Compare commits
47 Commits
medley-240
...
medley-250
| Author | SHA1 | Date | |
|---|---|---|---|
|
db98ea346b | ||
|
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 | ||
|
|
7ed120ca97 |
11
.github/ISSUE_TEMPLATE/bug_report.md
vendored
11
.github/ISSUE_TEMPLATE/bug_report.md
vendored
@@ -3,6 +3,7 @@ name: Bug report (not specific)
|
||||
about: Create a report to help us improve
|
||||
title: ''
|
||||
labels: ''
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
@@ -22,11 +23,13 @@ A clear and concise description of what you expected to happen.
|
||||
If applicable, add screenshots to help explain your problem.
|
||||
|
||||
**Context (please complete the following information):**
|
||||
- OS: [e.g. Mac/Linux/Cygwin]
|
||||
- OS Version: [e.g. High Siera/Ubuntu 18/Raspbian]
|
||||
- Host arch: [e.g. x86_64, arm7l, arm64, sparc]
|
||||
- Are you using online.interlisp.org? [yes / no]
|
||||
- OS: [e.g. macOS/Linux/Cygwin]
|
||||
- OS Version: [e.g. Ventura, Ubuntu 24, Raspberry Pi OS]
|
||||
- Display/window system: [e.g. X11, SDL, VNC, Web browser]
|
||||
- Host arch: [e.g. x86_64, arm7l, arm64, SPARC]
|
||||
- Maiko version: [e.g. commit ID from `git log | head`]
|
||||
- IL:MAKESYSDATE: [ date ]
|
||||
- `IL:MAKESYSDATE`: [ date ] or `(il:print-lisp-information)`: copy-paste or screenshot this
|
||||
|
||||
**Additional context**
|
||||
Add any other context about the problem here.
|
||||
|
||||
1
.github/ISSUE_TEMPLATE/documentation.md
vendored
1
.github/ISSUE_TEMPLATE/documentation.md
vendored
@@ -3,6 +3,7 @@ name: Documentation problem
|
||||
about: Problems with this web site?
|
||||
title: ''
|
||||
labels: ''
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
|
||||
1
.github/ISSUE_TEMPLATE/feature_request.md
vendored
1
.github/ISSUE_TEMPLATE/feature_request.md
vendored
@@ -3,6 +3,7 @@ name: Feature request
|
||||
about: Suggest an idea for this project
|
||||
title: ''
|
||||
labels: ''
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
|
||||
6
.github/workflows/buildDocker.yml
vendored
6
.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: |
|
||||
@@ -211,7 +211,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 }}
|
||||
|
||||
4
.github/workflows/buildReleaseInclDocker.yml
vendored
4
.github/workflows/buildReleaseInclDocker.yml
vendored
@@ -69,7 +69,7 @@ jobs:
|
||||
# the result of a workflow_dispatch or a workflow_call
|
||||
|
||||
inputs:
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
outputs:
|
||||
draft: ${{ steps.one.outputs.draft }}
|
||||
force: ${{ steps.one.outputs.force }}
|
||||
@@ -124,7 +124,7 @@ jobs:
|
||||
|
||||
# Kickoff workflow in online repo to build and deploy Medley docker image to oio
|
||||
do_oio:
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
needs: [inputs, do_docker]
|
||||
steps:
|
||||
- name: trigger-oio-buildAndDeploy
|
||||
|
||||
2
.github/workflows/doHCFILES.yml
vendored
2
.github/workflows/doHCFILES.yml
vendored
@@ -45,7 +45,7 @@ jobs:
|
||||
|
||||
run_HCFILES:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
steps:
|
||||
|
||||
|
||||
4
.gitignore
vendored
4
.gitignore
vendored
@@ -37,6 +37,10 @@ loadups/fuller.database
|
||||
|
||||
*.IMPTR
|
||||
|
||||
# (Accidentally) created sysouts at any level
|
||||
*.sysout
|
||||
*.SYSOUT
|
||||
|
||||
#compiled code -- leave in for now
|
||||
|
||||
# *.lcom
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,6 +1,6 @@
|
||||
MIT License
|
||||
|
||||
Copyright Interlisp.org contributors
|
||||
Copyright © 2024 Interlisp.org. Portions originally copyrighted by Xerox, Venue, John Sybalsky, and other contributors.
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
|
||||
1
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
|
||||
2456
internal/TEDIT-DEBUG
Normal file
2456
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.
311
library/IMAGEOBJ
311
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-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3 34260
|
||||
|
||||
: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-Dec-95 13:21:56" {WMEDLEY}<library>IMAGEOBJ.;1)
|
||||
|
||||
|
||||
(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,90 @@ 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-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.")
|
||||
(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 +724,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 +761,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 (2973 7469 (BITMAPTEDITOBJ 2983 . 3626) (COERCETOBITMAP 3628 . 5672) (WINDOWTITLEFONT
|
||||
5674 . 6021) (\PRINTBINARYBITMAP 6023 . 6814) (\READBINARYBITMAP 6816 . 7467)) (7520 23638 (
|
||||
BMOBJ.BUTTONEVENTINFN 7530 . 12076) (BMOBJ.COPYFN 12078 . 12704) (BMOBJ.DISPLAYFN 12706 . 16435) (
|
||||
BMOBJ.IMAGEBOXFN 16437 . 18852) (BMOBJ.PUTFN 18854 . 19786) (BMOBJ.INIT 19788 . 20827) (BMOBJ.GETFN5
|
||||
20829 . 21419) (BMOBJ.CREATE.MENU 21421 . 23636)) (23728 27012 (SCALED.BITMAP.GETFN 23738 . 24164) (
|
||||
BMOBJ.GETFN 24166 . 24701) (BMOBJ.GETFN2 24703 . 25188) (BMOBJ.GETFN3 25190 . 25978) (BMOBJ.GETFN4
|
||||
25980 . 27010)) (28947 34160 (GET.OBJ.FROM.USER 28957 . 30804) (BITMAPOBJ.SNAPW 30806 . 31932) (
|
||||
PROMPTFOREVALED 31934 . 34158)))))
|
||||
STOP
|
||||
|
||||
|
||||
Binary file not shown.
@@ -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.
Binary file not shown.
2122
library/tedit/TEDIT
2122
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.
1982
library/tedit/TEDIT-BUTTONS
Normal file
1982
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 "28-Nov-2024 10:03:03" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;133 49278
|
||||
|
||||
: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 "21-Nov-2024 11:53:19" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;128)
|
||||
|
||||
|
||||
(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,135 @@
|
||||
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 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 (* ;
|
||||
(OR (EQ TCH T)
|
||||
(SETQ CH TCH)))
|
||||
(SELECTC (AND CH (\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL))
|
||||
CH))
|
||||
(CHARDELETE.TTC
|
||||
(\TEDIT.CHARDELETE TSTREAM))
|
||||
(CHARDELETE.FORWARD.TTC
|
||||
(\TEDIT.CHARDELETE TSTREAM T))
|
||||
(WORDDELETE.TTC
|
||||
(\TEDIT.WORDDELETE TSTREAM))
|
||||
(WORDDELETE.FORWARD.TTC
|
||||
(\TEDIT.WORDDELETE.FORWARD TSTREAM))
|
||||
(DELETE.TTC (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)))
|
||||
(UNDO.TTC (* ;
|
||||
"Take off the BPD, the undoing and put it back on.")
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(TEDIT.UNDO TSTREAM))
|
||||
(REDO.TTC (* ;
|
||||
"He hit the REDO key, so go REDO something")
|
||||
(TEDIT.REDO 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 +393,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 +432,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 +441,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 +469,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 +911,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 26570 (\TEDIT.INTERRUPT.SETUP 8322 . 9969) (\TEDIT.MARKACTIVE 9971 . 10300) (
|
||||
\TEDIT.MARKINACTIVE 10302 . 10518) (\TEDIT.COMMAND.LOOP 10520 . 19978) (\TEDIT.COMMAND.RESET.SETUP
|
||||
19980 . 26568)) (26854 42051 (\TEDIT.READTABLE 26864 . 28521) (\TEDIT.WORDBOUND.READTABLE 28523 .
|
||||
31116) (TEDIT.GETSYNTAX 31118 . 33557) (TEDIT.SETSYNTAX 33559 . 36037) (TEDIT.GETFUNCTION 36039 .
|
||||
37399) (TEDIT.SETFUNCTION 37401 . 39840) (TEDIT.WORDGET 39842 . 40103) (TEDIT.WORDSET 40105 . 40802) (
|
||||
TEDIT.ATOMBOUND.READTABLE 40804 . 42049)) (42379 43288 (\TEDIT.WHEELSCROLL 42389 . 43286)) (43441
|
||||
49021 (\TEDIT.CLIPBOARD 43451 . 45206) (\TEDIT.COPYTOCLIPBOARD 45208 . 45988) (
|
||||
\TEDIT.EXTRACTTOCLIPBOARD 45990 . 46185) (\TEDIT.WRITE.SEL 46187 . 49019)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
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 " 8-Dec-2024 15:49:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;134 36434
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.BASICFIND \TEDIT.BASICFIND.BACKWARD \TEDIT.WCFIND.BACKWARD)
|
||||
:CHANGES-TO (FNS TEDIT.SUBSTITUTE)
|
||||
|
||||
:PREVIOUS-DATE "15-Mar-2024 14:10:05" {WMEDLEY}<library>tedit>TEDIT-FIND.;98)
|
||||
:PREVIOUS-DATE "26-Nov-2024 23:53:41" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;132)
|
||||
|
||||
|
||||
(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,220 @@
|
||||
|
||||
(* ;; "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 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 +302,30 @@
|
||||
(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.NORMALIZECARET TEXTOBJ) (* ; "And get it into the window")
|
||||
(\TEDIT.SHOWSEL SEL T))
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ))
|
||||
(FIELD (* ;
|
||||
"Update the selection for this textobj from the scratch sel returned from MBUTTON.FIND.NEXT.FIELD")
|
||||
(FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
|
||||
(\TEDIT.SHOWSEL SEL NIL) (* ;
|
||||
(\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.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 +338,227 @@
|
||||
(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 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 (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 21950 (TEDIT.FIND 794 . 2793) (TEDIT.FIND.BACKWARD 2795 . 5117) (TEDIT.SUBSTITUTE
|
||||
5119 . 17479) (TEDIT.NEXT 17481 . 21948)) (21983 36411 (\TEDIT.WCFIND 21993 . 25512) (\TEDIT.BASICFIND
|
||||
25514 . 27605) (\TEDIT.WCFIND.BACKWARD 27607 . 31071) (\TEDIT.BASICFIND.BACKWARD 31073 . 33330) (
|
||||
\TEDIT.PARSE.SEARCHSTRING 33332 . 36409)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -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 "24-Jan-2025 15:31:33" {WMEDLEY}<library>TEDIT>TEDIT-FNKEYS.;109 40128
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.LCASE.SEL \TEDIT.UCASE.SEL \TEDIT.KEY.FIND)
|
||||
:CHANGES-TO (FNS \TEDIT.ONECHAR.BACKWARD \TEDIT.ONECHAR.FORWARD)
|
||||
|
||||
:PREVIOUS-DATE " 9-Mar-2024 11:47:31" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;69)
|
||||
:PREVIOUS-DATE "18-Jan-2025 23:38:11" {WMEDLEY}<library>TEDIT>TEDIT-FNKEYS.;108)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
|
||||
@@ -17,12 +17,14 @@
|
||||
|
||||
(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 \TEDIT.ONECHAR.BACKWARD
|
||||
\TEDIT.ONECHAR.FORWARD))
|
||||
(COMS
|
||||
(* ;; "Auxiliary functions used in the above main functions:")
|
||||
|
||||
@@ -69,12 +71,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 +90,11 @@
|
||||
("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]
|
||||
(P (MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY)
|
||||
(SELECTQ (CADR ENTRY)
|
||||
(FN (TEDIT.SETFUNCTION (CAR ENTRY)
|
||||
@@ -164,92 +174,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 +330,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 +340,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 +390,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 +400,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 +429,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 +440,70 @@
|
||||
(* ;; "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])
|
||||
|
||||
(\TEDIT.ONECHAR.BACKWARD
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "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)))
|
||||
(CL:UNLESS (ILEQ PT 1)
|
||||
(\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 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.")
|
||||
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(LET ((PT (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
(CL:UNLESS (IGEQ PT (TEXTLEN TEXTOBJ))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL (ADD1 PT)
|
||||
0
|
||||
'LEFT)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ))])
|
||||
)
|
||||
|
||||
|
||||
@@ -511,13 +623,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 +698,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 +717,11 @@
|
||||
("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)))
|
||||
|
||||
[MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY)
|
||||
(SELECTQ (CADR ENTRY)
|
||||
@@ -609,21 +730,23 @@
|
||||
(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 (6251 29984 (\TEDIT.BOLD.SEL.OFF 6261 . 6599) (\TEDIT.BOLD.SEL.ON 6601 . 6929) (
|
||||
\TEDIT.CENTER.SEL 6931 . 8447) (\TEDIT.CENTER.SEL.REV 8449 . 8745) (\TEDIT.DEFAULTS.CARET 8747 . 9240)
|
||||
(\TEDIT.DEFAULTSSEL 9242 . 9689) (\TEDIT.SETDEFAULT.FROM.SEL 9691 . 10368) (\TEDIT.KEY.FIND 10370 .
|
||||
15437) (\TEDIT.KEY.FIND.SEARCHSTRING 15439 . 16579) (\TEDIT.GET.TARGET.STRING 16581 . 18295) (
|
||||
\TEDIT.KEY.FIND.BACKWARD 18297 . 18602) (\TEDIT.FINDAGAIN.BACKWARD 18604 . 19015) (\TEDIT.FINDAGAIN
|
||||
19017 . 19308) (\TEDIT.ITALIC.SEL.OFF 19310 . 19562) (\TEDIT.ITALIC.SEL.ON 19564 . 19757) (
|
||||
\TEDIT.LARGERSEL 19759 . 20047) (\TEDIT.LCASE.SEL 20049 . 21444) (\TEDIT.SHOWCARETLOOKS 21446 . 23046)
|
||||
(\TEDIT.SMALLERSEL 23048 . 23339) (\TEDIT.SUBSCRIPTSEL 23341 . 23544) (\TEDIT.SUPERSCRIPTSEL 23546 .
|
||||
23750) (\TEDIT.UCASE.SEL 23752 . 25091) (\TEDIT.UNDERLINE.SEL.OFF 25093 . 25291) (
|
||||
\TEDIT.UNDERLINE.SEL.ON 25293 . 25489) (\TEDIT.STRIKEOUT.SEL.ON 25491 . 25687) (
|
||||
\TEDIT.STRIKEOUT.SEL.OFF 25689 . 25887) (\TEDIT.SELECT.ALL 25889 . 26205) (\TEDIT.KEY.SUBSTITUTE 26207
|
||||
. 26428) (\TEDIT.MANPAGE 26430 . 27677) (\TEDIT.CALL.ED 27679 . 28509) (\TEDIT.ONECHAR.BACKWARD 28511
|
||||
. 29216) (\TEDIT.ONECHAR.FORWARD 29218 . 29982)) (30056 36567 (\TEDIT.BOLD.CARET.OFF 30066 . 30601) (
|
||||
\TEDIT.BOLD.CARET.ON 30603 . 31135) (\TEDIT.ITALIC.CARET.OFF 31137 . 31674) (\TEDIT.ITALIC.CARET.ON
|
||||
31676 . 32219) (\TEDIT.LARGER.CARET 32221 . 32756) (\TEDIT.SMALLER.CARET 32758 . 33295) (
|
||||
\TEDIT.SUBSCRIPT.CARET 33297 . 33838) (\TEDIT.SUPERSCRIPT.CARET 33840 . 34382) (
|
||||
\TEDIT.UNDERLINE.CARET.OFF 34384 . 34924) (\TEDIT.UNDERLINE.CARET.ON 34926 . 35464) (
|
||||
\TEDIT.STRIKEOUT.CARET.OFF 35466 . 36006) (\TEDIT.STRIKEOUT.CARET.ON 36008 . 36565)) (36636 37338 (
|
||||
\TK.DESCRIBEFONT 36646 . 37336)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Apr-2024 09:12:32" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;153 33754
|
||||
(FILECREATED "13-Dec-2024 23:51:23" {WMEDLEY}<library>tedit>TEDIT-HCPY.;164 32996
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE)
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE TEDIT.HARDCOPYFN)
|
||||
|
||||
:PREVIOUS-DATE "20-Mar-2024 11:05:37" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;152)
|
||||
:PREVIOUS-DATE "26-Oct-2024 11:05:00" {WMEDLEY}<library>tedit>TEDIT-HCPY.;160)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
|
||||
@@ -87,9 +87,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 +103,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 +128,14 @@
|
||||
'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 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 +158,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 +232,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 +256,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
|
||||
|
||||
@@ -272,13 +277,14 @@
|
||||
|
||||
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 26-Oct-2024 11:04 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 17:22 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 23:19 by rmk")
|
||||
(* ; "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 (GETPARA FMTSPEC FMTPARATYPE)
|
||||
(PAGEHEADING
|
||||
(* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.")
|
||||
|
||||
@@ -287,11 +293,11 @@
|
||||
T)
|
||||
(EVEN (* ; "Skip an odd page.")
|
||||
(CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
T))
|
||||
(ODD (* ; "Skip an even page")
|
||||
(CL:WHEN (EVENP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
T))
|
||||
NIL])
|
||||
|
||||
@@ -337,7 +343,8 @@
|
||||
(MOVETO CURX CURY PRSTREAM])
|
||||
|
||||
(\TEDIT.HCPYFMTSPEC
|
||||
[LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 15-Mar-2024 19:34 by rmk")
|
||||
[LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "Edited 28-Jul-2024 22:25 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:34 by rmk")
|
||||
(* ; "Edited 7-Mar-2023 21:03 by rmk")
|
||||
(* ; "Edited 6-Mar-2023 15:14 by rmk")
|
||||
(* ; "Edited 20-Oct-2022 22:35 by rmk")
|
||||
@@ -346,44 +353,31 @@
|
||||
|
||||
(* ;; "Given a display-type FMTSPEC, 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 FMTSPEC using DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
|
||||
(HCSCALE SCALE (FGETPARA DISPLAYFMT 1STLEFTMAR))
|
||||
LEFTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEFTMAR))
|
||||
RIGHTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT RIGHTMAR))
|
||||
QUAD _ (FGETPARA DISPLAYFMT QUAD DISPLAYFMT)
|
||||
FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPARA DISPLAYFMT FMTDEFAULTTAB))
|
||||
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPARA DISPLAYFMT FMTTABS)
|
||||
SCALE)
|
||||
FMTSPECIALX _ (AND (FGETPARA DISPLAYFMT FMTSPECIALX)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA
|
||||
DISPLAYFMT
|
||||
FMTSPECIALX)
|
||||
1.0 NIL)))
|
||||
FMTSPECIALY _ (AND (FGETPARA DISPLAYFMT FMTSPECIALY)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA
|
||||
DISPLAYFMT
|
||||
FMTSPECIALY)
|
||||
1.0 NIL)))
|
||||
LEADBEFORE _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADBEFORE))
|
||||
LEADAFTER _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADAFTER))
|
||||
LINELEAD _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LINELEAD))
|
||||
FMTBASETOBASE _ (AND (FGETPARA DISPLAYFMT FMTBASETOBASE)
|
||||
(HCSCALE SCALE (FGETPARA DISPLAYFMT
|
||||
FMTBASETOBASE])
|
||||
|
||||
(\TEDIT.INTEGER.IMAGEBOX
|
||||
[LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52")
|
||||
@@ -451,7 +445,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 +455,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 +555,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 (3492 26205 (TEDIT.HARDCOPY 3502 . 4635) (\TEDIT.PRINT.MENU 4637 . 5603) (TEDIT.HCPYFILE
|
||||
5605 . 7779) (\TEDIT.HARDCOPY.DISPLAYLINE 7781 . 17682) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17684 .
|
||||
19183) (\TEDIT.HARDCOPY.MODIFYLOOKS 19185 . 21419) (\TEDIT.HCPYFMTSPEC 21421 . 24534) (
|
||||
\TEDIT.INTEGER.IMAGEBOX 24536 . 25207) (\TEDIT.DISPLAY.DIACRITIC 25209 . 26203)) (26280 27110 (
|
||||
\TEDIT.SCALEREGION 26290 . 27108)) (27369 30909 (TEDIT.HARDCOPYFN 27379 . 28684) (
|
||||
\TEDIT.HARDCOPYFILEFN 28686 . 29247) (\TEDIT.POSTSCRIPT.HARDCOPY 29249 . 30180) (\TEDIT.PRESS.HARDCOPY
|
||||
30182 . 30907)) (32172 32973 (TEDIT-BOOK 32182 . 32971)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,21 +1,25 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Mar-2024 11:05:20" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;154 33348
|
||||
(FILECREATED " 8-Dec-2024 19:41:55" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;219 53094
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.UNDO)
|
||||
:CHANGES-TO (FNS TEDIT.UNDO \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS \TEDIT.UNDO.UNDO
|
||||
TEDIT.REDO \TEDIT.HISTORYADD.COMPOSITE \TEDIT.UNDO.MOVE \TEDIT.UNDO.COMPOSITE
|
||||
\TEDIT.COMPOSITE.EVENT)
|
||||
(VARS TEDIT-HISTORYCOMS)
|
||||
(MACROS \TEDIT.HISTORYADD1)
|
||||
|
||||
:PREVIOUS-DATE "15-Mar-2024 13:55:42" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;153)
|
||||
:PREVIOUS-DATE " 7-Dec-2024 21:26:15" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;213)
|
||||
|
||||
|
||||
(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 +27,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 +54,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 +87,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 +118,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 +157,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 +175,73 @@
|
||||
|
||||
(* ;; "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 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")
|
||||
(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 +257,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 +328,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 +348,123 @@
|
||||
|
||||
(* ;; "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 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 +473,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 TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
|
||||
SEL))
|
||||
(:ParaLooks (* ; "It was a Paragraph looks change")
|
||||
(\TEDIT.CHANGE.PARALOOKS TEXTOBJ (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 +559,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 +594,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 +613,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 +648,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 +829,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 (5191 6212 (\TEDIT.HISTORYEVENT.DEFPRINT 5201 . 6210)) (7302 17740 (\TEDIT.HISTORYADD
|
||||
7312 . 12173) (\TEDIT.HISTORYADD.COMPOSITE 12175 . 12934) (\TEDIT.CUMULATE.EVENTS 12936 . 14530) (
|
||||
\TEDIT.COMPOSITE.EVENT 14532 . 15268) (\TEDIT.HISTORY.PROP 15270 . 16633) (\TEDIT.HISTORY.EVENT 16635
|
||||
. 17564) (\TEDIT.POPEVENT 17566 . 17738)) (17793 35623 (TEDIT.UNDO 17803 . 22197) (\TEDIT.UNDO1 22199
|
||||
. 26411) (TEDIT.REDO 26413 . 32777) (\TEDIT.UNDO.UNDO 32779 . 35621)) (35624 50710 (
|
||||
\TEDIT.UNDO.INSERT 35634 . 36547) (\TEDIT.UNDO.DELETE 36549 . 37343) (\TEDIT.UNDO.MOVE 37345 . 38934)
|
||||
(\TEDIT.UNDO.REPLACE 38936 . 40032) (\TEDIT.UNDO.CHARLOOKS 40034 . 44608) (\TEDIT.UNDO.PARALOOKS 44610
|
||||
. 48842) (\TEDIT.UNDO.PAGELOOKS 48844 . 49253) (\TEDIT.UNDO.COMPOSITE 49255 . 50482) (
|
||||
\TEDIT.UNDO.REPLACECODE 50484 . 50708)) (50711 53071 (\TEDIT.REDO.INSERT 50721 . 51454) (
|
||||
\TEDIT.REDO.REPLACE 51456 . 52787) (\TEDIT.REDO.COMPOSITE 52789 . 53069)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Mar-2024 11:06:42" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;11 73247
|
||||
(FILECREATED "23-Oct-2024 16:09:28" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;27 72985
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.GET.PCTB2 \TEDIT.GET.PCTB1)
|
||||
:CHANGES-TO (FNS \TEDIT.GET.SINGLE.PARALOOKS2 \TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;10)
|
||||
:PREVIOUS-DATE "21-Oct-2024 00:34:06" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;25)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-OLDFILECOMS)
|
||||
@@ -46,7 +46,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB2
|
||||
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 20-Mar-2024 11:00 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:28 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:00 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 14:37 by rmk")
|
||||
(* ; "Edited 21-Jan-2024 10:21 by rmk")
|
||||
@@ -65,9 +67,10 @@
|
||||
|
||||
(* ;; "END = use this as eofptr of file. For use in reading files within files.")
|
||||
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(LET (PIECEINFOCH# (CURFILECH# (OR START 0))
|
||||
LOOKSHASH PARAHASH)
|
||||
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
||||
PIECEINFOCH#
|
||||
(CURFILECH# (OR START 0))
|
||||
LOOKSHASH PARAHASH)
|
||||
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
|
||||
8))
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
@@ -167,8 +170,7 @@
|
||||
PPARALOOKS _ OLDPARALOOKS
|
||||
PTYPE _ OBJECT.PTYPE
|
||||
PBYTESPERCHAR _ PCLEN))
|
||||
(\TEDIT.GET.OBJECT (FGETTOBJ TEXTOBJ STREAMHINT)
|
||||
PC TEXT CURFILECH# PCLEN)
|
||||
(\TEDIT.GET.OBJECT TSTREAM PC TEXT CURFILECH# PCLEN)
|
||||
(add CURFILECH# PCLEN)
|
||||
(FSETPC PC PLOOKS (if (ZEROP (BIN TEXT))
|
||||
then
|
||||
@@ -182,7 +184,7 @@
|
||||
"There are new character looks for this object. Read them in.")
|
||||
|
||||
(\TEDIT.GET.SINGLE.CHARLOOKS2 TEXT))))
|
||||
(SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
|
||||
(\TEDIT.THELP "Impossible piece-type code in BUILD.PCTB"))
|
||||
(CL:WHEN PC (* ;
|
||||
"If we created a piece, save it in the table.")
|
||||
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
|
||||
@@ -273,7 +275,8 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS2 FILE])
|
||||
|
||||
(\TEDIT.GET.SINGLE.CHARLOOKS2
|
||||
[LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:53 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 22:53 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 23:22 by rmk")
|
||||
(* ; "Edited 7-Nov-2023 22:00 by rmk")
|
||||
@@ -298,7 +301,7 @@
|
||||
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
|
||||
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
|
||||
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
|
||||
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
|
||||
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
|
||||
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
|
||||
(SETQ CLSIZE SIZE)
|
||||
(SETQ CLOFFSET SUPER))
|
||||
@@ -328,76 +331,68 @@
|
||||
(RETURN LOOKS])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.PARALOOKS2
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 16-Jan-2024 23:01 by rmk")
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:25 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 16:07 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 23:01 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:14 by rmk")
|
||||
(* ; "Edited 3-Mar-2023 23:23 by rmk")
|
||||
(* ; "Edited 30-May-91 20:33 by jds")
|
||||
(* ;
|
||||
"Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
|
||||
(PROG (DEFTAB TABSPECS OUTPUTFORMAT LEN)
|
||||
(\SMALLPOUT FILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS))
|
||||
(* ;
|
||||
(PROG (DEFTAB TABS OUTPUTFORMAT LEN)
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS 1STLEFTMAR)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS))
|
||||
(* ;
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LEFTMAR)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(\SMALLPOUT FILE (fetch (FMTSPEC RIGHTMAR) of LOOKS))
|
||||
(* ; "Right margin for the paragraph")
|
||||
(\SMALLPOUT FILE (fetch (FMTSPEC LEADBEFORE) of LOOKS))
|
||||
(* ; "Leading before the paragraph")
|
||||
(\SMALLPOUT FILE (fetch (FMTSPEC LEADAFTER) of LOOKS))
|
||||
(* ; "Lead after the paragraph")
|
||||
(\SMALLPOUT FILE (fetch (FMTSPEC LINELEAD) of LOOKS))
|
||||
(* ; "inter-line leading")
|
||||
(SETQ DEFTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS)))
|
||||
(SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS)))
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LEADAFTER)) (* ; "Lead after the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LINELEAD)) (* ; "inter-line leading")
|
||||
(SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB))
|
||||
(SETQ TABS (FGETPARA LOOKS FMTTABS))
|
||||
(COND
|
||||
((AND (fetch (FMTSPEC TABSPEC) of LOOKS)
|
||||
(OR DEFTAB TABSPECS)) (* ;
|
||||
((AND (OR DEFTAB TABS)) (* ;
|
||||
"There are tab specs to save, or there is a default tab setting to save")
|
||||
(\BOUT FILE 3))
|
||||
(T (* ;
|
||||
"There are no tab looks. Just let him go.")
|
||||
(\BOUT FILE 2)))
|
||||
(\BOUT FILE (SELECTQ (fetch (FMTSPEC QUAD) of LOOKS)
|
||||
(\BOUT FILE (SELECTQ (FGETPARA LOOKS QUAD)
|
||||
(LEFT 1)
|
||||
(RIGHT 2)
|
||||
((CENTER CENTERED)
|
||||
3)
|
||||
((JUST JUSTIFIED)
|
||||
4)
|
||||
(SHOULDNT)))
|
||||
[COND
|
||||
((OR TABSPECS DEFTAB) (* ; "There are tab specs to save.")
|
||||
(COND
|
||||
(DEFTAB (\SMALLPOUT FILE DEFTAB))
|
||||
(T (\SMALLPOUT FILE 0)))
|
||||
(\BOUT FILE (LENGTH TABSPECS))
|
||||
(COND
|
||||
(TABSPECS (* ; "# of tab settings <256!")
|
||||
(for TAB in TABSPECS do (\SMALLPOUT FILE (fetch TABX of TAB))
|
||||
(* ; "And setting.")
|
||||
(\BOUT FILE (SELECTQ (fetch TABKIND of TAB)
|
||||
(LEFT 0)
|
||||
(RIGHT 1)
|
||||
(CENTERED 2)
|
||||
(DECIMAL 3)
|
||||
(SHOULDNT)))
|
||||
(* ; "Tab type")]
|
||||
(\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALX) of LOOKS)
|
||||
(\TEDIT.THELP)))
|
||||
(CL:WHEN (OR TABS DEFTAB) (* ; "There are tab specs to save.")
|
||||
(\SMALLPOUT FILE (OR DEFTAB 0))
|
||||
(\BOUT FILE (LENGTH TABS))
|
||||
(CL:WHEN TABS (* ; "# of tab settings <256!")
|
||||
[for TAB in TABS do (\SMALLPOUT FILE (fetch (TAB TABX) of TAB))
|
||||
(* ; "And setting and type")
|
||||
(\BOUT FILE (SELECTQ (fetch (TAB TABKIND) of TAB)
|
||||
(LEFT 0)
|
||||
(RIGHT 1)
|
||||
(CENTERED 2)
|
||||
(DECIMAL 3)
|
||||
(\TEDIT.THELP]))
|
||||
(\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALX)
|
||||
0))
|
||||
(\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS)
|
||||
(\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALY)
|
||||
0))
|
||||
(\ARBOUT FILE (fetch (FMTSPEC FMTUSERINFO) of LOOKS))
|
||||
(\ATMOUT FILE (fetch (FMTSPEC FMTPARATYPE) of LOOKS))
|
||||
(\ATMOUT FILE (fetch (FMTSPEC FMTPARASUBTYPE) of LOOKS))
|
||||
(\ARBOUT FILE (fetch (FMTSPEC FMTSTYLE) of LOOKS))
|
||||
(\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS))
|
||||
(\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS))
|
||||
(\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEAFTER) of LOOKS])
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTUSERINFO))
|
||||
(\ATMOUT FILE (FGETPARA LOOKS FMTPARATYPE))
|
||||
(\ATMOUT FILE (FGETPARA LOOKS FMTPARASUBTYPE))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTSTYLE))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEBEFORE))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEAFTER])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.CHARLOOKS2
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 16-Jan-2024 23:01 by rmk")
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 23:01 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:14 by rmk")
|
||||
(* ; "Edited 30-May-91 20:26 by jds")
|
||||
(* ;
|
||||
@@ -468,7 +463,7 @@
|
||||
NIL 4)
|
||||
(T 0))
|
||||
(COND
|
||||
((fetch (CHARLOOKS CLSELHERE) of LOOKS)
|
||||
((fetch (CHARLOOKS CLSELAFTER) of LOOKS)
|
||||
2)
|
||||
(T 0))
|
||||
(COND
|
||||
@@ -484,69 +479,65 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS2 FILE])
|
||||
|
||||
(\TEDIT.GET.SINGLE.PARALOOKS2
|
||||
[LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:54 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:07 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:48 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:22 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:35 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 22:54 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
(* ; "Edited 3-Mar-2023 23:18 by rmk")
|
||||
(* ; "Edited 1-Aug-2022 12:04 by rmk")
|
||||
(* ; "Edited 30-May-91 20:33 by jds")
|
||||
(* ;
|
||||
"Read a paragraph format spec from the FILE, and return it for later use.")
|
||||
(PROG ((LOOKS (create FMTSPEC))
|
||||
TABFLG DEFTAB TABCOUNT TABS TABSPEC)
|
||||
(replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
TABFLG DEFTAB TABS)
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "Right margin for the paragraph")
|
||||
(replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "Leading before the paragraph")
|
||||
(replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "Lead after the paragraph")
|
||||
(replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "inter-line leading")
|
||||
(replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS DEFAULTTAB NIL)))
|
||||
(* ; "Will be tab specs")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(replace (FMTSPEC QUAD) of LOOKS with (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(SHOULDNT)))
|
||||
(COND
|
||||
((NOT (ZEROP (LOGAND TABFLG 1))) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(SETQ TABCOUNT (BIN FILE))
|
||||
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
(SELECTQ (BIN FILE)
|
||||
(0 'LEFT)
|
||||
(1 'RIGHT)
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(SHOULDNT]
|
||||
(CL:UNLESS (ZEROP DEFTAB)
|
||||
(RPLACA TABSPEC DEFTAB))
|
||||
(RPLACD TABSPEC TABS)))
|
||||
[COND
|
||||
((NOT (ZEROP (LOGAND TABFLG 2))) (* ;
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(CL:WHEN (ILEQ DEFTAB 1)
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
(SELECTQ (BIN FILE)
|
||||
(0 'LEFT)
|
||||
(1 'RIGHT)
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE))
|
||||
(replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE))
|
||||
(replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE))
|
||||
(replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE))
|
||||
(replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE))
|
||||
(replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE))
|
||||
(replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE))
|
||||
(replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE]
|
||||
(RETURN LOOKS])
|
||||
(FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
|
||||
FMT])
|
||||
|
||||
(\TEDIT.PUT.CHARLOOKS.LIST2
|
||||
[LAMBDA (FILE LOOKSLIST) (* ; "Edited 16-Jan-2024 23:02 by rmk")
|
||||
@@ -600,7 +591,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB1
|
||||
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 20-Mar-2024 11:00 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:28 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:00 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 21-Jan-2024 10:23 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
@@ -619,8 +612,9 @@
|
||||
|
||||
(* ;; "END = use this as eofptr of file. For use in reading files within files.")
|
||||
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(LET (PIECEINFOCH# TSTREAM (CURFILECH# (OR START 0)))
|
||||
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
||||
PIECEINFOCH#
|
||||
(CURFILECH# (OR START 0)))
|
||||
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
|
||||
8))
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
@@ -675,8 +669,7 @@
|
||||
PPARALOOKS _ OLDPARALOOKS
|
||||
PTYPE _ THINFILE.PTYPE
|
||||
PBYTESPERCHAR _ PCLEN))
|
||||
(TEDIT.GET.OBJECT1 (FGETTOBJ TEXTOBJ STREAMHINT)
|
||||
PC TEXT CURFILECH#)
|
||||
(TEDIT.GET.OBJECT1 TSTREAM PC TEXT CURFILECH#)
|
||||
(add CURFILECH# PCLEN)
|
||||
[COND
|
||||
((NOT (ZEROP (BIN TEXT))) (* ;
|
||||
@@ -689,7 +682,7 @@
|
||||
"No new looks; steal them from the prior piece.")
|
||||
(FSETPC PC PLOOKS (OR (AND OLDPC (PLOOKS OLDPC))
|
||||
DEFAULTCHARLOOKS])
|
||||
(SHOULDNT "Impossible piece-type code"))
|
||||
(\TEDIT.THELP "Impossible piece-type code"))
|
||||
(CL:WHEN PC
|
||||
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
|
||||
(SETQ OLDPC PC)) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
|
||||
@@ -702,7 +695,8 @@
|
||||
(\TEDIT.PARSE.PAGEFRAMES1 (READ FILE])
|
||||
|
||||
(\TEDIT.PARSE.PAGEFRAMES1
|
||||
[LAMBDA (PAGELIST PARENT) (* ; "Edited 7-Nov-2023 13:27 by rmk")
|
||||
[LAMBDA (PAGELIST PARENT) (* ; "Edited 30-Aug-2024 15:43 by rmk")
|
||||
(* ; "Edited 7-Nov-2023 13:27 by rmk")
|
||||
(* ; "Edited 8-Mar-2023 18:14 by rmk")
|
||||
(* ; "Edited 4-Oct-2022 16:57 by rmk")
|
||||
(* ; "Edited 1-Oct-2022 16:02 by rmk")
|
||||
@@ -736,10 +730,14 @@
|
||||
collect (\TEDIT.PARSE.PAGEFRAMES1 ALIST
|
||||
PAGEFRAME)))
|
||||
PAGEFRAME)
|
||||
(T (for FRAMESPEC in (CAR PAGELIST) collect (\TEDIT.PARSE.PAGEFRAMES1 FRAMESPEC NIL])
|
||||
(T (SETQ PAGELIST (CAR PAGELIST))
|
||||
(TEDIT.COMPOUND.PAGEFORMAT (\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST))
|
||||
(\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST))
|
||||
(\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST])
|
||||
|
||||
(\TEDIT.GET.CHARLOOKS1
|
||||
[LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 22:55 by rmk")
|
||||
[LAMBDA (PC FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 22:55 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 23:21 by rmk")
|
||||
(* ; "Edited 7-Nov-2023 22:02 by rmk")
|
||||
@@ -776,7 +774,7 @@
|
||||
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
|
||||
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
|
||||
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
|
||||
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
|
||||
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
|
||||
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
|
||||
(SETQ CLSIZE SIZE)
|
||||
(SETQ CLOFFSET SUPER))
|
||||
@@ -805,7 +803,11 @@
|
||||
(replace (CHARLOOKS CLFONT) of LOOKS with FONT])
|
||||
|
||||
(\TEDIT.GET.PARALOOKS1
|
||||
[LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:55 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:08 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:48 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 22:00 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 22:55 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
(* ; "Edited 27-Oct-2023 13:00 by rmk")
|
||||
(* ; "Edited 3-Mar-2023 23:20 by rmk")
|
||||
@@ -813,63 +815,57 @@
|
||||
(* ; "Edited 30-May-91 20:34 by jds")
|
||||
(* ;
|
||||
"Read a paragraph format spec from the FILE, and return it for later use.")
|
||||
(LET ((LOOKS (create FMTSPEC))
|
||||
TABFLG DEFTAB TABCOUNT TABS TABSPEC)
|
||||
(replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
TABFLG DEFTAB)
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "Right margin for the paragraph")
|
||||
(replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "Leading before the paragraph")
|
||||
(replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "Lead after the paragraph")
|
||||
(replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "inter-line leading")
|
||||
(replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS DEFAULTTAB NIL)))
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(* ; "Will be tab specs")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(replace (FMTSPEC QUAD) of LOOKS with (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(SHOULDNT)))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(SETQ TABCOUNT (BIN FILE))
|
||||
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
(SELECTQ (BIN FILE)
|
||||
(0 'LEFT)
|
||||
(1 'RIGHT)
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(SHOULDNT]
|
||||
(CL:UNLESS (ZEROP DEFTAB)
|
||||
(RPLACA TABSPEC DEFTAB))
|
||||
(RPLACD TABSPEC TABS))
|
||||
(CL:WHEN (ILEQ DEFTAB 1)
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[FSETPARA FMT FMTTABS (for TAB# from 1 to (BIN FILE)
|
||||
collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _ (SELECTQ (BIN FILE)
|
||||
(0 'LEFT)
|
||||
(1 'RIGHT)
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP])
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE))
|
||||
(replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE))
|
||||
(replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE))
|
||||
(replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE))
|
||||
(replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE))
|
||||
(replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE))
|
||||
(replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE))
|
||||
(replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE)))
|
||||
LOOKS])
|
||||
(FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
|
||||
FMT])
|
||||
|
||||
(TEDIT.GET.OBJECT1
|
||||
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 27-Oct-2023 12:58 by rmk")
|
||||
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk")
|
||||
(* ; "Edited 27-Oct-2023 12:58 by rmk")
|
||||
(* ; "Edited 6-Aug-2022 09:11 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:17 by mitani")
|
||||
|
||||
@@ -891,7 +887,8 @@
|
||||
(FSETPC PIECE PLOOKS (if (PREVPIECE PIECE)
|
||||
then (PLOOKS (PREVPIECE PIECE))
|
||||
elseif (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)
|
||||
else (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)
|
||||
else (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
|
||||
DEFAULTFONT)
|
||||
TEXTOBJ)))
|
||||
(PCONTENTS PIECE])
|
||||
)
|
||||
@@ -903,7 +900,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB0
|
||||
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:27 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 14:47 by rmk")
|
||||
(* ; "Edited 21-Jan-2024 10:27 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
@@ -915,8 +914,9 @@
|
||||
|
||||
(* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE")
|
||||
|
||||
(LET (OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
|
||||
(SBINABLE (fetch (STREAM BINABLE) of TEXT)))
|
||||
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
||||
OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
|
||||
(SBINABLE (fetch (STREAM BINABLE) of TEXT)))
|
||||
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
|
||||
8))
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
@@ -943,8 +943,7 @@
|
||||
(\TEDIT.GET.CHARLOOKS0 PC TEXT)
|
||||
(add CURFILECH# (PLEN PC)))
|
||||
(\PieceDescriptorOBJECT
|
||||
(\TEDIT.GET.OBJECT0 (AND TEXTOBJ (FGETTOBJ TEXTOBJ STREAMHINT))
|
||||
PC TEXT CURFILECH#)
|
||||
(\TEDIT.GET.OBJECT0 TSTREAM PC TEXT CURFILECH#)
|
||||
(add CURFILECH# (PLEN PC)) (* ;
|
||||
"Only object--can't be followed by either of the others.")
|
||||
(FSETPC PC PLEN 1))
|
||||
@@ -958,12 +957,13 @@
|
||||
(\TEDIT.GET.CHARLOOKS0 PC TEXT) (* ; "This document is 'formatted' .")
|
||||
(add CURFILECH# (PLEN PC))
|
||||
(AND TEXTOBJ (FSETTOBJ TEXTOBJ FORMATTEDP T)))
|
||||
(SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
|
||||
(\TEDIT.THELP "Impossible piece-type code in BUILD.PCTB"))
|
||||
(SETQ OLDPC PC)
|
||||
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
|
||||
|
||||
(\TEDIT.GET.CHARLOOKS0
|
||||
[LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 23:03 by rmk")
|
||||
[LAMBDA (PC FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 23:03 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
(* ; "Edited 1-Aug-2022 12:04 by rmk")
|
||||
(* ; "Edited 30-May-91 20:26 by jds")
|
||||
@@ -1007,7 +1007,7 @@
|
||||
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
|
||||
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
|
||||
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
|
||||
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
|
||||
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
|
||||
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
|
||||
(SETQ CLSIZE SIZE)
|
||||
(SETQ CLOFFSET SUPER))
|
||||
@@ -1027,7 +1027,8 @@
|
||||
'ITALIC])
|
||||
|
||||
(\TEDIT.GET.OBJECT0
|
||||
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 6-Aug-2022 15:57 by rmk")
|
||||
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk")
|
||||
(* ; "Edited 6-Aug-2022 15:57 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:17 by mitani")
|
||||
|
||||
(* ;; "Get an object from the file")
|
||||
@@ -1051,71 +1052,70 @@
|
||||
(T (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS)
|
||||
of TEXTOBJ)
|
||||
(\TEDIT.UNIQUIFY.CHARLOOKS (
|
||||
CHARLOOKS.FROM.FONT
|
||||
\TEDIT.CHARLOOKS.FROM.FONT
|
||||
DEFAULTFONT)
|
||||
TEXTOBJ]
|
||||
OBJ])
|
||||
|
||||
(\TEDIT.GET.PARALOOKS0
|
||||
[LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 22:57 by rmk")
|
||||
[LAMBDA (PC FILE) (* ; "Edited 23-Oct-2024 16:09 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:47 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:23 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 22:23 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 22:57 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
(* ; "Edited 3-Mar-2023 23:14 by rmk")
|
||||
(* ; "Edited 1-Aug-2022 12:04 by rmk")
|
||||
(* ; "Edited 30-May-91 20:34 by jds")
|
||||
(* ;
|
||||
"Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
|
||||
(PROG ((LOOKS (create FMTSPEC))
|
||||
TABFLG DEFTAB TABCOUNT TABS TABSPEC)
|
||||
(replace (PIECE PPARALOOKS) of PC with LOOKS)
|
||||
(replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
TABFLG DEFTAB TABS)
|
||||
(SETPC PC PPARALOOKS FMT)
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "Right margin for the paragraph")
|
||||
(replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "Leading before the paragraph")
|
||||
(replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "Lead after the paragraph")
|
||||
(replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE))
|
||||
(* ; "inter-line leading")
|
||||
(replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS DEFAULTTAB NIL)))
|
||||
(* ; "Will be tab specs")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(replace (FMTSPEC QUAD) of LOOKS with (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(SHOULDNT)))
|
||||
(COND
|
||||
((NOT (ZEROP TABFLG)) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(SETQ TABCOUNT (BIN FILE))
|
||||
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
(SELECTQ (BIN FILE)
|
||||
(0 'LEFT)
|
||||
(1 'RIGHT)
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(SHOULDNT]
|
||||
(OR (ZEROP DEFTAB)
|
||||
(RPLACA TABSPEC DEFTAB))
|
||||
(RPLACD TABSPEC TABS])
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(CL:UNLESS (ZEROP TABFLG) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(CL:WHEN (ILEQ DEFTAB 1)
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
(SELECTQ (BIN FILE)
|
||||
(0 'LEFT)
|
||||
(1 'RIGHT)
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
FMT])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1666 38666 (\TEDIT.GET.PCTB2 1676 . 11742) (\TEDIT.GET.PARALOOKS2 11744 . 12333) (
|
||||
\TEDIT.GET.CHARLOOKS2 12335 . 13666) (\TEDIT.PARSE.PAGEFRAMES2 13668 . 16407) (
|
||||
\TEDIT.GET.CHARLOOKS.LIST2 16409 . 16916) (\TEDIT.GET.SINGLE.CHARLOOKS2 16918 . 20635) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS2 20637 . 25388) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25390 . 29864) (
|
||||
\TEDIT.GET.PARALOOKS.LIST2 29866 . 30373) (\TEDIT.GET.SINGLE.PARALOOKS2 30375 . 35384) (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST2 35386 . 37465) (\TEDIT.PUT.PARALOOKS.LIST2 37467 . 38664)) (38743 59003 (
|
||||
\TEDIT.GET.PCTB1 38753 . 45217) (\TEDIT.GET.PAGEFRAMES1 45219 . 45671) (\TEDIT.PARSE.PAGEFRAMES1 45673
|
||||
. 48049) (\TEDIT.GET.CHARLOOKS1 48051 . 52423) (\TEDIT.GET.PARALOOKS1 52425 . 57457) (
|
||||
TEDIT.GET.OBJECT1 57459 . 59001)) (59063 73224 (\TEDIT.GET.PCTB0 59073 . 62808) (\TEDIT.GET.CHARLOOKS0
|
||||
62810 . 67397) (\TEDIT.GET.OBJECT0 67399 . 69349) (\TEDIT.GET.PARALOOKS0 69351 . 73222)))))
|
||||
(FILEMAP (NIL (1705 37969 (\TEDIT.GET.PCTB2 1715 . 12010) (\TEDIT.GET.PARALOOKS2 12012 . 12601) (
|
||||
\TEDIT.GET.CHARLOOKS2 12603 . 13934) (\TEDIT.PARSE.PAGEFRAMES2 13936 . 16675) (
|
||||
\TEDIT.GET.CHARLOOKS.LIST2 16677 . 17184) (\TEDIT.GET.SINGLE.CHARLOOKS2 17186 . 21013) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS2 21015 . 25132) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25134 . 29718) (
|
||||
\TEDIT.GET.PARALOOKS.LIST2 29720 . 30227) (\TEDIT.GET.SINGLE.PARALOOKS2 30229 . 34687) (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST2 34689 . 36768) (\TEDIT.PUT.PARALOOKS.LIST2 36770 . 37967)) (38046 58482 (
|
||||
\TEDIT.GET.PCTB1 38056 . 44747) (\TEDIT.GET.PAGEFRAMES1 44749 . 45201) (\TEDIT.PARSE.PAGEFRAMES1 45203
|
||||
. 47856) (\TEDIT.GET.CHARLOOKS1 47858 . 52340) (\TEDIT.GET.PARALOOKS1 52342 . 56748) (
|
||||
TEDIT.GET.OBJECT1 56750 . 58480)) (58542 72962 (\TEDIT.GET.PCTB0 58552 . 62515) (\TEDIT.GET.CHARLOOKS0
|
||||
62517 . 67214) (\TEDIT.GET.OBJECT0 67216 . 69275) (\TEDIT.GET.PARALOOKS0 69277 . 72960)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Mar-2024 11:07:07" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;239 66617
|
||||
(FILECREATED "27-Nov-2024 23:12:27" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;243 67795
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.INSERTPIECES)
|
||||
:CHANGES-TO (FNS \TEDIT.DELETEPIECES)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 12:41:57" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;238)
|
||||
:PREVIOUS-DATE "21-Oct-2024 00:42:44" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;242)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||
@@ -272,10 +272,15 @@
|
||||
DELTA])
|
||||
|
||||
(\TEDIT.FIRSTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 21-Aug-2024 16:07 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
(* ; "Edited 11-Apr-2023 12:54 by rmk")
|
||||
(* ; "Edited 24-Aug-2022 12:45 by rmk")
|
||||
(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).")
|
||||
@@ -284,7 +289,8 @@
|
||||
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 +319,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))
|
||||
@@ -504,18 +510,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 +571,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.")
|
||||
@@ -643,19 +651,21 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.UNLINKPIECE
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2023 17:24 by rmk")
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:24 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:31 by rmk")
|
||||
|
||||
(* ;; "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])
|
||||
|
||||
(\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 +697,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"))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -817,7 +827,8 @@
|
||||
PIECES])
|
||||
|
||||
(\TEDIT.DELETEPIECES
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 12:12 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 23:03 by rmk")
|
||||
(* ; "Edited 22-Oct-2023 11:43 by rmk")
|
||||
@@ -837,10 +848,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 LASTPIECE)))
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T) inselpieces SELPIECES
|
||||
do (UNINTERRUPTABLY
|
||||
(\TEDIT.UPDATEPCNODES PC (IMINUS (PLEN PC))
|
||||
TEXTOBJ)
|
||||
@@ -856,9 +868,9 @@
|
||||
(* ;;
|
||||
"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])
|
||||
|
||||
@@ -1057,12 +1069,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 +1098,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 (8698 55567 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
|
||||
\TEDIT.FIRSTPIECE 12557 . 13853) (\TEDIT.DELETETREE 13855 . 17129) (\TEDIT.INSERTTREE 17131 . 19876) (
|
||||
\TEDIT.LASTPIECE 19878 . 20814) (\TEDIT.PCTOCH 20816 . 22913) (\TEDIT.CHTOPC 22915 . 28977) (
|
||||
\TEDIT.SET-TOTLEN 28979 . 29767) (\TEDIT.MAKE.VACANT.BTREESLOT 29769 . 36499) (\TEDIT.LINKNEWPIECE
|
||||
36501 . 37994) (\TEDIT.UNLINKPIECE 37996 . 38724) (\TEDIT.SPLITPIECE 38726 . 43382) (
|
||||
\TEDIT.INSERTPIECE 43384 . 46537) (\TEDIT.INSERTPIECES 46539 . 49518) (\TEDIT.DELETEPIECES 49520 .
|
||||
53561) (\TEDIT.ALIGNEDPIECE 53563 . 55565)) (55595 67672 (\TEDIT.BTVALIDATE 55605 . 57146) (
|
||||
\TEDIT.BTVALIDATE.PRINT 57148 . 58513) (\TEDIT.CHECK-BTREE 58515 . 60727) (\TEDIT.CHECK-BTREE1 60729
|
||||
. 66229) (\TEDIT.BTFAIL 66231 . 66653) (\TEDIT.MATCHPCS 66655 . 67670)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
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.
@@ -1,15 +1,12 @@
|
||||
(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-Dec-2024 23:43:59" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;163 92210
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-TFBRAVOCOMS)
|
||||
(FNS \TEDIT.NAMEDTAB.INIT)
|
||||
:CHANGES-TO (FNS \TFBRAVO.READ.PARALOOKS)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 12:41:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;152)
|
||||
:PREVIOUS-DATE "21-Oct-2024 00:33:50" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;162)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
|
||||
@@ -124,7 +121,7 @@
|
||||
(WIDTH (IPLUS (CONSTANT (FIX (FTIMES 8.5 72)))
|
||||
NUM))
|
||||
(NIL NUM)
|
||||
(HELP "UNKNOWN DIMENSION" DIMENSION))))
|
||||
(\TEDIT.THELP "UNKNOWN DIMENSION" DIMENSION))))
|
||||
NUM)))
|
||||
)
|
||||
|
||||
@@ -303,7 +300,8 @@
|
||||
(SETTOBJ TEXTOBJ FMTSPEC USER.CM.FMTSPEC])
|
||||
|
||||
(\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 +328,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,7 +378,9 @@
|
||||
(GO LLP)))])
|
||||
|
||||
(\TFBRAVO.INIT.PARALOOKS
|
||||
[LAMBDA (ALIST) (* ; "Edited 13-Aug-2023 11:27 by rmk")
|
||||
[LAMBDA (ALIST) (* ; "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")
|
||||
@@ -400,8 +402,8 @@
|
||||
(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])
|
||||
@@ -491,7 +493,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.PARSE.PARA
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "Edited 14-Nov-2023 13:03 by rmk")
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "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")
|
||||
@@ -540,14 +543,18 @@
|
||||
(^Z (SETQ FMTSPEC (\TFBRAVO.READ.PARALOOKS OLDFMTSPEC 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
|
||||
RUNS _ RUNS
|
||||
FORMATPTRS _ FORMATPTRS])
|
||||
|
||||
(\TFBRAVO.READ.PARALOOKS
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM) (* ; "Edited 9-Sep-2023 21:40 by rmk")
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM) (* ; "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")
|
||||
@@ -560,55 +567,55 @@
|
||||
(* ;;
|
||||
"Decodes bravo paragraph looks into a TEDIT FMTSPEC. OLDFMTSPEC 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))
|
||||
(\DTEST OLDFMTSPEC 'FMTSPEC)
|
||||
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPARA USER.CM.FMTSPEC
|
||||
FMTDEFAULTTAB))
|
||||
(NEWFMTSPEC _ (create FMTSPEC using USER.CM.FMTSPEC))
|
||||
first (CL:UNLESS (EQ 'PROFILE (FGETPARA OLDFMTSPEC 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 (FGETPARA OLDFMTSPEC FMTDEFAULTTAB)
|
||||
(FGETPARA USER.CM.FMTSPEC 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 (FGETPARA OLDFMTSPEC FMTUSERINFO))))
|
||||
do (SELCHARQ (SETQ COMMAND (BIN BSTREAM))
|
||||
(l (SETQ LMFLAG T)
|
||||
(replace (FMTSPEC LEFTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(FSETPARA NEWFMTSPEC 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)))
|
||||
(FSETPARA NEWFMTSPEC 1STLEFTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS)
|
||||
))
|
||||
(z (FSETPARA NEWFMTSPEC RIGHTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS)))
|
||||
(x (FSETPARA NEWFMTSPEC LINELEAD (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(e (FSETPARA NEWFMTSPEC LEADAFTER 0)
|
||||
(FSETPARA NEWFMTSPEC LEADBEFORE (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(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)))
|
||||
(FSETPARA NEWFMTSPEC FMTSPECIALX 0)
|
||||
(FSETPARA NEWFMTSPEC FMTSPECIALY (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(k (FSETPARA NEWFMTSPEC FMTHEADINGKEEP (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(w 'HardcopyMode)
|
||||
(j (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'JUSTIFIED))
|
||||
(c (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'CENTERED))
|
||||
(j (FSETPARA NEWFMTSPEC QUAD 'JUSTIFIED))
|
||||
(c (FSETPARA NEWFMTSPEC QUAD 'CENTERED))
|
||||
(q
|
||||
(* ;; "Profiles are marked here but then interpreted at the top")
|
||||
|
||||
(replace (FMTSPEC FMTPARATYPE) of NEWFMTSPEC with 'PROFILE))
|
||||
(FSETPARA NEWFMTSPEC 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 +625,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))
|
||||
(FSETPARA NEWFMTSPEC 1STLEFTMAR (FGETPARA NEWFMTSPEC LEFTMAR)))
|
||||
(FSETPARA NEWFMTSPEC FMTDEFAULTTAB TABDEFAULT)
|
||||
(FSETPARA NEWFMTSPEC 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"])
|
||||
(\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 +660,8 @@
|
||||
(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 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")
|
||||
@@ -709,8 +716,8 @@
|
||||
(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")
|
||||
@@ -1087,7 +1094,9 @@
|
||||
NEWPARAS])
|
||||
|
||||
(\TFBRAVO.RUN.TABSPEC
|
||||
[LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 15-Mar-2024 19:42 by rmk")
|
||||
[LAMBDA (RUN PARAFMTSPEC) (* ; "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")
|
||||
|
||||
@@ -1105,41 +1114,43 @@
|
||||
|
||||
(* ;; "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.FMTSPEC))
|
||||
(LET ([LASTTAB (CAR (LAST (FGETPARA PARAFMTSPEC FMTTABS]
|
||||
(TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO))
|
||||
(TABDEFAULT (OR (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)
|
||||
(FGETPARA USER.CM.FMTSPEC 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))
|
||||
))
|
||||
[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 PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT FMTTABS _
|
||||
TABS)))
|
||||
PARAFMTSPEC])
|
||||
|
||||
(\TFBRAVO.INSTALL.PAGEFORMAT
|
||||
@@ -1220,10 +1231,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 +1345,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.ADD.NAMEDTAB
|
||||
[LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "Edited 9-Sep-2023 21:44 by rmk")
|
||||
[LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "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")
|
||||
@@ -1344,38 +1359,38 @@
|
||||
(* ;; "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. ")
|
||||
|
||||
(* ;; "")
|
||||
(* ; "")
|
||||
|
||||
(* ;; "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 (FGETPARA PARAFMTSPEC FMTUSERINFO))
|
||||
(TABDEFAULT (FGETPARA PARAFMTSPEC 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)))
|
||||
(CL:WHEN (OR TABS (NEQ TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)))
|
||||
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT
|
||||
FMTTABS _ TABS))
|
||||
(\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ)))
|
||||
PARAFMTSPEC])
|
||||
|
||||
@@ -1450,18 +1465,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 (6681 13063 (TEDIT.BRAVOFILE? 6691 . 8421) (TEDITFROMBRAVO 8423 . 13061)) (13174 28618 (
|
||||
\TFBRAVO.GET.USER.CM 13184 . 15994) (\TFBRAVO.USER.CM.LOOKS 15996 . 17171) (\TFBRAVO.READ.USER.CM
|
||||
17173 . 21743) (\TFBRAVO.INIT.PARALOOKS 21745 . 23731) (\TFBRAVO.INIT.PAGEFORMAT 23733 . 24613) (
|
||||
\TFBRAVO.GETPARAMS 24615 . 27469) (\TFBRAVO.FIND.LAST.TRAILER 27471 . 28616)) (28660 48692 (
|
||||
\TFBRAVO.PARSE.PARA 28670 . 32470) (\TFBRAVO.READ.PARALOOKS 32472 . 38894) (\TFBRAVO.CREATE.RUNS 38896
|
||||
. 40284) (\TFBRAVO.READ.CHARLOOKS 40286 . 45422) (\TFBRAVO.FONT.FROM.CHARLOOKS 45424 . 46793) (
|
||||
\TFBRAVO.READNUM? 46795 . 48690)) (48729 59480 (\TFBRAVO.HANDLE.HEADING 48739 . 51371) (
|
||||
\TFBRAVO.PARSE.PROFILE.PARA 51373 . 59478)) (59523 80972 (\TFBRAVO.INSERT.PARA 59533 . 60186) (
|
||||
\TFBRAVO.INSERT.RUN 60188 . 63385) (\TFBRAVO.SPLIT.PARA 63387 . 70629) (\TFBRAVO.RUN.TABSPEC 70631 .
|
||||
75277) (\TFBRAVO.INSTALL.PAGEFORMAT 75279 . 80970)) (80973 85116 (\TFBRAVO.ASSERT 80983 . 81513) (
|
||||
\TEST.CHARACTER.LOOKS 81515 . 83401) (\TEST.PARAGRAPH.LOOKS 83403 . 85114)) (85601 92044 (
|
||||
\TFBRAVO.ADD.NAMEDTAB 85611 . 89002) (\TFBRAVO.COPY.NAMEDTAB 89004 . 89452) (\TFBRAVO.PUT.NAMEDTAB
|
||||
89454 . 89734) (\TFBRAVO.GET.NAMEDTAB 89736 . 90113) (\NAMEDTABNYET 90115 . 90275) (\NAMEDTABSIZE
|
||||
90277 . 90792) (\NAMEDTABPREPRINT 90794 . 90992) (\TEDIT.NAMEDTAB.INIT 90994 . 92042)))))
|
||||
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 "14-Dec-2024 11:45:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;196 52876
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "20-Mar-2024 09:45:21" {WMEDLEY}<library>TEDIT>tedit-exports.all;118)
|
||||
:PREVIOUS-DATE " 8-Dec-2024 19:52:13" {WMEDLEY}<library>TEDIT>tedit-exports.all;195)
|
||||
|
||||
|
||||
(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 " 8-Dec-2024 21:39:48"))
|
||||
(RPAQQ \BTREEWORDSPERSLOT 4)
|
||||
(RPAQQ \BTREEMAXCOUNT 8)
|
||||
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
||||
@@ -52,23 +53,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 "27-Nov-2024 23:12:27"))
|
||||
(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 +78,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 " 6-Dec-2024 12:50:42"))
|
||||
(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 +133,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 (* ;
|
||||
@@ -141,19 +150,27 @@ FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ;
|
||||
) 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) (* ;
|
||||
* ; "The format spec 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 +182,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 +262,7 @@ SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE NEX
|
||||
THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)) by (PREVCHARSLOT I.V.)
|
||||
eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.))
|
||||
repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
|
||||
(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 "13-Dec-2024 23:51:31"))
|
||||
(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)."
|
||||
@@ -243,37 +279,39 @@ 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 _
|
||||
POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM))) (
|
||||
PCHARLOOKS (PLOOKS DATUM) (STANDARD (replace (PIECE PLOOKS) of DATUM with NEWVALUE) FAST (freplace (
|
||||
PIECE PLOOKS) 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"
|
||||
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ;
|
||||
"A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC"
|
||||
) LASTPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end")
|
||||
NIL (* ;
|
||||
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 (* ;
|
||||
"Was MOVESEL: Source for the next MOVE of text") NIL (* ; "Was SHIFTEDSEL: Source for the next COPY")
|
||||
NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
|
||||
"Right edge of the window (or subregion) where this is displayed") WTOP (* ;
|
||||
SEL (* ; "The current selection within the text") NIL (* ; "Was: Scratch space for the selection code"
|
||||
) NIL (* ; "Was MOVESEL: Source for the next MOVE of text") NIL (* ;
|
||||
"Was SHIFTEDSEL: Source for the next COPY") NIL (* ; "Was DELETESEL: Text to be deleted imminently")
|
||||
WRIGHT (* ; "Right edge of the window (or subregion) where this is displayed") WTOP (* ;
|
||||
"Top of the window/region") WBOTTOM (* ; "Bottom of the window/region") WLEFT (* ;
|
||||
"Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (\XDIRTY FLAG)
|
||||
(* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ;
|
||||
"-> 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) (* ;
|
||||
@@ -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")
|
||||
@@ -302,7 +341,9 @@ DISPLAYCACHEDS (* ; "The DISPLAYSTREAM that is used to build line images") DISPL
|
||||
) 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) (* ;
|
||||
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 (* ;
|
||||
@@ -310,9 +351,8 @@ TXTNEEDSUPDATE FLAG) (* ; "T => Screen invalid, need to run updater") (TXTDON'TU
|
||||
"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)
|
||||
SELECTION) TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 MOUSEREGION _ (QUOTE TEXT) THISLINE _
|
||||
(create THISLINE) FMTSPEC _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
|
||||
(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 +360,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)))
|
||||
) (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 PCHARLOOKS MACRO ((PC) (PLOOKS 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 +387,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 +408,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 +436,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 "27-Nov-2024 23:17:20"))
|
||||
(RPAQQ NONE.TTC 0)
|
||||
(RPAQQ CHARDELETE.TTC 1)
|
||||
(RPAQQ WORDDELETE.TTC 2)
|
||||
@@ -414,10 +463,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,15 +480,16 @@ 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 "28-Nov-2024 10:03:03"))
|
||||
(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 "11-Dec-2024 23:00:13"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "23-Oct-2024 16:09:28"))
|
||||
(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") CLNAME (* ;;
|
||||
"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) (* ;
|
||||
@@ -450,9 +500,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,7 +511,8 @@ 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))))
|
||||
) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields)."))
|
||||
CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))))
|
||||
(DATATYPE FMTSPEC ((* ;; "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 (* ;
|
||||
@@ -471,8 +522,8 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
"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 (* ;
|
||||
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 +543,28 @@ 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 FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _
|
||||
0)
|
||||
(DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))
|
||||
(DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.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 FSETPARA MACRO ((F FIELD NEWVALUE) (freplace (FMTSPEC FIELD) of F with NEWVALUE)))
|
||||
(PUTPROPS FGETPARA MACRO ((F FIELD) (ffetch (FMTSPEC FIELD) of F)))
|
||||
(PUTPROPS GETPARA MACRO ((F FIELD) (fetch (FMTSPEC FIELD) of F)))
|
||||
(PUTPROPS SETPARA MACRO ((F FIELD NEWVALUE) (replace (FMTSPEC FIELD) of F with NEWVALUE)))
|
||||
(PUTPROPS GETCLOOKS MACRO ((CL FIELD) (fetch (CHARLOOKS FIELD) of CL)))
|
||||
(PUTPROPS SETCLOOKS MACRO ((CL FIELD NEWVALUE) (replace (CHARLOOKS FIELD) of CL with NEWVALUE)))
|
||||
(PUTPROPS FGETCLOOKS MACRO ((CL FIELD) (ffetch (CHARLOOKS FIELD) of CL)))
|
||||
(PUTPROPS FSETCLOOKS MACRO ((CL FIELD NEWVALUE) (freplace (CHARLOOKS FIELD) of CL with NEWVALUE)))
|
||||
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE FMTSPEC))))
|
||||
(PUTPROPS CHARLOOKS! MACRO ((CL) (\DTEST CL (QUOTE CHARLOOKS))))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 3-Dec-2024 00:01:46"))
|
||||
(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 +575,79 @@ 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 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 "13-Dec-2024 09:00:10"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 09:24:22"))
|
||||
(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 " 7-Dec-2024 21:21:48"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 15:49:12"))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "26-Nov-2024 23:53:32"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:23"))
|
||||
(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 " 8-Dec-2024 19:41:55"))
|
||||
(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 +678,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 "11-Dec-2024 22:39:52"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "31-Oct-2024 17:53:21"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Oct-2024 00:33:50"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-May-2024 14:53:20" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;260 131326
|
||||
(FILECREATED "20-Jan-2025 11:00:54" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;263 131893
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS COMPAREDIRECTORIES)
|
||||
:CHANGES-TO (VARS COMPAREDIRECTORIESCOMS)
|
||||
|
||||
:PREVIOUS-DATE "26-Mar-2024 21:42:47" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;259)
|
||||
:PREVIOUS-DATE "23-Dec-2024 23:54:13" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;262)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||
@@ -15,6 +15,8 @@
|
||||
[
|
||||
(* ;; "Compare the contents of two directories.")
|
||||
|
||||
(FILES (SYSLOAD)
|
||||
PDFSTREAM)
|
||||
(FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.CANDIDATES
|
||||
CDENTRIES.SELECT COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE
|
||||
CD.UPDATEWIDTHS)
|
||||
@@ -59,6 +61,9 @@
|
||||
|
||||
(* ;; "Compare the contents of two directories.")
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
PDFSTREAM)
|
||||
(DEFINEQ
|
||||
|
||||
(COMPAREDIRECTORIES
|
||||
@@ -1955,6 +1960,8 @@
|
||||
(CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
||||
|
||||
(* ;; "Edited 23-Dec-2024 23:53 by rmk")
|
||||
|
||||
(* ;; "Edited 21-May-2022 21:59 by rmk")
|
||||
|
||||
(* ;; "Edited 27-Feb-2022 12:47 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
|
||||
@@ -1968,52 +1975,64 @@
|
||||
(* ; "Close the previous ones")
|
||||
(CLOSEWITH.DOIT WINDOW))
|
||||
(LET (CHILDREN)
|
||||
(SETQ CHILDREN (SELECTQ MENUITEM
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE
|
||||
(WINDOWPROP WINDOW 'REGION))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "Only one file" T)))
|
||||
(See% left (IF FILE1
|
||||
THEN (TEDIT-SEE FILE1
|
||||
(RELCREATEREGION
|
||||
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
T)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL1))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% right (IF FILE2
|
||||
THEN (TEDIT-SEE FILE2
|
||||
(RELCREATEREGION
|
||||
700 700 'LEFT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL2))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
((See See% both)
|
||||
(EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL)))
|
||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
|
||||
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
|
||||
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
|
||||
(|Delete ALL <-|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
|
||||
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
|
||||
(|Delete ALL ->|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
|
||||
(SHOULDNT)))
|
||||
(SETQ CHILDREN
|
||||
(SELECTQ MENUITEM
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP
|
||||
WINDOW
|
||||
'REGION))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "Only one file" T)))
|
||||
(See% left (IF FILE1
|
||||
THEN (if (PDFFILEP FILE1)
|
||||
then (SEE-PDF FILE1)
|
||||
else (TEDIT-SEE FILE1 (RELCREATEREGION
|
||||
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
T)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL1)))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% right (IF FILE2
|
||||
THEN (if (PDFFILEP FILE2)
|
||||
then (SEE-PDF FILE2)
|
||||
else (TEDIT-SEE FILE2 (RELCREATEREGION
|
||||
700 700 'LEFT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
NIL)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL2)))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
((See See% both)
|
||||
(IF (PDFFILEP FILE1)
|
||||
then (SEE-PDF FILE1)
|
||||
(CL:WHEN (PDFFILEP FILE2)
|
||||
(SEE-PDF FILE2))
|
||||
elseif (PDFFILEP FILE2)
|
||||
then (SEE-PDF FILE2)
|
||||
else (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
NIL))))
|
||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
|
||||
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
|
||||
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
|
||||
(|Delete ALL <-|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
|
||||
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
|
||||
(|Delete ALL ->|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
|
||||
(SHOULDNT)))
|
||||
(CLOSEWITH CHILDREN WINDOW)
|
||||
(MOVEWITH CHILDREN WINDOW])
|
||||
|
||||
@@ -2202,25 +2221,25 @@
|
||||
|
||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2526 22889 (COMPAREDIRECTORIES 2536 . 7871) (COMPAREDIRECTORIES.INFOS 7873 . 10831) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10833 . 14218) (CDENTRIES.SELECT 14220 . 18995) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18997 . 20123) (MATCHNAME 20125 . 20805) (CD.INSURECDVALUE 20807 . 22421
|
||||
) (CD.UPDATEWIDTHS 22423 . 22887)) (22890 33512 (CDFILES 22900 . 28914) (CDFILES.MATCH 28916 . 30541)
|
||||
(CDFILES.PATS 30543 . 33510)) (33513 51334 (CDPRINT 33523 . 36040) (CDPRINT.HEADER 36042 . 36939) (
|
||||
CDPRINT.LINE 36941 . 40173) (CDPRINT.MAXWIDTHS 40175 . 44290) (CDPRINT.COLHEADERS 44292 . 45577) (
|
||||
CDPRINT.COLUMNS 45579 . 50699) (CDTEDIT 50701 . 51332)) (51335 60456 (CDMAP 51345 . 52777) (CDENTRY
|
||||
52779 . 53088) (CDSUBSET 53090 . 54529) (CDMERGE 54531 . 58515) (CDMERGE.COMMON 58517 . 59832) (
|
||||
CD.SORT 59834 . 60454)) (60457 67995 (BINCOMP 60467 . 64756) (EOLTYPE 64758 . 67320) (EOLTYPE.SHOW
|
||||
67322 . 67993)) (68523 81050 (FIND-UNCOMPILED-FILES 68533 . 72176) (FIND-UNSOURCED-FILES 72178 . 74562
|
||||
) (FIND-SOURCE-FILES 74564 . 76302) (FIND-COMPILED-FILES 76304 . 78181) (FIND-UNLOADED-FILES 78183 .
|
||||
79036) (FIND-LOADED-FILES 79038 . 79466) (FIND-MULTICOMPILED-FILES 79468 . 81048)) (81051 89482 (
|
||||
CREATED-AS 81061 . 85858) (SOURCE-FOR-COMPILED-P 85860 . 88787) (COMPILE-SOURCE-DATE-DIFF 88789 .
|
||||
89480)) (89483 100246 (FIX-DIRECTORY-DATES 89493 . 92943) (FIX-EQUIV-DATES 92945 . 94470) (
|
||||
COPY-COMPARED-FILES 94472 . 96293) (COPY-MISSING-FILES 96295 . 98452) (COMPILED-ON-SAME-SOURCE 98454
|
||||
. 100244)) (100440 108278 (CDBROWSER 100450 . 104377) (CDBROWSER.STRINGS 104379 . 108276)) (108440
|
||||
110176 (CD.TABLEITEM 108450 . 108670) (CD.TABLEITEM.PRINTFN 108672 . 108871) (CD.TABLEITEM.COPYFN
|
||||
108873 . 109931) (CDTABLEBROWSER.HEADING.REPAINTFN 109933 . 110174)) (110177 130832 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 110187 . 110655) (CD.COMMANDSELECTEDFN 110657 . 115758) (CD-MENUFN
|
||||
115760 . 120071) (CD-COMPARE-FILES 120073 . 123425) (CDBROWSER-COPY 123427 . 127096) (
|
||||
CDBROWSER-DELETE-FILE 127098 . 130311) (CD-SWAPDIRS 130313 . 130830)))))
|
||||
(FILEMAP (NIL (2622 22985 (COMPAREDIRECTORIES 2632 . 7967) (COMPAREDIRECTORIES.INFOS 7969 . 10927) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10929 . 14314) (CDENTRIES.SELECT 14316 . 19091) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 19093 . 20219) (MATCHNAME 20221 . 20901) (CD.INSURECDVALUE 20903 . 22517
|
||||
) (CD.UPDATEWIDTHS 22519 . 22983)) (22986 33608 (CDFILES 22996 . 29010) (CDFILES.MATCH 29012 . 30637)
|
||||
(CDFILES.PATS 30639 . 33606)) (33609 51430 (CDPRINT 33619 . 36136) (CDPRINT.HEADER 36138 . 37035) (
|
||||
CDPRINT.LINE 37037 . 40269) (CDPRINT.MAXWIDTHS 40271 . 44386) (CDPRINT.COLHEADERS 44388 . 45673) (
|
||||
CDPRINT.COLUMNS 45675 . 50795) (CDTEDIT 50797 . 51428)) (51431 60552 (CDMAP 51441 . 52873) (CDENTRY
|
||||
52875 . 53184) (CDSUBSET 53186 . 54625) (CDMERGE 54627 . 58611) (CDMERGE.COMMON 58613 . 59928) (
|
||||
CD.SORT 59930 . 60550)) (60553 68091 (BINCOMP 60563 . 64852) (EOLTYPE 64854 . 67416) (EOLTYPE.SHOW
|
||||
67418 . 68089)) (68619 81146 (FIND-UNCOMPILED-FILES 68629 . 72272) (FIND-UNSOURCED-FILES 72274 . 74658
|
||||
) (FIND-SOURCE-FILES 74660 . 76398) (FIND-COMPILED-FILES 76400 . 78277) (FIND-UNLOADED-FILES 78279 .
|
||||
79132) (FIND-LOADED-FILES 79134 . 79562) (FIND-MULTICOMPILED-FILES 79564 . 81144)) (81147 89578 (
|
||||
CREATED-AS 81157 . 85954) (SOURCE-FOR-COMPILED-P 85956 . 88883) (COMPILE-SOURCE-DATE-DIFF 88885 .
|
||||
89576)) (89579 100342 (FIX-DIRECTORY-DATES 89589 . 93039) (FIX-EQUIV-DATES 93041 . 94566) (
|
||||
COPY-COMPARED-FILES 94568 . 96389) (COPY-MISSING-FILES 96391 . 98548) (COMPILED-ON-SAME-SOURCE 98550
|
||||
. 100340)) (100536 108374 (CDBROWSER 100546 . 104473) (CDBROWSER.STRINGS 104475 . 108372)) (108536
|
||||
110272 (CD.TABLEITEM 108546 . 108766) (CD.TABLEITEM.PRINTFN 108768 . 108967) (CD.TABLEITEM.COPYFN
|
||||
108969 . 110027) (CDTABLEBROWSER.HEADING.REPAINTFN 110029 . 110270)) (110273 131399 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 110283 . 110751) (CD.COMMANDSELECTEDFN 110753 . 115854) (CD-MENUFN
|
||||
115856 . 120638) (CD-COMPARE-FILES 120640 . 123992) (CDBROWSER-COPY 123994 . 127663) (
|
||||
CDBROWSER-DELETE-FILE 127665 . 130878) (CD-SWAPDIRS 130880 . 131397)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13 65523
|
||||
(FILECREATED "25-May-2024 13:19:49" {WMEDLEY}<lispusers>DINFO.;14 65819
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM)
|
||||
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM DINFO.UPDATE.TEXT.DISPLAY)
|
||||
|
||||
:PREVIOUS-DATE "10-Mar-2024 15:38:36" {WMEDLEY}<lispusers>DINFO.;12)
|
||||
:PREVIOUS-DATE "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT DINFOCOMS)
|
||||
@@ -988,17 +988,18 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DINFO.UPDATE.TEXT.DISPLAY
|
||||
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 3-Feb-2022 11:50 by rmk")
|
||||
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 25-May-2024 13:16 by rmk")
|
||||
(* drc%: "25-Jan-86 18:18")
|
||||
(* drc%: "25-Jan-86 18:18")
|
||||
(LET ((WINDOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(FILENAME (DINFO.GET.FILENAME GRAPH NODE))
|
||||
(FROM (fetch (DINFONODE FROMBYTE) of NODE))
|
||||
(TO (fetch (DINFONODE TOBYTE) of NODE))
|
||||
(PROPS (APPEND (LIST 'READONLY T 'NOTITLE T 'TITLEMENUFN 'DINFO.TITLEMENUFN)
|
||||
(PROPS (APPEND (LIST 'READONLY 'QUIET 'NOTITLE T 'TITLEMENUFN (FUNCTION DINFO.TITLEMENUFN))
|
||||
(fetch (DINFOGRAPH TEXTPROPS) of GRAPH)))
|
||||
(OLD.TEXTSTREAM (WINDOWPROP (fetch (DINFOGRAPH WINDOW) of GRAPH)
|
||||
'TEXTSTREAM))
|
||||
TEXTSTREAM FULLFILENAME) (* Default directory and host.)
|
||||
TEXTSTREAM FULLFILENAME) (* ; "Default directory and host.")
|
||||
(if (OR OFF? (NULL FILENAME))
|
||||
then (OPENTEXTSTREAM (CL:UNLESS OFF? (OPENSTRINGSTREAM "This node has no text"))
|
||||
WINDOW NIL NIL PROPS)
|
||||
@@ -1036,7 +1037,8 @@
|
||||
(PROMPTPRINT "DInfo is busy"])
|
||||
|
||||
(DINFO.OPENTEXTSTREAM
|
||||
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 10-Apr-2024 23:46 by rmk")
|
||||
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 25-May-2024 13:17 by rmk")
|
||||
(* ; "Edited 10-Apr-2024 23:46 by rmk")
|
||||
(* ; "Edited 10-Mar-2024 15:37 by rmk")
|
||||
(* drc%: "25-Jan-86 18:24")
|
||||
(RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW WINDOW))
|
||||
@@ -1053,7 +1055,8 @@
|
||||
(CLEARW T)
|
||||
(CLEARW WINDOW)
|
||||
[RESETSAVE NIL `(AND RESETSTATE (WINDOWPROP ,WINDOW 'LAST.TEXT NIL]
|
||||
(PROG1 (OPENTEXTSTREAM FILE WINDOW FROM TO PROPS)
|
||||
(PROG1 (TEDIT (OPENTEXTSTREAM FILE NIL FROM TO PROPS)
|
||||
WINDOW)
|
||||
(replace (DINFOGRAPH LAST.TEXT) of (DINFOGRAPH WINDOW) with THIS.TEXT))])
|
||||
|
||||
(DINFO.SHOWSEL
|
||||
@@ -1110,21 +1113,21 @@
|
||||
(SETTEMPLATE 'DINFOGRAPHPROP 'MACRO)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4556 6015 (DINFOGRAPHPROP 4556 . 6015)) (7269 24407 (DINFO 7279 . 8893) (DINFO.UPDATE
|
||||
8895 . 11759) (DINFOGRAPH 11761 . 12179) (DINFO.SPECIAL.UPDATE 12181 . 13879) (DINFO.READ.GRAPH 13881
|
||||
. 15736) (DINFO.WRITE.GRAPH 15738 . 16828) (DINFO.SELECT.GRAPH 16830 . 17737) (DINFO.DEFAULT.MENU
|
||||
17739 . 20263) (DINFO.FIND 20265 . 22851) (DINFO.LOOKUP 22853 . 24405)) (24408 27102 (
|
||||
DINFO.READ.KOTO.GRAPH 24418 . 27100)) (27103 29417 (DINFO.SETUP.WINDOW 27113 . 27794) (DINFO.CLOSEFN
|
||||
27796 . 28229) (DINFO.SHRINKFN 28231 . 28427) (DINFO.EXPANDFN 28429 . 28986) (DINFO.ICONFN 28988 .
|
||||
29415)) (29418 40740 (DINFO.ADD.FMENU 29428 . 30523) (DINFO.CREATE.FMENU 30525 . 34552) (
|
||||
DINFO.FMW.CLOSEFN 34554 . 35399) (DINFO.FMENU.HANDLER 35401 . 36040) (DINFO.UPDATE.FMENU 36042 . 38231
|
||||
) (DINFO.TOGGLE.MENU 38233 . 38823) (DINFO.TOGGLE.GRAPH 38825 . 39324) (DINFO.TOGGLE.HISTORY 39326 .
|
||||
39870) (DINFO.TOGGLE.TEXT 39872 . 40738)) (40741 48536 (DINFO.UPDATE.MENU.DISPLAY 40751 . 44872) (
|
||||
DINFO.UPDATE.FROM.MENU 44874 . 45173) (DINFO.UPDATE.HISTORY 45175 . 47705) (DINFO.HISTORIC.UPDATE
|
||||
47707 . 48534)) (48537 58866 (DINFO.UPDATE.GRAPH.DISPLAY 48547 . 49999) (DINFO.UPDATE.FROM.GRAPH 50001
|
||||
. 50477) (DINFO.GET.GRAPH.WINDOW 50479 . 51064) (DINFO.CREATE.GRAPH.WINDOW 51066 . 52183) (
|
||||
DINFO.SHOWGRAPH 52185 . 53910) (DINFO.INVERT.NODE 53912 . 55300) (DINFO.LAYOUTGRAPH 55302 . 58864)) (
|
||||
58867 64936 (DINFO.UPDATE.TEXT.DISPLAY 58877 . 60825) (DINFO.TITLEMENUFN 60827 . 61952) (
|
||||
DINFO.OPENTEXTSTREAM 61954 . 63296) (DINFO.SHOWSEL 63298 . 64031) (DINFO.GET.FILENAME 64033 . 64934)))
|
||||
(FILEMAP (NIL (4582 6041 (DINFOGRAPHPROP 4582 . 6041)) (7295 24433 (DINFO 7305 . 8919) (DINFO.UPDATE
|
||||
8921 . 11785) (DINFOGRAPH 11787 . 12205) (DINFO.SPECIAL.UPDATE 12207 . 13905) (DINFO.READ.GRAPH 13907
|
||||
. 15762) (DINFO.WRITE.GRAPH 15764 . 16854) (DINFO.SELECT.GRAPH 16856 . 17763) (DINFO.DEFAULT.MENU
|
||||
17765 . 20289) (DINFO.FIND 20291 . 22877) (DINFO.LOOKUP 22879 . 24431)) (24434 27128 (
|
||||
DINFO.READ.KOTO.GRAPH 24444 . 27126)) (27129 29443 (DINFO.SETUP.WINDOW 27139 . 27820) (DINFO.CLOSEFN
|
||||
27822 . 28255) (DINFO.SHRINKFN 28257 . 28453) (DINFO.EXPANDFN 28455 . 29012) (DINFO.ICONFN 29014 .
|
||||
29441)) (29444 40766 (DINFO.ADD.FMENU 29454 . 30549) (DINFO.CREATE.FMENU 30551 . 34578) (
|
||||
DINFO.FMW.CLOSEFN 34580 . 35425) (DINFO.FMENU.HANDLER 35427 . 36066) (DINFO.UPDATE.FMENU 36068 . 38257
|
||||
) (DINFO.TOGGLE.MENU 38259 . 38849) (DINFO.TOGGLE.GRAPH 38851 . 39350) (DINFO.TOGGLE.HISTORY 39352 .
|
||||
39896) (DINFO.TOGGLE.TEXT 39898 . 40764)) (40767 48562 (DINFO.UPDATE.MENU.DISPLAY 40777 . 44898) (
|
||||
DINFO.UPDATE.FROM.MENU 44900 . 45199) (DINFO.UPDATE.HISTORY 45201 . 47731) (DINFO.HISTORIC.UPDATE
|
||||
47733 . 48560)) (48563 58892 (DINFO.UPDATE.GRAPH.DISPLAY 48573 . 50025) (DINFO.UPDATE.FROM.GRAPH 50027
|
||||
. 50503) (DINFO.GET.GRAPH.WINDOW 50505 . 51090) (DINFO.CREATE.GRAPH.WINDOW 51092 . 52209) (
|
||||
DINFO.SHOWGRAPH 52211 . 53936) (DINFO.INVERT.NODE 53938 . 55326) (DINFO.LAYOUTGRAPH 55328 . 58890)) (
|
||||
58893 65232 (DINFO.UPDATE.TEXT.DISPLAY 58903 . 60963) (DINFO.TITLEMENUFN 60965 . 62090) (
|
||||
DINFO.OPENTEXTSTREAM 62092 . 63592) (DINFO.SHOWSEL 63594 . 64327) (DINFO.GET.FILENAME 64329 . 65230)))
|
||||
))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,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.
@@ -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
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Mar-2024 11:16:38" {WMEDLEY}<lispusers>GREP.;31 6115
|
||||
(FILECREATED "10-Sep-2024 12:54:27" {WMEDLEY}<lispusers>GREP.;34 6309
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DOGREP)
|
||||
:CHANGES-TO (FNS TGREP)
|
||||
|
||||
:PREVIOUS-DATE "15-Mar-2024 16:28:09" {WMEDLEY}<lispusers>GREP.;29)
|
||||
:PREVIOUS-DATE "16-Mar-2024 11:16:38" {WMEDLEY}<lispusers>GREP.;31)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GREPCOMS)
|
||||
@@ -115,9 +115,15 @@
|
||||
OUTSTREAM)])
|
||||
|
||||
(TGREP
|
||||
[LAMBDA (STRS FILES) (* ; "Edited 20-Jan-2024 14:14 by rmk")
|
||||
(TEXTSTREAM (TEDIT (GREP STRS FILES (OPENTEXTSTREAM))
|
||||
'TGREP NIL '(READONLY T])
|
||||
[LAMBDA (STRS FILES DONTDEFER) (* ; "Edited 10-Sep-2024 12:54 by rmk")
|
||||
|
||||
(* ;; "TSTREAM to return the text stream")
|
||||
(* ; "Edited 20-Jan-2024 14:14 by rmk")
|
||||
(TEVAL (PROGN (GREP STRS FILES)
|
||||
TSTREAM)
|
||||
'TGREP
|
||||
`(TGREP ,STRS ,FILES)
|
||||
DONTDEFER])
|
||||
)
|
||||
|
||||
(MOVD? 'NILL 'TEDIT.FORMATTEDFILEP)
|
||||
@@ -130,6 +136,6 @@
|
||||
|
||||
(RPAQ? PHONELISTFILES )
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (496 5830 (DOGREP 506 . 4544) (GREP 4546 . 5596) (TGREP 5598 . 5828)) (5868 6063 (PHONE
|
||||
5878 . 6061)))))
|
||||
(FILEMAP (NIL (495 6024 (DOGREP 505 . 4543) (GREP 4545 . 5595) (TGREP 5597 . 6022)) (6062 6257 (PHONE
|
||||
6072 . 6255)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Jan-2024 13:38:15" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;7 30816
|
||||
(FILECREATED "30-Jun-2024 22:38:08" {WMEDLEY}<lispusers>MODERNIZE.;50 30912
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN)
|
||||
|
||||
:PREVIOUS-DATE "27-Jan-2024 13:28:36" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;6
|
||||
)
|
||||
:PREVIOUS-DATE "27-Jan-2024 13:38:15" {WMEDLEY}<lispusers>MODERNIZE.;49)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MODERNIZECOMS)
|
||||
@@ -499,7 +500,8 @@
|
||||
(FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN])
|
||||
|
||||
(\MODERNIZED.TEDIT.BUTTONEVENTFN
|
||||
[LAMBDA (W STREAM) (* ; "Edited 29-Jul-2023 10:48 by rmk")
|
||||
[LAMBDA (W STREAM) (* ; "Edited 30-Jun-2024 22:29 by rmk")
|
||||
(* ; "Edited 29-Jul-2023 10:48 by rmk")
|
||||
(* ; "Edited 13-Oct-2021 21:43 by rmk:")
|
||||
|
||||
(* ;; "If a TEDIT window has been split, we have to make sure that movement happens only for clicks at the top of the main window and at the bottom of the bottom-most split window. Clicks near the split lines must be ignored. Essentially, the %"region%" of the Tedit window is the union of the regions of all of its split-panes.")
|
||||
@@ -510,8 +512,8 @@
|
||||
NIL
|
||||
(WINDOWPROP W 'MODERNIZE.TITLEPROPORTION)
|
||||
[APPLY (FUNCTION UNIONREGIONS)
|
||||
(bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE 'REGION)
|
||||
repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
|
||||
(for PANE in (\TEDIT.PANELIST (CENTRALWINDOW W)) collect (WINDOWPROP PANE
|
||||
'REGION]
|
||||
(WINDOWPROP (CENTRALWINDOW W)
|
||||
'TITLE])
|
||||
)
|
||||
@@ -614,11 +616,11 @@
|
||||
(ADDTOVAR LAMA MODERN-ADD-EXEC)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5095 11457 (MODERNWINDOW 5105 . 6645) (MODERNWINDOW.SETUP 6647 . 9596) (UNMODERNWINDOW
|
||||
9598 . 9992) (MODERNWINDOW.UNSETUP 9994 . 10806) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10808 . 11455)) (
|
||||
11522 22488 (MODERNWINDOW.BUTTONEVENTFN 11532 . 18559) (NEARTOP 18561 . 19489) (NEARESTCORNER 19491 .
|
||||
21358) (INCORNER.REGION 21360 . 22486)) (22546 25018 (MODERN-ADD-EXEC 22556 . 22987) (MODERN-SNAPW
|
||||
22989 . 23532) (TOTOPW.MODERNIZE 23534 . 23962) (MODERN-MENUBUTTONFN 23964 . 25016)) (25019 27448 (
|
||||
\MODERNIZED.FREEMENU.BUTTONEVENTFN 25029 . 25676) (MODERNIZED.TB.BUTTONEVENTFN 25678 . 27446)) (27489
|
||||
29055 (TEDIT.MODERNIZE 27499 . 27852) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27854 . 29053)))))
|
||||
(FILEMAP (NIL (5066 11428 (MODERNWINDOW 5076 . 6616) (MODERNWINDOW.SETUP 6618 . 9567) (UNMODERNWINDOW
|
||||
9569 . 9963) (MODERNWINDOW.UNSETUP 9965 . 10777) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10779 . 11426)) (
|
||||
11493 22459 (MODERNWINDOW.BUTTONEVENTFN 11503 . 18530) (NEARTOP 18532 . 19460) (NEARESTCORNER 19462 .
|
||||
21329) (INCORNER.REGION 21331 . 22457)) (22517 24989 (MODERN-ADD-EXEC 22527 . 22958) (MODERN-SNAPW
|
||||
22960 . 23503) (TOTOPW.MODERNIZE 23505 . 23933) (MODERN-MENUBUTTONFN 23935 . 24987)) (24990 27419 (
|
||||
\MODERNIZED.FREEMENU.BUTTONEVENTFN 25000 . 25647) (MODERNIZED.TB.BUTTONEVENTFN 25649 . 27417)) (27460
|
||||
29151 (TEDIT.MODERNIZE 27470 . 27823) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27825 . 29149)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Nov-2023 23:48:28" {WMEDLEY}<lispusers>REGIONMANAGER.;133 41064
|
||||
(FILECREATED "27-Oct-2024 21:59:33" {WMEDLEY}<lispusers>REGIONMANAGER.;134 41230
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS RM-CREATEW)
|
||||
:CHANGES-TO (FNS CLOSE-TYPED-W)
|
||||
|
||||
:PREVIOUS-DATE "10-Oct-2023 22:19:05" {WMEDLEY}<lispusers>REGIONMANAGER.;129)
|
||||
:PREVIOUS-DATE " 2-Nov-2023 23:48:28" {WMEDLEY}<lispusers>REGIONMANAGER.;133)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT REGIONMANAGERCOMS)
|
||||
@@ -248,15 +248,17 @@
|
||||
REGION])
|
||||
|
||||
(CLOSE-TYPED-W
|
||||
[LAMBDA (TYPE) (* ; "Edited 14-Sep-2023 07:39 by rmk")
|
||||
[LAMBDA (TYPE) (* ; "Edited 27-Oct-2024 21:59 by rmk")
|
||||
(* ; "Edited 14-Sep-2023 07:39 by rmk")
|
||||
(* ; "Edited 29-Dec-2021 15:58 by rmk")
|
||||
(* ; "Edited 27-Nov-2021 11:50 by rmk:")
|
||||
|
||||
(* ;; "Closes all windows whose regions are of type TYPE")
|
||||
(* ;; "Closes all windows whose regions are of type TYPE (case-independent)")
|
||||
|
||||
(CL:WHEN TYPE
|
||||
(for W R in (OPENWINDOWS) eachtime [SETQ WT (CAR (WINDOWPROP W 'TYPED-REGION]
|
||||
when (AND WT (EQMEMB WT TYPE)) do (CLOSEW W)))])
|
||||
(for W TRPROP in (OPENWINDOWS) eachtime (SETQ TRPROP (WINDOWPROP W 'TYPED-REGION))
|
||||
when (STRING.EQUAL (CAR TRPROP)
|
||||
TYPE) do (CLOSEW W)))])
|
||||
)
|
||||
|
||||
(RPAQ? TYPED-REGIONS )
|
||||
@@ -730,11 +732,11 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1612 6730 (SET-TYPED-REGIONS 1622 . 3797) (GRAB-TYPED-REGION 3799 . 4825) (
|
||||
REGISTER-TYPED-REGION 4827 . 6124) (REGION-TYPE 6126 . 6728)) (6731 14637 (RM-CREATEW 6741 . 8864) (
|
||||
RM-CLOSEW 8866 . 11884) (RM-GETREGION 11886 . 14035) (CLOSE-TYPED-W 14037 . 14635)) (15280 22759 (
|
||||
RELCREATEREGION 15290 . 19913) (RELGETREGION 19915 . 22522) (RELCREATEPOSITION 22524 . 22757)) (22760
|
||||
29564 (\RELCREATEREGION.REF 22770 . 26521) (\RELCREATEREGION.SIZE 26523 . 29562)) (29617 38959 (
|
||||
RM-ATTACHWINDOW 29627 . 38957)) (38960 40694 (CLOSEWITH 38970 . 39497) (CLOSEWITH.DOIT 39499 . 39779)
|
||||
(MOVEWITH 39781 . 40304) (MOVEWITH.DOIT 40306 . 40692)))))
|
||||
(FILEMAP (NIL (1615 6733 (SET-TYPED-REGIONS 1625 . 3800) (GRAB-TYPED-REGION 3802 . 4828) (
|
||||
REGISTER-TYPED-REGION 4830 . 6127) (REGION-TYPE 6129 . 6731)) (6734 14803 (RM-CREATEW 6744 . 8867) (
|
||||
RM-CLOSEW 8869 . 11887) (RM-GETREGION 11889 . 14038) (CLOSE-TYPED-W 14040 . 14801)) (15446 22925 (
|
||||
RELCREATEREGION 15456 . 20079) (RELGETREGION 20081 . 22688) (RELCREATEPOSITION 22690 . 22923)) (22926
|
||||
29730 (\RELCREATEREGION.REF 22936 . 26687) (\RELCREATEREGION.SIZE 26689 . 29728)) (29783 39125 (
|
||||
RM-ATTACHWINDOW 29793 . 39123)) (39126 40860 (CLOSEWITH 39136 . 39663) (CLOSEWITH.DOIT 39665 . 39945)
|
||||
(MOVEWITH 39947 . 40470) (MOVEWITH.DOIT 40472 . 40858)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
73
lispusers/TAB-WINDOWS
Normal file
73
lispusers/TAB-WINDOWS
Normal file
@@ -0,0 +1,73 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Aug-2024 11:31:37" {DSK}<Users>hjellinek>Projects>IL>TAB-WINDOWS.;13 3078
|
||||
|
||||
:CHANGES-TO (FNS START-TAB-WINDOWS TAB-WINDOWS SHOW-KEYS IS-KEY-DOWN? KEY-WINDOW)
|
||||
(VARS TAB-WINDOWSCOMS)
|
||||
(PROPS (TAB-WINDOWS :COMPILE-FILE))
|
||||
|
||||
:PREVIOUS-DATE " 4-Jun-2024 09:48:34" {DSK}<Users>hjellinek>Projects>IL>TAB-WINDOWS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TAB-WINDOWSCOMS)
|
||||
|
||||
(RPAQQ TAB-WINDOWSCOMS ((FNS IS-KEY-DOWN? START-TAB-WINDOWS TAB-WINDOWS SHOW-KEYS KEY-WINDOW)
|
||||
(PROP :COMPILE-FILE TAB-WINDOWS)))
|
||||
(DEFINEQ
|
||||
|
||||
(IS-KEY-DOWN?
|
||||
[LAMBDA (KEY-NAME KEYS-DOWN)
|
||||
(for KEY-NAME-LIST in KEYS-DOWN thereis (FMEMB KEY-NAME KEY-NAME-LIST])
|
||||
|
||||
(START-TAB-WINDOWS
|
||||
[LAMBDA (META-KEY-NAME)
|
||||
(ADD.PROCESS (LIST 'TAB-WINDOWS (KWOTE META-KEY-NAME))
|
||||
'NAME "Window Tabber" 'RESTARTABLE T])
|
||||
|
||||
(TAB-WINDOWS
|
||||
[LAMBDA (META-KEY-NAME)
|
||||
|
||||
(* ;; "When the meta and tab keys go down, TOTOPW the next window in OPENWINDOWS")
|
||||
|
||||
(DECLARE (CL:SPECIAL \KEYNAMES))
|
||||
(LET ((CURRENT-WINDOW NIL)
|
||||
(OPEN-WINDOWS (OPENWINDOWS)))
|
||||
(CL:UNWIND-PROTECT
|
||||
[PROGN (while T
|
||||
do ([LET ((KEYS-DOWN (for K in \KEYNAMES when (KEYDOWNP K) collect K)))
|
||||
[if (AND (IS-KEY-DOWN? 'TAB KEYS-DOWN)
|
||||
(IS-KEY-DOWN? META-KEY-NAME KEYS-DOWN))
|
||||
then (if CURRENT-WINDOW
|
||||
then (TOTOPW CURRENT-WINDOW)
|
||||
(SETQ CURRENT-WINDOW (CADR (FMEMB CURRENT-WINDOW
|
||||
OPEN-WINDOWS)))
|
||||
else (SETQ CURRENT-WINDOW (CAR OPEN-WINDOWS]
|
||||
(if (NOT KEYS-DOWN)
|
||||
then (SETQ CURRENT-WINDOW NIL)
|
||||
(SETQ OPEN-WINDOWS (OPENWINDOWS]
|
||||
(BLOCK 20])])
|
||||
|
||||
(SHOW-KEYS
|
||||
[LAMBDA NIL
|
||||
(DECLARE (CL:SPECIAL \KEYNAMES))
|
||||
(LET ((WINDOW (CREATEW NIL "Keys down")))
|
||||
(WINDOWPROP WINDOW 'PROCESS (THIS.PROCESS))
|
||||
[WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
|
||||
(DEL.PROCESS (WINDOWPROP W 'PROCESS]
|
||||
(CL:UNWIND-PROTECT
|
||||
[PROGN (while T do (LET ((DOWN-KEYS (for K in \KEYNAMES when (KEYDOWNP K) collect K)))
|
||||
(BLOCK 100)
|
||||
(CLEARW WINDOW)
|
||||
(COND
|
||||
(DOWN-KEYS (PRIN1 DOWN-KEYS WINDOW]
|
||||
(CLOSEW WINDOW))])
|
||||
|
||||
(KEY-WINDOW
|
||||
[LAMBDA NIL
|
||||
(ADD.PROCESS '(SHOW-KEYS)
|
||||
'NAME "Showing Keys" 'RESTARTABLE T])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (645 3055 (IS-KEY-DOWN? 655 . 791) (START-TAB-WINDOWS 793 . 950) (TAB-WINDOWS 952 . 2219
|
||||
) (SHOW-KEYS 2221 . 2939) (KEY-WINDOW 2941 . 3053)))))
|
||||
STOP
|
||||
BIN
lispusers/TAB-WINDOWS.DFASL
Normal file
BIN
lispusers/TAB-WINDOWS.DFASL
Normal file
Binary file not shown.
BIN
lispusers/TAB-WINDOWS.TEdit
Normal file
BIN
lispusers/TAB-WINDOWS.TEdit
Normal file
Binary file not shown.
@@ -1,29 +1,32 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Mar-2024 23:45:38" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;119 8322
|
||||
(FILECREATED "23-Dec-2024 19:26:20" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;133 11059
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS PF-TEDIT)
|
||||
|
||||
:PREVIOUS-DATE "25-Dec-2023 12:29:39" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;118)
|
||||
:PREVIOUS-DATE " 7-Dec-2024 18:00:39" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;132)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
|
||||
|
||||
(RPAQQ TEDIT-PF-SEECOMS
|
||||
[(FNS PF-TEDIT)
|
||||
[(FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
|
||||
(COMMANDS ts tf)
|
||||
(FILES (SYSLOAD)
|
||||
REGIONMANAGER)
|
||||
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION))
|
||||
REGIONMANAGER VERSIONDEFS)
|
||||
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
|
||||
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
|
||||
(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT))
|
||||
(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(DEFINEQ
|
||||
|
||||
(PF-TEDIT
|
||||
[LAMBDA (FN IFILES REPRINT) (* ; "Edited 27-Mar-2024 23:45 by rmk")
|
||||
[LAMBDA (FN IFILES VERSION REPRINT) (* ; "Edited 6-Dec-2024 19:15 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 13:03 by rmk")
|
||||
(* ; "Edited 27-Mar-2024 23:45 by rmk")
|
||||
(* ; "Edited 25-Dec-2023 12:24 by rmk")
|
||||
(* ; "Edited 5-Dec-2023 23:50 by rmk")
|
||||
(* ; "Edited 12-Oct-2023 00:19 by rmk")
|
||||
@@ -46,21 +49,32 @@
|
||||
((t T NIL)
|
||||
(SETQ REPRINT T)
|
||||
(SETQ FN LASTWORD))
|
||||
(SETQ LASTWORD FN))
|
||||
(if (VERSIONP FN)
|
||||
then (SETQ IFILES (CONS FN))
|
||||
(SETQ FN LASTWORD)
|
||||
else (SETQ LASTWORD FN)))
|
||||
(CL:UNLESS FN (ERROR "No function to print"))
|
||||
(CL:WHEN (AND (VERSIONP IFILES)
|
||||
(NULL VERSION))
|
||||
(SETQ VERSION IFILES)
|
||||
(SETQ IFILES NIL))
|
||||
(CL:WHEN (INTERSECTION '(T t)
|
||||
IFILES)
|
||||
(SETQ REPRINT T)
|
||||
[SETQ IFILES (LDIFFERENCE IFILES '(t T])
|
||||
(IF [OR IFILES (SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
|
||||
(WHEREIS FN 'FUNCTIONS T]
|
||||
(CL:UNLESS IFILES
|
||||
(SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
|
||||
(WHEREIS FN 'FUNCTIONS T))))
|
||||
(IF IFILES
|
||||
THEN (* ; "skip compiled files")
|
||||
|
||||
(* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.")
|
||||
|
||||
(FOR IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW INSIDE IFILES
|
||||
UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
|
||||
*COMPILED-EXTENSIONS*)
|
||||
EACHTIME (CL:IF (VERSIONP IFILE)
|
||||
(SETQ IFILE (FINDFILEVERSION (CAR (WHEREIS FN NIL T))
|
||||
IFILE))) UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
|
||||
*COMPILED-EXTENSIONS*)
|
||||
DO (SETQ LOC (FINDFNDEF FN IFILE))
|
||||
(IF (LISTP LOC)
|
||||
THEN (SETQ TFPROP (LIST FN (CAR LOC)))
|
||||
@@ -80,6 +94,8 @@
|
||||
(SETFILEINFO ISTREAM 'FORMAT ENV)
|
||||
(SETQ TSTREAM (OPENTEXTSTREAM))
|
||||
(DSPFONT DEFAULTFONT TSTREAM)
|
||||
(PRINTOUT TSTREAM 5 "[From " (FULLNAME ISTREAM)
|
||||
"]" T)
|
||||
(PRINT-READER-ENVIRONMENT ENV TSTREAM)
|
||||
(IF REPRINT
|
||||
THEN (SETFILEPTR ISTREAM (POP LOC))
|
||||
@@ -126,20 +142,53 @@
|
||||
ELSE (printout T FN " not found on " LOC "." T)))
|
||||
(SETQ *LAST-DF* FN)
|
||||
ELSE (PRINTOUT T FN " has no function definition" T])
|
||||
|
||||
(PF-TEDIT-FROM-TEXT
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 5-Dec-2024 22:20 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 23:13 by rmk")
|
||||
|
||||
(* ;; "The function key for the meta,T and meta,t keys. This shows in a separate Tedit window the definition in TSTREAM of the function named by the selection SEL.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:UNLESS SEL
|
||||
(SETQ SEL (TEDIT.GETSEL TSTREAM)))
|
||||
(LET [[FILENAME (OR (TEXTPROP TSTREAM 'FILENAME)
|
||||
(AND (\TEDIT.PRIMARYPANE TSTREAM)
|
||||
(CADR (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM TSTREAM)
|
||||
'TF]
|
||||
(FN (MKATOM (TEDIT.SEL.AS.STRING TSTREAM SEL]
|
||||
(if (EQ 0 (NCHARS FN))
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "Please select a function to display" T)
|
||||
elseif FILENAME
|
||||
then [PF-TEDIT FN (CAR (MEMB (FILENAMEFIELD FILENAME)
|
||||
(WHEREIS FN NIL T]
|
||||
else (TEDIT.PROMPTPRINT TSTREAM (CONCAT FN " not found")
|
||||
T])
|
||||
)
|
||||
|
||||
(DEFCOMMAND ts (FILE WINDOW FORMAT)
|
||||
(TEDIT-SEE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX))
|
||||
(ERROR "FILE NOT FOUND" FILE))
|
||||
(DEFCOMMAND ts (FILE VERSION WINDOW FORMAT) (CL:WHEN (WINDOWP VERSION)
|
||||
(SETQ WINDOW VERSION)
|
||||
(SETQ VERSION -1))
|
||||
(CL:UNLESS VERSION (SETQ VERSION -1))
|
||||
(TEDIT-SEE (FINDFILEVERSION (OR (FINDFILE-WITH-EXTENSIONS FILE NIL
|
||||
'(NIL TEDIT TED TXT TEXT TEX))
|
||||
(ERROR "FILE NOT FOUND" FILE))
|
||||
VERSION)
|
||||
(OR WINDOW 'SEE)
|
||||
FORMAT))
|
||||
|
||||
(DEFCOMMAND tf (FN . IFILES) (PF-TEDIT FN IFILES))
|
||||
(DEFCOMMAND tf (FN FILE VERSION) (PF-TEDIT FN FILE VERSION))
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
REGIONMANAGER)
|
||||
REGIONMANAGER VERSIONDEFS)
|
||||
|
||||
(MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
|
||||
|
||||
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
|
||||
|
||||
(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT))
|
||||
|
||||
(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
@@ -149,5 +198,5 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (782 7802 (PF-TEDIT 792 . 7800)))))
|
||||
(FILEMAP (NIL (973 10035 (PF-TEDIT 983 . 8821) (PF-TEDIT-FROM-TEXT 8823 . 10033)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
143
lispusers/VERSIONDEFS
Normal file
143
lispusers/VERSIONDEFS
Normal file
@@ -0,0 +1,143 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Jan-2025 08:49:34" {WMEDLEY}<lispusers>VERSIONDEFS.;12 5880
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GETVINFO)
|
||||
|
||||
:PREVIOUS-DATE "12-Dec-2024 15:07:45" {WMEDLEY}<lispusers>VERSIONDEFS.;11)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT VERSIONDEFSCOMS)
|
||||
|
||||
(RPAQQ VERSIONDEFSCOMS [(FNS FINDFILEVERSION GETVINFO VERSIONP)
|
||||
(FNS EDV DFV)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA DFV EDV)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(DEFINEQ
|
||||
|
||||
(FINDFILEVERSION
|
||||
[LAMBDA (FILE VERSION DIRLIST NOERROR) (* ; "Edited 6-Dec-2024 22:12 by rmk")
|
||||
(* ; "Edited 1-Dec-2024 23:01 by rmk")
|
||||
(* ; "Edited 4-Oct-2024 15:23 by rmk")
|
||||
|
||||
(* ;; "Returns the version of FILE in DIRLIST that correspond to the relative version specifier VERSION. Negative version count backwrd from the newest (=-1), positive count forward from the oldest (=1). F, FIRST,OLDEST are equivalent to 1 (= oldest), N NEWEST are equivalent to -1 (newest).")
|
||||
|
||||
(LET (FILES)
|
||||
(SETQ VERSION (VERSIONP VERSION))
|
||||
(if (EQ VERSION -1)
|
||||
then (FINDFILE FILE T DIRLIST)
|
||||
elseif [SETQ FILES (FILDIR (PACKFILENAME 'VERSION '* 'BODY (FINDFILE FILE T DIRLIST]
|
||||
then (CAR (if (ILESSP VERSION 0)
|
||||
then
|
||||
(* ;; "-2 is the second newest version")
|
||||
|
||||
(NTH FILES (IMINUS VERSION))
|
||||
else
|
||||
(* ;; "2 is the second oldest")
|
||||
|
||||
(NTH (DREVERSE FILES)
|
||||
VERSION)))
|
||||
elseif (NOT NOERROR)
|
||||
then (ERROR (CONCAT "Version " VERSION " of " FILE " not found"])
|
||||
|
||||
(GETVINFO
|
||||
[LAMBDA (NAME TYPE FILE VERSION DIRLIST) (* ; "Edited 27-Jan-2025 08:49 by rmk")
|
||||
(* ; "Edited 6-Dec-2024 21:37 by rmk")
|
||||
(* ; "Edited 1-Dec-2024 23:50 by rmk")
|
||||
|
||||
(* ;; "Gets the TYPE definition of NAME from version VERSION of FILE, returns the definition after storing it under an annotated name that the filepkg doesn't see. ")
|
||||
|
||||
(if (VERSIONP TYPE)
|
||||
then (SETQ VERSION TYPE)
|
||||
(SETQ TYPE NIL)
|
||||
elseif (VERSIONP FILE)
|
||||
then (SETQ VERSION FILE)
|
||||
(SETQ FILE NIL))
|
||||
(CL:UNLESS [OR FILE (SETQ FILE (CAR (WHEREIS NAME TYPE T]
|
||||
(ERROR (CONCAT "File for " NAME " not found")))
|
||||
(CL:UNLESS VERSION
|
||||
(SETQ VERSION 'NEWEST))
|
||||
(LET ((VFILE (FINDFILEVERSION FILE VERSION DIRLIST))
|
||||
(CONNECTED (DIRECTORYNAME T T))
|
||||
DEF VNAME HOST DIR) (* ; "Don't include the whole path if it's the connected one. Perhaps we should create/return both a short name and a long name")
|
||||
(SETQ DEF (GETDEF NAME TYPE VFILE))
|
||||
(SETQ HOST (FILENAMEFIELD VFILE 'HOST))
|
||||
(SETQ DIR (FILENAMEFIELD VFILE 'DIRECTORY))
|
||||
(CL:WHEN (STRING.EQUAL HOST (FILENAMEFIELD CONNECTED 'HOST))
|
||||
(SETQ HOST NIL))
|
||||
(CL:WHEN (STRING.EQUAL DIR (FILENAMEFIELD CONNECTED 'DIRECTORY))
|
||||
(SETQ DIR NIL))
|
||||
(SETQ VNAME (PACK* (CL:IF HOST
|
||||
(CONCAT "{" HOST "}")
|
||||
"")
|
||||
(CL:IF DIR
|
||||
(CONCAT "<" (L-CASE DIR)
|
||||
">")
|
||||
"")
|
||||
NAME ";" (FILENAMEFIELD VFILE 'VERSION)
|
||||
(SELECTQ VERSION
|
||||
(1 " (F)")
|
||||
(-1 " (N)")
|
||||
"")))
|
||||
(LIST VNAME TYPE DEF])
|
||||
|
||||
(VERSIONP
|
||||
[LAMBDA (X) (* ; "Edited 6-Dec-2024 20:26 by rmk")
|
||||
|
||||
(* ;; "Normalize X if X is a version designator, otherwise NIL")
|
||||
|
||||
(SELECTQ X
|
||||
((F FIRST OLDEST)
|
||||
1)
|
||||
((N NEWEST 0)
|
||||
-1)
|
||||
(FIXP X])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(EDV
|
||||
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:30 by rmk")
|
||||
(* ; "Edited 2-Dec-2024 00:14 by rmk")
|
||||
(SETQ ARGS (MKLIST ARGS))
|
||||
(PROG ((NAME (POP ARGS))
|
||||
(TYPE (POP ARGS))
|
||||
(FILE (POP ARGS))
|
||||
(VERSION (POP ARGS))
|
||||
(DIRLIST (POP ARGS))
|
||||
VINFO)
|
||||
(SETQ VINFO (GETVINFO NAME TYPE FILE VERSION DIRLIST))
|
||||
(EDITE (CADDR VINFO)
|
||||
NIL
|
||||
(CAR VINFO)
|
||||
(CADR VINFO)
|
||||
NIL
|
||||
'(:DONTWAIT))
|
||||
(CAR VINFO])
|
||||
|
||||
(DFV
|
||||
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:29 by rmk")
|
||||
(* ; "Edited 2-Dec-2024 00:08 by rmk")
|
||||
(SETQ ARGS (MKLIST ARGS))
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST (POP ARGS)
|
||||
NIL
|
||||
(POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA DFV EDV)
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (671 4570 (FINDFILEVERSION 681 . 2128) (GETVINFO 2130 . 4253) (VERSIONP 4255 . 4568)) (
|
||||
4571 5717 (EDV 4581 . 5281) (DFV 5283 . 5715)))))
|
||||
STOP
|
||||
BIN
lispusers/VERSIONDEFS.LCOM
Normal file
BIN
lispusers/VERSIONDEFS.LCOM
Normal file
Binary file not shown.
BIN
lispusers/VERSIONDEFS.TEDIT
Normal file
BIN
lispusers/VERSIONDEFS.TEDIT
Normal file
Binary file not shown.
28
lispusers/WHICHKEY
Normal file
28
lispusers/WHICHKEY
Normal file
@@ -0,0 +1,28 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Jan-2025 15:47:23" {WMEDLEY}<lispusers>WHICHKEY.;3 1037
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS WHICHKEY)
|
||||
|
||||
:PREVIOUS-DATE "23-Jan-2025 15:46:57" {WMEDLEY}<lispusers>WHICHKEY.;2)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT WHICHKEYCOMS)
|
||||
|
||||
(RPAQQ WHICHKEYCOMS ((FNS DOWNP WHICHKEY)))
|
||||
(DEFINEQ
|
||||
|
||||
(DOWNP
|
||||
[LAMBDA (KEYNAME) (* ; "Edited 19-May-2018 20:03 by rmk:")
|
||||
(PROGN (DISMISS 2000)
|
||||
(KEYDOWNP KEYNAME])
|
||||
|
||||
(WHICHKEY
|
||||
[LAMBDA (DELAY) (* ; "Edited 23-Jan-2025 15:44 by rmk")
|
||||
(* ; "Edited 4-Dec-2023 16:04 by rmk")
|
||||
(* ; "Edited 18-May-2018 13:09 by rmk:")
|
||||
(PROGN (DISMISS (OR DELAY 3000))
|
||||
(for X IN \KEYNAMES when (KEYDOWNP (CAR X)) collect X])
|
||||
)
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Jan-2024 13:20:30" {WMEDLEY}<lispusers>COMPARETEXT.;133 48539
|
||||
(FILECREATED "17-Dec-2024 20:47:21" {WMEDLEY}<lispusers>COMPARETEXT.;134 48583
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS IMCOMPARE.COLLECT.HASH.CHUNKS)
|
||||
|
||||
:PREVIOUS-DATE "14-Jan-2024 13:11:44" {WMEDLEY}<lispusers>COMPARETEXT.;132)
|
||||
:PREVIOUS-DATE "14-Jan-2024 13:20:30" {WMEDLEY}<lispusers>COMPARETEXT.;133)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPARETEXTCOMS)
|
||||
@@ -291,7 +291,8 @@
|
||||
TITLE TEXTWIDTH TEXTHEIGHT])
|
||||
|
||||
(IMCOMPARE.COLLECT.HASH.CHUNKS
|
||||
[LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 14-Jan-2024 13:20 by rmk")
|
||||
[LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 17-Dec-2024 20:46 by rmk")
|
||||
(* ; "Edited 14-Jan-2024 13:20 by rmk")
|
||||
(* ; "Edited 18-Oct-2023 17:45 by rmk")
|
||||
(* ; "Edited 20-Jan-2022 23:09 by rmk")
|
||||
(* ; "Edited 24-Dec-2021 22:30 by rmk")
|
||||
@@ -315,7 +316,6 @@
|
||||
(OPENTEXTSTREAM STREAM NIL NIL NIL
|
||||
`(OBJECTBYTE ,(CHARCODE *]
|
||||
'(PROGN (CLOSEF? OLDVALUE])
|
||||
(SETFILEINFO STREAM 'EOL 'ANY)
|
||||
(CL:UNLESS (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK)
|
||||
|
||||
(* ;;
|
||||
@@ -780,12 +780,12 @@
|
||||
GRAPHER)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1234 40907 (COMPARETEXT 1244 . 2884) (COMPARETEXT.WINDOW 2886 . 6684) (
|
||||
(FILEMAP (NIL (1234 40951 (COMPARETEXT 1244 . 2884) (COMPARETEXT.WINDOW 2886 . 6684) (
|
||||
COMPARETEXT.TSTREAM 6686 . 9907) (COMPARETEXT.SETSEL 9909 . 10814) (CHUNKNODELABEL 10816 . 11937) (
|
||||
IMCOMPARE.BOXNODE 11939 . 12915) (IMCOMPARE.CHUNKS 12917 . 17525) (IMCOMPARE.COLLECT.HASH.CHUNKS 17527
|
||||
. 20676) (IMCOMPARE.DISPLAYGRAPH 20678 . 28757) (IMCOMPARE.HASH 28759 . 33117) (
|
||||
IMCOMPARE.MERGE.CONNECTED.CHUNKS 33119 . 36615) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 36617 . 38572) (
|
||||
IMCOMPARE.SHOW.DIST 38574 . 39020) (IMCOMPARE.UPDATE.SYMBOL.TABLE 39022 . 40905)) (40908 47392 (
|
||||
IMCOMPARE.LEFTBUTTONFN 40918 . 43822) (IMCOMPARE.MIDDLEBUTTONFN 43824 . 46940) (IMCOMPARE.COPYBUTTONFN
|
||||
46942 . 47390)) (47445 48136 (TAIL1 47455 . 47809) (TAIL2 47811 . 48134)))))
|
||||
. 20720) (IMCOMPARE.DISPLAYGRAPH 20722 . 28801) (IMCOMPARE.HASH 28803 . 33161) (
|
||||
IMCOMPARE.MERGE.CONNECTED.CHUNKS 33163 . 36659) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 36661 . 38616) (
|
||||
IMCOMPARE.SHOW.DIST 38618 . 39064) (IMCOMPARE.UPDATE.SYMBOL.TABLE 39066 . 40949)) (40952 47436 (
|
||||
IMCOMPARE.LEFTBUTTONFN 40962 . 43866) (IMCOMPARE.MIDDLEBUTTONFN 43868 . 46984) (IMCOMPARE.COPYBUTTONFN
|
||||
46986 . 47434)) (47489 48180 (TAIL1 47499 . 47853) (TAIL2 47855 . 48178)))))
|
||||
STOP
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user