Compare commits
55 Commits
medley-220
...
medley-221
| Author | SHA1 | Date | |
|---|---|---|---|
|
97cb04be46 | ||
|
62754015b0 | ||
|
|
9d09033cc4 | ||
|
d9c144d966 | ||
|
|
17dd03a358 | ||
|
|
382881a068 | ||
|
|
d0d952a10d | ||
|
|
d5d21397d4 | ||
|
|
7a4470ce8b | ||
|
|
32ff7b7649 | ||
|
|
096d860ac8 | ||
|
|
418b1df00d | ||
|
ba90344080 | ||
|
|
0eac6efb61 | ||
|
|
540aff091c | ||
|
|
3f244f6cd3 | ||
|
|
58557d383a | ||
|
|
882fbacf59 | ||
|
|
70ce516e0c | ||
|
|
fdb573c761 | ||
|
|
06368f95eb | ||
|
|
654ebc359c | ||
|
|
4e38802325 | ||
|
b43b63b287 | ||
|
|
016097e8bf | ||
|
99321e7951 | ||
|
|
8e4fc4ab74 | ||
|
|
c005cf86bf | ||
|
|
ecc2b22207 | ||
|
|
d0945f7a5f | ||
|
|
add65a9397 | ||
|
|
0474f924a4 | ||
|
|
a387094eab | ||
|
|
541a07e09b | ||
|
|
5ee5482dd2 | ||
|
|
095beef454 | ||
|
|
06a7356b00 | ||
|
|
147abac04c | ||
|
|
56a52af6b9 | ||
|
|
fad70d4947 | ||
|
|
f4c91ec419 | ||
|
|
f5e48847c9 | ||
|
|
b90bf65be9 | ||
|
|
d379bcc102 | ||
|
|
39a7512458 | ||
|
|
431d80fb3c | ||
|
|
78b76f6801 | ||
|
|
16517cdfc5 | ||
|
|
902d542121 | ||
|
c708f2ac55 | ||
|
|
43e6801341 | ||
|
|
27a6063ce9 | ||
|
|
cd6b64efa2 | ||
|
|
222da55f69 | ||
|
|
92f85c5957 |
9
.gitattributes
vendored
Normal file
9
.gitattributes
vendored
Normal file
@@ -0,0 +1,9 @@
|
||||
# Denote all files that are truly binary and should not be modified.
|
||||
*.tedit binary
|
||||
*.lcom binary
|
||||
*.sketch binary
|
||||
*.dfasl binary
|
||||
*.TEDIT binary
|
||||
*.LCOM binary
|
||||
*.SKETCH binary
|
||||
*.DFASL binary
|
||||
79
.github/workflows/buildLoadup.yml
vendored
79
.github/workflows/buildLoadup.yml
vendored
@@ -1,4 +1,4 @@
|
||||
#re*******************************************************************************
|
||||
#*******************************************************************************
|
||||
# buidLoadup.yml
|
||||
#
|
||||
# Interlisp workflow to build Medley release and push it to github. This workflow
|
||||
@@ -59,8 +59,8 @@ jobs:
|
||||
- id: force
|
||||
run: >
|
||||
if [ '${{ toJSON(inputs) }}' = 'null' ];
|
||||
then echo ::set-output name=force::'${{ github.event.inputs.force }}'; echo "workflow_dispatch";
|
||||
else echo ::set-output name=force::'${{ inputs.force }}'; echo "workflow_call";
|
||||
then echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT; echo "workflow_dispatch";
|
||||
else echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT; echo "workflow_call";
|
||||
fi
|
||||
|
||||
|
||||
@@ -79,7 +79,7 @@ jobs:
|
||||
steps:
|
||||
# Checkout the actions for this repo owner
|
||||
- name: Checkout Actions
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/.github
|
||||
path: ./Actions_${{ github.sha }}
|
||||
@@ -110,7 +110,7 @@ jobs:
|
||||
steps:
|
||||
# Checkout the actions for this repo owner
|
||||
- name: Checkout Actions
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/.github
|
||||
path: ./Actions_${{ github.sha }}
|
||||
@@ -118,7 +118,7 @@ jobs:
|
||||
|
||||
# Checkout latest commit
|
||||
- name: Checkout Medley
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
|
||||
# Setup release tag
|
||||
- name: Setup Release Tag
|
||||
@@ -129,20 +129,20 @@ jobs:
|
||||
- name: Setup Environment Variables
|
||||
id: setup_env
|
||||
run: |
|
||||
echo ::set-output name=build_time::$(date -u +'%Y-%m-%dT%H:%M:%SZ')
|
||||
echo "build_time=$(date -u +'%Y-%m-%dT%H:%M:%SZ')" >> $GITHUB_OUTPUT
|
||||
|
||||
# Get Maiko release information, retrieves the name of the latest
|
||||
# release. Used to download the correct Maiko release
|
||||
- name: Get Maiko Release Information
|
||||
id: latest_version
|
||||
uses: abatilo/release-info-action@v1.3.0
|
||||
uses: abatilo/release-info-action@v1.3.2
|
||||
with:
|
||||
owner: ${{ github.repository_owner }}
|
||||
repo: maiko
|
||||
|
||||
# Download Maiko Release Assets
|
||||
- name: Download Release Assets
|
||||
uses: robinraju/release-downloader@v1.2
|
||||
uses: robinraju/release-downloader@v1.6
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/maiko
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
@@ -165,24 +165,20 @@ jobs:
|
||||
|
||||
- name: Build loadups release tar
|
||||
run: |
|
||||
cp -p tmp/full.sysout tmp/lisp.sysout tmp/whereis.hash loadups/
|
||||
cp -p tmp/exports.all library/
|
||||
cd ..
|
||||
tar cfz medley/tmp/${release_tag}-loadups.tgz \
|
||||
tar cfz medley/tmp/${RELEASE_TAG}-loadups.tgz \
|
||||
medley/loadups/lisp.sysout \
|
||||
medley/loadups/full.sysout \
|
||||
medley/loadups/whereis.hash \
|
||||
medley/library/exports.all
|
||||
|
||||
env:
|
||||
release_tag: ${{ steps.tag.outputs.release_tag }}
|
||||
|
||||
- name: Build runtime release tar
|
||||
run: |
|
||||
cd ..
|
||||
tar cfz medley/tmp/${release_tag}-runtime.tgz \
|
||||
tar cfz medley/tmp/${RELEASE_TAG}-runtime.tgz \
|
||||
--exclude "*~" --exclude "*#*" \
|
||||
--exclude exports.all \
|
||||
medley/clos \
|
||||
medley/docs/dinfo \
|
||||
medley/doctools \
|
||||
medley/greetfiles \
|
||||
@@ -197,40 +193,25 @@ jobs:
|
||||
medley/lispusers \
|
||||
medley/sources \
|
||||
medley/internal
|
||||
env:
|
||||
release_tag: ${{ steps.tag.outputs.release_tag }}
|
||||
|
||||
|
||||
- name: "Create release"
|
||||
uses: "actions/github-script@v5"
|
||||
- name: Delete existing release with same tag (if any)
|
||||
uses: cb80/delrel@latest
|
||||
with:
|
||||
github-token: "${{ secrets.GITHUB_TOKEN }}"
|
||||
script: |
|
||||
try {
|
||||
await github.rest.repos.createRelease({
|
||||
draft: false,
|
||||
generate_release_notes: true,
|
||||
name: process.env.release_tag,
|
||||
owner: context.repo.owner,
|
||||
prerelease: false,
|
||||
repo: context.repo.repo,
|
||||
tag_name: process.env.release_tag,
|
||||
});
|
||||
} catch (error) {
|
||||
core.setFailed(error.message);
|
||||
}
|
||||
env:
|
||||
release_tag: ${{ steps.tag.outputs.release_tag }}
|
||||
|
||||
- name: "Upload release assets"
|
||||
uses: AButler/upload-release-assets@v2.0
|
||||
with:
|
||||
files: 'tmp/${{ env.release_tag }}-loadups.tgz;tmp/${{ env.release_tag }}-runtime.tgz'
|
||||
repo-token: ${{ secrets.GITHUB_TOKEN }}
|
||||
release-tag: ${{ env.release_tag }}
|
||||
env:
|
||||
release_tag: ${{ steps.tag.outputs.release_tag }}
|
||||
tag: ${{ env.RELEASE_TAG }}
|
||||
continue-on-error: true
|
||||
|
||||
- name: Push the release
|
||||
uses: ncipollo/release-action@v1
|
||||
with:
|
||||
allowUpdates: true
|
||||
artifacts:
|
||||
tmp/${{ env.RELEASE_TAG }}-loadups.tgz,
|
||||
tmp/${{ env.RELEASE_TAG }}-runtime.tgz
|
||||
tag: ${{ env.RELEASE_TAG }}
|
||||
draft: false
|
||||
prerelease: false
|
||||
generateReleaseNotes: true
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
|
||||
######################################################################################
|
||||
|
||||
@@ -249,7 +230,7 @@ jobs:
|
||||
steps:
|
||||
# Checkout the actions for this repo owner
|
||||
- name: Checkout Actions
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/.github
|
||||
path: ./Actions_${{ github.sha }}
|
||||
@@ -265,6 +246,6 @@ jobs:
|
||||
- name: Output
|
||||
id: output
|
||||
run: |
|
||||
echo ::set-output name=build_successful::'true'
|
||||
echo "build_successful='true'" >> $GITHUB_OUTPUT
|
||||
|
||||
######################################################################################
|
||||
|
||||
1
.gitignore
vendored
1
.gitignore
vendored
@@ -36,3 +36,4 @@ core
|
||||
|
||||
# Mac OS detritus
|
||||
.DS_Store
|
||||
*.PS
|
||||
|
||||
@@ -41,9 +41,9 @@ ADD ./*.tgz ${INSTALL_LOCATION}
|
||||
|
||||
# Create a run_medley script in /usr/local/bin
|
||||
RUN mkdir -p /usr/local/bin && \
|
||||
echo "#!/bin/bash" > /usr/local/bin/run-medley && \
|
||||
echo "cd ${INSTALL_LOCATION}" >> /usr/local/bin/run-medley && \
|
||||
echo './run-medley "$@"' >> /usr/local/bin/run-medley && \
|
||||
echo "#!/bin/bash" > /usr/local/bin/run-medley && \
|
||||
echo "cd ${INSTALL_LOCATION}/medley" >> /usr/local/bin/run-medley && \
|
||||
echo './run-medley "$@"' >> /usr/local/bin/run-medley && \
|
||||
chmod ugo+x /usr/local/bin/run-medley
|
||||
|
||||
# "Finalize" image
|
||||
|
||||
BIN
fonts/displayfonts/c0/IBM-US14-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBM-US14-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
BIN
fonts/displayfonts/c0/IBM-US16-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBM-US16-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
BIN
fonts/displayfonts/c0/IBM14-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBM14-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
BIN
fonts/displayfonts/c0/IBM16-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBM16-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
BIN
fonts/displayfonts/c0/IBMREV14-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBMREV14-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
BIN
fonts/displayfonts/c0/IBMREV16-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBMREV16-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
@@ -1,10 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Mar-2022 11:50:44" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;2 4690
|
||||
(FILECREATED "22-Nov-2022 20:59:24" {DSK}<home>frank>il>medley>wmedley>greetfiles>MEDLEYDIR-INIT.;6 2860
|
||||
|
||||
:CHANGES-TO (VARS MEDLEYDIR-INITCOMS)
|
||||
|
||||
:PREVIOUS-DATE "28-Feb-2022 21:13:20" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;1)
|
||||
:PREVIOUS-DATE "22-Nov-2022 20:42:43"
|
||||
{DSK}<home>frank>il>medley>wmedley>greetfiles>MEDLEYDIR-INIT.;5)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
|
||||
@@ -13,7 +14,7 @@
|
||||
([P (LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
|
||||
"")
|
||||
"/sources/MEDLEYDIR.LCOM"))
|
||||
(MEDLEY-INIT-VARS)
|
||||
(MEDLEY-INIT-VARS 'GREET)
|
||||
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
|
||||
(FILES BACKGROUND-YIELD)
|
||||
(VARS
|
||||
@@ -38,7 +39,7 @@
|
||||
"")
|
||||
"/sources/MEDLEYDIR.LCOM"))
|
||||
|
||||
(MEDLEY-INIT-VARS)
|
||||
(MEDLEY-INIT-VARS 'GREET)
|
||||
|
||||
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
|
||||
|
||||
@@ -81,44 +82,7 @@
|
||||
:PACKAGE "INTERLISP"])
|
||||
)
|
||||
|
||||
(ADDTOVAR FONTDEFS
|
||||
[LARGER (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (GACHA 12)
|
||||
(GACHA 10)
|
||||
(TERMINAL 10)
|
||||
(POSTSCRIPT (TERMINAL 10)))
|
||||
(ITALICFONT 1 (HELVETICA 12 MIR)
|
||||
(GACHA 10 MIR)
|
||||
(MODERN 10 MIR)
|
||||
(POSTSCRIPT (MODERN 10 MIR)))
|
||||
(BOLDFONT 2 (HELVETICA 12 BRR)
|
||||
(HELVETICA 10 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(POSTSCRIPT (HELVETICA 12 BRR)))
|
||||
(LITTLEFONT 3 (HELVETICA 10)
|
||||
(HELVETICA 6 MIR)
|
||||
(MODERN 10 MIR)
|
||||
(POSTSCRIPT (MODERN 10 MIR)))
|
||||
(TINYFONT 6 (GACHA 10)
|
||||
(GACHA 6)
|
||||
(TERMINAL 6)
|
||||
(POSTSCRIPT (TERMINAL 6)))
|
||||
(BIGFONT 4 (HELVETICA 12 BRR)
|
||||
NIL
|
||||
(MODERN 12 BRR)
|
||||
(POSTSCRIPT (MODERN 12 BRR)))
|
||||
(MENUFONT 5 (HELVETICA 12)
|
||||
(HELVETICA 12)
|
||||
(POSTSCRIPT (HELVETICA 12)))
|
||||
(COMMENTFONT 6 (HELVETICA 12)
|
||||
(HELVETICA 10)
|
||||
(MODERN 10)
|
||||
(POSTSCRIPT (MODERN 10)))
|
||||
(TEXTFONT 7 (TIMESROMAN 12)
|
||||
NIL
|
||||
(CLASSIC 12)
|
||||
(POSTSCRIPT (CLASSIC 12])
|
||||
(ADDTOVAR FONTDEFS )
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1949 2774 (INTERLISPMODE 1959 . 2772)))))
|
||||
(FILEMAP (NIL (1986 2811 (INTERLISPMODE 1996 . 2809)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
2842
internal/COMPTEST
2842
internal/COMPTEST
File diff suppressed because it is too large
Load Diff
Binary file not shown.
10
internal/CONDITIONGRAPH.TXT
Normal file
10
internal/CONDITIONGRAPH.TXT
Normal file
@@ -0,0 +1,10 @@
|
||||
CONDITIONGRAPH
|
||||
|
||||
|
||||
Currently in internal rather than lispusers, this package shows a graph of "conditions" (Common Lisp error system).
|
||||
|
||||
(FILESLOAD CONDITIONGRAPH) to load it.
|
||||
|
||||
(GRAPH-CONDITIONS) will display a graph of conditions and their inheritance.
|
||||
|
||||
Other possible operations might be determinable by reading the source.
|
||||
BIN
internal/DO-TEST
BIN
internal/DO-TEST
Binary file not shown.
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
@@ -1 +0,0 @@
|
||||
Running DSKTEST
The Disk-file-system test utility
1. Load the file DSKTEST.DCOM from whichever directory & server it is stored on.
2. Type
(DSKTEST '{DSK}<LISPFILES>
|
||||
1493
internal/MACROTEST
1493
internal/MACROTEST
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,25 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;9| 15959
|
||||
(FILECREATED " 4-Aug-2022 09:50:04" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;2| 10212
|
||||
|
||||
:CHANGES-TO (FNS HCFILES)
|
||||
:CHANGES-TO (VARS MEDLEY-UTILSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "16-Jul-2022 22:08:34" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;8|)
|
||||
:PREVIOUS-DATE "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
|
||||
(RPAQQ MEDLEY-UTILSCOMS
|
||||
((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES PICK)
|
||||
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)
|
||||
|
||||
(* |;;| "hardcopy files")
|
||||
|
||||
(FNS HCFILES BADFILE)
|
||||
(INITVARS (HCFILES)
|
||||
(BADFILES))
|
||||
(COMMANDS "pick")))
|
||||
(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
|
||||
(DEFINEQ
|
||||
|
||||
(GATHER-INFO
|
||||
@@ -130,24 +122,6 @@
|
||||
(MEDLEY-FIX-DATES
|
||||
(LAMBDA (DIRS) (* \; "Edited 28-Jan-2021 12:15 by larry")
|
||||
(|for| X |in| (OR DIRS MEDLEY-FIX-DIRS) |join| (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T))))))
|
||||
|
||||
(PICK
|
||||
(LAMBDA (TYPE CHOICES) (* \; "Edited 25-Jun-2022 16:58 by larry")
|
||||
(SELECTQ (MKATOM (U-CASE (MKSTRING TYPE)))
|
||||
(NIL (PICK (PICK 'ONEOF '(FILE ISSUE PROJECT))))
|
||||
(ISSUE (LET ((ISSUE (PICK 'ONEOF (OR CHOICES (GIT-COMMAND
|
||||
"gh issue list -L 5000 -R interlisp/medley | sed 's/\\([0-9]*\\).*/\\1/'"
|
||||
))))
|
||||
(STR (OPENTEXTSTREAM)))
|
||||
(|for| S |in| (GIT-COMMAND (CL:FORMAT NIL "gh issue view ~a" ISSUE))
|
||||
|do| (CL:FORMAT STR "~a~&" S)
|
||||
|finally| (TEDIT STR NIL NIL `(READONLY T TITLE ,(CL:FORMAT NIL "Issue #~a"
|
||||
ISSUE))))))
|
||||
(DIR (PICK 'ONEOF '(LISPUSERS LIBRARY DOCTOOLS SOURCES INTERNAL)))
|
||||
(FILE (PICK 'ONEOF (DIRECTORY (MEDLEYDIR (PICK 'DIR)))))
|
||||
(PROJECT (PICK 'ONEOF '(CLOS ROOMS LOOPS NOTECARDS ONLINE TEST GITBOOK COMMUNITY ENVOS)))
|
||||
(ONEOF (CAR (NTH CHOICES (RAND 1 (LENGTH CHOICES)))))
|
||||
(HELP TYPE "Unknown type"))))
|
||||
)
|
||||
|
||||
(RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal" "greetfiles" "doctools"))
|
||||
@@ -195,104 +169,8 @@
|
||||
(RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T))
|
||||
(DRIBBLE))))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* |;;| "hardcopy files")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(HCFILES
|
||||
(LAMBDA (TFILE DEST REDOFLG TOPDIRLEN) (* \; "Edited 17-Jul-2022 12:44 by larry")
|
||||
(* \; "Edited 21-Jun-2022 22:59 by larry")
|
||||
(* \; "Edited 31-May-2022 09:31 by larry")
|
||||
(* \; "Edited 20-Feb-2022 12:16 by larry")
|
||||
(* \; "Edited 21-Aug-2021 20:56 by larry")
|
||||
(DECLARE (SPECVARS TFILE))
|
||||
(|if| (NULL TFILE)
|
||||
|then| (SETQ TFILE MEDLEYDIR))
|
||||
(COND
|
||||
((DIRECTORYNAMEP TFILE)
|
||||
|
||||
(* |;;| "canonicalize")
|
||||
|
||||
(SETQ TFILE (DIRECTORYNAME TFILE))
|
||||
(OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING TFILE 'DIRECTORY))))
|
||||
(CL:UNLESS DEST
|
||||
(|ShellCommand| (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
|
||||
"/tmp/psfiles/"))
|
||||
(SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T)))
|
||||
|
||||
(* |;;| "first deal with files in this directory")
|
||||
|
||||
(FOR EXT IN '("TED*" "SKETCH" "T*XT")
|
||||
DO (|for| X |in| (DIRECTORY (CONCAT TFILE "*." EXT ";*"))
|
||||
|do| (HCFILES X DEST REDOFLG TOPDIRLEN)))
|
||||
|
||||
(* |;;| " then deal with subdirs ")
|
||||
|
||||
(|for| X |in| (DIRECTORY (CONCAT TFILE "*"))
|
||||
|when| (|for| SKIP |in| '(">." ">dinfo>") |always| (NOT (STRPOS SKIP (L-CASE X))))
|
||||
|when| (DIRECTORYNAMEP X) |do| (HCFILES X DEST REDOFLG TOPDIRLEN)))
|
||||
((SETQ TFILE (INFILEP TFILE))
|
||||
(LET* ((TF (UNPACKFILENAME.STRING TFILE))
|
||||
(NAME (LISTGET TF 'NAME))
|
||||
(DIR (LISTGET TF 'DIRECTORY))
|
||||
(PSFILE (PACKFILENAME.STRING
|
||||
'EXTENSION
|
||||
(|if| (EQ REDOFLG 'IP)
|
||||
|then| "IP"
|
||||
|else| "PS")
|
||||
'NAME
|
||||
(|if| (EQ DEST T)
|
||||
|then| (* \; "with the tedit file")
|
||||
NAME
|
||||
|else| (CONCAT (PACK (SUBST '- '> (UNPACK (SUBSTRING DIR (IPLUS 2 TOPDIRLEN
|
||||
)
|
||||
-1))))
|
||||
"-" NAME))
|
||||
'HOST
|
||||
(LISTGET TF 'HOST)
|
||||
'DIRECTORY
|
||||
(|if| (EQ DEST T)
|
||||
|then| DIR
|
||||
|else| DEST)))
|
||||
(TEXTSTREAM))
|
||||
(|if| (AND (NOT REDOFLG)
|
||||
(INFILEP PSFILE))
|
||||
|then| (* \; " do nothing")
|
||||
(PRINTOUT T PSFILE " already there" T)
|
||||
|elseif| (EQ REDOFLG 'TEST)
|
||||
|then| (PRINTOUT T TFILE "-> " PSFILE T)
|
||||
(CLOSEF (OPENTEXTSTREAM TFILE))
|
||||
ELSEIF (MEMBER TFILE BADFILES)
|
||||
THEN (PRINTOUT T "Skipping " TFILE " on BADFILES")
|
||||
|else| (PRINTOUT T "Converting " TFILE " to " PSFILE "...")
|
||||
(TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
|
||||
PSFILE T NIL NIL NIL (|if| (EQ REDOFLG 'IP)
|
||||
|then| 'INTERPRESS
|
||||
|else| 'POSTSCRIPT))
|
||||
(|printout| T " DONE" T)
|
||||
(CLOSEF? TEXTSTREAM))))
|
||||
(T (PRINTOUT T "no such file " T)))))
|
||||
|
||||
(BADFILE
|
||||
(LAMBDA NIL (* \; "Edited 22-Jun-2022 09:40 by larry")
|
||||
(PUSHNEW BADFILES TFILE)
|
||||
(LET ((STR (OPENSTREAM "BADFILES.TXT" 'APPEND)))
|
||||
(SETFILEPTR STR -1)
|
||||
(PRINT TFILE STR)
|
||||
(CLOSEF STR))
|
||||
(RETFROM 'HCFILES)))
|
||||
)
|
||||
|
||||
(RPAQ? HCFILES )
|
||||
|
||||
(RPAQ? BADFILES )
|
||||
|
||||
(DEFCOMMAND "pick" (FIRST . REST) (PICK FIRST REST))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (727 8702 (GATHER-INFO 737 . 6147) (MAKE-FULLER-DB 6149 . 6839) (MEDLEY-FIX-LINKS 6841
|
||||
. 7238) (MEDLEY-FIX-DATES 7240 . 7482) (PICK 7484 . 8700)) (9741 11534 (MAKE-EXPORTS-ALL 9751 . 10710
|
||||
) (MAKE-WHEREIS-HASH 10712 . 11532)) (11569 15829 (HCFILES 11579 . 15514) (BADFILE 15516 . 15827)))))
|
||||
(FILEMAP (NIL (600 7357 (GATHER-INFO 610 . 6020) (MAKE-FULLER-DB 6022 . 6712) (MEDLEY-FIX-LINKS 6714
|
||||
. 7111) (MEDLEY-FIX-DATES 7113 . 7355)) (8396 10189 (MAKE-EXPORTS-ALL 8406 . 9365) (MAKE-WHEREIS-HASH
|
||||
9367 . 10187)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,105 +0,0 @@
|
||||
(FILECREATED "24-Mar-86 15:18:14" {ERIS}<LISPCORE>SOURCES>FLOPPYTESTER.;9 4308
|
||||
|
||||
changes to: (FNS STARTTEST STOPTEST KILLTEST)
|
||||
(VARS FLOPPYTESTERCOMS)
|
||||
|
||||
previous date: "20-Mar-86 21:06:46" {ERIS}<LISPCORE>SOURCES>FLOPPYTESTER.;5)
|
||||
|
||||
|
||||
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
|
||||
|
||||
(PRETTYCOMPRINT FLOPPYTESTERCOMS)
|
||||
|
||||
(RPAQQ FLOPPYTESTERCOMS ((* * FLOPPYTESTER -- Runs FILEBANGER on FLOPPY. *)
|
||||
(P (LOAD? (QUOTE {ERINYES}<TEST>TOOLS>FILEBANGER.DCOM)))
|
||||
(INITVARS (ALLOCATIONSW NIL))
|
||||
(FNS STARTTEST STOPTEST KILLTEST BLTALLOCS BLTALLOC)))
|
||||
(* * FLOPPYTESTER -- Runs FILEBANGER on FLOPPY. *)
|
||||
|
||||
(LOAD? (QUOTE {ERINYES}<TEST>TOOLS>FILEBANGER.DCOM))
|
||||
|
||||
(RPAQ? ALLOCATIONSW NIL)
|
||||
(DEFINEQ
|
||||
|
||||
(STARTTEST
|
||||
(LAMBDA (N) (* kbr: "24-Mar-86 15:15")
|
||||
(SETQ STARTTIME (GDATE))
|
||||
(CNDIR (QUOTE {FLOPPY}))
|
||||
(FLOPPY.FORMAT (QUOTE TEST))
|
||||
(DIRECTORY (QUOTE {FLOPPY}*))
|
||||
(BLTALLOCS)
|
||||
(for I from 1 to N do (DOFILEBANGER (PACK* (QUOTE {FLOPPY})
|
||||
(QUOTE TESTFILE)
|
||||
I)
|
||||
(RAND 10 30)))))
|
||||
|
||||
(STOPTEST
|
||||
(LAMBDA NIL (* kbr: "24-Mar-86 15:16")
|
||||
(SETQ STOPTIME (GDATE))
|
||||
(for P in FILEBANGERS when (NOT (EQ P (THIS.PROCESS))) do (SUSPEND.PROCESS P))))
|
||||
|
||||
(KILLTEST
|
||||
(LAMBDA NIL (* kbr: "22-Mar-86 17:18")
|
||||
(for P in FILEBANGERS do (DEL.PROCESS P))
|
||||
(SETQ FILEBANGERS NIL)))
|
||||
|
||||
(BLTALLOCS
|
||||
[LAMBDA NIL (* kbr: "18-Nov-85 12:32")
|
||||
(* Debugging fn. Puts up a window representation of
|
||||
allocations on floppy. *)
|
||||
(PROG (PIXELS XLENGTH YLENGTH)
|
||||
(SETQ PIXELS 5)
|
||||
(SETQ XLENGTH (ITIMES \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
|
||||
(SETQ YLENGTH \FLOPPY.CYLINDERS)
|
||||
[COND
|
||||
((NULL ALLOCATIONSW)
|
||||
(SETQ ALLOCATIONSW (CREATEW (GETBOXREGION (WIDTHIFWINDOW (ITIMES PIXELS
|
||||
XLENGTH))
|
||||
(HEIGHTIFWINDOW (ITIMES PIXELS
|
||||
YLENGTH)
|
||||
T)
|
||||
NIL NIL NIL
|
||||
"Position FLOPPY ALLOCATIONS window")
|
||||
"FLOPPY ALLOCATIONS"))
|
||||
(UNADVISE (QUOTE \PFLOPPY.ALLOCATE))
|
||||
(ADVISE (QUOTE \PFLOPPY.ALLOCATE)
|
||||
(QUOTE AFTER)
|
||||
(QUOTE (COND (!VALUE (BLTALLOC !VALUE]
|
||||
(BITBLT NIL NIL NIL ALLOCATIONSW NIL NIL NIL NIL (QUOTE TEXTURE)
|
||||
(QUOTE REPLACE)
|
||||
WHITESHADE)
|
||||
(for Y from 0 to (SUB1 YLENGTH) do (for X from 0 to (SUB1 XLENGTH)
|
||||
do (BITMAPBIT ALLOCATIONSW
|
||||
(ITIMES PIXELS X)
|
||||
(ITIMES PIXELS Y)
|
||||
1)))
|
||||
(for PFALLOC in (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)
|
||||
when [NOT (EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
|
||||
(QUOTE (FREE]
|
||||
do (BLTALLOC PFALLOC])
|
||||
|
||||
(BLTALLOC
|
||||
[LAMBDA (PFALLOC) (* kbr: "18-Nov-85 12:21")
|
||||
(PROG (SHADE OPSHADE LEFT BOTTOM PIXELS XLENGTH)
|
||||
(SETQ PIXELS 5)
|
||||
(SETQ XLENGTH (ITIMES \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
|
||||
(SETQ SHADE (COND
|
||||
((EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
|
||||
(QUOTE (FREE)))
|
||||
WHITESHADE)
|
||||
(T BLACKSHADE)))
|
||||
(SETQ OPSHADE (IDIFFERENCE BLACKSHADE SHADE))
|
||||
(for I from (fetch (PFALLOC START) of PFALLOC) to (fetch (PFALLOC END)
|
||||
of PFALLOC)
|
||||
do (SETQ LEFT (ITIMES PIXELS (IREMAINDER (SUB1 I)
|
||||
XLENGTH)))
|
||||
(SETQ BOTTOM (ITIMES PIXELS (IQUOTIENT (SUB1 I)
|
||||
XLENGTH)))
|
||||
(BLTSHADE SHADE ALLOCATIONSW LEFT BOTTOM PIXELS PIXELS (QUOTE REPLACE))
|
||||
(BLTSHADE OPSHADE ALLOCATIONSW LEFT BOTTOM 1 1 (QUOTE REPLACE])
|
||||
)
|
||||
(PUTPROPS FLOPPYTESTER COPYRIGHT ("Xerox Corporation" 1985 1986))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (745 4220 (STARTTEST 755 . 1203) (STOPTEST 1205 . 1463) (KILLTEST 1465 . 1665) (
|
||||
BLTALLOCS 1667 . 3253) (BLTALLOC 3255 . 4218)))))
|
||||
STOP
|
||||
@@ -1,242 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "26-Jun-90 19:15:35" |{DSK}<usr>local>lde>lispcore>internal>library>RS232TEST.;2| 9419
|
||||
|
||||
|changes| |to:| (VARS RS232TESTCOMS)
|
||||
|
||||
|previous| |date:| "20-Feb-87 00:10:14"
|
||||
|{DSK}<usr>local>lde>lispcore>internal>library>RS232TEST.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1987, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(PRETTYCOMPRINT RS232TESTCOMS)
|
||||
|
||||
(RPAQQ RS232TESTCOMS
|
||||
((FNS RSTEST TESTCLEANUP XMITTEST)
|
||||
|
||||
(* |;;|
|
||||
"Exhaustive test for RS-232 for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
|
||||
|
||||
(FNS RS232.TEST RS232.MICROTEST RS232.QUICKTEST RS232.MENU RS232TMENU.SELFN)
|
||||
(VARS RS232.TEST.MENU.ITEMS)
|
||||
|
||||
(* |;;|
|
||||
"Exhaustive test for the TTY port for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
|
||||
|
||||
(FNS TTY.TEST TTY.MICROTEST TTY.QUICKTEST TTY.MENU TTYTMENU.SELFN)))
|
||||
(DEFINEQ
|
||||
|
||||
(rstest
|
||||
(lambda nil (* \; "Edited 14-Jan-87 16:00 by jds")
|
||||
(let (oo)
|
||||
(resetlst (resetsave (setq oo (openstream '{rs232} 'output))
|
||||
'closef?)
|
||||
(|for| i |from| 1 |do| (printout oo "Line " i
|
||||
": 1 2 3 4 5 6 7 8 9 0 9 8 7 6 5 4 3 2 1.
|
||||
\
|
||||
")
|
||||
(printout t "Line " i t))))))
|
||||
|
||||
(testcleanup
|
||||
(lambda nil (* \; "Edited 16-Jan-87 09:51 by jds")
|
||||
|
||||
(* |;;| "Close the streams used by the rs232 test.")
|
||||
|
||||
(and (boundp 'out)
|
||||
out
|
||||
(closef? out))
|
||||
(and (boundp in)
|
||||
in
|
||||
(closef? in))))
|
||||
|
||||
(XMITTEST
|
||||
(LAMBDA (BAUDRATE XONXOFF?) (* \; "Edited 19-Feb-87 20:59 by jds")
|
||||
|
||||
(* |;;| "Set up the rs232 port at BAUDRATE with XOn-XOff flow control if XONXOFF? is T. Then print forever, lines of text. Show an indication on the screen for each line, so the user can tell if flow control has shut things off.")
|
||||
|
||||
(RS232C.INIT BAUDRATE 8 'NONE 1 (COND
|
||||
(XONXOFF? 'XONXOFF)
|
||||
(T 'NONE)))
|
||||
(SETQ OUT (OPENSTREAM '{RS232} 'OUTPUT))
|
||||
(SETQ IN (OPENSTREAM '{RS232} 'INPUT))
|
||||
(ERSETQ (FOR I FROM 1 DO (PRINTOUT OUT "Line " I ": 0 1 2 3 4 5 6 7 8 9 0 9 8 7 6 5 4 3 2 1.
|
||||
\
|
||||
")
|
||||
(|printout| T "Line " I T)))
|
||||
(CLOSEF? OUT)
|
||||
(CLOSEF? IN)))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* |;;| "Exhaustive test for RS-232 for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(rs232.test
|
||||
(lambda nil (* \; "Edited 19-Feb-87 22:43 by jds")
|
||||
|
||||
(* |;;| "Run quickly thru all the possible combinations of RS-232 bit lengths and parities and stop bits for testing sake.")
|
||||
|
||||
(printout t t t "Starting RS-232 port test." t
|
||||
"Make sure the line monitor is attached to the RS-232 port, "
|
||||
"and its cable goes to the DCE socket on the monitor." t)
|
||||
(mouseconfirm)
|
||||
(printout t "Set the line monitor for: " t)
|
||||
(|for| bits |in| '(5 6 7 8) |do| (|for| parity |in| '(none odd even)
|
||||
|do| (|for| stopbits |in| '(1 1.5 2)
|
||||
|do| (rs232.microtest 9600 bits parity stopbits))))))
|
||||
|
||||
(rs232.microtest
|
||||
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:37 by jds")
|
||||
|
||||
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
|
||||
|
||||
(printout t bits "bits, " (cond
|
||||
((eq parity 'none)
|
||||
"NO")
|
||||
(t parity))
|
||||
" parity, " stopbits " stop bits..." t)
|
||||
(mouseconfirm)
|
||||
(rs232.quicktest speed bits parity stopbits)))
|
||||
|
||||
(rs232.quicktest
|
||||
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:38 by jds")
|
||||
|
||||
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
|
||||
|
||||
(rs232c.init speed bits parity stopbits 'none)
|
||||
(let ((out (openstream '{rs232} 'output)))
|
||||
(prin1 (concat "0123 ABC abc " (packc '(1 2 3 255)))
|
||||
out)
|
||||
(closef out))))
|
||||
|
||||
(rs232.menu
|
||||
(lambda nil (* \; "Edited 19-Feb-87 22:45 by jds")
|
||||
(let ((ww (addmenu (|create| menu
|
||||
menucolumns _ 4
|
||||
items _ rs232.test.menu.items
|
||||
whenselectedfn _ (function rs232tmenu.selfn)))))
|
||||
(windowprop ww 'title "RS-232 Tests"))))
|
||||
|
||||
(rs232tmenu.selfn
|
||||
(lambda (item menu key) (* \; "Edited 19-Feb-87 22:57 by jds")
|
||||
|
||||
(* |;;| "Called from the RS-232 test menu")
|
||||
|
||||
(let* ((info (cadr item))
|
||||
(bits (car info))
|
||||
(parity (cadr info))
|
||||
(stopbits (caddr info)))
|
||||
(rs232.quicktest 9600 bits parity stopbits))))
|
||||
)
|
||||
|
||||
(RPAQQ RS232.TEST.MENU.ITEMS
|
||||
((|5/N/1| (5 NONE 1))
|
||||
(|6/N/1| (6 NONE 1))
|
||||
(|7/N/1| (7 NONE 1))
|
||||
(|8/N/1| (8 NONE 1))
|
||||
(|5/N/1.5| (5 NONE 1.5))
|
||||
(|6/N/1.5| (6 NONE 1.5))
|
||||
(|7/N/1.5| (7 NONE 1.5))
|
||||
(|8/N/1.5| (8 NONE 1.5))
|
||||
(|5/N/2| (5 NONE 2))
|
||||
(|6/N/2| (6 NONE 2))
|
||||
(|7/N/2| (7 NONE 2))
|
||||
(|8/N/2| (8 NONE 2))
|
||||
(|5/O/1| (5 ODD 1))
|
||||
(|6/O/1| (6 ODD 1))
|
||||
(|7/O/1| (7 ODD 1))
|
||||
(|8/O/1| (8 ODD 1))
|
||||
(|5/O/1.5| (5 ODD 1.5))
|
||||
(|6/O/1.5| (6 ODD 1.5))
|
||||
(|7/O/1.5| (7 ODD 1.5))
|
||||
(|8/O/1.5| (8 ODD 1.5))
|
||||
(|5/O/2| (5 ODD 2))
|
||||
(|6/O/2| (6 ODD 2))
|
||||
(|7/O/2| (7 ODD 2))
|
||||
(|8/O/2| (8 ODD 2))
|
||||
(|5/E/1| (5 EVEN 1))
|
||||
(|6/E/1| (6 EVEN 1))
|
||||
(|7/E/1| (7 EVEN 1))
|
||||
(|8/E/1| (8 EVEN 1))
|
||||
(|5/E/1.5| (5 EVEN 1.5))
|
||||
(|6/E/1.5| (6 EVEN 1.5))
|
||||
(|7/E/1.5| (7 EVEN 1.5))
|
||||
(|8/E/1.5| (8 EVEN 1.5))
|
||||
(|5/E/2| (5 EVEN 2))
|
||||
(|6/E/2| (6 EVEN 2))
|
||||
(|7/E/2| (7 EVEN 2))
|
||||
(|8/E/2| (8 EVEN 2))))
|
||||
|
||||
|
||||
|
||||
(* |;;|
|
||||
"Exhaustive test for the TTY port for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(tty.test
|
||||
(lambda nil (* \; "Edited 19-Feb-87 22:42 by jds")
|
||||
|
||||
(* |;;| "Run quickly thru all the possible combinations of RS-232 bit lengths and parities and stop bits for testing sake.")
|
||||
|
||||
(printout t t t "Starting TTY port test." t
|
||||
"Make sure the line monitor is attached to the TTY port, "
|
||||
"and its cable goes to the DTE socket on the monitor." t)
|
||||
(mouseconfirm)
|
||||
(printout t "Set the line monitor for: " t)
|
||||
(|for| bits |in| '(5 6 7 8) |do| (|for| parity |in| '(none odd even)
|
||||
|do| (|for| stopbits |in| '(1 1.5 2)
|
||||
|do| (tty.microtest 9600 bits parity stopbits))))))
|
||||
|
||||
(tty.microtest
|
||||
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:41 by jds")
|
||||
|
||||
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
|
||||
|
||||
(printout t bits "bits, " (cond
|
||||
((eq parity 'none)
|
||||
"NO")
|
||||
(t parity))
|
||||
" parity, " stopbits " stop bits..." t)
|
||||
(mouseconfirm)
|
||||
(tty.init speed bits parity stopbits)))
|
||||
|
||||
(tty.quicktest
|
||||
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:40 by jds")
|
||||
|
||||
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
|
||||
|
||||
(tty.init speed bits parity stopbits 'none)
|
||||
(let ((out (openstream '{tty} 'output)))
|
||||
(prin1 (concat "0123 ABC abc " (packc '(1 2 3 255)))
|
||||
out)
|
||||
(closef out))))
|
||||
|
||||
(tty.menu
|
||||
(lambda nil (* \; "Edited 19-Feb-87 22:57 by jds")
|
||||
(let ((ww (addmenu (|create| menu
|
||||
menucolumns _ 4
|
||||
items _ rs232.test.menu.items
|
||||
whenselectedfn _ (function ttytmenu.selfn)))))
|
||||
(windowprop ww 'title "TTY Tests"))))
|
||||
|
||||
(ttytmenu.selfn
|
||||
(lambda (item menu key) (* \; "Edited 19-Feb-87 22:59 by jds")
|
||||
|
||||
(* |;;| "Called from the RS-232 test menu")
|
||||
|
||||
(let* ((info (cadr item))
|
||||
(bits (car info))
|
||||
(parity (cadr info))
|
||||
(stopbits (caddr info)))
|
||||
(tty.quicktest 9600 bits parity stopbits))))
|
||||
)
|
||||
(PUTPROPS RS232TEST COPYRIGHT ("Venue & Xerox Corporation" 1987 1990))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (979 2623 (RSTEST 989 . 1466) (TESTCLEANUP 1468 . 1789) (XMITTEST 1791 . 2621)) (2732
|
||||
5433 (RS232.TEST 2742 . 3570) (RS232.MICROTEST 3572 . 4151) (RS232.QUICKTEST 4153 . 4640) (RS232.MENU
|
||||
4642 . 5042) (RS232TMENU.SELFN 5044 . 5431)) (6665 9325 (TTY.TEST 6675 . 7493) (TTY.MICROTEST 7495 .
|
||||
8061) (TTY.QUICKTEST 8063 . 8543) (TTY.MENU 8545 . 8938) (TTYTMENU.SELFN 8940 . 9323)))))
|
||||
STOP
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1 +0,0 @@
|
||||
12345
|
||||
Binary file not shown.
@@ -1 +0,0 @@
|
||||
aδσγδφβc
|
||||
Binary file not shown.
Binary file not shown.
@@ -1 +0,0 @@
|
||||
012345X1245
|
||||
@@ -1,495 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Jul-2022 14:07:11"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>internal>test>filepos>TFP.;31 27425
|
||||
|
||||
:CHANGES-TO (FNS TFP TFP1)
|
||||
|
||||
:PREVIOUS-DATE " 3-Jul-2022 13:32:16"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>internal>test>filepos>TFP.;27)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TFPCOMS)
|
||||
|
||||
(RPAQQ TFPCOMS
|
||||
((FNS TFP TFP1 FPC FPCS)
|
||||
(FNS OLDFILEPOS OLDFFILEPOS)
|
||||
(FILES FPTESTS)
|
||||
(ADDVARS (DIRECTORIES {WMEDLEY}<internal>test>filepos>))
|
||||
|
||||
(* ;; "Compiling also requires EXPORTS.ALL")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
IOCHAR))))
|
||||
(DEFINEQ
|
||||
|
||||
(TFP
|
||||
[LAMBDA (TESTNAMES TAGS FN) (* ; "Edited 3-Jul-2022 14:06 by rmk")
|
||||
(CL:UNLESS TESTNAMES (SETQ TESTNAMES ALLTESTS))
|
||||
(LET [(TESTS (FOR TN INSIDE TESTNAMES FIRST (PRINTOUT T "Testing")
|
||||
JOIN (PRINTOUT T " " TN)
|
||||
(CONS (MKSTRING TN)
|
||||
(COPY (EVALV TN))) FINALLY (TERPRI T]
|
||||
(CL:WHEN TAGS
|
||||
(SETQ TESTS (FOR TEST IN TESTS WHEN (THEREIS TAG INSIDE TAGS
|
||||
SUCHTHAT (MEMB TAG TEST)) COLLECT TEST)))
|
||||
(PRINTOUT T (LENGTH TESTS)
|
||||
" tests" T)
|
||||
(FOR TEST VAL COMMENT PRINTED IN TESTS EACHTIME (CL:WHEN (STRINGP TEST)
|
||||
(SETQ COMMENT TEST)
|
||||
(SETQ PRINTED NIL))
|
||||
WHEN [AND (LISTP TEST)
|
||||
(NOT (AND FN (CADDR TEST] UNLESS (EQUAL (CAR TEST)
|
||||
(SETQ VAL (TFP1 (CADR TEST)
|
||||
FN)))
|
||||
COLLECT (CL:WHEN COMMENT
|
||||
(CL:UNLESS PRINTED (PRINTOUT T COMMENT T)))
|
||||
(PRINTOUT T 5 VAL " <- " .P2 TEST T)
|
||||
(CONS VAL TEST])
|
||||
|
||||
(TFP1
|
||||
[LAMBDA (FPARGS FN) (* ; "Edited 3-Jul-2022 14:04 by rmk")
|
||||
|
||||
(* ;; "FN is the search function to apply: NIL = FILEPOS, OLDFILEPOS, FFILEPOS. OLDFFILEPOS")
|
||||
|
||||
(* ;; "For convenience: NIL -> FILEPOS, OF -> OLDFILEPOS, FF -> FFILEPOS, OFF -> OLDFFILEPOS.")
|
||||
|
||||
(* ;; "OLDFILEPOS and OLDFFILEPOS do only a byte searches.")
|
||||
|
||||
(* ;;
|
||||
"FPARGS is a list of FILEPOS args. CASEARRAY=T means Transparent case array, pushes to FFILEPOS. ")
|
||||
|
||||
(* ;; "The file extension gives the format, defaulting to *DEFAULT-EXTERNALFORMAT* = :XCCS")
|
||||
|
||||
(SETQ FN (SELECTQ FN
|
||||
((NIL FILEPOS)
|
||||
'FILEPOS)
|
||||
((FF FFILEPOS)
|
||||
'FFILEPOS)
|
||||
((OF OLDFILEPOS)
|
||||
'OLDFILEPOS)
|
||||
((OFF OLDFFILEPOS)
|
||||
'OLDFFILEPOS)
|
||||
(HELP "BAD FN" FN)))
|
||||
(CL:WHEN (OR (FIXP (CAR FPARGS))
|
||||
(NULL (CAR FPARGS))
|
||||
(AND (LISTP (CAR FPARGS))
|
||||
(FIXP (CAAR FPARGS))
|
||||
(FIXP (CDAR FPARGS)))
|
||||
(LISTP (CADR FPARGS)))
|
||||
(SETQ FPARGS (CADR FPARGS)))
|
||||
(LET (STREAM VAL PATTERN FILE START END SKIP TAIL CASEARRAY EXT (FORMAT *DEFAULT-EXTERNALFORMAT*)
|
||||
)
|
||||
(SETQ PATTERN (EVAL (POP FPARGS))) (* ;
|
||||
"So we can do substrings, CHARACTER etc.")
|
||||
(SETQ FILE (POP FPARGS))
|
||||
(SETQ START (POP FPARGS))
|
||||
(SETQ END (POP FPARGS))
|
||||
(SETQ SKIP (POP FPARGS))
|
||||
(SETQ TAIL (POP FPARGS))
|
||||
(SETQ CASEARRAY (POP FPARGS))
|
||||
(SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
|
||||
(CL:WHEN EXT
|
||||
(CL:WHEN (STRPOS "UTF8" EXT)
|
||||
(SETQ EXT "UTF-8"))
|
||||
[SETQ FORMAT (FIND-FORMAT (CL:INTERN EXT 'KEYWORD])
|
||||
[SETQ STREAM (OPENSTREAM (OR (FINDFILE FILE T)
|
||||
FILE)
|
||||
'INPUT NIL `((FORMAT ,FORMAT]
|
||||
(SETQ CASEARRAY (IF (EQ CASEARRAY T)
|
||||
THEN (CASEARRAY)
|
||||
ELSE (EVAL CASEARRAY)))
|
||||
(SETQ VAL (APPLY* FN PATTERN STREAM START END SKIP TAIL CASEARRAY))
|
||||
(CLOSEF? STREAM)
|
||||
VAL])
|
||||
|
||||
(FPC
|
||||
[LAMBDA (STR FILE START END SKIP TAIL CASEARRAY) (* ; "Edited 29-Jun-2022 21:22 by rmk")
|
||||
|
||||
(* ;; "Compare old and new filepos")
|
||||
|
||||
(LET (OLD NEW EXT FORMAT)
|
||||
(CL:UNLESS (STREAMP FILE)
|
||||
(SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
|
||||
(SETQ FORMAT (CL:INTERN EXT 'KEYWORD))
|
||||
(CL:UNLESS (FIND-FORMAT FORMAT T)
|
||||
(SETQ FORMAT :XCCS))
|
||||
(STREAMPROP FILE 'FORMAT FORMAT))
|
||||
(SETQ OLD (OLDFILEPOS STR FILE START END SKIP TAIL CASEARRAY))
|
||||
(SETQ NEW (FILEPOS STR FILE START END SKIP TAIL CASEARRAY))
|
||||
(CLOSEF FILE)
|
||||
(CL:UNLESS (EQUAL OLD (IF (EQ TAIL 'BOTH)
|
||||
THEN (CDR NEW)
|
||||
ELSE NEW))
|
||||
(HELP (CONCAT "OLD=" (OR OLD "NIL")
|
||||
" NEW="
|
||||
(OR NEW "NIL"))))
|
||||
(LIST OLD NEW])
|
||||
|
||||
(FPCS
|
||||
[LAMBDA (STR FILE START END SKIP TAIL) (* ; "Edited 29-Jun-2022 23:56 by rmk")
|
||||
(* ; "Edited 28-Jun-2022 22:21 by rmk")
|
||||
|
||||
(* ;; "Compare old and new slow filepos")
|
||||
|
||||
(LET (FAST SLOW EXT FORMAT)
|
||||
(CL:UNLESS (STREAMP FILE)
|
||||
(SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
|
||||
(SETQ FORMAT (CL:INTERN EXT 'KEYWORD))
|
||||
(CL:UNLESS (FIND-FORMAT FORMAT T)
|
||||
(SETQ FORMAT :XCCS))
|
||||
(STREAMPROP FILE 'FORMAT FORMAT))
|
||||
(SETQ FAST (FILEPOS STR FILE START END SKIP TAIL))
|
||||
(SETQ SLOW (FILEPOS STR FILE START END SKIP TAIL (CASEARRAY)))
|
||||
(CLOSEF FILE)
|
||||
(CL:UNLESS (EQUAL FAST SLOW)
|
||||
(HELP (CONCAT "FAST=" (OR FAST "NIL")
|
||||
" SLOW="
|
||||
(OR SLOW "NIL"))))
|
||||
(LIST FAST SLOW])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(OLDFILEPOS
|
||||
[LAMBDA (STR FILE START END SKIP TAIL CASEARRAY) (* ; "Edited 27-Jun-2022 23:35 by rmk")
|
||||
(* ; "Edited 10-Aug-2020 21:44 by rmk:")
|
||||
(* Pavel "12-Oct-86 15:13")
|
||||
|
||||
(* ;; "RMK: Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")
|
||||
|
||||
(* ;; "NB: this function now works on non-PAGEMAPPED files. It must use only IO functions that respect that.")
|
||||
|
||||
(PROG ((SKIPCHAR (AND SKIP (CHCON1 SKIP)))
|
||||
[CA (fetch (ARRAYP BASE) of (COND
|
||||
[CASEARRAY (COND
|
||||
((AND (ARRAYP CASEARRAY)
|
||||
(EQ (fetch (ARRAYP TYP) of CASEARRAY)
|
||||
\ST.BYTE))
|
||||
CASEARRAY)
|
||||
(T (CASEARRAY CASEARRAY]
|
||||
(T \TRANSPARENT]
|
||||
(STREAM (\GETSTREAM FILE 'INPUT))
|
||||
CHAR FIRSTCHAR STRBASE STRINDEX PATLEN PATINDEX ORGFILEPTR LASTINDEX STARTBYTE ENDBYTE
|
||||
BIGENDBYTE STARTSEG ENDSEG)
|
||||
(CL:WHEN (EQ :UTF-8 (\EXTERNALFORMAT STREAM))
|
||||
(SETQ STR (XTOUSTRING STR)))
|
||||
[COND
|
||||
((LITATOM STR)
|
||||
(SETQ STRBASE (fetch (LITATOM PNAMEBASE) of STR))
|
||||
(SETQ STRINDEX 1)
|
||||
(SETQ PATLEN (fetch (LITATOM PNAMELENGTH) of STR)))
|
||||
(T (OR (STRINGP STR)
|
||||
(SETQ STR (MKSTRING STR)))
|
||||
(SETQ STRBASE (fetch (STRINGP BASE) of STR))
|
||||
(SETQ STRINDEX (fetch (STRINGP OFFST) of STR))
|
||||
(SETQ PATLEN (fetch (STRINGP LENGTH) of STR] (* ;
|
||||
"calculate start addr and set file ptr.")
|
||||
[SETQ STARTBYTE (COND
|
||||
(START (COND
|
||||
((NOT (AND (FIXP START)
|
||||
(IGEQ START 0)))
|
||||
(LISPERROR "ILLEGAL ARG" START)))
|
||||
(SETQ ORGFILEPTR (\GETFILEPTR STREAM))
|
||||
(\SETFILEPTR STREAM START)
|
||||
START)
|
||||
(T (SETQ ORGFILEPTR (\GETFILEPTR STREAM]
|
||||
(* ;
|
||||
"calculate the character address of the character after the last possible match.")
|
||||
[SETQ ENDBYTE (ADD1 (COND
|
||||
((NULL END) (* ; "Default is end of file")
|
||||
(IDIFFERENCE (\GETEOFPTR STREAM)
|
||||
PATLEN))
|
||||
((IGEQ END 0) (* ; "Absolute byte pointer given")
|
||||
(IMIN END (IDIFFERENCE (\GETEOFPTR STREAM)
|
||||
PATLEN)))
|
||||
((IGREATERP PATLEN (IMINUS END))
|
||||
(* ;
|
||||
"END is too far, use eof less length")
|
||||
(IDIFFERENCE (\GETEOFPTR STREAM)
|
||||
PATLEN))
|
||||
(T (IDIFFERENCE (IPLUS (\GETEOFPTR STREAM)
|
||||
END 1)
|
||||
PATLEN]
|
||||
|
||||
(* ;; "use STARTBYTE and ENDBYTE instead of START and END because vm functions shouldn't change their arguments.")
|
||||
|
||||
(COND
|
||||
((IGEQ STARTBYTE ENDBYTE) (* ; "nothing to search")
|
||||
(GO FAILED)))
|
||||
(SETQ LASTINDEX PATLEN)
|
||||
SKIPLP
|
||||
(* ;
|
||||
"set the first character to FIRSTCHAR, handling leading skips.")
|
||||
(COND
|
||||
((EQ LASTINDEX 0) (* ; "null case")
|
||||
(GO FOUNDIT))
|
||||
((EQ (SETQ FIRSTCHAR (\GETBASEBYTE CA (\GETBASEBYTE STRBASE STRINDEX)))
|
||||
SKIPCHAR) (* ;
|
||||
"first character in pattern is skip.")
|
||||
(SETQ LASTINDEX (SUB1 LASTINDEX))
|
||||
(\BIN STREAM) (* ; "Move forward a character.")
|
||||
(add STRINDEX 1)
|
||||
(add STARTBYTE 1)
|
||||
(GO SKIPLP)))
|
||||
(SETQ LASTINDEX (IPLUS LASTINDEX STRINDEX)) (* ;
|
||||
"Used for end of pattern check, comparing against current INDEX")
|
||||
[COND
|
||||
((SMALLP ENDBYTE)
|
||||
(SETQ STARTSEG (SETQ ENDSEG 0)))
|
||||
(T
|
||||
(* ;; "The search will be in the large integers at least part of the time, so split the start and end fileptrs into hi and lo parts. The `segment' size we choose is smaller than 2^16 so that we are still smallp near the boundary (can get around that here by decrementing everyone, but can't in FFILEPOS). Note that STARTBYTE and ENDBYTE are never actually used as file ptrs, just for counting.")
|
||||
|
||||
(SETQ ENDSEG (FOLDLO ENDBYTE FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ BIGENDBYTE (IMOD ENDBYTE FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ STARTSEG (FOLDLO STARTBYTE FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ STARTBYTE (IMOD STARTBYTE FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ ENDBYTE (COND
|
||||
((EQ STARTSEG ENDSEG)
|
||||
BIGENDBYTE)
|
||||
(T
|
||||
|
||||
(* ;; "In different segments, so we'll have to search all the way to the end of this seg; hence, `end' is currently as big as it gets")
|
||||
|
||||
FILEPOS.SEGMENT.SIZE]
|
||||
FIRSTCHARLP
|
||||
|
||||
|
||||
(* ;; "STARTBYTE is the possible beginning of a match. the file ptr of the file is always at STARTBYTE position when the FIRSTCHAR loop is passed.")
|
||||
|
||||
(COND
|
||||
((EQ STARTBYTE ENDBYTE) (* ; "end of this part of search")
|
||||
(COND
|
||||
((EQ STARTSEG ENDSEG) (* ; "failed")
|
||||
(GO FAILED))) (* ;
|
||||
"Finished this segment, roll over into new one")
|
||||
(SETQ STARTBYTE 0) (* ; "= STARTBYTE-FILEPOS.SEGMENT.SIZE")
|
||||
[COND
|
||||
((EQ (add STARTSEG 1)
|
||||
ENDSEG) (* ;
|
||||
"Entering final segment, so set ENDBYTE to actual end instead of segment end")
|
||||
(COND
|
||||
((EQ (SETQ ENDBYTE BIGENDBYTE)
|
||||
0)
|
||||
(GO FAILED]
|
||||
(GO FIRSTCHARLP))
|
||||
((NEQ FIRSTCHAR (\GETBASEBYTE CA (\BIN STREAM)))
|
||||
(add STARTBYTE 1)
|
||||
(GO FIRSTCHARLP)))
|
||||
(SETQ PATINDEX STRINDEX)
|
||||
MATCHLP
|
||||
(* ;
|
||||
"At this point, STR is matched thru offset PATINDEX")
|
||||
(COND
|
||||
((EQ (SETQ PATINDEX (ADD1 PATINDEX))
|
||||
LASTINDEX) (* ; "matched for entire length")
|
||||
(GO FOUNDIT))
|
||||
((OR (EQ (SETQ CHAR (\GETBASEBYTE CA (\GETBASEBYTE STRBASE PATINDEX)))
|
||||
(\GETBASEBYTE CA (\BIN STREAM)))
|
||||
(EQ CHAR SKIPCHAR)) (* ;
|
||||
"Char from file matches char from STR")
|
||||
(GO MATCHLP))
|
||||
(T (* ;
|
||||
"Match failed, so we have to start again with first char")
|
||||
(\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR STREAM)
|
||||
(IDIFFERENCE PATINDEX STRINDEX)))
|
||||
|
||||
(* ;; "Back up over the chars we have just read in trying to match, less one. I.e. go back to one past the previous starting point")
|
||||
|
||||
(add STARTBYTE 1)
|
||||
(GO FIRSTCHARLP)))
|
||||
FOUNDIT
|
||||
(* ;
|
||||
"set fileptr, adjust for beginning skips and return proper value.")
|
||||
[COND
|
||||
((NOT TAIL) (* ;
|
||||
"Fileptr wants to be at start of string")
|
||||
(\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR STREAM)
|
||||
PATLEN]
|
||||
(RETURN (\GETFILEPTR STREAM))
|
||||
FAILED
|
||||
(* ;
|
||||
"return the fileptr to its initial position.")
|
||||
(\SETFILEPTR STREAM ORGFILEPTR)
|
||||
(RETURN NIL])
|
||||
|
||||
(OLDFFILEPOS
|
||||
[LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY) (* ; "Edited 10-Aug-2020 21:44 by rmk:")
|
||||
|
||||
(* ;; "RMK: Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")
|
||||
(* Pavel "12-Oct-86 15:20")
|
||||
(PROG ([STREAM (\GETSTREAM (OR FILE (INPUT]
|
||||
PATBASE PATOFFSET PATLEN ORGFILEPTR STARTOFFSET ENDOFFSET BIGENDOFFSET STARTSEG ENDSEG EOF
|
||||
)
|
||||
(COND
|
||||
(SKIP (* ; "Slow case--use FILEPOS")
|
||||
(GO TRYFILEPOS))
|
||||
((NOT (fetch PAGEMAPPED of (fetch (STREAM DEVICE) of STREAM)))
|
||||
(* ;
|
||||
"This is a non-page-oriented file. Use FILEPOS instead.")
|
||||
(GO TRYFILEPOS))) (* ;
|
||||
"calculate start addr and set file ptr.")
|
||||
(CL:WHEN (EQ :UTF8 (\EXTERNALFORMAT STREAM))
|
||||
(SETQ PATTERN (XTOUSTRING PATTERN)))
|
||||
[COND
|
||||
((LITATOM PATTERN)
|
||||
(SETQ PATBASE (fetch (LITATOM PNAMEBASE) of PATTERN))
|
||||
(SETQ PATOFFSET 1)
|
||||
(SETQ PATLEN (fetch (LITATOM PNAMELENGTH) of PATTERN)))
|
||||
(T (OR (STRINGP PATTERN)
|
||||
(SETQ PATTERN (MKSTRING PATTERN)))
|
||||
(SETQ PATBASE (fetch (STRINGP BASE) of PATTERN))
|
||||
(SETQ PATOFFSET (fetch (STRINGP OFFST) of PATTERN))
|
||||
(SETQ PATLEN (fetch (STRINGP LENGTH) of PATTERN]
|
||||
(COND
|
||||
((OR (IGREATERP PATLEN \MAX.PATTERN.SIZE)
|
||||
(ILESSP PATLEN \MIN.PATTERN.SIZE))
|
||||
(GO TRYFILEPOS)))
|
||||
(SETQ ORGFILEPTR (\GETFILEPTR STREAM))
|
||||
(SETQ STARTOFFSET (IPLUS (COND
|
||||
(START (COND
|
||||
((NOT (AND (FIXP START)
|
||||
(IGEQ START 0)))
|
||||
(LISPERROR "ILLEGAL ARG" START)))
|
||||
START)
|
||||
(T ORGFILEPTR))
|
||||
(SUB1 PATLEN))) (* ;
|
||||
"STARTOFFSET is the address of the character corresponding to the last character of PATTERN.")
|
||||
(SETQ EOF (\GETEOFPTR STREAM)) (* ;
|
||||
"calculate the character address of the character after the last possible match.")
|
||||
[SETQ ENDOFFSET (COND
|
||||
((NULL END) (* ; "Default is end of file")
|
||||
EOF)
|
||||
(T (IMIN (IPLUS (COND
|
||||
((ILESSP END 0)
|
||||
(IPLUS EOF END 1))
|
||||
(T END))
|
||||
PATLEN)
|
||||
EOF]
|
||||
|
||||
(* ;; "use STARTOFFSET and ENDOFFSET instead of START and END because vm functions shouldn't change their arguments.")
|
||||
|
||||
(COND
|
||||
((IGEQ STARTOFFSET ENDOFFSET) (* ; "nothing to search")
|
||||
(RETURN))
|
||||
((ILESSP (IDIFFERENCE ENDOFFSET STARTOFFSET)
|
||||
\MIN.SEARCH.LENGTH) (* ;
|
||||
"too small to make FFILEPOS worthwhile")
|
||||
(GO TRYFILEPOS)))
|
||||
(\SETFILEPTR STREAM STARTOFFSET)
|
||||
[RETURN (GLOBALRESOURCE
|
||||
(\FFDELTA1 \FFDELTA2 \FFPATCHAR)
|
||||
(PROG ((CASE (fetch (ARRAYP BASE)
|
||||
of (COND
|
||||
[CASEARRAY (COND
|
||||
((AND (ARRAYP CASEARRAY)
|
||||
(EQ (fetch (ARRAYP TYP) of CASEARRAY)
|
||||
\ST.BYTE))
|
||||
CASEARRAY)
|
||||
(T (CASEARRAY CASEARRAY]
|
||||
(T \TRANSPARENT))))
|
||||
(DELTA1 (fetch (ARRAYP BASE) of \FFDELTA1))
|
||||
(DELTA2 (fetch (ARRAYP BASE) of \FFDELTA2))
|
||||
(PATCHAR (fetch (ARRAYP BASE) of \FFPATCHAR))
|
||||
(MAXPATINDEX (SUB1 PATLEN))
|
||||
CHAR CURPATINDEX LASTCHAR INC)
|
||||
|
||||
(* ;; "Use Boyer-Moore string search algorithm. Use two auxiliary tables, DELTA1 and DELTA2, to tell how far ahead to move in the file when a partial match fails. DELTA1 contains, for each character code, the distance of that character from the right end of the pattern, or PATLEN if the character does not occur in the pattern. DELTA2 contains, for each character position in the pattern, how far ahead to move such that the partial substring discovered to the right of the position now matches some other substring (to the left) in the pattern. PATCHAR is just PATTERN translated thru CASEARRAY")
|
||||
|
||||
(\SETUP.FFILEPOS PATBASE PATOFFSET PATLEN PATCHAR DELTA1 DELTA2 CASE)
|
||||
[COND
|
||||
((SMALLP ENDOFFSET)
|
||||
(SETQ STARTSEG (SETQ ENDSEG 0)))
|
||||
(T
|
||||
(* ;; "The search will be in the large integers at least part of the time, so split the start and end fileptrs into hi and lo parts. The `segment' size we choose is smaller than 2^16 so that we are still smallp near the boundary. Note that STARTOFFSET and ENDOFFSET are never actually used as file ptrs, just for counting.")
|
||||
|
||||
(SETQ ENDSEG (FOLDLO ENDOFFSET FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ BIGENDOFFSET (MOD ENDOFFSET FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ STARTSEG (FOLDLO STARTOFFSET FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ STARTOFFSET (MOD STARTOFFSET FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ ENDOFFSET (COND
|
||||
((EQ STARTSEG ENDSEG)
|
||||
BIGENDOFFSET)
|
||||
(T
|
||||
|
||||
(* ;; "In different segments, so we'll have to search all the way to the end of this seg; hence, `end' is currently as big as it gets")
|
||||
|
||||
FILEPOS.SEGMENT.SIZE]
|
||||
(SETQ LASTCHAR (GETBASEBYTE PATCHAR MAXPATINDEX))
|
||||
FIRSTCHARLP
|
||||
(COND
|
||||
[(IGEQ STARTOFFSET ENDOFFSET) (* ; "End of this chunk")
|
||||
(COND
|
||||
((EQ STARTSEG ENDSEG) (* ; "failed")
|
||||
(GO FAILED))
|
||||
(T (* ;
|
||||
"Finished this segment, roll over into new one")
|
||||
(add STARTSEG 1)
|
||||
(SETQ STARTOFFSET (IDIFFERENCE STARTOFFSET FILEPOS.SEGMENT.SIZE))
|
||||
(COND
|
||||
((EQ STARTSEG ENDSEG)
|
||||
(SETQ ENDOFFSET BIGENDOFFSET)))
|
||||
(GO FIRSTCHARLP]
|
||||
((NEQ (SETQ CHAR (GETBASEBYTE CASE (\BIN STREAM)))
|
||||
LASTCHAR)
|
||||
(add STARTOFFSET (SETQ INC (GETBASEBYTE DELTA1 CHAR)))
|
||||
(OR (EQ INC 1)
|
||||
(\INCFILEPTR STREAM (SUB1 INC)))
|
||||
(* ;
|
||||
"advance file pointer accordingly (\BIN already advanced it one)")
|
||||
(GO FIRSTCHARLP)))
|
||||
(SETQ CURPATINDEX (SUB1 MAXPATINDEX))
|
||||
MATCHLP
|
||||
(COND
|
||||
((ILESSP CURPATINDEX 0)
|
||||
(GO FOUNDIT)))
|
||||
(\DECFILEPTR STREAM 2) (* ; "back up to read previous char")
|
||||
(COND
|
||||
((NEQ (SETQ CHAR (GETBASEBYTE CASE (\BIN STREAM)))
|
||||
(GETBASEBYTE PATCHAR CURPATINDEX))
|
||||
(* ;
|
||||
"Mismatch, advance by greater of delta1 and delta2")
|
||||
(add STARTOFFSET (IDIFFERENCE (SETQ INC (IMAX (GETBASEBYTE DELTA1 CHAR)
|
||||
(GETBASEBYTE DELTA2
|
||||
CURPATINDEX)))
|
||||
(IDIFFERENCE MAXPATINDEX CURPATINDEX)))
|
||||
(OR (EQ INC 1)
|
||||
(\INCFILEPTR STREAM (SUB1 INC)))
|
||||
(GO FIRSTCHARLP)))
|
||||
(SETQ CURPATINDEX (SUB1 CURPATINDEX))
|
||||
(GO MATCHLP)
|
||||
FOUNDIT
|
||||
(* ;
|
||||
"set fileptr, adjust for beginning skips and return proper value.")
|
||||
(\INCFILEPTR STREAM (COND
|
||||
(TAIL (* ; "Put fileptr at end of string")
|
||||
(SUB1 PATLEN))
|
||||
(T (* ;
|
||||
"back up over the last char we looked at, i.e. the first char of string")
|
||||
-1)))
|
||||
(RETURN (\GETFILEPTR STREAM))
|
||||
FAILED
|
||||
(* ;
|
||||
"return the fileptr to its initial position.")
|
||||
(\SETFILEPTR STREAM ORGFILEPTR)
|
||||
(RETURN NIL]
|
||||
TRYFILEPOS
|
||||
(RETURN (FILEPOS PATTERN STREAM START END SKIP TAIL CASEARRAY])
|
||||
)
|
||||
|
||||
(FILESLOAD FPTESTS)
|
||||
|
||||
(ADDTOVAR DIRECTORIES {WMEDLEY}<internal>test>filepos>)
|
||||
|
||||
|
||||
|
||||
(* ;; "Compiling also requires EXPORTS.ALL")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
IOCHAR)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (759 6571 (TFP 769 . 2219) (TFP1 2221 . 4656) (FPC 4658 . 5619) (FPCS 5621 . 6569)) (
|
||||
6572 27191 (OLDFILEPOS 6582 . 16284) (OLDFFILEPOS 16286 . 27189)))))
|
||||
STOP
|
||||
Binary file not shown.
@@ -1 +0,0 @@
|
||||
012
|
||||
@@ -1 +0,0 @@
|
||||
(HCFILES "{DSK}<home>larry>ilisp>envos>" "{DSK}<home>larry>medley>tmp>psfiles>")
|
||||
@@ -1,66 +0,0 @@
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>PUBS>admin>doc-dirs>ERIS-DOC-WO-LOOPS.TEDIT;2
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>medley1.2>RS6000>keybaord-layout.tedit;3
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>medley2.0>final>ug>APP-D-DIFFERENCES.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>printers>recommendation.tedit;3
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>1982BUGS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>BRIEFINGBLURB-DRAFT.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>CHAT-GENERIC.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>HELLO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>IDDESCRIPTION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>LISPARFIELDS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>NSCHARACTERS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>SOURCEFILES.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>library>COLOROBJ.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>library>DSKTEST.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>notecards>library>BOONE-V-COE.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>notecards>library>NCPLOTCARD.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>GC>HAND-AUX>ADVDICT-N-Z.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>Library>TEdit>Hand-Aux>AR10063.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>i>o>Hardcopy>Hand>testfiles>04PARA.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>LAFITEDELTA.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>LAFITEIMPL.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>Manual>LAFITEMANUAL-INDEXINTERNAL.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>lispusers>2.0>src>EQUATIONEXAMPLES.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>03-SOFTWARE-INSTALLATION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>05-NOTECARDS-BASICS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>11-SYSTEM-CARDS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>2.0>src>library>BOONE-V-COE.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>nilsson>intercalc>inter-calc>INTERCALCDEMO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>nilsson>intercalc>inter-calc>INTERCALCDOCUMENTATION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>JELLINEK>graphics>DDLCOLORHAX.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>JELLINEK>graphics>LUCASFILMFORMAT.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>basics>INVOICE.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>genis>FLYER-COV-CHOICE.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>genis>FLYER-COV.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>inter-calc>INTERCALCDEMO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>inter-calc>INTERCALCDOCUMENTATION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>ADVERTS>Cherry-RidgeWFH.TEdit;5
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Adv-Committee>Defns>ADVDEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Board>CALLERLAB-BYLAWCHANGE.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C1-NEW-DEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C1DEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C2DEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>NUMBERART.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>ADVDICT-A-M.TEDIT;13
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>ADVDICT-N-Z.TEDIT;9
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-I-R.TEDIT;9
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-S.TEDIT;7
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-T-Z.TEDIT;9
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-A-E.TEDIT;11
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-F-O.TEDIT;5
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-P-S.TEDIT;6
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-T-Z.TEDIT;6
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>DICT-PREFACE.TEDIT;14
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>leftover-calls.tedit;3
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>FRA>ARRANGEMENTS.TEDIT;28
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>venue>ads>aaai>top-rapid-dev.TEdit;4
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>24-STREAMS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>25-IO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>27-GRAPHICS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>28-WINDOWS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>29-HARDCOPY.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>30-ETHERNET.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>30-TERMINAL.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>31-ETHERNET.TEDIT;1
|
||||
{DSK}<home>larry>medley>lispusers>ACE>ACE-MAINTAINERS-NOTES.TEDIT;1
|
||||
{DSK}<home>larry>medley>lispusers>EQUATIONEXAMPLES.TEDIT;1
|
||||
@@ -1,546 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-May-2022 12:30:29"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>TESTUPF.;1 32843 )
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TESTUPFCOMS)
|
||||
|
||||
(RPAQQ TESTUPFCOMS
|
||||
((COMS (* ; "Original code")
|
||||
(FNS OLD-UNPACKFILENAME.STRING \UPF.NEXTPOS \UPF.TEMPFILEP)
|
||||
(DECLARE%: DONTCOPY (MACROS CANONICAL.DIRECTORY UNPACKFILE1.DIRECTORY UNPACKFILE1)))
|
||||
|
||||
(* ;; "Debugging")
|
||||
|
||||
|
||||
(* ;; "DOTTEDNAMES: mismatch intended")
|
||||
|
||||
|
||||
(* ;; "RETURNFAILS: mismatch with DIRFLG=RETURN, DIRECTORY and SUBDIRECTORY are swapped. But original doesn't agree with its own complete analaysis.")
|
||||
|
||||
(VARS DOTTEDNAMES TESTS RETURNFAILS)
|
||||
(FNS TRY TRYALL DT)))
|
||||
|
||||
|
||||
|
||||
(* ; "Original code")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(OLD-UNPACKFILENAME.STRING
|
||||
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 25-Jan-2022 17:16 by rmk")
|
||||
(* ; "Edited 5-Jan-2022 11:03 by rmk")
|
||||
(* ; "Edited 30-Mar-90 22:37 by nm")
|
||||
|
||||
(* ;;; "Given a string or atom representation of a file name, unpack it into its component parts")
|
||||
|
||||
(* ;;; "rmk: devices must come before directories.")
|
||||
|
||||
(PROG ((POS 1)
|
||||
(LEN (NCHARS FILE))
|
||||
TEM BEYONDNAME BEYONDEXT VAL CODE HOSTP SUBDIREND FIRSTDOT SECONDDOT USEDSEMI)
|
||||
(COND
|
||||
((NULL FILE)
|
||||
(RETURN NIL))
|
||||
((OR (LITATOM FILE)
|
||||
(STRINGP FILE)
|
||||
(NUMBERP FILE)))
|
||||
((TYPEP FILE 'PATHNAME)
|
||||
(RETURN (UNPACKPATHNAME.STRING FILE ONEFIELDFLG DIRFLG PACKFLG)))
|
||||
[(STREAMP FILE) (* ;
|
||||
"For streams, use full name. If anonymous, fake it")
|
||||
(SETQ FILE (OR (ffetch FULLFILENAME of FILE)
|
||||
(RETURN (COND
|
||||
(ONEFIELDFLG (AND (EQ ONEFIELDFLG 'NAME)
|
||||
FILE))
|
||||
(T (LIST 'NAME FILE]
|
||||
(T (\ILLEGAL.ARG FILE)))
|
||||
(COND
|
||||
((SELCHARQ (NTHCHARCODE FILE 1)
|
||||
({ (* ; "normal use in Interlisp-D")
|
||||
(SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE })
|
||||
FILE 2)
|
||||
0))))
|
||||
(%[ (* ;
|
||||
"some Xerox and Arpanet systems use '[' for host")
|
||||
(SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE "]")
|
||||
FILE 2)
|
||||
0))))
|
||||
(%( (* ;
|
||||
"this is the 'proposed standard' for Xerox servers")
|
||||
(SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE ")")
|
||||
FILE 2)
|
||||
0))))
|
||||
NIL)
|
||||
(UNPACKFILE1 'HOST 2 TEM)
|
||||
[COND
|
||||
((EQ TEM -1) (* ;
|
||||
"Started with the host field delimiter, but there was no corresponding terminating delimiter .")
|
||||
(* ;
|
||||
"I'm not sure why the name is dealt with the host name.")
|
||||
(RETURN (DREVERSE VAL]
|
||||
(SETQ POS (IPLUS TEM 2))
|
||||
[if (EQ OSTYPE T)
|
||||
then (* ;
|
||||
"Use actual host to determine os type")
|
||||
(SETQ OSTYPE (GETHOSTINFO (CAR VAL)
|
||||
'OSTYPE]
|
||||
(SETQ HOSTP T)))
|
||||
|
||||
(* ;; "rmk: if there is a colon before the next < or /, then we must be looking at a device. A device appears to end after the last colon, i.e., a device name can have a colon inside it.")
|
||||
|
||||
(COND
|
||||
((AND (SETQ TEM (\UPF.NEXTPOS (CHARCODE (%: < /))
|
||||
FILE POS))
|
||||
(EQ (CHARCODE %:)
|
||||
(NTHCHARCODE FILE TEM))) (* ;
|
||||
"all device returned have DEVICE.END on it so that NIL: will work")
|
||||
(UNPACKFILE1 'DEVICE POS (if CLFLG
|
||||
then (SUB1 TEM)
|
||||
else TEM))
|
||||
(SETQ POS (ADD1 TEM))
|
||||
(SETQ HOSTP T)))
|
||||
(COND
|
||||
((EQ DIRFLG 'RETURN) (* ; "assert that this is a directory; more forgiving about missing trailing delimiter. There are two distinct cases for the missing initial delimiter. If HOST is also specified, it is dealt with as the true %"relative pathname%" by device dependent manner, otherwise it is dealt with following the %"incomplete file names%" convention. In the first case, returns RELATIVEDIRECTORY instead of DIRECTORY and in the second case, returns SUBDIRECTORY.")
|
||||
(LET ((TYPE 'DIRECTORY)
|
||||
(START (SELCHARQ (NTHCHARCODE FILE POS)
|
||||
(NIL (* ; "just host, return")
|
||||
(RETURN (DREVERSE VAL)))
|
||||
((/ <) (* ;
|
||||
"Started with the initial directory delimiter.")
|
||||
(ADD1 POS))
|
||||
POS))
|
||||
END)
|
||||
(SETQ END (SELCHARQ (NTHCHARCODE FILE -1)
|
||||
((/ >)
|
||||
[COND
|
||||
((EQ START POS) (* ;
|
||||
"Didn't start with a directory delimiter,")
|
||||
(COND
|
||||
((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM. This is a subdirectory of the current connected directory")
|
||||
(SETQ TYPE 'SUBDIRECTORY))
|
||||
(T (* ; "True %"relative pathname%". The way to deal with it is dependent on the device on which HOST is implemented.")
|
||||
(SETQ TYPE 'RELATIVEDIRECTORY]
|
||||
(COND
|
||||
((EQ LEN POS) (* ;
|
||||
"Only the initial directory is specified (i.e. %"{DSK}/%").")
|
||||
(SETQ START POS)
|
||||
-1)
|
||||
(T -2)))
|
||||
(PROGN [COND
|
||||
[(EQ START POS) (* ;
|
||||
"Both of the initial and trail delimiters are omitted.")
|
||||
(COND
|
||||
((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM. This is a subdirectory of the current connected directory")
|
||||
(SETQ TYPE 'SUBDIRECTORY))
|
||||
(T (* ; "True %"relative pathname%". The way to deal with it is dependent on the device on which HOST is implemented.")
|
||||
(SETQ TYPE 'RELATIVEDIRECTORY]
|
||||
(T (COND
|
||||
((EQ LEN POS)
|
||||
(* ;
|
||||
"Only the initial directory is specified (i.e. %"{DSK}<%").")
|
||||
(SETQ START POS]
|
||||
-1)))
|
||||
(UNPACKFILE1.DIRECTORY TYPE START END))
|
||||
(RETURN (DREVERSE VAL)))
|
||||
((SELCHARQ (NTHCHARCODE FILE POS)
|
||||
(/ (* ;
|
||||
"unix and the 'xerox standard' use / for delimiter")
|
||||
(* ;
|
||||
"In the case of the {DSK}/FOO>BAR, FOO should be dealt with as a directory.")
|
||||
(SETQ TEM (LASTCHPOS (CHARCODE (/ >))
|
||||
FILE
|
||||
(ADD1 POS)))
|
||||
T)
|
||||
((< >) (* ;
|
||||
"Interlisp-D and most other Xerox systems, and Tops-20/Tenex use <>. Jericho uses >>")
|
||||
(* ;
|
||||
"In the case of the {DSK}<FOO/BAR, FOO should be dealt with as a directory.")
|
||||
(SETQ TEM (LASTCHPOS (CHARCODE (> /))
|
||||
FILE
|
||||
(ADD1 POS)))
|
||||
T)
|
||||
NIL)
|
||||
|
||||
(* ;; "allow {DSK}/etc to be a directory specification.")
|
||||
|
||||
(if TEM
|
||||
then (UNPACKFILE1.DIRECTORY 'DIRECTORY (ADD1 POS)
|
||||
(SUB1 TEM))
|
||||
(SETQ POS (ADD1 TEM))
|
||||
else
|
||||
(* ;; "{DSK}/foo: the directory is /, the name is foo")
|
||||
|
||||
(UNPACKFILE1.DIRECTORY 'DIRECTORY POS POS)
|
||||
(SETQ POS (ADD1 POS)))
|
||||
(SETQ HOSTP T))
|
||||
((SETQ TEM (LASTCHPOS (CHARCODE (/ >))
|
||||
FILE POS)) (* ; " {eris}abc> relative")
|
||||
|
||||
(* ;;
|
||||
" This is the true %"relative pathname%". Returns RELATIVEDIRECTORY instead of DIRECTORY.")
|
||||
|
||||
[COND
|
||||
((NOT HOSTP) (* ; "%"Incomplete file names%" case.")
|
||||
(UNPACKFILE1.DIRECTORY (if (EQ DIRFLG 'FIELD)
|
||||
then 'DIRECTORY
|
||||
else 'SUBDIRECTORY)
|
||||
POS
|
||||
(SUB1 TEM)))
|
||||
(T (* ; "True %"relative pathname%".")
|
||||
(UNPACKFILE1.DIRECTORY (if (EQ DIRFLG 'FIELD)
|
||||
then 'DIRECTORY
|
||||
else 'RELATIVEDIRECTORY)
|
||||
POS
|
||||
(SUB1 TEM]
|
||||
(SETQ POS (ADD1 TEM))
|
||||
(SETQ HOSTP T)))
|
||||
(OR (SETQ CODE (NTHCHARCODE FILE (SETQ TEM POS)))
|
||||
(RETURN (DREVERSE VAL)))
|
||||
(if (EQ OSTYPE T)
|
||||
then (* ;
|
||||
"There wasn't a host field in the name, so we have no clue")
|
||||
(SETQ OSTYPE NIL))
|
||||
NAMELP
|
||||
|
||||
|
||||
(* ;; "At this point, CODE is the TEM'th char of file name. POS is the first character of the field we are currently working on.")
|
||||
|
||||
(SELCHARQ CODE
|
||||
(%. (* ;
|
||||
"Note position for later--we only want to deal with the last set of dots")
|
||||
(if BEYONDNAME
|
||||
then (* ;
|
||||
"no longer of interest (probably a bad name, too)")
|
||||
elseif FIRSTDOT
|
||||
then (* ; "We're recording the second dot")
|
||||
(if SECONDDOT
|
||||
then (* ;
|
||||
"Note only the two most recent dots")
|
||||
(SETQ FIRSTDOT SECONDDOT))
|
||||
(SETQ SECONDDOT TEM)
|
||||
else (SETQ FIRSTDOT TEM)))
|
||||
((! ; NIL) (* ;
|
||||
"SUBDIRECTORY, NAME and EXTENSION fields definitely terminated by now")
|
||||
(if (SELCHARQ CODE
|
||||
(! (* ;
|
||||
"! is only a delimiter on IFS, so ignore it if we know the ostype is something else")
|
||||
(AND OSTYPE (NEQ OSTYPE 'IFS)))
|
||||
(; (* ; "If we've already parsed the extension, then we have a semi in the middle of the version. Skip it unless it's ;T or ;S")
|
||||
[AND BEYONDEXT (NOT (\UPF.TEMPFILEP FILE (ADD1 TEM])
|
||||
NIL)
|
||||
then (GO NEXTCHAR))
|
||||
(if FIRSTDOT
|
||||
then (* ;
|
||||
"Have a name and/or extension to parse now")
|
||||
(if
|
||||
[AND SECONDDOT
|
||||
(NOT (if OSTYPE
|
||||
then (* ;
|
||||
"Known OS type must be Tops20 for second dot to mean version")
|
||||
(EQ OSTYPE 'TOPS20)
|
||||
else (* ;
|
||||
"Unknown OS type, so check that %"version%" is numeric or wildcard")
|
||||
(AND [for I from (ADD1 SECONDDOT) to (SUB1 TEM)
|
||||
bind CH
|
||||
always (OR (DIGITCHARP (SETQ CH (NTHCHARCODE FILE I
|
||||
)))
|
||||
(EQ CH (CHARCODE *]
|
||||
(SELCHARQ CODE
|
||||
(NIL (* ; "end of file name, ok")
|
||||
T)
|
||||
(; (* ;
|
||||
"This semi-colon better not be introducing a version")
|
||||
(\UPF.TEMPFILEP FILE (ADD1 TEM)))
|
||||
NIL]
|
||||
then (* ;
|
||||
"Second dot is not intoducing a version")
|
||||
(SETQ FIRSTDOT SECONDDOT)
|
||||
(SETQ SECONDDOT NIL))
|
||||
(UNPACKFILE1 'NAME POS (SUB1 FIRSTDOT))
|
||||
(SETQ POS (ADD1 (if SECONDDOT
|
||||
then (UNPACKFILE1 'EXTENSION (ADD1 FIRSTDOT)
|
||||
(SUB1 SECONDDOT))
|
||||
(SETQ BEYONDEXT T)
|
||||
SECONDDOT
|
||||
else FIRSTDOT)))
|
||||
(SETQ BEYONDNAME T)
|
||||
(SETQ FIRSTDOT NIL))
|
||||
(UNPACKFILE1 (COND
|
||||
((NOT BEYONDNAME)
|
||||
(SETQQ BEYONDNAME NAME))
|
||||
((NOT BEYONDEXT)
|
||||
'EXTENSION)
|
||||
((AND (EQ BEYONDEXT (CHARCODE ";"))
|
||||
(\UPF.TEMPFILEP FILE POS)))
|
||||
(T (* ;
|
||||
"Everything after the semi was version")
|
||||
'VERSION))
|
||||
POS
|
||||
(SUB1 TEM))
|
||||
(if (NULL CODE)
|
||||
then (* ; "End of string")
|
||||
(RETURN (DREVERSE VAL)))
|
||||
(SETQ BEYONDEXT CODE) (* ;
|
||||
"Note the character that terminated the name/ext")
|
||||
(SETQ POS (ADD1 TEM)))
|
||||
(%' (* ; "Quoter")
|
||||
(add TEM 1))
|
||||
NIL)
|
||||
NEXTCHAR
|
||||
(SETQ CODE (NTHCHARCODE FILE (add TEM 1)))
|
||||
(GO NAMELP])
|
||||
|
||||
(\UPF.NEXTPOS
|
||||
[LAMBDA (CHAR STRING POS) (* lmm " 5-Oct-84 18:41")
|
||||
(bind NCH while (SETQ NCH (NTHCHARCODE STRING POS)) do (COND
|
||||
((EQMEMB NCH CHAR)
|
||||
(RETURN POS))
|
||||
((EQ NCH (CHARCODE %'))
|
||||
(add POS 1)))
|
||||
(add POS 1])
|
||||
|
||||
(\UPF.TEMPFILEP
|
||||
[LAMBDA (FILENAME START) (* ; "Edited 6-Jan-88 13:12 by bvm:")
|
||||
|
||||
(* ;; "Checks whether START denotes a temporary mark for Twenex filename beginning at START. Returns the appropriate field name if so. Not sure we should parse this junk any more, but this at least localizes it.")
|
||||
|
||||
(SELCHARQ (NTHCHARCODE FILENAME START)
|
||||
((T S) (* ; "Funny temp stuff")
|
||||
(AND (EQ START (NCHARS FILENAME))
|
||||
'TEMPORARY))
|
||||
NIL])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS CANONICAL.DIRECTORY MACRO
|
||||
[OPENLAMBDA (SRCSTRING)
|
||||
(AND
|
||||
SRCSTRING
|
||||
(LET
|
||||
((LEN (NCHARS SRCSTRING)))
|
||||
(COND
|
||||
((EQ LEN 1)
|
||||
(if (STREQUAL SRCSTRING "/")
|
||||
then "<"
|
||||
else SRCSTRING))
|
||||
(T
|
||||
(LET*
|
||||
((FATP (ffetch (STRINGP FATSTRINGP) of SRCSTRING))
|
||||
(DSTSTRING (ALLOCSTRING LEN NIL NIL (AND FATP T)))
|
||||
(DSTBASE (ffetch (STRINGP BASE) of DSTSTRING))
|
||||
(DSTPOS 0)
|
||||
(NEXTPOS -1))
|
||||
(if (NOT FATP)
|
||||
then [for SRCPOS from 1 to LEN bind CODE
|
||||
first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
|
||||
(CHARCODE (< / >))) do (add SRCPOS 1))
|
||||
(if (> SRCPOS LEN)
|
||||
then (RETURN "<"))
|
||||
do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
|
||||
((> /)
|
||||
(if (> DSTPOS NEXTPOS)
|
||||
then (\PUTBASETHIN DSTBASE DSTPOS (CHARCODE >))
|
||||
(SETQ NEXTPOS (add DSTPOS 1))))
|
||||
(%' (\PUTBASETHIN DSTBASE DSTPOS CODE)
|
||||
(add DSTPOS 1)
|
||||
(if (NEQ SRCPOS LEN)
|
||||
then (\PUTBASETHIN DSTBASE DSTPOS
|
||||
(NTHCHARCODE SRCSTRING (add SRCPOS 1)))
|
||||
(add DSTPOS 1)))
|
||||
(PROGN (\PUTBASETHIN DSTBASE DSTPOS CODE)
|
||||
(add DSTPOS 1)))
|
||||
finally (RETURN (if (EQ DSTPOS LEN)
|
||||
then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
|
||||
(CHARCODE (> /)))
|
||||
then (SUBSTRING DSTSTRING 1 -2)
|
||||
else DSTSTRING)
|
||||
elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
|
||||
(CHARCODE (> /)))
|
||||
then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
|
||||
else (SUBSTRING DSTSTRING 1 DSTPOS]
|
||||
else (for SRCPOS from 1 to LEN bind CODE
|
||||
first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
|
||||
(CHARCODE (< / >))) do (add SRCPOS 1))
|
||||
do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
|
||||
((> /)
|
||||
(if (> DSTPOS NEXTPOS)
|
||||
then (\PUTBASEFAT DSTBASE DSTPOS (CHARCODE >))
|
||||
(SETQ NEXTPOS (add DSTPOS 1))))
|
||||
(%' (\PUTBASEFAT DSTBASE DSTPOS CODE)
|
||||
(add DSTPOS 1)
|
||||
(if (NEQ SRCPOS LEN)
|
||||
then (\PUTBASEFAT DSTBASE DSTPOS (NTHCHARCODE
|
||||
SRCSTRING
|
||||
(add SRCPOS 1)))
|
||||
(add DSTPOS 1)))
|
||||
(PROGN (\PUTBASEFAT DSTBASE DSTPOS CODE)
|
||||
(add DSTPOS 1)))
|
||||
finally (RETURN (if (EQ DSTPOS LEN)
|
||||
then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
|
||||
(CHARCODE (> /)))
|
||||
then (SUBSTRING DSTSTRING 1 -2)
|
||||
else DSTSTRING)
|
||||
elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
|
||||
(CHARCODE (> /)))
|
||||
then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
|
||||
else (SUBSTRING DSTSTRING 1 DSTPOS])
|
||||
|
||||
(PUTPROPS UNPACKFILE1.DIRECTORY MACRO [OPENLAMBDA (NAM ST END)
|
||||
(LET* ((OLDDIR (SUBSTRING FILE ST END))
|
||||
(NEWDIR (CANONICAL.DIRECTORY OLDDIR)))
|
||||
(COND
|
||||
[(NOT ONEFIELDFLG)
|
||||
(SETQ VAL (CONS (COND
|
||||
(PACKFLG (AND NEWDIR
|
||||
(MKATOM NEWDIR)))
|
||||
(T (OR NEWDIR "")))
|
||||
(CONS NAM VAL]
|
||||
((EQMEMB NAM ONEFIELDFLG)
|
||||
(RETURN (COND
|
||||
(PACKFLG (AND NEWDIR (MKATOM NEWDIR)))
|
||||
(T (OR NEWDIR ""])
|
||||
|
||||
(PUTPROPS UNPACKFILE1 MACRO [OPENLAMBDA (NAM ST END) (* lmm "22-APR-81 22:21")
|
||||
(COND
|
||||
[(NOT ONEFIELDFLG)
|
||||
(SETQ VAL (CONS (COND
|
||||
(PACKFLG (SUBATOM FILE ST END))
|
||||
(T (OR (SUBSTRING FILE ST END)
|
||||
"")))
|
||||
(CONS NAM VAL]
|
||||
((EQMEMB NAM ONEFIELDFLG)
|
||||
(RETURN (COND
|
||||
(PACKFLG (SUBATOM FILE ST END))
|
||||
(T (OR (SUBSTRING FILE ST END)
|
||||
""])
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "Debugging")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "DOTTEDNAMES: mismatch intended")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"RETURNFAILS: mismatch with DIRFLG=RETURN, DIRECTORY and SUBDIRECTORY are swapped. But original doesn't agree with its own complete analaysis."
|
||||
)
|
||||
|
||||
|
||||
(RPAQQ DOTTEDNAMES (".x" ">.git" "x.y.100"))
|
||||
|
||||
(RPAQQ TESTS
|
||||
("*,;" "*.*;*" "*.;" "*.;*" "///abc/x" "/abc.x" "<" "<<<abc" "<<<abc>" "<<<abc>>" "<<<abc>x"
|
||||
"<<abc" "<<xyz>>>zz" "<<xyz>>>zzz/" "<<xyz>>zz" "<<xyz>zz" "<ABC>" "<XYZ>aa" "<a.b>"
|
||||
"<a;b>" "<ab;c" "<ab>" "<abc" "<abc*." "<abc.x" "<abc.x;1" "<abc;x" "<abc<<<x"
|
||||
"<abc<xyz<foo" "<abc<xyz>qrs" "<abc>" "<abc>;1" "<abc>xyz" "<abc>xyz>foo" "<xxx"
|
||||
"<xy>>zz" "<xyz>>>zzz/" ">" ">>>abc/x" ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx"
|
||||
"A.B.C" "XXX<yyy" "a;b" "a;b/d" "a;b;c" "a;b;c;d" "aa" "aa;" "aa;NEWEST" "aa;newest"
|
||||
"aaa" "aaa/bbb" "aaa/bbb/" "aaa/xyz;x;m" "aaa<bbb" "aaa<bbb/" "aaa<xyz>" "aaa>bbb>"
|
||||
"aaa>xyz.e;m;n" "aaa>xyz>qrs" "abc" "abc...c" "abc///XYZ//" "abc/d" "abc/xyz"
|
||||
"abc/xyz.qrs" "abc/xyz.qrs;2" "abc:x<qrs>z" "abc<<<XYZ//" "abc<x" "abc<xyz"
|
||||
"abc<xyz>qq" "abc<xyzqq" "abc>;1" "abc>qr.x" "abc>xy" "abc>xyz" "abc>xyz;2"
|
||||
"dev:aaa>xyz>qrs" "foo:" "foo:aaa<xyz" "foo:aaa<xyz>" "foo:x<qrs>z" "foo<a:B>" "s;n;b"
|
||||
"x.y.z;w" "x.y;z" "x;y" "x<abc<xyz>qrs" "x<abc<z" "x<abc>z" "xxx<yyy" "xxx<yyy>"
|
||||
"xxx<yyy>zzz" "xxx>yyy" "xxx>yyy>" "{ABC}" "{ABC}XXX:" "{DSK}" "{DSK}*.;*" "{DSK}...<a"
|
||||
"{DSK}<a" "{DSK}xxx<a" "{DSK}xxx<xxx>yyy" "{DSK}xxx>xxx" "{DSK}xxx>yyy"
|
||||
"{HOST}foo:x<qrs>z" "{HOST}x<qrs>z" "{abc}" "{dsk}foo:aaa>b>.c.e.g;f"
|
||||
"{dsk}foo:aaa>b>.c.e;f" "{dsk}foo:aaa>b>c.e;f" "{eris}abc>" "{host}abc/xyz;2"
|
||||
"{host}abc>xyz;2" "{x}abc<xyz>qq" "{x}abc<xyzqq" "<abc<xyz>abc" "<abc<xyz>qrs"
|
||||
"<abc<xyz>"))
|
||||
|
||||
(RPAQQ RETURNFAILS (">" ">>>abc/x" ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx" ">" ">>>abc/x"
|
||||
">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx"))
|
||||
(DEFINEQ
|
||||
|
||||
(TRY
|
||||
[LAMBDA (FILE ONEFIELDFLG DIRFLG) (* ; "Edited 23-May-2022 12:09 by rmk")
|
||||
(* ; "Edited 25-Apr-2022 14:15 by rmk")
|
||||
(* ; "Edited 24-Apr-2022 08:45 by rmk")
|
||||
(* ; "Edited 21-Apr-2022 15:36 by rmk")
|
||||
(CL:WHEN (LISTP (CAR (LISTP FILE)))
|
||||
(SETQ FILE (CAR FILE)))
|
||||
(LET (ORIG NEW)
|
||||
(CL:WHEN (LISTP FILE)
|
||||
(SETQ ONEFIELDFLG (CADR FILE))
|
||||
(SETQ DIRFLG (CADDR FILE))
|
||||
(SETQ FILE (CAR FILE)))
|
||||
(SETQ ORIG (OLD-UNPACKFILENAME.STRING FILE ONEFIELDFLG DIRFLG))
|
||||
(SETQ NEW (UNPACKFILENAME.STRING FILE ONEFIELDFLG DIRFLG))
|
||||
(LIST (LIST FILE ONEFIELDFLG DIRFLG)
|
||||
(AND (EQUAL ORIG NEW)
|
||||
'=)
|
||||
ORIG NEW])
|
||||
|
||||
(TRYALL
|
||||
[LAMBDA (FILES ALLFLAG ONEFIELDFLG DIRFLG) (* ; "Edited 21-Apr-2022 17:56 by rmk")
|
||||
(* ; "Edited 2-Apr-2022 23:50 by rmk")
|
||||
(* ; "Edited 31-Mar-2022 22:57 by rmk")
|
||||
(CL:WHEN (LISTP FILES)
|
||||
(SETQ FILES (FOR F IN FILES COLLECT (CL:IF (LISTP (CAR (LISTP F)))
|
||||
(CAR F)
|
||||
F))))
|
||||
(FOR FILE INFO (SAME _ 0)
|
||||
(DIFF _ 0) IN FILES EACHTIME (SETQ INFO (TRY FILE ONEFIELDFLG DIRFLG))
|
||||
(CL:IF (CADR INFO)
|
||||
(ADD SAME 1)
|
||||
(ADD DIFF 1)) UNLESS (AND (CADR INFO)
|
||||
(NOT ALLFLAG))
|
||||
COLLECT (PRINTOUT T .P2 (CAAR INFO)
|
||||
31)
|
||||
(IF (CADR INFO)
|
||||
THEN (PRINTOUT T " = " .P2 (CADDR INFO))
|
||||
(CL:WHEN (OR (CADAR INFO)
|
||||
(CADDAR INFO))
|
||||
(PRINTOUT T 60 (CADAR INFO)
|
||||
%,,
|
||||
(CADDAR INFO))
|
||||
(TERPRI T))
|
||||
ELSE (PRINTOUT T " ~= " -2 "old: " .P2 (CADDR INFO))
|
||||
(CL:WHEN (OR (CADAR INFO)
|
||||
(CADDAR INFO))
|
||||
(PRINTOUT T 60 (CADAR INFO)
|
||||
%,,
|
||||
(CADDAR INFO))
|
||||
(TERPRI T))
|
||||
(PRINTOUT T 37 "new: " .P2 (CADDDR INFO)
|
||||
T))
|
||||
INFO FINALLY (PRINTOUT T SAME " matches, " DIFF " mismatches" T])
|
||||
|
||||
(DT
|
||||
[LAMBDA (STRINGS ALLFLAG) (* ; "Edited 21-Apr-2022 17:53 by rmk")
|
||||
(* ; "Edited 19-Apr-2022 20:55 by rmk")
|
||||
|
||||
(* ;; "Tests the DIRFLG options on STRINGS. If an element of STRINGS is a list, it is assumed to be a (STRING ONEFIELD DIRFLG), STRING is extracted.")
|
||||
|
||||
(SETQ STRINGS (FOR S INSIDE STRINGS COLLECT (CL:IF (LISTP S)
|
||||
(CAR S)
|
||||
S)))
|
||||
[AND NIL (FOR ONEFIELD IN '(NAME DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY)
|
||||
JOIN (FOR DIR ORIG NEW SAME IN '(FIELD RETURN)
|
||||
JOIN (PRINTOUT T T "ONEFIELDFLG = " ONEFIELD -3 "DIRFLG = " DIR T T)
|
||||
(TRYALL STRINGS ALLFLAG ONEFIELD DIR))
|
||||
FINALLY (FOR INFO SAME (DIFF _ 0) IN $$VAL DO (CL:IF (CADR INFO)
|
||||
(ADD SAME 1)
|
||||
(ADD DIFF 1))
|
||||
FINALLY (SETQ SAME (IDIFFERENCE (LENGTH STRINGS)
|
||||
DIFF))
|
||||
(PRINTOUT T T "Overall: " SAME " matched, " DIFF " mismatched" T]
|
||||
(TRYALL (FOR S IN STRINGS JOIN (FOR ONEFIELD IN '(NAME DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY)
|
||||
JOIN (FOR DIR IN '(FIELD RETURN)
|
||||
COLLECT (LIST S ONEFIELD DIR])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (893 18981 (OLD-UNPACKFILENAME.STRING 903 . 17808) (\UPF.NEXTPOS 17810 . 18396) (
|
||||
\UPF.TEMPFILEP 18398 . 18979)) (28216 32820 (TRY 28226 . 29192) (TRYALL 29194 . 31111) (DT 31113 .
|
||||
32818)))))
|
||||
STOP
|
||||
Binary file not shown.
@@ -1,23 +0,0 @@
|
||||
TESTUPF contains functions for testing the new implementation of UNPACKFILENAME.STRING (now in ADIR) and the original definition.
|
||||
|
||||
The original definition is also provided here, under the name OLD-UNPACKFILENAME.STRING
|
||||
|
||||
TESTUPF also includes some test functions, and some of the strings that I have been testing with.
|
||||
|
||||
(TRY FILE ONEDIRFLG DIRFLG)
|
||||
|
||||
returns a comparison of the behavior of the original version and the new version in a list of the form
|
||||
|
||||
(FILE ONEDIRFLG DIRFLG) MATCH ORIG NEW)
|
||||
|
||||
where MATCH is = if ORIG and NEW are EQUAL, otherwise NIL. (For convenience, a list of this form can also be passed in as an argument.)
|
||||
|
||||
(TRYALL FILES ALLFLG ONDIRFLG DIRFLG)
|
||||
|
||||
applies TRY to each file-string in FILES, prints and reports what it discovers. If ALLFLG, it prints the result on every file, otherwise just the mismatches. Value is a list of TRY values that it printed.
|
||||
|
||||
(DT FILES) sets up a call to TRYALL for DIRFLG testing (setting DIRFLG NIL, FIELD, RETURN for each file in FILES).
|
||||
|
||||
The variable TESTS has the strings that I have tested against, the variable DOTTEDNAMES has the strings that I intend to be different (.cshrc as NAME, not EXTENSION). The new behavior avoids the bug that (PACKFILENAME.STRING 'EXTENSION "txt "BODY ".bashrc") produces ".txt" instead of ".bashrc.txt".
|
||||
|
||||
The variable RETURNFAILS is a list of strings with DIRFLG=RETURN that also don¹t match, in that the DIRECTORY and SUBDIRECTORY classifications are inverted between old and new for strings beginning with ª>". But the old code is inconsistent for these inputs: it returns different classifications of those substrings with or without the RETURN. (I think RETURN is for the case "/Users/kaplan" where the caller knows that the whole thing is a directory, doesn¹t want ªkaplanº to be parsed as a name. Just wants it to be normalized, with host and device stripped off.)
|
||||
Binary file not shown.
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Dec-2021 19:33:12" |{DSK}<home>larry>medley>library>FILEBROWSER.;44| 267497
|
||||
(FILECREATED " 4-Aug-2022 09:32:02" |{DSK}<home>larry>medley>library>FILEBROWSER.;2| 266567
|
||||
|
||||
|changes| |to:| (VARS FILEBROWSERCOMS)
|
||||
:CHANGES-TO (VARS FILEBROWSERCOMS)
|
||||
|
||||
|previous| |date:| "23-Nov-2021 12:17:08" |{DSK}<home>larry>medley>library>FILEBROWSER.;39|)
|
||||
:PREVIOUS-DATE " 2-Dec-2021 19:33:12" |{DSK}<home>larry>medley>library>FILEBROWSER.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.
|
||||
@@ -185,8 +185,7 @@ You specify how many versions to keep.")))
|
||||
(* \; "Setup")
|
||||
(FNS FB.STARTUP FB.MAKERIGIDWINDOW)
|
||||
(FNS FB.PRINTFN FB.COPYFN))
|
||||
(COMS (* \;
|
||||
"commands and major subfunctions")
|
||||
(COMS (* \; "commands and major subfunctions")
|
||||
(FNS FB.MENU.WHENSELECTEDFN FB.COMMANDSELECTEDFN FB.SUBITEMP FB.MAKE.BROWSER.BUSY
|
||||
FB.FINISH.COMMAND FB.HANDLE.ABORT.BUTTON)
|
||||
(FNS FB.DELETECOMMAND FB.DELVERCOMMAND FB.IS.NOT.SUBDIRECTORY.ITEM FB.DELVER.FILES
|
||||
@@ -221,8 +220,8 @@ You specify how many versions to keep.")))
|
||||
(FNS FB.ICONFN FB.INFOMENU.WHENSELECTEDFN FB.CLOSEFN FB.EXPUNGE?.MENU FB.AFTERCLOSEFN
|
||||
FB.CLOSE&EXPUNGE)
|
||||
(FNS FB.HARDCOPY.DIRECTORY FB.HARDCOPY.PRINT.TITLE FB.HARDCOPY.MAXWIDTH))
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
|
||||
TABLEBROWSERDECLS)
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
TABLEBROWSER)
|
||||
(RECORDS INFOFIELD FBFILEDATA FILEBROWSER)
|
||||
(CONSTANTS FB.MORE.BORDER FB.NULL.VERSION)
|
||||
(MACROS NULL.VERSIONP NULL.DIRECTORYP EQ.DIRECTORYP NULL.FIELDP)
|
||||
@@ -276,8 +275,8 @@ You specify how many versions to keep.")))
|
||||
DOCOPY
|
||||
|
||||
(RPAQ? FB.ICONSPEC '(#*(83 70)OOOOOOOOOOOOOOOOOOOON@@@OOOOOOOOOOOOOOOOOOOON@@@L@@@@@@@@@@@@@@@@@@@F@@@L@@@@@@@@@@@@@@@@@@@F@@@LOOOOOOOOOOOOOOOOOONF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@GOOOOOL@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@DCOOOHD@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@DOOOOND@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@GOOOOOL@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@COOOOOH@@@@@BF@@@LH@@@@@COOOOOH@@@@@BF@@@LH@@@@@B@@@@@H@@@@@BF@@@LH@@@@@A@@@@A@@@@@@BF@@@LH@@@@@@OOOON@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LOOOOOOOOOOOOOOOOOONF@@@L@@@@@@@@@@@@@@@@@@@F@@@L@@@@@@@@@@@@@@@@@@@F@@@OOOOOOOOOOOOOOOOOOOON@@@OOOOOOOOOOOOOOOOOOOON@@@
|
||||
NIL
|
||||
(5 5 73 40)))
|
||||
NIL
|
||||
(5 5 73 40)))
|
||||
)
|
||||
|
||||
(RPAQ? FB.EXPUNGE?MENU )
|
||||
@@ -305,9 +304,9 @@ DOCOPY
|
||||
(RPAQ? FB.DEFAULT.INFO '(SIZE CREATIONDATE AUTHOR))
|
||||
|
||||
(APPENDTOVAR FONTVARS (FB.ICONFONT LITTLEFONT)
|
||||
(FB.BROWSERFONT DEFAULTFONT)
|
||||
(FB.PROMPTFONT LITTLEFONT)
|
||||
(FB.BROWSER.DIRECTORY.FONT BOLDFONT))
|
||||
(FB.BROWSERFONT DEFAULTFONT)
|
||||
(FB.PROMPTFONT LITTLEFONT)
|
||||
(FB.BROWSER.DIRECTORY.FONT BOLDFONT))
|
||||
|
||||
|
||||
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
|
||||
@@ -408,27 +407,25 @@ You specify how many versions to keep.")))
|
||||
))
|
||||
|
||||
(RPAQQ FB.VERSION.MENU.ITEMS (("1" 1 "Keep only one version of the files")
|
||||
("2" 2 "Keep two versions of the files")
|
||||
("3" 3 "Keep three versions of the files")
|
||||
("4" 4 "Keep four versions of the files")
|
||||
("Other" :NUMBER "Select number of versions to keep")))
|
||||
("2" 2 "Keep two versions of the files")
|
||||
("3" 3 "Keep three versions of the files")
|
||||
("4" 4 "Keep four versions of the files")
|
||||
("Other" :NUMBER "Select number of versions to keep")))
|
||||
|
||||
(RPAQQ FB.CLOSE.MENU.ITEMS (("Expunge deleted files" 'EXPUNGE
|
||||
"Erases all files still marked 'deleted'")
|
||||
("Don't expunge" 'NOEXPUNGE "Proceeds (closes or updates browser) without expunging deleted files.
|
||||
"Erases all files still marked 'deleted'")
|
||||
("Don't expunge" 'NOEXPUNGE "Proceeds (closes or updates browser) without expunging deleted files.
|
||||
Your deletions are thus ignored.")))
|
||||
|
||||
(RPAQQ FB.DEPTH.MENU.ITEMS (("Global default" :GLOBAL
|
||||
"Set depth using the global default (FILING.ENUMERATION.DEPTH)"
|
||||
)
|
||||
("Infinite" T
|
||||
"Set depth to infinity, i.e., enumerate all levels of directory"
|
||||
)
|
||||
("1" 1
|
||||
"Set depth using the global default (FILING.ENUMERATION.DEPTH)")
|
||||
("Infinite" T
|
||||
"Set depth to infinity, i.e., enumerate all levels of directory")
|
||||
("1" 1
|
||||
"Set depth to 1, i.e., enumerate just the top level of the directory"
|
||||
)
|
||||
("2" 2 "Set depth to 2")
|
||||
("Other" :NUMBER "Set depth to some other finite depth")))
|
||||
)
|
||||
("2" 2 "Set depth to 2")
|
||||
("Other" :NUMBER "Set depth to some other finite depth")))
|
||||
|
||||
(RPAQQ FB.INFO.MENU.ITEMS
|
||||
((|Length| LENGTH "Toggles Length display")
|
||||
@@ -3857,127 +3854,124 @@ then click Recompute"))))
|
||||
)
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (SOURCE)
|
||||
TABLEBROWSERDECLS)
|
||||
(FILESLOAD (LOADCOMP)
|
||||
TABLEBROWSER)
|
||||
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
|
||||
(RECORD INFOFIELD (INFONAME INFOLABEL INFOWIDTH INFOFORMAT INFOPROTOTYPE))
|
||||
|
||||
(DATATYPE FBFILEDATA ((FILENAME POINTER) (* \; "Full name of this file")
|
||||
(FILEINFO POINTER) (* \; "Plist of attributes")
|
||||
(VERSIONLESSNAME POINTER) (* \; "FILENAME sans version")
|
||||
(DIRECTORYP FLAG) (* \; "True if it's a directory line")
|
||||
(HASDIRPREFIX FLAG) (* \;
|
||||
"True if it has a directory prefix beyond that in common to all the files")
|
||||
(DIRECTORYFILEP FLAG) (* \;
|
||||
"True if the \"file\" in this item is actually a subdirectory")
|
||||
(SIZE POINTER) (* \; "Size of file, for stats")
|
||||
(FILEDEPTH BYTE) (* \;
|
||||
"Number of levels of subdirectory beneath the main pattern--zero for files at that level")
|
||||
(SORTVALUE POINTER) (* \;
|
||||
"Cached value by which we are sorting the dir.")
|
||||
(SUBDIREND WORD) (* \;
|
||||
"Index of last char in subdirectory, or zero if HASDIRPREFIX is false")
|
||||
(STARTOFPNAME WORD) (* \;
|
||||
"Start of name for printing purposes. Same as STARTOFNAME when browser sorted by name")
|
||||
(VERSION WORD) (* \; "Version, or zero if none")
|
||||
(STARTOFNAME WORD) (* \;
|
||||
"Index beyond all directory fields")
|
||||
DUMMY)
|
||||
(ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH (FBFILEDATA FILENAME
|
||||
)
|
||||
OF DATUM)
|
||||
(FETCH (FBFILEDATA STARTOFPNAME
|
||||
) OF DATUM)))
|
||||
(SUBDIRECTORY (SUBSTRING (FETCH (FBFILEDATA
|
||||
FILENAME)
|
||||
OF DATUM)
|
||||
1
|
||||
(FETCH (FBFILEDATA SUBDIREND
|
||||
) OF
|
||||
DATUM))))))
|
||||
(DATATYPE FBFILEDATA ((FILENAME POINTER) (* \; "Full name of this file")
|
||||
(FILEINFO POINTER) (* \; "Plist of attributes")
|
||||
(VERSIONLESSNAME POINTER) (* \; "FILENAME sans version")
|
||||
(DIRECTORYP FLAG) (* \; "True if it's a directory line")
|
||||
(HASDIRPREFIX FLAG) (* \;
|
||||
"True if it has a directory prefix beyond that in common to all the files")
|
||||
(DIRECTORYFILEP FLAG) (* \;
|
||||
"True if the \"file\" in this item is actually a subdirectory")
|
||||
(SIZE POINTER) (* \; "Size of file, for stats")
|
||||
(FILEDEPTH BYTE) (* \;
|
||||
"Number of levels of subdirectory beneath the main pattern--zero for files at that level")
|
||||
(SORTVALUE POINTER) (* \;
|
||||
"Cached value by which we are sorting the dir.")
|
||||
(SUBDIREND WORD) (* \;
|
||||
"Index of last char in subdirectory, or zero if HASDIRPREFIX is false")
|
||||
(STARTOFPNAME WORD) (* \;
|
||||
"Start of name for printing purposes. Same as STARTOFNAME when browser sorted by name")
|
||||
(VERSION WORD) (* \; "Version, or zero if none")
|
||||
(STARTOFNAME WORD) (* \;
|
||||
"Index beyond all directory fields")
|
||||
DUMMY)
|
||||
(ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH (FBFILEDATA FILENAME)
|
||||
OF DATUM)
|
||||
(FETCH (FBFILEDATA STARTOFPNAME)
|
||||
OF DATUM)))
|
||||
(SUBDIRECTORY (SUBSTRING (FETCH (FBFILEDATA FILENAME)
|
||||
OF DATUM)
|
||||
1
|
||||
(FETCH (FBFILEDATA SUBDIREND)
|
||||
OF DATUM))))))
|
||||
|
||||
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (* \;
|
||||
"True if we don't want separate subdirectory lines -- subdirs then included in name")
|
||||
(NSPATTERN? FLAG) (* \; "True if host is an ns host")
|
||||
(SHOWUNDELETED? FLAG) (* \;
|
||||
"True if counter window should show `Undeleted' rather than `Total' counts")
|
||||
(PATTERNPARSED? FLAG) (* \;
|
||||
"True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")
|
||||
(SORTBYDATE FLAG) (* \;
|
||||
"True if SORTATTRIBUTE is one of the date attributes")
|
||||
(FBREADY FLAG) (* \; "False while FB is enumerating.")
|
||||
(ABORTING FLAG) (* \;
|
||||
"True if enumeration is being aborted")
|
||||
(FIXEDTITLE FLAG) (* \; "True if caller supplied title")
|
||||
(FBCOMPUTEDDEPTH BYTE) (* \;
|
||||
"Depth at the time we enumerated directory (zero for infinite)")
|
||||
(FBDISPLAYEDDEPTH BYTE) (* \;
|
||||
"Depth we are currently displaying (zero for infinite)")
|
||||
(TABLEBROWSER POINTER) (* \;
|
||||
"Pointer to TABLEBROWSER object controlling the browser")
|
||||
(BROWSERWINDOW POINTER) (* \; "Main window")
|
||||
(COUNTERWINDOW POINTER) (* \;
|
||||
"Window that counts files, pages, deletions")
|
||||
(HEADINGWINDOW POINTER) (* \;
|
||||
"Window with headings for browser columns")
|
||||
(INFOMENUW POINTER) (* \;
|
||||
"Window containing choices for info to be displayed, or NIL if none yet")
|
||||
(PROMPTWINDOW POINTER) (* \; "GETPROMPTWINDOW BROWSERWINDOW")
|
||||
(INFODISPLAYED POINTER) (* \;
|
||||
"List of attribute specs to be displayed")
|
||||
(PATTERN POINTER) (* \;
|
||||
"Directory pattern being enumerated")
|
||||
(PREPAREDPATTERN POINTER) (* \; "DIRECTORY.MATCH.SETUP of same")
|
||||
(SEEWINDOW POINTER) (* \;
|
||||
"Primary window used by FAST SEE command")
|
||||
(BROWSERFONT POINTER) (* \; "Font of BROWSERWINDOW")
|
||||
(SORTBY POINTER) (* \;
|
||||
"Sorting function or NIL for default sort")
|
||||
(NAMESTART WORD) (* \;
|
||||
"Index of first character in file name beyond the common prefix shared by all")
|
||||
(DIRECTORYSTART WORD) (* \;
|
||||
"Index of first character of directory in file names")
|
||||
(INFOSTART WORD) (* \;
|
||||
"X position in browser where first col of info is displayed")
|
||||
(NAMEOVERHEAD WORD) (* \;
|
||||
"This plus width of name gives is how much to allow before INFOSTART")
|
||||
(OVERFLOWSPACING WORD) (* \;
|
||||
"Increment between sizes considered for INFOSTART")
|
||||
(DIGITWIDTH WORD)
|
||||
(TOTALFILES WORD) (* \;
|
||||
"Total number of files, deleted files, pages, deleted pages at the moment")
|
||||
(DELETEDFILES WORD)
|
||||
(TOTALPAGES POINTER)
|
||||
(DELETEDPAGES POINTER)
|
||||
(PAGECOUNT? POINTER) (* \;
|
||||
"True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")
|
||||
(COUNTERPOSITIONS POINTER) (* \;
|
||||
"List of pairs (left right) describing regions where the values of the counters are displayed")
|
||||
(COUNTERPAGESTRING POINTER) (* \;
|
||||
"String to print after file/page count")
|
||||
(OVERFLOWWIDTHS POINTER) (* \;
|
||||
"List of (xpos occurrences) describing files whose names exceed default INFOSTART")
|
||||
(INFOMENUCHOICES POINTER) (* \;
|
||||
"Selections user has made in Info window, not necessarily the info currently displayed")
|
||||
(UPDATEPROC POINTER) (* \;
|
||||
"Process doing an Update (Recompute)")
|
||||
(DEFAULTDIR POINTER) (* \;
|
||||
"Default directory for destination of Copy/Rename")
|
||||
(SORTATTRIBUTE POINTER) (* \;
|
||||
"Attribute being sorted on, or NIL if by name")
|
||||
(SORTMENU POINTER)
|
||||
(FBLOCK POINTER) (* \;
|
||||
"Lock acquired by filebrowser operations")
|
||||
(SORTINDEX WORD) (* \;
|
||||
"Index (zero-based) in file info of the sort attribute")
|
||||
(SIZEINDEX WORD) (* \; "Index of size attribute")
|
||||
(FBDEPTH POINTER) (* \;
|
||||
"Enumeration depth, or NIL for default")
|
||||
(ABORTWINDOW POINTER) (* \;
|
||||
"Dotted pair of (abortwindow . menuw) for this browser's abort window.")
|
||||
DUMMY))
|
||||
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (* \;
|
||||
"True if we don't want separate subdirectory lines -- subdirs then included in name")
|
||||
(NSPATTERN? FLAG) (* \; "True if host is an ns host")
|
||||
(SHOWUNDELETED? FLAG) (* \;
|
||||
"True if counter window should show `Undeleted' rather than `Total' counts")
|
||||
(PATTERNPARSED? FLAG) (* \;
|
||||
"True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")
|
||||
(SORTBYDATE FLAG) (* \;
|
||||
"True if SORTATTRIBUTE is one of the date attributes")
|
||||
(FBREADY FLAG) (* \; "False while FB is enumerating.")
|
||||
(ABORTING FLAG) (* \;
|
||||
"True if enumeration is being aborted")
|
||||
(FIXEDTITLE FLAG) (* \; "True if caller supplied title")
|
||||
(FBCOMPUTEDDEPTH BYTE) (* \;
|
||||
"Depth at the time we enumerated directory (zero for infinite)")
|
||||
(FBDISPLAYEDDEPTH BYTE) (* \;
|
||||
"Depth we are currently displaying (zero for infinite)")
|
||||
(TABLEBROWSER POINTER) (* \;
|
||||
"Pointer to TABLEBROWSER object controlling the browser")
|
||||
(BROWSERWINDOW POINTER) (* \; "Main window")
|
||||
(COUNTERWINDOW POINTER) (* \;
|
||||
"Window that counts files, pages, deletions")
|
||||
(HEADINGWINDOW POINTER) (* \;
|
||||
"Window with headings for browser columns")
|
||||
(INFOMENUW POINTER) (* \;
|
||||
"Window containing choices for info to be displayed, or NIL if none yet")
|
||||
(PROMPTWINDOW POINTER) (* \; "GETPROMPTWINDOW BROWSERWINDOW")
|
||||
(INFODISPLAYED POINTER) (* \;
|
||||
"List of attribute specs to be displayed")
|
||||
(PATTERN POINTER) (* \;
|
||||
"Directory pattern being enumerated")
|
||||
(PREPAREDPATTERN POINTER) (* \; "DIRECTORY.MATCH.SETUP of same")
|
||||
(SEEWINDOW POINTER) (* \;
|
||||
"Primary window used by FAST SEE command")
|
||||
(BROWSERFONT POINTER) (* \; "Font of BROWSERWINDOW")
|
||||
(SORTBY POINTER) (* \;
|
||||
"Sorting function or NIL for default sort")
|
||||
(NAMESTART WORD) (* \;
|
||||
"Index of first character in file name beyond the common prefix shared by all")
|
||||
(DIRECTORYSTART WORD) (* \;
|
||||
"Index of first character of directory in file names")
|
||||
(INFOSTART WORD) (* \;
|
||||
"X position in browser where first col of info is displayed")
|
||||
(NAMEOVERHEAD WORD) (* \;
|
||||
"This plus width of name gives is how much to allow before INFOSTART")
|
||||
(OVERFLOWSPACING WORD) (* \;
|
||||
"Increment between sizes considered for INFOSTART")
|
||||
(DIGITWIDTH WORD)
|
||||
(TOTALFILES WORD) (* \;
|
||||
"Total number of files, deleted files, pages, deleted pages at the moment")
|
||||
(DELETEDFILES WORD)
|
||||
(TOTALPAGES POINTER)
|
||||
(DELETEDPAGES POINTER)
|
||||
(PAGECOUNT? POINTER) (* \;
|
||||
"True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")
|
||||
(COUNTERPOSITIONS POINTER) (* \;
|
||||
"List of pairs (left right) describing regions where the values of the counters are displayed")
|
||||
(COUNTERPAGESTRING POINTER) (* \;
|
||||
"String to print after file/page count")
|
||||
(OVERFLOWWIDTHS POINTER) (* \;
|
||||
"List of (xpos occurrences) describing files whose names exceed default INFOSTART")
|
||||
(INFOMENUCHOICES POINTER) (* \;
|
||||
"Selections user has made in Info window, not necessarily the info currently displayed")
|
||||
(UPDATEPROC POINTER) (* \;
|
||||
"Process doing an Update (Recompute)")
|
||||
(DEFAULTDIR POINTER) (* \;
|
||||
"Default directory for destination of Copy/Rename")
|
||||
(SORTATTRIBUTE POINTER) (* \;
|
||||
"Attribute being sorted on, or NIL if by name")
|
||||
(SORTMENU POINTER)
|
||||
(FBLOCK POINTER) (* \;
|
||||
"Lock acquired by filebrowser operations")
|
||||
(SORTINDEX WORD) (* \;
|
||||
"Index (zero-based) in file info of the sort attribute")
|
||||
(SIZEINDEX WORD) (* \; "Index of size attribute")
|
||||
(FBDEPTH POINTER) (* \;
|
||||
"Enumeration depth, or NIL for default")
|
||||
(ABORTWINDOW POINTER) (* \;
|
||||
"Dotted pair of (abortwindow . menuw) for this browser's abort window.")
|
||||
DUMMY))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'FBFILEDATA
|
||||
@@ -4065,25 +4059,24 @@ then click Recompute"))))
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS NULL.VERSIONP MACRO ((V)
|
||||
(EQ V 0)))
|
||||
(EQ V 0)))
|
||||
|
||||
(PUTPROPS NULL.DIRECTORYP MACRO ((FILEDATA)
|
||||
(EQ (FETCH (FBFILEDATA SUBDIREND) OF FILEDATA)
|
||||
0)))
|
||||
(EQ (FETCH (FBFILEDATA SUBDIREND) OF FILEDATA)
|
||||
0)))
|
||||
|
||||
(PUTPROPS EQ.DIRECTORYP MACRO (OPENLAMBDA (FD1 FD2)
|
||||
(STRING-EQUAL (|fetch| (FBFILEDATA FILENAME) |of|
|
||||
FD1)
|
||||
(|fetch| (FBFILEDATA FILENAME) |of| FD2)
|
||||
:END1
|
||||
(|fetch| (FBFILEDATA SUBDIREND) |of| FD1)
|
||||
:END2
|
||||
(|fetch| (FBFILEDATA SUBDIREND) |of| FD2))))
|
||||
(STRING-EQUAL (|fetch| (FBFILEDATA FILENAME) |of| FD1)
|
||||
(|fetch| (FBFILEDATA FILENAME) |of| FD2)
|
||||
:END1
|
||||
(|fetch| (FBFILEDATA SUBDIREND) |of| FD1)
|
||||
:END2
|
||||
(|fetch| (FBFILEDATA SUBDIREND) |of| FD2))))
|
||||
|
||||
(PUTPROPS NULL.FIELDP MACRO (OPENLAMBDA (STR)
|
||||
(OR (NULL STR)
|
||||
(EQ (NCHARS STR)
|
||||
0))))
|
||||
(OR (NULL STR)
|
||||
(EQ (NCHARS STR)
|
||||
0))))
|
||||
)
|
||||
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -4176,67 +4169,67 @@ then click Recompute"))))
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG)
|
||||
(NSPATTERN? FLAG)
|
||||
(SHOWUNDELETED? FLAG)
|
||||
(PATTERNPARSED? FLAG)
|
||||
(SORTBYDATE FLAG)
|
||||
(FBREADY FLAG)
|
||||
(ABORTING FLAG)
|
||||
(FIXEDTITLE FLAG)
|
||||
(FBCOMPUTEDDEPTH BYTE)
|
||||
(FBDISPLAYEDDEPTH BYTE)
|
||||
(TABLEBROWSER POINTER)
|
||||
(BROWSERWINDOW POINTER)
|
||||
(COUNTERWINDOW POINTER)
|
||||
(HEADINGWINDOW POINTER)
|
||||
(INFOMENUW POINTER)
|
||||
(PROMPTWINDOW POINTER)
|
||||
(INFODISPLAYED POINTER)
|
||||
(PATTERN POINTER)
|
||||
(PREPAREDPATTERN POINTER)
|
||||
(SEEWINDOW POINTER)
|
||||
(BROWSERFONT POINTER)
|
||||
(SORTBY POINTER)
|
||||
(NAMESTART WORD)
|
||||
(DIRECTORYSTART WORD)
|
||||
(INFOSTART WORD)
|
||||
(NAMEOVERHEAD WORD)
|
||||
(OVERFLOWSPACING WORD)
|
||||
(DIGITWIDTH WORD)
|
||||
(TOTALFILES WORD)
|
||||
(DELETEDFILES WORD)
|
||||
(TOTALPAGES POINTER)
|
||||
(DELETEDPAGES POINTER)
|
||||
(PAGECOUNT? POINTER)
|
||||
(COUNTERPOSITIONS POINTER)
|
||||
(COUNTERPAGESTRING POINTER)
|
||||
(OVERFLOWWIDTHS POINTER)
|
||||
(INFOMENUCHOICES POINTER)
|
||||
(UPDATEPROC POINTER)
|
||||
(DEFAULTDIR POINTER)
|
||||
(SORTATTRIBUTE POINTER)
|
||||
(SORTMENU POINTER)
|
||||
(FBLOCK POINTER)
|
||||
(SORTINDEX WORD)
|
||||
(SIZEINDEX WORD)
|
||||
(FBDEPTH POINTER)
|
||||
(ABORTWINDOW POINTER)
|
||||
DUMMY))
|
||||
(NSPATTERN? FLAG)
|
||||
(SHOWUNDELETED? FLAG)
|
||||
(PATTERNPARSED? FLAG)
|
||||
(SORTBYDATE FLAG)
|
||||
(FBREADY FLAG)
|
||||
(ABORTING FLAG)
|
||||
(FIXEDTITLE FLAG)
|
||||
(FBCOMPUTEDDEPTH BYTE)
|
||||
(FBDISPLAYEDDEPTH BYTE)
|
||||
(TABLEBROWSER POINTER)
|
||||
(BROWSERWINDOW POINTER)
|
||||
(COUNTERWINDOW POINTER)
|
||||
(HEADINGWINDOW POINTER)
|
||||
(INFOMENUW POINTER)
|
||||
(PROMPTWINDOW POINTER)
|
||||
(INFODISPLAYED POINTER)
|
||||
(PATTERN POINTER)
|
||||
(PREPAREDPATTERN POINTER)
|
||||
(SEEWINDOW POINTER)
|
||||
(BROWSERFONT POINTER)
|
||||
(SORTBY POINTER)
|
||||
(NAMESTART WORD)
|
||||
(DIRECTORYSTART WORD)
|
||||
(INFOSTART WORD)
|
||||
(NAMEOVERHEAD WORD)
|
||||
(OVERFLOWSPACING WORD)
|
||||
(DIGITWIDTH WORD)
|
||||
(TOTALFILES WORD)
|
||||
(DELETEDFILES WORD)
|
||||
(TOTALPAGES POINTER)
|
||||
(DELETEDPAGES POINTER)
|
||||
(PAGECOUNT? POINTER)
|
||||
(COUNTERPOSITIONS POINTER)
|
||||
(COUNTERPAGESTRING POINTER)
|
||||
(OVERFLOWWIDTHS POINTER)
|
||||
(INFOMENUCHOICES POINTER)
|
||||
(UPDATEPROC POINTER)
|
||||
(DEFAULTDIR POINTER)
|
||||
(SORTATTRIBUTE POINTER)
|
||||
(SORTMENU POINTER)
|
||||
(FBLOCK POINTER)
|
||||
(SORTINDEX WORD)
|
||||
(SIZEINDEX WORD)
|
||||
(FBDEPTH POINTER)
|
||||
(ABORTWINDOW POINTER)
|
||||
DUMMY))
|
||||
|
||||
(DATATYPE FBFILEDATA ((FILENAME POINTER)
|
||||
(FILEINFO POINTER)
|
||||
(VERSIONLESSNAME POINTER)
|
||||
(DIRECTORYP FLAG)
|
||||
(HASDIRPREFIX FLAG)
|
||||
(DIRECTORYFILEP FLAG)
|
||||
(SIZE POINTER)
|
||||
(FILEDEPTH BYTE)
|
||||
(SORTVALUE POINTER)
|
||||
(SUBDIREND WORD)
|
||||
(STARTOFPNAME WORD)
|
||||
(VERSION WORD)
|
||||
(STARTOFNAME WORD)
|
||||
DUMMY))
|
||||
(FILEINFO POINTER)
|
||||
(VERSIONLESSNAME POINTER)
|
||||
(DIRECTORYP FLAG)
|
||||
(HASDIRPREFIX FLAG)
|
||||
(DIRECTORYFILEP FLAG)
|
||||
(SIZE POINTER)
|
||||
(FILEDEPTH BYTE)
|
||||
(SORTVALUE POINTER)
|
||||
(SUBDIREND WORD)
|
||||
(STARTOFPNAME WORD)
|
||||
(VERSION WORD)
|
||||
(STARTOFNAME WORD)
|
||||
DUMMY))
|
||||
)
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -4244,10 +4237,10 @@ then click Recompute"))))
|
||||
|
||||
|
||||
(ADDTOVAR *ATTACHED-WINDOW-COMMAND-SYNONYMS* (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW)
|
||||
(HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
|
||||
(HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
|
||||
|
||||
(ADDTOVAR |BackgroundMenuCommands| ("FileBrowser" '(FILEBROWSER)
|
||||
"Opens a filebrowser window; prompts for pattern"))
|
||||
"Opens a filebrowser window; prompts for pattern"))
|
||||
|
||||
|
||||
(RPAQQ |BackgroundMenu| NIL)
|
||||
@@ -4263,51 +4256,51 @@ then click Recompute"))))
|
||||
(PUTPROPS FILEBROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1993 1994 1999 2000 2001 2021))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (32602 55483 (FB 32612 . 33747) (FB.COPYBINARYCOMMAND 33749 . 34095) (FB.COPYTEXTCOMMAND
|
||||
34097 . 34439) (FILEBROWSER 34441 . 47547) (FB.TABLEBROWSER 47549 . 47766) (FB.SELECTEDFILES 47768 .
|
||||
48405) (FB.FETCHFILENAME 48407 . 48799) (FB.DIRECTORYP 48801 . 49195) (FB.PROMPTWPRINT 49197 . 50243)
|
||||
(FB.PROMPTW.FORMAT 50245 . 50982) (FB.PROMPTFORINPUT 50984 . 53236) (FB.YES-OR-NO-P 53238 . 54272) (
|
||||
FB.ALLOW.ABORT 54274 . 55128) (\\FB.HARDCOPY.TOFILE.EXTENSION 55130 . 55481)) (55507 56460 (FB.STARTUP
|
||||
55517 . 56032) (FB.MAKERIGIDWINDOW 56034 . 56458)) (56461 61833 (FB.PRINTFN 56471 . 61624) (FB.COPYFN
|
||||
61626 . 61831)) (61883 68223 (FB.MENU.WHENSELECTEDFN 61893 . 62251) (FB.COMMANDSELECTEDFN 62253 .
|
||||
63792) (FB.SUBITEMP 63794 . 64395) (FB.MAKE.BROWSER.BUSY 64397 . 65201) (FB.FINISH.COMMAND 65203 .
|
||||
67234) (FB.HANDLE.ABORT.BUTTON 67236 . 68221)) (68224 73740 (FB.DELETECOMMAND 68234 . 68515) (
|
||||
FB.DELVERCOMMAND 68517 . 71710) (FB.IS.NOT.SUBDIRECTORY.ITEM 71712 . 71893) (FB.DELVER.FILES 71895 .
|
||||
72984) (FB.DELETE.FILE 72986 . 73738)) (73741 75066 (FB.UNDELETECOMMAND 73751 . 74036) (
|
||||
FB.UNDELETEALLCOMMAND 74038 . 74317) (FB.UNDELETE.FILE 74319 . 75064)) (75067 99248 (FB.COPYCOMMAND
|
||||
75077 . 75346) (FB.RENAMECOMMAND 75348 . 75623) (FB.COPY/RENAME.COMMAND 75625 . 76548) (
|
||||
FB.COPY/RENAME.ONE 76550 . 78872) (FB.COPY/RENAME.MANY 78874 . 85094) (FB.MERGE.DIRECTORIES 85096 .
|
||||
85514) (FB.GREATEST.PREFIX 85516 . 86872) (FB.MAYBE.INSERT.FILE 86874 . 94314) (FB.GET.NEW.FILE.SPEC
|
||||
94316 . 98147) (FB.CANONICAL.DIRECTORY 98149 . 99246)) (99249 107033 (FB.HARDCOPYCOMMAND 99259 .
|
||||
100389) (FB.HARDCOPY.TOFILE 100391 . 107031)) (107034 117233 (FB.EDITCOMMAND 107044 . 107911) (
|
||||
FB.EDITCOMMAND.ONEFILE 107913 . 111317) (FB.EDITLISPFILE 111319 . 112424) (FB.BROWSECOMMAND 112426 .
|
||||
117231)) (117234 129155 (FB.FASTSEECOMMAND 117244 . 120694) (FB.FASTSEE.ONEFILE 120696 . 123853) (
|
||||
FB.SEEFULLFN 123855 . 127986) (FB.SEEBUTTONFN 127988 . 129153)) (129156 130902 (FB.LOADCOMMAND 129166
|
||||
. 129673) (FB.COMPILECOMMAND 129675 . 130213) (FB.OPERATE.ON.FILES 130215 . 130900)) (130903 179088 (
|
||||
FB.UPDATECOMMAND 130913 . 131138) (FB.FIX-DIRECTORY-DATES 131140 . 132163) (FB.MAYBE.EXPUNGE 132165 .
|
||||
133226) (FB.UPDATEBROWSERITEMS 133228 . 146443) (FB.DATE 146445 . 147086) (FB.ADJUST.DATE.WIDTH 147088
|
||||
. 150056) (FB.SET.BROWSER.TITLE 150058 . 151060) (FB.MAYBE.WIDEN.NAMES 151062 . 153181) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 153183 . 154547) (FB.CREATE.FILEBUCKET 154549 . 161769) (
|
||||
FB.CHECK.NAME.LENGTH 161771 . 164192) (FB.ADD.FILEGROUP 164194 . 165721) (FB.INSERT.DIRECTORY 165723
|
||||
. 165961) (FB.MAKE.SUBDIRECTORY.ITEM 165963 . 167372) (FB.ADD.FILE 167374 . 167987) (FB.INSERT.FILE
|
||||
167989 . 171401) (FB.ANALYZE.PATTERN 171403 . 176667) (FB.CANONICALIZE.PATTERN 176669 . 177981) (
|
||||
FB.GETALLFILEINFO 177983 . 179086)) (179089 187248 (FB.SORT.VERSIONS 179099 . 181870) (
|
||||
FB.DECREASING.VERSION 181872 . 182541) (FB.INCREASING.VERSION 182543 . 183164) (
|
||||
FB.NAMES.DECREASING.VERSION 183166 . 184201) (FB.NAMES.INCREASING.VERSION 184203 . 185200) (
|
||||
FB.DECREASING.NUMERIC.ATTR 185202 . 185882) (FB.INCREASING.NUMERIC.ATTR 185884 . 186558) (
|
||||
FB.ALPHABETIC.ATTR 186560 . 187246)) (187249 197091 (FB.SORTCOMMAND 187259 . 194089) (
|
||||
FB.INSERT.SUBDIRECTORIES 194091 . 194888) (FB.GET.SORT.MENU 194890 . 197089)) (197092 213313 (
|
||||
FB.EXPUNGECOMMAND 197102 . 199687) (FB.NEWPATTERNCOMMAND 199689 . 200087) (FB.NEWINFOCOMMAND 200089 .
|
||||
202921) (FB.DEPTHCOMMAND 202923 . 204698) (FB.SHAPECOMMAND 204700 . 208042) (FB.REMOVE.FILE 208044 .
|
||||
209865) (FB.COUNT.FILE.CHANGE 209867 . 211312) (FB.SETNEWPATTERN 211314 . 212484) (FB.GET.NEWPATTERN
|
||||
212486 . 213070) (FB.OPTIONSCOMMAND 213072 . 213311)) (213348 214401 (FB.GETWINDOW 213358 . 214399)) (
|
||||
214402 215414 (FB.INFOMENU.SHADEINITIALSELECTIONS 214412 . 215059) (FB.INFO.ITEM.NAMED 215061 . 215412
|
||||
)) (215415 224947 (FB.MAKECOUNTERWINDOW 215425 . 216953) (FB.COUNTERW.REDISPLAYFN 216955 . 217542) (
|
||||
FB.UPDATE.COUNTERS 217544 . 219616) (FB.DISPLAY.COUNTERS 219618 . 224678) (FB.COUNTER.STRING 224680 .
|
||||
224945)) (224948 229657 (FB.MAKEHEADINGWINDOW 224958 . 226572) (FB.HEADINGW.REDISPLAYFN 226574 .
|
||||
226840) (FB.HEADINGW.RESHAPEFN 226842 . 227218) (FB.HEADINGW.DISPLAY 227220 . 229655)) (229658 233841
|
||||
(FB.ICONFN 229668 . 230015) (FB.INFOMENU.WHENSELECTEDFN 230017 . 230747) (FB.CLOSEFN 230749 . 231952)
|
||||
(FB.EXPUNGE?.MENU 231954 . 232366) (FB.AFTERCLOSEFN 232368 . 232729) (FB.CLOSE&EXPUNGE 232731 . 233839
|
||||
)) (233842 245900 (FB.HARDCOPY.DIRECTORY 233852 . 244209) (FB.HARDCOPY.PRINT.TITLE 244211 . 244537) (
|
||||
FB.HARDCOPY.MAXWIDTH 244539 . 245898)))))
|
||||
(FILEMAP (NIL (32375 55256 (FB 32385 . 33520) (FB.COPYBINARYCOMMAND 33522 . 33868) (FB.COPYTEXTCOMMAND
|
||||
33870 . 34212) (FILEBROWSER 34214 . 47320) (FB.TABLEBROWSER 47322 . 47539) (FB.SELECTEDFILES 47541 .
|
||||
48178) (FB.FETCHFILENAME 48180 . 48572) (FB.DIRECTORYP 48574 . 48968) (FB.PROMPTWPRINT 48970 . 50016)
|
||||
(FB.PROMPTW.FORMAT 50018 . 50755) (FB.PROMPTFORINPUT 50757 . 53009) (FB.YES-OR-NO-P 53011 . 54045) (
|
||||
FB.ALLOW.ABORT 54047 . 54901) (\\FB.HARDCOPY.TOFILE.EXTENSION 54903 . 55254)) (55280 56233 (FB.STARTUP
|
||||
55290 . 55805) (FB.MAKERIGIDWINDOW 55807 . 56231)) (56234 61606 (FB.PRINTFN 56244 . 61397) (FB.COPYFN
|
||||
61399 . 61604)) (61656 67996 (FB.MENU.WHENSELECTEDFN 61666 . 62024) (FB.COMMANDSELECTEDFN 62026 .
|
||||
63565) (FB.SUBITEMP 63567 . 64168) (FB.MAKE.BROWSER.BUSY 64170 . 64974) (FB.FINISH.COMMAND 64976 .
|
||||
67007) (FB.HANDLE.ABORT.BUTTON 67009 . 67994)) (67997 73513 (FB.DELETECOMMAND 68007 . 68288) (
|
||||
FB.DELVERCOMMAND 68290 . 71483) (FB.IS.NOT.SUBDIRECTORY.ITEM 71485 . 71666) (FB.DELVER.FILES 71668 .
|
||||
72757) (FB.DELETE.FILE 72759 . 73511)) (73514 74839 (FB.UNDELETECOMMAND 73524 . 73809) (
|
||||
FB.UNDELETEALLCOMMAND 73811 . 74090) (FB.UNDELETE.FILE 74092 . 74837)) (74840 99021 (FB.COPYCOMMAND
|
||||
74850 . 75119) (FB.RENAMECOMMAND 75121 . 75396) (FB.COPY/RENAME.COMMAND 75398 . 76321) (
|
||||
FB.COPY/RENAME.ONE 76323 . 78645) (FB.COPY/RENAME.MANY 78647 . 84867) (FB.MERGE.DIRECTORIES 84869 .
|
||||
85287) (FB.GREATEST.PREFIX 85289 . 86645) (FB.MAYBE.INSERT.FILE 86647 . 94087) (FB.GET.NEW.FILE.SPEC
|
||||
94089 . 97920) (FB.CANONICAL.DIRECTORY 97922 . 99019)) (99022 106806 (FB.HARDCOPYCOMMAND 99032 .
|
||||
100162) (FB.HARDCOPY.TOFILE 100164 . 106804)) (106807 117006 (FB.EDITCOMMAND 106817 . 107684) (
|
||||
FB.EDITCOMMAND.ONEFILE 107686 . 111090) (FB.EDITLISPFILE 111092 . 112197) (FB.BROWSECOMMAND 112199 .
|
||||
117004)) (117007 128928 (FB.FASTSEECOMMAND 117017 . 120467) (FB.FASTSEE.ONEFILE 120469 . 123626) (
|
||||
FB.SEEFULLFN 123628 . 127759) (FB.SEEBUTTONFN 127761 . 128926)) (128929 130675 (FB.LOADCOMMAND 128939
|
||||
. 129446) (FB.COMPILECOMMAND 129448 . 129986) (FB.OPERATE.ON.FILES 129988 . 130673)) (130676 178861 (
|
||||
FB.UPDATECOMMAND 130686 . 130911) (FB.FIX-DIRECTORY-DATES 130913 . 131936) (FB.MAYBE.EXPUNGE 131938 .
|
||||
132999) (FB.UPDATEBROWSERITEMS 133001 . 146216) (FB.DATE 146218 . 146859) (FB.ADJUST.DATE.WIDTH 146861
|
||||
. 149829) (FB.SET.BROWSER.TITLE 149831 . 150833) (FB.MAYBE.WIDEN.NAMES 150835 . 152954) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 152956 . 154320) (FB.CREATE.FILEBUCKET 154322 . 161542) (
|
||||
FB.CHECK.NAME.LENGTH 161544 . 163965) (FB.ADD.FILEGROUP 163967 . 165494) (FB.INSERT.DIRECTORY 165496
|
||||
. 165734) (FB.MAKE.SUBDIRECTORY.ITEM 165736 . 167145) (FB.ADD.FILE 167147 . 167760) (FB.INSERT.FILE
|
||||
167762 . 171174) (FB.ANALYZE.PATTERN 171176 . 176440) (FB.CANONICALIZE.PATTERN 176442 . 177754) (
|
||||
FB.GETALLFILEINFO 177756 . 178859)) (178862 187021 (FB.SORT.VERSIONS 178872 . 181643) (
|
||||
FB.DECREASING.VERSION 181645 . 182314) (FB.INCREASING.VERSION 182316 . 182937) (
|
||||
FB.NAMES.DECREASING.VERSION 182939 . 183974) (FB.NAMES.INCREASING.VERSION 183976 . 184973) (
|
||||
FB.DECREASING.NUMERIC.ATTR 184975 . 185655) (FB.INCREASING.NUMERIC.ATTR 185657 . 186331) (
|
||||
FB.ALPHABETIC.ATTR 186333 . 187019)) (187022 196864 (FB.SORTCOMMAND 187032 . 193862) (
|
||||
FB.INSERT.SUBDIRECTORIES 193864 . 194661) (FB.GET.SORT.MENU 194663 . 196862)) (196865 213086 (
|
||||
FB.EXPUNGECOMMAND 196875 . 199460) (FB.NEWPATTERNCOMMAND 199462 . 199860) (FB.NEWINFOCOMMAND 199862 .
|
||||
202694) (FB.DEPTHCOMMAND 202696 . 204471) (FB.SHAPECOMMAND 204473 . 207815) (FB.REMOVE.FILE 207817 .
|
||||
209638) (FB.COUNT.FILE.CHANGE 209640 . 211085) (FB.SETNEWPATTERN 211087 . 212257) (FB.GET.NEWPATTERN
|
||||
212259 . 212843) (FB.OPTIONSCOMMAND 212845 . 213084)) (213121 214174 (FB.GETWINDOW 213131 . 214172)) (
|
||||
214175 215187 (FB.INFOMENU.SHADEINITIALSELECTIONS 214185 . 214832) (FB.INFO.ITEM.NAMED 214834 . 215185
|
||||
)) (215188 224720 (FB.MAKECOUNTERWINDOW 215198 . 216726) (FB.COUNTERW.REDISPLAYFN 216728 . 217315) (
|
||||
FB.UPDATE.COUNTERS 217317 . 219389) (FB.DISPLAY.COUNTERS 219391 . 224451) (FB.COUNTER.STRING 224453 .
|
||||
224718)) (224721 229430 (FB.MAKEHEADINGWINDOW 224731 . 226345) (FB.HEADINGW.REDISPLAYFN 226347 .
|
||||
226613) (FB.HEADINGW.RESHAPEFN 226615 . 226991) (FB.HEADINGW.DISPLAY 226993 . 229428)) (229431 233614
|
||||
(FB.ICONFN 229441 . 229788) (FB.INFOMENU.WHENSELECTEDFN 229790 . 230520) (FB.CLOSEFN 230522 . 231725)
|
||||
(FB.EXPUNGE?.MENU 231727 . 232139) (FB.AFTERCLOSEFN 232141 . 232502) (FB.CLOSE&EXPUNGE 232504 . 233612
|
||||
)) (233615 245673 (FB.HARDCOPY.DIRECTORY 233625 . 243982) (FB.HARDCOPY.PRINT.TITLE 243984 . 244310) (
|
||||
FB.HARDCOPY.MAXWIDTH 244312 . 245671)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 8-Oct-92 16:50:21" "{Pele:mv:envos}<LispCore>library>HRULE.;11" 23325
|
||||
|
||||
changes to%: (FNS VRULE.CREATE VRULE.GETFN2)
|
||||
(FILECREATED "25-Jul-2022 15:09:26" {DSK}<Users>kaplan>Local>medley3.5>working-medley>library>HRULE.;4 23801
|
||||
|
||||
previous date%: "29-Sep-92 21:06:13" "{Pele:mv:envos}<LispCore>library>HRULE.;10")
|
||||
:CHANGES-TO (VARS HRULECOMS)
|
||||
|
||||
:PREVIOUS-DATE "25-Jul-2022 15:07:00"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>HRULE.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT HRULECOMS)
|
||||
@@ -33,7 +35,10 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION HRULE.WHENOPERATEDONFN)
|
||||
(FUNCTION NILL]
|
||||
(FUNCTION (LAMBDA (OBJ)
|
||||
(CONCAT (CHARACTER (CHARCODE EOL))
|
||||
(ALLOCSTRING 20 "-")
|
||||
(CHARACTER (CHARCODE EOL]
|
||||
[COMS
|
||||
(* ;; "Vertical rules")
|
||||
|
||||
@@ -200,11 +205,11 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
|
||||
|
||||
(RPAQ? HRULE.DEFAULT.WIDTH 2)
|
||||
|
||||
(RPAQQ HRULEFNS (HRULE.CREATE HRULE.DISPLAYFN HRULE.GETFN HRULE.IMAGEBOXFN HRULE.PUTFN
|
||||
HRULE.COPYFN HRULE.WHENOPERATEDONFN))
|
||||
(RPAQQ HRULEFNS (HRULE.CREATE HRULE.DISPLAYFN HRULE.GETFN HRULE.IMAGEBOXFN HRULE.PUTFN HRULE.COPYFN
|
||||
HRULE.WHENOPERATEDONFN))
|
||||
|
||||
(RPAQ HRULE.IMAGEFNS
|
||||
(IMAGEFNSCREATE (FUNCTION HRULE.DISPLAYFN)
|
||||
[IMAGEFNSCREATE (FUNCTION HRULE.DISPLAYFN)
|
||||
(FUNCTION HRULE.IMAGEBOXFN)
|
||||
(FUNCTION HRULE.PUTFN)
|
||||
(FUNCTION HRULE.GETFN)
|
||||
@@ -216,7 +221,10 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION HRULE.WHENOPERATEDONFN)
|
||||
(FUNCTION NILL)))
|
||||
(FUNCTION (LAMBDA (OBJ)
|
||||
(CONCAT (CHARACTER (CHARCODE EOL))
|
||||
(ALLOCSTRING 20 "-")
|
||||
(CHARACTER (CHARCODE EOL])
|
||||
|
||||
|
||||
|
||||
@@ -502,12 +510,12 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
|
||||
(FUNCTION NILL)))
|
||||
(PUTPROPS HRULE COPYRIGHT ("Venue & Xerox Corporation" 1985 1990 1991 1992))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4225 10404 (HRULE.CREATE 4235 . 5657) (HRULE.DISPLAYFN 5659 . 8228) (HRULE.GETFN 8230
|
||||
. 8550) (HRULE.IMAGEBOXFN 8552 . 9354) (HRULE.PUTFN 9356 . 9734) (HRULE.COPYFN 9736 . 10200) (
|
||||
HRULE.WHENOPERATEDONFN 10202 . 10402)) (11107 17312 (VRULE.CREATE 11117 . 13116) (VRULE.DISPLAYFN
|
||||
13118 . 15312) (VRULE.GETFN 15314 . 15535) (VRULE.GETFN2 15537 . 15873) (VRULE.IMAGEBOXFN 15875 .
|
||||
16303) (VRULE.PUTFN 16305 . 16703) (VRULE.COPYFN 16705 . 17108) (VRULE.WHENOPERATEDONFN 17110 . 17310)
|
||||
) (17951 22601 (CROPMARK.CREATE 17961 . 19228) (CROPMARK.DISPLAYFN 19230 . 20730) (CROPMARK.GETFN
|
||||
20732 . 21026) (CROPMARK.IMAGEBOXFN 21028 . 21729) (CROPMARK.PUTFN 21731 . 22009) (CROPMARK.COPYFN
|
||||
22011 . 22394) (CROPMARK.WHENOPERATEDONFN 22396 . 22599)))))
|
||||
(FILEMAP (NIL (4512 10691 (HRULE.CREATE 4522 . 5944) (HRULE.DISPLAYFN 5946 . 8515) (HRULE.GETFN 8517
|
||||
. 8837) (HRULE.IMAGEBOXFN 8839 . 9641) (HRULE.PUTFN 9643 . 10021) (HRULE.COPYFN 10023 . 10487) (
|
||||
HRULE.WHENOPERATEDONFN 10489 . 10689)) (11583 17788 (VRULE.CREATE 11593 . 13592) (VRULE.DISPLAYFN
|
||||
13594 . 15788) (VRULE.GETFN 15790 . 16011) (VRULE.GETFN2 16013 . 16349) (VRULE.IMAGEBOXFN 16351 .
|
||||
16779) (VRULE.PUTFN 16781 . 17179) (VRULE.COPYFN 17181 . 17584) (VRULE.WHENOPERATEDONFN 17586 . 17786)
|
||||
) (18427 23077 (CROPMARK.CREATE 18437 . 19704) (CROPMARK.DISPLAYFN 19706 . 21206) (CROPMARK.GETFN
|
||||
21208 . 21502) (CROPMARK.IMAGEBOXFN 21504 . 22205) (CROPMARK.PUTFN 22207 . 22485) (CROPMARK.COPYFN
|
||||
22487 . 22870) (CROPMARK.WHENOPERATEDONFN 22872 . 23075)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,22 +1,20 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "15-Jan-2022 20:17:21" |{DSK}<home>larry>medley>library>MSCOMMON.;4| 24053
|
||||
(FILECREATED " 2-Nov-2022 10:13:59" |{DSK}<home>larry>ilisp>medley>library>MSCOMMON.;3| 23999
|
||||
|
||||
:CHANGES-TO (TEMPLATES ADD-EXEC CL:ASSOC CL:COMPILE-FILE EXEC CL:IN-PACKAGE CL:MAKE-STRING OPEN
|
||||
CL:PUSH CL:PUSHNEW CL:RASSOC CL:WRITE-LINE CL:WRITE-STRING CL:WHEN CL:UNLESS
|
||||
)
|
||||
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
|
||||
(VARS MSCOMMONCOMS)
|
||||
:CHANGES-TO (VARS MSCOMMONCOMS)
|
||||
(TEMPLATES CL:UNLESS CL:WHEN)
|
||||
|
||||
:PREVIOUS-DATE " 4-May-92 13:10:53" |{DSK}<home>larry>medley>library>MSCOMMON.;3|)
|
||||
:PREVIOUS-DATE "15-Jan-2022 20:17:21" |{DSK}<home>larry>ilisp>medley>library>MSCOMMON.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation.
|
||||
; Copyright (c) 1988, 1990, 1992, 2022 by Venue & Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT MSCOMMONCOMS)
|
||||
|
||||
(RPAQQ MSCOMMONCOMS
|
||||
((PROP FILETYPE MSCOMMON)
|
||||
(DECLARE\: EVAL@COMPILE (GLOBALVARS USERTEMPLATES MSTEMPLATES))
|
||||
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
|
||||
|
||||
(* |;;| "Templates for CL stuff that need them.")
|
||||
@@ -89,6 +87,12 @@
|
||||
(CLRHASH USERTEMPLATES))))
|
||||
|
||||
(PUTPROPS MSCOMMON FILETYPE :COMPILE-FILE)
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS USERTEMPLATES MSTEMPLATES)
|
||||
)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(FUNCTIONSMSGETDEF
|
||||
@@ -470,13 +474,13 @@
|
||||
|
||||
(SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
|
||||
|
||||
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFECT RETURN))
|
||||
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH))
|
||||
|
||||
(SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL))
|
||||
|
||||
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFECT RETURN))
|
||||
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE
|
||||
:GENSYM :ARRAY))
|
||||
@@ -552,8 +556,8 @@
|
||||
(PUTHASH KEY VAL MSTEMPLATES)))
|
||||
|
||||
(CLRHASH USERTEMPLATES)
|
||||
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992))
|
||||
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992 2022))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (5280 7291 (FUNCTIONSMSGETDEF 5290 . 6258) (FUNCTIONSMSMC 6260 . 6731) (
|
||||
VARIABLESMSGETDEF 6733 . 7289)))))
|
||||
(FILEMAP (NIL (5219 7230 (FUNCTIONSMSGETDEF 5229 . 6197) (FUNCTIONSMSMC 6199 . 6670) (
|
||||
VARIABLESMSGETDEF 6672 . 7228)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
313
library/SKETCH
313
library/SKETCH
@@ -1,11 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Feb-2022 09:17:12" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SKETCH.;2 490756
|
||||
(FILECREATED " 4-Aug-2022 09:58:03" {DSK}<home>larry>medley>library>SKETCH.;2 491064
|
||||
|
||||
:CHANGES-TO (FNS SKETCH.PUT)
|
||||
:CHANGES-TO (FNS SKETCH.COMMANDMENU.ITEMS)
|
||||
|
||||
:PREVIOUS-DATE "21-Jan-93 11:59:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SKETCH.;1)
|
||||
:PREVIOUS-DATE " 1-Feb-2022 09:17:12" {DSK}<home>larry>medley>library>SKETCH.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -1358,10 +1357,9 @@ This will be slow for arcs and curves."]
|
||||
TITLE _ TITLE])
|
||||
|
||||
(SKETCH.COMMANDMENU.ITEMS
|
||||
[LAMBDA (ADDFIXITEM ELEMENTTYPES VIEWER) (* rrb "24-Sep-86 18:11")
|
||||
|
||||
(* returns a list of the items that are in the sketch command menu.)
|
||||
|
||||
[LAMBDA (ADDFIXITEM ELEMENTTYPES VIEWER) (* rrb "24-Sep-86 18:11")
|
||||
(* returns a list of the items that
|
||||
are in the sketch command menu.)
|
||||
(APPEND '[(Delete SK.DELETE.ELT "Deletes one or more elements from the sketch."
|
||||
(SUBITEMS ("Delete element(s)" SK.DELETE.ELT
|
||||
"Deletes one or more elements from the sketch.")
|
||||
@@ -1388,15 +1386,18 @@ This will be slow for arcs and curves."]
|
||||
(Combined SK.SET.MOVE.MODE.COMBINED
|
||||
"MOVE command will move points if a single point is clicked; elements otherwise"
|
||||
]
|
||||
'[(Copy SK.COPY.ELT "Copies a piece of the sketch." (SUBITEMS ("Copy elements" SK.COPY.ELT
|
||||
'[(Copy SK.COPY.ELT "Copies a piece of the sketch." (SUBITEMS ("Copy elements" SK.COPY.ELT
|
||||
|
||||
"copies one or more elements of the sketch."
|
||||
)
|
||||
("Copy w/2 pt trans"
|
||||
SK.COPY.AND.TWO.PT.TRANSFORM.ELTS
|
||||
SK.COPY.AND.TWO.PT.TRANSFORM.ELTS
|
||||
|
||||
"Copies one or more sketch elements with a two point transformation."
|
||||
)
|
||||
("Copy w/3 pt trans"
|
||||
SK.COPY.AND.THREE.PT.TRANSFORM.ELTS
|
||||
SK.COPY.AND.THREE.PT.TRANSFORM.ELTS
|
||||
|
||||
"Copies one or more sketch elements with a three point transformation."
|
||||
]
|
||||
'[(Align SK.ALIGN.POINTS.LEFT "Aligns a collection of points with the leftmost one."
|
||||
@@ -8763,149 +8764,149 @@ Otherwise, type '^'.")
|
||||
)
|
||||
(PUTPROPS SKETCH COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22155 85518 (SKETCH 22165 . 24270) (SKETCH.FROM.A.FILE 24272 . 24587) (SKETCHW.CREATE
|
||||
24589 . 29163) (SKETCH.RESET 29165 . 30687) (SKETCHW.FIG.CHANGED 30689 . 31029) (SK.WINDOW.TITLE 31031
|
||||
. 31418) (EDITSLIDE 31420 . 31826) (EDITSKETCH 31828 . 32152) (SK.PUT.ON.FILE 32154 . 33606) (
|
||||
SK.OUTPUT.FILE.NAME 33608 . 33982) (SKETCH.PUT 33984 . 36882) (SK.GET.FROM.FILE 36884 . 37777) (
|
||||
SK.INCLUDE.FILE 37779 . 40287) (SK.GET.IMAGEOBJ.FROM.FILE 40289 . 42492) (SKETCH.GET 42494 . 42801) (
|
||||
ADD.SKETCH.TO.VIEWER 42803 . 45389) (FILENAMELESSVERSION 45391 . 45667) (SK.ADD.ELEMENTS.TO.SKETCH
|
||||
45669 . 46183) (SKETCH.SET.A.DEFAULT 46185 . 53343) (SK.POPUP.SELECTIONFN 53345 . 53887) (
|
||||
GETSKETCHWREGION 53889 . 54095) (SK.ADD.ELEMENT 54097 . 55676) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH
|
||||
55678 . 57072) (SK.ELTS.BY.PRIORITY 57074 . 57370) (SK.ORDER.ELEMENTS 57372 . 57639) (
|
||||
SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57641 . 59135) (SK.ADD.ELEMENTS 59137 . 59661) (
|
||||
SK.CHECK.WHENADDEDFN 59663 . 60393) (SK.APPLY.MENU.COMMAND 60395 . 61193) (SK.DELETE.ELEMENT1 61195 .
|
||||
62773) (SK.MARK.DIRTY 62775 . 63441) (SK.MARK.UNDIRTY 63443 . 63774) (SK.MENU.AND.RETURN.FIELD 63776
|
||||
. 64441) (SKETCH.SET.BRUSH.SHAPE 64443 . 65028) (SKETCH.SET.BRUSH.SIZE 65030 . 65536) (
|
||||
SKETCHW.CLOSEFN 65538 . 67329) (SK.CONFIRM.DESTRUCTION 67331 . 68330) (SKETCHW.OUTFN 68332 . 68596) (
|
||||
SKETCHW.REOPENFN 68598 . 69010) (MAKE.LOCAL.SKETCH 69012 . 69742) (MAP.SKETCHSPEC.INTO.VIEWER 69744 .
|
||||
70954) (SKETCHW.REPAINTFN 70956 . 71784) (SKETCHW.REPAINTFN1 71786 . 72725) (SK.DRAWFIGURE.IF 72727 .
|
||||
73249) (SKETCHW.SCROLLFN 73251 . 77444) (SKETCHW.RESHAPEFN 77446 . 79704) (SK.UPDATE.EVENT.SELECTION
|
||||
79706 . 81761) (LIGHTGRAYWINDOW 81763 . 81926) (SK.ADD.SPACES 81928 . 82674) (SK.SKETCH.MENU 82676 .
|
||||
82998) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 83000 . 83852) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83854 . 84814)
|
||||
(SK.RETURN.TTY 84816 . 85184) (SK.TAKE.TTY 85186 . 85516)) (85572 108565 (SKETCH.COMMANDMENU 85582 .
|
||||
85919) (SKETCH.COMMANDMENU.ITEMS 85921 . 105669) (CREATE.SKETCHW.COMMANDMENU 105671 . 106091) (
|
||||
SKETCHW.SELECTIONFN 106093 . 107196) (SKETCH.MONITORLOCK 107198 . 107669) (SK.EVAL.AS.PROCESS 107671
|
||||
. 108284) (SK.EVAL.WITH.LOCK 108286 . 108563)) (108566 116370 (SK.FIX.MENU 108576 . 109670) (
|
||||
SK.SET.UP.MENUS 109672 . 111973) (SK.INSURE.HAS.MENU 111975 . 112637) (SK.CREATE.STANDARD.MENU 112639
|
||||
. 113084) (SK.ADD.ITEM.TO.MENU 113086 . 113761) (SK.GET.VIEWER.POPUP.MENU 113763 . 115964) (
|
||||
SK.CLEAR.POPUP.MENU 115966 . 116368)) (116426 125248 (SKETCH.CREATE 116436 . 117222) (GETSKETCHPROP
|
||||
117224 . 120281) (PUTSKETCHPROP 120283 . 124215) (CREATE.DEFAULT.SKETCH.CONTEXT 124217 . 125246)) (
|
||||
125414 148310 (SK.COPY.BUTTONEVENTFN 125424 . 136652) (SK.BUTTONEVENT.MARK 136654 . 137037) (
|
||||
SK.BUILD.IMAGEOBJ 137039 . 146954) (SK.BUTTONEVENT.OVERP 146956 . 147579) (SK.BUTTONEVENT.SAME.KEYS
|
||||
147581 . 148308)) (148589 174404 (SK.SEL.AND.CHANGE 148599 . 148891) (SK.CHECK.WHENCHANGEDFN 148893 .
|
||||
149599) (SK.CHECK.PRECHANGEFN 149601 . 150202) (SK.CHANGE.ELT 150204 . 150396) (SK.CHANGE.THING 150398
|
||||
. 151649) (SKETCH.CHANGE.ELEMENTS 151651 . 152834) (SK.APPLY.SINGLE.CHANGEFN 152836 . 153409) (
|
||||
SK.DO.CHANGESPECS 153411 . 155070) (SK.VIEWER.FROM.SKETCH.ARG 155072 . 155514) (SK.DO.CHANGESPEC1
|
||||
155516 . 157391) (SK.CHANGEFN 157393 . 157973) (SK.READCHANGEFN 157975 . 158434) (SK.DEFAULT.CHANGEFN
|
||||
158436 . 160908) (CHANGEABLEFIELDITEMS 160910 . 161557) (SK.APPLY.CHANGE.COMMAND 161559 . 162176) (
|
||||
SK.DO.AND.RECORD.CHANGES 162178 . 163575) (SK.APPLY.CHANGE.COMMAND1 163577 . 165065) (
|
||||
SK.ELEMENTS.CHANGEFN 165067 . 167391) (READ.POINT.TO.ADD 167393 . 168337) (GLOBAL.KNOT.FROM.LOCAL
|
||||
168339 . 168799) (SK.ADD.KNOT.TO.ELEMENT 168801 . 169745) (SK.GROUP.CHANGEFN 169747 . 170959) (
|
||||
SK.GROUP.CHANGEFN1 170961 . 174402)) (174571 188304 (ADD.ELEMENT.TO.SKETCH 174581 . 176287) (
|
||||
ADD.SKETCH.VIEWER 176289 . 176957) (REMOVE.SKETCH.VIEWER 176959 . 177572) (ALL.SKETCH.VIEWERS 177574
|
||||
. 177814) (SKETCH.ALL.VIEWERS 177816 . 178076) (VIEWER.BUCKET 178078 . 178229) (ELT.INSIDE.REGION?
|
||||
178231 . 178558) (ELT.INSIDE.SKWP 178560 . 178851) (SCALE.FROM.SKW 178853 . 179103) (
|
||||
SK.ADDELT.TO.WINDOW 179105 . 179965) (SK.CALC.REGION.VIEWED 179967 . 180345) (SK.DRAWFIGURE 180347 .
|
||||
181636) (SK.DRAWFIGURE1 181638 . 182022) (SK.LOCAL.FROM.GLOBAL 182024 . 183259) (SKETCH.REGION.VIEWED
|
||||
183261 . 185948) (SKETCH.VIEW.FROM.NAME 185950 . 186380) (SK.UPDATE.REGION.VIEWED 186382 . 186774) (
|
||||
SKETCH.ADD.AND.DISPLAY 186776 . 187184) (SKETCH.ADD.AND.DISPLAY1 187186 . 187624) (SK.ADD.ITEM 187626
|
||||
. 187958) (SKETCHW.ADD.INSTANCE 187960 . 188302)) (188345 201533 (SK.SEL.AND.DELETE 188355 . 188743)
|
||||
(SK.ERASE.AND.DELETE.ITEM 188745 . 189164) (REMOVE.ELEMENT.FROM.SKETCH 189166 . 190277) (
|
||||
SK.DELETE.ELEMENT 190279 . 190837) (SK.DELETE.ELEMENT2 190839 . 191500) (SK.DELETE.KNOT 191502 .
|
||||
191793) (SK.SEL.AND.DELETE.KNOT 191795 . 192920) (SK.DELETE.ELEMENT.KNOT 192922 . 196129) (
|
||||
SK.CHECK.WHENDELETEDFN 196131 . 196911) (SK.CHECK.PREEDITFN 196913 . 197397) (
|
||||
SK.CHECK.END.INITIAL.EDIT 197399 . 197933) (SK.CHECK.WHENPOINTDELETEDFN 197935 . 198731) (SK.ERASE.ELT
|
||||
198733 . 199069) (SK.DELETE.ELT 199071 . 199446) (SK.DELETE.ITEM 199448 . 199856) (DELFROMTCONC
|
||||
199858 . 201531)) (201572 215406 (SK.COPY.ELT 201582 . 201952) (SK.SEL.AND.COPY 201954 . 202337) (
|
||||
SK.COPY.ELEMENTS 202339 . 207967) (SK.ADD.COPY.OF.ELEMENTS 207969 . 209736) (
|
||||
SK.GLOBAL.FROM.LOCAL.ELEMENTS 209738 . 209978) (SK.COPY.ITEM 209980 . 210777) (SK.INSERT.SKETCH 210779
|
||||
. 215404)) (215446 245467 (SK.MOVE.ELT 215456 . 215731) (SK.MOVE.ELT.OR.PT 215733 . 216046) (
|
||||
SK.APPLY.DEFAULT.MOVE 216048 . 216482) (SK.SEL.AND.MOVE 216484 . 217031) (SK.MOVE.ELEMENTS 217033 .
|
||||
227905) (SKETCH.MOVE.ELEMENTS 227907 . 229838) (SKETCH.COPY.ELEMENTS 229840 . 231887) (
|
||||
\SKETCH.COPY.ELEMENT 231889 . 232614) (SK.TRANSLATE.ELEMENT 232616 . 233099) (SK.COPY.GLOBAL.ELEMENT
|
||||
233101 . 233312) (SK.MAKE.ELEMENT.MOVE.ARG 233314 . 233934) (SK.MAKE.ELEMENTS.MOVE.ARG 233936 . 234458
|
||||
) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234460 . 235529) (SK.SHOW.FIG.FROM.INFO 235531 . 235899) (
|
||||
SK.MOVE.THING 235901 . 236807) (UPDATE.ELEMENT.IN.SKETCH 236809 . 238864) (SK.UPDATE.ELEMENT 238866 .
|
||||
240425) (SK.UPDATE.ELEMENTS 240427 . 241146) (SK.UPDATE.ELEMENT1 241148 . 245048) (
|
||||
SK.MOVE.ELEMENT.POINT 245050 . 245465)) (245530 267819 (SK.MOVE.POINTS 245540 . 245827) (
|
||||
SK.SEL.AND.MOVE.POINTS 245829 . 246134) (SK.DO.MOVE.ELEMENT.POINTS 246136 . 254793) (
|
||||
SK.MOVE.ITEM.POINTS 254795 . 256466) (SK.TRANSLATEPTSFN 256468 . 256852) (SK.TRANSLATE.POINTS 256854
|
||||
. 257755) (SK.SELECT.MULTIPLE.POINTS 257757 . 263397) (SK.CONTROL.POINTS.IN.REGION 263399 . 264820) (
|
||||
SK.ADD.PT.SELECTION 264822 . 265286) (SK.REMOVE.PT.SELECTION 265288 . 265905) (SK.ADD.POINT 265907 .
|
||||
266530) (SK.ELTS.CONTAINING.PTS 266532 . 267157) (SK.HOTSPOTS.NOT.ON.LIST 267159 . 267817)) (267977
|
||||
270773 (SK.SET.MOVE.MODE 267987 . 268658) (SK.SET.MOVE.MODE.POINTS 268660 . 268999) (
|
||||
SK.SET.MOVE.MODE.ELEMENTS 269001 . 269345) (SK.SET.MOVE.MODE.COMBINED 269347 . 269697) (READMOVEMODE
|
||||
269699 . 270771)) (270774 289529 (SK.ALIGN.POINTS 270784 . 271074) (SK.SEL.AND.ALIGN.POINTS 271076 .
|
||||
271385) (SK.ALIGN.POINTS.LEFT 271387 . 271690) (SK.ALIGN.POINTS.RIGHT 271692 . 271997) (
|
||||
SK.ALIGN.POINTS.TOP 271999 . 272300) (SK.ALIGN.POINTS.BOTTOM 272302 . 272609) (
|
||||
SK.EVEN.SPACE.POINTS.IN.X 272611 . 272931) (SK.EVEN.SPACE.POINTS.IN.Y 272933 . 273253) (
|
||||
SK.DO.ALIGN.POINTS 273255 . 283877) (SK.NTH.CONTROL.POINT 283879 . 284340) (
|
||||
SK.GET.SELECTED.ELEMENT.STRUCTURE 284342 . 285008) (SK.CORRESPONDING.CONTROL.PT 285010 . 285564) (
|
||||
SK.CONTROL.POINT.NUMBER 285566 . 285936) (SK.DO.ALIGN.SETVALUE 285938 . 289527)) (289593 303025 (
|
||||
SKETCH.CREATE.GROUP 289603 . 290092) (SK.CREATE.GROUP1 290094 . 290641) (SK.UPDATE.GROUP.AFTER.CHANGE
|
||||
290643 . 291432) (SK.GROUP.ELTS 291434 . 291715) (SK.SEL.AND.GROUP 291717 . 292103) (SK.GROUP.ELEMENTS
|
||||
292105 . 293754) (SK.UNGROUP.ELT 293756 . 294040) (SK.SEL.AND.UNGROUP 294042 . 295711) (
|
||||
SK.UNGROUP.ELEMENT 295713 . 296649) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 296651 . 297573) (
|
||||
SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297575 . 298586) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298588 .
|
||||
299928) (SK.UNIONREGIONS 299930 . 302296) (SKETCH.REGION.OF.SKETCH 302298 . 302714) (SK.FLASHREGION
|
||||
302716 . 303023)) (303026 316497 (INIT.GROUP.ELEMENT 303036 . 303908) (GROUP.DRAWFN 303910 . 304360) (
|
||||
GROUP.EXPANDFN 304362 . 305925) (GROUP.INSIDEFN 305927 . 306336) (GROUP.REGIONFN 306338 . 306733) (
|
||||
GROUP.GLOBALREGIONFN 306735 . 307053) (GROUP.TRANSLATEFN 307055 . 309087) (GROUP.TRANSFORMFN 309089 .
|
||||
312569) (GROUP.READCHANGEFN 312571 . 316495)) (316498 317506 (REGION.CENTER 316508 . 317109) (
|
||||
REMOVE.LAST 317111 . 317504)) (317559 322666 (SK.MOVE.GROUP.CONTROL.PT 317569 . 317860) (
|
||||
SK.SEL.AND.MOVE.CONTROL.PT 317862 . 319266) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319268 . 321341) (
|
||||
SK.READ.NEW.GROUP.CONTROL.PT 321343 . 322664)) (322925 327549 (SK.DO.GROUP 322935 . 324387) (
|
||||
SK.CHECK.WHENGROUPEDFN 324389 . 325099) (SK.DO.UNGROUP 325101 . 326306) (SK.CHECK.WHENUNGROUPEDFN
|
||||
326308 . 326895) (SK.GROUP.UNDO 326897 . 327220) (SK.UNGROUP.UNDO 327222 . 327547)) (327790 332712 (
|
||||
SK.FREEZE.ELTS 327800 . 328084) (SK.SEL.AND.FREEZE 328086 . 328476) (SK.FREEZE.ELEMENTS 328478 .
|
||||
329029) (SK.UNFREEZE.ELT 329031 . 329320) (SK.SEL.AND.UNFREEZE 329322 . 330858) (SK.UNFREEZE.ELEMENTS
|
||||
330860 . 331419) (SK.FREEZE.UNDO 331421 . 331666) (SK.UNFREEZE.UNDO 331668 . 331915) (SK.DO.FREEZE
|
||||
331917 . 332310) (SK.DO.UNFREEZE 332312 . 332710)) (332942 342752 (SKETCH.ELEMENTS.OF.SKETCH 332952 .
|
||||
333787) (SKETCH.LIST.OF.ELEMENTS 333789 . 334507) (SKETCH.ADD.ELEMENT 334509 . 335584) (
|
||||
SKETCH.DELETE.ELEMENT 335586 . 337318) (DELFROMGROUPELT 337320 . 338120) (SKETCH.ELEMENT.TYPE 338122
|
||||
. 338471) (SKETCH.ELEMENT.CHANGED 338473 . 340041) (SK.ELEMENT.CHANGED1 340043 . 340694) (
|
||||
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 340696 . 342750)) (342806 347418 (INSURE.SKETCH 342816 . 345431)
|
||||
(LOCALSPECS.FROM.VIEWER 345433 . 345793) (SK.LOCAL.ELT.FROM.GLOBALPART 345795 . 346263) (
|
||||
SKETCH.FROM.VIEWER 346265 . 346499) (INSPECT.SKETCH 346501 . 346826) (ELT.INSIDE.SKETCHWP 346828 .
|
||||
347101) (SK.INSIDE.REGION 347103 . 347416)) (347419 351749 (MAPSKETCHSPECS 347429 . 348050) (
|
||||
MAPCOLLECTSKETCHSPECS 348052 . 348801) (MAPSKETCHSPECSUNTIL 348803 . 349611) (MAPGLOBALSKETCHSPECS
|
||||
349613 . 350314) (MAPGLOBALSKETCHELEMENTS 350316 . 351747)) (351811 377703 (SK.ADD.SELECTION 351821 .
|
||||
352561) (SK.COPY.INSERTFN 352563 . 356194) (SCREENELEMENTP 356196 . 356669) (SK.ITEM.REGION 356671 .
|
||||
357158) (SK.ELEMENT.GLOBAL.REGION 357160 . 357688) (SK.LOCAL.ITEMS.IN.REGION 357690 . 359669) (
|
||||
SK.REGIONFN 359671 . 359993) (SK.GLOBAL.REGIONFN 359995 . 360353) (SK.REMOVE.SELECTION 360355 . 361083
|
||||
) (SK.SELECT.MULTIPLE.ITEMS 361085 . 371527) (SKETCH.GET.ELEMENTS 371529 . 372952) (SK.PUT.MARKS.UP
|
||||
372954 . 373293) (SK.TAKE.MARKS.DOWN 373295 . 373634) (SK.TRANSLATE.GLOBALPART 373636 . 375763) (
|
||||
SK.TRANSLATE.ITEM 375765 . 376692) (SK.TRANSLATEFN 376694 . 376890) (TRANSLATE.SKETCH 376892 . 377701)
|
||||
) (377969 380876 (SK.INPUT.SCALE 377979 . 378826) (SK.UPDATE.SKETCHCONTEXT 378828 . 379425) (
|
||||
SK.SET.INPUT.SCALE 379427 . 380076) (SK.SET.INPUT.SCALE.CURRENT 380078 . 380369) (
|
||||
SK.SET.INPUT.SCALE.VALUE 380371 . 380874)) (380927 382839 (SK.SET.FEEDBACK.MODE 380937 . 382243) (
|
||||
SK.SET.FEEDBACK.POINT 382245 . 382413) (SK.SET.FEEDBACK.VERBOSE 382415 . 382584) (
|
||||
SK.SET.FEEDBACK.ALWAYS 382586 . 382837)) (382990 384267 (SKETCH.TITLE 383000 . 383263) (
|
||||
SK.SHRINK.ICONCREATE 383265 . 384265)) (389957 392771 (READBRUSHSHAPE 389967 . 390426) (READ.FUNCTION
|
||||
390428 . 390943) (READBRUSHSIZE 390945 . 391403) (READANGLE 391405 . 391897) (READARCDIRECTION 391899
|
||||
. 392769)) (392772 403183 (SK.CHANGE.DASHING 392782 . 396730) (READ.AND.SAVE.NEW.DASHING 396732 .
|
||||
398500) (READ.NEW.DASHING 398502 . 400242) (READ.DASHING.CHANGE 400244 . 401719) (SK.CACHE.DASHING
|
||||
401721 . 402723) (SK.DASHING.LABEL 402725 . 403181)) (403184 406889 (READ.FILLING.CHANGE 403194 .
|
||||
405175) (SK.CACHE.FILLING 405177 . 405895) (READ.AND.SAVE.NEW.FILLING 405897 . 406495) (
|
||||
SK.FILLING.LABEL 406497 . 406887)) (407273 443526 (SK.GETGLOBALPOSITION 407283 . 407588) (
|
||||
SKETCH.TRACK.ELEMENTS 407590 . 411110) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411112 . 411671) (
|
||||
MAP.SKETCH.ELEMENTS.INTO.VIEWER 411673 . 412065) (MAP.GLOBAL.POSITION.INTO.VIEWER 412067 . 412447) (
|
||||
SKETCH.TO.VIEWER.POSITION 412449 . 412808) (SKETCH.TRACK.IMAGE 412810 . 413664) (SK.TRACK.IMAGE1
|
||||
413666 . 415078) (MAP.VIEWER.XY.INTO.GLOBAL 415080 . 416074) (SK.SET.POSITION 416076 . 416412) (
|
||||
MAP.VIEWER.PT.INTO.GLOBAL 416414 . 417520) (VIEWER.TO.SKETCH.POSITION 417522 . 418157) (
|
||||
SK.INSURE.SCALE 418159 . 418419) (SKETCH.TO.VIEWER.REGION 418421 . 419227) (VIEWER.TO.SKETCH.REGION
|
||||
419229 . 419567) (SK.READ.POINT.WITH.FEEDBACK 419569 . 430572) (SKETCH.GET.POSITION 430574 . 432454) (
|
||||
\CLOBBER.POSITION 432456 . 432904) (NEAREST.HOT.SPOT 432906 . 434434) (GETWREGION 434436 . 435197) (
|
||||
GET.BITMAP.POSITION 435199 . 435983) (SK.TRACK.BITMAP1 435985 . 443524)) (444095 474981 (
|
||||
SK.BRING.UP.POSITION.PAD 444105 . 449965) (SK.PAD.READER.POSITION 449967 . 451616) (
|
||||
SK.POSITION.READER.REPAINTFN 451618 . 453402) (SK.POSITION.PAD.FROM.VIEWER 453404 . 454746) (
|
||||
SK.INIT.POSITION.NUMBER.PAD.MENU 454748 . 455098) (SK.READ.POSITION.PAD.HANDLER 455100 . 460832) (
|
||||
DISPLAY.POSITION.READER.TOTAL 460834 . 463132) (POSITION.PAD.READER.HANDLER 463134 . 471177) (
|
||||
POSITIONPAD.HELDFN 471179 . 472663) (\POSITION.PAD.ADD.DIGIT.MENU 472665 . 474244) (
|
||||
\POSITION.READER.NUMBERPAD 474246 . 474979)) (476607 479285 (SK.DRAWFN 476617 . 476983) (
|
||||
SK.TRANSFORMFN 476985 . 477366) (SK.EXPANDFN 477368 . 477645) (SK.INPUT 477647 . 478028) (SK.INSIDEFN
|
||||
478030 . 478670) (SK.UPDATEFN 478672 . 479283)) (484857 488802 (SK.CHECK.SKETCH.VERSION 484867 .
|
||||
486107) (SK.INSURE.RECORD.LENGTH 486109 . 487592) (SK.INSURE.HAS.LENGTH 487594 . 488332) (
|
||||
SK.RECORD.LENGTH 488334 . 488508) (SK.SET.RECORD.LENGTHS 488510 . 488800)) (489543 490430 (
|
||||
SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 489553 . 490428)))))
|
||||
(FILEMAP (NIL (22128 85491 (SKETCH 22138 . 24243) (SKETCH.FROM.A.FILE 24245 . 24560) (SKETCHW.CREATE
|
||||
24562 . 29136) (SKETCH.RESET 29138 . 30660) (SKETCHW.FIG.CHANGED 30662 . 31002) (SK.WINDOW.TITLE 31004
|
||||
. 31391) (EDITSLIDE 31393 . 31799) (EDITSKETCH 31801 . 32125) (SK.PUT.ON.FILE 32127 . 33579) (
|
||||
SK.OUTPUT.FILE.NAME 33581 . 33955) (SKETCH.PUT 33957 . 36855) (SK.GET.FROM.FILE 36857 . 37750) (
|
||||
SK.INCLUDE.FILE 37752 . 40260) (SK.GET.IMAGEOBJ.FROM.FILE 40262 . 42465) (SKETCH.GET 42467 . 42774) (
|
||||
ADD.SKETCH.TO.VIEWER 42776 . 45362) (FILENAMELESSVERSION 45364 . 45640) (SK.ADD.ELEMENTS.TO.SKETCH
|
||||
45642 . 46156) (SKETCH.SET.A.DEFAULT 46158 . 53316) (SK.POPUP.SELECTIONFN 53318 . 53860) (
|
||||
GETSKETCHWREGION 53862 . 54068) (SK.ADD.ELEMENT 54070 . 55649) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH
|
||||
55651 . 57045) (SK.ELTS.BY.PRIORITY 57047 . 57343) (SK.ORDER.ELEMENTS 57345 . 57612) (
|
||||
SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57614 . 59108) (SK.ADD.ELEMENTS 59110 . 59634) (
|
||||
SK.CHECK.WHENADDEDFN 59636 . 60366) (SK.APPLY.MENU.COMMAND 60368 . 61166) (SK.DELETE.ELEMENT1 61168 .
|
||||
62746) (SK.MARK.DIRTY 62748 . 63414) (SK.MARK.UNDIRTY 63416 . 63747) (SK.MENU.AND.RETURN.FIELD 63749
|
||||
. 64414) (SKETCH.SET.BRUSH.SHAPE 64416 . 65001) (SKETCH.SET.BRUSH.SIZE 65003 . 65509) (
|
||||
SKETCHW.CLOSEFN 65511 . 67302) (SK.CONFIRM.DESTRUCTION 67304 . 68303) (SKETCHW.OUTFN 68305 . 68569) (
|
||||
SKETCHW.REOPENFN 68571 . 68983) (MAKE.LOCAL.SKETCH 68985 . 69715) (MAP.SKETCHSPEC.INTO.VIEWER 69717 .
|
||||
70927) (SKETCHW.REPAINTFN 70929 . 71757) (SKETCHW.REPAINTFN1 71759 . 72698) (SK.DRAWFIGURE.IF 72700 .
|
||||
73222) (SKETCHW.SCROLLFN 73224 . 77417) (SKETCHW.RESHAPEFN 77419 . 79677) (SK.UPDATE.EVENT.SELECTION
|
||||
79679 . 81734) (LIGHTGRAYWINDOW 81736 . 81899) (SK.ADD.SPACES 81901 . 82647) (SK.SKETCH.MENU 82649 .
|
||||
82971) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 82973 . 83825) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83827 . 84787)
|
||||
(SK.RETURN.TTY 84789 . 85157) (SK.TAKE.TTY 85159 . 85489)) (85545 108873 (SKETCH.COMMANDMENU 85555 .
|
||||
85892) (SKETCH.COMMANDMENU.ITEMS 85894 . 105977) (CREATE.SKETCHW.COMMANDMENU 105979 . 106399) (
|
||||
SKETCHW.SELECTIONFN 106401 . 107504) (SKETCH.MONITORLOCK 107506 . 107977) (SK.EVAL.AS.PROCESS 107979
|
||||
. 108592) (SK.EVAL.WITH.LOCK 108594 . 108871)) (108874 116678 (SK.FIX.MENU 108884 . 109978) (
|
||||
SK.SET.UP.MENUS 109980 . 112281) (SK.INSURE.HAS.MENU 112283 . 112945) (SK.CREATE.STANDARD.MENU 112947
|
||||
. 113392) (SK.ADD.ITEM.TO.MENU 113394 . 114069) (SK.GET.VIEWER.POPUP.MENU 114071 . 116272) (
|
||||
SK.CLEAR.POPUP.MENU 116274 . 116676)) (116734 125556 (SKETCH.CREATE 116744 . 117530) (GETSKETCHPROP
|
||||
117532 . 120589) (PUTSKETCHPROP 120591 . 124523) (CREATE.DEFAULT.SKETCH.CONTEXT 124525 . 125554)) (
|
||||
125722 148618 (SK.COPY.BUTTONEVENTFN 125732 . 136960) (SK.BUTTONEVENT.MARK 136962 . 137345) (
|
||||
SK.BUILD.IMAGEOBJ 137347 . 147262) (SK.BUTTONEVENT.OVERP 147264 . 147887) (SK.BUTTONEVENT.SAME.KEYS
|
||||
147889 . 148616)) (148897 174712 (SK.SEL.AND.CHANGE 148907 . 149199) (SK.CHECK.WHENCHANGEDFN 149201 .
|
||||
149907) (SK.CHECK.PRECHANGEFN 149909 . 150510) (SK.CHANGE.ELT 150512 . 150704) (SK.CHANGE.THING 150706
|
||||
. 151957) (SKETCH.CHANGE.ELEMENTS 151959 . 153142) (SK.APPLY.SINGLE.CHANGEFN 153144 . 153717) (
|
||||
SK.DO.CHANGESPECS 153719 . 155378) (SK.VIEWER.FROM.SKETCH.ARG 155380 . 155822) (SK.DO.CHANGESPEC1
|
||||
155824 . 157699) (SK.CHANGEFN 157701 . 158281) (SK.READCHANGEFN 158283 . 158742) (SK.DEFAULT.CHANGEFN
|
||||
158744 . 161216) (CHANGEABLEFIELDITEMS 161218 . 161865) (SK.APPLY.CHANGE.COMMAND 161867 . 162484) (
|
||||
SK.DO.AND.RECORD.CHANGES 162486 . 163883) (SK.APPLY.CHANGE.COMMAND1 163885 . 165373) (
|
||||
SK.ELEMENTS.CHANGEFN 165375 . 167699) (READ.POINT.TO.ADD 167701 . 168645) (GLOBAL.KNOT.FROM.LOCAL
|
||||
168647 . 169107) (SK.ADD.KNOT.TO.ELEMENT 169109 . 170053) (SK.GROUP.CHANGEFN 170055 . 171267) (
|
||||
SK.GROUP.CHANGEFN1 171269 . 174710)) (174879 188612 (ADD.ELEMENT.TO.SKETCH 174889 . 176595) (
|
||||
ADD.SKETCH.VIEWER 176597 . 177265) (REMOVE.SKETCH.VIEWER 177267 . 177880) (ALL.SKETCH.VIEWERS 177882
|
||||
. 178122) (SKETCH.ALL.VIEWERS 178124 . 178384) (VIEWER.BUCKET 178386 . 178537) (ELT.INSIDE.REGION?
|
||||
178539 . 178866) (ELT.INSIDE.SKWP 178868 . 179159) (SCALE.FROM.SKW 179161 . 179411) (
|
||||
SK.ADDELT.TO.WINDOW 179413 . 180273) (SK.CALC.REGION.VIEWED 180275 . 180653) (SK.DRAWFIGURE 180655 .
|
||||
181944) (SK.DRAWFIGURE1 181946 . 182330) (SK.LOCAL.FROM.GLOBAL 182332 . 183567) (SKETCH.REGION.VIEWED
|
||||
183569 . 186256) (SKETCH.VIEW.FROM.NAME 186258 . 186688) (SK.UPDATE.REGION.VIEWED 186690 . 187082) (
|
||||
SKETCH.ADD.AND.DISPLAY 187084 . 187492) (SKETCH.ADD.AND.DISPLAY1 187494 . 187932) (SK.ADD.ITEM 187934
|
||||
. 188266) (SKETCHW.ADD.INSTANCE 188268 . 188610)) (188653 201841 (SK.SEL.AND.DELETE 188663 . 189051)
|
||||
(SK.ERASE.AND.DELETE.ITEM 189053 . 189472) (REMOVE.ELEMENT.FROM.SKETCH 189474 . 190585) (
|
||||
SK.DELETE.ELEMENT 190587 . 191145) (SK.DELETE.ELEMENT2 191147 . 191808) (SK.DELETE.KNOT 191810 .
|
||||
192101) (SK.SEL.AND.DELETE.KNOT 192103 . 193228) (SK.DELETE.ELEMENT.KNOT 193230 . 196437) (
|
||||
SK.CHECK.WHENDELETEDFN 196439 . 197219) (SK.CHECK.PREEDITFN 197221 . 197705) (
|
||||
SK.CHECK.END.INITIAL.EDIT 197707 . 198241) (SK.CHECK.WHENPOINTDELETEDFN 198243 . 199039) (SK.ERASE.ELT
|
||||
199041 . 199377) (SK.DELETE.ELT 199379 . 199754) (SK.DELETE.ITEM 199756 . 200164) (DELFROMTCONC
|
||||
200166 . 201839)) (201880 215714 (SK.COPY.ELT 201890 . 202260) (SK.SEL.AND.COPY 202262 . 202645) (
|
||||
SK.COPY.ELEMENTS 202647 . 208275) (SK.ADD.COPY.OF.ELEMENTS 208277 . 210044) (
|
||||
SK.GLOBAL.FROM.LOCAL.ELEMENTS 210046 . 210286) (SK.COPY.ITEM 210288 . 211085) (SK.INSERT.SKETCH 211087
|
||||
. 215712)) (215754 245775 (SK.MOVE.ELT 215764 . 216039) (SK.MOVE.ELT.OR.PT 216041 . 216354) (
|
||||
SK.APPLY.DEFAULT.MOVE 216356 . 216790) (SK.SEL.AND.MOVE 216792 . 217339) (SK.MOVE.ELEMENTS 217341 .
|
||||
228213) (SKETCH.MOVE.ELEMENTS 228215 . 230146) (SKETCH.COPY.ELEMENTS 230148 . 232195) (
|
||||
\SKETCH.COPY.ELEMENT 232197 . 232922) (SK.TRANSLATE.ELEMENT 232924 . 233407) (SK.COPY.GLOBAL.ELEMENT
|
||||
233409 . 233620) (SK.MAKE.ELEMENT.MOVE.ARG 233622 . 234242) (SK.MAKE.ELEMENTS.MOVE.ARG 234244 . 234766
|
||||
) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234768 . 235837) (SK.SHOW.FIG.FROM.INFO 235839 . 236207) (
|
||||
SK.MOVE.THING 236209 . 237115) (UPDATE.ELEMENT.IN.SKETCH 237117 . 239172) (SK.UPDATE.ELEMENT 239174 .
|
||||
240733) (SK.UPDATE.ELEMENTS 240735 . 241454) (SK.UPDATE.ELEMENT1 241456 . 245356) (
|
||||
SK.MOVE.ELEMENT.POINT 245358 . 245773)) (245838 268127 (SK.MOVE.POINTS 245848 . 246135) (
|
||||
SK.SEL.AND.MOVE.POINTS 246137 . 246442) (SK.DO.MOVE.ELEMENT.POINTS 246444 . 255101) (
|
||||
SK.MOVE.ITEM.POINTS 255103 . 256774) (SK.TRANSLATEPTSFN 256776 . 257160) (SK.TRANSLATE.POINTS 257162
|
||||
. 258063) (SK.SELECT.MULTIPLE.POINTS 258065 . 263705) (SK.CONTROL.POINTS.IN.REGION 263707 . 265128) (
|
||||
SK.ADD.PT.SELECTION 265130 . 265594) (SK.REMOVE.PT.SELECTION 265596 . 266213) (SK.ADD.POINT 266215 .
|
||||
266838) (SK.ELTS.CONTAINING.PTS 266840 . 267465) (SK.HOTSPOTS.NOT.ON.LIST 267467 . 268125)) (268285
|
||||
271081 (SK.SET.MOVE.MODE 268295 . 268966) (SK.SET.MOVE.MODE.POINTS 268968 . 269307) (
|
||||
SK.SET.MOVE.MODE.ELEMENTS 269309 . 269653) (SK.SET.MOVE.MODE.COMBINED 269655 . 270005) (READMOVEMODE
|
||||
270007 . 271079)) (271082 289837 (SK.ALIGN.POINTS 271092 . 271382) (SK.SEL.AND.ALIGN.POINTS 271384 .
|
||||
271693) (SK.ALIGN.POINTS.LEFT 271695 . 271998) (SK.ALIGN.POINTS.RIGHT 272000 . 272305) (
|
||||
SK.ALIGN.POINTS.TOP 272307 . 272608) (SK.ALIGN.POINTS.BOTTOM 272610 . 272917) (
|
||||
SK.EVEN.SPACE.POINTS.IN.X 272919 . 273239) (SK.EVEN.SPACE.POINTS.IN.Y 273241 . 273561) (
|
||||
SK.DO.ALIGN.POINTS 273563 . 284185) (SK.NTH.CONTROL.POINT 284187 . 284648) (
|
||||
SK.GET.SELECTED.ELEMENT.STRUCTURE 284650 . 285316) (SK.CORRESPONDING.CONTROL.PT 285318 . 285872) (
|
||||
SK.CONTROL.POINT.NUMBER 285874 . 286244) (SK.DO.ALIGN.SETVALUE 286246 . 289835)) (289901 303333 (
|
||||
SKETCH.CREATE.GROUP 289911 . 290400) (SK.CREATE.GROUP1 290402 . 290949) (SK.UPDATE.GROUP.AFTER.CHANGE
|
||||
290951 . 291740) (SK.GROUP.ELTS 291742 . 292023) (SK.SEL.AND.GROUP 292025 . 292411) (SK.GROUP.ELEMENTS
|
||||
292413 . 294062) (SK.UNGROUP.ELT 294064 . 294348) (SK.SEL.AND.UNGROUP 294350 . 296019) (
|
||||
SK.UNGROUP.ELEMENT 296021 . 296957) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 296959 . 297881) (
|
||||
SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297883 . 298894) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298896 .
|
||||
300236) (SK.UNIONREGIONS 300238 . 302604) (SKETCH.REGION.OF.SKETCH 302606 . 303022) (SK.FLASHREGION
|
||||
303024 . 303331)) (303334 316805 (INIT.GROUP.ELEMENT 303344 . 304216) (GROUP.DRAWFN 304218 . 304668) (
|
||||
GROUP.EXPANDFN 304670 . 306233) (GROUP.INSIDEFN 306235 . 306644) (GROUP.REGIONFN 306646 . 307041) (
|
||||
GROUP.GLOBALREGIONFN 307043 . 307361) (GROUP.TRANSLATEFN 307363 . 309395) (GROUP.TRANSFORMFN 309397 .
|
||||
312877) (GROUP.READCHANGEFN 312879 . 316803)) (316806 317814 (REGION.CENTER 316816 . 317417) (
|
||||
REMOVE.LAST 317419 . 317812)) (317867 322974 (SK.MOVE.GROUP.CONTROL.PT 317877 . 318168) (
|
||||
SK.SEL.AND.MOVE.CONTROL.PT 318170 . 319574) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319576 . 321649) (
|
||||
SK.READ.NEW.GROUP.CONTROL.PT 321651 . 322972)) (323233 327857 (SK.DO.GROUP 323243 . 324695) (
|
||||
SK.CHECK.WHENGROUPEDFN 324697 . 325407) (SK.DO.UNGROUP 325409 . 326614) (SK.CHECK.WHENUNGROUPEDFN
|
||||
326616 . 327203) (SK.GROUP.UNDO 327205 . 327528) (SK.UNGROUP.UNDO 327530 . 327855)) (328098 333020 (
|
||||
SK.FREEZE.ELTS 328108 . 328392) (SK.SEL.AND.FREEZE 328394 . 328784) (SK.FREEZE.ELEMENTS 328786 .
|
||||
329337) (SK.UNFREEZE.ELT 329339 . 329628) (SK.SEL.AND.UNFREEZE 329630 . 331166) (SK.UNFREEZE.ELEMENTS
|
||||
331168 . 331727) (SK.FREEZE.UNDO 331729 . 331974) (SK.UNFREEZE.UNDO 331976 . 332223) (SK.DO.FREEZE
|
||||
332225 . 332618) (SK.DO.UNFREEZE 332620 . 333018)) (333250 343060 (SKETCH.ELEMENTS.OF.SKETCH 333260 .
|
||||
334095) (SKETCH.LIST.OF.ELEMENTS 334097 . 334815) (SKETCH.ADD.ELEMENT 334817 . 335892) (
|
||||
SKETCH.DELETE.ELEMENT 335894 . 337626) (DELFROMGROUPELT 337628 . 338428) (SKETCH.ELEMENT.TYPE 338430
|
||||
. 338779) (SKETCH.ELEMENT.CHANGED 338781 . 340349) (SK.ELEMENT.CHANGED1 340351 . 341002) (
|
||||
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 341004 . 343058)) (343114 347726 (INSURE.SKETCH 343124 . 345739)
|
||||
(LOCALSPECS.FROM.VIEWER 345741 . 346101) (SK.LOCAL.ELT.FROM.GLOBALPART 346103 . 346571) (
|
||||
SKETCH.FROM.VIEWER 346573 . 346807) (INSPECT.SKETCH 346809 . 347134) (ELT.INSIDE.SKETCHWP 347136 .
|
||||
347409) (SK.INSIDE.REGION 347411 . 347724)) (347727 352057 (MAPSKETCHSPECS 347737 . 348358) (
|
||||
MAPCOLLECTSKETCHSPECS 348360 . 349109) (MAPSKETCHSPECSUNTIL 349111 . 349919) (MAPGLOBALSKETCHSPECS
|
||||
349921 . 350622) (MAPGLOBALSKETCHELEMENTS 350624 . 352055)) (352119 378011 (SK.ADD.SELECTION 352129 .
|
||||
352869) (SK.COPY.INSERTFN 352871 . 356502) (SCREENELEMENTP 356504 . 356977) (SK.ITEM.REGION 356979 .
|
||||
357466) (SK.ELEMENT.GLOBAL.REGION 357468 . 357996) (SK.LOCAL.ITEMS.IN.REGION 357998 . 359977) (
|
||||
SK.REGIONFN 359979 . 360301) (SK.GLOBAL.REGIONFN 360303 . 360661) (SK.REMOVE.SELECTION 360663 . 361391
|
||||
) (SK.SELECT.MULTIPLE.ITEMS 361393 . 371835) (SKETCH.GET.ELEMENTS 371837 . 373260) (SK.PUT.MARKS.UP
|
||||
373262 . 373601) (SK.TAKE.MARKS.DOWN 373603 . 373942) (SK.TRANSLATE.GLOBALPART 373944 . 376071) (
|
||||
SK.TRANSLATE.ITEM 376073 . 377000) (SK.TRANSLATEFN 377002 . 377198) (TRANSLATE.SKETCH 377200 . 378009)
|
||||
) (378277 381184 (SK.INPUT.SCALE 378287 . 379134) (SK.UPDATE.SKETCHCONTEXT 379136 . 379733) (
|
||||
SK.SET.INPUT.SCALE 379735 . 380384) (SK.SET.INPUT.SCALE.CURRENT 380386 . 380677) (
|
||||
SK.SET.INPUT.SCALE.VALUE 380679 . 381182)) (381235 383147 (SK.SET.FEEDBACK.MODE 381245 . 382551) (
|
||||
SK.SET.FEEDBACK.POINT 382553 . 382721) (SK.SET.FEEDBACK.VERBOSE 382723 . 382892) (
|
||||
SK.SET.FEEDBACK.ALWAYS 382894 . 383145)) (383298 384575 (SKETCH.TITLE 383308 . 383571) (
|
||||
SK.SHRINK.ICONCREATE 383573 . 384573)) (390265 393079 (READBRUSHSHAPE 390275 . 390734) (READ.FUNCTION
|
||||
390736 . 391251) (READBRUSHSIZE 391253 . 391711) (READANGLE 391713 . 392205) (READARCDIRECTION 392207
|
||||
. 393077)) (393080 403491 (SK.CHANGE.DASHING 393090 . 397038) (READ.AND.SAVE.NEW.DASHING 397040 .
|
||||
398808) (READ.NEW.DASHING 398810 . 400550) (READ.DASHING.CHANGE 400552 . 402027) (SK.CACHE.DASHING
|
||||
402029 . 403031) (SK.DASHING.LABEL 403033 . 403489)) (403492 407197 (READ.FILLING.CHANGE 403502 .
|
||||
405483) (SK.CACHE.FILLING 405485 . 406203) (READ.AND.SAVE.NEW.FILLING 406205 . 406803) (
|
||||
SK.FILLING.LABEL 406805 . 407195)) (407581 443834 (SK.GETGLOBALPOSITION 407591 . 407896) (
|
||||
SKETCH.TRACK.ELEMENTS 407898 . 411418) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411420 . 411979) (
|
||||
MAP.SKETCH.ELEMENTS.INTO.VIEWER 411981 . 412373) (MAP.GLOBAL.POSITION.INTO.VIEWER 412375 . 412755) (
|
||||
SKETCH.TO.VIEWER.POSITION 412757 . 413116) (SKETCH.TRACK.IMAGE 413118 . 413972) (SK.TRACK.IMAGE1
|
||||
413974 . 415386) (MAP.VIEWER.XY.INTO.GLOBAL 415388 . 416382) (SK.SET.POSITION 416384 . 416720) (
|
||||
MAP.VIEWER.PT.INTO.GLOBAL 416722 . 417828) (VIEWER.TO.SKETCH.POSITION 417830 . 418465) (
|
||||
SK.INSURE.SCALE 418467 . 418727) (SKETCH.TO.VIEWER.REGION 418729 . 419535) (VIEWER.TO.SKETCH.REGION
|
||||
419537 . 419875) (SK.READ.POINT.WITH.FEEDBACK 419877 . 430880) (SKETCH.GET.POSITION 430882 . 432762) (
|
||||
\CLOBBER.POSITION 432764 . 433212) (NEAREST.HOT.SPOT 433214 . 434742) (GETWREGION 434744 . 435505) (
|
||||
GET.BITMAP.POSITION 435507 . 436291) (SK.TRACK.BITMAP1 436293 . 443832)) (444403 475289 (
|
||||
SK.BRING.UP.POSITION.PAD 444413 . 450273) (SK.PAD.READER.POSITION 450275 . 451924) (
|
||||
SK.POSITION.READER.REPAINTFN 451926 . 453710) (SK.POSITION.PAD.FROM.VIEWER 453712 . 455054) (
|
||||
SK.INIT.POSITION.NUMBER.PAD.MENU 455056 . 455406) (SK.READ.POSITION.PAD.HANDLER 455408 . 461140) (
|
||||
DISPLAY.POSITION.READER.TOTAL 461142 . 463440) (POSITION.PAD.READER.HANDLER 463442 . 471485) (
|
||||
POSITIONPAD.HELDFN 471487 . 472971) (\POSITION.PAD.ADD.DIGIT.MENU 472973 . 474552) (
|
||||
\POSITION.READER.NUMBERPAD 474554 . 475287)) (476915 479593 (SK.DRAWFN 476925 . 477291) (
|
||||
SK.TRANSFORMFN 477293 . 477674) (SK.EXPANDFN 477676 . 477953) (SK.INPUT 477955 . 478336) (SK.INSIDEFN
|
||||
478338 . 478978) (SK.UPDATEFN 478980 . 479591)) (485165 489110 (SK.CHECK.SKETCH.VERSION 485175 .
|
||||
486415) (SK.INSURE.RECORD.LENGTH 486417 . 487900) (SK.INSURE.HAS.LENGTH 487902 . 488640) (
|
||||
SK.RECORD.LENGTH 488642 . 488816) (SK.SET.RECORD.LENGTHS 488818 . 489108)) (489851 490738 (
|
||||
SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 489861 . 490736)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,9 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "21-Aug-2021 20:49:42" {DSK}<home>larry>medley>library>SKETCHELEMENTS.;2 554230
|
||||
|
||||
changes to%: (FNS \SK.PUT.ARROWHEADS)
|
||||
(FILECREATED " 4-Aug-2022 09:57:43" {DSK}<home>larry>medley>library>SKETCHELEMENTS.;2 554099
|
||||
|
||||
previous date%: "31-Dec-2000 10:58:28" {DSK}<home>larry>medley>library>SKETCHELEMENTS.;1)
|
||||
:CHANGES-TO (FNS CREATE.SKETCH.ELEMENT.TYPE)
|
||||
|
||||
:PREVIOUS-DATE "21-Aug-2021 20:49:42" {DSK}<home>larry>medley>library>SKETCHELEMENTS.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -14,7 +15,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(RPAQQ SKETCHELEMENTSCOMS
|
||||
( (* ;
|
||||
"contains the functions need to implement the sketch basic element types")
|
||||
"contains the functions need to implement the sketch basic element types")
|
||||
(FNS INIT.SKETCH.ELEMENTS CREATE.SKETCH.ELEMENT.TYPE SKETCH.ELEMENT.TYPEP
|
||||
SKETCH.ELEMENT.NAMEP \CURSOR.IN.MIDDLE.MENU)
|
||||
(COMS (* ; "color and filling stuff")
|
||||
@@ -43,9 +44,9 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(CURSORS CIRCLE.CENTER CIRCLE.EDGE)
|
||||
(INITVARS [SK.DEFAULT.BRUSH (CONS 'ROUND (CONS 1 (CONS 'BLACK NIL]
|
||||
(* ;
|
||||
"Original was (create BRUSH BRUSHSHAPE _ 'ROUND BRUSHSIZE _ 1 BRUSHCOLOR _ 'BLACK).")
|
||||
"Original was (create BRUSH BRUSHSHAPE _ 'ROUND BRUSHSIZE _ 1 BRUSHCOLOR _ 'BLACK).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
(SK.DEFAULT.DASHING)
|
||||
(SK.DEFAULT.TEXTURE))
|
||||
(GLOBALVARS SK.DEFAULT.BRUSH SK.DEFAULT.DASHING SK.DEFAULT.TEXTURE))
|
||||
@@ -113,7 +114,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(INITVARS (SK.ARROW.END.MENU)
|
||||
(SK.ARROW.EDIT.MENU)))
|
||||
(COMS (* ;
|
||||
"stuff to support the text element type.")
|
||||
"stuff to support the text element type.")
|
||||
(FNS SKETCH.CREATE.TEXT TEXT.CHANGEFN TEXT.READCHANGEFN \SK.READ.FONT.SIZE1
|
||||
SK.TEXT.ELT.WITH.SAME.FIELDS SK.READFONTFAMILY CLOSE.PROMPT.WINDOW TEXT.DRAWFN
|
||||
TEXT.DRAWFN1 TEXT.INSIDEFN TEXT.EXPANDFN SK.TEXT.LINE.REGIONS
|
||||
@@ -142,7 +143,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(GLOBALVARS SKETCH.TERMTABLE SK.DEFAULT.TEXT.ALIGNMENT INDICATE.TEXT.SHADE \FONTSONFILE
|
||||
SK.HORIZONTAL.STYLES SK.VERTICAL.STYLES))
|
||||
(COMS (* ;
|
||||
"stuff for supporting the TEXTBOX sketch element.")
|
||||
"stuff for supporting the TEXTBOX sketch element.")
|
||||
(FNS SKETCH.CREATE.TEXTBOX SK.COMPUTE.TEXTBOX.REGION.FOR.STRING SK.BREAK.INTO.LINES
|
||||
SK.BRUSH.SIZE SK.TEXTBOX.CREATE SK.TEXTBOX.CREATE1 SK.UPDATE.TEXTBOX.AFTER.CHANGE
|
||||
SK.TEXTBOX.POSITION.IN.BOX TEXTBOX.CHANGEFN TEXTBOX.DRAWFN
|
||||
@@ -153,13 +154,13 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
SK.TEXTBOX.FROM.TEXT ADD.EOLS)
|
||||
(DECLARE%: DONTCOPY (RECORDS LOCALTEXTBOX TEXTBOX))
|
||||
(COMS (* ;
|
||||
"stuff to handle default alignment for text boxes")
|
||||
"stuff to handle default alignment for text boxes")
|
||||
(FNS SK.SET.TEXTBOX.VERT.ALIGN SK.SET.TEXTBOX.HORIZ.ALIGN)
|
||||
(VARS TEXTBOXICON)
|
||||
[INITVARS (SK.DEFAULT.TEXTBOX.ALIGNMENT '(CENTER CENTER]
|
||||
(GLOBALVARS SK.DEFAULT.TEXTBOX.ALIGNMENT)))
|
||||
(COMS (* ;
|
||||
"functions to implement the box sketch element.")
|
||||
"functions to implement the box sketch element.")
|
||||
(FNS SKETCH.CREATE.BOX SK.BOX.DRAWFN BOX.DRAWFN1 KNOTS.OF.REGION SK.DRAWAREABOX
|
||||
SK.DRAWBOX SK.BOX.EXPANDFN SK.BOX.GETREGIONFN BOX.SET.SCALES SK.BOX.INPUTFN
|
||||
SK.BOX.CREATE SK.UPDATE.BOX.AFTER.CHANGE SK.BOX.INSIDEFN SK.BOX.REGIONFN
|
||||
@@ -170,7 +171,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DONTCOPY (RECORDS BOX LOCALBOX))
|
||||
(UGLYVARS BOXICON))
|
||||
(COMS (* ;
|
||||
"fns for the arc sketch element type")
|
||||
"fns for the arc sketch element type")
|
||||
(FNS SKETCH.CREATE.ARC ARC.DRAWFN ARC.EXPANDFN ARC.INPUTFN SK.INVERT.CIRCLE
|
||||
SK.READ.ARC.ANGLE.POINT SK.SHOW.ARC ARC.CREATE SK.UPDATE.ARC.AFTER.CHANGE
|
||||
ARC.MOVEFN ARC.TRANSLATEPTS ARC.INSIDEFN ARC.REGIONFN ARC.GLOBALREGIONFN
|
||||
@@ -185,7 +186,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(CURSORS ARC.RADIUS.CURSOR ARC.ANGLE.CURSOR CW.ARC.ANGLE.CURSOR CW.ARC.RADIUS.CURSOR)
|
||||
(UGLYVARS ARCICON))
|
||||
(COMS (* ;
|
||||
"property getting and setting stuff")
|
||||
"property getting and setting stuff")
|
||||
(FNS GETSKETCHELEMENTPROP \SK.GET.ARC.ANGLEPT \GETSKETCHELEMENTPROP1 \SK.GET.BRUSH
|
||||
\SK.GET.FILLING \SK.GET.ARROWHEADS \SK.GET.FONT \SK.GET.JUSTIFICATION
|
||||
\SK.GET.DIRECTION \SK.GET.DASHING PUTSKETCHELEMENTPROP \SK.PUT.FILLING
|
||||
@@ -375,7 +376,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(CREATE.SKETCH.ELEMENT.TYPE
|
||||
[LAMBDA (SKETCHTYPE LABEL DOCSTR DRAWFN EXPANDFN OBSOLETE CHANGEFN INPUTFN INSIDEFN REGIONFN
|
||||
TRANSLATEFN UPDATEFN READCHANGEFN TRANSFORMFN TRANSLATEPTSFN GLOBALREGIONFN)
|
||||
TRANSLATEFN UPDATEFN READCHANGEFN TRANSFORMFN TRANSLATEPTSFN GLOBALREGIONFN)
|
||||
(* rrb "18-Oct-85 17:18")
|
||||
(* creates a new sketch element type.)
|
||||
(COND
|
||||
@@ -1124,17 +1125,16 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD BRUSH (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR)
|
||||
BRUSHSHAPE _ 'ROUND BRUSHSIZE _ 1)
|
||||
BRUSHSHAPE _ 'ROUND BRUSHSIZE _ 1)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD LOCALCIRCLE ((CENTERPOSITION RADIUSPOSITION)
|
||||
LOCALHOTREGION RADIUS LOCALCIRCLEBRUSH LOCALCIRCLEFILLING LOCALCIRCLEDASHING
|
||||
))
|
||||
LOCALHOTREGION RADIUS LOCALCIRCLEBRUSH LOCALCIRCLEFILLING LOCALCIRCLEDASHING))
|
||||
|
||||
(TYPERECORD CIRCLE (CENTERLATLON RADIUSLATLON BRUSH DASHING CIRCLEINITSCALE CIRCLEFILLING
|
||||
CIRCLEREGION))
|
||||
CIRCLEREGION))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -1645,11 +1645,11 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD LOCALELLIPSE ((ELLIPSECENTER MINORRADIUSPOSITION MAJORRADIUSPOSITION)
|
||||
LOCALHOTREGION SEMIMINORRADIUS SEMIMAJORRADIUS LOCALELLIPSEBRUSH
|
||||
LOCALELLIPSEDASHING LOCALELLIPSEFILLING))
|
||||
LOCALHOTREGION SEMIMINORRADIUS SEMIMAJORRADIUS LOCALELLIPSEBRUSH
|
||||
LOCALELLIPSEDASHING LOCALELLIPSEFILLING))
|
||||
|
||||
(TYPERECORD ELLIPSE (ELLIPSECENTERLATLON SEMIMINORLATLON SEMIMAJORLATLON ORIENTATION BRUSH
|
||||
DASHING ELLIPSEINITSCALE ELLIPSEFILLING ELLIPSEREGION))
|
||||
(TYPERECORD ELLIPSE (ELLIPSECENTERLATLON SEMIMINORLATLON SEMIMAJORLATLON ORIENTATION BRUSH DASHING
|
||||
ELLIPSEINITSCALE ELLIPSEFILLING ELLIPSEREGION))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2710,14 +2710,14 @@ Click outside the window to stop.")
|
||||
|
||||
(RECORD LOCALCURVE (KNOTS LOCALHOTREGION ARROWHEADPTS LOCALCURVEBRUSH LOCALCURVEDASHING))
|
||||
|
||||
(TYPERECORD OPENCURVE (LATLONKNOTS BRUSH DASHING CURVEARROWHEADS OPENCURVEINITSCALE
|
||||
OPENCURVEREGION OPENCURVEARROWHEADPOINTS))
|
||||
(TYPERECORD OPENCURVE (LATLONKNOTS BRUSH DASHING CURVEARROWHEADS OPENCURVEINITSCALE OPENCURVEREGION
|
||||
OPENCURVEARROWHEADPOINTS))
|
||||
|
||||
(TYPERECORD CLOSEDCURVE (LATLONKNOTS BRUSH DASHING CLOSEDCURVEINITSCALE CLOSEDCURVEFILLING
|
||||
CLOSEDCURVEREGION))
|
||||
CLOSEDCURVEREGION))
|
||||
|
||||
(RECORD LOCALCLOSEDCURVE (LOCALCLOSEDCURVEKNOTS LOCALCLOSEDCURVEHOTREGION LOCALCLOSEDCURVEBRUSH
|
||||
LOCALCLOSEDCURVEFILLING LOCALCLOSEDCURVEDASHING))
|
||||
LOCALCLOSEDCURVEFILLING LOCALCLOSEDCURVEDASHING))
|
||||
|
||||
(RECORD LOCALCLOSEDWIRE (KNOTS LOCALHOTREGION LOCALCLOSEDWIREBRUSH LOCALCLOSEDWIREFILLING))
|
||||
)
|
||||
@@ -4311,11 +4311,11 @@ Click outside the window to stop.")
|
||||
|
||||
(RECORD LOCALWIRE (KNOTS LOCALHOTREGION ARROWHEADPTS LOCALOPENWIREBRUSH LOCALWIREDASHING))
|
||||
|
||||
(TYPERECORD WIRE (LATLONKNOTS BRUSH WIREARROWHEADS OPENWIREDASHING OPENWIREINITSCALE
|
||||
OPENWIREREGION OPENWIREARROWHEADPOINTS))
|
||||
(TYPERECORD WIRE (LATLONKNOTS BRUSH WIREARROWHEADS OPENWIREDASHING OPENWIREINITSCALE OPENWIREREGION
|
||||
OPENWIREARROWHEADPOINTS))
|
||||
|
||||
(TYPERECORD CLOSEDWIRE (LATLONKNOTS BRUSH CLOSEDWIREDASHING CLOSEDWIREINITSCALE CLOSEDWIREFILLING
|
||||
CLOSEDWIREREGION))
|
||||
(TYPERECORD CLOSEDWIRE (LATLONKNOTS BRUSH CLOSEDWIREDASHING CLOSEDWIREINITSCALE CLOSEDWIREFILLING
|
||||
CLOSEDWIREREGION))
|
||||
|
||||
(RECORD LOCALCLOSEDWIRE (KNOTS LOCALHOTREGION LOCALCLOSEDWIREBRUSH LOCALCLOSEDWIREFILLING))
|
||||
)
|
||||
@@ -5743,11 +5743,11 @@ Click outside the window to stop.")
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(TYPERECORD TEXT (LOCATIONLATLON LISTOFCHARACTERS INITIALSCALE TEXTSTYLE FONT LISTOFREGIONS
|
||||
TEXTCOLOR))
|
||||
(TYPERECORD TEXT (LOCATIONLATLON LISTOFCHARACTERS INITIALSCALE TEXTSTYLE FONT LISTOFREGIONS TEXTCOLOR
|
||||
))
|
||||
|
||||
(RECORD LOCALTEXT ((DISPLAYPOSITION)
|
||||
LOCALHOTREGION LINEREGIONS LOCALFONT LOCALLISTOFCHARACTERS))
|
||||
LOCALHOTREGION LINEREGIONS LOCALFONT LOCALLISTOFCHARACTERS))
|
||||
)
|
||||
)
|
||||
(DEFINEQ
|
||||
@@ -6985,12 +6985,11 @@ No more font sizes found.")))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD LOCALTEXTBOX ((TEXTBOXLL TEXTBOXUR)
|
||||
LOCALHOTREGION LINEREGIONS LOCALFONT LOCALLISTOFCHARACTERS
|
||||
LOCALTEXTBOXREGION LOCALTEXTBOXBRUSH LOCALTEXTBOXFILLING
|
||||
LOCALTEXTBOXDASHING))
|
||||
LOCALHOTREGION LINEREGIONS LOCALFONT LOCALLISTOFCHARACTERS LOCALTEXTBOXREGION
|
||||
LOCALTEXTBOXBRUSH LOCALTEXTBOXFILLING LOCALTEXTBOXDASHING))
|
||||
|
||||
(TYPERECORD TEXTBOX (TEXTBOXREGION LISTOFCHARACTERS INITIALSCALE TEXTSTYLE FONT LISTOFREGIONS
|
||||
TEXTCOLOR TEXTBOXBRUSH TEXTBOXDASHING TEXTBOXFILLING))
|
||||
TEXTCOLOR TEXTBOXBRUSH TEXTBOXDASHING TEXTBOXFILLING))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -7822,7 +7821,7 @@ No more font sizes found.")))
|
||||
(TYPERECORD BOX (GLOBALREGION BRUSH BOXDASHING BOXINITSCALE BOXFILLING))
|
||||
|
||||
(RECORD LOCALBOX ((BOXLL BOXUR)
|
||||
LOCALHOTREGION LOCALREGION LOCALBOXBRUSH LOCALBOXFILLING LOCALBOXDASHING))
|
||||
LOCALHOTREGION LOCALREGION LOCALBOXBRUSH LOCALBOXFILLING LOCALBOXDASHING))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -8468,12 +8467,11 @@ No more font sizes found.")))
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(TYPERECORD ARC (ARCCENTERPT ARCRADIUSPT ARCBRUSH ARCDASHING ARCINITSCALE ARCARROWHEADS
|
||||
ARCANGLEPT ARCDIRECTION ARCREGION ARCARROWHEADPOINTS))
|
||||
(TYPERECORD ARC (ARCCENTERPT ARCRADIUSPT ARCBRUSH ARCDASHING ARCINITSCALE ARCARROWHEADS ARCANGLEPT
|
||||
ARCDIRECTION ARCREGION ARCARROWHEADPOINTS))
|
||||
|
||||
(RECORD LOCALARC ((LOCALARCCENTERPT LOCALARCRADIUSPT LOCALARCANGLEPT)
|
||||
LOCALHOTREGION LOCALARCARROWHEADPTS LOCALARCBRUSH LOCALARCKNOTS LOCALARCDASHING
|
||||
))
|
||||
LOCALHOTREGION LOCALARCARROWHEADPTS LOCALARCBRUSH LOCALARCKNOTS LOCALARCDASHING))
|
||||
)
|
||||
)
|
||||
(RPAQ ARC.RADIUS.CURSOR (CURSORCREATE (QUOTE #*(16 16)@@@L@@@D@@@F@@@B@@@C@@LA@@OA@@CMOOOO@@CL@@O@@@L@@@@@@@@@@@@@@@@@
|
||||
@@ -9284,137 +9282,137 @@ No more font sizes found.")))
|
||||
(PUTPROPS SKETCHELEMENTS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1991 1992 1993
|
||||
2000 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (14335 24749 (INIT.SKETCH.ELEMENTS 14345 . 21908) (CREATE.SKETCH.ELEMENT.TYPE 21910 .
|
||||
23436) (SKETCH.ELEMENT.TYPEP 23438 . 23826) (SKETCH.ELEMENT.NAMEP 23828 . 24091) (
|
||||
\CURSOR.IN.MIDDLE.MENU 24093 . 24747)) (24790 25467 (SKETCHINCOLORP 24800 . 25120) (READ.COLOR.CHANGE
|
||||
25122 . 25465)) (25976 28755 (SK.CREATE.DEFAULT.FILLING 25986 . 26287) (SKFILLINGP 26289 . 26922) (
|
||||
SK.INSURE.FILLING 26924 . 28352) (SK.INSURE.COLOR 28354 . 28753)) (28756 34366 (SK.TRANSLATE.MODE
|
||||
28766 . 29548) (SK.CHANGE.FILLING.MODE 29550 . 33133) (READ.FILLING.MODE 33135 . 34364)) (34367 65041
|
||||
(SKETCH.CREATE.CIRCLE 34377 . 35189) (CIRCLE.EXPANDFN 35191 . 38563) (CIRCLE.DRAWFN 38565 . 41566) (
|
||||
\CIRCLE.DRAWFN1 41568 . 44163) (CIRCLE.INPUTFN 44165 . 46014) (SK.UPDATE.CIRCLE.AFTER.CHANGE 46016 .
|
||||
46375) (SK.READ.CIRCLE.POINT 46377 . 46848) (SK.SHOW.CIRCLE 46850 . 47496) (CIRCLE.INSIDEFN 47498 .
|
||||
47763) (CIRCLE.REGIONFN 47765 . 49446) (CIRCLE.GLOBALREGIONFN 49448 . 50966) (CIRCLE.TRANSLATE 50968
|
||||
. 52829) (CIRCLE.READCHANGEFN 52831 . 57447) (CIRCLE.TRANSFORMFN 57449 . 59302) (CIRCLE.TRANSLATEPTS
|
||||
59304 . 60918) (SK.CIRCLE.CREATE 60920 . 61763) (SET.CIRCLE.SCALE 61765 . 62531) (SK.BRUSH.READCHANGE
|
||||
62533 . 65039)) (65042 65771 (SK.INSURE.BRUSH 65052 . 65446) (SK.INSURE.DASHING 65448 . 65769)) (67023
|
||||
96517 (SKETCH.CREATE.ELLIPSE 67033 . 67632) (ELLIPSE.EXPANDFN 67634 . 71246) (ELLIPSE.DRAWFN 71248 .
|
||||
75425) (ELLIPSE.INPUTFN 75427 . 77867) (SK.READ.ELLIPSE.MAJOR.PT 77869 . 78448) (
|
||||
SK.SHOW.ELLIPSE.MAJOR.RADIUS 78450 . 79205) (SK.READ.ELLIPSE.MINOR.PT 79207 . 79900) (
|
||||
SK.SHOW.ELLIPSE.MINOR.RADIUS 79902 . 80734) (ELLIPSE.INSIDEFN 80736 . 81006) (ELLIPSE.CREATE 81008 .
|
||||
82383) (SK.UPDATE.ELLIPSE.AFTER.CHANGE 82385 . 82753) (ELLIPSE.REGIONFN 82755 . 84955) (
|
||||
ELLIPSE.GLOBALREGIONFN 84957 . 86770) (ELLIPSE.TRANSLATEFN 86772 . 89318) (ELLIPSE.TRANSFORMFN 89320
|
||||
. 90597) (ELLIPSE.TRANSLATEPTS 90599 . 92640) (MARK.SPOT 92642 . 93893) (DISTANCEBETWEEN 93895 .
|
||||
94490) (SK.DISTANCE.TO 94492 . 94877) (SQUARE 94879 . 94921) (COMPUTE.ELLIPSE.ORIENTATION 94923 .
|
||||
95642) (SK.COMPUTE.ELLIPSE.MINOR.RADIUS.PT 95644 . 96515)) (97642 138698 (SKETCH.CREATE.OPEN.CURVE
|
||||
97652 . 98205) (OPENCURVE.INPUTFN 98207 . 99075) (SK.CURVE.CREATE 99077 . 100822) (MAXXEXTENT 100824
|
||||
. 101683) (MAXYEXTENT 101685 . 102545) (KNOT.SET.SCALE.FIELD 102547 . 103349) (OPENCURVE.DRAWFN
|
||||
103351 . 104482) (OPENCURVE.EXPANDFN 104484 . 107799) (OPENCURVE.READCHANGEFN 107801 . 111003) (
|
||||
OPENCURVE.TRANSFORMFN 111005 . 113503) (OPENCURVE.TRANSLATEFN 113505 . 113927) (
|
||||
OPENCURVE.TRANSLATEPTSFN 113929 . 115310) (SKETCH.CREATE.CLOSED.CURVE 115312 . 115818) (
|
||||
CLOSEDCURVE.DRAWFN 115820 . 116604) (CLOSEDCURVE.EXPANDFN 116606 . 119719) (CLOSEDCURVE.REGIONFN
|
||||
119721 . 120518) (CLOSEDCURVE.GLOBALREGIONFN 120520 . 121953) (READ.LIST.OF.POINTS 121955 . 123934) (
|
||||
CLOSEDCURVE.INPUTFN 123936 . 124581) (CLOSEDCURVE.READCHANGEFN 124583 . 127478) (
|
||||
CLOSEDCURVE.TRANSFORMFN 127480 . 129280) (CLOSEDCURVE.TRANSLATEPTSFN 129282 . 130627) (INVISIBLEPARTP
|
||||
130629 . 130982) (SHOWSKETCHPOINT 130984 . 131289) (SHOWSKETCHXY 131291 . 131809) (KNOTS.REGIONFN
|
||||
131811 . 132712) (OPENWIRE.GLOBALREGIONFN 132714 . 133578) (CURVE.REGIONFN 133580 . 134521) (
|
||||
OPENCURVE.GLOBALREGIONFN 134523 . 135930) (KNOTS.TRANSLATEFN 135932 . 136975) (REGION.CONTAINING.PTS
|
||||
136977 . 138696)) (138699 160975 (CHANGE.ELTS.BRUSH.SIZE 138709 . 139319) (CHANGE.ELTS.BRUSH 139321 .
|
||||
139838) (CHANGE.ELTS.BRUSH.SHAPE 139840 . 140241) (SK.CHANGE.BRUSH.SHAPE 140243 . 143755) (
|
||||
SK.CHANGE.BRUSH.COLOR 143757 . 148203) (SK.CHANGE.BRUSH.SIZE 148205 . 153163) (SK.CHANGE.ANGLE 153165
|
||||
. 156145) (SK.CHANGE.ARC.DIRECTION 156147 . 158526) (SK.SET.DEFAULT.BRUSH.SIZE 158528 . 159227) (
|
||||
READSIZECHANGE 159229 . 160973)) (160976 162595 (SK.CHANGE.ELEMENT.KNOTS 160986 . 162593)) (162596
|
||||
163243 (SK.INSURE.POINT.LIST 162606 . 163059) (SK.INSURE.POSITION 163061 . 163241)) (164623 196946 (
|
||||
SKETCH.CREATE.WIRE 164633 . 165123) (CLOSEDWIRE.EXPANDFN 165125 . 167813) (KNOTS.INSIDEFN 167815 .
|
||||
168536) (OPEN.WIRE.DRAWFN 168538 . 169130) (WIRE.EXPANDFN 169132 . 172379) (
|
||||
SK.UPDATE.WIRE.ELT.AFTER.CHANGE 172381 . 172902) (OPENWIRE.READCHANGEFN 172904 . 175397) (
|
||||
OPENWIRE.TRANSFORMFN 175399 . 177522) (OPENWIRE.TRANSLATEFN 177524 . 177948) (OPENWIRE.TRANSLATEPTSFN
|
||||
177950 . 179229) (WIRE.INPUTFN 179231 . 180862) (SK.READ.WIRE.POINTS 180864 . 181395) (
|
||||
SK.READ.POINTS.WITH.FEEDBACK 181397 . 184164) (OPENWIRE.FEEDBACKFN 184166 . 184920) (
|
||||
CLOSEDWIRE.FEEDBACKFN 184922 . 186278) (CLOSEDWIRE.REGIONFN 186280 . 187265) (
|
||||
CLOSEDWIRE.GLOBALREGIONFN 187267 . 188319) (SK.WIRE.CREATE 188321 . 190084) (WIRE.ADD.POINT.TO.END
|
||||
190086 . 191002) (READ.ARROW.CHANGE 191004 . 196480) (CHANGE.ELTS.ARROWHEADS 196482 . 196944)) (196947
|
||||
207953 (SKETCH.CREATE.CLOSED.WIRE 196957 . 197518) (CLOSED.WIRE.INPUTFN 197520 . 197875) (
|
||||
CLOSED.WIRE.DRAWFN 197877 . 199922) (CLOSEDWIRE.READCHANGEFN 199924 . 204829) (CLOSEDWIRE.TRANSFORMFN
|
||||
204831 . 206625) (CLOSEDWIRE.TRANSLATEPTSFN 206627 . 207951)) (207954 260660 (SK.EXPAND.ARROWHEADS
|
||||
207964 . 208314) (SK.COMPUTE.ARC.ARROWHEAD.POINTS 208316 . 209697) (ARC.ARROWHEAD.POINTS 209699 .
|
||||
210922) (SET.ARC.ARROWHEAD.POINTS 210924 . 211905) (SET.OPENCURVE.ARROWHEAD.POINTS 211907 . 212808) (
|
||||
SK.COMPUTE.CURVE.ARROWHEAD.POINTS 212810 . 214080) (SET.WIRE.ARROWHEAD.POINTS 214082 . 214835) (
|
||||
SK.COMPUTE.WIRE.ARROWHEAD.POINTS 214837 . 216102) (SK.EXPAND.ARROWHEAD 216104 . 217287) (CHANGED.ARROW
|
||||
217289 . 220461) (SK.CHANGE.ARROWHEAD 220463 . 220916) (SK.CHANGE.ARROWHEAD1 220918 . 226173) (
|
||||
SK.CREATE.ARROWHEAD 226175 . 226695) (SK.ARROWHEAD.CREATE 226697 . 228271) (SK.ARROWHEAD.END.TEST
|
||||
228273 . 229197) (READ.ARROWHEAD.END 229199 . 231224) (ARROW.HEAD.POSITIONS 231226 . 233066) (
|
||||
ARROWHEAD.POINTS.LIST 233068 . 237040) (CURVE.ARROWHEAD.POINTS 237042 . 237905) (LEFT.MOST.IS.BEGINP
|
||||
237907 . 238788) (WIRE.ARROWHEAD.POINTS 238790 . 240316) (DRAWARROWHEADS 240318 . 242688) (
|
||||
\SK.DRAW.TRIANGLE.ARROWHEAD 242690 . 244350) (\SK.ENDPT.OF.ARROW 244352 . 246609) (
|
||||
\SK.ADJUST.FOR.ARROWHEADS 246611 . 249116) (SK.SET.ARROWHEAD.LENGTH 249118 . 250262) (
|
||||
SK.SET.ARROWHEAD.ANGLE 250264 . 251360) (SK.SET.ARROWHEAD.TYPE 251362 . 254651) (SK.SET.LINE.ARROWHEAD
|
||||
254653 . 257066) (SK.UPDATE.ARROWHEAD.FORMAT 257068 . 259178) (SK.SET.LINE.LENGTH.MODE 259180 .
|
||||
260658)) (260661 262462 (SK.INSURE.ARROWHEADS 260671 . 261853) (SK.ARROWHEADP 261855 . 262460)) (
|
||||
265266 327592 (SKETCH.CREATE.TEXT 265276 . 265790) (TEXT.CHANGEFN 265792 . 266184) (TEXT.READCHANGEFN
|
||||
266186 . 274257) (\SK.READ.FONT.SIZE1 274259 . 276155) (SK.TEXT.ELT.WITH.SAME.FIELDS 276157 . 277797)
|
||||
(SK.READFONTFAMILY 277799 . 279345) (CLOSE.PROMPT.WINDOW 279347 . 279771) (TEXT.DRAWFN 279773 . 280494
|
||||
) (TEXT.DRAWFN1 280496 . 283998) (TEXT.INSIDEFN 284000 . 284389) (TEXT.EXPANDFN 284391 . 286516) (
|
||||
SK.TEXT.LINE.REGIONS 286518 . 288392) (TEXT.UPDATE.GLOBAL.REGIONS 288394 . 289626) (REL.MOVE.REGION
|
||||
289628 . 290165) (LTEXT.LINE.REGIONS 290167 . 293585) (TEXT.INPUTFN 293587 . 294097) (READ.TEXT 294099
|
||||
. 294847) (TEXT.POSITION.AND.CREATE 294849 . 297160) (CREATE.TEXT.ELEMENT 297162 . 297980) (
|
||||
SK.UPDATE.TEXT.AFTER.CHANGE 297982 . 298384) (SK.TEXT.FROM.TEXTBOX 298386 . 302192) (
|
||||
TEXT.SET.GLOBAL.REGIONS 302194 . 303487) (TEXT.REGIONFN 303489 . 304259) (TEXT.GLOBALREGIONFN 304261
|
||||
. 304949) (TEXT.TRANSLATEFN 304951 . 306266) (TEXT.TRANSFORMFN 306268 . 307391) (TEXT.TRANSLATEPTSFN
|
||||
307393 . 307910) (TEXT.UPDATEFN 307912 . 312568) (SK.CHANGE.TEXT 312570 . 325658) (TEXT.SET.SCALES
|
||||
325660 . 326628) (BREAK.AT.CARRIAGE.RETURNS 326630 . 327590)) (327593 346117 (ADD.KNOWN.SKETCH.FONT
|
||||
327603 . 328594) (SK.PICK.FONT 328596 . 334128) (SK.CHOOSE.TEXT.FONT 334130 . 338078) (SK.NEXTSIZEFONT
|
||||
338080 . 339347) (SK.DECREASING.FONT.LIST 339349 . 341222) (SK.GUESS.FONTSAVAILABLE 341224 . 346115))
|
||||
(346544 360687 (SK.SET.FONT 346554 . 348121) (SK.SET.TEXT.FONT 348123 . 349125) (SK.SET.TEXT.SIZE
|
||||
349127 . 349814) (SK.SET.TEXT.HORIZ.ALIGN 349816 . 351390) (SK.READFONTSIZE 351392 . 353622) (
|
||||
SK.COLLECT.FONT.SIZES 353624 . 356542) (SK.SET.TEXT.VERT.ALIGN 356544 . 358586) (SK.SET.TEXT.LOOKS
|
||||
358588 . 360045) (SK.SET.DEFAULT.TEXT.FACE 360047 . 360685)) (360688 361274 (CREATE.SKETCH.TERMTABLE
|
||||
360698 . 361272)) (361275 363041 (SK.FONT.LIST 361285 . 361611) (SK.INSURE.FONT 361613 . 362135) (
|
||||
SK.INSURE.STYLE 362137 . 362655) (SK.INSURE.TEXT 362657 . 363039)) (363611 420904 (
|
||||
SKETCH.CREATE.TEXTBOX 363621 . 365263) (SK.COMPUTE.TEXTBOX.REGION.FOR.STRING 365265 . 367342) (
|
||||
SK.BREAK.INTO.LINES 367344 . 378530) (SK.BRUSH.SIZE 378532 . 378913) (SK.TEXTBOX.CREATE 378915 .
|
||||
379712) (SK.TEXTBOX.CREATE1 379714 . 380778) (SK.UPDATE.TEXTBOX.AFTER.CHANGE 380780 . 381320) (
|
||||
SK.TEXTBOX.POSITION.IN.BOX 381322 . 383233) (TEXTBOX.CHANGEFN 383235 . 383709) (TEXTBOX.DRAWFN 383711
|
||||
. 385747) (SK.TEXTURE.AROUND.REGIONS 385749 . 391822) (ALL.EMPTY.REGIONS 391824 . 392314) (
|
||||
TEXTBOX.EXPANDFN 392316 . 399472) (TEXTBOX.INPUTFN 399474 . 401087) (TEXTBOX.INSIDEFN 401089 . 401502)
|
||||
(TEXTBOX.REGIONFN 401504 . 402358) (TEXTBOX.GLOBALREGIONFN 402360 . 402688) (
|
||||
TEXTBOX.SET.GLOBAL.REGIONS 402690 . 404021) (TEXTBOX.TRANSLATEFN 404023 . 405864) (
|
||||
TEXTBOX.TRANSLATEPTSFN 405866 . 408649) (TEXTBOX.TRANSFORMFN 408651 . 410319) (TEXTBOX.UPDATEFN 410321
|
||||
. 412214) (TEXTBOX.READCHANGEFN 412216 . 417105) (SK.TEXTBOX.TEXT.POSITION 417107 . 417528) (
|
||||
SK.TEXTBOX.FROM.TEXT 417530 . 420135) (ADD.EOLS 420137 . 420902)) (421472 424973 (
|
||||
SK.SET.TEXTBOX.VERT.ALIGN 421482 . 423362) (SK.SET.TEXTBOX.HORIZ.ALIGN 423364 . 424971)) (425356
|
||||
469831 (SKETCH.CREATE.BOX 425366 . 425849) (SK.BOX.DRAWFN 425851 . 427010) (BOX.DRAWFN1 427012 .
|
||||
429851) (KNOTS.OF.REGION 429853 . 431087) (SK.DRAWAREABOX 431089 . 437690) (SK.DRAWBOX 437692 . 438881
|
||||
) (SK.BOX.EXPANDFN 438883 . 442631) (SK.BOX.GETREGIONFN 442633 . 443819) (BOX.SET.SCALES 443821 .
|
||||
445061) (SK.BOX.INPUTFN 445063 . 446996) (SK.BOX.CREATE 446998 . 447699) (SK.UPDATE.BOX.AFTER.CHANGE
|
||||
447701 . 448212) (SK.BOX.INSIDEFN 448214 . 448604) (SK.BOX.REGIONFN 448606 . 449319) (
|
||||
SK.BOX.GLOBALREGIONFN 449321 . 450059) (SK.BOX.READCHANGEFN 450061 . 453782) (SK.CHANGE.FILLING 453784
|
||||
. 457732) (SK.CHANGE.FILLING.COLOR 457734 . 461390) (SK.BOX.TRANSLATEFN 461392 . 462571) (
|
||||
SK.BOX.TRANSFORMFN 462573 . 463518) (SK.BOX.TRANSLATEPTSFN 463520 . 465888) (UNSCALE.REGION.TO.GRID
|
||||
465890 . 466815) (INCREASEREGION 466817 . 467408) (INSUREREGIONSIZE 467410 . 468581) (EXPANDREGION
|
||||
468583 . 469463) (REGION.FROM.COORDINATES 469465 . 469829)) (470371 496726 (SKETCH.CREATE.ARC 470381
|
||||
. 471190) (ARC.DRAWFN 471192 . 472919) (ARC.EXPANDFN 472921 . 475254) (ARC.INPUTFN 475256 . 479474) (
|
||||
SK.INVERT.CIRCLE 479476 . 480336) (SK.READ.ARC.ANGLE.POINT 480338 . 480845) (SK.SHOW.ARC 480847 .
|
||||
481457) (ARC.CREATE 481459 . 482814) (SK.UPDATE.ARC.AFTER.CHANGE 482816 . 483156) (ARC.MOVEFN 483158
|
||||
. 484741) (ARC.TRANSLATEPTS 484743 . 486628) (ARC.INSIDEFN 486630 . 486880) (ARC.REGIONFN 486882 .
|
||||
488018) (ARC.GLOBALREGIONFN 488020 . 489742) (ARC.TRANSLATE 489744 . 490726) (ARC.TRANSFORMFN 490728
|
||||
. 493678) (ARC.READCHANGEFN 493680 . 496724)) (496727 505806 (SK.COMPUTE.ARC.ANGLE.PT 496737 . 497663
|
||||
) (SK.COMPUTE.ARC.ANGLE.PT.FROM.ANGLE 497665 . 498658) (SK.COMPUTE.ARC.PTS 498660 . 502232) (
|
||||
SK.SET.ARC.DIRECTION 502234 . 502808) (SK.SET.ARC.DIRECTION.CW 502810 . 502984) (
|
||||
SK.SET.ARC.DIRECTION.CCW 502986 . 503259) (SK.COMPUTE.SLOPE.OF.LINE 503261 . 503753) (
|
||||
SK.CREATE.ARC.USING 503755 . 504992) (SET.ARC.SCALES 504994 . 505804)) (505807 506252 (
|
||||
SK.INSURE.DIRECTION 505817 . 506250)) (507654 553513 (GETSKETCHELEMENTPROP 507664 . 508972) (
|
||||
\SK.GET.ARC.ANGLEPT 508974 . 509535) (\GETSKETCHELEMENTPROP1 509537 . 509791) (\SK.GET.BRUSH 509793 .
|
||||
510717) (\SK.GET.FILLING 510719 . 511817) (\SK.GET.ARROWHEADS 511819 . 512598) (\SK.GET.FONT 512600 .
|
||||
513080) (\SK.GET.JUSTIFICATION 513082 . 513606) (\SK.GET.DIRECTION 513608 . 514085) (\SK.GET.DASHING
|
||||
514087 . 515106) (PUTSKETCHELEMENTPROP 515108 . 517377) (\SK.PUT.FILLING 517379 . 518649) (
|
||||
ADDSKETCHELEMENTPROP 518651 . 519456) (REMOVESKETCHELEMENTPROP 519458 . 520247) (\SK.PUT.FONT 520249
|
||||
. 521063) (\SK.PUT.JUSTIFICATION 521065 . 522076) (\SK.PUT.DIRECTION 522078 . 522685) (
|
||||
\SK.PUT.DASHING 522687 . 524022) (\SK.PUT.BRUSH 524024 . 525943) (\SK.PUT.ARROWHEADS 525945 . 527911)
|
||||
(SK.COPY.ELEMENT.PROPERTY.LIST 527913 . 528489) (SKETCH.UPDATE 528491 . 529221) (SKETCH.UPDATE1 529223
|
||||
. 530511) (\SKELT.GET.SCALE 530513 . 531501) (\SKELT.PUT.SCALE 531503 . 532810) (\SKELT.PUT.DATA
|
||||
532812 . 534609) (SK.REPLACE.TEXT.IN.ELEMENT 534611 . 535564) (\SKELT.GET.DATA 535566 . 536633) (
|
||||
\SK.GET.1STCONTROLPT 536635 . 538147) (\SK.PUT.1STCONTROLPT 538149 . 543622) (\SK.GET.2NDCONTROLPT
|
||||
543624 . 544539) (\SK.PUT.2NDCONTROLPT 544541 . 548729) (\SK.GET.3RDCONTROLPT 548731 . 549609) (
|
||||
\SK.PUT.3RDCONTROLPT 549611 . 553511)) (553514 554095 (LOWERLEFTCORNER 553524 . 553770) (
|
||||
UPPERRIGHTCORNER 553772 . 554093)))))
|
||||
(FILEMAP (NIL (14359 24769 (INIT.SKETCH.ELEMENTS 14369 . 21932) (CREATE.SKETCH.ELEMENT.TYPE 21934 .
|
||||
23456) (SKETCH.ELEMENT.TYPEP 23458 . 23846) (SKETCH.ELEMENT.NAMEP 23848 . 24111) (
|
||||
\CURSOR.IN.MIDDLE.MENU 24113 . 24767)) (24810 25487 (SKETCHINCOLORP 24820 . 25140) (READ.COLOR.CHANGE
|
||||
25142 . 25485)) (25996 28775 (SK.CREATE.DEFAULT.FILLING 26006 . 26307) (SKFILLINGP 26309 . 26942) (
|
||||
SK.INSURE.FILLING 26944 . 28372) (SK.INSURE.COLOR 28374 . 28773)) (28776 34386 (SK.TRANSLATE.MODE
|
||||
28786 . 29568) (SK.CHANGE.FILLING.MODE 29570 . 33153) (READ.FILLING.MODE 33155 . 34384)) (34387 65061
|
||||
(SKETCH.CREATE.CIRCLE 34397 . 35209) (CIRCLE.EXPANDFN 35211 . 38583) (CIRCLE.DRAWFN 38585 . 41586) (
|
||||
\CIRCLE.DRAWFN1 41588 . 44183) (CIRCLE.INPUTFN 44185 . 46034) (SK.UPDATE.CIRCLE.AFTER.CHANGE 46036 .
|
||||
46395) (SK.READ.CIRCLE.POINT 46397 . 46868) (SK.SHOW.CIRCLE 46870 . 47516) (CIRCLE.INSIDEFN 47518 .
|
||||
47783) (CIRCLE.REGIONFN 47785 . 49466) (CIRCLE.GLOBALREGIONFN 49468 . 50986) (CIRCLE.TRANSLATE 50988
|
||||
. 52849) (CIRCLE.READCHANGEFN 52851 . 57467) (CIRCLE.TRANSFORMFN 57469 . 59322) (CIRCLE.TRANSLATEPTS
|
||||
59324 . 60938) (SK.CIRCLE.CREATE 60940 . 61783) (SET.CIRCLE.SCALE 61785 . 62551) (SK.BRUSH.READCHANGE
|
||||
62553 . 65059)) (65062 65791 (SK.INSURE.BRUSH 65072 . 65466) (SK.INSURE.DASHING 65468 . 65789)) (67005
|
||||
96499 (SKETCH.CREATE.ELLIPSE 67015 . 67614) (ELLIPSE.EXPANDFN 67616 . 71228) (ELLIPSE.DRAWFN 71230 .
|
||||
75407) (ELLIPSE.INPUTFN 75409 . 77849) (SK.READ.ELLIPSE.MAJOR.PT 77851 . 78430) (
|
||||
SK.SHOW.ELLIPSE.MAJOR.RADIUS 78432 . 79187) (SK.READ.ELLIPSE.MINOR.PT 79189 . 79882) (
|
||||
SK.SHOW.ELLIPSE.MINOR.RADIUS 79884 . 80716) (ELLIPSE.INSIDEFN 80718 . 80988) (ELLIPSE.CREATE 80990 .
|
||||
82365) (SK.UPDATE.ELLIPSE.AFTER.CHANGE 82367 . 82735) (ELLIPSE.REGIONFN 82737 . 84937) (
|
||||
ELLIPSE.GLOBALREGIONFN 84939 . 86752) (ELLIPSE.TRANSLATEFN 86754 . 89300) (ELLIPSE.TRANSFORMFN 89302
|
||||
. 90579) (ELLIPSE.TRANSLATEPTS 90581 . 92622) (MARK.SPOT 92624 . 93875) (DISTANCEBETWEEN 93877 .
|
||||
94472) (SK.DISTANCE.TO 94474 . 94859) (SQUARE 94861 . 94903) (COMPUTE.ELLIPSE.ORIENTATION 94905 .
|
||||
95624) (SK.COMPUTE.ELLIPSE.MINOR.RADIUS.PT 95626 . 96497)) (97612 138668 (SKETCH.CREATE.OPEN.CURVE
|
||||
97622 . 98175) (OPENCURVE.INPUTFN 98177 . 99045) (SK.CURVE.CREATE 99047 . 100792) (MAXXEXTENT 100794
|
||||
. 101653) (MAXYEXTENT 101655 . 102515) (KNOT.SET.SCALE.FIELD 102517 . 103319) (OPENCURVE.DRAWFN
|
||||
103321 . 104452) (OPENCURVE.EXPANDFN 104454 . 107769) (OPENCURVE.READCHANGEFN 107771 . 110973) (
|
||||
OPENCURVE.TRANSFORMFN 110975 . 113473) (OPENCURVE.TRANSLATEFN 113475 . 113897) (
|
||||
OPENCURVE.TRANSLATEPTSFN 113899 . 115280) (SKETCH.CREATE.CLOSED.CURVE 115282 . 115788) (
|
||||
CLOSEDCURVE.DRAWFN 115790 . 116574) (CLOSEDCURVE.EXPANDFN 116576 . 119689) (CLOSEDCURVE.REGIONFN
|
||||
119691 . 120488) (CLOSEDCURVE.GLOBALREGIONFN 120490 . 121923) (READ.LIST.OF.POINTS 121925 . 123904) (
|
||||
CLOSEDCURVE.INPUTFN 123906 . 124551) (CLOSEDCURVE.READCHANGEFN 124553 . 127448) (
|
||||
CLOSEDCURVE.TRANSFORMFN 127450 . 129250) (CLOSEDCURVE.TRANSLATEPTSFN 129252 . 130597) (INVISIBLEPARTP
|
||||
130599 . 130952) (SHOWSKETCHPOINT 130954 . 131259) (SHOWSKETCHXY 131261 . 131779) (KNOTS.REGIONFN
|
||||
131781 . 132682) (OPENWIRE.GLOBALREGIONFN 132684 . 133548) (CURVE.REGIONFN 133550 . 134491) (
|
||||
OPENCURVE.GLOBALREGIONFN 134493 . 135900) (KNOTS.TRANSLATEFN 135902 . 136945) (REGION.CONTAINING.PTS
|
||||
136947 . 138666)) (138669 160945 (CHANGE.ELTS.BRUSH.SIZE 138679 . 139289) (CHANGE.ELTS.BRUSH 139291 .
|
||||
139808) (CHANGE.ELTS.BRUSH.SHAPE 139810 . 140211) (SK.CHANGE.BRUSH.SHAPE 140213 . 143725) (
|
||||
SK.CHANGE.BRUSH.COLOR 143727 . 148173) (SK.CHANGE.BRUSH.SIZE 148175 . 153133) (SK.CHANGE.ANGLE 153135
|
||||
. 156115) (SK.CHANGE.ARC.DIRECTION 156117 . 158496) (SK.SET.DEFAULT.BRUSH.SIZE 158498 . 159197) (
|
||||
READSIZECHANGE 159199 . 160943)) (160946 162565 (SK.CHANGE.ELEMENT.KNOTS 160956 . 162563)) (162566
|
||||
163213 (SK.INSURE.POINT.LIST 162576 . 163029) (SK.INSURE.POSITION 163031 . 163211)) (164581 196904 (
|
||||
SKETCH.CREATE.WIRE 164591 . 165081) (CLOSEDWIRE.EXPANDFN 165083 . 167771) (KNOTS.INSIDEFN 167773 .
|
||||
168494) (OPEN.WIRE.DRAWFN 168496 . 169088) (WIRE.EXPANDFN 169090 . 172337) (
|
||||
SK.UPDATE.WIRE.ELT.AFTER.CHANGE 172339 . 172860) (OPENWIRE.READCHANGEFN 172862 . 175355) (
|
||||
OPENWIRE.TRANSFORMFN 175357 . 177480) (OPENWIRE.TRANSLATEFN 177482 . 177906) (OPENWIRE.TRANSLATEPTSFN
|
||||
177908 . 179187) (WIRE.INPUTFN 179189 . 180820) (SK.READ.WIRE.POINTS 180822 . 181353) (
|
||||
SK.READ.POINTS.WITH.FEEDBACK 181355 . 184122) (OPENWIRE.FEEDBACKFN 184124 . 184878) (
|
||||
CLOSEDWIRE.FEEDBACKFN 184880 . 186236) (CLOSEDWIRE.REGIONFN 186238 . 187223) (
|
||||
CLOSEDWIRE.GLOBALREGIONFN 187225 . 188277) (SK.WIRE.CREATE 188279 . 190042) (WIRE.ADD.POINT.TO.END
|
||||
190044 . 190960) (READ.ARROW.CHANGE 190962 . 196438) (CHANGE.ELTS.ARROWHEADS 196440 . 196902)) (196905
|
||||
207911 (SKETCH.CREATE.CLOSED.WIRE 196915 . 197476) (CLOSED.WIRE.INPUTFN 197478 . 197833) (
|
||||
CLOSED.WIRE.DRAWFN 197835 . 199880) (CLOSEDWIRE.READCHANGEFN 199882 . 204787) (CLOSEDWIRE.TRANSFORMFN
|
||||
204789 . 206583) (CLOSEDWIRE.TRANSLATEPTSFN 206585 . 207909)) (207912 260618 (SK.EXPAND.ARROWHEADS
|
||||
207922 . 208272) (SK.COMPUTE.ARC.ARROWHEAD.POINTS 208274 . 209655) (ARC.ARROWHEAD.POINTS 209657 .
|
||||
210880) (SET.ARC.ARROWHEAD.POINTS 210882 . 211863) (SET.OPENCURVE.ARROWHEAD.POINTS 211865 . 212766) (
|
||||
SK.COMPUTE.CURVE.ARROWHEAD.POINTS 212768 . 214038) (SET.WIRE.ARROWHEAD.POINTS 214040 . 214793) (
|
||||
SK.COMPUTE.WIRE.ARROWHEAD.POINTS 214795 . 216060) (SK.EXPAND.ARROWHEAD 216062 . 217245) (CHANGED.ARROW
|
||||
217247 . 220419) (SK.CHANGE.ARROWHEAD 220421 . 220874) (SK.CHANGE.ARROWHEAD1 220876 . 226131) (
|
||||
SK.CREATE.ARROWHEAD 226133 . 226653) (SK.ARROWHEAD.CREATE 226655 . 228229) (SK.ARROWHEAD.END.TEST
|
||||
228231 . 229155) (READ.ARROWHEAD.END 229157 . 231182) (ARROW.HEAD.POSITIONS 231184 . 233024) (
|
||||
ARROWHEAD.POINTS.LIST 233026 . 236998) (CURVE.ARROWHEAD.POINTS 237000 . 237863) (LEFT.MOST.IS.BEGINP
|
||||
237865 . 238746) (WIRE.ARROWHEAD.POINTS 238748 . 240274) (DRAWARROWHEADS 240276 . 242646) (
|
||||
\SK.DRAW.TRIANGLE.ARROWHEAD 242648 . 244308) (\SK.ENDPT.OF.ARROW 244310 . 246567) (
|
||||
\SK.ADJUST.FOR.ARROWHEADS 246569 . 249074) (SK.SET.ARROWHEAD.LENGTH 249076 . 250220) (
|
||||
SK.SET.ARROWHEAD.ANGLE 250222 . 251318) (SK.SET.ARROWHEAD.TYPE 251320 . 254609) (SK.SET.LINE.ARROWHEAD
|
||||
254611 . 257024) (SK.UPDATE.ARROWHEAD.FORMAT 257026 . 259136) (SK.SET.LINE.LENGTH.MODE 259138 .
|
||||
260616)) (260619 262420 (SK.INSURE.ARROWHEADS 260629 . 261811) (SK.ARROWHEADP 261813 . 262418)) (
|
||||
265217 327543 (SKETCH.CREATE.TEXT 265227 . 265741) (TEXT.CHANGEFN 265743 . 266135) (TEXT.READCHANGEFN
|
||||
266137 . 274208) (\SK.READ.FONT.SIZE1 274210 . 276106) (SK.TEXT.ELT.WITH.SAME.FIELDS 276108 . 277748)
|
||||
(SK.READFONTFAMILY 277750 . 279296) (CLOSE.PROMPT.WINDOW 279298 . 279722) (TEXT.DRAWFN 279724 . 280445
|
||||
) (TEXT.DRAWFN1 280447 . 283949) (TEXT.INSIDEFN 283951 . 284340) (TEXT.EXPANDFN 284342 . 286467) (
|
||||
SK.TEXT.LINE.REGIONS 286469 . 288343) (TEXT.UPDATE.GLOBAL.REGIONS 288345 . 289577) (REL.MOVE.REGION
|
||||
289579 . 290116) (LTEXT.LINE.REGIONS 290118 . 293536) (TEXT.INPUTFN 293538 . 294048) (READ.TEXT 294050
|
||||
. 294798) (TEXT.POSITION.AND.CREATE 294800 . 297111) (CREATE.TEXT.ELEMENT 297113 . 297931) (
|
||||
SK.UPDATE.TEXT.AFTER.CHANGE 297933 . 298335) (SK.TEXT.FROM.TEXTBOX 298337 . 302143) (
|
||||
TEXT.SET.GLOBAL.REGIONS 302145 . 303438) (TEXT.REGIONFN 303440 . 304210) (TEXT.GLOBALREGIONFN 304212
|
||||
. 304900) (TEXT.TRANSLATEFN 304902 . 306217) (TEXT.TRANSFORMFN 306219 . 307342) (TEXT.TRANSLATEPTSFN
|
||||
307344 . 307861) (TEXT.UPDATEFN 307863 . 312519) (SK.CHANGE.TEXT 312521 . 325609) (TEXT.SET.SCALES
|
||||
325611 . 326579) (BREAK.AT.CARRIAGE.RETURNS 326581 . 327541)) (327544 346068 (ADD.KNOWN.SKETCH.FONT
|
||||
327554 . 328545) (SK.PICK.FONT 328547 . 334079) (SK.CHOOSE.TEXT.FONT 334081 . 338029) (SK.NEXTSIZEFONT
|
||||
338031 . 339298) (SK.DECREASING.FONT.LIST 339300 . 341173) (SK.GUESS.FONTSAVAILABLE 341175 . 346066))
|
||||
(346487 360630 (SK.SET.FONT 346497 . 348064) (SK.SET.TEXT.FONT 348066 . 349068) (SK.SET.TEXT.SIZE
|
||||
349070 . 349757) (SK.SET.TEXT.HORIZ.ALIGN 349759 . 351333) (SK.READFONTSIZE 351335 . 353565) (
|
||||
SK.COLLECT.FONT.SIZES 353567 . 356485) (SK.SET.TEXT.VERT.ALIGN 356487 . 358529) (SK.SET.TEXT.LOOKS
|
||||
358531 . 359988) (SK.SET.DEFAULT.TEXT.FACE 359990 . 360628)) (360631 361217 (CREATE.SKETCH.TERMTABLE
|
||||
360641 . 361215)) (361218 362984 (SK.FONT.LIST 361228 . 361554) (SK.INSURE.FONT 361556 . 362078) (
|
||||
SK.INSURE.STYLE 362080 . 362598) (SK.INSURE.TEXT 362600 . 362982)) (363554 420847 (
|
||||
SKETCH.CREATE.TEXTBOX 363564 . 365206) (SK.COMPUTE.TEXTBOX.REGION.FOR.STRING 365208 . 367285) (
|
||||
SK.BREAK.INTO.LINES 367287 . 378473) (SK.BRUSH.SIZE 378475 . 378856) (SK.TEXTBOX.CREATE 378858 .
|
||||
379655) (SK.TEXTBOX.CREATE1 379657 . 380721) (SK.UPDATE.TEXTBOX.AFTER.CHANGE 380723 . 381263) (
|
||||
SK.TEXTBOX.POSITION.IN.BOX 381265 . 383176) (TEXTBOX.CHANGEFN 383178 . 383652) (TEXTBOX.DRAWFN 383654
|
||||
. 385690) (SK.TEXTURE.AROUND.REGIONS 385692 . 391765) (ALL.EMPTY.REGIONS 391767 . 392257) (
|
||||
TEXTBOX.EXPANDFN 392259 . 399415) (TEXTBOX.INPUTFN 399417 . 401030) (TEXTBOX.INSIDEFN 401032 . 401445)
|
||||
(TEXTBOX.REGIONFN 401447 . 402301) (TEXTBOX.GLOBALREGIONFN 402303 . 402631) (
|
||||
TEXTBOX.SET.GLOBAL.REGIONS 402633 . 403964) (TEXTBOX.TRANSLATEFN 403966 . 405807) (
|
||||
TEXTBOX.TRANSLATEPTSFN 405809 . 408592) (TEXTBOX.TRANSFORMFN 408594 . 410262) (TEXTBOX.UPDATEFN 410264
|
||||
. 412157) (TEXTBOX.READCHANGEFN 412159 . 417048) (SK.TEXTBOX.TEXT.POSITION 417050 . 417471) (
|
||||
SK.TEXTBOX.FROM.TEXT 417473 . 420078) (ADD.EOLS 420080 . 420845)) (421376 424877 (
|
||||
SK.SET.TEXTBOX.VERT.ALIGN 421386 . 423266) (SK.SET.TEXTBOX.HORIZ.ALIGN 423268 . 424875)) (425260
|
||||
469735 (SKETCH.CREATE.BOX 425270 . 425753) (SK.BOX.DRAWFN 425755 . 426914) (BOX.DRAWFN1 426916 .
|
||||
429755) (KNOTS.OF.REGION 429757 . 430991) (SK.DRAWAREABOX 430993 . 437594) (SK.DRAWBOX 437596 . 438785
|
||||
) (SK.BOX.EXPANDFN 438787 . 442535) (SK.BOX.GETREGIONFN 442537 . 443723) (BOX.SET.SCALES 443725 .
|
||||
444965) (SK.BOX.INPUTFN 444967 . 446900) (SK.BOX.CREATE 446902 . 447603) (SK.UPDATE.BOX.AFTER.CHANGE
|
||||
447605 . 448116) (SK.BOX.INSIDEFN 448118 . 448508) (SK.BOX.REGIONFN 448510 . 449223) (
|
||||
SK.BOX.GLOBALREGIONFN 449225 . 449963) (SK.BOX.READCHANGEFN 449965 . 453686) (SK.CHANGE.FILLING 453688
|
||||
. 457636) (SK.CHANGE.FILLING.COLOR 457638 . 461294) (SK.BOX.TRANSLATEFN 461296 . 462475) (
|
||||
SK.BOX.TRANSFORMFN 462477 . 463422) (SK.BOX.TRANSLATEPTSFN 463424 . 465792) (UNSCALE.REGION.TO.GRID
|
||||
465794 . 466719) (INCREASEREGION 466721 . 467312) (INSUREREGIONSIZE 467314 . 468485) (EXPANDREGION
|
||||
468487 . 469367) (REGION.FROM.COORDINATES 469369 . 469733)) (470271 496626 (SKETCH.CREATE.ARC 470281
|
||||
. 471090) (ARC.DRAWFN 471092 . 472819) (ARC.EXPANDFN 472821 . 475154) (ARC.INPUTFN 475156 . 479374) (
|
||||
SK.INVERT.CIRCLE 479376 . 480236) (SK.READ.ARC.ANGLE.POINT 480238 . 480745) (SK.SHOW.ARC 480747 .
|
||||
481357) (ARC.CREATE 481359 . 482714) (SK.UPDATE.ARC.AFTER.CHANGE 482716 . 483056) (ARC.MOVEFN 483058
|
||||
. 484641) (ARC.TRANSLATEPTS 484643 . 486528) (ARC.INSIDEFN 486530 . 486780) (ARC.REGIONFN 486782 .
|
||||
487918) (ARC.GLOBALREGIONFN 487920 . 489642) (ARC.TRANSLATE 489644 . 490626) (ARC.TRANSFORMFN 490628
|
||||
. 493578) (ARC.READCHANGEFN 493580 . 496624)) (496627 505706 (SK.COMPUTE.ARC.ANGLE.PT 496637 . 497563
|
||||
) (SK.COMPUTE.ARC.ANGLE.PT.FROM.ANGLE 497565 . 498558) (SK.COMPUTE.ARC.PTS 498560 . 502132) (
|
||||
SK.SET.ARC.DIRECTION 502134 . 502708) (SK.SET.ARC.DIRECTION.CW 502710 . 502884) (
|
||||
SK.SET.ARC.DIRECTION.CCW 502886 . 503159) (SK.COMPUTE.SLOPE.OF.LINE 503161 . 503653) (
|
||||
SK.CREATE.ARC.USING 503655 . 504892) (SET.ARC.SCALES 504894 . 505704)) (505707 506152 (
|
||||
SK.INSURE.DIRECTION 505717 . 506150)) (507523 553382 (GETSKETCHELEMENTPROP 507533 . 508841) (
|
||||
\SK.GET.ARC.ANGLEPT 508843 . 509404) (\GETSKETCHELEMENTPROP1 509406 . 509660) (\SK.GET.BRUSH 509662 .
|
||||
510586) (\SK.GET.FILLING 510588 . 511686) (\SK.GET.ARROWHEADS 511688 . 512467) (\SK.GET.FONT 512469 .
|
||||
512949) (\SK.GET.JUSTIFICATION 512951 . 513475) (\SK.GET.DIRECTION 513477 . 513954) (\SK.GET.DASHING
|
||||
513956 . 514975) (PUTSKETCHELEMENTPROP 514977 . 517246) (\SK.PUT.FILLING 517248 . 518518) (
|
||||
ADDSKETCHELEMENTPROP 518520 . 519325) (REMOVESKETCHELEMENTPROP 519327 . 520116) (\SK.PUT.FONT 520118
|
||||
. 520932) (\SK.PUT.JUSTIFICATION 520934 . 521945) (\SK.PUT.DIRECTION 521947 . 522554) (
|
||||
\SK.PUT.DASHING 522556 . 523891) (\SK.PUT.BRUSH 523893 . 525812) (\SK.PUT.ARROWHEADS 525814 . 527780)
|
||||
(SK.COPY.ELEMENT.PROPERTY.LIST 527782 . 528358) (SKETCH.UPDATE 528360 . 529090) (SKETCH.UPDATE1 529092
|
||||
. 530380) (\SKELT.GET.SCALE 530382 . 531370) (\SKELT.PUT.SCALE 531372 . 532679) (\SKELT.PUT.DATA
|
||||
532681 . 534478) (SK.REPLACE.TEXT.IN.ELEMENT 534480 . 535433) (\SKELT.GET.DATA 535435 . 536502) (
|
||||
\SK.GET.1STCONTROLPT 536504 . 538016) (\SK.PUT.1STCONTROLPT 538018 . 543491) (\SK.GET.2NDCONTROLPT
|
||||
543493 . 544408) (\SK.PUT.2NDCONTROLPT 544410 . 548598) (\SK.GET.3RDCONTROLPT 548600 . 549478) (
|
||||
\SK.PUT.3RDCONTROLPT 549480 . 553380)) (553383 553964 (LOWERLEFTCORNER 553393 . 553639) (
|
||||
UPPERRIGHTCORNER 553641 . 553962)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,51 +1,51 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "20-Feb-2021 23:02:39"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TABLEBROWSER.;4 57889
|
||||
|
||||
changes to%: (VARS TABLEBROWSERCOMS)
|
||||
(FILECREATED " 6-Aug-2022 18:06:57" {DSK}<home>larry>medley>library>TABLEBROWSER.;8 63740
|
||||
|
||||
previous date%: " 1-Dec-2018 17:25:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TABLEBROWSER.;3)
|
||||
:CHANGES-TO (VARS TABLEBROWSERCOMS)
|
||||
(RECORDS TABLEBROWSER TABLEITEM)
|
||||
|
||||
:PREVIOUS-DATE " 4-Aug-2022 09:32:17" {DSK}<home>larry>medley>library>TABLEBROWSER.;7)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1985-1988, 1990, 1993-1995, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TABLEBROWSERCOMS)
|
||||
|
||||
(RPAQQ TABLEBROWSERCOMS
|
||||
((COMS (* ; "Entries")
|
||||
((COMS (* ; "Entries")
|
||||
(FNS TB.MAKE.BROWSER TB.REPLACE.ITEMS)
|
||||
(FNS TB.DELETE.ITEM TB.UNDELETE.ITEM TB.INSERT.ITEM TB.REMOVE.ITEM TB.NORMALIZE.ITEM
|
||||
TB.REDISPLAY.ITEMS TB.SELECT.ITEM TB.UNSELECT.ITEM TB.UNSELECT.ALL.ITEMS)
|
||||
(FNS TB.NUMBER.OF.ITEMS TB.NTH.ITEM TB.COLLECT.ITEMS TB.MAP.ITEMS TB.MAP.DELETED.ITEMS
|
||||
TB.MAP.SELECTED.ITEMS TB.FIND.ITEM TB.ITEM.SELECTED? TB.ITEM.DELETED?)
|
||||
(FNS TB.CLEAR.LINE TB.USERDATA TB.WINDOW))
|
||||
(COMS (* ; "Display")
|
||||
(COMS (* ; "Display")
|
||||
(FNS TB.REPAINTFN TB.RESHAPEFN TB.SCROLLFN TB.DISPLAY.LINES TB.PRINT.LINE
|
||||
TB.FIRST.VISIBLE.ITEM# TB.LAST.VISIBLE.ITEM# TB.ITEM.VISIBLE? TB.ITEM.FROM.YCOORD
|
||||
TB.BOTTOM.OF.ITEM TB.SHOW.DELETION TB.SHOW.SELECTION TB.UPDATE.DISPLAY
|
||||
TB.ITEM.UPDATABLE?))
|
||||
(COMS (* ; "Selection")
|
||||
(COMS (* ; "Selection")
|
||||
(FNS TB.BUTTONEVENTFN TB.DO.UNLESS.BUSY TB.DO.ITEM.SELECTION TB.CONTIGUOUS.SELP
|
||||
TB.DECONSIDERRANGE TB.CONSIDERRANGE TB.DESELECTRANGE TB.RECONSIDERRANGE
|
||||
TB.SELECTRANGE TB.UNDOSELECTION TB.FIND.SELECTED.ITEM TB.REV.FIND.SELECTED.ITEM)
|
||||
(FNS TB.COPYBUTTONEVENTFN TB.SHOW.COPY.SELECTION))
|
||||
(COMS (* ; "Misc state change")
|
||||
(COMS (* ; "Misc state change")
|
||||
(FNS TB.BROWSER.BUSY TB.CLOSE/SHRINK TB.CLOSEFN TB.FINISH.CLOSE TB.FLUSH.WINDOW
|
||||
TB.SET.FONT TB.SHRINKFN TB.EXPANDFN TB.FIND.PREVIOUS.TAIL TB.RENUMBER.TAIL))
|
||||
(COMS (* ; "Misc")
|
||||
(COMS (* ; "Misc")
|
||||
(FNS TB.PROCESS)
|
||||
(INITVARS (TB.DELETEDLINEHEIGHT 1))
|
||||
(VARS TB.SELECTION.BITMAP)
|
||||
(CURSORS TB.CROSSCURSOR)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
|
||||
TABLEBROWSERDECLS)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS TB.LEFT.MARGIN)
|
||||
(CONSTANTS * TOCSTATES)
|
||||
(MACROS .COPYKEYDOWNP.)
|
||||
(GLOBALVARS TB.CROSSCURSOR TB.SELECTION.BITMAP TB.DELETEDLINEHEIGHT)
|
||||
(LOCALVARS . T)))
|
||||
(LOCALVARS . T)
|
||||
(RECORDS TABLEBROWSER TABLEITEM)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA TB.USERDATA)))
|
||||
@@ -375,19 +375,23 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 b
|
||||
(RPAQ TB.CROSSCURSOR (CURSORCREATE (QUOTE #*(16 16)L@@CN@@GG@@NCHALALCH@NG@@GN@@CL@@CL@@GN@@NG@ALCHCHALG@@NN@@GL@@C
|
||||
) (QUOTE NIL) 8 8))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(FILESLOAD (SOURCE)
|
||||
TABLEBROWSERDECLS)
|
||||
(RPAQQ TB.LEFT.MARGIN 8)
|
||||
|
||||
|
||||
(CONSTANTS TB.LEFT.MARGIN)
|
||||
)
|
||||
|
||||
|
||||
(RPAQQ TOCSTATES ((TS.IDLE 0)
|
||||
(TS.REPLACING 1)
|
||||
(TS.ADDING 2)
|
||||
(TS.REMOVING 3)
|
||||
(TS.EXTENDING.HI 4)
|
||||
(TS.EXTENDING.LO 5)
|
||||
(TS.SHRINKING.HI 6)
|
||||
(TS.SHRINKING.LO 7)))
|
||||
(TS.REPLACING 1)
|
||||
(TS.ADDING 2)
|
||||
(TS.REMOVING 3)
|
||||
(TS.EXTENDING.HI 4)
|
||||
(TS.EXTENDING.LO 5)
|
||||
(TS.SHRINKING.HI 6)
|
||||
(TS.SHRINKING.LO 7)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ TS.IDLE 0)
|
||||
@@ -420,8 +424,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 b
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .COPYKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'LSHIFT)
|
||||
(KEYDOWNP 'RSHIFT)
|
||||
(KEYDOWNP 'COPY])
|
||||
(KEYDOWNP 'RSHIFT)
|
||||
(KEYDOWNP 'COPY])
|
||||
)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -433,30 +437,80 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 b
|
||||
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
(DATATYPE TABLEBROWSER ((TBREADY FLAG)
|
||||
(TBHEIGHTEXPLICIT FLAG) (* ;
|
||||
"True if creator set explicit item height or baseline")
|
||||
(TBITEMS POINTER) (* ; "List of items in this browser")
|
||||
(TB#ITEMS WORD) (* ; "Number of items")
|
||||
(TB#DELETED WORD) (* ; "Number of items marked deleted")
|
||||
(TB#LINESPERITEM WORD) (* ;
|
||||
"Number of lines occupied by each item, normally 1 (dunno if any other values work)")
|
||||
(TBFIRSTSELECTEDITEM WORD) (* ;
|
||||
"Number of first selected item. If none selected, is > TB#ITEMS")
|
||||
(TBLASTSELECTEDITEM WORD) (* ;
|
||||
"Number of last selected item. If none selected, is 0")
|
||||
(TBITEMHEIGHT WORD) (* ;
|
||||
"Height of an item, i.e., fontheight*linesperitem")
|
||||
(TBMAXXPOS WORD) (* ;
|
||||
"The largest x-position a user printfn has printed to")
|
||||
(TBFONTHEIGHT WORD) (* ; "Height, ascent, descent of font")
|
||||
(TBFONTASCENT WORD)
|
||||
(TBBASELINE WORD)
|
||||
(TBWINDOW POINTER) (* ;
|
||||
"Pointer to the display window. Need to snap this link when browser is closed")
|
||||
(TBLOCK POINTER) (* ;
|
||||
"Monitor lock guarding some browser operations")
|
||||
(TBUSERDATA POINTER) (* ; "Arbitrary user storage")
|
||||
(TBFONT POINTER) (* ; "Pointer to font used by display")
|
||||
(TBEXTENT POINTER) (* ;
|
||||
"Window's extent, updated as items are added, deleted, or printfn prints farther to right")
|
||||
(TBUPDATEFROMHERE POINTER) (* ;
|
||||
"If changes have occurred while shrunk, this gives the # of first item that needs redisplay")
|
||||
(TBCOLUMNS POINTER) (* ;
|
||||
"Number of columns--not yet implemented")
|
||||
(TBPRINTFN POINTER) (* ;
|
||||
"(Browser Item Window) -- displays Item at current line position in window")
|
||||
(TBCOPYFN POINTER) (* ;
|
||||
"(Browser Item) -- copy selects Item")
|
||||
(TBFONTCHANGEFN POINTER) (* ;
|
||||
"(Browser Window) -- called when tb.set.font changes the font")
|
||||
(TBCLOSEFN POINTER) (* ;
|
||||
"(Browser Window Close/Shrink) -- called when you try to close or shrink window")
|
||||
(TBAFTERCLOSEFN POINTER) (* ;
|
||||
"(Browser Window) -- called to cleanup AFTER a closew")
|
||||
(TBTITLEEVENTFN POINTER) (* ;
|
||||
"(Window Browser) -- handles button event in browser's title")
|
||||
(TBLINETHICKNESS POINTER) (* ;
|
||||
"Thickness of line for deletions (normally 1)")
|
||||
(TBORIGIN POINTER) (* ;
|
||||
"Y position of the top of the first item")
|
||||
(TBTAILHINT POINTER) (* ;
|
||||
"A tail of TBITEMS, used to speed up TB.NTH.ITEM")
|
||||
(TBHEADINGWINDOW POINTER) (* ;
|
||||
"An optional %"header window%" that should be horizontally scrolled in synchrony with this one")
|
||||
(NIL POINTER)))
|
||||
|
||||
(ADDTOVAR LAMA TB.USERDATA)
|
||||
(DATATYPE TABLEITEM ((TISELECTED FLAG)
|
||||
(TIDELETED FLAG)
|
||||
(TIUNDELETABLE FLAG)
|
||||
(TIUNSELECTABLE FLAG)
|
||||
(TIUNCOPYSELECTABLE FLAG)
|
||||
(TIDATA POINTER)
|
||||
(TI# WORD)))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'TABLEBROWSER
|
||||
'(FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD
|
||||
WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)
|
||||
'(FLAG FLAG POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER
|
||||
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER POINTER POINTER POINTER)
|
||||
'((TABLEBROWSER 0 (FLAGBITS . 0))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 16))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 32))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 48))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 64))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 80))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 96))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 112))
|
||||
(TABLEBROWSER 2 POINTER)
|
||||
(TABLEBROWSER 1 (BITS . 15))
|
||||
(TABLEBROWSER 0 POINTER)
|
||||
(TABLEBROWSER 2 (BITS . 15))
|
||||
(TABLEBROWSER 3 (BITS . 15))
|
||||
(TABLEBROWSER 4 (BITS . 15))
|
||||
(TABLEBROWSER 5 (BITS . 15))
|
||||
(TABLEBROWSER 6 (BITS . 15))
|
||||
@@ -465,7 +519,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 b
|
||||
(TABLEBROWSER 9 (BITS . 15))
|
||||
(TABLEBROWSER 10 (BITS . 15))
|
||||
(TABLEBROWSER 11 (BITS . 15))
|
||||
(TABLEBROWSER 12 (BITS . 15))
|
||||
(TABLEBROWSER 12 POINTER)
|
||||
(TABLEBROWSER 14 POINTER)
|
||||
(TABLEBROWSER 16 POINTER)
|
||||
(TABLEBROWSER 18 POINTER)
|
||||
@@ -482,91 +536,139 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 b
|
||||
(TABLEBROWSER 40 POINTER)
|
||||
(TABLEBROWSER 42 POINTER)
|
||||
(TABLEBROWSER 44 POINTER)
|
||||
(TABLEBROWSER 46 POINTER)
|
||||
(TABLEBROWSER 48 POINTER))
|
||||
'50)
|
||||
(TABLEBROWSER 46 POINTER))
|
||||
'48)
|
||||
|
||||
(/DECLAREDATATYPE 'TABLEITEM '(FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD)
|
||||
(/DECLAREDATATYPE 'TABLEITEM '(FLAG FLAG FLAG FLAG FLAG POINTER WORD)
|
||||
'((TABLEITEM 0 (FLAGBITS . 0))
|
||||
(TABLEITEM 0 (FLAGBITS . 16))
|
||||
(TABLEITEM 0 (FLAGBITS . 32))
|
||||
(TABLEITEM 0 (FLAGBITS . 48))
|
||||
(TABLEITEM 0 (FLAGBITS . 64))
|
||||
(TABLEITEM 0 (FLAGBITS . 80))
|
||||
(TABLEITEM 0 (FLAGBITS . 96))
|
||||
(TABLEITEM 0 (FLAGBITS . 112))
|
||||
(TABLEITEM 2 POINTER)
|
||||
(TABLEITEM 1 (BITS . 15))
|
||||
(TABLEITEM 4 (BITS . 15)))
|
||||
'6)
|
||||
(TABLEITEM 1 (BITS . 15)))
|
||||
'4)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA TB.USERDATA)
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'TABLEBROWSER
|
||||
'(FLAG FLAG POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER
|
||||
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER POINTER POINTER POINTER)
|
||||
'((TABLEBROWSER 0 (FLAGBITS . 0))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 16))
|
||||
(TABLEBROWSER 0 POINTER)
|
||||
(TABLEBROWSER 2 (BITS . 15))
|
||||
(TABLEBROWSER 3 (BITS . 15))
|
||||
(TABLEBROWSER 4 (BITS . 15))
|
||||
(TABLEBROWSER 5 (BITS . 15))
|
||||
(TABLEBROWSER 6 (BITS . 15))
|
||||
(TABLEBROWSER 7 (BITS . 15))
|
||||
(TABLEBROWSER 8 (BITS . 15))
|
||||
(TABLEBROWSER 9 (BITS . 15))
|
||||
(TABLEBROWSER 10 (BITS . 15))
|
||||
(TABLEBROWSER 11 (BITS . 15))
|
||||
(TABLEBROWSER 12 POINTER)
|
||||
(TABLEBROWSER 14 POINTER)
|
||||
(TABLEBROWSER 16 POINTER)
|
||||
(TABLEBROWSER 18 POINTER)
|
||||
(TABLEBROWSER 20 POINTER)
|
||||
(TABLEBROWSER 22 POINTER)
|
||||
(TABLEBROWSER 24 POINTER)
|
||||
(TABLEBROWSER 26 POINTER)
|
||||
(TABLEBROWSER 28 POINTER)
|
||||
(TABLEBROWSER 30 POINTER)
|
||||
(TABLEBROWSER 32 POINTER)
|
||||
(TABLEBROWSER 34 POINTER)
|
||||
(TABLEBROWSER 36 POINTER)
|
||||
(TABLEBROWSER 38 POINTER)
|
||||
(TABLEBROWSER 40 POINTER)
|
||||
(TABLEBROWSER 42 POINTER)
|
||||
(TABLEBROWSER 44 POINTER)
|
||||
(TABLEBROWSER 46 POINTER))
|
||||
'48)
|
||||
|
||||
(/DECLAREDATATYPE 'TABLEITEM '(FLAG FLAG FLAG FLAG FLAG POINTER WORD)
|
||||
'((TABLEITEM 0 (FLAGBITS . 0))
|
||||
(TABLEITEM 0 (FLAGBITS . 16))
|
||||
(TABLEITEM 0 (FLAGBITS . 32))
|
||||
(TABLEITEM 0 (FLAGBITS . 48))
|
||||
(TABLEITEM 0 (FLAGBITS . 64))
|
||||
(TABLEITEM 2 POINTER)
|
||||
(TABLEITEM 1 (BITS . 15)))
|
||||
'4)
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE TABLEBROWSER ((TBREADY FLAG)
|
||||
(TBHEIGHTEXPLICIT FLAG)
|
||||
(NIL 6 FLAG)
|
||||
(TBITEMS POINTER)
|
||||
(TB#ITEMS WORD)
|
||||
(TB#DELETED WORD)
|
||||
(TB#LINESPERITEM WORD)
|
||||
(TBFIRSTSELECTEDITEM WORD)
|
||||
(TBLASTSELECTEDITEM WORD)
|
||||
(TBITEMHEIGHT WORD)
|
||||
(TBMAXXPOS WORD)
|
||||
(TBFONTHEIGHT WORD)
|
||||
(TBFONTASCENT WORD)
|
||||
(TBBASELINE WORD)
|
||||
(TBWINDOW POINTER)
|
||||
(TBLOCK POINTER)
|
||||
(TBUSERDATA POINTER)
|
||||
(TBFONT POINTER)
|
||||
(TBEXTENT POINTER)
|
||||
(TBUPDATEFROMHERE POINTER)
|
||||
(TBCOLUMNS POINTER)
|
||||
(TBPRINTFN POINTER)
|
||||
(TBCOPYFN POINTER)
|
||||
(TBFONTCHANGEFN POINTER)
|
||||
(TBCLOSEFN POINTER)
|
||||
(TBAFTERCLOSEFN POINTER)
|
||||
(TBTITLEEVENTFN POINTER)
|
||||
(TBLINETHICKNESS POINTER)
|
||||
(TBORIGIN POINTER)
|
||||
(TBTAILHINT POINTER)
|
||||
(TBHEADINGWINDOW POINTER)
|
||||
(NIL POINTER)))
|
||||
(TBHEIGHTEXPLICIT FLAG)
|
||||
(TBITEMS POINTER)
|
||||
(TB#ITEMS WORD)
|
||||
(TB#DELETED WORD)
|
||||
(TB#LINESPERITEM WORD)
|
||||
(TBFIRSTSELECTEDITEM WORD)
|
||||
(TBLASTSELECTEDITEM WORD)
|
||||
(TBITEMHEIGHT WORD)
|
||||
(TBMAXXPOS WORD)
|
||||
(TBFONTHEIGHT WORD)
|
||||
(TBFONTASCENT WORD)
|
||||
(TBBASELINE WORD)
|
||||
(TBWINDOW POINTER)
|
||||
(TBLOCK POINTER)
|
||||
(TBUSERDATA POINTER)
|
||||
(TBFONT POINTER)
|
||||
(TBEXTENT POINTER)
|
||||
(TBUPDATEFROMHERE POINTER)
|
||||
(TBCOLUMNS POINTER)
|
||||
(TBPRINTFN POINTER)
|
||||
(TBCOPYFN POINTER)
|
||||
(TBFONTCHANGEFN POINTER)
|
||||
(TBCLOSEFN POINTER)
|
||||
(TBAFTERCLOSEFN POINTER)
|
||||
(TBTITLEEVENTFN POINTER)
|
||||
(TBLINETHICKNESS POINTER)
|
||||
(TBORIGIN POINTER)
|
||||
(TBTAILHINT POINTER)
|
||||
(TBHEADINGWINDOW POINTER)
|
||||
(NIL POINTER)))
|
||||
|
||||
(DATATYPE TABLEITEM ((TISELECTED FLAG)
|
||||
(TIDELETED FLAG)
|
||||
(TIUNDELETABLE FLAG)
|
||||
(TIUNSELECTABLE FLAG)
|
||||
(TIUNCOPYSELECTABLE FLAG)
|
||||
(NIL 3 FLAG)
|
||||
(TIDATA POINTER)
|
||||
(TI# WORD)
|
||||
(NIL WORD)))
|
||||
(TIDELETED FLAG)
|
||||
(TIUNDELETABLE FLAG)
|
||||
(TIUNSELECTABLE FLAG)
|
||||
(TIUNCOPYSELECTABLE FLAG)
|
||||
(TIDATA POINTER)
|
||||
(TI# WORD)))
|
||||
)
|
||||
(PUTPROPS TABLEBROWSER COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993 1994 1995
|
||||
1999 2018 2021))
|
||||
1999 2018 2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3214 7565 (TB.MAKE.BROWSER 3224 . 6340) (TB.REPLACE.ITEMS 6342 . 7563)) (7566 16585 (
|
||||
TB.DELETE.ITEM 7576 . 8010) (TB.UNDELETE.ITEM 8012 . 8591) (TB.INSERT.ITEM 8593 . 10600) (
|
||||
TB.REMOVE.ITEM 10602 . 12134) (TB.NORMALIZE.ITEM 12136 . 12849) (TB.REDISPLAY.ITEMS 12851 . 15170) (
|
||||
TB.SELECT.ITEM 15172 . 15477) (TB.UNSELECT.ITEM 15479 . 15834) (TB.UNSELECT.ALL.ITEMS 15836 . 16583))
|
||||
(16586 21112 (TB.NUMBER.OF.ITEMS 16596 . 17078) (TB.NTH.ITEM 17080 . 18154) (TB.COLLECT.ITEMS 18156 .
|
||||
18527) (TB.MAP.ITEMS 18529 . 18893) (TB.MAP.DELETED.ITEMS 18895 . 19342) (TB.MAP.SELECTED.ITEMS 19344
|
||||
. 19951) (TB.FIND.ITEM 19953 . 20826) (TB.ITEM.SELECTED? 20828 . 20969) (TB.ITEM.DELETED? 20971 .
|
||||
21110)) (21113 21954 (TB.CLEAR.LINE 21123 . 21535) (TB.USERDATA 21537 . 21803) (TB.WINDOW 21805 .
|
||||
21952)) (21979 32237 (TB.REPAINTFN 21989 . 22400) (TB.RESHAPEFN 22402 . 23240) (TB.SCROLLFN 23242 .
|
||||
23793) (TB.DISPLAY.LINES 23795 . 25052) (TB.PRINT.LINE 25054 . 25574) (TB.FIRST.VISIBLE.ITEM# 25576 .
|
||||
26013) (TB.LAST.VISIBLE.ITEM# 26015 . 26488) (TB.ITEM.VISIBLE? 26490 . 27010) (TB.ITEM.FROM.YCOORD
|
||||
27012 . 27322) (TB.BOTTOM.OF.ITEM 27324 . 27737) (TB.SHOW.DELETION 27739 . 28361) (TB.SHOW.SELECTION
|
||||
28363 . 29132) (TB.UPDATE.DISPLAY 29134 . 31419) (TB.ITEM.UPDATABLE? 31421 . 32235)) (32264 43677 (
|
||||
TB.BUTTONEVENTFN 32274 . 32733) (TB.DO.UNLESS.BUSY 32735 . 33042) (TB.DO.ITEM.SELECTION 33044 . 39118)
|
||||
(TB.CONTIGUOUS.SELP 39120 . 39487) (TB.DECONSIDERRANGE 39489 . 39857) (TB.CONSIDERRANGE 39859 . 40430
|
||||
) (TB.DESELECTRANGE 40432 . 41494) (TB.RECONSIDERRANGE 41496 . 41994) (TB.SELECTRANGE 41996 . 42936) (
|
||||
TB.UNDOSELECTION 42938 . 43215) (TB.FIND.SELECTED.ITEM 43217 . 43440) (TB.REV.FIND.SELECTED.ITEM 43442
|
||||
. 43675)) (43678 45177 (TB.COPYBUTTONEVENTFN 43688 . 44908) (TB.SHOW.COPY.SELECTION 44910 . 45175)) (
|
||||
45212 51519 (TB.BROWSER.BUSY 45222 . 45339) (TB.CLOSE/SHRINK 45341 . 45973) (TB.CLOSEFN 45975 . 46076)
|
||||
(TB.FINISH.CLOSE 46078 . 46731) (TB.FLUSH.WINDOW 46733 . 47260) (TB.SET.FONT 47262 . 49560) (
|
||||
TB.SHRINKFN 49562 . 49665) (TB.EXPANDFN 49667 . 50432) (TB.FIND.PREVIOUS.TAIL 50434 . 51176) (
|
||||
TB.RENUMBER.TAIL 51178 . 51517)) (51541 51914 (TB.PROCESS 51551 . 51912)))))
|
||||
(FILEMAP (NIL (3194 7545 (TB.MAKE.BROWSER 3204 . 6320) (TB.REPLACE.ITEMS 6322 . 7543)) (7546 16565 (
|
||||
TB.DELETE.ITEM 7556 . 7990) (TB.UNDELETE.ITEM 7992 . 8571) (TB.INSERT.ITEM 8573 . 10580) (
|
||||
TB.REMOVE.ITEM 10582 . 12114) (TB.NORMALIZE.ITEM 12116 . 12829) (TB.REDISPLAY.ITEMS 12831 . 15150) (
|
||||
TB.SELECT.ITEM 15152 . 15457) (TB.UNSELECT.ITEM 15459 . 15814) (TB.UNSELECT.ALL.ITEMS 15816 . 16563))
|
||||
(16566 21092 (TB.NUMBER.OF.ITEMS 16576 . 17058) (TB.NTH.ITEM 17060 . 18134) (TB.COLLECT.ITEMS 18136 .
|
||||
18507) (TB.MAP.ITEMS 18509 . 18873) (TB.MAP.DELETED.ITEMS 18875 . 19322) (TB.MAP.SELECTED.ITEMS 19324
|
||||
. 19931) (TB.FIND.ITEM 19933 . 20806) (TB.ITEM.SELECTED? 20808 . 20949) (TB.ITEM.DELETED? 20951 .
|
||||
21090)) (21093 21934 (TB.CLEAR.LINE 21103 . 21515) (TB.USERDATA 21517 . 21783) (TB.WINDOW 21785 .
|
||||
21932)) (21959 32217 (TB.REPAINTFN 21969 . 22380) (TB.RESHAPEFN 22382 . 23220) (TB.SCROLLFN 23222 .
|
||||
23773) (TB.DISPLAY.LINES 23775 . 25032) (TB.PRINT.LINE 25034 . 25554) (TB.FIRST.VISIBLE.ITEM# 25556 .
|
||||
25993) (TB.LAST.VISIBLE.ITEM# 25995 . 26468) (TB.ITEM.VISIBLE? 26470 . 26990) (TB.ITEM.FROM.YCOORD
|
||||
26992 . 27302) (TB.BOTTOM.OF.ITEM 27304 . 27717) (TB.SHOW.DELETION 27719 . 28341) (TB.SHOW.SELECTION
|
||||
28343 . 29112) (TB.UPDATE.DISPLAY 29114 . 31399) (TB.ITEM.UPDATABLE? 31401 . 32215)) (32244 43657 (
|
||||
TB.BUTTONEVENTFN 32254 . 32713) (TB.DO.UNLESS.BUSY 32715 . 33022) (TB.DO.ITEM.SELECTION 33024 . 39098)
|
||||
(TB.CONTIGUOUS.SELP 39100 . 39467) (TB.DECONSIDERRANGE 39469 . 39837) (TB.CONSIDERRANGE 39839 . 40410
|
||||
) (TB.DESELECTRANGE 40412 . 41474) (TB.RECONSIDERRANGE 41476 . 41974) (TB.SELECTRANGE 41976 . 42916) (
|
||||
TB.UNDOSELECTION 42918 . 43195) (TB.FIND.SELECTED.ITEM 43197 . 43420) (TB.REV.FIND.SELECTED.ITEM 43422
|
||||
. 43655)) (43658 45157 (TB.COPYBUTTONEVENTFN 43668 . 44888) (TB.SHOW.COPY.SELECTION 44890 . 45155)) (
|
||||
45192 51499 (TB.BROWSER.BUSY 45202 . 45319) (TB.CLOSE/SHRINK 45321 . 45953) (TB.CLOSEFN 45955 . 46056)
|
||||
(TB.FINISH.CLOSE 46058 . 46711) (TB.FLUSH.WINDOW 46713 . 47240) (TB.SET.FONT 47242 . 49540) (
|
||||
TB.SHRINKFN 49542 . 49645) (TB.EXPANDFN 49647 . 50412) (TB.FIND.PREVIOUS.TAIL 50414 . 51156) (
|
||||
TB.RENUMBER.TAIL 51158 . 51497)) (51521 51894 (TB.PROCESS 51531 . 51892)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
300
library/UNIXCOMM
300
library/UNIXCOMM
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Jul-2022 10:42:46"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNIXCOMM.;6 20326
|
||||
(FILECREATED "11-Oct-2022 10:18:47" {DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;4 14580
|
||||
|
||||
:CHANGES-TO (FNS INITIALIZE-NEW-SHELL-DEVICE)
|
||||
:CHANGES-TO (FNS CREATE-SHELL-STREAM CREATE-PROCESS-STREAM UNIXCOMM-AROUNDEXITFN
|
||||
CREATE-UNIX-SOCKET-STREAM ACCEPT-UNIX-SOCKET-STREAM INITIALIZE-SHELL-DEVICE)
|
||||
(VARS UNIXCOMMCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 3-Jul-2022 16:16:31"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNIXCOMM.;5)
|
||||
:PREVIOUS-DATE " 8-Oct-2022 16:06:36"
|
||||
{DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -26,10 +27,10 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(FNS FORK-SHELL FORK-UNIX UNIX-KILL UNIX-WRITE CREATE-SHELL-STREAM
|
||||
CREATE-PROCESS-STREAM UNIXCOMM-AROUNDEXITFN))
|
||||
[COMS (* ; "Operations on the shell device")
|
||||
(FNS INITIALIZE-NEW-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR-NEW
|
||||
(FNS INITIALIZE-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR-NEW
|
||||
UNIX-STREAM-EOFP-NEW UNIX-STREAM-OUT UNIX-STREAM-CLOSE)
|
||||
(GLOBALVARS *NEW-SHELL-DEVICE*)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-NEW-SHELL-DEVICE))
|
||||
(GLOBALVARS *SHELL-DEVICE*)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE))
|
||||
(ADDVARS (AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN]
|
||||
(COMS (* ;
|
||||
"Stuff for direct manipulation of Unix sockets")
|
||||
@@ -37,14 +38,6 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-CHANNEL)
|
||||
(P (CHECKIMPORTS '(FILEIO LLSUBRS)
|
||||
T)))
|
||||
[COMS
|
||||
(* ;; "Obsolete stuff. This is for pre-Medley1.2, where there wasn't support for buffered input on the shell device")
|
||||
|
||||
(FNS UNIX-BACKFILEPTR UNIX-READ INITIALIZE-SHELL-DEVICE UNIX-STREAM-IN UNIX-STREAM-EOFP
|
||||
UNIX-STREAM-PEEK)
|
||||
(GLOBALVARS *SHELL-DEVICE*)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-PEEKEDCHAR UNIX-LASTCHAR))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE]
|
||||
(PROP FILETYPE UNIXCOMM)))
|
||||
|
||||
|
||||
@@ -108,24 +101,17 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(RETURN LENGTH-WRITTEN])
|
||||
|
||||
(CREATE-SHELL-STREAM
|
||||
[LAMBDA (TERMTYPE COMMAND) (* ; "Edited 21-May-90 15:39 by jrb:")
|
||||
(LET ((CHAN (FORK-SHELL TERMTYPE COMMAND))
|
||||
(SHELL-DEV (if (SUBRCALL UNIX-HANDLECOMM 8)
|
||||
then (* ;
|
||||
"SUBRCALL tests that this is supported")
|
||||
*NEW-SHELL-DEVICE*
|
||||
else *SHELL-DEVICE*)))
|
||||
[LAMBDA (TERMTYPE COMMAND) (* ; "Edited 11-Oct-2022 09:56 by lmm")
|
||||
(* ; "Edited 21-May-90 15:39 by jrb:")
|
||||
(LET ((CHAN (FORK-SHELL TERMTYPE COMMAND)))
|
||||
(COND
|
||||
(CHAN (LET ((STR (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ SHELL-DEV)))
|
||||
DEVICE _ *SHELL-DEVICE*)))
|
||||
(CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
|
||||
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
|
||||
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
STR)
|
||||
STR)
|
||||
(STREAMPROP STR 'SENDSCREENPARAMS (FUNCTION UNIX.SENDSCREENPARAMS))
|
||||
(STREAMPROP STR 'SETDISPLAYTYPE (FUNCTION UNIX.SETDISPLAYTYPE))
|
||||
STR])
|
||||
@@ -133,47 +119,40 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(CREATE-PROCESS-STREAM
|
||||
[LAMBDA (COMM)
|
||||
|
||||
(* ;; "Edited 11-Oct-2022 10:05 by lmm")
|
||||
|
||||
(* ;; "Edited 8-Oct-2022 16:04 by lmm")
|
||||
|
||||
(* ;; "Edited 3-Jul-2022 16:04 by rmk: Removed external format here, the device has the environmental defaultg")
|
||||
|
||||
(* ;; "Edited 26-Jun-2022 13:52 by larry")
|
||||
|
||||
(* ;; "Edited 26-Jun-2022 13:31 by lmm - set external format of shell stream to utf-8 ??")
|
||||
|
||||
(* ;; "Edited 21-May-90 15:39 by jrb:")
|
||||
|
||||
(LET* ((SHELL-DEV (if (AND (BOUNDP '*NEW-SHELL-DEVICE)
|
||||
(SUBRCALL UNIX-HANDLECOMM 8))
|
||||
then (* ;
|
||||
"SUBRCALL tests that this is supported")
|
||||
*NEW-SHELL-DEVICE*
|
||||
else *SHELL-DEVICE*))
|
||||
(STR (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ SHELL-DEV
|
||||
EOLCONVENTION _ LF.EOLC))
|
||||
(CHAN (FORK-UNIX COMM)))
|
||||
(if CHAN
|
||||
then (CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
|
||||
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
|
||||
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
STR)
|
||||
STR
|
||||
else NIL])
|
||||
(LET ((CHAN (FORK-UNIX COMM)))
|
||||
(if CHAN
|
||||
then (LET ((STR (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ *SHELL-DEVICE*
|
||||
EOLCONVENTION _ LF.EOLC)))
|
||||
(CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
STR)
|
||||
STR])
|
||||
|
||||
(UNIXCOMM-AROUNDEXITFN
|
||||
[LAMBDA (EVENT) (* ; "Edited 2-Jul-90 16:35 by jrb:")
|
||||
[LAMBDA (EVENT) (* ; "Edited 11-Oct-2022 10:07 by lmm")
|
||||
|
||||
(* ;;
|
||||
"only using *NEW-SHELL-DEVICE* for creation; *SHELL-DEVICE* -- will cleanup in another pass")
|
||||
(* ; "Edited 2-Jul-90 16:35 by jrb:")
|
||||
(CASE EVENT
|
||||
((AFTERLOGOUT AFTERMAKESYS AFTERSAVEVM AFTERSYSOUT) (for STREAM
|
||||
in (fetch (FDEV OPENFILELST)
|
||||
of *SHELL-DEVICE*)
|
||||
do (CLOSEF STREAM)))
|
||||
((AFTERLOGOUT AFTERMAKESYS AFTERSAVEVM AFTERSYSOUT)
|
||||
(for STREAM in (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*) do (CLOSEF STREAM))
|
||||
(REPLACE (FDEV DEFAULTEXTERNALFORMAT) OF *SHELL-DEVICE* WITH (SYSTEM-EXTERNALFORMAT)))
|
||||
((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT)
|
||||
|
||||
(* ;;
|
||||
"Make sure any Unix sockets get closed here, so their file system handles get closed as well")
|
||||
(* ;;
|
||||
"Make sure any Unix sockets get closed here, so their file system handles get closed as well")
|
||||
|
||||
(for STREAM in (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
when (EQ -3 (SUBRCALL UNIX-HANDLECOMM 14 (UNIX-CHANNEL STREAM)))
|
||||
@@ -186,25 +165,24 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(INITIALIZE-NEW-SHELL-DEVICE
|
||||
[LAMBDA NIL (* ; "Edited 7-Jul-2022 10:41 by rmk")
|
||||
(* ; "Edited 3-Jul-2022 16:04 by rmk")
|
||||
(* ; "Edited 12-Feb-90 17:00 by bvm")
|
||||
(SETQ *NEW-SHELL-DEVICE* (create FDEV
|
||||
FDBINABLE _ T
|
||||
NODIRECTORIES _ T
|
||||
DEVICENAME _ (FUNCTION UNIX-PTY-NEW)
|
||||
BIN _ (FUNCTION \BUFFERED.BIN)
|
||||
BOUT _ (FUNCTION UNIX-STREAM-OUT)
|
||||
PEEKBIN _ (FUNCTION \BUFFERED.PEEKBIN)
|
||||
CLOSEFILE _ (FUNCTION UNIX-STREAM-CLOSE)
|
||||
GETFILEINFO _ (FUNCTION NILL)
|
||||
SETFILEINFO _ (FUNCTION NILL)
|
||||
EOFP _ (FUNCTION UNIX-STREAM-EOFP-NEW)
|
||||
BACKFILEPTR _ (FUNCTION UNIX-BACKFILEPTR-NEW)
|
||||
GETNEXTBUFFER _ (FUNCTION UNIX-GET-NEXT-BUFFER)
|
||||
BLOCKIN _ (FUNCTION \BUFFERED.BINS)
|
||||
DEFAULTEXTERNALFORMAT _ (SYSTEM-EXTERNALFORMAT])
|
||||
(INITIALIZE-SHELL-DEVICE
|
||||
[LAMBDA NIL (* ; "Edited 11-Oct-2022 09:35 by lmm")
|
||||
|
||||
(* ;; "only using for holding open list")
|
||||
(* ; "Edited 3-Jul-2022 16:15 by rmk")
|
||||
(* ; "Edited 14-Dec-88 10:45 by bane")
|
||||
(SETQ *SHELL-DEVICE* (create FDEV
|
||||
NODIRECTORIES _ T
|
||||
DEVICENAME _ 'UNIX-PTY
|
||||
BIN _ 'UNIX-STREAM-IN
|
||||
BOUT _ 'UNIX-STREAM-OUT
|
||||
PEEKBIN _ 'UNIX-STREAM-PEEK
|
||||
CLOSEFILE _ 'UNIX-STREAM-CLOSE
|
||||
GETFILEINFO _ 'NILL
|
||||
SETFILEINFO _ 'NILL
|
||||
EOFP _ 'UNIX-STREAM-EOFP
|
||||
BACKFILEPTR _ 'UNIX-BACKFILEPTR
|
||||
DEFAULTEXTERNALFORMAT _ (SYSTEM-EXTERNALFORMAT])
|
||||
|
||||
(UNIX-GET-NEXT-BUFFER
|
||||
[LAMBDA (STREAM WHATFOR NOERRORFLG) (* ;
|
||||
@@ -279,11 +257,11 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *NEW-SHELL-DEVICE*)
|
||||
(GLOBALVARS *SHELL-DEVICE*)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(INITIALIZE-NEW-SHELL-DEVICE)
|
||||
(INITIALIZE-SHELL-DEVICE)
|
||||
|
||||
|
||||
(ADDTOVAR AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN)
|
||||
@@ -296,25 +274,23 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(CREATE-UNIX-SOCKET-STREAM
|
||||
[LAMBDA (PATHNAME) (* ; "Edited 29-May-90 16:23 by jrb:")
|
||||
(LET [(STR (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ *NEW-SHELL-DEVICE*
|
||||
EOLCONVENTION _ LF.EOLC))
|
||||
(CHAN (SUBRCALL UNIX-HANDLECOMM 12 (\DTEST PATHNAME 'ONED-ARRAY]
|
||||
[LAMBDA (PATHNAME) (* ; "Edited 11-Oct-2022 10:11 by lmm")
|
||||
(* ; "Edited 29-May-90 16:23 by jrb:")
|
||||
(LET [(CHAN (SUBRCALL UNIX-HANDLECOMM 12 (\DTEST PATHNAME 'ONED-ARRAY]
|
||||
(if CHAN
|
||||
then (CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
|
||||
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
|
||||
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
STR)
|
||||
STR
|
||||
else NIL])
|
||||
then (LET ((STR (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ *SHELL-DEVICE*
|
||||
EOLCONVENTION _ LF.EOLC)))
|
||||
(CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
STR)
|
||||
STR])
|
||||
|
||||
(ACCEPT-UNIX-SOCKET-STREAM
|
||||
[LAMBDA (SOCKSTREAM) (* ; "Edited 29-May-90 16:31 by jrb:")
|
||||
[LAMBDA (SOCKSTREAM) (* ; "Edited 11-Oct-2022 10:12 by lmm")
|
||||
(* ; "Edited 29-May-90 16:31 by jrb:")
|
||||
(LET ((CHAN (UNIX-CHANNEL SOCKSTREAM))
|
||||
NEWCHAN)
|
||||
(SELECTQ (SETQ NEWCHAN (SUBRCALL UNIX-HANDLECOMM 13 CHAN))
|
||||
@@ -322,15 +298,12 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
NEWCHAN)
|
||||
(LET ((NEWSTREAM (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ *NEW-SHELL-DEVICE*
|
||||
DEVICE _ *SHELL-DEVICE*
|
||||
EOLCONVENTION _ LF.EOLC)))
|
||||
(CL:SETF (UNIX-CHANNEL NEWSTREAM)
|
||||
NEWCHAN)
|
||||
|
||||
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
|
||||
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
NEWSTREAM)
|
||||
NEWSTREAM)
|
||||
NEWSTREAM])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -345,122 +318,13 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
T)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"Obsolete stuff. This is for pre-Medley1.2, where there wasn't support for buffered input on the shell device"
|
||||
)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(UNIX-BACKFILEPTR
|
||||
[LAMBDA (STREAM) (* ; "Edited 14-Dec-88 09:52 by bane")
|
||||
|
||||
(* ;; "The trick here is to use the existing mechanisms for UNIX-PEEKCHAR")
|
||||
|
||||
(COND
|
||||
((UNIX-PEEKEDCHAR STREAM)
|
||||
(ERROR "Can only back up one character" STREAM))
|
||||
((NOT (UNIX-LASTCHAR STREAM))
|
||||
(ERROR "Can't back up past beginning of stream" STREAM))
|
||||
(T (CL:SETF (UNIX-PEEKEDCHAR STREAM)
|
||||
(UNIX-LASTCHAR STREAM])
|
||||
|
||||
(UNIX-READ
|
||||
[LAMBDA (STREAM NO-ERROR) (* ; "Edited 14-Dec-88 09:18 by bane")
|
||||
(LET* [(CONN (UNIX-CHANNEL STREAM))
|
||||
(CH (AND CONN (SUBRCALL UNIX-HANDLECOMM 2 (\DTEST CONN 'SMALLP)
|
||||
0]
|
||||
(COND
|
||||
((EQ CH T)
|
||||
NIL)
|
||||
[(EQ CH NIL)
|
||||
(COND
|
||||
(NO-ERROR NIL)
|
||||
(T (\EOF.ACTION STREAM]
|
||||
(T (CL:SETF (UNIX-LASTCHAR STREAM)
|
||||
CH])
|
||||
|
||||
(INITIALIZE-SHELL-DEVICE
|
||||
[LAMBDA NIL (* ; "Edited 3-Jul-2022 16:15 by rmk")
|
||||
(* ; "Edited 14-Dec-88 10:45 by bane")
|
||||
(SETQ *SHELL-DEVICE* (create FDEV
|
||||
NODIRECTORIES _ T
|
||||
DEVICENAME _ 'UNIX-PTY
|
||||
BIN _ 'UNIX-STREAM-IN
|
||||
BOUT _ 'UNIX-STREAM-OUT
|
||||
PEEKBIN _ 'UNIX-STREAM-PEEK
|
||||
CLOSEFILE _ 'UNIX-STREAM-CLOSE
|
||||
GETFILEINFO _ 'NILL
|
||||
SETFILEINFO _ 'NILL
|
||||
EOFP _ 'UNIX-STREAM-EOFP
|
||||
BACKFILEPTR _ 'UNIX-BACKFILEPTR
|
||||
DEFAULTEXTERNALFORMAT _ (AND (STRPOS ".UTF-8" (UNIX-GETENV "LANG"))
|
||||
:UTF-8])
|
||||
|
||||
(UNIX-STREAM-IN
|
||||
[LAMBDA (STREAM) (* ; "Edited 9-May-88 15:05 by ")
|
||||
(LET (CH)
|
||||
(if (SETQ CH (UNIX-PEEKEDCHAR STREAM))
|
||||
then (CL:SETF (UNIX-PEEKEDCHAR STREAM)
|
||||
NIL)
|
||||
else (while (NOT (SETQ CH (UNIX-READ STREAM))) do (BLOCK)))
|
||||
CH])
|
||||
|
||||
(UNIX-STREAM-EOFP
|
||||
[LAMBDA (STREAM) (* ; "Edited 2-Apr-90 11:51 by jds")
|
||||
|
||||
(* ;; "EOFP method for unix-shell streams. Notices when there are chars yet to read and doesn't set EOFP.")
|
||||
|
||||
(AND (NOT (UNIX-PEEKEDCHAR STREAM))
|
||||
(LET* [(CONN (UNIX-CHANNEL STREAM))
|
||||
(CH (AND CONN (SUBRCALL UNIX-HANDLECOMM 2 (\DTEST CONN 'SMALLP)
|
||||
0]
|
||||
(COND
|
||||
((EQ CH T)
|
||||
NIL)
|
||||
((EQ CH NIL)
|
||||
T)
|
||||
(T (CL:SETF (UNIX-PEEKEDCHAR STREAM)
|
||||
CH)
|
||||
(CL:SETF (UNIX-LASTCHAR STREAM)
|
||||
CH)
|
||||
NIL])
|
||||
|
||||
(UNIX-STREAM-PEEK
|
||||
[LAMBDA (STREAM NO-ERROR) (* ; "Edited 24-Jun-88 15:07 by drc:")
|
||||
(OR (UNIX-PEEKEDCHAR STREAM)
|
||||
(CL:SETF (UNIX-PEEKEDCHAR STREAM)
|
||||
(UNIX-READ STREAM NO-ERROR])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *SHELL-DEVICE*)
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS UNIX-PEEKEDCHAR MACRO ((STR)
|
||||
(FETCH (STREAM F2) OF STR)))
|
||||
|
||||
(PUTPROPS UNIX-LASTCHAR MACRO ((STR)
|
||||
(FETCH (STREAM F3) OF STR)))
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(INITIALIZE-SHELL-DEVICE)
|
||||
)
|
||||
|
||||
(PUTPROPS UNIXCOMM FILETYPE FAKE-COMPILE-FILE)
|
||||
(PUTPROPS UNIXCOMM FILETYPE COMPILE-FILE)
|
||||
(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2492 8463 (FORK-SHELL 2502 . 3699) (FORK-UNIX 3701 . 3877) (UNIX-KILL 3879 . 4068) (
|
||||
UNIX-WRITE 4070 . 4781) (CREATE-SHELL-STREAM 4783 . 6099) (CREATE-PROCESS-STREAM 6101 . 7560) (
|
||||
UNIXCOMM-AROUNDEXITFN 7562 . 8461)) (8511 13805 (INITIALIZE-NEW-SHELL-DEVICE 8521 . 9920) (
|
||||
UNIX-GET-NEXT-BUFFER 9922 . 12122) (UNIX-BACKFILEPTR-NEW 12124 . 12603) (UNIX-STREAM-EOFP-NEW 12605 .
|
||||
13151) (UNIX-STREAM-OUT 13153 . 13409) (UNIX-STREAM-CLOSE 13411 . 13803)) (14061 15926 (
|
||||
CREATE-UNIX-SOCKET-STREAM 14071 . 14932) (ACCEPT-UNIX-SOCKET-STREAM 14934 . 15924)) (16275 19735 (
|
||||
UNIX-BACKFILEPTR 16285 . 16783) (UNIX-READ 16785 . 17307) (INITIALIZE-SHELL-DEVICE 17309 . 18329) (
|
||||
UNIX-STREAM-IN 18331 . 18707) (UNIX-STREAM-EOFP 18709 . 19483) (UNIX-STREAM-PEEK 19485 . 19733)))))
|
||||
(FILEMAP (NIL (2139 7214 (FORK-SHELL 2149 . 3346) (FORK-UNIX 3348 . 3524) (UNIX-KILL 3526 . 3715) (
|
||||
UNIX-WRITE 3717 . 4428) (CREATE-SHELL-STREAM 4430 . 5314) (CREATE-PROCESS-STREAM 5316 . 6155) (
|
||||
UNIXCOMM-AROUNDEXITFN 6157 . 7212)) (7262 12248 (INITIALIZE-SHELL-DEVICE 7272 . 8363) (
|
||||
UNIX-GET-NEXT-BUFFER 8365 . 10565) (UNIX-BACKFILEPTR-NEW 10567 . 11046) (UNIX-STREAM-EOFP-NEW 11048 .
|
||||
11594) (UNIX-STREAM-OUT 11596 . 11852) (UNIX-STREAM-CLOSE 11854 . 12246)) (12496 14202 (
|
||||
CREATE-UNIX-SOCKET-STREAM 12506 . 13312) (ACCEPT-UNIX-SOCKET-STREAM 13314 . 14200)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Feb-2022 11:10:55" {DSK}<home>larry>medley>library>VTCHAT.;2 21881
|
||||
(FILECREATED " 3-Aug-2022 11:30:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>VTCHAT.;3 21940
|
||||
|
||||
:CHANGES-TO (VARS VTCHATCOMS)
|
||||
:CHANGES-TO (RECORDS VT100SAVE)
|
||||
|
||||
:PREVIOUS-DATE "30-Sep-2021 17:41:51" {DSK}<home>larry>medley>library>VTCHAT.;1)
|
||||
:PREVIOUS-DATE "20-Feb-2022 11:10:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>VTCHAT.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -151,7 +153,7 @@ Copyright (c) 1983-1988, 1990, 1993, 2022 by Venue & Xerox Corporation.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD VT100SAVE (CURSORPOS CHARATTR CHARSET))
|
||||
(RECORD VT100SAVE (CURSORPOS CHARATTR VTSCHARSET))
|
||||
|
||||
(DATATYPE VT100.STATE ((DINGED FLAG)
|
||||
(EATLF FLAG)
|
||||
@@ -261,10 +263,10 @@ Copyright (c) 1983-1988, 1990, 1993, 2022 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS VTCHAT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1675 9741 (VTCHAT.STATE 1685 . 2195) (VTCHAT.HANDLECHARACTER 2197 . 4771) (
|
||||
VTCHAT.SEQUENCE 4773 . 6316) (VTCHAT.DOCOMMAND 6318 . 9739)) (9742 17253 (VTCHAT.ADDRESS 9752 . 10270)
|
||||
(VTCHAT.REVERSE.INDEX 10272 . 10841) (VTCHAT.ATTRIBUTES 10843 . 11229) (VTCHAT.DECLFONT 11231 . 11500
|
||||
) (VTCHAT.CLEARMODES 11502 . 12005) (VTCHAT.SAVE 12007 . 12746) (VTCHAT.RESTORE 12748 . 13455) (
|
||||
VTCHAT.SETMODE 13457 . 14529) (VTCHAT.SETMARGINS 14531 . 15122) (VTCHAT.REPORT 15124 . 15884) (
|
||||
VTCHAT.STATUS 15886 . 17251)))))
|
||||
(FILEMAP (NIL (1731 9797 (VTCHAT.STATE 1741 . 2251) (VTCHAT.HANDLECHARACTER 2253 . 4827) (
|
||||
VTCHAT.SEQUENCE 4829 . 6372) (VTCHAT.DOCOMMAND 6374 . 9795)) (9798 17309 (VTCHAT.ADDRESS 9808 . 10326)
|
||||
(VTCHAT.REVERSE.INDEX 10328 . 10897) (VTCHAT.ATTRIBUTES 10899 . 11285) (VTCHAT.DECLFONT 11287 . 11556
|
||||
) (VTCHAT.CLEARMODES 11558 . 12061) (VTCHAT.SAVE 12063 . 12802) (VTCHAT.RESTORE 12804 . 13511) (
|
||||
VTCHAT.SETMODE 13513 . 14585) (VTCHAT.SETMARGINS 14587 . 15178) (VTCHAT.REPORT 15180 . 15940) (
|
||||
VTCHAT.STATUS 15942 . 17307)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,18 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Feb-2022 12:04:09"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITESEND.;2 100778
|
||||
(FILECREATED "16-Oct-2022 10:02:19" {DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;2 100794
|
||||
|
||||
:CHANGES-TO (FILES LAFITEDECLS)
|
||||
(FNS \SENDMESSAGE.RESTARTABLE \SENDMESSAGE LAFITE.SENDMESSAGE MAKEXXXSUPPORTFORM
|
||||
MAKENEWMESSAGEFORM MAKEANSWERFORM LAFITE.FILL.IN.ANSWER.FORM MAKEFORWARDFORM)
|
||||
:CHANGES-TO (FNS \SENDMESSAGE.RESTARTABLE)
|
||||
|
||||
:PREVIOUS-DATE "30-Sep-2021 22:58:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITESEND.;1)
|
||||
:PREVIOUS-DATE " 7-Feb-2022 12:04:09"
|
||||
{DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
|
||||
Copyright (c) 1984-1990, 1993, 1999-2000, 2021-2022 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LAFITESENDCOMS)
|
||||
@@ -529,7 +526,8 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
|
||||
(RETURN (\SENDMESSAGE.RESTARTABLE FORM TEDITPROPS NIL FORMNAME])
|
||||
|
||||
(\SENDMESSAGE.RESTARTABLE
|
||||
[LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* ; "Edited 7-Feb-2022 11:50 by rmk")
|
||||
[LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* ; "Edited 16-Oct-2022 09:59 by briggs")
|
||||
(* ; "Edited 7-Feb-2022 11:50 by rmk")
|
||||
(* ; "Edited 3-Nov-89 15:06 by bvm")
|
||||
(bind (CURRENTMESSAGE _ FORM)
|
||||
(FIRSTTIME _ T)
|
||||
@@ -558,7 +556,9 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
|
||||
EDITORWINDOW))
|
||||
(push LAFITECURRENTEDITORWINDOWS EDITORWINDOW)
|
||||
(SETQ FIRSTTIME)))
|
||||
[SETQ EDITORRESULT (TEDIT (OPENSTRINGSTREAM FORM)
|
||||
[SETQ EDITORRESULT (TEDIT (CL:IF (STRINGP FORM)
|
||||
(OPENSTRINGSTREAM FORM)
|
||||
FORM)
|
||||
EDITORWINDOW T (APPEND TEDITPROPS (LIST 'FONT LAFITEEDITORFONT]
|
||||
(COND
|
||||
((TTY.PROCESSP) (* ; "give back the keyboard")
|
||||
@@ -1764,31 +1764,31 @@ cc: ~A
|
||||
)
|
||||
)
|
||||
(PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1993 1999 2000
|
||||
2021))
|
||||
2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5539 28516 (DOLAFITESENDINGCOMMAND 5549 . 6039) (\SENDMESSAGE.INITIATE 6041 . 7980) (
|
||||
\SENDMSG.DELIVER 7982 . 8590) (\SENDMSG.EXIT.TEDIT 8592 . 8963) (\SENDMSG.SAVE.FORM 8965 . 10952) (
|
||||
\LAFITE.HEADER.EOF 10954 . 11247) (\LAFITE.INSERT.REPLYTO 11249 . 11857) (\SENDMSG.REPLYTO 11859 .
|
||||
12418) (\SENDMSG.CHANGE.MODE 12420 . 17996) (\SENDMSG.FIND.FIELD 17998 . 18508) (\SENDMESSAGE.PARSE
|
||||
18510 . 19306) (\LAFITE.PREPARE.SEND 19308 . 22141) (\LAFITE.PREPARE.ERROR 22143 . 23325) (
|
||||
\LAFITE.CHOOSE.MSG.FORMAT 23327 . 25968) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25970 . 26895) (
|
||||
\SENDMESSAGE.MENUPROMPT 26897 . 27760) (\SENDMESSAGE.PROMPT 27762 . 28298) (\SENDMESSAGEFAIL 28300 .
|
||||
28514)) (28517 52962 (\SENDMESSAGE 28527 . 29879) (\SENDMESSAGE.RESTARTABLE 29881 . 34865) (
|
||||
\SENDMESSAGE.CLEANUP 34867 . 35083) (\SENDMESSAGE.MAKEWINDOW 35085 . 41258) (MAKELAFITEDELIVERMENU
|
||||
41260 . 41567) (\LAFITE.CLOSEMSG? 41569 . 42519) (\LAFITE.AFTER.DELIVER 42521 . 45840) (
|
||||
\LAFITE.UNSENT.ICON 45842 . 46152) (\LAFITE.FETCH.SUBJECT 46154 . 46954) (LAFITE.SENDMESSAGE 46956 .
|
||||
47849) (\SENDMESSAGE0 47851 . 50715) (LA.ASSURE.PROMPT.WINDOW 50717 . 51614) (\LAFITE.SEND.FAIL 51616
|
||||
. 52087) (\LAFITE.INVALID.RECIPIENTS 52089 . 52547) (\SENDMESSAGE.ABORT 52549 . 52960)) (52994 62907
|
||||
(\OUTBOX.CREATE 53004 . 54467) (\OUTBOX.RESET 54469 . 54962) (\OUTBOX.CLOSEFN 54964 . 55104) (
|
||||
\OUTBOX.REPAINTFN 55106 . 55769) (\OUTBOX.RESHAPEFN 55771 . 57054) (\OUTBOX.SHADEITEM 57056 . 57729) (
|
||||
\OUTBOX.BUTTONFN 57731 . 60579) (\OUTBOX.DISPLAYLINE 60581 . 61075) (\OUTBOX.ADD.ITEM 61077 . 62905))
|
||||
(63203 79611 (\LAFITE.MESSAGEFORM 63213 . 67556) (MAKELAFITESUPPORTFORM 67558 . 67747) (
|
||||
MAKELISPSUPPORTFORM 67749 . 67915) (MAKEXXXSUPPORTFORM 67917 . 71966) (MAKENEWMESSAGEFORM 71968 .
|
||||
72924) (MAKELAFITEPRIVATEFORMSITEMS 72926 . 73354) (\LAFITE.UNCACHE.MESSAGEFORM 73356 . 73809) (
|
||||
\LAFITE.DELETE.MESSAGEFORM 73811 . 74412) (\LAFITE.SELECT.FORM 74414 . 74769) (
|
||||
\LAFITE.DELETE.FORM.INTERNAL 74771 . 75915) (\LAFITE.READ.FORM 75917 . 78654) (\LAFITE.FIND.TEMPLATE
|
||||
78656 . 79609)) (79635 87366 (\LAFITE.ANSWER 79645 . 80050) (\LAFITE.ANSWER.PROC 80052 . 81946) (
|
||||
MAKEANSWERFORM 81948 . 84478) (LA.PRINT.COMMA.LIST 84480 . 84966) (LAFITE.FILL.IN.ANSWER.FORM 84968 .
|
||||
87364)) (87391 93587 (\LAFITE.FORWARD 87401 . 87809) (\LAFITE.FORWARD.PROC 87811 . 89800) (
|
||||
MAKEFORWARDFORM 89802 . 93585)))))
|
||||
(FILEMAP (NIL (5333 28310 (DOLAFITESENDINGCOMMAND 5343 . 5833) (\SENDMESSAGE.INITIATE 5835 . 7774) (
|
||||
\SENDMSG.DELIVER 7776 . 8384) (\SENDMSG.EXIT.TEDIT 8386 . 8757) (\SENDMSG.SAVE.FORM 8759 . 10746) (
|
||||
\LAFITE.HEADER.EOF 10748 . 11041) (\LAFITE.INSERT.REPLYTO 11043 . 11651) (\SENDMSG.REPLYTO 11653 .
|
||||
12212) (\SENDMSG.CHANGE.MODE 12214 . 17790) (\SENDMSG.FIND.FIELD 17792 . 18302) (\SENDMESSAGE.PARSE
|
||||
18304 . 19100) (\LAFITE.PREPARE.SEND 19102 . 21935) (\LAFITE.PREPARE.ERROR 21937 . 23119) (
|
||||
\LAFITE.CHOOSE.MSG.FORMAT 23121 . 25762) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25764 . 26689) (
|
||||
\SENDMESSAGE.MENUPROMPT 26691 . 27554) (\SENDMESSAGE.PROMPT 27556 . 28092) (\SENDMESSAGEFAIL 28094 .
|
||||
28308)) (28311 52973 (\SENDMESSAGE 28321 . 29673) (\SENDMESSAGE.RESTARTABLE 29675 . 34876) (
|
||||
\SENDMESSAGE.CLEANUP 34878 . 35094) (\SENDMESSAGE.MAKEWINDOW 35096 . 41269) (MAKELAFITEDELIVERMENU
|
||||
41271 . 41578) (\LAFITE.CLOSEMSG? 41580 . 42530) (\LAFITE.AFTER.DELIVER 42532 . 45851) (
|
||||
\LAFITE.UNSENT.ICON 45853 . 46163) (\LAFITE.FETCH.SUBJECT 46165 . 46965) (LAFITE.SENDMESSAGE 46967 .
|
||||
47860) (\SENDMESSAGE0 47862 . 50726) (LA.ASSURE.PROMPT.WINDOW 50728 . 51625) (\LAFITE.SEND.FAIL 51627
|
||||
. 52098) (\LAFITE.INVALID.RECIPIENTS 52100 . 52558) (\SENDMESSAGE.ABORT 52560 . 52971)) (53005 62918
|
||||
(\OUTBOX.CREATE 53015 . 54478) (\OUTBOX.RESET 54480 . 54973) (\OUTBOX.CLOSEFN 54975 . 55115) (
|
||||
\OUTBOX.REPAINTFN 55117 . 55780) (\OUTBOX.RESHAPEFN 55782 . 57065) (\OUTBOX.SHADEITEM 57067 . 57740) (
|
||||
\OUTBOX.BUTTONFN 57742 . 60590) (\OUTBOX.DISPLAYLINE 60592 . 61086) (\OUTBOX.ADD.ITEM 61088 . 62916))
|
||||
(63214 79622 (\LAFITE.MESSAGEFORM 63224 . 67567) (MAKELAFITESUPPORTFORM 67569 . 67758) (
|
||||
MAKELISPSUPPORTFORM 67760 . 67926) (MAKEXXXSUPPORTFORM 67928 . 71977) (MAKENEWMESSAGEFORM 71979 .
|
||||
72935) (MAKELAFITEPRIVATEFORMSITEMS 72937 . 73365) (\LAFITE.UNCACHE.MESSAGEFORM 73367 . 73820) (
|
||||
\LAFITE.DELETE.MESSAGEFORM 73822 . 74423) (\LAFITE.SELECT.FORM 74425 . 74780) (
|
||||
\LAFITE.DELETE.FORM.INTERNAL 74782 . 75926) (\LAFITE.READ.FORM 75928 . 78665) (\LAFITE.FIND.TEMPLATE
|
||||
78667 . 79620)) (79646 87377 (\LAFITE.ANSWER 79656 . 80061) (\LAFITE.ANSWER.PROC 80063 . 81957) (
|
||||
MAKEANSWERFORM 81959 . 84489) (LA.PRINT.COMMA.LIST 84491 . 84977) (LAFITE.FILL.IN.ANSWER.FORM 84979 .
|
||||
87375)) (87402 93598 (\LAFITE.FORWARD 87412 . 87820) (\LAFITE.FORWARD.PROC 87822 . 89811) (
|
||||
MAKEFORWARDFORM 89813 . 93596)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Jul-2022 17:00:01"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;1 27141
|
||||
(FILECREATED "26-Jul-2022 10:35:13" {DSK}<home>larry>medley>library>tedit>TEDIT-PCTREE.;2 26909
|
||||
|
||||
:PREVIOUS-DATE "14-Jul-2022 11:08:10"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-PCTREE.;2)
|
||||
:CHANGES-TO (FNS \INSERTTREE)
|
||||
|
||||
:PREVIOUS-DATE "14-Jul-2022 17:00:01" {DSK}<home>larry>medley>library>tedit>TEDIT-PCTREE.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||
@@ -168,8 +168,7 @@
|
||||
1))])
|
||||
|
||||
(\INSERTTREE
|
||||
[LAMBDA (NEW OLD PCNODE NEW-PREVLEN NEW-OLDLEN PREV) (* ; "Edited 21-Jun-2022 23:39 by larry")
|
||||
(* ;
|
||||
[LAMBDA (NEW OLD PCNODE NEW-PREVLEN NEW-OLDLEN PREV) (* ;
|
||||
"Edited 21-Mar-95 15:29 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "inserts NEW in front of OLD in PCNODE. NEW/OLD are either pieces or tree nodes.")
|
||||
@@ -231,8 +230,6 @@
|
||||
(T (\ILLEGAL.ARG NEW)))
|
||||
(SETQ NEWLEN (for I from 0 to NODE-COUNT as ITEM# from 2 by 4
|
||||
sum (\GETBASEFIXP PCNODE ITEM#)))
|
||||
(IF (TYPE? BIGNUM NEWLEN)
|
||||
THEN (HELP NEWLEN " is bignum"))
|
||||
(replace (BTREENODE TOTLEN) of PCNODE with NEWLEN)
|
||||
|
||||
(* ;; " If adding this piece overflows the tree node, split it.")
|
||||
@@ -542,9 +539,9 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2938 22352 (UPDATEPCNODES 2948 . 3917) (FINDPCNODE 3919 . 4155) (\FIRSTNODE 4157 . 4518
|
||||
) (\DELETETREE 4520 . 6985) (\INSERTTREE 6987 . 11551) (\LASTNODE 11553 . 12090) (\MATCHPCS 12092 .
|
||||
12816) (\SPLITTREE 12818 . 19698) (\TEDIT.UPDATETREE 19700 . 21207) (\TEDIT.PIECE-CHNO 21209 . 21791)
|
||||
(\TEDIT.SET-TOTLEN 21793 . 22350)) (22353 24789 (DISPTREE 22363 . 22819) (TREEGRAPHNODE 22821 . 24787)
|
||||
(FILEMAP (NIL (2918 22120 (UPDATEPCNODES 2928 . 3897) (FINDPCNODE 3899 . 4135) (\FIRSTNODE 4137 . 4498
|
||||
) (\DELETETREE 4500 . 6965) (\INSERTTREE 6967 . 11319) (\LASTNODE 11321 . 11858) (\MATCHPCS 11860 .
|
||||
12584) (\SPLITTREE 12586 . 19466) (\TEDIT.UPDATETREE 19468 . 20975) (\TEDIT.PIECE-CHNO 20977 . 21559)
|
||||
(\TEDIT.SET-TOTLEN 21561 . 22118)) (22121 24557 (DISPTREE 22131 . 22587) (TREEGRAPHNODE 22589 . 24555)
|
||||
))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Jul-2022 08:54:12"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;246 128062
|
||||
(FILECREATED " 3-Oct-2022 12:03:37"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;252 128695
|
||||
|
||||
:CHANGES-TO (FNS CDPRINT.COLUMNS)
|
||||
:CHANGES-TO (FNS CDFILES)
|
||||
|
||||
:PREVIOUS-DATE "17-Jul-2022 11:04:12"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;245)
|
||||
:PREVIOUS-DATE "14-Aug-2022 12:13:45"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;250)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -388,7 +388,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(DEFINEQ
|
||||
|
||||
(CDFILES
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 25-Apr-2022 08:42 by rmk")
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 3-Oct-2022 12:03 by rmk")
|
||||
(* ; "Edited 25-Apr-2022 08:42 by rmk")
|
||||
(* ; "Edited 5-Mar-2022 15:05 by rmk")
|
||||
(* ; "Edited 16-Oct-2020 13:42 by rmk:")
|
||||
|
||||
@@ -416,6 +417,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(SETQ EXCLUDEDFILES (LDIFFERENCE EXCLUDEDFILES INCLUDEDFILES))
|
||||
(LET ([INCLUDES (CDFILES.PATS (OR INCLUDEDFILES '*.*]
|
||||
(EXCLUDES (AND EXCLUDEDFILES (CDFILES.PATS EXCLUDEDFILES)))
|
||||
(*UPPER-CASE-FILE-NAMES* NIL)
|
||||
HOST ENUMPAT)
|
||||
(SETQ HOST (FILENAMEFIELD.STRING DIR 'HOST))
|
||||
(SETQ DIR (FILENAMEFIELD.STRING DIR 'DIRECTORY))
|
||||
@@ -1707,7 +1709,11 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
BROWSER)])
|
||||
|
||||
(CDBROWSER.STRINGS
|
||||
[LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 22-Feb-2022 18:30 by rmk")
|
||||
[LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 14-Aug-2022 12:13 by rmk")
|
||||
(* ; "Edited 11-Aug-2022 20:23 by rmk")
|
||||
(* ; "Edited 25-Jul-2022 15:31 by rmk")
|
||||
(* ; "Edited 20-Jul-2022 21:14 by rmk")
|
||||
(* ; "Edited 22-Feb-2022 18:30 by rmk")
|
||||
(* ; "Edited 14-Dec-2021 21:03 by rmk")
|
||||
(* ; "Edited 8-Dec-2021 11:22 by rmk")
|
||||
(* ; "Edited 27-Nov-2021 21:37 by rmk:")
|
||||
@@ -1756,7 +1762,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(* ;; "Stick a blank object between")
|
||||
|
||||
(SETQ PAIRS (NCONC (DREVERSE L2R)
|
||||
(LIST "")
|
||||
[COPY '(("")
|
||||
(""]
|
||||
(DREVERSE R2L)))))
|
||||
(CL:WHEN COLHEADERS
|
||||
(PUSH PAIRS (LIST COLHEADERS)))
|
||||
@@ -2150,25 +2157,25 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
|
||||
2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2632 22189 (COMPAREDIRECTORIES 2642 . 7475) (COMPAREDIRECTORIES.INFOS 7477 . 10351) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10353 . 13738) (CDENTRIES.SELECT 13740 . 18515) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18517 . 19423) (MATCHNAME 19425 . 20105) (CD.INSURECDVALUE 20107 . 21721
|
||||
) (CD.UPDATEWIDTHS 21723 . 22187)) (22190 31859 (CDFILES 22200 . 27953) (CDFILES.MATCH 27955 . 29580)
|
||||
(CDFILES.PATS 29582 . 31857)) (31860 49681 (CDPRINT 31870 . 34387) (CDPRINT.HEADER 34389 . 35286) (
|
||||
CDPRINT.LINE 35288 . 38520) (CDPRINT.MAXWIDTHS 38522 . 42637) (CDPRINT.COLHEADERS 42639 . 43924) (
|
||||
CDPRINT.COLUMNS 43926 . 49046) (CDTEDIT 49048 . 49679)) (49682 58051 (CDMAP 49692 . 51124) (CDENTRY
|
||||
51126 . 51435) (CDSUBSET 51437 . 52876) (CDMERGE 52878 . 56732) (CDMERGE.COMMON 56734 . 58049)) (58052
|
||||
65590 (BINCOMP 58062 . 62351) (EOLTYPE 62353 . 64915) (EOLTYPE.SHOW 64917 . 65588)) (66118 78645 (
|
||||
FIND-UNCOMPILED-FILES 66128 . 69771) (FIND-UNSOURCED-FILES 69773 . 72157) (FIND-SOURCE-FILES 72159 .
|
||||
73897) (FIND-COMPILED-FILES 73899 . 75776) (FIND-UNLOADED-FILES 75778 . 76631) (FIND-LOADED-FILES
|
||||
76633 . 77061) (FIND-MULTICOMPILED-FILES 77063 . 78643)) (78646 87077 (CREATED-AS 78656 . 83453) (
|
||||
SOURCE-FOR-COMPILED-P 83455 . 86382) (COMPILE-SOURCE-DATE-DIFF 86384 . 87075)) (87078 97384 (
|
||||
FIX-DIRECTORY-DATES 87088 . 90081) (FIX-EQUIV-DATES 90083 . 91608) (COPY-COMPARED-FILES 91610 . 93431)
|
||||
(COPY-MISSING-FILES 93433 . 95590) (COMPILED-ON-SAME-SOURCE 95592 . 97382)) (97578 104924 (CDBROWSER
|
||||
97588 . 101515) (CDBROWSER.STRINGS 101517 . 104922)) (105086 106822 (CD.TABLEITEM 105096 . 105316) (
|
||||
CD.TABLEITEM.PRINTFN 105318 . 105517) (CD.TABLEITEM.COPYFN 105519 . 106577) (
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN 106579 . 106820)) (106823 127478 (CDTABLEBROWSER.WHENSELECTEDFN
|
||||
106833 . 107301) (CD.COMMANDSELECTEDFN 107303 . 112404) (CD-MENUFN 112406 . 116717) (CD-COMPARE-FILES
|
||||
116719 . 120071) (CDBROWSER-COPY 120073 . 123742) (CDBROWSER-DELETE-FILE 123744 . 126957) (CD-SWAPDIRS
|
||||
126959 . 127476)))))
|
||||
(FILEMAP (NIL (2624 22181 (COMPAREDIRECTORIES 2634 . 7467) (COMPAREDIRECTORIES.INFOS 7469 . 10343) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10345 . 13730) (CDENTRIES.SELECT 13732 . 18507) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18509 . 19415) (MATCHNAME 19417 . 20097) (CD.INSURECDVALUE 20099 . 21713
|
||||
) (CD.UPDATEWIDTHS 21715 . 22179)) (22182 32000 (CDFILES 22192 . 28094) (CDFILES.MATCH 28096 . 29721)
|
||||
(CDFILES.PATS 29723 . 31998)) (32001 49822 (CDPRINT 32011 . 34528) (CDPRINT.HEADER 34530 . 35427) (
|
||||
CDPRINT.LINE 35429 . 38661) (CDPRINT.MAXWIDTHS 38663 . 42778) (CDPRINT.COLHEADERS 42780 . 44065) (
|
||||
CDPRINT.COLUMNS 44067 . 49187) (CDTEDIT 49189 . 49820)) (49823 58192 (CDMAP 49833 . 51265) (CDENTRY
|
||||
51267 . 51576) (CDSUBSET 51578 . 53017) (CDMERGE 53019 . 56873) (CDMERGE.COMMON 56875 . 58190)) (58193
|
||||
65731 (BINCOMP 58203 . 62492) (EOLTYPE 62494 . 65056) (EOLTYPE.SHOW 65058 . 65729)) (66259 78786 (
|
||||
FIND-UNCOMPILED-FILES 66269 . 69912) (FIND-UNSOURCED-FILES 69914 . 72298) (FIND-SOURCE-FILES 72300 .
|
||||
74038) (FIND-COMPILED-FILES 74040 . 75917) (FIND-UNLOADED-FILES 75919 . 76772) (FIND-LOADED-FILES
|
||||
76774 . 77202) (FIND-MULTICOMPILED-FILES 77204 . 78784)) (78787 87218 (CREATED-AS 78797 . 83594) (
|
||||
SOURCE-FOR-COMPILED-P 83596 . 86523) (COMPILE-SOURCE-DATE-DIFF 86525 . 87216)) (87219 97525 (
|
||||
FIX-DIRECTORY-DATES 87229 . 90222) (FIX-EQUIV-DATES 90224 . 91749) (COPY-COMPARED-FILES 91751 . 93572)
|
||||
(COPY-MISSING-FILES 93574 . 95731) (COMPILED-ON-SAME-SOURCE 95733 . 97523)) (97719 105557 (CDBROWSER
|
||||
97729 . 101656) (CDBROWSER.STRINGS 101658 . 105555)) (105719 107455 (CD.TABLEITEM 105729 . 105949) (
|
||||
CD.TABLEITEM.PRINTFN 105951 . 106150) (CD.TABLEITEM.COPYFN 106152 . 107210) (
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN 107212 . 107453)) (107456 128111 (CDTABLEBROWSER.WHENSELECTEDFN
|
||||
107466 . 107934) (CD.COMMANDSELECTEDFN 107936 . 113037) (CD-MENUFN 113039 . 117350) (CD-COMPARE-FILES
|
||||
117352 . 120704) (CDBROWSER-COPY 120706 . 124375) (CDBROWSER-DELETE-FILE 124377 . 127590) (CD-SWAPDIRS
|
||||
127592 . 128109)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Feb-2022 11:57:39" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DINFO.;5 65271
|
||||
(FILECREATED " 4-Aug-2022 09:56:25" {DSK}<home>larry>medley>lispusers>DINFO.;2 65548
|
||||
|
||||
:CHANGES-TO (FNS DINFO.UPDATE.TEXT.DISPLAY)
|
||||
:CHANGES-TO (FNS DINFO.UPDATE.FMENU DINFO.UPDATE.MENU.DISPLAY DINFO.UPDATE.HISTORY
|
||||
DINFO.UPDATE.GRAPH.DISPLAY DINFO.LAYOUTGRAPH)
|
||||
|
||||
:PREVIOUS-DATE "21-Jan-2022 23:16:01"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DINFO.;3)
|
||||
:PREVIOUS-DATE " 3-Feb-2022 11:57:39" {DSK}<home>larry>medley>lispusers>DINFO.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -628,10 +628,10 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
(SHOULDNT])
|
||||
|
||||
(DINFO.UPDATE.FMENU
|
||||
[LAMBDA (GRAPH NEW.NODE) (* jow "20-May-86 15:13")
|
||||
|
||||
(* * Update the display of GRAPH's FreeMenu.
|
||||
If NEW.NODE is not specified, use Top node of GRAPH, and change Top node title.)
|
||||
[LAMBDA (GRAPH NEW.NODE) (* jow "20-May-86 15:13")
|
||||
|
||||
(* * Update the display of GRAPH's FreeMenu.
|
||||
If NEW.NODE is not specified, use Top node of GRAPH, and change Top node title.)
|
||||
|
||||
(LET* [(W (fetch (DINFOGRAPH FMENU.WINDOW) of GRAPH))
|
||||
(NODELST (fetch (DINFOGRAPH NODELST) of GRAPH))
|
||||
@@ -712,7 +712,7 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(DINFO.UPDATE.MENU.DISPLAY
|
||||
[LAMBDA (GRAPH NODE) (* drc%: "25-Jan-86 18:20")
|
||||
[LAMBDA (GRAPH NODE) (* drc%: "25-Jan-86 18:20")
|
||||
(LET* [(DINFOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(WINDOW (fetch (DINFOGRAPH SUBNODE.MENU.WINDOW) of GRAPH))
|
||||
[CHILDREN (DREVERSE (for ID in (fetch (DINFONODE CHILDREN) of NODE)
|
||||
@@ -764,9 +764,8 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
(REDISPLAYW WINDOW)
|
||||
(replace (DINFOGRAPH SUBNODE.MENU.WINDOW) of GRAPH with WINDOW)
|
||||
(LET [(BITS (fetch (REGION BOTTOM) of (WINDOWPROP WINDOW 'REGION]
|
||||
|
||||
(* Slide DINFOW up if our new menu is off the screen)
|
||||
|
||||
(* Slide DINFOW up if our new menu is
|
||||
off the screen)
|
||||
(AND (ILESSP BITS 0)
|
||||
(RELMOVEW DINFOW (create POSITION
|
||||
XCOORD _ 0
|
||||
@@ -780,7 +779,7 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
(CADR ITEM])
|
||||
|
||||
(DINFO.UPDATE.HISTORY
|
||||
[LAMBDA (GRAPH NODE SEL DISPLAY?) (* drc%: "25-Jan-86 18:21")
|
||||
[LAMBDA (GRAPH NODE SEL DISPLAY?) (* drc%: "25-Jan-86 18:21")
|
||||
(LET* ((DINFOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(OLDWINDOW (fetch (DINFOGRAPH HISTORY.MENU.WINDOW) of GRAPH))
|
||||
(OLDITEMS (fetch (DINFOGRAPH HISTORY.ITEMS) of GRAPH))
|
||||
@@ -839,17 +838,15 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(DINFO.UPDATE.GRAPH.DISPLAY
|
||||
[LAMBDA (DINFO.GRAPH NODE FORCE?) (* drc%: "27-Jan-86 16:19")
|
||||
[LAMBDA (DINFO.GRAPH NODE FORCE?) (* drc%: "27-Jan-86 16:19")
|
||||
(LET [(DINFOW (fetch (DINFOGRAPH WINDOW) of DINFO.GRAPH))
|
||||
(LOCATION (CONS (fetch (DINFONODE PARENT) of NODE)
|
||||
(fetch (DINFONODE CHILDREN) of NODE]
|
||||
(if (AND (NOT FORCE?)
|
||||
(EQUAL LOCATION (fetch (DINFOGRAPH LAST.GRAPH.LOCATION) of DINFO.GRAPH)))
|
||||
then
|
||||
|
||||
(* don't need to relayout grapher display --
|
||||
just change which node is inverted.)
|
||||
|
||||
then (* don't need to relayout grapher
|
||||
display -- just change which node is
|
||||
inverted.)
|
||||
(DINFO.INVERT.NODE (fetch (DINFOGRAPH GRAPH.WINDOW) of DINFO.GRAPH)
|
||||
NODE DINFO.GRAPH)
|
||||
else (DINFO.SHOWGRAPH (DINFO.LAYOUTGRAPH DINFO.GRAPH NODE)
|
||||
@@ -944,7 +941,7 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
else (OPENW WINDOW])
|
||||
|
||||
(DINFO.LAYOUTGRAPH
|
||||
[LAMBDA (DINFO.GRAPH NODE) (* drc%: "25-Jan-86 18:20")
|
||||
[LAMBDA (DINFO.GRAPH NODE) (* drc%: "25-Jan-86 18:20")
|
||||
(LET* [(WINDOW (fetch (DINFOGRAPH WINDOW) of DINFO.GRAPH))
|
||||
(FONT (OR (FONTP (fetch (DINFOGRAPH MENUFONT) of DINFO.GRAPH))
|
||||
MENUFONT))
|
||||
@@ -1115,21 +1112,21 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS DINFO COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4678 6137 (DINFOGRAPHPROP 4678 . 6137)) (7391 24529 (DINFO 7401 . 9015) (DINFO.UPDATE
|
||||
9017 . 11881) (DINFOGRAPH 11883 . 12301) (DINFO.SPECIAL.UPDATE 12303 . 14001) (DINFO.READ.GRAPH 14003
|
||||
. 15858) (DINFO.WRITE.GRAPH 15860 . 16950) (DINFO.SELECT.GRAPH 16952 . 17859) (DINFO.DEFAULT.MENU
|
||||
17861 . 20385) (DINFO.FIND 20387 . 22973) (DINFO.LOOKUP 22975 . 24527)) (24530 27224 (
|
||||
DINFO.READ.KOTO.GRAPH 24540 . 27222)) (27225 29539 (DINFO.SETUP.WINDOW 27235 . 27916) (DINFO.CLOSEFN
|
||||
27918 . 28351) (DINFO.SHRINKFN 28353 . 28549) (DINFO.EXPANDFN 28551 . 29108) (DINFO.ICONFN 29110 .
|
||||
29537)) (29540 40800 (DINFO.ADD.FMENU 29550 . 30645) (DINFO.CREATE.FMENU 30647 . 34596) (
|
||||
DINFO.FMW.CLOSEFN 34598 . 35443) (DINFO.FMENU.HANDLER 35445 . 36084) (DINFO.UPDATE.FMENU 36086 . 38291
|
||||
) (DINFO.TOGGLE.MENU 38293 . 38883) (DINFO.TOGGLE.GRAPH 38885 . 39384) (DINFO.TOGGLE.HISTORY 39386 .
|
||||
39930) (DINFO.TOGGLE.TEXT 39932 . 40798)) (40801 48499 (DINFO.UPDATE.MENU.DISPLAY 40811 . 44831) (
|
||||
DINFO.UPDATE.FROM.MENU 44833 . 45132) (DINFO.UPDATE.HISTORY 45134 . 47668) (DINFO.HISTORIC.UPDATE
|
||||
47670 . 48497)) (48500 58666 (DINFO.UPDATE.GRAPH.DISPLAY 48510 . 49828) (DINFO.UPDATE.FROM.GRAPH 49830
|
||||
. 50273) (DINFO.GET.GRAPH.WINDOW 50275 . 50860) (DINFO.CREATE.GRAPH.WINDOW 50862 . 51979) (
|
||||
DINFO.SHOWGRAPH 51981 . 53706) (DINFO.INVERT.NODE 53708 . 55096) (DINFO.LAYOUTGRAPH 55098 . 58664)) (
|
||||
58667 64610 (DINFO.UPDATE.TEXT.DISPLAY 58677 . 60625) (DINFO.TITLEMENUFN 60627 . 61752) (
|
||||
DINFO.OPENTEXTSTREAM 61754 . 62970) (DINFO.SHOWSEL 62972 . 63705) (DINFO.GET.FILENAME 63707 . 64608)))
|
||||
(FILEMAP (NIL (4744 6203 (DINFOGRAPHPROP 4744 . 6203)) (7457 24595 (DINFO 7467 . 9081) (DINFO.UPDATE
|
||||
9083 . 11947) (DINFOGRAPH 11949 . 12367) (DINFO.SPECIAL.UPDATE 12369 . 14067) (DINFO.READ.GRAPH 14069
|
||||
. 15924) (DINFO.WRITE.GRAPH 15926 . 17016) (DINFO.SELECT.GRAPH 17018 . 17925) (DINFO.DEFAULT.MENU
|
||||
17927 . 20451) (DINFO.FIND 20453 . 23039) (DINFO.LOOKUP 23041 . 24593)) (24596 27290 (
|
||||
DINFO.READ.KOTO.GRAPH 24606 . 27288)) (27291 29605 (DINFO.SETUP.WINDOW 27301 . 27982) (DINFO.CLOSEFN
|
||||
27984 . 28417) (DINFO.SHRINKFN 28419 . 28615) (DINFO.EXPANDFN 28617 . 29174) (DINFO.ICONFN 29176 .
|
||||
29603)) (29606 40850 (DINFO.ADD.FMENU 29616 . 30711) (DINFO.CREATE.FMENU 30713 . 34662) (
|
||||
DINFO.FMW.CLOSEFN 34664 . 35509) (DINFO.FMENU.HANDLER 35511 . 36150) (DINFO.UPDATE.FMENU 36152 . 38341
|
||||
) (DINFO.TOGGLE.MENU 38343 . 38933) (DINFO.TOGGLE.GRAPH 38935 . 39434) (DINFO.TOGGLE.HISTORY 39436 .
|
||||
39980) (DINFO.TOGGLE.TEXT 39982 . 40848)) (40851 48646 (DINFO.UPDATE.MENU.DISPLAY 40861 . 44982) (
|
||||
DINFO.UPDATE.FROM.MENU 44984 . 45283) (DINFO.UPDATE.HISTORY 45285 . 47815) (DINFO.HISTORIC.UPDATE
|
||||
47817 . 48644)) (48647 58943 (DINFO.UPDATE.GRAPH.DISPLAY 48657 . 50109) (DINFO.UPDATE.FROM.GRAPH 50111
|
||||
. 50554) (DINFO.GET.GRAPH.WINDOW 50556 . 51141) (DINFO.CREATE.GRAPH.WINDOW 51143 . 52260) (
|
||||
DINFO.SHOWGRAPH 52262 . 53987) (DINFO.INVERT.NODE 53989 . 55377) (DINFO.LAYOUTGRAPH 55379 . 58941)) (
|
||||
58944 64887 (DINFO.UPDATE.TEXT.DISPLAY 58954 . 60902) (DINFO.TITLEMENUFN 60904 . 62029) (
|
||||
DINFO.OPENTEXTSTREAM 62031 . 63247) (DINFO.SHOWSEL 63249 . 63982) (DINFO.GET.FILENAME 63984 . 64885)))
|
||||
))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
335
lispusers/GITFNS
335
lispusers/GITFNS
@@ -1,12 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Jul-2022 21:45:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;428 113994
|
||||
(FILECREATED " 1-Oct-2022 12:14:04" {WMEDLEY}<lispusers>GITFNS.;5 118357
|
||||
|
||||
:CHANGES-TO (FNS GIT-MAKE-BRANCH)
|
||||
:CHANGES-TO (FNS GIT-INIT)
|
||||
|
||||
:PREVIOUS-DATE "18-Jul-2022 09:53:48"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;427)
|
||||
:PREVIOUS-DATE "29-Sep-2022 10:52:34" {DSK}<home>frank>il>medley>wmedley>lispusers>GITFNS.;4)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -23,24 +21,29 @@
|
||||
|
||||
(* ;; "GIT projects")
|
||||
|
||||
(COMS (FNS GIT-CLONEP GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PROJECT-PATH
|
||||
(COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PROJECT-PATH
|
||||
FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH GIT-MAINBRANCH?)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS GIT-PROJECT))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS GIT-PROJECT PULLREQUEST))
|
||||
(INITVARS (GIT-DEFAULT-PROJECT 'MEDLEY)
|
||||
[GIT-DEFAULT-PROJECTS '((MEDLEY T T
|
||||
(EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/
|
||||
tmp/ fontsold/ clos/ cltl2/)
|
||||
(greetfiles scripts sources library lispusers
|
||||
internal doctools rooms))
|
||||
(NOTECARDS T T)
|
||||
(LOOPS T T)
|
||||
(TEST T T]
|
||||
(GIT-PROJECTS NIL)))
|
||||
(P (GIT-MAKE-PROJECT 'MEDLEY T T '(EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/
|
||||
fontsold/ clos/ cltl2/)
|
||||
'(greetfiles scripts sources library lispusers))
|
||||
(GIT-MAKE-PROJECT 'NOTECARDS T T '(online/))
|
||||
(GIT-MAKE-PROJECT 'LOOPS T T)
|
||||
(GIT-MAKE-PROJECT 'TEST T T))
|
||||
(P (GIT-INIT))
|
||||
(ADDVARS (AROUNDEXITFNS GIT-INIT))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Lisp exec commands")
|
||||
|
||||
(INITVARS (GIT-MERGE-COMPARES T))
|
||||
(INITVARS (GIT-MERGE-COMPARES T)
|
||||
(GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
|
||||
(COMMANDS gwc bbc prc cob b? cdg cdw)
|
||||
|
||||
(* ;; "")
|
||||
@@ -145,8 +148,20 @@
|
||||
THEN NIL
|
||||
ELSE (ERROR "NOT A GIT CLONE" HOST/DIR])
|
||||
|
||||
(GIT-INIT
|
||||
[LAMBDA (EVENT) (* ; "Edited 1-Oct-2022 12:13 by FGH")
|
||||
(* ; "Edited 8-Aug-2022 21:52 by lmm")
|
||||
(SELECTQ EVENT
|
||||
((NIL AFTERMAKESYS AFTERSYSOUT)
|
||||
(SETQ GIT-PROJECTS NIL)
|
||||
(for X in GIT-DEFAULT-PROJECTS do (APPLY (FUNCTION GIT-MAKE-PROJECT)
|
||||
X))
|
||||
NIL)
|
||||
NIL])
|
||||
|
||||
(GIT-MAKE-PROJECT
|
||||
[LAMBDA (PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
(* ; "Edited 11-Aug-2022 17:54 by rmk")
|
||||
(* ; "Edited 13-Jul-2022 13:47 by rmk")
|
||||
(* ; "Edited 6-Jul-2022 19:34 by rmk")
|
||||
(* ; "Edited 17-May-2022 17:08 by rmk")
|
||||
@@ -172,7 +187,10 @@
|
||||
|
||||
(SETQ PROJECTNAME (U-CASE (MKATOM PROJECTNAME)))
|
||||
(CL:WHEN (MEMB PROJECTPATH '(NIL T))
|
||||
[SETQ PROJECTPATH (OR (GIT-CLONEP (UNIX-GETENV PROJECTNAME)
|
||||
[SETQ PROJECTPATH (OR (GIT-CLONEP (MEDLEYDIR (L-CASE PROJECTNAME)
|
||||
NIL NIL T)
|
||||
T)
|
||||
(GIT-CLONEP (UNIX-GETENV PROJECTNAME)
|
||||
T)
|
||||
(GIT-CLONEP (UNIX-GETENV (PACK* PROJECTNAME 'DIR))
|
||||
T)
|
||||
@@ -191,21 +209,21 @@
|
||||
'DIRECTORY
|
||||
'RETURN))
|
||||
T))
|
||||
(SETQ CLONEPATH (IF (GIT-CLONEP PROJECTPATH T T)
|
||||
ELSEIF (SETQ GITPATH (GIT-PROJECT-PATH PROJECTNAME PROJECTPATH))
|
||||
THEN (SETQ PROJECTPATH GITPATH)
|
||||
(SETQ CLONEPATH (if (GIT-CLONEP PROJECTPATH T T)
|
||||
elseif (SETQ GITPATH (GIT-PROJECT-PATH PROJECTNAME PROJECTPATH))
|
||||
then (SETQ PROJECTPATH GITPATH)
|
||||
(GIT-CLONEP PROJECTPATH NIL T)
|
||||
ELSE (ERROR "Can't find GIT clone for" PROJECTPATH)))
|
||||
else (ERROR "Can't find GIT clone for" PROJECTPATH)))
|
||||
(CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY
|
||||
CLONEPATH)))
|
||||
(SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE)
|
||||
(BIND L UNTIL (EOFP STREAM)
|
||||
WHILE (SETQ L (CL:READ-LINE STREAM :EOF-ERROR-P NIL
|
||||
(bind L until (EOFP STREAM)
|
||||
while (SETQ L (CL:READ-LINE STREAM :EOF-ERROR-P NIL
|
||||
:EOF-VALUE NIL))
|
||||
UNLESS (OR (EQ 0 (NCHARS L))
|
||||
(STRPOS "#" L)) COLLECT L))))
|
||||
(SETQ EXCLUSIONS (CL:REMOVE-DUPLICATES (APPEND (FOR E INSIDE EXCLUSIONS
|
||||
COLLECT (MKSTRING E))
|
||||
unless (OR (EQ 0 (NCHARS L))
|
||||
(STRPOS "#" L)) collect L))))
|
||||
(SETQ EXCLUSIONS (CL:REMOVE-DUPLICATES (APPEND (for E inside EXCLUSIONS
|
||||
collect (MKSTRING E))
|
||||
GITIGNORE
|
||||
`("deleted/" "*.sysout"))
|
||||
:TEST
|
||||
@@ -248,14 +266,14 @@
|
||||
T)))
|
||||
(DIRECTORYNAME (TRUEFILENAME WORKINGPATH)
|
||||
T)))
|
||||
[SETQ WORKINGPATH (IF WP
|
||||
THEN (UNSLASHIT WP T)
|
||||
ELSEIF (EQ WORKINGPATH T)
|
||||
THEN NIL
|
||||
ELSE (ERROR (CONCAT "Can't find the working directory "
|
||||
[SETQ WORKINGPATH (if WP
|
||||
then (UNSLASHIT WP T)
|
||||
elseif (EQ WORKINGPATH T)
|
||||
then NIL
|
||||
else (ERROR (CONCAT "Can't find the working directory "
|
||||
(OR WORKINGPATH "")
|
||||
" for " PROJECTNAME]
|
||||
(SETQ PROJECT (CREATE GIT-PROJECT
|
||||
(SETQ PROJECT (create GIT-PROJECT
|
||||
PROJECTNAME _ PROJECTNAME
|
||||
GITHOST _ (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME)
|
||||
PROJECTPATH)
|
||||
@@ -268,7 +286,7 @@
|
||||
DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS)
|
||||
CLONEPATH _ CLONEPATH))
|
||||
(/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS)
|
||||
(CAR (PUSH GIT-PROJECTS (CONS PROJECTNAME]
|
||||
(CAR (push GIT-PROJECTS (CONS PROJECTNAME]
|
||||
PROJECT)
|
||||
PROJECTNAME))])
|
||||
|
||||
@@ -350,8 +368,10 @@
|
||||
MB)])
|
||||
|
||||
(GIT-MAINBRANCH?
|
||||
[LAMBDA (BRANCH PROJECT NOERROR) (* ; "Edited 9-May-2022 15:06 by rmk")
|
||||
(IF (STRING.EQUAL (STRIPWHERE (GIT-MAINBRANCH PROJECT NIL T))
|
||||
[LAMBDA (BRANCH PROJECT NOERROR) (* ; "Edited 9-Aug-2022 10:40 by rmk")
|
||||
(* ; "Edited 9-May-2022 15:06 by rmk")
|
||||
(IF (STRING.EQUAL (STRIPWHERE (GIT-MAINBRANCH PROJECT NIL T)
|
||||
T)
|
||||
(STRIPWHERE BRANCH))
|
||||
ELSEIF NOERROR
|
||||
THEN NIL
|
||||
@@ -361,22 +381,25 @@
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
|
||||
|
||||
(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS))
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)
|
||||
|
||||
(RPAQ? GIT-DEFAULT-PROJECTS
|
||||
'((MEDLEY T T (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
|
||||
(greetfiles scripts sources library lispusers internal doctools rooms))
|
||||
(NOTECARDS T T)
|
||||
(LOOPS T T)
|
||||
(TEST T T)))
|
||||
|
||||
(RPAQ? GIT-PROJECTS NIL)
|
||||
|
||||
(GIT-MAKE-PROJECT 'MEDLEY T T '(EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/
|
||||
cltl2/)
|
||||
'(greetfiles scripts sources library lispusers))
|
||||
(GIT-INIT)
|
||||
|
||||
(GIT-MAKE-PROJECT 'NOTECARDS T T '(online/))
|
||||
|
||||
(GIT-MAKE-PROJECT 'LOOPS T T)
|
||||
|
||||
(GIT-MAKE-PROJECT 'TEST T T)
|
||||
(ADDTOVAR AROUNDEXITFNS GIT-INIT)
|
||||
|
||||
|
||||
|
||||
@@ -390,6 +413,8 @@
|
||||
|
||||
(RPAQ? GIT-MERGE-COMPARES T)
|
||||
|
||||
(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T)
|
||||
|
||||
(DEFCOMMAND gwc (SUBDIR . OTHERS)
|
||||
|
||||
(* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project")
|
||||
@@ -450,8 +475,8 @@
|
||||
(IF PRS
|
||||
THEN (CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT PRS)
|
||||
"Pull requests")))
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES RB (GIT-MAINBRANCH PROJECT)
|
||||
NIL PROJECT))
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT)
|
||||
RB NIL PROJECT))
|
||||
ELSE "No open pull requests")))
|
||||
|
||||
(DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT)
|
||||
@@ -703,9 +728,17 @@
|
||||
NIL])
|
||||
|
||||
(STRIPWHERE
|
||||
[LAMBDA (BRANCH) (* ; "Edited 9-May-2022 14:31 by rmk")
|
||||
[LAMBDA (BRANCH ORIGINTOO) (* ; "Edited 9-Aug-2022 10:39 by rmk")
|
||||
(* ; "Edited 4-Aug-2022 10:31 by rmk")
|
||||
(* ; "Edited 9-May-2022 14:31 by rmk")
|
||||
|
||||
(* ;; "Leave origin/ unless ORIGINTOO")
|
||||
|
||||
(LET ((POS (STRPOS "/" BRANCH)))
|
||||
(CL:IF POS
|
||||
(CL:IF [AND POS (MEMB [L-CASE (MKATOM (SUBSTRING BRANCH 1 (SUB1 POS]
|
||||
(CL:IF ORIGINTOO
|
||||
'(local origin)
|
||||
'(local))]
|
||||
(SUBSTRING BRANCH (ADD1 POS))
|
||||
BRANCH)])
|
||||
)
|
||||
@@ -959,6 +992,10 @@
|
||||
(GIT-BRANCH-DIFF
|
||||
[LAMBDA (BRANCH1 BRANCH2 PROJECT)
|
||||
|
||||
(* ;; "Edited 29-Sep-2022 10:52 by rmk")
|
||||
|
||||
(* ;; "Edited 12-Sep-2022 14:13 by rmk")
|
||||
|
||||
(* ;; "Edited 17-Jul-2022 09:36 by rmk")
|
||||
|
||||
(* ;; "Edited 4-Jun-2022 20:43 by rmk")
|
||||
@@ -973,18 +1010,20 @@
|
||||
(SETQ BRANCH1 (GIT-MAINBRANCH PROJECT)))
|
||||
(CL:UNLESS BRANCH2
|
||||
(SETQ BRANCH2 (GIT-MAINBRANCH PROJECT)))
|
||||
(GIT-REMOTE-UPDATE NIL PROJECT) (* (* ;; "Returns the status (M, R, D, A, C), but not sure what comparison is used for the letters. With --name-only, you just get the list of files in the commit. (GIT-COMMIT-DIFFS gives the commits that differ between 2 branches. But what if a given file shows up in 2 different commits in a sequence? E.g. it was changed and then deleted? For each files we can calculate the sequence of changes and figure out what the net effect is? e.g (file D (R file2) (C file3) A) would say that that file didn't exist at the beginning and doesn't exist at the end, so don't report it?")
|
||||
(GIT-COMMAND (CONCAT
|
||||
"git diff-tree --no-commit-id --name-STATUS -r "
|
||||
COMMIT) NIL NIL PROJECT))
|
||||
(GIT-REMOTE-UPDATE NIL PROJECT)
|
||||
|
||||
(* ;; "We don't use GIT-COMMAND because we want to deal with the warning messages here, to give the option of increasing the rename limit..")
|
||||
|
||||
(PROG (POS LIMIT ERRORFILE RLINES ELINES RESULTFILE)
|
||||
RETRY
|
||||
|
||||
|
||||
(* ;; "Nick previously suggested: %"git diff --name-status -C --find-copies-harder <merge> branch1%", but that brought in too many files. The merge-base seems to match the Git desktop.")
|
||||
|
||||
(SETQ RESULTFILE (GIT-COMMAND-TO-FILE (CONCAT
|
||||
"git diff --name-status -C --find-copies-harder "
|
||||
BRANCH1 " " BRANCH2)
|
||||
"git diff -C --find-copies-harder $(git merge-base "
|
||||
BRANCH1 " " BRANCH2 ") " BRANCH2
|
||||
" --name-status")
|
||||
PROJECT))
|
||||
(SETQ ELINES NIL)
|
||||
(SETQ RLINES NIL)
|
||||
@@ -1062,7 +1101,8 @@
|
||||
NIL NIL PROJECT])
|
||||
|
||||
(GIT-BRANCH-RELATIONS
|
||||
[LAMBDA (BRANCHES BRANCH2 STRIPWHERE PROJECT) (* ; "Edited 29-May-2022 21:59 by rmk")
|
||||
[LAMBDA (BRANCHES BRANCH2 STRIPWHERE PROJECT) (* ; "Edited 4-Aug-2022 10:38 by rmk")
|
||||
(* ; "Edited 29-May-2022 21:59 by rmk")
|
||||
(* ; "Edited 9-May-2022 16:12 by rmk")
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
|
||||
@@ -1070,8 +1110,12 @@
|
||||
|
||||
(LET
|
||||
((MAIN (GIT-MAINBRANCH PROJECT)))
|
||||
(CL:WHEN STRIPWHERE
|
||||
(SETQ MAIN (STRIPWHERE MAIN)))
|
||||
(FOR DTAIL D1 MORE1 MORE2 SUPERSETS EQUALS
|
||||
ON (FOR B IN BRANCHES COLLECT (CONS B (GIT-COMMIT-DIFFS B MAIN PROJECT)))
|
||||
ON (FOR B IN BRANCHES COLLECT (CL:WHEN STRIPWHERE
|
||||
(SETQ B (STRIPWHERE B)))
|
||||
(CONS B (GIT-COMMIT-DIFFS B MAIN PROJECT)))
|
||||
DO
|
||||
(* ;; "For each branch we now have the list of commit identifiers (hexstrings) that they do not share with the main branch.")
|
||||
|
||||
@@ -1208,7 +1252,8 @@
|
||||
NIL])
|
||||
|
||||
(GIT-BRANCHES
|
||||
[LAMBDA (WHERE PROJECT EXCLUDEMERGED) (* ; "Edited 18-Jul-2022 08:11 by rmk")
|
||||
[LAMBDA (WHERE PROJECT EXCLUDEMERGED) (* ; "Edited 9-Aug-2022 10:45 by rmk")
|
||||
(* ; "Edited 18-Jul-2022 08:11 by rmk")
|
||||
(* ; "Edited 8-Jul-2022 10:33 by rmk")
|
||||
(* ; "Edited 23-May-2022 14:25 by rmk")
|
||||
(* ; "Edited 19-May-2022 10:06 by rmk")
|
||||
@@ -1230,6 +1275,8 @@
|
||||
0])]
|
||||
BRANCHES)
|
||||
(SETQ BRANCHES (UNION LOCAL REMOTE))
|
||||
(CL:WHEN (THEREIS B IN BRANCHES SUCHTHAT (STRPOS "HEAD detached" B))
|
||||
(PRINTOUT T "Execute %"git gc%" to eliminate a branch with a detached HEAD" T))
|
||||
(CL:WHEN EXCLUDEMERGED
|
||||
(SETQ BRANCHES (FOR B (MAINBRANCH _ (GIT-MAINBRANCH PROJECT 'LOCAL)) IN BRANCHES
|
||||
WHEN (EQUAL (GIT-COMMAND (CONCAT "git merge-base " B " " MAINBRANCH))
|
||||
@@ -1259,53 +1306,64 @@
|
||||
MENUFONT _ DEFAULTFONT)))])
|
||||
|
||||
(GIT-PRC-MENU
|
||||
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 9-Jul-2022 19:01 by rmk")
|
||||
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk")
|
||||
(* ; "Edited 4-Aug-2022 18:55 by rmk")
|
||||
(* ; "Edited 9-Jul-2022 19:01 by rmk")
|
||||
(* ; "Edited 16-May-2022 19:44 by rmk")
|
||||
(CL:UNLESS PRS
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)))
|
||||
(CL:WHEN PRS
|
||||
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
|
||||
NIL T PROJECT)))
|
||||
(SORT [FOR PR REL LABEL (SUPERSETS _ (CAR RELATIONS))
|
||||
(SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS))
|
||||
(EQUALS _ (CADR RELATIONS)) IN PRS
|
||||
COLLECT (SETQ LABEL (IF [SETQ REL (CAR (CDR (SASSOC (CADDR PR)
|
||||
SUPERSETS]
|
||||
THEN (CONCAT (CADDR PR)
|
||||
" > " REL)
|
||||
ELSEIF [SETQ REL (CAR (CDR (SASSOC (CADDR PR)
|
||||
EQUALS]
|
||||
THEN (CONCAT (CADDR PR)
|
||||
" = " REL)
|
||||
ELSE (CADDR PR)))
|
||||
(LIST (CL:IF (MEMB 'DRAFT PR)
|
||||
COLLECT (SETQ PRNAME (fetch PRNAME of PR))
|
||||
(SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR)
|
||||
" "
|
||||
(IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
|
||||
THEN (CONCAT PRNAME " > " REL)
|
||||
ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS]
|
||||
THEN (CONCAT PRNAME " = " REL)
|
||||
ELSE PRNAME)))
|
||||
(LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR))
|
||||
(CONCAT LABEL " (draft)")
|
||||
LABEL)
|
||||
(GITORIGIN (CADDR PR))
|
||||
(CONCAT " " (CADR PR)
|
||||
(GITORIGIN PRNAME)
|
||||
(CONCAT " " (FETCH PRDESCRIPTION OF PR)
|
||||
" #"
|
||||
(CAR PR]
|
||||
(FETCH PRNUMBER OF PR]
|
||||
T)))])
|
||||
|
||||
(GIT-PULL-REQUESTS
|
||||
[LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 17-Jul-2022 11:12 by rmk")
|
||||
[LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 8-Aug-2022 13:12 by rmk")
|
||||
(* ; "Edited 4-Aug-2022 19:01 by rmk")
|
||||
(* ; "Edited 17-Jul-2022 11:12 by rmk")
|
||||
(* ; "Edited 9-May-2022 16:54 by rmk")
|
||||
(* ; "Edited 25-Feb-2022 09:26 by rmk")
|
||||
(CL:UNLESS (EQ 0 (PROCESS-COMMAND "command -v gh"))
|
||||
(ERROR "gh must be installed in order to enumerate pull requests:"))
|
||||
(FOR LINE TAB1 TAB2 TAB3 VAL IN (GIT-COMMAND "gh pr list" T NIL PROJECT)
|
||||
(FOR LINE PR TAB1 TAB2 TAB3 VAL IN (GIT-COMMAND "gh pr list" T NIL PROJECT)
|
||||
WHEN [AND (SETQ TAB1 (STRPOS " " LINE))
|
||||
(SETQ TAB2 (STRPOS " " LINE (ADD1 TAB1)))
|
||||
(SETQ TAB3 (STRPOS " " LINE (ADD1 TAB2)))
|
||||
(OR INCLUDEDRAFTS (NEQ 'DRAFT (SUBATOM LINE (ADD1 TAB3]
|
||||
COLLECT (IF ALLINFO
|
||||
THEN `[,(SUBATOM LINE 1 (SUB1 TAB1))
|
||||
,(SUBSTRING LINE (ADD1 TAB1)
|
||||
(SUB1 TAB2))
|
||||
,(SUBSTRING LINE (ADD1 TAB2)
|
||||
(SUB1 TAB3))
|
||||
,(SUBATOM LINE (ADD1 TAB3]
|
||||
ELSE (SUBATOM LINE (ADD1 TAB2)
|
||||
(SUB1 TAB3])
|
||||
COLLECT [SETQ PR (IF ALLINFO
|
||||
THEN (CREATE PULLREQUEST
|
||||
PRNUMBER _ (SUBATOM LINE 1 (SUB1 TAB1))
|
||||
PRDESCRIPTION _ (SUBSTRING LINE (ADD1 TAB1)
|
||||
(SUB1 TAB2))
|
||||
PRNAME _ (SUBSTRING LINE (ADD1 TAB2)
|
||||
(SUB1 TAB3))
|
||||
PRSTATUS _ (SUBATOM LINE (ADD1 TAB3)))
|
||||
ELSE (CREATE PULLREQUEST
|
||||
PRNAME _ (SUBSTRING LINE (ADD1 TAB2)
|
||||
(SUB1 TAB3]
|
||||
(CL:WHEN (STRPOS ":" (fetch (PULLREQUEST PRNAME) of PR))
|
||||
(PRINTOUT T "Ignoring PR for forked repo %%%"" (fetch (PULLREQUEST PRNAME)
|
||||
of PR)
|
||||
"%"" T)
|
||||
(GO $$ITERATE))
|
||||
PR])
|
||||
|
||||
(GIT-SHORT-BRANCH-NAME
|
||||
[LAMBDA (BRANCH) (* ; "Edited 22-May-2022 22:36 by rmk")
|
||||
@@ -1479,6 +1537,8 @@
|
||||
[LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT)
|
||||
(DECLARE (USEDFREE FROMGITN))
|
||||
|
||||
(* ;; "Edited 12-Sep-2022 14:58 by rmk")
|
||||
|
||||
(* ;; "Edited 21-May-2022 23:38 by rmk")
|
||||
|
||||
(* ;; "Edited 9-May-2022 14:17 by rmk: Ask git for the files that differ between the branches, copy those files down to local DIR1 and DIR2, return the directories and a list of (dir1-file1 file2) mappings for renamed and copied files.")
|
||||
@@ -1538,8 +1598,8 @@
|
||||
|
||||
(* ;; "For copied files, presumably 2 files are exactly the same. But we hope we can show them on the same line, by virtue of the mapping.")
|
||||
|
||||
(LET ((GFILE (CDR D))
|
||||
F1)
|
||||
[LET ((GFILE (CDR D))
|
||||
F1 F1)
|
||||
|
||||
(* ;; "GFILE is a triple (F2 F1 N )")
|
||||
|
||||
@@ -1548,31 +1608,42 @@
|
||||
(SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE)
|
||||
(CONCAT DIR1 (CADR GFILE))
|
||||
T PROJECT))
|
||||
(IF (EQ (CADDR GFILE)
|
||||
100)
|
||||
THEN
|
||||
(SETQ F2 (GIT-GET-FILE BRANCH2 (CADR GFILE)
|
||||
(CONCAT DIR2 (CADR GFILE))
|
||||
T PROJECT))
|
||||
|
||||
(* ;; "Let the directories figure it out")
|
||||
|
||||
(AND NIL (IF (EQ (CADDR GFILE)
|
||||
100)
|
||||
THEN
|
||||
|
||||
(* ;; "A little tricky to figure out what corresponds to the real file in the mapping, which directory it belongs to. Maybe the first one should always be one that exists, the second may just be a useful name. But we have to know whether to match against INFO1 or INFO2")
|
||||
|
||||
(PUSH MAPPINGS (LIST (FULLNAME F1)
|
||||
(HELP GFILE 100)
|
||||
(PUSH MAPPINGS
|
||||
(LIST (LIST)
|
||||
(FULLNAME F1)
|
||||
(SLASHIT (U-CASE (CONCAT DIR2 (CAR GFILE))
|
||||
)
|
||||
T)
|
||||
(NTHCHAR (CAR D)
|
||||
1)
|
||||
100))
|
||||
ELSE
|
||||
(* ;;
|
||||
ELSE
|
||||
(* ;;
|
||||
"If not a perfect match, then the directory should figure it out")
|
||||
|
||||
(GIT-GET-FILE BRANCH2 (CAR GFILE)
|
||||
(CONCAT DIR2 (CAR GFILE))
|
||||
T PROJECT))))
|
||||
(GIT-GET-FILE BRANCH2 (CAR GFILE)
|
||||
(CONCAT DIR2 (CAR GFILE))
|
||||
T PROJECT])
|
||||
(HELP "UNKNOWN GIT-DIFF TAG" D)))
|
||||
(LIST DIR1 DIR2 MAPPINGS))])
|
||||
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 22-May-2022 22:47 by rmk")
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Sep-2022 14:41 by rmk")
|
||||
(* ; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
(* ; "Edited 22-May-2022 22:47 by rmk")
|
||||
(* ; "Edited 9-May-2022 15:14 by rmk")
|
||||
(* ; "Edited 3-May-2022 23:04 by rmk")
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
@@ -1608,6 +1679,7 @@
|
||||
(FETCH (CDINFO FULLNAME)
|
||||
OF INFO1)
|
||||
FILEDIRCASEARRAY)))]
|
||||
(CL:WHEN MAP (HELP MAP))
|
||||
(CL:WHEN INFO1
|
||||
(CHANGE (FETCH (CDINFO FULLNAME) OF INFO1)
|
||||
(SLASHIT (PACKFILENAME.STRING 'VERSION NIL
|
||||
@@ -1647,7 +1719,7 @@
|
||||
(LIST SHORT1 SHORT2)
|
||||
`(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT
|
||||
,PROJECT)
|
||||
NIL
|
||||
GIT-CDBROWSER-SEPARATE-DIRECTIONS
|
||||
`(Compare See))
|
||||
(SETQ NENTRIES (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE)))
|
||||
(LIST NENTRIES (CL:IF (EQ NENTRIES 1)
|
||||
@@ -1659,6 +1731,8 @@
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||
|
||||
(* ;; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
||||
|
||||
(* ;; "Edited 17-May-2022 17:39 by rmk")
|
||||
@@ -1722,7 +1796,7 @@
|
||||
[CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
|
||||
`(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN
|
||||
GIT-CD-LABELFN PROJECT ,PROJECT)
|
||||
NIL
|
||||
GIT-CDBROWSER-SEPARATE-DIRECTIONS
|
||||
`(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN)
|
||||
,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T)
|
||||
'("" Copy% -> (Delete% -> GIT-CD-MENUFN)))]
|
||||
@@ -1900,7 +1974,8 @@
|
||||
(OR LABEL2 FILE2])
|
||||
|
||||
(GIT-CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 22-May-2022 19:13 by rmk")
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 21-Sep-2022 21:34 by rmk")
|
||||
(* ; "Edited 22-May-2022 19:13 by rmk")
|
||||
(* ; "Edited 8-May-2022 09:26 by rmk")
|
||||
(* ; "Edited 10-Dec-2021 08:52 by rmk")
|
||||
|
||||
@@ -1918,12 +1993,14 @@
|
||||
(|Delete ALL <-|
|
||||
(FLASHWINDOW PWINDOW)
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(CL:WHEN [OR (EQ KEY 'MIDDLE)
|
||||
(EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of " (NAMEFIELD LABEL1
|
||||
T)
|
||||
" ? "]
|
||||
(MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT))
|
||||
(TB.DELETE.ITEM CDBROWSER TBITEM)))
|
||||
(if (NAMEFIELD LABEL1 T)
|
||||
then (CL:WHEN [OR (EQ KEY 'MIDDLE)
|
||||
(EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of "
|
||||
(NAMEFIELD LABEL1 T)
|
||||
" ? "]
|
||||
(MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT))
|
||||
(TB.DELETE.ITEM CDBROWSER TBITEM))
|
||||
else (PRINTOUT T "Nothing to delete")))
|
||||
(Delete% BOTH (FLASHWINDOW PWINDOW)
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT
|
||||
@@ -2134,31 +2211,31 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3603 18135 (GIT-CLONEP 3613 . 4876) (GIT-MAKE-PROJECT 4878 . 12976) (GIT-GET-PROJECT
|
||||
12978 . 14903) (GIT-PROJECT-PATH 14905 . 15949) (FIND-ANCESTOR-DIRECTORY 15951 . 16300) (
|
||||
GIT-FIND-CLONE 16302 . 17383) (GIT-MAINBRANCH 17385 . 17780) (GIT-MAINBRANCH? 17782 . 18133)) (24452
|
||||
27240 (ALLSUBDIRS 24462 . 25748) (MEDLEYSUBDIRS 25750 . 26443) (GITSUBDIRS 26445 . 27238)) (27241
|
||||
32031 (TOGIT 27251 . 28657) (FROMGIT 28659 . 29640) (GIT-DELETE-FILE 29642 . 30488) (
|
||||
MYMEDLEY-DELETE-FILES 30490 . 32029)) (32032 34564 (MYMEDLEYSUBDIR 32042 . 32498) (GITSUBDIR 32500 .
|
||||
32943) (STRIPDIR 32945 . 33316) (STRIPHOST 33318 . 33558) (STRIPNAME 33560 . 34313) (STRIPWHERE 34315
|
||||
. 34562)) (34565 36467 (GFILE4MFILE 34575 . 34938) (MFILE4GFILE 34940 . 35509) (GIT-REPO-FILENAME
|
||||
35511 . 36465)) (36516 46338 (GIT-COMMIT 36526 . 37352) (GIT-PUSH 37354 . 37998) (GIT-PULL 38000 .
|
||||
38612) (GIT-APPROVAL 38614 . 38963) (GIT-GET-FILE 38965 . 40930) (GIT-FILE-EXISTS? 40932 . 41206) (
|
||||
GIT-REMOTE-UPDATE 41208 . 41932) (GIT-REMOTE-ADD 41934 . 42241) (GIT-FILE-DATE 42243 . 43174) (
|
||||
GIT-FILE-HISTORY 43176 . 45110) (GIT-PRINT-FILE-HISTORY 45112 . 46162) (GIT-FETCH 46164 . 46336)) (
|
||||
46368 57100 (GIT-BRANCH-DIFF 46378 . 53162) (GIT-COMMIT-DIFFS 53164 . 53717) (GIT-BRANCH-RELATIONS
|
||||
53719 . 57098)) (57145 67947 (GIT-BRANCH-NUM 57155 . 57728) (GIT-CHECKOUT 57730 . 58789) (
|
||||
GIT-WHICH-BRANCH 58791 . 59089) (GIT-MAKE-BRANCH 59091 . 61304) (GIT-BRANCHES 61306 . 63279) (
|
||||
GIT-BRANCH-EXISTS? 63281 . 63985) (GIT-PICK-BRANCH 63987 . 64315) (GIT-PRC-MENU 64317 . 66065) (
|
||||
GIT-PULL-REQUESTS 66067 . 67333) (GIT-SHORT-BRANCH-NAME 67335 . 67626) (GIT-LONG-NAME 67628 . 67945))
|
||||
(67977 71312 (GIT-MY-CURRENT-BRANCH 67987 . 68357) (GIT-MY-BRANCHP 68359 . 68864) (GIT-MY-NEXT-BRANCH
|
||||
68866 . 69360) (GIT-MY-BRANCHES 69362 . 71310)) (71358 75310 (GIT-ADD-WORKTREE 71368 . 72852) (
|
||||
GIT-REMOVE-WORKTREE 72854 . 73784) (GIT-LIST-WORKTREES 73786 . 74590) (WORKTREEDIR 74592 . 75308)) (
|
||||
75358 105340 (GIT-GET-DIFFERENT-FILES 75368 . 81193) (GIT-BRANCHES-COMPARE-DIRECTORIES 81195 . 87037)
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES 87039 . 91785) (GIT-COMPARE-WORKTREE 91787 . 95765) (GITCDOBJBUTTONFN
|
||||
95767 . 100257) (GIT-CD-LABELFN 100259 . 101341) (GIT-CD-MENUFN 101343 . 103550) (
|
||||
GIT-WORKING-COMPARE-FILES 103552 . 104172) (GIT-BRANCHES-COMPARE-FILES 104174 . 105338)) (105410
|
||||
113927 (CDGITDIR 105420 . 105980) (GIT-COMMAND 105982 . 107540) (GITORIGIN 107542 . 108239) (
|
||||
GIT-INITIALS 108241 . 108545) (GIT-COMMAND-TO-FILE 108547 . 112036) (PROCESS-COMMAND 112038 . 112651)
|
||||
(GIT-RESULT-TO-LINES 112653 . 113260) (STRIPLOCAL 113262 . 113925)))))
|
||||
(FILEMAP (NIL (3905 19378 (GIT-CLONEP 3915 . 5178) (GIT-INIT 5180 . 5692) (GIT-MAKE-PROJECT 5694 .
|
||||
14079) (GIT-GET-PROJECT 14081 . 16006) (GIT-PROJECT-PATH 16008 . 17052) (FIND-ANCESTOR-DIRECTORY 17054
|
||||
. 17403) (GIT-FIND-CLONE 17405 . 18486) (GIT-MAINBRANCH 18488 . 18883) (GIT-MAINBRANCH? 18885 . 19376
|
||||
)) (25826 28614 (ALLSUBDIRS 25836 . 27122) (MEDLEYSUBDIRS 27124 . 27817) (GITSUBDIRS 27819 . 28612)) (
|
||||
28615 33405 (TOGIT 28625 . 30031) (FROMGIT 30033 . 31014) (GIT-DELETE-FILE 31016 . 31862) (
|
||||
MYMEDLEY-DELETE-FILES 31864 . 33403)) (33406 36409 (MYMEDLEYSUBDIR 33416 . 33872) (GITSUBDIR 33874 .
|
||||
34317) (STRIPDIR 34319 . 34690) (STRIPHOST 34692 . 34932) (STRIPNAME 34934 . 35687) (STRIPWHERE 35689
|
||||
. 36407)) (36410 38312 (GFILE4MFILE 36420 . 36783) (MFILE4GFILE 36785 . 37354) (GIT-REPO-FILENAME
|
||||
37356 . 38310)) (38361 48183 (GIT-COMMIT 38371 . 39197) (GIT-PUSH 39199 . 39843) (GIT-PULL 39845 .
|
||||
40457) (GIT-APPROVAL 40459 . 40808) (GIT-GET-FILE 40810 . 42775) (GIT-FILE-EXISTS? 42777 . 43051) (
|
||||
GIT-REMOTE-UPDATE 43053 . 43777) (GIT-REMOTE-ADD 43779 . 44086) (GIT-FILE-DATE 44088 . 45019) (
|
||||
GIT-FILE-HISTORY 45021 . 46955) (GIT-PRINT-FILE-HISTORY 46957 . 48007) (GIT-FETCH 48009 . 48181)) (
|
||||
48213 58806 (GIT-BRANCH-DIFF 48223 . 54563) (GIT-COMMIT-DIFFS 54565 . 55118) (GIT-BRANCH-RELATIONS
|
||||
55120 . 58804)) (58851 71083 (GIT-BRANCH-NUM 58861 . 59434) (GIT-CHECKOUT 59436 . 60495) (
|
||||
GIT-WHICH-BRANCH 60497 . 60795) (GIT-MAKE-BRANCH 60797 . 63010) (GIT-BRANCHES 63012 . 65280) (
|
||||
GIT-BRANCH-EXISTS? 65282 . 65986) (GIT-PICK-BRANCH 65988 . 66316) (GIT-PRC-MENU 66318 . 68321) (
|
||||
GIT-PULL-REQUESTS 68323 . 70469) (GIT-SHORT-BRANCH-NAME 70471 . 70762) (GIT-LONG-NAME 70764 . 71081))
|
||||
(71113 74448 (GIT-MY-CURRENT-BRANCH 71123 . 71493) (GIT-MY-BRANCHP 71495 . 72000) (GIT-MY-NEXT-BRANCH
|
||||
72002 . 72496) (GIT-MY-BRANCHES 72498 . 74446)) (74494 78446 (GIT-ADD-WORKTREE 74504 . 75988) (
|
||||
GIT-REMOVE-WORKTREE 75990 . 76920) (GIT-LIST-WORKTREES 76922 . 77726) (WORKTREEDIR 77728 . 78444)) (
|
||||
78494 109703 (GIT-GET-DIFFERENT-FILES 78504 . 84928) (GIT-BRANCHES-COMPARE-DIRECTORIES 84930 . 91087)
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES 91089 . 95915) (GIT-COMPARE-WORKTREE 95917 . 99895) (GITCDOBJBUTTONFN
|
||||
99897 . 104387) (GIT-CD-LABELFN 104389 . 105471) (GIT-CD-MENUFN 105473 . 107913) (
|
||||
GIT-WORKING-COMPARE-FILES 107915 . 108535) (GIT-BRANCHES-COMPARE-FILES 108537 . 109701)) (109773
|
||||
118290 (CDGITDIR 109783 . 110343) (GIT-COMMAND 110345 . 111903) (GITORIGIN 111905 . 112602) (
|
||||
GIT-INITIALS 112604 . 112908) (GIT-COMMAND-TO-FILE 112910 . 116399) (PROCESS-COMMAND 116401 . 117014)
|
||||
(GIT-RESULT-TO-LINES 117016 . 117623) (STRIPLOCAL 117625 . 118288)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
645
lispusers/HANOI
645
lispusers/HANOI
@@ -1,70 +1,74 @@
|
||||
(FILECREATED "25-Feb-86 19:07:01" {ERIS}<LISPUSERS>KOTO>HANOI.;7 19947
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to: (VARS HANOICOMS)
|
||||
(FILECREATED "21-Aug-2022 18:08:56" {DSK}<home>larry>medley>lispusers>HANOI.;2 22228
|
||||
|
||||
previous date: "17-Feb-86 14:59:01" {ERIS}<LISPUSERS>KOTO>HANOI.;5)
|
||||
:CHANGES-TO (VARS HANOICOMS)
|
||||
|
||||
:PREVIOUS-DATE "25-Feb-86 19:07:01" {DSK}<home>larry>medley>lispusers>HANOI.;1)
|
||||
|
||||
|
||||
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
|
||||
(* ; "
|
||||
Copyright (c) 1982-1986 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT HANOICOMS)
|
||||
|
||||
(RPAQQ HANOICOMS ((FNS DISPLAYPEGSANDRINGS DOHANOI FINDOTHER HANOI HANOIDEMO MOVEDIS MOVERING
|
||||
RINGSHADE SETUPRINGBITMAPS TRACK WHANOI XHANOI)
|
||||
(VARS (HANOIWINDOW))
|
||||
(DECLARE: DONTCOPY (RECORDS PEG RING)
|
||||
(CONSTANTS XRINGSHADE ORINGSHADE XPEGSHADE)
|
||||
(CONSTANTS PEGMIN HANOIMARGIN (MAXVERTSPEED 30)
|
||||
(MAXHORIZSPEED 44))
|
||||
(MACROS PEGN))
|
||||
(VARS EVENRINGSHADE ODDRINGSHADE PEGSHADE)
|
||||
(ALISTS (IDLE.FUNCTIONS Hanoi HanoiUsername))))
|
||||
(RPAQQ HANOICOMS
|
||||
((FNS DISPLAYPEGSANDRINGS DOHANOI FINDOTHER HANOI HANOIDEMO MOVEDIS MOVERING RINGSHADE
|
||||
SETUPRINGBITMAPS TRACK WHANOI XHANOI)
|
||||
(VARS (HANOIWINDOW))
|
||||
(DECLARE%: DONTCOPY (RECORDS PEG RING)
|
||||
(CONSTANTS XRINGSHADE ORINGSHADE XPEGSHADE)
|
||||
(CONSTANTS PEGMIN HANOIMARGIN (MAXVERTSPEED 30)
|
||||
(MAXHORIZSPEED 44))
|
||||
(MACROS PEGN))
|
||||
(VARS EVENRINGSHADE ODDRINGSHADE PEGSHADE)
|
||||
(ALISTS (IDLE.FUNCTIONS Hanoi HanoiUsername))))
|
||||
(DEFINEQ
|
||||
|
||||
(DISPLAYPEGSANDRINGS
|
||||
[LAMBDA (PEGS W) (* edited: " 1-Oct-84 12:41")
|
||||
(* displays the pegs and the rings on them.)
|
||||
(for PEG in PEGS
|
||||
do (\CLEARBM W PEGSHADE (fetch PEGREGION of PEG))
|
||||
(for RING in (fetch RINGS of PEG)
|
||||
do (\CLEARBM W (RINGSHADE (fetch RINGNUMBER of RING))
|
||||
(fetch RINGREGION of RING))
|
||||
(COND
|
||||
((fetch RINGLABEL of RING)
|
||||
(CENTERPRINTINREGION (fetch RINGLABEL of RING)
|
||||
(fetch RINGREGION of RING)
|
||||
W])
|
||||
[LAMBDA (PEGS W) (* edited%: " 1-Oct-84 12:41")
|
||||
(* displays the pegs and the rings on
|
||||
them.)
|
||||
(for PEG in PEGS do (\CLEARBM W PEGSHADE (fetch PEGREGION of PEG))
|
||||
(for RING in (fetch RINGS of PEG)
|
||||
do (\CLEARBM W (RINGSHADE (fetch RINGNUMBER of RING))
|
||||
(fetch RINGREGION of RING))
|
||||
(COND
|
||||
((fetch RINGLABEL of RING)
|
||||
(CENTERPRINTINREGION (fetch RINGLABEL of RING)
|
||||
(fetch RINGREGION of RING)
|
||||
W])
|
||||
|
||||
(DOHANOI
|
||||
[LAMBDA (N SRC DST W) (* lmm " 8-MAR-82 12:05")
|
||||
(COND
|
||||
((EQ N 1)
|
||||
(MOVERING SRC DST W))
|
||||
(T (DOHANOI (SUB1 N)
|
||||
SRC
|
||||
(FINDOTHER SRC DST)
|
||||
W)
|
||||
(MOVERING SRC DST W)
|
||||
(DOHANOI (SUB1 N)
|
||||
(FINDOTHER SRC DST)
|
||||
DST W])
|
||||
[LAMBDA (N SRC DST W) (* lmm " 8-MAR-82 12:05")
|
||||
(COND
|
||||
((EQ N 1)
|
||||
(MOVERING SRC DST W))
|
||||
(T (DOHANOI (SUB1 N)
|
||||
SRC
|
||||
(FINDOTHER SRC DST)
|
||||
W)
|
||||
(MOVERING SRC DST W)
|
||||
(DOHANOI (SUB1 N)
|
||||
(FINDOTHER SRC DST)
|
||||
DST W])
|
||||
|
||||
(FINDOTHER
|
||||
[LAMBDA (S D) (* bas: "10-DEC-80 14:01")
|
||||
(for Z from 1 to 3 thereis (NOT (OR (EQ Z S)
|
||||
(EQ Z D])
|
||||
[LAMBDA (S D) (* bas%: "10-DEC-80 14:01")
|
||||
(for Z from 1 to 3 thereis (NOT (OR (EQ Z S)
|
||||
(EQ Z D])
|
||||
|
||||
(HANOI
|
||||
[LAMBDA (NRINGS WINDOW FONT ONCE) (* lmm " 9-MAR-82 09:52")
|
||||
[LAMBDA (NRINGS WINDOW FONT ONCE) (* lmm " 9-MAR-82 09:52")
|
||||
(WHANOI NRINGS WINDOW FONT ONCE])
|
||||
|
||||
(HANOIDEMO
|
||||
[LAMBDA NIL (* lmm
|
||||
"17-Feb-86 14:58")
|
||||
[LAMBDA NIL (* lmm "17-Feb-86 14:58")
|
||||
(PROG (HANOI.MOUSE.SPEED)
|
||||
(WHANOI 7
|
||||
[COND
|
||||
((TYPENAMEP HANOIWINDOW (QUOTE WINDOW))
|
||||
((TYPENAMEP HANOIWINDOW 'WINDOW)
|
||||
HANOIWINDOW)
|
||||
(T (SETQ HANOIWINDOW
|
||||
(CREATEW (create REGION
|
||||
@@ -75,18 +79,16 @@
|
||||
NIL T])
|
||||
|
||||
(MOVEDIS
|
||||
[LAMBDA (RING DY SX DX W) (* lmm
|
||||
"17-Feb-86 14:58")
|
||||
|
||||
(* moves RING from its position on the source peg whose left is SX to
|
||||
the peg whose left is DX at a height of DY)
|
||||
[LAMBDA (RING DY SX DX W) (* lmm "17-Feb-86 14:58")
|
||||
|
||||
(* moves RING from its position on the source peg whose left is SX to the peg
|
||||
whose left is DX at a height of DY)
|
||||
|
||||
(PROG ((RINGREGION (fetch RINGREGION of RING))
|
||||
RINGWIDTH HORIZWIDTH MOVERIGHTFLG)
|
||||
[COND
|
||||
(HANOI.MOUSE.SPEED (GETMOUSESTATE) (* IPLUS 16 is
|
||||
because cursor can go
|
||||
negative.)
|
||||
(HANOI.MOUSE.SPEED (GETMOUSESTATE) (* IPLUS 16 is because cursor can go
|
||||
negative.)
|
||||
(SETQ VERTSPEED (IMIN (IMAX (IDIFFERENCE 17 (IQUOTIENT LASTMOUSEY 50))
|
||||
1)
|
||||
MAXVERTSPEED))
|
||||
@@ -95,333 +97,298 @@
|
||||
MAXHORIZSPEED]
|
||||
(SETUPRINGBITMAPS RING (SETQ RINGWIDTH (fetch WIDTH of RINGREGION))
|
||||
(SETQ MOVERIGHTFLG (IGREATERP DX SX))
|
||||
W) (* PROG is because
|
||||
FOR loop bug.)
|
||||
W) (* PROG is because FOR loop bug.)
|
||||
(PROG ((I (fetch BOTTOM of RINGREGION))
|
||||
(TOPLIMIT (IDIFFERENCE PEGTOP VERTSPEED)))
|
||||
LP (COND
|
||||
((IGREATERP TOPLIMIT I)
|
||||
(BITBLT UPRINGBM 0 0 W SX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED)
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
(SETQ I (IPLUS VERTSPEED I))
|
||||
(GO LP)))
|
||||
(BITBLT UPRINGBM 0 (IDIFFERENCE I TOPLIMIT)
|
||||
W SX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED)
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE)))
|
||||
'INPUT
|
||||
'REPLACE))
|
||||
(BITBLT TOPUPRINGBM 0 0 W SX PEGTOP RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED)
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
(SETQ HORIZWIDTH (IPLUS RINGWIDTH HORIZSPEED))
|
||||
(for I from (COND
|
||||
(MOVERIGHTFLG SX)
|
||||
(T (IDIFFERENCE SX HORIZSPEED)))
|
||||
(MOVERIGHTFLG SX)
|
||||
(T (IDIFFERENCE SX HORIZSPEED)))
|
||||
to (COND
|
||||
(MOVERIGHTFLG (SUB1 (IDIFFERENCE DX HORIZSPEED)))
|
||||
(T (ADD1 DX))) by (ITIMES (COND
|
||||
((IGREATERP DX SX)
|
||||
1)
|
||||
(T -1))
|
||||
HORIZSPEED)
|
||||
do (BITBLT HORIZRINGBM 0 0 W I (IPLUS PEGTOP VERTSPEED)
|
||||
HORIZWIDTH RINGHEIGHT (QUOTE INPUT)
|
||||
(QUOTE REPLACE)))
|
||||
(MOVERIGHTFLG (SUB1 (IDIFFERENCE DX HORIZSPEED)))
|
||||
(T (ADD1 DX))) by (ITIMES (COND
|
||||
((IGREATERP DX SX)
|
||||
1)
|
||||
(T -1))
|
||||
HORIZSPEED) do (BITBLT HORIZRINGBM 0 0 W I
|
||||
(IPLUS PEGTOP VERTSPEED)
|
||||
HORIZWIDTH RINGHEIGHT 'INPUT
|
||||
'REPLACE))
|
||||
(BITBLT HORIZRINGBM 0 0 W (COND
|
||||
(MOVERIGHTFLG (IDIFFERENCE DX HORIZSPEED))
|
||||
(T DX))
|
||||
(IPLUS PEGTOP VERTSPEED)
|
||||
HORIZWIDTH NIL (QUOTE INPUT)
|
||||
(QUOTE REPLACE)) (* Update the ring
|
||||
region's left)
|
||||
HORIZWIDTH NIL 'INPUT 'REPLACE) (* Update the ring region's left)
|
||||
(replace LEFT of RINGREGION with (IPLUS (fetch LEFT of RINGREGION)
|
||||
(IDIFFERENCE DX SX)))
|
||||
(for I from PEGTOP to (SUB1 (IDIFFERENCE PEGTOP RINGHEIGHT))
|
||||
by (IMINUS VERTSPEED) do (BITBLT TOPDOWNRINGBM NIL NIL W DX I RINGWIDTH
|
||||
(IPLUS RINGHEIGHT VERTSPEED)
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE)))
|
||||
(IDIFFERENCE DX SX)))
|
||||
(for I from PEGTOP to (SUB1 (IDIFFERENCE PEGTOP RINGHEIGHT)) by (IMINUS VERTSPEED)
|
||||
do (BITBLT TOPDOWNRINGBM NIL NIL W DX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED)
|
||||
'INPUT
|
||||
'REPLACE))
|
||||
(BITBLT TOPDOWNRINGBM NIL NIL W DX (IDIFFERENCE PEGTOP RINGHEIGHT)
|
||||
RINGWIDTH
|
||||
(IPLUS RINGHEIGHT VERTSPEED)
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
(PROG [(I (IDIFFERENCE PEGTOP (IPLUS VERTSPEED RINGHEIGHT]
|
||||
LP (COND
|
||||
((IGREATERP DY I) (* blt last ring
|
||||
image)
|
||||
((IGREATERP DY I) (* blt last ring image)
|
||||
(BITBLT DOWNRINGBM 0 0 W DX DY RINGWIDTH (COND
|
||||
((IGREATERP VERTSPEED RINGHEIGHT)
|
||||
(IDIFFERENCE (IPLUS RINGHEIGHT
|
||||
VERTSPEED)
|
||||
(IDIFFERENCE DY I)))
|
||||
(T (IPLUS RINGHEIGHT VERTSPEED)))
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
(RETURN)))
|
||||
(BITBLT DOWNRINGBM 0 0 W DX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED)
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
(SETQ I (IDIFFERENCE I VERTSPEED))
|
||||
(GO LP))
|
||||
(replace BOTTOM of RINGREGION with DY)
|
||||
(RETURN RING])
|
||||
|
||||
(MOVERING
|
||||
[LAMBDA (SRC DST W) (* rrb " 2-AUG-82 17:41")
|
||||
(PROG ([X (fetch RINGREGION of (CAR (fetch RINGS of (PEGN DST]
|
||||
RING)
|
||||
[LAMBDA (SRC DST W) (* rrb " 2-AUG-82 17:41")
|
||||
(PROG ([X (fetch RINGREGION of (CAR (fetch RINGS of (PEGN DST]
|
||||
RING)
|
||||
(push (fetch RINGS of (PEGN DST))
|
||||
(MOVEDIS [SETQ RING (pop (fetch RINGS of (PEGN SRC]
|
||||
(IPLUS (fetch BOTTOM of X)
|
||||
(fetch HEIGHT of X))
|
||||
(TRACK SRC (fetch RINGREGION of RING))
|
||||
(TRACK DST (fetch RINGREGION of RING))
|
||||
W))
|
||||
(BLOCK])
|
||||
(MOVEDIS [SETQ RING (pop (fetch RINGS of (PEGN SRC]
|
||||
(IPLUS (fetch BOTTOM of X)
|
||||
(fetch HEIGHT of X))
|
||||
(TRACK SRC (fetch RINGREGION of RING))
|
||||
(TRACK DST (fetch RINGREGION of RING))
|
||||
W))
|
||||
(BLOCK])
|
||||
|
||||
(RINGSHADE
|
||||
[LAMBDA (RINGN) (* rrb " 9-JUN-81 15:11")
|
||||
(COND
|
||||
((EQ RINGN (QUOTE BASE))
|
||||
PEGSHADE)
|
||||
((ZEROP (LOGAND RINGN 1))
|
||||
EVENRINGSHADE)
|
||||
(T ODDRINGSHADE])
|
||||
[LAMBDA (RINGN) (* rrb " 9-JUN-81 15:11")
|
||||
(COND
|
||||
((EQ RINGN 'BASE)
|
||||
PEGSHADE)
|
||||
((ZEROP (LOGAND RINGN 1))
|
||||
EVENRINGSHADE)
|
||||
(T ODDRINGSHADE])
|
||||
|
||||
(SETUPRINGBITMAPS
|
||||
[LAMBDA (RING RINGWIDTH MOVERIGHTFLG W) (* edited: " 1-Oct-84 12:43")
|
||||
[LAMBDA (RING RINGWIDTH MOVERIGHTFLG W) (* edited%: " 1-Oct-84 12:43")
|
||||
|
||||
(* sets up the ring bitmaps. There are 5 ring bitmaps: up while on peg, up above peg, horizontal, down above peg and
|
||||
down while on peg.)
|
||||
(* sets up the ring bitmaps. There are 5 ring bitmaps%: up while on peg, up above
|
||||
peg, horizontal, down above peg and down while on peg.)
|
||||
|
||||
|
||||
(PROG ((PEGOFFSET (IQUOTIENT (IDIFFERENCE RINGWIDTH PEGWIDTH)
|
||||
2))
|
||||
(RINGREGION (fetch RINGREGION of RING))
|
||||
(RINGN (fetch RINGNUMBER of RING)))
|
||||
(AND FONT (DSPFONT FONT RDEST))
|
||||
(DSPOPERATION (QUOTE ERASE)
|
||||
RDEST)
|
||||
[PROGN (\CLEARBM UPRINGBM)
|
||||
(BITBLT NIL NIL NIL UPRINGBM 0 VERTSPEED RINGWIDTH RINGHEIGHT (QUOTE TEXTURE)
|
||||
(QUOTE REPLACE)
|
||||
(RINGSHADE RINGN)) (* put in peg)
|
||||
(BITBLT NIL NIL NIL UPRINGBM PEGOFFSET 0 PEGWIDTH VERTSPEED (QUOTE TEXTURE)
|
||||
(QUOTE REPLACE)
|
||||
PEGSHADE)
|
||||
(COND
|
||||
((fetch RINGLABEL of RING) (* print in label if there is one.)
|
||||
(DSPDESTINATION UPRINGBM RDEST)
|
||||
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
|
||||
0 VERTSPEED RINGWIDTH RINGHEIGHT RDEST]
|
||||
[PROGN (\CLEARBM TOPUPRINGBM)
|
||||
(BITBLT NIL NIL NIL TOPUPRINGBM 0 VERTSPEED RINGWIDTH RINGHEIGHT (QUOTE TEXTURE)
|
||||
(QUOTE REPLACE)
|
||||
(RINGSHADE RINGN))
|
||||
(COND
|
||||
((fetch RINGLABEL of RING) (* print in label if there is one.)
|
||||
(DSPDESTINATION TOPUPRINGBM RDEST)
|
||||
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
|
||||
0 VERTSPEED RINGWIDTH RINGHEIGHT RDEST]
|
||||
(PROGN (\CLEARBM DOWNRINGBM)
|
||||
(BITBLT NIL NIL NIL DOWNRINGBM 0 0 RINGWIDTH RINGHEIGHT (QUOTE TEXTURE)
|
||||
(QUOTE REPLACE)
|
||||
(RINGSHADE RINGN))
|
||||
(COND
|
||||
((fetch RINGLABEL of RING) (* print in label if there is one.)
|
||||
(DSPDESTINATION DOWNRINGBM RDEST)
|
||||
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
|
||||
0 0 RINGWIDTH RINGHEIGHT RDEST)))
|
||||
(* put in peg)
|
||||
(BITBLT NIL NIL NIL DOWNRINGBM PEGOFFSET RINGHEIGHT PEGWIDTH VERTSPEED (QUOTE
|
||||
TEXTURE)
|
||||
(QUOTE REPLACE)
|
||||
PEGSHADE))
|
||||
[PROGN (\CLEARBM TOPDOWNRINGBM)
|
||||
(BITBLT NIL NIL NIL TOPDOWNRINGBM 0 0 RINGWIDTH RINGHEIGHT (QUOTE TEXTURE)
|
||||
(QUOTE REPLACE)
|
||||
(RINGSHADE RINGN))
|
||||
(COND
|
||||
((fetch RINGLABEL of RING) (* print in label if there is one.)
|
||||
(DSPDESTINATION TOPDOWNRINGBM RDEST)
|
||||
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
|
||||
0 0 RINGWIDTH RINGHEIGHT RDEST]
|
||||
[PROGN (\CLEARBM HORIZRINGBM)
|
||||
(BITBLT NIL NIL NIL HORIZRINGBM (COND
|
||||
(MOVERIGHTFLG HORIZSPEED)
|
||||
(T 0))
|
||||
0 RINGWIDTH RINGHEIGHT (QUOTE TEXTURE)
|
||||
(QUOTE REPLACE)
|
||||
(RINGSHADE RINGN))
|
||||
(COND
|
||||
((fetch RINGLABEL of RING) (* print in label if there is one.)
|
||||
(DSPDESTINATION HORIZRINGBM RDEST)
|
||||
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
|
||||
(COND
|
||||
(MOVERIGHTFLG HORIZSPEED)
|
||||
(T 0))
|
||||
0 RINGWIDTH RINGHEIGHT RDEST]
|
||||
(RETURN])
|
||||
(PROG ((PEGOFFSET (IQUOTIENT (IDIFFERENCE RINGWIDTH PEGWIDTH)
|
||||
2))
|
||||
(RINGREGION (fetch RINGREGION of RING))
|
||||
(RINGN (fetch RINGNUMBER of RING)))
|
||||
(AND FONT (DSPFONT FONT RDEST))
|
||||
(DSPOPERATION 'ERASE RDEST)
|
||||
[PROGN (\CLEARBM UPRINGBM)
|
||||
(BITBLT NIL NIL NIL UPRINGBM 0 VERTSPEED RINGWIDTH RINGHEIGHT 'TEXTURE 'REPLACE
|
||||
(RINGSHADE RINGN)) (* put in peg)
|
||||
(BITBLT NIL NIL NIL UPRINGBM PEGOFFSET 0 PEGWIDTH VERTSPEED 'TEXTURE 'REPLACE
|
||||
PEGSHADE)
|
||||
(COND
|
||||
((fetch RINGLABEL of RING) (* print in label if there is one.)
|
||||
(DSPDESTINATION UPRINGBM RDEST)
|
||||
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
|
||||
0 VERTSPEED RINGWIDTH RINGHEIGHT RDEST]
|
||||
[PROGN (\CLEARBM TOPUPRINGBM)
|
||||
(BITBLT NIL NIL NIL TOPUPRINGBM 0 VERTSPEED RINGWIDTH RINGHEIGHT 'TEXTURE
|
||||
'REPLACE
|
||||
(RINGSHADE RINGN))
|
||||
(COND
|
||||
((fetch RINGLABEL of RING) (* print in label if there is one.)
|
||||
(DSPDESTINATION TOPUPRINGBM RDEST)
|
||||
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
|
||||
0 VERTSPEED RINGWIDTH RINGHEIGHT RDEST]
|
||||
(PROGN (\CLEARBM DOWNRINGBM)
|
||||
(BITBLT NIL NIL NIL DOWNRINGBM 0 0 RINGWIDTH RINGHEIGHT 'TEXTURE 'REPLACE
|
||||
(RINGSHADE RINGN))
|
||||
(COND
|
||||
((fetch RINGLABEL of RING) (* print in label if there is one.)
|
||||
(DSPDESTINATION DOWNRINGBM RDEST)
|
||||
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
|
||||
0 0 RINGWIDTH RINGHEIGHT RDEST)))(* put in peg)
|
||||
(BITBLT NIL NIL NIL DOWNRINGBM PEGOFFSET RINGHEIGHT PEGWIDTH VERTSPEED 'TEXTURE
|
||||
'REPLACE PEGSHADE))
|
||||
[PROGN (\CLEARBM TOPDOWNRINGBM)
|
||||
(BITBLT NIL NIL NIL TOPDOWNRINGBM 0 0 RINGWIDTH RINGHEIGHT 'TEXTURE 'REPLACE
|
||||
(RINGSHADE RINGN))
|
||||
(COND
|
||||
((fetch RINGLABEL of RING) (* print in label if there is one.)
|
||||
(DSPDESTINATION TOPDOWNRINGBM RDEST)
|
||||
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
|
||||
0 0 RINGWIDTH RINGHEIGHT RDEST]
|
||||
[PROGN (\CLEARBM HORIZRINGBM)
|
||||
(BITBLT NIL NIL NIL HORIZRINGBM (COND
|
||||
(MOVERIGHTFLG HORIZSPEED)
|
||||
(T 0))
|
||||
0 RINGWIDTH RINGHEIGHT 'TEXTURE 'REPLACE (RINGSHADE RINGN))
|
||||
(COND
|
||||
((fetch RINGLABEL of RING) (* print in label if there is one.)
|
||||
(DSPDESTINATION HORIZRINGBM RDEST)
|
||||
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
|
||||
(COND
|
||||
(MOVERIGHTFLG HORIZSPEED)
|
||||
(T 0))
|
||||
0 RINGWIDTH RINGHEIGHT RDEST]
|
||||
(RETURN])
|
||||
|
||||
(TRACK
|
||||
[LAMBDA (PN REGION) (* lmm " 8-MAR-82 12:10")
|
||||
(* returns the track offset for ring movement on a
|
||||
peg.)
|
||||
(IPLUS HANOIMARGIN (IPLUS (ITIMES RINGLARGEST (SUB1 PN))
|
||||
(IQUOTIENT (IDIFFERENCE RINGLARGEST (fetch WIDTH of REGION))
|
||||
2])
|
||||
[LAMBDA (PN REGION) (* lmm " 8-MAR-82 12:10")
|
||||
(* returns the track offset for ring
|
||||
movement on a peg.)
|
||||
(IPLUS HANOIMARGIN (IPLUS (ITIMES RINGLARGEST (SUB1 PN))
|
||||
(IQUOTIENT (IDIFFERENCE RINGLARGEST (fetch WIDTH of REGION))
|
||||
2])
|
||||
|
||||
(WHANOI
|
||||
[LAMBDA (RINGS W FONT ONCE) (* lmm " 3-Dec-85 12:51")
|
||||
(* runs hanoi in a region of a displaystream)
|
||||
(PROG ([REGION (DSPCLIPPINGREGION NIL (SETQ W (COND
|
||||
[(NULL W)
|
||||
(OR HANOIWINDOW (SETQ HANOIWINDOW (CREATEW]
|
||||
((WINDOWP W))
|
||||
(T (CREATEW W]
|
||||
[NRINGS (COND
|
||||
((NUMBERP RINGS)
|
||||
RINGS)
|
||||
(T (LENGTH RINGS]
|
||||
(HORIZSPEED 21)
|
||||
(VERTSPEED 17)
|
||||
PEGS RINGBM TOPUPRINGBM RINGLARGEST TOPDOWNRINGBM PEGWIDTH BASEWIDTH RINGHEIGHT
|
||||
MOVEMENTHEIGHT BASEHEIGHT PEGTOP RINGDISPLAYSTREAM HANOIWINDOW RINGDELTA UPRINGBM
|
||||
HORIZRINGBM DOWNRINGBM (RDEST (DSPCREATE)))
|
||||
(DECLARE (SPECVARS . T))
|
||||
(PROG (IMAGEHEIGHT)
|
||||
(SETQ BASEWIDTH (IDIFFERENCE (fetch WIDTH of REGION)
|
||||
(ITIMES HANOIMARGIN 2)))
|
||||
(SETQ RINGLARGEST (IQUOTIENT BASEWIDTH 3))
|
||||
(* RINGDELTA is the difference in peg size on each
|
||||
side.)
|
||||
(COND
|
||||
([ZEROP (SETQ RINGDELTA (IQUOTIENT (IDIFFERENCE RINGLARGEST PEGMIN)
|
||||
(ADD1 (ITIMES NRINGS 2]
|
||||
(HELP "Not enough width for a display.")))
|
||||
[LAMBDA (RINGS W FONT ONCE) (* lmm " 3-Dec-85 12:51")
|
||||
(* runs hanoi in a region of a
|
||||
displaystream)
|
||||
(PROG ([REGION (DSPCLIPPINGREGION NIL (SETQ W (COND
|
||||
[(NULL W)
|
||||
(OR HANOIWINDOW (SETQ HANOIWINDOW (CREATEW]
|
||||
((WINDOWP W))
|
||||
(T (CREATEW W]
|
||||
[NRINGS (COND
|
||||
((NUMBERP RINGS)
|
||||
RINGS)
|
||||
(T (LENGTH RINGS]
|
||||
(HORIZSPEED 21)
|
||||
(VERTSPEED 17)
|
||||
PEGS RINGBM TOPUPRINGBM RINGLARGEST TOPDOWNRINGBM PEGWIDTH BASEWIDTH RINGHEIGHT
|
||||
MOVEMENTHEIGHT BASEHEIGHT PEGTOP RINGDISPLAYSTREAM HANOIWINDOW RINGDELTA UPRINGBM
|
||||
HORIZRINGBM DOWNRINGBM (RDEST (DSPCREATE)))
|
||||
(DECLARE (SPECVARS . T))
|
||||
(PROG (IMAGEHEIGHT)
|
||||
(SETQ BASEWIDTH (IDIFFERENCE (fetch WIDTH of REGION)
|
||||
(ITIMES HANOIMARGIN 2)))
|
||||
(SETQ RINGLARGEST (IQUOTIENT BASEWIDTH 3)) (* RINGDELTA is the difference in peg
|
||||
size on each side.)
|
||||
(COND
|
||||
([ZEROP (SETQ RINGDELTA (IQUOTIENT (IDIFFERENCE RINGLARGEST PEGMIN)
|
||||
(ADD1 (ITIMES NRINGS 2]
|
||||
(HELP "Not enough width for a display.")))
|
||||
|
||||
(* leave one ring width for base, one for top of peg and two above peg for movement. Doesn't really use two heights
|
||||
at top, only one plus VERTSPEED)
|
||||
(* leave one ring width for base, one for top of peg and two above peg for
|
||||
movement. Doesn't really use two heights at top, only one plus VERTSPEED)
|
||||
|
||||
|
||||
(SETQ RINGHEIGHT (IQUOTIENT (SETQ IMAGEHEIGHT (IDIFFERENCE (fetch
|
||||
HEIGHT
|
||||
of REGION)
|
||||
(ITIMES
|
||||
HANOIMARGIN
|
||||
2)))
|
||||
(IPLUS NRINGS 4)))
|
||||
(COND
|
||||
((ZEROP RINGHEIGHT)
|
||||
(HELP "Not enough height for display.")))
|
||||
(SETQ PEGWIDTH (IQUOTIENT (IDIFFERENCE RINGLARGEST (ITIMES RINGDELTA
|
||||
(SUB1 NRINGS)
|
||||
2))
|
||||
3)) (* put extra in base if it comes out closer to
|
||||
pegwidth.)
|
||||
(COND
|
||||
[(IGREATERP PEGWIDTH RINGHEIGHT)
|
||||
(SETQ BASEHEIGHT (IMIN PEGWIDTH (IPLUS RINGHEIGHT
|
||||
(IDIFFERENCE
|
||||
IMAGEHEIGHT
|
||||
(ITIMES (IPLUS NRINGS 4)
|
||||
RINGHEIGHT]
|
||||
(T (SETQ BASEHEIGHT RINGHEIGHT)))
|
||||
(SETQ MOVEMENTHEIGHT (IPLUS [SETQ PEGTOP (IPLUS HANOIMARGIN BASEHEIGHT
|
||||
(ITIMES RINGHEIGHT
|
||||
(ADD1 NRINGS]
|
||||
VERTSPEED))
|
||||
(DSPFONT FONT RDEST)
|
||||
(DSPFONT FONT W)
|
||||
(DSPOPERATION (QUOTE ERASE)
|
||||
RDEST)
|
||||
(DSPOPERATION (QUOTE ERASE)
|
||||
W))
|
||||
[PROG ((BASE (create REGION
|
||||
LEFT _ HANOIMARGIN
|
||||
BOTTOM _ HANOIMARGIN
|
||||
WIDTH _ BASEWIDTH
|
||||
HEIGHT _ BASEHEIGHT)))
|
||||
(SETQ PEGS (for PLEFT from (IPLUS HANOIMARGIN (IQUOTIENT (IDIFFERENCE
|
||||
RINGLARGEST
|
||||
PEGWIDTH)
|
||||
2))
|
||||
by RINGLARGEST as I from 1 to 3
|
||||
collect (create PEG
|
||||
PEGREGION _(create REGION
|
||||
LEFT _ PLEFT
|
||||
BOTTOM _(IPLUS
|
||||
BASEHEIGHT
|
||||
HANOIMARGIN)
|
||||
WIDTH _ PEGWIDTH
|
||||
HEIGHT _(ITIMES
|
||||
RINGHEIGHT
|
||||
(ADD1 NRINGS)))
|
||||
RINGS _(LIST (create RING
|
||||
RINGREGION _ BASE
|
||||
RINGNUMBER _(QUOTE
|
||||
BASE]
|
||||
[PROG [(SOURCEPEG (PEGN 1))
|
||||
(RINGLABELS (COND
|
||||
((LISTP RINGS)
|
||||
(REVERSE RINGS))
|
||||
(T (* collect n NILs as lables.)
|
||||
(for I from 1 to RINGS collect NIL]
|
||||
(for RINGBOTTOM from (IPLUS HANOIMARGIN BASEHEIGHT) by RINGHEIGHT
|
||||
as RINGLEFT from (IPLUS HANOIMARGIN (ITIMES RINGLARGEST (SUB1 1)))
|
||||
by RINGDELTA as I from 0 to (SUB1 NRINGS) as LABEL in RINGLABELS
|
||||
do (push (fetch RINGS of SOURCEPEG)
|
||||
(create RING
|
||||
RINGREGION _(create REGION
|
||||
LEFT _ RINGLEFT
|
||||
BOTTOM _ RINGBOTTOM
|
||||
WIDTH _(IDIFFERENCE
|
||||
RINGLARGEST
|
||||
(ITIMES I 2 RINGDELTA))
|
||||
HEIGHT _ RINGHEIGHT)
|
||||
RINGNUMBER _(ADD1 (IDIFFERENCE NRINGS I))
|
||||
RINGLABEL _ LABEL)))
|
||||
(* allocate bitmaps for ring movement)
|
||||
(SETQ HORIZRINGBM (BITMAPCREATE (IPLUS RINGLARGEST MAXHORIZSPEED)
|
||||
RINGHEIGHT))
|
||||
(SETQ UPRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED)))
|
||||
(SETQ DOWNRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED)))
|
||||
(SETQ TOPUPRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED))
|
||||
)
|
||||
(SETQ TOPDOWNRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT
|
||||
MAXVERTSPEED]
|
||||
(\CLEARBM W)
|
||||
(DISPLAYPEGSANDRINGS PEGS W)
|
||||
(bind (HERE _ 1)
|
||||
(THERE _ 3)
|
||||
do (DOHANOI NRINGS HERE THERE W)
|
||||
(COND
|
||||
(ONCE (RETURN)))
|
||||
(DISMISS 2000)
|
||||
(SETQ HERE (PROG1 THERE (SETQ THERE (FINDOTHER HERE THERE])
|
||||
(SETQ RINGHEIGHT (IQUOTIENT (SETQ IMAGEHEIGHT (IDIFFERENCE (fetch HEIGHT of REGION)
|
||||
(ITIMES HANOIMARGIN 2)))
|
||||
(IPLUS NRINGS 4)))
|
||||
(COND
|
||||
((ZEROP RINGHEIGHT)
|
||||
(HELP "Not enough height for display.")))
|
||||
(SETQ PEGWIDTH (IQUOTIENT (IDIFFERENCE RINGLARGEST (ITIMES RINGDELTA (SUB1 NRINGS)
|
||||
2))
|
||||
3)) (* put extra in base if it comes out
|
||||
closer to pegwidth.)
|
||||
(COND
|
||||
[(IGREATERP PEGWIDTH RINGHEIGHT)
|
||||
(SETQ BASEHEIGHT (IMIN PEGWIDTH (IPLUS RINGHEIGHT (IDIFFERENCE
|
||||
IMAGEHEIGHT
|
||||
(ITIMES (IPLUS NRINGS 4)
|
||||
RINGHEIGHT]
|
||||
(T (SETQ BASEHEIGHT RINGHEIGHT)))
|
||||
(SETQ MOVEMENTHEIGHT (IPLUS [SETQ PEGTOP (IPLUS HANOIMARGIN BASEHEIGHT
|
||||
(ITIMES RINGHEIGHT (ADD1 NRINGS]
|
||||
VERTSPEED))
|
||||
(DSPFONT FONT RDEST)
|
||||
(DSPFONT FONT W)
|
||||
(DSPOPERATION 'ERASE RDEST)
|
||||
(DSPOPERATION 'ERASE W))
|
||||
[PROG ((BASE (create REGION
|
||||
LEFT _ HANOIMARGIN
|
||||
BOTTOM _ HANOIMARGIN
|
||||
WIDTH _ BASEWIDTH
|
||||
HEIGHT _ BASEHEIGHT)))
|
||||
(SETQ PEGS (for PLEFT from (IPLUS HANOIMARGIN (IQUOTIENT (IDIFFERENCE RINGLARGEST
|
||||
PEGWIDTH)
|
||||
2)) by RINGLARGEST as I
|
||||
from 1 to 3
|
||||
collect (create PEG
|
||||
PEGREGION _ (create REGION
|
||||
LEFT _ PLEFT
|
||||
BOTTOM _ (IPLUS BASEHEIGHT
|
||||
HANOIMARGIN)
|
||||
WIDTH _ PEGWIDTH
|
||||
HEIGHT _ (ITIMES RINGHEIGHT
|
||||
(ADD1 NRINGS)))
|
||||
RINGS _ (LIST (create RING
|
||||
RINGREGION _ BASE
|
||||
RINGNUMBER _ 'BASE]
|
||||
[PROG [(SOURCEPEG (PEGN 1))
|
||||
(RINGLABELS (COND
|
||||
((LISTP RINGS)
|
||||
(REVERSE RINGS))
|
||||
(T (* collect n NILs as lables.)
|
||||
(for I from 1 to RINGS collect NIL]
|
||||
(for RINGBOTTOM from (IPLUS HANOIMARGIN BASEHEIGHT) by RINGHEIGHT as RINGLEFT
|
||||
from (IPLUS HANOIMARGIN (ITIMES RINGLARGEST (SUB1 1))) by RINGDELTA as I
|
||||
from 0 to (SUB1 NRINGS) as LABEL in RINGLABELS
|
||||
do (push (fetch RINGS of SOURCEPEG)
|
||||
(create RING
|
||||
RINGREGION _ (create REGION
|
||||
LEFT _ RINGLEFT
|
||||
BOTTOM _ RINGBOTTOM
|
||||
WIDTH _ (IDIFFERENCE RINGLARGEST
|
||||
(ITIMES I 2 RINGDELTA))
|
||||
HEIGHT _ RINGHEIGHT)
|
||||
RINGNUMBER _ (ADD1 (IDIFFERENCE NRINGS I))
|
||||
RINGLABEL _ LABEL))) (* allocate bitmaps for ring movement)
|
||||
(SETQ HORIZRINGBM (BITMAPCREATE (IPLUS RINGLARGEST MAXHORIZSPEED)
|
||||
RINGHEIGHT))
|
||||
(SETQ UPRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED)))
|
||||
(SETQ DOWNRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED)))
|
||||
(SETQ TOPUPRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED)))
|
||||
(SETQ TOPDOWNRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED]
|
||||
(\CLEARBM W)
|
||||
(DISPLAYPEGSANDRINGS PEGS W)
|
||||
(bind (HERE _ 1)
|
||||
(THERE _ 3) do (DOHANOI NRINGS HERE THERE W)
|
||||
(COND
|
||||
(ONCE (RETURN)))
|
||||
(DISMISS 2000)
|
||||
(SETQ HERE (PROG1 THERE
|
||||
(SETQ THERE (FINDOTHER HERE THERE)))])
|
||||
|
||||
(XHANOI
|
||||
[LAMBDA NIL (* lmm " 8-MAR-82 15:59")
|
||||
(PROG ((EVENRINGSHADE XRINGSHADE)
|
||||
(ODDRINGSHADE ORINGSHADE)
|
||||
(PEGSHADE XPEGSHADE))
|
||||
(WHANOI (QUOTE (X E R O X))
|
||||
(QUOTE (0 0 400 280))
|
||||
(FONTCREATE (QUOTE LOGO)
|
||||
24])
|
||||
[LAMBDA NIL (* lmm " 8-MAR-82 15:59")
|
||||
(PROG ((EVENRINGSHADE XRINGSHADE)
|
||||
(ODDRINGSHADE ORINGSHADE)
|
||||
(PEGSHADE XPEGSHADE))
|
||||
(WHANOI '(X E R O X)
|
||||
'(0 0 400 280)
|
||||
(FONTCREATE 'LOGO 24])
|
||||
)
|
||||
|
||||
(RPAQQ HANOIWINDOW NIL)
|
||||
(DECLARE: DONTCOPY
|
||||
[DECLARE: EVAL@COMPILE
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD PEG (PEGREGION RINGS))
|
||||
|
||||
(RECORD RING (RINGREGION RINGNUMBER RINGLABEL))
|
||||
]
|
||||
)
|
||||
|
||||
(DECLARE: EVAL@COMPILE
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ XRINGSHADE 42405)
|
||||
|
||||
@@ -429,10 +396,11 @@
|
||||
|
||||
(RPAQQ XPEGSHADE 65535)
|
||||
|
||||
|
||||
(CONSTANTS XRINGSHADE ORINGSHADE XPEGSHADE)
|
||||
)
|
||||
|
||||
(DECLARE: EVAL@COMPILE
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ PEGMIN 2)
|
||||
|
||||
@@ -442,15 +410,18 @@
|
||||
|
||||
(RPAQQ MAXHORIZSPEED 44)
|
||||
|
||||
|
||||
(CONSTANTS PEGMIN HANOIMARGIN (MAXVERTSPEED 30)
|
||||
(MAXHORIZSPEED 44))
|
||||
(MAXHORIZSPEED 44))
|
||||
)
|
||||
|
||||
(DECLARE: EVAL@COMPILE
|
||||
[PUTPROPS PEGN MACRO ((N)
|
||||
(CAR (SELECTQ N (1 PEGS)
|
||||
(2 (CDR PEGS))
|
||||
(CDDR PEGS]
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PEGN MACRO [(N)
|
||||
(CAR (SELECTQ N
|
||||
(1 PEGS)
|
||||
(2 (CDR PEGS))
|
||||
(CDDR PEGS])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -461,17 +432,13 @@
|
||||
(RPAQQ PEGSHADE 65535)
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS [Hanoi (FUNCTION (LAMBDA (W)
|
||||
(HANOI (UNPACK (QUOTE "Xerox AI Systems"))
|
||||
W
|
||||
(QUOTE (TIMESROMAND 36]
|
||||
[HanoiUsername (FUNCTION (LAMBDA (W)
|
||||
(HANOI (UNPACK (USERNAME NIL T T))
|
||||
W
|
||||
(QUOTE (TIMESROMAND 36])
|
||||
(HANOI (UNPACK "Interlisp.org")
|
||||
W
|
||||
'(TIMESROMAND 36])
|
||||
(PUTPROPS HANOI COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (797 18810 (DISPLAYPEGSANDRINGS 807 . 1479) (DOHANOI 1481 . 1818) (FINDOTHER 1820 . 2022
|
||||
) (HANOI 2024 . 2167) (HANOIDEMO 2169 . 2861) (MOVEDIS 2863 . 8440) (MOVERING 8442 . 8994) (RINGSHADE
|
||||
8996 . 9245) (SETUPRINGBITMAPS 9247 . 12568) (TRACK 12570 . 12983) (WHANOI 12985 . 18479) (XHANOI
|
||||
18481 . 18808)))))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (920 20991 (DISPLAYPEGSANDRINGS 930 . 1875) (DOHANOI 1877 . 2288) (FINDOTHER 2290 . 2512
|
||||
) (HANOI 2514 . 2657) (HANOIDEMO 2659 . 3254) (MOVEDIS 3256 . 8151) (MOVERING 8153 . 8808) (RINGSHADE
|
||||
8810 . 9049) (SETUPRINGBITMAPS 9051 . 12799) (TRACK 12801 . 13291) (WHANOI 13293 . 20670) (XHANOI
|
||||
20672 . 20989)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1609
lispusers/HELPSYS
1609
lispusers/HELPSYS
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
@@ -1,453 +1,191 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(FILECREATED "10-Nov-2020 15:57:14" |{DSK}<export>home>denber>lisp>HISTMENU.;40| 28526
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
|changes| |to:| (FNS |HistoryMenu| |UpdateHistoryWindow| |UpdateWistoryWindow|
|
||||
|HistRightButtonFn| |HistMenuOp| |HistMenuMiddle| REMOVENTH)
|
||||
(VARS HISTMENUCOMS HISTCOMS)
|
||||
(FILECREATED "19-Sep-2022 19:20:51" {DSK}<home>matt>medley>LISPUSERS>HISTMENU.;4 16184
|
||||
|
||||
|previous| |date:| "20-Oct-2020 12:02:51" |{DSK}<export>home>denber>lisp>HISTMENU.;1|)
|
||||
:CHANGES-TO (VARS HISTMENUCOMS)
|
||||
(FNS HistMenuOp)
|
||||
|
||||
:PREVIOUS-DATE "15-Sep-2022 21:50:50" {DSK}<home>matt>medley>LISPUSERS>HISTMENU.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1987, 2022 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT HISTMENUCOMS)
|
||||
|
||||
(RPAQQ HISTMENUCOMS ((FNS |HistMenuMiddle| |HistMenuOp| |HistRightButtonFn| |HistoryMenu|
|
||||
REMOVENTH |UpdateHistoryWindow| |UpdateWistoryWindow|)
|
||||
(VARS HISTCOMS)))
|
||||
(RPAQQ HISTMENUCOMS ((VARS * HISTMENUVARS)
|
||||
(INITVARS HistMenuExecOnly)
|
||||
(FNS * HISTMENUFNS)
|
||||
(BITMAPS HistoryBitMap HistoryMask)
|
||||
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
|
||||
HISTMENU)))
|
||||
|
||||
(RPAQQ HISTMENUVARS (BadHistoryItems HistDefaultSlice HistItemsShown HistMenuItemHeight HistMenuWidth
|
||||
HistOpMenuItems HistWindowWidth HistEventWidth UpdateOnDeleteFlg (
|
||||
HistRightMenu
|
||||
)
|
||||
(HistOpMenu)
|
||||
(HistoryWindow)
|
||||
(HistoryMenu)))
|
||||
|
||||
(RPAQQ BadHistoryItems (EDIT ?= OK T NIL ^))
|
||||
|
||||
(RPAQQ HistDefaultSlice 30)
|
||||
|
||||
(RPAQQ HistItemsShown 51)
|
||||
|
||||
(RPAQQ HistMenuItemHeight 15)
|
||||
|
||||
(RPAQQ HistMenuWidth 164)
|
||||
|
||||
(RPAQQ HistOpMenuItems
|
||||
((REDO 'REDO "REDO event selected")
|
||||
(FIX 'FIX "Edit event selected")
|
||||
(UNDO 'UNDO "UNDO event selected")
|
||||
(?? '?? "Show event selected")
|
||||
(Delete 'Delete "Delete event from history menu")))
|
||||
|
||||
(RPAQQ HistWindowWidth 164)
|
||||
|
||||
(RPAQQ HistEventWidth 60)
|
||||
|
||||
(RPAQQ UpdateOnDeleteFlg T)
|
||||
|
||||
(RPAQQ HistRightMenu NIL)
|
||||
|
||||
(RPAQQ HistOpMenu NIL)
|
||||
|
||||
(RPAQQ HistoryWindow NIL)
|
||||
|
||||
(RPAQQ HistoryMenu NIL)
|
||||
|
||||
(RPAQ? HistMenuExecOnly NIL)
|
||||
|
||||
(RPAQQ HISTMENUFNS (HistEventString HistHeldFn HistMenuOp HistRightButtonFn HistoryIcon HistoryMenu
|
||||
LastNEvents UpdateHistory UpdateHistoryWindow))
|
||||
(DEFINEQ
|
||||
|
||||
(|HistMenuMiddle|
|
||||
(LAMBDA (ITEM MENU KEY)
|
||||
(HistEventString
|
||||
[LAMBDA (entry) (* dgb%: "10-FEB-83 10:32")
|
||||
(* |;;| "Actions to take when the middle button is pressed on a History Window menu item.")
|
||||
(* \; "Edited 30-Oct-2020 14:36 by root")
|
||||
(PROG (N) (* PRINT "HistMenuMiddle")
|
||||
(* PRINT ITEM)
|
||||
(RETURN (CADR ITEM)))))
|
||||
|
||||
(* Put together a string which looks like input for menu.
|
||||
(|HistMenuOp|
|
||||
(LAMBDA (ITEM MENU KEY) (* \; "Edited 4-Nov-2020 19:59 by root")
|
||||
Put spaces between atoms, remove <c.r.>, and make top level NIL be "()" %.
|
||||
entry is a history list entry of form (event value . proplist)%.
|
||||
Computed entries are cached in the propList under the property HistoryString)
|
||||
|
||||
(COND
|
||||
(* |;;| "Process History Window menu items when the user clicks on one.")
|
||||
((NULL entry)
|
||||
'(" "))
|
||||
(PROG (NITEMS)
|
||||
((LISTGET (CDDDR entry)
|
||||
'HistoryString))
|
||||
(* |;;| "Need to know the number of the item (ie. ITEMNO) the user clicked on in the menu so we can compute the Exec line that corresponds to.")
|
||||
(T (PROG (newLst key (event (CAR entry))
|
||||
str)
|
||||
(SETQ ITEMNO (|\\ItemNumber| ITEM (|fetch| (MENU ITEMS) |of| MENU)))
|
||||
(* PRINT ITEMNO)
|
||||
(* SETQ ITEMNO (-
|
||||
ITEMNO 2))
|
||||
(SETQ ITEMEXEC (- LASTEXEC ITEMNO))
|
||||
[COND
|
||||
[(AND (EQ (SETQ key (CAR event))
|
||||
'UNDO)
|
||||
(CDR event))
|
||||
|
||||
(* Special form for UNDO. Show form of event that was undone.)
|
||||
(* |;;|
|
||||
"This method is needed to stay in sync in case the user deletes an entry form the menu.")
|
||||
|
||||
(SETQ event (APPEND event '(" -- ") (CAR (LISPXFIND LISPXHISTORY (CDR event)
|
||||
(SETQ ITEMEXEC (CAADAR (NTH |HistoryString| ITEMNO)))
|
||||
(* \;
|
||||
"The exec line of the selected item.")
|
||||
'ENTRY]
|
||||
((FMEMB key BadHistoryItems) (* Not an item to be shown in history)
|
||||
(NCONC entry (LIST 'HistoryString 'Deleted))
|
||||
(* |;;| " Stuff the appropriate text into the Exec window. Since it actually goes into the window that has the caret first check to see if the window with focus is an Exec window. Note the original HISTMENU did not do this.")
|
||||
(* PRINT "HistMenuOp KEY=")
|
||||
(* PRINT KEY)
|
||||
(|if| (NEQ (STRPOS "EXEC" (PROCESSPROP (TTY.PROCESS)
|
||||
'NAME))
|
||||
NIL)
|
||||
|then| (SELECTQ KEY
|
||||
(LEFT (BKSYSBUF (CONCAT "REDO " ITEMEXEC))
|
||||
(BKSYSCHARCODE (CHARCODE CR)))
|
||||
(MIDDLE (SETQ MRET (MENU MMENU))(* \;
|
||||
"Show the middle button menu and return which item was selected.")
|
||||
(* PRINT MRET)
|
||||
(SETQ MRET (CADR MRET))
|
||||
(SELECTQ MRET
|
||||
(REDO (BKSYSBUF (CONCAT "REDO " ITEMEXEC))
|
||||
(BKSYSCHARCODE (CHARCODE CR)))
|
||||
(FIX (BKSYSBUF (CONCAT "FIX " ITEMEXEC))
|
||||
(BKSYSCHARCODE (CHARCODE CR)))
|
||||
(UNDO (BKSYSBUF (CONCAT "UNDO " ITEMEXEC))
|
||||
(BKSYSCHARCODE (CHARCODE CR)))
|
||||
(?? (BKSYSBUF (CONCAT "?? " ITEMEXEC))
|
||||
(BKSYSCHARCODE (CHARCODE CR)))
|
||||
(|Deleted| (* PRINT "DELETE")
|
||||
(* PRINT ITEMNO)
|
||||
(SETQ NITEMS (LENGTH |HistoryString|))
|
||||
(RETURN 'Deleted]
|
||||
(SETQ newLst (TCONC NIL key))
|
||||
(for tail item on (CDR event) do
|
||||
|
||||
(* Add item to the event description to made into a string)
|
||||
|
||||
[COND
|
||||
((EQ HISTSTR0 (SETQ item (CAR tail)))
|
||||
(* leave out <c.r.>)
|
||||
(GO SKIP))
|
||||
((NULL item)
|
||||
(SETQ item "()"))
|
||||
((ATOM item)
|
||||
(* Put in space between atoms)
|
||||
(TCONC newLst '% ]
|
||||
(TCONC newLst item)
|
||||
SKIP finally (SETQ str (APPLY 'CONCAT (CAR newLst)))
|
||||
|
||||
(* make a string using CONCAT, and put as property HistoryString)
|
||||
|
||||
[COND
|
||||
((IGREATERP (NCHARS str)
|
||||
HistEventWidth)
|
||||
(* Avoid going on too long)
|
||||
(SETQ str
|
||||
(CONCAT (SUBSTRING str 1
|
||||
HistEventWidth)
|
||||
(* |;;|
|
||||
"Remove the selected item from HistoryString:")
|
||||
" ..."]
|
||||
(NCONC entry (LIST 'HistoryString str)))
|
||||
(SETQ |HistoryString| (REMOVENTH (- ITEMNO 1)
|
||||
|HistoryString|))
|
||||
(RETURN str])
|
||||
|
||||
(* |;;|
|
||||
"Remove the selected item from HMITEMS too so they stay in sync.")
|
||||
(HistHeldFn
|
||||
[LAMBDA (item menu key) (* dgb%: " 9-FEB-83 16:36")
|
||||
(CLRPROMPT)
|
||||
(SETQ HMITEMS (REMOVENTH (- ITEMNO 1)
|
||||
HMITEMS))
|
||||
(printout PROMPTWINDOW "Will " (SELECTQ key
|
||||
(MIDDLE "do one of UNDO, FIX, ??, or Delete on ")
|
||||
(* |;;| "Now add in the earlier Exec item to the end so that both lists remain histMenuLength long. Ie. if the last item on the last was 734, go find 733 and tack it on the end.")
|
||||
"REDO ")
|
||||
(CDR item)
|
||||
T %# (PRIN3 (CAR item))
|
||||
(SETQ NBACK (LIST (MINUS (SUB1 NITEMS))))
|
||||
(SETQ |HistoryString| (APPEND |HistoryString|
|
||||
(LISPXFIND
|
||||
LISPXHISTORY NBACK
|
||||
'ENTRIES)))
|
||||
(SETQ HMITEMS
|
||||
(APPEND HMITEMS
|
||||
(LIST (LIST (CAAAR (NTH |HistoryString|
|
||||
NITEMS))))))
|
||||
T])
|
||||
|
||||
(* |;;| "And finally update the menu image.")
|
||||
(HistMenuOp
|
||||
[LAMBDA (exp menu key) (* ; "Edited 19-Sep-2022 19:20 by Matt Heffron")
|
||||
(* ; "Edited 15-Sep-2022 21:49 by Matt Heffron")
|
||||
(PROG (op)
|
||||
|
||||
(* ;; "Stuff the appropriate text into the Exec window.")
|
||||
|
||||
(* ;; "Per Michele Denber: Since it actually goes into the window that has the caret, first check to see if the window with focus is an Exec window.")
|
||||
|
||||
(* ;; "Note the original HISTMENU did not do this.")
|
||||
|
||||
(COND
|
||||
((NULL (CDR exp))
|
||||
(RETURN))
|
||||
([AND HistMenuExecOnly (NOT (FIXP (STRPOS "EXEC" (PROCESSPROP (TTY.PROCESS)
|
||||
'NAME]
|
||||
|
||||
(* ;; "It turns out that this check can be too restrictive. ")
|
||||
|
||||
(* ;;
|
||||
"E.g., It wouldn't allow for using the HistMenu in a Break window unless %"under%" an Exec process")
|
||||
|
||||
(PROMPTPRINT "Please select an Exec window for this action.")
|
||||
(RETURN)))
|
||||
(SELECTQ key
|
||||
(LEFT (SETQ op 'REDO)
|
||||
(GO DOIT))
|
||||
(MIDDLE [SETQ op (MENU (OR (AND (type? MENU HistOpMenu)
|
||||
HistOpMenu)
|
||||
(SETQ HistOpMenu (create MENU
|
||||
ITEMS _ HistOpMenuItems]
|
||||
(SELECTQ op
|
||||
(Delete (LISTPUT (CDDDR (LISPXFIND LISPXHISTORY (LIST (CDR exp))
|
||||
'ENTRY))
|
||||
(|replace| ITEMS |of| |HistMenu|
|
||||
|with| HMITEMS)
|
||||
(UPDATE/MENU/IMAGE |HistMenu|)
|
||||
(REDISPLAYW |HistWin|))
|
||||
NIL))
|
||||
(* |;;| "The RIGHTBUTTONFN of the underlying window takes precedence over the WHENSELECTEDFN of the menu filling the window so we do not put a RIGHT button entry here.")
|
||||
(RIGHT (PRINT "HistMenuOp RIGHT")
|
||||
(* SETQ MRET (CAR (MENU
|
||||
|HistRightMenu|)))
|
||||
(SETQ MRET NIL)
|
||||
(PRINT MRET)
|
||||
(SELECTQ MRET
|
||||
(|Bury| (BURYW |HistWin|))
|
||||
(|Move| (MOVEW |HistWin|))
|
||||
(|Shrink| (SHRINKW |HistWin|))
|
||||
(|Update| (|UpdateHistoryWindow|))
|
||||
NIL))
|
||||
NIL)
|
||||
|else| (PROMPTPRINT "Please select the Exec window for this action.")))))
|
||||
'HistoryString
|
||||
'Deleted)
|
||||
(|HistRightButtonFn|
|
||||
(LAMBDA (WIN) (* \; "Edited 8-Nov-2020 17:01 by root")
|
||||
(PROG (X)
|
||||
(MENU |HistRightMenu|) (* SELECTQ MRET (|Bury|
|
||||
(BURYW |HistWin|))
|
||||
(|Move| (MOVEW |HistWin|))
|
||||
(|Shrink| (SHRINKW |HistWin|))
|
||||
(|Update| (|UpdateHistoryWindow|))
|
||||
NIL)
|
||||
(RETURN WIN))))
|
||||
(RETURN (AND UpdateOnDeleteFlg (UpdateHistory menu))))
|
||||
(NIL (* ; "nothing selected")
|
||||
(|HistoryMenu|
|
||||
(LAMBDA (|histMenuLength| |histMenuPosition|) (* \; "Edited 10-Nov-2020 15:56 by root")
|
||||
(PROG (NEGLEN) (* PRINT "Start HistoryMenu")
|
||||
(OR |histMenuLength| (SETQ |histMenuLength| 30))
|
||||
|
||||
(* |;;| "The MIN here is needed in case the user starts HistoryMenu before the history has grown to the requested size.")
|
||||
|
||||
(SETQ ACTUALNITEMS (MIN (CADR LISPXHISTORY)
|
||||
|histMenuLength|))
|
||||
(SETQ NEGLEN (MINUS (MIN |histMenuLength| ACTUALNITEMS)))
|
||||
(SETQ NBACK (LIST -1 `THRU NEGLEN)) (* \; " N.B. backquote!")
|
||||
(* OR |histMenuPosition|
|
||||
(SETQ |histMenuPosition|
|
||||
(QUOTE (LASTMOUSEX LASTMOUSEY 176
|
||||
464))))
|
||||
(SETQ |HistEventWidth| (- (OR (CADDR |histMenuPosition|)
|
||||
178)
|
||||
4))
|
||||
(SETQ |HistoryString| (LISPXFIND LISPXHISTORY NBACK 'ENTRIES))
|
||||
(SETQ HMITEMS (LIST (CAAR |HistoryString|)))
|
||||
(|for| I |from| 2 |to| (MIN |histMenuLength| ACTUALNITEMS)
|
||||
|do| (* PRINT (CAAAR (NTH |HistoryString|
|
||||
I)))
|
||||
(SETQ HMITEMS (APPEND HMITEMS (LIST (LIST (CAAAR (NTH |HistoryString| I)))))))
|
||||
|
||||
(* |;;| "try (CAADAR (NTH HistoryString n)) to get item no.")
|
||||
|
||||
(SETQ MMENU (|create| MENU
|
||||
ITEMS _ '((REDO 'REDO "REDO item selected")
|
||||
(FIX 'FIX "Edit item selected")
|
||||
(UNDO 'UNDO "UNDO event selected")
|
||||
(?? '?? "Show event selected")
|
||||
(|Delete| '|Deleted| "Delete event from history menu"))
|
||||
WHENSELECTEDFN _ '|HistMenuMiddle|))
|
||||
(SETQ |HistRightMenu| (|create| MENU
|
||||
ITEMS _ '((|Bury| (BURYW |HistWin|)
|
||||
"Puts this window on the bottom.")
|
||||
(|Move| (MOVEW |HistWin|)
|
||||
"Moves window by a corner.")
|
||||
(|Shrink| (SHRINKW |HistWin|)
|
||||
|
||||
"Replaces this window with its icon (or title if it doesn't have an icon."
|
||||
)
|
||||
(|Update| (|UpdateHistoryWindow|)
|
||||
|
||||
"Update the window to show all current items."
|
||||
)))) (* SETQ |HistWin| (CREATEW
|
||||
(QUOTE (50 100 172 382))
|
||||
"History Window"))
|
||||
(SETQ |HistMenu| (|create| MENU
|
||||
ITEMS _ HMITEMS
|
||||
MENUROWS _ |histMenuLength|
|
||||
ITEMWIDTH _ |HistEventWidth|
|
||||
WHENSELECTEDFN _ '|HistMenuOp|
|
||||
MENUOUTLINESIZE _ 0))
|
||||
|
||||
(* |;;| " Remember the last Exec line no. so we know which one to FIX, etc.")
|
||||
|
||||
(SETQ LASTEXEC (CAR (HISTORY-NTH LISPXHISTORY 2)))
|
||||
(SETQ LASTEXEC (- LASTEXEC 2)) (* SETQ |HistRightButtonFn| NIL)
|
||||
(SETQ |HistWin| (ADDMENU |HistMenu| NIL |histMenuPosition|))
|
||||
(OR |histMenuPosition| (MOVEW |HistWin|))
|
||||
(WINDOWPROP |HistWin| 'RIGHTBUTTONFN '|HistRightButtonFn|)
|
||||
(WINDOWPROP |HistWin| 'TITLE "History Window")
|
||||
(WINDOWPROP |HistWin| 'BORDER 4) (* CREATEMENUEDWINDOW PUTMENUPROP
|
||||
UPDATE/MENU/IMAG WINDOWPROP HWIN
|
||||
(QUOTE RIGHTBUTTONFN)
|
||||
|HistRightButtonFn|)
|
||||
(RETURN HWIN))))
|
||||
|
||||
(REMOVENTH
|
||||
(LAMBDA (N LIST) (* \; "Edited 27-Oct-2020 16:15 by root")
|
||||
|
||||
(* |;;| "Return LIST with the Nth element removed.")
|
||||
|
||||
(|if| (OR (ZEROP N)
|
||||
(NULL LIST))
|
||||
|then| (CDR LIST)
|
||||
|else| (CONS (CAR LIST)
|
||||
(REMOVENTH (CL:1- N)
|
||||
(CDR LIST))))))
|
||||
|
||||
(|UpdateHistoryWindow|
|
||||
(LAMBDA (NEGLEN) (* \; "Edited 10-Nov-2020 15:53 by root")
|
||||
(PROG (NITEMS)
|
||||
(SETQ NITEMS (LENGTH (|fetch| ITEMS |of| |HistMenu|)))
|
||||
|
||||
(* |;;| "Need this in case HistoryMenu was started before the requested size was reached,")
|
||||
|
||||
(SETQ ACTUALNITEMS (ADD1 (MIN (CADR LISPXHISTORY)
|
||||
NITEMS)))
|
||||
(SETQ NEGLEN (MINUS ACTUALNITEMS))
|
||||
(SETQ NBACK (LIST -2 `THRU NEGLEN))
|
||||
(SETQ |HistoryString| (LISPXFIND LISPXHISTORY NBACK 'ENTRIES))
|
||||
(SETQ HMITEMS (LIST (CAAR |HistoryString|)))
|
||||
|
||||
(* |;;| "Make sure LASTEXEC again points to the most recent event since that has now changed.")
|
||||
|
||||
(SETQ LASTEXEC (CAR (HISTORY-NTH LISPXHISTORY 2)))
|
||||
(SETQ LASTEXEC (- LASTEXEC 2))
|
||||
(|for| I |from| 2 |to| ACTUALNITEMS
|
||||
|do| (SETQ HMITEMS (APPEND HMITEMS (LIST (LIST (CAAAR (NTH |HistoryString| I)))))))
|
||||
(|replace| ITEMS |of| |HistMenu| |with| HMITEMS)
|
||||
(UPDATE/MENU/IMAGE |HistMenu|)
|
||||
(WINDOWPROP |HistWin| 'BORDER 4)
|
||||
(REDISPLAYW |HistWin|))))
|
||||
|
||||
(|UpdateWistoryWindow|
|
||||
(LAMBDA NIL
|
||||
(PROG (N)
|
||||
NIL)))
|
||||
(RETURN NIL))
|
||||
(GO DOIT)))
|
||||
(RETURN))
|
||||
(RPAQQ HISTCOMS
|
||||
((FNS PRINTHISTORY ENTRY# PRINTHISTORY1 PRINTHISTORY2)
|
||||
(FNS EVALQT ENTEREVALQT USEREXEC LISPXREAD LISPXREADBUF LISPXREADP LISPXUNREAD LISPX LISPX/
|
||||
LISPX/1 LISPXEVAL LISPXSTOREVALUE HISTORYSAVE LISPXFIND LISPXGETINPUT REMEMBER
|
||||
GETEXPRESSIONFROMEVENTSPEC LISPXFIND0 LISPXFIND1 HISTORYFIND HISTORYFIND1 HISTORYMATCH
|
||||
VALUEOF VALUOF VALUOF-EVENT LISPXUSE LISPXUSE0 LISPXUSE1 LISPXSUBST LISPXUSEC LISPXFIX
|
||||
CHANGESLICE LISPXSTATE LISPXTYPEAHEAD)
|
||||
(ALISTS (SYSTEMINITVARS LISPXHISTORY GREETHIST))
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY (VARS (\#REDOCNT 3)
|
||||
(ARCHIVEFLG T)
|
||||
(ARCHIVEFN)
|
||||
(ARCHIVELST '(NIL 0 50 100))
|
||||
(DISPLAYTERMFLG)
|
||||
(EDITHISTORY '(NIL 0 30 100))
|
||||
(HERALDSTRING)
|
||||
(LASTEXEC)
|
||||
(LASTHISTORY)
|
||||
(LISPXBUFS)
|
||||
(LISPXHIST)
|
||||
(LISPXHISTORY '(NIL 0 30 100))
|
||||
(LISPXPRINTFLG T)
|
||||
(LISPXUSERFN)
|
||||
(MAKESYSDATE)
|
||||
(PROMPT#FLG T)
|
||||
(REDOCNT)
|
||||
(SYSOUT.EXT 'SYSOUT)
|
||||
(SYSOUTFILE 'WORK)
|
||||
(SYSOUTGAG)
|
||||
(TOPLISPXBUFS)))
|
||||
(LISPXMACROS SHH RETRIEVE BEFORE AFTER OK REMEMBER\: REMEMBER TYPE-AHEAD ??T)
|
||||
(ADDVARS (LISPXFINDSPLST FROM TO THRU SUCHTHAT ALL AND)
|
||||
(BEFORESYSOUTFORMS (SETQ SYSOUTDATE (DATE))
|
||||
(PROGN (COND ((NULL FILE)
|
||||
(SETQ FILE SYSOUTFILE))
|
||||
(T (SETQ SYSOUTFILE (PACKFILENAME 'VERSION NIL 'BODY FILE))))
|
||||
(COND ((AND (NULL (FILENAMEFIELD FILE 'EXTENSION))
|
||||
(NULL (FILENAMEFIELD FILE 'VERSION)))
|
||||
(SETQ FILE (PACKFILENAME 'BODY FILE 'EXTENSION SYSOUT.EXT))))))
|
||||
(RESETFORMS (SETQ READBUF NIL)
|
||||
(SETQ READBUFSOURCE NIL)
|
||||
(SETQ TOPLISPXBUFS (OR (CLBUFS T)
|
||||
TOPLISPXBUFS))
|
||||
(COND ((EQ CLEARSTKLST T)
|
||||
(COND ((EQ NOCLEARSTKLST NIL)
|
||||
(CLEARSTK))
|
||||
(T (* |clear| |all| |stack| |pointers| EXCEPT |those| |on|
|
||||
NOCLEARSTKLST.)
|
||||
(MAPC (CLEARSTK T)
|
||||
(FUNCTION (LAMBDA (X)
|
||||
(AND (NOT (FMEMB X NOCLEARSTKLST))
|
||||
(RELSTK X))))))))
|
||||
(T (MAPC CLEARSTKLST (FUNCTION RELSTK))
|
||||
(SETQ CLEARSTKLST NIL))))
|
||||
(HISTORYSAVEFORMS)
|
||||
(LISPXCOMS |...| ?? FIX FORGET NAME ORIGINAL REDO REPEAT RETRY UNDO USE |fix|
|
||||
|forget| |name| |redo| |repeat| |retry| |undo| |use|)
|
||||
(SYSTATS (LISPXSTATS LISPX INPUTS)
|
||||
(UNDOSAVES UNDO SAVES)
|
||||
(UNDOSTATS CHANGES UNDONE)
|
||||
NIL
|
||||
(EDITCALLS CALLS TO EDITOR)
|
||||
(EDITSTATS EDIT COMMANDS)
|
||||
(EDITEVALSTATS COMMANDS INVOLVING EVALUATING A LISP EXPRESSION)
|
||||
(EDITESTATS USES OF AN E COMMAND TYPED IN DIRECTLY)
|
||||
(EDITISTATS USES OF AN I COMMAND TYPED IN DIRECTLY)
|
||||
(EDITUNDOSAVES EDIT UNDO SAVES)
|
||||
(EDITUNDOSTATS EDIT CHANGES UNDONE)
|
||||
NIL
|
||||
(P.A.STATS P.A. COMMANDS)
|
||||
NIL
|
||||
(CLISPIFYSTATS CALLS TO CLISPIFY)
|
||||
NIL
|
||||
(FIXCALLS CALLS TO DWIM)
|
||||
(FIXTIME)
|
||||
(ERRORCALLS WERE DUE TO ERRORS)
|
||||
(DWIMIFYFIXES WERE FROM DWIMIFYING)
|
||||
NIL "OF THOSE DUE TO ERRORS:" (TYPEINFIXES WERE DUE TO ERRORS IN TYPE-IN)
|
||||
(PROGFIXES WERE DUE TO ERRORS IN USER PROGRAMS)
|
||||
(SUCCFIXES1 OF THESE CALLS WERE SUCCESSFUL)
|
||||
NIL "OF THE CALLS DUE TO DWIMIFYING:" (SUCCFIXES2 WERE SUCCESSFUL)
|
||||
NIL
|
||||
(SPELLSTATS OF ALL DWIM CORRECTIONS WERE SPELLING CORRECTIONS)
|
||||
(CLISPSTATS WERE CLISP TRANSFORMATIONS)
|
||||
(INFIXSTATS OF THESE WERE INFIX TRANSFORMATIONS)
|
||||
(IFSTATS WERE IF/THEN/ELSE STATEMENTS)
|
||||
(I.S.STATS WERE ITERATIVE STATEMENTS)
|
||||
(MATCHSTATS WERE PATTERN MATCHES)
|
||||
(RECORDSTATS WERE RECORD OPERATIONS)
|
||||
NIL
|
||||
(SPELLSTATS1 OTHER SPELLING CORRECTIONS\, E.G. EDIT COMMANDS)
|
||||
NIL
|
||||
(RUNONSTATS OF ALL SPELLING CORRECTIONS WERE RUN-ON CORRECTIONS)
|
||||
NIL
|
||||
(VETOSTATS CORRECTIONS WERE VETOED)
|
||||
NIL)
|
||||
(NOCLEARSTKLST))
|
||||
(APPENDVARS (AFTERSYSOUTFORMS (COND ((LISTP SYSOUTGAG)
|
||||
(EVAL SYSOUTGAG))
|
||||
(SYSOUTGAG)
|
||||
((OR (NULL USERNAME)
|
||||
(EQ USERNAME (USERNAME NIL T)))
|
||||
(TERPRI T)
|
||||
(PRIN1 HERALDSTRING T)
|
||||
(TERPRI T)
|
||||
(TERPRI T)
|
||||
(GREET0)
|
||||
(TERPRI T))
|
||||
(T (LISPXPRIN1 '"****ATTENTION USER " T)
|
||||
(LISPXPRIN1 (USERNAME)
|
||||
T)
|
||||
(LISPXPRIN1 '":
|
||||
this sysout is initialized for user " T)
|
||||
(LISPXPRIN1 USERNAME T)
|
||||
(LISPXPRIN1 '".
|
||||
" T)
|
||||
(LISPXPRIN1 '"To reinitialize, type GREET()
|
||||
" T)))
|
||||
(SETINITIALS)))
|
||||
(P (MAPC SYSTATS (FUNCTION (LAMBDA (X)
|
||||
(AND (LISTP X)
|
||||
(EQ (GETTOPVAL (CAR X))
|
||||
'NOBIND)
|
||||
(SETTOPVAL (CAR X)
|
||||
NIL)))))
|
||||
(PUTD 'E))
|
||||
(COMS (FNS GREET GREET0)
|
||||
(ADDVARS (PREGREETFORMS (DREMOVE GREETFORM RESETFORMS)
|
||||
(SETQ CONSOLETIME (SETQ CPUTIME (SETQ EDITIME 0)))
|
||||
(SETQ CONSOLETIME0 (CLOCK 0))
|
||||
(SETQ CPUTIME0 (CLOCK 2)))
|
||||
(POSTGREETFORMS (SETINITIALS)
|
||||
(AND EDITCHARACTERS (APPLY 'SETTERMCHARS EDITCHARACTERS))))
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY (VARS (GREETHIST)
|
||||
(SYSTEMTYPE)
|
||||
(GREETFORM '(LISPXEVAL '(GREET)
|
||||
'_))
|
||||
(CUTEFLG)
|
||||
(GREETDATES '((" 1-JAN" . "Happy new year")
|
||||
("12-FEB"
|
||||
. "Happy Lincoln's birthday")
|
||||
("14-FEB"
|
||||
. "Happy Valentine's day")
|
||||
("22-FEB"
|
||||
. "Happy Washington's birthday")
|
||||
("15-MAR"
|
||||
. "Beware the Ides of March")
|
||||
("17-MAR"
|
||||
. "Happy St. Patrick's day")
|
||||
("18-MAY" . "It's Victoria Day")
|
||||
(" 1-JUL" . "It's Canada Day")
|
||||
("31-OCT" . "Trick or Treat")
|
||||
(" 5-NOV"
|
||||
. "<boom> it's Guy Fawkes day")
|
||||
("25-DEC" . "Merry Christmas")))
|
||||
(USERNAME)
|
||||
(HOSTNAME)
|
||||
(CONSOLETIME 0)
|
||||
(CONSOLETIME0 0)
|
||||
(CPUTIME 0)
|
||||
(CPUTIME0 0)
|
||||
(EDITIME 0)
|
||||
(FIRSTNAME))
|
||||
(ADDVARS (BEFOREMAKESYSFORMS (SETQ RESETFORMS (CONS GREETFORM RESETFORMS))
|
||||
(SETQ MAKESYSDATE (DATE))))
|
||||
(ADDVARS (AFTERMAKESYSFORMS (LISPXEVAL '(GREET)
|
||||
'_)))))
|
||||
(FNS LISPXPRINT LISPXPRIN1 LISPXPRIN2 LISPXPRINTDEF LISPXPRINTDEF0 LISPXSPACES LISPXTERPRI
|
||||
LISPXTAB USERLISPXPRINT LISPXPUT)
|
||||
(GLOBALVARS \#REDOCNT ARCHIVEFLG ARCHIVEFN ARCHIVELST BOUNDPDUMMY BREAKRESETVALSLST
|
||||
CAR/CDRNIL CHCONLST1 CLEARSTKLST CLISPARRAY CLISPCHARS CLISPFLG CLISPTRANFLG
|
||||
CONSOLETIME CONSOLETIME0 CPUTIME CPUTIME0 CTRLUFLG CUTEFLG DISPLAYTERMFLG DWIMFLG
|
||||
EDITHISTORY EDITIME EDITQUIETFLG EDITSTATS EVALQTFORMS FILERDTBL FIRSTNAME GREETDATES
|
||||
GREETHIST HISTORYCOMS HISTORYSAVEFN HISTORYSAVEFORMS HISTSTR0 HISTSTR2 HISTSTR3 IT
|
||||
LASTHISTORY LISP-RELEASE-VERSION LISPXBUFS LISPXCOMS LISPXFINDSPLST LISPXFNS
|
||||
LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS LISPXPRINTFLG LISPXREADFN LISPXSTATS
|
||||
LISPXUSERFN MACSCRATCHSTRING NEWUSERFLG P.A.STATS POSTGREETFORMS PREGREETFORMS
|
||||
PRETTYHEADER RANDSTATE READBUFSOURCE REDOCNT REREADFLG RESETFORMS SYSFILES
|
||||
TOPLISPXBUFS USERHANDLE USERNAME)
|
||||
(VARS (LISP-RELEASE-VERSION 2.0))
|
||||
(BLOCKS (LISPXFINDBLOCK LISPXFIND LISPXFIND0 LISPXFIND1 HISTORYFIND HISTORYFIND1
|
||||
(ENTRIES LISPXFIND HISTORYFIND)
|
||||
(LOCALFREEVARS _FLG L LST Z =FLG HISTORYFLG PREDFLG LINE HISTORY TYPE BACKUP
|
||||
QUIETFLG)
|
||||
(NOLINKFNS HISTORYMATCH LISPXGETINPUT))
|
||||
(NIL ENTRY# EVALQT GETEXPRESSIONFROMEVENTSPEC GREET GREET0 HISTORYMATCH HISTORYSAVE
|
||||
LISPX LISPX/ LISPX/1 LISPXEVAL LISPXFIND1 LISPXGETINPUT LISPXPRIN1 LISPXPRIN2
|
||||
LISPXPRINT LISPXPRINTDEF LISPXPRINTDEF0 LISPXPUT LISPXREAD LISPXREADBUF
|
||||
LISPXREADP LISPXSPACES LISPXSTOREVALUE LISPXSUBST LISPXTAB LISPXTERPRI
|
||||
LISPXTYPEAHEAD LISPXUNREAD LISPXUSE LISPXUSE0 LISPXUSE1 LISPXUSEC PRINTHISTORY
|
||||
PRINTHISTORY1 PRINTHISTORY2 USEREXEC USERLISPXPRINT VALUEOF VALUOF (LOCALVARS
|
||||
. T)
|
||||
(SPECVARS LISPXLINE LISPXID LISPXVALUE LISPXLISTFLG HISTORY ID EVENT
|
||||
BREAKRESETVALS VARS GENLST INITLST NAME MESSAGE)
|
||||
(LINKFNS . T)
|
||||
(NOLINKFNS LISPXTYPEAHEAD UNDOLISPX ARCHIVEFN LISPXFIX LISPXUSE LISPXUSE0
|
||||
LISPXSUBST LISPXFIND HISTORYMATCH PRINTHISTORY DISPLAYTERMP
|
||||
LISPXSTOREVALUE HISTORYSAVEFN ENTEREVALQT PRINTHISTORY1 PRINTHISTORY2
|
||||
LISPXFIND HISTORYMATCH LISPXGETINPUT LISPXSUBST ARCHIVEFN LISPXFIX
|
||||
LISPXUSE LISPXUSE0 LISPXSUBST HISTORYMATCH PRINTHISTORY DISPLAYTERMP
|
||||
LISPXSTOREVALUE HISTORYSAVEFN ENTEREVALQT LISPXTYEAHEAD UNDOLISPX
|
||||
GREETFILENAME)))
|
||||
(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VALUEOF)
|
||||
(NLAML)
|
||||
(LAMA)))))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (731 14594 (|HistMenuMiddle| 741 . 1200) (|HistMenuOp| 1202 . 7581) (|HistRightButtonFn|
|
||||
7583 . 8274) (|HistoryMenu| 8276 . 12906) (REMOVENTH 12908 . 13307) (|UpdateHistoryWindow| 13309 .
|
||||
14523) (|UpdateWistoryWindow| 14525 . 14592)))))
|
||||
DOIT
|
||||
(BKSYSBUF op) (* ;
|
||||
"Insert op space event identifier in system buffer")
|
||||
(BKSYSBUF " ")
|
||||
(BKSYSBUF (CDR exp))
|
||||
(BKSYSCHARCODE (CHARCODE CR))
|
||||
NIL])
|
||||
|
||||
(HistRightButtonFn
|
||||
[LAMBDA (WINDOW) (* dgb%: "31-MAR-83 18:12")
|
||||
|
||||
(* Sets up Menu, and then does usual right window stuff, augmented by
|
||||
UpdateHistoryWindow)
|
||||
|
||||
[OR (type? MENU (EVALV 'HistRightMenu))
|
||||
|
||||
Binary file not shown.
Binary file not shown.
19
lispusers/IDLEDEMO
Normal file
19
lispusers/IDLEDEMO
Normal file
@@ -0,0 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Aug-2022 23:35:58" {DSK}<home>larry>medley>lispusers>IDLEDEMO.;1 565
|
||||
|
||||
:CHANGES-TO (VARS IDLE.FILES))
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IDLEDEMOCOMS)
|
||||
|
||||
(RPAQQ IDLEDEMOCOMS ((FILES * IDLE.FILES)))
|
||||
|
||||
(RPAQQ IDLE.FILES (SOLITAIRE SCREENPAPER READBRUSH PAC-MAN-IDLE LIFE IDLEHAX BICLOCK KINETIC STARBG
|
||||
HANOI QIX))
|
||||
|
||||
(FILESLOAD SOLITAIRE SCREENPAPER READBRUSH PAC-MAN-IDLE LIFE IDLEHAX BICLOCK KINETIC STARBG HANOI QIX
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
@@ -1,12 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Jun-2022 18:21:17"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>IDLEHAX.;4 26796
|
||||
(FILECREATED "28-Sep-2022 19:53:38" {DSK}<home>larry>medley>lispusers>IDLEHAX.;2 31965
|
||||
|
||||
:CHANGES-TO (FNS KAL.ADVANCE)
|
||||
:CHANGES-TO (FNS IDLE-SWAP)
|
||||
|
||||
:PREVIOUS-DATE " 9-Feb-2022 13:53:05"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>IDLEHAX.;3)
|
||||
:PREVIOUS-DATE "23-Aug-2022 08:50:16" {DSK}<home>larry>medley>lispusers>IDLEHAX.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -98,7 +96,7 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
)
|
||||
|
||||
(CONNECTPOLYS
|
||||
[LAMBDA (FROMS TOS NSTEPS W OPERATION) (* ; "Edited 12-Jan-2022 15:22 by larry")
|
||||
[LAMBDA (FROMS TOS NSTEPS W OPERATION) (* ; "Edited 23-Aug-2022 08:10 by larry")
|
||||
(* lmm "30-Jul-85 17:19")
|
||||
(PROG (DIFFS)
|
||||
(CLEARW W)
|
||||
@@ -120,8 +118,8 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(fetch YC of FPT)
|
||||
(fetch XC of TPT)
|
||||
(fetch YC of TPT)
|
||||
1 OPERATION W))
|
||||
(DISMISS POLYGONWAIT2)
|
||||
1 OPERATION W)
|
||||
(DISMISS POLYGONWAIT2))
|
||||
(CLEARW W)
|
||||
(for I from 1 to POLYGONSTEPS do (DISMISS POLYGONWAIT3)
|
||||
(LINES2 FROMS 1 W OPERATION)
|
||||
@@ -148,7 +146,7 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
|
||||
(RPAQ? POLYGONSWINDOW )
|
||||
|
||||
(RPAQQ POLYGONWAIT2 250)
|
||||
(RPAQQ POLYGONWAIT2 25)
|
||||
|
||||
(RPAQQ POLYGONMINPTS 3)
|
||||
|
||||
@@ -191,8 +189,67 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(KALDEMO
|
||||
(LAMBDA (W PERIOD PERSISTENCE) (* lmm " 5-Aug-85 22:16") (OR PERIOD (SETQ PERIOD (RAND 8 128))) (OR PERSISTENCE (SETQ PERSISTENCE (LSH 1 (RAND 4 13)))) (SETQ W (DEMOWINDOW W)) (LET ((XSTATEB (create KALSTATE A _ 1 B _ -1849 C _ (RAND 2 4) PERIOD _ PERIOD PERIODCOUNT _ 1)) (XSTATEE (create KALSTATE)) (YSTATEB (create KALSTATE A _ 1 B _ -1809 C _ (RAND 0 20) PERIOD _ PERIOD PERIODCOUNT _ 1)) (YSTATEE (create KALSTATE)) (WINDOWSIDE (MIN (WINDOWPROP W (QUOTE HEIGHT)) (WINDOWPROP W (QUOTE WIDTH)))) (TIMER (SETUPTIMER 0 NIL (QUOTE TICKS))) (BLACK (NOT (VIDEOCOLOR))) XOFFSET) (SETQ XOFFSET (QUOTIENT (MAX (DIFFERENCE (WINDOWPROP W (QUOTE WIDTH)) WINDOWSIDE) 0) 2)) (SETQ XSTATEE (COPY XSTATEB)) (SETQ YSTATEE (COPY YSTATEB)) (from 1 to PERSISTENCE do (KAL.ADVANCE XSTATEB) (KAL.ADVANCE YSTATEB) (KAL.SPOTS (ffetch A of XSTATEB) (ffetch A of YSTATEB) WINDOWSIDE W BLACK XOFFSET) (PERIODIC.BLOCK TIMER)) (do (KAL.ADVANCE XSTATEE) (KAL.ADVANCE YSTATEE) (PROG ((X0 (LOGAND (LRSH (ffetch A of XSTATEE) 7) KAL.MASK)) (Y0 (LOGAND (LRSH (ffetch A of YSTATEE) 7) KAL.MASK)) X1 Y1) (COND ((ILESSP X0 Y0) (SETQ X1 (IDIFFERENCE (SUB1 WINDOWSIDE) X0)) (SETQ Y1 (IDIFFERENCE (SUB1 WINDOWSIDE) Y0)) (KAL.BMS W X0 Y0 X1 Y1 (if BLACK then 1 else 0) XOFFSET)))) (KAL.ADVANCE XSTATEB) (KAL.ADVANCE YSTATEB) (KAL.SPOTS (ffetch A of XSTATEB) (ffetch A of YSTATEB) WINDOWSIDE W BLACK XOFFSET) (PERIODIC.BLOCK TIMER))))
|
||||
)
|
||||
[LAMBDA (W PERIOD PERSISTENCE) (* ; "Edited 23-Aug-2022 08:49 by lmm")
|
||||
(* lmm " 5-Aug-85 22:16")
|
||||
(OR PERIOD (SETQ PERIOD (RAND 16 128)))
|
||||
[OR PERSISTENCE (SETQ PERSISTENCE (LSH 1 (RAND 14 23]
|
||||
(SETQ W (DEMOWINDOW W))
|
||||
(LET ((XSTATEB (create KALSTATE
|
||||
A _ 1
|
||||
B _ -1849
|
||||
C _ (RAND 2 4)
|
||||
PERIOD _ PERIOD
|
||||
PERIODCOUNT _ 1))
|
||||
(XSTATEE (create KALSTATE))
|
||||
(YSTATEB (create KALSTATE
|
||||
A _ 1
|
||||
B _ -1809
|
||||
C _ (RAND 0 20)
|
||||
PERIOD _ PERIOD
|
||||
PERIODCOUNT _ 1))
|
||||
(YSTATEE (create KALSTATE))
|
||||
[WINDOWSIDE (MIN (WINDOWPROP W 'HEIGHT)
|
||||
(WINDOWPROP W 'WIDTH]
|
||||
(TIMER (SETUPTIMER 0 NIL 'TICKS))
|
||||
(BLACK (NOT (VIDEOCOLOR)))
|
||||
XOFFSET)
|
||||
(SETQ XOFFSET (QUOTIENT (MAX (DIFFERENCE (WINDOWPROP W 'WIDTH)
|
||||
WINDOWSIDE)
|
||||
0)
|
||||
2))
|
||||
(SETQ XSTATEE (COPY XSTATEB))
|
||||
(SETQ YSTATEE (COPY YSTATEB))
|
||||
(from 1 to PERSISTENCE do (KAL.ADVANCE XSTATEB)
|
||||
(KAL.ADVANCE YSTATEB)
|
||||
(KAL.SPOTS (ffetch A of XSTATEB)
|
||||
(ffetch A of YSTATEB)
|
||||
WINDOWSIDE W BLACK XOFFSET)
|
||||
(BLOCK 100 TIMER))
|
||||
(do (KAL.ADVANCE XSTATEE)
|
||||
(KAL.ADVANCE YSTATEE)
|
||||
[PROG ((X0 (LOGAND (LRSH (ffetch A of XSTATEE)
|
||||
7)
|
||||
KAL.MASK))
|
||||
(Y0 (LOGAND (LRSH (ffetch A of YSTATEE)
|
||||
7)
|
||||
KAL.MASK))
|
||||
X1 Y1)
|
||||
(COND
|
||||
((ILESSP X0 Y0)
|
||||
(SETQ X1 (IDIFFERENCE (SUB1 WINDOWSIDE)
|
||||
X0))
|
||||
(SETQ Y1 (IDIFFERENCE (SUB1 WINDOWSIDE)
|
||||
Y0))
|
||||
(KAL.BMS W X0 Y0 X1 Y1 (if BLACK
|
||||
then 1
|
||||
else 0)
|
||||
XOFFSET]
|
||||
(KAL.ADVANCE XSTATEB)
|
||||
(KAL.ADVANCE YSTATEB)
|
||||
(KAL.SPOTS (ffetch A of XSTATEB)
|
||||
(ffetch A of YSTATEB)
|
||||
WINDOWSIDE W BLACK XOFFSET)
|
||||
(PERIODIC.BLOCK TIMER])
|
||||
|
||||
(KAL.ADVANCE
|
||||
[LAMBDA (STATE) (* ; "Edited 26-Jun-2022 18:20 by rmk")
|
||||
@@ -231,8 +288,59 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(BUBBLES
|
||||
(LAMBDA (W) (* lmm "30-Jul-85 20:35") (WINDOWPROP (SETQ W (DEMOWINDOW W)) (QUOTE RESHAPEFN) (FUNCTION (LAMBDA (W) (DSPFILL NIL (if (VIDEOCOLOR) then WHITESHADE else BLACKSHADE) (QUOTE REPLACE) W)))) (DSPFILL NIL (if (VIDEOCOLOR) then WHITESHADE else BLACKSHADE) (QUOTE REPLACE) W) (bind (ARRAY _ (ARRAY BUBBLECNT (QUOTE POINTER))) (I _ 1) CIRCLE eachtime (SETQ I (if (EQ I BUBBLECNT) then 1 else (ADD1 I))) do (* * first erase the circle at I in array) (SETQ CIRCLE (ELT ARRAY I)) (DSPOPERATION (if (VIDEOCOLOR) then (QUOTE ERASE) else (QUOTE PAINT)) W) (* there will be no circle at I the first time through) (AND CIRCLE (DRAWCIRCLE (CAR CIRCLE) (CADR CIRCLE) (CADDR CIRCLE) NIL NIL W)) (* * now put a new circle in array at I and draw it) (SETQ CIRCLE (SETA ARRAY I (BUBBLE.CREATE W))) (DSPOPERATION (QUOTE REPLACE) W) (* fill center w/ black so it ocludes ones under) (FILLCIRCLE (CAR CIRCLE) (CADR CIRCLE) (SUB1 (CADDR CIRCLE)) (if (VIDEOCOLOR) then WHITESHADE else BLACKSHADE) W) (DSPOPERATION (QUOTE INVERT) W) (DRAWCIRCLE (CAR CIRCLE) (CADR CIRCLE) (CADDR CIRCLE) NIL NIL W) (BLOCK)))
|
||||
)
|
||||
[LAMBDA (W) (* ; "Edited 23-Aug-2022 08:14 by larry")
|
||||
(* lmm "30-Jul-85 20:35")
|
||||
[WINDOWPROP (SETQ W (DEMOWINDOW W))
|
||||
'RESHAPEFN
|
||||
(FUNCTION (LAMBDA (W)
|
||||
(DSPFILL NIL (if (VIDEOCOLOR)
|
||||
then WHITESHADE
|
||||
else BLACKSHADE)
|
||||
'REPLACE W]
|
||||
(DSPFILL NIL (if (VIDEOCOLOR)
|
||||
then WHITESHADE
|
||||
else BLACKSHADE)
|
||||
'REPLACE W)
|
||||
(bind (ARRAY _ (ARRAY BUBBLECNT 'POINTER))
|
||||
(I _ 1)
|
||||
CIRCLE eachtime (SETQ I (if (EQ I BUBBLECNT)
|
||||
then 1
|
||||
else (ADD1 I))) do
|
||||
|
||||
(* * first erase the circle at I in array)
|
||||
|
||||
(SETQ CIRCLE (ELT ARRAY I))
|
||||
(DSPOPERATION (if (VIDEOCOLOR)
|
||||
then 'ERASE
|
||||
else 'PAINT)
|
||||
W)
|
||||
(* there will be no circle at I the
|
||||
first time through)
|
||||
(AND CIRCLE (DRAWCIRCLE (CAR CIRCLE)
|
||||
(CADR CIRCLE)
|
||||
(CADDR CIRCLE)
|
||||
NIL NIL W))
|
||||
|
||||
(* * now put a new circle in array at I and draw it)
|
||||
|
||||
(SETQ CIRCLE (SETA ARRAY I (BUBBLE.CREATE
|
||||
W)))
|
||||
(DSPOPERATION 'REPLACE W)
|
||||
(* fill center w/ black so it ocludes
|
||||
ones under)
|
||||
(FILLCIRCLE (CAR CIRCLE)
|
||||
(CADR CIRCLE)
|
||||
(SUB1 (CADDR CIRCLE))
|
||||
(if (VIDEOCOLOR)
|
||||
then WHITESHADE
|
||||
else BLACKSHADE)
|
||||
W)
|
||||
(DSPOPERATION 'INVERT W)
|
||||
(DRAWCIRCLE (CAR CIRCLE)
|
||||
(CADR CIRCLE)
|
||||
(CADDR CIRCLE)
|
||||
NIL NIL W)
|
||||
(BLOCK 100])
|
||||
|
||||
(BUBBLE.CREATE
|
||||
(LAMBDA (W) (* drc%: "29-Jul-85 13:51") (LET* ((REGION (WINDOWPROP W (QUOTE REGION))) (WIDTH (SUB1 (fetch WIDTH of REGION))) (HEIGHT (SUB1 (fetch HEIGHT of REGION))) (CENTERX (RAND 1 (SUB1 WIDTH))) (CENTERY (RAND 1 (SUB1 HEIGHT)))) (LIST CENTERX CENTERY (RAND 1 (IMIN (IDIFFERENCE WIDTH CENTERX) CENTERX (IDIFFERENCE HEIGHT CENTERY) CENTERY)))))
|
||||
@@ -243,8 +351,32 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(IDLE-WINDOWS
|
||||
(LAMBDA (W DELAY) (* lmm " 7-Jun-86 22:21") (SETQ W (DEMOWINDOW W)) (PROG ((D (WINDOWPROP W (QUOTE WIDTH))) (H (WINDOWPROP W (QUOTE HEIGHT))) (TIMER (SETUPTIMER 0 NIL (QUOTE TICKS)))) (LET ((TITLE (WINDOWPROP (CREATEW (LIST 0 0 D (HEIGHTIFWINDOW 0 T)) "Yet another window" NIL T) (QUOTE IMAGECOVERED)))) (while T do (PROG ((X (RAND 0 (- D (+ 2 2 100)))) (Y (RAND 0 (- H 8 100)))) (PROG ((D0 (MAX 100 (RAND 100 (- D X)))) (H0 (MAX 100 (RAND 100 (- H Y))))) (BITBLT NIL NIL NIL W X Y D0 2 (QUOTE TEXTURE) (QUOTE REPLACE) BLACKSHADE) (BITBLT NIL NIL NIL W X Y 2 H0 (QUOTE TEXTURE) (QUOTE REPLACE) BLACKSHADE) (BITBLT NIL NIL NIL W (+ X (- D0 2)) Y 2 H0 (QUOTE TEXTURE) (QUOTE REPLACE) BLACKSHADE) (BITBLT TITLE NIL (+ WBorder (QUOTIENT WBorder 2)) W X (+ Y H0) D0 NIL NIL (QUOTE REPLACE)) (BITBLT NIL NIL NIL W (+ X 2) (+ Y 2) (- D0 (+ 2 2)) (- H0 2) (QUOTE TEXTURE) (QUOTE ERASE) BLACKSHADE))) (if DELAY then (BLOCK DELAY) else (PERIODIC.BLOCK TIMER))))))
|
||||
)
|
||||
[LAMBDA (W DELAY) (* ; "Edited 23-Aug-2022 08:35 by lmm")
|
||||
(* lmm " 7-Jun-86 22:21")
|
||||
(SETQ W (DEMOWINDOW W))
|
||||
(PROG [(D (WINDOWPROP W 'WIDTH))
|
||||
(H (WINDOWPROP W 'HEIGHT]
|
||||
(LET [(TITLE (WINDOWPROP (CREATEW (LIST 0 0 D (HEIGHTIFWINDOW 0 T))
|
||||
"Yet another window" NIL T)
|
||||
'IMAGECOVERED]
|
||||
(while T do (PROG [[X (RAND 0 (- D (+ 2 2 100]
|
||||
(Y (RAND 0 (- H 8 100]
|
||||
(PROG [[D0 (MAX 100 (RAND 100 (- D X]
|
||||
(H0 (MAX 100 (RAND 100 (- H Y]
|
||||
(BITBLT NIL NIL NIL W X Y D0 2 'TEXTURE 'REPLACE BLACKSHADE)
|
||||
(BITBLT NIL NIL NIL W X Y 2 H0 'TEXTURE 'REPLACE BLACKSHADE)
|
||||
(BITBLT NIL NIL NIL W (+ X (- D0 2))
|
||||
Y 2 H0 'TEXTURE 'REPLACE BLACKSHADE)
|
||||
(BITBLT TITLE NIL (+ WBorder (QUOTIENT WBorder 2))
|
||||
W X (+ Y H0)
|
||||
D0 NIL NIL 'REPLACE)
|
||||
(BITBLT NIL NIL NIL W (+ X 2)
|
||||
(+ Y 2)
|
||||
(- D0 (+ 2 2))
|
||||
(- H0 2)
|
||||
'TEXTURE
|
||||
'ERASE BLACKSHADE)))
|
||||
(BLOCK (OR DELAY 500])
|
||||
)
|
||||
|
||||
|
||||
@@ -258,8 +390,18 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
)
|
||||
|
||||
(LINES1
|
||||
(LAMBDA (ENDPOINTS LINES DSP) (* lmm "30-Jul-85 17:33") (PROG (PTS) (COND ((SETQ PTS (CAR LINES)) (* ERASE OLD) (LINES3 (CAR LINES) 1 DSP (QUOTE INVERT) ENDPOINTS)) (T (RPLACA LINES (SETQ PTS (in ENDPOINTS collect (create NPOINT)))) (LINES2 ENDPOINTS 1 DSP (QUOTE INVERT)))) (for PT in PTS as EP in ENDPOINTS do (replace XC of PT with (fetch XC of EP)) (replace YC of PT with (fetch YC of EP)))))
|
||||
)
|
||||
[LAMBDA (ENDPOINTS LINES DSP) (* ; "Edited 23-Aug-2022 07:59 by larry")
|
||||
(* lmm "30-Jul-85 17:33")
|
||||
(PROG (PTS)
|
||||
[COND
|
||||
((SETQ PTS (CAR LINES)) (* ERASE OLD)
|
||||
(LINES3 (CAR LINES)
|
||||
1 DSP 'INVERT ENDPOINTS))
|
||||
(T [RPLACA LINES (SETQ PTS (in ENDPOINTS collect (create NPOINT]
|
||||
(LINES2 ENDPOINTS 1 DSP 'INVERT]
|
||||
(BLOCK 75)
|
||||
(for PT in PTS as EP in ENDPOINTS do (replace XC of PT with (fetch XC of EP))
|
||||
(replace YC of PT with (fetch YC of EP])
|
||||
|
||||
(LINES2
|
||||
(LAMBDA (ENDPOINTS WIDTH WINDOW OPERATION) (* lmm "30-Jul-85 17:14") (for (X _ ENDPOINTS) while (OR (CDR X) (if (CDDR ENDPOINTS) then X)) do (DRAWLINE (fetch XC (CAR X)) (fetch YC (CAR X)) (fetch XC (CAR (OR (SETQ X (CDR X)) ENDPOINTS))) (fetch YC (CAR (OR X ENDPOINTS))) WIDTH OPERATION WINDOW)))
|
||||
@@ -283,8 +425,20 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
)
|
||||
|
||||
(WARP
|
||||
(LAMBDA (W) (* hdj " 1-Apr-86 14:22") (do (CLEARW W) (LET ((OLDOP (DSPOPERATION (QUOTE INVERT) W))) (LET ((WIDTH (WINDOWPROP W (QUOTE WIDTH))) (HEIGHT (WINDOWPROP W (QUOTE HEIGHT)))) (LET ((CENTERX (RAND 0 WIDTH)) (CENTERY (RAND 0 HEIGHT))) (for RADIUS from (RAND 5 250) to 5 by -2 do (FILLCIRCLE (PLUS CENTERX (RAND 0 2)) (PLUS CENTERY (RAND 0 2)) RADIUS BLACKSHADE W) (BLOCK)))) (DSPOPERATION OLDOP W))))
|
||||
)
|
||||
[LAMBDA (W) (* ; "Edited 23-Aug-2022 08:01 by larry")
|
||||
(* hdj " 1-Apr-86 14:22")
|
||||
(do (CLEARW W)
|
||||
(LET ((OLDOP (DSPOPERATION 'INVERT W)))
|
||||
[LET [(WIDTH (WINDOWPROP W 'WIDTH))
|
||||
(HEIGHT (WINDOWPROP W 'HEIGHT]
|
||||
(LET ((CENTERX (RAND 0 WIDTH))
|
||||
(CENTERY (RAND 0 HEIGHT)))
|
||||
(for RADIUS from (RAND 5 250) to 5 by -2
|
||||
do (FILLCIRCLE (PLUS CENTERX (RAND 0 2))
|
||||
(PLUS CENTERY (RAND 0 2))
|
||||
RADIUS BLACKSHADE W)
|
||||
(BLOCK 75]
|
||||
(DSPOPERATION OLDOP W])
|
||||
)
|
||||
|
||||
|
||||
@@ -294,7 +448,8 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(IDLE-MELT
|
||||
[LAMBDA (WINDOW SIZE INITIAL PATH) (* ; "Edited 10-Jun-88 17:15 by MASINTER")
|
||||
[LAMBDA (WINDOW SIZE INITIAL PATH) (* ; "Edited 23-Aug-2022 08:20 by larry")
|
||||
(* ; "Edited 10-Jun-88 17:15 by MASINTER")
|
||||
(OR SIZE (SETQ SIZE MELT-BLOCK-SIZE))
|
||||
(SETQ WINDOW (DEMOWINDOW WINDOW))
|
||||
(PROG ((W (WINDOWPROP WINDOW 'WIDTH))
|
||||
@@ -307,37 +462,34 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
[SETQ BM (OR (CAR TAIL)
|
||||
(WINDOWPROP WINDOW 'IMAGECOVERED]
|
||||
(for BITMAP inside BM do (BITBLT (SETQ BITMAP (if (BITMAPP BITMAP)
|
||||
then BITMAP
|
||||
elseif (CL:SYMBOLP BITMAP)
|
||||
then (CAR (READBRUSHFILE
|
||||
BITMAP))
|
||||
else (IDLE.BITMAP NIL
|
||||
BITMAP)))
|
||||
NIL NIL WINDOW (RAND 0 (- W (BITMAPWIDTH BITMAP
|
||||
)))
|
||||
(RAND 0 (- H (BITMAPHEIGHT BITMAP)))
|
||||
NIL NIL (if (VIDEOCOLOR)
|
||||
then NIL
|
||||
else 'INVERT)
|
||||
'REPLACE))
|
||||
then BITMAP
|
||||
elseif (CL:SYMBOLP BITMAP)
|
||||
then (CAR (READBRUSHFILE BITMAP))
|
||||
else (IDLE.BITMAP NIL BITMAP)))
|
||||
NIL NIL WINDOW (RAND 0 (- W (BITMAPWIDTH BITMAP)))
|
||||
(RAND 0 (- H (BITMAPHEIGHT BITMAP)))
|
||||
NIL NIL (if (VIDEOCOLOR)
|
||||
then NIL
|
||||
else 'INVERT)
|
||||
'REPLACE))
|
||||
(if INITIAL
|
||||
then [SETQ TIMER (AND (CADR TAIL)
|
||||
(SETUPTIMER (CADR TAIL)
|
||||
TIMER
|
||||
'SECONDS
|
||||
'SECONDS]
|
||||
(SETQ TAIL (OR (CDDR TAIL)
|
||||
INITIAL)))
|
||||
(SETUPTIMER (CADR TAIL)
|
||||
TIMER
|
||||
'SECONDS
|
||||
'SECONDS]
|
||||
(SETQ TAIL (OR (CDDR TAIL)
|
||||
INITIAL)))
|
||||
[do (LET [(X (RAND 0 (- W SIZE)))
|
||||
(Y (RAND 0 (- H SIZE]
|
||||
(BITBLT WINDOW X Y WINDOW (+ X (RAND -1 1))
|
||||
(+ Y (RAND -1 1))
|
||||
SIZE SIZE NIL 'REPLACE))
|
||||
(BLOCK) repeatuntil (AND TIMER (TIMEREXPIRED? TIMER 'SECONDS]
|
||||
(Y (RAND 0 (- H SIZE]
|
||||
(BITBLT WINDOW X Y WINDOW (+ X (RAND -1 1))
|
||||
(+ Y (RAND -1 1))
|
||||
SIZE SIZE NIL 'REPLACE))
|
||||
(BLOCK 100) repeatuntil (AND TIMER (TIMEREXPIRED? TIMER 'SECONDS]
|
||||
(GO REPAINT])
|
||||
|
||||
(IDLE-SLIDE
|
||||
[LAMBDA (W SIZE SPEED COUNT SOURCE) (* ; "Edited 10-Jun-88 17:12 by MASINTER")
|
||||
[LAMBDA (W SIZE SPEED COUNT SOURCE) (* ; "Edited 10-Jun-88 17:12 by MASINTER")
|
||||
(OR SIZE (SETQ SIZE 128))
|
||||
(OR COUNT (SETQ COUNT 120))
|
||||
(OR SPEED (SETQ SPEED 2))
|
||||
@@ -354,28 +506,28 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
X Y DX DY (CNT 1)
|
||||
DDX DDY (TIMER (SETUPTIMER 0 NIL 'TICKS]
|
||||
(do (COND
|
||||
((OR (EQ (add CNT -1)
|
||||
0)
|
||||
(< X 0)
|
||||
(> X XMAX)
|
||||
(< Y 0)
|
||||
(> Y YMAX))
|
||||
(SETQ X (RAND 0 XMAX))
|
||||
(SETQ Y (RAND 0 YMAX))
|
||||
(SETQ DX (RAND (- SPEED)
|
||||
SPEED))
|
||||
(SETQ DY (RAND (- SPEED)
|
||||
SPEED))
|
||||
(BITBLT SOURCE X Y W X Y SIZE SIZE NIL 'REPLACE)
|
||||
(SETQ DDX DY)
|
||||
(SETQ DDY DX)
|
||||
(SETQ CNT COUNT)))
|
||||
(BITBLT W X Y W (+ X DDX)
|
||||
(+ Y DDY)
|
||||
SIZE SIZE NIL 'REPLACE)
|
||||
(add X DX)
|
||||
(add Y DY)
|
||||
(PERIODIC.BLOCK TIMER])
|
||||
((OR (EQ (add CNT -1)
|
||||
0)
|
||||
(< X 0)
|
||||
(> X XMAX)
|
||||
(< Y 0)
|
||||
(> Y YMAX))
|
||||
(SETQ X (RAND 0 XMAX))
|
||||
(SETQ Y (RAND 0 YMAX))
|
||||
(SETQ DX (RAND (- SPEED)
|
||||
SPEED))
|
||||
(SETQ DY (RAND (- SPEED)
|
||||
SPEED))
|
||||
(BITBLT SOURCE X Y W X Y SIZE SIZE NIL 'REPLACE)
|
||||
(SETQ DDX DY)
|
||||
(SETQ DDY DX)
|
||||
(SETQ CNT COUNT)))
|
||||
(BITBLT W X Y W (+ X DDX)
|
||||
(+ Y DDY)
|
||||
SIZE SIZE NIL 'REPLACE)
|
||||
(add X DX)
|
||||
(add Y DY)
|
||||
(PERIODIC.BLOCK TIMER])
|
||||
)
|
||||
|
||||
(RPAQQ MELT-BLOCK-SIZE 32)
|
||||
@@ -399,17 +551,16 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PERIODIC.BLOCK MACRO [(TIMER)
|
||||
(if (TIMEREXPIRED? TIMER 'TICKS)
|
||||
then (BLOCK)
|
||||
(SETQ TIMER (SETUPTIMER 100 TIMER 'TICKS 'MILLISECONDS])
|
||||
(PUTPROPS PERIODIC.BLOCK MACRO ((TIMER)
|
||||
(BLOCK 100 TIMER)))
|
||||
)
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Drain" 'IDLE-DRAIN))
|
||||
(DEFINEQ
|
||||
|
||||
(IDLE-DRAIN
|
||||
[LAMBDA (WINDOW) (* hdj "28-May-86 11:52")
|
||||
[LAMBDA (WINDOW) (* ; "Edited 23-Aug-2022 07:52 by larry")
|
||||
(* hdj "28-May-86 11:52")
|
||||
(do (BITBLT (WINDOWPROP WINDOW 'IMAGECOVERED)
|
||||
NIL NIL WINDOW NIL NIL NIL NIL 'INVERT 'REPLACE)
|
||||
(LET* ((WIDTH (WINDOWPROP WINDOW 'WIDTH))
|
||||
@@ -417,7 +568,7 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(HALF-WIDTH (IQUOTIENT WIDTH 2))
|
||||
(HALF-HEIGHT (IQUOTIENT HEIGHT 2)))
|
||||
(for EDGE from 0 to (MIN HALF-WIDTH HALF-HEIGHT)
|
||||
do (BLOCK)
|
||||
do (BLOCK 100)
|
||||
(BITBLT WINDOW EDGE 0 WINDOW (PLUS 1 EDGE)
|
||||
0
|
||||
(- HALF-WIDTH EDGE)
|
||||
@@ -452,13 +603,14 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(IDLE-SWAP
|
||||
[LAMBDA (WINDOW) (* hdj "29-May-86 23:41")
|
||||
[LAMBDA (WINDOW) (* ; "Edited 28-Sep-2022 19:48 by lmm")
|
||||
(* hdj "29-May-86 23:41")
|
||||
(DECLARE (GLOBALVARS IDLE-SWAP-SIZE))
|
||||
(BITBLT (WINDOWPROP WINDOW 'IMAGECOVERED)
|
||||
NIL NIL WINDOW NIL NIL NIL NIL 'INVERT 'REPLACE)
|
||||
(LET [(WIDTH (WINDOWPROP WINDOW 'WIDTH))
|
||||
(HEIGHT (WINDOWPROP WINDOW 'HEIGHT]
|
||||
(do (BLOCK (RAND 0 5000))
|
||||
(do (BLOCK 250)
|
||||
(LET [[RAND-X-1 (TIMES IDLE-SWAP-SIZE (RAND 0 (IQUOTIENT WIDTH IDLE-SWAP-SIZE]
|
||||
[RAND-Y-1 (TIMES IDLE-SWAP-SIZE (RAND 0 (IQUOTIENT HEIGHT IDLE-SWAP-SIZE]
|
||||
[RAND-X-2 (TIMES IDLE-SWAP-SIZE (RAND 0 (IQUOTIENT WIDTH IDLE-SWAP-SIZE]
|
||||
@@ -480,12 +632,12 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Swap" 'IDLE-SWAP))
|
||||
(PUTPROPS IDLEHAX COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1991 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3812 7852 (POLYGONSDEMO 3822 . 3992) (POLYGONS 3994 . 4358) (CONNECTPOLYS 4360 . 6758)
|
||||
(DRAWPOLY1 6760 . 7397) (RANDOMPT 7399 . 7850)) (8489 12004 (KALDEMO 8499 . 9910) (KAL.ADVANCE 9912 .
|
||||
10846) (KAL.SPOTS 10848 . 11189) (KAL.BMS 11191 . 11678) (KAL.ORAND 11680 . 12002)) (12041 13527 (
|
||||
BUBBLES 12051 . 13157) (BUBBLE.CREATE 13159 . 13525)) (13554 14539 (IDLE-WINDOWS 13564 . 14537)) (
|
||||
14574 16845 (LINES 14584 . 15643) (LINES1 15645 . 16055) (LINES2 16057 . 16368) (LINES3 16370 . 16843)
|
||||
) (16905 18118 (WALKINGSPOKE 16915 . 17696) (WARP 17698 . 18116)) (18143 22426 (IDLE-MELT 18153 .
|
||||
20669) (IDLE-SLIDE 20671 . 22424)) (22597 22843 (DEMOWINDOW 22607 . 22841)) (23255 25128 (IDLE-DRAIN
|
||||
23265 . 25126)) (25160 26641 (IDLE-SWAP 25170 . 26639)))))
|
||||
(FILEMAP (NIL (3756 7833 (POLYGONSDEMO 3766 . 3936) (POLYGONS 3938 . 4302) (CONNECTPOLYS 4304 . 6739)
|
||||
(DRAWPOLY1 6741 . 7378) (RANDOMPT 7380 . 7831)) (8469 13548 (KALDEMO 8479 . 11454) (KAL.ADVANCE 11456
|
||||
. 12390) (KAL.SPOTS 12392 . 12733) (KAL.BMS 12735 . 13222) (KAL.ORAND 13224 . 13546)) (13585 17431 (
|
||||
BUBBLES 13595 . 17061) (BUBBLE.CREATE 17063 . 17429)) (17458 19241 (IDLE-WINDOWS 17468 . 19239)) (
|
||||
19276 21944 (LINES 19286 . 20345) (LINES1 20347 . 21154) (LINES2 21156 . 21467) (LINES3 21469 . 21942)
|
||||
) (22004 23625 (WALKINGSPOKE 22014 . 22795) (WARP 22797 . 23623)) (23650 27551 (IDLE-MELT 23660 .
|
||||
25872) (IDLE-SLIDE 25874 . 27549)) (27722 27968 (DEMOWINDOW 27732 . 27966)) (28212 30198 (IDLE-DRAIN
|
||||
28222 . 30196)) (30230 31810 (IDLE-SWAP 30240 . 31808)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,49 +1,53 @@
|
||||
(FILECREATED " 2-Apr-86 00:14:01" {ERIS}<LISPUSERS>KOTO>KINETIC.;2 1626
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to: (VARS KINETICCOMS)
|
||||
(FILECREATED "23-Sep-2022 08:19:41" {DSK}<home>larry>medley>lispusers>KINETIC.;2 1928
|
||||
|
||||
previous date: " 3-Dec-85 14:17:48" {ERIS}<LISPUSERS>KOTO>KINETIC.;1)
|
||||
:CHANGES-TO (FNS KINETIC)
|
||||
|
||||
:PREVIOUS-DATE " 2-Apr-86 00:14:01" {DSK}<home>larry>medley>lispusers>KINETIC.;1)
|
||||
|
||||
|
||||
(* Copyright (c) 1982, 1985, 1986 by Xerox Corporation. All rights reserved.)
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT KINETICCOMS)
|
||||
|
||||
(RPAQQ KINETICCOMS ((FNS KINETIC)
|
||||
(VARS (CHECKSHADE 63903)
|
||||
(KINETICWINDOW))
|
||||
(ALISTS (IDLE.FUNCTIONS Kinetic))))
|
||||
(VARS (CHECKSHADE 63903)
|
||||
(KINETICWINDOW))
|
||||
(ALISTS (IDLE.FUNCTIONS Kinetic))))
|
||||
(DEFINEQ
|
||||
|
||||
(KINETIC
|
||||
[LAMBDA (WINDOW) (* lmm " 3-Dec-85 14:16")
|
||||
(* test example (KINETICDEMO)
|
||||
(SETQ CHECKSHADE (EDITSHADE CHECKSHADE)))
|
||||
[OR (WINDOWP WINDOW)
|
||||
(SETQ WINDOW (OR KINETICWINDOW (SETQ KINETICWINDOW (CREATEW NIL "Kinetic Window"]
|
||||
(PROG ((WD (WINDOWPROP WINDOW (QUOTE WIDTH)))
|
||||
(HT (WINDOWPROP WINDOW (QUOTE HEIGHT)))
|
||||
X Y)
|
||||
(do (SETQ X (RAND 0 WD))
|
||||
(SETQ Y (RAND 0 HT))
|
||||
(BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
|
||||
(RAND 0 (IDIFFERENCE HT Y))
|
||||
X Y (QUOTE TEXTURE)
|
||||
(SELECTQ (RAND 0 5)
|
||||
(0 (QUOTE PAINT))
|
||||
(QUOTE INVERT))
|
||||
(SELECTQ (AND CHECKSHADE (RAND 0 12))
|
||||
(0 CHECKSHADE)
|
||||
BLACKSHADE))
|
||||
(BLOCK])
|
||||
[LAMBDA (WINDOW) (* ; "Edited 22-Sep-2022 22:07 by lmm")
|
||||
(* lmm " 3-Dec-85 14:16")
|
||||
(* test example (KINETICDEMO)
|
||||
(SETQ CHECKSHADE (EDITSHADE CHECKSHADE)))
|
||||
[OR (WINDOWP WINDOW)
|
||||
(SETQ WINDOW (OR KINETICWINDOW (SETQ KINETICWINDOW (CREATEW NIL "Kinetic Window"]
|
||||
(PROG ((WD (WINDOWPROP WINDOW 'WIDTH))
|
||||
(HT (WINDOWPROP WINDOW 'HEIGHT))
|
||||
X Y)
|
||||
(do (SETQ X (RAND 0 WD))
|
||||
(SETQ Y (RAND 0 HT))
|
||||
(BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
|
||||
(RAND 0 (IDIFFERENCE HT Y))
|
||||
X Y 'TEXTURE (SELECTQ (RAND 0 5)
|
||||
(0 'PAINT)
|
||||
'INVERT)
|
||||
(SELECTQ (AND CHECKSHADE (RAND 0 12))
|
||||
(0 CHECKSHADE)
|
||||
BLACKSHADE))
|
||||
(BLOCK 100])
|
||||
)
|
||||
|
||||
(RPAQQ CHECKSHADE 63903)
|
||||
|
||||
(RPAQQ KINETICWINDOW NIL)
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS (Kinetic (QUOTE KINETIC)))
|
||||
(PUTPROPS KINETIC COPYRIGHT ("Xerox Corporation" 1982 1985 1986))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (447 1420 (KINETIC 457 . 1418)))))
|
||||
(ADDTOVAR IDLE.FUNCTIONS (Kinetic 'KINETIC))
|
||||
(PUTPROPS KINETIC COPYRIGHT ("Xerox Corporation" 1982 1985 1986 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (573 1723 (KINETIC 583 . 1721)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,23 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "10-Feb-2022 22:17:51" {DSK}<home>larry>medley>lispusers>MANAGER.;4 111722
|
||||
(FILECREATED "15-Sep-2022 23:39:36" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;2 111145
|
||||
|
||||
:CHANGES-TO (ADVICE (MARKASCHANGED :IN DEFAULT.EDITDEFA0001)
|
||||
LOADFNS LOAD \ADDTOFILEBLOCK/ADDNEWCOM DELFROMCOMS ADDTOCOMS UPDATEFILES
|
||||
UNMARKASCHANGED MARKASCHANGED MAKEFILE ADDTOFILES? ADDFILE)
|
||||
(VARS MANAGERCOMS)
|
||||
(FNS Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT Manager.WINDOW
|
||||
Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE
|
||||
Manager.COLLECTCOMS Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE
|
||||
Manager.HIGHLIGHTED Manager.INSUREHIGHLIGHTS Manager.FILECHANGES
|
||||
Manager.FILELSTCHANGED? Manager.FILESUBTYPES Manager.GET.ENVIRONMENT
|
||||
Manager.GETFILE Manager.INTITLE? Manager.MAIN.WSF Manager.MAINCLOSE
|
||||
Manager.MAINMENUITEMS Manager.MAINOPEN Manager.MAINUPDATE Manager.MAKEFILE.ADV
|
||||
Manager.MENUCOLUMNS Manager.MENUHASITEM Manager.MENUITEMS
|
||||
Manager.REMOVE.DUPLICATE.ADVICE Manager.RESETSUBITEMS Manager.SORT.COMS
|
||||
Manager.SORTBYCOLUMN)
|
||||
:CHANGES-TO (FNS Manager.DO.COMMAND)
|
||||
|
||||
:PREVIOUS-DATE "18-Nov-87 15:18:24" |{POGO:AISNORTH:XEROX}<FISCHER>WORK>MANAGER.;2|)
|
||||
:PREVIOUS-DATE "10-Feb-2022 22:17:51" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -536,7 +523,10 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
UPDATEFILES])
|
||||
|
||||
(Manager.DO.COMMAND
|
||||
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 18-Nov-87 14:30 by raf")
|
||||
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 15-Sep-2022 23:35 by Matt Heffron")
|
||||
(* ; "Edited 15-Sep-2022 23:32 by Matt Heffron")
|
||||
(* ; "Edited 15-Sep-2022 23:19 by Matt Heffron")
|
||||
(* ; "Edited 18-Nov-87 14:30 by raf")
|
||||
(if (EQ COMSTYPE 'FILEVARS)
|
||||
then (SETQ COMSTYPE 'VARS) (* ; "The Manager currently does unnatural things with the FILEVARS type, this is a hack to compensate for it. E.g., editing a FILEVARS = editing the VARS, etc.")
|
||||
)
|
||||
@@ -730,12 +720,14 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
else (* ; "single item")
|
||||
(UNMARKASCHANGED ITEM COMSTYPE)))
|
||||
(SEE (FB.FASTSEE.ONEFILE
|
||||
FILE
|
||||
(LET [(W (CREATEW NIL (CONCAT "Seeing " FILE "..."]
|
||||
(DSPSCROLL 'ON W)
|
||||
(WINDOWPROP W 'PAGEFULLFN 'FB.SEEFULLFN)
|
||||
(TTYDISPLAYSTREAM W)
|
||||
W)))
|
||||
NIL FILE (LET [(W (CREATEW NIL (CONCAT "Seeing " FILE
|
||||
"..."]
|
||||
(DSPSCROLL 'ON W)
|
||||
(WINDOWPROP W 'PAGEFULLFN
|
||||
'FB.SEEFULLFN)
|
||||
(TTYDISPLAYSTREAM W)
|
||||
W)))
|
||||
(TEDIT-SEE (TEDIT-SEE FILE))
|
||||
(LOAD
|
||||
(printout T .FONT LAMBDAFONT "Loading file " FILE "."
|
||||
.FONT DEFAULTFONT T)
|
||||
@@ -1756,18 +1748,18 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
)
|
||||
(PUTPROPS MANAGER COPYRIGHT ("Xerox Corporation" 1986 1987 1900 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (25538 101851 (MANAGER 25548 . 26347) (MANAGER.RESET 26349 . 27863) (Manager.ADDADV
|
||||
27865 . 29218) (Manager.ADDTOFILES? 29220 . 29498) (Manager.ALTERMARKING 29500 . 31110) (
|
||||
Manager.DO.COMMAND 31112 . 62332) (Manager.HIGHLIGHT 62334 . 62631) (Manager.PROMPT 62633 . 62946) (
|
||||
Manager.WINDOW 62948 . 63581) (Manager.insurefilehighlights 63583 . 64654) (Manager.CHANGED? 64656 .
|
||||
65205) (Manager.CHECKFILE 65207 . 66306) (Manager.COLLECTCOMS 66308 . 67746) (Manager.COMS.WSF 67748
|
||||
. 70418) (Manager.COMSOPEN 70420 . 75158) (Manager.COMSUPDATE 75160 . 76252) (Manager.HIGHLIGHTED
|
||||
76254 . 76560) (Manager.INSUREHIGHLIGHTS 76562 . 77120) (Manager.FILECHANGES 77122 . 77421) (
|
||||
Manager.FILELSTCHANGED? 77423 . 77751) (Manager.FILESUBTYPES 77753 . 78391) (Manager.GET.ENVIRONMENT
|
||||
78393 . 80931) (Manager.GETFILE 80933 . 83247) (Manager.INTITLE? 83249 . 83927) (Manager.MAIN.WSF
|
||||
83929 . 86573) (Manager.MAINCLOSE 86575 . 87685) (Manager.MAINMENUITEMS 87687 . 88764) (
|
||||
Manager.MAINOPEN 88766 . 94142) (Manager.MAINUPDATE 94144 . 94780) (Manager.MAKEFILE.ADV 94782 . 95818
|
||||
) (Manager.MENUCOLUMNS 95820 . 96624) (Manager.MENUHASITEM 96626 . 96983) (Manager.MENUITEMS 96985 .
|
||||
97230) (Manager.REMOVE.DUPLICATE.ADVICE 97232 . 98838) (Manager.RESETSUBITEMS 98840 . 100077) (
|
||||
Manager.SORT.COMS 100079 . 100611) (Manager.SORTBYCOLUMN 100613 . 101849)))))
|
||||
(FILEMAP (NIL (24415 101274 (MANAGER 24425 . 25224) (MANAGER.RESET 25226 . 26740) (Manager.ADDADV
|
||||
26742 . 28095) (Manager.ADDTOFILES? 28097 . 28375) (Manager.ALTERMARKING 28377 . 29987) (
|
||||
Manager.DO.COMMAND 29989 . 61755) (Manager.HIGHLIGHT 61757 . 62054) (Manager.PROMPT 62056 . 62369) (
|
||||
Manager.WINDOW 62371 . 63004) (Manager.insurefilehighlights 63006 . 64077) (Manager.CHANGED? 64079 .
|
||||
64628) (Manager.CHECKFILE 64630 . 65729) (Manager.COLLECTCOMS 65731 . 67169) (Manager.COMS.WSF 67171
|
||||
. 69841) (Manager.COMSOPEN 69843 . 74581) (Manager.COMSUPDATE 74583 . 75675) (Manager.HIGHLIGHTED
|
||||
75677 . 75983) (Manager.INSUREHIGHLIGHTS 75985 . 76543) (Manager.FILECHANGES 76545 . 76844) (
|
||||
Manager.FILELSTCHANGED? 76846 . 77174) (Manager.FILESUBTYPES 77176 . 77814) (Manager.GET.ENVIRONMENT
|
||||
77816 . 80354) (Manager.GETFILE 80356 . 82670) (Manager.INTITLE? 82672 . 83350) (Manager.MAIN.WSF
|
||||
83352 . 85996) (Manager.MAINCLOSE 85998 . 87108) (Manager.MAINMENUITEMS 87110 . 88187) (
|
||||
Manager.MAINOPEN 88189 . 93565) (Manager.MAINUPDATE 93567 . 94203) (Manager.MAKEFILE.ADV 94205 . 95241
|
||||
) (Manager.MENUCOLUMNS 95243 . 96047) (Manager.MENUHASITEM 96049 . 96406) (Manager.MENUITEMS 96408 .
|
||||
96653) (Manager.REMOVE.DUPLICATE.ADVICE 96655 . 98261) (Manager.RESETSUBITEMS 98263 . 99500) (
|
||||
Manager.SORT.COMS 99502 . 100034) (Manager.SORTBYCOLUMN 100036 . 101272)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Mar-2022 23:20:21"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;40 30674
|
||||
(FILECREATED " 7-Oct-2022 21:45:29"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>MODERNIZE.;43 30755
|
||||
|
||||
:CHANGES-TO (FNS MODERNWINDOW.BUTTONEVENTFN)
|
||||
:CHANGES-TO (FNS MODERNWINDOW)
|
||||
|
||||
:PREVIOUS-DATE "25-Dec-2021 22:27:41"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;39)
|
||||
:PREVIOUS-DATE " 5-Mar-2022 23:20:21"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>MODERNIZE.;40)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MODERNIZECOMS)
|
||||
@@ -104,11 +104,12 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MODERNWINDOW
|
||||
[LAMBDA (WINDOW ANYWHERE TITLEPROPORTION) (* ; "Edited 8-Jul-2021 23:33 by rmk:")
|
||||
(* ; "Edited 3-Jul-2021 10:31 by rmk:")
|
||||
(* ; "Edited 24-Jun-2021 14:52 by rmk:")
|
||||
[LAMBDA (WINDOW ANYWHERE TITLEPROPORTION) (* ; "Edited 7-Oct-2022 21:45 by rmk")
|
||||
(* ; "Edited 8-Jul-2021 23:33 by rmk:")
|
||||
(* ; "Edited 3-Jul-2021 10:31 by rmk:")
|
||||
(* ; "Edited 24-Jun-2021 14:52 by rmk:")
|
||||
|
||||
(* ;; "This can be applied to windows that have been created with an unknown or unmodifiable buttoneventfn. If the window was previously modernized, we restore its original state first, in case it is called here with different parameters")
|
||||
(* ;; "This can be applied to windows that have been created with an unknown or unmodifiable buttoneventfn. If the window was previously modernized, we restore its original state first, in case it is called here with different parameters")
|
||||
|
||||
(CL:WHEN (AND TITLEPROPORTION (GREATERP TITLEPROPORTION 0.5))
|
||||
(ERROR "TITLEPROPORTION cannot be greater than .5"))
|
||||
@@ -117,9 +118,9 @@
|
||||
(WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN NIL))
|
||||
(WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN (WINDOWPROP WINDOW 'BUTTONEVENTFN))
|
||||
(WINDOWPROP WINDOW 'BUTTONEVENTFN (IF (OR ANYWHERE TITLEPROPORTION)
|
||||
THEN [FUNCTION (LAMBDA (WINDOW)
|
||||
(MODERNWINDOW.BUTTONEVENTFN
|
||||
WINDOW NIL T ,TITLEPROPORTION]
|
||||
THEN `[LAMBDA (WINDOW)
|
||||
(MODERNWINDOW.BUTTONEVENTFN WINDOW NIL T
|
||||
',TITLEPROPORTION]
|
||||
ELSE (FUNCTION MODERNWINDOW.BUTTONEVENTFN)))
|
||||
WINDOW])
|
||||
|
||||
@@ -613,12 +614,12 @@
|
||||
(ADDTOVAR LAMA MODERN-ADD-EXEC)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5129 11406 (MODERNWINDOW 5139 . 6594) (MODERNWINDOW.SETUP 6596 . 9545) (UNMODERNWINDOW
|
||||
9547 . 9941) (MODERNWINDOW.UNSETUP 9943 . 10755) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10757 . 11404)) (
|
||||
11471 21633 (MODERNWINDOW.BUTTONEVENTFN 11481 . 18508) (NEARTOP 18510 . 19438) (NEARESTCORNER 19440 .
|
||||
20319) (INCORNER.REGION 20321 . 21631)) (21691 24163 (MODERN-ADD-EXEC 21701 . 22132) (MODERN-SNAPW
|
||||
22134 . 22677) (TOTOPW.MODERNIZE 22679 . 23107) (MODERN-MENUBUTTONFN 23109 . 24161)) (24164 26593 (
|
||||
\MODERNIZED.FREEMENU.BUTTONEVENTFN 24174 . 24821) (MODERNIZED.TB.BUTTONEVENTFN 24823 . 26591)) (26634
|
||||
28913 (TEDIT.MODERNIZE 26644 . 27458) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27460 . 28582) (TEDIT.SELECTALL
|
||||
28584 . 28911)))))
|
||||
(FILEMAP (NIL (5125 11487 (MODERNWINDOW 5135 . 6675) (MODERNWINDOW.SETUP 6677 . 9626) (UNMODERNWINDOW
|
||||
9628 . 10022) (MODERNWINDOW.UNSETUP 10024 . 10836) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10838 . 11485))
|
||||
(11552 21714 (MODERNWINDOW.BUTTONEVENTFN 11562 . 18589) (NEARTOP 18591 . 19519) (NEARESTCORNER 19521
|
||||
. 20400) (INCORNER.REGION 20402 . 21712)) (21772 24244 (MODERN-ADD-EXEC 21782 . 22213) (MODERN-SNAPW
|
||||
22215 . 22758) (TOTOPW.MODERNIZE 22760 . 23188) (MODERN-MENUBUTTONFN 23190 . 24242)) (24245 26674 (
|
||||
\MODERNIZED.FREEMENU.BUTTONEVENTFN 24255 . 24902) (MODERNIZED.TB.BUTTONEVENTFN 24904 . 26672)) (26715
|
||||
28994 (TEDIT.MODERNIZE 26725 . 27539) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27541 . 28663) (TEDIT.SELECTALL
|
||||
28665 . 28992)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,284 +1,187 @@
|
||||
(FILECREATED "30-Jun-86 18:01:00" {PHYLUM}<LANNING>LISP>USERS>PAC-MAN-IDLE.;11 14703
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to: (VARS PAC-MAN-IDLECOMS)
|
||||
(FNS Pac-Man-Eat-Window Slow-Fade Pac-Man-Idle)
|
||||
(FILECREATED "24-Aug-2022 08:54:17" {DSK}<home>larry>medley>lispusers>PAC-MAN-IDLE.;2 17389
|
||||
|
||||
previous date: " 2-May-86 18:42:49" {PHYLUM}<LANNING>LISP>USERS>PAC-MAN-IDLE.;10)
|
||||
:CHANGES-TO (FNS Pac-Man-Eat-Window Pac-Man-Scout-Food)
|
||||
|
||||
:PREVIOUS-DATE "30-Jun-86 18:01:00" {DSK}<home>larry>medley>lispusers>PAC-MAN-IDLE.;1)
|
||||
|
||||
|
||||
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
|
||||
(* ; "
|
||||
Copyright (c) 1986 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PAC-MAN-IDLECOMS)
|
||||
|
||||
(RPAQQ PAC-MAN-IDLECOMS [(* * The Pac-Man idle function)
|
||||
(FNS Pac-Man-Eat-Window Pac-Man-Idle)
|
||||
(VARS DefaultPacManEatMask DefaultPacManIcon DefaultPacManMask)
|
||||
(INITVARS (Pac-Man-Delay 100)
|
||||
(pacManHorizonFactor .75)
|
||||
(pacManStarvationTime 75)
|
||||
(pacManEatMask DefaultPacManEatMask)
|
||||
(pacManIcon DefaultPacManIcon)
|
||||
(pacManMask DefaultPacManMask))
|
||||
(GLOBALVARS Pac-Man-Delay pacManHorizonFactor pacManStarvationTime
|
||||
pacManEatMask pacManIcon pacManMask)
|
||||
(FNS Pac-Man-Scout-Food)
|
||||
(* * Stuff for counting the bits on in a bitmap)
|
||||
(FNS Pac-Man-Amount-Of-Food)
|
||||
(MACROS Pac-Man-Convert-Word)
|
||||
(VARS (Pac-Man-Convert-Byte-Array (\ALLOCBLOCK 256 T)))
|
||||
(GLOBALVARS Pac-Man-Convert-Byte-Array)
|
||||
[P (for i from 0 to 255 do (\PUTBASE Pac-Man-Convert-Byte-Array i
|
||||
(bind (j _ i)
|
||||
while
|
||||
(NOT (ZEROP j))
|
||||
count
|
||||
(SETQ j (LOGAND j (SUB1 j]
|
||||
(* * Another idle function)
|
||||
(FNS Slow-Fade)
|
||||
[INITVARS (Slow-Fade-Delay 1000)
|
||||
(Default-Slow-Fade-Idle-Function (LISTGET IDLE.PROFILE
|
||||
(QUOTE DISPLAYFN]
|
||||
(GLOBALVARS Slow-Fade-Delay Default-Slow-Fade-Idle-Function)
|
||||
(* * Add them as idle functions)
|
||||
(ADDVARS (IDLE.FUNCTIONS ("Pac-man" (QUOTE Pac-Man-Idle))
|
||||
("Slow fade" (QUOTE Slow-Fade])
|
||||
(RPAQQ PAC-MAN-IDLECOMS
|
||||
[(* * The Pac-Man idle function)
|
||||
(FNS Pac-Man-Eat-Window Pac-Man-Idle)
|
||||
(VARS DefaultPacManEatMask DefaultPacManIcon DefaultPacManMask)
|
||||
(INITVARS (Pac-Man-Delay 100)
|
||||
(pacManHorizonFactor 0.75)
|
||||
(pacManStarvationTime 75)
|
||||
(pacManEatMask DefaultPacManEatMask)
|
||||
(pacManIcon DefaultPacManIcon)
|
||||
(pacManMask DefaultPacManMask))
|
||||
(GLOBALVARS Pac-Man-Delay pacManHorizonFactor pacManStarvationTime pacManEatMask pacManIcon
|
||||
pacManMask)
|
||||
(FNS Pac-Man-Scout-Food)
|
||||
(* * Stuff for counting the bits on in a bitmap)
|
||||
(FNS Pac-Man-Amount-Of-Food)
|
||||
(MACROS Pac-Man-Convert-Word)
|
||||
(VARS (Pac-Man-Convert-Byte-Array (\ALLOCBLOCK 256 T)))
|
||||
(GLOBALVARS Pac-Man-Convert-Byte-Array)
|
||||
[P (for i from 0 to 255 do (\PUTBASE Pac-Man-Convert-Byte-Array i
|
||||
(bind (j _ i)
|
||||
while
|
||||
(NOT (ZEROP j))
|
||||
count
|
||||
(SETQ j (LOGAND j (SUB1 j]
|
||||
(* * Another idle function)
|
||||
(FNS Slow-Fade)
|
||||
[INITVARS (Slow-Fade-Delay 1000)
|
||||
(Default-Slow-Fade-Idle-Function (LISTGET IDLE.PROFILE 'DISPLAYFN]
|
||||
(GLOBALVARS Slow-Fade-Delay Default-Slow-Fade-Idle-Function)
|
||||
(* * Add them as idle functions)
|
||||
(ADDVARS (IDLE.FUNCTIONS ("Pac-man" 'Pac-Man-Idle)
|
||||
("Slow fade" 'Slow-Fade])
|
||||
(* * The Pac-Man idle function)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(Pac-Man-Eat-Window
|
||||
[LAMBDA (window) (* smL "30-Jun-86 17:38")
|
||||
[LAMBDA (window) (* smL "30-Jun-86 17:38")
|
||||
|
||||
(* * Comment)
|
||||
(* * Comment)
|
||||
|
||||
(RESETLST
|
||||
(bind (minX _ (MINUS (QUOTIENT (BITMAPWIDTH pacManIcon)
|
||||
2)))
|
||||
(minY _ (MINUS (QUOTIENT (BITMAPHEIGHT pacManIcon)
|
||||
2)))
|
||||
(maxX _ (DIFFERENCE (WINDOWPROP window 'WIDTH)
|
||||
(QUOTIENT (BITMAPWIDTH pacManIcon)
|
||||
2)))
|
||||
(maxY _ (DIFFERENCE (WINDOWPROP window 'HEIGHT)
|
||||
(QUOTIENT (BITMAPHEIGHT pacManIcon)
|
||||
2)))
|
||||
(minimumSpeed _ 0.2)
|
||||
(maximumSpeed _ 1.0)
|
||||
(icon _ (DEFERREDCONSTANT (BITMAPCOPY pacManIcon)))
|
||||
(delayTimer _ (DEFERREDCONSTANT (SETUPTIMER 250)))
|
||||
[horizon _ (FIX (MAX 2 (TIMES (MIN (BITMAPWIDTH pacManIcon)
|
||||
(BITMAPHEIGHT pacManIcon))
|
||||
pacManHorizonFactor]
|
||||
(delta _ '(0 . 0))
|
||||
possibleDeltas x y (xSpeed _ 0)
|
||||
(ySpeed _ 0)
|
||||
[maxSpeed _ (TIMES 10 (MIN (BITMAPWIDTH pacManIcon)
|
||||
(BITMAPHEIGHT pacManIcon]
|
||||
(maxAcceleration _ (MIN (BITMAPWIDTH pacManIcon)
|
||||
(BITMAPHEIGHT pacManIcon)))
|
||||
(stepsWithoutFood _ 0) first [SETQ possibleDeltas
|
||||
(for pair in '((0 . -1)
|
||||
(-1 . 0)
|
||||
(1 . 0)
|
||||
(0 . 1)
|
||||
(0.707 . 0.707)
|
||||
(-0.707 . 0.707)
|
||||
(0.707 . -0.707)
|
||||
(-0.707 . -0.707))
|
||||
collect (CONS (FIX (TIMES horizon (CAR pair)))
|
||||
(FIX (TIMES horizon (CDR pair]
|
||||
(* Pick a random starting place)
|
||||
(SELECTQ (RAND 0 1)
|
||||
(0 (SETQ x (TIMES (WINDOWPROP window 'WIDTH)
|
||||
(RAND 0 1)))
|
||||
[SETQ y (RAND 0 (WINDOWPROP window 'HEIGHT])
|
||||
(1 [SETQ x (RAND 0 (WINDOWPROP window 'WIDTH]
|
||||
(SETQ y (TIMES (WINDOWPROP window 'WIDTH)
|
||||
(RAND 0 1))))
|
||||
NIL) while T
|
||||
do
|
||||
|
||||
(RESETLST (bind (minX _(MINUS (QUOTIENT (BITMAPWIDTH pacManIcon)
|
||||
2)))
|
||||
(minY _(MINUS (QUOTIENT (BITMAPHEIGHT pacManIcon)
|
||||
2)))
|
||||
(maxX _(DIFFERENCE (WINDOWPROP window (QUOTE WIDTH))
|
||||
(QUOTIENT (BITMAPWIDTH pacManIcon)
|
||||
2)))
|
||||
(maxY _(DIFFERENCE (WINDOWPROP window (QUOTE HEIGHT))
|
||||
(QUOTIENT (BITMAPHEIGHT pacManIcon)
|
||||
2)))
|
||||
(minimumSpeed _ .2)
|
||||
(maximumSpeed _ 1.0)
|
||||
(icon _(DEFERREDCONSTANT (BITMAPCOPY pacManIcon)))
|
||||
(delayTimer _(DEFERREDCONSTANT (SETUPTIMER 250)))
|
||||
[horizon _(FIX (MAX 2 (TIMES (MIN (BITMAPWIDTH pacManIcon)
|
||||
(BITMAPHEIGHT pacManIcon))
|
||||
pacManHorizonFactor]
|
||||
(delta _(QUOTE (0 . 0)))
|
||||
possibleDeltas x y (xSpeed _ 0)
|
||||
(ySpeed _ 0)
|
||||
[maxSpeed _(TIMES 10 (MIN (BITMAPWIDTH pacManIcon)
|
||||
(BITMAPHEIGHT pacManIcon]
|
||||
(maxAcceleration _(MIN (BITMAPWIDTH pacManIcon)
|
||||
(BITMAPHEIGHT pacManIcon)))
|
||||
(stepsWithoutFood _ 0)
|
||||
first [SETQ possibleDeltas (for pair in (QUOTE ((0 . -1)
|
||||
(-1 . 0)
|
||||
(1 . 0)
|
||||
(0 . 1)
|
||||
(.707 . .707)
|
||||
(-.707 . .707)
|
||||
(.707 . -.707)
|
||||
(-.707 . -.707)))
|
||||
collect (CONS (FIX (TIMES horizon
|
||||
(CAR pair)))
|
||||
(FIX (TIMES horizon
|
||||
(CDR pair]
|
||||
(* Pick a random starting place)
|
||||
(SELECTQ (RAND 0 1)
|
||||
[0 (SETQ x (TIMES (WINDOWPROP window (QUOTE WIDTH))
|
||||
(RAND 0 1)))
|
||||
(SETQ y (RAND 0 (WINDOWPROP window (QUOTE HEIGHT]
|
||||
[1 [SETQ x (RAND 0 (WINDOWPROP window (QUOTE WIDTH]
|
||||
(SETQ y (TIMES (WINDOWPROP window (QUOTE WIDTH))
|
||||
(RAND 0 1]
|
||||
NIL)
|
||||
while T
|
||||
do
|
||||
(* * Try to figure out which direction to go.
|
||||
Pick the one that would get us the most food.
|
||||
Make sure to block, and don't move to quickly
|
||||
(hah!))
|
||||
|
||||
(* * Try to figure out which direction to go. Pick the one that would get us the most food.
|
||||
Make sure to block, and don't move to quickly (hah!))
|
||||
(SETQ delayTimer (SETUPTIMER Pac-Man-Delay delayTimer))
|
||||
[SETQ delta (Pac-Man-Scout-Food
|
||||
window x y pacManEatMask possibleDeltas delta
|
||||
(DEFERREDCONSTANT (BITMAPCREATE
|
||||
(PLUS (TIMES 16 (QUOTIENT (BITMAPWIDTH pacManMask)
|
||||
16))
|
||||
(if (ZEROP (REMAINDER (BITMAPWIDTH pacManMask)
|
||||
16))
|
||||
then 0
|
||||
else 16))
|
||||
(BITMAPHEIGHT pacManMask]
|
||||
(COND
|
||||
((NOT (NULL delta)) (* Found some food)
|
||||
NIL)
|
||||
((GREATERP stepsWithoutFood pacManStarvationTime)
|
||||
(* Starving, so make a random jump)
|
||||
(change xSpeed (RAND (DIFFERENCE minX x)
|
||||
(DIFFERENCE maxX x)))
|
||||
(change ySpeed (RAND (DIFFERENCE minY y)
|
||||
(DIFFERENCE maxY y)))
|
||||
(SETQ stepsWithoutFood 0)
|
||||
(SETQ delta (CONS xSpeed ySpeed)))
|
||||
(T (add stepsWithoutFood 1)
|
||||
(change xSpeed (RAND (MINUS maxAcceleration)
|
||||
maxAcceleration))
|
||||
(change xSpeed (MAX (DIFFERENCE minX x)
|
||||
(MIN (DIFFERENCE maxX x)
|
||||
DATUM)))
|
||||
(change ySpeed (RAND (MINUS maxAcceleration)
|
||||
maxAcceleration))
|
||||
(change ySpeed (MAX (DIFFERENCE minY y)
|
||||
(MIN (DIFFERENCE maxY y)
|
||||
DATUM)))
|
||||
(SETQ delta (CONS xSpeed ySpeed)))
|
||||
(T (SETQ stepsWithoutFood 0)
|
||||
(SETQ xSpeed 0)
|
||||
(SETQ ySpeed 0)))
|
||||
(do (BLOCK) repeatuntil (TIMEREXPIRED? delayTimer))
|
||||
|
||||
(* * Eat the food at the current location)
|
||||
|
||||
(SETQ delayTimer (SETUPTIMER Pac-Man-Delay delayTimer))
|
||||
[SETQ delta (Pac-Man-Scout-Food
|
||||
window x y pacManEatMask possibleDeltas delta
|
||||
(DEFERREDCONSTANT (BITMAPCREATE
|
||||
(PLUS (TIMES 16 (QUOTIENT (BITMAPWIDTH
|
||||
pacManMask)
|
||||
16))
|
||||
(if (ZEROP (REMAINDER (BITMAPWIDTH
|
||||
pacManMask)
|
||||
16))
|
||||
then 0
|
||||
else 16))
|
||||
(BITMAPHEIGHT pacManMask]
|
||||
(COND
|
||||
((NOT (NULL delta)) (* Found some food)
|
||||
NIL)
|
||||
((GREATERP stepsWithoutFood pacManStarvationTime)
|
||||
(* Starving, so make a random jump)
|
||||
(change xSpeed (RAND (DIFFERENCE minX x)
|
||||
(DIFFERENCE maxX x)))
|
||||
(change ySpeed (RAND (DIFFERENCE minY y)
|
||||
(DIFFERENCE maxY y)))
|
||||
(SETQ stepsWithoutFood 0)
|
||||
(SETQ delta (CONS xSpeed ySpeed)))
|
||||
(T (add stepsWithoutFood 1)
|
||||
(change xSpeed (RAND (MINUS maxAcceleration)
|
||||
maxAcceleration))
|
||||
(change xSpeed (MAX (DIFFERENCE minX x)
|
||||
(MIN (DIFFERENCE maxX x)
|
||||
DATUM)))
|
||||
(change ySpeed (RAND (MINUS maxAcceleration)
|
||||
maxAcceleration))
|
||||
(change ySpeed (MAX (DIFFERENCE minY y)
|
||||
(MIN (DIFFERENCE maxY y)
|
||||
DATUM)))
|
||||
(SETQ delta (CONS xSpeed ySpeed)))
|
||||
(T (SETQ stepsWithoutFood 0)
|
||||
(SETQ xSpeed 0)
|
||||
(SETQ ySpeed 0)))
|
||||
(do (BLOCK) repeatuntil (TIMEREXPIRED? delayTimer))
|
||||
(BITBLT pacManEatMask NIL NIL window x y NIL NIL 'INPUT 'ERASE)
|
||||
|
||||
(* * Eat the food at the current location)
|
||||
(* * Update my location)
|
||||
|
||||
|
||||
(BITBLT pacManEatMask NIL NIL window x y NIL NIL (QUOTE INPUT)
|
||||
(QUOTE ERASE))
|
||||
|
||||
(* * Update my location)
|
||||
|
||||
|
||||
[change x (FIX (MAX minX (MIN maxX (PLUS DATUM
|
||||
(TIMES (RAND
|
||||
minimumSpeed
|
||||
maximumSpeed)
|
||||
(CAR delta]
|
||||
[change y (FIX (MAX minY (MIN maxY (PLUS DATUM
|
||||
(TIMES (RAND
|
||||
minimumSpeed
|
||||
maximumSpeed)
|
||||
(CDR delta]
|
||||
(BITBLT window x y icon NIL NIL NIL NIL (QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
(BITBLT pacManMask NIL NIL icon NIL NIL NIL NIL (QUOTE INPUT)
|
||||
(QUOTE ERASE))
|
||||
(BITBLT pacManIcon NIL NIL icon NIL NIL NIL NIL (QUOTE INPUT)
|
||||
(QUOTE PAINT))
|
||||
(BITBLT icon NIL NIL window x y NIL NIL (QUOTE INPUT)
|
||||
(QUOTE REPLACE])
|
||||
[change x (FIX (MAX minX (MIN maxX (PLUS DATUM (TIMES (RAND minimumSpeed maximumSpeed)
|
||||
(CAR delta]
|
||||
[change y (FIX (MAX minY (MIN maxY (PLUS DATUM (TIMES (RAND minimumSpeed maximumSpeed)
|
||||
(CDR delta]
|
||||
(BITBLT window x y icon NIL NIL NIL NIL 'INPUT 'REPLACE)
|
||||
(BITBLT pacManMask NIL NIL icon NIL NIL NIL NIL 'INPUT 'ERASE)
|
||||
(BITBLT pacManIcon NIL NIL icon NIL NIL NIL NIL 'INPUT 'PAINT)
|
||||
(BITBLT icon NIL NIL window x y NIL NIL 'INPUT 'REPLACE)))])
|
||||
|
||||
(Pac-Man-Idle
|
||||
[LAMBDA (window) (* smL "30-Jun-86 17:41")
|
||||
[LAMBDA (window) (* smL "30-Jun-86 17:41")
|
||||
|
||||
(* * A hungry idle function)
|
||||
(* * A hungry idle function)
|
||||
|
||||
|
||||
(BITBLT (WINDOWPROP window (QUOTE IMAGECOVERED))
|
||||
NIL NIL window NIL NIL NIL NIL (QUOTE INVERT)
|
||||
(QUOTE REPLACE))
|
||||
(BITBLT (WINDOWPROP window 'IMAGECOVERED)
|
||||
NIL NIL window NIL NIL NIL NIL 'INVERT 'REPLACE)
|
||||
(Pac-Man-Eat-Window window])
|
||||
)
|
||||
|
||||
(RPAQ DefaultPacManEatMask (READBITMAP))
|
||||
(27 27
|
||||
"@@AO@@@@"
|
||||
"@@GOL@@@"
|
||||
"@AOOO@@@"
|
||||
"@GOOOL@@"
|
||||
"@OOOON@@"
|
||||
"AOOOOO@@"
|
||||
"AOOOOO@@"
|
||||
"COOOOOH@"
|
||||
"COOOOOH@"
|
||||
"GOOOOOL@"
|
||||
"GOOOOOL@"
|
||||
"OOOOOON@"
|
||||
"OOOOOON@"
|
||||
"OOOOOON@"
|
||||
"OOOOOON@"
|
||||
"OOOOOON@"
|
||||
"GOOOOOL@"
|
||||
"GOOOOOL@"
|
||||
"COOOOOH@"
|
||||
"COOOOOH@"
|
||||
"AOOOOO@@"
|
||||
"AOOOOO@@"
|
||||
"@OOOON@@"
|
||||
"@GOOOL@@"
|
||||
"@AOOO@@@"
|
||||
"@@GOL@@@"
|
||||
"@@AO@@@@")
|
||||
(RPAQQ DefaultPacManEatMask #*(27 27)@@AO@@@@@@GOL@@@@AOOO@@@@GOOOL@@@OOOON@@AOOOOO@@AOOOOO@@COOOOOH@COOOOOH@GOOOOOL@GOOOOOL@OOOOOON@OOOOOON@OOOOOON@OOOOOON@OOOOOON@GOOOOOL@GOOOOOL@COOOOOH@COOOOOH@AOOOOO@@AOOOOO@@@OOOON@@@GOOOL@@@AOOO@@@@@GOL@@@@@AO@@@@
|
||||
)
|
||||
|
||||
(RPAQ DefaultPacManIcon (READBITMAP))
|
||||
(27 27
|
||||
"@@AE@@@@"
|
||||
"@@EED@@@"
|
||||
"@@JJJ@@@"
|
||||
"@BJJJH@@"
|
||||
"@EEEED@@"
|
||||
"AEEGME@@"
|
||||
"@JJONJ@@"
|
||||
"BJJONJH@"
|
||||
"AEEEEE@@"
|
||||
"EEEEEED@"
|
||||
"BJJJJJH@"
|
||||
"JJJJJJJ@"
|
||||
"EEEEEED@"
|
||||
"EEEEEED@"
|
||||
"JJJH@@@@"
|
||||
"JJJJ@@@@"
|
||||
"EEEE@@@@"
|
||||
"EEEE@@@@"
|
||||
"BJJJH@@@"
|
||||
"BJJJJ@@@"
|
||||
"AEEEE@@@"
|
||||
"AEEEE@@@"
|
||||
"@JJJJH@@"
|
||||
"@BJJJH@@"
|
||||
"@AEEE@@@"
|
||||
"@@EED@@@"
|
||||
"@@@J@@@@")
|
||||
(RPAQQ DefaultPacManIcon #*(27 27)@@AE@@@@@@EED@@@@@JJJ@@@@BJJJH@@@EEEED@@AEEGME@@@JJONJ@@BJJONJH@AEEEEE@@EEEEEED@BJJJJJH@JJJJJJJ@EEEEEED@EEEEEED@JJJH@@@@JJJJ@@@@EEEE@@@@EEEE@@@@BJJJH@@@BJJJJ@@@AEEEE@@@AEEEE@@@@JJJJH@@@BJJJH@@@AEEE@@@@@EED@@@@@@J@@@@
|
||||
)
|
||||
|
||||
(RPAQ DefaultPacManMask (READBITMAP))
|
||||
(27 27
|
||||
"@@AO@@@@"
|
||||
"@@GOL@@@"
|
||||
"@AOOO@@@"
|
||||
"@GOOOL@@"
|
||||
"@OOOON@@"
|
||||
"AOOOOO@@"
|
||||
"AOOOOO@@"
|
||||
"COOOOOH@"
|
||||
"COOOOOH@"
|
||||
"GOOOOOL@"
|
||||
"GOOOOOL@"
|
||||
"OOOOOON@"
|
||||
"OOOOOON@"
|
||||
"OOOOOON@"
|
||||
"OOOL@@@@"
|
||||
"OOON@@@@"
|
||||
"GOOO@@@@"
|
||||
"GOOOH@@@"
|
||||
"COOOL@@@"
|
||||
"COOON@@@"
|
||||
"AOOOO@@@"
|
||||
"AOOOOH@@"
|
||||
"@OOOOL@@"
|
||||
"@GOOOL@@"
|
||||
"@AOOO@@@"
|
||||
"@@GOL@@@"
|
||||
"@@AO@@@@")
|
||||
(RPAQQ DefaultPacManMask #*(27 27)@@AO@@@@@@GOL@@@@AOOO@@@@GOOOL@@@OOOON@@AOOOOO@@AOOOOO@@COOOOOH@COOOOOH@GOOOOOL@GOOOOOL@OOOOOON@OOOOOON@OOOOOON@OOOL@@@@OOON@@@@GOOO@@@@GOOOH@@@COOOL@@@COOON@@@AOOOO@@@AOOOOH@@@OOOOL@@@GOOOL@@@AOOO@@@@@GOL@@@@@AO@@@@
|
||||
)
|
||||
|
||||
(RPAQ? Pac-Man-Delay 100)
|
||||
|
||||
(RPAQ? pacManHorizonFactor .75)
|
||||
(RPAQ? pacManHorizonFactor 0.75)
|
||||
|
||||
(RPAQ? pacManStarvationTime 75)
|
||||
|
||||
@@ -287,164 +190,150 @@
|
||||
(RPAQ? pacManIcon DefaultPacManIcon)
|
||||
|
||||
(RPAQ? pacManMask DefaultPacManMask)
|
||||
(DECLARE: DOEVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS Pac-Man-Delay pacManHorizonFactor pacManStarvationTime pacManEatMask pacManIcon
|
||||
pacManMask)
|
||||
pacManMask)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(Pac-Man-Scout-Food
|
||||
[LAMBDA (window x y mask possibleDeltas prevDelta tempBitMap)
|
||||
(* smL "29-Apr-86 12:55")
|
||||
|
||||
(* * Return the x-y pair of directions to go to get the most food)
|
||||
(* smL "29-Apr-86 12:55")
|
||||
|
||||
(* * Return the x-y pair of directions to go to get the most food)
|
||||
|
||||
(for i from 1 to 8 bind direction
|
||||
thereis [SETQ direction (for offsetPair in [for x in possibleDeltas
|
||||
collect (CONS (TIMES i
|
||||
(CAR x))
|
||||
(TIMES i
|
||||
(CDR x]
|
||||
bind xoffset yoffset amountOfFood (mostFood _ 0)
|
||||
(mostFoodDirections _ NIL)
|
||||
do (SETQ xoffset (CAR offsetPair))
|
||||
(SETQ yoffset (CDR offsetPair))
|
||||
thereis [SETQ direction (for offsetPair in [for x in possibleDeltas
|
||||
collect (CONS (TIMES i (CAR x))
|
||||
(TIMES i (CDR x]
|
||||
bind xoffset yoffset amountOfFood (mostFood _ 0)
|
||||
(mostFoodDirections _ NIL)
|
||||
do (SETQ xoffset (CAR offsetPair))
|
||||
(SETQ yoffset (CDR offsetPair))
|
||||
|
||||
(* * Build a bitmap of the food available at the location. -
|
||||
This requires computing the number of bits that are black both in the window and in the mask.
|
||||
-
|
||||
We want black bits in the window because things have been inverted by idle and we are trying to eat white bits, and
|
||||
we want black bits in the mask because that is what defines the mask.)
|
||||
|
||||
(* Copy the screen bits into the temp bitmap.)
|
||||
(BITBLT NIL NIL NIL tempBitMap NIL NIL NIL NIL
|
||||
(QUOTE TEXTURE)
|
||||
(QUOTE REPLACE)
|
||||
WHITESHADE)
|
||||
(BITBLT window (PLUS xoffset x)
|
||||
(PLUS yoffset y)
|
||||
tempBitMap NIL NIL NIL NIL (QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
(* Or in the white bits of the mask at the appropriate
|
||||
location.)
|
||||
(BITBLT mask NIL NIL tempBitMap NIL NIL NIL NIL
|
||||
(QUOTE INVERT)
|
||||
(QUOTE ERASE))
|
||||
(* Clear out the image of the current position of the
|
||||
mask.)
|
||||
(BITBLT NIL NIL NIL tempBitMap NIL NIL NIL NIL
|
||||
(QUOTE TEXTURE)
|
||||
(QUOTE INVERT)
|
||||
BLACKSHADE)
|
||||
(BITBLT mask (MAX 0 xoffset)
|
||||
(MAX 0 yoffset)
|
||||
tempBitMap
|
||||
(MAX 0 (MINUS xoffset))
|
||||
(MAX 0 (MINUS yoffset))
|
||||
NIL NIL (QUOTE INPUT)
|
||||
(QUOTE PAINT))
|
||||
(BITBLT NIL NIL NIL tempBitMap NIL NIL NIL NIL
|
||||
(QUOTE TEXTURE)
|
||||
(QUOTE INVERT)
|
||||
BLACKSHADE)
|
||||
(* Compute the amount of food)
|
||||
(SETQ amountOfFood (Pac-Man-Amount-Of-Food tempBitMap))
|
||||
(* Remember the directions with the most food)
|
||||
(if (LESSP amountOfFood mostFood)
|
||||
then (* This direction loses)
|
||||
NIL
|
||||
elseif (EQP amountOfFood mostFood)
|
||||
then (* This is a possible direction)
|
||||
(push mostFoodDirections offsetPair)
|
||||
else (* This direction dominates)
|
||||
(SETQ mostFood amountOfFood)
|
||||
(SETQ mostFoodDirections (LIST offsetPair)))
|
||||
finally (RETURN (if (ZEROP mostFood)
|
||||
then NIL
|
||||
else (CAR (NTH mostFoodDirections
|
||||
(RAND
|
||||
1
|
||||
(LENGTH
|
||||
mostFoodDirections]
|
||||
finally (RETURN direction])
|
||||
(* * Build a bitmap of the food available at the location.
|
||||
-
|
||||
This requires computing the number of bits that are black both in the window and
|
||||
in the mask. -
|
||||
We want black bits in the window because things have been inverted by idle and we
|
||||
are trying to eat white bits, and we want black bits in the mask because that is
|
||||
what defines the mask.)
|
||||
(* Copy the screen bits into the temp
|
||||
bitmap.)
|
||||
(BITBLT NIL NIL NIL tempBitMap NIL NIL NIL NIL 'TEXTURE
|
||||
'REPLACE WHITESHADE)
|
||||
(BITBLT window (PLUS xoffset x)
|
||||
(PLUS yoffset y)
|
||||
tempBitMap NIL NIL NIL NIL 'INPUT 'REPLACE)
|
||||
(* Or in the white bits of the mask at
|
||||
the appropriate location.)
|
||||
(BITBLT mask NIL NIL tempBitMap NIL NIL NIL NIL 'INVERT
|
||||
'ERASE) (* Clear out the image of the current
|
||||
position of the mask.)
|
||||
(BITBLT NIL NIL NIL tempBitMap NIL NIL NIL NIL 'TEXTURE
|
||||
'INVERT BLACKSHADE)
|
||||
(BITBLT mask (MAX 0 xoffset)
|
||||
(MAX 0 yoffset)
|
||||
tempBitMap
|
||||
(MAX 0 (MINUS xoffset))
|
||||
(MAX 0 (MINUS yoffset))
|
||||
NIL NIL 'INPUT 'PAINT)
|
||||
(BITBLT NIL NIL NIL tempBitMap NIL NIL NIL NIL 'TEXTURE
|
||||
'INVERT BLACKSHADE)
|
||||
(* Compute the amount of food)
|
||||
(SETQ amountOfFood (Pac-Man-Amount-Of-Food tempBitMap))
|
||||
(* Remember the directions with the
|
||||
most food)
|
||||
(if (LESSP amountOfFood mostFood)
|
||||
then (* This direction loses)
|
||||
NIL
|
||||
elseif (EQP amountOfFood mostFood)
|
||||
then (* This is a possible direction)
|
||||
(push mostFoodDirections offsetPair)
|
||||
else (* This direction dominates)
|
||||
(SETQ mostFood amountOfFood)
|
||||
(SETQ mostFoodDirections (LIST offsetPair)))
|
||||
finally (RETURN (if (ZEROP mostFood)
|
||||
then NIL
|
||||
else (CAR (NTH mostFoodDirections
|
||||
(RAND 1 (LENGTH mostFoodDirections
|
||||
]
|
||||
finally (RETURN direction])
|
||||
)
|
||||
(* * Stuff for counting the bits on in a bitmap)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(Pac-Man-Amount-Of-Food
|
||||
[LAMBDA (bitMap) (* smL "29-Apr-86 13:23")
|
||||
[LAMBDA (bitMap) (* smL "29-Apr-86 13:23")
|
||||
|
||||
(* * How much food is there in the bitmap?)
|
||||
(* * How much food is there in the bitmap?)
|
||||
|
||||
|
||||
(for j from 0 to (QUOTIENT (TIMES (BITMAPHEIGHT bitMap)
|
||||
(BITMAPWIDTH bitMap))
|
||||
16)
|
||||
bind (bitmapBase _(fetch (BITMAP BITMAPBASE) of bitMap)) sum (Pac-Man-Convert-Word
|
||||
(\GETBASE bitmapBase
|
||||
j])
|
||||
(for j from 0 to (QUOTIENT (TIMES (BITMAPHEIGHT bitMap)
|
||||
(BITMAPWIDTH bitMap))
|
||||
16) bind (bitmapBase _ (fetch (BITMAP BITMAPBASE) of bitMap))
|
||||
sum (Pac-Man-Convert-Word (\GETBASE bitmapBase j])
|
||||
)
|
||||
(DECLARE: EVAL@COMPILE
|
||||
[DEFMACRO Pac-Man-Convert-Word (word)
|
||||
(* * Count up the number of bits on in the word)
|
||||
(BQUOTE (PLUS (\GETBASE Pac-Man-Convert-Byte-Array (LRSH , word 8))
|
||||
(\GETBASE Pac-Man-Convert-Byte-Array (LOGAND , word 255]
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PROGN (DEFMACRO Pac-Man-Convert-Word (word)
|
||||
|
||||
|
||||
(* * Count up the number of bits on in the word)
|
||||
|
||||
`(PLUS (\GETBASE Pac-Man-Convert-Byte-Array (LRSH %, word 8))
|
||||
(\GETBASE Pac-Man-Convert-Byte-Array (LOGAND %, word 255))))
|
||||
NIL)
|
||||
)
|
||||
|
||||
(RPAQ Pac-Man-Convert-Byte-Array (\ALLOCBLOCK 256 T))
|
||||
(DECLARE: DOEVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS Pac-Man-Convert-Byte-Array)
|
||||
)
|
||||
[for i from 0 to 255 do (\PUTBASE Pac-Man-Convert-Byte-Array i (bind (j _ i)
|
||||
while
|
||||
(NOT (ZEROP j))
|
||||
count
|
||||
(SETQ j (LOGAND j (SUB1 j]
|
||||
|
||||
[for i from 0 to 255 do (\PUTBASE Pac-Man-Convert-Byte-Array i (bind (j _ i)
|
||||
while (NOT (ZEROP j))
|
||||
count (SETQ j (LOGAND j
|
||||
(SUB1 j]
|
||||
(* * Another idle function)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(Slow-Fade
|
||||
[LAMBDA (window) (* smL "30-Jun-86 17:16")
|
||||
[LAMBDA (window) (* smL "30-Jun-86 17:16")
|
||||
|
||||
(* * Slowly fade the idle window to black)
|
||||
(* * Slowly fade the idle window to black)
|
||||
|
||||
|
||||
(BITBLT (WINDOWPROP window (QUOTE IMAGECOVERED))
|
||||
NIL NIL window NIL NIL NIL NIL (QUOTE INVERT)
|
||||
(QUOTE REPLACE))
|
||||
[LET [(fadeTextures (for i from 0 to 15 collect (LLSH 1 i]
|
||||
(BITBLT (WINDOWPROP window 'IMAGECOVERED)
|
||||
NIL NIL window NIL NIL NIL NIL 'INVERT 'REPLACE)
|
||||
[LET [(fadeTextures (for i from 0 to 15 collect (LLSH 1 i]
|
||||
(while fadeTextures bind selectedTexture
|
||||
do (BLOCK Slow-Fade-Delay)
|
||||
(SETQ selectedTexture (LLSH 1 (RAND 0 15)))
|
||||
(BITBLT NIL NIL NIL window NIL NIL NIL NIL (QUOTE TEXTURE)
|
||||
(QUOTE ERASE)
|
||||
selectedTexture)
|
||||
(SETQ fadeTextures (DREMOVE selectedTexture fadeTextures]
|
||||
(BLOCK Slow-Fade-Delay)
|
||||
(APPLY* (OR Default-Slow-Fade-Idle-Function (FUNCTION IDLE.BOUNCING.BOX))
|
||||
window])
|
||||
do (BLOCK Slow-Fade-Delay)
|
||||
(SETQ selectedTexture (LLSH 1 (RAND 0 15)))
|
||||
(BITBLT NIL NIL NIL window NIL NIL NIL NIL 'TEXTURE 'ERASE selectedTexture)
|
||||
(SETQ fadeTextures (DREMOVE selectedTexture fadeTextures]
|
||||
(BLOCK Slow-Fade-Delay)
|
||||
(APPLY* (OR Default-Slow-Fade-Idle-Function (FUNCTION IDLE.BOUNCING.BOX))
|
||||
window])
|
||||
)
|
||||
|
||||
(RPAQ? Slow-Fade-Delay 1000)
|
||||
|
||||
(RPAQ? Default-Slow-Fade-Idle-Function (LISTGET IDLE.PROFILE (QUOTE DISPLAYFN)))
|
||||
(DECLARE: DOEVAL@COMPILE DONTCOPY
|
||||
(RPAQ? Default-Slow-Fade-Idle-Function (LISTGET IDLE.PROFILE 'DISPLAYFN))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS Slow-Fade-Delay Default-Slow-Fade-Idle-Function)
|
||||
)
|
||||
(* * Add them as idle functions)
|
||||
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Pac-man" (QUOTE Pac-Man-Idle))
|
||||
("Slow fade" (QUOTE Slow-Fade)))
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Pac-man" 'Pac-Man-Idle)
|
||||
("Slow fade" 'Slow-Fade))
|
||||
(PUTPROPS PAC-MAN-IDLE COPYRIGHT ("Xerox Corporation" 1986))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (1826 7263 (Pac-Man-Eat-Window 1836 . 6918) (Pac-Man-Idle 6920 . 7261)) (8683 12226 (
|
||||
Pac-Man-Scout-Food 8693 . 12224)) (12282 12768 (Pac-Man-Amount-Of-Food 12292 . 12766)) (13370 14261 (
|
||||
Slow-Fade 13380 . 14259)))))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2093 8924 (Pac-Man-Eat-Window 2103 . 8625) (Pac-Man-Idle 8627 . 8922)) (10090 14734 (
|
||||
Pac-Man-Scout-Food 10100 . 14732)) (14790 15275 (Pac-Man-Amount-Of-Food 14800 . 15273)) (16137 16947 (
|
||||
Slow-Fade 16147 . 16945)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
87
lispusers/PICK
Normal file
87
lispusers/PICK
Normal file
@@ -0,0 +1,87 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "11-Aug-2022 17:53:58" {DSK}<home>larry>medley>lispusers>PICK.;3 4261
|
||||
|
||||
:CHANGES-TO (VARS PICKCOMS)
|
||||
(FNS PICK)
|
||||
|
||||
:PREVIOUS-DATE "10-Aug-2022 16:57:49" {DSK}<home>larry>medley>lispusers>PICK.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PICKCOMS)
|
||||
|
||||
(RPAQQ PICKCOMS ((COMMANDS "pick")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOP)
|
||||
GITFNS))
|
||||
(FILES GITFNS)
|
||||
(FNS PICK)))
|
||||
|
||||
(DEFCOMMAND "pick" (FIRST . REST) (PICK FIRST REST))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (LOADCOP)
|
||||
GITFNS)
|
||||
)
|
||||
|
||||
(FILESLOAD GITFNS)
|
||||
(DEFINEQ
|
||||
|
||||
(PICK
|
||||
[LAMBDA (TYPE CHOICES) (* ; "Edited 11-Aug-2022 17:15 by lmm")
|
||||
(* ; "Edited 10-Aug-2022 16:57 by lmm")
|
||||
(SELECTQ (MKATOM (U-CASE (MKSTRING TYPE)))
|
||||
(ONEOF (* ;
|
||||
"PICK ONEOF A1 A2 A3 ... - just choose from choices listed")
|
||||
[CAR (NTH CHOICES (RAND 1 (LENGTH CHOICES])
|
||||
(NIL (* ;
|
||||
"pick -- choose an issue, a file, a project")
|
||||
[PICK (PICK 'ONEOF '(FILE ISSUE PROJECT])
|
||||
(ISSUE (* ;
|
||||
"pick issue [number] -- display an issue; if none given, choose one at random")
|
||||
(LET ([ISSUE (PICK 'ONEOF (OR CHOICES (GIT-COMMAND
|
||||
"gh issue list -L 5000 -R interlisp/medley | sed 's/\([0-9]*\).*/\1/'"
|
||||
]
|
||||
(STR (OPENTEXTSTREAM))
|
||||
(COMMENTS T)
|
||||
(TITLE))
|
||||
(for S in (GIT-COMMAND (CL:FORMAT NIL "gh issue view -R interlisp/medley ~d"
|
||||
ISSUE)) do (CL:FORMAT STR "~a~&" S)
|
||||
finally
|
||||
|
||||
(* ;;
|
||||
"this TEDIT call is wrong -- it takes the keyboard and the promptwindow prompt is wrong")
|
||||
|
||||
[TEDIT STR NIL NIL `(READONLY T TITLE ,(SETQ TITLE (CL:FORMAT NIL
|
||||
"Issue #~d"
|
||||
ISSUE]
|
||||
|
||||
(* ;; "if there are comments (or always) show comments too -- the -w switch doesn't work online -- no browser")
|
||||
|
||||
(IF COMMENTS
|
||||
THEN (GIT-COMMAND (CL:FORMAT NIL
|
||||
"gh issue view -R interlisp/medley ~a -w"
|
||||
ISSUE)))
|
||||
(RETURN TITLE))))
|
||||
(DIR
|
||||
(* ;; "pick a directory to choose files from")
|
||||
|
||||
(PICK 'ONEOF '(LISPUSERS LIBRARY DOCTOOLS SOURCES INTERNAL)))
|
||||
(FILE
|
||||
(* ;; " pick a file from a (randomly chosen) directory")
|
||||
|
||||
[LIST 'FILE (PICK 'ONEOF (DIRECTORY (OR (MEDLEYDIR (OR (CAR CHOICES)
|
||||
(PICK 'DIR))
|
||||
NIL T)
|
||||
(FETCH (GIT-PROJECT CLONEPATH)
|
||||
OF (CDR (ASSOC (CAR CHOICES)
|
||||
GIT-PROJECTS])
|
||||
(PROJECT
|
||||
(* ;; "pick PROJECT will choose some repo to work on")
|
||||
|
||||
[PICK 'ONEOF (PICK 'ONEOF (LIST (MAPCAR GIT-PROJECTS #'CAR)
|
||||
'(CLOS ROOMS ONLINE WEBSITE COMMUNITY ENVOS])
|
||||
(HELP TYPE "Unknown type"])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (735 4238 (PICK 745 . 4236)))))
|
||||
STOP
|
||||
BIN
lispusers/PICK.LCOM
Normal file
BIN
lispusers/PICK.LCOM
Normal file
Binary file not shown.
BIN
lispusers/PICK.TEDIT
Normal file
BIN
lispusers/PICK.TEDIT
Normal file
Binary file not shown.
@@ -1,18 +1,20 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(FILECREATED "12-Aug-87 03:05:50" {PHYLUM}<SHRAGER>LISP>QIX.\;3 11097
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
|changes| |to:| (VARS QIXCOMS)
|
||||
(FILECREATED "24-Aug-2022 07:58:48" |{DSK}<home>larry>medley>lispusers>QIX.;2| 11276
|
||||
|
||||
|previous| |date:| " 1-Aug-87 17:04:27" {PHYLUM}<SHRAGER>LISP>QIX.\;2)
|
||||
:CHANGES-TO (FNS QIX.IDLE)
|
||||
|
||||
:PREVIOUS-DATE "12-Aug-87 03:05:50" |{DSK}<home>larry>medley>lispusers>QIX.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1987 by Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1987 by Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT QIXCOMS)
|
||||
|
||||
(RPAQQ QIXCOMS ((FNS QIX.GROW QIX.IDLE QIX.MOVE.POINT QIX.PLAY)
|
||||
(RECORDS QIX.POINT)
|
||||
(P (SETQ IDLE.FUNCTIONS (CONS '("5 Qix's" 'QIX.IDLE) IDLE.FUNCTIONS)))))
|
||||
(P (SETQ IDLE.FUNCTIONS (CONS '("5 Qix's" 'QIX.IDLE)
|
||||
IDLE.FUNCTIONS)))))
|
||||
(DEFINEQ
|
||||
|
||||
(QIX.GROW
|
||||
@@ -109,16 +111,18 @@
|
||||
(GO LOOP))))
|
||||
|
||||
(QIX.IDLE
|
||||
(LAMBDA (W) (* \; "Edited 1-Aug-87 16:58 by JEFF.SHRAGER")
|
||||
|
||||
(* * CLOBBER ANY OLD QIXS THAT WERE LEFT AROUND
|
||||
(WASTING SPACE) FROM BEFORE.)
|
||||
(LAMBDA (W) (* \; "Edited 24-Aug-2022 07:53 by larry")
|
||||
(* \;
|
||||
"Edited 1-Aug-87 16:58 by JEFF.SHRAGER")
|
||||
|
||||
(* * CLOBBER ANY OLD QIXS THAT WERE LEFT AROUND
|
||||
(WASTING SPACE) FROM BEFORE.)
|
||||
|
||||
(AND (BOUNDP '*OLD-QIXS*)
|
||||
(FOR Q IN *OLD-QIXS* DO (RPLACD Q NIL)))
|
||||
(PROG (P P2 L QIXS)
|
||||
|
||||
(* * P |and| P2 |define| \a QIX.)
|
||||
|
||||
(* * P |and| P2 |define| \a QIX.)
|
||||
|
||||
(SETQ QIXS (|for| I |from| 1 |to| 5
|
||||
|collect| (PROGN (SETQ P (|create| QIX.POINT
|
||||
@@ -131,10 +135,10 @@
|
||||
Y _ (RAND 1 100)
|
||||
VH _ (RAND 1 20)
|
||||
VV _ (RAND 1 20)))
|
||||
|
||||
(* * L |is| |the| |tail| |list.| I\t |starts| |out| |full| |of| NIL\s |and|
|
||||
|gets| |filled| |as| |the| QIX |moves.| I\t |is| |also| |inserted| |in| |it's|
|
||||
|own| |mouth| |so| |that| |the| |whole| |thing| |wraps| |around.|)
|
||||
|
||||
(* * L |is| |the| |tail| |list.| I\t |starts| |out| |full| |of| NIL\s |and|
|
||||
|gets| |filled| |as| |the| QIX |moves.| I\t |is| |also| |inserted| |in| |it's|
|
||||
|own| |mouth| |so| |that| |the| |whole| |thing| |wraps| |around.|)
|
||||
|
||||
(SETQ L
|
||||
(APPEND (|for| X |from| 1 |to| (RAND 5 25)
|
||||
@@ -148,12 +152,12 @@
|
||||
(LIST P P2 L))))
|
||||
(SETQ *OLD-QIXS* QIXS)
|
||||
LOOP
|
||||
(DISMISS)
|
||||
(BLOCK 25)
|
||||
(|for| Q |in| QIXS |do| (SETQ P (CAR Q))
|
||||
(SETQ P2 (CADR Q))
|
||||
(SETQ L (CADDR Q))
|
||||
|
||||
(* * |Draw| |the| |QIX's| |head| |line.|)
|
||||
|
||||
(* * |Draw| |the| |QIX's| |head| |line.|)
|
||||
|
||||
(MOVETO (|fetch| X P)
|
||||
(|fetch| Y P)
|
||||
@@ -162,13 +166,13 @@
|
||||
(|fetch| Y P2)
|
||||
1
|
||||
'REPLACE W)
|
||||
|
||||
(* * |Move| |the| |points| |according| |to| |their| X |and| Y |velocities.|)
|
||||
|
||||
(* * |Move| |the| |points| |according| |to| |their| X |and| Y |velocities.|)
|
||||
|
||||
(QIX.MOVE.POINT P W)
|
||||
(QIX.MOVE.POINT P2 W)
|
||||
|
||||
(* * |Delete| |the| |first| |object| |on| |the| |tail| |list.|)
|
||||
|
||||
(* * |Delete| |the| |first| |object| |on| |the| |tail| |list.|)
|
||||
|
||||
(COND
|
||||
((EQ (CAAR L)
|
||||
@@ -181,10 +185,10 @@
|
||||
(CADDDR OLD)
|
||||
1
|
||||
'ERASE W))))
|
||||
|
||||
(* * |Replace| |the| |current| |point| |with| |the| |new| |head,| |which|
|
||||
|effectively| |adds| |it| |to| |the| |end| |of| |the| |list,| |since| |we| THEN
|
||||
|immediately| |move| |to| |the| |next| |elt| |in| |this| |circular| |list.|)
|
||||
|
||||
(* * |Replace| |the| |current| |point| |with| |the| |new| |head,| |which|
|
||||
|effectively| |adds| |it| |to| |the| |end| |of| |the| |list,| |since| |we| THEN
|
||||
|immediately| |move| |to| |the| |next| |elt| |in| |this| |circular| |list.|)
|
||||
|
||||
(RPLACA (CAR L)
|
||||
(|fetch| X P))
|
||||
@@ -247,9 +251,11 @@
|
||||
|
||||
(RECORD QIX.POINT (X Y VH VV))
|
||||
)
|
||||
(SETQ IDLE.FUNCTIONS (CONS '("5 Qix's" 'QIX.IDLE) IDLE.FUNCTIONS))
|
||||
|
||||
(SETQ IDLE.FUNCTIONS (CONS '("5 Qix's" 'QIX.IDLE)
|
||||
IDLE.FUNCTIONS))
|
||||
(PUTPROPS QIX COPYRIGHT ("Xerox Corporation" 1987))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (539 10893 (QIX.GROW 549 . 4105) (QIX.IDLE 4107 . 8821) (QIX.MOVE.POINT 8823 . 10205) (
|
||||
QIX.PLAY 10207 . 10891)))))
|
||||
(FILEMAP (NIL (592 11044 (QIX.GROW 602 . 4158) (QIX.IDLE 4160 . 8972) (QIX.MOVE.POINT 8974 . 10356) (
|
||||
QIX.PLAY 10358 . 11042)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user