Compare commits
1 Commits
nhb-fix-et
...
rmk143--So
| Author | SHA1 | Date | |
|---|---|---|---|
|
55da53966b |
Binary file not shown.
Binary file not shown.
@@ -1,27 +1,23 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "28-Jan-2026 11:03:17" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;3 26880
|
||||
(FILECREATED "16-May-2025 15:37:36" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;8 31221
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:CHANGES-TO (FNS MAKE-INDEX-HTMLS)
|
||||
|
||||
:CHANGES-TO (FNS MAKE-INDEX-HTMLS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES
|
||||
MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS HCFILES RECOMPILE-ONE
|
||||
RECMPL COMPILE-SETUP REMAKEFILES)
|
||||
(ADVICE TEDIT.PROMPTPRINT)
|
||||
|
||||
:PREVIOUS-DATE "28-Jan-2026 10:46:02" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;1)
|
||||
:PREVIOUS-DATE "16-May-2025 13:51:08" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;7)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
|
||||
(RPAQQ MEDLEY-UTILSCOMS
|
||||
[(FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
[(FNS GATHER-INFO MAKE-FULLER-DB MAKE-INDEX-HTMLS MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS)
|
||||
(FNS HCFILES MAKE-INDEX-HTMLS)
|
||||
(PROP FILETYPE MEDLEY-UTILS)
|
||||
(ADVISE TEDIT.PROMPTPRINT)
|
||||
(FNS RECOMPILE-ONE RECMPL COMPILE-SETUP REMAKEFILES)
|
||||
(P (READVISE TEDIT.PROMPTPRINT))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
@@ -129,6 +125,91 @@
|
||||
(MAKESYS (OR SYSOUTFILE "fuller.sysout")
|
||||
"Welcome to Fuller sysout"])
|
||||
|
||||
(MAKE-INDEX-HTMLS
|
||||
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
(* ; "Edited 26-Apr-2024 16:15 by lmm")
|
||||
(* ; "Edited 20-Apr-2024 12:34 by lmm")
|
||||
(* ; "Edited 13-Apr-2024 21:18 by lmm")
|
||||
(* ; " Edited 16-May-2025 13:17 by fgh")
|
||||
[OR BASE (SETQ BASE (TRUEFILENAME (MEDLEYDIR]
|
||||
(OR (DIRECTORYNAMEP BASE)
|
||||
(ERROR BASE "not a directory name"))
|
||||
(OR (AND (NUMBERP LEVEL)
|
||||
(IGREATERP LEVEL 0))
|
||||
(SETQ LEVEL 1))
|
||||
(OR ROOT.NAME (SETQ ROOT.NAME 'MEDLEY))
|
||||
(RESETLST
|
||||
(if (EQ LEVEL 1)
|
||||
then (RESETSAVE (PSEUDOHOSTS T))
|
||||
(PSEUDOHOST ROOT.NAME BASE))
|
||||
(SETQ BASE (PSEUDOFILENAME BASE))
|
||||
[LET*
|
||||
((SUBDIRS NIL)
|
||||
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
|
||||
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
|
||||
'}))
|
||||
SLASHED SHORTNAME)
|
||||
(CL:WITH-OPEN-FILE
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
|
||||
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
|
||||
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
|
||||
(CL:FORMAT S "<SCRIPT>~%%")
|
||||
(CL:FORMAT S " function up_onclick(){~%%")
|
||||
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
|
||||
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
|
||||
(CL:FORMAT S " }~%%")
|
||||
(CL:FORMAT S "</SCRIPT>~%%")
|
||||
(CL:FORMAT S "</HEAD>~%%")
|
||||
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
|
||||
(CL:UNLESS (EQ LEVEL 1)
|
||||
(CL:FORMAT S
|
||||
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
|
||||
))
|
||||
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
|
||||
(for FULLNAME in (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
do (if (EQ (NTHCHAR FULLNAME -1)
|
||||
'>)
|
||||
then
|
||||
(* ;; "A directory")
|
||||
|
||||
(if (NOT (DIRECTORYNAMEP FULLNAME))
|
||||
then (HELP (CONCAT "NOT DIRNAME " FULLNAME)))
|
||||
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
|
||||
(+ (NCHARS BASE)
|
||||
(if PSEUDOHOST
|
||||
then 2
|
||||
else 1))
|
||||
-2)))
|
||||
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
|
||||
(MEMB SHORTNAME '(.GIT))
|
||||
[AND (STRPOS ".git" (L-CASE FULLNAME))
|
||||
(NOT (STRPOS ".github" (L-CASE FULLNAME]
|
||||
(INFILEP (CONCAT FULLNAME ".skip")))
|
||||
|
||||
(* ;; ".skip in the directory itself -- don't index any of it")
|
||||
|
||||
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
|
||||
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
|
||||
elseif (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
|
||||
(SUB1 (OR (STRPOS ".;" FULLNAME)
|
||||
(STRPOS ";" FULLNAME)
|
||||
(HELP (CONCAT
|
||||
"No ; in non-directory "
|
||||
FULLNAME]
|
||||
'(index.html .skip))
|
||||
then
|
||||
(* ;; "dont index the index")
|
||||
|
||||
elseif (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
|
||||
'(IMPTR SKIP skip imptr))
|
||||
then
|
||||
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
|
||||
|
||||
else (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
|
||||
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
|
||||
(NCONC SUBDIRS (for D in SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
|
||||
(ADD1 LEVEL])])
|
||||
|
||||
(MEDLEY-FIX-LINKS
|
||||
[LAMBDA (UNIXPATH) (* ; "Edited 18-Jan-2021 12:01 by larry")
|
||||
(OR UNIXPATH (SETQ UNIXPATH (UNIX-GETENV "MEDLEYDIR"))
|
||||
@@ -280,10 +361,7 @@
|
||||
(PRINTOUT T "DONE" T))])
|
||||
|
||||
(MAKE-INDEX-HTMLS
|
||||
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 28-Jan-2026 11:01 by lmm")
|
||||
(* ; "Edited 27-Jan-2026 10:50 by lmm")
|
||||
(* ; "Edited 23-Jan-2026 11:59 by lmm")
|
||||
(* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
(* ; "Edited 26-Apr-2024 16:15 by lmm")
|
||||
(* ; "Edited 20-Apr-2024 12:34 by lmm")
|
||||
(* ; "Edited 13-Apr-2024 21:18 by lmm")
|
||||
@@ -307,22 +385,20 @@
|
||||
'}))
|
||||
SLASHED SHORTNAME)
|
||||
(CL:WITH-OPEN-FILE
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE
|
||||
:EXTERNAL-FORMAT :UTF-8)
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
|
||||
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
|
||||
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
|
||||
(CL:FORMAT S "<META CHARSET=%"UTF-8%">~%%")
|
||||
(CL:FORMAT S "<SCRIPT>~%%")
|
||||
(CL:FORMAT S " function uponclick(){~%%")
|
||||
(CL:FORMAT S " function up_onclick(){~%%")
|
||||
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
|
||||
(CL:FORMAT S " location = newLoc.replace(/\/[\/]+\/?$/, %"%");~%%")
|
||||
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
|
||||
(CL:FORMAT S " }~%%")
|
||||
(CL:FORMAT S "</SCRIPT>~%%")
|
||||
(CL:FORMAT S "</HEAD>~%%")
|
||||
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
|
||||
(CL:UNLESS (EQ LEVEL 1)
|
||||
(CL:FORMAT S
|
||||
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"uponclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
|
||||
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
|
||||
))
|
||||
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
|
||||
(for FULLNAME in (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
@@ -463,6 +539,8 @@
|
||||
(SETQ DIFF (COMPARESOURCES X DESTFILE NIL))
|
||||
(TERPRI])
|
||||
)
|
||||
|
||||
(READVISE TEDIT.PROMPTPRINT)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
@@ -472,9 +550,9 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1312 8246 (GATHER-INFO 1322 . 6704) (MAKE-FULLER-DB 6706 . 7615) (MEDLEY-FIX-LINKS 7617
|
||||
. 8010) (MEDLEY-FIX-DATES 8012 . 8244)) (9425 12213 (MAKE-EXPORTS-ALL 9435 . 10494) (
|
||||
MAKE-WHEREIS-HASH 10496 . 11685) (MAKE-WHEREIS-LOOPS 11687 . 12211)) (12214 21862 (HCFILES 12224 .
|
||||
16487) (MAKE-INDEX-HTMLS 16489 . 21860)) (22112 26724 (RECOMPILE-ONE 22122 . 24019) (RECMPL 24021 .
|
||||
24624) (COMPILE-SETUP 24626 . 25250) (REMAKEFILES 25252 . 26722)))))
|
||||
(FILEMAP (NIL (1086 12975 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7389) (MAKE-INDEX-HTMLS
|
||||
7391 . 12344) (MEDLEY-FIX-LINKS 12346 . 12739) (MEDLEY-FIX-DATES 12741 . 12973)) (14154 16942 (
|
||||
MAKE-EXPORTS-ALL 14164 . 15223) (MAKE-WHEREIS-HASH 15225 . 16414) (MAKE-WHEREIS-LOOPS 16416 . 16940))
|
||||
(16943 26173 (HCFILES 16953 . 21216) (MAKE-INDEX-HTMLS 21218 . 26171)) (26423 31035 (RECOMPILE-ONE
|
||||
26433 . 28330) (RECMPL 28332 . 28935) (COMPILE-SETUP 28937 . 29561) (REMAKEFILES 29563 . 31033)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -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 "29-Jul-2025 11:42:21" {WMEDLEY}<internal>TEDIT-DEBUG.;174 138232
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS SP)
|
||||
:CHANGES-TO (FNS SPPRINT)
|
||||
|
||||
:PREVIOUS-DATE "29-Jul-2025 11:42:21" {WMEDLEY}<internal>TEDIT-DEBUG.;174)
|
||||
:PREVIOUS-DATE " 3-Jun-2025 23:12:40" {WMEDLEY}<internal>TEDIT-DEBUG.;173)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-DEBUGCOMS)
|
||||
@@ -455,8 +455,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SP
|
||||
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 13-Oct-2025 16:37 by rmk")
|
||||
(* ; "Edited 17-Apr-2025 13:37 by rmk")
|
||||
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 17-Apr-2025 13:37 by rmk")
|
||||
(* ; "Edited 15-Apr-2025 13:53 by rmk")
|
||||
(* ; "Edited 11-Apr-2025 12:15 by rmk")
|
||||
(* ; "Edited 29-Mar-2025 22:34 by rmk")
|
||||
@@ -476,7 +475,8 @@
|
||||
|
||||
(* ;; "OFILE=T or TEDIT means Tedit stream. NIL means primary output (usually T)")
|
||||
|
||||
(PROG ((TEXTOBJ (OR (TEXTOBJ PC T)
|
||||
(PROG ((TEXTOBJ (CL:IF (type? TEXTOBJ PC)
|
||||
PC
|
||||
(GTO TOBJ)))
|
||||
WTYPE TITLE)
|
||||
(if OFILE
|
||||
@@ -2579,33 +2579,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 (5120 7679 (GTO 5130 . 5380) (GTS 5382 . 7153) (GTW 7155 . 7311) (GSEL 7313 . 7677)) (
|
||||
7712 8833 (TEST.TEMPLATE 7722 . 8831)) (8834 9769 (TESTACTION 8844 . 9767)) (9794 23609 (IPC 9804 .
|
||||
11308) (ILINES 11310 . 13851) (ISEL 13853 . 14464) (ITS 14466 . 16190) (IPANES 16192 . 16427) (ITL
|
||||
16429 . 16848) (IHIST 16850 . 19512) (IPCTB 19514 . 19940) (IMB 19942 . 20701) (ICL 20703 . 21404) (
|
||||
IPL 21406 . 21946) (ICARET 21948 . 22475) (INSPECTPIECES 22477 . 23607)) (23631 52299 (SP 23641 .
|
||||
28685) (SL 28687 . 32522) (SSP 32524 . 34226) (SPF 34228 . 36758) (SLF 36760 . 45893) (SHOWLINE 45895
|
||||
. 49457) (SLL 49459 . 50206) (STBYTES 50208 . 51934) (SSEL 51936 . 52297)) (52300 64813 (STL 52310 .
|
||||
61311) (CLEARTHISLINE 61313 . 61793) (CHARSLOTP 61795 . 63114) (\TLVALIDATE 63116 . 64811)) (64814
|
||||
70187 (NTHPIECE 64824 . 65956) (NPIECES 65958 . 66823) (NTHPIECECHAR 66825 . 68133) (SELPIECE 68135 .
|
||||
68577) (PIECENUM 68579 . 69298) (PCBYTES 69300 . 70185)) (70188 72662 (FILEBYTES 70198 . 71622) (
|
||||
TFILEBYTES 71624 . 72660)) (72663 73985 (TRELMOVE 72673 . 72916) (TSCROLL 72918 . 73084) (TSCROLL*
|
||||
73086 . 73983)) (73986 77035 (TRY 73996 . 75265) (TEDITCLOSEW 75267 . 75610) (PARALASTWITHOUTEOL 75612
|
||||
. 76497) (FIXPARALAST 76499 . 77033)) (77036 91923 (SPPRINT 77046 . 83871) (SPPRINT.CHAR 83873 .
|
||||
84857) (SPPRINT.OBJ 84859 . 87917) (SHOWPIECEBYTES 87919 . 89475) (CHECKPLENGTHS 89477 . 89934) (SBT
|
||||
89936 . 91073) (COPYPCHAIN 91075 . 91921)) (91924 93985 (POSLINE 91934 . 93983)) (93986 94869 (
|
||||
PRESPLIT 93996 . 94867)) (94870 96583 (ALLTL 94880 . 96133) (NTHCHARSLOT 96135 . 96581)) (96609 106822
|
||||
(PLCHAIN 96619 . 97147) (PRINTLINE 97149 . 100139) (SL.GETLINES 100141 . 103434) (CHECKLINES 103436
|
||||
. 104416) (COLLECTLINES 104418 . 104670) (NTHLINE 104672 . 105677) (HEIGHT 105679 . 105967) (LINEBOTS
|
||||
105969 . 106820)) (106823 109271 (IPC.DECODEARGS 106833 . 109269)) (109272 109865 (SPF1 109282 .
|
||||
109863)) (109894 112272 (SLF.FATPLEN 109904 . 110763) (FILEPIECE 110765 . 112270)) (112305 113073 (
|
||||
SELTEDIT 112315 . 113071)) (113143 118755 (PPARA 113153 . 113575) (PRUN 113577 . 115053) (
|
||||
ADDLINEPOSITIONS 115055 . 116482) (SBR 116484 . 117138) (SBC 117140 . 118753)) (118812 120588 (OLDWI
|
||||
118822 . 119197) (COMP 119199 . 119394) (DFR 119396 . 120586)) (120589 121622 (DFGV 120599 . 121125) (
|
||||
GDIRECTORIES 121127 . 121620)) (121623 128188 (TTEST 121633 . 126165) (LTEST 126167 . 127532) (THC
|
||||
127534 . 128186)) (128502 129194 (SHOWSAFE 128512 . 129192)) (129247 129694 (MYH 129257 . 129692)) (
|
||||
129939 131034 (DFVENUE 129949 . 130828) (VSEE 130830 . 131032)) (131035 131489 (PTT 131045 . 131487))
|
||||
(131848 133429 (DEBUGOUTPUT.STREAM 131858 . 133427)) (133430 135746 (TEDIT-DEBUG 133440 . 135744)) (
|
||||
135747 136239 (HEXTOHILO 135757 . 136097) (CW 136099 . 136237)) (136240 137976 (TRENAME 136250 .
|
||||
137974)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "28-Dec-2025 12:06:12" {WMEDLEY}<internal>loadups>LOADUP-FULL.;35 5759
|
||||
(FILECREATED "20-Sep-2025 14:18:19" {WMEDLEY}<internal>loadups>LOADUP-FULL.;34 5662
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-FULL)
|
||||
:CHANGES-TO (FNS LOADFULLFONTS)
|
||||
|
||||
:PREVIOUS-DATE "20-Sep-2025 14:18:19" {WMEDLEY}<internal>loadups>LOADUP-FULL.;34)
|
||||
:PREVIOUS-DATE " 2-Sep-2025 20:07:20" {WMEDLEY}<internal>loadups>LOADUP-FULL.;33)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-FULLCOMS)
|
||||
@@ -47,8 +47,7 @@
|
||||
(PRINTOUT T "FULL fonts loaded" T])
|
||||
|
||||
(LOADUP-FULL
|
||||
[LAMBDA (DRIBBLEFILE) (* ; "Edited 28-Dec-2025 12:06 by rmk")
|
||||
(* ; "Edited 1-Sep-2025 11:59 by rmk")
|
||||
[LAMBDA (DRIBBLEFILE) (* ; "Edited 1-Sep-2025 11:59 by rmk")
|
||||
(* ; "Edited 18-Aug-2025 12:09 by rmk")
|
||||
(* ; "Edited 21-Jun-2025 23:33 by rmk")
|
||||
(* ; "Edited 18-Jan-2023 16:22 by FGH")
|
||||
@@ -86,7 +85,7 @@
|
||||
(LOADUP '(CHAT INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES
|
||||
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT ISO8859IO
|
||||
HELPSYS DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM
|
||||
UNIXCHAT UNIXYCD))
|
||||
UNIXCHAT UNIXYCD UNIXUTILS))
|
||||
(COND
|
||||
((WINDOWP *WHO-LINE*)
|
||||
(CLOSEW *WHO-LINE*)))
|
||||
@@ -101,5 +100,5 @@
|
||||
|
||||
(FIXMETA)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (456 5721 (LOADFULLFONTS 466 . 2601) (LOADUP-FULL 2603 . 5471) (FIXMETA 5473 . 5719)))))
|
||||
(FILEMAP (NIL (458 5624 (LOADFULLFONTS 468 . 2603) (LOADUP-FULL 2605 . 5374) (FIXMETA 5376 . 5622)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Feb-2026 11:59:42"
|
||||
|{DSK}<Users>briggs>Projects>medley>internal>loadups>LOADUP-LISP.;12| 7475
|
||||
(FILECREATED " 5-Nov-2025 09:04:36" |{DSK}<Users>larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;2| 7333
|
||||
|
||||
:EDIT-BY |nhb|
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-LISP)
|
||||
|
||||
:PREVIOUS-DATE "28-Jan-2026 14:30:48" |{DSK}<tmp>new-LOADUP-LISP.;1|)
|
||||
:PREVIOUS-DATE "16-Oct-2025 16:55:27"
|
||||
|{DSK}<Users>larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;1|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-LISPCOMS)
|
||||
@@ -20,9 +20,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(LOADUP-LISP
|
||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 3-Feb-2026 11:59 by nhb")
|
||||
(* \; "Edited 28-Jan-2026 14:30 by lmm")
|
||||
(* \; "Edited 27-Dec-2025 15:02 by rmk")
|
||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 5-Nov-2025 09:01 by lmm")
|
||||
(* \; "Edited 16-Oct-2025 16:55 by rmk")
|
||||
(* \; "Edited 18-Aug-2025 12:08 by rmk")
|
||||
(* \; "Edited 15-Jun-2025 14:39 by rmk")
|
||||
@@ -74,7 +72,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 FILEPKG RESOURCE))
|
||||
DIRECTORY SPELLFILE FILEPKG RESOURCE))
|
||||
|
||||
(* |;;| "needed for makesys")
|
||||
|
||||
@@ -108,7 +106,7 @@
|
||||
(LOADUP '(DSK UFS UFSCALLC MAIKOBITBLT))
|
||||
(LOADUP '(TIME))
|
||||
(LOADUP '(BRKDWN))
|
||||
(LOADUP '(LOGOW IDLER UNIXUTILS PSEUDOHOSTS HARDCOPY ICONW FREEMENU SEDIT))
|
||||
(LOADUP '(LOGOW IDLER HARDCOPY ICONW FREEMENU SEDIT))
|
||||
(LOADUP '(XCL-EXTRAS))
|
||||
|
||||
(* |;;| "CMLPACKAGE pushes onto INSPECTMACROS")
|
||||
@@ -130,13 +128,15 @@
|
||||
|
||||
(* |;;| " Added late, LOAD late to avoid any dependencies")
|
||||
|
||||
(* |;;| "prevent medley from pinning CPU")
|
||||
|
||||
(LOADUP '(XCL-LOOP XCL-HASH-LOOP))
|
||||
(LOADUP '(BACKGROUND-YIELD))
|
||||
|
||||
(* |;;| " networking code -- should make it optional but too many cross dependencies")
|
||||
|
||||
(LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP
|
||||
NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER))
|
||||
(RESTART.ETHER)
|
||||
(DRIBBLE)
|
||||
(SETQ MAKESYSNAME :MEDLEY)))
|
||||
)
|
||||
@@ -149,5 +149,5 @@
|
||||
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (652 7269 (LOADUP-LISP 662 . 7267)))))
|
||||
(FILEMAP (NIL (675 7127 (LOADUP-LISP 685 . 7125)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "24-Dec-2025 11:14:31" |{WMEDLEY}<library>FILEBROWSER.;34| 263525
|
||||
(FILECREATED "29-May-2024 15:30:07" {LIB}FILEBROWSER.\;2 266071
|
||||
|
||||
:EDIT-BY |rmk|
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS FB.HARDCOPY.TOFILE)
|
||||
:CHANGES-TO (FNS FB.PROMPTW.FORMAT FB.FASTSEE.ONEFILE)
|
||||
|
||||
:PREVIOUS-DATE " 6-Nov-2025 14:33:28" |{WMEDLEY}<library>FILEBROWSER.;33|)
|
||||
:PREVIOUS-DATE " 4-Nov-2023 23:55:27" {LIB}FILEBROWSER.\;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FILEBROWSERCOMS)
|
||||
@@ -91,10 +91,22 @@ You specify how many versions to keep.")))
|
||||
(|See| (FB.EDITCOMMAND READONLY)
|
||||
|
||||
"Displays selected files one at a time in a separate window"
|
||||
)
|
||||
(|Browse| FB.BROWSECOMMAND
|
||||
(SUBITEMS ("Fast SEE Pretty" FB.FASTSEECOMMAND
|
||||
"Views file quickly, uses font information, no scrolling backwards"
|
||||
)
|
||||
("Fast SEE Unformatted" (FB.FASTSEECOMMAND
|
||||
T)
|
||||
|
||||
"Views file quickly, shows raw characters, no scrolling backwards"
|
||||
)
|
||||
("Scrollable & Pretty" (FB.EDITCOMMAND
|
||||
READONLY)
|
||||
|
||||
"Views file with font information in a fully scrollable window"
|
||||
)
|
||||
("FileBrowse" FB.BROWSECOMMAND
|
||||
"Recursively call FileBrowser on the selected subdirectory"
|
||||
)
|
||||
)))
|
||||
(|Edit| FB.EDITCOMMAND
|
||||
"Calls an editor on the selected files (use submenu to specify editor)"
|
||||
(SUBITEMS ("TEdit" (FB.EDITCOMMAND TEDIT)
|
||||
@@ -325,8 +337,15 @@ You specify how many versions to keep.")))
|
||||
("To a printer" (FB.HARDCOPYCOMMAND PRINTER)
|
||||
"Sends hardcopy of selected files to a printer of your choosing")))
|
||||
(|See| (FB.EDITCOMMAND READONLY)
|
||||
"Displays selected files one at a time in a separate window")
|
||||
(|Browse| FB.BROWSECOMMAND "Recursively call FileBrowser on the selected subdirectory")
|
||||
"Displays selected files one at a time in a separate window"
|
||||
(SUBITEMS ("Fast SEE Pretty" FB.FASTSEECOMMAND
|
||||
"Views file quickly, uses font information, no scrolling backwards")
|
||||
("Fast SEE Unformatted" (FB.FASTSEECOMMAND T)
|
||||
"Views file quickly, shows raw characters, no scrolling backwards")
|
||||
("Scrollable & Pretty" (FB.EDITCOMMAND READONLY)
|
||||
"Views file with font information in a fully scrollable window")
|
||||
("FileBrowse" FB.BROWSECOMMAND
|
||||
"Recursively call FileBrowser on the selected subdirectory")))
|
||||
(|Edit| FB.EDITCOMMAND
|
||||
"Calls an editor on the selected files (use submenu to specify editor)"
|
||||
(SUBITEMS ("TEdit" (FB.EDITCOMMAND TEDIT)
|
||||
@@ -808,10 +827,13 @@ Your deletions are thus ignored.")))
|
||||
(REDISPLAYW (CAR W))))))
|
||||
|
||||
(\\FB.HARDCOPY.TOFILE.EXTENSION
|
||||
(LAMBDA NIL (* \; "Edited 20-Sep-2025 11:41 by rmk")
|
||||
(* \; "Edited 14-Sep-2025 20:48 by rmk")
|
||||
(OR (CAR (EXTENSIONS.FOR.IMAGEFILETYPE (PRINTERTYPE)))
|
||||
DEFAULTPRINTERTYPE)))
|
||||
(LAMBDA NIL (* \;
|
||||
"Edited 25-Feb-91 15:15 by gadener")
|
||||
(LET ((TYPE (PRINTERTYPE)))
|
||||
(CASE TYPE
|
||||
(INTERPRESS 'IP)
|
||||
(POSTSCRIPT 'PS)
|
||||
(DEFAULT TYPE)))))
|
||||
)
|
||||
|
||||
|
||||
@@ -1564,25 +1586,22 @@ Your deletions are thus ignored.")))
|
||||
PRINTOPTIONS)))))))
|
||||
|
||||
(FB.HARDCOPY.TOFILE
|
||||
(LAMBDA (BROWSER FILES) (* \; "Edited 21-Dec-2025 09:05 by rmk")
|
||||
(* \; "Edited 20-Sep-2025 12:55 by rmk")
|
||||
(* \; "Edited 18-Sep-2025 10:29 by rmk")
|
||||
(* \; "Edited 14-Sep-2025 20:55 by rmk")
|
||||
(* \; "Edited 15-Feb-91 17:13 by gadener")
|
||||
(LAMBDA (BROWSER FILES) (* \;
|
||||
"Edited 15-Feb-91 17:13 by gadener")
|
||||
|
||||
(* |;;| "Handle the \"Hardcopy>To File\" command. ")
|
||||
|
||||
(PROG ((HCOPYFILE (FB.PROMPTFORINPUT (COND
|
||||
((CDR FILES)
|
||||
"Hardcopy file name pattern: ")
|
||||
(T "Hardcopy file name: "))
|
||||
((CDR FILES)
|
||||
"Hardcopy file name pattern: ")
|
||||
(T "Hardcopy file name: "))
|
||||
(COND
|
||||
((CDR FILES)
|
||||
(PACKFILENAME.STRING 'NAME '* 'EXTENSION (
|
||||
\\FB.HARDCOPY.TOFILE.EXTENSION
|
||||
\\FB.HARDCOPY.TOFILE.EXTENSION
|
||||
)))
|
||||
(T (PACKFILENAME.STRING 'VERSION NIL 'EXTENSION (
|
||||
\\FB.HARDCOPY.TOFILE.EXTENSION
|
||||
\\FB.HARDCOPY.TOFILE.EXTENSION
|
||||
)
|
||||
'BODY
|
||||
(FB.FETCHFILENAME (CAR FILES)))))
|
||||
@@ -1600,56 +1619,72 @@ Your deletions are thus ignored.")))
|
||||
((|for| TAIL |on| (SETQ HCOPYFIELDS (UNPACKFILENAME.STRING HCOPYFILE))
|
||||
|by| (CDDR TAIL) |bind| HOST HAVEDIRECTORY I
|
||||
|do| (COND
|
||||
((SETQ I (STRPOS '* (CADR TAIL)))
|
||||
(|if| (NEQ (CAR TAIL)
|
||||
'NAME)
|
||||
|then| (RETURN (SETQ MSG "Only name portion can contain *")))
|
||||
(* \; "Take apart name into FORE*AFT")
|
||||
(SETQ HCOPYTAIL (CDR TAIL))
|
||||
(SETQ FORE (OR (SUBSTRING (CADR TAIL)
|
||||
1
|
||||
(SUB1 I))
|
||||
""))
|
||||
(SETQ AFT (OR (SUBSTRING (CADR TAIL)
|
||||
(ADD1 I))
|
||||
"")))
|
||||
(T (SELECTQ (CAR TAIL)
|
||||
(NAME (RETURN (SETQ MSG
|
||||
"Name must have * for multiple hardcopy files")))
|
||||
(EXTENSION (SETQ EXT (MKATOM (U-CASE (CADR TAIL)))))
|
||||
(DIRECTORY (SETQ HAVEDIRECTORY T))
|
||||
(HOST (SETQ HOST (CADR TAIL)))
|
||||
NIL))) |finally| (|if| (AND HOST (NOT HAVEDIRECTORY))
|
||||
|then|
|
||||
((SETQ I (STRPOS '* (CADR TAIL)))
|
||||
(|if| (NEQ (CAR TAIL)
|
||||
'NAME)
|
||||
|then| (RETURN (SETQ MSG "Only name portion can contain *")
|
||||
)) (* \; "Take apart name into FORE*AFT")
|
||||
(SETQ HCOPYTAIL (CDR TAIL))
|
||||
(SETQ FORE (OR (SUBSTRING (CADR TAIL)
|
||||
1
|
||||
(SUB1 I))
|
||||
""))
|
||||
(SETQ AFT (OR (SUBSTRING (CADR TAIL)
|
||||
(ADD1 I))
|
||||
"")))
|
||||
(T (SELECTQ (CAR TAIL)
|
||||
(NAME (RETURN (SETQ MSG
|
||||
"Name must have * for multiple hardcopy files"
|
||||
)))
|
||||
(EXTENSION (SETQ EXT (MKATOM (U-CASE (CADR TAIL)))))
|
||||
(DIRECTORY (SETQ HAVEDIRECTORY T))
|
||||
(HOST (SETQ HOST (CADR TAIL)))
|
||||
NIL))) |finally| (|if| (AND HOST (NOT HAVEDIRECTORY))
|
||||
|then|
|
||||
(* \;
|
||||
"E.g., {DSK}*.IP. This pattern explicitly has no directory")
|
||||
(|push| HCOPYFIELDS 'DIRECTORY NIL)))
|
||||
"E.g., {DSK}*.IP. This pattern explicitly has no directory")
|
||||
(|push| HCOPYFIELDS
|
||||
'DIRECTORY NIL)))
|
||||
(FB.PROMPTWPRINT BROWSER "Bad pattern -- " MSG)
|
||||
(RETURN))))
|
||||
(T (SETQ EXT (U-CASE (FILENAMEFIELD HCOPYFILE 'EXTENSION)))))
|
||||
(CL:UNLESS (SETQ PRINTFILETYPE (OR (IMAGEFILETYPE.FROM.EXTENSION NIL EXT)
|
||||
(MENU (|MakeMenuOfImageTypes| "File type?"))))
|
||||
(RETURN))
|
||||
(|for| ITEM NAME FIELDS |in| FILES
|
||||
(COND
|
||||
((AND (NULL (SETQ PRINTFILETYPE (|for| TYPE |in| PRINTFILETYPES
|
||||
|when| (FMEMB EXT (CADR (ASSOC 'EXTENSION
|
||||
(CDR TYPE))))
|
||||
|do| (* \;
|
||||
"Opencoded PRINTFILETYPE.FROM.EXTENSION because that one's buggy")
|
||||
(RETURN (CAR TYPE)))))
|
||||
(NULL (SETQ PRINTFILETYPE (MENU (|MakeMenuOfImageTypes| "File type?")))))
|
||||
(RETURN)))
|
||||
(|for| ITEM |in| FILES |bind| (CONVERTERS _ (PRINTFILEPROP PRINTFILETYPE
|
||||
'CONVERSION))
|
||||
FILETYPE NAME FN FIELDS
|
||||
|do| (SETQ ITEM (FB.FETCHFILENAME ITEM))
|
||||
(SETQ NAME (COND
|
||||
((CDR FILES)
|
||||
(SETQ FIELDS (UNPACKFILENAME.STRING ITEM NIL NIL 'TENEX))
|
||||
(RPLACA HCOPYTAIL (CONCAT FORE (LISTGET FIELDS 'NAME)
|
||||
AFT))
|
||||
(CL:APPLY (FUNCTION PACKFILENAME.STRING)
|
||||
'VERSION NIL (APPEND HCOPYFIELDS FIELDS)))
|
||||
(T (OUTFILEP HCOPYFILE))))
|
||||
(FB.PROMPTW.FORMAT BROWSER "~%Writing ~A..." NAME)
|
||||
(|if| (SETQ NAME (CONVERT.TO.IMAGEFILE ITEM NAME PRINTFILETYPE
|
||||
'(NOERROR T QUIET T)))
|
||||
|then| (FB.PROMPTWPRINT BROWSER "done.")
|
||||
(FB.MAYBE.INSERT.FILE BROWSER NAME)
|
||||
|else| (FB.PROMPTW.FORMAT BROWSER
|
||||
"~%Failed to hardcopy ~A -- Can't convert a ~A file to format ~A"
|
||||
ITEM (OR (IMAGESOURCETYPE ITEM)
|
||||
'TEXT)
|
||||
PRINTFILETYPE))))))
|
||||
(SETQ FILETYPE (OR (PRINTFILETYPE ITEM)
|
||||
'TEXT))
|
||||
(COND
|
||||
((SETQ FN (LISTGET CONVERTERS FILETYPE))
|
||||
(FB.PROMPTW.FORMAT BROWSER "~%Writing ~A..."
|
||||
(SETQ NAME (COND
|
||||
((CDR FILES)
|
||||
(SETQ FIELDS (UNPACKFILENAME.STRING ITEM NIL NIL
|
||||
'TENEX))
|
||||
(RPLACA HCOPYTAIL (CONCAT FORE (LISTGET FIELDS
|
||||
'NAME)
|
||||
AFT))
|
||||
(CL:APPLY (FUNCTION PACKFILENAME.STRING)
|
||||
'VERSION NIL (APPEND HCOPYFIELDS FIELDS)))
|
||||
(T HCOPYFILE))))
|
||||
(SETQ NAME (CL:FUNCALL FN ITEM NAME))
|
||||
(COND
|
||||
((LISTP NAME) (* \; "Result is (SOURCE DESTINATION)")
|
||||
(SETQ NAME (CADR NAME))))
|
||||
(FB.PROMPTWPRINT BROWSER "done.")
|
||||
(FB.MAYBE.INSERT.FILE BROWSER NAME))
|
||||
(T (FB.PROMPTW.FORMAT BROWSER
|
||||
"~%Failed to hardcopy ~A -- Can't convert a ~A file to format ~A"
|
||||
ITEM FILETYPE PRINTFILETYPE)))))))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -4214,51 +4249,51 @@ then click Recompute"))))
|
||||
(ADDTOVAR LAMA FB.PROMPTW.FORMAT FB.PROMPTWPRINT)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (30255 53354 (FB 30265 . 31400) (FB.COPYBINARYCOMMAND 31402 . 31748) (FB.COPYTEXTCOMMAND
|
||||
31750 . 32092) (FILEBROWSER 32094 . 45200) (FB.TABLEBROWSER 45202 . 45419) (FB.SELECTEDFILES 45421 .
|
||||
46058) (FB.FETCHFILENAME 46060 . 46452) (FB.DIRECTORYP 46454 . 46848) (FB.PROMPTWPRINT 46850 . 47896)
|
||||
(FB.PROMPTW.FORMAT 47898 . 48862) (FB.PROMPTFORINPUT 48864 . 51116) (FB.YES-OR-NO-P 51118 . 52152) (
|
||||
FB.ALLOW.ABORT 52154 . 53008) (\\FB.HARDCOPY.TOFILE.EXTENSION 53010 . 53352)) (53378 54331 (FB.STARTUP
|
||||
53388 . 53903) (FB.MAKERIGIDWINDOW 53905 . 54329)) (54332 59815 (FB.PRINTFN 54342 . 59495) (FB.COPYFN
|
||||
59497 . 59813)) (59865 66205 (FB.MENU.WHENSELECTEDFN 59875 . 60233) (FB.COMMANDSELECTEDFN 60235 .
|
||||
61774) (FB.SUBITEMP 61776 . 62377) (FB.MAKE.BROWSER.BUSY 62379 . 63183) (FB.FINISH.COMMAND 63185 .
|
||||
65216) (FB.HANDLE.ABORT.BUTTON 65218 . 66203)) (66206 71722 (FB.DELETECOMMAND 66216 . 66497) (
|
||||
FB.DELVERCOMMAND 66499 . 69692) (FB.IS.NOT.SUBDIRECTORY.ITEM 69694 . 69875) (FB.DELVER.FILES 69877 .
|
||||
70966) (FB.DELETE.FILE 70968 . 71720)) (71723 73048 (FB.UNDELETECOMMAND 71733 . 72018) (
|
||||
FB.UNDELETEALLCOMMAND 72020 . 72299) (FB.UNDELETE.FILE 72301 . 73046)) (73049 97230 (FB.COPYCOMMAND
|
||||
73059 . 73328) (FB.RENAMECOMMAND 73330 . 73605) (FB.COPY/RENAME.COMMAND 73607 . 74530) (
|
||||
FB.COPY/RENAME.ONE 74532 . 76854) (FB.COPY/RENAME.MANY 76856 . 83076) (FB.MERGE.DIRECTORIES 83078 .
|
||||
83496) (FB.GREATEST.PREFIX 83498 . 84854) (FB.MAYBE.INSERT.FILE 84856 . 92296) (FB.GET.NEW.FILE.SPEC
|
||||
92298 . 96129) (FB.CANONICAL.DIRECTORY 96131 . 97228)) (97231 104094 (FB.HARDCOPYCOMMAND 97241 . 98371
|
||||
) (FB.HARDCOPY.TOFILE 98373 . 104092)) (104095 114304 (FB.EDITCOMMAND 104105 . 104972) (
|
||||
FB.EDITCOMMAND.ONEFILE 104974 . 108388) (FB.EDITLISPFILE 108390 . 109495) (FB.BROWSECOMMAND 109497 .
|
||||
114302)) (114305 126025 (FB.FASTSEECOMMAND 114315 . 117765) (FB.FASTSEE.ONEFILE 117767 . 120723) (
|
||||
FB.SEEFULLFN 120725 . 124856) (FB.SEEBUTTONFN 124858 . 126023)) (126026 127772 (FB.LOADCOMMAND 126036
|
||||
. 126543) (FB.COMPILECOMMAND 126545 . 127083) (FB.OPERATE.ON.FILES 127085 . 127770)) (127773 175958 (
|
||||
FB.UPDATECOMMAND 127783 . 128008) (FB.FIX-DIRECTORY-DATES 128010 . 129033) (FB.MAYBE.EXPUNGE 129035 .
|
||||
130096) (FB.UPDATEBROWSERITEMS 130098 . 143313) (FB.DATE 143315 . 143956) (FB.ADJUST.DATE.WIDTH 143958
|
||||
. 146926) (FB.SET.BROWSER.TITLE 146928 . 147930) (FB.MAYBE.WIDEN.NAMES 147932 . 150051) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 150053 . 151417) (FB.CREATE.FILEBUCKET 151419 . 158639) (
|
||||
FB.CHECK.NAME.LENGTH 158641 . 161062) (FB.ADD.FILEGROUP 161064 . 162591) (FB.INSERT.DIRECTORY 162593
|
||||
. 162831) (FB.MAKE.SUBDIRECTORY.ITEM 162833 . 164242) (FB.ADD.FILE 164244 . 164857) (FB.INSERT.FILE
|
||||
164859 . 168271) (FB.ANALYZE.PATTERN 168273 . 173537) (FB.CANONICALIZE.PATTERN 173539 . 174851) (
|
||||
FB.GETALLFILEINFO 174853 . 175956)) (175959 184118 (FB.SORT.VERSIONS 175969 . 178740) (
|
||||
FB.DECREASING.VERSION 178742 . 179411) (FB.INCREASING.VERSION 179413 . 180034) (
|
||||
FB.NAMES.DECREASING.VERSION 180036 . 181071) (FB.NAMES.INCREASING.VERSION 181073 . 182070) (
|
||||
FB.DECREASING.NUMERIC.ATTR 182072 . 182752) (FB.INCREASING.NUMERIC.ATTR 182754 . 183428) (
|
||||
FB.ALPHABETIC.ATTR 183430 . 184116)) (184119 193961 (FB.SORTCOMMAND 184129 . 190959) (
|
||||
FB.INSERT.SUBDIRECTORIES 190961 . 191758) (FB.GET.SORT.MENU 191760 . 193959)) (193962 210183 (
|
||||
FB.EXPUNGECOMMAND 193972 . 196557) (FB.NEWPATTERNCOMMAND 196559 . 196957) (FB.NEWINFOCOMMAND 196959 .
|
||||
199791) (FB.DEPTHCOMMAND 199793 . 201568) (FB.SHAPECOMMAND 201570 . 204912) (FB.REMOVE.FILE 204914 .
|
||||
206735) (FB.COUNT.FILE.CHANGE 206737 . 208182) (FB.SETNEWPATTERN 208184 . 209354) (FB.GET.NEWPATTERN
|
||||
209356 . 209940) (FB.OPTIONSCOMMAND 209942 . 210181)) (210218 211271 (FB.GETWINDOW 210228 . 211269)) (
|
||||
211272 212284 (FB.INFOMENU.SHADEINITIALSELECTIONS 211282 . 211929) (FB.INFO.ITEM.NAMED 211931 . 212282
|
||||
)) (212285 221817 (FB.MAKECOUNTERWINDOW 212295 . 213823) (FB.COUNTERW.REDISPLAYFN 213825 . 214412) (
|
||||
FB.UPDATE.COUNTERS 214414 . 216486) (FB.DISPLAY.COUNTERS 216488 . 221548) (FB.COUNTER.STRING 221550 .
|
||||
221815)) (221818 226527 (FB.MAKEHEADINGWINDOW 221828 . 223442) (FB.HEADINGW.REDISPLAYFN 223444 .
|
||||
223710) (FB.HEADINGW.RESHAPEFN 223712 . 224088) (FB.HEADINGW.DISPLAY 224090 . 226525)) (226528 230711
|
||||
(FB.ICONFN 226538 . 226885) (FB.INFOMENU.WHENSELECTEDFN 226887 . 227617) (FB.CLOSEFN 227619 . 228822)
|
||||
(FB.EXPUNGE?.MENU 228824 . 229236) (FB.AFTERCLOSEFN 229238 . 229599) (FB.CLOSE&EXPUNGE 229601 . 230709
|
||||
)) (230712 242770 (FB.HARDCOPY.DIRECTORY 230722 . 241079) (FB.HARDCOPY.PRINT.TITLE 241081 . 241407) (
|
||||
FB.HARDCOPY.MAXWIDTH 241409 . 242768)))))
|
||||
(FILEMAP (NIL (31871 54979 (FB 31881 . 33016) (FB.COPYBINARYCOMMAND 33018 . 33364) (FB.COPYTEXTCOMMAND
|
||||
33366 . 33708) (FILEBROWSER 33710 . 46816) (FB.TABLEBROWSER 46818 . 47035) (FB.SELECTEDFILES 47037 .
|
||||
47674) (FB.FETCHFILENAME 47676 . 48068) (FB.DIRECTORYP 48070 . 48464) (FB.PROMPTWPRINT 48466 . 49512)
|
||||
(FB.PROMPTW.FORMAT 49514 . 50478) (FB.PROMPTFORINPUT 50480 . 52732) (FB.YES-OR-NO-P 52734 . 53768) (
|
||||
FB.ALLOW.ABORT 53770 . 54624) (\\FB.HARDCOPY.TOFILE.EXTENSION 54626 . 54977)) (55003 55956 (FB.STARTUP
|
||||
55013 . 55528) (FB.MAKERIGIDWINDOW 55530 . 55954)) (55957 61440 (FB.PRINTFN 55967 . 61120) (FB.COPYFN
|
||||
61122 . 61438)) (61490 67830 (FB.MENU.WHENSELECTEDFN 61500 . 61858) (FB.COMMANDSELECTEDFN 61860 .
|
||||
63399) (FB.SUBITEMP 63401 . 64002) (FB.MAKE.BROWSER.BUSY 64004 . 64808) (FB.FINISH.COMMAND 64810 .
|
||||
66841) (FB.HANDLE.ABORT.BUTTON 66843 . 67828)) (67831 73347 (FB.DELETECOMMAND 67841 . 68122) (
|
||||
FB.DELVERCOMMAND 68124 . 71317) (FB.IS.NOT.SUBDIRECTORY.ITEM 71319 . 71500) (FB.DELVER.FILES 71502 .
|
||||
72591) (FB.DELETE.FILE 72593 . 73345)) (73348 74673 (FB.UNDELETECOMMAND 73358 . 73643) (
|
||||
FB.UNDELETEALLCOMMAND 73645 . 73924) (FB.UNDELETE.FILE 73926 . 74671)) (74674 98855 (FB.COPYCOMMAND
|
||||
74684 . 74953) (FB.RENAMECOMMAND 74955 . 75230) (FB.COPY/RENAME.COMMAND 75232 . 76155) (
|
||||
FB.COPY/RENAME.ONE 76157 . 78479) (FB.COPY/RENAME.MANY 78481 . 84701) (FB.MERGE.DIRECTORIES 84703 .
|
||||
85121) (FB.GREATEST.PREFIX 85123 . 86479) (FB.MAYBE.INSERT.FILE 86481 . 93921) (FB.GET.NEW.FILE.SPEC
|
||||
93923 . 97754) (FB.CANONICAL.DIRECTORY 97756 . 98853)) (98856 106640 (FB.HARDCOPYCOMMAND 98866 . 99996
|
||||
) (FB.HARDCOPY.TOFILE 99998 . 106638)) (106641 116850 (FB.EDITCOMMAND 106651 . 107518) (
|
||||
FB.EDITCOMMAND.ONEFILE 107520 . 110934) (FB.EDITLISPFILE 110936 . 112041) (FB.BROWSECOMMAND 112043 .
|
||||
116848)) (116851 128571 (FB.FASTSEECOMMAND 116861 . 120311) (FB.FASTSEE.ONEFILE 120313 . 123269) (
|
||||
FB.SEEFULLFN 123271 . 127402) (FB.SEEBUTTONFN 127404 . 128569)) (128572 130318 (FB.LOADCOMMAND 128582
|
||||
. 129089) (FB.COMPILECOMMAND 129091 . 129629) (FB.OPERATE.ON.FILES 129631 . 130316)) (130319 178504 (
|
||||
FB.UPDATECOMMAND 130329 . 130554) (FB.FIX-DIRECTORY-DATES 130556 . 131579) (FB.MAYBE.EXPUNGE 131581 .
|
||||
132642) (FB.UPDATEBROWSERITEMS 132644 . 145859) (FB.DATE 145861 . 146502) (FB.ADJUST.DATE.WIDTH 146504
|
||||
. 149472) (FB.SET.BROWSER.TITLE 149474 . 150476) (FB.MAYBE.WIDEN.NAMES 150478 . 152597) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 152599 . 153963) (FB.CREATE.FILEBUCKET 153965 . 161185) (
|
||||
FB.CHECK.NAME.LENGTH 161187 . 163608) (FB.ADD.FILEGROUP 163610 . 165137) (FB.INSERT.DIRECTORY 165139
|
||||
. 165377) (FB.MAKE.SUBDIRECTORY.ITEM 165379 . 166788) (FB.ADD.FILE 166790 . 167403) (FB.INSERT.FILE
|
||||
167405 . 170817) (FB.ANALYZE.PATTERN 170819 . 176083) (FB.CANONICALIZE.PATTERN 176085 . 177397) (
|
||||
FB.GETALLFILEINFO 177399 . 178502)) (178505 186664 (FB.SORT.VERSIONS 178515 . 181286) (
|
||||
FB.DECREASING.VERSION 181288 . 181957) (FB.INCREASING.VERSION 181959 . 182580) (
|
||||
FB.NAMES.DECREASING.VERSION 182582 . 183617) (FB.NAMES.INCREASING.VERSION 183619 . 184616) (
|
||||
FB.DECREASING.NUMERIC.ATTR 184618 . 185298) (FB.INCREASING.NUMERIC.ATTR 185300 . 185974) (
|
||||
FB.ALPHABETIC.ATTR 185976 . 186662)) (186665 196507 (FB.SORTCOMMAND 186675 . 193505) (
|
||||
FB.INSERT.SUBDIRECTORIES 193507 . 194304) (FB.GET.SORT.MENU 194306 . 196505)) (196508 212729 (
|
||||
FB.EXPUNGECOMMAND 196518 . 199103) (FB.NEWPATTERNCOMMAND 199105 . 199503) (FB.NEWINFOCOMMAND 199505 .
|
||||
202337) (FB.DEPTHCOMMAND 202339 . 204114) (FB.SHAPECOMMAND 204116 . 207458) (FB.REMOVE.FILE 207460 .
|
||||
209281) (FB.COUNT.FILE.CHANGE 209283 . 210728) (FB.SETNEWPATTERN 210730 . 211900) (FB.GET.NEWPATTERN
|
||||
211902 . 212486) (FB.OPTIONSCOMMAND 212488 . 212727)) (212764 213817 (FB.GETWINDOW 212774 . 213815)) (
|
||||
213818 214830 (FB.INFOMENU.SHADEINITIALSELECTIONS 213828 . 214475) (FB.INFO.ITEM.NAMED 214477 . 214828
|
||||
)) (214831 224363 (FB.MAKECOUNTERWINDOW 214841 . 216369) (FB.COUNTERW.REDISPLAYFN 216371 . 216958) (
|
||||
FB.UPDATE.COUNTERS 216960 . 219032) (FB.DISPLAY.COUNTERS 219034 . 224094) (FB.COUNTER.STRING 224096 .
|
||||
224361)) (224364 229073 (FB.MAKEHEADINGWINDOW 224374 . 225988) (FB.HEADINGW.REDISPLAYFN 225990 .
|
||||
226256) (FB.HEADINGW.RESHAPEFN 226258 . 226634) (FB.HEADINGW.DISPLAY 226636 . 229071)) (229074 233257
|
||||
(FB.ICONFN 229084 . 229431) (FB.INFOMENU.WHENSELECTEDFN 229433 . 230163) (FB.CLOSEFN 230165 . 231368)
|
||||
(FB.EXPUNGE?.MENU 231370 . 231782) (FB.AFTERCLOSEFN 231784 . 232145) (FB.CLOSE&EXPUNGE 232147 . 233255
|
||||
)) (233258 245316 (FB.HARDCOPY.DIRECTORY 233268 . 243625) (FB.HARDCOPY.PRINT.TITLE 243627 . 243953) (
|
||||
FB.HARDCOPY.MAXWIDTH 243955 . 245314)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "30-Dec-2025 14:53:37" {WMEDLEY}<library>MAIKOCOLOR.;3 58803
|
||||
(FILECREATED "26-Oct-2021 10:53:57" {DSK}<home>larry>medley>library>MAIKOCOLOR.;2 60141
|
||||
|
||||
:EDIT-BY rmk
|
||||
changes to%: (VARS MAIKOCOLORCOMS)
|
||||
(MACROS \MAIKO.CGTHREEP \MAIKO.CGFOURP \MAIKO.CGSIXP \MAIKO.CGTWOP)
|
||||
(FNS \MAIKO.COLORINIT \MAIKO.STARTCOLOR \MAIKO.STOPCOLOR \MAIKOCOLOR.EVENTFN
|
||||
\MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN CURSOREXIT CURSORSCREEN
|
||||
WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY \PUNT.SLOWBLTCHAR
|
||||
\PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP BITMAPOBJ.SNAPW \MAIKO.PUNTBLTCHAR
|
||||
\MAIKO.BLTCHAR)
|
||||
|
||||
:CHANGES-TO (VARS MAIKOCOLORCOMS)
|
||||
previous date%: "23-Oct-91 14:43:35" {DSK}<home>larry>medley>library>MAIKOCOLOR.;1)
|
||||
|
||||
:PREVIOUS-DATE "26-Oct-2021 10:53:57" {WMEDLEY}<library>MAIKOCOLOR.;2)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT MAIKOCOLORCOMS)
|
||||
|
||||
@@ -21,7 +29,7 @@
|
||||
\MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN)
|
||||
(FNS CURSOREXIT CURSORSCREEN WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY)
|
||||
(* ;
|
||||
"these FNS defs. will be moved to original files,later")
|
||||
"these FNS defs. will be moved to original files,later")
|
||||
(FNS \PUNT.SLOWBLTCHAR \MAIKO.PUNTBLTCHAR \MAIKO.BLTCHAR)
|
||||
(FNS \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP)
|
||||
(FNS BITMAPOBJ.SNAPW)
|
||||
@@ -39,7 +47,7 @@
|
||||
(GLOBALVARS MAIKOCOLOR.BITSPERPIXEL)
|
||||
(FILES COLOR BIGBITMAPS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD 'CURSOREXIT 'SAVE.CURSOREXIT)
|
||||
(MOVD '\MAIKO.BLTCHAR '\BLTCHAR)
|
||||
(MOVD '\MAIKO.BLTCHAR '\BILTCHAR)
|
||||
(\MAIKO.COLORINIT)
|
||||
(COLORDISPLAY 'ON 'MAIKOCOLOR)
|
||||
(CURSORSCREEN (COLORSCREEN)
|
||||
@@ -901,20 +909,28 @@
|
||||
[PROGN (DEFMACRO \MAIKO.CGTHREEP ()
|
||||
(EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
48))
|
||||
(PUTPROPS \MAIKO.CGTHREEP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
48)))]
|
||||
(PUTPROPS \MAIKO.CGTHREEP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of
|
||||
|
||||
\InterfacePage
|
||||
))
|
||||
48)))]
|
||||
|
||||
(PUTPROPS \MAIKO.CGFOURP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
64)))
|
||||
(PUTPROPS \MAIKO.CGFOURP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of
|
||||
\InterfacePage
|
||||
))
|
||||
64)))
|
||||
|
||||
[PROGN (DEFMACRO \MAIKO.CGSIXP ()
|
||||
(EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
96))
|
||||
(PUTPROPS \MAIKO.CGSIXP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
96)))]
|
||||
(PUTPROPS \MAIKO.CGSIXP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of
|
||||
\InterfacePage
|
||||
))
|
||||
96)))]
|
||||
|
||||
(PUTPROPS \MAIKO.CGTWOP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
24)))
|
||||
(PUTPROPS \MAIKO.CGTWOP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage
|
||||
))
|
||||
24)))
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -958,7 +974,7 @@
|
||||
|
||||
(MOVD 'CURSOREXIT 'SAVE.CURSOREXIT)
|
||||
|
||||
(MOVD '\MAIKO.BLTCHAR '\BLTCHAR)
|
||||
(MOVD '\MAIKO.BLTCHAR '\BILTCHAR)
|
||||
|
||||
(\MAIKO.COLORINIT)
|
||||
|
||||
@@ -973,12 +989,13 @@
|
||||
|
||||
(LOGOW)
|
||||
)
|
||||
(PUTPROPS MAIKOCOLOR COPYRIGHT ("Fuji Xerox Co., Ltd." 1988 1989 1990 1991))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2639 6664 (\MAIKO.COLORINIT 2649 . 3885) (\MAIKO.STARTCOLOR 3887 . 4703) (
|
||||
\MAIKO.STOPCOLOR 4705 . 5159) (\MAIKOCOLOR.EVENTFN 5161 . 5792) (\MAIKO.SENDCOLORMAPENTRY 5794 . 6252)
|
||||
(\MAIKO.CHANGESCREEN 6254 . 6662)) (6665 27654 (CURSOREXIT 6675 . 8179) (CURSORSCREEN 8181 . 10287) (
|
||||
WARPCURSOR 10289 . 10604) (\SLOWBLTCHAR 10606 . 11018) (\SOFTCURSORUP 11020 . 16881) (\BITBLT.DISPLAY
|
||||
16883 . 27652)) (27725 39693 (\PUNT.SLOWBLTCHAR 27735 . 34573) (\MAIKO.PUNTBLTCHAR 34575 . 39265) (
|
||||
\MAIKO.BLTCHAR 39267 . 39691)) (39694 56027 (\PUNT.BLTSHADE.BITMAP 39704 . 46796) (\PUNT.BITBLT.BITMAP
|
||||
46798 . 56025)) (56028 56836 (BITMAPOBJ.SNAPW 56038 . 56834)))))
|
||||
(FILEMAP (NIL (3229 7254 (\MAIKO.COLORINIT 3239 . 4475) (\MAIKO.STARTCOLOR 4477 . 5293) (
|
||||
\MAIKO.STOPCOLOR 5295 . 5749) (\MAIKOCOLOR.EVENTFN 5751 . 6382) (\MAIKO.SENDCOLORMAPENTRY 6384 . 6842)
|
||||
(\MAIKO.CHANGESCREEN 6844 . 7252)) (7255 28244 (CURSOREXIT 7265 . 8769) (CURSORSCREEN 8771 . 10877) (
|
||||
WARPCURSOR 10879 . 11194) (\SLOWBLTCHAR 11196 . 11608) (\SOFTCURSORUP 11610 . 17471) (\BITBLT.DISPLAY
|
||||
17473 . 28242)) (28315 40283 (\PUNT.SLOWBLTCHAR 28325 . 35163) (\MAIKO.PUNTBLTCHAR 35165 . 39855) (
|
||||
\MAIKO.BLTCHAR 39857 . 40281)) (40284 56617 (\PUNT.BLTSHADE.BITMAP 40294 . 47386) (\PUNT.BITBLT.BITMAP
|
||||
47388 . 56615)) (56618 57426 (BITMAPOBJ.SNAPW 56628 . 57424)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Feb-2024 09:28:38" {DSK}<home>larry>il>medley>library>MSANALYZE.;2 61022
|
||||
(FILECREATED " 2-Oct-2025 23:05:25" {WMEDLEY}<library>MSANALYZE.;4 61409
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "17-Feb-2024 22:10:56" {DSK}<home>larry>il>medley>library>MSANALYZE.;3)
|
||||
:CHANGES-TO (FNS CALLS)
|
||||
|
||||
:PREVIOUS-DATE "20-Feb-2024 09:28:38" {WMEDLEY}<library>MSANALYZE.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MSANALYZECOMS)
|
||||
@@ -72,11 +74,13 @@
|
||||
(CADDR (CALLS FN USEDATABASE 'FREEVARS])
|
||||
|
||||
(CALLS
|
||||
[LAMBDA (EXPR USEDATABASE VARSFLG) (* ; "Edited 12-Jun-90 17:25 by teruuchi")
|
||||
[LAMBDA (EXPR USEDATABASE VARSFLG) (* ; "Edited 2-Oct-2025 23:01 by rmk")
|
||||
(* ; "Edited 12-Jun-90 17:25 by teruuchi")
|
||||
(* ;
|
||||
"This FNS is for the User Interface Function in MSANALYZE(MasterScope)")
|
||||
(* ;
|
||||
"Edited by Tomoru Teruuchi(12-June-90 : for AR#10020)")
|
||||
"Edited by Tomoru Teruuchi(12-June-90 : for AR#10020) ")
|
||||
(* ; "Edited by TT (Date : 8-May-1990)")
|
||||
(PROG (FREES (GLOBALS NIL)
|
||||
FNDEF FLG)
|
||||
[COND
|
||||
@@ -84,19 +88,20 @@
|
||||
(GETD 'UPDATEFN))
|
||||
(UPDATEFN EXPR NIL 'ERROR)
|
||||
[SETQ FREES (GETRELATION EXPR '(USE FREELY]
|
||||
[SETQ FREES (SUBSET FREES (FUNCTION (LAMBDA (VAR)
|
||||
[SETQ FREES (SORT (SUBSET FREES (FUNCTION (LAMBDA (VAR)
|
||||
(* ;
|
||||
"This Function is The Predicate whether the variable is global or not.")
|
||||
(if (OR (FMEMB VAR GLOBALVARS)
|
||||
(EQ (GETPROP VAR 'GLOBALVAR)
|
||||
T))
|
||||
then (pushnew GLOBALS VAR)
|
||||
NIL
|
||||
else T](* ; "Edited by TT (Date : 8-May-1990)")
|
||||
(if (OR (FMEMB VAR GLOBALVARS)
|
||||
(EQ (GETPROP VAR 'GLOBALVAR)
|
||||
T))
|
||||
then (pushnew GLOBALS VAR)
|
||||
NIL
|
||||
else T]
|
||||
(SETQ GLOBALS (SORT GLOBALS))
|
||||
(RETURN (LIST [AND (NOT VARSFLG)
|
||||
(GETRELATION EXPR '(CALL NOTERROR]
|
||||
(AND (NEQ VARSFLG 'FREEVARS)
|
||||
(GETRELATION EXPR 'BIND))
|
||||
(SORT (GETRELATION EXPR '(CALL NOTERROR]
|
||||
[AND (NEQ VARSFLG 'FREEVARS)
|
||||
(SORT (GETRELATION EXPR 'BIND]
|
||||
FREES GLOBALS]
|
||||
GETDLP
|
||||
(SETQ FNDEF (COND
|
||||
@@ -170,11 +175,13 @@
|
||||
then (pushnew GLOBALS VAR)
|
||||
NIL
|
||||
else T]
|
||||
(* ; "Edited by TT (Date : 8-May-1990)")
|
||||
(RETURN (LIST [COLLECTFNDATA (CONSTANT (MSVBNOTICED 'CALL
|
||||
(RETURN (LIST [SORT (COLLECTFNDATA (CONSTANT (MSVBNOTICED
|
||||
'CALL
|
||||
'NOTERROR]
|
||||
[COLLECTFNDATA (CONSTANT (MSVBNOTICED 'BIND]
|
||||
FREES GLOBALS]
|
||||
[SORT (COLLECTFNDATA (CONSTANT (MSVBNOTICED
|
||||
'BIND]
|
||||
(SORT FREES)
|
||||
(SORT GLOBALS]
|
||||
(T '?])
|
||||
|
||||
(COLLECTFNDATA
|
||||
@@ -1270,11 +1277,11 @@ DONTCOPY
|
||||
(BLOCK%: MSFINDP MSFINDP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3487 10938 (VARS 3497 . 3636) (FREEVARS 3638 . 3789) (CALLS 3791 . 10089) (
|
||||
COLLECTFNDATA 10091 . 10462) (CALLS3 10464 . 10936)) (13187 51210 (ALLCALLS 13197 . 13797) (
|
||||
MSINITFNDATA 13799 . 14029) (MSPRGE 14031 . 21284) (MSPRGMACRO 21286 . 21997) (MSPRGCALL 21999 . 22316
|
||||
) (MSBINDVAR 22318 . 22825) (MSPRGRECORD 22827 . 29604) (MSPRGERR 29606 . 29769) (MSPRGTEMPLATE1 29771
|
||||
. 38819) (MSPRGTEMPLATE 38821 . 39424) (MSPRGLAMBDA 39426 . 48039) (MSPRGLST 48041 . 48203) (ADDTO
|
||||
48205 . 48985) (NLAMBDAFNP 48987 . 49713) (MSPRGDWIM 49715 . 50554) (MSDWIMTRAN 50556 . 51208)) (60485
|
||||
60921 (MSFINDP 60495 . 60919)))))
|
||||
(FILEMAP (NIL (3482 11325 (VARS 3492 . 3631) (FREEVARS 3633 . 3784) (CALLS 3786 . 10476) (
|
||||
COLLECTFNDATA 10478 . 10849) (CALLS3 10851 . 11323)) (13574 51597 (ALLCALLS 13584 . 14184) (
|
||||
MSINITFNDATA 14186 . 14416) (MSPRGE 14418 . 21671) (MSPRGMACRO 21673 . 22384) (MSPRGCALL 22386 . 22703
|
||||
) (MSBINDVAR 22705 . 23212) (MSPRGRECORD 23214 . 29991) (MSPRGERR 29993 . 30156) (MSPRGTEMPLATE1 30158
|
||||
. 39206) (MSPRGTEMPLATE 39208 . 39811) (MSPRGLAMBDA 39813 . 48426) (MSPRGLST 48428 . 48590) (ADDTO
|
||||
48592 . 49372) (NLAMBDAFNP 49374 . 50100) (MSPRGDWIM 50102 . 50941) (MSDWIMTRAN 50943 . 51595)) (60872
|
||||
61308 (MSFINDP 60882 . 61306)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Dec-2025 20:40:36" {WMEDLEY}<library>MULTI-ALIST.;32 15606
|
||||
(FILECREATED "25-Sep-2025 18:41:59" {WMEDLEY}<library>MULTI-ALIST.;30 15648
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (PROPS (SGETMULTI ARGNAMES))
|
||||
(MACROS SGETMULTI GETMULTI)
|
||||
:CHANGES-TO (FNS EXTENDMULTI-PAIR FETCHMULTI-PAIR)
|
||||
(MACROS FETCHMULTI)
|
||||
|
||||
:PREVIOUS-DATE "25-Sep-2025 18:41:59" {WMEDLEY}<library>MULTI-ALIST.;30)
|
||||
:PREVIOUS-DATE "25-Sep-2025 11:35:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>MULTI-ALIST.;28)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MULTI-ALISTCOMS)
|
||||
@@ -61,7 +62,7 @@
|
||||
(CDR ARGS))))
|
||||
|
||||
(PUTPROPS SGETMULTI MACRO ((MULTIALIST . KEYS)
|
||||
(CDR (SGETMULTI-PAIR MULTIALIST . KEYS))))
|
||||
(CDR (GETMULTI-PAIR MULTIALIST . KEYS))))
|
||||
|
||||
(PUTPROPS SGETMULTI-PAIR MACRO (ARGS (GETMULTI-PAIR.EXPAND 'SASSOC (CAR ARGS)
|
||||
(CDR ARGS))))
|
||||
@@ -281,7 +282,7 @@
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3678 10388 (MAPMULTI 3688 . 4834) (MAPMULTI1 4836 . 5893) (COLLECTMULTI 5895 . 6366) (
|
||||
FETCHMULTI-PAIR 6368 . 7428) (EXTENDMULTI-PAIR 7430 . 10386)) (10389 14763 (GETMULTI-PAIR.EXPAND 10399
|
||||
. 11900) (PUTMULTI.EXPAND 11902 . 14761)))))
|
||||
(FILEMAP (NIL (3720 10430 (MAPMULTI 3730 . 4876) (MAPMULTI1 4878 . 5935) (COLLECTMULTI 5937 . 6408) (
|
||||
FETCHMULTI-PAIR 6410 . 7470) (EXTENDMULTI-PAIR 7472 . 10428)) (10431 14805 (GETMULTI-PAIR.EXPAND 10441
|
||||
. 11942) (PUTMULTI.EXPAND 11944 . 14803)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jan-2026 17:03:36" {WMEDLEY}<library>PDFSTREAM.;107 17186
|
||||
(FILECREATED "23-Aug-2025 10:53:33" {WMEDLEY}<library>PDFSTREAM.;70 15659
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS PDFSTREAMCOMS)
|
||||
(FNS SEE-PDF)
|
||||
:CHANGES-TO (FNS PDF.FONTSAVAILABLE)
|
||||
|
||||
:PREVIOUS-DATE "17-Jan-2026 12:11:04" {WMEDLEY}<library>PDFSTREAM.;105)
|
||||
:PREVIOUS-DATE "30-Jul-2025 18:01:04" {WMEDLEY}<library>PDFSTREAM.;68)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PDFSTREAMCOMS)
|
||||
@@ -15,13 +14,26 @@
|
||||
(RPAQQ PDFSTREAMCOMS
|
||||
((FILES (SYSLOAD)
|
||||
POSTSCRIPTSTREAM)
|
||||
(INITVARS (PDFFONTCOERCIONS POSTSCRIPTFONTCOERCIONS)
|
||||
(PDFCHARCOERCIONS POSTSCRIPTCHARCOERCIONS))
|
||||
[COMS (* ; "Hook into hardcopy interface")
|
||||
(ALISTS (PRINTFILETYPES PDF)
|
||||
(IMAGESTREAMTYPES PDF)
|
||||
(DEFAULTFILETYPELIST PDF))
|
||||
(FNS PDFFILEP PDF.HARDCOPYW PDF.TEDIT PDF.FONTSAVAILABLE)
|
||||
[ADDVARS [PRINTERTYPES ((PDF)
|
||||
(CANPRINT (PDF))
|
||||
(STATUS TRUE)
|
||||
(PROPERTIES NILL)
|
||||
(SEND POSTSCRIPTSEND)
|
||||
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
|
||||
(BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION
|
||||
ROTATION TITLE]
|
||||
[PRINTFILETYPES (PDF (TEST PDFFILEP)
|
||||
(EXTENSION (PDF))
|
||||
(CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT]
|
||||
(IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM)
|
||||
(FONTCREATE POSTSCRIPT.FONTCREATE)
|
||||
(FONTSAVAILABLE PDF.FONTSAVAILABLE)
|
||||
(CREATECHARSET \CREATECHARSET.PSC)
|
||||
(FONTEXISTS? POSTSCRIPT.FONTEXISTS?]
|
||||
(ALISTS (DEFAULTFILETYPELIST PDF))
|
||||
(VARS (DEFAULTPRINTERTYPE 'PDF))
|
||||
(FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT PDF.FONTSAVAILABLE)
|
||||
(P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]
|
||||
|
||||
(* ;; "")
|
||||
@@ -34,31 +46,29 @@
|
||||
(ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf))
|
||||
(GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES)
|
||||
(FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF)
|
||||
(FNS PDF.POSTSCRIPT)
|
||||
(FNS SEE-PDF)
|
||||
(ADDVARS (FB.SEE.METHODS (PDFFILEP SEE-PDF)))
|
||||
(FNS PDFCONVERTER)
|
||||
(FNS \PDFINIT)
|
||||
(P (\PDFINIT))))
|
||||
(FNS PDFCONVERTER)))
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
POSTSCRIPTSTREAM)
|
||||
|
||||
(RPAQ? PDFFONTCOERCIONS POSTSCRIPTFONTCOERCIONS)
|
||||
|
||||
(RPAQ? PDFCHARCOERCIONS POSTSCRIPTCHARCOERCIONS)
|
||||
|
||||
|
||||
|
||||
(* ; "Hook into hardcopy interface")
|
||||
|
||||
|
||||
(ADDTOVAR PRINTERTYPES ((PDF)
|
||||
(CANPRINT (PDF))
|
||||
(STATUS TRUE)
|
||||
(PROPERTIES NILL)
|
||||
(SEND POSTSCRIPTSEND)
|
||||
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
|
||||
(BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES (PDF (TEST PDFFILEP)
|
||||
(EXTENSION (PDF))
|
||||
(CONVERSION (POSTSCRIPT PDF.POSTSCRIPT))
|
||||
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
|
||||
(BITMAPFILE (PDF.HARDCOPYW IMAGEFILE BITMAP SCALEFACTOR REGION ROTATION
|
||||
TITLE))))
|
||||
(CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT))))
|
||||
|
||||
(ADDTOVAR IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM)
|
||||
(FONTCREATE POSTSCRIPT.FONTCREATE)
|
||||
@@ -67,56 +77,54 @@
|
||||
(FONTEXISTS? POSTSCRIPT.FONTEXISTS?)))
|
||||
|
||||
(ADDTOVAR DEFAULTFILETYPELIST (PDF . BINARY))
|
||||
|
||||
(RPAQQ DEFAULTPRINTERTYPE PDF)
|
||||
(DEFINEQ
|
||||
|
||||
(PDFFILEP
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Sep-2025 23:24 by rmk")
|
||||
(* ; "Edited 23-Jun-2023 14:43 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk")
|
||||
(* ; "Edited 5-Mar-93 21:40 by rmk:")
|
||||
(* ; "Edited 14-Jan-93 10:56 by jds")
|
||||
(OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION)
|
||||
'("PDF")
|
||||
:TEST
|
||||
(FUNCTION STRING-EQUAL))
|
||||
(RESETLST
|
||||
[LET (STRM)
|
||||
[if (SETQ STRM (\GETSTREAM FILE 'INPUT T))
|
||||
then [RESETSAVE NIL `(PROGN (SETFILEPTR ,STRM ,(GETFILEPTR STRM]
|
||||
(SETFILEPTR STRM 0)
|
||||
else (RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT))
|
||||
`(PROGN (CLOSEF? OLDVALUE]
|
||||
(AND (EQ (BIN STRM)
|
||||
(CHARCODE %%))
|
||||
(EQ (BIN STRM)
|
||||
(CHARCODE P))
|
||||
(EQ (BIN STRM)
|
||||
(CHARCODE D))
|
||||
(EQ (BIN STRM)
|
||||
(CHARCODE F])])
|
||||
(CL:WHEN (STREAMP FILE)
|
||||
(SETFILEPTR FILE 0)
|
||||
(PROG1 (AND (EQ (BIN FILE)
|
||||
(CHARCODE %%))
|
||||
(EQ (BIN FILE)
|
||||
(CHARCODE P))
|
||||
(EQ (BIN FILE)
|
||||
(CHARCODE D))
|
||||
(EQ (BIN FILE)
|
||||
(CHARCODE F)))
|
||||
(SETFILEPTR FILE 0)))])
|
||||
|
||||
(PDF.HARDCOPYW
|
||||
[LAMBDA (PDFFILE BITMAP SCALEFACTOR REGION Landscape? TITLE)
|
||||
(* ; "Edited 12-Jan-2026 23:35 by rmk")
|
||||
(* ; "Edited 11-Jan-2026 14:07 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 17:36 by rmk")
|
||||
(* ; "Edited 24-Jul-2023 10:37 by rmk")
|
||||
(* ; "Edited 23-Jun-2023 13:28 by rmk")
|
||||
(PS-TO-PDF (POSTSCRIPT.HARDCOPYW (OPENSTREAM (UNIX-TMP-FILE-NAME 'bitmap 'ps)
|
||||
'OUTPUT)
|
||||
BITMAP SCALEFACTOR REGION Landscape? TITLE)
|
||||
PDFFILE])
|
||||
(* ; "Edited 23-Jun-2023 13:28 by rmk")
|
||||
(* ; "Edited 6-Mar-2023 22:43 by rmk")
|
||||
(LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY PDFFILE)))
|
||||
(PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP BITMAP SCALEFACTOR REGION Landscape? TITLE)
|
||||
PDFFILE])
|
||||
|
||||
(PDF.TEXT
|
||||
[LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 1-Oct-2023 15:24 by rmk")
|
||||
(* ; "Edited 23-Jun-2023 13:23 by rmk")
|
||||
(* ; "Edited 7-Mar-2023 08:39 by rmk")
|
||||
(TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION
|
||||
ROTATION ,(NOT (NOT
|
||||
POSTSCRIPT.TEXTFILE.LANDSCAPE
|
||||
])
|
||||
|
||||
(PDF.TEDIT
|
||||
[LAMBDA (FILE IMAGESTREAM IMAGETYPE OPTIONS) (* ; "Edited 13-Jan-2026 15:47 by rmk")
|
||||
(* ; "Edited 26-Sep-2025 23:02 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 07:33 by rmk")
|
||||
|
||||
(* ;; "Make a scratch postscript stream, then convert it to a PDF that is stored in the caller's IMAGESTREAM (which may have been opened with some postscript preamble, which we discard)")
|
||||
|
||||
(PS-TO-PDF (TEDIT.TO.IMAGEFILE FILE (OPENSTREAM (UNIX-TMP-FILE-NAME 'tedit IMAGETYPE)
|
||||
'OUTPUT)
|
||||
'POSTSCRIPT OPTIONS)
|
||||
IMAGESTREAM])
|
||||
[LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk")
|
||||
(* ; "Edited 7-Mar-2023 08:39 by rmk")
|
||||
(LET ((TSTREAM (OPENTEXTSTREAM FILE)))
|
||||
(TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF)
|
||||
(CLOSEF TSTREAM])
|
||||
|
||||
(PDF.FONTSAVAILABLE
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 23-Aug-2025 10:53 by rmk")
|
||||
@@ -154,165 +162,137 @@
|
||||
(DEFINEQ
|
||||
|
||||
(OPEN-PDF-STREAM
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 14-Sep-2025 11:15 by rmk")
|
||||
(* ; "Edited 5-Jun-2025 08:41 by rmk")
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 5-Jun-2025 08:41 by rmk")
|
||||
(* ; "Edited 23-Feb-2025 12:18 by rmk")
|
||||
(* ; "Edited 23-Sep-2023 15:38 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 11:04 by rmk")
|
||||
(* ; "Edited 24-Jun-2023 14:49 by rmk")
|
||||
|
||||
(* ;; "Open FILE as a postscript file, but with IMAGETYPE=PDF and a closefn that calls PS-TO-PDF after the PS file closefn.")
|
||||
(* ;; "Open a temporary PS file, but set it up so that at closing it gets converted to PDF using an operating-system utility (if available), and then gets renamed to the original intended filename.")
|
||||
|
||||
(DECLARE (GLOBALVARS \PDFIMAGEOPS))
|
||||
(CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "Can't find a POSTSCRIPT-to-PDF converter"))
|
||||
(LET ((STRM (OPENPOSTSCRIPTSTREAM FILE OPTIONS)))
|
||||
(replace (STREAM IMAGEOPS) of STRM with \PDFIMAGEOPS)
|
||||
STRM])
|
||||
(* ;; "We have to stash the original filename someplace. We could put it in the tmp filename and then parse it out, but then we would have to worry about how unix filenames might parse against our {, }, etc. ")
|
||||
|
||||
(* ;;
|
||||
"Simplest thing for now is to just add an extra field at the end of the \POSTSCRIPTDATA record.")
|
||||
|
||||
(if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST]
|
||||
then
|
||||
(* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.")
|
||||
|
||||
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
|
||||
elseif (EQ 'NULL (FILENAMEFIELD (TRUEFILENAME FILE)
|
||||
'HOST))
|
||||
then
|
||||
(* ;; "Device NULL used by TMAX, maybe others, to get page number for table of contents, index. Nothing to convert")
|
||||
|
||||
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
|
||||
elseif (SETQ FILE (OR [AND (NEQ FILE T)
|
||||
(OR (OUTFILEP FILE)
|
||||
(OPENSTREAM FILE 'OUTPUT]
|
||||
(ERROR "PDF target file not found" FILE)))
|
||||
then (CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "Can't find a POSTSCRIPT-to-PDF converter"))
|
||||
(LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
|
||||
"-"
|
||||
(RAND)
|
||||
".ps")
|
||||
OPTIONS)))
|
||||
(STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
|
||||
(STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
|
||||
PSSTREAM])
|
||||
|
||||
(CLOSE-PDF-STREAM
|
||||
[LAMBDA (PSSTREAM) (* ; "Edited 17-Jan-2026 12:10 by rmk")
|
||||
(* ; "Edited 15-Jan-2026 10:16 by rmk")
|
||||
(* ; "Edited 13-Jan-2026 15:49 by rmk")
|
||||
(* ; "Edited 27-Sep-2025 14:02 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 14:16 by rmk")
|
||||
(* ; "Edited 14-Sep-2025 12:16 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 11:18 by rmk")
|
||||
[LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk")
|
||||
(* ; "Edited 24-Jul-2023 10:37 by rmk")
|
||||
(* ; "Edited 17-Jul-2023 22:32 by rmk")
|
||||
(* ; "Edited 24-Jun-2023 13:57 by rmk")
|
||||
(* ;
|
||||
"Don't run again for internal closing")
|
||||
(CL:WHEN (IMAGESTREAMTYPE PSSTREAM 'PDF) (* ;
|
||||
"If it's still a PDF stream, it hasn't been converted")
|
||||
(CLOSEPOSTSCRIPTSTREAM PSSTREAM)
|
||||
(replace (STREAM IMAGEOPS) of PSSTREAM with \NOIMAGEOPS)
|
||||
(* ;
|
||||
"Don't run again for internal closing")
|
||||
(CLOSEF? PSSTREAM) (* ; "PS-TO-PDF wants it closed?")
|
||||
(RESETLST
|
||||
(LET (PDFSTREAM) (* ;
|
||||
"PS-TO-PDF returns a /tmp file if not given a PDFFILE, we copy it into our stream")
|
||||
[RESETSAVE (SETQ PDFSTREAM (OPENSTREAM (PS-TO-PDF (FULLNAME PSSTREAM)
|
||||
(UNIX-TMP-FILE-NAME 'closepdf
|
||||
'pdf))
|
||||
'INPUT))
|
||||
`(PROGN (DELFILE (CLOSEF? OLDVALUE]
|
||||
[RESETSAVE (SETQ PSSTREAM (OPENSTREAM PSSTREAM 'OUTPUT))
|
||||
`(PROGN (CLOSEF? OLDVALUE]
|
||||
(SETFILEPTR PSSTREAM 0)
|
||||
(SETFILEINFO PSSTREAM 'LENGTH 0)
|
||||
(COPYBYTES PDFSTREAM PSSTREAM 0 -1))))])
|
||||
|
||||
(* ;; "PSSTREAM is a postscript (maybe in tmp) rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.")
|
||||
|
||||
(* ;; "But for a file we execute the PDFCONVERTER as a shell command to make a pdf, and then we rename it to the intended filename")
|
||||
|
||||
(STREAMPROP PSSTREAM 'AFTERCLOSE NIL) (* ;
|
||||
"Maybe just remove only CLOSE-PDF-STREAMfrom the list?")
|
||||
(LET ((TARGETINFO (STREAMPROP PSSTREAM 'PDFTARGETINFO NIL)))
|
||||
(CL:IF TARGETINFO
|
||||
(RENAMEFILE (PS-TO-PDF PSSTREAM)
|
||||
TARGETINFO)
|
||||
PSSTREAM)])
|
||||
|
||||
(PS-TO-PDF
|
||||
[LAMBDA (PSFILE PDFFILE MAKEERRORFILE) (* ; "Edited 14-Jan-2026 21:02 by rmk")
|
||||
(* ; "Edited 13-Jan-2026 15:44 by rmk")
|
||||
(* ; "Edited 27-Sep-2025 16:51 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 14:14 by rmk")
|
||||
(* ; "Edited 14-Sep-2025 09:44 by rmk")
|
||||
(* ; "Edited 1-Oct-2023 15:18 by rmk")
|
||||
[LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 1-Oct-2023 15:18 by rmk")
|
||||
(* ; "Edited 23-Sep-2023 22:54 by rmk")
|
||||
(* ; "Edited 23-Jul-2023 22:30 by rmk")
|
||||
(* ; "Edited 24-Jun-2023 15:01 by rmk")
|
||||
(* ; "Edited 16-Jul-2022 13:06 by rmk")
|
||||
(* ; "Edited 8-Jul-2022 10:20 by rmk")
|
||||
(* ; "Edited 7-May-2022 22:40 by rmk")
|
||||
(* ; "Edited 7-Oct-2021 11:15 by rmk:")
|
||||
|
||||
(* ;; "PSFILE is a postscript file or stream whose contents are to be converted to a PDF-formatted file PDFFILE by means of a Shell PDFCONVERTER utility.")
|
||||
(* ;; "PSFILE is the name of a closed PS file on a DSK/UNIX device. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to PDFFILE. ")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "PSFILE may be a Medley filename or a stream that is recognized as a PS formatted file. If its contents do not reside in the Unix file system, it will be copied to a /tmp/ file to be given to the Shell. The /tmp/ file may be deleted at the end.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "PDFFILE is NIL, a file name, or perhaps a stream to receive the pdf.")
|
||||
|
||||
(* ;; " If NIL, a name is made by attaching PDF to PSFILE; a stream without a name goes to a scratch stream.")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files")
|
||||
|
||||
(SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE)))
|
||||
(CL:UNLESS (INFILEP PSFILE)
|
||||
(ERROR "NO PS FILE TO CONVERT"))
|
||||
(CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "A POSTSCRIPT-to-PDF converter cannot be found for this system"))
|
||||
(CL:UNLESS (POSTSCRIPTFILEP PSFILE)
|
||||
(ERROR "NOT A POSTSCRIPT FILE" PSFILE))
|
||||
(SETQ PSFILE (TRUEFILENAME PSFILE))
|
||||
(SETQ PDFFILE (TRUEFILENAME PDFFILE))
|
||||
(RESETLST
|
||||
(LET* ((PSNAMEU (SLASHIT (CL:IF (EQ 'UNIX (FILENAMEFIELD PSFILE 'HOST))
|
||||
(FULLNAME PSFILE)
|
||||
(COPYFILE PSFILE (UNIX-TMP-FILE-NAME PSFILE 'ps)))
|
||||
NIL T))
|
||||
TMPPDFFILE
|
||||
[PDFNAMEU (CL:IF (EQ 'UNIX (FILENAMEFIELD PDFFILE 'HOST))
|
||||
(FULLNAME PDFFILE)
|
||||
(SETQ TMPPDFFILE (UNIX-TMP-FILE-NAME PDFFILE 'pdf)))]
|
||||
(ERRORFILE (CL:IF MAKEERRORFILE
|
||||
(UNIX-TMP-FILE-NAME (OR TMPPDFFILE PDFFILE)
|
||||
'error)
|
||||
"/dev/null"))
|
||||
COMPLETIONCODE)
|
||||
(ERROR "A specified POSTSCRIPT-to-PDF converter cannot be found"))
|
||||
(SETQ PDFFILE (if PDFFILE
|
||||
then (TRUEFILENAME PDFFILE)
|
||||
else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE)))
|
||||
(LET ((ERRORFILE (PACKFILENAME 'EXTENSION 'error 'BODY PSFILE))
|
||||
COMPLETIONCODE)
|
||||
|
||||
(* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.")
|
||||
(* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.")
|
||||
|
||||
[SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS `((PSFILE \, PSNAMEU)
|
||||
(PDFFILE \,
|
||||
(SLASHIT PDFNAMEU
|
||||
NIL T))
|
||||
(ERRORFILE \,
|
||||
(SLASHIT ERRORFILE
|
||||
NIL T)))
|
||||
(ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES
|
||||
]
|
||||
(* ;;
|
||||
"We have to map the filenames down to Unix conventions: (not pseudohost or host, slashes, etc.")
|
||||
|
||||
(* ;; "Now use Medley names")
|
||||
[SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS
|
||||
`((PSFILE \, (SLASHIT (TRUEFILENAME
|
||||
PSFILE)
|
||||
NIL T))
|
||||
(PDFFILE \, (SLASHIT (TRUEFILENAME
|
||||
PDFFILE)
|
||||
NIL T))
|
||||
(ERRORFILE \, (SLASHIT (TRUEFILENAME
|
||||
ERRORFILE)
|
||||
NIL T)))
|
||||
(ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES]
|
||||
|
||||
(CL:WHEN (IGREATERP COMPLETIONCODE 0)
|
||||
(CL:WHEN (AND MAKEERRORFILE (INFILEP ERRORFILE))
|
||||
(CLOSEF? ERRORFILE)
|
||||
(CL:WHEN (IGREATERP (GETFILEINFO ERRORFILE 'LENGTH)
|
||||
0)
|
||||
(PRINTOUT T "See error file at " '%" ERRORFILE '%" T)))
|
||||
(ERROR "Cannot create PDF file for " PSFILE))
|
||||
(if TMPPDFFILE
|
||||
then (* ; "Not on {UNIX}, could be {DSK}")
|
||||
(PROG1 (COPYFILE TMPPDFFILE PDFFILE)
|
||||
(DELFILE TMPPDFFILE))
|
||||
else (* ; "Originally on UNIX")
|
||||
(FULLNAME PDFFILE))))])
|
||||
)
|
||||
(DEFINEQ
|
||||
(* ;; "Now use Medley names")
|
||||
|
||||
(PDF.POSTSCRIPT
|
||||
[LAMBDA (PSFILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 18-Sep-2025 23:49 by rmk")
|
||||
|
||||
(* ;; "Can't pass OPTIONS, until the MAKEERROFILE flag goes away.")
|
||||
|
||||
(PS-TO-PDF PSFILE IMAGEFILE])
|
||||
(CLOSEF? PSFILE)
|
||||
(CL:UNLESS DONTDELETE (DELFILE PSFILE))
|
||||
(CLOSEF? ERRORFILE)
|
||||
(CL:WHEN (INFILEP ERRORFILE)
|
||||
(CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILE 'LENGTH)
|
||||
(CL:UNLESS DONTDELETE (DELFILE ERRORFILE)))
|
||||
0)
|
||||
(ERROR "Cannot create PDF file for " PDFFILE)))
|
||||
(CL:WHEN (IGREATERP COMPLETIONCODE 0)
|
||||
(ERROR "Cannot create PDF file for " PDFFILE))
|
||||
PDFFILE])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(SEE-PDF
|
||||
[LAMBDA (PDFFILE) (* ; "Edited 19-Jan-2026 14:06 by rmk")
|
||||
(* ; "Edited 24-Dec-2025 23:32 by rmk")
|
||||
(* ; "Edited 30-Jul-2025 18:00 by rmk")
|
||||
[LAMBDA (PDFFILE) (* ; "Edited 30-Jul-2025 18:00 by rmk")
|
||||
(* ; "Edited 25-Dec-2024 14:25 by rmk")
|
||||
(* ; "Edited 1-Oct-2023 20:47 by rmk")
|
||||
(* ; "Edited 26-Sep-2023 16:52 by rmk")
|
||||
|
||||
(* ;; "Use the ShellOpener for this machine to open the PDF file outside of Medley")
|
||||
|
||||
(LET (FOUND)
|
||||
[SETQ FOUND (if (AND (STREAMP PDFFILE)
|
||||
(PDFFILEP PDFFILE))
|
||||
then (UNIX-FILE-NAME PDFFILE 'INPUT 'pdf 'pdf)
|
||||
else (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF]
|
||||
(if (NOT FOUND)
|
||||
then (ERROR "FILE NOT FOUND" PDFFILE)
|
||||
elseif (PDFFILEP FOUND)
|
||||
(LET [(FOUND (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF]
|
||||
(if FOUND
|
||||
then (ShellOpen FOUND)
|
||||
else (ERROR FOUND "is not a PDF file"])
|
||||
FOUND
|
||||
else (ERROR "FILE NOT FOUND" PDFFILE])
|
||||
)
|
||||
|
||||
(ADDTOVAR FB.SEE.METHODS (PDFFILEP SEE-PDF))
|
||||
@@ -324,18 +304,9 @@
|
||||
(CAR (for TEMPLATE in PDF-CONVERTER-TEMPLATES
|
||||
thereis (ShellWhich (CAR TEMPLATE])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\PDFINIT
|
||||
[LAMBDA NIL (* ; "Edited 14-Sep-2025 01:15 by rmk")
|
||||
(SETQ \PDFIMAGEOPS (create IMAGEOPS using \POSTSCRIPTIMAGEOPS IMAGETYPE _ 'PDF IMCLOSEFN _
|
||||
(FUNCTION CLOSE-PDF-STREAM])
|
||||
)
|
||||
|
||||
(\PDFINIT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2498 5822 (PDFFILEP 2508 . 3785) (PDF.HARDCOPYW 3787 . 4639) (PDF.TEDIT 4641 . 5398) (
|
||||
PDF.FONTSAVAILABLE 5400 . 5820)) (6262 14970 (OPEN-PDF-STREAM 6272 . 7422) (CLOSE-PDF-STREAM 7424 .
|
||||
10136) (PS-TO-PDF 10138 . 14968)) (14971 15227 (PDF.POSTSCRIPT 14981 . 15225)) (15228 16499 (SEE-PDF
|
||||
15238 . 16497)) (16550 16834 (PDFCONVERTER 16560 . 16832)) (16835 17147 (\PDFINIT 16845 . 17145)))))
|
||||
(FILEMAP (NIL (3421 6457 (PDFFILEP 3431 . 4345) (PDF.HARDCOPYW 4347 . 4945) (PDF.TEXT 4947 . 5664) (
|
||||
PDF.TEDIT 5666 . 6033) (PDF.FONTSAVAILABLE 6035 . 6455)) (6897 14542 (OPEN-PDF-STREAM 6907 . 9628) (
|
||||
CLOSE-PDF-STREAM 9630 . 10917) (PS-TO-PDF 10919 . 14540)) (14543 15301 (SEE-PDF 14553 . 15299)) (15352
|
||||
15636 (PDFCONVERTER 15362 . 15634)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(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 "13-Oct-2025 18:05:08" {WMEDLEY}<library>POSTSCRIPTSTREAM.;55 260304
|
||||
|
||||
:EDIT-BY "mth"
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS POSTSCRIPT.STARTPAGE)
|
||||
:CHANGES-TO (FNS POSTSCRIPT.FONTCREATE)
|
||||
|
||||
:PREVIOUS-DATE "27-Jan-2026 13:15:17"
|
||||
{DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;3)
|
||||
:PREVIOUS-DATE " 9-Oct-2025 21:16:27" {WMEDLEY}<library>POSTSCRIPTSTREAM.;53)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
|
||||
@@ -46,7 +45,7 @@
|
||||
POSTSCRIPT.FONTSAVAILABLE POSTSCRIPT.FONTEXISTS?)
|
||||
(FNS OPENPOSTSCRIPTSTREAM CLOSEPOSTSCRIPTSTREAM)
|
||||
(INITVARS (*POSTSCRIPT-FILE-TYPE* 'BINARY))
|
||||
(FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPTFILEP MAKEEPSFILE)
|
||||
(FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPT.TEXT POSTSCRIPTFILEP MAKEEPSFILE)
|
||||
(FNS POSTSCRIPT.BITMAPSCALE POSTSCRIPT.CLOSESTRING POSTSCRIPT.ENDPAGE POSTSCRIPT.OUTSTR
|
||||
POSTSCRIPT.PUTBITMAPBYTES POSTSCRIPT.PUTCOMMAND POSTSCRIPT.SET-FAKE-LANDSCAPE
|
||||
POSTSCRIPT.SHOWACCUM POSTSCRIPT.STARTPAGE \POSTSCRIPTTAB \PS.BOUTFIXP \PS.SCALEHACK
|
||||
@@ -155,9 +154,17 @@
|
||||
(OPTIMA (PALATINO 1))
|
||||
(TITAN (COURIER 1))
|
||||
(* (* 1]
|
||||
(POSTSCRIPTCHARCOERCIONS NIL)
|
||||
(\POSTSCRIPT.MAX.WILD.FONTSIZE 72))
|
||||
(ADDVARS (POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA)
|
||||
[COMS (FNS POSTSCRIPTSEND)
|
||||
(ADDVARS (PRINTERTYPES ((POSTSCRIPT)
|
||||
(CANPRINT (POSTSCRIPT))
|
||||
(STATUS TRUE)
|
||||
(PROPERTIES NILL)
|
||||
(SEND POSTSCRIPTSEND)
|
||||
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
|
||||
(BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR
|
||||
REGION ROTATION TITLE]
|
||||
[ADDVARS (POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA)
|
||||
(HELVETICAD . HELVETICA)
|
||||
(TIMESROMAN . TIMES)
|
||||
(TIMESROMAND . TIMES)
|
||||
@@ -169,9 +176,15 @@
|
||||
(TERMINAL . COURIER)
|
||||
(LOGO . HELVETICA)
|
||||
(OPTIMA . PALATINO)
|
||||
(TITAN . COURIER)))
|
||||
(ALISTS (PRINTFILETYPES POSTSCRIPT)
|
||||
(IMAGESTREAMTYPES POSTSCRIPT))
|
||||
(TITAN . COURIER))
|
||||
[PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP)
|
||||
(EXTENSION (PS PSC PSF))
|
||||
(CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT TEDIT.TO.IMAGEFILE]
|
||||
(IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM)
|
||||
(FONTCREATE POSTSCRIPT.FONTCREATE)
|
||||
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
|
||||
(CREATECHARSET \CREATECHARSET.PSC)
|
||||
(FONTEXISTS? POSTSCRIPT.FONTEXISTS?]
|
||||
(INITVARS (POSTSCRIPT.PAGETYPE 'LETTER))
|
||||
|
||||
(* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk")
|
||||
@@ -376,8 +389,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(POSTSCRIPT.INIT
|
||||
[LAMBDA NIL (* ; "Edited 31-Dec-2025 22:38 by rmk")
|
||||
(* ; "Edited 9-Sep-2025 21:57 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 9-Sep-2025 21:57 by rmk")
|
||||
(* ; "Edited 22-Aug-2025 21:34 by rmk")
|
||||
(* ; "Edited 14-May-2018 10:48 by rmk:")
|
||||
(* ; "Edited 4-Feb-93 21:08 by jds")
|
||||
@@ -424,7 +436,7 @@
|
||||
|
||||
(* ;; "Eliminate any existing postscript fonts, to start with a clean slate if reinitializing.")
|
||||
|
||||
(FLUSHFONTCACHE NIL '* '* '* '* 'POSTSCRIPT)
|
||||
(FLUSHFONTSINCORE '* '* '* '* 'POSTSCRIPT)
|
||||
(SETQ POSTSCRIPTFONTCACHE NIL)
|
||||
(SETQ \POSTSCRIPT.CHARTYPE (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT T))
|
||||
|
||||
@@ -1115,14 +1127,13 @@
|
||||
NEWWIDTHS)])
|
||||
|
||||
(POSTSCRIPT.FONTSAVAILABLE
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 17-Dec-2025 20:55 by rmk")
|
||||
(* ; "Edited 25-Aug-2025 13:09 by rmk")
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 25-Aug-2025 13:09 by rmk")
|
||||
(* ; "Edited 23-Aug-2025 08:19 by rmk")
|
||||
|
||||
(* ;; "Postscript only has font files of size 1, and only files for %"raw%" postscript families that Medley font families are mapped to by POSTSCRIPTFONTCOERCIONS. Therefore the search doesn't care about the given family, just looks at the corresponding raw files that exist in the directory. ")
|
||||
|
||||
(LET [(SIZE (fetch (FONTSPEC FSSIZE) of FONTSPEC))
|
||||
(FONTSAVAILABLE (\SEARCHFONTFILES (COERCEFONTSPEC FONTSPEC]
|
||||
(FONTSAVAILABLE (\SEARCHFONTFILES (CAR (COERCEFONTSPEC FONTSPEC]
|
||||
|
||||
(* ;; "Switch from postscript family names back to the corresponding Medley names.")
|
||||
|
||||
@@ -1175,8 +1186,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(OPENPOSTSCRIPTSTREAM
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 19-Jan-2026 17:04 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 16:02 by rmk")
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 19-Sep-2025 16:02 by rmk")
|
||||
(* ; "Edited 14-Sep-2025 12:50 by rmk")
|
||||
(* ; "Edited 12-Jun-2021 19:14 by rmk:")
|
||||
(* ;
|
||||
@@ -1268,8 +1278,7 @@
|
||||
|
||||
(* ;; "If a REGION parameter was supplied, it establishes the initial margins.")
|
||||
|
||||
(SETQ REG (OR (AND (SETQ REG (OR (LISTGET OPTIONS 'REGION)
|
||||
POSTSCRIPT.DEFAULT.PAGEREGION))
|
||||
(SETQ REG (OR (AND (SETQ REG (LISTGET OPTIONS 'REGION))
|
||||
(INTERSECTREGIONS REG CLIP))
|
||||
(CREATEREGION 3600 3600 54000 72000)))
|
||||
(replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with (fetch (REGION LEFT)
|
||||
@@ -1390,6 +1399,14 @@
|
||||
|
||||
(TEDIT.TO.IMAGESTREAM FILE IMAGESTREAM])
|
||||
|
||||
(POSTSCRIPT.TEXT
|
||||
[LAMBDA (FILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 17-Sep-2025 23:21 by rmk")
|
||||
(* ; "Edited 23-Apr-89 11:31 by TAL")
|
||||
(TEXTTOIMAGEFILE FILE IMAGEFILE IMAGETYPE `(,@OPTIONS REGION ,POSTSCRIPT.DEFAULT.PAGEREGION
|
||||
ROTATION ,(NOT (NOT
|
||||
POSTSCRIPT.TEXTFILE.LANDSCAPE
|
||||
])
|
||||
|
||||
(POSTSCRIPTFILEP
|
||||
[LAMBDA (FILE) (* ; "Edited 9-Oct-2025 21:16 by rmk")
|
||||
(* ; "Edited 18-Sep-2025 09:35 by rmk")
|
||||
@@ -1415,8 +1432,7 @@
|
||||
(CHARCODE !])])
|
||||
|
||||
(MAKEEPSFILE
|
||||
[LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 7-Dec-2025 16:37 by rmk")
|
||||
(* ; "Edited 16-Sep-2025 00:29 by rmk")
|
||||
[LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 16-Sep-2025 00:29 by rmk")
|
||||
(* ; "Edited 7-Apr-94 14:48 by rmk:")
|
||||
|
||||
(* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file. The lower-left corner of the image box will be at 0,0 on the page.")
|
||||
@@ -1425,7 +1441,7 @@
|
||||
|
||||
(LET ([IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN)
|
||||
IMAGEOBJ
|
||||
(OPENIMAGESTREAM NIL 'POSTSCRIPT]
|
||||
(OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT]
|
||||
STREAM)
|
||||
[SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT
|
||||
`(BOUNDINGBOX (0 0 ,(FETCH XSIZE OF IMAGEBOX)
|
||||
@@ -1800,8 +1816,7 @@
|
||||
(freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL])
|
||||
|
||||
(POSTSCRIPT.STARTPAGE
|
||||
[LAMBDA (STREAM) (* ; "Edited 27-Jan-2026 17:54 by mth")
|
||||
(* ; "Edited 12-Jun-2021 14:52 by rmk:")
|
||||
[LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 14:52 by rmk:")
|
||||
|
||||
(* ;; "Start up a new page in a Postscript document.")
|
||||
|
||||
@@ -1832,11 +1847,11 @@
|
||||
(LET [(FONT (\DSPFONT.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT)
|
||||
of IMAGEDATA]
|
||||
(\DSPRESET.PSC STREAM)
|
||||
(for CH instring (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA)
|
||||
do (\POSTSCRIPT.OUTCHARFN STREAM CH))
|
||||
(POSTSCRIPT.OUTSTR STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA))
|
||||
(RELMOVETO (CONSTANT (TIMES 72 \PS.SCALE0))
|
||||
0 STREAM) (* ; "Skip an inch before page number")
|
||||
(for CH instring (CONCAT "Page " NEW-PAGE) do (\POSTSCRIPT.OUTCHARFN STREAM CH))
|
||||
(POSTSCRIPT.OUTSTR STREAM "Page ")
|
||||
(POSTSCRIPT.OUTSTR STREAM NEW-PAGE)
|
||||
(\TERPRI.PSC STREAM) (* ; "Skip 2 lines")
|
||||
(\TERPRI.PSC STREAM)
|
||||
(\DSPFONT.PSC STREAM FONT)))
|
||||
@@ -4320,9 +4335,28 @@
|
||||
(TITAN (COURIER 1))
|
||||
(* (* 1))))
|
||||
|
||||
(RPAQ? POSTSCRIPTCHARCOERCIONS NIL)
|
||||
|
||||
(RPAQ? \POSTSCRIPT.MAX.WILD.FONTSIZE 72)
|
||||
(DEFINEQ
|
||||
|
||||
(POSTSCRIPTSEND
|
||||
[LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 20-Nov-95 11:29 by ")
|
||||
(* ; "Edited 20-Nov-95 11:26 by ")
|
||||
|
||||
(* ;; "This is the send function for generic POSTSCRIPT printers. It branches on the architecture-specific function. The theory is that the send method is really a property of the operating system, not a property of specific postscript printers. These functions are contained in separate library files (or defined by user).")
|
||||
|
||||
(SELECTQ (MKATOM (UNIX-GETPARM "ARCH"))
|
||||
(dos (DOSPRINT HOST FILE PRINTOPTIONS))
|
||||
(UnixPrint HOST FILE PRINTOPTIONS])
|
||||
)
|
||||
|
||||
(ADDTOVAR PRINTERTYPES ((POSTSCRIPT)
|
||||
(CANPRINT (POSTSCRIPT))
|
||||
(STATUS TRUE)
|
||||
(PROPERTIES NILL)
|
||||
(SEND POSTSCRIPTSEND)
|
||||
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
|
||||
(BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION
|
||||
TITLE))))
|
||||
|
||||
(ADDTOVAR POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA)
|
||||
(HELVETICAD . HELVETICA)
|
||||
@@ -4339,10 +4373,8 @@
|
||||
(TITAN . COURIER))
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP)
|
||||
(EXTENSION (PS PSC PSF POSTSCRIPT))
|
||||
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
|
||||
(BITMAPFILE (POSTSCRIPT.HARDCOPYW IMAGEFILE BITMAP SCALEFACTOR REGION
|
||||
ROTATION TITLE))))
|
||||
(EXTENSION (PS PSC PSF))
|
||||
(CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT TEDIT.TO.IMAGEFILE))))
|
||||
|
||||
(ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM)
|
||||
(FONTCREATE POSTSCRIPT.FONTCREATE)
|
||||
@@ -4392,37 +4424,39 @@
|
||||
(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 (23388 33596 (POSTSCRIPT.INIT 23398 . 30202) (POSTSCRIPT.PUTRGBCOLOR 30204 . 31226) (
|
||||
\PSC.COLOR.TO.RGB 31228 . 33594)) (34582 69900 (PSCFONT.READFONT 34592 . 36500) (PSCFONT.SPELLFILE
|
||||
36502 . 37315) (PSCFONT.COERCEFILE 37317 . 38889) (PSCFONTFROMCACHE.SPELLFILE 38891 . 39876) (
|
||||
PSCFONTFROMCACHE.COERCEFILE 39878 . 41530) (PSCFONT.WRITEFONT 41532 . 42547) (READ-AFM-FILE 42549 .
|
||||
48420) (CONVERT-AFM-FILES 48422 . 49634) (POSTSCRIPT.GETFONTID 49636 . 51031) (POSTSCRIPT.FONTCREATE
|
||||
51033 . 63927) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63929 . 66326) (POSTSCRIPT.FONTSAVAILABLE 66328
|
||||
. 68511) (POSTSCRIPT.FONTEXISTS? 68513 . 69898)) (69901 79624 (OPENPOSTSCRIPTSTREAM 69911 . 79290) (
|
||||
CLOSEPOSTSCRIPTSTREAM 79292 . 79622)) (79669 86491 (POSTSCRIPT.HARDCOPYW 79679 . 82786) (
|
||||
POSTSCRIPT.TEDIT 82788 . 83240) (POSTSCRIPT.TEXT 83242 . 83829) (POSTSCRIPTFILEP 83831 . 85319) (
|
||||
MAKEEPSFILE 85321 . 86489)) (86492 130066 (POSTSCRIPT.BITMAPSCALE 86502 . 88958) (
|
||||
POSTSCRIPT.CLOSESTRING 88960 . 89513) (POSTSCRIPT.ENDPAGE 89515 . 90406) (POSTSCRIPT.OUTSTR 90408 .
|
||||
91625) (POSTSCRIPT.PUTBITMAPBYTES 91627 . 100098) (POSTSCRIPT.PUTCOMMAND 100100 . 101089) (
|
||||
POSTSCRIPT.SET-FAKE-LANDSCAPE 101091 . 105611) (POSTSCRIPT.SHOWACCUM 105613 . 107768) (
|
||||
POSTSCRIPT.STARTPAGE 107770 . 110302) (\POSTSCRIPTTAB 110304 . 111101) (\PS.BOUTFIXP 111103 . 112383)
|
||||
(\PS.SCALEHACK 112385 . 115028) (\PS.SCALEREGION 115030 . 115590) (\SCALEDBITBLT.PSC 115592 . 119902)
|
||||
(\SETPOS.PSC 119904 . 120385) (\SETXFORM.PSC 120387 . 122971) (\STRINGWIDTH.PSC 122973 . 123446) (
|
||||
\SWITCHFONTS.PSC 123448 . 128940) (\TERPRI.PSC 128942 . 130064)) (130101 183957 (\BITBLT.PSC 130111 .
|
||||
130663) (\BLTSHADE.PSC 130665 . 135326) (\CHARWIDTH.PSC 135328 . 135835) (\CREATECHARSET.PSC 135837 .
|
||||
137193) (\DRAWARC.PSC 137195 . 139573) (\DRAWCIRCLE.PSC 139575 . 141826) (\DRAWCURVE.PSC 141828 .
|
||||
145672) (\DRAWELLIPSE.PSC 145674 . 148038) (\DRAWLINE.PSC 148040 . 150780) (\DRAWPOINT.PSC 150782 .
|
||||
151358) (\DRAWPOLYGON.PSC 151360 . 154489) (\DSPBOTTOMMARGIN.PSC 154491 . 155178) (
|
||||
\DSPCLIPPINGREGION.PSC 155180 . 156555) (\DSPCOLOR.PSC 156557 . 157488) (\DSPFONT.PSC 157490 . 161127)
|
||||
(\DSPLEFTMARGIN.PSC 161129 . 161815) (\DSPLINEFEED.PSC 161817 . 162407) (\DSPPUSHSTATE.PSC 162409 .
|
||||
163869) (\DSPPOPSTATE.PSC 163871 . 167356) (\DSPRESET.PSC 167358 . 168023) (\DSPRIGHTMARGIN.PSC 168025
|
||||
. 168714) (\DSPROTATE.PSC 168716 . 169715) (\DSPSCALE.PSC 169717 . 170669) (\DSPSCALE2.PSC 170671 .
|
||||
171511) (\DSPSPACEFACTOR.PSC 171513 . 172434) (\DSPTOPMARGIN.PSC 172436 . 173007) (\DSPTRANSLATE.PSC
|
||||
173009 . 175040) (\DSPXPOSITION.PSC 175042 . 175606) (\DSPYPOSITION.PSC 175608 . 176199) (
|
||||
\FILLCIRCLE.PSC 176201 . 178426) (\FILLPOLYGON.PSC 178428 . 181665) (\FIXLINELENGTH.PSC 181667 .
|
||||
182986) (\MOVETO.PSC 182988 . 183758) (\NEWPAGE.PSC 183760 . 183955)) (184013 206159 (
|
||||
\POSTSCRIPT.CHANGECHARSET 184023 . 184741) (\POSTSCRIPT.OUTCHARFN 184743 . 197013) (
|
||||
\POSTSCRIPT.PRINTSLUG 197015 . 198739) (\POSTSCRIPT.SPECIALOUTCHARFN 198741 . 201092) (\UPDATE.PSC
|
||||
201094 . 202340) (\POSTSCRIPT.ACCENTFN 202342 . 203284) (\POSTSCRIPT.ACCENTPAIR 203286 . 206157)) (
|
||||
206257 207902 (\PSC.SPACEDISP 206267 . 206546) (\PSC.SPACEWID 206548 . 207167) (\PSC.SYMBOLS 207169 .
|
||||
207900)) (208011 211002 (\POSTSCRIPT.NSHASH 208021 . 211000)) (256412 257118 (POSTSCRIPTSEND 256422 .
|
||||
257116)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,26 +1,33 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-Jan-2026 11:09:09" {WMEDLEY}<library>UNIXPRINT.;15 11553
|
||||
(FILECREATED "20-Jan-2023 22:44:05" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;4 13651
|
||||
|
||||
:EDIT-BY rmk
|
||||
:CHANGES-TO (VARS UNIXPRINTCOMS)
|
||||
|
||||
:CHANGES-TO (FNS UnixPrint)
|
||||
:PREVIOUS-DATE "18-Jan-2023 13:28:36" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;3
|
||||
)
|
||||
|
||||
:PREVIOUS-DATE "18-Jan-2026 08:44:40" {WMEDLEY}<library>UNIXPRINT.;14)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT UNIXPRINTCOMS)
|
||||
|
||||
(RPAQQ UNIXPRINTCOMS
|
||||
[(FILES UNIXUTILS)
|
||||
(FNS UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
|
||||
(ALISTS (PRINTERTYPES (UNIX)))
|
||||
(FNS InstallUnixPrinter UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
|
||||
(INITVARS (UnixPrinterName NIL)
|
||||
(UNIXPRINTSWITCHES " -r -s "))
|
||||
(P (PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW))
|
||||
(P
|
||||
(* ;;
|
||||
"(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform")
|
||||
|
||||
(PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW))
|
||||
(PROP FILETYPE UNIXPRINT)
|
||||
(GLOBALVARS UnixPrinterName)
|
||||
(DECLARE%: EVAL@COMPILE (FILES UNIXCOMM))
|
||||
(DECLARE%: DONTEVAL@COMPILE DOCOPY (FNS UnixPrintCommand))
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY (FILES UNIXCOMM))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS UnixPrinterName))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
@@ -28,33 +35,39 @@
|
||||
(FILESLOAD UNIXUTILS)
|
||||
(DEFINEQ
|
||||
|
||||
(InstallUnixPrinter
|
||||
[LAMBDA (PrinterTypes) (* ; "Edited 8-Feb-97 11:33 by rmk:")
|
||||
|
||||
(* ;; "Set up any printers in PrinterTypes (or just Postscript by default) so that they'll be printed using the unix LPR command.")
|
||||
|
||||
(DECLARE (GLOBALVARS PRINTERTYPES))
|
||||
(for type inside (OR PrinterTypes '(POSTSCRIPT))
|
||||
do (for x in PRINTERTYPES when (EQMEMB type (CAR x))
|
||||
do (LET ((PRINTERTYPE type))
|
||||
(PUTASSOC 'SEND (LIST 'UnixPrint)
|
||||
(CDR x])
|
||||
|
||||
(UnixPrint
|
||||
[LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 25-Jan-2026 11:08 by rmk")
|
||||
(* ; "Edited 17-Jan-2026 15:47 by rmk")
|
||||
(* ; "Edited 5-Dec-2025 11:46 by rmk")
|
||||
(* ; "Edited 13-Sep-2025 20:28 by rmk")
|
||||
(* ; "Edited 11-Sep-2025 20:48 by rmk")
|
||||
(* ; "Edited 7-Dec-2001 14:55 by rmk:")
|
||||
[LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 7-Dec-2001 14:55 by rmk:")
|
||||
(* ; "Edited 20-May-92 14:13 by nilsson")
|
||||
|
||||
(* ;; "Given a print FILE, use the Unix %"lpr%" command to spool it to a printer.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "The printer is named by HOST or UnixPrinterName, a Global variable.")
|
||||
|
||||
[LET*
|
||||
((PRINTER (SELECTQ HOST
|
||||
((NIL UNIX)
|
||||
UnixPrinterName)
|
||||
HOST))
|
||||
((PRINTER (OR HOST UnixPrinterName))
|
||||
(COPIES (LISTGET PRINTOPTIONS '%#COPIES))
|
||||
(NAME (LISTGET PRINTOPTIONS 'DOCUMENT.NAME))
|
||||
(NSIDES (LISTGET PRINTOPTIONS '%#SIDES))
|
||||
(TYPE (PRINTERTYPE PRINTER)))
|
||||
|
||||
(* ;; "Removed redundant check (we already know it's a PS printer), JDS 2/19/92:")
|
||||
|
||||
(* ;; "(COND ((NULL TYPE) (ERROR (CONCAT %"Printertype unknown for %" PRINTER))) ((NOT (EQL (U-CASE TYPE) 'POSTSCRIPT)) (ERROR (CONCAT %"Printertype for %" PRINTER %" is not Postscript%"))))")
|
||||
|
||||
[COND
|
||||
((OR (NULL NAME)
|
||||
(EQ NAME 'LPT)
|
||||
(STRPOS "{LPT}" NAME 1 NIL T))
|
||||
(SETQ NAME "Medley Output"))
|
||||
((EQ (CHCON1 NAME)
|
||||
@@ -75,63 +88,63 @@
|
||||
|
||||
(* ;; "The temp file's name will be of the form medleyprint.<idate>, so all such files can be found for deletion on a subsequent call after a certain amount of time (2 minutes) has gone by. If we delete immediately, it may happen before lpr has done its thing. ")
|
||||
|
||||
(CL:MULTIPLE-VALUE-BIND
|
||||
(tmpstream tmpname)
|
||||
(UnixTempFile 'medleyprint.)
|
||||
(COND
|
||||
(tmpstream
|
||||
(CL:MULTIPLE-VALUE-BIND (tmpstream tmpname)
|
||||
(UnixTempFile 'medleyprint.)
|
||||
(COND
|
||||
(tmpstream
|
||||
|
||||
(* ;; "First, copy the lisp file to /tmp so lpr can find it.")
|
||||
(* ;; "First, copy the lisp file to /tmp so lpr can find it.")
|
||||
|
||||
[CL:WITH-OPEN-STREAM
|
||||
(out tmpstream)
|
||||
(CL:WITH-OPEN-STREAM
|
||||
(in (OPENSTREAM FILE 'INPUT))
|
||||
(printout PROMPTWINDOW .TAB0 0 "Sending output to Unix printer " (OR PRINTER "")
|
||||
" ")
|
||||
(IF NSIDES
|
||||
THEN
|
||||
(* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")
|
||||
[CL:WITH-OPEN-STREAM
|
||||
(out tmpstream)
|
||||
(CL:WITH-OPEN-STREAM
|
||||
(in (OPENSTREAM FILE 'INPUT))
|
||||
(printout PROMPTWINDOW .TAB0 0 "Spooling output to Unix printer"
|
||||
(COND
|
||||
(PRINTER (CONCAT " '" PRINTER "'"))
|
||||
(T ""))
|
||||
"...")
|
||||
(IF NSIDES
|
||||
THEN
|
||||
(* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")
|
||||
|
||||
(BIND C SAWCR
|
||||
DO (SETQ C (BIN in))
|
||||
(IF (MEMB C (CHARCODE (CR LF)))
|
||||
THEN (BOUT out C)
|
||||
(SETQ SAWCR T)
|
||||
ELSEIF SAWCR
|
||||
THEN
|
||||
(* ;; "First char of 2nd line: nonCR/LF after CR/LF")
|
||||
(BIND C SAWCR
|
||||
DO (SETQ C (BIN in))
|
||||
(IF (MEMB C (CHARCODE (CR LF)))
|
||||
THEN (BOUT out C)
|
||||
(SETQ SAWCR T)
|
||||
ELSEIF SAWCR
|
||||
THEN
|
||||
(* ;; "First char of 2nd line: nonCR/LF after CR/LF")
|
||||
|
||||
(* ;; "Put out simplex header, then print character in C")
|
||||
(* ;; "Put out simplex header, then print character in C")
|
||||
|
||||
(PRINTOUT out "%%BeginSetup" T)
|
||||
(PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T
|
||||
"<< /Duplex " (CL:IF (EQ NSIDES 1)
|
||||
"false"
|
||||
"true")
|
||||
" /Tumble false >> setpagedevice" T "%%%%EndFeature"
|
||||
T "} stopped cleartomark" T)
|
||||
(PRINTOUT out "%%EndSetup" T)
|
||||
(BOUT out C)
|
||||
(COPYCHARS in out (GETFILEPTR in)
|
||||
-1)
|
||||
(RETURN)
|
||||
ELSE (BOUT out C)))
|
||||
ELSE (COPYCHARS in out 0 -1]
|
||||
(PRINTOUT out "%%BeginSetup" T)
|
||||
(PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T
|
||||
"<< /Duplex " (CL:IF (EQ NSIDES 1)
|
||||
"false"
|
||||
"true")
|
||||
" /Tumble false >> setpagedevice" T
|
||||
"%%%%EndFeature" T "} stopped cleartomark" T)
|
||||
(PRINTOUT out "%%EndSetup" T)
|
||||
(BOUT out C)
|
||||
(COPYCHARS in out (GETFILEPTR in)
|
||||
-1)
|
||||
(RETURN)
|
||||
ELSE (BOUT out C)))
|
||||
ELSE (COPYCHARS in out 0 -1]
|
||||
|
||||
(* ;; "Now make Unix print the /tmp file.")
|
||||
(* ;; "Now make Unix print the /tmp file.")
|
||||
|
||||
(ShellCommand (UnixPrintCommand PRINTER COPIES NAME tmpname)
|
||||
PROMPTWINDOW)
|
||||
(CL:WHEN NIL (* ; "This should be conditioned an error code--don't want to say %"done%" if it didn't happen. If we put this back, then put in ... in the Sending printout above")
|
||||
(printout PROMPTWINDOW "done" T)))
|
||||
(T (ERROR "Couldn't create unix temp file"]
|
||||
(ShellCommand (UnixPrintCommand PRINTER COPIES NAME tmpname)
|
||||
PROMPTWINDOW)
|
||||
(printout PROMPTWINDOW "done" T))
|
||||
(T (ERROR "Couldn't create unix temp file"))))]
|
||||
T])
|
||||
|
||||
(UnixShellQuote
|
||||
[LAMBDA (STRING)
|
||||
(DECLARE (LOCALVARS . T)) (* ; "Edited 18-Jan-2026 08:34 by rmk")
|
||||
(* ; "Edited 19-Apr-89 21:14 by TAL")
|
||||
(DECLARE (LOCALVARS . T)) (* ; "Edited 19-Apr-89 21:14 by TAL")
|
||||
(LET* ((X (CHCON STRING))
|
||||
(CT X)
|
||||
C FLG)
|
||||
@@ -155,9 +168,9 @@
|
||||
(CHARCODE SPACE))
|
||||
(T C))
|
||||
(SETQ CT (CDR CT]
|
||||
(MTOUTF8STRING (COND
|
||||
(FLG (CONCATCODES X))
|
||||
(T STRING])
|
||||
(COND
|
||||
(FLG (CONCATCODES X))
|
||||
(T STRING])
|
||||
|
||||
(UnixTempFile
|
||||
[LAMBDA (Prefix DontOpen) (* ; "Edited 28-Apr-93 13:49 by rmk:")
|
||||
@@ -221,26 +234,66 @@
|
||||
" " TMPNAME])
|
||||
)
|
||||
|
||||
(ADDTOVAR PRINTERTYPES ((UNIX)
|
||||
(CANPRINT (PDF))
|
||||
(STATUS TRUE)
|
||||
(PROPERTIES NILL)
|
||||
(SEND UnixPrint)))
|
||||
|
||||
(RPAQ? UnixPrinterName NIL)
|
||||
|
||||
(RPAQ? UNIXPRINTSWITCHES " -r -s ")
|
||||
|
||||
|
||||
(* ;; "(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform")
|
||||
|
||||
|
||||
(PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW)
|
||||
|
||||
(PUTPROPS UNIXPRINT FILETYPE :COMPILE-FILE)
|
||||
(DECLARE%: DONTEVAL@COMPILE DOCOPY
|
||||
(DEFINEQ
|
||||
|
||||
(UnixPrintCommand
|
||||
[LAMBDA (PRINTER COPIES NAME TMPNAME) (* ; "Edited 4-May-2018 17:17 by rmk:")
|
||||
(* ; "Edited 20-May-92 14:26 by nilsson")
|
||||
|
||||
(* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr tmpname%". The arguments to this function are:")
|
||||
|
||||
(* ;; " PRINTER - the name of the printer. Usually something like lw or plw.")
|
||||
|
||||
(* ;; "COPIES - how many copies of this job to be printed.")
|
||||
|
||||
(* ;; "NAME - the name of this job. This gets printed on the banner of your job.")
|
||||
|
||||
(* ;; "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")
|
||||
|
||||
(* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")
|
||||
|
||||
(* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")
|
||||
|
||||
(* ;; "Use raw lpr, let system decide where it is located.")
|
||||
|
||||
(CONCAT "lpr " (COND
|
||||
((AND PRINTER (NEQ 0 (NCHARS PRINTER)))
|
||||
(CONCAT "-P" (UnixShellQuote PRINTER)
|
||||
" "))
|
||||
(T ""))
|
||||
(COND
|
||||
((AND (FIXP COPIES)
|
||||
(NEQ COPIES 1))
|
||||
(CONCAT "-#" COPIES " "))
|
||||
(T ""))
|
||||
" -J"
|
||||
(UnixShellQuote NAME)
|
||||
" "
|
||||
(OR UNIXPRINTSWITCHES "")
|
||||
" " TMPNAME])
|
||||
)
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY
|
||||
|
||||
(FILESLOAD UNIXCOMM)
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS UnixPrinterName)
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(FILESLOAD UNIXCOMM)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
@@ -250,7 +303,9 @@
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS UNIXPRINT COPYRIGHT ("Venue" 1990 1991 1992 1993 1995 1997 1999 2001 2018 2023))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1046 10887 (UnixPrint 1056 . 6392) (UnixShellQuote 6394 . 7977) (UnixTempFile 7979 .
|
||||
9202) (UnixPrintCommand 9204 . 10885)))))
|
||||
(FILEMAP (NIL (1389 11216 (InstallUnixPrinter 1399 . 1991) (UnixPrint 1993 . 6875) (UnixShellQuote
|
||||
6877 . 8306) (UnixTempFile 8308 . 9531) (UnixPrintCommand 9533 . 11214)) (11550 13243 (
|
||||
UnixPrintCommand 11560 . 13241)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jan-2026 14:09:03" {WMEDLEY}<library>UNIXUTILS.;55 20711
|
||||
(FILECREATED "26-Nov-2025 14:21:13" {WMEDLEY}<library>UNIXUTILS.;35 18084
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS UNIX-FILE-NAME)
|
||||
:CHANGES-TO (VARS UNIXUTILSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "17-Jan-2026 23:16:17" {WMEDLEY}<library>UNIXUTILS.;54)
|
||||
:PREVIOUS-DATE " 4-Nov-2025 10:11:10" {WMEDLEY}<library>UNIXUTILS.;34)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
||||
@@ -21,8 +21,7 @@
|
||||
(FUNCTIONS ShellCommand ShellWhich)
|
||||
(ADDVARS (MEDLEY-INIT-VARS (ShellBrowser NIL RESET)
|
||||
(ShellOpener NIL RESET)))
|
||||
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME
|
||||
UNIX-TMP-FILE-NAME)
|
||||
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME)
|
||||
(PROPS (UNIXUTILS FILETYPE))))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -148,8 +147,7 @@
|
||||
"true"])
|
||||
|
||||
(ShellOpen
|
||||
[LAMBDA (FilenameOrURL) (* ; "Edited 28-Dec-2025 18:26 by rmk")
|
||||
(* ; "Edited 10-Sep-2025 15:29 by rmk")
|
||||
[LAMBDA (FilenameOrURL) (* ; "Edited 10-Sep-2025 15:29 by rmk")
|
||||
(* ; "Edited 4-May-2025 11:14 by rmk")
|
||||
|
||||
(* ;; "Open the file or URL using the generic %"opener%" for this machine via a shell call.")
|
||||
@@ -186,11 +184,7 @@
|
||||
then (CONCAT "File not found: " FilenameOrURL)
|
||||
elseif (STREQUAL OPENER "true")
|
||||
then (CONCAT "Unable to find a file opener to open: " FilenameOrURL)
|
||||
else (SETQ FilenameOrURL (TRUEFILENAME FilenameOrURL))
|
||||
|
||||
(* ;; "RMK: UNVERSIONED is in the Lisp space, I removed the SLASHIT there because it adds \ in front of spaces which screws up the following INFILEP.")
|
||||
|
||||
(LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION))
|
||||
else (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION))
|
||||
(UNPACKED (UNPACKFILENAME.STRING FULLNAME))
|
||||
(NEWNAME (CONCAT (LISTGET UNPACKED 'NAME)
|
||||
"~"
|
||||
@@ -203,7 +197,8 @@
|
||||
(SETQ FN (PACKFILENAME.STRING UNPACKED))
|
||||
(if (STREQUAL (SUBSTRING FN -1)
|
||||
".")
|
||||
then (SETQ FN (SUBSTRING UNIXFILE 1 -2]
|
||||
then (SETQ FN (SUBSTRING UNIXFILE 1 -2)))
|
||||
(SETQ FN (SLASHIT FN]
|
||||
(UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED)))
|
||||
(TMPDIR (CONCAT "/tmp/" (RAND 1000 9999)))
|
||||
(TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR
|
||||
@@ -245,8 +240,7 @@
|
||||
0))) DO (BLOCK) FINALLY (RETURN CODE])
|
||||
|
||||
(SLASHIT
|
||||
[LAMBDA (X LCASEDIRS NOHOST KEEPDOT) (* ; "Edited 17-Jan-2026 23:15 by rmk")
|
||||
(* ; "Edited 4-Nov-2025 10:10 by rmk")
|
||||
[LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 4-Nov-2025 10:10 by rmk")
|
||||
(* ; "Edited 22-Oct-2025 13:05 by rmk")
|
||||
(* ; "Edited 25-Sep-2025 09:57 by rmk")
|
||||
(* ; "Edited 23-Sep-2023 15:27 by rmk")
|
||||
@@ -255,7 +249,7 @@
|
||||
|
||||
(* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.")
|
||||
|
||||
(* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, perhaps lower-casing the directory, and perhaps removing a final dot. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ")
|
||||
(* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ")
|
||||
|
||||
(LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
|
||||
0]
|
||||
@@ -273,34 +267,22 @@
|
||||
(SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS))
|
||||
(OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS))
|
||||
""))))
|
||||
(CL:UNLESS (OR (EQ DIRPOS 1)
|
||||
NOHOST)
|
||||
(SETQ SLASHED (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
|
||||
SLASHED)))
|
||||
(CL:UNLESS (OR KEEPDOT (NEQ (CHARCODE %.)
|
||||
(NTHCHARCODE SLASHED -1)))
|
||||
(SETQ SLASHED (CL:IF (EQ (CHARCODE %')
|
||||
(NTHCHARCODE SLASHED -2))
|
||||
(CONCAT (SUBSTRING SLASHED 1 -3)
|
||||
".")
|
||||
(SUBSTRING SLASHED 1 -2))))
|
||||
SLASHED])
|
||||
(CL:IF (OR (EQ DIRPOS 1)
|
||||
NOHOST)
|
||||
SLASHED
|
||||
(CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
|
||||
SLASHED))])
|
||||
|
||||
(UNIX-FILE-NAME
|
||||
[LAMBDA (FILE ACCESS COPY EXTENSION) (* ; "Edited 19-Jan-2026 14:05 by rmk")
|
||||
(* ; "Edited 17-Jan-2026 22:32 by rmk")
|
||||
(* ; "Edited 11-Jan-2026 23:54 by rmk")
|
||||
(* ; "Edited 27-Dec-2025 21:24 by rmk")
|
||||
(* ; "Edited 26-Dec-2025 10:58 by rmk")
|
||||
(* ; "Edited 27-Sep-2025 16:24 by rmk")
|
||||
[LAMBDA (FILE ACCESS COPY) (* ; "Edited 27-Sep-2025 16:24 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 07:29 by rmk")
|
||||
(* ; "Edited 13-Sep-2025 18:37 by rmk")
|
||||
(* ; "Edited 1-Oct-2023 20:52 by rmk")
|
||||
|
||||
(* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file doesn't have the Medley version convention. If FILE does not have a corresponding Unix name (e.g. NODIRCORE), COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.")
|
||||
|
||||
(* ;; "NOTE: The value does not have a host field--no {UNIX}.")
|
||||
(* ;; "Forces an extension %"ufn%" if there isn't one already, to avoid the dot/no-dot question")
|
||||
|
||||
(* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.")
|
||||
(* ; "Might catch NODIRCORE")
|
||||
(CL:WHEN FILE
|
||||
(SETQ FILE (TRUEFILENAME FILE))
|
||||
(CL:UNLESS (STREAMP FILE)
|
||||
@@ -310,58 +292,42 @@
|
||||
(NIL (SETQ ACCESS 'INPUT)
|
||||
'OLD)
|
||||
(\ILLEGAL.ARG ACCESS])
|
||||
[SLASHIT (SELECTQ (FILENAMEFIELD FILE 'HOST)
|
||||
(UNIX (CL:IF [AND EXTENSION (NEQ (L-CASE EXTENSION)
|
||||
(L-CASE (FILENAMEFIELD FILE 'EXTENSION]
|
||||
(COPYFILE FILE (PACKFILENAME 'EXTENSION EXTENSION 'BODY FILE))
|
||||
FILE))
|
||||
(DSK [LET ((VERSION (FILENAMEFIELD FILE 'VERSION))
|
||||
(UNAME (PACKFILENAME 'VERSION NIL 'BODY FILE)))
|
||||
(CL:UNLESS (EQ VERSION 1)
|
||||
(CONCAT UNAME (CONCAT "~" VERSION "~")))])
|
||||
(LET (UNAME)
|
||||
(LET (UNAME VERSION)
|
||||
[SELECTQ (FILENAMEFIELD FILE 'HOST)
|
||||
((UNIX DSK)
|
||||
(SETQ UNAME FILE))
|
||||
(PROGN
|
||||
(* ;; "Catch the streams as well as other devices (CORE, servers)")
|
||||
|
||||
(* ;; "Catch the streams as well as other devices (CORE, servers)")
|
||||
|
||||
(SETQ UNAME (UNIX-TMP-FILE-NAME FILE EXTENSION))
|
||||
(CL:IF (AND COPY FILE)
|
||||
(RESETLST
|
||||
(CL:WHEN (\GETSTREAM FILE 'INPUT T)
|
||||
[SETQ UNAME (OUTFILEP (CONCAT "{DSK}/tmp/medley-" (CL:IF COPY
|
||||
(CONCAT (L-CASE COPY)
|
||||
"-")
|
||||
"")
|
||||
(IDATE]
|
||||
(CL:WHEN (AND COPY FILE)
|
||||
(RESETLST
|
||||
(CL:WHEN (\GETSTREAM FILE 'INPUT T)
|
||||
(* ; "Hope it's randaccess")
|
||||
[RESETSAVE (GETFILEPTR FILE)
|
||||
`(PROGN (SETFILEPTR ,FILE OLDVALUE])
|
||||
(COPYFILE FILE UNAME))
|
||||
UNAME)])])
|
||||
[RESETSAVE (GETFILEPTR FILE)
|
||||
`(PROGN (SETFILEPTR ,FILE OLDVALUE])
|
||||
|
||||
(UNIX-TMP-FILE-NAME
|
||||
[LAMBDA (NAME EXT HOST) (* ; "Edited 17-Jan-2026 22:28 by rmk")
|
||||
(* ; "Edited 13-Jan-2026 15:41 by rmk")
|
||||
(* ; "Edited 26-Dec-2025 17:37 by rmk")
|
||||
(* ;; "Let DSK pick a new version number, rather than RAND")
|
||||
|
||||
(* ;; "Returns a unique {UNIX}/tmp/medley name that includes NAME as a hint and perhaps a useful extension. This goes through random candidates hoping to find a name that doesn't yet exist, and that can be %"reserved%" before anybody else gets it. There is a race-condition window where somebody could get in.")
|
||||
|
||||
(* ;; " ")
|
||||
|
||||
(* ;; "If DSK names were reformatted so that the ~version~ came before the intended extension, we could just open on an output stream on DSK to get a unique version number, then convert to the UNIX formatted string.")
|
||||
|
||||
(bind UNAME (DATEPREFIX _ (CONCAT "{UNIX}/tmp/medley-" (IDATE)
|
||||
"-"))
|
||||
(SUFFIX _ (CONCAT (CL:IF NAME
|
||||
[OR (AND (STREAMP (FULLNAME NAME))
|
||||
"stream")
|
||||
(L-CASE (FILENAMEFIELD NAME 'NAME]
|
||||
"unamed")
|
||||
(CL:IF EXT
|
||||
(CONCAT "." (L-CASE EXT))
|
||||
""))) eachtime (SETQ UNAME (CONCAT DATEPREFIX (RAND 1 1000)
|
||||
"-" SUFFIX))
|
||||
unless (INFILEP UNAME) do (RETURN (SLASHIT (CLOSEF (OPENSTREAM UNAME 'OUTPUT 'NEW])
|
||||
(COPYFILE FILE UNAME)))]
|
||||
(SETQ VERSION (FILENAMEFIELD UNAME 'VERSION)) (* ; "Convert to Unix version. ")
|
||||
(SETQ UNAME (PACKFILENAME 'VERSION NIL 'BODY UNAME))
|
||||
(CL:WHEN (AND VERSION (IGREATERP VERSION 1))
|
||||
(SETQ UNAME (CONCAT UNAME ".~" VERSION "~")))
|
||||
(SETQ UNAME (SLASHIT UNAME NIL T))
|
||||
(CL:IF (EQ (CHARCODE %.)
|
||||
(NTHCHARCODE UNAME -1))
|
||||
(SUBSTRING UNAME 1 -2)
|
||||
UNAME)))])
|
||||
)
|
||||
|
||||
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1170 1543 (ShellCommand 1170 . 1543)) (1545 1942 (ShellWhich 1545 . 1942)) (2052 20633
|
||||
(ShellBrowser 2062 . 3834) (ShellBrowse 3836 . 4521) (ShellOpener 4523 . 6211) (ShellOpen 6213 . 11982
|
||||
) (PROCESS-COMMAND 11984 . 12597) (SLASHIT 12599 . 15623) (UNIX-FILE-NAME 15625 . 18952) (
|
||||
UNIX-TMP-FILE-NAME 18954 . 20631)))))
|
||||
(FILEMAP (NIL (1137 1510 (ShellCommand 1137 . 1510)) (1512 1909 (ShellWhich 1512 . 1909)) (2019 18006
|
||||
(ShellBrowser 2029 . 3801) (ShellBrowse 3803 . 4488) (ShellOpener 4490 . 6178) (ShellOpen 6180 . 11659
|
||||
) (PROCESS-COMMAND 11661 . 12274) (SLASHIT 12276 . 14731) (UNIX-FILE-NAME 14733 . 18004)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Dec-2025 00:35:27" {WMEDLEY}<library>sketch>SKETCH-OPS.;9 220612
|
||||
(FILECREATED " 5-Dec-2023 00:08:46" {WMEDLEY}<library>sketch>SKETCH-OPS.;1 221752
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS SK.PRINTER.FILE.CANDIDATE.NAME)
|
||||
:CHANGES-TO (RECORDS AFFINETRANSFORMATION SKHISTEVENT SKEVENTTYPE SKETCHVIEW)
|
||||
|
||||
:PREVIOUS-DATE "29-Nov-2025 21:49:05" {WMEDLEY}<library>sketch>SKETCH-OPS.;8)
|
||||
:PREVIOUS-DATE " 3-May-2023 21:06:28" {WMEDLEY}<library>sketch>SKETCHOPS.;2)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT SKETCH-OPSCOMS)
|
||||
@@ -17,8 +17,9 @@
|
||||
(COMS
|
||||
(* ;; "miscellaneous utility functions")
|
||||
|
||||
(FNS SCALE.REGION.OUT SK.SCALE.POSITION.INTO.VIEWER SK.SCALE.POSITION.INTO.VIEWER.EXACT
|
||||
SK.MAKE.POSITION.INTEGER SCALE.POSITION.INTO.SKETCHW UNSCALE UNSCALE.REGION)
|
||||
(FNS SK.FONTNAMELIST SCALE.REGION.OUT SK.SCALE.POSITION.INTO.VIEWER
|
||||
SK.SCALE.POSITION.INTO.VIEWER.EXACT SK.MAKE.POSITION.INTEGER
|
||||
SCALE.POSITION.INTO.SKETCHW UNSCALE UNSCALE.REGION)
|
||||
|
||||
(* ;; "misc IO functions")
|
||||
|
||||
@@ -44,8 +45,9 @@
|
||||
(FNS SKETCHW.HARDCOPYFN SK.LIST.IMAGE SK.HARDCOPYIMAGEW)
|
||||
(FNS SK.DO.HARDCOPYIMAGEW.TOFILE SK.HARDCOPYIMAGEW.TOFILE
|
||||
SK.HARDCOPYIMAGEW.TOPRINTER SK.LIST.IMAGE.ON.FILE)
|
||||
(FNS \SK.LIST.PAGE.IMAGE SK.PRINTER.FILE.CANDIDATE.NAME SK.SET.HARDCOPY.MODE
|
||||
SK.UNSET.HARDCOPY.MODE SK.UPDATE.AFTER.HARDCOPY SK.SWITCH.REGION.X.AND.Y)
|
||||
(FNS \SK.LIST.PAGE.IMAGE SK.GetImageFile SK.PRINTER.FILE.CANDIDATE.NAME
|
||||
SK.SET.HARDCOPY.MODE SK.UNSET.HARDCOPY.MODE SK.UPDATE.AFTER.HARDCOPY
|
||||
DEFAULTPRINTINGIMAGETYPE SK.SWITCH.REGION.X.AND.Y)
|
||||
(CONSTANTS MICASPERPT IMICASPERPT PTSPERMICA)))
|
||||
(COMS
|
||||
(* ;; "fns to implement transformations on the elements")
|
||||
@@ -138,8 +140,8 @@
|
||||
SK.NAME.CURRENT.VIEW SKETCH.ADD.VIEW SK.RESTORE.VIEW SK.FORGET.VIEW)
|
||||
(DECLARE%: DONTCOPY (RECORDS SKETCHVIEW)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
SKETCH SKETCH-ELEMENTS SKETCH-OBJ
|
||||
SKETCH-EDIT INTERPRESS))
|
||||
SKETCH SKETCHELEMENTS SKETCHOBJ
|
||||
SKETCHEDIT INTERPRESS))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA STATUSPRINT])
|
||||
@@ -155,6 +157,12 @@
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(SK.FONTNAMELIST
|
||||
[LAMBDA (FONTDESC) (* rrb " 2-NOV-83 21:00")
|
||||
(LIST (FONTPROP FONTDESC 'FAMILY)
|
||||
(FONTPROP FONTDESC 'SIZE)
|
||||
(FONTPROP FONTDESC 'FACE])
|
||||
|
||||
(SCALE.REGION.OUT
|
||||
[LAMBDA (REGION SCALE) (* rrb "30-Dec-85 17:24")
|
||||
|
||||
@@ -692,8 +700,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SKETCHW.HARDCOPYFN
|
||||
[LAMBDA (SKETCHW OPENIMAGESTREAM) (* ; "Edited 3-Nov-2025 19:55 by rmk")
|
||||
(* ; "Edited 20-Aug-92 13:33 by jds")
|
||||
[LAMBDA (SKETCHW OPENIMAGESTREAM) (* ; "Edited 20-Aug-92 13:33 by jds")
|
||||
(* ;
|
||||
"dumps the sketch onto OPENIMAGESTREAM.")
|
||||
(* ;
|
||||
@@ -721,9 +728,7 @@
|
||||
|
||||
(* ;; "PAGETOSKETCHFACTOR is the factor to multiply the page coordinates by to get into sketch coordinates.")
|
||||
|
||||
(STATUSPRINT SKETCHW "Hardcopying" (CL:UNLESS (STREAMP (FULLNAME OPENIMAGESTREAM))
|
||||
(CONCAT " to " (FULLNAME OPENIMAGESTREAM)))
|
||||
" ...")
|
||||
(STATUSPRINT SKETCHW "Hardcopying ...")
|
||||
[STREAMPROP OPENIMAGESTREAM 'PRINTOPTIONS (APPEND (LIST 'DOCUMENT.NAME (OR (SKETCH.TITLE
|
||||
SKETCHW)
|
||||
"A Sketch"))
|
||||
@@ -945,12 +950,15 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SK.DO.HARDCOPYIMAGEW.TOFILE
|
||||
[LAMBDA (W) (* ; "Edited 4-Nov-2025 21:47 by rmk")
|
||||
(* ; "Edited 3-Nov-2025 16:17 by rmk")
|
||||
(* rrb " 5-May-86 13:38")
|
||||
(* ;
|
||||
"sketch version of HARDCOPYIMAGEW.TOFILE that accepts a candidate file name.")
|
||||
(HARDCOPY.SOMEHOW W (GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME W])
|
||||
[LAMBDA (W) (* rrb " 5-May-86 13:38")
|
||||
(* sketch version of
|
||||
HARDCOPYIMAGEW.TOFILE that accepts a
|
||||
candidate file name.)
|
||||
(RESETFORM (TTY.PROCESS (THIS.PROCESS))
|
||||
(LET [(FILE&TYPE (SK.GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME W]
|
||||
(COND
|
||||
(FILE&TYPE (HARDCOPY.SOMEHOW W (CAR FILE&TYPE)
|
||||
(CDR FILE&TYPE])
|
||||
|
||||
(SK.HARDCOPYIMAGEW.TOFILE
|
||||
[LAMBDA (SKW) (* rrb " 5-May-86 13:34")
|
||||
@@ -973,16 +981,16 @@
|
||||
'SketchHardcopy])
|
||||
|
||||
(SK.LIST.IMAGE.ON.FILE
|
||||
[LAMBDA (SKETCHW) (* ; "Edited 4-Nov-2025 21:46 by rmk")
|
||||
(* ; "Edited 3-Nov-2025 16:20 by rmk")
|
||||
(* rrb " 5-May-86 13:39")
|
||||
[LAMBDA (SKETCHW) (* rrb " 5-May-86 13:39")
|
||||
|
||||
(* ;; "makes a file suitable for the default printing host of the current sketch. Pretty dumb about file names.")
|
||||
(* makes a file suitable for the default printing host of the current sketch.
|
||||
Pretty dumb about file names.)
|
||||
|
||||
(LET [(FILE&TYPE (GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME SKETCHW]
|
||||
(CL:WHEN FILE&TYPE
|
||||
(SK.LIST.IMAGE SKETCHW (CAR FILE&TYPE)
|
||||
(CDR FILE&TYPE)))])
|
||||
(RESETFORM (TTY.PROCESS (THIS.PROCESS))
|
||||
(LET [(FILE&TYPE (SK.GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME SKETCHW]
|
||||
(COND
|
||||
(FILE&TYPE (SK.LIST.IMAGE SKETCHW (CAR FILE&TYPE)
|
||||
(CDR FILE&TYPE])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1019,21 +1027,46 @@
|
||||
PAGETOSKETCHFACTOR OPENIMAGESTREAM T))
|
||||
(DRAW.LOCAL.SKETCH SKETCHX OPENIMAGESTREAM REGIONONPAGE])
|
||||
|
||||
(SK.GetImageFile
|
||||
[LAMBDA (CANDIDATE) (* rrb " 5-May-86 10:41")
|
||||
(* version of GetImageFile that takes
|
||||
a candidate name.)
|
||||
(PROG ((FILE (PopUpWindowAndGetAtom "File name (CR to abort): " CANDIDATE))
|
||||
PRINTFILETYPE FILETYPEMENU EXTENSIONSUPPLIED EXTENSIONFORTYPE)
|
||||
(COND
|
||||
((NULL FILE)
|
||||
(RETURN)))
|
||||
(SETQ FILETYPEMENU (MakeMenuOfImageTypes "File type?"))
|
||||
(COND
|
||||
((SETQ PRINTFILETYPE (PRINTFILETYPE.FROM.EXTENSION FILE))
|
||||
(RETURN (CONS FILE PRINTFILETYPE)))
|
||||
(T (SETQ PRINTFILETYPE (MENU FILETYPEMENU))
|
||||
(COND
|
||||
((NULL PRINTFILETYPE)
|
||||
(RETURN))
|
||||
(T (RETURN (CONS FILE PRINTFILETYPE])
|
||||
|
||||
(SK.PRINTER.FILE.CANDIDATE.NAME
|
||||
[LAMBDA (VIEWER) (* ; "Edited 14-Dec-2025 00:33 by rmk")
|
||||
(* ; "Edited 3-Nov-2025 16:05 by rmk")
|
||||
(* rrb " 5-May-86 13:30")
|
||||
[LAMBDA (VIEWER) (* rrb " 5-May-86 13:30")
|
||||
|
||||
(* ;; "Returns the preferred imagefile name for a viewer.")
|
||||
(* * returns the preferred printer file name for a viewer)
|
||||
|
||||
(* ;; "RMK: Original had IP built in in some way, odd conditions, plus an unbound variable. I assume that the extension of the filename is something like .SKETCH and not usually .IP (or now .PDF). And that therefore the intent is really that the result should have the extension that the deffaultprinting host can print directly.")
|
||||
(PROG ((FILENAME (SK.OUTPUT.FILE.NAME (SKETCH.TITLE VIEWER)))
|
||||
EXTENSION PRINTEXTENSION)
|
||||
(OR FILENAME (RETURN))
|
||||
[COND
|
||||
((EQ (SELECTQ (SETQ PRINTEXTENSION (DEFAULTPRINTINGIMAGETYPE))
|
||||
(INTERPRESS (SETQ PRINTEXTENSION 'IP))
|
||||
NIL)
|
||||
(FILENAMEFIELD FILENAME 'EXTENSION))
|
||||
|
||||
(LET ((FILENAME (SK.OUTPUT.FILE.NAME (SKETCH.TITLE VIEWER)))
|
||||
PRINTEXTENSION)
|
||||
(CL:WHEN [AND FILENAME (SETQ PRINTEXTENSION (CAR (EXTENSIONS.FOR.IMAGEFILETYPE (
|
||||
CAN.PRINT.DIRECTLY
|
||||
]
|
||||
(PACKFILENAME 'EXTENSION PRINTEXTENSION 'BODY FILENAME))])
|
||||
(* file name has a printer extension for some reason, propose either a null
|
||||
extension or hdcpy extension.)
|
||||
|
||||
(COND
|
||||
(PRINTEXTENSION (SETQ PRINTEREXTENSION NIL))
|
||||
(T (SETQ PRINTEREXTENSION 'HDCPY]
|
||||
(RETURN (PACKFILENAME 'EXTENSION PRINTEXTENSION 'BODY FILENAME])
|
||||
|
||||
(SK.SET.HARDCOPY.MODE
|
||||
[LAMBDA (SKETCHW IMAGETYPE) (* rrb "28-Oct-85 16:43")
|
||||
@@ -1088,6 +1121,15 @@
|
||||
(VIEWER.SCALE SKETCHW))
|
||||
(REDISPLAYW SKETCHW])
|
||||
|
||||
(DEFAULTPRINTINGIMAGETYPE
|
||||
[LAMBDA NIL (* rrb "20-Mar-85 12:45")
|
||||
(* returns the image type of the
|
||||
default printer.)
|
||||
(* code copied from OPENIMAGESTREAM)
|
||||
(CAR (MKLIST (PRINTERPROP (PRINTERTYPE (OR (CAR (LISTP DEFAULTPRINTINGHOST))
|
||||
DEFAULTPRINTINGHOST))
|
||||
'CANPRINT])
|
||||
|
||||
(SK.SWITCH.REGION.X.AND.Y
|
||||
[LAMBDA (REGION) (* rrb " 3-Sep-85 14:50")
|
||||
(* switchs the X and Y dimensions of a
|
||||
@@ -1103,7 +1145,7 @@
|
||||
|
||||
(RPAQQ IMICASPERPT 35)
|
||||
|
||||
(RPAQQ PTSPERMICA 0.028346457)
|
||||
(RPAQQ PTSPERMICA 0.02834646)
|
||||
|
||||
|
||||
(CONSTANTS MICASPERPT IMICASPERPT PTSPERMICA)
|
||||
@@ -2842,12 +2884,10 @@ If you meant this, you should use the TWO PT TRANSFORM.")
|
||||
(STATUSPRINT SKW "Element subsequently modified, can't undo"])
|
||||
|
||||
(SK.UNDO.LAST
|
||||
[LAMBDA (SKW) (* ; "Edited 29-Nov-2025 21:48 by rmk")
|
||||
(* rrb " 5-Dec-85 17:19")
|
||||
(* ;
|
||||
"undoes the first not yet undone history event.")
|
||||
[LAMBDA (SKW) (* rrb " 5-Dec-85 17:19")
|
||||
(* undoes the first not yet undone
|
||||
history event.)
|
||||
(SKED.CLEAR.SELECTION SKW)
|
||||
(CLEARPROMPTWINDOW SKW)
|
||||
(PROG [EVENT UNDOFN (HISTLST (WINDOWPROP SKW 'SKETCHHISTORY]
|
||||
(COND
|
||||
((NULL HISTLST)
|
||||
@@ -2865,8 +2905,8 @@ If you meant this, you should use the TWO PT TRANSFORM.")
|
||||
do (RETURN HISTEVENT)))
|
||||
(COND
|
||||
((APPLY* UNDOFN (fetch (SKHISTEVENT EVENTARGS) of EVENT)
|
||||
SKW EVENT) (* ;
|
||||
"only add to history list if something happened.")
|
||||
SKW EVENT) (* only add to history list if
|
||||
something happened.)
|
||||
(STATUSPRINT SKW (SK.UNDO.NAME EVENT)
|
||||
" event undone.")
|
||||
(replace (SKHISTEVENT UNDONE?) of EVENT with T)
|
||||
@@ -4054,7 +4094,7 @@ It can be either larger or smaller than the present window size.")
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
SKETCH SKETCH-ELEMENTS SKETCH-OBJ SKETCH-EDIT INTERPRESS)
|
||||
SKETCH SKETCHELEMENTS SKETCHOBJ SKETCHEDIT INTERPRESS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
@@ -4065,84 +4105,85 @@ It can be either larger or smaller than the present window size.")
|
||||
(ADDTOVAR LAMA STATUSPRINT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (9724 13801 (SCALE.REGION.OUT 9734 . 10715) (SK.SCALE.POSITION.INTO.VIEWER 10717 . 11473
|
||||
) (SK.SCALE.POSITION.INTO.VIEWER.EXACT 11475 . 12017) (SK.MAKE.POSITION.INTEGER 12019 . 12687) (
|
||||
SCALE.POSITION.INTO.SKETCHW 12689 . 13081) (UNSCALE 13083 . 13211) (UNSCALE.REGION 13213 . 13799)) (
|
||||
13837 17535 (STATUSPRINT 13847 . 15209) (CLEARPROMPTWINDOW 15211 . 15618) (CLOSEPROMPTWINDOW 15620 .
|
||||
16117) (MYGETPROMPTWINDOW 16119 . 16818) (PROMPT.GETINPUT 16820 . 17533)) (17593 28624 (
|
||||
SK.SEND.TO.BOTTOM 17603 . 17942) (SK.BRING.TO.TOP 17944 . 18312) (SK.SWITCH.PRIORITIES 18314 . 18640)
|
||||
(SK.SEL.AND.CHANGE.PRIORITY 18642 . 19210) (SK.SEL.AND.SWITCH.PRIORITIES 19212 . 20979) (
|
||||
SK.SORT.ELTS.BY.PRIORITY 20981 . 21702) (SK.SORT.GELTS.BY.PRIORITY 21704 . 22283) (
|
||||
SORT.CHANGESPECS.BY.NEW.PRIORITY 22285 . 22973) (SORT.CHANGESPECS.BY.OLD.PRIORITY 22975 . 23663) (
|
||||
SK.SEND.ELEMENTS.TO.BOTTOM 23665 . 25336) (SK.BRING.ELEMENTS.TO.TOP 25338 . 27022) (
|
||||
SK.COPY.GLOBAL.ELEMENT.AND.PROPERTY.LIST 27024 . 28622)) (28625 31481 (SK.ELEMENT.PRIORITY 28635 .
|
||||
28963) (SK.SET.ELEMENT.PRIORITY 28965 . 29909) (SK.POP.NEXT.PRIORITY 29911 . 30254) (SK.PRIORITY.CELL
|
||||
30256 . 30461) (SK.HIGH.PRIORITY 30463 . 30966) (SK.LOW.PRIORITY 30968 . 31479)) (31544 38347 (
|
||||
DRAW.LOCAL.SKETCH 31554 . 32556) (SET.PRIORITYIMPORTANT 32558 . 33126) (SK.FIGUREIMAGE 33128 . 38345))
|
||||
(38391 57335 (SKETCHW.HARDCOPYFN 38401 . 45876) (SK.LIST.IMAGE 45878 . 56985) (SK.HARDCOPYIMAGEW
|
||||
56987 . 57333)) (57336 59339 (SK.DO.HARDCOPYIMAGEW.TOFILE 57346 . 57943) (SK.HARDCOPYIMAGEW.TOFILE
|
||||
57945 . 58307) (SK.HARDCOPYIMAGEW.TOPRINTER 58309 . 58671) (SK.LIST.IMAGE.ON.FILE 58673 . 59337)) (
|
||||
59340 66025 (\SK.LIST.PAGE.IMAGE 59350 . 61782) (SK.PRINTER.FILE.CANDIDATE.NAME 61784 . 62988) (
|
||||
SK.SET.HARDCOPY.MODE 62990 . 64375) (SK.UNSET.HARDCOPY.MODE 64377 . 64795) (SK.UPDATE.AFTER.HARDCOPY
|
||||
64797 . 65505) (SK.SWITCH.REGION.X.AND.Y 65507 . 66023)) (66264 79161 (SK.SEL.AND.TRANSFORM 66274 .
|
||||
66624) (SK.TRANSFORM.ELEMENTS 66626 . 67881) (SK.TRANSFORM.ITEM 67883 . 68684) (SK.TRANSFORM.ELEMENT
|
||||
68686 . 69144) (SK.TRANSFORM.POINT 69146 . 69496) (SK.TRANSFORM.POINT.LIST 69498 . 69719) (
|
||||
SK.TRANSFORM.REGION 69721 . 71907) (SK.PUT.ELTS.ON.GRID 71909 . 72387) (SK.TRANSFORM.GLOBAL.ELEMENTS
|
||||
72389 . 72891) (GLOBALELEMENTP 72893 . 73184) (SKETCH.LIST.OF.ELEMENTSP 73186 . 73490) (
|
||||
SK.TRANSFORM.SCALE.FACTOR 73492 . 75185) (SK.TRANSFORM.BRUSH 75187 . 75654) (SK.TRANSFORM.ARROWHEADS
|
||||
75656 . 77247) (SCALE.BRUSH 77249 . 79159)) (79162 99354 (TWO.PT.TRANSFORMATION.INPUTFN 79172 . 81945)
|
||||
(SK.TWO.PT.TRANSFORM.ELTS 81947 . 82352) (SK.SEL.AND.TWO.PT.TRANSFORM 82354 . 82945) (
|
||||
SK.APPLY.AFFINE.TRANSFORM 82947 . 84066) (SK.COMPUTE.TWO.PT.TRANSFORMATION 84068 . 88406) (
|
||||
SK.COMPUTE.SLOPE 88408 . 89173) (SK.THREE.PT.TRANSFORM.ELTS 89175 . 89586) (
|
||||
SK.COMPUTE.THREE.PT.TRANSFORMATION 89588 . 94125) (SK.SEL.AND.THREE.PT.TRANSFORM 94127 . 94724) (
|
||||
THREE.PT.TRANSFORMATION.INPUTFN 94726 . 99352)) (99355 103382 (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS 99365
|
||||
. 99784) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM 99786 . 100407) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS
|
||||
100409 . 100838) (SK.SEL.COPY.AND.THREE.PT.TRANSFORM 100840 . 101464) (SK.COPY.AND.TRANSFORM.ELEMENTS
|
||||
101466 . 102510) (SK.COPY.AND.TRANSFORM.ITEM 102512 . 103380)) (105510 108705 (SK.SHOWMARKS 105520 .
|
||||
106420) (MARKPOINT 106422 . 107142) (SK.MARKHOTSPOTS 107144 . 108219) (SK.MARK.SELECTION 108221 .
|
||||
108703)) (109234 116012 (SK.SELECT.ITEM 109244 . 111904) (IN.SKETCH.ELT? 111906 . 114292) (
|
||||
SK.MARK.HOTSPOT 114294 . 114776) (SK.MARK.POSITION 114778 . 115215) (SK.SELECT.ELT 115217 . 115644) (
|
||||
SK.DESELECT.ELT 115646 . 116010)) (116155 128969 (SK.HOTSPOT.CACHE 116165 . 116509) (
|
||||
SK.HOTSPOT.CACHE.FOR.OPERATION 116511 . 117866) (SK.BUILD.CACHE 117868 . 118691) (
|
||||
SK.ELEMENT.PROTECTED? 118693 . 119286) (SK.HAS.SOME.HOTSPOTS 119288 . 119742) (SK.SET.HOTSPOT.CACHE
|
||||
119744 . 120099) (SK.CREATE.HOTSPOT.CACHE 120101 . 120551) (SK.ELTS.FROM.HOTSPOT 120553 . 121393) (
|
||||
SK.ADD.HOTSPOTS.TO.CACHE 121395 . 121796) (SK.ADD.HOTSPOTS.TO.CACHE1 121798 . 122344) (
|
||||
SK.ADD.HOTSPOT.TO.CACHE 122346 . 124222) (SK.REMOVE.HOTSPOTS.FROM.CACHE 124224 . 124627) (
|
||||
SK.REMOVE.HOTSPOTS.FROM.CACHE1 124629 . 125147) (SK.REMOVE.HOTSPOT.FROM.CACHE 125149 . 125712) (
|
||||
SK.REMOVE.VALUE.FROM.CACHE.BUCKET 125714 . 126683) (SK.FIND.CACHE.BUCKET 126685 . 127274) (
|
||||
SK.ADD.VALUE.TO.CACHE.BUCKET 127276 . 128967)) (128997 148440 (SK.SET.GRID 129007 . 129428) (
|
||||
SK.DISPLAY.GRID 129430 . 129979) (SK.DISPLAY.GRID.POINTS 129981 . 130177) (SK.REMOVE.GRID.POINTS
|
||||
130179 . 130982) (SK.TAKE.DOWN.GRID 130984 . 131295) (SK.SHOW.GRID 131297 . 134911) (SK.GRIDFACTOR
|
||||
134913 . 135434) (SK.TURN.GRID.ON 135436 . 135764) (SK.TURN.GRID.OFF 135766 . 136124) (
|
||||
SK.MAKE.GRID.LARGER 136126 . 136858) (SK.MAKE.GRID.SMALLER 136860 . 137613) (SK.CHANGE.GRID 137615 .
|
||||
138063) (GRID.FACTOR1 138065 . 138422) (LEASTPOWEROF2GT 138424 . 139198) (GREATESTPOWEROF2LT 139200 .
|
||||
139815) (SK.DEFAULT.GRIDFACTOR 139817 . 140370) (SK.PUT.ON.GRID 140372 . 140930) (MAP.WINDOW.ONTO.GRID
|
||||
140932 . 141366) (MAP.SCREEN.ONTO.GRID 141368 . 141856) (MAP.GLOBAL.PT.ONTO.GRID 141858 . 142240) (
|
||||
MAP.GLOBAL.REGION.ONTO.GRID 142242 . 143959) (MAP.WINDOW.POINT.ONTO.GLOBAL.GRID 143961 . 144504) (
|
||||
MAP.WINDOW.ONTO.GLOBAL.GRID 144506 . 144891) (SK.UPDATE.GRIDFACTOR 144893 . 145529) (
|
||||
SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID 145531 . 146069) (SK.MAP.INPUT.PT.TO.GLOBAL 146071 . 147288) (
|
||||
SK.MAP.FROM.WINDOW.TO.NEAREST.GRID 147290 . 148438)) (148580 157135 (SK.ADD.HISTEVENT 148590 . 149725)
|
||||
(SK.SEL.AND.UNDO 149727 . 152641) (SK.UNDO.LAST 152643 . 154852) (SK.UNDO.NAME 154854 . 155358) (
|
||||
SKEVENTTYPEFNS 155360 . 155710) (SK.TYPE.OF.FIRST.ARG 155712 . 157133)) (157136 157822 (SK.DELETE.UNDO
|
||||
157146 . 157575) (SK.ADD.UNDO 157577 . 157820)) (157823 164605 (SK.CHANGE.UNDO 157833 . 159816) (
|
||||
SK.ELT.IN.SKETCH? 159818 . 160072) (SK.CHANGE.REDO 160074 . 161942) (SK.MOVE.UNDO 161944 . 163337) (
|
||||
SK.MOVE.REDO 163339 . 164603)) (164606 166705 (SK.UNDO.UNDO 164616 . 165882) (SK.UNDO.MENULABEL 165884
|
||||
. 166279) (SK.LABEL.FROM.TYPE 166281 . 166703)) (167555 175397 (SHOW.GLOBAL.COORDS 167565 . 168114) (
|
||||
LOCATOR.CLOSEFN 168116 . 168401) (SKETCHW.FROM.LOCATOR 168403 . 168811) (SKETCHW.UPDATE.LOCATORS
|
||||
168813 . 169399) (LOCATOR.UPDATE 169401 . 170159) (UPDATE.GLOBAL.LOCATOR 170161 . 170962) (
|
||||
UPDATE.GLOBALCOORD.LOCATOR 170964 . 171541) (ADD.GLOBAL.DISPLAY 171543 . 172460) (
|
||||
ADD.GLOBAL.GRIDDED.DISPLAY 172462 . 172721) (CREATE.GLOBAL.DISPLAYER 172723 . 173800) (
|
||||
UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR 173802 . 175395)) (175604 188091 (DISPLAYREADCOLORHLSLEVELS 175614
|
||||
. 176450) (DISPLAYREADCOLORLEVEL 176452 . 177487) (DRAWREADCOLORBOX 177489 . 178478) (
|
||||
READ.CHANGE.COLOR 178480 . 178697) (READCOLOR1 178699 . 181613) (READCOLORCOMMANDMENUSELECTEDFN 181615
|
||||
. 181982) (READCOLOR2 181984 . 188089)) (188092 189551 (CREATE.CNS.MENU 188102 . 189549)) (189828
|
||||
192538 (SK.ABSWXOFFSET 189838 . 190132) (SK.ABSWYOFFSET 190134 . 190428) (
|
||||
SK.UNSCALE.POSITION.FROM.VIEWER 190430 . 190999) (SK.SCALE.REGION 191001 . 192536)) (192577 207575 (
|
||||
VIEWER.SCALE 192587 . 192896) (SKETCH.ZOOM 192898 . 193933) (SAME.ASPECT.RATIO 193935 . 195299) (
|
||||
SKETCH.DO.ZOOM 195301 . 196506) (SKETCH.NEW.VIEW 196508 . 197023) (ZOOM.UPDATE.ELT 197025 . 197918) (
|
||||
SK.UPDATE.AFTER.SCALE.CHANGE 197920 . 199789) (SKETCH.AUTOZOOM 199791 . 204211) (
|
||||
SKETCH.GLOBAL.REGION.ZOOM 204213 . 207573)) (208212 220124 (SKETCH.HOME 208222 . 208749) (SK.FRAME.IT
|
||||
208751 . 209343) (SK.FRAME.WINDOW.TO.SKETCH 209345 . 213191) (SK.MOVE.TO.VIEW 213193 . 214607) (
|
||||
SK.NAME.CURRENT.VIEW 214609 . 215719) (SKETCH.ADD.VIEW 215721 . 216814) (SK.RESTORE.VIEW 216816 .
|
||||
218692) (SK.FORGET.VIEW 218694 . 220122)))))
|
||||
(FILEMAP (NIL (9853 14154 (SK.FONTNAMELIST 9863 . 10085) (SCALE.REGION.OUT 10087 . 11068) (
|
||||
SK.SCALE.POSITION.INTO.VIEWER 11070 . 11826) (SK.SCALE.POSITION.INTO.VIEWER.EXACT 11828 . 12370) (
|
||||
SK.MAKE.POSITION.INTEGER 12372 . 13040) (SCALE.POSITION.INTO.SKETCHW 13042 . 13434) (UNSCALE 13436 .
|
||||
13564) (UNSCALE.REGION 13566 . 14152)) (14190 17888 (STATUSPRINT 14200 . 15562) (CLEARPROMPTWINDOW
|
||||
15564 . 15971) (CLOSEPROMPTWINDOW 15973 . 16470) (MYGETPROMPTWINDOW 16472 . 17171) (PROMPT.GETINPUT
|
||||
17173 . 17886)) (17946 28977 (SK.SEND.TO.BOTTOM 17956 . 18295) (SK.BRING.TO.TOP 18297 . 18665) (
|
||||
SK.SWITCH.PRIORITIES 18667 . 18993) (SK.SEL.AND.CHANGE.PRIORITY 18995 . 19563) (
|
||||
SK.SEL.AND.SWITCH.PRIORITIES 19565 . 21332) (SK.SORT.ELTS.BY.PRIORITY 21334 . 22055) (
|
||||
SK.SORT.GELTS.BY.PRIORITY 22057 . 22636) (SORT.CHANGESPECS.BY.NEW.PRIORITY 22638 . 23326) (
|
||||
SORT.CHANGESPECS.BY.OLD.PRIORITY 23328 . 24016) (SK.SEND.ELEMENTS.TO.BOTTOM 24018 . 25689) (
|
||||
SK.BRING.ELEMENTS.TO.TOP 25691 . 27375) (SK.COPY.GLOBAL.ELEMENT.AND.PROPERTY.LIST 27377 . 28975)) (
|
||||
28978 31834 (SK.ELEMENT.PRIORITY 28988 . 29316) (SK.SET.ELEMENT.PRIORITY 29318 . 30262) (
|
||||
SK.POP.NEXT.PRIORITY 30264 . 30607) (SK.PRIORITY.CELL 30609 . 30814) (SK.HIGH.PRIORITY 30816 . 31319)
|
||||
(SK.LOW.PRIORITY 31321 . 31832)) (31897 38700 (DRAW.LOCAL.SKETCH 31907 . 32909) (SET.PRIORITYIMPORTANT
|
||||
32911 . 33479) (SK.FIGUREIMAGE 33481 . 38698)) (38744 57418 (SKETCHW.HARDCOPYFN 38754 . 45959) (
|
||||
SK.LIST.IMAGE 45961 . 57068) (SK.HARDCOPYIMAGEW 57070 . 57416)) (57419 59376 (
|
||||
SK.DO.HARDCOPYIMAGEW.TOFILE 57429 . 58103) (SK.HARDCOPYIMAGEW.TOFILE 58105 . 58467) (
|
||||
SK.HARDCOPYIMAGEW.TOPRINTER 58469 . 58831) (SK.LIST.IMAGE.ON.FILE 58833 . 59374)) (59377 67301 (
|
||||
\SK.LIST.PAGE.IMAGE 59387 . 61819) (SK.GetImageFile 61821 . 62751) (SK.PRINTER.FILE.CANDIDATE.NAME
|
||||
62753 . 63672) (SK.SET.HARDCOPY.MODE 63674 . 65059) (SK.UNSET.HARDCOPY.MODE 65061 . 65479) (
|
||||
SK.UPDATE.AFTER.HARDCOPY 65481 . 66189) (DEFAULTPRINTINGIMAGETYPE 66191 . 66781) (
|
||||
SK.SWITCH.REGION.X.AND.Y 66783 . 67299)) (67539 80436 (SK.SEL.AND.TRANSFORM 67549 . 67899) (
|
||||
SK.TRANSFORM.ELEMENTS 67901 . 69156) (SK.TRANSFORM.ITEM 69158 . 69959) (SK.TRANSFORM.ELEMENT 69961 .
|
||||
70419) (SK.TRANSFORM.POINT 70421 . 70771) (SK.TRANSFORM.POINT.LIST 70773 . 70994) (SK.TRANSFORM.REGION
|
||||
70996 . 73182) (SK.PUT.ELTS.ON.GRID 73184 . 73662) (SK.TRANSFORM.GLOBAL.ELEMENTS 73664 . 74166) (
|
||||
GLOBALELEMENTP 74168 . 74459) (SKETCH.LIST.OF.ELEMENTSP 74461 . 74765) (SK.TRANSFORM.SCALE.FACTOR
|
||||
74767 . 76460) (SK.TRANSFORM.BRUSH 76462 . 76929) (SK.TRANSFORM.ARROWHEADS 76931 . 78522) (SCALE.BRUSH
|
||||
78524 . 80434)) (80437 100629 (TWO.PT.TRANSFORMATION.INPUTFN 80447 . 83220) (SK.TWO.PT.TRANSFORM.ELTS
|
||||
83222 . 83627) (SK.SEL.AND.TWO.PT.TRANSFORM 83629 . 84220) (SK.APPLY.AFFINE.TRANSFORM 84222 . 85341)
|
||||
(SK.COMPUTE.TWO.PT.TRANSFORMATION 85343 . 89681) (SK.COMPUTE.SLOPE 89683 . 90448) (
|
||||
SK.THREE.PT.TRANSFORM.ELTS 90450 . 90861) (SK.COMPUTE.THREE.PT.TRANSFORMATION 90863 . 95400) (
|
||||
SK.SEL.AND.THREE.PT.TRANSFORM 95402 . 95999) (THREE.PT.TRANSFORMATION.INPUTFN 96001 . 100627)) (100630
|
||||
104657 (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS 100640 . 101059) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM 101061
|
||||
. 101682) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS 101684 . 102113) (SK.SEL.COPY.AND.THREE.PT.TRANSFORM
|
||||
102115 . 102739) (SK.COPY.AND.TRANSFORM.ELEMENTS 102741 . 103785) (SK.COPY.AND.TRANSFORM.ITEM 103787
|
||||
. 104655)) (106785 109980 (SK.SHOWMARKS 106795 . 107695) (MARKPOINT 107697 . 108417) (SK.MARKHOTSPOTS
|
||||
108419 . 109494) (SK.MARK.SELECTION 109496 . 109978)) (110509 117287 (SK.SELECT.ITEM 110519 . 113179)
|
||||
(IN.SKETCH.ELT? 113181 . 115567) (SK.MARK.HOTSPOT 115569 . 116051) (SK.MARK.POSITION 116053 . 116490)
|
||||
(SK.SELECT.ELT 116492 . 116919) (SK.DESELECT.ELT 116921 . 117285)) (117430 130244 (SK.HOTSPOT.CACHE
|
||||
117440 . 117784) (SK.HOTSPOT.CACHE.FOR.OPERATION 117786 . 119141) (SK.BUILD.CACHE 119143 . 119966) (
|
||||
SK.ELEMENT.PROTECTED? 119968 . 120561) (SK.HAS.SOME.HOTSPOTS 120563 . 121017) (SK.SET.HOTSPOT.CACHE
|
||||
121019 . 121374) (SK.CREATE.HOTSPOT.CACHE 121376 . 121826) (SK.ELTS.FROM.HOTSPOT 121828 . 122668) (
|
||||
SK.ADD.HOTSPOTS.TO.CACHE 122670 . 123071) (SK.ADD.HOTSPOTS.TO.CACHE1 123073 . 123619) (
|
||||
SK.ADD.HOTSPOT.TO.CACHE 123621 . 125497) (SK.REMOVE.HOTSPOTS.FROM.CACHE 125499 . 125902) (
|
||||
SK.REMOVE.HOTSPOTS.FROM.CACHE1 125904 . 126422) (SK.REMOVE.HOTSPOT.FROM.CACHE 126424 . 126987) (
|
||||
SK.REMOVE.VALUE.FROM.CACHE.BUCKET 126989 . 127958) (SK.FIND.CACHE.BUCKET 127960 . 128549) (
|
||||
SK.ADD.VALUE.TO.CACHE.BUCKET 128551 . 130242)) (130272 149715 (SK.SET.GRID 130282 . 130703) (
|
||||
SK.DISPLAY.GRID 130705 . 131254) (SK.DISPLAY.GRID.POINTS 131256 . 131452) (SK.REMOVE.GRID.POINTS
|
||||
131454 . 132257) (SK.TAKE.DOWN.GRID 132259 . 132570) (SK.SHOW.GRID 132572 . 136186) (SK.GRIDFACTOR
|
||||
136188 . 136709) (SK.TURN.GRID.ON 136711 . 137039) (SK.TURN.GRID.OFF 137041 . 137399) (
|
||||
SK.MAKE.GRID.LARGER 137401 . 138133) (SK.MAKE.GRID.SMALLER 138135 . 138888) (SK.CHANGE.GRID 138890 .
|
||||
139338) (GRID.FACTOR1 139340 . 139697) (LEASTPOWEROF2GT 139699 . 140473) (GREATESTPOWEROF2LT 140475 .
|
||||
141090) (SK.DEFAULT.GRIDFACTOR 141092 . 141645) (SK.PUT.ON.GRID 141647 . 142205) (MAP.WINDOW.ONTO.GRID
|
||||
142207 . 142641) (MAP.SCREEN.ONTO.GRID 142643 . 143131) (MAP.GLOBAL.PT.ONTO.GRID 143133 . 143515) (
|
||||
MAP.GLOBAL.REGION.ONTO.GRID 143517 . 145234) (MAP.WINDOW.POINT.ONTO.GLOBAL.GRID 145236 . 145779) (
|
||||
MAP.WINDOW.ONTO.GLOBAL.GRID 145781 . 146166) (SK.UPDATE.GRIDFACTOR 146168 . 146804) (
|
||||
SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID 146806 . 147344) (SK.MAP.INPUT.PT.TO.GLOBAL 147346 . 148563) (
|
||||
SK.MAP.FROM.WINDOW.TO.NEAREST.GRID 148565 . 149713)) (149855 158278 (SK.ADD.HISTEVENT 149865 . 151000)
|
||||
(SK.SEL.AND.UNDO 151002 . 153916) (SK.UNDO.LAST 153918 . 155995) (SK.UNDO.NAME 155997 . 156501) (
|
||||
SKEVENTTYPEFNS 156503 . 156853) (SK.TYPE.OF.FIRST.ARG 156855 . 158276)) (158279 158965 (SK.DELETE.UNDO
|
||||
158289 . 158718) (SK.ADD.UNDO 158720 . 158963)) (158966 165748 (SK.CHANGE.UNDO 158976 . 160959) (
|
||||
SK.ELT.IN.SKETCH? 160961 . 161215) (SK.CHANGE.REDO 161217 . 163085) (SK.MOVE.UNDO 163087 . 164480) (
|
||||
SK.MOVE.REDO 164482 . 165746)) (165749 167848 (SK.UNDO.UNDO 165759 . 167025) (SK.UNDO.MENULABEL 167027
|
||||
. 167422) (SK.LABEL.FROM.TYPE 167424 . 167846)) (168698 176540 (SHOW.GLOBAL.COORDS 168708 . 169257) (
|
||||
LOCATOR.CLOSEFN 169259 . 169544) (SKETCHW.FROM.LOCATOR 169546 . 169954) (SKETCHW.UPDATE.LOCATORS
|
||||
169956 . 170542) (LOCATOR.UPDATE 170544 . 171302) (UPDATE.GLOBAL.LOCATOR 171304 . 172105) (
|
||||
UPDATE.GLOBALCOORD.LOCATOR 172107 . 172684) (ADD.GLOBAL.DISPLAY 172686 . 173603) (
|
||||
ADD.GLOBAL.GRIDDED.DISPLAY 173605 . 173864) (CREATE.GLOBAL.DISPLAYER 173866 . 174943) (
|
||||
UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR 174945 . 176538)) (176747 189234 (DISPLAYREADCOLORHLSLEVELS 176757
|
||||
. 177593) (DISPLAYREADCOLORLEVEL 177595 . 178630) (DRAWREADCOLORBOX 178632 . 179621) (
|
||||
READ.CHANGE.COLOR 179623 . 179840) (READCOLOR1 179842 . 182756) (READCOLORCOMMANDMENUSELECTEDFN 182758
|
||||
. 183125) (READCOLOR2 183127 . 189232)) (189235 190694 (CREATE.CNS.MENU 189245 . 190692)) (190971
|
||||
193681 (SK.ABSWXOFFSET 190981 . 191275) (SK.ABSWYOFFSET 191277 . 191571) (
|
||||
SK.UNSCALE.POSITION.FROM.VIEWER 191573 . 192142) (SK.SCALE.REGION 192144 . 193679)) (193720 208718 (
|
||||
VIEWER.SCALE 193730 . 194039) (SKETCH.ZOOM 194041 . 195076) (SAME.ASPECT.RATIO 195078 . 196442) (
|
||||
SKETCH.DO.ZOOM 196444 . 197649) (SKETCH.NEW.VIEW 197651 . 198166) (ZOOM.UPDATE.ELT 198168 . 199061) (
|
||||
SK.UPDATE.AFTER.SCALE.CHANGE 199063 . 200932) (SKETCH.AUTOZOOM 200934 . 205354) (
|
||||
SKETCH.GLOBAL.REGION.ZOOM 205356 . 208716)) (209355 221267 (SKETCH.HOME 209365 . 209892) (SK.FRAME.IT
|
||||
209894 . 210486) (SK.FRAME.WINDOW.TO.SKETCH 210488 . 214334) (SK.MOVE.TO.VIEW 214336 . 215750) (
|
||||
SK.NAME.CURRENT.VIEW 215752 . 216862) (SKETCH.ADD.VIEW 216864 . 217957) (SK.RESTORE.VIEW 217959 .
|
||||
219835) (SK.FORGET.VIEW 219837 . 221265)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Dec-2025 22:45:39" {WMEDLEY}<library>TEDIT>TEDIT.;847 145111
|
||||
(FILECREATED "13-Nov-2025 21:00:34" {WMEDLEY}<library>TEDIT>TEDIT.;844 144838
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDITCOMS)
|
||||
:CHANGES-TO (FNS TEDIT.INSERT \TEDIT.INSERT)
|
||||
|
||||
:PREVIOUS-DATE "24-Dec-2025 11:23:12" {WMEDLEY}<library>TEDIT>TEDIT.;846)
|
||||
:PREVIOUS-DATE "28-Oct-2025 00:29:56" {WMEDLEY}<library>TEDIT>TEDIT.;843)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDITCOMS)
|
||||
@@ -76,9 +76,8 @@
|
||||
(VARS (TEDITSYSTEMDATE (TEDITSYSTEMDATE]
|
||||
(COMS (* ;
|
||||
"IMAGETYPE Interface, so the system can decide if a file is a TEdit file.")
|
||||
(FNS TEDIT.IMAGESOURCEP)
|
||||
(ALISTS (PRINTFILETYPES TEDIT))
|
||||
(P (DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE])
|
||||
(ADDVARS (PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP)
|
||||
(EXTENSION (TEDIT TED])
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
POSTSCRIPTSTREAM PDFSTREAM WHEELSCROLL)
|
||||
@@ -2318,40 +2317,30 @@
|
||||
|
||||
(* ; "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.IMAGESOURCEP
|
||||
[LAMBDA (X) (* ; "Edited 23-Dec-2025 11:26 by rmk")
|
||||
(OR (TEXTSTREAM X T)
|
||||
(TEDIT.FORMATTEDFILEP X])
|
||||
)
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST TEDIT.IMAGESOURCEP)
|
||||
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP)
|
||||
(EXTENSION (TEDIT TED))))
|
||||
|
||||
(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 (4838 7232 (MAKE-TEDIT-EXPORTS.ALL 4848 . 5394) (UPDATE-TEDIT 5396 . 6325) (EDIT-TEDIT
|
||||
6327 . 7230)) (8662 36440 (TEDIT 8672 . 11286) (TEXTSTREAM 11288 . 13177) (TEXTSTREAMP 13179 . 13563)
|
||||
(COERCETEXTSTREAM 13565 . 17776) (TEDIT.CONCAT 17778 . 21080) (TEDITSTRING 21082 . 21996) (TEDIT-SEE
|
||||
21998 . 22682) (TEDIT.COPY 22684 . 24829) (TEDIT.DELETE 24831 . 26192) (TEDIT.INSERT 26194 . 29163) (
|
||||
TEDIT.TERPRI 29165 . 30279) (TEDIT.KILL 30281 . 31263) (TEDIT.QUIT 31265 . 32631) (TEDIT.MOVE 32633 .
|
||||
33521) (TEDIT.STRINGWIDTH 33523 . 34194) (TEDIT.CHARWIDTH 34196 . 36438)) (36441 38382 (TEXTOBJ 36451
|
||||
. 36916) (COERCETEXTOBJ 36918 . 38380)) (39782 41432 (TDRIBBLE 39792 . 41430)) (41473 53369 (
|
||||
TEDIT.INSERT.OBJECT 41483 . 45190) (TEDIT.EDIT.OBJECT 45192 . 48132) (TEDIT.OBJECT.CHANGED 48134 .
|
||||
51324) (TEDIT.MAP.OBJECTS 51326 . 52897) (\TEDIT.FIRST.OBJPIECE 52899 . 53132) (\TEDIT.NEXT.OBJPIECE
|
||||
53134 . 53367)) (53392 60835 (\TEDIT.CONCAT.PAGEFRAMES 53402 . 58469) (\TEDIT.GET.PAGE.HEADINGS 58471
|
||||
. 59500) (\TEDIT.CONCAT.INSTALL.HEADINGS 59502 . 60833)) (60836 64443 (\TEDIT.MOVE.MSG 60846 . 62927)
|
||||
(\TEDIT.READONLY 62929 . 64441)) (64444 70335 (TEDIT.NCHARS 64454 . 64827) (TEDIT.RPLCHARCODE 64829
|
||||
. 67819) (TEDIT.NTHCHARCODE 67821 . 69864) (TEDIT.NTHCHAR 69866 . 70333)) (70381 127158 (\TEDIT1
|
||||
70391 . 72468) (\TEDIT.INSERT 72470 . 78583) (\TEDIT.MOVE 78585 . 86491) (\TEDIT.COPY 86493 . 91024) (
|
||||
\TEDIT.REPLACE.SELPIECES 91026 . 95562) (\TEDIT.INSERT.SELPIECES 95564 . 98561) (\TEDIT.RESTARTFN
|
||||
98563 . 101068) (\TEDIT.CHARDELETE 101070 . 103999) (\TEDIT.COPYPIECE 104001 . 109163) (
|
||||
\TEDIT.APPLY.OBJFN 109165 . 112251) (\TEDIT.DELETE 112253 . 116621) (\TEDIT.DIFFUSE.PARALOOKS 116623
|
||||
. 118894) (\TEDIT.WORDDELETE 118896 . 120511) (\TEDIT.WORDDELETE.FORWARD 120513 . 122302) (
|
||||
\TEDIT.FINISHEDIT? 122304 . 127156)) (127159 127818 (\TEDIT.THELP 127169 . 127816)) (127852 136983 (
|
||||
\TEDIT.PARAPIECES 127862 . 129836) (\TEDIT.PARACHNOS 129838 . 130730) (\TEDIT.PARA.FIRST 130732 .
|
||||
133833) (\TEDIT.PARA.LAST 133835 . 136981)) (136984 144079 (\TEDIT.WORD.FIRST 136994 . 140998) (
|
||||
\TEDIT.WORD.LAST 141000 . 144077)) (144280 144557 (TEDITSYSTEMDATE 144290 . 144555)))))
|
||||
STOP
|
||||
|
||||
@@ -1,276 +1,223 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "13-Jan-2026 17:51:55" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;55 18063
|
||||
(FILECREATED " 5-Sep-2025 18:50:19"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;29 17935
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
|
||||
(VARS TEDIT-ABBREVCOMS)
|
||||
:CHANGES-TO (VARS TEDIT-ABBREVCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 8-Jan-2026 09:09:58" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;53)
|
||||
:PREVIOUS-DATE " 5-Sep-2025 12:24:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;28)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
||||
|
||||
(RPAQQ TEDIT-ABBREVCOMS
|
||||
[(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.EXPANSION \TEDIT.ABBREV.TREE \TEDIT.ABBREV.PARSE
|
||||
\TEDIT.ABBREV.PARSE.CHARCODE)
|
||||
(FNS \TEDIT.EXPAND.DATE)
|
||||
(GLOBALVARS TEDIT.ABBREVS \TEDIT.ABBREVS.TREE \TEDIT.ABBREVS.INTREE)
|
||||
(INITVARS (\TEDIT.ABBREVS.TREE NIL)
|
||||
(\TEDIT.ABBREVS.INTREE NIL)
|
||||
(TEDIT.ABBREVS '(("b" "357,146" Bullet)
|
||||
("n" "357,44" Endash)
|
||||
("--" "357,44" Endash)
|
||||
("m" EMDASH)
|
||||
("---" EMDASH)
|
||||
("T" THINSPACE)
|
||||
("d" "357,60" Dagger)
|
||||
("D" "357,61" DoubleDagger)
|
||||
("s" "0,247" Section)
|
||||
("'" "0,271" RSQ)
|
||||
("`" "0,251" LSQ)
|
||||
("%"" LEFT-DOUBLEQUOTE)
|
||||
("~" RIGHT-DOUBLEQUOTE)
|
||||
("1/4" "0,274")
|
||||
("1/2" "0,275")
|
||||
("3/4" "0,276")
|
||||
("1/3" "357,375")
|
||||
("2/3" "357,376")
|
||||
("c" "0,323" Copyright)
|
||||
("c/o" "357,100" c/o)
|
||||
("%%" "357,100" c/o)
|
||||
("->" "0,256" Rightarrow)
|
||||
("ra" "0,256" Rightarrow)
|
||||
("|" "0,257" Downarrow)
|
||||
("da" "0,257" Downarrow)
|
||||
("L" "0,243" English-pound)
|
||||
("o" "0,260" Degree)
|
||||
("Y" "0,245" Yen)
|
||||
("+-" "0,261" PlusMinus)
|
||||
("x" "0,264" Times)
|
||||
("/" "0,270" Divide)
|
||||
("lra" "357,121")
|
||||
("p" "0,266" Paragraph)
|
||||
("r" "0,322" Register)
|
||||
("t" "0,324" Trademark)
|
||||
("tm" "0,324" Trademark)
|
||||
("bbox" "42,43" Blackbox)
|
||||
("wbox" "43,42" Whitebox)
|
||||
("-" SOFT-HYPHEN)
|
||||
("=" NONBREAKING-HYPHEN)
|
||||
("nbsp" NONBREAKING-SPACE)
|
||||
(" " NONBREAKING-SPACE "original, but deprecated")
|
||||
("un" "357,127")
|
||||
("int" "357,126")
|
||||
("subset" "357,131")
|
||||
("superset" "357,130")
|
||||
("&" "357,266")
|
||||
("or" "357,267")
|
||||
("not" "357,152")
|
||||
("all" "357,265")
|
||||
("exist" "357,264")
|
||||
("def" "357,162")
|
||||
(in "357,112" Member)
|
||||
("compose" "357,147")
|
||||
("!" "0,241")
|
||||
(* ; " Inverted !")
|
||||
("?" "0,277")
|
||||
(* ; " Inverted ?")
|
||||
("u" "0,265" MicroSign)
|
||||
("<<" "0,253")
|
||||
(* ; " Left double guillemet")
|
||||
(">>" "0,273")
|
||||
(* ; " Right double guillemet")
|
||||
("DATE" \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" \TEDIT.EXPAND.DATE])
|
||||
[(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.PARSE \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
(INITVARS (TEDIT.ABBREVS '(("b" "357,146" Bullet)
|
||||
("n" "357,44" Endash)
|
||||
("--" "357,44" Endash)
|
||||
("m" EMDASH)
|
||||
("---" EMDASH)
|
||||
("T" THINSPACE)
|
||||
("d" "357,60" Dagger)
|
||||
("D" "357,61" DoubleDagger)
|
||||
("s" "0,247" Section)
|
||||
("'" "0,271" RSQ)
|
||||
("`" "0,251" LSQ)
|
||||
("%"" LEFT-DOUBLEQUOTE)
|
||||
("~" RIGHT-DOUBLEQUOTE)
|
||||
("1/4" "0,274")
|
||||
("1/2" "0,275")
|
||||
("3/4" "0,276")
|
||||
("1/3" "357,375")
|
||||
("2/3" "357,376")
|
||||
("c" "0,323" Copyright)
|
||||
("c/o" "357,100" c/o)
|
||||
("%%" "357,100" c/o)
|
||||
("->" "0,256" Rightarrow)
|
||||
("ra" "0,256" Rightarrow)
|
||||
("|" "0,257" Downarrow)
|
||||
("da" "0,257" Downarrow)
|
||||
("L" "0,243" English-pound)
|
||||
("o" "0,260" Degree)
|
||||
("Y" "0,245" Yen)
|
||||
("+" "0,261" PlusMinus)
|
||||
("x" "0,264" Times)
|
||||
("/" "0,270" Divide)
|
||||
("=" "357,121")
|
||||
("p" "0,266" Paragraph)
|
||||
("r" "0,322" Register)
|
||||
("t" "0,324" Trademark)
|
||||
("tm" "0,324" Trademark)
|
||||
("bbox" "42,43" Blackbox)
|
||||
("wbox" "43,42" Whitebox)
|
||||
("-" SOFT-HYPHEN)
|
||||
("=" NONBREAKING-HYPHEN)
|
||||
(" " NONBREAKING-SPACE)
|
||||
("un" "357,127")
|
||||
("int" "357,126")
|
||||
("subset" "357,131")
|
||||
("superset" "357,130")
|
||||
("&" "357,266")
|
||||
("or" "357,267")
|
||||
("not" "357,152")
|
||||
("all" "357,265")
|
||||
("exist" "357,264")
|
||||
("def" "357,162")
|
||||
("compose" "357,147")
|
||||
("DATE" \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" \TEDIT.EXPAND.DATE])
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.ABBREV.EXPAND
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "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")
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 20-Apr-2025 23:30 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 30-May-91 19:27 by jds")
|
||||
(* ; "Expand an abbvreviation")
|
||||
(\TEDIT.ABBREV.TREE)
|
||||
(LET ((CANDIDATES (\TEDIT.ABBREV.PARSE TSTREAM SEL))
|
||||
CAND EXPANSION)
|
||||
|
||||
(* ;; "If a point selection (DCH <= 1), let the tree control the match, otherwise stop at the beginning of the selection. If the character before the caret is \, then the match string consists of all characters between that \ and the first preceding one.")
|
||||
(* ;; "Candidates are ordered longest first, so D doesn't override EMDASH.")
|
||||
|
||||
(LET* ((LASTCHNO (GETSEL SEL CHLAST))
|
||||
(POINTSELECTION (ILEQ (FGETSEL SEL DCH)
|
||||
1))
|
||||
(FIRSTCHNO (CL:IF POINTSELECTION
|
||||
1
|
||||
(FGETSEL SEL CH#)))
|
||||
BACKSLASH ABBREV EXPANSION LEN)
|
||||
(CL:WHEN (MEMB (TEDIT.NTHCHARCODE TSTREAM LASTCHNO)
|
||||
(CHARCODE (EOL FORM Meta,EOL)))
|
||||
(* ;; "Try literal match first, then fiddle the case.")
|
||||
|
||||
(* ;; "Line or paragraph selection: back up over the terminator. Maybe we should back up over spaces too--except for the no-breaking space abbreviation?")
|
||||
(* ;; "If we don't find it in abbrevs, try for a character code.")
|
||||
|
||||
(add LASTCHNO -1))
|
||||
(CL:WHEN (EQ (CHARCODE \)
|
||||
(TEDIT.NTHCHARCODE TSTREAM LASTCHNO)) (* ;
|
||||
"But if selection ends with \, go back to previous \ to match/consume \xxx\ ")
|
||||
(SETQ BACKSLASH T) (* ;
|
||||
"Started with backslash, extend match")
|
||||
(SETQ POINTSELECTION NIL)
|
||||
(for I CH from (SUB1 LASTCHNO) by -1 as J from 1 to 25
|
||||
do (SETQ CH (TEDIT.NTHCHARCODE TSTREAM I)) (* ; "Don't cross over an image obj")
|
||||
(if (IMAGEOBJP CH)
|
||||
then (RETURN)
|
||||
elseif (EQ CH (CHARCODE \))
|
||||
then (SETQ FIRSTCHNO I)
|
||||
(RETURN)))
|
||||
(add LASTCHNO -1))
|
||||
(if (AND FIRSTCHNO [SETQ ABBREV (OR (\TEDIT.ABBREV.PARSE TSTREAM FIRSTCHNO LASTCHNO
|
||||
POINTSELECTION)
|
||||
(\TEDIT.ABBREV.PARSE TSTREAM FIRSTCHNO LASTCHNO
|
||||
POINTSELECTION T)
|
||||
(CL:UNLESS POINTSELECTION (\TEDIT.ABBREV.PARSE.CHARCODE
|
||||
TSTREAM FIRSTCHNO LASTCHNO]
|
||||
(SETQ EXPANSION (\TEDIT.ABBREV.EXPANSION ABBREV TSTREAM)))
|
||||
then (SETQ LEN (NCHARS (CAR ABBREV)))
|
||||
(SETQ FIRSTCHNO (ADD1 (IDIFFERENCE LASTCHNO LEN)))
|
||||
(CL:WHEN BACKSLASH (* ;
|
||||
"LASTCHNO and LEN include the final backslash")
|
||||
(add LASTCHNO 1)
|
||||
(add LEN 1))
|
||||
(\TEDIT.UPDATE.SEL SEL FIRSTCHNO LEN 'RIGHT 'NORMAL)
|
||||
(* ; "Set the target")
|
||||
(\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)
|
||||
T)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
|
||||
|
||||
(\TEDIT.ABBREV.EXPANSION
|
||||
[LAMBDA (ABBREV TSTREAM) (* ; "Edited 2-Jan-2026 22:46 by rmk")
|
||||
(* ; "Edited 6-Sep-2025 00:09 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
(* jds "11-Jul-85 12:46")
|
||||
|
||||
(* ;; "Decode the expansion:")
|
||||
|
||||
(* ;; " A string may be a character name, otherwise itself. ")
|
||||
|
||||
(* ;;
|
||||
" A litatom may be a character name,otherwise it is a function (if it has a GETD) to be applied.")
|
||||
|
||||
(* ;; " Anything else is evaled. ")
|
||||
|
||||
(LET ((KEY (CAR ABBREV))
|
||||
(EXPANSION (CADR ABBREV))
|
||||
CH)
|
||||
(CL:WHEN (LISTP EXPANSION) (* ;
|
||||
"Originally stored in the CDR. Now can be followed by comments")
|
||||
(SETQ EXPANSION (CAR EXPANSION)))
|
||||
(if (NULL EXPANSION)
|
||||
then
|
||||
(* ;; "So basically you can use any character name to insert its character")
|
||||
|
||||
(CL:WHEN (SETQ CH (CHARCODE.DECODE KEY T))
|
||||
(CHARACTER CH))
|
||||
elseif (AND (OR (STRINGP EXPANSION)
|
||||
(LITATOM EXPANSION))
|
||||
(SETQ CH (CHARCODE.DECODE EXPANSION T)))
|
||||
then
|
||||
(* ;; "Could be a character code")
|
||||
|
||||
(CHARACTER CH)
|
||||
elseif (STRINGP EXPANSION)
|
||||
then
|
||||
(* ;; " Could be a character code")
|
||||
|
||||
(CL:IF (SETQ CH (CHARCODE.DECODE EXPANSION T))
|
||||
(CHARACTER CH)
|
||||
EXPANSION)
|
||||
elseif (SMALLP EXPANSION)
|
||||
then
|
||||
(* ;; "Treat a number as a character code.")
|
||||
|
||||
(CHARACTER EXPANSION)
|
||||
elseif (AND (LITATOM EXPANSION)
|
||||
(OR (SETQ CH (CHARCODE.DECODE EXPANSION T))
|
||||
(GETD EXPANSION)))
|
||||
then (* ;
|
||||
" Either a character name or a function")
|
||||
(CL:IF CH
|
||||
(CHARACTER CH)
|
||||
(APPLY* EXPANSION TSTREAM KEY))
|
||||
elseif (LISTP EXPANSION)
|
||||
then (* ; "Form in the CADR, now")
|
||||
(EVAL EXPANSION)
|
||||
elseif (AND (SETQ EXPANSION (CDR (SASSOC KEY TEDIT.ABBREVS)))
|
||||
(LITATOM (CAR EXPANSION))
|
||||
(GETD (CAR EXPANSION)))
|
||||
then
|
||||
(* ;; "Form in the CDR, originally. Have to refetch EXPANSION")
|
||||
|
||||
(EVAL EXPANSION])
|
||||
|
||||
(\TEDIT.ABBREV.TREE
|
||||
[LAMBDA (ALWAYS) (* ; "Edited 6-Jan-2026 22:02 by rmk")
|
||||
(* ; "Edited 4-Jan-2026 09:01 by rmk")
|
||||
(CL:UNLESS (AND (NOT ALWAYS)
|
||||
(EQUAL TEDIT.ABBREVS \TEDIT.ABBREVS.INTREE))
|
||||
(SETQ \TEDIT.ABBREVS.TREE NIL)
|
||||
(for A in TEDIT.ABBREVS unless (EQ (CAR A)
|
||||
'*)
|
||||
do (STOREMULTI \TEDIT.ABBREVS.TREE [DREVERSE (LIST* 'ABBREV (UNPACK (CAR A]
|
||||
A)
|
||||
(CL:UNLESS (EQ '\ (NTHCHAR (CAR A)
|
||||
1)) (* ;
|
||||
"Backslash at the beginning, if not already there, like Tex: \cup")
|
||||
(SETQ A (CONS (PACK* "\" (CAR A))
|
||||
(CDR A)))
|
||||
(STOREMULTI \TEDIT.ABBREVS.TREE [DREVERSE (LIST* 'ABBREV (UNPACK (CAR A]
|
||||
A)))
|
||||
(SETQ \TEDIT.ABBREVS.INTREE TEDIT.ABBREVS)
|
||||
\TEDIT.ABBREVS.TREE)])
|
||||
[SETQ CAND (OR (find C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(CAR C)
|
||||
TSTREAM)))
|
||||
(for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(U-CASE (CAR C))
|
||||
TSTREAM)))
|
||||
(for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(L-CASE (CAR C))
|
||||
TSTREAM]
|
||||
(if EXPANSION
|
||||
then (\TEDIT.UPDATE.SEL SEL (CADR CAND)
|
||||
(CADDR CAND)
|
||||
'RIGHT
|
||||
'NORMAL) (* ; "Set the target")
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
|
||||
(PCHARLOOKS (\TEDIT.CHTOPC (CADR CAND)
|
||||
TEXTOBJ)))
|
||||
TSTREAM SEL)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
|
||||
|
||||
(\TEDIT.ABBREV.PARSE
|
||||
[LAMBDA (TSTREAM FIRSTCHNO LASTCHNO POINTSELECTION CASEINSENSITIVE)
|
||||
(* ; "Edited 7-Jan-2026 09:55 by rmk")
|
||||
(* ; "Edited 3-Jan-2026 22:50 by rmk")
|
||||
[LAMBDA (TSTREAM SEL) (* ; "Edited 11-Aug-2025 14:40 by rmk")
|
||||
(* ; "Edited 7-Aug-2025 12:50 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 23:45 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 10:11 by rmk")
|
||||
(* ; "Edited 23-Mar-2025 17:08 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 22:21 by rmk")
|
||||
|
||||
(* ;; "But if LA")
|
||||
(* ;; "This produces candidate abbreviation-strings by parsing the characters around the point. Each candidate is returned as a list (KEY STARTCH# LEN).")
|
||||
|
||||
(for CHNO CH MATCH (DCH _ (ADD1 (IDIFFERENCE LASTCHNO FIRSTCHNO)))
|
||||
(TREE _ \TEDIT.ABBREVS.TREE) by -1 from LASTCHNO to FIRSTCHNO
|
||||
while [PROGN (SETQ CH (TEDIT.NTHCHAR TSTREAM CHNO))
|
||||
(SETQ TREE (CL:IF CASEINSENSITIVE
|
||||
(CL:ASSOC CH TREE :TEST (FUNCTION STRING.EQUAL))
|
||||
(ASSOC CH TREE))] when (SETQ MATCH (CDR (ASSOC 'ABBREV TREE)))
|
||||
do (SETQ $$VAL MATCH) finally
|
||||
(* ;;
|
||||
"It first backs up over any spaces to find the anchor position. The candidates then include")
|
||||
|
||||
(* ;;
|
||||
"Return NIL for a multi-char selection if the longest match doesn't cover the whole thing")
|
||||
(* ;; " The immediately preceding singleton character, if a point selection")
|
||||
|
||||
(CL:UNLESS [OR POINTSELECTION (EQ DCH (NCHARS (CAR MATCH]
|
||||
(RETURN NIL])
|
||||
(* ;; " The remaining (after backing up) characters of the selection.")
|
||||
|
||||
(\TEDIT.ABBREV.PARSE.CHARCODE
|
||||
[LAMBDA (TSTREAM FIRSTCHNO LASTCHNO) (* ; "Edited 7-Jan-2026 21:53 by rmk")
|
||||
(LET ((STRING (TEDIT.SEL.AS.STRING TSTREAM FIRSTCHNO (ADD1 (IDIFFERENCE LASTCHNO FIRSTCHNO))
|
||||
0))
|
||||
CHARCODE)
|
||||
(CL:WHEN (SETQ CHARCODE (CHARCODE.DECODE (CL:IF (EQ (CHARCODE \)
|
||||
(CHCON1 STRING))
|
||||
(SUBSTRING STRING 2)
|
||||
STRING)
|
||||
T))
|
||||
(LIST STRING (CHARACTER CHARCODE)))])
|
||||
)
|
||||
(DEFINEQ
|
||||
(* ;; " The word that contains the caret (backwards and forwards)")
|
||||
|
||||
(* ;; " If the character before a candidate C is a comma, then the word before W before the comma (without or without \) is extracted, and W,C is is added to the list (a possible charname).")
|
||||
|
||||
(* ;; "If the character before a candidate C is \, the \ is included in the replacement span, and \C is also added to the list (Tex style)")
|
||||
|
||||
(* ;; "If one of the candidates is a character name, the abbreviation exapnds to the corresponding character.")
|
||||
|
||||
(* ;; "Otherwise, the candidates are looked up in TEDIT.ABBREVS to find their expansions.")
|
||||
|
||||
(PROG ((PT# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
FIRST# LAST# LEN CANDIDATES KEY NSPACES)
|
||||
|
||||
(* ;; "The abbreviation is taken from the CH# of the current selection. It is either the character just before a point selection, the entire selection, or the word containing the selection.")
|
||||
|
||||
(* ;; " The character at CH#, if it is a point selection")
|
||||
|
||||
(* ;; " Otherwise either the current selection up to and including CH# or the full word that includes the selection. What works is determined by what it finds in the abbreviations list.")
|
||||
|
||||
(* ;; "Back up over spaces")
|
||||
|
||||
(SETQ NSPACES (for I from PT# by -1 while (EQ (CHARCODE SPACE)
|
||||
(\TEDIT.NTHCHARCODE TSTREAM I)) sum 1))
|
||||
(add PT# (IMINUS NSPACES))
|
||||
(CL:WHEN (ZEROP PT#) (* ; "Beginning of document")
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Each candidate is a triple containing the key and the starting character and length of the replacement target..")
|
||||
|
||||
(push CANDIDATES (LIST (MKSTRING (TEDIT.NTHCHAR TSTREAM PT#))
|
||||
PT# 1))
|
||||
(SETQ LEN (IMAX 0 (IDIFFERENCE (FGETSEL SEL DCH)
|
||||
NSPACES))) (* ; "Last singleton predecessor")
|
||||
(CL:WHEN (IGEQ LEN 2) (* ; "At least one more character")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM (FGETSEL SEL CH#)
|
||||
LEN)
|
||||
(FGETSEL SEL CH#)
|
||||
LEN)))
|
||||
(SETQ FIRST# (\TEDIT.WORD.FIRST TSTREAM PT#))
|
||||
(SETQ LEN (ADD1 (IDIFFERENCE PT# FIRST#)))
|
||||
(CL:UNLESS (EQ LEN 1) (* ; "Already there")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
|
||||
FIRST# LEN)))
|
||||
(SETQ LAST# (\TEDIT.WORD.LAST TSTREAM FIRST#))
|
||||
(SETQ LEN (ADD1 (IDIFFERENCE LAST# FIRST#)))
|
||||
(CL:UNLESS (EQ LEN 1) (* ; "Already there")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
|
||||
FIRST# LEN))) (* ; "Extend if a ,")
|
||||
[for C KEY END in CANDIDATES
|
||||
do
|
||||
(* ;; "Comma for MCCS character names, - and / - for internal punctuation (3/4 EMDASH). Adjacent character must be text")
|
||||
|
||||
(if [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C)))
|
||||
(CHARCODE (%, / -)))
|
||||
(EQ (\TEDIT.TTC TEXT)
|
||||
(TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IDIFFERENCE (CADR C)
|
||||
2]
|
||||
then (SETQ END (\TEDIT.WORD.FIRST TSTREAM (IDIFFERENCE (CADR C)
|
||||
2)))
|
||||
(* ; "Comma before, maybe a charname")
|
||||
(SETQ KEY (CONCAT (TEDIT.SEL.AS.STRING TSTREAM END (IDIFFERENCE (CADR C)
|
||||
END))
|
||||
(CAR C)))
|
||||
(push CANDIDATES (LIST KEY END (NCHARS KEY)))
|
||||
elseif [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (IPLUS (CADR C)
|
||||
(CADDR C)))
|
||||
(CHARCODE (%, / -)))
|
||||
(EQ (\TEDIT.TTC TEXT)
|
||||
(TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IPLUS 1 (CADR C)
|
||||
(CADDR C]
|
||||
then [SETQ END (\TEDIT.WORD.LAST TSTREAM (ADD1 (IPLUS (CADR C)
|
||||
(CADDR C]
|
||||
(* ; "Comma after")
|
||||
[SETQ KEY (CONCAT (CAR C)
|
||||
(TEDIT.SEL.AS.STRING TSTREAM (IPLUS (CADR C)
|
||||
(CADDR C))
|
||||
(ADD1 (IDIFFERENCE END (IPLUS (CADR C)
|
||||
(CADDR C]
|
||||
(push CANDIDATES (LIST KEY (CADR C)
|
||||
(NCHARS KEY] (* ;
|
||||
"If preceded by \, include it optionally in the key, always include it in the replacement")
|
||||
(for C in CANDIDATES when [EQ (CHARCODE \)
|
||||
(\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C]
|
||||
do (* ; "Match and replace \KEY")
|
||||
[push CANDIDATES (LIST (CONCAT "\" (CAR C))
|
||||
(SUB1 (CADR C))
|
||||
(ADD1 (CADDR C]
|
||||
(change (CADR C)
|
||||
(SUB1 DATUM)) (* ; "Match KEY but also replace the \")
|
||||
(change (CADDR C)
|
||||
(ADD1 DATUM)))
|
||||
[SORT CANDIDATES (FUNCTION (LAMBDA (C1 C2)
|
||||
(IGEQ (CADDR C1)
|
||||
(CADDR C2] (* ; "Look for longest first")
|
||||
(RETURN CANDIDATES])
|
||||
|
||||
(\TEDIT.EXPAND.DATE
|
||||
[LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds")
|
||||
@@ -285,16 +232,54 @@
|
||||
"August" "September" "October" "November" "December")
|
||||
(ADD1 MONTH)))
|
||||
" " DAY ", " YEAR])
|
||||
|
||||
(\TEDIT.TRY.ABBREV
|
||||
[LAMBDA (KEY TSTREAM) (* ; "Edited 5-Sep-2025 12:24 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
(* jds "11-Jul-85 12:46")
|
||||
|
||||
(* ;; "Decode the expansion. A string may be a character name, otherwise itself. A litatom is a function to be applied, anything else is evaled. ")
|
||||
|
||||
(LET [(ABBREV (CDR (SASSOC KEY TEDIT.ABBREVS]
|
||||
(CL:WHEN (LISTP ABBREV) (* ; "Originally stored in the CDR")
|
||||
(SETQ ABBREV (CAR ABBREV)))
|
||||
(if (NULL ABBREV)
|
||||
then (CL:WHEN (CHARCODE.DECODE KEY T)
|
||||
(CHARACTER (CHARCODE.DECODE KEY T)))
|
||||
elseif (STRINGP ABBREV)
|
||||
then
|
||||
(* ;; "Could be a character code")
|
||||
|
||||
(LET ((CH (CHARCODE.DECODE ABBREV T)))
|
||||
(CL:IF CH
|
||||
(CHARACTER CH)
|
||||
ABBREV))
|
||||
elseif (SMALLP ABBREV)
|
||||
then
|
||||
(* ;; "Treat a number as a character code.")
|
||||
|
||||
(CHARACTER ABBREV)
|
||||
elseif (AND (LITATOM ABBREV)
|
||||
(GETD ABBREV))
|
||||
then (* ; " A function to be applied.")
|
||||
(APPLY* ABBREV TSTREAM KEY)
|
||||
elseif (LISTP ABBREV)
|
||||
then (* ; "Form in the CADR, now")
|
||||
(EVAL ABBREV)
|
||||
elseif (AND (SETQ ABBREV (CDR (SASSOC KEY TEDIT.ABBREVS)))
|
||||
(LITATOM (CAR ABBREV))
|
||||
(GETD (CAR ABBREV)))
|
||||
then
|
||||
(* ;; "Form in the CDR, originally")
|
||||
|
||||
(EVAL ABBREV])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.ABBREVS \TEDIT.ABBREVS.TREE \TEDIT.ABBREVS.INTREE)
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
)
|
||||
|
||||
(RPAQ? \TEDIT.ABBREVS.TREE NIL)
|
||||
|
||||
(RPAQ? \TEDIT.ABBREVS.INTREE NIL)
|
||||
|
||||
(RPAQ? TEDIT.ABBREVS
|
||||
'(("b" "357,146" Bullet)
|
||||
("n" "357,44" Endash)
|
||||
@@ -324,10 +309,10 @@
|
||||
("L" "0,243" English-pound)
|
||||
("o" "0,260" Degree)
|
||||
("Y" "0,245" Yen)
|
||||
("+-" "0,261" PlusMinus)
|
||||
("+" "0,261" PlusMinus)
|
||||
("x" "0,264" Times)
|
||||
("/" "0,270" Divide)
|
||||
("lra" "357,121")
|
||||
("=" "357,121")
|
||||
("p" "0,266" Paragraph)
|
||||
("r" "0,322" Register)
|
||||
("t" "0,324" Trademark)
|
||||
@@ -336,8 +321,7 @@
|
||||
("wbox" "43,42" Whitebox)
|
||||
("-" SOFT-HYPHEN)
|
||||
("=" NONBREAKING-HYPHEN)
|
||||
("nbsp" NONBREAKING-SPACE)
|
||||
(" " NONBREAKING-SPACE "original, but deprecated")
|
||||
(" " NONBREAKING-SPACE)
|
||||
("un" "357,127")
|
||||
("int" "357,126")
|
||||
("subset" "357,131")
|
||||
@@ -348,21 +332,10 @@
|
||||
("all" "357,265")
|
||||
("exist" "357,264")
|
||||
("def" "357,162")
|
||||
(in "357,112" Member)
|
||||
("compose" "357,147")
|
||||
("!" "0,241")
|
||||
(* ; " Inverted !")
|
||||
("?" "0,277")
|
||||
(* ; " Inverted ?")
|
||||
("u" "0,265" MicroSign)
|
||||
("<<" "0,253")
|
||||
(* ; " Left double guillemet")
|
||||
(">>" "0,273")
|
||||
(* ; " Right double guillemet")
|
||||
("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 (3630 16182 (\TEDIT.ABBREV.EXPAND 3640 . 5860) (\TEDIT.ABBREV.PARSE 5862 . 13472) (
|
||||
\TEDIT.EXPAND.DATE 13474 . 14107) (\TEDIT.TRY.ABBREV 14109 . 16180)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Nov-2025 10:03:19" {WMEDLEY}<library>TEDIT>TEDIT-COMMAND.;166 19030
|
||||
(FILECREATED "17-Jul-2025 00:24:49"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;165 19015
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.COMMAND.FUNCTION?)
|
||||
:CHANGES-TO (FNS \TEDIT.COMMAND.RESET.SETUP)
|
||||
|
||||
:PREVIOUS-DATE "17-Jul-2025 00:24:49" {WMEDLEY}<library>TEDIT>TEDIT-COMMAND.;165)
|
||||
:PREVIOUS-DATE "23-Mar-2025 15:27:20"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;163)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
|
||||
@@ -135,8 +137,7 @@
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))])
|
||||
|
||||
(\TEDIT.COMMAND.FUNCTION?
|
||||
[LAMBDA (TSTREAM CHARCODE) (* ; "Edited 8-Nov-2025 10:00 by rmk")
|
||||
(* ; "Edited 23-Mar-2025 15:27 by rmk")
|
||||
[LAMBDA (TSTREAM CHARCODE) (* ; "Edited 23-Mar-2025 15:27 by rmk")
|
||||
(DECLARE (SPECVARS TSTREAM CHARCODE))
|
||||
|
||||
(* ;; "If CHARCODE is a function in TSTREAM's read table, execute the function.")
|
||||
@@ -144,7 +145,7 @@
|
||||
(LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
FN)
|
||||
(DECLARE (SPECVARS TEXTOBJ))
|
||||
(CL:WHEN [AND (EQ (\TEDIT.TTC FN)
|
||||
(CL:WHEN [AND (EQ (\TEDIT.TTC FUNCTIONCALL)
|
||||
(\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL))
|
||||
CHARCODE))
|
||||
(SETQ FN (CAR (fetch MACROFN of (GETHASH CHARCODE (fetch READMACRODEFS
|
||||
@@ -302,7 +303,7 @@
|
||||
(GLOBALVARS || TEDIT.INTERRUPTS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2625 10278 (\TEDIT.COMMAND.LOOP 2635 . 8976) (\TEDIT.COMMAND.FUNCTION? 8978 . 10276)) (
|
||||
10279 18740 (\TEDIT.INTERRUPT.SETUP 10289 . 11936) (\TEDIT.MARKACTIVE 11938 . 12267) (
|
||||
\TEDIT.MARKINACTIVE 12269 . 12485) (\TEDIT.COMMAND.RESET.SETUP 12487 . 18738)))))
|
||||
(FILEMAP (NIL (2709 10263 (\TEDIT.COMMAND.LOOP 2719 . 9060) (\TEDIT.COMMAND.FUNCTION? 9062 . 10261)) (
|
||||
10264 18725 (\TEDIT.INTERRUPT.SETUP 10274 . 11921) (\TEDIT.MARKACTIVE 11923 . 12252) (
|
||||
\TEDIT.MARKINACTIVE 12254 . 12470) (\TEDIT.COMMAND.RESET.SETUP 12472 . 18723)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Jan-2026 11:08:15" {WMEDLEY}<library>tedit>TEDIT-HCPY.;196 32421
|
||||
(FILECREATED "10-Sep-2025 19:05:00" {WMEDLEY}<library>tedit>TEDIT-HCPY.;179 30623
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.IMAGEFILE.MESSAGE TEDIT.FORMAT.HARDCOPY)
|
||||
:CHANGES-TO (VARS TEDIT-HCPYCOMS)
|
||||
|
||||
:PREVIOUS-DATE "24-Dec-2025 11:16:22" {WMEDLEY}<library>tedit>TEDIT-HCPY.;194)
|
||||
:PREVIOUS-DATE " 9-Sep-2025 21:52:28" {WMEDLEY}<library>tedit>TEDIT-HCPY.;177)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
|
||||
@@ -15,10 +15,9 @@
|
||||
((COMS
|
||||
(* ;; "Generic interface functions and common code")
|
||||
|
||||
(FNS TEDIT.HARDCOPY TEDIT.FORMAT.HARDCOPY TEDIT.IMAGEFILE.MESSAGE \TEDIT.PRINT.MENU
|
||||
\TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
\TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX
|
||||
\TEDIT.DISPLAY.DIACRITIC))
|
||||
(FNS TEDIT.HARDCOPY \TEDIT.PRINT.MENU TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE
|
||||
\TEDIT.HARDCOPY.FORMATLINE.HEADINGS \TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYFMTSPEC
|
||||
\TEDIT.INTEGER.IMAGEBOX \TEDIT.DISPLAY.DIACRITIC))
|
||||
(COMS
|
||||
(* ;; "Functions for scaling regions as needed during hardcopy.")
|
||||
|
||||
@@ -28,9 +27,9 @@
|
||||
(INITVARS (TEDIT.DEFAULTPAGEREGION (\TEDIT.SCALEREGION MICASPERINCH
|
||||
(CREATEREGION 1.1 0.75 6.4 9.25]
|
||||
(COMS
|
||||
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. Eliminated postscript, but this still may be screwy")
|
||||
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. THIS IS SCREWY")
|
||||
|
||||
(FNS \TEDIT.HARDCOPYFILEFN))
|
||||
(FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPYFILEFN \TEDIT.POSTSCRIPT.HARDCOPY))
|
||||
[COMS
|
||||
(* ;; "vars for Japanese Line Break")
|
||||
|
||||
@@ -57,120 +56,68 @@
|
||||
|
||||
(TEDIT.HARDCOPY
|
||||
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS)
|
||||
(* ; "Edited 17-Dec-2025 01:06 by rmk")
|
||||
(* ; "Edited 6-Mar-2024 23:33 by rmk")
|
||||
(* ; "Edited 5-Jan-88 16:09 by jds")
|
||||
|
||||
(* ;; "Send the text to a printer, unless DONTSEND. If DONTSEND and we can't find a server, we'll get the DEFAULTPRINTERTYPE.")
|
||||
|
||||
(CL:UNLESS SERVER
|
||||
(SETQ SERVER (CAR (DEFAULTPRINTERS))))
|
||||
(CL:UNLESS SERVER (SETQ SERVER DEFAULTPRINTINGHOST))
|
||||
(COND
|
||||
[(OR SERVER DONTSEND)
|
||||
(for IMAGETYPE in (PRINTERPROP (PRINTERTYPE SERVER)
|
||||
'CANPRINT)
|
||||
do (RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS
|
||||
do (RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS
|
||||
IMAGETYPE)) finally (ERROR (CONCAT "Can't print TEDIT documents on a "
|
||||
(PRINTERTYPE SERVER)
|
||||
" printer."]
|
||||
(T (TEDIT.PROMPTPRINT (TEXTOBJ STREAM)
|
||||
"Can't HARDCOPY: No print server specified." T])
|
||||
|
||||
(TEDIT.FORMAT.HARDCOPY
|
||||
[LAMBDA (TSTREAM IMAGESTREAM DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG
|
||||
ENDPG QUIET) (* ; "Edited 15-Jan-2026 08:52 by rmk")
|
||||
(* ; "Edited 14-Dec-2025 17:40 by rmk")
|
||||
(* ; "Edited 8-Dec-2025 18:08 by rmk")
|
||||
(* ; "Edited 7-Dec-2025 15:06 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 22:04 by rmk")
|
||||
(* ; "Edited 18-Sep-2025 10:11 by rmk")
|
||||
(* ; "Edited 12-Sep-2025 23:54 by rmk")
|
||||
(* ; "Edited 5-Jun-2025 08:24 by rmk")
|
||||
(* ; "Edited 22-Apr-2025 08:12 by rmk")
|
||||
(* ; "Edited 30-Aug-2024 15:45 by rmk")
|
||||
(* ; "Edited 5-Apr-2024 08:01 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 23:39 by rmk")
|
||||
(* ; "Edited 15-Nov-2023 23:56 by rmk")
|
||||
(* ; "Edited 4-Jul-2023 11:16 by rmk")
|
||||
(* ; "Edited 2-Oct-2022 00:00 by rmk")
|
||||
(* ;
|
||||
"Edited 25-May-93 13:06 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "Format a document for hardcopy. Returns NIL if the before-print-fn said not to print.")
|
||||
|
||||
(* ;; "TEXTSTREAM is either already a textstream or somehow denotes a tedit-formatted file, otherwise an error. We don't here try to decide that a non-formatted file is a plain text file, as opposed binary or anything else.")
|
||||
|
||||
(RESETLST
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
(LET [(IMAGEFILE (TEDIT.TO.IMAGEFILE TSTREAM IMAGESTREAM (OR IMAGETYPE DEFAULTPRINTERTYPE)
|
||||
`(,@PRINTOPTIONS FIRSTPG# ,FIRSTPG# STARTPG ,STARTPG ENDPG
|
||||
,ENDPG DOCUMENT.NAME ,BREAKPAGETITLE]
|
||||
(CL:UNLESS (OR DONTSEND (EQ IMAGEFILE IMAGESTREAM))
|
||||
|
||||
(* ;; "If the caller gave us an already open image stream, not just a filename (or NIL), we assume that the caller will close it and send to the printer, if necessary.")
|
||||
|
||||
(SEND.FILE.TO.PRINTER IMAGEFILE SERVER `(DOCUMENT.NAME ,BREAKPAGETITLE
|
||||
,@PRINTOPTIONS DOCUMENT.NAME
|
||||
"TEdit Hardcopy Output")))
|
||||
(CL:UNLESS QUIET (TEDIT.IMAGEFILE.MESSAGE TSTREAM SERVER))
|
||||
IMAGEFILE))])
|
||||
|
||||
(TEDIT.IMAGEFILE.MESSAGE
|
||||
[LAMBDA (TSTREAM SERVER) (* ; "Edited 15-Jan-2026 11:07 by rmk")
|
||||
(* ; "Edited 14-Dec-2025 17:40 by rmk")
|
||||
|
||||
(* ;; "Description of last imagefile goes in promptwindow")
|
||||
|
||||
(LET* [(LASTIMAGEFILE (GETTEXTPROP TSTREAM 'LASTIMAGEFILE))
|
||||
(NPAGES (pop LASTIMAGEFILE))
|
||||
(IMAGEFILE (pop LASTIMAGEFILE))
|
||||
(PRINTERNAME (OR (pop LASTIMAGEFILE)
|
||||
(CL:IF (LISTP SERVER)
|
||||
(CADR SERVER)
|
||||
SERVER)]
|
||||
(TEDIT.PROMPTPRINT TSTREAM [CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES)
|
||||
""
|
||||
"s")
|
||||
(if PRINTERNAME
|
||||
then (CONCAT " printed on " PRINTERNAME)
|
||||
elseif (STREAMP IMAGEFILE)
|
||||
then " printed"
|
||||
else (CONCAT " on " (PSEUDOFILENAME IMAGEFILE]
|
||||
T])
|
||||
|
||||
(\TEDIT.PRINT.MENU
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 17-Dec-2025 00:09 by rmk")
|
||||
(* ; "Edited 14-Dec-2025 17:38 by rmk")
|
||||
(* ; "Edited 13-Dec-2025 08:35 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 07:43 by rmk")
|
||||
(* ; "Edited 28-Jun-2024 22:09 by rmk")
|
||||
(* ; "Edited 25-Jun-2023 13:16 by rmk")
|
||||
(SETQ TSTREAM (TEXTSTREAM (GETTOBJ (TEXTOBJ TSTREAM)
|
||||
PRIMARYPANE)))
|
||||
(TEDIT.PROMPTCLEAR TSTREAM) (* ; "Edited 6-Jun-2023 17:48 by rmk")
|
||||
(LET (FILE&TYPE)
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 28-Jun-2024 22:09 by rmk")
|
||||
(* ; "Edited 25-Jun-2023 13:16 by rmk")
|
||||
(* ; "Edited 6-Jun-2023 17:48 by rmk")
|
||||
(LET ((W (GETTOBJ (TEXTOBJ TSTREAM)
|
||||
PRIMARYPANE)))
|
||||
(SELECTQ [MENU (create MENU
|
||||
ITEMS _ '(("Print to a file" 'FILE
|
||||
"Puts image on a file; prompts for filename and format"
|
||||
)
|
||||
("Send to a printer" 'PRINTER
|
||||
"Sends image to a printer of your choosing"]
|
||||
(FILE [LET [(FILENAME (GETTEXTPROP TSTREAM 'FILENAME]
|
||||
(CL:WHEN FILENAME
|
||||
(SETQ FILENAME (PACKFILENAME
|
||||
'VERSION NIL 'EXTENSION
|
||||
[L-CASE (CAR (EXTENSIONS.FOR.IMAGEFILETYPE
|
||||
(CAR (PRINTERPROP (PRINTERTYPE
|
||||
:DEFAULTPRINTER)
|
||||
'CANPRINT]
|
||||
'BODY FILENAME)))
|
||||
(CL:WHEN (SETQ FILE&TYPE (GetImageFile FILENAME))
|
||||
(TEDIT.TO.IMAGEFILE TSTREAM (CAR FILE&TYPE)
|
||||
(CDR FILE&TYPE)))])
|
||||
(PRINTER [SEND.FILE.TO.PRINTER TSTREAM (GetPrinterName)
|
||||
`(HEADING ,(GETTEXTPROP TSTREAM 'FILENAME])
|
||||
NIL)
|
||||
(TEDIT.IMAGEFILE.MESSAGE TSTREAM])
|
||||
(FILE (HARDCOPYIMAGEW.TOFILE W))
|
||||
(PRINTER (HARDCOPYIMAGEW.TOPRINTER W))
|
||||
NIL])
|
||||
|
||||
(TEDIT.HCPYFILE
|
||||
[LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 29-Jun-2024 16:33 by rmk")
|
||||
(* ; "Edited 4-Oct-2022 09:23 by rmk")
|
||||
(* ; "Edited 1-Oct-2022 22:12 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:36 by mitani")
|
||||
|
||||
(* ;; "Create a hardcopy-format FILE from the text on TSTREAM, with the file type depending on what the default printer is.")
|
||||
|
||||
(LET ([IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE)
|
||||
'CANPRINT]
|
||||
(TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
FILENM TXTFILE)
|
||||
(CL:WHEN [SETQ FILENM (OR FILE (\TEDIT.MAKEFILENAME
|
||||
(TEDIT.GETINPUT TEXTOBJ (CONCAT IMAGETYPE " file name: ")
|
||||
(COND
|
||||
((type? STREAM (SETQ TXTFILE (fetch (TEXTOBJ
|
||||
TXTFILE)
|
||||
of TEXTOBJ)))
|
||||
(* ;
|
||||
"There was a file, so supply default")
|
||||
(PACKFILENAME 'VERSION NIL 'EXTENSION
|
||||
(OR (CAR (PRINTFILETYPE IMAGETYPE
|
||||
'EXTENSION))
|
||||
'HCPY)
|
||||
'BODY
|
||||
(fetch (STREAM FULLFILENAME) of TXTFILE]
|
||||
(if FILENM
|
||||
then (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
|
||||
|
||||
(\TEDIT.HARDCOPY.DISPLAYLINE
|
||||
[LAMBDA (TSTREAM LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 21-Apr-2025 19:02 by rmk")
|
||||
@@ -468,12 +415,31 @@
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"Support for the window-menu's HARDCOPY button, LISTFILES, etc. Eliminated postscript, but this still may be screwy"
|
||||
)
|
||||
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. THIS IS SCREWY")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.HARDCOPYFN
|
||||
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 13-Dec-2024 22:33 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 14:42 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:49 by rmk")
|
||||
(* ; "Edited 25-Sep-2023 16:29 by rmk")
|
||||
(* ; "Edited 4-Jul-2023 11:16 by rmk")
|
||||
(* ; "Edited 21-Sep-2021 15:33 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")
|
||||
|
||||
(LET ((TEXTSTREAM (TEXTSTREAM WINDOW)))
|
||||
|
||||
(* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it. Please don't remove this binding!")
|
||||
|
||||
(TEDIT.FORMAT.HARDCOPY (CL:IF (FGETTOBJ (TEXTOBJ WINDOW)
|
||||
MENUFLG)
|
||||
(\TEDIT.MAINW WINDOW)
|
||||
WINDOW)
|
||||
IMAGESTREAM])
|
||||
|
||||
(\TEDIT.HARDCOPYFILEFN
|
||||
[LAMBDA (W EXT) (* ; "Edited 25-Sep-2023 16:19 by rmk")
|
||||
(LET [(STRM (OR (GETTOBJ (TEXTOBJ W)
|
||||
@@ -486,6 +452,22 @@
|
||||
(PACKFILENAME 'VERSION NIL 'EXTENSION (OR EXT 'IMAGEFILE)
|
||||
'BODY
|
||||
(FULLNAME STRM)))])
|
||||
|
||||
(\TEDIT.POSTSCRIPT.HARDCOPY
|
||||
[LAMBDA (FILE PFILE) (* ; "Edited 4-Oct-2022 10:40 by rmk")
|
||||
(* ; "Edited 1-Oct-2022 22:08 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:35 by mitani")
|
||||
|
||||
(* ;; "Send the document FILE to the printer (or to a print file, as determined by PFILE).")
|
||||
|
||||
(CL:WITH-OPEN-STREAM (TEXT-STREAM (OPENTEXTSTREAM FILE))
|
||||
(RESETLST
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE (TEXTOBJ TEXT-STREAM))
|
||||
'(AND (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
[RESETSAVE NIL `(AND (CLOSEF? ',PFILE]
|
||||
(replace (TEXTOBJ EDITOPACTIVE) of (TEXTOBJ TEXT-STREAM) with 'Hardcopy)
|
||||
(TEDIT.FORMAT.HARDCOPY TEXT-STREAM PFILE T NIL NIL NIL 'POSTSCRIPT)
|
||||
PFILE)])
|
||||
)
|
||||
|
||||
|
||||
@@ -523,10 +505,11 @@
|
||||
(CLOSEF DOC])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2727 29208 (TEDIT.HARDCOPY 2737 . 3995) (TEDIT.FORMAT.HARDCOPY 3997 . 7234) (
|
||||
TEDIT.IMAGEFILE.MESSAGE 7236 . 8533) (\TEDIT.PRINT.MENU 8535 . 10938) (\TEDIT.HARDCOPY.DISPLAYLINE
|
||||
10940 . 20163) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 20165 . 21894) (\TEDIT.HARDCOPY.MODIFYLOOKS 21896
|
||||
. 24077) (\TEDIT.HCPYFMTSPEC 24079 . 27537) (\TEDIT.INTEGER.IMAGEBOX 27539 . 28210) (
|
||||
\TEDIT.DISPLAY.DIACRITIC 28212 . 29206)) (29283 30113 (\TEDIT.SCALEREGION 29293 . 30111)) (30405 30978
|
||||
(\TEDIT.HARDCOPYFILEFN 30415 . 30976)) (31597 32398 (TEDIT-BOOK 31607 . 32396)))))
|
||||
(FILEMAP (NIL (2652 25209 (TEDIT.HARDCOPY 2662 . 3795) (\TEDIT.PRINT.MENU 3797 . 4763) (TEDIT.HCPYFILE
|
||||
4765 . 6939) (\TEDIT.HARDCOPY.DISPLAYLINE 6941 . 16164) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 16166 .
|
||||
17895) (\TEDIT.HARDCOPY.MODIFYLOOKS 17897 . 20078) (\TEDIT.HCPYFMTSPEC 20080 . 23538) (
|
||||
\TEDIT.INTEGER.IMAGEBOX 23540 . 24211) (\TEDIT.DISPLAY.DIACRITIC 24213 . 25207)) (25284 26114 (
|
||||
\TEDIT.SCALEREGION 25294 . 26112)) (26367 29180 (TEDIT.HARDCOPYFN 26377 . 27682) (
|
||||
\TEDIT.HARDCOPYFILEFN 27684 . 28245) (\TEDIT.POSTSCRIPT.HARDCOPY 28247 . 29178)) (29799 30600 (
|
||||
TEDIT-BOOK 29809 . 30598)))))
|
||||
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 " 6-Oct-2025 20:50:59" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;459 155349
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-LOOKSCOMS)
|
||||
:CHANGES-TO (FNS \TEDIT.MCCS.TRANSLATE)
|
||||
|
||||
:PREVIOUS-DATE " 6-Oct-2025 20:50:59" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;459)
|
||||
:PREVIOUS-DATE " 5-Oct-2025 10:57:43" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;457)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
|
||||
@@ -60,6 +60,7 @@
|
||||
(* ;; "Public entries")
|
||||
|
||||
(FNS TEDIT.LOOKS TEDIT.GET.LOOKS TEDIT.SUBLOOKS TEDIT.FINDLOOKS)
|
||||
[INITVARS (TEDIT.FONTCLASSES '(DISPLAY PDF POSTSCRIPT INTERPRESS]
|
||||
(FNS \TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.CHARLOOKS.NEW \TEDIT.CHARLOOKS.CHANGE.FONT
|
||||
\TEDIT.FONT.NEXTSIZE \TEDIT.LOOKS \TEDIT.FONTCOPY \TEDIT.COERCE.FONTCLASS
|
||||
\TEDIT.FONTCLASS.TO.FONT))
|
||||
@@ -1374,6 +1375,8 @@
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ)
|
||||
(RETURN (\TEDIT.COPYSEL (FGETTOBJ TEXTOBJ SEL])])
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.FONTCLASSES '(DISPLAY PDF POSTSCRIPT INTERPRESS))
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.CHANGE.CHARLOOKS
|
||||
@@ -2458,26 +2461,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 (22099 24041 (\TEDIT.CHARLOOKS.DEFPRINT 22109 . 23245) (\TEDIT.PARALOOKS.DEFPRINT 23247
|
||||
. 24039)) (24145 24531 (\TEDIT.CREATE.FACE.MENU 24155 . 24327) (\TEDIT.CREATE.SIZE.MENU 24329 . 24529
|
||||
)) (25535 27424 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25545 . 27422)) (27696 52953 (
|
||||
\TEDIT.CHARLOOKS.FROM.FONT 27706 . 29990) (\TEDIT.EQCLOOKS 29992 . 33023) (\TEDIT.SAMECLOOKS 33025 .
|
||||
36196) (TEDIT.CARETLOOKS 36198 . 37744) (TEDIT.COPY.LOOKS 37746 . 41029) (
|
||||
\TEDIT.UNPARSE.CHARLOOKS.LIST 41031 . 44525) (\TEDIT.MODIFYLOOKS 44527 . 46687) (TEDIT.NEW.FONT 46689
|
||||
. 47136) (\TEDIT.CARETLOOKS.VERIFY 47138 . 47975) (\TEDIT.CARETPIECE 47977 . 48282) (
|
||||
\TEDIT.GET.INSERT.CHARLOOKS 48284 . 51331) (\TEDIT.GET.TERMSA.WIDTHS 51333 . 51749) (
|
||||
\TEDIT.PARSE.CHARLOOKS.LIST 51751 . 52951)) (52954 65081 (\TEDIT.MCCS.TRANSLATE 52964 . 58817) (
|
||||
\TEDIT.CONVERT.TO.FORMATTED 58819 . 65079)) (65953 73290 (\TEDIT.UNIQUIFY.CHARLOOKS 65963 . 67623) (
|
||||
\TEDIT.UNIQUIFY.PARALOOKS 67625 . 68892) (\TEDIT.UNIQUIFY.ALL 68894 . 70982) (
|
||||
\TEDIT.FLUSH.UNUSED.LOOKS 70984 . 73288)) (73323 85281 (TEDIT.LOOKS 73333 . 75722) (TEDIT.GET.LOOKS
|
||||
75724 . 78059) (TEDIT.SUBLOOKS 78061 . 82441) (TEDIT.FINDLOOKS 82443 . 85279)) (85350 115000 (
|
||||
\TEDIT.CHANGE.CHARLOOKS 85360 . 94138) (\TEDIT.CHANGE.CHARLOOKS.NEW 94140 . 97955) (
|
||||
\TEDIT.CHARLOOKS.CHANGE.FONT 97957 . 106264) (\TEDIT.FONT.NEXTSIZE 106266 . 107887) (\TEDIT.LOOKS
|
||||
107889 . 111218) (\TEDIT.FONTCOPY 111220 . 112721) (\TEDIT.COERCE.FONTCLASS 112723 . 113874) (
|
||||
\TEDIT.FONTCLASS.TO.FONT 113876 . 114998)) (115043 146691 (\TEDIT.EQFMTSPEC 115053 . 118268) (
|
||||
TEDIT.GET.PARALOOKS 118270 . 122317) (\TEDIT.PARSE.PARALOOKS.LIST 122319 . 130352) (TEDIT.PARALOOKS
|
||||
130354 . 131394) (\TEDIT.CHANGE.PARALOOKS 131396 . 138364) (\TEDIT.CHANGE.PARALOOKS.NEW 138366 .
|
||||
142349) (TEDIT.COPY.PARALOOKS 142351 . 145025) (\TEDIT.PARABOUNDS 145027 . 146689)) (146751 154467 (
|
||||
TEDIT.SUBPARALOOKS 146761 . 150863) (SAMEPARALOOKS 150865 . 154465)) (154468 155155 (
|
||||
\TEDIT.MARK.REVISION 154478 . 155153)))))
|
||||
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 "22-Oct-2025 12:55:36" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;498 183397
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-MENUCOMS)
|
||||
:CHANGES-TO (FNS MARGINBAR.NEUTRALIZE \TEDIT.PARALOOKS.TO.MARBAR)
|
||||
|
||||
:PREVIOUS-DATE " 7-Dec-2025 16:34:30" {WMEDLEY}<library>tedit>TEDIT-MENU.;499)
|
||||
:PREVIOUS-DATE "19-Oct-2025 15:14:00" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;496)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-MENUCOMS)
|
||||
@@ -67,7 +67,7 @@
|
||||
(* ;; "")
|
||||
|
||||
(* ; "CHARMENU")
|
||||
[INITVARS (TEDIT.FONTDEVICES '(DISPLAY PDF))
|
||||
[INITVARS (TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT))
|
||||
(TEDIT.FONTFAMILIES '(Classic Modern Terminal Helvetica TimesRoman Gacha]
|
||||
(FNS \TEDIT.CHARMENU.CREATE \TEDIT.CHARMENU.START \TEDIT.CHARMENU.SPEC \TEDIT.CHARMENU.PARSE
|
||||
\TEDIT.CHARMENU.FILLIN \TEDIT.SHOW.CHARLOOKS \TEDIT.APPLY.CHARLOOKS
|
||||
@@ -1952,7 +1952,7 @@
|
||||
(* ; "CHARMENU")
|
||||
|
||||
|
||||
(RPAQ? TEDIT.FONTDEVICES '(DISPLAY PDF))
|
||||
(RPAQ? TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT))
|
||||
|
||||
(RPAQ? TEDIT.FONTFAMILIES '(Classic Modern Terminal Helvetica TimesRoman Gacha))
|
||||
(DEFINEQ
|
||||
@@ -2907,32 +2907,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 (4972 16610 (TEDIT.ADD.MENUITEM 4982 . 7099) (TEDIT.DEFAULT.MENUFN 7101 . 13822) (
|
||||
TEDIT.REMOVE.MENUITEM 13824 . 14821) (\TEDIT.CREATEMENU 14823 . 15388) (\TEDIT.MENU.WHENHELDFN 15390
|
||||
. 16295) (\TEDIT.MENU.WHENSELECTEDFN 16297 . 16608)) (17424 65459 (DRAWMARGINSCALE 17434 . 20893) (
|
||||
MARGINBAR 20895 . 28020) (MARGINBAR.CREATE 28022 . 32220) (MB.MARGINBAR.BUTTONEVENTINFN 32222 . 40024)
|
||||
(MB.MARGINBAR.SELFN.TABS 40026 . 45266) (MB.MARGINBAR.SELFN.TABS.KIND 45268 . 46203) (
|
||||
MARGINBAR.GETSTATEFN 46205 . 50192) (MARGINBAR.SETSTATEFN 50194 . 50404) (MARGINBAR.NEUTRALIZE 50406
|
||||
. 51081) (MARGINBAR.LOOKS 51083 . 54189) (MB.MARGINBAR.SIZEFN 54191 . 54977) (MB.MARGINBAR.DISPLAYFN
|
||||
54979 . 58040) (MDESCALE 58042 . 58582) (MSCALE 58584 . 58914) (MB.MARGINBAR.SHOWTAB 58916 . 61239) (
|
||||
MB.MARGINBAR.TABTRACK 61241 . 62626) (MARGINBAR.INIT 62628 . 64021) (\TEDIT.PARALOOKS.TO.MARBAR 64023
|
||||
. 65457)) (66284 73566 (TEDIT.MENUSTREAM 66294 . 67294) (TEDITMENUP 67296 . 68265) (\TEDIT.MENU.START
|
||||
68267 . 72614) (\TEDIT.MENU.OPEN? 72616 . 72990) (\TEDIT.MENU.BUTTONEVENTFN 72992 . 73564)) (73885
|
||||
81936 (\TEDIT.MENU.CREATE 73895 . 75835) (\TEDIT.MENU.PARSE 75837 . 79526) (\TEDIT.MENU.NEUTRALIZE
|
||||
79528 . 81599) (\TEDITMENU.RECORD.UNFORMATTED 81601 . 81934)) (82002 101783 (
|
||||
\TEDIT.EXPANDEDMENU.CREATE 82012 . 87479) (\TEDIT.EXPANDEDMENU.START 87481 . 89105) (
|
||||
\TEDIT.EXPANDEDMENU.FN 89107 . 92362) (\TEDIT.EXPANDEDMENU.ACTIONFN 92364 . 101781)) (101845 121270 (
|
||||
\TEDIT.PARAMENU.CREATE 101855 . 110586) (\TEDIT.PARAMENU.START 110588 . 111842) (
|
||||
\TEDIT.APPLY.PARALOOKS 111844 . 112896) (\TEDIT.SHOW.PARALOOKS 112898 . 115615) (
|
||||
\TEDIT.PARAMENU.FILLIN 115617 . 120366) (\TEDIT.PARAMENU.RESHAPEFN 120368 . 121268)) (121475 148317 (
|
||||
\TEDIT.CHARMENU.CREATE 121485 . 124089) (\TEDIT.CHARMENU.START 124091 . 125381) (\TEDIT.CHARMENU.SPEC
|
||||
125383 . 130066) (\TEDIT.CHARMENU.PARSE 130068 . 133236) (\TEDIT.CHARMENU.FILLIN 133238 . 137868) (
|
||||
\TEDIT.SHOW.CHARLOOKS 137870 . 141415) (\TEDIT.APPLY.CHARLOOKS 141417 . 142578) (
|
||||
\TEDIT.OFFSETTYPE.STATEFN 142580 . 144543) (\TEDIT.OTHER.STATECHANGEFN 144545 . 146190) (
|
||||
\TEDIT.OTHER.SELECTFN 146192 . 148315)) (148379 177437 (\TEDIT.PAGEMENU.CREATE 148389 . 156901) (
|
||||
\TEDIT.PAGEMENU.START 156903 . 157254) (\TEDIT.SHOW.PAGELOOKS 157256 . 159142) (\TEDIT.PAGEMENU.FILLIN
|
||||
159144 . 160694) (\TEDIT.PAGEREGION.UNPARSE 160696 . 170095) (\TEDIT.APPLY.PAGELOOKS 170097 . 172024)
|
||||
(\TEDIT.CHANGE.PAGELOOKS 172026 . 176593) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176595 . 177435)) (
|
||||
177438 183241 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177448 . 180260) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN
|
||||
180262 . 181687) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181689 . 183239)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Jan-2026 12:00:08" {WMEDLEY}<library>tedit>TEDIT-PAGE.;241 130528
|
||||
(FILECREATED " 5-Jun-2025 08:24:12" {WMEDLEY}<library>tedit>TEDIT-PAGE.;222 134861
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.TO.IMAGEFILE)
|
||||
:CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY)
|
||||
|
||||
:PREVIOUS-DATE "15-Jan-2026 10:48:30" {WMEDLEY}<library>tedit>TEDIT-PAGE.;240)
|
||||
:PREVIOUS-DATE "11-May-2025 15:03:00" {WMEDLEY}<library>tedit>TEDIT-PAGE.;221)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PAGECOMS)
|
||||
@@ -50,7 +50,7 @@
|
||||
72 72 NIL 1)
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72
|
||||
72 72 NIL 1]
|
||||
(FNS TEDIT.TO.IMAGEFILE)
|
||||
(FNS TEDIT.FORMAT.HARDCOPY)
|
||||
(COMS
|
||||
(* ;; "Perform page layout, based on a regular expression of typed regions.")
|
||||
|
||||
@@ -631,103 +631,148 @@
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 72 72 NIL 1)))
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.TO.IMAGEFILE
|
||||
[LAMBDA (TSTREAM IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 17-Jan-2026 11:59 by rmk")
|
||||
(* ; "Edited 15-Jan-2026 08:46 by rmk")
|
||||
(* ; "Edited 25-Dec-2025 15:07 by rmk")
|
||||
(* ; "Edited 20-Dec-2025 23:03 by rmk")
|
||||
(* ; "Edited 14-Dec-2025 17:38 by rmk")
|
||||
(* ; "Edited 27-Sep-2025 14:05 by rmk")
|
||||
(* ; "Edited 19-Sep-2025 22:08 by rmk")
|
||||
(TEDIT.FORMAT.HARDCOPY
|
||||
[LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG
|
||||
ENDPG QUIET) (* ; "Edited 5-Jun-2025 08:24 by rmk")
|
||||
(* ; "Edited 22-Apr-2025 08:12 by rmk")
|
||||
(* ; "Edited 23-Feb-2025 09:59 by rmk")
|
||||
(* ; "Edited 30-Aug-2024 15:45 by rmk")
|
||||
(* ; "Edited 10-Jul-2024 23:34 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 10:32 by rmk")
|
||||
(* ; "Edited 5-Apr-2024 08:01 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 09:31 by rmk")
|
||||
(* ; "Edited 7-Mar-2024 12:34 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 23:39 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 14:10 by rmk")
|
||||
(* ; "Edited 15-Nov-2023 23:56 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:38 by rmk")
|
||||
(* ; "Edited 4-Jul-2023 11:16 by rmk")
|
||||
(* ; "Edited 2-Oct-2022 00:00 by rmk")
|
||||
(* ;
|
||||
"Edited 25-May-93 13:06 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "Format a document for hardcopy. Returns the number of pages printed (not the final page number!). Returns NIL if the before-print-fn said not to print.")
|
||||
|
||||
(* ;; "TSTREAM is either already a textstream or somehow denotes a tedit-formatted file, otherwise an error. ")
|
||||
(* ;; "TEXTSTREAM is either already a textstream or somehow denotes a tedit-formatted file, otherwise an error. We don't here try to decide that a non-formatted file is a plain text file, as opposed binary or anything else.")
|
||||
|
||||
(RESETLST
|
||||
(SETQ TSTREAM (if (TEXTSTREAM TSTREAM T)
|
||||
elseif (TEDIT.FORMATTEDFILEP TSTREAM)
|
||||
then [RESETSAVE (SETQ TSTREAM (OPENTEXTSTREAM TSTREAM))
|
||||
`(PROGN (CLOSEF? OLDVALUE]
|
||||
TSTREAM
|
||||
else (ERROR TSTREAM "is not a Tedit stream")))
|
||||
(CL:WHEN (GETTEXTPROP TSTREAM 'MENUFLG)
|
||||
(SETQ TSTREAM (TEXTSTREAM (\TEDIT.MAINW TSTREAM))))
|
||||
(CL:UNLESS IMAGEFILE
|
||||
[SETQ IMAGEFILE (if (GETTEXTPROP TSTREAM 'FILENAME)
|
||||
then (PACKFILENAME 'VERSION NIL 'EXTENSION (CAR (
|
||||
EXTENSIONS.FOR.IMAGEFILETYPE
|
||||
IMAGETYPE))
|
||||
'BODY
|
||||
(GETTEXTPROP TSTREAM 'FILENAME))
|
||||
else (UNIX-TMP-FILE-NAME 'tedit (CAR (EXTENSIONS.FOR.IMAGEFILETYPE
|
||||
IMAGETYPE])
|
||||
(PUTTEXTPROP TSTREAM 'LASTIMAGEFILE NIL)
|
||||
(PROG* ((FIRSTPG# (LISTGET OPTIONS 'FIRSTPG#))
|
||||
(TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||
[FORMATTINGSTATE (create PAGEFORMATTINGSTATE
|
||||
PAGE# _ (FIXP FIRSTPG#)
|
||||
FIRSTPAGE _ T
|
||||
STATE _ FIRSTPG#
|
||||
MINPAGE# _ (LISTGET OPTIONS 'STARTPG)
|
||||
MAXPAGE# _ (OR (LISTGET OPTIONS 'ENDPG)
|
||||
65535)
|
||||
CHNO _ 1
|
||||
PAGEHEADINGS _ (LIST NIL NIL)
|
||||
PAGE#GENERATOR _ (AND (LISTP FIRSTPG#)
|
||||
(CDR FIRSTPG#))
|
||||
PAGE#TEXT _ (AND (LISTP FIRSTPG#)
|
||||
(CAR FIRSTPG#]
|
||||
IMAGESTREAM PAGEREGION SCRATCHFILE)
|
||||
(CL:WHEN (EQ 'DON'T (APPLY* (OR (GETTEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN)
|
||||
(FUNCTION NILL))
|
||||
TSTREAM)) (* ;
|
||||
(SETQ TEXTSTREAM (if (TEXTSTREAM TEXTSTREAM T)
|
||||
elseif (TEDIT.FORMATTEDFILEP TEXTSTREAM)
|
||||
then [RESETSAVE (SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTSTREAM))
|
||||
`(PROGN (CLOSEF? OLDVALUE]
|
||||
TEXTSTREAM
|
||||
else (ERROR TEXTSTREAM "is not a Tedit stream")))
|
||||
(PROG ((TEXTOBJ (FTEXTOBJ TEXTSTREAM))
|
||||
[FORMATTINGSTATE (create PAGEFORMATTINGSTATE
|
||||
PAGE# _ (FIXP FIRSTPG#)
|
||||
FIRSTPAGE _ T
|
||||
STATE _ FIRSTPG#
|
||||
MINPAGE# _ STARTPG
|
||||
MAXPAGE# _ (OR ENDPG 65535)
|
||||
CHNO _ 1
|
||||
PAGEHEADINGS _ (LIST NIL NIL)
|
||||
PAGE#GENERATOR _ (AND (LISTP FIRSTPG#)
|
||||
(CDR FIRSTPG#))
|
||||
PAGE#TEXT _ (AND (LISTP FIRSTPG#)
|
||||
(CAR FIRSTPG#]
|
||||
PRSTREAM PAGEREGION SCRATCHFILE NPAGES WASOPEN TARGETFILENAME)
|
||||
(CL:WHEN (EQ 'DON'T (APPLY* (OR (GETTEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN)
|
||||
(FUNCTION NILL))
|
||||
TEXTSTREAM)) (* ;
|
||||
"Do pre-hardcopy processing as indicated, or refuse")
|
||||
(RETURN))
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Hardcopy")
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(SETQ PAGEREGION (FGETTOBJ TEXTOBJ TXTPAGEFRAMES))
|
||||
(SETPFS FORMATTINGSTATE PRESSREGION TEDIT.DEFAULTPAGEREGION)
|
||||
(RETURN))
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Hardcopy")
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(SETQ PAGEREGION (FGETTOBJ TEXTOBJ TXTPAGEFRAMES))
|
||||
(SETPFS FORMATTINGSTATE PRESSREGION TEDIT.DEFAULTPAGEREGION)
|
||||
(* ;
|
||||
"Print in the usual region on the page")
|
||||
(CL:UNLESS BREAKPAGETITLE
|
||||
[SETQ BREAKPAGETITLE (COND
|
||||
((LISTGET PRINTOPTIONS 'DOCUMENT.NAME))
|
||||
([OR (NOT (FGETTOBJ TEXTOBJ TXTFILE))
|
||||
(STRINGP (FGETTOBJ TEXTOBJ TXTFILE))
|
||||
(type? STREAM (fetch (STREAM FULLNAME)
|
||||
of (FGETTOBJ TEXTOBJ TXTFILE)))
|
||||
(STRINGP (fetch (STREAM FULLNAME)
|
||||
of (FGETTOBJ TEXTOBJ TXTFILE]
|
||||
(* ;
|
||||
"This isn't a real file, so print a generic name on the document break page.")
|
||||
"TEdit Hardcopy Output")
|
||||
(T (* ;
|
||||
"It's a real file, so use the file name on the break page.")
|
||||
(fetch (STREAM FULLNAME) of (FGETTOBJ TEXTOBJ TXTFILE])
|
||||
[SETQ SCRATCHFILE (OR FILE (PRINTER.SCRATCH.FILE (TEXTSTREAM TEXTSTREAM]
|
||||
(RESETLST (* ;
|
||||
"Set up to do the user's cleanup on the way out, as well.")
|
||||
(CL:UNLESS QUIET (TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T))
|
||||
[COND
|
||||
((AND FILE (OPENP FILE)
|
||||
(IMAGESTREAMTYPE FILE)) (* ;
|
||||
"The file he handed us is already an image-type file. Just append the new stuff to it.")
|
||||
(SETQ WASOPEN T)
|
||||
(SETQ PRSTREAM FILE))
|
||||
(T (* ;
|
||||
"T'wasn't an image stream, so let's open us one.")
|
||||
(RESETSAVE (SETQ PRSTREAM (OPENIMAGESTREAM
|
||||
SCRATCHFILE
|
||||
[OR IMAGETYPE (SETQ IMAGETYPE
|
||||
(CAR (PRINTERPROP (PRINTERTYPE
|
||||
SERVER)
|
||||
'CANPRINT]
|
||||
(LIST 'FONT (FONTCREATE 'TERMINAL 10)
|
||||
'BREAKPAGEFILENAME BREAKPAGETITLE)))
|
||||
'(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
|
||||
(* ;
|
||||
"So we close and delete the file in case of trouble.")
|
||||
|
||||
(* ;; "TEDIT puts its own headings on the page")
|
||||
(* ;; "The right margin must be big enough to prevent line wrap on landscaped 14 inch paper, with Postscript's scaling of .01-point increments. (~ 101,000). This will cause a performance hit. Sigh. JDS 9/5/89")
|
||||
|
||||
[SETQ IMAGESTREAM (OPENIMAGESTREAM IMAGEFILE IMAGETYPE `(HEADING NIL ,@OPTIONS]
|
||||
(DSPRIGHTMARGIN 131072 PRSTREAM)
|
||||
(while (ILEQ (GETPFS FORMATTINGSTATE CHNO)
|
||||
(FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
do
|
||||
(* ;; "Format pages according to the existing layout:")
|
||||
|
||||
(* ;; "The right margin must be big enough to prevent line wrap on landscaped 14 inch paper, with Postscript's scaling of .01-point increments. (~ 101,000). This will cause a performance hit. Sigh. JDS 9/5/89")
|
||||
(\TEDIT.FORMATBOX TEXTSTREAM PRSTREAM (GETPFS FORMATTINGSTATE CHNO)
|
||||
PAGEREGION FORMATTINGSTATE IMAGETYPE)
|
||||
(CL:WHEN (EQ (GETPFS FORMATTINGSTATE STATE)
|
||||
:NEW-PAGE-LAYOUT)
|
||||
|
||||
(DSPRIGHTMARGIN 131072 IMAGESTREAM)
|
||||
(while (ILEQ (GETPFS FORMATTINGSTATE CHNO)
|
||||
(FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
do
|
||||
(* ;; "Format pages according to the existing layout:")
|
||||
(* ;; "New page layout got specified. Prepare to re-enter the formatting code and skip to the equivalent page in the new format.")
|
||||
|
||||
(\TEDIT.FORMATBOX TSTREAM IMAGESTREAM (GETPFS FORMATTINGSTATE CHNO)
|
||||
PAGEREGION FORMATTINGSTATE IMAGETYPE)
|
||||
(CL:WHEN (EQ (GETPFS FORMATTINGSTATE STATE)
|
||||
:NEW-PAGE-LAYOUT)
|
||||
(SETQ PAGEREGION (GETPFS FORMATTINGSTATE NEWPAGELAYOUT))
|
||||
|
||||
(* ;; "New page layout got specified. Prepare to re-enter the formatting code and skip to the equivalent page in the new format.")
|
||||
(* ;; "Set up the formatting state so code knows we're looking for an equivalent page, and which page it is. (The SUB1 is because we counted an extra page for the page on which the new payout was detected.)")
|
||||
|
||||
(SETQ PAGEREGION (GETPFS FORMATTINGSTATE NEWPAGELAYOUT))
|
||||
|
||||
(* ;; "Set up the formatting state so code knows we're looking for an equivalent page, and which page it is. (The SUB1 is because we counted an extra page for the page on which the new payout was detected.)")
|
||||
|
||||
(SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE (SUB1 (GETPFS FORMATTINGSTATE
|
||||
PAGECOUNT)))
|
||||
(SETPFS FORMATTINGSTATE PAGECOUNT 0)
|
||||
(SETPFS FORMATTINGSTATE STATE :SEARCHING-FOR-EQUIVALENT-PAGE)))
|
||||
(APPLY* (OR (GETTEXTPROP TEXTOBJ 'AFTERHARDCOPYFN)
|
||||
(FUNCTION NILL))
|
||||
TSTREAM)
|
||||
|
||||
(* ;; "So caller can formulate a prompt message TEDIT.IMAGEFILE.MESSAGE")
|
||||
|
||||
(PUTTEXTPROP TSTREAM 'LASTIMAGEFILE (LIST (GETPFS FORMATTINGSTATE PAGECOUNT)
|
||||
(FULLNAME IMAGESTREAM)
|
||||
(PRINTERNAME IMAGESTREAM)))
|
||||
(RETURN (CLOSEF IMAGESTREAM))))])
|
||||
(SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE (SUB1 (GETPFS FORMATTINGSTATE
|
||||
PAGECOUNT)))
|
||||
(SETPFS FORMATTINGSTATE PAGECOUNT 0)
|
||||
(SETPFS FORMATTINGSTATE STATE :SEARCHING-FOR-EQUIVALENT-PAGE)))
|
||||
(SETQ TARGETFILENAME (STREAMPROP PRSTREAM 'PDFTARGETINFO))
|
||||
(CL:UNLESS WASOPEN (* ;
|
||||
"Only if we created the image stream should we close it.")
|
||||
(SETQ PRSTREAM (CLOSEF PRSTREAM))
|
||||
(CL:UNLESS DONTSEND
|
||||
(SEND.FILE.TO.PRINTER PRSTREAM SERVER (APPEND PRINTOPTIONS
|
||||
(LIST 'DOCUMENT.NAME
|
||||
BREAKPAGETITLE)))))
|
||||
(CL:UNLESS FILE (DELFILE SCRATCHFILE))
|
||||
(APPLY* (OR (GETTEXTPROP TEXTOBJ 'AFTERHARDCOPYFN)
|
||||
(FUNCTION NILL))
|
||||
TEXTSTREAM))
|
||||
(SETQ NPAGES (GETPFS FORMATTINGSTATE PAGECOUNT))
|
||||
(CL:UNLESS QUIET
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES)
|
||||
""
|
||||
"s")
|
||||
" printed"
|
||||
(CL:IF (EQ FILE SCRATCHFILE)
|
||||
(CONCAT " to " (OR TARGETFILENAME
|
||||
(FULLNAME FILE)))
|
||||
""))
|
||||
T))
|
||||
(RETURN NPAGES)))])
|
||||
)
|
||||
|
||||
|
||||
@@ -2056,18 +2101,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 (12139 15751 (\TEDIT.PARSE.PAGEFRAMES 12149 . 13928) (\TEDIT.PUT.PAGEFRAMES 13930 .
|
||||
14754) (\TEDIT.UNPARSE.PAGEFRAMES 14756 . 15749)) (15814 37831 (TEDIT.SINGLE.PAGEFORMAT 15824 . 26817)
|
||||
(TEDIT.COMPOUND.PAGEFORMAT 26819 . 27798) (TEDIT.PAGEFORMAT 27800 . 35089) (TEDIT.GET.PAGEFORMAT
|
||||
35091 . 37829)) (38118 48925 (TEDIT.FORMAT.HARDCOPY 38128 . 48923)) (49012 102264 (\TEDIT.FORMATBOX
|
||||
49022 . 62446) (\TEDIT.FORMATHEADING 62448 . 67094) (\TEDIT.FORMATPAGE 67096 . 76285) (
|
||||
\TEDIT.FORMATTEXTBOX 76287 . 92800) (\TEDIT.FORMATFOLIO 92802 . 98119) (\TEDIT.FORMAT.FOUNDBOX? 98121
|
||||
. 100160) (\TEDIT.SKIP.SPECIALCOND 100162 . 102262)) (102344 107399 (\TEDIT.HARDCOPY.PAGEHEADINGS
|
||||
102354 . 107397)) (107508 115559 (\TEDIT.HARDCOPY-COLUMN-END 107518 . 115557)) (115604 120545 (
|
||||
SCALEPAGEUNITS 115614 . 116755) (SCALEPAGEXUNITS 116757 . 117527) (SCALEPAGEYUNITS 117529 . 118300) (
|
||||
\TEDIT.PAPERHEIGHT 118302 . 119237) (\TEDIT.PAPERWIDTH 119239 . 120543)) (120961 124529 (ROMANNUMERALS
|
||||
120971 . 124527)) (124568 131834 (TEDIT.PAGENO.CREATE 124578 . 124954) (\TEDIT.PAGENO.OBJINIT 124956
|
||||
. 126239) (\TEDIT.PAGENO.BUTTONEVENTINFN 126241 . 127307) (\TEDIT.PAGENO.IMAGEBOXFN 127309 . 129459)
|
||||
(\TEDIT.PAGENO.DISPLAYFN 129461 . 131111) (\TEDIT.PAGENO.GETFN 131113 . 131505) (\TEDIT.PAGENO.PUTFN
|
||||
131507 . 131832)) (131899 134838 (\TEDIT.FORMAT.FOOTNOTE 131909 . 134836)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
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 "19-Oct-2025 00:07:29" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;910 186445
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-SCREENCOMS)
|
||||
:CHANGES-TO (FNS \TEDIT.FORMATLINE.HORIZONTAL)
|
||||
|
||||
:PREVIOUS-DATE " 7-Dec-2025 16:28:01" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;914)
|
||||
:PREVIOUS-DATE " 7-Aug-2025 12:51:00" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;909)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
|
||||
@@ -22,6 +22,7 @@
|
||||
LINEDESCRIPTOR!))
|
||||
(MACROS HCSCALE HCUNSCALE SCALEUP SCALEDOWN)
|
||||
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
|
||||
(ALISTS (CHARACTERNAMES SOFT-HYPHEN NONBREAKING-HYPHEN NONBREAKING-SPACE))
|
||||
(MACROS DIACRITICP)
|
||||
(MACROS \TEDIT.LINE.TALLP)
|
||||
(COMS (* ; "Formatting slots held by THISLINE")
|
||||
@@ -35,7 +36,6 @@
|
||||
(* ;; "incharslots can be used only if THISLINE is properly bound in the environment, to provide upperbound checking. Operand can be THISLINE (= FIRSTCHARSLOT) or a within-range slot pointer. The latter case is not current checked for validity (some \HILOC \LOLOC address calculations?). backcharslots runs backwards.")
|
||||
|
||||
(I.S.OPRS incharslots backcharslots]
|
||||
(ALISTS (CHARACTERNAMES SOFT-HYPHEN NONBREAKING-HYPHEN NONBREAKING-SPACE))
|
||||
(FNS \TEDIT.LINEDESCRIPTOR.DEFPRINT)
|
||||
(INITRECORDS THISLINE LINEDESCRIPTOR LINECACHE)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (* ; "Not exported")
|
||||
@@ -298,6 +298,10 @@
|
||||
|
||||
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
|
||||
)
|
||||
|
||||
(ADDTOVAR CHARACTERNAMES (SOFT-HYPHEN "357,043")
|
||||
(NONBREAKING-HYPHEN "357,042")
|
||||
(NONBREAKING-SPACE "357,041"))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR)
|
||||
@@ -456,10 +460,6 @@
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
|
||||
(ADDTOVAR CHARACTERNAMES (SOFT-HYPHEN "357,043")
|
||||
(NONBREAKING-HYPHEN "357,042")
|
||||
(NONBREAKING-SPACE "357,041"))
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.LINEDESCRIPTOR.DEFPRINT
|
||||
@@ -654,16 +654,17 @@
|
||||
|
||||
(\TEDIT.FORMATLINE
|
||||
[LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 21-Nov-2025 16:36 by rmk")
|
||||
(* ; "Edited 7-Aug-2025 12:49 by rmk")
|
||||
(* ; "Edited 27-Apr-2025 11:24 by rmk")
|
||||
(* ; "Edited 21-Apr-2025 19:03 by rmk")
|
||||
(* ; "Edited 11-Apr-2025 20:18 by rmk")
|
||||
(* ; "Edited 29-Mar-2025 11:39 by rmk")
|
||||
(* ; "Edited 6-Mar-2025 11:42 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:36 by rmk")
|
||||
(* ; "Edited 24-Dec-2024 22:15 by rmk")
|
||||
(* ; "Edited 23-Nov-2024 00:03 by rmk")
|
||||
(* ; "Edited 31-Oct-2024 15:32 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 10:51 by rmk")
|
||||
(* ; "Edited 2-Sep-2024 16:06 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 18:07 by rmk")
|
||||
(* ; "Edited 21-May-2024 14:45 by rmk")
|
||||
@@ -703,11 +704,9 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(CL:UNLESS LINE
|
||||
(SETQ LINE (create LINEDESCRIPTOR)))
|
||||
(CL:UNLESS IMAGESTREAM
|
||||
(SETQ IMAGESTREAM (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
|
||||
'DSP)))
|
||||
'DSP))) (* ; "For lower image objects?")
|
||||
(PROG ((TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||
(OFFSET 0)
|
||||
(TRUEASCENT -1)
|
||||
@@ -719,11 +718,17 @@
|
||||
(OVERHANG 0)
|
||||
(SPACELEFT 0)
|
||||
(TX 0)
|
||||
(BOXSTREAM IMAGESTREAM)
|
||||
CHARLOOKS THISLINE LINETYPE WIDTH WMARGIN SCALE PARALOOKS RIGHTMARGIN HASKERN PC CHARSLOT
|
||||
PREVSP 1STLN CHNOB FORCED-END CHNO LX1 TX TXB FONT CHARSLOTB TABPENDING PREVHYPH PREVDHYPH
|
||||
START-OF-PIECE UNBREAKABLE OLDPIECE OLDPCCHARSLEFT OLDCARETLOOKS FIRSTSEPR)
|
||||
(DECLARE (SPECVARS TEXTOBJ LINETYPE CHARLOOKS CHNO OFFSET ASCENTC DESCENTC FONT
|
||||
START-OF-PIECE HASKERN UNBREAKABLE))
|
||||
(CL:UNLESS LINE
|
||||
|
||||
(* ;; "Not needed until the end, but then we might not get the starting values for WRIGHT and WBOTTOM, if those change from piece to piece--check this.")
|
||||
|
||||
(SETQ LINE (create LINEDESCRIPTOR)))
|
||||
(SETQ THISLINE (FGETTOBJ TEXTOBJ THISLINE))
|
||||
|
||||
(* ;;
|
||||
@@ -894,9 +899,9 @@
|
||||
(* ;; "If this isn't TRUEHARDCOPY, we want to do the imageobject in the displaystream with displaystream coordinates, because we don't know what internal size computations the imageobject might make based on its displaystream and fonts. But we do have to down-scale WIDTH (right margin) back to the units of the display stream.")
|
||||
|
||||
(SETQ BOX (APPLY* (IMAGEOBJPROP CH 'IMAGEBOXFN)
|
||||
CH IMAGESTREAM TX (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY)
|
||||
(SCALEDOWN SCALE WIDTH)
|
||||
WIDTH)
|
||||
CH BOXSTREAM TX (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY)
|
||||
(SCALEDOWN SCALE WIDTH)
|
||||
WIDTH)
|
||||
TSTREAM))
|
||||
(IMAGEOBJPROP CH 'BOUNDBOX BOX)
|
||||
(SETQ TRUEASCENT (IMAX TRUEASCENT (IPLUS (IDIFFERENCE (fetch (IMAGEBOX YSIZE)
|
||||
@@ -1224,8 +1229,7 @@
|
||||
(RETURN LINE])
|
||||
|
||||
(\TEDIT.FORMATLINE.SETUP.PARA
|
||||
[LAMBDA (TEXTOBJ PC LINE IMAGESTREAM LINETYPE) (* ; "Edited 7-Dec-2025 16:26 by rmk")
|
||||
(* ; "Edited 19-Feb-2025 13:37 by rmk")
|
||||
[LAMBDA (TEXTOBJ PC LINE IMAGESTREAM LINETYPE) (* ; "Edited 19-Feb-2025 13:37 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:36 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:09 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 11:14 by rmk")
|
||||
@@ -1260,8 +1264,9 @@
|
||||
(* ;; "Coerce the image stream and PARALOOKS for HARDCOPYDISPLAY.")
|
||||
|
||||
[SETQ IMAGESTREAM (OR (FGETTOBJ TEXTOBJ DISPLAYHCPYDS)
|
||||
(FSETTOBJ TEXTOBJ DISPLAYHCPYDS (OPENIMAGESTREAM NIL
|
||||
DEFAULTPRINTERTYPE]
|
||||
(FSETTOBJ TEXTOBJ DISPLAYHCPYDS (OPENIMAGESTREAM
|
||||
'{NODIRCORE}
|
||||
'POSTSCRIPT]
|
||||
(SETQ SCALE (DSPSCALE NIL IMAGESTREAM))
|
||||
[SETQ PLOOKS (create PARALOOKS using PLOOKS FMTHARDCOPYSCALE _ SCALE RIGHTMAR _
|
||||
(SCALEUP SCALE (FGETPLOOKS PLOOKS RIGHTMAR))
|
||||
@@ -2290,9 +2295,7 @@
|
||||
1)])
|
||||
|
||||
(\TEDIT.UPDATE.LINES
|
||||
[LAMBDA (TSTREAM REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 26-Oct-2025 17:10 by rmk")
|
||||
(* ; "Edited 24-Oct-2025 12:57 by rmk")
|
||||
(* ; "Edited 26-Apr-2025 19:19 by rmk")
|
||||
[LAMBDA (TSTREAM REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 26-Apr-2025 19:19 by rmk")
|
||||
(* ; "Edited 21-Apr-2025 20:30 by rmk")
|
||||
(* ; "Edited 9-Apr-2025 12:59 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 14:23 by rmk")
|
||||
@@ -2322,7 +2325,7 @@
|
||||
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ TXTDON'TUPDATE)
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
[for PANE LASTVALID NEXTVALID LASTGAPLINE BITMAPLINES (LASTCHANGEDCHNO
|
||||
(for PANE LASTVALID NEXTVALID LASTGAPLINE BITMAPLINES (LASTCHANGEDCHNO
|
||||
_
|
||||
(SUB1 (IPLUS FIRSTCHANGEDCHNO
|
||||
NCHARSCHANGED)))
|
||||
@@ -2332,41 +2335,38 @@
|
||||
((CHANGED LOOKS)
|
||||
0)
|
||||
(\TEDIT.THELP "BAD REASONS FOR VALID LINES"))) inpanes TEXTOBJ
|
||||
when (SETQ LASTVALID (\TEDIT.LASTVALIDLINE FIRSTCHANGEDCHNO LASTCHANGEDCHNO PANE
|
||||
TSTREAM))
|
||||
do
|
||||
(* ;;
|
||||
"Create/format/position/display new lines between LASTVALID and NEXTVALID exclusive")
|
||||
|
||||
(SETQ LASTVALID (\TEDIT.LASTVALIDLINE FIRSTCHANGEDCHNO LASTCHANGEDCHNO PANE
|
||||
TSTREAM))
|
||||
(if LASTVALID
|
||||
then (SETQ NEXTVALID (\TEDIT.NEXTVALIDLINE LASTCHANGEDCHNO PANE TSTREAM))
|
||||
(CL:UNLESS (ZEROP DELTA) (* ;
|
||||
(SETQ NEXTVALID (\TEDIT.NEXTVALIDLINE LASTCHANGEDCHNO PANE TSTREAM))
|
||||
(CL:UNLESS (ZEROP DELTA) (* ;
|
||||
"Adjust the character numbers of the lower valid lines")
|
||||
(for L inlines NEXTVALID do (add (FGETLD L LCHAR1)
|
||||
DELTA)
|
||||
(add (FGETLD L LCHARLAST)
|
||||
DELTA)))
|
||||
(for L inlines NEXTVALID do (add (FGETLD L LCHAR1)
|
||||
DELTA)
|
||||
(add (FGETLD L LCHARLAST)
|
||||
DELTA)))
|
||||
|
||||
(* ;; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.")
|
||||
(* ;; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.")
|
||||
|
||||
[SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID PANE TSTREAM
|
||||
(CL:IF NEXTVALID
|
||||
(SUB1 (FGETLD NEXTVALID LCHAR1))
|
||||
(TEXTLEN TEXTOBJ))]
|
||||
[SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID PANE TSTREAM
|
||||
(CL:IF NEXTVALID
|
||||
(SUB1 (FGETLD NEXTVALID LCHAR1))
|
||||
(TEXTLEN TEXTOBJ))]
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"The chain that ended at LASTVALID now continues thru LASTGAPLINE to NEXVALID and below.")
|
||||
|
||||
(LINKLD LASTGAPLINE NEXTVALID)
|
||||
(if NEXTVALID
|
||||
then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID))
|
||||
else (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM LASTGAPLINE))
|
||||
(LINKLD LASTGAPLINE NEXTVALID)
|
||||
(if NEXTVALID
|
||||
then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID))
|
||||
else (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM LASTGAPLINE))
|
||||
|
||||
(* ;; "If LASTVALID is not visible (above the pane), make sure that its NEXT is linked to the PANE's prefix")
|
||||
(* ;; "If LASTVALID is not visible (above the pane), make sure that its NEXT is linked to the PANE's prefix")
|
||||
|
||||
(\TEDIT.SHIFTLINES LASTVALID PANE TSTREAM BITMAPLINES)
|
||||
else (* ; "No lines left in this pane")
|
||||
(\TEDIT.SCROLLCH.TOP TSTREAM PANE (SUB1 FIRSTCHANGEDCHNO])])
|
||||
(\TEDIT.SHIFTLINES LASTVALID PANE TSTREAM BITMAPLINES)))])
|
||||
|
||||
(\TEDIT.PANE.CREATELINES
|
||||
[LAMBDA (TSTREAM PANE LCHARLAST YBOT) (* ; "Edited 28-Jul-2025 23:23 by rmk")
|
||||
@@ -2863,21 +2863,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 (26225 28441 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26235 . 28439)) (35895 119880 (
|
||||
\TEDIT.FORMATLINE 35905 . 71392) (\TEDIT.FORMATLINE.SETUP.PARA 71394 . 76560) (
|
||||
\TEDIT.FORMATLINE.HORIZONTAL 76562 . 81379) (\TEDIT.FORMATLINE.VERTICAL 81381 . 83832) (
|
||||
\TEDIT.FORMATLINE.JUSTIFY 83834 . 89855) (\TEDIT.FORMATLINE.TABS 89857 . 97885) (\TEDIT.SCALE.TABS
|
||||
97887 . 98678) (\TEDIT.FORMATLINE.PURGE.SPACES 98680 . 100107) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
||||
100109 . 101186) (\TEDIT.FORMATLINE.EMPTY 101188 . 106008) (\TEDIT.FORMATLINE.UPDATELOOKS 106010 .
|
||||
112191) (\TEDIT.FORMATLINE.LASTLEGAL 112193 . 115643) (\TEDIT.LINES.ABOVE 115645 . 119256) (
|
||||
\TEDIT.CHNO.TO.YTOP 119258 . 119878)) (120157 140737 (\TEDIT.DISPLAYLINE 120167 . 132677) (
|
||||
\TEDIT.DISPLAYLINE.TABS 132679 . 135483) (\TEDIT.LINECACHE 135485 . 136213) (\TEDIT.CREATE.LINECACHE
|
||||
136215 . 137051) (\TEDIT.BLTCHAR 137053 . 139680) (\TEDIT.DIACRITIC.SHIFT 139682 . 140735)) (141352
|
||||
186422 (\TEDIT.BACKFORMAT 141362 . 143916) (\TEDIT.PREVIOUS.LINEBREAK 143918 . 146721) (
|
||||
\TEDIT.UPDATE.LINES 146723 . 152438) (\TEDIT.PANE.CREATELINES 152440 . 154730) (
|
||||
\TEDIT.SUFFIXLINE.CREATE 154732 . 156347) (\TEDIT.LINES.BELOW 156349 . 160959) (\TEDIT.MEASURED.LINES
|
||||
160961 . 162970) (\TEDIT.VALID.LASTCHNOS 162972 . 166748) (\TEDIT.VALID.NEXTCHNOS 166750 . 170224) (
|
||||
\TEDIT.LASTVALIDLINE 170226 . 174897) (\TEDIT.NEXTVALIDLINE 174899 . 177869) (
|
||||
\TEDIT.CLEARPANE.BELOW.LINE 177871 . 179977) (\TEDIT.INSERTLINE 179979 . 181365) (\TEDIT.LINE.BOTTOM
|
||||
181367 . 184597) (\TEDIT.SHOW.AT.BOTTOMP 184599 . 185709) (\TEDIT.SHOW.AT.TOPP 185711 . 186420)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Dec-2025 17:50:45" {WMEDLEY}<library>tedit>TEDIT-STREAM.;930 194007
|
||||
(FILECREATED "23-Sep-2025 08:19:29" {MEDLEY}<library>tedit>TEDIT-STREAM.;15 192029
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS OPENTEXTSTREAM \TEDIT.OPENTEXTFILE)
|
||||
:CHANGES-TO (FNS \TEDIT.TEXTINIT)
|
||||
|
||||
:PREVIOUS-DATE "19-Oct-2025 15:09:09" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;927)
|
||||
:PREVIOUS-DATE "20-Sep-2025 08:49:36" {MEDLEY}<library>tedit>TEDIT-STREAM.;14)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
|
||||
@@ -83,6 +83,10 @@
|
||||
(ADDVARS (INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES
|
||||
\TEDIT.TEXTOBJ.PROPFETCHFN
|
||||
\TEDIT.TEXTOBJ.PROPSTOREFN]
|
||||
[COMS
|
||||
(* ;; "Support for error handling: The old error handler for the stream-not-open error. This is here, because you only want to do this ONCE, even if you load TEXT-STREAM multiple times (as, e.g., in development)")
|
||||
|
||||
(INITVARS (*TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN]
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEDIT.TEXTINIT)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
@@ -122,9 +126,7 @@
|
||||
"The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece")
|
||||
[ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
|
||||
(type? IMAGEOBJ (PCONTENTS DATUM))
|
||||
(PCONTENTS DATUM))
|
||||
(AND (EQ OBJECT.PTYPE (PTYPE DATUM))
|
||||
(SETPC DATUM PCONTENTS NEWVALUE]
|
||||
(PCONTENTS DATUM]
|
||||
PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0)
|
||||
|
||||
(DATATYPE TEXTOBJ (
|
||||
@@ -696,8 +698,6 @@
|
||||
(\TEDIT.TEXTBIN
|
||||
[LAMBDA (TSTREAM)
|
||||
|
||||
(* ;; "Edited 13-Oct-2025 17:16 by rmk")
|
||||
|
||||
(* ;; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
|
||||
(* ;; "Edited 3-May-2024 14:57 by rmk")
|
||||
@@ -767,7 +767,7 @@
|
||||
(if (\ENDOFPIECEP PCCHARSLEFT)
|
||||
then (SETQ PC (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE PC)
|
||||
0))
|
||||
else (\TEDIT.INSTALL.FILEBUFFER TSTREAM PCCHARSLEFT)))
|
||||
else (\TEDIT.INSTALL.FILEBUFFER TSTREAM (SUB1 PCCHARSLEFT))))
|
||||
(if (NOT PC)
|
||||
then (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM)
|
||||
elseif (ffetch (STREAM BINABLE) of TSTREAM)
|
||||
@@ -1232,10 +1232,6 @@
|
||||
(OPENTEXTSTREAM
|
||||
[LAMBDA (TEXT WINDOW START/PROPS END PROPS)
|
||||
|
||||
(* ;; "Edited 2-Dec-2025 17:49 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Sep-2025 21:30 by rmk")
|
||||
|
||||
(* ;; "Edited 9-Sep-2025 22:07 by rmk")
|
||||
|
||||
(* ;; "Edited 17-Feb-2025 08:57 by rmk")
|
||||
@@ -1321,12 +1317,12 @@
|
||||
(if TEXT
|
||||
then (* ;
|
||||
"Verify/open the file before the window")
|
||||
(SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS T))
|
||||
(SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS))
|
||||
(FSETTOBJ TEXTOBJ TXTFILE TEXT)
|
||||
else
|
||||
(* ;; "An empty document starts in an MCCS environment")
|
||||
|
||||
(PUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
|
||||
(FPUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
|
||||
'CHARENCODING
|
||||
'MCCS))
|
||||
|
||||
@@ -1356,8 +1352,7 @@
|
||||
TSTREAM))])
|
||||
|
||||
(COPYTEXTSTREAM
|
||||
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 5-Oct-2025 10:54 by rmk")
|
||||
(* ; "Edited 21-Apr-2025 23:48 by rmk")
|
||||
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 21-Apr-2025 23:48 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 20:10 by rmk")
|
||||
(* ; "Edited 12-Jan-2025 12:16 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
@@ -1377,10 +1372,7 @@
|
||||
|
||||
(LET* ((TSTREAM (TEXTSTREAM ORIGINAL))
|
||||
(TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||
[NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (APPEND (COPY (FGETTOBJ TEXTOBJ EDITPROPS))
|
||||
(for DP in (FGETTOBJ TEXTOBJ DOCPROPS)
|
||||
collect (LIST (CAR DP)
|
||||
(COPY (CDR DP]
|
||||
[NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (COPY (FGETTOBJ TEXTOBJ EDITPROPS]
|
||||
(NEWTEXTOBJ (FTEXTOBJ NEWSTREAM))) (* ;
|
||||
"Create an empty textstream into which the pieces can be hammered")
|
||||
(for PC NEWPC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
@@ -1665,8 +1657,7 @@
|
||||
(SETTOBJ TEXTOBJ DEFAULTPARALOOKS PARALOOKS])
|
||||
|
||||
(\TEDIT.OPENTEXTFILE
|
||||
[LAMBDA (TEXT PROPS ERROR) (* ; "Edited 2-Dec-2025 17:49 by rmk")
|
||||
(* ; "Edited 16-Sep-2025 00:28 by rmk")
|
||||
[LAMBDA (TEXT PROPS) (* ; "Edited 16-Sep-2025 00:28 by rmk")
|
||||
(* ; "Edited 8-Sep-2025 21:52 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 11:38 by rmk")
|
||||
(* ; "Edited 20-Dec-2023 10:49 by rmk")
|
||||
@@ -1677,22 +1668,29 @@
|
||||
(* ; "Edited 17-Sep-2023 21:29 by rmk")
|
||||
(CL:WHEN TEXT
|
||||
(if (\GETSTREAM TEXT 'INPUT T)
|
||||
elseif [AND (OR (LITATOM TEXT)
|
||||
(STRINGP TEXT)
|
||||
(CL:PATHNAMEP TEXT)
|
||||
(STREAMP TEXT))
|
||||
(CAR (NLSETQ (OPENSTREAM (if (STREAMP TEXT)
|
||||
elseif (CL:PATHNAMEP TEXT)
|
||||
then (FINDFILE TEXT T)
|
||||
elseif (FINDFILE-WITH-EXTENSIONS TEXT NIL
|
||||
*TEDIT-EXTENSIONS*)
|
||||
else TEXT)
|
||||
'INPUT
|
||||
'OLD
|
||||
`((TYPE TEXT)
|
||||
(FORMAT ,(LISTGET PROPS 'FORMAT]
|
||||
elseif ERROR
|
||||
then (ERROR "File not found:" TEXT)))])
|
||||
elseif (OR (LITATOM TEXT)
|
||||
(STRINGP TEXT)
|
||||
(CL:PATHNAMEP TEXT)
|
||||
(STREAMP TEXT))
|
||||
then (* ; "String detects empty extension")
|
||||
[RESETSAVE [SETQ TEXT (OPENSTREAM (if (STREAMP TEXT)
|
||||
elseif (OR (CL:PATHNAMEP TEXT)
|
||||
(FILENAMEFIELD.STRING TEXT
|
||||
'EXTENSION))
|
||||
then (FINDFILE TEXT T)
|
||||
elseif (FINDFILE-WITH-EXTENSIONS TEXT NIL
|
||||
*TEDIT-EXTENSIONS*)
|
||||
else TEXT)
|
||||
'INPUT
|
||||
'OLD
|
||||
`((TYPE TEXT)
|
||||
(FORMAT ,(LISTGET PROPS 'FORMAT]
|
||||
'(PROGN (AND RESETSTATE (CLOSEF? OLDVALUE]
|
||||
TEXT
|
||||
else
|
||||
(* ;; "Don't know what it is")
|
||||
|
||||
(ERROR TEXT " does not identify a Tedit document")))])
|
||||
|
||||
(\TEDIT.CREATE.TEXTSTREAM
|
||||
[LAMBDA (PROPS) (* ; "Edited 28-Jul-2025 22:56 by rmk")
|
||||
@@ -1753,7 +1751,7 @@
|
||||
NEWSTREAM])
|
||||
|
||||
(\TEDIT.TEXTINIT
|
||||
[LAMBDA NIL (* ; "Edited 23-Sep-2025 21:03 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 23-Sep-2025 08:19 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")
|
||||
@@ -1793,7 +1791,7 @@
|
||||
(* ;; "(FW8 WORD)")
|
||||
|
||||
(SETQ \TEDITIMAGEOPS (create IMAGEOPS
|
||||
IMAGETYPE _ 'TEDIT
|
||||
IMAGETYPE _ 'TEXT
|
||||
IMXPOSITION _ (FUNCTION \TEDIT.TEXTDSPXPOSITION)
|
||||
IMYPOSITION _ (FUNCTION \TEDIT.TEXTDSPYPOSITION)
|
||||
IMLEFTMARGIN _ (FUNCTION \TEDIT.TEXTLEFTMARGIN)
|
||||
@@ -1823,9 +1821,6 @@
|
||||
(FUNCTION \TEDIT.TEXTOUTCHARFN)
|
||||
(FUNCTION \TEDIT.TEXTFORMATBYTESTREAM)
|
||||
'CR NIL (FUNCTION \TEDIT.TEXTFORMATBYTESTRING))
|
||||
|
||||
(* ;; "Support for error handling: The old error handler for the stream-not-open error. ")
|
||||
|
||||
(SETQ \TEDITFDEV (create FDEV
|
||||
DEVICENAME _ 'TEDIT
|
||||
RESETABLE _ T
|
||||
@@ -1861,9 +1856,6 @@
|
||||
TRUNCATEFILE _ (FUNCTION NILL)
|
||||
WRITEPAGES _ (FUNCTION NILL)
|
||||
DEFAULTEXTERNALFORMAT _ :TEXTSTREAM))
|
||||
(* ;
|
||||
"Only load once, not every time TEDIT-STREAM is loaded e.g. in development")
|
||||
(RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN))
|
||||
(CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
|
||||
(FUNCTION (LAMBDA (CONDITION)
|
||||
(LET ((STREAM (STREAM-ERROR-STREAM CONDITION)))
|
||||
@@ -2108,34 +2100,28 @@
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM PC (- CH# START-OF-PIECE)))])
|
||||
|
||||
(\TEDIT.TEXTDSPXPOSITION
|
||||
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 20-Sep-2025 22:48 by rmk")
|
||||
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 20-Sep-2025 08:30 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:15 by rmk")
|
||||
(* ; "Edited 3-Jan-2001 17:27 by rmk:")
|
||||
(* ;
|
||||
"Edited 24-Oct-88 23:09 by rmk:; Edited 26-Sep-85 16:30 by ajb:")
|
||||
(* ;; "This doesn't make much sense for a character-oriented stream like a TEDIT stream. If the stream is displayed in a window, this returns the window's current position, and changes it as well. But that doesn't affect or particularly relate to the underlying sequence of characters.")
|
||||
|
||||
(* ;; "If there is no window (an OPENTEXTSTREAM being written on by a printing algorithm, like the pretty printer for source files, this estimates the XPOSITION from the number of characters that have been printed on the line since the last TERPRI (= POSITION), assuming that they are all the width of the space (or the average charwidth). And if XPOSITION is non-NIL, that is also translated into an estimated number of characters, and spaces are put out to get out to that position (essentially assuming that we are writing at the end of the file). We can't go backwards.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "We could be more accurate by reading backwards to the last TERPRI, and not rely on POSITION. And if we were going backwards, we could think of this as setting the caret position as close as possible to the specified XPOSITION, But going forward, we still would have to fill in with spaces--and that's the PRETTYPRINT case.")
|
||||
(* ;;
|
||||
"Simply returns the XPOSITION of the primary window's display stream, this is a read-only function")
|
||||
|
||||
(LET ((WINDOW (\TEDIT.PRIMARYPANE TSTREAM))
|
||||
SPACEWIDTH CHARPOS NSPACES) (* ;
|
||||
SPACEWIDTH) (* ;
|
||||
"If there is no window, estimate from character position")
|
||||
(if WINDOW
|
||||
then (DSPXPOSITION XPOSITION WINDOW)
|
||||
else (SETQ SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
|
||||
TSTREAM))
|
||||
(SETQ CHARPOS (POSITION TSTREAM))
|
||||
(PROG1 (TIMES SPACEWIDTH CHARPOS)
|
||||
(CL:WHEN XPOSITION
|
||||
(SETQ NSPACES (IDIFFERENCE (FIXR (FQUOTIENT XPOSITION SPACEWIDTH))
|
||||
CHARPOS))
|
||||
(CL:WHEN (IGREATERP NSPACES 0)
|
||||
(SPACES NSPACES TSTREAM))))])
|
||||
(PROG1 (TIMES SPACEWIDTH (POSITION TSTREAM))
|
||||
(CL:WHEN (AND XPOSITION (IGEQ XPOSITION 0))
|
||||
(SPACES (IDIFFERENCE (QUOTIENT XPOSITION SPACEWIDTH)
|
||||
(POSITION TSTREAM))
|
||||
TSTREAM)))])
|
||||
|
||||
(\TEDIT.TEXTDSPYPOSITION
|
||||
[LAMBDA (TSTREAM YPOSITION) (* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
@@ -2984,8 +2970,7 @@
|
||||
OLDITEMS])
|
||||
|
||||
(\TEDIT.TEXTPROP
|
||||
[LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 5-Oct-2025 10:15 by rmk")
|
||||
(* ; "Edited 17-Jul-2025 00:19 by rmk")
|
||||
[LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 17-Jul-2025 00:19 by rmk")
|
||||
(* ; "Edited 16-Feb-2025 23:27 by rmk")
|
||||
(* ; "Edited 15-Feb-2025 14:02 by rmk")
|
||||
(* ; "Edited 22-Dec-2024 00:23 by rmk")
|
||||
@@ -3071,42 +3056,32 @@
|
||||
(CL:WHEN SETNEWVALUE (FSETTOBJ TEXTOBJ LOOPFN NEWVALUE))))
|
||||
(CHARFN (PROG1 (FGETTOBJ TEXTOBJ CHARFN)
|
||||
(CL:WHEN SETNEWVALUE (FSETTOBJ TEXTOBJ CHARFN NEWVALUE))))
|
||||
(OR (PROG1 (LISTGET (FGETTOBJ TEXTOBJ EDITPROPS)
|
||||
PROP)
|
||||
(CL:WHEN SETNEWVALUE
|
||||
(CL:UNLESS (LISTP (FGETTOBJ TEXTOBJ EDITPROPS))
|
||||
(PROG1 (LISTGET (FGETTOBJ TEXTOBJ EDITPROPS)
|
||||
PROP)
|
||||
(CL:WHEN SETNEWVALUE
|
||||
(CL:UNLESS (LISTP (FGETTOBJ TEXTOBJ EDITPROPS))
|
||||
(* ;
|
||||
"Make sure we have a list to smash, no matter what.")
|
||||
(FSETTOBJ TEXTOBJ EDITPROPS (LIST PROP NIL)))
|
||||
(LISTPUT (FGETTOBJ TEXTOBJ EDITPROPS)
|
||||
PROP NEWVALUE)))
|
||||
(PROG1 (GETMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
|
||||
PROP)
|
||||
(CL:WHEN SETNEWVALUE
|
||||
(PUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
|
||||
PROP NEWVALUE)))])
|
||||
(FSETTOBJ TEXTOBJ EDITPROPS (LIST PROP NIL)))
|
||||
(LISTPUT (FGETTOBJ TEXTOBJ EDITPROPS)
|
||||
PROP NEWVALUE)))])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.TEXTOBJ.PROPNAMES
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 5-Oct-2025 10:50 by rmk")
|
||||
(* ; "Edited 4-Jul-2024 11:08 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 4-Jul-2024 11:08 by rmk")
|
||||
(* ; "Edited 30-Jun-2024 09:04 by rmk")
|
||||
|
||||
(* ;; "Stick the user properties at the end with --USERPROPS-- separator. INSPECTABLEFIELDNAMES does the sort for defined field names, the UFIELDS have to be sorted here.")
|
||||
|
||||
(LET [[TFIELDS (REMOVE 'EDITPROPS (INSPECTABLEFIELDNAMES (OR (RECLOOK 'TEXTOBJ)
|
||||
(LET ([TFIELDS (REMOVE 'EDITPROPS (INSPECTABLEFIELDNAMES (OR (RECLOOK 'TEXTOBJ)
|
||||
(SYSRECLOOK1 'TEXTOBJ]
|
||||
(EPROPS (for X in (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ) by (CDDR X) collect X))
|
||||
(DPROPS (for X in (fetch (TEXTOBJ DOCPROPS) of TEXTOBJ) collect (CAR X]
|
||||
(UFIELDS (for X in (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ) by (CDDR X) collect X)))
|
||||
(CL:UNLESS (OR (EQ T INSPECTDONTSORTFIELDS)
|
||||
(MEMB 'TEXTOBJ INSPECTDONTSORTFIELDS))
|
||||
(SETQ EPROPS (SORT EPROPS))
|
||||
(SETQ DPROPS (SORT DPROPS)))
|
||||
(APPEND TFIELDS (CONS '--EDITPROPS--)
|
||||
EPROPS
|
||||
(CONS '--DOCPROPS--)
|
||||
DPROPS])
|
||||
(SETQ UFIELDS (SORT UFIELDS)))
|
||||
(APPEND TFIELDS (CONS '--USERPROPS--)
|
||||
UFIELDS])
|
||||
|
||||
(\TEDIT.TEXTOBJ.PROPFETCHFN
|
||||
[LAMBDA (TEXTOBJ PROPNAME) (* ; "Edited 4-Jul-2024 11:53 by rmk")
|
||||
@@ -3138,6 +3113,15 @@
|
||||
(ADDTOVAR INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES \TEDIT.TEXTOBJ.PROPFETCHFN
|
||||
\TEDIT.TEXTOBJ.PROPSTOREFN))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"Support for error handling: The old error handler for the stream-not-open error. This is here, because you only want to do this ONCE, even if you load TEXT-STREAM multiple times (as, e.g., in development)"
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(\TEDIT.TEXTINIT)
|
||||
@@ -3151,34 +3135,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 (36887 67703 (\TEDIT.TEXTBIN 36897 . 47647) (\TEDIT.TEXTPEEKBIN 47649 . 53199) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53201 . 58874) (\TEDIT.TEXTBOUT 58876 . 63493) (\TEDIT.INSTALL.FILEBUFFER 63495
|
||||
. 67701)) (68601 72892 (\TEDIT.TEXTOUTCHARFN 68611 . 70167) (\TEDIT.TEXTINCCODEFN 70169 . 70908) (
|
||||
\TEDIT.TEXTBACKCCODEFN 70910 . 71502) (\TEDIT.TEXTFORMATBYTESTREAM 71504 . 72341) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 72343 . 72890)) (72939 84503 (OPENTEXTSTREAM 72949 . 79824) (
|
||||
COPYTEXTSTREAM 79826 . 83726) (TEDIT.STREAMCHANGEDP 83728 . 84030) (TXTFILE 84032 . 84501)) (84504
|
||||
115746 (\TEDIT.REOPENTEXTSTREAM 84514 . 85866) (\TEDIT.OPENTEXTSTREAM.PIECES 85868 . 90796) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 90798 . 91900) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91902 . 97143) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 97145 . 99936) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 99938 . 101877) (
|
||||
\TEDIT.OPENTEXTFILE 101879 . 104356) (\TEDIT.CREATE.TEXTSTREAM 104358 . 105505) (\TEDIT.REOPEN.STREAM
|
||||
105507 . 107843) (\TEDIT.TEXTINIT 107845 . 115744)) (115784 116972 (\TEDIT.TTYBOUT 115794 . 116970)) (
|
||||
117090 137553 (\TEDIT.TEXTCLOSEF 117100 . 118424) (\TEDIT.TEXTDSPFONT 118426 . 119624) (
|
||||
\TEDIT.TEXTEOFP 119626 . 121381) (\TEDIT.TEXTGETEOFPTR 121383 . 121706) (\TEDIT.TEXTSETEOFPTR 121708
|
||||
. 122995) (\TEDIT.TEXTGETFILEPTR 122997 . 125832) (\TEDIT.TEXTSETFILEINFO 125834 . 126342) (
|
||||
\TEDIT.TEXTOPENF 126344 . 127275) (\TEDIT.TEXTSETEOF 127277 . 127893) (\TEDIT.TEXTSETFILEPTR 127895 .
|
||||
130005) (\TEDIT.TEXTDSPXPOSITION 130007 . 131490) (\TEDIT.TEXTDSPYPOSITION 131492 . 132233) (
|
||||
\TEDIT.TEXTLEFTMARGIN 132235 . 132826) (\TEDIT.TEXTCOLOR 132828 . 133411) (\TEDIT.TEXTRIGHTMARGIN
|
||||
133413 . 136702) (\TEDIT.TEXTDSPCHARWIDTH 136704 . 137008) (\TEDIT.TEXTDSPSTRINGWIDTH 137010 . 137316)
|
||||
(\TEDIT.TEXTDSPLINEFEED 137318 . 137551)) (137591 150204 (\TEDIT.NTHCHARCODE 137601 . 139052) (
|
||||
\TEDIT.PIECE.NTHCHARCODE 139054 . 142964) (\TEDIT.RPLCHARCODE 142966 . 144424) (
|
||||
\TEDIT.PIECE.RPLCHARCODE 144426 . 149849) (\TEDIT.NTHCHARLOOKS 149851 . 150202)) (151251 172345 (
|
||||
\TEDIT.DELETE.SELPIECES 151261 . 154886) (\TEDIT.INSERTCH 154888 . 162927) (\TEDIT.INSERTCH.HISTORY
|
||||
162929 . 166393) (\TEDIT.INSERTEOL 166395 . 168220) (\TEDIT.INSERTCH.INSERTION 168222 . 171059) (
|
||||
\TEDIT.INSERTCH.EXTEND 171061 . 172343)) (172346 173850 (\TEDIT.NEXTCHANGEABLE.CHNO 172356 . 173071) (
|
||||
\TEDIT.LASTCHANGEABLE.CHNO 173073 . 173848)) (173851 175555 (\SETUPGETCH 173861 . 175553)) (175613
|
||||
180071 (\TEDIT.INSTALL.PIECE 175623 . 180069)) (180109 189210 (TEXTPROP 180119 . 180466) (GETTEXTPROP
|
||||
180468 . 180712) (PUTTEXTPROP 180714 . 180971) (GETTEXTPROPS 180973 . 181417) (PUTTEXTPROPS 181419 .
|
||||
182323) (TEXTPROP.ADD 182325 . 182588) (\TEDIT.TEXTPROP 182590 . 189208)) (189211 191281 (
|
||||
\TEDIT.TEXTOBJ.PROPNAMES 189221 . 190173) (\TEDIT.TEXTOBJ.PROPFETCHFN 190175 . 190691) (
|
||||
\TEDIT.TEXTOBJ.PROPSTOREFN 190693 . 191279)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Jan-2026 12:15:57" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;190 98203
|
||||
(FILECREATED " 7-Sep-2025 11:11:43"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;187 97463
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS BRAVOFILEP)
|
||||
(VARS TEDIT-TFBRAVOCOMS)
|
||||
:CHANGES-TO (FNS TEDITFROMBRAVO \TFBRAVO.FONT.FROM.CHARLOOKS)
|
||||
|
||||
:PREVIOUS-DATE " 7-Sep-2025 11:11:43" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;187)
|
||||
:PREVIOUS-DATE "28-Jul-2025 23:34:14" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;185)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
|
||||
@@ -20,12 +20,10 @@
|
||||
(CONSTANTS (BRAVO.TRAILER.CHARS '(l d z x e y k j c q %( %) %, s S u U b B i I g G v V
|
||||
w W t f o % \ 0 1 2 3 4 5 6 7 8 9]
|
||||
|
||||
(* ;; "Interface to TEDIT and CONVERT.TO.IMAGE.FILE")
|
||||
(* ;; "Interface to TEDIT")
|
||||
|
||||
(FNS BRAVOFILEP TEDITFROMBRAVO)
|
||||
(ADDVARS (TEDIT.INPUT.FORMATS (BRAVOFILEP TEDITFROMBRAVO)))
|
||||
(ALISTS (PRINTFILETYPES BRAVO))
|
||||
[P (DEFAULT.IMAGETYPE.CONVERSIONS '(BRAVO TEDIT.TO.IMAGEFILE]
|
||||
(FNS TEDIT.BRAVOFILE? TEDITFROMBRAVO)
|
||||
(ADDVARS (TEDIT.INPUT.FORMATS (TEDIT.BRAVOFILE? TEDITFROMBRAVO)))
|
||||
|
||||
(* ;; "Initial looks, USER.CM")
|
||||
|
||||
@@ -156,44 +154,36 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "Interface to TEDIT and CONVERT.TO.IMAGE.FILE")
|
||||
(* ;; "Interface to TEDIT")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(BRAVOFILEP
|
||||
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 21-Jan-2026 12:15 by rmk")
|
||||
(* ; "Edited 28-Nov-2023 10:34 by rmk")
|
||||
(TEDIT.BRAVOFILE?
|
||||
[LAMBDA (STREAM TEXTOBJ) (* ; "Edited 28-Nov-2023 10:34 by rmk")
|
||||
(* ; "Edited 17-Aug-2023 08:09 by rmk")
|
||||
(* ; "Edited 11-Aug-2023 22:59 by rmk")
|
||||
(* ; "Edited 5-Aug-2023 23:05 by rmk")
|
||||
(* ; "Edited 1-Aug-2023 08:15 by rmk")
|
||||
(* gbn " 3-Jun-85 21:06")
|
||||
|
||||
(* ;; "T if FILE looks like a Bravo file.")
|
||||
(* ;; "T if the open STREAM looks like a Bravo file.")
|
||||
|
||||
(RESETLST
|
||||
(PROG* ((STREAM (\GETSTREAM FILE 'INPUT T))
|
||||
(ORIGINAL.FILE.POSITION (CL:IF STREAM
|
||||
(GETFILEPTR STREAM)
|
||||
0))
|
||||
PLOOKS ENDCONDITION NAME DIRS USER.CM) (* ;
|
||||
(PROG (PLOOKS ENDCONDITION (ORIGINAL.FILE.POSITION (GETFILEPTR STREAM))
|
||||
NAME DIRS USER.CM) (* ;
|
||||
"first look for a ^z, (beginning of a Bravo trailer)")
|
||||
(CL:UNLESS STREAM
|
||||
[RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT))
|
||||
`(PROGN (CLOSEF? OLDVALUE])
|
||||
(CL:UNLESS (\TFBRAVO.FIND.LAST.TRAILER STREAM)
|
||||
(SETFILEPTR STREAM ORIGINAL.FILE.POSITION)
|
||||
(RETURN NIL)) (* ; "BIN past the ^z")
|
||||
(BIN STREAM)
|
||||
(SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS STREAM)) (* ;
|
||||
(CL:UNLESS (\TFBRAVO.FIND.LAST.TRAILER STREAM)
|
||||
(SETFILEPTR STREAM ORIGINAL.FILE.POSITION)
|
||||
(RETURN NIL)) (* ; "BIN past the ^z")
|
||||
(BIN STREAM)
|
||||
(SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS STREAM)) (* ;
|
||||
"if the next symbol is a slash then check if the character looks are valid")
|
||||
[SETQ ENDCONDITION (CL:WHEN (EQ (CAR PLOOKS)
|
||||
'\)
|
||||
(repeatuntil (\TEST.CHARACTER.LOOKS STREAM)))]
|
||||
(SETFILEPTR STREAM ORIGINAL.FILE.POSITION)
|
||||
(CL:WHEN (EQ ENDCONDITION 'BADLOOKS)
|
||||
(RETURN NIL))
|
||||
(RETURN T)))])
|
||||
[SETQ ENDCONDITION (CL:WHEN (EQ (CAR PLOOKS)
|
||||
'\)
|
||||
(repeatuntil (\TEST.CHARACTER.LOOKS STREAM)))]
|
||||
(SETFILEPTR STREAM ORIGINAL.FILE.POSITION)
|
||||
(CL:WHEN (EQ ENDCONDITION 'BADLOOKS)
|
||||
(RETURN NIL))
|
||||
(RETURN T])
|
||||
|
||||
(TEDITFROMBRAVO
|
||||
[LAMBDA (BFILE TSTREAM PROPS USER.CM) (* ; "Edited 7-Sep-2025 11:09 by rmk")
|
||||
@@ -264,12 +254,7 @@
|
||||
(RETURN TSTREAM)))])
|
||||
)
|
||||
|
||||
(ADDTOVAR TEDIT.INPUT.FORMATS (BRAVOFILEP TEDITFROMBRAVO))
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES (BRAVO (TEST BRAVOFILEP)
|
||||
(EXTENSION (BRAVO))))
|
||||
|
||||
(DEFAULT.IMAGETYPE.CONVERSIONS '(BRAVO TEDIT.TO.IMAGEFILE))
|
||||
(ADDTOVAR TEDIT.INPUT.FORMATS (TEDIT.BRAVOFILE? TEDITFROMBRAVO))
|
||||
|
||||
|
||||
|
||||
@@ -1571,18 +1556,18 @@
|
||||
(AND NIL (\TEDIT.NAMEDTAB.INIT))
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (7784 15335 (BRAVOFILEP 7794 . 9981) (TEDITFROMBRAVO 9983 . 15333)) (15610 32026 (
|
||||
\TFBRAVO.GET.USER.CM 15620 . 18800) (\TFBRAVO.USER.CM.LOOKS 18802 . 20295) (\TFBRAVO.READ.USER.CM
|
||||
20297 . 24920) (\TFBRAVO.INIT.PARALOOKS 24922 . 27139) (\TFBRAVO.INIT.PAGEFORMAT 27141 . 28021) (
|
||||
\TFBRAVO.GETPARAMS 28023 . 30877) (\TFBRAVO.FIND.LAST.TRAILER 30879 . 32024)) (32068 52773 (
|
||||
\TFBRAVO.PARSE.PARA 32078 . 36005) (\TFBRAVO.READ.PARALOOKS 36007 . 42897) (\TFBRAVO.CREATE.RUNS 42899
|
||||
. 44287) (\TFBRAVO.READ.CHARLOOKS 44289 . 49318) (\TFBRAVO.FONT.FROM.CHARLOOKS 49320 . 50874) (
|
||||
\TFBRAVO.READNUM? 50876 . 52771)) (52810 63851 (\TFBRAVO.HANDLE.HEADING 52820 . 55547) (
|
||||
\TFBRAVO.PARSE.PROFILE.PARA 55549 . 63849)) (63894 86228 (\TFBRAVO.INSERT.PARA 63904 . 64745) (
|
||||
\TFBRAVO.INSERT.RUN 64747 . 68238) (\TFBRAVO.SPLIT.PARA 68240 . 75664) (\TFBRAVO.RUN.TABSPEC 75666 .
|
||||
80533) (\TFBRAVO.INSTALL.PAGEFORMAT 80535 . 86226)) (86229 90372 (\TFBRAVO.ASSERT 86239 . 86769) (
|
||||
\TEST.CHARACTER.LOOKS 86771 . 88657) (\TEST.PARAGRAPH.LOOKS 88659 . 90370)) (91382 98037 (
|
||||
\TFBRAVO.ADD.NAMEDTAB 91392 . 94995) (\TFBRAVO.COPY.NAMEDTAB 94997 . 95445) (\TFBRAVO.PUT.NAMEDTAB
|
||||
95447 . 95727) (\TFBRAVO.GET.NAMEDTAB 95729 . 96106) (\NAMEDTABNYET 96108 . 96268) (\NAMEDTABSIZE
|
||||
96270 . 96785) (\NAMEDTABPREPRINT 96787 . 96985) (\TEDIT.NAMEDTAB.INIT 96987 . 98035)))))
|
||||
(FILEMAP (NIL (7665 14759 (TEDIT.BRAVOFILE? 7675 . 9405) (TEDITFROMBRAVO 9407 . 14757)) (14870 31286 (
|
||||
\TFBRAVO.GET.USER.CM 14880 . 18060) (\TFBRAVO.USER.CM.LOOKS 18062 . 19555) (\TFBRAVO.READ.USER.CM
|
||||
19557 . 24180) (\TFBRAVO.INIT.PARALOOKS 24182 . 26399) (\TFBRAVO.INIT.PAGEFORMAT 26401 . 27281) (
|
||||
\TFBRAVO.GETPARAMS 27283 . 30137) (\TFBRAVO.FIND.LAST.TRAILER 30139 . 31284)) (31328 52033 (
|
||||
\TFBRAVO.PARSE.PARA 31338 . 35265) (\TFBRAVO.READ.PARALOOKS 35267 . 42157) (\TFBRAVO.CREATE.RUNS 42159
|
||||
. 43547) (\TFBRAVO.READ.CHARLOOKS 43549 . 48578) (\TFBRAVO.FONT.FROM.CHARLOOKS 48580 . 50134) (
|
||||
\TFBRAVO.READNUM? 50136 . 52031)) (52070 63111 (\TFBRAVO.HANDLE.HEADING 52080 . 54807) (
|
||||
\TFBRAVO.PARSE.PROFILE.PARA 54809 . 63109)) (63154 85488 (\TFBRAVO.INSERT.PARA 63164 . 64005) (
|
||||
\TFBRAVO.INSERT.RUN 64007 . 67498) (\TFBRAVO.SPLIT.PARA 67500 . 74924) (\TFBRAVO.RUN.TABSPEC 74926 .
|
||||
79793) (\TFBRAVO.INSTALL.PAGEFORMAT 79795 . 85486)) (85489 89632 (\TFBRAVO.ASSERT 85499 . 86029) (
|
||||
\TEST.CHARACTER.LOOKS 86031 . 87917) (\TEST.PARAGRAPH.LOOKS 87919 . 89630)) (90642 97297 (
|
||||
\TFBRAVO.ADD.NAMEDTAB 90652 . 94255) (\TFBRAVO.COPY.NAMEDTAB 94257 . 94705) (\TFBRAVO.PUT.NAMEDTAB
|
||||
94707 . 94987) (\TFBRAVO.GET.NAMEDTAB 94989 . 95366) (\NAMEDTABNYET 95368 . 95528) (\NAMEDTABSIZE
|
||||
95530 . 96045) (\NAMEDTABPREPRINT 96047 . 96245) (\TEDIT.NAMEDTAB.INIT 96247 . 97295)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Dec-2025 11:22:33" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;883 231422
|
||||
(FILECREATED "15-Nov-2025 01:27:38" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;881 231034
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.MINIMAL.WINDOW.SETUP TEDIT.PROMPTCLEAR TEDIT.PROMPTPRINT)
|
||||
:CHANGES-TO (FNS \TEDIT.WINDOW.CREATE)
|
||||
|
||||
:PREVIOUS-DATE "15-Nov-2025 01:27:38" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;881)
|
||||
:PREVIOUS-DATE "25-Oct-2025 10:33:08" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;878)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
|
||||
@@ -608,9 +608,7 @@
|
||||
(\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE])
|
||||
|
||||
(\TEDIT.MINIMAL.WINDOW.SETUP
|
||||
[LAMBDA (PANEWINDOW TSTREAM PROPS) (* ; "Edited 23-Dec-2025 23:41 by rmk")
|
||||
(* ; "Edited 20-Dec-2025 23:04 by rmk")
|
||||
(* ; "Edited 19-Oct-2025 14:55 by rmk")
|
||||
[LAMBDA (PANEWINDOW TSTREAM PROPS) (* ; "Edited 19-Oct-2025 14:55 by rmk")
|
||||
(* ; "Edited 20-Apr-2025 15:19 by rmk")
|
||||
(* ; "Edited 30-Nov-2024 13:32 by rmk")
|
||||
(* ; "Edited 4-Nov-2024 19:46 by rmk")
|
||||
@@ -689,7 +687,8 @@
|
||||
(WINDOWPROP PANEWINDOW 'CURSOROUTFN (FUNCTION \TEDIT.CURSOROUTFN))
|
||||
(WINDOWPROP PANEWINDOW 'BUTTONEVENTFN (FUNCTION \TEDIT.BUTTONEVENTFN))
|
||||
(WINDOWPROP PANEWINDOW 'RIGHTBUTTONFN (FUNCTION \TEDIT.BUTTONEVENTFN))
|
||||
(WINDOWPROP PANEWINDOW 'IMAGETYPE 'TEDIT) (* ; "For hardcopy")
|
||||
(WINDOWPROP PANEWINDOW 'HARDCOPYFN (FUNCTION TEDIT.HARDCOPYFN))
|
||||
(WINDOWPROP PANEWINDOW 'HARDCOPYFILEFN (FUNCTION \TEDIT.HARDCOPYFILEFN))
|
||||
(WINDOWPROP PANEWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN))
|
||||
(WINDOWPROP PANEWINDOW 'REPAINTFN (FUNCTION \TEDIT.REPAINTFN))
|
||||
(WINDOWPROP PANEWINDOW 'AFTERMOVEFN (FUNCTION \TEDIT.AFTERMOVEFN))
|
||||
@@ -2060,8 +2059,7 @@
|
||||
PROMPTWINDOW])
|
||||
|
||||
(TEDIT.PROMPTPRINT
|
||||
[LAMBDA (TSTREAM MSG CLEAR? FLASH?) (* ; "Edited 14-Dec-2025 17:41 by rmk")
|
||||
(* ; "Edited 29-Dec-2024 14:45 by rmk")
|
||||
[LAMBDA (TEXTSTREAM MSG CLEAR? FLASH?) (* ; "Edited 29-Dec-2024 14:45 by rmk")
|
||||
(* ; "Edited 26-Nov-2023 10:10 by rmk")
|
||||
(* ; "Edited 10-Sep-2023 00:27 by rmk")
|
||||
(* ; "Edited 30-Jul-2023 08:52 by rmk")
|
||||
@@ -2072,7 +2070,7 @@
|
||||
|
||||
(* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow). Optionally clear the window first.")
|
||||
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM T))
|
||||
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM T))
|
||||
PWINDOW MAINWINDOW)
|
||||
(if TEXTOBJ
|
||||
then (CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ))
|
||||
@@ -2080,7 +2078,7 @@
|
||||
(CAR (NLSETQ (SELECTQ PWINDOW
|
||||
(DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND)
|
||||
(GETPROMPTWINDOW MAINWINDOW)))
|
||||
(NIL (CL:WHEN TSTREAM
|
||||
(NIL (CL:WHEN TEXTSTREAM
|
||||
[GETPROMPTWINDOW MAINWINDOW NIL NIL
|
||||
(NOT (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND]))
|
||||
PWINDOW]) (* ;
|
||||
@@ -2099,15 +2097,15 @@
|
||||
else (PROMPTPRINT MSG])
|
||||
|
||||
(TEDIT.PROMPTCLEAR
|
||||
[LAMBDA (TSTREAM FONT) (* ; "Edited 14-Dec-2025 17:34 by rmk")
|
||||
(* ; "Edited 18-Sep-2025 23:08 by rmk")
|
||||
[LAMBDA (TSTREAM FONT) (* ; "Edited 18-Sep-2025 23:08 by rmk")
|
||||
(* ; "Edited 14-Mar-98 12:52 by rmk:")
|
||||
(* ; "Edited 14-Oct-87 15:35 by bvm:")
|
||||
|
||||
(* ;; "Clears the promptwindow attached to TSTREAM and shrinks it back to a single line in font FONT (or TEDIT.PROMPT.FONT) if it has grown. [TSTREAM could actually be a stream on the promptwindow itself.--is that true, does this code need to deal with that?]")
|
||||
|
||||
(LET* [(MW (\TEDIT.MAINW TSTREAM))
|
||||
(PW (AND MW (GETPROMPTWINDOW MW NIL NIL (NOT (GETTEXTPROP TSTREAM 'PWINDOW.ON.DEMAND]
|
||||
(PW (AND MW (WINDOWPROP (\TEDIT.MAINW TSTREAM)
|
||||
'TEDIT.PROMPTWINDOW]
|
||||
(CL:WHEN PW
|
||||
(WINDOWPROP PW 'TEDIT.NLINES 1)
|
||||
(CL:WHEN [AND (SETQ MW (WINDOWPROP PW 'MAINWINDOW))
|
||||
@@ -3664,36 +3662,36 @@
|
||||
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
|
||||
TEDIT.ICON.TITLE.REGION))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (17143 18039 (TEDIT.DEFER.UPDATES 17153 . 18037)) (18040 45281 (\TEDIT.WINDOW.CREATE
|
||||
18050 . 24913) (\TEDIT.WINDOW.GETREGION 24915 . 29619) (\TEDIT.WINDOW.SETUP 29621 . 33951) (
|
||||
\TEDIT.MINIMAL.WINDOW.SETUP 33953 . 41913) (\TEDIT.CLEARPANE 41915 . 42632) (\TEDIT.FILL.PANES 42634
|
||||
. 45279)) (45282 68983 (\TEDIT.CURSORMOVEDFN 45292 . 50902) (\TEDIT.CURSOROUTFN 50904 . 51592) (
|
||||
\TEDIT.ACTIVE.WINDOWP 51594 . 52664) (\TEDIT.EXPANDFN 52666 . 53229) (\TEDIT.MAINW 53231 . 54511) (
|
||||
\TEDIT.MAINSTREAM 54513 . 54847) (\TEDIT.PRIMARYPANE 54849 . 55619) (\TEDIT.PANELIST 55621 . 56117) (
|
||||
\TEDIT.NEWREGIONFN 56119 . 58635) (\TEDIT.SET.WINDOW.EXTENT 58637 . 63619) (\TEDIT.SHRINK.ICONCREATE
|
||||
63621 . 66354) (\TEDIT.SHRINKFN 66356 . 66765) (\TEDIT.PANEREGION 66767 . 68981)) (69015 102061 (
|
||||
\TEDIT.BUTTONEVENTFN 69025 . 81998) (\TEDIT.BUTTONEVENTFN.DOOPERATION 82000 . 89263) (
|
||||
\TEDIT.BUTTONEVENTFN.GETOPERATION 89265 . 91107) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 91109 . 94779) (
|
||||
\TEDIT.BUTTONEVENTFN.INACTIVE 94781 . 97211) (\TEDIT.BUTTONEVENTFN.INTITLE 97213 . 99048) (
|
||||
\TEDIT.COPYINSERTFN 99050 . 100182) (\TEDIT.FOREIGN.COPY 100184 . 102059)) (102062 119625 (
|
||||
\TEDIT.PANE.SPLIT 102072 . 106020) (\TEDIT.SPLITW 106022 . 114081) (\TEDIT.UNSPLITW 114083 . 118282) (
|
||||
\TEDIT.LINKPANES 118284 . 119047) (\TEDIT.UNLINKPANE 119049 . 119623)) (121059 121950 (TEDITWINDOWP
|
||||
121069 . 121948)) (121987 125090 (TEDIT.GETINPUT 121997 . 124440) (\TEDIT.MAKEFILENAME 124442 . 125088
|
||||
)) (125139 132985 (TEDIT.PROMPTWINDOW 125149 . 125463) (TEDIT.PROMPTPRINT 125465 . 128195) (
|
||||
TEDIT.PROMPTCLEAR 128197 . 130032) (TEDIT.PROMPTFLASH 130034 . 131292) (\TEDIT.PROMPT.PAGEFULLFN
|
||||
131294 . 132983)) (133223 143801 (\TEDIT.FILENAME 133233 . 134005) (\TEDIT.DEFAULT.TITLE 134007 .
|
||||
136386) (\TEDIT.WINDOW.TITLE 136388 . 138557) (\TEDIT.LIKELY.FILENAME 138559 . 141283) (
|
||||
\TEDIT.UPDATE.TITLE 141285 . 143799)) (143844 156328 (TEDIT.DEACTIVATE.WINDOW 143854 . 149427) (
|
||||
\TEDIT.RESHAPEFN 149429 . 151514) (\TEDIT.REPAINTFN 151516 . 151740) (\TEDIT.CLOSESPLITS 151742 .
|
||||
154187) (\TEDIT.CLOSEPANE 154189 . 156326)) (156329 199128 (\TEDIT.SCROLLFN 156339 . 158570) (
|
||||
\TEDIT.SCROLLCH.TOP 158572 . 160683) (\TEDIT.SCROLLCH.BOTTOM 160685 . 165015) (\TEDIT.SCROLLUP 165017
|
||||
. 170743) (\TEDIT.TOPLINE.YTOP 170745 . 172414) (\TEDIT.SCROLLDOWN 172416 . 179455) (
|
||||
\TEDIT.SCROLL.CARET 179457 . 182295) (\TEDIT.VISIBLECARETP 182297 . 184591) (\TEDIT.VISIBLECHARP
|
||||
184593 . 185684) (\TEDIT.BITMAPLINES 185686 . 189606) (\TEDIT.SETPANE.TOPLINE 189608 . 190220) (
|
||||
\TEDIT.SHIFTLINES 190222 . 199126)) (199129 209998 (\TEDIT.ONSCREEN? 199139 . 203690) (
|
||||
\TEDIT.ONSCREEN.REGION 203692 . 207343) (\TEDIT.AFTERMOVEFN 207345 . 208242) (OFFSCREENP 208244 .
|
||||
209996)) (210040 212854 (\TEDIT.PROCIDLEFN 210050 . 211710) (\TEDIT.PROCENTRYFN 211712 . 212157) (
|
||||
\TEDIT.PROCEXITFN 212159 . 212852)) (212933 226158 (\TEDIT.DOWNCARET 212943 . 213736) (
|
||||
\TEDIT.FLASHCARET 213738 . 215849) (\TEDIT.UPCARET 215851 . 216955) (TEDIT.NORMALIZECARET 216957 .
|
||||
220175) (\TEDIT.SETCARET 220177 . 225528) (\TEDIT.CARET 225530 . 226156)))))
|
||||
(FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 45089 (\TEDIT.WINDOW.CREATE
|
||||
18007 . 24870) (\TEDIT.WINDOW.GETREGION 24872 . 29576) (\TEDIT.WINDOW.SETUP 29578 . 33908) (
|
||||
\TEDIT.MINIMAL.WINDOW.SETUP 33910 . 41721) (\TEDIT.CLEARPANE 41723 . 42440) (\TEDIT.FILL.PANES 42442
|
||||
. 45087)) (45090 68791 (\TEDIT.CURSORMOVEDFN 45100 . 50710) (\TEDIT.CURSOROUTFN 50712 . 51400) (
|
||||
\TEDIT.ACTIVE.WINDOWP 51402 . 52472) (\TEDIT.EXPANDFN 52474 . 53037) (\TEDIT.MAINW 53039 . 54319) (
|
||||
\TEDIT.MAINSTREAM 54321 . 54655) (\TEDIT.PRIMARYPANE 54657 . 55427) (\TEDIT.PANELIST 55429 . 55925) (
|
||||
\TEDIT.NEWREGIONFN 55927 . 58443) (\TEDIT.SET.WINDOW.EXTENT 58445 . 63427) (\TEDIT.SHRINK.ICONCREATE
|
||||
63429 . 66162) (\TEDIT.SHRINKFN 66164 . 66573) (\TEDIT.PANEREGION 66575 . 68789)) (68823 101869 (
|
||||
\TEDIT.BUTTONEVENTFN 68833 . 81806) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81808 . 89071) (
|
||||
\TEDIT.BUTTONEVENTFN.GETOPERATION 89073 . 90915) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90917 . 94587) (
|
||||
\TEDIT.BUTTONEVENTFN.INACTIVE 94589 . 97019) (\TEDIT.BUTTONEVENTFN.INTITLE 97021 . 98856) (
|
||||
\TEDIT.COPYINSERTFN 98858 . 99990) (\TEDIT.FOREIGN.COPY 99992 . 101867)) (101870 119433 (
|
||||
\TEDIT.PANE.SPLIT 101880 . 105828) (\TEDIT.SPLITW 105830 . 113889) (\TEDIT.UNSPLITW 113891 . 118090) (
|
||||
\TEDIT.LINKPANES 118092 . 118855) (\TEDIT.UNLINKPANE 118857 . 119431)) (120867 121758 (TEDITWINDOWP
|
||||
120877 . 121756)) (121795 124898 (TEDIT.GETINPUT 121805 . 124248) (\TEDIT.MAKEFILENAME 124250 . 124896
|
||||
)) (124947 132597 (TEDIT.PROMPTWINDOW 124957 . 125271) (TEDIT.PROMPTPRINT 125273 . 127900) (
|
||||
TEDIT.PROMPTCLEAR 127902 . 129644) (TEDIT.PROMPTFLASH 129646 . 130904) (\TEDIT.PROMPT.PAGEFULLFN
|
||||
130906 . 132595)) (132835 143413 (\TEDIT.FILENAME 132845 . 133617) (\TEDIT.DEFAULT.TITLE 133619 .
|
||||
135998) (\TEDIT.WINDOW.TITLE 136000 . 138169) (\TEDIT.LIKELY.FILENAME 138171 . 140895) (
|
||||
\TEDIT.UPDATE.TITLE 140897 . 143411)) (143456 155940 (TEDIT.DEACTIVATE.WINDOW 143466 . 149039) (
|
||||
\TEDIT.RESHAPEFN 149041 . 151126) (\TEDIT.REPAINTFN 151128 . 151352) (\TEDIT.CLOSESPLITS 151354 .
|
||||
153799) (\TEDIT.CLOSEPANE 153801 . 155938)) (155941 198740 (\TEDIT.SCROLLFN 155951 . 158182) (
|
||||
\TEDIT.SCROLLCH.TOP 158184 . 160295) (\TEDIT.SCROLLCH.BOTTOM 160297 . 164627) (\TEDIT.SCROLLUP 164629
|
||||
. 170355) (\TEDIT.TOPLINE.YTOP 170357 . 172026) (\TEDIT.SCROLLDOWN 172028 . 179067) (
|
||||
\TEDIT.SCROLL.CARET 179069 . 181907) (\TEDIT.VISIBLECARETP 181909 . 184203) (\TEDIT.VISIBLECHARP
|
||||
184205 . 185296) (\TEDIT.BITMAPLINES 185298 . 189218) (\TEDIT.SETPANE.TOPLINE 189220 . 189832) (
|
||||
\TEDIT.SHIFTLINES 189834 . 198738)) (198741 209610 (\TEDIT.ONSCREEN? 198751 . 203302) (
|
||||
\TEDIT.ONSCREEN.REGION 203304 . 206955) (\TEDIT.AFTERMOVEFN 206957 . 207854) (OFFSCREENP 207856 .
|
||||
209608)) (209652 212466 (\TEDIT.PROCIDLEFN 209662 . 211322) (\TEDIT.PROCENTRYFN 211324 . 211769) (
|
||||
\TEDIT.PROCEXITFN 211771 . 212464)) (212545 225770 (\TEDIT.DOWNCARET 212555 . 213348) (
|
||||
\TEDIT.FLASHCARET 213350 . 215461) (\TEDIT.UPCARET 215463 . 216567) (TEDIT.NORMALIZECARET 216569 .
|
||||
219787) (\TEDIT.SETCARET 219789 . 225140) (\TEDIT.CARET 225142 . 225768)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,11 +1,9 @@
|
||||
(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 "20-Sep-2025 11:04:51"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;242 52344
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "20-Sep-2025 11:04:51" {WMEDLEY}<library>TEDIT>tedit-exports.all;242)
|
||||
:EDIT-BY rmk)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
|
||||
@@ -17,7 +15,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 " 8-Sep-2025 22:10:20"))
|
||||
(RPAQQ \BTREEWORDSPERSLOT 4)
|
||||
(RPAQQ \BTREEMAXCOUNT 8)
|
||||
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
||||
@@ -260,7 +258,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 " 7-Aug-2025 12:51:00"))
|
||||
(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)."
|
||||
@@ -277,8 +275,8 @@ PNEW FLAG) (* ;
|
||||
XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PCHARSET BYTE) (* ;
|
||||
"High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ;
|
||||
"The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") (ACCESSFNS ((
|
||||
POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM)) (AND (
|
||||
EQ OBJECT.PTYPE (PTYPE DATUM)) (SETPC DATUM PCONTENTS NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0)
|
||||
POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM)))))
|
||||
PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0)
|
||||
(DATATYPE TEXTOBJ ((* ;;
|
||||
"This is where TEdit stores its state information, and internal data about the text being edited.")
|
||||
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ;
|
||||
@@ -440,7 +438,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 "20-Sep-2025 08:49:36"))
|
||||
(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))
|
||||
@@ -454,7 +452,7 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
|
||||
\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 " 9-Sep-2025 21:49:43"))
|
||||
(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 +535,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 " 9-Sep-2025 21:55:31"))
|
||||
(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,9 +598,9 @@ 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-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-WINDOW) (QUOTE IMPORTDATE) (IDATE "18-Sep-2025 23:09:24"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "30-Apr-2025 14:09:18"))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "10-Sep-2025 17:08:43"))
|
||||
(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
|
||||
@@ -659,7 +657,7 @@ 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-PAGE) (QUOTE IMPORTDATE) (IDATE "19-Sep-2025 22:09:03"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE " 6-Sep-2025 00:10:45"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE " 7-Sep-2025 11:11:43"))
|
||||
(DECLARE%: DONTCOPY
|
||||
|
||||
187
lispusers/BLOCKS-HKB
Normal file
187
lispusers/BLOCKS-HKB
Normal file
@@ -0,0 +1,187 @@
|
||||
(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
lispusers/BLOCKS-HKB.LCOM
Normal file
1
lispusers/BLOCKS-HKB.LCOM
Normal file
@@ -0,0 +1 @@
|
||||
(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 "26-Dec-2025 16:37:05" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;4 14367
|
||||
(FILECREATED " 5-Feb-2025 17:03:38" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;11 9743
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS FontSample)
|
||||
:CHANGES-TO (FNS FontSample FontTable)
|
||||
|
||||
:PREVIOUS-DATE " 9-Dec-2025 14:00:20" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;3
|
||||
:PREVIOUS-DATE " 3-Feb-2025 20:08:40" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;10
|
||||
)
|
||||
|
||||
|
||||
@@ -20,77 +20,31 @@
|
||||
(DEFINEQ
|
||||
|
||||
(FontSample
|
||||
[LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal ColumnMajor NoSlugOnlyCS)
|
||||
(* ; "Edited 26-Dec-2025 16:25 by mth")
|
||||
(* ; "Edited 9-Dec-2025 13:48 by mth")
|
||||
(* ; "Edited 5-Dec-2025 11:06 by mth")
|
||||
[LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal)
|
||||
(* ; "Edited 5-Feb-2025 17:02 by mth")
|
||||
(* ; "Edited 29-Apr-87 22:03")
|
||||
(LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (SETQ StreamType (OR StreamType (PRINTERTYPE Printer]
|
||||
(* edited%: "29-Apr-87 22:03")
|
||||
(LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer]
|
||||
(FontList (if (LISTP Fonts)
|
||||
else (CONS Fonts)))
|
||||
[Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (CONS TitleFont FontList]
|
||||
(InchesToPrinterUnits (FTIMES 72.0 (DSPSCALE NIL Stream)))
|
||||
(LastFont (CAR (LAST FontList)))
|
||||
(AllCharacterSets (CONSTANT (for CS from 0 to 255 collect CS]
|
||||
(CL:UNLESS [OR (LISTP CharacterSets)
|
||||
(MEMB CharacterSets '(T :INCORE :ALL :INTERESTING]
|
||||
(SETQ CharacterSets (LIST (OR CharacterSets 0))))
|
||||
[CharacterSets (if (LISTP CharacterSets)
|
||||
then CharacterSets
|
||||
else (LIST (OR CharacterSets 0]
|
||||
(LastCharacterSet (CAR (LAST CharacterSets]
|
||||
(DSPRIGHTMARGIN (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL Stream))
|
||||
Stream)
|
||||
(for Font in FontList do
|
||||
(* ;; "Check for the special charset list builders")
|
||||
|
||||
(LET (FontCharacterSets (SlugCharsetInfo (\GETCHARSETINFO Font
|
||||
SLUGCHARSET)))
|
||||
(SETQ FontCharacterSets
|
||||
(SELECTQ CharacterSets
|
||||
(:ALL
|
||||
(* ;; "Forcibly install ALL CharacterSets.")
|
||||
|
||||
(for CS in AllCharacterSets
|
||||
when (\INSURECHARSETINFO Font CS) collect
|
||||
CS))
|
||||
(:INTERESTING (for CS in *INTERESTING-CHARSETS*
|
||||
when (\INSURECHARSETINFO Font CS)
|
||||
collect CS))
|
||||
((T :INCORE)
|
||||
(for CS in AllCharacterSets
|
||||
when (\GETCHARSETINFO Font CS) collect CS))
|
||||
CharacterSets))
|
||||
|
||||
(* ;;
|
||||
"If requested to do so, exclude any CharacterSet known to reference the SlugCharsetInfo")
|
||||
|
||||
(CL:WHEN (AND NoSlugOnlyCS SlugCharsetInfo)
|
||||
|
||||
(* ;;
|
||||
"Only if SlugCharsetInfo is non-NIL, else it won't load a requested charset")
|
||||
|
||||
(SETQ FontCharacterSets
|
||||
(for CS in FontCharacterSets
|
||||
unless (EQ SlugCharsetInfo (\GETCHARSETINFO Font CS))
|
||||
collect CS)))
|
||||
|
||||
(* ;;
|
||||
"Probably ought to report charsets eliminated by the above.")
|
||||
|
||||
(* ;; " At least report if NO charsets remain for this font.")
|
||||
|
||||
(CL:UNLESS FontCharacterSets (printout T
|
||||
"All requested character sets are empty for this font: "
|
||||
Font T))
|
||||
(for CharacterSet in FontCharacterSets
|
||||
bind (LastCharacterSet _ (CAR (LAST FontCharacterSets)))
|
||||
do (FontTable Font CharacterSet Stream
|
||||
(OR (NEQ Font LastFont)
|
||||
(NEQ CharacterSet LastCharacterSet))
|
||||
TitleFont InchesToPrinterUnits Hexadecimal
|
||||
ColumnMajor))) finally (CLOSEF Stream])
|
||||
(for Font in FontList do (for CharacterSet in CharacterSets
|
||||
do (FontTable Font CharacterSet Stream (OR (NEQ Font LastFont)
|
||||
(NEQ CharacterSet
|
||||
LastCharacterSet
|
||||
))
|
||||
TitleFont InchesToPrinterUnits Hexadecimal))
|
||||
finally (CLOSEF Stream])
|
||||
|
||||
(FontSampleFaked
|
||||
[LAMBDA (FontAsList Printer StreamType ColumnMajor) (* ; "Edited 8-Dec-2025 21:19 by mth")
|
||||
(* ; "Edited 27-Apr-87 18:12 by N.H.Briggs ")
|
||||
[LAMBDA (FontAsList Printer StreamType) (* N.H.Briggs "27-Apr-87 18:12")
|
||||
(LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer]
|
||||
(Font)
|
||||
[Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (LIST TitleFont]
|
||||
@@ -99,17 +53,14 @@
|
||||
(replace FONTFAMILY of Font with (CAR FontAsList))
|
||||
(replace FONTSIZE of Font with (CADR FontAsList))
|
||||
(replace FONTFACE of Font with (\FONTFACE (CADDR FontAsList)))
|
||||
(FontTable Font '(0)
|
||||
Stream NIL TitleFont InchesToPrinterUnits NIL ColumnMajor)
|
||||
(FontTable Font '(0) Stream NIL TitleFont InchesToPrinterUnits)
|
||||
(CLOSEF Stream])
|
||||
|
||||
(FontTable
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal ColumnMajor)
|
||||
(* ; "Edited 9-Dec-2025 13:23 by mth")
|
||||
(* ; "Edited 5-Dec-2025 11:09 by mth")
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal)
|
||||
(* ; "Edited 5-Feb-2025 17:03 by mth")
|
||||
(* ; "Edited 3-Feb-2025 20:07 by mth")
|
||||
(* ; "Edited 29-Apr-87 22:36")
|
||||
(* edited%: "29-Apr-87 22:36")
|
||||
(LET*
|
||||
((Family (FONTPROP Font 'FAMILY))
|
||||
(Face (FONTPROP Font 'FACE))
|
||||
@@ -118,15 +69,14 @@
|
||||
" "
|
||||
(L-CASE Face T)
|
||||
" Character set "))
|
||||
(StreamType (IMAGESTREAMTYPE Stream))
|
||||
[UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE)
|
||||
'DISPLAY)
|
||||
(NOT (EQ StreamType 'DISPLAY]
|
||||
(NOT (EQ (IMAGESTREAMTYPE Stream)
|
||||
'DISPLAY]
|
||||
[RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT)
|
||||
(FONTPROP Font 'HEIGHT]
|
||||
(XCellSpacing (TIMES 0.45 InchesToPrinterUnits))
|
||||
(YCellSpacing (TIMES 0.5 InchesToPrinterUnits))
|
||||
ColLabelStep RowLabelStep)
|
||||
(YCellSpacing (TIMES 0.5 InchesToPrinterUnits)))
|
||||
(printout T Title .I0.8 CharacterSet "Q" T)
|
||||
(RESETLST
|
||||
(RESETSAVE (RADIX (if Hexadecimal
|
||||
@@ -145,31 +95,15 @@
|
||||
(printout Stream (if Hexadecimal
|
||||
then "16"
|
||||
else "8"))
|
||||
(if ColumnMajor
|
||||
then (SETQ ColLabelStep 16)
|
||||
(SETQ RowLabelStep 1)
|
||||
else (SETQ ColLabelStep 1)
|
||||
(SETQ RowLabelStep 16))
|
||||
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as Counter
|
||||
from 0 to (ITIMES ColLabelStep 15) by ColLabelStep bind (YPosition _ (TIMES 9.5
|
||||
InchesToPrinterUnits
|
||||
))
|
||||
from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRINTNUM (if Hexadecimal
|
||||
then '(FIX 2 16 T)
|
||||
elseif ColumnMajor
|
||||
then '(FIX 1 8 NIL T)
|
||||
else '(FIX 2 8))
|
||||
Counter Stream))
|
||||
(PRIN1 Counter Stream))
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as Counter
|
||||
from 0 to (ITIMES RowLabelStep 15) by RowLabelStep bind (XPosition _ (TIMES 0.25
|
||||
InchesToPrinterUnits
|
||||
))
|
||||
from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRINTNUM (if Hexadecimal
|
||||
then '(FIX 2 16 T)
|
||||
elseif ColumnMajor
|
||||
then '(FIX 2 8)
|
||||
else '(FIX 3 8))
|
||||
Counter Stream)))
|
||||
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
|
||||
@@ -185,33 +119,33 @@
|
||||
(DSPSCALE NIL Stream)
|
||||
'PAINT Stream)
|
||||
(CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream))
|
||||
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter from 0
|
||||
to 15 bind [RangedCodesStreamType _ (MEMB StreamType '(DISPLAY INTERPRESS]
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter
|
||||
from 0 to 15 bind (CharacterCode _ 0)
|
||||
do
|
||||
[for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter
|
||||
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter
|
||||
from 0 to 15
|
||||
do (LET* ((CharacterCode (IPLUS (ITIMES YCounter RowLabelStep)
|
||||
(ITIMES XCounter ColLabelStep)))
|
||||
(CCode (IPLUS (ITIMES CharacterSet 256)
|
||||
CharacterCode)))
|
||||
(MOVETO XPosition YPosition Stream)
|
||||
(if UseDisplayFontBitmaps
|
||||
then (LET* ((Glyph (GETCHARBITMAP CCode Font))
|
||||
(ImSize (BITMAPIMAGESIZE Glyph NIL Stream))
|
||||
(ImWidth (CAR ImSize))
|
||||
(ImHeight (CDR ImSize)))
|
||||
(BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition
|
||||
(FTIMES ImHeight
|
||||
RelativeDescent))
|
||||
ImWidth ImHeight 'INPUT 'REPLACE))
|
||||
else (if (AND (NEQ CharacterCode (CHARCODE FF))
|
||||
(if RangedCodesStreamType
|
||||
then (OR (AND (IGREATERP CharacterCode 31)
|
||||
(ILESSP CharacterCode 127))
|
||||
(AND (IGREATERP CharacterCode 160)
|
||||
(ILESSP CharacterCode 255)))
|
||||
else T))
|
||||
then (PRINTCCODE CCode Stream]
|
||||
do [LET ((CCode (IPLUS (ITIMES CharacterSet 256)
|
||||
CharacterCode)))
|
||||
(MOVETO XPosition YPosition Stream)
|
||||
(if UseDisplayFontBitmaps
|
||||
then (LET* ((Glyph (GETCHARBITMAP CCode Font))
|
||||
(ImSize (BITMAPIMAGESIZE Glyph NIL Stream))
|
||||
(ImWidth (CAR ImSize))
|
||||
(ImHeight (CDR ImSize)))
|
||||
(BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition
|
||||
(FTIMES ImHeight
|
||||
RelativeDescent))
|
||||
ImWidth ImHeight 'INPUT 'REPLACE))
|
||||
else (if (AND (NEQ CharacterCode (CHARCODE FF))
|
||||
(if (MEMB (IMAGESTREAMTYPE Stream)
|
||||
'(DISPLAY INTERPRESS))
|
||||
then (OR (AND (IGREATERP CharacterCode 31)
|
||||
(ILESSP CharacterCode 127))
|
||||
(AND (IGREATERP CharacterCode 160)
|
||||
(ILESSP CharacterCode 255)))
|
||||
else T))
|
||||
then (PRINTCCODE CCode Stream]
|
||||
(SETQ CharacterCode (ADD1 CharacterCode)))
|
||||
(printout T "."))
|
||||
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.75 InchesToPrinterUnits)
|
||||
@@ -251,6 +185,6 @@
|
||||
FONT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (645 14204 (FontSample 655 . 5488) (FontSampleFaked 5490 . 6448) (FontTable 6450 . 14202
|
||||
)))))
|
||||
(FILEMAP (NIL (657 9580 (FontSample 667 . 2302) (FontSampleFaked 2304 . 3113) (FontTable 3115 . 9578))
|
||||
)))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
275
lispusers/HPGL
275
lispusers/HPGL
@@ -1,19 +1,20 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "20-Jul-88 17:47:02" |{MCS:MCS:STANFORD}<LANE>HPGL.;24| 45342
|
||||
|
||||
(FILECREATED "29-Jan-2026 21:10:52" {WMEDLEY}<lispusers>HPGL.;9 43562
|
||||
changes to%: (FNS \DRAWLINE.HPGL \FONT.HPGL \INIT.HPGL HARDCOPYW.HPGL)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: "20-Jul-88 17:34:42" |{MCS:MCS:STANFORD}<LANE>HPGL.;23|)
|
||||
|
||||
: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 OPENHPGLSTREAM HARDCOPYW.HPGL)
|
||||
(FNS MAKEHPGL 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
|
||||
@@ -35,11 +36,20 @@
|
||||
(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)
|
||||
@@ -54,36 +64,39 @@
|
||||
|
||||
(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 29-Jan-2026 21:10 by rmk")
|
||||
(* ; "Edited 28-Jan-2026 01:00 by rmk")
|
||||
(* ; "Edited 8-Sep-87 08:50 by cdl")
|
||||
[LAMBDA (FILE OPTIONS) (* ; "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])
|
||||
@@ -500,38 +513,37 @@
|
||||
T])
|
||||
|
||||
(\FONTCREATE.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])
|
||||
[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])
|
||||
|
||||
(\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)))
|
||||
@@ -567,14 +579,16 @@
|
||||
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
|
||||
@@ -589,13 +603,10 @@
|
||||
(push PD.TEXT CHARCODE])
|
||||
|
||||
(\SEARCH.HPGL.FONTS
|
||||
[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))])
|
||||
[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])
|
||||
|
||||
(\FILL.HPGL
|
||||
[LAMBDA (STREAM TEXTURE) (* ; "Edited 8-Dec-87 16:56 by cdl")
|
||||
@@ -668,43 +679,41 @@
|
||||
(* * 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)
|
||||
|
||||
@@ -733,55 +742,63 @@
|
||||
(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)
|
||||
(PROPERTIES NILL)))
|
||||
(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])
|
||||
|
||||
(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 (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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Jan-2026 12:41:54" {DSK}<home>matt>Interlisp>medley>lispusers>MANAGER.;5 106149
|
||||
(FILECREATED "21-May-2024 18:45:54" {LU}MANAGER.;4 102968
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (ADVICE ADDTOFILES? ADDTOCOMS LOAD LOADFNS MAKEFILE MARKASCHANGED UNMARKASCHANGED
|
||||
DELFROMCOMS UPDATEFILES \ADDTOFILEBLOCK/ADDNEWCOM ADDFILE)
|
||||
:CHANGES-TO (FNS Manager.DO.COMMAND)
|
||||
|
||||
:PREVIOUS-DATE " 5-Jan-2026 12:35:04" {DSK}<home>matt>Interlisp>medley>lispusers>MANAGER.;4)
|
||||
:PREVIOUS-DATE "20-May-2024 11:16:10" {LU}MANAGER.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MANAGERCOMS)
|
||||
@@ -1546,105 +1545,66 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
(RPLACA LST (CDAR LST)))])
|
||||
)
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'ADDFILE :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(Manager.CHECKFILE FILE)))]
|
||||
[XCL:REINSTALL-ADVICE 'ADDFILE :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG (Manager.CHECKFILE FILE)))
|
||||
]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'ADDTOFILES? :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(Manager.ADDTOFILES?)))]
|
||||
[XCL:REINSTALL-ADVICE 'ADDTOFILES? :AROUND '((:LAST (PROG1 (LET ((MANAGER-ADDTOFILES? T))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG (Manager.ADDTOFILES?)))
|
||||
]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'MAKEFILE :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(Manager.MAKEFILE.ADV FILE OPTIONS)))
|
||||
]
|
||||
[XCL:REINSTALL-ADVICE 'MAKEFILE :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG (Manager.MAKEFILE.ADV
|
||||
FILE OPTIONS)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'MARKASCHANGED :AROUND
|
||||
'((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
|
||||
(Manager.ALTERMARKING NAME TYPE (OR REASON T))))]
|
||||
[XCL:REINSTALL-ADVICE 'MARKASCHANGED :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG
|
||||
(Manager.ALTERMARKING NAME TYPE
|
||||
(OR REASON T))))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'UNMARKASCHANGED :AROUND
|
||||
'((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL)
|
||||
!VALUE)
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 (SETQ !VALUE *)
|
||||
(AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
|
||||
!VALUE
|
||||
(Manager.ALTERMARKING NAME TYPE NIL)))]
|
||||
'((:LAST (LET (!VALUE)
|
||||
(PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
(SETQ !VALUE *))
|
||||
(AND Manager.ACTIVEFLG !VALUE (Manager.ALTERMARKING NAME TYPE NIL)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'UPDATEFILES :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(Manager.MAINUPDATE T)))]
|
||||
[XCL:REINSTALL-ADVICE 'UPDATEFILES :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG (Manager.MAINUPDATE
|
||||
T)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'ADDTOCOMS :AROUND
|
||||
'((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL)
|
||||
!VALUE)
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 (SETQ !VALUE *)
|
||||
(AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
|
||||
(Manager.ADDADV !VALUE COMS NAME TYPE)))]
|
||||
'((:LAST (LET (!VALUE)
|
||||
(PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
(SETQ !VALUE *))
|
||||
(AND Manager.ACTIVEFLG (Manager.ADDADV !VALUE COMS NAME TYPE)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'DELFROMCOMS :AROUND
|
||||
'((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL)
|
||||
!VALUE)
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 (SETQ !VALUE *)
|
||||
(AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
|
||||
(Manager.ADDADV !VALUE COMS NAME TYPE)))]
|
||||
'((:LAST (LET (!VALUE)
|
||||
(PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
(SETQ !VALUE *))
|
||||
(AND Manager.ACTIVEFLG (Manager.ADDADV !VALUE COMS NAME TYPE)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE '\ADDTOFILEBLOCK/ADDNEWCOM :AROUND
|
||||
'((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
|
||||
(Manager.RESETSUBITEMS FILE TYPE)))]
|
||||
'((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG (Manager.RESETSUBITEMS FILE TYPE)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'LOAD :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(if Manager.ACTIVEFLG
|
||||
then (Manager.REMOVE.DUPLICATE.ADVICE
|
||||
FILE)
|
||||
(Manager.CHECKFILE FILE))))]
|
||||
[XCL:REINSTALL-ADVICE 'LOAD :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(if Manager.ACTIVEFLG
|
||||
then (Manager.REMOVE.DUPLICATE.ADVICE FILE)
|
||||
(Manager.CHECKFILE FILE)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'LOADFNS :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(if Manager.ACTIVEFLG
|
||||
then (
|
||||
Manager.REMOVE.DUPLICATE.ADVICE
|
||||
FILE)
|
||||
(Manager.CHECKFILE FILE))))]
|
||||
[XCL:REINSTALL-ADVICE 'LOADFNS :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(if Manager.ACTIVEFLG
|
||||
then (Manager.REMOVE.DUPLICATE.ADVICE FILE)
|
||||
(Manager.CHECKFILE FILE)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE '(MARKASCHANGED :IN DEFAULT.EDITDEFA0001)
|
||||
:AROUND
|
||||
@@ -1750,20 +1710,20 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
)
|
||||
(PUTPROPS MANAGER COPYRIGHT (NONE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (25852 93352 (MANAGER 25862 . 26661) (MANAGER.RESET 26663 . 28177) (Manager.ADDADV 28179
|
||||
. 29532) (Manager.ADDTOFILES? 29534 . 29812) (Manager.ALTERMARKING 29814 . 31424) (
|
||||
Manager.ANCHORED-SET-POSITION 31426 . 32529) (Manager.DO.COMMAND 32531 . 34138) (
|
||||
Manager.DO.COMMAND.PROCFN 34140 . 53495) (Manager.HIGHLIGHT 53497 . 53794) (Manager.PROMPT 53796 .
|
||||
54109) (Manager.WINDOW 54111 . 54744) (Manager.insurefilehighlights 54746 . 55817) (Manager.CHANGED?
|
||||
55819 . 56368) (Manager.CHECKFILE 56370 . 57469) (Manager.COLLECTCOMS 57471 . 58909) (Manager.COMS.WSF
|
||||
58911 . 61581) (Manager.COMSOPEN 61583 . 66321) (Manager.COMSUPDATE 66323 . 67415) (
|
||||
Manager.HIGHLIGHTED 67417 . 67723) (Manager.INSUREHIGHLIGHTS 67725 . 68283) (Manager.FILECHANGES 68285
|
||||
. 68584) (Manager.FILELSTCHANGED? 68586 . 68914) (Manager.FILESUBTYPES 68916 . 69554) (
|
||||
Manager.GET.ENVIRONMENT 69556 . 72094) (Manager.GETFILE 72096 . 74410) (Manager.INTITLE? 74412 . 75090
|
||||
) (Manager.MAIN.WSF 75092 . 77736) (Manager.MAINCLOSE 77738 . 78848) (Manager.MAINMENUITEMS 78850 .
|
||||
79927) (Manager.MAINOPEN 79929 . 85322) (Manager.MAINUPDATE 85324 . 85960) (Manager.MAKEFILE.ADV 85962
|
||||
. 86998) (Manager.MENUCOLUMNS 87000 . 87804) (Manager.MENUHASITEM 87806 . 88163) (Manager.MENUITEMS
|
||||
88165 . 88410) (Manager.REMOVE.DUPLICATE.ADVICE 88412 . 90018) (Manager.RESETSUBITEMS 90020 . 91257) (
|
||||
Manager.SET-ANCHOR 91259 . 91578) (Manager.SORT.COMS 91580 . 92112) (Manager.SORTBYCOLUMN 92114 .
|
||||
93350)))))
|
||||
(FILEMAP (NIL (25632 93132 (MANAGER 25642 . 26441) (MANAGER.RESET 26443 . 27957) (Manager.ADDADV 27959
|
||||
. 29312) (Manager.ADDTOFILES? 29314 . 29592) (Manager.ALTERMARKING 29594 . 31204) (
|
||||
Manager.ANCHORED-SET-POSITION 31206 . 32309) (Manager.DO.COMMAND 32311 . 33918) (
|
||||
Manager.DO.COMMAND.PROCFN 33920 . 53275) (Manager.HIGHLIGHT 53277 . 53574) (Manager.PROMPT 53576 .
|
||||
53889) (Manager.WINDOW 53891 . 54524) (Manager.insurefilehighlights 54526 . 55597) (Manager.CHANGED?
|
||||
55599 . 56148) (Manager.CHECKFILE 56150 . 57249) (Manager.COLLECTCOMS 57251 . 58689) (Manager.COMS.WSF
|
||||
58691 . 61361) (Manager.COMSOPEN 61363 . 66101) (Manager.COMSUPDATE 66103 . 67195) (
|
||||
Manager.HIGHLIGHTED 67197 . 67503) (Manager.INSUREHIGHLIGHTS 67505 . 68063) (Manager.FILECHANGES 68065
|
||||
. 68364) (Manager.FILELSTCHANGED? 68366 . 68694) (Manager.FILESUBTYPES 68696 . 69334) (
|
||||
Manager.GET.ENVIRONMENT 69336 . 71874) (Manager.GETFILE 71876 . 74190) (Manager.INTITLE? 74192 . 74870
|
||||
) (Manager.MAIN.WSF 74872 . 77516) (Manager.MAINCLOSE 77518 . 78628) (Manager.MAINMENUITEMS 78630 .
|
||||
79707) (Manager.MAINOPEN 79709 . 85102) (Manager.MAINUPDATE 85104 . 85740) (Manager.MAKEFILE.ADV 85742
|
||||
. 86778) (Manager.MENUCOLUMNS 86780 . 87584) (Manager.MENUHASITEM 87586 . 87943) (Manager.MENUITEMS
|
||||
87945 . 88190) (Manager.REMOVE.DUPLICATE.ADVICE 88192 . 89798) (Manager.RESETSUBITEMS 89800 . 91037) (
|
||||
Manager.SET-ANCHOR 91039 . 91358) (Manager.SORT.COMS 91360 . 91892) (Manager.SORTBYCOLUMN 91894 .
|
||||
93130)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Dec-2025 11:15:32" {WMEDLEY}<lispusers>PRETTYFILEINDEX.;14 100927
|
||||
(FILECREATED "21-Sep-2025 09:50:47"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;13 100936
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS PFI.MAKE.LPT.STREAM)
|
||||
:CHANGES-TO (VARS PRETTYFILEINDEXCOMS)
|
||||
|
||||
:PREVIOUS-DATE "21-Sep-2025 09:50:47" {WMEDLEY}<lispusers>PRETTYFILEINDEX.;13)
|
||||
:PREVIOUS-DATE "10-May-2023 09:12:17"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;12)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PRETTYFILEINDEXCOMS)
|
||||
@@ -379,12 +381,12 @@
|
||||
PRINTOPTIONS))))])])
|
||||
|
||||
(PFI.MAKE.LPT.STREAM
|
||||
[LAMBDA (PRINTOPTIONS) (* ; "Edited 17-Dec-2025 01:05 by rmk")
|
||||
(* ; "Edited 12-Nov-93 09:53 by rmk:")
|
||||
(* ; "Edited 19-Aug-92 13:57 by jds")
|
||||
(LET* ([PRINTER (OR (LISTGET PRINTOPTIONS 'SERVER)
|
||||
[LAMBDA (PRINTOPTIONS) (* ; "Edited 12-Nov-93 09:53 by rmk:")
|
||||
(* ; "Edited 19-Aug-92 13:57 by jds")
|
||||
(LET* ((PRINTER (OR (LISTGET PRINTOPTIONS 'SERVER)
|
||||
(LISTGET PRINTOPTIONS 'HOST)
|
||||
(CAR (DEFAULTPRINTERS]
|
||||
(CAR (LISTP DEFAULTPRINTINGHOST))
|
||||
DEFAULTPRINTINGHOST))
|
||||
[IMAGETYPE (COND
|
||||
[(AND PRINTER (CADDR (LISTP PRINTER]
|
||||
(T (CAR (MKLIST (PRINTERPROP (PRINTERTYPE PRINTER)
|
||||
@@ -392,13 +394,13 @@
|
||||
(DEFAULTOPTIONS *PFI-PRINTOPTIONS*)
|
||||
REG S TEMPS SCALE DEFREGION)
|
||||
|
||||
(* ;; "Get a dummy stream of the right image type, so we can get scaling right, etc. The IMAGETYPE ... code is stolen from OPENIMAGESTREAM's decision for IMAGETYPE.")
|
||||
(* ;; "Get a dummy stream of the right image type, so we can get scaling right, etc. The IMAGETYPE ... code is stolen from OPENIMAGESTREAM's decision for IMAGETYPE.")
|
||||
|
||||
(SETQ TEMPS (OPENIMAGESTREAM "{NODIRCORE}" IMAGETYPE))
|
||||
(SETQ SCALE (DSPSCALE NIL TEMPS))
|
||||
(CLOSEF TEMPS)
|
||||
|
||||
(* ;; "Scale the region from points to the stream's real units right up front. Also, copy the options so can smash with LISTPUTs here and below.")
|
||||
(* ;; "Scale the region from points to the stream's real units right up front. Also, copy the options so can smash with LISTPUTs here and below.")
|
||||
|
||||
(CL:WHEN (SETQ REG (LISTGET PRINTOPTIONS 'REGION))
|
||||
(LISTPUT (SETQ PRINTOPTIONS (APPEND PRINTOPTIONS))
|
||||
@@ -409,19 +411,19 @@
|
||||
'REGION
|
||||
(SCALEREGION SCALE REG)))
|
||||
|
||||
(* ;; "Set up the margins (REGION) for the page correctly.")
|
||||
(* ;; "Set up the margins (REGION) for the page correctly.")
|
||||
|
||||
[COND
|
||||
((AND (LISTGET PRINTOPTIONS 'LANDSCAPE)
|
||||
(LISTGET DEFAULTOPTIONS 'REGION)) (* ;
|
||||
"Don't use default region when caller specified landscape (tee hee)")
|
||||
(LISTGET DEFAULTOPTIONS 'REGION)) (* ;
|
||||
"Don't use default region when caller specified landscape (tee hee)")
|
||||
(LISTPUT DEFAULTOPTIONS 'REGION NIL))
|
||||
([AND *PFI-TWO-SIDED* (SETQ REG (LISTGET DEFAULTOPTIONS 'REGION))
|
||||
(NOT (LISTGET PRINTOPTIONS 'REGION] (* ; "Shift image to the left 1/4%" so that it is balanced. Default region is assumed to be 1%" on left and 1/2%" on right. No adjustment if user gave region explicitly")
|
||||
(LISTPUT DEFAULTOPTIONS 'REGION (create REGION using REG LEFT _
|
||||
(- (fetch (REGION LEFT)
|
||||
of REG)
|
||||
(FIXR (FTIMES 18 SCALE]
|
||||
(NOT (LISTGET PRINTOPTIONS 'REGION] (* ; "Shift image to the left 1/4%" so that it is balanced. Default region is assumed to be 1%" on left and 1/2%" on right. No adjustment if user gave region explicitly")
|
||||
(LISTPUT DEFAULTOPTIONS 'REGION (create REGION
|
||||
using REG LEFT _ (- (fetch (REGION LEFT)
|
||||
of REG)
|
||||
(FIXR (FTIMES 18 SCALE]
|
||||
(SETQ PRINTOPTIONS (APPEND PRINTOPTIONS DEFAULTOPTIONS))
|
||||
(SETQ S (OPENIMAGESTREAM (CONCAT "{LPT}" (OR (CADR (LISTP PRINTER))
|
||||
PRINTER ""))
|
||||
@@ -1191,28 +1193,28 @@
|
||||
'NON.PFI.PRINT.BITMAP NIL T)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (9872 12107 (PFI.NEW.LISTFILES1 9882 . 10376) (PFI.ENQUEUE 10378 . 11002) (
|
||||
\PFI.DO.HARDCOPY 11004 . 11590) (MAYBE.PRETTYFILEINDEX 11592 . 12105)) (12108 34697 (PRETTYFILEINDEX
|
||||
12118 . 26151) (PFI.MAKE.LPT.STREAM 26153 . 29278) (PFI.SETUP.TRANSLATIONS 29280 . 30794) (
|
||||
PFI.OUTCHARFN 30796 . 32770) (PFI.COLLECT.DEFINERS 32772 . 33584) (PFI.AFTER.NEW.PAGE 33586 . 34695))
|
||||
(34698 41212 (PFI.PRINT.FILECREATED 34708 . 39399) (PFI.PRINT.TO.TAB 39401 . 39846) (
|
||||
PFI.PRINT.ENVIRONMENT 39848 . 41210)) (41213 48728 (PFI.PROCESS.FILE 41223 . 42453) (PFI.PASS.COMMENT
|
||||
42455 . 43425) (PFI.HANDLE.EXPR 43427 . 44094) (PFI.DEFAULT.HANDLER 44096 . 46149) (PFI.PRETTYPRINT
|
||||
46151 . 46486) (PFI.LINES.REMAINING 46488 . 46815) (PFI.MAYBE.NEW.PAGE 46817 . 47651) (
|
||||
PFI.ESTIMATE.SIZE 47653 . 48184) (PFI.ESTIMATE.SIZE1 48186 . 48726)) (48765 58974 (PFI.HANDLE.RPAQQ
|
||||
48775 . 50183) (PFI.HANDLE.DECLARE 50185 . 51124) (PFI.HANDLE.EVAL-WHEN 51126 . 51609) (
|
||||
PFI.HANDLE.DEFDEFINER 51611 . 52901) (PFI.HANDLE.DEFINEQ 52903 . 53147) (PFI.PRINT.LAMBDA 53149 .
|
||||
53487) (PFI.PRINT.LAMBDA.BODY 53489 . 53824) (PFI.HANDLE.PUTDEF 53826 . 54323) (PFI.HANDLE.PUTPROPS
|
||||
54325 . 54940) (PFI.HANDLE./DECLAREDATATYPE 54942 . 55489) (PFI.HANDLE.* 55491 . 56753) (
|
||||
PFI.PRINT.COMMENTS 56755 . 58377) (PFI.HANDLE.FILEMAP 58379 . 58667) (PFI.HANDLE.PACKAGE 58669 . 58972
|
||||
)) (59002 59994 (PFI.PREVIEW.DECLARE 59012 . 59674) (PFI.PREVIEW.DEFINEQ 59676 . 59992)) (60030 71018
|
||||
(PFI.PRINT.INDEX 60040 . 60891) (PFI.CONDENSE.INDEX 60893 . 62700) (PFI.SORT.INDICES 62702 . 63841) (
|
||||
PFI.COMPUTE.INDEX.SHAPE 63843 . 65307) (PFI.PRINT.INDICES 65309 . 69851) (PFI.CENTER.PRINT 69853 .
|
||||
70423) (PFI.INDEX.BREAK 70425 . 70883) (PFI.LOOKUP.NAME 70885 . 71016)) (71019 72250 (PFI.ADD.TO.INDEX
|
||||
71029 . 71539) (PFI.VARNAME 71541 . 71951) (PFI.CONSTANTNAMES 71953 . 72248)) (72285 80598 (
|
||||
MULTIFILEINDEX 72295 . 73091) (MULTIFILEINDEX1 73093 . 74549) (PFI.PRINT.MULTI.INDEX 74551 . 79654) (
|
||||
PFI.CHOOSE.BEST 79656 . 79883) (PFI.MERGE.INDICES 79885 . 80596)) (80655 83724 (PFI.MAYBE.SEE.PRETTY
|
||||
80665 . 82448) (PFI.MAYBE.PP.DEFINITION 82450 . 83722)) (83794 91904 (PFI.PRINT.BITMAP 83804 . 91902))
|
||||
(94619 97733 (PUTPROPS.PRETTYPRINT 94629 . 96040) (RPAQX.PRETTYPRINT 96042 . 96767) (
|
||||
COURIERPROGRAM.PRETTYPRINT 96769 . 97469) (MAYBE.PRETTYPRINT.BOLD 97471 . 97731)))))
|
||||
(FILEMAP (NIL (9955 12190 (PFI.NEW.LISTFILES1 9965 . 10459) (PFI.ENQUEUE 10461 . 11085) (
|
||||
\PFI.DO.HARDCOPY 11087 . 11673) (MAYBE.PRETTYFILEINDEX 11675 . 12188)) (12191 34706 (PRETTYFILEINDEX
|
||||
12201 . 26234) (PFI.MAKE.LPT.STREAM 26236 . 29287) (PFI.SETUP.TRANSLATIONS 29289 . 30803) (
|
||||
PFI.OUTCHARFN 30805 . 32779) (PFI.COLLECT.DEFINERS 32781 . 33593) (PFI.AFTER.NEW.PAGE 33595 . 34704))
|
||||
(34707 41221 (PFI.PRINT.FILECREATED 34717 . 39408) (PFI.PRINT.TO.TAB 39410 . 39855) (
|
||||
PFI.PRINT.ENVIRONMENT 39857 . 41219)) (41222 48737 (PFI.PROCESS.FILE 41232 . 42462) (PFI.PASS.COMMENT
|
||||
42464 . 43434) (PFI.HANDLE.EXPR 43436 . 44103) (PFI.DEFAULT.HANDLER 44105 . 46158) (PFI.PRETTYPRINT
|
||||
46160 . 46495) (PFI.LINES.REMAINING 46497 . 46824) (PFI.MAYBE.NEW.PAGE 46826 . 47660) (
|
||||
PFI.ESTIMATE.SIZE 47662 . 48193) (PFI.ESTIMATE.SIZE1 48195 . 48735)) (48774 58983 (PFI.HANDLE.RPAQQ
|
||||
48784 . 50192) (PFI.HANDLE.DECLARE 50194 . 51133) (PFI.HANDLE.EVAL-WHEN 51135 . 51618) (
|
||||
PFI.HANDLE.DEFDEFINER 51620 . 52910) (PFI.HANDLE.DEFINEQ 52912 . 53156) (PFI.PRINT.LAMBDA 53158 .
|
||||
53496) (PFI.PRINT.LAMBDA.BODY 53498 . 53833) (PFI.HANDLE.PUTDEF 53835 . 54332) (PFI.HANDLE.PUTPROPS
|
||||
54334 . 54949) (PFI.HANDLE./DECLAREDATATYPE 54951 . 55498) (PFI.HANDLE.* 55500 . 56762) (
|
||||
PFI.PRINT.COMMENTS 56764 . 58386) (PFI.HANDLE.FILEMAP 58388 . 58676) (PFI.HANDLE.PACKAGE 58678 . 58981
|
||||
)) (59011 60003 (PFI.PREVIEW.DECLARE 59021 . 59683) (PFI.PREVIEW.DEFINEQ 59685 . 60001)) (60039 71027
|
||||
(PFI.PRINT.INDEX 60049 . 60900) (PFI.CONDENSE.INDEX 60902 . 62709) (PFI.SORT.INDICES 62711 . 63850) (
|
||||
PFI.COMPUTE.INDEX.SHAPE 63852 . 65316) (PFI.PRINT.INDICES 65318 . 69860) (PFI.CENTER.PRINT 69862 .
|
||||
70432) (PFI.INDEX.BREAK 70434 . 70892) (PFI.LOOKUP.NAME 70894 . 71025)) (71028 72259 (PFI.ADD.TO.INDEX
|
||||
71038 . 71548) (PFI.VARNAME 71550 . 71960) (PFI.CONSTANTNAMES 71962 . 72257)) (72294 80607 (
|
||||
MULTIFILEINDEX 72304 . 73100) (MULTIFILEINDEX1 73102 . 74558) (PFI.PRINT.MULTI.INDEX 74560 . 79663) (
|
||||
PFI.CHOOSE.BEST 79665 . 79892) (PFI.MERGE.INDICES 79894 . 80605)) (80664 83733 (PFI.MAYBE.SEE.PRETTY
|
||||
80674 . 82457) (PFI.MAYBE.PP.DEFINITION 82459 . 83731)) (83803 91913 (PFI.PRINT.BITMAP 83813 . 91911))
|
||||
(94628 97742 (PUTPROPS.PRETTYPRINT 94638 . 96049) (RPAQX.PRETTYPRINT 96051 . 96776) (
|
||||
COURIERPROGRAM.PRETTYPRINT 96778 . 97478) (MAYBE.PRETTYPRINT.BOLD 97480 . 97740)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1063
lispusers/READ-BDF
1063
lispusers/READ-BDF
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user