Compare commits
127 Commits
medley-240
...
medley-250
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
3aa58b6374 | ||
|
|
0400c1ec7f | ||
|
|
736ac51a8c | ||
|
|
ae52a44231 | ||
|
|
fbf0a98aec | ||
|
|
87d3abc632 | ||
|
|
1f317d34ef | ||
|
|
86f5aadf95 | ||
|
|
fc36176134 | ||
|
|
1e47741a71 | ||
|
|
40d18fff6e | ||
|
|
8323b1fae4 | ||
|
|
16e99100f5 | ||
|
|
db9d879920 | ||
|
|
907010013e | ||
|
|
0bc84f97f0 | ||
|
|
db98ea346b | ||
|
|
402a861b95 | ||
|
|
6c3f0d8e56 | ||
|
|
6c86838d18 | ||
|
|
d9090011d4 | ||
|
|
40d2ac394c | ||
|
|
4873590e22 | ||
|
|
188895c7e9 | ||
|
|
292a7cd787 | ||
|
|
a1a67959d1 | ||
|
|
015868e9a6 | ||
|
|
9f980276bf | ||
|
|
ef6a645bf5 | ||
|
|
90c723a8c1 | ||
|
|
20ec5c2bc9 | ||
|
|
ba3a5668bd | ||
|
|
d737f7ec93 | ||
|
|
9e6eba2cd9 | ||
|
|
27473e8cae | ||
|
|
27d8bffaa9 | ||
|
|
58122db362 | ||
|
|
5eb8a7bd34 | ||
|
|
4e11554156 | ||
|
|
0cc21cd46a | ||
|
|
936337d6bb | ||
|
|
6bdcb1853d | ||
|
|
fb7bb25201 | ||
|
|
5b37dd09db | ||
|
|
33a53e47e1 | ||
|
|
db33a50af3 | ||
|
|
f896885720 | ||
|
|
b46583557a | ||
|
|
1d15f37fdc | ||
|
|
e1c594b28c | ||
|
|
abdb128636 | ||
|
|
a26d061843 | ||
|
|
b51be87524 | ||
|
|
4b7a6daacd | ||
|
|
c4c0b65616 | ||
|
|
0dfac33a25 | ||
|
|
e5d4e0d299 | ||
|
|
a365e42a92 | ||
|
|
024e83d17e | ||
|
|
7a32bd3051 | ||
|
|
5fef8528ab | ||
|
|
0b3bc9ac48 | ||
|
|
93ee6a1fbf | ||
|
|
fe04869cb3 | ||
|
|
178807afff | ||
|
|
e1989850f3 | ||
|
|
fface7d9de | ||
|
|
b41ae0cbbe | ||
|
|
548d3f1567 | ||
|
|
a85d6287ae | ||
|
|
719b4e744e | ||
|
|
387fecf475 | ||
|
|
433ffaf9e5 | ||
|
|
2cec465f1f | ||
|
|
ca03e7f930 | ||
|
|
3526a61be1 | ||
|
|
115ba43100 | ||
|
|
d2b87a7327 | ||
|
|
f03a2fb4cb | ||
|
|
244300de7b | ||
|
|
7ed120ca97 | ||
|
|
e9200c73c9 | ||
|
|
1ffcde195a | ||
|
|
19015712de | ||
|
|
7b0c746af2 | ||
|
|
325bc9b5da | ||
|
|
94548bd7da | ||
|
|
d1fcd6cf7e | ||
|
|
9e7445927c | ||
|
|
31863256c8 | ||
|
|
a8c82aa9c4 | ||
|
|
84cd0c73cb | ||
|
|
54bea56b81 | ||
|
|
65cfd1dd69 | ||
|
|
7dcc200c91 | ||
|
|
9e0fdd0283 | ||
|
|
ffe99d6bcc | ||
|
|
3e77f627a0 | ||
|
|
8d648f46b1 | ||
|
|
e7dccf76a9 | ||
|
|
ff25001814 | ||
|
|
9793e48c4e | ||
|
|
2f6499317b | ||
|
|
6398c2b8d4 | ||
|
|
fcd40bc409 | ||
|
|
c8133ebb96 | ||
|
|
9962a9ca0a | ||
|
|
014c34959f | ||
|
|
4c18373229 | ||
|
|
1148cd5945 | ||
|
|
f44b96e870 | ||
|
|
e9bea32fa3 | ||
|
|
10cd51e5b1 | ||
|
|
ee57eabe21 | ||
|
|
eda9863432 | ||
|
|
a9a8c35827 | ||
|
|
40306a3fe8 | ||
|
|
eb7d34784b | ||
|
|
ba8aac6321 | ||
|
|
c578bfd983 | ||
|
|
dab6f2635f | ||
|
|
40ae5fb9b3 | ||
|
|
1c2f9bc395 | ||
|
|
a9941b36aa | ||
|
|
3129597058 | ||
|
|
0d8e5ae9f6 | ||
|
|
354c7f035a |
11
.github/ISSUE_TEMPLATE/bug_report.md
vendored
11
.github/ISSUE_TEMPLATE/bug_report.md
vendored
@@ -3,6 +3,7 @@ name: Bug report (not specific)
|
||||
about: Create a report to help us improve
|
||||
title: ''
|
||||
labels: ''
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
@@ -22,11 +23,13 @@ A clear and concise description of what you expected to happen.
|
||||
If applicable, add screenshots to help explain your problem.
|
||||
|
||||
**Context (please complete the following information):**
|
||||
- OS: [e.g. Mac/Linux/Cygwin]
|
||||
- OS Version: [e.g. High Siera/Ubuntu 18/Raspbian]
|
||||
- Host arch: [e.g. x86_64, arm7l, arm64, sparc]
|
||||
- Are you using online.interlisp.org? [yes / no]
|
||||
- OS: [e.g. macOS/Linux/Cygwin]
|
||||
- OS Version: [e.g. Ventura, Ubuntu 24, Raspberry Pi OS]
|
||||
- Display/window system: [e.g. X11, SDL, VNC, Web browser]
|
||||
- Host arch: [e.g. x86_64, arm7l, arm64, SPARC]
|
||||
- Maiko version: [e.g. commit ID from `git log | head`]
|
||||
- IL:MAKESYSDATE: [ date ]
|
||||
- `IL:MAKESYSDATE`: [ date ] or `(il:print-lisp-information)`: copy-paste or screenshot this
|
||||
|
||||
**Additional context**
|
||||
Add any other context about the problem here.
|
||||
|
||||
1
.github/ISSUE_TEMPLATE/documentation.md
vendored
1
.github/ISSUE_TEMPLATE/documentation.md
vendored
@@ -3,6 +3,7 @@ name: Documentation problem
|
||||
about: Problems with this web site?
|
||||
title: ''
|
||||
labels: ''
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
|
||||
1
.github/ISSUE_TEMPLATE/feature_request.md
vendored
1
.github/ISSUE_TEMPLATE/feature_request.md
vendored
@@ -3,6 +3,7 @@ name: Feature request
|
||||
about: Suggest an idea for this project
|
||||
title: ''
|
||||
labels: ''
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
|
||||
12
.github/workflows/buildDocker.yml
vendored
12
.github/workflows/buildDocker.yml
vendored
@@ -70,7 +70,7 @@ jobs:
|
||||
# based on the latest commit to the repo
|
||||
|
||||
sentry:
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
outputs:
|
||||
release_not_built: ${{ steps.check.outputs.release_not_built }}
|
||||
|
||||
@@ -99,7 +99,7 @@ jobs:
|
||||
|
||||
build_and-push:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
needs: [sentry]
|
||||
if: |
|
||||
@@ -154,7 +154,8 @@ jobs:
|
||||
if [ "${{ inputs.draft }}" = "false" ];
|
||||
then
|
||||
docker_tags="${docker_image}:latest,${docker_image}:${MEDLEY_RELEASE#*-}_${MAIKO_RELEASE#*-}"
|
||||
platforms="linux/amd64,linux/arm64"
|
||||
platforms="linux/amd64"
|
||||
#,linux/arm64
|
||||
else
|
||||
docker_tags="${docker_image}:draft"
|
||||
platforms="linux/amd64"
|
||||
@@ -171,7 +172,8 @@ jobs:
|
||||
- name: Set up QEMU
|
||||
uses: docker/setup-qemu-action@v3
|
||||
with:
|
||||
platforms: linux/amd64,linux/arm64,linux/arm/v7
|
||||
platforms: linux/amd64
|
||||
# ,linux/arm64,linux/arm/v7
|
||||
|
||||
# Setup the Docker Buildx funtion
|
||||
- name: Set up Docker Buildx
|
||||
@@ -211,7 +213,7 @@ jobs:
|
||||
|
||||
complete:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
outputs:
|
||||
build_successful: ${{ steps.output.outputs.build_successful }}
|
||||
|
||||
12
.github/workflows/buildLoadup.yml
vendored
12
.github/workflows/buildLoadup.yml
vendored
@@ -66,7 +66,7 @@ jobs:
|
||||
# based on the latest commit to the repo
|
||||
|
||||
sentry:
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
outputs:
|
||||
release_not_built: ${{ steps.check.outputs.release_not_built }}
|
||||
|
||||
@@ -96,7 +96,7 @@ jobs:
|
||||
|
||||
loadup:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
outputs:
|
||||
combined_release_tag: ${{ steps.job_outputs.outputs.COMBINED_RELEASE_TAG }}
|
||||
@@ -257,7 +257,7 @@ jobs:
|
||||
#
|
||||
linux_installer:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
needs: [sentry, loadup]
|
||||
if: |
|
||||
@@ -333,7 +333,7 @@ jobs:
|
||||
#
|
||||
macos_installer:
|
||||
|
||||
runs-on: macos-12
|
||||
runs-on: macos-14
|
||||
|
||||
needs: [sentry, loadup]
|
||||
if: |
|
||||
@@ -507,7 +507,7 @@ jobs:
|
||||
|
||||
downloads_page:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
needs: [sentry, loadup, linux_installer, macos_installer, cygwin_installer]
|
||||
if: |
|
||||
@@ -606,7 +606,7 @@ jobs:
|
||||
|
||||
complete:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
outputs:
|
||||
build_successful: ${{ steps.output.outputs.build_successful }}
|
||||
|
||||
30
.github/workflows/buildReleaseInclDocker.yml
vendored
30
.github/workflows/buildReleaseInclDocker.yml
vendored
@@ -3,6 +3,7 @@
|
||||
#
|
||||
# Interlisp webflow to build a Medley release and push it to github.
|
||||
# And to build a multiplatform Docker image for the release and push it to Docker Hub.
|
||||
# And to kickoff a build and deploy workflow for Medley-online within the online repo.
|
||||
#
|
||||
# This workflow just calls two reuseable workflows to the two task:
|
||||
# buildLoadup.yml and buildDocker.yml
|
||||
@@ -14,12 +15,12 @@
|
||||
# ******************************************************************************
|
||||
|
||||
|
||||
name: "Build/Push Release & Docker"
|
||||
name: "Build/Push Release, Docker, OIO"
|
||||
|
||||
# Run this workflow on ...
|
||||
on:
|
||||
schedule:
|
||||
- cron: '0 9 * * 3'
|
||||
- cron: '17 9 * * 3'
|
||||
|
||||
workflow_dispatch:
|
||||
inputs:
|
||||
@@ -68,7 +69,7 @@ jobs:
|
||||
# the result of a workflow_dispatch or a workflow_call
|
||||
|
||||
inputs:
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
outputs:
|
||||
draft: ${{ steps.one.outputs.draft }}
|
||||
force: ${{ steps.one.outputs.force }}
|
||||
@@ -111,3 +112,26 @@ jobs:
|
||||
|
||||
######################################################################################
|
||||
|
||||
# Run HCFILES and push to files.interlisp.org
|
||||
do_HCFILES:
|
||||
needs: [inputs, do_release]
|
||||
uses: ./.github/workflows/doHCFILES.yml
|
||||
with:
|
||||
draft: ${{ needs.inputs.outputs.draft }}
|
||||
secrets: inherit
|
||||
|
||||
######################################################################################
|
||||
|
||||
# Kickoff workflow in online repo to build and deploy Medley docker image to oio
|
||||
do_oio:
|
||||
runs-on: ubuntu-24.04
|
||||
needs: [inputs, do_docker]
|
||||
steps:
|
||||
- name: trigger-oio-buildAndDeploy
|
||||
run: |
|
||||
if [ ! "${{ needs.inputs.outputs.draft }}" = "true" ]
|
||||
then
|
||||
gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref master
|
||||
fi
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.ONLINE_TOKEN }}
|
||||
|
||||
139
.github/workflows/doHCFILES.yml
vendored
Normal file
139
.github/workflows/doHCFILES.yml
vendored
Normal file
@@ -0,0 +1,139 @@
|
||||
#*******************************************************************************
|
||||
# doHCFILES.yml
|
||||
#
|
||||
# Interlisp workflow to run HCFILES. HCFILES prints out PDF files for all of the
|
||||
# files in the Medley directory and posts them on files.interlisp.org.
|
||||
#
|
||||
# This workflow is designed to be kickjed off by the buildReleaseInclDocker
|
||||
# workflow running in the Medley repo, once the release has been completed successfully
|
||||
#
|
||||
# Copyright 2024 by Interlisp.org
|
||||
#
|
||||
# ******************************************************************************
|
||||
|
||||
name: Run HCFILES
|
||||
|
||||
# Run this workflow on ...
|
||||
on:
|
||||
workflow_dispatch:
|
||||
inputs:
|
||||
draft:
|
||||
description: "Mark this as a draft release"
|
||||
type: choice
|
||||
options:
|
||||
- 'false'
|
||||
- 'true'
|
||||
|
||||
workflow_call:
|
||||
inputs:
|
||||
draft:
|
||||
description: "Mark this as a draft release"
|
||||
required: false
|
||||
type: string
|
||||
default: 'false'
|
||||
secrets:
|
||||
OIO_SSH_KEY:
|
||||
required: true
|
||||
MU_TOKEN:
|
||||
required: true
|
||||
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
|
||||
jobs:
|
||||
|
||||
run_HCFILES:
|
||||
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
steps:
|
||||
|
||||
- name: Checkout Medley repo
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Checkout notecards
|
||||
uses: actions/checkout@v4
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/notecards
|
||||
path: ./notecards
|
||||
|
||||
- name: Checkout loops
|
||||
uses: actions/checkout@v4
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/loops
|
||||
path: ./loops
|
||||
|
||||
- name: Checkout test
|
||||
uses: actions/checkout@v4
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/test
|
||||
path: ./test
|
||||
|
||||
- name: Cleanup .git for notecards, loops, test
|
||||
run: rm -rf ./notecards/.git ./loops/.git ./test/.git
|
||||
|
||||
- name: Download Maiko
|
||||
run: |
|
||||
gh release download --output /tmp/maiko.tgz \
|
||||
--repo ${{ github.repository_owner }}/maiko \
|
||||
--pattern '*-linux.x86_64.tgz'
|
||||
tar -xzf /tmp/maiko.tgz
|
||||
env:
|
||||
GH_TOKEN: ${{ secrets.MU_TOKEN }}
|
||||
|
||||
- name: Install vnc & ghostscript (ps2pdf)
|
||||
run: |
|
||||
sudo apt-get update
|
||||
sudo apt-get install -y tightvncserver
|
||||
sudo apt-get install -y ghostscript
|
||||
|
||||
- name: Build apps.sysout
|
||||
run: |
|
||||
Xvnc -geometry 1280x720 :0 &
|
||||
export DISPLAY=":0"
|
||||
scripts/loadup-all.sh -apps
|
||||
|
||||
- name: Run HCFILES
|
||||
run: |
|
||||
export DISPLAY=":0"
|
||||
scripts/do_hcfiles.sh
|
||||
|
||||
- name: Push Medley files (including created pdf files) to files.interlisp.org
|
||||
run: |
|
||||
# create a tar file of all of the directories to be pushed
|
||||
tarfile=/tmp/source-$$.tgz
|
||||
tar -c -z -f ${tarfile} --exclude=.git .
|
||||
# set up ssh identity
|
||||
eval $(ssh-agent)
|
||||
ssh-add - <<< "${SSH_KEY}"
|
||||
# set destination directory on files.interlisp.org
|
||||
if [ "${{ inputs.draft }}" = "true" ]
|
||||
then
|
||||
dest=/srv/oio/files/development/medley
|
||||
else
|
||||
dest=/srv/oio/files/production/medley
|
||||
fi
|
||||
# Push tar file up to files.interlisp.org
|
||||
batchfile=/tmp/batch-$$
|
||||
echo "-put ${tarfile} ${dest}.tgz" > ${batchfile}
|
||||
sftp -o StrictHostKeyChecking=no -b ${batchfile} ubuntu@files.interlisp.org
|
||||
# now tar is up, untar it and juggle backups
|
||||
scriptfile=/tmp/script-$$
|
||||
# create script file to do the work
|
||||
cat > ${scriptfile} <<EOF
|
||||
rm -rf ${dest}.new
|
||||
mkdir -p ${dest}.new
|
||||
tar -C ${dest}.new -x -z -f ${dest}.tgz
|
||||
rm -f ${dest}.tgz
|
||||
rm -rf ${dest}.oldold
|
||||
if [ -e ${dest}.old ]; then mv ${dest}.old ${dest}.oldold; fi
|
||||
if [ -e ${dest} ]; then mv ${dest} ${dest}.old; fi
|
||||
mv ${dest}.new ${dest}
|
||||
EOF
|
||||
# execute the script file via ssh
|
||||
ssh -aTxo BatchMode=yes ubuntu@files.interlisp.org /bin/sh -s < ${scriptfile}
|
||||
env:
|
||||
SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
|
||||
|
||||
|
||||
16
.gitignore
vendored
16
.gitignore
vendored
@@ -5,12 +5,19 @@ tmp/*
|
||||
# releases directory
|
||||
releases/*
|
||||
|
||||
# maiko directory
|
||||
maiko/
|
||||
|
||||
|
||||
# all PDFs (those explicitly checked in aren't ignored
|
||||
# normally when you have derived files, you ignore them from git
|
||||
# because they will get regenerated when you rebuild.
|
||||
# MEDLEY-UTILS HCFILES regenerates
|
||||
|
||||
*.pdf
|
||||
# do not ignore .pdf files after all... rather, [new workflow](scripts/make-gh-pages.md) stores it in the src repository gh-pages branch.
|
||||
|
||||
# *.pdf
|
||||
# index.html
|
||||
|
||||
|
||||
# all loadup files
|
||||
@@ -19,7 +26,8 @@ loadups/exports.all
|
||||
library/RDSYS*
|
||||
loadups/lisp.sysout
|
||||
loadups/full.sysout
|
||||
loadups/fuller.sysout # not currently included but might as well ignore it
|
||||
# not currently included but might as well ignore it
|
||||
loadups/fuller.sysout
|
||||
loadups/*.dribble
|
||||
loadups/whereis.hash
|
||||
loadups/apps.sysout
|
||||
@@ -29,6 +37,10 @@ loadups/fuller.database
|
||||
|
||||
*.IMPTR
|
||||
|
||||
# (Accidentally) created sysouts at any level
|
||||
*.sysout
|
||||
*.SYSOUT
|
||||
|
||||
#compiled code -- leave in for now
|
||||
|
||||
# *.lcom
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,6 +1,6 @@
|
||||
MIT License
|
||||
|
||||
Copyright Interlisp.org contributors
|
||||
Copyright © 2024 Interlisp.org. Portions originally copyrighted by Xerox, Venue, John Sybalsky, and other contributors.
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
|
||||
313
doctools/IMTEDIT
313
doctools/IMTEDIT
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 6-Mar-2024 21:18:02" {WMEDLEY}<doctools>IMTEDIT.;4 116622
|
||||
(FILECREATED "12-Apr-2024 19:58:59" {WMEDLEY}<doctools>IMTEDIT.;5 117369
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TRANSLATE.DUMPOUT MAKE.IM.DOCUMENT)
|
||||
:CHANGES-TO (FNS MAKE.IM.DOCUMENT)
|
||||
|
||||
:PREVIOUS-DATE "20-Jul-2022 15:10:53" {WMEDLEY}<doctools>IMTEDIT.;2)
|
||||
:PREVIOUS-DATE " 6-Mar-2024 21:18:02" {WMEDLEY}<doctools>IMTEDIT.;4)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IMTEDITCOMS)
|
||||
@@ -15,16 +15,17 @@
|
||||
((FNS IM.TEDIT DUMP DUMP.HEADERS.FOOTERS DUMP.HRULE CHANGE.FONT IM.BOUT.IMAGEOBJ
|
||||
IM.TEDIT.DUMP.COMMANDS IM.TEDIT.DUMP.FOOTNOTES IM.TEDIT.DUMP.PARA INDEXX.PARSE.TYPE
|
||||
FORMAT.DEF FORMAT.LISPWORD MAKE.IM.DOCUMENT PRINT.NOTE SEND.INFO)
|
||||
(COMS (* fns for drawing vrules to the left of definition text -- an unused, never-fully
|
||||
debuged feature)
|
||||
(COMS (* ;
|
||||
"fns for drawing vrules to the left of definition text -- an unused, never-fully debuged feature")
|
||||
(FNS IM.VRULE.DISPLAYFN CREATE.VRULE.OBJECT PRINT.VRULES.ON.PAGE)
|
||||
(VARS (IM.VRULE.STATE.LIST))
|
||||
(INITVARS (IM.VRULE.OBJECT.IMAGEFNS NIL)
|
||||
(IM.PRINT.VRULE.FLG NIL)))
|
||||
(COMS (* fns for printing page numbers)
|
||||
(COMS (* ; "fns for printing page numbers")
|
||||
(FNS IM.FOLIO.DISPLAYFN IM.FOLIO.SIZEFN CREATE.FOLIO.OBJECT GET.FOLIO.STRING)
|
||||
(INITVARS (IM.FOLIO.OBJECT.IMAGEFNS NIL)))
|
||||
(COMS (* TOPROG functions, used to define the translating actions of IM text objects.)
|
||||
(COMS (* ;
|
||||
"TOPROG functions, used to define the translating actions of IM text objects.")
|
||||
(FNS ARG#TOPROG BIGLISPCODE#TOPROG BRACKET#TOPROG CHAPTER#TOPROG COMMENT#TOPROG
|
||||
DEF#TOPROG FIGURE#TOPROG FN#TOPROG FNDEF#TOPROG FOOT#TOPROG INCLUDE#TOPROG
|
||||
INDEX#TOPROG INDEXX#TOPROG IT#TOPROG LBRACKET#TOPROG LISP#TOPROG LISPCODE#TOPROG
|
||||
@@ -54,104 +55,112 @@
|
||||
(IM.TEXT.FONT '(FAMILY MODERN FACE MRR SIZE 10))
|
||||
(IM.HEADER.FOOTER.FONT '(FAMILY MODERN FACE MRR SIZE 8))
|
||||
(IM.XEROX.LOGO.FONT '(FAMILY MODERN FACE BRR SIZE 30]
|
||||
(COMS (* the following variables specify all of the lengths used for possitioning IM text,
|
||||
headers, etc. on the page. All of these are measured with respect to the page
|
||||
*margins* <the region on the page defined by the Tedit margin parameters> or with
|
||||
respect to the page *edges* <the edges of the physical page>.)
|
||||
(* Note%: The formatting and printing does not always position the image on the page
|
||||
exactly as specified. It will probably be necessary to adjust any variables based on
|
||||
the page edges until they come out correctly on your printer.)
|
||||
(* indentation of 1st line of definitian header, measured in points from left page
|
||||
margin. Also used for indentation of hrule under defn header.)
|
||||
(COMS
|
||||
(* ;; "the following variables specify all of the lengths used for possitioning IM text, headers, etc. on the page. All of these are measured with respect to the page *margins* <the region on the page defined by the Tedit margin parameters> or with respect to the page *edges* <the edges of the physical page>.")
|
||||
|
||||
|
||||
(* ;; "Note: The formatting and printing does not always position the image on the page exactly as specified. It will probably be necessary to adjust any variables based on the page edges until they come out correctly on your printer.")
|
||||
|
||||
|
||||
(* ;; "indentation of 1st line of definitian header, measured in points from left page margin. Also used for indentation of hrule under defn header.")
|
||||
|
||||
(INITVARS (IM.DEF.TITLE.1STLEFTMARGIN 75))
|
||||
(* indentation of 2nd and other overflow lines of definition header, measured in points
|
||||
from left page margin.)
|
||||
|
||||
(* ;; "indentation of 2nd and other overflow lines of definition header, measured in points from left page margin.")
|
||||
|
||||
(INITVARS (IM.DEF.TITLE.LEFTMARGIN 204))
|
||||
(* indentation of vertical rule to the left of definition text, measured in points from
|
||||
left page margin. This is a never-used, never-debugged feature.)
|
||||
|
||||
(* ;; "indentation of vertical rule to the left of definition text, measured in points from left page margin. This is a never-used, never-debugged feature.")
|
||||
|
||||
(INITVARS (IM.VRULE.X 194))
|
||||
(* y-pos of top-left corner of top text line, measured in points from bottom page edge.
|
||||
)
|
||||
(* ;
|
||||
"y-pos of top-left corner of top text line, measured in points from bottom page edge.")
|
||||
(INITVARS (IM.TEXT.TOPMARGIN 738))
|
||||
(* y-pos of bottom-left corner of bottom text line, measured in points from bottom page
|
||||
edge.)
|
||||
(* ;
|
||||
"y-pos of bottom-left corner of bottom text line, measured in points from bottom page edge.")
|
||||
(INITVARS (IM.TEXT.BOTTOMMARGIN 54))
|
||||
(* x-pos of left edge of text, measured in points from the left page margin.)
|
||||
(* ;
|
||||
"x-pos of left edge of text, measured in points from the left page margin.")
|
||||
(INITVARS (IM.TEXT.LEFTMARGIN 204))
|
||||
(* x-pos of right edge of text, measured in points from the left page margin.)
|
||||
(* ;
|
||||
"x-pos of right edge of text, measured in points from the left page margin.")
|
||||
(INITVARS (IM.TEXT.RIGHTMARGIN 504))
|
||||
(* X-pos and Y-pos of the lower-left corner of the
|
||||
"[This page intentionally left blank]" message printed on blank pages, measured in
|
||||
points from the left and bottom page edges.)
|
||||
|
||||
(* ;; "X-pos and Y-pos of the lower-left corner of the '[This page intentionally left blank]' message printed on blank pages, measured in points from the left and bottom page edges.")
|
||||
|
||||
(INITVARS (IM.BLANKPAGE.SPECIALX 258)
|
||||
(IM.BLANKPAGE.SPECIALY 400))
|
||||
(* In the table of contents, indentation of first and second-level subsection headers,
|
||||
measured in points from the left page margin.)
|
||||
|
||||
(* ;; "In the table of contents, indentation of first and second-level subsection headers, measured in points from the left page margin.")
|
||||
|
||||
(INITVARS (IM.TOC.SUBSEC.ONE.LEFTMARGIN 120)
|
||||
(IM.TOC.SUBSEC.TWO.LEFTMARGIN 216))
|
||||
(* in the index, the indentation of the first line and remaining lines of a top-level
|
||||
entry, of a subentry, and of a subsubentry, measured in points from the left page
|
||||
margin <for the left column>.)
|
||||
|
||||
(* ;; "in the index, the indentation of the first line and remaining lines of a top-level entry, of a subentry, and of a subsubentry, measured in points from the left page margin <for the left column>.")
|
||||
|
||||
(INITVARS (IM.INDEX.1STLEFTMARGIN 0)
|
||||
(IM.INDEX.LEFTMARGIN 75)
|
||||
(IM.INDEX.SUB.1STLEFTMARGIN 25)
|
||||
(IM.INDEX.SUB.LEFTMARGIN 75)
|
||||
(IM.INDEX.SUBSUB.1STLEFTMARGIN 50)
|
||||
(IM.INDEX.SUBSUB.LEFTMARGIN 75))
|
||||
(* on the title page, the y-pos of the lower-left corner of the first line in the title
|
||||
<and of the XEROX logo>, measured in points from the bottom page margin. The X-pos
|
||||
is always 0 for the XEROX logo, and the normal text indentation for the title.)
|
||||
|
||||
(* ;; "on the title page, the y-pos of the lower-left corner of the first line in the title <and of the XEROX logo>, measured in points from the bottom page margin. The X-pos is always 0 for the XEROX logo, and the normal text indentation for the title.")
|
||||
|
||||
(INITVARS (IM.TITLEPAGE.TITLE.Y 258))
|
||||
(* on the title page, the y-pos of the lower-left corner of the first line in the
|
||||
document number, measured in points from the bottom page margin. The Y-pos is always
|
||||
the normal text indentation.)
|
||||
|
||||
(* ;; "on the title page, the y-pos of the lower-left corner of the first line in the document number, measured in points from the bottom page margin. The Y-pos is always the normal text indentation.")
|
||||
|
||||
(INITVARS (IM.TITLEPAGE.DOCNUMBER.Y 45))
|
||||
(* Tedit tab setting used for subsection heading text. "(40 . LEFT)" determines the
|
||||
indentation of the title after the subsec number, measured in points from the left
|
||||
page margin. "18" is the tab used if the subsec number is wider than 40 pts.)
|
||||
|
||||
(* ;; "Tedit tab setting used for subsection heading text. '(40 . LEFT)' determines the indentation of the title after the subsec number, measured in points from the left page margin. '18' is the tab used if the subsec number is wider than 40 pts.")
|
||||
|
||||
[INITVARS (IM.SUBSEC.TITLE.TABS '(18 (40 . LEFT]
|
||||
(* Tedit tab setting used for chapter titles, headers, and footers to right-justify
|
||||
text. "(504 . RIGHT)" specifies a right tab at the right-hand edge of the text,
|
||||
measured in points from the left page margin.)
|
||||
|
||||
(* ;; "Tedit tab setting used for chapter titles, headers, and footers to right-justify text. '(504 . RIGHT)' specifies a right tab at the right-hand edge of the text, measured in points from the left page margin.")
|
||||
|
||||
[INITVARS (IM.RIGHT.MARGIN.TABS '(0 (504 . RIGHT]
|
||||
(* Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists.
|
||||
"(186 . RIGHT)" right-justifies the label on the left of the center space.
|
||||
"(204 . LEFT)" starts the first line of the list item with the same indentation as
|
||||
normal text. Both measurements are measured in points from the left page margin.)
|
||||
|
||||
(* ;; "Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists. '(186 . RIGHT)' right-justifies the label on the left of the center space. '(204 . LEFT)' starts the first line of the list item with the same indentation as normal text. Both measurements are measured in points from the left page margin.")
|
||||
|
||||
[INITVARS (IM.LABELED.LIST.TABS '(18 (186 . RIGHT)
|
||||
(204 . LEFT]
|
||||
(* left, right, top, and bottom margins of the "page region" %, measured in points from
|
||||
the four edges of the page.)
|
||||
|
||||
(* ;; "left, right, top, and bottom margins of the 'page region' , measured in points from the four edges of the page.")
|
||||
|
||||
(INITVARS (IM.PAGE.LEFTMARGIN 58)
|
||||
(IM.PAGE.RIGHTMARGIN 54)
|
||||
(IM.PAGE.TOPMARGIN 54)
|
||||
(IM.PAGE.BOTTOMMARGIN 54))
|
||||
(* top margin of the page region for the first page of a chapter <where the first
|
||||
paragraph is the chapter title>, measured in points from the top page edge.)
|
||||
|
||||
(* ;; "top margin of the page region for the first page of a chapter <where the first paragraph is the chapter title>, measured in points from the top page edge.")
|
||||
|
||||
(INITVARS (IM.PAGE.FIRST.TOPMARGIN 12))
|
||||
(* top margin of the page region for the first page of the index, measured in points
|
||||
from the top page edge. Note that in the case of the index, because it uses two
|
||||
columns, the index title is implemented as a Tedit header, instead of as the first
|
||||
paragraph of the document.)
|
||||
|
||||
(* ;; "top margin of the page region for the first page of the index, measured in points from the top page edge. Note that in the case of the index, because it uses two columns, the index title is implemented as a Tedit header, instead of as the first paragraph of the document.")
|
||||
|
||||
(INITVARS (IM.INDEX.PAGE.FIRST.TOPMARGIN 144))
|
||||
(* y-pos of lower-left corner of footer text, measured in points from the bottom page
|
||||
edge.)
|
||||
(* ;
|
||||
"y-pos of lower-left corner of footer text, measured in points from the bottom page edge.")
|
||||
(INITVARS (IM.FOOTER.Y 22))
|
||||
(* y-pos of the footer hrule, measured in points from the bottom page edge.)
|
||||
(* ;
|
||||
"y-pos of the footer hrule, measured in points from the bottom page edge.")
|
||||
(INITVARS (IM.FOOTER.RULE.Y 30))
|
||||
(* y-pos of lower-left corner of header text, measured in points from the bottom page
|
||||
edge.)
|
||||
(* ;
|
||||
"y-pos of lower-left corner of header text, measured in points from the bottom page edge.")
|
||||
(INITVARS (IM.HEADER.Y 761))
|
||||
(* y-pos of the header hrule, measured in points from the bottom page edge.)
|
||||
(* ;
|
||||
"y-pos of the header hrule, measured in points from the bottom page edge.")
|
||||
(INITVARS (IM.HEADER.RULE.Y 757))
|
||||
(* y-pos of lower-left corner of bottom draft message, measured in points from the
|
||||
bottom page edge.)
|
||||
(* ;
|
||||
"y-pos of lower-left corner of bottom draft message, measured in points from the bottom page edge.")
|
||||
(INITVARS (IM.DRAFT.MESSAGE.BOTTOM.Y 5))
|
||||
(* y-pos of lower-left corner of top draft message, measured in points from the bottom
|
||||
page edge.)
|
||||
(* ;
|
||||
"y-pos of lower-left corner of top draft message, measured in points from the bottom page edge.")
|
||||
(INITVARS (IM.DRAFT.MESSAGE.TOP.Y 775))
|
||||
(* x-pos of lower-left corner of both top and bottom draft messages, measured in points
|
||||
from the left page edge.)
|
||||
|
||||
(* ;; "x-pos of lower-left corner of both top and bottom draft messages, measured in points from the left page edge.")
|
||||
|
||||
(INITVARS (IM.DRAFT.MESSAGE.X 200)))
|
||||
(FILES TEDIT IMTRAN HRULE IMINDEX)
|
||||
(FNS TRANSLATE.DUMPOUT TRANSLATE.SAVE.DUMPOUT)
|
||||
@@ -491,6 +500,8 @@
|
||||
(MAKE.IM.DOCUMENT
|
||||
[LAMBDA (FORM OUTFILE.FLG PAGE.LAYOUT OUTPUT.MESSAGE DEFAULT.PARALOOKS PTRFILENAME)
|
||||
|
||||
(* ;; "Edited 12-Apr-2024 19:58 by rmk")
|
||||
|
||||
(* ;; "Edited 6-Mar-2024 21:17 by rmk: Fixed backquote commas. Also put IM.INDEX.CLOSEF calls in TEXTPROPs so advice in IMINDEX can be eliminated.")
|
||||
|
||||
(* ;; "Edited 20-Jul-2022 15:10 by rmk")
|
||||
@@ -506,9 +517,7 @@
|
||||
|
||||
(* ;;; "PTRFILENAME is the name to be used if an index pointer file is generated during hardcopy <by printing index objects>")
|
||||
|
||||
(PROG ([IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL `(IM.INDEX.PTRFILENAME ,PTRFILENAME
|
||||
AFTERHARDCOPYFN (FUNCTION
|
||||
IM.INDEX.INIT]
|
||||
(PROG ([IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL `(IM.INDEX.PTRFILENAME ,PTRFILENAME]
|
||||
(FONT.STACK (CONS))
|
||||
(IM.TEDIT.LAST.PARA.BEGIN 1)
|
||||
(IM.TEDIT.LAST.FONT.BEGIN 1)
|
||||
@@ -650,7 +659,8 @@
|
||||
|
||||
|
||||
|
||||
(* fns for drawing vrules to the left of definition text -- an unused, never-fully debuged feature)
|
||||
(* ; "fns for drawing vrules to the left of definition text -- an unused, never-fully debuged feature"
|
||||
)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -735,7 +745,7 @@
|
||||
|
||||
|
||||
|
||||
(* fns for printing page numbers)
|
||||
(* ; "fns for printing page numbers")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -831,7 +841,7 @@
|
||||
|
||||
|
||||
|
||||
(* TOPROG functions, used to define the translating actions of IM text objects.)
|
||||
(* ; "TOPROG functions, used to define the translating actions of IM text objects.")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -2062,75 +2072,78 @@
|
||||
|
||||
|
||||
|
||||
(* the following variables specify all of the lengths used for possitioning IM text, headers, etc. on
|
||||
the page. All of these are measured with respect to the page *margins* <the region on the page defined
|
||||
by the Tedit margin parameters> or with respect to the page *edges* <the edges of the physical page>.
|
||||
(* ;;
|
||||
"the following variables specify all of the lengths used for possitioning IM text, headers, etc. on the page. All of these are measured with respect to the page *margins* <the region on the page defined by the Tedit margin parameters> or with respect to the page *edges* <the edges of the physical page>."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* Note%: The formatting and printing does not always position the image on the page exactly as
|
||||
specified. It will probably be necessary to adjust any variables based on the page edges until they
|
||||
come out correctly on your printer.)
|
||||
(* ;;
|
||||
"Note: The formatting and printing does not always position the image on the page exactly as specified. It will probably be necessary to adjust any variables based on the page edges until they come out correctly on your printer."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* indentation of 1st line of definitian header, measured in points from left page margin. Also used
|
||||
for indentation of hrule under defn header.)
|
||||
(* ;;
|
||||
"indentation of 1st line of definitian header, measured in points from left page margin. Also used for indentation of hrule under defn header."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.DEF.TITLE.1STLEFTMARGIN 75)
|
||||
|
||||
|
||||
|
||||
(* indentation of 2nd and other overflow lines of definition header, measured in points from left page
|
||||
margin.)
|
||||
(* ;;
|
||||
"indentation of 2nd and other overflow lines of definition header, measured in points from left page margin."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.DEF.TITLE.LEFTMARGIN 204)
|
||||
|
||||
|
||||
|
||||
(* indentation of vertical rule to the left of definition text, measured in points from left page
|
||||
margin. This is a never-used, never-debugged feature.)
|
||||
(* ;;
|
||||
"indentation of vertical rule to the left of definition text, measured in points from left page margin. This is a never-used, never-debugged feature."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.VRULE.X 194)
|
||||
|
||||
|
||||
|
||||
(* y-pos of top-left corner of top text line, measured in points from bottom page edge.)
|
||||
(* ; "y-pos of top-left corner of top text line, measured in points from bottom page edge.")
|
||||
|
||||
|
||||
(RPAQ? IM.TEXT.TOPMARGIN 738)
|
||||
|
||||
|
||||
|
||||
(* y-pos of bottom-left corner of bottom text line, measured in points from bottom page edge.)
|
||||
(* ; "y-pos of bottom-left corner of bottom text line, measured in points from bottom page edge.")
|
||||
|
||||
|
||||
(RPAQ? IM.TEXT.BOTTOMMARGIN 54)
|
||||
|
||||
|
||||
|
||||
(* x-pos of left edge of text, measured in points from the left page margin.)
|
||||
(* ; "x-pos of left edge of text, measured in points from the left page margin.")
|
||||
|
||||
|
||||
(RPAQ? IM.TEXT.LEFTMARGIN 204)
|
||||
|
||||
|
||||
|
||||
(* x-pos of right edge of text, measured in points from the left page margin.)
|
||||
(* ; "x-pos of right edge of text, measured in points from the left page margin.")
|
||||
|
||||
|
||||
(RPAQ? IM.TEXT.RIGHTMARGIN 504)
|
||||
|
||||
|
||||
|
||||
(* X-pos and Y-pos of the lower-left corner of the "[This page intentionally left blank]" message
|
||||
printed on blank pages, measured in points from the left and bottom page edges.)
|
||||
(* ;;
|
||||
"X-pos and Y-pos of the lower-left corner of the '[This page intentionally left blank]' message printed on blank pages, measured in points from the left and bottom page edges."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.BLANKPAGE.SPECIALX 258)
|
||||
@@ -2139,8 +2152,9 @@ printed on blank pages, measured in points from the left and bottom page edges.)
|
||||
|
||||
|
||||
|
||||
(* In the table of contents, indentation of first and second-level subsection headers, measured in
|
||||
points from the left page margin.)
|
||||
(* ;;
|
||||
"In the table of contents, indentation of first and second-level subsection headers, measured in points from the left page margin."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.TOC.SUBSEC.ONE.LEFTMARGIN 120)
|
||||
@@ -2149,8 +2163,9 @@ points from the left page margin.)
|
||||
|
||||
|
||||
|
||||
(* in the index, the indentation of the first line and remaining lines of a top-level entry, of a
|
||||
subentry, and of a subsubentry, measured in points from the left page margin <for the left column>.)
|
||||
(* ;;
|
||||
"in the index, the indentation of the first line and remaining lines of a top-level entry, of a subentry, and of a subsubentry, measured in points from the left page margin <for the left column>."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.INDEX.1STLEFTMARGIN 0)
|
||||
@@ -2167,45 +2182,45 @@ subentry, and of a subsubentry, measured in points from the left page margin <fo
|
||||
|
||||
|
||||
|
||||
(* on the title page, the y-pos of the lower-left corner of the first line in the title <and of the
|
||||
XEROX logo>, measured in points from the bottom page margin. The X-pos is always 0 for the XEROX logo,
|
||||
and the normal text indentation for the title.)
|
||||
(* ;;
|
||||
"on the title page, the y-pos of the lower-left corner of the first line in the title <and of the XEROX logo>, measured in points from the bottom page margin. The X-pos is always 0 for the XEROX logo, and the normal text indentation for the title."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.TITLEPAGE.TITLE.Y 258)
|
||||
|
||||
|
||||
|
||||
(* on the title page, the y-pos of the lower-left corner of the first line in the document number,
|
||||
measured in points from the bottom page margin. The Y-pos is always the normal text indentation.)
|
||||
(* ;;
|
||||
"on the title page, the y-pos of the lower-left corner of the first line in the document number, measured in points from the bottom page margin. The Y-pos is always the normal text indentation."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.TITLEPAGE.DOCNUMBER.Y 45)
|
||||
|
||||
|
||||
|
||||
(* Tedit tab setting used for subsection heading text. "(40 . LEFT)" determines the indentation of the
|
||||
title after the subsec number, measured in points from the left page margin. "18" is the tab used if
|
||||
the subsec number is wider than 40 pts.)
|
||||
(* ;;
|
||||
"Tedit tab setting used for subsection heading text. '(40 . LEFT)' determines the indentation of the title after the subsec number, measured in points from the left page margin. '18' is the tab used if the subsec number is wider than 40 pts."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.SUBSEC.TITLE.TABS '(18 (40 . LEFT)))
|
||||
|
||||
|
||||
|
||||
(* Tedit tab setting used for chapter titles, headers, and footers to right-justify text.
|
||||
"(504 . RIGHT)" specifies a right tab at the right-hand edge of the text, measured in points from the
|
||||
left page margin.)
|
||||
(* ;;
|
||||
"Tedit tab setting used for chapter titles, headers, and footers to right-justify text. '(504 . RIGHT)' specifies a right tab at the right-hand edge of the text, measured in points from the left page margin."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.RIGHT.MARGIN.TABS '(0 (504 . RIGHT)))
|
||||
|
||||
|
||||
|
||||
(* Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists. "(186 . RIGHT)"
|
||||
right-justifies the label on the left of the center space. "(204 . LEFT)" starts the first line of the
|
||||
list item with the same indentation as normal text. Both measurements are measured in points from the
|
||||
left page margin.)
|
||||
(* ;;
|
||||
"Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists. '(186 . RIGHT)' right-justifies the label on the left of the center space. '(204 . LEFT)' starts the first line of the list item with the same indentation as normal text. Both measurements are measured in points from the left page margin."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.LABELED.LIST.TABS '(18 (186 . RIGHT)
|
||||
@@ -2213,8 +2228,9 @@ right-justifies the label on the left of the center space. "(204 . LEFT)" starts
|
||||
|
||||
|
||||
|
||||
(* left, right, top, and bottom margins of the "page region" %, measured in points from the four edges
|
||||
of the page.)
|
||||
(* ;;
|
||||
"left, right, top, and bottom margins of the 'page region' , measured in points from the four edges of the page."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.PAGE.LEFTMARGIN 58)
|
||||
@@ -2227,67 +2243,70 @@ right-justifies the label on the left of the center space. "(204 . LEFT)" starts
|
||||
|
||||
|
||||
|
||||
(* top margin of the page region for the first page of a chapter <where the first paragraph is the
|
||||
chapter title>, measured in points from the top page edge.)
|
||||
(* ;;
|
||||
"top margin of the page region for the first page of a chapter <where the first paragraph is the chapter title>, measured in points from the top page edge."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.PAGE.FIRST.TOPMARGIN 12)
|
||||
|
||||
|
||||
|
||||
(* top margin of the page region for the first page of the index, measured in points from the top page
|
||||
edge. Note that in the case of the index, because it uses two columns, the index title is implemented
|
||||
as a Tedit header, instead of as the first paragraph of the document.)
|
||||
(* ;;
|
||||
"top margin of the page region for the first page of the index, measured in points from the top page edge. Note that in the case of the index, because it uses two columns, the index title is implemented as a Tedit header, instead of as the first paragraph of the document."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.INDEX.PAGE.FIRST.TOPMARGIN 144)
|
||||
|
||||
|
||||
|
||||
(* y-pos of lower-left corner of footer text, measured in points from the bottom page edge.)
|
||||
(* ; "y-pos of lower-left corner of footer text, measured in points from the bottom page edge.")
|
||||
|
||||
|
||||
(RPAQ? IM.FOOTER.Y 22)
|
||||
|
||||
|
||||
|
||||
(* y-pos of the footer hrule, measured in points from the bottom page edge.)
|
||||
(* ; "y-pos of the footer hrule, measured in points from the bottom page edge.")
|
||||
|
||||
|
||||
(RPAQ? IM.FOOTER.RULE.Y 30)
|
||||
|
||||
|
||||
|
||||
(* y-pos of lower-left corner of header text, measured in points from the bottom page edge.)
|
||||
(* ; "y-pos of lower-left corner of header text, measured in points from the bottom page edge.")
|
||||
|
||||
|
||||
(RPAQ? IM.HEADER.Y 761)
|
||||
|
||||
|
||||
|
||||
(* y-pos of the header hrule, measured in points from the bottom page edge.)
|
||||
(* ; "y-pos of the header hrule, measured in points from the bottom page edge.")
|
||||
|
||||
|
||||
(RPAQ? IM.HEADER.RULE.Y 757)
|
||||
|
||||
|
||||
|
||||
(* y-pos of lower-left corner of bottom draft message, measured in points from the bottom page edge.)
|
||||
(* ;
|
||||
"y-pos of lower-left corner of bottom draft message, measured in points from the bottom page edge.")
|
||||
|
||||
|
||||
(RPAQ? IM.DRAFT.MESSAGE.BOTTOM.Y 5)
|
||||
|
||||
|
||||
|
||||
(* y-pos of lower-left corner of top draft message, measured in points from the bottom page edge.)
|
||||
(* ; "y-pos of lower-left corner of top draft message, measured in points from the bottom page edge.")
|
||||
|
||||
|
||||
(RPAQ? IM.DRAFT.MESSAGE.TOP.Y 775)
|
||||
|
||||
|
||||
|
||||
(* x-pos of lower-left corner of both top and bottom draft messages, measured in points from the left
|
||||
page edge.)
|
||||
(* ;;
|
||||
"x-pos of lower-left corner of both top and bottom draft messages, measured in points from the left page edge."
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? IM.DRAFT.MESSAGE.X 200)
|
||||
@@ -2388,23 +2407,23 @@ page edge.)
|
||||
(PUTPROPS SAVE.DUMPOUT MACRO (X (TRANSLATE.SAVE.DUMPOUT X)))
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (10668 38115 (IM.TEDIT 10678 . 12359) (DUMP 12361 . 14656) (DUMP.HEADERS.FOOTERS 14658
|
||||
. 17024) (DUMP.HRULE 17026 . 18177) (CHANGE.FONT 18179 . 19373) (IM.BOUT.IMAGEOBJ 19375 . 19698) (
|
||||
IM.TEDIT.DUMP.COMMANDS 19700 . 23253) (IM.TEDIT.DUMP.FOOTNOTES 23255 . 23696) (IM.TEDIT.DUMP.PARA
|
||||
23698 . 24472) (INDEXX.PARSE.TYPE 24474 . 25769) (FORMAT.DEF 25771 . 27902) (FORMAT.LISPWORD 27904 .
|
||||
28055) (MAKE.IM.DOCUMENT 28057 . 36970) (PRINT.NOTE 36972 . 37186) (SEND.INFO 37188 . 38113)) (38224
|
||||
42242 (IM.VRULE.DISPLAYFN 38234 . 38558) (CREATE.VRULE.OBJECT 38560 . 40340) (PRINT.VRULES.ON.PAGE
|
||||
40342 . 42240)) (42400 47155 (IM.FOLIO.DISPLAYFN 42410 . 43088) (IM.FOLIO.SIZEFN 43090 . 43939) (
|
||||
CREATE.FOLIO.OBJECT 43941 . 45487) (GET.FOLIO.STRING 45489 . 47153)) (47287 93527 (ARG#TOPROG 47297 .
|
||||
47436) (BIGLISPCODE#TOPROG 47438 . 48674) (BRACKET#TOPROG 48676 . 48840) (CHAPTER#TOPROG 48842 . 51523
|
||||
) (COMMENT#TOPROG 51525 . 52077) (DEF#TOPROG 52079 . 55414) (FIGURE#TOPROG 55416 . 56760) (FN#TOPROG
|
||||
56762 . 57159) (FNDEF#TOPROG 57161 . 61053) (FOOT#TOPROG 61055 . 61596) (INCLUDE#TOPROG 61598 . 61913)
|
||||
(INDEX#TOPROG 61915 . 63005) (INDEXX#TOPROG 63007 . 65088) (IT#TOPROG 65090 . 65231) (LBRACKET#TOPROG
|
||||
65233 . 65387) (LISP#TOPROG 65389 . 65530) (LISPCODE#TOPROG 65532 . 66651) (LISPWORD#TOPROG 66653 .
|
||||
67393) (LIST#TOPROG 67395 . 71817) (MACDEF#TOPROG 71819 . 72997) (NOTE#TOPROG 72999 . 73679) (
|
||||
PRINT.SPECIAL.CHARS#TOPROG 73681 . 74658) (PROPDEF#TOPROG 74660 . 74937) (RBRACKET#TOPROG 74939 .
|
||||
75093) (REF#TOPROG 75095 . 82934) (RM#TOPROG 82936 . 83074) (SUB#TOPROG 83076 . 83224) (SUBSEC#TOPROG
|
||||
83226 . 87729) (SUPER#TOPROG 87731 . 87885) (TABLE#TOPROG 87887 . 91839) (TAG#TOPROG 91841 . 92108) (
|
||||
TERM#TOPROG 92110 . 92423) (VAR#TOPROG 92425 . 92828) (VARDEF#TOPROG 92830 . 93525)) (111173 116115 (
|
||||
TRANSLATE.DUMPOUT 111183 . 115714) (TRANSLATE.SAVE.DUMPOUT 115716 . 116113)))))
|
||||
(FILEMAP (NIL (11391 38703 (IM.TEDIT 11401 . 13082) (DUMP 13084 . 15379) (DUMP.HEADERS.FOOTERS 15381
|
||||
. 17747) (DUMP.HRULE 17749 . 18900) (CHANGE.FONT 18902 . 20096) (IM.BOUT.IMAGEOBJ 20098 . 20421) (
|
||||
IM.TEDIT.DUMP.COMMANDS 20423 . 23976) (IM.TEDIT.DUMP.FOOTNOTES 23978 . 24419) (IM.TEDIT.DUMP.PARA
|
||||
24421 . 25195) (INDEXX.PARSE.TYPE 25197 . 26492) (FORMAT.DEF 26494 . 28625) (FORMAT.LISPWORD 28627 .
|
||||
28778) (MAKE.IM.DOCUMENT 28780 . 37558) (PRINT.NOTE 37560 . 37774) (SEND.INFO 37776 . 38701)) (38817
|
||||
42835 (IM.VRULE.DISPLAYFN 38827 . 39151) (CREATE.VRULE.OBJECT 39153 . 40933) (PRINT.VRULES.ON.PAGE
|
||||
40935 . 42833)) (42997 47752 (IM.FOLIO.DISPLAYFN 43007 . 43685) (IM.FOLIO.SIZEFN 43687 . 44536) (
|
||||
CREATE.FOLIO.OBJECT 44538 . 46084) (GET.FOLIO.STRING 46086 . 47750)) (47888 94128 (ARG#TOPROG 47898 .
|
||||
48037) (BIGLISPCODE#TOPROG 48039 . 49275) (BRACKET#TOPROG 49277 . 49441) (CHAPTER#TOPROG 49443 . 52124
|
||||
) (COMMENT#TOPROG 52126 . 52678) (DEF#TOPROG 52680 . 56015) (FIGURE#TOPROG 56017 . 57361) (FN#TOPROG
|
||||
57363 . 57760) (FNDEF#TOPROG 57762 . 61654) (FOOT#TOPROG 61656 . 62197) (INCLUDE#TOPROG 62199 . 62514)
|
||||
(INDEX#TOPROG 62516 . 63606) (INDEXX#TOPROG 63608 . 65689) (IT#TOPROG 65691 . 65832) (LBRACKET#TOPROG
|
||||
65834 . 65988) (LISP#TOPROG 65990 . 66131) (LISPCODE#TOPROG 66133 . 67252) (LISPWORD#TOPROG 67254 .
|
||||
67994) (LIST#TOPROG 67996 . 72418) (MACDEF#TOPROG 72420 . 73598) (NOTE#TOPROG 73600 . 74280) (
|
||||
PRINT.SPECIAL.CHARS#TOPROG 74282 . 75259) (PROPDEF#TOPROG 75261 . 75538) (RBRACKET#TOPROG 75540 .
|
||||
75694) (REF#TOPROG 75696 . 83535) (RM#TOPROG 83537 . 83675) (SUB#TOPROG 83677 . 83825) (SUBSEC#TOPROG
|
||||
83827 . 88330) (SUPER#TOPROG 88332 . 88486) (TABLE#TOPROG 88488 . 92440) (TAG#TOPROG 92442 . 92709) (
|
||||
TERM#TOPROG 92711 . 93024) (VAR#TOPROG 93026 . 93429) (VARDEF#TOPROG 93431 . 94126)) (111920 116862 (
|
||||
TRANSLATE.DUMPOUT 111930 . 116461) (TRANSLATE.SAVE.DUMPOUT 116463 . 116860)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1
installers/cygwin/.gitignore
vendored
1
installers/cygwin/.gitignore
vendored
@@ -4,3 +4,4 @@ maiko*.tgz
|
||||
setup-x86_64.exe
|
||||
medley.bat
|
||||
|
||||
|
||||
|
||||
@@ -9,7 +9,6 @@
|
||||
;#
|
||||
;###############################################################################
|
||||
|
||||
#define x86_or_x64 "x64"
|
||||
#if GetEnv('COMBINED_RELEASE_TAG') != ""
|
||||
#define VERSION=GetEnv('COMBINED_RELEASE_TAG')
|
||||
#else
|
||||
@@ -24,20 +23,17 @@
|
||||
|
||||
[Setup]
|
||||
PrivilegesRequired=lowest
|
||||
ArchitecturesAllowed={#x86_or_x64}
|
||||
ArchitecturesAllowed=x64compatible
|
||||
ArchitecturesInstallIn64BitMode=x64compatible
|
||||
AppName=Medley
|
||||
AppVersion={#version}
|
||||
AppPublisher=Interlisp.org
|
||||
AppPublisherURL=https://interlisp.org/
|
||||
AppCopyright=Copyright (C) 2023 Interlisp.org
|
||||
DefaultDirName={%USERPROFILE}\il
|
||||
AppCopyright=Copyright (C) 2023-2024 Interlisp.org
|
||||
DefaultDirName="{%USERPROFILE}\il"
|
||||
DefaultGroupName=Medley
|
||||
Compression=lzma2
|
||||
SolidCompression=yes
|
||||
; "ArchitecturesInstallIn64BitMode=x64" requests that the install be
|
||||
; done in "64-bit mode" on x64, meaning it should use the native
|
||||
; 64-bit Program Files directory and the 64-bit view of the registry.
|
||||
ArchitecturesInstallIn64BitMode=x64
|
||||
OutputDir="."
|
||||
OutputBaseFilename={#OUTFILE}
|
||||
SetupIconFile="Medley.ico"
|
||||
@@ -48,7 +44,7 @@ WizardImageFile=medley_logo.bmp
|
||||
WizardSmallImageFile=medley_logo_small.bmp
|
||||
WizardImageStretch=no
|
||||
UninstallDisplayIcon="{app}\Medley.ico"
|
||||
UninstallFilesDir={app}\uninstall
|
||||
UninstallFilesDir="{app}\uninstall"
|
||||
UsePreviousAppDir=no
|
||||
|
||||
[Dirs]
|
||||
@@ -68,18 +64,21 @@ Name: "{group}\Medley\Uninstall_Medley"; Filename: "{uninstallexe}"
|
||||
; Name: "{group}\Medley\Medley"; Filename: "powershell"; Parameters: "-NoExit -File {app}\medley.ps1 --help"; IconFilename: "{app}\Medley.ico"
|
||||
|
||||
[Run]
|
||||
Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root {app} --site https://mirrors.kernel.org/sourceware/cygwin --only-site --local-package-dir {app}\cygwin --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..."
|
||||
Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root ""{app}"" --site https://mirrors.kernel.org/sourceware/cygwin --only-site --local-package-dir ""{app}\cygwin"" --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..."
|
||||
Filename: "{app}\bin\bash"; Parameters: "-login -c 'sed -i -e s/^none/#none/ /etc/fstab && echo none / cygdrive binary,posix=0,user 0 0 >>/etc/fstab'"; Flags: runhidden
|
||||
Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\medley.tgz"; Flags: runhidden; StatusMsg: "Installing Medley ..."
|
||||
Filename: "powershell"; Parameters: "remove-item -force -recurse {app}\maiko"; Flags: runhidden; StatusMsg: "Installing Maiko ..."
|
||||
Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\maiko-cygwin.x86_64.tgz"; Flags: runhidden; StatusMsg: "Installing Maiko ..."
|
||||
Filename: "tar"; Parameters: "-x -z -C ""{app}"" -f ""{app}\install\medley.tgz"""; Flags: runhidden; StatusMsg: "Installing Medley ..."
|
||||
Filename: "powershell"; Parameters: "remove-item -force -recurse ""{app}\maiko"""; Flags: runhidden; StatusMsg: "Installing Maiko ..."
|
||||
Filename: "tar"; Parameters: "-x -z -C ""{app}"" -f ""{app}\install\maiko-cygwin.x86_64.tgz"""; Flags: runhidden; StatusMsg: "Installing Maiko ..."
|
||||
; Recreate medley symbolic links (lost in tars)
|
||||
Filename: "{app}\bin\bash"; Parameters: "-login -c 'cd /medley/scripts/medley && ln -s medley.command medley.sh && cd ../.. && ln -s /medley/scripts/medley/medley.sh medley'"; Flags: runhidden
|
||||
; Create medley.bat
|
||||
Filename: "powershell"; Parameters: "write-output \""{app}\bin\bash -login -c '/medley/scripts/medley/medley.sh %*'\"" | out-file medley.bat -Encoding ascii"; WorkingDir: "{app}"; Flags: runhidden; StatusMsg: "Creating medley.bat ..."
|
||||
Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --add {app}"; Flags: runhidden; StatusMsg: "Adding to PATH ..."
|
||||
Filename: "powershell"; Parameters: "remove-item -recurse -force {app}\install"; Flags: runhidden; StatusMsg: "Cleaning up ..."
|
||||
Filename: "powershell"; Parameters: "write-output '""""""""{app}\bin\bash"""""""" -login -c """"""""/medley/scripts/medley/medley.sh %*""""""""' | out-file medley.bat -Encoding ascii -NoNewline"; WorkingDir: "{app}"; Flags: runhidden; StatusMsg: "Creating medley.bat ..."
|
||||
Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --add ""{app}"""; Flags: runhidden; StatusMsg: "Adding to PATH ..."
|
||||
Filename: "powershell"; Parameters: "remove-item -recurse -force """"""""{app}\install"""""""""; Flags: runhidden; StatusMsg: "Cleaning up ..."
|
||||
|
||||
[UninstallDelete]
|
||||
Type: filesandordirs; Name: "{app}"
|
||||
|
||||
[UninstallRun]
|
||||
Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --remove {app}"; Flags: runhidden
|
||||
Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --remove ""{app}"""; Flags: runhidden
|
||||
|
||||
|
||||
9
installers/cygwin/prep-for-local-testing.ps1
Normal file
9
installers/cygwin/prep-for-local-testing.ps1
Normal file
@@ -0,0 +1,9 @@
|
||||
#
|
||||
# Prep the installer/cygwin directory to locally test the medley.iss installer
|
||||
# Normally these downloads are done by the github workflow
|
||||
#
|
||||
# fgh 2024-11-15
|
||||
#
|
||||
wget https://cygwin.com/setup-x86_64.exe -OutFile setup-x86_64.exe
|
||||
gh release download --repo interlisp/maiko --pattern *-cygwin.x86_64.tgz --output maiko-cygwin.x86_64.tgz --clobber
|
||||
gh release download --repo interlisp/medley --pattern medley-full-linux-x86_64-*.tgz --output medley.tgz --clobber
|
||||
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "29-Apr-2024 16:25:20" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;9 28903
|
||||
(FILECREATED "14-Jul-2024 12:51:12" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;16 30093
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:CHANGES-TO (FNS MAKE-INDEX-HTMLS)
|
||||
|
||||
:PREVIOUS-DATE "26-Apr-2024 16:34:08" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;8)
|
||||
:PREVIOUS-DATE "13-Jul-2024 23:39:43" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;14)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
@@ -124,13 +124,16 @@
|
||||
"Welcome to Fuller sysout"])
|
||||
|
||||
(MAKE-INDEX-HTMLS
|
||||
[LAMBDA (BASE TOP) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
[LAMBDA (BASE TOP LEVEL) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
(* ; "Edited 26-Apr-2024 16:15 by lmm")
|
||||
(* ; "Edited 20-Apr-2024 12:34 by lmm")
|
||||
(* ; "Edited 13-Apr-2024 21:18 by lmm")
|
||||
[OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
|
||||
(OR (DIRECTORYNAMEP BASE)
|
||||
(ERROR BASE "not a directory name"))
|
||||
(OR (AND (NUMBERP LEVEL)
|
||||
(IGREATERP LEVEL 0))
|
||||
(SETQ LEVEL 1))
|
||||
(LET* ((SUBDIRS NIL)
|
||||
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
|
||||
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
|
||||
@@ -138,9 +141,20 @@
|
||||
SLASHED SHORTNAME)
|
||||
(CL:WITH-OPEN-FILE
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
|
||||
(CL:FORMAT S "<HTML><HEAD><TITLE>Index page for ~a</TITLE></HEAD>~%%" (SETQ SLASHED
|
||||
(SLASHIT BASE)))
|
||||
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
|
||||
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
|
||||
(CL:FORMAT S "<SCRIPT>~%%")
|
||||
(CL:FORMAT S " function up_onclick(){~%%")
|
||||
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
|
||||
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
|
||||
(CL:FORMAT S " }~%%")
|
||||
(CL:FORMAT S "</SCRIPT>~%%")
|
||||
(CL:FORMAT S "</HEAD>~%%")
|
||||
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
|
||||
(CL:UNLESS (EQ LEVEL 1)
|
||||
(CL:FORMAT S
|
||||
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
|
||||
))
|
||||
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
|
||||
(FOR FULLNAME IN (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
DO (IF (EQ (NTHCHAR FULLNAME -1)
|
||||
@@ -181,7 +195,8 @@
|
||||
|
||||
ELSE (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
|
||||
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
|
||||
(NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE])
|
||||
(NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
|
||||
(ADD1 LEVEL])
|
||||
|
||||
(MEDLEY-FIX-LINKS
|
||||
[LAMBDA (UNIXPATH) (* ; "Edited 18-Jan-2021 12:01 by larry")
|
||||
@@ -258,7 +273,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(HCFILES
|
||||
[LAMBDA (BASE REDO SUBSETS) (* ; "Edited 23-Apr-2024 23:15 by lmm")
|
||||
[LAMBDA (BASE REDO SUBSETS) (* ; "Edited 30-Jun-2024 08:27 by lmm")
|
||||
(* ; "Edited 23-Apr-2024 23:15 by lmm")
|
||||
(* ; "Edited 22-Apr-2024 13:22 by lmm")
|
||||
(* ; "Edited 5-Feb-2024 12:16 by lmm")
|
||||
(* ; "Edited 4-Nov-2023 11:14 by lmm")
|
||||
@@ -302,12 +318,7 @@
|
||||
(* ;;
|
||||
" doesnt (yet) implement / to - translattion. .readme should show up as -.readme.")
|
||||
|
||||
(SETQ DEST (PACKFILENAME 'EXTENSION 'pdf 'NAME
|
||||
(IF EXT
|
||||
THEN (LISTGET SRC 'NAME)
|
||||
ELSE (PACK* (LISTGET SRC 'NAME)
|
||||
'-src))
|
||||
'BODY NOV))
|
||||
(SETQ DEST (CONCAT NOV ".pdf"))
|
||||
(CL:WHEN (AND (NOT REDO)
|
||||
(INFILEP DEST))
|
||||
(CL:FORMAT T "~a already there~%%" DEST)
|
||||
@@ -338,13 +349,16 @@
|
||||
(PRINTOUT T "DONE" T))])
|
||||
|
||||
(MAKE-INDEX-HTMLS
|
||||
[LAMBDA (BASE TOP) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
[LAMBDA (BASE TOP LEVEL) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
(* ; "Edited 26-Apr-2024 16:15 by lmm")
|
||||
(* ; "Edited 20-Apr-2024 12:34 by lmm")
|
||||
(* ; "Edited 13-Apr-2024 21:18 by lmm")
|
||||
[OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
|
||||
(OR (DIRECTORYNAMEP BASE)
|
||||
(ERROR BASE "not a directory name"))
|
||||
(OR (AND (NUMBERP LEVEL)
|
||||
(IGREATERP LEVEL 0))
|
||||
(SETQ LEVEL 1))
|
||||
(LET* ((SUBDIRS NIL)
|
||||
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
|
||||
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
|
||||
@@ -352,9 +366,20 @@
|
||||
SLASHED SHORTNAME)
|
||||
(CL:WITH-OPEN-FILE
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
|
||||
(CL:FORMAT S "<HTML><HEAD><TITLE>Index page for ~a</TITLE></HEAD>~%%" (SETQ SLASHED
|
||||
(SLASHIT BASE)))
|
||||
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
|
||||
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
|
||||
(CL:FORMAT S "<SCRIPT>~%%")
|
||||
(CL:FORMAT S " function up_onclick(){~%%")
|
||||
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
|
||||
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
|
||||
(CL:FORMAT S " }~%%")
|
||||
(CL:FORMAT S "</SCRIPT>~%%")
|
||||
(CL:FORMAT S "</HEAD>~%%")
|
||||
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
|
||||
(CL:UNLESS (EQ LEVEL 1)
|
||||
(CL:FORMAT S
|
||||
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
|
||||
))
|
||||
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
|
||||
(FOR FULLNAME IN (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
DO (IF (EQ (NTHCHAR FULLNAME -1)
|
||||
@@ -395,7 +420,8 @@
|
||||
|
||||
ELSE (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
|
||||
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
|
||||
(NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE])
|
||||
(NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
|
||||
(ADD1 LEVEL])
|
||||
)
|
||||
|
||||
(PUTPROPS MEDLEY-UTILS FILETYPE :COMPILE-FILE)
|
||||
@@ -502,9 +528,9 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1064 11630 (GATHER-INFO 1074 . 6456) (MAKE-FULLER-DB 6458 . 7235) (MAKE-INDEX-HTMLS
|
||||
7237 . 10999) (MEDLEY-FIX-LINKS 11001 . 11394) (MEDLEY-FIX-DATES 11396 . 11628)) (12809 15597 (
|
||||
MAKE-EXPORTS-ALL 12819 . 13878) (MAKE-WHEREIS-HASH 13880 . 15069) (MAKE-WHEREIS-LOOPS 15071 . 15595))
|
||||
(15598 23855 (HCFILES 15608 . 20089) (MAKE-INDEX-HTMLS 20091 . 23853)) (24105 28717 (RECOMPILE-ONE
|
||||
24115 . 26012) (RECMPL 26014 . 26617) (COMPILE-SETUP 26619 . 27243) (REMAKEFILES 27245 . 28715)))))
|
||||
(FILEMAP (NIL (1086 12345 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7257) (MAKE-INDEX-HTMLS
|
||||
7259 . 11714) (MEDLEY-FIX-LINKS 11716 . 12109) (MEDLEY-FIX-DATES 12111 . 12343)) (13524 16312 (
|
||||
MAKE-EXPORTS-ALL 13534 . 14593) (MAKE-WHEREIS-HASH 14595 . 15784) (MAKE-WHEREIS-LOOPS 15786 . 16310))
|
||||
(16313 25045 (HCFILES 16323 . 20586) (MAKE-INDEX-HTMLS 20588 . 25043)) (25295 29907 (RECOMPILE-ONE
|
||||
25305 . 27202) (RECMPL 27204 . 27807) (COMPILE-SETUP 27809 . 28433) (REMAKEFILES 28435 . 29905)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
2470
internal/TEDIT-DEBUG
Normal file
2470
internal/TEDIT-DEBUG
Normal file
File diff suppressed because it is too large
Load Diff
BIN
internal/TEDIT-DEBUG.LCOM
Normal file
BIN
internal/TEDIT-DEBUG.LCOM
Normal file
Binary file not shown.
@@ -1,16 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Apr-2023 12:41:36" {DSK}<home>larry>il>medley>library>BROWSER.;6 29801
|
||||
(FILECREATED "21-May-2024 18:46:31" {LIB}BROWSER.;2 29502
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS BROWSER.LEFTFN NUMSPATHS STBROWSER MSPATHS.DISPATCH BROWSER
|
||||
BROWSER.WHENFNSCHANGED BRPATHS1 GET.BROWSE.PP.WINDOW
|
||||
GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN
|
||||
BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH)
|
||||
(VARS BROWSERCOMS BROWSER.BORDERS)
|
||||
:CHANGES-TO (FNS BROWSER.LEFTFN)
|
||||
|
||||
:PREVIOUS-DATE "15-Apr-2023 18:55:36" {DSK}<home>larry>il>medley>library>BROWSER.;1)
|
||||
:PREVIOUS-DATE "26-Apr-2023 12:41:36" {LIB}BROWSER.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT BROWSERCOMS)
|
||||
@@ -202,28 +198,29 @@
|
||||
(RETURN ENTRY])
|
||||
|
||||
(BROWSER.LEFTFN
|
||||
[LAMBDA (NODE NWINDOW) (* ; "Edited 26-Apr-2023 12:41 by lmm")
|
||||
[LAMBDA (NODE NWINDOW) (* ; "Edited 21-May-2024 18:40 by mth")
|
||||
(* ; "Edited 26-Apr-2023 12:41 by lmm")
|
||||
(* ; "Edited 31-Mar-87 11:16 by jop")
|
||||
(* ;
|
||||
"function that is applied upon selection of a node.")
|
||||
(PROG (FN SELECTION)
|
||||
(IF (NULL NODE)
|
||||
THEN (RETURN)
|
||||
(if (NULL NODE)
|
||||
then (RETURN)
|
||||
(MOVEW NWINDOW) (* ;
|
||||
" really want to just drag the content around")
|
||||
(RETURN))
|
||||
(IF (NULL (SETQ FN (FETCH NODELABEL OF NODE)))
|
||||
THEN (RETURN))
|
||||
[SETQ SELECTION (MENU (CREATE MENU
|
||||
(if (NULL (SETQ FN (fetch NODELABEL of NODE)))
|
||||
then (RETURN))
|
||||
[SETQ SELECTION (MENU (create MENU
|
||||
ITEMS _ '(CallsFrom CallsTo Edit Show InspectCode]
|
||||
|
||||
(* ;; "Mot implemented: Ignore Avoid")
|
||||
|
||||
(DESTRUCTURING-BIND (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH)
|
||||
(FOR BW IN BROWSERWINDOWS WHEN (EQ (FETCH (BROWSEWIN WINDOW) OF BW)
|
||||
NWINDOW) DO (RETURN (FETCH (BROWSEWIN ARGS)
|
||||
OF BW))
|
||||
FINALLY (PROMPTPRINT "No browser window found for" FN)
|
||||
(for BW in BROWSERWINDOWS when (EQ (fetch (BROWSEWIN WINDOW) of BW)
|
||||
NWINDOW) do (RETURN (fetch (BROWSEWIN ARGS)
|
||||
of BW))
|
||||
finally (PROMPTPRINT "No browser window found for" FN)
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Now we have the arguments to MSPATHS .. insert this node?")
|
||||
@@ -245,11 +242,11 @@
|
||||
NIL
|
||||
(Ignore (* ; "local ignore"))
|
||||
(Avoid (* ; " global ignore"))
|
||||
(Edit (ED FN (IF (HASDEF FN 'FNS)
|
||||
THEN 'FNS
|
||||
ELSEIF (HASDEF FN 'FUNCTIONS)
|
||||
THEN 'FUNCTIONS
|
||||
ELSE (PROMPTPRINT FN "no definition")
|
||||
(Edit (ED FN (if (HASDEF FN 'FNS)
|
||||
then '(FNS :DONTWAIT)
|
||||
elseif (HASDEF FN 'FUNCTIONS)
|
||||
then '(FUNCTIONS :DONTWAIT)
|
||||
else (PROMPTPRINT FN "no definition")
|
||||
NIL)))
|
||||
(Show (CL:UNLESS (EQ FN (WINDOWPROP (GET.BROWSE.PP.WINDOW)
|
||||
'FNBROWSED))
|
||||
@@ -544,10 +541,10 @@
|
||||
(BROWSER T)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2085 28437 (MSPATHS.DISPATCH 2095 . 2569) (NUMSPATHS 2571 . 6158) (BROWSER 6160 . 6731)
|
||||
(BROWSER.WHENFNSCHANGED 6733 . 8518) (BRPATHS1 8520 . 11171) (BROWSER.LEFTFN 11173 . 14599) (
|
||||
GET.BROWSE.PP.WINDOW 14601 . 15426) (GET.BROWSE.DESCRIBE.WINDOW 15428 . 16176) (BROWSEPP 16178 . 17052
|
||||
) (PPREPAINTFN 17054 . 20180) (PPRESHAPEFN 20182 . 20358) (DESCRIBEREPAINTFN 20360 . 21064) (
|
||||
BROWSERDESCRIBE 21066 . 21808) (BROWSER.MIDDLEFN 21810 . 23125) (DEDITPROCESSRUNNINGP 23127 . 23382) (
|
||||
REDRAWBROWSEGRAPH 23384 . 24148) (STBROWSER 24150 . 28435)))))
|
||||
(FILEMAP (NIL (1653 28138 (MSPATHS.DISPATCH 1663 . 2137) (NUMSPATHS 2139 . 5726) (BROWSER 5728 . 6299)
|
||||
(BROWSER.WHENFNSCHANGED 6301 . 8086) (BRPATHS1 8088 . 10739) (BROWSER.LEFTFN 10741 . 14300) (
|
||||
GET.BROWSE.PP.WINDOW 14302 . 15127) (GET.BROWSE.DESCRIBE.WINDOW 15129 . 15877) (BROWSEPP 15879 . 16753
|
||||
) (PPREPAINTFN 16755 . 19881) (PPRESHAPEFN 19883 . 20059) (DESCRIBEREPAINTFN 20061 . 20765) (
|
||||
BROWSERDESCRIBE 20767 . 21509) (BROWSER.MIDDLEFN 21511 . 22826) (DEDITPROCESSRUNNINGP 22828 . 23083) (
|
||||
REDRAWBROWSEGRAPH 23085 . 23849) (STBROWSER 23851 . 28136)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 4-Nov-2023 23:55:27" |{WMEDLEY}<library>FILEBROWSER.;27| 266102
|
||||
(FILECREATED "29-May-2024 15:30:07" {LIB}FILEBROWSER.\;2 266071
|
||||
|
||||
:EDIT-BY |rmk|
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (VARS FILEBROWSERCOMS)
|
||||
(FNS FB.EDITCOMMAND.ONEFILE)
|
||||
:CHANGES-TO (FNS FB.PROMPTW.FORMAT FB.FASTSEE.ONEFILE)
|
||||
|
||||
:PREVIOUS-DATE " 4-Nov-2023 23:50:29" |{WMEDLEY}<library>FILEBROWSER.;26|)
|
||||
:PREVIOUS-DATE " 4-Nov-2023 23:55:27" {LIB}FILEBROWSER.\;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FILEBROWSERCOMS)
|
||||
@@ -729,14 +728,17 @@ Your deletions are thus ignored.")))
|
||||
(PRIN1 THING WINDOW))))))))
|
||||
|
||||
(FB.PROMPTW.FORMAT
|
||||
(CL:LAMBDA (BROWSER FORMAT-STRING &REST ARGS) (* \; "Edited 4-Feb-88 23:15 by bvm:")
|
||||
(CL:LAMBDA (BROWSER FORMAT-STRING &REST ARGS) (* \; "Edited 29-May-2024 15:16 by mth")
|
||||
(* \; "Edited 4-Feb-88 23:15 by bvm:")
|
||||
|
||||
(* |;;| "Outputs to FOLDER's prompt window using FORMAT.")
|
||||
|
||||
(LET ((*PRINT-CASE* :UPCASE)
|
||||
(*PRINT-BASE* 10)
|
||||
(WINDOW (|ffetch| (FILEBROWSER PROMPTWINDOW) |of| (\\DTEST BROWSER
|
||||
'FILEBROWSER))))
|
||||
(WINDOW (OR (AND (|type?| FILEBROWSER BROWSER)
|
||||
(|ffetch| (FILEBROWSER PROMPTWINDOW) |of| (\\DTEST BROWSER
|
||||
'FILEBROWSER)))
|
||||
PROMPTWINDOW)))
|
||||
|
||||
(* |;;| "*PRINT-CASE* is bound so symbols get printed in \"expected\" case. *PRINT-BASE* is 10 for benefit of printing numbers in the non-format case.")
|
||||
|
||||
@@ -1896,10 +1898,9 @@ Your deletions are thus ignored.")))
|
||||
SEEWINDOW UNFORMATTED (CDR TAIL)))))))
|
||||
|
||||
(FB.FASTSEE.ONEFILE
|
||||
(LAMBDA (BROWSER FILE WINDOW UNFORMATTED MORE) (* \;
|
||||
"Edited 21-Feb-2021 14:46 by rmk:")
|
||||
(* \;
|
||||
"Edited 20-Nov-2000 14:23 by rmk:")
|
||||
(LAMBDA (BROWSER FILE WINDOW UNFORMATTED MORE) (* \; "Edited 29-May-2024 15:28 by mth")
|
||||
(* \; "Edited 21-Feb-2021 14:46 by rmk:")
|
||||
(* \; "Edited 20-Nov-2000 14:23 by rmk:")
|
||||
(* \; "Edited 19-Aug-91 13:06 by jds")
|
||||
(COND
|
||||
((DIRECTORYNAMEP FILE)
|
||||
@@ -1921,32 +1922,30 @@ Your deletions are thus ignored.")))
|
||||
|
||||
(* |;;| "Failed on this file. If this was the only file, the message can be a little more terse (which is desirable, because the typical message is \"File not found xxx\")")
|
||||
|
||||
(FB.PROMPTW.FORMAT BROWSER "~:[Failed~;~:*Couldn't see ~A~] because ~A"
|
||||
(FB.PROMPTW.FORMAT BROWSER "~&~:[Failed~;~:*Couldn't see ~A~] because ~A"
|
||||
(AND MORE FILE)
|
||||
CONDITION)
|
||||
|else| (RESETLST
|
||||
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM WINDOW)
|
||||
(AND RESETSTATE (OPENWP WINDOW)
|
||||
(WINDOWPROP
|
||||
WINDOW
|
||||
'TITLE
|
||||
(CONCAT (WINDOWPROP WINDOW
|
||||
'TITLE)
|
||||
" -- " "Aborted")))
|
||||
(CLOSEF STREAM)))
|
||||
STREAM WINDOW))
|
||||
(WINDOWPROP WINDOW 'MORETYPE (COND
|
||||
(MORE 'YETMOREBUTTONS)
|
||||
(T 'LASTMOREBUTTONS)))
|
||||
(COND
|
||||
(UNFORMATTED (COPYCHARS STREAM WINDOW))
|
||||
(T (PFCOPYBYTES STREAM WINDOW)))
|
||||
(WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE)
|
||||
" -- " "Finished"))
|
||||
(COND
|
||||
(MORE (* \; "Wait for OK to proceed")
|
||||
(FB.SEEFULLFN (WINDOWPROP WINDOW 'DSP)
|
||||
'FINISHEDMOREBUTTONS))))))))))
|
||||
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM WINDOW)
|
||||
(AND RESETSTATE (OPENWP WINDOW)
|
||||
(WINDOWPROP WINDOW 'TITLE
|
||||
(CONCAT (WINDOWPROP WINDOW
|
||||
'TITLE)
|
||||
" -- " "Aborted")))
|
||||
(CLOSEF STREAM)))
|
||||
STREAM WINDOW))
|
||||
(WINDOWPROP WINDOW 'MORETYPE (COND
|
||||
(MORE 'YETMOREBUTTONS)
|
||||
(T 'LASTMOREBUTTONS)))
|
||||
(COND
|
||||
(UNFORMATTED (COPYCHARS STREAM WINDOW))
|
||||
(T (PFCOPYBYTES STREAM WINDOW)))
|
||||
(WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE)
|
||||
" -- " "Finished"))
|
||||
(COND
|
||||
(MORE (* \; "Wait for OK to proceed")
|
||||
(FB.SEEFULLFN (WINDOWPROP WINDOW 'DSP)
|
||||
'FINISHEDMOREBUTTONS))))))))))
|
||||
|
||||
(FB.SEEFULLFN
|
||||
(LAMBDA (DSP PROP) (* |bvm:| "18-Sep-85 23:29")
|
||||
@@ -4250,51 +4249,51 @@ then click Recompute"))))
|
||||
(ADDTOVAR LAMA FB.PROMPTW.FORMAT FB.PROMPTWPRINT)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (31928 54809 (FB 31938 . 33073) (FB.COPYBINARYCOMMAND 33075 . 33421) (FB.COPYTEXTCOMMAND
|
||||
33423 . 33765) (FILEBROWSER 33767 . 46873) (FB.TABLEBROWSER 46875 . 47092) (FB.SELECTEDFILES 47094 .
|
||||
47731) (FB.FETCHFILENAME 47733 . 48125) (FB.DIRECTORYP 48127 . 48521) (FB.PROMPTWPRINT 48523 . 49569)
|
||||
(FB.PROMPTW.FORMAT 49571 . 50308) (FB.PROMPTFORINPUT 50310 . 52562) (FB.YES-OR-NO-P 52564 . 53598) (
|
||||
FB.ALLOW.ABORT 53600 . 54454) (\\FB.HARDCOPY.TOFILE.EXTENSION 54456 . 54807)) (54833 55786 (FB.STARTUP
|
||||
54843 . 55358) (FB.MAKERIGIDWINDOW 55360 . 55784)) (55787 61270 (FB.PRINTFN 55797 . 60950) (FB.COPYFN
|
||||
60952 . 61268)) (61320 67660 (FB.MENU.WHENSELECTEDFN 61330 . 61688) (FB.COMMANDSELECTEDFN 61690 .
|
||||
63229) (FB.SUBITEMP 63231 . 63832) (FB.MAKE.BROWSER.BUSY 63834 . 64638) (FB.FINISH.COMMAND 64640 .
|
||||
66671) (FB.HANDLE.ABORT.BUTTON 66673 . 67658)) (67661 73177 (FB.DELETECOMMAND 67671 . 67952) (
|
||||
FB.DELVERCOMMAND 67954 . 71147) (FB.IS.NOT.SUBDIRECTORY.ITEM 71149 . 71330) (FB.DELVER.FILES 71332 .
|
||||
72421) (FB.DELETE.FILE 72423 . 73175)) (73178 74503 (FB.UNDELETECOMMAND 73188 . 73473) (
|
||||
FB.UNDELETEALLCOMMAND 73475 . 73754) (FB.UNDELETE.FILE 73756 . 74501)) (74504 98685 (FB.COPYCOMMAND
|
||||
74514 . 74783) (FB.RENAMECOMMAND 74785 . 75060) (FB.COPY/RENAME.COMMAND 75062 . 75985) (
|
||||
FB.COPY/RENAME.ONE 75987 . 78309) (FB.COPY/RENAME.MANY 78311 . 84531) (FB.MERGE.DIRECTORIES 84533 .
|
||||
84951) (FB.GREATEST.PREFIX 84953 . 86309) (FB.MAYBE.INSERT.FILE 86311 . 93751) (FB.GET.NEW.FILE.SPEC
|
||||
93753 . 97584) (FB.CANONICAL.DIRECTORY 97586 . 98683)) (98686 106470 (FB.HARDCOPYCOMMAND 98696 . 99826
|
||||
) (FB.HARDCOPY.TOFILE 99828 . 106468)) (106471 116680 (FB.EDITCOMMAND 106481 . 107348) (
|
||||
FB.EDITCOMMAND.ONEFILE 107350 . 110764) (FB.EDITLISPFILE 110766 . 111871) (FB.BROWSECOMMAND 111873 .
|
||||
116678)) (116681 128602 (FB.FASTSEECOMMAND 116691 . 120141) (FB.FASTSEE.ONEFILE 120143 . 123300) (
|
||||
FB.SEEFULLFN 123302 . 127433) (FB.SEEBUTTONFN 127435 . 128600)) (128603 130349 (FB.LOADCOMMAND 128613
|
||||
. 129120) (FB.COMPILECOMMAND 129122 . 129660) (FB.OPERATE.ON.FILES 129662 . 130347)) (130350 178535 (
|
||||
FB.UPDATECOMMAND 130360 . 130585) (FB.FIX-DIRECTORY-DATES 130587 . 131610) (FB.MAYBE.EXPUNGE 131612 .
|
||||
132673) (FB.UPDATEBROWSERITEMS 132675 . 145890) (FB.DATE 145892 . 146533) (FB.ADJUST.DATE.WIDTH 146535
|
||||
. 149503) (FB.SET.BROWSER.TITLE 149505 . 150507) (FB.MAYBE.WIDEN.NAMES 150509 . 152628) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 152630 . 153994) (FB.CREATE.FILEBUCKET 153996 . 161216) (
|
||||
FB.CHECK.NAME.LENGTH 161218 . 163639) (FB.ADD.FILEGROUP 163641 . 165168) (FB.INSERT.DIRECTORY 165170
|
||||
. 165408) (FB.MAKE.SUBDIRECTORY.ITEM 165410 . 166819) (FB.ADD.FILE 166821 . 167434) (FB.INSERT.FILE
|
||||
167436 . 170848) (FB.ANALYZE.PATTERN 170850 . 176114) (FB.CANONICALIZE.PATTERN 176116 . 177428) (
|
||||
FB.GETALLFILEINFO 177430 . 178533)) (178536 186695 (FB.SORT.VERSIONS 178546 . 181317) (
|
||||
FB.DECREASING.VERSION 181319 . 181988) (FB.INCREASING.VERSION 181990 . 182611) (
|
||||
FB.NAMES.DECREASING.VERSION 182613 . 183648) (FB.NAMES.INCREASING.VERSION 183650 . 184647) (
|
||||
FB.DECREASING.NUMERIC.ATTR 184649 . 185329) (FB.INCREASING.NUMERIC.ATTR 185331 . 186005) (
|
||||
FB.ALPHABETIC.ATTR 186007 . 186693)) (186696 196538 (FB.SORTCOMMAND 186706 . 193536) (
|
||||
FB.INSERT.SUBDIRECTORIES 193538 . 194335) (FB.GET.SORT.MENU 194337 . 196536)) (196539 212760 (
|
||||
FB.EXPUNGECOMMAND 196549 . 199134) (FB.NEWPATTERNCOMMAND 199136 . 199534) (FB.NEWINFOCOMMAND 199536 .
|
||||
202368) (FB.DEPTHCOMMAND 202370 . 204145) (FB.SHAPECOMMAND 204147 . 207489) (FB.REMOVE.FILE 207491 .
|
||||
209312) (FB.COUNT.FILE.CHANGE 209314 . 210759) (FB.SETNEWPATTERN 210761 . 211931) (FB.GET.NEWPATTERN
|
||||
211933 . 212517) (FB.OPTIONSCOMMAND 212519 . 212758)) (212795 213848 (FB.GETWINDOW 212805 . 213846)) (
|
||||
213849 214861 (FB.INFOMENU.SHADEINITIALSELECTIONS 213859 . 214506) (FB.INFO.ITEM.NAMED 214508 . 214859
|
||||
)) (214862 224394 (FB.MAKECOUNTERWINDOW 214872 . 216400) (FB.COUNTERW.REDISPLAYFN 216402 . 216989) (
|
||||
FB.UPDATE.COUNTERS 216991 . 219063) (FB.DISPLAY.COUNTERS 219065 . 224125) (FB.COUNTER.STRING 224127 .
|
||||
224392)) (224395 229104 (FB.MAKEHEADINGWINDOW 224405 . 226019) (FB.HEADINGW.REDISPLAYFN 226021 .
|
||||
226287) (FB.HEADINGW.RESHAPEFN 226289 . 226665) (FB.HEADINGW.DISPLAY 226667 . 229102)) (229105 233288
|
||||
(FB.ICONFN 229115 . 229462) (FB.INFOMENU.WHENSELECTEDFN 229464 . 230194) (FB.CLOSEFN 230196 . 231399)
|
||||
(FB.EXPUNGE?.MENU 231401 . 231813) (FB.AFTERCLOSEFN 231815 . 232176) (FB.CLOSE&EXPUNGE 232178 . 233286
|
||||
)) (233289 245347 (FB.HARDCOPY.DIRECTORY 233299 . 243656) (FB.HARDCOPY.PRINT.TITLE 243658 . 243984) (
|
||||
FB.HARDCOPY.MAXWIDTH 243986 . 245345)))))
|
||||
(FILEMAP (NIL (31871 54979 (FB 31881 . 33016) (FB.COPYBINARYCOMMAND 33018 . 33364) (FB.COPYTEXTCOMMAND
|
||||
33366 . 33708) (FILEBROWSER 33710 . 46816) (FB.TABLEBROWSER 46818 . 47035) (FB.SELECTEDFILES 47037 .
|
||||
47674) (FB.FETCHFILENAME 47676 . 48068) (FB.DIRECTORYP 48070 . 48464) (FB.PROMPTWPRINT 48466 . 49512)
|
||||
(FB.PROMPTW.FORMAT 49514 . 50478) (FB.PROMPTFORINPUT 50480 . 52732) (FB.YES-OR-NO-P 52734 . 53768) (
|
||||
FB.ALLOW.ABORT 53770 . 54624) (\\FB.HARDCOPY.TOFILE.EXTENSION 54626 . 54977)) (55003 55956 (FB.STARTUP
|
||||
55013 . 55528) (FB.MAKERIGIDWINDOW 55530 . 55954)) (55957 61440 (FB.PRINTFN 55967 . 61120) (FB.COPYFN
|
||||
61122 . 61438)) (61490 67830 (FB.MENU.WHENSELECTEDFN 61500 . 61858) (FB.COMMANDSELECTEDFN 61860 .
|
||||
63399) (FB.SUBITEMP 63401 . 64002) (FB.MAKE.BROWSER.BUSY 64004 . 64808) (FB.FINISH.COMMAND 64810 .
|
||||
66841) (FB.HANDLE.ABORT.BUTTON 66843 . 67828)) (67831 73347 (FB.DELETECOMMAND 67841 . 68122) (
|
||||
FB.DELVERCOMMAND 68124 . 71317) (FB.IS.NOT.SUBDIRECTORY.ITEM 71319 . 71500) (FB.DELVER.FILES 71502 .
|
||||
72591) (FB.DELETE.FILE 72593 . 73345)) (73348 74673 (FB.UNDELETECOMMAND 73358 . 73643) (
|
||||
FB.UNDELETEALLCOMMAND 73645 . 73924) (FB.UNDELETE.FILE 73926 . 74671)) (74674 98855 (FB.COPYCOMMAND
|
||||
74684 . 74953) (FB.RENAMECOMMAND 74955 . 75230) (FB.COPY/RENAME.COMMAND 75232 . 76155) (
|
||||
FB.COPY/RENAME.ONE 76157 . 78479) (FB.COPY/RENAME.MANY 78481 . 84701) (FB.MERGE.DIRECTORIES 84703 .
|
||||
85121) (FB.GREATEST.PREFIX 85123 . 86479) (FB.MAYBE.INSERT.FILE 86481 . 93921) (FB.GET.NEW.FILE.SPEC
|
||||
93923 . 97754) (FB.CANONICAL.DIRECTORY 97756 . 98853)) (98856 106640 (FB.HARDCOPYCOMMAND 98866 . 99996
|
||||
) (FB.HARDCOPY.TOFILE 99998 . 106638)) (106641 116850 (FB.EDITCOMMAND 106651 . 107518) (
|
||||
FB.EDITCOMMAND.ONEFILE 107520 . 110934) (FB.EDITLISPFILE 110936 . 112041) (FB.BROWSECOMMAND 112043 .
|
||||
116848)) (116851 128571 (FB.FASTSEECOMMAND 116861 . 120311) (FB.FASTSEE.ONEFILE 120313 . 123269) (
|
||||
FB.SEEFULLFN 123271 . 127402) (FB.SEEBUTTONFN 127404 . 128569)) (128572 130318 (FB.LOADCOMMAND 128582
|
||||
. 129089) (FB.COMPILECOMMAND 129091 . 129629) (FB.OPERATE.ON.FILES 129631 . 130316)) (130319 178504 (
|
||||
FB.UPDATECOMMAND 130329 . 130554) (FB.FIX-DIRECTORY-DATES 130556 . 131579) (FB.MAYBE.EXPUNGE 131581 .
|
||||
132642) (FB.UPDATEBROWSERITEMS 132644 . 145859) (FB.DATE 145861 . 146502) (FB.ADJUST.DATE.WIDTH 146504
|
||||
. 149472) (FB.SET.BROWSER.TITLE 149474 . 150476) (FB.MAYBE.WIDEN.NAMES 150478 . 152597) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 152599 . 153963) (FB.CREATE.FILEBUCKET 153965 . 161185) (
|
||||
FB.CHECK.NAME.LENGTH 161187 . 163608) (FB.ADD.FILEGROUP 163610 . 165137) (FB.INSERT.DIRECTORY 165139
|
||||
. 165377) (FB.MAKE.SUBDIRECTORY.ITEM 165379 . 166788) (FB.ADD.FILE 166790 . 167403) (FB.INSERT.FILE
|
||||
167405 . 170817) (FB.ANALYZE.PATTERN 170819 . 176083) (FB.CANONICALIZE.PATTERN 176085 . 177397) (
|
||||
FB.GETALLFILEINFO 177399 . 178502)) (178505 186664 (FB.SORT.VERSIONS 178515 . 181286) (
|
||||
FB.DECREASING.VERSION 181288 . 181957) (FB.INCREASING.VERSION 181959 . 182580) (
|
||||
FB.NAMES.DECREASING.VERSION 182582 . 183617) (FB.NAMES.INCREASING.VERSION 183619 . 184616) (
|
||||
FB.DECREASING.NUMERIC.ATTR 184618 . 185298) (FB.INCREASING.NUMERIC.ATTR 185300 . 185974) (
|
||||
FB.ALPHABETIC.ATTR 185976 . 186662)) (186665 196507 (FB.SORTCOMMAND 186675 . 193505) (
|
||||
FB.INSERT.SUBDIRECTORIES 193507 . 194304) (FB.GET.SORT.MENU 194306 . 196505)) (196508 212729 (
|
||||
FB.EXPUNGECOMMAND 196518 . 199103) (FB.NEWPATTERNCOMMAND 199105 . 199503) (FB.NEWINFOCOMMAND 199505 .
|
||||
202337) (FB.DEPTHCOMMAND 202339 . 204114) (FB.SHAPECOMMAND 204116 . 207458) (FB.REMOVE.FILE 207460 .
|
||||
209281) (FB.COUNT.FILE.CHANGE 209283 . 210728) (FB.SETNEWPATTERN 210730 . 211900) (FB.GET.NEWPATTERN
|
||||
211902 . 212486) (FB.OPTIONSCOMMAND 212488 . 212727)) (212764 213817 (FB.GETWINDOW 212774 . 213815)) (
|
||||
213818 214830 (FB.INFOMENU.SHADEINITIALSELECTIONS 213828 . 214475) (FB.INFO.ITEM.NAMED 214477 . 214828
|
||||
)) (214831 224363 (FB.MAKECOUNTERWINDOW 214841 . 216369) (FB.COUNTERW.REDISPLAYFN 216371 . 216958) (
|
||||
FB.UPDATE.COUNTERS 216960 . 219032) (FB.DISPLAY.COUNTERS 219034 . 224094) (FB.COUNTER.STRING 224096 .
|
||||
224361)) (224364 229073 (FB.MAKEHEADINGWINDOW 224374 . 225988) (FB.HEADINGW.REDISPLAYFN 225990 .
|
||||
226256) (FB.HEADINGW.RESHAPEFN 226258 . 226634) (FB.HEADINGW.DISPLAY 226636 . 229071)) (229074 233257
|
||||
(FB.ICONFN 229084 . 229431) (FB.INFOMENU.WHENSELECTEDFN 229433 . 230163) (FB.CLOSEFN 230165 . 231368)
|
||||
(FB.EXPUNGE?.MENU 231370 . 231782) (FB.AFTERCLOSEFN 231784 . 232145) (FB.CLOSE&EXPUNGE 232147 . 233255
|
||||
)) (233258 245316 (FB.HARDCOPY.DIRECTORY 233268 . 243625) (FB.HARDCOPY.PRINT.TITLE 243627 . 243953) (
|
||||
FB.HARDCOPY.MAXWIDTH 243955 . 245314)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
312
library/IMAGEOBJ
312
library/IMAGEOBJ
@@ -1,137 +1,69 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Dec-95 13:21:56" {DSK}<MEDLEY>LIBRARY/IMAGEOBJ.;1 35602
|
||||
(FILECREATED " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4 34381
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GET.OBJ.FROM.USER)
|
||||
|
||||
changes to%: (FNS BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN)
|
||||
|
||||
|
||||
|
||||
previous date%: " 6-Dec-95 15:18:32" {DSK}<MEDLEY>LIBRARY/IMAGEOBJ.;1)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* ; "
|
||||
|
||||
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
")
|
||||
|
||||
:PREVIOUS-DATE " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IMAGEOBJCOMS)
|
||||
|
||||
|
||||
|
||||
(RPAQQ IMAGEOBJCOMS
|
||||
|
||||
((COMS
|
||||
|
||||
(* ;; "Bit-map image objects")
|
||||
|
||||
|
||||
(* ;; "Bit-map image objects")
|
||||
|
||||
(FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT \PRINTBINARYBITMAP \READBINARYBITMAP
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "fns for the bitmap tedit object.")
|
||||
|
||||
|
||||
(* ;; "fns for the bitmap tedit object.")
|
||||
|
||||
(FNS BMOBJ.BUTTONEVENTINFN BMOBJ.COPYFN BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN BMOBJ.PUTFN
|
||||
|
||||
BMOBJ.INIT BMOBJ.GETFN5 BMOBJ.CREATE.MENU)
|
||||
|
||||
(INITVARS (*SMALLSCREEN* (ILESSP SCREENWIDTH 700))
|
||||
|
||||
(*SMALLSCREENFACTOR* 0.5))
|
||||
|
||||
(FNS SCALED.BITMAP.GETFN BMOBJ.GETFN BMOBJ.GETFN2 BMOBJ.GETFN3 BMOBJ.GETFN4)
|
||||
|
||||
(* ;
|
||||
|
||||
"GETFNs for backward compatibility with older objects.")
|
||||
|
||||
(* ;
|
||||
"GETFNs for backward compatibility with older objects.")
|
||||
(RECORDS BITMAPOBJ)
|
||||
|
||||
[INITVARS (DEFAULT.BITMAP.SCALE '(0.75 (DISPLAY 1]
|
||||
|
||||
|
||||
|
||||
(* ;; "make ^O be a character that inserts an object read from the user.")
|
||||
|
||||
|
||||
(* ;; "make ^O be a character that inserts an object read from the user.")
|
||||
|
||||
(GLOBALVARS (BITMAP.OBJ.MENU))
|
||||
|
||||
(ADDVARS (BackgroundCopyMenuCommands (SNAP (FUNCTION (BITMAPOBJ.SNAPW))
|
||||
|
||||
|
||||
|
||||
"prompts for an area of the screen to insert."
|
||||
|
||||
)
|
||||
|
||||
("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5))
|
||||
|
||||
|
||||
|
||||
"prompts for an area of the screen to insert, scaled down by 50%%."
|
||||
|
||||
)
|
||||
|
||||
("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T))
|
||||
|
||||
|
||||
|
||||
"prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50."
|
||||
|
||||
)
|
||||
|
||||
("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*))
|
||||
|
||||
"Inserts *INSERT-BITMAP* in a document"))
|
||||
|
||||
(IMAGEOBJGETFNS (BMOBJ.GETFN))
|
||||
|
||||
(IMAGEOBJGETFNS (BMOBJ.GETFN2))
|
||||
|
||||
(IMAGEOBJGETFNS (BMOBJ.GETFN3))
|
||||
|
||||
(IMAGEOBJGETFNS (BMOBJ.GETFN4))
|
||||
|
||||
(IMAGEOBJGETFNS (BMOBJ.GETFN5))
|
||||
|
||||
(IMAGEOBJGETFNS (SCALED.BITMAP.GETFN)))
|
||||
|
||||
(VARS (BackgroundCopyMenu))
|
||||
|
||||
(FNS GET.OBJ.FROM.USER BITMAPOBJ.SNAPW PROMPTFOREVALED)
|
||||
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (BMOBJ.INIT)))
|
||||
|
||||
(FILES EDITBITMAP))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Bit-map image objects")
|
||||
|
||||
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
|
||||
|
||||
(BITMAPTEDITOBJ
|
||||
[LAMBDA (BITMAP SCALEFACTOR ROTATION DESCENT) (* ; "Edited 13-Aug-93 17:17 by rmk:")
|
||||
(* ; "Edited 6-Jan-89 16:34 by jds")
|
||||
@@ -146,8 +78,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
BMOBJDESCENT _ (OR DESCENT 0))
|
||||
BITMAPIMAGEFNS])
|
||||
|
||||
|
||||
|
||||
(COERCETOBITMAP
|
||||
[LAMBDA (BMSPEC) (* ; "Edited 11-Jun-90 16:28 by mitani")
|
||||
(* tries to interpret X as a spec
|
||||
@@ -182,16 +112,12 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(fetch (REGION HEIGHT) of CR))
|
||||
BM])
|
||||
|
||||
|
||||
|
||||
(WINDOWTITLEFONT
|
||||
(LAMBDA (FONT) (* rrb " 1-Feb-84 15:26")
|
||||
(* reset type of function that changes
|
||||
the title font)
|
||||
(DSPFONT FONT WindowTitleDisplayStream)))
|
||||
|
||||
|
||||
|
||||
(\PRINTBINARYBITMAP
|
||||
(LAMBDA (BITMAP STREAM) (* rrb "23-Jul-84 15:16")
|
||||
|
||||
@@ -211,8 +137,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
BMH BYTESPERWORD))
|
||||
(RETURN BITMAP))))
|
||||
|
||||
|
||||
|
||||
(\READBINARYBITMAP
|
||||
(LAMBDA (STREAM) (* rrb "23-Jul-84 15:17")
|
||||
|
||||
@@ -229,23 +153,14 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP)
|
||||
BMH BYTESPERWORD))
|
||||
(RETURN BITMAP))))
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "fns for the bitmap tedit object.")
|
||||
|
||||
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
|
||||
|
||||
(BMOBJ.BUTTONEVENTINFN
|
||||
[LAMBDA (IMAGEOBJ WINDOW SELECTION X Y SELWINDOW TEXTSTREAM BUTTON OPERATION)
|
||||
(* ; "Edited 14-Aug-93 19:44 by rmk:")
|
||||
@@ -315,8 +230,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
"And clear any cached shrunk bitmaps so the display looks reasonable.")
|
||||
(RETURN 'CHANGED])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.COPYFN
|
||||
[LAMBDA (IMAGEOBJ) (* ; "Edited 13-Aug-93 17:13 by rmk:")
|
||||
(* ; "Edited 6-Jan-89 16:19 by jds")
|
||||
@@ -329,8 +242,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(FETCH (BITMAPOBJ BMOBJROTATION) OF BMOBJ)
|
||||
(FETCH (BITMAPOBJ BMOBJDESCENT) OF BMOBJ])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.DISPLAYFN
|
||||
|
||||
[LAMBDA (IMAGEOBJ IMAGE.STREAM) (* ; "Edited 7-Dec-95 13:20 by ")
|
||||
@@ -449,8 +360,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
|
||||
'REPLACE NIL NIL FACTOR])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.IMAGEBOXFN
|
||||
|
||||
[LAMBDA (IMAGEOBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN) (* ; "Edited 7-Dec-95 13:20 by ")
|
||||
@@ -537,8 +446,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
|
||||
XKERN _ 0])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.PUTFN
|
||||
[LAMBDA (BMOBJ STREAM) (* ; "Edited 13-Aug-93 15:41 by rmk:")
|
||||
(* ; "Edited 11-Jan-89 17:00 by jds")
|
||||
@@ -558,8 +465,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
STREAM FILERDTBL)
|
||||
(SPACES 1 STREAM])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.INIT
|
||||
[LAMBDA NIL (* ; "Edited 13-Aug-93 14:27 by rmk:")
|
||||
(* ; "Edited 11-Jan-89 17:01 by jds")
|
||||
@@ -581,8 +486,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.GETFN5
|
||||
[LAMBDA (INPUT.STREAM TEXTSTREAM) (* ; "Edited 13-Aug-93 15:40 by rmk:")
|
||||
(* jds "30-Oct-85 11:29")
|
||||
@@ -592,8 +495,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(READ INPUT.STREAM FILERDTBL)
|
||||
(READ INPUT.STREAM FILERDTBL])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.CREATE.MENU
|
||||
[LAMBDA NIL (* ; "Edited 30-Jul-87 19:19 by jds")
|
||||
|
||||
@@ -628,21 +529,13 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
MENUOFFSET _ (create POSITION
|
||||
XCOORD _ -1
|
||||
YCOORD _ 0])
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(RPAQ? *SMALLSCREEN* (ILESSP SCREENWIDTH 700))
|
||||
|
||||
|
||||
|
||||
(RPAQ? *SMALLSCREENFACTOR* 0.5)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
|
||||
|
||||
(SCALED.BITMAP.GETFN
|
||||
(LAMBDA (INPUT.STREAM TEXTSTREAM) (* jds "30-Oct-85 11:29")
|
||||
|
||||
@@ -654,8 +547,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(RETURN (BITMAPTEDITOBJ BITMAP (FQUOTIENT 1.0 FACTOR)
|
||||
0)))))
|
||||
|
||||
|
||||
|
||||
(BMOBJ.GETFN
|
||||
(LAMBDA (STREAM) (* rrb "17-Jul-84 11:46")
|
||||
|
||||
@@ -669,8 +560,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(RETURN (BITMAPTEDITOBJ BITMAP (CAR FIELDS)
|
||||
(CADR FIELDS)))))))
|
||||
|
||||
|
||||
|
||||
(BMOBJ.GETFN2
|
||||
(LAMBDA (STREAM) (* rrb "17-Jul-84 11:29")
|
||||
|
||||
@@ -683,8 +572,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
|
||||
SCALE ROT)))))
|
||||
|
||||
|
||||
|
||||
(BMOBJ.GETFN3
|
||||
[LAMBDA (STREAM) (* ; "Edited 11-Jan-89 17:03 by jds")
|
||||
|
||||
@@ -702,8 +589,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
|
||||
SCALE 0 DESC])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.GETFN4
|
||||
[LAMBDA (STREAM) (* ; "Edited 6-Jan-89 16:33 by jds")
|
||||
|
||||
@@ -731,162 +616,91 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
|
||||
(BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
|
||||
SCALE ROT DESCENT])
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* ; "GETFNs for backward compatibility with older objects.")
|
||||
|
||||
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
|
||||
|
||||
(RECORD BITMAPOBJ (
|
||||
(* ;; "Describes a bitmap imageobj")
|
||||
|
||||
(* ;; "Describes a bitmap imageobj")
|
||||
|
||||
|
||||
|
||||
BITMAP (* ; "The bitmap itself")
|
||||
|
||||
BMOBJSCALEFACTOR (* ;
|
||||
|
||||
"The factor to scale it by when displaying")
|
||||
|
||||
BMOBJROTATION (* ;
|
||||
|
||||
"A rotation to apply when displaying")
|
||||
|
||||
BMOBJDESCENT (* ;
|
||||
|
||||
"How far below the base line to display it. NIL => 0.")
|
||||
|
||||
))
|
||||
|
||||
BITMAP (* ; "The bitmap itself")
|
||||
BMOBJSCALEFACTOR (* ;
|
||||
"The factor to scale it by when displaying")
|
||||
BMOBJROTATION (* ;
|
||||
"A rotation to apply when displaying")
|
||||
BMOBJDESCENT (* ;
|
||||
"How far below the base line to display it. NIL => 0.")
|
||||
))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(RPAQ? DEFAULT.BITMAP.SCALE '(0.75 (DISPLAY 1)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "make ^O be a character that inserts an object read from the user.")
|
||||
|
||||
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
|
||||
|
||||
(GLOBALVARS (BITMAP.OBJ.MENU))
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR BackgroundCopyMenuCommands
|
||||
|
||||
(SNAP (FUNCTION (BITMAPOBJ.SNAPW))
|
||||
|
||||
"prompts for an area of the screen to insert.")
|
||||
|
||||
("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5))
|
||||
|
||||
"prompts for an area of the screen to insert, scaled down by 50%%.")
|
||||
|
||||
("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T))
|
||||
|
||||
"prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50.")
|
||||
|
||||
("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*))
|
||||
|
||||
"Inserts *INSERT-BITMAP* in a document"))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN2))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN3))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN4))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN5))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (SCALED.BITMAP.GETFN))
|
||||
|
||||
|
||||
|
||||
(RPAQQ BackgroundCopyMenu NIL)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
|
||||
|
||||
(GET.OBJ.FROM.USER
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 26-Apr-91 10:54 by jds")
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 7-Dec-2024 19:44 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 21:04 by rmk")
|
||||
(* ; "Edited 26-Apr-91 10:54 by jds")
|
||||
|
||||
(* ;; "reads an expression from the user and puts the result into the textstream.")
|
||||
(* ;; "reads an expression from the user and puts the result into the textstream at the current position of its caret.")
|
||||
|
||||
(ERSETQ (PROG ((VAL (PROMPTFOREVALED "Form to eval:"))
|
||||
(SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
BM)
|
||||
(CL:TYPECASE VAL
|
||||
(STRINGP (* ;
|
||||
"Atoms and strings get inserted as text.")
|
||||
(AND VAL (TEDIT.INSERT TEXTSTREAM VAL SEL)))
|
||||
(LITATOM (* ;
|
||||
"Atoms and strings get inserted as text.")
|
||||
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)
|
||||
SEL)))
|
||||
(IMAGEOBJ (* ; "IMAGEOBJs get inserted as is")
|
||||
(TEDIT.INSERT.OBJECT VAL TEXTSTREAM (SELECTQ (fetch POINT of SEL)
|
||||
(LEFT (fetch (SELECTION CH#)
|
||||
of SEL))
|
||||
(RIGHT (fetch (SELECTION CHLIM)
|
||||
of SEL))
|
||||
NIL)))
|
||||
(T (COND
|
||||
((SETQ BM (COERCETOBITMAP VAL))
|
||||
(ERSETQ (LET ((VAL (PROMPTFOREVALED "Form to eval:"))
|
||||
BM)
|
||||
(CL:WHEN VAL
|
||||
(CL:TYPECASE VAL
|
||||
(STRINGP (* ;
|
||||
"Atoms and strings get inserted as text.")
|
||||
(TEDIT.INSERT TEXTSTREAM VAL))
|
||||
(LITATOM (* ;
|
||||
"Atoms and strings get inserted as text.")
|
||||
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T))))
|
||||
(IMAGEOBJ (* ; "IMAGEOBJs get inserted as is")
|
||||
(TEDIT.INSERT.OBJECT VAL TEXTSTREAM))
|
||||
(T [COND
|
||||
((SETQ BM (COERCETOBITMAP VAL))
|
||||
(* ;
|
||||
"If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject")
|
||||
(TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ BM 1 0)
|
||||
TEXTSTREAM
|
||||
(SELECTQ (fetch POINT of SEL)
|
||||
(LEFT (fetch (SELECTION CH#) of SEL))
|
||||
(RIGHT (fetch (SELECTION CHLIM) of SEL))
|
||||
NIL)))
|
||||
(T (* ;
|
||||
"Not a bitmap, nor one of the special cases above; complain")
|
||||
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)
|
||||
SEL)) (* ;
|
||||
"(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT 'Not implemented to have ' VAL ' in documents yet.') T)")
|
||||
))))])
|
||||
|
||||
|
||||
"If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject")
|
||||
(TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ BM 1 0)
|
||||
TEXTSTREAM))
|
||||
(T (* ;
|
||||
"Not a bitmap, nor one of the special cases above; see what happens")
|
||||
(TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T])))])
|
||||
|
||||
(BITMAPOBJ.SNAPW
|
||||
[LAMBDA (SCALE SAVE) (* ; "Edited 14-Aug-93 19:54 by rmk:")
|
||||
@@ -911,8 +725,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
0]
|
||||
(RETURN])
|
||||
|
||||
|
||||
|
||||
(PROMPTFOREVALED
|
||||
(LAMBDA (MSG WHERE FONT MINWIDTH MINHEIGHT) (* jds "26-Sep-85 16:46")
|
||||
|
||||
@@ -950,42 +762,20 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
'>)))))
|
||||
(CLOSEW WIN)
|
||||
(RETURN NEWVALUE))))
|
||||
|
||||
)
|
||||
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
|
||||
|
||||
(BMOBJ.INIT)
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(FILESLOAD EDITBITMAP)
|
||||
|
||||
(PUTPROPS IMAGEOBJ COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1993
|
||||
|
||||
1995))
|
||||
|
||||
(DECLARE%: DONTCOPY
|
||||
|
||||
(FILEMAP (NIL (3164 7671 (BITMAPTEDITOBJ 3176 . 3819) (COERCETOBITMAP 3823 . 5867) (WINDOWTITLEFONT
|
||||
|
||||
5871 . 6218) (\PRINTBINARYBITMAP 6222 . 7013) (\READBINARYBITMAP 7017 . 7668)) (7728 23863 (
|
||||
|
||||
BMOBJ.BUTTONEVENTINFN 7740 . 12286) (BMOBJ.COPYFN 12290 . 12916) (BMOBJ.DISPLAYFN 12920 . 16649) (
|
||||
|
||||
BMOBJ.IMAGEBOXFN 16653 . 19068) (BMOBJ.PUTFN 19072 . 20004) (BMOBJ.INIT 20008 . 21047) (BMOBJ.GETFN5
|
||||
|
||||
21051 . 21641) (BMOBJ.CREATE.MENU 21645 . 23860)) (23958 27253 (SCALED.BITMAP.GETFN 23970 . 24396) (
|
||||
|
||||
BMOBJ.GETFN 24400 . 24935) (BMOBJ.GETFN2 24939 . 25424) (BMOBJ.GETFN3 25428 . 26216) (BMOBJ.GETFN4
|
||||
|
||||
26220 . 27250)) (29245 35381 (GET.OBJ.FROM.USER 29257 . 32020) (BITMAPOBJ.SNAPW 32024 . 33150) (
|
||||
|
||||
PROMPTFOREVALED 33154 . 35378)))))
|
||||
|
||||
(FILEMAP (NIL (2975 7471 (BITMAPTEDITOBJ 2985 . 3628) (COERCETOBITMAP 3630 . 5674) (WINDOWTITLEFONT
|
||||
5676 . 6023) (\PRINTBINARYBITMAP 6025 . 6816) (\READBINARYBITMAP 6818 . 7469)) (7522 23640 (
|
||||
BMOBJ.BUTTONEVENTINFN 7532 . 12078) (BMOBJ.COPYFN 12080 . 12706) (BMOBJ.DISPLAYFN 12708 . 16437) (
|
||||
BMOBJ.IMAGEBOXFN 16439 . 18854) (BMOBJ.PUTFN 18856 . 19788) (BMOBJ.INIT 19790 . 20829) (BMOBJ.GETFN5
|
||||
20831 . 21421) (BMOBJ.CREATE.MENU 21423 . 23638)) (23730 27014 (SCALED.BITMAP.GETFN 23740 . 24166) (
|
||||
BMOBJ.GETFN 24168 . 24703) (BMOBJ.GETFN2 24705 . 25190) (BMOBJ.GETFN3 25192 . 25980) (BMOBJ.GETFN4
|
||||
25982 . 27012)) (28949 34281 (GET.OBJ.FROM.USER 28959 . 30925) (BITMAPOBJ.SNAPW 30927 . 32053) (
|
||||
PROMPTFOREVALED 32055 . 34279)))))
|
||||
STOP
|
||||
|
||||
|
||||
Binary file not shown.
@@ -1,22 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "13-Jun-2021 09:05:17"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;6 196680
|
||||
|
||||
changes to%: (FNS MSINTERPRETSET)
|
||||
(FILECREATED "14-Jul-2024 08:42:20" {WMEDLEY}<library>MASTERSCOPE.;28 197707
|
||||
|
||||
previous date%: " 9-Jun-2021 23:55:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;5)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MSOUTPUT)
|
||||
|
||||
:PREVIOUS-DATE " 5-Jul-2024 11:54:48" {WMEDLEY}<library>MASTERSCOPE.;27)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT MASTERSCOPECOMS)
|
||||
|
||||
(RPAQQ MASTERSCOPECOMS
|
||||
[
|
||||
(* ;; "Main file for MASTERSCOPE.")
|
||||
(* ;; "Main file for MASTERSCOPE.")
|
||||
|
||||
(FILES MSPARSE MSANALYZE)
|
||||
(PROP FILETYPE MASTERSCOPE)
|
||||
@@ -28,13 +25,13 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
[COMS (FNS MSFIND MSEDITF MSEDITE EDITGETDEF)
|
||||
(VARS MSBLIP)
|
||||
|
||||
(* ;; "List of (FILEPKGTYPE FILEPKGTYPE GETDEF-fn MARKASCHANGED-fn) for types that Masterscope knows how to analyze. LOOPSMS, for example, adds LOOPS constructs to this lists using MSADDANALYZE.")
|
||||
(* ;; "List of (FILEPKGTYPE FILEPKGTYPE GETDEF-fn MARKASCHANGED-fn) for types that Masterscope knows how to analyze. LOOPSMS, for example, adds LOOPS constructs to this lists using MSADDANALYZE.")
|
||||
|
||||
[INITVARS (MSFNTYPES '((FNS FNS GETDEF]
|
||||
(COMS (* ; "SCRATCHASH")
|
||||
(COMS (* ; "SCRATCHASH")
|
||||
(INITVARS (MSCRATCHASH))
|
||||
(DECLARE%: DONTCOPY (MACROS SCRATCHASH]
|
||||
(COMS (* ; "marking changed")
|
||||
(COMS (* ; "marking changed")
|
||||
(FNS MSMARKCHANGED CHANGEMACRO CHANGEVAR CHANGEI.S. CHANGERECORD MSNEEDUNSAVE UNSAVEFNS
|
||||
)
|
||||
(ADDVARS (COMPILE.TIME.CONSTANTS))
|
||||
@@ -42,11 +39,11 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(INITVARS (CHECKUNSAVEFLG T)
|
||||
(MSNEEDUNSAVE)))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS GETWORDTYPE))
|
||||
(COMS (* ; "interactive routines")
|
||||
(COMS (* ; "interactive routines")
|
||||
[VARS * (LIST (LIST 'MASTERSCOPEDATE (DATE (DATEFORMAT NO.TIME]
|
||||
(ADDVARS (HISTORYCOMS %.))
|
||||
(FNS %. MASTERSCOPE MASTERSCOPE1 MASTERSCOPEXEC)
|
||||
(* ; "Interpreting commands")
|
||||
(* ; "Interpreting commands")
|
||||
(FNS MSINTERPRETSET MSINTERPA MSGETBLOCKDEC LISTHARD MSMEMBSET MSLISTSET MSHASHLIST
|
||||
MSHASHLIST1 CHECKPATHS ONFILE)
|
||||
(FNS MSINTERPRET VERBNOTICELIST MSOUTPUT MSCHECKEMPTY CHECKFORCHANGED MSSOLVE)
|
||||
@@ -186,9 +183,9 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
MSFILELST])
|
||||
|
||||
(MSSHOWUSE
|
||||
[LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS)
|
||||
(* ;
|
||||
"Edited 23-Jun-93 09:40 by sybalsky:mv:envos")
|
||||
[LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS) (* ; "Edited 4-Jul-2024 15:06 by rmk")
|
||||
(* ;
|
||||
"Edited 23-Jun-93 09:40 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "Show/Edit where SHOWFN uses/etc. a pattern.")
|
||||
|
||||
@@ -196,7 +193,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(COND
|
||||
([OR [CL:MULTIPLE-VALUE-SETQ (DEF REALDEF)
|
||||
(MSGETDEF SHOWFN (AND (fetch (MSSETPHRASE KNOWN) of SHOWSET)
|
||||
(fetch (MSSETPHRASE TYPE) of SHOWSET))
|
||||
(fetch (MSSETPHRASE TYPE) of SHOWSET))
|
||||
(COND
|
||||
((EQ SHOWEDIT 'SHOW)
|
||||
'?)
|
||||
@@ -208,43 +205,45 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(FILE (LOADFNS SHOWFN FILE 'PROP)
|
||||
(GETPROP SHOWFN 'EXPR]
|
||||
(* ;
|
||||
"was (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW)))")
|
||||
"was (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW)))")
|
||||
(* ;
|
||||
"The SHOW command does not need to save")
|
||||
(MSUPDATEFN1 SHOWFN DEF
|
||||
(LIST SHOWTYPE [FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
|
||||
(COND
|
||||
((MSMEMBSET ITEM SS)
|
||||
(COND
|
||||
((NOT ANYFOUND)
|
||||
(TAB 0 0 T)
|
||||
(PRIN2 SHOWFN)
|
||||
(PRIN1 " :
|
||||
"The SHOW command does not need to save")
|
||||
(MSUPDATEFN1 SHOWFN DEF (LIST SHOWTYPE
|
||||
[FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
|
||||
(COND
|
||||
((MSMEMBSET ITEM SS)
|
||||
(COND
|
||||
((NOT ANYFOUND)
|
||||
(TAB 0 0 T)
|
||||
(DSPFONT (PROG1 (DSPFONT BOLDFONT)
|
||||
(PRIN2 SHOWFN)))
|
||||
(PRIN1 " :
|
||||
")))
|
||||
(SETQ ANYFOUND
|
||||
(CONS (CONS PRNT (AND INCLISP
|
||||
(NOT (MSFIND INCLISP
|
||||
PRNT))
|
||||
INCLISP))
|
||||
ANYFOUND))
|
||||
(COND
|
||||
([AND (EQ SE 'SHOW)
|
||||
(NOT (FASSOC PRNT (CDR ANYFOUND]
|
||||
(SETQ ANYFOUND
|
||||
(CONS (CONS PRNT
|
||||
(AND INCLISP
|
||||
(NOT (MSFIND INCLISP
|
||||
PRNT))
|
||||
INCLISP))
|
||||
ANYFOUND))
|
||||
(COND
|
||||
([AND (EQ SE 'SHOW)
|
||||
(NOT (FASSOC PRNT (CDR ANYFOUND]
|
||||
|
||||
(* ;; "The EDIT command works by collecting a list of the expressions, and then doing a (*ORF* (= . lst1) (= . lst2)) --- if within a CLISP translation (determined by the binding of the INCLISP variable) then want to point at the CLISP if the expression is not actually embedded in the expression")
|
||||
|
||||
(SPACES 3)
|
||||
(LVLPRINT PRNT (OUTPUT)
|
||||
2)
|
||||
(COND
|
||||
((CDAR ANYFOUND)
|
||||
(SPACES 3)
|
||||
(LVLPRINT PRNT (OUTPUT)
|
||||
2)
|
||||
(COND
|
||||
((CDAR ANYFOUND)
|
||||
(* ; "This is under a clisp")
|
||||
(PRIN1 " {under ")
|
||||
(LVLPRIN2 INCLISP (OUTPUT)
|
||||
2)
|
||||
(PRIN1 "}
|
||||
(PRIN1 " {under ")
|
||||
(LVLPRIN2 INCLISP (OUTPUT)
|
||||
2)
|
||||
(PRIN1 "}
|
||||
"]
|
||||
SHOWSET SHOWEDIT)))
|
||||
SHOWSET SHOWEDIT)))
|
||||
(T (printout T "Can't find a definition for " SHOWFN "!" T)
|
||||
(RETURN)))
|
||||
(COND
|
||||
@@ -2403,14 +2402,14 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS SCRATCHASH MACRO [(ARRAYNAME . FORMS)
|
||||
([LAMBDA (ARRAYNAME)
|
||||
(SETQ MSCRATCHASH)
|
||||
(PROG1 (PROGN . FORMS)
|
||||
(SETQ MSCRATCHASH ARRAYNAME]
|
||||
(COND
|
||||
(MSCRATCHASH (CLRHASH MSCRATCHASH)
|
||||
MSCRATCHASH)
|
||||
(T (HASHARRAY 20 (FUNCTION MSREHASH])
|
||||
([LAMBDA (ARRAYNAME)
|
||||
(SETQ MSCRATCHASH)
|
||||
(PROG1 (PROGN . FORMS)
|
||||
(SETQ MSCRATCHASH ARRAYNAME]
|
||||
(COND
|
||||
(MSCRATCHASH (CLRHASH MSCRATCHASH)
|
||||
MSCRATCHASH)
|
||||
(T (HASHARRAY 20 (FUNCTION MSREHASH])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2569,7 +2568,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS GETWORDTYPE MACRO [(WORD TYPE)
|
||||
(CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
|
||||
(CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2578,7 +2577,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(* ; "interactive routines")
|
||||
|
||||
|
||||
(RPAQ MASTERSCOPEDATE "13-Jun-2021")
|
||||
(RPAQ MASTERSCOPEDATE "14-Jul-2024")
|
||||
|
||||
(ADDTOVAR HISTORYCOMS %.)
|
||||
(DEFINEQ
|
||||
@@ -3527,8 +3526,31 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(ERROR!])
|
||||
|
||||
(MSOUTPUT
|
||||
(LAMBDA (FILE) (* ; "Edited 12-Jun-90 20:43 by teruuchi") (* ;; "OUTPUT is already RESETSAVE'd") (COND ((OPENP FILE (QUOTE OUTPUT)) (OUTPUT FILE)) (T (OUTFILE FILE) (SETQ FILE (OUTPUT)) (RESETSAVE NIL (LIST (QUOTE CLOSEF) FILE)))) (* ;; "output to file, reset LINELENGTH") (LINELENGTH FILELINELENGTH))
|
||||
)
|
||||
[LAMBDA (FILE) (* ; "Edited 14-Jul-2024 08:41 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 11:54 by rmk")
|
||||
(* ; "Edited 12-Jun-90 20:43 by teruuchi")
|
||||
(LET ((LLENGTH FILELINELENGTH))
|
||||
[COND
|
||||
((AND (LITATOM FILE)
|
||||
(MEMB (U-CASE FILE)
|
||||
'(TEDIT :TEDIT))
|
||||
(GETD (FUNCTION TEDIT)))
|
||||
|
||||
(* ;; "If no TEDIT, leave the current OUTPUT")
|
||||
|
||||
[SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
|
||||
,DEFAULTFONT]
|
||||
(SETQ LLENGTH T)
|
||||
(TEDIT.DEFER.UPDATES FILE '(READONLY QUIET))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE)))
|
||||
((OPENP FILE 'OUTPUT))
|
||||
(T (SETQ FILE (OPENSTREAM FILE 'OUTPUT))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE]
|
||||
|
||||
(* ;; "Reset LINELENGTH, output to file. OUTPUT is already RESETSAVE'd.")
|
||||
|
||||
(LINELENGTH LLENGTH FILE)
|
||||
(OUTPUT FILE])
|
||||
|
||||
(MSCHECKEMPTY
|
||||
[LAMBDA NIL (* lmm "20-JAN-79 14:08")
|
||||
@@ -3621,15 +3643,15 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD GETHASH (ID HTABLE . BADMARKS)
|
||||
ID _ 'GETHASH)
|
||||
ID _ 'GETHASH)
|
||||
|
||||
(RECORD INRELATION (ID (INVERTED . HTABLES) . OSET)
|
||||
ID _ 'INRELATION)
|
||||
ID _ 'INRELATION)
|
||||
|
||||
(ASSOCRECORD PATHOPTIONS (TO FROM AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH
|
||||
MARKING) (* CHECKPATHS assumes that this is
|
||||
an ASSOCRECORD)
|
||||
)
|
||||
(ASSOCRECORD PATHOPTIONS (TO FROM AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH MARKING)
|
||||
(* CHECKPATHS assumes that this is an
|
||||
ASSOCRECORD)
|
||||
)
|
||||
|
||||
(RECORD MSANALYZABLE (FILEPKGNAME SETNAME GETDEF-FN MARKCHANGED-FN))
|
||||
)
|
||||
@@ -3726,39 +3748,37 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
|
||||
(ADDTOVAR LAMA MSEDITE MSEDITF)
|
||||
)
|
||||
(PUTPROPS MASTERSCOPE COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993
|
||||
1994 2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3419 19188 (UPDATEFN 3429 . 5046) (MSGETDEF 5048 . 6454) (MSNOTICEFILE 6456 . 8849) (
|
||||
MSSHOWUSE 8851 . 14354) (MSUPDATEFN1 14356 . 15044) (MSUPDATE 15046 . 17472) (MSNLAMBDACHECK 17474 .
|
||||
18356) (MSCOLLECTDATA 18358 . 19186)) (19189 20088 (UPDATECHANGED 19199 . 19562) (UPDATECHANGED1 19564
|
||||
. 20086)) (20662 21085 (MSCLOSEFILES 20672 . 21083)) (21766 26198 (MSDESCRIBE 21776 . 24564) (
|
||||
MSDESCRIBE1 24566 . 25629) (FMAPRINT 25631 . 26196)) (26291 26731 (MSPRINTHELPFILE 26301 . 26729)) (
|
||||
26781 29919 (TEMPLATE 26791 . 28212) (GETTEMPLATE 28214 . 28349) (SETTEMPLATE 28351 . 29917)) (30789
|
||||
35713 (ADDTEMPLATEWORD 30799 . 31471) (MSADDANALYZE 31473 . 32971) (MSADDMODIFIER 32973 . 34054) (
|
||||
MSADDRELATION 34056 . 34803) (MSADDTYPE 34805 . 35711)) (37214 42435 (MSMARKCHANGE1 37224 . 38018) (
|
||||
MSINIT 38020 . 39201) (GETVERBTABLES 39203 . 39756) (MSSTOREDATA 39758 . 41437) (STORETABLE 41439 .
|
||||
42433)) (43836 48906 (PARSERELATION 43846 . 44446) (PARSERELATION1 44448 . 45903) (GETRELATION 45905
|
||||
. 46934) (MAPRELATION 46936 . 48070) (TESTRELATION 48072 . 48904)) (48907 50547 (ADDHASH 48917 .
|
||||
49395) (SUBHASH 49397 . 49625) (MAKEHASH 49627 . 49771) (MSREHASH 49773 . 50226) (EQMEMBHASH 50228 .
|
||||
50545)) (50886 57101 (MSVBTABLES 50896 . 56675) (MSUSERVBTABLES 56677 . 57099)) (57184 59395 (
|
||||
BUILDGETRELQ 57194 . 58300) (BUILDTESTRELQ 58302 . 59393)) (59566 59954 (MSERASE 59576 . 59952)) (
|
||||
59955 64415 (DUMPDATABASE 59965 . 62530) (DUMPDATABASE1 62532 . 62877) (READATABASE 62879 . 64413)) (
|
||||
65497 94556 (MSCHECKBLOCKS 65507 . 69327) (MSCHECKBLOCK 69329 . 77949) (MSCHECKFNINBLOCK 77951 . 80951
|
||||
) (MSCHECKBLOCKBASIC 80953 . 83373) (MSCHECKBOUNDFREE 83375 . 85274) (GLOBALVARP 85276 . 85443) (
|
||||
PRINTERROR 85445 . 88661) (MSCHECKVARS1 88663 . 91616) (UNECCSPEC 91618 . 91896) (NECCSPEC 91898 .
|
||||
92245) (SPECVARP 92247 . 92774) (SHORTLST 92776 . 93232) (DOERROR 93234 . 93944) (MSMSGPRINT 93946 .
|
||||
94554)) (95700 110528 (MSPATHS 95710 . 99112) (MSPATHS1 99114 . 103349) (MSPATHS2 103351 . 106761) (
|
||||
MSONPATH 106763 . 107991) (MSPATHS4 107993 . 109075) (DASHES 109077 . 109603) (DOTABS 109605 . 109846)
|
||||
(BELOWMARKER 109848 . 110311) (MSPATHSPRINTFN 110313 . 110526)) (110914 114338 (MSFIND 110924 .
|
||||
111199) (MSEDITF 111201 . 112201) (MSEDITE 112203 . 113240) (EDITGETDEF 113242 . 114336)) (115344
|
||||
123945 (MSMARKCHANGED 115354 . 117078) (CHANGEMACRO 117080 . 117785) (CHANGEVAR 117787 . 118103) (
|
||||
CHANGEI.S. 118105 . 119438) (CHANGERECORD 119440 . 120311) (MSNEEDUNSAVE 120313 . 121305) (UNSAVEFNS
|
||||
121307 . 123943)) (124386 127876 (%. 124396 . 124536) (MASTERSCOPE 124538 . 125064) (MASTERSCOPE1
|
||||
125066 . 125934) (MASTERSCOPEXEC 125936 . 127874)) (127915 167565 (MSINTERPRETSET 127925 . 156459) (
|
||||
MSINTERPA 156461 . 156995) (MSGETBLOCKDEC 156997 . 159510) (LISTHARD 159512 . 160730) (MSMEMBSET
|
||||
160732 . 160877) (MSLISTSET 160879 . 161244) (MSHASHLIST 161246 . 161413) (MSHASHLIST1 161415 . 161741
|
||||
) (CHECKPATHS 161743 . 162383) (ONFILE 162385 . 167563)) (167566 190732 (MSINTERPRET 167576 . 184429)
|
||||
(VERBNOTICELIST 184431 . 185541) (MSOUTPUT 185543 . 185860) (MSCHECKEMPTY 185862 . 187066) (
|
||||
CHECKFORCHANGED 187068 . 187588) (MSSOLVE 187590 . 190730)))))
|
||||
(FILEMAP (NIL (3260 19507 (UPDATEFN 3270 . 4887) (MSGETDEF 4889 . 6295) (MSNOTICEFILE 6297 . 8690) (
|
||||
MSSHOWUSE 8692 . 14673) (MSUPDATEFN1 14675 . 15363) (MSUPDATE 15365 . 17791) (MSNLAMBDACHECK 17793 .
|
||||
18675) (MSCOLLECTDATA 18677 . 19505)) (19508 20407 (UPDATECHANGED 19518 . 19881) (UPDATECHANGED1 19883
|
||||
. 20405)) (20981 21404 (MSCLOSEFILES 20991 . 21402)) (22085 26517 (MSDESCRIBE 22095 . 24883) (
|
||||
MSDESCRIBE1 24885 . 25948) (FMAPRINT 25950 . 26515)) (26610 27050 (MSPRINTHELPFILE 26620 . 27048)) (
|
||||
27100 30238 (TEMPLATE 27110 . 28531) (GETTEMPLATE 28533 . 28668) (SETTEMPLATE 28670 . 30236)) (31108
|
||||
36032 (ADDTEMPLATEWORD 31118 . 31790) (MSADDANALYZE 31792 . 33290) (MSADDMODIFIER 33292 . 34373) (
|
||||
MSADDRELATION 34375 . 35122) (MSADDTYPE 35124 . 36030)) (37533 42754 (MSMARKCHANGE1 37543 . 38337) (
|
||||
MSINIT 38339 . 39520) (GETVERBTABLES 39522 . 40075) (MSSTOREDATA 40077 . 41756) (STORETABLE 41758 .
|
||||
42752)) (44155 49225 (PARSERELATION 44165 . 44765) (PARSERELATION1 44767 . 46222) (GETRELATION 46224
|
||||
. 47253) (MAPRELATION 47255 . 48389) (TESTRELATION 48391 . 49223)) (49226 50866 (ADDHASH 49236 .
|
||||
49714) (SUBHASH 49716 . 49944) (MAKEHASH 49946 . 50090) (MSREHASH 50092 . 50545) (EQMEMBHASH 50547 .
|
||||
50864)) (51205 57420 (MSVBTABLES 51215 . 56994) (MSUSERVBTABLES 56996 . 57418)) (57503 59714 (
|
||||
BUILDGETRELQ 57513 . 58619) (BUILDTESTRELQ 58621 . 59712)) (59885 60273 (MSERASE 59895 . 60271)) (
|
||||
60274 64734 (DUMPDATABASE 60284 . 62849) (DUMPDATABASE1 62851 . 63196) (READATABASE 63198 . 64732)) (
|
||||
65816 94875 (MSCHECKBLOCKS 65826 . 69646) (MSCHECKBLOCK 69648 . 78268) (MSCHECKFNINBLOCK 78270 . 81270
|
||||
) (MSCHECKBLOCKBASIC 81272 . 83692) (MSCHECKBOUNDFREE 83694 . 85593) (GLOBALVARP 85595 . 85762) (
|
||||
PRINTERROR 85764 . 88980) (MSCHECKVARS1 88982 . 91935) (UNECCSPEC 91937 . 92215) (NECCSPEC 92217 .
|
||||
92564) (SPECVARP 92566 . 93093) (SHORTLST 93095 . 93551) (DOERROR 93553 . 94263) (MSMSGPRINT 94265 .
|
||||
94873)) (96019 110847 (MSPATHS 96029 . 99431) (MSPATHS1 99433 . 103668) (MSPATHS2 103670 . 107080) (
|
||||
MSONPATH 107082 . 108310) (MSPATHS4 108312 . 109394) (DASHES 109396 . 109922) (DOTABS 109924 . 110165)
|
||||
(BELOWMARKER 110167 . 110630) (MSPATHSPRINTFN 110632 . 110845)) (111233 114657 (MSFIND 111243 .
|
||||
111518) (MSEDITF 111520 . 112520) (MSEDITE 112522 . 113559) (EDITGETDEF 113561 . 114655)) (115599
|
||||
124200 (MSMARKCHANGED 115609 . 117333) (CHANGEMACRO 117335 . 118040) (CHANGEVAR 118042 . 118358) (
|
||||
CHANGEI.S. 118360 . 119693) (CHANGERECORD 119695 . 120566) (MSNEEDUNSAVE 120568 . 121560) (UNSAVEFNS
|
||||
121562 . 124198)) (124633 128123 (%. 124643 . 124783) (MASTERSCOPE 124785 . 125311) (MASTERSCOPE1
|
||||
125313 . 126181) (MASTERSCOPEXEC 126183 . 128121)) (128162 167812 (MSINTERPRETSET 128172 . 156706) (
|
||||
MSINTERPA 156708 . 157242) (MSGETBLOCKDEC 157244 . 159757) (LISTHARD 159759 . 160977) (MSMEMBSET
|
||||
160979 . 161124) (MSLISTSET 161126 . 161491) (MSHASHLIST 161493 . 161660) (MSHASHLIST1 161662 . 161988
|
||||
) (CHECKPATHS 161990 . 162630) (ONFILE 162632 . 167810)) (167813 191885 (MSINTERPRET 167823 . 184676)
|
||||
(VERBNOTICELIST 184678 . 185788) (MSOUTPUT 185790 . 187013) (MSCHECKEMPTY 187015 . 188219) (
|
||||
CHECKFORCHANGED 188221 . 188741) (MSSOLVE 188743 . 191883)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56 14033
|
||||
(FILECREATED "25-Dec-2024 14:26:23" {WMEDLEY}<library>PDFSTREAM.;60 14292
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS PDFSTREAMCOMS)
|
||||
:CHANGES-TO (FNS SEE-PDF)
|
||||
|
||||
:PREVIOUS-DATE " 9-Oct-2023 00:42:25" {WMEDLEY}<library>PDFSTREAM.;55)
|
||||
:PREVIOUS-DATE "10-Dec-2024 14:36:59" {WMEDLEY}<library>PDFSTREAM.;59)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PDFSTREAMCOMS)
|
||||
@@ -30,6 +30,7 @@
|
||||
(FONTCREATE POSTSCRIPT.FONTCREATE)
|
||||
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
|
||||
(CREATECHARSET \CREATECHARSET.PSC]
|
||||
(ALISTS (DEFAULTFILETYPELIST PDF))
|
||||
(VARS (DEFAULTPRINTERTYPE 'PDF))
|
||||
(FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT)
|
||||
(P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]
|
||||
@@ -73,6 +74,8 @@
|
||||
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
|
||||
(CREATECHARSET \CREATECHARSET.PSC)))
|
||||
|
||||
(ADDTOVAR DEFAULTFILETYPELIST (PDF . BINARY))
|
||||
|
||||
(RPAQQ DEFAULTPRINTERTYPE PDF)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -262,12 +265,14 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SEE-PDF
|
||||
[LAMBDA (PDFFILE) (* ; "Edited 1-Oct-2023 20:47 by rmk")
|
||||
[LAMBDA (PDFFILE) (* ; "Edited 25-Dec-2024 14:25 by rmk")
|
||||
(* ; "Edited 1-Oct-2023 20:47 by rmk")
|
||||
(* ; "Edited 26-Sep-2023 16:52 by rmk")
|
||||
|
||||
(* ;; "Use the ShellOpener for this machine to open the PDF file outside of Medley")
|
||||
|
||||
(ShellOpen (PACKFILENAME 'BODY PDFFILE 'EXTENSION 'PDF])
|
||||
(ShellOpen (OR (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF))
|
||||
(ERROR "FILE NOT FOUND" PDFFILE])
|
||||
)
|
||||
|
||||
(ADDTOVAR FB.SEE.METHODS (PDFFILEP SEE-PDF))
|
||||
@@ -280,8 +285,8 @@
|
||||
thereis (ShellWhich (CAR TEMPLATE])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3162 5776 (PDFFILEP 3172 . 4086) (PDF.HARDCOPYW 4088 . 4686) (PDF.TEXT 4688 . 5405) (
|
||||
PDF.TEDIT 5407 . 5774)) (6216 13276 (OPEN-PDF-STREAM 6226 . 8362) (CLOSE-PDF-STREAM 8364 . 9651) (
|
||||
PS-TO-PDF 9653 . 13274)) (13277 13675 (SEE-PDF 13287 . 13673)) (13726 14010 (PDFCONVERTER 13736 .
|
||||
14008)))))
|
||||
(FILEMAP (NIL (3255 5869 (PDFFILEP 3265 . 4179) (PDF.HARDCOPYW 4181 . 4779) (PDF.TEXT 4781 . 5498) (
|
||||
PDF.TEDIT 5500 . 5867)) (6309 13369 (OPEN-PDF-STREAM 6319 . 8455) (CLOSE-PDF-STREAM 8457 . 9744) (
|
||||
PS-TO-PDF 9746 . 13367)) (13370 13934 (SEE-PDF 13380 . 13932)) (13985 14269 (PDFCONVERTER 13995 .
|
||||
14267)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12 258100
|
||||
(FILECREATED "10-Dec-2024 15:16:36" {WMEDLEY}<library>POSTSCRIPTSTREAM.;15 258118
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS POSTSCRIPTFILEP)
|
||||
:CHANGES-TO (VARS POSTSCRIPTSTREAMCOMS)
|
||||
|
||||
:PREVIOUS-DATE "21-Jun-2021 20:29:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;11)
|
||||
:PREVIOUS-DATE "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
|
||||
@@ -18,11 +18,11 @@
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM))
|
||||
(INITRECORDS \POSTSCRIPTDATA)
|
||||
(FNS POSTSCRIPT.INIT)
|
||||
(ADDVARS (DEFAULTFILETYPELIST (PS . TEXT)
|
||||
(PSC . TEXT)
|
||||
(ADDVARS (DEFAULTFILETYPELIST (PS . BINARY)
|
||||
(PSC . BINARY)
|
||||
(PSF . BINARY)
|
||||
(PSCFONT . BINARY)
|
||||
(POSTSCRIPT . TEXT))
|
||||
(POSTSCRIPT . BINARY))
|
||||
(*DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB)
|
||||
(AVANTGARDE-DEMI . AD)
|
||||
(BECKMAN . BM)
|
||||
@@ -483,11 +483,11 @@
|
||||
(\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*])
|
||||
)
|
||||
|
||||
(ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT)
|
||||
(PSC . TEXT)
|
||||
(ADDTOVAR DEFAULTFILETYPELIST (PS . BINARY)
|
||||
(PSC . BINARY)
|
||||
(PSF . BINARY)
|
||||
(PSCFONT . BINARY)
|
||||
(POSTSCRIPT . TEXT))
|
||||
(POSTSCRIPT . BINARY))
|
||||
|
||||
(ADDTOVAR *DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB)
|
||||
(AVANTGARDE-DEMI . AD)
|
||||
@@ -4383,38 +4383,38 @@
|
||||
(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22199 29303 (POSTSCRIPT.INIT 22209 . 29301)) (30283 65067 (PSCFONT.READFONT 30293 .
|
||||
32201) (PSCFONT.SPELLFILE 32203 . 32781) (PSCFONT.COERCEFILE 32783 . 34355) (
|
||||
PSCFONTFROMCACHE.SPELLFILE 34357 . 35342) (PSCFONTFROMCACHE.COERCEFILE 35344 . 36996) (
|
||||
PSCFONT.WRITEFONT 36998 . 38013) (READ-AFM-FILE 38015 . 43886) (CONVERT-AFM-FILES 43888 . 45100) (
|
||||
POSTSCRIPT.GETFONTID 45102 . 46497) (POSTSCRIPT.FONTCREATE 46499 . 58898) (
|
||||
\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58900 . 61297) (POSTSCRIPT.FONTSAVAILABLE 61299 . 65065)) (65622
|
||||
74768 (OPENPOSTSCRIPTSTREAM 65632 . 74434) (CLOSEPOSTSCRIPTSTREAM 74436 . 74766)) (74813 81105 (
|
||||
POSTSCRIPT.HARDCOPYW 74823 . 78172) (POSTSCRIPT.TEDIT 78174 . 78654) (POSTSCRIPT.TEXT 78656 . 78947) (
|
||||
POSTSCRIPTFILEP 78949 . 80056) (MAKEEPSFILE 80058 . 81103)) (81106 125992 (POSTSCRIPT.BITMAPSCALE
|
||||
81116 . 83572) (POSTSCRIPT.CLOSESTRING 83574 . 84108) (POSTSCRIPT.ENDPAGE 84110 . 84981) (
|
||||
POSTSCRIPT.OUTSTR 84983 . 86004) (POSTSCRIPT.PUTBITMAPBYTES 86006 . 94477) (POSTSCRIPT.PUTCOMMAND
|
||||
94479 . 95528) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95530 . 100978) (POSTSCRIPT.SHOWACCUM 100980 . 103218) (
|
||||
POSTSCRIPT.STARTPAGE 103220 . 105799) (\POSTSCRIPTTAB 105801 . 106672) (\PS.BOUTFIXP 106674 . 108024)
|
||||
(\PS.SCALEHACK 108026 . 110855) (\PS.SCALEREGION 110857 . 111417) (\SCALEDBITBLT.PSC 111419 . 115719)
|
||||
(\SETPOS.PSC 115721 . 116183) (\SETXFORM.PSC 116185 . 118004) (\STRINGWIDTH.PSC 118006 . 118460) (
|
||||
\SWITCHFONTS.PSC 118462 . 124619) (\TERPRI.PSC 124621 . 125990)) (126027 181747 (\BITBLT.PSC 126037 .
|
||||
126590) (\BLTSHADE.PSC 126592 . 130874) (\CHARWIDTH.PSC 130876 . 131643) (\CREATECHARSET.PSC 131645 .
|
||||
133343) (\DRAWARC.PSC 133345 . 135825) (\DRAWCIRCLE.PSC 135827 . 138236) (\DRAWCURVE.PSC 138238 .
|
||||
142259) (\DRAWELLIPSE.PSC 142261 . 144738) (\DRAWLINE.PSC 144740 . 147090) (\DRAWPOINT.PSC 147092 .
|
||||
147680) (\DRAWPOLYGON.PSC 147682 . 150796) (\DSPBOTTOMMARGIN.PSC 150798 . 151363) (
|
||||
\DSPCLIPPINGREGION.PSC 151365 . 152808) (\DSPCOLOR.PSC 152810 . 153651) (\DSPFONT.PSC 153653 . 157863)
|
||||
(\DSPLEFTMARGIN.PSC 157865 . 158434) (\DSPLINEFEED.PSC 158436 . 159012) (\DSPPUSHSTATE.PSC 159014 .
|
||||
160777) (\DSPPOPSTATE.PSC 160779 . 163288) (\DSPRESET.PSC 163290 . 163936) (\DSPRIGHTMARGIN.PSC 163938
|
||||
. 164510) (\DSPROTATE.PSC 164512 . 165535) (\DSPSCALE.PSC 165537 . 166468) (\DSPSCALE2.PSC 166470 .
|
||||
167289) (\DSPSPACEFACTOR.PSC 167291 . 168263) (\DSPTOPMARGIN.PSC 168265 . 168982) (\DSPTRANSLATE.PSC
|
||||
168984 . 171558) (\DSPXPOSITION.PSC 171560 . 172159) (\DSPYPOSITION.PSC 172161 . 172733) (
|
||||
\FILLCIRCLE.PSC 172735 . 175381) (\FILLPOLYGON.PSC 175383 . 179299) (\FIXLINELENGTH.PSC 179301 .
|
||||
180795) (\MOVETO.PSC 180797 . 181548) (\NEWPAGE.PSC 181550 . 181745)) (181803 204955 (
|
||||
\POSTSCRIPT.CHANGECHARSET 181813 . 182617) (\POSTSCRIPT.OUTCHARFN 182619 . 195476) (
|
||||
\POSTSCRIPT.PRINTSLUG 195478 . 197445) (\POSTSCRIPT.SPECIALOUTCHARFN 197447 . 199879) (\UPDATE.PSC
|
||||
199881 . 201104) (\POSTSCRIPT.ACCENTFN 201106 . 202048) (\POSTSCRIPT.ACCENTPAIR 202050 . 204953)) (
|
||||
205053 206698 (\PSC.SPACEDISP 205063 . 205342) (\PSC.SPACEWID 205344 . 205963) (\PSC.SYMBOLS 205965 .
|
||||
206696)) (206807 209798 (\POSTSCRIPT.NSHASH 206817 . 209796)) (254273 254987 (POSTSCRIPTSEND 254283 .
|
||||
254985)))))
|
||||
(FILEMAP (NIL (22211 29315 (POSTSCRIPT.INIT 22221 . 29313)) (30301 65085 (PSCFONT.READFONT 30311 .
|
||||
32219) (PSCFONT.SPELLFILE 32221 . 32799) (PSCFONT.COERCEFILE 32801 . 34373) (
|
||||
PSCFONTFROMCACHE.SPELLFILE 34375 . 35360) (PSCFONTFROMCACHE.COERCEFILE 35362 . 37014) (
|
||||
PSCFONT.WRITEFONT 37016 . 38031) (READ-AFM-FILE 38033 . 43904) (CONVERT-AFM-FILES 43906 . 45118) (
|
||||
POSTSCRIPT.GETFONTID 45120 . 46515) (POSTSCRIPT.FONTCREATE 46517 . 58916) (
|
||||
\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58918 . 61315) (POSTSCRIPT.FONTSAVAILABLE 61317 . 65083)) (65640
|
||||
74786 (OPENPOSTSCRIPTSTREAM 65650 . 74452) (CLOSEPOSTSCRIPTSTREAM 74454 . 74784)) (74831 81123 (
|
||||
POSTSCRIPT.HARDCOPYW 74841 . 78190) (POSTSCRIPT.TEDIT 78192 . 78672) (POSTSCRIPT.TEXT 78674 . 78965) (
|
||||
POSTSCRIPTFILEP 78967 . 80074) (MAKEEPSFILE 80076 . 81121)) (81124 126010 (POSTSCRIPT.BITMAPSCALE
|
||||
81134 . 83590) (POSTSCRIPT.CLOSESTRING 83592 . 84126) (POSTSCRIPT.ENDPAGE 84128 . 84999) (
|
||||
POSTSCRIPT.OUTSTR 85001 . 86022) (POSTSCRIPT.PUTBITMAPBYTES 86024 . 94495) (POSTSCRIPT.PUTCOMMAND
|
||||
94497 . 95546) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95548 . 100996) (POSTSCRIPT.SHOWACCUM 100998 . 103236) (
|
||||
POSTSCRIPT.STARTPAGE 103238 . 105817) (\POSTSCRIPTTAB 105819 . 106690) (\PS.BOUTFIXP 106692 . 108042)
|
||||
(\PS.SCALEHACK 108044 . 110873) (\PS.SCALEREGION 110875 . 111435) (\SCALEDBITBLT.PSC 111437 . 115737)
|
||||
(\SETPOS.PSC 115739 . 116201) (\SETXFORM.PSC 116203 . 118022) (\STRINGWIDTH.PSC 118024 . 118478) (
|
||||
\SWITCHFONTS.PSC 118480 . 124637) (\TERPRI.PSC 124639 . 126008)) (126045 181765 (\BITBLT.PSC 126055 .
|
||||
126608) (\BLTSHADE.PSC 126610 . 130892) (\CHARWIDTH.PSC 130894 . 131661) (\CREATECHARSET.PSC 131663 .
|
||||
133361) (\DRAWARC.PSC 133363 . 135843) (\DRAWCIRCLE.PSC 135845 . 138254) (\DRAWCURVE.PSC 138256 .
|
||||
142277) (\DRAWELLIPSE.PSC 142279 . 144756) (\DRAWLINE.PSC 144758 . 147108) (\DRAWPOINT.PSC 147110 .
|
||||
147698) (\DRAWPOLYGON.PSC 147700 . 150814) (\DSPBOTTOMMARGIN.PSC 150816 . 151381) (
|
||||
\DSPCLIPPINGREGION.PSC 151383 . 152826) (\DSPCOLOR.PSC 152828 . 153669) (\DSPFONT.PSC 153671 . 157881)
|
||||
(\DSPLEFTMARGIN.PSC 157883 . 158452) (\DSPLINEFEED.PSC 158454 . 159030) (\DSPPUSHSTATE.PSC 159032 .
|
||||
160795) (\DSPPOPSTATE.PSC 160797 . 163306) (\DSPRESET.PSC 163308 . 163954) (\DSPRIGHTMARGIN.PSC 163956
|
||||
. 164528) (\DSPROTATE.PSC 164530 . 165553) (\DSPSCALE.PSC 165555 . 166486) (\DSPSCALE2.PSC 166488 .
|
||||
167307) (\DSPSPACEFACTOR.PSC 167309 . 168281) (\DSPTOPMARGIN.PSC 168283 . 169000) (\DSPTRANSLATE.PSC
|
||||
169002 . 171576) (\DSPXPOSITION.PSC 171578 . 172177) (\DSPYPOSITION.PSC 172179 . 172751) (
|
||||
\FILLCIRCLE.PSC 172753 . 175399) (\FILLPOLYGON.PSC 175401 . 179317) (\FIXLINELENGTH.PSC 179319 .
|
||||
180813) (\MOVETO.PSC 180815 . 181566) (\NEWPAGE.PSC 181568 . 181763)) (181821 204973 (
|
||||
\POSTSCRIPT.CHANGECHARSET 181831 . 182635) (\POSTSCRIPT.OUTCHARFN 182637 . 195494) (
|
||||
\POSTSCRIPT.PRINTSLUG 195496 . 197463) (\POSTSCRIPT.SPECIALOUTCHARFN 197465 . 199897) (\UPDATE.PSC
|
||||
199899 . 201122) (\POSTSCRIPT.ACCENTFN 201124 . 202066) (\POSTSCRIPT.ACCENTPAIR 202068 . 204971)) (
|
||||
205071 206716 (\PSC.SPACEDISP 205081 . 205360) (\PSC.SPACEWID 205362 . 205981) (\PSC.SYMBOLS 205983 .
|
||||
206714)) (206825 209816 (\POSTSCRIPT.NSHASH 206835 . 209814)) (254291 255005 (POSTSCRIPTSEND 254301 .
|
||||
255003)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Nov-2023 10:53:30" {WMEDLEY}<lispusers>PSEUDOHOSTS.;160 26843
|
||||
(FILECREATED "31-Dec-2024 11:45:23" {WMEDLEY}<library>PSEUDOHOSTS.;177 29713
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS PSEUDOHOST)
|
||||
:CHANGES-TO (FNS TRUEDEVICE)
|
||||
|
||||
:PREVIOUS-DATE " 1-Oct-2023 20:16:43" {WMEDLEY}<lispusers>PSEUDOHOSTS.;159)
|
||||
:PREVIOUS-DATE "25-Dec-2024 07:38:10" {WMEDLEY}<library>PSEUDOHOSTS.;176)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
|
||||
@@ -15,16 +15,17 @@
|
||||
(
|
||||
(* ;; "Public entries")
|
||||
|
||||
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME PSEUDOFILENAME)
|
||||
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEDEVICE TRUEFILENAME PSEUDOFILENAME)
|
||||
|
||||
(* ;; "Internals")
|
||||
|
||||
(FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH)
|
||||
(FNS CDPSEUDO)
|
||||
(FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH
|
||||
OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH
|
||||
SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH)
|
||||
(P (PSEUDOHOST 'LI LOGINHOST/DIR)
|
||||
(MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (PSEUDOHOST 'LI LOGINHOST/DIR)))
|
||||
(P (MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
|
||||
(MOVD 'GETHOSTINFO.PH 'GETHOSTINFO))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE)
|
||||
(MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)
|
||||
@@ -136,9 +137,14 @@
|
||||
HOST])
|
||||
|
||||
(PSEUDOHOSTP
|
||||
[LAMBDA (HOST) (* ; "Edited 24-Feb-2022 23:51 by rmk")
|
||||
[LAMBDA (HOST) (* ; "Edited 16-Dec-2024 21:15 by rmk")
|
||||
(* ; "Edited 24-Feb-2022 23:51 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 11:29 by rmk")
|
||||
(LET ((DEV (\GETDEVICEFROMNAME HOST T T)))
|
||||
(LET [(DEV (if (type? FDEV HOST)
|
||||
then HOST
|
||||
elseif (type? STREAM HOST)
|
||||
then (fetch (STREAM DEVICE) of HOST)
|
||||
else (\GETDEVICEFROMNAME HOST T T]
|
||||
(CL:WHEN (AND DEV (type? FDEV (fetch (PHDEVICE TARGETDEV) OF DEV)))
|
||||
(LIST (FETCH (FDEV DEVICENAME) OF DEV)
|
||||
(FETCH (PHDEVICE PREFIX)
|
||||
@@ -151,9 +157,30 @@
|
||||
(FETCH (PHDEVICE PREFIX) OF DEV])
|
||||
|
||||
(TARGETHOST
|
||||
[LAMBDA (HOST) (* ; "Edited 22-Jan-2022 09:00 by rmk")
|
||||
(CL:WHEN (PSEUDOHOSTP HOST)
|
||||
(FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))])
|
||||
[LAMBDA (HOST) (* ; "Edited 14-Dec-2024 15:26 by rmk")
|
||||
(* ; "Edited 12-Dec-2024 16:16 by rmk")
|
||||
(* ; "Edited 22-Jan-2022 09:00 by rmk")
|
||||
(if (STREAMP HOST)
|
||||
then (CL:WHEN (type? FDEV (fetch (PHDEVICE TARGETDEV) of (fetch (STREAM DEVICE) of HOST)))
|
||||
(fetch (FDEV DEVICENAME) of (fetch (PHDEVICE TARGETDEV) of (fetch (STREAM DEVICE)
|
||||
of HOST))))
|
||||
elseif (PSEUDOHOSTP HOST)
|
||||
then (fetch (FDEV DEVICENAME) of (fetch (PHDEVICE TARGETDEV) of (\GETDEVICEFROMNAME HOST T T])
|
||||
|
||||
(TRUEDEVICE
|
||||
[LAMBDA (X) (* ; "Edited 31-Dec-2024 11:44 by rmk")
|
||||
(* ; "Edited 25-Dec-2024 07:37 by rmk")
|
||||
(* ; "Edited 23-Dec-2024 22:56 by rmk")
|
||||
(* ; "Edited 16-Dec-2024 17:36 by rmk")
|
||||
(* ; "Edited 12-Dec-2024 14:34 by rmk")
|
||||
(LET [(DEV (if (type? FDEV X)
|
||||
then X
|
||||
elseif (STREAMP X)
|
||||
then (fetch (STREAM DEVICE) of X)
|
||||
else (\GETDEVICEFROMNAME X]
|
||||
(if (type? FDEV (fetch (PHDEVICE TARGETDEV) of DEV))
|
||||
then (fetch (PHDEVICE TARGETDEV) of DEV)
|
||||
else DEV])
|
||||
|
||||
(TRUEFILENAME
|
||||
[LAMBDA (FILE) (* ; "Edited 1-Oct-2023 20:16 by rmk")
|
||||
@@ -301,6 +328,24 @@
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(CDPSEUDO
|
||||
[LAMBDA (PHOST CDSUFFIX FILEPKG) (* ; "Edited 21-Dec-2024 13:48 by rmk")
|
||||
(* ; "Edited 6-Feb-2024 15:50 by rmk")
|
||||
|
||||
(* ;; "Makes a cd command for PHOST. The command name is %"cd%" followed by the lower-case letters of CDSUFFIX (e.g. cdf for PHOST FOO and CDSUFFIX %"f%".")
|
||||
|
||||
(CL:WHEN (AND (SETQ PHOST (CAR (PSEUDOHOSTP PHOST)))
|
||||
CDSUFFIX)
|
||||
[LET ((C (PACK* "cd" (L-CASE CDSUFFIX)))
|
||||
(FILEPKGFLG FILEPKG))
|
||||
(DECLARE (SPECVARS FILEPKGFLG))
|
||||
(SETQ PHOST (CONCAT "{" PHOST "}"))
|
||||
(EVAL `(DEFCOMMAND ,C (SUBDIR) (/CNDIR (CL:IF SUBDIR
|
||||
(CONCAT ,PHOST "/" SUBDIR)
|
||||
,PHOST)))])])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(OPENFILE.PH
|
||||
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
|
||||
|
||||
@@ -453,8 +498,10 @@
|
||||
(SETQ RESULT (CONTRACT.PH RESULT NEW-DEVICE)))
|
||||
RESULT])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(PSEUDOHOST 'LI LOGINHOST/DIR)
|
||||
)
|
||||
|
||||
(MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
|
||||
|
||||
@@ -515,12 +562,13 @@
|
||||
EXPORTS.ALL)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1254 10126 (PSEUDOHOST 1264 . 6972) (PSEUDOHOSTP 6974 . 7487) (PSEUDOHOSTS 7489 . 7850)
|
||||
(TARGETHOST 7852 . 8126) (TRUEFILENAME 8128 . 9253) (PSEUDOFILENAME 9255 . 10124)) (10154 16169 (
|
||||
EXPAND.PH 10164 . 11417) (CONTRACT.PH 11419 . 14130) (UNSLASHIT 14132 . 15878) (GETHOSTINFO.PH 15880
|
||||
. 16167)) (16170 24190 (OPENFILE.PH 16180 . 17253) (GETFILENAME.PH 17255 . 17544) (DIRECTORYNAMEP.PH
|
||||
17546 . 18170) (CLOSEFILE.PH 18172 . 18639) (REOPENFILE.PH 18641 . 19206) (DELETEFILE.PH 19208 . 19492
|
||||
) (OPENP.PH 19494 . 19789) (UNREGISTERFILE.PH 19791 . 20333) (REGISTERFILE.PH 20335 . 20869) (
|
||||
GENERATEFILES.PH 20871 . 21915) (GETFILEINFO.PH 21917 . 22219) (SETFILEINFO.PH 22221 . 22420) (
|
||||
NEXTFILEFN.PH 22422 . 22968) (FILEINFOFN.PH 22970 . 23245) (RENAMEFILE.PH 23247 . 24188)))))
|
||||
(FILEMAP (NIL (1318 12059 (PSEUDOHOST 1328 . 7036) (PSEUDOHOSTP 7038 . 7867) (PSEUDOHOSTS 7869 . 8230)
|
||||
(TARGETHOST 8232 . 9101) (TRUEDEVICE 9103 . 10059) (TRUEFILENAME 10061 . 11186) (PSEUDOFILENAME 11188
|
||||
. 12057)) (12087 18102 (EXPAND.PH 12097 . 13350) (CONTRACT.PH 13352 . 16063) (UNSLASHIT 16065 . 17811
|
||||
) (GETHOSTINFO.PH 17813 . 18100)) (18103 19004 (CDPSEUDO 18113 . 19002)) (19005 27025 (OPENFILE.PH
|
||||
19015 . 20088) (GETFILENAME.PH 20090 . 20379) (DIRECTORYNAMEP.PH 20381 . 21005) (CLOSEFILE.PH 21007 .
|
||||
21474) (REOPENFILE.PH 21476 . 22041) (DELETEFILE.PH 22043 . 22327) (OPENP.PH 22329 . 22624) (
|
||||
UNREGISTERFILE.PH 22626 . 23168) (REGISTERFILE.PH 23170 . 23704) (GENERATEFILES.PH 23706 . 24750) (
|
||||
GETFILEINFO.PH 24752 . 25054) (SETFILEINFO.PH 25056 . 25255) (NEXTFILEFN.PH 25257 . 25803) (
|
||||
FILEINFOFN.PH 25805 . 26080) (RENAMEFILE.PH 26082 . 27023)))))
|
||||
STOP
|
||||
Binary file not shown.
953
library/UNICODE
953
library/UNICODE
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
2244
library/tedit/TEDIT
2244
library/tedit/TEDIT
File diff suppressed because it is too large
Load Diff
@@ -1,71 +1,69 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Mar-2024 18:15:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;8 9500
|
||||
(FILECREATED "31-Oct-2024 17:53:21" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;9 10946
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 12:06:12"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;7)
|
||||
:PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;8)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
||||
|
||||
(RPAQQ TEDIT-ABBREVCOMS
|
||||
[(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
(INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE])
|
||||
(RPAQQ TEDIT-ABBREVCOMS [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
(INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE])
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.ABBREV.EXPAND
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 31-Oct-2024 17:50 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
(* ; "Edited 17-May-2023 13:31 by rmk")
|
||||
(* ; "Edited 8-Sep-2022 23:53 by rmk")
|
||||
(* ; "Edited 1-Aug-2022 12:04 by rmk")
|
||||
@@ -74,7 +72,7 @@
|
||||
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))
|
||||
SEL CH# CH OLDLOOKS EXPANSION)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(SETQ CH# (SUB1 (TEDIT.GETPOINT NIL SEL)))
|
||||
(SETQ CH# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
[COND
|
||||
((ZEROP (GETSEL SEL DCH)) (* ;
|
||||
"Point Selection, so use the character to the left")
|
||||
@@ -158,54 +156,53 @@
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.ABBREVS
|
||||
'(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
|
||||
(RPAQ? TEDIT.ABBREVS '(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2994 8156 (\TEDIT.ABBREV.EXPAND 3004 . 5371) (\TEDIT.EXPAND.DATE 5373 . 6006) (
|
||||
\TEDIT.TRY.ABBREV 6008 . 8154)))))
|
||||
(FILEMAP (NIL (3704 8979 (\TEDIT.ABBREV.EXPAND 3714 . 6194) (\TEDIT.EXPAND.DATE 6196 . 6829) (
|
||||
\TEDIT.TRY.ABBREV 6831 . 8977)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1995
library/tedit/TEDIT-BUTTONS
Normal file
1995
library/tedit/TEDIT-BUTTONS
Normal file
File diff suppressed because it is too large
Load Diff
BIN
library/tedit/TEDIT-BUTTONS.LCOM
Normal file
BIN
library/tedit/TEDIT-BUTTONS.LCOM
Normal file
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Dec-2023 09:24:21" {WMEDLEY}<library>TEDIT>TEDIT-CHAT.;14 12223
|
||||
(FILECREATED "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16 12363
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-CHATCOMS)
|
||||
(FNS TEDITSTREAM.INIT TEDIT.DISPLAYTEXT TEDITCHAT.CHARFN)
|
||||
:CHANGES-TO (FNS TEDITCHAT.CHARFN)
|
||||
|
||||
:PREVIOUS-DATE " 6-Apr-2023 21:40:07" {WMEDLEY}<library>tedit>TEDIT-CHAT.;9)
|
||||
:PREVIOUS-DATE " 2-May-2024 18:09:26" {WMEDLEY}<library>tedit>TEDIT-CHAT.;15)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-CHATCOMS)
|
||||
@@ -71,16 +70,18 @@
|
||||
(replace (CHAT.STATE HELD) of STATE with NIL])
|
||||
|
||||
(TEDITCHAT.CHARFN
|
||||
[LAMBDA (CH CHAT.STATE) (* ; "Edited 22-Dec-2023 23:57 by rmk")
|
||||
[LAMBDA (CH CHAT.STATE) (* ; "Edited 24-Jun-2024 00:04 by rmk")
|
||||
(* ; "Edited 2-May-2024 18:09 by rmk")
|
||||
(* ; "Edited 22-Dec-2023 23:57 by rmk")
|
||||
(* ; "Edited 18-Mar-2023 20:08 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:00 by mitani")
|
||||
(LET [(TEXTOBJ (TEXTOBJ (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE]
|
||||
(\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
|
||||
(SELCHARQ CH
|
||||
(BS (\TEDIT.CHARDELETE TEXTOBJ (FGETTOBJ TEXTOBJ SEL)))
|
||||
(LF NIL)
|
||||
(BOUT (FGETTOBJ TEXTOBJ STREAMHINT)
|
||||
CH])
|
||||
(LET* ((TSTREAM (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE))
|
||||
(TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
|
||||
(SELCHARQ CH
|
||||
(BS (\TEDIT.CHARDELETE TSTREAM (FGETTOBJ TEXTOBJ SEL)))
|
||||
(LF NIL)
|
||||
(BOUT TSTREAM CH])
|
||||
)
|
||||
|
||||
|
||||
@@ -212,6 +213,6 @@
|
||||
CHATDECLS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (960 4404 (TEDITSTREAM.INIT 970 . 1897) (TEDITCHAT.MENUFN 1899 . 3735) (TEDITCHAT.CHARFN
|
||||
3737 . 4402)) (4451 11335 (TEDIT.DISPLAYTEXT 4461 . 11333)))))
|
||||
(FILEMAP (NIL (886 4544 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
|
||||
3663 . 4542)) (4591 11475 (TEDIT.DISPLAYTEXT 4601 . 11473)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,15 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Apr-2024 11:55:17"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;87 53604
|
||||
(FILECREATED "17-Feb-2025 12:25:49" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;135 49397
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.COPYTOCLIPBOARD \TEDIT.WRITE.SEL)
|
||||
(MACROS \TEDIT.MOUSESTATE)
|
||||
:CHANGES-TO (FNS \TEDIT.COMMAND.LOOP)
|
||||
|
||||
:PREVIOUS-DATE "21-Apr-2024 10:17:38"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;80)
|
||||
:PREVIOUS-DATE "28-Nov-2024 10:03:03" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;133)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
|
||||
@@ -247,8 +244,9 @@
|
||||
PROC])
|
||||
|
||||
(\TEDIT.MARKACTIVE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani")
|
||||
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T)
|
||||
[LAMBDA (TEXTOBJ OPERATION) (* ; "Edited 29-Jun-2024 10:32 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:04 by mitani")
|
||||
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with OPERATION)
|
||||
TEXTOBJ])
|
||||
|
||||
(\TEDIT.MARKINACTIVE
|
||||
@@ -257,193 +255,136 @@
|
||||
TEXTOBJ])
|
||||
|
||||
(\TEDIT.COMMAND.LOOP
|
||||
[LAMBDA (STREAM RTBL) (* ; "Edited 21-Apr-2024 09:08 by rmk")
|
||||
(* ; "Edited 2-Apr-2024 15:35 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 17-Feb-2025 12:05 by rmk")
|
||||
(* ; "Edited 28-Nov-2024 10:01 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 11:51 by rmk")
|
||||
(* ; "Edited 13-Sep-2024 22:34 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 23:26 by rmk")
|
||||
(* ; "Edited 18-Aug-2024 23:05 by rmk")
|
||||
(* ; "Edited 2-Aug-2024 08:46 by rmk")
|
||||
(* ; "Edited 13-Jul-2024 23:13 by rmk")
|
||||
(* ; "Edited 12-Jul-2024 00:39 by rmk")
|
||||
(* ; "Edited 9-Jul-2024 18:02 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 16:24 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 12:31 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 00:08 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:21 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:58 by rmk")
|
||||
(* ; "Edited 7-May-2024 10:42 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:59 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 14:23 by rmk")
|
||||
(* ; "Edited 9-Mar-2024 11:35 by rmk")
|
||||
(* ; "Edited 24-Feb-2024 15:33 by rmk")
|
||||
(* ; "Edited 21-Feb-2024 14:49 by rmk")
|
||||
(* ; "Edited 18-Feb-2024 23:35 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 09:50 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:40 by rmk")
|
||||
(* ; "Edited 16-Sep-2023 22:48 by rmk")
|
||||
(* ; "Edited 30-May-91 19:33 by jds")
|
||||
|
||||
(* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch")
|
||||
|
||||
(PROG ((TEXTOBJ (CL:IF (type? STREAM STREAM)
|
||||
(fetch (TEXTSTREAM TEXTOBJ) of STREAM)
|
||||
STREAM))
|
||||
SEL PANES)
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(SETQ SEL (TEXTSEL TEXTOBJ))
|
||||
(SETQ PANES (FGETTOBJ TEXTOBJ \WINDOW))
|
||||
(SETQ RTBL (OR RTBL (FGETTOBJ TEXTOBJ TXTRTBL)
|
||||
TEDIT.READTABLE)) (* ;
|
||||
"Used to derive command characters from type-in")
|
||||
(for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
|
||||
(* ; "Add the pane to this process")
|
||||
(until (TTY.PROCESSP) do (* ;
|
||||
(LET
|
||||
[(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ]
|
||||
(for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
|
||||
(* ; "Add the process to our panes")
|
||||
(until (TTY.PROCESSP) do (* ;
|
||||
"Wait until we really have the TTY before proceeding.")
|
||||
(DISMISS 250))
|
||||
(RESETLST
|
||||
(RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ PANES)
|
||||
T))
|
||||
(LET
|
||||
(CH FN TCH (READSA (fetch READSA of %#CURRENTRDTBL#))
|
||||
(TERMSA (OR (FGETTOBJ TEXTOBJ TXTTERMSA)
|
||||
\PRIMTERMSA))
|
||||
(TEDITSA (fetch READSA of RTBL))
|
||||
(TEDITFNHASH (fetch READMACRODEFS of RTBL))
|
||||
(LOOPFN (GETTEXTPROP TEXTOBJ 'LOOPFN))
|
||||
(CHARFN (GETTEXTPROP TEXTOBJ 'CHARFN))
|
||||
SELOPERATION SOURCESEL SELPANE)
|
||||
(DECLARE (SPECVARS SELOPERATION SOURCESEL SELPANE))
|
||||
(DISMISS 250))
|
||||
(RESETLST
|
||||
(RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ)
|
||||
T))
|
||||
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do
|
||||
(ERSETQ
|
||||
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do
|
||||
(\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action")
|
||||
(while (FGETTOBJ TEXTOBJ EDITOPACTIVE) do (\TEDIT.FLASHCARET TEXTOBJ)
|
||||
(* ;
|
||||
"Set by \TEDIT.BUTTONEVENTFN in MOUSE process")
|
||||
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do
|
||||
(ERSETQ
|
||||
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do (\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action")
|
||||
(until (OR SELOPERATION (NOT (FGETTOBJ TEXTOBJ EDITOPACTIVE)))
|
||||
do (\TEDIT.FLASHCARET TEXTOBJ)
|
||||
(BLOCK))
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
(CL:WHEN (FGETTOBJ TEXTOBJ TXTNEEDSUPDATE)
|
||||
(* ;
|
||||
"We got here somehow with the window not in sync with the text. Run an update.")
|
||||
(\TEDIT.SHOWSEL SEL NIL)
|
||||
(\TEDIT.UPDATE.SCREEN TEXTOBJ)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T))
|
||||
(\TEDIT.FLASHCARET TEXTOBJ) (* ;
|
||||
"Flash caret while other operation completes")
|
||||
(BLOCK))
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
(\TEDIT.FLASHCARET TEXTOBJ) (* ;
|
||||
"Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE T)
|
||||
(* ;
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE T) (* ;
|
||||
"Before starting to work, note that we're doing something.")
|
||||
(CL:WHEN LOOPFN
|
||||
(ERSETQ (APPLY* LOOPFN (FGETTOBJ TEXTOBJ STREAMHINT))))
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(* ;;
|
||||
"Process any pending selections from \TEDIT.BUTTONEVENTFN, here instead of in MOUSE process")
|
||||
(* ;; "Handle user type-in")
|
||||
|
||||
(SELECTQ (PROG1 SELOPERATION (SETQ SELOPERATION NIL))
|
||||
(NORMAL (CL:WHEN (FGETSEL SOURCESEL SET)
|
||||
(SETQ SEL (\TEDIT.COPYSEL SOURCESEL SEL))
|
||||
(* ; "SOURCESEL is new SEL selection")
|
||||
(FSETTOBJ TEXTOBJ CARETLOOKS (
|
||||
\TEDIT.GET.INSERT.CHARLOOKS
|
||||
TEXTOBJ SEL))
|
||||
(\TEDIT.SHOWSEL SEL T)))
|
||||
(MOVE (* ; "Move source to SEL")
|
||||
(TEDIT.MOVE SOURCESEL SEL))
|
||||
(COPY (* ; "Copy source to SEL.")
|
||||
(TEDIT.COPY SOURCESEL SEL))
|
||||
(COPYLOOKS (* ; "Copy source-looks to SEL")
|
||||
(if (EQ 'PARA (GETSEL SOURCESEL SELKIND))
|
||||
then (TEDIT.COPY.PARALOOKS TEXTOBJ SOURCESEL SEL)
|
||||
else (TEDIT.COPY.LOOKS TEXTOBJ SOURCESEL SEL)))
|
||||
(DELETE (* ; "Delete CTRL selection")
|
||||
(\TEDIT.DELETE TEXTOBJ SOURCESEL NIL SELPANE))
|
||||
NIL)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Handle user type-in")
|
||||
|
||||
[while (\SYSBUFP)
|
||||
do (SETQ CH (\GETKEY))
|
||||
(CL:WHEN CHARFN (* ;
|
||||
[bind CH TCH FN first (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ LOOPFN))
|
||||
(ERSETQ (APPLY* FN TSTREAM))) while (\SYSBUFP)
|
||||
do (SETQ CH (\GETKEY))
|
||||
(CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN))
|
||||
(* ;
|
||||
"Give the OEM user control for each character typed.")
|
||||
(SETQ TCH (APPLY* CHARFN (FGETTOBJ TEXTOBJ STREAMHINT)
|
||||
CH))
|
||||
(SETQ TCH (APPLY* FN TSTREAM CH))
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.")
|
||||
|
||||
(OR (EQ TCH T)
|
||||
(SETQ CH TCH)))
|
||||
(SELECTC (AND CH (\SYNCODE TEDITSA CH))
|
||||
(CHARDELETE.TTC (* ;
|
||||
"Backspace handler: Remove the character just before SEL:CH#.")
|
||||
(\TEDIT.CHARDELETE TEXTOBJ SEL)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
|
||||
(CHARDELETE.FORWARD.TTC
|
||||
(\TEDIT.CHARDELETE.FORWARD TEXTOBJ SEL)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
|
||||
(WORDDELETE.TTC
|
||||
(\TEDIT.WORDDELETE TEXTOBJ SEL)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
|
||||
(WORDDELETE.FORWARD.TTC
|
||||
(\TEDIT.WORDDELETE.FORWARD TEXTOBJ SEL)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
|
||||
(DELETE.TTC (* ;
|
||||
"DEL Key handler: Delete the selected characters")
|
||||
(\TEDIT.DELETE TEXTOBJ SEL)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
|
||||
(UNDO.TTC (* ;
|
||||
"He hit the CANCEL key, so go UNDO something")
|
||||
(TEDIT.UNDO TEXTOBJ)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
|
||||
(REDO.TTC (* ;
|
||||
(CL:UNLESS (EQ TCH T)
|
||||
(SETQ CH TCH)))
|
||||
(SELECTC (AND CH (\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL))
|
||||
CH))
|
||||
(CHARDELETE.TTC
|
||||
(\TEDIT.CHARDELETE TSTREAM))
|
||||
(CHARDELETE.FORWARD.TTC
|
||||
(\TEDIT.CHARDELETE TSTREAM T))
|
||||
(WORDDELETE.TTC
|
||||
(\TEDIT.WORDDELETE TSTREAM))
|
||||
(WORDDELETE.FORWARD.TTC
|
||||
(\TEDIT.WORDDELETE.FORWARD TSTREAM))
|
||||
(DELETE.TTC (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)))
|
||||
(UNDO.TTC (* ;
|
||||
"Take off the BPD, the undoing and put it back on.")
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(TEDIT.UNDO TSTREAM))
|
||||
(REDO.TTC (* ;
|
||||
"He hit the REDO key, so go REDO something")
|
||||
(TEDIT.REDO TEXTOBJ)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
|
||||
(FUNCTIONCALL.TTC (* ;
|
||||
(TEDIT.REDO TSTREAM)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ))
|
||||
(FUNCTIONCALL.TTC (* ;
|
||||
"This is a special character -- it calls a function")
|
||||
(CL:WHEN [SETQ FN (CAR (FETCH MACROFN
|
||||
OF (GETHASH CH TEDITFNHASH]
|
||||
(CL:WHEN [SETQ FN (CAR (fetch MACROFN
|
||||
of (GETHASH CH (fetch READMACRODEFS
|
||||
of (FGETTOBJ TEXTOBJ
|
||||
TXTRTBL]
|
||||
(* ;
|
||||
"There IS a command function to be called.")
|
||||
(APPLY* FN (FGETTOBJ TEXTOBJ STREAMHINT)
|
||||
TEXTOBJ SEL)
|
||||
(APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ))
|
||||
(* ; "do it")
|
||||
(* ;
|
||||
"After a user function (that is not wheelscroll) no more blue-pending-delete")
|
||||
|
||||
(* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")
|
||||
(* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")
|
||||
|
||||
(CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
|
||||
(MEMB CH CLIPBOARDCODES))
|
||||
(CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
|
||||
(MEMB CH CLIPBOARDCODES))
|
||||
(* ;
|
||||
"The FNs handled the selection. should preserve the highlighting")
|
||||
(\TEDIT.SHOWSEL SEL NIL)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T))))
|
||||
(NEXT.TTC (* ;
|
||||
"Move to the next blank to fill in. For now, blanks are delimited by >>...<<")
|
||||
(TEDIT.NEXT TEXTOBJ))
|
||||
(EXPAND.TTC (* ; "EXPAND AN ABBREVIATION")
|
||||
(\TEDIT.ABBREV.EXPAND (FGETTOBJ TEXTOBJ STREAMHINT
|
||||
)))
|
||||
(SELECTC (AND TERMSA CH (fetch TERMCLASS
|
||||
of (\SYNCODE TERMSA CH)))
|
||||
(CHARDELETE.TC (* ;
|
||||
"Backspace handler: Remove the character just before SEL:CH#.")
|
||||
(\TEDIT.CHARDELETE TEXTOBJ SEL)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL
|
||||
TEXTOBJ))
|
||||
(WORDDELETE.TC (* ; "Back-WORD handler")
|
||||
(\TEDIT.WORDDELETE TEXTOBJ)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL
|
||||
TEXTOBJ))
|
||||
(LINEDELETE.TC (* ;
|
||||
"DEL Key handler: Delete the selected characters")
|
||||
(\TEDIT.DELETE TEXTOBJ SEL)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL
|
||||
TEXTOBJ))
|
||||
(CL:WHEN CH (* ;
|
||||
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL NIL T TEXTOBJ))))
|
||||
(NEXT.TTC (* ;
|
||||
"Move to the next blank to fill in, delimited by >>...<<")
|
||||
(TEDIT.NEXT TSTREAM))
|
||||
(EXPAND.TTC (* ; "EXPAND AN ABBREVIATION")
|
||||
(\TEDIT.ABBREV.EXPAND TSTREAM))
|
||||
(SELECTC (AND CH (fetch TERMCLASS of (\SYNCODE (OR (FGETTOBJ TEXTOBJ
|
||||
TXTTERMSA)
|
||||
\PRIMTERMSA)
|
||||
CH)))
|
||||
(CHARDELETE.TC (\TEDIT.CHARDELETE TSTREAM))
|
||||
(WORDDELETE.TC (\TEDIT.WORDDELETE TSTREAM))
|
||||
(LINEDELETE.TC (\TEDIT.DELETE TEXTOBJ))
|
||||
(CL:WHEN CH (* ;
|
||||
"Any other key: insert the character.")
|
||||
(\TEDIT.INSERT CH SEL TEXTOBJ))])
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))))])
|
||||
(\TEDIT.INSERT CH (TEXTSEL TEXTOBJ)
|
||||
TSTREAM NIL T))])
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))])
|
||||
|
||||
(\TEDIT.COMMAND.RESET.SETUP
|
||||
[LAMBDA (TEXT&WIND STARTING) (* ; "Edited 17-Mar-2024 18:54 by rmk")
|
||||
[LAMBDA (ARGS STARTING) (* ; "Edited 29-Jun-2024 00:10 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 18:54 by rmk")
|
||||
(* ; "Edited 22-Feb-2024 23:14 by rmk")
|
||||
(* ; "Edited 5-Oct-2023 22:41 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:41 by rmk")
|
||||
@@ -453,21 +394,20 @@
|
||||
|
||||
(* ;; "If STARTING is T, set up the reset-driven connections and values for editing; otherwise, break links and reset values for non-editing")
|
||||
|
||||
(PROG ((TEXTOBJ (CAR TEXT&WIND))
|
||||
(PANES (CADR TEXT&WIND))
|
||||
(OTTYWINDOW (CADDR TEXT&WIND))
|
||||
(OTTYENTRYFN (CADDDR TEXT&WIND))
|
||||
(OTTYEXITFN (CAR (CDDDDR TEXT&WIND)))
|
||||
(OWINDOW (CADR (CDDDDR TEXT&WIND)))
|
||||
TTYWINDOW)
|
||||
(PROG ((TEXTOBJ (pop ARGS))
|
||||
(OTTYWINDOW (pop ARGS))
|
||||
(OTTYENTRYFN (pop ARGS))
|
||||
(OTTYEXITFN (pop ARGS))
|
||||
(OWINDOW (pop ARGS))
|
||||
TTYWINDOW PRIMPANE)
|
||||
(SETQ PRIMPANE (FGETTOBJ TEXTOBJ PRIMARYPANE))
|
||||
[COND
|
||||
(STARTING (* ;
|
||||
"We're going INTO the command loop. Set up all the stuff")
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE T) (* ;
|
||||
"Mark us busy until we're set up, so that nobody tries any funny stuff.")
|
||||
(SETQ OWINDOW (PROCESSPROP (THIS.PROCESS)
|
||||
'WINDOW
|
||||
(CAR PANES))) (* ;
|
||||
'WINDOW PRIMPANE)) (* ;
|
||||
"Attach the process to this window.")
|
||||
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)) (* ;
|
||||
"Disarm all interrupt chars, re-arm them when we leave the edit")
|
||||
@@ -493,7 +433,7 @@
|
||||
(* ;
|
||||
"So that there isn't a circularity in the PROCESS -> TTYWINDOW -> PROCESS")
|
||||
(WINDOWPROP TTYWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN))
|
||||
(WINDOWPROP TTYWINDOW 'MAINWINDOW (CAR PANES)))
|
||||
(WINDOWPROP TTYWINDOW 'MAINWINDOW PRIMPANE))
|
||||
(FSETTOBJ TEXTOBJ TXTEDITING T) (* ;
|
||||
"Tell TEdit that this document is actively being edited.")
|
||||
(* ;
|
||||
@@ -502,21 +442,19 @@
|
||||
(T (* ;
|
||||
"Coming OUT OF the command loop -- reset everything")
|
||||
(PROCESSPROP (THIS.PROCESS)
|
||||
'WINDOW
|
||||
(CAR PANES)) (* ;
|
||||
'WINDOW PRIMPANE) (* ;
|
||||
"Detach the window from the edit process, to prevent circularity there")
|
||||
(WINDOWPROP (CAR PANES)
|
||||
'PROCESS NIL)
|
||||
(WINDOWPROP PRIMPANE 'PROCESS NIL)
|
||||
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)
|
||||
T) (* ;
|
||||
"Re-arm the interrupts we turned off coming in.")
|
||||
(CL:WHEN [AND (TXTFILE TEXTOBJ)
|
||||
(NOT (fetch (TEXTWINDOW CLOSINGFILE) of (CAR PANES]
|
||||
(CL:WHEN (AND (TXTFILE TEXTOBJ)
|
||||
(NOT (fetch (TEXTWINDOW CLOSINGFILE) of PRIMPANE)))
|
||||
(* ;
|
||||
"Remember to close the file we were editing (Only if the window function isn't closing it.)")
|
||||
(CLOSEF? (TXTFILE TEXTOBJ)) (* ;
|
||||
"Let anyone else who wants to close the file.")
|
||||
(replace (TEXTWINDOW CLOSINGFILE) of (CAR PANES) with NIL))
|
||||
(replace (TEXTWINDOW CLOSINGFILE) of PRIMPANE with NIL))
|
||||
(PROCESSPROP (THIS.PROCESS)
|
||||
'TTYEXITFN OTTYEXITFN)
|
||||
(PROCESSPROP (THIS.PROCESS)
|
||||
@@ -532,7 +470,7 @@
|
||||
(TTYDISPLAYSTREAM OTTYWINDOW)
|
||||
(PROCESSPROP (THIS.PROCESS)
|
||||
'TEDITTTYWINDOW NIL))]
|
||||
(RETURN (LIST TEXTOBJ PANES OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW])
|
||||
(RETURN (LIST TEXTOBJ OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW])
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.INTERRUPTS '((2 BREAK)
|
||||
@@ -974,12 +912,12 @@
|
||||
|
||||
(\TEDIT.CLIPBOARD)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8457 30896 (\TEDIT.INTERRUPT.SETUP 8467 . 10114) (\TEDIT.MARKACTIVE 10116 . 10328) (
|
||||
\TEDIT.MARKINACTIVE 10330 . 10546) (\TEDIT.COMMAND.LOOP 10548 . 24296) (\TEDIT.COMMAND.RESET.SETUP
|
||||
24298 . 30894)) (31180 46377 (\TEDIT.READTABLE 31190 . 32847) (\TEDIT.WORDBOUND.READTABLE 32849 .
|
||||
35442) (TEDIT.GETSYNTAX 35444 . 37883) (TEDIT.SETSYNTAX 37885 . 40363) (TEDIT.GETFUNCTION 40365 .
|
||||
41725) (TEDIT.SETFUNCTION 41727 . 44166) (TEDIT.WORDGET 44168 . 44429) (TEDIT.WORDSET 44431 . 45128) (
|
||||
TEDIT.ATOMBOUND.READTABLE 45130 . 46375)) (46705 47614 (\TEDIT.WHEELSCROLL 46715 . 47612)) (47767
|
||||
53347 (\TEDIT.CLIPBOARD 47777 . 49532) (\TEDIT.COPYTOCLIPBOARD 49534 . 50314) (
|
||||
\TEDIT.EXTRACTTOCLIPBOARD 50316 . 50511) (\TEDIT.WRITE.SEL 50513 . 53345)))))
|
||||
(FILEMAP (NIL (8312 26689 (\TEDIT.INTERRUPT.SETUP 8322 . 9969) (\TEDIT.MARKACTIVE 9971 . 10300) (
|
||||
\TEDIT.MARKINACTIVE 10302 . 10518) (\TEDIT.COMMAND.LOOP 10520 . 20097) (\TEDIT.COMMAND.RESET.SETUP
|
||||
20099 . 26687)) (26973 42170 (\TEDIT.READTABLE 26983 . 28640) (\TEDIT.WORDBOUND.READTABLE 28642 .
|
||||
31235) (TEDIT.GETSYNTAX 31237 . 33676) (TEDIT.SETSYNTAX 33678 . 36156) (TEDIT.GETFUNCTION 36158 .
|
||||
37518) (TEDIT.SETFUNCTION 37520 . 39959) (TEDIT.WORDGET 39961 . 40222) (TEDIT.WORDSET 40224 . 40921) (
|
||||
TEDIT.ATOMBOUND.READTABLE 40923 . 42168)) (42498 43407 (\TEDIT.WHEELSCROLL 42508 . 43405)) (43560
|
||||
49140 (\TEDIT.CLIPBOARD 43570 . 45325) (\TEDIT.COPYTOCLIPBOARD 45327 . 46107) (
|
||||
\TEDIT.EXTRACTTOCLIPBOARD 46109 . 46304) (\TEDIT.WRITE.SEL 46306 . 49138)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Mar-2024 12:06:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;102 30083
|
||||
(FILECREATED "17-Feb-2025 12:25:36" {WMEDLEY}<library>tedit>TEDIT-FIND.;136 36884
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.BASICFIND \TEDIT.BASICFIND.BACKWARD \TEDIT.WCFIND.BACKWARD)
|
||||
:CHANGES-TO (FNS \TEDIT.BASICFIND)
|
||||
|
||||
:PREVIOUS-DATE "15-Mar-2024 14:10:05" {WMEDLEY}<library>tedit>TEDIT-FIND.;98)
|
||||
:PREVIOUS-DATE "15-Feb-2025 18:08:55" {WMEDLEY}<library>tedit>TEDIT-FIND.;135)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FINDCOMS)
|
||||
@@ -28,7 +28,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.FIND
|
||||
[LAMBDA (TEXTOBJ TARGETSTRING START END WILDCARDS?) (* ; "Edited 19-Jun-2023 22:27 by rmk")
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS?) (* ; "Edited 10-May-2024 21:55 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 23:47 by rmk")
|
||||
(* ; "Edited 19-Jun-2023 22:27 by rmk")
|
||||
(* ; "Edited 6-May-2018 17:34 by rmk:")
|
||||
(* ; "Edited 30-May-91 20:56 by jds")
|
||||
|
||||
@@ -38,26 +40,30 @@
|
||||
|
||||
(* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?")
|
||||
|
||||
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
(CL:WHEN TARGETSTRING
|
||||
(SETQ TARGETSTRING (MKSTRING TARGETSTRING))
|
||||
(CL:UNLESS END
|
||||
(SETQ END (TEXTLEN TEXTOBJ)))
|
||||
(CL:UNLESS START
|
||||
(SETQ START (TEDIT.GETPOINT TEXTOBJ)))
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
|
||||
(* ;; "* and # are implicitly quoted if not WILDCARDS? This could be handled simply by calling CONS instead of \TEDIT.PARSE.SEARCHSTRING")
|
||||
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
|
||||
(\TEDIT.PARSE.SEARCHSTRING TARGETSTRING)
|
||||
START END)
|
||||
(CAR (\TEDIT.BASICFIND (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
|
||||
TARGETSTRING START END)))))])
|
||||
[if (IMAGEOBJP TARGET)
|
||||
then (TEDIT.FIND.OBJECT TSTREAM TARGET START END)
|
||||
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
|
||||
then (CL:UNLESS END
|
||||
(SETQ END (FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
|
||||
TEXTLEN)))
|
||||
(CL:UNLESS START
|
||||
(SETQ START (TEDIT.GETPOINT TSTREAM)))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND TSTREAM (\TEDIT.PARSE.SEARCHSTRING TARGET)
|
||||
START END)
|
||||
(CAR (\TEDIT.BASICFIND TSTREAM TARGET START END))))])])
|
||||
|
||||
(TEDIT.FIND.BACKWARD
|
||||
[LAMBDA (TEXTOBJ TARGETSTRING START END WILDCARDS? AGAIN) (* ; "Edited 12-Jul-2023 08:24 by rmk")
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 19-May-2024 12:07 by rmk")
|
||||
(* ; "Edited 10-May-2024 22:00 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 23:43 by rmk")
|
||||
(* ; "Edited 12-Jul-2023 08:24 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 12:12 by rmk")
|
||||
(* ; "Edited 18-Jun-2023 23:43 by rmk")
|
||||
(* ; "Edited 30-May-91 19:17 by jds")
|
||||
@@ -66,197 +72,221 @@
|
||||
|
||||
(* ;; "If WILDCARDS?, the value is the pair (MATCHSTART MATCHEND) for that match, since the caller doesn't know the length. But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long. This is quirky, but that's the way it is documented.")
|
||||
|
||||
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
(CL:WHEN [AND TARGETSTRING (NEQ 0 (NCHARS (SETQ TARGETSTRING (MKSTRING TARGETSTRING]
|
||||
(SETQ START (IMAX 1 (OR START 1)))
|
||||
(SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TEXTOBJ)))
|
||||
(TEXTLEN TEXTOBJ)))
|
||||
(CL:WHEN AGAIN
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
[if (IMAGEOBJP TARGET)
|
||||
then (TEDIT.FIND.OBJECT.BACKWARD TSTREAM TARGET START END AGAIN)
|
||||
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
|
||||
then (SETQ START (IMAX 1 (OR START 1)))
|
||||
(SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
|
||||
(FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
|
||||
TEXTLEN)))
|
||||
(CL:WHEN AGAIN
|
||||
|
||||
(* ;; "Assume that we aren't interested in another match at the current position.")
|
||||
(* ;;
|
||||
"Assume that we aren't interested in another match at the current position.")
|
||||
|
||||
(ADD END -1))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND.BACKWARD (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
|
||||
(DREVERSE (\TEDIT.PARSE.SEARCHSTRING TARGETSTRING))
|
||||
START END)
|
||||
(CAR (\TEDIT.BASICFIND.BACKWARD (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
|
||||
TARGETSTRING START END)))))])
|
||||
(ADD END -1))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND.BACKWARD TSTREAM (\TEDIT.PARSE.SEARCHSTRING TARGET T)
|
||||
START END)
|
||||
(CAR (\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START END))))])])
|
||||
|
||||
(TEDIT.SUBSTITUTE
|
||||
[LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 15-Mar-2024 14:09 by rmk")
|
||||
[LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 8-Dec-2024 15:47 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 23:49 by rmk")
|
||||
(* ; "Edited 15-Aug-2024 09:20 by rmk")
|
||||
(* ; "Edited 14-Jul-2024 00:24 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:46 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 10:49 by rmk")
|
||||
(* ; "Edited 18-May-2024 23:03 by rmk")
|
||||
(* ; "Edited 9-Mar-2024 11:36 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 12:24 by rmk")
|
||||
(* ; "Edited 29-Feb-2024 17:00 by rmk")
|
||||
(* ; "Edited 27-Feb-2024 08:20 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:11 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 14:09 by rmk")
|
||||
(* ; "Edited 6-Jan-2024 11:09 by rmk")
|
||||
(* ; "Edited 12-Nov-2023 12:29 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:36 by rmk")
|
||||
(* ; "Edited 31-May-2023 00:04 by rmk")
|
||||
(* ; "Edited 24-May-2023 20:01 by rmk")
|
||||
(* ; "Edited 30-Mar-94 16:04 by jds")
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
|
||||
(* ;; "Replace all instances of PATTERN with REPLACEMENT. If CONFIRM? is non-NIL, ask before each replacement.")
|
||||
|
||||
(CL:UNLESS (\TEDIT.READONLY TEXTSTREAM)
|
||||
(PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
|
||||
(NREPLACEMENTS 0)
|
||||
(YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
|
||||
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN
|
||||
ACTIONSTRING)
|
||||
(CL:UNLESS [SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
|
||||
(\TEDIT.GET.TARGET.STRING TEXTOBJ
|
||||
'TEDIT.LAST.SUBSTITUTE.STRING]
|
||||
(* ;
|
||||
"If the search pattern is empty, bail out.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
|
||||
(RETURN))
|
||||
(CL:UNLESS REPLACEMENT
|
||||
[SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ "Replace string:" (GETTEXTPROP
|
||||
TEXTOBJ
|
||||
|
||||
'
|
||||
(CL:UNLESS (\TEDIT.READONLY TSTREAM)
|
||||
(RESETLST
|
||||
(PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(NREPLACEMENTS 0)
|
||||
(YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
|
||||
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN
|
||||
ACTIONSTRING)
|
||||
|
||||
(* ;; "Don't call \TEDIT.GET.TARGET.STRING because it might pick the search-domain (current selection) as the search string. If the search pattern is empty, bail out.")
|
||||
|
||||
[CL:UNLESS (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
|
||||
(GETTEXTPROP TEXTOBJ
|
||||
'
|
||||
TEDIT.LAST.SUBSTITUTE.STRING
|
||||
]
|
||||
(CL:UNLESS [OR REPLACEMENT (SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ
|
||||
"Replace string:"
|
||||
(GETTEXTPROP TEXTOBJ
|
||||
|
||||
'
|
||||
TEDIT.LAST.REPLACEMENT.STRING
|
||||
])
|
||||
(if (type? SELPIECES REPLACEMENT)
|
||||
elseif (OR (STRINGP REPLACEMENT)
|
||||
(LITATOM REPLACEMENT))
|
||||
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ))
|
||||
elseif (LISTP REPLACEMENT)
|
||||
then (HELP "LISTP REPLACEMENT"))
|
||||
]
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
|
||||
(RETURN))
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(if (type? SELPIECES REPLACEMENT)
|
||||
elseif (OR (STRINGP REPLACEMENT)
|
||||
(LITATOM REPLACEMENT))
|
||||
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ)))
|
||||
|
||||
(* ;; "Could be NIL or empty string, meaning just delete all occurrences.")
|
||||
(* ;; "Could be NIL or empty string, meaning just delete all occurrences.")
|
||||
|
||||
(SETQ REPLACE-LEN (fetch (SELPIECES SPLEN) of REPLACEMENT))
|
||||
(SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN)
|
||||
"delet"
|
||||
"substitut"))
|
||||
(SETQ REPLACE-LEN (fetch (SELPIECES SPLEN) of REPLACEMENT))
|
||||
(SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN)
|
||||
"delet"
|
||||
"substitut"))
|
||||
|
||||
(* ;;
|
||||
"If a pattern is specd in the call, use the caller's confirm flag, otherwise ask for one.")
|
||||
(* ;;
|
||||
"If a pattern is specd in the call, use the caller's confirm flag, otherwise ask for one.")
|
||||
|
||||
(SETQ CONFIRMFLG (CL:IF PATTERN
|
||||
CONFIRM?
|
||||
(MEMBER (TEDIT.GETINPUT TEXTOBJ (CONCAT "Ask before each "
|
||||
ACTIONSTRING "ion?")
|
||||
"No")
|
||||
YESLIST)))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T)
|
||||
"ing...")
|
||||
T)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(\TEDIT.SHOWSEL SEL NIL)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
|
||||
(SETQ CONFIRMFLG (CL:IF PATTERN
|
||||
CONFIRM?
|
||||
(MEMBER (TEDIT.GETINPUT TEXTOBJ (CONCAT "Ask before each "
|
||||
ACTIONSTRING "ion?")
|
||||
"No")
|
||||
YESLIST)))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T)
|
||||
"ing...")
|
||||
T)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(* ; "Turn off any blue pending delete")
|
||||
|
||||
(* ;; "STARTCHAR# and ENDCHAR# bound each search. ENDCHAR# has to be reduced as STARTCHAR# increases, so the search stays within the selection.")
|
||||
(* ;; "STARTCHAR# and ENDCHAR# bound each search. ENDCHAR# has to be reduced as STARTCHAR# increases, so the search stays within the selection.")
|
||||
|
||||
(SETQ STARTCHAR# (GETSEL SEL CH#))
|
||||
[SETQ ENDCHAR# (IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH]
|
||||
[if CONFIRMFLG
|
||||
then
|
||||
(* ;; "In this case the selection moves along, ending up at the last hit.")
|
||||
(SETQ STARTCHAR# (GETSEL SEL CH#))
|
||||
[SETQ ENDCHAR# (CL:IF (ZEROP (GETSEL SEL DCH))
|
||||
(GETTOBJ TEXTOBJ TEXTLEN)
|
||||
(IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH))))]
|
||||
[if CONFIRMFLG
|
||||
then
|
||||
(* ;; "In this case the selection moves along, ending up at the last hit.")
|
||||
|
||||
[bind PENDING.SEL CHOICE while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING
|
||||
STARTCHAR# ENDCHAR# T))
|
||||
do (* ;
|
||||
[bind PENDING.SEL CHOICE while (SETQ RANGE (TEDIT.FIND TEXTOBJ
|
||||
SEARCHSTRING STARTCHAR#
|
||||
ENDCHAR# T))
|
||||
do (* ;
|
||||
"Show each substitution site and ask for permission")
|
||||
(SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE)
|
||||
(ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE)))
|
||||
'RIGHT T))
|
||||
(\TEDIT.SHOWSEL PENDING.SEL T)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
|
||||
(SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ
|
||||
"OK to replace? ['q' quits]" "Yes")
|
||||
1))
|
||||
(Q (RETURN))
|
||||
(Y (* ; "Do this one")
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
|
||||
'COPY TEXTOBJ)
|
||||
TEXTOBJ PENDING.SEL)
|
||||
(add NREPLACEMENTS 1)
|
||||
(SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM))
|
||||
(SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE)
|
||||
(ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE)))
|
||||
'RIGHT T))
|
||||
(\TEDIT.SHOWSEL PENDING.SEL T TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
|
||||
(SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ
|
||||
"OK to replace? ['q' quits]" "Yes")
|
||||
1))
|
||||
(Q (RETURN))
|
||||
(Y (* ; "Do this one")
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
|
||||
'COPY TEXTOBJ)
|
||||
TEXTOBJ PENDING.SEL)
|
||||
(add NREPLACEMENTS 1)
|
||||
(SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM))
|
||||
(* ; "Next start, compensate for end")
|
||||
[add ENDCHAR# (IDIFFERENCE REPLACE-LEN (ADD1 (IDIFFERENCE
|
||||
(CADR RANGE)
|
||||
(CAR RANGE])
|
||||
(PROGN
|
||||
(* ;;
|
||||
[add ENDCHAR# (IDIFFERENCE REPLACE-LEN
|
||||
(ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE])
|
||||
(PROGN
|
||||
(* ;;
|
||||
"Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.")
|
||||
|
||||
(TEDIT.SHOWSEL TEXTOBJ NIL PENDING.SEL)
|
||||
(SETQ STARTCHAR# (ADD1 (CAR RANGE]
|
||||
else
|
||||
(* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events")
|
||||
(\TEDIT.SHOWSEL PENDING.SEL NIL TEXTOBJ)
|
||||
(SETQ STARTCHAR# (ADD1 (CAR RANGE]
|
||||
else
|
||||
(* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events")
|
||||
|
||||
(bind FIRSTHIT HITLEN HITDIFF (TOTALDIFF _ 0)
|
||||
(SAVESEL _ (\TEDIT.COPYSEL SEL))
|
||||
while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR# T))
|
||||
collect (CL:UNLESS FIRSTHIT (* ; "For final line updating.")
|
||||
(SETQ FIRSTHIT (CAR RANGE)))
|
||||
[SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE]
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR RANGE)
|
||||
HITLEN
|
||||
'RIGHT)
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
|
||||
'COPY TEXTOBJ)
|
||||
TEXTOBJ SEL)
|
||||
(add NREPLACEMENTS 1)
|
||||
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
|
||||
(SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN))
|
||||
(add ENDCHAR# HITDIFF)
|
||||
(add TOTALDIFF HITDIFF)
|
||||
(\TEDIT.POPEVENT TEXTOBJ)
|
||||
finally (CL:WHEN $$VAL
|
||||
(bind FIRSTHIT HITLAST HITLEN HITDIFF (TOTALDIFF _ 0)
|
||||
(SAVESEL _ (\TEDIT.COPYSEL SEL))
|
||||
EVENTS while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR#
|
||||
ENDCHAR# T))
|
||||
do (CL:UNLESS FIRSTHIT (* ; "For final line updating.")
|
||||
(SETQ FIRSTHIT (CAR RANGE)))
|
||||
[SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE]
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR RANGE)
|
||||
HITLEN
|
||||
'RIGHT)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
|
||||
'COPY TEXTOBJ)
|
||||
TEXTOBJ SEL)
|
||||
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(* ;
|
||||
"Collect the events for a single composite")
|
||||
(add NREPLACEMENTS 1)
|
||||
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
|
||||
(SETQ HITLAST STARTCHAR#)
|
||||
(SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN))
|
||||
(add ENDCHAR# HITDIFF)
|
||||
(add TOTALDIFF HITDIFF)
|
||||
finally (CL:UNLESS (EQ NREPLACEMENTS 0)
|
||||
|
||||
(* ;;
|
||||
"At least one replacement, update the lines that have changed.")
|
||||
(* ;;
|
||||
"At least one replacement, update the lines that have changed.")
|
||||
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
|
||||
(IDIFFERENCE (GETSEL SEL CHLIM)
|
||||
FIRSTHIT))
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
|
||||
(IDIFFERENCE (GETSEL SEL CHLIM)
|
||||
FIRSTHIT))
|
||||
|
||||
(* ;; "We want the new selection to begin at the beginning of the original selection, somewhere before the first hit, and end at the position that the prior ending moved to. The text grew or shrank with each hit.")
|
||||
(* ;; "Not clear what the final selection should be, if there are multiple changes. The original selection? A selection that goes from the beginning of the first subsitution to the end of the last (as here)? Or just the selection of the last substitution?")
|
||||
|
||||
(\TEDIT.SHOWSEL SEL NIL)
|
||||
(\TEDIT.UPDATE.SEL SEL (GETSEL SAVESEL CH#)
|
||||
(IPLUS (GETSEL SAVESEL DCH)
|
||||
TOTALDIFF)
|
||||
'RIGHT)
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (DREVERSE $$VAL)))]
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL FIRSTHIT (IDIFFERENCE HITLAST FIRSTHIT
|
||||
)
|
||||
'RIGHT)
|
||||
(\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))]
|
||||
|
||||
(* ;; "Save the search & replacement strings to offer for next time:")
|
||||
(* ;; "Save the search & replacement strings to offer for next time:")
|
||||
|
||||
(\TEDIT.SHOWSEL SEL T)
|
||||
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING)
|
||||
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING
|
||||
REPLACEMENT NIL TEXTOBJ))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (SELECTQ NREPLACEMENTS
|
||||
(0 (CONCAT " No " ACTIONSTRING "ions made"))
|
||||
(1 (CONCAT " 1 " ACTIONSTRING "ion made"))
|
||||
(CONCAT " " (MKSTRING NREPLACEMENTS)
|
||||
" " ACTIONSTRING "ions made"))
|
||||
T)
|
||||
(RETURN NREPLACEMENTS)))])
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TSTREAM SEL)
|
||||
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING)
|
||||
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING
|
||||
REPLACEMENT NIL TEXTOBJ))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (SELECTQ NREPLACEMENTS
|
||||
(0 (CONCAT " No " ACTIONSTRING "ions made"))
|
||||
(1 (CONCAT " 1 " ACTIONSTRING "ion made"))
|
||||
(CONCAT " " (MKSTRING NREPLACEMENTS)
|
||||
" " ACTIONSTRING "ions made"))
|
||||
T)
|
||||
(RETURN NREPLACEMENTS))))])
|
||||
|
||||
(TEDIT.NEXT
|
||||
[LAMBDA (STREAM) (* ; "Edited 15-Mar-2024 13:34 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 15-Feb-2025 18:08 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:40 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:47 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:23 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:10 by rmk")
|
||||
(* ; "Edited 16-Feb-2024 23:48 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:34 by rmk")
|
||||
(* ; "Edited 14-Dec-2023 21:20 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 00:05 by rmk")
|
||||
(* ; "Edited 3-May-2023 23:47 by rmk")
|
||||
(* ; "Edited 18-Apr-2023 23:46 by rmk")
|
||||
(* ; "Edited 30-May-91 20:57 by jds")
|
||||
(LET ((TEXTOBJ (TEXTOBJ STREAM))
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
TARGET SEL OPTION FIELDSEL)
|
||||
(SETQ SEL (TEXTSEL TEXTOBJ))
|
||||
(SETQ TARGET (TEDIT.FIND TEXTOBJ ">>*<<" NIL NIL T))(* ;
|
||||
"find the first >>delimited<< field")
|
||||
(SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (GETSEL SEL CH#)))
|
||||
(* ;
|
||||
(SETQ FIELDSEL (TEDIT.FIND TEXTOBJ "{*}" NIL NIL T))(* ;
|
||||
"find the first menu-type insertion field, usually delimited with {}")
|
||||
[SETQ OPTION (COND
|
||||
[(AND TARGET FIELDSEL) (* ; "take the first one")
|
||||
@@ -273,28 +303,32 @@
|
||||
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T)
|
||||
(* ;
|
||||
"Original comment: %"never pending a deletion%", but it is!")
|
||||
(\TEDIT.SHOWSEL SEL NIL) (* ;
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ;
|
||||
"Set up SELECTION to be the found text")
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR TARGET)
|
||||
(IDIFFERENCE (ADD1 (CADR TARGET))
|
||||
(CAR TARGET))
|
||||
'RIGHT)
|
||||
(\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* ; "Always selected normally")
|
||||
'RIGHT
|
||||
'PENDINGDEL)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ) (* ; "Always selected normally")
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ) (* ; "And get it into the window")
|
||||
(\TEDIT.SHOWSEL SEL T))
|
||||
)
|
||||
(FIELD (* ;
|
||||
"Update the selection for this textobj from the scratch sel returned from MBUTTON.FIND.NEXT.FIELD")
|
||||
(FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
|
||||
(\TEDIT.SHOWSEL SEL NIL) (* ;
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ;
|
||||
"Set SELECTION to be the found text")
|
||||
(\TEDIT.UPDATE.SEL SEL (GETSEL FIELDSEL CH#)
|
||||
(GETSEL FIELDSEL DCH)
|
||||
'LEFT)
|
||||
(\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* ; "And get it into the window")
|
||||
'LEFT
|
||||
'PENDINGDEL) (* ; "And get it into the window")
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ))
|
||||
(NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T)
|
||||
(SETQ SEL NIL))
|
||||
(SHOULDNT "No legal value found in selectq in TEDIT.NEXT"))
|
||||
(\TEDIT.THELP "No legal value found in SELECTQ in TEDIT.NEXT"))
|
||||
(CL:WHEN SEL (* ;
|
||||
"There really IS a selection made here, so set up the charlooks for it properly.")
|
||||
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)))])
|
||||
@@ -307,192 +341,230 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.WCFIND
|
||||
[LAMBDA (TSTREAM TARGETLIST START END HITSTART ANCHORED) (* ; "Edited 19-Jun-2023 23:50 by rmk")
|
||||
[LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:04 by rmk")
|
||||
(* ; "Edited 23-Jun-2024 12:00 by rmk")
|
||||
(* ; "Edited 19-May-2024 23:46 by rmk")
|
||||
(* ; "Edited 3-May-2024 07:11 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 20:45 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 11:59 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 13:52 by rmk")
|
||||
|
||||
(* ;; "Returns the (start end) pair of a match possibly with wild cards, where HITSTART is the first character of such a match")
|
||||
(* ;; "Returns the (start end) pair of the nearest match somewhere at or after START, possibly with wild cards. The basic-find does fast search of simple strings. This is all about backtracking to advance the search on failure, and for wild cards. Note that *'s do not appear on the edges.")
|
||||
|
||||
(CL:UNLESS (IGREATERP START END)
|
||||
[LET (RESULT)
|
||||
(COND
|
||||
((NULL TARGETLIST) (* ; "Final match")
|
||||
(LIST (OR HITSTART (SUB1 START))
|
||||
(SUB1 START)))
|
||||
[(EQ '%# (CAR TARGETLIST)) (* ;
|
||||
"Single-char wildcard, next segment is anchored ")
|
||||
(OR (\TEDIT.WCFIND TSTREAM (CDR TARGETLIST)
|
||||
(ADD1 START)
|
||||
END
|
||||
(OR HITSTART START)
|
||||
T)
|
||||
(CL:UNLESS ANCHORED (* ;
|
||||
"Initial # didn't match, let it slide in this loop")
|
||||
(for S from (ADD1 START) to END
|
||||
when (SETQ RESULT (\TEDIT.WCFIND TSTREAM TARGETLIST S END S T))
|
||||
do (RETURN RESULT)))]
|
||||
((EQ '* (CAR TARGETLIST))
|
||||
(CL:WHEN TARGETLIST
|
||||
[bind STACK CONFIG HITSTART ANCHORED RESULT TARGETTAIL TARGET (TOPSTART _ (SUB1 START))
|
||||
do (SETQ CONFIG (pop STACK))
|
||||
(if CONFIG
|
||||
then (SETQ START (pop CONFIG))
|
||||
(SETQ TARGETTAIL (pop CONFIG))
|
||||
(SETQ HITSTART (pop CONFIG))
|
||||
(SETQ ANCHORED (pop CONFIG))
|
||||
elseif (IGEQ TOPSTART END)
|
||||
then (RETURN NIL) (* ; "No more, failed")
|
||||
else (add TOPSTART 1) (* ; "First time or outer advance")
|
||||
(SETQ START TOPSTART)
|
||||
(SETQ TARGETTAIL TARGETLIST)
|
||||
(SETQ HITSTART NIL)
|
||||
(SETQ ANCHORED NIL))
|
||||
(SETQ TARGET (CAR TARGETTAIL))
|
||||
(SELECTQ TARGET
|
||||
(%# (CL:UNLESS (CDR TARGETTAIL)
|
||||
(RETURN (LIST (OR HITSTART START)
|
||||
START)))
|
||||
(CL:WHEN (ILEQ START END) (* ;
|
||||
"If we are unanchored, slipping continues")
|
||||
(push STACK (LIST (ADD1 START)
|
||||
(CDR TARGETTAIL)
|
||||
(OR HITSTART START)
|
||||
ANCHORED))))
|
||||
(*
|
||||
(* ;; "Unanchored config for the tail that starts here.")
|
||||
|
||||
(* ;; "Variable width wildcard, not anchored so the match can slide along.")
|
||||
|
||||
(\TEDIT.WCFIND TSTREAM (CDR TARGETLIST)
|
||||
START END HITSTART))
|
||||
((SETQ RESULT (\TEDIT.BASICFIND TSTREAM (CAR TARGETLIST)
|
||||
START END ANCHORED)) (* ;
|
||||
"Matched a string segment, keep going")
|
||||
(\TEDIT.WCFIND TSTREAM (CDR TARGETLIST)
|
||||
(ADD1 (CADR RESULT))
|
||||
END
|
||||
(OR HITSTART (CAR RESULT])])
|
||||
(push STACK (LIST START (CDR TARGETTAIL)
|
||||
HITSTART NIL)))
|
||||
(if (SETQ RESULT (\TEDIT.BASICFIND TSTREAM TARGET START END ANCHORED))
|
||||
then (CL:UNLESS (CDR TARGETTAIL) (* ; "Success!")
|
||||
(RETURN (LIST (OR HITSTART (CAR RESULT))
|
||||
(CADR RESULT))))
|
||||
(SETQ START (ADD1 (CADR RESULT))) (* ; "Next target")
|
||||
(CL:WHEN (ILEQ START END)
|
||||
[push STACK (LIST START (CDR TARGETTAIL)
|
||||
(OR HITSTART (CAR RESULT])
|
||||
elseif (NOT ANCHORED)
|
||||
then (RETURN NIL])])
|
||||
|
||||
(\TEDIT.BASICFIND
|
||||
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Feb-2025 12:24 by rmk")
|
||||
(* ; "Edited 23-Jun-2024 12:03 by rmk")
|
||||
(* ; "Edited 22-Jun-2024 12:01 by rmk")
|
||||
(* ; "Edited 19-May-2024 23:18 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 00:11 by rmk")
|
||||
(* ; "Edited 30-May-91 20:56 by jds")
|
||||
|
||||
(* ;; "Search thru TEXTOBJ, starting where the caret is, for an exact match of TARGETSTRING. Optionally, start the search at character START. ")
|
||||
(* ;; "Search thru TSTREAM for an exact match of TARGETSTRING. ")
|
||||
|
||||
(* ;; "Returns a (startmatch endmatch) pair of character positions in TSTREAM")
|
||||
|
||||
(bind LASTANCHOR (NCHARS _ (NCHARS TARGETSTRING))
|
||||
(CHAR1 _ (NTHCHARCODE TARGETSTRING 1))
|
||||
(ANCHOR _ (SUB1 START)) first [SETQ LASTANCHOR (ADD1 (CL:IF ANCHORED
|
||||
(ANCHOR _ (SUB1 START)) first (CL:WHEN (ZEROP NCHARS)
|
||||
(RETURN NIL))
|
||||
[SETQ LASTANCHOR (ADD1 (CL:IF ANCHORED
|
||||
ANCHOR
|
||||
(IDIFFERENCE END NCHARS))]
|
||||
eachtime (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
|
||||
(IDIFFERENCE END NCHARS))]
|
||||
|
||||
(* ;; "Match failed, bump the start--single char wild-card # always matches")
|
||||
while [SETQ ANCHOR (find A from (ADD1 ANCHOR) to LASTANCHOR suchthat (EQ CHAR1 (BIN TSTREAM]
|
||||
when [OR (EQ NCHARS 1)
|
||||
(for I from 2 to NCHARS always (EQ (NTHCHARCODE TARGETSTRING I)
|
||||
(BIN TSTREAM]
|
||||
do (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
|
||||
(* ;; "LASTANCHOR protects us from running into the EOF")
|
||||
eachtime (CL:WHEN (IGEQ ANCHOR LASTANCHOR)
|
||||
(RETURN NIL))
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
|
||||
(add ANCHOR 1) (* ; "Move the anchor up 1")
|
||||
|
||||
(* ;; "Match failed, bump the start--single char wild-card # always matches")
|
||||
|
||||
when (for I from 1 do (CL:UNLESS (EQ (NTHCHARCODE TARGETSTRING I)
|
||||
(BIN TSTREAM))
|
||||
(RETURN NIL))
|
||||
(CL:WHEN (EQ I NCHARS) (* ; "Matched the last char")
|
||||
(RETURN T))) do (FSETTOBJ (GETTSTR TSTREAM TEXTOBJ)
|
||||
LASTARROWX NIL)
|
||||
(RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
|
||||
|
||||
(\TEDIT.WCFIND.BACKWARD
|
||||
[LAMBDA (TSTREAM TARGETLIST START END HITEND ANCHORED) (* ; "Edited 17-Mar-2024 11:59 by rmk")
|
||||
[LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:05 by rmk")
|
||||
(* ; "Edited 23-Jun-2024 12:02 by rmk")
|
||||
(* ; "Edited 19-May-2024 23:46 by rmk")
|
||||
(* ; "Edited 3-May-2024 07:11 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 20:45 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 11:59 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 13:52 by rmk")
|
||||
|
||||
(* ;; "Returns the (start end) pair of a match possibly with wild cards, where HITEND is the last character of such a match")
|
||||
(* ;; "Returns the (start end) pair of the nearest match somewhere at or after START, possibly with wild cards. The basic-find does fast search of simple strings. This is all about backtracking to advance the search on failure, and for wild cards. Note that *'s do not appear on the edges.")
|
||||
|
||||
(LET (RESULT)
|
||||
(COND
|
||||
((NULL TARGETLIST) (* ; "Final match")
|
||||
(LIST (ADD1 (\TEDIT.TEXTGETFILEPTR TSTREAM))
|
||||
(OR HITEND END)))
|
||||
[(EQ '%# (CAR TARGETLIST)) (* ;
|
||||
"Single-char wildcard, next segment is anchored ")
|
||||
(OR (\TEDIT.WCFIND.BACKWARD TSTREAM (CDR TARGETLIST)
|
||||
START
|
||||
(SUB1 END)
|
||||
(OR HITEND END)
|
||||
T)
|
||||
(CL:UNLESS ANCHORED (* ;
|
||||
"Initial # didn't match, let it slide in this loop")
|
||||
(for E from (SUB1 END) to START by -1
|
||||
when (SETQ RESULT (\TEDIT.WCFIND.BACKWARD TSTREAM TARGETLIST START E E T))
|
||||
do (RETURN RESULT)))]
|
||||
((EQ '* (CAR TARGETLIST))
|
||||
(CL:WHEN TARGETLIST
|
||||
[bind STACK CONFIG HITEND ANCHORED RESULT TARGETTAIL TARGET (TOPEND _ (ADD1 END))
|
||||
do (SETQ CONFIG (pop STACK))
|
||||
(if CONFIG
|
||||
then (SETQ END (pop CONFIG))
|
||||
(SETQ TARGETTAIL (pop CONFIG))
|
||||
(SETQ HITEND (pop CONFIG))
|
||||
(SETQ ANCHORED (pop CONFIG))
|
||||
elseif (ILEQ TOPEND START)
|
||||
then (RETURN NIL) (* ; "No more, failed")
|
||||
else (add TOPEND -1) (* ; "First time or outer advance")
|
||||
(SETQ END TOPEND)
|
||||
(SETQ TARGETTAIL TARGETLIST)
|
||||
(SETQ HITEND NIL)
|
||||
(SETQ ANCHORED NIL))
|
||||
(SETQ TARGET (CAR TARGETTAIL))
|
||||
(SELECTQ TARGET
|
||||
(%# (CL:UNLESS (CDR TARGETTAIL)
|
||||
(RETURN (LIST END (OR HITEND END))))
|
||||
(CL:WHEN (ILEQ START END) (* ;
|
||||
"If we are unanchored, slipping continues")
|
||||
(push STACK (LIST (SUB1 END)
|
||||
(CDR TARGETTAIL)
|
||||
(OR HITEND (SUB1 END))
|
||||
ANCHORED))))
|
||||
(*
|
||||
(* ;; "Unanchored config for the tail that starts here.")
|
||||
|
||||
(* ;; "Variable width wildcard, not anchored so the match can slide along.")
|
||||
|
||||
(\TEDIT.WCFIND.BACKWARD TSTREAM (CDR TARGETLIST)
|
||||
START END HITEND))
|
||||
((SETQ RESULT (\TEDIT.BASICFIND.BACKWARD TSTREAM (CAR TARGETLIST)
|
||||
START END ANCHORED)) (* ;
|
||||
"Matched a string segment, keep going")
|
||||
(\TEDIT.WCFIND.BACKWARD TSTREAM (CDR TARGETLIST)
|
||||
START
|
||||
(SUB1 (CAR RESULT))
|
||||
(OR HITEND (CADR RESULT])
|
||||
(push STACK (LIST END (CDR TARGETTAIL)
|
||||
HITEND NIL)))
|
||||
(if (SETQ RESULT (\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START END ANCHORED))
|
||||
then (CL:UNLESS (CDR TARGETTAIL) (* ; "Success!")
|
||||
[RETURN (LIST (CAR RESULT)
|
||||
(OR HITEND (CADR RESULT])
|
||||
(SETQ END (SUB1 (CADR RESULT))) (* ; "Next target")
|
||||
(CL:WHEN (ILEQ START END)
|
||||
[push STACK (LIST END (CDR TARGETTAIL)
|
||||
(OR HITEND (CADR RESULT])
|
||||
elseif (NOT ANCHORED)
|
||||
then (RETURN NIL])])
|
||||
|
||||
(\TEDIT.BASICFIND.BACKWARD
|
||||
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
(* ; "Edited 12-Jul-2023 08:14 by rmk")
|
||||
(* ; "Edited 23-Apr-2023 12:42 by rmk")
|
||||
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 23-Jun-2024 11:32 by rmk")
|
||||
(* ; "Edited 19-May-2024 23:07 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 00:11 by rmk")
|
||||
(* ; "Edited 30-May-91 20:56 by jds")
|
||||
|
||||
(* ;; "Returns a (Startmatch Endmatch) pair of character positions in TSTREAM that denote the nearest occurrence of TARGETSTRING whose first character is at or ahead of START and whose last character is at or before END. ")
|
||||
(* ;; "Seach backwards thru TSTREAM for an exact match of TARGETSTRING.")
|
||||
|
||||
(* ;; "A better interface would return a selection for the string-match, but we repeat the pair interface that is documented for forward search.")
|
||||
(* ;; "Returns a (startmatch endmatch) pair of character positions in TSTREAM")
|
||||
|
||||
(* ;;
|
||||
"Note that caller must decrement END in subsequent calls to avoid looping on the same match.")
|
||||
(bind LASTANCHOR (NCHARS _ (NCHARS TARGETSTRING))
|
||||
(ANCHOR _ (ADD1 END)) first (CL:WHEN (ZEROP NCHARS)
|
||||
(RETURN NIL))
|
||||
(CL:WHEN ANCHORED
|
||||
(SETQ START (IDIFFERENCE ANCHOR NCHARS)))
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "LASTANCHOR protects agains the beginning of the stream")
|
||||
|
||||
(* ;; "The last target character first matches at END. Setting the initial ANCHOR one past END and going into the anchor backup loop won't work if END points to the last character in the stream--the \TEXTSETFILEPTR would be out of bounds. So the first anchor-match has to be special, by setting the fileptr at END and peeking.")
|
||||
|
||||
[SETQ END (IMIN END (TEXTLEN (TEXTOBJ TSTREAM]
|
||||
(bind ANCHOR LASTANCHOR (NCHARS1 _ (SUB1 (NCHARS TARGETSTRING)))
|
||||
(CHARN _ (NTHCHARCODE TARGETSTRING -1))
|
||||
first
|
||||
(* ;; "NCHARS1 because the last character is matched separately.")
|
||||
|
||||
(CL:WHEN (ILESSP (IDIFFERENCE END START)
|
||||
NCHARS1) (* ; "Too few characters")
|
||||
(RETURN NIL))
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 END))
|
||||
(CL:WHEN [AND (EQ CHARN (\TEDIT.TEXTPEEKBIN TSTREAM))
|
||||
(OR (EQ NCHARS1 0)
|
||||
(for I from NCHARS1 to 1 by -1 always (EQ (NTHCHARCODE TARGETSTRING I)
|
||||
(\TEDIT.TEXTBACKFILEPTR
|
||||
TSTREAM]
|
||||
(RETURN (LIST (IDIFFERENCE END NCHARS1)
|
||||
END)))
|
||||
(CL:WHEN ANCHORED (* ; "Anchored at END, didn't match")
|
||||
(RETURN NIL))
|
||||
(SETQ ANCHOR (SUB1 END))
|
||||
(SETQ LASTANCHOR (IPLUS START NCHARS1)) eachtime (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
|
||||
(* ;
|
||||
"The filepos one before the last CHARN match")
|
||||
(ADD ANCHOR -1)
|
||||
(* ; "For next attempt")
|
||||
while (find old ANCHOR from ANCHOR to LASTANCHOR by -1 suchthat (EQ CHARN (
|
||||
\TEDIT.TEXTBACKFILEPTR
|
||||
TSTREAM)))
|
||||
when [OR (EQ NCHARS1 0)
|
||||
(for I from NCHARS1 to 1 by -1 always (EQ (NTHCHARCODE TARGETSTRING I)
|
||||
(\TEDIT.TEXTBACKFILEPTR TSTREAM]
|
||||
do (ADD ANCHOR 1)
|
||||
(RETURN (LIST (IDIFFERENCE ANCHOR NCHARS1)
|
||||
ANCHOR])
|
||||
[SETQ LASTANCHOR (SUB1 (CL:IF ANCHORED
|
||||
ANCHOR
|
||||
(IPLUS START NCHARS))]
|
||||
eachtime (CL:WHEN (ILESSP ANCHOR LASTANCHOR) (* ; "Won't fit in the frame")
|
||||
(RETURN NIL))
|
||||
(add ANCHOR -1) (* ; "Move the anchor back 1")
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
|
||||
when (for I from 1 do (CL:UNLESS (EQ (NTHCHARCODE TARGETSTRING I)
|
||||
(\TEDIT.TEXTBACKFILEPTR TSTREAM))
|
||||
(RETURN NIL))
|
||||
(CL:WHEN (EQ I NCHARS) (* ; "Matched the last char")
|
||||
(RETURN T))) do (RETURN (LIST (IDIFFERENCE (ADD1 ANCHOR)
|
||||
NCHARS)
|
||||
ANCHOR])
|
||||
|
||||
(\TEDIT.PARSE.SEARCHSTRING
|
||||
[LAMBDA (TARGETSTRING) (* ; "Edited 19-Jun-2023 16:42 by rmk")
|
||||
[LAMBDA (TARGETSTRING BACKWARD) (* ; "Edited 23-Jun-2024 08:02 by rmk")
|
||||
(* ; "Edited 19-May-2024 22:43 by rmk")
|
||||
(* ; "Edited 19-Jun-2023 16:42 by rmk")
|
||||
(* jds "31-Jan-84 13:26")
|
||||
|
||||
(* ;;
|
||||
"Quote Is an escape if it comes before a wild card. ''# would match ' in front of literal .")
|
||||
(* ;; "Parse TARGETSTRING into string-segments that are separated by the wild-card characters # and * (or escape). Each # is left as its own segment, multiple *'s collapse to one, and *'s on the edges are removed. ' quotes the following character.")
|
||||
|
||||
(for TTAIL C SEG on (CHCON TARGETSTRING)
|
||||
do (SETQ C (CAR TTAIL))
|
||||
(SELCHARQ C
|
||||
(%' (if (MEMB (CADR TTAIL)
|
||||
(CHARCODE (%# *)))
|
||||
then (POP TTAIL)
|
||||
(PUSH SEG (CAR TTAIL))
|
||||
else (PUSH SEG C)))
|
||||
(%# (CL:WHEN SEG
|
||||
(push $$VAL (CONCATCODES (DREVERSE SEG))))
|
||||
(push $$VAL (CHARACTER C))
|
||||
(SETQ SEG NIL))
|
||||
(* (CL:UNLESS (EQ (CAR $$VAL)
|
||||
'*) (* ; "Reduce adjacent *s to one.")
|
||||
(CL:WHEN SEG
|
||||
(push $$VAL (CONCATCODES (DREVERSE SEG))))
|
||||
(CL:UNLESS $$VAL (* ; "Ignore leading *")
|
||||
(push $$VAL (CHARACTER C)))
|
||||
(SETQ SEG NIL)))
|
||||
(PUSH SEG C)) finally [if SEG
|
||||
then (PUSH $$VAL (CONCATCODES (DREVERSE SEG)))
|
||||
else (* ; "Ignore trailing *")
|
||||
(SETQ $$VAL (find VTAIL on $$VAL
|
||||
suchthat (NEQ (CAR $$VAL)
|
||||
'*]
|
||||
(RETURN (CL:IF $$VAL
|
||||
(DREVERSE $$VAL)
|
||||
TARGETSTRING)])
|
||||
(* ;; "If BACKWARD, the search string segments are reverse, and the characters within each segment are reversed, so that the search can go backwards.")
|
||||
|
||||
(* ;; " ")
|
||||
|
||||
(for CTAIL C SEGCODES on (CHCON TARGETSTRING) eachtime (SETQ C (CAR CTAIL))
|
||||
do (SELCHARQ C
|
||||
((* ESCAPE) (* ;
|
||||
"Throw away the first and multiiple *'s")
|
||||
(CL:WHEN SEGCODES
|
||||
[push $$VAL (CONCATCODES (CL:IF BACKWARD
|
||||
SEGCODES
|
||||
(DREVERSE SEGCODES))]
|
||||
(SETQ SEGCODES NIL))
|
||||
(CL:WHEN (AND $$VAL (NEQ '* (CAR $$VAL)))
|
||||
(push $$VAL '*)))
|
||||
(%# (* ; "# stands alone")
|
||||
(CL:WHEN SEGCODES
|
||||
[push $$VAL (CONCATCODES (CL:IF BACKWARD
|
||||
SEGCODES
|
||||
(DREVERSE SEGCODES))])
|
||||
(push $$VAL '%#)
|
||||
(SETQ SEGCODES NIL))
|
||||
(%' (* ; "Quote the next character")
|
||||
(CL:WHEN (CDR CTAIL)
|
||||
(push SEGCODES (CADR CTAIL))
|
||||
(SETQ CTAIL (CDR CTAIL))))
|
||||
(push SEGCODES C)) finally (if SEGCODES
|
||||
then [push $$VAL (CONCATCODES (CL:IF BACKWARD
|
||||
SEGCODES
|
||||
(DREVERSE SEGCODES))]
|
||||
elseif (EQ '* (CAR $$VAL))
|
||||
then
|
||||
(* ;; "Strip the first edge *")
|
||||
|
||||
(pop $$VAL))
|
||||
(RETURN (CL:IF BACKWARD
|
||||
$$VAL
|
||||
(DREVERSE $$VAL))])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (832 18922 (TEDIT.FIND 842 . 2482) (TEDIT.FIND.BACKWARD 2484 . 4297) (TEDIT.SUBSTITUTE
|
||||
4299 . 14915) (TEDIT.NEXT 14917 . 18920)) (18955 30060 (\TEDIT.WCFIND 18965 . 20966) (\TEDIT.BASICFIND
|
||||
20968 . 22446) (\TEDIT.WCFIND.BACKWARD 22448 . 24507) (\TEDIT.BASICFIND.BACKWARD 24509 . 28037) (
|
||||
\TEDIT.PARSE.SEARCHSTRING 28039 . 30058)))))
|
||||
(FILEMAP (NIL (784 22132 (TEDIT.FIND 794 . 2793) (TEDIT.FIND.BACKWARD 2795 . 5117) (TEDIT.SUBSTITUTE
|
||||
5119 . 17479) (TEDIT.NEXT 17481 . 22130)) (22165 36861 (\TEDIT.WCFIND 22175 . 25694) (\TEDIT.BASICFIND
|
||||
25696 . 28055) (\TEDIT.WCFIND.BACKWARD 28057 . 31521) (\TEDIT.BASICFIND.BACKWARD 31523 . 33780) (
|
||||
\TEDIT.PARSE.SEARCHSTRING 33782 . 36859)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Mar-2024 14:07:55" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;74 32961
|
||||
(FILECREATED "17-Feb-2025 09:12:22" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;121 48129
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.LCASE.SEL \TEDIT.UCASE.SEL \TEDIT.KEY.FIND)
|
||||
:CHANGES-TO (FNS \TEDIT.ONECHAR.FORWARD \TEDIT.ONECHAR.BACKWARD)
|
||||
|
||||
:PREVIOUS-DATE " 9-Mar-2024 11:47:31" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;69)
|
||||
:PREVIOUS-DATE "16-Feb-2025 20:44:51" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;120)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
|
||||
@@ -17,12 +17,15 @@
|
||||
|
||||
(FNS \TEDIT.BOLD.SEL.OFF \TEDIT.BOLD.SEL.ON \TEDIT.CENTER.SEL \TEDIT.CENTER.SEL.REV
|
||||
\TEDIT.DEFAULTS.CARET \TEDIT.DEFAULTSSEL \TEDIT.SETDEFAULT.FROM.SEL
|
||||
\TEDIT.KEY.FIND \TEDIT.GET.TARGET.STRING \TEDIT.KEY.FIND.BACKWARD
|
||||
\TEDIT.FINDAGAIN.BACKWARD \TEDIT.FINDAGAIN \TEDIT.ITALIC.SEL.OFF
|
||||
\TEDIT.ITALIC.SEL.ON \TEDIT.LARGERSEL \TEDIT.LCASE.SEL \TEDIT.SHOWCARETLOOKS
|
||||
\TEDIT.SMALLERSEL \TEDIT.SUBSCRIPTSEL \TEDIT.SUPERSCRIPTSEL \TEDIT.UCASE.SEL
|
||||
\TEDIT.UNDERLINE.SEL.OFF \TEDIT.UNDERLINE.SEL.ON \TEDIT.STRIKEOUT.SEL.ON
|
||||
\TEDIT.STRIKEOUT.SEL.OFF \TEDIT.SELECT.ALL \TEDIT.KEY.SUBSTITUTE))
|
||||
\TEDIT.KEY.FIND \TEDIT.KEY.FIND.SEARCHSTRING \TEDIT.GET.TARGET.STRING
|
||||
\TEDIT.KEY.FIND.BACKWARD \TEDIT.FINDAGAIN.BACKWARD \TEDIT.FINDAGAIN
|
||||
\TEDIT.ITALIC.SEL.OFF \TEDIT.ITALIC.SEL.ON \TEDIT.LARGERSEL \TEDIT.LCASE.SEL
|
||||
\TEDIT.SHOWCARETLOOKS \TEDIT.SMALLERSEL \TEDIT.SUBSCRIPTSEL \TEDIT.SUPERSCRIPTSEL
|
||||
\TEDIT.UCASE.SEL \TEDIT.UNDERLINE.SEL.OFF \TEDIT.UNDERLINE.SEL.ON
|
||||
\TEDIT.STRIKEOUT.SEL.ON \TEDIT.STRIKEOUT.SEL.OFF \TEDIT.SELECT.ALL
|
||||
\TEDIT.KEY.SUBSTITUTE \TEDIT.MANPAGE \TEDIT.CALL.ED))
|
||||
(FNS \TEDIT.ONECHAR.BACKWARD \TEDIT.ONECHAR.FORWARD \TEDIT.ONELINE.UP \TEDIT.ONELINE.DOWN
|
||||
\TEDIT.ONELINE.MOVE)
|
||||
(COMS
|
||||
(* ;; "Auxiliary functions used in the above main functions:")
|
||||
|
||||
@@ -69,12 +72,16 @@
|
||||
("Function,^A" FN \TEDIT.SHOWCARETLOOKS)
|
||||
("Meta,a" FN \TEDIT.SELECT.ALL)
|
||||
("Meta,A" FN \TEDIT.SELECT.ALL)
|
||||
("Meta,d" FN \TEDIT.MANPAGE)
|
||||
("Meta,D" FN \TEDIT.MANPAGE)
|
||||
("Meta,F" FN \TEDIT.KEY.FIND.BACKWARD)
|
||||
("Meta,f" FN \TEDIT.KEY.FIND)
|
||||
("Meta,g" FN \TEDIT.FINDAGAIN)
|
||||
("Meta,G" FN \TEDIT.FINDAGAIN.BACKWARD)
|
||||
("Meta,N" NEXT)
|
||||
("Meta,n" NEXT)
|
||||
("Meta,o" FN \TEDIT.CALL.ED)
|
||||
("Meta,O" FN \TEDIT.CALL.ED)
|
||||
("Meta,p" FN \TEDIT.PRINT.MENU)
|
||||
("Meta,P" FN \TEDIT.PRINT.MENU)
|
||||
("Meta,r" REDO)
|
||||
@@ -84,7 +91,13 @@
|
||||
("Meta,U" FN \TEDIT.UNDO.UNDO)
|
||||
("Meta,u" UNDO)
|
||||
("Meta,z" UNDO)
|
||||
("Meta,Z" \TEDIT.UNDO.UNDO]
|
||||
("Meta,Z" \TEDIT.UNDO.UNDO)
|
||||
("Meta,<" FN \TEDIT.ONECHAR.BACKWARD)
|
||||
("Meta,," FN \TEDIT.ONECHAR.BACKWARD)
|
||||
("Meta,>" FN \TEDIT.ONECHAR.FORWARD)
|
||||
("Meta,." FN \TEDIT.ONECHAR.FORWARD)
|
||||
("Meta,^" FN \TEDIT.ONELINE.UP)
|
||||
("Meta,LF" FN \TEDIT.ONELINE.DOWN]
|
||||
(P (MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY)
|
||||
(SELECTQ (CADR ENTRY)
|
||||
(FN (TEDIT.SETFUNCTION (CAR ENTRY)
|
||||
@@ -164,92 +177,125 @@
|
||||
NIL TEXTOBJ])
|
||||
|
||||
(\TEDIT.KEY.FIND
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN BACKWARD) (* ; "Edited 15-Mar-2024 13:36 by rmk")
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL AGAIN BACKWARD SEARCHSTRING) (* ; "Edited 26-Nov-2024 23:47 by rmk")
|
||||
(* ; "Edited 23-Nov-2024 16:25 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:47 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 16:20 by rmk")
|
||||
(* ; "Edited 22-Jun-2024 10:00 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:29 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:36 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 23:39 by rmk")
|
||||
(* ; "Edited 9-Mar-2024 11:36 by rmk")
|
||||
(* ; "Edited 29-Feb-2024 17:06 by rmk")
|
||||
(* ; "Edited 27-Feb-2024 00:22 by rmk")
|
||||
(* ; "Edited 16-Feb-2024 23:43 by rmk")
|
||||
(* ; "Edited 14-Dec-2023 21:14 by rmk")
|
||||
(* ; "Edited 12-Jul-2023 08:26 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 13:06 by rmk")
|
||||
(* ; "Edited 6-May-2018 17:14 by rmk:")
|
||||
(* ; "Edited 30-May-91 21:05 by jds")
|
||||
|
||||
(* ;; "just calls the normal tedit.find starting at the right of the current selection. SEL is passed from the FN key in the readtable, presumably always (fetch SEL of TEXTOBJ).")
|
||||
(* ;; "Case sensitive search, with * and # wildcards. Just calls the normal tedit.find starting at the right of the current selection. SEL is passed from the FN key in the readtable, presumably always (fetch SEL of TEXTOBJ).")
|
||||
|
||||
(* ;; "AGAIN suppresses confirmation of a previous target, but also assumes that the user is not interested in trying again at the current character position--starts forward or backward from there.")
|
||||
(* ;; "AGAIN suppresses confirmation of a previous target.")
|
||||
|
||||
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
|
||||
TARGET CH) (* ;
|
||||
"Case sensitive search, with * and # wildcards")
|
||||
|
||||
(* ;; "TEDIT.LAST.FIND.STRING used to be stored as a window property. But then it would only pertain to a particular pane. Better store it on the textobj.")
|
||||
|
||||
(CL:WHEN AGAIN
|
||||
(SETQ TARGET (GETTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING)))
|
||||
(CL:UNLESS TARGET
|
||||
(SETQ AGAIN NIL) (* ;
|
||||
"If no previous target, we aren't %"again%"")
|
||||
[SETQ TARGET (TEDIT.GETINPUT TEXTOBJ (CL:IF BACKWARD
|
||||
"Backward search string: "
|
||||
"Search string: ")
|
||||
(\TEDIT.GET.TARGET.STRING TEXTOBJ 'TEDIT.LAST.FIND.STRING])
|
||||
(CL:WHEN TARGET
|
||||
(CL:UNLESS SEL
|
||||
(SETQ SEL (FGETTOBJ TEXTOBJ SEL)))
|
||||
(\TEDIT.SHOWSEL SEL NIL) (* ;
|
||||
"Save for next search, even if not found")
|
||||
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING TARGET)
|
||||
(SETQ CH (if BACKWARD
|
||||
then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching backward for %"" TARGET
|
||||
"%"")
|
||||
T)
|
||||
(TEDIT.FIND.BACKWARD TEXTOBJ (MKSTRING TARGET)
|
||||
NIL NIL T)
|
||||
else (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching for %"" TARGET "%"")
|
||||
T)
|
||||
(TEDIT.FIND TEXTOBJ (MKSTRING TARGET)
|
||||
NIL NIL T)))
|
||||
(COND
|
||||
(CH (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" found")
|
||||
T) (* ; "We found the target text.")
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:UNLESS TEXTOBJ
|
||||
(SETQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
||||
(RESETLST
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Find")
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
CH)
|
||||
(CL:UNLESS SEARCHSTRING
|
||||
(SETQ SEARCHSTRING (\TEDIT.KEY.FIND.SEARCHSTRING TEXTOBJ AGAIN BACKWARD)))
|
||||
(CL:WHEN (AND SEARCHSTRING (IGEQ (NCHARS SEARCHSTRING)
|
||||
1))
|
||||
(CL:UNLESS SEL
|
||||
(SETQ SEL (FGETTOBJ TEXTOBJ SEL)))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(SETQ CH (if BACKWARD
|
||||
then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching backward for %""
|
||||
SEARCHSTRING "%"")
|
||||
T)
|
||||
(TEDIT.FIND.BACKWARD TSTREAM (MKSTRING SEARCHSTRING)
|
||||
NIL NIL T)
|
||||
else (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching for %"" SEARCHSTRING
|
||||
"%"")
|
||||
T)
|
||||
(TEDIT.FIND TSTREAM (MKSTRING SEARCHSTRING)
|
||||
NIL NIL T)))
|
||||
(if CH
|
||||
then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" SEARCHSTRING "%" found")
|
||||
T) (* ; "We found the target text.")
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(* ;
|
||||
"Set up SELECTION to be the found text")
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR CH)
|
||||
(ADD1 (IDIFFERENCE (CADR CH)
|
||||
(CAR CH)))
|
||||
(CL:IF BACKWARD
|
||||
'LEFT
|
||||
'RIGHT))
|
||||
(TEDIT.SET.SEL.LOOKS SEL (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY)
|
||||
'PENDINGDEL
|
||||
'NORMAL))
|
||||
[SETSEL SEL SELKIND (CL:IF (IGREATERP (CADR CH)
|
||||
(CAR CH)
|
||||
'WORD
|
||||
'CHAR]
|
||||
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" not found")
|
||||
T)))
|
||||
(\TEDIT.SHOWSEL SEL T))])
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR CH)
|
||||
(ADD1 (IDIFFERENCE (CADR CH)
|
||||
(CAR CH)))
|
||||
(CL:IF BACKWARD
|
||||
'LEFT
|
||||
'RIGHT)
|
||||
(CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY)
|
||||
'PENDINGDEL
|
||||
'NORMAL))
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
[SETSEL SEL SELKIND (CL:IF (IGREATERP (CADR CH)
|
||||
(CAR CH)
|
||||
'WORD
|
||||
'CHAR]
|
||||
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ)
|
||||
else (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" SEARCHSTRING "%" not found")
|
||||
T))
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ))))])
|
||||
|
||||
(\TEDIT.KEY.FIND.SEARCHSTRING
|
||||
[LAMBDA (TEXTOBJ AGAIN BACKWARD) (* ; "Edited 22-Jun-2024 10:17 by rmk")
|
||||
|
||||
(* ;; "TEDIT.LAST.FIND.STRING used to be stored as a window property. But then it would only pertain to a particular pane. Better store it on the textobj.")
|
||||
|
||||
(LET (SEARCHSTRING)
|
||||
(CL:WHEN AGAIN
|
||||
(SETQ SEARCHSTRING (GETTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING)))
|
||||
(CL:UNLESS SEARCHSTRING
|
||||
(SETQ SEARCHSTRING (\TEDIT.GET.TARGET.STRING TEXTOBJ 'TEDIT.LAST.FIND.STRING))
|
||||
(SETQ SEARCHSTRING (TEDIT.GETINPUT TEXTOBJ (CL:IF BACKWARD
|
||||
"Backward search string: "
|
||||
"Search string: ")
|
||||
SEARCHSTRING))
|
||||
(CL:WHEN SEARCHSTRING (* ;
|
||||
"Save for next search, even if not found")
|
||||
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING SEARCHSTRING)))
|
||||
SEARCHSTRING])
|
||||
|
||||
(\TEDIT.GET.TARGET.STRING
|
||||
[LAMBDA (TEXTOBJ PROP) (* ; "Edited 29-Feb-2024 17:08 by rmk")
|
||||
[LAMBDA (TEXTOBJ PROP) (* ; "Edited 14-Jul-2024 00:09 by rmk")
|
||||
(* ; "Edited 23-Jun-2024 23:06 by rmk")
|
||||
(* ; "Edited 22-Jun-2024 12:03 by rmk")
|
||||
(* ; "Edited 29-Feb-2024 17:08 by rmk")
|
||||
|
||||
(* ;; "This is called from \TEDIT.KEY.FIND, TEDIT.DEFAULT.MENUFN, TEDIT.SUBSTITUTE. It tries to determine the best tentative target string for a search. PROP is either TEDIT.LAST.FIND.STRING or TEDIT.LAST.SUBSTITUTE.STRING.")
|
||||
(* ;; "This is called from \TEDIT.KEY.FIND, TEDIT.DEFAULT.MENUFN. It tries to determine the best tentative target string for a search. PROP is presumably TEDIT.LAST.FIND.STRING.")
|
||||
|
||||
(* ;; "Current heuristic: use selection if longer than 1 character, otherwise last search string. Note that meta-G goes directly to the last search.")
|
||||
(* ;; "Current heuristic: If a previous string, use it if it contains wild cards, otherwise the current non-point selection. Note that meta-G goes directly to the last search.")
|
||||
|
||||
(if (GETTEXTPROP TEXTOBJ PROP)
|
||||
then (if (IGREATERP (GETSEL (GETTOBJ TEXTOBJ SEL)
|
||||
DCH)
|
||||
(* ;; "TEDIT.SUBSTITUTE doesn't call this because the current selection is the search domain")
|
||||
|
||||
(LET [(PREV (STRINGP (GETTEXTPROP TEXTOBJ PROP]
|
||||
(if [AND PREV (find I from 1 to (NCHARS PREV)
|
||||
suchthat (AND (MEMB (NTHCHARCODE PREV I)
|
||||
(CHARCODE (%# ESCAPE *)))
|
||||
(NEQ (CHARCODE %')
|
||||
(NTHCHARCODE PREV (SUB1 I]
|
||||
then PREV
|
||||
elseif (IGEQ (FGETSEL (FGETTOBJ TEXTOBJ SEL)
|
||||
DCH)
|
||||
1)
|
||||
then (TEDIT.SEL.AS.STRING TEXTOBJ)
|
||||
else (GETTEXTPROP TEXTOBJ PROP))
|
||||
else (TEDIT.SEL.AS.STRING TEXTOBJ])
|
||||
then
|
||||
(* ;; "TEDIT.SEL.AS.STRING breaks on image objects, should be fixed there.")
|
||||
|
||||
(CAR (NLSETQ (TEDIT.SEL.AS.STRING TEXTOBJ)))
|
||||
else PREV])
|
||||
|
||||
(\TEDIT.KEY.FIND.BACKWARD
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN) (* ; "Edited 20-Jun-2023 13:57 by rmk")
|
||||
@@ -287,7 +333,8 @@
|
||||
SEL])
|
||||
|
||||
(\TEDIT.LCASE.SEL
|
||||
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2024 13:57 by rmk")
|
||||
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 7-Jul-2024 09:05 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:57 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 12:28 by rmk")
|
||||
(* ; "Edited 28-May-2023 00:34 by rmk")
|
||||
(* ; "Edited 24-May-2023 22:46 by rmk")
|
||||
@@ -296,7 +343,8 @@
|
||||
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY (
|
||||
\TEDIT.SELPIECES
|
||||
SEL))
|
||||
SEL NIL TEXTOBJ
|
||||
))
|
||||
(FUNCTION L-CASECODE)
|
||||
NIL TEXTOBJ)
|
||||
TEXTOBJ SEL)
|
||||
@@ -345,7 +393,8 @@
|
||||
SEL])
|
||||
|
||||
(\TEDIT.UCASE.SEL
|
||||
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2024 13:57 by rmk")
|
||||
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 7-Jul-2024 09:04 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:57 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 12:56 by rmk")
|
||||
(* ; "Edited 28-May-2023 00:33 by rmk")
|
||||
(* ; "Edited 24-May-2023 22:45 by rmk")
|
||||
@@ -354,7 +403,8 @@
|
||||
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY (
|
||||
\TEDIT.SELPIECES
|
||||
SEL))
|
||||
SEL NIL TEXTOBJ
|
||||
))
|
||||
(FUNCTION U-CASECODE)
|
||||
NIL TEXTOBJ)
|
||||
TEXTOBJ SEL)
|
||||
@@ -382,8 +432,9 @@
|
||||
SEL])
|
||||
|
||||
(\TEDIT.SELECT.ALL
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 12:41 by rmk:")
|
||||
(TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of TEXTOBJ))
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 29-Jun-2024 15:05 by rmk")
|
||||
(* ; "Edited 6-May-2018 12:41 by rmk:")
|
||||
(TEDIT.SETSEL TEXTSTREAM 1 (GETTOBJ TEXTOBJ TEXTLEN)
|
||||
'LEFT])
|
||||
|
||||
(\TEDIT.KEY.SUBSTITUTE
|
||||
@@ -392,6 +443,186 @@
|
||||
(* ;; "Stub for function-key")
|
||||
|
||||
(TEDIT.SUBSTITUTE TEXTSTREAM NIL NIL T])
|
||||
|
||||
(\TEDIT.MANPAGE
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 18-Jan-2025 21:48 by rmk")
|
||||
(* ; "Edited 29-Dec-2024 08:40 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
(* ; "Edited 26-May-2024 21:53 by rmk")
|
||||
(* ; "Edited 25-May-2024 14:50 by rmk")
|
||||
|
||||
(* ;; "If meta-D is typed in an existing DINFO window, the new stuff comes up but then the window closes. That could be debugged, but probably not worth it. The DINFO window has its own links to things that it thought were worth indexing.")
|
||||
|
||||
(CL:UNLESS (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
|
||||
'DINFOGRAPH)
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
[LET ((KEY (TEDIT.SEL.AS.STRING TSTREAM SEL)))
|
||||
(if (OR (NULL KEY)
|
||||
(EQ 0 (NCHARS KEY)))
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "Please select a man-page key" T T)
|
||||
else (GENERIC.MAN.LOOKUP (TEDIT.SEL.AS.STRING TSTREAM SEL])])
|
||||
|
||||
(\TEDIT.CALL.ED
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 18-Jan-2025 23:38 by rmk")
|
||||
(* ; "Edited 29-Dec-2024 08:46 by rmk")
|
||||
(* ; "Edited 25-May-2024 15:03 by rmk")
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
(LET [(SYMBOL (MKATOM (CAR (MKLIST (TEDIT.SEL.AS.SEXPR TSTREAM SEL]
|
||||
(if (OR (NULL SYMBOL)
|
||||
(EQ 0 (NCHARS SYMBOL)))
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "Please select a symbol to edit" T T)
|
||||
elseif (TYPESOF SYMBOL)
|
||||
then (ED SYMBOL `(:DONTWAIT :DISPLAY))
|
||||
else (TEDIT.PROMPTPRINT TSTREAM (CONCAT SYMBOL " has no definitions to edit")
|
||||
T T])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.ONECHAR.BACKWARD
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 17-Feb-2025 09:12 by rmk")
|
||||
(* ; "Edited 24-Jan-2025 15:25 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 20:31 by rmk")
|
||||
(* ; "Edited 1-Sep-2024 10:39 by rmk")
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(SELECTION! SEL)
|
||||
(LET ((PT (TEDIT.GETPOINT TSTREAM SEL))
|
||||
OBJ)
|
||||
(CL:UNLESS [OR (ILEQ PT 1)
|
||||
(AND (FGETTOBJ TEXTOBJ MENUFLG)
|
||||
(SETQ OBJ (POBJ (\TEDIT.CHTOPC (SUB1 PT)
|
||||
TEXTOBJ)))
|
||||
(IMAGEOBJPROP OBJ 'FIELDPREFIX]
|
||||
(FSETTOBJ TEXTOBJ LASTARROWX NIL)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL (SUB1 PT)
|
||||
0
|
||||
'LEFT)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ))])
|
||||
|
||||
(\TEDIT.ONECHAR.FORWARD
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 17-Feb-2025 09:11 by rmk")
|
||||
(* ; "Edited 15-Feb-2025 08:50 by rmk")
|
||||
(* ; "Edited 24-Jan-2025 15:27 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 20:31 by rmk")
|
||||
(* ; "Edited 1-Sep-2024 10:39 by rmk")
|
||||
|
||||
(* ;; "Moves caret to a point one character forward.")
|
||||
|
||||
(SELECTION! SEL)
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(LET ((PT (TEDIT.GETPOINT TSTREAM SEL))
|
||||
OBJ)
|
||||
(CL:UNLESS [OR (IGREATERP PT (TEXTLEN TEXTOBJ))
|
||||
(AND (FGETTOBJ TEXTOBJ MENUFLG)
|
||||
(SETQ OBJ (POBJ (\TEDIT.CHTOPC PT TEXTOBJ)))
|
||||
(IMAGEOBJPROP OBJ 'FIELDSUFFIX]
|
||||
(FSETTOBJ TEXTOBJ LASTARROWX NIL)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL PT 0 'RIGHT)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ))])
|
||||
|
||||
(\TEDIT.ONELINE.UP
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 13-Feb-2025 22:04 by rmk")
|
||||
(* ; "Edited 12-Feb-2025 19:46 by rmk")
|
||||
(* ; "Edited 24-Jan-2025 15:27 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 20:31 by rmk")
|
||||
(* ; "Edited 1-Sep-2024 10:39 by rmk")
|
||||
|
||||
(* ;; "Moves caret to the same x position one line up. It gets the current X (X0 or XLIM) of the caret in the current selection, which is common to all panes in which the caret is visible. It then finds the line in the first pane where the caret is visible, formats the previous line, and then figures out the character in previousline that would come closest to X.")
|
||||
|
||||
(* ;; "We look for a pane that not only has a line with the caret, but also has the previous line. Otherwise, we have to search backwards to find the start of that line.")
|
||||
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(SELECTION! SEL)
|
||||
(LET (LINE LINEPANE (CHNO (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
(for PANE FIRSTONE inpanes (PROGN TEXTOBJ) as L1 in (FGETSEL SEL L1) as LN
|
||||
in (FGETSEL SEL LN) when [SETQ LINE (OR (AND L1 (WITHINLINEP CHNO L1))
|
||||
(AND LN (WITHINLINEP CHNO LN]
|
||||
do (CL:UNLESS (FGETLD (FGETLD LINE PREVLINE)
|
||||
LDUMMY)
|
||||
(RETURN))
|
||||
(CL:UNLESS FIRSTONE (SETQ FIRSTONE LINE)) finally
|
||||
|
||||
(* ;; "The caret is blinking nowhere, or in the top line of every pane, we have to create a prevline above.")
|
||||
|
||||
(SETQ LINE FIRSTONE)
|
||||
(SETQ LINEPANE PANE))
|
||||
|
||||
(* ;; "Caret is blinking in LINE, move selection to the charno at the same X in the previous line, in all panes. ")
|
||||
|
||||
(CL:WHEN [AND LINE (ILEQ 1 (SUB1 (FGETLD LINE LCHAR1]
|
||||
(\TEDIT.ONELINE.MOVE SEL (FGETLD (if (FGETLD (FGETLD LINE PREVLINE)
|
||||
LDUMMY)
|
||||
then
|
||||
(* ;;
|
||||
"Top of window, create the preceding line")
|
||||
|
||||
(\TEDIT.LASTVALIDLINE LINE CHNO LINEPANE
|
||||
TSTREAM)
|
||||
else (FGETLD LINE PREVLINE))
|
||||
LCHAR1)
|
||||
TSTREAM))])
|
||||
|
||||
(\TEDIT.ONELINE.DOWN
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 13-Feb-2025 22:05 by rmk")
|
||||
(* ; "Edited 12-Feb-2025 19:46 by rmk")
|
||||
(* ; "Edited 24-Jan-2025 15:27 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 20:31 by rmk")
|
||||
(* ; "Edited 1-Sep-2024 10:39 by rmk")
|
||||
|
||||
(* ;; "Moves caret to the same x position one line down. It gets the current X (X0 or XLIM) of the caret in the current selection, which is common to all panes in which the caret is visible. It then finds the line in the first pane where the caret is visible, formats the nextline, and then figures out the character in nextline that would come closest to X.")
|
||||
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(SELECTION! SEL)
|
||||
(LET (LINE NEXTLINE NEXTCHNO)
|
||||
(for L1 (CHNO _ (TEDIT.GETPOINT TSTREAM SEL)) in (FGETSEL SEL L1) as LN
|
||||
in (FGETSEL SEL LN) when [SETQ LINE (OR (AND L1 (WITHINLINEP CHNO L1))
|
||||
(AND LN (WITHINLINEP CHNO LN] do (RETURN))
|
||||
|
||||
(* ;; "Caret is blinking in LINE, move selection to the charno at the same X in the next line, in all panes. ")
|
||||
|
||||
(CL:WHEN (AND LINE (ILESSP (ADD1 (FGETLD LINE LCHARLAST))
|
||||
(TEXTLEN TEXTOBJ)))
|
||||
(\TEDIT.ONELINE.MOVE SEL (ADD1 (FGETLD LINE LCHARLAST))
|
||||
TSTREAM))])
|
||||
|
||||
(\TEDIT.ONELINE.MOVE
|
||||
[LAMBDA (SEL CHNO TSTREAM) (* ; "Edited 16-Feb-2025 16:20 by rmk")
|
||||
(* ; "Edited 14-Feb-2025 09:49 by rmk")
|
||||
|
||||
(* ;;
|
||||
"Move caret from its previous X position to the same position in the line beginning at CHNO.")
|
||||
|
||||
(* ;; "The scan part is basically a specialized variant of \TEDIT.SCAN.LINE. ")
|
||||
|
||||
(LET ((TARGETLINE (\TEDIT.FORMATLINE TSTREAM CHNO))
|
||||
(TEXTOBJ (FGETTSTR TSTREAM TEXTOBJ)))
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ MENUFLG)
|
||||
(for CHARSLOT (THISLINE _ (FGETTOBJ TEXTOBJ THISLINE))
|
||||
(TARGX _ (FGETLD TARGETLINE LX1))
|
||||
[X _ (OR (FGETTOBJ TEXTOBJ LASTARROWX)
|
||||
(FSETTOBJ TEXTOBJ LASTARROWX (SELECTQ (FGETSEL SEL POINT)
|
||||
(LEFT (FGETSEL SEL X0))
|
||||
(RIGHT (FGETSEL SEL XLIM))
|
||||
NIL] incharslots (FGETTOBJ TEXTOBJ
|
||||
THISLINE)
|
||||
when CHAR do (add TARGX CHARW)
|
||||
(CL:WHEN (IGEQ TARGX X)
|
||||
(CL:WHEN (IGEQ X (IDIFFERENCE TARGX (FOLDLO CHARW 2)))
|
||||
(* ;
|
||||
"To RIGHT of target char if more than half way")
|
||||
(add CHNO 1))
|
||||
(RETURN))
|
||||
(add CHNO 1) finally (* ;
|
||||
"TARGETLINE must have been shorter than X")
|
||||
(SETQ CHNO (FGETLD TARGETLINE LCHARLAST)))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL CHNO 0 'LEFT)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(\TEDIT.SCROLL.CARET TSTREAM))])
|
||||
)
|
||||
|
||||
|
||||
@@ -511,13 +742,14 @@
|
||||
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))])
|
||||
|
||||
(\TEDIT.STRIKEOUT.CARET.ON
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
|
||||
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(STRIKEOUT ON)
|
||||
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
|
||||
TEXTOBJ)))
|
||||
(COND
|
||||
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
|
||||
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 10-Aug-2024 16:31 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:32 by mitani")
|
||||
(LET ((LOOKS (\TEDIT.CHANGE.CHARLOOKS.NEW '(STRIKEOUT ON)
|
||||
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
|
||||
TEXTOBJ)))
|
||||
(CL:WHEN LOOKS
|
||||
(TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
|
||||
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))])
|
||||
)
|
||||
|
||||
|
||||
@@ -585,12 +817,16 @@
|
||||
("Function,^A" FN \TEDIT.SHOWCARETLOOKS)
|
||||
("Meta,a" FN \TEDIT.SELECT.ALL)
|
||||
("Meta,A" FN \TEDIT.SELECT.ALL)
|
||||
("Meta,d" FN \TEDIT.MANPAGE)
|
||||
("Meta,D" FN \TEDIT.MANPAGE)
|
||||
("Meta,F" FN \TEDIT.KEY.FIND.BACKWARD)
|
||||
("Meta,f" FN \TEDIT.KEY.FIND)
|
||||
("Meta,g" FN \TEDIT.FINDAGAIN)
|
||||
("Meta,G" FN \TEDIT.FINDAGAIN.BACKWARD)
|
||||
("Meta,N" NEXT)
|
||||
("Meta,n" NEXT)
|
||||
("Meta,o" FN \TEDIT.CALL.ED)
|
||||
("Meta,O" FN \TEDIT.CALL.ED)
|
||||
("Meta,p" FN \TEDIT.PRINT.MENU)
|
||||
("Meta,P" FN \TEDIT.PRINT.MENU)
|
||||
("Meta,r" REDO)
|
||||
@@ -600,7 +836,13 @@
|
||||
("Meta,U" FN \TEDIT.UNDO.UNDO)
|
||||
("Meta,u" UNDO)
|
||||
("Meta,z" UNDO)
|
||||
("Meta,Z" \TEDIT.UNDO.UNDO)))
|
||||
("Meta,Z" \TEDIT.UNDO.UNDO)
|
||||
("Meta,<" FN \TEDIT.ONECHAR.BACKWARD)
|
||||
("Meta,," FN \TEDIT.ONECHAR.BACKWARD)
|
||||
("Meta,>" FN \TEDIT.ONECHAR.FORWARD)
|
||||
("Meta,." FN \TEDIT.ONECHAR.FORWARD)
|
||||
("Meta,^" FN \TEDIT.ONELINE.UP)
|
||||
("Meta,LF" FN \TEDIT.ONELINE.DOWN)))
|
||||
|
||||
[MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY)
|
||||
(SELECTQ (CADR ENTRY)
|
||||
@@ -609,21 +851,24 @@
|
||||
(TEDIT.SETSYNTAX (CAR ENTRY)
|
||||
(CADR ENTRY]
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5609 23249 (\TEDIT.BOLD.SEL.OFF 5619 . 5957) (\TEDIT.BOLD.SEL.ON 5959 . 6287) (
|
||||
\TEDIT.CENTER.SEL 6289 . 7805) (\TEDIT.CENTER.SEL.REV 7807 . 8103) (\TEDIT.DEFAULTS.CARET 8105 . 8598)
|
||||
(\TEDIT.DEFAULTSSEL 8600 . 9047) (\TEDIT.SETDEFAULT.FROM.SEL 9049 . 9726) (\TEDIT.KEY.FIND 9728 .
|
||||
14757) (\TEDIT.GET.TARGET.STRING 14759 . 15623) (\TEDIT.KEY.FIND.BACKWARD 15625 . 15930) (
|
||||
\TEDIT.FINDAGAIN.BACKWARD 15932 . 16343) (\TEDIT.FINDAGAIN 16345 . 16636) (\TEDIT.ITALIC.SEL.OFF 16638
|
||||
. 16890) (\TEDIT.ITALIC.SEL.ON 16892 . 17085) (\TEDIT.LARGERSEL 17087 . 17375) (\TEDIT.LCASE.SEL
|
||||
17377 . 18564) (\TEDIT.SHOWCARETLOOKS 18566 . 20166) (\TEDIT.SMALLERSEL 20168 . 20459) (
|
||||
\TEDIT.SUBSCRIPTSEL 20461 . 20664) (\TEDIT.SUPERSCRIPTSEL 20666 . 20870) (\TEDIT.UCASE.SEL 20872 .
|
||||
22003) (\TEDIT.UNDERLINE.SEL.OFF 22005 . 22203) (\TEDIT.UNDERLINE.SEL.ON 22205 . 22401) (
|
||||
\TEDIT.STRIKEOUT.SEL.ON 22403 . 22599) (\TEDIT.STRIKEOUT.SEL.OFF 22601 . 22799) (\TEDIT.SELECT.ALL
|
||||
22801 . 23024) (\TEDIT.KEY.SUBSTITUTE 23026 . 23247)) (23321 29730 (\TEDIT.BOLD.CARET.OFF 23331 .
|
||||
23866) (\TEDIT.BOLD.CARET.ON 23868 . 24400) (\TEDIT.ITALIC.CARET.OFF 24402 . 24939) (
|
||||
\TEDIT.ITALIC.CARET.ON 24941 . 25484) (\TEDIT.LARGER.CARET 25486 . 26021) (\TEDIT.SMALLER.CARET 26023
|
||||
. 26560) (\TEDIT.SUBSCRIPT.CARET 26562 . 27103) (\TEDIT.SUPERSCRIPT.CARET 27105 . 27647) (
|
||||
\TEDIT.UNDERLINE.CARET.OFF 27649 . 28189) (\TEDIT.UNDERLINE.CARET.ON 28191 . 28729) (
|
||||
\TEDIT.STRIKEOUT.CARET.OFF 28731 . 29271) (\TEDIT.STRIKEOUT.CARET.ON 29273 . 29728)) (29799 30501 (
|
||||
\TK.DESCRIBEFONT 29809 . 30499)))))
|
||||
(FILEMAP (NIL (6442 28702 (\TEDIT.BOLD.SEL.OFF 6452 . 6790) (\TEDIT.BOLD.SEL.ON 6792 . 7120) (
|
||||
\TEDIT.CENTER.SEL 7122 . 8638) (\TEDIT.CENTER.SEL.REV 8640 . 8936) (\TEDIT.DEFAULTS.CARET 8938 . 9431)
|
||||
(\TEDIT.DEFAULTSSEL 9433 . 9880) (\TEDIT.SETDEFAULT.FROM.SEL 9882 . 10559) (\TEDIT.KEY.FIND 10561 .
|
||||
15628) (\TEDIT.KEY.FIND.SEARCHSTRING 15630 . 16770) (\TEDIT.GET.TARGET.STRING 16772 . 18486) (
|
||||
\TEDIT.KEY.FIND.BACKWARD 18488 . 18793) (\TEDIT.FINDAGAIN.BACKWARD 18795 . 19206) (\TEDIT.FINDAGAIN
|
||||
19208 . 19499) (\TEDIT.ITALIC.SEL.OFF 19501 . 19753) (\TEDIT.ITALIC.SEL.ON 19755 . 19948) (
|
||||
\TEDIT.LARGERSEL 19950 . 20238) (\TEDIT.LCASE.SEL 20240 . 21635) (\TEDIT.SHOWCARETLOOKS 21637 . 23237)
|
||||
(\TEDIT.SMALLERSEL 23239 . 23530) (\TEDIT.SUBSCRIPTSEL 23532 . 23735) (\TEDIT.SUPERSCRIPTSEL 23737 .
|
||||
23941) (\TEDIT.UCASE.SEL 23943 . 25282) (\TEDIT.UNDERLINE.SEL.OFF 25284 . 25482) (
|
||||
\TEDIT.UNDERLINE.SEL.ON 25484 . 25680) (\TEDIT.STRIKEOUT.SEL.ON 25682 . 25878) (
|
||||
\TEDIT.STRIKEOUT.SEL.OFF 25880 . 26078) (\TEDIT.SELECT.ALL 26080 . 26396) (\TEDIT.KEY.SUBSTITUTE 26398
|
||||
. 26619) (\TEDIT.MANPAGE 26621 . 27868) (\TEDIT.CALL.ED 27870 . 28700)) (28703 37902 (
|
||||
\TEDIT.ONECHAR.BACKWARD 28713 . 29842) (\TEDIT.ONECHAR.FORWARD 29844 . 31062) (\TEDIT.ONELINE.UP 31064
|
||||
. 34025) (\TEDIT.ONELINE.DOWN 34027 . 35684) (\TEDIT.ONELINE.MOVE 35686 . 37900)) (37974 44485 (
|
||||
\TEDIT.BOLD.CARET.OFF 37984 . 38519) (\TEDIT.BOLD.CARET.ON 38521 . 39053) (\TEDIT.ITALIC.CARET.OFF
|
||||
39055 . 39592) (\TEDIT.ITALIC.CARET.ON 39594 . 40137) (\TEDIT.LARGER.CARET 40139 . 40674) (
|
||||
\TEDIT.SMALLER.CARET 40676 . 41213) (\TEDIT.SUBSCRIPT.CARET 41215 . 41756) (\TEDIT.SUPERSCRIPT.CARET
|
||||
41758 . 42300) (\TEDIT.UNDERLINE.CARET.OFF 42302 . 42842) (\TEDIT.UNDERLINE.CARET.ON 42844 . 43382) (
|
||||
\TEDIT.STRIKEOUT.CARET.OFF 43384 . 43924) (\TEDIT.STRIKEOUT.CARET.ON 43926 . 44483)) (44554 45256 (
|
||||
\TK.DESCRIBEFONT 44564 . 45254)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Apr-2024 09:12:32" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;153 33754
|
||||
(FILECREATED "19-Feb-2025 13:34:37" {WMEDLEY}<library>tedit>TEDIT-HCPY.;170 33842
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE)
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
\TEDIT.HCPYFMTSPEC)
|
||||
|
||||
:PREVIOUS-DATE "20-Mar-2024 11:05:37" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;152)
|
||||
:PREVIOUS-DATE " 8-Feb-2025 23:42:18" {WMEDLEY}<library>tedit>TEDIT-HCPY.;169)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
|
||||
@@ -87,9 +88,11 @@
|
||||
"Can't HARDCOPY: No print server specified." T])
|
||||
|
||||
(\TEDIT.PRINT.MENU
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 25-Jun-2023 13:16 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 28-Jun-2024 22:09 by rmk")
|
||||
(* ; "Edited 25-Jun-2023 13:16 by rmk")
|
||||
(* ; "Edited 6-Jun-2023 17:48 by rmk")
|
||||
(LET [(W (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TSTREAM]
|
||||
(LET ((W (GETTOBJ (TEXTOBJ TSTREAM)
|
||||
PRIMARYPANE)))
|
||||
(SELECTQ [MENU (create MENU
|
||||
ITEMS _ '(("Print to a file" 'FILE
|
||||
"Puts image on a file; prompts for filename and format"
|
||||
@@ -101,7 +104,8 @@
|
||||
NIL])
|
||||
|
||||
(TEDIT.HCPYFILE
|
||||
[LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 4-Oct-2022 09:23 by rmk")
|
||||
[LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 29-Jun-2024 16:33 by rmk")
|
||||
(* ; "Edited 4-Oct-2022 09:23 by rmk")
|
||||
(* ; "Edited 1-Oct-2022 22:12 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:36 by mitani")
|
||||
|
||||
@@ -125,10 +129,16 @@
|
||||
'HCPY)
|
||||
'BODY
|
||||
(fetch (STREAM FULLFILENAME) of TXTFILE]
|
||||
(TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE])
|
||||
(if FILENM
|
||||
then (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
|
||||
|
||||
(\TEDIT.HARDCOPY.DISPLAYLINE
|
||||
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 19-Apr-2024 09:09 by rmk")
|
||||
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:39 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 23:49 by rmk")
|
||||
(* ; "Edited 13-Jun-2024 17:13 by rmk")
|
||||
(* ; "Edited 19-Apr-2024 09:09 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:04 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:23 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 22:07 by rmk")
|
||||
@@ -151,16 +161,16 @@
|
||||
(FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
[LET ((THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
|
||||
(CL:UNLESS (EQ LINE (fetch DESC of THISLINE))
|
||||
(\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
|
||||
(\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT)
|
||||
(FGETLD LINE LCHAR1)
|
||||
LINE REGION PRSTREAM FORMATTINGSTATE))
|
||||
|
||||
(* ;; "Use the characters cached in THISLINE.")
|
||||
|
||||
(for CHARSLOT CLOOKS CURY KERN LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE
|
||||
|
||||
(for CHARSLOT CLOOKS CURY LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE
|
||||
TLSPACEFACTOR
|
||||
)
|
||||
of THISLINE))
|
||||
)
|
||||
of THISLINE))
|
||||
(FIRST-SCALEDSPACE-SLOT _ (ffetch (THISLINE TLFIRSTSPACE) of THISLINE))
|
||||
(SCALE _ (DSPSCALE NIL PRSTREAM))
|
||||
(TX _ (FGETLD LINE LX1)) incharslots THISLINE first (DSPSPACEFACTOR 1 PRSTREAM)
|
||||
@@ -225,11 +235,7 @@
|
||||
)
|
||||
of CLOOKS]
|
||||
(T (FGETLD LINE YBASE]
|
||||
(DSPYPOSITION CURY PRSTREAM)
|
||||
(CL:WHEN (SETQ KERN (LISTGET (fetch (CHARLOOKS CLUSERINFO)
|
||||
of CLOOKS)
|
||||
'KERN))
|
||||
(SETQ KERN (HCSCALE SCALE KERN)))
|
||||
(DSPYPOSITION CURY PRSTREAM)
|
||||
|
||||
(* ;; "LOOKSTARTX: Starting X position for this CLOOKS.")
|
||||
|
||||
@@ -253,6 +259,8 @@
|
||||
|
||||
(SETQ CHARW (\TEDIT.DISPLAY.DIACRITIC CHARSLOT THISLINE
|
||||
PRSTREAM))
|
||||
elseif (EQ 'KERN CHAR)
|
||||
then (RELMOVETO 0 CHARW PRSTREAM)
|
||||
else (\OUTCHAR PRSTREAM CHAR))
|
||||
(add TX CHARW))) finally
|
||||
|
||||
@@ -262,36 +270,39 @@
|
||||
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE
|
||||
LOOKSTARTX TX (FGETLD LINE YBASE)
|
||||
CLOOKS PRSTREAM))
|
||||
(CL:WHEN (fetch (FMTSPEC FMTREVISED)
|
||||
of (FGETLD LINE LFMTSPEC))
|
||||
(CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS)
|
||||
FMTREVISED)
|
||||
(* ;
|
||||
"This paragraph has been revised, so mark it.")
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ
|
||||
(FGETLD LINE LFMTSPEC)
|
||||
(FGETLD LINE LPARALOOKS)
|
||||
PRSTREAM LINE))])])
|
||||
|
||||
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:13 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 11:04 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 17:22 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 23:19 by rmk")
|
||||
(* ; "Edited 3-Oct-2022 13:05 by rmk")
|
||||
|
||||
(* ;; "Return setup LINE to skip a sequence of heading pieces STATE")
|
||||
|
||||
(SELECTQ (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC)
|
||||
(SELECTQ (GETPLOOKS PARALOOKS FMTPARATYPE)
|
||||
(PAGEHEADING
|
||||
(* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.")
|
||||
|
||||
(\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM
|
||||
(\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM
|
||||
FORMATTINGSTATE)
|
||||
T)
|
||||
(EVEN (* ; "Skip an odd page.")
|
||||
(CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
|
||||
T))
|
||||
(ODD (* ; "Skip an even page")
|
||||
(CL:WHEN (EVENP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
|
||||
T))
|
||||
NIL])
|
||||
|
||||
@@ -337,53 +348,44 @@
|
||||
(MOVETO CURX CURY PRSTREAM])
|
||||
|
||||
(\TEDIT.HCPYFMTSPEC
|
||||
[LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 15-Mar-2024 19:34 by rmk")
|
||||
[LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:36 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 22:25 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:34 by rmk")
|
||||
(* ; "Edited 7-Mar-2023 21:03 by rmk")
|
||||
(* ; "Edited 6-Mar-2023 15:14 by rmk")
|
||||
(* ; "Edited 20-Oct-2022 22:35 by rmk")
|
||||
(* ; "Edited 29-Sep-2022 23:32 by rmk")
|
||||
(* ; "Edited 30-May-91 21:18 by jds")
|
||||
|
||||
(* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
|
||||
(* ;; "Given a display-type PARALOOKS, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
|
||||
|
||||
(LET ((SCALE (DSPSCALE NIL IMAGESTREAM))
|
||||
FMTSPEC)
|
||||
[SETQ FMTSPEC (create FMTSPEC using SPEC FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
|
||||
(HCSCALE SCALE (fetch (FMTSPEC 1STLEFTMAR) of SPEC))
|
||||
LEFTMAR _ (HCSCALE SCALE (fetch (FMTSPEC LEFTMAR)
|
||||
of SPEC))
|
||||
RIGHTMAR _ (HCSCALE SCALE (fetch (FMTSPEC RIGHTMAR)
|
||||
of SPEC))
|
||||
QUAD _ (fetch (FMTSPEC QUAD) of SPEC)
|
||||
TABSPEC _ (\TEDIT.FORMATLINE.SCALETABS SPEC SCALE)
|
||||
FMTSPECIALX _ (AND (fetch (FMTSPEC FMTSPECIALX)
|
||||
of SPEC)
|
||||
(HCSCALE SCALE
|
||||
(SCALEPAGEUNITS
|
||||
(fetch (FMTSPEC FMTSPECIALX)
|
||||
of SPEC)
|
||||
1.0 NIL)))
|
||||
FMTSPECIALY _ (AND (fetch (FMTSPEC FMTSPECIALY)
|
||||
of SPEC)
|
||||
(HCSCALE SCALE
|
||||
(SCALEPAGEUNITS
|
||||
(fetch (FMTSPEC FMTSPECIALY)
|
||||
of SPEC)
|
||||
1.0 NIL)))
|
||||
LEADBEFORE _ (HCSCALE SCALE (fetch (FMTSPEC LEADBEFORE)
|
||||
of SPEC))
|
||||
LEADAFTER _ (HCSCALE SCALE (fetch (FMTSPEC LEADAFTER)
|
||||
of SPEC))
|
||||
LINELEAD _ (HCSCALE SCALE (fetch (FMTSPEC LINELEAD)
|
||||
of SPEC))
|
||||
FMTBASETOBASE _ (AND (fetch (FMTSPEC FMTBASETOBASE)
|
||||
of SPEC)
|
||||
(HCSCALE SCALE (fetch (FMTSPEC
|
||||
|
||||
FMTBASETOBASE
|
||||
)
|
||||
of SPEC]
|
||||
FMTSPEC])
|
||||
(LET* ((SCALE (DSPSCALE NIL IMAGESTREAM)))
|
||||
(create PARALOOKS using DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
|
||||
(HCSCALE SCALE (FGETPLOOKS DISPLAYFMT 1STLEFTMAR))
|
||||
LEFTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEFTMAR))
|
||||
RIGHTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT RIGHTMAR))
|
||||
QUAD _ (FGETPLOOKS DISPLAYFMT QUAD DISPLAYFMT)
|
||||
FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT FMTDEFAULTTAB
|
||||
))
|
||||
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPLOOKS DISPLAYFMT FMTTABS)
|
||||
SCALE)
|
||||
FMTSPECIALX _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALX)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
|
||||
DISPLAYFMT
|
||||
FMTSPECIALX)
|
||||
1.0 NIL)))
|
||||
FMTSPECIALY _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALY)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
|
||||
DISPLAYFMT
|
||||
FMTSPECIALY)
|
||||
1.0 NIL)))
|
||||
LEADBEFORE _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADBEFORE))
|
||||
LEADAFTER _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADAFTER))
|
||||
LINELEAD _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LINELEAD))
|
||||
FMTBASETOBASE _ (AND (FGETPLOOKS DISPLAYFMT FMTBASETOBASE)
|
||||
(HCSCALE SCALE (FGETPLOOKS DISPLAYFMT
|
||||
FMTBASETOBASE])
|
||||
|
||||
(\TEDIT.INTEGER.IMAGEBOX
|
||||
[LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52")
|
||||
@@ -451,7 +453,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.HARDCOPYFN
|
||||
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 20-Mar-2024 10:49 by rmk")
|
||||
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 13-Dec-2024 22:33 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 14:42 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:49 by rmk")
|
||||
(* ; "Edited 25-Sep-2023 16:29 by rmk")
|
||||
(* ; "Edited 4-Jul-2023 11:16 by rmk")
|
||||
(* ; "Edited 21-Sep-2021 15:33 by rmk:")
|
||||
@@ -459,22 +463,15 @@
|
||||
(* ;;
|
||||
"This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")
|
||||
|
||||
(LET ((TEXTOBJ (TEXTOBJ WINDOW))
|
||||
(TEXTSTREAM (TEXTSTREAM WINDOW))
|
||||
WASDIRTY)
|
||||
(LET ((TEXTSTREAM (TEXTSTREAM WINDOW)))
|
||||
|
||||
(* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it. Please don't remove this binding!")
|
||||
|
||||
(CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG)
|
||||
(SETQ WINDOW (\TEDIT.MAINW WINDOW))
|
||||
(SETQ TEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW)))
|
||||
(RESETLST
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE 'Hardcopy) (* ; "Build the hardcopy")
|
||||
(SETQ WASDIRTY (FGETTOBJ TEXTOBJ \DIRTY))
|
||||
(PROG1 (TEDIT.FORMAT.HARDCOPY WINDOW IMAGESTREAM)
|
||||
(FSETTOBJ TEXTOBJ \DIRTY WASDIRTY)))])
|
||||
(TEDIT.FORMAT.HARDCOPY (CL:IF (FGETTOBJ (TEXTOBJ WINDOW)
|
||||
MENUFLG)
|
||||
(\TEDIT.MAINW WINDOW)
|
||||
WINDOW)
|
||||
IMAGESTREAM])
|
||||
|
||||
(\TEDIT.HARDCOPYFILEFN
|
||||
[LAMBDA (W EXT) (* ; "Edited 25-Sep-2023 16:19 by rmk")
|
||||
@@ -566,11 +563,11 @@
|
||||
(CLOSEF DOC])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3475 26808 (TEDIT.HARDCOPY 3485 . 4618) (\TEDIT.PRINT.MENU 4620 . 5474) (TEDIT.HCPYFILE
|
||||
5476 . 7416) (\TEDIT.HARDCOPY.DISPLAYLINE 7418 . 17356) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17358 .
|
||||
18765) (\TEDIT.HARDCOPY.MODIFYLOOKS 18767 . 21001) (\TEDIT.HCPYFMTSPEC 21003 . 25137) (
|
||||
\TEDIT.INTEGER.IMAGEBOX 25139 . 25810) (\TEDIT.DISPLAY.DIACRITIC 25812 . 26806)) (26883 27713 (
|
||||
\TEDIT.SCALEREGION 26893 . 27711)) (27972 31667 (TEDIT.HARDCOPYFN 27982 . 29442) (
|
||||
\TEDIT.HARDCOPYFILEFN 29444 . 30005) (\TEDIT.POSTSCRIPT.HARDCOPY 30007 . 30938) (\TEDIT.PRESS.HARDCOPY
|
||||
30940 . 31665)) (32930 33731 (TEDIT-BOOK 32940 . 33729)))))
|
||||
(FILEMAP (NIL (3554 27051 (TEDIT.HARDCOPY 3564 . 4697) (\TEDIT.PRINT.MENU 4699 . 5665) (TEDIT.HCPYFILE
|
||||
5667 . 7841) (\TEDIT.HARDCOPY.DISPLAYLINE 7843 . 17953) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17955 .
|
||||
19684) (\TEDIT.HARDCOPY.MODIFYLOOKS 19686 . 21920) (\TEDIT.HCPYFMTSPEC 21922 . 25380) (
|
||||
\TEDIT.INTEGER.IMAGEBOX 25382 . 26053) (\TEDIT.DISPLAY.DIACRITIC 26055 . 27049)) (27126 27956 (
|
||||
\TEDIT.SCALEREGION 27136 . 27954)) (28215 31755 (TEDIT.HARDCOPYFN 28225 . 29530) (
|
||||
\TEDIT.HARDCOPYFILEFN 29532 . 30093) (\TEDIT.POSTSCRIPT.HARDCOPY 30095 . 31026) (\TEDIT.PRESS.HARDCOPY
|
||||
31028 . 31753)) (33018 33819 (TEDIT-BOOK 33028 . 33817)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,21 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Mar-2024 11:05:20" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;154 33348
|
||||
(FILECREATED " 6-Feb-2025 15:42:44" {WMEDLEY}<library>TEDIT>TEDIT-HISTORY.;221 53072
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.UNDO)
|
||||
:CHANGES-TO (FNS \TEDIT.HISTORYADD.COMPOSITE)
|
||||
|
||||
:PREVIOUS-DATE "15-Mar-2024 13:55:42" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;153)
|
||||
:PREVIOUS-DATE " 2-Feb-2025 11:32:56" {WMEDLEY}<library>TEDIT>TEDIT-HISTORY.;220)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
|
||||
|
||||
(RPAQQ TEDIT-HISTORYCOMS
|
||||
((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITHISTORYEVENT)
|
||||
(MACROS \TEDIT.LASTEVENT \TEDIT.POPEVENT GETTH SETTH)
|
||||
))
|
||||
(MACROS \TEDIT.LASTEVENT GETTH SETTH)))
|
||||
(FNS \TEDIT.HISTORYEVENT.DEFPRINT)
|
||||
(MACROS \TEDIT.HISTORYADD1)
|
||||
(INITRECORDS TEDITHISTORYEVENT)
|
||||
(GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST)
|
||||
(INITVARS (TEDIT.HISTORY.TYPELST NIL)
|
||||
@@ -23,13 +23,16 @@
|
||||
(COMS
|
||||
(* ;; "History-list maintenance functions")
|
||||
|
||||
(FNS \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS))
|
||||
(FNS \TEDIT.HISTORYADD \TEDIT.HISTORYADD.COMPOSITE \TEDIT.CUMULATE.EVENTS
|
||||
\TEDIT.COMPOSITE.EVENT \TEDIT.HISTORY.PROP \TEDIT.HISTORY.EVENT \TEDIT.POPEVENT))
|
||||
(COMS
|
||||
(* ;; "Specialized UNDO & REDO functions.")
|
||||
|
||||
(FNS TEDIT.UNDO \TEDIT.UNDO1 TEDIT.REDO \TEDIT.UNDO.UNDO)
|
||||
(FNS \TEDIT.UNDO.INSERTION \TEDIT.UNDO.DELETION \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE)
|
||||
(FNS \TEDIT.REDO.INSERTION \TEDIT.REDO.REPLACE \TEDIT.REDO.MOVE))))
|
||||
(FNS \TEDIT.UNDO.INSERT \TEDIT.UNDO.DELETE \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE
|
||||
\TEDIT.UNDO.CHARLOOKS \TEDIT.UNDO.PARALOOKS \TEDIT.UNDO.PAGELOOKS
|
||||
\TEDIT.UNDO.COMPOSITE \TEDIT.UNDO.REPLACECODE)
|
||||
(FNS \TEDIT.REDO.INSERT \TEDIT.REDO.REPLACE \TEDIT.REDO.COMPOSITE))))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -47,16 +50,16 @@
|
||||
NIL (* ;
|
||||
"Was THAUXINFO: Auxiliary info about the event, primarily for redo")
|
||||
THDELETEDPIECES)
|
||||
[ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (AND (fetch (TEDITHISTORYEVENT
|
||||
THCH#) of DATUM)
|
||||
(IPLUS (fetch (
|
||||
[ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch (
|
||||
TEDITHISTORYEVENT
|
||||
THCH#)
|
||||
of DATUM)
|
||||
(fetch (
|
||||
THCH#)
|
||||
of DATUM)
|
||||
0)
|
||||
(OR (fetch (
|
||||
TEDITHISTORYEVENT
|
||||
THLEN)
|
||||
of DATUM]
|
||||
THLEN)
|
||||
of DATUM)
|
||||
0]
|
||||
(INIT (DEFPRINT 'TEDITHISTORYEVENT (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT
|
||||
)))
|
||||
THPOINT _ 'LEFT)
|
||||
@@ -80,9 +83,6 @@
|
||||
(PUTPROPS \TEDIT.LASTEVENT MACRO ((TOBJ)
|
||||
(CAR (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
|
||||
|
||||
(PUTPROPS \TEDIT.POPEVENT MACRO ((TOBJ)
|
||||
(pop (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
|
||||
|
||||
(PUTPROPS GETTH MACRO ((EVENT FIELD)
|
||||
(fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
|
||||
|
||||
@@ -114,6 +114,15 @@
|
||||
(CDR LOC)
|
||||
"}"])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \TEDIT.HISTORYADD1 MACRO ((TEXTOBJ EVENT)
|
||||
|
||||
(* ;; "This is the primitive, to be upgraded if we go to a ring.")
|
||||
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORY)
|
||||
EVENT)))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'TEDITHISTORYEVENT '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER)
|
||||
@@ -144,7 +153,11 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.HISTORYADD
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 3-Mar-2024 12:15 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 8-Dec-2024 17:32 by rmk")
|
||||
(* ; "Edited 29-Aug-2024 12:30 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 21:57 by rmk")
|
||||
(* ; "Edited 30-Apr-2024 22:51 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 12:15 by rmk")
|
||||
(* ; "Edited 19-Feb-2024 12:09 by rmk")
|
||||
(* ; "Edited 30-Dec-2023 22:19 by rmk")
|
||||
(* ; "Edited 11-Aug-2023 14:25 by rmk")
|
||||
@@ -158,55 +171,75 @@
|
||||
|
||||
(* ;; "Not sure what should happen if the second one is to the right of the first, deleting forwards. Old code seemed to treat those as separate events, and only the second/right one could be undone.")
|
||||
|
||||
(CL:UNLESS (EQ 'DON'T (GETTOBJ TEXTOBJ TXTHISTORY))
|
||||
(if (type? TEDITHISTORYEVENT EVENT)
|
||||
then (CL:WHEN (MEMB (GETTH EVENT THACTION)
|
||||
(CONSTANT (LIST :Put :Get))) (* ;
|
||||
(if (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
|
||||
then
|
||||
(* ;; "Maybe the first event after setting the textprop--now's the time to flush")
|
||||
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORY NIL)
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)
|
||||
else (if (type? TEDITHISTORYEVENT EVENT)
|
||||
then (CL:WHEN (MEMB (GETTH EVENT THACTION)
|
||||
(CONSTANT (LIST :Put :Get)))
|
||||
(* ;
|
||||
"Can't back up over Put/Get, flush the history.")
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORY NIL))
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORY NIL))
|
||||
|
||||
(* ;; "Somebody may have already done there own fixup.")
|
||||
(* ;; "Somebody may have already done there own fixup.")
|
||||
|
||||
(LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
|
||||
(CL:WHEN (AND (type? TEDITHISTORYEVENT OLDEVENT)
|
||||
(EQ :Delete (GETTH EVENT THACTION))
|
||||
(EQ :Delete (GETTH OLDEVENT THACTION)))
|
||||
(LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
|
||||
(CL:WHEN (AND (type? TEDITHISTORYEVENT OLDEVENT)
|
||||
(EQ :Delete (GETTH EVENT THACTION))
|
||||
(EQ :Delete (GETTH OLDEVENT THACTION)))
|
||||
|
||||
(* ;;
|
||||
"Repeated successive deletions, we can combine them if they are adjacent.")
|
||||
(* ;;
|
||||
"Repeated successive deletions, we can combine them if they are adjacent.")
|
||||
|
||||
(CL:WHEN (IEQP (GETTH EVENT THCHLIM)
|
||||
(GETTH OLDEVENT THCH#))
|
||||
(CL:WHEN (IEQP (GETTH EVENT THCHLIM)
|
||||
(GETTH OLDEVENT THCH#))
|
||||
(* ;
|
||||
"OLDEVENT is first, EVENT is still delete")
|
||||
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT TEXTOBJ))
|
||||
(\TEDIT.POPEVENT TEXTOBJ) (* ; "Pop OLDEVENT before repushing")
|
||||
(SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
|
||||
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT TEXTOBJ))
|
||||
(\TEDIT.POPEVENT TEXTOBJ) (* ; "Pop OLDEVENT before repushing")
|
||||
(SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
|
||||
|
||||
(* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")
|
||||
(* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")
|
||||
|
||||
(CL:WHEN [AND OLDEVENT (type? TEDITHISTORYEVENT OLDEVENT)
|
||||
(EQ :Delete (GETTH OLDEVENT THACTION))
|
||||
(IEQP (GETTH OLDEVENT THCHLIM)
|
||||
(IPLUS (GETTH EVENT THCH#)
|
||||
(GETTH OLDEVENT THLEN]
|
||||
(CL:WHEN [AND OLDEVENT (type? TEDITHISTORYEVENT OLDEVENT)
|
||||
(EQ :Delete (GETTH OLDEVENT THACTION))
|
||||
(IEQP (GETTH OLDEVENT THCHLIM)
|
||||
(IPLUS (GETTH EVENT THCH#)
|
||||
(GETTH OLDEVENT THLEN]
|
||||
|
||||
(* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates. EVENT came later, with its TCH# in a coordinate system reduced by THLEN. So we have to add it back.")
|
||||
(* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates. EVENT came later, with its TCH# in a coordinate system reduced by THLEN. So we have to add it back.")
|
||||
|
||||
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT))
|
||||
(\TEDIT.POPEVENT TEXTOBJ)))
|
||||
(push (GETTOBJ TEXTOBJ TXTHISTORY)
|
||||
EVENT))
|
||||
elseif (LISTP EVENT)
|
||||
then
|
||||
(* ;; "A monolithic sequence of undoable events")
|
||||
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT))
|
||||
(\TEDIT.POPEVENT TEXTOBJ)))
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT))
|
||||
elseif (LISTP EVENT)
|
||||
then
|
||||
(* ;; "A monolithic sequence of undoable events")
|
||||
|
||||
(push (GETTOBJ TEXTOBJ TXTHISTORY)
|
||||
EVENT)))
|
||||
(* ;; "SHOULDNT HAPPEN ?")
|
||||
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT)))
|
||||
EVENT])
|
||||
|
||||
(\TEDIT.HISTORYADD.COMPOSITE
|
||||
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 6-Feb-2025 15:31 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 19:31 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:47 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 08:02 by rmk")
|
||||
(* ; "Edited 8-May-2024 12:34 by rmk")
|
||||
(SETQ EVENTS (REMOVE NIL EVENTS))
|
||||
(CL:WHEN EVENTS
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (CL:IF (CDR EVENTS)
|
||||
(\TEDIT.HISTORY.EVENT TEXTOBJ :Composite NIL NIL NIL NIL
|
||||
EVENTS)
|
||||
(CAR EVENTS))))])
|
||||
|
||||
(\TEDIT.CUMULATE.EVENTS
|
||||
[LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
[LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 8-Dec-2024 17:35 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 12:15 by rmk")
|
||||
(* ; "Edited 3-Jun-2023 17:09 by rmk")
|
||||
(* ; "Edited 27-May-2023 00:54 by rmk")
|
||||
@@ -222,8 +255,68 @@
|
||||
(SETTH EVENT1 THDELETEDPIECES (\TEDIT.SELPIECES.CONCAT (GETTH EVENT1 THDELETEDPIECES)
|
||||
(GETTH EVENT2 THDELETEDPIECES)
|
||||
TEXTOBJ))
|
||||
(SETTH EVENT1 THLEN (fetch (SELPIECES SPLEN) of (GETTH EVENT1 THDELETEDPIECES)))
|
||||
(SETTH EVENT1 THLEN (GETSPC (GETTH EVENT1 THDELETEDPIECES)
|
||||
SPLEN))
|
||||
EVENT1])
|
||||
|
||||
(\TEDIT.COMPOSITE.EVENT
|
||||
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 8-Dec-2024 15:47 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:47 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 08:02 by rmk")
|
||||
(* ; "Edited 8-May-2024 12:34 by rmk")
|
||||
(CL:WHEN EVENTS
|
||||
(\TEDIT.HISTORYADD (CL:IF (CDR EVENTS)
|
||||
(\TEDIT.HISTORY.EVENT TEXTOBJ (OR ACTION :Composite)
|
||||
NIL NIL NIL NIL NEWEVENTS)
|
||||
(CAR EVENTS))))])
|
||||
|
||||
(\TEDIT.HISTORY.PROP
|
||||
[LAMBDA (TEXTOBJ SETNEWVALUE NEWVALUE) (* ; "Edited 22-Sep-2024 08:42 by rmk")
|
||||
|
||||
(* ;; "Called fromTEDIT.TEXT.PROP to manage the history list. History is ON by default, and the events always correspond to the current state of the document. If it's OFF, the next document-changing event will cause HISTORYADD to flush the past and no further events will be recorded until it is turned ON again to start a new epoch. CLEAR flushes old events but then turns on collection.")
|
||||
|
||||
(PROG1 (CL:IF (FGETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
|
||||
'OFF
|
||||
'ON)
|
||||
(CL:WHEN SETNEWVALUE
|
||||
(SELECTQ NEWVALUE
|
||||
((ON T)
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL))
|
||||
((OFF NIL)
|
||||
(* ;;
|
||||
"HISTORYADD will wipe out everything the next time it is called event--gives a chance to back out")
|
||||
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE T))
|
||||
(CLEAR (* ;
|
||||
"Wipes out current history now, then resumes collection")
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORY NIL)
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL))
|
||||
(\ILLEGAL.ARG NEWVALUE))))])
|
||||
|
||||
(\TEDIT.HISTORY.EVENT
|
||||
[LAMBDA (TEXTOBJ ACTION CH# LEN POINT FIRSTPIECE OLDINFO DELETEDPIECES)
|
||||
(* ; "Edited 26-Sep-2024 15:44 by rmk")
|
||||
(* ; "Edited 23-Sep-2024 16:47 by rmk")
|
||||
|
||||
(* ;; "Don't create if it's inactive")
|
||||
|
||||
(CL:UNLESS (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
|
||||
(CL:WHEN (AND (NULL LEN)
|
||||
(type? SELPIECES CH#))
|
||||
(SETQ LEN (fetch (SELPIECES SPLEN) of CH#))
|
||||
(SETQ CH# (fetch (SELPIECES SPFIRSTCHAR) of CH#)))
|
||||
(create TEDITHISTORYEVENT
|
||||
THACTION _ ACTION
|
||||
THCH# _ CH#
|
||||
THLEN _ LEN
|
||||
THPOINT _ (OR POINT 'LEFT)
|
||||
THFIRSTPIECE _ FIRSTPIECE
|
||||
THOLDINFO _ OLDINFO
|
||||
THDELETEDPIECES _ DELETEDPIECES))])
|
||||
|
||||
(\TEDIT.POPEVENT
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Dec-2024 21:24 by rmk")
|
||||
(pop (GETTOBJ TEXTOBJ TXTHISTORY])
|
||||
)
|
||||
|
||||
|
||||
@@ -233,7 +326,14 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.UNDO
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 20-Mar-2024 11:04 by rmk")
|
||||
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 8-Dec-2024 19:41 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 13:17 by rmk")
|
||||
(* ; "Edited 12-Aug-2024 10:49 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 21:21 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:23 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:08 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:04 by rmk")
|
||||
(* ; "Edited 8-May-2024 11:16 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:36 by rmk")
|
||||
(* ; "Edited 7-Mar-2024 12:48 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 20:02 by rmk")
|
||||
@@ -246,95 +346,124 @@
|
||||
|
||||
(* ;; "We push information for undoing the undo onto the TXTHISTORYUNDO list.")
|
||||
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY)
|
||||
|
||||
(* ;; "Only undo things if the document is allowed to change.")
|
||||
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "" T)
|
||||
(PROG ((SEL (TEXTSEL TEXTOBJ))
|
||||
(EVENT (\TEDIT.POPEVENT TEXTOBJ))
|
||||
PREVEVENTS UNDOEVENT)
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T)
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
EVENT PREVEVENT UNDOEVENT)
|
||||
(CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY)
|
||||
(RETURN))
|
||||
(SETQ EVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T)
|
||||
(RETURN))
|
||||
(CL:WHEN (MEMB (GETTH EVENT THACTION)
|
||||
'(:Get :Put))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
|
||||
T)
|
||||
(RETURN))
|
||||
(SETQ EVENT (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(SETQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ)) (* ;
|
||||
"So we can test for the undoundo event.")
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TSTREAM "Nothing to undo" T)
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Each main event was popped. Each subfunction must put back on the history-undo list one or more new events that would undo its undoing. ")
|
||||
(* ;; "Each main event was popped. Each subfunction must put back on the history-undo list one or more new events that would undo its undoing. ")
|
||||
|
||||
(* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")
|
||||
(* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")
|
||||
|
||||
(SETQ PREVEVENTS (FGETTOBJ TEXTOBJ TXTHISTORY))
|
||||
(\TEDIT.SHOWSEL SEL NIL)
|
||||
(\TEDIT.UNDO1 TEXTOBJ EVENT)
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UNDO1 TSTREAM EVENT)
|
||||
|
||||
(* ;; "Get the event that undid EVENT")
|
||||
(* ;; "Get the event that undid EVENT--if it was pushed in front of PREVENT ")
|
||||
|
||||
(SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORY PREVEVENTS)
|
||||
(CL:WHEN [OR (NULL PREVEVENTS)
|
||||
(AND (type? TEDITHISTORYEVENT (CAR (LISTP PREVEVENTS)))
|
||||
(MEMB (GETTH (CAR PREVEVENTS)
|
||||
THACTION)
|
||||
(CONSTANT (LIST :Get :Put]
|
||||
(SETTOBJ TEXTOBJ \DIRTY NIL))
|
||||
(CL:UNLESS (EQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
(SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ)))
|
||||
(CL:WHEN [OR (NULL PREVEVENT)
|
||||
(MEMB (GETTH PREVEVENT THACTION)
|
||||
(CONSTANT (LIST :Get :Put]
|
||||
(FSETTOBJ TEXTOBJ \DIRTY NIL))
|
||||
(CL:UNLESS NOUNDOUNDO
|
||||
|
||||
(* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u). This is so that M-U can undo the undoing.")
|
||||
(* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u). This is so that M-U can undo the undoing by redoing the original event.")
|
||||
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE TEXTOBJ)
|
||||
(LIST (CAR PREVEVENTS)
|
||||
UNDOEVENT EVENT))
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T)))])
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE)
|
||||
(LIST PREVEVENT UNDOEVENT EVENT)))
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO1
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 4-Mar-2024 14:55 by rmk")
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 25-Nov-2024 13:56 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 13:51 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 21:41 by rmk")
|
||||
(* ; "Edited 19-Aug-2024 00:11 by rmk")
|
||||
(* ; "Edited 12-Aug-2024 23:42 by rmk")
|
||||
(* ; "Edited 7-May-2024 23:10 by rmk")
|
||||
(* ; "Edited 4-Mar-2024 14:55 by rmk")
|
||||
(* ; "Edited 16-Jul-2023 11:14 by rmk")
|
||||
(* ; "Edited 30-May-2023 23:50 by rmk")
|
||||
(* ; "Edited 25-May-2023 00:33 by rmk")
|
||||
(SELECTC (GETTH EVENT THACTION)
|
||||
((LIST :Insert :Copy)
|
||||
(\TEDIT.UNDO.INSERTION TEXTOBJ EVENT))
|
||||
(:Move (\TEDIT.UNDO.MOVE TEXTOBJ EVENT))
|
||||
(:Delete (* ; "Deletion or case-shift")
|
||||
(\TEDIT.UNDO.DELETION TEXTOBJ EVENT))
|
||||
(:Move (\TEDIT.UNDO.MOVE TEXTOBJ EVENT))
|
||||
(:Looks (* ; "Character-looks change")
|
||||
(\TEDIT.UNDO.LOOKS TEXTOBJ EVENT))
|
||||
(:ParaLooks (* ; "PARA looks change")
|
||||
(\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
|
||||
(:PageFormat (* ; "Pageframe change")
|
||||
[SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (GETTH EVENT THOLDINFO)
|
||||
(SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ
|
||||
TXTPAGEFRAMES)))
|
||||
]
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT))
|
||||
((LIST :Replace :LowerCase :UpperCase)
|
||||
(* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")
|
||||
(LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)))
|
||||
(CL:WHEN (GETTH EVENT THCH#)
|
||||
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
EVENT)
|
||||
(\TEDIT.SHOWSEL NIL T TEXTOBJ)
|
||||
(\TEDIT.SCROLL.CARET TSTREAM))
|
||||
(PROG1 (SELECTC (GETTH EVENT THACTION)
|
||||
((LIST :Insert :Copy)
|
||||
(\TEDIT.UNDO.INSERT TEXTOBJ EVENT))
|
||||
(:Move (\TEDIT.UNDO.MOVE TSTREAM EVENT))
|
||||
(:Delete (* ; "Deletion or case-shift")
|
||||
(\TEDIT.UNDO.DELETE TEXTOBJ EVENT))
|
||||
(:CharLooks (* ; "Character-looks change")
|
||||
(\TEDIT.UNDO.CHARLOOKS TEXTOBJ EVENT))
|
||||
(:ParaLooks (* ; "PARA looks change")
|
||||
(\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
|
||||
(:PageFormat (* ; "Pageframe change")
|
||||
(\TEDIT.UNDO.PAGELOOKS TEXTOBJ EVENT))
|
||||
((LIST :Replace :LowerCase :UpperCase)
|
||||
|
||||
(\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:Closefile (* ; "Closes an included file")
|
||||
(CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
|
||||
(CLOSEF? (GETTH EVENT THOLDINFO))))
|
||||
((LIST :Get :Put) (* ;
|
||||
(* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")
|
||||
|
||||
(\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:ReplaceCode (\TEDIT.UNDO.REPLACECODE TEXTOBJ EVENT))
|
||||
(:Closefile (* ; "Closes an included file")
|
||||
(CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
|
||||
(CLOSEF? (GETTH EVENT THOLDINFO))))
|
||||
(:Composite (\TEDIT.UNDO.COMPOSITE TSTREAM EVENT))
|
||||
((LIST :Get :Put) (* ;
|
||||
"He did a GET or PUT-- not undoable.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
|
||||
T))
|
||||
(LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
|
||||
TEDIT.HISTORY.TYPELST]
|
||||
(COND
|
||||
(UNDOFN
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION
|
||||
))
|
||||
T))
|
||||
(LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
|
||||
TEDIT.HISTORY.TYPELST]
|
||||
(COND
|
||||
(UNDOFN
|
||||
|
||||
(* ;; "<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
|
||||
(* ;;
|
||||
"<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
|
||||
|
||||
(APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
|
||||
(GETTH EVENT THCH#)
|
||||
(GETTH EVENT THFIRSTPIECE)))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for " (GETTH EVENT
|
||||
THACTION))
|
||||
T])
|
||||
(APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
|
||||
(GETTH EVENT THCH#)
|
||||
(GETTH EVENT THFIRSTPIECE)))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for "
|
||||
(GETTH EVENT THACTION))
|
||||
T])
|
||||
|
||||
(TEDIT.REDO
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 15-Mar-2024 13:36 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 2-Feb-2025 11:28 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 17:53 by rmk")
|
||||
(* ; "Edited 27-Nov-2024 23:11 by rmk")
|
||||
(* ; "Edited 26-Sep-2024 16:49 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:58 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 07:41 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:23 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:08 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:36 by rmk")
|
||||
(* ; "Edited 7-May-2024 23:13 by rmk")
|
||||
(* ; "Edited 4-Mar-2024 21:33 by rmk")
|
||||
(* ; "Edited 2-Mar-2024 09:41 by rmk")
|
||||
(* ; "Edited 21-Dec-2023 11:57 by rmk")
|
||||
@@ -343,71 +472,81 @@
|
||||
|
||||
(* ;; "REDO the last thing this guy did.")
|
||||
|
||||
(CL:UNLESS (GETTOBJ TEXTOBJ TXTREADONLY)
|
||||
(PROG ((SEL (GETTOBJ TEXTOBJ SEL))
|
||||
(EVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
CH)
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
|
||||
(RETURN))
|
||||
(CL:UNLESS (GETSEL SEL SET)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
|
||||
(RETURN))
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (GETTOBJ TEXTOBJ SEL))
|
||||
(EVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
CH)
|
||||
(CL:WHEN (\TEDIT.READONLY TEXTOBJ)
|
||||
(RETURN NIL))
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
|
||||
(RETURN))
|
||||
(CL:UNLESS (GETSEL SEL SET)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
|
||||
(RETURN))
|
||||
|
||||
(* ;; "There really is something to redo and something to do it to.")
|
||||
(* ;; "There really is something to redo and something to do it to.")
|
||||
|
||||
(\TEDIT.SHOWSEL SEL NIL)
|
||||
(SELECTC (GETTH EVENT THACTION)
|
||||
((LIST :Insert :Copy :Move) (* ; "It was an insertion")
|
||||
(\TEDIT.REDO.INSERTION TEXTOBJ EVENT SEL))
|
||||
(:Delete (* ; "It was a deletion")
|
||||
(\TEDIT.DELETE TEXTOBJ SEL))
|
||||
(:Replace (* ;
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(SELECTC (GETTH EVENT THACTION)
|
||||
((LIST :Insert :Copy :Move) (* ; "It was an insertion")
|
||||
(\TEDIT.REDO.INSERT TEXTOBJ EVENT SEL))
|
||||
(:Delete (* ; "It was a deletion")
|
||||
(\TEDIT.DELETE TEXTOBJ SEL))
|
||||
(:Replace (* ;
|
||||
"It was a replacement (a del/insert combo)")
|
||||
(\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:LowerCase (* ; "He lower-cased something")
|
||||
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(:UpperCase (* ; "He upper-cased something")
|
||||
(\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(:Looks (* ; "It was a character looks change")
|
||||
(TEDIT.LOOKS TEXTOBJ (PLOOKS (GETTH EVENT THFIRSTPIECE))
|
||||
SEL))
|
||||
(:ParaLooks (* ; "It was a Paragraph looks change")
|
||||
(TEDIT.PARALOOKS TEXTOBJ (PPARALOOKS (GETTH EVENT THFIRSTPIECE))
|
||||
SEL))
|
||||
(:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
|
||||
(:Find (* ; "EXACT-MATCH SEARCH COMMAND")
|
||||
(\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:LowerCase (* ; "He lower-cased something")
|
||||
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(:UpperCase (* ; "He upper-cased something")
|
||||
(\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(:CharLooks (* ; "It was a character looks change")
|
||||
(\TEDIT.CHANGE.CHARLOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
|
||||
SEL))
|
||||
(:ParaLooks (* ; "It was a Paragraph looks change")
|
||||
(\TEDIT.CHANGE.PARALOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
|
||||
SEL))
|
||||
(:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
|
||||
(:Find (* ; "EXACT-MATCH SEARCH COMMAND")
|
||||
(* (* ;; "RESTLST ?")
|
||||
(AND NIL (RESETSAVE (CURSOR
|
||||
WAITINGCURSOR))) (TEDIT.PROMPTPRINT
|
||||
TEXTOBJ "Searching..." T)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of
|
||||
TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL)
|
||||
(SETQ CH (TEDIT.FIND TEXTOBJ
|
||||
TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL NIL
|
||||
TEXTOBJ) (SETQ CH (TEDIT.FIND TEXTOBJ
|
||||
(GETTH EVENT THAUXINFO)))
|
||||
(COND (CH (TEDIT.PROMPTPRINT TEXTOBJ
|
||||
"done.") (\TEDIT.UPDATE.SEL SEL CH
|
||||
(NCHARS (GETTH EVENT THAUXINFO))
|
||||
(QUOTE RIGHT)) (\TEDIT.FIXSEL SEL
|
||||
TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T))
|
||||
(\TEDIT.SHOWSEL SEL T NIL TEXTOBJ))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ
|
||||
"[Not found]"))))
|
||||
)
|
||||
(:Move (* ; "He moved some text")
|
||||
(\TEDIT.REDO.MOVE TEXTOBJ EVENT (GETTH EVENT THLEN)
|
||||
(IMAX 1 (TEDIT.GETPOINT NIL SEL))
|
||||
(GETTH EVENT THFIRSTPIECE)))
|
||||
((LIST :Get :Put) (* ; "Why can't you redo a get or put ?")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
|
||||
T T))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
|
||||
" isn't implemented.")
|
||||
T))
|
||||
(\TEDIT.SHOWSEL SEL T)))])
|
||||
)
|
||||
(:Move
|
||||
(* ;; "It doesn't make sense to do the deletion part of a move in the same place or a different place. The insert part is probably OK--that maps to the :Insert clause above.")
|
||||
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
|
||||
T T))
|
||||
(:Composite (\TEDIT.REDO.COMPOSITE TEXTOBJ EVENT SEL))
|
||||
((LIST :Get :Put NIL) (* ; "Why can't you redo a get or put ?")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
|
||||
T T))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
|
||||
" isn't implemented.")
|
||||
T))
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO.UNDO
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 3-Mar-2024 21:27 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 8-Dec-2024 18:24 by rmk")
|
||||
(* ; "Edited 26-Sep-2024 22:57 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 11:08 by rmk")
|
||||
(* ; "Edited 12-Aug-2024 23:45 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 09:50 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 21:27 by rmk")
|
||||
(* ; "Edited 13-Jun-2023 15:05 by rmk")
|
||||
(* ; "Edited 3-Jun-2023 23:04 by rmk")
|
||||
(* ; "Edited 1-Jun-2023 23:53 by rmk")
|
||||
@@ -419,33 +558,34 @@
|
||||
|
||||
(* ;; "This makes sense only if the document is now in the state immediately after the undoing--if any other events have intervened, the character positions and the general state of the document are unrelated. So the elements of the undo list also contain the state of the (forward) history list after the undoing was undone. If we have moved back to the same point in history, we can do the undoing.")
|
||||
|
||||
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "" T)
|
||||
(LET [(LASTUNDONE (pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE]
|
||||
(if (NULL LASTUNDONE)
|
||||
then (TEDIT.PROMPTPRINT TEXTOBJ "There is no action whose undoing can be reversed" T)
|
||||
elseif (EQ (CAR LASTUNDONE)
|
||||
(\TEDIT.LASTEVENT TEXTOBJ))
|
||||
then
|
||||
(* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.")
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(LASTUNDONE (pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE]
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
(if (NULL LASTUNDONE)
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "There is no action whose undoing can be reversed")
|
||||
elseif (EQ (CAR LASTUNDONE)
|
||||
(\TEDIT.LASTEVENT TEXTOBJ))
|
||||
then
|
||||
(* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.")
|
||||
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORY)
|
||||
(CADR LASTUNDONE))
|
||||
(TEDIT.UNDO TEXTOBJ)
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ (CADR LASTUNDONE))
|
||||
(TEDIT.UNDO TSTREAM)
|
||||
(TEDIT.PROMPTPRINT TSTREAM "Undo undone" T)
|
||||
|
||||
(* ;; "This saved what we just undid, don't want to keep reundoing it.")
|
||||
(* ;; "This undoing saved what we just undid, don't want to keep reundoing it.")
|
||||
|
||||
(pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE))
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORY)
|
||||
(CADDR LASTUNDONE))
|
||||
else (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) (* ;
|
||||
(pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE))
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ (CADDR LASTUNDONE))
|
||||
else (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) (* ;
|
||||
"If something else has happened, there are no undos to undo.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Cannot undo the previous undo" T])
|
||||
(TEDIT.PROMPTPRINT TSTREAM "Cannot undo the previous undo" T])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.UNDO.INSERTION
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-2023 22:54 by rmk")
|
||||
(\TEDIT.UNDO.INSERT
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 8-Jul-2024 00:07 by rmk")
|
||||
(* ; "Edited 30-May-2023 22:54 by rmk")
|
||||
(* ; "Edited 26-May-2023 23:49 by rmk")
|
||||
(* ; "Edited 24-May-2023 23:53 by rmk")
|
||||
(* ; "Edited 2-May-2023 23:26 by rmk")
|
||||
@@ -453,11 +593,13 @@
|
||||
|
||||
(* ;; "UNDO a prior Insert, Copy, or Include. ")
|
||||
|
||||
(\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
EVENT])
|
||||
(\TEDIT.DELETE TEXTOBJ (\TEDIT.FIXSEL (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
EVENT)
|
||||
TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO.DELETION
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(\TEDIT.UNDO.DELETE
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 29-Sep-2024 00:23 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 30-May-2023 23:31 by rmk")
|
||||
(* ; "Edited 27-May-2023 23:39 by rmk")
|
||||
(* ; "Edited 21-Apr-93 12:01 by jds")
|
||||
@@ -470,35 +612,32 @@
|
||||
(GETTH EVENT THCH#])
|
||||
|
||||
(\TEDIT.UNDO.MOVE
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 8-Dec-2024 19:38 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 14:12 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 00:23 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:50 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 10:17 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 4-Mar-2024 16:08 by rmk")
|
||||
|
||||
(* ;; "If the deletion from TEDIT.MOVE was not in TEXTOBJ, the FOBJ must have been a separate document. If FOBJ is still in the state just after that deletion, it can be undone there. But if FOBJ is not in that state, undoing doesn't there make sense. The deleted string would reappear in some random place.")
|
||||
(* ;; "This event includes a deletion and an insert/replace both within TEXTOBJ. (The deletion from a from a foreign textobj is in that document's history.)")
|
||||
|
||||
(LET ((DELEVENT (CAR (GETTH EVENT THOLDINFO)))
|
||||
(FOBJ (CDR (GETTH EVENT THOLDINFO)))
|
||||
(SEL (FGETTOBJ TEXTOBJ SEL)))
|
||||
(\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL SEL EVENT))
|
||||
(* ; "Undo the insert in this document")
|
||||
(CL:WHEN (GETTH EVENT THDELETEDPIECES) (* ;
|
||||
":Move must have started as :Replace")
|
||||
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
|
||||
'INSERT TEXTOBJ)
|
||||
TEXTOBJ
|
||||
(GETTH EVENT THCH#)))
|
||||
(if FOBJ
|
||||
then (CL:WHEN (EQ DELEVENT (\TEDIT.LASTEVENT FOBJ))
|
||||
(* ;
|
||||
"Delete is last event in other document")
|
||||
(TEDIT.UNDO FOBJ))
|
||||
else (\TEDIT.UNDO1 TEXTOBJ DELEVENT))
|
||||
|
||||
(* ;; "Put the point back after the original target. Caller wil fix it.")
|
||||
|
||||
(\TEDIT.UPDATE.SEL SEL EVENT 0 'LEFT T])
|
||||
(LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
(REPLACE (EQ :Replace (GETTH (CAR (GETTH EVENT THOLDINFO))
|
||||
THACTION]
|
||||
(\TEDIT.UNDO.COMPOSITE TSTREAM EVENT)
|
||||
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL (if REPLACE
|
||||
then (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
|
||||
'PENDINGDEL
|
||||
else 'NORMAL))
|
||||
(\TEDIT.FIXSEL SEL TSTREAM)
|
||||
(\TEDIT.SHOWSEL SEL T TSTREAM])
|
||||
|
||||
(\TEDIT.UNDO.REPLACE
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 13-Sep-2024 23:50 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:59 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 30-May-2023 23:10 by rmk")
|
||||
(* ; "Edited 27-May-2023 16:49 by rmk")
|
||||
(* ; "Edited 24-May-2023 22:43 by rmk")
|
||||
@@ -508,27 +647,176 @@
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
|
||||
NIL TEXTOBJ)
|
||||
TEXTOBJ
|
||||
(\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
EVENT))
|
||||
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
|
||||
THACTION ACTION])
|
||||
|
||||
(\TEDIT.UNDO.CHARLOOKS
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 25-Nov-2024 21:59 by rmk")
|
||||
(* ; "Edited 28-Sep-2024 22:37 by rmk")
|
||||
(* ; "Edited 26-Sep-2024 16:06 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 22:11 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 22:54 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:21 by rmk")
|
||||
(* ; "Edited 19-Feb-2024 11:32 by rmk")
|
||||
(* ; "Edited 14-Dec-2023 21:01 by rmk")
|
||||
(* ; "Edited 30-May-2023 22:56 by rmk")
|
||||
(* ; "Edited 18-Apr-2023 23:56 by rmk")
|
||||
(* ; "Edited 30-May-91 21:44 by jds")
|
||||
|
||||
(* ;; "Undo the setting of character looks. The undolist is a list of (NEXTCHNO . OLDCHARLOOKS) pairs, where OLDCHARLOOKS NIL means nothing changed. We have to track the character numbers because pieces may have been split by future events that were then undone. NEXTCHNO is the first character number of the next original piece")
|
||||
|
||||
(for U OLDLOOKS NEWUNDOLIST NEXTCHNO (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
|
||||
TEXTOBJ))
|
||||
(CHNO _ (GETTH EVENT THCH#))
|
||||
(SEL _ (FGETTOBJ TEXTOBJ SEL))
|
||||
(CARETPC _ (\TEDIT.CARETPIECE TEXTOBJ)) in (CDR (GETTH EVENT THOLDINFO))
|
||||
do
|
||||
(* ;; "Revert changes until we see the character number of the next changed piece. The initial NEXTCHNO is ")
|
||||
|
||||
(* ;; "Perhaps we should also save the CHNO of the CARETPC")
|
||||
|
||||
(SETQ NEXTCHNO (CAR U))
|
||||
(SETQ OLDLOOKS (CDR U))
|
||||
(CL:WHEN (AND OLDLOOKS (EQ PC CARETPC))
|
||||
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ OLDLOOKS)))
|
||||
[push NEWUNDOLIST (CONS NEXTCHNO (CL:IF OLDLOOKS (PLOOKS PC]
|
||||
|
||||
(* ;; "U starts at the first piece. We want CHNO to be the start of the next piece, i.e. initialize to (CAR(CDR ...)) But then, what about the last piece. Maybe we have to do our own popping, or look at UTAIL. Or end in (NEXTPC-CHNO . NIL ). Or text for IGEQ THCHLIM")
|
||||
|
||||
(for P inpieces PC do (FSETPC P PLOOKS OLDLOOKS)
|
||||
(add CHNO (PLEN P))
|
||||
(CL:WHEN (IEQP CHNO NEXTCHNO)(* ; "First piece of the next run")
|
||||
(SETQ PC P)
|
||||
(RETURN))) finally
|
||||
|
||||
(* ;;
|
||||
"Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")
|
||||
|
||||
(CL:WHEN NEWUNDOLIST
|
||||
(change (GETTH EVENT THOLDINFO)
|
||||
(CONS (CAR DATUM)
|
||||
(DREVERSE NEWUNDOLIST)))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
|
||||
'NORMAL)
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS
|
||||
(GETTH EVENT THCH#)
|
||||
(GETTH EVENT THLEN))
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ
|
||||
"Character looks restored" T))
|
||||
|
||||
(* ;;
|
||||
"Save the event for REDO, even if these pieces didn't change")
|
||||
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
|
||||
|
||||
(\TEDIT.UNDO.PARALOOKS
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 25-Nov-2024 22:00 by rmk")
|
||||
(* ; "Edited 28-Sep-2024 22:38 by rmk")
|
||||
(* ; "Edited 27-Sep-2024 12:23 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 22:10 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 22:54 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:22 by rmk")
|
||||
(* ; "Edited 19-Feb-2024 11:32 by rmk")
|
||||
(* ; "Edited 11-Dec-2023 11:10 by rmk")
|
||||
(* ; "Edited 21-Sep-2023 23:51 by rmk")
|
||||
(* ; "Edited 30-May-2023 22:55 by rmk")
|
||||
(* ; "Edited 18-Apr-2023 23:57 by rmk")
|
||||
(* ; "Edited 30-May-91 21:44 by jds")
|
||||
|
||||
(* ;; "Undo the setting of paragraph looks.")
|
||||
|
||||
(for U OLDLOOKS NEWUNDOLIST (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
|
||||
TEXTOBJ))
|
||||
(CHNO _ (GETTH EVENT THCH#))
|
||||
(SEL _ (FGETTOBJ TEXTOBJ SEL)) in (CDR (GETTH EVENT THOLDINFO))
|
||||
do
|
||||
(* ;; "Find the first piece of the next changed paragraph")
|
||||
|
||||
(for P inpieces PC do (CL:WHEN (IEQP CHNO (CAR U))
|
||||
(SETQ PC P)
|
||||
(RETURN))
|
||||
(add CHNO (PLEN P)))
|
||||
(SETQ OLDLOOKS (CDR U))
|
||||
(push NEWUNDOLIST (CONS CHNO (PPARALOOKS PC))) (* ; "Save for UNDO UNDO")
|
||||
|
||||
(* ;; "Change all the pieces in this paragraph")
|
||||
|
||||
(for P inpieces PC do (FSETPC P PPARALOOKS OLDLOOKS)
|
||||
(CL:WHEN (PPARALAST P)
|
||||
(SETQ PC P)
|
||||
(RETURN))
|
||||
(add CHNO (PLEN P))) finally
|
||||
|
||||
(* ;;
|
||||
"Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")
|
||||
|
||||
(CL:WHEN NEWUNDOLIST
|
||||
(change (GETTH EVENT THOLDINFO)
|
||||
(CONS (CAR DATUM)
|
||||
(DREVERSE NEWUNDOLIST)))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
|
||||
'NORMAL)
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ
|
||||
'LOOKS
|
||||
(GETTH EVENT THCH#)
|
||||
(GETTH EVENT THLEN))
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ
|
||||
"Paragraph looks restored" T))
|
||||
|
||||
(* ;;
|
||||
"Save the event for REDO, even if these pieces didn't change")
|
||||
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
|
||||
|
||||
(\TEDIT.UNDO.PAGELOOKS
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 12-Aug-2024 10:28 by rmk")
|
||||
[SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (COPYALL (GETTH EVENT THOLDINFO))
|
||||
(SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))]
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Page formats restored" T)
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
|
||||
|
||||
(\TEDIT.UNDO.COMPOSITE
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 8-Dec-2024 15:47 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 22:27 by rmk")
|
||||
(* ; "Edited 15-Aug-2024 10:14 by rmk")
|
||||
(* ; "Edited 7-May-2024 23:17 by rmk")
|
||||
|
||||
(* ;; "A composite event is a group of other events that are to be undone at the same time. Only show the selection of the last undo event. We want to end up with a single event on history. We don't want to bump the count. (Presumably EVENT was alread popped)")
|
||||
|
||||
(for E EVENTS CUREVENT (TEXTOBJ _ (GETTSTR TSTREAM TEXTOBJ)) in (GETTH EVENT THOLDINFO)
|
||||
do (SETQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
(\TEDIT.UNDO1 TSTREAM E)
|
||||
(CL:UNLESS (EQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))(* ; "Something changed")
|
||||
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ)))
|
||||
(\TEDIT.SHOWSEL NIL NIL TSTREAM) finally (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))
|
||||
(\TEDIT.SCROLL.CARET TSTREAM])
|
||||
|
||||
(\TEDIT.UNDO.REPLACECODE
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 23-Sep-2024 00:45 by rmk")
|
||||
(TEDIT.RPLCHARCODE TEXTOBJ (GETTH EVENT THCH#)
|
||||
(GETTH EVENT THOLDINFO])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.REDO.INSERTION
|
||||
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(\TEDIT.REDO.INSERT
|
||||
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 15-Aug-2024 10:47 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 31-May-2023 10:26 by rmk")
|
||||
(* ; "Edited 18-May-2023 19:24 by rmk")
|
||||
(* ; "Edited 21-Apr-93 01:06 by jds")
|
||||
|
||||
(* ;; "Copies of the pieces inserted at the previous insertion EVENT are inserted at SEL's caret. We can extract the relevant pieces from the event's text position, because we know that either EVENT was the last event or other events after it have been undone, and the pieces are back to their original state.")
|
||||
|
||||
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
|
||||
'INSERT TEXTOBJ)
|
||||
TEXTOBJ SEL])
|
||||
|
||||
(\TEDIT.REDO.REPLACE
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 7-Jul-2024 11:59 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 2-Oct-2023 11:43 by rmk")
|
||||
(* ; "Edited 31-May-2023 10:25 by rmk")
|
||||
(* ; "Edited 27-May-2023 11:16 by rmk")
|
||||
@@ -540,31 +828,25 @@
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
|
||||
NIL TEXTOBJ)
|
||||
TEXTOBJ
|
||||
(\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL (GETTOBJ TEXTOBJ SEL)
|
||||
EVENT))
|
||||
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
|
||||
THACTION ACTION])
|
||||
|
||||
(\TEDIT.REDO.MOVE
|
||||
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 15-Mar-2024 13:36 by rmk")
|
||||
(* ; "Edited 16-Feb-2024 23:36 by rmk")
|
||||
(* ; "Edited 7-Jun-2023 23:19 by rmk")
|
||||
(* ; "Edited 27-May-2023 11:18 by rmk")
|
||||
(* ; "Edited 23-May-2023 12:54 by rmk")
|
||||
(* ; "Edited 30-May-91 21:28 by jds")
|
||||
(LET ((SCR2 (GETTOBJ TEXTOBJ SCRATCHSEL2)))
|
||||
(\TEDIT.UPDATE.SEL SCR2 (GETTH EVENT THCH#)
|
||||
LEN)
|
||||
(SETSEL SCR2 SET T)
|
||||
(\TEDIT.FIXSEL SCR2 TEXTOBJ)
|
||||
(\TEDIT.SET.SEL.LOOKS SCR2 'MOVE)
|
||||
(TEDIT.MOVE SCR2 (FGETTOBJ TEXTOBJ SEL])
|
||||
(\TEDIT.REDO.COMPOSITE
|
||||
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 7-May-2024 23:12 by rmk")
|
||||
(\TEDIT.THELP 'Redo-composite])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4834 5855 (\TEDIT.HISTORYEVENT.DEFPRINT 4844 . 5853)) (6621 12187 (\TEDIT.HISTORYADD
|
||||
6631 . 10707) (\TEDIT.CUMULATE.EVENTS 10709 . 12185)) (12240 26023 (TEDIT.UNDO 12250 . 15439) (
|
||||
\TEDIT.UNDO1 15441 . 18506) (TEDIT.REDO 18508 . 23783) (\TEDIT.UNDO.UNDO 23785 . 26021)) (26024 30162
|
||||
(\TEDIT.UNDO.INSERTION 26034 . 26791) (\TEDIT.UNDO.DELETION 26793 . 27480) (\TEDIT.UNDO.MOVE 27482 .
|
||||
29257) (\TEDIT.UNDO.REPLACE 29259 . 30160)) (30163 33325 (\TEDIT.REDO.INSERTION 30173 . 31123) (
|
||||
\TEDIT.REDO.REPLACE 31125 . 32366) (\TEDIT.REDO.MOVE 32368 . 33323)))))
|
||||
(FILEMAP (NIL (4913 5934 (\TEDIT.HISTORYEVENT.DEFPRINT 4923 . 5932)) (7024 17609 (\TEDIT.HISTORYADD
|
||||
7034 . 11895) (\TEDIT.HISTORYADD.COMPOSITE 11897 . 12803) (\TEDIT.CUMULATE.EVENTS 12805 . 14399) (
|
||||
\TEDIT.COMPOSITE.EVENT 14401 . 15137) (\TEDIT.HISTORY.PROP 15139 . 16502) (\TEDIT.HISTORY.EVENT 16504
|
||||
. 17433) (\TEDIT.POPEVENT 17435 . 17607)) (17662 35601 (TEDIT.UNDO 17672 . 22066) (\TEDIT.UNDO1 22068
|
||||
. 26280) (TEDIT.REDO 26282 . 32755) (\TEDIT.UNDO.UNDO 32757 . 35599)) (35602 50688 (
|
||||
\TEDIT.UNDO.INSERT 35612 . 36525) (\TEDIT.UNDO.DELETE 36527 . 37321) (\TEDIT.UNDO.MOVE 37323 . 38912)
|
||||
(\TEDIT.UNDO.REPLACE 38914 . 40010) (\TEDIT.UNDO.CHARLOOKS 40012 . 44586) (\TEDIT.UNDO.PARALOOKS 44588
|
||||
. 48820) (\TEDIT.UNDO.PAGELOOKS 48822 . 49231) (\TEDIT.UNDO.COMPOSITE 49233 . 50460) (
|
||||
\TEDIT.UNDO.REPLACECODE 50462 . 50686)) (50689 53049 (\TEDIT.REDO.INSERT 50699 . 51432) (
|
||||
\TEDIT.REDO.REPLACE 51434 . 52765) (\TEDIT.REDO.COMPOSITE 52767 . 53047)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Mar-2024 11:07:07" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;239 66617
|
||||
(FILECREATED " 8-Feb-2025 20:56:54" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;248 68998
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.INSERTPIECES)
|
||||
:CHANGES-TO (FNS \TEDIT.MAKEPCTB)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 12:41:57" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;238)
|
||||
:PREVIOUS-DATE " 7-Feb-2025 08:31:28" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;246)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||
@@ -25,7 +25,7 @@
|
||||
(RECORDS BTREENODE BTSLOT)
|
||||
(MACROS \NTHSLOT \NEXTSLOT \PREVSLOT \LASTSLOT \FIRSTSLOT \MOVESLOT \FILLSLOT
|
||||
\FINDSLOT)
|
||||
(MACROS \LASTPIECEP)
|
||||
(MACROS \SUFFIXPIECEP)
|
||||
(I.S.OPRS inslots inpieces backpieces))
|
||||
(MACROS \INSURE.VACANT.BTREESLOT)
|
||||
(ADDVARS (INSPECTDONTSORTFIELDS BTREENODE)))
|
||||
@@ -138,9 +138,9 @@
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \LASTPIECEP MACRO (OPENLAMBDA (PC TOBJ)
|
||||
(AND (EQ PC (ffetch (TEXTOBJ LASTPIECE) of TOBJ))
|
||||
PC)))
|
||||
(PUTPROPS \SUFFIXPIECEP MACRO (OPENLAMBDA (PC TOBJ)
|
||||
(AND (EQ PC (FGETTOBJ TOBJ SUFFIXPIECE))
|
||||
PC)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -215,7 +215,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.MAKEPCTB
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Dec-2023 12:41 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 8-Feb-2025 20:14 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:02 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 12:41 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:09 by rmk")
|
||||
(* ; "Edited 8-Sep-2023 16:30 by rmk")
|
||||
(* ; "Edited 26-Apr-2023 14:03 by rmk")
|
||||
@@ -236,8 +238,8 @@
|
||||
PLEN _ 0
|
||||
PTREENODE _ NODE
|
||||
PLOOKS _ (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS)
|
||||
PPARALOOKS _ (GETTOBJ TEXTOBJ FMTSPEC)))
|
||||
(FSETTOBJ TEXTOBJ LASTPIECE (ffetch (BTREENODE DOWN1) of NODE))
|
||||
PPARALOOKS _ (GETTOBJ TEXTOBJ DEFAULTPARALOOKS)))
|
||||
(FSETTOBJ TEXTOBJ SUFFIXPIECE (ffetch (BTREENODE DOWN1) of NODE))
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(FSETTOBJ TEXTOBJ TEXTLEN 0)
|
||||
(FSETTOBJ TEXTOBJ PCTB (CONS NODE])
|
||||
@@ -272,19 +274,26 @@
|
||||
DELTA])
|
||||
|
||||
(\TEDIT.FIRSTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Feb-2025 08:02 by rmk")
|
||||
(* ; "Edited 21-Aug-2024 16:07 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
(* ; "Edited 11-Apr-2023 12:54 by rmk")
|
||||
(* ; "Edited 24-Aug-2022 12:45 by rmk")
|
||||
(for (NODE _ (CAR (GETTOBJ TEXTOBJ PCTB))) by (ffetch (BTREENODE DOWN1) of NODE)
|
||||
(for (NODE _ (CAR (GETTOBJ (if (type? TEXTOBJ TEXTOBJ)
|
||||
then TEXTOBJ
|
||||
elseif (type? STREAM TEXTOBJ)
|
||||
then (fetch (TEXTSTREAM TEXTOBJ) of TEXTOBJ))
|
||||
PCTB))) by (ffetch (BTREENODE DOWN1) of NODE)
|
||||
unless (type? BTREENODE NODE) do
|
||||
|
||||
(* ;; "If we don't bottom out in a piece, something else is screwed up. But we return NIL for the last piece, which is only there to hold the PREV pointer to the real last piece (and maybe the initial looks).")
|
||||
|
||||
(RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
NODE])
|
||||
|
||||
(\TEDIT.DELETETREE
|
||||
[LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 17-Mar-2024 00:22 by rmk")
|
||||
[LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:22 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:23 by rmk")
|
||||
(* ; "Edited 26-Oct-2023 12:50 by rmk")
|
||||
(* ; "Edited 30-May-2023 08:58 by rmk")
|
||||
@@ -313,7 +322,7 @@
|
||||
|
||||
(bind TARGET OLDSLOT (LAST _ (\LASTSLOT PCNODE))
|
||||
first (SETQ OLDSLOT (\FINDSLOT PCNODE OLD))
|
||||
(CL:UNLESS OLDSLOT (SHOULDNT "Piece/node not in PCNODE"))
|
||||
(CL:UNLESS OLDSLOT (\TEDIT.THELP "Piece/node not in PCNODE"))
|
||||
(CL:WHEN (EQ OLDSLOT LAST) (* ; "Just shrink by one")
|
||||
(\FILLSLOT OLDSLOT NIL 0)
|
||||
(GO $$OUT))
|
||||
@@ -377,16 +386,16 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.LASTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 10:20 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Feb-2025 08:20 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:20 by rmk")
|
||||
(* ; "Edited 12-Apr-2023 19:23 by rmk")
|
||||
(* ; "Edited 21-Aug-2022 17:13 by rmk")
|
||||
(* ; "Edited 16-Aug-2022 10:16 by rmk")
|
||||
(* ; "Edited 14-Apr-93 16:29 by jds")
|
||||
|
||||
(* ;; "Returns the LASTPIECE by running down the right side of the B-tree. Should be the same as (fetch LASTPIECE of TEXTOBJ). Argument can also be a node.")
|
||||
(* ;; "Returns the last real piece of the text, NIL for an empty document.")
|
||||
|
||||
(bind [CHILD _ (CAR (LAST (GETTOBJ TEXTOBJ PCTB] while (type? BTREENODE CHILD)
|
||||
do (SETQ CHILD (ffetch (BTSLOT DOWN) of (\LASTSLOT CHILD))) finally (RETURN CHILD])
|
||||
(PREVPIECE (FGETTOBJ TEXTOBJ SUFFIXPIECE])
|
||||
|
||||
(\TEDIT.PCTOCH
|
||||
[LAMBDA (PC TEXTOBJ) (* ; "Edited 31-Oct-2023 21:05 by rmk")
|
||||
@@ -415,7 +424,8 @@
|
||||
of TOPNODE])
|
||||
|
||||
(\TEDIT.CHTOPC
|
||||
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 4-Nov-2023 17:56 by rmk")
|
||||
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 7-Feb-2025 08:29 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 17:56 by rmk")
|
||||
(* ; "Edited 1-Nov-2023 23:29 by rmk")
|
||||
(* ; "Edited 13-Apr-2023 22:22 by rmk")
|
||||
(* ; "Edited 12-Apr-2023 09:49 by rmk")
|
||||
@@ -429,7 +439,7 @@
|
||||
|
||||
(* ;; "There are 2 acceleration cases:")
|
||||
|
||||
(* ;; " if CH# is after the current text length, the pseudo LASTPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.")
|
||||
(* ;; " if CH# is after the current text length, the pseudo SUFFIXPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.")
|
||||
|
||||
(* ;; " If the TEXTOBJ contains a HINTPC and CH# is in the range HINTPCSTARTCH# and HINTPCSTARTCH#+PLEN-1, then HINTPC is returned. Others may cache that, but we cache it here too for repeated sequential calls.")
|
||||
|
||||
@@ -441,7 +451,7 @@
|
||||
(if (IGREATERP CH# (FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
then (CL:WHEN TELL-PC-START?
|
||||
(SETQ START-OF-PIECE (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN))))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
elseif (AND (SETQ HINTPC (FGETTOBJ TEXTOBJ HINTPC))
|
||||
(IGEQ CH# (SETQ STARTCH (FGETTOBJ TEXTOBJ HINTPCSTARTCH#)))
|
||||
(ILESSP (IDIFFERENCE CH# STARTCH)
|
||||
@@ -457,7 +467,7 @@
|
||||
|
||||
(* ;; "When PCTB is a list of top-level BTNODES, we find the sub-tree that contains the global CH# piece, sum the TOTLEN's of all prior top-level nodes, retrieve the piece from the identified subtree after adjusting to its LOCAL#. START-OF-PIECE, if required, is globally correct.")
|
||||
|
||||
(* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the LASTPIECE case above. Also look at \INSERTPIECE.")
|
||||
(* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the SUFFIXPIECE case above. Also look at \INSERTPIECE.")
|
||||
|
||||
(for old BASE-NODE NEXT in (FGETTOBJ TEXTOBJ PCTB)
|
||||
do (SETQ NEXT (IPLUS ALLPRIOR (ffetch (BTREENODE TOTLEN) of BASE-NODE)))
|
||||
@@ -504,18 +514,20 @@
|
||||
(RETURN NODE])
|
||||
|
||||
(\TEDIT.SET-TOTLEN
|
||||
[LAMBDA (PCNODE) (* ; "Edited 21-Oct-2023 17:22 by rmk")
|
||||
[LAMBDA (PCNODE) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:22 by rmk")
|
||||
(* ; "Edited 15-Aug-2022 17:15 by rmk")
|
||||
(* ; "Edited 9-May-93 15:40 by jds")
|
||||
|
||||
(* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths")
|
||||
|
||||
(HELP 'NOTCALLED)
|
||||
(\TEDIT.THELP 'NOTCALLED)
|
||||
(replace (BTREENODE TOTLEN) of PCNODE with (for S inslots PCNODE sum (fetch (BTSLOT DLEN)
|
||||
of S])
|
||||
|
||||
(\TEDIT.MAKE.VACANT.BTREESLOT
|
||||
[LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 16-Mar-2024 10:23 by rmk")
|
||||
[LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:23 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:08 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:32 by rmk")
|
||||
(* ; "Edited 10-Jun-2023 00:13 by rmk")
|
||||
@@ -563,7 +575,7 @@
|
||||
(UNINTERRUPTABLY
|
||||
(replace (BTREENODE UPWARD) of BTNODE with PARENT)
|
||||
(RPLACA (OR (FMEMB BTNODE (FGETTOBJ TEXTOBJ PCTB))
|
||||
(HELP "BTNODE NOT FOUND"))
|
||||
(\TEDIT.THELP "BTNODE NOT FOUND"))
|
||||
PARENT)))
|
||||
|
||||
(* ;; "Tree is still valid, but PARENT how has a needed empty slot.")
|
||||
@@ -620,16 +632,17 @@
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.MAKE.VACANT.BTREESLOT 'END TEXTOBJ)))])
|
||||
|
||||
(\TEDIT.LINKNEWPIECE
|
||||
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 29-May-2023 23:16 by rmk")
|
||||
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 7-Feb-2025 08:26 by rmk")
|
||||
(* ; "Edited 29-May-2023 23:16 by rmk")
|
||||
|
||||
(* ;; "Set up the linear-chain links to insert the piece NEW in front of the piece NEXT in its piece-chain. This doesn't deal with the btree.")
|
||||
|
||||
(* ;; "NEXT=NIL denotes the last piece LASTPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")
|
||||
(* ;; "NEXT=NIL denotes the last piece SUFFIXPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")
|
||||
|
||||
(CL:UNLESS NEXT
|
||||
(SETQ NEXT (ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)))
|
||||
(SETQ NEXT (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(LET ((NEXTPREV (PREVPIECE NEXT)))
|
||||
(freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\LASTPIECEP NEXT TEXTOBJ)
|
||||
(freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\SUFFIXPIECEP NEXT TEXTOBJ)
|
||||
NEXT))
|
||||
(* ; "NIL for last piece")
|
||||
(freplace (PIECE PREVPIECE) of NEW with NEXTPREV) (* ;
|
||||
@@ -643,19 +656,22 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.UNLINKPIECE
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2023 17:24 by rmk")
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:24 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:31 by rmk")
|
||||
|
||||
(* ;; "Takes PC out of the piece chain, linking prev and next around it.")
|
||||
|
||||
(HELP 'NOTCALLED?)
|
||||
(\TEDIT.THELP 'NOTCALLED?)
|
||||
(CL:WHEN PREV
|
||||
(freplace (PIECE NEXTPIECE) of PREV with (NEXTPIECE PC)))
|
||||
(freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC)
|
||||
(ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)) with PREV])
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)) with PREV])
|
||||
|
||||
(\TEDIT.SPLITPIECE
|
||||
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
(* ; "Edited 28-Dec-2023 22:17 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:07 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 11:50 by rmk")
|
||||
@@ -687,7 +703,7 @@
|
||||
(CONSTANT (APPEND STRING.PTYPES FILE.PTYPES)))
|
||||
(* ;
|
||||
"Dont' want the error under the UNINTERRABPTABLY. Remove when everything is good.")
|
||||
(SHOULDNT "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE"))
|
||||
(\TEDIT.THELP "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE"))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -722,7 +738,8 @@
|
||||
PC])
|
||||
|
||||
(\TEDIT.INSERTPIECE
|
||||
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:28 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:07 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 23:05 by rmk")
|
||||
(* ; "Edited 9-Jun-2023 22:40 by rmk")
|
||||
@@ -731,15 +748,15 @@
|
||||
|
||||
(* ;; "Insert the piece NEWPC in front of the piece NEXTPC. At the end, NEWPC appears before NEXTPC in the piece tree, and all counts and lengths are consistent.")
|
||||
|
||||
(* ;; "The last piece LASTPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the lastpiece has its rightful place in the tree.")
|
||||
(* ;; "The last piece SUFFIXPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the suffix piece has its rightful place in the tree.")
|
||||
|
||||
(* ;; "Caller guarantees that the chain links of NEW can be smashed.")
|
||||
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.INSERTPIECE 'START TEXTOBJ)
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(CL:UNLESS NEXTPC
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(* ; "Inserting at the very end")
|
||||
(LET ((PCTB (FGETTOBJ TEXTOBJ PCTB))
|
||||
LASTTREECONS)
|
||||
@@ -775,7 +792,8 @@
|
||||
NEWPC])
|
||||
|
||||
(\TEDIT.INSERTPIECES
|
||||
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 20-Mar-2024 10:55 by rmk")
|
||||
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:55 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:23 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:08 by rmk")
|
||||
@@ -793,7 +811,7 @@
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T)
|
||||
(CL:UNLESS NEXTPC
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(for PC (PREVPC _ (PREVPIECE NEXTPC)) inpieces PIECES
|
||||
do
|
||||
(* ;; "This is a variant of \INSERTPIECE specialized for filling in an empty TEXTOBJ from a piece chain. Insertion always happens before NEXTPC, and the chain-links are not smashed. ")
|
||||
@@ -809,7 +827,7 @@
|
||||
|
||||
(* ;; "PC is the final piece of the chain")
|
||||
|
||||
(CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(FSETPC PC NEXTPIECE NEXTPC))
|
||||
(FSETPC NEXTPC PREVPIECE PC)
|
||||
(CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PIECES))
|
||||
@@ -817,7 +835,9 @@
|
||||
PIECES])
|
||||
|
||||
(\TEDIT.DELETEPIECES
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 7-Feb-2025 08:08 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 12:12 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 23:03 by rmk")
|
||||
(* ; "Edited 22-Oct-2023 11:43 by rmk")
|
||||
@@ -829,7 +849,7 @@
|
||||
|
||||
(* ;; "As the PC is deleted from the tree on each iteration, the original previous PREV piece is linked to PC's next, and the next PREVPIECE is linked to PREV so that the tree and the links are uninterruptably consistent.")
|
||||
|
||||
(* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection. If SPLAST is the final actual piece (its NEXTPIECE is NIL), then LASTPIECE's PREVPIECE will be updated.")
|
||||
(* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection. If SPLAST is the final actual piece (its NEXTPIECE is NIL), then SUFFIXPIECE's PREVPIECE will be updated.")
|
||||
|
||||
(* ;; " Since the pieces are not unlinked on the fly, the tree may be invalid until all the pieces are gone.")
|
||||
|
||||
@@ -837,10 +857,11 @@
|
||||
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ)
|
||||
(for PC PREV NEXT first (FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(SETQ PREV (PREVPIECE (fetch (SELPIECES SPFIRST) of SELPIECES)))
|
||||
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
|
||||
(* ; "For incremental chain-update")
|
||||
(SETQ NEXT (OR (NEXTPIECE (fetch (SELPIECES SPLAST) of SELPIECES))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE))) inselpieces SELPIECES
|
||||
(SETQ NEXT (OR (NEXTPIECE (GETSPC SELPIECES SPLAST))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T) inselpieces SELPIECES
|
||||
do (UNINTERRUPTABLY
|
||||
(\TEDIT.UPDATEPCNODES PC (IMINUS (PLEN PC))
|
||||
TEXTOBJ)
|
||||
@@ -856,14 +877,15 @@
|
||||
(* ;;
|
||||
"TEXTOBJ has forgotten the SELPIECES, now make the SELPIECES also forget they were there.")
|
||||
|
||||
(FSETPC (fetch (SELPIECES SPFIRST) of SELPIECES)
|
||||
(FSETPC (GETSPC SELPIECES SPFIRST)
|
||||
PREVPIECE NIL)
|
||||
(FSETPC (fetch (SELPIECES SPLAST) of SELPIECES)
|
||||
(FSETPC (GETSPC SELPIECES SPLAST)
|
||||
NEXTPIECE NIL))
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'AFTER TEXTOBJ])
|
||||
|
||||
(\TEDIT.ALIGNEDPIECE
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 7-Feb-2025 08:05 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
(* ; "Edited 29-May-2023 23:48 by rmk")
|
||||
(* ; "Edited 20-May-2023 13:53 by rmk")
|
||||
@@ -878,7 +900,7 @@
|
||||
then
|
||||
(* ;; "Doesn't return NIL in this case, returns the last piece.")
|
||||
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
elseif (ILEQ CHNO 1)
|
||||
then (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
else (LET (PC START-OF-PIECE)
|
||||
@@ -944,13 +966,14 @@
|
||||
T])
|
||||
|
||||
(\TEDIT.CHECK-BTREE
|
||||
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 17-Mar-2024 00:25 by rmk")
|
||||
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 7-Feb-2025 08:07 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:25 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:33 by rmk")
|
||||
(* ; "Edited 7-Sep-2022 09:43 by rmk")
|
||||
(* ; "Edited 4-Sep-2022 16:37 by rmk")
|
||||
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
(for BT (LASTPIECE _ (FGETTOBJ TEXTOBJ LASTPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
|
||||
declare (SPECVARS LASTPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
|
||||
(for BT (SUFFIXPIECE _ (FGETTOBJ TEXTOBJ SUFFIXPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
|
||||
declare (SPECVARS SUFFIXPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
|
||||
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
do (SELECTC (PTYPE PC)
|
||||
(FILE.PTYPES (CL:UNLESS (STREAMP (PCONTENTS PC))
|
||||
@@ -977,7 +1000,8 @@
|
||||
'VALID])
|
||||
|
||||
(\TEDIT.CHECK-BTREE1
|
||||
[LAMBDA (NODE DEPTH PARENT) (* ; "Edited 31-Oct-2023 10:35 by rmk")
|
||||
[LAMBDA (NODE DEPTH PARENT) (* ; "Edited 7-Feb-2025 08:31 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:35 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:06 by rmk")
|
||||
(* ; "Edited 27-May-2023 15:00 by rmk")
|
||||
(* ; "Edited 1-Sep-2022 09:49 by rmk")
|
||||
@@ -987,30 +1011,30 @@
|
||||
(* ;;
|
||||
"Returns the TOTLEN/PLEN of NODE, after verifying that all of the nodes underneath are consistent.")
|
||||
|
||||
(DECLARE (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ LASTPIECE))
|
||||
(DECLARE (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ SUFFIXPIECE))
|
||||
(ADD DEPTH 1)
|
||||
(if (type? PIECE NODE)
|
||||
then [if (EQ NODE LASTPIECE)
|
||||
then (CL:WHEN (AND (PREVPIECE LASTPIECE)
|
||||
(NEXTPIECE (PREVPIECE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "(NEXT (PPREV of LASTPIECE is not NULL" LASTPIECE))
|
||||
then [if (EQ NODE SUFFIXPIECE)
|
||||
then (CL:WHEN (AND (PREVPIECE SUFFIXPIECE)
|
||||
(NEXTPIECE (PREVPIECE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "(NEXT (PPREV of SUFFIXPIECE is not NULL" SUFFIXPIECE))
|
||||
else (CL:UNLESS (IGEQ (PLEN NODE)
|
||||
0)
|
||||
(\TEDIT.BTFAIL "Negative PLEN" NODE))
|
||||
(CL:UNLESS (OR (NEXTPIECE NODE)
|
||||
(EQ NODE (PREVPIECE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of LASTPIECE" NODE))
|
||||
(EQ NODE (PREVPIECE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of SUFFIXPIECE" NODE))
|
||||
(CL:UNLESS (EQ PARENT (fetch (PIECE PTREENODE) of NODE))
|
||||
(\TEDIT.BTFAIL "Piece with wrong PTREENODE" NODE))
|
||||
(CL:WHEN (PREVPIECE NODE)
|
||||
(CL:UNLESS (OR (EQ NODE (NEXTPIECE (PREVPIECE NODE)))
|
||||
(AND (NULL (NEXTPIECE (PREVPIECE NODE)))
|
||||
(EQ NODE LASTPIECE)))
|
||||
(EQ NODE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "PREVPIECE is not consistent" NODE)))
|
||||
(CL:WHEN (OR (NEXTPIECE NODE)
|
||||
LASTPIECE)
|
||||
SUFFIXPIECE)
|
||||
(CL:UNLESS (EQ NODE (PREVPIECE (OR (NEXTPIECE NODE)
|
||||
LASTPIECE)))
|
||||
SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "NEXTPIECE is not consistent" NODE)))]
|
||||
(add NPIECES 1)
|
||||
(add [CDR (OR (SASSOC DEPTH DEPTHHIST)
|
||||
@@ -1057,12 +1081,13 @@
|
||||
|
||||
(\TEDIT.BTFAIL
|
||||
[LAMBDA (STRING VAL)
|
||||
(DECLARE (USEDFREE TAG MSG)) (* ; "Edited 28-May-2023 08:45 by rmk")
|
||||
(HELP (CONCAT (OR TAG "")
|
||||
" "
|
||||
(OR MSG "")
|
||||
": " STRING)
|
||||
VAL])
|
||||
(DECLARE (USEDFREE TAG MSG)) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 28-May-2023 08:45 by rmk")
|
||||
(\TEDIT.THELP (CONCAT (OR TAG "")
|
||||
" "
|
||||
(OR MSG "")
|
||||
": " STRING)
|
||||
VAL])
|
||||
|
||||
(\TEDIT.MATCHPCS
|
||||
[LAMBDA (NODE) (* ; "Edited 16-Mar-2024 11:07 by rmk")
|
||||
@@ -1085,13 +1110,13 @@
|
||||
(GLOBALVARS BTVALIDATETAGS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8698 54531 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
|
||||
\TEDIT.FIRSTPIECE 12557 . 13471) (\TEDIT.DELETETREE 13473 . 16634) (\TEDIT.INSERTTREE 16636 . 19381) (
|
||||
\TEDIT.LASTPIECE 19383 . 20319) (\TEDIT.PCTOCH 20321 . 22418) (\TEDIT.CHTOPC 22420 . 28482) (
|
||||
\TEDIT.SET-TOTLEN 28484 . 29155) (\TEDIT.MAKE.VACANT.BTREESLOT 29157 . 35770) (\TEDIT.LINKNEWPIECE
|
||||
35772 . 37265) (\TEDIT.UNLINKPIECE 37267 . 37878) (\TEDIT.SPLITPIECE 37880 . 42423) (
|
||||
\TEDIT.INSERTPIECE 42425 . 45578) (\TEDIT.INSERTPIECES 45580 . 48559) (\TEDIT.DELETEPIECES 48561 .
|
||||
52525) (\TEDIT.ALIGNEDPIECE 52527 . 54529)) (54559 66494 (\TEDIT.BTVALIDATE 54569 . 56110) (
|
||||
\TEDIT.BTVALIDATE.PRINT 56112 . 57477) (\TEDIT.CHECK-BTREE 57479 . 59691) (\TEDIT.CHECK-BTREE1 59693
|
||||
. 65193) (\TEDIT.BTFAIL 65195 . 65475) (\TEDIT.MATCHPCS 65477 . 66492)))))
|
||||
(FILEMAP (NIL (8685 56524 (\TEDIT.MAKEPCTB 8695 . 10475) (\TEDIT.UPDATEPCNODES 10477 . 12771) (
|
||||
\TEDIT.FIRSTPIECE 12773 . 14180) (\TEDIT.DELETETREE 14182 . 17456) (\TEDIT.INSERTTREE 17458 . 20203) (
|
||||
\TEDIT.LASTPIECE 20205 . 21012) (\TEDIT.PCTOCH 21014 . 23111) (\TEDIT.CHTOPC 23113 . 29290) (
|
||||
\TEDIT.SET-TOTLEN 29292 . 30080) (\TEDIT.MAKE.VACANT.BTREESLOT 30082 . 36812) (\TEDIT.LINKNEWPIECE
|
||||
36814 . 38403) (\TEDIT.UNLINKPIECE 38405 . 39225) (\TEDIT.SPLITPIECE 39227 . 43883) (
|
||||
\TEDIT.INSERTPIECE 43885 . 47157) (\TEDIT.INSERTPIECES 47159 . 50251) (\TEDIT.DELETEPIECES 50253 .
|
||||
54407) (\TEDIT.ALIGNEDPIECE 54409 . 56522)) (56552 68875 (\TEDIT.BTVALIDATE 56562 . 58103) (
|
||||
\TEDIT.BTVALIDATE.PRINT 58105 . 59470) (\TEDIT.CHECK-BTREE 59472 . 61799) (\TEDIT.CHECK-BTREE1 61801
|
||||
. 67432) (\TEDIT.BTFAIL 67434 . 67856) (\TEDIT.MATCHPCS 67858 . 68873)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
BIN
library/tedit/TEDIT-RELEASENOTES.TEDIT
Normal file
BIN
library/tedit/TEDIT-RELEASENOTES.TEDIT
Normal file
Binary file not shown.
172
library/tedit/TEDIT-RENAMES
Normal file
172
library/tedit/TEDIT-RENAMES
Normal file
@@ -0,0 +1,172 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Aug-2024 08:48:45" {WMEDLEY}<library>tedit>TEDIT-RENAMES.;5 7187
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDITSYMBOLMAP)
|
||||
|
||||
:PREVIOUS-DATE "22-Jul-2024 11:31:22" {WMEDLEY}<library>tedit>TEDIT-RENAMES.;4)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-RENAMESCOMS)
|
||||
|
||||
(RPAQQ TEDIT-RENAMESCOMS (
|
||||
(* ;; "TEDITSYMBOLMAP is a list that maps names for current TEDIT items (e.g. \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE).")
|
||||
|
||||
|
||||
(* ;;
|
||||
"FORWARDEDFILES maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)")
|
||||
|
||||
(VARS TEDITSYMBOLMAP)
|
||||
(VARS FORWARDEDFILES)))
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"TEDITSYMBOLMAP is a list that maps names for current TEDIT items (e.g. \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE)."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "FORWARDEDFILES maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)")
|
||||
|
||||
|
||||
(RPAQQ TEDITSYMBOLMAP
|
||||
((MB.NB.ARRANGEBUTTONS MB.NB.PACKITEMS)
|
||||
(MB.NWAYBUTTON.BUTTONEVENTINFN MB.NWAYBUTTON.SELFN)
|
||||
(\TEDIT.BTFAIL BTFAIL)
|
||||
(\TEDIT.BTVALIDATE BTVALIDATE)
|
||||
(\TEDIT.BTVALIDATE.PRINT BTVALIDATE.PRINT)
|
||||
(\TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.LOOKS)
|
||||
(\TEDIT.CHECK-BTREE CHECK-BTREE)
|
||||
(\TEDIT.CHECK-BTREE1 CHECK-BTREE1)
|
||||
(\TEDIT.EQCLOOKS EQCLOOKS)
|
||||
(\TEDIT.EQFMTSPEC EQFMTSPEC)
|
||||
(\TEDIT.REOPENTEXTSTREAM REOPENTEXTSTREAM)
|
||||
(\TEDIT.SAMECLOOKS SAMECLOOKS)
|
||||
(\TEDIT.DO.BLUEPENDINGDELETE TEDIT.DO.BLUEPENDINGDELETE)
|
||||
(\TEDIT.FORMATBOX TEDIT.FORMATBOX)
|
||||
(\TEDIT.FORMATFOLIO TEDIT.FORMATFOLIO)
|
||||
(\TEDIT.FORMATHEADING TEDIT.FORMATHEADING)
|
||||
(\TEDIT.FORMATPAGE TEDIT.FORMATPAGE)
|
||||
(\TEDIT.FORMATTEXTBOX TEDIT.FORMATTEXTBOX)
|
||||
(\TEDIT.GET.CHARLOOKS0 TEDIT.GET.CHARLOOKS0)
|
||||
(\TEDIT.GET.OBJECT TEDIT.GET.OBJECT)
|
||||
(\TEDIT.GET.OBJECT0 TEDIT.GET.OBJECT0)
|
||||
(\TEDIT.GET.PARALOOKS0 TEDIT.GET.PARALOOKS0)
|
||||
(\TEDIT.GET.PCTB0 TEDIT.GET.PCTB0)
|
||||
(\TEDIT.PUT.OBJECT TEDIT.PUT.OBJECT)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEDIT.RESET.EXTEND.PENDING.DELETE)
|
||||
(\TEDIT.SELECTED.PIECES TEDIT.SELECTED.PIECES)
|
||||
(\TEDIT.UPDATE.SCREEN TEDIT.UPDATE.SCREEN)
|
||||
(\TEDIT.ALIGNEDPIECE \ALIGNEDPIECE)
|
||||
(\TEDIT.BACKFORMAT \BACKFORMAT)
|
||||
(\TEDIT.CHTOPC \CHTOPC)
|
||||
(\TEDIT.COPYSEL \COPYSEL)
|
||||
(\TEDIT.CREATE.TEDIT.RESTART.MENU \CREATE.TEDIT.RESTART.MENU)
|
||||
(\TEDIT.DELETEPIECES \DELETEPIECES)
|
||||
(\TEDIT.DELETETREE \DELETETREE)
|
||||
(\TEDIT.DISPLAYLINE \DISPLAYLINE)
|
||||
(\TEDIT.DISPLAYLINE.TABS \DISPLAYLINE.TABS)
|
||||
(\TEDIT.FILLPANE \FILLPANE)
|
||||
(\TEDIT.FIRSTPIECE \FIRSTPIECE)
|
||||
(\TEDIT.FIXSEL \FIXSEL)
|
||||
(\TEDIT.FORMATBLOCK \FORMATBLOCK)
|
||||
(\TEDIT.FORMATLINE \FORMATLINE)
|
||||
(\TEDIT.FORMATLINE.EMPTY \FORMATLINE.EMPTY)
|
||||
(\TEDIT.FORMATLINE.JUSTIFY \FORMATLINE.JUSTIFY)
|
||||
(\TEDIT.FORMATLINE.LASTLEGAL \FORMATLINE.LASTLEGAL)
|
||||
(\TEDIT.FORMATLINE.PURGE.SPACES \FORMATLINE.PURGE.SPACES)
|
||||
(\TEDIT.FORMATLINE.SCALETABS \FORMATLINE.SCALETABS)
|
||||
(\TEDIT.FORMATLINE.SETUP \FORMATLINE.SETUP)
|
||||
(\TEDIT.FORMATLINE.TABS \FORMATLINE.TABS)
|
||||
(\TEDIT.FORMATLINE.UPDATELOOKS \FORMATLINE.UPDATELOOKS)
|
||||
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS \HARDCOPY.FORMATLINE.HEADINGS)
|
||||
(\TEDIT.INSERT TEDIT.\INSERT)
|
||||
(\TEDIT.INSERTCH \INSERTCH)
|
||||
(\TEDIT.INSERTCH.EXTEND \INSERTCH.EXTEND)
|
||||
(\TEDIT.INSERTCH.HISTORY \INSERTCH.HISTORY)
|
||||
(\TEDIT.INSERTCH.INSERTION \INSERTCH.INSERTION)
|
||||
(\TEDIT.INSERTEOL \INSERTEOL)
|
||||
(\TEDIT.INSERTPIECE \INSERTPIECE)
|
||||
(\TEDIT.INSERTPIECES \INSERTPIECES)
|
||||
(\TEDIT.INSERTTREE \INSERTTREE)
|
||||
(\TEDIT.LASTPIECE \LASTPIECE)
|
||||
(\TEDIT.LINKNEWPIECE \LINKNEWPIECE)
|
||||
(\TEDIT.MAKE.VACANT.BTREESLOT \MAKE.VACANT.BTREESLOT)
|
||||
(\TEDIT.MAKEPCTB \MAKEPCTB)
|
||||
(\TEDIT.MATCHPCS \MATCHPCS)
|
||||
(\TEDIT.NAMEDTAB.INIT \NAMEDTAB.INIT)
|
||||
(\TEDIT.PCTOCH \PCTOCH)
|
||||
(\TEDIT.PRIMARYPANE \TEDIT.PRIMARYW)
|
||||
(\TEDIT.SELPIECES \SELPIECES)
|
||||
(\TEDIT.SELPIECES.CHARTRANSFORM \SELPIECES.CHARTRANSFORM)
|
||||
(\TEDIT.SELPIECES.CONCAT \SELPIECES.CONCAT)
|
||||
(\TEDIT.SELPIECES.COPY \SELPIECES.COPY)
|
||||
(\TEDIT.SELPIECES.FROM.STRING \SELPIECES.FROM.STRING)
|
||||
(\TEDIT.SELPIECES.TO.STRING \SELPIECES.TO.STRING)
|
||||
(\TEDIT.SHOWSEL \SHOWSEL)
|
||||
(\TEDIT.SPLITPIECE \SPLITPIECE)
|
||||
(\TEDIT.TEDIT.FORMATLINES \TEDIT.FORMATLINES)
|
||||
(\TEDIT.POSTSCRIPT.HARDCOPY \TEDIT.HARDCOPY)
|
||||
(\TEDIT.TEDIT.HARDCOPY \TEDIT.HARDCOPY)
|
||||
(\TEDIT.TEXTBACKFILEPTR \TEXTBACKFILEPTR)
|
||||
(\TEDIT.TEXTBIN \TEXTBIN)
|
||||
(\TEDIT.TEXTBOUT \TEXTBOUT)
|
||||
(\TEDIT.TEXTCLOSEF \TEXTCLOSEF)
|
||||
(\TEDIT.TEXTDSPCHARWIDTH \TEXTDSPCHARWIDTH)
|
||||
(\TEDIT.TEXTDSPFONT \TEXTDSPFONT)
|
||||
(\TEDIT.TEXTDSPLINEFEED \TEXTDSPLINEFEED)
|
||||
(\TEDIT.TEXTDSPSTRINGWIDTH \TEXTDSPSTRINGWIDTH)
|
||||
(\TEDIT.TEXTDSPXPOSITION \TEXTDSPXPOSITION)
|
||||
(\TEDIT.TEXTDSPYPOSITION \TEXTDSPYPOSITION)
|
||||
(\TEDIT.TEXTEOFP \TEXTEOFP)
|
||||
(\TEDIT.TEXTGETEOFPTR \TEXTGETEOFPTR)
|
||||
(\TEDIT.TEXTGETFILEPTR \TEXTGETFILEPTR)
|
||||
(\TEDIT.TEXTINIT \TEXTINIT)
|
||||
(\TEDIT.TEXTLEFTMARGIN \TEXTLEFTMARGIN)
|
||||
(\TEDIT.TEXTOPENF \TEXTOPENF)
|
||||
(\TEDIT.TEXTPEEKBIN \TEXTPEEKBIN)
|
||||
(\TEDIT.TEXTRIGHTMARGIN \TEXTRIGHTMARGIN)
|
||||
(\TEDIT.TEXTSETEOF \TEXTSETEOF)
|
||||
(\TEDIT.TEXTSETFILEPTR \TEXTSETFILEPTR)
|
||||
(\TEDIT.TEXTBACKCCODEFN \TEXTSTREAM.BACKCCODEFN)
|
||||
(\TEDIT.TEXTSTREAM.BACKCCODEFN \TEXTSTREAM.BACKCCODEFN)
|
||||
(\TEDIT.TEXTFORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM)
|
||||
(\TEDIT.TEXTSTREAM.FORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM)
|
||||
(\TEDIT.TEXTINCCODEFN \TEXTSTREAM.INCCCODEFN)
|
||||
(\TEDIT.TEXTSTREAM.INCCCODEFN \TEXTSTREAM.INCCCODEFN)
|
||||
(\TEDIT.TEXTOUTCHARFN \TEXTSTREAM.OUTCHARFN)
|
||||
(\TEDIT.TEXTSTREAM.OUTCHARFN \TEXTSTREAM.OUTCHARFN)
|
||||
(\TEDIT.TEXTTTYBOUT \TEXTTTYBOUT)
|
||||
(\TEDIT.UNLINKPIECE \UNLINKPIECE)
|
||||
(\TEDIT.UPDATEPCNODES \UPDATEPCNODES)
|
||||
(\TEDIT.XYTOSEL \TEDIT.SELECT.LINE.SCANNER)))
|
||||
|
||||
(RPAQQ FORWARDEDFILES
|
||||
((PCTREE TEDIT-PCTREE)
|
||||
(TEDIT TEDIT)
|
||||
(TEDIT-FILE TEDIT-FILE)
|
||||
(TEDIT-TEXTOFD TEDIT-STREAM)
|
||||
(TEDITABBREV TEDIT-ABBREV)
|
||||
(TEDITCHAT TEDIT-CHAT)
|
||||
(TEDITCOMMAND TEDIT-COMMAND)
|
||||
(TEDITDCL TEDITDCL)
|
||||
(TEDITDEBUG TEDIT-DEBUG)
|
||||
(TEDITFILE TEDIT-FILE TEDIT-OLDFILE)
|
||||
(TEDITFIND TEDIT-FIND)
|
||||
(TEDITFNKEYS TEDIT-FNKEYS)
|
||||
(TEDITHCPY TEDIT-HCPY)
|
||||
(TEDITHISTORY TEDIT-HISTORY)
|
||||
(TEDITLOOKS TEDIT-LOOKS)
|
||||
(TEDITMENU TEDIT-MENU)
|
||||
(TEDITPAGE TEDIT-PAGE)
|
||||
(TEDITSCREEN TEDIT-SCREEN)
|
||||
(TEDITSELECTION TEDIT-SELECTION)
|
||||
(TEDITWINDOW TEDIT-WINDOW)
|
||||
(TFBRAVO TEDIT-TFBRAVO)))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Mar-2024 21:34:32" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;70 15296
|
||||
(FILECREATED "21-Oct-2024 00:27:47" {WMEDLEY}<library>tedit>TEDIT-STRESS.;71 15583
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSPEEK)
|
||||
(VARS TEDIT-STRESSCOMS)
|
||||
:CHANGES-TO (FNS STRESSHC STRESSPUT EQTEXTSTREAM)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 19:46:53" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;54)
|
||||
:PREVIOUS-DATE "19-Mar-2024 21:34:32" {WMEDLEY}<library>tedit>TEDIT-STRESS.;70)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STRESSCOMS)
|
||||
@@ -25,6 +24,7 @@
|
||||
|
||||
(STRESSHC
|
||||
[LAMBDA (FILES NSYSOUTS REPS ERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:33 by rmk")
|
||||
(* ; "Edited 14-Mar-2024 15:15 by rmk")
|
||||
(* ; "Edited 13-Mar-2024 00:23 by rmk")
|
||||
@@ -83,7 +83,7 @@
|
||||
T))
|
||||
(CLOSEF? TSTRM)
|
||||
(CL:WHEN SINGLESTEP
|
||||
(HELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
|
||||
(\TEDIT.THELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
|
||||
(PRINTOUT T " Hardcopied " N " files without failure" T)
|
||||
finally (RETURN (LIST R N])
|
||||
|
||||
@@ -121,7 +121,8 @@
|
||||
T)) finally (RETURN (LIST R N])
|
||||
|
||||
(STRESSPUT
|
||||
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
|
||||
(* ;; "Opens, puts, reopens and tests for equivalence")
|
||||
@@ -142,13 +143,13 @@
|
||||
(TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
|
||||
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
|
||||
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTRM TSP STOP)))
|
||||
(HELP "Get of put not equivalent" F))
|
||||
(\TEDIT.THELP "Get of put not equivalent" F))
|
||||
(CLOSEF TSP))
|
||||
else (SETQ TSTRM (OPENTEXTSTREAM F))
|
||||
(TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
|
||||
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
|
||||
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTRM TSP STOP)))
|
||||
(HELP "Get of put not equivalent" F))
|
||||
(\TEDIT.THELP "Get of put not equivalent" F))
|
||||
(CLOSEF TSP))
|
||||
then (CLOSEF TSTRM)
|
||||
(add N 1)
|
||||
@@ -242,7 +243,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(EQTEXTSTREAM
|
||||
[LAMBDA (TS1 TS2 STOP) (* ; "Edited 11-Mar-2024 16:53 by rmk")
|
||||
[LAMBDA (TS1 TS2 STOP) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 16:53 by rmk")
|
||||
(AND (IEQP (TEDIT.NCHARS TS1)
|
||||
(TEDIT.NCHARS TS2))
|
||||
(OR (for I C1 C2 from 1 to (TEDIT.NCHARS TS1) eachtime (SETQ C1 (TEDIT.NTHCHARCODE TS1 I))
|
||||
@@ -255,8 +257,8 @@
|
||||
(AND (IMAGEOBJP C1)
|
||||
(IMAGEOBJP C2)
|
||||
(EQUALALL C1 C2))) do (CL:WHEN STOP
|
||||
(HELP "Different characters: "
|
||||
(LIST I C1 C2)))
|
||||
(\TEDIT.THELP "Different characters: "
|
||||
(LIST I C1 C2)))
|
||||
(RETURN NIL) finally (RETURN T])
|
||||
|
||||
(SYSOUTRING
|
||||
@@ -293,7 +295,7 @@
|
||||
finally (CL:UNLESS NORECLAIM (RECLAIM])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (795 12697 (STRESSHC 805 . 4271) (STRESSRAND 4273 . 6009) (STRESSPUT 6011 . 7854) (
|
||||
STRESSOPEN 7856 . 9289) (STRESSREAD 9291 . 10826) (STRESSGREP 10828 . 11771) (STRESSPEEK 11773 . 12695
|
||||
)) (12698 15273 (EQTEXTSTREAM 12708 . 13759) (SYSOUTRING 13761 . 14641) (COPYTOCORE 14643 . 15271)))))
|
||||
(FILEMAP (NIL (722 12866 (STRESSHC 732 . 4315) (STRESSRAND 4317 . 6053) (STRESSPUT 6055 . 8023) (
|
||||
STRESSOPEN 8025 . 9458) (STRESSREAD 9460 . 10995) (STRESSGREP 10997 . 11940) (STRESSPEEK 11942 . 12864
|
||||
)) (12867 15560 (EQTEXTSTREAM 12877 . 14046) (SYSOUTRING 14048 . 14928) (COPYTOCORE 14930 . 15558)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
234
library/tedit/TEDIT-STYLES
Normal file
234
library/tedit/TEDIT-STYLES
Normal file
@@ -0,0 +1,234 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Feb-2025 13:31:28" {WMEDLEY}<library>tedit>TEDIT-STYLES.;4 12550
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES)
|
||||
|
||||
:PREVIOUS-DATE "12-Feb-2025 12:18:37" {WMEDLEY}<library>tedit>TEDIT-STYLES.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STYLESCOMS)
|
||||
|
||||
(RPAQQ TEDIT-STYLESCOMS
|
||||
( (* ; "Style-sheet support")
|
||||
(FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES TEDIT.STYLESHEET TEDIT.POP.STYLESHEET
|
||||
TEDIT.PUSH.STYLESHEET TEDIT.ADD.STYLESHEET)
|
||||
|
||||
(* ;; "*TEDIT-PARASTYLE-CACHE* is an ALIST of original char/para looks to styled char/para looks. It is used to cache stylings, and is reset when the main stylesheet changes, and when we change paragraph looks, given paras that have private char styles.")
|
||||
|
||||
|
||||
(* ;; "*TEDIT-CURRENTPARA-CACHE* is NIL if we're not in a para that has private char styles, or is the PARALOOKS (styled!) for that para, if we are. Used to decide when we have to flush *TEDIT-PARASTYLE-CACHE* at paragraph boundaries. Mostly, this'll be NIL and not interesting.")
|
||||
|
||||
|
||||
(* ;; "*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly. This is the push-stack, in effect. Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET")
|
||||
|
||||
(INITVARS (TEDIT.STYLES))
|
||||
|
||||
(* ;; "RMK 2023: Maybe this should be one of the later ones? Only partly implemented")
|
||||
|
||||
(GLOBALVARS TEDIT.STYLES)
|
||||
(INITVARS (*TEDIT-PARASTYLE-CACHE*)
|
||||
(*TEDIT-CURRENTPARA-CACHE*)
|
||||
(*TEDIT-STYLESHEET-SAVE-LIST*))
|
||||
(GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* *TEDIT-STYLESHEET-SAVE-LIST*)))
|
||||
|
||||
|
||||
|
||||
(* ; "Style-sheet support")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.APPLY.STYLES
|
||||
[LAMBDA (LOOKS PC TSTREAM) (* ; "Edited 19-Feb-2025 13:31 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:07 by rmk")
|
||||
(* ; "Edited 12-Nov-2023 16:08 by rmk")
|
||||
(* ; "Edited 18-Mar-2023 21:45 by rmk")
|
||||
(* ; "Edited 25-Sep-2022 13:28 by rmk")
|
||||
(* ; "Edited 11-Sep-2022 14:45 by rmk")
|
||||
(* ;
|
||||
"Edited 4-Jul-93 01:02 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Given a set of looks, return the looks with the proper styles expanded out.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(OR (CDR (ASSOC LOOKS *TEDIT-CURRENTPARA-CACHE*))
|
||||
(CDR (ASSOC LOOKS *TEDIT-PARASTYLE-CACHE*))
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(STYLE (GETCLOOKS LOOKS CLSTYLE))
|
||||
(STYLE-SHEET (OR (FGETTOBJ TEXTOBJ TXTSTYLESHEET)
|
||||
TEDIT.STYLES))
|
||||
NOSTYLE CHARSTYLES CHARSTYLE IN-PARA)
|
||||
(SETQ STYLE (COND
|
||||
((NULL STYLE) (* ;
|
||||
"STYLE of NIL means don't bother. Just use the looks we got.")
|
||||
(SETQ NOSTYLE T)
|
||||
LOOKS)
|
||||
((AND (SETQ CHARSTYLES (AND (GETTSTR TSTREAM CURRENTPARALOOKS)
|
||||
(GETPLOOKS (GETTSTR TSTREAM CURRENTPARALOOKS
|
||||
)
|
||||
FMTCHARSTYLES)))
|
||||
(SETQ CHARSTYLE (FASSOC STYLE CHARSTYLES)))
|
||||
(* ;
|
||||
"If the paragraph we're in has character styles, and this is one of them, use it.")
|
||||
(SETQ IN-PARA T)
|
||||
CHARSTYLE)
|
||||
((CDR (SASSOC STYLE STYLE-SHEET)))
|
||||
((AND (LITATOM STYLE)
|
||||
(DEFINEDP STYLE)) (* ;
|
||||
"Call the guy's function to find the new looks")
|
||||
(APPLY* STYLE LOOKS PC TEXTOBJ))
|
||||
(T (* ;
|
||||
"If all else fails, return the original set of looks")
|
||||
(SETQ NOSTYLE T)
|
||||
LOOKS)))
|
||||
(SETQ STYLE (COND
|
||||
((LISTP STYLE)
|
||||
(\TEDIT.PARSE.CHARLOOKS.LIST (APPEND STYLE '(STYLE NIL))
|
||||
LOOKS TEXTOBJ))
|
||||
(T STYLE)))
|
||||
|
||||
(* ;; "Cache the looks->styled-looks mapping, either in the cache for this kind of paragraph (which gets wiped when we hit a new para type), or in the global cache.")
|
||||
|
||||
[OR NOSTYLE (CL:IF IN-PARA
|
||||
(push *TEDIT-CURRENTPARA-CACHE* (CONS LOOKS STYLE))
|
||||
(push *TEDIT-PARASTYLE-CACHE* (CONS LOOKS STYLE)))]
|
||||
STYLE])
|
||||
|
||||
(\TEDIT.APPLY.PARASTYLES
|
||||
[LAMBDA (PARALOOKS PC TEXTOBJ) (* ; "Edited 19-Feb-2025 13:31 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:07 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 14:48 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 11:06 by rmk")
|
||||
(* ; "Edited 4-Mar-2023 22:23 by rmk")
|
||||
(* ; "Edited 25-Sep-2022 13:26 by rmk")
|
||||
(* ;
|
||||
"Edited 3-Jul-93 23:15 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Given a set of looks, return the looks with the proper styles expanded out.")
|
||||
|
||||
(\TEDIT.CHECK (type? PARALOOKS PARALOOKS)) (* ; "Incoming thing has to be a LOOKS.")
|
||||
(OR (CDR (ASSOC PARALOOKS *TEDIT-PARASTYLE-CACHE*))
|
||||
(LET* [NOSTYLE (STYLE-SHEET (OR (fetch (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ)
|
||||
TEDIT.STYLES))
|
||||
(STYLE (COND
|
||||
((NULL (GETPLOOKS PARALOOKS FMTSTYLE))
|
||||
(SETQ NOSTYLE T)
|
||||
PARALOOKS)
|
||||
((CDR (SASSOC (GETPLOOKS PARALOOKS FMTSTYLE)
|
||||
STYLE-SHEET)))
|
||||
((AND (LITATOM (GETPLOOKS PARALOOKS FMTSTYLE))
|
||||
(DEFINEDP (GETPLOOKS PARALOOKS FMTSTYLE)))
|
||||
(* ;
|
||||
"Call the guy's function to find the new looks")
|
||||
(APPLY* (GETPLOOKS PARALOOKS FMTSTYLE)
|
||||
PARALOOKS PC TEXTOBJ))
|
||||
(T (SETQ NOSTYLE T)
|
||||
PARALOOKS]
|
||||
(CL:WHEN (LISTP STYLE)
|
||||
(SETQ STYLE (\TEDIT.PARSE.PARALOOKS.LIST (APPEND STYLE '(STYLE NIL))
|
||||
PARALOOKS TEXTOBJ)))
|
||||
(CL:UNLESS NOSTYLE
|
||||
(push *TEDIT-PARASTYLE-CACHE* (CONS PARALOOKS STYLE)))
|
||||
STYLE])
|
||||
|
||||
(TEDIT.STYLESHEET
|
||||
[LAMBDA (SHEET TEXTSTREAM) (* ;
|
||||
"Edited 3-Jul-93 23:19 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Put a new stylesheet into force. This REPLACES any existing style sheets, and forgets any pushed sheets.")
|
||||
|
||||
(LET [(TEXTOBJ (AND TEXTSTREAM (TEXTOBJ TEXTSTREAM]
|
||||
(COND
|
||||
(TEXTOBJ (SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(replace (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ with SHEET))
|
||||
(T
|
||||
(* ;; "No specific document given; change the global style sheet TEDIT.STYLES")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES SHEET)
|
||||
(SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES])
|
||||
|
||||
(TEDIT.POP.STYLESHEET
|
||||
[LAMBDA NIL (* ;
|
||||
"Edited 3-Jul-93 17:42 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Go back to an earlier stylesheet, by popping the stack of saved sheets. You can't pop back to no sheet -- you'll always bottom out at the original style sheet.")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES (OR (CL:POP *TEDIT-STYLESHEET-SAVE-LIST*)
|
||||
TEDIT.STYLES])
|
||||
|
||||
(TEDIT.PUSH.STYLESHEET
|
||||
[LAMBDA (SHEET) (* ;
|
||||
"Edited 3-Jul-93 17:40 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Add more style definitions to the current style sheet, and remember how to get back to the old one. Think of this as PUSHING onto a stack of stylesheets, with the new sheet being a composition of SHEET and the existing styles. ")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES))
|
||||
(CL:PUSH TEDIT.STYLES *TEDIT-STYLESHEET-SAVE-LIST*])
|
||||
|
||||
(TEDIT.ADD.STYLESHEET
|
||||
[LAMBDA (SHEET) (* ;
|
||||
"Edited 3-Jul-93 17:38 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Add more style definitions to the current style sheet. This ADDS entries, without remembering that there was an earlier sheet. ")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES))
|
||||
(SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"*TEDIT-PARASTYLE-CACHE* is an ALIST of original char/para looks to styled char/para looks. It is used to cache stylings, and is reset when the main stylesheet changes, and when we change paragraph looks, given paras that have private char styles."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"*TEDIT-CURRENTPARA-CACHE* is NIL if we're not in a para that has private char styles, or is the PARALOOKS (styled!) for that para, if we are. Used to decide when we have to flush *TEDIT-PARASTYLE-CACHE* at paragraph boundaries. Mostly, this'll be NIL and not interesting."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly. This is the push-stack, in effect. Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET"
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? TEDIT.STYLES )
|
||||
|
||||
|
||||
|
||||
(* ;; "RMK 2023: Maybe this should be one of the later ones? Only partly implemented")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.STYLES)
|
||||
)
|
||||
|
||||
(RPAQ? *TEDIT-PARASTYLE-CACHE* )
|
||||
|
||||
(RPAQ? *TEDIT-CURRENTPARA-CACHE* )
|
||||
|
||||
(RPAQ? *TEDIT-STYLESHEET-SAVE-LIST* )
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* *TEDIT-STYLESHEET-SAVE-LIST*)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1980 11244 (\TEDIT.APPLY.STYLES 1990 . 5638) (\TEDIT.APPLY.PARASTYLES 5640 . 8118) (
|
||||
TEDIT.STYLESHEET 8120 . 9187) (TEDIT.POP.STYLESHEET 9189 . 9857) (TEDIT.PUSH.STYLESHEET 9859 . 10599)
|
||||
(TEDIT.ADD.STYLESHEET 10601 . 11242)))))
|
||||
STOP
|
||||
BIN
library/tedit/TEDIT-STYLES.LCOM
Normal file
BIN
library/tedit/TEDIT-STYLES.LCOM
Normal file
Binary file not shown.
@@ -1,15 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Mar-2024 18:27:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;153 91304
|
||||
(FILECREATED "19-Feb-2025 12:18:40" {WMEDLEY}<library>tedit>TEDIT-TFBRAVO.;175 94753
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-TFBRAVOCOMS)
|
||||
(FNS \TEDIT.NAMEDTAB.INIT)
|
||||
:CHANGES-TO (RECORDS PARA)
|
||||
(FNS TEDITFROMBRAVO \TFBRAVO.READ.PARALOOKS \TFBRAVO.HANDLE.HEADING
|
||||
\TFBRAVO.PARSE.PROFILE.PARA \TFBRAVO.SPLIT.PARA \TFBRAVO.RUN.TABSPEC
|
||||
\TFBRAVO.ADD.NAMEDTAB)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 12:41:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;152)
|
||||
:PREVIOUS-DATE " 8-Feb-2025 23:19:34" {WMEDLEY}<library>tedit>TEDIT-TFBRAVO.;174)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
|
||||
@@ -75,10 +75,10 @@
|
||||
(RECORD BRAVOFONT (BFFONTNUM BRFAMILY BRSIZE BRWEIGHT BRSLOPE))
|
||||
|
||||
(RECORD PARA (PARAFMTSPEC RUNS FORMATPTRS)
|
||||
(ACCESSFNS (PARATABDEFS (fetch (FMTSPEC FMTUSERINFO) of (fetch (PARA PARAFMTSPEC)
|
||||
of DATUM))
|
||||
(replace (FMTSPEC FMTUSERINFO) of (fetch (PARA PARAFMTSPEC)
|
||||
of DATUM) with NEWVALUE))))
|
||||
(ACCESSFNS (PARATABDEFS (GETPLOOKS (fetch (PARA PARAFMTSPEC) of DATUM)
|
||||
FMTUSERINFO)
|
||||
(FSETPLOOKS (fetch (PARA PARAFMTSPEC) of DATUM)
|
||||
FMTUSERINFO NEWVALUE))))
|
||||
|
||||
(RECORD RUN (RUNLENGTH RUNLOOKS RUNSTART RUNLAST)
|
||||
(ACCESSFNS (RUNTABS (fetch (CHARLOOKS CLUSERINFO) of (fetch (RUN RUNLOOKS) of DATUM))
|
||||
@@ -124,7 +124,7 @@
|
||||
(WIDTH (IPLUS (CONSTANT (FIX (FTIMES 8.5 72)))
|
||||
NUM))
|
||||
(NIL NUM)
|
||||
(HELP "UNKNOWN DIMENSION" DIMENSION))))
|
||||
(\TEDIT.THELP "UNKNOWN DIMENSION" DIMENSION))))
|
||||
NUM)))
|
||||
)
|
||||
|
||||
@@ -173,7 +173,10 @@
|
||||
(RETURN T])
|
||||
|
||||
(TEDITFROMBRAVO
|
||||
[LAMBDA (BFILE TEXTSTREAM PROPS USER.CM) (* ; "Edited 17-Jan-2024 12:11 by rmk")
|
||||
[LAMBDA (BFILE TEXTSTREAM PROPS USER.CM) (* ; "Edited 19-Feb-2025 12:13 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:03 by rmk")
|
||||
(* ; "Edited 2-Jan-2025 22:22 by rmk")
|
||||
(* ; "Edited 17-Jan-2024 12:11 by rmk")
|
||||
(* ; "Edited 26-Nov-2023 00:29 by rmk")
|
||||
(* ; "Edited 14-Nov-2023 17:09 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 08:53 by rmk")
|
||||
@@ -188,9 +191,9 @@
|
||||
(CL:UNLESS TEXTSTREAM
|
||||
(SETQ TEXTSTREAM (OPENTEXTSTREAM NIL))) (* ;
|
||||
" Produce the USER.CM's alist of default values")
|
||||
(bind PARA NEXTFMTSPEC USER.CM.CHARLOOKS USER.CM.FMTSPEC USER.CM.ALIST START (BSTREAM _ BFILE
|
||||
)
|
||||
(TEXTOBJ _ (TEXTOBJ TEXTSTREAM)) declare (SPECVARS USER.CM.FMTSPEC USER.CM.CHARLOOKS
|
||||
(bind PARA NEXTPARALOOKS USER.CM.CHARLOOKS USER.CM.PARALOOKS USER.CM.ALIST START
|
||||
(BSTREAM _ BFILE)
|
||||
(TEXTOBJ _ (TEXTOBJ TEXTSTREAM)) declare (SPECVARS USER.CM.PARALOOKS USER.CM.CHARLOOKS
|
||||
USER.CM.ALIST)
|
||||
first (CL:UNLESS (SETQ USER.CM (\TFBRAVO.GET.USER.CM BFILE USER.CM TEXTOBJ))
|
||||
(* ; "Go for plain text")
|
||||
@@ -204,28 +207,32 @@
|
||||
(PUTTEXTPROP TEXTOBJ 'OUTPUT-FORMAT :DEFAULT)
|
||||
[RESETSAVE (STREAMPROP BSTREAM 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
`(PROGN (STREAMPROP ,BSTREAM 'ENDOFSTREAMOP OLDVALUE]
|
||||
(SETQ NEXTFMTSPEC USER.CM.FMTSPEC) eachtime (SETQ START (GETFILEPTR BSTREAM))
|
||||
(SETQ NEXTPARALOOKS USER.CM.PARALOOKS) eachtime (SETQ START (GETFILEPTR BSTREAM))
|
||||
(* ;
|
||||
"Profiles and headings have to back up")
|
||||
(SETQ PARA (\TFBRAVO.PARSE.PARA NEXTFMTSPEC
|
||||
BSTREAM TEXTOBJ))
|
||||
(SETQ PARA (\TFBRAVO.PARSE.PARA
|
||||
NEXTPARALOOKS BSTREAM
|
||||
TEXTOBJ))
|
||||
|
||||
(* ;; "No runs signals the very end")
|
||||
while (fetch (PARA RUNS) of PARA) do (SETQ NEXTFMTSPEC (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
(* ;; "No runs signals the very end")
|
||||
while (fetch (PARA RUNS) of PARA) do (SETQ NEXTPARALOOKS (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
|
||||
(* ;; "Valid profile paragraphs have a special interpretation, invalid ones must be mismarked ordinary text")
|
||||
|
||||
(CL:UNLESS (AND (EQ 'PROFILE (fetch (FMTSPEC FMTPARATYPE)
|
||||
of NEXTFMTSPEC))
|
||||
(CL:UNLESS (AND (EQ 'PROFILE (GETPLOOKS NEXTPARALOOKS
|
||||
FMTPARATYPE))
|
||||
(\TFBRAVO.PARSE.PROFILE.PARA BSTREAM PARA
|
||||
TEXTOBJ START))
|
||||
(\TFBRAVO.INSERT.PARA PARA BSTREAM TEXTOBJ))
|
||||
finally (\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
|
||||
(\TEDIT.UNIQUIFY.ALL TEXTOBJ) (* ; "Lists are complete and unique")
|
||||
finally (\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
|
||||
|
||||
(* ;; "Named tab information is collected in the userinfo fields, but then ignored.")
|
||||
|
||||
(for PARALOOKS in (GETTOBJ TEXTOBJ TXTPARALOOKSLIST)
|
||||
do (replace (FMTSPEC FMTUSERINFO) of PARALOOKS with NIL))
|
||||
do (SETPLOOKS PARALOOKS FMTUSERINFO NIL))
|
||||
(for CHARLOOKS in (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST)
|
||||
do (replace (CHARLOOKS CLUSERINFO) of CHARLOOKS with NIL))
|
||||
do (SETCLOOKS CHARLOOKS CLUSERINFO NIL))
|
||||
(\TEDIT.UNIQUIFY.ALL TEXTOBJ) (* ; "Lists are complete and unique")
|
||||
(\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ)
|
||||
(TEDIT.SETSEL TEXTOBJ 1 0 'LEFT)
|
||||
(RETURN TEXTSTREAM)))])
|
||||
@@ -285,25 +292,27 @@
|
||||
(RETURN USER.CM])
|
||||
|
||||
(\TFBRAVO.USER.CM.LOOKS
|
||||
[LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 18-Aug-2023 18:47 by rmk")
|
||||
[LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 8-Feb-2025 22:13 by rmk")
|
||||
(* ; "Edited 2-Jan-2025 11:06 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 18:47 by rmk")
|
||||
(* ; "Edited 16-Aug-2023 21:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2023 17:15 by rmk")
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC USER.CM.ALIST))
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM))
|
||||
(SETQ USER.CM.CHARLOOKS (create CHARLOOKS
|
||||
CLNAME _ (\TFBRAVO.GETFONT 0 BRFAMILY)
|
||||
CLSIZE _ (\TFBRAVO.GETFONT 0 BRSIZE)
|
||||
CLOFFSET _ 0))
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS)
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS (\TFBRAVO.GETFONT 0 BRFAMILY)
|
||||
(\TFBRAVO.GETFONT 0 BRSIZE))
|
||||
(\TFBRAVO.INIT.PAGEFORMAT TEXTOBJ)
|
||||
(SETQ USER.CM.FMTSPEC (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.PARALOOKS (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS USER.CM.CHARLOOKS TEXTOBJ))
|
||||
(SETQ USER.CM.FMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.FMTSPEC TEXTOBJ))
|
||||
(SETQ USER.CM.PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.PARALOOKS TEXTOBJ))
|
||||
(SETTOBJ TEXTOBJ DEFAULTCHARLOOKS USER.CM.CHARLOOKS)
|
||||
(SETTOBJ TEXTOBJ FMTSPEC USER.CM.FMTSPEC])
|
||||
(SETTOBJ TEXTOBJ DEFAULTPARALOOKS USER.CM.PARALOOKS])
|
||||
|
||||
(\TFBRAVO.READ.USER.CM
|
||||
[LAMBDA (USER.CM) (* ; "Edited 18-Aug-2023 22:26 by rmk")
|
||||
[LAMBDA (USER.CM) (* ; "Edited 27-Aug-2024 18:12 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 22:26 by rmk")
|
||||
(* ; "Edited 10-Aug-2023 13:02 by rmk")
|
||||
(* ; "Edited 7-Aug-2023 12:52 by rmk")
|
||||
(* ; "Edited 1-Aug-2023 22:11 by rmk")
|
||||
@@ -330,7 +339,9 @@
|
||||
|
||||
LLP (CL:UNLESS (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL)))
|
||||
USER.CM USER.CM.RDTBL)))
|
||||
(RETURN ALIST)) (* ;
|
||||
(CL:UNLESS (ASSOC 'DefaultTab ALIST)
|
||||
(push ALIST (CONS 'DefaulTab DEFAULTTAB)))
|
||||
(RETURN ALIST)) (* ;
|
||||
"If the '[BRAVO]' section is the last one")
|
||||
(COND
|
||||
((NULL LINE) (* ; "ignore blank lines")
|
||||
@@ -378,19 +389,22 @@
|
||||
(GO LLP)))])
|
||||
|
||||
(\TFBRAVO.INIT.PARALOOKS
|
||||
[LAMBDA (ALIST) (* ; "Edited 13-Aug-2023 11:27 by rmk")
|
||||
[LAMBDA (ALIST) (* ; "Edited 8-Feb-2025 22:09 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 22:17 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:36 by rmk")
|
||||
(* ; "Edited 13-Aug-2023 11:27 by rmk")
|
||||
(* ; "Edited 8-Aug-2023 23:51 by rmk")
|
||||
(* ; "Edited 7-Aug-2023 14:59 by rmk")
|
||||
(* ; "Edited 31-May-91 15:26 by jds")
|
||||
|
||||
(* ;; "creates the default paragraph looks from the USER.CM. The numeric values are Bravo defaults as specfied in the Bravo documentation. This assumes that all mica values in the USER.CM have already been converted to points. ")
|
||||
|
||||
(LET ((INITFMTSPEC (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC)))
|
||||
(LET ((INITPARALOOKS (create PARALOOKS using TEDIT.DEFAULT.FMTSPEC)))
|
||||
|
||||
(* ;; "Bravo User Manual says that default tab is 36, the Bravo file format document says 60. I'm going with 36.")
|
||||
|
||||
(with FMTSPEC INITFMTSPEC (SETQ LEFTMAR (OR (CADR (ASSOC 'LeftMargin ALIST))
|
||||
85))
|
||||
(with PARALOOKS INITPARALOOKS (SETQ LEFTMAR (OR (CADR (ASSOC 'LeftMargin ALIST))
|
||||
85))
|
||||
(SETQ 1STLEFTMAR (OR (CADR (ASSOC 'FirstLineLeftMargin ALIST))
|
||||
LEFTMAR))
|
||||
(SETQ RIGHTMAR (OR (CADR (ASSOC 'RightMargin ALIST))
|
||||
@@ -400,11 +414,11 @@
|
||||
(SETQ LEADBEFORE (OR (CADR (ASSOC 'ParagraphLeading ALIST))
|
||||
0))
|
||||
(SETQ LEADAFTER 0)
|
||||
(SETQ TABSPEC (LIST (OR (CADR (ASSOC 'DefaultTab ALIST))
|
||||
36)))
|
||||
(SETQ FMTDEFAULTTAB (OR (CADR (ASSOC 'DefaultTab ALIST))
|
||||
DEFAULTTAB))
|
||||
(SETQ FMTSPECIALX 0)
|
||||
(SETQ FMTSPECIALY 0))
|
||||
INITFMTSPEC])
|
||||
INITPARALOOKS])
|
||||
|
||||
(\TFBRAVO.INIT.PAGEFORMAT
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 22-Sep-2023 20:03 by rmk")
|
||||
@@ -491,24 +505,26 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.PARSE.PARA
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "Edited 14-Nov-2023 13:03 by rmk")
|
||||
[LAMBDA (OLDPARALOOKS BSTREAM TEXTOBJ) (* ; "Edited 8-Feb-2025 23:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 14-Nov-2023 13:03 by rmk")
|
||||
(* ; "Edited 7-Nov-2023 21:53 by rmk")
|
||||
(* ; "Edited 21-Aug-2023 23:41 by rmk")
|
||||
(* ; "Edited 20-Aug-2023 22:48 by rmk")
|
||||
(* ; "Edited 16-Aug-2023 21:28 by rmk")
|
||||
(* ; "Edited 13-Jun-2021 09:46 by rmk:")
|
||||
|
||||
(* ;; "OLDFMTSPEC are the paragraph looks of the previous paragraph, and RUNi are the character runs in the form returned by \TFBRAVO.READ.CHARLOOKS, except that here we fill in the character count for the last run. Leaves the input file pointer at the end of the trailer, after the CR.")
|
||||
(* ;; "OLDPARALOOKS are the paragraph looks of the previous paragraph, and RUNi are the character runs in the form returned by \TFBRAVO.READ.CHARLOOKS, except that here we fill in the character count for the last run. Leaves the input file pointer at the end of the trailer, after the CR.")
|
||||
|
||||
(* ;; "^Z marks the end of a Bravo-looks paragraph which may have internal CR's that mark the end of Tedit paragraphs. The Bravo runs with different charlooks want to end up in different pieces all within the same paragraph.")
|
||||
|
||||
(* ;;
|
||||
"The carriage return that ends the trailer is its own final run, the trailer itself is skipped.")
|
||||
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC))
|
||||
(LET (BYTE PLEN ^ZPTR ENDCHAR FMTSPEC RUNS FORMATPTRS PARAGRAPH TABPTRS (PSTART (GETFILEPTR
|
||||
BSTREAM))
|
||||
(FMTSPEC USER.CM.FMTSPEC))
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.PARALOOKS))
|
||||
(LET (BYTE PLEN ^ZPTR ENDCHAR PARALOOKS RUNS FORMATPTRS PARAGRAPH TABPTRS (PSTART (GETFILEPTR
|
||||
BSTREAM))
|
||||
(PARALOOKS USER.CM.PARALOOKS))
|
||||
|
||||
(* ;; "BYTE=NIL at EOF, no terminating ^Z")
|
||||
|
||||
@@ -537,17 +553,23 @@
|
||||
(NIL T)
|
||||
NIL))
|
||||
(SELCHARQ BYTE
|
||||
(^Z (SETQ FMTSPEC (\TFBRAVO.READ.PARALOOKS OLDFMTSPEC BSTREAM TEXTOBJ))
|
||||
(^Z (SETQ PARALOOKS (\TFBRAVO.READ.PARALOOKS OLDPARALOOKS BSTREAM TEXTOBJ))
|
||||
(SETQ RUNS (\TFBRAVO.CREATE.RUNS BSTREAM PSTART PLEN)))
|
||||
(NIL)
|
||||
(SHOULDNT "Bravo paragraph not ending in ^Z, CR, EOF"))
|
||||
(\TEDIT.THELP "Bravo paragraph not ending in ^Z, CR, EOF"))
|
||||
(create PARA
|
||||
PARAFMTSPEC _ FMTSPEC
|
||||
PARAFMTSPEC _ PARALOOKS
|
||||
RUNS _ RUNS
|
||||
FORMATPTRS _ FORMATPTRS])
|
||||
|
||||
(\TFBRAVO.READ.PARALOOKS
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM) (* ; "Edited 9-Sep-2023 21:40 by rmk")
|
||||
[LAMBDA (OLDPARALOOKS BSTREAM) (* ; "Edited 19-Feb-2025 12:14 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:04 by rmk")
|
||||
(* ; "Edited 19-Dec-2024 23:42 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:27 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 21:59 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:39 by rmk")
|
||||
(* ; "Edited 9-Sep-2023 21:40 by rmk")
|
||||
(* ; "Edited 21-Aug-2023 21:43 by rmk")
|
||||
(* ; "Edited 20-Aug-2023 15:48 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 23:08 by rmk")
|
||||
@@ -555,60 +577,62 @@
|
||||
(* ; "Edited 13-Aug-2023 19:58 by rmk")
|
||||
(* ; "Edited 3-Aug-2023 00:20 by rmk")
|
||||
(* ; "Edited 31-May-91 15:26 by jds")
|
||||
(DECLARE (USEDFREE USER.CM.FMTSPEC))
|
||||
(DECLARE (USEDFREE USER.CM.PARALOOKS))
|
||||
|
||||
(* ;;
|
||||
"Decodes bravo paragraph looks into a TEDIT FMTSPEC. OLDFMTSPEC is used just for its tabs.")
|
||||
"Decodes bravo paragraph looks into a TEDIT PARALOOKS. OLDPARALOOKS is used just for its tabs.")
|
||||
|
||||
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME TABDEFAULT NAMEDTABS (NEWFMTSPEC _
|
||||
(create FMTSPEC
|
||||
using USER.CM.FMTSPEC))
|
||||
first (CL:UNLESS (EQ 'PROFILE (fetch (FMTSPEC FMTPARATYPE) of OLDFMTSPEC))
|
||||
(PARALOOKS! OLDPARALOOKS)
|
||||
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPLOOKS USER.CM.PARALOOKS
|
||||
FMTDEFAULTTAB))
|
||||
(NEWPARALOOKS _ (create PARALOOKS using USER.CM.PARALOOKS))
|
||||
first (CL:UNLESS (EQ 'PROFILE (FGETPLOOKS OLDPARALOOKS FMTPARATYPE))
|
||||
|
||||
(* ;; "It appears that heading-tabs don't carry over to other paragraphs. Although maybe the default interval-tab does?")
|
||||
|
||||
(SETQ TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of OLDFMTSPEC)))
|
||||
(SETQ TABDEFAULT (OR (FGETPLOOKS OLDPARALOOKS FMTDEFAULTTAB)
|
||||
(FGETPLOOKS USER.CM.PARALOOKS FMTDEFAULTTAB)))
|
||||
|
||||
(* ;; "We don't put the NAMEDTABS in the TABSPEC since we don't know which ones will be activated by any particular run. ")
|
||||
|
||||
(SETQ NAMEDTABS (COPY (fetch (FMTSPEC FMTUSERINFO) of OLDFMTSPEC))))
|
||||
(SETQ NAMEDTABS (COPY (FGETPLOOKS OLDPARALOOKS FMTUSERINFO))))
|
||||
do (SELCHARQ (SETQ COMMAND (BIN BSTREAM))
|
||||
(l (SETQ LMFLAG T)
|
||||
(replace (FMTSPEC LEFTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(FSETPLOOKS NEWPARALOOKS LEFTMAR (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(d (SETQ 1LMFLAG T)
|
||||
(replace (FMTSPEC 1STLEFTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(z (replace (FMTSPEC RIGHTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(x (replace (FMTSPEC LINELEAD) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(e (replace (FMTSPEC LEADAFTER) of NEWFMTSPEC with 0)
|
||||
(replace (FMTSPEC LEADBEFORE) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(FSETPLOOKS NEWPARALOOKS 1STLEFTMAR (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(z (FSETPLOOKS NEWPARALOOKS RIGHTMAR (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(x (FSETPLOOKS NEWPARALOOKS LINELEAD (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(e (FSETPLOOKS NEWPARALOOKS LEADAFTER 0)
|
||||
(FSETPLOOKS NEWPARALOOKS LEADBEFORE (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(y (* ; "vertical tabs are supported")
|
||||
(replace (FMTSPEC FMTSPECIALX) of NEWFMTSPEC with 0)
|
||||
(replace (FMTSPEC FMTSPECIALY) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(k (replace (FMTSPEC FMTHEADINGKEEP) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(FSETPLOOKS NEWPARALOOKS FMTSPECIALX 0)
|
||||
(FSETPLOOKS NEWPARALOOKS FMTSPECIALY (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(k (FSETPLOOKS NEWPARALOOKS FMTHEADINGKEEP (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(w 'HardcopyMode)
|
||||
(j (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'JUSTIFIED))
|
||||
(c (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'CENTERED))
|
||||
(j (FSETPLOOKS NEWPARALOOKS QUAD 'JUSTIFIED))
|
||||
(c (FSETPLOOKS NEWPARALOOKS QUAD 'CENTERED))
|
||||
(q
|
||||
(* ;; "Profiles are marked here but then interpreted at the top")
|
||||
|
||||
(replace (FMTSPEC FMTPARATYPE) of NEWFMTSPEC with 'PROFILE))
|
||||
(FSETPLOOKS NEWPARALOOKS FMTPARATYPE 'PROFILE))
|
||||
(%( (* ; "Collect the named tabs")
|
||||
(SETQ TABX (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Name or X position")
|
||||
|
||||
(* ;; "Tabs apparently round down/truncate, not up.")
|
||||
|
||||
(SELCHARQ (SETQ COMMAND (BIN BSTREAM))
|
||||
(%) (SETQ TABDEFAULT (FIXR (FQUOTIENT TABX MICASPERPT))))
|
||||
(%) (SETQ TABDEFAULT (HCUNSCALE MICASPERPT TABX)))
|
||||
(%, (CL:WHEN (IGREATERP TABX 14)
|
||||
(HELP TABX " is not a legal tab-name"))
|
||||
(\TEDIT.THELP TABX " is not a legal tab-name"))
|
||||
(SETQ TABNAME (ADD1 TABX)) (* ; "Adding 1 to align with t1, t2...")
|
||||
(SETQ TABX (\TFBRAVO.READNUM? BSTREAM T))
|
||||
(CL:UNLESS (EQ (CHARCODE %))
|
||||
(BIN BSTREAM))
|
||||
(HELP "MISSING CLOSING ) IN TABSPEC"))
|
||||
(\TEDIT.THELP "MISSING CLOSING ) IN TABSPEC"))
|
||||
|
||||
(* ;; "Here we collect the tabs declared in this paragraph or inherited from before. 65535 means delete that the named tab (possibly inherited), otherwise the name is given a new TABX for all runs of this paragraph and beyond.")
|
||||
|
||||
@@ -618,23 +642,22 @@
|
||||
else (RPLACD [OR (ASSOC TABNAME NAMEDTABS)
|
||||
(CAR (push NAMEDTABS (CONS TABNAME]
|
||||
(create TAB
|
||||
TABX _ (FIXR (FQUOTIENT TABX MICASPERPT))
|
||||
TABX _ (HCUNSCALE MICASPERPT TABX)
|
||||
TABKIND _ 'LEFT])
|
||||
(HELP "ILLFORMED BRAVO TAB SPEC")))
|
||||
(\TEDIT.THELP "ILLFORMED BRAVO TAB SPEC")))
|
||||
(SPACE)
|
||||
((CR \)
|
||||
(CL:WHEN (AND LMFLAG (NOT 1LMFLAG)) (* ;
|
||||
"If there was a Left margin but no firstline left then default it")
|
||||
(replace (FMTSPEC 1STLEFTMAR) of NEWFMTSPEC with (fetch (FMTSPEC LEFTMAR)
|
||||
of NEWFMTSPEC)))
|
||||
(replace TABSPEC of NEWFMTSPEC with (CONS TABDEFAULT))
|
||||
(replace (FMTSPEC FMTUSERINFO) of NEWFMTSPEC with (DREVERSE NAMEDTABS))
|
||||
(FSETPLOOKS NEWPARALOOKS 1STLEFTMAR (FGETPLOOKS NEWPARALOOKS LEFTMAR)))
|
||||
(FSETPLOOKS NEWPARALOOKS FMTDEFAULTTAB TABDEFAULT)
|
||||
(FSETPLOOKS NEWPARALOOKS FMTUSERINFO (DREVERSE NAMEDTABS))
|
||||
(CL:WHEN (EQ COMMAND (CHARCODE CR)) (* ;
|
||||
"Read the \ separator, but leave the terminating CR")
|
||||
(\BACKFILEPTR BSTREAM))
|
||||
(RETURN NEWFMTSPEC))
|
||||
(HELP (CHARACTER COMMAND)
|
||||
'" is not a legal Bravo paragraph-format character"])
|
||||
(RETURN NEWPARALOOKS))
|
||||
(\TEDIT.THELP (CHARACTER COMMAND)
|
||||
'" is not a legal Bravo paragraph-format character"])
|
||||
|
||||
(\TFBRAVO.CREATE.RUNS
|
||||
[LAMBDA (BSTREAM PSTART PLEN) (* ; "Edited 14-Nov-2023 13:01 by rmk")
|
||||
@@ -654,7 +677,9 @@
|
||||
(SETQ OLDCHARLOOKS (fetch (RUN RUNLOOKS) of RUN])
|
||||
|
||||
(\TFBRAVO.READ.CHARLOOKS
|
||||
[LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 9-Sep-2023 21:39 by rmk")
|
||||
[LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 2-Jan-2025 23:44 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:27 by rmk")
|
||||
(* ; "Edited 9-Sep-2023 21:39 by rmk")
|
||||
(* ; "Edited 20-Aug-2023 16:15 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 20:11 by rmk")
|
||||
(* ; "Edited 31-May-91 15:25 by jds")
|
||||
@@ -663,36 +688,39 @@
|
||||
|
||||
(* ;; "The charlooks trailer (from \ to CR) consists of a sequence of run-looks. Each run-look is a sequence of commands followed by the length of the run. If the first run has no commands (i.e. the \ is followed immediately by a length-number), than the first run gets the USER.CM default looks.")
|
||||
|
||||
(bind COMMAND LEN LAST VALUE TABNAMES (NEWCHARLOOKS _ (create CHARLOOKS using OLDCHARLOOKS))
|
||||
until (SETQ LEN (\TFBRAVO.READNUM? BSTREAM))
|
||||
(bind COMMAND LEN LAST VALUE TABNAMES FAMILY SIZE BOLD ITALIC (NEWCHARLOOKS _
|
||||
(create CHARLOOKS
|
||||
using OLDCHARLOOKS))
|
||||
first [SETQ FAMILY (SETQ SIZE (SETQ BOLD (SETQ ITALIC 'OFF] until (SETQ LEN (\TFBRAVO.READNUM?
|
||||
BSTREAM))
|
||||
do
|
||||
(* ;; "Some command letters are followed by numeric arguments (f1 vs b). Any spaces around command letters are skipped. BIN is used here for one-byte arguments, but perhaps a version that skips initial spaces would be safter?")
|
||||
(* ;; "Some command letters are followed by numeric arguments (f1 vs b). Any spaces around command letters are skipped. BIN is used here for one-byte arguments, but perhaps a version that skips initial spaces would be safer?")
|
||||
|
||||
(SELCHARQ (SETQ COMMAND (BIN BSTREAM))
|
||||
(s (replace (CHARLOOKS CLSTRIKE) of NEWCHARLOOKS with T))
|
||||
(S (replace (CHARLOOKS CLSTRIKE) of NEWCHARLOOKS with NIL))
|
||||
(u (replace (CHARLOOKS CLULINE) of NEWCHARLOOKS with T))
|
||||
(U (replace (CHARLOOKS CLULINE) of NEWCHARLOOKS with NIL))
|
||||
(b (replace (CHARLOOKS CLBOLD) of NEWCHARLOOKS with T))
|
||||
(B (replace (CHARLOOKS CLBOLD) of NEWCHARLOOKS with NIL))
|
||||
(i (replace (CHARLOOKS CLITAL) of NEWCHARLOOKS with T))
|
||||
(I (replace (CHARLOOKS CLITAL) of NEWCHARLOOKS with NIL))
|
||||
(s (FSETCLOOKS NEWCHARLOOKS CLSTRIKE T))
|
||||
(S (FSETCLOOKS NEWCHARLOOKS CLSTRIKE NIL))
|
||||
(u (FSETCLOOKS NEWCHARLOOKS CLULINE T))
|
||||
(U (FSETCLOOKS NEWCHARLOOKS CLULINE NIL))
|
||||
(b (SETQ BOLD T))
|
||||
(B (SETQ BOLD NIL))
|
||||
(i (SETQ ITALIC T))
|
||||
(I (SETQ ITALIC NIL))
|
||||
(g "Graphic T --unsupported")
|
||||
(G "Graphic NIL")
|
||||
(v (replace (CHARLOOKS CLINVISIBLE) of NEWCHARLOOKS with NIL))
|
||||
(V (AND NIL (replace (CHARLOOKS CLINVISIBLE) of NEWCHARLOOKS with T)))
|
||||
(v (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE NIL))
|
||||
(V (AND NIL (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE T)))
|
||||
(t
|
||||
(* ;; "Collect the named tabs for writerun")
|
||||
|
||||
(PUSH TABNAMES (CHARACTER (BIN BSTREAM))))
|
||||
(f (* ; "Save the fontface until the end")
|
||||
(SETQ VALUE (CHARACTER (BIN BSTREAM)))
|
||||
(replace (CHARLOOKS CLSIZE) of NEWCHARLOOKS with (\TFBRAVO.GETFONT VALUE BRSIZE))
|
||||
(replace (CHARLOOKS CLNAME) of NEWCHARLOOKS with (\TFBRAVO.GETFONT VALUE BRFAMILY)))
|
||||
(SETQ SIZE (\TFBRAVO.GETFONT VALUE BRSIZE))
|
||||
(SETQ FAMILY (\TFBRAVO.GETFONT VALUE BRFAMILY)))
|
||||
(o (SETQ VALUE (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Superscript")
|
||||
(replace (CHARLOOKS CLOFFSET) of NEWCHARLOOKS with (CL:IF (IGREATERP VALUE 127)
|
||||
(IDIFFERENCE VALUE 256)
|
||||
VALUE)))
|
||||
(FSETCLOOKS NEWCHARLOOKS CLOFFSET (CL:IF (IGREATERP VALUE 127)
|
||||
(IDIFFERENCE VALUE 256)
|
||||
VALUE)))
|
||||
(SPACE)
|
||||
(CR
|
||||
(* ;; "We hit the trailer-terminating CR, It is either the end-marker for the last run, or a signal that this paragraph has no run-look information. ")
|
||||
@@ -709,14 +737,14 @@
|
||||
(SETQ LEN PLEN)) (* ;
|
||||
"Otherwise, PLEN is what's left for the final substantive run")
|
||||
(GO $$OUT))
|
||||
(HELP (CHARACTER COMMAND)
|
||||
" is not a legal Bravo command character look"))
|
||||
(\TEDIT.THELP (CHARACTER COMMAND)
|
||||
" is not a legal Bravo command character look"))
|
||||
finally
|
||||
|
||||
(* ;; "Wait til end to do font, so we have the bold/italic looks for sure. Last run may not have an explicit length")
|
||||
|
||||
(replace (CHARLOOKS CLUSERINFO) of NEWCHARLOOKS with (DREVERSE TABNAMES))
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS NEWCHARLOOKS)
|
||||
(FSETCLOOKS NEWCHARLOOKS CLUSERINFO (DREVERSE TABNAMES))
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS NEWCHARLOOKS FAMILY SIZE BOLD ITALIC)
|
||||
(RETURN (create RUN
|
||||
RUNSTART _ RUNSTART
|
||||
RUNLENGTH _ LEN
|
||||
@@ -724,22 +752,29 @@
|
||||
RUNLAST _ LAST])
|
||||
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS
|
||||
[LAMBDA (CHARLOOKS) (* ; "Edited 1-Aug-2023 13:21 by rmk")
|
||||
[LAMBDA (CHARLOOKS FAMILY SIZE BOLD ITALIC) (* ; "Edited 2-Jan-2025 23:43 by rmk")
|
||||
(* ; "Edited 1-Aug-2023 13:21 by rmk")
|
||||
(* ; "Edited 31-May-91 15:26 by jds")
|
||||
|
||||
(* ;; "Takes a TEDIT CHARLOOKS with fields filled in (CLNAME = family name) and creates the font to fill it.")
|
||||
|
||||
[replace (CHARLOOKS CLFONT) of CHARLOOKS with (FONTCREATE (fetch (CHARLOOKS CLNAME) of CHARLOOKS)
|
||||
(fetch (CHARLOOKS CLSIZE) of CHARLOOKS)
|
||||
(LIST (CL:IF (fetch (CHARLOOKS CLBOLD)
|
||||
of CHARLOOKS)
|
||||
'BOLD
|
||||
'MEDIUM)
|
||||
(CL:IF (fetch (CHARLOOKS CLITAL)
|
||||
of CHARLOOKS)
|
||||
'ITALIC
|
||||
'REGULAR)
|
||||
'REGULAR]
|
||||
[LET ((OLDFONT (GETCLOOKS CHARLOOKS CLFONT)))
|
||||
(CL:WHEN (EQ FAMILY 'OFF)
|
||||
(SETQ FAMILY (FONTPROP OLDFONT 'FAMILY)))
|
||||
(CL:WHEN (EQ SIZE 'OFF)
|
||||
(SETQ SIZE (FONTPROP OLDFONT 'SIZE)))
|
||||
(CL:WHEN (EQ BOLD 'OFF)
|
||||
[SETQ BOLD (EQ 'BOLD (FONTPROP OLDFONT 'WEIGHT])
|
||||
(CL:WHEN (EQ ITALIC 'OFF)
|
||||
[SETQ ITALIC (EQ 'ITALIC (FONTPROP OLDFONT 'SLOPE])
|
||||
[SETCLOOKS CHARLOOKS CLFONT (FONTCREATE FAMILY SIZE (LIST (CL:IF BOLD
|
||||
'BOLD
|
||||
'MEDIUM)
|
||||
(CL:IF ITALIC
|
||||
'ITALIC
|
||||
'REGULAR)
|
||||
'REGULAR]
|
||||
(SETCLOOKS CHARLOOKS CLNAME (FONTUNPARSE (GETCLOOKS CHARLOOKS CLFONT]
|
||||
CHARLOOKS])
|
||||
|
||||
(\TFBRAVO.READNUM?
|
||||
@@ -775,7 +810,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.HANDLE.HEADING
|
||||
[LAMBDA (BSTREAM TEXTOBJ HEADINGSTART) (* ; "Edited 20-Aug-2023 20:11 by rmk")
|
||||
[LAMBDA (BSTREAM TEXTOBJ HEADINGSTART) (* ; "Edited 19-Feb-2025 12:17 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:05 by rmk")
|
||||
(* ; "Edited 20-Aug-2023 20:11 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 10:37 by rmk")
|
||||
(* ; "Edited 12-Aug-2023 12:25 by rmk")
|
||||
(* ; "Edited 9-Aug-2023 23:37 by rmk")
|
||||
@@ -785,31 +822,33 @@
|
||||
|
||||
(* ;; "Called from \TFBRAVO.PARSE.PROFILE.PARA. The heading is a paragraph beginning at the current position, presumably just a line with a looks trailer. Its paralooks have to be marked with special heading properties--heading type and special X and Y locations.")
|
||||
|
||||
(DECLARE (USEDFREE USER.CM.FMTSPEC))
|
||||
(LET (HEADINGDESC HEADINGPARA HEADINGFMTSPEC) (* ;
|
||||
(DECLARE (USEDFREE USER.CM.PARALOOKS))
|
||||
(LET (HEADINGDESC HEADINGPARA HEADINGPARALOOKS) (* ;
|
||||
"skip over the trailer of the profile para")
|
||||
(SETFILEPTR BSTREAM HEADINGSTART)
|
||||
(SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA USER.CM.FMTSPEC BSTREAM TEXTOBJ))
|
||||
(SETQ HEADINGFMTSPEC (fetch (PARA PARAFMTSPEC) of HEADINGPARA))
|
||||
(replace (FMTSPEC FMTPARATYPE) of HEADINGFMTSPEC with 'PAGEHEADING)
|
||||
(SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA USER.CM.PARALOOKS BSTREAM TEXTOBJ))
|
||||
(SETQ HEADINGPARALOOKS (fetch (PARA PARAFMTSPEC) of HEADINGPARA))
|
||||
(SETPLOOKS HEADINGPARALOOKS FMTPARATYPE 'PAGEHEADING)
|
||||
|
||||
(* ;; "This is where the vertical tab info is placed for the heading, remove the special x and y and use them as the position for the descriptor")
|
||||
|
||||
(SETQ HEADINGDESC (LIST (GENSYM 'PageHeading)
|
||||
(OR (fetch (FMTSPEC FMTSPECIALX) of HEADINGFMTSPEC)
|
||||
(OR (FGETPLOOKS HEADINGPARALOOKS FMTSPECIALX)
|
||||
0)
|
||||
(OR (fetch (FMTSPEC FMTSPECIALY) of HEADINGFMTSPEC)
|
||||
(OR (FGETPLOOKS HEADINGPARALOOKS FMTSPECIALY)
|
||||
0)))
|
||||
(replace (FMTSPEC FMTPARASUBTYPE) of HEADINGFMTSPEC with (CAR HEADINGDESC))
|
||||
(replace (FMTSPEC FMTSPECIALX) of HEADINGFMTSPEC with (CADR HEADINGDESC))
|
||||
(replace (FMTSPEC FMTSPECIALY) of HEADINGFMTSPEC with (CADDR HEADINGDESC))
|
||||
(FSETPLOOKS HEADINGPARALOOKS FMTPARASUBTYPE (CAR HEADINGDESC))
|
||||
(FSETPLOOKS HEADINGPARALOOKS FMTSPECIALX (CADR HEADINGDESC))
|
||||
(FSETPLOOKS HEADINGPARALOOKS FMTSPECIALY (CADDR HEADINGDESC))
|
||||
(* ;
|
||||
"now write out the heading paragraph")
|
||||
(\TFBRAVO.INSERT.PARA HEADINGPARA BSTREAM TEXTOBJ MAX.FIXP)
|
||||
HEADINGDESC])
|
||||
|
||||
(\TFBRAVO.PARSE.PROFILE.PARA
|
||||
[LAMBDA (BSTREAM PARAGRAPH TEXTOBJ START) (* ; "Edited 22-Sep-2023 20:02 by rmk")
|
||||
[LAMBDA (BSTREAM PARAGRAPH TEXTOBJ START) (* ; "Edited 19-Feb-2025 12:17 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:27 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:02 by rmk")
|
||||
(* ; "Edited 19-Aug-2023 23:33 by rmk")
|
||||
(* ; "Edited 17-Aug-2023 14:51 by rmk")
|
||||
(* ; "Edited 10-Aug-2023 10:37 by rmk")
|
||||
@@ -907,8 +946,8 @@
|
||||
(PROGN (* ;
|
||||
"Not a profile line, presumably a mistaken q.")
|
||||
(SETFILEPTR BSTREAM END)
|
||||
(replace (FMTSPEC FMTPARATYPE) of (fetch (PARA PARAFMTSPEC) of PARAGRAPH)
|
||||
with NIL)
|
||||
(FSETPLOOKS (fetch (PARA PARAFMTSPEC) of PARAGRAPH)
|
||||
FMTPARATYPE NIL)
|
||||
(RETURN NIL] repeatuntil [EQ (CAR LINE)
|
||||
(CONSTANT (CHARACTER (CHARCODE ^Z]
|
||||
finally (CL:WHEN ROMAN
|
||||
@@ -929,17 +968,20 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.INSERT.PARA
|
||||
[LAMBDA (PARA BSTREAM TEXTOBJ) (* ; "Edited 20-Aug-2023 16:13 by rmk")
|
||||
[LAMBDA (PARA BSTREAM TEXTOBJ) (* ; "Edited 8-Feb-2025 23:06 by rmk")
|
||||
(* ; "Edited 20-Aug-2023 16:13 by rmk")
|
||||
|
||||
(* ;; "Inserts pieces into TEXTOBJ that correspond to the runs in PARA. PARA may be broken up at internal CR's to get spacing and tabs right.")
|
||||
|
||||
(for P PFMTSPEC in (\TFBRAVO.SPLIT.PARA PARA)
|
||||
do (SETQ PFMTSPEC (fetch (PARA PARAFMTSPEC) of P))
|
||||
(for RUN in (fetch (PARA RUNS) of P) do (SETQ PFMTSPEC (\TFBRAVO.RUN.TABSPEC RUN PFMTSPEC))
|
||||
(\TFBRAVO.INSERT.RUN RUN BSTREAM PFMTSPEC TEXTOBJ])
|
||||
(for P PARALOOKS in (\TFBRAVO.SPLIT.PARA PARA)
|
||||
do (SETQ PARALOOKS (fetch (PARA PARAFMTSPEC) of P))
|
||||
(for RUN in (fetch (PARA RUNS) of P) do (SETQ PARALOOKS (\TFBRAVO.RUN.TABSPEC RUN PARALOOKS
|
||||
))
|
||||
(\TFBRAVO.INSERT.RUN RUN BSTREAM PARALOOKS TEXTOBJ])
|
||||
|
||||
(\TFBRAVO.INSERT.RUN
|
||||
[LAMBDA (RUN BSTREAM PARAFMTSPEC TEXTOBJ) (* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
[LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ) (* ; "Edited 8-Feb-2025 23:08 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 18:28 by rmk")
|
||||
(* ; "Edited 29-Dec-2023 11:50 by rmk")
|
||||
(* ; "Edited 23-Sep-2023 12:11 by rmk")
|
||||
@@ -949,7 +991,7 @@
|
||||
|
||||
(* ;; "A Bravo run can include many CR's each of which should end a separate TEDIT paragraph. Unless we want to think of those as paragraph internal meta-CRs ?")
|
||||
|
||||
(* ;; "PARAFMTSPEC is the intended paragraph PARALOOKS for the paragraph, providing the margins, line leading etc. common to all runs. It may be specialized for each run to encode the tabs that that run actually selects (via \TFBRAVO.RUN.TABSPEC")
|
||||
(* ;; "PARALOOKS is the intended paragraph PARALOOKS for the paragraph, providing the margins, line leading etc. common to all runs. It may be specialized for each run to encode the tabs that that run actually selects (via \TFBRAVO.RUN.TABSPEC")
|
||||
|
||||
(CL:WHEN (IGREATERP (fetch (RUN RUNLENGTH) of RUN)
|
||||
0) (* ; "No need for an empty piece")
|
||||
@@ -960,7 +1002,7 @@
|
||||
PLEN _ NCHARS
|
||||
PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (RUN RUNLOOKS) of RUN)
|
||||
TEXTOBJ)
|
||||
PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ)
|
||||
PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ)
|
||||
PPARALAST _ (fetch (RUN RUNLAST) of RUN)))
|
||||
(if (STRINGP RUNSTART)
|
||||
then
|
||||
@@ -988,10 +1030,12 @@
|
||||
PC))])
|
||||
|
||||
(\TFBRAVO.SPLIT.PARA
|
||||
[LAMBDA (PARA) (* ; "Edited 9-Sep-2023 21:35 by rmk")
|
||||
[LAMBDA (PARA) (* ; "Edited 19-Feb-2025 12:15 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:12 by rmk")
|
||||
(* ; "Edited 9-Sep-2023 21:35 by rmk")
|
||||
(* ; "Edited 22-Aug-2023 23:45 by rmk")
|
||||
|
||||
(* ;; "The Bravo paragraph PARA may contain internal CRs or FORMS that should be broken out into separate Tedit paragraphs. All of them share the same basic FMTSPEC, except that paragraphs after the first should have 0 for paragraph leading and first-paragraph margins. The charlooks for each run are carried over to the splits.")
|
||||
(* ;; "The Bravo paragraph PARA may contain internal CRs or FORMS that should be broken out into separate Tedit paragraphs. All of them share the same basic PARALOOKS, except that paragraphs after the first should have 0 for paragraph leading and first-paragraph margins. The charlooks for each run are carried over to the splits.")
|
||||
|
||||
(* ;; "However, we leave alone a paragraph with a special location, since we don't know how to arrange the positions of the later sub-paragraphs.")
|
||||
|
||||
@@ -999,7 +1043,7 @@
|
||||
|
||||
(* ;; "This smashes PARA's runs.")
|
||||
|
||||
(LET ((PARAFMTSPEC (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
(LET ((PARALOOKS (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
NEWPARAS)
|
||||
|
||||
(* ;;
|
||||
@@ -1007,9 +1051,9 @@
|
||||
|
||||
(SETQ NEWPARAS
|
||||
(if [AND (fetch (PARA FORMATPTRS) of PARA)
|
||||
(FMEMB (fetch (FMTSPEC FMTSPECIALX) of PARAFMTSPEC)
|
||||
(FMEMB (GETPLOOKS PARALOOKS FMTSPECIALX)
|
||||
'(0 NIL))
|
||||
(FMEMB (fetch (FMTSPEC FMTSPECIALY) of PARAFMTSPEC)
|
||||
(FMEMB (GETPLOOKS PARALOOKS FMTSPECIALY)
|
||||
'(0 NIL]
|
||||
then [for PTR POS RUN FIRSTRUN NEWRUNLENGTH (RUNS _ (fetch (PARA RUNS) of PARA))
|
||||
in (fetch (PARA FORMATPTRS) of PARA) eachtime (SETQ POS (CDR PTR))
|
||||
@@ -1040,7 +1084,7 @@
|
||||
NEWRUNLENGTH)))
|
||||
(replace (RUN RUNLENGTH) of RUN with NEWRUNLENGTH))
|
||||
|
||||
(* ;; "Fill in RUNS here, FMTSPEC below. No more FORMATPTRS")
|
||||
(* ;; "Fill in RUNS here, PARALOOKS below. No more FORMATPTRS")
|
||||
|
||||
(create PARA
|
||||
RUNS _ FIRSTRUN)
|
||||
@@ -1050,19 +1094,18 @@
|
||||
(* ;; "The first paragraph has LEADAFTER=0, all the others have 1STLEFTMAR=LEFTMAR and LEADAFTER=LEADBEFORE=0, except that the last one keeps the original LEADAFTER. Tabs are retained across all the runs.")
|
||||
|
||||
(replace (PARA PARAFMTSPEC) of (CAR $$VAL)
|
||||
with (create FMTSPEC using PARAFMTSPEC LEADAFTER _ 0))
|
||||
(for PTAIL (NEWFMTSPEC _ (create FMTSPEC
|
||||
using PARAFMTSPEC 1STLEFTMAR _
|
||||
(fetch (FMTSPEC LEFTMAR) of PARAFMTSPEC
|
||||
)
|
||||
LEADBEFORE _ 0 LEADAFTER _ 0))
|
||||
with (create PARALOOKS using PARALOOKS LEADAFTER _ 0))
|
||||
(for PTAIL (NEWPARALOOKS _ (create PARALOOKS
|
||||
using PARALOOKS 1STLEFTMAR _
|
||||
(GETPLOOKS PARALOOKS LEFTMAR)
|
||||
LEADBEFORE _ 0 LEADAFTER _ 0))
|
||||
on (CDR $$VAL)
|
||||
do (replace (PARA PARAFMTSPEC) of (CAR PTAIL)
|
||||
with (CL:IF (CDR PTAIL)
|
||||
NEWFMTSPEC
|
||||
(create FMTSPEC using NEWFMTSPEC LEADAFTER _
|
||||
(fetch (FMTSPEC LEADAFTER)
|
||||
of PARAFMTSPEC)))]
|
||||
NEWPARALOOKS
|
||||
(create PARALOOKS using NEWPARALOOKS LEADAFTER _
|
||||
(GETPLOOKS PARALOOKS LEADAFTER)
|
||||
))]
|
||||
else (CONS PARA)))
|
||||
|
||||
(* ;; "If t0 is the first tab specfied for a run, tx is the last tab of the previous run, and t(x+1) is defined, then change t0 to t(x+1).")
|
||||
@@ -1087,60 +1130,66 @@
|
||||
NEWPARAS])
|
||||
|
||||
(\TFBRAVO.RUN.TABSPEC
|
||||
[LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 15-Mar-2024 19:42 by rmk")
|
||||
[LAMBDA (RUN PARALOOKS) (* ; "Edited 19-Feb-2025 12:16 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:15 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 22:02 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:30 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:42 by rmk")
|
||||
(* ; "Edited 22-Aug-2023 16:54 by rmk")
|
||||
(* ; "Edited 19-Aug-2023 15:47 by rmk")
|
||||
|
||||
(* ;; "The CLUSERINFO contains a list of named tabs specified for this and presumably defined in the paragraph-wide PARAFMTSPEC. This returns a FMTSPEC for this run that only includes the named tabs that this run calls for.")
|
||||
(* ;; "The CLUSERINFO contains a list of named tabs specified for this and presumably defined in the paragraph-wide PARALOOKS. This returns a PARALOOKS for this run that only includes the named tabs that this run calls for.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "For the first run, the PARAFMTSPEC is the unspecialized run for the paragraph, with empty TABSPEC. Each subsequent run is given the FMTSPEC for the last run, so the tabs that were selected there are known. This is because t0 is loosely specified as picking the next tab in the FMTUSERINFO after the last tab that was used in the previous run (I think). (Or perhaps as setting the next tabs TABX as the interval?)")
|
||||
(* ;; "For the first run, the PARALOOKS is the unspecialized run for the paragraph, with empty TABSPEC. Each subsequent run is given the PARALOOKS for the last run, so the tabs that were selected there are known. This is because t0 is loosely specified as picking the next tab in the FMTUSERINFO after the last tab that was used in the previous run (I think). (Or perhaps as setting the next tabs TABX as the interval?)")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different FMTSPECs. ")
|
||||
(* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different PARALOOKS. ")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "NOTE: the names in the tab definitions have been bumped up by 1 to match the names in the tab looks (e.g. (0,xxx) is (1,xxx) to correspond to t1. t0 doesn't match.")
|
||||
|
||||
(LET ([LASTTAB (CAR (LAST (CDR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC]
|
||||
(TABDEFS (fetch (FMTSPEC FMTUSERINFO) of PARAFMTSPEC))
|
||||
(TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC)))
|
||||
(DECLARE (USEDFREE USER.CM.PARALOOKS))
|
||||
(LET ([LASTTAB (CAR (LAST (GETPLOOKS PARALOOKS FMTTABS]
|
||||
(TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO))
|
||||
(TABDEFAULT (OR (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FGETPLOOKS USER.CM.PARALOOKS FMTDEFAULTTAB)))
|
||||
(RUNTABS (fetch (RUN RUNTABS) of RUN))
|
||||
TAB TABSPEC)
|
||||
TAB TABS)
|
||||
(CL:WHEN (AND TABDEFS (NULL RUNTABS))
|
||||
(SETQ RUNTABS (CONS (CAAR TABDEFS))))
|
||||
(CL:WHEN (AND TABDEFS RUNTABS)
|
||||
(CL:WHEN (EQUAL RUNTABS '(0)) (* ;
|
||||
"If e.g. Tab 0 is set but the run has no tn's, assume that the first tn is intended.")
|
||||
(SETQ RUNTABS '(1 2)))
|
||||
[SETQ TABSPEC (for TABNAME in RUNTABS
|
||||
collect
|
||||
[SETQ TABS (for TABNAME in RUNTABS
|
||||
collect
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"For t0 we try to find the tab after the one last used in the previous run.")
|
||||
|
||||
(if (CDR (ASSOC TABNAME TABDEFS))
|
||||
elseif [AND (EQ TABNAME 0)
|
||||
(for TDTAIL TD on TABDEFS
|
||||
eachtime (SETQ TD (CAR TDTAIL))
|
||||
when (EQ LASTTAB (CDR TD))
|
||||
do [SETQ TABDEFAULT (fetch TABX
|
||||
of (CDR (CADR TDTAIL]
|
||||
(RETURN (CDR (CADR TDTAIL]
|
||||
else (GO $$ITERATE]
|
||||
(if (CDR (ASSOC TABNAME TABDEFS))
|
||||
elseif [AND (EQ TABNAME 0)
|
||||
(for TDTAIL TD on TABDEFS eachtime (SETQ TD
|
||||
(CAR TDTAIL))
|
||||
when (EQ LASTTAB (CDR TD))
|
||||
do [SETQ TABDEFAULT (fetch TABX
|
||||
of (CDR (CADR TDTAIL]
|
||||
(RETURN (CDR (CADR TDTAIL]
|
||||
else (GO $$ITERATE]
|
||||
|
||||
(* ;; "This asserts that the tabdefs are constant across a paragraph, that the right number of tabs are on each line in a paragraph. That assumption is mostly reasonable, given the paragraph splitting. The code above allows each run (piece) to have its own tab settings. Although \TEDIT.FORMATLINE.UPDATELOOKS can easily be modified to allow the pieces on a line to change their tab definitions, the paragraph-looks menu assumes that tabs are constant across a paragraph. So things would go bonkers.")
|
||||
|
||||
[SETQ TABSPEC (SORT (for TAB in TABDEFS collect (CDR TAB))
|
||||
(FUNCTION (LAMBDA (T1 T2)
|
||||
(ILEQ (fetch (TAB TABX) of T1)
|
||||
(fetch (TAB TABX) of T2]
|
||||
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC TABSPEC _ (CONS TABDEFAULT TABSPEC))
|
||||
))
|
||||
PARAFMTSPEC])
|
||||
[SETQ TABS (SORT (for TAB in TABDEFS collect (CDR TAB))
|
||||
(FUNCTION (LAMBDA (T1 T2)
|
||||
(ILEQ (fetch (TAB TABX) of T1)
|
||||
(fetch (TAB TABX) of T2]
|
||||
(SETQ PARALOOKS (create PARALOOKS using PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS _
|
||||
TABS)))
|
||||
PARALOOKS])
|
||||
|
||||
(\TFBRAVO.INSTALL.PAGEFORMAT
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 22-Sep-2023 20:04 by rmk")
|
||||
@@ -1220,10 +1269,12 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.ASSERT
|
||||
[LAMBDA (X Y) (* ; "Edited 9-Aug-2023 10:32 by rmk")
|
||||
[LAMBDA (X Y) (* ; "Edited 21-Oct-2024 00:27 by rmk")
|
||||
(* ; "Edited 9-Aug-2023 10:32 by rmk")
|
||||
(* gbn "19-Sep-84 21:39")
|
||||
(CL:UNLESS (EQ X Y)
|
||||
(HELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y " was found.")))])
|
||||
(\TEDIT.THELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y
|
||||
" was found.")))])
|
||||
|
||||
(\TEST.CHARACTER.LOOKS
|
||||
[LAMBDA (BSTREAM) (* ; "Edited 17-Aug-2023 09:18 by rmk")
|
||||
@@ -1332,7 +1383,11 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.ADD.NAMEDTAB
|
||||
[LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "Edited 9-Sep-2023 21:44 by rmk")
|
||||
[LAMBDA (RUN PARALOOKS TEXTOBJ) (* ; "Edited 19-Feb-2025 12:17 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:19 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 18:05 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:29 by rmk")
|
||||
(* ; "Edited 9-Sep-2023 21:44 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 18:42 by rmk")
|
||||
(* ; "Edited 15-Aug-2023 00:26 by rmk")
|
||||
(* ; "Edited 13-Aug-2023 19:56 by rmk")
|
||||
@@ -1341,43 +1396,43 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different FMTSPECs. ")
|
||||
(* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different PARALOOKS. ")
|
||||
|
||||
(* ;; "")
|
||||
(* ; "")
|
||||
|
||||
(* ;; "THIS IS NOT USED, TO BE REMOVED. RUNTABOFFSETS DOESN'T EXIST")
|
||||
|
||||
(NOTUSED)
|
||||
(LET ((RUNLOOKS (fetch (RUN RUNLOOKS) of RUN))
|
||||
(TABDEFS (fetch (FMTSPEC FMTUSERINFO) of PARAFMTSPEC))
|
||||
(TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC)))
|
||||
(TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO))
|
||||
(TABDEFAULT (FGETPLOOKS PARALOOKS FMTDEFAULTTAB))
|
||||
(TABOFFSETS '(fetch (RUN RUNTABOFFSETS) of RUN))
|
||||
TAB TABNAMES TABSPEC)
|
||||
TAB TABNAMES TABS)
|
||||
(SETQ TABNAMES (fetch (CHARLOOKS CLUSERINFO) of RUNLOOKS))
|
||||
(CL:WHEN TABDEFS
|
||||
[if TABNAMES
|
||||
then (SETQ TABSPEC (for TN in TABNAMES eachtime (add TN -1)
|
||||
when (SETQ TAB (CDR (ASSOC TN TABDEFS)))
|
||||
unless (EQ TAB T) until (EQ TN -1) collect TAB))
|
||||
then (SETQ TABS (for TN in TABNAMES eachtime (add TN -1)
|
||||
when (SETQ TAB (CDR (ASSOC TN TABDEFS)))
|
||||
unless (EQ TAB T) until (EQ TN -1) collect TAB))
|
||||
elseif (CDR TABDEFS)
|
||||
then
|
||||
(* ;; "If the run has no names, then assume that its first TAB aligns at the earliest defined tab, next aligns at the second, etc. Sort tabs by increasing TABX, not names. ")
|
||||
|
||||
[SETQ TABSPEC (SORT (for TD in TABDEFS collect (CDR TD))
|
||||
(FUNCTION (LAMBDA (T1 T2)
|
||||
(ILEQ (fetch (TAB TABX) of T1)
|
||||
(fetch (TAB TABX) of T2]
|
||||
[SETQ TABS (SORT (for TD in TABDEFS collect (CDR TD))
|
||||
(FUNCTION (LAMBDA (T1 T2)
|
||||
(ILEQ (fetch (TAB TABX) of T1)
|
||||
(fetch (TAB TABX) of T2]
|
||||
elseif (EQ 0 (CAR (CAR TABDEFS)))
|
||||
then
|
||||
(* ;;
|
||||
"No name and 0, make it be the default. How else would we decide where the second tab goes?")
|
||||
|
||||
(SETQ TABDEFAULT (fetch (TAB TABX) of (CDAR TABDEFS]
|
||||
(CL:WHEN [OR TABSPEC (NEQ TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC]
|
||||
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC TABSPEC _ (CONS TABDEFAULT
|
||||
TABSPEC)))
|
||||
(\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ)))
|
||||
PARAFMTSPEC])
|
||||
(CL:WHEN (OR TABS (NEQ TABDEFAULT (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)))
|
||||
(SETQ PARALOOKS (create PARALOOKS using PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS
|
||||
_ TABS))
|
||||
(\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ)))
|
||||
PARALOOKS])
|
||||
|
||||
(\TFBRAVO.COPY.NAMEDTAB
|
||||
[LAMBDA (OBJ PIECE OLDCH NEWCH) (* jds " 8-Feb-84 19:58")
|
||||
@@ -1450,18 +1505,18 @@
|
||||
(AND NIL (\TEDIT.NAMEDTAB.INIT))
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6795 13177 (TEDIT.BRAVOFILE? 6805 . 8535) (TEDITFROMBRAVO 8537 . 13175)) (13288 28274 (
|
||||
\TFBRAVO.GET.USER.CM 13298 . 16108) (\TFBRAVO.USER.CM.LOOKS 16110 . 17285) (\TFBRAVO.READ.USER.CM
|
||||
17287 . 21624) (\TFBRAVO.INIT.PARALOOKS 21626 . 23387) (\TFBRAVO.INIT.PAGEFORMAT 23389 . 24269) (
|
||||
\TFBRAVO.GETPARAMS 24271 . 27125) (\TFBRAVO.FIND.LAST.TRAILER 27127 . 28272)) (28316 48329 (
|
||||
\TFBRAVO.PARSE.PARA 28326 . 32013) (\TFBRAVO.READ.PARALOOKS 32015 . 38649) (\TFBRAVO.CREATE.RUNS 38651
|
||||
. 40039) (\TFBRAVO.READ.CHARLOOKS 40041 . 45059) (\TFBRAVO.FONT.FROM.CHARLOOKS 45061 . 46430) (
|
||||
\TFBRAVO.READNUM? 46432 . 48327)) (48366 59117 (\TFBRAVO.HANDLE.HEADING 48376 . 51008) (
|
||||
\TFBRAVO.PARSE.PROFILE.PARA 51010 . 59115)) (59160 80307 (\TFBRAVO.INSERT.PARA 59170 . 59823) (
|
||||
\TFBRAVO.INSERT.RUN 59825 . 63022) (\TFBRAVO.SPLIT.PARA 63024 . 70266) (\TFBRAVO.RUN.TABSPEC 70268 .
|
||||
74612) (\TFBRAVO.INSTALL.PAGEFORMAT 74614 . 80305)) (80308 84268 (\TFBRAVO.ASSERT 80318 . 80665) (
|
||||
\TEST.CHARACTER.LOOKS 80667 . 82553) (\TEST.PARAGRAPH.LOOKS 82555 . 84266)) (84753 91138 (
|
||||
\TFBRAVO.ADD.NAMEDTAB 84763 . 88096) (\TFBRAVO.COPY.NAMEDTAB 88098 . 88546) (\TFBRAVO.PUT.NAMEDTAB
|
||||
88548 . 88828) (\TFBRAVO.GET.NAMEDTAB 88830 . 89207) (\NAMEDTABNYET 89209 . 89369) (\NAMEDTABSIZE
|
||||
89371 . 89886) (\NAMEDTABPREPRINT 89888 . 90086) (\TEDIT.NAMEDTAB.INIT 90088 . 91136)))))
|
||||
(FILEMAP (NIL (6790 13568 (TEDIT.BRAVOFILE? 6800 . 8530) (TEDITFROMBRAVO 8532 . 13566)) (13679 29406 (
|
||||
\TFBRAVO.GET.USER.CM 13689 . 16499) (\TFBRAVO.USER.CM.LOOKS 16501 . 17836) (\TFBRAVO.READ.USER.CM
|
||||
17838 . 22408) (\TFBRAVO.INIT.PARALOOKS 22410 . 24519) (\TFBRAVO.INIT.PAGEFORMAT 24521 . 25401) (
|
||||
\TFBRAVO.GETPARAMS 25403 . 28257) (\TFBRAVO.FIND.LAST.TRAILER 28259 . 29404)) (29448 50146 (
|
||||
\TFBRAVO.PARSE.PARA 29458 . 33385) (\TFBRAVO.READ.PARALOOKS 33387 . 40277) (\TFBRAVO.CREATE.RUNS 40279
|
||||
. 41667) (\TFBRAVO.READ.CHARLOOKS 41669 . 46698) (\TFBRAVO.FONT.FROM.CHARLOOKS 46700 . 48247) (
|
||||
\TFBRAVO.READNUM? 48249 . 50144)) (50183 61224 (\TFBRAVO.HANDLE.HEADING 50193 . 52920) (
|
||||
\TFBRAVO.PARSE.PROFILE.PARA 52922 . 61222)) (61267 83303 (\TFBRAVO.INSERT.PARA 61277 . 62118) (
|
||||
\TFBRAVO.INSERT.RUN 62120 . 65422) (\TFBRAVO.SPLIT.PARA 65424 . 72739) (\TFBRAVO.RUN.TABSPEC 72741 .
|
||||
77608) (\TFBRAVO.INSTALL.PAGEFORMAT 77610 . 83301)) (83304 87447 (\TFBRAVO.ASSERT 83314 . 83844) (
|
||||
\TEST.CHARACTER.LOOKS 83846 . 85732) (\TEST.PARAGRAPH.LOOKS 85734 . 87445)) (87932 94587 (
|
||||
\TFBRAVO.ADD.NAMEDTAB 87942 . 91545) (\TFBRAVO.COPY.NAMEDTAB 91547 . 91995) (\TFBRAVO.PUT.NAMEDTAB
|
||||
91997 . 92277) (\TFBRAVO.GET.NAMEDTAB 92279 . 92656) (\NAMEDTABNYET 92658 . 92818) (\NAMEDTABSIZE
|
||||
92820 . 93335) (\NAMEDTABPREPRINT 93337 . 93535) (\TEDIT.NAMEDTAB.INIT 93537 . 94585)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
@@ -1,23 +1,24 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Mar-2024 11:16:36"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;120 47172
|
||||
(FILECREATED "19-Feb-2025 12:22:24"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;207 53931
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "20-Mar-2024 09:45:21" {WMEDLEY}<library>TEDIT>tedit-exports.all;118)
|
||||
:PREVIOUS-DATE "17-Feb-2025 12:26:08" {WMEDLEY}<library>TEDIT>tedit-exports.all;206)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
|
||||
PRINT))))))))
|
||||
(FILESLOAD (FROM LOADUPS) EXPORTS.ALL)
|
||||
(PUTPROPS TEDIT-ASSERT MACRO (ARGS (COND (CHECK-TEDIT-ASSERTIONS (BQUOTE (CL:UNLESS (\, (CAR ARGS)) (
|
||||
HELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS))))))))
|
||||
\TEDIT.THELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS)
|
||||
)))))))
|
||||
(GLOBALVARS CHECK-TEDIT-ASSERTIONS)
|
||||
(RPAQ? CHECK-TEDIT-ASSERTIONS T)
|
||||
(PUTPROPS OBJECT.ALLOWS MACRO ((PC OPERATION FROMTOBJ TOTOBJ) (OR (NOT (EQ OBJECT.PTYPE (PTYPE PC))) (
|
||||
\TEDIT.APPLY.OBJFN (PCONTENTS PC) OPERATION FROMTOBJ TOTOBJ))))
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:26"))
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "16-Feb-2025 11:25:32"))
|
||||
(RPAQQ \BTREEWORDSPERSLOT 4)
|
||||
(RPAQQ \BTREEMAXCOUNT 8)
|
||||
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
||||
@@ -43,8 +44,7 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
|
||||
DLEN) of SLOT with DWNL)))
|
||||
(PUTPROPS \FINDSLOT MACRO ((BTNODE ITEM) (find S inslots BTNODE suchthat (EQ ITEM (ffetch (BTSLOT DOWN
|
||||
) of S)))))
|
||||
(PUTPROPS \LASTPIECEP MACRO (OPENLAMBDA (PC TOBJ) (AND (EQ PC (ffetch (TEXTOBJ LASTPIECE) of TOBJ)) PC
|
||||
)))
|
||||
(PUTPROPS \SUFFIXPIECEP MACRO (OPENLAMBDA (PC TOBJ) (AND (EQ PC (FGETTOBJ TOBJ SUFFIXPIECE)) PC)))
|
||||
(I.S.OPR (QUOTE inslots) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$BTBODY) (QUOTE (bind $$BTBODY _ BODY
|
||||
$$BTEND declare (LOCALVARS $$BTBODY $$BTEND) first (SETQ I.V. (\FIRSTSLOT $$BTBODY)) (SETQ $$BTEND (
|
||||
\LASTSLOT $$BTBODY)) repeatuntil (EQ I.V. $$BTEND) by (\ADDBASE I.V. \BTREEWORDSPERSLOT))))) T)
|
||||
@@ -52,23 +52,24 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
|
||||
(\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||
(I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE)))
|
||||
by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:07"))
|
||||
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2025 20:56:54"))
|
||||
(DATATYPE SELECTION ((* ;;
|
||||
"Description of a piece of selected text for TEdit. Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
|
||||
) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;;
|
||||
"If DCH=0, this is a caret-only selection, with no highlighting. In that case CHLIM=(ADD1 CH#) and POINT essentially indicates whether the caret blinks before or after CH#."
|
||||
) NIL (* ; "Was Y0: Y value of topmost line of selection") X0 (* ;
|
||||
"X value of left edge of selection on the first line") NIL (* ;
|
||||
"Was DX: Width of the selection, if it's on one line.") CH# (* ; "CH# of the first selected character"
|
||||
) XLIM (* ; "X value of right edge of last selected character on the last line") CHLIM (* ;
|
||||
"X value of left edge of selection on the first line") SELLINES (* ;
|
||||
"A list of (L1 L2) pairs one for each pane, to replace the separate L1 L2 lists. Was DX: Width of the selection, if it's on one line."
|
||||
) CH# (* ; "CH# of the first selected character") XLIM (* ;
|
||||
"X value of right edge of last selected character on the last line") CHLIM (* ;
|
||||
"Last character is at (SUB1 CHLIM)") DCH (* ;
|
||||
"# of characters selected (can be zero, for empty/point selection.) This controls highlighting") L1 (*
|
||||
; "-> line descriptor for the line where the first selected character is") LN (* ;
|
||||
"-> line descriptor for the line which contains the end of the selection") NIL (* ;
|
||||
"Was YLIM: Y value of the bottom of the line that ends the selection") POINT (* ;
|
||||
"Which end should the caret appear at? (LEFT or RIGHT)") (SET FLAG) (* ;
|
||||
"T if this selection is real; NIL if not") (SELTEXTOBJ FULLXPOINTER) (* ;
|
||||
"TEXTOBJ that describes the selected text") SELKIND (* ;
|
||||
"T if this selection is real; NIL if not") (SELTEXTSTREAM FULLXPOINTER) (* ;
|
||||
"TEXTSTREAM that describes the selected text") SELKIND (* ;
|
||||
"What kind of selection? CHAR or WORD or LINE or PARA") HOW (* ;
|
||||
"SHADE used to highlight this selection") HOWHEIGHT (* ;
|
||||
"Height of the highlight (1 usually, full line for delete selection...)") (HASCARET FLAG) (* ;
|
||||
@@ -76,44 +77,50 @@ by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||
"If this selection is inside an object, which object?") (ONFLG FLAG) (* ;
|
||||
"T if the selection is highlighted on the screen, else NIL") SELOBJINFO (* ;
|
||||
"A Place for the selected object to put info about selection inside itself.")) (INIT (DEFPRINT (QUOTE
|
||||
SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))) (ACCESSFNS (DX (AND (FIXP (fetch (SELECTION X0) of
|
||||
DATUM)) (FIXP (fetch (SELECTION XLIM) of DATUM)) (IDIFFERENCE (fetch (SELECTION XLIM) of DATUM) (fetch
|
||||
(SELECTION X0) of DATUM))))) SET _ NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ (
|
||||
QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST NIL))
|
||||
SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))) (ACCESSFNS ((SELTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of (GETSEL DATUM SELTEXTSTREAM))) (CHLAST (STANDARD (SUB1 (GETSEL DATUM CHLIM)) (SETSEL DATUM CHLIM (
|
||||
ADD1 NEWVALUE))) (FAST (SUB1 (FSETSEL DATUM CHLIM)) (FSETSEL DATUM CHLIM (ADD1 NEWVALUE)))))) SET _
|
||||
NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ (QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST
|
||||
NIL))
|
||||
(DATATYPE SELPIECES (SPFIRST SPLAST SPLEN SPFIRSTCHAR SPLASTCHAR))
|
||||
(DEFPRINT (QUOTE SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))
|
||||
(RPAQQ COPYSELSHADE 30583)
|
||||
(RPAQQ COPYLOOKSSELSHADE 30583)
|
||||
(RPAQQ EDITMOVESHADE -1)
|
||||
(RPAQ EDITMOVESHADE BLACKSHADE)
|
||||
(RPAQQ EDITGRAY 32800)
|
||||
(CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE -1) (EDITGRAY 32800))
|
||||
(PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (fetch (LINEDESCRIPTOR LCHAR1) of
|
||||
LINE)) (ILEQ CHNO (fetch (LINEDESCRIPTOR LCHARLIM) of LINE)) LINE)))
|
||||
(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLIM) (AND (IGEQ CHLIM (GETLD L LCHAR1)) (ILEQ CH# (
|
||||
FGETLD L LCHARLIM)))))
|
||||
(CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE BLACKSHADE) (EDITGRAY 32800))
|
||||
(PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (GETLD LINE LCHAR1)) (ILESSP CHNO
|
||||
(FGETLD LINE LCHARLIM)) LINE)))
|
||||
(PUTPROPS FWITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (FGETLD LINE LCHAR1)) (ILESSP
|
||||
CHNO (FGETLD LINE LCHARLIM)) LINE)))
|
||||
(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (AND (IGEQ (GETLD L LCHARLAST) CH#) (ILEQ (
|
||||
FGETLD L LCHAR1) CHLAST))))
|
||||
(PUTPROPS FLINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (* ;
|
||||
"True if a CH#..CHLAST selection would include L") (AND (IGREATERP (FGETLD L LCHARLIM) CH#) (ILEQ (
|
||||
FGETLD L LCHAR1) CHLAST))))
|
||||
(PUTPROPS IBETWEENP MACRO (OPENLAMBDA (X LOW HIGH) (AND (IGEQ X LOW) (ILEQ X HIGH))))
|
||||
(PUTPROPS GETSEL MACRO ((S FIELD) (fetch (SELECTION FIELD) of S)))
|
||||
(PUTPROPS SETSEL MACRO ((S FIELD NEWVALUE) (replace (SELECTION FIELD) of S with NEWVALUE)))
|
||||
(PUTPROPS FGETSEL MACRO ((S FIELD) (ffetch (SELECTION FIELD) of S)))
|
||||
(PUTPROPS FSETSEL MACRO ((S FIELD NEWVALUE) (freplace (SELECTION FIELD) of S with NEWVALUE)))
|
||||
(PUTPROPS SELECTION! MACRO ((SEL) (\DTEST SEL (QUOTE SELECTION))))
|
||||
(I.S.OPR (QUOTE inselpieces) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$SELPIECES) (QUOTE (BIND
|
||||
$$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY DECLARE (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST
|
||||
$$SPLENGTH) FIRST (\DTEST (OR $$SELPIECES (GO $$OUT)) (QUOTE SELPIECES)) (SETQ I.V. (SETQ $$SPFIRST (
|
||||
\DTEST (ffetch (SELPIECES SPFIRST) of $$SELPIECES) (QUOTE PIECE)))) (SETQ $$SPLAST (\DTEST (ffetch (
|
||||
SELPIECES SPLAST) of $$SELPIECES) (QUOTE PIECE))) (SETQ $$SPLENGTH (ffetch (SELPIECES SPLEN) of
|
||||
$$SELPIECES)) REPEATUNTIL (EQ I.V. $$SPLAST) BY (\DTEST (NEXTPIECE I.V.) (QUOTE PIECE)))))) T)
|
||||
(PUTPROPS GETSPC MACRO ((SP FIELD) (fetch (SELPIECES FIELD) of SP)))
|
||||
(PUTPROPS SETSPC MACRO ((SP FIELD NEWVALUE) (replace (SELPIECES FIELD) of SP with NEWVALUE)))
|
||||
(PUTPROPS FGETSPC MACRO ((SP FIELD) (ffetch (SELPIECES FIELD) of SP)))
|
||||
(PUTPROPS FSETSPC MACRO ((SP FIELD NEWVALUE) (freplace (SELPIECES FIELD) of SP with NEWVALUE)))
|
||||
(PUTPROPS SELPIECES! MACRO ((SPC) (\DTEST SPC (QUOTE SELPIECES))))
|
||||
(GLOBALVARS TEDIT.EXTEND.PENDING.DELETE)
|
||||
(GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION
|
||||
TEDIT.DELETESELECTION)
|
||||
(I.S.OPR (QUOTE inselpieces) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$SELPIECES) (QUOTE (bind
|
||||
$$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY declare (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST
|
||||
$$SPLENGTH) first (SETQ I.V. (SETQ $$SPFIRST (\DTEST (OR (fetch (SELPIECES SPFIRST) of $$SELPIECES) (
|
||||
GO $$OUT)) (QUOTE PIECE)))) (SETQ $$SPLAST (fetch (SELPIECES SPLAST) of $$SELPIECES)) (SETQ $$SPLENGTH
|
||||
(fetch (SELPIECES SPLEN) of $$SELPIECES)) while I.V. repeatuntil (EQ I.V. $$SPLAST) by (NEXTPIECE
|
||||
I.V.))))) T)
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:55"))
|
||||
(DATATYPE THISLINE ((* ;;
|
||||
"Cache for line-related character location info, for selection and line-display code to use.") (DESC
|
||||
FULLXPOINTER) (* ; "Line descriptor for the line this describes now") TLSPACEFACTOR (* ;
|
||||
"The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ;
|
||||
"The first space to which SPACEFACTOR is to apply. This is used sothat spaces to the left of a TAB have their default width."
|
||||
) CHARSLOTS (* ;
|
||||
"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT"
|
||||
) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)")
|
||||
CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT))
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "18-Feb-2025 22:06:22"))
|
||||
(RECORD TAB (TABX . TABKIND))
|
||||
(RECORD TABSPEC (DEFAULTTAB . TABS))
|
||||
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
|
||||
"The bitmap that will be used by this instance of the cache") (LCNEXTCACHE FULLXPOINTER) (* ;
|
||||
"The next cache in the chain, for screen updates.")))
|
||||
@@ -125,12 +132,13 @@ CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.
|
||||
RIGHTMARGIN (* ; "Right margin, in screen points") LXLIM (* ;
|
||||
"X value of right edge of LCHARLIM character on the line (may exceed right margin, if char is a space.). In natural stream units"
|
||||
) LX1 (* ; "X value of the left edge of LCHAR1 from the left margin, in stream natural units.")
|
||||
LHEIGHT (* ; "Total height of hte line, Ascent+Descent plus leading") ASCENT (* ;
|
||||
"Ascent of the line above YBASE, adjusted for line leading") DESCENT (* ;
|
||||
LHEIGHT (* ;
|
||||
"Total height of hte line, Ascent+Descent plus leading. Includes paragraph and line leading") LASCENT
|
||||
(* ; "Ascent of the line above YBASE, adjusted for line and paragraph leading") LDESCENT (* ;
|
||||
"How far line descends below YBASE, adjusted for line leading") LTRUEDESCENT (* ;
|
||||
"The TRUE DESCENT for this line, unadjusted for line leading.") LTRUEASCENT (* ;
|
||||
"The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") LCHAR1 (* ;
|
||||
"CH# of the first character on the line.") LCHARLIM (* ; "CH# of the last character on the line")
|
||||
"CH# of the first character on the line.") LCHARLAST (* ; "CH# of the last character on the line")
|
||||
FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ;
|
||||
"Was CHARTOP: CH# of the character which forced the line break (may be less than CHARLIM)") NEXTLINE
|
||||
(* ; "Next line chain pointer") (PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer") LMARK (* ;
|
||||
@@ -140,20 +148,28 @@ FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ;
|
||||
"A cached textstream that this line took its text from. Filled in by \TEDIT.FORMATLINE only in hardcopy, used temporarily and the cleared by \TEDIT.FORMATBOX to avoid the circularity."
|
||||
) NIL (* ;
|
||||
"Was CACHE: A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit. Now: THISLINE comes from TEXTOBJ"
|
||||
) NIL (* ; "Was LDOBJ: The object which lies behind this line of text, for updating, etc.") LFMTSPEC (
|
||||
* ; "The format spec for this line's paragraph (eventually)") (LDIRTY FLAG) (* ;
|
||||
"T if this line has changed since it was last formatted.") (NIL FLAG) (* ; "Was FORCED-END flag") (
|
||||
DELETED FLAG) (* ;
|
||||
"T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)"
|
||||
) (LHASPROT FLAG) (* ; "This line contains protected text.") (LDUMMY FLAG) (* ;
|
||||
) NIL (* ; "Was LDOBJ: The object which lies behind this line of text, for updating, etc.") LPARALOOKS
|
||||
(* ; "The paragraph looks for this line's paragraph (eventually)") (NIL FLAG) (* ;
|
||||
"Was LDIRTY: T if this line has changed since it was last formatted.") (NIL FLAG) (* ;
|
||||
"Was FORCED-END flag") (NIL FLAG) (* ;
|
||||
"Was DELETED: T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)"
|
||||
) (NIL FLAG) (* ; "Was LHASPROT This line contains protected text.") (LDUMMY FLAG) (* ;
|
||||
"This is a dummy line. Was: LHASTABS. But never fetched and this descriptions wasn't true: If this line has a tab in it, this is the line-relative ch# of the final tab. This is to let us punt properly with tabs in a line."
|
||||
) (1STLN FLAG) (* ; "This line is the first line in a paragraph") (LSTLN FLAG) (* ;
|
||||
"This is the last line in a paragraph")) (INIT (DEFPRINT (QUOTE LINEDESCRIPTOR) (FUNCTION
|
||||
\TEDIT.LINEDESCRIPTOR.DEFPRINT))) (ACCESSFNS ((YTOP (IPLUS (FGETLD DATUM YBOT) (FGETLD DATUM LHEIGHT))
|
||||
) (LTRUEHEIGHT (IPLUS (FGETLD DATUM LTRUEASCENT (FGETLD DATUM LTRUEDESCENT)))) (LTRUEYTOP (IPLUS (
|
||||
GETLD DATUM YBOT) (FGETLD DATUM LTRUEHEIGHT))) (LTRUEYBOT (IDIFFERENCE (FGETLD DATUM YBASE) (FGETLD
|
||||
DATUM LTRUEDESCENT))))) LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 LCHARLIM _ 1000000 NEXTLINE _ NIL
|
||||
PREVLINE _ NIL LDIRTY _ NIL YBOT _ 0 YBASE _ 0 LEFTMARGIN _ 0 DELETED _ NIL)
|
||||
\TEDIT.LINEDESCRIPTOR.DEFPRINT))) (ACCESSFNS ((YTOP (STANDARD (IPLUS (GETLD DATUM YBASE) (GETLD DATUM
|
||||
LASCENT)) FAST (IPLUS (FGETLD DATUM YBASE) (FGETLD DATUM LASCENT)))) (LTRUEYTOP (STANDARD (IPLUS (
|
||||
GETLD DATUM YBASE) (FGETLD DATUM LTRUEASCENT)) FAST (IPLUS (FGETLD DATUM YBASE) (FGETLD DATUM
|
||||
LTRUEASCENT)))) (LTRUEHEIGHT (STANDARD (IPLUS (GETLD DATUM LTRUEASCENT) (FGETLD DATUM LTRUEDESCENT))
|
||||
FAST (IPLUS (FGETLD DATUM LTRUEASCENT) (FGETLD DATUM LTRUEDESCENT)))) (LTRUEYBOT (STANDARD (
|
||||
IDIFFERENCE (GETLD DATUM YBASE) (FGETLD DATUM LTRUEDESCENT)) FAST (IDIFFERENCE (FGETLD DATUM YBASE) (
|
||||
FGETLD DATUM LTRUEDESCENT)))) (LLEADBEFORE (STANDARD (IDIFFERENCE (GETLD DATUM LASCENT) (FGETLD DATUM
|
||||
LTRUEASCENT)) FAST (IDIFFERENCE (FGETLD DATUM LASCENT) (FGETLD DATUM LTRUEASCENT)))) (LCHARLIM (
|
||||
STANDARD (ADD1 (GETLD DATUM LCHARLAST)) FAST (ADD1 (FGETLD DATUM LCHARLAST))) (STANDARD (SETLD DATUM
|
||||
LCHARLAST (SUB1 NEWVALUE)) FAST (FSETLD DATUM LCHARLAST (SUB1 NEWVALUE)))) (LNCH (STANDARD (
|
||||
IDIFFERENCE (GETLD DATUM LCHARLIM) (GETLD DATUM LCHAR1)) FAST (IDIFFERENCE (FGETLD DATUM LCHARLIM) (
|
||||
FGETLD DATUM LCHAR1)))))) LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 YBOT _ 0 YBASE _ 0 LEFTMARGIN _
|
||||
0)
|
||||
(DEFPRINT (QUOTE LINEDESCRIPTOR) (FUNCTION \TEDIT.LINEDESCRIPTOR.DEFPRINT))
|
||||
(I.S.OPR (QUOTE inlines) NIL (QUOTE (bind $$PREVLINE declare (LOCALVARS $$PREVLINE) first (SETQ I.V. (
|
||||
\DTEST (OR BODY (GO $$OUT)) (QUOTE LINEDESCRIPTOR))) by (PROGN (SETQ $$PREVLINE I.V.) (\DTEST (OR (
|
||||
@@ -165,18 +181,39 @@ fetch (LINEDESCRIPTOR PREVLINE) of I.V.) (GO $$OUT)) (QUOTE LINEDESCRIPTOR))))))
|
||||
(PUTPROPS FGETLD MACRO ((L FIELD) (ffetch (LINEDESCRIPTOR FIELD) of L)))
|
||||
(PUTPROPS SETLD MACRO ((L FIELD NEWVALUE) (replace (LINEDESCRIPTOR FIELD) of L with NEWVALUE)))
|
||||
(PUTPROPS FSETLD MACRO ((L FIELD NEWVALUE) (freplace (LINEDESCRIPTOR FIELD) of L with NEWVALUE)))
|
||||
(PUTPROPS SETYPOS MACRO (OPENLAMBDA (LINE BOTTOM) (FSETLD LINE YBASE (IPLUS (GETLD LINE DESCENT) (
|
||||
(PUTPROPS SETYBOT MACRO (OPENLAMBDA (LINE BOTTOM) (FSETLD LINE YBASE (IPLUS (GETLD LINE LDESCENT) (
|
||||
FSETLD LINE YBOT BOTTOM)))))
|
||||
(PUTPROPS SETYTOP MACRO (OPENLAMBDA (LINE TOP) (SETYBOT LINE (IDIFFERENCE TOP (GETLD LINE LHEIGHT)))))
|
||||
(PUTPROPS SETYBASE MACRO (OPENLAMBDA (LINE BASE) (FSETLD LINE YBOT (IDIFFERENCE (GETLD LINE LDESCENT)
|
||||
(FSETLD LINE YBASE BASE)))))
|
||||
(PUTPROPS LINKLD MACRO (OPENLAMBDA (LINE1 LINE2) (CL:WHEN LINE1 (SETLD LINE1 NEXTLINE LINE2)) (CL:WHEN
|
||||
LINE2 (SETLD LINE2 PREVLINE LINE1))))
|
||||
(PUTPROPS LINEDESCRIPTOR! MACRO ((LD) (\DTEST LD (QUOTE LINEDESCRIPTOR))))
|
||||
(PUTPROPS HCSCALE MACRO (OPENLAMBDA (SCALE ITEM) (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR (
|
||||
FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
|
||||
(PUTPROPS HCUNSCALE MACRO (OPENLAMBDA (SCALE ITEM) (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR (
|
||||
FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
|
||||
(PUTPROPS SCALEUP MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I in
|
||||
ITEM collect (FIXR (FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
|
||||
(PUTPROPS SCALEDOWN MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I
|
||||
in ITEM collect (FIXR (FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
|
||||
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
|
||||
(ADDTOVAR CHARACTERNAMES (EM-DASH "357,045") (SOFT-HYPHEN "357,043") (NONBREAKING-HYPHEN "357,042") (
|
||||
NONBREAKING-SPACE "357,041"))
|
||||
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
|
||||
192) (ILEQ CHAR 207))))
|
||||
(PUTPROPS \TEDIT.LINE.TALLP MACRO ((LINE HEIGHT) (OR (IGREATERP (FGETLD LINE LHEIGHT) 50) (IGREATERP (
|
||||
FGETLD LINE LHEIGHT) HEIGHT))))
|
||||
(* ; "Formatting slots held by THISLINE")
|
||||
(DATATYPE THISLINE ((* ;;
|
||||
"Cache for line-related character location info, for selection and line-display code to use.") (DESC
|
||||
FULLXPOINTER) (* ; "Line descriptor for the line this describes now") TLSPACEFACTOR (* ;
|
||||
"The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ;
|
||||
"The first space to which SPACEFACTOR is to apply. This is used sothat spaces to the left of a TAB have their default width."
|
||||
) CHARSLOTS (* ;
|
||||
"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT"
|
||||
) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)")
|
||||
CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT))
|
||||
(BLOCKRECORD CHARSLOT (CHAR CHARW (* ; "If CHAR is NIL, then CHARW is CHARLOOKS.")))
|
||||
(PUTPROPS CHAR MACRO ((CSLOT) (ffetch (CHARSLOT CHAR) of CSLOT)))
|
||||
(PUTPROPS CHARW MACRO ((CSLOT) (ffetch (CHARSLOT CHARW) of CSLOT)))
|
||||
@@ -224,9 +261,7 @@ SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE NEX
|
||||
THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)) by (PREVCHARSLOT I.V.)
|
||||
eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.))
|
||||
repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
|
||||
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
|
||||
192) (ILEQ CHAR 207))))
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:35"))
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "18-Feb-2025 12:50:32"))
|
||||
(DATATYPE PIECE ((* ;
|
||||
"The piece describes either a string or part of a file. , or a generalized OBJECT.") PCONTENTS (* ;
|
||||
"The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
|
||||
@@ -234,8 +269,8 @@ repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
|
||||
PBYTELEN (* ; "Length of this character piece in bytes. PBYTELEN = PLEN*PBYTESPERCHAR") PFPOS (* ;
|
||||
"The FILEPTR of the start of the piece in the file") PLEN (* ; "Length of the piece, in characters.")
|
||||
NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ;
|
||||
"-> Prior piece in this text object.") PLOOKS (* ; "Character formatting info ") PBYTESPERCHAR (* ;
|
||||
"The number of bytes per character, given that all characters in a piece are the same length.") (
|
||||
"-> Prior piece in this text object.") PCHARLOOKS (* ; "Character formatting info ") PBYTESPERCHAR (*
|
||||
; "The number of bytes per character, given that all characters in a piece are the same length.") (
|
||||
PPARALAST FLAG) (* ; "This piece ends paragraph") PPARALOOKS (* ; "Paragraph looks for this piece") (
|
||||
PNEW FLAG) (* ;
|
||||
"This text is new here; used by the tentative edit system, and anyone else interested.") (NIL FLAG) (
|
||||
@@ -243,28 +278,31 @@ PNEW FLAG) (* ;
|
||||
XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PCHARSET BYTE) (* ;
|
||||
"High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ;
|
||||
"The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") (ACCESSFNS ((
|
||||
POBJ (IMAGEOBJP (PCONTENTS DATUM))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _
|
||||
TEDIT.DEFAULT.FMTSPEC)
|
||||
POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM))) (
|
||||
PLOOKS (STANDARD (fetch (PIECE PCHARLOOKS) of DATUM) FAST (fetch (PIECE PCHARLOOKS) of DATUM)) (
|
||||
STANDARD (replace (PIECE PCHARLOOKS) of DATUM with NEWVALUE) FAST (freplace (PIECE PCHARLOOKS) of
|
||||
DATUM with NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC)
|
||||
(DATATYPE TEXTOBJ ((* ;;
|
||||
"This is where TEdit stores its state information, and internal data about the text being edited.")
|
||||
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PANES (* ;
|
||||
"A list of panes (subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC"
|
||||
) LASTPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end")
|
||||
NIL (* ;
|
||||
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ;
|
||||
"A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC"
|
||||
) SUFFIXPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end")
|
||||
CHARFN (* ;
|
||||
"Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#")
|
||||
HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ;
|
||||
"Was # of characters already in the piece.") INSERTSTRING (* ;
|
||||
"A substring of storage that is available for an insertion.") TXTHISTORYUNDONE (* ;
|
||||
"Events that result from undoing other events, for revoking the UNDO. Was: CH# of first char in the piece."
|
||||
) (TXTLINELEADINGABOVE FLAG) (* ;
|
||||
"NIL for old/existing Tedit files whose lines are formatted with leading below, T for newer files. Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL."
|
||||
) \WINDOW (* ; "The window-pane<s> where this textobj is displayed") MOUSEREGION (* ;
|
||||
"Section of the window the mouse is in.") NIL (* ;
|
||||
) (NIL FLAG) (* ;
|
||||
" Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL."
|
||||
) (TXTREADONLYQUIET FLAG) (* ; "T => don't print READONLY abort messages") PARABREAKCHARS (* ;
|
||||
"Characters that cause a paragraph break.Was \WINDOW. The window-pane<s> where this textobj is displayed. Now chained through PRIMARYPANE"
|
||||
) MOUSEREGION (* ; "Section of the window the mouse is in.") LOOPFN (* ;
|
||||
"Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES."
|
||||
) DS (* ;
|
||||
"NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")
|
||||
SEL (* ; "The current selection within the text") SCRATCHSEL (* ;
|
||||
"Scratch space for the selection code") SCRATCHSEL2 (* ;
|
||||
SEL (* ; "The current selection within the text") LASTARROWX (* ;
|
||||
"X for next arrow up or arrow down. Was: Scratch space for the selection code") NIL (* ;
|
||||
"Was MOVESEL: Source for the next MOVE of text") NIL (* ; "Was SHIFTEDSEL: Source for the next COPY")
|
||||
NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
|
||||
"Right edge of the window (or subregion) where this is displayed") WTOP (* ;
|
||||
@@ -272,12 +310,12 @@ NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
|
||||
"Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (\XDIRTY FLAG)
|
||||
(* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ;
|
||||
"-> the TEXTOFD stream which gives access to this textobj") EDITFINISHEDFLG (* ;
|
||||
"T => The guy has asked the editor to go way") CARET (* ;
|
||||
"Describes the flashing caret for the editing window") CARETLOOKS (* ;
|
||||
"T => The guy has asked the editor to go way") NIL (* ;
|
||||
"Was CARET: Describes the flashing caret for the editing window") CARETLOOKS (* ;
|
||||
"Font to be used for inserted text.") WINDOWTITLE (* ;
|
||||
"Original title for this window, of there was one.") THISLINE (* ;
|
||||
"Cache of line-related info, to speed up selection &c") (MENUFLG FLAG) (* ;
|
||||
"T if this TEXTOBJ is a tedit-style menu") FMTSPEC (* ;
|
||||
"T if this TEXTOBJ is a tedit-style menu") DEFAULTPARALOOKS (* ;
|
||||
"Default Formatting Spec to be used when formatting paragraphs") (FORMATTEDP FLAG) (* ;
|
||||
"Flag for paragraph formatting. T if this document is to contain paragraph formatting information.")
|
||||
(TXTREADONLY FLAG) (* ; "This is only available for shift selection.") (TXTEDITING FLAG) (* ;
|
||||
@@ -292,7 +330,8 @@ NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
|
||||
"The READTABLE to be used to decide on word breaks") EDITPROPS (* ;
|
||||
"The PROPS that were passed into this edit session") (BLUEPENDINGDELETE FLAG) (* ;
|
||||
"T if the next insertion in this document is to be preceded by a deletion of the then-current selection"
|
||||
) TXTHISTORY (* ; "The history list for this edit session.") (SELPANE FULLXPOINTER) (* ;
|
||||
) (TXTHISTORYINACTIVE FLAG) (* ; "T if history events are not recorded (e.g. for transcript files)")
|
||||
TXTHISTORY (* ; "The history list for this edit session.") (SELPANE FULLXPOINTER) (* ;
|
||||
"The pane in which the last 'real' selection got made for this edit; used by TEDIT.NORMALIZECAREET")
|
||||
PROMPTWINDOW (* ;
|
||||
"A window to be used for unscheduled interactions; normally a small window above the edit window")
|
||||
@@ -301,18 +340,20 @@ DISPLAYCACHEDS (* ; "The DISPLAYSTREAM that is used to build line images") DISPL
|
||||
"The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode"
|
||||
) TXTPAGEFRAMES (* ; "A tree of page frames, specifying how the document is to be laid out.")
|
||||
TXTCHARLOOKSLIST (* ; "List of all the CHARLOOKSs in the document, so they can be kept unique")
|
||||
TXTPARALOOKSLIST (* ; "List of all the FMTSPECs in the document, so they can be kept unique") (
|
||||
TXTNEEDSUPDATE FLAG) (* ; "T => Screen invalid, need to run updater") (TXTDON'TUPDATE FLAG) (* ;
|
||||
TXTPARALOOKSLIST (* ; "List of all the PARALOOKS in the document, so they can be kept unique") (
|
||||
TXTAPPENDONLY FLAG) (* ;
|
||||
"Allows updates only at the end of the stream. Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater"
|
||||
) (TXTDON'TUPDATE FLAG) (* ;
|
||||
"T if we're holding off on screen updates until later. Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW."
|
||||
) TXTRAWINCLUDESTREAM (* ;
|
||||
"NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)") DOCPROPS (* ;
|
||||
"Document properties that are stored with the document (not used yet)") TXTSTYLESHEET (* ;
|
||||
"Style sheet local to this document. Not currently saved as part of the file.")) (ACCESSFNS TEXTOBJ (
|
||||
(\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM
|
||||
)) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY OF DATUM WITH NEWVALUE))))) SEL _ (create
|
||||
SELECTION) SCRATCHSEL _ (create SELECTION) SCRATCHSEL2 _ (create SELECTION) TEXTLEN _ 0 WRIGHT _ 0
|
||||
WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 TXTFILE _ NIL \XDIRTY _ NIL MOUSEREGION _ (QUOTE TEXT) THISLINE _ (
|
||||
create THISLINE) MENUFLG _ NIL FMTSPEC _ TEDIT.DEFAULT.FMTSPEC FORMATTEDP _ NIL INSERTSTRING _ NIL)
|
||||
(\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (PROGN (FSETTOBJ DATUM LASTARROWX NIL) (CL:UNLESS (EQ
|
||||
NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM)) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY
|
||||
OF DATUM WITH NEWVALUE)))))) SEL _ (create SELECTION) TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0
|
||||
WBOTTOM _ 0 MOUSEREGION _ (QUOTE TEXT) THISLINE _ (create THISLINE) DEFAULTPARALOOKS _
|
||||
TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
|
||||
(ACCESSFNS TEXTSTREAM ((* ;;
|
||||
"Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") (* ;;
|
||||
"The # of characters that have already been read from the current piece") (TEXTOBJ (fetch (STREAM F3)
|
||||
@@ -320,23 +361,25 @@ of DATUM) (REPLACE (STREAM F3) OF DATUM WITH NEWVALUE)) (* ; "The TEXTOBJ that i
|
||||
(PIECE (fetch (STREAM F5) of DATUM) (REPLACE (STREAM F5) OF DATUM WITH NEWVALUE)) (* ;
|
||||
"The PIECE we're currently fetching chars from/putting chars into") (PCCHARSLEFT (fetch (STREAM F1) of
|
||||
DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (* ; "Runs from PLEN to 0: piece exhausted") (
|
||||
CURRENTLOOKS (fetch (STREAM F10) of DATUM) (replace (STREAM F10) of DATUM with NEWVALUE)) (* ;
|
||||
"The CHARLOOKS that are currently applicable to characters being taken from the stream.") (
|
||||
CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with
|
||||
NIL) (* ;
|
||||
"Was CURRENTLOOKS at F10: The CHARLOOKS that are currently applicable to characters being taken from the stream. This is now CARETLOOKS of the TEXTOBJ."
|
||||
) (CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (replace (STREAM IMAGEDATA) of DATUM with
|
||||
NEWVALUE)) (* ;
|
||||
"The FMTSPEC that is currently applicable to characters being taken from the stream. This was the only residual field of TEXTIMAGEDATA, now gone."
|
||||
) (LOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ;
|
||||
"Function to be called at every piece change when line-formatting.") (STARTINGCOFFSET (fetch (STREAM
|
||||
F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE? (AND (type? STREAM DATUM) (type?
|
||||
TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create STREAM BINABLE _ NIL BOUTABLE _ NIL
|
||||
ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4
|
||||
_ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS IMAGEDATA _ NIL)))
|
||||
"THIS IS SOMEHOW INVOLVED IN STYLES, NOT SENSIBLE. REMOVE? The PARALOOKS that is currently applicable to characters being taken from the stream. This was the only residual field of TEXTIMAGEDATA, now gone."
|
||||
) (APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (replace (STREAM F4) OF DATUM with NEWVALUE)) (* ;
|
||||
"Determines whether to call \TEDIT.FORMATLINE.UPDATELOOKS at every piece change when line-formatting."
|
||||
) (STARTINGCOFFSET (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE?
|
||||
(AND (type? STREAM DATUM) (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create
|
||||
STREAM BINABLE _ NIL BOUTABLE _ NIL ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _
|
||||
\TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4 _ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS
|
||||
IMAGEDATA _ NIL)))
|
||||
(PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC)))
|
||||
(PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) of PC)))
|
||||
(PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC)))
|
||||
(PUTPROPS PTYPE MACRO ((PC) (ffetch (PIECE PTYPE) of PC)))
|
||||
(PUTPROPS PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC)))
|
||||
(PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PLOOKS) of PC)))
|
||||
(PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
|
||||
(PUTPROPS PCHARLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
|
||||
(PUTPROPS PCHARSET MACRO ((PC) (ffetch (PIECE PCHARSET) of PC)))
|
||||
(PUTPROPS PPARALOOKS MACRO ((PC) (ffetch (PIECE PPARALOOKS) of PC)))
|
||||
(PUTPROPS PPARALAST MACRO ((PC) (ffetch (PIECE PPARALAST) of PC)))
|
||||
@@ -345,16 +388,16 @@ ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _
|
||||
(PUTPROPS PNEW MACRO ((PC) (ffetch (PIECE PNEW) of PC)))
|
||||
(PUTPROPS PBINABLE MACRO ((PC) (ffetch (PIECE PBINABLE) of PC)))
|
||||
(PUTPROPS PBYTESPERCHAR MACRO ((PC) (ffetch (PIECE PBYTESPERCHAR) of PC)))
|
||||
(PUTPROPS POBJ MACRO ((PC) (ffetch (PIECE POBJ) of PC)))
|
||||
(PUTPROPS SETPC MACRO ((PC FIELD NEWVALUE) (replace (PIECE FIELD) of PC with NEWVALUE)))
|
||||
(PUTPROPS FSETPC MACRO ((PC FIELD NEWVALUE) (freplace (PIECE FIELD) of PC with NEWVALUE)))
|
||||
(PUTPROPS GETPC MACRO ((PC FIELD) (fetch (PIECE FIELD) of PC)))
|
||||
(PUTPROPS FGETPC MACRO ((PC FIELD) (ffetch (PIECE FIELD) of PC)))
|
||||
(PUTPROPS THINPIECEP MACRO ((PC) (* ;;
|
||||
"Assume that objects start out thin, for CHARSET in \TEDIT.PUT.PCTB. The putfn might immediately change that, but we don't care."
|
||||
) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) (OBJECT.PTYPE
|
||||
T) NIL)))
|
||||
(PUTPROPS VISIBLEPIECEP MACRO ((PC) (NOT (OR (EQ 0 (PLEN PC)) (fetch (CHARLOOKS CLINVISIBLE) of (
|
||||
PLOOKS PC))))))
|
||||
) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) NIL)))
|
||||
(PUTPROPS VISIBLEPIECEP MACRO ((PC) (AND PC (NEQ 0 (PLEN PC)) (NOT (FGETCLOOKS (PCHARLOOKS PC)
|
||||
CLINVISIBLE)))))
|
||||
(PUTPROPS \NEXT.VISIBLE.PIECE MACRO ((PC) (find NPC inpieces (AND PC (NEXTPIECE PC)) suchthat (
|
||||
VISIBLEPIECEP NPC))))
|
||||
(PUTPROPS \PREV.VISIBLE.PIECE MACRO ((PC) (find PPC backpieces (AND PC (PREVPIECE PC)) suchthat (
|
||||
@@ -366,12 +409,18 @@ VISIBLEPIECEP PPC))))
|
||||
(PUTPROPS TEXTLEN MACRO ((TOBJ) (ffetch (TEXTOBJ TEXTLEN) of TOBJ)))
|
||||
(PUTPROPS TEXTSEL MACRO ((TOBJ) (fetch (TEXTOBJ SEL) of TOBJ)))
|
||||
(PUTPROPS TEXTOBJ! MACRO ((TOBJ) (\DTEST TOBJ (QUOTE TEXTOBJ))))
|
||||
(PUTPROPS GETTSTR MACRO ((TSTR FIELD) (fetch (TEXTSTREAM FIELD) of TSTR)))
|
||||
(PUTPROPS SETTSTR MACRO ((TSTR FIELD NEWVALUE) (replace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
|
||||
(PUTPROPS FGETTSTR MACRO ((TSTR FIELD) (ffetch (TEXTSTREAM FIELD) of TSTR)))
|
||||
(PUTPROPS FSETTSTR MACRO ((TSTR FIELD NEWVALUE) (freplace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
|
||||
(PUTPROPS TEXTSTREAM! MACRO (OPENLAMBDA (TSTR) (AND (\DTEST TSTR (QUOTE STREAM)) (TEXTOBJ! (FGETTSTR
|
||||
TSTR TEXTOBJ)) TSTR)))
|
||||
(RPAQQ PTYPES ((THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
|
||||
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
|
||||
UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE
|
||||
UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
|
||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
||||
THINSTRING.PTYPE))))
|
||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))))
|
||||
(RPAQQ THINFILE.PTYPE 0)
|
||||
(RPAQQ FATFILE1.PTYPE 1)
|
||||
(RPAQQ FATFILE2.PTYPE 2)
|
||||
@@ -388,14 +437,15 @@ UTF16LE.PTYPE))
|
||||
(RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
|
||||
(RPAQ BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||
(RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||
(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))
|
||||
(CONSTANTS (THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
|
||||
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
|
||||
UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE
|
||||
UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
|
||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
||||
THINSTRING.PTYPE)))
|
||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
|
||||
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:37"))
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "17-Feb-2025 12:25:59"))
|
||||
(RPAQQ NONE.TTC 0)
|
||||
(RPAQQ CHARDELETE.TTC 1)
|
||||
(RPAQQ WORDDELETE.TTC 2)
|
||||
@@ -414,10 +464,10 @@ THINSTRING.PTYPE)))
|
||||
(CONSTANTS (NONE.TTC 0) (CHARDELETE.TTC 1) (WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) (
|
||||
REDO.TTC 5) (UNDO.TTC 6) (CMD.TTC 7) (NEXT.TTC 8) (EXPAND.TTC 9) (CHARDELETE.FORWARD.TTC 10) (
|
||||
WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))
|
||||
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* Test to see if only the specified mouse button is down.
|
||||
DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it WAS called.) (
|
||||
SELECTQ (CAR BUTTON) (LEFT (QUOTE (IEQP LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (IEQP LASTMOUSEBUTTONS 1)
|
||||
)) (RIGHT (QUOTE (IEQP LASTMOUSEBUTTONS 2))) (SHOULDNT))))
|
||||
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;;
|
||||
"Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
|
||||
) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
|
||||
) (RIGHT (QUOTE (EQ LASTMOUSEBUTTONS 2))) (SHOULDNT))))
|
||||
(PUTPROPS \TEDIT.CHECK MACRO (ARGS (COND ((AND (BOUNDP (QUOTE CHECK)) CHECK) (CONS (QUOTE PROGN) (for
|
||||
I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (QUOTE HELP)
|
||||
"TEdit consistency-check failure [RETURN to continue]: " (COND ((STRINGP (CADR J))) (T (KWOTE I))))))
|
||||
@@ -431,18 +481,20 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
|
||||
(RPAQQ NEWCHAR-IF-SPLIT.LB 32)
|
||||
(CONSTANTS (NOTBEFORE.LB 1) (NOTAFTER.LB 2) (BEFORE.LB 4) (AFTER.LB 8) (DISAPPEAR-IF-NOT-SPLIT.LB 16)
|
||||
(NEWCHAR-IF-SPLIT.LB 32))
|
||||
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:16"))
|
||||
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "17-Feb-2025 12:25:49"))
|
||||
(PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) (SIGNED (create WORD HIBYTE _ (\BIN STREAM) LOBYTE _ (
|
||||
\BIN STREAM)) BITSPERWORD)))
|
||||
(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
|
||||
LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:52"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:42"))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:11:42"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:09:40"))
|
||||
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
|
||||
CLFONT (* ; "The font descriptor for these characters") CLNAME (* ;;
|
||||
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
|
||||
"The font descriptor for these characters") CLFONTUNPARSE (* ;;
|
||||
"Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE. USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT."
|
||||
) CLSIZE (* ; "Font size, in points") (CLITAL FLAG) (* ; "T if the characters are italic, else NIL") (
|
||||
CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
) NIL (* ; "Was CLSIZE. Font size, in points") (NIL FLAG) (* ;
|
||||
"Was CLITAL: T if the characters are italic, else NIL") (NIL FLAG) (* ;
|
||||
"Was CLBoldT if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
"T if the characters are to be underscored, else NIL") (CLOLINE FLAG) (* ;
|
||||
"T if the characters are to be overscored, else NIL") (CLSTRIKE FLAG) (* ;
|
||||
"T if the characters are to be struck thru, else nil.") CLOFFSET (* ;
|
||||
@@ -450,9 +502,9 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
"T if small caps, else NIL") (CLINVERTED FLAG) (* ;
|
||||
"T if the characters are to be shown white-on-black") (CLPROTECTED FLAG) (* ;
|
||||
"T if chars can't be selected, else NIL") (CLINVISIBLE FLAG) (* ;
|
||||
"T if TEDIT is to ignore these chars; else NIL") (CLSELHERE FLAG) (* ;;
|
||||
"T if TEDIT can put selection after this char (for menu blanks) else NIL; anything typed after this char will NOT BE PROTECTED."
|
||||
) (CLCANCOPY FLAG) (* ;;
|
||||
"T if TEDIT is to ignore these chars; else NIL") (CLSELAFTER FLAG) (* ;
|
||||
"T if TEDIT can put selection after this char (for menu fields).") (* ;; "Was CLSELHERE. ") (CLCANCOPY
|
||||
FLAG) (* ;;
|
||||
"T if this text can be selected for copying, even tho protected (it will become unprotected after the copy; for Dribble/TTY interface)"
|
||||
) (CLUNBREAKABLE FLAG) (* ; "Spaces are treated as nonbreaking spaces") CLSTYLE (* ;
|
||||
"The style to be used in marking these characters; overridden by the other fields") CLUSERINFO (* ;
|
||||
@@ -461,8 +513,11 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
"For arbitrarily-places horizontal rules. List of pairs, of (widthinpts . offsetfrombaselineinpts). Should be taken account of in ascent/descent calcs."
|
||||
) (CLMARK FLAG) (* ;;
|
||||
"Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document"
|
||||
)) CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))))
|
||||
(DATATYPE FMTSPEC ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")
|
||||
) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields)."))
|
||||
CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))) (ACCESSFNS (
|
||||
CLNAME (fetch (CHARLOOKS CLFONTUNPARSE) of DATUM) (replace (CHARLOOKS CLFONTUNPARSE) of DATUM with
|
||||
NEWVALUE))))
|
||||
(DATATYPE PARALOOKS ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")
|
||||
1STLEFTMAR (* ; "Left margin of the first line of the paragraph") LEFTMAR (* ;
|
||||
"Left margin of the rest of the lines in the paragraph") RIGHTMAR (* ;
|
||||
"Right margin for the paragraph") LEADBEFORE (* ;
|
||||
@@ -470,9 +525,9 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
"Leading below the paragraph's bottom line, in points. NOT IMPLEMENTED.") LINELEAD (* ;
|
||||
"Leading between lines, in points. This space is added BELOW each line in the para when TEDIT.LINELEADING.BELOW, otherwise above, which is how it is documented."
|
||||
) FMTBASETOBASE (* ;
|
||||
"The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING")
|
||||
TABSPEC (* ; "The list of tabs for this paragraph, including CAR for a default tab width") QUAD (* ;
|
||||
"How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ;
|
||||
"The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING")
|
||||
NIL (* ; "Was TABSPEC: The list of tabs for this paragraph, including CAR for a default tab width")
|
||||
QUAD (* ; "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ;
|
||||
"The STYLE that controls this paragraph's appearance") FMTCHARSTYLES (* ;
|
||||
"The characterstyles that control the appearance of characters in this para (maybe? may be part of the fmtstyle.)"
|
||||
) FMTUSERINFO (* ; "Space for a PLIST of user info") FMTSPECIALX (* ;
|
||||
@@ -492,17 +547,36 @@ TABSPEC (* ; "The list of tabs for this paragraph, including CAR for a default t
|
||||
) (FMTHARDCOPY FLAG) (* ; "T if this paragraph is to be displayed in hardcopy-format.") FMTREVISED (*
|
||||
;
|
||||
"T (or perhaps a revision level or revision-mark spec??) if this paragraph is to be marked as changed on output."
|
||||
) FMTHARDCOPYSCALE) (* ;
|
||||
"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T)"
|
||||
) (INIT (DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0
|
||||
LINELEAD _ 0 TABSPEC _ (CONS DEFAULTTAB NIL))
|
||||
) FMTHARDCOPYSCALE (* ;
|
||||
"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T"
|
||||
) FMTDEFAULTTAB (* ; "Default tab in points)") FMTTABS) (* ; "List of tabs (in points)") (INIT (
|
||||
DEFPRINT (QUOTE PARALOOKS) (FUNCTION \TEDIT.PARALOOKS.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0
|
||||
LINELEAD _ 0)
|
||||
(DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))
|
||||
(DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))
|
||||
(DEFPRINT (QUOTE PARALOOKS) (FUNCTION \TEDIT.PARALOOKS.DEFPRINT))
|
||||
(PUTPROPS \WORDSETA DMACRO (OPENLAMBDA (A J V) (CHECK (AND (ARRAYP A) (ZEROP (fetch (ARRAYP ORIG) of A
|
||||
)) (EQ \ST.POS16 (fetch (ARRAYP TYP) of A)))) (CHECK (IGREATERP (fetch (ARRAYP LENGTH) of A) J)) (
|
||||
\PUTBASE (fetch (ARRAYP BASE) of A) (IPLUS (fetch (ARRAYP OFFST) of A) J) V)))
|
||||
(PUTPROPS ONOFF MACRO (OPENLAMBDA (VAL) (COND (VAL (QUOTE ON)) (T (QUOTE OFF)))))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:29"))
|
||||
(PUTPROPS GETCLOOKS MACRO ((CL FIELD) (fetch (CHARLOOKS FIELD) of CL)))
|
||||
(PUTPROPS SETCLOOKS MACRO ((CL FIELD NEWVALUE) (replace (CHARLOOKS FIELD) of CL with NEWVALUE)))
|
||||
(PUTPROPS FGETCLOOKS MACRO ((CL FIELD) (ffetch (CHARLOOKS FIELD) of CL)))
|
||||
(PUTPROPS FSETCLOOKS MACRO ((CL FIELD NEWVALUE) (freplace (CHARLOOKS FIELD) of CL with NEWVALUE)))
|
||||
(PUTPROPS CHARLOOKS! MACRO ((CL) (\DTEST CL (QUOTE CHARLOOKS))))
|
||||
(PUTPROPS GETPLOOKS MACRO ((PLOOKS FIELD) (fetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS SETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (replace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)
|
||||
))
|
||||
(PUTPROPS FGETPLOOKS MACRO ((PLOOKS FIELD) (ffetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with
|
||||
NEWVALUE)))
|
||||
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
|
||||
(PUTPROPS FSETPARA MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)
|
||||
))
|
||||
(PUTPROPS FGETPARA MACRO ((PLOOKS FIELD) (ffetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS GETPARA MACRO ((PLOOKS FIELD) (fetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS SETPARA MACRO ((PLOOKS FIELD NEWVALUE) (replace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:00:37"))
|
||||
(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "12-Feb-2025 12:18:37"))
|
||||
(DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
|
||||
is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
|
||||
means (Make the caret visible at the next call to \EDIT.FLIPCARET.)) TCUP (* TCUP = T => The caret is
|
||||
@@ -513,64 +587,81 @@ the caret up during screen updates) TCCARETX (* X position in the window that th
|
||||
TCCARETY (* Y position in the window where the caret appears) TCCARET (* A lisp CARET to be flashed (
|
||||
eventually))) TCNOWTIME _ (CREATECELL \FIXP) TCTHENTIME _ (CREATECELL \FIXP) TCCURSORBM _ BXCARET
|
||||
TCCARETRATE _ \CARETRATE TCUP _ T TCCARET _ (\CARET.CREATE BXCARET))
|
||||
(ACCESSFNS TEXTWINDOW ((NEXTPANE (GETWINDOWPROP DATUM (QUOTE TEDIT-NEXT-PANE-DOWN)) (PUTWINDOWPROP
|
||||
DATUM (QUOTE TEDIT-NEXT-PANE-DOWN) NEWVALUE)) (WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) (
|
||||
PUTWINDOWPROP DATUM (QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (
|
||||
TEXTWINDOW WTEXTSTREAM) of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW
|
||||
WTEXTSTREAM) of DATUM))) (WLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM (QUOTE LINES
|
||||
) NEWVALUE)) (CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (
|
||||
QUOTE TEDIT.CURSORREGION) NEWVALUE)) (PLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM
|
||||
(QUOTE LINES) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) (PUTWINDOWPROP
|
||||
DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (WITHINSCREEN (GETWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN))
|
||||
(LET ((NV NEWVALUE)) (PUTWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN) NV) NV))))
|
||||
(DATATYPE PANE ((XPWINDOW FULLXPOINTER) PLINES PCARET HOLDDUMMYFIRSTLINE NEXTPANE (PREVPANE XPOINTER))
|
||||
(ACCESSFNS (PWINDOW (PROGN DATUM))))
|
||||
(PUTPROPS FGETPANE MACRO ((P FIELD) (ffetch (PANE FIELD) of P)))
|
||||
(PUTPROPS GETPANE MACRO ((P FIELD) (fetch (PANE FIELD) of P)))
|
||||
(PUTPROPS SETPANE MACRO ((P FIELD NEWVALUE) (replace (PANE FIELD) of P with NEWVALUE)))
|
||||
(PUTPROPS FSETPANE MACRO ((P FIELD NEWVALUE) (freplace (PANE FIELD) of P with NEWVALUE)))
|
||||
(I.S.OPR (QUOTE inpanes) NIL (QUOTE (inside (fetch (TEXTOBJ \WINDOW) of BODY))))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:16:27"))
|
||||
(TYPERECORD MB.3STATE ((* ;; "Describes a 3-state menu button.") MBLABEL (* ;
|
||||
"Label for the button on the screen") MBFONT (* ; "Font the label text should appear in")
|
||||
MBCHANGESTATEFN (* ; "Function to call when the button's state changes") MBINITSTATE (* ;
|
||||
"Button's initial state.")) MBFONT _ (FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
|
||||
(TYPERECORD MB.BUTTON (MBLABEL MBBUTTONEVENTFN MBFONT) MBBUTTONEVENTFN _ (QUOTE MB.DEFAULTBUTTON.FN)
|
||||
MBFONT _ (FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
|
||||
(TYPERECORD MB.INSERT (MBINITENTRY))
|
||||
(TYPERECORD MB.MARGINBAR (ignoredfield))
|
||||
(TYPERECORD MB.NWAY (MBBUTTONS MBFONT MBCHANGESTATEFN MBINITSTATE MBMAXITEMSPERLINE) MBFONT _ (
|
||||
FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
|
||||
(TYPERECORD MB.TEXT (MBSTRING MBFONT))
|
||||
(TYPERECORD MB.TOGGLE (MBTEXT MBFONT MBCHANGESTATEFN MBINITSTATE) MBFONT _ (FONTCREATE (QUOTE
|
||||
HELVETICA) 8 (QUOTE BOLD)))
|
||||
(RECORD MBUTTON NIL (TYPE? (AND (IMAGEOBJP DATUM) (OR (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (
|
||||
QUOTE MB.DISPLAY)) (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.THREESTATE.DISPLAY)) (EQ (
|
||||
IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE \TEXTMENU.TOGGLE.DISPLAY))))))
|
||||
(RECORD NWAYBUTTON NIL (TYPE? (AND (IMAGEOBJP DATUM) (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE
|
||||
MB.NB.DISPLAYFN)))))
|
||||
(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (TYPE? (AND (IMAGEOBJP DATUM) (EQ (
|
||||
IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.MARGINBAR.DISPLAYFN)))))
|
||||
(RECORD TAB (TABX . TABKIND))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:06"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 12:06:12"))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "15-Mar-2024 14:07:55"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:37"))
|
||||
(ACCESSFNS TEXTWINDOW ((WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) (PUTWINDOWPROP DATUM (
|
||||
QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM)
|
||||
of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) of DATUM))) (
|
||||
CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (QUOTE
|
||||
TEDIT.CURSORREGION) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) (
|
||||
PUTWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (PANEPROPS (GETWINDOWPROP DATUM (QUOTE PANEPROPS)
|
||||
) (PUTWINDOWPROP DATUM (QUOTE PANEPROPS) NEWVALUE))) (TYPE? (AND (WINDOWP DATUM) (TYPENAMEP (fetch (
|
||||
TEXTWINDOW PTEXTOBJ) of DATUM) (QUOTE TEXTOBJ)))))
|
||||
(DATATYPE PANEPROPS ((PWINDOW FULLXPOINTER) (* ; "The window with these PANEPROPS") PREFIXLINE (* ;
|
||||
"Dummy line that covers all the characters above the first visible line") SUFFIXLINE (* ;
|
||||
"Dummy line that covers all the characters below the last visible line") PCARET NEXTPANE (PREVPANE
|
||||
XPOINTER) PANEHEIGHT PANEWIDTH PANELEFT PANERIGHT PANEBOTTOM PANETOP PANEREGION))
|
||||
(PUTPROPS FGETPANEPROP MACRO ((P FIELD) (ffetch (PANEPROPS FIELD) of P)))
|
||||
(PUTPROPS GETPANEPROP MACRO ((P FIELD) (fetch (PANEPROPS FIELD) of P)))
|
||||
(PUTPROPS SETPANEPROP MACRO ((P FIELD NEWVALUE) (replace (PANEPROPS FIELD) of P with NEWVALUE)))
|
||||
(PUTPROPS FSETPANEPROP MACRO ((P FIELD NEWVALUE) (freplace (PANEPROPS FIELD) of P with NEWVALUE)))
|
||||
(PUTPROPS PANEPROPS MACRO ((PANE) (fetch (TEXTWINDOW PANEPROPS) of PANE)))
|
||||
(PUTPROPS PANEPREFIX MACRO ((PANE) (LINEDESCRIPTOR! (GETPANEPROP (PANEPROPS PANE) PREFIXLINE))))
|
||||
(PUTPROPS PANESUFFIX MACRO ((PANE) (GETPANEPROP (PANEPROPS PANE) SUFFIXLINE)))
|
||||
(PUTPROPS PANETOPLINE MACRO ((PANE) (FGETLD (PANEPREFIX PANE) NEXTLINE)))
|
||||
(PUTPROPS PANECARET MACRO ((PANE) (\DTEST (GETPANEPROP (PANEPROPS PANE) PCARET) (QUOTE TEDITCARET))))
|
||||
(PUTPROPS PANESTREAM MACRO ((PANE) (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))
|
||||
(PUTPROPS PANETOBJ MACRO ((PANE) (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW
|
||||
WTEXTSTREAM) of PANE)))))
|
||||
(PUTPROPS PANEBOTTOMLINE MACRO ((PANE) (GETLD (PANESUFFIX PANE) PREVLINE)))
|
||||
(PUTPROPS \TEDIT.PREFIX.LCHARLIM MACRO ((PANE CHNO) (FSETLD (PANEPREFIX PANE) LCHARLAST CHNO)))
|
||||
(PUTPROPS PANETOP MACRO ((PANE PREG) (fetch (REGION TOP) of (OR PREG (DSPCLIPPINGREGION NIL PANE)))))
|
||||
(PUTPROPS PANEWIDTH MACRO ((PANE PREG) (fetch (REGION WIDTH) of (OR PREG (DSPCLIPPINGREGION NIL PANE))
|
||||
)))
|
||||
(PUTPROPS PANELEFT MACRO ((PANE PREG) (fetch (REGION LEFT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))))
|
||||
)
|
||||
(PUTPROPS PANERIGHT MACRO ((PANE PREG) (fetch (REGION RIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))
|
||||
)))
|
||||
(PUTPROPS PANEBOTTOM MACRO ((PANE PREG) (fetch (REGION BOTTOM) of (OR PREG (DSPCLIPPINGREGION NIL PANE
|
||||
)))))
|
||||
(PUTPROPS PANEHEIGHT MACRO ((PANE PREG) (fetch (REGION HEIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE
|
||||
)))))
|
||||
(PUTPROPS PANEREGION MACRO ((PANE PREG) (OR PREG (DSPCLIPPINGREGION NIL PANE))))
|
||||
(I.S.OPR (QUOTE inpanes) NIL (QUOTE (bind $$BODY _ BODY declare (LOCALVARS $$BODY) first (SETQ I.V. (
|
||||
OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BODY) (GO $$OUT))) by (OR
|
||||
(GETPANEPROP (PANEPROPS I.V.) NEXTPANE) (GO $$OUT)))))
|
||||
(I.S.OPR (QUOTE backpanes) NIL (QUOTE (first (SETQ I.V. (OR (find P inpanes BODY suchthat (NULL (
|
||||
GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO
|
||||
$$OUT)))))
|
||||
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "18-Feb-2025 23:57:08"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "16-Feb-2025 15:02:06"))
|
||||
(RPAQQ PTSPERPICA 12)
|
||||
(RPAQQ PTSPERINCH 72)
|
||||
(RPAQQ PICASPERINCH 6)
|
||||
(RPAQQ MICASPERINCH 2540)
|
||||
(RPAQ PTSPERCM (FQUOTIENT PTSPERINCH 2.54))
|
||||
(RPAQ PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH))
|
||||
(RPAQ MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH))
|
||||
(CONSTANTS (PTSPERPICA 12) (PTSPERINCH 72) (PICASPERINCH 6) (MICASPERINCH 2540) (PTSPERCM (FQUOTIENT
|
||||
PTSPERINCH 2.54)) (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) (MICASPERPOINT (FQUOTIENT
|
||||
MICASPERINCH PTSPERINCH)))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2025 23:19:34"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "17-Feb-2025 12:25:36"))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "17-Feb-2025 09:12:22"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2025 23:42:18"))
|
||||
(DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (*
|
||||
; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?")
|
||||
THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ;
|
||||
"First piece involved") THOLDINFO (* ; "Old info, for undo") NIL (* ;
|
||||
"Was THAUXINFO: Auxiliary info about the event, primarily for redo") THDELETEDPIECES) (ACCESSFNS
|
||||
TEDITHISTORYEVENT ((THCHLIM (AND (fetch (TEDITHISTORYEVENT THCH#) of DATUM) (IPLUS (fetch (
|
||||
TEDITHISTORYEVENT THCH#) of DATUM) (fetch (TEDITHISTORYEVENT THLEN) of DATUM)))))) (INIT (DEFPRINT (
|
||||
QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QUOTE LEFT))
|
||||
TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch (TEDITHISTORYEVENT THCH#) of DATUM) 0) (OR (fetch (
|
||||
TEDITHISTORYEVENT THLEN) of DATUM) 0))))) (INIT (DEFPRINT (QUOTE TEDITHISTORYEVENT) (FUNCTION
|
||||
\TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QUOTE LEFT))
|
||||
(DEFPRINT (QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT))
|
||||
(PUTPROPS \TEDIT.LASTEVENT MACRO ((TOBJ) (CAR (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
|
||||
(PUTPROPS \TEDIT.POPEVENT MACRO ((TOBJ) (pop (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
|
||||
(PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
|
||||
(PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) (replace (TEDITHISTORYEVENT FIELD) of EVENT with
|
||||
NEWVALUE)))
|
||||
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:20"))
|
||||
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE " 6-Feb-2025 15:42:44"))
|
||||
(RECORD PAGEFORMATTINGSTATE ((* ;; "Contains the state for a TEdit page-formatting job.") PAGE# (* ;
|
||||
"The current page number. Counted from 1") FIRSTPAGE (* ;;
|
||||
"T if the current page is the 'first page' . Is set initially, and can be set again by the user at will. Gets reset after each page image is printed."
|
||||
@@ -601,9 +692,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
|
||||
(PUTPROPS GETPFS MACRO ((FS FIELD) (fetch (PAGEFORMATTINGSTATE FIELD) of FS)))
|
||||
(PUTPROPS SETPFS MACRO ((FS FIELD NEWVALUE) (replace (PAGEFORMATTINGSTATE FIELD) of FS with NEWVALUE))
|
||||
)
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:27:18"))
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2025 23:42:12"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "31-Oct-2024 17:53:21"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:18:40"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Mar-2024 21:42:47" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;259 131082
|
||||
(FILECREATED "20-Jan-2025 11:00:54" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;263 131893
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS FIX-DIRECTORY-DATES)
|
||||
:CHANGES-TO (VARS COMPAREDIRECTORIESCOMS)
|
||||
|
||||
:PREVIOUS-DATE "29-Sep-2023 17:25:57" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;257)
|
||||
:PREVIOUS-DATE "23-Dec-2024 23:54:13" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;262)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||
@@ -15,6 +15,8 @@
|
||||
[
|
||||
(* ;; "Compare the contents of two directories.")
|
||||
|
||||
(FILES (SYSLOAD)
|
||||
PDFSTREAM)
|
||||
(FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.CANDIDATES
|
||||
CDENTRIES.SELECT COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE
|
||||
CD.UPDATEWIDTHS)
|
||||
@@ -59,11 +61,15 @@
|
||||
|
||||
(* ;; "Compare the contents of two directories.")
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
PDFSTREAM)
|
||||
(DEFINEQ
|
||||
|
||||
(COMPAREDIRECTORIES
|
||||
[LAMBDA (DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS
|
||||
FIXDIRECTORYDATES) (* ; "Edited 29-Sep-2023 17:25 by rmk")
|
||||
FIXDIRECTORYDATES SHORTDIRNAMES) (* ; "Edited 1-May-2024 14:52 by rmk")
|
||||
(* ; "Edited 29-Sep-2023 17:25 by rmk")
|
||||
(* ; "Edited 5-Apr-2023 10:12 by rmk")
|
||||
(* ; "Edited 29-Mar-2022 11:50 by rmk")
|
||||
(* ; "Edited 23-Feb-2022 21:10 by rmk")
|
||||
@@ -116,7 +122,11 @@
|
||||
(PRINTOUT T "Fixing directory dates" T)
|
||||
(FIX-DIRECTORY-DATES DIR1)
|
||||
(FIX-DIRECTORY-DATES DIR2))
|
||||
(CDPRINT.HEADER DIR1 DIR2 SELECT DATE T)
|
||||
(CDPRINT.HEADER (OR (CAR SHORTDIRNAMES)
|
||||
DIR1)
|
||||
(OR (CADR SHORTDIRNAMES)
|
||||
DIR2)
|
||||
SELECT DATE T)
|
||||
(PRINTOUT T " ... ")
|
||||
(SETQ INFOS1 (COMPAREDIRECTORIES.INFOS DIR1 INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH1
|
||||
USEDIRECTORYDATE (MEMB 'AUTHOR SELECT)))
|
||||
@@ -1950,6 +1960,8 @@
|
||||
(CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
||||
|
||||
(* ;; "Edited 23-Dec-2024 23:53 by rmk")
|
||||
|
||||
(* ;; "Edited 21-May-2022 21:59 by rmk")
|
||||
|
||||
(* ;; "Edited 27-Feb-2022 12:47 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
|
||||
@@ -1963,52 +1975,64 @@
|
||||
(* ; "Close the previous ones")
|
||||
(CLOSEWITH.DOIT WINDOW))
|
||||
(LET (CHILDREN)
|
||||
(SETQ CHILDREN (SELECTQ MENUITEM
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE
|
||||
(WINDOWPROP WINDOW 'REGION))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "Only one file" T)))
|
||||
(See% left (IF FILE1
|
||||
THEN (TEDIT-SEE FILE1
|
||||
(RELCREATEREGION
|
||||
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
T)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL1))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% right (IF FILE2
|
||||
THEN (TEDIT-SEE FILE2
|
||||
(RELCREATEREGION
|
||||
700 700 'LEFT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL2))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
((See See% both)
|
||||
(EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL)))
|
||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
|
||||
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
|
||||
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
|
||||
(|Delete ALL <-|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
|
||||
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
|
||||
(|Delete ALL ->|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
|
||||
(SHOULDNT)))
|
||||
(SETQ CHILDREN
|
||||
(SELECTQ MENUITEM
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP
|
||||
WINDOW
|
||||
'REGION))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "Only one file" T)))
|
||||
(See% left (IF FILE1
|
||||
THEN (if (PDFFILEP FILE1)
|
||||
then (SEE-PDF FILE1)
|
||||
else (TEDIT-SEE FILE1 (RELCREATEREGION
|
||||
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
T)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL1)))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% right (IF FILE2
|
||||
THEN (if (PDFFILEP FILE2)
|
||||
then (SEE-PDF FILE2)
|
||||
else (TEDIT-SEE FILE2 (RELCREATEREGION
|
||||
700 700 'LEFT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
NIL)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL2)))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
((See See% both)
|
||||
(IF (PDFFILEP FILE1)
|
||||
then (SEE-PDF FILE1)
|
||||
(CL:WHEN (PDFFILEP FILE2)
|
||||
(SEE-PDF FILE2))
|
||||
elseif (PDFFILEP FILE2)
|
||||
then (SEE-PDF FILE2)
|
||||
else (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
NIL))))
|
||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
|
||||
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
|
||||
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
|
||||
(|Delete ALL <-|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
|
||||
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
|
||||
(|Delete ALL ->|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
|
||||
(SHOULDNT)))
|
||||
(CLOSEWITH CHILDREN WINDOW)
|
||||
(MOVEWITH CHILDREN WINDOW])
|
||||
|
||||
@@ -2197,25 +2221,25 @@
|
||||
|
||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2527 22645 (COMPAREDIRECTORIES 2537 . 7627) (COMPAREDIRECTORIES.INFOS 7629 . 10587) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10589 . 13974) (CDENTRIES.SELECT 13976 . 18751) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18753 . 19879) (MATCHNAME 19881 . 20561) (CD.INSURECDVALUE 20563 . 22177
|
||||
) (CD.UPDATEWIDTHS 22179 . 22643)) (22646 33268 (CDFILES 22656 . 28670) (CDFILES.MATCH 28672 . 30297)
|
||||
(CDFILES.PATS 30299 . 33266)) (33269 51090 (CDPRINT 33279 . 35796) (CDPRINT.HEADER 35798 . 36695) (
|
||||
CDPRINT.LINE 36697 . 39929) (CDPRINT.MAXWIDTHS 39931 . 44046) (CDPRINT.COLHEADERS 44048 . 45333) (
|
||||
CDPRINT.COLUMNS 45335 . 50455) (CDTEDIT 50457 . 51088)) (51091 60212 (CDMAP 51101 . 52533) (CDENTRY
|
||||
52535 . 52844) (CDSUBSET 52846 . 54285) (CDMERGE 54287 . 58271) (CDMERGE.COMMON 58273 . 59588) (
|
||||
CD.SORT 59590 . 60210)) (60213 67751 (BINCOMP 60223 . 64512) (EOLTYPE 64514 . 67076) (EOLTYPE.SHOW
|
||||
67078 . 67749)) (68279 80806 (FIND-UNCOMPILED-FILES 68289 . 71932) (FIND-UNSOURCED-FILES 71934 . 74318
|
||||
) (FIND-SOURCE-FILES 74320 . 76058) (FIND-COMPILED-FILES 76060 . 77937) (FIND-UNLOADED-FILES 77939 .
|
||||
78792) (FIND-LOADED-FILES 78794 . 79222) (FIND-MULTICOMPILED-FILES 79224 . 80804)) (80807 89238 (
|
||||
CREATED-AS 80817 . 85614) (SOURCE-FOR-COMPILED-P 85616 . 88543) (COMPILE-SOURCE-DATE-DIFF 88545 .
|
||||
89236)) (89239 100002 (FIX-DIRECTORY-DATES 89249 . 92699) (FIX-EQUIV-DATES 92701 . 94226) (
|
||||
COPY-COMPARED-FILES 94228 . 96049) (COPY-MISSING-FILES 96051 . 98208) (COMPILED-ON-SAME-SOURCE 98210
|
||||
. 100000)) (100196 108034 (CDBROWSER 100206 . 104133) (CDBROWSER.STRINGS 104135 . 108032)) (108196
|
||||
109932 (CD.TABLEITEM 108206 . 108426) (CD.TABLEITEM.PRINTFN 108428 . 108627) (CD.TABLEITEM.COPYFN
|
||||
108629 . 109687) (CDTABLEBROWSER.HEADING.REPAINTFN 109689 . 109930)) (109933 130588 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 109943 . 110411) (CD.COMMANDSELECTEDFN 110413 . 115514) (CD-MENUFN
|
||||
115516 . 119827) (CD-COMPARE-FILES 119829 . 123181) (CDBROWSER-COPY 123183 . 126852) (
|
||||
CDBROWSER-DELETE-FILE 126854 . 130067) (CD-SWAPDIRS 130069 . 130586)))))
|
||||
(FILEMAP (NIL (2622 22985 (COMPAREDIRECTORIES 2632 . 7967) (COMPAREDIRECTORIES.INFOS 7969 . 10927) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10929 . 14314) (CDENTRIES.SELECT 14316 . 19091) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 19093 . 20219) (MATCHNAME 20221 . 20901) (CD.INSURECDVALUE 20903 . 22517
|
||||
) (CD.UPDATEWIDTHS 22519 . 22983)) (22986 33608 (CDFILES 22996 . 29010) (CDFILES.MATCH 29012 . 30637)
|
||||
(CDFILES.PATS 30639 . 33606)) (33609 51430 (CDPRINT 33619 . 36136) (CDPRINT.HEADER 36138 . 37035) (
|
||||
CDPRINT.LINE 37037 . 40269) (CDPRINT.MAXWIDTHS 40271 . 44386) (CDPRINT.COLHEADERS 44388 . 45673) (
|
||||
CDPRINT.COLUMNS 45675 . 50795) (CDTEDIT 50797 . 51428)) (51431 60552 (CDMAP 51441 . 52873) (CDENTRY
|
||||
52875 . 53184) (CDSUBSET 53186 . 54625) (CDMERGE 54627 . 58611) (CDMERGE.COMMON 58613 . 59928) (
|
||||
CD.SORT 59930 . 60550)) (60553 68091 (BINCOMP 60563 . 64852) (EOLTYPE 64854 . 67416) (EOLTYPE.SHOW
|
||||
67418 . 68089)) (68619 81146 (FIND-UNCOMPILED-FILES 68629 . 72272) (FIND-UNSOURCED-FILES 72274 . 74658
|
||||
) (FIND-SOURCE-FILES 74660 . 76398) (FIND-COMPILED-FILES 76400 . 78277) (FIND-UNLOADED-FILES 78279 .
|
||||
79132) (FIND-LOADED-FILES 79134 . 79562) (FIND-MULTICOMPILED-FILES 79564 . 81144)) (81147 89578 (
|
||||
CREATED-AS 81157 . 85954) (SOURCE-FOR-COMPILED-P 85956 . 88883) (COMPILE-SOURCE-DATE-DIFF 88885 .
|
||||
89576)) (89579 100342 (FIX-DIRECTORY-DATES 89589 . 93039) (FIX-EQUIV-DATES 93041 . 94566) (
|
||||
COPY-COMPARED-FILES 94568 . 96389) (COPY-MISSING-FILES 96391 . 98548) (COMPILED-ON-SAME-SOURCE 98550
|
||||
. 100340)) (100536 108374 (CDBROWSER 100546 . 104473) (CDBROWSER.STRINGS 104475 . 108372)) (108536
|
||||
110272 (CD.TABLEITEM 108546 . 108766) (CD.TABLEITEM.PRINTFN 108768 . 108967) (CD.TABLEITEM.COPYFN
|
||||
108969 . 110027) (CDTABLEBROWSER.HEADING.REPAINTFN 110029 . 110270)) (110273 131399 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 110283 . 110751) (CD.COMMANDSELECTEDFN 110753 . 115854) (CD-MENUFN
|
||||
115856 . 120638) (CD-COMPARE-FILES 120640 . 123992) (CDBROWSER-COPY 123994 . 127663) (
|
||||
CDBROWSER-DELETE-FILE 127665 . 130878) (CD-SWAPDIRS 130880 . 131397)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Feb-2024 16:08:54" {WMEDLEY}<lispusers>COMPARESOURCES.;137 40939
|
||||
(FILECREATED "13-Jun-2024 11:46:26" {WMEDLEY}<lispusers>COMPARESOURCES.;138 40991
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS COMPARESOURCESCOMS)
|
||||
(FNS COMPARESOURCES CSBROWSER \CS.IGNOREFORMS)
|
||||
:CHANGES-TO (FNS \CS.COMPARE.MASTERS)
|
||||
|
||||
:PREVIOUS-DATE "17-Jun-2023 15:22:40" {WMEDLEY}<lispusers>COMPARESOURCES.;131)
|
||||
:PREVIOUS-DATE " 7-Feb-2024 16:08:54" {WMEDLEY}<lispusers>COMPARESOURCES.;137)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPARESOURCESCOMS)
|
||||
@@ -142,7 +141,8 @@
|
||||
'SAME])
|
||||
|
||||
(\CS.COMPARE.MASTERS
|
||||
[LAMBDA (BODY1 BODY2 DW?) (* ; "Edited 17-Jun-2023 15:19 by rmk")
|
||||
[LAMBDA (BODY1 BODY2 DW?) (* ; "Edited 13-Jun-2024 11:46 by rmk")
|
||||
(* ; "Edited 17-Jun-2023 15:19 by rmk")
|
||||
(* ; "Edited 25-Feb-2022 18:02 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 22:00 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 21:05 by rmk")
|
||||
@@ -155,8 +155,8 @@
|
||||
"We don't care about editdate comments")
|
||||
(SETQ BODY2 (CL:REMOVE-IF (FUNCTION EDITDATE?)
|
||||
BODY2))
|
||||
(SETQ BODY1 (\CS.FIXFNS BODY1))
|
||||
(SETQ BODY2 (\CS.FIXFNS BODY2))
|
||||
(SETQ BODY1 (\CS.FIXFNS BODY1 DW?))
|
||||
(SETQ BODY2 (\CS.FIXFNS BODY2 DW?))
|
||||
(CL:WHEN (AND (SETQ THING1 (ASSOC 'DEFINE-FILE-INFO BODY1))
|
||||
(SETQ THING2 (ASSOC 'DEFINE-FILE-INFO BODY2))
|
||||
(\CS.COMPARE.DEFINE-FILE-INFO THING1 THING2))
|
||||
@@ -703,17 +703,17 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1748 26130 (COMPARESOURCES 1758 . 8406) (\CS.COMPARE.MASTERS 8408 . 15929) (
|
||||
\CS.COMPARE.TYPES 15931 . 19197) (\CS.EXAMINE 19199 . 22377) (\CS.FIXFNS 22379 . 23881) (
|
||||
\CS.SORT.DECLARES 23883 . 24226) (\CS.SORT.DECLARE1 24228 . 25648) (\CS.FILTER.GARBAGE 25650 . 26128))
|
||||
(26131 31474 (\CS.ISFNFORM 26141 . 26409) (\CS.COMPARE.FNS 26411 . 26653) (\CS.FNSID 26655 . 26799) (
|
||||
\CS.ISVARFORM 26801 . 26906) (\CS.COMPARE.VARS 26908 . 27570) (\CS.ISMACROFORM 27572 . 27710) (
|
||||
\CS.ISRECFORM 27712 . 28040) (\CS.REC.NAME 28042 . 28361) (\CS.ISCOURIERFORM 28363 . 28463) (
|
||||
\CS.ISTEMPLATEFORM 28465 . 28563) (\CS.COMPARE.TEMPLATES 28565 . 28930) (\CS.ISPROPFORM 28932 . 29087)
|
||||
(\CS.PROP.NAME 29089 . 29234) (\CS.COMPARE.PROPS 29236 . 29393) (\CS.ISADDVARFORM 29395 . 29488) (
|
||||
\CS.COMPARE.ADDVARS 29490 . 29655) (\CS.ISFPKGCOMFORM 29657 . 29864) (\CS.COMPARE.FPKGCOMS 29866 .
|
||||
30073) (\CS.COMPARE.DEFINE-FILE-INFO 30075 . 30665) (\CS.IGNOREFORMS 30667 . 31472)) (31475 37539 (
|
||||
CSOBJ.CREATE 31485 . 31898) (CSOBJ.DISPLAYFN 31900 . 32653) (CSOBJ.IMAGEBOXFN 32655 . 34816) (
|
||||
CSOBJ.BUTTONEVENTINFN 34818 . 37289) (CSOBJ.COPYBUTTONEVENTINFN 37291 . 37537)) (38420 40605 (
|
||||
CSBROWSER 38430 . 40603)))))
|
||||
(FILEMAP (NIL (1683 26182 (COMPARESOURCES 1693 . 8341) (\CS.COMPARE.MASTERS 8343 . 15981) (
|
||||
\CS.COMPARE.TYPES 15983 . 19249) (\CS.EXAMINE 19251 . 22429) (\CS.FIXFNS 22431 . 23933) (
|
||||
\CS.SORT.DECLARES 23935 . 24278) (\CS.SORT.DECLARE1 24280 . 25700) (\CS.FILTER.GARBAGE 25702 . 26180))
|
||||
(26183 31526 (\CS.ISFNFORM 26193 . 26461) (\CS.COMPARE.FNS 26463 . 26705) (\CS.FNSID 26707 . 26851) (
|
||||
\CS.ISVARFORM 26853 . 26958) (\CS.COMPARE.VARS 26960 . 27622) (\CS.ISMACROFORM 27624 . 27762) (
|
||||
\CS.ISRECFORM 27764 . 28092) (\CS.REC.NAME 28094 . 28413) (\CS.ISCOURIERFORM 28415 . 28515) (
|
||||
\CS.ISTEMPLATEFORM 28517 . 28615) (\CS.COMPARE.TEMPLATES 28617 . 28982) (\CS.ISPROPFORM 28984 . 29139)
|
||||
(\CS.PROP.NAME 29141 . 29286) (\CS.COMPARE.PROPS 29288 . 29445) (\CS.ISADDVARFORM 29447 . 29540) (
|
||||
\CS.COMPARE.ADDVARS 29542 . 29707) (\CS.ISFPKGCOMFORM 29709 . 29916) (\CS.COMPARE.FPKGCOMS 29918 .
|
||||
30125) (\CS.COMPARE.DEFINE-FILE-INFO 30127 . 30717) (\CS.IGNOREFORMS 30719 . 31524)) (31527 37591 (
|
||||
CSOBJ.CREATE 31537 . 31950) (CSOBJ.DISPLAYFN 31952 . 32705) (CSOBJ.IMAGEBOXFN 32707 . 34868) (
|
||||
CSOBJ.BUTTONEVENTINFN 34870 . 37341) (CSOBJ.COPYBUTTONEVENTINFN 37343 . 37589)) (38472 40657 (
|
||||
CSBROWSER 38482 . 40655)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13 65523
|
||||
(FILECREATED "25-May-2024 13:19:49" {WMEDLEY}<lispusers>DINFO.;14 65819
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM)
|
||||
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM DINFO.UPDATE.TEXT.DISPLAY)
|
||||
|
||||
:PREVIOUS-DATE "10-Mar-2024 15:38:36" {WMEDLEY}<lispusers>DINFO.;12)
|
||||
:PREVIOUS-DATE "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT DINFOCOMS)
|
||||
@@ -988,17 +988,18 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DINFO.UPDATE.TEXT.DISPLAY
|
||||
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 3-Feb-2022 11:50 by rmk")
|
||||
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 25-May-2024 13:16 by rmk")
|
||||
(* drc%: "25-Jan-86 18:18")
|
||||
(* drc%: "25-Jan-86 18:18")
|
||||
(LET ((WINDOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(FILENAME (DINFO.GET.FILENAME GRAPH NODE))
|
||||
(FROM (fetch (DINFONODE FROMBYTE) of NODE))
|
||||
(TO (fetch (DINFONODE TOBYTE) of NODE))
|
||||
(PROPS (APPEND (LIST 'READONLY T 'NOTITLE T 'TITLEMENUFN 'DINFO.TITLEMENUFN)
|
||||
(PROPS (APPEND (LIST 'READONLY 'QUIET 'NOTITLE T 'TITLEMENUFN (FUNCTION DINFO.TITLEMENUFN))
|
||||
(fetch (DINFOGRAPH TEXTPROPS) of GRAPH)))
|
||||
(OLD.TEXTSTREAM (WINDOWPROP (fetch (DINFOGRAPH WINDOW) of GRAPH)
|
||||
'TEXTSTREAM))
|
||||
TEXTSTREAM FULLFILENAME) (* Default directory and host.)
|
||||
TEXTSTREAM FULLFILENAME) (* ; "Default directory and host.")
|
||||
(if (OR OFF? (NULL FILENAME))
|
||||
then (OPENTEXTSTREAM (CL:UNLESS OFF? (OPENSTRINGSTREAM "This node has no text"))
|
||||
WINDOW NIL NIL PROPS)
|
||||
@@ -1036,7 +1037,8 @@
|
||||
(PROMPTPRINT "DInfo is busy"])
|
||||
|
||||
(DINFO.OPENTEXTSTREAM
|
||||
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 10-Apr-2024 23:46 by rmk")
|
||||
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 25-May-2024 13:17 by rmk")
|
||||
(* ; "Edited 10-Apr-2024 23:46 by rmk")
|
||||
(* ; "Edited 10-Mar-2024 15:37 by rmk")
|
||||
(* drc%: "25-Jan-86 18:24")
|
||||
(RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW WINDOW))
|
||||
@@ -1053,7 +1055,8 @@
|
||||
(CLEARW T)
|
||||
(CLEARW WINDOW)
|
||||
[RESETSAVE NIL `(AND RESETSTATE (WINDOWPROP ,WINDOW 'LAST.TEXT NIL]
|
||||
(PROG1 (OPENTEXTSTREAM FILE WINDOW FROM TO PROPS)
|
||||
(PROG1 (TEDIT (OPENTEXTSTREAM FILE NIL FROM TO PROPS)
|
||||
WINDOW)
|
||||
(replace (DINFOGRAPH LAST.TEXT) of (DINFOGRAPH WINDOW) with THIS.TEXT))])
|
||||
|
||||
(DINFO.SHOWSEL
|
||||
@@ -1110,21 +1113,21 @@
|
||||
(SETTEMPLATE 'DINFOGRAPHPROP 'MACRO)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4556 6015 (DINFOGRAPHPROP 4556 . 6015)) (7269 24407 (DINFO 7279 . 8893) (DINFO.UPDATE
|
||||
8895 . 11759) (DINFOGRAPH 11761 . 12179) (DINFO.SPECIAL.UPDATE 12181 . 13879) (DINFO.READ.GRAPH 13881
|
||||
. 15736) (DINFO.WRITE.GRAPH 15738 . 16828) (DINFO.SELECT.GRAPH 16830 . 17737) (DINFO.DEFAULT.MENU
|
||||
17739 . 20263) (DINFO.FIND 20265 . 22851) (DINFO.LOOKUP 22853 . 24405)) (24408 27102 (
|
||||
DINFO.READ.KOTO.GRAPH 24418 . 27100)) (27103 29417 (DINFO.SETUP.WINDOW 27113 . 27794) (DINFO.CLOSEFN
|
||||
27796 . 28229) (DINFO.SHRINKFN 28231 . 28427) (DINFO.EXPANDFN 28429 . 28986) (DINFO.ICONFN 28988 .
|
||||
29415)) (29418 40740 (DINFO.ADD.FMENU 29428 . 30523) (DINFO.CREATE.FMENU 30525 . 34552) (
|
||||
DINFO.FMW.CLOSEFN 34554 . 35399) (DINFO.FMENU.HANDLER 35401 . 36040) (DINFO.UPDATE.FMENU 36042 . 38231
|
||||
) (DINFO.TOGGLE.MENU 38233 . 38823) (DINFO.TOGGLE.GRAPH 38825 . 39324) (DINFO.TOGGLE.HISTORY 39326 .
|
||||
39870) (DINFO.TOGGLE.TEXT 39872 . 40738)) (40741 48536 (DINFO.UPDATE.MENU.DISPLAY 40751 . 44872) (
|
||||
DINFO.UPDATE.FROM.MENU 44874 . 45173) (DINFO.UPDATE.HISTORY 45175 . 47705) (DINFO.HISTORIC.UPDATE
|
||||
47707 . 48534)) (48537 58866 (DINFO.UPDATE.GRAPH.DISPLAY 48547 . 49999) (DINFO.UPDATE.FROM.GRAPH 50001
|
||||
. 50477) (DINFO.GET.GRAPH.WINDOW 50479 . 51064) (DINFO.CREATE.GRAPH.WINDOW 51066 . 52183) (
|
||||
DINFO.SHOWGRAPH 52185 . 53910) (DINFO.INVERT.NODE 53912 . 55300) (DINFO.LAYOUTGRAPH 55302 . 58864)) (
|
||||
58867 64936 (DINFO.UPDATE.TEXT.DISPLAY 58877 . 60825) (DINFO.TITLEMENUFN 60827 . 61952) (
|
||||
DINFO.OPENTEXTSTREAM 61954 . 63296) (DINFO.SHOWSEL 63298 . 64031) (DINFO.GET.FILENAME 64033 . 64934)))
|
||||
(FILEMAP (NIL (4582 6041 (DINFOGRAPHPROP 4582 . 6041)) (7295 24433 (DINFO 7305 . 8919) (DINFO.UPDATE
|
||||
8921 . 11785) (DINFOGRAPH 11787 . 12205) (DINFO.SPECIAL.UPDATE 12207 . 13905) (DINFO.READ.GRAPH 13907
|
||||
. 15762) (DINFO.WRITE.GRAPH 15764 . 16854) (DINFO.SELECT.GRAPH 16856 . 17763) (DINFO.DEFAULT.MENU
|
||||
17765 . 20289) (DINFO.FIND 20291 . 22877) (DINFO.LOOKUP 22879 . 24431)) (24434 27128 (
|
||||
DINFO.READ.KOTO.GRAPH 24444 . 27126)) (27129 29443 (DINFO.SETUP.WINDOW 27139 . 27820) (DINFO.CLOSEFN
|
||||
27822 . 28255) (DINFO.SHRINKFN 28257 . 28453) (DINFO.EXPANDFN 28455 . 29012) (DINFO.ICONFN 29014 .
|
||||
29441)) (29444 40766 (DINFO.ADD.FMENU 29454 . 30549) (DINFO.CREATE.FMENU 30551 . 34578) (
|
||||
DINFO.FMW.CLOSEFN 34580 . 35425) (DINFO.FMENU.HANDLER 35427 . 36066) (DINFO.UPDATE.FMENU 36068 . 38257
|
||||
) (DINFO.TOGGLE.MENU 38259 . 38849) (DINFO.TOGGLE.GRAPH 38851 . 39350) (DINFO.TOGGLE.HISTORY 39352 .
|
||||
39896) (DINFO.TOGGLE.TEXT 39898 . 40764)) (40767 48562 (DINFO.UPDATE.MENU.DISPLAY 40777 . 44898) (
|
||||
DINFO.UPDATE.FROM.MENU 44900 . 45199) (DINFO.UPDATE.HISTORY 45201 . 47731) (DINFO.HISTORIC.UPDATE
|
||||
47733 . 48560)) (48563 58892 (DINFO.UPDATE.GRAPH.DISPLAY 48573 . 50025) (DINFO.UPDATE.FROM.GRAPH 50027
|
||||
. 50503) (DINFO.GET.GRAPH.WINDOW 50505 . 51090) (DINFO.CREATE.GRAPH.WINDOW 51092 . 52209) (
|
||||
DINFO.SHOWGRAPH 52211 . 53936) (DINFO.INVERT.NODE 53938 . 55326) (DINFO.LAYOUTGRAPH 55328 . 58890)) (
|
||||
58893 65232 (DINFO.UPDATE.TEXT.DISPLAY 58903 . 60963) (DINFO.TITLEMENUFN 60965 . 62090) (
|
||||
DINFO.OPENTEXTSTREAM 62092 . 63592) (DINFO.SHOWSEL 63594 . 64327) (DINFO.GET.FILENAME 64329 . 65230)))
|
||||
))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Mar-2024 23:42:37" {WMEDLEY}<lispusers>DOC-OBJECTS.;36 52788
|
||||
(FILECREATED " 9-Dec-2024 21:07:13" {WMEDLEY}<lispusers>DOC-OBJECTS.;58 52672
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DOCOBJ-INCLUDE-EDIT-WINDOWP)
|
||||
:CHANGES-TO (FNS DOCOBJ-STRING-IMAGEBOX)
|
||||
|
||||
:PREVIOUS-DATE "19-Mar-2024 19:36:25" {WMEDLEY}<lispusers>DOC-OBJECTS.;35)
|
||||
:PREVIOUS-DATE " 8-Dec-2024 15:49:01" {WMEDLEY}<lispusers>DOC-OBJECTS.;57)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT DOC-OBJECTSCOMS)
|
||||
@@ -17,7 +17,7 @@
|
||||
(* ;;; "This TEdit subsystem implements an extensible facility originally intended to provide bibliography and citation capabilities. The TEdit function GET.OBJ.FROM.USER, the one triggered by typing ^O, calls the function PROMPTFOREVALED which is redefined by this subsystem to be equivalent to the function DocObj-Acquire-Object. This function inserts IMAGEOBJects into the current TEdit, and is driven by the variables DocObjectsMenu and DocObjectsMenuCommands (analogous to BackgroundMenu and BackgroundMenuCommands). Each menu entry contains a form that, when EVAL'd, creates and returns a particular kind of IMAGEOBJ. Note that this form is EVAL'd under the function DocObj-Acquire-Object, which runs under the function GET.OBJ.FROM.USER, which gets TEXTSTREAM and TEXTOBJ as arguments. They can be (and are) used freely to record state or other desired info. The image objects supplied by this subsystem are 'Eval`d Form' (i.e., the original behavior of ^O), 'Screen Snap' (equivalent to right-buttoning in the background while holding the SHIFT key down), etc.")
|
||||
|
||||
(FILES (SYSLOAD)
|
||||
TEDIT TEDIT IMAGEOBJ)
|
||||
TEDIT IMAGEOBJ)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL))
|
||||
(VARS (DocObjectsMenu NIL)
|
||||
(DocObjectsConfirmEditMenu NIL))
|
||||
@@ -28,7 +28,7 @@
|
||||
|
||||
(FNS DOCOBJ-ACQUIRE-OBJECT DOCOBJ-INIT DOCOBJ-TEDIT-MENU-ENTRY DOCOBJ-GET-LOOKS
|
||||
DOCOBJ-REGISTER-OBJECT DOCOBJ-STRING-IMAGEBOX DOCOBJ-WAIT-MOUSE
|
||||
DOCOBJ-INVOKE-IMAGEOBJFN DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN))
|
||||
DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN))
|
||||
[COMS
|
||||
(* ;; "Eval'd Form")
|
||||
|
||||
@@ -108,7 +108,7 @@
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
TEDIT TEDIT IMAGEOBJ)
|
||||
TEDIT IMAGEOBJ)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD TEDIT-EXPORTS.ALL)
|
||||
@@ -167,44 +167,37 @@
|
||||
(GET.OBJ.FROM.USER TEXTSTREAM (TEXTOBJ TEXTSTREAM])
|
||||
|
||||
(DOCOBJ-GET-LOOKS
|
||||
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 19-Mar-2024 19:36 by rmk")
|
||||
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 5-Apr-2024 12:20 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 19:36 by rmk")
|
||||
(* ; "Edited 29-Oct-2022 21:30 by rmk")
|
||||
(* Koomen " 4-Feb-87 23:37")
|
||||
|
||||
(* ;;; "Adapted from {ERIS}<TEDIT>TEDITLOOKS.;30 dated '15-Oct-85 16:51:10' to return looks itself, rather than a proplist.")
|
||||
(* jds "10-Jul-85 16:02")
|
||||
(* ; "Return a PLIST of character looks")
|
||||
(PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
LOOKS FONT NLOOKS)
|
||||
[COND
|
||||
((type? CHARLOOKS CH#ORCHARLOOKS) (* ;
|
||||
(LET ((TEXTOBJ (TEXTOBJ TEXTOBJ)))
|
||||
(if (type? CHARLOOKS CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"He handed us a CHARLOOKS. Unparse it for him.")
|
||||
(SETQ LOOKS CH#ORCHARLOOKS))
|
||||
((ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) (* ;
|
||||
CH#ORCHARLOOKS
|
||||
elseif (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
then (* ;
|
||||
"There's no text in the document. Use the extant caret looks.")
|
||||
(SETQ LOOKS (FGETTOBJ TEXTOBJ CARETLOOKS)))
|
||||
[(FIXP CH#ORCHARLOOKS) (* ;
|
||||
(FGETTOBJ TEXTOBJ CARETLOOKS)
|
||||
else (PLOOKS (\TEDIT.CHTOPC (if (FIXP CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"He gave us a CH# to get the looks of. Grab it.")
|
||||
(SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||
CH#ORCHARLOOKS)
|
||||
TEXTOBJ]
|
||||
[(type? SELECTION CH#ORCHARLOOKS) (* ;
|
||||
CH#ORCHARLOOKS
|
||||
elseif (type? SELECTION CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"Get the looks of the selected text")
|
||||
(SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||
(GETSEL CH#ORCHARLOOKS CH#))
|
||||
TEXTOBJ]
|
||||
((NULL CH#ORCHARLOOKS) (* ;
|
||||
(GETSEL CH#ORCHARLOOKS CH#)
|
||||
elseif (NULL CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"Get the looks of the selected text")
|
||||
(SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||
(GETSEL (FGETTOBJ TEXTOBJ SEL)
|
||||
CH#))
|
||||
TEXTOBJ]
|
||||
(RETURN LOOKS)
|
||||
|
||||
(* ;;; "Now break the looks apart into a PROPLIST")
|
||||
|
||||
(SETQ NLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST LOOKS))
|
||||
(RETURN NLOOKS])
|
||||
(GETSEL (FGETTOBJ TEXTOBJ SEL)
|
||||
CH#))
|
||||
TEXTOBJ])
|
||||
|
||||
(DOCOBJ-REGISTER-OBJECT
|
||||
[LAMBDA (OBJECT) (* ; "Edited 23-Oct-87 14:48 by Koomen")
|
||||
@@ -218,8 +211,9 @@
|
||||
OBJECT])
|
||||
|
||||
(DOCOBJ-STRING-IMAGEBOX
|
||||
[LAMBDA (STRING IMAGESTREAM) (* Koomen " 9-Feb-87 17:22")
|
||||
(DECLARE (SPECVARS CHNO TEXTOBJ))
|
||||
[LAMBDA (STRING IMAGESTREAM) (* ; "Edited 9-Dec-2024 21:04 by rmk")
|
||||
(* Koomen " 9-Feb-87 17:22")
|
||||
(DECLARE (USEDFREE CHNO TEXTOBJ))
|
||||
(PROG (LOOKS CLOFFSET FONT DEVICE HEIGHT DESCENT)
|
||||
(SETQ LOOKS (DOCOBJ-GET-LOOKS TEXTOBJ CHNO))
|
||||
(SETQ CLOFFSET (fetch (CHARLOOKS CLOFFSET) of LOOKS))
|
||||
@@ -230,10 +224,10 @@
|
||||
(SETQ HEIGHT (FONTHEIGHT FONT))
|
||||
(SETQ DESCENT (FONTPROP FONT 'DESCENT))
|
||||
(RETURN (create IMAGEBOX
|
||||
XSIZE _ (STRINGWIDTH STRING FONT)
|
||||
YSIZE _ (IPLUS HEIGHT (IABS CLOFFSET))
|
||||
YDESC _ (IDIFFERENCE DESCENT CLOFFSET)
|
||||
XKERN _ 0])
|
||||
XSIZE _ (STRINGWIDTH STRING FONT)
|
||||
YSIZE _ (IPLUS HEIGHT (IABS CLOFFSET))
|
||||
YDESC _ (IDIFFERENCE DESCENT CLOFFSET)
|
||||
XKERN _ 0])
|
||||
|
||||
(DOCOBJ-WAIT-MOUSE
|
||||
[LAMBDA (STREAM) (* ;
|
||||
@@ -245,108 +239,104 @@
|
||||
(LASTMOUSEY STREAM)))
|
||||
then (RETURN NIL)) finally (RETURN T])
|
||||
|
||||
(DOCOBJ-INVOKE-IMAGEOBJFN
|
||||
[LAMBDA (CH# PIECE IMAGEOBJFNNAME) (* ; "Edited 28-Jun-2023 19:45 by rmk")
|
||||
(* ; "Edited 9-Sep-2022 16:10 by rmk")
|
||||
(* ; "Edited 7-Sep-2022 23:11 by rmk")
|
||||
(* ; "Edited 6-Sep-2022 10:05 by rmk")
|
||||
(* ; "Edited 15-Oct-87 23:35 by Koomen")
|
||||
|
||||
(* ;; "If PIECE is an IMAGEOBJ, invoke the function associated with the ImageObj property IMAGEOBJFNNAME on the IMAGEOBJ and the character position where the IMAGEOBJ is located. ")
|
||||
|
||||
(CL:WHEN (AND (type? PIECE PIECE)
|
||||
(EQ OBJECT.PTYPE (PTYPE PIECE)))
|
||||
(LET ((IMAGEOBJ (PCONTENTS PIECE))
|
||||
IMAGEOBJFN)
|
||||
(SETQ IMAGEOBJFN (IMAGEOBJPROP IMAGEOBJ IMAGEOBJFNNAME))
|
||||
(CL:WHEN (AND IMAGEOBJFN (DEFINEDP IMAGEOBJFN))
|
||||
(APPLY* IMAGEOBJFN IMAGEOBJ CH# PIECE))))])
|
||||
|
||||
(DOCOBJ-BEFOREHARDCOPYFN
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 16-Mar-2024 10:05 by rmk")
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 8-Dec-2024 15:48 by rmk")
|
||||
(* ; "Edited 12-Jul-2024 12:46 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 00:09 by rmk")
|
||||
(* ; "Edited 8-May-2024 00:05 by rmk")
|
||||
(* ; "Edited 6-May-2024 22:50 by rmk")
|
||||
(* ; "Edited 5-Apr-2024 08:03 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:05 by rmk")
|
||||
(* ; "Edited 16-Jul-2023 16:53 by rmk")
|
||||
(* ; "Edited 10-Jul-2023 22:29 by rmk")
|
||||
(* ;
|
||||
"Edited 25-May-93 13:07 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "This is the only BEFOREHARDCOPYFN, provided by DOC-OBJECTS. If the text doesn't contain any such objects, the property is NIL and the piece-scan doesn't happen. This is installed in the TEXTOBJ by the call to DOCOBJ-REGISTER-OBJECT from every DOCOBJ create function.")
|
||||
(* ;; "This is the only BEFOREHARDCOPYFN provided by DOC-OBJECTS. If the text doesn't contain any such objects, the property is NIL and te piece-scan doesn't happen. This is installed in the TEXTOBJ by the call to DOCOBJ-REGISTER-OBJECT from every DOCOBJ create function.")
|
||||
|
||||
(* ;; "This runs through the file applying the BEFOREHARDCOPYFN of every object that has one. For example, an include object will replace the object by its target file.")
|
||||
|
||||
(* ;; "This records all of the history events created during the object pass into a single composite even so that the DOCOBJ-AFTERHARDCOPYFN can restore the stream to its original state.")
|
||||
|
||||
(RESETLST
|
||||
|
||||
(* ;; "We don't want to update the display lines to show the intermediate state while we are updating the pieces. ")
|
||||
|
||||
(RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T)
|
||||
`(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE))
|
||||
(LET ((PREVEVENTS (GETTOBJ TEXTOBJ TXTHISTORY))
|
||||
(OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY))
|
||||
(PREVSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)))
|
||||
FAILED)
|
||||
(TEDIT.DEFER.UPDATES TEXTSTREAM)
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
|
||||
(OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY))
|
||||
(PREVSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)))
|
||||
FAILED EVENTS)
|
||||
|
||||
(* ;; "This is a little tricky because the imageobj function may screw around with the piece containining the object, delete it or replace it with something else. But presumably it links into the previous saved piece, and we continue from there.")
|
||||
(* ;; "This is a little tricky because the imageobj function may screw around with the piece containining the object, delete it or replace it with something else. But presumably it links into the previous saved piece, and we continue from there.")
|
||||
|
||||
[bind OBJ FN PREVPC (CH# _ 1)
|
||||
(PC _ (\TEDIT.FIRSTPIECE TEXTOBJ)) while PC
|
||||
do (SETQ PC (if (AND (EQ OBJECT.PTYPE (PTYPE PC))
|
||||
(SETQ OBJ (PCONTENTS PC))
|
||||
(SETQ FN (IMAGEOBJPROP OBJ 'BEFOREHARDCOPYFN))
|
||||
(DEFINEDP FN))
|
||||
then (SETQ PREVPC (PREVPIECE PC))
|
||||
(CL:UNLESS (APPLY* FN TEXTOBJ OBJ PC CH#)
|
||||
(SETQ FAILED T)
|
||||
(RETURN))
|
||||
(if PREVPC
|
||||
then (NEXTPIECE (if (EQ PC (NEXTPIECE PREVPC))
|
||||
then
|
||||
(* ;;
|
||||
[bind OBJ FN PREVPC (CH# _ 1)
|
||||
(PC _ (\TEDIT.FIRSTPIECE TEXTOBJ)) while PC
|
||||
do (SETQ PC (if (AND (EQ OBJECT.PTYPE (PTYPE PC))
|
||||
(SETQ OBJ (PCONTENTS PC))
|
||||
(SETQ FN (IMAGEOBJPROP OBJ 'BEFOREHARDCOPYFN))
|
||||
(DEFINEDP FN))
|
||||
then (SETQ PREVPC (PREVPIECE PC))
|
||||
(CL:UNLESS (APPLY* FN TEXTOBJ OBJ PC CH#)
|
||||
(SETQ FAILED T)
|
||||
(RETURN))
|
||||
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(* ; "Accumulate undo events")
|
||||
(if PREVPC
|
||||
then (NEXTPIECE (if (EQ PC (NEXTPIECE PREVPC))
|
||||
then
|
||||
(* ;;
|
||||
"Nothing affected this PC, advance")
|
||||
|
||||
(add CH# (PLEN PC))
|
||||
PC
|
||||
else
|
||||
(* ;;
|
||||
(add CH# (PLEN PC))
|
||||
PC
|
||||
else
|
||||
(* ;;
|
||||
"Otherwise investigate its replacement")
|
||||
|
||||
PREVPC))
|
||||
elseif (EQ PC (\TEDIT.FIRSTPIECE TEXTOBJ))
|
||||
then (add CH# (PLEN PC))
|
||||
(NEXTPIECE PC)
|
||||
else
|
||||
(* ;;
|
||||
PREVPC))
|
||||
elseif (EQ PC (\TEDIT.FIRSTPIECE TEXTOBJ))
|
||||
then (add CH# (PLEN PC))
|
||||
(NEXTPIECE PC)
|
||||
else
|
||||
(* ;;
|
||||
"Investigate the replacement of the previous first piece.")
|
||||
|
||||
(\TEDIT.FIRSTPIECE TEXTOBJ))
|
||||
else (add CH# (PLEN PC))
|
||||
(NEXTPIECE PC] (* ; "Restore previous settings")
|
||||
(\TEDIT.FIRSTPIECE TEXTOBJ))
|
||||
else (add CH# (PLEN PC))
|
||||
(NEXTPIECE PC] (* ; "Restore previous settings")
|
||||
(* ;
|
||||
"The history event may restore SEL, but...")
|
||||
(SETTOBJ TEXTOBJ \DIRTY OLDDIRTY)
|
||||
(SETTOBJ TEXTOBJ \DIRTY OLDDIRTY)
|
||||
|
||||
(* ;; "Make a single undoing event for the after fn")
|
||||
(* ;; "Make a single event for the afterfn to undo")
|
||||
|
||||
(for ETAIL on (GETTOBJ TEXTOBJ TXTHISTORY) until (EQ ETAIL PREVEVENTS)
|
||||
collect (CAR ETAIL) finally (SETTOBJ TEXTOBJ TXTHISTORY (CONS $$VAL PREVEVENTS)))
|
||||
|
||||
(* ;; "In case something screws up, at least redisplaying will show something correctly (even if we aren't \DIRTY)")
|
||||
|
||||
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (TEXTLEN TEXTOBJ))
|
||||
(CL:WHEN FAILED
|
||||
(DOCOBJ-AFTERHARDCOPYFN TEXTSTREAM TEXTOBJ) (* ; "UNDO whatever was saved")
|
||||
(SETTOBJ TEXTOBJ SEL PREVSEL)
|
||||
'DON'T)))])
|
||||
(\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS)
|
||||
(CL:WHEN FAILED
|
||||
(DOCOBJ-AFTERHARDCOPYFN TEXTSTREAM) (* ; "UNDO whatever was saved")
|
||||
(SETTOBJ TEXTOBJ SEL PREVSEL)
|
||||
'DON'T)))])
|
||||
|
||||
(DOCOBJ-AFTERHARDCOPYFN
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 15-Mar-2024 14:24 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 7-Jul-2024 00:07 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 22:59 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 09:55 by rmk")
|
||||
(* ; "Edited 8-May-2024 10:42 by rmk")
|
||||
(* ; "Edited 7-May-2024 08:20 by rmk")
|
||||
(* ; "Edited 5-Apr-2024 08:05 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 14:24 by rmk")
|
||||
(* ; "Edited 15-Jul-2023 15:57 by rmk")
|
||||
(* ;
|
||||
"Edited 25-May-93 13:08 by sybalsky:mv:envos")
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(RESETLST
|
||||
(RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T)
|
||||
`(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE))
|
||||
(LET ((PREVUNDONE (GETTOBJ TEXTOBJ TXTHISTORYUNDONE)))
|
||||
(TEDIT.UNDO TEXTOBJ)
|
||||
(SETTOBJ TEXTOBJ TXTHISTORYUNDONE PREVUNDONE)
|
||||
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (TEXTLEN TEXTOBJ))
|
||||
(\TEDIT.UPDATE.SCREEN TEXTOBJ)))])
|
||||
[RESETSAVE (TEXTPROP TSTREAM 'DON'TUPDATE T)
|
||||
`(PROGN (TEXTPROP ,TSTREAM 'DON'TUPDATE OLDVALUE)
|
||||
(\TEDIT.FILL.PANES ,TSTREAM]
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(PREVUNDONE (GETTOBJ TEXTOBJ TXTHISTORYUNDONE)))
|
||||
(TEDIT.UNDO TSTREAM T)
|
||||
(SETTOBJ TEXTOBJ TXTHISTORYUNDONE PREVUNDONE)))])
|
||||
)
|
||||
|
||||
|
||||
@@ -750,11 +740,10 @@
|
||||
IMAGEOBJ])
|
||||
|
||||
(DOCOBJ-INCLUDE-EDIT
|
||||
[LAMBDA (INCLOBJ) (* ; "Edited 9-May-2018 11:09 by rmk:")
|
||||
(* ; "Edited 9-May-2018 10:35 by rmk:")
|
||||
(* ;
|
||||
"Edited 26-Oct-87 19:57 by Koomen")
|
||||
(DECLARE (SPECVARS TEXTOBJ))
|
||||
[LAMBDA (INCLOBJ TSTREAM) (* ; "Edited 12-May-2024 09:03 by rmk")
|
||||
(* ; "Edited 9-May-2018 11:09 by rmk:")
|
||||
(* ; "Edited 9-May-2018 10:35 by rmk:")
|
||||
(* ; "Edited 26-Oct-87 19:57 by Koomen")
|
||||
(SELECTQ [MENU (OR DOCOBJ-INCLUDE-EDITMENU (SETQ DOCOBJ-INCLUDE-EDITMENU
|
||||
(create MENU
|
||||
TITLE _ "Edit Include"
|
||||
@@ -771,41 +760,38 @@
|
||||
CENTERFLG _ T
|
||||
MENUOFFSET _ '(-1 . 30)
|
||||
CHANGEOFFSETFLG _ 'Y]
|
||||
(NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TEXTOBJ "Enter new file name: " (fetch
|
||||
(INCLOBJ FILENAME)
|
||||
(NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TSTREAM "Enter new file name: " (fetch (INCLOBJ
|
||||
FILENAME)
|
||||
of INCLOBJ]
|
||||
(if [AND NEWNAME (SETQ NEWNAME (MKSTRING NEWNAME))
|
||||
(NOT (EQUAL NEWNAME (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
(NOT (EQUAL NEWNAME (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
then (replace (INCLOBJ FILENAME) of INCLOBJ with NEWNAME)
|
||||
T)))
|
||||
T)))
|
||||
(EDIT.FILE (for W in (OPENWINDOWS)
|
||||
bind [FULLNAME _ (OR [FINDFILE (fetch (INCLOBJ FILENAME) of INCLOBJ
|
||||
)
|
||||
T
|
||||
(CONS (PACKFILENAME.STRING 'HOST
|
||||
(FILENAMEFIELD (FETCH TXTFILE
|
||||
OF TEXTOBJ)
|
||||
'HOST)
|
||||
'DIRECTORY
|
||||
(FILENAMEFIELD (FETCH TXTFILE
|
||||
OF TEXTOBJ)
|
||||
'DIRECTORY]
|
||||
(INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
bind [FULLNAME _ (OR (FINDFILE-WITH-EXTENSIONS
|
||||
(fetch (INCLOBJ FILENAME) of INCLOBJ)
|
||||
(CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD
|
||||
TXTFILE
|
||||
'HOST)
|
||||
'DIRECTORY
|
||||
(FILENAMEFIELD TXTFILE 'DIRECTORY))
|
||||
DIRECTORIES)
|
||||
*TEDIT-EXTENSIONS*)
|
||||
(INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
first (if (NULL FULLNAME)
|
||||
then (TEDIT.PROMPTPRINT TEXTOBJ "Can't find " T)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (fetch (INCLOBJ FILENAME)
|
||||
of INCLOBJ))
|
||||
(RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP
|
||||
FULLNAME W))
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "Can't find " T)
|
||||
(TEDIT.PROMPTPRINT TSTREAM (fetch (INCLOBJ FILENAME)
|
||||
of INCLOBJ))
|
||||
(RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP FULLNAME W))
|
||||
do (TOTOPW W)
|
||||
(GIVE.TTY.PROCESS W)
|
||||
(RETURN) finally (TEDIT (MKATOM FULLNAME))))
|
||||
(GIVE.TTY.PROCESS W)
|
||||
(RETURN) finally (TEDIT (MKATOM FULLNAME))))
|
||||
(ENABLE (if (NOT (fetch (INCLOBJ ENABLEDP) of INCLOBJ))
|
||||
then (replace (INCLOBJ ENABLEDP) of INCLOBJ with T)
|
||||
T))
|
||||
T))
|
||||
(DISABLE (if (fetch (INCLOBJ ENABLEDP) of INCLOBJ)
|
||||
then (replace (INCLOBJ ENABLEDP) of INCLOBJ with NIL)
|
||||
T))
|
||||
T))
|
||||
NIL])
|
||||
|
||||
(DOCOBJ-INCLUDE-EDIT-WINDOWP
|
||||
@@ -842,56 +828,51 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DOCOBJ-INCLUDE-BEFOREHARDCOPYFN
|
||||
[LAMBDA (TEXTOBJ OBJ PC CH#) (* ; "Edited 16-Feb-2024 23:47 by rmk")
|
||||
[LAMBDA (TEXTOBJ OBJ PC CH#) (* ; "Edited 13-Sep-2024 15:13 by rmk")
|
||||
(* ; "Edited 12-May-2024 08:48 by rmk")
|
||||
(* ; "Edited 7-May-2024 23:33 by rmk")
|
||||
(* ; "Edited 16-Feb-2024 23:47 by rmk")
|
||||
(* ; "Edited 23-Jul-2023 22:45 by rmk")
|
||||
(* ; "Edited 16-Jul-2023 11:14 by rmk")
|
||||
(* ; "Edited 10-Jul-2023 22:18 by rmk")
|
||||
(* ; "Edited 22-Jun-2023 16:44 by rmk")
|
||||
|
||||
(* ;; "This replaces the PC, the piece with an included-file object, with the contents of that file. The undo event will restore the object. Since the piece with the object is deleted, its paragraph looks are ignored and only the lookos of the inserted file are interpreted. E.g., to get a page break before the included file, either the first piece of that file must be a page break, or a blank NEWPAGEBEFORE paragraph must come before the OBJ.'")
|
||||
(* ;; "This replaces the PC, the piece with an included-file object, with the contents of that file. The undo event will restore the object. Since the piece with the object is deleted, its paragraph looks are ignored and only the looks of the inserted file are interpreted. E.g., to get a page break before the included file, either the first piece of that file must be a page break, or a blank NEWPAGEBEFORE paragraph must come before the OBJ.")
|
||||
|
||||
(* ;; "Returns T if the inclusion is succeeds as intended, NIL otherwise.")
|
||||
|
||||
(* ;; "Not sure why the INCLUDEDP property. If enabled, it's included.")
|
||||
|
||||
(if (fetch (INCLOBJ ENABLEDP) of (IMAGEOBJPROP OBJ 'OBJECTDATUM))
|
||||
then (LET ([INCLFILE (fetch (INCLOBJ FILENAME) of (IMAGEOBJPROP OBJ 'OBJECTDATUM]
|
||||
(TXTFILE (GETTOBJ TEXTOBJ TXTFILE))
|
||||
INCLSTREAM)
|
||||
[SETQ INCLFILE (FINDFILE INCLFILE T (AND TXTFILE (CONS (PACKFILENAME.STRING
|
||||
'HOST
|
||||
(FILENAMEFIELD TXTFILE
|
||||
'HOST)
|
||||
'DIRECTORY
|
||||
(FILENAMEFIELD TXTFILE
|
||||
'DIRECTORY))
|
||||
DIRECTORIES]
|
||||
(if INCLFILE
|
||||
then
|
||||
(* ;; "No point in prompting: it just flashes by")
|
||||
(CL:WHEN (fetch (INCLOBJ ENABLEDP) of (IMAGEOBJPROP OBJ 'OBJECTDATUM))
|
||||
(LET ([INCLFILE (fetch (INCLOBJ FILENAME) of (IMAGEOBJPROP OBJ 'OBJECTDATUM]
|
||||
(TXTFILE (GETTOBJ TEXTOBJ TXTFILE)))
|
||||
(SETQ INCLFILE (FINDFILE-WITH-EXTENSIONS INCLFILE
|
||||
(AND TXTFILE (CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD
|
||||
TXTFILE
|
||||
'HOST)
|
||||
'DIRECTORY
|
||||
(FILENAMEFIELD TXTFILE 'DIRECTORY))
|
||||
DIRECTORIES))
|
||||
*TEDIT-EXTENSIONS*))
|
||||
(if INCLFILE
|
||||
then (* ; "Don't update/show until end")
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
CH# 1 'LEFT) (* ; "Deletes this include-object")
|
||||
(\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ))
|
||||
(TEDIT.INCLUDE TEXTOBJ INCLFILE NIL NIL DOCOBJ-INCLUDE-SAFE)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included " INCLFILE))
|
||||
|
||||
(AND NIL (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Including " INCLFILE "...")
|
||||
T))
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
CH# 1 'LEFT T) (* ; "Set the destination")
|
||||
(\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)
|
||||
T)
|
||||
(TEDIT.INCLUDE TEXTOBJ INCLFILE NIL NIL DOCOBJ-INCLUDE-SAFE)
|
||||
(AND NIL (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Including " INCLFILE
|
||||
"...done")))
|
||||
else
|
||||
(* ;; "Did not succeed as intended. Caller should restore the stream, maybe selecting and highlighting the bad inclusion.")
|
||||
(* ;; "Succeeded as intended")
|
||||
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch (INCLOBJ FILENAME
|
||||
)
|
||||
of OBJ)
|
||||
" not found")
|
||||
T T)
|
||||
NIL))
|
||||
else
|
||||
(* ;; "Succeeded as intended")
|
||||
T
|
||||
else
|
||||
(* ;; "Did not succeed as intended. Caller should restore the stream, maybe selecting and highlighting the bad inclusion.")
|
||||
|
||||
T])
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch (INCLOBJ FILENAME)
|
||||
of OBJ)
|
||||
" not found")
|
||||
T T)
|
||||
NIL)))])
|
||||
|
||||
(DOCOBJ-INCLUDE-CLEANUPFN
|
||||
[LAMBDA (TEXTSTREAM STARTPOS LEN) (* ; "Edited 15-Mar-2024 14:08 by rmk")
|
||||
@@ -919,12 +900,13 @@
|
||||
|
||||
(DOCOBJ-INCLUDE-BUTTONEVENTINFN
|
||||
[LAMBDA (IMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON)
|
||||
(* ; "Edited 12-May-2024 09:01 by rmk")
|
||||
(* ; "Edited 23-Oct-87 00:46 by Koomen")
|
||||
|
||||
(if (AND (EQ BUTTON 'MIDDLE)
|
||||
(DOCOBJ-WAIT-MOUSE WINDOWSTREAM))
|
||||
then (ALLOW.BUTTON.EVENTS)
|
||||
(if (DOCOBJ-INCLUDE-EDIT (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM))
|
||||
(if (DOCOBJ-INCLUDE-EDIT (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)
|
||||
HOSTSTREAM)
|
||||
then (DOCOBJ-INCLUDE-RESET-OBJ IMAGEOBJ)
|
||||
'CHANGED])
|
||||
|
||||
@@ -1011,30 +993,29 @@
|
||||
(PUTPROPS DOC-OBJECTS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (7682 21029 (DOCOBJ-ACQUIRE-OBJECT 7692 . 8693) (DOCOBJ-INIT 8695 . 9323) (
|
||||
DOCOBJ-TEDIT-MENU-ENTRY 9325 . 9747) (DOCOBJ-GET-LOOKS 9749 . 12364) (DOCOBJ-REGISTER-OBJECT 12366 .
|
||||
13020) (DOCOBJ-STRING-IMAGEBOX 13022 . 13970) (DOCOBJ-WAIT-MOUSE 13972 . 14432) (
|
||||
DOCOBJ-INVOKE-IMAGEOBJFN 14434 . 15557) (DOCOBJ-BEFOREHARDCOPYFN 15559 . 20205) (
|
||||
DOCOBJ-AFTERHARDCOPYFN 20207 . 21027)) (21059 21326 (DOCOBJ-ACQUIRE-EVALED-OBJECT 21069 . 21324)) (
|
||||
21526 21668 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21536 . 21666)) (22007 26803 (DOCOBJ-EDIT-TIMESTAMP 22017
|
||||
. 22546) (DOCOBJ-MAKE-TIMESTAMP 22548 . 22959) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 22961 . 24031) (
|
||||
DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24033 . 24564) (DOCOBJ-TIMESTAMP-COPYFN 24566 . 24891) (
|
||||
DOCOBJ-TIMESTAMP-DISPLAYFN 24893 . 25186) (DOCOBJ-TIMESTAMP-GETFN 25188 . 25428) (
|
||||
DOCOBJ-TIMESTAMP-IMAGEBOXFN 25430 . 25786) (DOCOBJ-TIMESTAMP-PREPRINTFN 25788 . 26019) (
|
||||
DOCOBJ-TIMESTAMP-PUTFN 26021 . 26390) (DOCOBJ-TIMESTAMP-TO-STRING 26392 . 26801)) (27097 31404 (
|
||||
DOCOBJ-MAKE-FILESTAMP 27107 . 27448) (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27450 . 28492) (
|
||||
DOCOBJ-FILESTAMP-COPYFN 28494 . 28809) (DOCOBJ-FILESTAMP-DISPLAYFN 28811 . 29099) (
|
||||
DOCOBJ-FILESTAMP-GETFN 29101 . 29454) (DOCOBJ-FILESTAMP-IMAGEBOXFN 29456 . 29794) (
|
||||
DOCOBJ-FILESTAMP-GET-FULLNAME 29796 . 30414) (DOCOBJ-FILESTAMP-NEW-FULLNAME 30416 . 30889) (
|
||||
DOCOBJ-FILESTAMP-PREPRINTFN 30891 . 31100) (DOCOBJ-FILESTAMP-PUTFN 31102 . 31402)) (31727 34224 (
|
||||
DOCOBJ-MAKE-HRULE 31737 . 32151) (DOCOBJ-EDIT-HRULE 32153 . 32625) (DOCOBJ-HRULE-INIT 32627 . 32959) (
|
||||
DOCOBJ-HRULE-GET-WIDTH 32961 . 33772) (DOCOBJ-HRULE-BUTTONEVENTINFN 33774 . 34222)) (34643 43315 (
|
||||
DOCOBJ-MAKE-INCLUDE 34653 . 35054) (DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35056 . 36061) (
|
||||
DOCOBJ-INCLUDE-CREATE-OBJ 36063 . 36831) (DOCOBJ-INCLUDE-EDIT 36833 . 41432) (
|
||||
DOCOBJ-INCLUDE-EDIT-WINDOWP 41434 . 42290) (DOCOBJ-INCLUDE-RESET-OBJ 42292 . 43313)) (43316 52247 (
|
||||
DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43326 . 47048) (DOCOBJ-INCLUDE-CLEANUPFN 47050 . 48569) (
|
||||
DOCOBJ-INCLUDE-BUTTONEVENTINFN 48571 . 49105) (DOCOBJ-INCLUDE-COPYFN 49107 . 49325) (
|
||||
DOCOBJ-INCLUDE-DISPLAYFN 49327 . 50079) (DOCOBJ-INCLUDE-GETFN 50081 . 50804) (
|
||||
DOCOBJ-INCLUDE-IMAGEBOXFN 50806 . 51815) (DOCOBJ-INCLUDE-PREPRINTFN 51817 . 52036) (
|
||||
DOCOBJ-INCLUDE-PUTFN 52038 . 52245)))))
|
||||
(FILEMAP (NIL (7640 21328 (DOCOBJ-ACQUIRE-OBJECT 7650 . 8651) (DOCOBJ-INIT 8653 . 9281) (
|
||||
DOCOBJ-TEDIT-MENU-ENTRY 9283 . 9705) (DOCOBJ-GET-LOOKS 9707 . 12167) (DOCOBJ-REGISTER-OBJECT 12169 .
|
||||
12823) (DOCOBJ-STRING-IMAGEBOX 12825 . 13881) (DOCOBJ-WAIT-MOUSE 13883 . 14343) (
|
||||
DOCOBJ-BEFOREHARDCOPYFN 14345 . 19815) (DOCOBJ-AFTERHARDCOPYFN 19817 . 21326)) (21358 21625 (
|
||||
DOCOBJ-ACQUIRE-EVALED-OBJECT 21368 . 21623)) (21825 21967 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21835 . 21965
|
||||
)) (22306 27102 (DOCOBJ-EDIT-TIMESTAMP 22316 . 22845) (DOCOBJ-MAKE-TIMESTAMP 22847 . 23258) (
|
||||
DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 23260 . 24330) (DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24332 . 24863) (
|
||||
DOCOBJ-TIMESTAMP-COPYFN 24865 . 25190) (DOCOBJ-TIMESTAMP-DISPLAYFN 25192 . 25485) (
|
||||
DOCOBJ-TIMESTAMP-GETFN 25487 . 25727) (DOCOBJ-TIMESTAMP-IMAGEBOXFN 25729 . 26085) (
|
||||
DOCOBJ-TIMESTAMP-PREPRINTFN 26087 . 26318) (DOCOBJ-TIMESTAMP-PUTFN 26320 . 26689) (
|
||||
DOCOBJ-TIMESTAMP-TO-STRING 26691 . 27100)) (27396 31703 (DOCOBJ-MAKE-FILESTAMP 27406 . 27747) (
|
||||
DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27749 . 28791) (DOCOBJ-FILESTAMP-COPYFN 28793 . 29108) (
|
||||
DOCOBJ-FILESTAMP-DISPLAYFN 29110 . 29398) (DOCOBJ-FILESTAMP-GETFN 29400 . 29753) (
|
||||
DOCOBJ-FILESTAMP-IMAGEBOXFN 29755 . 30093) (DOCOBJ-FILESTAMP-GET-FULLNAME 30095 . 30713) (
|
||||
DOCOBJ-FILESTAMP-NEW-FULLNAME 30715 . 31188) (DOCOBJ-FILESTAMP-PREPRINTFN 31190 . 31399) (
|
||||
DOCOBJ-FILESTAMP-PUTFN 31401 . 31701)) (32026 34523 (DOCOBJ-MAKE-HRULE 32036 . 32450) (
|
||||
DOCOBJ-EDIT-HRULE 32452 . 32924) (DOCOBJ-HRULE-INIT 32926 . 33258) (DOCOBJ-HRULE-GET-WIDTH 33260 .
|
||||
34071) (DOCOBJ-HRULE-BUTTONEVENTINFN 34073 . 34521)) (34942 43284 (DOCOBJ-MAKE-INCLUDE 34952 . 35353)
|
||||
(DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35355 . 36360) (DOCOBJ-INCLUDE-CREATE-OBJ 36362 . 37130) (
|
||||
DOCOBJ-INCLUDE-EDIT 37132 . 41401) (DOCOBJ-INCLUDE-EDIT-WINDOWP 41403 . 42259) (
|
||||
DOCOBJ-INCLUDE-RESET-OBJ 42261 . 43282)) (43285 52131 (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43295 . 46789)
|
||||
(DOCOBJ-INCLUDE-CLEANUPFN 46791 . 48310) (DOCOBJ-INCLUDE-BUTTONEVENTINFN 48312 . 48989) (
|
||||
DOCOBJ-INCLUDE-COPYFN 48991 . 49209) (DOCOBJ-INCLUDE-DISPLAYFN 49211 . 49963) (DOCOBJ-INCLUDE-GETFN
|
||||
49965 . 50688) (DOCOBJ-INCLUDE-IMAGEBOXFN 50690 . 51699) (DOCOBJ-INCLUDE-PREPRINTFN 51701 . 51920) (
|
||||
DOCOBJ-INCLUDE-PUTFN 51922 . 52129)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,18 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "12-Jul-2022 14:18:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EDITFONT.;10 28741
|
||||
(FILECREATED " 1-Feb-2025 12:28:41" {DSK}<home>matt>Interlisp>medley>lispusers>EDITFONT.;2 28339
|
||||
|
||||
:CHANGES-TO (FNS READSTRIKEFONTFILE)
|
||||
(VARS EDITFONTCOMS)
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:PREVIOUS-DATE "27-Jun-2022 10:59:12"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>EDITFONT.;5)
|
||||
:CHANGES-TO (VARS EDITFONTCOMS)
|
||||
|
||||
:PREVIOUS-DATE "12-Jul-2022 14:18:56" {DSK}<home>matt>Interlisp>medley>lispusers>EDITFONT.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985-1986 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT EDITFONTCOMS)
|
||||
|
||||
@@ -26,9 +21,7 @@ Copyright (c) 1985-1986 by Xerox Corporation.
|
||||
COPYFONT READSTRIKEFONTFILE)
|
||||
(FNS BLANKFONTCREATE EDITFONT)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (BITSPERWORD 16)
|
||||
(BYTESPERWORD 2)
|
||||
(MAXCODE 255)
|
||||
(DUMMYINDEX 256))
|
||||
(BYTESPERWORD 2))
|
||||
(FILES (LOADCOMP)
|
||||
FONT))
|
||||
(P (EF.INIT))))
|
||||
@@ -527,15 +520,9 @@ Copyright (c) 1985-1986 by Xerox Corporation.
|
||||
|
||||
(RPAQQ BYTESPERWORD 2)
|
||||
|
||||
(RPAQQ MAXCODE 255)
|
||||
|
||||
(RPAQQ DUMMYINDEX 256)
|
||||
|
||||
|
||||
(CONSTANTS (BITSPERWORD 16)
|
||||
(BYTESPERWORD 2)
|
||||
(MAXCODE 255)
|
||||
(DUMMYINDEX 256))
|
||||
(BYTESPERWORD 2))
|
||||
)
|
||||
|
||||
|
||||
@@ -544,12 +531,11 @@ Copyright (c) 1985-1986 by Xerox Corporation.
|
||||
)
|
||||
|
||||
(EF.INIT)
|
||||
(PUTPROPS EDITFONT COPYRIGHT ("Xerox Corporation" 1985 1986))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1567 26117 (EF.INIT 1577 . 2303) (EF.PROMPT 2305 . 2887) (EF.MESSAGE 2889 . 3101) (
|
||||
EF.CLOSEFN 3103 . 3630) (EF.CHARITEMS 3632 . 5853) (EF.BUTTONEVENTFN 5855 . 6267) (EF.WHENSELECTEDFN
|
||||
6269 . 6673) (EF.EDITBM 6675 . 8073) (EF.MIDDLEBUTTONFN 8075 . 8320) (EF.CHANGESIZE 8322 . 9541) (
|
||||
EF.DELETE 9543 . 10308) (EF.ENTER 10310 . 11141) (EF.REPLACE 11143 . 12006) (EF.SAVE 12008 . 16681) (
|
||||
EF.BLANK 16683 . 22308) (COPYFONT 22310 . 24750) (READSTRIKEFONTFILE 24752 . 26115)) (26118 28332 (
|
||||
BLANKFONTCREATE 26128 . 26385) (EDITFONT 26387 . 28330)))))
|
||||
(FILEMAP (NIL (1325 25875 (EF.INIT 1335 . 2061) (EF.PROMPT 2063 . 2645) (EF.MESSAGE 2647 . 2859) (
|
||||
EF.CLOSEFN 2861 . 3388) (EF.CHARITEMS 3390 . 5611) (EF.BUTTONEVENTFN 5613 . 6025) (EF.WHENSELECTEDFN
|
||||
6027 . 6431) (EF.EDITBM 6433 . 7831) (EF.MIDDLEBUTTONFN 7833 . 8078) (EF.CHANGESIZE 8080 . 9299) (
|
||||
EF.DELETE 9301 . 10066) (EF.ENTER 10068 . 10899) (EF.REPLACE 10901 . 11764) (EF.SAVE 11766 . 16439) (
|
||||
EF.BLANK 16441 . 22066) (COPYFONT 22068 . 24508) (READSTRIKEFONTFILE 24510 . 25873)) (25876 28090 (
|
||||
BLANKFONTCREATE 25886 . 26143) (EDITFONT 26145 . 28088)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,24 +1,22 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED " 3-Mar-88 13:51:10" {ERINYES}<LISPUSERS>LYRIC>EQUATIONS.;1 86057
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS EQIO.Put EQIO.Get)
|
||||
(FILECREATED "28-Jun-2024 22:11:21" {WMEDLEY}<lispusers>EQUATIONS.;2 85831
|
||||
|
||||
previous date%: "27-May-87 11:20:49" |{IE:PARC:XEROX}<LISP>LYRIC>LISPUSERS>EQUATIONS.;1|)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS EQN.WindowFromText)
|
||||
|
||||
:PREVIOUS-DATE " 3-Mar-88 13:51:10" {WMEDLEY}<lispusers>EQUATIONS.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT EQUATIONSCOMS)
|
||||
|
||||
(RPAQQ EQUATIONSCOMS
|
||||
(RPAQQ EQUATIONSCOMS
|
||||
(
|
||||
|
||||
(* ;;; "EQUATION module: Part 1 of 3")
|
||||
|
||||
(* ; "functions for image object")
|
||||
|
||||
(FNS EQIO.CreateFns EQIO.Create EQIO.Imagebox EQIO.Display EQIO.ButtonEventIn EQIO.Copy
|
||||
EQIO.CopyList EQIO.Get EQIO.Put EQIO.WhenDeleted EQIO.SelectRegion EQIO.Selection
|
||||
EQIO.DefaultSelectFn EQIO.MakeSelectionMenu)
|
||||
@@ -32,7 +30,7 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(* ;;; "functions to handle equation specification info")
|
||||
|
||||
(FNS EQIO.AddType EQIO.GetInfo EQIO.SetInfo EQIO.TypeProp EQIO.ResetTypeProps EQIO.IsDefined
|
||||
(FNS EQIO.AddType EQIO.GetInfo EQIO.SetInfo EQIO.TypeProp EQIO.ResetTypeProps EQIO.IsDefined
|
||||
EQIO.GetBox EQIO.GetDataSpec EQIO.GetDataSpecList EQIO.GetDataPosition
|
||||
EQIO.GetDataSelectRegion EQIO.MakeSpec EQIO.MakeDataSpec)
|
||||
|
||||
@@ -46,7 +44,6 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
[P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Equation 'EQN.Equation]
|
||||
(P (* ;
|
||||
"needed to force the getfn to be recognized before any new eqns defined")
|
||||
|
||||
(SETQ EquationImageFns (EQIO.CreateFns)))
|
||||
(VARS UnknownEquationData)
|
||||
(PROP ARGNAMES EQIO.TypeProp EQIO.NumPieces EQIO.AllProps EQIO.EqnProperty)
|
||||
@@ -61,7 +58,6 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
(* ;;; "EQUATIONEDIT module: Part 2 of 3")
|
||||
|
||||
(* ; "functions to edit data pieces")
|
||||
|
||||
(FNS EQN.AbortEdit EQN.StopEdit EQN.ContinueEdit EQN.FinishEdit EQN.MakeEditWindow
|
||||
EQN.SetUpEdit EQN.StartEdit EQN.StartNextEdit EQN.UpdateEdit EQN.DefaultData
|
||||
EQN.TypeMenu)
|
||||
@@ -69,7 +65,7 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(* ;;; "hooks to control behavior of equation subeditor")
|
||||
|
||||
(FNS EQN.Equation EQN.NextPiece EQN.FinishEqn EQN.NoUpdateAbort EQN.PreventUpdate EQN.CharFn
|
||||
(FNS EQN.Equation EQN.NextPiece EQN.FinishEqn EQN.NoUpdateAbort EQN.PreventUpdate EQN.CharFn
|
||||
EQN.TEditSpecialChar EQN.SnuggleWindows EQN.SnuggleMainWindow)
|
||||
|
||||
|
||||
@@ -680,25 +676,27 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
(RPAQ? EquationInfo NIL)
|
||||
|
||||
(RPAQ? EquationDefaultSelectFn 'EQIO.DefaultSelectFn)
|
||||
|
||||
[TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Equation 'EQN.Equation]
|
||||
|
||||
(* ;
|
||||
"needed to force the getfn to be recognized before any new eqns defined")
|
||||
|
||||
(SETQ EquationImageFns (EQIO.CreateFns))
|
||||
(SETQ EquationImageFns (EQIO.CreateFns))
|
||||
|
||||
(RPAQQ UnknownEquationData (((Gacha 10)
|
||||
"[unknown equation]")))
|
||||
|
||||
(PUTPROPS EQIO.TypeProp ARGNAMES (NIL (type prop {newValue})
|
||||
(PUTPROPS EQIO.TypeProp ARGNAMES (NIL (type prop {newValue})
|
||||
args))
|
||||
|
||||
(PUTPROPS EQIO.NumPieces ARGNAMES (NIL (eqnObj {newValue})
|
||||
(PUTPROPS EQIO.NumPieces ARGNAMES (NIL (eqnObj {newValue})
|
||||
args))
|
||||
|
||||
(PUTPROPS EQIO.AllProps ARGNAMES (NIL (eqnObj {newValue})
|
||||
(PUTPROPS EQIO.AllProps ARGNAMES (NIL (eqnObj {newValue})
|
||||
args))
|
||||
|
||||
(PUTPROPS EQIO.EqnProperty ARGNAMES (NIL (eqnObj prop {newValue})
|
||||
(PUTPROPS EQIO.EqnProperty ARGNAMES (NIL (eqnObj prop {newValue})
|
||||
args))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
@@ -1316,13 +1314,12 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
(EQN.ResultWindow window])
|
||||
|
||||
(EQN.WindowFromText
|
||||
[LAMBDA (textObjORStream) (* thh%: "28-Jun-85 14:32")
|
||||
(* gets window corresponding to a text
|
||||
object or stream)
|
||||
|
||||
(* note%: \WINDOW field actually is a list whose only element is the window)
|
||||
[LAMBDA (textObjORStream) (* ; "Edited 28-Jun-2024 22:11 by rmk")
|
||||
(* thh%: "28-Jun-85 14:32")
|
||||
|
||||
(LET [(w (fetch \WINDOW of (TEXTOBJ textObjORStream]
|
||||
(* ;; "gets window corresponding to a text object or stream")
|
||||
|
||||
(LET [(w (\TEDIT.PRIMARYPANE (TEXTOBJ textObjORStream]
|
||||
(OR (WINDOWP w)
|
||||
(WINDOWP (CAR w))
|
||||
(ERROR "EQN.WindowFromText: unable to find window for textobj/stream = " textObjORStream
|
||||
@@ -1477,22 +1474,22 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
) (TimesRoman 12) NIL))))
|
||||
|
||||
|
||||
(PUTPROPS EQN.ObjEditWindow ARGNAMES (NIL (eqnObj {newEditWindow})
|
||||
(PUTPROPS EQN.ObjEditWindow ARGNAMES (NIL (eqnObj {newEditWindow})
|
||||
args))
|
||||
|
||||
(PUTPROPS EQN.ContinueFlg ARGNAMES (NIL (editWindow {continueFlg})
|
||||
(PUTPROPS EQN.ContinueFlg ARGNAMES (NIL (editWindow {continueFlg})
|
||||
args))
|
||||
|
||||
(PUTPROPS EQN.PieceNumber ARGNAMES (NIL (editWindow {pieceNumber})
|
||||
(PUTPROPS EQN.PieceNumber ARGNAMES (NIL (editWindow {pieceNumber})
|
||||
args))
|
||||
|
||||
(PUTPROPS EQN.ResultObj ARGNAMES (NIL (editWindow {resultObj})
|
||||
(PUTPROPS EQN.ResultObj ARGNAMES (NIL (editWindow {resultObj})
|
||||
args))
|
||||
|
||||
(PUTPROPS EQN.ResultWindow ARGNAMES (NIL (editWindow {resultWindow})
|
||||
(PUTPROPS EQN.ResultWindow ARGNAMES (NIL (editWindow {resultWindow})
|
||||
args))
|
||||
|
||||
(PUTPROPS EQN.EditWindow ARGNAMES (NIL (window {editWindow})
|
||||
(PUTPROPS EQN.EditWindow ARGNAMES (NIL (window {editWindow})
|
||||
args))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
@@ -1797,37 +1794,37 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(* ;;; "Now load EQUATIONFORMS")
|
||||
|
||||
|
||||
(FILESLOAD EQUATIONFORMS)
|
||||
(PUTPROPS EQUATIONS COPYRIGHT ("Xerox Corporation" 1986 1987 1988))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4524 19553 (EQIO.CreateFns 4534 . 5067) (EQIO.Create 5069 . 6335) (EQIO.Imagebox 6337
|
||||
. 6749) (EQIO.Display 6751 . 8362) (EQIO.ButtonEventIn 8364 . 12205) (EQIO.Copy 12207 . 12588) (
|
||||
EQIO.CopyList 12590 . 13161) (EQIO.Get 13163 . 13571) (EQIO.Put 13573 . 14128) (EQIO.WhenDeleted 14130
|
||||
. 14624) (EQIO.SelectRegion 14626 . 15773) (EQIO.Selection 15775 . 17279) (EQIO.DefaultSelectFn 17281
|
||||
. 18519) (EQIO.MakeSelectionMenu 18521 . 19551)) (19627 25629 (EQIO.EqnType 19637 . 19888) (
|
||||
EQIO.EqnDataList 19890 . 20230) (EQIO.SetDataList 20232 . 20629) (EQIO.EqnData 20631 . 20810) (
|
||||
EQIO.EqnProperty 20812 . 21740) (EQIO.AllProps 21742 . 22257) (EQIO.Specify 22259 . 22756) (
|
||||
EQIO.GetInitialProps 22758 . 23890) (EQIO.NumPieces 23892 . 25135) (EQIO.NewStructure 25137 . 25627))
|
||||
(25696 30158 (EQIO.AddType 25706 . 26219) (EQIO.GetInfo 26221 . 26571) (EQIO.SetInfo 26573 . 27214) (
|
||||
EQIO.TypeProp 27216 . 28162) (EQIO.ResetTypeProps 28164 . 28486) (EQIO.IsDefined 28488 . 28773) (
|
||||
EQIO.GetBox 28775 . 28995) (EQIO.GetDataSpec 28997 . 29330) (EQIO.GetDataSpecList 29332 . 29477) (
|
||||
EQIO.GetDataPosition 29479 . 29619) (EQIO.GetDataSelectRegion 29621 . 29765) (EQIO.MakeSpec 29767 .
|
||||
30003) (EQIO.MakeDataSpec 30005 . 30156)) (31711 48815 (EQN.AbortEdit 31721 . 32233) (EQN.StopEdit
|
||||
32235 . 32682) (EQN.ContinueEdit 32684 . 36336) (EQN.FinishEdit 36338 . 37071) (EQN.MakeEditWindow
|
||||
37073 . 38492) (EQN.SetUpEdit 38494 . 39671) (EQN.StartEdit 39673 . 42974) (EQN.StartNextEdit 42976 .
|
||||
43493) (EQN.UpdateEdit 43495 . 44892) (EQN.DefaultData 44894 . 47579) (EQN.TypeMenu 47581 . 48813)) (
|
||||
48882 56790 (EQN.Equation 48892 . 50151) (EQN.NextPiece 50153 . 50878) (EQN.FinishEqn 50880 . 51409) (
|
||||
EQN.NoUpdateAbort 51411 . 51824) (EQN.PreventUpdate 51826 . 52261) (EQN.CharFn 52263 . 54348) (
|
||||
EQN.TEditSpecialChar 54350 . 55069) (EQN.SnuggleWindows 55071 . 55662) (EQN.SnuggleMainWindow 55664 .
|
||||
56788)) (56844 58583 (EQN.EquationFontNumber 56854 . 57613) (EQN.EquationFont 57615 . 57957) (
|
||||
EQN.GetEqnFont 57959 . 58140) (EQN.MakeFS 58142 . 58581)) (58612 61753 (EQN.AdjustWindow 58622 . 60582
|
||||
) (EQN.CheckWindowSize 60584 . 61751)) (61754 67638 (EQN.SubEditorP 61764 . 61997) (EQN.WindowFromText
|
||||
61999 . 62656) (EQN.EditWindow 62658 . 63736) (EQN.ResultWindow 63738 . 64288) (EQN.ResultObj 64290
|
||||
. 64758) (EQN.PieceNumber 64760 . 65309) (EQN.ContinueFlg 65311 . 65874) (EQN.ValidEditWindow 65876
|
||||
. 66310) (EQN.ObjEditWindow 66312 . 67636)) (67639 68756 (EQN.Make 67649 . 68754)) (69964 85899 (
|
||||
FS.Box 69974 . 72220) (FS.Copy 72222 . 72862) (FS.Display 72864 . 75850) (FS.Get 75852 . 76321) (
|
||||
FS.Put 76323 . 76794) (FS.ItemFont 76796 . 77157) (FS.ItemValue 77159 . 77565) (FS.ItemShift 77567 .
|
||||
77947) (FS.MakeItem 77949 . 78371) (FS.Extract 78373 . 82297) (FS.ExtractFont 82299 . 82902) (
|
||||
FS.ExtractShift 82904 . 83467) (FS.Insert 83469 . 85458) (FS.AllowedChar 85460 . 85697) (
|
||||
FS.RealStringP 85699 . 85897)))))
|
||||
(FILEMAP (NIL (4439 19468 (EQIO.CreateFns 4449 . 4982) (EQIO.Create 4984 . 6250) (EQIO.Imagebox 6252
|
||||
. 6664) (EQIO.Display 6666 . 8277) (EQIO.ButtonEventIn 8279 . 12120) (EQIO.Copy 12122 . 12503) (
|
||||
EQIO.CopyList 12505 . 13076) (EQIO.Get 13078 . 13486) (EQIO.Put 13488 . 14043) (EQIO.WhenDeleted 14045
|
||||
. 14539) (EQIO.SelectRegion 14541 . 15688) (EQIO.Selection 15690 . 17194) (EQIO.DefaultSelectFn 17196
|
||||
. 18434) (EQIO.MakeSelectionMenu 18436 . 19466)) (19542 25544 (EQIO.EqnType 19552 . 19803) (
|
||||
EQIO.EqnDataList 19805 . 20145) (EQIO.SetDataList 20147 . 20544) (EQIO.EqnData 20546 . 20725) (
|
||||
EQIO.EqnProperty 20727 . 21655) (EQIO.AllProps 21657 . 22172) (EQIO.Specify 22174 . 22671) (
|
||||
EQIO.GetInitialProps 22673 . 23805) (EQIO.NumPieces 23807 . 25050) (EQIO.NewStructure 25052 . 25542))
|
||||
(25611 30073 (EQIO.AddType 25621 . 26134) (EQIO.GetInfo 26136 . 26486) (EQIO.SetInfo 26488 . 27129) (
|
||||
EQIO.TypeProp 27131 . 28077) (EQIO.ResetTypeProps 28079 . 28401) (EQIO.IsDefined 28403 . 28688) (
|
||||
EQIO.GetBox 28690 . 28910) (EQIO.GetDataSpec 28912 . 29245) (EQIO.GetDataSpecList 29247 . 29392) (
|
||||
EQIO.GetDataPosition 29394 . 29534) (EQIO.GetDataSelectRegion 29536 . 29680) (EQIO.MakeSpec 29682 .
|
||||
29918) (EQIO.MakeDataSpec 29920 . 30071)) (31648 48752 (EQN.AbortEdit 31658 . 32170) (EQN.StopEdit
|
||||
32172 . 32619) (EQN.ContinueEdit 32621 . 36273) (EQN.FinishEdit 36275 . 37008) (EQN.MakeEditWindow
|
||||
37010 . 38429) (EQN.SetUpEdit 38431 . 39608) (EQN.StartEdit 39610 . 42911) (EQN.StartNextEdit 42913 .
|
||||
43430) (EQN.UpdateEdit 43432 . 44829) (EQN.DefaultData 44831 . 47516) (EQN.TypeMenu 47518 . 48750)) (
|
||||
48819 56727 (EQN.Equation 48829 . 50088) (EQN.NextPiece 50090 . 50815) (EQN.FinishEqn 50817 . 51346) (
|
||||
EQN.NoUpdateAbort 51348 . 51761) (EQN.PreventUpdate 51763 . 52198) (EQN.CharFn 52200 . 54285) (
|
||||
EQN.TEditSpecialChar 54287 . 55006) (EQN.SnuggleWindows 55008 . 55599) (EQN.SnuggleMainWindow 55601 .
|
||||
56725)) (56781 58520 (EQN.EquationFontNumber 56791 . 57550) (EQN.EquationFont 57552 . 57894) (
|
||||
EQN.GetEqnFont 57896 . 58077) (EQN.MakeFS 58079 . 58518)) (58549 61690 (EQN.AdjustWindow 58559 . 60519
|
||||
) (EQN.CheckWindowSize 60521 . 61688)) (61691 67455 (EQN.SubEditorP 61701 . 61934) (EQN.WindowFromText
|
||||
61936 . 62473) (EQN.EditWindow 62475 . 63553) (EQN.ResultWindow 63555 . 64105) (EQN.ResultObj 64107
|
||||
. 64575) (EQN.PieceNumber 64577 . 65126) (EQN.ContinueFlg 65128 . 65691) (EQN.ValidEditWindow 65693
|
||||
. 66127) (EQN.ObjEditWindow 66129 . 67453)) (67456 68573 (EQN.Make 67466 . 68571)) (69805 85740 (
|
||||
FS.Box 69815 . 72061) (FS.Copy 72063 . 72703) (FS.Display 72705 . 75691) (FS.Get 75693 . 76162) (
|
||||
FS.Put 76164 . 76635) (FS.ItemFont 76637 . 76998) (FS.ItemValue 77000 . 77406) (FS.ItemShift 77408 .
|
||||
77788) (FS.MakeItem 77790 . 78212) (FS.Extract 78214 . 82138) (FS.ExtractFont 82140 . 82743) (
|
||||
FS.ExtractShift 82745 . 83308) (FS.Insert 83310 . 85299) (FS.AllowedChar 85301 . 85538) (
|
||||
FS.RealStringP 85540 . 85738)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,29 +1,33 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "13-Oct-2023 11:18:04" {WMEDLEY}<lispusers>EXAMINEDEFS.;48 14244
|
||||
(FILECREATED "20-Jan-2025 22:00:44" {WMEDLEY}<lispusers>EXAMINEDEFS.;54 16352
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS EXAMINEDEFS TEDITDEF)
|
||||
:CHANGES-TO (FNS EXVV EXV)
|
||||
(COMMANDS exv)
|
||||
(VARS EXAMINEDEFSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "19-Jul-2023 13:59:26" {WMEDLEY}<lispusers>EXAMINEDEFS.;44)
|
||||
:PREVIOUS-DATE "12-Dec-2024 15:09:08" {WMEDLEY}<lispusers>EXAMINEDEFS.;53)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
|
||||
|
||||
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF)
|
||||
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF EXVV)
|
||||
(COMMANDS exv)
|
||||
(INITVARS (EXAMINEDEFS-PROCESS-LIST)
|
||||
(EXAMINEWITH 'COMPARETEXT))
|
||||
(FILES (SYSLOAD)
|
||||
COMPARETEXT)))
|
||||
COMPARETEXT VERSIONDEFS)))
|
||||
(DEFINEQ
|
||||
|
||||
(EXAMINEDEFS
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 13-Oct-2023 11:11 by rmk")
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 6-Dec-2024 20:51 by rmk")
|
||||
(* ; "Edited 13-Oct-2023 11:11 by rmk")
|
||||
(* ; "Edited 18-May-2023 22:35 by rmk")
|
||||
(* ; "Edited 21-Apr-2023 14:42 by rmk")
|
||||
|
||||
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as the definitions SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined. If both SOURCE1 and SOURCE2 are NIL, then SOURCE1 is the existing file defintions, NIL is the existing in-memory definition")
|
||||
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as the definitions SOURCE1 and SOURCE2 or, if NAME is given, the copies of the definitions of NAME as TYPE on the two sources are examined. If both SOURCE1 and SOURCE2 are NIL, then SOURCE1 is the existing file defintion, NIL is the existing in-memory definition")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -231,15 +235,49 @@
|
||||
(PRIN3 ")" TSTREAM)
|
||||
ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM)))
|
||||
TSTREAM])
|
||||
|
||||
(EXVV
|
||||
[LAMBDA (NAME TYPE FILE VERSION1 VERSION2) (* ; "Edited 20-Jan-2025 21:56 by rmk")
|
||||
(* ; "Edited 12-Dec-2024 15:09 by rmk")
|
||||
|
||||
(* ;; "Compares the definitions of NAME as TYPE on 2 different versions of FILE. TYPE and FILE can be elided, defaulting to NIL and WHEREIS respectively. Versions default to newest.")
|
||||
|
||||
(* ;; "If only one version specification, compares with the current (like the EXV command)")
|
||||
|
||||
(* ;; "(EXVV 'FOO -1 -2) will compare the newest and second-newest function definitions of FOO.")
|
||||
|
||||
(CL:UNLESS (AND (VERSIONP VERSION1)
|
||||
(VERSIONP VERSION2)) (* ; "Both versions, arguments are good")
|
||||
(if (VERSIONP TYPE)
|
||||
then (SETQ VERSION1 TYPE) (* ; "TYPE and FILE are NIL")
|
||||
(SETQ TYPE NIL)
|
||||
(CL:WHEN (VERSIONP FILE)
|
||||
(SETQ VERSION2 FILE)
|
||||
(SETQ FILE NIL))
|
||||
elseif (VERSIONP FILE)
|
||||
then (CL:WHEN (VERSIONP VERSION1) (* ; "Type is good, FILE is NIL")
|
||||
(SETQ VERSION2 VERSION1))
|
||||
(SETQ VERSION1 FILE)
|
||||
(SETQ FILE NIL)))
|
||||
(CL:UNLESS FILE
|
||||
(SETQ FILE (OR (CAR (WHEREIS NAME (OR TYPE '(FNS FUNCTIONS))
|
||||
T))
|
||||
(ERROR "Can't find " FILE " definition of " NAME))))
|
||||
(if (AND VERSION1 VERSION2)
|
||||
then (EXAMINEDEFS NAME TYPE (FINDFILEVERSION FILE VERSION1)
|
||||
(FINDFILEVERSION FILE VERSION2))
|
||||
else (EXAMINEDEFS NAME TYPE NIL (FINDFILEVERSION FILE (OR VERSION1 VERSION2 -1])
|
||||
)
|
||||
|
||||
(DEFCOMMAND exv (NAME TYPE FILE VERSION) (EXVV NAME TYPE FILE VERSION))
|
||||
|
||||
(RPAQ? EXAMINEDEFS-PROCESS-LIST )
|
||||
|
||||
(RPAQ? EXAMINEWITH 'COMPARETEXT)
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
COMPARETEXT)
|
||||
COMPARETEXT VERSIONDEFS)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (618 14102 (EXAMINEDEFS 628 . 10448) (EXAMINEFILES 10450 . 11932) (TEDITDEF 11934 .
|
||||
14100)))))
|
||||
(FILEMAP (NIL (736 16121 (EXAMINEDEFS 746 . 10675) (EXAMINEFILES 10677 . 12159) (TEDITDEF 12161 .
|
||||
14327) (EXVV 14329 . 16119)))))
|
||||
STOP
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user