Compare commits
12 Commits
medley-260
...
mth63--Mis
| Author | SHA1 | Date | |
|---|---|---|---|
|
a8a0313bd9 | ||
|
075ca1a9f1 | ||
|
|
69bb98c49a | ||
|
|
bb830e75f0 | ||
|
|
dc86cd8f80 | ||
|
03b59d5a33 | ||
|
03ca57d22a | ||
|
|
5fadc0f632 | ||
|
|
53b13dc8ed | ||
|
|
f937e2ca98 | ||
|
|
53d6387e93 | ||
|
de0ba95497 |
30
README.md
30
README.md
@@ -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
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "13-Oct-2025 16:52:28" {WMEDLEY}<internal>TEDIT-DEBUG.;175 138298
|
||||
(FILECREATED " 7-Feb-2026 17:00:39" {WMEDLEY}<internal>TEDIT-DEBUG.;178 138742
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS SP)
|
||||
:CHANGES-TO (FNS TEDIT-DEBUG)
|
||||
|
||||
:PREVIOUS-DATE "29-Jul-2025 11:42:21" {WMEDLEY}<internal>TEDIT-DEBUG.;174)
|
||||
:PREVIOUS-DATE " 7-Feb-2026 10:41:45" {WMEDLEY}<internal>TEDIT-DEBUG.;177)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-DEBUGCOMS)
|
||||
@@ -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 (5115 7674 (GTO 5125 . 5375) (GTS 5377 . 7148) (GTW 7150 . 7306) (GSEL 7308 . 7672)) (
|
||||
7707 8828 (TEST.TEMPLATE 7717 . 8826)) (8829 9764 (TESTACTION 8839 . 9762)) (9789 23604 (IPC 9799 .
|
||||
11303) (ILINES 11305 . 13846) (ISEL 13848 . 14459) (ITS 14461 . 16185) (IPANES 16187 . 16422) (ITL
|
||||
16424 . 16843) (IHIST 16845 . 19507) (IPCTB 19509 . 19935) (IMB 19937 . 20696) (ICL 20698 . 21399) (
|
||||
IPL 21401 . 21941) (ICARET 21943 . 22470) (INSPECTPIECES 22472 . 23602)) (23626 52365 (SP 23636 .
|
||||
28751) (SL 28753 . 32588) (SSP 32590 . 34292) (SPF 34294 . 36824) (SLF 36826 . 45959) (SHOWLINE 45961
|
||||
. 49523) (SLL 49525 . 50272) (STBYTES 50274 . 52000) (SSEL 52002 . 52363)) (52366 64879 (STL 52376 .
|
||||
61377) (CLEARTHISLINE 61379 . 61859) (CHARSLOTP 61861 . 63180) (\TLVALIDATE 63182 . 64877)) (64880
|
||||
70253 (NTHPIECE 64890 . 66022) (NPIECES 66024 . 66889) (NTHPIECECHAR 66891 . 68199) (SELPIECE 68201 .
|
||||
68643) (PIECENUM 68645 . 69364) (PCBYTES 69366 . 70251)) (70254 72728 (FILEBYTES 70264 . 71688) (
|
||||
TFILEBYTES 71690 . 72726)) (72729 74051 (TRELMOVE 72739 . 72982) (TSCROLL 72984 . 73150) (TSCROLL*
|
||||
73152 . 74049)) (74052 77101 (TRY 74062 . 75331) (TEDITCLOSEW 75333 . 75676) (PARALASTWITHOUTEOL 75678
|
||||
. 76563) (FIXPARALAST 76565 . 77099)) (77102 91989 (SPPRINT 77112 . 83937) (SPPRINT.CHAR 83939 .
|
||||
84923) (SPPRINT.OBJ 84925 . 87983) (SHOWPIECEBYTES 87985 . 89541) (CHECKPLENGTHS 89543 . 90000) (SBT
|
||||
90002 . 91139) (COPYPCHAIN 91141 . 91987)) (91990 94051 (POSLINE 92000 . 94049)) (94052 94935 (
|
||||
PRESPLIT 94062 . 94933)) (94936 96649 (ALLTL 94946 . 96199) (NTHCHARSLOT 96201 . 96647)) (96675 106888
|
||||
(PLCHAIN 96685 . 97213) (PRINTLINE 97215 . 100205) (SL.GETLINES 100207 . 103500) (CHECKLINES 103502
|
||||
. 104482) (COLLECTLINES 104484 . 104736) (NTHLINE 104738 . 105743) (HEIGHT 105745 . 106033) (LINEBOTS
|
||||
106035 . 106886)) (106889 109337 (IPC.DECODEARGS 106899 . 109335)) (109338 109931 (SPF1 109348 .
|
||||
109929)) (109960 112338 (SLF.FATPLEN 109970 . 110829) (FILEPIECE 110831 . 112336)) (112371 113139 (
|
||||
SELTEDIT 112381 . 113137)) (113209 118821 (PPARA 113219 . 113641) (PRUN 113643 . 115119) (
|
||||
ADDLINEPOSITIONS 115121 . 116548) (SBR 116550 . 117204) (SBC 117206 . 118819)) (118878 120654 (OLDWI
|
||||
118888 . 119263) (COMP 119265 . 119460) (DFR 119462 . 120652)) (120655 121688 (DFGV 120665 . 121191) (
|
||||
GDIRECTORIES 121193 . 121686)) (121689 128254 (TTEST 121699 . 126231) (LTEST 126233 . 127598) (THC
|
||||
127600 . 128252)) (128568 129260 (SHOWSAFE 128578 . 129258)) (129313 129760 (MYH 129323 . 129758)) (
|
||||
130005 131100 (DFVENUE 130015 . 130894) (VSEE 130896 . 131098)) (131101 131555 (PTT 131111 . 131553))
|
||||
(131914 133495 (DEBUGOUTPUT.STREAM 131924 . 133493)) (133496 135812 (TEDIT-DEBUG 133506 . 135810)) (
|
||||
135813 136305 (HEXTOHILO 135823 . 136163) (CW 136165 . 136303)) (136306 138042 (TRENAME 136316 .
|
||||
138040)))))
|
||||
(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.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "27-Dec-2025 15:02:04" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;24| 7235
|
||||
(FILECREATED "28-Jan-2026 14:30:48" |{DSK}<Users>larry>IL>medley>internal>loadups>LOADUP-LISP.;2| 7369
|
||||
|
||||
:EDIT-BY |rmk|
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-LISP)
|
||||
|
||||
:PREVIOUS-DATE "16-Oct-2025 16:55:27" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;22|)
|
||||
:PREVIOUS-DATE "27-Dec-2025 15:02:04"
|
||||
|{DSK}<Users>larry>IL>medley>internal>loadups>LOADUP-LISP.;1|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-LISPCOMS)
|
||||
@@ -19,7 +20,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(LOADUP-LISP
|
||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 27-Dec-2025 15:02 by rmk")
|
||||
(LAMBDA (DRIBBLEFILE) (* \; "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")
|
||||
@@ -71,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")
|
||||
|
||||
@@ -145,5 +147,5 @@
|
||||
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (640 7029 (LOADUP-LISP 650 . 7027)))))
|
||||
(FILEMAP (NIL (675 7163 (LOADUP-LISP 685 . 7161)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -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 " 8-Feb-2026 19:27:31" {DSK}<Users>larry>il>MEDLEY>LIBRARY>MASTERSCOPE.;3 197425
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS MSINTERPRET)
|
||||
:CHANGES-TO (FNS BUILDGETRELQ)
|
||||
|
||||
:PREVIOUS-DATE " 5-Apr-2025 11:49:04" {WMEDLEY}<library>MASTERSCOPE.;29)
|
||||
:PREVIOUS-DATE " 8-Feb-2026 18:47:30" {DSK}<Users>larry>il>MEDLEY>LIBRARY>MASTERSCOPE.;2)
|
||||
|
||||
|
||||
(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 " 8-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])
|
||||
)
|
||||
@@ -3742,36 +3724,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 (3300 19547 (UPDATEFN 3310 . 4927) (MSGETDEF 4929 . 6335) (MSNOTICEFILE 6337 . 8730) (
|
||||
MSSHOWUSE 8732 . 14713) (MSUPDATEFN1 14715 . 15403) (MSUPDATE 15405 . 17831) (MSNLAMBDACHECK 17833 .
|
||||
18715) (MSCOLLECTDATA 18717 . 19545)) (19548 20447 (UPDATECHANGED 19558 . 19921) (UPDATECHANGED1 19923
|
||||
. 20445)) (21021 21444 (MSCLOSEFILES 21031 . 21442)) (22125 26557 (MSDESCRIBE 22135 . 24923) (
|
||||
MSDESCRIBE1 24925 . 25988) (FMAPRINT 25990 . 26555)) (26650 27090 (MSPRINTHELPFILE 26660 . 27088)) (
|
||||
27140 30278 (TEMPLATE 27150 . 28571) (GETTEMPLATE 28573 . 28708) (SETTEMPLATE 28710 . 30276)) (31148
|
||||
36072 (ADDTEMPLATEWORD 31158 . 31830) (MSADDANALYZE 31832 . 33330) (MSADDMODIFIER 33332 . 34413) (
|
||||
MSADDRELATION 34415 . 35162) (MSADDTYPE 35164 . 36070)) (37573 42669 (MSMARKCHANGE1 37583 . 38377) (
|
||||
MSINIT 38379 . 39560) (GETVERBTABLES 39562 . 40115) (MSSTOREDATA 40117 . 41671) (STORETABLE 41673 .
|
||||
42667)) (44071 49141 (PARSERELATION 44081 . 44681) (PARSERELATION1 44683 . 46138) (GETRELATION 46140
|
||||
. 47169) (MAPRELATION 47171 . 48305) (TESTRELATION 48307 . 49139)) (49142 50782 (ADDHASH 49152 .
|
||||
49630) (SUBHASH 49632 . 49860) (MAKEHASH 49862 . 50006) (MSREHASH 50008 . 50461) (EQMEMBHASH 50463 .
|
||||
50780)) (51121 57437 (MSVBTABLES 51131 . 57011) (MSUSERVBTABLES 57013 . 57435)) (57520 59823 (
|
||||
BUILDGETRELQ 57530 . 58728) (BUILDTESTRELQ 58730 . 59821)) (59994 60382 (MSERASE 60004 . 60380)) (
|
||||
60383 64843 (DUMPDATABASE 60393 . 62958) (DUMPDATABASE1 62960 . 63305) (READATABASE 63307 . 64841)) (
|
||||
65925 94984 (MSCHECKBLOCKS 65935 . 69755) (MSCHECKBLOCK 69757 . 78377) (MSCHECKFNINBLOCK 78379 . 81379
|
||||
) (MSCHECKBLOCKBASIC 81381 . 83801) (MSCHECKBOUNDFREE 83803 . 85702) (GLOBALVARP 85704 . 85871) (
|
||||
PRINTERROR 85873 . 89089) (MSCHECKVARS1 89091 . 92044) (UNECCSPEC 92046 . 92324) (NECCSPEC 92326 .
|
||||
92673) (SPECVARP 92675 . 93202) (SHORTLST 93204 . 93660) (DOERROR 93662 . 94372) (MSMSGPRINT 94374 .
|
||||
94982)) (96128 110956 (MSPATHS 96138 . 99540) (MSPATHS1 99542 . 103777) (MSPATHS2 103779 . 107189) (
|
||||
MSONPATH 107191 . 108419) (MSPATHS4 108421 . 109503) (DASHES 109505 . 110031) (DOTABS 110033 . 110274)
|
||||
(BELOWMARKER 110276 . 110739) (MSPATHSPRINTFN 110741 . 110954)) (111342 114766 (MSFIND 111352 .
|
||||
111627) (MSEDITF 111629 . 112629) (MSEDITE 112631 . 113668) (EDITGETDEF 113670 . 114764)) (115708
|
||||
124309 (MSMARKCHANGED 115718 . 117442) (CHANGEMACRO 117444 . 118149) (CHANGEVAR 118151 . 118467) (
|
||||
CHANGEI.S. 118469 . 119802) (CHANGERECORD 119804 . 120675) (MSNEEDUNSAVE 120677 . 121669) (UNSAVEFNS
|
||||
121671 . 124307)) (124742 128352 (%. 124752 . 124892) (MASTERSCOPE 124894 . 125420) (MASTERSCOPE1
|
||||
125422 . 126290) (MASTERSCOPEXEC 126292 . 128350)) (128391 168041 (MSINTERPRETSET 128401 . 156935) (
|
||||
MSINTERPA 156937 . 157471) (MSGETBLOCKDEC 157473 . 159986) (LISTHARD 159988 . 161206) (MSMEMBSET
|
||||
161208 . 161353) (MSLISTSET 161355 . 161720) (MSHASHLIST 161722 . 161889) (MSHASHLIST1 161891 . 162217
|
||||
) (CHECKPATHS 162219 . 162859) (ONFILE 162861 . 168039)) (168042 191603 (MSINTERPRET 168052 . 184107)
|
||||
(VERBNOTICELIST 184109 . 185219) (MSOUTPUT 185221 . 186731) (MSCHECKEMPTY 186733 . 187937) (
|
||||
CHECKFORCHANGED 187939 . 188459) (MSSOLVE 188461 . 191601)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Jan-2026 17:57:49" {DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;4 258423
|
||||
(FILECREATED "12-Feb-2026 12:19:03" {DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;6 258522
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS POSTSCRIPT.STARTPAGE)
|
||||
:CHANGES-TO (FNS PSCFONT.READFONT)
|
||||
|
||||
:PREVIOUS-DATE "27-Jan-2026 13:15:17"
|
||||
{DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;3)
|
||||
:PREVIOUS-DATE "27-Jan-2026 17:57:49"
|
||||
{DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;5)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
|
||||
@@ -574,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))
|
||||
@@ -601,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
|
||||
@@ -4392,37 +4393,37 @@
|
||||
(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22370 32689 (POSTSCRIPT.INIT 22380 . 29295) (POSTSCRIPT.PUTRGBCOLOR 29297 . 30319) (
|
||||
\PSC.COLOR.TO.RGB 30321 . 32687)) (33675 69097 (PSCFONT.READFONT 33685 . 35593) (PSCFONT.SPELLFILE
|
||||
35595 . 36408) (PSCFONT.COERCEFILE 36410 . 37982) (PSCFONTFROMCACHE.SPELLFILE 37984 . 38969) (
|
||||
PSCFONTFROMCACHE.COERCEFILE 38971 . 40623) (PSCFONT.WRITEFONT 40625 . 41640) (READ-AFM-FILE 41642 .
|
||||
47513) (CONVERT-AFM-FILES 47515 . 48727) (POSTSCRIPT.GETFONTID 48729 . 50124) (POSTSCRIPT.FONTCREATE
|
||||
50126 . 63020) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63022 . 65419) (POSTSCRIPT.FONTSAVAILABLE 65421
|
||||
. 67708) (POSTSCRIPT.FONTEXISTS? 67710 . 69095)) (69098 79007 (OPENPOSTSCRIPTSTREAM 69108 . 78673) (
|
||||
CLOSEPOSTSCRIPTSTREAM 78675 . 79005)) (79052 85378 (POSTSCRIPT.HARDCOPYW 79062 . 82169) (
|
||||
POSTSCRIPT.TEDIT 82171 . 82623) (POSTSCRIPTFILEP 82625 . 84113) (MAKEEPSFILE 84115 . 85376)) (85379
|
||||
129123 (POSTSCRIPT.BITMAPSCALE 85389 . 87845) (POSTSCRIPT.CLOSESTRING 87847 . 88400) (
|
||||
POSTSCRIPT.ENDPAGE 88402 . 89293) (POSTSCRIPT.OUTSTR 89295 . 90512) (POSTSCRIPT.PUTBITMAPBYTES 90514
|
||||
. 98985) (POSTSCRIPT.PUTCOMMAND 98987 . 99976) (POSTSCRIPT.SET-FAKE-LANDSCAPE 99978 . 104498) (
|
||||
POSTSCRIPT.SHOWACCUM 104500 . 106655) (POSTSCRIPT.STARTPAGE 106657 . 109359) (\POSTSCRIPTTAB 109361 .
|
||||
110158) (\PS.BOUTFIXP 110160 . 111440) (\PS.SCALEHACK 111442 . 114085) (\PS.SCALEREGION 114087 .
|
||||
114647) (\SCALEDBITBLT.PSC 114649 . 118959) (\SETPOS.PSC 118961 . 119442) (\SETXFORM.PSC 119444 .
|
||||
122028) (\STRINGWIDTH.PSC 122030 . 122503) (\SWITCHFONTS.PSC 122505 . 127997) (\TERPRI.PSC 127999 .
|
||||
129121)) (129158 183014 (\BITBLT.PSC 129168 . 129720) (\BLTSHADE.PSC 129722 . 134383) (\CHARWIDTH.PSC
|
||||
134385 . 134892) (\CREATECHARSET.PSC 134894 . 136250) (\DRAWARC.PSC 136252 . 138630) (\DRAWCIRCLE.PSC
|
||||
138632 . 140883) (\DRAWCURVE.PSC 140885 . 144729) (\DRAWELLIPSE.PSC 144731 . 147095) (\DRAWLINE.PSC
|
||||
147097 . 149837) (\DRAWPOINT.PSC 149839 . 150415) (\DRAWPOLYGON.PSC 150417 . 153546) (
|
||||
\DSPBOTTOMMARGIN.PSC 153548 . 154235) (\DSPCLIPPINGREGION.PSC 154237 . 155612) (\DSPCOLOR.PSC 155614
|
||||
. 156545) (\DSPFONT.PSC 156547 . 160184) (\DSPLEFTMARGIN.PSC 160186 . 160872) (\DSPLINEFEED.PSC
|
||||
160874 . 161464) (\DSPPUSHSTATE.PSC 161466 . 162926) (\DSPPOPSTATE.PSC 162928 . 166413) (\DSPRESET.PSC
|
||||
166415 . 167080) (\DSPRIGHTMARGIN.PSC 167082 . 167771) (\DSPROTATE.PSC 167773 . 168772) (
|
||||
\DSPSCALE.PSC 168774 . 169726) (\DSPSCALE2.PSC 169728 . 170568) (\DSPSPACEFACTOR.PSC 170570 . 171491)
|
||||
(\DSPTOPMARGIN.PSC 171493 . 172064) (\DSPTRANSLATE.PSC 172066 . 174097) (\DSPXPOSITION.PSC 174099 .
|
||||
174663) (\DSPYPOSITION.PSC 174665 . 175256) (\FILLCIRCLE.PSC 175258 . 177483) (\FILLPOLYGON.PSC 177485
|
||||
. 180722) (\FIXLINELENGTH.PSC 180724 . 182043) (\MOVETO.PSC 182045 . 182815) (\NEWPAGE.PSC 182817 .
|
||||
183012)) (183070 205216 (\POSTSCRIPT.CHANGECHARSET 183080 . 183798) (\POSTSCRIPT.OUTCHARFN 183800 .
|
||||
196070) (\POSTSCRIPT.PRINTSLUG 196072 . 197796) (\POSTSCRIPT.SPECIALOUTCHARFN 197798 . 200149) (
|
||||
\UPDATE.PSC 200151 . 201397) (\POSTSCRIPT.ACCENTFN 201399 . 202341) (\POSTSCRIPT.ACCENTPAIR 202343 .
|
||||
205214)) (205314 206959 (\PSC.SPACEDISP 205324 . 205603) (\PSC.SPACEWID 205605 . 206224) (\PSC.SYMBOLS
|
||||
206226 . 206957)) (207068 210059 (\POSTSCRIPT.NSHASH 207078 . 210057)))))
|
||||
(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.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Dec-2025 22:45:39" {WMEDLEY}<library>TEDIT>TEDIT.;847 145111
|
||||
(FILECREATED " 4-Feb-2026 16:02:02" {WMEDLEY}<library>TEDIT>TEDIT.;852 146779
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDITCOMS)
|
||||
:CHANGES-TO (FNS TEDIT.MAP.OBJECTS TEDIT.PARAGRAPH.BOUNDARIES)
|
||||
(VARS TEDITCOMS)
|
||||
|
||||
:PREVIOUS-DATE "24-Dec-2025 11:23:12" {WMEDLEY}<library>TEDIT>TEDIT.;846)
|
||||
:PREVIOUS-DATE "31-Jan-2026 11:49:19" {WMEDLEY}<library>TEDIT>TEDIT.;849)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDITCOMS)
|
||||
@@ -47,7 +48,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)
|
||||
@@ -676,6 +677,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
|
||||
|
||||
@@ -912,7 +933,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")
|
||||
@@ -932,8 +954,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)
|
||||
@@ -1325,7 +1346,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")
|
||||
@@ -1385,7 +1408,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")
|
||||
@@ -1421,15 +1444,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))))
|
||||
@@ -1448,7 +1470,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")
|
||||
@@ -1497,8 +1520,7 @@
|
||||
(* ;; "")
|
||||
|
||||
(CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF)
|
||||
(\TEDIT.FOREIGN.COPY (WFROMDS TOTSTREAM)
|
||||
FROMSEL T)
|
||||
(\TEDIT.FOREIGN.COPY FROMSEL FROMTSTREAM T)
|
||||
(RETURN))
|
||||
|
||||
(* ;; "")
|
||||
@@ -2331,27 +2353,27 @@
|
||||
|
||||
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4840 7234 (MAKE-TEDIT-EXPORTS.ALL 4850 . 5396) (UPDATE-TEDIT 5398 . 6327) (EDIT-TEDIT
|
||||
6329 . 7232)) (8664 36442 (TEDIT 8674 . 11288) (TEXTSTREAM 11290 . 13179) (TEXTSTREAMP 13181 . 13565)
|
||||
(COERCETEXTSTREAM 13567 . 17778) (TEDIT.CONCAT 17780 . 21082) (TEDITSTRING 21084 . 21998) (TEDIT-SEE
|
||||
22000 . 22684) (TEDIT.COPY 22686 . 24831) (TEDIT.DELETE 24833 . 26194) (TEDIT.INSERT 26196 . 29165) (
|
||||
TEDIT.TERPRI 29167 . 30281) (TEDIT.KILL 30283 . 31265) (TEDIT.QUIT 31267 . 32633) (TEDIT.MOVE 32635 .
|
||||
33523) (TEDIT.STRINGWIDTH 33525 . 34196) (TEDIT.CHARWIDTH 34198 . 36440)) (36443 38384 (TEXTOBJ 36453
|
||||
. 36918) (COERCETEXTOBJ 36920 . 38382)) (39784 41434 (TDRIBBLE 39794 . 41432)) (41475 53371 (
|
||||
TEDIT.INSERT.OBJECT 41485 . 45192) (TEDIT.EDIT.OBJECT 45194 . 48134) (TEDIT.OBJECT.CHANGED 48136 .
|
||||
51326) (TEDIT.MAP.OBJECTS 51328 . 52899) (\TEDIT.FIRST.OBJPIECE 52901 . 53134) (\TEDIT.NEXT.OBJPIECE
|
||||
53136 . 53369)) (53394 60837 (\TEDIT.CONCAT.PAGEFRAMES 53404 . 58471) (\TEDIT.GET.PAGE.HEADINGS 58473
|
||||
. 59502) (\TEDIT.CONCAT.INSTALL.HEADINGS 59504 . 60835)) (60838 64445 (\TEDIT.MOVE.MSG 60848 . 62929)
|
||||
(\TEDIT.READONLY 62931 . 64443)) (64446 70337 (TEDIT.NCHARS 64456 . 64829) (TEDIT.RPLCHARCODE 64831
|
||||
. 67821) (TEDIT.NTHCHARCODE 67823 . 69866) (TEDIT.NTHCHAR 69868 . 70335)) (70383 127160 (\TEDIT1
|
||||
70393 . 72470) (\TEDIT.INSERT 72472 . 78585) (\TEDIT.MOVE 78587 . 86493) (\TEDIT.COPY 86495 . 91026) (
|
||||
\TEDIT.REPLACE.SELPIECES 91028 . 95564) (\TEDIT.INSERT.SELPIECES 95566 . 98563) (\TEDIT.RESTARTFN
|
||||
98565 . 101070) (\TEDIT.CHARDELETE 101072 . 104001) (\TEDIT.COPYPIECE 104003 . 109165) (
|
||||
\TEDIT.APPLY.OBJFN 109167 . 112253) (\TEDIT.DELETE 112255 . 116623) (\TEDIT.DIFFUSE.PARALOOKS 116625
|
||||
. 118896) (\TEDIT.WORDDELETE 118898 . 120513) (\TEDIT.WORDDELETE.FORWARD 120515 . 122304) (
|
||||
\TEDIT.FINISHEDIT? 122306 . 127158)) (127161 127820 (\TEDIT.THELP 127171 . 127818)) (127854 136985 (
|
||||
\TEDIT.PARAPIECES 127864 . 129838) (\TEDIT.PARACHNOS 129840 . 130732) (\TEDIT.PARA.FIRST 130734 .
|
||||
133835) (\TEDIT.PARA.LAST 133837 . 136983)) (136986 144081 (\TEDIT.WORD.FIRST 136996 . 141000) (
|
||||
\TEDIT.WORD.LAST 141002 . 144079)) (144282 144559 (TEDITSYSTEMDATE 144292 . 144557)) (144695 144902 (
|
||||
TEDIT.IMAGESOURCEP 144705 . 144900)))))
|
||||
(FILEMAP (NIL (4936 7330 (MAKE-TEDIT-EXPORTS.ALL 4946 . 5492) (UPDATE-TEDIT 5494 . 6423) (EDIT-TEDIT
|
||||
6425 . 7328)) (8760 37759 (TEDIT 8770 . 11384) (TEXTSTREAM 11386 . 13275) (TEXTSTREAMP 13277 . 13661)
|
||||
(COERCETEXTSTREAM 13663 . 17874) (TEDIT.CONCAT 17876 . 21178) (TEDITSTRING 21180 . 22094) (TEDIT-SEE
|
||||
22096 . 22780) (TEDIT.COPY 22782 . 24927) (TEDIT.DELETE 24929 . 26290) (TEDIT.INSERT 26292 . 29261) (
|
||||
TEDIT.TERPRI 29263 . 30377) (TEDIT.KILL 30379 . 31361) (TEDIT.QUIT 31363 . 32729) (TEDIT.MOVE 32731 .
|
||||
33619) (TEDIT.STRINGWIDTH 33621 . 34292) (TEDIT.CHARWIDTH 34294 . 36536) (TEDIT.PARAGRAPH.BOUNDARIES
|
||||
36538 . 37757)) (37760 39701 (TEXTOBJ 37770 . 38235) (COERCETEXTOBJ 38237 . 39699)) (41101 42751 (
|
||||
TDRIBBLE 41111 . 42749)) (42792 54772 (TEDIT.INSERT.OBJECT 42802 . 46509) (TEDIT.EDIT.OBJECT 46511 .
|
||||
49451) (TEDIT.OBJECT.CHANGED 49453 . 52643) (TEDIT.MAP.OBJECTS 52645 . 54300) (\TEDIT.FIRST.OBJPIECE
|
||||
54302 . 54535) (\TEDIT.NEXT.OBJPIECE 54537 . 54770)) (54795 62238 (\TEDIT.CONCAT.PAGEFRAMES 54805 .
|
||||
59872) (\TEDIT.GET.PAGE.HEADINGS 59874 . 60903) (\TEDIT.CONCAT.INSTALL.HEADINGS 60905 . 62236)) (62239
|
||||
65846 (\TEDIT.MOVE.MSG 62249 . 64330) (\TEDIT.READONLY 64332 . 65844)) (65847 71738 (TEDIT.NCHARS
|
||||
65857 . 66230) (TEDIT.RPLCHARCODE 66232 . 69222) (TEDIT.NTHCHARCODE 69224 . 71267) (TEDIT.NTHCHAR
|
||||
71269 . 71736)) (71784 128828 (\TEDIT1 71794 . 73871) (\TEDIT.INSERT 73873 . 79986) (\TEDIT.MOVE 79988
|
||||
. 88086) (\TEDIT.COPY 88088 . 92694) (\TEDIT.REPLACE.SELPIECES 92696 . 97232) (
|
||||
\TEDIT.INSERT.SELPIECES 97234 . 100231) (\TEDIT.RESTARTFN 100233 . 102738) (\TEDIT.CHARDELETE 102740
|
||||
. 105669) (\TEDIT.COPYPIECE 105671 . 110833) (\TEDIT.APPLY.OBJFN 110835 . 113921) (\TEDIT.DELETE
|
||||
113923 . 118291) (\TEDIT.DIFFUSE.PARALOOKS 118293 . 120564) (\TEDIT.WORDDELETE 120566 . 122181) (
|
||||
\TEDIT.WORDDELETE.FORWARD 122183 . 123972) (\TEDIT.FINISHEDIT? 123974 . 128826)) (128829 129488 (
|
||||
\TEDIT.THELP 128839 . 129486)) (129522 138653 (\TEDIT.PARAPIECES 129532 . 131506) (\TEDIT.PARACHNOS
|
||||
131508 . 132400) (\TEDIT.PARA.FIRST 132402 . 135503) (\TEDIT.PARA.LAST 135505 . 138651)) (138654
|
||||
145749 (\TEDIT.WORD.FIRST 138664 . 142668) (\TEDIT.WORD.LAST 142670 . 145747)) (145950 146227 (
|
||||
TEDITSYSTEMDATE 145960 . 146225)) (146363 146570 (TEDIT.IMAGESOURCEP 146373 . 146568)))))
|
||||
STOP
|
||||
|
||||
@@ -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.
@@ -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.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Oct-2025 08:49:06" {WMEDLEY}<library>tedit>TEDIT-FILE.;656 173140
|
||||
(FILECREATED " 7-Feb-2026 17:02:37" {WMEDLEY}<library>tedit>TEDIT-FILE.;657 173103
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8)
|
||||
:CHANGES-TO (FNS TEDITFROMLISPSOURCE)
|
||||
|
||||
:PREVIOUS-DATE "25-Sep-2025 21:32:46" {WMEDLEY}<library>tedit>TEDIT-FILE.;655)
|
||||
:PREVIOUS-DATE "23-Oct-2025 08:49:06" {WMEDLEY}<library>tedit>TEDIT-FILE.;656)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
||||
@@ -2625,7 +2625,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 +2659,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 +2691,28 @@
|
||||
|
||||
(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 (5304 35563 (TEDIT.GET 5314 . 11724) (TEDIT.FORMATTEDFILEP 11726 . 13042) (
|
||||
TEDIT.FILEDATE 13044 . 14353) (TEDIT.INCLUDE 14355 . 22384) (TEDIT.RAW.INCLUDE 22386 . 23194) (
|
||||
TEDIT.PUT 23196 . 31552) (TEDIT.PUT.STREAM 31554 . 35561)) (35564 56838 (\TEDIT.GET.FOREIGN.FILE 35574
|
||||
. 38999) (\TEDIT.GET.UNFORMATTED.FILE 39001 . 43307) (\TEDIT.GET.FORMATTED.FILE 43309 . 46952) (
|
||||
\TEDIT.FORMATTEDSTREAMP 46954 . 50085) (\ARBIN 50087 . 50807) (\ATMIN 50809 . 51346) (\DWIN 51348 .
|
||||
51727) (\STRINGIN 51729 . 52437) (\TEDIT.GET.TRAILER 52439 . 55307) (\TEDIT.CACHEFILE 55309 . 56836))
|
||||
(57004 73042 (\TEDIT.GET.PIECES3 57014 . 67977) (\TEDIT.GET.PROPS3 67979 . 71201) (
|
||||
\TEDIT.MAKE.STRINGPIECE 71203 . 73040)) (73043 86469 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73053 . 79286)
|
||||
(\TEDIT.INTERPRET.MCCS.SHIFTS 79288 . 85533) (\TEDIT.CONVERT.XCCSTOMCCS 85535 . 86467)) (86491 92736 (
|
||||
\TEDIT.GET.UNFORMATTED.FILE.UTF8 86501 . 92734)) (92759 104101 (\TEDIT.GET.CHARLOOKS.LIST 92769 .
|
||||
93500) (\TEDIT.GET.SINGLE.CHARLOOKS 93502 . 100574) (\TEDIT.GET.CHARLOOKS 100576 . 102132) (
|
||||
\TEDIT.GET.PARALOOKS.INDEX 102134 . 102678) (\TEDIT.GET.CHARLOOKS.INDEX 102680 . 104099)) (104102
|
||||
111759 (\TEDIT.GET.PARALOOKS.LIST 104112 . 104734) (\TEDIT.GET.SINGLE.PARALOOKS 104736 . 111757)) (
|
||||
111760 115593 (\TEDIT.GET.OBJECT 111770 . 115591)) (115658 148921 (\TEDIT.PUT.PCTB 115668 . 125575) (
|
||||
\TEDIT.PUT.PCTB.PIECEDATA 125577 . 128775) (\TEDIT.PUT.TRAILER 128777 . 130105) (
|
||||
\TEDIT.PUT.PCTB.MERGEABLE 130107 . 133880) (\TEDIT.PUT.UTF8.SPLITPIECES 133882 . 138584) (
|
||||
\TEDIT.PUT.PCTB.NEXTNEW 138586 . 143082) (\TEDIT.INSERT.NEWPIECES 143084 . 146519) (\TEDIT.PUTRESET
|
||||
146521 . 146763) (\ARBOUT 146765 . 147489) (\ATMOUT 147491 . 148096) (\DWOUT 148098 . 148377) (
|
||||
\STRINGOUT 148379 . 148919)) (148922 161656 (\TEDIT.PUT.CHARLOOKS.LIST 148932 . 150604) (
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS 150606 . 156886) (\TEDIT.PUT.CHARLOOKS 156888 . 158227) (
|
||||
\TEDIT.PUT.CHARLOOKS1 158229 . 159280) (\TEDIT.PUT.OBJECT 159282 . 161654)) (161657 169296 (
|
||||
\TEDIT.PUT.PARALOOKS.LIST 161667 . 162569) (\TEDIT.PUT.SINGLE.PARALOOKS 162571 . 168155) (
|
||||
\TEDIT.PUT.PARALOOKS 168157 . 169294)) (169391 172796 (TEDITFROMLISPSOURCE 169401 . 172045) (
|
||||
SHELLSCRIPTP 172047 . 172276) (TEDITFROMSHELLSCRIPT 172278 . 172794)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -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.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Dec-2025 16:32:32" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;460 155196
|
||||
(FILECREATED "10-Feb-2026 11:07:12" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;465 155591
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-LOOKSCOMS)
|
||||
:CHANGES-TO (FNS \TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.PARALOOKS)
|
||||
|
||||
:PREVIOUS-DATE " 6-Oct-2025 20:50:59" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;459)
|
||||
:PREVIOUS-DATE " 7-Dec-2025 16:32:32" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;460)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
|
||||
@@ -1377,7 +1377,8 @@
|
||||
(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")
|
||||
@@ -1403,10 +1404,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#)
|
||||
@@ -2103,7 +2106,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")
|
||||
@@ -2126,6 +2130,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)
|
||||
@@ -2458,26 +2465,26 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22014 23956 (\TEDIT.CHARLOOKS.DEFPRINT 22024 . 23160) (\TEDIT.PARALOOKS.DEFPRINT 23162
|
||||
. 23954)) (24060 24446 (\TEDIT.CREATE.FACE.MENU 24070 . 24242) (\TEDIT.CREATE.SIZE.MENU 24244 . 24444
|
||||
)) (25450 27339 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25460 . 27337)) (27611 52868 (
|
||||
\TEDIT.CHARLOOKS.FROM.FONT 27621 . 29905) (\TEDIT.EQCLOOKS 29907 . 32938) (\TEDIT.SAMECLOOKS 32940 .
|
||||
36111) (TEDIT.CARETLOOKS 36113 . 37659) (TEDIT.COPY.LOOKS 37661 . 40944) (
|
||||
\TEDIT.UNPARSE.CHARLOOKS.LIST 40946 . 44440) (\TEDIT.MODIFYLOOKS 44442 . 46602) (TEDIT.NEW.FONT 46604
|
||||
. 47051) (\TEDIT.CARETLOOKS.VERIFY 47053 . 47890) (\TEDIT.CARETPIECE 47892 . 48197) (
|
||||
\TEDIT.GET.INSERT.CHARLOOKS 48199 . 51246) (\TEDIT.GET.TERMSA.WIDTHS 51248 . 51664) (
|
||||
\TEDIT.PARSE.CHARLOOKS.LIST 51666 . 52866)) (52869 64996 (\TEDIT.MCCS.TRANSLATE 52879 . 58732) (
|
||||
\TEDIT.CONVERT.TO.FORMATTED 58734 . 64994)) (65868 73205 (\TEDIT.UNIQUIFY.CHARLOOKS 65878 . 67538) (
|
||||
\TEDIT.UNIQUIFY.PARALOOKS 67540 . 68807) (\TEDIT.UNIQUIFY.ALL 68809 . 70897) (
|
||||
\TEDIT.FLUSH.UNUSED.LOOKS 70899 . 73203)) (73238 85196 (TEDIT.LOOKS 73248 . 75637) (TEDIT.GET.LOOKS
|
||||
75639 . 77974) (TEDIT.SUBLOOKS 77976 . 82356) (TEDIT.FINDLOOKS 82358 . 85194)) (85197 114847 (
|
||||
\TEDIT.CHANGE.CHARLOOKS 85207 . 93985) (\TEDIT.CHANGE.CHARLOOKS.NEW 93987 . 97802) (
|
||||
\TEDIT.CHARLOOKS.CHANGE.FONT 97804 . 106111) (\TEDIT.FONT.NEXTSIZE 106113 . 107734) (\TEDIT.LOOKS
|
||||
107736 . 111065) (\TEDIT.FONTCOPY 111067 . 112568) (\TEDIT.COERCE.FONTCLASS 112570 . 113721) (
|
||||
\TEDIT.FONTCLASS.TO.FONT 113723 . 114845)) (114890 146538 (\TEDIT.EQFMTSPEC 114900 . 118115) (
|
||||
TEDIT.GET.PARALOOKS 118117 . 122164) (\TEDIT.PARSE.PARALOOKS.LIST 122166 . 130199) (TEDIT.PARALOOKS
|
||||
130201 . 131241) (\TEDIT.CHANGE.PARALOOKS 131243 . 138211) (\TEDIT.CHANGE.PARALOOKS.NEW 138213 .
|
||||
142196) (TEDIT.COPY.PARALOOKS 142198 . 144872) (\TEDIT.PARABOUNDS 144874 . 146536)) (146598 154314 (
|
||||
TEDIT.SUBPARALOOKS 146608 . 150710) (SAMEPARALOOKS 150712 . 154312)) (154315 155002 (
|
||||
\TEDIT.MARK.REVISION 154325 . 155000)))))
|
||||
(FILEMAP (NIL (22045 23987 (\TEDIT.CHARLOOKS.DEFPRINT 22055 . 23191) (\TEDIT.PARALOOKS.DEFPRINT 23193
|
||||
. 23985)) (24091 24477 (\TEDIT.CREATE.FACE.MENU 24101 . 24273) (\TEDIT.CREATE.SIZE.MENU 24275 . 24475
|
||||
)) (25481 27370 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25491 . 27368)) (27642 52899 (
|
||||
\TEDIT.CHARLOOKS.FROM.FONT 27652 . 29936) (\TEDIT.EQCLOOKS 29938 . 32969) (\TEDIT.SAMECLOOKS 32971 .
|
||||
36142) (TEDIT.CARETLOOKS 36144 . 37690) (TEDIT.COPY.LOOKS 37692 . 40975) (
|
||||
\TEDIT.UNPARSE.CHARLOOKS.LIST 40977 . 44471) (\TEDIT.MODIFYLOOKS 44473 . 46633) (TEDIT.NEW.FONT 46635
|
||||
. 47082) (\TEDIT.CARETLOOKS.VERIFY 47084 . 47921) (\TEDIT.CARETPIECE 47923 . 48228) (
|
||||
\TEDIT.GET.INSERT.CHARLOOKS 48230 . 51277) (\TEDIT.GET.TERMSA.WIDTHS 51279 . 51695) (
|
||||
\TEDIT.PARSE.CHARLOOKS.LIST 51697 . 52897)) (52900 65027 (\TEDIT.MCCS.TRANSLATE 52910 . 58763) (
|
||||
\TEDIT.CONVERT.TO.FORMATTED 58765 . 65025)) (65899 73236 (\TEDIT.UNIQUIFY.CHARLOOKS 65909 . 67569) (
|
||||
\TEDIT.UNIQUIFY.PARALOOKS 67571 . 68838) (\TEDIT.UNIQUIFY.ALL 68840 . 70928) (
|
||||
\TEDIT.FLUSH.UNUSED.LOOKS 70930 . 73234)) (73269 85227 (TEDIT.LOOKS 73279 . 75668) (TEDIT.GET.LOOKS
|
||||
75670 . 78005) (TEDIT.SUBLOOKS 78007 . 82387) (TEDIT.FINDLOOKS 82389 . 85225)) (85228 115001 (
|
||||
\TEDIT.CHANGE.CHARLOOKS 85238 . 94139) (\TEDIT.CHANGE.CHARLOOKS.NEW 94141 . 97956) (
|
||||
\TEDIT.CHARLOOKS.CHANGE.FONT 97958 . 106265) (\TEDIT.FONT.NEXTSIZE 106267 . 107888) (\TEDIT.LOOKS
|
||||
107890 . 111219) (\TEDIT.FONTCOPY 111221 . 112722) (\TEDIT.COERCE.FONTCLASS 112724 . 113875) (
|
||||
\TEDIT.FONTCLASS.TO.FONT 113877 . 114999)) (115044 146933 (\TEDIT.EQFMTSPEC 115054 . 118269) (
|
||||
TEDIT.GET.PARALOOKS 118271 . 122318) (\TEDIT.PARSE.PARALOOKS.LIST 122320 . 130353) (TEDIT.PARALOOKS
|
||||
130355 . 131395) (\TEDIT.CHANGE.PARALOOKS 131397 . 138606) (\TEDIT.CHANGE.PARALOOKS.NEW 138608 .
|
||||
142591) (TEDIT.COPY.PARALOOKS 142593 . 145267) (\TEDIT.PARABOUNDS 145269 . 146931)) (146993 154709 (
|
||||
TEDIT.SUBPARALOOKS 147003 . 151105) (SAMEPARALOOKS 151107 . 154707)) (154710 155397 (
|
||||
\TEDIT.MARK.REVISION 154720 . 155395)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "12-Dec-2025 00:01:26" {WMEDLEY}<library>tedit>TEDIT-MENU.;501 183343
|
||||
(FILECREATED " 9-Feb-2026 09:10:43" {WMEDLEY}<library>tedit>TEDIT-MENU.;510 183027
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-MENUCOMS)
|
||||
:CHANGES-TO (FNS \TEDIT.PAGEMENU.CREATE)
|
||||
|
||||
:PREVIOUS-DATE " 7-Dec-2025 16:34:30" {WMEDLEY}<library>tedit>TEDIT-MENU.;499)
|
||||
:PREVIOUS-DATE "27-Jan-2026 10:42:09" {WMEDLEY}<library>tedit>TEDIT-MENU.;508)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-MENUCOMS)
|
||||
@@ -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))))])
|
||||
)
|
||||
|
||||
|
||||
@@ -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 (4929 16567 (TEDIT.ADD.MENUITEM 4939 . 7056) (TEDIT.DEFAULT.MENUFN 7058 . 13779) (
|
||||
TEDIT.REMOVE.MENUITEM 13781 . 14778) (\TEDIT.CREATEMENU 14780 . 15345) (\TEDIT.MENU.WHENHELDFN 15347
|
||||
. 16252) (\TEDIT.MENU.WHENSELECTEDFN 16254 . 16565)) (17381 65416 (DRAWMARGINSCALE 17391 . 20850) (
|
||||
MARGINBAR 20852 . 27977) (MARGINBAR.CREATE 27979 . 32177) (MB.MARGINBAR.BUTTONEVENTINFN 32179 . 39981)
|
||||
(MB.MARGINBAR.SELFN.TABS 39983 . 45223) (MB.MARGINBAR.SELFN.TABS.KIND 45225 . 46160) (
|
||||
MARGINBAR.GETSTATEFN 46162 . 50149) (MARGINBAR.SETSTATEFN 50151 . 50361) (MARGINBAR.NEUTRALIZE 50363
|
||||
. 51038) (MARGINBAR.LOOKS 51040 . 54146) (MB.MARGINBAR.SIZEFN 54148 . 54934) (MB.MARGINBAR.DISPLAYFN
|
||||
54936 . 57997) (MDESCALE 57999 . 58539) (MSCALE 58541 . 58871) (MB.MARGINBAR.SHOWTAB 58873 . 61196) (
|
||||
MB.MARGINBAR.TABTRACK 61198 . 62583) (MARGINBAR.INIT 62585 . 63978) (\TEDIT.PARALOOKS.TO.MARBAR 63980
|
||||
. 65414)) (66241 73523 (TEDIT.MENUSTREAM 66251 . 67251) (TEDITMENUP 67253 . 68222) (\TEDIT.MENU.START
|
||||
68224 . 72571) (\TEDIT.MENU.OPEN? 72573 . 72947) (\TEDIT.MENU.BUTTONEVENTFN 72949 . 73521)) (73842
|
||||
81893 (\TEDIT.MENU.CREATE 73852 . 75792) (\TEDIT.MENU.PARSE 75794 . 79483) (\TEDIT.MENU.NEUTRALIZE
|
||||
79485 . 81556) (\TEDITMENU.RECORD.UNFORMATTED 81558 . 81891)) (81959 101740 (
|
||||
\TEDIT.EXPANDEDMENU.CREATE 81969 . 87436) (\TEDIT.EXPANDEDMENU.START 87438 . 89062) (
|
||||
\TEDIT.EXPANDEDMENU.FN 89064 . 92319) (\TEDIT.EXPANDEDMENU.ACTIONFN 92321 . 101738)) (101802 121227 (
|
||||
\TEDIT.PARAMENU.CREATE 101812 . 110543) (\TEDIT.PARAMENU.START 110545 . 111799) (
|
||||
\TEDIT.APPLY.PARALOOKS 111801 . 112853) (\TEDIT.SHOW.PARALOOKS 112855 . 115572) (
|
||||
\TEDIT.PARAMENU.FILLIN 115574 . 120323) (\TEDIT.PARAMENU.RESHAPEFN 120325 . 121225)) (121421 148263 (
|
||||
\TEDIT.CHARMENU.CREATE 121431 . 124035) (\TEDIT.CHARMENU.START 124037 . 125327) (\TEDIT.CHARMENU.SPEC
|
||||
125329 . 130012) (\TEDIT.CHARMENU.PARSE 130014 . 133182) (\TEDIT.CHARMENU.FILLIN 133184 . 137814) (
|
||||
\TEDIT.SHOW.CHARLOOKS 137816 . 141361) (\TEDIT.APPLY.CHARLOOKS 141363 . 142524) (
|
||||
\TEDIT.OFFSETTYPE.STATEFN 142526 . 144489) (\TEDIT.OTHER.STATECHANGEFN 144491 . 146136) (
|
||||
\TEDIT.OTHER.SELECTFN 146138 . 148261)) (148325 177383 (\TEDIT.PAGEMENU.CREATE 148335 . 156847) (
|
||||
\TEDIT.PAGEMENU.START 156849 . 157200) (\TEDIT.SHOW.PAGELOOKS 157202 . 159088) (\TEDIT.PAGEMENU.FILLIN
|
||||
159090 . 160640) (\TEDIT.PAGEREGION.UNPARSE 160642 . 170041) (\TEDIT.APPLY.PAGELOOKS 170043 . 171970)
|
||||
(\TEDIT.CHANGE.PAGELOOKS 171972 . 176539) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176541 . 177381)) (
|
||||
177384 183187 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177394 . 180206) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN
|
||||
180208 . 181633) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181635 . 183185)))))
|
||||
(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.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Jan-2026 12:00:08" {WMEDLEY}<library>tedit>TEDIT-PAGE.;241 130528
|
||||
(FILECREATED "27-Jan-2026 10:30:27" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;243 130855
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.TO.IMAGEFILE)
|
||||
:CHANGES-TO (FNS TEDIT.SINGLE.PAGEFORMAT)
|
||||
(VARS TEDIT-PAGECOMS)
|
||||
|
||||
:PREVIOUS-DATE "15-Jan-2026 10:48:30" {WMEDLEY}<library>tedit>TEDIT-PAGE.;240)
|
||||
:PREVIOUS-DATE "17-Jan-2026 12:00:08" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;241)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PAGECOMS)
|
||||
@@ -51,6 +52,7 @@
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72
|
||||
72 72 NIL 1]
|
||||
(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?")
|
||||
|
||||
@@ -730,6 +734,8 @@
|
||||
(RETURN (CLOSEF IMAGESTREAM))))])
|
||||
)
|
||||
|
||||
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE))
|
||||
|
||||
|
||||
|
||||
(* ;; "Perform page layout, based on a regular expression of typed regions.")
|
||||
@@ -2056,18 +2062,18 @@
|
||||
(RETURN (DREMOVE NIL $$VAL])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (12133 15745 (\TEDIT.PARSE.PAGEFRAMES 12143 . 13922) (\TEDIT.PUT.PAGEFRAMES 13924 .
|
||||
14748) (\TEDIT.UNPARSE.PAGEFRAMES 14750 . 15743)) (15808 37825 (TEDIT.SINGLE.PAGEFORMAT 15818 . 26811)
|
||||
(TEDIT.COMPOUND.PAGEFORMAT 26813 . 27792) (TEDIT.PAGEFORMAT 27794 . 35083) (TEDIT.GET.PAGEFORMAT
|
||||
35085 . 37823)) (38112 44592 (TEDIT.TO.IMAGEFILE 38122 . 44590)) (44679 97931 (\TEDIT.FORMATBOX 44689
|
||||
. 58113) (\TEDIT.FORMATHEADING 58115 . 62761) (\TEDIT.FORMATPAGE 62763 . 71952) (\TEDIT.FORMATTEXTBOX
|
||||
71954 . 88467) (\TEDIT.FORMATFOLIO 88469 . 93786) (\TEDIT.FORMAT.FOUNDBOX? 93788 . 95827) (
|
||||
\TEDIT.SKIP.SPECIALCOND 95829 . 97929)) (98011 103066 (\TEDIT.HARDCOPY.PAGEHEADINGS 98021 . 103064)) (
|
||||
103175 111226 (\TEDIT.HARDCOPY-COLUMN-END 103185 . 111224)) (111271 116212 (SCALEPAGEUNITS 111281 .
|
||||
112422) (SCALEPAGEXUNITS 112424 . 113194) (SCALEPAGEYUNITS 113196 . 113967) (\TEDIT.PAPERHEIGHT 113969
|
||||
. 114904) (\TEDIT.PAPERWIDTH 114906 . 116210)) (116628 120196 (ROMANNUMERALS 116638 . 120194)) (
|
||||
120235 127501 (TEDIT.PAGENO.CREATE 120245 . 120621) (\TEDIT.PAGENO.OBJINIT 120623 . 121906) (
|
||||
\TEDIT.PAGENO.BUTTONEVENTINFN 121908 . 122974) (\TEDIT.PAGENO.IMAGEBOXFN 122976 . 125126) (
|
||||
\TEDIT.PAGENO.DISPLAYFN 125128 . 126778) (\TEDIT.PAGENO.GETFN 126780 . 127172) (\TEDIT.PAGENO.PUTFN
|
||||
127174 . 127499)) (127566 130505 (\TEDIT.FORMAT.FOOTNOTE 127576 . 130503)))))
|
||||
(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.
@@ -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.
@@ -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 "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;736 162073
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.FIND.PROTECTED.START \TEDIT.FIND.PROTECTED.END)
|
||||
:CHANGES-TO (FNS \TEDIT.COPYSEL TEDIT.SELPROP)
|
||||
|
||||
:PREVIOUS-DATE "28-Jul-2025 23:50:43" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;730)
|
||||
:PREVIOUS-DATE "10-Jan-2026 12:33:26" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;735)
|
||||
|
||||
|
||||
(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]
|
||||
@@ -2237,7 +2248,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 +2289,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 +2309,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 +2570,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 (15886 17707 (\TEDIT.SELECTION.DEFPRINT 15896 . 17705)) (17744 19249 (
|
||||
\TEDIT.SET.GLOBAL.SELECTIONS 17754 . 19247)) (19250 25471 (\TEDIT.SELECTED.PIECES 19260 . 20899) (
|
||||
\TEDIT.FIND.PROTECTED.END 20901 . 22695) (\TEDIT.FIND.PROTECTED.START 22697 . 24680) (
|
||||
\TEDIT.WORD.BOUND 24682 . 25469)) (25605 59712 (\TEDIT.EXTEND.SEL 25615 . 32855) (\TEDIT.SCAN.LINE
|
||||
32857 . 44530) (\TEDIT.SCAN.LINE.WORD 44532 . 49525) (\TEDIT.XYTOSEL 49527 . 56865) (\TEDIT.REGIONTYPE
|
||||
56867 . 57886) (\TEDIT.XYTOSEL.INLINEP 57888 . 58343) (\TEDIT.XYTOSEL.LINE 58345 . 59710)) (59713
|
||||
73258 (\TEDIT.FIXSEL 59723 . 69100) (\TEDIT.CHTOLINEX 69102 . 73256)) (73259 77463 (
|
||||
\TEDIT.RESET.EXTEND.PENDING.DELETE 73269 . 74547) (\TEDIT.SET.SEL.LOOKS 74549 . 77461)) (78400 99553 (
|
||||
\TEDIT.SHOWSEL 78410 . 83386) (\TEDIT.NOSEL 83388 . 83689) (\TEDIT.SEL.OFF 83691 . 84102) (
|
||||
\TEDIT.SEL.ON 84104 . 84520) (\TEDIT.SHOWSEL.HILIGHT 84522 . 89143) (\TEDIT.UPDATE.SEL 89145 . 93747)
|
||||
(\TEDIT.CARETLINE 93749 . 94463) (\TEDIT.SEL.L1 94465 . 95148) (\TEDIT.SEL.LN 95150 . 95833) (
|
||||
\TEDIT.SEL.DELETEDCHARS 95835 . 99551)) (99554 104436 (\TEDIT.COPYSEL 99564 . 102206) (
|
||||
\TEDIT.SEL.CHANGED? 102208 . 104434)) (104467 118126 (\TEDIT.SELECT.OBJECT 104477 . 109430) (
|
||||
\TEDIT.SHOWSEL.OBJECT 109432 . 111663) (\TEDIT.CLIP.OBJECT 111665 . 113669) (\TEDIT.OPERATE.OBJECT
|
||||
113671 . 118124)) (118154 137903 (\TEDIT.SELPIECES 118164 . 122445) (\TEDIT.SELPIECES.COPY 122447 .
|
||||
124936) (\TEDIT.SELPIECES.CONCAT 124938 . 126817) (\TEDIT.SELPIECES.CHARTRANSFORM 126819 . 130278) (
|
||||
\TEDIT.SELPIECES.FROM.STRING 130280 . 135538) (\TEDIT.SELPIECES.TO.STRING 135540 . 137901)) (137956
|
||||
161904 (TEDIT.XYTOCH 137966 . 140542) (TEDIT.SELPROP 140544 . 144821) (TEDIT.GETPOINT 144823 . 146743)
|
||||
(TEDIT.GETSEL 146745 . 147621) (TEDIT.GETSEL.PARA 147623 . 148572) (TEDIT.SCANSEL 148574 . 149522) (
|
||||
TEDIT.SET.SEL.LOOKS 149524 . 151009) (TEDIT.SETSEL 151011 . 155929) (TEDIT.SHOWSEL 155931 . 157795) (
|
||||
TEDIT.SEL.AS.STRING 157797 . 160282) (TEDIT.SEL.AS.SEXPR 160284 . 161570) (TEDIT.SELECTALL 161572 .
|
||||
161902)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Dec-2025 17:50:45" {WMEDLEY}<library>tedit>TEDIT-STREAM.;930 194007
|
||||
(FILECREATED "26-Jan-2026 23:58:48" {WMEDLEY}<library>tedit>TEDIT-STREAM.;936 194450
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS OPENTEXTSTREAM \TEDIT.OPENTEXTFILE)
|
||||
:CHANGES-TO (VARS TEDIT-STREAMCOMS)
|
||||
(FNS TEDIT.IMAGESTREAM.OPEN \TEDIT.STREAMINIT \TEDIT.TEXTINIT)
|
||||
|
||||
:PREVIOUS-DATE "19-Oct-2025 15:09:09" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;927)
|
||||
:PREVIOUS-DATE "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-STREAM.;933)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
|
||||
@@ -43,7 +44,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:")
|
||||
|
||||
@@ -83,7 +86,7 @@
|
||||
(ADDVARS (INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES
|
||||
\TEDIT.TEXTOBJ.PROPFETCHFN
|
||||
\TEDIT.TEXTOBJ.PROPSTOREFN]
|
||||
(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])
|
||||
@@ -158,8 +161,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 (* ;
|
||||
@@ -1519,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")
|
||||
@@ -1562,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 (* ;
|
||||
@@ -1751,9 +1756,12 @@
|
||||
(* ;; "Return the new value for the stream:")
|
||||
|
||||
NEWSTREAM])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.TEXTINIT
|
||||
[LAMBDA NIL (* ; "Edited 23-Sep-2025 21:03 by rmk")
|
||||
(\TEDIT.STREAMINIT
|
||||
[LAMBDA NIL (* ; "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")
|
||||
@@ -1807,14 +1815,6 @@
|
||||
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)
|
||||
@@ -1881,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:")
|
||||
@@ -3140,7 +3147,7 @@
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(\TEDIT.TEXTINIT)
|
||||
(\TEDIT.STREAMINIT)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
@@ -3151,34 +3158,34 @@
|
||||
(ADDTOVAR LAMA TEXTPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (36705 67564 (\TEDIT.TEXTBIN 36715 . 47508) (\TEDIT.TEXTPEEKBIN 47510 . 53060) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53062 . 58735) (\TEDIT.TEXTBOUT 58737 . 63354) (\TEDIT.INSTALL.FILEBUFFER 63356
|
||||
. 67562)) (68462 72753 (\TEDIT.TEXTOUTCHARFN 68472 . 70028) (\TEDIT.TEXTINCCODEFN 70030 . 70769) (
|
||||
\TEDIT.TEXTBACKCCODEFN 70771 . 71363) (\TEDIT.TEXTFORMATBYTESTREAM 71365 . 72202) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 72204 . 72751)) (72800 84875 (OPENTEXTSTREAM 72810 . 79786) (
|
||||
COPYTEXTSTREAM 79788 . 84098) (TEDIT.STREAMCHANGEDP 84100 . 84402) (TXTFILE 84404 . 84873)) (84876
|
||||
116145 (\TEDIT.REOPENTEXTSTREAM 84886 . 86238) (\TEDIT.OPENTEXTSTREAM.PIECES 86240 . 91168) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 91170 . 92272) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92274 . 97515) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 97517 . 100308) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100310 . 102249) (
|
||||
\TEDIT.OPENTEXTFILE 102251 . 104383) (\TEDIT.CREATE.TEXTSTREAM 104385 . 105532) (\TEDIT.REOPEN.STREAM
|
||||
105534 . 107870) (\TEDIT.TEXTINIT 107872 . 116143)) (116183 117371 (\TEDIT.TTYBOUT 116193 . 117369)) (
|
||||
117489 139172 (\TEDIT.TEXTCLOSEF 117499 . 118823) (\TEDIT.TEXTDSPFONT 118825 . 120023) (
|
||||
\TEDIT.TEXTEOFP 120025 . 121780) (\TEDIT.TEXTGETEOFPTR 121782 . 122105) (\TEDIT.TEXTSETEOFPTR 122107
|
||||
. 123394) (\TEDIT.TEXTGETFILEPTR 123396 . 126231) (\TEDIT.TEXTSETFILEINFO 126233 . 126741) (
|
||||
\TEDIT.TEXTOPENF 126743 . 127674) (\TEDIT.TEXTSETEOF 127676 . 128292) (\TEDIT.TEXTSETFILEPTR 128294 .
|
||||
130404) (\TEDIT.TEXTDSPXPOSITION 130406 . 133109) (\TEDIT.TEXTDSPYPOSITION 133111 . 133852) (
|
||||
\TEDIT.TEXTLEFTMARGIN 133854 . 134445) (\TEDIT.TEXTCOLOR 134447 . 135030) (\TEDIT.TEXTRIGHTMARGIN
|
||||
135032 . 138321) (\TEDIT.TEXTDSPCHARWIDTH 138323 . 138627) (\TEDIT.TEXTDSPSTRINGWIDTH 138629 . 138935)
|
||||
(\TEDIT.TEXTDSPLINEFEED 138937 . 139170)) (139210 151823 (\TEDIT.NTHCHARCODE 139220 . 140671) (
|
||||
\TEDIT.PIECE.NTHCHARCODE 140673 . 144583) (\TEDIT.RPLCHARCODE 144585 . 146043) (
|
||||
\TEDIT.PIECE.RPLCHARCODE 146045 . 151468) (\TEDIT.NTHCHARLOOKS 151470 . 151821)) (152870 173964 (
|
||||
\TEDIT.DELETE.SELPIECES 152880 . 156505) (\TEDIT.INSERTCH 156507 . 164546) (\TEDIT.INSERTCH.HISTORY
|
||||
164548 . 168012) (\TEDIT.INSERTEOL 168014 . 169839) (\TEDIT.INSERTCH.INSERTION 169841 . 172678) (
|
||||
\TEDIT.INSERTCH.EXTEND 172680 . 173962)) (173965 175469 (\TEDIT.NEXTCHANGEABLE.CHNO 173975 . 174690) (
|
||||
\TEDIT.LASTCHANGEABLE.CHNO 174692 . 175467)) (175470 177174 (\SETUPGETCH 175480 . 177172)) (177232
|
||||
181690 (\TEDIT.INSTALL.PIECE 177242 . 181688)) (181728 191194 (TEXTPROP 181738 . 182085) (GETTEXTPROP
|
||||
182087 . 182331) (PUTTEXTPROP 182333 . 182590) (GETTEXTPROPS 182592 . 183036) (PUTTEXTPROPS 183038 .
|
||||
183942) (TEXTPROP.ADD 183944 . 184207) (\TEDIT.TEXTPROP 184209 . 191192)) (191195 193572 (
|
||||
\TEDIT.TEXTOBJ.PROPNAMES 191205 . 192464) (\TEDIT.TEXTOBJ.PROPFETCHFN 192466 . 192982) (
|
||||
\TEDIT.TEXTOBJ.PROPSTOREFN 192984 . 193570)))))
|
||||
(FILEMAP (NIL (36872 67731 (\TEDIT.TEXTBIN 36882 . 47675) (\TEDIT.TEXTPEEKBIN 47677 . 53227) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53229 . 58902) (\TEDIT.TEXTBOUT 58904 . 63521) (\TEDIT.INSTALL.FILEBUFFER 63523
|
||||
. 67729)) (68629 72920 (\TEDIT.TEXTOUTCHARFN 68639 . 70195) (\TEDIT.TEXTINCCODEFN 70197 . 70936) (
|
||||
\TEDIT.TEXTBACKCCODEFN 70938 . 71530) (\TEDIT.TEXTFORMATBYTESTREAM 71532 . 72369) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 72371 . 72918)) (72967 85042 (OPENTEXTSTREAM 72977 . 79953) (
|
||||
COPYTEXTSTREAM 79955 . 84265) (TEDIT.STREAMCHANGEDP 84267 . 84569) (TXTFILE 84571 . 85040)) (85043
|
||||
108248 (\TEDIT.REOPENTEXTSTREAM 85053 . 86405) (\TEDIT.OPENTEXTSTREAM.PIECES 86407 . 91335) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 91337 . 92439) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92441 . 97891) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 97893 . 100684) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100686 . 102625) (
|
||||
\TEDIT.OPENTEXTFILE 102627 . 104759) (\TEDIT.CREATE.TEXTSTREAM 104761 . 105908) (\TEDIT.REOPEN.STREAM
|
||||
105910 . 108246)) (108249 116436 (\TEDIT.STREAMINIT 108259 . 116253) (TEDIT.IMAGESTREAM.OPEN 116255 .
|
||||
116434)) (116624 117812 (\TEDIT.TTYBOUT 116634 . 117810)) (117930 139613 (\TEDIT.TEXTCLOSEF 117940 .
|
||||
119264) (\TEDIT.TEXTDSPFONT 119266 . 120464) (\TEDIT.TEXTEOFP 120466 . 122221) (\TEDIT.TEXTGETEOFPTR
|
||||
122223 . 122546) (\TEDIT.TEXTSETEOFPTR 122548 . 123835) (\TEDIT.TEXTGETFILEPTR 123837 . 126672) (
|
||||
\TEDIT.TEXTSETFILEINFO 126674 . 127182) (\TEDIT.TEXTOPENF 127184 . 128115) (\TEDIT.TEXTSETEOF 128117
|
||||
. 128733) (\TEDIT.TEXTSETFILEPTR 128735 . 130845) (\TEDIT.TEXTDSPXPOSITION 130847 . 133550) (
|
||||
\TEDIT.TEXTDSPYPOSITION 133552 . 134293) (\TEDIT.TEXTLEFTMARGIN 134295 . 134886) (\TEDIT.TEXTCOLOR
|
||||
134888 . 135471) (\TEDIT.TEXTRIGHTMARGIN 135473 . 138762) (\TEDIT.TEXTDSPCHARWIDTH 138764 . 139068) (
|
||||
\TEDIT.TEXTDSPSTRINGWIDTH 139070 . 139376) (\TEDIT.TEXTDSPLINEFEED 139378 . 139611)) (139651 152264 (
|
||||
\TEDIT.NTHCHARCODE 139661 . 141112) (\TEDIT.PIECE.NTHCHARCODE 141114 . 145024) (\TEDIT.RPLCHARCODE
|
||||
145026 . 146484) (\TEDIT.PIECE.RPLCHARCODE 146486 . 151909) (\TEDIT.NTHCHARLOOKS 151911 . 152262)) (
|
||||
153311 174405 (\TEDIT.DELETE.SELPIECES 153321 . 156946) (\TEDIT.INSERTCH 156948 . 164987) (
|
||||
\TEDIT.INSERTCH.HISTORY 164989 . 168453) (\TEDIT.INSERTEOL 168455 . 170280) (\TEDIT.INSERTCH.INSERTION
|
||||
170282 . 173119) (\TEDIT.INSERTCH.EXTEND 173121 . 174403)) (174406 175910 (\TEDIT.NEXTCHANGEABLE.CHNO
|
||||
174416 . 175131) (\TEDIT.LASTCHANGEABLE.CHNO 175133 . 175908)) (175911 177615 (\SETUPGETCH 175921 .
|
||||
177613)) (177673 182131 (\TEDIT.INSTALL.PIECE 177683 . 182129)) (182169 191635 (TEXTPROP 182179 .
|
||||
182526) (GETTEXTPROP 182528 . 182772) (PUTTEXTPROP 182774 . 183031) (GETTEXTPROPS 183033 . 183477) (
|
||||
PUTTEXTPROPS 183479 . 184383) (TEXTPROP.ADD 184385 . 184648) (\TEDIT.TEXTPROP 184650 . 191633)) (
|
||||
191636 194013 (\TEDIT.TEXTOBJ.PROPNAMES 191646 . 192905) (\TEDIT.TEXTOBJ.PROPFETCHFN 192907 . 193423)
|
||||
(\TEDIT.TEXTOBJ.PROPSTOREFN 193425 . 194011)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Oct-2025 11:20:51"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;243 52506
|
||||
(FILECREATED "14-Jan-2026 14:50:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;248 52743
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "20-Sep-2025 11:04:51" {WMEDLEY}<library>TEDIT>tedit-exports.all;242)
|
||||
:PREVIOUS-DATE "10-Jan-2026 23:04:09" {WMEDLEY}<library>TEDIT>tedit-exports.all;247)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
|
||||
@@ -17,7 +17,7 @@ PRINT))))))))
|
||||
(PUTPROPS FTEXTOBJ MACRO ((X) (TEXTOBJ! (CL:IF (type? TEXTOBJ X) X (GETTSTR X TEXTOBJ)))))
|
||||
(GLOBALVARS CHECK-TEDIT-ASSERTIONS)
|
||||
(RPAQ? CHECK-TEDIT-ASSERTIONS T)
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "28-Sep-2025 11:35:06"))
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "10-Jan-2026 01:39:21"))
|
||||
(RPAQQ \BTREEWORDSPERSLOT 4)
|
||||
(RPAQQ \BTREEMAXCOUNT 8)
|
||||
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
||||
@@ -56,8 +56,9 @@ by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||
"Description of a piece of selected text for TEdit. Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
|
||||
) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;;
|
||||
"If DCH=0, this is a caret-only selection, with no highlighting. In that case CHLIM=(ADD1 CH#) and POINT essentially indicates whether the caret blinks before or after CH#."
|
||||
) NIL (* ; "Was Y0: Y value of topmost line of selection") X0 (* ;
|
||||
"X value of left edge of selection on the first line") SELLINES (* ;
|
||||
) 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."
|
||||
) CH# (* ; "CH# of the first selected character") XLIM (* ;
|
||||
"X value of right edge of last selected character on the last line") CHLIM (* ;
|
||||
@@ -127,7 +128,7 @@ TSTREAM ONLYPANE DONTFIX)))
|
||||
(PUTPROPS \TEDIT.SEL.OFF MACRO ((TSTREAM SEL ONLYPANE) (* ;
|
||||
"Takes down SEL in TSTREAM, where SEL defaults to the current selection") (\TEDIT.SHOWSEL SEL NIL
|
||||
TSTREAM ONLYPANE)))
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "29-Jul-2025 11:22:10"))
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "14-Jan-2026 14:32:01"))
|
||||
(RECORD TAB (TABX . TABKIND))
|
||||
(RECORD TABSPEC (DEFAULTTAB . TABS))
|
||||
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
|
||||
@@ -208,8 +209,6 @@ ITEM collect (FIXR (FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
|
||||
(PUTPROPS SCALEDOWN MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I
|
||||
in ITEM collect (FIXR (FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
|
||||
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
|
||||
(ADDTOVAR CHARACTERNAMES (SOFT-HYPHEN "357,043") (NONBREAKING-HYPHEN "357,042") (NONBREAKING-SPACE
|
||||
"357,041"))
|
||||
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
|
||||
192) (ILEQ CHAR 207))))
|
||||
(PUTPROPS \TEDIT.LINE.TALLP MACRO ((LINE HEIGHT) (OR (IGREATERP (FGETLD LINE LHEIGHT) 50) (IGREATERP (
|
||||
@@ -260,7 +259,7 @@ NEXTAVAILABLECHARSLOT) of THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (F
|
||||
) by (PREVCHARSLOT I.V.) eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (
|
||||
CHARSLOT CHARW) of I.V.)) (SETQ CHARCL (fetch (CHARSLOT CHARCL) of I.V.)) repeatuntil (EQ I.V.
|
||||
$$CHARSLOTLIMIT))))) T)
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 00:07:29"))
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "31-Dec-2025 23:10:18"))
|
||||
(DATATYPE PIECE ((* ;
|
||||
"The piece describes either a string or part of a file. , or a generalized OBJECT.") PCONTENTS (* ;
|
||||
"The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
|
||||
@@ -299,9 +298,10 @@ HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ;
|
||||
) DS (* ;
|
||||
"NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")
|
||||
SEL (* ; "The current selection within the text") LASTARROWX (* ;
|
||||
"X for next arrow up or arrow down. Was: Scratch space for the selection code") NIL (* ;
|
||||
"Was MOVESEL: Source for the next MOVE of text") NIL (* ; "Was SHIFTEDSEL: Source for the next COPY")
|
||||
NIL (* ; "Was DELETESEL: Text to be deleted imminently") NIL (* ;
|
||||
"X for next arrow up or arrow down. Was: Scratch space for the selection code") 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 (* ;
|
||||
"Was DELETESEL: Text to be deleted imminently") NIL (* ;
|
||||
"Was WRIGHT: Right edge of the window (or subregion) where this is displayed") WTOP (* ;
|
||||
"Top of the window/region") NIL (* ; "Was WBOTTOM: Bottom of the window/region") NIL (* ;
|
||||
"Was WLEFT: Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (
|
||||
@@ -440,7 +440,7 @@ UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE F
|
||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
|
||||
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 15:09:09"))
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "14-Jan-2026 14:32:01"))
|
||||
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;;
|
||||
"Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
|
||||
) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
|
||||
@@ -449,12 +449,12 @@ THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTY
|
||||
I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (QUOTE HELP)
|
||||
"TEdit consistency-check failure [RETURN to continue]: " (COND ((STRINGP (CADR J))) (T (KWOTE I))))))
|
||||
)) (T (CONS COMMENTFLG ARGS)))))
|
||||
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "17-Jul-2025 00:24:49"))
|
||||
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE " 8-Nov-2025 10:03:19"))
|
||||
(PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) (SIGNED (create WORD HIBYTE _ (\BIN STREAM) LOBYTE _ (
|
||||
\BIN STREAM)) BITSPERWORD)))
|
||||
(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
|
||||
LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "25-Sep-2025 21:32:46"))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "23-Oct-2025 08:49:06"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE " 8-Sep-2025 22:10:10"))
|
||||
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
|
||||
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
|
||||
@@ -537,7 +537,7 @@ LINELEAD _ 0)
|
||||
(PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with
|
||||
NEWVALUE)))
|
||||
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 6-Oct-2025 20:50:59"))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 7-Dec-2025 16:32:32"))
|
||||
(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:25:43"))
|
||||
(DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
|
||||
is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
|
||||
@@ -600,17 +600,18 @@ OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BOD
|
||||
GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO
|
||||
$$OUT)))))
|
||||
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 15:13:01"))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "14-Jan-2026 14:32:01"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 10:44:18"))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 15:14:00"))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "12-Dec-2025 00:01:26"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:57"))
|
||||
(RPAQQ \TEDIT.TTCCODES ((NONE 0) (CHARDELETE 1) (WORDDELETE 2) (DELETE 3) (FUNCTIONCALL 4) (REDO 5) (
|
||||
UNDO 6) (CMD 7) (NEXT 8) (EXPAND 9) (CHARDELETE.FORWARD 10) (WORDDELETE.FORWARD 11) (PUNCT 20) (TEXT
|
||||
21) (WHITESPACE 22)))
|
||||
(RPAQQ \TEDIT.TTCCODES ((NONE . 0) (CHARDELETE . 1) (:CHARDELETE.BACKWARD . 1) (WORDDELETE . 2) (
|
||||
:WORDDELETE.BACKWORD . 2) (DELETE . 3) (:DELETE . 3) (FN . 4) (REDO . 5) (:REDO . 5) (UNDO . 6) (:UNDO
|
||||
. 6) (CMD . 7) (:CMD . 7) (NEXT . 8) (:NEXT . 8) (EXPAND . 9) (:EXPAND . 9) (CHARDELETE.FORWARD . 10)
|
||||
(:CHARDELETE.FORWARD . 10) (:WORDDELETE.FORWARD . 11) (PUNCT . 20) (TEXT . 21) (WHITESPACE . 22)))
|
||||
(CONSTANTS \TEDIT.TTCCODES)
|
||||
(PUTPROPS \TEDIT.TTC MACRO ((CLASS) (CONSTANT (CADR (ASSOC (QUOTE CLASS) \TEDIT.TTCCODES)))))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE " 7-Aug-2025 15:00:51"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Sep-2025 17:08:05"))
|
||||
(PUTPROPS \TEDIT.TTC MACRO ((ACTION) (CONSTANT (GETMULTI \TEDIT.TTCCODES (QUOTE ACTION)))))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "24-Nov-2025 08:40:56"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "24-Dec-2025 11:16:22"))
|
||||
(DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (*
|
||||
; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?")
|
||||
THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ;
|
||||
@@ -659,8 +660,8 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
|
||||
$$VALUES)) (PROG1 (CAR $$VALUES) (\,@ (FOR V IN (CAR ARGS) collect (COND (V (BQUOTE (SETQ (\, V) (POP
|
||||
$$VALUES)))) (T (BQUOTE (SETQ $$VALUES (CDR $$VALUES))))))))))))
|
||||
(PUTPROPS TEDIT.VALUES MACRO (ARGS (BQUOTE (LIST (\,@ ARGS)))))
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "27-Sep-2025 16:25:26"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE " 6-Sep-2025 00:10:45"))
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "25-Dec-2025 15:07:57"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "13-Jan-2026 17:51:55"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE " 7-Sep-2025 11:11:43"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
|
||||
@@ -1,187 +0,0 @@
|
||||
(FILECREATED " 6-Feb-87 10:18:07" {DSK}<LISPFILES2>H.ALFA>BLOCKS.HKB;2 4571
|
||||
|
||||
changes to: (VARS *functions1* *predicates1* *variables1* *temp-foo* *temp-pred*)
|
||||
|
||||
previous date: " 3-Nov-86 11:06:40" {DSK}<LISPFILES2>H>BLOCKS.HKB;9)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT BLOCKSCOMS)
|
||||
|
||||
(RPAQQ BLOCKSCOMS (*functions1* *predicates1* *variables1* *temp-foo* *temp-pred*))
|
||||
|
||||
(RPAQQ *functions1* (HRPRINT LISTMEMB MEMBER fail true noteq))
|
||||
|
||||
(RPAQQ *predicates1* (color-of showworld SPLIT putdown pickup please ART PREP GoOnNp PARTIC
|
||||
OPTPARTIC VP VERB NP1 NP NOM BLOCK on clear puton))
|
||||
|
||||
(RPAQQ *variables1* (:d :c :color :bl :a4 :a3 :a2 :a1 :e :q :s :m :string :e4 :e3 :e2 :e1 :rest1
|
||||
:block2 :q4 :q3 :q2 :q1 :block1 :rest :block :oper :vf :b :a :w2 :w1 :x1
|
||||
:y1 :u :r :v :z :i :h :j :l :w :y :x :k :p))
|
||||
|
||||
(RPAQQ *temp-foo* [[LAMBDA (y)
|
||||
(PRINTOUT T y T]
|
||||
[LAMBDA (x y)
|
||||
(PROG ((temp x))
|
||||
loop
|
||||
(COND ((NULL temp)
|
||||
(RETURN T))
|
||||
(T (COND ([OR (MEMBER (CAR temp)
|
||||
y)
|
||||
(EQ (CAR temp (QUOTE one]
|
||||
(SETQ temp (CDR temp))
|
||||
(GO loop))
|
||||
(T (RETURN NIL]
|
||||
[LAMBDA (x y)
|
||||
(MEMBER x y]
|
||||
[LAMBDA NIL NIL]
|
||||
[LAMBDA NIL T]
|
||||
(LAMBDA (x y)
|
||||
(NOT (EQ x y])
|
||||
|
||||
(RPAQQ *temp-pred* [(((color-of :block :color)
|
||||
<
|
||||
(BLOCK :block :color :a :b :c :d)))
|
||||
(((showworld)
|
||||
<
|
||||
(on :x :y)
|
||||
(HRPRINT (on :x :y))
|
||||
(fail)))
|
||||
(((SPLIT (:a . :b)
|
||||
:a :b)))
|
||||
(((putdown :x)
|
||||
<
|
||||
(puton :x table)))
|
||||
(((pickup :x)
|
||||
<
|
||||
(puton :x hand)))
|
||||
(((please :string)
|
||||
<
|
||||
(VP :string)))
|
||||
(((ART the))
|
||||
((ART a))
|
||||
((ART an)))
|
||||
(((PREP on on)))
|
||||
(((GoOnNp (:x . :y)
|
||||
:v :rest)
|
||||
<
|
||||
(PREP :x :x1)
|
||||
(NP :y :v :rest)))
|
||||
(((PARTIC down))
|
||||
((PARTIC up))
|
||||
((PARTIC to)))
|
||||
(((OPTPARTIC NIL :x))
|
||||
((OPTPARTIC (:x . :y)
|
||||
:z)
|
||||
<
|
||||
(PARTIC :x)))
|
||||
(((VP (:x :y . :z))
|
||||
<
|
||||
(VERB :x :vf :oper)
|
||||
(PARTIC :y)
|
||||
(MEMBER :y :vf)
|
||||
(NP :z :block NIL)
|
||||
(:oper :block))
|
||||
((VP (:x . :y))
|
||||
<
|
||||
(VERB :x :vf :oper)
|
||||
(MEMBER one :vf)
|
||||
(NP :y :block :rest)
|
||||
(OPTPARTIC :rest :vf)
|
||||
(:oper :block))
|
||||
((VP (:x . :y))
|
||||
<
|
||||
(VERB :x :vf :oper)
|
||||
(MEMBER two :vf)
|
||||
(NP :y :block1 :rest)
|
||||
(BLOCK :block1 :q1 :q2 :q3 :q4 stackable)
|
||||
(GoOnNp :rest :block2 :rest1)
|
||||
(BLOCK :block2 :e1 :e2 :e3 supportive :e4)
|
||||
(:oper :block1 :block2)))
|
||||
(((VERB pickup (one)
|
||||
pickup))
|
||||
((VERB pick (up one)
|
||||
pickup))
|
||||
((VERB put (two)
|
||||
puton))
|
||||
((VERB stack (two)
|
||||
puton))
|
||||
((VERB put (down one)
|
||||
putdown)))
|
||||
(((NP1 (:x :y . :z)
|
||||
:w :u :r)
|
||||
<
|
||||
(PREP :y :y1)
|
||||
(NOM :x :x1)
|
||||
(NP :z :v :r)
|
||||
(:y1 :w :v)
|
||||
(BLOCK . :w1)
|
||||
(LISTMEMB (:x1 . :u)
|
||||
:w1)
|
||||
(SPLIT :w1 :w :w2))
|
||||
((NP1 (:x . :y)
|
||||
:v :u :r)
|
||||
<
|
||||
(NOM :x :x1)
|
||||
(NP1 :y :v (:x1 . :u)
|
||||
:r))
|
||||
((NP1 (:x . :y)
|
||||
:w :u :y)
|
||||
<
|
||||
(NOM :x :x1)
|
||||
(BLOCK . :w1)
|
||||
(LISTMEMB (:x1 . :u)
|
||||
:w1)
|
||||
(SPLIT :w1 :w :w2)))
|
||||
(((NP (:x . :y)
|
||||
:v :r)
|
||||
<
|
||||
(ART :x)
|
||||
(NP1 :y :v NIL :r))
|
||||
((NP :x :v :r)
|
||||
<
|
||||
(NP1 :x :v NIL :r)))
|
||||
(((NOM red red))
|
||||
((NOM block cube))
|
||||
((NOM cube cube))
|
||||
((NOM cube1 cube1))
|
||||
((NOM cube2 cube2))
|
||||
((NOM cube3 cube3))
|
||||
((NOM big large))
|
||||
((NOM small small))
|
||||
((NOM blue blue))
|
||||
((NOM white white))
|
||||
((NOM green green))
|
||||
((NOM pyramid1 pyramid))
|
||||
((NOM pyramid pyramid))
|
||||
((NOM sphere sphere)))
|
||||
(((BLOCK pyramid1 white pyramid 3 NIL stackable))
|
||||
((BLOCK cube2 blue cube 5 supportive stackable))
|
||||
((BLOCK cube3 green cube 1 supportive stackable))
|
||||
((BLOCK cube1 red cube 10 supportive stackable))
|
||||
((BLOCK sphere black sphere 3 NIL stackable))
|
||||
((BLOCK table NIL NIL NIL supportive NIL))
|
||||
((BLOCK hand NIL NIL NIL supportive NIL)))
|
||||
(((on cube3 hand))
|
||||
((on sphere table))
|
||||
((on cube1 table))
|
||||
((on cube2 table))
|
||||
((on pyramid1 table)))
|
||||
(((clear table))
|
||||
((clear :x)
|
||||
<
|
||||
(on :y :x)
|
||||
(puton :y table))
|
||||
((clear :x)))
|
||||
(((puton :x :y)
|
||||
<
|
||||
(noteq :x table)
|
||||
(clear :x)
|
||||
(noteq :y pyramid)
|
||||
(noteq :y sphere)
|
||||
(clear :y)
|
||||
(on :x :w)
|
||||
(delete (on :x :w))
|
||||
(assert (on :x :y])
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
@@ -1 +0,0 @@
|
||||
(FILECREATED "31-Aug-94 15:04:16" ("compiled on " {DSK}<lispcore>lispusers>BLOCKS-HKB.;1)
"28-Jul-94 17:28:46" bcompl'd in "Medley 28-Jul-94 ..." dated "28-Jul-94 17:35:29")
(FILECREATED " 6-Feb-87 10:18:07" {DSK}<LISPFILES2>H.ALFA>BLOCKS.HKB;2 4571 changes to: (VARS
*functions1* *predicates1* *variables1* *temp-foo* *temp-pred*) previous date: " 3-Nov-86 11:06:40"
{DSK}<LISPFILES2>H>BLOCKS.HKB;9)
(PRETTYCOMPRINT BLOCKSCOMS)
(RPAQQ BLOCKSCOMS (*functions1* *predicates1* *variables1* *temp-foo* *temp-pred*))
(RPAQQ *functions1* (HRPRINT LISTMEMB MEMBER fail true noteq))
(RPAQQ *predicates1* (color-of showworld SPLIT putdown pickup please ART PREP GoOnNp PARTIC OPTPARTIC
VP VERB NP1 NP NOM BLOCK on clear puton))
(RPAQQ *variables1* (:d :c :color :bl :a4 :a3 :a2 :a1 :e :q :s :m :string :e4 :e3 :e2 :e1 :rest1
:block2 :q4 :q3 :q2 :q1 :block1 :rest :block :oper :vf :b :a :w2 :w1 :x1 :y1 :u :r :v :z :i :h :j :l
:w :y :x :k :p))
(RPAQQ *temp-foo* ((LAMBDA (y) (PRINTOUT T y T)) (LAMBDA (x y) (PROG ((temp x)) loop (COND ((NULL temp
) (RETURN T)) (T (COND ((OR (MEMBER (CAR temp) y) (EQ (CAR temp (QUOTE one)))) (SETQ temp (CDR temp))
(GO loop)) (T (RETURN NIL))))))) (LAMBDA (x y) (MEMBER x y)) (LAMBDA NIL NIL) (LAMBDA NIL T) (LAMBDA (
x y) (NOT (EQ x y)))))
(RPAQQ *temp-pred* ((((color-of :block :color) < (BLOCK :block :color :a :b :c :d))) (((showworld) < (
on :x :y) (HRPRINT (on :x :y)) (fail))) (((SPLIT (:a . :b) :a :b))) (((putdown :x) < (puton :x table))
) (((pickup :x) < (puton :x hand))) (((please :string) < (VP :string))) (((ART the)) ((ART a)) ((ART
an))) (((PREP on on))) (((GoOnNp (:x . :y) :v :rest) < (PREP :x :x1) (NP :y :v :rest))) (((PARTIC down
)) ((PARTIC up)) ((PARTIC to))) (((OPTPARTIC NIL :x)) ((OPTPARTIC (:x . :y) :z) < (PARTIC :x))) (((VP
(:x :y . :z)) < (VERB :x :vf :oper) (PARTIC :y) (MEMBER :y :vf) (NP :z :block NIL) (:oper :block)) ((
VP (:x . :y)) < (VERB :x :vf :oper) (MEMBER one :vf) (NP :y :block :rest) (OPTPARTIC :rest :vf) (:oper
:block)) ((VP (:x . :y)) < (VERB :x :vf :oper) (MEMBER two :vf) (NP :y :block1 :rest) (BLOCK :block1
:q1 :q2 :q3 :q4 stackable) (GoOnNp :rest :block2 :rest1) (BLOCK :block2 :e1 :e2 :e3 supportive :e4) (
:oper :block1 :block2))) (((VERB pickup (one) pickup)) ((VERB pick (up one) pickup)) ((VERB put (two)
puton)) ((VERB stack (two) puton)) ((VERB put (down one) putdown))) (((NP1 (:x :y . :z) :w :u :r) < (
PREP :y :y1) (NOM :x :x1) (NP :z :v :r) (:y1 :w :v) (BLOCK . :w1) (LISTMEMB (:x1 . :u) :w1) (SPLIT :w1
:w :w2)) ((NP1 (:x . :y) :v :u :r) < (NOM :x :x1) (NP1 :y :v (:x1 . :u) :r)) ((NP1 (:x . :y) :w :u :y
) < (NOM :x :x1) (BLOCK . :w1) (LISTMEMB (:x1 . :u) :w1) (SPLIT :w1 :w :w2))) (((NP (:x . :y) :v :r) <
(ART :x) (NP1 :y :v NIL :r)) ((NP :x :v :r) < (NP1 :x :v NIL :r))) (((NOM red red)) ((NOM block cube)
) ((NOM cube cube)) ((NOM cube1 cube1)) ((NOM cube2 cube2)) ((NOM cube3 cube3)) ((NOM big large)) ((
NOM small small)) ((NOM blue blue)) ((NOM white white)) ((NOM green green)) ((NOM pyramid1 pyramid)) (
(NOM pyramid pyramid)) ((NOM sphere sphere))) (((BLOCK pyramid1 white pyramid 3 NIL stackable)) ((
BLOCK cube2 blue cube 5 supportive stackable)) ((BLOCK cube3 green cube 1 supportive stackable)) ((
BLOCK cube1 red cube 10 supportive stackable)) ((BLOCK sphere black sphere 3 NIL stackable)) ((BLOCK
table NIL NIL NIL supportive NIL)) ((BLOCK hand NIL NIL NIL supportive NIL))) (((on cube3 hand)) ((on
sphere table)) ((on cube1 table)) ((on cube2 table)) ((on pyramid1 table))) (((clear table)) ((clear
:x) < (on :y :x) (puton :y table)) ((clear :x))) (((puton :x :y) < (noteq :x table) (clear :x) (noteq
:y pyramid) (noteq :y sphere) (clear :y) (on :x :w) (delete (on :x :w)) (assert (on :x :y))))))
NIL
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Nov-2025 13:07:39" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;285 138536
|
||||
(FILECREATED "10-Feb-2026 21:28:55" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;286 138607
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS CD-MENUFN CDBROWSER-COPY)
|
||||
:CHANGES-TO (FNS CD-MENUFN)
|
||||
|
||||
:PREVIOUS-DATE "28-Oct-2025 14:52:05" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;280)
|
||||
:PREVIOUS-DATE " 8-Nov-2025 13:07:39" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;285)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||
@@ -1983,6 +1983,8 @@
|
||||
(CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
||||
|
||||
(* ;; "Edited 10-Feb-2026 21:28 by rmk")
|
||||
|
||||
(* ;; "Edited 8-Nov-2025 13:06 by rmk")
|
||||
|
||||
(* ;; "Edited 28-Oct-2025 17:35 by rmk")
|
||||
@@ -2059,11 +2061,11 @@
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
((See See% both)
|
||||
(IF (PDFFILEP FILE1)
|
||||
(IF (AND FILE1 (PDFFILEP FILE1))
|
||||
then (SEE-PDF FILE1)
|
||||
(CL:WHEN (PDFFILEP FILE2)
|
||||
(CL:WHEN (AND FILE2 (PDFFILEP FILE2))
|
||||
(SEE-PDF FILE2))
|
||||
elseif (PDFFILEP FILE2)
|
||||
elseif (AND FILE2 (PDFFILEP FILE2))
|
||||
then (SEE-PDF FILE2)
|
||||
else (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION (ITIMES 2 (CL:IF (LISPSOURCEFILEP FILE1)
|
||||
@@ -2321,25 +2323,25 @@
|
||||
|
||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2668 23647 (COMPAREDIRECTORIES 2678 . 8013) (COMPAREDIRECTORIES.INFOS 8015 . 11244) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 11246 . 14631) (CDENTRIES.SELECT 14633 . 19535) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 19537 . 20881) (MATCHNAME 20883 . 21563) (CD.INSURECDVALUE 21565 . 23179
|
||||
) (CD.UPDATEWIDTHS 23181 . 23645)) (23648 34353 (CDFILES 23658 . 29755) (CDFILES.MATCH 29757 . 31382)
|
||||
(CDFILES.PATS 31384 . 34351)) (34354 52372 (CDPRINT 34364 . 36881) (CDPRINT.HEADER 36883 . 37780) (
|
||||
CDPRINT.LINE 37782 . 41211) (CDPRINT.MAXWIDTHS 41213 . 45328) (CDPRINT.COLHEADERS 45330 . 46615) (
|
||||
CDPRINT.COLUMNS 46617 . 51737) (CDTEDIT 51739 . 52370)) (52373 61494 (CDMAP 52383 . 53815) (CDENTRY
|
||||
53817 . 54126) (CDSUBSET 54128 . 55567) (CDMERGE 55569 . 59553) (CDMERGE.COMMON 59555 . 60870) (
|
||||
CD.SORT 60872 . 61492)) (61495 69033 (BINCOMP 61505 . 65794) (EOLTYPE 65796 . 68358) (EOLTYPE.SHOW
|
||||
68360 . 69031)) (69561 82088 (FIND-UNCOMPILED-FILES 69571 . 73214) (FIND-UNSOURCED-FILES 73216 . 75600
|
||||
) (FIND-SOURCE-FILES 75602 . 77340) (FIND-COMPILED-FILES 77342 . 79219) (FIND-UNLOADED-FILES 79221 .
|
||||
80074) (FIND-LOADED-FILES 80076 . 80504) (FIND-MULTICOMPILED-FILES 80506 . 82086)) (82089 90520 (
|
||||
CREATED-AS 82099 . 86896) (SOURCE-FOR-COMPILED-P 86898 . 89825) (COMPILE-SOURCE-DATE-DIFF 89827 .
|
||||
90518)) (90521 101284 (FIX-DIRECTORY-DATES 90531 . 93981) (FIX-EQUIV-DATES 93983 . 95508) (
|
||||
COPY-COMPARED-FILES 95510 . 97331) (COPY-MISSING-FILES 97333 . 99490) (COMPILED-ON-SAME-SOURCE 99492
|
||||
. 101282)) (101478 109356 (CDBROWSER 101488 . 105455) (CDBROWSER.STRINGS 105457 . 109354)) (109518
|
||||
111254 (CD.TABLEITEM 109528 . 109748) (CD.TABLEITEM.PRINTFN 109750 . 109949) (CD.TABLEITEM.COPYFN
|
||||
109951 . 111009) (CDTABLEBROWSER.HEADING.REPAINTFN 111011 . 111252)) (111255 138020 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 111265 . 111733) (CD.COMMANDSELECTEDFN 111735 . 117908) (CD-MENUFN
|
||||
117910 . 124301) (CD-COMPARE-FILES 124303 . 127830) (CDBROWSER-COPY 127832 . 132894) (
|
||||
CDBROWSER-DELETE-FILE 132896 . 137499) (CD-SWAPDIRS 137501 . 138018)))))
|
||||
(FILEMAP (NIL (2653 23632 (COMPAREDIRECTORIES 2663 . 7998) (COMPAREDIRECTORIES.INFOS 8000 . 11229) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 11231 . 14616) (CDENTRIES.SELECT 14618 . 19520) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 19522 . 20866) (MATCHNAME 20868 . 21548) (CD.INSURECDVALUE 21550 . 23164
|
||||
) (CD.UPDATEWIDTHS 23166 . 23630)) (23633 34338 (CDFILES 23643 . 29740) (CDFILES.MATCH 29742 . 31367)
|
||||
(CDFILES.PATS 31369 . 34336)) (34339 52357 (CDPRINT 34349 . 36866) (CDPRINT.HEADER 36868 . 37765) (
|
||||
CDPRINT.LINE 37767 . 41196) (CDPRINT.MAXWIDTHS 41198 . 45313) (CDPRINT.COLHEADERS 45315 . 46600) (
|
||||
CDPRINT.COLUMNS 46602 . 51722) (CDTEDIT 51724 . 52355)) (52358 61479 (CDMAP 52368 . 53800) (CDENTRY
|
||||
53802 . 54111) (CDSUBSET 54113 . 55552) (CDMERGE 55554 . 59538) (CDMERGE.COMMON 59540 . 60855) (
|
||||
CD.SORT 60857 . 61477)) (61480 69018 (BINCOMP 61490 . 65779) (EOLTYPE 65781 . 68343) (EOLTYPE.SHOW
|
||||
68345 . 69016)) (69546 82073 (FIND-UNCOMPILED-FILES 69556 . 73199) (FIND-UNSOURCED-FILES 73201 . 75585
|
||||
) (FIND-SOURCE-FILES 75587 . 77325) (FIND-COMPILED-FILES 77327 . 79204) (FIND-UNLOADED-FILES 79206 .
|
||||
80059) (FIND-LOADED-FILES 80061 . 80489) (FIND-MULTICOMPILED-FILES 80491 . 82071)) (82074 90505 (
|
||||
CREATED-AS 82084 . 86881) (SOURCE-FOR-COMPILED-P 86883 . 89810) (COMPILE-SOURCE-DATE-DIFF 89812 .
|
||||
90503)) (90506 101269 (FIX-DIRECTORY-DATES 90516 . 93966) (FIX-EQUIV-DATES 93968 . 95493) (
|
||||
COPY-COMPARED-FILES 95495 . 97316) (COPY-MISSING-FILES 97318 . 99475) (COMPILED-ON-SAME-SOURCE 99477
|
||||
. 101267)) (101463 109341 (CDBROWSER 101473 . 105440) (CDBROWSER.STRINGS 105442 . 109339)) (109503
|
||||
111239 (CD.TABLEITEM 109513 . 109733) (CD.TABLEITEM.PRINTFN 109735 . 109934) (CD.TABLEITEM.COPYFN
|
||||
109936 . 110994) (CDTABLEBROWSER.HEADING.REPAINTFN 110996 . 111237)) (111240 138091 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 111250 . 111718) (CD.COMMANDSELECTEDFN 111720 . 117893) (CD-MENUFN
|
||||
117895 . 124372) (CD-COMPARE-FILES 124374 . 127901) (CDBROWSER-COPY 127903 . 132965) (
|
||||
CDBROWSER-DELETE-FILE 132967 . 137570) (CD-SWAPDIRS 137572 . 138089)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-May-2025 22:04:32" {WMEDLEY}<lispusers>HELPSYS.;15 87966
|
||||
(FILECREATED "27-Jan-2026 13:21:10" {WMEDLEY}<lispusers>HELPSYS.;21 88654
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS CLHS.INDEX)
|
||||
:CHANGES-TO (FNS DOCS.LOOKUP GENERIC.MAN.LOOKUP)
|
||||
(VARS HELPSYSCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 4-May-2025 13:30:47" {WMEDLEY}<lispusers>HELPSYS.;12)
|
||||
:PREVIOUS-DATE " 5-May-2025 22:04:32" {WMEDLEY}<lispusers>HELPSYS.;15)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT HELPSYSCOMS)
|
||||
@@ -17,7 +18,7 @@
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
DINFO HASH))
|
||||
[COMS (COMMANDS "man")
|
||||
(FNS HELPSYS IRM.LOOKUP GENERIC.MAN.LOOKUP IRM.SMART.LOOKUP IRM.RESET)
|
||||
(FNS HELPSYS IRM.LOOKUP GENERIC.MAN.LOOKUP IRM.SMART.LOOKUP IRM.RESET DOCS.LOOKUP)
|
||||
(INITVARS (IRM.HOST&DIR)
|
||||
(IRM.HASHFILE.NAME))
|
||||
(GLOBALVARS IRM.HOST&DIR IRM.HASHFILE.NAME)
|
||||
@@ -161,7 +162,8 @@
|
||||
NIL])
|
||||
|
||||
(GENERIC.MAN.LOOKUP
|
||||
[LAMBDA (KEYWORD GRAPH TYPE) (* ; "Edited 27-Aug-2022 12:15 by larry")
|
||||
[LAMBDA (KEYWORD GRAPH TYPE) (* ; "Edited 27-Jan-2026 11:42 by rmk")
|
||||
(* ; "Edited 27-Aug-2022 12:15 by larry")
|
||||
(* ; "Edited 24-Aug-2022 22:35 by larry")
|
||||
(* ; "Edited 19-Aug-2022 19:35 by lmm")
|
||||
(* drc%: " 6-Jan-86 14:50")
|
||||
@@ -171,7 +173,8 @@
|
||||
|
||||
(APPEND (IRM.LOOKUP KEYWORD NIL GRAPH T)
|
||||
(CLHS.LOOKUP KEYWORD)
|
||||
(REPO.LOOKUP KEYWORD))
|
||||
(REPO.LOOKUP KEYWORD)
|
||||
(DOCS.LOOKUP KEYWORD))
|
||||
elseif (NOT (LITATOM KEYWORD))
|
||||
then
|
||||
(* ;; " not a string -- list or number. turn it into a string, removing parens")
|
||||
@@ -192,7 +195,8 @@
|
||||
(AND (CL:FIND-SYMBOL KEYWORD "IL")
|
||||
(IRM.LOOKUP KEYWORD TYPE GRAPH T)))
|
||||
else (APPEND (IRM.LOOKUP KEYWORD TYPE GRAPH T)
|
||||
(REPO.LOOKUP KEYWORD])
|
||||
(REPO.LOOKUP KEYWORD)
|
||||
(DOCS.LOOKUP KEYWORD])
|
||||
|
||||
(IRM.SMART.LOOKUP
|
||||
[LAMBDA (KEYWORD GRAPH) (* drc%: " 6-Jan-86 14:50")
|
||||
@@ -208,6 +212,15 @@
|
||||
(CLOSEHASHFILE \IRM.HASHFILE)
|
||||
(SETQ \IRM.HASHFILE)
|
||||
(SETQ \IRM.KEYWORDS])
|
||||
|
||||
(DOCS.LOOKUP
|
||||
[LAMBDA (KEYWORD) (* ; "Edited 27-Jan-2026 13:20 by rmk")
|
||||
(LET ((DIR (MEDLEYDIR (CONCAT "library/" (L-CASE KEYWORD)
|
||||
"/docs/")
|
||||
NIL NIL T)))
|
||||
(CL:WHEN DIR
|
||||
(ShellOpen (CONCAT "file://" (SLASHIT (TRUEFILENAME DIR)
|
||||
NIL T))))])
|
||||
)
|
||||
|
||||
(RPAQ? IRM.HOST&DIR )
|
||||
@@ -1703,14 +1716,14 @@
|
||||
|
||||
(PUTPROPS HELPSYS FILETYPE :FAKE-COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4571 10304 (HELPSYS 4581 . 6422) (IRM.LOOKUP 6424 . 8062) (GENERIC.MAN.LOOKUP 8064 .
|
||||
9733) (IRM.SMART.LOOKUP 9735 . 9891) (IRM.RESET 9893 . 10302)) (10561 17880 (CLHS.INDEX 10571 . 13535)
|
||||
(CLHS.LOOKUP 13537 . 15543) (CLHS.OPENER 15545 . 16868) (REPO.LOOKUP 16870 . 17878)) (70975 72493 (
|
||||
IRM.GET.DINFOGRAPH 70985 . 71860) (IRM.DISPLAY.REF 71862 . 72491)) (72495 72857 (IRM.LOAD-GRAPH 72495
|
||||
. 72857)) (73182 78686 (IRM.DISPLAY.CREF 73192 . 74906) (IRM.CREF.BOX 74908 . 75735) (IRM.PUT.CREF
|
||||
75737 . 75962) (IRM.GET.CREF 75964 . 76335) (IRM.CREF.BUTTONEVENTFN 76337 . 78684)) (79241 87547 (
|
||||
\IRM.GET.REF 79251 . 80582) (\IRM.SMART.REF 80584 . 82511) (\IRM.CHOOSE.REF 82513 . 83764) (
|
||||
\IRM.WILD.REF 83766 . 85021) (\IRM.WILDCARD 85023 . 85389) (\IRM.WILD.MATCH 85391 . 86621) (
|
||||
\IRM.GET.HASHFILE 86623 . 87086) (\IRM.GET.KEYWORDS 87088 . 87545)) (87684 87840 (\IRM.AROUND-EXIT
|
||||
87684 . 87840)))))
|
||||
(FILEMAP (NIL (4640 10992 (HELPSYS 4650 . 6491) (IRM.LOOKUP 6493 . 8131) (GENERIC.MAN.LOOKUP 8133 .
|
||||
10001) (IRM.SMART.LOOKUP 10003 . 10159) (IRM.RESET 10161 . 10570) (DOCS.LOOKUP 10572 . 10990)) (11249
|
||||
18568 (CLHS.INDEX 11259 . 14223) (CLHS.LOOKUP 14225 . 16231) (CLHS.OPENER 16233 . 17556) (REPO.LOOKUP
|
||||
17558 . 18566)) (71663 73181 (IRM.GET.DINFOGRAPH 71673 . 72548) (IRM.DISPLAY.REF 72550 . 73179)) (
|
||||
73183 73545 (IRM.LOAD-GRAPH 73183 . 73545)) (73870 79374 (IRM.DISPLAY.CREF 73880 . 75594) (
|
||||
IRM.CREF.BOX 75596 . 76423) (IRM.PUT.CREF 76425 . 76650) (IRM.GET.CREF 76652 . 77023) (
|
||||
IRM.CREF.BUTTONEVENTFN 77025 . 79372)) (79929 88235 (\IRM.GET.REF 79939 . 81270) (\IRM.SMART.REF 81272
|
||||
. 83199) (\IRM.CHOOSE.REF 83201 . 84452) (\IRM.WILD.REF 84454 . 85709) (\IRM.WILDCARD 85711 . 86077)
|
||||
(\IRM.WILD.MATCH 86079 . 87309) (\IRM.GET.HASHFILE 87311 . 87774) (\IRM.GET.KEYWORDS 87776 . 88233)) (
|
||||
88372 88528 (\IRM.AROUND-EXIT 88372 . 88528)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
275
lispusers/HPGL
275
lispusers/HPGL
@@ -1,20 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "20-Jul-88 17:47:02" |{MCS:MCS:STANFORD}<LANE>HPGL.;24| 45342
|
||||
|
||||
changes to%: (FNS \DRAWLINE.HPGL \FONT.HPGL \INIT.HPGL HARDCOPYW.HPGL)
|
||||
(FILECREATED "29-Jan-2026 21:10:52" {WMEDLEY}<lispusers>HPGL.;9 43562
|
||||
|
||||
previous date%: "20-Jul-88 17:34:42" |{MCS:MCS:STANFORD}<LANE>HPGL.;23|)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS OPENHPGLSTREAM)
|
||||
|
||||
:PREVIOUS-DATE "29-Jan-2026 11:02:32" {WMEDLEY}<lispusers>HPGL.;7)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT HPGLCOMS)
|
||||
|
||||
(RPAQQ HPGLCOMS
|
||||
(RPAQQ HPGLCOMS
|
||||
((* * User Functions)
|
||||
(FNS MAKEHPGL OPENHPGLSTREAM HARDCOPYW.HPGL)
|
||||
(FNS OPENHPGLSTREAM HARDCOPYW.HPGL)
|
||||
(* * ImageOp Functions)
|
||||
(FNS \BITBLT.HPGL \BLTSHADE.HPGL \CLOSEFN.HPGL \COLOR.HPGL \DRAWARC.HPGL \DRAWCIRCLE.HPGL
|
||||
\DRAWCURVE.HPGL \DRAWLINE.HPGL \DRAWPOLYGON.HPGL \FILLCIRCLE.HPGL \FONT.HPGL
|
||||
@@ -36,20 +35,11 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES UTILISOPRS)
|
||||
(ALISTS (PRINTOUTMACROS !, !; !!;))
|
||||
(RECORDS PLOTTERDATA))
|
||||
(ALISTS (PRINTFILETYPES HPGL))
|
||||
[ADDVARS (PRINTERTYPES ((PLOTTER HPGL)
|
||||
(CANPRINT (HPGL))
|
||||
(STATUS TRUE)
|
||||
(BITMAPFILE (HARDCOPYW.HPGL FILE BITMAP SCALEFACTOR REGION ROTATION
|
||||
TITLE))
|
||||
(PROPERTIES NILL)))
|
||||
[PRINTFILETYPES (HPGL (EXTENSION (HPGL PLOT))
|
||||
(CONVERSION (TEXT MAKEHPGL TEDIT
|
||||
(LAMBDA (FILE PFILE)
|
||||
(SETQ FILE (OPENTEXTSTREAM FILE))
|
||||
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL
|
||||
NIL NIL 'HPGL)
|
||||
(CLOSEF? FILE)
|
||||
PFILE]
|
||||
(IMAGESTREAMTYPES (HPGL (OPENSTREAM OPENHPGLSTREAM)
|
||||
(FONTCREATE \FONTCREATE.HPGL)
|
||||
(FONTSAVAILABLE \SEARCH.HPGL.FONTS)
|
||||
@@ -64,39 +54,36 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(MAKEHPGL
|
||||
[LAMBDA (FILE PFILE FONTS HEADING TABS) (* cdl "12-Jun-85 11:22")
|
||||
(TEXTTOIMAGEFILE FILE PFILE 'HPGL FONTS HEADING TABS])
|
||||
|
||||
(OPENHPGLSTREAM
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 8-Sep-87 08:50 by cdl")
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 29-Jan-2026 21:10 by rmk")
|
||||
(* ; "Edited 28-Jan-2026 01:00 by rmk")
|
||||
(* ; "Edited 8-Sep-87 08:50 by cdl")
|
||||
(* DECLARATIONS%: (RECORD PAIR
|
||||
(KEY VALUE)))
|
||||
(KEY VALUE)))
|
||||
(LET (HPGLSTREAM POSITION (STREAM (OPENSTREAM FILE 'OUTPUT))
|
||||
(SCALE (create POSITION
|
||||
XCOORD _ SCREENWIDTH
|
||||
YCOORD _ SCREENHEIGHT)))
|
||||
(if (AND (SETQ POSITION (LISTGET OPTIONS 'SCALE))
|
||||
(POSITIONP POSITION))
|
||||
(POSITIONP POSITION))
|
||||
then (SETQ SCALE POSITION))
|
||||
(SETQ HPGLSTREAM (create STREAM
|
||||
IMAGEOPS _ \HPGLIMAGEOPS
|
||||
IMAGEDATA _ (create PLOTTERDATA
|
||||
PD.STREAM _ STREAM
|
||||
PD.SCALE _ SCALE
|
||||
PD.RIGHTMARGIN _ (with POSITION SCALE XCOORD)
|
||||
)
|
||||
PD.RIGHTMARGIN _ (with POSITION SCALE XCOORD))
|
||||
OUTCHARFN _ (FUNCTION \OUTCHAR.HPGL)
|
||||
CBUFPTR _ NIL
|
||||
CBUFSIZE _ 0
|
||||
DEVICE _ \NULLFDEV using STREAM))
|
||||
(with STREAM STREAM (SETQ LINELENGTH MAX.SMALLP))
|
||||
(with POSITION SCALE
|
||||
(printout STREAM "DF" !; "SC" "0" !, XCOORD !, "0" !, YCOORD !; "DT" !!; !;))
|
||||
(printout STREAM "DF" !; "SC" "0" !, XCOORD !, "0" !, YCOORD !; "DT" !!; !;))
|
||||
[bind ENTRY for PAIR on OPTIONS by (CDDR PAIR)
|
||||
do (with PAIR PAIR (if (SETQ ENTRY (ASSOC KEY HPGL.OPTIONS))
|
||||
then (printout STREAM (CDR ENTRY)
|
||||
VALUE !;]
|
||||
then (printout STREAM (CDR ENTRY)
|
||||
VALUE !;]
|
||||
(DSPFONT DEFAULTFONT HPGLSTREAM)
|
||||
(DSPRESET HPGLSTREAM)
|
||||
HPGLSTREAM])
|
||||
@@ -513,37 +500,38 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
|
||||
T])
|
||||
|
||||
(\FONTCREATE.HPGL
|
||||
[LAMBDA (FAMILY SIZE FACE ROTATION) (* ; "Edited 4-Sep-87 15:13 by cdl")
|
||||
(if (ASSOC FAMILY HPGL.FONTS)
|
||||
then (LET ((WIDTHSBLOCK (\CREATECSINFOELEMENT))
|
||||
(FONTDESCRIPTOR (create FONTDESCRIPTOR
|
||||
FONTDEVICE _ 'HPGL
|
||||
FONTFAMILY _ FAMILY
|
||||
FONTSIZE _ SIZE
|
||||
FONTFACE _ FACE
|
||||
ROTATION _ ROTATION
|
||||
\SFHeight _ SIZE
|
||||
\SFAscent _ SIZE
|
||||
\SFDescent _ 0)))
|
||||
(bind (WIDTH _ (FIX (QUOTIENT (TIMES 3 SIZE)
|
||||
4))) for N from 0 to 254
|
||||
do (\FSETWIDTH WIDTHSBLOCK N WIDTH))
|
||||
(with FONTDESCRIPTOR FONTDESCRIPTOR
|
||||
(\SETCHARSETINFO FONTCHARSETVECTOR 0
|
||||
(create CHARSETINFO
|
||||
WIDTHS _ WIDTHSBLOCK
|
||||
IMAGEWIDTHS _ WIDTHSBLOCK
|
||||
CHARSETASCENT _ SIZE
|
||||
CHARSETDESCENT _ 0)))
|
||||
FONTDESCRIPTOR)
|
||||
else (FONTCREATE (CAAR HPGL.FONTS)
|
||||
SIZE FACE ROTATION 'HPGL])
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 28-Jan-2026 00:58 by rmk")
|
||||
(* ; "Edited 4-Sep-87 15:13 by cdl")
|
||||
(if (ASSOC (fetch (FONTSPEC FSFAMILY) of FONTSPEC)
|
||||
HPGL.FONTS)
|
||||
then (LET* ((SIZE (fetch (FONTSPEC FSSIZE) of FONTSPEC))
|
||||
(WIDTHSBLOCK (\CREATECSINFOELEMENT))
|
||||
(FONTDESCRIPTOR (create FONTDESCRIPTOR
|
||||
FONTDEVICE _ 'HPGL
|
||||
FONTFAMILY _ (fetch (FONTSPEC FSFAMILY) of FONTSPEC)
|
||||
FONTSIZE _ SIZE
|
||||
FONTFACE _ (fetch (FONTSPEC FSFACE) of FONTSPEC)
|
||||
ROTATION _ (fetch (FONTSPEC FSROTATION) of FONTSPEC)
|
||||
\SFHeight _ SIZE
|
||||
\SFAscent _ SIZE
|
||||
\SFDescent _ 0)))
|
||||
(for N (WIDTH _ (FIX (QUOTIENT (TIMES 3 SIZE)
|
||||
4))) from 0 to \MAXTHINCHAR
|
||||
do (\FSETWIDTH WIDTHSBLOCK N WIDTH))
|
||||
(\SETCHARSETINFO FONTDESCRIPTOR 0
|
||||
(create CHARSETINFO
|
||||
WIDTHS _ WIDTHSBLOCK
|
||||
IMAGEWIDTHS _ WIDTHSBLOCK
|
||||
CHARSETASCENT _ SIZE
|
||||
CHARSETDESCENT _ 0))
|
||||
FONTDESCRIPTOR)
|
||||
else (FONTCREATE (create FONTSPEC using FONTSPEC FSFAMILY _ (CAAR HPGL.FONTS])
|
||||
|
||||
(\INIT.HPGL
|
||||
[LAMBDA NIL (* ; "Edited 20-Jul-88 17:04 by cdl")
|
||||
[LAMBDA NIL (* ; "Edited 20-Jul-88 17:04 by cdl")
|
||||
(* DECLARATIONS%: (RECORD CLASS
|
||||
(FONTCLASSNAME PRETTYFONT# DISPLAYFD
|
||||
PRESSFD INTERPRESSFD . OTHERFDS)))
|
||||
(FONTCLASSNAME PRETTYFONT# DISPLAYFD
|
||||
PRESSFD INTERPRESSFD . OTHERFDS)))
|
||||
(DECLARE (GLOBALVARS FONTDEFS FONTNAME))
|
||||
(SETQ \NULLFDEV (create FDEV
|
||||
CLOSEFILE _ (FUNCTION NILL)))
|
||||
@@ -579,16 +567,14 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
|
||||
IMROTATE _ (FUNCTION \ROTATE.HPGL)))
|
||||
(for FONTSET in FONTDEFS
|
||||
do [for CLASS in (CDR (ASSOC 'FONTPROFILE (CDR FONTSET)))
|
||||
unless (with CLASS CLASS (OR (NULL DISPLAYFD)
|
||||
(NULL INTERPRESSFD)
|
||||
(ASSOC 'HPGL OTHERFDS)))
|
||||
do (with CLASS CLASS (push
|
||||
OTHERFDS
|
||||
(LIST 'HPGL (CONS 'STANDARD
|
||||
(CDR (if (LISTP DISPLAYFD)
|
||||
then DISPLAYFD
|
||||
else (FONTUNPARSE
|
||||
DISPLAYFD]
|
||||
unless (with CLASS CLASS (OR (NULL DISPLAYFD)
|
||||
(NULL INTERPRESSFD)
|
||||
(ASSOC 'HPGL OTHERFDS)))
|
||||
do (with CLASS CLASS (push OTHERFDS (LIST 'HPGL (CONS 'STANDARD
|
||||
(CDR (if (LISTP DISPLAYFD)
|
||||
then DISPLAYFD
|
||||
else (FONTUNPARSE DISPLAYFD
|
||||
]
|
||||
finally (FONTSET FONTNAME])
|
||||
|
||||
(\OUTCHAR.HPGL
|
||||
@@ -603,10 +589,13 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
|
||||
(push PD.TEXT CHARCODE])
|
||||
|
||||
(\SEARCH.HPGL.FONTS
|
||||
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* cdl " 1-May-85 09:34")
|
||||
(if (EQ DEVICE 'HPGL)
|
||||
then (if (FASSOC FAMILY HPGL.FONTS)
|
||||
then (LIST (LIST FAMILY SIZE FACE ROTATION DEVICE])
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 28-Jan-2026 00:53 by rmk")
|
||||
(* cdl " 1-May-85 09:34")
|
||||
(CL:WHEN (AND (EQ (fetch (FONTSPEC FSDEVICE) of FONTSPEC)
|
||||
'HPGL)
|
||||
(FASSOC (fetch (FONTSPEC FSFAMILY) of FONTSPEC)
|
||||
HPGL.FONTS)) (* ; "Make a copy?")
|
||||
(create FONTSPEC using FONTSPEC))])
|
||||
|
||||
(\FILL.HPGL
|
||||
[LAMBDA (STREAM TEXTURE) (* ; "Edited 8-Dec-87 16:56 by cdl")
|
||||
@@ -679,41 +668,43 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
|
||||
(* * etc.)
|
||||
|
||||
|
||||
(RPAQQ HPGL.FONTS ((STANDARD . 0)
|
||||
(9825 . 1)
|
||||
(FRENCH . 2)
|
||||
(SCANDINAVIAN . 3)
|
||||
(SPANISH . 4)
|
||||
(JISASCII . 6)
|
||||
(ROMAN . 7)
|
||||
(KATAKANA . 8)
|
||||
(IRV . 9)
|
||||
(SWEDISH . 30)
|
||||
(SWEDISH2 . 31)
|
||||
(NORWAY . 32)
|
||||
(GERMAN . 33)
|
||||
(FRENCH2 . 34)
|
||||
(BRITISH . 35)
|
||||
(ITALIAN . 36)
|
||||
(SPANISH2 . 37)
|
||||
(PORTUGUESE . 38)
|
||||
(NORWAY2 . 39)))
|
||||
(RPAQQ HPGL.FONTS
|
||||
((STANDARD . 0)
|
||||
(9825 . 1)
|
||||
(FRENCH . 2)
|
||||
(SCANDINAVIAN . 3)
|
||||
(SPANISH . 4)
|
||||
(JISASCII . 6)
|
||||
(ROMAN . 7)
|
||||
(KATAKANA . 8)
|
||||
(IRV . 9)
|
||||
(SWEDISH . 30)
|
||||
(SWEDISH2 . 31)
|
||||
(NORWAY . 32)
|
||||
(GERMAN . 33)
|
||||
(FRENCH2 . 34)
|
||||
(BRITISH . 35)
|
||||
(ITALIAN . 36)
|
||||
(SPANISH2 . 37)
|
||||
(PORTUGUESE . 38)
|
||||
(NORWAY2 . 39)))
|
||||
|
||||
(RPAQQ HPGL.OPTIONS ((ROTATE . "RO")
|
||||
(VELOCITY . "VS")
|
||||
(PAPER . "PS")
|
||||
(TERMINATOR . "DT")))
|
||||
(VELOCITY . "VS")
|
||||
(PAPER . "PS")
|
||||
(TERMINATOR . "DT")))
|
||||
|
||||
(RPAQQ HPGL.FONT.EXPANSIONS ((REGULAR . 200.0)
|
||||
(COMPRESSED . 100.0)
|
||||
(EXPANDED . 400.0)))
|
||||
(COMPRESSED . 100.0)
|
||||
(EXPANDED . 400.0)))
|
||||
|
||||
(RPAQQ HPGL.DASHING ((1 1 49)
|
||||
(2 25)
|
||||
(3 35 15)
|
||||
(4 39 5 1 5)
|
||||
(5 35 5 5 5)
|
||||
(6 25 5 5 5 5 5)))
|
||||
(RPAQQ HPGL.DASHING
|
||||
((1 1 49)
|
||||
(2 25)
|
||||
(3 35 15)
|
||||
(4 39 5 1 5)
|
||||
(5 35 5 5 5)
|
||||
(6 25 5 5 5 5 5)))
|
||||
|
||||
(RPAQQ SKETCHINCOLORFLG T)
|
||||
|
||||
@@ -742,63 +733,55 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
|
||||
(FILESLOAD UTILISOPRS)
|
||||
|
||||
|
||||
(ADDTOVAR PRINTOUTMACROS [!, (LAMBDA (COMS)
|
||||
(CONS '(PRIN1 HPGL.SEPARATOR NIL)
|
||||
(CDR COMS]
|
||||
[!; (LAMBDA (COMS)
|
||||
(CONS '(PRIN1 HPGL.TERMINATOR NIL)
|
||||
(CDR COMS]
|
||||
[!!; (LAMBDA (COMS)
|
||||
(CONS '(PRIN1 HPGL.TEXT.TERMINATOR NIL)
|
||||
(CDR COMS])
|
||||
(ADDTOVAR PRINTOUTMACROS
|
||||
[!, (LAMBDA (COMS)
|
||||
(CONS '(PRIN1 HPGL.SEPARATOR NIL)
|
||||
(CDR COMS]
|
||||
[!; (LAMBDA (COMS)
|
||||
(CONS '(PRIN1 HPGL.TERMINATOR NIL)
|
||||
(CDR COMS]
|
||||
[!!; (LAMBDA (COMS)
|
||||
(CONS '(PRIN1 HPGL.TEXT.TERMINATOR NIL)
|
||||
(CDR COMS])
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD PLOTTERDATA (PD.STREAM PD.POSITION PD.FONT PD.TEXT PD.COLOR PD.SCALE PD.LEFTMARGIN
|
||||
PD.RIGHTMARGIN PD.DASHING PD.ROTATION)
|
||||
PD.POSITION _ (create POSITION)
|
||||
PD.COLOR _ 0 PD.LEFTMARGIN _ 0 PD.ROTATION _ 0)
|
||||
PD.RIGHTMARGIN PD.DASHING PD.ROTATION)
|
||||
PD.POSITION _ (create POSITION)
|
||||
PD.COLOR _ 0 PD.LEFTMARGIN _ 0 PD.ROTATION _ 0)
|
||||
)
|
||||
)
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES (HPGL (EXTENSION (HPGL PLOT))
|
||||
(BITMAPFILE (HARDCOPYW.HPGL FILE BITMAP SCALEFACTOR REGION ROTATION
|
||||
TITLE))))
|
||||
|
||||
(ADDTOVAR PRINTERTYPES ((PLOTTER HPGL)
|
||||
(CANPRINT (HPGL))
|
||||
(STATUS TRUE)
|
||||
(BITMAPFILE (HARDCOPYW.HPGL FILE BITMAP SCALEFACTOR REGION ROTATION TITLE
|
||||
))
|
||||
(PROPERTIES NILL)))
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES [HPGL (EXTENSION (HPGL PLOT))
|
||||
(CONVERSION (TEXT MAKEHPGL TEDIT
|
||||
(LAMBDA (FILE PFILE)
|
||||
(SETQ FILE (OPENTEXTSTREAM FILE))
|
||||
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL
|
||||
NIL NIL 'HPGL)
|
||||
(CLOSEF? FILE)
|
||||
PFILE])
|
||||
(CANPRINT (HPGL))
|
||||
(STATUS TRUE)
|
||||
(PROPERTIES NILL)))
|
||||
|
||||
(ADDTOVAR IMAGESTREAMTYPES (HPGL (OPENSTREAM OPENHPGLSTREAM)
|
||||
(FONTCREATE \FONTCREATE.HPGL)
|
||||
(FONTSAVAILABLE \SEARCH.HPGL.FONTS)
|
||||
(CREATECHARSET NILL)))
|
||||
(FONTCREATE \FONTCREATE.HPGL)
|
||||
(FONTSAVAILABLE \SEARCH.HPGL.FONTS)
|
||||
(CREATECHARSET NILL)))
|
||||
|
||||
[if (FGETD (FUNCTION SK.DASHING.LABEL))
|
||||
then (for ENTRY in HPGL.DASHING do (push SK.DASHING.PATTERNS
|
||||
(LIST (SK.DASHING.LABEL (CDR ENTRY))
|
||||
(CDR ENTRY]
|
||||
then (for ENTRY in HPGL.DASHING do (push SK.DASHING.PATTERNS (LIST (SK.DASHING.LABEL (CDR ENTRY))
|
||||
(CDR ENTRY]
|
||||
|
||||
(\INIT.HPGL)
|
||||
(PUTPROPS HPGL COPYRIGHT ("Stanford University" 1985 1986 1987 1988))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3583 6000 (MAKEHPGL 3593 . 3756) (OPENHPGLSTREAM 3758 . 5715) (HARDCOPYW.HPGL 5717 .
|
||||
5998)) (6031 29802 (\BITBLT.HPGL 6041 . 8018) (\BLTSHADE.HPGL 8020 . 9173) (\CLOSEFN.HPGL 9175 . 9503)
|
||||
(\COLOR.HPGL 9505 . 11429) (\DRAWARC.HPGL 11431 . 12940) (\DRAWCIRCLE.HPGL 12942 . 14285) (
|
||||
\DRAWCURVE.HPGL 14287 . 15076) (\DRAWLINE.HPGL 15078 . 17236) (\DRAWPOLYGON.HPGL 17238 . 18904) (
|
||||
\FILLCIRCLE.HPGL 18906 . 19622) (\FONT.HPGL 19624 . 23275) (\LEFTMARGIN.HPGL 23277 . 23578) (
|
||||
\LINEFEED.HPGL 23580 . 23823) (\MOVETO.HPGL 23825 . 24303) (\RESET.HPGL 24305 . 24674) (
|
||||
\RIGHTMARGIN.HPGL 24676 . 24980) (\ROTATE.HPGL 24982 . 25356) (\SCALEDBITBLT.HPGL 25358 . 27641) (
|
||||
\STRINGWIDTH.HPGL 27643 . 27826) (\CLIPPINGREGION.HPGL 27828 . 28133) (\TERPRI.HPGL 28135 . 28492) (
|
||||
\XPOSITION.HPGL 28494 . 29156) (\YPOSITION.HPGL 29158 . 29800)) (29834 40881 (\DUMPSTRING.HPGL 29844
|
||||
. 30316) (\FONTCREATE.HPGL 30318 . 31926) (\INIT.HPGL 31928 . 35493) (\OUTCHAR.HPGL 35495 . 36108) (
|
||||
\SEARCH.HPGL.FONTS 36110 . 36383) (\FILL.HPGL 36385 . 39041) (\DASHING.HPGL 39043 . 40879)))))
|
||||
(FILEMAP (NIL (2696 5094 (OPENHPGLSTREAM 2706 . 4809) (HARDCOPYW.HPGL 4811 . 5092)) (5125 28896 (
|
||||
\BITBLT.HPGL 5135 . 7112) (\BLTSHADE.HPGL 7114 . 8267) (\CLOSEFN.HPGL 8269 . 8597) (\COLOR.HPGL 8599
|
||||
. 10523) (\DRAWARC.HPGL 10525 . 12034) (\DRAWCIRCLE.HPGL 12036 . 13379) (\DRAWCURVE.HPGL 13381 .
|
||||
14170) (\DRAWLINE.HPGL 14172 . 16330) (\DRAWPOLYGON.HPGL 16332 . 17998) (\FILLCIRCLE.HPGL 18000 .
|
||||
18716) (\FONT.HPGL 18718 . 22369) (\LEFTMARGIN.HPGL 22371 . 22672) (\LINEFEED.HPGL 22674 . 22917) (
|
||||
\MOVETO.HPGL 22919 . 23397) (\RESET.HPGL 23399 . 23768) (\RIGHTMARGIN.HPGL 23770 . 24074) (
|
||||
\ROTATE.HPGL 24076 . 24450) (\SCALEDBITBLT.HPGL 24452 . 26735) (\STRINGWIDTH.HPGL 26737 . 26920) (
|
||||
\CLIPPINGREGION.HPGL 26922 . 27227) (\TERPRI.HPGL 27229 . 27586) (\XPOSITION.HPGL 27588 . 28250) (
|
||||
\YPOSITION.HPGL 28252 . 28894)) (28928 40323 (\DUMPSTRING.HPGL 28938 . 29410) (\FONTCREATE.HPGL 29412
|
||||
. 31221) (\INIT.HPGL 31223 . 34674) (\OUTCHAR.HPGL 34676 . 35289) (\SEARCH.HPGL.FONTS 35291 . 35825)
|
||||
(\FILL.HPGL 35827 . 38483) (\DASHING.HPGL 38485 . 40321)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,18 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" ( USE "XCL" "LISP") ( EXPORT "READ-BDF" "BUILD-COMPOSITE"
|
||||
"WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") ( IMPORT-FROM "IL" "BITBLT" "BITMAPBIT" "BITMAPCREATE"
|
||||
"BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "CHARSETPROP"
|
||||
"DISPLAY" "FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MCCS" "MEDIUM"
|
||||
"REGULAR" "TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE
|
||||
10)
|
||||
"BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY"
|
||||
"FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MCCS" "MEDIUM" "REGULAR" "TCONC"
|
||||
"UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE 10)
|
||||
|
||||
(IL:FILECREATED " 8-Dec-2025 12:13:40" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;9| 51309
|
||||
(IL:FILECREATED "23-Feb-2026 20:11:48" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;20| 54795
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR)
|
||||
(FILE-ENVIRONMENTS "READ-BDF")
|
||||
:CHANGES-TO (IL:FUNCTIONS READ-GLYPH)
|
||||
|
||||
:PREVIOUS-DATE " 8-Dec-2025 12:12:47" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;8|
|
||||
:PREVIOUS-DATE "23-Feb-2026 17:38:07" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;19|
|
||||
)
|
||||
|
||||
|
||||
@@ -20,7 +18,7 @@
|
||||
|
||||
(IL:RPAQQ IL:READ-BDFCOMS
|
||||
((IL:STRUCTURES BDF-FONT GLYPH XLFD)
|
||||
(IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET)
|
||||
(IL:VARIABLES GLYPH-PROCESSING-HOOK MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET)
|
||||
(IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR BUILD-COMPOSITE CHAR-PRESENT-BIT
|
||||
COUNT-MCHARS GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF
|
||||
READ-DELIMITED-LIST-FROM-STRING READ-GLYPH WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE
|
||||
@@ -71,6 +69,8 @@
|
||||
(CHARSET昱EGISTRY NIL :TYPE STRING)
|
||||
(CHARSET挂NCODING NIL :TYPE STRING))
|
||||
|
||||
(DEFVAR GLYPH-PROCESSING-HOOK NIL)
|
||||
|
||||
(DEFCONSTANT MAXCHARSET 255)
|
||||
|
||||
(DEFCONSTANT MAXTHINCHAR 255)
|
||||
@@ -126,7 +126,7 @@
|
||||
(IMAGEWIDTHS (IL:\\CREATECSINFOELEMENT))
|
||||
(DLEFT 0)
|
||||
GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS)
|
||||
(CHARSETPROP CSINFO 'IL:CSCHARENCODING 'MCCS)
|
||||
(IL:CHARSETPROP CSINFO 'IL:CSCHARENCODING 'MCCS)
|
||||
(LOOP :FOR XGL :IN CSGLYPHS :DO (LET* ((MCODE (CAR XGL))
|
||||
(GL (CDR XGL))
|
||||
(GWIDTH (GLYPH-WIDTH GL))
|
||||
@@ -309,7 +309,9 @@
|
||||
(LIST CSET)))))
|
||||
(LIST FONTDESC CHARSETS))))
|
||||
|
||||
(DEFUN BUILD-COMPOSITE (FONTS &KEY VERBOSE) (IL:* IL:\; "Edited 1-Dec-2025 23:07 by mth")
|
||||
(DEFUN BUILD-COMPOSITE (FONTS &KEY VERBOSE (BLOCKING T))
|
||||
(IL:* IL:\; "Edited 19-Feb-2026 21:45 by mth")
|
||||
(IL:* IL:\; "Edited 1-Dec-2025 23:07 by mth")
|
||||
(IL:* IL:\; "Edited 30-Nov-2025 12:32 by mth")
|
||||
(IL:* IL:\; "Edited 26-Nov-2025 21:23 by mth")
|
||||
(IL:* IL:\; "Edited 18-Nov-2025 21:22 by mth")
|
||||
@@ -327,53 +329,61 @@
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Loading initial font file: ~A~%" (NAMESTRING BASE-FONT)
|
||||
))
|
||||
(SETQ BASE-FONT (READ-BDF BASE-FONT :MCCS-ONLY T :VERBOSE VERBOSE)))
|
||||
(SETQ BASE-FONT (READ-BDF BASE-FONT :MCCS-ONLY T :VERBOSE VERBOSE))
|
||||
(WHEN BLOCKING (IL:BLOCK)))
|
||||
((NOT (BDF-FONT-P BASE-FONT))
|
||||
(ERROR "Initial font (~S) is not a BDF-FONT, nor string, nor pathname." BASE-FONT)))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Initial font contains ~D MCCS characters.~%"
|
||||
(SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))))
|
||||
(SETQ MCHAR-PRESENT (BF-MCHAR-PRESENT BASE-FONT))
|
||||
(LOOP :FOR FILL-FONT :IN FILL-FROM :WITH PREV-CC :WHEN FILL-FONT :DO
|
||||
(COND
|
||||
((OR (STRINGP FILL-FONT)
|
||||
(PATHNAMEP FILL-FONT))
|
||||
(UNLESS (IL:INFILEP FILL-FONT)
|
||||
(ERROR "Subsequent font ~S doesn't exist or is unreadable." (NAMESTRING
|
||||
FILL-FONT)))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Loading subsequent font file: ~A~%" (NAMESTRING
|
||||
FILL-FONT)))
|
||||
(SETQ FILL-FONT (READ-BDF FILL-FONT :MCCS-ONLY T :VERBOSE VERBOSE)))
|
||||
((NOT (BDF-FONT-P FILL-FONT))
|
||||
(ERROR "Subsequent font (~S) is not a BDF-FONT, nor string, nor pathname."
|
||||
FILL-FONT)))
|
||||
(SETQ PREV-CC CHAR-COUNT)
|
||||
(LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT)
|
||||
:WITH V :DO (SETQ V (GLYPH-ENCODING GL))
|
||||
(WHEN (AND (LISTP V)
|
||||
(EQ (FIRST V)
|
||||
-1))
|
||||
(SETQ V (OR (SECOND V)
|
||||
-1)))
|
||||
(LOOP :FOR FILL-FONT :IN FILL-FROM :WITH PREV-CC :WITH FF-NAME :WHEN FILL-FONT :DO
|
||||
(FLET ((MERGE-GLYPH (GL &AUX V)
|
||||
(SETQ V (GLYPH-ENCODING GL))
|
||||
(WHEN (AND (LISTP V)
|
||||
(EQ (FIRST V)
|
||||
-1))
|
||||
(SETQ V (OR (SECOND V)
|
||||
-1)))
|
||||
|
||||
(IL:* IL:|;;|
|
||||
(IL:* IL:|;;|
|
||||
"Need to change this use of UTOMCODE? based on the CHARSET昱EGISTRY of the XLFD of FILL-FONT")
|
||||
|
||||
(WHEN (AND (UTOMCODE? V)
|
||||
(ZEROP (CHAR-PRESENT-BIT MCHAR-PRESENT V)))
|
||||
(CHAR-PRESENT-BIT MCHAR-PRESENT V 1)
|
||||
(WHEN (AND (UTOMCODE? V)
|
||||
(ZEROP (CHAR-PRESENT-BIT MCHAR-PRESENT V)))
|
||||
(CHAR-PRESENT-BIT MCHAR-PRESENT V 1)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
(IL:* IL:|;;|
|
||||
"What other bookkeping of BASE-FONT needs to be done when adding a glyph? Any?")
|
||||
|
||||
(PUSH GL (BF-GLYPHS BASE-FONT))))
|
||||
(SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Font ~A supplied ~D additional MCCS characters.~%"
|
||||
(NAMESTRING FILL-FONT)
|
||||
(- (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))
|
||||
PREV-CC))))
|
||||
(PUSH GL (BF-GLYPHS BASE-FONT)))
|
||||
NIL))
|
||||
(COND
|
||||
((OR (STRINGP FILL-FONT)
|
||||
(PATHNAMEP FILL-FONT))
|
||||
(SETQ FF-NAME (NAMESTRING FILL-FONT))
|
||||
(UNLESS (IL:INFILEP FILL-FONT)
|
||||
(ERROR "Subsequent font ~S doesn't exist or is unreadable." FF-NAME))
|
||||
(WHEN VERBOSE (FORMAT *STANDARD-OUTPUT*
|
||||
"~&Loading subsequent font file: ~A~%" FF-NAME))
|
||||
(LET ((GLYPH-PROCESSING-HOOK #'MERGE-GLYPH))
|
||||
(READ-BDF FILL-FONT :MCCS-ONLY T :VERBOSE VERBOSE)
|
||||
(SETQ FILL-FONT NIL))
|
||||
(WHEN BLOCKING (IL:BLOCK)))
|
||||
((NOT (BDF-FONT-P FILL-FONT))
|
||||
(ERROR "Subsequent font (~S) is not a BDF-FONT, nor string, nor pathname."
|
||||
FF-NAME)))
|
||||
(SETQ PREV-CC CHAR-COUNT)
|
||||
(WHEN FILL-FONT
|
||||
(LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT)
|
||||
:DO
|
||||
(MERGE-GLYPH GL)))
|
||||
(SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT*
|
||||
"~&Font ~A supplied ~D additional MCCS characters.~%" FF-NAME
|
||||
(- (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))
|
||||
PREV-CC)))))
|
||||
BASE-FONT))
|
||||
|
||||
(DEFUN CHAR-PRESENT-BIT (BM MCODE &OPTIONAL (NEWBIT -1 SBIT)
|
||||
@@ -472,6 +482,7 @@
|
||||
Y))))
|
||||
|
||||
(DEFUN READ-BDF (PATH &KEY VERBOSE MCCS-ONLY (EXTERNAL-FORMAT :ISO8859/1))
|
||||
(IL:* IL:\; "Edited 19-Feb-2026 21:42 by mth")
|
||||
(IL:* IL:\; "Edited 1-Dec-2025 22:40 by mth")
|
||||
(IL:* IL:\; "Edited 30-Nov-2025 11:59 by mth")
|
||||
(IL:* IL:\; "Edited 28-Nov-2025 17:39 by mth")
|
||||
@@ -586,13 +597,12 @@
|
||||
(PLUSP NGLYPHS))
|
||||
(ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing."
|
||||
NGLYPHS))
|
||||
(LOOP :REPEAT NGLYPHS :WITH ENC :WITH MC :DO (SETQ GL (READ-GLYPH
|
||||
FILE-STREAM
|
||||
FONT))
|
||||
(LOOP :REPEAT NGLYPHS :WITH ENC :WITH MC :DO
|
||||
(SETQ GL (READ-GLYPH FILE-STREAM FONT :MCCS-ONLY MCCS-ONLY))
|
||||
(SETQ ENC (GLYPH-ENCODING GL))
|
||||
(WHEN (AND (LISTP ENC)
|
||||
(EQ (FIRST ENC)
|
||||
-1))
|
||||
(EQL (FIRST ENC)
|
||||
-1))
|
||||
(SETQ ENC (OR (SECOND ENC)
|
||||
-1)))
|
||||
(COND
|
||||
@@ -615,143 +625,195 @@
|
||||
|
||||
(IL:* IL:|;;| "It ought to be safe to share the bitmap")
|
||||
|
||||
(TCONC MAPPED-GLYPHS CGL)
|
||||
(WHEN (AND GLYPH-PROCESSING-HOOK (FUNCTIONP
|
||||
GLYPH-PROCESSING-HOOK
|
||||
))
|
||||
(SETQ CGL (FUNCALL GLYPH-PROCESSING-HOOK CGL)))
|
||||
(WHEN CGL (TCONC MAPPED-GLYPHS CGL))
|
||||
(CHAR-PRESENT-BIT MCHAR-PRESENT CC 1)))
|
||||
(T (TCONC UNMAPPED-GLYPHS GL))))
|
||||
((NOT MCCS-ONLY)
|
||||
(WHEN (AND GLYPH-PROCESSING-HOOK (FUNCTIONP GLYPH-PROCESSING-HOOK)
|
||||
)
|
||||
(SETQ GL (FUNCALL GLYPH-PROCESSING-HOOK GL)))
|
||||
(WHEN GL (TCONC UNMAPPED-GLYPHS GL)))))
|
||||
(SETF (BF-GLYPHS FONT)
|
||||
(CAR MAPPED-GLYPHS))
|
||||
(SETF (BF-UNMAPPED故LYPHS FONT)
|
||||
(CAR UNMAPPED-GLYPHS)))
|
||||
(ENDFONT (SETQ FONT-COMPLETE T))))))))
|
||||
(WHEN VERBOSE
|
||||
(ENDFONT (SETQ FONT-COMPLETE T)))))))))
|
||||
(WHEN VERBOSE
|
||||
|
||||
(IL:* IL:|;;| "The SIZE reported needs clarification:")
|
||||
(IL:* IL:|;;| "The SIZE reported needs clarification:")
|
||||
|
||||
(FORMAT *STANDARD-OUTPUT* "Name: ~A~%Family: ~A~%Sizes: Font: ~A Pixel: ~A Point: ~A (decipoints)~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%"
|
||||
(BF-NAME FONT)
|
||||
(XLFD-FAMILY XLFD)
|
||||
(FIRST (BF-SIZE FONT))
|
||||
(XLFD-PIXEL昤IZE XLFD)
|
||||
(XLFD-POINT昤IZE XLFD)
|
||||
(XLFD-WEIGHT XLFD)
|
||||
(XLFD-SLANT XLFD)
|
||||
(XLFD-SETWIDTH昧AME XLFD)))
|
||||
FONT)))
|
||||
(FORMAT *STANDARD-OUTPUT* "Name: ~A~%Family: ~A~%Sizes: Font: ~A Pixel: ~A Point: ~A (decipoints)~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%Glyphs: ~D~%Unmapped glyphs: ~D~%"
|
||||
(BF-NAME FONT)
|
||||
(XLFD-FAMILY XLFD)
|
||||
(FIRST (BF-SIZE FONT))
|
||||
(XLFD-PIXEL昤IZE XLFD)
|
||||
(XLFD-POINT昤IZE XLFD)
|
||||
(XLFD-WEIGHT XLFD)
|
||||
(XLFD-SLANT XLFD)
|
||||
(XLFD-SETWIDTH昧AME XLFD)
|
||||
(LENGTH (BF-GLYPHS FONT))
|
||||
(LENGTH (BF-UNMAPPED故LYPHS FONT))))
|
||||
FONT))
|
||||
|
||||
(DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\]))
|
||||
(IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth")
|
||||
(WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT)))
|
||||
(READ-DELIMITED-LIST DELIMIT SI)))
|
||||
|
||||
(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 26-Nov-2025 23:32 by mth")
|
||||
(DEFUN READ-GLYPH (FILE-STREAM FONT &KEY MCCS-ONLY) (IL:* IL:\; "Edited 23-Feb-2026 20:11 by mth")
|
||||
(IL:* IL:\; "Edited 19-Feb-2026 15:46 by mth")
|
||||
(IL:* IL:\; "Edited 26-Nov-2025 23:32 by mth")
|
||||
(IL:* IL:\; "Edited 17-Nov-2025 20:03 by mth")
|
||||
(IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth")
|
||||
(IL:* IL:\; "Edited 21-Apr-2025 13:37 by mth")
|
||||
(IL:* IL:\; "Edited 19-Apr-2025 09:32 by mth")
|
||||
(IL:* IL:\; "Edited 17-Apr-2025 18:14 by mth")
|
||||
(IL:* IL:\; "Edited 21-Aug-2024 01:10 by mth")
|
||||
(LET ((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT))
|
||||
:DWIDTH
|
||||
(COPY-LIST (BF-DWIDTH FONT))
|
||||
:SWIDTH1
|
||||
(COPY-LIST (BF-SWIDTH1 FONT))
|
||||
:DWIDTH1
|
||||
(COPY-LIST (BF-DWIDTH1 FONT))
|
||||
:VVECTOR
|
||||
(COPY-LIST (BF-VVECTOR FONT))))
|
||||
CHAR-COMPLETE LINE ITEMS V KEY POS STARTED BBW BBH)
|
||||
(LOOP :UNTIL CHAR-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM))
|
||||
(WHEN LINE (IL:* IL:\; "Ignore blank lines")
|
||||
(MULTIPLE-VALUE-SETQ (KEY POS)
|
||||
(READ-FROM-STRING LINE))
|
||||
(WHEN (<= POS (LENGTH LINE))
|
||||
(SETQ LINE (SUBSEQ LINE POS)))
|
||||
(COND
|
||||
((EQ KEY 'COMMENT) (IL:* IL:\; "Ignore COMMENT lines")
|
||||
(LET
|
||||
((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT))
|
||||
:DWIDTH
|
||||
(COPY-LIST (BF-DWIDTH FONT))
|
||||
:SWIDTH1
|
||||
(COPY-LIST (BF-SWIDTH1 FONT))
|
||||
:DWIDTH1
|
||||
(COPY-LIST (BF-DWIDTH1 FONT))
|
||||
:VVECTOR
|
||||
(COPY-LIST (BF-VVECTOR FONT))))
|
||||
CHAR-COMPLETE ENC LINE ITEMS V KEY POS STARTED BBW BBH)
|
||||
(LOOP
|
||||
:UNTIL CHAR-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM))
|
||||
(WHEN LINE (IL:* IL:\; "Ignore blank lines")
|
||||
(MULTIPLE-VALUE-SETQ (KEY POS)
|
||||
(READ-FROM-STRING LINE))
|
||||
(WHEN (<= POS (LENGTH LINE))
|
||||
(SETQ LINE (SUBSEQ LINE POS)))
|
||||
(COND
|
||||
((EQ KEY 'COMMENT) (IL:* IL:\; "Ignore COMMENT lines")
|
||||
(IL:* IL:\;
|
||||
"Probably aren't \"legal\" here, anyway.")
|
||||
)
|
||||
((EQ KEY 'STARTCHAR)
|
||||
(WHEN STARTED (ERROR "Invalid BDF file - STARTCHAR inside glyph."))
|
||||
(SETF STARTED T)
|
||||
(SETF (GLYPH-NAME GLYPH)
|
||||
(STRING LINE)))
|
||||
(T (UNLESS STARTED (ERROR
|
||||
)
|
||||
((EQ KEY 'STARTCHAR)
|
||||
(WHEN STARTED (ERROR "Invalid BDF file - STARTCHAR inside glyph."))
|
||||
(SETF STARTED T)
|
||||
(SETF (GLYPH-NAME GLYPH)
|
||||
(STRING LINE)))
|
||||
(T
|
||||
(UNLESS STARTED (ERROR
|
||||
"Invalid BDF file - glyph has not been started. STARTCHAR missing."
|
||||
))
|
||||
(SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE))
|
||||
(CASE KEY
|
||||
(ENCODING (SETF (GLYPH-ENCODING GLYPH)
|
||||
(IF (EQL -1 (FIRST ITEMS))
|
||||
ITEMS
|
||||
(FIRST ITEMS))))
|
||||
(SWIDTH (SETF (GLYPH-SWIDTH GLYPH)
|
||||
ITEMS))
|
||||
(DWIDTH (SETF (GLYPH-DWIDTH GLYPH)
|
||||
ITEMS))
|
||||
(SWIDTH1 (SETF (GLYPH-SWIDTH1 GLYPH)
|
||||
ITEMS))
|
||||
(DWIDTH1 (SETF (GLYPH-DWIDTH1 GLYPH)
|
||||
ITEMS))
|
||||
(VVECTOR (SETF (GLYPH-VVECTOR GLYPH)
|
||||
ITEMS))
|
||||
(BBX (SETF (GLYPH-BBW GLYPH)
|
||||
(SETQ BBW (FIRST ITEMS))
|
||||
(GLYPH-BBH GLYPH)
|
||||
(SETQ BBH (SECOND ITEMS))
|
||||
(GLYPH-BBXOFF0 GLYPH)
|
||||
(THIRD ITEMS)
|
||||
(GLYPH-BBYOFF0 GLYPH)
|
||||
(FOURTH ITEMS)))
|
||||
(BITMAP (UNLESS (ZEROP (* BBW BBH))
|
||||
))
|
||||
(SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE))
|
||||
(CASE KEY
|
||||
(ENCODING (SETF (GLYPH-ENCODING GLYPH)
|
||||
(SETQ ENC (IF (EQL -1 (FIRST ITEMS))
|
||||
ITEMS
|
||||
(FIRST ITEMS)))))
|
||||
(SWIDTH (SETF (GLYPH-SWIDTH GLYPH)
|
||||
ITEMS))
|
||||
(DWIDTH (SETF (GLYPH-DWIDTH GLYPH)
|
||||
ITEMS))
|
||||
(SWIDTH1 (SETF (GLYPH-SWIDTH1 GLYPH)
|
||||
ITEMS))
|
||||
(DWIDTH1 (SETF (GLYPH-DWIDTH1 GLYPH)
|
||||
ITEMS))
|
||||
(VVECTOR (SETF (GLYPH-VVECTOR GLYPH)
|
||||
ITEMS))
|
||||
(BBX (SETF (GLYPH-BBW GLYPH)
|
||||
(SETQ BBW (FIRST ITEMS))
|
||||
(GLYPH-BBH GLYPH)
|
||||
(SETQ BBH (SECOND ITEMS))
|
||||
(GLYPH-BBXOFF0 GLYPH)
|
||||
(THIRD ITEMS)
|
||||
(GLYPH-BBYOFF0 GLYPH)
|
||||
(FOURTH ITEMS)))
|
||||
(BITMAP
|
||||
(UNLESS (ZEROP (* BBW BBH)) (IL:* IL:\;
|
||||
"Don't bother creating a BITMAP with no area")
|
||||
(IF (AND MCCS-ONLY (NOT (UTOMCODE? ENC)))
|
||||
(PROGN
|
||||
(IL:* IL:|;;|
|
||||
"This is the case of skipping over non-MCCS encoded glyph when MCCS-ONLY")
|
||||
|
||||
(IL:* IL:|;;| "Don't bother creating a BITMAP with no area")
|
||||
(LOOP :REPEAT BBH :DO (READ-LINE FILE-STREAM)))
|
||||
(LET*
|
||||
((BM (BITMAPCREATE BBW BBH 1))
|
||||
(BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM))
|
||||
(BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH IL:|of| BM))
|
||||
(NBYTES (CEILING BBW 8))
|
||||
(NCHARS (* 2 NBYTES))
|
||||
(NWORDS (CEILING BBW 16))
|
||||
BITS WORDINDEX)
|
||||
(LABELS ((CHAR-HEX-VALUE (C)
|
||||
(IF (CHARACTERP C)
|
||||
(COND
|
||||
((CHAR<= #\0 C #\9)
|
||||
(- (CHAR-CODE C)
|
||||
(IL:CONSTANT (CHAR-CODE #\0))))
|
||||
((CHAR<= #\A C #\F)
|
||||
|
||||
(LET* ((BM (BITMAPCREATE BBW BBH 1))
|
||||
(BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM))
|
||||
(BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH
|
||||
IL:|of| BM))
|
||||
(NBYTES (CEILING BBW 8))
|
||||
(NCHARS (* 2 NBYTES))
|
||||
(NWORDS (CEILING BBW 16))
|
||||
BITS BYTEPOS WORDINDEX)
|
||||
(LOOP :WITH BITROW = 0 :REPEAT BBH :DO
|
||||
(SETQ LINE (STRING-TRIM '(#\Space #\Tab)
|
||||
(READ-LINE FILE-STREAM)))
|
||||
(UNLESS (AND (EQUAL NCHARS (LENGTH LINE))
|
||||
(SETQ BITS
|
||||
(PARSE-INTEGER LINE :RADIX 16
|
||||
:JUNK-ALLOWED T)))
|
||||
(ERROR
|
||||
"Invalid BDF file - bad line in BITMAP: ~A"
|
||||
LINE))
|
||||
(WHEN (ODDP NBYTES)
|
||||
(SETQ BITS (ASH BITS 8)))
|
||||
(SETQ WORDINDEX (* BITROW BM.RASTERWIDTH))
|
||||
(SETQ BYTEPOS (* 16 (1- NWORDS)))
|
||||
(LOOP :REPEAT NWORDS :DO
|
||||
(IL:\\PUTBASE BM.BASE WORDINDEX
|
||||
(LDB (BYTE 16 BYTEPOS)
|
||||
BITS))
|
||||
(INCF WORDINDEX)
|
||||
(DECF BYTEPOS 16))
|
||||
(INCF BITROW))
|
||||
(SETF (GLYPH-BITMAP GLYPH)
|
||||
BM))))
|
||||
(ENDCHAR (SETQ CHAR-COMPLETE T)))))))
|
||||
(SETF (GLYPH-ASCENT GLYPH)
|
||||
(+ (GLYPH-BBH GLYPH)
|
||||
(GLYPH-BBYOFF0 GLYPH)))
|
||||
(SETF (GLYPH-DESCENT GLYPH)
|
||||
(ABS (MIN 0 (GLYPH-BBYOFF0 GLYPH))))
|
||||
(SETF (GLYPH-WIDTH GLYPH)
|
||||
(MAX (+ (MAX 0 (GLYPH-BBXOFF0 GLYPH))
|
||||
(GLYPH-BBW GLYPH))
|
||||
(FIRST (GLYPH-DWIDTH GLYPH))))
|
||||
GLYPH))
|
||||
(IL:* IL:|;;|
|
||||
"The (- (CHAR-CODE #\\A) 10) accomplishes adding 10 after the outer subtraction")
|
||||
|
||||
(- (CHAR-CODE C)
|
||||
(IL:CONSTANT (- (CHAR-CODE #\A)
|
||||
10))))
|
||||
((CHAR<= #\a C #\f)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"The (- (CHAR-CODE #\\a) 10) accomplishes adding 10 after the outer subtraction")
|
||||
|
||||
(- (CHAR-CODE C)
|
||||
(IL:CONSTANT (- (CHAR-CODE #\a)
|
||||
10))))
|
||||
(T 0))
|
||||
0))
|
||||
(PARSE-WORDS
|
||||
NIL
|
||||
(LOOP :FOR I :FROM 0 :TO (1- NCHARS)
|
||||
:BY 4 :WITH C3LIMIT = (- NCHARS 3)
|
||||
:WITH C4LIMIT = (- NCHARS 4)
|
||||
:COLLECT
|
||||
(+ (ASH (CHAR-HEX-VALUE (CHAR LINE I))
|
||||
12)
|
||||
(ASH (CHAR-HEX-VALUE (CHAR LINE (+ 1 I)))
|
||||
8)
|
||||
(ASH (CHAR-HEX-VALUE (AND (<= I C3LIMIT)
|
||||
(CHAR LINE (+ 2 I))))
|
||||
4)
|
||||
(CHAR-HEX-VALUE (AND (<= I C4LIMIT)
|
||||
(CHAR LINE (+ 3 I))))))))
|
||||
(LOOP :WITH BITROW = 0 :REPEAT BBH :DO
|
||||
(SETQ LINE (STRING-TRIM '(#\Space #\Tab)
|
||||
(READ-LINE FILE-STREAM)))
|
||||
(UNLESS (EQUAL NCHARS (LENGTH LINE))
|
||||
(ERROR "Invalid BDF file - bad line in BITMAP: ~A"
|
||||
LINE))
|
||||
(SETQ BITS (PARSE-WORDS))
|
||||
(SETQ WORDINDEX (* BITROW BM.RASTERWIDTH))
|
||||
(LOOP :REPEAT NWORDS :DO (IL:\\PUTBASE BM.BASE WORDINDEX
|
||||
(POP BITS))
|
||||
(INCF WORDINDEX))
|
||||
(INCF BITROW)))
|
||||
(SETF (GLYPH-BITMAP GLYPH)
|
||||
BM)))))
|
||||
(ENDCHAR (SETQ CHAR-COMPLETE T)))))))
|
||||
(SETF (GLYPH-ASCENT GLYPH)
|
||||
(+ (GLYPH-BBH GLYPH)
|
||||
(GLYPH-BBYOFF0 GLYPH)))
|
||||
(SETF (GLYPH-DESCENT GLYPH)
|
||||
(ABS (MIN 0 (GLYPH-BBYOFF0 GLYPH))))
|
||||
(SETF (GLYPH-WIDTH GLYPH)
|
||||
(MAX (+ (MAX 0 (GLYPH-BBXOFF0 GLYPH))
|
||||
(GLYPH-BBW GLYPH))
|
||||
(FIRST (GLYPH-DWIDTH GLYPH))))
|
||||
GLYPH))
|
||||
|
||||
(DEFUN WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE
|
||||
&AUX FULLFILENAME)
|
||||
TEST &AUX FULLFILENAME)
|
||||
(IL:* IL:\; "Edited 23-Feb-2026 15:57 by mth")
|
||||
(IL:* IL:\; "Edited 17-Feb-2026 14:17 by mth")
|
||||
(IL:* IL:\; "Edited 2-Dec-2025 14:47 by mth")
|
||||
(IL:* IL:\; "Edited 30-Nov-2025 16:03 by mth")
|
||||
(IL:* IL:\; "Edited 28-Nov-2025 17:56 by mth")
|
||||
@@ -769,8 +831,10 @@
|
||||
|
||||
(IL:* IL:|;;| "CSETS correspond to the charsets actually present in the FONTDESC.")
|
||||
|
||||
(SETQ FULLFILENAME (MEDLEYFONT.WRITE.FONT FONTDESC (MEDLEYFONT.FILENAME FONTDESC NIL NIL
|
||||
DEST-DIR)))
|
||||
(SETQ FULLFILENAME (IF TEST
|
||||
"WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE TEST"
|
||||
(MEDLEYFONT.WRITE.FONT FONTDESC (MEDLEYFONT.FILENAME NIL FONTDESC
|
||||
NIL NIL DEST-DIR))))
|
||||
(LIST FULLFILENAME FONTDESC CSETS)))
|
||||
|
||||
(DEFUN XLFD-SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 26-Nov-2025 09:43 by mth")
|
||||
@@ -880,21 +944,21 @@
|
||||
"BITMAPCREATE" "BITMAPHEIGHT"
|
||||
"BITMAPWIDTH" "BLACKSHADE" "BLTSHADE"
|
||||
"BOLD" "COMPRESSED" "CHARSETINFO"
|
||||
"CHARSETPROP" "DISPLAY" "FONTDESCRIPTOR"
|
||||
"FONTP" "FONTPROP" "INPUT" "ITALIC"
|
||||
"LIGHT" "LRSH" "MCCS" "MEDIUM" "REGULAR"
|
||||
"TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME"
|
||||
"DISPLAY" "FONTDESCRIPTOR" "FONTP"
|
||||
"FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH"
|
||||
"MCCS" "MEDIUM" "REGULAR" "TCONC"
|
||||
"UTOMCODE?" "MEDLEYFONT.FILENAME"
|
||||
"MEDLEYFONT.WRITE.FONT"))
|
||||
:READTABLE "XCL"
|
||||
:COMPILER :COMPILE-FILE)
|
||||
|
||||
(IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO)
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (3116 10226 (BDF-TO-CHARSETINFO 3116 . 10226)) (10228 16847 (BDF-TO-FONTDESCRIPTOR
|
||||
10228 . 16847)) (16849 20782 (BUILD-COMPOSITE 16849 . 20782)) (20784 21533 (CHAR-PRESENT-BIT 20784 .
|
||||
21533)) (21535 21819 (COUNT-MCHARS 21535 . 21819)) (21821 24856 (GLYPHS-BY-CHARSET 21821 . 24856)) (
|
||||
24858 26283 (PACKFILENAME.STRING 24858 . 26283)) (26285 35760 (READ-BDF 26285 . 35760)) (35762 36085 (
|
||||
READ-DELIMITED-LIST-FROM-STRING 35762 . 36085)) (36087 43085 (READ-GLYPH 36087 . 43085)) (43087 44472
|
||||
(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 43087 . 44472)) (44474 46891 (XLFD-SPLIT-FONT-NAME 44474 . 46891)
|
||||
) (46893 49905 (XLFD-TO-FACE 46893 . 49905)))))
|
||||
(IL:FILEMAP (NIL (3086 10199 (BDF-TO-CHARSETINFO 3086 . 10199)) (10201 16820 (BDF-TO-FONTDESCRIPTOR
|
||||
10201 . 16820)) (16822 21401 (BUILD-COMPOSITE 16822 . 21401)) (21403 22152 (CHAR-PRESENT-BIT 21403 .
|
||||
22152)) (22154 22438 (COUNT-MCHARS 22154 . 22438)) (22440 25475 (GLYPHS-BY-CHARSET 22440 . 25475)) (
|
||||
25477 26902 (PACKFILENAME.STRING 25477 . 26902)) (26904 37150 (READ-BDF 26904 . 37150)) (37152 37475 (
|
||||
READ-DELIMITED-LIST-FROM-STRING 37152 . 37475)) (37477 46234 (READ-GLYPH 37477 . 46234)) (46236 47972
|
||||
(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 46236 . 47972)) (47974 50391 (XLFD-SPLIT-FONT-NAME 47974 . 50391)
|
||||
) (50393 53405 (XLFD-TO-FACE 50393 . 53405)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
164
sources/APRINT
164
sources/APRINT
@@ -1,21 +1,18 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 9-Jun-2021 22:50:15"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>APRINT.;11 79264
|
||||
|
||||
changes to%: (VARS APRINTCOMS)
|
||||
(FILECREATED "22-Jan-2026 16:13:45" {WMEDLEY}<sources>APRINT.;5 78925
|
||||
|
||||
previous date%: "10-May-2021 15:46:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>APRINT.;10)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS APRINTCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 9-Jun-2021 22:50:15" {WMEDLEY}<sources>APRINT.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982-1988, 1990-1991, 2020-2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT APRINTCOMS)
|
||||
|
||||
(RPAQQ APRINTCOMS
|
||||
[(COMS (* ; "User-level print functions")
|
||||
[(COMS (* ; "User-level print functions")
|
||||
(FNS PRIN1 PRIN2 PRIN3 PRIN4 PRINT PRINTCCODE \PRINTCCODE PRINTLEVEL RADIX SPACES
|
||||
TERPRI FRESHLINE DEFPRINT LINELENGTH))
|
||||
(INITVARS (PLVLFILEFLG NIL)
|
||||
@@ -38,8 +35,9 @@ Copyright (c) 1982-1988, 1990-1991, 2020-2021 by Venue & Xerox Corporation.
|
||||
(*KEYWORD-PACKAGE* NIL)
|
||||
(*INTERLISP-PRIN1-CASE* ':UPCASE)
|
||||
(\DEFPRINTFNS NIL))
|
||||
(COMS (* ; "PRINT internals")
|
||||
(COMS (* ; "PRINT internals")
|
||||
(FNS PRINT-CIRCLE-LOOKUP PRINT-CIRCLE-LABEL-P PRINT-CIRCLE-SCAN PRINT-CIRCLE-ENTER)
|
||||
(FNS OCTALSTRING)
|
||||
(FNS \PRINDATUM \PRINT-USING-DEFPRINT \PRINT-USING-ADDRESS \ELIDE.PRINT.ELEMENT
|
||||
\ELIDE.ELEMENT.CHAR \ELIDE.PRINT.TAIL \ELIDE.TAIL.STRING \CKPOSBOUT \CKPOSSOUT
|
||||
\CONVERTNUMBER \LITPRIN \LITPRIN.INTERNAL \SYMBOL.ESCAPE.COUNT \NUMERIC.PNAMEP
|
||||
@@ -49,23 +47,24 @@ Copyright (c) 1982-1988, 1990-1991, 2020-2021 by Venue & Xerox Corporation.
|
||||
(EXPORT (MACROS .SPACECHECK. \CHECKRADIX)))
|
||||
(FNS \INVALID.RADIX)
|
||||
(SPECVARS \THISFILELINELENGTH))
|
||||
(COMS (* ; "Internal printing")
|
||||
(COMS (* ; "Internal printing")
|
||||
(FNS \MAPPNAME \MAPPNAME.INTERNAL PNAMESTREAMP)
|
||||
(DECLARE%: DONTCOPY (RESOURCES \MAPPNAMESTREAM)
|
||||
(MACROS PNAMESTREAMP))
|
||||
(INITRESOURCES \MAPPNAMESTREAM)
|
||||
[INITVARS (\PNAMEDEVICE (NCREATE 'FDEV (\GETDEVICEFROMHOSTNAME 'NULL T]
|
||||
(GLOBALVARS \PNAMEDEVICE))
|
||||
(COMS (* ; "Obsolete")
|
||||
(COMS (* ; "Obsolete")
|
||||
(FNS \MAPCHARS))
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY
|
||||
(ADDVARS (SYSSPECVARS *PRINT-BASE* *READ-BASE* *PRINT-RADIX* *PRINT-ESCAPE*
|
||||
*PRINT-CASE* *PRINT-GENSYM* *PRINT-LEVEL* *PRINT-LENGTH*
|
||||
*PRINT-PRETTY* *PRINT-CIRCLE* *PRINT-ARRAY* *PACKAGE*)))
|
||||
(COMS (* ; "PRINTNUM and friends")
|
||||
(COMS (* ; "PRINTNUM and friends")
|
||||
(FNS PRINTNUM FLTFMT \CHECKFLTFMT PRINTNUM-TO-STRING)
|
||||
(MACROS NUMFORMATCODE)
|
||||
(INITVARS (NILNUMPRINTFLG)))
|
||||
(PROPS (APRINT FILETYPE))
|
||||
(LOCALVARS . T)
|
||||
(GLOBALVARS \LINELENGTH \FLOATFORMAT PRXFLG \DEFPRINTFNS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
@@ -401,6 +400,13 @@ Copyright (c) 1982-1988, 1990-1991, 2020-2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(OCTALSTRING
|
||||
[LAMBDA (N) (* bvm%: "21-JUL-81 12:16")
|
||||
(GLOBALRESOURCE (\NUMSTR \NUMSTR1)
|
||||
(CONCAT (\CONVERTNUMBER N 8 NIL NIL \NUMSTR \NUMSTR1])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\PRINDATUM
|
||||
[LAMBDA (OBJECT STREAM CPL) (* ; "Edited 11-Feb-91 14:34 by jds")
|
||||
(DECLARE (USEDFREE *READTABLE* *PRINT-RADIX* *PRINT-BASE* *PRINT-ESCAPE*))
|
||||
@@ -1117,75 +1123,72 @@ Copyright (c) 1982-1988, 1990-1991, 2020-2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .FILELINELENGTH. MACRO ((STRM)
|
||||
(LET ((L (fetch (STREAM LINELENGTH) of STRM)))
|
||||
(SELECTC L
|
||||
(0 (* Some default)
|
||||
\LINELENGTH)
|
||||
(MAX.SMALLP
|
||||
(* Infinite)
|
||||
NIL)
|
||||
L))))
|
||||
(LET ((L (fetch (STREAM LINELENGTH) of STRM)))
|
||||
(SELECTC L
|
||||
(0 (* Some default)
|
||||
\LINELENGTH)
|
||||
(MAX.SMALLP (* Infinite)
|
||||
NIL)
|
||||
L))))
|
||||
)
|
||||
|
||||
|
||||
(DEFMACRO \PRINDATUM-LISTP ()
|
||||
|
||||
(* ;; "This is a hokey macro call to save the function call. Read it as though it were inline code in \prindatum")
|
||||
(* ;; "This is a hokey macro call to save the function call. Read it as though it were inline code in \prindatum")
|
||||
|
||||
`[LET (LABEL FIRSTTIME)
|
||||
(OR CPL (SETQ CPL 0))
|
||||
(if *PRINT-CIRCLE-HASHTABLE*
|
||||
then
|
||||
(* ;; "*PRINT-CIRCLE-HASHTABLE* is only non-nil when *print-circle*.")
|
||||
|
||||
(* ;; "*PRINT-CIRCLE-HASHTABLE* is only non-nil when *print-circle*.")
|
||||
|
||||
(CL:MULTIPLE-VALUE-SETQ (LABEL FIRSTTIME)
|
||||
(PRINT-CIRCLE-LOOKUP OBJECT)))
|
||||
(CL:MULTIPLE-VALUE-SETQ (LABEL FIRSTTIME)
|
||||
(PRINT-CIRCLE-LOOKUP OBJECT)))
|
||||
[if LABEL
|
||||
then (\CKPOSSOUT STREAM LABEL)
|
||||
(CL:WHEN FIRSTTIME
|
||||
(\CKPOSBOUT STREAM (CHARCODE SPACE)))]
|
||||
(CL:WHEN FIRSTTIME
|
||||
(\CKPOSBOUT STREAM (CHARCODE SPACE)))]
|
||||
(COND
|
||||
((AND LABEL (NOT FIRSTTIME)) (* ;
|
||||
"Second reference --- just print label")
|
||||
((AND LABEL (NOT FIRSTTIME)) (* ;
|
||||
"Second reference --- just print label")
|
||||
NIL)
|
||||
((AND *PRINT-LEVEL* (ILEQ *PRINT-LEVEL* CPL))
|
||||
(\ELIDE.PRINT.ELEMENT STREAM))
|
||||
(T (PROG (CDRCNT)
|
||||
[COND
|
||||
(*PRINT-LENGTH* (SETQ CDRCNT (COND
|
||||
((fetch (READTABLEP COMMONLISP)
|
||||
of *READTABLE*)
|
||||
((fetch (READTABLEP COMMONLISP) of
|
||||
*READTABLE*
|
||||
)
|
||||
0)
|
||||
(T (* ;
|
||||
"Interlisp print depth is triangular, Common Lisp isn't")
|
||||
(T (* ;
|
||||
"Interlisp print depth is triangular, Common Lisp isn't")
|
||||
[COND
|
||||
((IGEQ CPL *PRINT-LENGTH*)
|
||||
(* ;
|
||||
"We would just print '(--)' so it's nicer to print '&'")
|
||||
(RETURN (\ELIDE.PRINT.ELEMENT
|
||||
STREAM]
|
||||
(* ;
|
||||
"We would just print '(--)' so it's nicer to print '&'")
|
||||
(RETURN (\ELIDE.PRINT.ELEMENT STREAM]
|
||||
CPL]
|
||||
(add CPL 1) (* ;
|
||||
"Recursive calls will be at 1 greater depth")
|
||||
(add CPL 1) (* ;
|
||||
"Recursive calls will be at 1 greater depth")
|
||||
(\CKPOSBOUT STREAM (CHARCODE %())
|
||||
LP [COND
|
||||
((AND CDRCNT (IGREATERP (add CDRCNT 1)
|
||||
*PRINT-LENGTH*)) (* ;
|
||||
"have printed as many elements as allowed")
|
||||
*PRINT-LENGTH*)) (* ;
|
||||
"have printed as many elements as allowed")
|
||||
(\ELIDE.PRINT.TAIL STREAM T))
|
||||
(T (\PRINDATUM (CAR OBJECT)
|
||||
STREAM CPL)
|
||||
(COND
|
||||
((LISTP (SETQ OBJECT (CDR OBJECT)))
|
||||
(\CKPOSBOUT STREAM (CHARCODE SPACE))
|
||||
(if (AND *PRINT-CIRCLE-HASHTABLE* (PRINT-CIRCLE-LABEL-P OBJECT
|
||||
))
|
||||
then (* ; "Must print as a dotted tail")
|
||||
(\CKPOSSOUT STREAM ". ")
|
||||
(\PRINDATUM OBJECT STREAM CPL)
|
||||
(if (AND *PRINT-CIRCLE-HASHTABLE* (PRINT-CIRCLE-LABEL-P OBJECT))
|
||||
then (* ; "Must print as a dotted tail")
|
||||
(\CKPOSSOUT STREAM ". ")
|
||||
(\PRINDATUM OBJECT STREAM CPL)
|
||||
else (GO LP)))
|
||||
(OBJECT (* ; "Dotted tail")
|
||||
(OBJECT (* ; "Dotted tail")
|
||||
(\CKPOSSOUT STREAM " . ")
|
||||
(\PRINDATUM OBJECT STREAM]
|
||||
(\CKPOSBOUT STREAM (CHARCODE ")"])
|
||||
@@ -1193,20 +1196,18 @@ Copyright (c) 1982-1988, 1990-1991, 2020-2021 by Venue & Xerox Corporation.
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .SPACECHECK. MACRO ((STRM N)
|
||||
(AND \THISFILELINELENGTH (IGREATERP (IPLUS N
|
||||
(fetch
|
||||
CHARPOSITION
|
||||
of STRM))
|
||||
\THISFILELINELENGTH)
|
||||
(FRESHLINE STRM))))
|
||||
(AND \THISFILELINELENGTH (IGREATERP (IPLUS N (fetch CHARPOSITION
|
||||
of STRM))
|
||||
\THISFILELINELENGTH)
|
||||
(FRESHLINE STRM))))
|
||||
|
||||
(PUTPROPS \CHECKRADIX MACRO [LAMBDA (R)
|
||||
(COND
|
||||
((OR (NOT (SMALLP R))
|
||||
(ILESSP R 1)
|
||||
(IGREATERP R 36))
|
||||
(\INVALID.RADIX R))
|
||||
(T R])
|
||||
(COND
|
||||
((OR (NOT (SMALLP R))
|
||||
(ILESSP R 1)
|
||||
(IGREATERP R 36))
|
||||
(\INVALID.RADIX R))
|
||||
(T R])
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
@@ -1280,8 +1281,8 @@ Copyright (c) 1982-1988, 1990-1991, 2020-2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PNAMESTREAMP DMACRO ((STRM)
|
||||
(EQ (fetch (STREAM DEVICE) of STRM)
|
||||
\PNAMEDEVICE)))
|
||||
(EQ (fetch (STREAM DEVICE) of STRM)
|
||||
\PNAMEDEVICE)))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -1312,8 +1313,8 @@ Copyright (c) 1982-1988, 1990-1991, 2020-2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY
|
||||
|
||||
(ADDTOVAR SYSSPECVARS *PRINT-BASE* *READ-BASE* *PRINT-RADIX* *PRINT-ESCAPE* *PRINT-CASE*
|
||||
*PRINT-GENSYM* *PRINT-LEVEL* *PRINT-LENGTH* *PRINT-PRETTY*
|
||||
*PRINT-CIRCLE* *PRINT-ARRAY* *PACKAGE*)
|
||||
*PRINT-GENSYM* *PRINT-LEVEL* *PRINT-LENGTH* *PRINT-PRETTY* *PRINT-CIRCLE*
|
||||
*PRINT-ARRAY* *PACKAGE*)
|
||||
)
|
||||
|
||||
|
||||
@@ -1455,6 +1456,8 @@ Copyright (c) 1982-1988, 1990-1991, 2020-2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
|
||||
(RPAQ? NILNUMPRINTFLG )
|
||||
|
||||
(PUTPROPS APRINT FILETYPE TCOMPL)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(LOCALVARS . T)
|
||||
@@ -1471,22 +1474,21 @@ Copyright (c) 1982-1988, 1990-1991, 2020-2021 by Venue & Xerox Corporation.
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS APRINT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
|
||||
2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3743 13280 (PRIN1 3753 . 5238) (PRIN2 5240 . 6433) (PRIN3 6435 . 7469) (PRIN4 7471 .
|
||||
8654) (PRINT 8656 . 8892) (PRINTCCODE 8894 . 9167) (\PRINTCCODE 9169 . 9638) (PRINTLEVEL 9640 . 10346)
|
||||
(RADIX 10348 . 10530) (SPACES 10532 . 10878) (TERPRI 10880 . 11065) (FRESHLINE 11067 . 11744) (
|
||||
DEFPRINT 11746 . 12318) (LINELENGTH 12320 . 13278)) (13942 18274 (PRINT-CIRCLE-LOOKUP 13952 . 15118) (
|
||||
PRINT-CIRCLE-LABEL-P 15120 . 15596) (PRINT-CIRCLE-SCAN 15598 . 17560) (PRINT-CIRCLE-ENTER 17562 .
|
||||
18272)) (18275 62434 (\PRINDATUM 18285 . 21227) (\PRINT-USING-DEFPRINT 21229 . 22601) (
|
||||
\PRINT-USING-ADDRESS 22603 . 23579) (\ELIDE.PRINT.ELEMENT 23581 . 23751) (\ELIDE.ELEMENT.CHAR 23753 .
|
||||
24036) (\ELIDE.PRINT.TAIL 24038 . 24462) (\ELIDE.TAIL.STRING 24464 . 24685) (\CKPOSBOUT 24687 . 24852)
|
||||
(\CKPOSSOUT 24854 . 25068) (\CONVERTNUMBER 25070 . 29559) (\LITPRIN 29561 . 36096) (\LITPRIN.INTERNAL
|
||||
36098 . 44453) (\SYMBOL.ESCAPE.COUNT 44455 . 51223) (\NUMERIC.PNAMEP 51225 . 57808) (\PRINSTACKP
|
||||
57810 . 59115) (\PRINTADDR 59117 . 60214) (\PRINSTRING 60216 . 61712) (\SOUT 61714 . 62432)) (67877
|
||||
68045 (\INVALID.RADIX 67887 . 68043)) (68149 70224 (\MAPPNAME 68159 . 69154) (\MAPPNAME.INTERNAL 69156
|
||||
. 69867) (PNAMESTREAMP 69869 . 70222)) (70907 71295 (\MAPCHARS 70917 . 71293)) (71626 78665 (PRINTNUM
|
||||
71636 . 74693) (FLTFMT 74695 . 75085) (\CHECKFLTFMT 75087 . 75655) (PRINTNUM-TO-STRING 75657 . 78663)
|
||||
))))
|
||||
(FILEMAP (NIL (3664 13201 (PRIN1 3674 . 5159) (PRIN2 5161 . 6354) (PRIN3 6356 . 7390) (PRIN4 7392 .
|
||||
8575) (PRINT 8577 . 8813) (PRINTCCODE 8815 . 9088) (\PRINTCCODE 9090 . 9559) (PRINTLEVEL 9561 . 10267)
|
||||
(RADIX 10269 . 10451) (SPACES 10453 . 10799) (TERPRI 10801 . 10986) (FRESHLINE 10988 . 11665) (
|
||||
DEFPRINT 11667 . 12239) (LINELENGTH 12241 . 13199)) (13863 18195 (PRINT-CIRCLE-LOOKUP 13873 . 15039) (
|
||||
PRINT-CIRCLE-LABEL-P 15041 . 15517) (PRINT-CIRCLE-SCAN 15519 . 17481) (PRINT-CIRCLE-ENTER 17483 .
|
||||
18193)) (18196 18426 (OCTALSTRING 18206 . 18424)) (18427 62586 (\PRINDATUM 18437 . 21379) (
|
||||
\PRINT-USING-DEFPRINT 21381 . 22753) (\PRINT-USING-ADDRESS 22755 . 23731) (\ELIDE.PRINT.ELEMENT 23733
|
||||
. 23903) (\ELIDE.ELEMENT.CHAR 23905 . 24188) (\ELIDE.PRINT.TAIL 24190 . 24614) (\ELIDE.TAIL.STRING
|
||||
24616 . 24837) (\CKPOSBOUT 24839 . 25004) (\CKPOSSOUT 25006 . 25220) (\CONVERTNUMBER 25222 . 29711) (
|
||||
\LITPRIN 29713 . 36248) (\LITPRIN.INTERNAL 36250 . 44605) (\SYMBOL.ESCAPE.COUNT 44607 . 51375) (
|
||||
\NUMERIC.PNAMEP 51377 . 57960) (\PRINSTACKP 57962 . 59267) (\PRINTADDR 59269 . 60366) (\PRINSTRING
|
||||
60368 . 61864) (\SOUT 61866 . 62584)) (63167 66808 (\PRINDATUM-LISTP 63167 . 66808)) (67634 67802 (
|
||||
\INVALID.RADIX 67644 . 67800)) (67906 69981 (\MAPPNAME 67916 . 68911) (\MAPPNAME.INTERNAL 68913 .
|
||||
69624) (PNAMESTREAMP 69626 . 69979)) (70648 71036 (\MAPCHARS 70658 . 71034)) (71358 78397 (PRINTNUM
|
||||
71368 . 74425) (FLTFMT 74427 . 74817) (\CHECKFLTFMT 74819 . 75387) (PRINTNUM-TO-STRING 75389 . 78395))
|
||||
)))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Apr-2025 08:43:01" {WMEDLEY}<sources>EXTERNALFORMAT.;91 38905
|
||||
(FILECREATED "29-Jan-2026 21:09:02" {WMEDLEY}<sources>EXTERNALFORMAT.;92 39722
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS EXTERNALFORMATCOMS)
|
||||
:CHANGES-TO (FNS \EXTERNALFORMAT)
|
||||
|
||||
:PREVIOUS-DATE "19-Mar-2024 18:24:39" {WMEDLEY}<sources>EXTERNALFORMAT.;90)
|
||||
:PREVIOUS-DATE "24-Apr-2025 08:43:01" {WMEDLEY}<sources>EXTERNALFORMAT.;91)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
|
||||
@@ -131,7 +131,11 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\EXTERNALFORMAT
|
||||
[LAMBDA (STREAM NEWFORMAT/NAME)
|
||||
[LAMBDA (STREAM NEWFORMAT/NAME CREATING) (* ; "Edited 29-Jan-2026 21:05 by rmk")
|
||||
|
||||
(* ;; "CREATING is T from STREAM declaration, tries to not override the fields that are specified in the create expression")
|
||||
|
||||
(* ;; "Edited 29-Jan-2026 21:01 by rmk")
|
||||
|
||||
(* ;; "Edited 2-Jul-2022 19:17 by rmk: Fast case: NEWFORMAT/NAME is an external format")
|
||||
|
||||
@@ -177,14 +181,20 @@
|
||||
(CL:WHEN (ffetch (EXTERNALFORMAT EOLVALID) of EXTFORMAT)
|
||||
(freplace (STREAM EOLCONVENTION) of STREAM with (ffetch (EXTERNALFORMAT EOL)
|
||||
of EXTFORMAT)))
|
||||
(freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT OUTCHARFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT INCCODEFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT PEEKCCODEFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT BACKCCODEFN)
|
||||
of EXTFORMAT)))])
|
||||
(CL:UNLESS (AND CREATING (ffetch (STREAM OUTCHARFN) of STREAM))
|
||||
(freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT OUTCHARFN)
|
||||
of EXTFORMAT)))
|
||||
(CL:UNLESS (AND CREATING (ffetch (STREAM INCCODEFN) of STREAM))
|
||||
(freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT INCCODEFN)
|
||||
of EXTFORMAT)))
|
||||
(CL:UNLESS (AND CREATING (ffetch (STREAM PEEKCCODEFN) of STREAM))
|
||||
(freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT
|
||||
PEEKCCODEFN)
|
||||
of EXTFORMAT)))
|
||||
(CL:UNLESS (AND CREATING (ffetch (STREAM BACKCCODEFN) of STREAM))
|
||||
(freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT
|
||||
BACKCCODEFN)
|
||||
of EXTFORMAT))))])
|
||||
(ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM])
|
||||
|
||||
(MAKE-EXTERNALFORMAT
|
||||
@@ -737,13 +747,13 @@
|
||||
(\CREATE.THROUGH.EXTERNALFORMAT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6710 13543 (\EXTERNALFORMAT 6720 . 10498) (MAKE-EXTERNALFORMAT 10500 . 13070) (
|
||||
\EXTERNALFORMAT.DEFPRINT 13072 . 13541)) (13544 16585 (\INSTALL.EXTERNALFORMAT 13554 . 15003) (
|
||||
\REMOVE.EXTERNALFORMAT 15005 . 15836) (FIND-FORMAT 15838 . 16583)) (16586 16998 (SYSTEM-EXTERNALFORMAT
|
||||
16596 . 16996)) (17347 33324 (\OUTCHAR 17357 . 18574) (\INCCODE 18576 . 19729) (\BACKCCODE 19731 .
|
||||
21410) (\BACKCCODE.EOLC 21412 . 23602) (\PEEKCCODE 23604 . 23929) (\PEEKCCODE.EOLC 23931 . 24310) (
|
||||
\INCCODE.EOLC 24312 . 26111) (\FORMATBYTESTREAM 26113 . 28557) (\FORMATBYTESTRING 28559 . 30259) (
|
||||
\CHECKEOLC.CRLF 30261 . 33322)) (34606 36842 (\NULLDEVICE 34616 . 36518) (\NULL.OPENFILE 36520 . 36840
|
||||
)) (36982 38809 (\CREATE.THROUGH.EXTERNALFORMAT 36992 . 37778) (\THROUGHIN 37780 . 38200) (
|
||||
\THROUGHBACKCCODE 38202 . 38469) (\THROUGHOUTCHARFN 38471 . 38807)))))
|
||||
(FILEMAP (NIL (6706 14360 (\EXTERNALFORMAT 6716 . 11315) (MAKE-EXTERNALFORMAT 11317 . 13887) (
|
||||
\EXTERNALFORMAT.DEFPRINT 13889 . 14358)) (14361 17402 (\INSTALL.EXTERNALFORMAT 14371 . 15820) (
|
||||
\REMOVE.EXTERNALFORMAT 15822 . 16653) (FIND-FORMAT 16655 . 17400)) (17403 17815 (SYSTEM-EXTERNALFORMAT
|
||||
17413 . 17813)) (18164 34141 (\OUTCHAR 18174 . 19391) (\INCCODE 19393 . 20546) (\BACKCCODE 20548 .
|
||||
22227) (\BACKCCODE.EOLC 22229 . 24419) (\PEEKCCODE 24421 . 24746) (\PEEKCCODE.EOLC 24748 . 25127) (
|
||||
\INCCODE.EOLC 25129 . 26928) (\FORMATBYTESTREAM 26930 . 29374) (\FORMATBYTESTRING 29376 . 31076) (
|
||||
\CHECKEOLC.CRLF 31078 . 34139)) (35423 37659 (\NULLDEVICE 35433 . 37335) (\NULL.OPENFILE 37337 . 37657
|
||||
)) (37799 39626 (\CREATE.THROUGH.EXTERNALFORMAT 37809 . 38595) (\THROUGHIN 38597 . 39017) (
|
||||
\THROUGHBACKCCODE 39019 . 39286) (\THROUGHOUTCHARFN 39288 . 39624)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
466
sources/FONT
466
sources/FONT
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "31-Dec-2025 22:41:44" {WMEDLEY}<sources>FONT.;655 285234
|
||||
(FILECREATED " 6-Feb-2026 23:44:25" {WMEDLEY}<sources>FONT.;671 276511
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS FONTCOMS)
|
||||
:CHANGES-TO (FNS \FINDFONTFILE)
|
||||
|
||||
:PREVIOUS-DATE "25-Dec-2025 10:58:30" {WMEDLEY}<sources>FONT.;654)
|
||||
:PREVIOUS-DATE " 6-Feb-2026 00:24:55" {WMEDLEY}<sources>FONT.;670)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FONTCOMS)
|
||||
@@ -46,16 +46,7 @@
|
||||
(FNS MOVECHARBITMAP MOVEFONTCHARS \MOVEFONTCHAR \MOVEFONTCHARS.SOURCEDATA \MAKESLUGCHAR
|
||||
SLUGCHARP.DISPLAY)
|
||||
(MACROS UPDATEINFOELEMENT))
|
||||
(COMS
|
||||
(* ;; "\FINDFONTFILE \FONTFILENAME \SEARCHFONTFILES \FONTINFOFROMFILENAME are redefined to deal with character-set directories. That behavior is conditioned on the setting of the global variable *USEOLDFONTDIRECTORIES*, T at PARC, maybe NIL most other places. ")
|
||||
|
||||
(FNS FONTFILES \FINDFONTFILE \FONTFILENAMES \FONTFILENAME \FONTFILENAME.OLD
|
||||
\FONTFILENAME.NEW FONTSPECFROMFILENAME \FONTINFOFROMFILENAME.OLD)
|
||||
(* (* ; "Do we still want old fonts?")
|
||||
(ADDVARS (*OLD-FONT-EXTENSIONS* STRIKE)))
|
||||
(INITVARS (*OLD-FONT-EXTENSIONS* NIL))
|
||||
(INITVARS (*USEOLDFONTDIRECTORIES* NIL))
|
||||
(GLOBALVARS *OLD-FONT-EXTENSIONS* *USEOLDFONTDIRECTORIES*))
|
||||
(FNS FONTFILES \FINDFONTFILE \FONTFILENAMES \FONTFILENAME FONTSPECFROMFILENAME)
|
||||
(FNS FONTCOPY FONTP FONTUNPARSE SETFONTDESCRIPTOR \STREAMCHARWIDTH \COERCECHARSET
|
||||
\BUILDSLUGCSINFO \FONTSYMBOL \DEVICESYMBOL \FONTFACE \FONTFACE.COLOR SETFONTCHARENCODING
|
||||
)
|
||||
@@ -712,7 +703,8 @@
|
||||
(CLOSEF? STRM))))])
|
||||
|
||||
(\READCHARSET
|
||||
[LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 11-Nov-2025 14:30 by rmk")
|
||||
[LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 6-Feb-2026 00:03 by rmk")
|
||||
(* ; "Edited 11-Nov-2025 14:30 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 23:57 by rmk")
|
||||
(* ; "Edited 28-Aug-2025 23:17 by rmk")
|
||||
(* ; "Edited 25-Aug-2025 12:03 by rmk")
|
||||
@@ -725,7 +717,7 @@
|
||||
|
||||
(* ;; "This finds the first file in the directories/extensions order that contains information about charset, determines its format, and reads it in. The assumption is that the first such existing file is the one we want. ")
|
||||
|
||||
(CL:WHEN (EQ 0 (fetch (FONTSPEC FSROTATION) of FONTSPEC))
|
||||
(CL:WHEN (AND FONTSPEC (EQ 0 (fetch (FONTSPEC FSROTATION) of FONTSPEC)))
|
||||
(RESETLST
|
||||
(for FILE STRM CSINFO in (FONTFILES FONTSPEC CHARSET)
|
||||
do
|
||||
@@ -1179,7 +1171,8 @@
|
||||
(fetch (FONTDESCRIPTOR \SFHeight) of (FONTCREATE FONTSPEC])
|
||||
|
||||
(FONTPROP
|
||||
[LAMBDA (FONT PROP) (* ; "Edited 2-Dec-2025 16:01 by rmk")
|
||||
[LAMBDA (FONT PROP) (* ; "Edited 25-Jan-2026 20:08 by rmk")
|
||||
(* ; "Edited 2-Dec-2025 16:01 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 22:21 by rmk")
|
||||
(* ; "Edited 12-Aug-2025 21:10 by rmk")
|
||||
(* ; "Edited 10-Aug-2025 13:28 by rmk")
|
||||
@@ -1256,6 +1249,7 @@
|
||||
\MAXCHARSET
|
||||
eachtime (SETQ CSINFO (\GETBASEPTR CSVECTOR (UNFOLD CS 2))) when CSINFO
|
||||
unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CS))
|
||||
(AVGCHARWIDTH (ffetch (FONTDESCRIPTOR FONTAVGCHARWIDTH) of FONT))
|
||||
(FONTTOMCCSFN (ffetch FONTTOMCCSFN of FONT))
|
||||
(\ILLEGAL.ARG PROP])
|
||||
|
||||
@@ -1820,13 +1814,6 @@
|
||||
(freplace (CHARSETINFO FIELD) of DCSINFO with DBLOCK))
|
||||
(\FSETWIDTH DBLOCK DTHINCODE NEWVAL))])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"\FINDFONTFILE \FONTFILENAME \SEARCHFONTFILES \FONTINFOFROMFILENAME are redefined to deal with character-set directories. That behavior is conditioned on the setting of the global variable *USEOLDFONTDIRECTORIES*, T at PARC, maybe NIL most other places. "
|
||||
)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(FONTFILES
|
||||
@@ -1853,6 +1840,8 @@
|
||||
|
||||
(\FINDFONTFILE
|
||||
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST)
|
||||
(* ; "Edited 6-Feb-2026 23:44 by rmk")
|
||||
(* ; "Edited 22-Jan-2026 08:54 by rmk")
|
||||
(* ; "Edited 3-Dec-2025 23:38 by rmk")
|
||||
(* ; "Edited 9-Jun-2025 09:40 by rmk")
|
||||
(* ; "Edited 15-May-2025 22:41 by rmk")
|
||||
@@ -1864,13 +1853,9 @@
|
||||
(CL:UNLESS DIRLST
|
||||
(SETQ DIRLST (CONS NIL)))
|
||||
|
||||
(* ;; "Find any font file on any directory with any naming convention with any extension. Note that ROTATION and DEVICE are just place holders. DEVICE is irrelevant because DIRLST already incorporates the device information. The variable *OLD-FONT-EXTENSIONS* can be set to suppress using the old-style lookup. If set to a list of extensions, just those will be looked up with old-style conventions.")
|
||||
(* ;; "Find any font file on any directory with any naming convention with any extension. Note that ROTATION and DEVICE are just place holders. DEVICE is irrelevant because DIRLST already incorporates the device information. ")
|
||||
|
||||
(for EXT FONTFILE inside EXTLST join (SETQ FONTFILE (if (FMEMB EXT *OLD-FONT-EXTENSIONS*)
|
||||
then (\FONTFILENAME.OLD FAMILY SIZE FACE
|
||||
EXT CHARSET)
|
||||
else (\FONTFILENAME FAMILY SIZE FACE EXT
|
||||
CHARSET)))
|
||||
(for EXT FONTFILE inside EXTLST join (SETQ FONTFILE (\FONTFILENAME FAMILY SIZE FACE EXT CHARSET))
|
||||
(for DIR FOUND inside DIRLST
|
||||
when (SETQ FOUND (INFILEP (PACKFILENAME.STRING
|
||||
'DIRECTORY DIR 'BODY FONTFILE)
|
||||
@@ -1883,165 +1868,61 @@
|
||||
(RETURN (CAR $$VAL)))])
|
||||
|
||||
(\FONTFILENAMES
|
||||
[LAMBDA (FAMILY SIZE FACE DEVICE EXTENSIONS) (* ; "Edited 7-Oct-2025 12:21 by rmk")
|
||||
[LAMBDA (FAMILY SIZE FACE DEVICE EXTENSIONS) (* ; "Edited 22-Jan-2026 09:01 by rmk")
|
||||
(* ; "Edited 7-Oct-2025 12:21 by rmk")
|
||||
(* ; "Edited 17-May-2025 12:15 by rmk")
|
||||
(APPEND [for EXT inside EXTENSIONS collect (IF (FMEMB EXT *OLD-FONT-EXTENSIONS*)
|
||||
THEN (\FONTFILENAME.OLD FAMILY SIZE FACE EXT
|
||||
'NOCHARSET)
|
||||
ELSE (\FONTFILENAME FAMILY SIZE FACE EXT
|
||||
'NOCHARSET]
|
||||
(for EXT inside EXTENSIONS collect (IF (FMEMB EXT *OLD-FONT-EXTENSIONS*)
|
||||
THEN (\FONTFILENAME.OLD FAMILY SIZE FACE EXT 0)
|
||||
ELSE (\FONTFILENAME FAMILY SIZE FACE EXT 0])
|
||||
(APPEND (for EXT inside EXTENSIONS collect (\FONTFILENAME FAMILY SIZE FACE EXT 'NOCHARSET))
|
||||
(for EXT inside EXTENSIONS collect (\FONTFILENAME FAMILY SIZE FACE EXT 0])
|
||||
|
||||
(\FONTFILENAME
|
||||
[LAMBDA (FAMILY SIZE FACE EXTENSION CHARSET) (* ; "Edited 11-Jul-2025 09:39 by rmk")
|
||||
[LAMBDA (FAMILY SIZE FACE EXTENSION CHARSET) (* ; "Edited 22-Jan-2026 14:25 by rmk")
|
||||
(* ; "Edited 11-Jul-2025 09:39 by rmk")
|
||||
(* ; "Edited 15-May-2025 15:51 by rmk")
|
||||
(* ; "Edited 5-Mar-93 16:10 by rmk:")
|
||||
|
||||
(* ;; "Strike file naming convention (w/o dashes, no charset) no longer supported. New name is of the form %"familysize-face-Ccharset.ext%", e.g., MODERN12-MRR-C357.WD")
|
||||
|
||||
(* ;; "**bvm 10/5/89 Slight change: partition fonts into subdirectories by charset, e.g., all Charset zero fonts are in subdirectory C0>. This significantly speeds up any font operation that requires any local directory work (e.g., NFS servers on both Sun and D machine), and FONTSAVAILABLE on any device (since it doesn't have to wade thru all those charsets). This behavior is conditioned on the value of *USEOLDFONTDIRECTORIES*")
|
||||
(* ;; "FAMILY can be a FONTSPEC")
|
||||
|
||||
(DECLARE (SPECVARS FAMILY SIZE FACE))
|
||||
(SETQ FACE (\FONTFACE FACE)) (* ; "Validate face")
|
||||
(LET* ([SIZEPATT (COND
|
||||
((EQ SIZE '*)
|
||||
SIZE)
|
||||
((FIXP SIZE)
|
||||
(if (< SIZE 10)
|
||||
then (CONCAT 0 SIZE)
|
||||
else SIZE))
|
||||
(T (\ILLEGAL.ARG SIZE]
|
||||
(CSETNAME (COND
|
||||
((OR (NULL CHARSET)
|
||||
(EQ CHARSET 0)) (* ; "Charset defaults to zero.")
|
||||
"0")
|
||||
((FIXP CHARSET)
|
||||
(LET ((*PRINT-BASE* 8)
|
||||
(*PRINT-RADIX* NIL)) (* ; "Longhand for (cl:write-to-string charset :radix nil :base 8), which is twice as slow, due to lousy keyword handling")
|
||||
(\PRINDATUM.TO.STRING CHARSET)))
|
||||
((EQ CHARSET 'NOCHARSET) (* ; "Don't want the charset indicated")
|
||||
NIL)
|
||||
(T (* ; "Somebody made the string already?")
|
||||
CHARSET)))
|
||||
[FACESPEC (LIST (CHCON1 (fetch (FONTFACE WEIGHT) of FACE))
|
||||
(CHCON1 (fetch (FONTFACE SLOPE) of FACE))
|
||||
(CHCON1 (fetch (FONTFACE EXPANSION) of FACE]
|
||||
(TAIL FACESPEC))
|
||||
[if (OR (EQ (CAR TAIL)
|
||||
(CHARCODE *))
|
||||
(EQ (CAR (SETQ TAIL (CDR TAIL)))
|
||||
(CHARCODE *)))
|
||||
then (* ;
|
||||
"Avoid adjacent wildcards because some devices (notably DSK) get exponentially slower.")
|
||||
(while (EQ (CADR TAIL)
|
||||
(CHARCODE *)) do (RPLACD TAIL (CDDR TAIL]
|
||||
(LET (ROTATION DEVICE SIZEPATT CSETNAME FACESPEC STARPOS FILENAME)
|
||||
(DECLARE (SPECVARS ROTATION DEVICE))
|
||||
(CL:WHEN (type? FONTSPEC FAMILY)
|
||||
(SPREADFONTSPEC FAMILY))
|
||||
(SETQ SIZEPATT (CL:IF (OR (EQ SIZE '*)
|
||||
(>= SIZE 10))
|
||||
SIZE
|
||||
(CONCAT "0" SIZE)))
|
||||
(SETQ CSETNAME (if (FIXP CHARSET)
|
||||
then (OCTALSTRING CHARSET)
|
||||
elseif (MEMB CHARSET '(NIL NOCHARSET))
|
||||
then (* ; "Don't want the charset indicated")
|
||||
NIL
|
||||
else (* ; "Somebody made the string already?")
|
||||
CHARSET))
|
||||
|
||||
(* ;; "Fortunately, CONCAT ignores packages.")
|
||||
(* ;; "Fortunately, PACKFILENAME ignores packages")
|
||||
|
||||
(PACKFILENAME.STRING 'NAME (CONCAT (if *USEOLDFONTDIRECTORIES*
|
||||
then ""
|
||||
elseif CSETNAME
|
||||
then (CONCAT (PROGN
|
||||
(* ;
|
||||
"Lowercase because it's in a directory name, so maybe Unix will find it sooner?")
|
||||
"c")
|
||||
CSETNAME ">")
|
||||
else "")
|
||||
FAMILY SIZEPATT "-" (CONCATCODES FACESPEC)
|
||||
(CL:IF CSETNAME
|
||||
(CONCAT "-C" CSETNAME)
|
||||
""))
|
||||
'EXTENSION EXTENSION])
|
||||
(SETQ FILENAME (PACKFILENAME.STRING 'NAME (CONCAT (CL:IF CSETNAME
|
||||
(CONCAT "c" CSETNAME ">")
|
||||
"")
|
||||
FAMILY SIZEPATT "-" (FONTFACETOATOM FACE)
|
||||
(CL:IF CSETNAME
|
||||
(CONCAT "-C" CSETNAME)
|
||||
""))
|
||||
'EXTENSION EXTENSION))
|
||||
|
||||
(\FONTFILENAME.OLD
|
||||
[LAMBDA (FAMILY SIZE FACE EXTENSION CHARSET) (* ; "Edited 23-Sep-92 18:22 by jds")
|
||||
(* ;;
|
||||
" Avoid adjacent wildcards because some devices (notably old DSK) get exponentially slower.")
|
||||
|
||||
(* ;; "Returns old style font file names. They were ambiguous because you could not ask for e.g. FACE (MEDIUM * REGULAR) because it maps to FamilySize-*-Charset, which also matches (BOLD * COMPRESSED), etc. Keep this function around though for user's who don't rename their files.")
|
||||
(* ;
|
||||
"Returns the name of the file that should contain the information for a font.")
|
||||
(SETQ FACE (\FONTFACE FACE)) (* ; "Force legal canonical face")
|
||||
(SETQ FACE (COND
|
||||
((AND (EQ (CAR FACE)
|
||||
'*)
|
||||
(EQ (CADR FACE)
|
||||
'*))
|
||||
|
||||
(* ;; "Avoid adjacent wildcards because DSK gets slower exponentially (can take loooong tiiiiiime). No need to check compression.")
|
||||
|
||||
'*)
|
||||
(T FACE)))
|
||||
(PACKFILENAME.STRING 'NAME [PROGN
|
||||
(* ;; "DISPLAYFONT AC WD and the default case")
|
||||
|
||||
(CONCAT (CDR (SASSOC FAMILY *DISPLAY-FONT-NAME-MAP*))
|
||||
(COND
|
||||
((EQ SIZE '*)
|
||||
SIZE)
|
||||
((FIXP SIZE)
|
||||
(COND
|
||||
((< SIZE 10)
|
||||
(CONCAT 0 SIZE))
|
||||
(T SIZE)))
|
||||
(T (\ILLEGAL.ARG SIZE)))
|
||||
[COND
|
||||
((EQ FACE '*)
|
||||
'*)
|
||||
(T (SELECTQ (fetch WEIGHT of FACE)
|
||||
(BOLD (SELECTQ (fetch SLOPE of FACE)
|
||||
(ITALIC "D")
|
||||
"B"))
|
||||
(SELECTQ (fetch SLOPE of FACE)
|
||||
(ITALIC "I")
|
||||
"R"]
|
||||
(COND
|
||||
((FIXP CHARSET)
|
||||
(LET ((*PRINT-BASE* 8))
|
||||
(CL:FORMAT NIL "~O" CHARSET)))
|
||||
(T "000"]
|
||||
'EXTENSION EXTENSION])
|
||||
|
||||
(\FONTFILENAME.NEW
|
||||
[LAMBDA (FAMILY SIZE FACE EXTENSION CHARSET) (* ; "Edited 30-Mar-87 20:00 by FS")
|
||||
|
||||
(* ;; "Strike file naming convention (w/o dashes, no charset) no longer supported.")
|
||||
|
||||
(LET (NAME SIZEPATT)
|
||||
(SETQ FACE (\FONTFACE FACE)) (* ; "Validate face")
|
||||
[SETQ SIZEPATT (COND
|
||||
((EQ SIZE '*)
|
||||
SIZE)
|
||||
((FIXP SIZE)
|
||||
(if (< SIZE 10)
|
||||
then (CONCAT 0 SIZE)
|
||||
else SIZE))
|
||||
(T (\ILLEGAL.ARG SIZE]
|
||||
|
||||
(* ;; "Avoid adjacent wildcards because some devices (notably DSK) get exponentially slower. Nicely, PACK & CONCAT ignore packages.")
|
||||
|
||||
(PACKFILENAME.STRING 'NAME (CONCAT FAMILY SIZEPATT "-"
|
||||
[COND
|
||||
((EQUAL FACE '
|
||||
|
||||
(* * *)
|
||||
)
|
||||
'*)
|
||||
(T (CONCAT (NTHCHAR (fetch (FONTFACE WEIGHT)
|
||||
of FACE)
|
||||
1)
|
||||
(NTHCHAR (fetch (FONTFACE SLOPE)
|
||||
of FACE)
|
||||
1)
|
||||
(NTHCHAR (fetch (FONTFACE EXPANSION)
|
||||
of FACE)
|
||||
1]
|
||||
(COND
|
||||
[(FIXP CHARSET)
|
||||
(LET ((*PRINT-BASE* 8))
|
||||
(CONCAT "-C" (\PRINDATUM.TO.STRING CHARSET]
|
||||
(CHARSET (CONCAT "-C" CHARSET))
|
||||
(T "-C0")))
|
||||
'EXTENSION EXTENSION])
|
||||
(CL:IF (STRPOS "**" FILENAME)
|
||||
(CONCATCODES (for I C from 1 while (SETQ C (NTHCHARCODE FILENAME I))
|
||||
unless [AND (EQ (CHARCODE *)
|
||||
C)
|
||||
(EQ (CHARCODE *)
|
||||
(NTHCHARCODE FILENAME (ADD1 I] collect C))
|
||||
FILENAME)])
|
||||
|
||||
(FONTSPECFROMFILENAME
|
||||
[LAMBDA (FONTFILE DEVICE) (* ; "Edited 23-Nov-2025 21:42 by rmk")
|
||||
@@ -2120,56 +2001,6 @@
|
||||
FSFACE _ FACE
|
||||
FSROTATION _ 0
|
||||
FSDEVICE _ DEVICE])
|
||||
|
||||
(\FONTINFOFROMFILENAME.OLD
|
||||
[LAMBDA (FONTFILE DEVICE) (* ; "Edited 1-Jan-87 01:29 by FS")
|
||||
|
||||
(* ;; "returns a list of the family size face rotation device of the font stored in the file name FONTFILE.")
|
||||
|
||||
(PROG ((FILENAMELIST (UNPACKFILENAME FONTFILE))
|
||||
SIZEBEG SIZEND NAME FAMILY SIZE)
|
||||
(SETQ NAME (LISTGET FILENAMELIST 'NAME)) (* ;
|
||||
"find where the name and size are.")
|
||||
(SETQ SIZEBEG (for CH# from 1 when (NUMBERP (NTHCHAR NAME CH#))
|
||||
do (RETURN CH#)))
|
||||
[SETQ FAMILY (MKATOM (SUBSTRING NAME 1 (SUB1 SIZEBEG]
|
||||
(SETQ SIZEND (for CH# from SIZEBEG when (NOT (NUMBERP (NTHCHAR NAME CH#)))
|
||||
do (RETURN CH#)))
|
||||
[SETQ SIZE (MKATOM (SUBSTRING NAME SIZEBEG (SUB1 SIZEND]
|
||||
(RETURN (LIST FAMILY SIZE (SELECTQ (LISTGET FILENAMELIST 'EXTENSION)
|
||||
((DISPLAYFONT AC WD)
|
||||
(LIST (COND
|
||||
((STRPOS "-B" NAME SIZEND NIL T)
|
||||
'BOLD)
|
||||
(T 'MEDIUM))
|
||||
(COND
|
||||
((STRPOS "-I" NAME SIZEND NIL)
|
||||
'ITALIC)
|
||||
(T 'REGULAR))
|
||||
'REGULAR))
|
||||
(LIST (COND
|
||||
((STRPOS "B" NAME SIZEND NIL T)
|
||||
'BOLD)
|
||||
(T 'MEDIUM))
|
||||
(COND
|
||||
((STRPOS "I" NAME SIZEND NIL)
|
||||
'ITALIC)
|
||||
(T 'REGULAR))
|
||||
'REGULAR))
|
||||
0 DEVICE])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* (* ; "Do we still want old fonts?") (ADDVARS (*OLD-FONT-EXTENSIONS* STRIKE)))
|
||||
|
||||
|
||||
(RPAQ? *OLD-FONT-EXTENSIONS* NIL)
|
||||
|
||||
(RPAQ? *USEOLDFONTDIRECTORIES* NIL)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *OLD-FONT-EXTENSIONS* *USEOLDFONTDIRECTORIES*)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -2839,7 +2670,8 @@
|
||||
then FILEFONTS)))])
|
||||
|
||||
(FONTEXISTS?
|
||||
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOCOERCIONS) (* ; "Edited 18-Dec-2025 13:10 by rmk")
|
||||
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOCOERCIONS) (* ; "Edited 22-Jan-2026 09:07 by rmk")
|
||||
(* ; "Edited 18-Dec-2025 13:10 by rmk")
|
||||
(* ; "Edited 25-Nov-2025 20:18 by rmk")
|
||||
(* ; "Edited 26-Sep-2025 10:10 by rmk")
|
||||
(* ; "Edited 28-Aug-2025 22:16 by rmk")
|
||||
@@ -2876,7 +2708,7 @@
|
||||
(FUNCTION NILL))
|
||||
FONTSPEC)))
|
||||
(if VAL
|
||||
then (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL |(QUOTE SASSOC)|)
|
||||
then (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL 'SASSOC)
|
||||
elseif [AND (NOT NOCOERCIONS)
|
||||
(SETQ VAL (COERCEFONTSPEC FONTSPEC (FONTDEVICEPROP DEVICE
|
||||
'FONTCOERCIONS]
|
||||
@@ -3099,37 +2931,38 @@
|
||||
COLOR _ COLOR])
|
||||
|
||||
(FONTFACETOATOM
|
||||
[LAMBDA (FACE NOERROR) (* ; "Edited 7-Sep-2025 09:19 by rmk")
|
||||
(* ; "Edited 4-Sep-2025 08:45 by rmk")
|
||||
(if (type? FONTFACE FACE)
|
||||
then [PACK (LIST* (SELECTQ (fetch (FONTFACE WEIGHT) of FACE)
|
||||
(MEDIUM 'M)
|
||||
(BOLD 'B)
|
||||
(LIGHT 'L)
|
||||
(fetch (FONTFACE WEIGHT) of FACE))
|
||||
(SELECTQ (fetch (FONTFACE SLOPE) of FACE)
|
||||
(ITALIC 'I)
|
||||
(REGULAR 'R)
|
||||
(fetch (FONTFACE SLOPE) of FACE))
|
||||
(SELECTQ (fetch (FONTFACE EXPANSION) of FACE)
|
||||
(REGULAR 'R)
|
||||
(COMPRESSED 'C)
|
||||
(EXPANDED 'E)
|
||||
(fetch (FONTFACE EXPANSION) of FACE))
|
||||
(CL:WHEN (fetch (FONTFACE COLOR) of FACE)
|
||||
(LIST "-" (fetch (FONTFACE BACKCOLOR) of FACE)
|
||||
"-"
|
||||
(fetch (FONTFACE FORECOLOR) of FACE)))]
|
||||
elseif (AND FACE (LITATOM FACE)
|
||||
(MEMB (NTHCHARCODE FACE 1)
|
||||
(CHARCODE M B L))
|
||||
(MEMB (NTHCHARCODE FACE 2)
|
||||
(CHARCODE I R))
|
||||
(MEMB (NTHCHARCODE FACE 3)
|
||||
(CHARCODE R C E)))
|
||||
then FACE
|
||||
elseif (NOT NOERROR)
|
||||
then (\ILLEGAL.ARG FACE])
|
||||
[LAMBDA (FACE NOERROR) (* ; "Edited 22-Jan-2026 08:13 by rmk")
|
||||
(* ; "Edited 7-Sep-2025 09:19 by rmk")
|
||||
(LET (ATOM)
|
||||
(SETQ ATOM (if (type? FONTFACE FACE)
|
||||
then [PACK (LIST* (SELECTQ (fetch (FONTFACE WEIGHT) of FACE)
|
||||
(MEDIUM 'M)
|
||||
(BOLD 'B)
|
||||
(LIGHT 'L)
|
||||
(fetch (FONTFACE WEIGHT) of FACE))
|
||||
(SELECTQ (fetch (FONTFACE SLOPE) of FACE)
|
||||
(ITALIC 'I)
|
||||
(REGULAR 'R)
|
||||
(fetch (FONTFACE SLOPE) of FACE))
|
||||
(SELECTQ (fetch (FONTFACE EXPANSION) of FACE)
|
||||
(REGULAR 'R)
|
||||
(COMPRESSED 'C)
|
||||
(EXPANDED 'E)
|
||||
(fetch (FONTFACE EXPANSION) of FACE))
|
||||
(CL:WHEN (fetch (FONTFACE COLOR) of FACE)
|
||||
(LIST "-" (fetch (FONTFACE BACKCOLOR) of FACE)
|
||||
"-"
|
||||
(fetch (FONTFACE FORECOLOR) of FACE)))]
|
||||
elseif (AND FACE (LITATOM FACE)
|
||||
(MEMB (NTHCHARCODE FACE 1)
|
||||
(CHARCODE M B L *))
|
||||
(MEMB (NTHCHARCODE FACE 2)
|
||||
(CHARCODE I R *))
|
||||
(MEMB (NTHCHARCODE FACE 3)
|
||||
(CHARCODE R C E *)))
|
||||
then FACE
|
||||
elseif (NOT NOERROR)
|
||||
then (\ILLEGAL.ARG FACE])
|
||||
)
|
||||
|
||||
(RPAQ? \FONTSINCORE NIL)
|
||||
@@ -3253,7 +3086,8 @@
|
||||
OFFSETS _ (\CREATECSINFOELEMENT)
|
||||
CHARSETNO _ MAX.SMALLP)
|
||||
|
||||
(RECORD FONTSPEC (FSFAMILY FSSIZE FSFACE FSROTATION FSDEVICE))
|
||||
(RECORD FONTSPEC (FSFAMILY FSSIZE FSFACE FSROTATION FSDEVICE)
|
||||
(TYPE? LISTP))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'FONTCLASS '(BYTE POINTER POINTER POINTER POINTER POINTER)
|
||||
@@ -3620,7 +3454,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\CREATEFONT
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 25-Dec-2025 10:58 by rmk")
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 26-Jan-2026 15:24 by rmk")
|
||||
(* ; "Edited 25-Dec-2025 10:58 by rmk")
|
||||
(* ; "Edited 25-Sep-2025 21:24 by rmk")
|
||||
(* ; "Edited 28-Aug-2025 14:30 by rmk")
|
||||
(* ; "Edited 18-Aug-2025 00:17 by rmk")
|
||||
@@ -3636,18 +3471,28 @@
|
||||
(LET ([FN (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTSPEC FSDEVICE) of FONTSPEC)
|
||||
'FONTCREATE]
|
||||
FONT)
|
||||
(CL:WHEN FN
|
||||
(SETQ FONT (if (EQ (NARGS FN)
|
||||
1)
|
||||
then (APPLY* FN FONTSPEC)
|
||||
else (* ; "Old form: spreading FONTSPEC")
|
||||
(APPLY FN FONTSPEC)))
|
||||
(CL:UNLESS FONT
|
||||
(CL:WHEN (SETQ FONTSPEC (COERCEFONTSPEC FONTSPEC))
|
||||
(SETQ FONT (if (EQ (NARGS FN)
|
||||
1)
|
||||
then (APPLY* FN FONTSPEC)
|
||||
else (APPLY FN FONTSPEC))))))
|
||||
[if FN
|
||||
then (SETQ FONT (if (EQ (NARGS FN)
|
||||
1)
|
||||
then (APPLY* FN FONTSPEC)
|
||||
else (* ; "Old form: spreading FONTSPEC")
|
||||
(APPLY FN FONTSPEC)))
|
||||
(CL:UNLESS FONT
|
||||
(CL:WHEN (SETQ FONTSPEC (COERCEFONTSPEC FONTSPEC))
|
||||
(SETQ FONT (if (EQ (NARGS FN)
|
||||
1)
|
||||
then (APPLY* FN FONTSPEC)
|
||||
else (APPLY FN FONTSPEC)))))
|
||||
else (SETQ FONT (create FONTDESCRIPTOR
|
||||
FONTFAMILY _ (fetch (FONTSPEC FSFAMILY) of FONTSPEC)
|
||||
FONTSIZE _ (fetch (FONTSPEC FSSIZE) of FONTSPEC)
|
||||
FONTFACE _ (fetch (FONTSPEC FSFACE) of FONTSPEC)
|
||||
ROTATION _ (fetch (FONTSPEC FSROTATION) of FONTSPEC)
|
||||
FONTDEVICE _ (fetch (FONTSPEC FSDEVICE) of FONTSPEC)
|
||||
\SFAscent _ 0
|
||||
\SFDescent _ 0
|
||||
\SFHeight _ 0
|
||||
FONTDEVICESPEC _ (create FONTSPEC using FONTSPEC]
|
||||
FONT])
|
||||
|
||||
(\CREATECHARSET
|
||||
@@ -4640,44 +4485,43 @@
|
||||
(ADDTOVAR LAMA FONTCOPY)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (12139 21852 (CHARWIDTH 12149 . 12934) (CHARWIDTHY 12936 . 14453) (STRINGWIDTH 14455 .
|
||||
15548) (\CHARWIDTH.DISPLAY 15550 . 15963) (\STRINGWIDTH.DISPLAY 15965 . 16389) (\STRINGWIDTH.GENERIC
|
||||
16391 . 21850)) (21853 28373 (DEFAULTFONT 21863 . 23148) (FONTCLASS 23150 . 25312) (FONTCLASSUNPARSE
|
||||
25314 . 26213) (FONTCLASSCOMPONENT 26215 . 26803) (SETFONTCLASSCOMPONENT 26805 . 27247) (
|
||||
GETFONTCLASSCOMPONENT 27249 . 28371)) (30086 47590 (FONTCREATE 30096 . 33341) (FONTCREATE1 33343 .
|
||||
35958) (FONTCREATE.SLUGFD 35960 . 37442) (\FONT.CHECKARGS1 37444 . 41967) (\FONTCREATE1.NOFN 41969 .
|
||||
42183) (FONTFILEP 42185 . 43073) (\READCHARSET 43075 . 47588)) (47591 54667 (\FONT.CHECKARGS 47601 .
|
||||
54350) (\CHARSET.CHECK 54352 . 54665)) (54668 61279 (COERCEFONTSPEC 54678 . 60590) (
|
||||
COERCEFONTSPEC.TARGETFACE 60592 . 61277)) (63474 64813 (MAKEFONTSPEC 63484 . 64811)) (64814 72991 (
|
||||
COMPLETE.FONT 64824 . 67347) (COMPLETEFONTP 67349 . 67972) (COMPLETE.CHARSET 67974 . 70659) (
|
||||
PRUNESLUGCSINFOS 70661 . 71586) (MONOSPACEFONTP 71588 . 72989)) (73030 81285 (FONTASCENT 73040 . 73424
|
||||
) (FONTDESCENT 73426 . 73911) (FONTHEIGHT 73913 . 74315) (FONTPROP 74317 . 80562) (\AVGCHARWIDTH 80564
|
||||
. 81283)) (81942 82850 (FONTDEVICEPROP 81952 . 82848)) (82896 83750 (EDITCHAR 82906 . 83748)) (83796
|
||||
95986 (GETCHARBITMAP 83806 . 84930) (PUTCHARBITMAP 84932 . 87090) (\GETCHARBITMAP.CSINFO 87092 . 89108
|
||||
) (\PUTCHARBITMAP.CSINFO 89110 . 95984)) (95987 116467 (MOVECHARBITMAP 95997 . 97891) (MOVEFONTCHARS
|
||||
97893 . 101853) (\MOVEFONTCHAR 101855 . 106698) (\MOVEFONTCHARS.SOURCEDATA 106700 . 112805) (
|
||||
\MAKESLUGCHAR 112807 . 115342) (SLUGCHARP.DISPLAY 115344 . 116465)) (117400 138565 (FONTFILES 117410
|
||||
. 119243) (\FINDFONTFILE 119245 . 121554) (\FONTFILENAMES 121556 . 122551) (\FONTFILENAME 122553 .
|
||||
126536) (\FONTFILENAME.OLD 126538 . 129487) (\FONTFILENAME.NEW 129489 . 131746) (FONTSPECFROMFILENAME
|
||||
131748 . 136284) (\FONTINFOFROMFILENAME.OLD 136286 . 138563)) (138832 175407 (FONTCOPY 138842 . 143905
|
||||
) (FONTP 143907 . 144206) (FONTUNPARSE 144208 . 145927) (SETFONTDESCRIPTOR 145929 . 147393) (
|
||||
\STREAMCHARWIDTH 147395 . 151559) (\COERCECHARSET 151561 . 154928) (\BUILDSLUGCSINFO 154930 . 158553)
|
||||
(\FONTSYMBOL 158555 . 159205) (\DEVICESYMBOL 159207 . 160076) (\FONTFACE 160078 . 167268) (
|
||||
\FONTFACE.COLOR 167270 . 174190) (SETFONTCHARENCODING 174192 . 175405)) (175408 194969 (FONTSAVAILABLE
|
||||
175418 . 180772) (FONTEXISTS? 180774 . 184213) (\SEARCHFONTFILES 184215 . 187300) (FLUSHFONTCACHE
|
||||
187302 . 189525) (FINDFONTFILES 189527 . 192741) (SORTFONTSPECS 192743 . 194967)) (194970 198579 (
|
||||
MATCHFONTFACE 194980 . 195795) (MAKEFONTFACE 195797 . 196823) (FONTFACETOATOM 196825 . 198577)) (
|
||||
199210 199702 (\UNITWIDTHSVECTOR 199220 . 199700)) (214296 216363 (FONTDESCRIPTOR.DEFPRINT 214306 .
|
||||
215885) (FONTCLASS.DEFPRINT 215887 . 216361)) (220192 222982 (\CREATEKERNELEMENT 220202 . 220560) (
|
||||
\FSETLEFTKERN 220562 . 221053) (\FGETLEFTKERN 221055 . 222980)) (222983 233135 (\CREATEFONT 222993 .
|
||||
224948) (\CREATECHARSET 224950 . 228886) (\INSTALLCHARSETINFO 228888 . 232222) (
|
||||
\INSTALLCHARSETINFO.CHARENCODING 232224 . 233133)) (233457 234821 (\FONTRESETCHARWIDTHS 233467 .
|
||||
234819)) (235451 245492 (\CREATEDISPLAYFONT 235461 . 237310) (\CREATECHARSET.DISPLAY 237312 . 243021)
|
||||
(\FONTEXISTS?.DISPLAY 243023 . 245490)) (245493 260358 (STRIKEFONT.FILEP 245503 . 246391) (
|
||||
STRIKEFONT.GETCHARSET 246393 . 251985) (WRITESTRIKEFONTFILE 251987 . 256898) (STRIKECSINFO 256900 .
|
||||
260356)) (260389 276706 (MAKEBOLD.CHARSET 260399 . 264048) (MAKEBOLD.CHAR 264050 . 265802) (
|
||||
MAKEITALIC.CHARSET 265804 . 269477) (MAKEITALIC.CHAR 269479 . 271825) (\SFMAKEBOLD 271827 . 274051) (
|
||||
\SFMAKEITALIC 274053 . 276704)) (276707 280856 (\SFMAKEROTATEDFONT 276717 . 278118) (\SFROTATECSINFO
|
||||
278120 . 278757) (\SFROTATEFONTCHARACTERS 278759 . 279139) (\SFROTATECSINFOOFFSETS 279141 . 280854)) (
|
||||
280857 282238 (\SFMAKECOLOR 280867 . 282236)))))
|
||||
(FILEMAP (NIL (11414 21127 (CHARWIDTH 11424 . 12209) (CHARWIDTHY 12211 . 13728) (STRINGWIDTH 13730 .
|
||||
14823) (\CHARWIDTH.DISPLAY 14825 . 15238) (\STRINGWIDTH.DISPLAY 15240 . 15664) (\STRINGWIDTH.GENERIC
|
||||
15666 . 21125)) (21128 27648 (DEFAULTFONT 21138 . 22423) (FONTCLASS 22425 . 24587) (FONTCLASSUNPARSE
|
||||
24589 . 25488) (FONTCLASSCOMPONENT 25490 . 26078) (SETFONTCLASSCOMPONENT 26080 . 26522) (
|
||||
GETFONTCLASSCOMPONENT 26524 . 27646)) (29361 46989 (FONTCREATE 29371 . 32616) (FONTCREATE1 32618 .
|
||||
35233) (FONTCREATE.SLUGFD 35235 . 36717) (\FONT.CHECKARGS1 36719 . 41242) (\FONTCREATE1.NOFN 41244 .
|
||||
41458) (FONTFILEP 41460 . 42348) (\READCHARSET 42350 . 46987)) (46990 54066 (\FONT.CHECKARGS 47000 .
|
||||
53749) (\CHARSET.CHECK 53751 . 54064)) (54067 60678 (COERCEFONTSPEC 54077 . 59989) (
|
||||
COERCEFONTSPEC.TARGETFACE 59991 . 60676)) (62873 64212 (MAKEFONTSPEC 62883 . 64210)) (64213 72390 (
|
||||
COMPLETE.FONT 64223 . 66746) (COMPLETEFONTP 66748 . 67371) (COMPLETE.CHARSET 67373 . 70058) (
|
||||
PRUNESLUGCSINFOS 70060 . 70985) (MONOSPACEFONTP 70987 . 72388)) (72429 80875 (FONTASCENT 72439 . 72823
|
||||
) (FONTDESCENT 72825 . 73310) (FONTHEIGHT 73312 . 73714) (FONTPROP 73716 . 80152) (\AVGCHARWIDTH 80154
|
||||
. 80873)) (81532 82440 (FONTDEVICEPROP 81542 . 82438)) (82486 83340 (EDITCHAR 82496 . 83338)) (83386
|
||||
95576 (GETCHARBITMAP 83396 . 84520) (PUTCHARBITMAP 84522 . 86680) (\GETCHARBITMAP.CSINFO 86682 . 88698
|
||||
) (\PUTCHARBITMAP.CSINFO 88700 . 95574)) (95577 116057 (MOVECHARBITMAP 95587 . 97481) (MOVEFONTCHARS
|
||||
97483 . 101443) (\MOVEFONTCHAR 101445 . 106288) (\MOVEFONTCHARS.SOURCEDATA 106290 . 112395) (
|
||||
\MAKESLUGCHAR 112397 . 114932) (SLUGCHARP.DISPLAY 114934 . 116055)) (116715 128552 (FONTFILES 116725
|
||||
. 118558) (\FINDFONTFILE 118560 . 120537) (\FONTFILENAMES 120539 . 121099) (\FONTFILENAME 121101 .
|
||||
124012) (FONTSPECFROMFILENAME 124014 . 128550)) (128553 165128 (FONTCOPY 128563 . 133626) (FONTP
|
||||
133628 . 133927) (FONTUNPARSE 133929 . 135648) (SETFONTDESCRIPTOR 135650 . 137114) (\STREAMCHARWIDTH
|
||||
137116 . 141280) (\COERCECHARSET 141282 . 144649) (\BUILDSLUGCSINFO 144651 . 148274) (\FONTSYMBOL
|
||||
148276 . 148926) (\DEVICESYMBOL 148928 . 149797) (\FONTFACE 149799 . 156989) (\FONTFACE.COLOR 156991
|
||||
. 163911) (SETFONTCHARENCODING 163913 . 165126)) (165129 184790 (FONTSAVAILABLE 165139 . 170493) (
|
||||
FONTEXISTS? 170495 . 174034) (\SEARCHFONTFILES 174036 . 177121) (FLUSHFONTCACHE 177123 . 179346) (
|
||||
FINDFONTFILES 179348 . 182562) (SORTFONTSPECS 182564 . 184788)) (184791 188898 (MATCHFONTFACE 184801
|
||||
. 185616) (MAKEFONTFACE 185618 . 186644) (FONTFACETOATOM 186646 . 188896)) (189529 190021 (
|
||||
\UNITWIDTHSVECTOR 189539 . 190019)) (204650 206717 (FONTDESCRIPTOR.DEFPRINT 204660 . 206239) (
|
||||
FONTCLASS.DEFPRINT 206241 . 206715)) (210546 213336 (\CREATEKERNELEMENT 210556 . 210914) (
|
||||
\FSETLEFTKERN 210916 . 211407) (\FGETLEFTKERN 211409 . 213334)) (213337 224412 (\CREATEFONT 213347 .
|
||||
216225) (\CREATECHARSET 216227 . 220163) (\INSTALLCHARSETINFO 220165 . 223499) (
|
||||
\INSTALLCHARSETINFO.CHARENCODING 223501 . 224410)) (224734 226098 (\FONTRESETCHARWIDTHS 224744 .
|
||||
226096)) (226728 236769 (\CREATEDISPLAYFONT 226738 . 228587) (\CREATECHARSET.DISPLAY 228589 . 234298)
|
||||
(\FONTEXISTS?.DISPLAY 234300 . 236767)) (236770 251635 (STRIKEFONT.FILEP 236780 . 237668) (
|
||||
STRIKEFONT.GETCHARSET 237670 . 243262) (WRITESTRIKEFONTFILE 243264 . 248175) (STRIKECSINFO 248177 .
|
||||
251633)) (251666 267983 (MAKEBOLD.CHARSET 251676 . 255325) (MAKEBOLD.CHAR 255327 . 257079) (
|
||||
MAKEITALIC.CHARSET 257081 . 260754) (MAKEITALIC.CHAR 260756 . 263102) (\SFMAKEBOLD 263104 . 265328) (
|
||||
\SFMAKEITALIC 265330 . 267981)) (267984 272133 (\SFMAKEROTATEDFONT 267994 . 269395) (\SFROTATECSINFO
|
||||
269397 . 270034) (\SFROTATEFONTCHARACTERS 270036 . 270416) (\SFROTATECSINFOOFFSETS 270418 . 272131)) (
|
||||
272134 273515 (\SFMAKECOLOR 272144 . 273513)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
187
sources/HARDCOPY
187
sources/HARDCOPY
@@ -1,14 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jan-2026 17:17:23" {WMEDLEY}<sources>HARDCOPY.;155 147674
|
||||
(FILECREATED "29-Jan-2026 10:45:17" {WMEDLEY}<sources>HARDCOPY.;160 149481
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS HARDCOPYCOMS)
|
||||
(FNS TEXT.TO.IMAGEFILE TEXTTOIMAGEFILE VIEWERPRINT PRINTERDEVICE.OPENFN
|
||||
SEND.FILE.TO.PRINTER)
|
||||
:CHANGES-TO (FNS PRINTERNAME FIND.PRINTER.FOR.IMAGETYPE PRINTERDEVICE.OPENFN PRINTERTYPE)
|
||||
|
||||
:PREVIOUS-DATE "18-Jan-2026 15:20:21" {WMEDLEY}<sources>HARDCOPY.;149)
|
||||
:PREVIOUS-DATE "27-Jan-2026 23:11:17" {WMEDLEY}<sources>HARDCOPY.;157)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT HARDCOPYCOMS)
|
||||
@@ -52,11 +50,14 @@
|
||||
(FNS SCALEREGION)
|
||||
[COMS (* ;
|
||||
"Converting text files to imagestreams")
|
||||
(GLOBALVARS TEXTDEFAULTPAGEREGION)
|
||||
[INITVARS (TEXTDEFAULTPAGEREGION (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25
|
||||
9.75]
|
||||
(GLOBALVARS TEXTDEFAULTPAGEREGION)
|
||||
(ALISTS (IMAGESTREAMTYPES TEXT)
|
||||
(PRINTFILETYPES TEXT))
|
||||
(FNS TEXT.TO.IMAGEFILE COPY.TEXT.TO.IMAGE TEXTTOIMAGEFILE)
|
||||
(P (DEFAULT.IMAGETYPE.CONVERSIONS '(TEXT TEXT.TO.IMAGEFILE]
|
||||
(P (FONTPROFILE.ADDDEVICE 'TEXT)
|
||||
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEXT TEXT.TO.IMAGEFILE]
|
||||
(COMS (* ;
|
||||
"hack for printers that can't really BLTSHADE")
|
||||
(FNS \BLTSHADE.GENERICPRINTER))
|
||||
@@ -369,7 +370,8 @@
|
||||
(AND STATUSFN (APPLY* STATUSFN PRINTER])
|
||||
|
||||
(PRINTERTYPE
|
||||
[LAMBDA (HOST PREFERRED NODEFAULT) (* ; "Edited 18-Jan-2026 14:47 by rmk")
|
||||
[LAMBDA (HOST PREFERRED NODEFAULT) (* ; "Edited 28-Jan-2026 23:55 by rmk")
|
||||
(* ; "Edited 18-Jan-2026 14:47 by rmk")
|
||||
(* ; "Edited 16-Jan-2026 07:35 by rmk")
|
||||
(* ; "Edited 17-Dec-2025 00:52 by rmk")
|
||||
(* ; "Edited 14-Dec-2025 17:53 by rmk")
|
||||
@@ -378,11 +380,6 @@
|
||||
(* ; "Edited 19-Sep-2025 10:18 by rmk")
|
||||
(* ; "Edited 27-Apr-98 16:16 by rmk:")
|
||||
(* ; "Edited 15-Feb-91 14:14 by gadener")
|
||||
|
||||
(* ;;
|
||||
"We uppercase before we look at the printer HOSTNAMEP functions--they can handle the casing")
|
||||
|
||||
(SETQ HOST (MKATOM HOST))
|
||||
(COND
|
||||
((NULL HOST)
|
||||
DEFAULTPRINTERTYPE)
|
||||
@@ -424,7 +421,8 @@
|
||||
DEFAULTPRINTERTYPE])
|
||||
|
||||
(PRINTERNAME
|
||||
[LAMBDA (PRINTER) (* ; "Edited 5-Dec-2025 09:35 by rmk")
|
||||
[LAMBDA (PRINTER) (* ; "Edited 29-Jan-2026 10:44 by rmk")
|
||||
(* ; "Edited 5-Dec-2025 09:35 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 09:59 by rmk")
|
||||
|
||||
(* ;;
|
||||
@@ -432,17 +430,20 @@
|
||||
|
||||
(* ;; "Takes a printer-spec (in form (type printer-name) or just printer-name) and returns printer-name. returns nil for null arg.")
|
||||
|
||||
(CL:WHEN (LISTP PRINTER)
|
||||
(SETQ PRINTER (CADR PRINTER)))
|
||||
(CL:WHEN (PRINTERDEVICEP PRINTER)
|
||||
[LET (FDEV)
|
||||
(if (AND (STREAMP PRINTER)
|
||||
(STREAMPROP PRINTER 'PRINTERNAME))
|
||||
else (SETQ FDEV (TRUEDEVICE PRINTER))
|
||||
(if (EQ 'LPT (fetch (FDEV DEVICENAME) of FDEV))
|
||||
then (CL:UNLESS [EQ '%. (SETQ PRINTER (FILENAMEFIELD PRINTER 'NAME]
|
||||
PRINTER)
|
||||
else (fetch (FDEV DEVICENAME) of FDEV])])
|
||||
(if (LISTP PRINTER)
|
||||
then (CADR PRINTER)
|
||||
elseif (LITATOM PRINTER)
|
||||
then PRINTER
|
||||
elseif (PRINTERDEVICEP PRINTER)
|
||||
then (LET (FDEV)
|
||||
(if (AND (STREAMP PRINTER)
|
||||
(STREAMPROP PRINTER 'PRINTERNAME))
|
||||
else (SETQ FDEV (TRUEDEVICE PRINTER))
|
||||
(if (EQ 'LPT (fetch (FDEV DEVICENAME) of FDEV))
|
||||
then (CL:UNLESS [EQ '%. (SETQ PRINTER (FILENAMEFIELD PRINTER
|
||||
'NAME]
|
||||
PRINTER)
|
||||
else (fetch (FDEV DEVICENAME) of FDEV])
|
||||
|
||||
(PRINTFILETYPE
|
||||
[LAMBDA (FILE DONTOPEN) (* ; "Edited 24-Dec-2025 20:39 by rmk")
|
||||
@@ -542,7 +543,8 @@
|
||||
IMAGESOURCE)))])])
|
||||
|
||||
(FIND.PRINTER.FOR.IMAGETYPE
|
||||
[LAMBDA (IMAGETYPE HOST) (* ; "Edited 12-Jan-2026 23:49 by rmk")
|
||||
[LAMBDA (IMAGETYPE HOST) (* ; "Edited 29-Jan-2026 10:29 by rmk")
|
||||
(* ; "Edited 12-Jan-2026 23:49 by rmk")
|
||||
(* ; "Edited 28-Dec-2025 18:02 by rmk")
|
||||
(* ; "Edited 23-Dec-2025 10:13 by rmk")
|
||||
(* ; "Edited 17-Dec-2025 00:59 by rmk")
|
||||
@@ -559,22 +561,19 @@
|
||||
|
||||
(CL:WHEN (SETQ TARGETTYPE (CAN.PRINT.SOMEHOW HOST IMAGETYPE))
|
||||
(LIST (PRINTERTYPE HOST)
|
||||
HOST TARGETTYPE))
|
||||
(PRINTERNAME HOST)
|
||||
TARGETTYPE))
|
||||
elseif (for PRINTER in (DEFAULTPRINTERS) when (SETQ TARGETTYPE (CAN.PRINT.SOMEHOW PRINTER
|
||||
IMAGETYPE T))
|
||||
do (* ; "Direct?")
|
||||
(RETURN (LIST (PRINTERTYPE PRINTER)
|
||||
(CL:IF (LISTP PRINTER)
|
||||
(CADR PRINTER)
|
||||
PRINTER)
|
||||
(PRINTERNAME PRINTER)
|
||||
TARGETTYPE)))
|
||||
else (for PRINTER in (DEFAULTPRINTERS) when (SETQ TARGETTYPE (CAN.PRINT.SOMEHOW PRINTER
|
||||
IMAGETYPE))
|
||||
do (* ; "Conversion")
|
||||
(RETURN (LIST (PRINTERTYPE PRINTER)
|
||||
(CL:IF (LISTP PRINTER)
|
||||
(CADR PRINTER)
|
||||
PRINTER)
|
||||
(PRINTERNAME PRINTER)
|
||||
TARGETTYPE])
|
||||
|
||||
(CAN.PRINT.SOMEHOW
|
||||
@@ -626,7 +625,8 @@
|
||||
LPTNAME])
|
||||
|
||||
(PRINTERDEVICE.OPENFN
|
||||
[LAMBDA (LPTNAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* ; "Edited 19-Jan-2026 12:19 by rmk")
|
||||
[LAMBDA (LPTNAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* ; "Edited 29-Jan-2026 00:13 by rmk")
|
||||
(* ; "Edited 19-Jan-2026 12:19 by rmk")
|
||||
(* ; "Edited 16-Jan-2026 23:09 by rmk")
|
||||
(* ; "Edited 28-Dec-2025 17:44 by rmk")
|
||||
(* ; "Edited 11-Sep-2025 17:03 by rmk")
|
||||
@@ -656,14 +656,25 @@
|
||||
"The case of foo.local as a printer name with no type")
|
||||
(SETQ PRINTERNAME PN)
|
||||
(SETQ IMAGEFILETYPE NIL))
|
||||
(CL:UNLESS PRINTERNAME (SETQ PRINTERNAME :DEFAULTPRINTER))
|
||||
|
||||
(* ;; "Filename is now decoded")
|
||||
|
||||
[if IMAGEFILETYPE
|
||||
[if (AND IMAGEFILETYPE PRINTERNAME)
|
||||
then (CL:UNLESS (CAN.PRINT.SOMEHOW PRINTERNAME IMAGEFILETYPE)
|
||||
(* ; "{LPT}P.T")
|
||||
(ERROR PRINTERNAME (CONCAT "cannot print files of type " IMAGEFILETYPE)))
|
||||
else (SETQ IMAGEFILETYPE (CAR (PRINTERPROP (PRINTERTYPE PRINTERNAME)
|
||||
elseif PRINTERNAME
|
||||
then (* ; "{LPT}P")
|
||||
[SETQ IMAGEFILETYPE (CAR (PRINTERPROP (PRINTERTYPE PRINTERNAME)
|
||||
'CANPRINT]
|
||||
elseif IMAGEFILETYPE
|
||||
then (* ; "{LPT}.T")
|
||||
(CL:UNLESS (SETQ PRINTERNAME (FIND.PRINTER.FOR.IMAGETYPE IMAGEFILETYPE))
|
||||
(ERROR "No printers for " IMAGEFILETYPE " files" (CONCAT
|
||||
"cannot print files of type "
|
||||
IMAGEFILETYPE)))
|
||||
else (SETQ PRINTERNAME :DEFAULTPRINTER) (* ; "Just {LPT}")
|
||||
(SETQ IMAGEFILETYPE (CAR (PRINTERPROP (PRINTERTYPE PRINTERNAME)
|
||||
'CANPRINT]
|
||||
|
||||
(* ;; "Open as a regular Unix tmp stream... with a funky closefn")
|
||||
@@ -723,7 +734,8 @@
|
||||
(fetch (FDEV DEVICENAME) of FDEV))))])
|
||||
|
||||
(PRINTERNAME
|
||||
[LAMBDA (PRINTER) (* ; "Edited 5-Dec-2025 09:35 by rmk")
|
||||
[LAMBDA (PRINTER) (* ; "Edited 29-Jan-2026 10:44 by rmk")
|
||||
(* ; "Edited 5-Dec-2025 09:35 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 09:59 by rmk")
|
||||
|
||||
(* ;;
|
||||
@@ -731,17 +743,20 @@
|
||||
|
||||
(* ;; "Takes a printer-spec (in form (type printer-name) or just printer-name) and returns printer-name. returns nil for null arg.")
|
||||
|
||||
(CL:WHEN (LISTP PRINTER)
|
||||
(SETQ PRINTER (CADR PRINTER)))
|
||||
(CL:WHEN (PRINTERDEVICEP PRINTER)
|
||||
[LET (FDEV)
|
||||
(if (AND (STREAMP PRINTER)
|
||||
(STREAMPROP PRINTER 'PRINTERNAME))
|
||||
else (SETQ FDEV (TRUEDEVICE PRINTER))
|
||||
(if (EQ 'LPT (fetch (FDEV DEVICENAME) of FDEV))
|
||||
then (CL:UNLESS [EQ '%. (SETQ PRINTER (FILENAMEFIELD PRINTER 'NAME]
|
||||
PRINTER)
|
||||
else (fetch (FDEV DEVICENAME) of FDEV])])
|
||||
(if (LISTP PRINTER)
|
||||
then (CADR PRINTER)
|
||||
elseif (LITATOM PRINTER)
|
||||
then PRINTER
|
||||
elseif (PRINTERDEVICEP PRINTER)
|
||||
then (LET (FDEV)
|
||||
(if (AND (STREAMP PRINTER)
|
||||
(STREAMPROP PRINTER 'PRINTERNAME))
|
||||
else (SETQ FDEV (TRUEDEVICE PRINTER))
|
||||
(if (EQ 'LPT (fetch (FDEV DEVICENAME) of FDEV))
|
||||
then (CL:UNLESS [EQ '%. (SETQ PRINTER (FILENAMEFIELD PRINTER
|
||||
'NAME]
|
||||
PRINTER)
|
||||
else (fetch (FDEV DEVICENAME) of FDEV])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -839,12 +854,18 @@
|
||||
|
||||
(* ; "Converting text files to imagestreams")
|
||||
|
||||
|
||||
(RPAQ? TEXTDEFAULTPAGEREGION (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25 9.75)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEXTDEFAULTPAGEREGION)
|
||||
)
|
||||
|
||||
(RPAQ? TEXTDEFAULTPAGEREGION (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25 9.75)))
|
||||
|
||||
(ADDTOVAR IMAGESTREAMTYPES (TEXT (FONTCREATE \CREATEDISPLAYFONT)
|
||||
(CREATECHARSET \CREATECHARSET.DISPLAY)))
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES (TEXT (TEST LISPSOURCEFILEP)
|
||||
(EXTENSION (TXT TEXT))))
|
||||
(DEFINEQ
|
||||
|
||||
(TEXT.TO.IMAGEFILE
|
||||
@@ -970,6 +991,8 @@
|
||||
(TEDIT.TO.IMAGEFILE FILE IMAGEFILE IMAGETYPE OPTIONS])
|
||||
)
|
||||
|
||||
(FONTPROFILE.ADDDEVICE 'TEXT)
|
||||
|
||||
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEXT TEXT.TO.IMAGEFILE))
|
||||
|
||||
|
||||
@@ -2330,35 +2353,35 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6606 19331 (MakeMenuOfPrinters 6616 . 8105) (PRINTERS.WHENSELECTEDFN 8107 . 10038) (
|
||||
MakeMenuOfImageTypes 10040 . 10859) (GetNewPrinterFromUser 10861 . 11417) (PopUpWindowAndGetAtom 11419
|
||||
. 12870) (PopUpWindowAndGetList 12872 . 14442) (NewPrinter 14444 . 16058) (GetPrinterName 16060 .
|
||||
16348) (GetImageFile 16350 . 19329)) (19386 37306 (HARDCOPYW 19396 . 20869) (LISTFILES1 20871 . 21048)
|
||||
(PRINTERPROP 21050 . 21300) (PRINTERSTATUS 21302 . 21577) (PRINTERTYPE 21579 . 24855) (PRINTERNAME
|
||||
24857 . 25943) (PRINTFILETYPE 25945 . 26318) (PRINTERTYPEP 26320 . 26545) (SEND.FILE.TO.PRINTER 26547
|
||||
. 32796) (FIND.PRINTER.FOR.IMAGETYPE 32798 . 35503) (CAN.PRINT.SOMEHOW 35505 . 36877) (
|
||||
CAN.PRINT.DIRECTLY 36879 . 37304)) (37307 45651 (PRINTERDEVICE 37317 . 38926) (PRINTERDEVICE.OPENFN
|
||||
38928 . 41914) (PRINTERDEVICE.CLOSEFN 41916 . 43635) (PRINTERDEVICEP 43637 . 44561) (PRINTERNAME 44563
|
||||
. 45649)) (45713 48137 (DEFAULTPRINTERS 45723 . 48135)) (48536 49833 (VIEWERPRINT 48546 . 49831)) (
|
||||
49951 50509 (SCALEREGION 49961 . 50507)) (50733 58555 (TEXT.TO.IMAGEFILE 50743 . 51956) (
|
||||
COPY.TEXT.TO.IMAGE 51958 . 58306) (TEXTTOIMAGEFILE 58308 . 58553)) (58676 60419 (
|
||||
\BLTSHADE.GENERICPRINTER 58686 . 60417)) (60486 97652 (MAKEHARDCOPYSTREAM 60496 . 62212) (
|
||||
UNMAKEHARDCOPYSTREAM 62214 . 63144) (HARDCOPYSTREAMTYPE 63146 . 63553) (\CHARWIDTH.HDCPYDISPLAY 63555
|
||||
. 64375) (\DSPFONT.HDCPYDISPLAY 64377 . 67172) (\DSPRIGHTMARGIN.HDCPYDISPLAY 67174 . 68029) (
|
||||
\DSPXPOSITION.HDCPYDISPLAY 68031 . 68406) (\DSPYPOSITION.HDCPYDISPLAY 68408 . 68783) (
|
||||
\STRINGWIDTH.HDCPYDISPLAY 68785 . 69740) (\STRINGWIDTH.HCPYDISPLAYAUX 69742 . 75082) (\HDCPYBLTCHAR
|
||||
75084 . 79981) (\HDCPYDISPLAY.FIX.XPOS 79983 . 80740) (\HDCPYDISPLAY.FIX.YPOS 80742 . 81483) (
|
||||
\HDCPYDISPLAYINIT 81485 . 83175) (\HDCPYDSPPRINTCHAR 83177 . 89090) (\SLOWHDCPYBLTCHAR 89092 . 95708)
|
||||
(\CHANGECHARSET.HDCPYDISPLAY 95710 . 97650)) (97967 147518 (MAKEHARDCOPYMODESTREAM 97977 . 100698) (
|
||||
UNMAKEHARDCOPYMODESTREAM 100700 . 102290) (\HCPYDISPLAYIMAGEOPS 102292 . 105112) (\BLTSHADE.HCPYMODE
|
||||
105114 . 105780) (\BITBLT.HCPYMODE 105782 . 106530) (\BRUSHCONVERT.HCPYMODE 106532 . 107081) (
|
||||
\CHANGECHARSET.HCPYMODE 107083 . 110345) (\DASHINGCONVERT.HCPYMODE 110347 . 110688) (
|
||||
\CHARWIDTH.HCPYMODE 110690 . 111127) (\DRAWLINE.HCPYMODE 111129 . 111658) (\DRAWCURVE.HCPYMODE 111660
|
||||
. 112247) (\DRAWCIRCLE.HCPYMODE 112249 . 112734) (\DRAWELLIPSE.HCPYMODE 112736 . 113420) (
|
||||
\DSPFONT.HCPYMODE 113422 . 116106) (\DSPLEFTMARGIN.HCPYMODE 116108 . 116850) (\DSPLINEFEED.HCPYMODE
|
||||
116852 . 117485) (\DSPRIGHTMARGIN.HCPYMODE 117487 . 118555) (\DSPSPACEFACTOR.HCPYMODE 118557 . 119332)
|
||||
(\DSPXPOSITION.HCPYMODE 119334 . 120352) (\DSPYPOSITION.HCPYMODE 120354 . 121004) (\MOVETO.HCPYMODE
|
||||
121006 . 121220) (\FONTCREATE.HCPYMODE 121222 . 123179) (\CREATECHARSET.HCPYMODE 123181 . 124904) (
|
||||
\STRINGWIDTH.HCPYMODE 124906 . 125701) (\HCPYMODEBLTCHAR 125703 . 131453) (\HCPYMODEDSPPRINTCHAR
|
||||
131455 . 137389) (\SLOWHCPYMODEBLTCHAR 137391 . 144020) (\SFFixY.HCPYMODE 144022 . 147516)))))
|
||||
(FILEMAP (NIL (6665 19390 (MakeMenuOfPrinters 6675 . 8164) (PRINTERS.WHENSELECTEDFN 8166 . 10097) (
|
||||
MakeMenuOfImageTypes 10099 . 10918) (GetNewPrinterFromUser 10920 . 11476) (PopUpWindowAndGetAtom 11478
|
||||
. 12929) (PopUpWindowAndGetList 12931 . 14501) (NewPrinter 14503 . 16117) (GetPrinterName 16119 .
|
||||
16407) (GetImageFile 16409 . 19388)) (19445 37555 (HARDCOPYW 19455 . 20928) (LISTFILES1 20930 . 21107)
|
||||
(PRINTERPROP 21109 . 21359) (PRINTERSTATUS 21361 . 21636) (PRINTERTYPE 21638 . 24874) (PRINTERNAME
|
||||
24876 . 26243) (PRINTFILETYPE 26245 . 26618) (PRINTERTYPEP 26620 . 26845) (SEND.FILE.TO.PRINTER 26847
|
||||
. 33096) (FIND.PRINTER.FOR.IMAGETYPE 33098 . 35752) (CAN.PRINT.SOMEHOW 35754 . 37126) (
|
||||
CAN.PRINT.DIRECTLY 37128 . 37553)) (37556 47168 (PRINTERDEVICE 37566 . 39175) (PRINTERDEVICE.OPENFN
|
||||
39177 . 43150) (PRINTERDEVICE.CLOSEFN 43152 . 44871) (PRINTERDEVICEP 44873 . 45797) (PRINTERNAME 45799
|
||||
. 47166)) (47230 49654 (DEFAULTPRINTERS 47240 . 49652)) (50053 51350 (VIEWERPRINT 50063 . 51348)) (
|
||||
51468 52026 (SCALEREGION 51478 . 52024)) (52509 60331 (TEXT.TO.IMAGEFILE 52519 . 53732) (
|
||||
COPY.TEXT.TO.IMAGE 53734 . 60082) (TEXTTOIMAGEFILE 60084 . 60329)) (60483 62226 (
|
||||
\BLTSHADE.GENERICPRINTER 60493 . 62224)) (62293 99459 (MAKEHARDCOPYSTREAM 62303 . 64019) (
|
||||
UNMAKEHARDCOPYSTREAM 64021 . 64951) (HARDCOPYSTREAMTYPE 64953 . 65360) (\CHARWIDTH.HDCPYDISPLAY 65362
|
||||
. 66182) (\DSPFONT.HDCPYDISPLAY 66184 . 68979) (\DSPRIGHTMARGIN.HDCPYDISPLAY 68981 . 69836) (
|
||||
\DSPXPOSITION.HDCPYDISPLAY 69838 . 70213) (\DSPYPOSITION.HDCPYDISPLAY 70215 . 70590) (
|
||||
\STRINGWIDTH.HDCPYDISPLAY 70592 . 71547) (\STRINGWIDTH.HCPYDISPLAYAUX 71549 . 76889) (\HDCPYBLTCHAR
|
||||
76891 . 81788) (\HDCPYDISPLAY.FIX.XPOS 81790 . 82547) (\HDCPYDISPLAY.FIX.YPOS 82549 . 83290) (
|
||||
\HDCPYDISPLAYINIT 83292 . 84982) (\HDCPYDSPPRINTCHAR 84984 . 90897) (\SLOWHDCPYBLTCHAR 90899 . 97515)
|
||||
(\CHANGECHARSET.HDCPYDISPLAY 97517 . 99457)) (99774 149325 (MAKEHARDCOPYMODESTREAM 99784 . 102505) (
|
||||
UNMAKEHARDCOPYMODESTREAM 102507 . 104097) (\HCPYDISPLAYIMAGEOPS 104099 . 106919) (\BLTSHADE.HCPYMODE
|
||||
106921 . 107587) (\BITBLT.HCPYMODE 107589 . 108337) (\BRUSHCONVERT.HCPYMODE 108339 . 108888) (
|
||||
\CHANGECHARSET.HCPYMODE 108890 . 112152) (\DASHINGCONVERT.HCPYMODE 112154 . 112495) (
|
||||
\CHARWIDTH.HCPYMODE 112497 . 112934) (\DRAWLINE.HCPYMODE 112936 . 113465) (\DRAWCURVE.HCPYMODE 113467
|
||||
. 114054) (\DRAWCIRCLE.HCPYMODE 114056 . 114541) (\DRAWELLIPSE.HCPYMODE 114543 . 115227) (
|
||||
\DSPFONT.HCPYMODE 115229 . 117913) (\DSPLEFTMARGIN.HCPYMODE 117915 . 118657) (\DSPLINEFEED.HCPYMODE
|
||||
118659 . 119292) (\DSPRIGHTMARGIN.HCPYMODE 119294 . 120362) (\DSPSPACEFACTOR.HCPYMODE 120364 . 121139)
|
||||
(\DSPXPOSITION.HCPYMODE 121141 . 122159) (\DSPYPOSITION.HCPYMODE 122161 . 122811) (\MOVETO.HCPYMODE
|
||||
122813 . 123027) (\FONTCREATE.HCPYMODE 123029 . 124986) (\CREATECHARSET.HCPYMODE 124988 . 126711) (
|
||||
\STRINGWIDTH.HCPYMODE 126713 . 127508) (\HCPYMODEBLTCHAR 127510 . 133260) (\HCPYMODEDSPPRINTCHAR
|
||||
133262 . 139196) (\SLOWHCPYMODEBLTCHAR 139198 . 145827) (\SFFixY.HCPYMODE 145829 . 149323)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
203
sources/IMAGEIO
203
sources/IMAGEIO
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jan-2026 14:08:55" {WMEDLEY}<sources>IMAGEIO.;51 99943
|
||||
(FILECREATED "29-Jan-2026 08:48:22" {WMEDLEY}<sources>IMAGEIO.;60 100411
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS IMAGESTREAMTYPE)
|
||||
:CHANGES-TO (VARS IMAGEIOCOMS)
|
||||
|
||||
:PREVIOUS-DATE "18-Jan-2026 15:04:58" {WMEDLEY}<sources>IMAGEIO.;50)
|
||||
:PREVIOUS-DATE "29-Jan-2026 00:29:52" {WMEDLEY}<sources>IMAGEIO.;57)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IMAGEIOCOMS)
|
||||
@@ -19,17 +19,18 @@
|
||||
(FNS CONVERT.TO.IMAGEFILE)
|
||||
(FNS BITMAPFILEP BITMAP.TO.BITMAPFILE BITMAPFILE.TO.BITMAP BITMAPFILE.TO.IMAGEFILE)
|
||||
(FNS BITMAP.TO.IMAGEFILE WINDOW.TO.IMAGEFILE SCREENREGION.TO.IMAGEFILE COPY.WINDOW.TO.BITMAP)
|
||||
(COMS (ADDVARS (PRINTFILETYPES (DEFAULT)))
|
||||
(COMS (* ; "PRINTFILETYPES")
|
||||
(INITVARS (PRINTFILETYPES NIL))
|
||||
(GLOBALVARS PRINTFILETYPES)
|
||||
(FNS DEFAULT.IMAGETYPE.CONVERSIONS)
|
||||
[P (DEFAULT.IMAGETYPE.CONVERSIONS '(BITMAP BITMAP.TO.IMAGEFILE WINDOW
|
||||
WINDOW.TO.IMAGEFILE SCREENREGION
|
||||
SCREENREGION.TO.IMAGEFILE BITMAPFILE
|
||||
BITMAPFILE.TO.IMAGEFILE]
|
||||
(ALISTS (PRINTFILETYPES BITMAP WINDOW SCREENREGION BITMAPFILE TEXT)))
|
||||
(COMS (* ; "Until HTML streams")
|
||||
(ALISTS (PRINTFILETYPES HTML))
|
||||
(FNS HTMLFILEP))
|
||||
(ALISTS (PRINTFILETYPES BITMAP WINDOW SCREENREGION BITMAPFILE))
|
||||
(COMS (* ; "Until HTML streams")
|
||||
(ALISTS (PRINTFILETYPES HTML))
|
||||
(FNS HTMLFILEP)))
|
||||
(INITVARS (IMAGESTREAMTYPES NIL))
|
||||
(FNS \GOOD.DASHLST)
|
||||
(FNS DRAWDASHEDLINE)
|
||||
@@ -220,6 +221,7 @@
|
||||
|
||||
(CONVERT.TO.IMAGEFILE
|
||||
[LAMBDA (IMAGESOURCE IMAGEFILE IMAGEFILETYPE OPTIONS NOERROR)
|
||||
(* ; "Edited 27-Jan-2026 17:45 by rmk")
|
||||
(* ; "Edited 17-Jan-2026 12:41 by rmk")
|
||||
(* ; "Edited 12-Jan-2026 23:49 by rmk")
|
||||
(* ; "Edited 11-Jan-2026 13:21 by rmk")
|
||||
@@ -254,40 +256,43 @@
|
||||
(SETQ IMAGEFILETYPE (IMAGESOURCETYPE IMAGEFILE)))
|
||||
(CL:WHEN (MEMB IMAGEFILETYPE '(PDF POSTSCRIPT)) (* ; "POSTSCRIPT SCREWS UP")
|
||||
(push OPTIONS 'HEADING NIL))
|
||||
(LET
|
||||
((SOURCETYPE (IMAGESOURCETYPE IMAGESOURCE))
|
||||
CONVERTED CFN)
|
||||
(LET ((SOURCETYPE (IMAGESOURCETYPE IMAGESOURCE))
|
||||
CONVERTED CFN)
|
||||
|
||||
(* ;; "The conversion function may abandon the IMAGEFILE we provide and create its own.")
|
||||
(* ;; "The conversion function may abandon the IMAGEFILE we provide and create its own.")
|
||||
|
||||
(if (EQ IMAGEFILETYPE SOURCETYPE)
|
||||
then
|
||||
(* ;; "Already have what we want")
|
||||
(if (EQ IMAGEFILETYPE SOURCETYPE)
|
||||
then
|
||||
(* ;; "Already have what we want")
|
||||
|
||||
IMAGESOURCE
|
||||
else (if [AND (SETQ CFN (OR (LISTGET (IMAGEFILEPROP IMAGEFILETYPE 'CONVERSION)
|
||||
SOURCETYPE)
|
||||
(LISTGET (IMAGEFILEPROP 'DEFAULT 'CONVERSION)
|
||||
SOURCETYPE)))
|
||||
(SETQ CONVERTED (CAR (NLSETQ (APPLY* CFN IMAGESOURCE
|
||||
[OR (STREAMP IMAGEFILE)
|
||||
(AND IMAGEFILE
|
||||
(PACKFILENAME 'BODY IMAGEFILE
|
||||
'EXTENSION
|
||||
(CAR (
|
||||
IMAGESOURCE
|
||||
elseif [AND (SETQ CFN (OR (LISTGET (IMAGEFILEPROP IMAGEFILETYPE 'CONVERSION)
|
||||
SOURCETYPE)
|
||||
(LISTGET (IMAGEFILEPROP 'DEFAULT 'CONVERSION)
|
||||
SOURCETYPE)))
|
||||
(SETQ CONVERTED (CAR (NLSETQ (APPLY* CFN IMAGESOURCE
|
||||
[OR (STREAMP IMAGEFILE)
|
||||
[AND IMAGEFILE
|
||||
(PACKFILENAME 'BODY IMAGEFILE
|
||||
'EXTENSION
|
||||
(CAR (
|
||||
EXTENSIONS.FOR.IMAGEFILETYPE
|
||||
IMAGEFILETYPE]
|
||||
IMAGEFILETYPE OPTIONS]
|
||||
then (CL:WHEN (STREAMP CONVERTED) (* ; "Can't tell from the name")
|
||||
(STREAMPROP CONVERTED 'IMAGETYPE IMAGEFILETYPE))
|
||||
(CLOSEF? CONVERTED)
|
||||
CONVERTED
|
||||
elseif NOERROR
|
||||
then NIL
|
||||
else (ERROR (CONCAT "Can't convert " SOURCETYPE " file to " IMAGEFILETYPE)
|
||||
(CL:IF (STREAMP IMAGESOURCE)
|
||||
(FULLNAME IMAGESOURCE)
|
||||
IMAGESOURCE)])
|
||||
IMAGEFILETYPE]
|
||||
(UNIX-TMP-FILE-NAME
|
||||
(L-CASE SOURCETYPE)
|
||||
(CAR (EXTENSIONS.FOR.IMAGEFILETYPE
|
||||
IMAGEFILETYPE]
|
||||
IMAGEFILETYPE OPTIONS]
|
||||
then (CL:WHEN (STREAMP CONVERTED) (* ; "Can't tell from the name")
|
||||
(STREAMPROP CONVERTED 'IMAGETYPE IMAGEFILETYPE))
|
||||
(CLOSEF? CONVERTED)
|
||||
CONVERTED
|
||||
elseif NOERROR
|
||||
then NIL
|
||||
else (ERROR (CONCAT "Can't convert " SOURCETYPE " file to " IMAGEFILETYPE)
|
||||
(CL:IF (STREAMP IMAGESOURCE)
|
||||
(FULLNAME IMAGESOURCE)
|
||||
IMAGESOURCE)])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -479,7 +484,12 @@
|
||||
(T (BITMAPCOPY (WINDOWPROP WINDOW 'IMAGECOVERED])
|
||||
)
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES (DEFAULT))
|
||||
|
||||
|
||||
(* ; "PRINTFILETYPES")
|
||||
|
||||
|
||||
(RPAQ? PRINTFILETYPES NIL)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS PRINTFILETYPES)
|
||||
@@ -487,33 +497,27 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DEFAULT.IMAGETYPE.CONVERSIONS
|
||||
[LAMBDA (CONVERSIONS) (* ; "Edited 18-Jan-2026 00:18 by rmk")
|
||||
|
||||
(* ;; "Adds CONVERSIONS to the DEFAULT PRINTFILETYPE")
|
||||
(* ; "Edited 24-Dec-2025 22:42 by rmk")
|
||||
(CL:UNLESS (EQ 0 (IMOD (LENGTH CONVERSIONS)
|
||||
2))
|
||||
(ERROR "CONVERSIONS is not a property list"))
|
||||
(PUTMULTI PRINTFILETYPES 'DEFAULT 'CONVERSION
|
||||
(CONS (for CTAIL (CURRENT _ (OR (CAR (GETMULTI PRINTFILETYPES 'DEFAULT 'CONVERSION))
|
||||
(LIST (CAR CONVERSIONS)
|
||||
NIL))) on CONVERSIONS by (CDDR CTAIL)
|
||||
do (LISTPUT CURRENT (CAR CTAIL)
|
||||
(CADR CTAIL)) finally (RETURN CURRENT])
|
||||
[LAMBDA (CONVERSIONS) (* ; "Edited 27-Jan-2026 23:24 by rmk")
|
||||
(* ; "Edited 18-Jan-2026 00:18 by rmk")
|
||||
(* ; "Edited 24-Dec-2025 22:42 by rmk")
|
||||
(CL:WHEN CONVERSIONS
|
||||
[PUTMULTI PRINTFILETYPES 'DEFAULT 'CONVERSION
|
||||
(CONS (for CTAIL (CURRENT _ (OR (CAR (GETMULTI PRINTFILETYPES 'DEFAULT 'CONVERSION))
|
||||
(LIST (CAR CONVERSIONS)
|
||||
NIL))) on CONVERSIONS by (CDDR CTAIL)
|
||||
do (LISTPUT CURRENT (CAR CTAIL)
|
||||
(CADR CTAIL)) finally (RETURN CURRENT])])
|
||||
)
|
||||
|
||||
(DEFAULT.IMAGETYPE.CONVERSIONS '(BITMAP BITMAP.TO.IMAGEFILE WINDOW WINDOW.TO.IMAGEFILE SCREENREGION
|
||||
SCREENREGION.TO.IMAGEFILE BITMAPFILE BITMAPFILE.TO.IMAGEFILE))
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES
|
||||
(BITMAP (TEST BITMAPP))
|
||||
(WINDOW (TEST WINDOWP))
|
||||
(SCREENREGION (TEST REGIONP))
|
||||
(BITMAPFILE (TEST BITMAPFILEP)
|
||||
(EXTENSION (BM BITMAP))
|
||||
(CONVERSION (BITMAP BITMAP.TO.BITMAPFILE)))
|
||||
(TEXT (TEST LISPSOURCEFILEP)
|
||||
(EXTENSION (TXT TEXT))))
|
||||
(ADDTOVAR PRINTFILETYPES (BITMAP (TEST BITMAPP))
|
||||
(WINDOW (TEST WINDOWP))
|
||||
(SCREENREGION (TEST REGIONP))
|
||||
(BITMAPFILE (TEST BITMAPFILEP)
|
||||
(EXTENSION (BM BITMAP))
|
||||
(CONVERSION (BITMAP BITMAP.TO.BITMAPFILE))))
|
||||
|
||||
|
||||
|
||||
@@ -1834,23 +1838,22 @@
|
||||
)
|
||||
|
||||
(ADDTOVAR IMAGESTREAMTYPES
|
||||
(DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
|
||||
(FONTCREATE \CREATEDISPLAYFONT)
|
||||
(DISPLAY (FONTCREATE \CREATEDISPLAYFONT)
|
||||
(OPENSTREAM OPENDISPLAYSTREAM)
|
||||
(FONTSAVAILABLE \SEARCHFONTFILES)
|
||||
(CREATECHARSET \CREATECHARSET.DISPLAY)
|
||||
(FONTEXISTS? \FONTEXISTS?.DISPLAY))
|
||||
(4DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
|
||||
(4DISPLAY (FONTCREATE \CREATEDISPLAYFONT)
|
||||
(OPENSTREAM OPENDISPLAYSTREAM)
|
||||
(FONTSAVAILABLE \SEARCHFONTFILES)
|
||||
(FONTEXISTS? \FONTEXISTS?.DISPLAY))
|
||||
(8DISPLAY (FONTCREATE \CREATEDISPLAYFONT)
|
||||
(OPENSTREAM OPENDISPLAYSTREAM)
|
||||
(FONTCREATE \CREATEDISPLAYFONT)
|
||||
(FONTSAVAILABLE \SEARCHFONTFILES)
|
||||
(CREATECHARSET \CREATECHARSET.DISPLAY)
|
||||
(FONTEXISTS? \FONTEXISTS?.DISPLAY))
|
||||
(8DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
|
||||
(FONTCREATE \CREATEDISPLAYFONT)
|
||||
(FONTSAVAILABLE \SEARCHFONTFILES)
|
||||
(CREATECHARSET \CREATECHARSET.DISPLAY)
|
||||
(FONTEXISTS? \FONTEXISTS?.DISPLAY))
|
||||
(24DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
|
||||
(FONTCREATE \CREATEDISPLAYFONT)
|
||||
(24DISPLAY (FONTCREATE \CREATEDISPLAYFONT)
|
||||
(OPENSTREAM OPENDISPLAYSTREAM)
|
||||
(FONTSAVAILABLE \SEARCHFONTFILES)
|
||||
(CREATECHARSET \CREATECHARSET.DISPLAY)
|
||||
(FONTEXISTS? \FONTEXISTS?.DISPLAY)))
|
||||
@@ -1877,32 +1880,32 @@
|
||||
(ADDTOVAR LAMA IMAGESTREAMP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4337 6241 (OPENIMAGESTREAM 4347 . 6239)) (6242 11483 (IMAGESTREAMP 6252 . 7084) (
|
||||
IMAGESTREAMTYPE 7086 . 7602) (IMAGESTREAMTYPEP 7604 . 8239) (IMAGEFILEPROP 8241 . 8779) (
|
||||
IMAGESOURCEFILEP 8781 . 9058) (IMAGESOURCETYPE 9060 . 11481)) (11484 12775 (
|
||||
EXTENSIONS.FOR.IMAGEFILETYPE 11494 . 12136) (IMAGEFILETYPE.FROM.EXTENSION 12138 . 12773)) (12776 17758
|
||||
(CONVERT.TO.IMAGEFILE 12786 . 17756)) (17759 21850 (BITMAPFILEP 17769 . 19270) (BITMAP.TO.BITMAPFILE
|
||||
19272 . 20949) (BITMAPFILE.TO.BITMAP 20951 . 21605) (BITMAPFILE.TO.IMAGEFILE 21607 . 21848)) (21851
|
||||
28176 (BITMAP.TO.IMAGEFILE 21861 . 23418) (WINDOW.TO.IMAGEFILE 23420 . 26249) (
|
||||
SCREENREGION.TO.IMAGEFILE 26251 . 27155) (COPY.WINDOW.TO.BITMAP 27157 . 28174)) (28284 29190 (
|
||||
DEFAULT.IMAGETYPE.CONVERSIONS 28294 . 29188)) (29904 30130 (HTMLFILEP 29914 . 30128)) (30165 32280 (
|
||||
\GOOD.DASHLST 30175 . 32278)) (32281 34578 (DRAWDASHEDLINE 32291 . 34576)) (34579 41919 (DSPBACKCOLOR
|
||||
34589 . 34961) (DSPBOTTOMMARGIN 34963 . 35348) (DSPCOLOR 35350 . 35714) (DSPCLIPPINGREGION 35716 .
|
||||
36421) (DSPRESET 36423 . 36703) (DSPFONT 36705 . 37069) (DSPLEFTMARGIN 37071 . 37452) (DSPLINEFEED
|
||||
37454 . 37754) (DSPOPERATION 37756 . 38133) (DSPRIGHTMARGIN 38135 . 38518) (DSPTOPMARGIN 38520 . 38899
|
||||
) (DSPSCALE 38901 . 39268) (DSPSPACEFACTOR 39270 . 39663) (DSPXPOSITION 39665 . 39970) (DSPYPOSITION
|
||||
39972 . 40277) (DSPROTATE 40279 . 40574) (DSPPUSHSTATE 40576 . 40822) (DSPPOPSTATE 40824 . 41067) (
|
||||
DSPDEFAULTSTATE 41069 . 41321) (DSPSCALE2 41323 . 41614) (DSPTRANSLATE 41616 . 41917)) (41920 50721 (
|
||||
DSPNEWPAGE 41930 . 42622) (DRAWBETWEEN 42624 . 43326) (DRAWCIRCLE 43328 . 43824) (DRAWARC 43826 .
|
||||
44343) (DRAWCURVE 44345 . 45022) (DRAWELLIPSE 45024 . 45810) (DRAWLINE 45812 . 46202) (DRAWPOLYGON
|
||||
46204 . 46659) (DRAWPOINT 46661 . 47080) (FILLPOLYGON 47082 . 47648) (DRAWTO 47650 . 48068) (
|
||||
FILLCIRCLE 48070 . 48293) (MOVETO 48295 . 48659) (RELDRAWTO 48661 . 49578) (BITMAPIMAGESIZE 49580 .
|
||||
49751) (SCALEDBITBLT 49753 . 50719)) (50722 57761 (\DRAWPOINT.GENERIC 50732 . 51079) (
|
||||
\DRAWPOLYGON.GENERIC 51081 . 53389) (\DRAWCIRCLE.GENERIC 53391 . 55049) (\DRAWELLIPSE.GENERIC 55051 .
|
||||
57759)) (57762 62706 (\IMAGEIOINIT 57772 . 61052) (\NOIMAGE.DSPFONT 61054 . 62540) (\UNIMPIMAGEOP
|
||||
62542 . 62704)) (62829 65953 (INSURE.BRUSH 62839 . 64213) (BRUSHP 64215 . 65005) (\POSSIBLECOLOR 65007
|
||||
. 65558) (NEGSHADE 65560 . 65951)) (66509 67193 (DASHINGP 66519 . 66849) (INSURE.DASHING 66851 .
|
||||
67191)) (77931 98477 (\DisplayEventFn 77941 . 78451) (\DISPLAYINIT 78453 . 84036) (\4DISPLAYINIT 84038
|
||||
. 88739) (\8DISPLAYINIT 88741 . 93444) (\24DISPLAYINIT 93446 . 98218) (\DISPLAYSTREAMTYPEBPP 98220 .
|
||||
98475)))))
|
||||
(FILEMAP (NIL (4424 6328 (OPENIMAGESTREAM 4434 . 6326)) (6329 11570 (IMAGESTREAMP 6339 . 7171) (
|
||||
IMAGESTREAMTYPE 7173 . 7689) (IMAGESTREAMTYPEP 7691 . 8326) (IMAGEFILEPROP 8328 . 8866) (
|
||||
IMAGESOURCEFILEP 8868 . 9145) (IMAGESOURCETYPE 9147 . 11568)) (11571 12862 (
|
||||
EXTENSIONS.FOR.IMAGEFILETYPE 11581 . 12223) (IMAGEFILETYPE.FROM.EXTENSION 12225 . 12860)) (12863 18321
|
||||
(CONVERT.TO.IMAGEFILE 12873 . 18319)) (18322 22413 (BITMAPFILEP 18332 . 19833) (BITMAP.TO.BITMAPFILE
|
||||
19835 . 21512) (BITMAPFILE.TO.BITMAP 21514 . 22168) (BITMAPFILE.TO.IMAGEFILE 22170 . 22411)) (22414
|
||||
28739 (BITMAP.TO.IMAGEFILE 22424 . 23981) (WINDOW.TO.IMAGEFILE 23983 . 26812) (
|
||||
SCREENREGION.TO.IMAGEFILE 26814 . 27718) (COPY.WINDOW.TO.BITMAP 27720 . 28737)) (28869 29735 (
|
||||
DEFAULT.IMAGETYPE.CONVERSIONS 28879 . 29733)) (30435 30661 (HTMLFILEP 30445 . 30659)) (30696 32811 (
|
||||
\GOOD.DASHLST 30706 . 32809)) (32812 35109 (DRAWDASHEDLINE 32822 . 35107)) (35110 42450 (DSPBACKCOLOR
|
||||
35120 . 35492) (DSPBOTTOMMARGIN 35494 . 35879) (DSPCOLOR 35881 . 36245) (DSPCLIPPINGREGION 36247 .
|
||||
36952) (DSPRESET 36954 . 37234) (DSPFONT 37236 . 37600) (DSPLEFTMARGIN 37602 . 37983) (DSPLINEFEED
|
||||
37985 . 38285) (DSPOPERATION 38287 . 38664) (DSPRIGHTMARGIN 38666 . 39049) (DSPTOPMARGIN 39051 . 39430
|
||||
) (DSPSCALE 39432 . 39799) (DSPSPACEFACTOR 39801 . 40194) (DSPXPOSITION 40196 . 40501) (DSPYPOSITION
|
||||
40503 . 40808) (DSPROTATE 40810 . 41105) (DSPPUSHSTATE 41107 . 41353) (DSPPOPSTATE 41355 . 41598) (
|
||||
DSPDEFAULTSTATE 41600 . 41852) (DSPSCALE2 41854 . 42145) (DSPTRANSLATE 42147 . 42448)) (42451 51252 (
|
||||
DSPNEWPAGE 42461 . 43153) (DRAWBETWEEN 43155 . 43857) (DRAWCIRCLE 43859 . 44355) (DRAWARC 44357 .
|
||||
44874) (DRAWCURVE 44876 . 45553) (DRAWELLIPSE 45555 . 46341) (DRAWLINE 46343 . 46733) (DRAWPOLYGON
|
||||
46735 . 47190) (DRAWPOINT 47192 . 47611) (FILLPOLYGON 47613 . 48179) (DRAWTO 48181 . 48599) (
|
||||
FILLCIRCLE 48601 . 48824) (MOVETO 48826 . 49190) (RELDRAWTO 49192 . 50109) (BITMAPIMAGESIZE 50111 .
|
||||
50282) (SCALEDBITBLT 50284 . 51250)) (51253 58292 (\DRAWPOINT.GENERIC 51263 . 51610) (
|
||||
\DRAWPOLYGON.GENERIC 51612 . 53920) (\DRAWCIRCLE.GENERIC 53922 . 55580) (\DRAWELLIPSE.GENERIC 55582 .
|
||||
58290)) (58293 63237 (\IMAGEIOINIT 58303 . 61583) (\NOIMAGE.DSPFONT 61585 . 63071) (\UNIMPIMAGEOP
|
||||
63073 . 63235)) (63360 66484 (INSURE.BRUSH 63370 . 64744) (BRUSHP 64746 . 65536) (\POSSIBLECOLOR 65538
|
||||
. 66089) (NEGSHADE 66091 . 66482)) (67040 67724 (DASHINGP 67050 . 67380) (INSURE.DASHING 67382 .
|
||||
67722)) (78462 99008 (\DisplayEventFn 78472 . 78982) (\DISPLAYINIT 78984 . 84567) (\4DISPLAYINIT 84569
|
||||
. 89270) (\8DISPLAYINIT 89272 . 93975) (\24DISPLAYINIT 93977 . 98749) (\DISPLAYSTREAMTYPEBPP 98751 .
|
||||
99006)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Oct-2025 15:20:59" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;242 59604
|
||||
(FILECREATED "14-Feb-2026 00:39:34" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;250 60733
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MEDLEYFONT.GETCHARSET)
|
||||
:CHANGES-TO (FNS MEDLEYFONT.GETCHARSET MEDLEYFONT.READ.CHARSET)
|
||||
|
||||
:PREVIOUS-DATE " 7-Oct-2025 12:43:33" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;241)
|
||||
:PREVIOUS-DATE "23-Jan-2026 15:10:16" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;249)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYFONTFORMATCOMS)
|
||||
@@ -59,7 +59,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEYFONT.WRITE.FONT
|
||||
[LAMBDA (FONT FILE CHARSETNOS OTHERFONTPROPS NOINDIRECTS) (* ; "Edited 2-Sep-2025 23:01 by rmk")
|
||||
[LAMBDA (FONT FILE CHARSETNOS OTHERFONTPROPS NOINDIRECTS) (* ; "Edited 20-Jan-2026 22:36 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 23:01 by rmk")
|
||||
(* ; "Edited 15-Jul-2025 16:43 by rmk")
|
||||
(* ; "Edited 9-Jul-2025 09:32 by rmk")
|
||||
(* ; "Edited 19-Jun-2025 10:59 by rmk")
|
||||
@@ -70,8 +71,7 @@
|
||||
(* ; "Edited 16-May-2025 20:17 by rmk")
|
||||
(* ; "Edited 14-May-2025 17:45 by rmk")
|
||||
(SETQ FONT (FONTCREATE FONT))
|
||||
(CL:UNLESS FILE
|
||||
(SETQ FILE (MEDLEYFONT.FILENAME FONT CHARSETNOS)))
|
||||
(SETQ FILE (MEDLEYFONT.FILENAME FILE FONT CHARSETNOS))
|
||||
(SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS)))
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
|
||||
(MEDLEYFONT.WRITE.HEADER STREAM OTHERFONTPROPS)
|
||||
@@ -129,7 +129,8 @@
|
||||
(FULLNAME STREAM])
|
||||
|
||||
(MEDLEYFONT.GETCHARSET
|
||||
[LAMBDA (STREAM CHARSET FONT) (* ; "Edited 9-Oct-2025 15:18 by rmk")
|
||||
[LAMBDA (STREAM CHARSET FONT) (* ; "Edited 14-Feb-2026 00:36 by rmk")
|
||||
(* ; "Edited 9-Oct-2025 15:18 by rmk")
|
||||
(* ; "Edited 3-Sep-2025 11:32 by rmk")
|
||||
(* ; "Edited 15-Jul-2025 17:09 by rmk")
|
||||
(* ; "Edited 9-Jul-2025 15:45 by rmk")
|
||||
@@ -184,7 +185,7 @@
|
||||
(SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CHARSET BYTESPERCELL)))
|
||||
(CL:UNLESS (EQ 0 (SETQ CSLOC (\FIXPIN STREAM)))
|
||||
(SETFILEPTR STREAM CSLOC)))
|
||||
(MEDLEYFONT.READ.CHARSET STREAM CHARSET))))])
|
||||
(MEDLEYFONT.READ.CHARSET STREAM CHARSET FONT))))])
|
||||
|
||||
(MEDLEYFONT.CHARSET?
|
||||
[LAMBDA (FILE CHARSET) (* ; "Edited 15-Jul-2025 15:21 by rmk")
|
||||
@@ -279,14 +280,15 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEYFONT.READ.FONT
|
||||
[LAMBDA (FILE CHARSETNOS FONT) (* ; "Edited 31-Aug-2025 14:42 by rmk")
|
||||
[LAMBDA (FILE CHARSETNOS FONT) (* ; "Edited 20-Jan-2026 22:31 by rmk")
|
||||
(* ; "Edited 31-Aug-2025 14:42 by rmk")
|
||||
(* ; "Edited 15-Jul-2025 20:20 by rmk")
|
||||
(* ; "Edited 9-Jul-2025 00:06 by rmk")
|
||||
(* ; "Edited 6-Jul-2025 11:45 by rmk")
|
||||
(CL:UNLESS FILE (SETQ FILE FONT))
|
||||
(CL:WHEN (OR (type? FONTDESCRIPTOR FILE)
|
||||
(LISTP FILE))
|
||||
(SETQ FILE (MEDLEYFONT.FILENAME FILE)))
|
||||
(SETQ FONT (CL:IF FONT
|
||||
(FONTCREATE FONT)
|
||||
(create FONTDESCRIPTOR)))
|
||||
(SETQ FILE (MEDLEYFONT.FILENAME FILE FONT))
|
||||
(SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS)))
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
|
||||
(CL:UNLESS (MEDLEYFONT.FILEP STREAM)
|
||||
@@ -341,7 +343,8 @@
|
||||
FONT])
|
||||
|
||||
(MEDLEYFONT.READ.CHARSET
|
||||
[LAMBDA (STREAM CHARSET) (* ; "Edited 4-Sep-2025 10:39 by rmk")
|
||||
[LAMBDA (STREAM CHARSET FONT) (* ; "Edited 14-Feb-2026 00:36 by rmk")
|
||||
(* ; "Edited 4-Sep-2025 10:39 by rmk")
|
||||
(* ; "Edited 28-Aug-2025 15:27 by rmk")
|
||||
(* ; "Edited 26-Aug-2025 23:36 by rmk")
|
||||
(* ; "Edited 17-Aug-2025 13:01 by rmk")
|
||||
@@ -354,6 +357,9 @@
|
||||
(* ; "Edited 16-May-2025 20:19 by rmk")
|
||||
(* ; "Edited 14-May-2025 10:43 by rmk")
|
||||
(* ; "Edited 12-May-2025 07:55 by rmk")
|
||||
|
||||
(* ;; "FONT is only needed for the \READCHARSET call below that interprets an INDIRECT and leads to a recursiving invocation of MEDLEYFONT.GETCHARSET and this function. It is the font descriptor provided at the top-level call. ")
|
||||
|
||||
(MEDLEYFONT.READ.ITEM STREAM 'CHARSETSTRING) (* ;
|
||||
"Throwaway for looking with text editor")
|
||||
(LET (CSNO INDIRECT)
|
||||
@@ -364,7 +370,7 @@
|
||||
(* ;; "Read what we peeked and use it to create a complete charset from another file (e.g. shared Kanji). ")
|
||||
|
||||
(SETQ INDIRECT (MEDLEYFONT.READ.ITEM STREAM 'INDIRECTCHARSET))
|
||||
(\READCHARSET INDIRECT CHARSET)
|
||||
(\READCHARSET INDIRECT CHARSET FONT)
|
||||
else (bind PAIR LABEL ITEM (CSINFO _ (create CHARSETINFO
|
||||
WIDTHS _ NIL
|
||||
OFFSETS _ NIL)) eachtime (SETQ PAIR
|
||||
@@ -510,14 +516,13 @@
|
||||
(bind PAIR until [EQ 'STOP (CAR (SETQ PAIR (MEDLEYFONT.READ.ITEM STREAM] collect PAIR])
|
||||
|
||||
(MEDLEYFONT.READ.VERIFIEDFONT
|
||||
[LAMBDA (STREAM FONT) (* ; "Edited 2-Sep-2025 23:52 by rmk")
|
||||
[LAMBDA (STREAM FONT) (* ; "Edited 20-Jan-2026 22:31 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 23:52 by rmk")
|
||||
(* ; "Edited 12-Aug-2025 17:57 by rmk")
|
||||
(* ; "Edited 10-Jun-2025 20:57 by rmk")
|
||||
(* ; "Edited 21-May-2025 22:55 by rmk")
|
||||
(* ; "Edited 19-May-2025 17:42 by rmk")
|
||||
(* ; "Edited 16-May-2025 10:28 by rmk")
|
||||
(CL:UNLESS FONT
|
||||
(SETQ FONT (create FONTDESCRIPTOR)))
|
||||
(LET ((FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM)))
|
||||
(for P VAL in FONTPROPS do (SETQ VAL (CADR P))
|
||||
(SELECTQ (CAR P)
|
||||
@@ -842,35 +847,33 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEYFONT.FILENAME
|
||||
[LAMBDA (FONT CHARSET EXTENSION DIRECTORY) (* ; "Edited 7-Oct-2025 11:50 by rmk")
|
||||
[LAMBDA (FILE FONT CHARSET EXTENSION DIRECTORY) (* ; "Edited 23-Jan-2026 15:10 by rmk")
|
||||
(* ; "Edited 20-Jan-2026 17:39 by rmk")
|
||||
(* ; "Edited 7-Oct-2025 11:50 by rmk")
|
||||
(* ; "Edited 4-Sep-2025 08:48 by rmk")
|
||||
(* ; "Edited 10-Jun-2025 11:02 by rmk")
|
||||
(* ; "Edited 25-May-2025 21:25 by rmk")
|
||||
(* ; "Edited 19-May-2025 17:42 by rmk")
|
||||
(* ; "Edited 16-May-2025 14:09 by rmk")
|
||||
|
||||
(* ;; "If EXTENSION and FILE are NIL, puts the file in the MEDLEYDIR fonts/medley[device]fonts/ directory with extension MEDLEY[device]FONT. If CHARSET, goes in the CHARSET subdirectory.")
|
||||
|
||||
(LET (FAMILY SIZE FACE DEVICE ROTATION FILENAME)
|
||||
(SPREADFONTSPEC (CL:IF (type? FONTDESCRIPTOR FONT)
|
||||
(FONTPROP FONT 'SPEC)
|
||||
(\FONT.CHECKARGS FONT)))
|
||||
(CL:UNLESS EXTENSION
|
||||
(SETQ EXTENSION (CONCAT "MEDLEY" (U-CASE DEVICE)
|
||||
"FONT")))
|
||||
(CL:UNLESS DIRECTORY
|
||||
[SETQ DIRECTORY (PSEUDOFILENAME (CONCAT (MEDLEYDIR)
|
||||
(CONCAT "fonts/" (L-CASE EXTENSION)
|
||||
"s"])
|
||||
(SETQ FILENAME (PACK* FAMILY (CL:IF (ILEQ SIZE 9)
|
||||
"0"
|
||||
"")
|
||||
SIZE "-" (FONTFACETOATOM FACE)
|
||||
(CL:IF (SMALLP CHARSET)
|
||||
(CONCAT "-C" (OCTALSTRING CHARSET))
|
||||
"")
|
||||
"." EXTENSION))
|
||||
(CONCAT DIRECTORY ">" FILENAME])
|
||||
(LET [(FONTSPEC (AND FONT (\FONT.CHECKARGS FONT NIL NIL NIL NIL T]
|
||||
(CL:UNLESS EXTENSION (* ;
|
||||
"EXTENSION may be needed for DIRECTORY below")
|
||||
(SETQ EXTENSION (OR (FILENAMEFIELD FILE 'EXTENSION)
|
||||
(CONCAT "MEDLEY" (OR (AND FONTSPEC (fetch (FONTSPEC FSDEVICE)
|
||||
of FONTSPEC))
|
||||
(ERROR "Font device not known"))
|
||||
"FONT"))))
|
||||
(PACKFILENAME.STRING `(BODY ,FILE ,@(UNPACKFILENAME.STRING (AND FONTSPEC
|
||||
(\FONTFILENAME FONTSPEC NIL
|
||||
NIL NIL CHARSET)))
|
||||
DIRECTORY
|
||||
,(OR DIRECTORY (FILENAMEFIELD FILE 'DIRECTORY)
|
||||
(PSEUDOFILENAME (CONCAT (MEDLEYDIR)
|
||||
"fonts/"
|
||||
(L-CASE EXTENSION)
|
||||
"s")))
|
||||
EXTENSION
|
||||
,EXTENSION])
|
||||
)
|
||||
|
||||
(ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT)
|
||||
@@ -921,11 +924,11 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2128 16674 (MEDLEYFONT.WRITE.FONT 2138 . 7104) (MEDLEYFONT.GETCHARSET 7106 . 11133) (
|
||||
MEDLEYFONT.CHARSET? 11135 . 12604) (MEDLEYFONT.GETFILEPROP 12606 . 14706) (MEDLEYFONT.FILEP 14708 .
|
||||
16672)) (16700 38890 (MEDLEYFONT.READ.FONT 16710 . 21142) (MEDLEYFONT.READ.CHARSET 21144 . 26502) (
|
||||
MEDLEYFONT.READ.ITEM 26504 . 32653) (MEDLEYFONT.PEEK.ITEM 32655 . 33517) (MEDLEYFONT.READ.FONTPROPS
|
||||
33519 . 33984) (MEDLEYFONT.READ.VERIFIEDFONT 33986 . 38888)) (38916 56753 (MEDLEYFONT.WRITE.CHARSET
|
||||
38926 . 43488) (MEDLEYFONT.WRITE.ITEM 43490 . 52543) (MEDLEYFONT.WRITE.FONTPROPS 52545 . 56098) (
|
||||
MEDLEYFONT.WRITE.HEADER 56100 . 56751)) (56754 58719 (MEDLEYFONT.FILENAME 56764 . 58717)))))
|
||||
(FILEMAP (NIL (2152 16901 (MEDLEYFONT.WRITE.FONT 2162 . 7217) (MEDLEYFONT.GETCHARSET 7219 . 11360) (
|
||||
MEDLEYFONT.CHARSET? 11362 . 12831) (MEDLEYFONT.GETFILEPROP 12833 . 14933) (MEDLEYFONT.FILEP 14935 .
|
||||
16899)) (16927 39618 (MEDLEYFONT.READ.FONT 16937 . 21473) (MEDLEYFONT.READ.CHARSET 21475 . 27190) (
|
||||
MEDLEYFONT.READ.ITEM 27192 . 33341) (MEDLEYFONT.PEEK.ITEM 33343 . 34205) (MEDLEYFONT.READ.FONTPROPS
|
||||
34207 . 34672) (MEDLEYFONT.READ.VERIFIEDFONT 34674 . 39616)) (39644 57481 (MEDLEYFONT.WRITE.CHARSET
|
||||
39654 . 44216) (MEDLEYFONT.WRITE.ITEM 44218 . 53271) (MEDLEYFONT.WRITE.FONTPROPS 53273 . 56826) (
|
||||
MEDLEYFONT.WRITE.HEADER 56828 . 57479)) (57482 59848 (MEDLEYFONT.FILENAME 57492 . 59846)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user