Compare commits
2 Commits
medley-250
...
fgh_lfg-lo
| Author | SHA1 | Date | |
|---|---|---|---|
|
d91176bc90 | ||
|
|
a55246bc59 |
6
.github/workflows/buildDocker.yml
vendored
6
.github/workflows/buildDocker.yml
vendored
@@ -154,8 +154,7 @@ jobs:
|
||||
if [ "${{ inputs.draft }}" = "false" ];
|
||||
then
|
||||
docker_tags="${docker_image}:latest,${docker_image}:${MEDLEY_RELEASE#*-}_${MAIKO_RELEASE#*-}"
|
||||
platforms="linux/amd64"
|
||||
#,linux/arm64
|
||||
platforms="linux/amd64,linux/arm64"
|
||||
else
|
||||
docker_tags="${docker_image}:draft"
|
||||
platforms="linux/amd64"
|
||||
@@ -172,8 +171,7 @@ jobs:
|
||||
- name: Set up QEMU
|
||||
uses: docker/setup-qemu-action@v3
|
||||
with:
|
||||
platforms: linux/amd64
|
||||
# ,linux/arm64,linux/arm/v7
|
||||
platforms: linux/amd64,linux/arm64,linux/arm/v7
|
||||
|
||||
# Setup the Docker Buildx funtion
|
||||
- name: Set up Docker Buildx
|
||||
|
||||
2
.github/workflows/buildReleaseInclDocker.yml
vendored
2
.github/workflows/buildReleaseInclDocker.yml
vendored
@@ -131,7 +131,7 @@ jobs:
|
||||
run: |
|
||||
if [ ! "${{ needs.inputs.outputs.draft }}" = "true" ]
|
||||
then
|
||||
gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref main
|
||||
gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref master
|
||||
fi
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.ONLINE_TOKEN }}
|
||||
|
||||
7
.github/workflows/doHCFILES.yml
vendored
7
.github/workflows/doHCFILES.yml
vendored
@@ -52,12 +52,6 @@ jobs:
|
||||
- name: Checkout Medley repo
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Checkout maiko
|
||||
uses: actions/checkout@v4
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/maiko
|
||||
path: ./maiko
|
||||
|
||||
- name: Checkout notecards
|
||||
uses: actions/checkout@v4
|
||||
with:
|
||||
@@ -85,7 +79,6 @@ jobs:
|
||||
--repo ${{ github.repository_owner }}/maiko \
|
||||
--pattern '*-linux.x86_64.tgz'
|
||||
tar -xzf /tmp/maiko.tgz
|
||||
touch ./maiko/linux.x86_64/.skip
|
||||
env:
|
||||
GH_TOKEN: ${{ secrets.MU_TOKEN }}
|
||||
|
||||
|
||||
9
.gitignore
vendored
9
.gitignore
vendored
@@ -13,9 +13,11 @@ maiko/
|
||||
# normally when you have derived files, you ignore them from git
|
||||
# because they will get regenerated when you rebuild.
|
||||
# MEDLEY-UTILS HCFILES regenerates
|
||||
# index.html files are also produced by HCFILES
|
||||
*.pdf
|
||||
index.html
|
||||
|
||||
# do not ignore .pdf files after all... rather, [new workflow](scripts/make-gh-pages.md) stores it in the src repository gh-pages branch.
|
||||
|
||||
# *.pdf
|
||||
# index.html
|
||||
|
||||
|
||||
# all loadup files
|
||||
@@ -30,7 +32,6 @@ loadups/*.dribble
|
||||
loadups/whereis.hash
|
||||
loadups/apps.sysout
|
||||
loadups/fuller.database
|
||||
loadups/build/
|
||||
|
||||
# manual cross-reference files
|
||||
|
||||
|
||||
@@ -1,18 +1,18 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (PROGN (DEFPACKAGE "CLOS-BROWSER" ( USE "CLOS" "LISP") ( EXPORT "CLOS-ICON"
|
||||
"CLOS-BROWSER" "ADD-BROWSER-METHOD" "BROWSE-CLASS")) (CL FIND-PACKAGE "USER")) READTABLE "XCL" BASE
|
||||
10)
|
||||
(DEFINE-FILE-INFO PACKAGE (PROGN (DEFPACKAGE "CLOS-BROWSER" ( USE "CLOS") ( EXPORT "CLOS-ICON"
|
||||
"CLOS-BROWSER" "ADD-BROWSER-METHOD" "BROWSE-CLASS")) (CL FIND-PACKAGE "USER")) READTABLE "XCL" BASE
|
||||
10)
|
||||
|
||||
(IL:FILECREATED "28-Apr-2025 18:32:38"
|
||||
IL:|{DSK}<Users>arunwelch>DOCUMENTS>MEDLEY-WORKSPACE>RELEASE>NEW-CLOS-BROWSER.;4| 91934
|
||||
(IL:FILECREATED " 5-Dec-2023 12:07:41" IL:{CLOS}NEW-CLOS-BROWSER.\;3 91622
|
||||
|
||||
:EDIT-BY "akw"
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (IL:PROPS (IL:NEW-CLOS-BROWSER IL:MAKEFILE-ENVIRONMENT))
|
||||
|
||||
:PREVIOUS-DATE "26-Apr-2025 17:16:46"
|
||||
IL:|{DSK}<Users>arunwelch>DOCUMENTS>MEDLEY-WORKSPACE>RELEASE>NEW-CLOS-BROWSER.;3|)
|
||||
:PREVIOUS-DATE " 5-Dec-2023 00:58:05" IL:{CLOS}NEW-CLOS-BROWSER.\;2)
|
||||
|
||||
|
||||
; Copyright (c) 1991, 2020, 2023 by Venue.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:NEW-CLOS-BROWSERCOMS)
|
||||
|
||||
(IL:RPAQQ IL:NEW-CLOS-BROWSERCOMS
|
||||
@@ -275,7 +275,7 @@ IL:|{DSK}<Users>arunwelch>DOCUMENTS>MEDLEY-WORKSPACE>RELEASE>NEW-CLOS-BROWSER.;3
|
||||
|
||||
(IL:PUTPROPS IL:NEW-CLOS-BROWSER IL:MAKEFILE-ENVIRONMENT (:PACKAGE (PROGN (XCL:DEFPACKAGE
|
||||
"CLOS-BROWSER"
|
||||
(:USE "CLOS" "LISP")
|
||||
(:USE "CLOS")
|
||||
(:EXPORT "CLOS-ICON"
|
||||
"CLOS-BROWSER"
|
||||
"ADD-BROWSER-METHOD"
|
||||
@@ -1159,14 +1159,9 @@ Below this line operates on individual slots and methods."
|
||||
(DOCUMENTATION (SLOT-VALUE CLOS-BROWSER::SELF 'CLOS-BROWSER::CLASS)))
|
||||
|
||||
(DEFMETHOD CLOS-BROWSER::PRINT-CLASS ((CLOS-BROWSER::SELF CLOS-BROWSER::CLOS-BROWSER-NODE))
|
||||
(IF (IL:HASDEF (SLOT-VALUE (SLOT-VALUE CLOS-BROWSER::SELF 'CLOS-BROWSER::CLASS)
|
||||
'CLOS::NAME)
|
||||
'CLOS-BROWSER::CLASSES)
|
||||
(PPRINT (IL:GETDEF (SLOT-VALUE (SLOT-VALUE CLOS-BROWSER::SELF `CLOS-BROWSER::CLASS)
|
||||
'CLOS::NAME)
|
||||
'CLOS-BROWSER::CLASSES))
|
||||
(IL:PROMPTPRINT "No Printable Definition for the class " (SLOT-VALUE CLOS-BROWSER::SELF
|
||||
'WEB::NAME))))
|
||||
(PPRINT (IL:GETDEF (SLOT-VALUE (SLOT-VALUE CLOS-BROWSER::SELF `CLOS-BROWSER::CLASS)
|
||||
'CLOS::NAME)
|
||||
'CLOS-BROWSER::CLASSES)))
|
||||
|
||||
(DEFMETHOD CLOS-BROWSER::SPECIALIZE-CLASS ((CLOS-BROWSER::NODE CLOS-BROWSER::CLOS-BROWSER-NODE)
|
||||
&OPTIONAL CLOS-BROWSER::FORM CLOS-BROWSER::NEW-CLASS-NAME)
|
||||
@@ -1216,8 +1211,7 @@ Below this line operates on individual slots and methods."
|
||||
(RETURN))))))
|
||||
(IL:SETCURSOR CLOS-BROWSER::ORIGINALCURSOR))))))
|
||||
|
||||
(DEFUN CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE (IGNORE STRUCTURE)
|
||||
(IL:* IL:\; "Edited 26-Apr-2025 14:31 by arunwelch")
|
||||
(DEFUN CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE (IGNORE STRUCTURE)
|
||||
(LET ((CLOS-BROWSER::ORIGINALCURSOR (IL:CURSOR)))
|
||||
(UNWIND-PROTECT
|
||||
(PROGN (IL:SETCURSOR IL:WAITINGCURSOR)
|
||||
@@ -1230,7 +1224,8 @@ Below this line operates on individual slots and methods."
|
||||
(IL:* IL:|;;| "check for bug")
|
||||
|
||||
(WHEN (SYMBOLP CLOS-BROWSER::SUB-CLASS)
|
||||
(SETQ CLOS-BROWSER::SUB-CLASS (FIND-CLASS CLOS-BROWSER::SUB-CLASS)))
|
||||
(SETQ CLOS-BROWSER::SUB-CLASS (CLOS::SYMBOL-CLASS CLOS-BROWSER::SUB-CLASS
|
||||
)))
|
||||
(DOLIST (CLOS-BROWSER::BROWSER (SLOT-VALUE CLOS-BROWSER:CLOS-ICON
|
||||
'CLOS-BROWSER::CLASS-BROWSERS))
|
||||
(DOLIST (CLOS-BROWSER::SUPER-CLASS (SLOT-VALUE CLOS-BROWSER::SUB-CLASS
|
||||
@@ -1392,12 +1387,14 @@ Below this line operates on individual slots and methods."
|
||||
(0 (FORMAT T "Unspecialized methods cannot be copied. ~A" (CLOS::FULL-METHOD-NAME
|
||||
CLOS-BROWSER::METHOD NIL)))
|
||||
(1 (SETQ CLOS-BROWSER::FROM-CLASS (CAR CLOS-BROWSER::NON-T-CLASSES)))
|
||||
(OTHERWISE (SETQ CLOS-BROWSER::FROM-CLASS (FIND-CLASS (IL:PROMPTFORWORD
|
||||
(FORMAT NIL
|
||||
(OTHERWISE (SETQ CLOS-BROWSER::FROM-CLASS (CLOS::SYMBOL-CLASS
|
||||
(IL:PROMPTFORWORD (FORMAT NIL
|
||||
"Which class in ~A do you wish to move from?"
|
||||
(CLOS::FULL-METHOD-NAME
|
||||
CLOS-BROWSER::METHOD
|
||||
NIL))))))))
|
||||
(
|
||||
CLOS::FULL-METHOD-NAME
|
||||
|
||||
CLOS-BROWSER::METHOD
|
||||
NIL))))))))
|
||||
|
||||
(IL:* IL:|;;| "should contain from-class. If it is not the same, abort.")
|
||||
|
||||
@@ -1468,7 +1465,7 @@ Below this line operates on individual slots and methods."
|
||||
"fix bug in the inconsistent way CLOS objects store T class specializers and do method lookup.")
|
||||
|
||||
(WHEN (EQ CLOS-BROWSER::CLASS T)
|
||||
(SETQ CLOS-BROWSER::CLASS (FIND-CLASS T)))
|
||||
(SETQ CLOS-BROWSER::CLASS (CLOS::SYMBOL-CLASS T)))
|
||||
(LET ((CLOS-BROWSER::NODE (CLOS-BROWSER::BROWSER-CONTAINS-P
|
||||
CLOS-BROWSER::CLASS CLOS-BROWSER::BROWSER)))
|
||||
(WHEN CLOS-BROWSER::NODE
|
||||
@@ -1585,8 +1582,7 @@ Below this line operates on individual slots and methods."
|
||||
(IL:|if| PACKAGE
|
||||
IL:|then| (IN-PACKAGE PACKAGE))))
|
||||
|
||||
(DEFUN CLOS-BROWSER::CLASSES-IN-PACKAGE (PACKAGE &OPTIONAL CLOS-BROWSER::MAP-ON-PACKAGE)
|
||||
(IL:* IL:\; "Edited 26-Apr-2025 14:25 by arunwelch")
|
||||
(DEFUN CLOS-BROWSER::CLASSES-IN-PACKAGE (PACKAGE &OPTIONAL CLOS-BROWSER::MAP-ON-PACKAGE)
|
||||
"Retrieves a list of all the classes for a given package. When map-on-package is t this can be very slow."
|
||||
|
||||
(IL:* IL:|;;| "The maphash is always fast, whereas for some strange reason map-on-package varys among packages greatly.")
|
||||
@@ -1598,7 +1594,7 @@ Below this line operates on individual slots and methods."
|
||||
(DO-SYMBOLS (CLOS-BROWSER::SYM PACKAGE)
|
||||
(IF (AND (EQ (SYMBOL-PACKAGE CLOS-BROWSER::SYM)
|
||||
PACKAGE)
|
||||
(FIND-CLASS CLOS-BROWSER::SYM T))
|
||||
(CLOS::SYMBOL-CLASS CLOS-BROWSER::SYM T))
|
||||
(PUSH CLOS-BROWSER::SYM CLOS-BROWSER::CLASSES)))
|
||||
(MAPHASH #'(LAMBDA (CLOS-BROWSER::KEY CLOS-BROWSER::VAL)
|
||||
(IF (EQ (SYMBOL-PACKAGE CLOS-BROWSER::KEY)
|
||||
@@ -1627,16 +1623,17 @@ Below this line operates on individual slots and methods."
|
||||
IL:|BackgroundMenuCommands|)
|
||||
|
||||
(SETQ IL:|BackgroundMenu| NIL)
|
||||
(IL:PUTPROPS IL:NEW-CLOS-BROWSER IL:COPYRIGHT ("Venue" 1991 2020 2023))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (11846 13516 (CLOS-BROWSER:BROWSE-CLASS 11846 . 13516)) (13518 14861 (
|
||||
CLOS-BROWSER::COLLECT-FAMILY 13518 . 14861)) (14863 16895 (CLOS-BROWSER::MAKE-NODES 14863 . 16895)) (
|
||||
16897 17572 (CLOS-BROWSER::CLOS-BROWSER-CLOSE-FN 16897 . 17572)) (17574 18506 (CLOS-BROWSER::BROWSER-CONTAINS-P
|
||||
17574 . 18506)) (42339 42663 (CLOS-BROWSER::EDIT 42339 . 42663)) (42665 48259 (
|
||||
CLOS-BROWSER::MAKE-METHOD-MENU-ITEMS 42665 . 48259)) (48261 49739 (CLOS-BROWSER::MAKE-TOP-LEVEL-METHOD-MENU-ITEMS
|
||||
48261 . 49739)) (49741 51031 (CLOS-BROWSER::MAKE-MULTI-METHOD-SUB-MENU 49741 . 51031)) (65408 66025 (
|
||||
CLOS-BROWSER::COMPLETE-ADD-METHOD 65408 . 66025)) (66027 68239 (CLOS-BROWSER::COMPLETE-SPECIALIZE
|
||||
66027 . 68239)) (68241 69946 (CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE 68241 . 69946)) (69948 70113 (
|
||||
CLOS-BROWSER::THIS-CLASS-NODE-P 69948 . 70113)) (70115 70217 (CLOS::CLASS-DIRECT-METHODS 70115 . 70217
|
||||
)) (86738 87753 (CLOS-BROWSER::REPLACE-SPECIALIZERS 86738 . 87753)) (88064 89648 (CLOS-BROWSER::IN-SELECT-PACKAGE
|
||||
88064 . 89648)) (89650 90900 (CLOS-BROWSER::CLASSES-IN-PACKAGE 89650 . 90900)))))
|
||||
(IL:FILEMAP (NIL (11770 13440 (CLOS-BROWSER:BROWSE-CLASS 11770 . 13440)) (13442 14785 (
|
||||
CLOS-BROWSER::COLLECT-FAMILY 13442 . 14785)) (14787 16819 (CLOS-BROWSER::MAKE-NODES 14787 . 16819)) (
|
||||
16821 17496 (CLOS-BROWSER::CLOS-BROWSER-CLOSE-FN 16821 . 17496)) (17498 18430 (CLOS-BROWSER::BROWSER-CONTAINS-P
|
||||
17498 . 18430)) (42263 42587 (CLOS-BROWSER::EDIT 42263 . 42587)) (42589 48183 (
|
||||
CLOS-BROWSER::MAKE-METHOD-MENU-ITEMS 42589 . 48183)) (48185 49663 (CLOS-BROWSER::MAKE-TOP-LEVEL-METHOD-MENU-ITEMS
|
||||
48185 . 49663)) (49665 50955 (CLOS-BROWSER::MAKE-MULTI-METHOD-SUB-MENU 49665 . 50955)) (64981 65598 (
|
||||
CLOS-BROWSER::COMPLETE-ADD-METHOD 64981 . 65598)) (65600 67812 (CLOS-BROWSER::COMPLETE-SPECIALIZE
|
||||
65600 . 67812)) (67814 69482 (CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE 67814 . 69482)) (69484 69649 (
|
||||
CLOS-BROWSER::THIS-CLASS-NODE-P 69484 . 69649)) (69651 69753 (CLOS::CLASS-DIRECT-METHODS 69651 . 69753
|
||||
)) (86457 87472 (CLOS-BROWSER::REPLACE-SPECIALIZERS 86457 . 87472)) (87783 89367 (CLOS-BROWSER::IN-SELECT-PACKAGE
|
||||
87783 . 89367)) (89369 90516 (CLOS-BROWSER::CLASSES-IN-PACKAGE 89369 . 90516)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
@@ -1,361 +1,164 @@
|
||||
<h1>NAME</h1>
|
||||
<p><strong>medley</strong> — starts up Medley Interlisp</p>
|
||||
<h1>SYNOPSIS</h1>
|
||||
<p><strong>medley</strong> [ flags ... ] [ <em>SYSOUT_FILE</em> ] [ --
|
||||
<em>PASS_ON_ARGS</em> ]</p>
|
||||
<p><strong>medley</strong> [ flags ... ] [ <em>SYSOUT_FILE</em> ] [ -- <em>PASS_ON_ARGS</em> ]</p>
|
||||
<h1>DESCRIPTION</h1>
|
||||
<p>Starts Medley Interlisp in a window.</p>
|
||||
<h1>OPTIONS</h1>
|
||||
<p><strong>MEDLEYDIR</strong> is an environment variable set by Medley
|
||||
and used by many of the options described below. MEDLEYDIR is the top
|
||||
level directory of the Medley installation that contains the specific
|
||||
medley script that is invoked after all symbolic links are resolved. In
|
||||
the standard global installation this will be
|
||||
/usr/local/interlisp/medley. But Medley can be installed in multiple
|
||||
places on any given machine and hence MEDLEYDIR is computed on each
|
||||
invocation of medley.</p>
|
||||
<p><strong>MEDLEYDIR</strong> is an environment variable set by Medley and used by many of the options described below. MEDLEYDIR is the top level directory of the Medley installation that contains the specific medley script that is invoked after all symbolic links are resolved. In the standard global installation this will be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and hence MEDLEYDIR is computed on each invocation of medley.</p>
|
||||
<h2>Flags</h2>
|
||||
<dl>
|
||||
<dt>-h, --help</dt>
|
||||
<dd>
|
||||
<p>Prints out a brief summary of the flags and arguments to medley.</p>
|
||||
<dd><p>Prints out a brief summary of the flags and arguments to medley.</p>
|
||||
</dd>
|
||||
<dt>-z, --man</dt>
|
||||
<dd>
|
||||
<p>Show the man page for medley</p>
|
||||
<dd><p>Show the man page for medley</p>
|
||||
</dd>
|
||||
<dt>-c [<em>FILE</em> | -], --config [<em>FILE</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Use <em>FILE</em> as the config file for this run of Medley. See
|
||||
information on <em>CONFIG FILE</em> below.</p>
|
||||
<p>If the given value is “-”, then suppress the use of a config file for
|
||||
this run of Medley.</p>
|
||||
<dd><p>Use <em>FILE</em> as the config file for this run of Medley. See information on <em>CONFIG FILE</em> below.</p>
|
||||
<p>If the given value is “-”, then suppress the use of a config file for this run of Medley.</p>
|
||||
</dd>
|
||||
<dt>-f, --full</dt>
|
||||
<dd>
|
||||
<p>Start Medley from the standard “full” sysout. full.sysout includes a
|
||||
complete Interlisp and CommonLisp environment with a standard set of
|
||||
development tools. It does not include any of the applications built
|
||||
using Medley.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting
|
||||
sysouts.)</p>
|
||||
<dd><p>Start Medley from the standard “full” sysout. full.sysout includes a complete Interlisp and CommonLisp environment with a standard set of development tools. It does not include any of the applications built using Medley.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
|
||||
</dd>
|
||||
<dt>-l, --lisp</dt>
|
||||
<dd>
|
||||
<p>Start Medley from the standard “lisp” sysout. lisp.sysout only
|
||||
includes the basic Interlisp and CommonLisp environment.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting
|
||||
sysouts.)</p>
|
||||
<dd><p>Start Medley from the standard “lisp” sysout. lisp.sysout only includes the basic Interlisp and CommonLisp environment.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
|
||||
</dd>
|
||||
<dt>-a, --apps</dt>
|
||||
<dd>
|
||||
<p>Start Medley from the standard “apps” sysout. apps.sysout includes
|
||||
everything in full.sysout plus Medley applications including Notecards,
|
||||
Rooms and CLOS. It also includes pre-installed links to key Medley
|
||||
documentation.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting
|
||||
sysouts.)</p>
|
||||
<dd><p>Start Medley from the standard “apps” sysout. apps.sysout includes everything in full.sysout plus Medley applications including Notecards, Rooms and CLOS. It also includes pre-installed links to key Medley documentation.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
|
||||
</dd>
|
||||
<dt>-u, --continue</dt>
|
||||
<dd>
|
||||
<p>Nullify any prior setting of the sysout file (e.g., from the config
|
||||
file) - causing Medley to start from the virtual memory file resulting
|
||||
from the previous invocation (with the same values for –id and
|
||||
–logindir), if any. If there is no matching virtual memory file, Medley
|
||||
will start from the full.sysout (see -f/–full above).</p>
|
||||
<dd><p>Nullify any prior setting of the sysout file (e.g., from the config file) - causing Medley to start from the virtual memory file resulting from the previous invocation (with the same values for –id and –logindir), if any. If there is no matching virtual memory file, Medley will start from the full.sysout (see -f/–full above).</p>
|
||||
<p>Equivalent to “-y -”.</p>
|
||||
<p>(See <em>SYSOUT FILE</em> section below.)</p>
|
||||
</dd>
|
||||
<dt>-y [<em>SYSOUT_FILE</em> | -], --sysout [<em>SYSOUT-FILE</em> |
|
||||
-]</dt>
|
||||
<dd>
|
||||
<p>Start Medley from the specified <em>SYSOUT-FILE</em>. This is an
|
||||
alternative to specifying the <em>SYSOUT-FILE</em> as the last argument
|
||||
on the command line (but before any <em>PASS_ON_ARGS</em>). It can be
|
||||
used to specify the <em>SYSOUT-FILE</em> in the config file (see
|
||||
information on <em>CONFIG FILE</em> below).</p>
|
||||
<p>If the given value is “-”, then any prior setting of the sysout file
|
||||
(e.g., from the config file) is nullified (see -u/–continue above).</p>
|
||||
<dt>-y [<em>SYSOUT_FILE</em> | -], --sysout [<em>SYSOUT-FILE</em> | -]</dt>
|
||||
<dd><p>Start Medley from the specified <em>SYSOUT-FILE</em>. This is an alternative to specifying the <em>SYSOUT-FILE</em> as the last argument on the command line (but before any <em>PASS_ON_ARGS</em>). It can be used to specify the <em>SYSOUT-FILE</em> in the config file (see information on <em>CONFIG FILE</em> below).</p>
|
||||
<p>If the given value is “-”, then any prior setting of the sysout file (e.g., from the config file) is nullified (see -u/–continue above).</p>
|
||||
<p>(See <em>SYSOUT FILE</em> section below.)</p>
|
||||
</dd>
|
||||
<dt>-e [+ | -], --interlisp [+ | -]</dt>
|
||||
<dd>
|
||||
<p>If value is “+” or no value, make the initial Exec window within
|
||||
Medley be an Interlisp Exec. If value is “-”, make the initial Exec
|
||||
window be the default XCL Exec.</p>
|
||||
<dd><p>If value is “+” or no value, make the initial Exec window within Medley be an Interlisp Exec. If value is “-”, make the initial Exec window be the default XCL Exec.</p>
|
||||
<p>This flag applies only when the –apps flag is used.</p>
|
||||
</dd>
|
||||
<dt>-n [+ | -], --noscroll [+ | -]</dt>
|
||||
<dd>
|
||||
<p>Medley ordinarily displays scroll bars to enable the user to pan the
|
||||
Medley virtual display within the Medley window. This is true even when
|
||||
the entire virtual display fits within the window.</p>
|
||||
<p>Specifying “-n +” (–noscroll +) turns off scroll bars. Specifying “-n
|
||||
-” (–scroll -) turns on scroll bars. Specifying -n (–noscroll) with no
|
||||
value is equivalent to specifying “–noscroll +”.</p>
|
||||
<dd><p>Medley ordinarily displays scroll bars to enable the user to pan the Medley virtual display within the Medley window. This is true even when the entire virtual display fits within the window.</p>
|
||||
<p>Specifying “-n +” (–noscroll +) turns off scroll bars. Specifying “-n -” (–scroll -) turns on scroll bars. Specifying -n (–noscroll) with no value is equivalent to specifying “–noscroll +”.</p>
|
||||
<p>Default is scroll bars off.</p>
|
||||
<p>Note: If scroll bars are off and the virtual screen is larger than
|
||||
the window, there will be no way to pan to the non-visible parts of the
|
||||
virtual display.</p>
|
||||
<p>Note: If scroll bars are off and the virtual screen is larger than the window, there will be no way to pan to the non-visible parts of the virtual display.</p>
|
||||
</dd>
|
||||
<dt>-g [<em>WxH</em> | -], --geometry [<em>WxH</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Sets the size of the X Window (or VNC window) that Medley runs in to
|
||||
be Width x Height. (Full X Windows geomtery specification with +X+Y is
|
||||
not currently supported).</p>
|
||||
<dd><p>Sets the size of the X Window (or VNC window) that Medley runs in to be Width x Height. (Full X Windows geomtery specification with +X+Y is not currently supported).</p>
|
||||
<p>If a value of “-” is given, geometry is set to the default value.</p>
|
||||
<p>If --geometry is not specified but --screensize is, then the window
|
||||
size will be determined based on the --screensize values and the
|
||||
--noscroll flag. If neither --geometry nor --screensize is provided,
|
||||
then the window size is set to 1440x900 if --noscroll is set and
|
||||
1462x922 if --noscroll is not set.</p>
|
||||
<p>(Also see note below under <em>CONFIG FILE</em> on the use of
|
||||
geometry and screensize in config files.)</p>
|
||||
<p>If --geometry is not specified but --screensize is, then the window size will be determined based on the --screensize values and the --noscroll flag. If neither --geometry nor --screensize is provided, then the window size is set to 1440x900 if --noscroll is set and 1462x922 if --noscroll is not set.</p>
|
||||
<p>(Also see note below under <em>CONFIG FILE</em> on the use of geometry and screensize in config files.)</p>
|
||||
</dd>
|
||||
<dt>-s [<em>WxH</em> | -], --screensize [<em>WxH</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Sets the size of the virtual display as seen from Medley’s point of
|
||||
view. The Medley window is an unscaled viewport onto this virtual
|
||||
display.</p>
|
||||
<p>If a value of “-” is given, screensize is set to the default
|
||||
value.</p>
|
||||
<p>If --screensize is not specified but --geometry is, then the virtual
|
||||
display size will be set so that the entire virtual display fits into
|
||||
the given window geometry. If neither --screensize nor --geometry is
|
||||
provided, then the screen size is set to 1440x900.</p>
|
||||
<p>(Also see note below under <em>CONFIG FILE</em> on the use of
|
||||
geometry and screensize in config files.)</p>
|
||||
<dd><p>Sets the size of the virtual display as seen from Medley’s point of view. The Medley window is an unscaled viewport onto this virtual display.</p>
|
||||
<p>If a value of “-” is given, screensize is set to the default value.</p>
|
||||
<p>If --screensize is not specified but --geometry is, then the virtual display size will be set so that the entire virtual display fits into the given window geometry. If neither --screensize nor --geometry is provided, then the screen size is set to 1440x900.</p>
|
||||
<p>(Also see note below under <em>CONFIG FILE</em> on the use of geometry and screensize in config files.)</p>
|
||||
</dd>
|
||||
<dt>-ps [<em>N</em> | -], –pixelscale [<em>N</em> | -] **
|
||||
<strong>Applicable only when display is SDL-based (e.g., on
|
||||
Windows/Cygwin)</strong> **</dt>
|
||||
<dd>
|
||||
<p>Sets the pixel scaling factor to <em>N</em>, an integer</p>
|
||||
<p>If value of “-” is given, the pixel scale factor is set to its
|
||||
default of 1.</p>
|
||||
<dt>-ps [<em>N</em> | -], –pixelscale [<em>N</em> | -] ** <strong>Applicable only when display is SDL-based (e.g., on Windows/Cygwin)</strong> **</dt>
|
||||
<dd><p>Sets the pixel scaling factor to <em>N</em>, an integer</p>
|
||||
<p>If value of “-” is given, the pixel scale factor is set to its default of 1.</p>
|
||||
</dd>
|
||||
<dt>-t [<em>STRING</em> | -], --title [<em>STRING</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Use <em>STRING</em> as title of Medley window.</p>
|
||||
<p>If <em>STRING</em> includes the character sequence “%i”, then the
|
||||
value of the id string (see –id flag below) prefixed by “::” will be
|
||||
substituited for the “%i”. Example: if the id is “run_45” and
|
||||
<em>STRING</em> is “Medley Interlisp %i”, then the actual window title
|
||||
will be “Medley Interlisp :: run_45”.</p>
|
||||
<p>If the value of “-” is given, sets the title to its default value
|
||||
(“Medley Interlisp %i”).</p>
|
||||
<dd><p>Use <em>STRING</em> as title of Medley window.</p>
|
||||
<p>If <em>STRING</em> includes the character sequence “%i”, then the value of the id string (see –id flag below) prefixed by “::” will be substituited for the “%i”. Example: if the id is “run_45” and <em>STRING</em> is “Medley Interlisp %i”, then the actual window title will be “Medley Interlisp :: run_45”.</p>
|
||||
<p>If the value of “-” is given, sets the title to its default value (“Medley Interlisp %i”).</p>
|
||||
<p>This flag is ignored when when the --vnc flag is set.</p>
|
||||
</dd>
|
||||
<dt>-d [<em>:N</em> | -], --display [<em>:N</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Use X display <em>:N</em>.</p>
|
||||
<p>If value is “-”, reset display to its default value. Default value is
|
||||
the value of $DISPLAY.</p>
|
||||
<p>On platforms that support both SDL and X Windows, set the value of -d
|
||||
(–display) to “SDL” to select using SDL instead of X Windows.</p>
|
||||
<p>This flag is ignored on the Windows/Cygwin platform and when the
|
||||
--vnc flag is set on Windows System for Linux.</p>
|
||||
<dd><p>Use X display <em>:N</em>.</p>
|
||||
<p>If value is “-”, reset display to its default value. Default value is the value of $DISPLAY.</p>
|
||||
<p>On platforms that support both SDL and X Windows, set the value of -d (–display) to “SDL” to select using SDL instead of X Windows.</p>
|
||||
<p>This flag is ignored on the Windows/Cygwin platform and when the --vnc flag is set on Windows System for Linux.</p>
|
||||
</dd>
|
||||
<dt>-v [+ | -] , --vnc [+ | -] ** <strong>Applicable only to WSL
|
||||
installations</strong> **</dt>
|
||||
<dd>
|
||||
<p>If value is “+” or no value is given, then use a VNC window running
|
||||
on the Windows side instead of an X window. If value is “-”, then do not
|
||||
use a VNC window, relying instead on a standard X Window.</p>
|
||||
<p>A VNC window will folllow the Windows desktop scaling setting
|
||||
allowing for much more usable Medley on high resolution displays. On
|
||||
WSL, X windows do not scale well.</p>
|
||||
<dt>-v [+ | -] , --vnc [+ | -] ** <strong>Applicable only to WSL installations</strong> **</dt>
|
||||
<dd><p>If value is “+” or no value is given, then use a VNC window running on the Windows side instead of an X window. If value is “-”, then do not use a VNC window, relying instead on a standard X Window.</p>
|
||||
<p>A VNC window will folllow the Windows desktop scaling setting allowing for much more usable Medley on high resolution displays. On WSL, X windows do not scale well.</p>
|
||||
<p>This flag is always set for WSL1 installations.</p>
|
||||
</dd>
|
||||
<dt>-i [<em>ID_STRING</em> | - | --], --id [<em>ID_STRING</em> | - |
|
||||
--]</dt>
|
||||
<dd>
|
||||
<p>Use <em>ID_STRING</em> as the id for this run of Medley, unless the
|
||||
given value is “-”, “--”, or “---”.</p>
|
||||
<p>Only one instance of Medley can be run simultaneously for any given
|
||||
id.</p>
|
||||
<p><em>ID-STRING</em> can consist of any alphanumeric character plus the
|
||||
underscore (_) character, ending (optionally) in a “+” character. If
|
||||
<em>ID_STRING</em> ends with a “+” (including just a singleton “+”),
|
||||
then Medley will add a number to the id to make it unique among
|
||||
currently running Medley intsances.</p>
|
||||
<p>If the given value is “-”, then the id will be (re)set to “default”
|
||||
(e.g., if it was previously set in the config file). If it is “--”, then
|
||||
id will be set to the basename of $MEDLEYDIR. If ID_STRING is “---”,
|
||||
then id will be set to the basename of the parent directory of
|
||||
$MEDLEYDIR.</p>
|
||||
<dt>-i [<em>ID_STRING</em> | - | --], --id [<em>ID_STRING</em> | - | --]</dt>
|
||||
<dd><p>Use <em>ID_STRING</em> as the id for this run of Medley, unless the given value is “-”, “--”, or “---”.</p>
|
||||
<p>Only one instance of Medley can be run simultaneously for any given id.</p>
|
||||
<p><em>ID-STRING</em> can consist of any alphanumeric character plus the underscore (_) character, ending (optionally) in a “+” character. If <em>ID_STRING</em> ends with a “+” (including just a singleton “+”), then Medley will add a number to the id to make it unique among currently running Medley intsances.</p>
|
||||
<p>If the given value is “-”, then the id will be (re)set to “default” (e.g., if it was previously set in the config file). If it is “--”, then id will be set to the basename of $MEDLEYDIR. If ID_STRING is “---”, then id will be set to the basename of the parent directory of $MEDLEYDIR.</p>
|
||||
<p>Default id is “default”.</p>
|
||||
</dd>
|
||||
<dt>-m [<em>N</em> | -], --mem [<em>N</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Set Medley to run in <em>N</em> MB of virtual memory. Defaults to
|
||||
256MB.</p>
|
||||
<dd><p>Set Medley to run in <em>N</em> MB of virtual memory. Defaults to 256MB.</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<p>If a value of “-” is given, resets to default value.</p>
|
||||
<dl>
|
||||
<dt>-p [<em>FILE</em> | -], --vmem [<em>FILE</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Use <em>FILE</em> as the Medley virtual memory (vmem) store.
|
||||
<em>FILE</em> must be writeable by the current user.</p>
|
||||
<p>Care must be taken not to use the same vmem FILE for two instances of
|
||||
Medley running simultaneously. The --id flag will not protect against
|
||||
vmem collisions when the --vmem flag is used.</p>
|
||||
<p>If the value “-” is given, then resets the vmem file to the
|
||||
default.</p>
|
||||
<p>Default is to store the vmem in LOGINDIR/vmem/lisp_III.virtualmem,
|
||||
where III is the id of this Medley run (see --id flag above). See
|
||||
--logindir below for setting of LOGINDIR.</p>
|
||||
<dd><p>Use <em>FILE</em> as the Medley virtual memory (vmem) store. <em>FILE</em> must be writeable by the current user.</p>
|
||||
<p>Care must be taken not to use the same vmem FILE for two instances of Medley running simultaneously. The --id flag will not protect against vmem collisions when the --vmem flag is used.</p>
|
||||
<p>If the value “-” is given, then resets the vmem file to the default.</p>
|
||||
<p>Default is to store the vmem in LOGINDIR/vmem/lisp_III.virtualmem, where III is the id of this Medley run (see --id flag above). See --logindir below for setting of LOGINDIR.</p>
|
||||
</dd>
|
||||
<dt>-r [<em>FILE</em> | -], --greet [<em>FILE</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Use <em>FILE</em> as the Medley greetfile.</p>
|
||||
<p>If the given value is “-”, Medley will start up without using a
|
||||
greetfile.</p>
|
||||
<p>The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT,
|
||||
except when the --apps flag is used in which case it is
|
||||
$MEDLEYDIR/greetfiles/APPS-INIT.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the
|
||||
Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
<dt>-cm [<em>FILE</em> | -], --rem.cm [<em>FILE</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Use <em>FILE</em> as the REM.CM file that Medley reads and executes
|
||||
at startup - after any greet files. Usually used only for loadups and
|
||||
other maintenance operations .</p>
|
||||
<p>If the given value is “-”, Medley will start up without using REM.CM
|
||||
file.</p>
|
||||
<p>There is no default Medley REM.CM file.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the
|
||||
Medley file system, not the host Windows file system.</p>
|
||||
<dd><p>Use <em>FILE</em> as the Medley greetfile.</p>
|
||||
<p>If the given value is “-”, Medley will start up without using a greetfile.</p>
|
||||
<p>The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT, except when the --apps flag is used in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
<dt>-x [<em>DIR</em> | - | –], --logindir [<em>DIR</em> | - | –]</dt>
|
||||
<dd>
|
||||
<p>Use <em>DIR</em> as LOGINDIR in Medley. <em>DIR</em> must be
|
||||
writeable by the current user.</p>
|
||||
<p>LOGINDIR is used by Medley as the working directory on start-up and
|
||||
where it loads any “personal” initialization file from.</p>
|
||||
<p>If the given value is “-”, then reset LOGINDIR to its default value.
|
||||
If the given value is “–”, uses $MEDLEYDIR/logindir as LOGINDIR.</p>
|
||||
<dd><p>Use <em>DIR</em> as LOGINDIR in Medley. <em>DIR</em> must be writeable by the current user.</p>
|
||||
<p>LOGINDIR is used by Medley as the working directory on start-up and where it loads any “personal” initialization file from.</p>
|
||||
<p>If the given value is “-”, then reset LOGINDIR to its default value. If the given value is “–”, uses $MEDLEYDIR/logindir as LOGINDIR.</p>
|
||||
<p>LOGINDIR defaults to $HOME/il.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the
|
||||
Medley file system, not the host Windows file system.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
<dt>-nh <em>Host:Port:Mac:Debug</em>, --nethub
|
||||
<em>Host:Port:Mac:Debug</em></dt>
|
||||
<dd>
|
||||
<p>Set the parameters for using Nethub XNS networking. <em>Host</em> is
|
||||
the full domain name of the nethub host. <em>Port</em> is the port on
|
||||
<em>Host</em> that nethub is using. <em>Mac</em> is the Mac address that
|
||||
this instance of Medley should use when contacting the nethub host.
|
||||
<em>Debug</em> is the level of nethub debug information that should be
|
||||
printed on stdout (value is 0, 1, or 2). A <em>Host</em> value is
|
||||
required and serves to turn nethub functionality on. <em>Port</em>,
|
||||
<em>Mac</em> and <em>Debug</em> parameters are optional and will default
|
||||
if left off.</p>
|
||||
<p>If any of the parameters have a value of “-”, any previous setting
|
||||
(e.g., in a config file) for the parameter will be reset to the default
|
||||
value - which in the case of <em>Host</em> is the null string, turning
|
||||
nethub functionality off.</p>
|
||||
<dt>-nh <em>Host:Port:Mac:Debug</em>, --nethub <em>Host:Port:Mac:Debug</em></dt>
|
||||
<dd><p>Set the parameters for using Nethub XNS networking. <em>Host</em> is the full domain name of the nethub host. <em>Port</em> is the port on <em>Host</em> that nethub is using. <em>Mac</em> is the Mac address that this instance of Medley should use when contacting the nethub host. <em>Debug</em> is the level of nethub debug information that should be printed on stdout (value is 0, 1, or 2). A <em>Host</em> value is required and serves to turn nethub functionality on. <em>Port</em>, <em>Mac</em> and <em>Debug</em> parameters are optional and will default if left off.</p>
|
||||
<p>If any of the parameters have a value of “-”, any previous setting (e.g., in a config file) for the parameter will be reset to the default value - which in the case of <em>Host</em> is the null string, turning nethub functionality off.</p>
|
||||
</dd>
|
||||
<dt>-nf, -NF, –nofork</dt>
|
||||
<dd>
|
||||
<p>No fork. Relevant only to the Medley loadup workflow.</p>
|
||||
<dd><p>No fork. Relevant only to the Medley loadup workflow.</p>
|
||||
</dd>
|
||||
<dt>-prog <em>EXE</em>, –maikoprog <em>EXE</em></dt>
|
||||
<dd>
|
||||
<p>Use <em>EXE</em> as the basename of the Maiko executable. Relevant
|
||||
only to the Medley loadup workflow.</p>
|
||||
<dd><p>Use <em>EXE</em> as the basename of the Maiko executable. Relevant only to the Medley loadup workflow.</p>
|
||||
</dd>
|
||||
<dt>–maikodir <em>DIR</em></dt>
|
||||
<dd>
|
||||
<p>Use <em>DIR</em> as the directory containing the Maiko emulator. For
|
||||
testing purposes only.</p>
|
||||
</dd>
|
||||
<dt>-cc [<em>FILE</em> | -], --repeat [<em>FILE</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Run Medley once. And then as long as <em>FILE</em> exists and is
|
||||
greater then zero length, repeatedly run Medley using <em>FILE</em> as
|
||||
the REM.CM file that Medley reads and executes at startup. Each run of
|
||||
Medley can change the contents of <em>FILE</em> to effect the subsequent
|
||||
run of Medley. To end the cycle, Medley needs to delete <em>FILE</em>.
|
||||
WIthin Medley, <em>FILE</em> can be found as the value of the
|
||||
environment variable LDEREPEATCM.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the
|
||||
Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
<dt>-am, –automation</dt>
|
||||
<dd>
|
||||
<p>Useful only when using –vnc (and always on WSL1). When calling medley
|
||||
as part of an automation script, often Medley will run for a very short
|
||||
time (< a couple of seconds). This can cause issues with medley code
|
||||
that detects Xvnc server failures. Setting this flag notifies Medley
|
||||
that very short Medley sessions are possible and the Xvnc error
|
||||
detection needs to be adjusted accordingly.</p>
|
||||
<dd><p>Use <em>DIR</em> as the directory containing the Maiko emulator. For testing purposes only.</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h2>Other Options</h2>
|
||||
<dl>
|
||||
<dt><em>SYSOUT_FILE</em></dt>
|
||||
<dd>
|
||||
<p>The pathname of the file to use as a sysout for Medley to start from.
|
||||
If SYSOUT_FILE is not provided and none of the flags (--apps, --full,
|
||||
--lisp) is used, then Medley will start from the saved virtual memory
|
||||
file from the previous session with the same ID_STRING as this run. If
|
||||
no such virtual memory file exists, then Medley will start from the
|
||||
standard full.sysout (equivalent to specifying the --full flag). On
|
||||
Windows (Docker) installations, <em>SYSOUT_FILE</em> is specified in the
|
||||
Medley file system, not the host Windows file system.</p>
|
||||
<dd><p>The pathname of the file to use as a sysout for Medley to start from. If SYSOUT_FILE is not provided and none of the flags (--apps, --full, --lisp) is used, then Medley will start from the saved virtual memory file from the previous session with the same ID_STRING as this run. If no such virtual memory file exists, then Medley will start from the standard full.sysout (equivalent to specifying the --full flag). On Windows (Docker) installations, <em>SYSOUT_FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
<dt><em>PASS_ON_ARGS</em></dt>
|
||||
<dd>
|
||||
<p>All arguments after the “--” flag, are passed unaltered to the Maiko
|
||||
emulator.</p>
|
||||
<dd><p>All arguments after the “--” flag, are passed unaltered to the Maiko emulator.</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h1>CONFIG FILE</h1>
|
||||
<p>A config file can be used to “pre-specify” any of the above command
|
||||
line arguments. The config file consists of command line arguments
|
||||
(flags or flag-value pairs), <em>one per line</em>. These arguments are
|
||||
read from the config file and prepended to the arguments actually given
|
||||
on the command line. Since later arguments override earlier arguments,
|
||||
any argument actually given on the command line will override a
|
||||
conflicting argument given in the config file.</p>
|
||||
<p>Unless specified using the -c (–config) argument, the default config
|
||||
file will be $MEDLEYDIR/.medley_config, if it exists, and
|
||||
$HOME/.medley_config, otherwise.</p>
|
||||
<p>Specifying, “-c -” or “–config -” on the command line will suppress
|
||||
the use of config files for the current run of Medley.</p>
|
||||
<p><em>Note:</em> care must be taken when using -g (–geometry) and/or -s
|
||||
(–screensize) arguments in config files. If only one of these is
|
||||
specified, then the other is conputed. But if both are specified, then
|
||||
the specified dimensions are used as given. Unexpected results can arise
|
||||
if one is specified in the config file but the other is specified on the
|
||||
command line. In this case, the two specified dimensions will be used as
|
||||
given. It will not be the case, as might be expected, that the dimension
|
||||
given in the config file will be overridden by a dimension computed from
|
||||
the dimension given on the command line.</p>
|
||||
<p>A config file can be used to “pre-specify” any of the above command line arguments. The config file consists of command line arguments (flags or flag-value pairs), <em>one per line</em>. These arguments are read from the config file and prepended to the arguments actually given on the command line. Since later arguments override earlier arguments, any argument actually given on the command line will override a conflicting argument given in the config file.</p>
|
||||
<p>Unless specified using the -c (–config) argument, the default config file will be $MEDLEYDIR/.medley_config, if it exists, and $HOME/.medley_config, otherwise.</p>
|
||||
<p>Specifying, “-c -” or “–config -” on the command line will suppress the use of config files for the current run of Medley.</p>
|
||||
<p><em>Note:</em> care must be taken when using -g (–geometry) and/or -s (–screensize) arguments in config files. If only one of these is specified, then the other is conputed. But if both are specified, then the specified dimensions are used as given. Unexpected results can arise if one is specified in the config file but the other is specified on the command line. In this case, the two specified dimensions will be used as given. It will not be the case, as might be expected, that the dimension given in the config file will be overridden by a dimension computed from the dimension given on the command line.</p>
|
||||
<h1>OTHER FILES</h1>
|
||||
<dl>
|
||||
<dt>$HOME/il</dt>
|
||||
<dd>
|
||||
<p>Default Medley LOGINDIR</p>
|
||||
<dd><p>Default Medley LOGINDIR</p>
|
||||
</dd>
|
||||
<dt>$HOME/il/vmem/lisp.virtualmem</dt>
|
||||
<dd>
|
||||
<p>Default virtual memory file</p>
|
||||
<dd><p>Default virtual memory file</p>
|
||||
</dd>
|
||||
<dt>$HOME/il/INIT(.LCOM)</dt>
|
||||
<dd>
|
||||
<p>Default personal init file</p>
|
||||
<dd><p>Default personal init file</p>
|
||||
</dd>
|
||||
<dt>$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT(.LCOM)</dt>
|
||||
<dd>
|
||||
<p>Default Medley greetfile</p>
|
||||
<dd><p>Default Medley greetfile</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h1>BUGS</h1>
|
||||
<p>See GitHub Issues:
|
||||
<https://github.com/Interlisp/medley/issues></p>
|
||||
<p>See GitHub Issues: <https://github.com/Interlisp/medley/issues></p>
|
||||
<h1>COPYRIGHT</h1>
|
||||
<p>Copyright(c) 2023-2024 by Interlisp.org</p>
|
||||
|
||||
@@ -1,19 +1,5 @@
|
||||
.\" Automatically generated by Pandoc 3.1.3
|
||||
.\" Automatically generated by Pandoc 2.9.2.1
|
||||
.\"
|
||||
.\" Define V font for inline verbatim, using C font in formats
|
||||
.\" that render this, and otherwise B font.
|
||||
.ie "\f[CB]x\f[]"x" \{\
|
||||
. ftr V B
|
||||
. ftr VI BI
|
||||
. ftr VB B
|
||||
. ftr VBI BI
|
||||
.\}
|
||||
.el \{\
|
||||
. ftr V CR
|
||||
. ftr VI CI
|
||||
. ftr VB CB
|
||||
. ftr VBI CBI
|
||||
.\}
|
||||
.ad l
|
||||
.TH "MEDLEY" "1" "" "" "Start Medley Interlisp"
|
||||
.nh
|
||||
@@ -22,8 +8,8 @@
|
||||
\f[B]medley\f[R] \[em] starts up Medley Interlisp
|
||||
.SH SYNOPSIS
|
||||
.PP
|
||||
\f[B]medley\f[R] [ flags \&...
|
||||
] [ \f[I]SYSOUT_FILE\f[R] ] [ -- \f[I]PASS_ON_ARGS\f[R] ]
|
||||
\f[B]medley\f[R] [ flags \&... ] [ \f[I]SYSOUT_FILE\f[R] ] [ --
|
||||
\f[I]PASS_ON_ARGS\f[R] ]
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
Starts Medley Interlisp in a window.
|
||||
@@ -305,21 +291,6 @@ On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
|
||||
Medley file system, not the host Windows file system.
|
||||
.RE
|
||||
.TP
|
||||
-cm [\f[I]FILE\f[R] | -], --rem.cm [\f[I]FILE\f[R] | -]
|
||||
Use \f[I]FILE\f[R] as the REM.CM file that Medley reads and executes at
|
||||
startup - after any greet files.
|
||||
Usually used only for loadups and other maintenance operations .
|
||||
.RS
|
||||
.PP
|
||||
If the given value is \[lq]-\[rq], Medley will start up without using
|
||||
REM.CM file.
|
||||
.PP
|
||||
There is no default Medley REM.CM file.
|
||||
.PP
|
||||
On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
|
||||
Medley file system, not the host Windows file system.
|
||||
.RE
|
||||
.TP
|
||||
-x [\f[I]DIR\f[R] | - | \[en]], --logindir [\f[I]DIR\f[R] | - | \[en]]
|
||||
Use \f[I]DIR\f[R] as LOGINDIR in Medley.
|
||||
\f[I]DIR\f[R] must be writeable by the current user.
|
||||
@@ -370,31 +341,6 @@ Relevant only to the Medley loadup workflow.
|
||||
\[en]maikodir \f[I]DIR\f[R]
|
||||
Use \f[I]DIR\f[R] as the directory containing the Maiko emulator.
|
||||
For testing purposes only.
|
||||
.TP
|
||||
-cc [\f[I]FILE\f[R] | -], --repeat [\f[I]FILE\f[R] | -]
|
||||
Run Medley once.
|
||||
And then as long as \f[I]FILE\f[R] exists and is greater then zero
|
||||
length, repeatedly run Medley using \f[I]FILE\f[R] as the REM.CM file
|
||||
that Medley reads and executes at startup.
|
||||
Each run of Medley can change the contents of \f[I]FILE\f[R] to effect
|
||||
the subsequent run of Medley.
|
||||
To end the cycle, Medley needs to delete \f[I]FILE\f[R].
|
||||
WIthin Medley, \f[I]FILE\f[R] can be found as the value of the
|
||||
environment variable LDEREPEATCM.
|
||||
.RS
|
||||
.PP
|
||||
On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
|
||||
Medley file system, not the host Windows file system.
|
||||
.RE
|
||||
.TP
|
||||
-am, \[en]automation
|
||||
Useful only when using \[en]vnc (and always on WSL1).
|
||||
When calling medley as part of an automation script, often Medley will
|
||||
run for a very short time (< a couple of seconds).
|
||||
This can cause issues with medley code that detects Xvnc server
|
||||
failures.
|
||||
Setting this flag notifies Medley that very short Medley sessions are
|
||||
possible and the Xvnc error detection needs to be adjusted accordingly.
|
||||
.SS Other Options
|
||||
.PP
|
||||
\
|
||||
|
||||
Binary file not shown.
@@ -1,4 +1,4 @@
|
||||
% MEDLEY(1) | Start Medley Interlisp
|
||||
% MEDLEY(1) | Start Medley Interlisp
|
||||
|
||||
---
|
||||
adjusting: l
|
||||
@@ -210,16 +210,6 @@ in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.
|
||||
On Windows/Cygwin installations, *FILE* is
|
||||
specified in the Medley file system, not the host Windows file system.
|
||||
|
||||
-cm \[*FILE* | -], \-\-rem.cm \[*FILE* | -]
|
||||
: Use *FILE* as the REM.CM file that Medley reads and executes at startup - after any greet files. Usually used only for loadups and other maintenance operations .
|
||||
|
||||
If the given value is "-", Medley will start up without using REM.CM file.
|
||||
|
||||
There is no default Medley REM.CM file.
|
||||
|
||||
On Windows/Cygwin installations, *FILE* is
|
||||
specified in the Medley file system, not the host Windows file system.
|
||||
|
||||
-x \[*DIR* | - | --], \-\-logindir \[*DIR* | - | --]
|
||||
: Use *DIR* as LOGINDIR in Medley. *DIR* must be writeable by the current user.
|
||||
|
||||
@@ -252,17 +242,6 @@ for the parameter will be reset to the default value - which in the case of *Hos
|
||||
--maikodir *DIR*
|
||||
: Use *DIR* as the directory containing the Maiko emulator. For testing purposes only.
|
||||
|
||||
-cc \[*FILE* | -], \-\-repeat \[*FILE* | -]
|
||||
: Run Medley once. And then as long as *FILE* exists and is greater then zero length, repeatedly run Medley using *FILE* as the REM.CM file that Medley reads and executes at startup. Each run of Medley can change the contents of *FILE* to effect the subsequent run of Medley. To end the cycle, Medley needs to delete *FILE*. WIthin Medley, *FILE* can be found as the value of the environment variable LDEREPEATCM.
|
||||
|
||||
On Windows/Cygwin installations, *FILE* is
|
||||
specified in the Medley file system, not the host Windows file system.
|
||||
|
||||
-am, --automation
|
||||
: Useful only when using --vnc (and always on WSL1). When calling medley as part of an automation script, often Medley
|
||||
will run for a very short time (< a couple of seconds). This can cause issues with medley code that detects Xvnc server failures.
|
||||
Setting this flag notifies Medley that very short Medley sessions are possible and the Xvnc error detection needs to be adjusted accordingly.
|
||||
|
||||
|
||||
Other Options
|
||||
-------------
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Mar-2025 10:31:37" {WMEDLEY}<doctools>IMINDEX.;10 37350
|
||||
(FILECREATED " 7-Apr-2024 09:25:49" {WMEDLEY}<doctools>IMINDEX.;6 37064
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS IM.INDEX.EDIT)
|
||||
:CHANGES-TO (FNS IM.INDEX.PUTFN IM.INDEX.GETFN)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2025 12:07:55" {WMEDLEY}<doctools>IMINDEX.;9)
|
||||
:PREVIOUS-DATE " 4-Apr-2024 23:17:47" {WMEDLEY}<doctools>IMINDEX.;5)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IMINDEXCOMS)
|
||||
@@ -163,13 +163,11 @@
|
||||
(TERPRI PTRFILE])
|
||||
|
||||
(IM.INDEX.EDIT
|
||||
[LAMBDA (OBJ TEXTSTREAM) (* ; "Edited 24-Mar-2025 10:30 by rmk")
|
||||
(* ; "Edited 17-Mar-2025 12:06 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 00:14 by rmk")
|
||||
(* ; "Edited 18-Jul-88 14:10 by burns")
|
||||
[LAMBDA (OBJ TEXTSTREAM) (* ; "Edited 18-Jul-88 14:10 by burns")
|
||||
|
||||
(PROG* ((W (FREEMENU IM.INDEX.OBJ.FREEMENU.SPECS))
|
||||
(REGION (WINDOWREGION W))
|
||||
(TEDIT.WINDOW (TEDITWINDOWP TEXTSTREAM))
|
||||
[TEDIT.WINDOW (CAR (fetch \WINDOW of (TEXTOBJ TEXTSTREAM]
|
||||
(TEDIT.REGION (AND TEDIT.WINDOW (WINDOWREGION TEDIT.WINDOW)))
|
||||
OBJ.DATA OBJ.DATA.PROPLIST)
|
||||
(WINDOWPROP W 'IM.INDEX.OBJ OBJ)
|
||||
@@ -642,13 +640,13 @@
|
||||
|
||||
(IM.INDEX.INIT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1677 15659 (IM.INDEX.CLOSEF 1687 . 2378) (IM.INDEX.COPYFN 2380 . 2565) (
|
||||
IM.INDEX.CREATEOBJ 2567 . 3913) (IM.INDEX.DISPLAY.STRING 3915 . 4336) (IM.INDEX.DISPLAYFN 4338 . 8435)
|
||||
(IM.INDEX.EDIT 8437 . 12206) (IM.INDEX.LIST.FROM.STRING 12208 . 13242) (IM.INDEX.SIZEFN 13244 . 14004
|
||||
) (IM.INDEX.STRING.FROM.LIST 14006 . 14251) (IM.INDEX.PUTFN 14253 . 14599) (IM.INDEX.GETFN 14601 .
|
||||
14898) (IM.INDEX.BUTTONEVENTFN 14900 . 15657)) (15660 17730 (IM.INDEX.INIT 15670 . 17728)) (17731
|
||||
29647 (IM.INDEX.MENU 17741 . 19429) (IM.INDEX.MENU.WHENSELECTEDFN 19431 . 26186) (
|
||||
IM.INDEX.OBJ.FREEMENU.SELECTEDFN 26188 . 29645)) (32163 37306 (IM.CHAP.COPYFN 32173 . 32353) (
|
||||
IM.CHAP.CREATEOBJ 32355 . 33781) (IM.CHAP.DISPLAYFN 33783 . 35743) (IM.CHAP.SIZEFN 35745 . 36747) (
|
||||
IM.CHAP.PUTFN 36749 . 36933) (IM.CHAP.GETFN 36935 . 37096) (IM.CHAP.BUTTONEVENTFN 37098 . 37304)))))
|
||||
(FILEMAP (NIL (1692 15373 (IM.INDEX.CLOSEF 1702 . 2393) (IM.INDEX.COPYFN 2395 . 2580) (
|
||||
IM.INDEX.CREATEOBJ 2582 . 3928) (IM.INDEX.DISPLAY.STRING 3930 . 4351) (IM.INDEX.DISPLAYFN 4353 . 8450)
|
||||
(IM.INDEX.EDIT 8452 . 11920) (IM.INDEX.LIST.FROM.STRING 11922 . 12956) (IM.INDEX.SIZEFN 12958 . 13718
|
||||
) (IM.INDEX.STRING.FROM.LIST 13720 . 13965) (IM.INDEX.PUTFN 13967 . 14313) (IM.INDEX.GETFN 14315 .
|
||||
14612) (IM.INDEX.BUTTONEVENTFN 14614 . 15371)) (15374 17444 (IM.INDEX.INIT 15384 . 17442)) (17445
|
||||
29361 (IM.INDEX.MENU 17455 . 19143) (IM.INDEX.MENU.WHENSELECTEDFN 19145 . 25900) (
|
||||
IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25902 . 29359)) (31877 37020 (IM.CHAP.COPYFN 31887 . 32067) (
|
||||
IM.CHAP.CREATEOBJ 32069 . 33495) (IM.CHAP.DISPLAYFN 33497 . 35457) (IM.CHAP.SIZEFN 35459 . 36461) (
|
||||
IM.CHAP.PUTFN 36463 . 36647) (IM.CHAP.GETFN 36649 . 36810) (IM.CHAP.BUTTONEVENTFN 36812 . 37018)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -71,17 +71,14 @@ popd >/dev/null 2>/dev/null
|
||||
|
||||
|
||||
# For linux and wsl create packages for each arch
|
||||
for wslp in linux wsl2 wsl1
|
||||
for wslp in linux wsl
|
||||
do
|
||||
# For each arch create a deb file
|
||||
for arch_base in x86_64^amd64 armv7l^armhf aarch64^arm64
|
||||
do
|
||||
if [ "${arch_base}" = armv7l^armhf ]
|
||||
if [[ ${wslp} = wsl && ${arch_base} = armv7l^armhf ]];
|
||||
then
|
||||
if [ "${wslp}" = wsl1 ] || [ "${wslp}" = wsl2 ]
|
||||
then
|
||||
continue
|
||||
fi
|
||||
continue
|
||||
fi
|
||||
arch=${arch_base%^*}
|
||||
debian_arch=${arch_base#*^}
|
||||
@@ -102,14 +99,8 @@ do
|
||||
MEDLEYDIR=${il_dir#${pkg_dir}}/medley
|
||||
# Maiko and Medley files to il_dir (/usr/local/interlisp)
|
||||
mkdir -p ${il_dir}
|
||||
if [ "${wslp}" = wsl1 ]
|
||||
then
|
||||
tar -x -z -C ${il_dir} \
|
||||
-f "${tarball_dir}/maiko-${maiko_release}-wsl1.${arch}.tgz"
|
||||
else
|
||||
tar -x -z -C ${il_dir} \
|
||||
-f "${tarball_dir}/maiko-${maiko_release}-linux.${arch}.tgz"
|
||||
fi
|
||||
tar -x -z -C ${il_dir} \
|
||||
-f "${tarball_dir}/maiko-${maiko_release}-linux.${arch}.tgz"
|
||||
tar -x -z -C ${il_dir} \
|
||||
-f "${tarball_dir}/medley-${medley_release}-runtime.tgz"
|
||||
tar -x -z -C ${il_dir} \
|
||||
@@ -126,17 +117,14 @@ do
|
||||
sed -e "s>--MEDLEYDIR-->${MEDLEYDIR}>g" <postrm >${pkg_dir}/DEBIAN/postrm
|
||||
chmod +x ${pkg_dir}/DEBIAN/postrm
|
||||
# For wsl scripts, include the vncviewer.exe
|
||||
if [ "${wslp}" = wsl1 ] || [ "${wslp}" = wsl2 ]
|
||||
if [[ ${wslp} = wsl && ${arch} = x86_64 ]];
|
||||
then
|
||||
if [ "${arch}" = x86_64 ]
|
||||
then
|
||||
pushd ./tmp >/dev/null
|
||||
rm -rf vncviewer64-1.12.0.exe
|
||||
wget -q https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe
|
||||
popd >/dev/null
|
||||
mkdir -p ${il_dir}/wsl
|
||||
cp -p tmp/vncviewer64-1.12.0.exe ${il_dir}/wsl/vncviewer64-1.12.0.exe
|
||||
fi
|
||||
pushd ./tmp >/dev/null
|
||||
rm -rf vncviewer64-1.12.0.exe
|
||||
wget -q https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe
|
||||
popd >/dev/null
|
||||
mkdir -p ${il_dir}/wsl
|
||||
cp -p tmp/vncviewer64-1.12.0.exe ${il_dir}/wsl/vncviewer64-1.12.0.exe
|
||||
fi
|
||||
#
|
||||
# Make sure all files are owned by root
|
||||
|
||||
@@ -1,9 +0,0 @@
|
||||
Package: medley-interlisp
|
||||
Version: 1.0.0
|
||||
Release: --RELEASE--
|
||||
Maintainer: info@interlisp.org
|
||||
Description: Medley Interlisp for Linux
|
||||
Homepage: https://github.com/interlisp/medley
|
||||
Architecture: --ARCH--
|
||||
Depends: wslu ( >= 4.1 ) | wslu ( << 4.0 ), tigervnc-standalone-server, tigervnc-xorg-extension
|
||||
|
||||
@@ -15,16 +15,11 @@
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-linux-aarch64-@@@COMBINED.RELEASE.TAG@@@.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-linux-armv7l-@@@COMBINED.RELEASE.TAG@@@.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
|
||||
<li><h4>Windows System for Linux v1</h4>
|
||||
<li><h4>Windows System for Linux</h4>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl1-x86_64-@@@COMBINED.RELEASE.TAG@@@.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86.64 machines</a></p>
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl-x86_64-@@@COMBINED.RELEASE.TAG@@@.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86.64 machines</a></p>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl1-aarch64-@@@COMBINED.RELEASE.TAG@@@.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
|
||||
<li><h4>Windows System for Linux v2</h4>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl2-x86_64-@@@COMBINED.RELEASE.TAG@@@.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86.64 machines</a></p>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl2-aarch64-@@@COMBINED.RELEASE.TAG@@@.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl-aarch64-@@@COMBINED.RELEASE.TAG@@@.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
|
||||
</ul></li>
|
||||
<li><h3>Local Installations (for any Linux distro)</h3>
|
||||
|
||||
@@ -36,16 +31,11 @@
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-linux-aarch64-@@@COMBINED.RELEASE.TAG@@@.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-linux-armv7l-@@@COMBINED.RELEASE.TAG@@@.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
|
||||
<li><h4>Windows System for Linux v1</h4>
|
||||
<li><h4>Windows System for Linux</h4>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl1-x86_64-@@@COMBINED.RELEASE.TAG@@@.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl-x86_64-@@@COMBINED.RELEASE.TAG@@@.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl1-aarch64-@@@COMBINED.RELEASE.TAG@@@.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
|
||||
<li><h4>Windows System for Linux v2</h4>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl2-x86_64-@@@COMBINED.RELEASE.TAG@@@.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl2-aarch64-@@@COMBINED.RELEASE.TAG@@@.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl-aarch64-@@@COMBINED.RELEASE.TAG@@@.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
|
||||
</ul></li>
|
||||
</ul></li>
|
||||
<li><h2>WINDOWS 10/11 (Single install based on cygwin - Docker install deprecated)</h2>
|
||||
|
||||
@@ -12,17 +12,11 @@
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](@@@DOWNLOAD_URL@@@/medley-full-linux-armv7l-@@@COMBINED.RELEASE.TAG@@@.deb)
|
||||
|
||||
* #### Windows System for Linux v1
|
||||
* #### Windows System for Linux
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\.64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl1-x86\_64-@@@COMBINED.RELEASE.TAG@@@.deb)
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\.64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl-x86\_64-@@@COMBINED.RELEASE.TAG@@@.deb)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl1-aarch64-@@@COMBINED.RELEASE.TAG@@@.deb)
|
||||
|
||||
* #### Windows System for Linux v2
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\.64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl2-x86\_64-@@@COMBINED.RELEASE.TAG@@@.deb)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl2-aarch64-@@@COMBINED.RELEASE.TAG@@@.deb)
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl-aarch64-@@@COMBINED.RELEASE.TAG@@@.deb)
|
||||
|
||||
* ### Local Installations (for any Linux distro)
|
||||
|
||||
@@ -34,17 +28,11 @@
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](@@@DOWNLOAD_URL@@@/medley-full-linux-armv7l-@@@COMBINED.RELEASE.TAG@@@.tgz)
|
||||
|
||||
* #### Windows System for Linux v1
|
||||
* #### Windows System for Linux
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl1-x86\_64-@@@COMBINED.RELEASE.TAG@@@.tgz)
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl-x86\_64-@@@COMBINED.RELEASE.TAG@@@.tgz)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl1-aarch64-@@@COMBINED.RELEASE.TAG@@@.tgz)
|
||||
|
||||
* #### Windows System for Linux v2
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl2-x86\_64-@@@COMBINED.RELEASE.TAG@@@.tgz)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl2-aarch64-@@@COMBINED.RELEASE.TAG@@@.tgz)
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl-aarch64-@@@COMBINED.RELEASE.TAG@@@.tgz)
|
||||
|
||||
* ## WINDOWS 10/11 (Single install based on cygwin - Docker install deprecated)
|
||||
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-May-2025 15:37:36" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;8 31221
|
||||
(FILECREATED "14-Jul-2024 12:51:12" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;16 30093
|
||||
|
||||
:CHANGES-TO (FNS MAKE-INDEX-HTMLS)
|
||||
|
||||
:PREVIOUS-DATE "16-May-2025 13:51:08" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;7)
|
||||
:PREVIOUS-DATE "13-Jul-2024 23:39:43" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;14)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
@@ -108,14 +108,12 @@
|
||||
(HELP])
|
||||
|
||||
(MAKE-FULLER-DB
|
||||
[LAMBDA (DRIBBLEFILE DBFILE SYSOUTFILE) (* ; "Edited 28-Mar-2025 08:53 by lmm")
|
||||
(* ; "Edited 3-Aug-2023 18:12 by frank")
|
||||
[LAMBDA (DRIBBLEFILE DBFILE SYSOUTFILE) (* ; "Edited 3-Aug-2023 18:12 by frank")
|
||||
(* ; "Edited 16-Jul-2022 22:07 by larry")
|
||||
(* ; "Edited 20-Jun-2022 17:23 by larry")
|
||||
(FILESLOAD (SOURCE)
|
||||
FILESETS)
|
||||
(DRIBBLE (OR DRIBBLEFILE "fuller.dribble"))
|
||||
(FILESLOAD LAFITE)
|
||||
(DOFILESLOAD (SUBSET (APPEND OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
'FINDFILE))
|
||||
(GATHER-INFO 'ALL)
|
||||
@@ -126,89 +124,79 @@
|
||||
"Welcome to Fuller sysout"])
|
||||
|
||||
(MAKE-INDEX-HTMLS
|
||||
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
[LAMBDA (BASE TOP LEVEL) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
(* ; "Edited 26-Apr-2024 16:15 by lmm")
|
||||
(* ; "Edited 20-Apr-2024 12:34 by lmm")
|
||||
(* ; "Edited 13-Apr-2024 21:18 by lmm")
|
||||
(* ; " Edited 16-May-2025 13:17 by fgh")
|
||||
[OR BASE (SETQ BASE (TRUEFILENAME (MEDLEYDIR]
|
||||
(* ; "Edited 13-Apr-2024 21:18 by lmm")
|
||||
[OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
|
||||
(OR (DIRECTORYNAMEP BASE)
|
||||
(ERROR BASE "not a directory name"))
|
||||
(OR (AND (NUMBERP LEVEL)
|
||||
(IGREATERP LEVEL 0))
|
||||
(SETQ LEVEL 1))
|
||||
(OR ROOT.NAME (SETQ ROOT.NAME 'MEDLEY))
|
||||
(RESETLST
|
||||
(if (EQ LEVEL 1)
|
||||
then (RESETSAVE (PSEUDOHOSTS T))
|
||||
(PSEUDOHOST ROOT.NAME BASE))
|
||||
(SETQ BASE (PSEUDOFILENAME BASE))
|
||||
[LET*
|
||||
((SUBDIRS NIL)
|
||||
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
|
||||
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
|
||||
'}))
|
||||
SLASHED SHORTNAME)
|
||||
(CL:WITH-OPEN-FILE
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
|
||||
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
|
||||
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
|
||||
(CL:FORMAT S "<SCRIPT>~%%")
|
||||
(CL:FORMAT S " function up_onclick(){~%%")
|
||||
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
|
||||
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
|
||||
(CL:FORMAT S " }~%%")
|
||||
(CL:FORMAT S "</SCRIPT>~%%")
|
||||
(CL:FORMAT S "</HEAD>~%%")
|
||||
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
|
||||
(CL:UNLESS (EQ LEVEL 1)
|
||||
(CL:FORMAT S
|
||||
(LET* ((SUBDIRS NIL)
|
||||
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
|
||||
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
|
||||
'}))
|
||||
SLASHED SHORTNAME)
|
||||
(CL:WITH-OPEN-FILE
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
|
||||
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
|
||||
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
|
||||
(CL:FORMAT S "<SCRIPT>~%%")
|
||||
(CL:FORMAT S " function up_onclick(){~%%")
|
||||
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
|
||||
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
|
||||
(CL:FORMAT S " }~%%")
|
||||
(CL:FORMAT S "</SCRIPT>~%%")
|
||||
(CL:FORMAT S "</HEAD>~%%")
|
||||
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
|
||||
(CL:UNLESS (EQ LEVEL 1)
|
||||
(CL:FORMAT S
|
||||
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
|
||||
))
|
||||
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
|
||||
(for FULLNAME in (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
do (if (EQ (NTHCHAR FULLNAME -1)
|
||||
'>)
|
||||
then
|
||||
(* ;; "A directory")
|
||||
))
|
||||
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
|
||||
(FOR FULLNAME IN (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
DO (IF (EQ (NTHCHAR FULLNAME -1)
|
||||
'>)
|
||||
THEN
|
||||
(* ;; "A directory")
|
||||
|
||||
(if (NOT (DIRECTORYNAMEP FULLNAME))
|
||||
then (HELP (CONCAT "NOT DIRNAME " FULLNAME)))
|
||||
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
|
||||
(+ (NCHARS BASE)
|
||||
(if PSEUDOHOST
|
||||
then 2
|
||||
else 1))
|
||||
-2)))
|
||||
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
|
||||
(MEMB SHORTNAME '(.GIT))
|
||||
[AND (STRPOS ".git" (L-CASE FULLNAME))
|
||||
(NOT (STRPOS ".github" (L-CASE FULLNAME]
|
||||
(INFILEP (CONCAT FULLNAME ".skip")))
|
||||
(IF (NOT (DIRECTORYNAMEP FULLNAME))
|
||||
THEN (HELP "NOT DIRNAME"))
|
||||
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
|
||||
(+ (NCHARS BASE)
|
||||
(IF PSEUDOHOST
|
||||
THEN 2
|
||||
ELSE 1))
|
||||
-2)))
|
||||
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
|
||||
(STRPOS ".git" FULLNAME)
|
||||
(INFILEP (CONCAT FULLNAME ".skip")))
|
||||
|
||||
(* ;; ".skip in the directory itself -- don't index any of it")
|
||||
(* ;; ".skip in the directory itself -- don't index any of it")
|
||||
|
||||
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
|
||||
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
|
||||
elseif (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
|
||||
(SUB1 (OR (STRPOS ".;" FULLNAME)
|
||||
(STRPOS ";" FULLNAME)
|
||||
(HELP (CONCAT
|
||||
"No ; in non-directory "
|
||||
FULLNAME]
|
||||
'(index.html .skip))
|
||||
then
|
||||
(* ;; "dont index the index")
|
||||
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
|
||||
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
|
||||
ELSEIF (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
|
||||
(SUB1 (OR (STRPOS ".;" FULLNAME)
|
||||
(STRPOS ";" FULLNAME)
|
||||
(HELP
|
||||
"No ; in non-directory"
|
||||
]
|
||||
'(index.html .skip))
|
||||
THEN
|
||||
(* ;; "dont index the index")
|
||||
|
||||
elseif (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
|
||||
'(IMPTR SKIP skip imptr))
|
||||
then
|
||||
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
|
||||
ELSEIF (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
|
||||
'(IMPTR SKIP skip imptr))
|
||||
THEN
|
||||
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
|
||||
|
||||
else (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
|
||||
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
|
||||
(NCONC SUBDIRS (for D in SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
|
||||
(ADD1 LEVEL])])
|
||||
ELSE (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
|
||||
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
|
||||
(NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
|
||||
(ADD1 LEVEL])
|
||||
|
||||
(MEDLEY-FIX-LINKS
|
||||
[LAMBDA (UNIXPATH) (* ; "Edited 18-Jan-2021 12:01 by larry")
|
||||
@@ -301,11 +289,11 @@
|
||||
(PHASES (OR SUBSETS '(TEDIT PRETTY INDEX HRULE]
|
||||
(FILESLOAD PDFSTREAM SKETCH)
|
||||
(FONTSET 'STANDARD)
|
||||
(while DIRLIST
|
||||
do
|
||||
(SETQ BASE (pop DIRLIST))
|
||||
(for SRCPATH in (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
do (PROG* [(SRC (UNPACKFILENAME SRCPATH))
|
||||
(WHILE DIRLIST
|
||||
DO
|
||||
(SETQ BASE (POP DIRLIST))
|
||||
(FOR SRCPATH IN (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
DO (PROG* [(SRC (UNPACKFILENAME SRCPATH))
|
||||
[EXT (U-CASE (LISTGET SRC 'EXTENSION]
|
||||
(DIR (LISTGET SRC 'DIRECTORY))
|
||||
FRDY LDGP DEST (NOV (PACKFILENAME `(VERSION NIL ,@SRC]
|
||||
@@ -338,13 +326,13 @@
|
||||
(CL:WHEN (INFILEP (CONCAT DEST ".skip"))
|
||||
(PRINTOUT T "Explicit .skip " DEST T)
|
||||
(RETURN))
|
||||
(if (MEMB 'TEDIT PHASES)
|
||||
then (CL:WHEN [OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
|
||||
(IF (MEMB 'TEDIT PHASES)
|
||||
THEN (CL:WHEN [OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
|
||||
(CAR (NLSETQ (TEDIT.FORMATTEDFILEP SRCPATH]
|
||||
(if (EQ REDO 'TEST)
|
||||
then (CL:FORMAT T "Testing open ~a..." SRCPATH)
|
||||
(IF (EQ REDO 'TEST)
|
||||
THEN (CL:FORMAT T "Testing open ~a..." SRCPATH)
|
||||
(CLOSEF? (OPENTEXTSTREAM SRCPATH))
|
||||
else (OR [NLSETQ (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM SRCPATH)
|
||||
ELSE (OR [NLSETQ (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM SRCPATH)
|
||||
)
|
||||
(TEDIT.FORMAT.HARDCOPY S DEST T NIL NIL
|
||||
NIL 'PDF]
|
||||
@@ -361,89 +349,79 @@
|
||||
(PRINTOUT T "DONE" T))])
|
||||
|
||||
(MAKE-INDEX-HTMLS
|
||||
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
[LAMBDA (BASE TOP LEVEL) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
(* ; "Edited 26-Apr-2024 16:15 by lmm")
|
||||
(* ; "Edited 20-Apr-2024 12:34 by lmm")
|
||||
(* ; "Edited 13-Apr-2024 21:18 by lmm")
|
||||
(* ; " Edited 16-May-2025 13:17 by fgh")
|
||||
[OR BASE (SETQ BASE (TRUEFILENAME (MEDLEYDIR]
|
||||
(* ; "Edited 13-Apr-2024 21:18 by lmm")
|
||||
[OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
|
||||
(OR (DIRECTORYNAMEP BASE)
|
||||
(ERROR BASE "not a directory name"))
|
||||
(OR (AND (NUMBERP LEVEL)
|
||||
(IGREATERP LEVEL 0))
|
||||
(SETQ LEVEL 1))
|
||||
(OR ROOT.NAME (SETQ ROOT.NAME 'MEDLEY))
|
||||
(RESETLST
|
||||
(if (EQ LEVEL 1)
|
||||
then (RESETSAVE (PSEUDOHOSTS T))
|
||||
(PSEUDOHOST ROOT.NAME BASE))
|
||||
(SETQ BASE (PSEUDOFILENAME BASE))
|
||||
[LET*
|
||||
((SUBDIRS NIL)
|
||||
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
|
||||
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
|
||||
'}))
|
||||
SLASHED SHORTNAME)
|
||||
(CL:WITH-OPEN-FILE
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
|
||||
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
|
||||
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
|
||||
(CL:FORMAT S "<SCRIPT>~%%")
|
||||
(CL:FORMAT S " function up_onclick(){~%%")
|
||||
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
|
||||
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
|
||||
(CL:FORMAT S " }~%%")
|
||||
(CL:FORMAT S "</SCRIPT>~%%")
|
||||
(CL:FORMAT S "</HEAD>~%%")
|
||||
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
|
||||
(CL:UNLESS (EQ LEVEL 1)
|
||||
(CL:FORMAT S
|
||||
(LET* ((SUBDIRS NIL)
|
||||
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
|
||||
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
|
||||
'}))
|
||||
SLASHED SHORTNAME)
|
||||
(CL:WITH-OPEN-FILE
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
|
||||
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
|
||||
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
|
||||
(CL:FORMAT S "<SCRIPT>~%%")
|
||||
(CL:FORMAT S " function up_onclick(){~%%")
|
||||
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
|
||||
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
|
||||
(CL:FORMAT S " }~%%")
|
||||
(CL:FORMAT S "</SCRIPT>~%%")
|
||||
(CL:FORMAT S "</HEAD>~%%")
|
||||
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
|
||||
(CL:UNLESS (EQ LEVEL 1)
|
||||
(CL:FORMAT S
|
||||
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
|
||||
))
|
||||
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
|
||||
(for FULLNAME in (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
do (if (EQ (NTHCHAR FULLNAME -1)
|
||||
'>)
|
||||
then
|
||||
(* ;; "A directory")
|
||||
))
|
||||
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
|
||||
(FOR FULLNAME IN (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
DO (IF (EQ (NTHCHAR FULLNAME -1)
|
||||
'>)
|
||||
THEN
|
||||
(* ;; "A directory")
|
||||
|
||||
(if (NOT (DIRECTORYNAMEP FULLNAME))
|
||||
then (HELP (CONCAT "NOT DIRNAME " FULLNAME)))
|
||||
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
|
||||
(+ (NCHARS BASE)
|
||||
(if PSEUDOHOST
|
||||
then 2
|
||||
else 1))
|
||||
-2)))
|
||||
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
|
||||
(MEMB SHORTNAME '(.GIT))
|
||||
[AND (STRPOS ".git" (L-CASE FULLNAME))
|
||||
(NOT (STRPOS ".github" (L-CASE FULLNAME]
|
||||
(INFILEP (CONCAT FULLNAME ".skip")))
|
||||
(IF (NOT (DIRECTORYNAMEP FULLNAME))
|
||||
THEN (HELP "NOT DIRNAME"))
|
||||
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
|
||||
(+ (NCHARS BASE)
|
||||
(IF PSEUDOHOST
|
||||
THEN 2
|
||||
ELSE 1))
|
||||
-2)))
|
||||
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
|
||||
(STRPOS ".git" FULLNAME)
|
||||
(INFILEP (CONCAT FULLNAME ".skip")))
|
||||
|
||||
(* ;; ".skip in the directory itself -- don't index any of it")
|
||||
(* ;; ".skip in the directory itself -- don't index any of it")
|
||||
|
||||
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
|
||||
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
|
||||
elseif (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
|
||||
(SUB1 (OR (STRPOS ".;" FULLNAME)
|
||||
(STRPOS ";" FULLNAME)
|
||||
(HELP (CONCAT
|
||||
"No ; in non-directory "
|
||||
FULLNAME]
|
||||
'(index.html .skip))
|
||||
then
|
||||
(* ;; "dont index the index")
|
||||
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
|
||||
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
|
||||
ELSEIF (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
|
||||
(SUB1 (OR (STRPOS ".;" FULLNAME)
|
||||
(STRPOS ";" FULLNAME)
|
||||
(HELP
|
||||
"No ; in non-directory"
|
||||
]
|
||||
'(index.html .skip))
|
||||
THEN
|
||||
(* ;; "dont index the index")
|
||||
|
||||
elseif (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
|
||||
'(IMPTR SKIP skip imptr))
|
||||
then
|
||||
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
|
||||
ELSEIF (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
|
||||
'(IMPTR SKIP skip imptr))
|
||||
THEN
|
||||
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
|
||||
|
||||
else (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
|
||||
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
|
||||
(NCONC SUBDIRS (for D in SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
|
||||
(ADD1 LEVEL])])
|
||||
ELSE (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
|
||||
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
|
||||
(NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
|
||||
(ADD1 LEVEL])
|
||||
)
|
||||
|
||||
(PUTPROPS MEDLEY-UTILS FILETYPE :COMPILE-FILE)
|
||||
@@ -550,9 +528,9 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1086 12975 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7389) (MAKE-INDEX-HTMLS
|
||||
7391 . 12344) (MEDLEY-FIX-LINKS 12346 . 12739) (MEDLEY-FIX-DATES 12741 . 12973)) (14154 16942 (
|
||||
MAKE-EXPORTS-ALL 14164 . 15223) (MAKE-WHEREIS-HASH 15225 . 16414) (MAKE-WHEREIS-LOOPS 16416 . 16940))
|
||||
(16943 26173 (HCFILES 16953 . 21216) (MAKE-INDEX-HTMLS 21218 . 26171)) (26423 31035 (RECOMPILE-ONE
|
||||
26433 . 28330) (RECMPL 28332 . 28935) (COMPILE-SETUP 28937 . 29561) (REMAKEFILES 29563 . 31033)))))
|
||||
(FILEMAP (NIL (1086 12345 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7257) (MAKE-INDEX-HTMLS
|
||||
7259 . 11714) (MEDLEY-FIX-LINKS 11716 . 12109) (MEDLEY-FIX-DATES 12111 . 12343)) (13524 16312 (
|
||||
MAKE-EXPORTS-ALL 13534 . 14593) (MAKE-WHEREIS-HASH 14595 . 15784) (MAKE-WHEREIS-LOOPS 15786 . 16310))
|
||||
(16313 25045 (HCFILES 16323 . 20586) (MAKE-INDEX-HTMLS 20588 . 25043)) (25295 29907 (RECOMPILE-ONE
|
||||
25305 . 27202) (RECMPL 27204 . 27807) (COMPILE-SETUP 27809 . 28433) (REMAKEFILES 28435 . 29905)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,86 +1,43 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Mar-2025 20:03:27" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;10 3274
|
||||
(FILECREATED "17-Jan-2023 20:34:02" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-APPS.;3 2095
|
||||
|
||||
:EDIT-BY "frank"
|
||||
:CHANGES-TO (FNS Apps.RemoveBackgroundMenuItem)
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-APPS)
|
||||
|
||||
:PREVIOUS-DATE " 9-Mar-2025 19:42:36" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;8
|
||||
:PREVIOUS-DATE "17-Jan-2023 20:29:39" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-APPS.;2
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-APPSCOMS)
|
||||
|
||||
(RPAQQ LOADUP-APPSCOMS ((GLOBALVARS *ALL-BUTTONS* BackgroundMenuCommands BackgroundMenu)
|
||||
(FNS LOADUP-APPS Apps.RemoveBackgroundMenuItem)))
|
||||
(FNS Apps.LOADUP Apps.RemoveBackgroundMenuItem)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *ALL-BUTTONS* BackgroundMenuCommands BackgroundMenu)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(LOADUP-APPS
|
||||
[LAMBDA NIL (* ; "Edited 9-Mar-2025 20:02 by frank")
|
||||
(* ; "Edited 2-Jan-2025 20:38 by lmm")
|
||||
(* ; "Edited 2-Jan-2025 06:30 by larry")
|
||||
(Apps.LOADUP
|
||||
[LAMBDA NIL (* ; "Edited 12-Nov-2022 14:03 by FGH")
|
||||
(PROGN
|
||||
(* ;; " Delete button(s) that are created when lispusers/BUTTONS is loaded")
|
||||
|
||||
(* ;; "= = = = = = = = = = = = = = = = = =")
|
||||
(for B in *ALL-BUTTONS* do (DELETE-BUTTON B))
|
||||
|
||||
(* ;; " Load ROOMS")
|
||||
(* ;; " Remove the BUTTONS BackgroundMenu item")
|
||||
|
||||
(* ;; "")
|
||||
(Apps.RemoveBackgroundMenuItem "Button Control")
|
||||
|
||||
(DOFILESLOAD `((SYSLOAD SOURCE)
|
||||
(FROM ,(MEDLEYDIR "ROOMS"))
|
||||
ROOMS))
|
||||
(* ;; " Remove the NoteCards Background Menu Item")
|
||||
|
||||
(* ;; "======================")
|
||||
(Apps.RemoveBackgroundMenuItem 'NoteCards)
|
||||
|
||||
(* ;; " Load Notecards and %"fix up%"")
|
||||
(* ;; " Remove the CLOS Background Menu Item")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(DOFILESLOAD `((SYSLOAD)
|
||||
(FROM ,(CONCAT (UNIX-GETENV "NOTECARDSDIR")
|
||||
"/system"))
|
||||
NOTECARDS))
|
||||
(Apps.RemoveBackgroundMenuItem 'NoteCards) (* ; "")
|
||||
(PUTASSOC 'NOTECARDS (LIST (UNIX-GETENV 'NOTECARDS_COMMIT_ID))
|
||||
SYSOUTCOMMITS)
|
||||
|
||||
(* ;; "======================")
|
||||
|
||||
(* ;; " Load CLOS and %"fix up%"")
|
||||
|
||||
(* ;; " Assumes that clos/DEFSYS.DFASL has already been loaded (so CLOS: package is defined)")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(LOADUP-CLOS)
|
||||
(CLOS::LOAD-CLOS) (* ; "")
|
||||
(Apps.RemoveBackgroundMenuItem 'BrowseClass)
|
||||
|
||||
(* ;; "= = = = = = = = = = = = = == = = = ")
|
||||
|
||||
(* ;; " Load lispusers/BUTTONS and %"fix up%"")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(DOFILESLOAD '((SYSLOAD)
|
||||
BUTTONS))
|
||||
(Apps.RemoveBackgroundMenuItem "Button Control")
|
||||
(for B in *ALL-BUTTONS* do (DELETE-BUTTON B))
|
||||
|
||||
(* ;; "= = = = = = = = = = = = = == = = = ")
|
||||
|
||||
(* ;; " Do misc")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(PUTASSOC 'MEDLEY (LIST (UNIX-GETENV 'LOADUP_COMMIT_ID))
|
||||
SYSOUTCOMMITS)
|
||||
(PRINTOUT T "commits-- " SYSOUTCOMMITS T])
|
||||
(Apps.RemoveBackgroundMenuItem 'BrowseClass)
|
||||
(RPLACA [CAR (LIST '(A B C]
|
||||
NIL])
|
||||
|
||||
(Apps.RemoveBackgroundMenuItem
|
||||
[LAMBDA (ItemStringOrAtom)
|
||||
@@ -95,5 +52,5 @@
|
||||
Apps.SBG])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (656 3251 (LOADUP-APPS 666 . 2579) (Apps.RemoveBackgroundMenuItem 2581 . 3249)))))
|
||||
(FILEMAP (NIL (647 2072 (Apps.LOADUP 657 . 1400) (Apps.RemoveBackgroundMenuItem 1402 . 2070)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,23 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Mar-2025 19:04:34" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-CLOS.;1 600
|
||||
|
||||
:EDIT-BY "frank"
|
||||
|
||||
:CHANGES-TO (VARS LOADUP-CLOSCOMS))
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-CLOSCOMS)
|
||||
|
||||
(RPAQQ LOADUP-CLOSCOMS ((FNS LOADUP-CLOS)))
|
||||
(DEFINEQ
|
||||
|
||||
(LOADUP-CLOS
|
||||
[LAMBDA NIL (* ; "Edited 9-Mar-2025 18:53 by frank")
|
||||
(DOFILESLOAD `((SYSLOAD)
|
||||
(FROM ,(MEDLEYDIR "CLOS"))
|
||||
DEFSYS])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (333 577 (LOADUP-CLOS 343 . 575)))))
|
||||
STOP
|
||||
Binary file not shown.
@@ -1,12 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Apr-2025 05:14:27" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;2 4662
|
||||
(FILECREATED "31-Jul-2023 18:28:53" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-FULL.;4 4521
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:CHANGES-TO (FNS LOADUP-FULL)
|
||||
|
||||
:CHANGES-TO (FNS LOADFULLFONTS)
|
||||
|
||||
:PREVIOUS-DATE "31-Jul-2023 18:28:53" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;1
|
||||
:PREVIOUS-DATE "18-Jan-2023 16:23:36" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-FULL.;3
|
||||
)
|
||||
|
||||
|
||||
@@ -17,8 +15,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(LOADFULLFONTS
|
||||
[LAMBDA NIL (* ; "Edited 23-Apr-2025 05:13 by lmm")
|
||||
(* ; "Edited 13-Feb-2021 22:51 by larry")
|
||||
[LAMBDA NIL (* ; "Edited 13-Feb-2021 22:51 by larry")
|
||||
|
||||
(* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q")
|
||||
|
||||
@@ -38,7 +35,7 @@
|
||||
(PRINTOUT T T))
|
||||
(PRINTOUT T " Loading postscript fonts" T)
|
||||
(for F in (FILDIR (CONCAT (CAR POSTSCRIPTFONTDIRECTORIES)
|
||||
">c0>*.PSCFONT")) do (PSCFONT.READFONT F))
|
||||
">c0>*.*")) do (PSCFONT.READFONT F))
|
||||
(PRINTOUT T "FULL fonts loaded" T])
|
||||
|
||||
(LOADUP-FULL
|
||||
@@ -89,5 +86,5 @@
|
||||
|
||||
(FIXMETA)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (493 4624 (LOADFULLFONTS 503 . 2059) (LOADUP-FULL 2061 . 4374) (FIXMETA 4376 . 4622)))))
|
||||
(FILEMAP (NIL (467 4483 (LOADFULLFONTS 477 . 1918) (LOADUP-FULL 1920 . 4233) (FIXMETA 4235 . 4481)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,343 +0,0 @@
|
||||
.\" Automatically generated by Pandoc 2.9.2.1
|
||||
.\"
|
||||
.ad l
|
||||
.TH "loadup" "1" "" "" "Run the Medley loadup procedure"
|
||||
.nh
|
||||
.SH NAME
|
||||
.PP
|
||||
\f[B]loadup\f[R] \[em] runs a loadup procedure for Medley Interlisp
|
||||
.SH SYNOPSIS
|
||||
.PP
|
||||
\f[B]<MEDLEYDIR>/scripts/loadup\f[R] [ options \&... ]
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
Runs all or part of the \f[B]loadup\f[R] procedure for Medley Interlisp.
|
||||
The loadup procedure is used to create the standard sysout files from
|
||||
which you can start a Medley session as well as other standard files
|
||||
that are useful in running Medley.
|
||||
After cloning Medley from GitHub or after making significant changes to
|
||||
the Medley source, you need to run the loadup procedure to (re)create
|
||||
these standard files.
|
||||
.PP
|
||||
The complete loadup procedure happens in 5 sequential stages with each
|
||||
stage depending on successful completion of the previous stage.
|
||||
There are two other non-sequential stages (Aux and DB), which depend
|
||||
only on the completion of Stage 4 (full.sysout).
|
||||
.PP
|
||||
You need not run all 5 stages, depending on what sysout files you need
|
||||
to create for your work.
|
||||
The target files created in each stage are copied into a loadups
|
||||
directory (<MEDLEYDIR>/loadups).
|
||||
The \f[I]medley\f[R] run script and other Medley tools look for these
|
||||
files in the loadups directory.
|
||||
.PP
|
||||
The 5 sequential stages and their main products are:
|
||||
.RS
|
||||
.IP "1." 3
|
||||
\f[B]Init:\f[R] create an \f[I]init.dlinit\f[R] sysout file.
|
||||
This init.dlinit file is used internally for Stage 2 and is not copied
|
||||
into the loadups directory.
|
||||
.RE
|
||||
.RS
|
||||
.IP "2." 3
|
||||
\f[B]Mid:\f[R] create an \f[I]init-mid.sysout\f[R].
|
||||
This init-mid.sysout is used only internally for Stage 3 and is not
|
||||
copied into the loadups directory.
|
||||
.RE
|
||||
.RS
|
||||
.IP "3." 3
|
||||
\f[B]Lisp:\f[R] create \f[I]lisp.sysout\f[R].
|
||||
Lisp.sysout has a minimal set of Medley\[cq]s functionality loaded and
|
||||
can be used as the basis for running a stripped-down Medley session.
|
||||
Lisp.sysout is copied into the loadups directory.
|
||||
.RE
|
||||
.RS
|
||||
.IP "4." 3
|
||||
\f[B]Full:\f[R] create \f[I]full.sysout\f[R].
|
||||
Full.sysout has all of the \[lq]standard\[rq] set of Medley
|
||||
functionality loaded and is the primary sysout used for running Medley
|
||||
sessions.
|
||||
Full.sysout is copied into the loadups directory.
|
||||
.RE
|
||||
.RS
|
||||
.IP "5." 3
|
||||
\f[B]Apps:\f[R]: create \f[I]apps.sysout\f[R].
|
||||
Apps.sysout includes everything in full.sysout plus the Medley
|
||||
applications Buttons, CLOS, Rooms, and Notecards.
|
||||
.RE
|
||||
.PP
|
||||
The two independent stages that can be run if the first 4 sequential
|
||||
stages complete successfully are:
|
||||
.RS
|
||||
.IP \[bu] 2
|
||||
\f[B]Aux:\f[R]: create the \f[I]whereis.hash\f[R] and
|
||||
\f[I]exports.all\f[R] files.
|
||||
These are databases that are commonly used when working on Medley source
|
||||
code.
|
||||
They are copied into the loadups directory.
|
||||
.IP \[bu] 2
|
||||
\f[B]DB:\f[R]: creates the \f[I]fuller.database\f[R] file.
|
||||
Fuller.database is a Mastercope database created by analyzing all of the
|
||||
source code included in full.sysout.
|
||||
(Stage 4) Fuller.database is copied into the loadups directory.
|
||||
.RE
|
||||
.PP
|
||||
Loadup does all of its work in a work directory
|
||||
(<MEDLEYDIR>loadups/build).
|
||||
The target files are copied from this work directory to the loadups
|
||||
directory if the loadup is successful.
|
||||
Each stage of the loadup also creates a dribble file containing the
|
||||
terminal output from within the Medley environment.
|
||||
These dribble files are also copied to the loadups directory, but also
|
||||
remain available in the work directory after the loadup completes.
|
||||
.PP
|
||||
Only one instance (per <MEDLEIDIR>) of loadup can be run at a time.
|
||||
There is lock file to prevent simultaneous loadups in the work directory
|
||||
(named \f[B]\f[BI]lock\f[B]\f[R]) that can be manually removed.
|
||||
The lock can also be automatically overridden (see the \[en]override
|
||||
flag below).
|
||||
Alternatively, if a lock is encountered at run time, the user will be
|
||||
asked to choose whether to override or simply exit the loadup.
|
||||
.PP
|
||||
Note: \f[B]MEDLEYDIR\f[R] is an environment variable set by the loadup
|
||||
script.
|
||||
It is set to the top level directory of the Medley installation that
|
||||
contains the specific loadup script that is invoked after all symbolic
|
||||
links are resolved.
|
||||
In the standard global installation this will be
|
||||
/usr/local/interlisp/medley.
|
||||
But Medley can be installed in multiple places on any given machine and
|
||||
hence MEDLEYDIR is computed on each invocation of loadup.
|
||||
.SH OPTIONS
|
||||
.TP
|
||||
\f[B]-z, --man, -man\f[R]
|
||||
Print this manual page on the screen.
|
||||
.TP
|
||||
\f[B]-t STAGE, --target STAGE, -target STAGE\f[R]
|
||||
Run the sequential loadup procedure until the STAGE is complete,
|
||||
starting from the files created by the previously run STAGE specified in
|
||||
the \[en]start option.
|
||||
.RS
|
||||
.PP
|
||||
STAGE can be one of the following:
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit).
|
||||
Init.dlinit is \f[I]not\f[R] copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
m, mid, 2: Run the loadup sequence through Stage 2 (init-mid.sysout).
|
||||
Init-mid.sysout is \f[I]not\f[R] copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
l, lisp, 3: Run the loadup sequence through Stage 3 (lisp.sysout).
|
||||
Lisp.sysout is copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
f, full, 4: Run the loadup sequence through Stage 4 (full.sysout).
|
||||
Full.sysout is copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||
Also run the Aux stage as if \[en]aux option had been specified.
|
||||
Apps.sysout and the Aux files are copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||
The Aux stage is not run unless otherwise specified.
|
||||
Apps.sysout is copied into the loadups directory.
|
||||
Also run the Aux stage as if \[en]aux option had been specified.
|
||||
.RE
|
||||
.RE
|
||||
.TP
|
||||
\f[B]-s STAGE --start STAGE, -start STAGE\f[R]
|
||||
Start the loadup process using the files previously created by STAGE.
|
||||
These files are looked for first in the loadups directory or, if not
|
||||
found there, in the work directory.
|
||||
It is an error if the files created by STAGE cannot be found.
|
||||
.RS
|
||||
.PP
|
||||
STAGE can be one of the following:
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
s, scratch, 0 : Start the loadup process from the beginning.
|
||||
This is the default.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
i, init, 1 : Start the loadup process using the files created by Stage 1
|
||||
(init.dlinit).
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
m, mid, 2 : Start the loadup process using the files created by Stage 2
|
||||
(init-mid.sysout).
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
l, lisp, 3 : Start the loadup process using the files created by Stage 3
|
||||
(lisp.sysout)
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
f, full, 4 : Start the loadup process using the files created by Stage 4
|
||||
(full.sysout).
|
||||
.RE
|
||||
.RE
|
||||
.TP
|
||||
\f[B]-x, --aux, -aux\f[R]
|
||||
Run the Aux loadup stage, creating the \f[I]whereis.hash\f[R] and
|
||||
\f[I]exports.all\f[R] files.
|
||||
If loadup completes successfully, these files are copied into loadups.
|
||||
.TP
|
||||
\f[B]-b, --db, -db\f[R]
|
||||
Run the DB loadup stage, creating the \f[I]fuller.database\f[R] file.
|
||||
If this stage complete successfully, these files are copied into
|
||||
loadups.
|
||||
.TP
|
||||
\f[B]-i, --init, -init, -1\f[R]
|
||||
Synonym for \[lq]\[en]target init\[rq]
|
||||
.TP
|
||||
\f[B]-m, --mid, -mid, -2\f[R]
|
||||
Synonym for \[lq]\[en]target mid\[rq]
|
||||
.TP
|
||||
\f[B]-l, --lisp, -lisp, -3\f[R]
|
||||
Synonym for \[lq]\[en]target lisp\[rq]
|
||||
.TP
|
||||
\f[B]-f, --full. -full, -4\f[R]
|
||||
Synonym for \[lq]\[en]target full\[rq]
|
||||
.TP
|
||||
\f[B]-a, --apps, -apps, -5\f[R]
|
||||
Synonym for \[lq]\[en]target apps\[rq]
|
||||
.TP
|
||||
\f[B]-a-, --apps-, -apps-, -5-\f[R]
|
||||
Synonym for \[lq]\[en]target apps\[rq]
|
||||
.TP
|
||||
\f[B]-ov, --override, -override\f[R]
|
||||
Automatically override the lock that prevents two loadups from running
|
||||
simultaneously.
|
||||
If this flag is not set and an active lock is encountered, the user will
|
||||
be asked to choose whether to override or exit.
|
||||
.TP
|
||||
\f[B]-nc, --nocopy, -nocopy\f[R]
|
||||
Run the specified loadups, but do not copy results into loadups
|
||||
directory.
|
||||
.TP
|
||||
\f[B]-tw, --thinw, -thinw\f[R]
|
||||
Before running loadups (if any), thin the working directory by deleting
|
||||
all versioned (\f[I].\[ti][0-9]\f[R]\[ti]) files.
|
||||
.TP
|
||||
\f[B]-tl, --thinl, -thinl\f[R]
|
||||
Before running loadups (if any), thin the loadups directory by deleting
|
||||
all versioned (\f[I].\[ti][0-9]\f[R]\[ti]) files.
|
||||
.TP
|
||||
\f[B]-d DIR, --maikodir DIR, -maikodir DIR\f[R]
|
||||
Use DIR as the directory from which to execute lde (Miko) when running
|
||||
Medley in the loadup process.
|
||||
If this flag is not present, the value of the environment variable
|
||||
MAIKODIR will be used instead.
|
||||
And if MAIKODIR does not exist, then the default Maiko directory search
|
||||
within Medley will be used.
|
||||
.TP
|
||||
\f[B]-v, --vnc, -vnc\f[R]
|
||||
Relevant to Linux (including WSLv1 and WSLv2) platforms only.
|
||||
Use Xvnc for the Medley display during this loadup.
|
||||
By default, the Medley display will use X Windows.
|
||||
This flag is most useful on Windows System for Linux v1, where Xvnc is
|
||||
commonly used in running Medley in the absence of an Xwindows server.
|
||||
.SH DEFAULTS
|
||||
.PP
|
||||
The defaults for the Options context-dependent and somewhat complicated
|
||||
due to the goal of maintaining compatibility with legacy loadup scripts.
|
||||
All of the following defaults rules hold independent of the
|
||||
\[en]maikodir (-d) option.
|
||||
.IP "1." 3
|
||||
If none of \[en]target, \[en]start, \[en]aux, and \[en]db are specified,
|
||||
then:
|
||||
.RS
|
||||
.PP
|
||||
1A.
|
||||
If neither \[en]thinw nor \[en]thinl are specified, the options default
|
||||
to:
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
\f[B]\[en]target full \[en]start 0 \[en]aux\f[R]
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.PP
|
||||
1B.
|
||||
If either \[en]thinw or \[en]thinl are specified, no loadups are run.
|
||||
.RE
|
||||
.IP "2." 3
|
||||
If neither \[en]start nor \[en]target are specified but either -aux or
|
||||
-db or both are, then \[en]start defaults to \f[I]full\f[R] and
|
||||
\[en]target is irrelevant.
|
||||
.IP "3." 3
|
||||
If \[en]start is specified and \[en]target is not, then \[en]target
|
||||
defaults to \f[I]full\f[R]
|
||||
.IP "4." 3
|
||||
If \[en]target is specified and \[en]start is not, then \[en]start
|
||||
defaults to \f[I]0\f[R]
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
\f[B]./loadup -full -s lisp\f[R] : run loadup thru Stage 4 (full.sysout)
|
||||
starting from existing Stage 3 outputs (lisp.sysout).
|
||||
.PP
|
||||
\f[B]./loadup --target full --start lisp\f[R] : run loadup thru Stage 4
|
||||
(full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
||||
.PP
|
||||
\f[B]./loadup -5 \[en]aux\f[R] : run loadup from the beginning thru
|
||||
Stage 5 (apps.sysout) then run the Aux \[lq]stage\[rq] to create
|
||||
\f[I]whereis.hash\f[R] and \f[I]exports.all\f[R]
|
||||
.PP
|
||||
\f[B]./loadup -db\f[R] : just run the DB \[lq]stage\[rq] starting from
|
||||
an existing full.sysout; do not run any of the sequential stages.
|
||||
.PP
|
||||
\f[B]./loadup \[en]maikodir \[ti]/il/newmaiko\f[R] : run loadup sequence
|
||||
from beginning to full plus the loadup Aux stage, while using
|
||||
\f[I]\[ti]/il/newmaiko\f[R] as the location for the lde executables when
|
||||
running Medley.
|
||||
.PP
|
||||
\f[B]./loadup -full\f[R] : run loadup sequence from beginning thru full
|
||||
.PP
|
||||
\f[B]./loadup -apps\f[R] : run loadup sequence from beginning thru app.
|
||||
Also run the Aux stage loadup.
|
||||
.PP
|
||||
\f[B]./loadup -apps-\f[R] : run loadup sequence from beginning thru app.
|
||||
Do not run the Aux stage loadup.
|
||||
.SH BUGS
|
||||
.PP
|
||||
See GitHub Issues: <https://github.com/Interlisp/medley/issues>
|
||||
.SH COPYRIGHT
|
||||
.PP
|
||||
Copyright(c) 2025 by Interlisp.org
|
||||
Binary file not shown.
@@ -1,188 +0,0 @@
|
||||
% loadup(1) | Run the Medley loadup procedure
|
||||
|
||||
---
|
||||
adjusting: l
|
||||
hyphenate: false
|
||||
---
|
||||
|
||||
NAME
|
||||
====
|
||||
|
||||
**loadup** — runs a loadup procedure for Medley Interlisp
|
||||
|
||||
SYNOPSIS
|
||||
========
|
||||
|
||||
**\<MEDLEYDIR>/scripts/loadup** \[ options ... ]
|
||||
|
||||
|
||||
DESCRIPTION
|
||||
===========
|
||||
|
||||
Runs all or part of the **loadup** procedure for Medley Interlisp. The loadup procedure is used to create the standard sysout files from which you can start a Medley session as well as other standard files that are useful in running Medley. After cloning Medley from GitHub or after making significant changes to the Medley source, you need to run the loadup procedure to (re)create these standard files.
|
||||
|
||||
The complete loadup procedure happens in 5 sequential stages with each stage depending on successful completion
|
||||
of the previous stage. There are two other non-sequential stages (Aux and DB), which depend only on the completion
|
||||
of Stage 4 (full.sysout).
|
||||
|
||||
You need not run all 5 stages, depending on what sysout files you need to create for your work.
|
||||
The target files created in each stage are copied into a loadups directory (\<MEDLEYDIR>/loadups).
|
||||
The *medley* run script and other Medley tools look for these files in the loadups directory.
|
||||
|
||||
The 5 sequential stages and their main products are:
|
||||
|
||||
>1. **Init:** create an *init.dlinit* sysout file. This init.dlinit file is used internally for Stage 2 and is not copied into the loadups directory.
|
||||
|
||||
>2. **Mid:** create an *init-mid.sysout*. This init-mid.sysout is used only internally for Stage 3 and is not copied into the loadups directory.
|
||||
|
||||
>3. **Lisp:** create *lisp.sysout*. Lisp.sysout has a minimal set of Medley's functionality loaded and can be used as the basis for running a stripped-down Medley session. Lisp.sysout is copied into the loadups directory.
|
||||
|
||||
>4. **Full:** create *full.sysout*. Full.sysout has all of the "standard" set of Medley functionality loaded and is the primary sysout used for running Medley sessions. Full.sysout is copied into the loadups directory.
|
||||
|
||||
>5. **Apps:**: create *apps.sysout*. Apps.sysout includes everything in full.sysout plus the Medley applications Buttons, CLOS, Rooms, and Notecards.
|
||||
|
||||
|
||||
The two independent stages that can be run if the first 4 sequential stages complete successfully are:
|
||||
|
||||
>+ **Aux:**: create the *whereis.hash* and *exports.all* files. These are databases that are commonly used when working on Medley source code. They are copied into the loadups directory.
|
||||
>+ **DB:**: creates the *fuller.database* file. Fuller.database is a Mastercope database created by analyzing all of the source code included in full.sysout. (Stage 4) Fuller.database is copied into the loadups directory.
|
||||
|
||||
|
||||
Loadup does all of its work in a work directory (\<MEDLEYDIR>loadups/build). The target files are copied from this work directory to the loadups directory if the loadup is successful. Each stage of the loadup also creates a dribble file containing the terminal output from within the Medley environment. These dribble files are also copied to the loadups directory, but also remain available in the work directory after the loadup completes.
|
||||
|
||||
|
||||
Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed. The lock can also be automatically overridden (see the --override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
|
||||
|
||||
Note: **MEDLEYDIR** is an environment variable set by the loadup script. It is set to the top level directory of the Medley installation that contains the specific loadup script that
|
||||
is invoked after all symbolic links are resolved. In the standard global installation this will
|
||||
be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and
|
||||
hence MEDLEYDIR is computed on each invocation of loadup.
|
||||
|
||||
OPTIONS
|
||||
=======
|
||||
**-z, \-\-man, \-man**
|
||||
: Print this manual page on the screen.
|
||||
|
||||
**-t STAGE, \-\-target STAGE, -target STAGE**
|
||||
: Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the --start option.
|
||||
|
||||
>STAGE can be one of the following:
|
||||
|
||||
>>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit). Init.dlinit is *not* copied into the loadups directory.
|
||||
|
||||
>>m, mid, 2: Run the loadup sequence through Stage 2 (init-mid.sysout). Init-mid.sysout is *not* copied into the loadups directory.
|
||||
|
||||
>>l, lisp, 3: Run the loadup sequence through Stage 3 (lisp.sysout). Lisp.sysout is copied into the loadups directory.
|
||||
|
||||
>>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout). Full.sysout is copied into the loadups directory.
|
||||
|
||||
>>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if --aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.
|
||||
|
||||
>>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout). The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory. Also run the Aux stage as if --aux option had been specified.
|
||||
|
||||
|
||||
**-s STAGE \-\-start STAGE, -start STAGE**
|
||||
: Start the loadup process using the files previously created by STAGE. These files are looked for first in the loadups directory or, if not found there, in the work directory. It is an error if the files created by STAGE cannot be found.
|
||||
|
||||
>STAGE can be one of the following:
|
||||
|
||||
>>s, scratch, 0 : Start the loadup process from the beginning. This is the default.
|
||||
|
||||
>> i, init, 1 : Start the loadup process using the files created by Stage 1 (init.dlinit).
|
||||
|
||||
>>m, mid, 2 : Start the loadup process using the files created by Stage 2 (init-mid.sysout).
|
||||
|
||||
>>l, lisp, 3 : Start the loadup process using the files created by Stage 3 (lisp.sysout)
|
||||
|
||||
>>f, full, 4 : Start the loadup process using the files created by Stage 4 (full.sysout).
|
||||
|
||||
**-x, \-\-aux, -aux**
|
||||
: Run the Aux loadup stage, creating the *whereis.hash* and *exports.all* files. If loadup completes successfully, these files are copied into loadups.
|
||||
|
||||
**-b, \-\-db, \-db**
|
||||
: Run the DB loadup stage, creating the *fuller.database* file. If this stage complete successfully, these files are copied into loadups.
|
||||
|
||||
**-i, \-\-init, -init, -1**
|
||||
: Synonym for "--target init"
|
||||
|
||||
**-m, \-\-mid, -mid, -2**
|
||||
: Synonym for "--target mid"
|
||||
|
||||
**-l, \-\-lisp, -lisp, -3**
|
||||
: Synonym for "--target lisp"
|
||||
|
||||
**-f, \-\-full. -full, -4**
|
||||
: Synonym for "--target full"
|
||||
|
||||
**-a, \-\-apps, -apps, -5**
|
||||
: Synonym for "--target apps"
|
||||
|
||||
**-a-, \-\-apps-, -apps-, -5-**
|
||||
: Synonym for "--target apps"
|
||||
|
||||
**-ov, \-\-override, -override**
|
||||
: Automatically override the lock that prevents two loadups from running simultaneously. If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.
|
||||
|
||||
**-nc, \-\-nocopy, -nocopy**
|
||||
: Run the specified loadups, but do not copy results into loadups directory.
|
||||
|
||||
**-tw, \-\-thinw, -thinw**
|
||||
: Before running loadups (if any), thin the working directory by deleting all versioned (*.~[0-9]*~) files.
|
||||
|
||||
**-tl, \-\-thinl, -thinl**
|
||||
: Before running loadups (if any), thin the loadups directory by deleting all versioned (*.~[0-9]*~) files.
|
||||
|
||||
**-d DIR, \-\-maikodir DIR, -maikodir DIR**
|
||||
: Use DIR as the directory from which to execute lde (Miko) when running Medley in the loadup process. If this flag is not present, the value of the environment variable MAIKODIR will be used instead. And if MAIKODIR does not exist, then the default Maiko directory search within Medley will be used.
|
||||
|
||||
**-v, \-\-vnc, -vnc**
|
||||
: Relevant to Linux (including WSLv1 and WSLv2) platforms only. Use Xvnc for the Medley display during this loadup.
|
||||
By default, the Medley display will use X Windows.
|
||||
This flag is most useful on Windows System for Linux v1, where Xvnc is commonly used in
|
||||
running Medley in the absence of an Xwindows server.
|
||||
|
||||
DEFAULTS
|
||||
====
|
||||
The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts. All of the following defaults rules hold independent of the --maikodir (-d) option.
|
||||
|
||||
1. If none of --target, --start, --aux, and --db are specified, then:
|
||||
|
||||
>1A. If neither --thinw nor --thinl are specified, the options default to:
|
||||
|
||||
>> **--target full --start 0 --aux**
|
||||
|
||||
>1B. If either --thinw or --thinl are specified, no loadups are run.
|
||||
|
||||
2. If neither --start nor --target are specified but either -aux or -db or both are, then --start defaults to *full* and --target is irrelevant.
|
||||
|
||||
3. If --start is specified and --target is not, then --target defaults to *full*
|
||||
|
||||
4. If --target is specified and --start is not, then --start defaults to *0*
|
||||
|
||||
EXAMPLES
|
||||
====
|
||||
**./loadup -full -s lisp** : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
||||
|
||||
**./loadup \-\-target full \-\-start lisp** : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
||||
|
||||
**./loadup -5 --aux** : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux "stage" to create *whereis.hash* and *exports.all*
|
||||
|
||||
**./loadup -db** : just run the DB "stage" starting from an existing full.sysout; do not run any of the sequential stages.
|
||||
|
||||
**./loadup --maikodir ~/il/newmaiko** : run loadup sequence from beginning to full plus the loadup Aux stage, while using *~/il/newmaiko* as the location for the lde executables when running Medley.
|
||||
|
||||
**./loadup -full** : run loadup sequence from beginning thru full
|
||||
|
||||
**./loadup -apps** : run loadup sequence from beginning thru app. Also run the Aux stage loadup.
|
||||
|
||||
**./loadup -apps-** : run loadup sequence from beginning thru app. Do not run the Aux stage loadup.
|
||||
|
||||
BUGS
|
||||
====
|
||||
|
||||
See GitHub Issues: <https://github.com/Interlisp/medley/issues>
|
||||
|
||||
COPYRIGHT
|
||||
=========
|
||||
|
||||
Copyright(c) 2025 by Interlisp.org
|
||||
@@ -1,2 +0,0 @@
|
||||
#!/bin/bash
|
||||
pandoc --from man --to html < loadup.1 > man_loadup.html
|
||||
@@ -1,159 +0,0 @@
|
||||
<h1>NAME</h1>
|
||||
<p><strong>loadup</strong> — runs a loadup procedure for Medley Interlisp</p>
|
||||
<h1>SYNOPSIS</h1>
|
||||
<p><strong><MEDLEYDIR>/scripts/loadup</strong> [ options ... ]</p>
|
||||
<h1>DESCRIPTION</h1>
|
||||
<p>Runs all or part of the <strong>loadup</strong> procedure for Medley Interlisp. The loadup procedure is used to create the standard sysout files from which you can start a Medley session as well as other standard files that are useful in running Medley. After cloning Medley from GitHub or after making significant changes to the Medley source, you need to run the loadup procedure to (re)create these standard files.</p>
|
||||
<p>The complete loadup procedure happens in 5 sequential stages with each stage depending on successful completion of the previous stage. There are two other non-sequential stages (Aux and DB), which depend only on the completion of Stage 4 (full.sysout).</p>
|
||||
<p>You need not run all 5 stages, depending on what sysout files you need to create for your work. The target files created in each stage are copied into a loadups directory (<MEDLEYDIR>/loadups). The <em>medley</em> run script and other Medley tools look for these files in the loadups directory.</p>
|
||||
<p>The 5 sequential stages and their main products are:</p>
|
||||
<blockquote>
|
||||
<ol type="1">
|
||||
<li><p><strong>Init:</strong> create an <em>init.dlinit</em> sysout file. This init.dlinit file is used internally for Stage 2 and is not copied into the loadups directory.</p></li>
|
||||
</ol>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<ol start="2" type="1">
|
||||
<li><p><strong>Mid:</strong> create an <em>init-mid.sysout</em>. This init-mid.sysout is used only internally for Stage 3 and is not copied into the loadups directory.</p></li>
|
||||
</ol>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<ol start="3" type="1">
|
||||
<li><p><strong>Lisp:</strong> create <em>lisp.sysout</em>. Lisp.sysout has a minimal set of Medley’s functionality loaded and can be used as the basis for running a stripped-down Medley session. Lisp.sysout is copied into the loadups directory.</p></li>
|
||||
</ol>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<ol start="4" type="1">
|
||||
<li><p><strong>Full:</strong> create <em>full.sysout</em>. Full.sysout has all of the “standard” set of Medley functionality loaded and is the primary sysout used for running Medley sessions. Full.sysout is copied into the loadups directory.</p></li>
|
||||
</ol>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<ol start="5" type="1">
|
||||
<li><p><strong>Apps:</strong>: create <em>apps.sysout</em>. Apps.sysout includes everything in full.sysout plus the Medley applications Buttons, CLOS, Rooms, and Notecards.</p></li>
|
||||
</ol>
|
||||
</blockquote>
|
||||
<p>The two independent stages that can be run if the first 4 sequential stages complete successfully are:</p>
|
||||
<blockquote>
|
||||
<ul>
|
||||
<li><p><strong>Aux:</strong>: create the <em>whereis.hash</em> and <em>exports.all</em> files. These are databases that are commonly used when working on Medley source code. They are copied into the loadups directory.</p></li>
|
||||
<li><p><strong>DB:</strong>: creates the <em>fuller.database</em> file. Fuller.database is a Mastercope database created by analyzing all of the source code included in full.sysout. (Stage 4) Fuller.database is copied into the loadups directory.</p></li>
|
||||
</ul>
|
||||
</blockquote>
|
||||
<p>Loadup does all of its work in a work directory (<MEDLEYDIR>loadups/build). The target files are copied from this work directory to the loadups directory if the loadup is successful. Each stage of the loadup also creates a dribble file containing the terminal output from within the Medley environment. These dribble files are also copied to the loadups directory, but also remain available in the work directory after the loadup completes.</p>
|
||||
<p>Only one instance (per <MEDLEIDIR>) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named <strong><em>lock</em></strong>) that can be manually removed. The lock can also be automatically overridden (see the –override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.</p>
|
||||
<p>Note: <strong>MEDLEYDIR</strong> is an environment variable set by the loadup script. It is set to the top level directory of the Medley installation that contains the specific loadup script that is invoked after all symbolic links are resolved. In the standard global installation this will be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and hence MEDLEYDIR is computed on each invocation of loadup.</p>
|
||||
<h1>OPTIONS</h1>
|
||||
<dl>
|
||||
<dt><strong>-z, --man, -man</strong></dt>
|
||||
<dd><p>Print this manual page on the screen.</p>
|
||||
</dd>
|
||||
<dt><strong>-t STAGE, --target STAGE, -target STAGE</strong></dt>
|
||||
<dd><p>Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the –start option.</p>
|
||||
<p>STAGE can be one of the following:</p>
|
||||
<blockquote>
|
||||
<p>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit). Init.dlinit is <em>not</em> copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>m, mid, 2: Run the loadup sequence through Stage 2 (init-mid.sysout). Init-mid.sysout is <em>not</em> copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>l, lisp, 3: Run the loadup sequence through Stage 3 (lisp.sysout). Lisp.sysout is copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout). Full.sysout is copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if –aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout). The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory. Also run the Aux stage as if –aux option had been specified.</p>
|
||||
</blockquote>
|
||||
</dd>
|
||||
<dt><strong>-s STAGE --start STAGE, -start STAGE</strong></dt>
|
||||
<dd><p>Start the loadup process using the files previously created by STAGE. These files are looked for first in the loadups directory or, if not found there, in the work directory. It is an error if the files created by STAGE cannot be found.</p>
|
||||
<p>STAGE can be one of the following:</p>
|
||||
<blockquote>
|
||||
<p>s, scratch, 0 : Start the loadup process from the beginning. This is the default.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>i, init, 1 : Start the loadup process using the files created by Stage 1 (init.dlinit).</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>m, mid, 2 : Start the loadup process using the files created by Stage 2 (init-mid.sysout).</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>l, lisp, 3 : Start the loadup process using the files created by Stage 3 (lisp.sysout)</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>f, full, 4 : Start the loadup process using the files created by Stage 4 (full.sysout).</p>
|
||||
</blockquote>
|
||||
</dd>
|
||||
<dt><strong>-x, --aux, -aux</strong></dt>
|
||||
<dd><p>Run the Aux loadup stage, creating the <em>whereis.hash</em> and <em>exports.all</em> files. If loadup completes successfully, these files are copied into loadups.</p>
|
||||
</dd>
|
||||
<dt><strong>-b, --db, -db</strong></dt>
|
||||
<dd><p>Run the DB loadup stage, creating the <em>fuller.database</em> file. If this stage complete successfully, these files are copied into loadups.</p>
|
||||
</dd>
|
||||
<dt><strong>-i, --init, -init, -1</strong></dt>
|
||||
<dd><p>Synonym for “–target init”</p>
|
||||
</dd>
|
||||
<dt><strong>-m, --mid, -mid, -2</strong></dt>
|
||||
<dd><p>Synonym for “–target mid”</p>
|
||||
</dd>
|
||||
<dt><strong>-l, --lisp, -lisp, -3</strong></dt>
|
||||
<dd><p>Synonym for “–target lisp”</p>
|
||||
</dd>
|
||||
<dt><strong>-f, --full. -full, -4</strong></dt>
|
||||
<dd><p>Synonym for “–target full”</p>
|
||||
</dd>
|
||||
<dt><strong>-a, --apps, -apps, -5</strong></dt>
|
||||
<dd><p>Synonym for “–target apps”</p>
|
||||
</dd>
|
||||
<dt><strong>-a-, --apps-, -apps-, -5-</strong></dt>
|
||||
<dd><p>Synonym for “–target apps”</p>
|
||||
</dd>
|
||||
<dt><strong>-ov, --override, -override</strong></dt>
|
||||
<dd><p>Automatically override the lock that prevents two loadups from running simultaneously. If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.</p>
|
||||
</dd>
|
||||
<dt><strong>-nc, --nocopy, -nocopy</strong></dt>
|
||||
<dd><p>Run the specified loadups, but do not copy results into loadups directory.</p>
|
||||
</dd>
|
||||
<dt><strong>-tw, --thinw, -thinw</strong></dt>
|
||||
<dd><p>Before running loadups (if any), thin the working directory by deleting all versioned (<em>.~[0-9]</em>~) files.</p>
|
||||
</dd>
|
||||
<dt><strong>-tl, --thinl, -thinl</strong></dt>
|
||||
<dd><p>Before running loadups (if any), thin the loadups directory by deleting all versioned (<em>.~[0-9]</em>~) files.</p>
|
||||
</dd>
|
||||
<dt><strong>-d DIR, --maikodir DIR, -maikodir DIR</strong></dt>
|
||||
<dd><p>Use DIR as the directory from which to execute lde (Miko) when running Medley in the loadup process. If this flag is not present, the value of the environment variable MAIKODIR will be used instead. And if MAIKODIR does not exist, then the default Maiko directory search within Medley will be used.</p>
|
||||
</dd>
|
||||
<dt><strong>-v, --vnc, -vnc</strong></dt>
|
||||
<dd><p>Relevant to Linux (including WSLv1 and WSLv2) platforms only. Use Xvnc for the Medley display during this loadup. By default, the Medley display will use X Windows. This flag is most useful on Windows System for Linux v1, where Xvnc is commonly used in running Medley in the absence of an Xwindows server.</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h1>DEFAULTS</h1>
|
||||
<p>The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts. All of the following defaults rules hold independent of the –maikodir (-d) option.</p>
|
||||
<ol type="1">
|
||||
<li><p>If none of –target, –start, –aux, and –db are specified, then:</p>
|
||||
<p>1A. If neither –thinw nor –thinl are specified, the options default to:</p>
|
||||
<blockquote>
|
||||
<p><strong>–target full –start 0 –aux</strong></p>
|
||||
</blockquote>
|
||||
<p>1B. If either –thinw or –thinl are specified, no loadups are run.</p></li>
|
||||
<li><p>If neither –start nor –target are specified but either -aux or -db or both are, then –start defaults to <em>full</em> and –target is irrelevant.</p></li>
|
||||
<li><p>If –start is specified and –target is not, then –target defaults to <em>full</em></p></li>
|
||||
<li><p>If –target is specified and –start is not, then –start defaults to <em>0</em></p></li>
|
||||
</ol>
|
||||
<h1>EXAMPLES</h1>
|
||||
<p><strong>./loadup -full -s lisp</strong> : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).</p>
|
||||
<p><strong>./loadup --target full --start lisp</strong> : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).</p>
|
||||
<p><strong>./loadup -5 –aux</strong> : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux “stage” to create <em>whereis.hash</em> and <em>exports.all</em></p>
|
||||
<p><strong>./loadup -db</strong> : just run the DB “stage” starting from an existing full.sysout; do not run any of the sequential stages.</p>
|
||||
<p><strong>./loadup –maikodir ~/il/newmaiko</strong> : run loadup sequence from beginning to full plus the loadup Aux stage, while using <em>~/il/newmaiko</em> as the location for the lde executables when running Medley.</p>
|
||||
<p><strong>./loadup -full</strong> : run loadup sequence from beginning thru full</p>
|
||||
<p><strong>./loadup -apps</strong> : run loadup sequence from beginning thru app. Also run the Aux stage loadup.</p>
|
||||
<p><strong>./loadup -apps-</strong> : run loadup sequence from beginning thru app. Do not run the Aux stage loadup.</p>
|
||||
<h1>BUGS</h1>
|
||||
<p>See GitHub Issues: <https://github.com/Interlisp/medley/issues></p>
|
||||
<h1>COPYRIGHT</h1>
|
||||
<p>Copyright(c) 2025 by Interlisp.org</p>
|
||||
@@ -1,3 +0,0 @@
|
||||
#!/bin/bash
|
||||
pandoc loadup.1.md -s -t man -o loadup.1
|
||||
gzip --stdout loadup.1 >loadup.1.gz
|
||||
@@ -1,4 +0,0 @@
|
||||
#!/bin/bash
|
||||
./md2man.sh
|
||||
./man2html.sh
|
||||
|
||||
@@ -1,2 +0,0 @@
|
||||
#!/bin/bash
|
||||
pandoc loadup.1.md -s -t man | /usr/bin/man -l -
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4 34381
|
||||
(FILECREATED " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3 34260
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GET.OBJ.FROM.USER)
|
||||
|
||||
:PREVIOUS-DATE " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3)
|
||||
:PREVIOUS-DATE " 7-Dec-95 13:21:56" {WMEDLEY}<library>IMAGEOBJ.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IMAGEOBJCOMS)
|
||||
@@ -674,8 +674,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(GET.OBJ.FROM.USER
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 7-Dec-2024 19:44 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 21:04 by rmk")
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 7-Jul-2024 21:04 by rmk")
|
||||
(* ; "Edited 26-Apr-91 10:54 by jds")
|
||||
|
||||
(* ;; "reads an expression from the user and puts the result into the textstream at the current position of its caret.")
|
||||
@@ -689,7 +688,7 @@
|
||||
(TEDIT.INSERT TEXTSTREAM VAL))
|
||||
(LITATOM (* ;
|
||||
"Atoms and strings get inserted as text.")
|
||||
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T))))
|
||||
(TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)))
|
||||
(IMAGEOBJ (* ; "IMAGEOBJs get inserted as is")
|
||||
(TEDIT.INSERT.OBJECT VAL TEXTSTREAM))
|
||||
(T [COND
|
||||
@@ -770,12 +769,12 @@
|
||||
|
||||
(FILESLOAD EDITBITMAP)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2975 7471 (BITMAPTEDITOBJ 2985 . 3628) (COERCETOBITMAP 3630 . 5674) (WINDOWTITLEFONT
|
||||
5676 . 6023) (\PRINTBINARYBITMAP 6025 . 6816) (\READBINARYBITMAP 6818 . 7469)) (7522 23640 (
|
||||
BMOBJ.BUTTONEVENTINFN 7532 . 12078) (BMOBJ.COPYFN 12080 . 12706) (BMOBJ.DISPLAYFN 12708 . 16437) (
|
||||
BMOBJ.IMAGEBOXFN 16439 . 18854) (BMOBJ.PUTFN 18856 . 19788) (BMOBJ.INIT 19790 . 20829) (BMOBJ.GETFN5
|
||||
20831 . 21421) (BMOBJ.CREATE.MENU 21423 . 23638)) (23730 27014 (SCALED.BITMAP.GETFN 23740 . 24166) (
|
||||
BMOBJ.GETFN 24168 . 24703) (BMOBJ.GETFN2 24705 . 25190) (BMOBJ.GETFN3 25192 . 25980) (BMOBJ.GETFN4
|
||||
25982 . 27012)) (28949 34281 (GET.OBJ.FROM.USER 28959 . 30925) (BITMAPOBJ.SNAPW 30927 . 32053) (
|
||||
PROMPTFOREVALED 32055 . 34279)))))
|
||||
(FILEMAP (NIL (2973 7469 (BITMAPTEDITOBJ 2983 . 3626) (COERCETOBITMAP 3628 . 5672) (WINDOWTITLEFONT
|
||||
5674 . 6021) (\PRINTBINARYBITMAP 6023 . 6814) (\READBINARYBITMAP 6816 . 7467)) (7520 23638 (
|
||||
BMOBJ.BUTTONEVENTINFN 7530 . 12076) (BMOBJ.COPYFN 12078 . 12704) (BMOBJ.DISPLAYFN 12706 . 16435) (
|
||||
BMOBJ.IMAGEBOXFN 16437 . 18852) (BMOBJ.PUTFN 18854 . 19786) (BMOBJ.INIT 19788 . 20827) (BMOBJ.GETFN5
|
||||
20829 . 21419) (BMOBJ.CREATE.MENU 21421 . 23636)) (23728 27012 (SCALED.BITMAP.GETFN 23738 . 24164) (
|
||||
BMOBJ.GETFN 24166 . 24701) (BMOBJ.GETFN2 24703 . 25188) (BMOBJ.GETFN3 25190 . 25978) (BMOBJ.GETFN4
|
||||
25980 . 27010)) (28947 34160 (GET.OBJ.FROM.USER 28957 . 30804) (BITMAPOBJ.SNAPW 30806 . 31932) (
|
||||
PROMPTFOREVALED 31934 . 34158)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
BIN
library/KeyboardEditor.tedit
Normal file
BIN
library/KeyboardEditor.tedit
Normal file
Binary file not shown.
@@ -1,19 +1,22 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "13-Jun-2021 09:05:17"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;6 196680
|
||||
|
||||
(FILECREATED " 5-Apr-2025 11:49:04" {WMEDLEY}<library>MASTERSCOPE.;29 197994
|
||||
changes to%: (FNS MSINTERPRETSET)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: " 9-Jun-2021 23:55:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;5)
|
||||
|
||||
:CHANGES-TO (FNS MSOUTPUT)
|
||||
|
||||
:PREVIOUS-DATE "14-Jul-2024 08:42:20" {WMEDLEY}<library>MASTERSCOPE.;28)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT MASTERSCOPECOMS)
|
||||
|
||||
(RPAQQ MASTERSCOPECOMS
|
||||
[
|
||||
(* ;; "Main file for MASTERSCOPE.")
|
||||
(* ;; "Main file for MASTERSCOPE.")
|
||||
|
||||
(FILES MSPARSE MSANALYZE)
|
||||
(PROP FILETYPE MASTERSCOPE)
|
||||
@@ -25,13 +28,13 @@
|
||||
[COMS (FNS MSFIND MSEDITF MSEDITE EDITGETDEF)
|
||||
(VARS MSBLIP)
|
||||
|
||||
(* ;; "List of (FILEPKGTYPE FILEPKGTYPE GETDEF-fn MARKASCHANGED-fn) for types that Masterscope knows how to analyze. LOOPSMS, for example, adds LOOPS constructs to this lists using MSADDANALYZE.")
|
||||
(* ;; "List of (FILEPKGTYPE FILEPKGTYPE GETDEF-fn MARKASCHANGED-fn) for types that Masterscope knows how to analyze. LOOPSMS, for example, adds LOOPS constructs to this lists using MSADDANALYZE.")
|
||||
|
||||
[INITVARS (MSFNTYPES '((FNS FNS GETDEF]
|
||||
(COMS (* ; "SCRATCHASH")
|
||||
(COMS (* ; "SCRATCHASH")
|
||||
(INITVARS (MSCRATCHASH))
|
||||
(DECLARE%: DONTCOPY (MACROS SCRATCHASH]
|
||||
(COMS (* ; "marking changed")
|
||||
(COMS (* ; "marking changed")
|
||||
(FNS MSMARKCHANGED CHANGEMACRO CHANGEVAR CHANGEI.S. CHANGERECORD MSNEEDUNSAVE UNSAVEFNS
|
||||
)
|
||||
(ADDVARS (COMPILE.TIME.CONSTANTS))
|
||||
@@ -39,11 +42,11 @@
|
||||
(INITVARS (CHECKUNSAVEFLG T)
|
||||
(MSNEEDUNSAVE)))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS GETWORDTYPE))
|
||||
(COMS (* ; "interactive routines")
|
||||
(COMS (* ; "interactive routines")
|
||||
[VARS * (LIST (LIST 'MASTERSCOPEDATE (DATE (DATEFORMAT NO.TIME]
|
||||
(ADDVARS (HISTORYCOMS %.))
|
||||
(FNS %. MASTERSCOPE MASTERSCOPE1 MASTERSCOPEXEC)
|
||||
(* ; "Interpreting commands")
|
||||
(* ; "Interpreting commands")
|
||||
(FNS MSINTERPRETSET MSINTERPA MSGETBLOCKDEC LISTHARD MSMEMBSET MSLISTSET MSHASHLIST
|
||||
MSHASHLIST1 CHECKPATHS ONFILE)
|
||||
(FNS MSINTERPRET VERBNOTICELIST MSOUTPUT MSCHECKEMPTY CHECKFORCHANGED MSSOLVE)
|
||||
@@ -183,9 +186,9 @@
|
||||
MSFILELST])
|
||||
|
||||
(MSSHOWUSE
|
||||
[LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS) (* ; "Edited 4-Jul-2024 15:06 by rmk")
|
||||
(* ;
|
||||
"Edited 23-Jun-93 09:40 by sybalsky:mv:envos")
|
||||
[LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS)
|
||||
(* ;
|
||||
"Edited 23-Jun-93 09:40 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "Show/Edit where SHOWFN uses/etc. a pattern.")
|
||||
|
||||
@@ -193,7 +196,7 @@
|
||||
(COND
|
||||
([OR [CL:MULTIPLE-VALUE-SETQ (DEF REALDEF)
|
||||
(MSGETDEF SHOWFN (AND (fetch (MSSETPHRASE KNOWN) of SHOWSET)
|
||||
(fetch (MSSETPHRASE TYPE) of SHOWSET))
|
||||
(fetch (MSSETPHRASE TYPE) of SHOWSET))
|
||||
(COND
|
||||
((EQ SHOWEDIT 'SHOW)
|
||||
'?)
|
||||
@@ -205,45 +208,43 @@
|
||||
(FILE (LOADFNS SHOWFN FILE 'PROP)
|
||||
(GETPROP SHOWFN 'EXPR]
|
||||
(* ;
|
||||
"was (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW)))")
|
||||
"was (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW)))")
|
||||
(* ;
|
||||
"The SHOW command does not need to save")
|
||||
(MSUPDATEFN1 SHOWFN DEF (LIST SHOWTYPE
|
||||
[FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
|
||||
(COND
|
||||
((MSMEMBSET ITEM SS)
|
||||
(COND
|
||||
((NOT ANYFOUND)
|
||||
(TAB 0 0 T)
|
||||
(DSPFONT (PROG1 (DSPFONT BOLDFONT)
|
||||
(PRIN2 SHOWFN)))
|
||||
(PRIN1 " :
|
||||
"The SHOW command does not need to save")
|
||||
(MSUPDATEFN1 SHOWFN DEF
|
||||
(LIST SHOWTYPE [FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
|
||||
(COND
|
||||
((MSMEMBSET ITEM SS)
|
||||
(COND
|
||||
((NOT ANYFOUND)
|
||||
(TAB 0 0 T)
|
||||
(PRIN2 SHOWFN)
|
||||
(PRIN1 " :
|
||||
")))
|
||||
(SETQ ANYFOUND
|
||||
(CONS (CONS PRNT
|
||||
(AND INCLISP
|
||||
(NOT (MSFIND INCLISP
|
||||
PRNT))
|
||||
INCLISP))
|
||||
ANYFOUND))
|
||||
(COND
|
||||
([AND (EQ SE 'SHOW)
|
||||
(NOT (FASSOC PRNT (CDR ANYFOUND]
|
||||
(SETQ ANYFOUND
|
||||
(CONS (CONS PRNT (AND INCLISP
|
||||
(NOT (MSFIND INCLISP
|
||||
PRNT))
|
||||
INCLISP))
|
||||
ANYFOUND))
|
||||
(COND
|
||||
([AND (EQ SE 'SHOW)
|
||||
(NOT (FASSOC PRNT (CDR ANYFOUND]
|
||||
|
||||
(* ;; "The EDIT command works by collecting a list of the expressions, and then doing a (*ORF* (= . lst1) (= . lst2)) --- if within a CLISP translation (determined by the binding of the INCLISP variable) then want to point at the CLISP if the expression is not actually embedded in the expression")
|
||||
|
||||
(SPACES 3)
|
||||
(LVLPRINT PRNT (OUTPUT)
|
||||
2)
|
||||
(COND
|
||||
((CDAR ANYFOUND)
|
||||
(SPACES 3)
|
||||
(LVLPRINT PRNT (OUTPUT)
|
||||
2)
|
||||
(COND
|
||||
((CDAR ANYFOUND)
|
||||
(* ; "This is under a clisp")
|
||||
(PRIN1 " {under ")
|
||||
(LVLPRIN2 INCLISP (OUTPUT)
|
||||
2)
|
||||
(PRIN1 "}
|
||||
(PRIN1 " {under ")
|
||||
(LVLPRIN2 INCLISP (OUTPUT)
|
||||
2)
|
||||
(PRIN1 "}
|
||||
"]
|
||||
SHOWSET SHOWEDIT)))
|
||||
SHOWSET SHOWEDIT)))
|
||||
(T (printout T "Can't find a definition for " SHOWFN "!" T)
|
||||
(RETURN)))
|
||||
(COND
|
||||
@@ -2402,14 +2403,14 @@
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS SCRATCHASH MACRO [(ARRAYNAME . FORMS)
|
||||
([LAMBDA (ARRAYNAME)
|
||||
(SETQ MSCRATCHASH)
|
||||
(PROG1 (PROGN . FORMS)
|
||||
(SETQ MSCRATCHASH ARRAYNAME]
|
||||
(COND
|
||||
(MSCRATCHASH (CLRHASH MSCRATCHASH)
|
||||
MSCRATCHASH)
|
||||
(T (HASHARRAY 20 (FUNCTION MSREHASH])
|
||||
([LAMBDA (ARRAYNAME)
|
||||
(SETQ MSCRATCHASH)
|
||||
(PROG1 (PROGN . FORMS)
|
||||
(SETQ MSCRATCHASH ARRAYNAME]
|
||||
(COND
|
||||
(MSCRATCHASH (CLRHASH MSCRATCHASH)
|
||||
MSCRATCHASH)
|
||||
(T (HASHARRAY 20 (FUNCTION MSREHASH])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2568,7 +2569,7 @@
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS GETWORDTYPE MACRO [(WORD TYPE)
|
||||
(CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
|
||||
(CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2577,7 +2578,7 @@
|
||||
(* ; "interactive routines")
|
||||
|
||||
|
||||
(RPAQ MASTERSCOPEDATE " 5-Apr-2025")
|
||||
(RPAQ MASTERSCOPEDATE "13-Jun-2021")
|
||||
|
||||
(ADDTOVAR HISTORYCOMS %.)
|
||||
(DEFINEQ
|
||||
@@ -3526,34 +3527,8 @@
|
||||
(ERROR!])
|
||||
|
||||
(MSOUTPUT
|
||||
[LAMBDA (FILE) (* ; "Edited 5-Apr-2025 11:48 by rmk")
|
||||
(* ; "Edited 14-Jul-2024 08:41 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 11:54 by rmk")
|
||||
(* ; "Edited 12-Jun-90 20:43 by teruuchi")
|
||||
(LET ((LLENGTH FILELINELENGTH))
|
||||
[COND
|
||||
((AND (LITATOM FILE)
|
||||
(MEMB (U-CASE FILE)
|
||||
'(TEDIT :TEDIT))
|
||||
(GETD (FUNCTION TEDIT)))
|
||||
|
||||
(* ;;
|
||||
"If no TEDIT, leave the current OUTPUT. The readtable for seprs etc is the current readtable.")
|
||||
|
||||
[SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
|
||||
,DEFAULTFONT BOUNDTABLE
|
||||
,(TEDIT.ATOMBOUND.READTABLE]
|
||||
(SETQ LLENGTH T)
|
||||
(TEDIT.DEFER.UPDATES FILE '(READONLY QUIET))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE)))
|
||||
((OPENP FILE 'OUTPUT))
|
||||
(T (SETQ FILE (OPENSTREAM FILE 'OUTPUT))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE]
|
||||
|
||||
(* ;; "Reset LINELENGTH, output to file. OUTPUT is already RESETSAVE'd.")
|
||||
|
||||
(LINELENGTH LLENGTH FILE)
|
||||
(OUTPUT FILE])
|
||||
(LAMBDA (FILE) (* ; "Edited 12-Jun-90 20:43 by teruuchi") (* ;; "OUTPUT is already RESETSAVE'd") (COND ((OPENP FILE (QUOTE OUTPUT)) (OUTPUT FILE)) (T (OUTFILE FILE) (SETQ FILE (OUTPUT)) (RESETSAVE NIL (LIST (QUOTE CLOSEF) FILE)))) (* ;; "output to file, reset LINELENGTH") (LINELENGTH FILELINELENGTH))
|
||||
)
|
||||
|
||||
(MSCHECKEMPTY
|
||||
[LAMBDA NIL (* lmm "20-JAN-79 14:08")
|
||||
@@ -3646,15 +3621,15 @@
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD GETHASH (ID HTABLE . BADMARKS)
|
||||
ID _ 'GETHASH)
|
||||
ID _ 'GETHASH)
|
||||
|
||||
(RECORD INRELATION (ID (INVERTED . HTABLES) . OSET)
|
||||
ID _ 'INRELATION)
|
||||
ID _ 'INRELATION)
|
||||
|
||||
(ASSOCRECORD PATHOPTIONS (TO FROM AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH MARKING)
|
||||
(* CHECKPATHS assumes that this is an
|
||||
ASSOCRECORD)
|
||||
)
|
||||
(ASSOCRECORD PATHOPTIONS (TO FROM AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH
|
||||
MARKING) (* CHECKPATHS assumes that this is
|
||||
an ASSOCRECORD)
|
||||
)
|
||||
|
||||
(RECORD MSANALYZABLE (FILEPKGNAME SETNAME GETDEF-FN MARKCHANGED-FN))
|
||||
)
|
||||
@@ -3751,37 +3726,39 @@
|
||||
|
||||
(ADDTOVAR LAMA MSEDITE MSEDITF)
|
||||
)
|
||||
(PUTPROPS MASTERSCOPE COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993
|
||||
1994 2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3260 19507 (UPDATEFN 3270 . 4887) (MSGETDEF 4889 . 6295) (MSNOTICEFILE 6297 . 8690) (
|
||||
MSSHOWUSE 8692 . 14673) (MSUPDATEFN1 14675 . 15363) (MSUPDATE 15365 . 17791) (MSNLAMBDACHECK 17793 .
|
||||
18675) (MSCOLLECTDATA 18677 . 19505)) (19508 20407 (UPDATECHANGED 19518 . 19881) (UPDATECHANGED1 19883
|
||||
. 20405)) (20981 21404 (MSCLOSEFILES 20991 . 21402)) (22085 26517 (MSDESCRIBE 22095 . 24883) (
|
||||
MSDESCRIBE1 24885 . 25948) (FMAPRINT 25950 . 26515)) (26610 27050 (MSPRINTHELPFILE 26620 . 27048)) (
|
||||
27100 30238 (TEMPLATE 27110 . 28531) (GETTEMPLATE 28533 . 28668) (SETTEMPLATE 28670 . 30236)) (31108
|
||||
36032 (ADDTEMPLATEWORD 31118 . 31790) (MSADDANALYZE 31792 . 33290) (MSADDMODIFIER 33292 . 34373) (
|
||||
MSADDRELATION 34375 . 35122) (MSADDTYPE 35124 . 36030)) (37533 42754 (MSMARKCHANGE1 37543 . 38337) (
|
||||
MSINIT 38339 . 39520) (GETVERBTABLES 39522 . 40075) (MSSTOREDATA 40077 . 41756) (STORETABLE 41758 .
|
||||
42752)) (44155 49225 (PARSERELATION 44165 . 44765) (PARSERELATION1 44767 . 46222) (GETRELATION 46224
|
||||
. 47253) (MAPRELATION 47255 . 48389) (TESTRELATION 48391 . 49223)) (49226 50866 (ADDHASH 49236 .
|
||||
49714) (SUBHASH 49716 . 49944) (MAKEHASH 49946 . 50090) (MSREHASH 50092 . 50545) (EQMEMBHASH 50547 .
|
||||
50864)) (51205 57420 (MSVBTABLES 51215 . 56994) (MSUSERVBTABLES 56996 . 57418)) (57503 59714 (
|
||||
BUILDGETRELQ 57513 . 58619) (BUILDTESTRELQ 58621 . 59712)) (59885 60273 (MSERASE 59895 . 60271)) (
|
||||
60274 64734 (DUMPDATABASE 60284 . 62849) (DUMPDATABASE1 62851 . 63196) (READATABASE 63198 . 64732)) (
|
||||
65816 94875 (MSCHECKBLOCKS 65826 . 69646) (MSCHECKBLOCK 69648 . 78268) (MSCHECKFNINBLOCK 78270 . 81270
|
||||
) (MSCHECKBLOCKBASIC 81272 . 83692) (MSCHECKBOUNDFREE 83694 . 85593) (GLOBALVARP 85595 . 85762) (
|
||||
PRINTERROR 85764 . 88980) (MSCHECKVARS1 88982 . 91935) (UNECCSPEC 91937 . 92215) (NECCSPEC 92217 .
|
||||
92564) (SPECVARP 92566 . 93093) (SHORTLST 93095 . 93551) (DOERROR 93553 . 94263) (MSMSGPRINT 94265 .
|
||||
94873)) (96019 110847 (MSPATHS 96029 . 99431) (MSPATHS1 99433 . 103668) (MSPATHS2 103670 . 107080) (
|
||||
MSONPATH 107082 . 108310) (MSPATHS4 108312 . 109394) (DASHES 109396 . 109922) (DOTABS 109924 . 110165)
|
||||
(BELOWMARKER 110167 . 110630) (MSPATHSPRINTFN 110632 . 110845)) (111233 114657 (MSFIND 111243 .
|
||||
111518) (MSEDITF 111520 . 112520) (MSEDITE 112522 . 113559) (EDITGETDEF 113561 . 114655)) (115599
|
||||
124200 (MSMARKCHANGED 115609 . 117333) (CHANGEMACRO 117335 . 118040) (CHANGEVAR 118042 . 118358) (
|
||||
CHANGEI.S. 118360 . 119693) (CHANGERECORD 119695 . 120566) (MSNEEDUNSAVE 120568 . 121560) (UNSAVEFNS
|
||||
121562 . 124198)) (124633 128123 (%. 124643 . 124783) (MASTERSCOPE 124785 . 125311) (MASTERSCOPE1
|
||||
125313 . 126181) (MASTERSCOPEXEC 126183 . 128121)) (128162 167812 (MSINTERPRETSET 128172 . 156706) (
|
||||
MSINTERPA 156708 . 157242) (MSGETBLOCKDEC 157244 . 159757) (LISTHARD 159759 . 160977) (MSMEMBSET
|
||||
160979 . 161124) (MSLISTSET 161126 . 161491) (MSHASHLIST 161493 . 161660) (MSHASHLIST1 161662 . 161988
|
||||
) (CHECKPATHS 161990 . 162630) (ONFILE 162632 . 167810)) (167813 192172 (MSINTERPRET 167823 . 184676)
|
||||
(VERBNOTICELIST 184678 . 185788) (MSOUTPUT 185790 . 187300) (MSCHECKEMPTY 187302 . 188506) (
|
||||
CHECKFORCHANGED 188508 . 189028) (MSSOLVE 189030 . 192170)))))
|
||||
(FILEMAP (NIL (3419 19188 (UPDATEFN 3429 . 5046) (MSGETDEF 5048 . 6454) (MSNOTICEFILE 6456 . 8849) (
|
||||
MSSHOWUSE 8851 . 14354) (MSUPDATEFN1 14356 . 15044) (MSUPDATE 15046 . 17472) (MSNLAMBDACHECK 17474 .
|
||||
18356) (MSCOLLECTDATA 18358 . 19186)) (19189 20088 (UPDATECHANGED 19199 . 19562) (UPDATECHANGED1 19564
|
||||
. 20086)) (20662 21085 (MSCLOSEFILES 20672 . 21083)) (21766 26198 (MSDESCRIBE 21776 . 24564) (
|
||||
MSDESCRIBE1 24566 . 25629) (FMAPRINT 25631 . 26196)) (26291 26731 (MSPRINTHELPFILE 26301 . 26729)) (
|
||||
26781 29919 (TEMPLATE 26791 . 28212) (GETTEMPLATE 28214 . 28349) (SETTEMPLATE 28351 . 29917)) (30789
|
||||
35713 (ADDTEMPLATEWORD 30799 . 31471) (MSADDANALYZE 31473 . 32971) (MSADDMODIFIER 32973 . 34054) (
|
||||
MSADDRELATION 34056 . 34803) (MSADDTYPE 34805 . 35711)) (37214 42435 (MSMARKCHANGE1 37224 . 38018) (
|
||||
MSINIT 38020 . 39201) (GETVERBTABLES 39203 . 39756) (MSSTOREDATA 39758 . 41437) (STORETABLE 41439 .
|
||||
42433)) (43836 48906 (PARSERELATION 43846 . 44446) (PARSERELATION1 44448 . 45903) (GETRELATION 45905
|
||||
. 46934) (MAPRELATION 46936 . 48070) (TESTRELATION 48072 . 48904)) (48907 50547 (ADDHASH 48917 .
|
||||
49395) (SUBHASH 49397 . 49625) (MAKEHASH 49627 . 49771) (MSREHASH 49773 . 50226) (EQMEMBHASH 50228 .
|
||||
50545)) (50886 57101 (MSVBTABLES 50896 . 56675) (MSUSERVBTABLES 56677 . 57099)) (57184 59395 (
|
||||
BUILDGETRELQ 57194 . 58300) (BUILDTESTRELQ 58302 . 59393)) (59566 59954 (MSERASE 59576 . 59952)) (
|
||||
59955 64415 (DUMPDATABASE 59965 . 62530) (DUMPDATABASE1 62532 . 62877) (READATABASE 62879 . 64413)) (
|
||||
65497 94556 (MSCHECKBLOCKS 65507 . 69327) (MSCHECKBLOCK 69329 . 77949) (MSCHECKFNINBLOCK 77951 . 80951
|
||||
) (MSCHECKBLOCKBASIC 80953 . 83373) (MSCHECKBOUNDFREE 83375 . 85274) (GLOBALVARP 85276 . 85443) (
|
||||
PRINTERROR 85445 . 88661) (MSCHECKVARS1 88663 . 91616) (UNECCSPEC 91618 . 91896) (NECCSPEC 91898 .
|
||||
92245) (SPECVARP 92247 . 92774) (SHORTLST 92776 . 93232) (DOERROR 93234 . 93944) (MSMSGPRINT 93946 .
|
||||
94554)) (95700 110528 (MSPATHS 95710 . 99112) (MSPATHS1 99114 . 103349) (MSPATHS2 103351 . 106761) (
|
||||
MSONPATH 106763 . 107991) (MSPATHS4 107993 . 109075) (DASHES 109077 . 109603) (DOTABS 109605 . 109846)
|
||||
(BELOWMARKER 109848 . 110311) (MSPATHSPRINTFN 110313 . 110526)) (110914 114338 (MSFIND 110924 .
|
||||
111199) (MSEDITF 111201 . 112201) (MSEDITE 112203 . 113240) (EDITGETDEF 113242 . 114336)) (115344
|
||||
123945 (MSMARKCHANGED 115354 . 117078) (CHANGEMACRO 117080 . 117785) (CHANGEVAR 117787 . 118103) (
|
||||
CHANGEI.S. 118105 . 119438) (CHANGERECORD 119440 . 120311) (MSNEEDUNSAVE 120313 . 121305) (UNSAVEFNS
|
||||
121307 . 123943)) (124386 127876 (%. 124396 . 124536) (MASTERSCOPE 124538 . 125064) (MASTERSCOPE1
|
||||
125066 . 125934) (MASTERSCOPEXEC 125936 . 127874)) (127915 167565 (MSINTERPRETSET 127925 . 156459) (
|
||||
MSINTERPA 156461 . 156995) (MSGETBLOCKDEC 156997 . 159510) (LISTHARD 159512 . 160730) (MSMEMBSET
|
||||
160732 . 160877) (MSLISTSET 160879 . 161244) (MSHASHLIST 161246 . 161413) (MSHASHLIST1 161415 . 161741
|
||||
) (CHECKPATHS 161743 . 162383) (ONFILE 162385 . 167563)) (167566 190732 (MSINTERPRET 167576 . 184429)
|
||||
(VERBNOTICELIST 184431 . 185541) (MSOUTPUT 185543 . 185860) (MSCHECKEMPTY 185862 . 187066) (
|
||||
CHECKFORCHANGED 187068 . 187588) (MSSOLVE 187590 . 190730)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Jun-2025 08:42:11" {WMEDLEY}<library>PDFSTREAM.;64 14885
|
||||
(FILECREATED "10-Dec-2024 14:36:59" {WMEDLEY}<library>PDFSTREAM.;59 14133
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS OPEN-PDF-STREAM)
|
||||
:CHANGES-TO (VARS PDFSTREAMCOMS)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2025 12:18:57" {WMEDLEY}<library>PDFSTREAM.;62)
|
||||
:PREVIOUS-DATE "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PDFSTREAMCOMS)
|
||||
@@ -153,9 +153,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(OPEN-PDF-STREAM
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 5-Jun-2025 08:41 by rmk")
|
||||
(* ; "Edited 23-Feb-2025 12:18 by rmk")
|
||||
(* ; "Edited 23-Sep-2023 15:38 by rmk")
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 23-Sep-2023 15:38 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 11:04 by rmk")
|
||||
(* ; "Edited 24-Jun-2023 14:49 by rmk")
|
||||
|
||||
@@ -166,32 +164,27 @@
|
||||
(* ;;
|
||||
"Simplest thing for now is to just add an extra field at the end of the \POSTSCRIPTDATA record.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST]
|
||||
then
|
||||
(* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.")
|
||||
|
||||
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
|
||||
elseif (EQ 'NULL (FILENAMEFIELD (TRUEFILENAME FILE)
|
||||
'HOST))
|
||||
then
|
||||
(* ;; "Device NULL used by TMAX, maybe others, to get page number for table of contents, index. Nothing to convert")
|
||||
|
||||
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
|
||||
elseif (SETQ FILE (OR [AND (NEQ FILE T)
|
||||
(OR (OUTFILEP FILE)
|
||||
(OPENSTREAM FILE 'OUTPUT]
|
||||
(ERROR "PDF target file not found" FILE)))
|
||||
then (CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "Can't find a POSTSCRIPT-to-PDF converter"))
|
||||
(LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
|
||||
"-"
|
||||
(RAND)
|
||||
".ps")
|
||||
OPTIONS)))
|
||||
(STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
|
||||
(STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
|
||||
PSSTREAM])
|
||||
else (CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "A specified POSTSCRIPT-to-PDF converter cannot be found"))
|
||||
(SETQ FILE (OR (AND (NEQ FILE T)
|
||||
(OUTFILEP FILE))
|
||||
(ERROR "PDF target file not found" FILE)))
|
||||
(LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
|
||||
"-"
|
||||
(RAND)
|
||||
".ps")
|
||||
OPTIONS)))
|
||||
(STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
|
||||
(STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
|
||||
PSSTREAM])
|
||||
|
||||
(CLOSE-PDF-STREAM
|
||||
[LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk")
|
||||
@@ -272,14 +265,12 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SEE-PDF
|
||||
[LAMBDA (PDFFILE) (* ; "Edited 25-Dec-2024 14:25 by rmk")
|
||||
(* ; "Edited 1-Oct-2023 20:47 by rmk")
|
||||
[LAMBDA (PDFFILE) (* ; "Edited 1-Oct-2023 20:47 by rmk")
|
||||
(* ; "Edited 26-Sep-2023 16:52 by rmk")
|
||||
|
||||
(* ;; "Use the ShellOpener for this machine to open the PDF file outside of Medley")
|
||||
|
||||
(ShellOpen (OR (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF))
|
||||
(ERROR "FILE NOT FOUND" PDFFILE])
|
||||
(ShellOpen (PACKFILENAME 'BODY PDFFILE 'EXTENSION 'PDF])
|
||||
)
|
||||
|
||||
(ADDTOVAR FB.SEE.METHODS (PDFFILEP SEE-PDF))
|
||||
@@ -292,8 +283,8 @@
|
||||
thereis (ShellWhich (CAR TEMPLATE])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3263 5877 (PDFFILEP 3273 . 4187) (PDF.HARDCOPYW 4189 . 4787) (PDF.TEXT 4789 . 5506) (
|
||||
PDF.TEDIT 5508 . 5875)) (6317 13962 (OPEN-PDF-STREAM 6327 . 9048) (CLOSE-PDF-STREAM 9050 . 10337) (
|
||||
PS-TO-PDF 10339 . 13960)) (13963 14527 (SEE-PDF 13973 . 14525)) (14578 14862 (PDFCONVERTER 14588 .
|
||||
14860)))))
|
||||
(FILEMAP (NIL (3262 5876 (PDFFILEP 3272 . 4186) (PDF.HARDCOPYW 4188 . 4786) (PDF.TEXT 4788 . 5505) (
|
||||
PDF.TEDIT 5507 . 5874)) (6316 13376 (OPEN-PDF-STREAM 6326 . 8462) (CLOSE-PDF-STREAM 8464 . 9751) (
|
||||
PS-TO-PDF 9753 . 13374)) (13377 13775 (SEE-PDF 13387 . 13773)) (13826 14110 (PDFCONVERTER 13836 .
|
||||
14108)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
954
library/UNICODE
954
library/UNICODE
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Feb-2025 13:05:52" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;3 164570
|
||||
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2 164484
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS LAFITE.SET.LOOKS LAFITE.SUBSTITUTE.VP.EOL)
|
||||
:CHANGES-TO (VARS LAFITE-COMMANDSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2)
|
||||
:PREVIOUS-DATE "23-Feb-2024 21:58:18" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-COMMANDSCOMS)
|
||||
@@ -560,7 +560,7 @@
|
||||
(LAFITE.SET.LOOKS TEXTSTREAM LAFITEFIXEDWIDTHFONT])
|
||||
|
||||
(LAFITE.SET.LOOKS
|
||||
[LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS OMITHEADER USERFN) (* ; "Edited 15-Feb-2025 13:02 by rmk")
|
||||
[LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS OMITHEADER USERFN)
|
||||
(* ; "Edited 3-Nov-89 14:50 by bvm")
|
||||
|
||||
(* ;; "Called from Looks (sub)commands of Lafite display window. Change the looks of the current selection (if there is an interesting one) or the whole message to be NEWLOOKS. If NEWLOOKS is T, we use TEdit's menu interface. PARALOOKS is for paragraph formatting. USERFN is arbitrary function called with arg textstream & selection set appropriately. Any of NEWLOOKS, PARALOOKS, USERFN can be NIL. If OMITHEADER is true, the header is left out of the modification if user has not selected a region of text already.")
|
||||
@@ -571,56 +571,57 @@
|
||||
(LET ((SEL (TEDIT.GETSEL TEXTSTREAM))
|
||||
START LEN WIDTH FIXEDLOOKS)
|
||||
[if (AND (NOT PARALOOKS)
|
||||
(FONTP NEWLOOKS)
|
||||
(EQ (SETQ WIDTH (CHARWIDTH (CHARCODE "i")
|
||||
NEWLOOKS))
|
||||
(CHARWIDTH (CHARCODE "W")
|
||||
NEWLOOKS)))
|
||||
then (* ; "If font is fixed-width, let's make the tab the right width. Might be nice to restore default tab if it's not fixed-width, but TEdit apparently doesn't support that.")
|
||||
(SETQ FIXEDLOOKS (SETQ PARALOOKS `(TABS (,(TIMES WIDTH 8]
|
||||
(if (> (SETQ LEN (TEDIT.SELPROP SEL 'LENGTH))
|
||||
1)
|
||||
then (* ; "User has already selected something. Assume any selection greater than a single character is not accidental.")
|
||||
(if (AND FIXEDLOOKS (NEQ (SETQ FIXEDLOOKS (TEXTPROP TEXTSTREAM
|
||||
'LAFITEFIXEDLOOKS))
|
||||
T))
|
||||
then
|
||||
(* ;; "Record the portions we have so marked, so hardcopy can work right--T means everything. If FIXEDLOOKS is false, might want to unset, but that's tedious, unlikely to be worth the hairy code")
|
||||
(FONTP NEWLOOKS)
|
||||
(EQ (SETQ WIDTH (CHARWIDTH (CHARCODE "i")
|
||||
NEWLOOKS))
|
||||
(CHARWIDTH (CHARCODE "W")
|
||||
NEWLOOKS)))
|
||||
then (* ; "If font is fixed-width, let's make the tab the right width. Might be nice to restore default tab if it's not fixed-width, but TEdit apparently doesn't support that.")
|
||||
(SETQ FIXEDLOOKS (SETQ PARALOOKS `(TABS (,(TIMES WIDTH 8]
|
||||
(if (> (SETQ LEN (fetch (SELECTION DCH) of SEL))
|
||||
1)
|
||||
then (* ; "User has already selected something. Assume any selection greater than a single character is not accidental.")
|
||||
(if (AND FIXEDLOOKS (NEQ (SETQ FIXEDLOOKS (TEXTPROP TEXTSTREAM
|
||||
'LAFITEFIXEDLOOKS))
|
||||
T))
|
||||
then
|
||||
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS
|
||||
(CONS (CONS (TEDIT.SELPROP SEL 'CH#)
|
||||
LEN)
|
||||
FIXEDLOOKS)))
|
||||
(* ;; "Record the portions we have so marked, so hardcopy can work right--T means everything. If FIXEDLOOKS is false, might want to unset, but that's tedious, unlikely to be worth the hairy code")
|
||||
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS
|
||||
(CONS (CONS (fetch (SELECTION CH#) of SEL)
|
||||
LEN)
|
||||
FIXEDLOOKS)))
|
||||
else (SETQ START (if OMITHEADER
|
||||
then (* ;
|
||||
"Start after the blank line following the header")
|
||||
(\LAFITE.HEADER.EOF TEXTSTREAM)
|
||||
else 0))
|
||||
(SETQ LEN (- (GETEOFPTR TEXTSTREAM)
|
||||
(if LAFITEENDOFMESSAGESTR
|
||||
then (NCHARS LAFITEENDOFMESSAGESTR)
|
||||
else 0)
|
||||
START))
|
||||
(TEDIT.SETSEL TEXTSTREAM (ADD1 START)
|
||||
LEN
|
||||
'RIGHT)
|
||||
(if FIXEDLOOKS
|
||||
then (* ; "The whole thing is fixed now")
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS T)))
|
||||
then (* ;
|
||||
"Start after the blank line following the header")
|
||||
(\LAFITE.HEADER.EOF TEXTSTREAM)
|
||||
else 0))
|
||||
(SETQ LEN (- (GETEOFPTR TEXTSTREAM)
|
||||
(if LAFITEENDOFMESSAGESTR
|
||||
then (NCHARS LAFITEENDOFMESSAGESTR)
|
||||
else 0)
|
||||
START))
|
||||
(TEDIT.SETSEL TEXTSTREAM (ADD1 START)
|
||||
LEN
|
||||
'RIGHT)
|
||||
(if FIXEDLOOKS
|
||||
then (* ; "The whole thing is fixed now")
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS T)))
|
||||
|
||||
(* ;; "Now do the modification")
|
||||
|
||||
(if (EQ NEWLOOKS T)
|
||||
then (* ; "Use menu")
|
||||
(\TEDIT.LOOKS (TEXTOBJ TEXTSTREAM))
|
||||
then (* ; "Use menu")
|
||||
(\TEDIT.LOOKS (TEXTOBJ TEXTSTREAM))
|
||||
elseif NEWLOOKS
|
||||
then (TEDIT.LOOKS TEXTSTREAM NEWLOOKS))
|
||||
(if PARALOOKS
|
||||
then (* ; "Paragraph looks")
|
||||
(TEDIT.PARALOOKS TEXTSTREAM PARALOOKS))
|
||||
then (* ; "Paragraph looks")
|
||||
(TEDIT.PARALOOKS TEXTSTREAM PARALOOKS))
|
||||
(if USERFN
|
||||
then (* ; "Arbitrary user manipulation.")
|
||||
(CL:FUNCALL USERFN TEXTSTREAM))
|
||||
then (* ; "Arbitrary user manipulation.")
|
||||
(CL:FUNCALL USERFN TEXTSTREAM))
|
||||
|
||||
(* ;; "Finally, set selection back to where it was.")
|
||||
|
||||
@@ -656,31 +657,31 @@
|
||||
STR])
|
||||
|
||||
(LAFITE.SUBSTITUTE.VP.EOL
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 15-Feb-2025 13:03 by rmk")
|
||||
(* ; "Edited 4-Aug-89 16:55 by bvm")
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 4-Aug-89 16:55 by bvm")
|
||||
|
||||
(* ;; "Called from Looks (sub)commands of Lafite display window. Replace VP eol (29) with ours.")
|
||||
(* ;;
|
||||
"Called from Looks (sub)commands of Lafite display window. Replace VP eol (29) with ours.")
|
||||
|
||||
(RESETLST
|
||||
(RESETSAVE NIL (LIST 'TEXTPROP TEXTSTREAM 'READONLY T))
|
||||
(TEXTPROP TEXTSTREAM 'READONLY NIL)
|
||||
(LET ((SEL (TEDIT.GETSEL TEXTSTREAM))
|
||||
POS)
|
||||
(if (<= (TEDIT.SELPROP SEL 'LENGTH)
|
||||
1)
|
||||
then (* ;
|
||||
"If user has already selected something (more than a single character), assume is not accidental.")
|
||||
(SETQ POS (CADAR (LAFITE.PARSE.HEADER TEXTSTREAM NIL NIL NIL NIL T)))
|
||||
(TEDIT.SETSEL TEXTSTREAM POS (- (GETEOFPTR TEXTSTREAM)
|
||||
(if LAFITEENDOFMESSAGESTR
|
||||
then (NCHARS LAFITEENDOFMESSAGESTR)
|
||||
else 0)
|
||||
POS)))
|
||||
(TEDIT.SUBSTITUTE TEXTSTREAM (ALLOCSTRING 1 29)
|
||||
(ALLOCSTRING 1 (CHARCODE EOL)))
|
||||
(if POS
|
||||
then (* ; "Undo the selection")
|
||||
(TEDIT.SETSEL TEXTSTREAM 1 0))))])
|
||||
(LET* ((SEL (TEDIT.GETSEL TEXTSTREAM))
|
||||
(LEN (fetch (SELECTION DCH) of SEL))
|
||||
POS)
|
||||
(if (<= LEN 1)
|
||||
then (* ;
|
||||
"If user has already selected something (more than a single character), assume is not accidental.")
|
||||
(SETQ POS (CADAR (LAFITE.PARSE.HEADER TEXTSTREAM NIL NIL NIL NIL T)))
|
||||
(TEDIT.SETSEL TEXTSTREAM POS (- (GETEOFPTR TEXTSTREAM)
|
||||
(if LAFITEENDOFMESSAGESTR
|
||||
then (NCHARS LAFITEENDOFMESSAGESTR)
|
||||
else 0)
|
||||
POS)))
|
||||
(TEDIT.SUBSTITUTE TEXTSTREAM (ALLOCSTRING 1 29)
|
||||
(ALLOCSTRING 1 (CHARCODE EOL)))
|
||||
(if POS
|
||||
then (* ; "Undo the selection")
|
||||
(TEDIT.SETSEL TEXTSTREAM 1 0))))])
|
||||
)
|
||||
|
||||
(RPAQ? \LAFITE.DISPLAY.COMMANDS NIL)
|
||||
@@ -2545,37 +2546,37 @@
|
||||
(ADDTOVAR LAMA LAFITE.HARDCOPY.MESSAGES)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (7764 27568 (\LAFITE.DISPLAY 7774 . 9479) (\LAFITE.DO.DISPLAY 9481 . 13646) (
|
||||
SELECTMESSAGETODISPLAY 13648 . 16016) (MESSAGEDISPLAYER 16018 . 23570) (LA.COPY.MESSAGE.TEXT 23572 .
|
||||
24326) (\LAFITE.CLOSE.DISPLAYWINDOWS 24328 . 25922) (\LAFITE.CLOSE.DISPLAYER 25924 . 27566)) (27569
|
||||
36161 (\LAFITE.UNHIDE.HEADERS 27579 . 28669) (\LAFITE.HIDE.HEADERS 28671 . 29324) (
|
||||
\LAFITE.REHIDE.HEADERS 29326 . 30362) (LAFITE.EAT.UNDESIRABLE.FIELD 30364 . 31123) (LAFITE.EAT.GVGV
|
||||
31125 . 32286) (\LAFITE.HARDCOPY.FROM.DISPLAY 32288 . 35807) (LAFITE.HARDCOPY.TAB.WIDTH 35809 . 36159)
|
||||
) (36162 44530 (\LAFITE.SET.LOOKS.FROM.MENU 36172 . 36349) (\LAFITE.SET.DEFAULT.LOOKS 36351 . 36542) (
|
||||
\LAFITE.SET.FIXED.LOOKS 36544 . 36736) (LAFITE.SET.LOOKS 36738 . 41179) (LAFITE.SET.TAB.LOOKS 41181 .
|
||||
41892) (LAFITE.SET.PARA.SEPARATION 41894 . 42102) (LAFITE.SET.LOWER.CASE 42104 . 42955) (
|
||||
LAFITE.SUBSTITUTE.VP.EOL 42957 . 44528)) (46447 54775 (LAFITE.DELETE.MESSAGES 46457 . 47507) (
|
||||
\LAFITE.DELETE 47509 . 48696) (DISPLAYAFTERDELETE 48698 . 53424) (\LAFITE.SELECT.NEXT 53426 . 54064) (
|
||||
\LAFITE.UNDELETE 54066 . 54773)) (54797 69292 (LAFITE.MOVE.MESSAGES 54807 . 55454) (\COERCE.TO.MSGLST
|
||||
55456 . 56214) (\LAFITE.MOVETO 56216 . 60160) (\LAFITE.COPYTO 60162 . 60578) (\LAFITE.MOVETO.PROC
|
||||
60580 . 61850) (\LAFITE.MOVE.MESSAGES.INTERNAL 61852 . 69290)) (69318 77870 (\LAFITE.ENABLE.MOVE.MENU
|
||||
69328 . 70370) (\LAFITE.ADD.TO.MOVE.MENU 70372 . 71388) (\LAFITE.UPDATE.MOVE.MENU 71390 . 76030) (
|
||||
\LAFITE.RESTORE.MOVE.MENU 76032 . 76708) (\LAFITE.HANDLE.AUTO.MOVE 76710 . 77868)) (78726 96210 (
|
||||
\LAFITE.UPDATE 78736 . 84369) (\LAFITE.EXPUNGE.PROC 84371 . 85176) (\LAFITE.UPDATE.PROC 85178 . 86261)
|
||||
(\LAFITE.HARDCOPYONLY.PROC 86263 . 86705) (LAB.CHOOSE.UPDATE.MENU 86707 . 87488) (
|
||||
LAB.CREATE.UPDATE.MENU 87490 . 89389) (LAB.UPDATE.NEEDED? 89391 . 90961) (\LAFITE.START.UPDATE 90963
|
||||
. 91995) (LAB.START.COMMAND 91997 . 92847) (\LAFITE.FINISH.UPDATE 92849 . 95102) (
|
||||
\LAFITE.CLOSE.OTHER.FOLDERS 95104 . 96208)) (96211 131005 (LAB.FLUSHWINDOW 96221 . 97900) (
|
||||
LAB.APPENDMESSAGES 97902 . 101064) (\LAFITE.COMPACT.FOLDER 101066 . 105230) (\LAFITE.COMPACT.FOLDER1
|
||||
105232 . 121271) (\LAFITE.COMPACT.FOLDER2 121273 . 125987) (\LAFITE.COMPACT.EXTRA 125989 . 128304) (
|
||||
\LAFITE.INVALIDATE.TOC 128306 . 128999) (\LAFITE.RENAMEFILE 129001 . 129471) (SMART-RENAMEFILEP 129473
|
||||
. 130033) (LA.OPENTEMPFILE 130035 . 131003)) (131006 144348 (\LAFITE.UPDATE.FOLDER 131016 . 132993) (
|
||||
\LAFITE.UPDATE.CONTENTS 132995 . 133712) (\LAFITE.UPDATE.CONTENTS1 133714 . 138568) (WRITETOCENTRY
|
||||
138570 . 141688) (WRITETOCMARKBYTES 141690 . 141932) (WRITEFOLDERMARKBYTES 141934 . 144346)) (144374
|
||||
163349 (LAFITE.HARDCOPY.MESSAGES 144384 . 144844) (\LAFITE.HARDCOPY 144846 . 145181) (
|
||||
\LAFITE.HARDCOPY.PROC 145183 . 148661) (\LAFITE.HARDCOPY.HEADERS 148663 . 153992) (
|
||||
\LAFITE.MARK.HARDCOPIED 153994 . 155704) (\LAFITE.TRANSMIT.HARDCOPY 155706 . 157296) (
|
||||
\LAFITE.HARDCOPY.BODIES 157298 . 158540) (\LAFITE.APPEND.MESSAGE.BODY 158542 . 160650) (
|
||||
\LAFITE.DO.PENDING.HARDCOPY 160652 . 161727) (\LAFITE.CANCEL.HARDCOPY 161729 . 162445) (
|
||||
\LAFITE.CLEAR.HARDCOPY.STATE 162447 . 163347)))))
|
||||
(FILEMAP (NIL (7743 27547 (\LAFITE.DISPLAY 7753 . 9458) (\LAFITE.DO.DISPLAY 9460 . 13625) (
|
||||
SELECTMESSAGETODISPLAY 13627 . 15995) (MESSAGEDISPLAYER 15997 . 23549) (LA.COPY.MESSAGE.TEXT 23551 .
|
||||
24305) (\LAFITE.CLOSE.DISPLAYWINDOWS 24307 . 25901) (\LAFITE.CLOSE.DISPLAYER 25903 . 27545)) (27548
|
||||
36140 (\LAFITE.UNHIDE.HEADERS 27558 . 28648) (\LAFITE.HIDE.HEADERS 28650 . 29303) (
|
||||
\LAFITE.REHIDE.HEADERS 29305 . 30341) (LAFITE.EAT.UNDESIRABLE.FIELD 30343 . 31102) (LAFITE.EAT.GVGV
|
||||
31104 . 32265) (\LAFITE.HARDCOPY.FROM.DISPLAY 32267 . 35786) (LAFITE.HARDCOPY.TAB.WIDTH 35788 . 36138)
|
||||
) (36141 44444 (\LAFITE.SET.LOOKS.FROM.MENU 36151 . 36328) (\LAFITE.SET.DEFAULT.LOOKS 36330 . 36521) (
|
||||
\LAFITE.SET.FIXED.LOOKS 36523 . 36715) (LAFITE.SET.LOOKS 36717 . 41174) (LAFITE.SET.TAB.LOOKS 41176 .
|
||||
41887) (LAFITE.SET.PARA.SEPARATION 41889 . 42097) (LAFITE.SET.LOWER.CASE 42099 . 42950) (
|
||||
LAFITE.SUBSTITUTE.VP.EOL 42952 . 44442)) (46361 54689 (LAFITE.DELETE.MESSAGES 46371 . 47421) (
|
||||
\LAFITE.DELETE 47423 . 48610) (DISPLAYAFTERDELETE 48612 . 53338) (\LAFITE.SELECT.NEXT 53340 . 53978) (
|
||||
\LAFITE.UNDELETE 53980 . 54687)) (54711 69206 (LAFITE.MOVE.MESSAGES 54721 . 55368) (\COERCE.TO.MSGLST
|
||||
55370 . 56128) (\LAFITE.MOVETO 56130 . 60074) (\LAFITE.COPYTO 60076 . 60492) (\LAFITE.MOVETO.PROC
|
||||
60494 . 61764) (\LAFITE.MOVE.MESSAGES.INTERNAL 61766 . 69204)) (69232 77784 (\LAFITE.ENABLE.MOVE.MENU
|
||||
69242 . 70284) (\LAFITE.ADD.TO.MOVE.MENU 70286 . 71302) (\LAFITE.UPDATE.MOVE.MENU 71304 . 75944) (
|
||||
\LAFITE.RESTORE.MOVE.MENU 75946 . 76622) (\LAFITE.HANDLE.AUTO.MOVE 76624 . 77782)) (78640 96124 (
|
||||
\LAFITE.UPDATE 78650 . 84283) (\LAFITE.EXPUNGE.PROC 84285 . 85090) (\LAFITE.UPDATE.PROC 85092 . 86175)
|
||||
(\LAFITE.HARDCOPYONLY.PROC 86177 . 86619) (LAB.CHOOSE.UPDATE.MENU 86621 . 87402) (
|
||||
LAB.CREATE.UPDATE.MENU 87404 . 89303) (LAB.UPDATE.NEEDED? 89305 . 90875) (\LAFITE.START.UPDATE 90877
|
||||
. 91909) (LAB.START.COMMAND 91911 . 92761) (\LAFITE.FINISH.UPDATE 92763 . 95016) (
|
||||
\LAFITE.CLOSE.OTHER.FOLDERS 95018 . 96122)) (96125 130919 (LAB.FLUSHWINDOW 96135 . 97814) (
|
||||
LAB.APPENDMESSAGES 97816 . 100978) (\LAFITE.COMPACT.FOLDER 100980 . 105144) (\LAFITE.COMPACT.FOLDER1
|
||||
105146 . 121185) (\LAFITE.COMPACT.FOLDER2 121187 . 125901) (\LAFITE.COMPACT.EXTRA 125903 . 128218) (
|
||||
\LAFITE.INVALIDATE.TOC 128220 . 128913) (\LAFITE.RENAMEFILE 128915 . 129385) (SMART-RENAMEFILEP 129387
|
||||
. 129947) (LA.OPENTEMPFILE 129949 . 130917)) (130920 144262 (\LAFITE.UPDATE.FOLDER 130930 . 132907) (
|
||||
\LAFITE.UPDATE.CONTENTS 132909 . 133626) (\LAFITE.UPDATE.CONTENTS1 133628 . 138482) (WRITETOCENTRY
|
||||
138484 . 141602) (WRITETOCMARKBYTES 141604 . 141846) (WRITEFOLDERMARKBYTES 141848 . 144260)) (144288
|
||||
163263 (LAFITE.HARDCOPY.MESSAGES 144298 . 144758) (\LAFITE.HARDCOPY 144760 . 145095) (
|
||||
\LAFITE.HARDCOPY.PROC 145097 . 148575) (\LAFITE.HARDCOPY.HEADERS 148577 . 153906) (
|
||||
\LAFITE.MARK.HARDCOPIED 153908 . 155618) (\LAFITE.TRANSMIT.HARDCOPY 155620 . 157210) (
|
||||
\LAFITE.HARDCOPY.BODIES 157212 . 158454) (\LAFITE.APPEND.MESSAGE.BODY 158456 . 160564) (
|
||||
\LAFITE.DO.PENDING.HARDCOPY 160566 . 161641) (\LAFITE.CANCEL.HARDCOPY 161643 . 162359) (
|
||||
\LAFITE.CLEAR.HARDCOPY.STATE 162361 . 163261)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,18 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "22-Jan-87 01:34:36" {ERIS}<LISPUSERS>LISPCORE>LAFITE-INDENT.;1 25845
|
||||
|
||||
(FILECREATED "15-Feb-2025 14:11:54" {WMEDLEY}<library>lafite>LAFITE-INDENT.;4 26926
|
||||
previous date%: "21-Jan-87 16:06:01" {ERIS}<LISPUSERS>KOTO>LAFITE-INDENT.;5)
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT-INDENT-BREAK-LONG-LINES TEDIT-INDENT-SELECTION TEDIT-OPEN-LINE
|
||||
TEDIT-MAKE-LINES-EXPLICIT TEDIT-INDENT-SET-INDENT)
|
||||
|
||||
:PREVIOUS-DATE "15-Feb-2025 09:21:58" {WMEDLEY}<library>lafite>LAFITE-INDENT.;3)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-INDENTCOMS)
|
||||
|
||||
(RPAQQ LAFITE-INDENTCOMS
|
||||
(RPAQQ LAFITE-INDENTCOMS
|
||||
[(* * LAFITE-INDENT defines a function that will indent the current selection.)
|
||||
(FNS TEDIT-INDENT-ADD-INDENTATION TEDIT-INDENT-BREAK-LINE TEDIT-INDENT-BREAK-LONG-LINES
|
||||
TEDIT-INDENT-FIND-BREAKPOINT TEDIT-INDENT-REPLACE-SELECTION TEDIT-INDENT-SELECTION
|
||||
@@ -33,14 +31,12 @@
|
||||
(SUBITEMS (Indent 'TEDIT-INDENT-SELECTION
|
||||
"Indent the current selection"
|
||||
)
|
||||
("Indent & keep lines"
|
||||
'
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
|
||||
|
||||
("Indent & keep lines" '
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
|
||||
"Indent the current selection, keeping existing line breaks"
|
||||
)
|
||||
("Set indent"
|
||||
'TEDIT-INDENT-SET-INDENT
|
||||
("Set indent" '
|
||||
TEDIT-INDENT-SET-INDENT
|
||||
"Set the indent string to a new value"
|
||||
)
|
||||
(Unindent 'TEDIT-REMOVE-INDENT
|
||||
@@ -49,14 +45,12 @@
|
||||
("Open line" 'TEDIT-OPEN-LINE
|
||||
"Open a blank line at the current position"
|
||||
)
|
||||
("Insert <RETURN>s"
|
||||
'TEDIT-MAKE-LINES-EXPLICIT
|
||||
("Insert <RETURN>s" '
|
||||
TEDIT-MAKE-LINES-EXPLICIT
|
||||
"Insert real <RETURN>s at the end of each line in the current selection"
|
||||
)
|
||||
("Break long lines"
|
||||
'
|
||||
TEDIT-INDENT-BREAK-LONG-LINES
|
||||
|
||||
("Break long lines" '
|
||||
TEDIT-INDENT-BREAK-LONG-LINES
|
||||
"Break long lines by inserting explicit <RETURN>'s"
|
||||
])
|
||||
(* * LAFITE-INDENT defines a function that will indent the current selection.)
|
||||
@@ -133,10 +127,14 @@
|
||||
max-length max-length])
|
||||
|
||||
(TEDIT-INDENT-BREAK-LONG-LINES
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
|
||||
(* smL "21-Jan-87 16:03")
|
||||
|
||||
(* ;;; "Break the current selection into explicit lines, each having no more than *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:03")
|
||||
|
||||
(* * Break the current selection into explicit lines, each having no more than
|
||||
*TEDIT-INDENT-LINE-LENGTH* characters. -
|
||||
If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
|
||||
the current selection are removed. -
|
||||
This is intended to be used in Lafite, where one wants to indent a piece of a
|
||||
forwarded document, but can be used in any TEdit document)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT-INDENT-REPLACE-SELECTION
|
||||
@@ -144,13 +142,11 @@
|
||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||
text-stream selection)
|
||||
explicit-paragraph-breaks?)
|
||||
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1)
|
||||
(TEDIT.SELPROP selection 'CH#]
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1]
|
||||
bind [hanging-indent _
|
||||
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
|
||||
(fetch CH# of selection)))
|
||||
(DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1 of (CAR (fetch L1 of selection]
|
||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||
"" *TEDIT-INDENT-LINE-LENGTH* hanging-indent)
|
||||
*eol-string*)
|
||||
@@ -185,10 +181,15 @@
|
||||
'RIGHT])
|
||||
|
||||
(TEDIT-INDENT-SELECTION
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
|
||||
(* smL "21-Jan-87 16:00")
|
||||
|
||||
(* ;;; "Indent the current selection by prefacing each line with the value of *TEDIT-INDENT-STRING*, and inserting line breaks after each *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:00")
|
||||
|
||||
(* * Indent the current selection by prefacing each line with the value of
|
||||
*TEDIT-INDENT-STRING*, and inserting line breaks after each
|
||||
*TEDIT-INDENT-LINE-LENGTH* characters. -
|
||||
If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
|
||||
the current selection are removed. -
|
||||
This is intended to be used in Lafite, where one wants to indent a piece of a
|
||||
forwarded document, but can be used in any TEdit document)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT-INDENT-REPLACE-SELECTION
|
||||
@@ -196,13 +197,11 @@
|
||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||
text-stream selection)
|
||||
explicit-paragraph-breaks?)
|
||||
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1)
|
||||
(TEDIT.SELPROP selection 'CH#]
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1]
|
||||
bind [hanging-indent _
|
||||
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
|
||||
(fetch CH# of selection)))
|
||||
(DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1 of (CAR (fetch L1 of selection]
|
||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||
*TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*
|
||||
hanging-indent)
|
||||
@@ -232,19 +231,18 @@
|
||||
else (\TEDIT-INDENT-SEPERATE-PARAGRAPHS string NIL])
|
||||
|
||||
(TEDIT-INDENT-SET-INDENT
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:21 by rmk")
|
||||
(* smL "12-Sep-86 17:09")
|
||||
[LAMBDA (text-stream) (* smL "12-Sep-86 17:09")
|
||||
|
||||
(* * Prompt the user for a new indentation string)
|
||||
|
||||
(* ;;; "Prompt the user for a new indentation string")
|
||||
|
||||
(LET* ((window (\TEDIT.PRIMARYPANE text-stream))
|
||||
(LET* ((window (fetch \WINDOW of (TEXTOBJ text-stream)))
|
||||
(pwindow (if window
|
||||
then (GETPROMPTWINDOW (if (LISTP window)
|
||||
then (CAR window)
|
||||
else window))
|
||||
else PROMPTWINDOW)))
|
||||
(CLEARW pwindow)
|
||||
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
|
||||
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
|
||||
pwindow NIL NIL (LIST (CHARCODE EOL])
|
||||
|
||||
(TEDIT-INDENT-STRIP-INDENTATION
|
||||
@@ -269,34 +267,36 @@
|
||||
else string])
|
||||
|
||||
(TEDIT-MAKE-LINES-EXPLICIT
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:20 by rmk")
|
||||
(* smL " 8-Sep-86 18:20")
|
||||
|
||||
(* ;;; "Take the current selection and replace all TEdit end-of-lines with explicit line breaks. --- This is intended to be used in Lafite, where it is sometimes nice to know that anyone receiving the msg will see the same line breaks that you see. see, but can be used in any TEdit document")
|
||||
[LAMBDA (text-stream) (* smL " 8-Sep-86 18:20")
|
||||
|
||||
(* * Take the current selection and replace all TEdit end-of-lines with
|
||||
explicit line breaks. -
|
||||
This is intended to be used in Lafite, where it is sometimes nice to know that
|
||||
anyone receiving the msg will see the same line breaks that you see.
|
||||
see, but can be used in any TEdit document)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
[for i in (bind (this-line _ (CAR (GETSEL selection L1)))
|
||||
[last-line _ (CAR (LAST (GETSEL selection LN]
|
||||
repeatuntil (PROGN (SETQ this-line (GETLD this-line NEXTLINE))
|
||||
(EQ this-line last-line)) collect (GETLD this-line LCHARLIM)
|
||||
) do (TEDIT.SETSEL text-stream i 1 'LEFT T)
|
||||
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
|
||||
[for i in (bind (this-line _ (CAR (fetch L1 of selection)))
|
||||
[last-line _ (CAR (LAST (fetch LN of selection]
|
||||
repeatuntil (PROGN (SETQ this-line (fetch NEXTLINE of this-line))
|
||||
(EQ this-line last-line)) collect (fetch CHARLIM
|
||||
of this-line))
|
||||
do (TEDIT.SETSEL text-stream i 1 'LEFT T)
|
||||
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
|
||||
(TEDIT.SETSEL text-stream selection NIL 'RIGHT])
|
||||
|
||||
(TEDIT-OPEN-LINE
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 14:09 by rmk")
|
||||
(* smL "17-Sep-86 11:13")
|
||||
|
||||
(* ;;; "Open a new line at the current position.")
|
||||
[LAMBDA (text-stream) (* smL "17-Sep-86 11:13")
|
||||
|
||||
(* * Open a new line at the current position.)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT.INSERT text-stream (CONCAT *eol-string* (ALLOCSTRING
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1))
|
||||
" ")))
|
||||
(if (ZEROP (TEDIT.SELPROP selection 'LENGTH))
|
||||
(TEDIT.INSERT text-stream (CONCAT *eol-string*
|
||||
(ALLOCSTRING [DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1
|
||||
of (CAR (fetch L1 of selection]
|
||||
" ")))
|
||||
(if (ZEROP (fetch DCH of selection))
|
||||
then (TEDIT.SETSEL text-stream selection])
|
||||
|
||||
(TEDIT-REMOVE-INDENT
|
||||
@@ -393,27 +393,21 @@
|
||||
|
||||
(RPAQ *eol-string* (CHARACTER (CHARCODE EOL)))
|
||||
|
||||
|
||||
[CONSTANTS (*eol-string* (CHARACTER (CHARCODE EOL]
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*)
|
||||
)
|
||||
|
||||
(OR (GETD 'TEDIT)
|
||||
(FILESLOAD TEDIT))
|
||||
|
||||
(TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU 'Indent)
|
||||
|
||||
[TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Indent 'TEDIT-INDENT-SELECTION
|
||||
"Indent the current selection"
|
||||
(SUBITEMS (Indent 'TEDIT-INDENT-SELECTION
|
||||
"Indent the current selection")
|
||||
("Indent & keep lines"
|
||||
'
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
|
||||
|
||||
("Indent & keep lines" '
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
|
||||
"Indent the current selection, keeping existing line breaks"
|
||||
)
|
||||
("Set indent" 'TEDIT-INDENT-SET-INDENT
|
||||
@@ -424,21 +418,21 @@
|
||||
("Open line" 'TEDIT-OPEN-LINE
|
||||
"Open a blank line at the current position"
|
||||
)
|
||||
("Insert <RETURN>s" 'TEDIT-MAKE-LINES-EXPLICIT
|
||||
|
||||
("Insert <RETURN>s" 'TEDIT-MAKE-LINES-EXPLICIT
|
||||
"Insert real <RETURN>s at the end of each line in the current selection"
|
||||
)
|
||||
("Break long lines"
|
||||
'TEDIT-INDENT-BREAK-LONG-LINES
|
||||
("Break long lines" '
|
||||
TEDIT-INDENT-BREAK-LONG-LINES
|
||||
"Break long lines by inserting explicit <RETURN>'s"
|
||||
]
|
||||
(PUTPROPS LAFITE-INDENT COPYRIGHT ("Xerox Corporation" 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4363 24314 (TEDIT-INDENT-ADD-INDENTATION 4373 . 6941) (TEDIT-INDENT-BREAK-LINE 6943 .
|
||||
8876) (TEDIT-INDENT-BREAK-LONG-LINES 8878 . 10828) (TEDIT-INDENT-FIND-BREAKPOINT 10830 . 11653) (
|
||||
TEDIT-INDENT-REPLACE-SELECTION 11655 . 12212) (TEDIT-INDENT-SELECTION 12214 . 14283) (
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 14285 . 14564) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14566 .
|
||||
15295) (TEDIT-INDENT-SET-INDENT 15297 . 16143) (TEDIT-INDENT-STRIP-INDENTATION 16145 . 17365) (
|
||||
TEDIT-MAKE-LINES-EXPLICIT 17367 . 18517) (TEDIT-OPEN-LINE 18519 . 19453) (TEDIT-REMOVE-INDENT 19455 .
|
||||
20225) (\TEDIT-INDENT-COUNT-SPACES 20227 . 20828) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20830 . 21801) (
|
||||
\TEDIT-INDENT-SEPERATE-LINES 21803 . 22601) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 22603 . 24312)))))
|
||||
(FILEMAP (NIL (3949 23354 (TEDIT-INDENT-ADD-INDENTATION 3959 . 6527) (TEDIT-INDENT-BREAK-LINE 6529 .
|
||||
8462) (TEDIT-INDENT-BREAK-LONG-LINES 8464 . 10231) (TEDIT-INDENT-FIND-BREAKPOINT 10233 . 11056) (
|
||||
TEDIT-INDENT-REPLACE-SELECTION 11058 . 11615) (TEDIT-INDENT-SELECTION 11617 . 13518) (
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 13520 . 13799) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 13801 .
|
||||
14530) (TEDIT-INDENT-SET-INDENT 14532 . 15306) (TEDIT-INDENT-STRIP-INDENTATION 15308 . 16528) (
|
||||
TEDIT-MAKE-LINES-EXPLICIT 16530 . 17735) (TEDIT-OPEN-LINE 17737 . 18493) (TEDIT-REMOVE-INDENT 18495 .
|
||||
19265) (\TEDIT-INDENT-COUNT-SPACES 19267 . 19868) (\TEDIT-INDENT-FIND-PARAGRAPH-END 19870 . 20841) (
|
||||
\TEDIT-INDENT-SEPERATE-LINES 20843 . 21641) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 21643 . 23352)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Feb-2025 13:05:38" {WMEDLEY}<library>lafite>LAFITE-SEND.;4 100003
|
||||
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2 100561
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \SENDMSG.CHANGE.MODE)
|
||||
:CHANGES-TO (VARS LAFITE-SENDCOMS)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2)
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:03:43" {WMEDLEY}<library>lafite>LAFITE-SEND.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-SENDCOMS)
|
||||
@@ -222,14 +222,14 @@
|
||||
(ERROR!])
|
||||
|
||||
(\SENDMSG.CHANGE.MODE
|
||||
[LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited 15-Feb-2025 13:05 by rmk")
|
||||
(* ; "Edited 5-Jan-90 18:06 by bvm")
|
||||
[LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited 5-Jan-90 18:06 by bvm")
|
||||
(LET*
|
||||
[(OLDMODE (TEXTPROP TEXTSTREAM 'LAFITEMODE))
|
||||
(OTHERMODES (for MODE in LAFITEMODELST unless (OR (EQ (fetch (LAFITEOPS LAFITEMODE)
|
||||
of MODE)
|
||||
OLDMODE)
|
||||
(NLISTP (CDR MODE)))
|
||||
(OTHERMODES (for MODE in LAFITEMODELST unless (OR (EQ (fetch (LAFITEOPS
|
||||
LAFITEMODE)
|
||||
of MODE)
|
||||
OLDMODE)
|
||||
(NLISTP (CDR MODE)))
|
||||
collect (fetch (LAFITEOPS LAFITEMODE) of MODE)))
|
||||
(NEWMODE (if (NULL OTHERMODES)
|
||||
then (\SENDMESSAGE.PROMPT WINDOW "There are no other modes")
|
||||
@@ -244,51 +244,58 @@
|
||||
N N2)
|
||||
(if (NULL NEWMODEDATA)
|
||||
then (\SENDMESSAGE.PROMPT WINDOW (CL:FORMAT NIL
|
||||
"Can't authenticate user in ~A mode"
|
||||
NEWMODE))
|
||||
else (LET ((OLDNAME (fetch (LAFITEMODEDATA FULLUSERNAME) of OLDMODEDATA))
|
||||
(END (TEDIT.FIND TEXTSTREAM "
|
||||
"Can't authenticate user in ~A mode"
|
||||
NEWMODE))
|
||||
else (LET ((OLDNAME (fetch (LAFITEMODEDATA FULLUSERNAME) of OLDMODEDATA)
|
||||
)
|
||||
(END (TEDIT.FIND TEXTSTREAM "
|
||||
|
||||
" 1))
|
||||
START N LEN NEW OLDSEL)
|
||||
(if END
|
||||
then (add END 1)) (* ;
|
||||
"Don't search past end of header. END now points at second cr.")
|
||||
[for FIELD in '("cc" "Reply-to")
|
||||
when [AND (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM FIELD END))
|
||||
(PROGN (SETQ LEN (CADR N))
|
||||
(SETQ N (CAR N))
|
||||
(SETQ START (STRPOS OLDNAME (SETQ OLDSEL
|
||||
(TEDIT.SEL.AS.STRING
|
||||
TEXTSTREAM N LEN))
|
||||
NIL NIL NIL NIL UPPERCASEARRAY]
|
||||
do (* ; "Change field containing old user name to new. This is much more complicated than it needs to be because TEDIT.FIND is case sensitive.")
|
||||
(TEDIT.DELETE TEXTSTREAM N LEN)
|
||||
(TEDIT.INSERT TEXTSTREAM (SETQ NEW
|
||||
(CONCAT (OR (SUBSTRING OLDSEL 1
|
||||
(SUB1 START))
|
||||
"")
|
||||
(fetch (LAFITEMODEDATA FULLUSERNAME
|
||||
) of NEWMODEDATA)
|
||||
(OR (SUBSTRING OLDSEL
|
||||
(+ START (NCHARS OLDNAME
|
||||
)))
|
||||
"")))
|
||||
N)
|
||||
(AND END (add END (- (NCHARS NEW)
|
||||
LEN]
|
||||
(if (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM "To" END))
|
||||
then (* ;
|
||||
"Leave the To field selected for address modification")
|
||||
(TEDIT.SETSEL TEXTSTREAM (CAR N)
|
||||
(CADR N)
|
||||
'RIGHT T))
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEMODE NEWMODE)
|
||||
(if (SETQ N (STRPOS (CONCAT "(" OLDMODE ")")
|
||||
TITLE))
|
||||
then (WINDOWPROP WINDOW 'TITLE (CONCAT (SUBSTRING TITLE 1 N)
|
||||
NEWMODE ")")))
|
||||
(\SENDMESSAGE.PROMPT WINDOW "Message mode is now " NEWMODE]
|
||||
START N LEN NEW OLDSEL)
|
||||
(if END
|
||||
then (add END 1)) (* ;
|
||||
"Don't search past end of header. END now points at second cr.")
|
||||
[for FIELD in '("cc" "Reply-to")
|
||||
when [AND (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM FIELD END
|
||||
))
|
||||
(PROGN (SETQ LEN (CADR N))
|
||||
(SETQ N (CAR N))
|
||||
(SETQ START
|
||||
(STRPOS OLDNAME
|
||||
(SETQ OLDSEL
|
||||
(TEDIT.SEL.AS.STRING TEXTSTREAM
|
||||
(create SELECTION
|
||||
CH# _ N
|
||||
DCH _ LEN)))
|
||||
NIL NIL NIL NIL UPPERCASEARRAY]
|
||||
do (* ; "Change field containing old user name to new. This is much more complicated than it needs to be because TEDIT.FIND is case sensitive.")
|
||||
(TEDIT.DELETE TEXTSTREAM N LEN)
|
||||
(TEDIT.INSERT TEXTSTREAM
|
||||
(SETQ NEW (CONCAT (OR (SUBSTRING OLDSEL 1 (SUB1 START)
|
||||
)
|
||||
"")
|
||||
(fetch (LAFITEMODEDATA
|
||||
FULLUSERNAME)
|
||||
of NEWMODEDATA)
|
||||
(OR (SUBSTRING OLDSEL
|
||||
(+ START (NCHARS OLDNAME))
|
||||
)
|
||||
"")))
|
||||
N)
|
||||
(AND END (add END (- (NCHARS NEW)
|
||||
LEN]
|
||||
(if (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM "To" END))
|
||||
then (* ;
|
||||
"Leave the To field selected for address modification")
|
||||
(TEDIT.SETSEL TEXTSTREAM (CAR N)
|
||||
(CADR N)
|
||||
'RIGHT T))
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEMODE NEWMODE)
|
||||
(if (SETQ N (STRPOS (CONCAT "(" OLDMODE ")")
|
||||
TITLE))
|
||||
then (WINDOWPROP WINDOW 'TITLE (CONCAT (SUBSTRING TITLE 1 N)
|
||||
NEWMODE ")")))
|
||||
(\SENDMESSAGE.PROMPT WINDOW "Message mode is now " NEWMODE]
|
||||
|
||||
(* ;; "Exit with error so that the window is restored to previous state")
|
||||
|
||||
@@ -1754,29 +1761,29 @@ cc: ~A
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5218 27633 (DOLAFITESENDINGCOMMAND 5228 . 5718) (\SENDMESSAGE.INITIATE 5720 . 7659) (
|
||||
\SENDMSG.DELIVER 7661 . 8269) (\SENDMSG.EXIT.TEDIT 8271 . 8642) (\SENDMSG.SAVE.FORM 8644 . 10631) (
|
||||
\LAFITE.HEADER.EOF 10633 . 10926) (\LAFITE.INSERT.REPLYTO 10928 . 11536) (\SENDMSG.REPLYTO 11538 .
|
||||
12097) (\SENDMSG.CHANGE.MODE 12099 . 17113) (\SENDMSG.FIND.FIELD 17115 . 17625) (\SENDMESSAGE.PARSE
|
||||
17627 . 18423) (\LAFITE.PREPARE.SEND 18425 . 21258) (\LAFITE.PREPARE.ERROR 21260 . 22442) (
|
||||
\LAFITE.CHOOSE.MSG.FORMAT 22444 . 25085) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25087 . 26012) (
|
||||
\SENDMESSAGE.MENUPROMPT 26014 . 26877) (\SENDMESSAGE.PROMPT 26879 . 27415) (\SENDMESSAGEFAIL 27417 .
|
||||
27631)) (27634 52296 (\SENDMESSAGE 27644 . 28996) (\SENDMESSAGE.RESTARTABLE 28998 . 34199) (
|
||||
\SENDMESSAGE.CLEANUP 34201 . 34417) (\SENDMESSAGE.MAKEWINDOW 34419 . 40592) (MAKELAFITEDELIVERMENU
|
||||
40594 . 40901) (\LAFITE.CLOSEMSG? 40903 . 41853) (\LAFITE.AFTER.DELIVER 41855 . 45174) (
|
||||
\LAFITE.UNSENT.ICON 45176 . 45486) (\LAFITE.FETCH.SUBJECT 45488 . 46288) (LAFITE.SENDMESSAGE 46290 .
|
||||
47183) (\SENDMESSAGE0 47185 . 50049) (LA.ASSURE.PROMPT.WINDOW 50051 . 50948) (\LAFITE.SEND.FAIL 50950
|
||||
. 51421) (\LAFITE.INVALID.RECIPIENTS 51423 . 51881) (\SENDMESSAGE.ABORT 51883 . 52294)) (52328 62241
|
||||
(\OUTBOX.CREATE 52338 . 53801) (\OUTBOX.RESET 53803 . 54296) (\OUTBOX.CLOSEFN 54298 . 54438) (
|
||||
\OUTBOX.REPAINTFN 54440 . 55103) (\OUTBOX.RESHAPEFN 55105 . 56388) (\OUTBOX.SHADEITEM 56390 . 57063) (
|
||||
\OUTBOX.BUTTONFN 57065 . 59913) (\OUTBOX.DISPLAYLINE 59915 . 60409) (\OUTBOX.ADD.ITEM 60411 . 62239))
|
||||
(62537 78945 (\LAFITE.MESSAGEFORM 62547 . 66890) (MAKELAFITESUPPORTFORM 66892 . 67081) (
|
||||
MAKELISPSUPPORTFORM 67083 . 67249) (MAKEXXXSUPPORTFORM 67251 . 71300) (MAKENEWMESSAGEFORM 71302 .
|
||||
72258) (MAKELAFITEPRIVATEFORMSITEMS 72260 . 72688) (\LAFITE.UNCACHE.MESSAGEFORM 72690 . 73143) (
|
||||
\LAFITE.DELETE.MESSAGEFORM 73145 . 73746) (\LAFITE.SELECT.FORM 73748 . 74103) (
|
||||
\LAFITE.DELETE.FORM.INTERNAL 74105 . 75249) (\LAFITE.READ.FORM 75251 . 77988) (\LAFITE.FIND.TEMPLATE
|
||||
77990 . 78943)) (78969 86700 (\LAFITE.ANSWER 78979 . 79384) (\LAFITE.ANSWER.PROC 79386 . 81280) (
|
||||
MAKEANSWERFORM 81282 . 83812) (LA.PRINT.COMMA.LIST 83814 . 84300) (LAFITE.FILL.IN.ANSWER.FORM 84302 .
|
||||
86698)) (86725 92921 (\LAFITE.FORWARD 86735 . 87143) (\LAFITE.FORWARD.PROC 87145 . 89134) (
|
||||
MAKEFORWARDFORM 89136 . 92919)))))
|
||||
(FILEMAP (NIL (5214 28191 (DOLAFITESENDINGCOMMAND 5224 . 5714) (\SENDMESSAGE.INITIATE 5716 . 7655) (
|
||||
\SENDMSG.DELIVER 7657 . 8265) (\SENDMSG.EXIT.TEDIT 8267 . 8638) (\SENDMSG.SAVE.FORM 8640 . 10627) (
|
||||
\LAFITE.HEADER.EOF 10629 . 10922) (\LAFITE.INSERT.REPLYTO 10924 . 11532) (\SENDMSG.REPLYTO 11534 .
|
||||
12093) (\SENDMSG.CHANGE.MODE 12095 . 17671) (\SENDMSG.FIND.FIELD 17673 . 18183) (\SENDMESSAGE.PARSE
|
||||
18185 . 18981) (\LAFITE.PREPARE.SEND 18983 . 21816) (\LAFITE.PREPARE.ERROR 21818 . 23000) (
|
||||
\LAFITE.CHOOSE.MSG.FORMAT 23002 . 25643) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25645 . 26570) (
|
||||
\SENDMESSAGE.MENUPROMPT 26572 . 27435) (\SENDMESSAGE.PROMPT 27437 . 27973) (\SENDMESSAGEFAIL 27975 .
|
||||
28189)) (28192 52854 (\SENDMESSAGE 28202 . 29554) (\SENDMESSAGE.RESTARTABLE 29556 . 34757) (
|
||||
\SENDMESSAGE.CLEANUP 34759 . 34975) (\SENDMESSAGE.MAKEWINDOW 34977 . 41150) (MAKELAFITEDELIVERMENU
|
||||
41152 . 41459) (\LAFITE.CLOSEMSG? 41461 . 42411) (\LAFITE.AFTER.DELIVER 42413 . 45732) (
|
||||
\LAFITE.UNSENT.ICON 45734 . 46044) (\LAFITE.FETCH.SUBJECT 46046 . 46846) (LAFITE.SENDMESSAGE 46848 .
|
||||
47741) (\SENDMESSAGE0 47743 . 50607) (LA.ASSURE.PROMPT.WINDOW 50609 . 51506) (\LAFITE.SEND.FAIL 51508
|
||||
. 51979) (\LAFITE.INVALID.RECIPIENTS 51981 . 52439) (\SENDMESSAGE.ABORT 52441 . 52852)) (52886 62799
|
||||
(\OUTBOX.CREATE 52896 . 54359) (\OUTBOX.RESET 54361 . 54854) (\OUTBOX.CLOSEFN 54856 . 54996) (
|
||||
\OUTBOX.REPAINTFN 54998 . 55661) (\OUTBOX.RESHAPEFN 55663 . 56946) (\OUTBOX.SHADEITEM 56948 . 57621) (
|
||||
\OUTBOX.BUTTONFN 57623 . 60471) (\OUTBOX.DISPLAYLINE 60473 . 60967) (\OUTBOX.ADD.ITEM 60969 . 62797))
|
||||
(63095 79503 (\LAFITE.MESSAGEFORM 63105 . 67448) (MAKELAFITESUPPORTFORM 67450 . 67639) (
|
||||
MAKELISPSUPPORTFORM 67641 . 67807) (MAKEXXXSUPPORTFORM 67809 . 71858) (MAKENEWMESSAGEFORM 71860 .
|
||||
72816) (MAKELAFITEPRIVATEFORMSITEMS 72818 . 73246) (\LAFITE.UNCACHE.MESSAGEFORM 73248 . 73701) (
|
||||
\LAFITE.DELETE.MESSAGEFORM 73703 . 74304) (\LAFITE.SELECT.FORM 74306 . 74661) (
|
||||
\LAFITE.DELETE.FORM.INTERNAL 74663 . 75807) (\LAFITE.READ.FORM 75809 . 78546) (\LAFITE.FIND.TEMPLATE
|
||||
78548 . 79501)) (79527 87258 (\LAFITE.ANSWER 79537 . 79942) (\LAFITE.ANSWER.PROC 79944 . 81838) (
|
||||
MAKEANSWERFORM 81840 . 84370) (LA.PRINT.COMMA.LIST 84372 . 84858) (LAFITE.FILL.IN.ANSWER.FORM 84860 .
|
||||
87256)) (87283 93479 (\LAFITE.FORWARD 87293 . 87701) (\LAFITE.FORWARD.PROC 87703 . 89692) (
|
||||
MAKEFORWARDFORM 89694 . 93477)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Feb-2025 14:03:21" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;4 6618
|
||||
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2 6592
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.ASSURE.NO.BACKING.FILE)
|
||||
:CHANGES-TO (VARS LAFITE-TEDITCOMS)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2)
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:09:24" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-TEDITCOMS)
|
||||
@@ -74,8 +74,7 @@
|
||||
(TEXTPROP TEXTSTREAM '\WINDOW NIL])
|
||||
|
||||
(TEDIT.ASSURE.NO.BACKING.FILE
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 15-Feb-2025 14:03 by rmk")
|
||||
(* ; "Edited 13-Jan-2024 18:08 by rmk")
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 13-Jan-2024 18:08 by rmk")
|
||||
(* ; "Edited 18-Jun-2023 09:31 by rmk")
|
||||
(* ; "Edited 29-Oct-2022 22:34 by rmk")
|
||||
(* ; "Edited 20-May-92 11:25 by rmk:")
|
||||
@@ -83,17 +82,18 @@
|
||||
(* ;; "This puts the contents of TEXTSTREAM to a nodircore file (if it isn't already on nodircore), and then sets it up for continuing in the current editing session. Essentially eliminates the file-system backing store.")
|
||||
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
|
||||
(OFILE (GETTEXTPROP TEXTSTREAM 'FILESTREAM))
|
||||
(OFILE (GETTOBJ TEXTOBJ TXTFILE))
|
||||
NEWFILE)
|
||||
(CL:WHEN [AND OFILE (NEQ 'NODIRCORE (FILENAMEFIELD (TRUEFILENAME OFILE)
|
||||
'HOST]
|
||||
(CL:WHEN [AND (TYPE? STREAM OFILE)
|
||||
(NEQ 'NODIRCORE (FETCH (FDEV DEVICENAME) OF (FETCH (STREAM DEVICE)
|
||||
OF (TRUEFILENAME OFILE]
|
||||
(SETQ NEWFILE (OPENSTREAM '{NODIRCORE} 'BOTH))
|
||||
|
||||
(* ;; "\TEDIT.PUT.PCTB will save the current text and looks in NEWFILE, leaving it open. It returns the sequence of new looks for continued editing, where all the file pieces point to their position in NEWFILE. But the file PCONTENTS do not yet point to the new stream. ")
|
||||
|
||||
(CLOSEF? OFILE)
|
||||
(\TEDIT.INSERT.NEWPIECES NEWFILE TEXTOBJ (\TEDIT.PUT.PCTB TEXTOBJ NEWFILE NIL T))
|
||||
(PUTTEXTPROP TEXTOBJ 'TXTFILE NIL)
|
||||
(FSETTOBJ TEXTOBJ TXTFILE NIL)
|
||||
(PUTTEXTPROP TEXTOBJ 'CACHE NEWFILE)
|
||||
TEXTSTREAM)])
|
||||
|
||||
@@ -118,6 +118,6 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (998 6387 (LA.ADJUST.FORMATTING 1008 . 4054) (LA.DETACH.TEDIT 4056 . 4422) (
|
||||
TEDIT.ASSURE.NO.BACKING.FILE 4424 . 6105) (LA.WINDOW.FROM.TEXTSTREAM 6107 . 6385)))))
|
||||
(FILEMAP (NIL (987 6361 (LA.ADJUST.FORMATTING 997 . 4043) (LA.DETACH.TEDIT 4045 . 4411) (
|
||||
TEDIT.ASSURE.NO.BACKING.FILE 4413 . 6079) (LA.WINDOW.FROM.TEXTSTREAM 6081 . 6359)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1340
library/tedit/TEDIT
1340
library/tedit/TEDIT
File diff suppressed because it is too large
Load Diff
@@ -1,211 +1,98 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Apr-2025 23:45:12" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;23 16200
|
||||
(FILECREATED "31-Oct-2024 17:53:21" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;9 10946
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.PARSE)
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
|
||||
|
||||
:PREVIOUS-DATE "20-Apr-2025 23:30:29" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;22)
|
||||
:PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;8)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
||||
|
||||
(RPAQQ TEDIT-ABBREVCOMS
|
||||
[(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.PARSE \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
(INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE])
|
||||
(RPAQQ TEDIT-ABBREVCOMS [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
(INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE])
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.ABBREV.EXPAND
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 20-Apr-2025 23:30 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 31-Oct-2024 17:50 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
(* ; "Edited 17-May-2023 13:31 by rmk")
|
||||
(* ; "Edited 8-Sep-2022 23:53 by rmk")
|
||||
(* ; "Edited 1-Aug-2022 12:04 by rmk")
|
||||
(* ; "Edited 30-May-91 19:27 by jds")
|
||||
(* ; "Expand an abbvreviation")
|
||||
(LET ((CANDIDATES (\TEDIT.ABBREV.PARSE TSTREAM SEL))
|
||||
CAND EXPANSION)
|
||||
|
||||
(* ;; "Candidates are ordered longest first, so D doesn't override EMDASH.")
|
||||
|
||||
(* ;; "Try literal match first, then fiddle the case.")
|
||||
|
||||
(* ;; "If we don't find it in abbrevs, try for a character code.")
|
||||
|
||||
[SETQ CAND (OR (find C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(CAR C)
|
||||
TSTREAM)))
|
||||
(for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(U-CASE (CAR C))
|
||||
TSTREAM)))
|
||||
(for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(L-CASE (CAR C))
|
||||
TSTREAM]
|
||||
(if EXPANSION
|
||||
then (\TEDIT.UPDATE.SEL SEL (CADR CAND)
|
||||
(CADDR CAND)
|
||||
'RIGHT
|
||||
'NORMAL) (* ; "Set the target")
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
|
||||
(PCHARLOOKS (\TEDIT.CHTOPC (CADR CAND)
|
||||
TEXTOBJ)))
|
||||
TSTREAM SEL)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
|
||||
|
||||
(\TEDIT.ABBREV.PARSE
|
||||
[LAMBDA (TSTREAM SEL) (* ; "Edited 24-Apr-2025 23:45 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 10:11 by rmk")
|
||||
(* ; "Edited 23-Mar-2025 17:08 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 22:21 by rmk")
|
||||
|
||||
(* ;; "This produces candidate abbreviation-strings by parsing the characters around the point. Each candidate is returned as a list (KEY STARTCH# LEN).")
|
||||
|
||||
(* ;;
|
||||
"It first backs up over any spaces to find the anchor position. The candidates then include")
|
||||
|
||||
(* ;; " The immediately preceding singleton character, if a point selection")
|
||||
|
||||
(* ;; " The remaining (after backing up) characters of the selection.")
|
||||
|
||||
(* ;; " The word that contains the caret (backwards and forwards)")
|
||||
|
||||
(* ;; " If the character before a candidate C is a comma, then the word before W before the comma (without or without \) is extracted, and W,C is is added to the list (a possible charname).")
|
||||
|
||||
(* ;; "If the character before a candidate C is \, the \ is included in the replacement span, and \C is also added to the list (Tex style)")
|
||||
|
||||
(* ;; "If one of the candidates is a character name, the abbreviation exapnds to the corresponding character.")
|
||||
|
||||
(* ;; "Otherwise, the candidates are looked up in TEDIT.ABBREVS to find their expansions.")
|
||||
|
||||
(PROG ((PT# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
FIRST# LAST# LEN CANDIDATES KEY NSPACES)
|
||||
|
||||
(* ;; "The abbreviation is taken from the CH# of the current selection. It is either the character just before a point selection, the entire selection, or the word containing the selection.")
|
||||
|
||||
(* ;; " The character at CH#, if it is a point selection")
|
||||
|
||||
(* ;; " Otherwise either the current selection up to and including CH# or the full word that includes the selection. What works is determined by what it finds in the abbreviations list.")
|
||||
|
||||
(* ;; "Back up over spaces")
|
||||
|
||||
(SETQ NSPACES (for I from PT# by -1 while (EQ (CHARCODE SPACE)
|
||||
(\TEDIT.NTHCHARCODE TSTREAM I)) sum 1))
|
||||
(add PT# (IMINUS NSPACES))
|
||||
(CL:WHEN (ZEROP PT#) (* ; "Beginning of document")
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Each candidate is a triple containing the key and the starting character and length of the replacement target..")
|
||||
|
||||
(push CANDIDATES (LIST (MKSTRING (TEDIT.NTHCHAR TSTREAM PT#))
|
||||
PT# 1))
|
||||
(SETQ LEN (IMAX 0 (IDIFFERENCE (FGETSEL SEL DCH)
|
||||
NSPACES))) (* ; "Last singleton predecessor")
|
||||
(CL:WHEN (IGEQ LEN 2) (* ; "At least one more character")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM (FGETSEL SEL CH#)
|
||||
LEN)
|
||||
(FGETSEL SEL CH#)
|
||||
LEN)))
|
||||
(SETQ FIRST# (\TEDIT.WORD.FIRST TSTREAM PT#))
|
||||
(SETQ LEN (ADD1 (IDIFFERENCE PT# FIRST#)))
|
||||
(CL:UNLESS (EQ LEN 1) (* ; "Already there")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
|
||||
FIRST# LEN)))
|
||||
(SETQ LAST# (\TEDIT.WORD.LAST TSTREAM FIRST#))
|
||||
(SETQ LEN (ADD1 (IDIFFERENCE LAST# FIRST#)))
|
||||
(CL:UNLESS (EQ LEN 1) (* ; "Already there")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
|
||||
FIRST# LEN))) (* ; "Extend if a ,")
|
||||
[for C KEY END in CANDIDATES
|
||||
do
|
||||
(* ;; "Comma for MCCS character names, - and / - for internal punctuation (3/4 EM-DASH). Adjacent character must be text")
|
||||
|
||||
(if [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C)))
|
||||
(CHARCODE (%, / -)))
|
||||
(EQ (\TEDIT.TTC TEXT)
|
||||
(TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IDIFFERENCE (CADR C)
|
||||
2]
|
||||
then (SETQ END (\TEDIT.WORD.FIRST TSTREAM (IDIFFERENCE (CADR C)
|
||||
2)))
|
||||
(* ; "Comma before, maybe a charname")
|
||||
(SETQ KEY (CONCAT (TEDIT.SEL.AS.STRING TSTREAM END (IDIFFERENCE (CADR C)
|
||||
END))
|
||||
(CAR C)))
|
||||
(push CANDIDATES (LIST KEY END (NCHARS KEY)))
|
||||
elseif [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (IPLUS (CADR C)
|
||||
(CADDR C)))
|
||||
(CHARCODE (%, / -)))
|
||||
(EQ (\TEDIT.TTC TEXT)
|
||||
(TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IPLUS 1 (CADR C)
|
||||
(CADDR C]
|
||||
then [SETQ END (\TEDIT.WORD.LAST TSTREAM (ADD1 (IPLUS (CADR C)
|
||||
(CADDR C]
|
||||
(* ; "Comma after")
|
||||
[SETQ KEY (CONCAT (CAR C)
|
||||
(TEDIT.SEL.AS.STRING TSTREAM (IPLUS (CADR C)
|
||||
(CADDR C))
|
||||
(ADD1 (IDIFFERENCE END (IPLUS (CADR C)
|
||||
(CADDR C]
|
||||
(push CANDIDATES (LIST KEY (CADR C)
|
||||
(NCHARS KEY] (* ;
|
||||
"If preceded by \, include it optionally in the key, always include it in the replacement")
|
||||
(for C in CANDIDATES when [EQ (CHARCODE \)
|
||||
(\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C]
|
||||
do (* ; "Match and replace \KEY")
|
||||
[push CANDIDATES (LIST (CONCAT "\" (CAR C))
|
||||
(SUB1 (CADR C))
|
||||
(ADD1 (CADDR C]
|
||||
(change (CADR C)
|
||||
(SUB1 DATUM)) (* ; "Match KEY but also replace the \")
|
||||
(change (CADDR C)
|
||||
(ADD1 DATUM)))
|
||||
[SORT CANDIDATES (FUNCTION (LAMBDA (C1 C2)
|
||||
(IGEQ (CADDR C1)
|
||||
(CADDR C2] (* ; "Look for longest first")
|
||||
(RETURN CANDIDATES])
|
||||
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))
|
||||
SEL CH# CH OLDLOOKS EXPANSION)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(SETQ CH# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
[COND
|
||||
((ZEROP (GETSEL SEL DCH)) (* ;
|
||||
"Point Selection, so use the character to the left")
|
||||
(CL:WHEN (ZEROP CH#) (* ;
|
||||
"If we're off the front of the document, don't bother trying.")
|
||||
(RETURN))
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CH#)
|
||||
CH#)
|
||||
[SETQ CH (MKSTRING (CHARACTER (BIN TSTREAM]
|
||||
(TEDIT.SETSEL TSTREAM CH# 1 'RIGHT))
|
||||
(T (* ;
|
||||
"We have a selection that isn't just a caret. Use it.")
|
||||
(SETQ CH (TEDIT.SEL.AS.STRING TSTREAM]
|
||||
(SETQ EXPANSION (\TEDIT.TRY.ABBREV CH TSTREAM)) (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.")
|
||||
(CL:WHEN EXPANSION (* ;
|
||||
"It exists, so insert it where the abbrev used to be")
|
||||
(SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ))
|
||||
(TEDIT.DELETE TEXTOBJ SEL) (* ;
|
||||
"First, delete the thing being expanded.")
|
||||
(TEDIT.INSERT TSTREAM EXPANSION SEL OLDLOOKS))])
|
||||
|
||||
(\TEDIT.EXPAND.DATE
|
||||
[LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds")
|
||||
@@ -222,92 +109,100 @@
|
||||
" " DAY ", " YEAR])
|
||||
|
||||
(\TEDIT.TRY.ABBREV
|
||||
[LAMBDA (KEY TSTREAM) (* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
[LAMBDA (ABBREV STREAM) (* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
(* jds "11-Jul-85 12:46")
|
||||
|
||||
(* ;; "Decode the expansion. A string may be a character name, otherwise itself. A litatom is a function to be applied, anything else is evaled. ")
|
||||
(* ;;
|
||||
"Try expanding ABBREV as an abbreviation. Return the expansion; NIL = no such abbreviation.")
|
||||
|
||||
(LET ((ABBREV (SASSOC KEY TEDIT.ABBREVS)))
|
||||
(if (NULL ABBREV)
|
||||
then (CL:WHEN (CHARCODE.DECODE KEY T)
|
||||
(CHARACTER (CHARCODE.DECODE KEY T)))
|
||||
elseif (STRINGP (CDR ABBREV))
|
||||
then
|
||||
(* ;; "Could be a character code")
|
||||
(* ;; "RMK: Established that a character-code looking string (%"357,201%" or %"02FE%") or a number is a character code that converts to a character.")
|
||||
|
||||
(LET ((CH (CHARCODE.DECODE (CDR ABBREV)
|
||||
T)))
|
||||
(CL:IF CH
|
||||
(CHARACTER CH)
|
||||
(CDR ABBREV)))
|
||||
elseif (SMALLP (CDR ABBREV))
|
||||
then
|
||||
(* ;; "Treat a number as a character code.")
|
||||
(PROG (SEL CH# (CH NIL)
|
||||
EXPANSION)
|
||||
(SETQ EXPANSION (OR (SASSOC ABBREV TEDIT.ABBREVS)
|
||||
(SASSOC (U-CASE ABBREV)
|
||||
TEDIT.ABBREVS)))
|
||||
|
||||
(CHARACTER (CDR ABBREV))
|
||||
elseif (AND (LITATOM (CDR ABBREV))
|
||||
(GETD (CDR ABBREV)))
|
||||
then (* ; "It's a function to be called.")
|
||||
(APPLY* (CDR ABBREV)
|
||||
TSTREAM
|
||||
(CAR ABBREV))
|
||||
else (* ; "Anything else is a form to EVAL.")
|
||||
(EVAL (CDR ABBREV])
|
||||
(* Find the abbreviation's expansion --first try it as-is, then try the
|
||||
upper-case version to be safe.)
|
||||
|
||||
(RETURN (COND
|
||||
(EXPANSION (* There's an expansion.
|
||||
Turn it into an insertable string.)
|
||||
(COND
|
||||
[(STRINGP (CDR EXPANSION))
|
||||
|
||||
(* ;; "Could be a character code")
|
||||
|
||||
(COND
|
||||
((SETQ CH (CHARCODE.DECODE (CDR EXPANSION)
|
||||
T))
|
||||
(CHARACTER CH))
|
||||
(T (CDR EXPANSION]
|
||||
((SMALLP (CDR EXPANSION))
|
||||
|
||||
(* ;; "Treat a number as a character code.")
|
||||
|
||||
(CHARACTER (CDR EXPANSION)))
|
||||
((AND (LITATOM (CDR EXPANSION))
|
||||
(GETD (CDR EXPANSION))) (* It's a function to be called.)
|
||||
(APPLY* (CDR EXPANSION)
|
||||
STREAM CH))
|
||||
(T (* Anything else is a form to EVAL.)
|
||||
(EVAL (CDR EXPANSION])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.ABBREVS
|
||||
'(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
|
||||
(RPAQ? TEDIT.ABBREVS '(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2933 14856 (\TEDIT.ABBREV.EXPAND 2943 . 5163) (\TEDIT.ABBREV.PARSE 5165 . 12558) (
|
||||
\TEDIT.EXPAND.DATE 12560 . 13193) (\TEDIT.TRY.ABBREV 13195 . 14854)))))
|
||||
(FILEMAP (NIL (3704 8979 (\TEDIT.ABBREV.EXPAND 3714 . 6194) (\TEDIT.EXPAND.DATE 6196 . 6829) (
|
||||
\TEDIT.TRY.ABBREV 6831 . 8977)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "30-Apr-2025 14:09:18" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;228 125393
|
||||
(FILECREATED "22-Dec-2024 22:47:22" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;200 119344
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MB.NWAY.ADDITEM MB.NWAY.CREATE MB.NWAY.SETSTATEFN MB.NWAY.SELECT)
|
||||
:CHANGES-TO (FNS MB.3STATE.BUTTONEVENTINFN)
|
||||
|
||||
:PREVIOUS-DATE "14-Apr-2025 23:50:23" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;226)
|
||||
:PREVIOUS-DATE "20-Dec-2024 22:19:48" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;198)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
|
||||
@@ -19,11 +19,12 @@
|
||||
(COMS (* ;
|
||||
"Generic functions for the various types of buttons.")
|
||||
(RECORDS MBARG)
|
||||
(FNS MB.ADD MB.DELETE MB.GET MB.GET.MBARG TEDIT.BACKTOMAIN))
|
||||
(FNS MB.ADD MB.DELETE MB.GET MB.GET.MBARG TEDITMENU.STREAM TEDIT.BACKTOMAIN))
|
||||
[COMS (* ; "Simple Menu Button support")
|
||||
(FNS MB.BUTTONEVENTINFN MB.DISPLAYFN MB.SETIMAGE MB.SIZEFN MB.WHENOPERATEDONFN
|
||||
MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MB.CREATE MB.CHANGENAME MB.INIT
|
||||
MB.TRACK.UNTIL MB.DON'T MB.SPEC.REMAINDER)
|
||||
MB.TRACK.UNTIL MB.DON'T)
|
||||
(GLOBALVARS MB.IMAGEFNS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.INIT]
|
||||
[COMS (* ; "3STATE")
|
||||
|
||||
@@ -31,6 +32,7 @@
|
||||
|
||||
(FNS MB.3STATE.CREATE MB.3STATE.DISPLAYFN MB.3STATE.SHOWSELFN MB.3STATE.INIT
|
||||
MB.3STATE.SETSTATEFN MB.3STATE.BUTTONEVENTINFN)
|
||||
(GLOBALVARS MB.3STATE.IMAGEFNS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.3STATE.INIT]
|
||||
[COMS (* ; "NWAY")
|
||||
|
||||
@@ -40,15 +42,18 @@
|
||||
MB.NWAY.SELECT MB.NWAY.BUTTONEVENTINFN MB.NWAY.NEWMENUBUTTON MB.NWAY.COPYFN
|
||||
MB.NWAY.INIT MB.NWAY.ARRANGEBUTTONS MB.NWAY.ADDITEM MB.NWAY.FINDSUBOBJ
|
||||
MB.NWAY.SETSTATEFN)
|
||||
(GLOBALVARS MB.NWAY.IMAGEFNS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.NWAY.INIT]
|
||||
[COMS (* ; "TOGGLE")
|
||||
(FNS MB.TOGGLE.CREATE MB.TOGGLE.DISPLAYFN MB.TOGGLE.INIT MB.SET.TOGGLE
|
||||
MB.TOGGLE.SETSTATEFN MB.TOGGLE.BUTTONEVENTINFN MB.TOGGLE.WHENOPERATEDONFN)
|
||||
(GLOBALVARS MB.TOGGLE.IMAGEFNS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.TOGGLE.INIT]
|
||||
(COMS (* ; "FIELDS")
|
||||
(FNS MB.FIELD.CREATE MB.FIELD.DISPLAYFN MB.FIELD.IMAGEBOXFN MB.FIELD.PREFIXCREATE
|
||||
MB.FIELD.SUFFIXCREATE MB.FIELD.INIT MB.FIELD.WHENOPERATEDONFN MB.FIELD.GETSTATEFN
|
||||
MB.FIELD.SETSTATEFN MB.FIELD.BUTTONEVENTINFN MB.FIELD.SIZEFN MB.FIELD.INSURETYPE)
|
||||
(GLOBALVARS MB.FIELD.IMAGEFNS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.FIELD.INIT])
|
||||
|
||||
|
||||
@@ -67,9 +72,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MB.ADD
|
||||
[LAMBDA (MENUDESC MENUTSTREAM WHERE INCREMENTALUPDATES) (* ; "Edited 6-Apr-2025 14:35 by rmk")
|
||||
(* ; "Edited 5-Jan-2025 11:36 by rmk")
|
||||
(* ; "Edited 22-Oct-2024 09:16 by rmk")
|
||||
[LAMBDA (MENUDESC MENUTSTREAM WHERE) (* ; "Edited 22-Oct-2024 09:16 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 18-Oct-2024 13:49 by rmk")
|
||||
(* ; "Edited 6-Oct-2024 15:25 by rmk")
|
||||
@@ -89,80 +92,73 @@
|
||||
|
||||
(* ;; "Returns the textstream character number of the character just after the last inserted character/object.")
|
||||
|
||||
(RESETLST
|
||||
(CL:UNLESS INCREMENTALUPDATES (TEDIT.DEFER.UPDATES MENUTSTREAM))
|
||||
(for DESC TYPE SPEC OBJ [EOL _ (CONCATCODES (CHARCODE (EOL]
|
||||
[TAB _ (CONCATCODES (CHARCODE (TAB]
|
||||
(CH# _ (if (NULL WHERE)
|
||||
then (ADD1 (TEXTLEN (FGETTSTR MENUTSTREAM TEXTOBJ)))
|
||||
elseif (FIXP WHERE)
|
||||
else (\ILLEGAL.ARG WHERE))) in MENUDESC declare (SPECVARS CH#)
|
||||
do (SETQ DESC (MKLIST DESC)) (* ; "MKLIST for EOL/TAB, FIXP")
|
||||
(SETQ TYPE (CAR DESC))
|
||||
(SETQ SPEC (CDR DESC))
|
||||
(SELECTQ TYPE
|
||||
( (* ; ;; NIL)
|
||||
(for DESC TYPE SPEC OBJ [EOL _ (CONCATCODES (CHARCODE (EOL]
|
||||
[TAB _ (CONCATCODES (CHARCODE (TAB]
|
||||
(CH# _ (if (NULL WHERE)
|
||||
then (ADD1 (TEXTLEN (FGETTSTR MENUTSTREAM TEXTOBJ)))
|
||||
elseif (FIXP WHERE)
|
||||
else (\ILLEGAL.ARG WHERE))) in MENUDESC declare (SPECVARS CH#)
|
||||
do (SETQ DESC (MKLIST DESC)) (* ; "MKLIST for EOL/TAB, FIXP")
|
||||
(SETQ TYPE (CAR DESC))
|
||||
(SETQ SPEC (CDR DESC))
|
||||
(SELECTQ TYPE
|
||||
( (* ; ;; NIL)
|
||||
(* ;
|
||||
"Ignore comments within menu descriptions")
|
||||
)
|
||||
(EOL (TEDIT.INSERT MENUTSTREAM EOL CH# '(PROTECTED ON))
|
||||
(add CH# 1))
|
||||
(TAB (TEDIT.INSERT MENUTSTREAM TAB CH# '(PROTECTED ON))
|
||||
(add CH# 1))
|
||||
(ACTION (* ; "Hitting calls a function")
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE SPEC)
|
||||
MENUTSTREAM CH# '(PROTECTED OFF))
|
||||
(add CH# 1))
|
||||
(3STATE (* ;
|
||||
)
|
||||
(EOL (TEDIT.INSERT MENUTSTREAM EOL CH# '(PROTECTED ON))
|
||||
(add CH# 1))
|
||||
(TAB (TEDIT.INSERT MENUTSTREAM TAB CH# '(PROTECTED ON))
|
||||
(add CH# 1))
|
||||
(ACTION (* ; "Hitting calls a function")
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE SPEC)
|
||||
MENUTSTREAM CH# '(PROTECTED OFF))
|
||||
(add CH# 1))
|
||||
(3STATE (* ;
|
||||
"3-state button; hitting it changes state among ON, OFF, and NEUTRAL.")
|
||||
(TEDIT.INSERT.OBJECT (MB.3STATE.CREATE SPEC)
|
||||
MENUTSTREAM CH# '(PROTECTED OFF))
|
||||
(add CH# 1))
|
||||
(TOGGLE (* ;
|
||||
(TEDIT.INSERT.OBJECT (MB.3STATE.CREATE SPEC)
|
||||
MENUTSTREAM CH# '(PROTECTED OFF))
|
||||
(add CH# 1))
|
||||
(TOGGLE (* ;
|
||||
"TOGGLE button; hitting it switches between ON and OFF.")
|
||||
(TEDIT.INSERT.OBJECT (MB.TOGGLE.CREATE SPEC)
|
||||
MENUTSTREAM CH# '(PROTECTED OFF))
|
||||
(add CH# 1))
|
||||
(NWAY (* ;
|
||||
(TEDIT.INSERT.OBJECT (MB.TOGGLE.CREATE SPEC)
|
||||
MENUTSTREAM CH# '(PROTECTED OFF))
|
||||
(add CH# 1))
|
||||
(NWAY (* ;
|
||||
"N-way buttons; choosing one turns the others off.")
|
||||
(SETQ OBJ (MB.NWAY.CREATE SPEC))
|
||||
(TEDIT.INSERT.OBJECT OBJ MENUTSTREAM CH# '(PROTECTED OFF))
|
||||
(add CH# 1))
|
||||
(TEXT (* ; "Arbitrary protected text.")
|
||||
[TEDIT.INSERT MENUTSTREAM (CADR (ASSOC 'STRING SPEC))
|
||||
CH#
|
||||
(CL:IF (CADR (ASSOC 'FONT SPEC))
|
||||
`(FONT ,(CADR (ASSOC 'FONT SPEC))
|
||||
PROTECTED ON)
|
||||
'(PROTECTED ON))]
|
||||
[add CH# (NCHARS (CADR (ASSOC 'STRING SPEC])
|
||||
(FIELD (SETQ CH# (MB.FIELD.CREATE SPEC MENUTSTREAM CH#)))
|
||||
(MENU (* ;
|
||||
(SETQ OBJ (MB.NWAY.CREATE SPEC))
|
||||
(TEDIT.INSERT.OBJECT OBJ MENUTSTREAM CH# '(PROTECTED OFF))
|
||||
(add CH# 1))
|
||||
(TEXT (* ; "Arbitrary protected text.")
|
||||
[TEDIT.INSERT MENUTSTREAM (CADR (ASSOC 'STRING SPEC))
|
||||
CH#
|
||||
(CL:IF (CADR (ASSOC 'FONT SPEC))
|
||||
`(FONT ,(CADR (ASSOC 'FONT SPEC))
|
||||
PROTECTED ON)
|
||||
'(PROTECTED ON))]
|
||||
[add CH# (NCHARS (CADR (ASSOC 'STRING SPEC])
|
||||
(FIELD (SETQ CH# (MB.FIELD.CREATE SPEC MENUTSTREAM CH#)))
|
||||
(MENU (* ;
|
||||
"Real menu, except the selection sticks")
|
||||
(\TEDIT.THELP "NOT IMPLEMENTED")
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR SPEC))
|
||||
MENUTSTREAM CH# '(PROTECTED OFF))
|
||||
(add CH# 1))
|
||||
(if (STRINGP TYPE)
|
||||
then (TEDIT.INSERT MENUTSTREAM TYPE CH# '(PROTECTED ON))
|
||||
(add CH# (NCHARS TYPE))
|
||||
elseif (FIXP TYPE)
|
||||
then (* ; "TYPE spaces")
|
||||
(TEDIT.INSERT MENUTSTREAM (ALLOCSTRING TYPE (CHARCODE SPACE))
|
||||
CH#
|
||||
'(PROTECTED ON))
|
||||
(add CH# TYPE)
|
||||
elseif (LISTP TYPE)
|
||||
then
|
||||
(* ;; "Form to be evaluated")
|
||||
(\TEDIT.THELP "NOT IMPLEMENTED")
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR SPEC))
|
||||
MENUTSTREAM CH# '(PROTECTED OFF))
|
||||
(add CH# 1))
|
||||
(if (STRINGP TYPE)
|
||||
then (TEDIT.INSERT MENUTSTREAM TYPE CH# '(PROTECTED ON))
|
||||
(add CH# (NCHARS TYPE))
|
||||
elseif (FIXP TYPE)
|
||||
then (* ; "TYPE spaces")
|
||||
(TEDIT.INSERT MENUTSTREAM (ALLOCSTRING TYPE (CHARCODE SPACE))
|
||||
CH#
|
||||
'(PROTECTED ON))
|
||||
(add CH# TYPE)
|
||||
elseif (LISTP TYPE)
|
||||
then
|
||||
(* ;; "Form to be evaluated")
|
||||
|
||||
(add CH# (EVAL TYPE))
|
||||
else (\ILLEGAL.ARG DESC))) finally (\TEDIT.NOSEL MENUTSTREAM)
|
||||
(* ;
|
||||
"User has to click to get a selection")
|
||||
(SETSEL (TEXTSEL (FTEXTOBJ MENUTSTREAM))
|
||||
SET NIL)
|
||||
(RETURN CH#)))])
|
||||
(add CH# (EVAL TYPE))
|
||||
else (\ILLEGAL.ARG DESC))) finally (RETURN CH#])
|
||||
|
||||
(MB.DELETE
|
||||
[LAMBDA (IDENTIFIERS MENUSTREAM) (* ; "Edited 8-Nov-2024 08:58 by rmk")
|
||||
@@ -172,8 +168,7 @@
|
||||
(CAR CHNOS])
|
||||
|
||||
(MB.GET
|
||||
[LAMBDA (IDENTIFIERS MENUSTREAM RETURNS START BEFORE) (* ; "Edited 11-Jan-2025 20:49 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 09:24 by rmk")
|
||||
[LAMBDA (IDENTIFIERS MENUSTREAM RETURNS START BEFORE) (* ; "Edited 13-Dec-2024 09:24 by rmk")
|
||||
(* ; "Edited 2-Dec-2024 09:41 by rmk")
|
||||
(* ; "Edited 7-Nov-2024 22:20 by rmk")
|
||||
(* ; "Edited 22-Oct-2024 22:02 by rmk")
|
||||
@@ -256,9 +251,9 @@
|
||||
(ERROR R " is not a button return"))
|
||||
finally (CL:UNLESS (CDR RETURNS)
|
||||
(RETURN (CAR $$VAL)))])
|
||||
(CL:IF (LISTP IDENTIFIERS)
|
||||
RESULT
|
||||
(CADR RESULT))))])
|
||||
(CL:IF (LITATOM IDENTIFIERS)
|
||||
(CADR RESULT)
|
||||
RESULT)))])
|
||||
|
||||
(MB.GET.MBARG
|
||||
[LAMBDA (IDPC MENUSTREAM) (* ; "Edited 17-Dec-2024 11:54 by rmk")
|
||||
@@ -289,6 +284,17 @@
|
||||
ARGENDPC _ ENDPC
|
||||
ARGIDPC _ IDPC])
|
||||
|
||||
(TEDITMENU.STREAM
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 29-Sep-2024 15:29 by rmk")
|
||||
(* ; "Edited 28-Aug-2024 15:48 by rmk")
|
||||
(* ; "Edited 10-Apr-2023 09:53 by rmk")
|
||||
(* jds "13-Aug-84 14:10")
|
||||
|
||||
(* ;; "returns the textstream of the teditmenu attached to this stream if any")
|
||||
|
||||
(for W in (ATTACHEDWINDOWS (\TEDIT.MAINW TSTREAM)) when (TEDITMENUP W "TEdit Menu")
|
||||
do (RETURN (TEXTSTREAM W])
|
||||
|
||||
(TEDIT.BACKTOMAIN
|
||||
[LAMBDA (MENUSTREAM) (* ; "Edited 20-Oct-2024 10:02 by rmk")
|
||||
(* ; "Edited 25-Aug-2024 09:17 by rmk")
|
||||
@@ -309,9 +315,6 @@
|
||||
|
||||
(MB.BUTTONEVENTINFN
|
||||
[LAMBDA (OBJ MENUSTREAM SEL RELX RELY SELWINDOW HOSTSTREAM BUTTON)
|
||||
(* ; "Edited 22-Mar-2025 14:00 by rmk")
|
||||
(* ; "Edited 12-Jan-2025 13:03 by rmk")
|
||||
(* ; "Edited 28-Dec-2024 20:21 by rmk")
|
||||
(* ; "Edited 22-Aug-2024 16:26 by rmk")
|
||||
(* ; "Edited 20-Aug-2024 10:04 by rmk")
|
||||
(* ; "Edited 20-Jul-2024 15:26 by rmk")
|
||||
@@ -322,7 +325,6 @@
|
||||
|
||||
(if [OR (EQ BUTTON 'RIGHT)
|
||||
(SHIFTDOWNP 'CTRL)
|
||||
(SHIFTDOWNP 'SHIFT)
|
||||
(LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX]
|
||||
(OR (ILESSP RELX 0)
|
||||
(ILESSP RELY 0)
|
||||
@@ -513,11 +515,7 @@
|
||||
'INVERT))])
|
||||
|
||||
(MB.CREATE
|
||||
[LAMBDA (SPEC IMAGEFNS) (* ; "Edited 12-Jan-2025 12:35 by rmk")
|
||||
(* ; "Edited 9-Jan-2025 16:51 by rmk")
|
||||
(* ; "Edited 6-Jan-2025 00:19 by rmk")
|
||||
(* ; "Edited 4-Jan-2025 16:29 by rmk")
|
||||
(* ; "Edited 18-Oct-2024 10:27 by rmk")
|
||||
[LAMBDA (SPEC IMAGEFNS) (* ; "Edited 18-Oct-2024 10:27 by rmk")
|
||||
(* ; "Edited 6-Oct-2024 16:59 by rmk")
|
||||
(* ; "Edited 5-Oct-2024 11:51 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 14:51 by rmk")
|
||||
@@ -534,34 +532,25 @@
|
||||
|
||||
(* ;; "Create a MENU BUTTON image object, and fill in its image and function-hook fields. ")
|
||||
|
||||
(for S PROP VAL IDENTIFIER LABEL (OBJ _ (IMAGEOBJCREATE NIL (OR IMAGEFNS
|
||||
(CADR (ASSOC 'IMAGEFNS SPEC))
|
||||
MB.IMAGEFNS))) in SPEC
|
||||
(for S PROP VAL (OBJ _ (IMAGEOBJCREATE NIL (OR IMAGEFNS (CADR (ASSOC 'IMAGEFNS SPEC))
|
||||
MB.IMAGEFNS))) in SPEC
|
||||
eachtime (SETQ PROP (MKATOM (CAR S)))
|
||||
(SETQ VAL (CADR S)) unless (EQ PROP 'IMAGEFNS)
|
||||
do (SELECTQ PROP
|
||||
(FONT [SETQ VAL (FONTCREATE (FONTCREATE VAL NIL NIL NIL 'DISPLAY])
|
||||
(LABEL (SETQ LABEL (SETQ VAL (MKSTRING VAL))))
|
||||
(IDENTIFIER (SETQ IDENTIFIER VAL)
|
||||
(GO $$ITERATE))
|
||||
((LABEL IDENTIFIER)
|
||||
(SETQ VAL (MKATOM VAL)))
|
||||
NIL)
|
||||
(IMAGEOBJPROP OBJ PROP VAL)
|
||||
finally (CL:UNLESS (IMAGEOBJPROP OBJ 'FONT)
|
||||
(IMAGEOBJPROP OBJ 'FONT (FONTCREATE '(HELVETICA 8 BOLD)
|
||||
NIL NIL NIL 'DISPLAY)))
|
||||
(if (NULL IDENTIFIER)
|
||||
then (if LABEL
|
||||
then [SETQ IDENTIFIER (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab
|
||||
#\Newline #\:
|
||||
)
|
||||
LABEL]
|
||||
else (ERROR (ERROR "Missing both IDENTIFIER and LABEL" SPEC)))
|
||||
elseif (OR (LITATOM IDENTIFIER)
|
||||
(SMALLP IDENTIFIER))
|
||||
elseif (STRINGP IDENTIFIER)
|
||||
then (SETQ IDENTIFIER (MKATOM IDENTIFIER))
|
||||
else (\ILLEGAL.ARG VAL))
|
||||
(IMAGEOBJPROP OBJ 'IDENTIFIER IDENTIFIER)
|
||||
(CL:UNLESS (IMAGEOBJPROP OBJ 'IDENTIFIER)
|
||||
(if (SETQ VAL (IMAGEOBJPROP OBJ 'LABEL))
|
||||
then [IMAGEOBJPROP OBJ 'IDENTIFIER
|
||||
(U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab #\Newline #\:)
|
||||
VAL]
|
||||
else (ERROR (ERROR "Missing both IDENTIFIER and LABEL" SPEC))))
|
||||
(CL:WHEN (IMAGEOBJPROP OBJ 'INITSTATE)
|
||||
(IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP OBJ 'INITSTATE)))
|
||||
(MB.SETIMAGE OBJ)
|
||||
@@ -580,14 +569,12 @@
|
||||
(TEDIT.OBJECT.CHANGED TEXTOBJ OBJ])
|
||||
|
||||
(MB.INIT
|
||||
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:49 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 09:05 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 7-Dec-2024 09:05 by rmk")
|
||||
(* ; "Edited 28-Aug-2024 23:34 by rmk")
|
||||
(* ; "Edited 24-Aug-2024 11:00 by rmk")
|
||||
(* ; "Edited 20-Aug-2024 15:23 by rmk")
|
||||
(* ; "Edited 18-Feb-2024 14:15 by rmk")
|
||||
(* jds "12-Feb-85 14:32")
|
||||
(DECLARE (GLOBALVARS MB.IMAGEFNS))
|
||||
(SETQ MB.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.DISPLAYFN)
|
||||
(FUNCTION MB.SIZEFN)
|
||||
(FUNCTION MB.PUTFN)
|
||||
@@ -623,17 +610,10 @@
|
||||
(* ; "Edited 7-Dec-2024 08:58 by rmk")
|
||||
(CL:UNLESS (IMAGEOBJPROP OBJ 'DELETABLE)
|
||||
'DON'T])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(MB.SPEC.REMAINDER
|
||||
[LAMBDA (SPEC IGNORE OBJ) (* ; "Edited 16-Feb-2025 13:07 by rmk")
|
||||
|
||||
(* ;; "Reduces SPEC to properties that not to be IGNORED because they have been dealt with separately. If OBJ, those properties are installed as IMAGEOBJPROP's.")
|
||||
|
||||
(for S in SPEC unless (MEMB (CAR S)
|
||||
IGNORE) collect (CL:WHEN OBJ
|
||||
(IMAGEOBJPROP OBJ (CAR S)
|
||||
(CADR S)))
|
||||
S])
|
||||
(GLOBALVARS MB.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -716,8 +696,7 @@
|
||||
NIL])
|
||||
|
||||
(MB.3STATE.INIT
|
||||
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:49 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 12:38 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 7-Dec-2024 12:38 by rmk")
|
||||
(* ; "Edited 18-Oct-2024 11:40 by rmk")
|
||||
(* ; "Edited 25-Aug-2024 23:11 by rmk")
|
||||
(* ; "Edited 20-Aug-2024 15:36 by rmk")
|
||||
@@ -725,7 +704,6 @@
|
||||
|
||||
(* ;; "Initialize the IMAGEFNS for 3-state menu button IMAGEOBJs")
|
||||
|
||||
(DECLARE (GLOBALVARS MB.3STATE.IMAGEFNS))
|
||||
(SETQ MB.3STATE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.3STATE.DISPLAYFN)
|
||||
(FUNCTION MB.SIZEFN)
|
||||
(FUNCTION MB.PUTFN)
|
||||
@@ -754,7 +732,6 @@
|
||||
|
||||
(MB.3STATE.BUTTONEVENTINFN
|
||||
[LAMBDA (OBJ MENUDS SEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON)
|
||||
(* ; "Edited 14-Apr-2025 23:49 by rmk")
|
||||
(* ; "Edited 22-Dec-2024 22:45 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 13:11 by rmk")
|
||||
(* ; "Edited 5-Dec-2024 21:53 by rmk")
|
||||
@@ -796,10 +773,15 @@
|
||||
else (* ; "Buttons came up: do it")
|
||||
(IMAGEOBJPROP OBJ 'STATE NEXTSTATE)
|
||||
(CL:WHEN (SETQ STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN))
|
||||
(APPLY* STATECHANGEFN OBJ NEXTSTATE (PANETEXTSTREAM MENUDS)))])
|
||||
(APPLY* STATECHANGEFN OBJ NEXTSTATE (fetch (TEXTWINDOW WTEXTSTREAM)
|
||||
of MENUDS)))])
|
||||
(TEDIT.BACKTOMAIN MENUTSTREAM)))
|
||||
'DON'T])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS MB.3STATE.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(MB.3STATE.INIT)
|
||||
@@ -817,11 +799,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MB.NWAY.CREATE
|
||||
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 30-Apr-2025 14:06 by rmk")
|
||||
(* ; "Edited 16-Feb-2025 12:08 by rmk")
|
||||
(* ; "Edited 9-Jan-2025 11:38 by rmk")
|
||||
(* ; "Edited 4-Jan-2025 21:39 by rmk")
|
||||
(* ; "Edited 20-Dec-2024 22:17 by rmk")
|
||||
[LAMBDA (SPEC) (* ; "Edited 20-Dec-2024 22:17 by rmk")
|
||||
(* ; "Edited 22-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 12:43 by rmk")
|
||||
(* ; "Edited 31-Aug-2024 14:57 by rmk")
|
||||
@@ -835,7 +813,6 @@
|
||||
(* gbn "24-Sep-84 15:31")
|
||||
(LET ((IDENTIFIER (CADR (ASSOC 'IDENTIFIER SPEC)))
|
||||
(BUTTONS (CADR (ASSOC 'BUTTONS SPEC)))
|
||||
(SORTBUTTONS (CADR (ASSOC 'SORTBUTTONS SPEC)))
|
||||
[FONT (FONTCREATE (OR (CADR (ASSOC 'FONT SPEC))
|
||||
'(HELVETICA 8 BOLD]
|
||||
(STATECHANGEFN (CADR (ASSOC 'STATECHANGEFN SPEC)))
|
||||
@@ -847,10 +824,6 @@
|
||||
(DONTAPPLY (CADR (ASSOC 'DONTAPPLY SPEC)))
|
||||
(OBJ (IMAGEOBJCREATE NIL MB.NWAY.IMAGEFNS))
|
||||
SPACING HEIGHT SUBOBJECTS)
|
||||
(if (AND IDENTIFIER (LITATOM IDENTIFIER))
|
||||
elseif (STRINGP IDENTIFIER)
|
||||
then (SETQ IDENTIFIER (MKATOM IDENTIFIER))
|
||||
else (\ILLEGAL.ARG IDENTIFIER))
|
||||
(SETQ SPACING (STRINGWIDTH " " FONT))
|
||||
[SETQ HEIGHT (IPLUS 2 (FONTPROP FONT 'HEIGHT]
|
||||
(CL:UNLESS (LISTP BUTTONS)
|
||||
@@ -879,14 +852,14 @@
|
||||
|
||||
(* ;; "At most, we're as wide as the N widest buttons put together. COPY because we want to preserve the original order")
|
||||
|
||||
(CL:WHEN SORTBUTTONS
|
||||
(IMAGEOBJPROP OBJ 'SORTBUTTONS T)
|
||||
[SETQ SUBOBJECTS (SORT SUBOBJECTS (FUNCTION (LAMBDA (A B)
|
||||
(IGEQ (fetch XSIZE
|
||||
of (IMAGEOBJPROP A 'BOUNDBOX))
|
||||
(fetch XSIZE
|
||||
of (IMAGEOBJPROP B 'BOUNDBOX])
|
||||
[IMAGEOBJPROP OBJ 'MAXWIDTH (for SOBJ in SUBOBJECTS as I from 1 to MAXITEMS/LINE
|
||||
[IMAGEOBJPROP OBJ 'MAXWIDTH (for SOBJ
|
||||
in [SORT (COPY SUBOBJECTS)
|
||||
(FUNCTION (LAMBDA (A B)
|
||||
(IGEQ (fetch XSIZE
|
||||
of (IMAGEOBJPROP A 'BOUNDBOX))
|
||||
(fetch XSIZE
|
||||
of (IMAGEOBJPROP B 'BOUNDBOX]
|
||||
as I from 1 to MAXITEMS/LINE
|
||||
sum (fetch XSIZE of (IMAGEOBJPROP SOBJ 'BOUNDBOX))
|
||||
finally (RETURN (IPLUS $$VAL (ITIMES SPACING (SUB1
|
||||
MAXITEMS/LINE
|
||||
@@ -1013,9 +986,7 @@
|
||||
BOX])
|
||||
|
||||
(MB.NWAY.SELECT
|
||||
[LAMBDA (OBJ SELECTED MENUWINDOW SEL) (* ; "Edited 3-Jan-2025 12:56 by rmk")
|
||||
(* ; "Edited 1-Jan-2025 12:30 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 12:44 by rmk")
|
||||
[LAMBDA (OBJ SELECTED MENUWINDOW SEL) (* ; "Edited 29-Sep-2024 12:44 by rmk")
|
||||
(* ; "Edited 24-Aug-2024 15:28 by rmk")
|
||||
(* ; "Edited 20-Aug-2024 15:13 by rmk")
|
||||
(* ; "Edited 2-Aug-2024 00:28 by rmk")
|
||||
@@ -1031,37 +1002,29 @@
|
||||
(CL:WHEN (AND SELECTED (NEQ SELECTED T)
|
||||
(LITATOM SELECTED))
|
||||
(SETQ SELECTED (MB.NWAY.FINDSUBOBJ SELECTED OBJ)))
|
||||
(if (AND NIL (EQ OLDSELECTED SELECTED))
|
||||
then (IMAGEOBJPROP OBJ 'STATE 'OFF) (* ;
|
||||
"Reclicking the current selection turns it off. ")
|
||||
(IMAGEOBJPROP OBJ 'SELECTED NIL)
|
||||
(CL:WHEN MENUWINDOW
|
||||
(BITBLT (IMAGEOBJPROP OLDSELECTED 'BITCACHE)
|
||||
0 0 MENUWINDOW (IMAGEOBJPROP OLDSELECTED 'X)
|
||||
(IMAGEOBJPROP OLDSELECTED 'Y)
|
||||
NIL NIL 'INPUT 'REPLACE))
|
||||
else (CL:WHEN (AND OLDSELECTED SELECTED) (* ;
|
||||
(CL:UNLESS (EQ OLDSELECTED SELECTED) (* ; "Reclicking is a no-op. ")
|
||||
(CL:WHEN (AND OLDSELECTED SELECTED) (* ;
|
||||
"Turn the old one off if it's changing")
|
||||
(IMAGEOBJPROP OLDSELECTED 'STATE 'OFF)
|
||||
(CL:WHEN MENUWINDOW
|
||||
(BITBLT (IMAGEOBJPROP OLDSELECTED 'BITCACHE)
|
||||
0 0 MENUWINDOW (IMAGEOBJPROP OLDSELECTED 'X)
|
||||
(IMAGEOBJPROP OLDSELECTED 'Y)
|
||||
NIL NIL 'INPUT 'REPLACE))
|
||||
(IMAGEOBJPROP OBJ 'STATE NIL)
|
||||
(IMAGEOBJPROP OBJ 'SELECTED NIL))
|
||||
(CL:WHEN (AND SELECTED (NEQ T SELECTED)) (* ; "Turn on the new one.")
|
||||
(IMAGEOBJPROP SELECTED 'STATE 'ON)
|
||||
(CL:WHEN MENUWINDOW
|
||||
(BITBLT (IMAGEOBJPROP SELECTED 'BITCACHE)
|
||||
0 0 MENUWINDOW (IMAGEOBJPROP SELECTED 'X)
|
||||
(IMAGEOBJPROP SELECTED 'Y)
|
||||
NIL NIL 'INVERT 'REPLACE))
|
||||
(IMAGEOBJPROP OBJ 'SELECTED SELECTED)
|
||||
(IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP SELECTED 'IDENTIFIER))
|
||||
(CL:WHEN (IMAGEOBJPROP OBJ 'STATECHANGEFN)
|
||||
(APPLY* (IMAGEOBJPROP OBJ 'STATECHANGEFN)
|
||||
OBJ SELECTED SEL MENUWINDOW)))])
|
||||
(IMAGEOBJPROP OLDSELECTED 'STATE 'OFF)
|
||||
(CL:WHEN MENUWINDOW
|
||||
(BITBLT (IMAGEOBJPROP OLDSELECTED 'BITCACHE)
|
||||
0 0 MENUWINDOW (IMAGEOBJPROP OLDSELECTED 'X)
|
||||
(IMAGEOBJPROP OLDSELECTED 'Y)
|
||||
NIL NIL 'INPUT 'REPLACE))
|
||||
(IMAGEOBJPROP OBJ 'STATE NIL)
|
||||
(IMAGEOBJPROP OBJ 'SELECTED NIL))
|
||||
(CL:WHEN (AND SELECTED (NEQ T SELECTED)) (* ; "Turn on the new one.")
|
||||
(IMAGEOBJPROP SELECTED 'STATE 'ON)
|
||||
(CL:WHEN MENUWINDOW
|
||||
(BITBLT (IMAGEOBJPROP SELECTED 'BITCACHE)
|
||||
0 0 MENUWINDOW (IMAGEOBJPROP SELECTED 'X)
|
||||
(IMAGEOBJPROP SELECTED 'Y)
|
||||
NIL NIL 'INVERT 'REPLACE))
|
||||
(IMAGEOBJPROP OBJ 'SELECTED SELECTED)
|
||||
(IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP SELECTED 'IDENTIFIER))
|
||||
(CL:WHEN (IMAGEOBJPROP OBJ 'STATECHANGEFN)
|
||||
(APPLY* (IMAGEOBJPROP OBJ 'STATECHANGEFN)
|
||||
OBJ SELECTED SEL MENUWINDOW))))])
|
||||
|
||||
(MB.NWAY.BUTTONEVENTINFN
|
||||
[LAMBDA (OBJ MENUDS SEL RELX RELY SELWINDOW MENUTSTREAM BUTTON)
|
||||
@@ -1142,8 +1105,7 @@
|
||||
NEWOBJ])
|
||||
|
||||
(MB.NWAY.INIT
|
||||
[LAMBDA (BUTTONS FONT INITSTATE) (* ; "Edited 7-Jan-2025 22:50 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 09:05 by rmk")
|
||||
[LAMBDA (BUTTONS FONT INITSTATE) (* ; "Edited 7-Dec-2024 09:05 by rmk")
|
||||
(* ; "Edited 24-Aug-2024 23:11 by rmk")
|
||||
(* ; "Edited 20-Aug-2024 16:41 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 17:13 by rmk")
|
||||
@@ -1151,7 +1113,6 @@
|
||||
|
||||
(* ;; "Selection happens in the BUTTEVENTINFN, no WHENOPERATEDONFN")
|
||||
|
||||
(DECLARE (GLOBALVARS MB.NWAY.IMAGEFNS))
|
||||
(SETQ MB.NWAY.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.NWAY.DISPLAYFN)
|
||||
(FUNCTION MB.NWAY.SIZEFN)
|
||||
(FUNCTION MB.PUTFN)
|
||||
@@ -1194,9 +1155,7 @@
|
||||
(RETURN (DREVERSE LINES])
|
||||
|
||||
(MB.NWAY.ADDITEM
|
||||
[LAMBDA (OBJ NEWBUTTON) (* ; "Edited 30-Apr-2025 14:09 by rmk")
|
||||
(* ; "Edited 9-Jan-2025 11:38 by rmk")
|
||||
(* ; "Edited 20-Oct-2024 00:13 by rmk")
|
||||
[LAMBDA (OBJ NEWBUTTON) (* ; "Edited 20-Oct-2024 00:13 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 12:47 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 09:36 by rmk")
|
||||
(* ; "Edited 20-Aug-2024 15:46 by rmk")
|
||||
@@ -1209,17 +1168,15 @@
|
||||
(* ;; "Given an existing n-way choice menu button, add another choice to the list. The items are arranged in alphabetical order by their labels. MAXITEMS/LINE is goofy: it should flow with reshaping of the window.")
|
||||
|
||||
(CL:WHEN NEWBUTTON
|
||||
(LET* [[NEWSOBJ (MB.TOGGLE.CREATE `((IDENTIFIER ,NEWBUTTON)
|
||||
(LET* [(SUBOBJECTS (IMAGEOBJPROP OBJ 'SUBOBJECTS))
|
||||
[NEWSOBJ (MB.TOGGLE.CREATE `((IDENTIFIER ,(U-CASE NEWBUTTON))
|
||||
(LABEL ,NEWBUTTON)
|
||||
(FONT ,(IMAGEOBJPROP OBJ 'FONT]
|
||||
(SUBOBJECTS (APPEND (IMAGEOBJPROP OBJ 'SUBOBJECTS)
|
||||
(CONS NEWSOBJ)))
|
||||
(MAXITEMS/LINE (IMAGEOBJPROP OBJ 'MAXITEMS/LINE]
|
||||
(CL:WHEN (IMAGEOBJPROP OBJ 'SORTBUTTONS)
|
||||
[SETQ SUBOBJECTS (SORT SUBOBJECTS (FUNCTION (LAMBDA (S1 S2)
|
||||
(ALPHORDER (IMAGEOBJPROP S1
|
||||
'LABEL)
|
||||
(IMAGEOBJPROP S2 'LABEL])
|
||||
[SETQ SUBOBJECTS (SORT (CONS NEWSOBJ SUBOBJECTS)
|
||||
(FUNCTION (LAMBDA (S1 S2)
|
||||
(ALPHORDER (IMAGEOBJPROP S1 'LABEL)
|
||||
(IMAGEOBJPROP S2 'LABEL]
|
||||
(IMAGEOBJPROP OBJ 'SUBOBJECTS SUBOBJECTS)
|
||||
[IMAGEOBJPROP OBJ 'MINWIDTH (IMAX (IMAGEOBJPROP OBJ 'MINWIDTH)
|
||||
(fetch XSIZE of (IMAGEOBJPROP NEWSOBJ 'BOUNDBOX]
|
||||
@@ -1273,6 +1230,10 @@
|
||||
(TEDIT.OBJECT.CHANGED MENUSTREAM OBJ PC))
|
||||
PC])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS MB.NWAY.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(MB.NWAY.INIT)
|
||||
@@ -1325,8 +1286,7 @@
|
||||
(BLTSHADE BLACKSHADE STREAM X Y XSIZE YSIZE 'INVERT))])
|
||||
|
||||
(MB.TOGGLE.INIT
|
||||
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:50 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 12:33 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 7-Dec-2024 12:33 by rmk")
|
||||
(* ; "Edited 19-Oct-2024 23:21 by rmk")
|
||||
(* ; "Edited 18-Oct-2024 13:27 by rmk")
|
||||
(* ; "Edited 6-Oct-2024 23:43 by rmk")
|
||||
@@ -1334,7 +1294,6 @@
|
||||
(* ; "Edited 24-Aug-2024 10:56 by rmk")
|
||||
(* ; "Edited 20-Aug-2024 15:47 by rmk")
|
||||
(* jds " 9-Feb-86 15:18")
|
||||
(DECLARE (GLOBALVARS MB.TOGGLE.IMAGEFNS))
|
||||
(SETQ MB.TOGGLE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.TOGGLE.DISPLAYFN)
|
||||
(FUNCTION MB.SIZEFN)
|
||||
(FUNCTION MB.PUTFN)
|
||||
@@ -1385,7 +1344,6 @@
|
||||
|
||||
(MB.TOGGLE.BUTTONEVENTINFN
|
||||
[LAMBDA (OBJ MENUDS MENUSEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON)
|
||||
(* ; "Edited 14-Apr-2025 23:49 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 13:11 by rmk")
|
||||
(* ; "Edited 19-Oct-2024 19:52 by rmk")
|
||||
(* ; "Edited 5-Oct-2024 22:42 by rmk")
|
||||
@@ -1429,8 +1387,8 @@
|
||||
else (* ; "Buttons came up: do it")
|
||||
(SETQ STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN))
|
||||
(if (OR (NULL STATECHANGEFN)
|
||||
(NEQ 'DON'T (APPLY* STATECHANGEFN OBJ NEXTSTATE (PANETEXTSTREAM
|
||||
MENUDS)
|
||||
(NEQ 'DON'T (APPLY* STATECHANGEFN OBJ NEXTSTATE
|
||||
(fetch (TEXTWINDOW WTEXTSTREAM) of MENUDS)
|
||||
MENUSEL)))
|
||||
then (IMAGEOBJPROP OBJ 'STATE NEXTSTATE)
|
||||
(* ;
|
||||
@@ -1460,6 +1418,10 @@
|
||||
((DESELECTED HIGHLIGHTED UNHIGHLIGHTED))
|
||||
NIL])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS MB.TOGGLE.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(MB.TOGGLE.INIT)
|
||||
@@ -1472,11 +1434,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MB.FIELD.CREATE
|
||||
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 16-Feb-2025 15:01 by rmk")
|
||||
(* ; "Edited 11-Jan-2025 09:59 by rmk")
|
||||
(* ; "Edited 9-Jan-2025 16:52 by rmk")
|
||||
(* ; "Edited 5-Jan-2025 12:09 by rmk")
|
||||
(* ; "Edited 16-Dec-2024 13:33 by rmk")
|
||||
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 16-Dec-2024 13:33 by rmk")
|
||||
(* ; "Edited 9-Dec-2024 21:53 by rmk")
|
||||
(* ; "Edited 4-Dec-2024 15:57 by rmk")
|
||||
(* ; "Edited 20-Oct-2024 23:43 by rmk")
|
||||
@@ -1504,21 +1462,22 @@
|
||||
[FIELDFONT (FONTCREATE (OR (CADR (ASSOC 'FIELDFONT SPEC))
|
||||
'(HELVETICA 8]
|
||||
PRE POST FIELDLOOKS PREFIXOBJ SUFFIXOBJ REMAINDER)
|
||||
(if (NULL IDENTIFIER)
|
||||
then (if PRELABEL
|
||||
then [SETQ IDENTIFIER (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab #\Newline
|
||||
#\:)
|
||||
PRELABEL]
|
||||
else (ERROR (ERROR "Missing both IDENTIFIER and PRELABEL" SPEC)))
|
||||
elseif (OR (LITATOM IDENTIFIER)
|
||||
(SMALLP IDENTIFIER))
|
||||
elseif (STRINGP IDENTIFIER)
|
||||
then (SETQ IDENTIFIER (MKATOM IDENTIFIER))
|
||||
else (\ILLEGAL.ARG IDENTIFIER))
|
||||
(push SPEC (LIST 'IDENTIFIER IDENTIFIER))
|
||||
|
||||
(* ;; "Collect any other properties to put on the prefix")
|
||||
|
||||
(SETQ REMAINDER (for S in SPEC unless (MEMB (CAR S)
|
||||
'(INITSTATE PRELABEL POSTLABEL IDENTIFIER
|
||||
LABELFONT FIELDFONT)) collect S))
|
||||
|
||||
(* ;; "SPEC could specify a prelabel font different from a field font")
|
||||
|
||||
(CL:UNLESS IDENTIFIER
|
||||
(if PRELABEL
|
||||
then [push SPEC (LIST IDENTIFIER (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab
|
||||
#\Newline
|
||||
#\:)
|
||||
PRELABEL]
|
||||
else (ERROR "NO IDENTIFIER FOR FIELD")))
|
||||
[SETQ PRE `((,FIELDFONT " {"]
|
||||
(CL:WHEN PRELABEL
|
||||
(push PRE (LIST LABELFONT PRELABEL)))
|
||||
@@ -1530,29 +1489,25 @@
|
||||
|
||||
(SETQ FIELDLOOKS (\TEDIT.CHARLOOKS.FROM.FONT FIELDFONT))
|
||||
(SETQ PREFIXOBJ (MB.FIELD.PREFIXCREATE SPEC PRE FIELDLOOKS))
|
||||
(SETQ SUFFIXOBJ (MB.FIELD.SUFFIXCREATE SPEC POST FIELDLOOKS))
|
||||
(IMAGEOBJPROP PREFIXOBJ 'SUFFIXOBJ SUFFIXOBJ)
|
||||
[SETQ REMAINDER (MB.SPEC.REMAINDER SPEC '(INITSTATE PRELABEL POSTLABEL IDENTIFIER LABELFONT
|
||||
FIELDFONT]
|
||||
(for S in REMAINDER do (IMAGEOBJPROP PREFIXOBJ (CAR S)
|
||||
(CADR S)))
|
||||
(SETQ SUFFIXOBJ (MB.FIELD.SUFFIXCREATE SPEC POST FIELDLOOKS))
|
||||
|
||||
(* ;; "Let the suffixobj have the same extras as the prefix ? E.g. DELETABLE ?")
|
||||
|
||||
(for S in REMAINDER do (IMAGEOBJPROP SUFFIXOBJ (CAR S)
|
||||
(CADR S)))
|
||||
(IMAGEOBJPROP PREFIXOBJ 'SUFFIXOBJ SUFFIXOBJ)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(TEDIT.INSERT.OBJECT PREFIXOBJ MENUTSTREAM CH# FIELDFONT)
|
||||
(add CH# 1)
|
||||
(CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**)) (* ; "Initial entry")
|
||||
(add CH# (if (EQ 'IMAGEOBJ (CADR (ASSOC 'FIELDTYPE SPEC)))
|
||||
then [TEDIT.INSERT.OBJECT INITSTATE MENUTSTREAM CH#
|
||||
`(FONT ,FIELDFONT]
|
||||
1
|
||||
else [TEDIT.INSERT MENUTSTREAM INITSTATE CH# `(FONT ,FIELDFONT]
|
||||
(NCHARS INITSTATE))))
|
||||
[TEDIT.INSERT MENUTSTREAM (MKSTRING INITSTATE)
|
||||
CH#
|
||||
`(FONT ,FIELDFONT]
|
||||
(add CH# (NCHARS INITSTATE)))
|
||||
(TEDIT.INSERT.OBJECT SUFFIXOBJ MENUTSTREAM CH# FIELDFONT)
|
||||
(add CH# 1])
|
||||
|
||||
@@ -1592,9 +1547,7 @@
|
||||
XKERN _ 0])
|
||||
|
||||
(MB.FIELD.PREFIXCREATE
|
||||
[LAMBDA (SPEC PRE FIELDLOOKS) (* ; "Edited 11-Jan-2025 09:58 by rmk")
|
||||
(* ; "Edited 4-Jan-2025 16:53 by rmk")
|
||||
(* ; "Edited 9-Dec-2024 21:53 by rmk")
|
||||
[LAMBDA (SPEC PRE FIELDLOOKS) (* ; "Edited 9-Dec-2024 21:53 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 09:01 by rmk")
|
||||
(* ; "Edited 4-Dec-2024 17:48 by rmk")
|
||||
(* ; "Edited 8-Nov-2024 08:36 by rmk")
|
||||
@@ -1624,12 +1577,12 @@
|
||||
(IMAGEOBJPROP OBJ SPEC 'SETSTATEFN (FUNCTION MB.FIELD.SETSTATEFN)))
|
||||
(IMAGEOBJPROP OBJ 'FIELDLOOKS FIELDLOOKS)
|
||||
(for S in SPEC unless (MEMB (CAR S)
|
||||
'(PRELABEL POSTLABEL LABELFONT IDENTIFIER FIELDFONT))
|
||||
'(PRELABEL POSTLABEL LABELFONT FIELDFONT))
|
||||
do (IMAGEOBJPROP OBJ (CAR S)
|
||||
(CADR S)))
|
||||
(CL:WHEN (AND EMPTYVALUE (EQ INITSTATE (CADR EMPTYVALUE)))
|
||||
(SETQ INITSTATE '**EMPTY**))
|
||||
(CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**))
|
||||
(CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**)) (* ; "Can SELECTION be initialized?")
|
||||
(CL:UNLESS (SELECTQ FIELDTYPE
|
||||
(NUMBER (NUMBERP INITSTATE))
|
||||
(SYMBOL (LITATOM INITSTATE))
|
||||
@@ -1641,12 +1594,9 @@
|
||||
((TEXT STRING)
|
||||
(STRINGP INITSTATE))
|
||||
(IMAGEOBJ (IMAGEOBJP INITSTATE))
|
||||
(SELECTION (OR (ATOM INITSTATE)
|
||||
(STRINGP INITSTATE)))
|
||||
NIL)
|
||||
(\ILLEGAL.ARG INITSTATE))
|
||||
(IMAGEOBJPROP OBJ 'INITSTATE INITSTATE))
|
||||
(IMAGEOBJPROP OBJ 'IDENTIFIER (CADR (ASSOC 'IDENTIFIER SPEC)))
|
||||
(IMAGEOBJPROP OBJ 'FIELDPREFIX T)
|
||||
OBJ])
|
||||
|
||||
@@ -1673,8 +1623,7 @@
|
||||
OBJ])
|
||||
|
||||
(MB.FIELD.INIT
|
||||
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:51 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 09:05 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 7-Dec-2024 09:05 by rmk")
|
||||
(* ; "Edited 4-Dec-2024 16:09 by rmk")
|
||||
(* ; "Edited 22-Aug-2024 10:07 by rmk")
|
||||
(* ; "Edited 20-Aug-2024 16:03 by rmk")
|
||||
@@ -1684,7 +1633,6 @@
|
||||
|
||||
(* ;; "The displayfn is NILL--field prefixes don't display")
|
||||
|
||||
(DECLARE (GLOBALVARS MB.FIELD.IMAGEFNS))
|
||||
(SETQ MB.FIELD.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.FIELD.DISPLAYFN)
|
||||
(FUNCTION MB.FIELD.IMAGEBOXFN)
|
||||
(FUNCTION MB.PUTFN)
|
||||
@@ -1781,8 +1729,7 @@
|
||||
ENDPC])
|
||||
|
||||
(MB.FIELD.SETSTATEFN
|
||||
[LAMBDA (PREFIXPC NEWVALUE TSTREAM) (* ; "Edited 6-Apr-2025 12:23 by rmk")
|
||||
(* ; "Edited 9-Dec-2024 22:14 by rmk")
|
||||
[LAMBDA (PREFIXPC NEWVALUE TSTREAM) (* ; "Edited 9-Dec-2024 22:14 by rmk")
|
||||
(* ; "Edited 4-Dec-2024 20:31 by rmk")
|
||||
(* ; "Edited 20-Oct-2024 17:20 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 12:46 by rmk")
|
||||
@@ -1826,7 +1773,7 @@
|
||||
"FSEL selects the field to the right of PREFIXPC")
|
||||
(\TEDIT.UPDATE.SEL FSEL FIELDSTART FIELDLENGTH 'LEFT)
|
||||
(CL:UNLESS (EQ 0 FIELDLENGTH) (* ; "Clear the old value")
|
||||
(\TEDIT.DELETE TSTREAM FSEL)
|
||||
(\TEDIT.DELETE TEXTOBJ FSEL)
|
||||
(SETQ FIELDLENGTH 0))
|
||||
(SETQ FIELDLENGTH (if (EQ NEWVALUE '**EMPTY**)
|
||||
then 0
|
||||
@@ -1893,8 +1840,7 @@
|
||||
XKERN _ 0])
|
||||
|
||||
(MB.FIELD.INSURETYPE
|
||||
[LAMBDA (FIELDTYPE STR TSTREAM) (* ; "Edited 24-Mar-2025 09:26 by rmk")
|
||||
(* ; "Edited 4-Dec-2024 20:09 by rmk")
|
||||
[LAMBDA (FIELDTYPE STR TSTREAM) (* ; "Edited 4-Dec-2024 20:09 by rmk")
|
||||
(* ; "Edited 8-Nov-2024 08:37 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 21:52 by rmk")
|
||||
(* ; "Edited 31-Aug-2024 12:46 by rmk")
|
||||
@@ -1915,8 +1861,6 @@
|
||||
((TEXT STRING) (* ;
|
||||
"String should be a string, not NIL atom")
|
||||
(SETQ VAL (OR STR '**EMPTY**)))
|
||||
(TRIMMEDSTRING (CL:UNLESS (STREQUAL "" TRIMMED)
|
||||
(SETQ VAL TRIMMED)))
|
||||
((NUMBER PICAS POSITIVENUMBER SIGNEDNUMBER CARDINAL)
|
||||
(SETQ TRIMMED (MKATOM TRIMMED))
|
||||
(if (OR (EQ 0 (NCHARS TRIMMED))
|
||||
@@ -1964,30 +1908,34 @@
|
||||
(\TEDIT.THELP "UNRECOGNIZED FIELD TYPE" FIELDTYPE))
|
||||
VAL])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS MB.FIELD.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(MB.FIELD.INIT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3279 19224 (MB.ADD 3289 . 9810) (MB.DELETE 9812 . 10186) (MB.GET 10188 . 16958) (
|
||||
MB.GET.MBARG 16960 . 18629) (TEDIT.BACKTOMAIN 18631 . 19222)) (19268 39204 (MB.BUTTONEVENTINFN 19278
|
||||
. 20846) (MB.DISPLAYFN 20848 . 22907) (MB.SETIMAGE 22909 . 24077) (MB.SIZEFN 24079 . 25627) (
|
||||
MB.WHENOPERATEDONFN 25629 . 27578) (MB.COPYFN 27580 . 28038) (MB.GETFN 28040 . 29001) (MB.PUTFN 29003
|
||||
. 30103) (MB.SHOWSELFN 30105 . 31614) (MB.CREATE 31616 . 35639) (MB.CHANGENAME 35641 . 36123) (
|
||||
MB.INIT 36125 . 37586) (MB.TRACK.UNTIL 37588 . 38283) (MB.DON'T 38285 . 38581) (MB.SPEC.REMAINDER
|
||||
38583 . 39202)) (39366 49371 (MB.3STATE.CREATE 39376 . 40240) (MB.3STATE.DISPLAYFN 40242 . 41228) (
|
||||
MB.3STATE.SHOWSELFN 41230 . 43541) (MB.3STATE.INIT 43543 . 44954) (MB.3STATE.SETSTATEFN 44956 . 45614)
|
||||
(MB.3STATE.BUTTONEVENTINFN 45616 . 49369)) (49526 80622 (MB.NWAY.CREATE 49536 . 55719) (
|
||||
MB.NWAY.DISPLAYFN 55721 . 56584) (MB.NWAY.WHENOPERATEDONFN 56586 . 58776) (MB.NWAY.SIZEFN 58778 .
|
||||
62714) (MB.NWAY.SELECT 62716 . 66286) (MB.NWAY.BUTTONEVENTINFN 66288 . 69500) (MB.NWAY.NEWMENUBUTTON
|
||||
69502 . 70214) (MB.NWAY.COPYFN 70216 . 71183) (MB.NWAY.INIT 71185 . 72676) (MB.NWAY.ARRANGEBUTTONS
|
||||
72678 . 74649) (MB.NWAY.ADDITEM 74651 . 78800) (MB.NWAY.FINDSUBOBJ 78802 . 79316) (MB.NWAY.SETSTATEFN
|
||||
79318 . 80620)) (80701 92700 (MB.TOGGLE.CREATE 80711 . 81706) (MB.TOGGLE.DISPLAYFN 81708 . 83191) (
|
||||
MB.TOGGLE.INIT 83193 . 84992) (MB.SET.TOGGLE 84994 . 86195) (MB.TOGGLE.SETSTATEFN 86197 . 87037) (
|
||||
MB.TOGGLE.BUTTONEVENTINFN 87039 . 91355) (MB.TOGGLE.WHENOPERATEDONFN 91357 . 92698)) (92781 125314 (
|
||||
MB.FIELD.CREATE 92791 . 98242) (MB.FIELD.DISPLAYFN 98244 . 99035) (MB.FIELD.IMAGEBOXFN 99037 . 100519)
|
||||
(MB.FIELD.PREFIXCREATE 100521 . 104457) (MB.FIELD.SUFFIXCREATE 104459 . 106119) (MB.FIELD.INIT 106121
|
||||
. 107888) (MB.FIELD.WHENOPERATEDONFN 107890 . 109161) (MB.FIELD.GETSTATEFN 109163 . 113097) (
|
||||
MB.FIELD.SETSTATEFN 113099 . 117903) (MB.FIELD.BUTTONEVENTINFN 117905 . 120210) (MB.FIELD.SIZEFN
|
||||
120212 . 120452) (MB.FIELD.INSURETYPE 120454 . 125312)))))
|
||||
(FILEMAP (NIL (3459 19034 (MB.ADD 3469 . 9058) (MB.DELETE 9060 . 9434) (MB.GET 9436 . 16099) (
|
||||
MB.GET.MBARG 16101 . 17770) (TEDITMENU.STREAM 17772 . 18439) (TEDIT.BACKTOMAIN 18441 . 19032)) (19078
|
||||
36844 (MB.BUTTONEVENTINFN 19088 . 20297) (MB.DISPLAYFN 20299 . 22358) (MB.SETIMAGE 22360 . 23528) (
|
||||
MB.SIZEFN 23530 . 25078) (MB.WHENOPERATEDONFN 25080 . 27029) (MB.COPYFN 27031 . 27489) (MB.GETFN 27491
|
||||
. 28452) (MB.PUTFN 28454 . 29554) (MB.SHOWSELFN 29556 . 31065) (MB.CREATE 31067 . 34052) (
|
||||
MB.CHANGENAME 34054 . 34536) (MB.INIT 34538 . 35847) (MB.TRACK.UNTIL 35849 . 36544) (MB.DON'T 36546 .
|
||||
36842)) (37069 46900 (MB.3STATE.CREATE 37079 . 37943) (MB.3STATE.DISPLAYFN 37945 . 38931) (
|
||||
MB.3STATE.SHOWSELFN 38933 . 41244) (MB.3STATE.INIT 41246 . 42498) (MB.3STATE.SETSTATEFN 42500 . 43158)
|
||||
(MB.3STATE.BUTTONEVENTINFN 43160 . 46898)) (47125 76244 (MB.NWAY.CREATE 47135 . 52645) (
|
||||
MB.NWAY.DISPLAYFN 52647 . 53510) (MB.NWAY.WHENOPERATEDONFN 53512 . 55702) (MB.NWAY.SIZEFN 55704 .
|
||||
59640) (MB.NWAY.SELECT 59642 . 62452) (MB.NWAY.BUTTONEVENTINFN 62454 . 65666) (MB.NWAY.NEWMENUBUTTON
|
||||
65668 . 66380) (MB.NWAY.COPYFN 66382 . 67349) (MB.NWAY.INIT 67351 . 68685) (MB.NWAY.ARRANGEBUTTONS
|
||||
68687 . 70658) (MB.NWAY.ADDITEM 70660 . 74422) (MB.NWAY.FINDSUBOBJ 74424 . 74938) (MB.NWAY.SETSTATEFN
|
||||
74940 . 76242)) (76391 88119 (MB.TOGGLE.CREATE 76401 . 77396) (MB.TOGGLE.DISPLAYFN 77398 . 78881) (
|
||||
MB.TOGGLE.INIT 78883 . 80523) (MB.SET.TOGGLE 80525 . 81726) (MB.TOGGLE.SETSTATEFN 81728 . 82568) (
|
||||
MB.TOGGLE.BUTTONEVENTINFN 82570 . 86774) (MB.TOGGLE.WHENOPERATEDONFN 86776 . 88117)) (88270 119196 (
|
||||
MB.FIELD.CREATE 88280 . 93015) (MB.FIELD.DISPLAYFN 93017 . 93808) (MB.FIELD.IMAGEBOXFN 93810 . 95292)
|
||||
(MB.FIELD.PREFIXCREATE 95294 . 98846) (MB.FIELD.SUFFIXCREATE 98848 . 100508) (MB.FIELD.INIT 100510 .
|
||||
102119) (MB.FIELD.WHENOPERATEDONFN 102121 . 103392) (MB.FIELD.GETSTATEFN 103394 . 107328) (
|
||||
MB.FIELD.SETSTATEFN 107330 . 112025) (MB.FIELD.BUTTONEVENTINFN 112027 . 114332) (MB.FIELD.SIZEFN
|
||||
114334 . 114574) (MB.FIELD.INSURETYPE 114576 . 119194)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Apr-2025 23:06:01" {WMEDLEY}<library>tedit>TEDIT-CHAT.;20 12175
|
||||
(FILECREATED "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16 12363
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.DISPLAYTEXT)
|
||||
:CHANGES-TO (FNS TEDITCHAT.CHARFN)
|
||||
|
||||
:PREVIOUS-DATE "11-Mar-2025 15:41:08" {WMEDLEY}<library>tedit>TEDIT-CHAT.;17)
|
||||
:PREVIOUS-DATE " 2-May-2024 18:09:26" {WMEDLEY}<library>tedit>TEDIT-CHAT.;15)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-CHATCOMS)
|
||||
@@ -70,8 +70,7 @@
|
||||
(replace (CHAT.STATE HELD) of STATE with NIL])
|
||||
|
||||
(TEDITCHAT.CHARFN
|
||||
[LAMBDA (CH CHAT.STATE) (* ; "Edited 11-Mar-2025 15:40 by rmk")
|
||||
(* ; "Edited 24-Jun-2024 00:04 by rmk")
|
||||
[LAMBDA (CH CHAT.STATE) (* ; "Edited 24-Jun-2024 00:04 by rmk")
|
||||
(* ; "Edited 2-May-2024 18:09 by rmk")
|
||||
(* ; "Edited 22-Dec-2023 23:57 by rmk")
|
||||
(* ; "Edited 18-Mar-2023 20:08 by rmk")
|
||||
@@ -80,7 +79,7 @@
|
||||
(TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
|
||||
(SELCHARQ CH
|
||||
(BS (\TEDIT.CHARDELETE TSTREAM))
|
||||
(BS (\TEDIT.CHARDELETE TSTREAM (FGETTOBJ TEXTOBJ SEL)))
|
||||
(LF NIL)
|
||||
(BOUT TSTREAM CH])
|
||||
)
|
||||
@@ -92,99 +91,98 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.DISPLAYTEXT
|
||||
[LAMBDA (TSTREAM CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 21-Apr-2025 23:05 by rmk")
|
||||
(* ; "Edited 23-Dec-2023 09:15 by rmk")
|
||||
[LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 23-Dec-2023 09:15 by rmk")
|
||||
(* ; "Edited 6-Apr-2023 21:39 by rmk")
|
||||
(* ; "Edited 4-Nov-2022 17:18 by rmk")
|
||||
(* ; "Edited 25-Sep-2022 13:34 by rmk")
|
||||
(* ; "Edited 6-Aug-2022 13:28 by rmk")
|
||||
(* ;
|
||||
"This function does the actual displaying of typed-in text on the edit window.")
|
||||
(* ; "Edited 6-Aug-2022 13:28 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:01 by mitani")
|
||||
(* This function does the actual
|
||||
displaying of typed-in text on the
|
||||
edit window.)
|
||||
(LINEDESCRIPTOR! LINE)
|
||||
(NOTUSED)
|
||||
(LET* ((TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||
(LOOKS (\TEDIT.APPLY.STYLES (FGETTOBJ TEXTOBJ CARETLOOKS)
|
||||
(HELP 'TEDIT.DISPLAYTEXT 'NOTUSED?)
|
||||
(PROG ((LOOKS (\TEDIT.APPLY.STYLES (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
|
||||
(\TEDIT.CARETPIECE TEXTOBJ)
|
||||
TSTREAM))
|
||||
(TERMSA (FGETTOBJ TEXTOBJ TXTTERMSA))
|
||||
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)))
|
||||
(TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ))
|
||||
DY FONT)
|
||||
(MOVETO XPOINT (IPLUS (GETLD LINE YBASE)
|
||||
(OR (FGETCLOOKS LOOKS CLOFFSET)
|
||||
(MOVETO XPOINT (IPLUS (fetch YBASE of LINE)
|
||||
(OR (fetch CLOFFSET of LOOKS)
|
||||
0))
|
||||
DS) (* ; "Set the display stream position")
|
||||
DS) (* Set the display stream position)
|
||||
(COND
|
||||
[TERMSA (* ;
|
||||
"Special terminal table for controlling character display. Use it.")
|
||||
[TERMSA (* Special terminal table for
|
||||
controlling character display.
|
||||
Use it.)
|
||||
(RESETLST
|
||||
(RESETSAVE \PRIMTERMSA TERMSA)
|
||||
[COND
|
||||
[(STRINGP CH)
|
||||
(for CHAR instring CH
|
||||
do (SELCHARQ CHAR
|
||||
(TAB (* ; "Put down white")
|
||||
(BITBLT NIL 0 0 DS XPOINT (FGETLD LINE YBOT)
|
||||
(TAB (* Put down white)
|
||||
(BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
|
||||
36
|
||||
(FGETLD LINE LHEIGHT)
|
||||
(fetch LHEIGHT of LINE)
|
||||
'TEXTURE
|
||||
'REPLACE WHITESHADE)
|
||||
(RELMOVETO 36 0 DS))
|
||||
(CR (BITBLT NIL 0 0 DS XPOINT (FGETLD LINE YBOT)
|
||||
(CR (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
|
||||
(IMAX 6 (CHARWIDTH CHAR FONT))
|
||||
(FGETLD LINE LHEIGHT)
|
||||
(fetch LHEIGHT of LINE)
|
||||
'TEXTURE
|
||||
'REPLACE WHITESHADE))
|
||||
(\DSPPRINTCHAR TSTREAM CHAR]
|
||||
(\DSPPRINTCHAR (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
|
||||
CHAR]
|
||||
(T (SELCHARQ CH
|
||||
(TAB (* ; "Put down white")
|
||||
(BITBLT NIL 0 0 DS XPOINT (FGETLD LINE YBOT)
|
||||
(TAB (* Put down white)
|
||||
(BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
|
||||
36
|
||||
(FGETLD LINE LHEIGHT)
|
||||
(fetch LHEIGHT of LINE)
|
||||
'TEXTURE
|
||||
'REPLACE WHITESHADE)
|
||||
(RELMOVETO 36 0 DS))
|
||||
(EOL (BITBLT NIL 0 0 DS XPOINT (FGETLD LINE YBOT)
|
||||
(EOL (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
|
||||
(IMAX 6 (CHARWIDTH CH FONT))
|
||||
(FGETLD LINE LHEIGHT)
|
||||
(fetch LHEIGHT of LINE)
|
||||
'TEXTURE
|
||||
'REPLACE WHITESHADE))
|
||||
(\DSPPRINTCHAR TSTREAM CH])]
|
||||
(T (* ;
|
||||
"No special handling; just use native character codes")
|
||||
(\DSPPRINTCHAR (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
|
||||
CH])]
|
||||
(T (* No special handling;
|
||||
just use native character codes)
|
||||
(COND
|
||||
[(STRINGP CH)
|
||||
(for CHAR instring CH do (SELCHARQ CHAR
|
||||
(TAB (* ; "Put down white")
|
||||
(TAB (* Put down white)
|
||||
(BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
|
||||
(FGETLD LINE YBOT)
|
||||
(fetch YBOT of LINE)
|
||||
36
|
||||
(FGETLD LINE LHEIGHT)
|
||||
(fetch LHEIGHT of LINE)
|
||||
'TEXTURE
|
||||
'REPLACE WHITESHADE)
|
||||
(RELMOVETO 36 0 DS))
|
||||
(EOL (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
|
||||
(FGETLD LINE YBOT)
|
||||
(fetch YBOT of LINE)
|
||||
(IMAX 6 (CHARWIDTH CHAR FONT))
|
||||
(FGETLD LINE LHEIGHT)
|
||||
(fetch LHEIGHT of LINE)
|
||||
'TEXTURE
|
||||
'REPLACE WHITESHADE))
|
||||
(BLTCHAR CHAR DS]
|
||||
(T (SELCHARQ CH
|
||||
(TAB (* ; "Put down white")
|
||||
(TAB (* Put down white)
|
||||
(BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
|
||||
(FGETLD LINE YBOT)
|
||||
(fetch YBOT of LINE)
|
||||
36
|
||||
(FGETLD LINE LHEIGHT)
|
||||
(fetch LHEIGHT of LINE)
|
||||
'TEXTURE
|
||||
'REPLACE WHITESHADE)
|
||||
(RELMOVETO 36 0 DS))
|
||||
(EOL (* ; "Blank out the CR's width.")
|
||||
(EOL (* Blank out the CR's width.)
|
||||
(BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
|
||||
(FGETLD LINE YBOT)
|
||||
(fetch YBOT of LINE)
|
||||
(IMAX 6 (CHARWIDTH CH FONT))
|
||||
(FGETLD LINE LHEIGHT)
|
||||
(fetch LHEIGHT of LINE)
|
||||
'TEXTURE
|
||||
'REPLACE WHITESHADE))
|
||||
(BLTCHAR CH DS])
|
||||
@@ -215,6 +213,6 @@
|
||||
CHATDECLS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (887 4631 (TEDITSTREAM.INIT 897 . 1824) (TEDITCHAT.MENUFN 1826 . 3662) (TEDITCHAT.CHARFN
|
||||
3664 . 4629)) (4678 11287 (TEDIT.DISPLAYTEXT 4688 . 11285)))))
|
||||
(FILEMAP (NIL (886 4544 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
|
||||
3663 . 4542)) (4591 11475 (TEDIT.DISPLAYTEXT 4601 . 11473)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,31 +1,165 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Mar-2025 15:27:20" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;163 19331
|
||||
(FILECREATED "28-Nov-2024 10:03:03" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;133 49278
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.COMMAND.FUNCTION? \TEDIT.COMMAND.LOOP)
|
||||
(VARS TEDIT-COMMANDCOMS)
|
||||
:CHANGES-TO (FNS \TEDIT.COMMAND.LOOP)
|
||||
|
||||
:PREVIOUS-DATE "16-Mar-2025 14:20:07" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;160)
|
||||
:PREVIOUS-DATE "21-Nov-2024 11:53:19" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;128)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
|
||||
|
||||
(RPAQQ TEDIT-COMMANDCOMS
|
||||
((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (MACROS \TEDIT.MOUSESTATE \TEDIT.CHECK)))
|
||||
(FNS \TEDIT.COMMAND.LOOP \TEDIT.COMMAND.FUNCTION?)
|
||||
(FNS \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE \TEDIT.COMMAND.RESET.SETUP)
|
||||
[[DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
|
||||
(CONSTANTS (MSPACE 153)
|
||||
(NSPACE 152)
|
||||
(THINSPACE 159)
|
||||
(FIGSPACE 154))
|
||||
(EXPORT (CONSTANTS (NONE.TTC 0)
|
||||
(CHARDELETE.TTC 1)
|
||||
(WORDDELETE.TTC 2)
|
||||
(DELETE.TTC 3)
|
||||
(FUNCTIONCALL.TTC 4)
|
||||
(REDO.TTC 5)
|
||||
(UNDO.TTC 6)
|
||||
(CMD.TTC 7)
|
||||
(NEXT.TTC 8)
|
||||
(EXPAND.TTC 9)
|
||||
(CHARDELETE.FORWARD.TTC 10)
|
||||
(WORDDELETE.FORWARD.TTC 11)
|
||||
(PUNCT.TTC 20)
|
||||
(TEXT.TTC 21)
|
||||
(WHITESPACE.TTC 22))
|
||||
(MACROS \TEDIT.MOUSESTATE \TEDIT.CHECK)
|
||||
(RECORDS TEDITTERMCODE)
|
||||
|
||||
(* ;; "Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character (RMK: THESE DON'T SEEM TO BE USED)")
|
||||
|
||||
(CONSTANTS (NOTBEFORE.LB 1)
|
||||
(* ;
|
||||
"Must not break before this character (e.g. Japanese right-paren)")
|
||||
(NOTAFTER.LB 2)
|
||||
(* ;
|
||||
"Must not break after this character (e.g. Japanese open-quote)")
|
||||
(BEFORE.LB 4)
|
||||
(* ; "OK to break before this character, provided it's OK to break after the prior char (true of most non-white-space)")
|
||||
(AFTER.LB 8)
|
||||
(* ;
|
||||
"OK to break after this char, if it's OK to break before the next one (true of most white space)")
|
||||
(DISAPPEAR-IF-NOT-SPLIT.LB 16)
|
||||
(* ; "This character shouldn't be rendered if it isn't the last char on the line (non-breaking hyphen has this)")
|
||||
(NEWCHAR-IF-SPLIT.LB 32)
|
||||
(* ; "Look this char up in *TEDIT-SPLITCHAR-HASH* if this IS the last character on a line, and render it as the char we found.")
|
||||
]
|
||||
(FNS \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE \TEDIT.COMMAND.LOOP
|
||||
\TEDIT.COMMAND.RESET.SETUP)
|
||||
[INITVARS (TEDIT.INTERRUPTS '((2 BREAK)
|
||||
(5 ERROR)
|
||||
(7 HELP)
|
||||
(20 CONTROL-T]
|
||||
(VARS (|| NIL))
|
||||
(* ; "Why?")
|
||||
(GLOBALVARS || TEDIT.INTERRUPTS)))
|
||||
(GLOBALVARS || TEDIT.INTERRUPTS)
|
||||
(COMS (* ; "Read-table Utilities")
|
||||
(FNS \TEDIT.READTABLE \TEDIT.WORDBOUND.READTABLE TEDIT.GETSYNTAX TEDIT.SETSYNTAX
|
||||
TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET TEDIT.WORDSET
|
||||
TEDIT.ATOMBOUND.READTABLE)
|
||||
[DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE))
|
||||
(TEDIT.WORDBOUND.READTABLE (
|
||||
\TEDIT.WORDBOUND.READTABLE
|
||||
]
|
||||
(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE))
|
||||
[COMS (* ; "Wheelscroll")
|
||||
(FILES (SYSLOAD FROM LISPUSERS)
|
||||
WHEELSCROLL)
|
||||
(FNS \TEDIT.WHEELSCROLL)
|
||||
(GLOBALVARS WHEELSCROLLCHARCODES)
|
||||
(VARS (WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL]
|
||||
(COMS (* ; "Clipboard")
|
||||
(FNS \TEDIT.CLIPBOARD \TEDIT.COPYTOCLIPBOARD \TEDIT.EXTRACTTOCLIPBOARD \TEDIT.WRITE.SEL
|
||||
)
|
||||
[DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY (CONSTANTS (CLIPBOARDCODES
|
||||
(CHARCODE (meta,C meta,X meta,c
|
||||
meta,X]
|
||||
(P (\TEDIT.CLIPBOARD])
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \SCRATCHLEN 64)
|
||||
|
||||
|
||||
(CONSTANTS (\SCRATCHLEN 64))
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ MSPACE 153)
|
||||
|
||||
(RPAQQ NSPACE 152)
|
||||
|
||||
(RPAQQ THINSPACE 159)
|
||||
|
||||
(RPAQQ FIGSPACE 154)
|
||||
|
||||
|
||||
(CONSTANTS (MSPACE 153)
|
||||
(NSPACE 152)
|
||||
(THINSPACE 159)
|
||||
(FIGSPACE 154))
|
||||
)
|
||||
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ NONE.TTC 0)
|
||||
|
||||
(RPAQQ CHARDELETE.TTC 1)
|
||||
|
||||
(RPAQQ WORDDELETE.TTC 2)
|
||||
|
||||
(RPAQQ DELETE.TTC 3)
|
||||
|
||||
(RPAQQ FUNCTIONCALL.TTC 4)
|
||||
|
||||
(RPAQQ REDO.TTC 5)
|
||||
|
||||
(RPAQQ UNDO.TTC 6)
|
||||
|
||||
(RPAQQ CMD.TTC 7)
|
||||
|
||||
(RPAQQ NEXT.TTC 8)
|
||||
|
||||
(RPAQQ EXPAND.TTC 9)
|
||||
|
||||
(RPAQQ CHARDELETE.FORWARD.TTC 10)
|
||||
|
||||
(RPAQQ WORDDELETE.FORWARD.TTC 11)
|
||||
|
||||
(RPAQQ PUNCT.TTC 20)
|
||||
|
||||
(RPAQQ TEXT.TTC 21)
|
||||
|
||||
(RPAQQ WHITESPACE.TTC 22)
|
||||
|
||||
|
||||
(CONSTANTS (NONE.TTC 0)
|
||||
(CHARDELETE.TTC 1)
|
||||
(WORDDELETE.TTC 2)
|
||||
(DELETE.TTC 3)
|
||||
(FUNCTIONCALL.TTC 4)
|
||||
(REDO.TTC 5)
|
||||
(UNDO.TTC 6)
|
||||
(CMD.TTC 7)
|
||||
(NEXT.TTC 8)
|
||||
(EXPAND.TTC 9)
|
||||
(CHARDELETE.FORWARD.TTC 10)
|
||||
(WORDDELETE.FORWARD.TTC 11)
|
||||
(PUNCT.TTC 20)
|
||||
(TEXT.TTC 21)
|
||||
(WHITESPACE.TTC 22))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON
|
||||
|
||||
(* ;; "Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called.")
|
||||
@@ -49,118 +183,39 @@
|
||||
(T (KWOTE I]
|
||||
(T (CONS COMMENTFLG ARGS])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224))
|
||||
(TTDECODE (LOGAND DATUM 31))))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ NOTBEFORE.LB 1)
|
||||
|
||||
(RPAQQ NOTAFTER.LB 2)
|
||||
|
||||
(RPAQQ BEFORE.LB 4)
|
||||
|
||||
(RPAQQ AFTER.LB 8)
|
||||
|
||||
(RPAQQ DISAPPEAR-IF-NOT-SPLIT.LB 16)
|
||||
|
||||
(RPAQQ NEWCHAR-IF-SPLIT.LB 32)
|
||||
|
||||
|
||||
(CONSTANTS (NOTBEFORE.LB 1)
|
||||
(NOTAFTER.LB 2)
|
||||
(BEFORE.LB 4)
|
||||
(AFTER.LB 8)
|
||||
(DISAPPEAR-IF-NOT-SPLIT.LB 16)
|
||||
(NEWCHAR-IF-SPLIT.LB 32))
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.COMMAND.LOOP
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 23-Mar-2025 09:56 by rmk")
|
||||
(* ; "Edited 16-Mar-2025 14:19 by rmk")
|
||||
(* ; "Edited 17-Feb-2025 12:05 by rmk")
|
||||
(* ; "Edited 28-Nov-2024 10:01 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 11:51 by rmk")
|
||||
(* ; "Edited 13-Sep-2024 22:34 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 23:26 by rmk")
|
||||
(* ; "Edited 18-Aug-2024 23:05 by rmk")
|
||||
(* ; "Edited 2-Aug-2024 08:46 by rmk")
|
||||
(* ; "Edited 13-Jul-2024 23:13 by rmk")
|
||||
(* ; "Edited 12-Jul-2024 00:39 by rmk")
|
||||
(* ; "Edited 9-Jul-2024 18:02 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 16:24 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 12:31 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 00:08 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:21 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:58 by rmk")
|
||||
(* ; "Edited 7-May-2024 10:42 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:59 by rmk")
|
||||
(* ; "Edited 24-Feb-2024 15:33 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 09:50 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:40 by rmk")
|
||||
(* ; "Edited 30-May-91 19:33 by jds")
|
||||
|
||||
(* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch")
|
||||
|
||||
(DECLARE (SPECVARS TEXTSTREAM))
|
||||
(LET
|
||||
[(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ]
|
||||
(for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
|
||||
(* ; "Add the process to our panes")
|
||||
(until (TTY.PROCESSP) do (* ;
|
||||
"Wait until we really have the TTY before proceeding.")
|
||||
(DISMISS 250))
|
||||
(RESETLST
|
||||
(RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ)
|
||||
T))
|
||||
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do (ERSETQ (until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do (\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action")
|
||||
(while (FGETTOBJ TEXTOBJ EDITOPACTIVE) do (\TEDIT.FLASHCARET TEXTOBJ)
|
||||
(* ;
|
||||
"Flash caret while other operation completes")
|
||||
(BLOCK))
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
(\TEDIT.FLASHCARET TEXTOBJ) (* ;
|
||||
"Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE T)
|
||||
(* ;
|
||||
"Before starting to work, note that we're doing something.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;;
|
||||
"Handle user type-in. CHARCODE is special so functions can see it.")
|
||||
|
||||
[bind CHARCODE TCH FN first (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ
|
||||
LOOPFN))
|
||||
(ERSETQ (APPLY* FN TSTREAM)))
|
||||
while (\SYSBUFP) do (SETQ CHARCODE (\GETKEY))
|
||||
(CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN))
|
||||
(* ;
|
||||
"The user can control each character typed.")
|
||||
(SETQ TCH (APPLY* FN TSTREAM CHARCODE))
|
||||
|
||||
(* ;;
|
||||
"Ignore input if TCH=NIL, continue if T, otherwise substitute.")
|
||||
|
||||
(CL:UNLESS (EQ TCH T)
|
||||
(SETQ CHARCODE TCH)))
|
||||
(CL:WHEN CHARCODE
|
||||
(OR (\TEDIT.COMMAND.FUNCTION? TSTREAM
|
||||
CHARCODE)
|
||||
(\TEDIT.INSERT CHARCODE (TEXTSEL
|
||||
TEXTOBJ)
|
||||
TSTREAM NIL T)))])
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))])
|
||||
|
||||
(\TEDIT.COMMAND.FUNCTION?
|
||||
[LAMBDA (TSTREAM CHARCODE) (* ; "Edited 23-Mar-2025 15:27 by rmk")
|
||||
(DECLARE (SPECVARS TSTREAM CHARCODE))
|
||||
|
||||
(* ;; "If CHARCODE is a function in TSTREAM's read table, execute the function.")
|
||||
|
||||
(LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
FN)
|
||||
(DECLARE (SPECVARS TEXTOBJ))
|
||||
(CL:WHEN [AND (EQ (\TEDIT.TTC FUNCTIONCALL)
|
||||
(\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL))
|
||||
CHARCODE))
|
||||
(SETQ FN (CAR (fetch MACROFN of (GETHASH CHARCODE (fetch READMACRODEFS
|
||||
of (FGETTOBJ TEXTOBJ
|
||||
TXTRTBL]
|
||||
(if (AND (LISTP FN)
|
||||
(NOT (FNTYP FN)))
|
||||
then
|
||||
(* ;; "A form but not a LAMBDA. TSTREAM, TEXTOBJ, and CHARCODE are specvars")
|
||||
|
||||
(EVAL FN)
|
||||
else (APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ)))
|
||||
T)])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.INTERRUPT.SETUP
|
||||
[LAMBDA (PROC FORCEOFF) (* ; "Edited 27-Mar-2024 15:27 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:45 by rmk")
|
||||
@@ -199,6 +254,133 @@
|
||||
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL)
|
||||
TEXTOBJ])
|
||||
|
||||
(\TEDIT.COMMAND.LOOP
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 28-Nov-2024 10:01 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 11:51 by rmk")
|
||||
(* ; "Edited 13-Sep-2024 22:34 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 23:26 by rmk")
|
||||
(* ; "Edited 18-Aug-2024 23:05 by rmk")
|
||||
(* ; "Edited 2-Aug-2024 08:46 by rmk")
|
||||
(* ; "Edited 13-Jul-2024 23:13 by rmk")
|
||||
(* ; "Edited 12-Jul-2024 00:39 by rmk")
|
||||
(* ; "Edited 9-Jul-2024 18:02 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 16:24 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 12:31 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 00:08 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:21 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:58 by rmk")
|
||||
(* ; "Edited 7-May-2024 10:42 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:59 by rmk")
|
||||
(* ; "Edited 24-Feb-2024 15:33 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 09:50 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:40 by rmk")
|
||||
(* ; "Edited 30-May-91 19:33 by jds")
|
||||
|
||||
(* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch")
|
||||
|
||||
(LET
|
||||
[(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ]
|
||||
(for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
|
||||
(* ; "Add the process to our panes")
|
||||
(until (TTY.PROCESSP) do (* ;
|
||||
"Wait until we really have the TTY before proceeding.")
|
||||
(DISMISS 250))
|
||||
(RESETLST
|
||||
(RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ)
|
||||
T))
|
||||
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do
|
||||
(ERSETQ
|
||||
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do
|
||||
(\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action")
|
||||
(while (FGETTOBJ TEXTOBJ EDITOPACTIVE) do (\TEDIT.FLASHCARET TEXTOBJ)
|
||||
(* ;
|
||||
"Flash caret while other operation completes")
|
||||
(BLOCK))
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
(\TEDIT.FLASHCARET TEXTOBJ) (* ;
|
||||
"Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE T) (* ;
|
||||
"Before starting to work, note that we're doing something.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Handle user type-in")
|
||||
|
||||
[bind CH TCH FN first (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ LOOPFN))
|
||||
(ERSETQ (APPLY* FN TSTREAM))) while (\SYSBUFP)
|
||||
do (SETQ CH (\GETKEY))
|
||||
(CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN))
|
||||
(* ;
|
||||
"Give the OEM user control for each character typed.")
|
||||
(SETQ TCH (APPLY* FN TSTREAM CH))
|
||||
|
||||
(* ;;
|
||||
"And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.")
|
||||
|
||||
(OR (EQ TCH T)
|
||||
(SETQ CH TCH)))
|
||||
(SELECTC (AND CH (\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL))
|
||||
CH))
|
||||
(CHARDELETE.TTC
|
||||
(\TEDIT.CHARDELETE TSTREAM))
|
||||
(CHARDELETE.FORWARD.TTC
|
||||
(\TEDIT.CHARDELETE TSTREAM T))
|
||||
(WORDDELETE.TTC
|
||||
(\TEDIT.WORDDELETE TSTREAM))
|
||||
(WORDDELETE.FORWARD.TTC
|
||||
(\TEDIT.WORDDELETE.FORWARD TSTREAM))
|
||||
(DELETE.TTC (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)))
|
||||
(UNDO.TTC (* ;
|
||||
"Take off the BPD, the undoing and put it back on.")
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(TEDIT.UNDO TSTREAM))
|
||||
(REDO.TTC (* ;
|
||||
"He hit the REDO key, so go REDO something")
|
||||
(TEDIT.REDO TSTREAM)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ))
|
||||
(FUNCTIONCALL.TTC (* ;
|
||||
"This is a special character -- it calls a function")
|
||||
(CL:WHEN [SETQ FN (CAR (fetch MACROFN
|
||||
of (GETHASH CH (fetch READMACRODEFS
|
||||
of (FGETTOBJ TEXTOBJ
|
||||
TXTRTBL]
|
||||
(* ;
|
||||
"There IS a command function to be called.")
|
||||
(APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ))
|
||||
(* ; "do it")
|
||||
(* ;
|
||||
"After a user function (that is not wheelscroll) no more blue-pending-delete")
|
||||
|
||||
(* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")
|
||||
|
||||
(CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
|
||||
(MEMB CH CLIPBOARDCODES))
|
||||
(* ;
|
||||
"The FNs handled the selection. should preserve the highlighting")
|
||||
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL NIL T TEXTOBJ))))
|
||||
(NEXT.TTC (* ;
|
||||
"Move to the next blank to fill in, delimited by >>...<<")
|
||||
(TEDIT.NEXT TSTREAM))
|
||||
(EXPAND.TTC (* ; "EXPAND AN ABBREVIATION")
|
||||
(\TEDIT.ABBREV.EXPAND TSTREAM))
|
||||
(SELECTC (AND CH (fetch TERMCLASS of (\SYNCODE (OR (FGETTOBJ TEXTOBJ
|
||||
TXTTERMSA)
|
||||
\PRIMTERMSA)
|
||||
CH)))
|
||||
(CHARDELETE.TC (\TEDIT.CHARDELETE TSTREAM))
|
||||
(WORDDELETE.TC (\TEDIT.WORDDELETE TSTREAM))
|
||||
(LINEDELETE.TC (\TEDIT.DELETE TEXTOBJ))
|
||||
(CL:WHEN CH (* ;
|
||||
"Any other key: insert the character.")
|
||||
(\TEDIT.INSERT CH (TEXTSEL TEXTOBJ)
|
||||
TSTREAM NIL T))])
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))])
|
||||
|
||||
(\TEDIT.COMMAND.RESET.SETUP
|
||||
[LAMBDA (ARGS STARTING) (* ; "Edited 29-Jun-2024 00:10 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 18:54 by rmk")
|
||||
@@ -296,17 +478,445 @@
|
||||
(20 CONTROL-T)))
|
||||
|
||||
(RPAQQ || NIL)
|
||||
|
||||
|
||||
|
||||
(* ; "Why?")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS || TEDIT.INTERRUPTS)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ; "Read-table Utilities")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.READTABLE
|
||||
[LAMBDA NIL (* ; "Edited 24-Dec-2023 09:54 by rmk")
|
||||
(* ; "Edited 20-Apr-2018 07:59 by rmk:")
|
||||
(* jds "12-Sep-86 13:48")
|
||||
|
||||
(* ;; "Create a TEdit read-table, to control which characters have what functions and call which commands.")
|
||||
|
||||
(LET [(RTBL (create READTABLEP
|
||||
READMACRODEFS _ (HASHARRAY 50]
|
||||
|
||||
(* ;; "CHARDELETE.FORWARD replaces WORDDELETE on ^W")
|
||||
|
||||
(for CH in (CHARCODE (BS ^A ^W DEL %#A %#B %#C ESC)) as CL
|
||||
in (CONSTANT (LIST CHARDELETE.TTC CHARDELETE.TTC CHARDELETE.FORWARD.TTC DELETE.TTC
|
||||
UNDO.TTC NEXT.TTC CMD.TTC REDO.TTC))
|
||||
do (* ;
|
||||
"Set up the default syntax classes for command characters")
|
||||
(\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH CL))
|
||||
(for CH in (CHARCODE (^X)) as FN in '(\TEDIT.ABBREV.EXPAND)
|
||||
do (* ;
|
||||
"Set up the default function-calling characters (^X to expand abbrevs for now)")
|
||||
(TEDIT.SETFUNCTION CH FN RTBL))
|
||||
(TEDIT.SETFUNCTION (CHARCODE ^O)
|
||||
(FUNCTION GET.OBJ.FROM.USER)
|
||||
RTBL) (* ; "And for image object capture")
|
||||
RTBL])
|
||||
|
||||
(\TEDIT.WORDBOUND.READTABLE
|
||||
[LAMBDA NIL (* ; "Edited 22-May-92 15:10 by jds")
|
||||
|
||||
(* ;; "Create a readtable which will let TEdit find word boundaries. A word boundary is any point where the SYNCODE of the adjacent characters is different")
|
||||
|
||||
(PROG [(RTBL (create READTABLEP
|
||||
READMACRODEFS _ (HARRAY 50]
|
||||
(for CH from 0 to 255 do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH PUNCT.TTC))
|
||||
|
||||
(* ;; "By default, every character except those noted below is a punctuation character")
|
||||
|
||||
(for CH from (CHARCODE A) to (CHARCODE Z) do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(* ; "Upper case alpha")
|
||||
(for CH from (CHARCODE a) to (CHARCODE z) do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(* ; "Lower case alpha")
|
||||
(for CH from (CHARCODE 0) to (CHARCODE 9) do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(* ; "And digits are text characters")
|
||||
|
||||
(* ;; "European chars and accents are text characters:")
|
||||
|
||||
(for CH from (CHARCODE "361,41") to (CHARCODE "361,376")
|
||||
do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(for CH from (CHARCODE "0,301") to (CHARCODE "0,317")
|
||||
do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(for CH from (CHARCODE "0,341") to (CHARCODE "0,376")
|
||||
do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(for CH in (CHARCODE (CR SPACE TAB ^L)) do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH WHITESPACE.TTC))
|
||||
(* ; "And these are white space")
|
||||
(for CH in (LIST MSPACE NSPACE THINSPACE FIGSPACE)
|
||||
do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(RETURN RTBL])
|
||||
|
||||
(TEDIT.GETSYNTAX
|
||||
[LAMBDA (CH TABLE) (* ; "Edited 24-Dec-2023 09:47 by rmk")
|
||||
(* ; "Edited 31-Mar-87 10:01 by jds")
|
||||
(* ;
|
||||
"Find TEdit's interpretation of a given character")
|
||||
(SELECTC (\SYNCODE [fetch READSA of (COND
|
||||
((type? TEXTOBJ TABLE)
|
||||
(* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(OR (fetch (TEXTOBJ TXTRTBL) of TABLE)
|
||||
TEDIT.READTABLE))
|
||||
((type? STREAM TABLE)
|
||||
(* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM
|
||||
TEXTOBJ)
|
||||
of TABLE))
|
||||
TEDIT.READTABLE))
|
||||
(T (OR TABLE TEDIT.READTABLE]
|
||||
(COND
|
||||
((LITATOM CH) (* ;
|
||||
"Symbols are converted to numeric charcodes")
|
||||
(APPLY* 'CHARCODE CH))
|
||||
((STRINGP CH) (* ; "As are string char-names")
|
||||
(APPLY* 'CHARCODE CH))
|
||||
(T CH)))
|
||||
(WORDDELETE.TTC
|
||||
'WORDDELETE)
|
||||
(WORDDELETE.FORWARD.TTC
|
||||
'WORDDELETE.FORWARD)
|
||||
(CHARDELETE.TTC
|
||||
'CHARDELETE)
|
||||
(CHARDELETE.FORWARD.TTC
|
||||
'CHARDELETE.FORWARD)
|
||||
(DELETE.TTC 'DELETE)
|
||||
(UNDO.TTC 'UNDO)
|
||||
(REDO.TTC 'REDO)
|
||||
(FUNCTIONCALL.TTC
|
||||
'FN)
|
||||
(CMD.TTC 'CMD)
|
||||
(NEXT.TTC 'NEXT)
|
||||
(EXPAND.TTC 'EXPAND)
|
||||
NIL])
|
||||
|
||||
(TEDIT.SETSYNTAX
|
||||
[LAMBDA (CHAR CLASS TABLE) (* ; "Edited 24-Dec-2023 09:17 by rmk")
|
||||
(* ; "Edited 31-Mar-87 10:00 by jds")
|
||||
(* ;
|
||||
"SETS TEDIT-STYLE SYNTAX BITS IN A TERMTABLE")
|
||||
(PROG1 (TEDIT.GETSYNTAX (SETQ CHAR (COND
|
||||
((LITATOM CHAR)
|
||||
(APPLY* 'CHARCODE CHAR))
|
||||
((STRINGP CHAR)
|
||||
(APPLY* 'CHARCODE CHAR))
|
||||
(T CHAR)))
|
||||
TABLE)
|
||||
(\SETSYNCODE [fetch READSA of (COND
|
||||
((type? TEXTOBJ TABLE)
|
||||
(* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(OR (fetch (TEXTOBJ TXTRTBL) of TABLE)
|
||||
TEDIT.READTABLE))
|
||||
((type? STREAM TABLE)
|
||||
(* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of TABLE))
|
||||
TEDIT.READTABLE))
|
||||
(T (OR TABLE TEDIT.READTABLE]
|
||||
CHAR
|
||||
(SELECTQ CLASS
|
||||
(CHARDELETE CHARDELETE.TTC)
|
||||
(CHARDELETE.FORWARD
|
||||
CHARDELETE.FORWARD.TTC)
|
||||
(WORDDELETE WORDDELETE.TTC)
|
||||
(WORDDELETE.FORWARD
|
||||
WORDDELETE.FORWARD.TTC)
|
||||
((DELETE LINEDELETE)
|
||||
DELETE.TTC)
|
||||
(UNDO UNDO.TTC)
|
||||
(REDO REDO.TTC)
|
||||
(CMD CMD.TTC)
|
||||
(FN FUNCTIONCALL.TTC)
|
||||
(NEXT NEXT.TTC)
|
||||
(EXPAND EXPAND.TTC)
|
||||
NONE.TTC)))])
|
||||
|
||||
(TEDIT.GETFUNCTION
|
||||
[LAMBDA (CHARCODE TABLE) (* jds "19-Sep-85 17:06")
|
||||
(* Gets the FN that is called when CH
|
||||
is hit inside TEDIT.)
|
||||
[SETQ TABLE (COND
|
||||
((type? TEXTOBJ TABLE)
|
||||
|
||||
(* If given a TEXTOBJ in place of a read table, coerce it to the read table for
|
||||
that edit session)
|
||||
|
||||
(fetch (TEXTOBJ TXTRTBL) of TABLE))
|
||||
((type? STREAM TABLE)
|
||||
|
||||
(* If given a TEXTOBJ in place of a read table, coerce it to the read table for
|
||||
that edit session)
|
||||
|
||||
(fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of TABLE)))
|
||||
(T (OR TABLE TEDIT.READTABLE]
|
||||
(SETQ CHARCODE (COND
|
||||
((LITATOM CHARCODE)
|
||||
(APPLY* 'CHARCODE CHARCODE))
|
||||
(T CHARCODE)))
|
||||
(AND TABLE (type? READTABLEP TABLE)
|
||||
(IEQP FUNCTIONCALL.TTC (\SYNCODE (fetch READSA of TABLE)
|
||||
CHARCODE))
|
||||
(fetch READMACRODEFS of TABLE)
|
||||
(CAR (FETCH MACROFN OF (GETHASH CHARCODE (fetch READMACRODEFS of TABLE])
|
||||
|
||||
(TEDIT.SETFUNCTION
|
||||
[LAMBDA (CHARCODE FN RTBL) (* ; "Edited 31-Mar-87 10:58 by jds")
|
||||
(* ;
|
||||
"Set TEDITs (read) table so that FN is called whenever CHARCODE is typed.")
|
||||
(* ;
|
||||
"If FN is NIL, make the character be normal again.")
|
||||
[SETQ RTBL (COND
|
||||
((type? TEXTOBJ RTBL) (* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(fetch (TEXTOBJ TXTRTBL) of RTBL))
|
||||
((type? STREAM RTBL) (* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of RTBL)))
|
||||
(T (OR RTBL TEDIT.READTABLE]
|
||||
(\SETSYNCODE (fetch READSA of RTBL)
|
||||
(SETQ CHARCODE (COND
|
||||
((LITATOM CHARCODE)
|
||||
(APPLY* 'CHARCODE CHARCODE))
|
||||
((STRINGP CHARCODE)
|
||||
(APPLY* 'CHARCODE CHARCODE))
|
||||
(T CHARCODE)))
|
||||
(COND
|
||||
(FN (* ;
|
||||
"He gave us a function to call. Set up the syntax so it IS called.")
|
||||
FUNCTIONCALL.TTC)
|
||||
(T (* ;
|
||||
"He gave us a function of NIL, meaning 'turn it off' . Cause this character to become normal.")
|
||||
NONE.TTC))) (* ;
|
||||
"Mark the character as invoking a function")
|
||||
(OR (fetch READMACRODEFS of RTBL)
|
||||
(replace READMACRODEFS of RTBL with (HARRAY 50))) (* ;
|
||||
"Make sure there's a hash table to store the function in.")
|
||||
(PUTHASH CHARCODE (CREATE READMACRODEF
|
||||
MACROTYPE _ 'TEDIT
|
||||
MACROFN _ (LIST FN))
|
||||
(fetch READMACRODEFS of RTBL])
|
||||
|
||||
(TEDIT.WORDGET
|
||||
[LAMBDA (CH TABLE) (* jds "27-MAY-83 13:24")
|
||||
(\SYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE))
|
||||
(COND
|
||||
((SMALLP CH))
|
||||
(T (CHCON1 CH])
|
||||
|
||||
(TEDIT.WORDSET
|
||||
[LAMBDA (CHARCODE CLASS TABLE) (* jds " 1-JUN-83 12:23")
|
||||
(* SETS TEDIT-STYLE SYNTAX BITS IN A
|
||||
TERMTABLE)
|
||||
(\SETSYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE))
|
||||
(COND
|
||||
((SMALLP CHARCODE))
|
||||
(T (CHCON1 CHARCODE)))
|
||||
(COND
|
||||
((FIXP CLASS))
|
||||
(T (SELECTQ CLASS
|
||||
(PUNCTUATION PUNCT.TTC)
|
||||
(WHITESPACE WHITESPACE.TTC)
|
||||
(TEXT TEXT.TTC)
|
||||
TEXT.TTC])
|
||||
|
||||
(TEDIT.ATOMBOUND.READTABLE
|
||||
[LAMBDA (READTABLE) (* ; "Edited 25-Dec-2023 13:10 by rmk")
|
||||
(* ; "Edited 5-Dec-2023 23:47 by rmk")
|
||||
|
||||
(* ;; "A wordbound table that approximates the unquoted OTHER characters of Lisp atoms as defined by READTABLE or the current readtable. This is specified as the BOUNDTABLE for Lisp source code edits. Not perfect, but not bad.")
|
||||
|
||||
(* ;; "Could cache this for common readtables (interlisp, commonlisp)")
|
||||
|
||||
(LET ((TABLE (\TEDIT.WORDBOUND.READTABLE))) (* ;
|
||||
"\TEDIT.WORDBOUND.READTABLE creates a new one each time.")
|
||||
(for CODE IN (GETSYNTAX 'OTHER (OR READTABLE *READTABLE*)) do (TEDIT.WORDSET CODE
|
||||
'TEXT TABLE))
|
||||
(for CODE IN (GETSYNTAX 'BREAK (OR READTABLE *READTABLE*)) do (TEDIT.WORDSET CODE
|
||||
'PUNCTUATION TABLE))
|
||||
(TEDIT.WORDSET (CHARCODE %:)
|
||||
'TEXT TABLE)
|
||||
TABLE])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(RPAQ TEDIT.READTABLE (\TEDIT.READTABLE))
|
||||
|
||||
(RPAQ TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE))
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ; "Wheelscroll")
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD FROM LISPUSERS)
|
||||
WHEELSCROLL)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.WHEELSCROLL
|
||||
[LAMBDA NIL (* ; "Edited 2-Oct-2023 23:23 by rmk")
|
||||
|
||||
(* ;; "TEDIT disables interrupts, so it has to deal with wheelscroll behaviors when the caret is in the Tedit window. Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).")
|
||||
|
||||
(* ;; "This localizes the behavior inside Tedit, where we also suppress Tedit from thinking that somehow these characters change the selection highlighting.")
|
||||
|
||||
(for I in WHEELSCROLLINTERRUPTS collect (TEDIT.SETFUNCTION (CAR I)
|
||||
`[LAMBDA NIL
|
||||
(AND WHEELSCROLLENABLED ,(CADR I]
|
||||
TEDIT.READTABLE)
|
||||
(CAR I])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS WHEELSCROLLCHARCODES)
|
||||
)
|
||||
|
||||
(RPAQ WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL))
|
||||
|
||||
|
||||
|
||||
(* ; "Clipboard")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.CLIPBOARD
|
||||
[LAMBDA NIL (* ; "Edited 21-Apr-2024 09:57 by rmk")
|
||||
(* ; "Edited 2-Oct-2023 23:23 by rmk")
|
||||
|
||||
(* ;; "TEDIT disables interrupts, so it has to deal with special interrupt behaviors when the caret is in the Tedit window. This localizes the behavior of WHEELSCROLL and CLIPBOARD inside Tedit.")
|
||||
|
||||
(* ;; "Clipboard paste")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,v")
|
||||
(FUNCTION PASTEFROMCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,V")
|
||||
(FUNCTION PASTEFROMCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Clipboard copy")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,c")
|
||||
(FUNCTION \TEDIT.COPYTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,C")
|
||||
(FUNCTION \TEDIT.COPYTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Clipboard extract")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,X")
|
||||
(FUNCTION \TEDIT.EXTRACTTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,x")
|
||||
(FUNCTION \TEDIT.EXTRACTTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).")
|
||||
|
||||
(for I in WHEELSCROLLINTERRUPTS collect (TEDIT.SETFUNCTION (CAR I)
|
||||
`[LAMBDA NIL
|
||||
(AND WHEELSCROLLENABLED ,(CADR I]
|
||||
TEDIT.READTABLE)
|
||||
(CAR I])
|
||||
|
||||
(\TEDIT.COPYTOCLIPBOARD
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL EXTRACT) (* ; "Edited 21-Apr-2024 11:51 by rmk")
|
||||
(* ; "Edited 2-Apr-2024 17:01 by rmk")
|
||||
(* ; "Edited 18-Apr-2018 00:02 by rmk:")
|
||||
|
||||
(* ;; "If CLIPBOARD is loaded, this copies the characters in the current selection to the clipboard (SEL argument is ignored). .")
|
||||
|
||||
(CL:WHEN (FGETD (FUNCTION PUTCLIPBOARD))
|
||||
(SETQ TSTREAM (TEXTSTREAM (OR TSTREAM (TTY.PROCESS))
|
||||
T))
|
||||
(CL:WHEN TSTREAM
|
||||
(PUTCLIPBOARD TSTREAM (FUNCTION \TEDIT.WRITE.SEL))
|
||||
(CL:WHEN EXTRACT (TEDIT.DELETE TSTREAM))))])
|
||||
|
||||
(\TEDIT.EXTRACTTOCLIPBOARD
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Apr-2024 09:20 by rmk")
|
||||
(\TEDIT.COPYTOCLIPBOARD TSTREAM TEXTOBJ SEL T])
|
||||
|
||||
(\TEDIT.WRITE.SEL
|
||||
[LAMBDA (TSTREAM STREAM) (* ; "Edited 21-Apr-2024 11:55 by rmk")
|
||||
|
||||
(* ;; "Writes the selected characters in TSTREAM to STREAM. ")
|
||||
|
||||
(* ;; "If there are no image objects, this is equivalent to (PRIN3 (TEDIT.SEL.AS.STRING ...)), but that would trip over image objects. Image objects could be skipped, or as here, represented as the OBJECTBYTE or described in some way.")
|
||||
|
||||
(* ;; "For Medley-to-Medley copy/paste we could also create a local tmp stream that shadows the system clipboard, and apply the PUTFN to that stream. Then copy/paste could be used to move image objects around with a single Medley or perhaps across Medley's (if the GETFN is available).")
|
||||
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(SEL (FGETTOBJ TEXTOBJ SEL)))
|
||||
(CL:WHEN (IGREATERP (GETSEL SEL DCH)
|
||||
0)
|
||||
|
||||
(* ;; "This could be run by setting the fileptr and doing BIN's. This way we don't manipulate TSTREAM's file position FWIW.")
|
||||
|
||||
(for I CODE PRE (OBJECTBYTE _ (GETTEXTPROP TEXTOBJ 'OBJECTBYTE))
|
||||
(NOBJECTS _ 0) from (GETSEL SEL CH#) to (SUB1 (GETSEL SEL CHLIM))
|
||||
while (SETQ CODE (TEDIT.NTHCHARCODE TSTREAM I))
|
||||
do (if (CHARCODEP CODE)
|
||||
then (PRINTCCODE CODE STREAM)
|
||||
elseif (IMAGEOBJP CODE)
|
||||
then (add NOBJECTS 1)
|
||||
(if OBJECTBYTE
|
||||
then (PRINTCCODE OBJECTBYTE STREAM)
|
||||
else (PRIN3 "{" STREAM)
|
||||
(PRIN4 (IMAGEOBJPROP CODE 'GETFN)
|
||||
STREAM)
|
||||
(CL:WHEN (SETQ PRE (APPLY* (OR (IMAGEOBJPROP CODE 'PREPRINTFN)
|
||||
(FUNCTION NILL))
|
||||
PRE CODE))
|
||||
(PRIN3 " : " STREAM)
|
||||
(PRIN4 PRE STREAM))
|
||||
(PRIN3 "}" STREAM))
|
||||
else (ERROR "UNRECOGNIZED TEDIT CHARACTER" CODE))
|
||||
finally (CL:WHEN (IGREATERP NOBJECTS 0)
|
||||
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Note: Selection contains " NOBJECTS
|
||||
" image object"
|
||||
(CL:IF (EQ NOBJECTS 1)
|
||||
""
|
||||
"s"))
|
||||
T))))])
|
||||
)
|
||||
(DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQ CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X)))
|
||||
|
||||
|
||||
[CONSTANTS (CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X]
|
||||
)
|
||||
)
|
||||
|
||||
(\TEDIT.CLIPBOARD)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2688 10242 (\TEDIT.COMMAND.LOOP 2698 . 9039) (\TEDIT.COMMAND.FUNCTION? 9041 . 10240)) (
|
||||
10243 19041 (\TEDIT.INTERRUPT.SETUP 10253 . 11900) (\TEDIT.MARKACTIVE 11902 . 12231) (
|
||||
\TEDIT.MARKINACTIVE 12233 . 12449) (\TEDIT.COMMAND.RESET.SETUP 12451 . 19039)))))
|
||||
(FILEMAP (NIL (8312 26570 (\TEDIT.INTERRUPT.SETUP 8322 . 9969) (\TEDIT.MARKACTIVE 9971 . 10300) (
|
||||
\TEDIT.MARKINACTIVE 10302 . 10518) (\TEDIT.COMMAND.LOOP 10520 . 19978) (\TEDIT.COMMAND.RESET.SETUP
|
||||
19980 . 26568)) (26854 42051 (\TEDIT.READTABLE 26864 . 28521) (\TEDIT.WORDBOUND.READTABLE 28523 .
|
||||
31116) (TEDIT.GETSYNTAX 31118 . 33557) (TEDIT.SETSYNTAX 33559 . 36037) (TEDIT.GETFUNCTION 36039 .
|
||||
37399) (TEDIT.SETFUNCTION 37401 . 39840) (TEDIT.WORDGET 39842 . 40103) (TEDIT.WORDSET 40105 . 40802) (
|
||||
TEDIT.ATOMBOUND.READTABLE 40804 . 42049)) (42379 43288 (\TEDIT.WHEELSCROLL 42389 . 43286)) (43441
|
||||
49021 (\TEDIT.CLIPBOARD 43451 . 45206) (\TEDIT.COPYTOCLIPBOARD 45208 . 45988) (
|
||||
\TEDIT.EXTRACTTOCLIPBOARD 45990 . 46185) (\TEDIT.WRITE.SEL 46187 . 49019)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "31-May-2025 10:42:55" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;628 165414
|
||||
(FILECREATED "23-Dec-2024 23:02:54" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;592 159471
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.GET)
|
||||
:CHANGES-TO (FNS TEDIT.PUT TEDIT.PUT.STREAM)
|
||||
|
||||
:PREVIOUS-DATE "30-May-2025 11:21:42" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;627)
|
||||
:PREVIOUS-DATE "16-Dec-2024 11:25:16" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;591)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
||||
@@ -36,8 +36,7 @@
|
||||
|
||||
(P (MOVD? '\TEDIT.GET.TRAILER '\TEDIT.FORMATTEDP1]
|
||||
(FNS \TEDIT.GET.PIECES3 \TEDIT.GET.IDATE3 \TEDIT.MAKE.STRINGPIECE)
|
||||
(FNS \TEDIT.GET.UNFORMATTED.FILE.MCCS \TEDIT.INTERPRET.MCCS.SHIFTS
|
||||
\TEDIT.CONVERT.XCCSTOMCCS)
|
||||
(FNS \TEDIT.GET.UNFORMATTED.FILE.XCCS \TEDIT.INTERPRET.XCCS.SHIFTS)
|
||||
(* ; "XCCS")
|
||||
(FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8)
|
||||
(* ; "UTF-8")
|
||||
@@ -46,7 +45,7 @@
|
||||
(FNS \TEDIT.GET.PARALOOKS.LIST \TEDIT.GET.SINGLE.PARALOOKS)
|
||||
(FNS \TEDIT.GET.OBJECT))
|
||||
(COMS
|
||||
(* ;; "Putting pageframe functions are on TEDIT-PAGE)")
|
||||
(* ;; "Putting (pageframe functions on TEDIT-PAGE)")
|
||||
|
||||
(FNS \TEDIT.PUT.PCTB \TEDIT.PUT.PCTB.PIECEDATA \TEDIT.PUT.TRAILER
|
||||
\TEDIT.PUT.PCTB.MERGEABLE \TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW
|
||||
@@ -56,8 +55,6 @@
|
||||
(FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS))
|
||||
(GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*)
|
||||
(FNS TEDITFROMLISPSOURCE SHELLSCRIPTP TEDITFROMSHELLSCRIPT)
|
||||
(INITVARS (TEDIT.SOURCE.LINELENGTH 110)
|
||||
(TEDIT.SOURCE.NLINES 30))
|
||||
(ADDVARS (TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)
|
||||
(SHELLSCRIPTP TEDITFROMSHELLSCRIPT)))
|
||||
(INITVARS (* ;
|
||||
@@ -120,10 +117,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.GET
|
||||
[LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 19-Apr-2025 10:31 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 14:26 by rmk")
|
||||
(* ; "Edited 14-Mar-2025 11:52 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 16:15 by rmk")
|
||||
[LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 26-Aug-2024 16:15 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 12:13 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 16:30 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:31 by rmk")
|
||||
@@ -157,7 +151,7 @@
|
||||
[SETQ FILE (\TEDIT.MAKEFILENAME (OR FILE (TEDIT.GETINPUT TEXTOBJ "GET from: "
|
||||
(OR (GETTEXTPROP TEXTOBJ
|
||||
'LASTGETFILENAME)
|
||||
(\TEDIT.LIKELY.FILENAME TEXTOBJ]
|
||||
(\TEXTSTREAM.FILENAME TEXTOBJ]
|
||||
(CL:UNLESS FILE
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "No input file--aborted" T T)
|
||||
(RETURN))
|
||||
@@ -184,7 +178,8 @@
|
||||
|
||||
(* ;; "New file is good, clean out the old stuff")
|
||||
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
(\TEDIT.SHOWSEL (TEXTSEL TEXTOBJ)
|
||||
NIL TEXTOBJ)
|
||||
(\TEDIT.TEXTCLOSEF TEXTOBJ) (* ;
|
||||
"Close the old files, still in TXTFILE")
|
||||
|
||||
@@ -192,10 +187,9 @@
|
||||
|
||||
(* ;; "Open a textstream NTSTREAM on the new file, then reconnect its textobj to the old TSTREAM and window")
|
||||
|
||||
(SETQ BEING-EDITED (GETTEXTPROP TEXTOBJ 'BEING-EDITED))
|
||||
(SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ))
|
||||
(SETQ BEING-EDITED (GETTEXTPROP TEXTOBJ 'BEING-EDITED))
|
||||
(CL:WHEN MAINWINDOW
|
||||
(TEDIT.KILL TEXTOBJ)
|
||||
(SETQ TEDITCREATED (WINDOWPROP MAINWINDOW 'TEDITCREATED)))
|
||||
(CL:WHEN UNFORMATTED?
|
||||
(push PROPS 'CLEARGET T))
|
||||
@@ -255,8 +249,7 @@
|
||||
(GDATE IDATE)))])
|
||||
|
||||
(TEDIT.INCLUDE
|
||||
[LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "Edited 8-Feb-2025 20:56 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 20:17 by rmk")
|
||||
[LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "Edited 25-Nov-2024 20:17 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:43 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 12:30 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 22:03 by rmk")
|
||||
@@ -371,7 +364,7 @@
|
||||
[SETQ FTSTREAM (OPENTEXTSTREAM FROMFILE NIL START END
|
||||
`(FONT ,(\TEDIT.GET.INSERT.CHARLOOKS TOOBJ TSEL)
|
||||
PARALOOKS
|
||||
,(GETTOBJ TOOBJ DEFAULTPARALOOKS)
|
||||
,(GETTOBJ TOOBJ FMTSPEC)
|
||||
PLAINTEXT
|
||||
,PLAINTEXT]
|
||||
|
||||
@@ -396,11 +389,7 @@
|
||||
(TEDIT.INCLUDE TSTREAM INFILE START END SAFE T])
|
||||
|
||||
(TEDIT.PUT
|
||||
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT QUIET) (* ; "Edited 25-Apr-2025 23:33 by rmk")
|
||||
(* ; "Edited 22-Apr-2025 15:58 by rmk")
|
||||
(* ; "Edited 14-Mar-2025 11:52 by rmk")
|
||||
(* ; "Edited 22-Feb-2025 15:56 by rmk")
|
||||
(* ; "Edited 23-Dec-2024 23:02 by rmk")
|
||||
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 23-Dec-2024 23:02 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 12:30 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 10:31 by rmk")
|
||||
(* ; "Edited 26-Jun-2024 15:46 by rmk")
|
||||
@@ -461,11 +450,10 @@
|
||||
(SETQ FORCENEW 'DETEMPLATE)))
|
||||
[SETQ FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Put to: "
|
||||
(CL:UNLESS FORCENEW
|
||||
(
|
||||
\TEDIT.LIKELY.FILENAME
|
||||
(\TEXTSTREAM.FILENAME
|
||||
TEXTOBJ UNFORMATTED?
|
||||
])
|
||||
(T (SETQ FILE (\TEDIT.LIKELY.FILENAME TEXTOBJ UNFORMATTED?)))
|
||||
(T (SETQ FILE (\TEXTSTREAM.FILENAME TEXTOBJ UNFORMATTED?)))
|
||||
NIL)
|
||||
(CL:UNLESS FILE (* ; "No file to put to.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "No output file--aborted" T T)
|
||||
@@ -491,10 +479,9 @@
|
||||
'(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
|
||||
[RESETSAVE (\TEDIT.PUTRESET (CONS (THIS.PROCESS)
|
||||
'DON'T]
|
||||
(CL:UNLESS QUIET
|
||||
(SETQ PUTSTRING (CONCAT "Put to " (FULLNAME CHARSTREAM)
|
||||
"..."))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ PUTSTRING T))
|
||||
(SETQ PUTSTRING (CONCAT "Put to " (FULLNAME CHARSTREAM)
|
||||
"..."))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ PUTSTRING T)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -502,7 +489,7 @@
|
||||
|
||||
(* ;; "We don't know how to decide that the user doesn't want to continue editing and therefore doesn't need the pieces to be updated to the new file. The stream itself may be used in the future, even if right now there is no process or window")
|
||||
|
||||
(SETQ CHARSTREAM (TEDIT.PUT.STREAM TSTREAM CHARSTREAM UNFORMATTED? NEWEXTFORMAT T))
|
||||
(SETQ CHARSTREAM (TEDIT.PUT.STREAM TSTREAM CHARSTREAM UNFORMATTED? NIL T))
|
||||
|
||||
(* ;; "The file is written, nothing can be lost. CHARSTREAM isn't closed yet")
|
||||
|
||||
@@ -521,9 +508,8 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(CL:UNLESS QUIET
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
|
||||
T))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
|
||||
T)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -533,7 +519,6 @@
|
||||
|
||||
(TEDIT.PUT.STREAM
|
||||
[LAMBDA (TSTREAM DESTSTREAM UNFORMATTED? EXTERNALFORMAT CONTINUE)
|
||||
(* ; "Edited 30-May-2025 11:21 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 16:26 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:40 by rmk")
|
||||
(* ; "Edited 14-May-2024 17:49 by rmk")
|
||||
@@ -578,7 +563,6 @@
|
||||
(FSETTOBJ TEXTOBJ \XDIRTY NIL)
|
||||
(\TEDIT.UPDATE.TITLE TEXTOBJ DESTSTREAM)
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Put))
|
||||
(PUTTEXTPROP TEXTOBJ 'CLEARGET UNFORMATTED?)
|
||||
DESTSTREAM
|
||||
elseif OPENEDHERE
|
||||
then (OR (CLOSEF? DESTSTREAM)
|
||||
@@ -588,9 +572,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.FOREIGN.FILE
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 8-Feb-2025 20:20 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:10 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
(* ; "Edited 22-Oct-2023 20:40 by rmk")
|
||||
(* ; "Edited 18-Sep-2023 16:40 by rmk")
|
||||
(* ; "Edited 10-Aug-2023 17:26 by rmk")
|
||||
@@ -624,17 +606,15 @@
|
||||
(SETQ FTEXTOBJ (TEXTOBJ FSTREAM))
|
||||
(\TEDIT.INSERTPIECES (\TEDIT.FIRSTPIECE FTEXTOBJ)
|
||||
NIL TTEXTOBJ)
|
||||
(FSETTOBJ TTEXTOBJ SUFFIXPIECE (FGETTOBJ FTEXTOBJ SUFFIXPIECE))
|
||||
(FSETTOBJ TTEXTOBJ LASTPIECE (FGETTOBJ FTEXTOBJ LASTPIECE))
|
||||
(* ; "Last piece have different looks")
|
||||
(FSETTOBJ TTEXTOBJ TXTPAGEFRAMES (FGETTOBJ FTEXTOBJ TXTPAGEFRAMES))
|
||||
(FSETTOBJ TTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ FTEXTOBJ DEFAULTPARALOOKS))
|
||||
(FSETTOBJ TTEXTOBJ FMTSPEC (FGETTOBJ FTEXTOBJ FMTSPEC))
|
||||
(FSETTOBJ TTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ FTEXTOBJ DEFAULTCHARLOOKS)))
|
||||
TSTREAM)])
|
||||
|
||||
(\TEDIT.GET.UNFORMATTED.FILE
|
||||
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 24-Apr-2025 17:21 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
(* ; "Edited 5-Feb-2024 09:26 by rmk")
|
||||
(* ; "Edited 21-Jan-2024 09:42 by rmk")
|
||||
(* ; "Edited 29-Dec-2023 11:52 by rmk")
|
||||
@@ -653,15 +633,14 @@
|
||||
DEFAULTCHARLOOKS DEFAULTPARALOOKS PIECES)
|
||||
(PUTTEXTPROP TEXTOBJ 'CLEARGET T)
|
||||
(SETQ DEFAULTCHARLOOKS (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(SETQ DEFAULTPARALOOKS (GETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(SETQ DEFAULTPARALOOKS (GETTOBJ TEXTOBJ FMTSPEC))
|
||||
(CL:WHEN (AND (EQ FORMAT :STRING)
|
||||
(\IOMODEP STREAM 'OUTPUT T))
|
||||
(SETQ STREAM (COPYFILE STREAM '{NODIRCORE})))
|
||||
[SETQ PIECES
|
||||
(SELECTQ FORMAT
|
||||
((:MCCS :XCCS) (* ; "XCCS is done later")
|
||||
(\TEDIT.GET.UNFORMATTED.FILE.MCCS STREAM START END DEFAULTCHARLOOKS
|
||||
DEFAULTPARALOOKS))
|
||||
(:XCCS (\TEDIT.GET.UNFORMATTED.FILE.XCCS STREAM START END DEFAULTCHARLOOKS
|
||||
DEFAULTPARALOOKS))
|
||||
(:UTF-8 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 STREAM START END DEFAULTCHARLOOKS
|
||||
DEFAULTPARALOOKS))
|
||||
(:STRING (CL:WHEN (\IOMODEP STREAM 'OUTPUT T)
|
||||
@@ -696,9 +675,7 @@
|
||||
(\TEDIT.INSERTPIECES PIECES NIL TEXTOBJ)))])
|
||||
|
||||
(\TEDIT.GET.FORMATTED.FILE
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 28-Mar-2025 14:15 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:19 by rmk")
|
||||
(* ; "Edited 28-Oct-2024 17:48 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 28-Oct-2024 17:48 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:25 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
@@ -732,14 +709,13 @@
|
||||
(\TEDIT.GET.PCTB0 TEXT TSTREAM (CADR PCCOUNT)
|
||||
PCCOUNT START END))
|
||||
(\TEDIT.THELP "File format version incompatible with this version of TEdit."))
|
||||
(CL:WHEN (SETQ PC (\TEDIT.LASTPIECE TEXTOBJ))
|
||||
(CL:WHEN (SETQ PC (PREVPIECE (\TEDIT.LASTPIECE TEXTOBJ)))
|
||||
(FSETPC PC PPARALAST T))
|
||||
(\TEDIT.TRANSLATE.ASCIICHARS TSTREAM NIL)
|
||||
(\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ NIL)
|
||||
TEXTOBJ)])
|
||||
|
||||
(\TEDIT.FORMATTEDSTREAMP
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:17 by rmk")
|
||||
(* ; "Edited 15-Sep-2023 00:09 by rmk")
|
||||
(* ; "Edited 15-Aug-2023 17:35 by rmk")
|
||||
@@ -753,7 +729,7 @@
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(for PC (FORMATLEVEL _ 0)
|
||||
(DEFAULTCLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(DEFAULTPLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(DEFAULTPLOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(TENTATIVE _ (GETTEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) inpieces (\TEDIT.FIRSTPIECE
|
||||
TEXTOBJ)
|
||||
do [COND
|
||||
@@ -914,9 +890,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PIECES3
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END) (* ; "Edited 24-Apr-2025 17:20 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 30-Aug-2024 15:44 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END) (* ; "Edited 30-Aug-2024 15:44 by rmk")
|
||||
(* ; "Edited 11-Jul-2024 13:20 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:37 by rmk")
|
||||
(* ; "Edited 7-Apr-2024 17:20 by rmk")
|
||||
@@ -940,8 +914,7 @@
|
||||
DEFAULTCHARLOOKS
|
||||
))
|
||||
(SETQ OLDPARALOOKS (FGETTOBJ TEXTOBJ
|
||||
DEFAULTPARALOOKS
|
||||
))
|
||||
FMTSPEC))
|
||||
(SETQ FIRSTPC (CREATE PIECE))
|
||||
(* ; "Throw away at the end")
|
||||
(SETQ PREVPC FIRSTPC)
|
||||
@@ -1046,14 +1019,9 @@
|
||||
(change (PPARALOOKS P)
|
||||
(CL:UNLESS (EQ DATUM 0)
|
||||
(* ; " For the last piece?")
|
||||
(ELT PARALOOKSMAP DATUM))))]
|
||||
|
||||
(* ;; "Produce MCCS codes for XCCS files, fix up later")
|
||||
|
||||
(SELECTQ (STREAMPROP TEXT 'FORMAT)
|
||||
((:MCCS :XCCS)
|
||||
(\TEDIT.INTERPRET.MCCS.SHIFTS PC TEXT))
|
||||
NIL)
|
||||
(ELT PARALOOKSMAP DATUM))))]
|
||||
(CL:WHEN (EQ :XCCS (STREAMPROP TEXT 'FORMAT))
|
||||
(\TEDIT.INTERPRET.XCCS.SHIFTS PC TEXT))
|
||||
(RETURN PC])
|
||||
|
||||
(\TEDIT.GET.IDATE3
|
||||
@@ -1114,7 +1082,7 @@
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.UNFORMATTED.FILE.MCCS
|
||||
(\TEDIT.GET.UNFORMATTED.FILE.XCCS
|
||||
[LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 21-Jan-2024 09:40 by rmk")
|
||||
(* ; "Edited 12-Jan-2024 13:13 by rmk")
|
||||
(* ; "Edited 10-Jan-2024 11:19 by rmk")
|
||||
@@ -1217,7 +1185,7 @@
|
||||
(CL:WHEN (SETQ CRBEFORE (EQ CHAR (CHARCODE CR)))
|
||||
(SETQ EOLC CR.EOLC])
|
||||
|
||||
(\TEDIT.INTERPRET.MCCS.SHIFTS
|
||||
(\TEDIT.INTERPRET.XCCS.SHIFTS
|
||||
[LAMBDA (PIECES PFILE) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 14-May-2024 18:39 by rmk")
|
||||
(* ; "Edited 21-Jan-2024 00:02 by rmk")
|
||||
@@ -1306,20 +1274,6 @@
|
||||
(replace (STREAM EOLCONVENTION)
|
||||
of PFILE with EOLC)))
|
||||
PIECES])
|
||||
|
||||
(\TEDIT.CONVERT.XCCSTOMCCS
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 24-Apr-2025 17:10 by rmk")
|
||||
|
||||
(* ;; "Brute force way of converting a known-to-be MCCS stream into an XCCS stream")
|
||||
(* ;
|
||||
"Don't accumulate history during this transformation;")
|
||||
(RESETLST
|
||||
[RESETSAVE (TEXTPROP TSTREAM 'HISTORY 'OFF)
|
||||
`(PROGN (TEXTPROP ,TSTREAM 'HISTORY OLDVALUE]
|
||||
(for CHNO CHAR from 1 to (TEDIT.NCHARS TSTREAM) when (SMALLP (SETQ CHAR (TEDIT.NTHCHARCODE
|
||||
TSTREAM CHNO)))
|
||||
unless (EQ CHAR (SETQ CHAR (MTOXCODE CHAR))) do (\TEDIT.RPLCHARCODE TSTREAM CHNO CHAR NIL
|
||||
T)))])
|
||||
)
|
||||
|
||||
|
||||
@@ -1445,15 +1399,15 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS FILE TEXTOBJ])
|
||||
|
||||
(\TEDIT.GET.SINGLE.CHARLOOKS
|
||||
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 22-Apr-2025 15:20 by rmk")
|
||||
(* ; "Edited 2-Jan-2025 11:08 by rmk")
|
||||
(* ; "Edited 11-Dec-2024 22:59 by rmk")
|
||||
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 11-Dec-2024 22:59 by rmk")
|
||||
(* ; "Edited 9-Dec-2024 20:11 by rmk")
|
||||
(* ; "Edited 13-Aug-2024 08:49 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 00:04 by rmk")
|
||||
(* ; "Edited 7-Apr-2024 17:21 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 22:46 by rmk")
|
||||
(* ; "Edited 21-Dec-2023 23:54 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 23:21 by rmk")
|
||||
(* ; "Edited 24-Aug-2023 15:05 by rmk")
|
||||
(* ; "Edited 20-Feb-2022 12:42 by larry")
|
||||
(* ; "Edited 30-May-91 20:25 by jds")
|
||||
@@ -1465,28 +1419,21 @@
|
||||
(PROG* ((LOOKS (create CHARLOOKS))
|
||||
(FILEPOS (GETFILEPTR FILE))
|
||||
(LOOKSLEN (\WIN FILE))
|
||||
FONT NAME SIZE SUPER PROPS STYLESTR BOLD ITALIC EXTRAS)
|
||||
FONT NAME FACE SIZE SUPER PROPS STYLESTR)
|
||||
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
|
||||
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
|
||||
(SETQ SUPER (\SMALLPIN FILE)) (* ;
|
||||
"Superscripting distance, could be negative")
|
||||
(FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
|
||||
0))
|
||||
(SETQ EXTRAS (\ARBIN FILE))
|
||||
(if [AND (EQ '\TEDIT.COLOR (CAR (LISTP (CAR (LISTP EXTRAS]
|
||||
then (FSETCLOOKS LOOKS CLCOLOR (CADR (ASSOC '\TEDIT.COLOR EXTRAS)))
|
||||
(* ; "Color tells us it's an alist")
|
||||
(FSETCLOOKS LOOKS CLUSERINFO (CADR (ASSOC '\TEDIT.USERINFO EXTRAS)))
|
||||
else (* ; "Pre color, create installed BLACK")
|
||||
(FSETCLOOKS LOOKS CLCOLOR 'BLACK)
|
||||
(FSETCLOOKS LOOKS CLUSERINFO EXTRAS))
|
||||
(SETQ PROPS (\WIN FILE)) (* ; "All the bits")
|
||||
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
|
||||
(FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE))
|
||||
(SETQ PROPS (\WIN FILE))
|
||||
(with CHARLOOKS LOOKS [SETQ CLSELBEFORE (NOT (ZEROP (LOGAND 8192 PROPS]
|
||||
[SETQ CLUNBREAKABLE (NOT (ZEROP (LOGAND 4096 PROPS]
|
||||
[SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS]
|
||||
[SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS]
|
||||
[SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
|
||||
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
|
||||
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
|
||||
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
|
||||
@@ -1495,24 +1442,31 @@
|
||||
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
|
||||
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
|
||||
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
|
||||
(SETQ CLSIZE SIZE)
|
||||
(SETQ CLOFFSET SUPER))
|
||||
[if (LISTP NAME)
|
||||
then (* ;
|
||||
(SETQ FACE (PACK* (CL:IF (FGETCLOOKS LOOKS CLBOLD)
|
||||
'B
|
||||
'M)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLITAL)
|
||||
'I
|
||||
'R)
|
||||
'R))
|
||||
(SETQ FONT (if (LISTP NAME)
|
||||
then (* ;
|
||||
"This was a font class. Restore it.")
|
||||
(SETQ FONT (FONTCLASS (pop NAME)
|
||||
NAME)) (* ;
|
||||
"But don't maintain original names, for equality testing")
|
||||
(replace (FONTCLASS FONTCLASSNAME) of FONT with 'TEDIT-FONTCLASS)
|
||||
(replace (FONTCLASS PRETTYFONT#) of FONT with 0)
|
||||
else (SETQ FONT (FONTCREATE NAME SIZE (PACK* (CL:IF BOLD
|
||||
'B
|
||||
'M)
|
||||
(CL:IF ITALIC
|
||||
'I
|
||||
'R)
|
||||
'R]
|
||||
(FONTCLASS (pop NAME)
|
||||
NAME)
|
||||
else (FONTCREATE NAME SIZE FACE)))
|
||||
(FSETCLOOKS LOOKS CLNAME (if (type? FONTCLASS FONT)
|
||||
then
|
||||
(* ;;
|
||||
"Put the display family in the CLNAME spot. Better than NIL.")
|
||||
|
||||
(CL:WHEN [SETQ NAME (FONTCOPY FONT
|
||||
'(DEVICE DISPLAY NOERROR T]
|
||||
(FONTPROP NAME 'FAMILY))
|
||||
else NAME))
|
||||
(FSETCLOOKS LOOKS CLFONT FONT)
|
||||
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
|
||||
(SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN))
|
||||
(RETURN LOOKS])
|
||||
|
||||
@@ -1582,9 +1536,7 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS FILE TEXTOBJ])
|
||||
|
||||
(\TEDIT.GET.SINGLE.PARALOOKS
|
||||
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 19-Feb-2025 12:10 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:04 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 23:55 by rmk")
|
||||
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 22-Nov-2024 23:55 by rmk")
|
||||
(* ; "Edited 23-Oct-2024 16:03 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:47 by rmk")
|
||||
@@ -1599,31 +1551,31 @@
|
||||
"Edited 2-Jul-93 21:31 by sybalskY:MV:ENVOS")
|
||||
(* ;
|
||||
"Read a paragraph format spec from the FILE, and return it for later use.")
|
||||
(LET ((PARALOOKS (create PARALOOKS))
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
(FILEPOS (GETFILEPTR FILE))
|
||||
(LOOKSLEN (\WIN FILE))
|
||||
TABFLG DEFTAB TABS)
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP "UNRECOGNIZED QUAD BYTE")))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP "UNRECOGNIZED QUAD BYTE")))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(CL:WHEN (ILEQ DEFTAB 1) (* ;
|
||||
"0/1 don't make sense, seemed to code default")
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
@@ -1637,42 +1589,41 @@
|
||||
(6 'DOTTEDCENTERED)
|
||||
(7 'DOTTEDDECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPLOOKS PARALOOKS FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEAFTER (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTHEADINGKEEP (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTKEEP (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTHEADINGKEEP (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTKEEP (\ARBIN FILE))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPLOOKS PARALOOKS FMTBASETOBASE (\ARBIN FILE)))
|
||||
(FSETPARA FMT FMTBASETOBASE (\ARBIN FILE)))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPLOOKS PARALOOKS FMTREVISED (\ARBIN FILE)))
|
||||
(FSETPARA FMT FMTREVISED (\ARBIN FILE)))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPLOOKS PARALOOKS FMTCOLUMN (\ARBIN FILE)))
|
||||
(FSETPARA FMT FMTCOLUMN (\ARBIN FILE)))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))))
|
||||
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN)) (* ;
|
||||
"There is more PARALOOKS info in this piece -- we probably lost data.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Newer file version; you lost PARALOOKS info" T)
|
||||
(SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN)))
|
||||
PARALOOKS])
|
||||
FMT])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1728,13 +1679,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "Putting pageframe functions are on TEDIT-PAGE)")
|
||||
(* ;; "Putting (pageframe functions on TEDIT-PAGE)")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.PUT.PCTB
|
||||
[LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE)
|
||||
(* ; "Edited 26-Apr-2025 00:11 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 15-May-2024 17:03 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 12:40 by rmk")
|
||||
@@ -1821,9 +1771,9 @@
|
||||
(PPARALAST (PREVPIECE PC)))
|
||||
(\TEDIT.PUT.PARALOOKS FORMATSTREAM PC PARAHASH)
|
||||
(add PCCOUNT 1))
|
||||
(CL:WHEN (MEMB EXTFORMAT '(:MCCS :XCCS))
|
||||
(CL:WHEN (EQ EXTFORMAT :XCCS)
|
||||
|
||||
(* ;; "For MCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file. TEDIT.GET calls \TEDIT.INTERPRET.XCCS.SHIFTS to shave those bytes. NSHIFTBYTES is used here if the edit will continue.")
|
||||
(* ;; "For XCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file. TEDIT.GET calls \TEDIT.INTERPRET.XCCS.SHIFTS to shave those bytes. NSHIFTBYTES is used here if the edit will continue.")
|
||||
|
||||
(CHARSET CHARSTREAM (CL:IF (MEMB (PTYPE PC)
|
||||
FAT.PTYPES)
|
||||
@@ -1933,9 +1883,7 @@
|
||||
(\WOUT FORMATSTREAM (IPLUS 31415 VERSION])
|
||||
|
||||
(\TEDIT.PUT.PCTB.MERGEABLE
|
||||
[LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ) (* ; "Edited 25-Apr-2025 23:50 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 16:02 by rmk")
|
||||
(* ; "Edited 14-May-2024 11:55 by rmk")
|
||||
[LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ) (* ; "Edited 14-May-2024 11:55 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:57 by rmk")
|
||||
(* ; "Edited 23-Jan-2024 09:12 by rmk")
|
||||
(* ; "Edited 12-Jan-2024 09:46 by rmk")
|
||||
@@ -1960,11 +1908,11 @@
|
||||
(* ;; "PC cannot merge with PREVPC if PREVPC ends in EOL (even if not PPARALAST). (We assume here that EOL's of interest appear only in last-of-piece position.) For some input piece types we can make the decision without bothering to look at their last character. If the destination EXTFORMAT is :UTF-8, the splitter has presumably arranged it so that EOL's only appear in thin string and file pieces.")
|
||||
|
||||
[AND (SELECTQ EXTFORMAT
|
||||
((:MCCS :XCCS)
|
||||
(* ;; "All thin strings and files are mergeable, all fat pieces are mergeable, since they all go to FAT2. ")
|
||||
(:XCCS
|
||||
(* ;; "All thin strings and files are mergeable, all fat pieces are mergeable, since they all go to FAT2. ")
|
||||
|
||||
(EQ (THINPIECEP PREVPC)
|
||||
(THINPIECEP PC)))
|
||||
(EQ (THINPIECEP PREVPC)
|
||||
(THINPIECEP PC)))
|
||||
(:UTF-8
|
||||
|
||||
(* ;; "UTF8 pieces with the same bytesperchar are mergeable. We rely on \TEDIT.PUT.UTF8.SPLITPIECES to examine string pieces and split thin strings that include mixtures of Ascii and non-Ascii characters, and to split fat pieces that may contain Ascii character in 2-byte form. After splitting, all pieces with the same PUTF8BYTESPERCHAR can be merged.")
|
||||
@@ -1977,12 +1925,11 @@
|
||||
(NEQ 0 (PCHARSET PREVPC)))
|
||||
[AND (EQ EXTFORMAT :UTF-8)
|
||||
(NOT (MEMB PREVTYPE (CONSTANT (LIST THINFILE.PTYPE THINSTRING.PTYPE]
|
||||
(NOT (MEMB (\TEDIT.PIECE.NTHCHARCODE PREVPC (SUB1 (PLEN PREVPC)))
|
||||
(NOT (MEMB (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PREVPC (SUB1 (PLEN PREVPC)))
|
||||
(CHARCODE (EOL LF])])])
|
||||
|
||||
(\TEDIT.PUT.UTF8.SPLITPIECES
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 19-Jan-2025 15:02 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:14 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 17-Mar-2024 00:14 by rmk")
|
||||
(* ; "Edited 3-Feb-2024 14:52 by rmk")
|
||||
(* ; "Edited 11-Jan-2024 23:29 by rmk")
|
||||
(* ; "Edited 5-Jan-2024 11:37 by rmk")
|
||||
@@ -1999,11 +1946,13 @@
|
||||
(* ;; "If BPC changes, split off and mark the prefix piece with the previous value, go back to the main loop to continue on the residual suffix piece.")
|
||||
|
||||
(if (EQ I 1)
|
||||
then (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
||||
then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH
|
||||
*XCCSTOUNICODE*)))
|
||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
||||
(* ;
|
||||
"The first character defines the piece")
|
||||
elseif (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
||||
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH
|
||||
*XCCSTOUNICODE*)))
|
||||
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
||||
TEXTOBJ)
|
||||
(SETQ PC (PREVPIECE PC))
|
||||
@@ -2019,9 +1968,11 @@
|
||||
(for I BPC (PFILE _ (PCONTENTS PC)) from 1 to (PLEN PC)
|
||||
first (\SETFILEPTR PFILE (PFPOS PC))
|
||||
do (if (EQ I 1)
|
||||
then [SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
|
||||
then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE)
|
||||
*XCCSTOUNICODE*)))
|
||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
||||
elseif [EQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
|
||||
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE)
|
||||
*XCCSTOUNICODE*)))
|
||||
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
||||
TEXTOBJ)
|
||||
(SETQ PC (PREVPIECE PC))
|
||||
@@ -2036,9 +1987,10 @@
|
||||
8)
|
||||
(BIN PFILE)))
|
||||
(if (EQ I 1)
|
||||
then (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
||||
then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*))
|
||||
)
|
||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
||||
elseif (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
||||
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*)))
|
||||
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
||||
TEXTOBJ)
|
||||
(SETQ PC (PREVPIECE PC))
|
||||
@@ -2048,8 +2000,6 @@
|
||||
|
||||
(\TEDIT.PUT.PCTB.NEXTNEW
|
||||
[LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)
|
||||
(* ; "Edited 25-Apr-2025 08:48 by rmk")
|
||||
(* ; "Edited 26-Mar-2025 09:27 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 14-May-2024 18:54 by rmk")
|
||||
(* ; "Edited 13-May-2024 08:27 by rmk")
|
||||
@@ -2064,7 +2014,7 @@
|
||||
|
||||
(* ;; "Note that the PCONTENTS (= PFILE) field for these file pieces isn't filled in, that has to be done after CHARSTREAM is closed and reopened at the TEDIT.PUT level. For the same reason, PBINABLE isn't set here.")
|
||||
|
||||
(* ;; "NSHIFTBYTES strips any MCCS/XCCS charset shifts at the beginning of the new piece.")
|
||||
(* ;; "NSHIFTBYTES strips any XCCS charset shifts at the beginning of the new piece.")
|
||||
|
||||
(SETQ RUNLEN (IDIFFERENCE RUNLEN NSHIFTBYTES))
|
||||
(FSETPC NEXTNEW NEXTPIECE (SETQ NEXTNEW (create PIECE
|
||||
@@ -2076,18 +2026,18 @@
|
||||
THINFILE.PTYPE
|
||||
UTF8.PTYPE))
|
||||
(FSETPC NEXTNEW PBYTESPERCHAR (FGETPC PC PUTF8BYTESPERCHAR)))
|
||||
((:MCCS :XCCS) (* ;
|
||||
(:XCCS (* ;
|
||||
"String pieces can be merged with corresponding file pieces")
|
||||
(FSETPC NEXTNEW PTYPE (SELECTC (PTYPE PC)
|
||||
(THINSTRING.PTYPE
|
||||
THINFILE.PTYPE)
|
||||
((LIST FATSTRING.PTYPE FATFILE1.PTYPE)
|
||||
(FSETPC NEXTNEW PTYPE (SELECTC (PTYPE PC)
|
||||
(THINSTRING.PTYPE
|
||||
THINFILE.PTYPE)
|
||||
((LIST FATSTRING.PTYPE FATFILE1.PTYPE)
|
||||
(FSETPC NEXTNEW PBYTESPERCHAR 2)
|
||||
(FSETPC NEXTNEW PCHARSET \NORUNCODE)
|
||||
FATFILE2.PTYPE)
|
||||
(PTYPE PC))))
|
||||
(\TEDIT.THELP "EXTERNAL FORMAT NOT RECOGNIZED" EXTFORMAT))
|
||||
(* ;
|
||||
"PCHARSET is not relevant for FILEFILE2")
|
||||
(FSETPC NEXTNEW PBYTESPERCHAR 2)
|
||||
FATFILE2.PTYPE)
|
||||
(PTYPE PC))))
|
||||
NIL) (* ;
|
||||
"Accumulate PLEN across merged pieces. Objects are always 1.")
|
||||
[FSETPC NEXTNEW PLEN (CL:IF (EQ OBJECT.PTYPE (PTYPE NEXTNEW))
|
||||
1
|
||||
@@ -2096,7 +2046,7 @@
|
||||
"The file may have LF, but we want to restore EOL internally")
|
||||
(CL:WHEN [AND (EQ THINFILE.PTYPE (PTYPE NEXTNEW))
|
||||
(EQ (CHARCODE EOL)
|
||||
(\TEDIT.PIECE.NTHCHARCODE PC (PLEN PC]
|
||||
(\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC (PLEN PC]
|
||||
(if (EQ 1 (PLEN NEXTNEW))
|
||||
then (FSETPC NEXTNEW PTYPE THINSTRING.PTYPE)
|
||||
(FSETPC NEXTNEW PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL)))
|
||||
@@ -2224,11 +2174,10 @@
|
||||
(PUTHASH LOOKS I LOOKSHASH])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.CHARLOOKS
|
||||
[LAMBDA (FORMATSTREAM LOOKS) (* ; "Edited 22-Apr-2025 14:50 by rmk")
|
||||
(* ; "Edited 2-Jan-2025 10:43 by rmk")
|
||||
(* ; "Edited 13-Aug-2024 08:47 by rmk")
|
||||
[LAMBDA (FORMATSTREAM LOOKS) (* ; "Edited 13-Aug-2024 08:47 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 23:07 by rmk")
|
||||
(* ; "Edited 21-Dec-2023 23:54 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:14 by rmk")
|
||||
(* ; "Edited 26-Aug-2023 11:29 by rmk")
|
||||
(* ; "Edited 15-Aug-2023 23:17 by rmk")
|
||||
@@ -2237,73 +2186,70 @@
|
||||
(* ;; "Put out a single CHARLOOKS description.")
|
||||
|
||||
(LET ((FILEPOS (GETFILEPTR FORMATSTREAM))
|
||||
(FONT (FGETCLOOKS LOOKS CLFONT))
|
||||
(FONT (fetch (CHARLOOKS CLFONT) of LOOKS))
|
||||
LEN)
|
||||
(\WOUT FORMATSTREAM 0) (* ;
|
||||
"Reserve space for the length of this looks")
|
||||
[if (type? FONTCLASS FONT)
|
||||
then (* ;
|
||||
[COND
|
||||
((type? FONTCLASS FONT) (* ;
|
||||
"For font classes, we need to save a list of device-FD sets")
|
||||
(\ARBOUT FORMATSTREAM (FONTCLASSUNPARSE FONT))
|
||||
else (* ;
|
||||
(\ARBOUT FORMATSTREAM (FONTCLASSUNPARSE FONT)))
|
||||
(T (* ;
|
||||
"For FONTDESCRIPTORs, do it the easy way")
|
||||
(\ATMOUT FORMATSTREAM (FONTPROP FONT 'FAMILY](* ; "The font family")
|
||||
(\ATMOUT FORMATSTREAM (FONTPROP FONT 'FAMILY] (* ; "The font family")
|
||||
(\WOUT FORMATSTREAM (OR (FONTPROP FONT 'SIZE)
|
||||
0)) (* ; "Size of the type, in points")
|
||||
(\SMALLPOUT FORMATSTREAM (OR (FGETCLOOKS LOOKS CLOFFSET)
|
||||
(\SMALLPOUT FORMATSTREAM (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS)
|
||||
0)) (* ; "Super/subscripting distance")
|
||||
(if [AND (FGETCLOOKS LOOKS CLSTYLE)
|
||||
(NOT (ZEROP (FGETCLOOKS LOOKS CLSTYLE]
|
||||
then (\ARBOUT FORMATSTREAM (FGETCLOOKS LOOKS CLSTYLE))
|
||||
else (\WOUT FORMATSTREAM 0))
|
||||
|
||||
(* ;; "Make an ALIST, headed by \TEDIT.COLOR, for future expansion")
|
||||
|
||||
[\ARBOUT FORMATSTREAM (CONS (LIST '\TEDIT.COLOR (OR (FGETCLOOKS LOOKS CLCOLOR)
|
||||
'BLACK))
|
||||
(CL:IF (FGETCLOOKS LOOKS CLUSERINFO)
|
||||
(CONS (LIST '\TEDIT.USERINFO (FGETCLOOKS LOOKS CLUSERINFO))))
|
||||
]
|
||||
(\WOUT FORMATSTREAM (LOGOR (CL:IF (FGETCLOOKS LOOKS CLSELBEFORE)
|
||||
(COND
|
||||
([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS)
|
||||
(NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS]
|
||||
(\ARBOUT FORMATSTREAM (fetch (CHARLOOKS CLSTYLE) of LOOKS)))
|
||||
(T (\WOUT FORMATSTREAM 0)))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLUSERINFO) of LOOKS)
|
||||
(\ARBOUT FORMATSTREAM (fetch (CHARLOOKS CLUSERINFO) of LOOKS)))
|
||||
(T (\WOUT FORMATSTREAM 0)))
|
||||
(\WOUT FORMATSTREAM (LOGOR (CL:IF (fetch (CHARLOOKS CLSELBEFORE) of LOOKS)
|
||||
8192
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLUNBREAKABLE LOOKS)
|
||||
(CL:IF (fetch (CHARLOOKS CLUNBREAKABLE) of LOOKS)
|
||||
4096
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLLEADER)
|
||||
(CL:IF (fetch (CHARLOOKS CLLEADER) of LOOKS)
|
||||
2048
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLINVERTED)
|
||||
(CL:IF (fetch (CHARLOOKS CLINVERTED) of LOOKS)
|
||||
1024
|
||||
0)
|
||||
(CL:IF (EQ 'BOLD (FONTPROP FONT 'WEIGHT))
|
||||
(CL:IF (fetch (CHARLOOKS CLBOLD) of LOOKS)
|
||||
512
|
||||
0)
|
||||
(CL:IF (EQ 'ITALIC (FONTPROP FONT 'SLOPE))
|
||||
(CL:IF (fetch (CHARLOOKS CLITAL) of LOOKS)
|
||||
256
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLULINE)
|
||||
(CL:IF (fetch (CHARLOOKS CLULINE) of LOOKS)
|
||||
128
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLOLINE)
|
||||
(CL:IF (fetch (CHARLOOKS CLOLINE) of LOOKS)
|
||||
64
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLSTRIKE)
|
||||
(CL:IF (fetch (CHARLOOKS CLSTRIKE) of LOOKS)
|
||||
32
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLSMALLCAP)
|
||||
(CL:IF (fetch (CHARLOOKS CLSMALLCAP) of LOOKS)
|
||||
16
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLPROTECTED)
|
||||
(CL:IF (fetch (CHARLOOKS CLPROTECTED) of LOOKS)
|
||||
8
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLINVISIBLE)
|
||||
(CL:IF (fetch (CHARLOOKS CLINVISIBLE) of LOOKS)
|
||||
4
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLSELAFTER)
|
||||
(CL:IF (fetch (CHARLOOKS CLSELAFTER) of LOOKS)
|
||||
2
|
||||
0)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLCANCOPY)
|
||||
(CL:IF (fetch (CHARLOOKS CLCANCOPY) of LOOKS)
|
||||
1
|
||||
0)))
|
||||
|
||||
@@ -2403,8 +2349,7 @@
|
||||
(PUTHASH PL I PARAHASH])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.PARALOOKS
|
||||
[LAMBDA (FONTFILE LOOKS) (* ; "Edited 19-Feb-2025 12:11 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (FONTFILE LOOKS) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:29 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 23:00 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:14 by rmk")
|
||||
@@ -2419,23 +2364,23 @@
|
||||
DEFTAB TABS LEN)
|
||||
(\SMALLPOUT FONTFILE 0) (* ;
|
||||
"Reserve space to store the look length")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS 1STLEFTMAR)) (* ;
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS 1STLEFTMAR)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LEFTMAR)) (* ;
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS LEFTMAR)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LEADAFTER)) (* ; "Lead after the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LINELEAD)) (* ; "inter-line leading")
|
||||
(SETQ DEFTAB (FGETPLOOKS LOOKS FMTDEFAULTTAB))
|
||||
(SETQ TABS (FGETPLOOKS LOOKS FMTTABS))
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS LEADAFTER)) (* ; "Lead after the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS LINELEAD)) (* ; "inter-line leading")
|
||||
(SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB))
|
||||
(SETQ TABS (FGETPARA LOOKS FMTTABS))
|
||||
|
||||
(* ;; "Indicate whether there are tab specs or a default tab setting to save")
|
||||
|
||||
(\BOUT FONTFILE (CL:IF (OR DEFTAB TABS)
|
||||
3
|
||||
2))
|
||||
(\BOUT FONTFILE (SELECTQ (FGETPLOOKS LOOKS QUAD)
|
||||
(\BOUT FONTFILE (SELECTQ (FGETPARA LOOKS QUAD)
|
||||
(LEFT 1)
|
||||
(RIGHT 2)
|
||||
((CENTER CENTERED)
|
||||
@@ -2462,23 +2407,23 @@
|
||||
6)
|
||||
(DOTTEDDECIMAL 7)
|
||||
(\TEDIT.THELP])
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPLOOKS LOOKS FMTSPECIALX)
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPARA LOOKS FMTSPECIALX)
|
||||
0))
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPLOOKS LOOKS FMTSPECIALY)
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPARA LOOKS FMTSPECIALY)
|
||||
0))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTUSERINFO))
|
||||
(\ATMOUT FONTFILE (FGETPLOOKS LOOKS FMTPARATYPE))
|
||||
(\ATMOUT FONTFILE (FGETPLOOKS LOOKS FMTPARASUBTYPE))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTSTYLE))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTNEWPAGEBEFORE))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTNEWPAGEAFTER))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTHEADINGKEEP))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTKEEP))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTBASETOBASE))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTREVISED))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTCOLUMN))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTUSERINFO))
|
||||
(\ATMOUT FONTFILE (FGETPARA LOOKS FMTPARATYPE))
|
||||
(\ATMOUT FONTFILE (FGETPARA LOOKS FMTPARASUBTYPE))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTSTYLE))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTNEWPAGEBEFORE))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTNEWPAGEAFTER))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTHEADINGKEEP))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTKEEP))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTBASETOBASE))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTREVISED))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTCOLUMN))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTCHARSTYLES))
|
||||
|
||||
(* ;;; "Now go fill in the length field at the front of the LOOKS. (ALL looks info should be written out BEFORE this comment.)")
|
||||
|
||||
@@ -2512,11 +2457,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDITFROMLISPSOURCE
|
||||
[LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 7-Apr-2025 23:13 by rmk")
|
||||
(* ; "Edited 1-Apr-2025 12:54 by rmk")
|
||||
(* ; "Edited 26-Mar-2025 10:02 by rmk")
|
||||
(* ; "Edited 18-Feb-2025 23:34 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 10:03 by rmk")
|
||||
[LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 17-Nov-2024 10:03 by rmk")
|
||||
(* ; "Edited 25-Dec-2023 12:28 by rmk")
|
||||
(* ; "Edited 5-Dec-2023 23:46 by rmk")
|
||||
(* ; "Edited 26-Oct-2023 11:22 by rmk")
|
||||
@@ -2530,25 +2471,19 @@
|
||||
|
||||
(* ;; "USERTEMP is the reader environment returned by LISPSOURCEFILEP")
|
||||
|
||||
(DECLARE (USEDFREE TEDIT.SOURCE.LINELENGTH))
|
||||
(CL:UNLESS TSTREAM
|
||||
(SETQ TSTREAM (OPENTEXTSTREAM)))
|
||||
|
||||
(* ;; "Estimate 110 characters per line in the default font?")
|
||||
(* ;; "An empty window for TSTREAM may already be up on the screen. Since this conversion can take awhile, we tell the user what's going on")
|
||||
|
||||
(PUTTEXTPROPS TSTREAM `(PARABREAKCHARS NIL OPENWIDTH ,(TIMES TEDIT.SOURCE.LINELENGTH
|
||||
(CHARWIDTH (CHARCODE SPACE)
|
||||
DEFAULTFONT))
|
||||
OPENHEIGHT
|
||||
,(TIMES TEDIT.SOURCE.NLINES (FONTPROP DEFAULTFONT 'HEIGHT))
|
||||
BOUNDTABLE
|
||||
,(TEDIT.ATOMBOUND.READTABLE (fetch (READER-ENVIRONMENT REREADTABLE)
|
||||
of USERTEMP))
|
||||
DEFAULTPUTEXTENSION ""))
|
||||
(TEXTPROP TSTREAM 'PARABREAKCHARS NIL)
|
||||
(TEXTPROP TSTREAM 'BOUNDTABLE (TEDIT.ATOMBOUND.READTABLE (fetch (READER-ENVIRONMENT REREADTABLE)
|
||||
of USERTEMP)))
|
||||
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Fetching " (FULLNAME SOURCEFILE)
|
||||
" ...")
|
||||
T)
|
||||
(COPY.TEXT.TO.IMAGE SOURCEFILE TSTREAM)
|
||||
(TEXTPROP TSTREAM 'PARABREAKCHARS NIL)
|
||||
TSTREAM])
|
||||
|
||||
(SHELLSCRIPTP
|
||||
@@ -2571,37 +2506,33 @@
|
||||
TSTREAM])
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.SOURCE.LINELENGTH 110)
|
||||
|
||||
(RPAQ? TEDIT.SOURCE.NLINES 30)
|
||||
|
||||
(ADDTOVAR TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)
|
||||
(SHELLSCRIPTP TEDITFROMSHELLSCRIPT))
|
||||
|
||||
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5137 35300 (TEDIT.GET 5147 . 11479) (TEDIT.FORMATTEDFILEP 11481 . 12797) (
|
||||
TEDIT.FILEDATE 12799 . 13970) (TEDIT.INCLUDE 13972 . 22001) (TEDIT.RAW.INCLUDE 22003 . 22811) (
|
||||
TEDIT.PUT 22813 . 31289) (TEDIT.PUT.STREAM 31291 . 35298)) (35301 55377 (\TEDIT.GET.FOREIGN.FILE 35311
|
||||
. 38736) (\TEDIT.GET.UNFORMATTED.FILE 38738 . 42927) (\TEDIT.GET.FORMATTED.FILE 42929 . 45956) (
|
||||
\TEDIT.FORMATTEDSTREAMP 45958 . 48976) (\ARBIN 48978 . 49698) (\ATMIN 49700 . 50237) (\DWIN 50239 .
|
||||
50618) (\STRINGIN 50620 . 51328) (\TEDIT.GET.TRAILER 51330 . 53846) (\TEDIT.CACHEFILE 53848 . 55375))
|
||||
(55543 69604 (\TEDIT.GET.PIECES3 55553 . 66366) (\TEDIT.GET.IDATE3 66368 . 67763) (
|
||||
\TEDIT.MAKE.STRINGPIECE 67765 . 69602)) (69605 82914 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 69615 . 75731)
|
||||
(\TEDIT.INTERPRET.MCCS.SHIFTS 75733 . 81978) (\TEDIT.CONVERT.XCCSTOMCCS 81980 . 82912)) (82936 88958 (
|
||||
\TEDIT.GET.UNFORMATTED.FILE.UTF8 82946 . 88956)) (88981 98110 (\TEDIT.GET.CHARLOOKS.LIST 88991 . 89722
|
||||
) (\TEDIT.GET.SINGLE.CHARLOOKS 89724 . 94922) (\TEDIT.GET.CHARLOOKS 94924 . 96254) (
|
||||
\TEDIT.GET.PARALOOKS.INDEX 96256 . 96800) (\TEDIT.GET.CHARLOOKS.INDEX 96802 . 98108)) (98111 105768 (
|
||||
\TEDIT.GET.PARALOOKS.LIST 98121 . 98743) (\TEDIT.GET.SINGLE.PARALOOKS 98745 . 105766)) (105769 109359
|
||||
(\TEDIT.GET.OBJECT 105779 . 109357)) (109424 141872 (\TEDIT.PUT.PCTB 109434 . 119204) (
|
||||
\TEDIT.PUT.PCTB.PIECEDATA 119206 . 122404) (\TEDIT.PUT.TRAILER 122406 . 123173) (
|
||||
\TEDIT.PUT.PCTB.MERGEABLE 123175 . 126831) (\TEDIT.PUT.UTF8.SPLITPIECES 126833 . 131535) (
|
||||
\TEDIT.PUT.PCTB.NEXTNEW 131537 . 136033) (\TEDIT.INSERT.NEWPIECES 136035 . 139470) (\TEDIT.PUTRESET
|
||||
139472 . 139714) (\ARBOUT 139716 . 140440) (\ATMOUT 140442 . 141047) (\DWOUT 141049 . 141328) (
|
||||
\STRINGOUT 141330 . 141870)) (141873 153943 (\TEDIT.PUT.CHARLOOKS.LIST 141883 . 143555) (
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS 143557 . 149287) (\TEDIT.PUT.CHARLOOKS 149289 . 150514) (
|
||||
\TEDIT.PUT.CHARLOOKS1 150516 . 151567) (\TEDIT.PUT.OBJECT 151569 . 153941)) (153944 161583 (
|
||||
\TEDIT.PUT.PARALOOKS.LIST 153954 . 154856) (\TEDIT.PUT.SINGLE.PARALOOKS 154858 . 160442) (
|
||||
\TEDIT.PUT.PARALOOKS 160444 . 161581)) (161678 165107 (TEDITFROMLISPSOURCE 161688 . 164356) (
|
||||
SHELLSCRIPTP 164358 . 164587) (TEDITFROMSHELLSCRIPT 164589 . 165105)))))
|
||||
(FILEMAP (NIL (5016 33941 (TEDIT.GET 5026 . 11035) (TEDIT.FORMATTEDFILEP 11037 . 12353) (
|
||||
TEDIT.FILEDATE 12355 . 13526) (TEDIT.INCLUDE 13528 . 21439) (TEDIT.RAW.INCLUDE 21441 . 22249) (
|
||||
TEDIT.PUT 22251 . 30106) (TEDIT.PUT.STREAM 30108 . 33939)) (33942 53139 (\TEDIT.GET.FOREIGN.FILE 33952
|
||||
. 37137) (\TEDIT.GET.UNFORMATTED.FILE 37139 . 41013) (\TEDIT.GET.FORMATTED.FILE 41015 . 43836) (
|
||||
\TEDIT.FORMATTEDSTREAMP 43838 . 46738) (\ARBIN 46740 . 47460) (\ATMIN 47462 . 47999) (\DWIN 48001 .
|
||||
48380) (\STRINGIN 48382 . 49090) (\TEDIT.GET.TRAILER 49092 . 51608) (\TEDIT.CACHEFILE 51610 . 53137))
|
||||
(53305 66855 (\TEDIT.GET.PIECES3 53315 . 63617) (\TEDIT.GET.IDATE3 63619 . 65014) (
|
||||
\TEDIT.MAKE.STRINGPIECE 65016 . 66853)) (66856 79231 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 66866 . 72982)
|
||||
(\TEDIT.INTERPRET.XCCS.SHIFTS 72984 . 79229)) (79253 85275 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 79263 .
|
||||
85273)) (85298 93989 (\TEDIT.GET.CHARLOOKS.LIST 85308 . 86039) (\TEDIT.GET.SINGLE.CHARLOOKS 86041 .
|
||||
90801) (\TEDIT.GET.CHARLOOKS 90803 . 92133) (\TEDIT.GET.PARALOOKS.INDEX 92135 . 92679) (
|
||||
\TEDIT.GET.CHARLOOKS.INDEX 92681 . 93987)) (93990 101158 (\TEDIT.GET.PARALOOKS.LIST 94000 . 94622) (
|
||||
\TEDIT.GET.SINGLE.PARALOOKS 94624 . 101156)) (101159 104749 (\TEDIT.GET.OBJECT 101169 . 104747)) (
|
||||
104811 137073 (\TEDIT.PUT.PCTB 104821 . 114471) (\TEDIT.PUT.PCTB.PIECEDATA 114473 . 117671) (
|
||||
\TEDIT.PUT.TRAILER 117673 . 118440) (\TEDIT.PUT.PCTB.MERGEABLE 118442 . 121876) (
|
||||
\TEDIT.PUT.UTF8.SPLITPIECES 121878 . 126965) (\TEDIT.PUT.PCTB.NEXTNEW 126967 . 131234) (
|
||||
\TEDIT.INSERT.NEWPIECES 131236 . 134671) (\TEDIT.PUTRESET 134673 . 134915) (\ARBOUT 134917 . 135641) (
|
||||
\ATMOUT 135643 . 136248) (\DWOUT 136250 . 136529) (\STRINGOUT 136531 . 137071)) (137074 149057 (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST 137084 . 138756) (\TEDIT.PUT.SINGLE.CHARLOOKS 138758 . 144401) (
|
||||
\TEDIT.PUT.CHARLOOKS 144403 . 145628) (\TEDIT.PUT.CHARLOOKS1 145630 . 146681) (\TEDIT.PUT.OBJECT
|
||||
146683 . 149055)) (149058 156552 (\TEDIT.PUT.PARALOOKS.LIST 149068 . 149970) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 149972 . 155411) (\TEDIT.PUT.PARALOOKS 155413 . 156550)) (156647 159241 (
|
||||
TEDITFROMLISPSOURCE 156657 . 158490) (SHELLSCRIPTP 158492 . 158721) (TEDITFROMSHELLSCRIPT 158723 .
|
||||
159239)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Apr-2025 22:42:57" {WMEDLEY}<library>tedit>TEDIT-FIND.;165 43576
|
||||
(FILECREATED " 8-Dec-2024 15:49:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;134 36434
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.SUBSTITUTE)
|
||||
|
||||
:PREVIOUS-DATE "20-Apr-2025 23:44:49" {WMEDLEY}<library>tedit>TEDIT-FIND.;162)
|
||||
:PREVIOUS-DATE "26-Nov-2024 23:53:41" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;132)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FINDCOMS)
|
||||
@@ -14,15 +14,12 @@
|
||||
(RPAQQ TEDIT-FINDCOMS (
|
||||
(* ;; "User entries")
|
||||
|
||||
(FNS TEDIT.FIND TEDIT.FIND.SETSEL TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE
|
||||
TEDIT.NEXT)
|
||||
(FNS TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.BACKWARD)
|
||||
(FNS TEDIT.FIND TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE TEDIT.NEXT)
|
||||
|
||||
(* ;; "Implementation")
|
||||
|
||||
(FNS \TEDIT.FIND \TEDIT.FIND.BACKWARD \TEDIT.WCFIND \TEDIT.BASICFIND
|
||||
\TEDIT.WCFIND.BACKWARD \TEDIT.BASICFIND.BACKWARD
|
||||
\TEDIT.PARSE.SEARCHSTRING)))
|
||||
(FNS \TEDIT.WCFIND \TEDIT.BASICFIND \TEDIT.WCFIND.BACKWARD
|
||||
\TEDIT.BASICFIND.BACKWARD \TEDIT.PARSE.SEARCHSTRING)))
|
||||
|
||||
|
||||
|
||||
@@ -31,51 +28,81 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.FIND
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 14-Mar-2025 23:39 by rmk")
|
||||
(* ; "Edited 11-Mar-2025 12:33 by rmk")
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS?) (* ; "Edited 10-May-2024 21:55 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 23:47 by rmk")
|
||||
(* ; "Edited 19-Jun-2023 22:27 by rmk")
|
||||
(* ; "Edited 6-May-2018 17:34 by rmk:")
|
||||
(* ; "Edited 30-May-91 20:56 by jds")
|
||||
|
||||
(* ;; "This is the documented user interface that does the silly thing with the return value--caller must know whether WILCARD? was true or not.")
|
||||
(* ;; "If WILDCARDS? is NIL then TEDIT.FIND returns just the start of a basic string-match.")
|
||||
|
||||
(LET ((RESULT (\TEDIT.FIND TSTREAM TARGET WILDCARDS? AGAIN START END)))
|
||||
(CL:WHEN RESULT
|
||||
(CL:IF WILDCARDS?
|
||||
RESULT
|
||||
(CAR RESULT)))])
|
||||
(* ;; "Otherwise it returns a list of (MATCHSTART MATCHEND) which is the start and end char positions of the match,")
|
||||
|
||||
(TEDIT.FIND.SETSEL
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS?) (* ; "Edited 11-Mar-2025 15:29 by rmk")
|
||||
(* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?")
|
||||
|
||||
(* ;; "Sets the selection to the result of a successful FIND.")
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
|
||||
(LET ((RESULT (\TEDIT.FIND TSTREAM TARGET WILDCARDS? NIL START END)))
|
||||
(CL:WHEN RESULT
|
||||
(TEDIT.SETSEL TSTREAM (CAR RESULT)
|
||||
(CADR RESULT)
|
||||
'RIGHT)
|
||||
(TEDIT.NORMALIZECARET TSTREAM))])
|
||||
(* ;; "* and # are implicitly quoted if not WILDCARDS? This could be handled simply by calling CONS instead of \TEDIT.PARSE.SEARCHSTRING")
|
||||
|
||||
[if (IMAGEOBJP TARGET)
|
||||
then (TEDIT.FIND.OBJECT TSTREAM TARGET START END)
|
||||
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
|
||||
then (CL:UNLESS END
|
||||
(SETQ END (FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
|
||||
TEXTLEN)))
|
||||
(CL:UNLESS START
|
||||
(SETQ START (TEDIT.GETPOINT TSTREAM)))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND TSTREAM (\TEDIT.PARSE.SEARCHSTRING TARGET)
|
||||
START END)
|
||||
(CAR (\TEDIT.BASICFIND TSTREAM TARGET START END))))])])
|
||||
|
||||
(TEDIT.FIND.BACKWARD
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 11-Mar-2025 15:06 by rmk")
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 19-May-2024 12:07 by rmk")
|
||||
(* ; "Edited 10-May-2024 22:00 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 23:43 by rmk")
|
||||
(* ; "Edited 12-Jul-2023 08:24 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 12:12 by rmk")
|
||||
(* ; "Edited 18-Jun-2023 23:43 by rmk")
|
||||
(* ; "Edited 30-May-91 19:17 by jds")
|
||||
|
||||
(* ;; "This is a new function that preserves the silly interface of TEDIT.FIND--caller must know whether WILCARD? was true or not.")
|
||||
(* ;; "The search is confined to the characters between START and END. It runs backwards from END looking for the nearest match, and returns the character positions of that match.")
|
||||
|
||||
(LET ((RESULT (\TEDIT.FIND.BACKWARD TARGET WILDCARDS? AGAIN START END)))
|
||||
(CL:WHEN RESULT
|
||||
(CL:IF WILDCARDS?
|
||||
RESULT
|
||||
(CAR RESULT)))])
|
||||
(* ;; "If WILDCARDS?, the value is the pair (MATCHSTART MATCHEND) for that match, since the caller doesn't know the length. But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long. This is quirky, but that's the way it is documented.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
[if (IMAGEOBJP TARGET)
|
||||
then (TEDIT.FIND.OBJECT.BACKWARD TSTREAM TARGET START END AGAIN)
|
||||
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
|
||||
then (SETQ START (IMAX 1 (OR START 1)))
|
||||
(SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
|
||||
(FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
|
||||
TEXTLEN)))
|
||||
(CL:WHEN AGAIN
|
||||
|
||||
(* ;;
|
||||
"Assume that we aren't interested in another match at the current position.")
|
||||
|
||||
(ADD END -1))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND.BACKWARD TSTREAM (\TEDIT.PARSE.SEARCHSTRING TARGET T)
|
||||
START END)
|
||||
(CAR (\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START END))))])])
|
||||
|
||||
(TEDIT.SUBSTITUTE
|
||||
[LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM? NEWCHARLOOKS)(* ; "Edited 21-Apr-2025 22:23 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 14:39 by rmk")
|
||||
(* ; "Edited 19-Mar-2025 11:20 by rmk")
|
||||
(* ; "Edited 15-Mar-2025 00:23 by rmk")
|
||||
(* ; "Edited 6-Mar-2025 20:17 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 15:47 by rmk")
|
||||
[LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 8-Dec-2024 15:47 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 23:49 by rmk")
|
||||
(* ; "Edited 15-Aug-2024 09:20 by rmk")
|
||||
(* ; "Edited 14-Jul-2024 00:24 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:46 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 10:49 by rmk")
|
||||
(* ; "Edited 18-May-2024 23:03 by rmk")
|
||||
(* ; "Edited 9-Mar-2024 11:36 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:11 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 14:09 by rmk")
|
||||
(* ; "Edited 6-Jan-2024 11:09 by rmk")
|
||||
(* ; "Edited 12-Nov-2023 12:29 by rmk")
|
||||
@@ -88,18 +115,19 @@
|
||||
|
||||
(CL:UNLESS (\TEDIT.READONLY TSTREAM)
|
||||
(RESETLST
|
||||
(PROG ((TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||
(PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(NREPLACEMENTS 0)
|
||||
(YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
|
||||
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# CONFIRMFLG SEL REPLACE-LEN ACTIONSTRING
|
||||
CHARLOOKS)
|
||||
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN
|
||||
ACTIONSTRING)
|
||||
|
||||
(* ;; "Don't call \TEDIT.GET.TARGET.STRING because it might pick the search-domain (current selection) as the search string. If the search pattern is empty, bail out.")
|
||||
|
||||
(CL:UNLESS SEARCHSTRING
|
||||
[SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
|
||||
(GETTEXTPROP TEXTOBJ
|
||||
'TEDIT.LAST.SUBSTITUTE.STRING])
|
||||
[CL:UNLESS (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
|
||||
(GETTEXTPROP TEXTOBJ
|
||||
'
|
||||
TEDIT.LAST.SUBSTITUTE.STRING
|
||||
]
|
||||
(CL:UNLESS [OR REPLACEMENT (SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ
|
||||
"Replace string:"
|
||||
(GETTEXTPROP TEXTOBJ
|
||||
@@ -109,17 +137,16 @@
|
||||
]
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
|
||||
(RETURN))
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Substitute")
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(if (type? SELPIECES REPLACEMENT)
|
||||
elseif (OR (STRINGP REPLACEMENT)
|
||||
(LITATOM REPLACEMENT))
|
||||
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ))
|
||||
else (RETURN NIL))
|
||||
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ)))
|
||||
|
||||
(* ;; "Could be NIL or empty string, meaning just delete all occurrences.")
|
||||
|
||||
(SETQ REPLACE-LEN (GETSPC REPLACEMENT SPLEN))
|
||||
(SETQ REPLACE-LEN (fetch (SELPIECES SPLEN) of REPLACEMENT))
|
||||
(SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN)
|
||||
"delet"
|
||||
"substitut"))
|
||||
@@ -136,7 +163,8 @@
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T)
|
||||
"ing...")
|
||||
T)
|
||||
(SETQ SEL (FGETTOBJ TEXTOBJ SEL))
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(* ; "Turn off any blue pending delete")
|
||||
|
||||
@@ -146,87 +174,80 @@
|
||||
[SETQ ENDCHAR# (CL:IF (ZEROP (GETSEL SEL DCH))
|
||||
(GETTOBJ TEXTOBJ TEXTLEN)
|
||||
(IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH))))]
|
||||
|
||||
(* ;;
|
||||
"NOTE: SEARCHSTRING may contain wild cards, so the hits may be of different lengths.")
|
||||
|
||||
[if CONFIRMFLG
|
||||
then
|
||||
(* ;; "In this case the selection moves along, ending up at the last hit.")
|
||||
|
||||
(bind HIT (LASTSEL _ (\TEDIT.COPYSEL SEL))
|
||||
while (SETQ HIT (\TEDIT.FIND TEXTOBJ SEARCHSTRING T NIL STARTCHAR#
|
||||
ENDCHAR#))
|
||||
[bind PENDING.SEL CHOICE while (SETQ RANGE (TEDIT.FIND TEXTOBJ
|
||||
SEARCHSTRING STARTCHAR#
|
||||
ENDCHAR# T))
|
||||
do (* ;
|
||||
"Show each substitution site and ask for permission")
|
||||
(\TEDIT.UPDATE.SEL TSTREAM (CAR HIT)
|
||||
(CADR HIT)
|
||||
'RIGHT
|
||||
'PENDINGDEL)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ SEL)
|
||||
[SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ
|
||||
(SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE)
|
||||
(ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE)))
|
||||
'RIGHT T))
|
||||
(\TEDIT.SHOWSEL PENDING.SEL T TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
|
||||
(SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ
|
||||
"OK to replace? ['q' quits]" "Yes")
|
||||
1))
|
||||
(Q (GO $$OUT))
|
||||
(Q (RETURN))
|
||||
(Y (* ; "Do this one")
|
||||
(CL:UNLESS NEWCHARLOOKS
|
||||
(SETQ CHARLOOKS (PCHARLOOKS (\TEDIT.CHTOPC (CAR HIT)
|
||||
TEXTOBJ))))
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
|
||||
'COPY TSTREAM)
|
||||
TSTREAM SEL)
|
||||
(\TEDIT.COPYSEL SEL LASTSEL)
|
||||
(* ; "This may be where we end up")
|
||||
'COPY TEXTOBJ)
|
||||
TEXTOBJ PENDING.SEL)
|
||||
(add NREPLACEMENTS 1)
|
||||
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
|
||||
(SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM))
|
||||
(* ; "Next start, compensate for end")
|
||||
(add ENDCHAR# (IDIFFERENCE REPLACE-LEN (CADR HIT))))
|
||||
[add ENDCHAR# (IDIFFERENCE REPLACE-LEN
|
||||
(ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE])
|
||||
(PROGN
|
||||
(* ;;
|
||||
"Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.")
|
||||
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
(SETQ STARTCHAR# (ADD1 (CAR HIT]
|
||||
finally (\TEDIT.COPYSEL LASTSEL SEL))
|
||||
(\TEDIT.SHOWSEL PENDING.SEL NIL TEXTOBJ)
|
||||
(SETQ STARTCHAR# (ADD1 (CAR RANGE]
|
||||
else
|
||||
(* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events")
|
||||
|
||||
(bind FIRSTHIT HIT HITLAST HITDIFF CHARLOOKS (TOTALDIFF _ 0)
|
||||
EVENTS while (SETQ HIT (\TEDIT.FIND TEXTOBJ SEARCHSTRING T NIL
|
||||
STARTCHAR# ENDCHAR#))
|
||||
(bind FIRSTHIT HITLAST HITLEN HITDIFF (TOTALDIFF _ 0)
|
||||
(SAVESEL _ (\TEDIT.COPYSEL SEL))
|
||||
EVENTS while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR#
|
||||
ENDCHAR# T))
|
||||
do (CL:UNLESS FIRSTHIT (* ; "For final line updating.")
|
||||
(SETQ FIRSTHIT (CAR HIT)))
|
||||
(CL:UNLESS NEWCHARLOOKS
|
||||
(SETQ CHARLOOKS (PCHARLOOKS (\TEDIT.CHTOPC (CAR HIT)
|
||||
TEXTOBJ))))
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR HIT)
|
||||
(CADR HIT)
|
||||
(SETQ FIRSTHIT (CAR RANGE)))
|
||||
[SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE]
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR RANGE)
|
||||
HITLEN
|
||||
'RIGHT)
|
||||
(\TEDIT.FIXSEL SEL TSTREAM)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
|
||||
'COPY TSTREAM NIL CHARLOOKS)
|
||||
TSTREAM SEL)
|
||||
'COPY TEXTOBJ)
|
||||
TEXTOBJ SEL)
|
||||
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(* ;
|
||||
"Collect the events for a single composite")
|
||||
(add NREPLACEMENTS 1)
|
||||
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
|
||||
(SETQ HITLAST STARTCHAR#)
|
||||
(SETQ HITDIFF (IDIFFERENCE REPLACE-LEN (CADR HIT)))
|
||||
(SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN))
|
||||
(add ENDCHAR# HITDIFF)
|
||||
(add TOTALDIFF HITDIFF)
|
||||
finally (CL:UNLESS (EQ NREPLACEMENTS 0)
|
||||
|
||||
(* ;; "At least one replacement, update the lines that have changed. We have to calculate how many of the original characters have %"changed%" by adding the TOTALDIFF to the final position of the last character of the last hit. ")
|
||||
(* ;;
|
||||
"At least one replacement, update the lines that have changed.")
|
||||
|
||||
(\TEDIT.UPDATE.LINES TSTREAM 'INSERTION FIRSTHIT
|
||||
(IDIFFERENCE (IPLUS (FGETSEL SEL CHLIM)
|
||||
TOTALDIFF)
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
|
||||
(IDIFFERENCE (GETSEL SEL CHLIM)
|
||||
FIRSTHIT))
|
||||
|
||||
(* ;; "Not clear what the final selection should be, if there are multiple changes. The original selection? A selection that goes from the beginning of the first subsitution to the end of the last (as here)? Or just the selection of the last substitution?")
|
||||
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL FIRSTHIT (IDIFFERENCE HITLAST FIRSTHIT
|
||||
)
|
||||
'RIGHT)
|
||||
@@ -234,7 +255,7 @@
|
||||
|
||||
(* ;; "Save the search & replacement strings to offer for next time:")
|
||||
|
||||
(\TEDIT.SHOWSEL SEL T TSTREAM)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TSTREAM SEL)
|
||||
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING)
|
||||
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING
|
||||
@@ -248,13 +269,7 @@
|
||||
(RETURN NREPLACEMENTS))))])
|
||||
|
||||
(TEDIT.NEXT
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 6-Apr-2025 14:40 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 14:06 by rmk")
|
||||
(* ; "Edited 14-Mar-2025 23:14 by rmk")
|
||||
(* ; "Edited 11-Mar-2025 15:35 by rmk")
|
||||
(* ; "Edited 9-Mar-2025 11:31 by rmk")
|
||||
(* ; "Edited 15-Feb-2025 18:08 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:40 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 21-Oct-2024 00:40 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:47 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:23 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:10 by rmk")
|
||||
@@ -263,107 +278,57 @@
|
||||
(* ; "Edited 14-Dec-2023 21:20 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 00:05 by rmk")
|
||||
(* ; "Edited 3-May-2023 23:47 by rmk")
|
||||
(* ; "Edited 18-Apr-2023 23:46 by rmk ")
|
||||
(* ; "Edited 18-Apr-2023 23:46 by rmk")
|
||||
(* ; "Edited 30-May-91 20:57 by jds")
|
||||
|
||||
(* ;; "Finds/selects the next >>*<< or {*} or menu field after the current selection")
|
||||
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
CH CHNO DCH)
|
||||
|
||||
(* ;; "One pass, search in parallel")
|
||||
|
||||
(if [for old CHNO HIT from (FGETSEL SEL CHLIM) while (SETQ CH (\TEDIT.NTHCHARCODE TSTREAM
|
||||
CHNO))
|
||||
do (SELCHARQ CH
|
||||
(> (CL:WHEN (SETQ HIT (\TEDIT.FIND TEXTOBJ ">>*<<" T NIL CHNO))
|
||||
(SETQ CHNO (CAR HIT))
|
||||
(SETQ DCH (CADR HIT))
|
||||
(RETURN T)))
|
||||
({ (CL:WHEN (SETQ HIT (\TEDIT.FIND TEXTOBJ "{*}" T NIL CHNO))
|
||||
(SETQ CHNO (CAR HIT)) (* ; "Shouldn't include the { and }")
|
||||
(SETQ DCH (IDIFFERENCE (CADR HIT)
|
||||
2))
|
||||
(CL:UNLESS (EQ 0 DCH) (* ;
|
||||
"Right of {, if empty. to put it inside")
|
||||
(add CHNO 1))
|
||||
(RETURN T)))
|
||||
(CL:WHEN (AND (IMAGEOBJP CH)
|
||||
(IMAGEOBJPROP CH 'FIELDPREFIX))
|
||||
(* ; "Menu fields")
|
||||
(add CHNO 1)
|
||||
(RETURN (for ENDCHNO FCH from CHNO while (SETQ FCH (\TEDIT.NTHCHARCODE
|
||||
TSTREAM ENDCHNO))
|
||||
when (AND (IMAGEOBJP FCH)
|
||||
(IMAGEOBJPROP FCH 'FIELDSUFFIX))
|
||||
do (SETQ DCH (IDIFFERENCE ENDCHNO CHNO))
|
||||
(CL:WHEN (EQ 0 DCH)
|
||||
(* ; "RIGHT of prefix, if empty")
|
||||
(add CHNO -1))
|
||||
(RETURN T))))]
|
||||
then
|
||||
(* ;; "CHNO is the beginning of the located blank, DCH is its length")
|
||||
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
(\TEDIT.UPDATE.SEL TSTREAM CHNO DCH 'RIGHT 'PENDINGDEL)
|
||||
(FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
|
||||
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ)
|
||||
else (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in" T])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.FIND.OBJECT
|
||||
[LAMBDA (TSTREAM OBJ START END) (* ; "Edited 20-Oct-2024 12:07 by rmk")
|
||||
(* ; "Edited 10-May-2024 21:58 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
(* ; "Edited 6-Nov-2022 11:12 by rmk")
|
||||
(* ; "Edited 3-May-93 12:52 by jds")
|
||||
|
||||
(* ;; "Return the character number of OBJ in TSTREAM, if it occurs between START and END. We know that an object occupies its own singleton piece, so we don't need to worry about starting or ending in the middle of a piece. We also don't need to test PTYPE, just look at PCONTENTS.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN (IMAGEOBJP OBJ)
|
||||
[LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)))
|
||||
(CL:UNLESS END
|
||||
(SETQ END (FGETTOBJ TEXTOBJ TEXTLEN)))
|
||||
(CL:UNLESS START
|
||||
(SETQ START (TEDIT.GETPOINT TSTREAM)))
|
||||
(CL:WHEN (AND (ILEQ START END)
|
||||
(SETQ START (\TEDIT.CHTOPC START TEXTOBJ)))
|
||||
(SETQ END (\TEDIT.CHTOPC END TEXTOBJ))
|
||||
(for PC inpieces START when (EQ OBJ (PCONTENTS PC))
|
||||
do (RETURN (\TEDIT.PCTOCH PC TEXTOBJ)) repeatuntil (EQ PC END)))])])
|
||||
|
||||
(TEDIT.FIND.OBJECT.BACKWARD
|
||||
[LAMBDA (TSTREAM OBJ START END AGAIN) (* ; "Edited 10-May-2024 22:06 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
(* ; "Edited 6-Nov-2022 11:12 by rmk")
|
||||
(* ; "Edited 3-May-93 12:52 by jds")
|
||||
|
||||
(* ;; "Return the character number of OBJ in TSTREAM, if it occurs between START and END and is the occurrence closest to END. START defaults to 1, END defaults to current caret position (or one before, if AGAIN).")
|
||||
|
||||
(* ;; "If we were sure that a given object can appear only once in a document, we could just run the TEDIT.FIND.OBJECT with different defaults for START and END, but...")
|
||||
|
||||
(* ;; "We know that an object occupies its own singleton piece, so we don't need to worry about starting or ending in the middle of a piece. We also don't need to test PTYPE, just look at PCONTENTS.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN (IMAGEOBJP OBJ)
|
||||
[LET [(TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM]
|
||||
(SETQ START (IMAX 1 (OR START 1)))
|
||||
(SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
|
||||
(FGETTOBJ TEXTOBJ TEXTLEN)))
|
||||
(CL:WHEN AGAIN
|
||||
|
||||
(* ;; "Assume that we aren't interested in another match at the current position.")
|
||||
|
||||
(ADD END -1))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(SETQ START (\TEDIT.CHTOPC START TEXTOBJ))
|
||||
(SETQ END (\TEDIT.CHTOPC END TEXTOBJ))
|
||||
(for PC backpieces END when (EQ OBJ (PCONTENTS PC))
|
||||
do (RETURN (\TEDIT.PCTOCH PC TEXTOBJ)) repeatuntil (EQ PC START)))])])
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
TARGET SEL OPTION FIELDSEL)
|
||||
(SETQ SEL (TEXTSEL TEXTOBJ))
|
||||
(SETQ TARGET (TEDIT.FIND TEXTOBJ ">>*<<" NIL NIL T))(* ;
|
||||
"find the first >>delimited<< field")
|
||||
(SETQ FIELDSEL (TEDIT.FIND TEXTOBJ "{*}" NIL NIL T))(* ;
|
||||
"find the first menu-type insertion field, usually delimited with {}")
|
||||
[SETQ OPTION (COND
|
||||
[(AND TARGET FIELDSEL) (* ; "take the first one")
|
||||
(COND
|
||||
((IGREATERP (CAR TARGET)
|
||||
(GETSEL FIELDSEL CH#)) (* ; "use the {} selection")
|
||||
'FIELD)
|
||||
(T 'TARGET]
|
||||
(TARGET 'TARGET)
|
||||
(FIELDSEL 'FIELD)
|
||||
(T 'NEITHER]
|
||||
(SELECTQ OPTION
|
||||
(TARGET (* ; "Found another fill-in")
|
||||
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T)
|
||||
(* ;
|
||||
"Original comment: %"never pending a deletion%", but it is!")
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ;
|
||||
"Set up SELECTION to be the found text")
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR TARGET)
|
||||
(IDIFFERENCE (ADD1 (CADR TARGET))
|
||||
(CAR TARGET))
|
||||
'RIGHT
|
||||
'PENDINGDEL)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ) (* ; "Always selected normally")
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ) (* ; "And get it into the window")
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ))
|
||||
(FIELD (* ;
|
||||
"Update the selection for this textobj from the scratch sel returned from MBUTTON.FIND.NEXT.FIELD")
|
||||
(FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ;
|
||||
"Set SELECTION to be the found text")
|
||||
(\TEDIT.UPDATE.SEL SEL (GETSEL FIELDSEL CH#)
|
||||
(GETSEL FIELDSEL DCH)
|
||||
'LEFT
|
||||
'PENDINGDEL) (* ; "And get it into the window")
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ))
|
||||
(NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T)
|
||||
(SETQ SEL NIL))
|
||||
(\TEDIT.THELP "No legal value found in SELECTQ in TEDIT.NEXT"))
|
||||
(CL:WHEN SEL (* ;
|
||||
"There really IS a selection made here, so set up the charlooks for it properly.")
|
||||
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)))])
|
||||
)
|
||||
|
||||
|
||||
@@ -372,95 +337,6 @@
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.FIND
|
||||
[LAMBDA (TSTREAM TARGET WILDCARDS? AGAIN START END) (* ; "Edited 14-Mar-2025 18:42 by rmk")
|
||||
(* ; "Edited 11-Mar-2025 15:04 by rmk")
|
||||
(* ; "Edited 10-May-2024 21:55 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 23:47 by rmk")
|
||||
(* ; "Edited 19-Jun-2023 22:27 by rmk")
|
||||
(* ; "Edited 6-May-2018 17:34 by rmk:")
|
||||
(* ; "Edited 30-May-91 20:56 by jds")
|
||||
|
||||
(* ;; "This returns the hit's (CH# DCL) or NIL.")
|
||||
|
||||
(* ;; "If WILDCARDS? is NIL then TEDIT.FIND returns just the start of a basic string-match.")
|
||||
|
||||
(* ;; "Otherwise it returns a list of (MATCHSTART MATCHEND) which is the start and end char positions of the match,")
|
||||
|
||||
(* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
|
||||
(* ;; "* and # are implicitly quoted if not WILDCARDS? This could be handled simply by calling CONS instead of \TEDIT.PARSE.SEARCHSTRING")
|
||||
|
||||
(CL:UNLESS END
|
||||
(SETQ END (TEXTLEN (GETTSTR TSTREAM TEXTOBJ))))
|
||||
(CL:UNLESS START
|
||||
(SETQ START (TEDIT.GETPOINT TSTREAM)))
|
||||
(CL:WHEN AGAIN (* ;
|
||||
"We aren't interested in the same hit")
|
||||
(add START 1))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
[LET (RESULT)
|
||||
(if (IMAGEOBJP TARGET)
|
||||
then (CL:WHEN (SETQ RESULT (TEDIT.FIND.OBJECT TSTREAM TARGET START END))
|
||||
(LIST RESULT 1))
|
||||
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
|
||||
then (CL:WHEN (SETQ RESULT (CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND TSTREAM (\TEDIT.PARSE.SEARCHSTRING
|
||||
TARGET NIL)
|
||||
START END)
|
||||
(\TEDIT.BASICFIND TSTREAM TARGET START END)))
|
||||
|
||||
(* ;; "Switch from CHLAST to DCH")
|
||||
|
||||
[LIST (CAR RESULT)
|
||||
(ADD1 (IDIFFERENCE (CADR RESULT)
|
||||
(CAR RESULT])]))])
|
||||
|
||||
(\TEDIT.FIND.BACKWARD
|
||||
[LAMBDA (TSTREAM TARGET WILDCARDS? AGAIN START END) (* ; "Edited 11-Mar-2025 15:07 by rmk")
|
||||
|
||||
(* ;; "This returns the hit's (CH# DCL) or NIL.")
|
||||
|
||||
(* ;; "The search is confined to the characters between START and END. It runs backwards from END looking for the nearest match, and returns the character positions of that match.")
|
||||
|
||||
(* ;; "If WILDCARDS?, the value is the pair (MATCHSTART MATCHEND) for that match, since the caller doesn't know the length. But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long. This is quirky, but that's the way it is documented.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
[LET (RESULT)
|
||||
(if (IMAGEOBJP TARGET)
|
||||
then (CL:WHEN (SETQ RESULT (TEDIT.FIND.OBJECT.BACKWARD TSTREAM TARGET START END
|
||||
AGAIN))
|
||||
(LIST RESULT 1))
|
||||
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
|
||||
then (SETQ START (IMAX 1 (OR START 1)))
|
||||
(SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
|
||||
(FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
|
||||
TEXTLEN)))
|
||||
(CL:WHEN AGAIN
|
||||
|
||||
(* ;;
|
||||
"Assume that we aren't interested in another match at the current position.")
|
||||
|
||||
(ADD END -1))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(CL:WHEN (SETQ RESULT (CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND.BACKWARD TSTREAM (
|
||||
\TEDIT.PARSE.SEARCHSTRING
|
||||
TARGET T)
|
||||
START END)
|
||||
(\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START
|
||||
END)))
|
||||
|
||||
(* ;; "Switch from CHLAST to DCH")
|
||||
|
||||
[LIST (CAR RESULT)
|
||||
(ADD1 (IDIFFERENCE (CADR RESULT)
|
||||
(CAR RESULT]))])])
|
||||
|
||||
(\TEDIT.WCFIND
|
||||
[LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:04 by rmk")
|
||||
(* ; "Edited 23-Jun-2024 12:00 by rmk")
|
||||
@@ -515,8 +391,7 @@
|
||||
then (RETURN NIL])])
|
||||
|
||||
(\TEDIT.BASICFIND
|
||||
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Feb-2025 12:24 by rmk")
|
||||
(* ; "Edited 23-Jun-2024 12:03 by rmk")
|
||||
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 23-Jun-2024 12:03 by rmk")
|
||||
(* ; "Edited 22-Jun-2024 12:01 by rmk")
|
||||
(* ; "Edited 19-May-2024 23:18 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
@@ -546,9 +421,7 @@
|
||||
(BIN TSTREAM))
|
||||
(RETURN NIL))
|
||||
(CL:WHEN (EQ I NCHARS) (* ; "Matched the last char")
|
||||
(RETURN T))) do (FSETTOBJ (GETTSTR TSTREAM TEXTOBJ)
|
||||
LASTARROWX NIL)
|
||||
(RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
|
||||
(RETURN T))) do (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
|
||||
|
||||
(\TEDIT.WCFIND.BACKWARD
|
||||
[LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:05 by rmk")
|
||||
@@ -684,10 +557,8 @@
|
||||
(DREVERSE $$VAL))])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (967 19936 (TEDIT.FIND 977 . 1561) (TEDIT.FIND.SETSEL 1563 . 2028) (TEDIT.FIND.BACKWARD
|
||||
2030 . 2609) (TEDIT.SUBSTITUTE 2611 . 15222) (TEDIT.NEXT 15224 . 19934)) (19937 23366 (
|
||||
TEDIT.FIND.OBJECT 19947 . 21447) (TEDIT.FIND.OBJECT.BACKWARD 21449 . 23364)) (23399 43553 (\TEDIT.FIND
|
||||
23409 . 26345) (\TEDIT.FIND.BACKWARD 26347 . 28865) (\TEDIT.WCFIND 28867 . 32386) (\TEDIT.BASICFIND
|
||||
32388 . 34747) (\TEDIT.WCFIND.BACKWARD 34749 . 38213) (\TEDIT.BASICFIND.BACKWARD 38215 . 40472) (
|
||||
\TEDIT.PARSE.SEARCHSTRING 40474 . 43551)))))
|
||||
(FILEMAP (NIL (784 21950 (TEDIT.FIND 794 . 2793) (TEDIT.FIND.BACKWARD 2795 . 5117) (TEDIT.SUBSTITUTE
|
||||
5119 . 17479) (TEDIT.NEXT 17481 . 21948)) (21983 36411 (\TEDIT.WCFIND 21993 . 25512) (\TEDIT.BASICFIND
|
||||
25514 . 27605) (\TEDIT.WCFIND.BACKWARD 27607 . 31071) (\TEDIT.BASICFIND.BACKWARD 31073 . 33330) (
|
||||
\TEDIT.PARSE.SEARCHSTRING 33332 . 36409)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Apr-2025 19:07:23" {WMEDLEY}<library>tedit>TEDIT-HCPY.;176 32823
|
||||
(FILECREATED "13-Dec-2024 23:51:23" {WMEDLEY}<library>tedit>TEDIT-HCPY.;164 32996
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE)
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE TEDIT.HARDCOPYFN)
|
||||
|
||||
:PREVIOUS-DATE "17-Apr-2025 13:35:29" {WMEDLEY}<library>tedit>TEDIT-HCPY.;174)
|
||||
:PREVIOUS-DATE "26-Oct-2024 11:05:00" {WMEDLEY}<library>tedit>TEDIT-HCPY.;160)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
|
||||
@@ -133,13 +133,7 @@
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
|
||||
|
||||
(\TEDIT.HARDCOPY.DISPLAYLINE
|
||||
[LAMBDA (TSTREAM LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 21-Apr-2025 19:02 by rmk")
|
||||
(* ; "Edited 17-Apr-2025 13:35 by rmk")
|
||||
(* ; "Edited 15-Apr-2025 15:19 by rmk")
|
||||
(* ; "Edited 11-Apr-2025 17:30 by rmk")
|
||||
(* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:39 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 23:49 by rmk")
|
||||
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 13-Dec-2024 23:49 by rmk")
|
||||
(* ; "Edited 13-Jun-2024 17:13 by rmk")
|
||||
(* ; "Edited 19-Apr-2024 09:09 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:04 by rmk")
|
||||
@@ -155,122 +149,134 @@
|
||||
|
||||
(* ;; "If possible, use the information cached in THISLINE")
|
||||
|
||||
(LINEDESCRIPTOR! LINE)
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(\DTEST LINE 'LINEDESCRIPTOR)
|
||||
|
||||
(* ;; "Only display the line if it appears before the end of the text!")
|
||||
|
||||
(PROG* ((TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||
(THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
|
||||
(CL:WHEN (IGREATERP (FGETLD LINE LCHAR1 LINE)
|
||||
(FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
(RETURN NIL))
|
||||
(CL:UNLESS (EQ LINE (fetch DESC of THISLINE))
|
||||
(\TEDIT.FORMATLINE TSTREAM (FGETLD LINE LCHAR1)
|
||||
LINE REGION PRSTREAM FORMATTINGSTATE))
|
||||
(CL:UNLESS (IGREATERP (FGETLD LINE LCHAR1 LINE)
|
||||
(FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
[LET ((THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
|
||||
(CL:UNLESS (EQ LINE (fetch DESC of THISLINE))
|
||||
(\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT)
|
||||
(FGETLD LINE LCHAR1)
|
||||
LINE REGION PRSTREAM FORMATTINGSTATE))
|
||||
|
||||
(* ;; "Use the characters cached in THISLINE.")
|
||||
(* ;; "Use the characters cached in THISLINE.")
|
||||
|
||||
(for CHARSLOT OLDCLOOKS CURY LOOKSTARTX SCALESPACES OLDCOLOR (SPACEFACTOR
|
||||
_
|
||||
(fetch (THISLINE
|
||||
TLSPACEFACTOR)
|
||||
of THISLINE))
|
||||
(FIRST-SCALEDSPACE-SLOT _ (ffetch (THISLINE TLFIRSTSPACE) of THISLINE))
|
||||
(SCALE _ (DSPSCALE NIL PRSTREAM))
|
||||
(TX _ (FGETLD LINE LX1)) incharslots THISLINE first (DSPSPACEFACTOR 1 PRSTREAM)
|
||||
(DSPXPOSITION TX PRSTREAM)
|
||||
do
|
||||
(* ;;
|
||||
"Display the line character by character. CHAR, CHARW, and CHARCL are bound to CHARSLOT values")
|
||||
(for CHARSLOT CLOOKS CURY LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE
|
||||
TLSPACEFACTOR
|
||||
)
|
||||
of THISLINE))
|
||||
(FIRST-SCALEDSPACE-SLOT _ (ffetch (THISLINE TLFIRSTSPACE) of THISLINE))
|
||||
(SCALE _ (DSPSCALE NIL PRSTREAM))
|
||||
(TX _ (FGETLD LINE LX1)) incharslots THISLINE first (DSPSPACEFACTOR 1 PRSTREAM)
|
||||
(DSPXPOSITION TX PRSTREAM)
|
||||
do
|
||||
(* ;;
|
||||
"Display the line character by character. CHAR and CHARW are bound to CHARSLOT values")
|
||||
|
||||
(* ;; "Underline/overline/strike the just-finished looks run")
|
||||
(* ; "DISPLAY ALSO PASES LINE DESCENT")
|
||||
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX OLDCLOOKS PRSTREAM)
|
||||
(DSPFONT (FGETCLOOKS CHARCL CLFONT)
|
||||
PRSTREAM)
|
||||
(CL:UNLESS (EQ OLDCOLOR (SETQ OLDCOLOR (FGETCLOOKS CHARCL CLCOLOR)))
|
||||
(DSPCOLOR OLDCOLOR PRSTREAM))
|
||||
[SETQ CURY (COND
|
||||
[(AND (FGETCLOOKS CHARCL CLOFFSET)
|
||||
(NEQ 0 (FGETCLOOKS CHARCL CLOFFSET)))
|
||||
(IPLUS (FGETLD LINE YBASE)
|
||||
(HCSCALE SCALE (FGETCLOOKS CHARCL CLOFFSET]
|
||||
(T (FGETLD LINE YBASE]
|
||||
(DSPYPOSITION CURY PRSTREAM)
|
||||
|
||||
(* ;; "LOOKSTARTX: Starting X position for this CLOOKS.")
|
||||
|
||||
(SETQ LOOKSTARTX TX)
|
||||
(SELCHARQ CHAR
|
||||
(SPACE (CL:WHEN (EQ CHARSLOT FIRST-SCALEDSPACE-SLOT)
|
||||
(SELCHARQ CHAR
|
||||
(SPACE (CL:WHEN (EQ CHARSLOT FIRST-SCALEDSPACE-SLOT)
|
||||
(* ; "Time to turn on space scaling.")
|
||||
(DSPSPACEFACTOR SPACEFACTOR PRSTREAM)
|
||||
(SETQ SCALESPACES T))
|
||||
(\OUTCHAR PRSTREAM (CHARCODE SPACE))
|
||||
(add TX (CL:IF SCALESPACES
|
||||
(HCSCALE SPACEFACTOR CHARW)
|
||||
CHARW)))
|
||||
((TAB Meta,TAB) (* ;
|
||||
(DSPSPACEFACTOR SPACEFACTOR PRSTREAM)
|
||||
(SETQ SCALESPACES T))
|
||||
(\OUTCHAR PRSTREAM (CHARCODE SPACE))
|
||||
(add TX (CL:IF SCALESPACES
|
||||
(HCSCALE SPACEFACTOR CHARW)
|
||||
CHARW)))
|
||||
((TAB Meta,TAB) (* ;
|
||||
"Dotted leaders are meta-TAB, or are DOTTEDLEADER.")
|
||||
(CL:WHEN (OR (EQ CHAR (CHARCODE Meta,TAB))
|
||||
(FGETCLOOKS CHARCL CLLEADER)
|
||||
(EQ (FGETCLOOKS CHARCL CLUSERINFO)
|
||||
'DOTTEDLEADER))
|
||||
(LET* [(DOTWIDTH (CHARWIDTH (CHARCODE %.)
|
||||
(FONTCOPY (FGETCLOOKS CHARCL CLFONT)
|
||||
'DEVICE PRSTREAM)))
|
||||
(TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH (IREMAINDER
|
||||
TX DOTWIDTH]
|
||||
(DSPXPOSITION (IDIFFERENCE TTX DOTWIDTH)
|
||||
PRSTREAM) (* ;
|
||||
(CL:WHEN (OR (EQ CHAR (CHARCODE Meta,TAB))
|
||||
(fetch CLLEADER of CLOOKS)
|
||||
(EQ (fetch CLUSERINFO of CLOOKS)
|
||||
'DOTTEDLEADER))
|
||||
(LET* [(DOTWIDTH (CHARWIDTH (CHARCODE %.)
|
||||
(FONTCOPY (fetch (CHARLOOKS CLFONT)
|
||||
of CLOOKS)
|
||||
'DEVICE PRSTREAM)))
|
||||
(TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH
|
||||
(IREMAINDER TX DOTWIDTH]
|
||||
(DSPXPOSITION (IDIFFERENCE TTX DOTWIDTH)
|
||||
PRSTREAM) (* ;
|
||||
"Move over to the next even multiple of a dot's width.")
|
||||
(while (ILEQ TTX (IPLUS TX CHARW))
|
||||
do (\OUTCHAR PRSTREAM (CHARCODE %.))
|
||||
(add TTX DOTWIDTH))))
|
||||
(add TX CHARW)
|
||||
(DSPXPOSITION TX PRSTREAM))
|
||||
((EOL LF CR)
|
||||
NIL)
|
||||
(PROGN (if (IMAGEOBJP CHAR)
|
||||
then
|
||||
(* ;; "Go to the base line, left edge of the image region.")
|
||||
(while (ILEQ TTX (IPLUS TX CHARW))
|
||||
do (\OUTCHAR PRSTREAM (CHARCODE %.))
|
||||
(add TTX DOTWIDTH))))
|
||||
(add TX CHARW)
|
||||
(DSPXPOSITION TX PRSTREAM))
|
||||
((EOL LF CR)
|
||||
NIL)
|
||||
(NIL
|
||||
(* ;;
|
||||
"LOOKS. Line-start looks are guaranteed to come before any character/object")
|
||||
|
||||
(SETQ CURY (DSPYPOSITION NIL PRSTREAM))
|
||||
(APPLY* (IMAGEOBJPROP CHAR 'DISPLAYFN)
|
||||
CHAR PRSTREAM (IMAGESTREAMTYPE PRSTREAM)
|
||||
TSTREAM)
|
||||
(DSPFONT (FGETCLOOKS CHARCL CLFONT)
|
||||
PRSTREAM) (* ;
|
||||
(if (type? CHARLOOKS CHARW)
|
||||
then (CL:WHEN CLOOKS
|
||||
|
||||
(* ;;
|
||||
"Underline/overline/strike the just-finished looks run")
|
||||
(* ; "DISPLAY ALSO PASES LINE DESCENT")
|
||||
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX
|
||||
(FGETLD LINE YBASE)
|
||||
CLOOKS PRSTREAM))
|
||||
(SETQ CLOOKS CHARW)
|
||||
(DSPFONT (fetch CLFONT of CLOOKS)
|
||||
PRSTREAM)
|
||||
[SETQ CURY (COND
|
||||
[(AND (fetch (CHARLOOKS CLOFFSET) of CLOOKS)
|
||||
(NEQ 0 (fetch (CHARLOOKS CLOFFSET)
|
||||
of CLOOKS)))
|
||||
(IPLUS (FGETLD LINE YBASE)
|
||||
(HCSCALE SCALE (fetch (CHARLOOKS CLOFFSET
|
||||
)
|
||||
of CLOOKS]
|
||||
(T (FGETLD LINE YBASE]
|
||||
(DSPYPOSITION CURY PRSTREAM)
|
||||
|
||||
(* ;; "LOOKSTARTX: Starting X position for this CLOOKS.")
|
||||
|
||||
(SETQ LOOKSTARTX TX)))
|
||||
(PROGN (if (IMAGEOBJP CHAR)
|
||||
then
|
||||
(* ;; "Go to the base line, left edge of the image region.")
|
||||
|
||||
(SETQ CURY (DSPYPOSITION NIL PRSTREAM))
|
||||
(APPLY* (IMAGEOBJPROP CHAR 'DISPLAYFN)
|
||||
CHAR PRSTREAM (IMAGESTREAMTYPE PRSTREAM)
|
||||
(ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ))
|
||||
(DSPFONT (fetch CLFONT of CLOOKS)
|
||||
PRSTREAM) (* ;
|
||||
"Restore the font, move to after the object's image")
|
||||
(MOVETO (IPLUS TX CHARW)
|
||||
CURY PRSTREAM)
|
||||
elseif (DIACRITICP CHAR)
|
||||
then
|
||||
(* ;; "Special placement for diacritics")
|
||||
(MOVETO (IPLUS TX CHARW)
|
||||
CURY PRSTREAM)
|
||||
elseif (DIACRITICP CHAR)
|
||||
then
|
||||
(* ;; "Special placement for diacritics")
|
||||
|
||||
(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
|
||||
(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
|
||||
|
||||
(* ;; "Do any last-minute underlining or similar looks fix-ups, and print a revision mark, if one is needed:")
|
||||
|
||||
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX
|
||||
CHARCL PRSTREAM)
|
||||
(CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS)
|
||||
FMTREVISED)
|
||||
(CL:WHEN CLOOKS
|
||||
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE
|
||||
LOOKSTARTX TX (FGETLD LINE YBASE)
|
||||
CLOOKS PRSTREAM))
|
||||
(CL:WHEN (fetch (FMTSPEC FMTREVISED)
|
||||
of (FGETLD LINE LFMTSPEC))
|
||||
(* ;
|
||||
"This paragraph has been revised, so mark it.")
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ
|
||||
(FGETLD LINE LPARALOOKS)
|
||||
PRSTREAM LINE))])
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ
|
||||
(FGETLD LINE LFMTSPEC)
|
||||
PRSTREAM LINE))])])
|
||||
|
||||
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:13 by rmk")
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 26-Oct-2024 11:04 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 17:22 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 23:19 by rmk")
|
||||
@@ -278,64 +284,66 @@
|
||||
|
||||
(* ;; "Return setup LINE to skip a sequence of heading pieces STATE")
|
||||
|
||||
(SELECTQ (GETPLOOKS PARALOOKS FMTPARATYPE)
|
||||
(SELECTQ (GETPARA FMTSPEC FMTPARATYPE)
|
||||
(PAGEHEADING
|
||||
(* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.")
|
||||
|
||||
(\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM
|
||||
(\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM
|
||||
FORMATTINGSTATE)
|
||||
T)
|
||||
(EVEN (* ; "Skip an odd page.")
|
||||
(CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
T))
|
||||
(ODD (* ; "Skip an even page")
|
||||
(CL:WHEN (EVENP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
T))
|
||||
NIL])
|
||||
|
||||
(\TEDIT.HARDCOPY.MODIFYLOOKS
|
||||
[LAMBDA (LINE STARTX CURX CLOOKS PRSTREAM) (* ; "Edited 11-Apr-2025 17:37 by rmk")
|
||||
(* ; "Edited 27-May-2023 12:16 by rmk")
|
||||
[LAMBDA (LINE STARTX CURX CURY LOOKS PRSTREAM) (* ; "Edited 27-May-2023 12:16 by rmk")
|
||||
(* ; "Edited 30-May-91 21:17 by jds")
|
||||
|
||||
(* ;; "Do underlining, overlining, etc. for hardcopy files")
|
||||
|
||||
(LINEDESCRIPTOR! LINE)
|
||||
(CL:WHEN CLOOKS
|
||||
(LET ((STREAMSCALE (DSPSCALE NIL PRSTREAM))
|
||||
[RULEWIDTH (FIXR (FTIMES 0.75 (DSPSCALE NIL PRSTREAM]
|
||||
(ONEPOINT (FIXR (DSPSCALE NIL PRSTREAM)))
|
||||
(YBASE (FGETLD LINE YBASE))
|
||||
YOFFSET)
|
||||
(CL:WHEN (FGETCLOOKS CLOOKS CLULINE) (* ; "Underlined")
|
||||
(DRAWLINE STARTX (IDIFFERENCE YBASE (FGETLD LINE LTRUEDESCENT LINE))
|
||||
CURX
|
||||
(IDIFFERENCE YBASE (FGETLD LINE LTRUEDESCENT LINE))
|
||||
RULEWIDTH
|
||||
'PAINT PRSTREAM))
|
||||
(CL:WHEN (FGETCLOOKS CLOOKS CLOLINE) (* ; "Over-line")
|
||||
(DRAWLINE STARTX (IPLUS YBASE (GETLD LINE LTRUEASCENT LINE))
|
||||
CURX
|
||||
(IPLUS YBASE (GETLD LINE LTRUEASCENT LINE))
|
||||
RULEWIDTH
|
||||
'PAINT PRSTREAM))
|
||||
(CL:WHEN (FGETCLOOKS CLOOKS CLSTRIKE) (* ; "Struch-thru")
|
||||
(DRAWLINE STARTX (SETQ YOFFSET
|
||||
(IPLUS YBASE (IQUOTIENT [FIXR (FTIMES STREAMSCALE
|
||||
(FONTPROP (fetch (CHARLOOKS
|
||||
CLFONT)
|
||||
of CLOOKS)
|
||||
'ASCENT]
|
||||
3)))
|
||||
CURX YOFFSET RULEWIDTH 'PAINT PRSTREAM))
|
||||
(MOVETO CURX YBASE PRSTREAM)))])
|
||||
[PROG ((STREAMSCALE (DSPSCALE NIL PRSTREAM))
|
||||
[RULEWIDTH (FIXR (FTIMES 0.75 (DSPSCALE NIL PRSTREAM]
|
||||
(ONEPOINT (FIXR (DSPSCALE NIL PRSTREAM)))
|
||||
YOFFSET)
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLULINE) of LOOKS) (* ; "It's underlined.")
|
||||
(DRAWLINE STARTX (IDIFFERENCE (GETLD LINE YBASE)
|
||||
(GETLD LINE LTRUEDESCENT LINE))
|
||||
CURX
|
||||
(IDIFFERENCE (GETLD LINE YBASE)
|
||||
(GETLD LINE LTRUEDESCENT LINE))
|
||||
RULEWIDTH
|
||||
'PAINT PRSTREAM) (* ; "A 1/2-pt underline")
|
||||
))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLOLINE) of LOOKS) (* ; "Over-line")
|
||||
(DRAWLINE STARTX (IPLUS (GETLD LINE YBASE)
|
||||
(GETLD LINE LTRUEASCENT LINE))
|
||||
CURX
|
||||
(IPLUS (GETLD LINE YBASE LINE)
|
||||
(GETLD LINE LTRUEASCENT LINE))
|
||||
RULEWIDTH
|
||||
'PAINT PRSTREAM)))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLSTRIKE) of LOOKS) (* ; "Struch-thru")
|
||||
(DRAWLINE STARTX (SETQ YOFFSET (IPLUS (GETLD LINE YBASE LINE)
|
||||
(IQUOTIENT
|
||||
[FIXR (FTIMES STREAMSCALE
|
||||
(FONTPROP (fetch (CHARLOOKS CLFONT)
|
||||
of LOOKS)
|
||||
'ASCENT]
|
||||
3)))
|
||||
CURX YOFFSET RULEWIDTH 'PAINT PRSTREAM]
|
||||
(MOVETO CURX CURY PRSTREAM])
|
||||
|
||||
(\TEDIT.HCPYFMTSPEC
|
||||
[LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:36 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 22:25 by rmk")
|
||||
[LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "Edited 28-Jul-2024 22:25 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:34 by rmk")
|
||||
(* ; "Edited 7-Mar-2023 21:03 by rmk")
|
||||
(* ; "Edited 6-Mar-2023 15:14 by rmk")
|
||||
@@ -343,34 +351,33 @@
|
||||
(* ; "Edited 29-Sep-2022 23:32 by rmk")
|
||||
(* ; "Edited 30-May-91 21:18 by jds")
|
||||
|
||||
(* ;; "Given a display-type PARALOOKS, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
|
||||
(* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
|
||||
|
||||
(LET* ((SCALE (DSPSCALE NIL IMAGESTREAM)))
|
||||
(create PARALOOKS using DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
|
||||
(HCSCALE SCALE (FGETPLOOKS DISPLAYFMT 1STLEFTMAR))
|
||||
LEFTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEFTMAR))
|
||||
RIGHTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT RIGHTMAR))
|
||||
QUAD _ (FGETPLOOKS DISPLAYFMT QUAD DISPLAYFMT)
|
||||
FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT FMTDEFAULTTAB
|
||||
))
|
||||
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPLOOKS DISPLAYFMT FMTTABS)
|
||||
SCALE)
|
||||
FMTSPECIALX _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALX)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
|
||||
DISPLAYFMT
|
||||
FMTSPECIALX)
|
||||
1.0 NIL)))
|
||||
FMTSPECIALY _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALY)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
|
||||
DISPLAYFMT
|
||||
FMTSPECIALY)
|
||||
1.0 NIL)))
|
||||
LEADBEFORE _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADBEFORE))
|
||||
LEADAFTER _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADAFTER))
|
||||
LINELEAD _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LINELEAD))
|
||||
FMTBASETOBASE _ (AND (FGETPLOOKS DISPLAYFMT FMTBASETOBASE)
|
||||
(HCSCALE SCALE (FGETPLOOKS DISPLAYFMT
|
||||
FMTBASETOBASE])
|
||||
(create FMTSPEC using DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
|
||||
(HCSCALE SCALE (FGETPARA DISPLAYFMT 1STLEFTMAR))
|
||||
LEFTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEFTMAR))
|
||||
RIGHTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT RIGHTMAR))
|
||||
QUAD _ (FGETPARA DISPLAYFMT QUAD DISPLAYFMT)
|
||||
FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPARA DISPLAYFMT FMTDEFAULTTAB))
|
||||
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPARA DISPLAYFMT FMTTABS)
|
||||
SCALE)
|
||||
FMTSPECIALX _ (AND (FGETPARA DISPLAYFMT FMTSPECIALX)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA
|
||||
DISPLAYFMT
|
||||
FMTSPECIALX)
|
||||
1.0 NIL)))
|
||||
FMTSPECIALY _ (AND (FGETPARA DISPLAYFMT FMTSPECIALY)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA
|
||||
DISPLAYFMT
|
||||
FMTSPECIALY)
|
||||
1.0 NIL)))
|
||||
LEADBEFORE _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADBEFORE))
|
||||
LEADAFTER _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADAFTER))
|
||||
LINELEAD _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LINELEAD))
|
||||
FMTBASETOBASE _ (AND (FGETPARA DISPLAYFMT FMTBASETOBASE)
|
||||
(HCSCALE SCALE (FGETPARA DISPLAYFMT
|
||||
FMTBASETOBASE])
|
||||
|
||||
(\TEDIT.INTEGER.IMAGEBOX
|
||||
[LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52")
|
||||
@@ -548,11 +555,11 @@
|
||||
(CLOSEF DOC])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3475 26032 (TEDIT.HARDCOPY 3485 . 4618) (\TEDIT.PRINT.MENU 4620 . 5586) (TEDIT.HCPYFILE
|
||||
5588 . 7762) (\TEDIT.HARDCOPY.DISPLAYLINE 7764 . 16987) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 16989 .
|
||||
18718) (\TEDIT.HARDCOPY.MODIFYLOOKS 18720 . 20901) (\TEDIT.HCPYFMTSPEC 20903 . 24361) (
|
||||
\TEDIT.INTEGER.IMAGEBOX 24363 . 25034) (\TEDIT.DISPLAY.DIACRITIC 25036 . 26030)) (26107 26937 (
|
||||
\TEDIT.SCALEREGION 26117 . 26935)) (27196 30736 (TEDIT.HARDCOPYFN 27206 . 28511) (
|
||||
\TEDIT.HARDCOPYFILEFN 28513 . 29074) (\TEDIT.POSTSCRIPT.HARDCOPY 29076 . 30007) (\TEDIT.PRESS.HARDCOPY
|
||||
30009 . 30734)) (31999 32800 (TEDIT-BOOK 32009 . 32798)))))
|
||||
(FILEMAP (NIL (3492 26205 (TEDIT.HARDCOPY 3502 . 4635) (\TEDIT.PRINT.MENU 4637 . 5603) (TEDIT.HCPYFILE
|
||||
5605 . 7779) (\TEDIT.HARDCOPY.DISPLAYLINE 7781 . 17682) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17684 .
|
||||
19183) (\TEDIT.HARDCOPY.MODIFYLOOKS 19185 . 21419) (\TEDIT.HCPYFMTSPEC 21421 . 24534) (
|
||||
\TEDIT.INTEGER.IMAGEBOX 24536 . 25207) (\TEDIT.DISPLAY.DIACRITIC 25209 . 26203)) (26280 27110 (
|
||||
\TEDIT.SCALEREGION 26290 . 27108)) (27369 30909 (TEDIT.HARDCOPYFN 27379 . 28684) (
|
||||
\TEDIT.HARDCOPYFILEFN 28686 . 29247) (\TEDIT.POSTSCRIPT.HARDCOPY 29249 . 30180) (\TEDIT.PRESS.HARDCOPY
|
||||
30182 . 30907)) (32172 32973 (TEDIT-BOOK 32182 . 32971)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Apr-2025 22:42:33" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;250 58952
|
||||
(FILECREATED " 8-Dec-2024 19:41:55" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;219 53094
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.UNDO.DELETE \TEDIT.REDO.INSERT \TEDIT.REDO.REPLACE \TEDIT.UNDO.REPLACE
|
||||
\TEDIT.UNDO.CHARLOOKS \TEDIT.UNDO.PARALOOKS TEDIT.UNDO)
|
||||
:CHANGES-TO (FNS TEDIT.UNDO \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS \TEDIT.UNDO.UNDO
|
||||
TEDIT.REDO \TEDIT.HISTORYADD.COMPOSITE \TEDIT.UNDO.MOVE \TEDIT.UNDO.COMPOSITE
|
||||
\TEDIT.COMPOSITE.EVENT)
|
||||
(VARS TEDIT-HISTORYCOMS)
|
||||
(MACROS \TEDIT.HISTORYADD1)
|
||||
|
||||
:PREVIOUS-DATE "20-Apr-2025 23:30:57" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;247)
|
||||
:PREVIOUS-DATE " 7-Dec-2024 21:26:15" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;213)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
|
||||
@@ -32,7 +35,7 @@
|
||||
(FNS TEDIT.UNDO \TEDIT.UNDO1 TEDIT.REDO \TEDIT.UNDO.UNDO)
|
||||
(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 \TEDIT.UNDO.WRAP \TEDIT.UNDO.SEL)
|
||||
\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
|
||||
@@ -154,8 +157,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.HISTORYADD
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 11:22 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 17:32 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")
|
||||
@@ -173,73 +175,68 @@
|
||||
|
||||
(* ;; "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.")
|
||||
|
||||
[LET [(TEXTOBJ (FTEXTOBJ TSTREAM (type? TEXTOBJ TSTREAM]
|
||||
(if (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
|
||||
then
|
||||
(* ;; "Maybe the first event after setting the textprop--now's the time to flush")
|
||||
(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)))
|
||||
(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.")
|
||||
|
||||
(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.")
|
||||
|
||||
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT))
|
||||
(\TEDIT.POPEVENT TEXTOBJ)))
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ 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")
|
||||
|
||||
(* ;; "SHOULDNT HAPPEN ?")
|
||||
(* ;; "SHOULDNT HAPPEN ?")
|
||||
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT]
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT)))
|
||||
EVENT])
|
||||
|
||||
(\TEDIT.HISTORYADD.COMPOSITE
|
||||
[LAMBDA (TEXTOBJ EVENTS ACTION EXTRA) (* ; "Edited 1-Apr-2025 17:50 by rmk")
|
||||
(* ; "Edited 6-Feb-2025 15:31 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 19:31 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 8-Dec-2024 19:31 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:47 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 08:02 by rmk")
|
||||
(* ; "Edited 8-May-2024 12:34 by rmk")
|
||||
(SETQ EVENTS (REMOVE NIL EVENTS))
|
||||
(CL:WHEN EVENTS
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (CL:IF (CDR EVENTS)
|
||||
(\TEDIT.HISTORY.EVENT TEXTOBJ (OR ACTION :Composite)
|
||||
NIL NIL NIL NIL EVENTS EXTRA)
|
||||
(\TEDIT.HISTORY.EVENT TEXTOBJ :Composite NIL NIL NIL NIL
|
||||
EVENTS)
|
||||
(CAR EVENTS))))])
|
||||
|
||||
(\TEDIT.CUMULATE.EVENTS
|
||||
@@ -299,15 +296,13 @@
|
||||
(\ILLEGAL.ARG NEWVALUE))))])
|
||||
|
||||
(\TEDIT.HISTORY.EVENT
|
||||
[LAMBDA (TSTREAM ACTION CH# LEN POINT FIRSTPIECE OLDINFO DELETEDPIECES)
|
||||
(* ; "Edited 6-Apr-2025 11:20 by rmk")
|
||||
[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 (FTEXTOBJ TSTREAM)
|
||||
TXTHISTORYINACTIVE)
|
||||
(CL:UNLESS (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
|
||||
(CL:WHEN (AND (NULL LEN)
|
||||
(type? SELPIECES CH#))
|
||||
(SETQ LEN (fetch (SELPIECES SPLEN) of CH#))
|
||||
@@ -333,11 +328,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.UNDO
|
||||
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 21-Apr-2025 20:16 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 14:42 by rmk")
|
||||
(* ; "Edited 5-Apr-2025 13:49 by rmk")
|
||||
(* ; "Edited 13-Mar-2025 15:47 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 19:41 by rmk")
|
||||
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 8-Dec-2024 19:41 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 13:17 by rmk")
|
||||
(* ; "Edited 12-Aug-2024 10:49 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 21:21 by rmk")
|
||||
@@ -372,7 +363,6 @@
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
|
||||
T)
|
||||
(RETURN))
|
||||
(TEDIT.PROMPTCLEAR TEXTOBJ)
|
||||
(SETQ EVENT (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(SETQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ)) (* ;
|
||||
"So we can test for the undoundo event.")
|
||||
@@ -384,9 +374,8 @@
|
||||
|
||||
(* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")
|
||||
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UNDO1 TSTREAM EVENT)
|
||||
|
||||
(* ;; "Get the event that undid EVENT--if it was pushed in front of PREVENT ")
|
||||
@@ -403,14 +392,11 @@
|
||||
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE)
|
||||
(LIST PREVEVENT UNDOEVENT EVENT)))
|
||||
(\TEDIT.SHOWSEL SEL T TSTREAM])
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO1
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 14:42 by rmk")
|
||||
(* ; "Edited 1-Apr-2025 21:22 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 14:22 by rmk")
|
||||
(* ; "Edited 16-Mar-2025 18:46 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 13:56 by rmk")
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 25-Nov-2024 13:56 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 13:51 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 21:41 by rmk")
|
||||
(* ; "Edited 19-Aug-2024 00:11 by rmk")
|
||||
@@ -420,57 +406,57 @@
|
||||
(* ; "Edited 16-Jul-2023 11:14 by rmk")
|
||||
(* ; "Edited 30-May-2023 23:50 by rmk")
|
||||
(* ; "Edited 25-May-2023 00:33 by rmk")
|
||||
(CL:WHEN (GETTH EVENT THCH#)
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
(\TEDIT.UPDATE.SEL TSTREAM EVENT)
|
||||
(\TEDIT.SCROLL.CARET TSTREAM))
|
||||
(PROG1 (SELECTC (GETTH EVENT THACTION)
|
||||
((LIST :Insert :Copy)
|
||||
(\TEDIT.UNDO.INSERT TSTREAM EVENT))
|
||||
(:Move (\TEDIT.UNDO.MOVE TSTREAM EVENT))
|
||||
(:Delete (* ; "Deletion or case-shift")
|
||||
(\TEDIT.UNDO.DELETE TSTREAM EVENT))
|
||||
(:CharLooks (* ; "Character-looks change")
|
||||
(\TEDIT.UNDO.CHARLOOKS TSTREAM EVENT))
|
||||
(:ParaLooks (* ; "PARA looks change")
|
||||
(\TEDIT.UNDO.PARALOOKS TSTREAM EVENT))
|
||||
(:PageFormat (* ; "Pageframe change")
|
||||
(\TEDIT.UNDO.PAGELOOKS TSTREAM EVENT))
|
||||
((LIST :Replace :Transform)
|
||||
(* ;; "He replaced one portion of text with another ; Transforms have the same undo event but different REDO's.")
|
||||
(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 :LowerCase :UpperCase)
|
||||
|
||||
(\TEDIT.UNDO.REPLACE TSTREAM EVENT (GETTH EVENT THACTION)))
|
||||
(:ReplaceCode (\TEDIT.UNDO.REPLACECODE TSTREAM EVENT))
|
||||
(:Closefile (* ; "Closes an included file")
|
||||
(CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
|
||||
(CLOSEF? (GETTH EVENT THOLDINFO))))
|
||||
(:Composite (\TEDIT.UNDO.COMPOSITE TSTREAM EVENT))
|
||||
(:Wrap (\TEDIT.UNDO.WRAP TSTREAM EVENT))
|
||||
(:Sel (\TEDIT.UNDO.SEL TSTREAM EVENT))
|
||||
((LIST :Get :Put) (* ;
|
||||
(* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")
|
||||
|
||||
(\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:ReplaceCode (\TEDIT.UNDO.REPLACECODE TEXTOBJ EVENT))
|
||||
(: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 TSTREAM (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 TSTREAM EVENT (GETTH EVENT THLEN)
|
||||
(GETTH EVENT THCH#)
|
||||
(GETTH EVENT THFIRSTPIECE)))
|
||||
(T (TEDIT.PROMPTPRINT TSTREAM (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 (TSTREAM) (* ; "Edited 6-Apr-2025 14:43 by rmk")
|
||||
(* ; "Edited 1-Apr-2025 21:42 by rmk")
|
||||
(* ; "Edited 16-Mar-2025 18:48 by rmk")
|
||||
(* ; "Edited 2-Feb-2025 11:28 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 17:53 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 8-Dec-2024 17:53 by rmk")
|
||||
(* ; "Edited 27-Nov-2024 23:11 by rmk")
|
||||
(* ; "Edited 26-Sep-2024 16:49 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:58 by rmk")
|
||||
@@ -488,74 +474,72 @@
|
||||
(* ;; "REDO the last thing this guy did.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(PROG* ((TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||
(SEL (FGETTOBJ TEXTOBJ SEL))
|
||||
(PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (GETTOBJ TEXTOBJ SEL))
|
||||
(EVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
CH)
|
||||
(CL:WHEN (\TEDIT.READONLY TSTREAM)
|
||||
(CL:WHEN (\TEDIT.READONLY TEXTOBJ)
|
||||
(RETURN NIL))
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TSTREAM "Nothing to redo" T)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
|
||||
(RETURN))
|
||||
(CL:UNLESS (GETSEL SEL SET)
|
||||
(TEDIT.PROMPTPRINT TSTREAM "Please select a target for the repeated action" T)
|
||||
(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.")
|
||||
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(SELECTC (GETTH EVENT THACTION)
|
||||
((LIST :Insert :Copy :Move) (* ; "It was an insertion")
|
||||
(\TEDIT.REDO.INSERT TSTREAM EVENT SEL))
|
||||
(\TEDIT.REDO.INSERT TEXTOBJ EVENT SEL))
|
||||
(:Delete (* ; "It was a deletion")
|
||||
(\TEDIT.DELETE TSTREAM SEL))
|
||||
(\TEDIT.DELETE TEXTOBJ SEL))
|
||||
(:Replace (* ;
|
||||
"It was a replacement (a del/insert combo)")
|
||||
(\TEDIT.REDO.REPLACE TSTREAM EVENT (GETTH EVENT THACTION)))
|
||||
(:Transform (\TEDIT.KEY.TRANSFORM TSTREAM (GETTH EVENT THOLDINFO)))
|
||||
(\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:LowerCase (* ; "He lower-cased something")
|
||||
(\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION L-CASECODE)))
|
||||
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(:UpperCase (* ; "He upper-cased something")
|
||||
(\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION U-CASECODE)))
|
||||
(:InitialCap (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION CAP-CASECODE)))
|
||||
(\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(:CharLooks (* ; "It was a character looks change")
|
||||
(\TEDIT.CHANGE.CHARLOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
|
||||
(\TEDIT.CHANGE.CHARLOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
|
||||
SEL))
|
||||
(:ParaLooks (* ; "It was a Paragraph looks change")
|
||||
(\TEDIT.CHANGE.PARALOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
|
||||
(\TEDIT.CHANGE.PARALOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
|
||||
SEL))
|
||||
(:PageFormat (TEDIT.PROMPTPRINT TSTREAM "You can't redo a page-format change" T T))
|
||||
(: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
|
||||
TSTREAM "Searching..." T)
|
||||
(SETQ SEL (TEXTSEL TEXTOBJ))
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
(SETQ CH (TEDIT.FIND TEXTOBJ
|
||||
TEXTOBJ "Searching..." T)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of
|
||||
TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL NIL
|
||||
TEXTOBJ) (SETQ CH (TEDIT.FIND TEXTOBJ
|
||||
(GETTH EVENT THAUXINFO)))
|
||||
(if CH then (\TEDIT.UPDATE.SEL TSTREAM
|
||||
CH (NCHARS (GETTH EVENT THAUXINFO))
|
||||
(QUOTE RIGHT)) (TEDIT.NORMALIZECARET
|
||||
TSTREAM) (TEDIT.PROMPTPRINT TSTREAM
|
||||
"done.") else (TEDIT.PROMPTPRINT
|
||||
TSTREAM "[Not found]")))
|
||||
(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 NIL TEXTOBJ))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ
|
||||
"[Not found]"))))
|
||||
)
|
||||
(: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 TSTREAM (CONCAT "You can't redo a " (GETTH EVENT THACTION))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
|
||||
T T))
|
||||
(:Composite (\TEDIT.REDO.COMPOSITE TSTREAM EVENT SEL))
|
||||
(:Wrap (\TEDIT.KEY.WRAP TSTREAM (CAR (GETTH EVENT THDELETEDPIECES))
|
||||
(CADR (GETTH EVENT THDELETEDPIECES))))
|
||||
(:Composite (\TEDIT.REDO.COMPOSITE TEXTOBJ EVENT SEL))
|
||||
((LIST :Get :Put NIL) (* ; "Why can't you redo a get or put ?")
|
||||
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "You can't redo a " (GETTH EVENT THACTION))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
|
||||
T T))
|
||||
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Redoing the action " (GETTH EVENT THACTION)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
|
||||
" isn't implemented.")
|
||||
T))
|
||||
(\TEDIT.SHOWSEL SEL T TSTREAM])
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO.UNDO
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 8-Dec-2024 18:24 by rmk")
|
||||
@@ -601,8 +585,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.UNDO.INSERT
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 12:15 by rmk")
|
||||
(* ; "Edited 8-Jul-2024 00:07 by rmk")
|
||||
[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")
|
||||
@@ -611,16 +594,12 @@
|
||||
|
||||
(* ;; "UNDO a prior Insert, Copy, or Include. ")
|
||||
|
||||
(* ;; "If it is OK to show, we don't need the FIX or the TEXTSEL--use the stream")
|
||||
|
||||
(\TEDIT.DELETE TSTREAM (\TEDIT.FIXSEL (\TEDIT.UPDATE.SEL (TEXTSEL (FTEXTOBJ TSTREAM))
|
||||
(\TEDIT.DELETE TEXTOBJ (\TEDIT.FIXSEL (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
EVENT)
|
||||
TSTREAM])
|
||||
TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO.DELETE
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 21-Apr-2025 22:22 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 11:49 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 00:23 by rmk")
|
||||
[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")
|
||||
@@ -629,13 +608,12 @@
|
||||
(* ;; "UNDO a prior deletion ")
|
||||
|
||||
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
|
||||
'INSERT TSTREAM)
|
||||
TSTREAM
|
||||
'INSERT TEXTOBJ)
|
||||
TEXTOBJ
|
||||
(GETTH EVENT THCH#])
|
||||
|
||||
(\TEDIT.UNDO.MOVE
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 11:51 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 19:38 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")
|
||||
@@ -645,7 +623,7 @@
|
||||
|
||||
(* ;; "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* [(TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||
(LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
(REPLACE (EQ :Replace (GETTH (CAR (GETTH EVENT THOLDINFO))
|
||||
THACTION]
|
||||
@@ -654,35 +632,29 @@
|
||||
then (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
|
||||
'PENDINGDEL
|
||||
else 'NORMAL))
|
||||
(\TEDIT.FIXSEL SEL TSTREAM)
|
||||
(\TEDIT.SHOWSEL SEL T TSTREAM])
|
||||
|
||||
(\TEDIT.UNDO.REPLACE
|
||||
[LAMBDA (TSTREAM EVENT ACTION) (* ; "Edited 21-Apr-2025 22:22 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 11:58 by rmk")
|
||||
(* ; "Edited 15-Mar-2025 22:35 by rmk")
|
||||
(* ; "Edited 13-Sep-2024 23:50 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 13-Sep-2024 23:50 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:59 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 30-May-2023 23:10 by rmk")
|
||||
(* ; "Edited 27-May-2023 16:49 by rmk")
|
||||
(* ; "Edited 24-May-2023 22:43 by rmk")
|
||||
|
||||
(* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, uppercase, or initialcap.")
|
||||
(* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, or uppercase.")
|
||||
|
||||
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
|
||||
NIL TSTREAM)
|
||||
TSTREAM
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
EVENT))
|
||||
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
|
||||
THACTION ACTION])
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
|
||||
NIL TEXTOBJ)
|
||||
TEXTOBJ
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
EVENT))
|
||||
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
|
||||
THACTION ACTION])
|
||||
|
||||
(\TEDIT.UNDO.CHARLOOKS
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 21-Apr-2025 20:31 by rmk")
|
||||
(* ; "Edited 20-Apr-2025 13:39 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 14:44 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 21:59 by rmk")
|
||||
[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")
|
||||
@@ -696,60 +668,54 @@
|
||||
|
||||
(* ;; "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")
|
||||
|
||||
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
|
||||
(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 ")
|
||||
(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")
|
||||
(* ;; "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]
|
||||
(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")
|
||||
(* ;; "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
|
||||
(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.NOSEL TSTREAM)
|
||||
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
|
||||
'NORMAL)
|
||||
(\TEDIT.UPDATE.LINES TSTREAM
|
||||
'LOOKS
|
||||
(GETTH EVENT THCH#)
|
||||
(GETTH EVENT THLEN))
|
||||
(\TEDIT.SHOWSEL SEL T TSTREAM)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ
|
||||
"Character looks restored" T))
|
||||
(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.HISTORYADD TEXTOBJ EVENT])
|
||||
|
||||
(\TEDIT.UNDO.PARALOOKS
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 21-Apr-2025 20:31 by rmk")
|
||||
(* ; "Edited 20-Apr-2025 13:38 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 14:44 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 22:00 by rmk")
|
||||
[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")
|
||||
@@ -764,62 +730,60 @@
|
||||
|
||||
(* ;; "Undo the setting of paragraph looks.")
|
||||
|
||||
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
|
||||
(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 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")
|
||||
(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")
|
||||
(* ;; "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
|
||||
(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.")
|
||||
(* ;;
|
||||
"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.NOSEL TSTREAM)
|
||||
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL 'NORMAL)
|
||||
(\TEDIT.UPDATE.LINES TSTREAM 'LOOKS (GETTH EVENT THCH#)
|
||||
(GETTH EVENT THLEN))
|
||||
(\TEDIT.SHOWSEL SEL T TSTREAM)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Paragraph looks restored" T))
|
||||
(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")
|
||||
|
||||
(* ;; "Save the event for REDO, even if these pieces didn't change")
|
||||
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
|
||||
|
||||
(\TEDIT.UNDO.PAGELOOKS
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 6-Apr-2025 11:49 by rmk")
|
||||
(* ; "Edited 12-Aug-2024 10:28 by rmk")
|
||||
(SETQ TEXTOBJ (FTEXTOBJ TEXTOBJ))
|
||||
[FSETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (COPYALL (GETTH EVENT THOLDINFO))
|
||||
(SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))]
|
||||
[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 6-Apr-2025 14:44 by rmk")
|
||||
(* ; "Edited 1-Apr-2025 17:34 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 15:47 by rmk")
|
||||
[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")
|
||||
@@ -831,67 +795,28 @@
|
||||
(\TEDIT.UNDO1 TSTREAM E)
|
||||
(CL:UNLESS (EQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))(* ; "Something changed")
|
||||
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ)))
|
||||
(\TEDIT.NOSEL TSTREAM) finally (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS (GETTH EVENT
|
||||
THACTION)
|
||||
))
|
||||
(\TEDIT.SHOWSEL NIL NIL TSTREAM) finally (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))
|
||||
(\TEDIT.SCROLL.CARET TSTREAM])
|
||||
|
||||
(\TEDIT.UNDO.REPLACECODE
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 28-Mar-2025 14:22 by rmk")
|
||||
(* ; "Edited 23-Sep-2024 00:45 by rmk")
|
||||
(\TEDIT.RPLCHARCODE TSTREAM (GETTH EVENT THCH#)
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 23-Sep-2024 00:45 by rmk")
|
||||
(TEDIT.RPLCHARCODE TEXTOBJ (GETTH EVENT THCH#)
|
||||
(GETTH EVENT THOLDINFO])
|
||||
|
||||
(\TEDIT.UNDO.WRAP
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 4-Apr-2025 11:01 by rmk")
|
||||
|
||||
(* ;; "Undo the deletions and restore the original selection. But also update the undo event so that undo-undo will select the whole span.")
|
||||
|
||||
(LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
(CH# (GETSEL SEL CH#))
|
||||
(DCH (FGETSEL SEL DCH))
|
||||
(POINT (FGETSEL SEL POINT))
|
||||
UNDOEVENT)
|
||||
(\TEDIT.UNDO.COMPOSITE TSTREAM EVENT)
|
||||
(SETQ UNDOEVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
(CL:WHEN (AND UNDOEVENT (EQ :Sel (GETTH (CAR (GETTH UNDOEVENT THOLDINFO))
|
||||
THACTION)))
|
||||
(change (GETTH UNDOEVENT THOLDINFO)
|
||||
(NCONC1 (CDR DATUM)
|
||||
(\TEDIT.HISTORY.EVENT TEXTOBJ :Sel CH# DCH POINT))))])
|
||||
|
||||
(\TEDIT.UNDO.SEL
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 14:45 by rmk")
|
||||
(* ; "Edited 4-Apr-2025 10:55 by rmk")
|
||||
(LET* ((SEL (TEXTSEL (FTEXTOBJ TSTREAM)))
|
||||
(CH# (GETSEL SEL CH#))
|
||||
(DCH (FGETSEL SEL DCH))
|
||||
(POINT (FGETSEL SEL POINT)))
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
(\TEDIT.UPDATE.SEL TSTREAM (GETTH EVENT THCH#)
|
||||
(GETTH EVENT THLEN)
|
||||
(GETTH EVENT THPOINT))
|
||||
(\TEDIT.HISTORYADD TSTREAM (\TEDIT.HISTORY.EVENT TSTREAM :Sel CH# DCH POINT])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.REDO.INSERT
|
||||
[LAMBDA (TSTREAM EVENT SEL) (* ; "Edited 21-Apr-2025 22:19 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 12:09 by rmk")
|
||||
(* ; "Edited 15-Aug-2024 10:47 by rmk")
|
||||
[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")
|
||||
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL (FTEXTOBJ TSTREAM))
|
||||
'INSERT TSTREAM)
|
||||
TSTREAM SEL])
|
||||
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
|
||||
'INSERT TEXTOBJ)
|
||||
TEXTOBJ SEL])
|
||||
|
||||
(\TEDIT.REDO.REPLACE
|
||||
[LAMBDA (TSTREAM EVENT ACTION) (* ; "Edited 21-Apr-2025 22:22 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 12:14 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:59 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")
|
||||
@@ -901,31 +826,28 @@
|
||||
|
||||
(* ;; "We get the replacement from where EVENT just installed it in the text (assume that it is still there unchanged), and then we use it to replace what is now at the current selection. EVENT's deleted pieces are not relevant.")
|
||||
|
||||
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
EVENT)
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
|
||||
NIL TSTREAM)
|
||||
TSTREAM)
|
||||
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
|
||||
THACTION ACTION])
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
|
||||
NIL TEXTOBJ)
|
||||
TEXTOBJ
|
||||
(\TEDIT.UPDATE.SEL (GETTOBJ TEXTOBJ SEL)
|
||||
EVENT))
|
||||
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
|
||||
THACTION ACTION])
|
||||
|
||||
(\TEDIT.REDO.COMPOSITE
|
||||
[LAMBDA (TSTREAM EVENT SEL) (* ; "Edited 6-Apr-2025 12:12 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
[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 (5074 6095 (\TEDIT.HISTORYEVENT.DEFPRINT 5084 . 6093)) (7185 18439 (\TEDIT.HISTORYADD
|
||||
7195 . 12457) (\TEDIT.HISTORYADD.COMPOSITE 12459 . 13491) (\TEDIT.CUMULATE.EVENTS 13493 . 15087) (
|
||||
\TEDIT.COMPOSITE.EVENT 15089 . 15825) (\TEDIT.HISTORY.PROP 15827 . 17190) (\TEDIT.HISTORY.EVENT 17192
|
||||
. 18263) (\TEDIT.POPEVENT 18265 . 18437)) (18492 37479 (TEDIT.UNDO 18502 . 23378) (\TEDIT.UNDO1 23380
|
||||
. 27718) (TEDIT.REDO 27720 . 34633) (\TEDIT.UNDO.UNDO 34635 . 37477)) (37480 55955 (
|
||||
\TEDIT.UNDO.INSERT 37490 . 38615) (\TEDIT.UNDO.DELETE 38617 . 39629) (\TEDIT.UNDO.MOVE 39631 . 41284)
|
||||
(\TEDIT.UNDO.REPLACE 41286 . 42796) (\TEDIT.UNDO.CHARLOOKS 42798 . 48035) (\TEDIT.UNDO.PARALOOKS 48037
|
||||
. 51866) (\TEDIT.UNDO.PAGELOOKS 51868 . 52426) (\TEDIT.UNDO.COMPOSITE 52428 . 54028) (
|
||||
\TEDIT.UNDO.REPLACECODE 54030 . 54364) (\TEDIT.UNDO.WRAP 54366 . 55295) (\TEDIT.UNDO.SEL 55297 . 55953
|
||||
)) (55956 58929 (\TEDIT.REDO.INSERT 55966 . 56928) (\TEDIT.REDO.REPLACE 56930 . 58536) (
|
||||
\TEDIT.REDO.COMPOSITE 58538 . 58927)))))
|
||||
(FILEMAP (NIL (5191 6212 (\TEDIT.HISTORYEVENT.DEFPRINT 5201 . 6210)) (7302 17740 (\TEDIT.HISTORYADD
|
||||
7312 . 12173) (\TEDIT.HISTORYADD.COMPOSITE 12175 . 12934) (\TEDIT.CUMULATE.EVENTS 12936 . 14530) (
|
||||
\TEDIT.COMPOSITE.EVENT 14532 . 15268) (\TEDIT.HISTORY.PROP 15270 . 16633) (\TEDIT.HISTORY.EVENT 16635
|
||||
. 17564) (\TEDIT.POPEVENT 17566 . 17738)) (17793 35623 (TEDIT.UNDO 17803 . 22197) (\TEDIT.UNDO1 22199
|
||||
. 26411) (TEDIT.REDO 26413 . 32777) (\TEDIT.UNDO.UNDO 32779 . 35621)) (35624 50710 (
|
||||
\TEDIT.UNDO.INSERT 35634 . 36547) (\TEDIT.UNDO.DELETE 36549 . 37343) (\TEDIT.UNDO.MOVE 37345 . 38934)
|
||||
(\TEDIT.UNDO.REPLACE 38936 . 40032) (\TEDIT.UNDO.CHARLOOKS 40034 . 44608) (\TEDIT.UNDO.PARALOOKS 44610
|
||||
. 48842) (\TEDIT.UNDO.PAGELOOKS 48844 . 49253) (\TEDIT.UNDO.COMPOSITE 49255 . 50482) (
|
||||
\TEDIT.UNDO.REPLACECODE 50484 . 50708)) (50711 53071 (\TEDIT.REDO.INSERT 50721 . 51454) (
|
||||
\TEDIT.REDO.REPLACE 51456 . 52787) (\TEDIT.REDO.COMPOSITE 52789 . 53069)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Feb-2025 12:09:40" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;33 72260
|
||||
(FILECREATED "23-Oct-2024 16:09:28" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;27 72985
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.PUT.SINGLE.PARALOOKS2 \TEDIT.GET.SINGLE.PARALOOKS2
|
||||
\TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
|
||||
:CHANGES-TO (FNS \TEDIT.GET.SINGLE.PARALOOKS2 \TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
|
||||
|
||||
:PREVIOUS-DATE " 8-Feb-2025 22:08:39" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;31)
|
||||
:PREVIOUS-DATE "21-Oct-2024 00:34:06" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;25)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-OLDFILECOMS)
|
||||
@@ -47,8 +46,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB2
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:28 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:00 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
@@ -78,7 +76,7 @@
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(SBINABLE _ (fetch (STREAM BINABLE) of TEXT)) for I from 1 to PCCOUNT
|
||||
do (SETQ PC NIL) (* ;
|
||||
"This loop may not really read a piece, so we have to distinguish that case.")
|
||||
@@ -277,9 +275,7 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS2 FILE])
|
||||
|
||||
(\TEDIT.GET.SINGLE.CHARLOOKS2
|
||||
[LAMBDA (FILE) (* ; "Edited 7-Jan-2025 12:29 by rmk")
|
||||
(* ; "Edited 2-Jan-2025 11:09 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 22:53 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 23:22 by rmk")
|
||||
@@ -287,18 +283,18 @@
|
||||
(* ; "Edited 30-May-91 20:26 by jds")
|
||||
(* ; "Read a set of CHARLOOKS from FILE")
|
||||
(PROG* ((LOOKS (create CHARLOOKS))
|
||||
FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR BOLD ITALIC)
|
||||
FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR)
|
||||
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
|
||||
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
|
||||
(SETQ SUPER (\SMALLPIN FILE)) (* ; "Superscripting distance")
|
||||
(FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
|
||||
0))
|
||||
(FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE))
|
||||
(replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE)
|
||||
0))
|
||||
(replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE))
|
||||
(SETQ PROPS (\WIN FILE))
|
||||
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
|
||||
(with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS]
|
||||
[SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS]
|
||||
[SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
|
||||
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
|
||||
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
|
||||
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
|
||||
@@ -307,6 +303,7 @@
|
||||
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
|
||||
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
|
||||
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
|
||||
(SETQ CLSIZE SIZE)
|
||||
(SETQ CLOFFSET SUPER))
|
||||
[SETQ FONT (COND
|
||||
((LISTP NAME) (* ;
|
||||
@@ -315,17 +312,26 @@
|
||||
NAME))
|
||||
((AND NAME (NOT (ZEROP SIZE)))
|
||||
(FONTCREATE NAME SIZE (COND
|
||||
((AND BOLD ITALIC)
|
||||
((AND (fetch (CHARLOOKS CLBOLD) of LOOKS)
|
||||
(fetch (CHARLOOKS CLITAL) of LOOKS))
|
||||
'BOLDITALIC)
|
||||
(BOLD 'BOLD)
|
||||
(ITALIC 'ITALIC]
|
||||
(FSETCLOOKS LOOKS CLFONT FONT)
|
||||
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
|
||||
((fetch (CHARLOOKS CLBOLD) of LOOKS)
|
||||
'BOLD)
|
||||
((fetch (CHARLOOKS CLITAL) of LOOKS)
|
||||
'ITALIC]
|
||||
(replace (CHARLOOKS CLNAME) of LOOKS
|
||||
with (if (type? FONTCLASS FONT)
|
||||
then
|
||||
(* ;; "Put the display family in the CLNAME spot. Better than NIL.")
|
||||
|
||||
(CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T]
|
||||
(FONTPROP NAME 'FAMILY))
|
||||
else NAME))
|
||||
(replace (CHARLOOKS CLFONT) of LOOKS with FONT)
|
||||
(RETURN LOOKS])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.PARALOOKS2
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 19-Feb-2025 12:09 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:25 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 16:07 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 23:01 by rmk")
|
||||
@@ -335,16 +341,16 @@
|
||||
(* ;
|
||||
"Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
|
||||
(PROG (DEFTAB TABS OUTPUTFORMAT LEN)
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS 1STLEFTMAR)) (* ;
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS 1STLEFTMAR)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS LEFTMAR)) (* ;
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LEFTMAR)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS LEADAFTER)) (* ; "Lead after the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS LINELEAD)) (* ; "inter-line leading")
|
||||
(SETQ DEFTAB (FGETPLOOKS LOOKS FMTDEFAULTTAB))
|
||||
(SETQ TABS (FGETPLOOKS LOOKS FMTTABS))
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LEADAFTER)) (* ; "Lead after the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LINELEAD)) (* ; "inter-line leading")
|
||||
(SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB))
|
||||
(SETQ TABS (FGETPARA LOOKS FMTTABS))
|
||||
(COND
|
||||
((AND (OR DEFTAB TABS)) (* ;
|
||||
"There are tab specs to save, or there is a default tab setting to save")
|
||||
@@ -352,7 +358,7 @@
|
||||
(T (* ;
|
||||
"There are no tab looks. Just let him go.")
|
||||
(\BOUT FILE 2)))
|
||||
(\BOUT FILE (SELECTQ (FGETPLOOKS LOOKS QUAD)
|
||||
(\BOUT FILE (SELECTQ (FGETPARA LOOKS QUAD)
|
||||
(LEFT 1)
|
||||
(RIGHT 2)
|
||||
((CENTER CENTERED)
|
||||
@@ -372,27 +378,26 @@
|
||||
(CENTERED 2)
|
||||
(DECIMAL 3)
|
||||
(\TEDIT.THELP]))
|
||||
(\SMALLPOUT FILE (OR (FGETPLOOKS LOOKS FMTSPECIALX)
|
||||
(\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALX)
|
||||
0))
|
||||
(\SMALLPOUT FILE (OR (FGETPLOOKS LOOKS FMTSPECIALY)
|
||||
(\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALY)
|
||||
0))
|
||||
(\ARBOUT FILE (FGETPLOOKS LOOKS FMTUSERINFO))
|
||||
(\ATMOUT FILE (FGETPLOOKS LOOKS FMTPARATYPE))
|
||||
(\ATMOUT FILE (FGETPLOOKS LOOKS FMTPARASUBTYPE))
|
||||
(\ARBOUT FILE (FGETPLOOKS LOOKS FMTSTYLE))
|
||||
(\ARBOUT FILE (FGETPLOOKS LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FILE (FGETPLOOKS LOOKS FMTNEWPAGEBEFORE))
|
||||
(\ARBOUT FILE (FGETPLOOKS LOOKS FMTNEWPAGEAFTER])
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTUSERINFO))
|
||||
(\ATMOUT FILE (FGETPARA LOOKS FMTPARATYPE))
|
||||
(\ATMOUT FILE (FGETPARA LOOKS FMTPARASUBTYPE))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTSTYLE))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEBEFORE))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEAFTER])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.CHARLOOKS2
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 2-Jan-2025 10:51 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 23:01 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:14 by rmk")
|
||||
(* ; "Edited 30-May-91 20:26 by jds")
|
||||
(* ;
|
||||
"Put out a single CHARLOOKS description.")
|
||||
(PROG ((FONT (GETCLOOKS LOOKS CLFONT))
|
||||
(PROG ((FONT (fetch (CHARLOOKS CLFONT) of LOOKS))
|
||||
STR LEN)
|
||||
[COND
|
||||
((type? FONTCLASS FONT) (* ;
|
||||
@@ -403,54 +408,68 @@
|
||||
(\ATMOUT FILE (FONTPROP FONT 'FAMILY] (* ; "The font family")
|
||||
(\WOUT FILE (OR (FONTPROP FONT 'SIZE)
|
||||
0)) (* ; "Size of the type, in points")
|
||||
(\SMALLPOUT FILE (OR (GETCLOOKS LOOKS CLOFFSET)
|
||||
(\SMALLPOUT FILE (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS)
|
||||
0)) (* ; "Super/subscripting distance")
|
||||
(COND
|
||||
([AND (GETCLOOKS LOOKS CLSTYLE)
|
||||
(NOT (ZEROP (GETCLOOKS LOOKS CLSTYLE]
|
||||
(\ARBOUT FILE (GETCLOOKS LOOKS CLSTYLE)))
|
||||
([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS)
|
||||
(NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS]
|
||||
(\ARBOUT FILE (fetch (CHARLOOKS CLSTYLE) of LOOKS)))
|
||||
(T (\WOUT FILE 0)))
|
||||
(COND
|
||||
((GETCLOOKS LOOKS CLUSERINFO)
|
||||
(\ARBOUT FILE (GETCLOOKS LOOKS CLUSERINFO LOOKS)))
|
||||
((fetch (CHARLOOKS CLUSERINFO) of LOOKS)
|
||||
(\ARBOUT FILE (fetch (CHARLOOKS CLUSERINFO) of LOOKS)))
|
||||
(T (\WOUT FILE 0)))
|
||||
(\WOUT FILE (LOGOR (CL:IF (GETCLOOKS LOOKS CLLEADER LOOKS)
|
||||
2048
|
||||
0)
|
||||
(CL:IF (GETCLOOKS LOOKS CLINVERTED LOOKS)
|
||||
1024
|
||||
0)
|
||||
(CL:IF (EQ 'BOLD (FONTPROP FONT 'WEIGHT))
|
||||
512
|
||||
0)
|
||||
(CL:IF (EQ 'ITALIC (FONTPROP FONT 'SLOPE))
|
||||
512
|
||||
0)
|
||||
(CL:IF (GETCLOOKS LOOKS CLULINE)
|
||||
128
|
||||
0)
|
||||
(CL:IF (GETCLOOKS LOOKS CLOLINE)
|
||||
64
|
||||
0)
|
||||
(CL:IF (GETCLOOKS LOOKS CLSTRIKE)
|
||||
32
|
||||
0)
|
||||
(CL:IF (GETCLOOKS LOOKS CLSMALLCAP)
|
||||
16
|
||||
0)
|
||||
(CL:IF (GETCLOOKS LOOKS CLPROTECTED)
|
||||
8
|
||||
0)
|
||||
(CL:IF (GETCLOOKS LOOKS CLINVISIBLE)
|
||||
NIL
|
||||
4
|
||||
0)
|
||||
(CL:IF (GETCLOOKS LOOKS CLSELAFTER)
|
||||
2
|
||||
0)
|
||||
(CL:IF (GETCLOOKS LOOKS CLCANCOPY)
|
||||
1
|
||||
0)])
|
||||
(\WOUT FILE (LOGOR (COND
|
||||
((fetch (CHARLOOKS CLLEADER) of LOOKS)
|
||||
(* ;
|
||||
"Dotted-leader; relevant only to TABs")
|
||||
2048)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLINVERTED) of LOOKS)
|
||||
(* ; "Inverse-video")
|
||||
1024)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLBOLD) of LOOKS)
|
||||
512)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLITAL) of LOOKS)
|
||||
256)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLULINE) of LOOKS)
|
||||
128)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLOLINE) of LOOKS)
|
||||
64)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLSTRIKE) of LOOKS)
|
||||
32)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLSMALLCAP) of LOOKS)
|
||||
16)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLPROTECTED) of LOOKS)
|
||||
8)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLINVISIBLE) of LOOKS)
|
||||
NIL 4)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLSELAFTER) of LOOKS)
|
||||
2)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLCANCOPY) of LOOKS)
|
||||
1)
|
||||
(T 0])
|
||||
|
||||
(\TEDIT.GET.PARALOOKS.LIST2
|
||||
[LAMBDA (FILE) (* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
@@ -460,9 +479,7 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS2 FILE])
|
||||
|
||||
(\TEDIT.GET.SINGLE.PARALOOKS2
|
||||
[LAMBDA (FILE) (* ; "Edited 19-Feb-2025 12:09 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:05 by rmk")
|
||||
(* ; "Edited 23-Oct-2024 16:07 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:07 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:48 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:22 by rmk")
|
||||
@@ -474,28 +491,28 @@
|
||||
(* ; "Edited 30-May-91 20:33 by jds")
|
||||
(* ;
|
||||
"Read a paragraph format spec from the FILE, and return it for later use.")
|
||||
(LET ((PARALOOKS (create PARALOOKS))
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
TABFLG DEFTAB TABS)
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(CL:WHEN (ILEQ DEFTAB 1)
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
@@ -505,23 +522,22 @@
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPLOOKS PARALOOKS FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEAFTER (\ARBIN FILE)))
|
||||
PARALOOKS])
|
||||
(FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
|
||||
FMT])
|
||||
|
||||
(\TEDIT.PUT.CHARLOOKS.LIST2
|
||||
[LAMBDA (FILE LOOKSLIST) (* ; "Edited 16-Jan-2024 23:02 by rmk")
|
||||
@@ -575,8 +591,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB1
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Feb-2025 20:22 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:28 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:00 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
@@ -605,7 +620,7 @@
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(SBINABLE _ (fetch (STREAM BINABLE) of TEXT)) for I from 1 to PCCOUNT
|
||||
do (SETQ PC NIL) (* ;
|
||||
"This loop may not really read a piece, so we have to distinguish that case.")
|
||||
@@ -721,8 +736,7 @@
|
||||
(\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST])
|
||||
|
||||
(\TEDIT.GET.CHARLOOKS1
|
||||
[LAMBDA (PC FILE) (* ; "Edited 2-Jan-2025 11:09 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
[LAMBDA (PC FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 22:55 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 23:21 by rmk")
|
||||
@@ -733,9 +747,7 @@
|
||||
|
||||
(* ;; "Read a description of PC's CHARLOOKS from FILE. The looks are here stored in PC, not in the TEXTOBJ (uniquify later?)")
|
||||
|
||||
(LET (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR BOLD ITALIC (LOOKS (create
|
||||
CHARLOOKS))
|
||||
)
|
||||
(LET (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)))
|
||||
(FSETPC PC PLOOKS LOOKS)
|
||||
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
|
||||
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
|
||||
@@ -750,13 +762,13 @@
|
||||
(FSETPC PC PNEW T))
|
||||
(CL:UNLESS (ZEROP (BIN FILE)) (* ;
|
||||
"There is style or user information to be read")
|
||||
(FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
|
||||
0))
|
||||
(FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE)))
|
||||
(replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE)
|
||||
0))
|
||||
(replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE)))
|
||||
(SETQ PROPS (\WIN FILE))
|
||||
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
|
||||
(with CHARLOOKS LOOKS [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
|
||||
(with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
|
||||
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
|
||||
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
|
||||
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
|
||||
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
|
||||
@@ -764,27 +776,34 @@
|
||||
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
|
||||
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
|
||||
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
|
||||
(SETQ CLSIZE SIZE)
|
||||
(SETQ CLOFFSET SUPER))
|
||||
[SETQ FONT (COND
|
||||
((LISTP NAME) (* ;
|
||||
"This was a font class. Restore it.")
|
||||
(FONTCLASS (CONS 0 (CDDR NAME))
|
||||
'TEDIT-FONTCLASS))
|
||||
[(AND NAME (NOT (ZEROP SIZE)))
|
||||
(FONTCLASS (pop NAME)
|
||||
NAME))
|
||||
((AND NAME (NOT (ZEROP SIZE)))
|
||||
(FONTCREATE NAME SIZE (COND
|
||||
((AND BOLD ITALIC)
|
||||
((AND (fetch (CHARLOOKS CLBOLD) of LOOKS)
|
||||
(fetch (CHARLOOKS CLITAL) of LOOKS))
|
||||
'BOLDITALIC)
|
||||
(BOLD 'BOLD)
|
||||
(ITALIC 'ITALIC]
|
||||
(T (* ; "Should never happen")
|
||||
(FONTCREATE DEFAULTFONT]
|
||||
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
|
||||
(FSETCLOOKS LOOKS CLFONT FONT])
|
||||
((fetch (CHARLOOKS CLBOLD) of LOOKS)
|
||||
'BOLD)
|
||||
((fetch (CHARLOOKS CLITAL) of LOOKS)
|
||||
'ITALIC]
|
||||
(replace (CHARLOOKS CLNAME) of LOOKS
|
||||
with (if (type? FONTCLASS FONT)
|
||||
then
|
||||
(* ;; "Put the display family in the CLNAME spot. Better than NIL.")
|
||||
|
||||
(CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T]
|
||||
(FONTPROP NAME 'FAMILY))
|
||||
else NAME))
|
||||
(replace (CHARLOOKS CLFONT) of LOOKS with FONT])
|
||||
|
||||
(\TEDIT.GET.PARALOOKS1
|
||||
[LAMBDA (FILE) (* ; "Edited 19-Feb-2025 12:09 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:05 by rmk")
|
||||
(* ; "Edited 23-Oct-2024 16:08 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:08 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:48 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 22:00 by rmk")
|
||||
@@ -796,54 +815,53 @@
|
||||
(* ; "Edited 30-May-91 20:34 by jds")
|
||||
(* ;
|
||||
"Read a paragraph format spec from the FILE, and return it for later use.")
|
||||
(LET ((PARALOOKS (create PARALOOKS))
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
TABFLG DEFTAB)
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(* ; "Will be tab specs")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(CL:WHEN (ILEQ DEFTAB 1)
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
[FSETPLOOKS PARALOOKS FMTTABS (for TAB# from 1 to (BIN FILE)
|
||||
collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _ (SELECTQ (BIN FILE)
|
||||
(0 'LEFT)
|
||||
(1 'RIGHT)
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP])
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[FSETPARA FMT FMTTABS (for TAB# from 1 to (BIN FILE)
|
||||
collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _ (SELECTQ (BIN FILE)
|
||||
(0 'LEFT)
|
||||
(1 'RIGHT)
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP])
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEAFTER (\ARBIN FILE)))
|
||||
PARALOOKS])
|
||||
(FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
|
||||
FMT])
|
||||
|
||||
(TEDIT.GET.OBJECT1
|
||||
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk")
|
||||
@@ -882,8 +900,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB0
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Feb-2025 20:22 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:27 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 14:47 by rmk")
|
||||
@@ -904,8 +921,8 @@
|
||||
8))
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
for I from 1 to PCCOUNT
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC)) for I
|
||||
from 1 to PCCOUNT
|
||||
do (SETQ PCLEN (\DWIN TEXT))
|
||||
(SETQ PC
|
||||
(create PIECE
|
||||
@@ -945,17 +962,15 @@
|
||||
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
|
||||
|
||||
(\TEDIT.GET.CHARLOOKS0
|
||||
[LAMBDA (PC FILE) (* ; "Edited 2-Jan-2025 11:09 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
[LAMBDA (PC FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 23:03 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
(* ; "Edited 1-Aug-2022 12:04 by rmk")
|
||||
(* ; "Edited 30-May-91 20:26 by jds")
|
||||
(* ;
|
||||
"Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
|
||||
(PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR BOLD ITALIC
|
||||
(LOOKS (create CHARLOOKS)))
|
||||
(SETPC PC PLOOKS LOOKS)
|
||||
(PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)))
|
||||
(replace (PIECE PLOOKS) of PC with LOOKS)
|
||||
(SETQ NAMELEN (\WIN FILE)) (* ;
|
||||
"The length of the description which follows")
|
||||
[SETQ NAME (PACK (for I from 1 to NAMELEN collect (CHARACTER (BIN FILE]
|
||||
@@ -970,7 +985,7 @@
|
||||
|
||||
(COND
|
||||
((NOT (ZEROP (BIN FILE))) (* ; "This text is NEW. Mark it so.")
|
||||
(FSETPC PC PNEW T)))
|
||||
(replace (PIECE PNEW) of PC with T)))
|
||||
[COND
|
||||
((NOT (ZEROP (BIN FILE))) (* ;
|
||||
"There is style or user information to be read")
|
||||
@@ -978,15 +993,15 @@
|
||||
(SETQ USERSTR (\STRINGIN FILE))
|
||||
(COND
|
||||
((NOT (ZEROP (NCHARS STYLESTR))) (* ; "There IS style info")
|
||||
(FSETCLOOKS LOOKS CLSTYLE (READ STYLESTR)))
|
||||
(T (FSETCLOOKS LOOKS CLSTYLE 0)))
|
||||
(replace (CHARLOOKS CLSTYLE) of LOOKS with (READ STYLESTR)))
|
||||
(T (replace (CHARLOOKS CLSTYLE) of LOOKS with 0)))
|
||||
(COND
|
||||
((NOT (ZEROP (NCHARS USERSTR))) (* ; "There IS user info")
|
||||
(FSETCLOOKS LOOKS CLUSERINFO (READ USERSTR]
|
||||
(replace (CHARLOOKS CLUSERINFO) of LOOKS with (READ USERSTR]
|
||||
(SETQ PROPS (\WIN FILE))
|
||||
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
|
||||
(with CHARLOOKS LOOKS [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
|
||||
(with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
|
||||
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
|
||||
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
|
||||
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
|
||||
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
|
||||
@@ -994,18 +1009,22 @@
|
||||
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
|
||||
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
|
||||
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
|
||||
(SETQ CLSIZE SIZE)
|
||||
(SETQ CLOFFSET SUPER))
|
||||
(SETQ FONT (if (AND NAME (NOT (ZEROP SIZE)))
|
||||
then [FONTCREATE NAME SIZE (COND
|
||||
((AND BOLD ITALIC ITALIC)
|
||||
'BOLDITALIC)
|
||||
(BOLD 'BOLD)
|
||||
(ITALIC 'ITALIC]
|
||||
else (* ; "Should never happen")
|
||||
(FONTCREATE DEFAULTFONT)))
|
||||
(FSETCLOOKS LOOKS CLFONT FONT)
|
||||
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
|
||||
(RETURN LOOKS])
|
||||
(replace (CHARLOOKS CLFONT) of LOOKS with (AND NAME (NOT (ZEROP SIZE))
|
||||
(FONTCREATE NAME SIZE
|
||||
(COND
|
||||
((AND (fetch (CHARLOOKS CLBOLD)
|
||||
of LOOKS)
|
||||
(fetch (CHARLOOKS CLITAL)
|
||||
of LOOKS))
|
||||
'BOLDITALIC)
|
||||
((fetch (CHARLOOKS CLBOLD)
|
||||
of LOOKS)
|
||||
'BOLD)
|
||||
((fetch (CHARLOOKS CLITAL)
|
||||
of LOOKS)
|
||||
'ITALIC])
|
||||
|
||||
(\TEDIT.GET.OBJECT0
|
||||
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk")
|
||||
@@ -1039,9 +1058,7 @@
|
||||
OBJ])
|
||||
|
||||
(\TEDIT.GET.PARALOOKS0
|
||||
[LAMBDA (PC FILE) (* ; "Edited 19-Feb-2025 12:09 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:05 by rmk")
|
||||
(* ; "Edited 23-Oct-2024 16:09 by rmk")
|
||||
[LAMBDA (PC FILE) (* ; "Edited 23-Oct-2024 16:09 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:47 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:23 by rmk")
|
||||
@@ -1053,29 +1070,29 @@
|
||||
(* ; "Edited 30-May-91 20:34 by jds")
|
||||
(* ;
|
||||
"Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
|
||||
(LET ((PARALOOKS (create PARALOOKS))
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
TABFLG DEFTAB TABS)
|
||||
(SETPC PC PPARALOOKS PARALOOKS)
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(SETPC PC PPARALOOKS FMT)
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(CL:UNLESS (ZEROP TABFLG) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(CL:WHEN (ILEQ DEFTAB 1)
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
@@ -1085,20 +1102,20 @@
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPLOOKS PARALOOKS FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
PARALOOKS])
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
FMT])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1758 37224 (\TEDIT.GET.PCTB2 1768 . 12181) (\TEDIT.GET.PARALOOKS2 12183 . 12772) (
|
||||
\TEDIT.GET.CHARLOOKS2 12774 . 14105) (\TEDIT.PARSE.PAGEFRAMES2 14107 . 16846) (
|
||||
\TEDIT.GET.CHARLOOKS.LIST2 16848 . 17355) (\TEDIT.GET.SINGLE.CHARLOOKS2 17357 . 20568) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS2 20570 . 24820) (\TEDIT.PUT.SINGLE.CHARLOOKS2 24822 . 28532) (
|
||||
\TEDIT.GET.PARALOOKS.LIST2 28534 . 29041) (\TEDIT.GET.SINGLE.PARALOOKS2 29043 . 33942) (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST2 33944 . 36023) (\TEDIT.PUT.PARALOOKS.LIST2 36025 . 37222)) (37301 57923 (
|
||||
\TEDIT.GET.PCTB1 37311 . 44120) (\TEDIT.GET.PAGEFRAMES1 44122 . 44574) (\TEDIT.PARSE.PAGEFRAMES1 44576
|
||||
. 47229) (\TEDIT.GET.CHARLOOKS1 47231 . 51276) (\TEDIT.GET.PARALOOKS1 51278 . 56189) (
|
||||
TEDIT.GET.OBJECT1 56191 . 57921)) (57983 72237 (\TEDIT.GET.PCTB0 57993 . 62074) (\TEDIT.GET.CHARLOOKS0
|
||||
62076 . 66171) (\TEDIT.GET.OBJECT0 66173 . 68232) (\TEDIT.GET.PARALOOKS0 68234 . 72235)))))
|
||||
(FILEMAP (NIL (1705 37969 (\TEDIT.GET.PCTB2 1715 . 12010) (\TEDIT.GET.PARALOOKS2 12012 . 12601) (
|
||||
\TEDIT.GET.CHARLOOKS2 12603 . 13934) (\TEDIT.PARSE.PAGEFRAMES2 13936 . 16675) (
|
||||
\TEDIT.GET.CHARLOOKS.LIST2 16677 . 17184) (\TEDIT.GET.SINGLE.CHARLOOKS2 17186 . 21013) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS2 21015 . 25132) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25134 . 29718) (
|
||||
\TEDIT.GET.PARALOOKS.LIST2 29720 . 30227) (\TEDIT.GET.SINGLE.PARALOOKS2 30229 . 34687) (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST2 34689 . 36768) (\TEDIT.PUT.PARALOOKS.LIST2 36770 . 37967)) (38046 58482 (
|
||||
\TEDIT.GET.PCTB1 38056 . 44747) (\TEDIT.GET.PAGEFRAMES1 44749 . 45201) (\TEDIT.PARSE.PAGEFRAMES1 45203
|
||||
. 47856) (\TEDIT.GET.CHARLOOKS1 47858 . 52340) (\TEDIT.GET.PARALOOKS1 52342 . 56748) (
|
||||
TEDIT.GET.OBJECT1 56750 . 58480)) (58542 72962 (\TEDIT.GET.PCTB0 58552 . 62515) (\TEDIT.GET.CHARLOOKS0
|
||||
62517 . 67214) (\TEDIT.GET.OBJECT0 67216 . 69275) (\TEDIT.GET.PARALOOKS0 69277 . 72960)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
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 " 8-Feb-2025 20:56:54" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;248 68998
|
||||
(FILECREATED "27-Nov-2024 23:12:27" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;243 67795
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.MAKEPCTB)
|
||||
:CHANGES-TO (FNS \TEDIT.DELETEPIECES)
|
||||
|
||||
:PREVIOUS-DATE " 7-Feb-2025 08:31:28" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;246)
|
||||
:PREVIOUS-DATE "21-Oct-2024 00:42:44" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;242)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||
@@ -25,7 +25,7 @@
|
||||
(RECORDS BTREENODE BTSLOT)
|
||||
(MACROS \NTHSLOT \NEXTSLOT \PREVSLOT \LASTSLOT \FIRSTSLOT \MOVESLOT \FILLSLOT
|
||||
\FINDSLOT)
|
||||
(MACROS \SUFFIXPIECEP)
|
||||
(MACROS \LASTPIECEP)
|
||||
(I.S.OPRS inslots inpieces backpieces))
|
||||
(MACROS \INSURE.VACANT.BTREESLOT)
|
||||
(ADDVARS (INSPECTDONTSORTFIELDS BTREENODE)))
|
||||
@@ -138,9 +138,9 @@
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \SUFFIXPIECEP MACRO (OPENLAMBDA (PC TOBJ)
|
||||
(AND (EQ PC (FGETTOBJ TOBJ SUFFIXPIECE))
|
||||
PC)))
|
||||
(PUTPROPS \LASTPIECEP MACRO (OPENLAMBDA (PC TOBJ)
|
||||
(AND (EQ PC (ffetch (TEXTOBJ LASTPIECE) of TOBJ))
|
||||
PC)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -215,9 +215,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.MAKEPCTB
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 8-Feb-2025 20:14 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:02 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 12:41 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Dec-2023 12:41 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:09 by rmk")
|
||||
(* ; "Edited 8-Sep-2023 16:30 by rmk")
|
||||
(* ; "Edited 26-Apr-2023 14:03 by rmk")
|
||||
@@ -238,8 +236,8 @@
|
||||
PLEN _ 0
|
||||
PTREENODE _ NODE
|
||||
PLOOKS _ (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS)
|
||||
PPARALOOKS _ (GETTOBJ TEXTOBJ DEFAULTPARALOOKS)))
|
||||
(FSETTOBJ TEXTOBJ SUFFIXPIECE (ffetch (BTREENODE DOWN1) of NODE))
|
||||
PPARALOOKS _ (GETTOBJ TEXTOBJ FMTSPEC)))
|
||||
(FSETTOBJ TEXTOBJ LASTPIECE (ffetch (BTREENODE DOWN1) of NODE))
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(FSETTOBJ TEXTOBJ TEXTLEN 0)
|
||||
(FSETTOBJ TEXTOBJ PCTB (CONS NODE])
|
||||
@@ -274,8 +272,7 @@
|
||||
DELTA])
|
||||
|
||||
(\TEDIT.FIRSTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Feb-2025 08:02 by rmk")
|
||||
(* ; "Edited 21-Aug-2024 16:07 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 21-Aug-2024 16:07 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
(* ; "Edited 11-Apr-2023 12:54 by rmk")
|
||||
(* ; "Edited 24-Aug-2022 12:45 by rmk")
|
||||
@@ -288,7 +285,7 @@
|
||||
|
||||
(* ;; "If we don't bottom out in a piece, something else is screwed up. But we return NIL for the last piece, which is only there to hold the PREV pointer to the real last piece (and maybe the initial looks).")
|
||||
|
||||
(RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
NODE])
|
||||
|
||||
(\TEDIT.DELETETREE
|
||||
@@ -386,16 +383,16 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.LASTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Feb-2025 08:20 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:20 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 10:20 by rmk")
|
||||
(* ; "Edited 12-Apr-2023 19:23 by rmk")
|
||||
(* ; "Edited 21-Aug-2022 17:13 by rmk")
|
||||
(* ; "Edited 16-Aug-2022 10:16 by rmk")
|
||||
(* ; "Edited 14-Apr-93 16:29 by jds")
|
||||
|
||||
(* ;; "Returns the last real piece of the text, NIL for an empty document.")
|
||||
(* ;; "Returns the LASTPIECE by running down the right side of the B-tree. Should be the same as (fetch LASTPIECE of TEXTOBJ). Argument can also be a node.")
|
||||
|
||||
(PREVPIECE (FGETTOBJ TEXTOBJ SUFFIXPIECE])
|
||||
(bind [CHILD _ (CAR (LAST (GETTOBJ TEXTOBJ PCTB] while (type? BTREENODE CHILD)
|
||||
do (SETQ CHILD (ffetch (BTSLOT DOWN) of (\LASTSLOT CHILD))) finally (RETURN CHILD])
|
||||
|
||||
(\TEDIT.PCTOCH
|
||||
[LAMBDA (PC TEXTOBJ) (* ; "Edited 31-Oct-2023 21:05 by rmk")
|
||||
@@ -424,8 +421,7 @@
|
||||
of TOPNODE])
|
||||
|
||||
(\TEDIT.CHTOPC
|
||||
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 7-Feb-2025 08:29 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 17:56 by rmk")
|
||||
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 4-Nov-2023 17:56 by rmk")
|
||||
(* ; "Edited 1-Nov-2023 23:29 by rmk")
|
||||
(* ; "Edited 13-Apr-2023 22:22 by rmk")
|
||||
(* ; "Edited 12-Apr-2023 09:49 by rmk")
|
||||
@@ -439,7 +435,7 @@
|
||||
|
||||
(* ;; "There are 2 acceleration cases:")
|
||||
|
||||
(* ;; " if CH# is after the current text length, the pseudo SUFFIXPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.")
|
||||
(* ;; " if CH# is after the current text length, the pseudo LASTPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.")
|
||||
|
||||
(* ;; " If the TEXTOBJ contains a HINTPC and CH# is in the range HINTPCSTARTCH# and HINTPCSTARTCH#+PLEN-1, then HINTPC is returned. Others may cache that, but we cache it here too for repeated sequential calls.")
|
||||
|
||||
@@ -451,7 +447,7 @@
|
||||
(if (IGREATERP CH# (FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
then (CL:WHEN TELL-PC-START?
|
||||
(SETQ START-OF-PIECE (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN))))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
elseif (AND (SETQ HINTPC (FGETTOBJ TEXTOBJ HINTPC))
|
||||
(IGEQ CH# (SETQ STARTCH (FGETTOBJ TEXTOBJ HINTPCSTARTCH#)))
|
||||
(ILESSP (IDIFFERENCE CH# STARTCH)
|
||||
@@ -467,7 +463,7 @@
|
||||
|
||||
(* ;; "When PCTB is a list of top-level BTNODES, we find the sub-tree that contains the global CH# piece, sum the TOTLEN's of all prior top-level nodes, retrieve the piece from the identified subtree after adjusting to its LOCAL#. START-OF-PIECE, if required, is globally correct.")
|
||||
|
||||
(* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the SUFFIXPIECE case above. Also look at \INSERTPIECE.")
|
||||
(* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the LASTPIECE case above. Also look at \INSERTPIECE.")
|
||||
|
||||
(for old BASE-NODE NEXT in (FGETTOBJ TEXTOBJ PCTB)
|
||||
do (SETQ NEXT (IPLUS ALLPRIOR (ffetch (BTREENODE TOTLEN) of BASE-NODE)))
|
||||
@@ -632,17 +628,16 @@
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.MAKE.VACANT.BTREESLOT 'END TEXTOBJ)))])
|
||||
|
||||
(\TEDIT.LINKNEWPIECE
|
||||
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 7-Feb-2025 08:26 by rmk")
|
||||
(* ; "Edited 29-May-2023 23:16 by rmk")
|
||||
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 29-May-2023 23:16 by rmk")
|
||||
|
||||
(* ;; "Set up the linear-chain links to insert the piece NEW in front of the piece NEXT in its piece-chain. This doesn't deal with the btree.")
|
||||
|
||||
(* ;; "NEXT=NIL denotes the last piece SUFFIXPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")
|
||||
(* ;; "NEXT=NIL denotes the last piece LASTPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")
|
||||
|
||||
(CL:UNLESS NEXT
|
||||
(SETQ NEXT (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(SETQ NEXT (ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)))
|
||||
(LET ((NEXTPREV (PREVPIECE NEXT)))
|
||||
(freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\SUFFIXPIECEP NEXT TEXTOBJ)
|
||||
(freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\LASTPIECEP NEXT TEXTOBJ)
|
||||
NEXT))
|
||||
(* ; "NIL for last piece")
|
||||
(freplace (PIECE PREVPIECE) of NEW with NEXTPREV) (* ;
|
||||
@@ -656,8 +651,7 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.UNLINKPIECE
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:24 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:31 by rmk")
|
||||
|
||||
@@ -667,7 +661,7 @@
|
||||
(CL:WHEN PREV
|
||||
(freplace (PIECE NEXTPIECE) of PREV with (NEXTPIECE PC)))
|
||||
(freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC)
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)) with PREV])
|
||||
(ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)) with PREV])
|
||||
|
||||
(\TEDIT.SPLITPIECE
|
||||
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
@@ -738,8 +732,7 @@
|
||||
PC])
|
||||
|
||||
(\TEDIT.INSERTPIECE
|
||||
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:28 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:07 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 23:05 by rmk")
|
||||
(* ; "Edited 9-Jun-2023 22:40 by rmk")
|
||||
@@ -748,15 +741,15 @@
|
||||
|
||||
(* ;; "Insert the piece NEWPC in front of the piece NEXTPC. At the end, NEWPC appears before NEXTPC in the piece tree, and all counts and lengths are consistent.")
|
||||
|
||||
(* ;; "The last piece SUFFIXPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the suffix piece has its rightful place in the tree.")
|
||||
(* ;; "The last piece LASTPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the lastpiece has its rightful place in the tree.")
|
||||
|
||||
(* ;; "Caller guarantees that the chain links of NEW can be smashed.")
|
||||
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.INSERTPIECE 'START TEXTOBJ)
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(CL:UNLESS NEXTPC
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(* ; "Inserting at the very end")
|
||||
(LET ((PCTB (FGETTOBJ TEXTOBJ PCTB))
|
||||
LASTTREECONS)
|
||||
@@ -792,8 +785,7 @@
|
||||
NEWPC])
|
||||
|
||||
(\TEDIT.INSERTPIECES
|
||||
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:55 by rmk")
|
||||
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 20-Mar-2024 10:55 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:23 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:08 by rmk")
|
||||
@@ -811,7 +803,7 @@
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T)
|
||||
(CL:UNLESS NEXTPC
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(for PC (PREVPC _ (PREVPIECE NEXTPC)) inpieces PIECES
|
||||
do
|
||||
(* ;; "This is a variant of \INSERTPIECE specialized for filling in an empty TEXTOBJ from a piece chain. Insertion always happens before NEXTPC, and the chain-links are not smashed. ")
|
||||
@@ -827,7 +819,7 @@
|
||||
|
||||
(* ;; "PC is the final piece of the chain")
|
||||
|
||||
(CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(FSETPC PC NEXTPIECE NEXTPC))
|
||||
(FSETPC NEXTPC PREVPIECE PC)
|
||||
(CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PIECES))
|
||||
@@ -835,8 +827,7 @@
|
||||
PIECES])
|
||||
|
||||
(\TEDIT.DELETEPIECES
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 7-Feb-2025 08:08 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 12:12 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 23:03 by rmk")
|
||||
@@ -849,7 +840,7 @@
|
||||
|
||||
(* ;; "As the PC is deleted from the tree on each iteration, the original previous PREV piece is linked to PC's next, and the next PREVPIECE is linked to PREV so that the tree and the links are uninterruptably consistent.")
|
||||
|
||||
(* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection. If SPLAST is the final actual piece (its NEXTPIECE is NIL), then SUFFIXPIECE's PREVPIECE will be updated.")
|
||||
(* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection. If SPLAST is the final actual piece (its NEXTPIECE is NIL), then LASTPIECE's PREVPIECE will be updated.")
|
||||
|
||||
(* ;; " Since the pieces are not unlinked on the fly, the tree may be invalid until all the pieces are gone.")
|
||||
|
||||
@@ -860,7 +851,7 @@
|
||||
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
|
||||
(* ; "For incremental chain-update")
|
||||
(SETQ NEXT (OR (NEXTPIECE (GETSPC SELPIECES SPLAST))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T) inselpieces SELPIECES
|
||||
do (UNINTERRUPTABLY
|
||||
(\TEDIT.UPDATEPCNODES PC (IMINUS (PLEN PC))
|
||||
@@ -884,8 +875,7 @@
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'AFTER TEXTOBJ])
|
||||
|
||||
(\TEDIT.ALIGNEDPIECE
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 7-Feb-2025 08:05 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
(* ; "Edited 29-May-2023 23:48 by rmk")
|
||||
(* ; "Edited 20-May-2023 13:53 by rmk")
|
||||
@@ -900,7 +890,7 @@
|
||||
then
|
||||
(* ;; "Doesn't return NIL in this case, returns the last piece.")
|
||||
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
elseif (ILEQ CHNO 1)
|
||||
then (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
else (LET (PC START-OF-PIECE)
|
||||
@@ -966,14 +956,13 @@
|
||||
T])
|
||||
|
||||
(\TEDIT.CHECK-BTREE
|
||||
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 7-Feb-2025 08:07 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:25 by rmk")
|
||||
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 17-Mar-2024 00:25 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:33 by rmk")
|
||||
(* ; "Edited 7-Sep-2022 09:43 by rmk")
|
||||
(* ; "Edited 4-Sep-2022 16:37 by rmk")
|
||||
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
(for BT (SUFFIXPIECE _ (FGETTOBJ TEXTOBJ SUFFIXPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
|
||||
declare (SPECVARS SUFFIXPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
|
||||
(for BT (LASTPIECE _ (FGETTOBJ TEXTOBJ LASTPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
|
||||
declare (SPECVARS LASTPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
|
||||
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
do (SELECTC (PTYPE PC)
|
||||
(FILE.PTYPES (CL:UNLESS (STREAMP (PCONTENTS PC))
|
||||
@@ -1000,8 +989,7 @@
|
||||
'VALID])
|
||||
|
||||
(\TEDIT.CHECK-BTREE1
|
||||
[LAMBDA (NODE DEPTH PARENT) (* ; "Edited 7-Feb-2025 08:31 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:35 by rmk")
|
||||
[LAMBDA (NODE DEPTH PARENT) (* ; "Edited 31-Oct-2023 10:35 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:06 by rmk")
|
||||
(* ; "Edited 27-May-2023 15:00 by rmk")
|
||||
(* ; "Edited 1-Sep-2022 09:49 by rmk")
|
||||
@@ -1011,30 +999,30 @@
|
||||
(* ;;
|
||||
"Returns the TOTLEN/PLEN of NODE, after verifying that all of the nodes underneath are consistent.")
|
||||
|
||||
(DECLARE (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ SUFFIXPIECE))
|
||||
(DECLARE (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ LASTPIECE))
|
||||
(ADD DEPTH 1)
|
||||
(if (type? PIECE NODE)
|
||||
then [if (EQ NODE SUFFIXPIECE)
|
||||
then (CL:WHEN (AND (PREVPIECE SUFFIXPIECE)
|
||||
(NEXTPIECE (PREVPIECE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "(NEXT (PPREV of SUFFIXPIECE is not NULL" SUFFIXPIECE))
|
||||
then [if (EQ NODE LASTPIECE)
|
||||
then (CL:WHEN (AND (PREVPIECE LASTPIECE)
|
||||
(NEXTPIECE (PREVPIECE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "(NEXT (PPREV of LASTPIECE is not NULL" LASTPIECE))
|
||||
else (CL:UNLESS (IGEQ (PLEN NODE)
|
||||
0)
|
||||
(\TEDIT.BTFAIL "Negative PLEN" NODE))
|
||||
(CL:UNLESS (OR (NEXTPIECE NODE)
|
||||
(EQ NODE (PREVPIECE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of SUFFIXPIECE" NODE))
|
||||
(EQ NODE (PREVPIECE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of LASTPIECE" NODE))
|
||||
(CL:UNLESS (EQ PARENT (fetch (PIECE PTREENODE) of NODE))
|
||||
(\TEDIT.BTFAIL "Piece with wrong PTREENODE" NODE))
|
||||
(CL:WHEN (PREVPIECE NODE)
|
||||
(CL:UNLESS (OR (EQ NODE (NEXTPIECE (PREVPIECE NODE)))
|
||||
(AND (NULL (NEXTPIECE (PREVPIECE NODE)))
|
||||
(EQ NODE SUFFIXPIECE)))
|
||||
(EQ NODE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "PREVPIECE is not consistent" NODE)))
|
||||
(CL:WHEN (OR (NEXTPIECE NODE)
|
||||
SUFFIXPIECE)
|
||||
LASTPIECE)
|
||||
(CL:UNLESS (EQ NODE (PREVPIECE (OR (NEXTPIECE NODE)
|
||||
SUFFIXPIECE)))
|
||||
LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "NEXTPIECE is not consistent" NODE)))]
|
||||
(add NPIECES 1)
|
||||
(add [CDR (OR (SASSOC DEPTH DEPTHHIST)
|
||||
@@ -1110,13 +1098,13 @@
|
||||
(GLOBALVARS BTVALIDATETAGS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8685 56524 (\TEDIT.MAKEPCTB 8695 . 10475) (\TEDIT.UPDATEPCNODES 10477 . 12771) (
|
||||
\TEDIT.FIRSTPIECE 12773 . 14180) (\TEDIT.DELETETREE 14182 . 17456) (\TEDIT.INSERTTREE 17458 . 20203) (
|
||||
\TEDIT.LASTPIECE 20205 . 21012) (\TEDIT.PCTOCH 21014 . 23111) (\TEDIT.CHTOPC 23113 . 29290) (
|
||||
\TEDIT.SET-TOTLEN 29292 . 30080) (\TEDIT.MAKE.VACANT.BTREESLOT 30082 . 36812) (\TEDIT.LINKNEWPIECE
|
||||
36814 . 38403) (\TEDIT.UNLINKPIECE 38405 . 39225) (\TEDIT.SPLITPIECE 39227 . 43883) (
|
||||
\TEDIT.INSERTPIECE 43885 . 47157) (\TEDIT.INSERTPIECES 47159 . 50251) (\TEDIT.DELETEPIECES 50253 .
|
||||
54407) (\TEDIT.ALIGNEDPIECE 54409 . 56522)) (56552 68875 (\TEDIT.BTVALIDATE 56562 . 58103) (
|
||||
\TEDIT.BTVALIDATE.PRINT 58105 . 59470) (\TEDIT.CHECK-BTREE 59472 . 61799) (\TEDIT.CHECK-BTREE1 61801
|
||||
. 67432) (\TEDIT.BTFAIL 67434 . 67856) (\TEDIT.MATCHPCS 67858 . 68873)))))
|
||||
(FILEMAP (NIL (8698 55567 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
|
||||
\TEDIT.FIRSTPIECE 12557 . 13853) (\TEDIT.DELETETREE 13855 . 17129) (\TEDIT.INSERTTREE 17131 . 19876) (
|
||||
\TEDIT.LASTPIECE 19878 . 20814) (\TEDIT.PCTOCH 20816 . 22913) (\TEDIT.CHTOPC 22915 . 28977) (
|
||||
\TEDIT.SET-TOTLEN 28979 . 29767) (\TEDIT.MAKE.VACANT.BTREESLOT 29769 . 36499) (\TEDIT.LINKNEWPIECE
|
||||
36501 . 37994) (\TEDIT.UNLINKPIECE 37996 . 38724) (\TEDIT.SPLITPIECE 38726 . 43382) (
|
||||
\TEDIT.INSERTPIECE 43384 . 46537) (\TEDIT.INSERTPIECES 46539 . 49518) (\TEDIT.DELETEPIECES 49520 .
|
||||
53561) (\TEDIT.ALIGNEDPIECE 53563 . 55565)) (55595 67672 (\TEDIT.BTVALIDATE 55605 . 57146) (
|
||||
\TEDIT.BTVALIDATE.PRINT 57148 . 58513) (\TEDIT.CHECK-BTREE 58515 . 60727) (\TEDIT.CHECK-BTREE1 60729
|
||||
. 66229) (\TEDIT.BTFAIL 66231 . 66653) (\TEDIT.MATCHPCS 66655 . 67670)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
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,36 +1,20 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "29-Jun-2025 21:59:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDIT>TEDIT-STRESS.;125 42815
|
||||
(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 STRESSFORMAT STRESSSCROLL
|
||||
STRESSDELETE STRESSDELETEWINDOW STRESSINSERTWINDOW STRESSGREP STRESSPEEK
|
||||
STRESSINSERT STRESS-SETUP STRESS-SYSOUT SYSOUTRING STRESSDISPLAY)
|
||||
(VARS TEDIT-STRESSCOMS)
|
||||
:CHANGES-TO (FNS STRESSHC STRESSPUT EQTEXTSTREAM)
|
||||
|
||||
:PREVIOUS-DATE "26-Jun-2025 20:58:11" {WMEDLEY}<library>tedit>TEDIT-STRESS.;120)
|
||||
:PREVIOUS-DATE "19-Mar-2024 21:34:32" {WMEDLEY}<library>tedit>TEDIT-STRESS.;70)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STRESSCOMS)
|
||||
|
||||
(RPAQQ TEDIT-STRESSCOMS
|
||||
( (* ; "Preload typical image objects")
|
||||
(FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSFORMAT STRESSDISPLAY
|
||||
STRESSSCROLL STRESSDELETE STRESSDELETEWINDOW STRESSINSERT STRESSINSERTWINDOW STRESSGREP
|
||||
STRESSPEEK)
|
||||
(FNS STRESS-SETUP STRESS-SYSOUT STRESS-AFTERSYSOUT SYSOUTRING SYSOUTNAME SYSOUTRING
|
||||
SYSOUTNAME)
|
||||
(FNS EQTEXTSTREAM COPYTOCORE CHECKARRAYS SAVERANDSTATE)
|
||||
(INITVARS (CHECKARRAYS NIL)
|
||||
(USELASTRANDSTATE NIL)
|
||||
(SYSOUTLEVEL NIL)
|
||||
(NSYSOUTS 0))
|
||||
(VARS (ARRAYBLOCKCHECKING T))
|
||||
(APPENDVARS (AFTERSYSOUTFORMS (STRESS-AFTERSYSOUT)))
|
||||
(FILES TEDIT-DEBUG)
|
||||
(MACROS STRESS)))
|
||||
(RPAQQ TEDIT-STRESSCOMS ( (* ; "Preload typical image objects")
|
||||
(FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSGREP
|
||||
STRESSPEEK)
|
||||
(FNS EQTEXTSTREAM SYSOUTRING COPYTOCORE)))
|
||||
|
||||
|
||||
|
||||
@@ -39,9 +23,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(STRESSHC
|
||||
[LAMBDA (FILES REPS ERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)
|
||||
(* ; "Edited 29-Jun-2025 21:58 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:27 by rmk")
|
||||
[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")
|
||||
@@ -50,8 +32,11 @@
|
||||
|
||||
(* ;; "If all arguments are defaulted, runs through all TEDIT files in the current directory until it fails, doing SAVEVM before each file. The HC files are made as {CORE}FOO.PS.")
|
||||
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSHC))
|
||||
(CL:UNLESS FILES
|
||||
(SETQ FILES (FILDIR '*.TEDIT;)))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(CL:UNLESS NSYSOUTS
|
||||
(SETQ NSYSOUTS 'SAVEVM))
|
||||
[SETQ SYSOUTNAME (PACKFILENAME 'VERSION NIL 'BODY (OR SYSOUTNAME (PACKFILENAME 'DIRECTORY
|
||||
MEDLEYDIR 'NAME
|
||||
"STRESSHC" 'EXTENSION
|
||||
@@ -71,559 +56,189 @@
|
||||
(for R SYSOUTS (ITYPE _ (CL:IF PDF
|
||||
'pdf
|
||||
'ps))
|
||||
(N _ 0) from 1 to REPS do (PRINTOUT T "Rep " R T)
|
||||
(if (EQ NSYSOUTS 'SAVEVM)
|
||||
then (SAVEVM)
|
||||
else (SETQ SYSOUTS (SYSOUTRING NSYSOUTS SYSOUTNAME SYSOUTS)))
|
||||
[for F TSTREAM HCFILE in FILES unless (DIRECTORYNAMEP F)
|
||||
do (PROMPTPRINT F)
|
||||
(SETQ HCFILE (CL:IF SEPARATEOUT
|
||||
(OUTFILEP (PACKFILENAME 'EXTENSION ITYPE
|
||||
'VERSION 1 'BODY F))
|
||||
(CL:IF PDF
|
||||
"{CORE}FOO.PDF;1"
|
||||
"{CORE}FOO.PS;1")))
|
||||
[STRESS (NOT ERROR)
|
||||
(SETQ TSTREAM (OPENTEXTSTREAM F))
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(TEDIT.FORMAT.HARDCOPY TSTREAM HCFILE T NIL NIL NIL
|
||||
(CL:IF PDF
|
||||
'PDF
|
||||
'POSTSCRIPT)]
|
||||
(CL:WHEN SINGLESTEP
|
||||
(\TEDIT.THELP (CONCAT "Just hardcopied " F " to " HCFILE
|
||||
)))]
|
||||
(PRINTOUT T " Hardcopied " N " files without failure" T)
|
||||
(N _ 0) from 1 to REPS
|
||||
do (PRINTOUT T "Rep " R T)
|
||||
(if (EQ NSYSOUTS 'SAVEVM)
|
||||
then (SAVEVM)
|
||||
else (SETQ SYSOUTS (SYSOUTRING NSYSOUTS SYSOUTNAME SYSOUTS)))
|
||||
[for F TSTRM HCFILE inside FILES
|
||||
do (PROMPTPRINT F)
|
||||
(SETQ HCFILE (CL:IF SEPARATEOUT
|
||||
(OUTFILEP (PACKFILENAME 'EXTENSION ITYPE 'VERSION 1 'BODY F))
|
||||
(CL:IF PDF
|
||||
"{CORE}FOO.PDF;1"
|
||||
"{CORE}FOO.PS;1")))
|
||||
(if [if ERROR
|
||||
then (SETQ TSTRM (OPENTEXTSTREAM F))
|
||||
(TEDIT.FORMAT.HARDCOPY TSTRM HCFILE T NIL NIL NIL (CL:IF PDF
|
||||
'PDF
|
||||
'POSTSCRIPT))
|
||||
else (NLSETQ (SETQ TSTRM (OPENTEXTSTREAM F))
|
||||
(TEDIT.FORMAT.HARDCOPY TSTRM HCFILE T NIL NIL NIL
|
||||
(CL:IF PDF
|
||||
'PDF
|
||||
'POSTSCRIPT)]
|
||||
then (add N 1)
|
||||
else (PRINTOUT T " Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
|
||||
T))
|
||||
(CLOSEF? TSTRM)
|
||||
(CL:WHEN SINGLESTEP
|
||||
(\TEDIT.THELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
|
||||
(PRINTOUT T " Hardcopied " N " files without failure" T)
|
||||
finally (RETURN (LIST R N])
|
||||
|
||||
(STRESSRAND
|
||||
[LAMBDA (FILES REPS ERROR PROBESPERFILE) (* ; "Edited 29-Jun-2025 21:58 by rmk")
|
||||
(* ; "Edited 5-Jun-2025 21:10 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:27 by rmk")
|
||||
(* ; "Edited 31-May-2025 09:10 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:33 by rmk")
|
||||
[LAMBDA (FILES REPS ERROR PROBESPERFILE) (* ; "Edited 19-Mar-2024 21:33 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:47 by rmk")
|
||||
|
||||
(* ;; "Opens, fetches random characters")
|
||||
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSRAND))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(CL:UNLESS FILES
|
||||
(SETQ FILES (FILDIR '*.TEDIT;)))
|
||||
(SETQ REPS (SELECTQ REPS
|
||||
(T MAX.SMALLP)
|
||||
(NIL 1)
|
||||
REPS))
|
||||
(CL:UNLESS PROBESPERFILE (SETQ PROBESPERFILE 100))
|
||||
(BKSYSBUF " ")
|
||||
(PRINTOUT T REPS " reps of " (LENGTH FILES)
|
||||
" files with " PROBESPERFILE " probes per file" T)
|
||||
(SAVERANDSTATE)
|
||||
(for R (N _ 0) from 1 to REPS
|
||||
do (PRINTOUT T R " ")
|
||||
[for F TSTREAM in FILES unless (DIRECTORYNAMEP F)
|
||||
do (STRESS (NOT ERROR)
|
||||
(SETQ TSTREAM (OPENTEXTSTREAM F))
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(for I (LEN _ (TEDIT.NCHARS TSTREAM)) from 1 to PROBESPERFILE
|
||||
do (TEDIT.NTHCHARCODE TSTREAM (RAND 1 LEN]
|
||||
finally (RETURN (LIST R N])
|
||||
(for F TSTRM inside FILES
|
||||
do (if (if ERROR
|
||||
then (SETQ TSTRM (OPENTEXTSTREAM F))
|
||||
(for I (LEN _ (TEDIT.NCHARS TSTRM)) from 1 to PROBESPERFILE
|
||||
do (TEDIT.NTHCHARCODE TSTRM (RAND 1 LEN)))
|
||||
T
|
||||
else (CAR (NLSETQ (SETQ TSTRM (OPENTEXTSTREAM F))
|
||||
(for I (LEN _ (TEDIT.NCHARS TSTRM)) from 1 to PROBESPERFILE
|
||||
do (TEDIT.NTHCHARCODE TSTRM (RAND 1 LEN)))
|
||||
T)))
|
||||
then (CLOSEF TSTRM)
|
||||
(add N 1)
|
||||
else (PRINTOUT T " Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
|
||||
T)) repeatwhile (PROGN (CLOSEF? TSTRM)
|
||||
T)) finally (RETURN (LIST R N])
|
||||
|
||||
(STRESSPUT
|
||||
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 29-Jun-2025 21:58 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:28 by rmk")
|
||||
(* ; "Edited 31-May-2025 09:10 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 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")
|
||||
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSPUT))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(BKSYSBUF " ")
|
||||
(CL:UNLESS FILES
|
||||
(SETQ FILES (FILDIR '*.TEDIT;)))
|
||||
(SETQ REPS (SELECTQ REPS
|
||||
(T MAX.SMALLP)
|
||||
(NIL 1)
|
||||
REPS))
|
||||
(PRINTOUT T REPS " reps of " (LENGTH FILES)
|
||||
" files" T)
|
||||
(for R (N _ 0) from 1 to REPS
|
||||
do (PRINTOUT T R " ")
|
||||
(for F TSTREAM TSP in FILES unless (DIRECTORYNAMEP F)
|
||||
do (STRESS NOERROR (SETQ TSTREAM (OPENTEXTSTREAM F))
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(TEDIT.PUT TSTREAM "{CORE}FOO.TEDIT;1")
|
||||
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
|
||||
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTREAM TSP STOP)))
|
||||
(\TEDIT.THELP "Get of put not equivalent" F))
|
||||
(CLOSEF TSP))) finally (RETURN (LIST R N])
|
||||
(for F TSTRM TSP inside FILES
|
||||
do (if (if NOERROR
|
||||
then (NLSETQ (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)))
|
||||
(\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)))
|
||||
(\TEDIT.THELP "Get of put not equivalent" F))
|
||||
(CLOSEF TSP))
|
||||
then (CLOSEF TSTRM)
|
||||
(add N 1)
|
||||
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
|
||||
T))) finally (RETURN (LIST R N])
|
||||
|
||||
(STRESSOPEN
|
||||
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:55 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:28 by rmk")
|
||||
(* ; "Edited 31-May-2025 09:12 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 09:15 by rmk")
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSOPEN))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(BKSYSBUF " ")
|
||||
(CL:UNLESS FILES
|
||||
(SETQ FILES (FILDIR '*.TEDIT;)))
|
||||
(SETQ REPS (SELECTQ REPS
|
||||
(T MAX.SMALLP)
|
||||
(NIL 1)
|
||||
REPS))
|
||||
(PRINTOUT T REPS " reps of " (LENGTH FILES)
|
||||
" files" T)
|
||||
(for R (N _ 0) from 1 to REPS do (PRINTOUT T R " ")
|
||||
[for F TSTREAM in FILES unless (DIRECTORYNAMEP F)
|
||||
do (STRESS NOERROR (SETQ TSTREAM (OPENTEXTSTREAM F]
|
||||
finally (RETURN (LIST R N])
|
||||
|
||||
(STRESSREAD
|
||||
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:56 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:28 by rmk")
|
||||
(* ; "Edited 31-May-2025 09:13 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 15:19 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 09:13 by rmk")
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSREAD))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(BKSYSBUF " ")
|
||||
(PRINTOUT T REPS " reps of " (LENGTH FILES)
|
||||
" files" T)
|
||||
(for R (N _ 0) from 1 to REPS do (PRINTOUT T R " ")
|
||||
[for F TSTREAM in FILES unless (DIRECTORYNAMEP F)
|
||||
do (STRESS NOERROR (SETQ TSTREAM (OPENTEXTSTREAM F))
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(for I from 1 while (TEDIT.NTHCHARCODE TSTREAM I]
|
||||
finally (RETURN (LIST (SUB1 R)
|
||||
N])
|
||||
|
||||
(STRESSFORMAT
|
||||
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:56 by rmk")
|
||||
(* ; "Edited 23-Jun-2025 12:34 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:28 by rmk")
|
||||
(* ; "Edited 31-May-2025 09:19 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 15:19 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 09:13 by rmk")
|
||||
|
||||
(* ;; "Calls FORMATLINE from beginning to end of each file")
|
||||
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSFORMAT))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(BKSYSBUF " ")
|
||||
(PRINTOUT T REPS " reps of " (LENGTH FILES)
|
||||
" files" T)
|
||||
(for R (N _ 0) from 1 to REPS do (PRINTOUT T R " ")
|
||||
[for F TSTREAM TEXTOBJ in FILES unless (DIRECTORYNAMEP F)
|
||||
do (SETQ TSTREAM (OPENTEXTSTREAM F))
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(STRESS NOERROR (bind LINE (NCHARS _ (TEDIT.NCHARS TSTREAM
|
||||
))
|
||||
(CHNO _ 1)
|
||||
while (ILESSP CHNO NCHARS)
|
||||
do (CHECKARRAYS 'BEFORE)
|
||||
(SETQ LINE (\TEDIT.FORMATLINE
|
||||
TSTREAM CHNO))
|
||||
(CHECKARRAYS 'AFTER)
|
||||
(SETQ CHNO (GETLD LINE LCHARLIM]
|
||||
finally (RETURN (LIST (SUB1 R)
|
||||
N])
|
||||
|
||||
(STRESSDISPLAY
|
||||
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:14 by rmk")
|
||||
(* ; "Edited 23-Jun-2025 12:34 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:29 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 15:19 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 09:13 by rmk")
|
||||
|
||||
(* ;; "Creates a single empty window, gets each file into that window without a process, and then displays every line there")
|
||||
|
||||
[SETQ FILES (OR (MKLIST FILES)
|
||||
(FILDIR '*.TEDIT;]
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(BKSYSBUF " ")
|
||||
(PRINTOUT T REPS " reps of " (LENGTH FILES)
|
||||
" files" T)
|
||||
(for R [WINDOW _ (CREATEW '(600 800 800 150]
|
||||
(N _ 0) from 1 to REPS
|
||||
do (PRINTOUT T R " ")
|
||||
(for F TSTREAM TEXTOBJ in FILES unless (DIRECTORYNAMEP F)
|
||||
do (* ; "No process")
|
||||
(STRESS NOERROR (WINDOWPROP WINDOW 'TITLE (CONCAT "Fetching " F))
|
||||
[SETQ TSTREAM (OPENTEXTSTREAM F WINDOW '(READONLY T LEAVETTY T]
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(bind LINE (NCHARS _ (TEDIT.NCHARS TSTREAM))
|
||||
(CHNO _ 1) while (ILESSP CHNO NCHARS) do (CHECKARRAYS 'BEFOREFORMAT)
|
||||
(SETQ LINE (\TEDIT.FORMATLINE
|
||||
TSTREAM CHNO))
|
||||
(CHECKARRAYS 'BEFOREDISPLAY)
|
||||
(\TEDIT.DISPLAYLINE TSTREAM
|
||||
LINE WINDOW)
|
||||
(CHECKARRAYS 'AFTERDISPLAY)
|
||||
(SETQ CHNO (GETLD LINE LCHARLIM
|
||||
)))
|
||||
(CHECKARRAYS 'BEFOREDEACTIVATE)
|
||||
(TEDIT.DEACTIVATE.WINDOW WINDOW)
|
||||
(CHECKARRAYS 'AFTERDEACTIVATE)
|
||||
(CLEARW WINDOW))) finally (RETURN (LIST (SUB1 R)
|
||||
N])
|
||||
|
||||
(STRESSSCROLL
|
||||
[LAMBDA (FILES NSCROLLS REPS NOERROR) (* ; "Edited 29-Jun-2025 21:56 by rmk")
|
||||
(* ; "Edited 5-Jun-2025 21:11 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:29 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 15:19 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 09:13 by rmk")
|
||||
|
||||
(* ;; "Creates a single empty window, gets each file into that window without a process, and then does NSCROLLS random scrolls before moving on to the next file.")
|
||||
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSSCROLL))
|
||||
(CL:UNLESS NSCROLLS (SETQ NSCROLLS 10))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(BKSYSBUF " ")
|
||||
(PRINTOUT T "STRESS SCROLL: " REPS " reps randomly scrolling " NSCROLLS " times in " (LENGTH
|
||||
FILES)
|
||||
" files" T)
|
||||
(SAVERANDSTATE)
|
||||
(for R [WINDOW _ (CREATEW '(600 500 750 400]
|
||||
(N _ 0) from 1 to REPS
|
||||
do (PRINTOUT T R " ")
|
||||
(for F TSTREAM TEXTOBJ LEN in FILES unless (DIRECTORYNAMEP F)
|
||||
do (* ; "No process")
|
||||
(WINDOWPROP WINDOW 'TITLE (CONCAT "Fetching " F))
|
||||
[STRESS NOERROR [SETQ TSTREAM (OPENTEXTSTREAM F WINDOW '(READONLY T LEAVETTY T]
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(SETQ LEN (TEDIT.NCHARS TSTREAM))
|
||||
(for I from 1 to NSCROLLS do (CHECKARRAYS 'BEFORE)
|
||||
(TEDIT.SETSEL TSTREAM (RAND 1 LEN)
|
||||
1)
|
||||
(TEDIT.NORMALIZECARET TSTREAM NIL T)
|
||||
(CHECKARRAYS 'AFTER]
|
||||
(TEDIT.DEACTIVATE.WINDOW WINDOW)
|
||||
(CLEARW WINDOW)) finally (RETURN (LIST (SUB1 R)
|
||||
N])
|
||||
|
||||
(STRESSDELETE
|
||||
[LAMBDA (FILES NTIMES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:56 by rmk")
|
||||
(* ; "Edited 5-Jun-2025 21:11 by rmk")
|
||||
(* ; "Edited 4-Jun-2025 09:20 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:29 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 15:19 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 09:13 by rmk")
|
||||
|
||||
(* ;;
|
||||
"For each file does NDELETES random single-character deletes before moving on to the next file.")
|
||||
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSDELETE))
|
||||
(CL:UNLESS NTIMES (SETQ NTIMES 10))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(BKSYSBUF " ")
|
||||
(PRINTOUT T "STRESS DELETE: " REPS " reps randomly deleting 1 character " NTIMES " times in "
|
||||
(LENGTH FILES)
|
||||
" files" T)
|
||||
(SAVERANDSTATE)
|
||||
(for R (N _ 0) from 1 to REPS
|
||||
do (PRINTOUT T R " ")
|
||||
(for F TSTREAM TEXTOBJ LEN in FILES unless (DIRECTORYNAMEP F)
|
||||
do (* ; "No process")
|
||||
(STRESS NOERROR [SETQ TSTREAM (OPENTEXTSTREAM F NIL '(LEAVETTY T HISTORY OFF]
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(SETQ LEN (TEDIT.NCHARS TSTREAM))
|
||||
(for I from 1 to NTIMES do (CHECKARRAYS 'BEFORE)
|
||||
(TEDIT.DELETE TSTREAM (RAND 1 LEN)
|
||||
1)
|
||||
(CHECKARRAYS 'AFTER)
|
||||
(add LEN -1))
|
||||
(CLOSEF? TSTREAM))) finally (RETURN (LIST (SUB1 R)
|
||||
N])
|
||||
(for F TSTRM inside FILES do (if (if NOERROR
|
||||
then (NLSETQ (SETQ TSTRM (OPENTEXTSTREAM F)))
|
||||
else (SETQ TSTRM (OPENTEXTSTREAM F)))
|
||||
then (CLOSEF TSTRM)
|
||||
(add N 1)
|
||||
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL
|
||||
'DIRECTORY NIL
|
||||
'BODY F)
|
||||
T))) finally (RETURN (LIST R N])
|
||||
|
||||
(STRESSDELETEWINDOW
|
||||
[LAMBDA (FILES NTIMES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:56 by rmk")
|
||||
(* ; "Edited 5-Jun-2025 21:11 by rmk")
|
||||
(* ; "Edited 4-Jun-2025 09:19 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 22:35 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(STRESSREAD
|
||||
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 15:19 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 09:13 by rmk")
|
||||
|
||||
(* ;; "Creates a single empty window, gets each file into that window without a process, and then does NTIMES random 1-character deletions before moving on to the next file.")
|
||||
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSDELETEWINDOW))
|
||||
(CL:UNLESS NTIMES (SETQ NTIMES 10))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(BKSYSBUF " ")
|
||||
(PRINTOUT T "STRESS INSERT: " REPS " reps randomly inserting 3 characters " NTIMES " times in "
|
||||
(LENGTH FILES)
|
||||
(CL:UNLESS FILES
|
||||
(SETQ FILES (FILDIR '*.TEDIT;)))
|
||||
(SETQ REPS (SELECTQ REPS
|
||||
(T MAX.SMALLP)
|
||||
(NIL 1)
|
||||
REPS))
|
||||
(PRINTOUT T REPS " reps of " (LENGTH FILES)
|
||||
" files" T)
|
||||
(SAVERANDSTATE)
|
||||
(for R [WINDOW _ (CREATEW '(550 800 750 150]
|
||||
(N _ 0) from 1 to REPS
|
||||
(for R (N _ 0) from 1 to REPS
|
||||
do (PRINTOUT T R " ")
|
||||
(for F TSTREAM TEXTOBJ LEN in FILES unless (DIRECTORYNAMEP F)
|
||||
do (* ; "No process")
|
||||
(WINDOWPROP WINDOW 'TITLE (CONCAT "Fetching " F))
|
||||
(STRESS NOERROR [SETQ TSTREAM (OPENTEXTSTREAM F WINDOW '(LEAVETTY T HISTORY OFF]
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(SETQ LEN (TEDIT.NCHARS TSTREAM))
|
||||
(for I from 1 to NTIMES do (CHECKARRAYS 'BEFORE)
|
||||
(TEDIT.DELETE TSTREAM (RAND 1 LEN))
|
||||
(CHECKARRAYS 'AFTER)
|
||||
(add LEN -1)))
|
||||
(PUTTEXTPROP TSTREAM 'DIRTY NIL)
|
||||
(TEDIT.DEACTIVATE.WINDOW WINDOW)
|
||||
(CLEARW WINDOW)) finally (RETURN (LIST (SUB1 R)
|
||||
N])
|
||||
|
||||
(STRESSINSERT
|
||||
[LAMBDA (FILES NTIMES REPS NOERROR SYSOUTNAME) (* ; "Edited 29-Jun-2025 21:18 by rmk")
|
||||
(* ; "Edited 26-Jun-2025 20:19 by rmk")
|
||||
(* ; "Edited 5-Jun-2025 21:11 by rmk")
|
||||
(* ; "Edited 4-Jun-2025 09:18 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 22:34 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 15:19 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 09:13 by rmk")
|
||||
|
||||
(* ;; "Does random inserts in the tstreams without a window or process")
|
||||
|
||||
(DECLARE (SPECVARS SYSOUTNAME))
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSINSERT))
|
||||
(CL:UNLESS NTIMES (SETQ NTIMES 10))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(PRINTOUT T T "STRESSINSERT: " T 2 REPS " reps randomly inserting 3 characters " NTIMES
|
||||
" times in " (LENGTH FILES)
|
||||
" files" T)
|
||||
(PRINTOUT T 2 "Saving " (if (EQ NSYSOUTS 0)
|
||||
then "no sysouts"
|
||||
elseif (EQ NSYSOUTS 'SAVEVM)
|
||||
then " the virtual memory"
|
||||
else (PRINTOUT NIL NSYSOUTS " sysouts on ")
|
||||
(PSEUDOFILENAME SYSOUTNAME))
|
||||
T)
|
||||
(SAVERANDSTATE)
|
||||
(for REP SYSOUTS AFTERCRASH (N _ 0) from 1 to REPS declare (SPECVARS SYSOUTS AFTERCRASH)
|
||||
do (CL:WHEN AFTERCRASH (TERPRI T))
|
||||
(PRINTOUT T REP " ")
|
||||
(for F TSTREAM TEXTOBJ LEN in FILES unless (DIRECTORYNAMEP F)
|
||||
do (CL:WHEN AFTERCRASH
|
||||
(PRINTOUT T T [if (EQ 'TEDIT (FILENAMEFIELD F 'EXTENSION))
|
||||
then (FILENAMEFIELD F 'NAME)
|
||||
else (PACKFILENAME 'NAME (FILENAMEFIELD F 'NAME)
|
||||
'EXTENSION
|
||||
(FILENAMEFIELD F 'EXTENSION]
|
||||
(for F TSTRM inside FILES
|
||||
do (if (if NOERROR
|
||||
then (NLSETQ (SETQ TSTRM (OPENTEXTSTREAM F))
|
||||
(for I from 1 while (TEDIT.NTHCHARCODE TSTRM I)))
|
||||
else (SETQ TSTRM (OPENTEXTSTREAM F))
|
||||
(for I from 1 while (TEDIT.NTHCHARCODE TSTRM I))
|
||||
T)
|
||||
'FILE)
|
||||
(STRESS NOERROR [SETQ TSTREAM (OPENTEXTSTREAM F NIL '(LEAVETTY T HISTORY OFF]
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(SETQ LEN (TEDIT.NCHARS TSTREAM))
|
||||
(for I RAND from 1 to NTIMES do (CHECKARRAYS 'BEFORE)
|
||||
(SETQ RAND (RAND 1 LEN))
|
||||
(CL:WHEN AFTERCRASH (PRINTOUT T RAND " "))
|
||||
(SETQ SYSOUTS (STRESS-SYSOUT SYSOUTS
|
||||
SYSOUTNAME))
|
||||
(TEDIT.INSERT TSTREAM "aaa" RAND)
|
||||
(CHECKARRAYS 'AFTER)
|
||||
(add LEN 3))
|
||||
(CLOSEF? TSTREAM))) finally (RETURN (LIST (SUB1 REP)
|
||||
N])
|
||||
|
||||
(STRESSINSERTWINDOW
|
||||
[LAMBDA (FILES NTIMES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:57 by rmk")
|
||||
(* ; "Edited 5-Jun-2025 21:12 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 22:35 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 15:19 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 09:13 by rmk")
|
||||
|
||||
(* ;; "Creates a single empty window, gets each file into that window without a process, and then does NTIMES random 3-character inserts before moving on to the next file.")
|
||||
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSINSERTWINDOW))
|
||||
(CL:UNLESS NTIMES (SETQ NTIMES 10))
|
||||
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
|
||||
(BKSYSBUF " ")
|
||||
(PRINTOUT T "STRESS INSERT: " REPS " reps randomly inserting 3 characters " NTIMES " times in "
|
||||
(LENGTH FILES)
|
||||
" files" T)
|
||||
(SAVERANDSTATE)
|
||||
(for R [WINDOW _ (CREATEW '(550 800 750 150]
|
||||
(N _ 0) from 1 to REPS
|
||||
do (PRINTOUT T R " ")
|
||||
(for F TSTREAM TEXTOBJ LEN in FILES unless (DIRECTORYNAMEP F)
|
||||
do (* ; "No process")
|
||||
(WINDOWPROP WINDOW 'TITLE (CONCAT "Fetching " F))
|
||||
(STRESS NOERROR [SETQ TSTREAM (OPENTEXTSTREAM F WINDOW '(LEAVETTY T HISTORY OFF]
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(SETQ LEN (TEDIT.NCHARS TSTREAM))
|
||||
(for I from 1 to NTIMES do (CHECKARRAYS 'BEFORE)
|
||||
(TEDIT.INSERT TSTREAM "aaa" (RAND 1 LEN))
|
||||
(CHECKARRAYS 'AFTER)
|
||||
(add LEN 3)))
|
||||
(PUTTEXTPROP TSTREAM 'DIRTY NIL)
|
||||
(TEDIT.DEACTIVATE.WINDOW WINDOW)
|
||||
(CLEARW WINDOW)) finally (RETURN (LIST (SUB1 R)
|
||||
N])
|
||||
then (CLOSEF TSTRM)
|
||||
(add N 1)
|
||||
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
|
||||
T))) finally (RETURN (LIST (SUB1 R)
|
||||
N])
|
||||
|
||||
(STRESSGREP
|
||||
[LAMBDA (FILES NOERROR TARGET) (* ; "Edited 29-Jun-2025 21:57 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:30 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 19:46 by rmk")
|
||||
[LAMBDA (FILES NOERROR TARGET) (* ; "Edited 17-Mar-2024 19:46 by rmk")
|
||||
|
||||
(* ;; "GREP does forward bins and peekbins. If it hits on something, it also runs the backfileptr function. FOO appears in quite a few lispusers/ Tedit files.")
|
||||
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSGREP))
|
||||
(CL:UNLESS FILES
|
||||
(SETQ FILES (FILDIR '*.TEDIT;)))
|
||||
(CL:UNLESS TARGET (SETQ TARGET "FOO"))
|
||||
(FILESLOAD GREP)
|
||||
(for F in FILES unless (DIRECTEORYNAMEP F) unless (if NOERROR
|
||||
then (NLSETQ (GREP TARGET F))
|
||||
else (PROGN (GREP TARGET F))
|
||||
T)
|
||||
do (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
|
||||
T])
|
||||
(for F inside FILES unless (if NOERROR
|
||||
then (NLSETQ (GREP TARGET F))
|
||||
else (GREP TARGET F)
|
||||
T) do (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL
|
||||
'DIRECTORY NIL
|
||||
'BODY F)
|
||||
T])
|
||||
|
||||
(STRESSPEEK
|
||||
[LAMBDA (FILES ERROR) (* ; "Edited 29-Jun-2025 21:57 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:30 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:33 by rmk")
|
||||
(SETQ FILES (STRESS-SETUP FILES 'STRESSPEEK))
|
||||
(for F TSTREAM (N _ 0) in FILES unless (DIRECTORYNAMEP F)
|
||||
do (STRESS (NOT ERROR)
|
||||
(SETQ TSTREAM (OPENTEXTSTREAM F))
|
||||
(CHECKARRAYS 'AFTEROPEN)
|
||||
(bind P while (SETQ P (PEEKCCODE TSTREAM T)) always (EQ P (BIN TSTREAM])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(STRESS-SETUP
|
||||
[LAMBDA (FILES SUBDIR) (* ; "Edited 29-Jun-2025 21:18 by rmk")
|
||||
(* ; "Edited 26-Jun-2025 20:18 by rmk")
|
||||
|
||||
(* ;; "Copy the files to CORE, defaulting to TEDIT files in connected directory, and load all the image object functions.")
|
||||
|
||||
(DECLARE (USEDFREE SYSOUTNAME))
|
||||
(BKSYSBUF " ")
|
||||
(CL:UNLESS SYSOUTNAME (SETQ SYSOUTNAME SUBDIR))
|
||||
(LET ((COREDIR (PACKFILENAME 'HOST 'CORE 'DIRECTORY SUBDIR))
|
||||
TOCOPY)
|
||||
(if (EQ FILES T)
|
||||
then (CL:UNLESS [SETQ FILES (FILDIR (PACKFILENAME 'BODY COREDIR 'BODY '*]
|
||||
(ERROR "No stress files in " COREDIR))
|
||||
(PRINTOUT T "Stress files in " COREDIR T)
|
||||
else [SETQ FILES (OR (MKLIST FILES)
|
||||
(FILDIR '*.TEDIT;]
|
||||
(SETQ TOCOPY (for F in FILES unless (INFILEP (PACKFILENAME 'BODY COREDIR 'BODY F))
|
||||
collect F))
|
||||
(if TOCOPY
|
||||
then (PRINTOUT T "Copying " (LENGTH TOCOPY)
|
||||
" files to " COREDIR T)
|
||||
(for F CF in TOCOPY collect (SETQ CF (COPYFILE F (PACKFILENAME 'BODY COREDIR
|
||||
'BODY F)))
|
||||
(CLOSEF? (OPENTEXTSTREAM CF))
|
||||
CF)
|
||||
else (PRINTOUT T (LENGTH FILES)
|
||||
" files already copied to " COREDIR T))
|
||||
(FILDIR (PACKFILENAME 'BODY COREDIR 'BODY '*])
|
||||
|
||||
(STRESS-SYSOUT
|
||||
[LAMBDA (SYSOUTS SYSOUTNAME) (* ; "Edited 29-Jun-2025 21:18 by rmk")
|
||||
(* ; "Edited 26-Jun-2025 20:57 by rmk")
|
||||
(DECLARE (USEDFREE NSYSOUTS))
|
||||
(if (EQ NSYSOUTS 'SAVEVM)
|
||||
then (SAVEVM)
|
||||
elseif (IGREATERP NSYSOUTS 0)
|
||||
then
|
||||
(* ;; "Keep NSYSOUT sysouts with increasing versions")
|
||||
|
||||
(CL:WHEN (IGEQ (LENGTH SYSOUTS)
|
||||
NSYSOUTS)
|
||||
(DELFILE (pop SYSOUTS))) (* ;
|
||||
"Drop the oldest, put out the newest")
|
||||
(SETQ SYSOUTNAME (SYSOUT SYSOUTNAME))
|
||||
[if (LISTP SYSOUTNAME)
|
||||
then (* ;
|
||||
"Restarting presumab ly after crash")
|
||||
(SETQ AFTERCRASH T)
|
||||
else
|
||||
(* ;; "Newest goes at the end of the ring")
|
||||
|
||||
(SETQ SYSOUTS (NCONC1 SYSOUTS SYSOUTNAME))
|
||||
(CL:WHEN (IGREATERP (FILENAMEFIELD SYSOUTNAME 'VERSION)
|
||||
1000) (* ; "Restart the versions at one")
|
||||
[SETQ SYSOUTS (for S in SYSOUTS as V from 1
|
||||
collect (RENAMEFILE S (PACKFILENAME 'VERSION V 'BODY S])]
|
||||
SYSOUTS])
|
||||
|
||||
(STRESS-AFTERSYSOUT
|
||||
[LAMBDA NIL (* ; "Edited 26-Jun-2025 09:18 by rmk")
|
||||
(DECLARE (USEDFREE SYSOUTLEVEL)) (* ;
|
||||
"Bound at the stress-test entry, or top-level NIL")
|
||||
(BKSYSBUF " ")
|
||||
(CL:WHEN SYSOUTLEVEL
|
||||
(CL:WHEN (OR (UNIX-GETENV "STRESSHELP")
|
||||
(EQ SYSOUTLEVEL 'EVENT))
|
||||
(HELP "STRESS SYSOUT"))
|
||||
(SETQ SYSOUTLEVEL (SELECTQ SYSOUTLEVEL
|
||||
(REPS 'FILE)
|
||||
(FILE 'EVENT)
|
||||
NIL)))])
|
||||
|
||||
(SYSOUTRING
|
||||
[LAMBDA (SYSOUTNAME SYSOUTS) (* ; "Edited 29-Jun-2025 21:19 by rmk")
|
||||
(* ; "Edited 26-Jun-2025 20:06 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 17:52 by rmk")
|
||||
|
||||
(* ;; "SYSOUTS is the list of names of sysouts that currently exist.")
|
||||
|
||||
(DECLARE (USEDFREE NSYSOUTS AFTERCRASH))
|
||||
(CL:WHEN (IGREATERP NSYSOUTS 0) (* ;
|
||||
"Keep NSYSOUT sysouts with increasing versions")
|
||||
(CL:WHEN (IGEQ (LENGTH SYSOUTS)
|
||||
NSYSOUTS)
|
||||
(DELFILE (pop SYSOUTS))) (* ;
|
||||
"Drop the oldest, put out the newest")
|
||||
(SETQ SYSOUTNAME (SYSOUT SYSOUTNAME))
|
||||
(CL:WHEN (LISTP SYSOUTNAME) (* ; "Restarting")
|
||||
(SETQ AFTERCRASH T))
|
||||
(NCONC1 SYSOUTS SYSOUTNAME))])
|
||||
|
||||
(SYSOUTNAME
|
||||
[LAMBDA (SYSOUTNAME) (* ; "Edited 26-Jun-2025 00:12 by rmk")
|
||||
|
||||
(* ;; "Doesn't work with PSEUDOFILENAME ??")
|
||||
|
||||
(PACKFILENAME 'VERSION NIL 'DIRECTORY MEDLEYDIR 'NAME SYSOUTNAME 'EXTENSION 'SYSOUT])
|
||||
|
||||
(SYSOUTRING
|
||||
[LAMBDA (SYSOUTNAME SYSOUTS) (* ; "Edited 29-Jun-2025 21:19 by rmk")
|
||||
(* ; "Edited 26-Jun-2025 20:06 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 17:52 by rmk")
|
||||
|
||||
(* ;; "SYSOUTS is the list of names of sysouts that currently exist.")
|
||||
|
||||
(DECLARE (USEDFREE NSYSOUTS AFTERCRASH))
|
||||
(CL:WHEN (IGREATERP NSYSOUTS 0) (* ;
|
||||
"Keep NSYSOUT sysouts with increasing versions")
|
||||
(CL:WHEN (IGEQ (LENGTH SYSOUTS)
|
||||
NSYSOUTS)
|
||||
(DELFILE (pop SYSOUTS))) (* ;
|
||||
"Drop the oldest, put out the newest")
|
||||
(SETQ SYSOUTNAME (SYSOUT SYSOUTNAME))
|
||||
(CL:WHEN (LISTP SYSOUTNAME) (* ; "Restarting")
|
||||
(SETQ AFTERCRASH T))
|
||||
(NCONC1 SYSOUTS SYSOUTNAME))])
|
||||
|
||||
(SYSOUTNAME
|
||||
[LAMBDA (SYSOUTNAME) (* ; "Edited 26-Jun-2025 00:12 by rmk")
|
||||
|
||||
(* ;; "Doesn't work with PSEUDOFILENAME ??")
|
||||
|
||||
(PACKFILENAME 'VERSION NIL 'DIRECTORY MEDLEYDIR 'NAME SYSOUTNAME 'EXTENSION 'SYSOUT])
|
||||
[LAMBDA (FILES ERROR) (* ; "Edited 19-Mar-2024 21:33 by rmk")
|
||||
(CL:UNLESS FILES
|
||||
(SETQ FILES (FILDIR '*.TEDIT;)))
|
||||
(for F TSTRM inside FILES eachtime (SETQ TSTRM (OPENTEXTSTREAM F))
|
||||
unless [if ERROR
|
||||
then (bind P while (SETQ P (PEEKCCODE TSTRM T)) always (EQ P (BIN TSTRM)))
|
||||
else (NLSETQ (bind P while (SETQ P (PEEKCCODE TSTRM T))
|
||||
always (EQ P (BIN TSTRM] do (PRINTOUT T "Error for "
|
||||
(PACKFILENAME 'HOST NIL
|
||||
'DIRECTORY NIL 'BODY F)
|
||||
T)
|
||||
repeatwhile (PROGN (CLOSEF? TSTRM)
|
||||
T])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -646,84 +261,41 @@
|
||||
(LIST I C1 C2)))
|
||||
(RETURN NIL) finally (RETURN T])
|
||||
|
||||
(SYSOUTRING
|
||||
[LAMBDA (NSYSOUTS SYSOUTNAME SYSOUTS) (* ; "Edited 12-Mar-2024 17:52 by rmk")
|
||||
|
||||
(* ;; "SYSOUTS is the list of names of sysouts that currently exist.")
|
||||
|
||||
(DECLARE (USEDFREE SINGLESTEP))
|
||||
(CL:WHEN (IGREATERP NSYSOUTS 0) (* ;
|
||||
"Keep NSYSOUT sysouts with increasing versions")
|
||||
(CL:WHEN (IGEQ (LENGTH SYSOUTS)
|
||||
NSYSOUTS)
|
||||
(DELFILE (pop SYSOUTS))) (* ;
|
||||
"Drop the firstr (oldest), new one goes at the end")
|
||||
(SETQ SYSOUTNAME (SYSOUT SYSOUTNAME))
|
||||
(CL:WHEN (LISTP SYSOUTNAME) (* ; "Restarting")
|
||||
(SETQ SINGLESTEP T))
|
||||
(NCONC1 SYSOUTS SYSOUTNAME))])
|
||||
|
||||
(COPYTOCORE
|
||||
[LAMBDA (FILES SUBDIR NORECLAIM) (* ; "Edited 25-Jun-2025 23:41 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 21:30 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 22:45 by rmk")
|
||||
[LAMBDA (FILES NORECLAIM) (* ; "Edited 12-Mar-2024 22:45 by rmk")
|
||||
|
||||
(* ;; "Copy FILES to {CORE}, defaulting to TEDIT files in connected directory")
|
||||
|
||||
[SETQ FILES (OR (MKLIST FILES)
|
||||
(FILDIR '*.TEDIT;]
|
||||
(CL:UNLESS (LISTP FILES)
|
||||
(SETQ FILES (FILDIR (OR FILES "*.TEDIT;"))))
|
||||
(PRINTOUT T "Copying " (LENGTH FILES)
|
||||
" files to {CORE} "
|
||||
(CL:IF NORECLAIM
|
||||
"without "
|
||||
"with ")
|
||||
"reclaiming" T)
|
||||
(for F CF in FILES collect (SETQ CF (PACKFILENAME 'HOST 'CORE 'DIRECTORY SUBDIR 'BODY F))
|
||||
(OR (INFILEP CF)
|
||||
(COPYFILE F CF)) finally (CL:UNLESS NORECLAIM (RECLAIM])
|
||||
|
||||
(CHECKARRAYS
|
||||
[LAMBDA (TAG)
|
||||
(DECLARE (SPECVARS TAG)) (* ; "Edited 2-Jun-2025 21:11 by rmk")
|
||||
|
||||
(* ;; "TAG is visible as an argument in URAID")
|
||||
|
||||
(CL:WHEN CHECKARRAYS
|
||||
(CL:WHEN (EQ CHECKARRAYS 'RECLAIM)
|
||||
(RECLAIM))
|
||||
(\PARSEARRAYSPACE))])
|
||||
|
||||
(SAVERANDSTATE
|
||||
[LAMBDA NIL (* ; "Edited 5-Jun-2025 21:20 by rmk")
|
||||
(DECLARE (USEDFREE USELASTRANDSTATE))
|
||||
(LET (RSTREAM)
|
||||
(if USELASTRANDSTATE
|
||||
then (SETQ RSTREAM (OPENSTREAM 'RANDSTATE 'INPUT))
|
||||
(RANDSET (READ RSTREAM))
|
||||
else (SETQ RSTREAM (OPENSTREAM 'RANDSTATE 'OUTPUT))
|
||||
(PRINTOUT RSTREAM (RANDSET T)
|
||||
T))
|
||||
(CLOSEF RSTREAM])
|
||||
)
|
||||
|
||||
(RPAQ? CHECKARRAYS NIL)
|
||||
|
||||
(RPAQ? USELASTRANDSTATE NIL)
|
||||
|
||||
(RPAQ? SYSOUTLEVEL NIL)
|
||||
|
||||
(RPAQ? NSYSOUTS 0)
|
||||
|
||||
(RPAQQ ARRAYBLOCKCHECKING T)
|
||||
|
||||
(APPENDTOVAR AFTERSYSOUTFORMS (STRESS-AFTERSYSOUT))
|
||||
|
||||
(FILESLOAD TEDIT-DEBUG)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS STRESS MACRO ((NOERROR . FORMS)
|
||||
(CHECKARRAYS 'BEFORESTRESS)
|
||||
(if (if NOERROR
|
||||
then (NLSETQ . FORMS)
|
||||
else (PROGN . FORMS)
|
||||
T)
|
||||
then (add N 1)
|
||||
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
|
||||
'BODY F)
|
||||
T))
|
||||
(CHECKARRAYS 'AFTERSTRESS)
|
||||
(CLOSEF? TSTREAM)))
|
||||
(for F in FILES collect (COPYFILE F (PACKFILENAME 'HOST 'CORE 'DIRECTORY NIL 'BODY F))
|
||||
finally (CL:UNLESS NORECLAIM (RECLAIM])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1548 32125 (STRESSHC 1558 . 5389) (STRESSRAND 5391 . 6927) (STRESSPUT 6929 . 8498) (
|
||||
STRESSOPEN 8500 . 9663) (STRESSREAD 9665 . 11165) (STRESSFORMAT 11167 . 13642) (STRESSDISPLAY 13644 .
|
||||
16623) (STRESSSCROLL 16625 . 19193) (STRESSDELETE 19195 . 21574) (STRESSDELETEWINDOW 21576 . 24168) (
|
||||
STRESSINSERT 24170 . 27854) (STRESSINSERTWINDOW 27856 . 30342) (STRESSGREP 30344 . 31418) (STRESSPEEK
|
||||
31420 . 32123)) (32126 38911 (STRESS-SETUP 32136 . 33889) (STRESS-SYSOUT 33891 . 35473) (
|
||||
STRESS-AFTERSYSOUT 35475 . 36139) (SYSOUTRING 36141 . 37249) (SYSOUTNAME 37251 . 37524) (SYSOUTRING
|
||||
37526 . 38634) (SYSOUTNAME 38636 . 38909)) (38912 41860 (EQTEXTSTREAM 38922 . 40091) (COPYTOCORE 40093
|
||||
. 41023) (CHECKARRAYS 41025 . 41352) (SAVERANDSTATE 41354 . 41858)))))
|
||||
(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.
@@ -1,234 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Feb-2025 13:31:28" {WMEDLEY}<library>tedit>TEDIT-STYLES.;4 12550
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES)
|
||||
|
||||
:PREVIOUS-DATE "12-Feb-2025 12:18:37" {WMEDLEY}<library>tedit>TEDIT-STYLES.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STYLESCOMS)
|
||||
|
||||
(RPAQQ TEDIT-STYLESCOMS
|
||||
( (* ; "Style-sheet support")
|
||||
(FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES TEDIT.STYLESHEET TEDIT.POP.STYLESHEET
|
||||
TEDIT.PUSH.STYLESHEET TEDIT.ADD.STYLESHEET)
|
||||
|
||||
(* ;; "*TEDIT-PARASTYLE-CACHE* is an ALIST of original char/para looks to styled char/para looks. It is used to cache stylings, and is reset when the main stylesheet changes, and when we change paragraph looks, given paras that have private char styles.")
|
||||
|
||||
|
||||
(* ;; "*TEDIT-CURRENTPARA-CACHE* is NIL if we're not in a para that has private char styles, or is the PARALOOKS (styled!) for that para, if we are. Used to decide when we have to flush *TEDIT-PARASTYLE-CACHE* at paragraph boundaries. Mostly, this'll be NIL and not interesting.")
|
||||
|
||||
|
||||
(* ;; "*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly. This is the push-stack, in effect. Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET")
|
||||
|
||||
(INITVARS (TEDIT.STYLES))
|
||||
|
||||
(* ;; "RMK 2023: Maybe this should be one of the later ones? Only partly implemented")
|
||||
|
||||
(GLOBALVARS TEDIT.STYLES)
|
||||
(INITVARS (*TEDIT-PARASTYLE-CACHE*)
|
||||
(*TEDIT-CURRENTPARA-CACHE*)
|
||||
(*TEDIT-STYLESHEET-SAVE-LIST*))
|
||||
(GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* *TEDIT-STYLESHEET-SAVE-LIST*)))
|
||||
|
||||
|
||||
|
||||
(* ; "Style-sheet support")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.APPLY.STYLES
|
||||
[LAMBDA (LOOKS PC TSTREAM) (* ; "Edited 19-Feb-2025 13:31 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:07 by rmk")
|
||||
(* ; "Edited 12-Nov-2023 16:08 by rmk")
|
||||
(* ; "Edited 18-Mar-2023 21:45 by rmk")
|
||||
(* ; "Edited 25-Sep-2022 13:28 by rmk")
|
||||
(* ; "Edited 11-Sep-2022 14:45 by rmk")
|
||||
(* ;
|
||||
"Edited 4-Jul-93 01:02 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Given a set of looks, return the looks with the proper styles expanded out.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(OR (CDR (ASSOC LOOKS *TEDIT-CURRENTPARA-CACHE*))
|
||||
(CDR (ASSOC LOOKS *TEDIT-PARASTYLE-CACHE*))
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(STYLE (GETCLOOKS LOOKS CLSTYLE))
|
||||
(STYLE-SHEET (OR (FGETTOBJ TEXTOBJ TXTSTYLESHEET)
|
||||
TEDIT.STYLES))
|
||||
NOSTYLE CHARSTYLES CHARSTYLE IN-PARA)
|
||||
(SETQ STYLE (COND
|
||||
((NULL STYLE) (* ;
|
||||
"STYLE of NIL means don't bother. Just use the looks we got.")
|
||||
(SETQ NOSTYLE T)
|
||||
LOOKS)
|
||||
((AND (SETQ CHARSTYLES (AND (GETTSTR TSTREAM CURRENTPARALOOKS)
|
||||
(GETPLOOKS (GETTSTR TSTREAM CURRENTPARALOOKS
|
||||
)
|
||||
FMTCHARSTYLES)))
|
||||
(SETQ CHARSTYLE (FASSOC STYLE CHARSTYLES)))
|
||||
(* ;
|
||||
"If the paragraph we're in has character styles, and this is one of them, use it.")
|
||||
(SETQ IN-PARA T)
|
||||
CHARSTYLE)
|
||||
((CDR (SASSOC STYLE STYLE-SHEET)))
|
||||
((AND (LITATOM STYLE)
|
||||
(DEFINEDP STYLE)) (* ;
|
||||
"Call the guy's function to find the new looks")
|
||||
(APPLY* STYLE LOOKS PC TEXTOBJ))
|
||||
(T (* ;
|
||||
"If all else fails, return the original set of looks")
|
||||
(SETQ NOSTYLE T)
|
||||
LOOKS)))
|
||||
(SETQ STYLE (COND
|
||||
((LISTP STYLE)
|
||||
(\TEDIT.PARSE.CHARLOOKS.LIST (APPEND STYLE '(STYLE NIL))
|
||||
LOOKS TEXTOBJ))
|
||||
(T STYLE)))
|
||||
|
||||
(* ;; "Cache the looks->styled-looks mapping, either in the cache for this kind of paragraph (which gets wiped when we hit a new para type), or in the global cache.")
|
||||
|
||||
[OR NOSTYLE (CL:IF IN-PARA
|
||||
(push *TEDIT-CURRENTPARA-CACHE* (CONS LOOKS STYLE))
|
||||
(push *TEDIT-PARASTYLE-CACHE* (CONS LOOKS STYLE)))]
|
||||
STYLE])
|
||||
|
||||
(\TEDIT.APPLY.PARASTYLES
|
||||
[LAMBDA (PARALOOKS PC TEXTOBJ) (* ; "Edited 19-Feb-2025 13:31 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:07 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 14:48 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 11:06 by rmk")
|
||||
(* ; "Edited 4-Mar-2023 22:23 by rmk")
|
||||
(* ; "Edited 25-Sep-2022 13:26 by rmk")
|
||||
(* ;
|
||||
"Edited 3-Jul-93 23:15 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Given a set of looks, return the looks with the proper styles expanded out.")
|
||||
|
||||
(\TEDIT.CHECK (type? PARALOOKS PARALOOKS)) (* ; "Incoming thing has to be a LOOKS.")
|
||||
(OR (CDR (ASSOC PARALOOKS *TEDIT-PARASTYLE-CACHE*))
|
||||
(LET* [NOSTYLE (STYLE-SHEET (OR (fetch (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ)
|
||||
TEDIT.STYLES))
|
||||
(STYLE (COND
|
||||
((NULL (GETPLOOKS PARALOOKS FMTSTYLE))
|
||||
(SETQ NOSTYLE T)
|
||||
PARALOOKS)
|
||||
((CDR (SASSOC (GETPLOOKS PARALOOKS FMTSTYLE)
|
||||
STYLE-SHEET)))
|
||||
((AND (LITATOM (GETPLOOKS PARALOOKS FMTSTYLE))
|
||||
(DEFINEDP (GETPLOOKS PARALOOKS FMTSTYLE)))
|
||||
(* ;
|
||||
"Call the guy's function to find the new looks")
|
||||
(APPLY* (GETPLOOKS PARALOOKS FMTSTYLE)
|
||||
PARALOOKS PC TEXTOBJ))
|
||||
(T (SETQ NOSTYLE T)
|
||||
PARALOOKS]
|
||||
(CL:WHEN (LISTP STYLE)
|
||||
(SETQ STYLE (\TEDIT.PARSE.PARALOOKS.LIST (APPEND STYLE '(STYLE NIL))
|
||||
PARALOOKS TEXTOBJ)))
|
||||
(CL:UNLESS NOSTYLE
|
||||
(push *TEDIT-PARASTYLE-CACHE* (CONS PARALOOKS STYLE)))
|
||||
STYLE])
|
||||
|
||||
(TEDIT.STYLESHEET
|
||||
[LAMBDA (SHEET TEXTSTREAM) (* ;
|
||||
"Edited 3-Jul-93 23:19 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Put a new stylesheet into force. This REPLACES any existing style sheets, and forgets any pushed sheets.")
|
||||
|
||||
(LET [(TEXTOBJ (AND TEXTSTREAM (TEXTOBJ TEXTSTREAM]
|
||||
(COND
|
||||
(TEXTOBJ (SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(replace (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ with SHEET))
|
||||
(T
|
||||
(* ;; "No specific document given; change the global style sheet TEDIT.STYLES")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES SHEET)
|
||||
(SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES])
|
||||
|
||||
(TEDIT.POP.STYLESHEET
|
||||
[LAMBDA NIL (* ;
|
||||
"Edited 3-Jul-93 17:42 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Go back to an earlier stylesheet, by popping the stack of saved sheets. You can't pop back to no sheet -- you'll always bottom out at the original style sheet.")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES (OR (CL:POP *TEDIT-STYLESHEET-SAVE-LIST*)
|
||||
TEDIT.STYLES])
|
||||
|
||||
(TEDIT.PUSH.STYLESHEET
|
||||
[LAMBDA (SHEET) (* ;
|
||||
"Edited 3-Jul-93 17:40 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Add more style definitions to the current style sheet, and remember how to get back to the old one. Think of this as PUSHING onto a stack of stylesheets, with the new sheet being a composition of SHEET and the existing styles. ")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES))
|
||||
(CL:PUSH TEDIT.STYLES *TEDIT-STYLESHEET-SAVE-LIST*])
|
||||
|
||||
(TEDIT.ADD.STYLESHEET
|
||||
[LAMBDA (SHEET) (* ;
|
||||
"Edited 3-Jul-93 17:38 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Add more style definitions to the current style sheet. This ADDS entries, without remembering that there was an earlier sheet. ")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES))
|
||||
(SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"*TEDIT-PARASTYLE-CACHE* is an ALIST of original char/para looks to styled char/para looks. It is used to cache stylings, and is reset when the main stylesheet changes, and when we change paragraph looks, given paras that have private char styles."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"*TEDIT-CURRENTPARA-CACHE* is NIL if we're not in a para that has private char styles, or is the PARALOOKS (styled!) for that para, if we are. Used to decide when we have to flush *TEDIT-PARASTYLE-CACHE* at paragraph boundaries. Mostly, this'll be NIL and not interesting."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly. This is the push-stack, in effect. Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET"
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? TEDIT.STYLES )
|
||||
|
||||
|
||||
|
||||
(* ;; "RMK 2023: Maybe this should be one of the later ones? Only partly implemented")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.STYLES)
|
||||
)
|
||||
|
||||
(RPAQ? *TEDIT-PARASTYLE-CACHE* )
|
||||
|
||||
(RPAQ? *TEDIT-CURRENTPARA-CACHE* )
|
||||
|
||||
(RPAQ? *TEDIT-STYLESHEET-SAVE-LIST* )
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* *TEDIT-STYLESHEET-SAVE-LIST*)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1980 11244 (\TEDIT.APPLY.STYLES 1990 . 5638) (\TEDIT.APPLY.PARASTYLES 5640 . 8118) (
|
||||
TEDIT.STYLESHEET 8120 . 9187) (TEDIT.POP.STYLESHEET 9189 . 9857) (TEDIT.PUSH.STYLESHEET 9859 . 10599)
|
||||
(TEDIT.ADD.STYLESHEET 10601 . 11242)))))
|
||||
STOP
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user