1
0
mirror of synced 2026-03-14 22:38:23 +00:00

Compare commits

...

33 Commits

Author SHA1 Message Date
Larry Masinter
322b2e0fbe DFV gets FNS and/or FUNCTIONS, depending on what definitions exist (#2530)
If both exist, it brings up 2 Sedit windows.

The relative version numbers are currently mapped to Medley absolute
version numbers. It would be nice to extend VERSIONDEFS with a function
(say GEDV) that maps the relative version numbers into the definitions
on git-file versions, by looking at the history. So (GEDV 'FOO 'RECORD
-3) would find the file for FOO's record declaration from WHEREIS, and
get the definition from the version 3 commits back. But GITFNS doesn't
currently have a primitive for fetching and interpreting history.
2026-03-09 23:07:30 -07:00
rmkaplan
a24a4dffc2 READ-READER-ENVIRONMENT can take a file name in addition to an open stream (#2531) 2026-03-09 12:31:01 -07:00
rmkaplan
95e08680b8 \CORE.DIRECTORYNAMEP returns T for the {CORE} (no directory) case (#2522) 2026-03-09 12:15:33 -07:00
rmkaplan
7a7fca0bcf Add lispusers/CONVERT-TO-UTF8 (#2518)
* Add lispusers/CONVERT-TO-UTF8
* FILETYPE with no DFASL defaults to :FAKE-COMPILE-FILE
2026-03-09 12:15:14 -07:00
Matt Heffron
9e4d37efd7 Most of the --option uses were incorrectly converted when making loadup.1 from loadup.md. (#2528)
Most of the --option uses were incorrectly converted to an en-dash instead of two hyphens when making loadup.1 from loadup.md.
The en-dash didn't display correctly in the shell, typically as u with ^.
Edited loadup.md, and regenerated the other changed files using publish.sh
2026-03-09 12:14:19 -07:00
rmkaplan
b8c0c594a9 DFV gets FNS and/or FNS, depending on what definitions exist 2026-03-08 09:26:18 -07:00
rmkaplan
d9f1a78f47 GITFNS remembers user's last branch number in a {LI} file (#2526) 2026-03-07 12:56:21 -08:00
rmkaplan
ab4eb3d52d Remove UNICODE file reference from Tedit (#2527) 2026-03-04 08:11:52 -08:00
rmkaplan
0f470b9753 Rmk161 loadup works with utf 8 source files (#2512)
* New starter.sysout contains the UTF-8 external format
* Init.sysout is created with the UTF-8 external format
* Files with non-ascii characters and some other files converted to UTF-8, for basic testing
* Environment arg of WITH-READER-ENVIRONMENT can be a stream
* Compiler functions now respect the external format as copied from the source file
* Colon is the package delimiter in DEFINE-FILE-INFO expressions
* UNICODE file is deprecated in favor of UNICODE-FORMATS and UNICODE-TABLES
2026-03-02 11:56:11 -08:00
Larry Masinter
b1bdd90338 remove 'obsolete' folder from repo -- move to separate repo (#2503) 2026-03-02 11:49:31 -08:00
rmkaplan
1569a27209 \FONT.CHECKARGS extracts the right component if the font of a stream family is a fontclass (#2509) 2026-02-24 10:06:24 -08:00
rmkaplan
1ff475a42c Clarify 0-origin indexing for piece NTHCHARCODE operations (#2499)
* Clarify 0-origin indexing for piece NTHCHARCODE operations
* Change the name of the Tedit externalformat from :TEXTSTREAM to :TEDIT
2026-02-23 12:05:59 -08:00
rmkaplan
7904f9dd86 Better initial window size for OUTPUT TEDIT masterscope queries (#2501)
* Better initial window size for OUTPUT TEDIT masterscope queries: Creates the output stream, then measures the lines
2026-02-23 12:05:04 -08:00
rmkaplan
93a04227d8 Rmk158 Remake files to convert the 247Q package-delimiter in DEFINE-FILE-INFO to 30Q (#2506)
* Remake files to convert the 247Q package-delimiter in DEFINE-FILE-INFO expressions to 30Q

* Remake TRANSOR after removing HIST command

* Remake TRANSOR-LOADTRAN after changing the filecoms variable
2026-02-23 12:04:11 -08:00
rmkaplan
cc0a819cd5 MCCS coding for UNIX-GETENV, fix MTOUTF8STRING (#2474)
* MCCS translations for strings passed to/from UNIX-GETENV and other system interfaces.
* INTERPRET.REM.CM assumes system external format is UTF-8.  ISO8859/1 external format is defined in MCCS as a dummy for UTF-8 until UNICODE is loaded
* Add string translation interface to EXTERNALFORMAT datatype, 
* Set the external format of the default reader environment to *DEFAULT-EXTERNALFORMAT* = :MCCS
* Add external format :THROUGH16 for 16 bit codes, used by linebuffer
2026-02-16 12:06:09 -08:00
rmkaplan
075ca1a9f1 Reading indirect charsets in MEDLEYFONT doesn't smash the default font (#2496) 2026-02-14 14:06:06 -08:00
rmkaplan
69bb98c49a Rmk157 Minor Tedit updates--improved page layout menu, TEDIT.PARAGRAPH.BOUNDARIES, other bug fixes (#2479)
* TEDIT adds TEDIT.PARAGRAPH.BOUNDARIES, fixed TEDIT.MAP.OBJECTS, a few other bugs
* Addresses the page layout menu #2447 and #2457
* TEDIT-STREAM add open method
* Ctrl-p inserts page number object
* Restore page number pretext and posttext in menu
2026-02-13 17:46:06 -08:00
rmkaplan
bb830e75f0 Fixed COMPAREDIRECTORIES See command so it doesn't fail if only one file to show (#2488)
See command in compare-directories browser doesn't fail if only one file
2026-02-13 17:44:04 -08:00
Matt Heffron
dc86cd8f80 Fix POSTSCRIPTSTREAM loading of PSCFONT so unaccented fonts aren't re-encoded. (#2490) 2026-02-12 14:55:55 -08:00
Larry Masinter
03b59d5a33 Rename 'NOBIND' table name to 'UNBOUND' to allow running interpreted (#2484)
evaluating a variable bound to NOBIND causes errors when run interpreted (doesn't when run compiled). It's not clear why this design decision was made, but in this case compiling MASTERSCOPE was hung up trying to run a subfuncion involved in macroexpansion after LOAD(MASTERSCOPE).
2026-02-09 09:37:19 -08:00
Paolo Amoroso
03ca57d22a Revise README of medley repo (#2481)
Revise and update the repo's README to address issue #2449 by adding an
introduction to the project; referring to the glossary for
system-specific terms; replacing section Running Medley Interlisp with a
reference to the Medley primer; and removing the obsolete link "docs --
Documentation files".
2026-02-06 17:30:53 -08:00
rmkaplan
5fadc0f632 man tedit and man sketch (#2468)
man tedit and man sketch bring up desktop windows with relevant pdf documentation files
2026-02-04 22:09:08 -08:00
Larry Masinter
53b13dc8ed remove useless duplicate spellfile (#2470) 2026-02-02 13:02:10 -08:00
rmkaplan
f937e2ca98 Rmk151 Remove old fontfile conventions from \FONTFILENAME (#2462)
* Remove code for archaic \FONTFILENAME conventions, MEDLEYFONTFORMAT now calls the generic function.

* Add OCTALSTRING to APRINT so FONT can use it.  Eventually remove it from PUP
2026-02-02 11:58:11 -08:00
rmkaplan
53d6387e93 Update to new imagefile architetecture (#2467)
* Update HPGL to new imagefile architetecture

* {LPT} improvements, TEXT imagetype centralized in HARDCOPY

* \EXTERNALFORMAT respects explicit fields in create stream expressions, doesn't override non-NIL fields
2026-02-02 11:56:50 -08:00
Nick Briggs
de0ba95497 Removes lispusers/BLOCKS-HKB[.LCOM] duplicate file (#2471)
The file lispusers/BLOCKS-HKB is a duplicate of lispusers/h/H-BLOCKS
except with differing end-of-line convention.  This PR removes
BLOCKS-HKB and BLOCKS-HKB.LCOM

Closes #2079
2026-02-02 11:50:57 -08:00
Larry Masinter
2e606befcf Fix bug / typo in MAKE-INDEX-HTMLS (#2469) 2026-01-28 15:06:21 -08:00
Matt Heffron
05a4c48f38 Fixed dumping of the running page header that was from the HEADER option of TEXTTOIMAGESTREAM. (#2461)
* Fixed dumping of the running page header that was from the HEADER option of TEXTTOIMAGESTREAM.

* Restored (CONSTANT ...) around a TIMES call (that *really* ought to optimize at compilation).
2026-01-27 19:58:12 -08:00
Larry Masinter
43e08ea85b remove _ (underbar) from JS up button, add META for UTF-8 in HTML (#2464) 2026-01-27 19:50:48 -08:00
Herb Jellinek
1e77a2e116 FX-80 files are obsolete (#2466)
Moved FX-80 files to obsolete/library.
2026-01-27 14:56:15 -08:00
rmkaplan
65df2ba6a4 Hardcopy to printer (#2290)
* Separate interface for imagefile creation from the send-to-printer interface
* SEND.FILE.TO.PRINTER recognizes :DEFAULTPRINTER
* Various changes to address #2414
* Move BITMAP properties from PRINTERTYPES to PRINTFILETYPES.
* Fix ShellOpen, add UNIX-TMP-FILE-NAME
* Include COERCEFONTSPEC changes in anticipation of HTML streams
* PDFSTREAM compatible with new imagefile architecture plus able to convert non-local Postscript streams
* SKETCH compatible with new imagefile/printing architecture
* TEDIT compatible with new printing architecture
* Tedit files are of type TEDIT, not TEXT, new interface function TEDIT.TO.IMAGEFILE
* ATTACHEDWINDOW:  DOATTACHEDWINDOWCOM allows menu to have a form to EVAL, like the background menu
* WINDOW: fix menus for new hardcopy architecture
* Remove FLUSHFONTSINCORE--FLUSHFONTCACHE is more general
* LOAD character names as suggested in PR #2398
* HARDCOPYW respects file extension
* VIEWER as default printinghost
* SLASHIT interprets '.
* MCCS to UTF8 conversion on printer name
* Deal with {LPT}.LOCAL and upper casing
* @ LPT printers work with exact upper/lower matching
* Using NSPRINT functions to recognize fax
* Let "UNIX" be the name of the default printer of type UNIX
2026-01-26 15:38:22 -08:00
Larry Masinter
23cef354eb index.html's exsternal-format is UTF-8 (#2454)
* set :external-format of index-html to be UTF-8
* remove duplicate MAKE-INDEX-HTMLS and unneccessary READVISE
2026-01-25 09:01:32 -08:00
rmkaplan
c793c967c6 Rmk150 tedit and sketch doc files (#2450)
* Add scanned pdfs to library/tedit/docs/

* Add scanned pdfs to library/sketch/docs/
2026-01-21 18:00:20 -08:00
1120 changed files with 16776 additions and 109491 deletions

View File

@@ -1,12 +1,14 @@
# Medley
This repository is for the Lisp environment of [Medley](https://interlisp.org).
The [Medley Interlisp Project](https://interlisp.org) aims to preserve, revive, and modernize the [Interlisp](https://interlisp.org) software development environment for rapid prototyping, research and Artificial Intelligence created at Xerox PARC since the 1970s.
[Install and Run](https://interlisp.org/software/install-and-run) covers ways to install and start up Medley on Linux systems, MacOS, and Windows (with or without WSL).
This repository is for the Lisp environment of the [Medley](https://interlisp.org) release of Interlisp. Other repositories hold additional subsystems and applications such as [Maiko](https://github.com/Interlisp/maiko), the implementation (in C) of the Medley virtual machine, the [LOOPS](https://github.com/Interlisp/loops) object-oriented extension of Interlisp, and the [NoteCards](https://github.com/Interlisp/notecards) hypermedia system.
[Install and Run](https://interlisp.org/software/install-and-run) covers ways to install and start up Medley on Linux systems, MacOS, Windows (with or without WSL), and in a web browser.
[Using Medley](https://interlisp.org/software/using-medley/) has an overview and pointers to documentation.
[Interlisp/maiko](https://github.com/Interlisp/maiko), is the repo for the implementation (in C) of the Medley virtual machine.
The [Glossary](https://interlisp.org/history/glossary) defines system-specific terms such as "loadup" and "sysout".
## Releases
@@ -67,25 +69,9 @@ If you have a high-resolution display, note that much of the graphics was design
Medley presumes you have a 3-button mouse; the scroll-wheel on some mice acts as one, with some difficulty. Go into XQuartz Preferences/Input and check "Emulate three button mouse" option.
### Running Medley Interlisp (obsolete)
### Running Medley Interlisp
The `run-medley` script in this repo sets up some convenient defaults. Running Medley can be done by typing:
```
$ cd medley
$ ./run-medley
```
Or, if you wish to start Medley up with a different SYSOUT:
```
$ cd medley
$ ./run-medley <SYSOUT-file-name>
```
The first time the system is run it loads the system image that comes
with the system. When you exit the system (or "do a `SaveVM`" menu
option) the state of your machine is saved in a file named
`~/lisp.virtualmem`. Subsequent system startups load the
`~/lisp.virtualmem` image by default.
The primer [Medley Interlisp for the Newcomer](https://primer.interlisp.org) eases new users into the Interlisp environment. It assumes no prior knowledge of Lisp and covers the user interface, programming and debugging, windows and graphics, and more. We recommend consulting this document to learn how to run and use the system.
### Exiting The System
@@ -123,7 +109,7 @@ Each directory should have a README.md, but briefly
* BUILDING.md -- instructions on how to make your own loadups
* clos -- early implementation of Common Lisp Object System
* CLTL2 -- files submitted to bring Medley up to the conformance to "Common Lisp, the Language" 2nd edition. Not enough to conform to the ANSI standard lisp.
* docs -- Documentation files (in TEdit format, PDFs, or online help; look [here](https://github.com/Interlisp/medley/Documentation))
* docs -- Documentation files (in TEdit format, PDFs, or online help
* fonts -- raster fonts (or font widths) in various resolutions for display, postscript, interpress, press formats
* greetfiles -- various configuration setups
* internal -- These _were_ internal to Venue

Binary file not shown.

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Nov-2025 12:30:08" {DSK}<Users>larry>il>MEDLEY>GREETFILES>APPS-INIT.;2 23361
(FILECREATED " 1-Feb-2026 13:41:02" {WMEDLEY}<greetfiles>APPS-INIT.;11 22926
:EDIT-BY "lmm"
:EDIT-BY rmk
:CHANGES-TO (FNS Apps.CreateButtons)
:CHANGES-TO (FNS XCL-USER::EXEC¬INTERLISP)
:PREVIOUS-DATE "25-Feb-2024 13:56:23" {DSK}<Users>larry>il>MEDLEY>GREETFILES>APPS-INIT.;1)
:PREVIOUS-DATE " 1-Feb-2026 07:58:14" {WMEDLEY}<greetfiles>APPS-INIT.;9)
(PRETTYCOMPRINT APPS-INITCOMS)
@@ -19,7 +19,7 @@
(Apps.RoomsActivated NIL))
(FNS Apps.InitNotecards Apps.SetUpNOTECARDSDIRECTORIES Apps.DoInit Apps.CreateButtons
Apps.CreateLabel Apps.ActivateCLOS Apps.ActivateRooms Apps.ShowDoc
XCL-USER::EXEC_INTERLISP Apps.AroundExitFn)
XCL-USER::EXEC¬INTERLISP Apps.AroundExitFn)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit)))
(DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
@@ -35,52 +35,53 @@
(RPAQ? Apps.RoomsActivated NIL)
(DEFINEQ
(Apps.InitNotecards
(Apps.InitNotecards
[LAMBDA (DoNotRefreshButtons)
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
(* ; "Edited 19-Jan-2023 11:57 by FGH")
(* ; "Edited 7-Dec-2022 11:14 by FGH")
(* ; "Edited 12-Nov-2022 14:41 by FGH")
(* ; "Edited 11-Sep-2022 01:09 by fgh")
(* ; "Edited 7-Feb-2022 20:22 by tp7")
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
(* ; "Edited 1-Feb-2026 00:00 by rmk")
(* ; "Edited 19-Jan-2023 11:57 by FGH")
(* ; "Edited 7-Dec-2022 11:14 by FGH")
(* ; "Edited 12-Nov-2022 14:41 by FGH")
(* ; "Edited 11-Sep-2022 01:09 by fgh")
(* ; "Edited 7-Feb-2022 20:22 by tp7")
(LET* [[SRCDIR (OR (UNIX-GETENV 'NOTEFILESSRC)
(AND (UNIX-GETENV 'NC_INSTALLDIR)
(CONCAT (UNIX-GETENV 'NC_INSTALLDIR)
(AND (UNIX-GETENV 'NC¬INSTALLDIR)
(CONCAT (UNIX-GETENV 'NC¬INSTALLDIR)
"/notefiles"))
(LET ((SUBDIR "notecards/notefiles"))
(for DIR in (LIST (CONCAT (MEDLEYDIR)
(for DIR in (LIST (CONCAT (MEDLEYDIR)
SUBDIR)
(CONCAT (MEDLEYDIR)
"../" SUBDIR)
(CONCAT (MEDLEYDIR)
"../../" SUBDIR)) thereis (DIRECTORYNAME DIR]
"../../" SUBDIR)) thereis (DIRECTORYNAME DIR]
(DESTDIR (OR (UNIX-GETENV 'NOTEFILESDIR)
(AND (UNIX-GETENV 'MEDLEY_USERDIR)
(CONCAT (UNIX-GETENV 'MEDLEY_USERDIR)
(AND (UNIX-GETENV 'MEDLEY¬USERDIR)
(CONCAT (UNIX-GETENV 'MEDLEY¬USERDIR)
"/notefiles"))
(CONCAT LOGINDIR "notefiles"]
[if (AND (NOT (DIRECTORYNAME DESTDIR))
[if (AND (NOT (DIRECTORYNAME DESTDIR))
(DIRECTORYNAME SRCDIR))
then (for NF in (DIRECTORY (CONCAT SRCDIR "/*"))
do (COPYFILE NF (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR 'NAME
then (for NF in (DIRECTORY (CONCAT SRCDIR "/*"))
do (COPYFILE NF (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR 'NAME
(FILENAMEFIELD NF 'NAME)
'EXTENSION
(FILENAMEFIELD NF 'EXTENSION)
'VERSION
(FILENAMEFIELD NF 'VERSION]
(LET* ((PW-REGION (WINDOWPROP PROMPTWINDOW 'REGION))
(LEFT (IPLUS (fetch (REGION RIGHT) of PW-REGION)
(LEFT (IPLUS (fetch (REGION RIGHT) of PW-REGION)
20))
(BOTTOM (fetch (REGION BOTTOM) of PW-REGION)))
(NC.BringUpNoteCardsIcon (create POSITION
(BOTTOM (fetch (REGION BOTTOM) of PW-REGION)))
(NC.BringUpNoteCardsIcon (create POSITION
XCOORD _ LEFT
YCOORD _ BOTTOM)))
(NC.FileBrowserMenu NC.NoteCardsIconWindow (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR
'NAME "*" 'EXTENSION "notefile")
(CREATEREGION 50 (IDIFFERENCE SCREENHEIGHT 700)
550 220))
(if (NULL (SASSOC 'NoteCards BackgroundMenuCommands))
then (PROGN [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands
(if (NULL (SASSOC 'NoteCards BackgroundMenuCommands))
then (PROGN [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands
(LIST '(NoteCards (
NC.BringUpNoteCardsIcon
)
@@ -89,59 +90,61 @@
]
(SETQ BackgroundMenu NIL)))
(SETQ Apps.NotecardsActivated T)
(if (NOT DoNotRefreshButtons)
then (Apps.CreateButtons])
(if (NOT DoNotRefreshButtons)
then (Apps.CreateButtons])
(Apps.SetUpNOTECARDSDIRECTORIES
(Apps.SetUpNOTECARDSDIRECTORIES
[LAMBDA NIL
(* ;; "Find the location of the Notecards directory and call NC.SetUpNOTECARDSDIRECTORIES.")
(* ;; "Find the location of the Notecards directory and call NC.SetUpNOTECARDSDIRECTORIES.")
(* ;; " This is needed to make sure that lazy loading of Notecard types works.")
(* ;; " This is needed to make sure that lazy loading of Notecard types works.")
(LET* [(LOC1 (CONCAT MEDLEYDIR "notecards>"))
(LOC2 (CONCAT MEDLEYDIR "..>notecards>"))
(LOC3 (CONCAT MEDLEYDIR "..>..>notecards>"))
(NCDIR (for LOC in (LIST LOC1 LOC2 LOC3) thereis (OR (INFILEP (CONCAT LOC
(NCDIR (for LOC in (LIST LOC1 LOC2 LOC3) thereis (OR (INFILEP (CONCAT LOC
"system>NOTECARDS"))
(INFILEP (CONCAT LOC
"system>NOTECARDS.LCOM"
]
(if NCDIR
then [SETQ NCDIR (OR (INFILEP (CONCAT NCDIR "system>NOTECARDS"))
(if NCDIR
then [SETQ NCDIR (OR (INFILEP (CONCAT NCDIR "system>NOTECARDS"))
(INFILEP (CONCAT NCDIR "system>NOTECARDS.LCOM"]
(SETQ NCDIR (SUBSTRING NCDIR 1 (IDIFFERENCE (STRPOS "system>NOTECARDS" NCDIR)
1)))
(NC.SetUpNOTECARDSDIRECTORIES NCDIR)
T
else (PRIN1 "Warning: Notecards directory could not be found." T)
else (PRIN1 "Warning: Notecards directory could not be found." T)
(PRIN1 "Hence, NOTECARDSDIRECTORIES is probably not set correctly" T)
(PRIN1 "and Notecards will not work properly." T)
NIL])
(Apps.DoInit
(Apps.DoInit
[LAMBDA NIL
(* ;; "Edited 19-Jan-2023 12:43 by FGH")
(* ;; "Edited 31-Jan-2026 23:57 by rmk")
(* ;; "Edited 17-Jan-2023 23:23 by FGH")
(* ;; "Edited 19-Jan-2023 12:43 by FGH")
(* ;; "Edited 7-Dec-2022 11:14 by FGH")
(* ;; "Edited 17-Jan-2023 23:23 by FGH")
(* ;; "Edited 12-Nov-2022 13:57 by FGH")
(* ;; "Edited 7-Dec-2022 11:14 by FGH")
(* ;; "Edited 12-Oct-2022 20:23 by fgh")
(* ;; "Edited 12-Nov-2022 13:57 by FGH")
(* ;; "Edited 6-Sep-2022 17:22 by fgh")
(* ;; "Edited 12-Oct-2022 20:23 by fgh")
(* ;; "Edited 4-Sep-2022 16:44 by larry")
(* ;; "Edited 6-Sep-2022 17:22 by fgh")
(* ;; "Edited 18-Mar-2022 18:53 by fgh")
(* ;; "Edited 4-Sep-2022 16:44 by larry")
(* ;; "Edited 17-Dec-2021 22:05 by fgh")
(* ;; "Edited 18-Mar-2022 18:53 by fgh")
(* ;; "Edited 17-Dec-2021 22:05 by fgh")
(PROGN
(* ;; " Adjust windows so that the exec window and the prompt window don't overlap")
(* ;; " Adjust windows so that the exec window and the prompt window don't overlap")
[MAPC (OPENWINDOWS)
(FUNCTION (LAMBDA (W)
@@ -152,90 +155,92 @@
(IDIFFERENCE SCREENHEIGHT 18)))
((STREQUAL (WINDOWPROP W 'TITLE)
"Prompt Window")
(PROGN (MOVEW W (create POSITION
(PROGN (MOVEW W (create POSITION
XCOORD _ 50
YCOORD _ (IDIFFERENCE SCREENHEIGHT 120)))
(CLEARW W)))
((STREQUAL (WINDOWPROP W 'TITLE)
"Exec (XCL)")
(PROGN (WINDOWPROP W 'TITLE "Exec (INTERLISP)")
(MOVEW W (create POSITION
(MOVEW W (create POSITION
XCOORD _ 50
YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
(* ;; " Set up INITIALSLST based on information passed in from the Linux environment")
(* ;; " Set up INITIALSLST based on information passed in from the Linux environment")
[SETQ INITIALSLST (LIST (LIST USERNAME (UNIX-GETENV 'MEDLEY_FIRSTNAME)
(UNIX-GETENV 'MEDLEY_INITIALS]
[SETQ INITIALSLST (LIST (LIST USERNAME (UNIX-GETENV 'MEDLEY¬FIRSTNAME)
(UNIX-GETENV 'MEDLEY¬INITIALS]
(LOAD '{DSK}/usr/local/interlisp/medley/lispusers/HELPSYS.LCOM T)
(* ;; "change to interlisp exec if required")
(* ;; "change to interlisp exec if required")
(COND
((OR (STRING-EQUAL (UNIX-GETENV 'MEDLEY_EXEC)
((OR (STRING-EQUAL (UNIX-GETENV 'MEDLEY¬EXEC)
"inter")
(STRING-EQUAL (UNIX-GETENV 'NCO)
"true"))
(BKSYSBUF "(EXEC_INTERLISP)")))
(BKSYSBUF "(EXEC¬INTERLISP)")))
(* ;; "Always Activate CLOS")
(* ;; "Always Activate CLOS")
(Apps.ActivateCLOS)
(Apps.ActivateCLOS)
(* ;; " activate Notecards if requested")
(* ;; " activate Notecards if requested")
(COND
((STRING-EQUAL (UNIX-GETENV 'RUN_NOTECARDS)
((STRING-EQUAL (UNIX-GETENV 'RUN¬NOTECARDS)
"true")
(Apps.InitNotecards T)))
(Apps.InitNotecards T)))
(* ;; " activate Rooms if requested")
(* ;; " activate Rooms if requested")
(COND
((STRING-EQUAL (UNIX-GETENV 'RUN_ROOMS)
((STRING-EQUAL (UNIX-GETENV 'RUN¬ROOMS)
"true")
(Apps.ActivateRooms T)))
(Apps.ActivateRooms T)))
(* ;; " create the Documentation and ROOMS, Notecards Activation Buttons, if needed")
(* ;; " create the Documentation and ROOMS, Notecards Activation Buttons, if needed")
(Apps.CreateButtons T)
(Apps.CreateButtons T)
(* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet")
(* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet")
(SETTOPVAL '\NC.SourceAccessFlg NIL)
(* ;; "Setup NOTECARDSDIRECTORIES.")
(* ;; "Setup NOTECARDSDIRECTORIES.")
(Apps.SetUpNOTECARDSDIRECTORIES)
(Apps.SetUpNOTECARDSDIRECTORIES)
(* ;; "Add AROUNDEXITFN to ensure NOTECARDSDIRECTORIES get reset after LOGOUT, etc.")
(* ;; "Add AROUNDEXITFN to ensure NOTECARDSDIRECTORIES get reset after LOGOUT, etc.")
(SETQ AROUNDEXITFNS (LSUBST '(MEDLEY-INIT-VARS Apps.AroundExitFn)
'MEDLEY-INIT-VARS AROUNDEXITFNS])
(Apps.CreateButtons
[LAMBDA (DoDocsToo) (* ; "Edited 26-Nov-2025 12:29 by lmm")
(* ; "Edited 13-Dec-2022 12:51 by frank")
(* ; "Edited 7-Dec-2022 11:28 by FGH")
(* ; "Edited 5-Dec-2022 17:31 by FGH")
(* ; "Edited 12-Nov-2022 14:52 by FGH")
(Apps.CreateButtons
[LAMBDA (DoDocsToo) (* ; "Edited 31-Jan-2026 23:59 by rmk")
(* ; "Edited 26-Nov-2025 12:29 by lmm")
(* ; "Edited 13-Dec-2022 12:51 by frank")
(* ; "Edited 7-Dec-2022 11:28 by FGH")
(* ; "Edited 5-Dec-2022 17:31 by FGH")
(* ; "Edited 12-Nov-2022 14:52 by FGH")
(* ;; " Create buttons for Documentation and to activate Rooms, Notecards ")
(* ;; " Create buttons for Documentation and to activate Rooms, Notecards ")
(* ;; "Note: due to bug in DELETE-BUTTON need to create Doc buttons last. This will make sure that the NoteCards/Rooms buttons get properl deleted when they are activated. But the Doc buttons will not necessariy get deleted properly (but then there is never a need for them to be deleted).")
(* ;; "Note: due to bug in DELETE-BUTTON need to create Doc buttons last. This will make sure that the NoteCards/Rooms buttons get properl deleted when they are activated. But the Doc buttons will not necessariy get deleted properly (but then there is never a need for them to be deleted).")
(LET* ((FEATURES (LIST (LIST Apps.NotecardsActivated '(Apps.InitNotecards)
(LET* ((FEATURES (LIST (LIST Apps.NotecardsActivated '(Apps.InitNotecards)
"NOTECARDS")
(LIST Apps.RoomsActivated '(Apps.ActivateRooms)
(LIST Apps.RoomsActivated '(Apps.ActivateRooms)
"ROOMS")))
(FEATURES-LABELS (for FEATURE in FEATURES collect (CADDR FEATURE)))
(FEATURES-LABELS (for FEATURE in FEATURES collect (CADDR FEATURE)))
(DOCS (LIST (LIST "https://interlisp.org/docs/medley/orientation/" "BASICS")
(LIST "https://primer.interlisp.org/" "PRIMER")
(LIST "https://interlisp.org/documentation/IRM.pdf" "MANUAL")
(LIST "https://interlisp.org/documentation/notecards_user_guide_v1.2.pdf"
(LIST "https://interlisp.org/documentation/notecards¬user-guide¬v1.2.pdf"
"NOTECARDS")
(LIST "https://interlisp.org/documentation/ROOMSTECHDESC.pdf" "ROOMS")))
(DOCS-LABELS (for DOC in DOCS collect (CADR DOC)))
(DOCS-LABELS (for DOC in DOCS collect (CADR DOC)))
(RIGHTMARGINISH 140)
(SECTION1YPOS 225)
(YPOSDELTA 55)
@@ -249,31 +254,31 @@
(IWS NIL)
(BUTTONS NIL))
(* ;; "First remove/re-create feature buttons")
(* ;; "First remove/re-create feature buttons")
(for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
(LIST "ACTIVATE" "FEATURES")) do (CLOSEW W))
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
(for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
(LIST "ACTIVATE" "FEATURES")) do (CLOSEW W))
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
'FEATURE)
(MEMBER (BUTTON-LABEL B)
FEATURES-LABELS)) do (DELETE-BUTTON B))
[if FEATURES-REQUIREDP
then [SETQ IWS (LIST (Apps.CreateLabel "ACTIVATE" (IDIFFERENCE SCREENWIDTH
FEATURES-LABELS)) do (DELETE-BUTTON B))
[if FEATURES-REQUIREDP
then [SETQ IWS (LIST (Apps.CreateLabel "ACTIVATE" (IDIFFERENCE SCREENWIDTH
(IDIFFERENCE RIGHTMARGINISH 50
))
(IDIFFERENCE SCREENHEIGHT (IDIFFERENCE SECTION2YPOS 20)))
(Apps.CreateLabel "FEATURES" (IDIFFERENCE SCREENWIDTH
(Apps.CreateLabel "FEATURES" (IDIFFERENCE SCREENWIDTH
(IDIFFERENCE RIGHTMARGINISH 50
))
(IDIFFERENCE SCREENHEIGHT SECTION2YPOS]
(SETQ BUTTONS (for FEATURE in FEATURES
collect (OR (CAR FEATURE)
(SETQ BUTTONS (for FEATURE in FEATURES
collect (OR (CAR FEATURE)
(LET (B)
(SETQ BUTTONY-FEATURES (IPLUS BUTTONY-FEATURES
YPOSDELTA))
[SETQ B (CREATE-BUTTON (CADR FEATURE)
(CADDR FEATURE)
(create POSITION
(create POSITION
XCOORD _ (IDIFFERENCE
SCREENWIDTH
RIGHTMARGINISH)
@@ -284,30 +289,30 @@
(WINDOWPROP B 'Apps.BUTTON 'FEATURE)
B]
(* ;; "Then if needed, remove/recreate documentation buttons")
(* ;; "Then if needed, remove/recreate documentation buttons")
(if DoDocsToo
then (for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
(if DoDocsToo
then (for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
(LIST "DOCUMENTATION"))
do (CLOSEW W))
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
do (CLOSEW W))
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
'DOC)
(MEMBER (BUTTON-LABEL B)
DOCS-LABELS)) do (DELETE-BUTTON B))
(SETQ IWS (CONS (Apps.CreateLabel "DOCUMENTATION" (IDIFFERENCE SCREENWIDTH
DOCS-LABELS)) do (DELETE-BUTTON B))
(SETQ IWS (CONS (Apps.CreateLabel "DOCUMENTATION" (IDIFFERENCE SCREENWIDTH
(IDIFFERENCE
RIGHTMARGINISH 50)
)
(IDIFFERENCE SCREENHEIGHT SECTION1YPOS))
IWS))
(SETQ BUTTONS (APPEND (for DOC in DOCS
collect (LET (B)
(SETQ BUTTONS (APPEND (for DOC in DOCS
collect (LET (B)
(SETQ BUTTONY-DOCS (IPLUS BUTTONY-DOCS
YPOSDELTA))
[SETQ B (CREATE-BUTTON (LIST 'Apps.ShowDoc
(CAR DOC))
(CADR DOC)
(create POSITION
(create POSITION
XCOORD _
(IDIFFERENCE
SCREENWIDTH
@@ -319,30 +324,30 @@
(WINDOWPROP B 'Apps.BUTTON 'DOC)
B))
BUTTONS)))
[for B in BUTTONS do (COND
[for B in BUTTONS do (COND
((WINDOWP B)
(WINDOWPROP B 'RIGHTBUTTONFN 'NILL)
(WINDOWPROP B 'BUTTONEVENTFN (FUNCTION (LAMBDA (BUTTON)
(if (LASTMOUSESTATE
(if (LASTMOUSESTATE
(ONLY LEFT))
then (EXECUTE-BUTTON
then (EXECUTE-BUTTON
BUTTON]
[for IW in IWS do (COND
[for IW in IWS do (COND
((WINDOWP IW)
(WINDOWPROP IW 'RIGHTBUTTONFN 'NILL]
(for B in BUTTONS when (WINDOWP B) collect B])
(for B in BUTTONS when (WINDOWP B) collect B])
(Apps.CreateLabel
[LAMBDA (Text CenterX BottomY) (* ; "Edited 5-Dec-2022 16:49 by FGH")
(Apps.CreateLabel
[LAMBDA (Text CenterX BottomY) (* ; "Edited 5-Dec-2022 16:49 by FGH")
(LET* ((DS (DSPCREATE))
(FONT (DSPFONT '(HELVETICA 18 BOLD)
DS))
(SR (STRINGREGION Text DS))
(BMW (fetch (REGION WIDTH) of SR))
(BMH (IPLUS (fetch (REGION HEIGHT) of SR)
(fetch (REGION BOTTOM) of SR)))
(BMW (fetch (REGION WIDTH) of SR))
(BMH (IPLUS (fetch (REGION HEIGHT) of SR)
(fetch (REGION BOTTOM) of SR)))
(BM (BITMAPCREATE BMW BMH))
(POS (create POSITION
(POS (create POSITION
XCOORD _ (IDIFFERENCE CenterX (IQUOTIENT BMW 2))
YCOORD _ BottomY))
IW)
@@ -352,12 +357,12 @@
(WINDOWPROP IW 'ICONLABEL Text)
IW])
(Apps.ActivateCLOS
(Apps.ActivateCLOS
[LAMBDA NIL
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
(* ; "Edited 12-Nov-2022 14:41 by FGH")
(if (NULL (SASSOC "CLOS Browse Class" BackgroundMenuCommands))
then (PROGN [SETQ BackgroundMenuCommands
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
(* ; "Edited 12-Nov-2022 14:41 by FGH")
(if (NULL (SASSOC "CLOS Browse Class" BackgroundMenuCommands))
then (PROGN [SETQ BackgroundMenuCommands
(APPEND BackgroundMenuCommands
(LIST '("CLOS Browse Class" (CLOS-BROWSER::BROWSE-CLASS)
"Bring up a class browser."
@@ -372,27 +377,27 @@
]
(SETQ BackgroundMenu NIL])
(Apps.ActivateRooms
(Apps.ActivateRooms
[LAMBDA (DoNotRefreshButtons)
(DECLARE (GLOBALVARS BackgroundMenuCommands ROOMS:*SUITE-DIRECTORIES*))
(* ; "Edited 7-Dec-2022 11:13 by FGH")
(* ; "Edited 12-Nov-2022 14:56 by FGH")
(if (NULL (SASSOC "Rooms" BackgroundMenuCommands))
then (ROOMS:RESET))
(SETQ ROOMS:*SUITE-DIRECTORIES* (CONS (CONCAT (UNIX-GETENV 'MEDLE_USERDIR)
(DECLARE (GLOBALVARS BackgroundMenuCommands ROOMS:*SUITE-DIRECTORIES*))
(* ; "Edited 7-Dec-2022 11:13 by FGH")
(* ; "Edited 12-Nov-2022 14:56 by FGH")
(if (NULL (SASSOC "Rooms" BackgroundMenuCommands))
then (ROOMS:RESET))
(SETQ ROOMS:*SUITE-DIRECTORIES* (CONS (CONCAT (UNIX-GETENV 'MEDLEUSERDIR)
"/suites")
ROOMS:*SUITE-DIRECTORIES*))
(SETQ Apps.RoomsActivated T)
(PROMPTPRINT "
ROOMS functionality is now available via the Background Menu")
(if (NOT DoNotRefreshButtons)
then (Apps.CreateButtons])
(if (NOT DoNotRefreshButtons)
then (Apps.CreateButtons])
(Apps.ShowDoc
[LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:26 by FGH")
(Apps.ShowDoc
[LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:26 by FGH")
(ShellBrowse URL])
(XCL-USER::EXEC_INTERLISP
(XCL-USER::EXEC¬INTERLISP
[LAMBDA NIL (* ; "Edited 18-Mar-2022 18:53 by fgh")
(PROGN [MAPC (OPENWINDOWS)
(FUNCTION (LAMBDA (W)
@@ -406,10 +411,10 @@
(XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP)
(XCL:SET-EXEC-TYPE 'INTERLISP])
(Apps.AroundExitFn
(Apps.AroundExitFn
[LAMBDA (EVENT)
(if (MEMB EVENT '(AFTERLOGOUT AFTERSYSOUT AFTERSAVEVM))
then (Apps.SetUpNOTECARDSDIRECTORIES])
(if (MEMB EVENT '(AFTERLOGOUT AFTERSYSOUT AFTERSAVEVM))
then (Apps.SetUpNOTECARDSDIRECTORIES])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
@@ -420,8 +425,8 @@
(BKSYSBUF " ")
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1184 23227 (Apps.InitNotecards 1194 . 5056) (Apps.SetUpNOTECARDSDIRECTORIES 5058 . 6613
) (Apps.DoInit 6615 . 10212) (Apps.CreateButtons 10214 . 19123) (Apps.CreateLabel 19125 . 19935) (
Apps.ActivateCLOS 19937 . 21286) (Apps.ActivateRooms 21288 . 22139) (Apps.ShowDoc 22141 . 22290) (
XCL-USER::EXEC_INTERLISP 22292 . 23064) (Apps.AroundExitFn 23066 . 23225)))))
(FILEMAP (NIL (1153 22792 (Apps.InitNotecards 1163 . 5006) (Apps.SetUpNOTECARDSDIRECTORIES 5008 . 6527
) (Apps.DoInit 6529 . 10067) (Apps.CreateButtons 10069 . 18820) (Apps.CreateLabel 18822 . 19592) (
Apps.ActivateCLOS 19594 . 20919) (Apps.ActivateRooms 20921 . 21730) (Apps.ShowDoc 21732 . 21871) (
XCL-USER::EXEC¬INTERLISP 21873 . 22645) (Apps.AroundExitFn 22647 . 22790)))))
STOP

Binary file not shown.

View File

@@ -1,23 +1,27 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-May-2025 15:37:36" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;8 31221
(FILECREATED "28-Jan-2026 11:03:17" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;3 26880
:CHANGES-TO (FNS MAKE-INDEX-HTMLS)
:EDIT-BY "lmm"
:PREVIOUS-DATE "16-May-2025 13:51:08" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;7)
:CHANGES-TO (FNS MAKE-INDEX-HTMLS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES
MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS HCFILES RECOMPILE-ONE
RECMPL COMPILE-SETUP REMAKEFILES)
(ADVICE TEDIT.PROMPTPRINT)
:PREVIOUS-DATE "28-Jan-2026 10:46:02" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;1)
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
(RPAQQ MEDLEY-UTILSCOMS
[(FNS GATHER-INFO MAKE-FULLER-DB MAKE-INDEX-HTMLS MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
[(FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS)
(FNS HCFILES MAKE-INDEX-HTMLS)
(PROP FILETYPE MEDLEY-UTILS)
(ADVISE TEDIT.PROMPTPRINT)
(FNS RECOMPILE-ONE RECMPL COMPILE-SETUP REMAKEFILES)
(P (READVISE TEDIT.PROMPTPRINT))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
@@ -125,91 +129,6 @@
(MAKESYS (OR SYSOUTFILE "fuller.sysout")
"Welcome to Fuller sysout"])
(MAKE-INDEX-HTMLS
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm")
(* ; "Edited 26-Apr-2024 16:15 by lmm")
(* ; "Edited 20-Apr-2024 12:34 by lmm")
(* ; "Edited 13-Apr-2024 21:18 by lmm")
(* ; " Edited 16-May-2025 13:17 by fgh")
[OR BASE (SETQ BASE (TRUEFILENAME (MEDLEYDIR]
(OR (DIRECTORYNAMEP BASE)
(ERROR BASE "not a directory name"))
(OR (AND (NUMBERP LEVEL)
(IGREATERP LEVEL 0))
(SETQ LEVEL 1))
(OR ROOT.NAME (SETQ ROOT.NAME 'MEDLEY))
(RESETLST
(if (EQ LEVEL 1)
then (RESETSAVE (PSEUDOHOSTS T))
(PSEUDOHOST ROOT.NAME BASE))
(SETQ BASE (PSEUDOFILENAME BASE))
[LET*
((SUBDIRS NIL)
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
'}))
SLASHED SHORTNAME)
(CL:WITH-OPEN-FILE
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
(CL:FORMAT S "<SCRIPT>~%%")
(CL:FORMAT S " function up_onclick(){~%%")
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
(CL:FORMAT S " }~%%")
(CL:FORMAT S "</SCRIPT>~%%")
(CL:FORMAT S "</HEAD>~%%")
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
(CL:UNLESS (EQ LEVEL 1)
(CL:FORMAT S
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
))
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
(for FULLNAME in (DIRECTORY (CONCAT BASE "*.*;"))
do (if (EQ (NTHCHAR FULLNAME -1)
'>)
then
(* ;; "A directory")
(if (NOT (DIRECTORYNAMEP FULLNAME))
then (HELP (CONCAT "NOT DIRNAME " FULLNAME)))
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
(+ (NCHARS BASE)
(if PSEUDOHOST
then 2
else 1))
-2)))
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
(MEMB SHORTNAME '(.GIT))
[AND (STRPOS ".git" (L-CASE FULLNAME))
(NOT (STRPOS ".github" (L-CASE FULLNAME]
(INFILEP (CONCAT FULLNAME ".skip")))
(* ;; ".skip in the directory itself -- don't index any of it")
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
elseif (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
(SUB1 (OR (STRPOS ".;" FULLNAME)
(STRPOS ";" FULLNAME)
(HELP (CONCAT
"No ; in non-directory "
FULLNAME]
'(index.html .skip))
then
(* ;; "dont index the index")
elseif (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
'(IMPTR SKIP skip imptr))
then
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
else (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
(NCONC SUBDIRS (for D in SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
(ADD1 LEVEL])])
(MEDLEY-FIX-LINKS
[LAMBDA (UNIXPATH) (* ; "Edited 18-Jan-2021 12:01 by larry")
(OR UNIXPATH (SETQ UNIXPATH (UNIX-GETENV "MEDLEYDIR"))
@@ -361,7 +280,10 @@
(PRINTOUT T "DONE" T))])
(MAKE-INDEX-HTMLS
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm")
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 28-Jan-2026 11:01 by lmm")
(* ; "Edited 27-Jan-2026 10:50 by lmm")
(* ; "Edited 23-Jan-2026 11:59 by lmm")
(* ; "Edited 29-Apr-2024 14:18 by lmm")
(* ; "Edited 26-Apr-2024 16:15 by lmm")
(* ; "Edited 20-Apr-2024 12:34 by lmm")
(* ; "Edited 13-Apr-2024 21:18 by lmm")
@@ -385,20 +307,22 @@
'}))
SLASHED SHORTNAME)
(CL:WITH-OPEN-FILE
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE
:EXTERNAL-FORMAT :UTF-8)
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
(CL:FORMAT S "<META CHARSET=%"UTF-8%">~%%")
(CL:FORMAT S "<SCRIPT>~%%")
(CL:FORMAT S " function up_onclick(){~%%")
(CL:FORMAT S " function uponclick(){~%%")
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
(CL:FORMAT S " location = newLoc.replace(/\/[­\/]+\/?$/, %"%");~%%")
(CL:FORMAT S " }~%%")
(CL:FORMAT S "</SCRIPT>~%%")
(CL:FORMAT S "</HEAD>~%%")
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
(CL:UNLESS (EQ LEVEL 1)
(CL:FORMAT S
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"uponclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
))
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
(for FULLNAME in (DIRECTORY (CONCAT BASE "*.*;"))
@@ -539,8 +463,6 @@
(SETQ DIFF (COMPARESOURCES X DESTFILE NIL))
(TERPRI])
)
(READVISE TEDIT.PROMPTPRINT)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
@@ -550,9 +472,9 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1086 12975 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7389) (MAKE-INDEX-HTMLS
7391 . 12344) (MEDLEY-FIX-LINKS 12346 . 12739) (MEDLEY-FIX-DATES 12741 . 12973)) (14154 16942 (
MAKE-EXPORTS-ALL 14164 . 15223) (MAKE-WHEREIS-HASH 15225 . 16414) (MAKE-WHEREIS-LOOPS 16416 . 16940))
(16943 26173 (HCFILES 16953 . 21216) (MAKE-INDEX-HTMLS 21218 . 26171)) (26423 31035 (RECOMPILE-ONE
26433 . 28330) (RECMPL 28332 . 28935) (COMPILE-SETUP 28937 . 29561) (REMAKEFILES 29563 . 31033)))))
(FILEMAP (NIL (1312 8246 (GATHER-INFO 1322 . 6704) (MAKE-FULLER-DB 6706 . 7615) (MEDLEY-FIX-LINKS 7617
. 8010) (MEDLEY-FIX-DATES 8012 . 8244)) (9425 12213 (MAKE-EXPORTS-ALL 9435 . 10494) (
MAKE-WHEREIS-HASH 10496 . 11685) (MAKE-WHEREIS-LOOPS 11687 . 12211)) (12214 21862 (HCFILES 12224 .
16487) (MAKE-INDEX-HTMLS 16489 . 21860)) (22112 26724 (RECOMPILE-ONE 22122 . 24019) (RECMPL 24021 .
24624) (COMPILE-SETUP 24626 . 25250) (REMAKEFILES 25252 . 26722)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Jul-2025 11:42:21" {WMEDLEY}<internal>TEDIT-DEBUG.;174 138232
(FILECREATED " 7-Feb-2026 17:00:39" {WMEDLEY}<internal>TEDIT-DEBUG.;178 138742
:EDIT-BY rmk
:CHANGES-TO (FNS SPPRINT)
:CHANGES-TO (FNS TEDIT-DEBUG)
:PREVIOUS-DATE " 3-Jun-2025 23:12:40" {WMEDLEY}<internal>TEDIT-DEBUG.;173)
:PREVIOUS-DATE " 7-Feb-2026 10:41:45" {WMEDLEY}<internal>TEDIT-DEBUG.;177)
(PRETTYCOMPRINT TEDIT-DEBUGCOMS)
@@ -455,7 +455,8 @@
(DEFINEQ
(SP
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 17-Apr-2025 13:37 by rmk")
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 13-Oct-2025 16:37 by rmk")
(* ; "Edited 17-Apr-2025 13:37 by rmk")
(* ; "Edited 15-Apr-2025 13:53 by rmk")
(* ; "Edited 11-Apr-2025 12:15 by rmk")
(* ; "Edited 29-Mar-2025 22:34 by rmk")
@@ -475,8 +476,7 @@
(* ;; "OFILE=T or TEDIT means Tedit stream. NIL means primary output (usually T)")
(PROG ((TEXTOBJ (CL:IF (type? TEXTOBJ PC)
PC
(PROG ((TEXTOBJ (OR (TEXTOBJ PC T)
(GTO TOBJ)))
WTYPE TITLE)
(if OFILE
@@ -540,7 +540,8 @@
(RETURN PC])
(SL
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 17-Apr-2025 13:36 by rmk")
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 9-Jan-2026 11:12 by rmk")
(* ; "Edited 17-Apr-2025 13:36 by rmk")
(* ; "Edited 15-Apr-2025 13:57 by rmk")
(* ; "Edited 11-Apr-2025 12:15 by rmk")
(* ; "Edited 29-Mar-2025 20:27 by rmk")
@@ -580,6 +581,7 @@
(SETQ PANE (pop LINES))
(SETQ PNO (pop LINES))
(DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE WTYPE TITLE NIL '(TERMINAL 8))
(RESETSAVE (LINELENGTH MAX.SMALLP OFILE))
(PRINTOUT OFILE .FONT '(TERMINAL 8)
"Pane " PNO " = " PANE T)
(PRINTOUT OFILE .FONT '(TERMINAL 8)
@@ -805,7 +807,8 @@
else (RETURN OUTFILE))))])
(SHOWLINE
[LAMBDA (LINE FILE TEXTOBJ) (* ; "Edited 20-Nov-2024 00:31 by rmk")
[LAMBDA (LINE FILE TEXTOBJ) (* ; "Edited 9-Jan-2026 11:09 by rmk")
(* ; "Edited 20-Nov-2024 00:31 by rmk")
(* ; "Edited 17-Nov-2024 15:56 by rmk")
(* ; "Edited 9-Nov-2024 10:37 by rmk")
(* ; "Edited 1-Sep-2024 16:49 by rmk")
@@ -836,7 +839,7 @@
"*"
" ")
.FONT
'(TERMINAL 6)
'(TERMINAL 8)
" ")
(if (GETLD LINE LDUMMY)
then (PRINTOUT FILE -8 (CL:IF (GETLD LINE LDUMMY)
@@ -2480,7 +2483,8 @@
(DEFINEQ
(TEDIT-DEBUG
[LAMBDA (DONTOVERLOAD) (* ; "Edited 9-Aug-2024 13:20 by rmk")
[LAMBDA (DONTOVERLOAD) (* ; "Edited 7-Feb-2026 17:00 by rmk")
(* ; "Edited 9-Aug-2024 13:20 by rmk")
(* ; "Edited 16-Jul-2024 12:37 by rmk")
(* ; "Edited 6-Jul-2024 21:16 by rmk")
(* ; "Edited 10-Jun-2024 14:21 by rmk")
@@ -2493,6 +2497,7 @@
(* ; "Edited 3-Dec-2023 21:00 by rmk")
(* ; "Edited 29-Nov-2023 10:49 by rmk")
(* ; "Edited 24-Nov-2023 12:53 by rmk")
(DRIBBLE "TEDIT-DEBUG.DRIBBLE")
(CL:WHEN (DIRECTORYNAMEP (MEDLEYDIR "../oldtedit/"))
(PSEUDOHOST 'OT (MEDLEYDIR "../oldtedit/")))
(FILESLOAD (NOERROR FROM LOADUPS)
@@ -2511,7 +2516,8 @@
(FILESLOAD (NOERROR)
{OT}OTWHEREIS)
(PRINTOUT T T "Connected to " (PSEUDOFILENAME (MEDLEYDIR "library/tedit"))
T])
T)
(DRIBBLE])
)
(DEFINEQ
@@ -2579,33 +2585,33 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5120 7679 (GTO 5130 . 5380) (GTS 5382 . 7153) (GTW 7155 . 7311) (GSEL 7313 . 7677)) (
7712 8833 (TEST.TEMPLATE 7722 . 8831)) (8834 9769 (TESTACTION 8844 . 9767)) (9794 23609 (IPC 9804 .
11308) (ILINES 11310 . 13851) (ISEL 13853 . 14464) (ITS 14466 . 16190) (IPANES 16192 . 16427) (ITL
16429 . 16848) (IHIST 16850 . 19512) (IPCTB 19514 . 19940) (IMB 19942 . 20701) (ICL 20703 . 21404) (
IPL 21406 . 21946) (ICARET 21948 . 22475) (INSPECTPIECES 22477 . 23607)) (23631 52299 (SP 23641 .
28685) (SL 28687 . 32522) (SSP 32524 . 34226) (SPF 34228 . 36758) (SLF 36760 . 45893) (SHOWLINE 45895
. 49457) (SLL 49459 . 50206) (STBYTES 50208 . 51934) (SSEL 51936 . 52297)) (52300 64813 (STL 52310 .
61311) (CLEARTHISLINE 61313 . 61793) (CHARSLOTP 61795 . 63114) (\TLVALIDATE 63116 . 64811)) (64814
70187 (NTHPIECE 64824 . 65956) (NPIECES 65958 . 66823) (NTHPIECECHAR 66825 . 68133) (SELPIECE 68135 .
68577) (PIECENUM 68579 . 69298) (PCBYTES 69300 . 70185)) (70188 72662 (FILEBYTES 70198 . 71622) (
TFILEBYTES 71624 . 72660)) (72663 73985 (TRELMOVE 72673 . 72916) (TSCROLL 72918 . 73084) (TSCROLL*
73086 . 73983)) (73986 77035 (TRY 73996 . 75265) (TEDITCLOSEW 75267 . 75610) (PARALASTWITHOUTEOL 75612
. 76497) (FIXPARALAST 76499 . 77033)) (77036 91923 (SPPRINT 77046 . 83871) (SPPRINT.CHAR 83873 .
84857) (SPPRINT.OBJ 84859 . 87917) (SHOWPIECEBYTES 87919 . 89475) (CHECKPLENGTHS 89477 . 89934) (SBT
89936 . 91073) (COPYPCHAIN 91075 . 91921)) (91924 93985 (POSLINE 91934 . 93983)) (93986 94869 (
PRESPLIT 93996 . 94867)) (94870 96583 (ALLTL 94880 . 96133) (NTHCHARSLOT 96135 . 96581)) (96609 106822
(PLCHAIN 96619 . 97147) (PRINTLINE 97149 . 100139) (SL.GETLINES 100141 . 103434) (CHECKLINES 103436
. 104416) (COLLECTLINES 104418 . 104670) (NTHLINE 104672 . 105677) (HEIGHT 105679 . 105967) (LINEBOTS
105969 . 106820)) (106823 109271 (IPC.DECODEARGS 106833 . 109269)) (109272 109865 (SPF1 109282 .
109863)) (109894 112272 (SLF.FATPLEN 109904 . 110763) (FILEPIECE 110765 . 112270)) (112305 113073 (
SELTEDIT 112315 . 113071)) (113143 118755 (PPARA 113153 . 113575) (PRUN 113577 . 115053) (
ADDLINEPOSITIONS 115055 . 116482) (SBR 116484 . 117138) (SBC 117140 . 118753)) (118812 120588 (OLDWI
118822 . 119197) (COMP 119199 . 119394) (DFR 119396 . 120586)) (120589 121622 (DFGV 120599 . 121125) (
GDIRECTORIES 121127 . 121620)) (121623 128188 (TTEST 121633 . 126165) (LTEST 126167 . 127532) (THC
127534 . 128186)) (128502 129194 (SHOWSAFE 128512 . 129192)) (129247 129694 (MYH 129257 . 129692)) (
129939 131034 (DFVENUE 129949 . 130828) (VSEE 130830 . 131032)) (131035 131489 (PTT 131045 . 131487))
(131848 133429 (DEBUGOUTPUT.STREAM 131858 . 133427)) (133430 135746 (TEDIT-DEBUG 133440 . 135744)) (
135747 136239 (HEXTOHILO 135757 . 136097) (CW 136099 . 136237)) (136240 137976 (TRENAME 136250 .
137974)))))
(FILEMAP (NIL (5124 7683 (GTO 5134 . 5384) (GTS 5386 . 7157) (GTW 7159 . 7315) (GSEL 7317 . 7681)) (
7716 8837 (TEST.TEMPLATE 7726 . 8835)) (8838 9773 (TESTACTION 8848 . 9771)) (9798 23613 (IPC 9808 .
11312) (ILINES 11314 . 13855) (ISEL 13857 . 14468) (ITS 14470 . 16194) (IPANES 16196 . 16431) (ITL
16433 . 16852) (IHIST 16854 . 19516) (IPCTB 19518 . 19944) (IMB 19946 . 20705) (ICL 20707 . 21408) (
IPL 21410 . 21950) (ICARET 21952 . 22479) (INSPECTPIECES 22481 . 23611)) (23635 52650 (SP 23645 .
28760) (SL 28762 . 32764) (SSP 32766 . 34468) (SPF 34470 . 37000) (SLF 37002 . 46135) (SHOWLINE 46137
. 49808) (SLL 49810 . 50557) (STBYTES 50559 . 52285) (SSEL 52287 . 52648)) (52651 65164 (STL 52661 .
61662) (CLEARTHISLINE 61664 . 62144) (CHARSLOTP 62146 . 63465) (\TLVALIDATE 63467 . 65162)) (65165
70538 (NTHPIECE 65175 . 66307) (NPIECES 66309 . 67174) (NTHPIECECHAR 67176 . 68484) (SELPIECE 68486 .
68928) (PIECENUM 68930 . 69649) (PCBYTES 69651 . 70536)) (70539 73013 (FILEBYTES 70549 . 71973) (
TFILEBYTES 71975 . 73011)) (73014 74336 (TRELMOVE 73024 . 73267) (TSCROLL 73269 . 73435) (TSCROLL*
73437 . 74334)) (74337 77386 (TRY 74347 . 75616) (TEDITCLOSEW 75618 . 75961) (PARALASTWITHOUTEOL 75963
. 76848) (FIXPARALAST 76850 . 77384)) (77387 92274 (SPPRINT 77397 . 84222) (SPPRINT.CHAR 84224 .
85208) (SPPRINT.OBJ 85210 . 88268) (SHOWPIECEBYTES 88270 . 89826) (CHECKPLENGTHS 89828 . 90285) (SBT
90287 . 91424) (COPYPCHAIN 91426 . 92272)) (92275 94336 (POSLINE 92285 . 94334)) (94337 95220 (
PRESPLIT 94347 . 95218)) (95221 96934 (ALLTL 95231 . 96484) (NTHCHARSLOT 96486 . 96932)) (96960 107173
(PLCHAIN 96970 . 97498) (PRINTLINE 97500 . 100490) (SL.GETLINES 100492 . 103785) (CHECKLINES 103787
. 104767) (COLLECTLINES 104769 . 105021) (NTHLINE 105023 . 106028) (HEIGHT 106030 . 106318) (LINEBOTS
106320 . 107171)) (107174 109622 (IPC.DECODEARGS 107184 . 109620)) (109623 110216 (SPF1 109633 .
110214)) (110245 112623 (SLF.FATPLEN 110255 . 111114) (FILEPIECE 111116 . 112621)) (112656 113424 (
SELTEDIT 112666 . 113422)) (113494 119106 (PPARA 113504 . 113926) (PRUN 113928 . 115404) (
ADDLINEPOSITIONS 115406 . 116833) (SBR 116835 . 117489) (SBC 117491 . 119104)) (119163 120939 (OLDWI
119173 . 119548) (COMP 119550 . 119745) (DFR 119747 . 120937)) (120940 121973 (DFGV 120950 . 121476) (
GDIRECTORIES 121478 . 121971)) (121974 128539 (TTEST 121984 . 126516) (LTEST 126518 . 127883) (THC
127885 . 128537)) (128853 129545 (SHOWSAFE 128863 . 129543)) (129598 130045 (MYH 129608 . 130043)) (
130290 131385 (DFVENUE 130300 . 131179) (VSEE 131181 . 131383)) (131386 131840 (PTT 131396 . 131838))
(132199 133780 (DEBUGOUTPUT.STREAM 132209 . 133778)) (133781 136256 (TEDIT-DEBUG 133791 . 136254)) (
136257 136749 (HEXTOHILO 136267 . 136607) (CW 136609 . 136747)) (136750 138486 (TRENAME 136760 .
138484)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 9-Mar-2025 20:03:27" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;10 3274
(FILECREATED " 1-Feb-2026 13:45:36" {WMEDLEY}<internal>loadups>LOADUP-APPS.;3 3343
:EDIT-BY "frank"
:EDIT-BY rmk
:CHANGES-TO (FNS LOADUP-APPS)
:PREVIOUS-DATE " 9-Mar-2025 19:42:36" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;8
)
:PREVIOUS-DATE " 9-Mar-2025 20:03:27" {WMEDLEY}<internal>loadups>LOADUP-APPS.;2)
(PRETTYCOMPRINT LOADUP-APPSCOMS)
@@ -21,7 +20,8 @@
(DEFINEQ
(LOADUP-APPS
[LAMBDA NIL (* ; "Edited 9-Mar-2025 20:02 by frank")
[LAMBDA NIL (* ; "Edited 1-Feb-2026 13:45 by rmk")
(* ; "Edited 9-Mar-2025 20:02 by frank")
(* ; "Edited 2-Jan-2025 20:38 by lmm")
(* ; "Edited 2-Jan-2025 06:30 by larry")
@@ -46,7 +46,7 @@
"/system"))
NOTECARDS))
(Apps.RemoveBackgroundMenuItem 'NoteCards) (* ; "")
(PUTASSOC 'NOTECARDS (LIST (UNIX-GETENV 'NOTECARDS_COMMIT_ID))
(PUTASSOC 'NOTECARDS (LIST (UNIX-GETENV 'NOTECARDS¬COMMIT¬ID))
SYSOUTCOMMITS)
(* ;; "======================")
@@ -78,7 +78,7 @@
(* ;; "")
(PUTASSOC 'MEDLEY (LIST (UNIX-GETENV 'LOADUP_COMMIT_ID))
(PUTASSOC 'MEDLEY (LIST (UNIX-GETENV 'LOADUP¬COMMIT¬ID))
SYSOUTCOMMITS)
(PRINTOUT T "commits-- " SYSOUTCOMMITS T])
@@ -95,5 +95,5 @@
Apps.SBG])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (656 3251 (LOADUP-APPS 666 . 2579) (Apps.RemoveBackgroundMenuItem 2581 . 3249)))))
(FILEMAP (NIL (616 3320 (LOADUP-APPS 626 . 2648) (Apps.RemoveBackgroundMenuItem 2650 . 3318)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Sep-2025 14:18:19" {WMEDLEY}<internal>loadups>LOADUP-FULL.;34 5662
(FILECREATED "14-Feb-2026 00:42:39" {WMEDLEY}<internal>loadups>LOADUP-FULL.;38 5967
:EDIT-BY rmk
:CHANGES-TO (FNS LOADFULLFONTS)
:CHANGES-TO (FNS LOADUP-FULL)
:PREVIOUS-DATE " 2-Sep-2025 20:07:20" {WMEDLEY}<internal>loadups>LOADUP-FULL.;33)
:PREVIOUS-DATE "13-Feb-2026 00:47:52" {WMEDLEY}<internal>loadups>LOADUP-FULL.;37)
(PRETTYCOMPRINT LOADUP-FULLCOMS)
@@ -47,7 +47,10 @@
(PRINTOUT T "FULL fonts loaded" T])
(LOADUP-FULL
[LAMBDA (DRIBBLEFILE) (* ; "Edited 1-Sep-2025 11:59 by rmk")
[LAMBDA (DRIBBLEFILE) (* ; "Edited 14-Feb-2026 00:42 by rmk")
(* ; "Edited 5-Feb-2026 10:26 by rmk")
(* ; "Edited 28-Dec-2025 12:06 by rmk")
(* ; "Edited 1-Sep-2025 11:59 by rmk")
(* ; "Edited 18-Aug-2025 12:09 by rmk")
(* ; "Edited 21-Jun-2025 23:33 by rmk")
(* ; "Edited 18-Jan-2023 16:22 by FGH")
@@ -76,16 +79,16 @@
(DIRECTORYNAME T)
T T) (* ; "For FONTSAVAILABLE lookup")
(LOADUP '(POSTSCRIPTSTREAM)) (* ; " to get PSCFONT.READFONT")
(LOADFULLFONTS)
(LISTPUT IDLE.PROFILE 'TIMEOUT 0)
(SETQQ *DEFAULT-CLEANUP-COMPILER* BCOMPL)
(* ;; "RMK: 2025: PRESS was after CHAT")
(LOADUP '(CHAT INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT ISO8859IO
HELPSYS DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM
UNIXCHAT UNIXYCD UNIXUTILS))
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT HELPSYS
DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT
UNIXYCD))
(LOADFULLFONTS)
(COND
((WINDOWP *WHO-LINE*)
(CLOSEW *WHO-LINE*)))
@@ -100,5 +103,5 @@
(FIXMETA)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (458 5624 (LOADFULLFONTS 468 . 2603) (LOADUP-FULL 2605 . 5374) (FIXMETA 5376 . 5622)))))
(FILEMAP (NIL (456 5929 (LOADFULLFONTS 466 . 2601) (LOADUP-FULL 2603 . 5679) (FIXMETA 5681 . 5927)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED " 5-Nov-2025 09:04:36" |{DSK}<Users>larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;2| 7333
(FILECREATED "22-Feb-2026 14:15:31" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;27| 7420
:EDIT-BY "lmm"
:EDIT-BY |rmk|
:CHANGES-TO (FNS LOADUP-LISP)
:PREVIOUS-DATE "16-Oct-2025 16:55:27"
|{DSK}<Users>larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;1|)
:PREVIOUS-DATE "22-Feb-2026 09:49:23" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;26|)
(PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -20,7 +19,9 @@
(DEFINEQ
(LOADUP-LISP
(LAMBDA (DRIBBLEFILE) (* \; "Edited 5-Nov-2025 09:01 by lmm")
(LAMBDA (DRIBBLEFILE) (* \; "Edited 22-Feb-2026 14:15 by rmk")
(* \; "Edited 28-Jan-2026 14:30 by lmm")
(* \; "Edited 27-Dec-2025 15:02 by rmk")
(* \; "Edited 16-Oct-2025 16:55 by rmk")
(* \; "Edited 18-Aug-2025 12:08 by rmk")
(* \; "Edited 15-Jun-2025 14:39 by rmk")
@@ -72,7 +73,7 @@
(LOADUP '(STACKFNS CMLMVS MACROS MACROAUX UNWINDMACROS))
(LOADUP '(COMMON XCLC-RUNTIME CMLTYPES CL-ERROR))
(LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF SPELLFILE PRINTFN LOADFNS DMISC
DIRECTORY SPELLFILE FILEPKG RESOURCE))
DIRECTORY FILEPKG RESOURCE))
(* |;;| "needed for makesys")
@@ -94,9 +95,9 @@
(* |;;| "Also, UNICODE is split into UNICODE-TABLES and UNICODE, so the tables are loaded before their MCCS/Uncode client functions are installed. Functions in UFS now depend on those translations so that filenames can have characters outside of Ascii. ")
(LOADUP '(UNICODE-TABLES UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU
WINDOWOBJ WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL
DEXEC INSPECT DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
(LOADUP '(CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU WINDOWOBJ WINDOWSCROLL
WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE
CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
(LOADUP '(BREAK-AND-TRACE))
(LOADUP '(FASDUMP XCL-COMPILER ADVISE))
@@ -106,7 +107,7 @@
(LOADUP '(DSK UFS UFSCALLC MAIKOBITBLT))
(LOADUP '(TIME))
(LOADUP '(BRKDWN))
(LOADUP '(LOGOW IDLER HARDCOPY ICONW FREEMENU SEDIT))
(LOADUP '(LOGOW IDLER UNIXUTILS PSEUDOHOSTS HARDCOPY ICONW FREEMENU SEDIT))
(LOADUP '(XCL-EXTRAS))
(* |;;| "CMLPACKAGE pushes onto INSPECTMACROS")
@@ -128,10 +129,7 @@
(* |;;| " Added late, LOAD late to avoid any dependencies")
(* |;;| "prevent medley from pinning CPU")
(LOADUP '(XCL-LOOP XCL-HASH-LOOP))
(LOADUP '(BACKGROUND-YIELD))
(* |;;| " networking code -- should make it optional but too many cross dependencies")
@@ -149,5 +147,5 @@
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (675 7127 (LOADUP-LISP 685 . 7125)))))
(FILEMAP (NIL (640 7214 (LOADUP-LISP 650 . 7212)))))
STOP

Binary file not shown.

View File

@@ -114,8 +114,8 @@ loadup is run.
Only one instance (per <MEDLEIDIR>) of loadup can be run at a time.
There is lock file to prevent simultaneous loadups in the work directory
(named \f[B]\f[BI]lock\f[B]\f[R]) that can be manually removed.
The lock can also be automatically overridden (see the \[en]override
flag below).
The lock can also be automatically overridden (see the --override flag
below).
Alternatively, if a lock is encountered at run time, the user will be
asked to choose whether to override or simply exit the loadup.
.PP
@@ -130,7 +130,7 @@ But Medley can be installed in multiple places on any given machine and
hence MEDLEYDIR is computed on each invocation of loadup.
.SH OPTIONS
.TP
\f[B]-z [+], --man [+], -man [+], -h [+], \[en]help [+]\f[R]
\f[B]-z [+], --man [+], -man [+], -h [+], --help [+]\f[R]
Print this manual page on the screen.
If the \f[B]+\f[R] parameter is specified, then no pager is used when
displaying the man page.
@@ -138,7 +138,7 @@ displaying the man page.
\f[B]-t STAGE, --target STAGE, -target STAGE\f[R]
Run the sequential loadup procedure until the STAGE is complete,
starting from the files created by the previously run STAGE specified in
the \[en]start option.
the --start option.
.RS
.PP
STAGE can be one of the following:
@@ -175,7 +175,7 @@ Full.sysout is copied into the loadups directory.
.RS
.PP
a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
Also run the Aux stage as if \[en]aux option had been specified.
Also run the Aux stage as if --aux option had been specified.
Apps.sysout and the Aux files are copied into the loadups directory.
.RE
.RE
@@ -185,7 +185,7 @@ Apps.sysout and the Aux files are copied into the loadups directory.
a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
The Aux stage is not run unless otherwise specified.
Apps.sysout is copied into the loadups directory.
Also run the Aux stage as if \[en]aux option had been specified.
Also run the Aux stage as if --aux option had been specified.
.RE
.RE
.TP
@@ -245,22 +245,22 @@ If this stage complete successfully, these files are copied into
loadups.
.TP
\f[B]-i, --init, -init, -1\f[R]
Synonym for \[lq]\[en]target init\[rq]
Synonym for \[lq]--target init\[rq]
.TP
\f[B]-m, --mid, -mid, -2\f[R]
Synonym for \[lq]\[en]target mid\[rq]
Synonym for \[lq]--target mid\[rq]
.TP
\f[B]-l, --lisp, -lisp, -3\f[R]
Synonym for \[lq]\[en]target lisp\[rq]
Synonym for \[lq]--target lisp\[rq]
.TP
\f[B]-f, --full. -full, -4\f[R]
Synonym for \[lq]\[en]target full\[rq]
Synonym for \[lq]--target full\[rq]
.TP
\f[B]-a, --apps, -apps, -5\f[R]
Synonym for \[lq]\[en]target apps\[rq]
Synonym for \[lq]--target apps\[rq]
.TP
\f[B]-a-, --apps-, -apps-, -5-\f[R]
Synonym for \[lq]\[en]target apps\[rq]
Synonym for \[lq]--target apps\[rq]
.TP
\f[B]-ov, --override, -override\f[R]
Automatically override the lock that prevents two loadups from running
@@ -300,14 +300,14 @@ contained in the working directory.
If the \f[B]+\f[R] parameter is used, then instead of deleting just the
versioned files, all files and subdirectories are deleted except for
those contained in the working directory.
If \f[B]+\f[R] is used and there is no working directory and
\f[I]\[en]tag TAG\f[R] is also specified, then the tagged loadups
directory (<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
If \f[B]+\f[R] is used and there is no working directory and \f[I]--tag
TAG\f[R] is also specified, then the tagged loadups directory
(<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
.TP
\f[B]-th [+], --thin [+], -thin [+]\f[R]
Equivalent to specifying both -tw [+] and -tl [+].
If \f[I]\[en]tag TAG\f[R] is also specified and the \f[B]+\f[R]
parameter is used here, then the tagged loadups directory
If \f[I]--tag TAG\f[R] is also specified and the \f[B]+\f[R] parameter
is used here, then the tagged loadups directory
(<MEDLEYDIR>/loadups/tagged/TAG) is removed.
.TP
\f[B]-d DIR, --maikodir DIR, -maikodir DIR\f[R]
@@ -328,38 +328,36 @@ commonly used in running Medley in the absence of an Xwindows server.
.PP
The defaults for the Options context-dependent and somewhat complicated
due to the goal of maintaining compatibility with legacy loadup scripts.
All of the following defaults rules hold independent of the
\[en]maikodir (-d) option.
All of the following defaults rules hold independent of the --maikodir
(-d) option.
.IP "1." 3
If none of \[en]target, \[en]start, \[en]aux, and \[en]db are specified,
then:
If none of --target, --start, --aux, and --db are specified, then:
.RS
.PP
1A.
If neither \[en]thinw nor \[en]thinl are specified, the options default
to:
If neither --thinw nor --thinl are specified, the options default to:
.RE
.RS
.RS
.PP
\f[B]\[en]target full \[en]start 0 \[en]aux\f[R]
\f[B]--target full --start 0 --aux\f[R]
.RE
.RE
.RS
.PP
1B.
If either \[en]thinw or \[en]thinl are specified, no loadups are run.
If either --thinw or --thinl are specified, no loadups are run.
.RE
.IP "2." 3
If neither \[en]start nor \[en]target are specified but either -aux or
-db or both are, then \[en]start defaults to \f[I]full\f[R] and
\[en]target is irrelevant.
If neither --start nor --target are specified but either -aux or -db or
both are, then --start defaults to \f[I]full\f[R] and --target is
irrelevant.
.IP "3." 3
If \[en]start is specified and \[en]target is not, then \[en]target
defaults to \f[I]full\f[R]
If --start is specified and --target is not, then --target defaults to
\f[I]full\f[R]
.IP "4." 3
If \[en]target is specified and \[en]start is not, then \[en]start
defaults to \f[I]0\f[R]
If --target is specified and --start is not, then --start defaults to
\f[I]0\f[R]
.SH EXAMPLES
.PP
\f[B]./loadup -full -s lisp\f[R] : run loadup thru Stage 4 (full.sysout)
@@ -368,14 +366,14 @@ starting from existing Stage 3 outputs (lisp.sysout).
\f[B]./loadup --target full --start lisp\f[R] : run loadup thru Stage 4
(full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
.PP
\f[B]./loadup -5 \[en]aux\f[R] : run loadup from the beginning thru
Stage 5 (apps.sysout) then run the Aux \[lq]stage\[rq] to create
\f[B]./loadup -5 --aux\f[R] : run loadup from the beginning thru Stage 5
(apps.sysout) then run the Aux \[lq]stage\[rq] to create
\f[I]whereis.hash\f[R] and \f[I]exports.all\f[R]
.PP
\f[B]./loadup -db\f[R] : just run the DB \[lq]stage\[rq] starting from
an existing full.sysout; do not run any of the sequential stages.
.PP
\f[B]./loadup \[en]maikodir \[ti]/il/newmaiko\f[R] : run loadup sequence
\f[B]./loadup --maikodir \[ti]/il/newmaiko\f[R] : run loadup sequence
from beginning to full plus the loadup Aux stage, while using
\f[I]\[ti]/il/newmaiko\f[R] as the location for the lde executables when
running Medley.

View File

@@ -52,7 +52,7 @@ Loadup does all of its work in a work directory (\<MEDLEYDIR>/loadups/build). T
If \<MEDLEYDIR> is a git directory, then a file is created in the loadups output directory called *gitinfo* which contains the git commit, git branch and git status information for the directory at the time the loadup is run.
Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed. The lock can also be automatically overridden (see the --override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed. The lock can also be automatically overridden (see the \-\-override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
Note: **MEDLEYDIR** is an environment variable set by the loadup script. It is set to the top level directory of the Medley installation that contains the specific loadup script that
is invoked after all symbolic links are resolved. In the standard global installation this will
@@ -61,12 +61,12 @@ hence MEDLEYDIR is computed on each invocation of loadup.
OPTIONS
=======
**-z [+], \-\-man [+], \-man [+], -h [+], --help [+]**
**-z [+], \-\-man [+], \-man [+], -h [+], \-\-help [+]**
: Print this manual page on the screen. If the **+** parameter is specified, then no pager is used when
displaying the man page.
**-t STAGE, \-\-target STAGE, -target STAGE**
: Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the --start option.
: Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the \-\-start option.
>STAGE can be one of the following:
@@ -78,9 +78,9 @@ displaying the man page.
>>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout). Full.sysout is copied into the loadups directory.
>>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if --aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.
>>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if \-\-aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.
>>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout). The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory. Also run the Aux stage as if --aux option had been specified.
>>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout). The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory. Also run the Aux stage as if \-\-aux option had been specified.
**-s STAGE \-\-start STAGE, -start STAGE**
@@ -105,22 +105,22 @@ displaying the man page.
: Run the DB loadup stage, creating the *fuller.database* file. If this stage complete successfully, these files are copied into loadups.
**-i, \-\-init, -init, -1**
: Synonym for "--target init"
: Synonym for "\-\-target init"
**-m, \-\-mid, -mid, -2**
: Synonym for "--target mid"
: Synonym for "\-\-target mid"
**-l, \-\-lisp, -lisp, -3**
: Synonym for "--target lisp"
: Synonym for "\-\-target lisp"
**-f, \-\-full. -full, -4**
: Synonym for "--target full"
: Synonym for "\-\-target full"
**-a, \-\-apps, -apps, -5**
: Synonym for "--target apps"
: Synonym for "\-\-target apps"
**-a-, \-\-apps-, -apps-, -5-**
: Synonym for "--target apps"
: Synonym for "\-\-target apps"
**-ov, \-\-override, -override**
: Automatically override the lock that prevents two loadups from running simultaneously. If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.
@@ -149,11 +149,11 @@ working directory (and all files and subdirectories it contains) is deleted.
files except for those contained in the working directory.
If the **+** parameter is used, then instead of deleting just the versioned files, all files and
subdirectories are deleted except for those contained in the working directory. If **+** is used and
there is no working directory and *--tag TAG* is also specified,
there is no working directory and *\-\-tag TAG* is also specified,
then the tagged loadups directory (\<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
**-th [+], \-\-thin [+], -thin [+]**
: Equivalent to specifying both -tw [+] and -tl [+]. If *--tag TAG* is also specified and
: Equivalent to specifying both -tw [+] and -tl [+]. If *\-\-tag TAG* is also specified and
the **+** parameter is used here, then the tagged loadups directory (\<MEDLEYDIR>/loadups/tagged/TAG)
is removed.
@@ -168,21 +168,21 @@ running Medley in the absence of an Xwindows server.
DEFAULTS
====
The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts. All of the following defaults rules hold independent of the --maikodir (-d) option.
The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts. All of the following defaults rules hold independent of the \-\-maikodir (-d) option.
1. If none of --target, --start, --aux, and --db are specified, then:
1. If none of \-\-target, \-\-start, \-\-aux, and \-\-db are specified, then:
>1A. If neither --thinw nor --thinl are specified, the options default to:
>1A. If neither \-\-thinw nor \-\-thinl are specified, the options default to:
>> **--target full --start 0 --aux**
>> **\-\-target full \-\-start 0 \-\-aux**
>1B. If either --thinw or --thinl are specified, no loadups are run.
>1B. If either \-\-thinw or \-\-thinl are specified, no loadups are run.
2. If neither --start nor --target are specified but either -aux or -db or both are, then --start defaults to *full* and --target is irrelevant.
2. If neither \-\-start nor \-\-target are specified but either -aux or -db or both are, then \-\-start defaults to *full* and \-\-target is irrelevant.
3. If --start is specified and --target is not, then --target defaults to *full*
3. If \-\-start is specified and \-\-target is not, then \-\-target defaults to *full*
4. If --target is specified and --start is not, then --start defaults to *0*
4. If \-\-target is specified and \-\-start is not, then \-\-start defaults to *0*
EXAMPLES
====
@@ -190,11 +190,11 @@ EXAMPLES
**./loadup \-\-target full \-\-start lisp** : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
**./loadup -5 --aux** : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux "stage" to create *whereis.hash* and *exports.all*
**./loadup -5 \-\-aux** : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux "stage" to create *whereis.hash* and *exports.all*
**./loadup -db** : just run the DB "stage" starting from an existing full.sysout; do not run any of the sequential stages.
**./loadup --maikodir ~/il/newmaiko** : run loadup sequence from beginning to full plus the loadup Aux stage, while using *~/il/newmaiko* as the location for the lde executables when running Medley.
**./loadup \-\-maikodir ~/il/newmaiko** : run loadup sequence from beginning to full plus the loadup Aux stage, while using *~/il/newmaiko* as the location for the lde executables when running Medley.
**./loadup -full** : run loadup sequence from beginning thru full

View File

@@ -87,7 +87,7 @@ the time the loadup is run.</p>
time. There is lock file to prevent simultaneous loadups in the work
directory (named <strong><em>lock</em></strong>) that can be manually
removed. The lock can also be automatically overridden (see the
override flag below). Alternatively, if a lock is encountered at run
--override flag below). Alternatively, if a lock is encountered at run
time, the user will be asked to choose whether to override or simply
exit the loadup.</p>
<p>Note: <strong>MEDLEYDIR</strong> is an environment variable set by
@@ -99,7 +99,8 @@ installed in multiple places on any given machine and hence MEDLEYDIR is
computed on each invocation of loadup.</p>
<h1>OPTIONS</h1>
<dl>
<dt><strong>-z [+], --man [+], -man [+], -h [+], help [+]</strong></dt>
<dt><strong>-z [+], --man [+], -man [+], -h [+], --help
[+]</strong></dt>
<dd>
<p>Print this manual page on the screen. If the <strong>+</strong>
parameter is specified, then no pager is used when displaying the man
@@ -109,7 +110,7 @@ page.</p>
<dd>
<p>Run the sequential loadup procedure until the STAGE is complete,
starting from the files created by the previously run STAGE specified in
the start option.</p>
the --start option.</p>
<p>STAGE can be one of the following:</p>
<blockquote>
<p>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit).
@@ -129,13 +130,13 @@ Full.sysout is copied into the loadups directory.</p>
</blockquote>
<blockquote>
<p>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
Also run the Aux stage as if aux option had been specified. Apps.sysout
and the Aux files are copied into the loadups directory.</p>
Also run the Aux stage as if --aux option had been specified.
Apps.sysout and the Aux files are copied into the loadups directory.</p>
</blockquote>
<blockquote>
<p>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
The Aux stage is not run unless otherwise specified. Apps.sysout is
copied into the loadups directory. Also run the Aux stage as if aux
copied into the loadups directory. Also run the Aux stage as if --aux
option had been specified.</p>
</blockquote>
</dd>
@@ -181,27 +182,27 @@ loadups.</p>
</dd>
<dt><strong>-i, --init, -init, -1</strong></dt>
<dd>
<p>Synonym for “target init”</p>
<p>Synonym for “--target init”</p>
</dd>
<dt><strong>-m, --mid, -mid, -2</strong></dt>
<dd>
<p>Synonym for “target mid”</p>
<p>Synonym for “--target mid”</p>
</dd>
<dt><strong>-l, --lisp, -lisp, -3</strong></dt>
<dd>
<p>Synonym for “target lisp”</p>
<p>Synonym for “--target lisp”</p>
</dd>
<dt><strong>-f, --full. -full, -4</strong></dt>
<dd>
<p>Synonym for “target full”</p>
<p>Synonym for “--target full”</p>
</dd>
<dt><strong>-a, --apps, -apps, -5</strong></dt>
<dd>
<p>Synonym for “target apps”</p>
<p>Synonym for “--target apps”</p>
</dd>
<dt><strong>-a-, --apps-, -apps-, -5-</strong></dt>
<dd>
<p>Synonym for “target apps”</p>
<p>Synonym for “--target apps”</p>
</dd>
<dt><strong>-ov, --override, -override</strong></dt>
<dd>
@@ -245,13 +246,13 @@ contained in the working directory. If the <strong>+</strong> parameter
is used, then instead of deleting just the versioned files, all files
and subdirectories are deleted except for those contained in the working
directory. If <strong>+</strong> is used and there is no working
directory and <em>tag TAG</em> is also specified, then the tagged
directory and <em>--tag</em> TAG is also specified, then the tagged
loadups directory (&lt;MEDLEYDIR&gt;/loadups/tagged/TAG) is also
deleted.</p>
</dd>
<dt><strong>-th [+], --thin [+], -thin [+]</strong></dt>
<dd>
<p>Equivalent to specifying both -tw [+] and -tl [+]. If <em>tag
<p>Equivalent to specifying both -tw [+] and -tl [+]. If <em>--tag
TAG</em> is also specified and the <strong>+</strong> parameter is used
here, then the tagged loadups directory
(&lt;MEDLEYDIR&gt;/loadups/tagged/TAG) is removed.</p>
@@ -277,24 +278,24 @@ absence of an Xwindows server.</p>
<p>The defaults for the Options context-dependent and somewhat
complicated due to the goal of maintaining compatibility with legacy
loadup scripts. All of the following defaults rules hold independent of
the maikodir (-d) option.</p>
the --maikodir (-d) option.</p>
<ol type="1">
<li><p>If none of target, start, aux, and db are specified,
<li><p>If none of --target, --start, --aux, and --db are specified,
then:</p>
<p>1A. If neither thinw nor thinl are specified, the options default
<p>1A. If neither --thinw nor --thinl are specified, the options default
to:</p>
<blockquote>
<p><strong>target full start 0 aux</strong></p>
<p><strong>--target full --start 0 --aux</strong></p>
</blockquote>
<p>1B. If either thinw or thinl are specified, no loadups are
<p>1B. If either --thinw or --thinl are specified, no loadups are
run.</p></li>
<li><p>If neither start nor target are specified but either -aux or
-db or both are, then start defaults to <em>full</em> and target is
<li><p>If neither --start nor --target are specified but either -aux or
-db or both are, then --start defaults to <em>full</em> and --target is
irrelevant.</p></li>
<li><p>If start is specified and target is not, then target defaults
to <em>full</em></p></li>
<li><p>If target is specified and start is not, then start defaults
to <em>0</em></p></li>
<li><p>If --start is specified and --target is not, then --target
defaults to <em>full</em></p></li>
<li><p>If --target is specified and --start is not, then --start
defaults to <em>0</em></p></li>
</ol>
<h1>EXAMPLES</h1>
<p><strong>./loadup -full -s lisp</strong> : run loadup thru Stage 4
@@ -302,12 +303,12 @@ to <em>0</em></p></li>
<p><strong>./loadup --target full --start lisp</strong> : run loadup
thru Stage 4 (full.sysout) starting from existing Stage 3 outputs
(lisp.sysout).</p>
<p><strong>./loadup -5 aux</strong> : run loadup from the beginning
<p><strong>./loadup -5 --aux</strong> : run loadup from the beginning
thru Stage 5 (apps.sysout) then run the Aux “stage” to create
<em>whereis.hash</em> and <em>exports.all</em></p>
<p><strong>./loadup -db</strong> : just run the DB “stage” starting from
an existing full.sysout; do not run any of the sequential stages.</p>
<p><strong>./loadup maikodir ~/il/newmaiko</strong> : run loadup
<p><strong>./loadup --maikodir ~/il/newmaiko</strong> : run loadup
sequence from beginning to full plus the loadup Aux stage, while using
<em>~/il/newmaiko</em> as the location for the lde executables when
running Medley.</p>

Binary file not shown.

View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Sep-2025 15:00:01" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;28 8305
(FILECREATED "23-Feb-2026 12:35:55" {WMEDLEY}<library>CLIPBOARD.;29 8228
:EDIT-BY rmk
:CHANGES-TO (FNS PUTCLIPBOARD CLIPBOARD-COPY-STREAM)
:CHANGES-TO (VARS CLIPBOARDCOMS)
:PREVIOUS-DATE "21-Apr-2024 09:12:04" {WMEDLEY}<library>CLIPBOARD.;18)
:PREVIOUS-DATE "25-Sep-2025 15:00:01" {WMEDLEY}<library>CLIPBOARD.;28)
(PRETTYCOMPRINT CLIPBOARDCOMS)
@@ -18,7 +17,7 @@
CLIPBOARD-PASTE-STREAM)
(FNS SEDIT.COPYTOCLIPBOARD)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD)
UNIXCOMM UNICODE)
UNIXCOMM)
(P (INSTALL-CLIPBOARD)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
@@ -148,7 +147,7 @@
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY
(FILESLOAD (SYSLOAD)
UNIXCOMM UNICODE)
UNIXCOMM)
(INSTALL-CLIPBOARD)
@@ -162,7 +161,7 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1167 6486 (INSTALL-CLIPBOARD 1177 . 2504) (GETCLIPBOARD 2506 . 2880) (PUTCLIPBOARD 2882
. 4306) (PASTEFROMCLIPBOARD 4308 . 5226) (CLIPBOARD-COPY-STREAM 5228 . 5762) (CLIPBOARD-PASTE-STREAM
5764 . 6484)) (6487 8026 (SEDIT.COPYTOCLIPBOARD 6497 . 8024)))))
(FILEMAP (NIL (1098 6417 (INSTALL-CLIPBOARD 1108 . 2435) (GETCLIPBOARD 2437 . 2811) (PUTCLIPBOARD 2813
. 4237) (PASTEFROMCLIPBOARD 4239 . 5157) (CLIPBOARD-COPY-STREAM 5159 . 5693) (CLIPBOARD-PASTE-STREAM
5695 . 6415)) (6418 7957 (SEDIT.COPYTOCLIPBOARD 6428 . 7955)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "29-May-2024 15:30:07" {LIB}FILEBROWSER.\;2 266071
(FILECREATED "24-Dec-2025 11:14:31" |{WMEDLEY}<library>FILEBROWSER.;34| 263525
:EDIT-BY "mth"
:EDIT-BY |rmk|
:CHANGES-TO (FNS FB.PROMPTW.FORMAT FB.FASTSEE.ONEFILE)
:CHANGES-TO (FNS FB.HARDCOPY.TOFILE)
:PREVIOUS-DATE " 4-Nov-2023 23:55:27" {LIB}FILEBROWSER.\;1)
:PREVIOUS-DATE " 6-Nov-2025 14:33:28" |{WMEDLEY}<library>FILEBROWSER.;33|)
(PRETTYCOMPRINT FILEBROWSERCOMS)
@@ -91,22 +91,10 @@ You specify how many versions to keep.")))
(|See| (FB.EDITCOMMAND READONLY)
"Displays selected files one at a time in a separate window"
(SUBITEMS ("Fast SEE Pretty" FB.FASTSEECOMMAND
"Views file quickly, uses font information, no scrolling backwards"
)
("Fast SEE Unformatted" (FB.FASTSEECOMMAND
T)
"Views file quickly, shows raw characters, no scrolling backwards"
)
("Scrollable & Pretty" (FB.EDITCOMMAND
READONLY)
"Views file with font information in a fully scrollable window"
)
("FileBrowse" FB.BROWSECOMMAND
)
(|Browse| FB.BROWSECOMMAND
"Recursively call FileBrowser on the selected subdirectory"
)))
)
(|Edit| FB.EDITCOMMAND
"Calls an editor on the selected files (use submenu to specify editor)"
(SUBITEMS ("TEdit" (FB.EDITCOMMAND TEDIT)
@@ -337,15 +325,8 @@ You specify how many versions to keep.")))
("To a printer" (FB.HARDCOPYCOMMAND PRINTER)
"Sends hardcopy of selected files to a printer of your choosing")))
(|See| (FB.EDITCOMMAND READONLY)
"Displays selected files one at a time in a separate window"
(SUBITEMS ("Fast SEE Pretty" FB.FASTSEECOMMAND
"Views file quickly, uses font information, no scrolling backwards")
("Fast SEE Unformatted" (FB.FASTSEECOMMAND T)
"Views file quickly, shows raw characters, no scrolling backwards")
("Scrollable & Pretty" (FB.EDITCOMMAND READONLY)
"Views file with font information in a fully scrollable window")
("FileBrowse" FB.BROWSECOMMAND
"Recursively call FileBrowser on the selected subdirectory")))
"Displays selected files one at a time in a separate window")
(|Browse| FB.BROWSECOMMAND "Recursively call FileBrowser on the selected subdirectory")
(|Edit| FB.EDITCOMMAND
"Calls an editor on the selected files (use submenu to specify editor)"
(SUBITEMS ("TEdit" (FB.EDITCOMMAND TEDIT)
@@ -827,13 +808,10 @@ Your deletions are thus ignored.")))
(REDISPLAYW (CAR W))))))
(\\FB.HARDCOPY.TOFILE.EXTENSION
(LAMBDA NIL (* \;
 "Edited 25-Feb-91 15:15 by gadener")
(LET ((TYPE (PRINTERTYPE)))
(CASE TYPE
(INTERPRESS 'IP)
(POSTSCRIPT 'PS)
(DEFAULT TYPE)))))
(LAMBDA NIL (* \; "Edited 20-Sep-2025 11:41 by rmk")
(* \; "Edited 14-Sep-2025 20:48 by rmk")
(OR (CAR (EXTENSIONS.FOR.IMAGEFILETYPE (PRINTERTYPE)))
DEFAULTPRINTERTYPE)))
)
@@ -1586,22 +1564,25 @@ Your deletions are thus ignored.")))
PRINTOPTIONS)))))))
(FB.HARDCOPY.TOFILE
(LAMBDA (BROWSER FILES) (* \;
 "Edited 15-Feb-91 17:13 by gadener")
(LAMBDA (BROWSER FILES) (* \; "Edited 21-Dec-2025 09:05 by rmk")
(* \; "Edited 20-Sep-2025 12:55 by rmk")
(* \; "Edited 18-Sep-2025 10:29 by rmk")
(* \; "Edited 14-Sep-2025 20:55 by rmk")
(* \; "Edited 15-Feb-91 17:13 by gadener")
(* |;;| "Handle the \"Hardcopy>To File\" command. ")
(PROG ((HCOPYFILE (FB.PROMPTFORINPUT (COND
((CDR FILES)
"Hardcopy file name pattern: ")
(T "Hardcopy file name: "))
((CDR FILES)
"Hardcopy file name pattern: ")
(T "Hardcopy file name: "))
(COND
((CDR FILES)
(PACKFILENAME.STRING 'NAME '* 'EXTENSION (
 \\FB.HARDCOPY.TOFILE.EXTENSION
 \\FB.HARDCOPY.TOFILE.EXTENSION
)))
(T (PACKFILENAME.STRING 'VERSION NIL 'EXTENSION (
 \\FB.HARDCOPY.TOFILE.EXTENSION
 \\FB.HARDCOPY.TOFILE.EXTENSION
)
'BODY
(FB.FETCHFILENAME (CAR FILES)))))
@@ -1619,72 +1600,56 @@ Your deletions are thus ignored.")))
((|for| TAIL |on| (SETQ HCOPYFIELDS (UNPACKFILENAME.STRING HCOPYFILE))
|by| (CDDR TAIL) |bind| HOST HAVEDIRECTORY I
|do| (COND
((SETQ I (STRPOS '* (CADR TAIL)))
(|if| (NEQ (CAR TAIL)
'NAME)
|then| (RETURN (SETQ MSG "Only name portion can contain *")
)) (* \; "Take apart name into FORE*AFT")
(SETQ HCOPYTAIL (CDR TAIL))
(SETQ FORE (OR (SUBSTRING (CADR TAIL)
1
(SUB1 I))
""))
(SETQ AFT (OR (SUBSTRING (CADR TAIL)
(ADD1 I))
"")))
(T (SELECTQ (CAR TAIL)
(NAME (RETURN (SETQ MSG
"Name must have * for multiple hardcopy files"
)))
(EXTENSION (SETQ EXT (MKATOM (U-CASE (CADR TAIL)))))
(DIRECTORY (SETQ HAVEDIRECTORY T))
(HOST (SETQ HOST (CADR TAIL)))
NIL))) |finally| (|if| (AND HOST (NOT HAVEDIRECTORY))
|then|
((SETQ I (STRPOS '* (CADR TAIL)))
(|if| (NEQ (CAR TAIL)
'NAME)
|then| (RETURN (SETQ MSG "Only name portion can contain *")))
(* \; "Take apart name into FORE*AFT")
(SETQ HCOPYTAIL (CDR TAIL))
(SETQ FORE (OR (SUBSTRING (CADR TAIL)
1
(SUB1 I))
""))
(SETQ AFT (OR (SUBSTRING (CADR TAIL)
(ADD1 I))
"")))
(T (SELECTQ (CAR TAIL)
(NAME (RETURN (SETQ MSG
"Name must have * for multiple hardcopy files")))
(EXTENSION (SETQ EXT (MKATOM (U-CASE (CADR TAIL)))))
(DIRECTORY (SETQ HAVEDIRECTORY T))
(HOST (SETQ HOST (CADR TAIL)))
NIL))) |finally| (|if| (AND HOST (NOT HAVEDIRECTORY))
|then|
(* \;
 "E.g., {DSK}*.IP. This pattern explicitly has no directory")
(|push| HCOPYFIELDS
'DIRECTORY NIL)))
 "E.g., {DSK}*.IP. This pattern explicitly has no directory")
(|push| HCOPYFIELDS 'DIRECTORY NIL)))
(FB.PROMPTWPRINT BROWSER "Bad pattern -- " MSG)
(RETURN))))
(T (SETQ EXT (U-CASE (FILENAMEFIELD HCOPYFILE 'EXTENSION)))))
(COND
((AND (NULL (SETQ PRINTFILETYPE (|for| TYPE |in| PRINTFILETYPES
|when| (FMEMB EXT (CADR (ASSOC 'EXTENSION
(CDR TYPE))))
|do| (* \;
 "Opencoded PRINTFILETYPE.FROM.EXTENSION because that one's buggy")
(RETURN (CAR TYPE)))))
(NULL (SETQ PRINTFILETYPE (MENU (|MakeMenuOfImageTypes| "File type?")))))
(RETURN)))
(|for| ITEM |in| FILES |bind| (CONVERTERS _ (PRINTFILEPROP PRINTFILETYPE
'CONVERSION))
FILETYPE NAME FN FIELDS
(CL:UNLESS (SETQ PRINTFILETYPE (OR (IMAGEFILETYPE.FROM.EXTENSION NIL EXT)
(MENU (|MakeMenuOfImageTypes| "File type?"))))
(RETURN))
(|for| ITEM NAME FIELDS |in| FILES
|do| (SETQ ITEM (FB.FETCHFILENAME ITEM))
(SETQ FILETYPE (OR (PRINTFILETYPE ITEM)
'TEXT))
(COND
((SETQ FN (LISTGET CONVERTERS FILETYPE))
(FB.PROMPTW.FORMAT BROWSER "~%Writing ~A..."
(SETQ NAME (COND
((CDR FILES)
(SETQ FIELDS (UNPACKFILENAME.STRING ITEM NIL NIL
'TENEX))
(RPLACA HCOPYTAIL (CONCAT FORE (LISTGET FIELDS
'NAME)
AFT))
(CL:APPLY (FUNCTION PACKFILENAME.STRING)
'VERSION NIL (APPEND HCOPYFIELDS FIELDS)))
(T HCOPYFILE))))
(SETQ NAME (CL:FUNCALL FN ITEM NAME))
(COND
((LISTP NAME) (* \; "Result is (SOURCE DESTINATION)")
(SETQ NAME (CADR NAME))))
(FB.PROMPTWPRINT BROWSER "done.")
(FB.MAYBE.INSERT.FILE BROWSER NAME))
(T (FB.PROMPTW.FORMAT BROWSER
"~%Failed to hardcopy ~A -- Can't convert a ~A file to format ~A"
ITEM FILETYPE PRINTFILETYPE)))))))
(SETQ NAME (COND
((CDR FILES)
(SETQ FIELDS (UNPACKFILENAME.STRING ITEM NIL NIL 'TENEX))
(RPLACA HCOPYTAIL (CONCAT FORE (LISTGET FIELDS 'NAME)
AFT))
(CL:APPLY (FUNCTION PACKFILENAME.STRING)
'VERSION NIL (APPEND HCOPYFIELDS FIELDS)))
(T (OUTFILEP HCOPYFILE))))
(FB.PROMPTW.FORMAT BROWSER "~%Writing ~A..." NAME)
(|if| (SETQ NAME (CONVERT.TO.IMAGEFILE ITEM NAME PRINTFILETYPE
'(NOERROR T QUIET T)))
|then| (FB.PROMPTWPRINT BROWSER "done.")
(FB.MAYBE.INSERT.FILE BROWSER NAME)
|else| (FB.PROMPTW.FORMAT BROWSER
"~%Failed to hardcopy ~A -- Can't convert a ~A file to format ~A"
ITEM (OR (IMAGESOURCETYPE ITEM)
'TEXT)
PRINTFILETYPE))))))
)
(DEFINEQ
@@ -4249,51 +4214,51 @@ then click Recompute"))))
(ADDTOVAR LAMA FB.PROMPTW.FORMAT FB.PROMPTWPRINT)
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (31871 54979 (FB 31881 . 33016) (FB.COPYBINARYCOMMAND 33018 . 33364) (FB.COPYTEXTCOMMAND
33366 . 33708) (FILEBROWSER 33710 . 46816) (FB.TABLEBROWSER 46818 . 47035) (FB.SELECTEDFILES 47037 .
47674) (FB.FETCHFILENAME 47676 . 48068) (FB.DIRECTORYP 48070 . 48464) (FB.PROMPTWPRINT 48466 . 49512)
(FB.PROMPTW.FORMAT 49514 . 50478) (FB.PROMPTFORINPUT 50480 . 52732) (FB.YES-OR-NO-P 52734 . 53768) (
FB.ALLOW.ABORT 53770 . 54624) (\\FB.HARDCOPY.TOFILE.EXTENSION 54626 . 54977)) (55003 55956 (FB.STARTUP
55013 . 55528) (FB.MAKERIGIDWINDOW 55530 . 55954)) (55957 61440 (FB.PRINTFN 55967 . 61120) (FB.COPYFN
61122 . 61438)) (61490 67830 (FB.MENU.WHENSELECTEDFN 61500 . 61858) (FB.COMMANDSELECTEDFN 61860 .
63399) (FB.SUBITEMP 63401 . 64002) (FB.MAKE.BROWSER.BUSY 64004 . 64808) (FB.FINISH.COMMAND 64810 .
66841) (FB.HANDLE.ABORT.BUTTON 66843 . 67828)) (67831 73347 (FB.DELETECOMMAND 67841 . 68122) (
FB.DELVERCOMMAND 68124 . 71317) (FB.IS.NOT.SUBDIRECTORY.ITEM 71319 . 71500) (FB.DELVER.FILES 71502 .
72591) (FB.DELETE.FILE 72593 . 73345)) (73348 74673 (FB.UNDELETECOMMAND 73358 . 73643) (
FB.UNDELETEALLCOMMAND 73645 . 73924) (FB.UNDELETE.FILE 73926 . 74671)) (74674 98855 (FB.COPYCOMMAND
74684 . 74953) (FB.RENAMECOMMAND 74955 . 75230) (FB.COPY/RENAME.COMMAND 75232 . 76155) (
FB.COPY/RENAME.ONE 76157 . 78479) (FB.COPY/RENAME.MANY 78481 . 84701) (FB.MERGE.DIRECTORIES 84703 .
85121) (FB.GREATEST.PREFIX 85123 . 86479) (FB.MAYBE.INSERT.FILE 86481 . 93921) (FB.GET.NEW.FILE.SPEC
93923 . 97754) (FB.CANONICAL.DIRECTORY 97756 . 98853)) (98856 106640 (FB.HARDCOPYCOMMAND 98866 . 99996
) (FB.HARDCOPY.TOFILE 99998 . 106638)) (106641 116850 (FB.EDITCOMMAND 106651 . 107518) (
FB.EDITCOMMAND.ONEFILE 107520 . 110934) (FB.EDITLISPFILE 110936 . 112041) (FB.BROWSECOMMAND 112043 .
116848)) (116851 128571 (FB.FASTSEECOMMAND 116861 . 120311) (FB.FASTSEE.ONEFILE 120313 . 123269) (
FB.SEEFULLFN 123271 . 127402) (FB.SEEBUTTONFN 127404 . 128569)) (128572 130318 (FB.LOADCOMMAND 128582
. 129089) (FB.COMPILECOMMAND 129091 . 129629) (FB.OPERATE.ON.FILES 129631 . 130316)) (130319 178504 (
FB.UPDATECOMMAND 130329 . 130554) (FB.FIX-DIRECTORY-DATES 130556 . 131579) (FB.MAYBE.EXPUNGE 131581 .
132642) (FB.UPDATEBROWSERITEMS 132644 . 145859) (FB.DATE 145861 . 146502) (FB.ADJUST.DATE.WIDTH 146504
. 149472) (FB.SET.BROWSER.TITLE 149474 . 150476) (FB.MAYBE.WIDEN.NAMES 150478 . 152597) (
FB.SET.DEFAULT.NAME.WIDTH 152599 . 153963) (FB.CREATE.FILEBUCKET 153965 . 161185) (
FB.CHECK.NAME.LENGTH 161187 . 163608) (FB.ADD.FILEGROUP 163610 . 165137) (FB.INSERT.DIRECTORY 165139
. 165377) (FB.MAKE.SUBDIRECTORY.ITEM 165379 . 166788) (FB.ADD.FILE 166790 . 167403) (FB.INSERT.FILE
167405 . 170817) (FB.ANALYZE.PATTERN 170819 . 176083) (FB.CANONICALIZE.PATTERN 176085 . 177397) (
FB.GETALLFILEINFO 177399 . 178502)) (178505 186664 (FB.SORT.VERSIONS 178515 . 181286) (
FB.DECREASING.VERSION 181288 . 181957) (FB.INCREASING.VERSION 181959 . 182580) (
FB.NAMES.DECREASING.VERSION 182582 . 183617) (FB.NAMES.INCREASING.VERSION 183619 . 184616) (
FB.DECREASING.NUMERIC.ATTR 184618 . 185298) (FB.INCREASING.NUMERIC.ATTR 185300 . 185974) (
FB.ALPHABETIC.ATTR 185976 . 186662)) (186665 196507 (FB.SORTCOMMAND 186675 . 193505) (
FB.INSERT.SUBDIRECTORIES 193507 . 194304) (FB.GET.SORT.MENU 194306 . 196505)) (196508 212729 (
FB.EXPUNGECOMMAND 196518 . 199103) (FB.NEWPATTERNCOMMAND 199105 . 199503) (FB.NEWINFOCOMMAND 199505 .
202337) (FB.DEPTHCOMMAND 202339 . 204114) (FB.SHAPECOMMAND 204116 . 207458) (FB.REMOVE.FILE 207460 .
209281) (FB.COUNT.FILE.CHANGE 209283 . 210728) (FB.SETNEWPATTERN 210730 . 211900) (FB.GET.NEWPATTERN
211902 . 212486) (FB.OPTIONSCOMMAND 212488 . 212727)) (212764 213817 (FB.GETWINDOW 212774 . 213815)) (
213818 214830 (FB.INFOMENU.SHADEINITIALSELECTIONS 213828 . 214475) (FB.INFO.ITEM.NAMED 214477 . 214828
)) (214831 224363 (FB.MAKECOUNTERWINDOW 214841 . 216369) (FB.COUNTERW.REDISPLAYFN 216371 . 216958) (
FB.UPDATE.COUNTERS 216960 . 219032) (FB.DISPLAY.COUNTERS 219034 . 224094) (FB.COUNTER.STRING 224096 .
224361)) (224364 229073 (FB.MAKEHEADINGWINDOW 224374 . 225988) (FB.HEADINGW.REDISPLAYFN 225990 .
226256) (FB.HEADINGW.RESHAPEFN 226258 . 226634) (FB.HEADINGW.DISPLAY 226636 . 229071)) (229074 233257
(FB.ICONFN 229084 . 229431) (FB.INFOMENU.WHENSELECTEDFN 229433 . 230163) (FB.CLOSEFN 230165 . 231368)
(FB.EXPUNGE?.MENU 231370 . 231782) (FB.AFTERCLOSEFN 231784 . 232145) (FB.CLOSE&EXPUNGE 232147 . 233255
)) (233258 245316 (FB.HARDCOPY.DIRECTORY 233268 . 243625) (FB.HARDCOPY.PRINT.TITLE 243627 . 243953) (
FB.HARDCOPY.MAXWIDTH 243955 . 245314)))))
(FILEMAP (NIL (30255 53354 (FB 30265 . 31400) (FB.COPYBINARYCOMMAND 31402 . 31748) (FB.COPYTEXTCOMMAND
31750 . 32092) (FILEBROWSER 32094 . 45200) (FB.TABLEBROWSER 45202 . 45419) (FB.SELECTEDFILES 45421 .
46058) (FB.FETCHFILENAME 46060 . 46452) (FB.DIRECTORYP 46454 . 46848) (FB.PROMPTWPRINT 46850 . 47896)
(FB.PROMPTW.FORMAT 47898 . 48862) (FB.PROMPTFORINPUT 48864 . 51116) (FB.YES-OR-NO-P 51118 . 52152) (
FB.ALLOW.ABORT 52154 . 53008) (\\FB.HARDCOPY.TOFILE.EXTENSION 53010 . 53352)) (53378 54331 (FB.STARTUP
53388 . 53903) (FB.MAKERIGIDWINDOW 53905 . 54329)) (54332 59815 (FB.PRINTFN 54342 . 59495) (FB.COPYFN
59497 . 59813)) (59865 66205 (FB.MENU.WHENSELECTEDFN 59875 . 60233) (FB.COMMANDSELECTEDFN 60235 .
61774) (FB.SUBITEMP 61776 . 62377) (FB.MAKE.BROWSER.BUSY 62379 . 63183) (FB.FINISH.COMMAND 63185 .
65216) (FB.HANDLE.ABORT.BUTTON 65218 . 66203)) (66206 71722 (FB.DELETECOMMAND 66216 . 66497) (
FB.DELVERCOMMAND 66499 . 69692) (FB.IS.NOT.SUBDIRECTORY.ITEM 69694 . 69875) (FB.DELVER.FILES 69877 .
70966) (FB.DELETE.FILE 70968 . 71720)) (71723 73048 (FB.UNDELETECOMMAND 71733 . 72018) (
FB.UNDELETEALLCOMMAND 72020 . 72299) (FB.UNDELETE.FILE 72301 . 73046)) (73049 97230 (FB.COPYCOMMAND
73059 . 73328) (FB.RENAMECOMMAND 73330 . 73605) (FB.COPY/RENAME.COMMAND 73607 . 74530) (
FB.COPY/RENAME.ONE 74532 . 76854) (FB.COPY/RENAME.MANY 76856 . 83076) (FB.MERGE.DIRECTORIES 83078 .
83496) (FB.GREATEST.PREFIX 83498 . 84854) (FB.MAYBE.INSERT.FILE 84856 . 92296) (FB.GET.NEW.FILE.SPEC
92298 . 96129) (FB.CANONICAL.DIRECTORY 96131 . 97228)) (97231 104094 (FB.HARDCOPYCOMMAND 97241 . 98371
) (FB.HARDCOPY.TOFILE 98373 . 104092)) (104095 114304 (FB.EDITCOMMAND 104105 . 104972) (
FB.EDITCOMMAND.ONEFILE 104974 . 108388) (FB.EDITLISPFILE 108390 . 109495) (FB.BROWSECOMMAND 109497 .
114302)) (114305 126025 (FB.FASTSEECOMMAND 114315 . 117765) (FB.FASTSEE.ONEFILE 117767 . 120723) (
FB.SEEFULLFN 120725 . 124856) (FB.SEEBUTTONFN 124858 . 126023)) (126026 127772 (FB.LOADCOMMAND 126036
. 126543) (FB.COMPILECOMMAND 126545 . 127083) (FB.OPERATE.ON.FILES 127085 . 127770)) (127773 175958 (
FB.UPDATECOMMAND 127783 . 128008) (FB.FIX-DIRECTORY-DATES 128010 . 129033) (FB.MAYBE.EXPUNGE 129035 .
130096) (FB.UPDATEBROWSERITEMS 130098 . 143313) (FB.DATE 143315 . 143956) (FB.ADJUST.DATE.WIDTH 143958
. 146926) (FB.SET.BROWSER.TITLE 146928 . 147930) (FB.MAYBE.WIDEN.NAMES 147932 . 150051) (
FB.SET.DEFAULT.NAME.WIDTH 150053 . 151417) (FB.CREATE.FILEBUCKET 151419 . 158639) (
FB.CHECK.NAME.LENGTH 158641 . 161062) (FB.ADD.FILEGROUP 161064 . 162591) (FB.INSERT.DIRECTORY 162593
. 162831) (FB.MAKE.SUBDIRECTORY.ITEM 162833 . 164242) (FB.ADD.FILE 164244 . 164857) (FB.INSERT.FILE
164859 . 168271) (FB.ANALYZE.PATTERN 168273 . 173537) (FB.CANONICALIZE.PATTERN 173539 . 174851) (
FB.GETALLFILEINFO 174853 . 175956)) (175959 184118 (FB.SORT.VERSIONS 175969 . 178740) (
FB.DECREASING.VERSION 178742 . 179411) (FB.INCREASING.VERSION 179413 . 180034) (
FB.NAMES.DECREASING.VERSION 180036 . 181071) (FB.NAMES.INCREASING.VERSION 181073 . 182070) (
FB.DECREASING.NUMERIC.ATTR 182072 . 182752) (FB.INCREASING.NUMERIC.ATTR 182754 . 183428) (
FB.ALPHABETIC.ATTR 183430 . 184116)) (184119 193961 (FB.SORTCOMMAND 184129 . 190959) (
FB.INSERT.SUBDIRECTORIES 190961 . 191758) (FB.GET.SORT.MENU 191760 . 193959)) (193962 210183 (
FB.EXPUNGECOMMAND 193972 . 196557) (FB.NEWPATTERNCOMMAND 196559 . 196957) (FB.NEWINFOCOMMAND 196959 .
199791) (FB.DEPTHCOMMAND 199793 . 201568) (FB.SHAPECOMMAND 201570 . 204912) (FB.REMOVE.FILE 204914 .
206735) (FB.COUNT.FILE.CHANGE 206737 . 208182) (FB.SETNEWPATTERN 208184 . 209354) (FB.GET.NEWPATTERN
209356 . 209940) (FB.OPTIONSCOMMAND 209942 . 210181)) (210218 211271 (FB.GETWINDOW 210228 . 211269)) (
211272 212284 (FB.INFOMENU.SHADEINITIALSELECTIONS 211282 . 211929) (FB.INFO.ITEM.NAMED 211931 . 212282
)) (212285 221817 (FB.MAKECOUNTERWINDOW 212295 . 213823) (FB.COUNTERW.REDISPLAYFN 213825 . 214412) (
FB.UPDATE.COUNTERS 214414 . 216486) (FB.DISPLAY.COUNTERS 216488 . 221548) (FB.COUNTER.STRING 221550 .
221815)) (221818 226527 (FB.MAKEHEADINGWINDOW 221828 . 223442) (FB.HEADINGW.REDISPLAYFN 223444 .
223710) (FB.HEADINGW.RESHAPEFN 223712 . 224088) (FB.HEADINGW.DISPLAY 224090 . 226525)) (226528 230711
(FB.ICONFN 226538 . 226885) (FB.INFOMENU.WHENSELECTEDFN 226887 . 227617) (FB.CLOSEFN 227619 . 228822)
(FB.EXPUNGE?.MENU 228824 . 229236) (FB.AFTERCLOSEFN 229238 . 229599) (FB.CLOSE&EXPUNGE 229601 . 230709
)) (230712 242770 (FB.HARDCOPY.DIRECTORY 230722 . 241079) (FB.HARDCOPY.PRINT.TITLE 241081 . 241407) (
FB.HARDCOPY.MAXWIDTH 241409 . 242768)))))
STOP

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

File diff suppressed because one or more lines are too long

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Aug-2025 13:45:51" {WMEDLEY}<library>MASTERSCOPE.;30 197199
(FILECREATED "16-Feb-2026 13:34:31" {WMEDLEY}<library>MASTERSCOPE.;41 197959
:EDIT-BY rmk
:CHANGES-TO (FNS MSINTERPRET)
:CHANGES-TO (FNS MSOUTPUT)
:PREVIOUS-DATE " 5-Apr-2025 11:49:04" {WMEDLEY}<library>MASTERSCOPE.;29)
:PREVIOUS-DATE " 8-Feb-2026 22:38:50" {WMEDLEY}<library>MASTERSCOPE.;40)
(PRETTYCOMPRINT MASTERSCOPECOMS)
@@ -847,34 +847,25 @@
(T (CDR (FASSOC Y MSDATABASELST])
(MSSTOREDATA
[LAMBDA (FNNAME FNDATA) (* lmm " 1-JUN-81 23:19")
[LAMBDA (FNNAME FNDATA) (* ; "Edited 8-Feb-2026 18:42 by lmm")
(* lmm " 1-JUN-81 23:19")
(PROG [NEWREL (KWN (PARSERELATION 'KNOWN]
(SETQ MSDBEMPTY NIL)
(* Database for FNNAME about to become inconsistant -
 mark it as changed)
(SETQ MSDBEMPTY NIL) (* Database for FNNAME about to become
 inconsistant -
 mark it as changed)
(PUTHASH FNNAME T MSCHANGEDARRAY)
(* * Now update the database)
(* * Now update the database)
(for TAB in MSDATABASELST when (AND (NOT (FMEMB (CAR TAB)
NODUMPRELATIONS))
(NEQ (CDDR TAB)
T)) do (SETQ NEWREL
(MSCOLLECTDATA
(CAR TAB)))
(STORETABLE FNNAME TAB
NEWREL))
NODUMPRELATIONS))
(NEQ (CDDR TAB)
T)) do (SETQ NEWREL (MSCOLLECTDATA (CAR TAB)))
(STORETABLE FNNAME TAB NEWREL))
[OR (TESTRELATION FNNAME KWN)
(PUTTABLE FNNAME T (CADR (FASSOC 'NOBIND MSDATABASELST]
(* Table NOBIND is for those functions which don't do very much.
 The idea is that the test that a function has been analyzed is whether it
 binds variables are calls functions, etc.
 However, for those functions which have no such entries,
 (e.g. their definition is (LAMBDA NIL NIL)) need to still be able to know
 that they were.)
(PUTTABLE FNNAME T (CADR (FASSOC 'UNBOUND MSDATABASELST]
(* ;; "Table UNBOUND is for those functions which don't do very much. The idea is that the test that a function has been analyzed is whether it binds variables are calls functions, etc. However, for those functions which have no such entries, (e.g. their definition is (LAMBDA NIL NIL)) need to still be able to know that they were.")
(PUTHASH FNNAME NIL MSCHANGEDARRAY])
@@ -911,7 +902,7 @@
((CALL 25 . 50)
(BIND 10 . 10)
[NLAMBDA 10 . 10]
(NOBIND 10)
(UNBOUND 10)
(RECORD 20 . 10)
(CREATE 2 . 2)
(FETCH 10 . 10)
@@ -1120,9 +1111,10 @@
(DEFINEQ
(MSVBTABLES
[LAMBDA (VERB MOD) (* ; "Edited 30-Jun-87 10:32 by jrb:")
(* ;; "The call to MSUSERVBTABLES checks a user hash table to allow extensions.")
[LAMBDA (VERB MOD) (* ; "Edited 8-Feb-2026 18:44 by lmm")
(* ; "Edited 30-Jun-87 10:32 by jrb:")
(* ;; "The call to MSUSERVBTABLES checks a user hash table to allow extensions.")
[COND
((LISTP VERB)
@@ -1159,10 +1151,10 @@
(IS (SELECTQ MOD
(FIELDS '((FETCH)
(REPLACE)))
(FNS '(CALL NOBIND REF (CALL)
(FNS '(CALL UNBOUND REF (CALL)
(APPLY)))
(KNOWN '(CALL NOBIND REF))
(NIL '(CALL NOBIND REF (CALL)
(KNOWN '(CALL UNBOUND REF))
(NIL '(CALL UNBOUND REF (CALL)
(BIND)
(REFFREE)
(REF)
@@ -1192,7 +1184,7 @@
(TYPE '((0)))
NIL))
(KNOWN (SELECTQ MOD
(NIL '(CALL NOBIND REF))
(NIL '(CALL UNBOUND REF))
NIL))
(PROG (SELECTQ MOD
(NIL 'PROG)
@@ -1258,23 +1250,20 @@
(DEFINEQ
(BUILDGETRELQ
[LAMBDA (X) (* ; "Edited 16-Jun-87 12:36 by jrb:")
[LAMBDA (X) (* ; "Edited 8-Feb-2026 19:24 by lmm")
(* ; "Edited 16-Jun-87 12:36 by jrb:")
(PROG ([VAR (COND
((LITATOM (CADR X))
(CADR X))
(T '$$1]
FORM F1)
[for REL in (MSVBTABLES (CAR X))
do [SETQ F1 (LIST 'GETTABLE VAR (LIST (COND
((CADDR X)
'CDDR)
(T 'CADR))
(LIST 'FASSOC (KWOTE REL)
'MSDATABASELST]
(SETQ FORM (COND
(FORM (LIST 'UNION F1 FORM))
(T F1]
[for REL in (MSVBTABLES (CAR X)) do [SETQ F1 `(GETTABLE ,VAR (,(CL:IF (CL:THIRD X)
'CDDR
'CADR)
(FASSOC ',REL MSDATABASELST]
(SETQ FORM (COND
(FORM (LIST 'UNION F1 FORM))
(T F1]
(RETURN (COND
((EQ VAR (CADR X))
FORM)
@@ -2577,7 +2566,7 @@
(* ; "interactive routines")
(RPAQ MASTERSCOPEDATE "24-Aug-2025")
(RPAQ MASTERSCOPEDATE "16-Feb-2026")
(ADDTOVAR HISTORYCOMS %.)
(DEFINEQ
@@ -2616,15 +2605,14 @@
(GO ERLP])
(MASTERSCOPEXEC
[LAMBDA (X LINE) (* ; "Edited 17-Jun-87 16:57 by jrb:")
(* Called via the LISPX in
 MASTERSCOPE)
[LAMBDA (X LINE) (* ; "Edited 8-Feb-2026 18:46 by lmm")
(* ; "Edited 17-Jun-87 16:57 by jrb:")
(* Called via the LISPX in MASTERSCOPE)
(* ;
 "Merged from smL Loops Masterscope by JRB")
 "Merged from smL Loops Masterscope by JRB")
(PROG (MASTERSCOPECOMMAND)
(AND [OR [COND
((NULL LINE) (* Single entry on line)
((NULL LINE) (* ; "Single entry on line")
(OR (NOT (LITATOM X))
(OR (NEQ (EVALV X)
'NOBIND)
@@ -2633,17 +2621,14 @@
(FGETD X)
(LISTP LINE)
(OR [COND
((NULL (CDR LINE)) (* "EDITF ] " OR SETQ
 (A B) TYPE ENTRY)
((NULL (CDR LINE)) (* ;
 "'EDITF ] ' OR SETQ (A B) TYPE ENTRY")
(OR (NULL (CAR LINE))
(LISTP (CAR LINE]
(EQ (ARGTYPE X)
3]
(RETURN))
(* If MASTERSCOPEXEC returns NIL, then LISPX will handle the event as a
 normal typin)
(RETURN)) (* ;
 "If MASTERSCOPEXEC returns NIL, then LISPX will handle the event as a normal typin")
(SETQ MASTERSCOPECOMMAND (CONS X LINE))
(SELECTQ (CAR MASTERSCOPECOMMAND)
((OK STOP BYE ok stop)
@@ -2651,11 +2636,8 @@
NIL)
LISPXVALUE
[AND (LISTP LISPXHIST)
(FRPLACA LISPXHIST (CONS '%. (CAR LISPXHIST]
(* Make sure the event shows up with a %.
 in it)
(FRPLACA LISPXHIST (CONS '%. (CAR LISPXHIST] (* ;
 "Make sure the event shows up with a . in it")
(SETQ LISPXVALUE (MSINTERPRET MASTERSCOPECOMMAND))
(RETURN T])
)
@@ -3516,13 +3498,17 @@
(ERROR!])
(MSOUTPUT
[LAMBDA (FILE) (* ; "Edited 5-Apr-2025 11:48 by rmk")
[LAMBDA (FILE) (* ; "Edited 16-Feb-2026 13:34 by rmk")
(* ; "Edited 5-Feb-2026 01:01 by rmk")
(* ; "Edited 18-Nov-2025 14:01 by rmk")
(* ; "Edited 8-Nov-2025 23:21 by rmk")
(* ; "Edited 5-Apr-2025 11:48 by rmk")
(* ; "Edited 14-Jul-2024 08:41 by rmk")
(* ; "Edited 5-Jul-2024 11:54 by rmk")
(* ; "Edited 12-Jun-90 20:43 by teruuchi")
(LET ((LLENGTH FILELINELENGTH))
[COND
((AND (LITATOM FILE)
[(AND (LITATOM FILE)
(MEMB (U-CASE FILE)
'(TEDIT :TEDIT))
(GETD (FUNCTION TEDIT)))
@@ -3530,12 +3516,14 @@
(* ;;
 "If no TEDIT, leave the current OUTPUT. The readtable for seprs etc is the current readtable.")
[SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
,DEFAULTFONT BOUNDTABLE
,(TEDIT.ATOMBOUND.READTABLE]
[SETQ FILE (OPENTEXTSTREAM NIL NIL `(FONT ,DEFAULTFONT BOUNDTABLE ,(
TEDIT.ATOMBOUND.READTABLE
]
(SETQ LLENGTH T)
(TEDIT.DEFER.UPDATES FILE '(READONLY QUIET))
(RESETSAVE NIL (LIST 'CLOSEF FILE)))
(RESETSAVE NIL `(PROGN (CL:UNLESS RESETSTATE
(TEDIT ,FILE 'Masterscope NIL
'(TITLE Masterscope READONLY QUIET LEAVETTY T)))
(CLOSEF? ,FILE]
((OPENP FILE 'OUTPUT))
(T (SETQ FILE (OPENSTREAM FILE 'OUTPUT))
(RESETSAVE NIL (LIST 'CLOSEF FILE]
@@ -3742,36 +3730,36 @@
(ADDTOVAR LAMA MSEDITE MSEDITF)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3263 19510 (UPDATEFN 3273 . 4890) (MSGETDEF 4892 . 6298) (MSNOTICEFILE 6300 . 8693) (
MSSHOWUSE 8695 . 14676) (MSUPDATEFN1 14678 . 15366) (MSUPDATE 15368 . 17794) (MSNLAMBDACHECK 17796 .
18678) (MSCOLLECTDATA 18680 . 19508)) (19511 20410 (UPDATECHANGED 19521 . 19884) (UPDATECHANGED1 19886
. 20408)) (20984 21407 (MSCLOSEFILES 20994 . 21405)) (22088 26520 (MSDESCRIBE 22098 . 24886) (
MSDESCRIBE1 24888 . 25951) (FMAPRINT 25953 . 26518)) (26613 27053 (MSPRINTHELPFILE 26623 . 27051)) (
27103 30241 (TEMPLATE 27113 . 28534) (GETTEMPLATE 28536 . 28671) (SETTEMPLATE 28673 . 30239)) (31111
36035 (ADDTEMPLATEWORD 31121 . 31793) (MSADDANALYZE 31795 . 33293) (MSADDMODIFIER 33295 . 34376) (
MSADDRELATION 34378 . 35125) (MSADDTYPE 35127 . 36033)) (37536 42757 (MSMARKCHANGE1 37546 . 38340) (
MSINIT 38342 . 39523) (GETVERBTABLES 39525 . 40078) (MSSTOREDATA 40080 . 41759) (STORETABLE 41761 .
42755)) (44158 49228 (PARSERELATION 44168 . 44768) (PARSERELATION1 44770 . 46225) (GETRELATION 46227
. 47256) (MAPRELATION 47258 . 48392) (TESTRELATION 48394 . 49226)) (49229 50869 (ADDHASH 49239 .
49717) (SUBHASH 49719 . 49947) (MAKEHASH 49949 . 50093) (MSREHASH 50095 . 50548) (EQMEMBHASH 50550 .
50867)) (51208 57423 (MSVBTABLES 51218 . 56997) (MSUSERVBTABLES 56999 . 57421)) (57506 59717 (
BUILDGETRELQ 57516 . 58622) (BUILDTESTRELQ 58624 . 59715)) (59888 60276 (MSERASE 59898 . 60274)) (
60277 64737 (DUMPDATABASE 60287 . 62852) (DUMPDATABASE1 62854 . 63199) (READATABASE 63201 . 64735)) (
65819 94878 (MSCHECKBLOCKS 65829 . 69649) (MSCHECKBLOCK 69651 . 78271) (MSCHECKFNINBLOCK 78273 . 81273
) (MSCHECKBLOCKBASIC 81275 . 83695) (MSCHECKBOUNDFREE 83697 . 85596) (GLOBALVARP 85598 . 85765) (
PRINTERROR 85767 . 88983) (MSCHECKVARS1 88985 . 91938) (UNECCSPEC 91940 . 92218) (NECCSPEC 92220 .
92567) (SPECVARP 92569 . 93096) (SHORTLST 93098 . 93554) (DOERROR 93556 . 94266) (MSMSGPRINT 94268 .
94876)) (96022 110850 (MSPATHS 96032 . 99434) (MSPATHS1 99436 . 103671) (MSPATHS2 103673 . 107083) (
MSONPATH 107085 . 108313) (MSPATHS4 108315 . 109397) (DASHES 109399 . 109925) (DOTABS 109927 . 110168)
(BELOWMARKER 110170 . 110633) (MSPATHSPRINTFN 110635 . 110848)) (111236 114660 (MSFIND 111246 .
111521) (MSEDITF 111523 . 112523) (MSEDITE 112525 . 113562) (EDITGETDEF 113564 . 114658)) (115602
124203 (MSMARKCHANGED 115612 . 117336) (CHANGEMACRO 117338 . 118043) (CHANGEVAR 118045 . 118361) (
CHANGEI.S. 118363 . 119696) (CHANGERECORD 119698 . 120569) (MSNEEDUNSAVE 120571 . 121563) (UNSAVEFNS
121565 . 124201)) (124636 128126 (%. 124646 . 124786) (MASTERSCOPE 124788 . 125314) (MASTERSCOPE1
125316 . 126184) (MASTERSCOPEXEC 126186 . 128124)) (128165 167815 (MSINTERPRETSET 128175 . 156709) (
MSINTERPA 156711 . 157245) (MSGETBLOCKDEC 157247 . 159760) (LISTHARD 159762 . 160980) (MSMEMBSET
160982 . 161127) (MSLISTSET 161129 . 161494) (MSHASHLIST 161496 . 161663) (MSHASHLIST1 161665 . 161991
) (CHECKPATHS 161993 . 162633) (ONFILE 162635 . 167813)) (167816 191377 (MSINTERPRET 167826 . 183881)
(VERBNOTICELIST 183883 . 184993) (MSOUTPUT 184995 . 186505) (MSCHECKEMPTY 186507 . 187711) (
CHECKFORCHANGED 187713 . 188233) (MSSOLVE 188235 . 191375)))))
(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 42629 (MSMARKCHANGE1 37543 . 38337) (
MSINIT 38339 . 39520) (GETVERBTABLES 39522 . 40075) (MSSTOREDATA 40077 . 41631) (STORETABLE 41633 .
42627)) (44031 49101 (PARSERELATION 44041 . 44641) (PARSERELATION1 44643 . 46098) (GETRELATION 46100
. 47129) (MAPRELATION 47131 . 48265) (TESTRELATION 48267 . 49099)) (49102 50742 (ADDHASH 49112 .
49590) (SUBHASH 49592 . 49820) (MAKEHASH 49822 . 49966) (MSREHASH 49968 . 50421) (EQMEMBHASH 50423 .
50740)) (51081 57397 (MSVBTABLES 51091 . 56971) (MSUSERVBTABLES 56973 . 57395)) (57480 59783 (
BUILDGETRELQ 57490 . 58688) (BUILDTESTRELQ 58690 . 59781)) (59954 60342 (MSERASE 59964 . 60340)) (
60343 64803 (DUMPDATABASE 60353 . 62918) (DUMPDATABASE1 62920 . 63265) (READATABASE 63267 . 64801)) (
65885 94944 (MSCHECKBLOCKS 65895 . 69715) (MSCHECKBLOCK 69717 . 78337) (MSCHECKFNINBLOCK 78339 . 81339
) (MSCHECKBLOCKBASIC 81341 . 83761) (MSCHECKBOUNDFREE 83763 . 85662) (GLOBALVARP 85664 . 85831) (
PRINTERROR 85833 . 89049) (MSCHECKVARS1 89051 . 92004) (UNECCSPEC 92006 . 92284) (NECCSPEC 92286 .
92633) (SPECVARP 92635 . 93162) (SHORTLST 93164 . 93620) (DOERROR 93622 . 94332) (MSMSGPRINT 94334 .
94942)) (96088 110916 (MSPATHS 96098 . 99500) (MSPATHS1 99502 . 103737) (MSPATHS2 103739 . 107149) (
MSONPATH 107151 . 108379) (MSPATHS4 108381 . 109463) (DASHES 109465 . 109991) (DOTABS 109993 . 110234)
(BELOWMARKER 110236 . 110699) (MSPATHSPRINTFN 110701 . 110914)) (111302 114726 (MSFIND 111312 .
111587) (MSEDITF 111589 . 112589) (MSEDITE 112591 . 113628) (EDITGETDEF 113630 . 114724)) (115668
124269 (MSMARKCHANGED 115678 . 117402) (CHANGEMACRO 117404 . 118109) (CHANGEVAR 118111 . 118427) (
CHANGEI.S. 118429 . 119762) (CHANGERECORD 119764 . 120635) (MSNEEDUNSAVE 120637 . 121629) (UNSAVEFNS
121631 . 124267)) (124702 128312 (%. 124712 . 124852) (MASTERSCOPE 124854 . 125380) (MASTERSCOPE1
125382 . 126250) (MASTERSCOPEXEC 126252 . 128310)) (128351 168001 (MSINTERPRETSET 128361 . 156895) (
MSINTERPA 156897 . 157431) (MSGETBLOCKDEC 157433 . 159946) (LISTHARD 159948 . 161166) (MSMEMBSET
161168 . 161313) (MSLISTSET 161315 . 161680) (MSHASHLIST 161682 . 161849) (MSHASHLIST1 161851 . 162177
) (CHECKPATHS 162179 . 162819) (ONFILE 162821 . 167999)) (168002 192137 (MSINTERPRET 168012 . 184067)
(VERBNOTICELIST 184069 . 185179) (MSOUTPUT 185181 . 187265) (MSCHECKEMPTY 187267 . 188471) (
CHECKFORCHANGED 188473 . 188993) (MSSOLVE 188995 . 192135)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Aug-2025 10:53:33" {WMEDLEY}<library>PDFSTREAM.;70 15659
(FILECREATED "19-Jan-2026 17:03:36" {WMEDLEY}<library>PDFSTREAM.;107 17186
:EDIT-BY rmk
:CHANGES-TO (FNS PDF.FONTSAVAILABLE)
:CHANGES-TO (VARS PDFSTREAMCOMS)
(FNS SEE-PDF)
:PREVIOUS-DATE "30-Jul-2025 18:01:04" {WMEDLEY}<library>PDFSTREAM.;68)
:PREVIOUS-DATE "17-Jan-2026 12:11:04" {WMEDLEY}<library>PDFSTREAM.;105)
(PRETTYCOMPRINT PDFSTREAMCOMS)
@@ -14,26 +15,13 @@
(RPAQQ PDFSTREAMCOMS
((FILES (SYSLOAD)
POSTSCRIPTSTREAM)
(INITVARS (PDFFONTCOERCIONS POSTSCRIPTFONTCOERCIONS)
(PDFCHARCOERCIONS POSTSCRIPTCHARCOERCIONS))
[COMS (* ; "Hook into hardcopy interface")
[ADDVARS [PRINTERTYPES ((PDF)
(CANPRINT (PDF))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND POSTSCRIPTSEND)
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
(BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION
ROTATION TITLE]
[PRINTFILETYPES (PDF (TEST PDFFILEP)
(EXTENSION (PDF))
(CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT]
(IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM)
(FONTCREATE POSTSCRIPT.FONTCREATE)
(FONTSAVAILABLE PDF.FONTSAVAILABLE)
(CREATECHARSET \CREATECHARSET.PSC)
(FONTEXISTS? POSTSCRIPT.FONTEXISTS?]
(ALISTS (DEFAULTFILETYPELIST PDF))
(VARS (DEFAULTPRINTERTYPE 'PDF))
(FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT PDF.FONTSAVAILABLE)
(ALISTS (PRINTFILETYPES PDF)
(IMAGESTREAMTYPES PDF)
(DEFAULTFILETYPELIST PDF))
(FNS PDFFILEP PDF.HARDCOPYW PDF.TEDIT PDF.FONTSAVAILABLE)
(P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]
(* ;; "")
@@ -46,29 +34,31 @@
(ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf))
(GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES)
(FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF)
(FNS PDF.POSTSCRIPT)
(FNS SEE-PDF)
(ADDVARS (FB.SEE.METHODS (PDFFILEP SEE-PDF)))
(FNS PDFCONVERTER)))
(FNS PDFCONVERTER)
(FNS \PDFINIT)
(P (\PDFINIT))))
(FILESLOAD (SYSLOAD)
POSTSCRIPTSTREAM)
(RPAQ? PDFFONTCOERCIONS POSTSCRIPTFONTCOERCIONS)
(RPAQ? PDFCHARCOERCIONS POSTSCRIPTCHARCOERCIONS)
(* ; "Hook into hardcopy interface")
(ADDTOVAR PRINTERTYPES ((PDF)
(CANPRINT (PDF))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND POSTSCRIPTSEND)
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
(BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
(ADDTOVAR PRINTFILETYPES (PDF (TEST PDFFILEP)
(EXTENSION (PDF))
(CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT))))
(CONVERSION (POSTSCRIPT PDF.POSTSCRIPT))
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
(BITMAPFILE (PDF.HARDCOPYW IMAGEFILE BITMAP SCALEFACTOR REGION ROTATION
TITLE))))
(ADDTOVAR IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM)
(FONTCREATE POSTSCRIPT.FONTCREATE)
@@ -77,54 +67,56 @@
(FONTEXISTS? POSTSCRIPT.FONTEXISTS?)))
(ADDTOVAR DEFAULTFILETYPELIST (PDF . BINARY))
(RPAQQ DEFAULTPRINTERTYPE PDF)
(DEFINEQ
(PDFFILEP
[LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk")
[LAMBDA (FILE) (* ; "Edited 13-Sep-2025 23:24 by rmk")
(* ; "Edited 23-Jun-2023 14:43 by rmk")
(* ; "Edited 5-Mar-93 21:40 by rmk:")
(* ; "Edited 14-Jan-93 10:56 by jds")
(OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION)
'("PDF")
:TEST
(FUNCTION STRING-EQUAL))
(CL:WHEN (STREAMP FILE)
(SETFILEPTR FILE 0)
(PROG1 (AND (EQ (BIN FILE)
(CHARCODE %%))
(EQ (BIN FILE)
(CHARCODE P))
(EQ (BIN FILE)
(CHARCODE D))
(EQ (BIN FILE)
(CHARCODE F)))
(SETFILEPTR FILE 0)))])
(RESETLST
[LET (STRM)
[if (SETQ STRM (\GETSTREAM FILE 'INPUT T))
then [RESETSAVE NIL `(PROGN (SETFILEPTR ,STRM ,(GETFILEPTR STRM]
(SETFILEPTR STRM 0)
else (RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT))
`(PROGN (CLOSEF? OLDVALUE]
(AND (EQ (BIN STRM)
(CHARCODE %%))
(EQ (BIN STRM)
(CHARCODE P))
(EQ (BIN STRM)
(CHARCODE D))
(EQ (BIN STRM)
(CHARCODE F])])
(PDF.HARDCOPYW
[LAMBDA (PDFFILE BITMAP SCALEFACTOR REGION Landscape? TITLE)
(* ; "Edited 12-Jan-2026 23:35 by rmk")
(* ; "Edited 11-Jan-2026 14:07 by rmk")
(* ; "Edited 19-Sep-2025 17:36 by rmk")
(* ; "Edited 24-Jul-2023 10:37 by rmk")
(* ; "Edited 23-Jun-2023 13:28 by rmk")
(* ; "Edited 6-Mar-2023 22:43 by rmk")
(LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY PDFFILE)))
(PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP BITMAP SCALEFACTOR REGION Landscape? TITLE)
PDFFILE])
(PDF.TEXT
[LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 1-Oct-2023 15:24 by rmk")
(* ; "Edited 23-Jun-2023 13:23 by rmk")
(* ; "Edited 7-Mar-2023 08:39 by rmk")
(TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION
ROTATION ,(NOT (NOT
POSTSCRIPT.TEXTFILE.LANDSCAPE
])
(* ; "Edited 23-Jun-2023 13:28 by rmk")
(PS-TO-PDF (POSTSCRIPT.HARDCOPYW (OPENSTREAM (UNIX-TMP-FILE-NAME 'bitmap 'ps)
'OUTPUT)
BITMAP SCALEFACTOR REGION Landscape? TITLE)
PDFFILE])
(PDF.TEDIT
[LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk")
(* ; "Edited 7-Mar-2023 08:39 by rmk")
(LET ((TSTREAM (OPENTEXTSTREAM FILE)))
(TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF)
(CLOSEF TSTREAM])
[LAMBDA (FILE IMAGESTREAM IMAGETYPE OPTIONS) (* ; "Edited 13-Jan-2026 15:47 by rmk")
(* ; "Edited 26-Sep-2025 23:02 by rmk")
(* ; "Edited 19-Sep-2025 07:33 by rmk")
(* ;; "Make a scratch postscript stream, then convert it to a PDF that is stored in the caller's IMAGESTREAM (which may have been opened with some postscript preamble, which we discard)")
(PS-TO-PDF (TEDIT.TO.IMAGEFILE FILE (OPENSTREAM (UNIX-TMP-FILE-NAME 'tedit IMAGETYPE)
'OUTPUT)
'POSTSCRIPT OPTIONS)
IMAGESTREAM])
(PDF.FONTSAVAILABLE
[LAMBDA (FONTSPEC) (* ; "Edited 23-Aug-2025 10:53 by rmk")
@@ -162,137 +154,165 @@
(DEFINEQ
(OPEN-PDF-STREAM
[LAMBDA (FILE OPTIONS) (* ; "Edited 5-Jun-2025 08:41 by rmk")
[LAMBDA (FILE OPTIONS) (* ; "Edited 14-Sep-2025 11:15 by rmk")
(* ; "Edited 5-Jun-2025 08:41 by rmk")
(* ; "Edited 23-Feb-2025 12:18 by rmk")
(* ; "Edited 23-Sep-2023 15:38 by rmk")
(* ; "Edited 22-Sep-2023 11:04 by rmk")
(* ; "Edited 24-Jun-2023 14:49 by rmk")
(* ;; "Open a temporary PS file, but set it up so that at closing it gets converted to PDF using an operating-system utility (if available), and then gets renamed to the original intended filename.")
(* ;; "Open FILE as a postscript file, but with IMAGETYPE=PDF and a closefn that calls PS-TO-PDF after the PS file closefn.")
(* ;; "We have to stash the original filename someplace. We could put it in the tmp filename and then parse it out, but then we would have to worry about how unix filenames might parse against our {, }, etc. ")
(* ;;
 "Simplest thing for now is to just add an extra field at the end of the \POSTSCRIPTDATA record.")
(if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST]
then
(* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.")
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
elseif (EQ 'NULL (FILENAMEFIELD (TRUEFILENAME FILE)
'HOST))
then
(* ;; "Device NULL used by TMAX, maybe others, to get page number for table of contents, index. Nothing to convert")
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
elseif (SETQ FILE (OR [AND (NEQ FILE T)
(OR (OUTFILEP FILE)
(OPENSTREAM FILE 'OUTPUT]
(ERROR "PDF target file not found" FILE)))
then (CL:UNLESS (ASSOC (PDFCONVERTER)
PDF-CONVERTER-TEMPLATES)
(ERROR "Can't find a POSTSCRIPT-to-PDF converter"))
(LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
"-"
(RAND)
".ps")
OPTIONS)))
(STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
(STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
PSSTREAM])
(DECLARE (GLOBALVARS \PDFIMAGEOPS))
(CL:UNLESS (ASSOC (PDFCONVERTER)
PDF-CONVERTER-TEMPLATES)
(ERROR "Can't find a POSTSCRIPT-to-PDF converter"))
(LET ((STRM (OPENPOSTSCRIPTSTREAM FILE OPTIONS)))
(replace (STREAM IMAGEOPS) of STRM with \PDFIMAGEOPS)
STRM])
(CLOSE-PDF-STREAM
[LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk")
[LAMBDA (PSSTREAM) (* ; "Edited 17-Jan-2026 12:10 by rmk")
(* ; "Edited 15-Jan-2026 10:16 by rmk")
(* ; "Edited 13-Jan-2026 15:49 by rmk")
(* ; "Edited 27-Sep-2025 14:02 by rmk")
(* ; "Edited 19-Sep-2025 14:16 by rmk")
(* ; "Edited 14-Sep-2025 12:16 by rmk")
(* ; "Edited 22-Sep-2023 11:18 by rmk")
(* ; "Edited 24-Jul-2023 10:37 by rmk")
(* ; "Edited 17-Jul-2023 22:32 by rmk")
(* ; "Edited 24-Jun-2023 13:57 by rmk")
(* ;; "PSSTREAM is a postscript (maybe in tmp) rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.")
(* ;; "But for a file we execute the PDFCONVERTER as a shell command to make a pdf, and then we rename it to the intended filename")
(STREAMPROP PSSTREAM 'AFTERCLOSE NIL) (* ;
 "Maybe just remove only CLOSE-PDF-STREAMfrom the list?")
(LET ((TARGETINFO (STREAMPROP PSSTREAM 'PDFTARGETINFO NIL)))
(CL:IF TARGETINFO
(RENAMEFILE (PS-TO-PDF PSSTREAM)
TARGETINFO)
PSSTREAM)])
(* ;
 "Don't run again for internal closing")
(CL:WHEN (IMAGESTREAMTYPE PSSTREAM 'PDF) (* ;
 "If it's still a PDF stream, it hasn't been converted")
(CLOSEPOSTSCRIPTSTREAM PSSTREAM)
(replace (STREAM IMAGEOPS) of PSSTREAM with \NOIMAGEOPS)
(* ;
 "Don't run again for internal closing")
(CLOSEF? PSSTREAM) (* ; "PS-TO-PDF wants it closed?")
(RESETLST
(LET (PDFSTREAM) (* ;
 "PS-TO-PDF returns a /tmp file if not given a PDFFILE, we copy it into our stream")
[RESETSAVE (SETQ PDFSTREAM (OPENSTREAM (PS-TO-PDF (FULLNAME PSSTREAM)
(UNIX-TMP-FILE-NAME 'closepdf
'pdf))
'INPUT))
`(PROGN (DELFILE (CLOSEF? OLDVALUE]
[RESETSAVE (SETQ PSSTREAM (OPENSTREAM PSSTREAM 'OUTPUT))
`(PROGN (CLOSEF? OLDVALUE]
(SETFILEPTR PSSTREAM 0)
(SETFILEINFO PSSTREAM 'LENGTH 0)
(COPYBYTES PDFSTREAM PSSTREAM 0 -1))))])
(PS-TO-PDF
[LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 1-Oct-2023 15:18 by rmk")
(* ; "Edited 23-Sep-2023 22:54 by rmk")
[LAMBDA (PSFILE PDFFILE MAKEERRORFILE) (* ; "Edited 14-Jan-2026 21:02 by rmk")
(* ; "Edited 13-Jan-2026 15:44 by rmk")
(* ; "Edited 27-Sep-2025 16:51 by rmk")
(* ; "Edited 19-Sep-2025 14:14 by rmk")
(* ; "Edited 14-Sep-2025 09:44 by rmk")
(* ; "Edited 1-Oct-2023 15:18 by rmk")
(* ; "Edited 23-Jul-2023 22:30 by rmk")
(* ; "Edited 24-Jun-2023 15:01 by rmk")
(* ; "Edited 16-Jul-2022 13:06 by rmk")
(* ; "Edited 8-Jul-2022 10:20 by rmk")
(* ; "Edited 7-May-2022 22:40 by rmk")
(* ; "Edited 7-Oct-2021 11:15 by rmk:")
(* ;; "PSFILE is the name of a closed PS file on a DSK/UNIX device. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to PDFFILE. ")
(* ;; "PSFILE is a postscript file or stream whose contents are to be converted to a PDF-formatted file PDFFILE by means of a Shell PDFCONVERTER utility.")
(* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files")
(* ;; "")
(* ;; "PSFILE may be a Medley filename or a stream that is recognized as a PS formatted file. If its contents do not reside in the Unix file system, it will be copied to a /tmp/ file to be given to the Shell. The /tmp/ file may be deleted at the end.")
(* ;; "")
(* ;; "PDFFILE is NIL, a file name, or perhaps a stream to receive the pdf.")
(* ;; " If NIL, a name is made by attaching PDF to PSFILE; a stream without a name goes to a scratch stream.")
(* ;; "")
(SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE)))
(CL:UNLESS (INFILEP PSFILE)
(ERROR "NO PS FILE TO CONVERT"))
(CL:UNLESS (ASSOC (PDFCONVERTER)
PDF-CONVERTER-TEMPLATES)
(ERROR "A specified POSTSCRIPT-to-PDF converter cannot be found"))
(SETQ PDFFILE (if PDFFILE
then (TRUEFILENAME PDFFILE)
else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE)))
(LET ((ERRORFILE (PACKFILENAME 'EXTENSION 'error 'BODY PSFILE))
COMPLETIONCODE)
(ERROR "A POSTSCRIPT-to-PDF converter cannot be found for this system"))
(CL:UNLESS (POSTSCRIPTFILEP PSFILE)
(ERROR "NOT A POSTSCRIPT FILE" PSFILE))
(SETQ PSFILE (TRUEFILENAME PSFILE))
(SETQ PDFFILE (TRUEFILENAME PDFFILE))
(RESETLST
(LET* ((PSNAMEU (SLASHIT (CL:IF (EQ 'UNIX (FILENAMEFIELD PSFILE 'HOST))
(FULLNAME PSFILE)
(COPYFILE PSFILE (UNIX-TMP-FILE-NAME PSFILE 'ps)))
NIL T))
TMPPDFFILE
[PDFNAMEU (CL:IF (EQ 'UNIX (FILENAMEFIELD PDFFILE 'HOST))
(FULLNAME PDFFILE)
(SETQ TMPPDFFILE (UNIX-TMP-FILE-NAME PDFFILE 'pdf)))]
(ERRORFILE (CL:IF MAKEERRORFILE
(UNIX-TMP-FILE-NAME (OR TMPPDFFILE PDFFILE)
'error)
"/dev/null"))
COMPLETIONCODE)
(* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.")
(* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.")
(* ;;
 "We have to map the filenames down to Unix conventions: (not pseudohost or host, slashes, etc.")
[SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS `((PSFILE \, PSNAMEU)
(PDFFILE \,
(SLASHIT PDFNAMEU
NIL T))
(ERRORFILE \,
(SLASHIT ERRORFILE
NIL T)))
(ASSOC (PDFCONVERTER)
PDF-CONVERTER-TEMPLATES
]
[SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS
`((PSFILE \, (SLASHIT (TRUEFILENAME
PSFILE)
NIL T))
(PDFFILE \, (SLASHIT (TRUEFILENAME
PDFFILE)
NIL T))
(ERRORFILE \, (SLASHIT (TRUEFILENAME
ERRORFILE)
NIL T)))
(ASSOC (PDFCONVERTER)
PDF-CONVERTER-TEMPLATES]
(* ;; "Now use Medley names")
(* ;; "Now use Medley names")
(CL:WHEN (IGREATERP COMPLETIONCODE 0)
(CL:WHEN (AND MAKEERRORFILE (INFILEP ERRORFILE))
(CLOSEF? ERRORFILE)
(CL:WHEN (IGREATERP (GETFILEINFO ERRORFILE 'LENGTH)
0)
(PRINTOUT T "See error file at " '%" ERRORFILE '%" T)))
(ERROR "Cannot create PDF file for " PSFILE))
(if TMPPDFFILE
then (* ; "Not on {UNIX}, could be {DSK}")
(PROG1 (COPYFILE TMPPDFFILE PDFFILE)
(DELFILE TMPPDFFILE))
else (* ; "Originally on UNIX")
(FULLNAME PDFFILE))))])
)
(DEFINEQ
(CLOSEF? PSFILE)
(CL:UNLESS DONTDELETE (DELFILE PSFILE))
(CLOSEF? ERRORFILE)
(CL:WHEN (INFILEP ERRORFILE)
(CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILE 'LENGTH)
(CL:UNLESS DONTDELETE (DELFILE ERRORFILE)))
0)
(ERROR "Cannot create PDF file for " PDFFILE)))
(CL:WHEN (IGREATERP COMPLETIONCODE 0)
(ERROR "Cannot create PDF file for " PDFFILE))
PDFFILE])
(PDF.POSTSCRIPT
[LAMBDA (PSFILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 18-Sep-2025 23:49 by rmk")
(* ;; "Can't pass OPTIONS, until the MAKEERROFILE flag goes away.")
(PS-TO-PDF PSFILE IMAGEFILE])
)
(DEFINEQ
(SEE-PDF
[LAMBDA (PDFFILE) (* ; "Edited 30-Jul-2025 18:00 by rmk")
[LAMBDA (PDFFILE) (* ; "Edited 19-Jan-2026 14:06 by rmk")
(* ; "Edited 24-Dec-2025 23:32 by rmk")
(* ; "Edited 30-Jul-2025 18:00 by rmk")
(* ; "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")
(LET [(FOUND (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF]
(if FOUND
(LET (FOUND)
[SETQ FOUND (if (AND (STREAMP PDFFILE)
(PDFFILEP PDFFILE))
then (UNIX-FILE-NAME PDFFILE 'INPUT 'pdf 'pdf)
else (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF]
(if (NOT FOUND)
then (ERROR "FILE NOT FOUND" PDFFILE)
elseif (PDFFILEP FOUND)
then (ShellOpen FOUND)
FOUND
else (ERROR "FILE NOT FOUND" PDFFILE])
else (ERROR FOUND "is not a PDF file"])
)
(ADDTOVAR FB.SEE.METHODS (PDFFILEP SEE-PDF))
@@ -304,9 +324,18 @@
(CAR (for TEMPLATE in PDF-CONVERTER-TEMPLATES
thereis (ShellWhich (CAR TEMPLATE])
)
(DEFINEQ
(\PDFINIT
[LAMBDA NIL (* ; "Edited 14-Sep-2025 01:15 by rmk")
(SETQ \PDFIMAGEOPS (create IMAGEOPS using \POSTSCRIPTIMAGEOPS IMAGETYPE _ 'PDF IMCLOSEFN _
(FUNCTION CLOSE-PDF-STREAM])
)
(\PDFINIT)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3421 6457 (PDFFILEP 3431 . 4345) (PDF.HARDCOPYW 4347 . 4945) (PDF.TEXT 4947 . 5664) (
PDF.TEDIT 5666 . 6033) (PDF.FONTSAVAILABLE 6035 . 6455)) (6897 14542 (OPEN-PDF-STREAM 6907 . 9628) (
CLOSE-PDF-STREAM 9630 . 10917) (PS-TO-PDF 10919 . 14540)) (14543 15301 (SEE-PDF 14553 . 15299)) (15352
15636 (PDFCONVERTER 15362 . 15634)))))
(FILEMAP (NIL (2498 5822 (PDFFILEP 2508 . 3785) (PDF.HARDCOPYW 3787 . 4639) (PDF.TEDIT 4641 . 5398) (
PDF.FONTSAVAILABLE 5400 . 5820)) (6262 14970 (OPEN-PDF-STREAM 6272 . 7422) (CLOSE-PDF-STREAM 7424 .
10136) (PS-TO-PDF 10138 . 14968)) (14971 15227 (PDF.POSTSCRIPT 14981 . 15225)) (15228 16499 (SEE-PDF
15238 . 16497)) (16550 16834 (PDFCONVERTER 16560 . 16832)) (16835 17147 (\PDFINIT 16845 . 17145)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Oct-2025 18:05:08" {WMEDLEY}<library>POSTSCRIPTSTREAM.;55 260304
(FILECREATED "12-Feb-2026 12:19:03" {DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;6 258522
:EDIT-BY rmk
:EDIT-BY "mth"
:CHANGES-TO (FNS POSTSCRIPT.FONTCREATE)
:CHANGES-TO (FNS PSCFONT.READFONT)
:PREVIOUS-DATE " 9-Oct-2025 21:16:27" {WMEDLEY}<library>POSTSCRIPTSTREAM.;53)
:PREVIOUS-DATE "27-Jan-2026 17:57:49"
{DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;5)
(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
@@ -45,7 +46,7 @@
POSTSCRIPT.FONTSAVAILABLE POSTSCRIPT.FONTEXISTS?)
(FNS OPENPOSTSCRIPTSTREAM CLOSEPOSTSCRIPTSTREAM)
(INITVARS (*POSTSCRIPT-FILE-TYPE* 'BINARY))
(FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPT.TEXT POSTSCRIPTFILEP MAKEEPSFILE)
(FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPTFILEP MAKEEPSFILE)
(FNS POSTSCRIPT.BITMAPSCALE POSTSCRIPT.CLOSESTRING POSTSCRIPT.ENDPAGE POSTSCRIPT.OUTSTR
POSTSCRIPT.PUTBITMAPBYTES POSTSCRIPT.PUTCOMMAND POSTSCRIPT.SET-FAKE-LANDSCAPE
POSTSCRIPT.SHOWACCUM POSTSCRIPT.STARTPAGE \POSTSCRIPTTAB \PS.BOUTFIXP \PS.SCALEHACK
@@ -154,17 +155,9 @@
(OPTIMA (PALATINO 1))
(TITAN (COURIER 1))
(* (* 1]
(POSTSCRIPTCHARCOERCIONS NIL)
(\POSTSCRIPT.MAX.WILD.FONTSIZE 72))
[COMS (FNS POSTSCRIPTSEND)
(ADDVARS (PRINTERTYPES ((POSTSCRIPT)
(CANPRINT (POSTSCRIPT))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND POSTSCRIPTSEND)
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
(BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR
REGION ROTATION TITLE]
[ADDVARS (POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA)
(ADDVARS (POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA)
(HELVETICAD . HELVETICA)
(TIMESROMAN . TIMES)
(TIMESROMAND . TIMES)
@@ -176,15 +169,9 @@
(TERMINAL . COURIER)
(LOGO . HELVETICA)
(OPTIMA . PALATINO)
(TITAN . COURIER))
[PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP)
(EXTENSION (PS PSC PSF))
(CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT TEDIT.TO.IMAGEFILE]
(IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM)
(FONTCREATE POSTSCRIPT.FONTCREATE)
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
(CREATECHARSET \CREATECHARSET.PSC)
(FONTEXISTS? POSTSCRIPT.FONTEXISTS?]
(TITAN . COURIER)))
(ALISTS (PRINTFILETYPES POSTSCRIPT)
(IMAGESTREAMTYPES POSTSCRIPT))
(INITVARS (POSTSCRIPT.PAGETYPE 'LETTER))
(* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk")
@@ -389,7 +376,8 @@
(DEFINEQ
(POSTSCRIPT.INIT
[LAMBDA NIL (* ; "Edited 9-Sep-2025 21:57 by rmk")
[LAMBDA NIL (* ; "Edited 31-Dec-2025 22:38 by rmk")
(* ; "Edited 9-Sep-2025 21:57 by rmk")
(* ; "Edited 22-Aug-2025 21:34 by rmk")
(* ; "Edited 14-May-2018 10:48 by rmk:")
(* ; "Edited 4-Feb-93 21:08 by jds")
@@ -436,7 +424,7 @@
(* ;; "Eliminate any existing postscript fonts, to start with a clean slate if reinitializing.")
(FLUSHFONTSINCORE '* '* '* '* 'POSTSCRIPT)
(FLUSHFONTCACHE NIL '* '* '* '* 'POSTSCRIPT)
(SETQ POSTSCRIPTFONTCACHE NIL)
(SETQ \POSTSCRIPT.CHARTYPE (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT T))
@@ -586,22 +574,24 @@
(DEFINEQ
(PSCFONT.READFONT
[LAMBDA (FONTFILENAME) (* ; "Edited 5-Oct-93 17:19 by rmk:")
(* ; "Edited 1-Sep-89 10:55 by jds")
[LAMBDA (FONTFILENAME) (* ; "Edited 12-Feb-2026 12:01 by mth")
(* ; "Edited 5-Oct-93 17:19 by rmk:")
(* ; "Edited 1-Sep-89 10:55 by jds")
(* ;; "Read one of Matt Heffron's .PSC files, to get postscript font metrics. First check to see if incore cache as information indexed under the file's name.")
(* ;; "Read one of Matt Heffron's .PSC files, to get postscript font metrics. First check to see if incore cache has information indexed under the file's name.")
(LET (FID W [S (OPENSTREAM FONTFILENAME 'INPUT NIL '((SEQUENTIAL T]
(PF (create PSCFONT)))
(PF (create PSCFONT))
(*PACKAGE* (CL:FIND-PACKAGE "INTERLISP")))
[replace (PSCFONT FID) of PF with (SETQ FID (READ S (FIND-READTABLE "INTERLISP"]
(* ;; "Read until we hit a 255 byte, marking the end of the font-id section.")
(* ;; "Read until we hit a 255 byte, marking the end of the font-id section.")
(CL:DO NIL
((EQ (BIN S)
255))
(* ;; "Body of the loop is empty, the test does all of the work")
(* ;; "Body of the loop is empty, the test does all of the work")
)
(replace (PSCFONT IL-FONTID) of PF with (CAR FID))
@@ -613,13 +603,12 @@
(for C from 0 to 255 do (SETA W C (\WIN S)))
(CLOSEF S)
(* ;;
 "PATCH JDS 9/1/89: The afm font reader made fonts too tall. This should fix things pro tem.")
(* ;;
 "PATCH JDS 9/1/89: The afm font reader made fonts too tall. This should fix things pro tem.")
(replace (PSCFONT ASCENT) of PF with (- 1000 (fetch (PSCFONT DESCENT)
OF PF)))
(replace (PSCFONT ASCENT) of PF with (- 1000 (fetch (PSCFONT DESCENT) OF PF)))
(PUSH POSTSCRIPTFONTCACHE (CONS (L-CASE (FILENAMEFIELD FONTFILENAME 'NAME))
(CREATE PSCFONT USING PF)))
(CREATE PSCFONT USING PF)))
PF])
(PSCFONT.SPELLFILE
@@ -1127,13 +1116,14 @@
NEWWIDTHS)])
(POSTSCRIPT.FONTSAVAILABLE
[LAMBDA (FONTSPEC) (* ; "Edited 25-Aug-2025 13:09 by rmk")
[LAMBDA (FONTSPEC) (* ; "Edited 17-Dec-2025 20:55 by rmk")
(* ; "Edited 25-Aug-2025 13:09 by rmk")
(* ; "Edited 23-Aug-2025 08:19 by rmk")
(* ;; "Postscript only has font files of size 1, and only files for %"raw%" postscript families that Medley font families are mapped to by POSTSCRIPTFONTCOERCIONS. Therefore the search doesn't care about the given family, just looks at the corresponding raw files that exist in the directory. ")
(LET [(SIZE (fetch (FONTSPEC FSSIZE) of FONTSPEC))
(FONTSAVAILABLE (\SEARCHFONTFILES (CAR (COERCEFONTSPEC FONTSPEC]
(FONTSAVAILABLE (\SEARCHFONTFILES (COERCEFONTSPEC FONTSPEC]
(* ;; "Switch from postscript family names back to the corresponding Medley names.")
@@ -1186,7 +1176,8 @@
(DEFINEQ
(OPENPOSTSCRIPTSTREAM
[LAMBDA (FILE OPTIONS) (* ; "Edited 19-Sep-2025 16:02 by rmk")
[LAMBDA (FILE OPTIONS) (* ; "Edited 19-Jan-2026 17:04 by rmk")
(* ; "Edited 19-Sep-2025 16:02 by rmk")
(* ; "Edited 14-Sep-2025 12:50 by rmk")
(* ; "Edited 12-Jun-2021 19:14 by rmk:")
(* ;
@@ -1278,7 +1269,8 @@
(* ;; "If a REGION parameter was supplied, it establishes the initial margins.")
(SETQ REG (OR (AND (SETQ REG (LISTGET OPTIONS 'REGION))
(SETQ REG (OR (AND (SETQ REG (OR (LISTGET OPTIONS 'REGION)
POSTSCRIPT.DEFAULT.PAGEREGION))
(INTERSECTREGIONS REG CLIP))
(CREATEREGION 3600 3600 54000 72000)))
(replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with (fetch (REGION LEFT)
@@ -1399,14 +1391,6 @@
(TEDIT.TO.IMAGESTREAM FILE IMAGESTREAM])
(POSTSCRIPT.TEXT
[LAMBDA (FILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 17-Sep-2025 23:21 by rmk")
(* ; "Edited 23-Apr-89 11:31 by TAL")
(TEXTTOIMAGEFILE FILE IMAGEFILE IMAGETYPE `(,@OPTIONS REGION ,POSTSCRIPT.DEFAULT.PAGEREGION
ROTATION ,(NOT (NOT
POSTSCRIPT.TEXTFILE.LANDSCAPE
])
(POSTSCRIPTFILEP
[LAMBDA (FILE) (* ; "Edited 9-Oct-2025 21:16 by rmk")
(* ; "Edited 18-Sep-2025 09:35 by rmk")
@@ -1432,7 +1416,8 @@
(CHARCODE !])])
(MAKEEPSFILE
[LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 16-Sep-2025 00:29 by rmk")
[LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 7-Dec-2025 16:37 by rmk")
(* ; "Edited 16-Sep-2025 00:29 by rmk")
(* ; "Edited 7-Apr-94 14:48 by rmk:")
(* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file. The lower-left corner of the image box will be at 0,0 on the page.")
@@ -1441,7 +1426,7 @@
(LET ([IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN)
IMAGEOBJ
(OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT]
(OPENIMAGESTREAM NIL 'POSTSCRIPT]
STREAM)
[SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT
`(BOUNDINGBOX (0 0 ,(FETCH XSIZE OF IMAGEBOX)
@@ -1816,7 +1801,8 @@
(freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL])
(POSTSCRIPT.STARTPAGE
[LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 14:52 by rmk:")
[LAMBDA (STREAM) (* ; "Edited 27-Jan-2026 17:54 by mth")
(* ; "Edited 12-Jun-2021 14:52 by rmk:")
(* ;; "Start up a new page in a Postscript document.")
@@ -1847,11 +1833,11 @@
(LET [(FONT (\DSPFONT.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT)
of IMAGEDATA]
(\DSPRESET.PSC STREAM)
(POSTSCRIPT.OUTSTR STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA))
(for CH instring (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA)
do (\POSTSCRIPT.OUTCHARFN STREAM CH))
(RELMOVETO (CONSTANT (TIMES 72 \PS.SCALE0))
0 STREAM) (* ; "Skip an inch before page number")
(POSTSCRIPT.OUTSTR STREAM "Page ")
(POSTSCRIPT.OUTSTR STREAM NEW-PAGE)
(for CH instring (CONCAT "Page " NEW-PAGE) do (\POSTSCRIPT.OUTCHARFN STREAM CH))
(\TERPRI.PSC STREAM) (* ; "Skip 2 lines")
(\TERPRI.PSC STREAM)
(\DSPFONT.PSC STREAM FONT)))
@@ -4335,28 +4321,9 @@
(TITAN (COURIER 1))
(* (* 1))))
(RPAQ? POSTSCRIPTCHARCOERCIONS NIL)
(RPAQ? \POSTSCRIPT.MAX.WILD.FONTSIZE 72)
(DEFINEQ
(POSTSCRIPTSEND
[LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 20-Nov-95 11:29 by ")
(* ; "Edited 20-Nov-95 11:26 by ")
(* ;; "This is the send function for generic POSTSCRIPT printers. It branches on the architecture-specific function. The theory is that the send method is really a property of the operating system, not a property of specific postscript printers. These functions are contained in separate library files (or defined by user).")
(SELECTQ (MKATOM (UNIX-GETPARM "ARCH"))
(dos (DOSPRINT HOST FILE PRINTOPTIONS))
(UnixPrint HOST FILE PRINTOPTIONS])
)
(ADDTOVAR PRINTERTYPES ((POSTSCRIPT)
(CANPRINT (POSTSCRIPT))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND POSTSCRIPTSEND)
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
(BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION
TITLE))))
(ADDTOVAR POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA)
(HELVETICAD . HELVETICA)
@@ -4373,8 +4340,10 @@
(TITAN . COURIER))
(ADDTOVAR PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP)
(EXTENSION (PS PSC PSF))
(CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT TEDIT.TO.IMAGEFILE))))
(EXTENSION (PS PSC PSF POSTSCRIPT))
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
(BITMAPFILE (POSTSCRIPT.HARDCOPYW IMAGEFILE BITMAP SCALEFACTOR REGION
ROTATION TITLE))))
(ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM)
(FONTCREATE POSTSCRIPT.FONTCREATE)
@@ -4424,39 +4393,37 @@
(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (23388 33596 (POSTSCRIPT.INIT 23398 . 30202) (POSTSCRIPT.PUTRGBCOLOR 30204 . 31226) (
\PSC.COLOR.TO.RGB 31228 . 33594)) (34582 69900 (PSCFONT.READFONT 34592 . 36500) (PSCFONT.SPELLFILE
36502 . 37315) (PSCFONT.COERCEFILE 37317 . 38889) (PSCFONTFROMCACHE.SPELLFILE 38891 . 39876) (
PSCFONTFROMCACHE.COERCEFILE 39878 . 41530) (PSCFONT.WRITEFONT 41532 . 42547) (READ-AFM-FILE 42549 .
48420) (CONVERT-AFM-FILES 48422 . 49634) (POSTSCRIPT.GETFONTID 49636 . 51031) (POSTSCRIPT.FONTCREATE
51033 . 63927) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63929 . 66326) (POSTSCRIPT.FONTSAVAILABLE 66328
. 68511) (POSTSCRIPT.FONTEXISTS? 68513 . 69898)) (69901 79624 (OPENPOSTSCRIPTSTREAM 69911 . 79290) (
CLOSEPOSTSCRIPTSTREAM 79292 . 79622)) (79669 86491 (POSTSCRIPT.HARDCOPYW 79679 . 82786) (
POSTSCRIPT.TEDIT 82788 . 83240) (POSTSCRIPT.TEXT 83242 . 83829) (POSTSCRIPTFILEP 83831 . 85319) (
MAKEEPSFILE 85321 . 86489)) (86492 130066 (POSTSCRIPT.BITMAPSCALE 86502 . 88958) (
POSTSCRIPT.CLOSESTRING 88960 . 89513) (POSTSCRIPT.ENDPAGE 89515 . 90406) (POSTSCRIPT.OUTSTR 90408 .
91625) (POSTSCRIPT.PUTBITMAPBYTES 91627 . 100098) (POSTSCRIPT.PUTCOMMAND 100100 . 101089) (
POSTSCRIPT.SET-FAKE-LANDSCAPE 101091 . 105611) (POSTSCRIPT.SHOWACCUM 105613 . 107768) (
POSTSCRIPT.STARTPAGE 107770 . 110302) (\POSTSCRIPTTAB 110304 . 111101) (\PS.BOUTFIXP 111103 . 112383)
(\PS.SCALEHACK 112385 . 115028) (\PS.SCALEREGION 115030 . 115590) (\SCALEDBITBLT.PSC 115592 . 119902)
(\SETPOS.PSC 119904 . 120385) (\SETXFORM.PSC 120387 . 122971) (\STRINGWIDTH.PSC 122973 . 123446) (
\SWITCHFONTS.PSC 123448 . 128940) (\TERPRI.PSC 128942 . 130064)) (130101 183957 (\BITBLT.PSC 130111 .
130663) (\BLTSHADE.PSC 130665 . 135326) (\CHARWIDTH.PSC 135328 . 135835) (\CREATECHARSET.PSC 135837 .
137193) (\DRAWARC.PSC 137195 . 139573) (\DRAWCIRCLE.PSC 139575 . 141826) (\DRAWCURVE.PSC 141828 .
145672) (\DRAWELLIPSE.PSC 145674 . 148038) (\DRAWLINE.PSC 148040 . 150780) (\DRAWPOINT.PSC 150782 .
151358) (\DRAWPOLYGON.PSC 151360 . 154489) (\DSPBOTTOMMARGIN.PSC 154491 . 155178) (
\DSPCLIPPINGREGION.PSC 155180 . 156555) (\DSPCOLOR.PSC 156557 . 157488) (\DSPFONT.PSC 157490 . 161127)
(\DSPLEFTMARGIN.PSC 161129 . 161815) (\DSPLINEFEED.PSC 161817 . 162407) (\DSPPUSHSTATE.PSC 162409 .
163869) (\DSPPOPSTATE.PSC 163871 . 167356) (\DSPRESET.PSC 167358 . 168023) (\DSPRIGHTMARGIN.PSC 168025
. 168714) (\DSPROTATE.PSC 168716 . 169715) (\DSPSCALE.PSC 169717 . 170669) (\DSPSCALE2.PSC 170671 .
171511) (\DSPSPACEFACTOR.PSC 171513 . 172434) (\DSPTOPMARGIN.PSC 172436 . 173007) (\DSPTRANSLATE.PSC
173009 . 175040) (\DSPXPOSITION.PSC 175042 . 175606) (\DSPYPOSITION.PSC 175608 . 176199) (
\FILLCIRCLE.PSC 176201 . 178426) (\FILLPOLYGON.PSC 178428 . 181665) (\FIXLINELENGTH.PSC 181667 .
182986) (\MOVETO.PSC 182988 . 183758) (\NEWPAGE.PSC 183760 . 183955)) (184013 206159 (
\POSTSCRIPT.CHANGECHARSET 184023 . 184741) (\POSTSCRIPT.OUTCHARFN 184743 . 197013) (
\POSTSCRIPT.PRINTSLUG 197015 . 198739) (\POSTSCRIPT.SPECIALOUTCHARFN 198741 . 201092) (\UPDATE.PSC
201094 . 202340) (\POSTSCRIPT.ACCENTFN 202342 . 203284) (\POSTSCRIPT.ACCENTPAIR 203286 . 206157)) (
206257 207902 (\PSC.SPACEDISP 206267 . 206546) (\PSC.SPACEWID 206548 . 207167) (\PSC.SYMBOLS 207169 .
207900)) (208011 211002 (\POSTSCRIPT.NSHASH 208021 . 211000)) (256412 257118 (POSTSCRIPTSEND 256422 .
257116)))))
(FILEMAP (NIL (22366 32685 (POSTSCRIPT.INIT 22376 . 29291) (POSTSCRIPT.PUTRGBCOLOR 29293 . 30315) (
\PSC.COLOR.TO.RGB 30317 . 32683)) (33671 69196 (PSCFONT.READFONT 33681 . 35692) (PSCFONT.SPELLFILE
35694 . 36507) (PSCFONT.COERCEFILE 36509 . 38081) (PSCFONTFROMCACHE.SPELLFILE 38083 . 39068) (
PSCFONTFROMCACHE.COERCEFILE 39070 . 40722) (PSCFONT.WRITEFONT 40724 . 41739) (READ-AFM-FILE 41741 .
47612) (CONVERT-AFM-FILES 47614 . 48826) (POSTSCRIPT.GETFONTID 48828 . 50223) (POSTSCRIPT.FONTCREATE
50225 . 63119) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63121 . 65518) (POSTSCRIPT.FONTSAVAILABLE 65520
. 67807) (POSTSCRIPT.FONTEXISTS? 67809 . 69194)) (69197 79106 (OPENPOSTSCRIPTSTREAM 69207 . 78772) (
CLOSEPOSTSCRIPTSTREAM 78774 . 79104)) (79151 85477 (POSTSCRIPT.HARDCOPYW 79161 . 82268) (
POSTSCRIPT.TEDIT 82270 . 82722) (POSTSCRIPTFILEP 82724 . 84212) (MAKEEPSFILE 84214 . 85475)) (85478
129222 (POSTSCRIPT.BITMAPSCALE 85488 . 87944) (POSTSCRIPT.CLOSESTRING 87946 . 88499) (
POSTSCRIPT.ENDPAGE 88501 . 89392) (POSTSCRIPT.OUTSTR 89394 . 90611) (POSTSCRIPT.PUTBITMAPBYTES 90613
. 99084) (POSTSCRIPT.PUTCOMMAND 99086 . 100075) (POSTSCRIPT.SET-FAKE-LANDSCAPE 100077 . 104597) (
POSTSCRIPT.SHOWACCUM 104599 . 106754) (POSTSCRIPT.STARTPAGE 106756 . 109458) (\POSTSCRIPTTAB 109460 .
110257) (\PS.BOUTFIXP 110259 . 111539) (\PS.SCALEHACK 111541 . 114184) (\PS.SCALEREGION 114186 .
114746) (\SCALEDBITBLT.PSC 114748 . 119058) (\SETPOS.PSC 119060 . 119541) (\SETXFORM.PSC 119543 .
122127) (\STRINGWIDTH.PSC 122129 . 122602) (\SWITCHFONTS.PSC 122604 . 128096) (\TERPRI.PSC 128098 .
129220)) (129257 183113 (\BITBLT.PSC 129267 . 129819) (\BLTSHADE.PSC 129821 . 134482) (\CHARWIDTH.PSC
134484 . 134991) (\CREATECHARSET.PSC 134993 . 136349) (\DRAWARC.PSC 136351 . 138729) (\DRAWCIRCLE.PSC
138731 . 140982) (\DRAWCURVE.PSC 140984 . 144828) (\DRAWELLIPSE.PSC 144830 . 147194) (\DRAWLINE.PSC
147196 . 149936) (\DRAWPOINT.PSC 149938 . 150514) (\DRAWPOLYGON.PSC 150516 . 153645) (
\DSPBOTTOMMARGIN.PSC 153647 . 154334) (\DSPCLIPPINGREGION.PSC 154336 . 155711) (\DSPCOLOR.PSC 155713
. 156644) (\DSPFONT.PSC 156646 . 160283) (\DSPLEFTMARGIN.PSC 160285 . 160971) (\DSPLINEFEED.PSC
160973 . 161563) (\DSPPUSHSTATE.PSC 161565 . 163025) (\DSPPOPSTATE.PSC 163027 . 166512) (\DSPRESET.PSC
166514 . 167179) (\DSPRIGHTMARGIN.PSC 167181 . 167870) (\DSPROTATE.PSC 167872 . 168871) (
\DSPSCALE.PSC 168873 . 169825) (\DSPSCALE2.PSC 169827 . 170667) (\DSPSPACEFACTOR.PSC 170669 . 171590)
(\DSPTOPMARGIN.PSC 171592 . 172163) (\DSPTRANSLATE.PSC 172165 . 174196) (\DSPXPOSITION.PSC 174198 .
174762) (\DSPYPOSITION.PSC 174764 . 175355) (\FILLCIRCLE.PSC 175357 . 177582) (\FILLPOLYGON.PSC 177584
. 180821) (\FIXLINELENGTH.PSC 180823 . 182142) (\MOVETO.PSC 182144 . 182914) (\NEWPAGE.PSC 182916 .
183111)) (183169 205315 (\POSTSCRIPT.CHANGECHARSET 183179 . 183897) (\POSTSCRIPT.OUTCHARFN 183899 .
196169) (\POSTSCRIPT.PRINTSLUG 196171 . 197895) (\POSTSCRIPT.SPECIALOUTCHARFN 197897 . 200248) (
\UPDATE.PSC 200250 . 201496) (\POSTSCRIPT.ACCENTFN 201498 . 202440) (\POSTSCRIPT.ACCENTPAIR 202442 .
205313)) (205413 207058 (\PSC.SPACEDISP 205423 . 205702) (\PSC.SPACEWID 205704 . 206323) (\PSC.SYMBOLS
206325 . 207056)) (207167 210158 (\POSTSCRIPT.NSHASH 207177 . 210156)))))
STOP

Binary file not shown.

File diff suppressed because it is too large Load Diff

View File

@@ -1,19 +1,22 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT UTF-8)
(FILECREATED "22-Oct-2025 23:28:42" {WMEDLEY}<library>UNICODE-TABLES.;4 34028
(FILECREATED "22-Feb-2026 10:44:33" {WMEDLEY}<library>UNICODE-TABLES.;20 44960
:EDIT-BY rmk
:CHANGES-TO (VARS UNICODE-TABLESCOMS)
:CHANGES-TO (FNS ALL-UNICODE-MAPPINGS GET-MCCS-UNICODE-MAPPING INVERT-UNICODE-MAPPING
MAKE-UNICODE-TRANSLATION-TABLES MERGE-UNICODE-TRANSLATION-TABLES
READ-UNICODE-MAPPING-FILENAMES)
(VARS UNICODE-TABLESCOMS)
:PREVIOUS-DATE "16-Oct-2025 16:47:54" {WMEDLEY}<library>UNICODE-TABLES.;3)
:PREVIOUS-DATE "22-Feb-2026 09:15:20" {WMEDLEY}<library>UNICODE-TABLES.;16)
(PRETTYCOMPRINT UNICODE-TABLESCOMS)
(RPAQQ UNICODE-TABLESCOMS
[
(* ;; "Read Unicode mapping tables. A separate file before UNICODE in the loadup, because the tables must be loaded while UTF8TOMCODE and MCODETOUTF8 are still equivalenced to EVQ. This file has to come before UNICODE in the loadup sequence.")
(* ;; "This is code for reading/writing the XCCS-to-UNICODE mapping tables. It runs offline, when UNICODE-UTF8 is modified. ")
(COMS (* ; "Read Unicode mapping files")
(INITVARS (UNICODEDIRECTORIES NIL))
@@ -22,22 +25,32 @@
(FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING))
(COMS (* ;
 "Make translation tables for UTF external formats")
(FNS MAKE-UNICODE-TRANSLATION-TABLES XCCSTOMCCS-MAPPING
MERGE-UNICODE-TRANSLATION-TABLES UNICODE.UNMAPPED UNICODE-EXTEND-TRANSLATION?)
(FNS MAKE-UNICODE-TRANSLATION-TABLES GET-MCCS-UNICODE-MAPPING INVERT-UNICODE-MAPPING
XCCSTOMCCS-MAPPING)
(FNS ALL-UNICODE-MAPPINGS XCCSJAPANESECHARSETS)
(INITVARS (*MCCSTOUNICODE*)
(*UNICODETOMCCS*)
(*MCCS-LOADED-CHARSETS*)
(*UNICODE-LOADED-CHARSETS*)
(*LARGEUNICODES*))
[DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-UNICODE-TRANSLATION-TABLES 'ALL]
(COMS (* ; "Write Unicode mapping files")
(FNS WRITE-UNICODE-MAPPING WRITE-UNICODE-INCLUDED WRITE-UNICODE-MAPPING-HEADER
WRITE-UNICODE-MAPPING-FILENAME)
(FNS XCCS-UTF8-AFTER-OPEN)
(* ;; "Automate dumping of a documentation prefix")
[DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (MISSINGCODE (CL:PARSE-INTEGER "FFFE"
:RADIX 16))
(UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF"
:RADIX 16]
(VARS UNICODE-MAPPING-HEADER))
(FNS UTF8HEXSTRING)
(COMS (* ; "debugging")
(FNS SHOWCHARS)
(DECLARE%: DOEVAL@LOAD DONTCOPY (MACROS HEXCHAR OCTALCHAR)))
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
UNICODE-EXPORTS])
(* ;;
"Read Unicode mapping tables. A separate file before UNICODE in the loadup, because the tables must be loaded while UTF8TOMCODE and MCODETOUTF8 are still equivalenced to EVQ. This file has to come before UNICODE in the loadup sequence."
"This is code for reading/writing the XCCS-to-UNICODE mapping tables. It runs offline, when UNICODE-UTF8 is modified. "
)
@@ -94,7 +107,8 @@
(DEFINEQ
(READ-UNICODE-MAPPING-FILENAMES
[LAMBDA (FILESPEC) (* ; "Edited 16-Oct-2025 16:43 by rmk")
[LAMBDA (FILESPEC) (* ; "Edited 21-Feb-2026 18:14 by rmk")
(* ; "Edited 16-Oct-2025 16:43 by rmk")
(* ; "Edited 4-Sep-2025 00:11 by rmk")
(* ; "Edited 27-Jan-2025 16:46 by rmk")
(* ; "Edited 21-Jan-2025 22:51 by rmk")
@@ -107,51 +121,47 @@
(* ;; "FILESPEC can be a file name, character-set name, the name of a collection of character sets, an XCCS character code, or a list of those. Maps those into the names of files that contain the indicated Unicode mappings.")
(CL:REMOVE-DUPLICATES [for F X CSI inside (if (EQ FILESPEC 'ALL)
then
(* ;;
(for F X CSI inside (if (EQ FILESPEC 'ALL)
then
(* ;;
 "Perhaps should figure out which files in the directories and subdirectories are relevant?")
(for N in XCCS-CHARSETS
collect (CAR N))
else FILESPEC)
join
(* ;; "Last case hopes to pick up all the tables that are grouped together in a subdirectory (e.g. if F is JIS)")
(for N in XCCS-CHARSETS collect (CAR N))
else FILESPEC)
join
(* ;; "Last case hopes to pick up all the tables that are grouped together in a subdirectory (e.g. if F is JIS)")
(OR (CL:WHEN (CHARCODEP F) (* ;
[OR (CL:WHEN (CHARCODEP F) (* ;
 "An XCCS code can retrieve its character set")
(for D FN (FOCTAL _ (OCTALSTRING (LRSH F 8))) inside
UNICODEDIRECTORIES
when (SETQ FN (FILDIR (PACKFILENAME 'DIRECTORY D
'BODY
(CONCAT 'XCCS- FOCTAL
'=*)
'EXTENSION
'TXT
'VERSION "")))
do (RETURN FN)))
(MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT
'VERSION "")
T UNICODEDIRECTORIES))
(for D inside UNICODEDIRECTORIES
when [SETQ $$VAL (OR (FILDIR (PACKFILENAME 'NAME
(CONCAT "XCCS-*=" F)
'EXTENSION
'TXT
'VERSION "" 'BODY D))
(FILDIR (PACKFILENAME 'NAME
(CONCAT "XCCS-" F "=*")
'EXTENSION
'TXT
'VERSION "" 'BODY D]
do (RETURN $$VAL))
(AND (SETQ CSI (ASSOC F XCCS-CHARSETS))
(READ-UNICODE-MAPPING-FILENAMES (CDR CSI)))
(for D inside UNICODEDIRECTORIES
when (DIRECTORYNAMEP (SETQ D (CONCAT D ">" F ">")))
join (FILDIR (CONCAT D ">*.TXT;"]
:TEST
(FUNCTION STRING.EQUAL])
(for D FN (FOCTAL (OCTALSTRING (LRSH F 8))) inside UNICODEDIRECTORIES
when (SETQ FN (DIRECTORY (PACKFILENAME 'DIRECTORY D 'BODY (CONCAT 'XCCS-
FOCTAL
'=*)
'EXTENSION
'TXT
'VERSION ""))) do (RETURN FN)))
(MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT 'VERSION "")
T UNICODEDIRECTORIES))
(for D inside UNICODEDIRECTORIES
when [SETQ $$VAL (OR (DIRECTORY (PACKFILENAME 'NAME (CONCAT "XCCS-*=" F)
'EXTENSION
'TXT
'VERSION "" 'BODY D))
(DIRECTORY (PACKFILENAME 'NAME (CONCAT "XCCS-" F "=*")
'EXTENSION
'TXT
'VERSION "" 'BODY D]
do (RETURN $$VAL))
(AND (SETQ CSI (ASSOC F XCCS-CHARSETS))
(READ-UNICODE-MAPPING-FILENAMES (CDR CSI)))
(for D inside UNICODEDIRECTORIES when (DIRECTORYNAMEP (SETQ D
(CONCAT D ">" F ">")))
join (DIRECTORY (CONCAT D ">*.TXT;"]
finally (* ;
 "CL:REMOVE-DUPLICATES doesn't exist in MAKEINIT")
(RETURN (for FTAIL on $$VAL unless (thereis FF in (CDR FTAIL)
suchthat (STRING-EQUAL (CAR FTAIL)
FF)) collect (CAR FTAIL])
(READ-UNICODE-MAPPING
[LAMBDA (FILESPEC PRINT NOERROR) (* ; "Edited 16-Oct-2025 11:25 by rmk")
@@ -179,7 +189,7 @@
(* ;; "")
(RESETLST
(for FILE STREAM [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] in (
(for FILE STREAM [SEPBITTABLE (MAKEBITTABLE (CHARCODE (TAB SPACE] in (
 READ-UNICODE-MAPPING-FILENAMES
FILESPEC)
join
@@ -221,7 +231,8 @@
(DEFINEQ
(MAKE-UNICODE-TRANSLATION-TABLES
[LAMBDA (MAPPING REINSTALL) (* ; "Edited 11-Oct-2025 11:54 by rmk")
[LAMBDA (MAPPING REINSTALL) (* ; "Edited 21-Feb-2026 22:42 by rmk")
(* ; "Edited 11-Oct-2025 11:54 by rmk")
(* ; "Edited 4-Sep-2025 00:30 by rmk")
(* ; "Edited 24-Apr-2025 15:47 by rmk")
(* ; "Edited 31-Jan-2025 17:46 by rmk")
@@ -232,26 +243,13 @@
(* ; "Edited 3-Feb-2024 00:24 by rmk")
(* ; "Edited 30-Jan-2024 09:54 by rmk")
(* ; "Edited 21-Aug-2021 13:12 by rmk:")
(SETQ MAPPING (GET-MCCS-UNICODE-MAPPING MAPPING))
(* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to XCCS-to-Unicode mapping files. This applies the XCCS-to-MCCS translations, and then updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. MCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. MCCS).")
 (* ; "Edited 17-Aug-2020 08:46 by rmk:")
(CL:UNLESS [AND (LISTP MAPPING)
(FOR PAIR R IN MAPPING AS I TO 10
ALWAYS (AND (LISTP PAIR)
(CHARCODEP (CAR PAIR))
[FIXP (SETQ R (CAR (MKLIST (CADR PAIR]
(CHARCODEP (IABS R]
(* ;; "Seems like the argument is not already a list of mapping pairs (perhaps with a combiner), presumably a list of charsets to be read.")
(SETQ MAPPING (READ-UNICODE-MAPPING MAPPING)))
(SETQ MAPPING (XCCSTOMCCS-MAPPING MAPPING))
(* ;; "This updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).")
(* ;; "This updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. MCCS to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. MCCS).")
(* ;; "")
(* ;; "If REINSTALL is T, the new mapping vectors replace the current maps in the *XCCSTOUNICODE* and *UNICODETOXCCS* global variables. Otherwise we create new tables (mostly for comparison and debugging).")
(* ;; "If REINSTALL is T, the new mapping vectors replace the current maps in the *MCCSTOUNICODE* and *UNICODETOMCCS* global variables. Otherwise we create new tables (mostly for comparison and debugging).")
(* ;; "")
@@ -270,6 +268,55 @@
(SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE))
(MERGE-UNICODE-TRANSLATION-TABLES NIL MAPPING])
(GET-MCCS-UNICODE-MAPPING
[LAMBDA (MAPPING) (* ; "Edited 22-Feb-2026 00:29 by rmk")
(* ;; "MAPPING is the list of numeric code correspondence pairs mapping MCCS-to-Unicode, or a specification of XCCS-to-Unicode files to be read and converted to MCCS-to-UNICODE.")
(SORT (if [AND (LISTP MAPPING)
(for PAIR R in MAPPING as I to 10
always (AND (LISTP PAIR)
(CHARCODEP (CAR PAIR))
[FIXP (SETQ R (CAR (MKLIST (CADR PAIR]
(CHARCODEP (IABS R]
then
(* ;; "The argument is already a list of MCCS-to-UNICODE mapping pairs")
MAPPING
else
(* ;; "Mapping files are is read as XCCS-UNICODE, make it MCCS")
(XCCSTOMCCS-MAPPING (READ-UNICODE-MAPPING MAPPING)))
T])
(INVERT-UNICODE-MAPPING
[LAMBDA (MAPPING) (* ; "Edited 22-Feb-2026 00:39 by rmk")
(* ;; "MAPPING is a list of pairs that map domain codes to range codes (presumably MCCS to UNICODE). This produces an inverted list of pairs that map the range into the domain (Unicode to MCCS) ")
(LET (INVERTED)
(SETQ INVERTED (SORT (for P D R OLDR in MAPPING eachtime (SETQ D (CAR P))
(SETQ R (CADR P))
(* ;;
 "We don't do combiners, but we are allowing non-SMALLP's")
unless (OR (LISTP D)
(LISTP R)) collect (LIST R D))
T))
(* ;; "If MAPPING contains two pairs that map to the same U (e.g. (M1 U) and (M2 U)), we want the inverse table to collect them into a single pair (U M1 M2) instead of two pairs (U M1) (U M2), with the lowest M code first. Those pairs represent alternative inverse mappings. There are no duplicates/alternative table entries in the M-to-U direction.")
(* ;; "The SORT above means that multiple inverted pairs for the same U will be next to each other in the list.")
[for PTAIL PTAIL2 U MS on INVERTED eachtime (SETQ U (CAAR PTAIL))
when (SETQ MS (for old PTAIL2 P2 on PTAIL eachtime (SETQ P2 (CADR PTAIL2))
while (EQ U (CAR P2)) collect (CADR P2)))
do (RPLACD PTAIL (CDR PTAIL2))
(RPLACD (CAR PTAIL)
(SORT (CONS (CADR (CAR PTAIL))
MS]
INVERTED])
(XCCSTOMCCS-MAPPING
[LAMBDA (XTOUMAPPING) (* ; "Edited 11-Oct-2025 12:57 by rmk")
@@ -292,152 +339,12 @@
XTOMCODES)))
finally (push XTOUMAPPING (CHARCODE (DEL DEL)))
(RETURN XTOUMAPPING])
(MERGE-UNICODE-TRANSLATION-TABLES
[LAMBDA (INVERSE MAPPING TABLE INVERSETABLE) (* ; "Edited 11-Oct-2025 10:24 by rmk")
(* ; "Edited 24-Apr-2025 15:28 by rmk")
(* ; "Edited 1-Feb-2025 21:42 by rmk")
(* ; "Edited 26-Jan-2025 12:58 by rmk")
(* ; "Edited 22-Jan-2025 08:20 by rmk")
(* ; "Edited 19-Jan-2025 15:58 by rmk")
(* ; "Edited 18-Jan-2025 11:49 by rmk")
(* ; "Edited 27-Mar-2024 12:10 by rmk")
(* ; "Edited 3-Feb-2024 12:46 by rmk")
(* ; "Edited 31-Jan-2024 10:06 by rmk")
(* ;; "MAPPINGS is a list of pairs that map domain codes to range codes. TABLE and INVERSETABLE default to *MCCSTOUNICODE* *UNICODETOMCCS* respectively. ")
(CL:UNLESS TABLE
[SETQ TABLE (OR *MCCSTOUNICODE* (SETQ *MCCSTOUNICODE* (HASHARRAY (LENGTH MAPPING])
(CL:UNLESS INVERSETABLE
[SETQ INVERSETABLE (OR *UNICODETOMCCS* (SETQ *UNICODETOMCCS* (HASHARRAY (LENGTH MAPPING])
(for M D R OLDR in MAPPING first (CL:IF INVERSE (swap TABLE INVERSETABLE))
eachtime (SETQ D (CAR M))
(SETQ R (CADR M))
(* ;; "We don't do combiners, but we are allowing non-SMALLP's")
unless (OR (LISTP D)
(LISTP R)) do
(* ;; "The (CONS R OLDR) deals with alternatives: (U X1) (U X2) => (U (X1 X2)), lowest code first. Those are only possible in the U-to-X direction when the tables contain (X1 U) and (X2 U). There are no duplicates/alternative table entries in the X-to-U direction.")
(SETQ OLDR (GETHASH D TABLE))
(CL:UNLESS (MEMB R OLDR)
(PUTHASH D (SORT (CONS R OLDR))
TABLE))
(swap D R)
(SETQ OLDR (GETHASH D INVERSETABLE))
(CL:UNLESS (MEMB R OLDR)
(PUTHASH D (SORT (CONS R OLDR))
INVERSETABLE)))
(LIST TABLE INVERSETABLE])
(UNICODE.UNMAPPED
[LAMBDA (CODE TABLE DONTFAKE) (* ; "Edited 24-Apr-2025 15:48 by rmk")
(* ; "Edited 22-Jan-2025 08:19 by rmk")
(* ; "Edited 19-Jan-2025 22:02 by rmk")
(* ; "Edited 18-Jan-2025 12:02 by rmk")
(* ; "Edited 2-Feb-2024 23:52 by rmk")
(* ; "Edited 31-Jan-2024 10:07 by rmk")
(* ; "Edited 11-Aug-2020 20:23 by rmk:")
(* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODE has no fast mapping in TRANSLATION-TABLE.")
(* ;; "")
(* ;; "If we have not already installed the mapping segment for that code, we try to retrieve it from the numberic file. If that segment mapping doesn't exist or doesn't have an entry for CODE, we fake up a mapping with a negative range in both directions. One way or the other, there will be an entry for that segment in both mapping vectors.")
(* ;; "")
(PROG ((INVERSE (EQ TABLE *UNICODETOMCCS*))
RANGE HASH)
(* ;; "If we already looked up CODE's character set in a file, then we have already filled in its information in the translation table. If it didn't have a code for a particular character, then we fake it here. Faked codes are negative, so we can detect them easily, and interpret them with IABS.")
(CL:WHEN (AND (UNICODE-EXTEND-TRANSLATION? CODE TABLE)
(SETQ RANGE (GETHASH CODE TABLE)))
(* ;; "We might have gotten the segment that didn't have an entry for CODE.")
(RETURN RANGE))
(* ;; "")
(CL:UNLESS DONTFAKE
(* ;; "Our attempt at extending the known tables did not provide a mapping for CODE. So we fake it up with the next unused private code in the code space. ")
(* ;; "The number of possible faked mappings is determined by the number of private-use Unicodes, since the MCCS character space is pretty sparse. The codes don't have to come from the same part of the code space, and the NEXTCODEs are saved in global variables. The last available codes are constants.")
(CL:WHEN (IEQP *NEXT-PRIVATE-MCCSCODE* LAST-PRIVATE-MCCSCODE)
(* ;
 "Same number of available codes both ways")
(ERROR "EXHAUSTED RANGE FOR UNMAPPED CODES"))
(if INVERSE
then (SETQ RANGE *NEXT-PRIVATE-MCCSCODE*)
(add *NEXT-PRIVATE-MCCSCODE* 1)
else (SETQ RANGE *NEXT-PRIVATE-UNICODE*)
(add *NEXT-PRIVATE-UNICODE* 1))
(MERGE-UNICODE-TRANSLATION-TABLES INVERSE (CONS (LIST CODE RANGE)))
(* ;; "CONS because of LIST convention so we can eventually distinguish combiners.")
(RETURN (CONS RANGE)))])
(UNICODE-EXTEND-TRANSLATION?
[LAMBDA (CODE TABLE) (* ; "Edited 11-Oct-2025 09:49 by rmk")
(* ; "Edited 4-Sep-2025 00:34 by rmk")
(* ; "Edited 29-Jun-2025 16:44 by rmk")
(* ; "Edited 24-Apr-2025 15:49 by rmk")
(* ; "Edited 26-Jan-2025 11:26 by rmk")
(* ; "Edited 21-Jan-2025 22:31 by rmk")
(* ; "Edited 18-Jan-2025 12:40 by rmk")
(* ; "Edited 13-Jan-2025 23:50 by rmk")
(* ; "Edited 26-Aug-2024 16:49 by rmk")
(* ; "Edited 27-Mar-2024 23:02 by rmk")
(* ; "Edited 5-Feb-2024 13:48 by rmk")
(* ; "Edited 3-Feb-2024 12:40 by rmk")
(* ;; "There is currently no mapping for CODE in TABLE, hopefully just because the relevant character-set mapping has not been installed. We infer from TABLE whether CODE is an MCCS or UNICODE code and look for the proper mapping table (forward or inverted) for its character set. ")
(* ;; "We record which character sets we have already expanded so we don't do them again.")
(LET ((CHARSET (\CHARSET CODE))
(INVERSE (EQ TABLE *UNICODETOMCCS*))
MAPPING FILE)
(* ;; "If we already looked for CHARSET in the file and found anything, it has already been merged. Otherwise, it would just fail again")
(CL:UNLESS (MEMB CHARSET (CL:IF INVERSE
*UNICODE-LOADED-CHARSETS*
*MCCS-LOADED-CHARSETS*))
(* ;; "Don't try this charset again.")
(CL:IF INVERSE
(push *UNICODE-LOADED-CHARSETS* CHARSET)
(push *MCCS-LOADED-CHARSETS* CHARSET))
(SETQ FILE (FINDFILE (CL:IF INVERSE
'UNICODE-TO-MCCS-MAPPINGS
'MCCS-TO-UNICODE-MAPPINGS)
T UNICODEDIRECTORIES))
(* ;; "The mappings files are indexed by CHARSET.")
(CL:WHEN [AND FILE (SETQ MAPPING (CL:WITH-OPEN-FILE (STREAM FILE :INPUT)
(CL:WHEN (FILEPOS (CONCAT "[" CHARSET " ")
STREAM NIL NIL NIL T)
(READ STREAM]
(* ;;
 "Merge MAPPING into both tables, respecting the direction indicated by TABLE. ")
(MERGE-UNICODE-TRANSLATION-TABLES INVERSE MAPPING)
T))])
)
(DEFINEQ
(ALL-UNICODE-MAPPINGS
[LAMBDA (INVERTED FILE) (* ; "Edited 24-Apr-2025 15:51 by rmk")
[LAMBDA (INVERTED FILE) (* ; "Edited 22-Feb-2026 10:42 by rmk")
(* ; "Edited 24-Apr-2025 15:51 by rmk")
(* ; "Edited 31-Jan-2025 17:46 by rmk")
(* ; "Edited 26-Jan-2025 13:40 by rmk")
(* ; "Edited 22-Jan-2025 14:07 by rmk")
@@ -453,38 +360,32 @@
(* ;; "The first index level segments all the domain codes according to their character sets. The segments are sorted by character set, the pairs within each segment are sorted by their domain codes. ")
(* ;;
 "E.g. if INVERTED=NIL and given a XCCS code, the lookup for the corresponding Unicode(s) is")
 "E.g. if INVERTED=NIL and given a MCCS code, the lookup for the corresponding Unicode(s) is")
(* ;; " (CADR (ASSOC MCCSCODE (\CHARSET MCCSCODE) INDEX)))).")
(* ;; " (CAR (GETMULTI INDEX (\CHARSET MCCSCODE) MCCSCODE).")
(* ;; "If FILE is not NIL, the result is written to a file. If FILE is T, the file is either MCCS-TO-UNICODE-MAPPINGS.TXT or UNICODE-TO-MCCS-MAPPINGS.TXT, depending on INVERTED.")
(LET (INDEX)
(for PAIR DOMAIN RANGE CHARSET in (READ-UNICODE-MAPPING 'ALL) eachtime (SETQ DOMAIN
(CAR PAIR))
(SETQ RANGE (CADR PAIR))
(* ;;
 "(LISTP RANGE) is a combiner, ignored for now.")
unless (LISTP RANGE) do (CL:WHEN INVERTED (SWAP DOMAIN RANGE))
(LET [INDEX (MAPPING (GET-MCCS-UNICODE-MAPPING 'ALL]
(for PAIR in (CL:IF INVERTED
(INVERT-UNICODE-MAPPING MAPPING)
MAPPING) unless (LISTP (CADR PAIR)) do
(* ;;
 "(LISTP (CADR PAIR) is a combiner, ignored for now.")
(* ;;
(* ;;
 "One segment for each high-byte character set. This aligns with UNICODE-EXTEND.TRANSLATION?")
[SETQ CHARSET (OR (ASSOC (\CHARSET DOMAIN)
INDEX)
(CAR (push INDEX (CONS (\CHARSET DOMAIN]
(* ;; "For alternative mappings (in the U-to-M direction) we end up with (D R1 R2 ...). (CAR (GETMULTI)) is the first (and almost always) the only one.")
(* ;; "For alternative mappings (in the U-to-M direction) we end up with (D R1 R2 ...). (CADR is the first (and almost always) the only one.")
(pushnew [CDR (OR (ASSOC DOMAIN (CDR CHARSET))
(CAR (push (CDR CHARSET)
(CONS DOMAIN]
RANGE))
(PUSHMULTI-NEW INDEX
(\CHARSET (CAR PAIR))
(CAR PAIR)
(CADR PAIR)))
(* ;; "Push the charset mappings down an extra CONS, so that a subsequent READ will get them all after a FILEPOS search for super-paren [")
[for CS in INDEX do (for M in (CDR CS) when (CDDR M) do
(for CS in INDEX do (for M in (CDR CS) when (CDDR M) do
(* ;;
 "Sort the range alternatives, if any")
@@ -494,7 +395,7 @@
(* ;; "Sort by domain codes and push down a level")
(change (CDR CS)
(CONS (SORT DATUM T]
(SORT DATUM T)))
(SETQ INDEX (SORT INDEX T)) (* ; "Sort character sets")
(if FILE
then (SETQ FILE (PACKFILENAME 'BODY (if (NEQ FILE T)
@@ -544,18 +445,347 @@
(FULLNAME STREAM))))])
)
(RPAQ? *MCCSTOUNICODE* )
(RPAQ? *UNICODETOMCCS* )
(RPAQ? *MCCS-LOADED-CHARSETS* )
(* ; "Write Unicode mapping files")
(RPAQ? *UNICODE-LOADED-CHARSETS* )
(DEFINEQ
(RPAQ? *LARGEUNICODES* )
(DECLARE%: DONTEVAL@LOAD DOCOPY
(WRITE-UNICODE-MAPPING
[LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK) (* ; "Edited 4-Jan-2024 22:44 by rmk")
(* ; "Edited 16-Aug-2020 16:56 by rmk:")
(MAKE-UNICODE-TRANSLATION-TABLES 'ALL)
(* ;; "Writes a symbol unicode mapping file. Mapping is a list of (XCCS-code Unicode) pairs, which may contain codes in multiple character sets.")
(* ;; "If FILE is NIL, it defaults to a name XCCS- followed by the octal character sets in the mapping, in the unicode/XEROX directory.")
(* ;; "The output lines are of the form x0XXX<tab>x0UUUU<tab># Unicode-char")
(* ;;
 "If INCLUDECHARSETS=T then the mappings are split up into separate per-character set files.")
(* ;; "Otherwise, all and only mappings included in thos charsets are included in a single output file--an implicit subset.")
(IF (AND (EQ INCLUDECHARSETS T)
(NULL FILE))
THEN (IF MAPPING
THEN (FOR CSI F IN XCCS-SET-NAMES WHEN (SETQ F (WRITE-UNICODE-MAPPING MAPPING
(CAR CSI)
NIL T)) COLLECT F)
ELSE (PRINTOUT T "THERE ARE NO MAPPINGS" T)
NIL)
ELSE
(LET
(IMAPPING CSETINFO RANGES)
(CL:MULTIPLE-VALUE-SETQ (IMAPPING CSETINFO RANGES)
(WRITE-UNICODE-INCLUDED MAPPING INCLUDECHARSETS))
(IF IMAPPING
THEN (CL:WITH-OPEN-FILE
(STREAM (WRITE-UNICODE-MAPPING-FILENAME FILE CSETINFO RANGES)
:DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :EXTERNAL-FORMAT :UTF-8-RAW)
(WRITE-UNICODE-MAPPING-HEADER STREAM CSETINFO RANGES)
(SORT IMAPPING T)
(FOR M CSET LEFTC FIRSTRIGHTC CSI IN IMAPPING
DO (SETQ LEFTC (CAR M))
(SETQ FIRSTRIGHTC (CADR M))
(CL:UNLESS (EQ CSET (LRSH LEFTC 8))
(SETQ CSET (LRSH LEFTC 8))
(SETQ CSI (ASSOC CSET CSETINFO))
(PRINTOUT STREAM T "# " .P2 (CADR CSI)
" "
(CADDR CSI)
T))
(PRINTOUT STREAM "0x" (HEXSTRING LEFTC 4)
%#
(FOR RIGHTC IN (CDR M) DO (PRINTOUT NIL " " "0x" (HEXSTRING RIGHTC 4)))
" # "
(SELECTC FIRSTRIGHTC
(UNDEFINEDCODE
(* ;; "FFFF")
"UNDEFINED")
(MISSINGCODE
(* ;; "FFFE")
"MISSING")
(IF (ILESSP FIRSTRIGHTC 32)
THEN (* ; "Control chars")
[CONCAT "↑" (CHARACTER (IPLUS FIRSTRIGHTC (CHARCODE @]
ELSE (CHARACTER FIRSTRIGHTC)))
T))
(FULLNAME STREAM))
ELSEIF (NOT EMPTYOK)
THEN (PRINTOUT T "THERE ARE NO MAPPINGS")
(CL:WHEN INCLUDECHARSETS
(PRINTOUT T " FOR " .PPVTL (MKLIST INCLUDECHARSETS)
T))
NIL])
(WRITE-UNICODE-INCLUDED
[LAMBDA (MAPPING INCLUDECHARSETS) (* ; "Edited 4-Aug-2020 17:47 by rmk:")
(* ;; "CSETINFO is a list of (num string name) for each included character set.")
(LET (CHARSETS CSETINFO RANGES ICSETS IMAPPING)
(* ;; "Normalize the INCLUDECHARSETS, then reduce MAPPING to the included mappings")
[SETQ ICSETS (FOR C POS KNOWN INSIDE (OR INCLUDECHARSETS (FOR CSI IN XCCS-SET-NAMES
COLLECT (CAR CSI)))
JOIN [SETQ KNOWN (OR (SASSOC C XCCS-SET-NAMES)
(FIND N IN XCCS-SET-NAMES
SUCHTHAT (EQ C (CADR N)))
(HELP "UNKNOWN CHARACTER SET" (OCTALSTRING C]
(IF (SETQ POS (STRPOS "-" (CAR KNOWN)))
THEN (FOR I FROM (CL:PARSE-INTEGER (SUBSTRING (CAR KNOWN)
1
(SUB1 POS))
:RADIX 8)
TO (CL:PARSE-INTEGER (SUBSTRING (CAR KNOWN)
(ADD1 POS))
:RADIX 8) COLLECT (LIST I (OCTALSTRING I)
(CADR KNOWN)))
ELSE (CONS (CONS (CL:PARSE-INTEGER (CAR KNOWN)
:RADIX 8)
KNOWN]
(SETQ IMAPPING (FOR M CSI IN MAPPING WHEN (SETQ CSI (ASSOC (LRSH (CAR M)
8)
ICSETS))
COLLECT
(* ;; "The attested subset of INCLUDED")
(CL:UNLESS (MEMB CSI CSETINFO)
(PUSH CSETINFO CSI))
M))
(* ;; "Sort as numbers, not octal strings, then group into consecutive ranges")
(SETQ CSETINFO (SORT CSETINFO T))
[SETQ RANGES (FOR CTAIL C START END ON (FOR CSI IN CSETINFO COLLECT (CAR CSI)) WHILE CTAIL
COLLECT (SETQ START (CAR CTAIL))
(SETQ END START)
(CONS START (WHILE [AND (CDR CTAIL)
(EQ END (SUB1 (CADR CTAIL]
COLLECT (SETQ CTAIL (CDR CTAIL))
(SETQ END (CAR CTAIL]
(* ;; "Split out groups of less than 3. But if a range exhaustively covers a known subset (like JIS), replace by the name")
[SETQ RANGES (FOR R STR KNOWN LAST IN RANGES
JOIN (SETQ LAST (CAR (LAST R)))
(IF (EQ (CAR R)
LAST)
THEN (CONS (OCTALSTRING (CAR R)))
ELSEIF (SETQ KNOWN (SASSOC (SETQ STR (CONCAT (OCTALSTRING
(CAR R))
"-"
(OCTALSTRING LAST)))
XCCS-SET-NAMES))
THEN (CONS (CADR KNOWN))
ELSEIF (CDDR R)
THEN (CONS STR)
ELSE (LIST (OCTALSTRING (CAR R))
(OCTALSTRING LAST]
(CL:VALUES IMAPPING CSETINFO RANGES])
(WRITE-UNICODE-MAPPING-HEADER
[LAMBDA (STREAM CSETINFO RANGES) (* ; "Edited 5-Jan-2024 13:24 by rmk")
(* ; "Edited 4-Aug-2020 17:38 by rmk:")
(* ;; "Writes the standard per-file header information")
(FOR LINE IN UNICODE-MAPPING-HEADER
DO (PRINTOUT STREAM "#" 2)
(SELECTQ LINE
(XCCSCHARACTERSETS
(PRINTOUT STREAM " XCCS charset")
(IF (CDR CSETINFO)
THEN (PRINTOUT STREAM "s:" -4)
(FOR R IN RANGES DO (PRINTOUT STREAM R " "))
ELSE (* ; "Singleton")
(PRINTOUT STREAM ": " -4 (CADAR CSETINFO)
" "
(CADDAR CSETINFO)))
(TERPRI STREAM))
(DATE (PRINTOUT STREAM " Date:" -13 (DATE (DATEFORMAT NO.TIME NO.LEADING.SPACES)
)
T))
(PRINTOUT STREAM LINE T)))
(TERPRI STREAM])
(WRITE-UNICODE-MAPPING-FILENAME
[LAMBDA (FILE CSETINFO RANGES) (* ; "Edited 4-Aug-2020 19:34 by rmk:")
(PACKFILENAME 'BODY [OR FILE (CONCATLIST
(CONS 'XCCS- (IF (CDR CSETINFO)
THEN (FOR RTAIL R ON RANGES
JOIN (SETQ R (CAR RTAIL))
(SETQ R (CL:IF (LISTP R)
(LIST (CAR R)
"-"
(CDR R))
(CONS R)))
(CL:IF (CDR RTAIL)
(NCONC1 R ","))
R)
ELSE (LIST (CADAR CSETINFO)
"="
(CADDAR CSETINFO]
'DIRECTORY
(CAR UNICODEDIRECTORIES)
'EXTENSION
'TXT])
)
(DEFINEQ
(XCCS-UTF8-AFTER-OPEN
[LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 3-Jan-2024 10:27 by rmk")
(* ; "Edited 13-Aug-2020 11:54 by rmk:")
(* ;;
 "If added to STREAM-AFTER-OPEN-FNS, causes mapping files to be opened as UTF-8. For development")
(CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM)))
[EQ 'TXT (U-CASE (FILENAMEFIELD (FULLNAME STREAM)
'EXTENSION]
(NOT (ASSOC 'EXTERNALFORMAT PARAMETERS)))
(STREAMPROP STREAM 'EXTERNALFORMAT :UTF-8))])
)
(* ;; "Automate dumping of a documentation prefix")
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(RPAQ MISSINGCODE (CL:PARSE-INTEGER "FFFE" :RADIX 16))
(RPAQ UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF" :RADIX 16))
(CONSTANTS (MISSINGCODE (CL:PARSE-INTEGER "FFFE" :RADIX 16))
(UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF" :RADIX 16)))
)
)
(RPAQQ UNICODE-MAPPING-HEADER
("" " Name: XCCS (Version 2.0) to Unicode" " Unicode version: 3.0"
XCCSCHARACTERSETS " Table version: 0.1" " Table format: Format A"
DATE " Author: Ron Kaplan <Ron.Kaplan@post.harvard.edu>" ""
"This file contains mappings from the Xerox Character Code Standard (version"
"2.0, 1990) into Unicode 3.0. standard codes. That is an extension of the"
"version of XCCS corresponding to the fonts in the Medley system." ""
"The format of this file conforms to the format of the other Unicode-supplied"
"mapping files:" " Three white-space (tab or spaces) separated columns:"
" Column 1 is the XCCS code (as hex 0xXXXX)"
" Column 2 is the corresponding Unicode (as hex 0xXXXX)"
" Column 3 (after #) is a comment column. For convenience, it contains the"
" Unicode character itself and the Unicode character names when available."
"Unicode FFFF is used for undefined XCCS codes (Column 3 = UNDEFINED"
"Unicode FFFE is used for XCCS codes that have not yet been filled in."
"(Column 3 = MISSING)" "" "This file is encoded in UTF-8, so that the Unicode characters"
"are properly displayed in Column 3 and can be edited by standard"
"Unicode-enabled editors (e.g. Mac Textedit)." ""
"This file can also be read by the function"
"READ-UNICODE-MAPPING in the UNICODE Medley library package." ""
"The entries are in XCCS order and grouped by character sets. In front of"
"the mappings, for convenience, there is a line with the octal XCCS"
"character set, after #." ""
"Note that a given XCCS code might map to codes in several different Unicode"
"positions, since there are repetitions in the Unicode standard." ""
"For more details, see the associated README.TXT file." ""
"Any comments or problems, contact <ron.kaplan@post.harvard.edu>"))
(DEFINEQ
(UTF8HEXSTRING
[LAMBDA (CHARCODE) (* ; "Edited 10-Aug-2020 08:33 by rmk:")
(* ;; "Utility to produces the UTF8 hexstring representing CODE")
(HEXSTRING (IF (ILESSP CHARCODE 128)
THEN CHARCODE
ELSEIF (ILESSP CHARCODE 2048)
THEN (* ; "x800")
(LOGOR (LLSH (LOGOR (LLSH 3 6)
(LRSH CHARCODE 6))
8)
(LOGOR (LLSH 2 6)
(LOADBYTE CHARCODE 0 6)))
ELSEIF (ILESSP CHARCODE 65536)
THEN (* ; "x10000")
(LOGOR (LLSH (LOGOR (LLSH 7 5)
(LRSH CHARCODE 12))
16)
(LLSH (LOGOR (LLSH 2 6)
(LOADBYTE CHARCODE 6 6))
8)
(LOGOR (LLSH 2 6)
(LOADBYTE CHARCODE 0 6)))
ELSEIF (ILESSP CHARCODE 2097152)
THEN (* ; "x200000")
(LOGOR (LLSH (LOGOR (LLSH 15 4)
(LRSH CHARCODE 18))
24)
(LLSH (LOGOR (LLSH 2 6)
(LOADBYTE CHARCODE 12 6))
16)
(LLSH (LOGOR (LLSH 2 6)
(LOADBYTE CHARCODE 6 6))
8)
(LOGOR (LLSH 2 6)
(LOADBYTE CHARCODE 0 6)))
ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE])
)
(* ; "debugging")
(DEFINEQ
(SHOWCHARS
[LAMBDA (FONT FROMCHAR TOCHAR ONELINE) (* ; "Edited 5-Oct-2025 17:41 by rmk")
(* ; "Edited 7-Sep-2025 20:29 by rmk")
(* ; "Edited 2-Sep-2025 10:26 by rmk")
(* ; "Edited 24-Jul-2025 11:30 by rmk")
(* ; "Edited 8-Jun-2025 20:05 by rmk")
(* ; "Edited 26-Jan-2024 14:18 by mth")
(* ; "Edited 1-Aug-2020 09:27 by rmk:")
[SETQ FONT (FONTCREATE (OR FONT '(CLASSIC 12]
(RESETLST
[LET ((OLDFONT (DSPFONT NIL T))
CHARS)
(CL:UNLESS (CHARCODEP FROMCHAR)
(SETQ FROMCHAR (OR (CHARCODE.DECODE FROMCHAR T)
FROMCHAR)))
(SETQ CHARS (if (LISTP FROMCHAR)
elseif (CHARCODEP FROMCHAR)
then (CL:UNLESS (CHARCODEP TOCHAR)
(SETQ TOCHAR (OR (CHARCODE.DECODE TOCHAR)
FROMCHAR)))
(for C from FROMCHAR to TOCHAR collect C)
else (CHCON FROMCHAR)))
[RESETSAVE OLDFONT '(PROGN (DSPFONT OLDVALUE]
(TERPRI)
(for C in CHARS do (PRINTOUT T .FONT OLDFONT (CONCAT (OCTALSTRING (\CHARSET C))
","
(OCTALSTRING (\CHAR8CODE C)))
10 .FONT FONT (CHARACTER C))
(CL:UNLESS ONELINE (PRINTOUT T T])
(TERPRI])
)
(DECLARE%: DOEVAL@LOAD DONTCOPY
(DECLARE%: EVAL@COMPILE
(PUTPROPS HEXCHAR MACRO ((CODE)
(HEXSTRING CODE)))
(PUTPROPS OCTALCHAR MACRO [(CODE)
(CONCAT (OCTALSTRING (\CHARSET CODE))
","
(OCTALSTRING (LOGAND CODE 255])
)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
@@ -563,9 +793,12 @@
UNICODE-EXPORTS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3341 12542 (READ-UNICODE-MAPPING-FILENAMES 3351 . 8301) (READ-UNICODE-MAPPING 8303 .
12540)) (12609 26839 (MAKE-UNICODE-TRANSLATION-TABLES 12619 . 16379) (XCCSTOMCCS-MAPPING 16381 . 17598
) (MERGE-UNICODE-TRANSLATION-TABLES 17600 . 20253) (UNICODE.UNMAPPED 20255 . 23579) (
UNICODE-EXTEND-TRANSLATION? 23581 . 26837)) (26840 33676 (ALL-UNICODE-MAPPINGS 26850 . 32339) (
XCCSJAPANESECHARSETS 32341 . 33674)))))
(FILEMAP (NIL (4107 12829 (READ-UNICODE-MAPPING-FILENAMES 4117 . 8586) (READ-UNICODE-MAPPING 8588 .
12827)) (12896 19704 (MAKE-UNICODE-TRANSLATION-TABLES 12906 . 15666) (GET-MCCS-UNICODE-MAPPING 15668
. 16688) (INVERT-UNICODE-MAPPING 16690 . 18483) (XCCSTOMCCS-MAPPING 18485 . 19702)) (19705 26328 (
ALL-UNICODE-MAPPINGS 19715 . 24991) (XCCSJAPANESECHARSETS 24993 . 26326)) (26373 37135 (
WRITE-UNICODE-MAPPING 26383 . 30127) (WRITE-UNICODE-INCLUDED 30129 . 34441) (
WRITE-UNICODE-MAPPING-HEADER 34443 . 35691) (WRITE-UNICODE-MAPPING-FILENAME 35693 . 37133)) (37136
37812 (XCCS-UTF8-AFTER-OPEN 37146 . 37810)) (40337 42426 (UTF8HEXSTRING 40347 . 42424)) (42453 44495 (
SHOWCHARS 42463 . 44493)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,14 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Sep-2025 12:06:52" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;14 14825
(FILECREATED " 5-Feb-2026 18:38:23" {WMEDLEY}<library>UNIXCOMM.;15 14717
:EDIT-BY rmk
:CHANGES-TO (FNS FORK-UNIX)
:PREVIOUS-DATE "29-Apr-2025 22:45:47"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;13)
:PREVIOUS-DATE " 2-Sep-2025 12:06:52" {WMEDLEY}<library>UNIXCOMM.;14)
(PRETTYCOMPRINT UNIXCOMMCOMS)
@@ -74,13 +72,11 @@
else (SUBRCALL UNIX-HANDLECOMM 4])
(FORK-UNIX
[LAMBDA (STR) (* ; "Edited 2-Sep-2025 12:03 by rmk")
[LAMBDA (STR) (* ; "Edited 5-Feb-2026 18:38 by rmk")
(* ; "Edited 2-Sep-2025 12:03 by rmk")
(* ; "Edited 29-Apr-2025 22:45 by rmk")
(* ; "Edited 25-May-88 15:47 by drc:")
(* ;; "MTOUBYTES converts MCCS codes to Unicodes, and then lays out the bytes of the UTF-8 encoding of those characters. ")
(SUBRCALL UNIX-HANDLECOMM 0 (MTOUTF8STRING (\DTEST STR 'ONED-ARRAY])
(SUBRCALL UNIX-HANDLECOMM 0 (MTOSYSSTRING (\DTEST STR 'ONED-ARRAY])
(UNIX-KILL
[LAMBDA (CONN) (* ; "Edited 25-May-88 16:04 by drc:")
@@ -321,10 +317,10 @@
(PUTPROPS UNIXCOMM FILETYPE COMPILE-FILE)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1903 7339 (FORK-SHELL 1913 . 3110) (FORK-UNIX 3112 . 3659) (UNIX-KILL 3661 . 3850) (
UNIX-WRITE 3852 . 4563) (CREATE-SHELL-STREAM 4565 . 5449) (CREATE-PROCESS-STREAM 5451 . 6290) (
UNIXCOMM-AROUNDEXITFN 6292 . 7337)) (7387 12578 (INITIALIZE-SHELL-DEVICE 7397 . 8825) (
UNIX-GET-NEXT-BUFFER 8827 . 11027) (UNIX-BACKFILEPTR 11029 . 11441) (UNIX-STREAM-EOFP 11443 . 11924) (
UNIX-STREAM-OUT 11926 . 12182) (UNIX-STREAM-CLOSE 12184 . 12576)) (12826 14532 (
CREATE-UNIX-SOCKET-STREAM 12836 . 13642) (ACCEPT-UNIX-SOCKET-STREAM 13644 . 14530)))))
(FILEMAP (NIL (1821 7231 (FORK-SHELL 1831 . 3028) (FORK-UNIX 3030 . 3551) (UNIX-KILL 3553 . 3742) (
UNIX-WRITE 3744 . 4455) (CREATE-SHELL-STREAM 4457 . 5341) (CREATE-PROCESS-STREAM 5343 . 6182) (
UNIXCOMM-AROUNDEXITFN 6184 . 7229)) (7279 12470 (INITIALIZE-SHELL-DEVICE 7289 . 8717) (
UNIX-GET-NEXT-BUFFER 8719 . 10919) (UNIX-BACKFILEPTR 10921 . 11333) (UNIX-STREAM-EOFP 11335 . 11816) (
UNIX-STREAM-OUT 11818 . 12074) (UNIX-STREAM-CLOSE 12076 . 12468)) (12718 14424 (
CREATE-UNIX-SOCKET-STREAM 12728 . 13534) (ACCEPT-UNIX-SOCKET-STREAM 13536 . 14422)))))
STOP

BIN
library/UNIXCOMM.DFASL Normal file

Binary file not shown.

View File

@@ -1,33 +1,26 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jan-2023 22:44:05" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;4 13651
(FILECREATED " 5-Feb-2026 18:37:09" {WMEDLEY}<library>UNIXPRINT.;17 11663
:CHANGES-TO (VARS UNIXPRINTCOMS)
:EDIT-BY rmk
:PREVIOUS-DATE "18-Jan-2023 13:28:36" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;3
)
:CHANGES-TO (FNS UnixShellQuote)
:PREVIOUS-DATE "25-Jan-2026 11:09:09" {WMEDLEY}<library>UNIXPRINT.;15)
(* ; "
Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
")
(PRETTYCOMPRINT UNIXPRINTCOMS)
(RPAQQ UNIXPRINTCOMS
[(FILES UNIXUTILS)
(FNS InstallUnixPrinter UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
(FNS UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
(ALISTS (PRINTERTYPES (UNIX)))
(INITVARS (UnixPrinterName NIL)
(UNIXPRINTSWITCHES " -r -s "))
(P
(* ;;
 "(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform")
(PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW))
(P (PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW))
(PROP FILETYPE UNIXPRINT)
(DECLARE%: DONTEVAL@COMPILE DOCOPY (FNS UnixPrintCommand))
(DECLARE%: EVAL@COMPILE DOCOPY (FILES UNIXCOMM))
(DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS UnixPrinterName))
(GLOBALVARS UnixPrinterName)
(DECLARE%: EVAL@COMPILE (FILES UNIXCOMM))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
@@ -35,39 +28,33 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
(FILESLOAD UNIXUTILS)
(DEFINEQ
(InstallUnixPrinter
[LAMBDA (PrinterTypes) (* ; "Edited 8-Feb-97 11:33 by rmk:")
(* ;; "Set up any printers in PrinterTypes (or just Postscript by default) so that they'll be printed using the unix LPR command.")
(DECLARE (GLOBALVARS PRINTERTYPES))
(for type inside (OR PrinterTypes '(POSTSCRIPT))
do (for x in PRINTERTYPES when (EQMEMB type (CAR x))
do (LET ((PRINTERTYPE type))
(PUTASSOC 'SEND (LIST 'UnixPrint)
(CDR x])
(UnixPrint
[LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 7-Dec-2001 14:55 by rmk:")
[LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 25-Jan-2026 11:08 by rmk")
(* ; "Edited 17-Jan-2026 15:47 by rmk")
(* ; "Edited 5-Dec-2025 11:46 by rmk")
(* ; "Edited 13-Sep-2025 20:28 by rmk")
(* ; "Edited 11-Sep-2025 20:48 by rmk")
(* ; "Edited 7-Dec-2001 14:55 by rmk:")
(* ; "Edited 20-May-92 14:13 by nilsson")
(* ;; "Given a print FILE, use the Unix %"lpr%" command to spool it to a printer.")
(* ;; "")
(* ;; "The printer is named by HOST or UnixPrinterName, a Global variable.")
[LET*
((PRINTER (OR HOST UnixPrinterName))
((PRINTER (SELECTQ HOST
((NIL UNIX)
UnixPrinterName)
HOST))
(COPIES (LISTGET PRINTOPTIONS '%#COPIES))
(NAME (LISTGET PRINTOPTIONS 'DOCUMENT.NAME))
(NSIDES (LISTGET PRINTOPTIONS '%#SIDES))
(TYPE (PRINTERTYPE PRINTER)))
(* ;; "Removed redundant check (we already know it's a PS printer), JDS 2/19/92:")
(* ;; "(COND ((NULL TYPE) (ERROR (CONCAT %"Printertype unknown for %" PRINTER))) ((NOT (EQL (U-CASE TYPE) 'POSTSCRIPT)) (ERROR (CONCAT %"Printertype for %" PRINTER %" is not Postscript%"))))")
[COND
((OR (NULL NAME)
(EQ NAME 'LPT)
(STRPOS "{LPT}" NAME 1 NIL T))
(SETQ NAME "Medley Output"))
((EQ (CHCON1 NAME)
@@ -88,63 +75,64 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
(* ;; "The temp file's name will be of the form medleyprint.<idate>, so all such files can be found for deletion on a subsequent call after a certain amount of time (2 minutes) has gone by. If we delete immediately, it may happen before lpr has done its thing. ")
(CL:MULTIPLE-VALUE-BIND (tmpstream tmpname)
(UnixTempFile 'medleyprint.)
(COND
(tmpstream
(CL:MULTIPLE-VALUE-BIND
(tmpstream tmpname)
(UnixTempFile 'medleyprint.)
(COND
(tmpstream
(* ;; "First, copy the lisp file to /tmp so lpr can find it.")
(* ;; "First, copy the lisp file to /tmp so lpr can find it.")
[CL:WITH-OPEN-STREAM
(out tmpstream)
(CL:WITH-OPEN-STREAM
(in (OPENSTREAM FILE 'INPUT))
(printout PROMPTWINDOW .TAB0 0 "Spooling output to Unix printer"
(COND
(PRINTER (CONCAT " '" PRINTER "'"))
(T ""))
"...")
(IF NSIDES
THEN
(* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")
[CL:WITH-OPEN-STREAM
(out tmpstream)
(CL:WITH-OPEN-STREAM
(in (OPENSTREAM FILE 'INPUT))
(printout PROMPTWINDOW .TAB0 0 "Sending output to Unix printer " (OR PRINTER "")
" ")
(IF NSIDES
THEN
(* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")
(BIND C SAWCR
DO (SETQ C (BIN in))
(IF (MEMB C (CHARCODE (CR LF)))
THEN (BOUT out C)
(SETQ SAWCR T)
ELSEIF SAWCR
THEN
(* ;; "First char of 2nd line: nonCR/LF after CR/LF")
(BIND C SAWCR
DO (SETQ C (BIN in))
(IF (MEMB C (CHARCODE (CR LF)))
THEN (BOUT out C)
(SETQ SAWCR T)
ELSEIF SAWCR
THEN
(* ;; "First char of 2nd line: nonCR/LF after CR/LF")
(* ;; "Put out simplex header, then print character in C")
(* ;; "Put out simplex header, then print character in C")
(PRINTOUT out "%%BeginSetup" T)
(PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T
"<< /Duplex " (CL:IF (EQ NSIDES 1)
"false"
"true")
" /Tumble false >> setpagedevice" T
"%%%%EndFeature" T "} stopped cleartomark" T)
(PRINTOUT out "%%EndSetup" T)
(BOUT out C)
(COPYCHARS in out (GETFILEPTR in)
-1)
(RETURN)
ELSE (BOUT out C)))
ELSE (COPYCHARS in out 0 -1]
(PRINTOUT out "%%BeginSetup" T)
(PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T
"<< /Duplex " (CL:IF (EQ NSIDES 1)
"false"
"true")
" /Tumble false >> setpagedevice" T "%%%%EndFeature"
T "} stopped cleartomark" T)
(PRINTOUT out "%%EndSetup" T)
(BOUT out C)
(COPYCHARS in out (GETFILEPTR in)
-1)
(RETURN)
ELSE (BOUT out C)))
ELSE (COPYCHARS in out 0 -1]
(* ;; "Now make Unix print the /tmp file.")
(* ;; "Now make Unix print the /tmp file.")
(ShellCommand (UnixPrintCommand PRINTER COPIES NAME tmpname)
PROMPTWINDOW)
(printout PROMPTWINDOW "done" T))
(T (ERROR "Couldn't create unix temp file"))))]
(ShellCommand (UnixPrintCommand PRINTER COPIES NAME tmpname)
PROMPTWINDOW)
(CL:WHEN NIL (* ; "This should be conditioned an error code--don't want to say %"done%" if it didn't happen. If we put this back, then put in ... in the Sending printout above")
(printout PROMPTWINDOW "done" T)))
(T (ERROR "Couldn't create unix temp file"]
T])
(UnixShellQuote
[LAMBDA (STRING)
(DECLARE (LOCALVARS . T)) (* ; "Edited 19-Apr-89 21:14 by TAL")
(DECLARE (LOCALVARS . T)) (* ; "Edited 5-Feb-2026 18:37 by rmk")
(* ; "Edited 18-Jan-2026 08:34 by rmk")
(* ; "Edited 19-Apr-89 21:14 by TAL")
(LET* ((X (CHCON STRING))
(CT X)
C FLG)
@@ -168,9 +156,9 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
(CHARCODE SPACE))
(T C))
(SETQ CT (CDR CT]
(COND
(FLG (CONCATCODES X))
(T STRING])
(MTOSYSSTRING (CL:IF FLG
(CONCATCODES X)
STRING)])
(UnixTempFile
[LAMBDA (Prefix DontOpen) (* ; "Edited 28-Apr-93 13:49 by rmk:")
@@ -234,66 +222,26 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
" " TMPNAME])
)
(ADDTOVAR PRINTERTYPES ((UNIX)
(CANPRINT (PDF))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND UnixPrint)))
(RPAQ? UnixPrinterName NIL)
(RPAQ? UNIXPRINTSWITCHES " -r -s ")
(* ;; "(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform")
(PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW)
(PUTPROPS UNIXPRINT FILETYPE :COMPILE-FILE)
(DECLARE%: DONTEVAL@COMPILE DOCOPY
(DEFINEQ
(UnixPrintCommand
[LAMBDA (PRINTER COPIES NAME TMPNAME) (* ; "Edited 4-May-2018 17:17 by rmk:")
(* ; "Edited 20-May-92 14:26 by nilsson")
(* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr tmpname%". The arguments to this function are:")
(* ;; " PRINTER - the name of the printer. Usually something like lw or plw.")
(* ;; "COPIES - how many copies of this job to be printed.")
(* ;; "NAME - the name of this job. This gets printed on the banner of your job.")
(* ;; "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")
(* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")
(* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")
(* ;; "Use raw lpr, let system decide where it is located.")
(CONCAT "lpr " (COND
((AND PRINTER (NEQ 0 (NCHARS PRINTER)))
(CONCAT "-P" (UnixShellQuote PRINTER)
" "))
(T ""))
(COND
((AND (FIXP COPIES)
(NEQ COPIES 1))
(CONCAT "-#" COPIES " "))
(T ""))
" -J"
(UnixShellQuote NAME)
" "
(OR UNIXPRINTSWITCHES "")
" " TMPNAME])
)
)
(DECLARE%: EVAL@COMPILE DOCOPY
(FILESLOAD UNIXCOMM)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS UnixPrinterName)
)
(DECLARE%: EVAL@COMPILE
(FILESLOAD UNIXCOMM)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -303,9 +251,7 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
(ADDTOVAR LAMA )
)
(PUTPROPS UNIXPRINT COPYRIGHT ("Venue" 1990 1991 1992 1993 1995 1997 1999 2001 2018 2023))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1389 11216 (InstallUnixPrinter 1399 . 1991) (UnixPrint 1993 . 6875) (UnixShellQuote
6877 . 8306) (UnixTempFile 8308 . 9531) (UnixPrintCommand 9533 . 11214)) (11550 13243 (
UnixPrintCommand 11560 . 13241)))))
(FILEMAP (NIL (1051 10997 (UnixPrint 1061 . 6397) (UnixShellQuote 6399 . 8087) (UnixTempFile 8089 .
9312) (UnixPrintCommand 9314 . 10995)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Nov-2025 14:21:13" {WMEDLEY}<library>UNIXUTILS.;35 18084
(FILECREATED "19-Jan-2026 14:09:03" {WMEDLEY}<library>UNIXUTILS.;55 20711
:EDIT-BY rmk
:CHANGES-TO (VARS UNIXUTILSCOMS)
:CHANGES-TO (FNS UNIX-FILE-NAME)
:PREVIOUS-DATE " 4-Nov-2025 10:11:10" {WMEDLEY}<library>UNIXUTILS.;34)
:PREVIOUS-DATE "17-Jan-2026 23:16:17" {WMEDLEY}<library>UNIXUTILS.;54)
(PRETTYCOMPRINT UNIXUTILSCOMS)
@@ -21,7 +21,8 @@
(FUNCTIONS ShellCommand ShellWhich)
(ADDVARS (MEDLEY-INIT-VARS (ShellBrowser NIL RESET)
(ShellOpener NIL RESET)))
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME)
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME
UNIX-TMP-FILE-NAME)
(PROPS (UNIXUTILS FILETYPE))))
(DECLARE%: EVAL@COMPILE DONTCOPY
@@ -147,7 +148,8 @@
"true"])
(ShellOpen
[LAMBDA (FilenameOrURL) (* ; "Edited 10-Sep-2025 15:29 by rmk")
[LAMBDA (FilenameOrURL) (* ; "Edited 28-Dec-2025 18:26 by rmk")
(* ; "Edited 10-Sep-2025 15:29 by rmk")
(* ; "Edited 4-May-2025 11:14 by rmk")
(* ;; "Open the file or URL using the generic %"opener%" for this machine via a shell call.")
@@ -184,7 +186,11 @@
then (CONCAT "File not found: " FilenameOrURL)
elseif (STREQUAL OPENER "true")
then (CONCAT "Unable to find a file opener to open: " FilenameOrURL)
else (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION))
else (SETQ FilenameOrURL (TRUEFILENAME FilenameOrURL))
(* ;; "RMK: UNVERSIONED is in the Lisp space, I removed the SLASHIT there because it adds \ in front of spaces which screws up the following INFILEP.")
(LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION))
(UNPACKED (UNPACKFILENAME.STRING FULLNAME))
(NEWNAME (CONCAT (LISTGET UNPACKED 'NAME)
"~"
@@ -197,8 +203,7 @@
(SETQ FN (PACKFILENAME.STRING UNPACKED))
(if (STREQUAL (SUBSTRING FN -1)
".")
then (SETQ FN (SUBSTRING UNIXFILE 1 -2)))
(SETQ FN (SLASHIT FN]
then (SETQ FN (SUBSTRING UNIXFILE 1 -2]
(UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED)))
(TMPDIR (CONCAT "/tmp/" (RAND 1000 9999)))
(TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR
@@ -240,7 +245,8 @@
0))) DO (BLOCK) FINALLY (RETURN CODE])
(SLASHIT
[LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 4-Nov-2025 10:10 by rmk")
[LAMBDA (X LCASEDIRS NOHOST KEEPDOT) (* ; "Edited 17-Jan-2026 23:15 by rmk")
(* ; "Edited 4-Nov-2025 10:10 by rmk")
(* ; "Edited 22-Oct-2025 13:05 by rmk")
(* ; "Edited 25-Sep-2025 09:57 by rmk")
(* ; "Edited 23-Sep-2023 15:27 by rmk")
@@ -249,7 +255,7 @@
(* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.")
(* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ")
(* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, perhaps lower-casing the directory, and perhaps removing a final dot. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ")
(LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
0]
@@ -267,22 +273,34 @@
(SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS))
(OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS))
""))))
(CL:IF (OR (EQ DIRPOS 1)
NOHOST)
SLASHED
(CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
SLASHED))])
(CL:UNLESS (OR (EQ DIRPOS 1)
NOHOST)
(SETQ SLASHED (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
SLASHED)))
(CL:UNLESS (OR KEEPDOT (NEQ (CHARCODE %.)
(NTHCHARCODE SLASHED -1)))
(SETQ SLASHED (CL:IF (EQ (CHARCODE %')
(NTHCHARCODE SLASHED -2))
(CONCAT (SUBSTRING SLASHED 1 -3)
".")
(SUBSTRING SLASHED 1 -2))))
SLASHED])
(UNIX-FILE-NAME
[LAMBDA (FILE ACCESS COPY) (* ; "Edited 27-Sep-2025 16:24 by rmk")
[LAMBDA (FILE ACCESS COPY EXTENSION) (* ; "Edited 19-Jan-2026 14:05 by rmk")
(* ; "Edited 17-Jan-2026 22:32 by rmk")
(* ; "Edited 11-Jan-2026 23:54 by rmk")
(* ; "Edited 27-Dec-2025 21:24 by rmk")
(* ; "Edited 26-Dec-2025 10:58 by rmk")
(* ; "Edited 27-Sep-2025 16:24 by rmk")
(* ; "Edited 19-Sep-2025 07:29 by rmk")
(* ; "Edited 13-Sep-2025 18:37 by rmk")
(* ; "Edited 1-Oct-2023 20:52 by rmk")
(* ;; "Forces an extension %"ufn%" if there isn't one already, to avoid the dot/no-dot question")
(* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file doesn't have the Medley version convention. If FILE does not have a corresponding Unix name (e.g. NODIRCORE), COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.")
(* ;; "NOTE: The value does not have a host field--no {UNIX}.")
(* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.")
(* ; "Might catch NODIRCORE")
(CL:WHEN FILE
(SETQ FILE (TRUEFILENAME FILE))
(CL:UNLESS (STREAMP FILE)
@@ -292,42 +310,58 @@
(NIL (SETQ ACCESS 'INPUT)
'OLD)
(\ILLEGAL.ARG ACCESS])
(LET (UNAME VERSION)
[SELECTQ (FILENAMEFIELD FILE 'HOST)
((UNIX DSK)
(SETQ UNAME FILE))
(PROGN
(* ;; "Catch the streams as well as other devices (CORE, servers)")
[SLASHIT (SELECTQ (FILENAMEFIELD FILE 'HOST)
(UNIX (CL:IF [AND EXTENSION (NEQ (L-CASE EXTENSION)
(L-CASE (FILENAMEFIELD FILE 'EXTENSION]
(COPYFILE FILE (PACKFILENAME 'EXTENSION EXTENSION 'BODY FILE))
FILE))
(DSK [LET ((VERSION (FILENAMEFIELD FILE 'VERSION))
(UNAME (PACKFILENAME 'VERSION NIL 'BODY FILE)))
(CL:UNLESS (EQ VERSION 1)
(CONCAT UNAME (CONCAT "~" VERSION "~")))])
(LET (UNAME)
[SETQ UNAME (OUTFILEP (CONCAT "{DSK}/tmp/medley-" (CL:IF COPY
(CONCAT (L-CASE COPY)
"-")
"")
(IDATE]
(CL:WHEN (AND COPY FILE)
(RESETLST
(CL:WHEN (\GETSTREAM FILE 'INPUT T)
(* ;; "Catch the streams as well as other devices (CORE, servers)")
(SETQ UNAME (UNIX-TMP-FILE-NAME FILE EXTENSION))
(CL:IF (AND COPY FILE)
(RESETLST
(CL:WHEN (\GETSTREAM FILE 'INPUT T)
(* ; "Hope it's randaccess")
[RESETSAVE (GETFILEPTR FILE)
`(PROGN (SETFILEPTR ,FILE OLDVALUE])
[RESETSAVE (GETFILEPTR FILE)
`(PROGN (SETFILEPTR ,FILE OLDVALUE])
(COPYFILE FILE UNAME))
UNAME)])])
(* ;; "Let DSK pick a new version number, rather than RAND")
(UNIX-TMP-FILE-NAME
[LAMBDA (NAME EXT HOST) (* ; "Edited 17-Jan-2026 22:28 by rmk")
(* ; "Edited 13-Jan-2026 15:41 by rmk")
(* ; "Edited 26-Dec-2025 17:37 by rmk")
(COPYFILE FILE UNAME)))]
(SETQ VERSION (FILENAMEFIELD UNAME 'VERSION)) (* ; "Convert to Unix version. ")
(SETQ UNAME (PACKFILENAME 'VERSION NIL 'BODY UNAME))
(CL:WHEN (AND VERSION (IGREATERP VERSION 1))
(SETQ UNAME (CONCAT UNAME ".~" VERSION "~")))
(SETQ UNAME (SLASHIT UNAME NIL T))
(CL:IF (EQ (CHARCODE %.)
(NTHCHARCODE UNAME -1))
(SUBSTRING UNAME 1 -2)
UNAME)))])
(* ;; "Returns a unique {UNIX}/tmp/medley name that includes NAME as a hint and perhaps a useful extension. This goes through random candidates hoping to find a name that doesn't yet exist, and that can be %"reserved%" before anybody else gets it. There is a race-condition window where somebody could get in.")
(* ;; " ")
(* ;; "If DSK names were reformatted so that the ~version~ came before the intended extension, we could just open on an output stream on DSK to get a unique version number, then convert to the UNIX formatted string.")
(bind UNAME (DATEPREFIX _ (CONCAT "{UNIX}/tmp/medley-" (IDATE)
"-"))
(SUFFIX _ (CONCAT (CL:IF NAME
[OR (AND (STREAMP (FULLNAME NAME))
"stream")
(L-CASE (FILENAMEFIELD NAME 'NAME]
"unamed")
(CL:IF EXT
(CONCAT "." (L-CASE EXT))
""))) eachtime (SETQ UNAME (CONCAT DATEPREFIX (RAND 1 1000)
"-" SUFFIX))
unless (INFILEP UNAME) do (RETURN (SLASHIT (CLOSEF (OPENSTREAM UNAME 'OUTPUT 'NEW])
)
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1137 1510 (ShellCommand 1137 . 1510)) (1512 1909 (ShellWhich 1512 . 1909)) (2019 18006
(ShellBrowser 2029 . 3801) (ShellBrowse 3803 . 4488) (ShellOpener 4490 . 6178) (ShellOpen 6180 . 11659
) (PROCESS-COMMAND 11661 . 12274) (SLASHIT 12276 . 14731) (UNIX-FILE-NAME 14733 . 18004)))))
(FILEMAP (NIL (1170 1543 (ShellCommand 1170 . 1543)) (1545 1942 (ShellWhich 1545 . 1942)) (2052 20633
(ShellBrowser 2062 . 3834) (ShellBrowse 3836 . 4521) (ShellOpener 4523 . 6211) (ShellOpen 6213 . 11982
) (PROCESS-COMMAND 11984 . 12597) (SLASHIT 12599 . 15623) (UNIX-FILE-NAME 15625 . 18952) (
UNIX-TMP-FILE-NAME 18954 . 20631)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "15-Feb-2025 14:11:54" {WMEDLEY}<library>lafite>LAFITE-INDENT.;4 26926
(FILECREATED "18-Feb-2026 15:47:08" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;2 26210
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT-INDENT-BREAK-LONG-LINES TEDIT-INDENT-SELECTION TEDIT-OPEN-LINE
TEDIT-MAKE-LINES-EXPLICIT TEDIT-INDENT-SET-INDENT)
:PREVIOUS-DATE "15-Feb-2025 09:21:58" {WMEDLEY}<library>lafite>LAFITE-INDENT.;3)
:PREVIOUS-DATE "22-Jan-87 01:34:36" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;1)
(PRETTYCOMPRINT LAFITE-INDENTCOMS)
@@ -133,10 +130,14 @@
max-length max-length])
(TEDIT-INDENT-BREAK-LONG-LINES
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
(* smL "21-Jan-87 16:03")
(* ;;; "Break the current selection into explicit lines, each having no more than *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:03")
(* * Break the current selection into explicit lines, each having no more than
 *TEDIT-INDENT-LINE-LENGTH* characters. -
 If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
 the current selection are removed. -
 This is intended to be used in Lafite, where one wants to indent a piece of a
 forwarded document, but can be used in any TEdit document)
(LET ((selection (TEDIT.GETSEL text-stream)))
(TEDIT-INDENT-REPLACE-SELECTION
@@ -144,13 +145,11 @@
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
text-stream selection)
explicit-paragraph-breaks?)
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
LCHAR1)
(TEDIT.SELPROP selection 'CH#]
(DIFFERENCE (TEDIT.SELPROP selection
'CH#)
(GETLD (CAR (GETSEL selection L1))
LCHAR1]
bind [hanging-indent _
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
(fetch CH# of selection)))
(DIFFERENCE (fetch CH# of selection)
(fetch CHAR1 of (CAR (fetch L1 of selection]
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
"" *TEDIT-INDENT-LINE-LENGTH* hanging-indent)
*eol-string*)
@@ -185,10 +184,15 @@
'RIGHT])
(TEDIT-INDENT-SELECTION
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
(* smL "21-Jan-87 16:00")
(* ;;; "Indent the current selection by prefacing each line with the value of *TEDIT-INDENT-STRING*, and inserting line breaks after each *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:00")
(* * Indent the current selection by prefacing each line with the value of
 *TEDIT-INDENT-STRING*, and inserting line breaks after each
 *TEDIT-INDENT-LINE-LENGTH* characters. -
 If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
 the current selection are removed. -
 This is intended to be used in Lafite, where one wants to indent a piece of a
 forwarded document, but can be used in any TEdit document)
(LET ((selection (TEDIT.GETSEL text-stream)))
(TEDIT-INDENT-REPLACE-SELECTION
@@ -196,13 +200,11 @@
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
text-stream selection)
explicit-paragraph-breaks?)
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
LCHAR1)
(TEDIT.SELPROP selection 'CH#]
(DIFFERENCE (TEDIT.SELPROP selection
'CH#)
(GETLD (CAR (GETSEL selection L1))
LCHAR1]
bind [hanging-indent _
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
(fetch CH# of selection)))
(DIFFERENCE (fetch CH# of selection)
(fetch CHAR1 of (CAR (fetch L1 of selection]
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
*TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*
hanging-indent)
@@ -232,19 +234,18 @@
else (\TEDIT-INDENT-SEPERATE-PARAGRAPHS string NIL])
(TEDIT-INDENT-SET-INDENT
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:21 by rmk")
(* smL "12-Sep-86 17:09")
[LAMBDA (text-stream) (* smL "12-Sep-86 17:09")
(* * Prompt the user for a new indentation string)
(* ;;; "Prompt the user for a new indentation string")
(LET* ((window (\TEDIT.PRIMARYPANE text-stream))
(LET* ((window (fetch \WINDOW of (TEXTOBJ text-stream)))
(pwindow (if window
then (GETPROMPTWINDOW (if (LISTP window)
then (CAR window)
else window))
else PROMPTWINDOW)))
(CLEARW pwindow)
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
pwindow NIL NIL (LIST (CHARCODE EOL])
(TEDIT-INDENT-STRIP-INDENTATION
@@ -269,34 +270,36 @@
else string])
(TEDIT-MAKE-LINES-EXPLICIT
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:20 by rmk")
(* smL " 8-Sep-86 18:20")
(* ;;; "Take the current selection and replace all TEdit end-of-lines with explicit line breaks. --- This is intended to be used in Lafite, where it is sometimes nice to know that anyone receiving the msg will see the same line breaks that you see. see, but can be used in any TEdit document")
[LAMBDA (text-stream) (* smL " 8-Sep-86 18:20")
(* * Take the current selection and replace all TEdit end-of-lines with
 explicit line breaks. -
 This is intended to be used in Lafite, where it is sometimes nice to know that
 anyone receiving the msg will see the same line breaks that you see.
 see, but can be used in any TEdit document)
(LET ((selection (TEDIT.GETSEL text-stream)))
[for i in (bind (this-line _ (CAR (GETSEL selection L1)))
[last-line _ (CAR (LAST (GETSEL selection LN]
repeatuntil (PROGN (SETQ this-line (GETLD this-line NEXTLINE))
(EQ this-line last-line)) collect (GETLD this-line LCHARLIM)
) do (TEDIT.SETSEL text-stream i 1 'LEFT T)
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
[for i in (bind (this-line _ (CAR (fetch L1 of selection)))
[last-line _ (CAR (LAST (fetch LN of selection]
repeatuntil (PROGN (SETQ this-line (fetch NEXTLINE of this-line))
(EQ this-line last-line)) collect (fetch CHARLIM
of this-line))
do (TEDIT.SETSEL text-stream i 1 'LEFT T)
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
(TEDIT.SETSEL text-stream selection NIL 'RIGHT])
(TEDIT-OPEN-LINE
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 14:09 by rmk")
(* smL "17-Sep-86 11:13")
(* ;;; "Open a new line at the current position.")
[LAMBDA (text-stream) (* smL "17-Sep-86 11:13")
(* * Open a new line at the current position.)
(LET ((selection (TEDIT.GETSEL text-stream)))
(TEDIT.INSERT text-stream (CONCAT *eol-string* (ALLOCSTRING
(DIFFERENCE (TEDIT.SELPROP selection
'CH#)
(GETLD (CAR (GETSEL selection L1))
LCHAR1))
" ")))
(if (ZEROP (TEDIT.SELPROP selection 'LENGTH))
(TEDIT.INSERT text-stream (CONCAT *eol-string*
(ALLOCSTRING [DIFFERENCE (fetch CH# of selection)
(fetch CHAR1
of (CAR (fetch L1 of selection]
" ")))
(if (ZEROP (fetch DCH of selection))
then (TEDIT.SETSEL text-stream selection])
(TEDIT-REMOVE-INDENT
@@ -433,12 +436,12 @@
"Break long lines by inserting explicit <RETURN>'s"
]
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4363 24314 (TEDIT-INDENT-ADD-INDENTATION 4373 . 6941) (TEDIT-INDENT-BREAK-LINE 6943 .
8876) (TEDIT-INDENT-BREAK-LONG-LINES 8878 . 10828) (TEDIT-INDENT-FIND-BREAKPOINT 10830 . 11653) (
TEDIT-INDENT-REPLACE-SELECTION 11655 . 12212) (TEDIT-INDENT-SELECTION 12214 . 14283) (
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 14285 . 14564) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14566 .
15295) (TEDIT-INDENT-SET-INDENT 15297 . 16143) (TEDIT-INDENT-STRIP-INDENTATION 16145 . 17365) (
TEDIT-MAKE-LINES-EXPLICIT 17367 . 18517) (TEDIT-OPEN-LINE 18519 . 19453) (TEDIT-REMOVE-INDENT 19455 .
20225) (\TEDIT-INDENT-COUNT-SPACES 20227 . 20828) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20830 . 21801) (
\TEDIT-INDENT-SEPERATE-LINES 21803 . 22601) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 22603 . 24312)))))
(FILEMAP (NIL (4193 23598 (TEDIT-INDENT-ADD-INDENTATION 4203 . 6771) (TEDIT-INDENT-BREAK-LINE 6773 .
8706) (TEDIT-INDENT-BREAK-LONG-LINES 8708 . 10475) (TEDIT-INDENT-FIND-BREAKPOINT 10477 . 11300) (
TEDIT-INDENT-REPLACE-SELECTION 11302 . 11859) (TEDIT-INDENT-SELECTION 11861 . 13762) (
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 13764 . 14043) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14045 .
14774) (TEDIT-INDENT-SET-INDENT 14776 . 15550) (TEDIT-INDENT-STRIP-INDENTATION 15552 . 16772) (
TEDIT-MAKE-LINES-EXPLICIT 16774 . 17979) (TEDIT-OPEN-LINE 17981 . 18737) (TEDIT-REMOVE-INDENT 18739 .
19509) (\TEDIT-INDENT-COUNT-SPACES 19511 . 20112) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20114 . 21085) (
\TEDIT-INDENT-SEPERATE-LINES 21087 . 21885) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 21887 . 23596)))))
STOP

Binary file not shown.

View File

@@ -1,30 +1,28 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED "19-Jan-87 23:56:51" {ERIS}<LISPUSERS>LISPCORE>LAFITEPRIVATEDL.;1 10080
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
previous date%: "19-Jan-87 23:47:54" {PHYLUM}<LISPUSERS>KOTO>LAFITEPRIVATEDL.;2)
(FILECREATED "18-Feb-2026 15:50:14" {WMEDLEY}<library>lafite>LAFITE-PRIVATEDL.;2 9719
:EDIT-BY rmk
:CHANGES-TO (FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST))
(* "
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITE-PRIVATEDLCOMS)
(PRETTYCOMPRINT LAFITEPRIVATEDLCOMS)
(RPAQQ LAFITEPRIVATEDLCOMS ((* * LAFITEDL.EXT is the default extension for dl files when no extension
is specified)
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after
the connected directory and the LAFITEDEFAULTHOST&DIR in order to
locate a dl file when no host or directory is specified)
(INITVARS (LAFITEDL.EXT 'DL)
(LAFITEDLDIRECTORIES NIL))
(* * no functions are user callable)
(FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
(* Lafite's readtable for parsing addresses needs to have CR as a
SEPRCHAR so that lines from a text file can all be parsed at once.
This has no effect on normal operation since before private dls no CR
was ever passed to the parser)
(P (SETSYNTAX (CHARCODE CR)
'SEPRCHAR ADDRESSPARSERRDTBL))))
(RPAQQ LAFITE-PRIVATEDLCOMS
((* * LAFITEDL.EXT is the default extension for dl files when no extension is specified)
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after the connected
directory and the LAFITEDEFAULTHOST&DIR in order to locate a dl file when no host or
directory is specified)
(INITVARS (LAFITEDL.EXT 'DL)
(LAFITEDLDIRECTORIES NIL))
(* * no functions are user callable)
(FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
(* Lafite's readtable for parsing addresses needs to have CR as a SEPRCHAR so that lines from
a text file can all be parsed at once. This has no effect on normal operation since before
private dls no CR was ever passed to the parser)
(P (SETSYNTAX (CHARCODE CR)
'SEPRCHAR ADDRESSPARSERRDTBL))))
(* * LAFITEDL.EXT is the default extension for dl files when no extension is specified)
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after the connected directory and the
@@ -39,7 +37,7 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(DEFINEQ
(\GV.PARSERECIPIENTS1
[LAMBDA (FIELD REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:44")
[LAMBDA (FIELD REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:44")
(* ;;; "INTERNALFLG = T means produce addresses to give Grapevine; NIL means give human-readable addresses")
@@ -73,8 +71,8 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(CHARCODE %"))
(HELP]
(OR REGISTRY (SETQ REGISTRY DEFAULTREGISTRY))
(* ;; "first just collect all the atoms using a special readtable ")
(* ;; "first just collect all the atoms using a special readtable ")
(SETQ ADDRESSES (when (SETQ ADDR (until (OR (EOFP FIELDSTREAM)
(EQ (SETQ TOKEN (READ FIELDSTREAM
@@ -107,14 +105,13 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(EQ (CADDR ADDRESS)
';))
then
(* ;; "it's a private dl --- foo:;")
(* ;; "it's a private dl --- foo:;")
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST ADDRESS REGISTRY INTERNALFLG
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST ADDRESS REGISTRY INTERNALFLG
EDITWINDOW)
else
(* ;; "ADDRESS will only get rebound if there is an address with <>'s in it ")
(* ;;
 "ADDRESS will only get rebound if there is an address with <>'s in it ")
(SETQ VALIDRECIPIENT (\GV.PARSE.SINGLE.ADDRESS
(COND
@@ -128,8 +125,8 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
((OR T INTERNALFLG (NULL REALADDRESS))
VALIDRECIPIENT)
(T
(* ;; "Need to figure out how to make GETREGISTRY of this work, and remove duplicates in MAKEANSWERFORM before we can enable this")
(* ;; "Need to figure out how to make GETREGISTRY of this work, and remove duplicates in MAKEANSWERFORM before we can enable this")
(\GV.REPACKADDRESS (APPEND (LDIFF ADDRESS OPEN)
(LIST '< VALIDRECIPIENT
@@ -137,7 +134,7 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(CDR CLOSE])
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST
[LAMBDA (DL REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:45")
[LAMBDA (DL REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:45")
(LET* [(FILENAME (FINDFILE (PACKFILENAME.STRING 'BODY (CAR DL)
'EXTENSION LAFITEDL.EXT)
T
@@ -162,10 +159,10 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
file can all be parsed at once. This has no effect on normal operation since before private dls no CR
was ever passed to the parser)
(SETSYNTAX (CHARCODE CR)
'SEPRCHAR ADDRESSPARSERRDTBL)
(PUTPROPS LAFITEPRIVATEDL COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1965 9682 (\GV.PARSERECIPIENTS1 1975 . 8562) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8564
. 9680)))))
(FILEMAP (NIL (1617 9389 (\GV.PARSERECIPIENTS1 1627 . 8273) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8275
. 9387)))))
STOP

Binary file not shown.

File diff suppressed because it is too large Load Diff

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Nov-2025 10:57:24" {WMEDLEY}<library>SKETCH>SKETCH-ELEMENTS.;25 545903
(FILECREATED "18-Dec-2025 00:27:41" {WMEDLEY}<library>SKETCH>SKETCH-ELEMENTS.;28 546107
:EDIT-BY rmk
:CHANGES-TO (FNS SK.CHANGE.TEXT SK.CHANGE.FONT)
:CHANGES-TO (FNS SK.DECREASING.FONT.LIST)
:PREVIOUS-DATE " 8-Nov-2025 14:02:38" {WMEDLEY}<library>SKETCH>SKETCH-ELEMENTS.;24)
:PREVIOUS-DATE "30-Nov-2025 10:57:24" {WMEDLEY}<library>SKETCH>SKETCH-ELEMENTS.;25)
(PRETTYCOMPRINT SKETCH-ELEMENTSCOMS)
@@ -5545,7 +5545,8 @@ Click outside the window to stop.")
do (RETURN (FONTPROP FONT 'SPEC])
(SK.DECREASING.FONT.LIST
[LAMBDA (FAMILY DEVICE) (* ; "Edited 6-Nov-2025 17:40 by rmk")
[LAMBDA (FAMILY DEVICE) (* ; "Edited 18-Dec-2025 00:27 by rmk")
(* ; "Edited 6-Nov-2025 17:40 by rmk")
(* ; "Edited 4-Nov-2025 15:34 by rmk")
(* ;
 "Edited 12-Oct-92 12:39 by sybalsky:mv:envos")
@@ -5566,19 +5567,19 @@ Click outside the window to stop.")
(SETQ FAMILY 'MODERN))
(LET ((FAMSPEC (create FONTSPEC
FSFAMILY _ FAMILY
FSSIZE _ '*
FSSIZE _ 12
FSDEVICE _ DEVICE)))
(* ;; "Run through all sizes for all the fonts for FAMILY or any of its coercions on DEVICE. This gives us all the possible sizes for FAMILY, we ask FONTCREATE to create a FAMILY font for each of those sizes.")
(* ;; "Coerce for size 12 to getcoercions for all reasonable FAMILYs, then go to *. This gives us all the possible sizes for FAMILY, we ask FONTCREATE to create a FAMILY font for each of those sizes.")
(for FS SIZES in (for FS in [CONS FAMSPEC (COERCEFONTSPEC FAMSPEC (FONTDEVICEPROP
(for FS SIZES in (for FS in (CONS FAMSPEC (COERCEFONTSPEC FAMSPEC (FONTDEVICEPROP
DEVICE
'CHARCOERCIONS]
join (FONTSAVAILABLE FS NIL NIL NIL NIL T))
do (pushnew SIZES (fetch (FONTSPEC FSSIZE) of FS))
finally (RETURN (for S in [SORT SIZES (FUNCTION (LAMBDA (S1 S2)
(IGREATERP S1 S2]
collect (FONTCREATE FAMILY S NIL NIL DEVICE])
'CHARCOERCIONS T)))
join (FONTSAVAILABLE (create FONTSPEC using FS FSSIZE _ '*)
NIL NIL NIL NIL T)) do (pushnew SIZES (fetch (FONTSPEC
FSSIZE)
of FS))
finally (RETURN (for S in (SORT SIZES) collect (FONTCREATE FAMILY S NIL NIL DEVICE])
)
(RPAQ? \KNOWN.SKETCH.FONTSIZES )
@@ -9076,136 +9077,136 @@ No more font sizes found.")
(fetch (REGION TOP) of REGION])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (14197 24607 (INIT.SKETCH.ELEMENTS 14207 . 21770) (CREATE.SKETCH.ELEMENT.TYPE 21772 .
23294) (SKETCH.ELEMENT.TYPEP 23296 . 23684) (SKETCH.ELEMENT.NAMEP 23686 . 23949) (
\CURSOR.IN.MIDDLE.MENU 23951 . 24605)) (24648 25325 (SKETCHINCOLORP 24658 . 24978) (READ.COLOR.CHANGE
24980 . 25323)) (25834 28613 (SK.CREATE.DEFAULT.FILLING 25844 . 26145) (SKFILLINGP 26147 . 26780) (
SK.INSURE.FILLING 26782 . 28210) (SK.INSURE.COLOR 28212 . 28611)) (28614 34224 (SK.TRANSLATE.MODE
28624 . 29406) (SK.CHANGE.FILLING.MODE 29408 . 32991) (READ.FILLING.MODE 32993 . 34222)) (34225 64899
(SKETCH.CREATE.CIRCLE 34235 . 35047) (CIRCLE.EXPANDFN 35049 . 38421) (CIRCLE.DRAWFN 38423 . 41424) (
\CIRCLE.DRAWFN1 41426 . 44021) (CIRCLE.INPUTFN 44023 . 45872) (SK.UPDATE.CIRCLE.AFTER.CHANGE 45874 .
46233) (SK.READ.CIRCLE.POINT 46235 . 46706) (SK.SHOW.CIRCLE 46708 . 47354) (CIRCLE.INSIDEFN 47356 .
47621) (CIRCLE.REGIONFN 47623 . 49304) (CIRCLE.GLOBALREGIONFN 49306 . 50824) (CIRCLE.TRANSLATE 50826
. 52687) (CIRCLE.READCHANGEFN 52689 . 57305) (CIRCLE.TRANSFORMFN 57307 . 59160) (CIRCLE.TRANSLATEPTS
59162 . 60776) (SK.CIRCLE.CREATE 60778 . 61621) (SET.CIRCLE.SCALE 61623 . 62389) (SK.BRUSH.READCHANGE
62391 . 64897)) (64900 65629 (SK.INSURE.BRUSH 64910 . 65304) (SK.INSURE.DASHING 65306 . 65627)) (66843
96337 (SKETCH.CREATE.ELLIPSE 66853 . 67452) (ELLIPSE.EXPANDFN 67454 . 71066) (ELLIPSE.DRAWFN 71068 .
75245) (ELLIPSE.INPUTFN 75247 . 77687) (SK.READ.ELLIPSE.MAJOR.PT 77689 . 78268) (
SK.SHOW.ELLIPSE.MAJOR.RADIUS 78270 . 79025) (SK.READ.ELLIPSE.MINOR.PT 79027 . 79720) (
SK.SHOW.ELLIPSE.MINOR.RADIUS 79722 . 80554) (ELLIPSE.INSIDEFN 80556 . 80826) (ELLIPSE.CREATE 80828 .
82203) (SK.UPDATE.ELLIPSE.AFTER.CHANGE 82205 . 82573) (ELLIPSE.REGIONFN 82575 . 84775) (
ELLIPSE.GLOBALREGIONFN 84777 . 86590) (ELLIPSE.TRANSLATEFN 86592 . 89138) (ELLIPSE.TRANSFORMFN 89140
. 90417) (ELLIPSE.TRANSLATEPTS 90419 . 92460) (MARK.SPOT 92462 . 93713) (DISTANCEBETWEEN 93715 .
94310) (SK.DISTANCE.TO 94312 . 94697) (SQUARE 94699 . 94741) (COMPUTE.ELLIPSE.ORIENTATION 94743 .
95462) (SK.COMPUTE.ELLIPSE.MINOR.RADIUS.PT 95464 . 96335)) (97450 138506 (SKETCH.CREATE.OPEN.CURVE
97460 . 98013) (OPENCURVE.INPUTFN 98015 . 98883) (SK.CURVE.CREATE 98885 . 100630) (MAXXEXTENT 100632
. 101491) (MAXYEXTENT 101493 . 102353) (KNOT.SET.SCALE.FIELD 102355 . 103157) (OPENCURVE.DRAWFN
103159 . 104290) (OPENCURVE.EXPANDFN 104292 . 107607) (OPENCURVE.READCHANGEFN 107609 . 110811) (
OPENCURVE.TRANSFORMFN 110813 . 113311) (OPENCURVE.TRANSLATEFN 113313 . 113735) (
OPENCURVE.TRANSLATEPTSFN 113737 . 115118) (SKETCH.CREATE.CLOSED.CURVE 115120 . 115626) (
CLOSEDCURVE.DRAWFN 115628 . 116412) (CLOSEDCURVE.EXPANDFN 116414 . 119527) (CLOSEDCURVE.REGIONFN
119529 . 120326) (CLOSEDCURVE.GLOBALREGIONFN 120328 . 121761) (READ.LIST.OF.POINTS 121763 . 123742) (
CLOSEDCURVE.INPUTFN 123744 . 124389) (CLOSEDCURVE.READCHANGEFN 124391 . 127286) (
CLOSEDCURVE.TRANSFORMFN 127288 . 129088) (CLOSEDCURVE.TRANSLATEPTSFN 129090 . 130435) (INVISIBLEPARTP
130437 . 130790) (SHOWSKETCHPOINT 130792 . 131097) (SHOWSKETCHXY 131099 . 131617) (KNOTS.REGIONFN
131619 . 132520) (OPENWIRE.GLOBALREGIONFN 132522 . 133386) (CURVE.REGIONFN 133388 . 134329) (
OPENCURVE.GLOBALREGIONFN 134331 . 135738) (KNOTS.TRANSLATEFN 135740 . 136783) (REGION.CONTAINING.PTS
136785 . 138504)) (138507 160783 (CHANGE.ELTS.BRUSH.SIZE 138517 . 139127) (CHANGE.ELTS.BRUSH 139129 .
139646) (CHANGE.ELTS.BRUSH.SHAPE 139648 . 140049) (SK.CHANGE.BRUSH.SHAPE 140051 . 143563) (
SK.CHANGE.BRUSH.COLOR 143565 . 148011) (SK.CHANGE.BRUSH.SIZE 148013 . 152971) (SK.CHANGE.ANGLE 152973
. 155953) (SK.CHANGE.ARC.DIRECTION 155955 . 158334) (SK.SET.DEFAULT.BRUSH.SIZE 158336 . 159035) (
READSIZECHANGE 159037 . 160781)) (160784 162403 (SK.CHANGE.ELEMENT.KNOTS 160794 . 162401)) (162404
163051 (SK.INSURE.POINT.LIST 162414 . 162867) (SK.INSURE.POSITION 162869 . 163049)) (164419 196742 (
SKETCH.CREATE.WIRE 164429 . 164919) (CLOSEDWIRE.EXPANDFN 164921 . 167609) (KNOTS.INSIDEFN 167611 .
168332) (OPEN.WIRE.DRAWFN 168334 . 168926) (WIRE.EXPANDFN 168928 . 172175) (
SK.UPDATE.WIRE.ELT.AFTER.CHANGE 172177 . 172698) (OPENWIRE.READCHANGEFN 172700 . 175193) (
OPENWIRE.TRANSFORMFN 175195 . 177318) (OPENWIRE.TRANSLATEFN 177320 . 177744) (OPENWIRE.TRANSLATEPTSFN
177746 . 179025) (WIRE.INPUTFN 179027 . 180658) (SK.READ.WIRE.POINTS 180660 . 181191) (
SK.READ.POINTS.WITH.FEEDBACK 181193 . 183960) (OPENWIRE.FEEDBACKFN 183962 . 184716) (
CLOSEDWIRE.FEEDBACKFN 184718 . 186074) (CLOSEDWIRE.REGIONFN 186076 . 187061) (
CLOSEDWIRE.GLOBALREGIONFN 187063 . 188115) (SK.WIRE.CREATE 188117 . 189880) (WIRE.ADD.POINT.TO.END
189882 . 190798) (READ.ARROW.CHANGE 190800 . 196276) (CHANGE.ELTS.ARROWHEADS 196278 . 196740)) (196743
207749 (SKETCH.CREATE.CLOSED.WIRE 196753 . 197314) (CLOSED.WIRE.INPUTFN 197316 . 197671) (
CLOSED.WIRE.DRAWFN 197673 . 199718) (CLOSEDWIRE.READCHANGEFN 199720 . 204625) (CLOSEDWIRE.TRANSFORMFN
204627 . 206421) (CLOSEDWIRE.TRANSLATEPTSFN 206423 . 207747)) (207750 260456 (SK.EXPAND.ARROWHEADS
207760 . 208110) (SK.COMPUTE.ARC.ARROWHEAD.POINTS 208112 . 209493) (ARC.ARROWHEAD.POINTS 209495 .
210718) (SET.ARC.ARROWHEAD.POINTS 210720 . 211701) (SET.OPENCURVE.ARROWHEAD.POINTS 211703 . 212604) (
SK.COMPUTE.CURVE.ARROWHEAD.POINTS 212606 . 213876) (SET.WIRE.ARROWHEAD.POINTS 213878 . 214631) (
SK.COMPUTE.WIRE.ARROWHEAD.POINTS 214633 . 215898) (SK.EXPAND.ARROWHEAD 215900 . 217083) (CHANGED.ARROW
217085 . 220257) (SK.CHANGE.ARROWHEAD 220259 . 220712) (SK.CHANGE.ARROWHEAD1 220714 . 225969) (
SK.CREATE.ARROWHEAD 225971 . 226491) (SK.ARROWHEAD.CREATE 226493 . 228067) (SK.ARROWHEAD.END.TEST
228069 . 228993) (READ.ARROWHEAD.END 228995 . 231020) (ARROW.HEAD.POSITIONS 231022 . 232862) (
ARROWHEAD.POINTS.LIST 232864 . 236836) (CURVE.ARROWHEAD.POINTS 236838 . 237701) (LEFT.MOST.IS.BEGINP
237703 . 238584) (WIRE.ARROWHEAD.POINTS 238586 . 240112) (DRAWARROWHEADS 240114 . 242484) (
\SK.DRAW.TRIANGLE.ARROWHEAD 242486 . 244146) (\SK.ENDPT.OF.ARROW 244148 . 246405) (
\SK.ADJUST.FOR.ARROWHEADS 246407 . 248912) (SK.SET.ARROWHEAD.LENGTH 248914 . 250058) (
SK.SET.ARROWHEAD.ANGLE 250060 . 251156) (SK.SET.ARROWHEAD.TYPE 251158 . 254447) (SK.SET.LINE.ARROWHEAD
254449 . 256862) (SK.UPDATE.ARROWHEAD.FORMAT 256864 . 258974) (SK.SET.LINE.LENGTH.MODE 258976 .
260454)) (260457 262258 (SK.INSURE.ARROWHEADS 260467 . 261649) (SK.ARROWHEADP 261651 . 262256)) (
265055 327497 (SKETCH.CREATE.TEXT 265065 . 265579) (TEXT.CHANGEFN 265581 . 265973) (TEXT.READCHANGEFN
265975 . 274046) (\SK.READ.FONT.SIZE1 274048 . 276214) (SK.TEXT.ELT.WITH.SAME.FIELDS 276216 . 277856)
(SK.READFONTFAMILY 277858 . 280328) (CLOSE.PROMPT.WINDOW 280330 . 280754) (TEXT.DRAWFN 280756 . 281477
) (TEXT.DRAWFN1 281479 . 284981) (TEXT.INSIDEFN 284983 . 285372) (TEXT.EXPANDFN 285374 . 287499) (
SK.TEXT.LINE.REGIONS 287501 . 289375) (TEXT.UPDATE.GLOBAL.REGIONS 289377 . 290609) (REL.MOVE.REGION
290611 . 291148) (LTEXT.LINE.REGIONS 291150 . 294568) (TEXT.INPUTFN 294570 . 295080) (READ.TEXT 295082
. 295830) (TEXT.POSITION.AND.CREATE 295832 . 298143) (CREATE.TEXT.ELEMENT 298145 . 298963) (
SK.UPDATE.TEXT.AFTER.CHANGE 298965 . 299367) (SK.TEXT.FROM.TEXTBOX 299369 . 303175) (
TEXT.SET.GLOBAL.REGIONS 303177 . 304470) (TEXT.REGIONFN 304472 . 305242) (TEXT.GLOBALREGIONFN 305244
. 305932) (TEXT.TRANSLATEFN 305934 . 307249) (TEXT.TRANSFORMFN 307251 . 308374) (TEXT.TRANSLATEPTSFN
308376 . 308893) (TEXT.UPDATEFN 308895 . 313551) (SK.CHANGE.TEXT 313553 . 323831) (SK.CHANGE.FONT
323833 . 325563) (TEXT.SET.SCALES 325565 . 326533) (BREAK.AT.CARRIAGE.RETURNS 326535 . 327495)) (
327498 340483 (SK.PICK.FONT 327508 . 331780) (SK.CHOOSE.TEXT.FONT 331782 . 336053) (SK.NEXTSIZEFONT
336055 . 337687) (SK.DECREASING.FONT.LIST 337689 . 340481)) (340902 352576 (SK.SET.FONT 340912 .
342179) (SK.SET.TEXT.FONT 342181 . 343183) (SK.SET.TEXT.SIZE 343185 . 343872) (SK.SET.TEXT.HORIZ.ALIGN
343874 . 345448) (SK.READFONTSIZE 345450 . 347348) (SK.COLLECT.FONT.SIZES 347350 . 348431) (
SK.SET.TEXT.VERT.ALIGN 348433 . 350475) (SK.SET.TEXT.LOOKS 350477 . 351934) (SK.SET.DEFAULT.TEXT.FACE
351936 . 352574)) (352577 353163 (CREATE.SKETCH.TERMTABLE 352587 . 353161)) (353164 354930 (
SK.FONT.LIST 353174 . 353500) (SK.INSURE.FONT 353502 . 354024) (SK.INSURE.STYLE 354026 . 354544) (
SK.INSURE.TEXT 354546 . 354928)) (355470 412763 (SKETCH.CREATE.TEXTBOX 355480 . 357122) (
SK.COMPUTE.TEXTBOX.REGION.FOR.STRING 357124 . 359201) (SK.BREAK.INTO.LINES 359203 . 370389) (
SK.BRUSH.SIZE 370391 . 370772) (SK.TEXTBOX.CREATE 370774 . 371571) (SK.TEXTBOX.CREATE1 371573 . 372637
) (SK.UPDATE.TEXTBOX.AFTER.CHANGE 372639 . 373179) (SK.TEXTBOX.POSITION.IN.BOX 373181 . 375092) (
TEXTBOX.CHANGEFN 375094 . 375568) (TEXTBOX.DRAWFN 375570 . 377606) (SK.TEXTURE.AROUND.REGIONS 377608
. 383681) (ALL.EMPTY.REGIONS 383683 . 384173) (TEXTBOX.EXPANDFN 384175 . 391331) (TEXTBOX.INPUTFN
391333 . 392946) (TEXTBOX.INSIDEFN 392948 . 393361) (TEXTBOX.REGIONFN 393363 . 394217) (
TEXTBOX.GLOBALREGIONFN 394219 . 394547) (TEXTBOX.SET.GLOBAL.REGIONS 394549 . 395880) (
TEXTBOX.TRANSLATEFN 395882 . 397723) (TEXTBOX.TRANSLATEPTSFN 397725 . 400508) (TEXTBOX.TRANSFORMFN
400510 . 402178) (TEXTBOX.UPDATEFN 402180 . 404073) (TEXTBOX.READCHANGEFN 404075 . 408964) (
SK.TEXTBOX.TEXT.POSITION 408966 . 409387) (SK.TEXTBOX.FROM.TEXT 409389 . 411994) (ADD.EOLS 411996 .
412761)) (413292 416793 (SK.SET.TEXTBOX.VERT.ALIGN 413302 . 415182) (SK.SET.TEXTBOX.HORIZ.ALIGN 415184
. 416791)) (417176 461651 (SKETCH.CREATE.BOX 417186 . 417669) (SK.BOX.DRAWFN 417671 . 418830) (
BOX.DRAWFN1 418832 . 421671) (KNOTS.OF.REGION 421673 . 422907) (SK.DRAWAREABOX 422909 . 429510) (
SK.DRAWBOX 429512 . 430701) (SK.BOX.EXPANDFN 430703 . 434451) (SK.BOX.GETREGIONFN 434453 . 435639) (
BOX.SET.SCALES 435641 . 436881) (SK.BOX.INPUTFN 436883 . 438816) (SK.BOX.CREATE 438818 . 439519) (
SK.UPDATE.BOX.AFTER.CHANGE 439521 . 440032) (SK.BOX.INSIDEFN 440034 . 440424) (SK.BOX.REGIONFN 440426
. 441139) (SK.BOX.GLOBALREGIONFN 441141 . 441879) (SK.BOX.READCHANGEFN 441881 . 445602) (
SK.CHANGE.FILLING 445604 . 449552) (SK.CHANGE.FILLING.COLOR 449554 . 453210) (SK.BOX.TRANSLATEFN
453212 . 454391) (SK.BOX.TRANSFORMFN 454393 . 455338) (SK.BOX.TRANSLATEPTSFN 455340 . 457708) (
UNSCALE.REGION.TO.GRID 457710 . 458635) (INCREASEREGION 458637 . 459228) (INSUREREGIONSIZE 459230 .
460401) (EXPANDREGION 460403 . 461283) (REGION.FROM.COORDINATES 461285 . 461649)) (462187 488542 (
SKETCH.CREATE.ARC 462197 . 463006) (ARC.DRAWFN 463008 . 464735) (ARC.EXPANDFN 464737 . 467070) (
ARC.INPUTFN 467072 . 471290) (SK.INVERT.CIRCLE 471292 . 472152) (SK.READ.ARC.ANGLE.POINT 472154 .
472661) (SK.SHOW.ARC 472663 . 473273) (ARC.CREATE 473275 . 474630) (SK.UPDATE.ARC.AFTER.CHANGE 474632
. 474972) (ARC.MOVEFN 474974 . 476557) (ARC.TRANSLATEPTS 476559 . 478444) (ARC.INSIDEFN 478446 .
478696) (ARC.REGIONFN 478698 . 479834) (ARC.GLOBALREGIONFN 479836 . 481558) (ARC.TRANSLATE 481560 .
482542) (ARC.TRANSFORMFN 482544 . 485494) (ARC.READCHANGEFN 485496 . 488540)) (488543 497622 (
SK.COMPUTE.ARC.ANGLE.PT 488553 . 489479) (SK.COMPUTE.ARC.ANGLE.PT.FROM.ANGLE 489481 . 490474) (
SK.COMPUTE.ARC.PTS 490476 . 494048) (SK.SET.ARC.DIRECTION 494050 . 494624) (SK.SET.ARC.DIRECTION.CW
494626 . 494800) (SK.SET.ARC.DIRECTION.CCW 494802 . 495075) (SK.COMPUTE.SLOPE.OF.LINE 495077 . 495569)
(SK.CREATE.ARC.USING 495571 . 496808) (SET.ARC.SCALES 496810 . 497620)) (497623 498068 (
SK.INSURE.DIRECTION 497633 . 498066)) (499439 545298 (GETSKETCHELEMENTPROP 499449 . 500757) (
\SK.GET.ARC.ANGLEPT 500759 . 501320) (\GETSKETCHELEMENTPROP1 501322 . 501576) (\SK.GET.BRUSH 501578 .
502502) (\SK.GET.FILLING 502504 . 503602) (\SK.GET.ARROWHEADS 503604 . 504383) (\SK.GET.FONT 504385 .
504865) (\SK.GET.JUSTIFICATION 504867 . 505391) (\SK.GET.DIRECTION 505393 . 505870) (\SK.GET.DASHING
505872 . 506891) (PUTSKETCHELEMENTPROP 506893 . 509162) (\SK.PUT.FILLING 509164 . 510434) (
ADDSKETCHELEMENTPROP 510436 . 511241) (REMOVESKETCHELEMENTPROP 511243 . 512032) (\SK.PUT.FONT 512034
. 512848) (\SK.PUT.JUSTIFICATION 512850 . 513861) (\SK.PUT.DIRECTION 513863 . 514470) (
\SK.PUT.DASHING 514472 . 515807) (\SK.PUT.BRUSH 515809 . 517728) (\SK.PUT.ARROWHEADS 517730 . 519696)
(SK.COPY.ELEMENT.PROPERTY.LIST 519698 . 520274) (SKETCH.UPDATE 520276 . 521006) (SKETCH.UPDATE1 521008
. 522296) (\SKELT.GET.SCALE 522298 . 523286) (\SKELT.PUT.SCALE 523288 . 524595) (\SKELT.PUT.DATA
524597 . 526394) (SK.REPLACE.TEXT.IN.ELEMENT 526396 . 527349) (\SKELT.GET.DATA 527351 . 528418) (
\SK.GET.1STCONTROLPT 528420 . 529932) (\SK.PUT.1STCONTROLPT 529934 . 535407) (\SK.GET.2NDCONTROLPT
535409 . 536324) (\SK.PUT.2NDCONTROLPT 536326 . 540514) (\SK.GET.3RDCONTROLPT 540516 . 541394) (
\SK.PUT.3RDCONTROLPT 541396 . 545296)) (545299 545880 (LOWERLEFTCORNER 545309 . 545555) (
UPPERRIGHTCORNER 545557 . 545878)))))
(FILEMAP (NIL (14191 24601 (INIT.SKETCH.ELEMENTS 14201 . 21764) (CREATE.SKETCH.ELEMENT.TYPE 21766 .
23288) (SKETCH.ELEMENT.TYPEP 23290 . 23678) (SKETCH.ELEMENT.NAMEP 23680 . 23943) (
\CURSOR.IN.MIDDLE.MENU 23945 . 24599)) (24642 25319 (SKETCHINCOLORP 24652 . 24972) (READ.COLOR.CHANGE
24974 . 25317)) (25828 28607 (SK.CREATE.DEFAULT.FILLING 25838 . 26139) (SKFILLINGP 26141 . 26774) (
SK.INSURE.FILLING 26776 . 28204) (SK.INSURE.COLOR 28206 . 28605)) (28608 34218 (SK.TRANSLATE.MODE
28618 . 29400) (SK.CHANGE.FILLING.MODE 29402 . 32985) (READ.FILLING.MODE 32987 . 34216)) (34219 64893
(SKETCH.CREATE.CIRCLE 34229 . 35041) (CIRCLE.EXPANDFN 35043 . 38415) (CIRCLE.DRAWFN 38417 . 41418) (
\CIRCLE.DRAWFN1 41420 . 44015) (CIRCLE.INPUTFN 44017 . 45866) (SK.UPDATE.CIRCLE.AFTER.CHANGE 45868 .
46227) (SK.READ.CIRCLE.POINT 46229 . 46700) (SK.SHOW.CIRCLE 46702 . 47348) (CIRCLE.INSIDEFN 47350 .
47615) (CIRCLE.REGIONFN 47617 . 49298) (CIRCLE.GLOBALREGIONFN 49300 . 50818) (CIRCLE.TRANSLATE 50820
. 52681) (CIRCLE.READCHANGEFN 52683 . 57299) (CIRCLE.TRANSFORMFN 57301 . 59154) (CIRCLE.TRANSLATEPTS
59156 . 60770) (SK.CIRCLE.CREATE 60772 . 61615) (SET.CIRCLE.SCALE 61617 . 62383) (SK.BRUSH.READCHANGE
62385 . 64891)) (64894 65623 (SK.INSURE.BRUSH 64904 . 65298) (SK.INSURE.DASHING 65300 . 65621)) (66837
96331 (SKETCH.CREATE.ELLIPSE 66847 . 67446) (ELLIPSE.EXPANDFN 67448 . 71060) (ELLIPSE.DRAWFN 71062 .
75239) (ELLIPSE.INPUTFN 75241 . 77681) (SK.READ.ELLIPSE.MAJOR.PT 77683 . 78262) (
SK.SHOW.ELLIPSE.MAJOR.RADIUS 78264 . 79019) (SK.READ.ELLIPSE.MINOR.PT 79021 . 79714) (
SK.SHOW.ELLIPSE.MINOR.RADIUS 79716 . 80548) (ELLIPSE.INSIDEFN 80550 . 80820) (ELLIPSE.CREATE 80822 .
82197) (SK.UPDATE.ELLIPSE.AFTER.CHANGE 82199 . 82567) (ELLIPSE.REGIONFN 82569 . 84769) (
ELLIPSE.GLOBALREGIONFN 84771 . 86584) (ELLIPSE.TRANSLATEFN 86586 . 89132) (ELLIPSE.TRANSFORMFN 89134
. 90411) (ELLIPSE.TRANSLATEPTS 90413 . 92454) (MARK.SPOT 92456 . 93707) (DISTANCEBETWEEN 93709 .
94304) (SK.DISTANCE.TO 94306 . 94691) (SQUARE 94693 . 94735) (COMPUTE.ELLIPSE.ORIENTATION 94737 .
95456) (SK.COMPUTE.ELLIPSE.MINOR.RADIUS.PT 95458 . 96329)) (97444 138500 (SKETCH.CREATE.OPEN.CURVE
97454 . 98007) (OPENCURVE.INPUTFN 98009 . 98877) (SK.CURVE.CREATE 98879 . 100624) (MAXXEXTENT 100626
. 101485) (MAXYEXTENT 101487 . 102347) (KNOT.SET.SCALE.FIELD 102349 . 103151) (OPENCURVE.DRAWFN
103153 . 104284) (OPENCURVE.EXPANDFN 104286 . 107601) (OPENCURVE.READCHANGEFN 107603 . 110805) (
OPENCURVE.TRANSFORMFN 110807 . 113305) (OPENCURVE.TRANSLATEFN 113307 . 113729) (
OPENCURVE.TRANSLATEPTSFN 113731 . 115112) (SKETCH.CREATE.CLOSED.CURVE 115114 . 115620) (
CLOSEDCURVE.DRAWFN 115622 . 116406) (CLOSEDCURVE.EXPANDFN 116408 . 119521) (CLOSEDCURVE.REGIONFN
119523 . 120320) (CLOSEDCURVE.GLOBALREGIONFN 120322 . 121755) (READ.LIST.OF.POINTS 121757 . 123736) (
CLOSEDCURVE.INPUTFN 123738 . 124383) (CLOSEDCURVE.READCHANGEFN 124385 . 127280) (
CLOSEDCURVE.TRANSFORMFN 127282 . 129082) (CLOSEDCURVE.TRANSLATEPTSFN 129084 . 130429) (INVISIBLEPARTP
130431 . 130784) (SHOWSKETCHPOINT 130786 . 131091) (SHOWSKETCHXY 131093 . 131611) (KNOTS.REGIONFN
131613 . 132514) (OPENWIRE.GLOBALREGIONFN 132516 . 133380) (CURVE.REGIONFN 133382 . 134323) (
OPENCURVE.GLOBALREGIONFN 134325 . 135732) (KNOTS.TRANSLATEFN 135734 . 136777) (REGION.CONTAINING.PTS
136779 . 138498)) (138501 160777 (CHANGE.ELTS.BRUSH.SIZE 138511 . 139121) (CHANGE.ELTS.BRUSH 139123 .
139640) (CHANGE.ELTS.BRUSH.SHAPE 139642 . 140043) (SK.CHANGE.BRUSH.SHAPE 140045 . 143557) (
SK.CHANGE.BRUSH.COLOR 143559 . 148005) (SK.CHANGE.BRUSH.SIZE 148007 . 152965) (SK.CHANGE.ANGLE 152967
. 155947) (SK.CHANGE.ARC.DIRECTION 155949 . 158328) (SK.SET.DEFAULT.BRUSH.SIZE 158330 . 159029) (
READSIZECHANGE 159031 . 160775)) (160778 162397 (SK.CHANGE.ELEMENT.KNOTS 160788 . 162395)) (162398
163045 (SK.INSURE.POINT.LIST 162408 . 162861) (SK.INSURE.POSITION 162863 . 163043)) (164413 196736 (
SKETCH.CREATE.WIRE 164423 . 164913) (CLOSEDWIRE.EXPANDFN 164915 . 167603) (KNOTS.INSIDEFN 167605 .
168326) (OPEN.WIRE.DRAWFN 168328 . 168920) (WIRE.EXPANDFN 168922 . 172169) (
SK.UPDATE.WIRE.ELT.AFTER.CHANGE 172171 . 172692) (OPENWIRE.READCHANGEFN 172694 . 175187) (
OPENWIRE.TRANSFORMFN 175189 . 177312) (OPENWIRE.TRANSLATEFN 177314 . 177738) (OPENWIRE.TRANSLATEPTSFN
177740 . 179019) (WIRE.INPUTFN 179021 . 180652) (SK.READ.WIRE.POINTS 180654 . 181185) (
SK.READ.POINTS.WITH.FEEDBACK 181187 . 183954) (OPENWIRE.FEEDBACKFN 183956 . 184710) (
CLOSEDWIRE.FEEDBACKFN 184712 . 186068) (CLOSEDWIRE.REGIONFN 186070 . 187055) (
CLOSEDWIRE.GLOBALREGIONFN 187057 . 188109) (SK.WIRE.CREATE 188111 . 189874) (WIRE.ADD.POINT.TO.END
189876 . 190792) (READ.ARROW.CHANGE 190794 . 196270) (CHANGE.ELTS.ARROWHEADS 196272 . 196734)) (196737
207743 (SKETCH.CREATE.CLOSED.WIRE 196747 . 197308) (CLOSED.WIRE.INPUTFN 197310 . 197665) (
CLOSED.WIRE.DRAWFN 197667 . 199712) (CLOSEDWIRE.READCHANGEFN 199714 . 204619) (CLOSEDWIRE.TRANSFORMFN
204621 . 206415) (CLOSEDWIRE.TRANSLATEPTSFN 206417 . 207741)) (207744 260450 (SK.EXPAND.ARROWHEADS
207754 . 208104) (SK.COMPUTE.ARC.ARROWHEAD.POINTS 208106 . 209487) (ARC.ARROWHEAD.POINTS 209489 .
210712) (SET.ARC.ARROWHEAD.POINTS 210714 . 211695) (SET.OPENCURVE.ARROWHEAD.POINTS 211697 . 212598) (
SK.COMPUTE.CURVE.ARROWHEAD.POINTS 212600 . 213870) (SET.WIRE.ARROWHEAD.POINTS 213872 . 214625) (
SK.COMPUTE.WIRE.ARROWHEAD.POINTS 214627 . 215892) (SK.EXPAND.ARROWHEAD 215894 . 217077) (CHANGED.ARROW
217079 . 220251) (SK.CHANGE.ARROWHEAD 220253 . 220706) (SK.CHANGE.ARROWHEAD1 220708 . 225963) (
SK.CREATE.ARROWHEAD 225965 . 226485) (SK.ARROWHEAD.CREATE 226487 . 228061) (SK.ARROWHEAD.END.TEST
228063 . 228987) (READ.ARROWHEAD.END 228989 . 231014) (ARROW.HEAD.POSITIONS 231016 . 232856) (
ARROWHEAD.POINTS.LIST 232858 . 236830) (CURVE.ARROWHEAD.POINTS 236832 . 237695) (LEFT.MOST.IS.BEGINP
237697 . 238578) (WIRE.ARROWHEAD.POINTS 238580 . 240106) (DRAWARROWHEADS 240108 . 242478) (
\SK.DRAW.TRIANGLE.ARROWHEAD 242480 . 244140) (\SK.ENDPT.OF.ARROW 244142 . 246399) (
\SK.ADJUST.FOR.ARROWHEADS 246401 . 248906) (SK.SET.ARROWHEAD.LENGTH 248908 . 250052) (
SK.SET.ARROWHEAD.ANGLE 250054 . 251150) (SK.SET.ARROWHEAD.TYPE 251152 . 254441) (SK.SET.LINE.ARROWHEAD
254443 . 256856) (SK.UPDATE.ARROWHEAD.FORMAT 256858 . 258968) (SK.SET.LINE.LENGTH.MODE 258970 .
260448)) (260451 262252 (SK.INSURE.ARROWHEADS 260461 . 261643) (SK.ARROWHEADP 261645 . 262250)) (
265049 327491 (SKETCH.CREATE.TEXT 265059 . 265573) (TEXT.CHANGEFN 265575 . 265967) (TEXT.READCHANGEFN
265969 . 274040) (\SK.READ.FONT.SIZE1 274042 . 276208) (SK.TEXT.ELT.WITH.SAME.FIELDS 276210 . 277850)
(SK.READFONTFAMILY 277852 . 280322) (CLOSE.PROMPT.WINDOW 280324 . 280748) (TEXT.DRAWFN 280750 . 281471
) (TEXT.DRAWFN1 281473 . 284975) (TEXT.INSIDEFN 284977 . 285366) (TEXT.EXPANDFN 285368 . 287493) (
SK.TEXT.LINE.REGIONS 287495 . 289369) (TEXT.UPDATE.GLOBAL.REGIONS 289371 . 290603) (REL.MOVE.REGION
290605 . 291142) (LTEXT.LINE.REGIONS 291144 . 294562) (TEXT.INPUTFN 294564 . 295074) (READ.TEXT 295076
. 295824) (TEXT.POSITION.AND.CREATE 295826 . 298137) (CREATE.TEXT.ELEMENT 298139 . 298957) (
SK.UPDATE.TEXT.AFTER.CHANGE 298959 . 299361) (SK.TEXT.FROM.TEXTBOX 299363 . 303169) (
TEXT.SET.GLOBAL.REGIONS 303171 . 304464) (TEXT.REGIONFN 304466 . 305236) (TEXT.GLOBALREGIONFN 305238
. 305926) (TEXT.TRANSLATEFN 305928 . 307243) (TEXT.TRANSFORMFN 307245 . 308368) (TEXT.TRANSLATEPTSFN
308370 . 308887) (TEXT.UPDATEFN 308889 . 313545) (SK.CHANGE.TEXT 313547 . 323825) (SK.CHANGE.FONT
323827 . 325557) (TEXT.SET.SCALES 325559 . 326527) (BREAK.AT.CARRIAGE.RETURNS 326529 . 327489)) (
327492 340687 (SK.PICK.FONT 327502 . 331774) (SK.CHOOSE.TEXT.FONT 331776 . 336047) (SK.NEXTSIZEFONT
336049 . 337681) (SK.DECREASING.FONT.LIST 337683 . 340685)) (341106 352780 (SK.SET.FONT 341116 .
342383) (SK.SET.TEXT.FONT 342385 . 343387) (SK.SET.TEXT.SIZE 343389 . 344076) (SK.SET.TEXT.HORIZ.ALIGN
344078 . 345652) (SK.READFONTSIZE 345654 . 347552) (SK.COLLECT.FONT.SIZES 347554 . 348635) (
SK.SET.TEXT.VERT.ALIGN 348637 . 350679) (SK.SET.TEXT.LOOKS 350681 . 352138) (SK.SET.DEFAULT.TEXT.FACE
352140 . 352778)) (352781 353367 (CREATE.SKETCH.TERMTABLE 352791 . 353365)) (353368 355134 (
SK.FONT.LIST 353378 . 353704) (SK.INSURE.FONT 353706 . 354228) (SK.INSURE.STYLE 354230 . 354748) (
SK.INSURE.TEXT 354750 . 355132)) (355674 412967 (SKETCH.CREATE.TEXTBOX 355684 . 357326) (
SK.COMPUTE.TEXTBOX.REGION.FOR.STRING 357328 . 359405) (SK.BREAK.INTO.LINES 359407 . 370593) (
SK.BRUSH.SIZE 370595 . 370976) (SK.TEXTBOX.CREATE 370978 . 371775) (SK.TEXTBOX.CREATE1 371777 . 372841
) (SK.UPDATE.TEXTBOX.AFTER.CHANGE 372843 . 373383) (SK.TEXTBOX.POSITION.IN.BOX 373385 . 375296) (
TEXTBOX.CHANGEFN 375298 . 375772) (TEXTBOX.DRAWFN 375774 . 377810) (SK.TEXTURE.AROUND.REGIONS 377812
. 383885) (ALL.EMPTY.REGIONS 383887 . 384377) (TEXTBOX.EXPANDFN 384379 . 391535) (TEXTBOX.INPUTFN
391537 . 393150) (TEXTBOX.INSIDEFN 393152 . 393565) (TEXTBOX.REGIONFN 393567 . 394421) (
TEXTBOX.GLOBALREGIONFN 394423 . 394751) (TEXTBOX.SET.GLOBAL.REGIONS 394753 . 396084) (
TEXTBOX.TRANSLATEFN 396086 . 397927) (TEXTBOX.TRANSLATEPTSFN 397929 . 400712) (TEXTBOX.TRANSFORMFN
400714 . 402382) (TEXTBOX.UPDATEFN 402384 . 404277) (TEXTBOX.READCHANGEFN 404279 . 409168) (
SK.TEXTBOX.TEXT.POSITION 409170 . 409591) (SK.TEXTBOX.FROM.TEXT 409593 . 412198) (ADD.EOLS 412200 .
412965)) (413496 416997 (SK.SET.TEXTBOX.VERT.ALIGN 413506 . 415386) (SK.SET.TEXTBOX.HORIZ.ALIGN 415388
. 416995)) (417380 461855 (SKETCH.CREATE.BOX 417390 . 417873) (SK.BOX.DRAWFN 417875 . 419034) (
BOX.DRAWFN1 419036 . 421875) (KNOTS.OF.REGION 421877 . 423111) (SK.DRAWAREABOX 423113 . 429714) (
SK.DRAWBOX 429716 . 430905) (SK.BOX.EXPANDFN 430907 . 434655) (SK.BOX.GETREGIONFN 434657 . 435843) (
BOX.SET.SCALES 435845 . 437085) (SK.BOX.INPUTFN 437087 . 439020) (SK.BOX.CREATE 439022 . 439723) (
SK.UPDATE.BOX.AFTER.CHANGE 439725 . 440236) (SK.BOX.INSIDEFN 440238 . 440628) (SK.BOX.REGIONFN 440630
. 441343) (SK.BOX.GLOBALREGIONFN 441345 . 442083) (SK.BOX.READCHANGEFN 442085 . 445806) (
SK.CHANGE.FILLING 445808 . 449756) (SK.CHANGE.FILLING.COLOR 449758 . 453414) (SK.BOX.TRANSLATEFN
453416 . 454595) (SK.BOX.TRANSFORMFN 454597 . 455542) (SK.BOX.TRANSLATEPTSFN 455544 . 457912) (
UNSCALE.REGION.TO.GRID 457914 . 458839) (INCREASEREGION 458841 . 459432) (INSUREREGIONSIZE 459434 .
460605) (EXPANDREGION 460607 . 461487) (REGION.FROM.COORDINATES 461489 . 461853)) (462391 488746 (
SKETCH.CREATE.ARC 462401 . 463210) (ARC.DRAWFN 463212 . 464939) (ARC.EXPANDFN 464941 . 467274) (
ARC.INPUTFN 467276 . 471494) (SK.INVERT.CIRCLE 471496 . 472356) (SK.READ.ARC.ANGLE.POINT 472358 .
472865) (SK.SHOW.ARC 472867 . 473477) (ARC.CREATE 473479 . 474834) (SK.UPDATE.ARC.AFTER.CHANGE 474836
. 475176) (ARC.MOVEFN 475178 . 476761) (ARC.TRANSLATEPTS 476763 . 478648) (ARC.INSIDEFN 478650 .
478900) (ARC.REGIONFN 478902 . 480038) (ARC.GLOBALREGIONFN 480040 . 481762) (ARC.TRANSLATE 481764 .
482746) (ARC.TRANSFORMFN 482748 . 485698) (ARC.READCHANGEFN 485700 . 488744)) (488747 497826 (
SK.COMPUTE.ARC.ANGLE.PT 488757 . 489683) (SK.COMPUTE.ARC.ANGLE.PT.FROM.ANGLE 489685 . 490678) (
SK.COMPUTE.ARC.PTS 490680 . 494252) (SK.SET.ARC.DIRECTION 494254 . 494828) (SK.SET.ARC.DIRECTION.CW
494830 . 495004) (SK.SET.ARC.DIRECTION.CCW 495006 . 495279) (SK.COMPUTE.SLOPE.OF.LINE 495281 . 495773)
(SK.CREATE.ARC.USING 495775 . 497012) (SET.ARC.SCALES 497014 . 497824)) (497827 498272 (
SK.INSURE.DIRECTION 497837 . 498270)) (499643 545502 (GETSKETCHELEMENTPROP 499653 . 500961) (
\SK.GET.ARC.ANGLEPT 500963 . 501524) (\GETSKETCHELEMENTPROP1 501526 . 501780) (\SK.GET.BRUSH 501782 .
502706) (\SK.GET.FILLING 502708 . 503806) (\SK.GET.ARROWHEADS 503808 . 504587) (\SK.GET.FONT 504589 .
505069) (\SK.GET.JUSTIFICATION 505071 . 505595) (\SK.GET.DIRECTION 505597 . 506074) (\SK.GET.DASHING
506076 . 507095) (PUTSKETCHELEMENTPROP 507097 . 509366) (\SK.PUT.FILLING 509368 . 510638) (
ADDSKETCHELEMENTPROP 510640 . 511445) (REMOVESKETCHELEMENTPROP 511447 . 512236) (\SK.PUT.FONT 512238
. 513052) (\SK.PUT.JUSTIFICATION 513054 . 514065) (\SK.PUT.DIRECTION 514067 . 514674) (
\SK.PUT.DASHING 514676 . 516011) (\SK.PUT.BRUSH 516013 . 517932) (\SK.PUT.ARROWHEADS 517934 . 519900)
(SK.COPY.ELEMENT.PROPERTY.LIST 519902 . 520478) (SKETCH.UPDATE 520480 . 521210) (SKETCH.UPDATE1 521212
. 522500) (\SKELT.GET.SCALE 522502 . 523490) (\SKELT.PUT.SCALE 523492 . 524799) (\SKELT.PUT.DATA
524801 . 526598) (SK.REPLACE.TEXT.IN.ELEMENT 526600 . 527553) (\SKELT.GET.DATA 527555 . 528622) (
\SK.GET.1STCONTROLPT 528624 . 530136) (\SK.PUT.1STCONTROLPT 530138 . 535611) (\SK.GET.2NDCONTROLPT
535613 . 536528) (\SK.PUT.2NDCONTROLPT 536530 . 540718) (\SK.GET.3RDCONTROLPT 540720 . 541598) (
\SK.PUT.3RDCONTROLPT 541600 . 545500)) (545503 546084 (LOWERLEFTCORNER 545513 . 545759) (
UPPERRIGHTCORNER 545761 . 546082)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Dec-2023 00:08:46" {WMEDLEY}<library>sketch>SKETCH-OPS.;1 221752
(FILECREATED "14-Dec-2025 00:35:27" {WMEDLEY}<library>sketch>SKETCH-OPS.;9 220612
:EDIT-BY rmk
:CHANGES-TO (RECORDS AFFINETRANSFORMATION SKHISTEVENT SKEVENTTYPE SKETCHVIEW)
:CHANGES-TO (FNS SK.PRINTER.FILE.CANDIDATE.NAME)
:PREVIOUS-DATE " 3-May-2023 21:06:28" {WMEDLEY}<library>sketch>SKETCHOPS.;2)
:PREVIOUS-DATE "29-Nov-2025 21:49:05" {WMEDLEY}<library>sketch>SKETCH-OPS.;8)
(PRETTYCOMPRINT SKETCH-OPSCOMS)
@@ -17,9 +17,8 @@
(COMS
(* ;; "miscellaneous utility functions")
(FNS SK.FONTNAMELIST SCALE.REGION.OUT SK.SCALE.POSITION.INTO.VIEWER
SK.SCALE.POSITION.INTO.VIEWER.EXACT SK.MAKE.POSITION.INTEGER
SCALE.POSITION.INTO.SKETCHW UNSCALE UNSCALE.REGION)
(FNS SCALE.REGION.OUT SK.SCALE.POSITION.INTO.VIEWER SK.SCALE.POSITION.INTO.VIEWER.EXACT
SK.MAKE.POSITION.INTEGER SCALE.POSITION.INTO.SKETCHW UNSCALE UNSCALE.REGION)
(* ;; "misc IO functions")
@@ -45,9 +44,8 @@
(FNS SKETCHW.HARDCOPYFN SK.LIST.IMAGE SK.HARDCOPYIMAGEW)
(FNS SK.DO.HARDCOPYIMAGEW.TOFILE SK.HARDCOPYIMAGEW.TOFILE
SK.HARDCOPYIMAGEW.TOPRINTER SK.LIST.IMAGE.ON.FILE)
(FNS \SK.LIST.PAGE.IMAGE SK.GetImageFile SK.PRINTER.FILE.CANDIDATE.NAME
SK.SET.HARDCOPY.MODE SK.UNSET.HARDCOPY.MODE SK.UPDATE.AFTER.HARDCOPY
DEFAULTPRINTINGIMAGETYPE SK.SWITCH.REGION.X.AND.Y)
(FNS \SK.LIST.PAGE.IMAGE SK.PRINTER.FILE.CANDIDATE.NAME SK.SET.HARDCOPY.MODE
SK.UNSET.HARDCOPY.MODE SK.UPDATE.AFTER.HARDCOPY SK.SWITCH.REGION.X.AND.Y)
(CONSTANTS MICASPERPT IMICASPERPT PTSPERMICA)))
(COMS
(* ;; "fns to implement transformations on the elements")
@@ -140,8 +138,8 @@
SK.NAME.CURRENT.VIEW SKETCH.ADD.VIEW SK.RESTORE.VIEW SK.FORGET.VIEW)
(DECLARE%: DONTCOPY (RECORDS SKETCHVIEW)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
SKETCH SKETCHELEMENTS SKETCHOBJ
SKETCHEDIT INTERPRESS))
SKETCH SKETCH-ELEMENTS SKETCH-OBJ
SKETCH-EDIT INTERPRESS))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA STATUSPRINT])
@@ -157,12 +155,6 @@
(DEFINEQ
(SK.FONTNAMELIST
[LAMBDA (FONTDESC) (* rrb " 2-NOV-83 21:00")
(LIST (FONTPROP FONTDESC 'FAMILY)
(FONTPROP FONTDESC 'SIZE)
(FONTPROP FONTDESC 'FACE])
(SCALE.REGION.OUT
[LAMBDA (REGION SCALE) (* rrb "30-Dec-85 17:24")
@@ -700,7 +692,8 @@
(DEFINEQ
(SKETCHW.HARDCOPYFN
[LAMBDA (SKETCHW OPENIMAGESTREAM) (* ; "Edited 20-Aug-92 13:33 by jds")
[LAMBDA (SKETCHW OPENIMAGESTREAM) (* ; "Edited 3-Nov-2025 19:55 by rmk")
(* ; "Edited 20-Aug-92 13:33 by jds")
(* ;
 "dumps the sketch onto OPENIMAGESTREAM.")
(* ;
@@ -728,7 +721,9 @@
(* ;; "PAGETOSKETCHFACTOR is the factor to multiply the page coordinates by to get into sketch coordinates.")
(STATUSPRINT SKETCHW "Hardcopying ...")
(STATUSPRINT SKETCHW "Hardcopying" (CL:UNLESS (STREAMP (FULLNAME OPENIMAGESTREAM))
(CONCAT " to " (FULLNAME OPENIMAGESTREAM)))
" ...")
[STREAMPROP OPENIMAGESTREAM 'PRINTOPTIONS (APPEND (LIST 'DOCUMENT.NAME (OR (SKETCH.TITLE
SKETCHW)
"A Sketch"))
@@ -950,15 +945,12 @@
(DEFINEQ
(SK.DO.HARDCOPYIMAGEW.TOFILE
[LAMBDA (W) (* rrb " 5-May-86 13:38")
(* sketch version of
 HARDCOPYIMAGEW.TOFILE that accepts a
 candidate file name.)
(RESETFORM (TTY.PROCESS (THIS.PROCESS))
(LET [(FILE&TYPE (SK.GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME W]
(COND
(FILE&TYPE (HARDCOPY.SOMEHOW W (CAR FILE&TYPE)
(CDR FILE&TYPE])
[LAMBDA (W) (* ; "Edited 4-Nov-2025 21:47 by rmk")
(* ; "Edited 3-Nov-2025 16:17 by rmk")
(* rrb " 5-May-86 13:38")
(* ;
 "sketch version of HARDCOPYIMAGEW.TOFILE that accepts a candidate file name.")
(HARDCOPY.SOMEHOW W (GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME W])
(SK.HARDCOPYIMAGEW.TOFILE
[LAMBDA (SKW) (* rrb " 5-May-86 13:34")
@@ -981,16 +973,16 @@
'SketchHardcopy])
(SK.LIST.IMAGE.ON.FILE
[LAMBDA (SKETCHW) (* rrb " 5-May-86 13:39")
[LAMBDA (SKETCHW) (* ; "Edited 4-Nov-2025 21:46 by rmk")
(* ; "Edited 3-Nov-2025 16:20 by rmk")
(* rrb " 5-May-86 13:39")
(* makes a file suitable for the default printing host of the current sketch.
 Pretty dumb about file names.)
(* ;; "makes a file suitable for the default printing host of the current sketch. Pretty dumb about file names.")
(RESETFORM (TTY.PROCESS (THIS.PROCESS))
(LET [(FILE&TYPE (SK.GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME SKETCHW]
(COND
(FILE&TYPE (SK.LIST.IMAGE SKETCHW (CAR FILE&TYPE)
(CDR FILE&TYPE])
(LET [(FILE&TYPE (GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME SKETCHW]
(CL:WHEN FILE&TYPE
(SK.LIST.IMAGE SKETCHW (CAR FILE&TYPE)
(CDR FILE&TYPE)))])
)
(DEFINEQ
@@ -1027,46 +1019,21 @@
PAGETOSKETCHFACTOR OPENIMAGESTREAM T))
(DRAW.LOCAL.SKETCH SKETCHX OPENIMAGESTREAM REGIONONPAGE])
(SK.GetImageFile
[LAMBDA (CANDIDATE) (* rrb " 5-May-86 10:41")
(* version of GetImageFile that takes
 a candidate name.)
(PROG ((FILE (PopUpWindowAndGetAtom "File name (CR to abort): " CANDIDATE))
PRINTFILETYPE FILETYPEMENU EXTENSIONSUPPLIED EXTENSIONFORTYPE)
(COND
((NULL FILE)
(RETURN)))
(SETQ FILETYPEMENU (MakeMenuOfImageTypes "File type?"))
(COND
((SETQ PRINTFILETYPE (PRINTFILETYPE.FROM.EXTENSION FILE))
(RETURN (CONS FILE PRINTFILETYPE)))
(T (SETQ PRINTFILETYPE (MENU FILETYPEMENU))
(COND
((NULL PRINTFILETYPE)
(RETURN))
(T (RETURN (CONS FILE PRINTFILETYPE])
(SK.PRINTER.FILE.CANDIDATE.NAME
[LAMBDA (VIEWER) (* rrb " 5-May-86 13:30")
[LAMBDA (VIEWER) (* ; "Edited 14-Dec-2025 00:33 by rmk")
(* ; "Edited 3-Nov-2025 16:05 by rmk")
(* rrb " 5-May-86 13:30")
(* * returns the preferred printer file name for a viewer)
(* ;; "Returns the preferred imagefile name for a viewer.")
(PROG ((FILENAME (SK.OUTPUT.FILE.NAME (SKETCH.TITLE VIEWER)))
EXTENSION PRINTEXTENSION)
(OR FILENAME (RETURN))
[COND
((EQ (SELECTQ (SETQ PRINTEXTENSION (DEFAULTPRINTINGIMAGETYPE))
(INTERPRESS (SETQ PRINTEXTENSION 'IP))
NIL)
(FILENAMEFIELD FILENAME 'EXTENSION))
(* ;; "RMK: Original had IP built in in some way, odd conditions, plus an unbound variable. I assume that the extension of the filename is something like .SKETCH and not usually .IP (or now .PDF). And that therefore the intent is really that the result should have the extension that the deffaultprinting host can print directly.")
(* file name has a printer extension for some reason, propose either a null
 extension or hdcpy extension.)
(COND
(PRINTEXTENSION (SETQ PRINTEREXTENSION NIL))
(T (SETQ PRINTEREXTENSION 'HDCPY]
(RETURN (PACKFILENAME 'EXTENSION PRINTEXTENSION 'BODY FILENAME])
(LET ((FILENAME (SK.OUTPUT.FILE.NAME (SKETCH.TITLE VIEWER)))
PRINTEXTENSION)
(CL:WHEN [AND FILENAME (SETQ PRINTEXTENSION (CAR (EXTENSIONS.FOR.IMAGEFILETYPE (
CAN.PRINT.DIRECTLY
]
(PACKFILENAME 'EXTENSION PRINTEXTENSION 'BODY FILENAME))])
(SK.SET.HARDCOPY.MODE
[LAMBDA (SKETCHW IMAGETYPE) (* rrb "28-Oct-85 16:43")
@@ -1121,15 +1088,6 @@
(VIEWER.SCALE SKETCHW))
(REDISPLAYW SKETCHW])
(DEFAULTPRINTINGIMAGETYPE
[LAMBDA NIL (* rrb "20-Mar-85 12:45")
(* returns the image type of the
 default printer.)
(* code copied from OPENIMAGESTREAM)
(CAR (MKLIST (PRINTERPROP (PRINTERTYPE (OR (CAR (LISTP DEFAULTPRINTINGHOST))
DEFAULTPRINTINGHOST))
'CANPRINT])
(SK.SWITCH.REGION.X.AND.Y
[LAMBDA (REGION) (* rrb " 3-Sep-85 14:50")
(* switchs the X and Y dimensions of a
@@ -1145,7 +1103,7 @@
(RPAQQ IMICASPERPT 35)
(RPAQQ PTSPERMICA 0.02834646)
(RPAQQ PTSPERMICA 0.028346457)
(CONSTANTS MICASPERPT IMICASPERPT PTSPERMICA)
@@ -2884,10 +2842,12 @@ If you meant this, you should use the TWO PT TRANSFORM.")
(STATUSPRINT SKW "Element subsequently modified, can't undo"])
(SK.UNDO.LAST
[LAMBDA (SKW) (* rrb " 5-Dec-85 17:19")
(* undoes the first not yet undone
 history event.)
[LAMBDA (SKW) (* ; "Edited 29-Nov-2025 21:48 by rmk")
(* rrb " 5-Dec-85 17:19")
(* ;
 "undoes the first not yet undone history event.")
(SKED.CLEAR.SELECTION SKW)
(CLEARPROMPTWINDOW SKW)
(PROG [EVENT UNDOFN (HISTLST (WINDOWPROP SKW 'SKETCHHISTORY]
(COND
((NULL HISTLST)
@@ -2905,8 +2865,8 @@ If you meant this, you should use the TWO PT TRANSFORM.")
do (RETURN HISTEVENT)))
(COND
((APPLY* UNDOFN (fetch (SKHISTEVENT EVENTARGS) of EVENT)
SKW EVENT) (* only add to history list if
 something happened.)
SKW EVENT) (* ;
 "only add to history list if something happened.")
(STATUSPRINT SKW (SK.UNDO.NAME EVENT)
" event undone.")
(replace (SKHISTEVENT UNDONE?) of EVENT with T)
@@ -4094,7 +4054,7 @@ It can be either larger or smaller than the present window size.")
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
SKETCH SKETCHELEMENTS SKETCHOBJ SKETCHEDIT INTERPRESS)
SKETCH SKETCH-ELEMENTS SKETCH-OBJ SKETCH-EDIT INTERPRESS)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -4105,85 +4065,84 @@ It can be either larger or smaller than the present window size.")
(ADDTOVAR LAMA STATUSPRINT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (9853 14154 (SK.FONTNAMELIST 9863 . 10085) (SCALE.REGION.OUT 10087 . 11068) (
SK.SCALE.POSITION.INTO.VIEWER 11070 . 11826) (SK.SCALE.POSITION.INTO.VIEWER.EXACT 11828 . 12370) (
SK.MAKE.POSITION.INTEGER 12372 . 13040) (SCALE.POSITION.INTO.SKETCHW 13042 . 13434) (UNSCALE 13436 .
13564) (UNSCALE.REGION 13566 . 14152)) (14190 17888 (STATUSPRINT 14200 . 15562) (CLEARPROMPTWINDOW
15564 . 15971) (CLOSEPROMPTWINDOW 15973 . 16470) (MYGETPROMPTWINDOW 16472 . 17171) (PROMPT.GETINPUT
17173 . 17886)) (17946 28977 (SK.SEND.TO.BOTTOM 17956 . 18295) (SK.BRING.TO.TOP 18297 . 18665) (
SK.SWITCH.PRIORITIES 18667 . 18993) (SK.SEL.AND.CHANGE.PRIORITY 18995 . 19563) (
SK.SEL.AND.SWITCH.PRIORITIES 19565 . 21332) (SK.SORT.ELTS.BY.PRIORITY 21334 . 22055) (
SK.SORT.GELTS.BY.PRIORITY 22057 . 22636) (SORT.CHANGESPECS.BY.NEW.PRIORITY 22638 . 23326) (
SORT.CHANGESPECS.BY.OLD.PRIORITY 23328 . 24016) (SK.SEND.ELEMENTS.TO.BOTTOM 24018 . 25689) (
SK.BRING.ELEMENTS.TO.TOP 25691 . 27375) (SK.COPY.GLOBAL.ELEMENT.AND.PROPERTY.LIST 27377 . 28975)) (
28978 31834 (SK.ELEMENT.PRIORITY 28988 . 29316) (SK.SET.ELEMENT.PRIORITY 29318 . 30262) (
SK.POP.NEXT.PRIORITY 30264 . 30607) (SK.PRIORITY.CELL 30609 . 30814) (SK.HIGH.PRIORITY 30816 . 31319)
(SK.LOW.PRIORITY 31321 . 31832)) (31897 38700 (DRAW.LOCAL.SKETCH 31907 . 32909) (SET.PRIORITYIMPORTANT
32911 . 33479) (SK.FIGUREIMAGE 33481 . 38698)) (38744 57418 (SKETCHW.HARDCOPYFN 38754 . 45959) (
SK.LIST.IMAGE 45961 . 57068) (SK.HARDCOPYIMAGEW 57070 . 57416)) (57419 59376 (
SK.DO.HARDCOPYIMAGEW.TOFILE 57429 . 58103) (SK.HARDCOPYIMAGEW.TOFILE 58105 . 58467) (
SK.HARDCOPYIMAGEW.TOPRINTER 58469 . 58831) (SK.LIST.IMAGE.ON.FILE 58833 . 59374)) (59377 67301 (
\SK.LIST.PAGE.IMAGE 59387 . 61819) (SK.GetImageFile 61821 . 62751) (SK.PRINTER.FILE.CANDIDATE.NAME
62753 . 63672) (SK.SET.HARDCOPY.MODE 63674 . 65059) (SK.UNSET.HARDCOPY.MODE 65061 . 65479) (
SK.UPDATE.AFTER.HARDCOPY 65481 . 66189) (DEFAULTPRINTINGIMAGETYPE 66191 . 66781) (
SK.SWITCH.REGION.X.AND.Y 66783 . 67299)) (67539 80436 (SK.SEL.AND.TRANSFORM 67549 . 67899) (
SK.TRANSFORM.ELEMENTS 67901 . 69156) (SK.TRANSFORM.ITEM 69158 . 69959) (SK.TRANSFORM.ELEMENT 69961 .
70419) (SK.TRANSFORM.POINT 70421 . 70771) (SK.TRANSFORM.POINT.LIST 70773 . 70994) (SK.TRANSFORM.REGION
70996 . 73182) (SK.PUT.ELTS.ON.GRID 73184 . 73662) (SK.TRANSFORM.GLOBAL.ELEMENTS 73664 . 74166) (
GLOBALELEMENTP 74168 . 74459) (SKETCH.LIST.OF.ELEMENTSP 74461 . 74765) (SK.TRANSFORM.SCALE.FACTOR
74767 . 76460) (SK.TRANSFORM.BRUSH 76462 . 76929) (SK.TRANSFORM.ARROWHEADS 76931 . 78522) (SCALE.BRUSH
78524 . 80434)) (80437 100629 (TWO.PT.TRANSFORMATION.INPUTFN 80447 . 83220) (SK.TWO.PT.TRANSFORM.ELTS
83222 . 83627) (SK.SEL.AND.TWO.PT.TRANSFORM 83629 . 84220) (SK.APPLY.AFFINE.TRANSFORM 84222 . 85341)
(SK.COMPUTE.TWO.PT.TRANSFORMATION 85343 . 89681) (SK.COMPUTE.SLOPE 89683 . 90448) (
SK.THREE.PT.TRANSFORM.ELTS 90450 . 90861) (SK.COMPUTE.THREE.PT.TRANSFORMATION 90863 . 95400) (
SK.SEL.AND.THREE.PT.TRANSFORM 95402 . 95999) (THREE.PT.TRANSFORMATION.INPUTFN 96001 . 100627)) (100630
104657 (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS 100640 . 101059) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM 101061
. 101682) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS 101684 . 102113) (SK.SEL.COPY.AND.THREE.PT.TRANSFORM
102115 . 102739) (SK.COPY.AND.TRANSFORM.ELEMENTS 102741 . 103785) (SK.COPY.AND.TRANSFORM.ITEM 103787
. 104655)) (106785 109980 (SK.SHOWMARKS 106795 . 107695) (MARKPOINT 107697 . 108417) (SK.MARKHOTSPOTS
108419 . 109494) (SK.MARK.SELECTION 109496 . 109978)) (110509 117287 (SK.SELECT.ITEM 110519 . 113179)
(IN.SKETCH.ELT? 113181 . 115567) (SK.MARK.HOTSPOT 115569 . 116051) (SK.MARK.POSITION 116053 . 116490)
(SK.SELECT.ELT 116492 . 116919) (SK.DESELECT.ELT 116921 . 117285)) (117430 130244 (SK.HOTSPOT.CACHE
117440 . 117784) (SK.HOTSPOT.CACHE.FOR.OPERATION 117786 . 119141) (SK.BUILD.CACHE 119143 . 119966) (
SK.ELEMENT.PROTECTED? 119968 . 120561) (SK.HAS.SOME.HOTSPOTS 120563 . 121017) (SK.SET.HOTSPOT.CACHE
121019 . 121374) (SK.CREATE.HOTSPOT.CACHE 121376 . 121826) (SK.ELTS.FROM.HOTSPOT 121828 . 122668) (
SK.ADD.HOTSPOTS.TO.CACHE 122670 . 123071) (SK.ADD.HOTSPOTS.TO.CACHE1 123073 . 123619) (
SK.ADD.HOTSPOT.TO.CACHE 123621 . 125497) (SK.REMOVE.HOTSPOTS.FROM.CACHE 125499 . 125902) (
SK.REMOVE.HOTSPOTS.FROM.CACHE1 125904 . 126422) (SK.REMOVE.HOTSPOT.FROM.CACHE 126424 . 126987) (
SK.REMOVE.VALUE.FROM.CACHE.BUCKET 126989 . 127958) (SK.FIND.CACHE.BUCKET 127960 . 128549) (
SK.ADD.VALUE.TO.CACHE.BUCKET 128551 . 130242)) (130272 149715 (SK.SET.GRID 130282 . 130703) (
SK.DISPLAY.GRID 130705 . 131254) (SK.DISPLAY.GRID.POINTS 131256 . 131452) (SK.REMOVE.GRID.POINTS
131454 . 132257) (SK.TAKE.DOWN.GRID 132259 . 132570) (SK.SHOW.GRID 132572 . 136186) (SK.GRIDFACTOR
136188 . 136709) (SK.TURN.GRID.ON 136711 . 137039) (SK.TURN.GRID.OFF 137041 . 137399) (
SK.MAKE.GRID.LARGER 137401 . 138133) (SK.MAKE.GRID.SMALLER 138135 . 138888) (SK.CHANGE.GRID 138890 .
139338) (GRID.FACTOR1 139340 . 139697) (LEASTPOWEROF2GT 139699 . 140473) (GREATESTPOWEROF2LT 140475 .
141090) (SK.DEFAULT.GRIDFACTOR 141092 . 141645) (SK.PUT.ON.GRID 141647 . 142205) (MAP.WINDOW.ONTO.GRID
142207 . 142641) (MAP.SCREEN.ONTO.GRID 142643 . 143131) (MAP.GLOBAL.PT.ONTO.GRID 143133 . 143515) (
MAP.GLOBAL.REGION.ONTO.GRID 143517 . 145234) (MAP.WINDOW.POINT.ONTO.GLOBAL.GRID 145236 . 145779) (
MAP.WINDOW.ONTO.GLOBAL.GRID 145781 . 146166) (SK.UPDATE.GRIDFACTOR 146168 . 146804) (
SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID 146806 . 147344) (SK.MAP.INPUT.PT.TO.GLOBAL 147346 . 148563) (
SK.MAP.FROM.WINDOW.TO.NEAREST.GRID 148565 . 149713)) (149855 158278 (SK.ADD.HISTEVENT 149865 . 151000)
(SK.SEL.AND.UNDO 151002 . 153916) (SK.UNDO.LAST 153918 . 155995) (SK.UNDO.NAME 155997 . 156501) (
SKEVENTTYPEFNS 156503 . 156853) (SK.TYPE.OF.FIRST.ARG 156855 . 158276)) (158279 158965 (SK.DELETE.UNDO
158289 . 158718) (SK.ADD.UNDO 158720 . 158963)) (158966 165748 (SK.CHANGE.UNDO 158976 . 160959) (
SK.ELT.IN.SKETCH? 160961 . 161215) (SK.CHANGE.REDO 161217 . 163085) (SK.MOVE.UNDO 163087 . 164480) (
SK.MOVE.REDO 164482 . 165746)) (165749 167848 (SK.UNDO.UNDO 165759 . 167025) (SK.UNDO.MENULABEL 167027
. 167422) (SK.LABEL.FROM.TYPE 167424 . 167846)) (168698 176540 (SHOW.GLOBAL.COORDS 168708 . 169257) (
LOCATOR.CLOSEFN 169259 . 169544) (SKETCHW.FROM.LOCATOR 169546 . 169954) (SKETCHW.UPDATE.LOCATORS
169956 . 170542) (LOCATOR.UPDATE 170544 . 171302) (UPDATE.GLOBAL.LOCATOR 171304 . 172105) (
UPDATE.GLOBALCOORD.LOCATOR 172107 . 172684) (ADD.GLOBAL.DISPLAY 172686 . 173603) (
ADD.GLOBAL.GRIDDED.DISPLAY 173605 . 173864) (CREATE.GLOBAL.DISPLAYER 173866 . 174943) (
UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR 174945 . 176538)) (176747 189234 (DISPLAYREADCOLORHLSLEVELS 176757
. 177593) (DISPLAYREADCOLORLEVEL 177595 . 178630) (DRAWREADCOLORBOX 178632 . 179621) (
READ.CHANGE.COLOR 179623 . 179840) (READCOLOR1 179842 . 182756) (READCOLORCOMMANDMENUSELECTEDFN 182758
. 183125) (READCOLOR2 183127 . 189232)) (189235 190694 (CREATE.CNS.MENU 189245 . 190692)) (190971
193681 (SK.ABSWXOFFSET 190981 . 191275) (SK.ABSWYOFFSET 191277 . 191571) (
SK.UNSCALE.POSITION.FROM.VIEWER 191573 . 192142) (SK.SCALE.REGION 192144 . 193679)) (193720 208718 (
VIEWER.SCALE 193730 . 194039) (SKETCH.ZOOM 194041 . 195076) (SAME.ASPECT.RATIO 195078 . 196442) (
SKETCH.DO.ZOOM 196444 . 197649) (SKETCH.NEW.VIEW 197651 . 198166) (ZOOM.UPDATE.ELT 198168 . 199061) (
SK.UPDATE.AFTER.SCALE.CHANGE 199063 . 200932) (SKETCH.AUTOZOOM 200934 . 205354) (
SKETCH.GLOBAL.REGION.ZOOM 205356 . 208716)) (209355 221267 (SKETCH.HOME 209365 . 209892) (SK.FRAME.IT
209894 . 210486) (SK.FRAME.WINDOW.TO.SKETCH 210488 . 214334) (SK.MOVE.TO.VIEW 214336 . 215750) (
SK.NAME.CURRENT.VIEW 215752 . 216862) (SKETCH.ADD.VIEW 216864 . 217957) (SK.RESTORE.VIEW 217959 .
219835) (SK.FORGET.VIEW 219837 . 221265)))))
(FILEMAP (NIL (9724 13801 (SCALE.REGION.OUT 9734 . 10715) (SK.SCALE.POSITION.INTO.VIEWER 10717 . 11473
) (SK.SCALE.POSITION.INTO.VIEWER.EXACT 11475 . 12017) (SK.MAKE.POSITION.INTEGER 12019 . 12687) (
SCALE.POSITION.INTO.SKETCHW 12689 . 13081) (UNSCALE 13083 . 13211) (UNSCALE.REGION 13213 . 13799)) (
13837 17535 (STATUSPRINT 13847 . 15209) (CLEARPROMPTWINDOW 15211 . 15618) (CLOSEPROMPTWINDOW 15620 .
16117) (MYGETPROMPTWINDOW 16119 . 16818) (PROMPT.GETINPUT 16820 . 17533)) (17593 28624 (
SK.SEND.TO.BOTTOM 17603 . 17942) (SK.BRING.TO.TOP 17944 . 18312) (SK.SWITCH.PRIORITIES 18314 . 18640)
(SK.SEL.AND.CHANGE.PRIORITY 18642 . 19210) (SK.SEL.AND.SWITCH.PRIORITIES 19212 . 20979) (
SK.SORT.ELTS.BY.PRIORITY 20981 . 21702) (SK.SORT.GELTS.BY.PRIORITY 21704 . 22283) (
SORT.CHANGESPECS.BY.NEW.PRIORITY 22285 . 22973) (SORT.CHANGESPECS.BY.OLD.PRIORITY 22975 . 23663) (
SK.SEND.ELEMENTS.TO.BOTTOM 23665 . 25336) (SK.BRING.ELEMENTS.TO.TOP 25338 . 27022) (
SK.COPY.GLOBAL.ELEMENT.AND.PROPERTY.LIST 27024 . 28622)) (28625 31481 (SK.ELEMENT.PRIORITY 28635 .
28963) (SK.SET.ELEMENT.PRIORITY 28965 . 29909) (SK.POP.NEXT.PRIORITY 29911 . 30254) (SK.PRIORITY.CELL
30256 . 30461) (SK.HIGH.PRIORITY 30463 . 30966) (SK.LOW.PRIORITY 30968 . 31479)) (31544 38347 (
DRAW.LOCAL.SKETCH 31554 . 32556) (SET.PRIORITYIMPORTANT 32558 . 33126) (SK.FIGUREIMAGE 33128 . 38345))
(38391 57335 (SKETCHW.HARDCOPYFN 38401 . 45876) (SK.LIST.IMAGE 45878 . 56985) (SK.HARDCOPYIMAGEW
56987 . 57333)) (57336 59339 (SK.DO.HARDCOPYIMAGEW.TOFILE 57346 . 57943) (SK.HARDCOPYIMAGEW.TOFILE
57945 . 58307) (SK.HARDCOPYIMAGEW.TOPRINTER 58309 . 58671) (SK.LIST.IMAGE.ON.FILE 58673 . 59337)) (
59340 66025 (\SK.LIST.PAGE.IMAGE 59350 . 61782) (SK.PRINTER.FILE.CANDIDATE.NAME 61784 . 62988) (
SK.SET.HARDCOPY.MODE 62990 . 64375) (SK.UNSET.HARDCOPY.MODE 64377 . 64795) (SK.UPDATE.AFTER.HARDCOPY
64797 . 65505) (SK.SWITCH.REGION.X.AND.Y 65507 . 66023)) (66264 79161 (SK.SEL.AND.TRANSFORM 66274 .
66624) (SK.TRANSFORM.ELEMENTS 66626 . 67881) (SK.TRANSFORM.ITEM 67883 . 68684) (SK.TRANSFORM.ELEMENT
68686 . 69144) (SK.TRANSFORM.POINT 69146 . 69496) (SK.TRANSFORM.POINT.LIST 69498 . 69719) (
SK.TRANSFORM.REGION 69721 . 71907) (SK.PUT.ELTS.ON.GRID 71909 . 72387) (SK.TRANSFORM.GLOBAL.ELEMENTS
72389 . 72891) (GLOBALELEMENTP 72893 . 73184) (SKETCH.LIST.OF.ELEMENTSP 73186 . 73490) (
SK.TRANSFORM.SCALE.FACTOR 73492 . 75185) (SK.TRANSFORM.BRUSH 75187 . 75654) (SK.TRANSFORM.ARROWHEADS
75656 . 77247) (SCALE.BRUSH 77249 . 79159)) (79162 99354 (TWO.PT.TRANSFORMATION.INPUTFN 79172 . 81945)
(SK.TWO.PT.TRANSFORM.ELTS 81947 . 82352) (SK.SEL.AND.TWO.PT.TRANSFORM 82354 . 82945) (
SK.APPLY.AFFINE.TRANSFORM 82947 . 84066) (SK.COMPUTE.TWO.PT.TRANSFORMATION 84068 . 88406) (
SK.COMPUTE.SLOPE 88408 . 89173) (SK.THREE.PT.TRANSFORM.ELTS 89175 . 89586) (
SK.COMPUTE.THREE.PT.TRANSFORMATION 89588 . 94125) (SK.SEL.AND.THREE.PT.TRANSFORM 94127 . 94724) (
THREE.PT.TRANSFORMATION.INPUTFN 94726 . 99352)) (99355 103382 (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS 99365
. 99784) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM 99786 . 100407) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS
100409 . 100838) (SK.SEL.COPY.AND.THREE.PT.TRANSFORM 100840 . 101464) (SK.COPY.AND.TRANSFORM.ELEMENTS
101466 . 102510) (SK.COPY.AND.TRANSFORM.ITEM 102512 . 103380)) (105510 108705 (SK.SHOWMARKS 105520 .
106420) (MARKPOINT 106422 . 107142) (SK.MARKHOTSPOTS 107144 . 108219) (SK.MARK.SELECTION 108221 .
108703)) (109234 116012 (SK.SELECT.ITEM 109244 . 111904) (IN.SKETCH.ELT? 111906 . 114292) (
SK.MARK.HOTSPOT 114294 . 114776) (SK.MARK.POSITION 114778 . 115215) (SK.SELECT.ELT 115217 . 115644) (
SK.DESELECT.ELT 115646 . 116010)) (116155 128969 (SK.HOTSPOT.CACHE 116165 . 116509) (
SK.HOTSPOT.CACHE.FOR.OPERATION 116511 . 117866) (SK.BUILD.CACHE 117868 . 118691) (
SK.ELEMENT.PROTECTED? 118693 . 119286) (SK.HAS.SOME.HOTSPOTS 119288 . 119742) (SK.SET.HOTSPOT.CACHE
119744 . 120099) (SK.CREATE.HOTSPOT.CACHE 120101 . 120551) (SK.ELTS.FROM.HOTSPOT 120553 . 121393) (
SK.ADD.HOTSPOTS.TO.CACHE 121395 . 121796) (SK.ADD.HOTSPOTS.TO.CACHE1 121798 . 122344) (
SK.ADD.HOTSPOT.TO.CACHE 122346 . 124222) (SK.REMOVE.HOTSPOTS.FROM.CACHE 124224 . 124627) (
SK.REMOVE.HOTSPOTS.FROM.CACHE1 124629 . 125147) (SK.REMOVE.HOTSPOT.FROM.CACHE 125149 . 125712) (
SK.REMOVE.VALUE.FROM.CACHE.BUCKET 125714 . 126683) (SK.FIND.CACHE.BUCKET 126685 . 127274) (
SK.ADD.VALUE.TO.CACHE.BUCKET 127276 . 128967)) (128997 148440 (SK.SET.GRID 129007 . 129428) (
SK.DISPLAY.GRID 129430 . 129979) (SK.DISPLAY.GRID.POINTS 129981 . 130177) (SK.REMOVE.GRID.POINTS
130179 . 130982) (SK.TAKE.DOWN.GRID 130984 . 131295) (SK.SHOW.GRID 131297 . 134911) (SK.GRIDFACTOR
134913 . 135434) (SK.TURN.GRID.ON 135436 . 135764) (SK.TURN.GRID.OFF 135766 . 136124) (
SK.MAKE.GRID.LARGER 136126 . 136858) (SK.MAKE.GRID.SMALLER 136860 . 137613) (SK.CHANGE.GRID 137615 .
138063) (GRID.FACTOR1 138065 . 138422) (LEASTPOWEROF2GT 138424 . 139198) (GREATESTPOWEROF2LT 139200 .
139815) (SK.DEFAULT.GRIDFACTOR 139817 . 140370) (SK.PUT.ON.GRID 140372 . 140930) (MAP.WINDOW.ONTO.GRID
140932 . 141366) (MAP.SCREEN.ONTO.GRID 141368 . 141856) (MAP.GLOBAL.PT.ONTO.GRID 141858 . 142240) (
MAP.GLOBAL.REGION.ONTO.GRID 142242 . 143959) (MAP.WINDOW.POINT.ONTO.GLOBAL.GRID 143961 . 144504) (
MAP.WINDOW.ONTO.GLOBAL.GRID 144506 . 144891) (SK.UPDATE.GRIDFACTOR 144893 . 145529) (
SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID 145531 . 146069) (SK.MAP.INPUT.PT.TO.GLOBAL 146071 . 147288) (
SK.MAP.FROM.WINDOW.TO.NEAREST.GRID 147290 . 148438)) (148580 157135 (SK.ADD.HISTEVENT 148590 . 149725)
(SK.SEL.AND.UNDO 149727 . 152641) (SK.UNDO.LAST 152643 . 154852) (SK.UNDO.NAME 154854 . 155358) (
SKEVENTTYPEFNS 155360 . 155710) (SK.TYPE.OF.FIRST.ARG 155712 . 157133)) (157136 157822 (SK.DELETE.UNDO
157146 . 157575) (SK.ADD.UNDO 157577 . 157820)) (157823 164605 (SK.CHANGE.UNDO 157833 . 159816) (
SK.ELT.IN.SKETCH? 159818 . 160072) (SK.CHANGE.REDO 160074 . 161942) (SK.MOVE.UNDO 161944 . 163337) (
SK.MOVE.REDO 163339 . 164603)) (164606 166705 (SK.UNDO.UNDO 164616 . 165882) (SK.UNDO.MENULABEL 165884
. 166279) (SK.LABEL.FROM.TYPE 166281 . 166703)) (167555 175397 (SHOW.GLOBAL.COORDS 167565 . 168114) (
LOCATOR.CLOSEFN 168116 . 168401) (SKETCHW.FROM.LOCATOR 168403 . 168811) (SKETCHW.UPDATE.LOCATORS
168813 . 169399) (LOCATOR.UPDATE 169401 . 170159) (UPDATE.GLOBAL.LOCATOR 170161 . 170962) (
UPDATE.GLOBALCOORD.LOCATOR 170964 . 171541) (ADD.GLOBAL.DISPLAY 171543 . 172460) (
ADD.GLOBAL.GRIDDED.DISPLAY 172462 . 172721) (CREATE.GLOBAL.DISPLAYER 172723 . 173800) (
UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR 173802 . 175395)) (175604 188091 (DISPLAYREADCOLORHLSLEVELS 175614
. 176450) (DISPLAYREADCOLORLEVEL 176452 . 177487) (DRAWREADCOLORBOX 177489 . 178478) (
READ.CHANGE.COLOR 178480 . 178697) (READCOLOR1 178699 . 181613) (READCOLORCOMMANDMENUSELECTEDFN 181615
. 181982) (READCOLOR2 181984 . 188089)) (188092 189551 (CREATE.CNS.MENU 188102 . 189549)) (189828
192538 (SK.ABSWXOFFSET 189838 . 190132) (SK.ABSWYOFFSET 190134 . 190428) (
SK.UNSCALE.POSITION.FROM.VIEWER 190430 . 190999) (SK.SCALE.REGION 191001 . 192536)) (192577 207575 (
VIEWER.SCALE 192587 . 192896) (SKETCH.ZOOM 192898 . 193933) (SAME.ASPECT.RATIO 193935 . 195299) (
SKETCH.DO.ZOOM 195301 . 196506) (SKETCH.NEW.VIEW 196508 . 197023) (ZOOM.UPDATE.ELT 197025 . 197918) (
SK.UPDATE.AFTER.SCALE.CHANGE 197920 . 199789) (SKETCH.AUTOZOOM 199791 . 204211) (
SKETCH.GLOBAL.REGION.ZOOM 204213 . 207573)) (208212 220124 (SKETCH.HOME 208222 . 208749) (SK.FRAME.IT
208751 . 209343) (SK.FRAME.WINDOW.TO.SKETCH 209345 . 213191) (SK.MOVE.TO.VIEW 213193 . 214607) (
SK.NAME.CURRENT.VIEW 214609 . 215719) (SKETCH.ADD.VIEW 215721 . 216814) (SK.RESTORE.VIEW 216816 .
218692) (SK.FORGET.VIEW 218694 . 220122)))))
STOP

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
(FILECREATED "13-Nov-2025 21:00:34" {WMEDLEY}<library>TEDIT>TEDIT.;844 144838
(FILECREATED " 2-Mar-2026 18:32:06" {WMEDLEY}<library>tedit>TEDIT.;853 146506
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.INSERT \TEDIT.INSERT)
:CHANGES-TO (VARS TEDITCOMS)
:PREVIOUS-DATE "28-Oct-2025 00:29:56" {WMEDLEY}<library>TEDIT>TEDIT.;843)
:PREVIOUS-DATE " 4-Feb-2026 16:02:02" {WMEDLEY}<library>tedit>TEDIT.;852)
(PRETTYCOMPRINT TEDITCOMS)
@@ -28,9 +28,7 @@
(EXPORT (FILES (FROM LOADUPS)
EXPORTS.ALL)))
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL))
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
UNICODE)))
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL)))
[DECLARE%: EVAL@COMPILE DONTCOPY
(* ;; "Assertions go to comments if not being checked, so we see value-warnings")
@@ -47,7 +45,7 @@
(FNS TEDIT TEXTSTREAM TEXTSTREAMP COERCETEXTSTREAM TEDIT.CONCAT TEDITSTRING TEDIT-SEE
TEDIT.COPY TEDIT.DELETE TEDIT.INSERT TEDIT.TERPRI TEDIT.KILL TEDIT.QUIT TEDIT.MOVE
TEDIT.STRINGWIDTH TEDIT.CHARWIDTH)
TEDIT.STRINGWIDTH TEDIT.CHARWIDTH TEDIT.PARAGRAPH.BOUNDARIES)
(FNS TEXTOBJ COERCETEXTOBJ)
(MACROS TEVAL)
(FNS TDRIBBLE)
@@ -76,8 +74,9 @@
(VARS (TEDITSYSTEMDATE (TEDITSYSTEMDATE]
(COMS (* ;
 "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.")
(ADDVARS (PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP)
(EXTENSION (TEDIT TED])
(FNS TEDIT.IMAGESOURCEP)
(ALISTS (PRINTFILETYPES TEDIT))
(P (DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE])
(FILESLOAD (SYSLOAD)
POSTSCRIPTSTREAM PDFSTREAM WHEELSCROLL)
@@ -156,11 +155,6 @@
(FILESLOAD TEDIT-EXPORTS.ALL)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
UNICODE)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS TEDIT-ASSERT MACRO [ARGS (COND
@@ -675,6 +669,26 @@
(CR (IMAX 6 (CHARWIDTH CH FONT)))
(TAB 36)
(CHARWIDTH CH FONT])
(TEDIT.PARAGRAPH.BOUNDARIES
[LAMBDA (TSTREAM SELORCH# PROTECTEDNOTOK) (* ; "Edited 2-Feb-2026 23:05 by rmk")
(* ;; "Returns a pair (FIRSTCH# LASTCH#) where FIRSTCH# is the character number of the first character of the paragraph that contains the beginning of the selection, and LASTCH# is the last character number of the last character of the paragraph that contains the end of the selection.")
(* ;;
 "If PROTECTIONNOTOK, the scans stop at any protected piece (e.g. doesn't cross menu boiler plate).")
(LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
(CL:UNLESS SELORCH#
(SETQ SELORCH# (TEXTSEL TEXTOBJ)))
(LIST (CAR (\TEDIT.PARA.FIRST TEXTOBJ (CL:IF (type? SELECTION SELORCH#)
(GETSEL SELORCH# CH#)
SELORCH#)
PROTECTEDNOTOK))
(CAR (\TEDIT.PARA.LAST TEXTOBJ (CL:IF (type? SELECTION SELORCH#)
(GETSEL SELORCH# CHLAST)
SELORCH#)
PROTECTEDNOTOK])
)
(DEFINEQ
@@ -911,7 +925,8 @@
else (TEDIT.PROMPTPRINT TSTREAM "Changed object not found in document" T])
(TEDIT.MAP.OBJECTS
[LAMBDA (TSTREAM FN FNARG COLLECT?) (* ; "Edited 25-Feb-2025 15:06 by rmk")
[LAMBDA (TSTREAM FN FNARG COLLECT?) (* ; "Edited 4-Feb-2026 16:01 by rmk")
(* ; "Edited 25-Feb-2025 15:06 by rmk")
(* ; "Edited 23-Apr-2024 09:15 by rmk")
(* ; "Edited 16-Mar-2024 10:03 by rmk")
(* ; "Edited 4-Mar-2024 16:12 by rmk")
@@ -931,8 +946,7 @@
(NIL)
(OBJECT (PUSH $$VAL OBJ))
(CH# (PUSH $$VAL CH#))
(VALUE (PUSH $$VAL CH#)
FNVAL)
(VALUE (PUSH $$VAL FNVAL))
(FIRST (RETURN (LIST CH# OBJ FNVAL)))
(PUSH $$VAL (LIST CH# OBJ FNVAL)))
(CL:WHEN (EQ FNVAL 'STOP)
@@ -1324,7 +1338,9 @@
(CL:WHEN TYPEIN (\TEDIT.SCROLL.CARET TSTREAM)))])])
(\TEDIT.MOVE
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 7-May-2025 00:12 by rmk")
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 31-Jan-2026 11:48 by rmk")
(* ; "Edited 10-Jan-2026 01:38 by rmk")
(* ; "Edited 7-May-2025 00:12 by rmk")
(* ; "Edited 22-Apr-2025 09:21 by rmk")
(* ; "Edited 16-Apr-2025 09:01 by rmk")
(* ; "Edited 6-Apr-2025 14:14 by rmk")
@@ -1384,7 +1400,7 @@
(CL:WHEN (AND (FGETTOBJ TOOBJ BLUEPENDINGDELETE)
(IGREATERP TODCH 0))
(FSETTOBJ TOOBJ BLUEPENDINGDELETE NIL)
(CL:UNLESS (\TEDIT.DELETE TOOBJ TOSEL)
(CL:UNLESS (\TEDIT.DELETE TOTSTREAM TOSEL)
(RETURN NIL))
(SETQ BPD T)
(CL:WHEN (EQ TOOBJ FROMOBJ) (* ; "Same text, pre-adjust the source")
@@ -1420,15 +1436,14 @@
(* ;; "Pop to accumulate into a single event (BPD, DELETE, INSERT).")
else (\TEDIT.DELETE FROMOBJ FROMSEL NIL NIL T))
else (\TEDIT.DELETE FROMTSTREAM FROMSEL NIL NIL T))
(* ;; "Deletion accomplished possibly in separate FROMOBJ with its own history.")
(* ;; "")
(CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF)
(\TEDIT.FOREIGN.COPY (WFROMDS TOTSTREAM)
FROMSEL T)
(\TEDIT.FOREIGN.COPY FROMSEL FROMTSTREAM T)
(CL:WHEN BPD (* ; "If no BPD, TO history is good")
(\TEDIT.HISTORYADD.COMPOSITE TOOBJ TOOBJ (LIST (\TEDIT.POPEVENT TOOBJ)
(\TEDIT.POPEVENT TOOBJ))))
@@ -1447,7 +1462,8 @@
(CL:IF BPD (\TEDIT.POPEVENT TOOBJ])])
(\TEDIT.COPY
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 7-May-2025 00:12 by rmk")
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 31-Jan-2026 11:48 by rmk")
(* ; "Edited 7-May-2025 00:12 by rmk")
(* ; "Edited 22-Apr-2025 09:12 by rmk")
(* ; "Edited 6-Apr-2025 14:16 by rmk")
(* ; "Edited 5-Apr-2025 13:19 by rmk")
@@ -1496,8 +1512,7 @@
(* ;; "")
(CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF)
(\TEDIT.FOREIGN.COPY (WFROMDS TOTSTREAM)
FROMSEL T)
(\TEDIT.FOREIGN.COPY FROMSEL FROMTSTREAM T)
(RETURN))
(* ;; "")
@@ -2317,30 +2332,40 @@
(* ; "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.")
(DEFINEQ
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP)
(TEDIT.IMAGESOURCEP
[LAMBDA (X) (* ; "Edited 23-Dec-2025 11:26 by rmk")
(OR (TEXTSTREAM X T)
(TEDIT.FORMATTEDFILEP X])
)
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST TEDIT.IMAGESOURCEP)
(EXTENSION (TEDIT TED))))
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4838 7232 (MAKE-TEDIT-EXPORTS.ALL 4848 . 5394) (UPDATE-TEDIT 5396 . 6325) (EDIT-TEDIT
6327 . 7230)) (8662 36440 (TEDIT 8672 . 11286) (TEXTSTREAM 11288 . 13177) (TEXTSTREAMP 13179 . 13563)
(COERCETEXTSTREAM 13565 . 17776) (TEDIT.CONCAT 17778 . 21080) (TEDITSTRING 21082 . 21996) (TEDIT-SEE
21998 . 22682) (TEDIT.COPY 22684 . 24829) (TEDIT.DELETE 24831 . 26192) (TEDIT.INSERT 26194 . 29163) (
TEDIT.TERPRI 29165 . 30279) (TEDIT.KILL 30281 . 31263) (TEDIT.QUIT 31265 . 32631) (TEDIT.MOVE 32633 .
33521) (TEDIT.STRINGWIDTH 33523 . 34194) (TEDIT.CHARWIDTH 34196 . 36438)) (36441 38382 (TEXTOBJ 36451
. 36916) (COERCETEXTOBJ 36918 . 38380)) (39782 41432 (TDRIBBLE 39792 . 41430)) (41473 53369 (
TEDIT.INSERT.OBJECT 41483 . 45190) (TEDIT.EDIT.OBJECT 45192 . 48132) (TEDIT.OBJECT.CHANGED 48134 .
51324) (TEDIT.MAP.OBJECTS 51326 . 52897) (\TEDIT.FIRST.OBJPIECE 52899 . 53132) (\TEDIT.NEXT.OBJPIECE
53134 . 53367)) (53392 60835 (\TEDIT.CONCAT.PAGEFRAMES 53402 . 58469) (\TEDIT.GET.PAGE.HEADINGS 58471
. 59500) (\TEDIT.CONCAT.INSTALL.HEADINGS 59502 . 60833)) (60836 64443 (\TEDIT.MOVE.MSG 60846 . 62927)
(\TEDIT.READONLY 62929 . 64441)) (64444 70335 (TEDIT.NCHARS 64454 . 64827) (TEDIT.RPLCHARCODE 64829
. 67819) (TEDIT.NTHCHARCODE 67821 . 69864) (TEDIT.NTHCHAR 69866 . 70333)) (70381 127158 (\TEDIT1
70391 . 72468) (\TEDIT.INSERT 72470 . 78583) (\TEDIT.MOVE 78585 . 86491) (\TEDIT.COPY 86493 . 91024) (
\TEDIT.REPLACE.SELPIECES 91026 . 95562) (\TEDIT.INSERT.SELPIECES 95564 . 98561) (\TEDIT.RESTARTFN
98563 . 101068) (\TEDIT.CHARDELETE 101070 . 103999) (\TEDIT.COPYPIECE 104001 . 109163) (
\TEDIT.APPLY.OBJFN 109165 . 112251) (\TEDIT.DELETE 112253 . 116621) (\TEDIT.DIFFUSE.PARALOOKS 116623
. 118894) (\TEDIT.WORDDELETE 118896 . 120511) (\TEDIT.WORDDELETE.FORWARD 120513 . 122302) (
\TEDIT.FINISHEDIT? 122304 . 127156)) (127159 127818 (\TEDIT.THELP 127169 . 127816)) (127852 136983 (
\TEDIT.PARAPIECES 127862 . 129836) (\TEDIT.PARACHNOS 129838 . 130730) (\TEDIT.PARA.FIRST 130732 .
133833) (\TEDIT.PARA.LAST 133835 . 136981)) (136984 144079 (\TEDIT.WORD.FIRST 136994 . 140998) (
\TEDIT.WORD.LAST 141000 . 144077)) (144280 144557 (TEDITSYSTEMDATE 144290 . 144555)))))
(FILEMAP (NIL (4738 7132 (MAKE-TEDIT-EXPORTS.ALL 4748 . 5294) (UPDATE-TEDIT 5296 . 6225) (EDIT-TEDIT
6227 . 7130)) (8487 37486 (TEDIT 8497 . 11111) (TEXTSTREAM 11113 . 13002) (TEXTSTREAMP 13004 . 13388)
(COERCETEXTSTREAM 13390 . 17601) (TEDIT.CONCAT 17603 . 20905) (TEDITSTRING 20907 . 21821) (TEDIT-SEE
21823 . 22507) (TEDIT.COPY 22509 . 24654) (TEDIT.DELETE 24656 . 26017) (TEDIT.INSERT 26019 . 28988) (
TEDIT.TERPRI 28990 . 30104) (TEDIT.KILL 30106 . 31088) (TEDIT.QUIT 31090 . 32456) (TEDIT.MOVE 32458 .
33346) (TEDIT.STRINGWIDTH 33348 . 34019) (TEDIT.CHARWIDTH 34021 . 36263) (TEDIT.PARAGRAPH.BOUNDARIES
36265 . 37484)) (37487 39428 (TEXTOBJ 37497 . 37962) (COERCETEXTOBJ 37964 . 39426)) (40828 42478 (
TDRIBBLE 40838 . 42476)) (42519 54499 (TEDIT.INSERT.OBJECT 42529 . 46236) (TEDIT.EDIT.OBJECT 46238 .
49178) (TEDIT.OBJECT.CHANGED 49180 . 52370) (TEDIT.MAP.OBJECTS 52372 . 54027) (\TEDIT.FIRST.OBJPIECE
54029 . 54262) (\TEDIT.NEXT.OBJPIECE 54264 . 54497)) (54522 61965 (\TEDIT.CONCAT.PAGEFRAMES 54532 .
59599) (\TEDIT.GET.PAGE.HEADINGS 59601 . 60630) (\TEDIT.CONCAT.INSTALL.HEADINGS 60632 . 61963)) (61966
65573 (\TEDIT.MOVE.MSG 61976 . 64057) (\TEDIT.READONLY 64059 . 65571)) (65574 71465 (TEDIT.NCHARS
65584 . 65957) (TEDIT.RPLCHARCODE 65959 . 68949) (TEDIT.NTHCHARCODE 68951 . 70994) (TEDIT.NTHCHAR
70996 . 71463)) (71511 128555 (\TEDIT1 71521 . 73598) (\TEDIT.INSERT 73600 . 79713) (\TEDIT.MOVE 79715
. 87813) (\TEDIT.COPY 87815 . 92421) (\TEDIT.REPLACE.SELPIECES 92423 . 96959) (
\TEDIT.INSERT.SELPIECES 96961 . 99958) (\TEDIT.RESTARTFN 99960 . 102465) (\TEDIT.CHARDELETE 102467 .
105396) (\TEDIT.COPYPIECE 105398 . 110560) (\TEDIT.APPLY.OBJFN 110562 . 113648) (\TEDIT.DELETE 113650
. 118018) (\TEDIT.DIFFUSE.PARALOOKS 118020 . 120291) (\TEDIT.WORDDELETE 120293 . 121908) (
\TEDIT.WORDDELETE.FORWARD 121910 . 123699) (\TEDIT.FINISHEDIT? 123701 . 128553)) (128556 129215 (
\TEDIT.THELP 128566 . 129213)) (129249 138380 (\TEDIT.PARAPIECES 129259 . 131233) (\TEDIT.PARACHNOS
131235 . 132127) (\TEDIT.PARA.FIRST 132129 . 135230) (\TEDIT.PARA.LAST 135232 . 138378)) (138381
145476 (\TEDIT.WORD.FIRST 138391 . 142395) (\TEDIT.WORD.LAST 142397 . 145474)) (145677 145954 (
TEDITSYSTEMDATE 145687 . 145952)) (146090 146297 (TEDIT.IMAGESOURCEP 146100 . 146295)))))
STOP

View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Jan-2026 17:51:55" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;55 18063
(FILECREATED "23-Jan-2026 15:49:26" {WMEDLEY}<library>TEDIT>TEDIT-ABBREV.;58 18256
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
(VARS TEDIT-ABBREVCOMS)
:PREVIOUS-DATE " 8-Jan-2026 09:09:58" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;53)
:PREVIOUS-DATE "13-Jan-2026 17:51:55" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;55)
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
@@ -87,7 +86,9 @@
(DEFINEQ
(\TEDIT.ABBREV.EXPAND
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 13-Jan-2026 17:51 by rmk")
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 23-Jan-2026 15:49 by rmk")
(* ; "Edited 20-Jan-2026 09:56 by rmk")
(* ; "Edited 13-Jan-2026 17:51 by rmk")
(* ; "Edited 8-Jan-2026 09:08 by rmk")
(* ; "Edited 3-Jan-2026 13:13 by rmk")
(* ; "Edited 20-Apr-2025 23:30 by rmk")
@@ -143,11 +144,11 @@
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
(PCHARLOOKS (\TEDIT.CHTOPC FIRSTCHNO TEXTOBJ)))
TSTREAM SEL)
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Replaced " (CL:IF BACKSLASH
(CONCAT (CAR ABBREV)
"\")
(CAR ABBREV))
" with " EXPANSION)
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Replaced %"" (CL:IF BACKSLASH
(CONCAT (CAR ABBREV)
"\")
(CAR ABBREV))
"%" with %"" EXPANSION "%"")
T)
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
@@ -362,7 +363,7 @@
("DATE" \TEDIT.EXPAND.DATE)
(">>DATE<<" \TEDIT.EXPAND.DATE)))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4390 14959 (\TEDIT.ABBREV.EXPAND 4400 . 8930) (\TEDIT.ABBREV.EXPANSION 8932 . 11996) (
\TEDIT.ABBREV.TREE 11998 . 13129) (\TEDIT.ABBREV.PARSE 13131 . 14283) (\TEDIT.ABBREV.PARSE.CHARCODE
14285 . 14957)) (14960 15605 (\TEDIT.EXPAND.DATE 14970 . 15603)))))
(FILEMAP (NIL (4348 15152 (\TEDIT.ABBREV.EXPAND 4358 . 9123) (\TEDIT.ABBREV.EXPANSION 9125 . 12189) (
\TEDIT.ABBREV.TREE 12191 . 13322) (\TEDIT.ABBREV.PARSE 13324 . 14476) (\TEDIT.ABBREV.PARSE.CHARCODE
14478 . 15150)) (15153 15798 (\TEDIT.EXPAND.DATE 15163 . 15796)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Oct-2025 10:44:18" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;229 125526
(FILECREATED "25-Jan-2026 09:14:04" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;230 123301
:EDIT-BY rmk
:CHANGES-TO (FNS MB.ADD)
:CHANGES-TO (VARS TEDIT-BUTTONSCOMS)
:PREVIOUS-DATE "30-Apr-2025 14:09:18" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;228)
:PREVIOUS-DATE "19-Oct-2025 10:44:18" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;229)
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
@@ -36,10 +36,9 @@
(* ;; "Mutually exclusive togggles with a single enclosing object")
(FNS MB.NWAY.CREATE MB.NWAY.DISPLAYFN MB.NWAY.WHENOPERATEDONFN MB.NWAY.SIZEFN
MB.NWAY.SELECT MB.NWAY.BUTTONEVENTINFN MB.NWAY.NEWMENUBUTTON MB.NWAY.COPYFN
MB.NWAY.INIT MB.NWAY.ARRANGEBUTTONS MB.NWAY.ADDITEM MB.NWAY.FINDSUBOBJ
MB.NWAY.SETSTATEFN)
(FNS MB.NWAY.CREATE MB.NWAY.DISPLAYFN MB.NWAY.SIZEFN MB.NWAY.SELECT
MB.NWAY.BUTTONEVENTINFN MB.NWAY.NEWMENUBUTTON MB.NWAY.COPYFN MB.NWAY.INIT
MB.NWAY.ARRANGEBUTTONS MB.NWAY.ADDITEM MB.NWAY.FINDSUBOBJ MB.NWAY.SETSTATEFN)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.NWAY.INIT]
[COMS (* ; "TOGGLE")
(FNS MB.TOGGLE.CREATE MB.TOGGLE.DISPLAYFN MB.TOGGLE.INIT MB.SET.TOGGLE
@@ -922,39 +921,6 @@
(APPLY* (IMAGEOBJPROP SOBJ 'DISPLAYFN)
SOBJ STREAM])
(MB.NWAY.WHENOPERATEDONFN
[LAMBDA (OBJ PANE OPERATION SEL) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 24-Aug-2024 23:38 by rmk")
(* ; "Edited 13-Aug-2024 23:43 by rmk")
(* ; "Edited 2-Aug-2024 00:36 by rmk")
(* ; "Edited 21-Jul-2024 13:17 by rmk")
(* ; "Edited 17-Jul-2024 21:51 by rmk")
(* ; "Edited 9-Apr-2023 15:57 by rmk")
(* ; "Edited 13-Sep-2022 12:09 by rmk")
(* ; "Edited 30-May-91 22:16 by jds")
(* ;; "Perhaps the selected subobject should be stored here, as the state?")
(* ;; "Mouse tracking and highlighting happens in the BUTTONEVENTINFN (MB.NWAYBUTTON.SELFN). The code here applies the STATECHANGEFN on the main object")
(NOTUSED)
(SELECTQ OPERATION
(SELECTED [AND NIL (\TEDIT.THELP)
(LET [(SELECTED (IMAGEOBJPROP OBJ 'SELECTED]
(if (IMAGEOBJPROP OBJ 'STATECHANGEFN)
then (\TEDIT.THELP)
(APPLY* (IMAGEOBJPROP OBJ 'STATECHANGEFN)
OBJ SELECTED SEL PANE)
elseif (AND NIL SELECTED (IMAGEOBJPROP SELECTED 'STATECHANGEFN))
then
(* ;;
 "This is nuked out: the selected object may be should have done its own thing?")
(APPLY* (IMAGEOBJPROP SELECTED 'STATECHANGEFN)
OBJ SELECTED SEL PANE])
((HIGHLIGHTED UNHIGHLIGHTED DESELECTED))
NIL])
(MB.NWAY.SIZEFN
[LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* ; "Edited 20-Aug-2024 15:12 by rmk")
(* ; "Edited 22-Jul-2024 11:31 by rmk")
@@ -1971,25 +1937,25 @@
(MB.FIELD.INIT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3221 19357 (MB.ADD 3231 . 9943) (MB.DELETE 9945 . 10319) (MB.GET 10321 . 17091) (
MB.GET.MBARG 17093 . 18762) (TEDIT.BACKTOMAIN 18764 . 19355)) (19401 39337 (MB.BUTTONEVENTINFN 19411
. 20979) (MB.DISPLAYFN 20981 . 23040) (MB.SETIMAGE 23042 . 24210) (MB.SIZEFN 24212 . 25760) (
MB.WHENOPERATEDONFN 25762 . 27711) (MB.COPYFN 27713 . 28171) (MB.GETFN 28173 . 29134) (MB.PUTFN 29136
. 30236) (MB.SHOWSELFN 30238 . 31747) (MB.CREATE 31749 . 35772) (MB.CHANGENAME 35774 . 36256) (
MB.INIT 36258 . 37719) (MB.TRACK.UNTIL 37721 . 38416) (MB.DON'T 38418 . 38714) (MB.SPEC.REMAINDER
38716 . 39335)) (39499 49504 (MB.3STATE.CREATE 39509 . 40373) (MB.3STATE.DISPLAYFN 40375 . 41361) (
MB.3STATE.SHOWSELFN 41363 . 43674) (MB.3STATE.INIT 43676 . 45087) (MB.3STATE.SETSTATEFN 45089 . 45747)
(MB.3STATE.BUTTONEVENTINFN 45749 . 49502)) (49659 80755 (MB.NWAY.CREATE 49669 . 55852) (
MB.NWAY.DISPLAYFN 55854 . 56717) (MB.NWAY.WHENOPERATEDONFN 56719 . 58909) (MB.NWAY.SIZEFN 58911 .
62847) (MB.NWAY.SELECT 62849 . 66419) (MB.NWAY.BUTTONEVENTINFN 66421 . 69633) (MB.NWAY.NEWMENUBUTTON
69635 . 70347) (MB.NWAY.COPYFN 70349 . 71316) (MB.NWAY.INIT 71318 . 72809) (MB.NWAY.ARRANGEBUTTONS
72811 . 74782) (MB.NWAY.ADDITEM 74784 . 78933) (MB.NWAY.FINDSUBOBJ 78935 . 79449) (MB.NWAY.SETSTATEFN
79451 . 80753)) (80834 92833 (MB.TOGGLE.CREATE 80844 . 81839) (MB.TOGGLE.DISPLAYFN 81841 . 83324) (
MB.TOGGLE.INIT 83326 . 85125) (MB.SET.TOGGLE 85127 . 86328) (MB.TOGGLE.SETSTATEFN 86330 . 87170) (
MB.TOGGLE.BUTTONEVENTINFN 87172 . 91488) (MB.TOGGLE.WHENOPERATEDONFN 91490 . 92831)) (92914 125447 (
MB.FIELD.CREATE 92924 . 98375) (MB.FIELD.DISPLAYFN 98377 . 99168) (MB.FIELD.IMAGEBOXFN 99170 . 100652)
(MB.FIELD.PREFIXCREATE 100654 . 104590) (MB.FIELD.SUFFIXCREATE 104592 . 106252) (MB.FIELD.INIT 106254
. 108021) (MB.FIELD.WHENOPERATEDONFN 108023 . 109294) (MB.FIELD.GETSTATEFN 109296 . 113230) (
MB.FIELD.SETSTATEFN 113232 . 118036) (MB.FIELD.BUTTONEVENTINFN 118038 . 120343) (MB.FIELD.SIZEFN
120345 . 120585) (MB.FIELD.INSURETYPE 120587 . 125445)))))
(FILEMAP (NIL (3188 19324 (MB.ADD 3198 . 9910) (MB.DELETE 9912 . 10286) (MB.GET 10288 . 17058) (
MB.GET.MBARG 17060 . 18729) (TEDIT.BACKTOMAIN 18731 . 19322)) (19368 39304 (MB.BUTTONEVENTINFN 19378
. 20946) (MB.DISPLAYFN 20948 . 23007) (MB.SETIMAGE 23009 . 24177) (MB.SIZEFN 24179 . 25727) (
MB.WHENOPERATEDONFN 25729 . 27678) (MB.COPYFN 27680 . 28138) (MB.GETFN 28140 . 29101) (MB.PUTFN 29103
. 30203) (MB.SHOWSELFN 30205 . 31714) (MB.CREATE 31716 . 35739) (MB.CHANGENAME 35741 . 36223) (
MB.INIT 36225 . 37686) (MB.TRACK.UNTIL 37688 . 38383) (MB.DON'T 38385 . 38681) (MB.SPEC.REMAINDER
38683 . 39302)) (39466 49471 (MB.3STATE.CREATE 39476 . 40340) (MB.3STATE.DISPLAYFN 40342 . 41328) (
MB.3STATE.SHOWSELFN 41330 . 43641) (MB.3STATE.INIT 43643 . 45054) (MB.3STATE.SETSTATEFN 45056 . 45714)
(MB.3STATE.BUTTONEVENTINFN 45716 . 49469)) (49626 78530 (MB.NWAY.CREATE 49636 . 55819) (
MB.NWAY.DISPLAYFN 55821 . 56684) (MB.NWAY.SIZEFN 56686 . 60622) (MB.NWAY.SELECT 60624 . 64194) (
MB.NWAY.BUTTONEVENTINFN 64196 . 67408) (MB.NWAY.NEWMENUBUTTON 67410 . 68122) (MB.NWAY.COPYFN 68124 .
69091) (MB.NWAY.INIT 69093 . 70584) (MB.NWAY.ARRANGEBUTTONS 70586 . 72557) (MB.NWAY.ADDITEM 72559 .
76708) (MB.NWAY.FINDSUBOBJ 76710 . 77224) (MB.NWAY.SETSTATEFN 77226 . 78528)) (78609 90608 (
MB.TOGGLE.CREATE 78619 . 79614) (MB.TOGGLE.DISPLAYFN 79616 . 81099) (MB.TOGGLE.INIT 81101 . 82900) (
MB.SET.TOGGLE 82902 . 84103) (MB.TOGGLE.SETSTATEFN 84105 . 84945) (MB.TOGGLE.BUTTONEVENTINFN 84947 .
89263) (MB.TOGGLE.WHENOPERATEDONFN 89265 . 90606)) (90689 123222 (MB.FIELD.CREATE 90699 . 96150) (
MB.FIELD.DISPLAYFN 96152 . 96943) (MB.FIELD.IMAGEBOXFN 96945 . 98427) (MB.FIELD.PREFIXCREATE 98429 .
102365) (MB.FIELD.SUFFIXCREATE 102367 . 104027) (MB.FIELD.INIT 104029 . 105796) (
MB.FIELD.WHENOPERATEDONFN 105798 . 107069) (MB.FIELD.GETSTATEFN 107071 . 111005) (MB.FIELD.SETSTATEFN
111007 . 115811) (MB.FIELD.BUTTONEVENTINFN 115813 . 118118) (MB.FIELD.SIZEFN 118120 . 118360) (
MB.FIELD.INSURETYPE 118362 . 123220)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Oct-2025 08:49:06" {WMEDLEY}<library>tedit>TEDIT-FILE.;656 173140
(FILECREATED "15-Feb-2026 23:45:51" {WMEDLEY}<library>tedit>TEDIT-FILE.;666 175062
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8)
:CHANGES-TO (FNS \TEDIT.PUT.MCCS.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW)
(VARS TEDIT-FILECOMS)
:PREVIOUS-DATE "25-Sep-2025 21:32:46" {WMEDLEY}<library>tedit>TEDIT-FILE.;655)
:PREVIOUS-DATE "14-Feb-2026 10:32:44" {WMEDLEY}<library>tedit>TEDIT-FILE.;659)
(PRETTYCOMPRINT TEDIT-FILECOMS)
@@ -50,8 +51,9 @@
(* ;; "Putting pageframe functions are on TEDIT-PAGE)")
(FNS \TEDIT.PUT.PCTB \TEDIT.PUT.PCTB.PIECEDATA \TEDIT.PUT.TRAILER
\TEDIT.PUT.PCTB.MERGEABLE \TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW
\TEDIT.INSERT.NEWPIECES \TEDIT.PUTRESET \ARBOUT \ATMOUT \DWOUT \STRINGOUT)
\TEDIT.PUT.PCTB.MERGEABLE \TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.MCCS.SPLITPIECES
\TEDIT.PUT.PCTB.NEXTNEW \TEDIT.INSERT.NEWPIECES \TEDIT.PUTRESET \ARBOUT \ATMOUT
\DWOUT \STRINGOUT)
(FNS \TEDIT.PUT.CHARLOOKS.LIST \TEDIT.PUT.SINGLE.CHARLOOKS \TEDIT.PUT.CHARLOOKS
\TEDIT.PUT.CHARLOOKS1 \TEDIT.PUT.OBJECT)
(FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS))
@@ -1830,6 +1832,7 @@
(\TEDIT.PUT.PCTB
[LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE)
(* ; "Edited 14-Feb-2026 10:32 by rmk")
(* ; "Edited 9-Sep-2025 21:32 by rmk")
(* ; "Edited 26-Apr-2025 00:11 by rmk")
(* ; "Edited 21-Oct-2024 00:33 by rmk")
@@ -1922,10 +1925,10 @@
(* ;; "For MCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file. TEDIT.GET calls \TEDIT.INTERPRET.XCCS.SHIFTS to shave those bytes. NSHIFTBYTES is used here if the edit will continue.")
(CHARSET CHARSTREAM (CL:IF (MEMB (PTYPE PC)
FAT.PTYPES)
T
0))
(CHARSET CHARSTREAM (OR (AND (EQ EXTFORMAT :XCCS)
(MEMB (PTYPE PC)
FAT.PTYPES))
(PCHARSET PC)))
(SETQ NSHIFTBYTES (IDIFFERENCE (\GETFILEPTR CHARSTREAM)
OLDBYTE#)))
(do (\TEDIT.PUT.PCTB.PIECEDATA PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDBYTE#)
@@ -2152,8 +2155,35 @@
(RETURN))))
NIL])
(\TEDIT.PUT.MCCS.SPLITPIECES
[LAMBDA (TEXTOBJ) (* ; "Edited 15-Feb-2026 23:45 by rmk")
(* ;; "We are putting to a :MCCS format file, and MCCS doesn't support single-byte runs of non-charset 0 characters. This function splits fat pieces into subpieces with only charset-0 characters or no charset-0 characters. The former will be put out as THINFILE pieces, the latter as FATFILE2.")
(for PC FIRST0 FIRSTNON0 inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
when [AND (MEMB (PTYPE PC)
(CONSTANT (LIST FATSTRING.PTYPE FATFILE2.PTYPE UTF8.PTYPE)))
(SETQ FIRST0 (find I from 0 to (PLAST PC)
suchthat (EQ 0 (\CHARSET (\TEDIT.PIECE.NTHCHARCODE PC I]
do (if [SETQ FIRSTNON0 (find I from (ADD1 FIRST0) to (PLAST PC)
suchthat (NEQ 0 (\CHARSET (\TEDIT.PIECE.NTHCHARCODE PC I]
then
(* ;; "xxx000yyy --> xxx 000yyy or 000yyy --> 000 yyy")
(\TEDIT.SPLITPIECE PC (CL:IF (EQ FIRST0 0)
FIRSTNON0
FIRST0)
TEXTOBJ) (* ; "Iterate to the residual piece")
(SETQ PC (PREVPIECE PC))
elseif (NEQ 0 FIRST0)
then
(* ;; "xxx000")
(\TEDIT.SPLITPIECE PC FIRST0 TEXTOBJ])
(\TEDIT.PUT.PCTB.NEXTNEW
[LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)
(* ; "Edited 15-Feb-2026 15:09 by rmk")
(* ; "Edited 25-Apr-2025 08:48 by rmk")
(* ; "Edited 26-Mar-2025 09:27 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
@@ -2202,7 +2232,7 @@
 "The file may have LF, but we want to restore EOL internally")
(CL:WHEN [AND (EQ THINFILE.PTYPE (PTYPE NEXTNEW))
(EQ (CHARCODE EOL)
(\TEDIT.PIECE.NTHCHARCODE PC (PLEN PC]
(\TEDIT.PIECE.NTHCHARCODE PC (PLAST PC]
(if (EQ 1 (PLEN NEXTNEW))
then (FSETPC NEXTNEW PTYPE THINSTRING.PTYPE)
(FSETPC NEXTNEW PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL)))
@@ -2625,7 +2655,8 @@
(DEFINEQ
(TEDITFROMLISPSOURCE
[LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 7-Apr-2025 23:13 by rmk")
[LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 7-Feb-2026 17:02 by rmk")
(* ; "Edited 7-Apr-2025 23:13 by rmk")
(* ; "Edited 1-Apr-2025 12:54 by rmk")
(* ; "Edited 26-Mar-2025 10:02 by rmk")
(* ; "Edited 18-Feb-2025 23:34 by rmk")
@@ -2658,9 +2689,6 @@
,(TEDIT.ATOMBOUND.READTABLE (fetch (READER-ENVIRONMENT REREADTABLE)
of USERTEMP))
DEFAULTPUTEXTENSION ""))
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Fetching " (FULLNAME SOURCEFILE)
" ...")
T)
(COPY.TEXT.TO.IMAGE SOURCEFILE TSTREAM)
TSTREAM])
@@ -2693,28 +2721,29 @@
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5317 35576 (TEDIT.GET 5327 . 11737) (TEDIT.FORMATTEDFILEP 11739 . 13055) (
TEDIT.FILEDATE 13057 . 14366) (TEDIT.INCLUDE 14368 . 22397) (TEDIT.RAW.INCLUDE 22399 . 23207) (
TEDIT.PUT 23209 . 31565) (TEDIT.PUT.STREAM 31567 . 35574)) (35577 56851 (\TEDIT.GET.FOREIGN.FILE 35587
. 39012) (\TEDIT.GET.UNFORMATTED.FILE 39014 . 43320) (\TEDIT.GET.FORMATTED.FILE 43322 . 46965) (
\TEDIT.FORMATTEDSTREAMP 46967 . 50098) (\ARBIN 50100 . 50820) (\ATMIN 50822 . 51359) (\DWIN 51361 .
51740) (\STRINGIN 51742 . 52450) (\TEDIT.GET.TRAILER 52452 . 55320) (\TEDIT.CACHEFILE 55322 . 56849))
(57017 73055 (\TEDIT.GET.PIECES3 57027 . 67990) (\TEDIT.GET.PROPS3 67992 . 71214) (
\TEDIT.MAKE.STRINGPIECE 71216 . 73053)) (73056 86482 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73066 . 79299)
(\TEDIT.INTERPRET.MCCS.SHIFTS 79301 . 85546) (\TEDIT.CONVERT.XCCSTOMCCS 85548 . 86480)) (86504 92749 (
\TEDIT.GET.UNFORMATTED.FILE.UTF8 86514 . 92747)) (92772 104114 (\TEDIT.GET.CHARLOOKS.LIST 92782 .
93513) (\TEDIT.GET.SINGLE.CHARLOOKS 93515 . 100587) (\TEDIT.GET.CHARLOOKS 100589 . 102145) (
\TEDIT.GET.PARALOOKS.INDEX 102147 . 102691) (\TEDIT.GET.CHARLOOKS.INDEX 102693 . 104112)) (104115
111772 (\TEDIT.GET.PARALOOKS.LIST 104125 . 104747) (\TEDIT.GET.SINGLE.PARALOOKS 104749 . 111770)) (
111773 115606 (\TEDIT.GET.OBJECT 111783 . 115604)) (115671 148934 (\TEDIT.PUT.PCTB 115681 . 125588) (
\TEDIT.PUT.PCTB.PIECEDATA 125590 . 128788) (\TEDIT.PUT.TRAILER 128790 . 130118) (
\TEDIT.PUT.PCTB.MERGEABLE 130120 . 133893) (\TEDIT.PUT.UTF8.SPLITPIECES 133895 . 138597) (
\TEDIT.PUT.PCTB.NEXTNEW 138599 . 143095) (\TEDIT.INSERT.NEWPIECES 143097 . 146532) (\TEDIT.PUTRESET
146534 . 146776) (\ARBOUT 146778 . 147502) (\ATMOUT 147504 . 148109) (\DWOUT 148111 . 148390) (
\STRINGOUT 148392 . 148932)) (148935 161669 (\TEDIT.PUT.CHARLOOKS.LIST 148945 . 150617) (
\TEDIT.PUT.SINGLE.CHARLOOKS 150619 . 156899) (\TEDIT.PUT.CHARLOOKS 156901 . 158240) (
\TEDIT.PUT.CHARLOOKS1 158242 . 159293) (\TEDIT.PUT.OBJECT 159295 . 161667)) (161670 169309 (
\TEDIT.PUT.PARALOOKS.LIST 161680 . 162582) (\TEDIT.PUT.SINGLE.PARALOOKS 162584 . 168168) (
\TEDIT.PUT.PARALOOKS 168170 . 169307)) (169404 172833 (TEDITFROMLISPSOURCE 169414 . 172082) (
SHELLSCRIPTP 172084 . 172313) (TEDITFROMSHELLSCRIPT 172315 . 172831)))))
(FILEMAP (NIL (5423 35682 (TEDIT.GET 5433 . 11843) (TEDIT.FORMATTEDFILEP 11845 . 13161) (
TEDIT.FILEDATE 13163 . 14472) (TEDIT.INCLUDE 14474 . 22503) (TEDIT.RAW.INCLUDE 22505 . 23313) (
TEDIT.PUT 23315 . 31671) (TEDIT.PUT.STREAM 31673 . 35680)) (35683 56957 (\TEDIT.GET.FOREIGN.FILE 35693
. 39118) (\TEDIT.GET.UNFORMATTED.FILE 39120 . 43426) (\TEDIT.GET.FORMATTED.FILE 43428 . 47071) (
\TEDIT.FORMATTEDSTREAMP 47073 . 50204) (\ARBIN 50206 . 50926) (\ATMIN 50928 . 51465) (\DWIN 51467 .
51846) (\STRINGIN 51848 . 52556) (\TEDIT.GET.TRAILER 52558 . 55426) (\TEDIT.CACHEFILE 55428 . 56955))
(57123 73161 (\TEDIT.GET.PIECES3 57133 . 68096) (\TEDIT.GET.PROPS3 68098 . 71320) (
\TEDIT.MAKE.STRINGPIECE 71322 . 73159)) (73162 86588 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73172 . 79405)
(\TEDIT.INTERPRET.MCCS.SHIFTS 79407 . 85652) (\TEDIT.CONVERT.XCCSTOMCCS 85654 . 86586)) (86610 92855 (
\TEDIT.GET.UNFORMATTED.FILE.UTF8 86620 . 92853)) (92878 104220 (\TEDIT.GET.CHARLOOKS.LIST 92888 .
93619) (\TEDIT.GET.SINGLE.CHARLOOKS 93621 . 100693) (\TEDIT.GET.CHARLOOKS 100695 . 102251) (
\TEDIT.GET.PARALOOKS.INDEX 102253 . 102797) (\TEDIT.GET.CHARLOOKS.INDEX 102799 . 104218)) (104221
111878 (\TEDIT.GET.PARALOOKS.LIST 104231 . 104853) (\TEDIT.GET.SINGLE.PARALOOKS 104855 . 111876)) (
111879 115712 (\TEDIT.GET.OBJECT 111889 . 115710)) (115777 150880 (\TEDIT.PUT.PCTB 115787 . 125844) (
\TEDIT.PUT.PCTB.PIECEDATA 125846 . 129044) (\TEDIT.PUT.TRAILER 129046 . 130374) (
\TEDIT.PUT.PCTB.MERGEABLE 130376 . 134149) (\TEDIT.PUT.UTF8.SPLITPIECES 134151 . 138853) (
\TEDIT.PUT.MCCS.SPLITPIECES 138855 . 140433) (\TEDIT.PUT.PCTB.NEXTNEW 140435 . 145041) (
\TEDIT.INSERT.NEWPIECES 145043 . 148478) (\TEDIT.PUTRESET 148480 . 148722) (\ARBOUT 148724 . 149448) (
\ATMOUT 149450 . 150055) (\DWOUT 150057 . 150336) (\STRINGOUT 150338 . 150878)) (150881 163615 (
\TEDIT.PUT.CHARLOOKS.LIST 150891 . 152563) (\TEDIT.PUT.SINGLE.CHARLOOKS 152565 . 158845) (
\TEDIT.PUT.CHARLOOKS 158847 . 160186) (\TEDIT.PUT.CHARLOOKS1 160188 . 161239) (\TEDIT.PUT.OBJECT
161241 . 163613)) (163616 171255 (\TEDIT.PUT.PARALOOKS.LIST 163626 . 164528) (
\TEDIT.PUT.SINGLE.PARALOOKS 164530 . 170114) (\TEDIT.PUT.PARALOOKS 170116 . 171253)) (171350 174755 (
TEDITFROMLISPSOURCE 171360 . 174004) (SHELLSCRIPTP 174006 . 174235) (TEDITFROMSHELLSCRIPT 174237 .
174753)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Nov-2025 08:40:56" {WMEDLEY}<library>TEDIT>TEDIT-FNKEYS.;317 109076
(FILECREATED " 8-Feb-2026 19:54:41" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;318 109228
:EDIT-BY rmk
:CHANGES-TO (VARS TEDIT.BASIC.CHARBINDINGS)
:CHANGES-TO (VARS TEDIT.BASIC.CHARBINDINGS ORIG.TEDIT.CHARACTIONS)
:PREVIOUS-DATE "24-Nov-2025 00:38:18" {WMEDLEY}<library>TEDIT>TEDIT-FNKEYS.;316)
:PREVIOUS-DATE "24-Nov-2025 08:40:56" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;317)
(PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
@@ -1776,6 +1776,8 @@
(:PRINT.MENU \TEDIT.PRINT.MENU)
(:EXPAND \TEDIT.ABBREV.EXPAND)
(:GET.OBJECT GET.OBJ.FROM.USER)
(:PAGENUMOBJ (TEDIT.INSERT.OBJECT (TEDIT.PAGENO.CREATE)
TSTREAM))
(:OPENLINE \TEDIT.KEY.OPENLINE)
(* ;; "")
@@ -1913,6 +1915,7 @@
(:PRINT.MENU "Meta,P" "Meta,p")
(:EXPAND "^X")
(:GET.OBJECT "^O")
(:PAGENUMOBJ "^P")
(* ;; "")
@@ -1986,30 +1989,30 @@
(RPAQ TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5031 23296 (TEDIT.INSTALL.CHARBINDINGS 5041 . 7892) (TEDIT.CLEAR.CHARBINDINGS 7894 .
10914) (TEDIT.GET.CHARACTION 10916 . 13697) (TEDIT.GET.CHARBINDING 13699 . 15876) (
TEDIT.GET.ALL.CHARBINDINGS 15878 . 18377) (TEDIT.CHARBINDINGS.INVERT 18379 . 19658) (
TEDIT.GET.ALL.CHARACTIONS 19660 . 21982) (TEDIT.CONFLICTING.CHARBINDINGS 21984 . 23294)) (23356 33411
(\TEDIT.KEY.CHARLOOKS 23366 . 24558) (\TEDIT.KEY.QUAD 24560 . 26653) (\TEDIT.DEFAULTSSEL 26655 . 27266
) (\TEDIT.SETDEFAULT.FROM.SEL 27268 . 27945) (\TEDIT.KEY.SIZE 27947 . 29143) (\TEDIT.SUBSCRIPTSEL
29145 . 29348) (\TEDIT.SUPERSCRIPTSEL 29350 . 29554) (\TEDIT.KEY.TRANSFORM 29556 . 31553) (
\TEDIT.KEY.OPENLINE 31555 . 32009) (\TEDIT.KEY.FAMILYN 32011 . 33409)) (33412 33701 (CAP-CASECODE
33422 . 33699)) (33735 37167 (\TEDIT.SHOWCARETLOOKS 33745 . 36260) (\TEDIT.DESCRIBEFONT 36262 . 37165)
) (37198 52171 (\TEDIT.ONECHAR.BACKWARD 37208 . 38355) (\TEDIT.ONECHAR.FORWARD 38357 . 39593) (
\TEDIT.ONELINE.UP 39595 . 42556) (\TEDIT.ONELINE.DOWN 42558 . 44215) (\TEDIT.ONELINE.MOVE 44217 .
46504) (\TEDIT.ONEWORD.BACKWARD 46506 . 47694) (\TEDIT.ONEWORD.FORWARD 47696 . 48883) (
\TEDIT.LINE.BEGIN 48885 . 49964) (\TEDIT.LINE.END 49966 . 51203) (\TEDIT.DOCUMENT.BEGIN 51205 . 51564)
(\TEDIT.DOCUMENT.END 51566 . 52169)) (52172 55480 (\TEDIT.LINEDELETE.FORWARD 52182 . 53291) (
\TEDIT.LINEDELETE.BACKWARD 53293 . 54432) (\TEDIT.LINEDELETE 54434 . 55478)) (55481 58009 (
\TEDIT.KEY.NEST 55491 . 58007)) (58010 59292 (\TEDIT.KEY.WRAP 58020 . 59290)) (59383 67431 (
\TEDIT.KEY.FIND 59393 . 64571) (\TEDIT.KEY.FIND.SEARCHSTRING 64573 . 65713) (\TEDIT.GET.TARGET.STRING
65715 . 67429)) (67462 70094 (\TEDIT.KEY.SUBSTITUTE 67472 . 67693) (\TEDIT.MANPAGE 67695 . 68942) (
\TEDIT.CALL.ED 68944 . 69774) (\TEDIT.SELECT.ALL 69776 . 70092)) (70121 75811 (\TEDIT.CLIPBOARD 70131
. 71886) (\TEDIT.COPYTOCLIPBOARD 71888 . 72668) (\TEDIT.EXTRACTTOCLIPBOARD 72670 . 72865) (
\TEDIT.WRITE.SEL 72867 . 75809)) (75977 88484 (\TEDIT.READTABLE 75987 . 76923) (
\TEDIT.WORDBOUND.READTABLE 76925 . 79973) (TEDIT.GETSYNTAX 79975 . 81204) (TEDIT.SETSYNTAX 81206 .
82520) (TEDIT.GETFUNCTION 82522 . 83995) (TEDIT.SETFUNCTION 83997 . 86153) (TEDIT.WORDGET 86155 .
86416) (TEDIT.WORDSET 86418 . 87158) (TEDIT.ATOMBOUND.READTABLE 87160 . 88482)) (88585 95573 (
TEDIT.BUTTONS.BUILD 88595 . 93841) (TEDIT.BUTTONBITMAP.FILL 93843 . 95571)) (98038 98626 (
\TEDIT.TTCCLASS 98048 . 98624)))))
(FILEMAP (NIL (5054 23319 (TEDIT.INSTALL.CHARBINDINGS 5064 . 7915) (TEDIT.CLEAR.CHARBINDINGS 7917 .
10937) (TEDIT.GET.CHARACTION 10939 . 13720) (TEDIT.GET.CHARBINDING 13722 . 15899) (
TEDIT.GET.ALL.CHARBINDINGS 15901 . 18400) (TEDIT.CHARBINDINGS.INVERT 18402 . 19681) (
TEDIT.GET.ALL.CHARACTIONS 19683 . 22005) (TEDIT.CONFLICTING.CHARBINDINGS 22007 . 23317)) (23379 33434
(\TEDIT.KEY.CHARLOOKS 23389 . 24581) (\TEDIT.KEY.QUAD 24583 . 26676) (\TEDIT.DEFAULTSSEL 26678 . 27289
) (\TEDIT.SETDEFAULT.FROM.SEL 27291 . 27968) (\TEDIT.KEY.SIZE 27970 . 29166) (\TEDIT.SUBSCRIPTSEL
29168 . 29371) (\TEDIT.SUPERSCRIPTSEL 29373 . 29577) (\TEDIT.KEY.TRANSFORM 29579 . 31576) (
\TEDIT.KEY.OPENLINE 31578 . 32032) (\TEDIT.KEY.FAMILYN 32034 . 33432)) (33435 33724 (CAP-CASECODE
33445 . 33722)) (33758 37190 (\TEDIT.SHOWCARETLOOKS 33768 . 36283) (\TEDIT.DESCRIBEFONT 36285 . 37188)
) (37221 52194 (\TEDIT.ONECHAR.BACKWARD 37231 . 38378) (\TEDIT.ONECHAR.FORWARD 38380 . 39616) (
\TEDIT.ONELINE.UP 39618 . 42579) (\TEDIT.ONELINE.DOWN 42581 . 44238) (\TEDIT.ONELINE.MOVE 44240 .
46527) (\TEDIT.ONEWORD.BACKWARD 46529 . 47717) (\TEDIT.ONEWORD.FORWARD 47719 . 48906) (
\TEDIT.LINE.BEGIN 48908 . 49987) (\TEDIT.LINE.END 49989 . 51226) (\TEDIT.DOCUMENT.BEGIN 51228 . 51587)
(\TEDIT.DOCUMENT.END 51589 . 52192)) (52195 55503 (\TEDIT.LINEDELETE.FORWARD 52205 . 53314) (
\TEDIT.LINEDELETE.BACKWARD 53316 . 54455) (\TEDIT.LINEDELETE 54457 . 55501)) (55504 58032 (
\TEDIT.KEY.NEST 55514 . 58030)) (58033 59315 (\TEDIT.KEY.WRAP 58043 . 59313)) (59406 67454 (
\TEDIT.KEY.FIND 59416 . 64594) (\TEDIT.KEY.FIND.SEARCHSTRING 64596 . 65736) (\TEDIT.GET.TARGET.STRING
65738 . 67452)) (67485 70117 (\TEDIT.KEY.SUBSTITUTE 67495 . 67716) (\TEDIT.MANPAGE 67718 . 68965) (
\TEDIT.CALL.ED 68967 . 69797) (\TEDIT.SELECT.ALL 69799 . 70115)) (70144 75834 (\TEDIT.CLIPBOARD 70154
. 71909) (\TEDIT.COPYTOCLIPBOARD 71911 . 72691) (\TEDIT.EXTRACTTOCLIPBOARD 72693 . 72888) (
\TEDIT.WRITE.SEL 72890 . 75832)) (76000 88507 (\TEDIT.READTABLE 76010 . 76946) (
\TEDIT.WORDBOUND.READTABLE 76948 . 79996) (TEDIT.GETSYNTAX 79998 . 81227) (TEDIT.SETSYNTAX 81229 .
82543) (TEDIT.GETFUNCTION 82545 . 84018) (TEDIT.SETFUNCTION 84020 . 86176) (TEDIT.WORDGET 86178 .
86439) (TEDIT.WORDSET 86441 . 87181) (TEDIT.ATOMBOUND.READTABLE 87183 . 88505)) (88608 95596 (
TEDIT.BUTTONS.BUILD 88618 . 93864) (TEDIT.BUTTONBITMAP.FILL 93866 . 95594)) (98061 98649 (
\TEDIT.TTCCLASS 98071 . 98647)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Sep-2025 19:05:00" {WMEDLEY}<library>tedit>TEDIT-HCPY.;179 30623
(FILECREATED "15-Jan-2026 11:08:15" {WMEDLEY}<library>tedit>TEDIT-HCPY.;196 32421
:EDIT-BY rmk
:CHANGES-TO (VARS TEDIT-HCPYCOMS)
:CHANGES-TO (FNS TEDIT.IMAGEFILE.MESSAGE TEDIT.FORMAT.HARDCOPY)
:PREVIOUS-DATE " 9-Sep-2025 21:52:28" {WMEDLEY}<library>tedit>TEDIT-HCPY.;177)
:PREVIOUS-DATE "24-Dec-2025 11:16:22" {WMEDLEY}<library>tedit>TEDIT-HCPY.;194)
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
@@ -15,9 +15,10 @@
((COMS
(* ;; "Generic interface functions and common code")
(FNS TEDIT.HARDCOPY \TEDIT.PRINT.MENU TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE
\TEDIT.HARDCOPY.FORMATLINE.HEADINGS \TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYFMTSPEC
\TEDIT.INTEGER.IMAGEBOX \TEDIT.DISPLAY.DIACRITIC))
(FNS TEDIT.HARDCOPY TEDIT.FORMAT.HARDCOPY TEDIT.IMAGEFILE.MESSAGE \TEDIT.PRINT.MENU
\TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE.HEADINGS
\TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX
\TEDIT.DISPLAY.DIACRITIC))
(COMS
(* ;; "Functions for scaling regions as needed during hardcopy.")
@@ -27,9 +28,9 @@
(INITVARS (TEDIT.DEFAULTPAGEREGION (\TEDIT.SCALEREGION MICASPERINCH
(CREATEREGION 1.1 0.75 6.4 9.25]
(COMS
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. THIS IS SCREWY")
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. Eliminated postscript, but this still may be screwy")
(FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPYFILEFN \TEDIT.POSTSCRIPT.HARDCOPY))
(FNS \TEDIT.HARDCOPYFILEFN))
[COMS
(* ;; "vars for Japanese Line Break")
@@ -56,68 +57,120 @@
(TEDIT.HARDCOPY
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS)
(* ; "Edited 17-Dec-2025 01:06 by rmk")
(* ; "Edited 6-Mar-2024 23:33 by rmk")
(* ; "Edited 5-Jan-88 16:09 by jds")
(* ;; "Send the text to a printer, unless DONTSEND. If DONTSEND and we can't find a server, we'll get the DEFAULTPRINTERTYPE.")
(CL:UNLESS SERVER (SETQ SERVER DEFAULTPRINTINGHOST))
(CL:UNLESS SERVER
(SETQ SERVER (CAR (DEFAULTPRINTERS))))
(COND
[(OR SERVER DONTSEND)
(for IMAGETYPE in (PRINTERPROP (PRINTERTYPE SERVER)
'CANPRINT)
do (RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS
do (RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS
IMAGETYPE)) finally (ERROR (CONCAT "Can't print TEDIT documents on a "
(PRINTERTYPE SERVER)
" printer."]
(T (TEDIT.PROMPTPRINT (TEXTOBJ STREAM)
"Can't HARDCOPY: No print server specified." T])
(TEDIT.FORMAT.HARDCOPY
[LAMBDA (TSTREAM IMAGESTREAM DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG
ENDPG QUIET) (* ; "Edited 15-Jan-2026 08:52 by rmk")
(* ; "Edited 14-Dec-2025 17:40 by rmk")
(* ; "Edited 8-Dec-2025 18:08 by rmk")
(* ; "Edited 7-Dec-2025 15:06 by rmk")
(* ; "Edited 19-Sep-2025 22:04 by rmk")
(* ; "Edited 18-Sep-2025 10:11 by rmk")
(* ; "Edited 12-Sep-2025 23:54 by rmk")
(* ; "Edited 5-Jun-2025 08:24 by rmk")
(* ; "Edited 22-Apr-2025 08:12 by rmk")
(* ; "Edited 30-Aug-2024 15:45 by rmk")
(* ; "Edited 5-Apr-2024 08:01 by rmk")
(* ; "Edited 19-Jan-2024 23:39 by rmk")
(* ; "Edited 15-Nov-2023 23:56 by rmk")
(* ; "Edited 4-Jul-2023 11:16 by rmk")
(* ; "Edited 2-Oct-2022 00:00 by rmk")
(* ;
 "Edited 25-May-93 13:06 by sybalsky:mv:envos")
(* ;; "Format a document for hardcopy. Returns NIL if the before-print-fn said not to print.")
(* ;; "TEXTSTREAM is either already a textstream or somehow denotes a tedit-formatted file, otherwise an error. We don't here try to decide that a non-formatted file is a plain text file, as opposed binary or anything else.")
(RESETLST
(TEDIT.PROMPTCLEAR TSTREAM)
(LET [(IMAGEFILE (TEDIT.TO.IMAGEFILE TSTREAM IMAGESTREAM (OR IMAGETYPE DEFAULTPRINTERTYPE)
`(,@PRINTOPTIONS FIRSTPG# ,FIRSTPG# STARTPG ,STARTPG ENDPG
,ENDPG DOCUMENT.NAME ,BREAKPAGETITLE]
(CL:UNLESS (OR DONTSEND (EQ IMAGEFILE IMAGESTREAM))
(* ;; "If the caller gave us an already open image stream, not just a filename (or NIL), we assume that the caller will close it and send to the printer, if necessary.")
(SEND.FILE.TO.PRINTER IMAGEFILE SERVER `(DOCUMENT.NAME ,BREAKPAGETITLE
,@PRINTOPTIONS DOCUMENT.NAME
"TEdit Hardcopy Output")))
(CL:UNLESS QUIET (TEDIT.IMAGEFILE.MESSAGE TSTREAM SERVER))
IMAGEFILE))])
(TEDIT.IMAGEFILE.MESSAGE
[LAMBDA (TSTREAM SERVER) (* ; "Edited 15-Jan-2026 11:07 by rmk")
(* ; "Edited 14-Dec-2025 17:40 by rmk")
(* ;; "Description of last imagefile goes in promptwindow")
(LET* [(LASTIMAGEFILE (GETTEXTPROP TSTREAM 'LASTIMAGEFILE))
(NPAGES (pop LASTIMAGEFILE))
(IMAGEFILE (pop LASTIMAGEFILE))
(PRINTERNAME (OR (pop LASTIMAGEFILE)
(CL:IF (LISTP SERVER)
(CADR SERVER)
SERVER)]
(TEDIT.PROMPTPRINT TSTREAM [CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES)
""
"s")
(if PRINTERNAME
then (CONCAT " printed on " PRINTERNAME)
elseif (STREAMP IMAGEFILE)
then " printed"
else (CONCAT " on " (PSEUDOFILENAME IMAGEFILE]
T])
(\TEDIT.PRINT.MENU
[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 (GETTOBJ (TEXTOBJ TSTREAM)
PRIMARYPANE)))
[LAMBDA (TSTREAM) (* ; "Edited 17-Dec-2025 00:09 by rmk")
(* ; "Edited 14-Dec-2025 17:38 by rmk")
(* ; "Edited 13-Dec-2025 08:35 by rmk")
(* ; "Edited 19-Sep-2025 07:43 by rmk")
(* ; "Edited 28-Jun-2024 22:09 by rmk")
(* ; "Edited 25-Jun-2023 13:16 by rmk")
(SETQ TSTREAM (TEXTSTREAM (GETTOBJ (TEXTOBJ TSTREAM)
PRIMARYPANE)))
(TEDIT.PROMPTCLEAR TSTREAM) (* ; "Edited 6-Jun-2023 17:48 by rmk")
(LET (FILE&TYPE)
(SELECTQ [MENU (create MENU
ITEMS _ '(("Print to a file" 'FILE
"Puts image on a file; prompts for filename and format"
)
("Send to a printer" 'PRINTER
"Sends image to a printer of your choosing"]
(FILE (HARDCOPYIMAGEW.TOFILE W))
(PRINTER (HARDCOPYIMAGEW.TOPRINTER W))
NIL])
(TEDIT.HCPYFILE
[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")
(* ;; "Create a hardcopy-format FILE from the text on TSTREAM, with the file type depending on what the default printer is.")
(LET ([IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE)
'CANPRINT]
(TEXTOBJ (TEXTOBJ TSTREAM))
FILENM TXTFILE)
(CL:WHEN [SETQ FILENM (OR FILE (\TEDIT.MAKEFILENAME
(TEDIT.GETINPUT TEXTOBJ (CONCAT IMAGETYPE " file name: ")
(COND
((type? STREAM (SETQ TXTFILE (fetch (TEXTOBJ
TXTFILE)
of TEXTOBJ)))
(* ;
 "There was a file, so supply default")
(PACKFILENAME 'VERSION NIL 'EXTENSION
(OR (CAR (PRINTFILETYPE IMAGETYPE
'EXTENSION))
'HCPY)
'BODY
(fetch (STREAM FULLFILENAME) of TXTFILE]
(if FILENM
then (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE)
else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
(FILE [LET [(FILENAME (GETTEXTPROP TSTREAM 'FILENAME]
(CL:WHEN FILENAME
(SETQ FILENAME (PACKFILENAME
'VERSION NIL 'EXTENSION
[L-CASE (CAR (EXTENSIONS.FOR.IMAGEFILETYPE
(CAR (PRINTERPROP (PRINTERTYPE
:DEFAULTPRINTER)
'CANPRINT]
'BODY FILENAME)))
(CL:WHEN (SETQ FILE&TYPE (GetImageFile FILENAME))
(TEDIT.TO.IMAGEFILE TSTREAM (CAR FILE&TYPE)
(CDR FILE&TYPE)))])
(PRINTER [SEND.FILE.TO.PRINTER TSTREAM (GetPrinterName)
`(HEADING ,(GETTEXTPROP TSTREAM 'FILENAME])
NIL)
(TEDIT.IMAGEFILE.MESSAGE TSTREAM])
(\TEDIT.HARDCOPY.DISPLAYLINE
[LAMBDA (TSTREAM LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 21-Apr-2025 19:02 by rmk")
@@ -415,31 +468,12 @@
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. THIS IS SCREWY")
(* ;;
"Support for the window-menu's HARDCOPY button, LISTFILES, etc. Eliminated postscript, but this still may be screwy"
)
(DEFINEQ
(TEDIT.HARDCOPYFN
[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:")
(* ;;
 "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")
(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!")
(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")
(LET [(STRM (OR (GETTOBJ (TEXTOBJ W)
@@ -452,22 +486,6 @@
(PACKFILENAME 'VERSION NIL 'EXTENSION (OR EXT 'IMAGEFILE)
'BODY
(FULLNAME STRM)))])
(\TEDIT.POSTSCRIPT.HARDCOPY
[LAMBDA (FILE PFILE) (* ; "Edited 4-Oct-2022 10:40 by rmk")
(* ; "Edited 1-Oct-2022 22:08 by rmk")
(* ; "Edited 12-Jun-90 18:35 by mitani")
(* ;; "Send the document FILE to the printer (or to a print file, as determined by PFILE).")
(CL:WITH-OPEN-STREAM (TEXT-STREAM (OPENTEXTSTREAM FILE))
(RESETLST
[RESETSAVE (\TEDIT.MARKACTIVE (TEXTOBJ TEXT-STREAM))
'(AND (\TEDIT.MARKINACTIVE OLDVALUE]
[RESETSAVE NIL `(AND (CLOSEF? ',PFILE]
(replace (TEXTOBJ EDITOPACTIVE) of (TEXTOBJ TEXT-STREAM) with 'Hardcopy)
(TEDIT.FORMAT.HARDCOPY TEXT-STREAM PFILE T NIL NIL NIL 'POSTSCRIPT)
PFILE)])
)
@@ -505,11 +523,10 @@
(CLOSEF DOC])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2652 25209 (TEDIT.HARDCOPY 2662 . 3795) (\TEDIT.PRINT.MENU 3797 . 4763) (TEDIT.HCPYFILE
4765 . 6939) (\TEDIT.HARDCOPY.DISPLAYLINE 6941 . 16164) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 16166 .
17895) (\TEDIT.HARDCOPY.MODIFYLOOKS 17897 . 20078) (\TEDIT.HCPYFMTSPEC 20080 . 23538) (
\TEDIT.INTEGER.IMAGEBOX 23540 . 24211) (\TEDIT.DISPLAY.DIACRITIC 24213 . 25207)) (25284 26114 (
\TEDIT.SCALEREGION 25294 . 26112)) (26367 29180 (TEDIT.HARDCOPYFN 26377 . 27682) (
\TEDIT.HARDCOPYFILEFN 27684 . 28245) (\TEDIT.POSTSCRIPT.HARDCOPY 28247 . 29178)) (29799 30600 (
TEDIT-BOOK 29809 . 30598)))))
(FILEMAP (NIL (2727 29208 (TEDIT.HARDCOPY 2737 . 3995) (TEDIT.FORMAT.HARDCOPY 3997 . 7234) (
TEDIT.IMAGEFILE.MESSAGE 7236 . 8533) (\TEDIT.PRINT.MENU 8535 . 10938) (\TEDIT.HARDCOPY.DISPLAYLINE
10940 . 20163) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 20165 . 21894) (\TEDIT.HARDCOPY.MODIFYLOOKS 21896
. 24077) (\TEDIT.HCPYFMTSPEC 24079 . 27537) (\TEDIT.INTEGER.IMAGEBOX 27539 . 28210) (
\TEDIT.DISPLAY.DIACRITIC 28212 . 29206)) (29283 30113 (\TEDIT.SCALEREGION 29293 . 30111)) (30405 30978
(\TEDIT.HARDCOPYFILEFN 30415 . 30976)) (31597 32398 (TEDIT-BOOK 31607 . 32396)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Oct-2025 20:50:59" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;459 155349
(FILECREATED "16-Feb-2026 00:36:00" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;467 155443
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.MCCS.TRANSLATE)
:PREVIOUS-DATE " 5-Oct-2025 10:57:43" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;457)
:PREVIOUS-DATE "10-Feb-2026 11:07:12" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;465)
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
@@ -60,7 +60,6 @@
(* ;; "Public entries")
(FNS TEDIT.LOOKS TEDIT.GET.LOOKS TEDIT.SUBLOOKS TEDIT.FINDLOOKS)
[INITVARS (TEDIT.FONTCLASSES '(DISPLAY PDF POSTSCRIPT INTERPRESS]
(FNS \TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.CHARLOOKS.NEW \TEDIT.CHARLOOKS.CHANGE.FONT
\TEDIT.FONT.NEXTSIZE \TEDIT.LOOKS \TEDIT.FONTCOPY \TEDIT.COERCE.FONTCLASS
\TEDIT.FONTCLASS.TO.FONT))
@@ -925,7 +924,8 @@
(DEFINEQ
(\TEDIT.MCCS.TRANSLATE
[LAMBDA (TSTREAM) (* ; "Edited 6-Oct-2025 20:50 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 16-Feb-2026 00:35 by rmk")
(* ; "Edited 6-Oct-2025 20:50 by rmk")
(* ; "Edited 5-Oct-2025 10:57 by rmk")
(* ; "Edited 25-Sep-2025 21:30 by rmk")
(* ; "Edited 9-Sep-2025 21:48 by rmk")
@@ -955,19 +955,17 @@
(SETQ CLOOKS
(PCHARLOOKS PC))
CLFONT]
do (for OFFSET OLDCODE STRING FAT from 1 to (PLEN PC) eachtime (SETQ OLDCODE
(
\TEDIT.PIECE.NTHCHARCODE
PC OFFSET))
do (for OFFSET OLDCODE STRING FAT from 0 to (PLAST PC)
eachtime (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE PC OFFSET))
unless (EQ OLDCODE (APPLY* TOMCCSFN OLDCODE))
do
(* ;; "This piece has recoded character. Start over to convert it to a string piece with necessary code conversions. (The logic to split the original piece at just the changes while still preserving the iteration would be very complicated).")
(SETQ STRING (ALLOCSTRING (PLEN PC)))
[for OFFSET from 1 to (PLEN PC) do (RPLCHARCODE STRING OFFSET
(APPLY* TOMCCSFN (
[for I from 0 to (PLAST PC) do (RPLCHARCODE STRING (ADD1 I)
(APPLY* TOMCCSFN (
\TEDIT.PIECE.NTHCHARCODE
PC OFFSET]
PC I]
(SETQ FAT (ffetch (STRINGP FATSTRINGP) of STRING))
(FSETPC PC PTYPE (CL:IF FAT
FATSTRING.PTYPE
@@ -1375,12 +1373,11 @@
(TEDIT.NORMALIZECARET TEXTOBJ)
(RETURN (\TEDIT.COPYSEL (FGETTOBJ TEXTOBJ SEL])])
)
(RPAQ? TEDIT.FONTCLASSES '(DISPLAY PDF POSTSCRIPT INTERPRESS))
(DEFINEQ
(\TEDIT.CHANGE.CHARLOOKS
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 31-Jul-2025 09:18 by rmk")
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 10-Feb-2026 11:06 by rmk")
(* ; "Edited 31-Jul-2025 09:18 by rmk")
(* ; "Edited 22-Apr-2025 20:17 by rmk")
(* ; "Edited 21-Apr-2025 20:17 by rmk")
(* ; "Edited 20-Apr-2025 13:27 by rmk")
@@ -1406,10 +1403,12 @@
(* ;;; "Internal programmatic interface to changing character looks. DOES NOT CHANGE the current selection (unless it's the TARGETSEL).")
(PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
SELPIECES NEWLOOKSLIST FONT DIRTY) (* ;
 "Construct the set of new looks to apply:")
SELPIECES NEWLOOKSLIST FONT DIRTY)
(CL:UNLESS TARGETSEL
(SETQ TARGETSEL (TEXTSEL TEXTOBJ)))
(CL:WHEN (EQ 0 (GETSEL TARGETSEL DCH))
(TEDIT.PROMPTPRINT TSTREAM "No characters are selected" T)
(RETURN))
(CL:UNLESS (AND NEWLOOKS (FGETSEL TARGETSEL SET)
(NOT (\TEDIT.READONLY TSTREAM NIL (GETSEL TARGETSEL CH#)))
(ILEQ (GETSEL TARGETSEL CH#)
@@ -2106,7 +2105,8 @@
then (\TEDIT.CHANGE.PARALOOKS TSTREAM NEWLOOKS TARGETSEL)))])
(\TEDIT.CHANGE.PARALOOKS
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 21-Apr-2025 23:27 by rmk")
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 10-Feb-2026 11:07 by rmk")
(* ; "Edited 21-Apr-2025 23:27 by rmk")
(* ; "Edited 20-Apr-2025 13:27 by rmk")
(* ; "Edited 16-Apr-2025 09:05 by rmk")
(* ; "Edited 6-Apr-2025 14:29 by rmk")
@@ -2129,6 +2129,9 @@
NEWPAGEAFTER HEADINGKEEP KEEP HARDCOPY USERINFO REVISED STYLE
CHARSTYLES COLUMN TABS DEFAULTTAB MARGINBAR))
PARAPIECES)
(CL:WHEN (EQ 0 (TEXTLEN TEXTOBJ))
(TEDIT.PROMPTPRINT TSTREAM "No text to modify" T)
(RETURN))
(CL:UNLESS TARGETSEL
(SETQ TARGETSEL (TEXTSEL TEXTOBJ)))
(CL:UNLESS (AND NEWLOOKS (FGETSEL TARGETSEL SET)
@@ -2461,26 +2464,26 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (22099 24041 (\TEDIT.CHARLOOKS.DEFPRINT 22109 . 23245) (\TEDIT.PARALOOKS.DEFPRINT 23247
. 24039)) (24145 24531 (\TEDIT.CREATE.FACE.MENU 24155 . 24327) (\TEDIT.CREATE.SIZE.MENU 24329 . 24529
)) (25535 27424 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25545 . 27422)) (27696 52953 (
\TEDIT.CHARLOOKS.FROM.FONT 27706 . 29990) (\TEDIT.EQCLOOKS 29992 . 33023) (\TEDIT.SAMECLOOKS 33025 .
36196) (TEDIT.CARETLOOKS 36198 . 37744) (TEDIT.COPY.LOOKS 37746 . 41029) (
\TEDIT.UNPARSE.CHARLOOKS.LIST 41031 . 44525) (\TEDIT.MODIFYLOOKS 44527 . 46687) (TEDIT.NEW.FONT 46689
. 47136) (\TEDIT.CARETLOOKS.VERIFY 47138 . 47975) (\TEDIT.CARETPIECE 47977 . 48282) (
\TEDIT.GET.INSERT.CHARLOOKS 48284 . 51331) (\TEDIT.GET.TERMSA.WIDTHS 51333 . 51749) (
\TEDIT.PARSE.CHARLOOKS.LIST 51751 . 52951)) (52954 65081 (\TEDIT.MCCS.TRANSLATE 52964 . 58817) (
\TEDIT.CONVERT.TO.FORMATTED 58819 . 65079)) (65953 73290 (\TEDIT.UNIQUIFY.CHARLOOKS 65963 . 67623) (
\TEDIT.UNIQUIFY.PARALOOKS 67625 . 68892) (\TEDIT.UNIQUIFY.ALL 68894 . 70982) (
\TEDIT.FLUSH.UNUSED.LOOKS 70984 . 73288)) (73323 85281 (TEDIT.LOOKS 73333 . 75722) (TEDIT.GET.LOOKS
75724 . 78059) (TEDIT.SUBLOOKS 78061 . 82441) (TEDIT.FINDLOOKS 82443 . 85279)) (85350 115000 (
\TEDIT.CHANGE.CHARLOOKS 85360 . 94138) (\TEDIT.CHANGE.CHARLOOKS.NEW 94140 . 97955) (
\TEDIT.CHARLOOKS.CHANGE.FONT 97957 . 106264) (\TEDIT.FONT.NEXTSIZE 106266 . 107887) (\TEDIT.LOOKS
107889 . 111218) (\TEDIT.FONTCOPY 111220 . 112721) (\TEDIT.COERCE.FONTCLASS 112723 . 113874) (
\TEDIT.FONTCLASS.TO.FONT 113876 . 114998)) (115043 146691 (\TEDIT.EQFMTSPEC 115053 . 118268) (
TEDIT.GET.PARALOOKS 118270 . 122317) (\TEDIT.PARSE.PARALOOKS.LIST 122319 . 130352) (TEDIT.PARALOOKS
130354 . 131394) (\TEDIT.CHANGE.PARALOOKS 131396 . 138364) (\TEDIT.CHANGE.PARALOOKS.NEW 138366 .
142349) (TEDIT.COPY.PARALOOKS 142351 . 145025) (\TEDIT.PARABOUNDS 145027 . 146689)) (146751 154467 (
TEDIT.SUBPARALOOKS 146761 . 150863) (SAMEPARALOOKS 150865 . 154465)) (154468 155155 (
\TEDIT.MARK.REVISION 154478 . 155153)))))
(FILEMAP (NIL (22019 23961 (\TEDIT.CHARLOOKS.DEFPRINT 22029 . 23165) (\TEDIT.PARALOOKS.DEFPRINT 23167
. 23959)) (24065 24451 (\TEDIT.CREATE.FACE.MENU 24075 . 24247) (\TEDIT.CREATE.SIZE.MENU 24249 . 24449
)) (25455 27344 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25465 . 27342)) (27616 52873 (
\TEDIT.CHARLOOKS.FROM.FONT 27626 . 29910) (\TEDIT.EQCLOOKS 29912 . 32943) (\TEDIT.SAMECLOOKS 32945 .
36116) (TEDIT.CARETLOOKS 36118 . 37664) (TEDIT.COPY.LOOKS 37666 . 40949) (
\TEDIT.UNPARSE.CHARLOOKS.LIST 40951 . 44445) (\TEDIT.MODIFYLOOKS 44447 . 46607) (TEDIT.NEW.FONT 46609
. 47056) (\TEDIT.CARETLOOKS.VERIFY 47058 . 47895) (\TEDIT.CARETPIECE 47897 . 48202) (
\TEDIT.GET.INSERT.CHARLOOKS 48204 . 51251) (\TEDIT.GET.TERMSA.WIDTHS 51253 . 51669) (
\TEDIT.PARSE.CHARLOOKS.LIST 51671 . 52871)) (52874 64879 (\TEDIT.MCCS.TRANSLATE 52884 . 58615) (
\TEDIT.CONVERT.TO.FORMATTED 58617 . 64877)) (65751 73088 (\TEDIT.UNIQUIFY.CHARLOOKS 65761 . 67421) (
\TEDIT.UNIQUIFY.PARALOOKS 67423 . 68690) (\TEDIT.UNIQUIFY.ALL 68692 . 70780) (
\TEDIT.FLUSH.UNUSED.LOOKS 70782 . 73086)) (73121 85079 (TEDIT.LOOKS 73131 . 75520) (TEDIT.GET.LOOKS
75522 . 77857) (TEDIT.SUBLOOKS 77859 . 82239) (TEDIT.FINDLOOKS 82241 . 85077)) (85080 114853 (
\TEDIT.CHANGE.CHARLOOKS 85090 . 93991) (\TEDIT.CHANGE.CHARLOOKS.NEW 93993 . 97808) (
\TEDIT.CHARLOOKS.CHANGE.FONT 97810 . 106117) (\TEDIT.FONT.NEXTSIZE 106119 . 107740) (\TEDIT.LOOKS
107742 . 111071) (\TEDIT.FONTCOPY 111073 . 112574) (\TEDIT.COERCE.FONTCLASS 112576 . 113727) (
\TEDIT.FONTCLASS.TO.FONT 113729 . 114851)) (114896 146785 (\TEDIT.EQFMTSPEC 114906 . 118121) (
TEDIT.GET.PARALOOKS 118123 . 122170) (\TEDIT.PARSE.PARALOOKS.LIST 122172 . 130205) (TEDIT.PARALOOKS
130207 . 131247) (\TEDIT.CHANGE.PARALOOKS 131249 . 138458) (\TEDIT.CHANGE.PARALOOKS.NEW 138460 .
142443) (TEDIT.COPY.PARALOOKS 142445 . 145119) (\TEDIT.PARABOUNDS 145121 . 146783)) (146845 154561 (
TEDIT.SUBPARALOOKS 146855 . 150957) (SAMEPARALOOKS 150959 . 154559)) (154562 155249 (
\TEDIT.MARK.REVISION 154572 . 155247)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Oct-2025 12:55:36" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;498 183397
(FILECREATED " 9-Feb-2026 09:10:43" {WMEDLEY}<library>tedit>TEDIT-MENU.;510 183027
:EDIT-BY rmk
:CHANGES-TO (FNS MARGINBAR.NEUTRALIZE \TEDIT.PARALOOKS.TO.MARBAR)
:CHANGES-TO (FNS \TEDIT.PAGEMENU.CREATE)
:PREVIOUS-DATE "19-Oct-2025 15:14:00" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;496)
:PREVIOUS-DATE "27-Jan-2026 10:42:09" {WMEDLEY}<library>tedit>TEDIT-MENU.;508)
(PRETTYCOMPRINT TEDIT-MENUCOMS)
@@ -67,7 +67,7 @@
(* ;; "")
(* ; "CHARMENU")
[INITVARS (TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT))
[INITVARS (TEDIT.FONTDEVICES '(DISPLAY PDF))
(TEDIT.FONTFAMILIES '(Classic Modern Terminal Helvetica TimesRoman Gacha]
(FNS \TEDIT.CHARMENU.CREATE \TEDIT.CHARMENU.START \TEDIT.CHARMENU.SPEC \TEDIT.CHARMENU.PARSE
\TEDIT.CHARMENU.FILLIN \TEDIT.SHOW.CHARLOOKS \TEDIT.APPLY.CHARLOOKS
@@ -1381,7 +1381,8 @@
(DEFINEQ
(\TEDIT.EXPANDEDMENU.CREATE
[LAMBDA NIL (* ; "Edited 29-May-2025 09:31 by rmk")
[LAMBDA NIL (* ; "Edited 25-Jan-2026 10:52 by rmk")
(* ; "Edited 29-May-2025 09:31 by rmk")
(* ; "Edited 8-Mar-2025 12:27 by rmk")
(* ; "Edited 7-Jan-2025 16:05 by rmk")
(* ; "Edited 8-Nov-2024 08:35 by rmk")
@@ -1463,13 +1464,15 @@
TAB
(FIELD (IDENTIFIER SERVER)
(PRELABEL "server:")
(FIELDTYPE SYMBOL))
(FIELDTYPE SYMBOL)
(EMPTYVALUE NIL))
(FIELD (IDENTIFIER COPIES)
(PRELABEL "copies:")
(EMPTYVALUE 1)
(FIELDTYPE POSITIVENUMBER))
2
(NWAY (IDENTIFIER SIDES)
(BUTTONS (One% Side Duplex)))
3
(TOGGLE (IDENTIFIER DOUBLE-SIDED)
(LABEL "Double-sided"))
EOL TAB TAB (FIELD (IDENTIFIER MESSAGE/PHONE#)
(PRELABEL "Message/Phone#:")
(FIELDTYPE STRING])
@@ -1546,7 +1549,8 @@
(RETURN 'DON'T])
(\TEDIT.EXPANDEDMENU.ACTIONFN
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 29-May-2025 09:29 by rmk")
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 25-Jan-2026 11:05 by rmk")
(* ; "Edited 29-May-2025 09:29 by rmk")
(* ; "Edited 11-May-2025 15:01 by rmk")
(* ; "Edited 6-Apr-2025 14:39 by rmk")
(* ; "Edited 18-Mar-2025 23:54 by rmk")
@@ -1564,11 +1568,11 @@
(* ;
 "MBFN for TEdit default menu item buttons.")
(ERSETQ (RESETLST
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (SEL)
(FSETSEL SEL SET NIL]
MENUSEL))
(LET ((MENUTEXTOBJ (FTEXTOBJ MENUSTREAM))
STATES STATE)
[RESETSAVE (PROG1 OBJ
(IMAGEOBJPROP OBJ 'MENUBUTTON.SELECTED T))
'(AND (IMAGEOBJPROP OLDVALUE 'MENUBUTTON.SELECTED NIL]
(SELECTQ (IMAGEOBJPROP OBJ 'IDENTIFIER)
(QUIT (* ; "Is it OK to quit the main edit?")
(\TEDIT.FINISHEDIT? MAINSTREAM))
@@ -1636,29 +1640,21 @@
)
(EQ 'ON (LISTGET STATES 'CONFIRM))
(EQ 'ON (LISTGET STATES 'USENEWLOOKS])])
(HARDCOPY (SETQ STATES (MB.GET '(SERVER COPIES SIDES MESSAGE/PHONE#)
(HARDCOPY (SETQ STATES (MB.GET '(SERVER COPIES DOUBLE-SIDED MESSAGE/PHONE#)
MENUSTREAM
'STATE MENUSEL))
(LET ((SERVER (LISTGET STATES 'SERVER))
(COPIES (LISTGET STATES 'COPIES))
(SIDES (LISTGET STATES 'SIDES))
(LET ((COPIES (LISTGET STATES 'COPIES))
(MSG (LISTGET STATES 'MESSAGE/PHONE#))
PRINTOPTIONS)
(CL:UNLESS (AND SERVER (SETQ SERVER (\TEDIT.MAKEFILENAME
SERVER)))
(TEDIT.PROMPTPRINT MAINSTREAM
"Using default print server."))
(CL:WHEN COPIES
(SETQ PRINTOPTIONS (LIST '%#COPIES COPIES)))
(CL:WHEN SIDES
(push PRINTOPTIONS '%#SIDES (SELECTQ SIDES
(One% Side 1)
(Duplex 2)
NIL)))
(CL:WHEN (LISTGET STATES 'DOUBLE-SIDED)
(push PRINTOPTIONS '%#SIDES 2))
(CL:WHEN MSG
(push PRINTOPTIONS 'MESSAGE (\TEDIT.MAKEFILENAME MSG)))
(TEDIT.HARDCOPY MAINSTREAM NIL NIL NIL SERVER PRINTOPTIONS)))
(ERROR))))])
(SEND.FILE.TO.PRINTER MAINSTREAM (LISTGET STATES 'SERVER)
PRINTOPTIONS)))
(SHOULDNT))))])
)
@@ -1952,7 +1948,7 @@
(* ; "CHARMENU")
(RPAQ? TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT))
(RPAQ? TEDIT.FONTDEVICES '(DISPLAY PDF))
(RPAQ? TEDIT.FONTFAMILIES '(Classic Modern Terminal Helvetica TimesRoman Gacha))
(DEFINEQ
@@ -2371,7 +2367,9 @@
(DEFINEQ
(\TEDIT.PAGEMENU.CREATE
[LAMBDA (TSTREAM) (* ; "Edited 5-Jun-2025 18:41 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 9-Feb-2026 09:09 by rmk")
(* ; "Edited 26-Jan-2026 12:03 by rmk")
(* ; "Edited 5-Jun-2025 18:41 by rmk")
(* ; "Edited 11-May-2025 14:40 by rmk")
(* ; "Edited 27-Jan-2025 08:51 by rmk")
(* ; "Edited 7-Jan-2025 15:47 by rmk")
@@ -2411,16 +2409,10 @@
EOL "Paper Size: " (NWAY (IDENTIFIER PAPERSIZE)
(BUTTONS (Letter Legal A4))
(INITSTATE Letter))
8
16
(TOGGLE (LABEL "Landscape"))
7
(FIELD (IDENTIFIER STARTINGPAGE#)
(PRELABEL "Starting page #:")
(LABELFONT (HELVETICA 10))
(FIELDTYPE POSITIVENUMBER))
EOL
(TEXT (STRING "For page: ")
(FONT (HELVETICA 10)))
(TEXT (STRING "For page: "))
(NWAY (IDENTIFIER PAGEID)
(BUTTONS (|First(&Default)| Other% Left Other% Right)))
EOL
@@ -2430,8 +2422,7 @@
(* ;; "Page numbers")
5
(TEXT (STRING "Page numbers: ")
(FONT (HELVETICA 10)))
(TEXT (STRING "Page numbers: "))
(NWAY (IDENTIFIER PAGENOS)
(BUTTONS (No Yes Heading))
(INITSTATE Yes))
@@ -2454,14 +2445,18 @@
3 "Alignment:" 2 (NWAY (IDENTIFIER QUAD)
(BUTTONS (Left Centered Right))
(INITSTATE Centered))
EOL TAB (FIELD (IDENTIFIER FOLIOPRETEXT)
(PRELABEL "Text before number:"))
5
(FIELD (IDENTIFIER FOLIOPOSTTEXT)
(PRELABEL "Text after number:"))
EOL
(* ;; "")
(* ;; "Margins")
EOL 5 (TEXT (STRING "Margins: ")
(FONT (HELVETICA 10)))
EOL 5 (TEXT (STRING "Margins: "))
(FIELD (IDENTIFIER LEFTMARGIN)
(PRELABEL "Left")
(POSTLABEL "picas")
@@ -2489,7 +2484,6 @@
EOL 5 (FIELD (IDENTIFIER COLUMNS)
(PRELABEL "Columns:")
(LABELFONT (HELVETICA 10))
(INITSTATE 1)
(FIELDTYPE POSITIVENUMBER))
4
@@ -2735,7 +2729,8 @@
(TEDIT.BACKTOMAIN MENUSTREAM])
(\TEDIT.CHANGE.PAGELOOKS
[LAMBDA (MAINTEXTSTREAM PAGELOOKS) (* ; "Edited 11-May-2025 15:04 by rmk")
[LAMBDA (MAINTEXTSTREAM PAGELOOKS) (* ; "Edited 27-Jan-2026 10:41 by rmk")
(* ; "Edited 11-May-2025 15:04 by rmk")
(* ; "Edited 24-Dec-2024 21:28 by rmk")
(* ; "Edited 20-Oct-2024 17:17 by rmk")
(* ; "Edited 30-Aug-2024 23:43 by rmk")
@@ -2754,8 +2749,8 @@
((OFF NEUTRAL)
(RPLACA PLTAIL NIL))
NIL))
(SELECTQ PAGENOS
(Yes (* ;
(SELECTQ (L-CASE PAGENOS T)
((Yes T) (* ;
 "Page number format specfified in pagelooks menu")
(CL:UNLESS (AND (LISTGET PAGELOOKS 'PAGENUMBERX)
(LISTGET PAGELOOKS 'PAGENUMBERY))
@@ -2776,7 +2771,7 @@
(* ;; "Page numbers formatted/printed by image object in header paragraphs")
(push PAGEPROPS 'STARTINGPAGE# (LISTGET PAGELOOKS 'STARTINGPAGE#)))
NIL)
(SHOULDNT))
(CL:UNLESS (LISTGET PAGELOOKS 'COLUMNS)
(LISTPUT PAGELOOKS 'COLUMNS 1)
(RETURN))
@@ -2786,9 +2781,6 @@
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Please specify the space between columns" T T)
(RETURN))
[push PAGEPROPS 'LANDSCAPE? (EQ 'ON (LISTGET PAGELOOKS 'LANDSCAPE]
(* ;; "**EMPTY** may come from field values in the pagelooks menue")
(TEDIT.PAGEFORMAT MAINTEXTOBJ (TEDIT.SINGLE.PAGEFORMAT PAGENOS (LISTGET PAGELOOKS
'PAGENUMBERX)
(LISTGET PAGELOOKS 'PAGENUMBERY)
@@ -2907,32 +2899,32 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4972 16610 (TEDIT.ADD.MENUITEM 4982 . 7099) (TEDIT.DEFAULT.MENUFN 7101 . 13822) (
TEDIT.REMOVE.MENUITEM 13824 . 14821) (\TEDIT.CREATEMENU 14823 . 15388) (\TEDIT.MENU.WHENHELDFN 15390
. 16295) (\TEDIT.MENU.WHENSELECTEDFN 16297 . 16608)) (17424 65459 (DRAWMARGINSCALE 17434 . 20893) (
MARGINBAR 20895 . 28020) (MARGINBAR.CREATE 28022 . 32220) (MB.MARGINBAR.BUTTONEVENTINFN 32222 . 40024)
(MB.MARGINBAR.SELFN.TABS 40026 . 45266) (MB.MARGINBAR.SELFN.TABS.KIND 45268 . 46203) (
MARGINBAR.GETSTATEFN 46205 . 50192) (MARGINBAR.SETSTATEFN 50194 . 50404) (MARGINBAR.NEUTRALIZE 50406
. 51081) (MARGINBAR.LOOKS 51083 . 54189) (MB.MARGINBAR.SIZEFN 54191 . 54977) (MB.MARGINBAR.DISPLAYFN
54979 . 58040) (MDESCALE 58042 . 58582) (MSCALE 58584 . 58914) (MB.MARGINBAR.SHOWTAB 58916 . 61239) (
MB.MARGINBAR.TABTRACK 61241 . 62626) (MARGINBAR.INIT 62628 . 64021) (\TEDIT.PARALOOKS.TO.MARBAR 64023
. 65457)) (66284 73566 (TEDIT.MENUSTREAM 66294 . 67294) (TEDITMENUP 67296 . 68265) (\TEDIT.MENU.START
68267 . 72614) (\TEDIT.MENU.OPEN? 72616 . 72990) (\TEDIT.MENU.BUTTONEVENTFN 72992 . 73564)) (73885
81936 (\TEDIT.MENU.CREATE 73895 . 75835) (\TEDIT.MENU.PARSE 75837 . 79526) (\TEDIT.MENU.NEUTRALIZE
79528 . 81599) (\TEDITMENU.RECORD.UNFORMATTED 81601 . 81934)) (82002 101783 (
\TEDIT.EXPANDEDMENU.CREATE 82012 . 87479) (\TEDIT.EXPANDEDMENU.START 87481 . 89105) (
\TEDIT.EXPANDEDMENU.FN 89107 . 92362) (\TEDIT.EXPANDEDMENU.ACTIONFN 92364 . 101781)) (101845 121270 (
\TEDIT.PARAMENU.CREATE 101855 . 110586) (\TEDIT.PARAMENU.START 110588 . 111842) (
\TEDIT.APPLY.PARALOOKS 111844 . 112896) (\TEDIT.SHOW.PARALOOKS 112898 . 115615) (
\TEDIT.PARAMENU.FILLIN 115617 . 120366) (\TEDIT.PARAMENU.RESHAPEFN 120368 . 121268)) (121475 148317 (
\TEDIT.CHARMENU.CREATE 121485 . 124089) (\TEDIT.CHARMENU.START 124091 . 125381) (\TEDIT.CHARMENU.SPEC
125383 . 130066) (\TEDIT.CHARMENU.PARSE 130068 . 133236) (\TEDIT.CHARMENU.FILLIN 133238 . 137868) (
\TEDIT.SHOW.CHARLOOKS 137870 . 141415) (\TEDIT.APPLY.CHARLOOKS 141417 . 142578) (
\TEDIT.OFFSETTYPE.STATEFN 142580 . 144543) (\TEDIT.OTHER.STATECHANGEFN 144545 . 146190) (
\TEDIT.OTHER.SELECTFN 146192 . 148315)) (148379 177437 (\TEDIT.PAGEMENU.CREATE 148389 . 156901) (
\TEDIT.PAGEMENU.START 156903 . 157254) (\TEDIT.SHOW.PAGELOOKS 157256 . 159142) (\TEDIT.PAGEMENU.FILLIN
159144 . 160694) (\TEDIT.PAGEREGION.UNPARSE 160696 . 170095) (\TEDIT.APPLY.PAGELOOKS 170097 . 172024)
(\TEDIT.CHANGE.PAGELOOKS 172026 . 176593) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176595 . 177435)) (
177438 183241 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177448 . 180260) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN
180262 . 181687) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181689 . 183239)))))
(FILEMAP (NIL (4936 16574 (TEDIT.ADD.MENUITEM 4946 . 7063) (TEDIT.DEFAULT.MENUFN 7065 . 13786) (
TEDIT.REMOVE.MENUITEM 13788 . 14785) (\TEDIT.CREATEMENU 14787 . 15352) (\TEDIT.MENU.WHENHELDFN 15354
. 16259) (\TEDIT.MENU.WHENSELECTEDFN 16261 . 16572)) (17388 65423 (DRAWMARGINSCALE 17398 . 20857) (
MARGINBAR 20859 . 27984) (MARGINBAR.CREATE 27986 . 32184) (MB.MARGINBAR.BUTTONEVENTINFN 32186 . 39988)
(MB.MARGINBAR.SELFN.TABS 39990 . 45230) (MB.MARGINBAR.SELFN.TABS.KIND 45232 . 46167) (
MARGINBAR.GETSTATEFN 46169 . 50156) (MARGINBAR.SETSTATEFN 50158 . 50368) (MARGINBAR.NEUTRALIZE 50370
. 51045) (MARGINBAR.LOOKS 51047 . 54153) (MB.MARGINBAR.SIZEFN 54155 . 54941) (MB.MARGINBAR.DISPLAYFN
54943 . 58004) (MDESCALE 58006 . 58546) (MSCALE 58548 . 58878) (MB.MARGINBAR.SHOWTAB 58880 . 61203) (
MB.MARGINBAR.TABTRACK 61205 . 62590) (MARGINBAR.INIT 62592 . 63985) (\TEDIT.PARALOOKS.TO.MARBAR 63987
. 65421)) (66248 73530 (TEDIT.MENUSTREAM 66258 . 67258) (TEDITMENUP 67260 . 68229) (\TEDIT.MENU.START
68231 . 72578) (\TEDIT.MENU.OPEN? 72580 . 72954) (\TEDIT.MENU.BUTTONEVENTFN 72956 . 73528)) (73849
81900 (\TEDIT.MENU.CREATE 73859 . 75799) (\TEDIT.MENU.PARSE 75801 . 79490) (\TEDIT.MENU.NEUTRALIZE
79492 . 81563) (\TEDITMENU.RECORD.UNFORMATTED 81565 . 81898)) (81966 101368 (
\TEDIT.EXPANDEDMENU.CREATE 81976 . 87654) (\TEDIT.EXPANDEDMENU.START 87656 . 89280) (
\TEDIT.EXPANDEDMENU.FN 89282 . 92537) (\TEDIT.EXPANDEDMENU.ACTIONFN 92539 . 101366)) (101430 120855 (
\TEDIT.PARAMENU.CREATE 101440 . 110171) (\TEDIT.PARAMENU.START 110173 . 111427) (
\TEDIT.APPLY.PARALOOKS 111429 . 112481) (\TEDIT.SHOW.PARALOOKS 112483 . 115200) (
\TEDIT.PARAMENU.FILLIN 115202 . 119951) (\TEDIT.PARAMENU.RESHAPEFN 119953 . 120853)) (121049 147891 (
\TEDIT.CHARMENU.CREATE 121059 . 123663) (\TEDIT.CHARMENU.START 123665 . 124955) (\TEDIT.CHARMENU.SPEC
124957 . 129640) (\TEDIT.CHARMENU.PARSE 129642 . 132810) (\TEDIT.CHARMENU.FILLIN 132812 . 137442) (
\TEDIT.SHOW.CHARLOOKS 137444 . 140989) (\TEDIT.APPLY.CHARLOOKS 140991 . 142152) (
\TEDIT.OFFSETTYPE.STATEFN 142154 . 144117) (\TEDIT.OTHER.STATECHANGEFN 144119 . 145764) (
\TEDIT.OTHER.SELECTFN 145766 . 147889)) (147953 177067 (\TEDIT.PAGEMENU.CREATE 147963 . 156484) (
\TEDIT.PAGEMENU.START 156486 . 156837) (\TEDIT.SHOW.PAGELOOKS 156839 . 158725) (\TEDIT.PAGEMENU.FILLIN
158727 . 160277) (\TEDIT.PAGEREGION.UNPARSE 160279 . 169678) (\TEDIT.APPLY.PAGELOOKS 169680 . 171607)
(\TEDIT.CHANGE.PAGELOOKS 171609 . 176223) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176225 . 177065)) (
177068 182871 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177078 . 179890) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN
179892 . 181317) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181319 . 182869)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Jun-2025 08:24:12" {WMEDLEY}<library>tedit>TEDIT-PAGE.;222 134861
(FILECREATED "27-Jan-2026 10:30:27" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;243 130855
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY)
:CHANGES-TO (FNS TEDIT.SINGLE.PAGEFORMAT)
(VARS TEDIT-PAGECOMS)
:PREVIOUS-DATE "11-May-2025 15:03:00" {WMEDLEY}<library>tedit>TEDIT-PAGE.;221)
:PREVIOUS-DATE "17-Jan-2026 12:00:08" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;241)
(PRETTYCOMPRINT TEDIT-PAGECOMS)
@@ -50,7 +51,8 @@
72 72 NIL 1)
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72
72 72 NIL 1]
(FNS TEDIT.FORMAT.HARDCOPY)
(FNS TEDIT.TO.IMAGEFILE)
[P (DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE]
(COMS
(* ;; "Perform page layout, based on a regular expression of typed regions.")
@@ -313,7 +315,8 @@
(TEDIT.SINGLE.PAGEFORMAT
[LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS
PAGEPROPS PAPERSIZE) (* ; "Edited 11-May-2025 14:59 by rmk")
PAGEPROPS PAPERSIZE) (* ; "Edited 27-Jan-2026 10:30 by rmk")
(* ; "Edited 11-May-2025 14:59 by rmk")
(* ; "Edited 10-Jan-2025 11:41 by rmk")
(* ; "Edited 24-Dec-2024 21:20 by rmk")
(* ; "Edited 15-Aug-2024 23:01 by rmk")
@@ -356,7 +359,8 @@
(AND INTERCOL (SETQ INTERCOL (HCSCALE SCALEFACTOR INTERCOL)))
(SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT)
LEFT))
(CL:WHEN (EQ PAGE#S? 'Yes)
(CL:WHEN (MEMB (L-CASE PAGE#S? T)
'(T Yes))
(* ;; "This asserts that the page number's region is 4 inches wide. Why? What if the pretext/posttext is longer?")
@@ -631,150 +635,107 @@
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 72 72 NIL 1)))
(DEFINEQ
(TEDIT.FORMAT.HARDCOPY
[LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG
ENDPG QUIET) (* ; "Edited 5-Jun-2025 08:24 by rmk")
(* ; "Edited 22-Apr-2025 08:12 by rmk")
(* ; "Edited 23-Feb-2025 09:59 by rmk")
(* ; "Edited 30-Aug-2024 15:45 by rmk")
(* ; "Edited 10-Jul-2024 23:34 by rmk")
(* ; "Edited 29-Jun-2024 10:32 by rmk")
(* ; "Edited 5-Apr-2024 08:01 by rmk")
(* ; "Edited 16-Mar-2024 09:31 by rmk")
(* ; "Edited 7-Mar-2024 12:34 by rmk")
(* ; "Edited 19-Jan-2024 23:39 by rmk")
(* ; "Edited 24-Dec-2023 14:10 by rmk")
(* ; "Edited 15-Nov-2023 23:56 by rmk")
(* ; "Edited 22-Sep-2023 20:38 by rmk")
(* ; "Edited 4-Jul-2023 11:16 by rmk")
(* ; "Edited 2-Oct-2022 00:00 by rmk")
(* ;
 "Edited 25-May-93 13:06 by sybalsky:mv:envos")
(TEDIT.TO.IMAGEFILE
[LAMBDA (TSTREAM IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 17-Jan-2026 11:59 by rmk")
(* ; "Edited 15-Jan-2026 08:46 by rmk")
(* ; "Edited 25-Dec-2025 15:07 by rmk")
(* ; "Edited 20-Dec-2025 23:03 by rmk")
(* ; "Edited 14-Dec-2025 17:38 by rmk")
(* ; "Edited 27-Sep-2025 14:05 by rmk")
(* ; "Edited 19-Sep-2025 22:08 by rmk")
(* ;; "Format a document for hardcopy. Returns the number of pages printed (not the final page number!). Returns NIL if the before-print-fn said not to print.")
(* ;; "TEXTSTREAM is either already a textstream or somehow denotes a tedit-formatted file, otherwise an error. We don't here try to decide that a non-formatted file is a plain text file, as opposed binary or anything else.")
(* ;; "TSTREAM is either already a textstream or somehow denotes a tedit-formatted file, otherwise an error. ")
(RESETLST
(SETQ TEXTSTREAM (if (TEXTSTREAM TEXTSTREAM T)
elseif (TEDIT.FORMATTEDFILEP TEXTSTREAM)
then [RESETSAVE (SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTSTREAM))
`(PROGN (CLOSEF? OLDVALUE]
TEXTSTREAM
else (ERROR TEXTSTREAM "is not a Tedit stream")))
(PROG ((TEXTOBJ (FTEXTOBJ TEXTSTREAM))
[FORMATTINGSTATE (create PAGEFORMATTINGSTATE
PAGE# _ (FIXP FIRSTPG#)
FIRSTPAGE _ T
STATE _ FIRSTPG#
MINPAGE# _ STARTPG
MAXPAGE# _ (OR ENDPG 65535)
CHNO _ 1
PAGEHEADINGS _ (LIST NIL NIL)
PAGE#GENERATOR _ (AND (LISTP FIRSTPG#)
(CDR FIRSTPG#))
PAGE#TEXT _ (AND (LISTP FIRSTPG#)
(CAR FIRSTPG#]
PRSTREAM PAGEREGION SCRATCHFILE NPAGES WASOPEN TARGETFILENAME)
(CL:WHEN (EQ 'DON'T (APPLY* (OR (GETTEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN)
(FUNCTION NILL))
TEXTSTREAM)) (* ;
(SETQ TSTREAM (if (TEXTSTREAM TSTREAM T)
elseif (TEDIT.FORMATTEDFILEP TSTREAM)
then [RESETSAVE (SETQ TSTREAM (OPENTEXTSTREAM TSTREAM))
`(PROGN (CLOSEF? OLDVALUE]
TSTREAM
else (ERROR TSTREAM "is not a Tedit stream")))
(CL:WHEN (GETTEXTPROP TSTREAM 'MENUFLG)
(SETQ TSTREAM (TEXTSTREAM (\TEDIT.MAINW TSTREAM))))
(CL:UNLESS IMAGEFILE
[SETQ IMAGEFILE (if (GETTEXTPROP TSTREAM 'FILENAME)
then (PACKFILENAME 'VERSION NIL 'EXTENSION (CAR (
EXTENSIONS.FOR.IMAGEFILETYPE
IMAGETYPE))
'BODY
(GETTEXTPROP TSTREAM 'FILENAME))
else (UNIX-TMP-FILE-NAME 'tedit (CAR (EXTENSIONS.FOR.IMAGEFILETYPE
IMAGETYPE])
(PUTTEXTPROP TSTREAM 'LASTIMAGEFILE NIL)
(PROG* ((FIRSTPG# (LISTGET OPTIONS 'FIRSTPG#))
(TEXTOBJ (FTEXTOBJ TSTREAM))
[FORMATTINGSTATE (create PAGEFORMATTINGSTATE
PAGE# _ (FIXP FIRSTPG#)
FIRSTPAGE _ T
STATE _ FIRSTPG#
MINPAGE# _ (LISTGET OPTIONS 'STARTPG)
MAXPAGE# _ (OR (LISTGET OPTIONS 'ENDPG)
65535)
CHNO _ 1
PAGEHEADINGS _ (LIST NIL NIL)
PAGE#GENERATOR _ (AND (LISTP FIRSTPG#)
(CDR FIRSTPG#))
PAGE#TEXT _ (AND (LISTP FIRSTPG#)
(CAR FIRSTPG#]
IMAGESTREAM PAGEREGION SCRATCHFILE)
(CL:WHEN (EQ 'DON'T (APPLY* (OR (GETTEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN)
(FUNCTION NILL))
TSTREAM)) (* ;
 "Do pre-hardcopy processing as indicated, or refuse")
(RETURN))
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Hardcopy")
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
(SETQ PAGEREGION (FGETTOBJ TEXTOBJ TXTPAGEFRAMES))
(SETPFS FORMATTINGSTATE PRESSREGION TEDIT.DEFAULTPAGEREGION)
(RETURN))
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Hardcopy")
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
(SETQ PAGEREGION (FGETTOBJ TEXTOBJ TXTPAGEFRAMES))
(SETPFS FORMATTINGSTATE PRESSREGION TEDIT.DEFAULTPAGEREGION)
(* ;
 "Print in the usual region on the page")
(CL:UNLESS BREAKPAGETITLE
[SETQ BREAKPAGETITLE (COND
((LISTGET PRINTOPTIONS 'DOCUMENT.NAME))
([OR (NOT (FGETTOBJ TEXTOBJ TXTFILE))
(STRINGP (FGETTOBJ TEXTOBJ TXTFILE))
(type? STREAM (fetch (STREAM FULLNAME)
of (FGETTOBJ TEXTOBJ TXTFILE)))
(STRINGP (fetch (STREAM FULLNAME)
of (FGETTOBJ TEXTOBJ TXTFILE]
(* ;
 "This isn't a real file, so print a generic name on the document break page.")
"TEdit Hardcopy Output")
(T (* ;
 "It's a real file, so use the file name on the break page.")
(fetch (STREAM FULLNAME) of (FGETTOBJ TEXTOBJ TXTFILE])
[SETQ SCRATCHFILE (OR FILE (PRINTER.SCRATCH.FILE (TEXTSTREAM TEXTSTREAM]
(RESETLST (* ;
 "Set up to do the user's cleanup on the way out, as well.")
(CL:UNLESS QUIET (TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T))
[COND
((AND FILE (OPENP FILE)
(IMAGESTREAMTYPE FILE)) (* ;
 "The file he handed us is already an image-type file. Just append the new stuff to it.")
(SETQ WASOPEN T)
(SETQ PRSTREAM FILE))
(T (* ;
 "T'wasn't an image stream, so let's open us one.")
(RESETSAVE (SETQ PRSTREAM (OPENIMAGESTREAM
SCRATCHFILE
[OR IMAGETYPE (SETQ IMAGETYPE
(CAR (PRINTERPROP (PRINTERTYPE
SERVER)
'CANPRINT]
(LIST 'FONT (FONTCREATE 'TERMINAL 10)
'BREAKPAGEFILENAME BREAKPAGETITLE)))
'(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
(* ;
 "So we close and delete the file in case of trouble.")
(* ;; "The right margin must be big enough to prevent line wrap on landscaped 14 inch paper, with Postscript's scaling of .01-point increments. (~ 101,000). This will cause a performance hit. Sigh. JDS 9/5/89")
(* ;; "TEDIT puts its own headings on the page")
(DSPRIGHTMARGIN 131072 PRSTREAM)
(while (ILEQ (GETPFS FORMATTINGSTATE CHNO)
(FGETTOBJ TEXTOBJ TEXTLEN))
do
(* ;; "Format pages according to the existing layout:")
[SETQ IMAGESTREAM (OPENIMAGESTREAM IMAGEFILE IMAGETYPE `(HEADING NIL ,@OPTIONS]
(\TEDIT.FORMATBOX TEXTSTREAM PRSTREAM (GETPFS FORMATTINGSTATE CHNO)
PAGEREGION FORMATTINGSTATE IMAGETYPE)
(CL:WHEN (EQ (GETPFS FORMATTINGSTATE STATE)
:NEW-PAGE-LAYOUT)
(* ;; "The right margin must be big enough to prevent line wrap on landscaped 14 inch paper, with Postscript's scaling of .01-point increments. (~ 101,000). This will cause a performance hit. Sigh. JDS 9/5/89")
(* ;; "New page layout got specified. Prepare to re-enter the formatting code and skip to the equivalent page in the new format.")
(DSPRIGHTMARGIN 131072 IMAGESTREAM)
(while (ILEQ (GETPFS FORMATTINGSTATE CHNO)
(FGETTOBJ TEXTOBJ TEXTLEN))
do
(* ;; "Format pages according to the existing layout:")
(SETQ PAGEREGION (GETPFS FORMATTINGSTATE NEWPAGELAYOUT))
(\TEDIT.FORMATBOX TSTREAM IMAGESTREAM (GETPFS FORMATTINGSTATE CHNO)
PAGEREGION FORMATTINGSTATE IMAGETYPE)
(CL:WHEN (EQ (GETPFS FORMATTINGSTATE STATE)
:NEW-PAGE-LAYOUT)
(* ;; "Set up the formatting state so code knows we're looking for an equivalent page, and which page it is. (The SUB1 is because we counted an extra page for the page on which the new payout was detected.)")
(* ;; "New page layout got specified. Prepare to re-enter the formatting code and skip to the equivalent page in the new format.")
(SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE (SUB1 (GETPFS FORMATTINGSTATE
PAGECOUNT)))
(SETPFS FORMATTINGSTATE PAGECOUNT 0)
(SETPFS FORMATTINGSTATE STATE :SEARCHING-FOR-EQUIVALENT-PAGE)))
(SETQ TARGETFILENAME (STREAMPROP PRSTREAM 'PDFTARGETINFO))
(CL:UNLESS WASOPEN (* ;
 "Only if we created the image stream should we close it.")
(SETQ PRSTREAM (CLOSEF PRSTREAM))
(CL:UNLESS DONTSEND
(SEND.FILE.TO.PRINTER PRSTREAM SERVER (APPEND PRINTOPTIONS
(LIST 'DOCUMENT.NAME
BREAKPAGETITLE)))))
(CL:UNLESS FILE (DELFILE SCRATCHFILE))
(APPLY* (OR (GETTEXTPROP TEXTOBJ 'AFTERHARDCOPYFN)
(FUNCTION NILL))
TEXTSTREAM))
(SETQ NPAGES (GETPFS FORMATTINGSTATE PAGECOUNT))
(CL:UNLESS QUIET
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES)
""
"s")
" printed"
(CL:IF (EQ FILE SCRATCHFILE)
(CONCAT " to " (OR TARGETFILENAME
(FULLNAME FILE)))
""))
T))
(RETURN NPAGES)))])
(SETQ PAGEREGION (GETPFS FORMATTINGSTATE NEWPAGELAYOUT))
(* ;; "Set up the formatting state so code knows we're looking for an equivalent page, and which page it is. (The SUB1 is because we counted an extra page for the page on which the new payout was detected.)")
(SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE (SUB1 (GETPFS FORMATTINGSTATE
PAGECOUNT)))
(SETPFS FORMATTINGSTATE PAGECOUNT 0)
(SETPFS FORMATTINGSTATE STATE :SEARCHING-FOR-EQUIVALENT-PAGE)))
(APPLY* (OR (GETTEXTPROP TEXTOBJ 'AFTERHARDCOPYFN)
(FUNCTION NILL))
TSTREAM)
(* ;; "So caller can formulate a prompt message TEDIT.IMAGEFILE.MESSAGE")
(PUTTEXTPROP TSTREAM 'LASTIMAGEFILE (LIST (GETPFS FORMATTINGSTATE PAGECOUNT)
(FULLNAME IMAGESTREAM)
(PRINTERNAME IMAGESTREAM)))
(RETURN (CLOSEF IMAGESTREAM))))])
)
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE))
(* ;; "Perform page layout, based on a regular expression of typed regions.")
@@ -2101,18 +2062,18 @@
(RETURN (DREMOVE NIL $$VAL])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (12139 15751 (\TEDIT.PARSE.PAGEFRAMES 12149 . 13928) (\TEDIT.PUT.PAGEFRAMES 13930 .
14754) (\TEDIT.UNPARSE.PAGEFRAMES 14756 . 15749)) (15814 37831 (TEDIT.SINGLE.PAGEFORMAT 15824 . 26817)
(TEDIT.COMPOUND.PAGEFORMAT 26819 . 27798) (TEDIT.PAGEFORMAT 27800 . 35089) (TEDIT.GET.PAGEFORMAT
35091 . 37829)) (38118 48925 (TEDIT.FORMAT.HARDCOPY 38128 . 48923)) (49012 102264 (\TEDIT.FORMATBOX
49022 . 62446) (\TEDIT.FORMATHEADING 62448 . 67094) (\TEDIT.FORMATPAGE 67096 . 76285) (
\TEDIT.FORMATTEXTBOX 76287 . 92800) (\TEDIT.FORMATFOLIO 92802 . 98119) (\TEDIT.FORMAT.FOUNDBOX? 98121
. 100160) (\TEDIT.SKIP.SPECIALCOND 100162 . 102262)) (102344 107399 (\TEDIT.HARDCOPY.PAGEHEADINGS
102354 . 107397)) (107508 115559 (\TEDIT.HARDCOPY-COLUMN-END 107518 . 115557)) (115604 120545 (
SCALEPAGEUNITS 115614 . 116755) (SCALEPAGEXUNITS 116757 . 117527) (SCALEPAGEYUNITS 117529 . 118300) (
\TEDIT.PAPERHEIGHT 118302 . 119237) (\TEDIT.PAPERWIDTH 119239 . 120543)) (120961 124529 (ROMANNUMERALS
120971 . 124527)) (124568 131834 (TEDIT.PAGENO.CREATE 124578 . 124954) (\TEDIT.PAGENO.OBJINIT 124956
. 126239) (\TEDIT.PAGENO.BUTTONEVENTINFN 126241 . 127307) (\TEDIT.PAGENO.IMAGEBOXFN 127309 . 129459)
(\TEDIT.PAGENO.DISPLAYFN 129461 . 131111) (\TEDIT.PAGENO.GETFN 131113 . 131505) (\TEDIT.PAGENO.PUTFN
131507 . 131832)) (131899 134838 (\TEDIT.FORMAT.FOOTNOTE 131909 . 134836)))))
(FILEMAP (NIL (12248 15860 (\TEDIT.PARSE.PAGEFRAMES 12258 . 14037) (\TEDIT.PUT.PAGEFRAMES 14039 .
14863) (\TEDIT.UNPARSE.PAGEFRAMES 14865 . 15858)) (15923 38091 (TEDIT.SINGLE.PAGEFORMAT 15933 . 27077)
(TEDIT.COMPOUND.PAGEFORMAT 27079 . 28058) (TEDIT.PAGEFORMAT 28060 . 35349) (TEDIT.GET.PAGEFORMAT
35351 . 38089)) (38378 44858 (TEDIT.TO.IMAGEFILE 38388 . 44856)) (45006 98258 (\TEDIT.FORMATBOX 45016
. 58440) (\TEDIT.FORMATHEADING 58442 . 63088) (\TEDIT.FORMATPAGE 63090 . 72279) (\TEDIT.FORMATTEXTBOX
72281 . 88794) (\TEDIT.FORMATFOLIO 88796 . 94113) (\TEDIT.FORMAT.FOUNDBOX? 94115 . 96154) (
\TEDIT.SKIP.SPECIALCOND 96156 . 98256)) (98338 103393 (\TEDIT.HARDCOPY.PAGEHEADINGS 98348 . 103391)) (
103502 111553 (\TEDIT.HARDCOPY-COLUMN-END 103512 . 111551)) (111598 116539 (SCALEPAGEUNITS 111608 .
112749) (SCALEPAGEXUNITS 112751 . 113521) (SCALEPAGEYUNITS 113523 . 114294) (\TEDIT.PAPERHEIGHT 114296
. 115231) (\TEDIT.PAPERWIDTH 115233 . 116537)) (116955 120523 (ROMANNUMERALS 116965 . 120521)) (
120562 127828 (TEDIT.PAGENO.CREATE 120572 . 120948) (\TEDIT.PAGENO.OBJINIT 120950 . 122233) (
\TEDIT.PAGENO.BUTTONEVENTINFN 122235 . 123301) (\TEDIT.PAGENO.IMAGEBOXFN 123303 . 125453) (
\TEDIT.PAGENO.DISPLAYFN 125455 . 127105) (\TEDIT.PAGENO.GETFN 127107 . 127499) (\TEDIT.PAGENO.PUTFN
127501 . 127826)) (127893 130832 (\TEDIT.FORMAT.FOOTNOTE 127903 . 130830)))))
STOP

Binary file not shown.

View File

@@ -1,14 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Jul-2025 23:25:19" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;249 69193
(FILECREATED "14-Feb-2026 13:22:06" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;251 68691
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.MAKEPCTB)
:CHANGES-TO (VARS TEDIT-PCTREECOMS)
(FNS \TEDIT.UNLINKPIECE \TEDIT.DELETEPIECES)
:PREVIOUS-DATE " 8-Feb-2025 20:56:54"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;248)
:PREVIOUS-DATE "28-Jul-2025 23:25:19" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;249)
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
@@ -37,8 +36,8 @@
(GLOBALVARS MULTIPLE-PIECE-TABLES)
(FNS \TEDIT.MAKEPCTB \TEDIT.UPDATEPCNODES \TEDIT.FIRSTPIECE \TEDIT.DELETETREE
\TEDIT.INSERTTREE \TEDIT.LASTPIECE \TEDIT.PCTOCH \TEDIT.CHTOPC \TEDIT.SET-TOTLEN
\TEDIT.MAKE.VACANT.BTREESLOT \TEDIT.LINKNEWPIECE \TEDIT.UNLINKPIECE \TEDIT.SPLITPIECE
\TEDIT.INSERTPIECE \TEDIT.INSERTPIECES \TEDIT.DELETEPIECES \TEDIT.ALIGNEDPIECE)
\TEDIT.MAKE.VACANT.BTREESLOT \TEDIT.LINKNEWPIECE \TEDIT.SPLITPIECE \TEDIT.INSERTPIECE
\TEDIT.INSERTPIECES \TEDIT.DELETEPIECES \TEDIT.ALIGNEDPIECE)
(COMS (* ; "Debugging ")
(FNS \TEDIT.BTVALIDATE \TEDIT.BTVALIDATE.PRINT \TEDIT.CHECK-BTREE \TEDIT.CHECK-BTREE1
\TEDIT.BTFAIL \TEDIT.MATCHPCS)
@@ -658,20 +657,6 @@
(freplace (PIECE PREVPIECE) of NEXT with NEW))
NEW])
(\TEDIT.UNLINKPIECE
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 21-Oct-2023 17:24 by rmk")
(* ; "Edited 30-May-2023 00:31 by rmk")
(* ;; "Takes PC out of the piece chain, linking prev and next around it.")
(\TEDIT.THELP 'NOTCALLED?)
(CL:WHEN PREV
(freplace (PIECE NEXTPIECE) of PREV with (NEXTPIECE PC)))
(freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC)
(FGETTOBJ TEXTOBJ SUFFIXPIECE)) with PREV])
(\TEDIT.SPLITPIECE
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 17-Mar-2024 00:11 by rmk")
@@ -838,7 +823,8 @@
PIECES])
(\TEDIT.DELETEPIECES
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 7-Feb-2025 08:08 by rmk")
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 14-Feb-2026 13:20 by rmk")
(* ; "Edited 7-Feb-2025 08:08 by rmk")
(* ; "Edited 26-Nov-2024 10:50 by rmk")
(* ; "Edited 16-Mar-2024 10:00 by rmk")
(* ; "Edited 25-Nov-2023 12:12 by rmk")
@@ -859,6 +845,11 @@
(* ;; "This may not be entirely safe against an interrupt, which only matters on the call from \INSERTSELPIECES (otherwise the data isn't yet visible). Although the tree is consistent with the remaining pieces after each deletion, the fact that we keep the SELPIECE links intact means that the remaining pieces point to pieces that are no longer in the tree. We could do a little more work to incrementally chain the deleted pieces together, one by one, as they are deleted--in the end they would all be out of the tree, and the deletion chain would have been reconnected. Alternatively, we can make the whole loop be uninterruptable. ")
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ)
(CL:WHEN (type? PIECE SELPIECES)
(SETQ SELPIECES (create SELPIECES
SPFIRST _ SELPIECES
SPLAST _ SELPIECES
SPLEN _ (PLEN SELPIECES))))
(for PC PREV NEXT first (FSETTOBJ TEXTOBJ HINTPC NIL)
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
(* ; "For incremental chain-update")
@@ -1113,13 +1104,13 @@
(GLOBALVARS BTVALIDATETAGS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8767 56719 (\TEDIT.MAKEPCTB 8777 . 10670) (\TEDIT.UPDATEPCNODES 10672 . 12966) (
\TEDIT.FIRSTPIECE 12968 . 14375) (\TEDIT.DELETETREE 14377 . 17651) (\TEDIT.INSERTTREE 17653 . 20398) (
\TEDIT.LASTPIECE 20400 . 21207) (\TEDIT.PCTOCH 21209 . 23306) (\TEDIT.CHTOPC 23308 . 29485) (
\TEDIT.SET-TOTLEN 29487 . 30275) (\TEDIT.MAKE.VACANT.BTREESLOT 30277 . 37007) (\TEDIT.LINKNEWPIECE
37009 . 38598) (\TEDIT.UNLINKPIECE 38600 . 39420) (\TEDIT.SPLITPIECE 39422 . 44078) (
\TEDIT.INSERTPIECE 44080 . 47352) (\TEDIT.INSERTPIECES 47354 . 50446) (\TEDIT.DELETEPIECES 50448 .
54602) (\TEDIT.ALIGNEDPIECE 54604 . 56717)) (56747 69070 (\TEDIT.BTVALIDATE 56757 . 58298) (
\TEDIT.BTVALIDATE.PRINT 58300 . 59665) (\TEDIT.CHECK-BTREE 59667 . 61994) (\TEDIT.CHECK-BTREE1 61996
. 67627) (\TEDIT.BTFAIL 67629 . 68051) (\TEDIT.MATCHPCS 68053 . 69068)))))
(FILEMAP (NIL (8731 56217 (\TEDIT.MAKEPCTB 8741 . 10634) (\TEDIT.UPDATEPCNODES 10636 . 12930) (
\TEDIT.FIRSTPIECE 12932 . 14339) (\TEDIT.DELETETREE 14341 . 17615) (\TEDIT.INSERTTREE 17617 . 20362) (
\TEDIT.LASTPIECE 20364 . 21171) (\TEDIT.PCTOCH 21173 . 23270) (\TEDIT.CHTOPC 23272 . 29449) (
\TEDIT.SET-TOTLEN 29451 . 30239) (\TEDIT.MAKE.VACANT.BTREESLOT 30241 . 36971) (\TEDIT.LINKNEWPIECE
36973 . 38562) (\TEDIT.SPLITPIECE 38564 . 43220) (\TEDIT.INSERTPIECE 43222 . 46494) (
\TEDIT.INSERTPIECES 46496 . 49588) (\TEDIT.DELETEPIECES 49590 . 54100) (\TEDIT.ALIGNEDPIECE 54102 .
56215)) (56245 68568 (\TEDIT.BTVALIDATE 56255 . 57796) (\TEDIT.BTVALIDATE.PRINT 57798 . 59163) (
\TEDIT.CHECK-BTREE 59165 . 61492) (\TEDIT.CHECK-BTREE1 61494 . 67125) (\TEDIT.BTFAIL 67127 . 67549) (
\TEDIT.MATCHPCS 67551 . 68566)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "31-Dec-2025 23:10:18" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;915 186658
(FILECREATED " 5-Feb-2026 00:39:54" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;916 186880
:EDIT-BY rmk
:CHANGES-TO (VARS TEDIT-SCREENCOMS)
:CHANGES-TO (FNS \TEDIT.FORMATLINE)
:PREVIOUS-DATE " 7-Dec-2025 16:28:01" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;914)
:PREVIOUS-DATE "31-Dec-2025 23:10:18" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;915)
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
@@ -654,6 +654,7 @@
(\TEDIT.FORMATLINE
[LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
(* ; "Edited 5-Feb-2026 00:38 by rmk")
(* ; "Edited 21-Nov-2025 16:36 by rmk")
(* ; "Edited 7-Aug-2025 12:49 by rmk")
(* ; "Edited 27-Apr-2025 11:24 by rmk")
@@ -706,8 +707,10 @@
(CL:UNLESS LINE
(SETQ LINE (create LINEDESCRIPTOR)))
(CL:UNLESS IMAGESTREAM
(SETQ IMAGESTREAM (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
'DSP)))
(SETQ IMAGESTREAM (CL:IF (\TEDIT.PRIMARYPANE TSTREAM)
(WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
'DSP)
(DSPCREATE))))
(PROG ((TEXTOBJ (FTEXTOBJ TSTREAM))
(OFFSET 0)
(TRUEASCENT -1)
@@ -2863,21 +2866,21 @@
(\TEDIT.LINE.TALLP LINE PHEIGHT))))])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (26200 28416 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26210 . 28414)) (35870 119502 (
\TEDIT.FORMATLINE 35880 . 70986) (\TEDIT.FORMATLINE.SETUP.PARA 70988 . 76182) (
\TEDIT.FORMATLINE.HORIZONTAL 76184 . 81001) (\TEDIT.FORMATLINE.VERTICAL 81003 . 83454) (
\TEDIT.FORMATLINE.JUSTIFY 83456 . 89477) (\TEDIT.FORMATLINE.TABS 89479 . 97507) (\TEDIT.SCALE.TABS
97509 . 98300) (\TEDIT.FORMATLINE.PURGE.SPACES 98302 . 99729) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
99731 . 100808) (\TEDIT.FORMATLINE.EMPTY 100810 . 105630) (\TEDIT.FORMATLINE.UPDATELOOKS 105632 .
111813) (\TEDIT.FORMATLINE.LASTLEGAL 111815 . 115265) (\TEDIT.LINES.ABOVE 115267 . 118878) (
\TEDIT.CHNO.TO.YTOP 118880 . 119500)) (119779 140359 (\TEDIT.DISPLAYLINE 119789 . 132299) (
\TEDIT.DISPLAYLINE.TABS 132301 . 135105) (\TEDIT.LINECACHE 135107 . 135835) (\TEDIT.CREATE.LINECACHE
135837 . 136673) (\TEDIT.BLTCHAR 136675 . 139302) (\TEDIT.DIACRITIC.SHIFT 139304 . 140357)) (140974
186635 (\TEDIT.BACKFORMAT 140984 . 143538) (\TEDIT.PREVIOUS.LINEBREAK 143540 . 146343) (
\TEDIT.UPDATE.LINES 146345 . 152651) (\TEDIT.PANE.CREATELINES 152653 . 154943) (
\TEDIT.SUFFIXLINE.CREATE 154945 . 156560) (\TEDIT.LINES.BELOW 156562 . 161172) (\TEDIT.MEASURED.LINES
161174 . 163183) (\TEDIT.VALID.LASTCHNOS 163185 . 166961) (\TEDIT.VALID.NEXTCHNOS 166963 . 170437) (
\TEDIT.LASTVALIDLINE 170439 . 175110) (\TEDIT.NEXTVALIDLINE 175112 . 178082) (
\TEDIT.CLEARPANE.BELOW.LINE 178084 . 180190) (\TEDIT.INSERTLINE 180192 . 181578) (\TEDIT.LINE.BOTTOM
181580 . 184810) (\TEDIT.SHOW.AT.BOTTOMP 184812 . 185922) (\TEDIT.SHOW.AT.TOPP 185924 . 186633)))))
(FILEMAP (NIL (26200 28416 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26210 . 28414)) (35870 119724 (
\TEDIT.FORMATLINE 35880 . 71208) (\TEDIT.FORMATLINE.SETUP.PARA 71210 . 76404) (
\TEDIT.FORMATLINE.HORIZONTAL 76406 . 81223) (\TEDIT.FORMATLINE.VERTICAL 81225 . 83676) (
\TEDIT.FORMATLINE.JUSTIFY 83678 . 89699) (\TEDIT.FORMATLINE.TABS 89701 . 97729) (\TEDIT.SCALE.TABS
97731 . 98522) (\TEDIT.FORMATLINE.PURGE.SPACES 98524 . 99951) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
99953 . 101030) (\TEDIT.FORMATLINE.EMPTY 101032 . 105852) (\TEDIT.FORMATLINE.UPDATELOOKS 105854 .
112035) (\TEDIT.FORMATLINE.LASTLEGAL 112037 . 115487) (\TEDIT.LINES.ABOVE 115489 . 119100) (
\TEDIT.CHNO.TO.YTOP 119102 . 119722)) (120001 140581 (\TEDIT.DISPLAYLINE 120011 . 132521) (
\TEDIT.DISPLAYLINE.TABS 132523 . 135327) (\TEDIT.LINECACHE 135329 . 136057) (\TEDIT.CREATE.LINECACHE
136059 . 136895) (\TEDIT.BLTCHAR 136897 . 139524) (\TEDIT.DIACRITIC.SHIFT 139526 . 140579)) (141196
186857 (\TEDIT.BACKFORMAT 141206 . 143760) (\TEDIT.PREVIOUS.LINEBREAK 143762 . 146565) (
\TEDIT.UPDATE.LINES 146567 . 152873) (\TEDIT.PANE.CREATELINES 152875 . 155165) (
\TEDIT.SUFFIXLINE.CREATE 155167 . 156782) (\TEDIT.LINES.BELOW 156784 . 161394) (\TEDIT.MEASURED.LINES
161396 . 163405) (\TEDIT.VALID.LASTCHNOS 163407 . 167183) (\TEDIT.VALID.NEXTCHNOS 167185 . 170659) (
\TEDIT.LASTVALIDLINE 170661 . 175332) (\TEDIT.NEXTVALIDLINE 175334 . 178304) (
\TEDIT.CLEARPANE.BELOW.LINE 178306 . 180412) (\TEDIT.INSERTLINE 180414 . 181800) (\TEDIT.LINE.BOTTOM
181802 . 185032) (\TEDIT.SHOW.AT.BOTTOMP 185034 . 186144) (\TEDIT.SHOW.AT.TOPP 186146 . 186855)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Jul-2025 11:22:10" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;731 161124
(FILECREATED "16-Feb-2026 00:38:33" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;738 162152
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.FIND.PROTECTED.START \TEDIT.FIND.PROTECTED.END)
:CHANGES-TO (FNS \TEDIT.SELPIECES.CHARTRANSFORM)
:PREVIOUS-DATE "28-Jul-2025 23:50:43" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;730)
:PREVIOUS-DATE "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;736)
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
@@ -73,8 +73,7 @@
(* ;; "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")
SELOPERATION (* ; "NORMAL, MOVE, COPY... HOW and HOWHEIGHT are derived from the operation. Was Y0: Y value of topmost line of selection")
X0 (* ;
 "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.")
@@ -1214,7 +1213,8 @@
(SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL])
(\TEDIT.SET.SEL.LOOKS
[LAMBDA (SEL OPERATION) (* ; "Edited 6-May-2025 11:32 by rmk")
[LAMBDA (SEL OPERATION) (* ; "Edited 10-Jan-2026 12:30 by rmk")
(* ; "Edited 6-May-2025 11:32 by rmk")
(* ; "Edited 28-Feb-2025 17:45 by rmk")
(* ; "Edited 7-Nov-2024 21:50 by rmk")
(* ; "Edited 4-Oct-2024 08:40 by rmk")
@@ -1260,6 +1260,7 @@
(FSETSEL SEL HASCARET T))
(NIL)
(\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION))
(FSETSEL SEL SELOPERATION OPERATION)
SEL])
)
(DECLARE%: EVAL@COMPILE DONTCOPY
@@ -1421,7 +1422,8 @@
'INVERT) repeatuntil (EQ L LN])
(\TEDIT.UPDATE.SEL
[LAMBDA (TSTREAM/SEL CH# DCH POINT LOOKS CHLIM) (* ; "Edited 6-May-2025 11:36 by rmk")
[LAMBDA (TSTREAM/SEL CH# DCH POINT LOOKS CHLIM) (* ; "Edited 6-Jan-2026 20:18 by rmk")
(* ; "Edited 6-May-2025 11:36 by rmk")
(* ; "Edited 21-Apr-2025 22:50 by rmk")
(* ; "Edited 6-Apr-2025 11:47 by rmk")
(* ; "Edited 10-Jul-2024 17:25 by rmk")
@@ -1458,6 +1460,13 @@
(CL:UNLESS POINT
(SETQ POINT (GETTH CH# THPOINT CH#)))
(SETQ CH# (GETTH CH# THCH#))
elseif (LISTP CH#)
then (CL:UNLESS DCH
(SETQ DCH (CADR CH#)))
(CL:UNLESS POINT
(SETQ POINT (CADDR CH#)))
(CL:UNLESS CH#
(SETQ POINT (CAR CH#)))
else
(* ;;
 "Get defaults from SEL (either a selection or a textobj whose SEL is indicated)")
@@ -1611,7 +1620,8 @@
(DEFINEQ
(\TEDIT.COPYSEL
[LAMBDA (FROM TO) (* ; "Edited 3-Sep-2024 22:44 by rmk")
[LAMBDA (FROM TO) (* ; "Edited 11-Jan-2026 00:17 by rmk")
(* ; "Edited 3-Sep-2024 22:44 by rmk")
(* ; "Edited 7-Jul-2024 11:21 by rmk")
(* ; "Edited 30-Jun-2024 23:21 by rmk")
(* ; "Edited 29-Apr-2024 12:35 by rmk")
@@ -1644,6 +1654,7 @@
(FSETSEL TO HASCARET (FGETSEL FROM HASCARET))
(FSETSEL TO SELOBJ (FGETSEL FROM SELOBJ))
(FSETSEL TO ONFLG (FGETSEL FROM ONFLG))
(FSETSEL TO SELOPERATION (FGETSEL FROM SELOPERATION))
else (SETQ TO (create SELECTION using FROM SELTEXTSTREAM _ NIL L1 _ (COPY (FGETSEL FROM L1))
LN _ (COPY (FGETSEL FROM LN))
SELLINES _ (COPY (FGETSEL FROM SELLINES]
@@ -2030,7 +2041,8 @@
SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2])
(\TEDIT.SELPIECES.CHARTRANSFORM
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM) (* ; "Edited 24-Apr-2025 16:02 by rmk")
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM) (* ; "Edited 16-Feb-2026 00:38 by rmk")
(* ; "Edited 24-Apr-2025 16:02 by rmk")
(* ; "Edited 20-Apr-2025 23:23 by rmk")
(* ; "Edited 16-Mar-2025 10:03 by rmk")
(* ; "Edited 7-Nov-2024 21:50 by rmk")
@@ -2055,10 +2067,10 @@
(* ;; "This assumes that no file piece has a PLEN greater than \MaxArrayLen characters. We rely on the piece-table reader and writer to guarantee this. If not, ALLOCSTRING will cause an error.")
[for I from 1 to (PLEN PC)
do (RPLCHARCODE STR I (APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE
PC I)
(add INDEX 1]
[for I from 0 to (PLAST PC)
do (RPLCHARCODE STR (ADD1 I)
(APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE PC I)
(add INDEX 1]
(if (fetch (STRINGP FATSTRINGP) of STR)
then (FSETPC PC PTYPE FATSTRING.PTYPE)
(FSETPC PC PBYTESPERCHAR 2)
@@ -2237,7 +2249,8 @@
(FGETSEL SCRSEL CH#])
(TEDIT.SELPROP
[LAMBDA X (* ; "Edited 28-Feb-2025 17:14 by rmk")
[LAMBDA X (* ; "Edited 11-Jan-2026 00:18 by rmk")
(* ; "Edited 28-Feb-2025 17:14 by rmk")
(* ; "Edited 6-Feb-2025 16:48 by rmk")
(* ; "Edited 31-Oct-2024 18:00 by rmk")
(* ; "Edited 23-Sep-2024 23:11 by rmk")
@@ -2277,6 +2290,7 @@
(TEXTSTREAM (FGETSEL SEL SELTEXTSTREAM))
(SHADE (FGETSEL SEL HOW))
(SHADEHEIGHT (FGETSEL SEL HOWHEIGHT))
(SELOPERATION (FGETSEL SEL SELOPERATION))
(SET (FGETSEL SEL SET))
(\ILLEGAL.ARG PROP))
(CL:WHEN (IGREATERP X 2)
@@ -2296,6 +2310,7 @@
(CHLIM (\TEDIT.UPDATE.SEL SEL NIL (IDIFFERENCE NEWVALUE (FGETSEL SEL CH#))))
(SHADE (FSETSEL SEL HOW NEWVALUE))
(SHADEHEIGHT (FSETSEL SEL HOWHEIGHT NEWVALUE))
(SELOPERATION (\TEDIT.SET.SEL.LOOKS SEL NEWVALUE))
(SET (FSETSEL SEL SET NEWVALUE))
(\ILLEGAL.ARG PROP))
(CL:WHEN (FGETSEL SEL SELTEXTSTREAM)
@@ -2556,26 +2571,26 @@
(ADDTOVAR LAMA TEDIT.SELPROP)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (15897 17718 (\TEDIT.SELECTION.DEFPRINT 15907 . 17716)) (17755 19260 (
\TEDIT.SET.GLOBAL.SELECTIONS 17765 . 19258)) (19261 25482 (\TEDIT.SELECTED.PIECES 19271 . 20910) (
\TEDIT.FIND.PROTECTED.END 20912 . 22706) (\TEDIT.FIND.PROTECTED.START 22708 . 24691) (
\TEDIT.WORD.BOUND 24693 . 25480)) (25616 59723 (\TEDIT.EXTEND.SEL 25626 . 32866) (\TEDIT.SCAN.LINE
32868 . 44541) (\TEDIT.SCAN.LINE.WORD 44543 . 49536) (\TEDIT.XYTOSEL 49538 . 56876) (\TEDIT.REGIONTYPE
56878 . 57897) (\TEDIT.XYTOSEL.INLINEP 57899 . 58354) (\TEDIT.XYTOSEL.LINE 58356 . 59721)) (59724
73269 (\TEDIT.FIXSEL 59734 . 69111) (\TEDIT.CHTOLINEX 69113 . 73267)) (73270 77324 (
\TEDIT.RESET.EXTEND.PENDING.DELETE 73280 . 74558) (\TEDIT.SET.SEL.LOOKS 74560 . 77322)) (78261 99027 (
\TEDIT.SHOWSEL 78271 . 83247) (\TEDIT.NOSEL 83249 . 83550) (\TEDIT.SEL.OFF 83552 . 83963) (
\TEDIT.SEL.ON 83965 . 84381) (\TEDIT.SHOWSEL.HILIGHT 84383 . 89004) (\TEDIT.UPDATE.SEL 89006 . 93221)
(\TEDIT.CARETLINE 93223 . 93937) (\TEDIT.SEL.L1 93939 . 94622) (\TEDIT.SEL.LN 94624 . 95307) (
\TEDIT.SEL.DELETEDCHARS 95309 . 99025)) (99028 103734 (\TEDIT.COPYSEL 99038 . 101504) (
\TEDIT.SEL.CHANGED? 101506 . 103732)) (103765 117424 (\TEDIT.SELECT.OBJECT 103775 . 108728) (
\TEDIT.SHOWSEL.OBJECT 108730 . 110961) (\TEDIT.CLIP.OBJECT 110963 . 112967) (\TEDIT.OPERATE.OBJECT
112969 . 117422)) (117452 137201 (\TEDIT.SELPIECES 117462 . 121743) (\TEDIT.SELPIECES.COPY 121745 .
124234) (\TEDIT.SELPIECES.CONCAT 124236 . 126115) (\TEDIT.SELPIECES.CHARTRANSFORM 126117 . 129576) (
\TEDIT.SELPIECES.FROM.STRING 129578 . 134836) (\TEDIT.SELPIECES.TO.STRING 134838 . 137199)) (137254
160955 (TEDIT.XYTOCH 137264 . 139840) (TEDIT.SELPROP 139842 . 143872) (TEDIT.GETPOINT 143874 . 145794)
(TEDIT.GETSEL 145796 . 146672) (TEDIT.GETSEL.PARA 146674 . 147623) (TEDIT.SCANSEL 147625 . 148573) (
TEDIT.SET.SEL.LOOKS 148575 . 150060) (TEDIT.SETSEL 150062 . 154980) (TEDIT.SHOWSEL 154982 . 156846) (
TEDIT.SEL.AS.STRING 156848 . 159333) (TEDIT.SEL.AS.SEXPR 159335 . 160621) (TEDIT.SELECTALL 160623 .
160953)))))
(FILEMAP (NIL (15888 17709 (\TEDIT.SELECTION.DEFPRINT 15898 . 17707)) (17746 19251 (
\TEDIT.SET.GLOBAL.SELECTIONS 17756 . 19249)) (19252 25473 (\TEDIT.SELECTED.PIECES 19262 . 20901) (
\TEDIT.FIND.PROTECTED.END 20903 . 22697) (\TEDIT.FIND.PROTECTED.START 22699 . 24682) (
\TEDIT.WORD.BOUND 24684 . 25471)) (25607 59714 (\TEDIT.EXTEND.SEL 25617 . 32857) (\TEDIT.SCAN.LINE
32859 . 44532) (\TEDIT.SCAN.LINE.WORD 44534 . 49527) (\TEDIT.XYTOSEL 49529 . 56867) (\TEDIT.REGIONTYPE
56869 . 57888) (\TEDIT.XYTOSEL.INLINEP 57890 . 58345) (\TEDIT.XYTOSEL.LINE 58347 . 59712)) (59715
73260 (\TEDIT.FIXSEL 59725 . 69102) (\TEDIT.CHTOLINEX 69104 . 73258)) (73261 77465 (
\TEDIT.RESET.EXTEND.PENDING.DELETE 73271 . 74549) (\TEDIT.SET.SEL.LOOKS 74551 . 77463)) (78402 99555 (
\TEDIT.SHOWSEL 78412 . 83388) (\TEDIT.NOSEL 83390 . 83691) (\TEDIT.SEL.OFF 83693 . 84104) (
\TEDIT.SEL.ON 84106 . 84522) (\TEDIT.SHOWSEL.HILIGHT 84524 . 89145) (\TEDIT.UPDATE.SEL 89147 . 93749)
(\TEDIT.CARETLINE 93751 . 94465) (\TEDIT.SEL.L1 94467 . 95150) (\TEDIT.SEL.LN 95152 . 95835) (
\TEDIT.SEL.DELETEDCHARS 95837 . 99553)) (99556 104438 (\TEDIT.COPYSEL 99566 . 102208) (
\TEDIT.SEL.CHANGED? 102210 . 104436)) (104469 118128 (\TEDIT.SELECT.OBJECT 104479 . 109432) (
\TEDIT.SHOWSEL.OBJECT 109434 . 111665) (\TEDIT.CLIP.OBJECT 111667 . 113671) (\TEDIT.OPERATE.OBJECT
113673 . 118126)) (118156 137982 (\TEDIT.SELPIECES 118166 . 122447) (\TEDIT.SELPIECES.COPY 122449 .
124938) (\TEDIT.SELPIECES.CONCAT 124940 . 126819) (\TEDIT.SELPIECES.CHARTRANSFORM 126821 . 130357) (
\TEDIT.SELPIECES.FROM.STRING 130359 . 135617) (\TEDIT.SELPIECES.TO.STRING 135619 . 137980)) (138035
161983 (TEDIT.XYTOCH 138045 . 140621) (TEDIT.SELPROP 140623 . 144900) (TEDIT.GETPOINT 144902 . 146822)
(TEDIT.GETSEL 146824 . 147700) (TEDIT.GETSEL.PARA 147702 . 148651) (TEDIT.SCANSEL 148653 . 149601) (
TEDIT.SET.SEL.LOOKS 149603 . 151088) (TEDIT.SETSEL 151090 . 156008) (TEDIT.SHOWSEL 156010 . 157874) (
TEDIT.SEL.AS.STRING 157876 . 160361) (TEDIT.SEL.AS.SEXPR 160363 . 161649) (TEDIT.SELECTALL 161651 .
161981)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Sep-2025 08:19:29" {MEDLEY}<library>tedit>TEDIT-STREAM.;15 192029
(FILECREATED "16-Feb-2026 12:40:44" {WMEDLEY}<library>tedit>TEDIT-STREAM.;944 193110
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.TEXTINIT)
:CHANGES-TO (FNS \TEDIT.STREAMINIT)
:PREVIOUS-DATE "20-Sep-2025 08:49:36" {MEDLEY}<library>tedit>TEDIT-STREAM.;14)
:PREVIOUS-DATE "16-Feb-2026 09:39:00" {WMEDLEY}<library>tedit>TEDIT-STREAM.;943)
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
@@ -14,8 +14,8 @@
(RPAQQ TEDIT-STREAMCOMS
[(DECLARE%: EVAL@COMPILE DONTCOPY
(EXPORT (RECORDS PIECE TEXTOBJ TEXTSTREAM)
(MACROS NEXTPIECE PREVPIECE PLEN PTYPE PCONTENTS PCHARLOOKS PCHARSET PPARALOOKS
PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
(MACROS NEXTPIECE PREVPIECE PLEN PLAST PTYPE PCONTENTS PCHARLOOKS PCHARSET
PPARALOOKS PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
(MACROS SETPC FSETPC GETPC FGETPC)
(MACROS THINPIECEP)
(MACROS VISIBLEPIECEP \NEXT.VISIBLE.PIECE \PREV.VISIBLE.PIECE)
@@ -43,7 +43,9 @@
(FNS \TEDIT.REOPENTEXTSTREAM \TEDIT.OPENTEXTSTREAM.PIECES \TEDIT.OPENTEXTSTREAM.PROPS
\TEDIT.OPENTEXTSTREAM.SETUP.SEL \TEDIT.OPENTEXTSTREAM.WINDOW
\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS \TEDIT.OPENTEXTFILE \TEDIT.CREATE.TEXTSTREAM
\TEDIT.REOPEN.STREAM \TEDIT.TEXTINIT)
\TEDIT.REOPEN.STREAM)
(FNS \TEDIT.STREAMINIT TEDIT.IMAGESTREAM.OPEN)
(ALISTS (IMAGESTREAMTYPES TEDIT))
(* ;; "Is this being used:")
@@ -69,10 +71,7 @@
(MACROS \INSERTCH.EXTENDABLE))
(FNS \TEDIT.DELETE.SELPIECES \TEDIT.INSERTCH \TEDIT.INSERTCH.HISTORY \TEDIT.INSERTEOL
\TEDIT.INSERTCH.INSERTION \TEDIT.INSERTCH.EXTEND)
(FNS \TEDIT.NEXTCHANGEABLE.CHNO \TEDIT.LASTCHANGEABLE.CHNO)
(FNS \SETUPGETCH))
(* ;
 "Deprecated, maybe still external callers")
(FNS \TEDIT.NEXTCHANGEABLE.CHNO \TEDIT.LASTCHANGEABLE.CHNO))
(FNS \TEDIT.INSTALL.PIECE)
[COMS (* ; "Support for TEXTPROP")
(FNS TEXTPROP GETTEXTPROP PUTTEXTPROP GETTEXTPROPS PUTTEXTPROPS TEXTPROP.ADD
@@ -83,11 +82,7 @@
(ADDVARS (INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES
\TEDIT.TEXTOBJ.PROPFETCHFN
\TEDIT.TEXTOBJ.PROPSTOREFN]
[COMS
(* ;; "Support for error handling: The old error handler for the stream-not-open error. This is here, because you only want to do this ONCE, even if you load TEXT-STREAM multiple times (as, e.g., in development)")
(INITVARS (*TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN]
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEDIT.TEXTINIT)))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEDIT.STREAMINIT)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA TEXTPROP])
@@ -126,7 +121,9 @@
 "The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece")
[ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
(type? IMAGEOBJ (PCONTENTS DATUM))
(PCONTENTS DATUM]
(PCONTENTS DATUM))
(AND (EQ OBJECT.PTYPE (PTYPE DATUM))
(SETPC DATUM PCONTENTS NEWVALUE]
PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0)
(DATATYPE TEXTOBJ (
@@ -160,8 +157,7 @@
 "The current selection within the text")
LASTARROWX (* ;
 "X for next arrow up or arrow down. Was: Scratch space for the selection code")
NIL (* ;
 "Was MOVESEL: Source for the next MOVE of text")
SECONDARYSEL (* ; "Holds secondary selection and operation just before the mouse leaves a window. Was MOVESEL: Source for the next MOVE of text")
NIL (* ;
 "Was SHIFTEDSEL: Source for the next COPY")
NIL (* ;
@@ -397,6 +393,9 @@
(PUTPROPS PLEN MACRO ((PC)
(ffetch (PIECE PLEN) of PC)))
(PUTPROPS PLAST MACRO ((PC)
(SUB1 (PLEN PC))))
(PUTPROPS PTYPE MACRO ((PC)
(ffetch (PIECE PTYPE) of PC)))
@@ -698,6 +697,8 @@
(\TEDIT.TEXTBIN
[LAMBDA (TSTREAM)
(* ;; "Edited 13-Oct-2025 17:16 by rmk")
(* ;; "Edited 21-Oct-2024 00:26 by rmk")
(* ;; "Edited 3-May-2024 14:57 by rmk")
@@ -767,7 +768,7 @@
(if (\ENDOFPIECEP PCCHARSLEFT)
then (SETQ PC (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE PC)
0))
else (\TEDIT.INSTALL.FILEBUFFER TSTREAM (SUB1 PCCHARSLEFT))))
else (\TEDIT.INSTALL.FILEBUFFER TSTREAM PCCHARSLEFT)))
(if (NOT PC)
then (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM)
elseif (ffetch (STREAM BINABLE) of TSTREAM)
@@ -922,7 +923,8 @@
else (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM])
(\TEDIT.TEXTBACKFILEPTR
[LAMBDA (TSTREAM) (* ; "Edited 21-Oct-2024 00:33 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 16-Feb-2026 08:54 by rmk")
(* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 1-Feb-2024 11:25 by rmk")
(* ; "Edited 5-Jan-2024 17:57 by rmk")
(* ; "Edited 28-Dec-2023 13:34 by rmk")
@@ -954,7 +956,7 @@
then (CL:WHEN (SETQ PPC (\PREV.VISIBLE.PIECE PC))
(* ;
 "Back up to last char of previous piece, if any.")
(\TEDIT.INSTALL.PIECE TSTREAM PPC (SUB1 (PLEN PPC)))
(\TEDIT.INSTALL.PIECE TSTREAM PPC (PLAST PPC))
(SETQ PC PPC))
elseif (AND (MEMB (PTYPE PC)
FILE.PTYPES)
@@ -1232,6 +1234,10 @@
(OPENTEXTSTREAM
[LAMBDA (TEXT WINDOW START/PROPS END PROPS)
(* ;; "Edited 2-Dec-2025 17:49 by rmk")
(* ;; "Edited 25-Sep-2025 21:30 by rmk")
(* ;; "Edited 9-Sep-2025 22:07 by rmk")
(* ;; "Edited 17-Feb-2025 08:57 by rmk")
@@ -1317,12 +1323,12 @@
(if TEXT
then (* ;
 "Verify/open the file before the window")
(SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS))
(SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS T))
(FSETTOBJ TEXTOBJ TXTFILE TEXT)
else
(* ;; "An empty document starts in an MCCS environment")
(FPUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
(PUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
'CHARENCODING
'MCCS))
@@ -1352,7 +1358,8 @@
TSTREAM))])
(COPYTEXTSTREAM
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 21-Apr-2025 23:48 by rmk")
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 5-Oct-2025 10:54 by rmk")
(* ; "Edited 21-Apr-2025 23:48 by rmk")
(* ; "Edited 8-Feb-2025 20:10 by rmk")
(* ; "Edited 12-Jan-2025 12:16 by rmk")
(* ; "Edited 17-Mar-2024 12:41 by rmk")
@@ -1372,7 +1379,10 @@
(LET* ((TSTREAM (TEXTSTREAM ORIGINAL))
(TEXTOBJ (FTEXTOBJ TSTREAM))
[NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (COPY (FGETTOBJ TEXTOBJ EDITPROPS]
[NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (APPEND (COPY (FGETTOBJ TEXTOBJ EDITPROPS))
(for DP in (FGETTOBJ TEXTOBJ DOCPROPS)
collect (LIST (CAR DP)
(COPY (CDR DP]
(NEWTEXTOBJ (FTEXTOBJ NEWSTREAM))) (* ;
 "Create an empty textstream into which the pieces can be hammered")
(for PC NEWPC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
@@ -1511,7 +1521,8 @@
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS TEXTOBJ])
(\TEDIT.OPENTEXTSTREAM.SETUP.SEL
[LAMBDA (TSTREAM) (* ; "Edited 21-Apr-2025 20:14 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 10-Jan-2026 23:53 by rmk")
(* ; "Edited 21-Apr-2025 20:14 by rmk")
(* ; "Edited 6-Apr-2025 14:24 by rmk")
(* ; "Edited 17-Feb-2025 08:56 by rmk")
(* ; "Edited 25-Nov-2024 14:33 by rmk")
@@ -1554,20 +1565,22 @@
(OR (CADR SELPROP)
0)
(OR (CADDR SELPROP)
'LEFT))
'LEFT)
'NORMAL)
elseif (FIXP SELPROP)
then (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT)
then (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT 'NORMAL)
elseif (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
then
(* ;; "Default to after the last character")
(\TEDIT.UPDATE.SEL SEL (FGETTOBJ TEXTOBJ TEXTLEN)
0
'RIGHT)
'RIGHT
'NORMAL)
else
(* ;; "Default to before the first character. UPDATE.SEL screws up the CHLIM=CH#+DCH invariant when DCH=0, it adds 1, But UPDATE.SEL adds 1 when DCH=0. That's wrong for the initial caret, so brute-force fix it here. Maybe it's wrong in general?")
(\TEDIT.UPDATE.SEL SEL 1 0 'LEFT)
(\TEDIT.UPDATE.SEL SEL 1 0 'LEFT 'NORMAL)
(FSETSEL SEL CHLIM 1))
[FSETTOBJ TEXTOBJ CARETLOOKS (if (FGETSEL SEL SET)
then (* ;
@@ -1657,7 +1670,8 @@
(SETTOBJ TEXTOBJ DEFAULTPARALOOKS PARALOOKS])
(\TEDIT.OPENTEXTFILE
[LAMBDA (TEXT PROPS) (* ; "Edited 16-Sep-2025 00:28 by rmk")
[LAMBDA (TEXT PROPS ERROR) (* ; "Edited 2-Dec-2025 17:49 by rmk")
(* ; "Edited 16-Sep-2025 00:28 by rmk")
(* ; "Edited 8-Sep-2025 21:52 by rmk")
(* ; "Edited 21-Nov-2024 11:38 by rmk")
(* ; "Edited 20-Dec-2023 10:49 by rmk")
@@ -1668,29 +1682,22 @@
(* ; "Edited 17-Sep-2023 21:29 by rmk")
(CL:WHEN TEXT
(if (\GETSTREAM TEXT 'INPUT T)
elseif (OR (LITATOM TEXT)
(STRINGP TEXT)
(CL:PATHNAMEP TEXT)
(STREAMP TEXT))
then (* ; "String detects empty extension")
[RESETSAVE [SETQ TEXT (OPENSTREAM (if (STREAMP TEXT)
elseif (OR (CL:PATHNAMEP TEXT)
(FILENAMEFIELD.STRING TEXT
'EXTENSION))
then (FINDFILE TEXT T)
elseif (FINDFILE-WITH-EXTENSIONS TEXT NIL
*TEDIT-EXTENSIONS*)
else TEXT)
'INPUT
'OLD
`((TYPE TEXT)
(FORMAT ,(LISTGET PROPS 'FORMAT]
'(PROGN (AND RESETSTATE (CLOSEF? OLDVALUE]
TEXT
else
(* ;; "Don't know what it is")
(ERROR TEXT " does not identify a Tedit document")))])
elseif [AND (OR (LITATOM TEXT)
(STRINGP TEXT)
(CL:PATHNAMEP TEXT)
(STREAMP TEXT))
(CAR (NLSETQ (OPENSTREAM (if (STREAMP TEXT)
elseif (CL:PATHNAMEP TEXT)
then (FINDFILE TEXT T)
elseif (FINDFILE-WITH-EXTENSIONS TEXT NIL
*TEDIT-EXTENSIONS*)
else TEXT)
'INPUT
'OLD
`((TYPE TEXT)
(FORMAT ,(LISTGET PROPS 'FORMAT]
elseif ERROR
then (ERROR "File not found:" TEXT)))])
(\TEDIT.CREATE.TEXTSTREAM
[LAMBDA (PROPS) (* ; "Edited 28-Jul-2025 22:56 by rmk")
@@ -1749,9 +1756,13 @@
(* ;; "Return the new value for the stream:")
NEWSTREAM])
)
(DEFINEQ
(\TEDIT.TEXTINIT
[LAMBDA NIL (* ; "Edited 23-Sep-2025 08:19 by rmk")
(\TEDIT.STREAMINIT
[LAMBDA NIL (* ; "Edited 16-Feb-2026 12:40 by rmk")
(* ; "Edited 26-Jan-2026 16:06 by rmk")
(* ; "Edited 23-Sep-2025 21:03 by rmk")
(* ; "Edited 20-Sep-2025 08:48 by rmk")
(* ; "Edited 18-Sep-2025 14:52 by rmk")
(* ; "Edited 10-Jul-2025 11:28 by rmk")
@@ -1791,7 +1802,7 @@
(* ;; "(FW8 WORD)")
(SETQ \TEDITIMAGEOPS (create IMAGEOPS
IMAGETYPE _ 'TEXT
IMAGETYPE _ 'TEDIT
IMXPOSITION _ (FUNCTION \TEDIT.TEXTDSPXPOSITION)
IMYPOSITION _ (FUNCTION \TEDIT.TEXTDSPYPOSITION)
IMLEFTMARGIN _ (FUNCTION \TEDIT.TEXTLEFTMARGIN)
@@ -1805,22 +1816,17 @@
IMSCALE _ [FUNCTION (LAMBDA NIL 1]
IMCOLOR _ (FUNCTION \TEDIT.TEXTCOLOR)))
(* ;; "Do we need TEXT here?")
(FONTPROFILE.ADDDEVICE 'TEXT 'DISPLAY)
(ADDTOVAR IMAGESTREAMTYPES (TEXT (FONTCREATE \CREATEDISPLAYFONT)
(CREATECHARSET \CREATECHARSET.DISPLAY)))
(ADDTOVAR IMAGESTREAMTYPES (TEDIT (FONTCREATE \CREATEDISPLAYFONT)
(CREATECHARSET \CREATECHARSET.DISPLAY)))
(* ;; "Maybe more functions later. The INCODE and BACK functions possibly need to count. If \TEXTBACKFILEPTR takes a count variable, the extra level wouldn't be needed. But INCCODE wants to go through the BIN opcode")
(MAKE-EXTERNALFORMAT :TEXTSTREAM (FUNCTION \TEDIT.TEXTINCCODEFN)
(MAKE-EXTERNALFORMAT :TEDIT (FUNCTION \TEDIT.TEXTINCCODEFN)
(FUNCTION \TEDIT.TEXTPEEKBIN)
(FUNCTION \TEDIT.TEXTBACKCCODEFN)
(FUNCTION \TEDIT.TEXTOUTCHARFN)
(FUNCTION \TEDIT.TEXTFORMATBYTESTREAM)
'CR NIL (FUNCTION \TEDIT.TEXTFORMATBYTESTRING))
(* ;; "Support for error handling: The old error handler for the stream-not-open error. ")
(SETQ \TEDITFDEV (create FDEV
DEVICENAME _ 'TEDIT
RESETABLE _ T
@@ -1855,7 +1861,9 @@
FDEXTENDABLE _ NIL
TRUNCATEFILE _ (FUNCTION NILL)
WRITEPAGES _ (FUNCTION NILL)
DEFAULTEXTERNALFORMAT _ :TEXTSTREAM))
DEFAULTEXTERNALFORMAT _ :TEDIT)) (* ;
 "Only load once, not every time TEDIT-STREAM is loaded e.g. in development")
(RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN))
(CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
(FUNCTION (LAMBDA (CONDITION)
(LET ((STREAM (STREAM-ERROR-STREAM CONDITION)))
@@ -1873,8 +1881,15 @@
(* ;
 "Some other kind of stream, so punt to the old handler (if there is one):")
(APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION])
(TEDIT.IMAGESTREAM.OPEN
[LAMBDA (FILE OPTIONS) (* ; "Edited 26-Jan-2026 23:55 by rmk")
(OPENTEXTSTREAM FILE NIL OPTIONS])
)
(ADDTOVAR IMAGESTREAMTYPES (TEDIT (OPENSTREAM TEDIT.IMAGESTREAM.OPEN)
(CREATECHARSET \CREATECHARSET.DISPLAY)))
(* ;; "Is this being used:")
@@ -2100,28 +2115,34 @@
(\TEDIT.INSTALL.PIECE TSTREAM PC (- CH# START-OF-PIECE)))])
(\TEDIT.TEXTDSPXPOSITION
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 20-Sep-2025 08:30 by rmk")
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 20-Sep-2025 22:48 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
(* ; "Edited 17-Mar-2024 12:15 by rmk")
(* ; "Edited 3-Jan-2001 17:27 by rmk:")
(* ;
 "Edited 24-Oct-88 23:09 by rmk:; Edited 26-Sep-85 16:30 by ajb:")
(* ;; "This doesn't make much sense for a character-oriented stream like a TEDIT stream. If the stream is displayed in a window, this returns the window's current position, and changes it as well. But that doesn't affect or particularly relate to the underlying sequence of characters.")
(* ;;
 "Simply returns the XPOSITION of the primary window's display stream, this is a read-only function")
(* ;; "If there is no window (an OPENTEXTSTREAM being written on by a printing algorithm, like the pretty printer for source files, this estimates the XPOSITION from the number of characters that have been printed on the line since the last TERPRI (= POSITION), assuming that they are all the width of the space (or the average charwidth). And if XPOSITION is non-NIL, that is also translated into an estimated number of characters, and spaces are put out to get out to that position (essentially assuming that we are writing at the end of the file). We can't go backwards.")
(* ;; "")
(* ;; "We could be more accurate by reading backwards to the last TERPRI, and not rely on POSITION. And if we were going backwards, we could think of this as setting the caret position as close as possible to the specified XPOSITION, But going forward, we still would have to fill in with spaces--and that's the PRETTYPRINT case.")
(LET ((WINDOW (\TEDIT.PRIMARYPANE TSTREAM))
SPACEWIDTH) (* ;
SPACEWIDTH CHARPOS NSPACES) (* ;
 "If there is no window, estimate from character position")
(if WINDOW
then (DSPXPOSITION XPOSITION WINDOW)
else (SETQ SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
TSTREAM))
(PROG1 (TIMES SPACEWIDTH (POSITION TSTREAM))
(CL:WHEN (AND XPOSITION (IGEQ XPOSITION 0))
(SPACES (IDIFFERENCE (QUOTIENT XPOSITION SPACEWIDTH)
(POSITION TSTREAM))
TSTREAM)))])
(SETQ CHARPOS (POSITION TSTREAM))
(PROG1 (TIMES SPACEWIDTH CHARPOS)
(CL:WHEN XPOSITION
(SETQ NSPACES (IDIFFERENCE (FIXR (FQUOTIENT XPOSITION SPACEWIDTH))
CHARPOS))
(CL:WHEN (IGREATERP NSPACES 0)
(SPACES NSPACES TSTREAM))))])
(\TEDIT.TEXTDSPYPOSITION
[LAMBDA (TSTREAM YPOSITION) (* ; "Edited 25-Jun-2024 11:59 by rmk")
@@ -2235,7 +2256,8 @@
(DEFINEQ
(\TEDIT.NTHCHARCODE
[LAMBDA (TSTREAM N) (* ; "Edited 24-Apr-2025 16:03 by rmk")
[LAMBDA (TSTREAM N) (* ; "Edited 15-Feb-2026 14:40 by rmk")
(* ; "Edited 24-Apr-2025 16:03 by rmk")
(* ; "Edited 28-Mar-2025 18:31 by rmk")
(* ; "Edited 7-Jul-2024 11:09 by rmk")
(* ; "Edited 29-Apr-2024 13:06 by rmk")
@@ -2252,11 +2274,11 @@
(CL:WHEN (AND (IGEQ N 1)
(ILEQ N (FGETTOBJ TEXTOBJ TEXTLEN)))
(\TEDIT.PIECE.NTHCHARCODE (\TEDIT.CHTOPC N TEXTOBJ T)
(IDIFFERENCE (ADD1 N)
START-OF-PIECE)))])
(IDIFFERENCE N START-OF-PIECE)))])
(\TEDIT.PIECE.NTHCHARCODE
[LAMBDA (PC OFFSET) (* ; "Edited 24-Apr-2025 16:04 by rmk")
[LAMBDA (PC OFFSET) (* ; "Edited 15-Feb-2026 14:31 by rmk")
(* ; "Edited 24-Apr-2025 16:04 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 29-Apr-2024 08:46 by rmk")
(* ; "Edited 22-Mar-2024 00:02 by rmk")
@@ -2268,24 +2290,24 @@
(* ; "Edited 8-Nov-2023 08:43 by rmk")
(* ; "Edited 5-Nov-2023 08:17 by rmk")
(* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. For file pieces, ensures that the backing stream is restored to its original position, so that it remains comaptible with the values (buffer, offset) in the textstream.")
(* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. For file pieces, ensures that the backing stream is restored to its original position, so that it remains comaptible with the values (buffer, offset) in the textstream. OFFSET ranges from 0 to PLEN-1.")
(CL:WHEN (AND (IGEQ OFFSET 1)
(ILEQ OFFSET (PLEN PC)))
(CL:WHEN (AND (IGEQ OFFSET 0)
(ILESSP OFFSET (PLEN PC)))
[LET ((PCONTENTS (PCONTENTS PC))
FILEPOS)
(SELECTC (PTYPE PC)
(STRING.PTYPES (NTHCHARCODE PCONTENTS OFFSET))
(STRING.PTYPES (NTHCHARCODE PCONTENTS (ADD1 OFFSET)))
(THINFILE.PTYPE
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
(SUB1 OFFSET)))
OFFSET))
(PROG1 (BIN PCONTENTS)
(\SETFILEPTR PCONTENTS FILEPOS)))
(FATFILE1.PTYPE
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
(SUB1 OFFSET)))
OFFSET))
(PROG1 (create WORD
HIBYTE _ (PCHARSET PC)
LOBYTE _ (BIN PCONTENTS))
@@ -2293,14 +2315,12 @@
(FATFILE2.PTYPE
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
(UNFOLD (SUB1 OFFSET)
2)))
(UNFOLD OFFSET 2)))
(PROG1 (\WIN PCONTENTS)
(\SETFILEPTR PCONTENTS FILEPOS)))
(UTF8.PTYPE (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
[\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
(ITIMES (SUB1 OFFSET)
(PBYTESPERCHAR PC]
(ITIMES OFFSET (PBYTESPERCHAR PC]
(PROG1 (UTF8.INCCODEFN PCONTENTS)
(\SETFILEPTR PCONTENTS FILEPOS)))
(OBJECT.PTYPE PCONTENTS)
@@ -2313,7 +2333,8 @@
(\TEDIT.THELP '\TEDIT.PIECE.NTHCHARCODE])])
(\TEDIT.RPLCHARCODE
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 24-Apr-2025 17:24 by rmk")
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 16-Feb-2026 08:37 by rmk")
(* ; "Edited 24-Apr-2025 17:24 by rmk")
(* ; "Edited 20-Apr-2025 13:25 by rmk")
(* ; "Edited 28-Mar-2025 10:04 by rmk")
@@ -2329,16 +2350,17 @@
(DECLARE (SPECVARS START-OF-PIECE))
(replace (STREAM BINABLE) of TSTREAM with NIL)
(SETQ OLDCHAR (\TEDIT.PIECE.RPLCHARCODE TEXTOBJ (\TEDIT.CHTOPC N TEXTOBJ T)
(ADD1 (IDIFFERENCE N START-OF-PIECE))
(IDIFFERENCE N START-OF-PIECE)
NEWCHARCODE NEWCHARLOOKS))
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N NIL NIL NIL
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N 1 NIL NIL
OLDCHAR))
(CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
(\TEDIT.UPDATE.LINES TSTREAM 'CHANGED N 1))
TSTREAM))])
(\TEDIT.PIECE.RPLCHARCODE
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 28-Jul-2025 23:38 by rmk")
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 16-Feb-2026 08:41 by rmk")
(* ; "Edited 28-Jul-2025 23:38 by rmk")
(* ; "Edited 24-Apr-2025 16:30 by rmk")
(* ; "Edited 20-Apr-2025 13:25 by rmk")
(* ; "Edited 28-Mar-2025 10:04 by rmk")
@@ -2363,12 +2385,13 @@
 "Fast case: Smash a new character code into an existing string piece with same looks. ")
(SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC)
OFFSET))
(ADD1 OFFSET)))
(RPLCHARCODE (PCONTENTS PC)
OFFSET NEWCHARCODE) (* ;
(ADD1 OFFSET)
NEWCHARCODE) (* ;
 "May upgrade string from thin to fat")
(CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
(IGREATERP NEWCHARCODE 255))
(IGREATERP NEWCHARCODE \MAXTHINCHAR))
(FSETPC PC PTYPE FATSTRING.PTYPE)
(FSETPC PC PBINABLE NIL)
(FSETPC PC PBYTESPERCHAR 2)
@@ -2382,24 +2405,25 @@
(FSETPC PC PCONTENTS NEWCHARCODE)
else
(* ;;
 "PC contained character OFFSET now becomes the suffix of characters after offset.")
 "The PC that contained character OFFSET now becomes the suffix of characters after offset.")
(CL:UNLESS (IEQP OFFSET (PLEN PC)) (* ; "No suffix for the last character")
(CL:UNLESS (IEQP OFFSET (PLAST PC)) (* ; "No suffix for the last character")
(* ;;
 "Chop off the suffix (essentially (\TEDIT.ALIGNEDPIECE CHNO ..) but we already have the piece")
(\TEDIT.SPLITPIECE PC OFFSET TEXTOBJ)
(\TEDIT.SPLITPIECE PC (ADD1 OFFSET)
TEXTOBJ)
(SETQ PC (PREVPIECE PC))) (* ;
 "Original PC holds the suffix, new PC ends with change position.")
(CL:UNLESS (EQ OFFSET 1)
(CL:UNLESS (EQ OFFSET 0)
(SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET)
TEXTOBJ))) (* ;
 "Chop off the prefix. PC is now the singleton target ")
(* ;; "OFFSET is now isolated into a one-character new piece which we smash. ")
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 1))
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 0))
(if (IMAGEOBJP NEWCHARCODE)
then (FSETPC PC PBINABLE NIL)
(FSETPC PC PCONTENTS NEWCHARCODE)
@@ -2409,7 +2433,7 @@
else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE)))
(* ;
 "Use the extend-string in INSERTCH for repeated calls?")
(if (IGREATERP NEWCHARCODE 255)
(if (IGREATERP NEWCHARCODE \MAXTHINCHAR)
then (FSETPC PC PTYPE FATSTRING.PTYPE)
(FSETPC PC PBINABLE NIL)
(FSETPC PC PBYTESPERCHAR 2)
@@ -2796,7 +2820,8 @@
else (SUB1 (\TEDIT.PCTOCH PC TEXTOBJ])
(\TEDIT.LASTCHANGEABLE.CHNO
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 26-Nov-2024 00:00 by rmk")
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 16-Feb-2026 08:53 by rmk")
(* ; "Edited 26-Nov-2024 00:00 by rmk")
(* ;; "Returns the number of the first visible character at or before CHNO, NIL if the first visible character is protected. Almost always CHNO--PCTOCH is the unusual case.")
@@ -2805,46 +2830,11 @@
CLPROTECTED) when (VISIBLEPIECEP PC)
do (RETURN (if (EQ PC FIRSTPIECE)
then CHNO
else (IPLUS (SUB1 (PLEN PC))
else (IPLUS (PLAST PC)
(\TEDIT.PCTOCH PC TEXTOBJ])
)
(DEFINEQ
(\SETUPGETCH
[LAMBDA (CH# TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 29-Apr-2024 12:14 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 23-Dec-2023 12:14 by rmk")
(* ; "Edited 22-Aug-2022 13:04 by rmk")
(* ; "Edited 10-Aug-2022 17:20 by rmk")
(* ; "Edited 8-Aug-2022 15:07 by rmk")
(* ; "Edited 31-Jul-2022 21:27 by rmk")
(* ; "Edited 14-Apr-93 17:14 by jds")
(* ;;; "Set up TEXTOBJ so that the next \GETCH will retrieve character # CH#")
(* ;; "NB that 1st char in the textobj is #1.")
(* ;; "NOBODY CALLS IT WITH A PIECE. CALLS |INSTALL.PIECE INSTEAD")
(SETQ TEXTOBJ (TEXTOBJ))
(LET ((TSTREAM (TEXTSTREAM TEXTOBJ)))
(COND
((TYPE? PIECE CH#)
(\TEDIT.THELP "\SETUPGETCH CALLED WITH PIECE")
(\TEDIT.INSTALL.PIECE TSTREAM CH# 0))
(T (LET (START-OF-PIECE PC)
(DECLARE (SPECVARS START-OF-PIECE))
(SETQ PC (\TEDIT.CHTOPC CH# TEXTOBJ T))
(\TEDIT.INSTALL.PIECE TSTREAM PC (- CH# START-OF-PIECE])
)
(* ; "Deprecated, maybe still external callers")
(DEFINEQ
(\TEDIT.INSTALL.PIECE
[LAMBDA (TSTREAM PC CHOFFSET) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 18-May-2024 22:39 by rmk")
@@ -2970,7 +2960,8 @@
OLDITEMS])
(\TEDIT.TEXTPROP
[LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 17-Jul-2025 00:19 by rmk")
[LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 5-Oct-2025 10:15 by rmk")
(* ; "Edited 17-Jul-2025 00:19 by rmk")
(* ; "Edited 16-Feb-2025 23:27 by rmk")
(* ; "Edited 15-Feb-2025 14:02 by rmk")
(* ; "Edited 22-Dec-2024 00:23 by rmk")
@@ -3056,32 +3047,42 @@
(CL:WHEN SETNEWVALUE (FSETTOBJ TEXTOBJ LOOPFN NEWVALUE))))
(CHARFN (PROG1 (FGETTOBJ TEXTOBJ CHARFN)
(CL:WHEN SETNEWVALUE (FSETTOBJ TEXTOBJ CHARFN NEWVALUE))))
(PROG1 (LISTGET (FGETTOBJ TEXTOBJ EDITPROPS)
PROP)
(CL:WHEN SETNEWVALUE
(CL:UNLESS (LISTP (FGETTOBJ TEXTOBJ EDITPROPS))
(OR (PROG1 (LISTGET (FGETTOBJ TEXTOBJ EDITPROPS)
PROP)
(CL:WHEN SETNEWVALUE
(CL:UNLESS (LISTP (FGETTOBJ TEXTOBJ EDITPROPS))
(* ;
 "Make sure we have a list to smash, no matter what.")
(FSETTOBJ TEXTOBJ EDITPROPS (LIST PROP NIL)))
(LISTPUT (FGETTOBJ TEXTOBJ EDITPROPS)
PROP NEWVALUE)))])
(FSETTOBJ TEXTOBJ EDITPROPS (LIST PROP NIL)))
(LISTPUT (FGETTOBJ TEXTOBJ EDITPROPS)
PROP NEWVALUE)))
(PROG1 (GETMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
PROP)
(CL:WHEN SETNEWVALUE
(PUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
PROP NEWVALUE)))])
)
(DEFINEQ
(\TEDIT.TEXTOBJ.PROPNAMES
[LAMBDA (TEXTOBJ) (* ; "Edited 4-Jul-2024 11:08 by rmk")
[LAMBDA (TEXTOBJ) (* ; "Edited 5-Oct-2025 10:50 by rmk")
(* ; "Edited 4-Jul-2024 11:08 by rmk")
(* ; "Edited 30-Jun-2024 09:04 by rmk")
(* ;; "Stick the user properties at the end with --USERPROPS-- separator. INSPECTABLEFIELDNAMES does the sort for defined field names, the UFIELDS have to be sorted here.")
(LET ([TFIELDS (REMOVE 'EDITPROPS (INSPECTABLEFIELDNAMES (OR (RECLOOK 'TEXTOBJ)
(LET [[TFIELDS (REMOVE 'EDITPROPS (INSPECTABLEFIELDNAMES (OR (RECLOOK 'TEXTOBJ)
(SYSRECLOOK1 'TEXTOBJ]
(UFIELDS (for X in (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ) by (CDDR X) collect X)))
(EPROPS (for X in (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ) by (CDDR X) collect X))
(DPROPS (for X in (fetch (TEXTOBJ DOCPROPS) of TEXTOBJ) collect (CAR X]
(CL:UNLESS (OR (EQ T INSPECTDONTSORTFIELDS)
(MEMB 'TEXTOBJ INSPECTDONTSORTFIELDS))
(SETQ UFIELDS (SORT UFIELDS)))
(APPEND TFIELDS (CONS '--USERPROPS--)
UFIELDS])
(SETQ EPROPS (SORT EPROPS))
(SETQ DPROPS (SORT DPROPS)))
(APPEND TFIELDS (CONS '--EDITPROPS--)
EPROPS
(CONS '--DOCPROPS--)
DPROPS])
(\TEDIT.TEXTOBJ.PROPFETCHFN
[LAMBDA (TEXTOBJ PROPNAME) (* ; "Edited 4-Jul-2024 11:53 by rmk")
@@ -3113,18 +3114,9 @@
(ADDTOVAR INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES \TEDIT.TEXTOBJ.PROPFETCHFN
\TEDIT.TEXTOBJ.PROPSTOREFN))
)
(* ;;
"Support for error handling: The old error handler for the stream-not-open error. This is here, because you only want to do this ONCE, even if you load TEXT-STREAM multiple times (as, e.g., in development)"
)
(RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN))
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\TEDIT.TEXTINIT)
(\TEDIT.STREAMINIT)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -3135,34 +3127,33 @@
(ADDTOVAR LAMA TEXTPROP)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (36887 67703 (\TEDIT.TEXTBIN 36897 . 47647) (\TEDIT.TEXTPEEKBIN 47649 . 53199) (
\TEDIT.TEXTBACKFILEPTR 53201 . 58874) (\TEDIT.TEXTBOUT 58876 . 63493) (\TEDIT.INSTALL.FILEBUFFER 63495
. 67701)) (68601 72892 (\TEDIT.TEXTOUTCHARFN 68611 . 70167) (\TEDIT.TEXTINCCODEFN 70169 . 70908) (
\TEDIT.TEXTBACKCCODEFN 70910 . 71502) (\TEDIT.TEXTFORMATBYTESTREAM 71504 . 72341) (
\TEDIT.TEXTFORMATBYTESTRING 72343 . 72890)) (72939 84503 (OPENTEXTSTREAM 72949 . 79824) (
COPYTEXTSTREAM 79826 . 83726) (TEDIT.STREAMCHANGEDP 83728 . 84030) (TXTFILE 84032 . 84501)) (84504
115746 (\TEDIT.REOPENTEXTSTREAM 84514 . 85866) (\TEDIT.OPENTEXTSTREAM.PIECES 85868 . 90796) (
\TEDIT.OPENTEXTSTREAM.PROPS 90798 . 91900) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91902 . 97143) (
\TEDIT.OPENTEXTSTREAM.WINDOW 97145 . 99936) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 99938 . 101877) (
\TEDIT.OPENTEXTFILE 101879 . 104356) (\TEDIT.CREATE.TEXTSTREAM 104358 . 105505) (\TEDIT.REOPEN.STREAM
105507 . 107843) (\TEDIT.TEXTINIT 107845 . 115744)) (115784 116972 (\TEDIT.TTYBOUT 115794 . 116970)) (
117090 137553 (\TEDIT.TEXTCLOSEF 117100 . 118424) (\TEDIT.TEXTDSPFONT 118426 . 119624) (
\TEDIT.TEXTEOFP 119626 . 121381) (\TEDIT.TEXTGETEOFPTR 121383 . 121706) (\TEDIT.TEXTSETEOFPTR 121708
. 122995) (\TEDIT.TEXTGETFILEPTR 122997 . 125832) (\TEDIT.TEXTSETFILEINFO 125834 . 126342) (
\TEDIT.TEXTOPENF 126344 . 127275) (\TEDIT.TEXTSETEOF 127277 . 127893) (\TEDIT.TEXTSETFILEPTR 127895 .
130005) (\TEDIT.TEXTDSPXPOSITION 130007 . 131490) (\TEDIT.TEXTDSPYPOSITION 131492 . 132233) (
\TEDIT.TEXTLEFTMARGIN 132235 . 132826) (\TEDIT.TEXTCOLOR 132828 . 133411) (\TEDIT.TEXTRIGHTMARGIN
133413 . 136702) (\TEDIT.TEXTDSPCHARWIDTH 136704 . 137008) (\TEDIT.TEXTDSPSTRINGWIDTH 137010 . 137316)
(\TEDIT.TEXTDSPLINEFEED 137318 . 137551)) (137591 150204 (\TEDIT.NTHCHARCODE 137601 . 139052) (
\TEDIT.PIECE.NTHCHARCODE 139054 . 142964) (\TEDIT.RPLCHARCODE 142966 . 144424) (
\TEDIT.PIECE.RPLCHARCODE 144426 . 149849) (\TEDIT.NTHCHARLOOKS 149851 . 150202)) (151251 172345 (
\TEDIT.DELETE.SELPIECES 151261 . 154886) (\TEDIT.INSERTCH 154888 . 162927) (\TEDIT.INSERTCH.HISTORY
162929 . 166393) (\TEDIT.INSERTEOL 166395 . 168220) (\TEDIT.INSERTCH.INSERTION 168222 . 171059) (
\TEDIT.INSERTCH.EXTEND 171061 . 172343)) (172346 173850 (\TEDIT.NEXTCHANGEABLE.CHNO 172356 . 173071) (
\TEDIT.LASTCHANGEABLE.CHNO 173073 . 173848)) (173851 175555 (\SETUPGETCH 173861 . 175553)) (175613
180071 (\TEDIT.INSTALL.PIECE 175623 . 180069)) (180109 189210 (TEXTPROP 180119 . 180466) (GETTEXTPROP
180468 . 180712) (PUTTEXTPROP 180714 . 180971) (GETTEXTPROPS 180973 . 181417) (PUTTEXTPROPS 181419 .
182323) (TEXTPROP.ADD 182325 . 182588) (\TEDIT.TEXTPROP 182590 . 189208)) (189211 191281 (
\TEDIT.TEXTOBJ.PROPNAMES 189221 . 190173) (\TEDIT.TEXTOBJ.PROPFETCHFN 190175 . 190691) (
\TEDIT.TEXTOBJ.PROPSTOREFN 190693 . 191279)))))
(FILEMAP (NIL (36667 67629 (\TEDIT.TEXTBIN 36677 . 47470) (\TEDIT.TEXTPEEKBIN 47472 . 53022) (
\TEDIT.TEXTBACKFILEPTR 53024 . 58800) (\TEDIT.TEXTBOUT 58802 . 63419) (\TEDIT.INSTALL.FILEBUFFER 63421
. 67627)) (68527 72818 (\TEDIT.TEXTOUTCHARFN 68537 . 70093) (\TEDIT.TEXTINCCODEFN 70095 . 70834) (
\TEDIT.TEXTBACKCCODEFN 70836 . 71428) (\TEDIT.TEXTFORMATBYTESTREAM 71430 . 72267) (
\TEDIT.TEXTFORMATBYTESTRING 72269 . 72816)) (72865 84940 (OPENTEXTSTREAM 72875 . 79851) (
COPYTEXTSTREAM 79853 . 84163) (TEDIT.STREAMCHANGEDP 84165 . 84467) (TXTFILE 84469 . 84938)) (84941
108146 (\TEDIT.REOPENTEXTSTREAM 84951 . 86303) (\TEDIT.OPENTEXTSTREAM.PIECES 86305 . 91233) (
\TEDIT.OPENTEXTSTREAM.PROPS 91235 . 92337) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92339 . 97789) (
\TEDIT.OPENTEXTSTREAM.WINDOW 97791 . 100582) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100584 . 102523) (
\TEDIT.OPENTEXTFILE 102525 . 104657) (\TEDIT.CREATE.TEXTSTREAM 104659 . 105806) (\TEDIT.REOPEN.STREAM
105808 . 108144)) (108147 116372 (\TEDIT.STREAMINIT 108157 . 116189) (TEDIT.IMAGESTREAM.OPEN 116191 .
116370)) (116560 117748 (\TEDIT.TTYBOUT 116570 . 117746)) (117866 139549 (\TEDIT.TEXTCLOSEF 117876 .
119200) (\TEDIT.TEXTDSPFONT 119202 . 120400) (\TEDIT.TEXTEOFP 120402 . 122157) (\TEDIT.TEXTGETEOFPTR
122159 . 122482) (\TEDIT.TEXTSETEOFPTR 122484 . 123771) (\TEDIT.TEXTGETFILEPTR 123773 . 126608) (
\TEDIT.TEXTSETFILEINFO 126610 . 127118) (\TEDIT.TEXTOPENF 127120 . 128051) (\TEDIT.TEXTSETEOF 128053
. 128669) (\TEDIT.TEXTSETFILEPTR 128671 . 130781) (\TEDIT.TEXTDSPXPOSITION 130783 . 133486) (
\TEDIT.TEXTDSPYPOSITION 133488 . 134229) (\TEDIT.TEXTLEFTMARGIN 134231 . 134822) (\TEDIT.TEXTCOLOR
134824 . 135407) (\TEDIT.TEXTRIGHTMARGIN 135409 . 138698) (\TEDIT.TEXTDSPCHARWIDTH 138700 . 139004) (
\TEDIT.TEXTDSPSTRINGWIDTH 139006 . 139312) (\TEDIT.TEXTDSPLINEFEED 139314 . 139547)) (139587 152583 (
\TEDIT.NTHCHARCODE 139597 . 141123) (\TEDIT.PIECE.NTHCHARCODE 141125 . 145033) (\TEDIT.RPLCHARCODE
145035 . 146593) (\TEDIT.PIECE.RPLCHARCODE 146595 . 152228) (\TEDIT.NTHCHARLOOKS 152230 . 152581)) (
153630 174724 (\TEDIT.DELETE.SELPIECES 153640 . 157265) (\TEDIT.INSERTCH 157267 . 165306) (
\TEDIT.INSERTCH.HISTORY 165308 . 168772) (\TEDIT.INSERTEOL 168774 . 170599) (\TEDIT.INSERTCH.INSERTION
170601 . 173438) (\TEDIT.INSERTCH.EXTEND 173440 . 174722)) (174725 176332 (\TEDIT.NEXTCHANGEABLE.CHNO
174735 . 175450) (\TEDIT.LASTCHANGEABLE.CHNO 175452 . 176330)) (176333 180791 (\TEDIT.INSTALL.PIECE
176343 . 180789)) (180829 190295 (TEXTPROP 180839 . 181186) (GETTEXTPROP 181188 . 181432) (PUTTEXTPROP
181434 . 181691) (GETTEXTPROPS 181693 . 182137) (PUTTEXTPROPS 182139 . 183043) (TEXTPROP.ADD 183045
. 183308) (\TEDIT.TEXTPROP 183310 . 190293)) (190296 192673 (\TEDIT.TEXTOBJ.PROPNAMES 190306 . 191565
) (\TEDIT.TEXTOBJ.PROPFETCHFN 191567 . 192083) (\TEDIT.TEXTOBJ.PROPSTOREFN 192085 . 192671)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Sep-2025 11:11:43" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;187 97463
(FILECREATED "21-Jan-2026 12:15:57" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;190 98203
:EDIT-BY rmk
:CHANGES-TO (FNS TEDITFROMBRAVO \TFBRAVO.FONT.FROM.CHARLOOKS)
:CHANGES-TO (FNS BRAVOFILEP)
(VARS TEDIT-TFBRAVOCOMS)
:PREVIOUS-DATE "28-Jul-2025 23:34:14" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;185)
:PREVIOUS-DATE " 7-Sep-2025 11:11:43" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;187)
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -20,10 +20,12 @@
(CONSTANTS (BRAVO.TRAILER.CHARS '(l d z x e y k j c q %( %) %, s S u U b B i I g G v V
w W t f o % \ 0 1 2 3 4 5 6 7 8 9]
(* ;; "Interface to TEDIT")
(* ;; "Interface to TEDIT and CONVERT.TO.IMAGE.FILE")
(FNS TEDIT.BRAVOFILE? TEDITFROMBRAVO)
(ADDVARS (TEDIT.INPUT.FORMATS (TEDIT.BRAVOFILE? TEDITFROMBRAVO)))
(FNS BRAVOFILEP TEDITFROMBRAVO)
(ADDVARS (TEDIT.INPUT.FORMATS (BRAVOFILEP TEDITFROMBRAVO)))
(ALISTS (PRINTFILETYPES BRAVO))
[P (DEFAULT.IMAGETYPE.CONVERSIONS '(BRAVO TEDIT.TO.IMAGEFILE]
(* ;; "Initial looks, USER.CM")
@@ -154,36 +156,44 @@
(* ;; "Interface to TEDIT")
(* ;; "Interface to TEDIT and CONVERT.TO.IMAGE.FILE")
(DEFINEQ
(TEDIT.BRAVOFILE?
[LAMBDA (STREAM TEXTOBJ) (* ; "Edited 28-Nov-2023 10:34 by rmk")
(BRAVOFILEP
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 21-Jan-2026 12:15 by rmk")
(* ; "Edited 28-Nov-2023 10:34 by rmk")
(* ; "Edited 17-Aug-2023 08:09 by rmk")
(* ; "Edited 11-Aug-2023 22:59 by rmk")
(* ; "Edited 5-Aug-2023 23:05 by rmk")
(* ; "Edited 1-Aug-2023 08:15 by rmk")
(* gbn " 3-Jun-85 21:06")
(* ;; "T if the open STREAM looks like a Bravo file.")
(* ;; "T if FILE looks like a Bravo file.")
(PROG (PLOOKS ENDCONDITION (ORIGINAL.FILE.POSITION (GETFILEPTR STREAM))
NAME DIRS USER.CM) (* ;
(RESETLST
(PROG* ((STREAM (\GETSTREAM FILE 'INPUT T))
(ORIGINAL.FILE.POSITION (CL:IF STREAM
(GETFILEPTR STREAM)
0))
PLOOKS ENDCONDITION NAME DIRS USER.CM) (* ;
 "first look for a ^z, (beginning of a Bravo trailer)")
(CL:UNLESS (\TFBRAVO.FIND.LAST.TRAILER STREAM)
(SETFILEPTR STREAM ORIGINAL.FILE.POSITION)
(RETURN NIL)) (* ; "BIN past the ^z")
(BIN STREAM)
(SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS STREAM)) (* ;
(CL:UNLESS STREAM
[RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT))
`(PROGN (CLOSEF? OLDVALUE])
(CL:UNLESS (\TFBRAVO.FIND.LAST.TRAILER STREAM)
(SETFILEPTR STREAM ORIGINAL.FILE.POSITION)
(RETURN NIL)) (* ; "BIN past the ^z")
(BIN STREAM)
(SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS STREAM)) (* ;
 "if the next symbol is a slash then check if the character looks are valid")
[SETQ ENDCONDITION (CL:WHEN (EQ (CAR PLOOKS)
'\)
(repeatuntil (\TEST.CHARACTER.LOOKS STREAM)))]
(SETFILEPTR STREAM ORIGINAL.FILE.POSITION)
(CL:WHEN (EQ ENDCONDITION 'BADLOOKS)
(RETURN NIL))
(RETURN T])
[SETQ ENDCONDITION (CL:WHEN (EQ (CAR PLOOKS)
'\)
(repeatuntil (\TEST.CHARACTER.LOOKS STREAM)))]
(SETFILEPTR STREAM ORIGINAL.FILE.POSITION)
(CL:WHEN (EQ ENDCONDITION 'BADLOOKS)
(RETURN NIL))
(RETURN T)))])
(TEDITFROMBRAVO
[LAMBDA (BFILE TSTREAM PROPS USER.CM) (* ; "Edited 7-Sep-2025 11:09 by rmk")
@@ -254,7 +264,12 @@
(RETURN TSTREAM)))])
)
(ADDTOVAR TEDIT.INPUT.FORMATS (TEDIT.BRAVOFILE? TEDITFROMBRAVO))
(ADDTOVAR TEDIT.INPUT.FORMATS (BRAVOFILEP TEDITFROMBRAVO))
(ADDTOVAR PRINTFILETYPES (BRAVO (TEST BRAVOFILEP)
(EXTENSION (BRAVO))))
(DEFAULT.IMAGETYPE.CONVERSIONS '(BRAVO TEDIT.TO.IMAGEFILE))
@@ -1556,18 +1571,18 @@
(AND NIL (\TEDIT.NAMEDTAB.INIT))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7665 14759 (TEDIT.BRAVOFILE? 7675 . 9405) (TEDITFROMBRAVO 9407 . 14757)) (14870 31286 (
\TFBRAVO.GET.USER.CM 14880 . 18060) (\TFBRAVO.USER.CM.LOOKS 18062 . 19555) (\TFBRAVO.READ.USER.CM
19557 . 24180) (\TFBRAVO.INIT.PARALOOKS 24182 . 26399) (\TFBRAVO.INIT.PAGEFORMAT 26401 . 27281) (
\TFBRAVO.GETPARAMS 27283 . 30137) (\TFBRAVO.FIND.LAST.TRAILER 30139 . 31284)) (31328 52033 (
\TFBRAVO.PARSE.PARA 31338 . 35265) (\TFBRAVO.READ.PARALOOKS 35267 . 42157) (\TFBRAVO.CREATE.RUNS 42159
. 43547) (\TFBRAVO.READ.CHARLOOKS 43549 . 48578) (\TFBRAVO.FONT.FROM.CHARLOOKS 48580 . 50134) (
\TFBRAVO.READNUM? 50136 . 52031)) (52070 63111 (\TFBRAVO.HANDLE.HEADING 52080 . 54807) (
\TFBRAVO.PARSE.PROFILE.PARA 54809 . 63109)) (63154 85488 (\TFBRAVO.INSERT.PARA 63164 . 64005) (
\TFBRAVO.INSERT.RUN 64007 . 67498) (\TFBRAVO.SPLIT.PARA 67500 . 74924) (\TFBRAVO.RUN.TABSPEC 74926 .
79793) (\TFBRAVO.INSTALL.PAGEFORMAT 79795 . 85486)) (85489 89632 (\TFBRAVO.ASSERT 85499 . 86029) (
\TEST.CHARACTER.LOOKS 86031 . 87917) (\TEST.PARAGRAPH.LOOKS 87919 . 89630)) (90642 97297 (
\TFBRAVO.ADD.NAMEDTAB 90652 . 94255) (\TFBRAVO.COPY.NAMEDTAB 94257 . 94705) (\TFBRAVO.PUT.NAMEDTAB
94707 . 94987) (\TFBRAVO.GET.NAMEDTAB 94989 . 95366) (\NAMEDTABNYET 95368 . 95528) (\NAMEDTABSIZE
95530 . 96045) (\NAMEDTABPREPRINT 96047 . 96245) (\TEDIT.NAMEDTAB.INIT 96247 . 97295)))))
(FILEMAP (NIL (7784 15335 (BRAVOFILEP 7794 . 9981) (TEDITFROMBRAVO 9983 . 15333)) (15610 32026 (
\TFBRAVO.GET.USER.CM 15620 . 18800) (\TFBRAVO.USER.CM.LOOKS 18802 . 20295) (\TFBRAVO.READ.USER.CM
20297 . 24920) (\TFBRAVO.INIT.PARALOOKS 24922 . 27139) (\TFBRAVO.INIT.PAGEFORMAT 27141 . 28021) (
\TFBRAVO.GETPARAMS 28023 . 30877) (\TFBRAVO.FIND.LAST.TRAILER 30879 . 32024)) (32068 52773 (
\TFBRAVO.PARSE.PARA 32078 . 36005) (\TFBRAVO.READ.PARALOOKS 36007 . 42897) (\TFBRAVO.CREATE.RUNS 42899
. 44287) (\TFBRAVO.READ.CHARLOOKS 44289 . 49318) (\TFBRAVO.FONT.FROM.CHARLOOKS 49320 . 50874) (
\TFBRAVO.READNUM? 50876 . 52771)) (52810 63851 (\TFBRAVO.HANDLE.HEADING 52820 . 55547) (
\TFBRAVO.PARSE.PROFILE.PARA 55549 . 63849)) (63894 86228 (\TFBRAVO.INSERT.PARA 63904 . 64745) (
\TFBRAVO.INSERT.RUN 64747 . 68238) (\TFBRAVO.SPLIT.PARA 68240 . 75664) (\TFBRAVO.RUN.TABSPEC 75666 .
80533) (\TFBRAVO.INSTALL.PAGEFORMAT 80535 . 86226)) (86229 90372 (\TFBRAVO.ASSERT 86239 . 86769) (
\TEST.CHARACTER.LOOKS 86771 . 88657) (\TEST.PARAGRAPH.LOOKS 88659 . 90370)) (91382 98037 (
\TFBRAVO.ADD.NAMEDTAB 91392 . 94995) (\TFBRAVO.COPY.NAMEDTAB 94997 . 95445) (\TFBRAVO.PUT.NAMEDTAB
95447 . 95727) (\TFBRAVO.GET.NAMEDTAB 95729 . 96106) (\NAMEDTABNYET 96108 . 96268) (\NAMEDTABSIZE
96270 . 96785) (\NAMEDTABPREPRINT 96787 . 96985) (\TEDIT.NAMEDTAB.INIT 96987 . 98035)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "15-Nov-2025 01:27:38" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;881 231034
(FILECREATED "24-Dec-2025 11:22:33" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;883 231422
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.WINDOW.CREATE)
:CHANGES-TO (FNS \TEDIT.MINIMAL.WINDOW.SETUP TEDIT.PROMPTCLEAR TEDIT.PROMPTPRINT)
:PREVIOUS-DATE "25-Oct-2025 10:33:08" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;878)
:PREVIOUS-DATE "15-Nov-2025 01:27:38" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;881)
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
@@ -608,7 +608,9 @@
(\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE])
(\TEDIT.MINIMAL.WINDOW.SETUP
[LAMBDA (PANEWINDOW TSTREAM PROPS) (* ; "Edited 19-Oct-2025 14:55 by rmk")
[LAMBDA (PANEWINDOW TSTREAM PROPS) (* ; "Edited 23-Dec-2025 23:41 by rmk")
(* ; "Edited 20-Dec-2025 23:04 by rmk")
(* ; "Edited 19-Oct-2025 14:55 by rmk")
(* ; "Edited 20-Apr-2025 15:19 by rmk")
(* ; "Edited 30-Nov-2024 13:32 by rmk")
(* ; "Edited 4-Nov-2024 19:46 by rmk")
@@ -687,8 +689,7 @@
(WINDOWPROP PANEWINDOW 'CURSOROUTFN (FUNCTION \TEDIT.CURSOROUTFN))
(WINDOWPROP PANEWINDOW 'BUTTONEVENTFN (FUNCTION \TEDIT.BUTTONEVENTFN))
(WINDOWPROP PANEWINDOW 'RIGHTBUTTONFN (FUNCTION \TEDIT.BUTTONEVENTFN))
(WINDOWPROP PANEWINDOW 'HARDCOPYFN (FUNCTION TEDIT.HARDCOPYFN))
(WINDOWPROP PANEWINDOW 'HARDCOPYFILEFN (FUNCTION \TEDIT.HARDCOPYFILEFN))
(WINDOWPROP PANEWINDOW 'IMAGETYPE 'TEDIT) (* ; "For hardcopy")
(WINDOWPROP PANEWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN))
(WINDOWPROP PANEWINDOW 'REPAINTFN (FUNCTION \TEDIT.REPAINTFN))
(WINDOWPROP PANEWINDOW 'AFTERMOVEFN (FUNCTION \TEDIT.AFTERMOVEFN))
@@ -2059,7 +2060,8 @@
PROMPTWINDOW])
(TEDIT.PROMPTPRINT
[LAMBDA (TEXTSTREAM MSG CLEAR? FLASH?) (* ; "Edited 29-Dec-2024 14:45 by rmk")
[LAMBDA (TSTREAM MSG CLEAR? FLASH?) (* ; "Edited 14-Dec-2025 17:41 by rmk")
(* ; "Edited 29-Dec-2024 14:45 by rmk")
(* ; "Edited 26-Nov-2023 10:10 by rmk")
(* ; "Edited 10-Sep-2023 00:27 by rmk")
(* ; "Edited 30-Jul-2023 08:52 by rmk")
@@ -2070,7 +2072,7 @@
(* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow). Optionally clear the window first.")
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM T))
(LET ((TEXTOBJ (TEXTOBJ TSTREAM T))
PWINDOW MAINWINDOW)
(if TEXTOBJ
then (CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ))
@@ -2078,7 +2080,7 @@
(CAR (NLSETQ (SELECTQ PWINDOW
(DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND)
(GETPROMPTWINDOW MAINWINDOW)))
(NIL (CL:WHEN TEXTSTREAM
(NIL (CL:WHEN TSTREAM
[GETPROMPTWINDOW MAINWINDOW NIL NIL
(NOT (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND]))
PWINDOW]) (* ;
@@ -2097,15 +2099,15 @@
else (PROMPTPRINT MSG])
(TEDIT.PROMPTCLEAR
[LAMBDA (TSTREAM FONT) (* ; "Edited 18-Sep-2025 23:08 by rmk")
[LAMBDA (TSTREAM FONT) (* ; "Edited 14-Dec-2025 17:34 by rmk")
(* ; "Edited 18-Sep-2025 23:08 by rmk")
(* ; "Edited 14-Mar-98 12:52 by rmk:")
(* ; "Edited 14-Oct-87 15:35 by bvm:")
(* ;; "Clears the promptwindow attached to TSTREAM and shrinks it back to a single line in font FONT (or TEDIT.PROMPT.FONT) if it has grown. [TSTREAM could actually be a stream on the promptwindow itself.--is that true, does this code need to deal with that?]")
(LET* [(MW (\TEDIT.MAINW TSTREAM))
(PW (AND MW (WINDOWPROP (\TEDIT.MAINW TSTREAM)
'TEDIT.PROMPTWINDOW]
(PW (AND MW (GETPROMPTWINDOW MW NIL NIL (NOT (GETTEXTPROP TSTREAM 'PWINDOW.ON.DEMAND]
(CL:WHEN PW
(WINDOWPROP PW 'TEDIT.NLINES 1)
(CL:WHEN [AND (SETQ MW (WINDOWPROP PW 'MAINWINDOW))
@@ -3662,36 +3664,36 @@
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
TEDIT.ICON.TITLE.REGION))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 45089 (\TEDIT.WINDOW.CREATE
18007 . 24870) (\TEDIT.WINDOW.GETREGION 24872 . 29576) (\TEDIT.WINDOW.SETUP 29578 . 33908) (
\TEDIT.MINIMAL.WINDOW.SETUP 33910 . 41721) (\TEDIT.CLEARPANE 41723 . 42440) (\TEDIT.FILL.PANES 42442
. 45087)) (45090 68791 (\TEDIT.CURSORMOVEDFN 45100 . 50710) (\TEDIT.CURSOROUTFN 50712 . 51400) (
\TEDIT.ACTIVE.WINDOWP 51402 . 52472) (\TEDIT.EXPANDFN 52474 . 53037) (\TEDIT.MAINW 53039 . 54319) (
\TEDIT.MAINSTREAM 54321 . 54655) (\TEDIT.PRIMARYPANE 54657 . 55427) (\TEDIT.PANELIST 55429 . 55925) (
\TEDIT.NEWREGIONFN 55927 . 58443) (\TEDIT.SET.WINDOW.EXTENT 58445 . 63427) (\TEDIT.SHRINK.ICONCREATE
63429 . 66162) (\TEDIT.SHRINKFN 66164 . 66573) (\TEDIT.PANEREGION 66575 . 68789)) (68823 101869 (
\TEDIT.BUTTONEVENTFN 68833 . 81806) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81808 . 89071) (
\TEDIT.BUTTONEVENTFN.GETOPERATION 89073 . 90915) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90917 . 94587) (
\TEDIT.BUTTONEVENTFN.INACTIVE 94589 . 97019) (\TEDIT.BUTTONEVENTFN.INTITLE 97021 . 98856) (
\TEDIT.COPYINSERTFN 98858 . 99990) (\TEDIT.FOREIGN.COPY 99992 . 101867)) (101870 119433 (
\TEDIT.PANE.SPLIT 101880 . 105828) (\TEDIT.SPLITW 105830 . 113889) (\TEDIT.UNSPLITW 113891 . 118090) (
\TEDIT.LINKPANES 118092 . 118855) (\TEDIT.UNLINKPANE 118857 . 119431)) (120867 121758 (TEDITWINDOWP
120877 . 121756)) (121795 124898 (TEDIT.GETINPUT 121805 . 124248) (\TEDIT.MAKEFILENAME 124250 . 124896
)) (124947 132597 (TEDIT.PROMPTWINDOW 124957 . 125271) (TEDIT.PROMPTPRINT 125273 . 127900) (
TEDIT.PROMPTCLEAR 127902 . 129644) (TEDIT.PROMPTFLASH 129646 . 130904) (\TEDIT.PROMPT.PAGEFULLFN
130906 . 132595)) (132835 143413 (\TEDIT.FILENAME 132845 . 133617) (\TEDIT.DEFAULT.TITLE 133619 .
135998) (\TEDIT.WINDOW.TITLE 136000 . 138169) (\TEDIT.LIKELY.FILENAME 138171 . 140895) (
\TEDIT.UPDATE.TITLE 140897 . 143411)) (143456 155940 (TEDIT.DEACTIVATE.WINDOW 143466 . 149039) (
\TEDIT.RESHAPEFN 149041 . 151126) (\TEDIT.REPAINTFN 151128 . 151352) (\TEDIT.CLOSESPLITS 151354 .
153799) (\TEDIT.CLOSEPANE 153801 . 155938)) (155941 198740 (\TEDIT.SCROLLFN 155951 . 158182) (
\TEDIT.SCROLLCH.TOP 158184 . 160295) (\TEDIT.SCROLLCH.BOTTOM 160297 . 164627) (\TEDIT.SCROLLUP 164629
. 170355) (\TEDIT.TOPLINE.YTOP 170357 . 172026) (\TEDIT.SCROLLDOWN 172028 . 179067) (
\TEDIT.SCROLL.CARET 179069 . 181907) (\TEDIT.VISIBLECARETP 181909 . 184203) (\TEDIT.VISIBLECHARP
184205 . 185296) (\TEDIT.BITMAPLINES 185298 . 189218) (\TEDIT.SETPANE.TOPLINE 189220 . 189832) (
\TEDIT.SHIFTLINES 189834 . 198738)) (198741 209610 (\TEDIT.ONSCREEN? 198751 . 203302) (
\TEDIT.ONSCREEN.REGION 203304 . 206955) (\TEDIT.AFTERMOVEFN 206957 . 207854) (OFFSCREENP 207856 .
209608)) (209652 212466 (\TEDIT.PROCIDLEFN 209662 . 211322) (\TEDIT.PROCENTRYFN 211324 . 211769) (
\TEDIT.PROCEXITFN 211771 . 212464)) (212545 225770 (\TEDIT.DOWNCARET 212555 . 213348) (
\TEDIT.FLASHCARET 213350 . 215461) (\TEDIT.UPCARET 215463 . 216567) (TEDIT.NORMALIZECARET 216569 .
219787) (\TEDIT.SETCARET 219789 . 225140) (\TEDIT.CARET 225142 . 225768)))))
(FILEMAP (NIL (17143 18039 (TEDIT.DEFER.UPDATES 17153 . 18037)) (18040 45281 (\TEDIT.WINDOW.CREATE
18050 . 24913) (\TEDIT.WINDOW.GETREGION 24915 . 29619) (\TEDIT.WINDOW.SETUP 29621 . 33951) (
\TEDIT.MINIMAL.WINDOW.SETUP 33953 . 41913) (\TEDIT.CLEARPANE 41915 . 42632) (\TEDIT.FILL.PANES 42634
. 45279)) (45282 68983 (\TEDIT.CURSORMOVEDFN 45292 . 50902) (\TEDIT.CURSOROUTFN 50904 . 51592) (
\TEDIT.ACTIVE.WINDOWP 51594 . 52664) (\TEDIT.EXPANDFN 52666 . 53229) (\TEDIT.MAINW 53231 . 54511) (
\TEDIT.MAINSTREAM 54513 . 54847) (\TEDIT.PRIMARYPANE 54849 . 55619) (\TEDIT.PANELIST 55621 . 56117) (
\TEDIT.NEWREGIONFN 56119 . 58635) (\TEDIT.SET.WINDOW.EXTENT 58637 . 63619) (\TEDIT.SHRINK.ICONCREATE
63621 . 66354) (\TEDIT.SHRINKFN 66356 . 66765) (\TEDIT.PANEREGION 66767 . 68981)) (69015 102061 (
\TEDIT.BUTTONEVENTFN 69025 . 81998) (\TEDIT.BUTTONEVENTFN.DOOPERATION 82000 . 89263) (
\TEDIT.BUTTONEVENTFN.GETOPERATION 89265 . 91107) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 91109 . 94779) (
\TEDIT.BUTTONEVENTFN.INACTIVE 94781 . 97211) (\TEDIT.BUTTONEVENTFN.INTITLE 97213 . 99048) (
\TEDIT.COPYINSERTFN 99050 . 100182) (\TEDIT.FOREIGN.COPY 100184 . 102059)) (102062 119625 (
\TEDIT.PANE.SPLIT 102072 . 106020) (\TEDIT.SPLITW 106022 . 114081) (\TEDIT.UNSPLITW 114083 . 118282) (
\TEDIT.LINKPANES 118284 . 119047) (\TEDIT.UNLINKPANE 119049 . 119623)) (121059 121950 (TEDITWINDOWP
121069 . 121948)) (121987 125090 (TEDIT.GETINPUT 121997 . 124440) (\TEDIT.MAKEFILENAME 124442 . 125088
)) (125139 132985 (TEDIT.PROMPTWINDOW 125149 . 125463) (TEDIT.PROMPTPRINT 125465 . 128195) (
TEDIT.PROMPTCLEAR 128197 . 130032) (TEDIT.PROMPTFLASH 130034 . 131292) (\TEDIT.PROMPT.PAGEFULLFN
131294 . 132983)) (133223 143801 (\TEDIT.FILENAME 133233 . 134005) (\TEDIT.DEFAULT.TITLE 134007 .
136386) (\TEDIT.WINDOW.TITLE 136388 . 138557) (\TEDIT.LIKELY.FILENAME 138559 . 141283) (
\TEDIT.UPDATE.TITLE 141285 . 143799)) (143844 156328 (TEDIT.DEACTIVATE.WINDOW 143854 . 149427) (
\TEDIT.RESHAPEFN 149429 . 151514) (\TEDIT.REPAINTFN 151516 . 151740) (\TEDIT.CLOSESPLITS 151742 .
154187) (\TEDIT.CLOSEPANE 154189 . 156326)) (156329 199128 (\TEDIT.SCROLLFN 156339 . 158570) (
\TEDIT.SCROLLCH.TOP 158572 . 160683) (\TEDIT.SCROLLCH.BOTTOM 160685 . 165015) (\TEDIT.SCROLLUP 165017
. 170743) (\TEDIT.TOPLINE.YTOP 170745 . 172414) (\TEDIT.SCROLLDOWN 172416 . 179455) (
\TEDIT.SCROLL.CARET 179457 . 182295) (\TEDIT.VISIBLECARETP 182297 . 184591) (\TEDIT.VISIBLECHARP
184593 . 185684) (\TEDIT.BITMAPLINES 185686 . 189606) (\TEDIT.SETPANE.TOPLINE 189608 . 190220) (
\TEDIT.SHIFTLINES 190222 . 199126)) (199129 209998 (\TEDIT.ONSCREEN? 199139 . 203690) (
\TEDIT.ONSCREEN.REGION 203692 . 207343) (\TEDIT.AFTERMOVEFN 207345 . 208242) (OFFSCREENP 208244 .
209996)) (210040 212854 (\TEDIT.PROCIDLEFN 210050 . 211710) (\TEDIT.PROCENTRYFN 211712 . 212157) (
\TEDIT.PROCEXITFN 212159 . 212852)) (212933 226158 (\TEDIT.DOWNCARET 212943 . 213736) (
\TEDIT.FLASHCARET 213738 . 215849) (\TEDIT.UPCARET 215851 . 216955) (TEDIT.NORMALIZECARET 216957 .
220175) (\TEDIT.SETCARET 220177 . 225528) (\TEDIT.CARET 225530 . 226156)))))
STOP

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Some files were not shown because too many files have changed in this diff Show More