From 65df2ba6a4b383269e376417f76366aa62d08e3d Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 26 Jan 2026 15:38:22 -0800 Subject: [PATCH] Hardcopy to printer (#2290) * Separate interface for imagefile creation from the send-to-printer interface * SEND.FILE.TO.PRINTER recognizes :DEFAULTPRINTER * Various changes to address #2414 * Move BITMAP properties from PRINTERTYPES to PRINTFILETYPES. * Fix ShellOpen, add UNIX-TMP-FILE-NAME * Include COERCEFONTSPEC changes in anticipation of HTML streams * PDFSTREAM compatible with new imagefile architecture plus able to convert non-local Postscript streams * SKETCH compatible with new imagefile/printing architecture * TEDIT compatible with new printing architecture * Tedit files are of type TEDIT, not TEXT, new interface function TEDIT.TO.IMAGEFILE * ATTACHEDWINDOW: DOATTACHEDWINDOWCOM allows menu to have a form to EVAL, like the background menu * WINDOW: fix menus for new hardcopy architecture * Remove FLUSHFONTSINCORE--FLUSHFONTCACHE is more general * LOAD character names as suggested in PR #2398 * HARDCOPYW respects file extension * VIEWER as default printinghost * SLASHIT interprets '. * MCCS to UTF8 conversion on printer name * Deal with {LPT}.LOCAL and upper casing * @ LPT printers work with exact upper/lower matching * Using NSPRINT functions to recognize fax * Let "UNIX" be the name of the default printer of type UNIX --- docs/internal/FONTCODECHANGES.tedit | Bin 34891 -> 34918 bytes docs/internal/MEDLEYFONTRATIONALE.TEDIT | Bin 0 -> 4950 bytes internal/TEDIT-DEBUG | 70 +- internal/TEDIT-DEBUG.LCOM | Bin 61422 -> 61431 bytes internal/loadups/LOADUP-FULL | 13 +- internal/loadups/LOADUP-FULL.LCOM | Bin 3046 -> 3032 bytes internal/loadups/LOADUP-LISP | 16 +- internal/loadups/LOADUP-LISP.LCOM | Bin 3704 -> 3629 bytes library/FILEBROWSER | 265 +++-- library/FILEBROWSER.LCOM | Bin 87971 -> 87217 bytes library/PDFSTREAM | 353 ++++--- library/PDFSTREAM.LCOM | Bin 5935 -> 6977 bytes library/POSTSCRIPTSTREAM | 159 ++- library/POSTSCRIPTSTREAM.LCOM | Bin 93174 -> 92119 bytes library/UNIXPRINT | 219 ++-- library/UNIXPRINT.DFASL | Bin 6215 -> 5520 bytes library/UNIXUTILS | 132 ++- library/UNIXUTILS.DFASL | Bin 7342 -> 7972 bytes library/sketch/SKETCH | 823 ++++++++------- library/sketch/SKETCH-ELEMENTS | 291 +++--- library/sketch/SKETCH-ELEMENTS.LCOM | Bin 143344 -> 143253 bytes library/sketch/SKETCH-OPS | 297 +++--- library/sketch/SKETCH-OPS.LCOM | Bin 69562 -> 68284 bytes library/sketch/SKETCH.LCOM | Bin 161932 -> 161936 bytes library/tedit/TEDIT | 67 +- library/tedit/TEDIT-HCPY | 203 ++-- library/tedit/TEDIT-HCPY.LCOM | Bin 10805 -> 10572 bytes library/tedit/TEDIT-LOOKS | 53 +- library/tedit/TEDIT-LOOKS.LCOM | Bin 38350 -> 38185 bytes library/tedit/TEDIT-MENU | 66 +- library/tedit/TEDIT-MENU.LCOM | Bin 55202 -> 55135 bytes library/tedit/TEDIT-PAGE | 245 ++--- library/tedit/TEDIT-PAGE.LCOM | Bin 29323 -> 28257 bytes library/tedit/TEDIT-STREAM | 218 ++-- library/tedit/TEDIT-STREAM.LCOM | Bin 38376 -> 38738 bytes library/tedit/TEDIT-TFBRAVO | 95 +- library/tedit/TEDIT-TFBRAVO.LCOM | Bin 28368 -> 28935 bytes library/tedit/TEDIT-WINDOW | 90 +- library/tedit/TEDIT-WINDOW.LCOM | Bin 62636 -> 62591 bytes library/tedit/TEDIT.LCOM | Bin 33274 -> 33445 bytes library/tedit/tedit-exports.all | 30 +- lispusers/PRETTYFILEINDEX | 86 +- lispusers/PRETTYFILEINDEX.LCOM | Bin 41896 -> 41778 bytes sources/APUTDQ | 15 +- sources/APUTDQ.LCOM | Bin 5730 -> 5686 bytes sources/ATTACHEDWINDOW | 101 +- sources/ATTACHEDWINDOW.LCOM | Bin 31893 -> 31789 bytes sources/FONT | 313 +++--- sources/FONT.LCOM | Bin 69724 -> 70206 bytes sources/HARDCOPY | 1237 +++++++++++------------ sources/HARDCOPY.LCOM | Bin 45595 -> 42799 bytes sources/IMAGEIO | 564 +++++++++-- sources/IMAGEIO.LCOM | Bin 35477 -> 44853 bytes sources/INTERPRESS | 204 ++-- sources/INTERPRESS.LCOM | Bin 57300 -> 56674 bytes sources/MCCS | 28 +- sources/MCCS.LCOM | Bin 23601 -> 23593 bytes sources/NSPRINT | 109 +- sources/NSPRINT.LCOM | Bin 16911 -> 16645 bytes sources/UFS | 52 +- sources/UFS.LCOM | Bin 38113 -> 38092 bytes sources/WINDOW | 198 ++-- sources/WINDOW.LCOM | Bin 67636 -> 68150 bytes 63 files changed, 3435 insertions(+), 3177 deletions(-) create mode 100644 docs/internal/MEDLEYFONTRATIONALE.TEDIT diff --git a/docs/internal/FONTCODECHANGES.tedit b/docs/internal/FONTCODECHANGES.tedit index 8bcbf2644c1be7d9747042d96110a509aa158835..b551332e002d9d87df99c0031438c00276185e1f 100644 GIT binary patch delta 694 zcmX>-f$7-qq!t$=%jhVSWMmdABq!$N z6f1z$ySn-Ng#-t&QcFsU@`@D_6>@;)DdeXq0NtZdT$-E=bZ%N{4n$XGex6UUjzT`r;-d1*;#9B; z$`W%*Qx$+-$SMWu1i1-pc|mG2kWmB?$SeX%733EeXC~!9T>vyoZ?jF%Hm=QQVh;;V zK3s5V^7I0o$^8W!o2M53WoG4IU|`^x{IOYL^7>LsR~8`e1rReZf(QmC29UrU5EEG- z7G2;Cioj&uG9wd^#v>@gK+Xnqfn*ec&6CR%7#Z0oZz(rnWZV3*oR5`JXY#=cNmW;v zGO#O{fv(AciSU3JKoN#rlOHsTZnmsl%i_uk`~HfTy3ce~{~B?hZYn7#GJ7SF3FK OBtZs-EC(jTs$BrbEvFs; delta 590 zcmaDhf$8)FrVXt6ljBTzH_Pd-WE4{<$;d2LC`rstEmp|PE6G<#Ois=(-TcSkxx(b< zfi0WOg12$;`Gf|0xcU2q1bg~9`v*<7F*UEx%uCBJ%1tcE%+FIuOv*1U0UDGFG$AE3 zIk6-)MIkLeuS6lOC_fh}UXogrmzblFoS2-ETCAtws8F7nlaicRl%k*o6wFgdN>wN* z$}h`I0qRXGR!GdNRLD;Q>rE_5FU?KOD*@_qbM*D}i3F(^0%=H806Qwc)mb66Bzg0T z*yBQz*A{Y2ZY@gK+Xnqfn*ec&6~><7#TSxUnw_XWZ%qL!N)o| zxK2vg6{ZO624>*L*% M3=CNcOvY8a0K6-UdH?_b diff --git a/docs/internal/MEDLEYFONTRATIONALE.TEDIT b/docs/internal/MEDLEYFONTRATIONALE.TEDIT new file mode 100644 index 0000000000000000000000000000000000000000..fc12ec02aabc62907fb4b9f9ffea7af18c6fbd24 GIT binary patch literal 4950 zcmeHK%aYs16~$;qibG|QRC$-pEy-0Ot4L-z9*rL5autRIN3ckM20>f$t_Nt6ZR0@$ zAV=d=%6os3zrf#;FGyvTbGtzfrA*{UdEtdAi3A$A@8g_vZ$o1lC-VA_V`ngOUJZRO z4D8VLJ$vLdP8yBVMx)ng-1ZR5czAyOj3~%6dLdSc$Qt2Nl@#aEI+a;Pi6|?Qv8rTD zu=zw}N)*@BJ8sj-@yS`Y;bv8l$Lpw4dA%3g1;w(A3bo=@%I8!qC8c?#HiB15n&$C{M8mI3iD#ML`{86%2j8eQz=$CQx;6t9eN*nV0%oF!sreGDw?W3LkkPs*Ibu$;OaT|!!UI6dCRkla zcn2@4TEafclLTD>u;+Q7$bNg;0X9I&2yD;Q5?#Mo8Dkn z(haZN%`M1Edl_I*t8x}@fBi33HP{0lN%ioGe{-J^eQM(sUD<= z_2n9Kl_TF!Y)~-su^yROe$_#a-+-UGJL-tYFU00cQL3m0c(2ciDbzVJ2WHHely=cN zn(7pi0Pdw$8wMXJWZpXRHRcTy!rU=>>x6q4D94ynKo1qv(DNnNk;$ta9(8tg6JYLX zIA8@daEGdNpVd>X(os4JiqpDJtf?7aJTx+Qa!^Xc&WgWT+3Rl&8i`+2*J;<4;08*w4D<3e!DLYi|D? zulr|6nNI?XbaBQb5 zhey^22M0eK+-A79w%zlmpRq?LhB$x0o}7k6xbFWPIV&-U-K7+}_0bU=Tebs(gTGo62v6|m}|6jwP3c~;Z literal 0 HcmV?d00001 diff --git a/internal/TEDIT-DEBUG b/internal/TEDIT-DEBUG index f64ba90e..32b6966f 100644 --- a/internal/TEDIT-DEBUG +++ b/internal/TEDIT-DEBUG @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Jul-2025 11:42:21" {WMEDLEY}TEDIT-DEBUG.;174 138232 +(FILECREATED "13-Oct-2025 16:52:28" {WMEDLEY}TEDIT-DEBUG.;175 138298 :EDIT-BY rmk - :CHANGES-TO (FNS SPPRINT) + :CHANGES-TO (FNS SP) - :PREVIOUS-DATE " 3-Jun-2025 23:12:40" {WMEDLEY}TEDIT-DEBUG.;173) + :PREVIOUS-DATE "29-Jul-2025 11:42:21" {WMEDLEY}TEDIT-DEBUG.;174) (PRETTYCOMPRINT TEDIT-DEBUGCOMS) @@ -455,7 +455,8 @@ (DEFINEQ (SP - [LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 17-Apr-2025 13:37 by rmk") + [LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 13-Oct-2025 16:37 by rmk") + (* ; "Edited 17-Apr-2025 13:37 by rmk") (* ; "Edited 15-Apr-2025 13:53 by rmk") (* ; "Edited 11-Apr-2025 12:15 by rmk") (* ; "Edited 29-Mar-2025 22:34 by rmk") @@ -475,8 +476,7 @@ (* ;; "OFILE=T or TEDIT means Tedit stream. NIL means primary output (usually T)") - (PROG ((TEXTOBJ (CL:IF (type? TEXTOBJ PC) - PC + (PROG ((TEXTOBJ (OR (TEXTOBJ PC T) (GTO TOBJ))) WTYPE TITLE) (if OFILE @@ -2579,33 +2579,33 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5120 7679 (GTO 5130 . 5380) (GTS 5382 . 7153) (GTW 7155 . 7311) (GSEL 7313 . 7677)) ( -7712 8833 (TEST.TEMPLATE 7722 . 8831)) (8834 9769 (TESTACTION 8844 . 9767)) (9794 23609 (IPC 9804 . -11308) (ILINES 11310 . 13851) (ISEL 13853 . 14464) (ITS 14466 . 16190) (IPANES 16192 . 16427) (ITL -16429 . 16848) (IHIST 16850 . 19512) (IPCTB 19514 . 19940) (IMB 19942 . 20701) (ICL 20703 . 21404) ( -IPL 21406 . 21946) (ICARET 21948 . 22475) (INSPECTPIECES 22477 . 23607)) (23631 52299 (SP 23641 . -28685) (SL 28687 . 32522) (SSP 32524 . 34226) (SPF 34228 . 36758) (SLF 36760 . 45893) (SHOWLINE 45895 - . 49457) (SLL 49459 . 50206) (STBYTES 50208 . 51934) (SSEL 51936 . 52297)) (52300 64813 (STL 52310 . -61311) (CLEARTHISLINE 61313 . 61793) (CHARSLOTP 61795 . 63114) (\TLVALIDATE 63116 . 64811)) (64814 -70187 (NTHPIECE 64824 . 65956) (NPIECES 65958 . 66823) (NTHPIECECHAR 66825 . 68133) (SELPIECE 68135 . -68577) (PIECENUM 68579 . 69298) (PCBYTES 69300 . 70185)) (70188 72662 (FILEBYTES 70198 . 71622) ( -TFILEBYTES 71624 . 72660)) (72663 73985 (TRELMOVE 72673 . 72916) (TSCROLL 72918 . 73084) (TSCROLL* -73086 . 73983)) (73986 77035 (TRY 73996 . 75265) (TEDITCLOSEW 75267 . 75610) (PARALASTWITHOUTEOL 75612 - . 76497) (FIXPARALAST 76499 . 77033)) (77036 91923 (SPPRINT 77046 . 83871) (SPPRINT.CHAR 83873 . -84857) (SPPRINT.OBJ 84859 . 87917) (SHOWPIECEBYTES 87919 . 89475) (CHECKPLENGTHS 89477 . 89934) (SBT -89936 . 91073) (COPYPCHAIN 91075 . 91921)) (91924 93985 (POSLINE 91934 . 93983)) (93986 94869 ( -PRESPLIT 93996 . 94867)) (94870 96583 (ALLTL 94880 . 96133) (NTHCHARSLOT 96135 . 96581)) (96609 106822 - (PLCHAIN 96619 . 97147) (PRINTLINE 97149 . 100139) (SL.GETLINES 100141 . 103434) (CHECKLINES 103436 - . 104416) (COLLECTLINES 104418 . 104670) (NTHLINE 104672 . 105677) (HEIGHT 105679 . 105967) (LINEBOTS - 105969 . 106820)) (106823 109271 (IPC.DECODEARGS 106833 . 109269)) (109272 109865 (SPF1 109282 . -109863)) (109894 112272 (SLF.FATPLEN 109904 . 110763) (FILEPIECE 110765 . 112270)) (112305 113073 ( -SELTEDIT 112315 . 113071)) (113143 118755 (PPARA 113153 . 113575) (PRUN 113577 . 115053) ( -ADDLINEPOSITIONS 115055 . 116482) (SBR 116484 . 117138) (SBC 117140 . 118753)) (118812 120588 (OLDWI -118822 . 119197) (COMP 119199 . 119394) (DFR 119396 . 120586)) (120589 121622 (DFGV 120599 . 121125) ( -GDIRECTORIES 121127 . 121620)) (121623 128188 (TTEST 121633 . 126165) (LTEST 126167 . 127532) (THC -127534 . 128186)) (128502 129194 (SHOWSAFE 128512 . 129192)) (129247 129694 (MYH 129257 . 129692)) ( -129939 131034 (DFVENUE 129949 . 130828) (VSEE 130830 . 131032)) (131035 131489 (PTT 131045 . 131487)) -(131848 133429 (DEBUGOUTPUT.STREAM 131858 . 133427)) (133430 135746 (TEDIT-DEBUG 133440 . 135744)) ( -135747 136239 (HEXTOHILO 135757 . 136097) (CW 136099 . 136237)) (136240 137976 (TRENAME 136250 . -137974))))) + (FILEMAP (NIL (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))))) STOP diff --git a/internal/TEDIT-DEBUG.LCOM b/internal/TEDIT-DEBUG.LCOM index e8e688c0e16097a95f65a93530e2b497f167bb12..f3afda41eed9c334432254e84a7d68337a1794e4 100644 GIT binary patch delta 251 zcmaENpZWWJ<_X~(3QxsAw3W|zVtrUU-6f*M^l-xpnd=!v%>FMbyDWoKp0F`1f&B#DW zlS{+R)5q00$kj2#)di>s;vQZU2Thh`RN(-+&)CAq(qghFqmqE8f>l6}YnZ2hXt1se xQ0HWJM(fSH8C@hfGPxLlU@OOFc4FMbyDWoKpq^2lf(Qjm|q{*e>=IP_=9OUX4;_9NH zWMrx9Rhk2JfuWU&k(H65(&PnIT|i4Ah(l(QE{C9?+2nljk$4FdA<@!ssH&ahL%JCOWik7LaCSnk+4wz@=cS5aJpU N;_u|Oxmvd75&(E?Lt+2` diff --git a/internal/loadups/LOADUP-FULL b/internal/loadups/LOADUP-FULL index cdeba4e4..037dd5cd 100644 --- a/internal/loadups/LOADUP-FULL +++ b/internal/loadups/LOADUP-FULL @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Sep-2025 14:18:19" {WMEDLEY}loadups>LOADUP-FULL.;34 5662 +(FILECREATED "28-Dec-2025 12:06:12" {WMEDLEY}loadups>LOADUP-FULL.;35 5759 :EDIT-BY rmk - :CHANGES-TO (FNS LOADFULLFONTS) + :CHANGES-TO (FNS LOADUP-FULL) - :PREVIOUS-DATE " 2-Sep-2025 20:07:20" {WMEDLEY}loadups>LOADUP-FULL.;33) + :PREVIOUS-DATE "20-Sep-2025 14:18:19" {WMEDLEY}loadups>LOADUP-FULL.;34) (PRETTYCOMPRINT LOADUP-FULLCOMS) @@ -47,7 +47,8 @@ (PRINTOUT T "FULL fonts loaded" T]) (LOADUP-FULL - [LAMBDA (DRIBBLEFILE) (* ; "Edited 1-Sep-2025 11:59 by rmk") + [LAMBDA (DRIBBLEFILE) (* ; "Edited 28-Dec-2025 12:06 by rmk") + (* ; "Edited 1-Sep-2025 11:59 by rmk") (* ; "Edited 18-Aug-2025 12:09 by rmk") (* ; "Edited 21-Jun-2025 23:33 by rmk") (* ; "Edited 18-Jan-2023 16:22 by FGH") @@ -85,7 +86,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 UNIXUTILS)) + UNIXCHAT UNIXYCD)) (COND ((WINDOWP *WHO-LINE*) (CLOSEW *WHO-LINE*))) @@ -100,5 +101,5 @@ (FIXMETA) (DECLARE%: DONTCOPY - (FILEMAP (NIL (458 5624 (LOADFULLFONTS 468 . 2603) (LOADUP-FULL 2605 . 5374) (FIXMETA 5376 . 5622))))) + (FILEMAP (NIL (456 5721 (LOADFULLFONTS 466 . 2601) (LOADUP-FULL 2603 . 5471) (FIXMETA 5473 . 5719))))) STOP diff --git a/internal/loadups/LOADUP-FULL.LCOM b/internal/loadups/LOADUP-FULL.LCOM index d5a7e96d2a04a6145c333ba724c9d20a8f55daf9..4b6d5511af33dba157e36a8805349b4632ea5585 100644 GIT binary patch delta 236 zcmaDRenWghgs_FKOKP&Nk%5t^f}xR>fti(|(Zpw_}dHT3I2e~?ixVk8y8Vt2nNn!Fq zMlDtaQ!_K8$+?Uw`fyt`6|4e+T*Ey5LxXi)fCeZiDHtJKZ3J|fxs{Q@larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;2| 7333 +(FILECREATED "27-Dec-2025 15:02:04" |{WMEDLEY}loadups>LOADUP-LISP.;24| 7235 - :EDIT-BY "lmm" + :EDIT-BY |rmk| :CHANGES-TO (FNS LOADUP-LISP) - :PREVIOUS-DATE "16-Oct-2025 16:55:27" -|{DSK}larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;1|) + :PREVIOUS-DATE "16-Oct-2025 16:55:27" |{WMEDLEY}loadups>LOADUP-LISP.;22|) (PRETTYCOMPRINT LOADUP-LISPCOMS) @@ -20,7 +19,7 @@ (DEFINEQ (LOADUP-LISP - (LAMBDA (DRIBBLEFILE) (* \; "Edited 5-Nov-2025 09:01 by lmm") + (LAMBDA (DRIBBLEFILE) (* \; "Edited 27-Dec-2025 15:02 by rmk") (* \; "Edited 16-Oct-2025 16:55 by rmk") (* \; "Edited 18-Aug-2025 12:08 by rmk") (* \; "Edited 15-Jun-2025 14:39 by rmk") @@ -106,7 +105,7 @@ (LOADUP '(DSK UFS UFSCALLC MAIKOBITBLT)) (LOADUP '(TIME)) (LOADUP '(BRKDWN)) - (LOADUP '(LOGOW IDLER HARDCOPY ICONW FREEMENU SEDIT)) + (LOADUP '(LOGOW IDLER UNIXUTILS PSEUDOHOSTS HARDCOPY ICONW FREEMENU SEDIT)) (LOADUP '(XCL-EXTRAS)) (* |;;| "CMLPACKAGE pushes onto INSPECTMACROS") @@ -128,10 +127,7 @@ (* |;;| " Added late, LOAD late to avoid any dependencies") - (* |;;| "prevent medley from pinning CPU") - (LOADUP '(XCL-LOOP XCL-HASH-LOOP)) - (LOADUP '(BACKGROUND-YIELD)) (* |;;| " networking code -- should make it optional but too many cross dependencies") @@ -149,5 +145,5 @@ (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (675 7127 (LOADUP-LISP 685 . 7125))))) + (FILEMAP (NIL (640 7029 (LOADUP-LISP 650 . 7027))))) STOP diff --git a/internal/loadups/LOADUP-LISP.LCOM b/internal/loadups/LOADUP-LISP.LCOM index 3a1d86082e364029f635560cfc3fcdf3f8043af9..11f55667e9e2450ab7c91dca09071112f722ce37 100644 GIT binary patch delta 460 zcmZ{fzfQtX97fZ|K+?q!jfn}vFP&NwNV&9B8kf>upz-#Py{*WI(18erR0b2T;Sn@8 zK7f;py6{dugQImYVZaCY&Uemt^`rW9(MEdBPR2E)APpLtp&&z1MUcetV!oWtk_jwQ z5P{tfTx=6Od^nq?t0YTDv%JC|t&z%P5Jc44g6KxGZ78S3=sHXOFbr67x6E!02E;e* zIH(ba2Ee8%1F;(u0^5vwy$GChQ53xQ<0gt}%JnPHF0LjG7*+p*_d#gRiO1Qf@%-}h-m ip>Kw^EZ-YIH^kV*UJUftSr(v)(B`ZBT>1f>5q~NG delta 521 zcmbu5y-vbV9K}-+Fm=&@OvL=t35F7SZ=tc8CKq}omA2Hjm@pzVN>V-o(P+dl_yR)X zh)fI> z&9QR3Xq*ib#9xe1lm#SXk%RGZa_Ie##v!G3+U%Wp)3?+*u`CA`uIWc&vLry1xGbC5 z*K}I8DRHS9QkIVSS9g#w#_R^jRMlL*)Bw)!b~y-cn2P-8ON8K)IbxpY2P+TEEW!rw zk;E2~K()0}Nv9wp1d9vjYpajUCYHb;Rq8YxlNh0lgO{k!2my-SrNq1hnGz{iD|W4J ts(eGEx|$7MV{VcKTttv58@gi<+a-3z$p*Q&7+l1+qks`&=lAhh>>JvAmdOAB diff --git a/library/FILEBROWSER b/library/FILEBROWSER index aee83ad1..ef852820 100644 --- a/library/FILEBROWSER +++ b/library/FILEBROWSER @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "29-May-2024 15:30:07" {LIB}FILEBROWSER.\;2 266071 +(FILECREATED "24-Dec-2025 11:14:31" |{WMEDLEY}FILEBROWSER.;34| 263525 - :EDIT-BY "mth" + :EDIT-BY |rmk| - :CHANGES-TO (FNS FB.PROMPTW.FORMAT FB.FASTSEE.ONEFILE) + :CHANGES-TO (FNS FB.HARDCOPY.TOFILE) - :PREVIOUS-DATE " 4-Nov-2023 23:55:27" {LIB}FILEBROWSER.\;1) + :PREVIOUS-DATE " 6-Nov-2025 14:33:28" |{WMEDLEY}FILEBROWSER.;33|) (PRETTYCOMPRINT FILEBROWSERCOMS) @@ -91,22 +91,10 @@ You specify how many versions to keep."))) (|See| (FB.EDITCOMMAND READONLY) "Displays selected files one at a time in a separate window" - (SUBITEMS ("Fast SEE Pretty" FB.FASTSEECOMMAND - "Views file quickly, uses font information, no scrolling backwards" - ) - ("Fast SEE Unformatted" (FB.FASTSEECOMMAND - T) - - "Views file quickly, shows raw characters, no scrolling backwards" - ) - ("Scrollable & Pretty" (FB.EDITCOMMAND - READONLY) - - "Views file with font information in a fully scrollable window" - ) - ("FileBrowse" FB.BROWSECOMMAND + ) + (|Browse| FB.BROWSECOMMAND "Recursively call FileBrowser on the selected subdirectory" - ))) + ) (|Edit| FB.EDITCOMMAND "Calls an editor on the selected files (use submenu to specify editor)" (SUBITEMS ("TEdit" (FB.EDITCOMMAND TEDIT) @@ -337,15 +325,8 @@ You specify how many versions to keep."))) ("To a printer" (FB.HARDCOPYCOMMAND PRINTER) "Sends hardcopy of selected files to a printer of your choosing"))) (|See| (FB.EDITCOMMAND READONLY) - "Displays selected files one at a time in a separate window" - (SUBITEMS ("Fast SEE Pretty" FB.FASTSEECOMMAND - "Views file quickly, uses font information, no scrolling backwards") - ("Fast SEE Unformatted" (FB.FASTSEECOMMAND T) - "Views file quickly, shows raw characters, no scrolling backwards") - ("Scrollable & Pretty" (FB.EDITCOMMAND READONLY) - "Views file with font information in a fully scrollable window") - ("FileBrowse" FB.BROWSECOMMAND - "Recursively call FileBrowser on the selected subdirectory"))) + "Displays selected files one at a time in a separate window") + (|Browse| FB.BROWSECOMMAND "Recursively call FileBrowser on the selected subdirectory") (|Edit| FB.EDITCOMMAND "Calls an editor on the selected files (use submenu to specify editor)" (SUBITEMS ("TEdit" (FB.EDITCOMMAND TEDIT) @@ -827,13 +808,10 @@ Your deletions are thus ignored."))) (REDISPLAYW (CAR W)))))) (\\FB.HARDCOPY.TOFILE.EXTENSION - (LAMBDA NIL (* \; - "Edited 25-Feb-91 15:15 by gadener") - (LET ((TYPE (PRINTERTYPE))) - (CASE TYPE - (INTERPRESS 'IP) - (POSTSCRIPT 'PS) - (DEFAULT TYPE))))) + (LAMBDA NIL (* \; "Edited 20-Sep-2025 11:41 by rmk") + (* \; "Edited 14-Sep-2025 20:48 by rmk") + (OR (CAR (EXTENSIONS.FOR.IMAGEFILETYPE (PRINTERTYPE))) + DEFAULTPRINTERTYPE))) ) @@ -1586,22 +1564,25 @@ Your deletions are thus ignored."))) PRINTOPTIONS))))))) (FB.HARDCOPY.TOFILE - (LAMBDA (BROWSER FILES) (* \; - "Edited 15-Feb-91 17:13 by gadener") + (LAMBDA (BROWSER FILES) (* \; "Edited 21-Dec-2025 09:05 by rmk") + (* \; "Edited 20-Sep-2025 12:55 by rmk") + (* \; "Edited 18-Sep-2025 10:29 by rmk") + (* \; "Edited 14-Sep-2025 20:55 by rmk") + (* \; "Edited 15-Feb-91 17:13 by gadener") (* |;;| "Handle the \"Hardcopy>To File\" command. ") (PROG ((HCOPYFILE (FB.PROMPTFORINPUT (COND - ((CDR FILES) - "Hardcopy file name pattern: ") - (T "Hardcopy file name: ")) + ((CDR FILES) + "Hardcopy file name pattern: ") + (T "Hardcopy file name: ")) (COND ((CDR FILES) (PACKFILENAME.STRING 'NAME '* 'EXTENSION ( - \\FB.HARDCOPY.TOFILE.EXTENSION + \\FB.HARDCOPY.TOFILE.EXTENSION ))) (T (PACKFILENAME.STRING 'VERSION NIL 'EXTENSION ( - \\FB.HARDCOPY.TOFILE.EXTENSION + \\FB.HARDCOPY.TOFILE.EXTENSION ) 'BODY (FB.FETCHFILENAME (CAR FILES))))) @@ -1619,72 +1600,56 @@ Your deletions are thus ignored."))) ((|for| TAIL |on| (SETQ HCOPYFIELDS (UNPACKFILENAME.STRING HCOPYFILE)) |by| (CDDR TAIL) |bind| HOST HAVEDIRECTORY I |do| (COND - ((SETQ I (STRPOS '* (CADR TAIL))) - (|if| (NEQ (CAR TAIL) - 'NAME) - |then| (RETURN (SETQ MSG "Only name portion can contain *") - )) (* \; "Take apart name into FORE*AFT") - (SETQ HCOPYTAIL (CDR TAIL)) - (SETQ FORE (OR (SUBSTRING (CADR TAIL) - 1 - (SUB1 I)) - "")) - (SETQ AFT (OR (SUBSTRING (CADR TAIL) - (ADD1 I)) - ""))) - (T (SELECTQ (CAR TAIL) - (NAME (RETURN (SETQ MSG - "Name must have * for multiple hardcopy files" - ))) - (EXTENSION (SETQ EXT (MKATOM (U-CASE (CADR TAIL))))) - (DIRECTORY (SETQ HAVEDIRECTORY T)) - (HOST (SETQ HOST (CADR TAIL))) - NIL))) |finally| (|if| (AND HOST (NOT HAVEDIRECTORY)) - |then| + ((SETQ I (STRPOS '* (CADR TAIL))) + (|if| (NEQ (CAR TAIL) + 'NAME) + |then| (RETURN (SETQ MSG "Only name portion can contain *"))) + (* \; "Take apart name into FORE*AFT") + (SETQ HCOPYTAIL (CDR TAIL)) + (SETQ FORE (OR (SUBSTRING (CADR TAIL) + 1 + (SUB1 I)) + "")) + (SETQ AFT (OR (SUBSTRING (CADR TAIL) + (ADD1 I)) + ""))) + (T (SELECTQ (CAR TAIL) + (NAME (RETURN (SETQ MSG + "Name must have * for multiple hardcopy files"))) + (EXTENSION (SETQ EXT (MKATOM (U-CASE (CADR TAIL))))) + (DIRECTORY (SETQ HAVEDIRECTORY T)) + (HOST (SETQ HOST (CADR TAIL))) + NIL))) |finally| (|if| (AND HOST (NOT HAVEDIRECTORY)) + |then| (* \; - "E.g., {DSK}*.IP. This pattern explicitly has no directory") - (|push| HCOPYFIELDS - 'DIRECTORY NIL))) + "E.g., {DSK}*.IP. This pattern explicitly has no directory") + (|push| HCOPYFIELDS 'DIRECTORY NIL))) (FB.PROMPTWPRINT BROWSER "Bad pattern -- " MSG) (RETURN)))) (T (SETQ EXT (U-CASE (FILENAMEFIELD HCOPYFILE 'EXTENSION))))) - (COND - ((AND (NULL (SETQ PRINTFILETYPE (|for| TYPE |in| PRINTFILETYPES - |when| (FMEMB EXT (CADR (ASSOC 'EXTENSION - (CDR TYPE)))) - |do| (* \; - "Opencoded PRINTFILETYPE.FROM.EXTENSION because that one's buggy") - (RETURN (CAR TYPE))))) - (NULL (SETQ PRINTFILETYPE (MENU (|MakeMenuOfImageTypes| "File type?"))))) - (RETURN))) - (|for| ITEM |in| FILES |bind| (CONVERTERS _ (PRINTFILEPROP PRINTFILETYPE - 'CONVERSION)) - FILETYPE NAME FN FIELDS + (CL:UNLESS (SETQ PRINTFILETYPE (OR (IMAGEFILETYPE.FROM.EXTENSION NIL EXT) + (MENU (|MakeMenuOfImageTypes| "File type?")))) + (RETURN)) + (|for| ITEM NAME FIELDS |in| FILES |do| (SETQ ITEM (FB.FETCHFILENAME ITEM)) - (SETQ FILETYPE (OR (PRINTFILETYPE ITEM) - 'TEXT)) - (COND - ((SETQ FN (LISTGET CONVERTERS FILETYPE)) - (FB.PROMPTW.FORMAT BROWSER "~%Writing ~A..." - (SETQ NAME (COND - ((CDR FILES) - (SETQ FIELDS (UNPACKFILENAME.STRING ITEM NIL NIL - 'TENEX)) - (RPLACA HCOPYTAIL (CONCAT FORE (LISTGET FIELDS - 'NAME) - AFT)) - (CL:APPLY (FUNCTION PACKFILENAME.STRING) - 'VERSION NIL (APPEND HCOPYFIELDS FIELDS))) - (T HCOPYFILE)))) - (SETQ NAME (CL:FUNCALL FN ITEM NAME)) - (COND - ((LISTP NAME) (* \; "Result is (SOURCE DESTINATION)") - (SETQ NAME (CADR NAME)))) - (FB.PROMPTWPRINT BROWSER "done.") - (FB.MAYBE.INSERT.FILE BROWSER NAME)) - (T (FB.PROMPTW.FORMAT BROWSER - "~%Failed to hardcopy ~A -- Can't convert a ~A file to format ~A" - ITEM FILETYPE PRINTFILETYPE))))))) + (SETQ NAME (COND + ((CDR FILES) + (SETQ FIELDS (UNPACKFILENAME.STRING ITEM NIL NIL 'TENEX)) + (RPLACA HCOPYTAIL (CONCAT FORE (LISTGET FIELDS 'NAME) + AFT)) + (CL:APPLY (FUNCTION PACKFILENAME.STRING) + 'VERSION NIL (APPEND HCOPYFIELDS FIELDS))) + (T (OUTFILEP HCOPYFILE)))) + (FB.PROMPTW.FORMAT BROWSER "~%Writing ~A..." NAME) + (|if| (SETQ NAME (CONVERT.TO.IMAGEFILE ITEM NAME PRINTFILETYPE + '(NOERROR T QUIET T))) + |then| (FB.PROMPTWPRINT BROWSER "done.") + (FB.MAYBE.INSERT.FILE BROWSER NAME) + |else| (FB.PROMPTW.FORMAT BROWSER + "~%Failed to hardcopy ~A -- Can't convert a ~A file to format ~A" + ITEM (OR (IMAGESOURCETYPE ITEM) + 'TEXT) + PRINTFILETYPE)))))) ) (DEFINEQ @@ -4249,51 +4214,51 @@ then click Recompute")))) (ADDTOVAR LAMA FB.PROMPTW.FORMAT FB.PROMPTWPRINT) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (31871 54979 (FB 31881 . 33016) (FB.COPYBINARYCOMMAND 33018 . 33364) (FB.COPYTEXTCOMMAND - 33366 . 33708) (FILEBROWSER 33710 . 46816) (FB.TABLEBROWSER 46818 . 47035) (FB.SELECTEDFILES 47037 . -47674) (FB.FETCHFILENAME 47676 . 48068) (FB.DIRECTORYP 48070 . 48464) (FB.PROMPTWPRINT 48466 . 49512) -(FB.PROMPTW.FORMAT 49514 . 50478) (FB.PROMPTFORINPUT 50480 . 52732) (FB.YES-OR-NO-P 52734 . 53768) ( -FB.ALLOW.ABORT 53770 . 54624) (\\FB.HARDCOPY.TOFILE.EXTENSION 54626 . 54977)) (55003 55956 (FB.STARTUP - 55013 . 55528) (FB.MAKERIGIDWINDOW 55530 . 55954)) (55957 61440 (FB.PRINTFN 55967 . 61120) (FB.COPYFN - 61122 . 61438)) (61490 67830 (FB.MENU.WHENSELECTEDFN 61500 . 61858) (FB.COMMANDSELECTEDFN 61860 . -63399) (FB.SUBITEMP 63401 . 64002) (FB.MAKE.BROWSER.BUSY 64004 . 64808) (FB.FINISH.COMMAND 64810 . -66841) (FB.HANDLE.ABORT.BUTTON 66843 . 67828)) (67831 73347 (FB.DELETECOMMAND 67841 . 68122) ( -FB.DELVERCOMMAND 68124 . 71317) (FB.IS.NOT.SUBDIRECTORY.ITEM 71319 . 71500) (FB.DELVER.FILES 71502 . -72591) (FB.DELETE.FILE 72593 . 73345)) (73348 74673 (FB.UNDELETECOMMAND 73358 . 73643) ( -FB.UNDELETEALLCOMMAND 73645 . 73924) (FB.UNDELETE.FILE 73926 . 74671)) (74674 98855 (FB.COPYCOMMAND -74684 . 74953) (FB.RENAMECOMMAND 74955 . 75230) (FB.COPY/RENAME.COMMAND 75232 . 76155) ( -FB.COPY/RENAME.ONE 76157 . 78479) (FB.COPY/RENAME.MANY 78481 . 84701) (FB.MERGE.DIRECTORIES 84703 . -85121) (FB.GREATEST.PREFIX 85123 . 86479) (FB.MAYBE.INSERT.FILE 86481 . 93921) (FB.GET.NEW.FILE.SPEC -93923 . 97754) (FB.CANONICAL.DIRECTORY 97756 . 98853)) (98856 106640 (FB.HARDCOPYCOMMAND 98866 . 99996 -) (FB.HARDCOPY.TOFILE 99998 . 106638)) (106641 116850 (FB.EDITCOMMAND 106651 . 107518) ( -FB.EDITCOMMAND.ONEFILE 107520 . 110934) (FB.EDITLISPFILE 110936 . 112041) (FB.BROWSECOMMAND 112043 . -116848)) (116851 128571 (FB.FASTSEECOMMAND 116861 . 120311) (FB.FASTSEE.ONEFILE 120313 . 123269) ( -FB.SEEFULLFN 123271 . 127402) (FB.SEEBUTTONFN 127404 . 128569)) (128572 130318 (FB.LOADCOMMAND 128582 - . 129089) (FB.COMPILECOMMAND 129091 . 129629) (FB.OPERATE.ON.FILES 129631 . 130316)) (130319 178504 ( -FB.UPDATECOMMAND 130329 . 130554) (FB.FIX-DIRECTORY-DATES 130556 . 131579) (FB.MAYBE.EXPUNGE 131581 . -132642) (FB.UPDATEBROWSERITEMS 132644 . 145859) (FB.DATE 145861 . 146502) (FB.ADJUST.DATE.WIDTH 146504 - . 149472) (FB.SET.BROWSER.TITLE 149474 . 150476) (FB.MAYBE.WIDEN.NAMES 150478 . 152597) ( -FB.SET.DEFAULT.NAME.WIDTH 152599 . 153963) (FB.CREATE.FILEBUCKET 153965 . 161185) ( -FB.CHECK.NAME.LENGTH 161187 . 163608) (FB.ADD.FILEGROUP 163610 . 165137) (FB.INSERT.DIRECTORY 165139 - . 165377) (FB.MAKE.SUBDIRECTORY.ITEM 165379 . 166788) (FB.ADD.FILE 166790 . 167403) (FB.INSERT.FILE -167405 . 170817) (FB.ANALYZE.PATTERN 170819 . 176083) (FB.CANONICALIZE.PATTERN 176085 . 177397) ( -FB.GETALLFILEINFO 177399 . 178502)) (178505 186664 (FB.SORT.VERSIONS 178515 . 181286) ( -FB.DECREASING.VERSION 181288 . 181957) (FB.INCREASING.VERSION 181959 . 182580) ( -FB.NAMES.DECREASING.VERSION 182582 . 183617) (FB.NAMES.INCREASING.VERSION 183619 . 184616) ( -FB.DECREASING.NUMERIC.ATTR 184618 . 185298) (FB.INCREASING.NUMERIC.ATTR 185300 . 185974) ( -FB.ALPHABETIC.ATTR 185976 . 186662)) (186665 196507 (FB.SORTCOMMAND 186675 . 193505) ( -FB.INSERT.SUBDIRECTORIES 193507 . 194304) (FB.GET.SORT.MENU 194306 . 196505)) (196508 212729 ( -FB.EXPUNGECOMMAND 196518 . 199103) (FB.NEWPATTERNCOMMAND 199105 . 199503) (FB.NEWINFOCOMMAND 199505 . -202337) (FB.DEPTHCOMMAND 202339 . 204114) (FB.SHAPECOMMAND 204116 . 207458) (FB.REMOVE.FILE 207460 . -209281) (FB.COUNT.FILE.CHANGE 209283 . 210728) (FB.SETNEWPATTERN 210730 . 211900) (FB.GET.NEWPATTERN -211902 . 212486) (FB.OPTIONSCOMMAND 212488 . 212727)) (212764 213817 (FB.GETWINDOW 212774 . 213815)) ( -213818 214830 (FB.INFOMENU.SHADEINITIALSELECTIONS 213828 . 214475) (FB.INFO.ITEM.NAMED 214477 . 214828 -)) (214831 224363 (FB.MAKECOUNTERWINDOW 214841 . 216369) (FB.COUNTERW.REDISPLAYFN 216371 . 216958) ( -FB.UPDATE.COUNTERS 216960 . 219032) (FB.DISPLAY.COUNTERS 219034 . 224094) (FB.COUNTER.STRING 224096 . -224361)) (224364 229073 (FB.MAKEHEADINGWINDOW 224374 . 225988) (FB.HEADINGW.REDISPLAYFN 225990 . -226256) (FB.HEADINGW.RESHAPEFN 226258 . 226634) (FB.HEADINGW.DISPLAY 226636 . 229071)) (229074 233257 -(FB.ICONFN 229084 . 229431) (FB.INFOMENU.WHENSELECTEDFN 229433 . 230163) (FB.CLOSEFN 230165 . 231368) -(FB.EXPUNGE?.MENU 231370 . 231782) (FB.AFTERCLOSEFN 231784 . 232145) (FB.CLOSE&EXPUNGE 232147 . 233255 -)) (233258 245316 (FB.HARDCOPY.DIRECTORY 233268 . 243625) (FB.HARDCOPY.PRINT.TITLE 243627 . 243953) ( -FB.HARDCOPY.MAXWIDTH 243955 . 245314))))) + (FILEMAP (NIL (30255 53354 (FB 30265 . 31400) (FB.COPYBINARYCOMMAND 31402 . 31748) (FB.COPYTEXTCOMMAND + 31750 . 32092) (FILEBROWSER 32094 . 45200) (FB.TABLEBROWSER 45202 . 45419) (FB.SELECTEDFILES 45421 . +46058) (FB.FETCHFILENAME 46060 . 46452) (FB.DIRECTORYP 46454 . 46848) (FB.PROMPTWPRINT 46850 . 47896) +(FB.PROMPTW.FORMAT 47898 . 48862) (FB.PROMPTFORINPUT 48864 . 51116) (FB.YES-OR-NO-P 51118 . 52152) ( +FB.ALLOW.ABORT 52154 . 53008) (\\FB.HARDCOPY.TOFILE.EXTENSION 53010 . 53352)) (53378 54331 (FB.STARTUP + 53388 . 53903) (FB.MAKERIGIDWINDOW 53905 . 54329)) (54332 59815 (FB.PRINTFN 54342 . 59495) (FB.COPYFN + 59497 . 59813)) (59865 66205 (FB.MENU.WHENSELECTEDFN 59875 . 60233) (FB.COMMANDSELECTEDFN 60235 . +61774) (FB.SUBITEMP 61776 . 62377) (FB.MAKE.BROWSER.BUSY 62379 . 63183) (FB.FINISH.COMMAND 63185 . +65216) (FB.HANDLE.ABORT.BUTTON 65218 . 66203)) (66206 71722 (FB.DELETECOMMAND 66216 . 66497) ( +FB.DELVERCOMMAND 66499 . 69692) (FB.IS.NOT.SUBDIRECTORY.ITEM 69694 . 69875) (FB.DELVER.FILES 69877 . +70966) (FB.DELETE.FILE 70968 . 71720)) (71723 73048 (FB.UNDELETECOMMAND 71733 . 72018) ( +FB.UNDELETEALLCOMMAND 72020 . 72299) (FB.UNDELETE.FILE 72301 . 73046)) (73049 97230 (FB.COPYCOMMAND +73059 . 73328) (FB.RENAMECOMMAND 73330 . 73605) (FB.COPY/RENAME.COMMAND 73607 . 74530) ( +FB.COPY/RENAME.ONE 74532 . 76854) (FB.COPY/RENAME.MANY 76856 . 83076) (FB.MERGE.DIRECTORIES 83078 . +83496) (FB.GREATEST.PREFIX 83498 . 84854) (FB.MAYBE.INSERT.FILE 84856 . 92296) (FB.GET.NEW.FILE.SPEC +92298 . 96129) (FB.CANONICAL.DIRECTORY 96131 . 97228)) (97231 104094 (FB.HARDCOPYCOMMAND 97241 . 98371 +) (FB.HARDCOPY.TOFILE 98373 . 104092)) (104095 114304 (FB.EDITCOMMAND 104105 . 104972) ( +FB.EDITCOMMAND.ONEFILE 104974 . 108388) (FB.EDITLISPFILE 108390 . 109495) (FB.BROWSECOMMAND 109497 . +114302)) (114305 126025 (FB.FASTSEECOMMAND 114315 . 117765) (FB.FASTSEE.ONEFILE 117767 . 120723) ( +FB.SEEFULLFN 120725 . 124856) (FB.SEEBUTTONFN 124858 . 126023)) (126026 127772 (FB.LOADCOMMAND 126036 + . 126543) (FB.COMPILECOMMAND 126545 . 127083) (FB.OPERATE.ON.FILES 127085 . 127770)) (127773 175958 ( +FB.UPDATECOMMAND 127783 . 128008) (FB.FIX-DIRECTORY-DATES 128010 . 129033) (FB.MAYBE.EXPUNGE 129035 . +130096) (FB.UPDATEBROWSERITEMS 130098 . 143313) (FB.DATE 143315 . 143956) (FB.ADJUST.DATE.WIDTH 143958 + . 146926) (FB.SET.BROWSER.TITLE 146928 . 147930) (FB.MAYBE.WIDEN.NAMES 147932 . 150051) ( +FB.SET.DEFAULT.NAME.WIDTH 150053 . 151417) (FB.CREATE.FILEBUCKET 151419 . 158639) ( +FB.CHECK.NAME.LENGTH 158641 . 161062) (FB.ADD.FILEGROUP 161064 . 162591) (FB.INSERT.DIRECTORY 162593 + . 162831) (FB.MAKE.SUBDIRECTORY.ITEM 162833 . 164242) (FB.ADD.FILE 164244 . 164857) (FB.INSERT.FILE +164859 . 168271) (FB.ANALYZE.PATTERN 168273 . 173537) (FB.CANONICALIZE.PATTERN 173539 . 174851) ( +FB.GETALLFILEINFO 174853 . 175956)) (175959 184118 (FB.SORT.VERSIONS 175969 . 178740) ( +FB.DECREASING.VERSION 178742 . 179411) (FB.INCREASING.VERSION 179413 . 180034) ( +FB.NAMES.DECREASING.VERSION 180036 . 181071) (FB.NAMES.INCREASING.VERSION 181073 . 182070) ( +FB.DECREASING.NUMERIC.ATTR 182072 . 182752) (FB.INCREASING.NUMERIC.ATTR 182754 . 183428) ( +FB.ALPHABETIC.ATTR 183430 . 184116)) (184119 193961 (FB.SORTCOMMAND 184129 . 190959) ( +FB.INSERT.SUBDIRECTORIES 190961 . 191758) (FB.GET.SORT.MENU 191760 . 193959)) (193962 210183 ( +FB.EXPUNGECOMMAND 193972 . 196557) (FB.NEWPATTERNCOMMAND 196559 . 196957) (FB.NEWINFOCOMMAND 196959 . +199791) (FB.DEPTHCOMMAND 199793 . 201568) (FB.SHAPECOMMAND 201570 . 204912) (FB.REMOVE.FILE 204914 . +206735) (FB.COUNT.FILE.CHANGE 206737 . 208182) (FB.SETNEWPATTERN 208184 . 209354) (FB.GET.NEWPATTERN +209356 . 209940) (FB.OPTIONSCOMMAND 209942 . 210181)) (210218 211271 (FB.GETWINDOW 210228 . 211269)) ( +211272 212284 (FB.INFOMENU.SHADEINITIALSELECTIONS 211282 . 211929) (FB.INFO.ITEM.NAMED 211931 . 212282 +)) (212285 221817 (FB.MAKECOUNTERWINDOW 212295 . 213823) (FB.COUNTERW.REDISPLAYFN 213825 . 214412) ( +FB.UPDATE.COUNTERS 214414 . 216486) (FB.DISPLAY.COUNTERS 216488 . 221548) (FB.COUNTER.STRING 221550 . +221815)) (221818 226527 (FB.MAKEHEADINGWINDOW 221828 . 223442) (FB.HEADINGW.REDISPLAYFN 223444 . +223710) (FB.HEADINGW.RESHAPEFN 223712 . 224088) (FB.HEADINGW.DISPLAY 224090 . 226525)) (226528 230711 +(FB.ICONFN 226538 . 226885) (FB.INFOMENU.WHENSELECTEDFN 226887 . 227617) (FB.CLOSEFN 227619 . 228822) +(FB.EXPUNGE?.MENU 228824 . 229236) (FB.AFTERCLOSEFN 229238 . 229599) (FB.CLOSE&EXPUNGE 229601 . 230709 +)) (230712 242770 (FB.HARDCOPY.DIRECTORY 230722 . 241079) (FB.HARDCOPY.PRINT.TITLE 241081 . 241407) ( +FB.HARDCOPY.MAXWIDTH 241409 . 242768))))) STOP diff --git a/library/FILEBROWSER.LCOM b/library/FILEBROWSER.LCOM index 7edc09c94f1b79c50e377db4aa6fa39265c732cb..cea20c863a82dbd1547568af9620d82e6faf74fe 100644 GIT binary patch delta 1397 zcma)6U2oe|7`9VN!RsImQQB>+yt9Us2*veh7Kbs-O->qjiH~udq-iTf?Gi0fw`OD$ zAHu8>5|>CIBgP$qT@?wjG%XX_AU9kf?TS0#4k08i`3K|pq#YIA1->|b{rJ4k^M0Lk z=bQ2V_V`E6mYU49E+=JC)YLG zE{pBD;NpM}yw0Wve7;gF!eK5!5C~0k?Pja#JyAxI`2-gaD6$SRT$BS|eqv%r5;2cv z0&+^xNI5bnXS&JxI(WTn8$>sgEg04UDkohG@w`>u&)^^d{|k0nPbIDHoBP!yrBpI< zng{NP>VHKQZ}2<&)2UWG4W|500xWOy4iF2X3<9@ZWy!FOJVR!8PKFb@S zFZ;|N1pU^HfS@;K6DDf;*Jup59Yede>!gJ91Fp4s^I zSb*(K&|lvNC;@+=-uvJWcQKBzO~T>NRcF|UU#PyAj14~=k$xJuG@?WD3iTg3IJz6g zv2FUVZJs>&T|2US*8jMA#%$x~Myyj*iiS>?<=shRN;-zaV|!1v!z{%bk)aXVxqu_> zK$l@AgQXE07E3thFV;?N#V8krKNyvP#Bh-^<0wsuM1-S@6d8F(cVP)R7v#b=BLjnX{wh;ZnhBkTSf_ilG34stO_wy|MR62FKO~9 z;)9_R@+2GK@mLPNT{_De97$CIm!O~$gM=H5ET~EfY$JQ=fL$oNWat-2FfvdzRn&-= zg_itF%bz^W#X*x({-4Xa*F+WgW_Pni?gf>E8MiQU9PEG#uUAauf}7w-2_)ceyc zZgw`Wz%7GbBZ{W`)=Kqx4rEaQo(Cx{lb1hOS!cOHZ1u;%Yy#rme6Rb~jTSleq(7r; iE{jVg!^*+!uXOhOy}xw!;l#bQ6YRs;|GWSG>3;yC30@=s delta 2259 zcmeHIPi!Jp7-y(;U0k}fsYno;Z%20*k}ZMxLkk+y0S1{0^CmMxyZw{kv`h;rg%zkx zBQ6^gk0u&c*P9zX?ZHUPHpWEd;$h=$^`d8Eq9?t0Uf;Ya+156mJ$PW=o9}(!`~7|& z^L}st-sopvjJ~gS;?sF!Z<>iP97Op98%gkS8iMqCefvhGYL=j00~+4SNy)b}Qcg^& zXi*c@@ajuU2x#V5afC@kVhN6?!PQ=Cn8W%uwAafx#h>v04*P*h3QMO9x?#E?74MIkL_ghEaSmIp-xW)>8Lo1Ri7MF%Dd zk^)feld$ zm575sk>sP`w>^Zs)REMW2PAQ&rym6lyaTI<0Fy^?Y|xt;HfB&M`UmgXjrqvREBdT- z=l&zFihTDy$bXM4mLOqquhfm-Vo1u>khv!HNCWySqf3-Mu(4HeW z9l?3<3i6e05f>~nMHuAr2uQ(InY7F|AaCSRmJkpql6)&$43Lxo@}WT0iKfPifssR> zy*tSp%%K38^!&IdfkE$Adl47-=R@vM3v+-boyE!hNAr$gEW({}aQT_;-9?`oiyvDf zUmfrqdn`6Q=se3oDwhxxCAS1T6NlARJQw9O1AJr_Qb%j3Wo?XY>qJ-wKgpIR+ z!=g+!V7d5XCKh3>JGy-PNp}$VINSYXIej_C0bQ!sOl)Etwi){7<;6y&RjF;lO~JA@ zH?XmpF03qE1SY})O+$2+!GpW|?#deF?*F#(UB3fCt&o&-F|R?;MQ4m=3$Sy7(lA@C zJ=$vfk(s7YJ}<~=?2`)>bGHc_*vsLKoyz)Fb?+MNG))|;*IH1iZPXjvMypb5RDy6WDrAI9zB$Zy*`cP+*0VI*xgF2d`ctM3kGcLRI7VO zQpxVSm0GF3YYWAVN;WW4leE*m?}kv6>(2KVsh6qHm!lr)&XxcFj{nNv@mGxc`uV>B DoK9PDFSTREAM.;70 15659 +(FILECREATED "19-Jan-2026 17:03:36" {WMEDLEY}PDFSTREAM.;107 17186 :EDIT-BY rmk - :CHANGES-TO (FNS PDF.FONTSAVAILABLE) + :CHANGES-TO (VARS PDFSTREAMCOMS) + (FNS SEE-PDF) - :PREVIOUS-DATE "30-Jul-2025 18:01:04" {WMEDLEY}PDFSTREAM.;68) + :PREVIOUS-DATE "17-Jan-2026 12:11:04" {WMEDLEY}PDFSTREAM.;105) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -14,26 +15,13 @@ (RPAQQ PDFSTREAMCOMS ((FILES (SYSLOAD) POSTSCRIPTSTREAM) + (INITVARS (PDFFONTCOERCIONS POSTSCRIPTFONTCOERCIONS) + (PDFCHARCOERCIONS POSTSCRIPTCHARCOERCIONS)) [COMS (* ; "Hook into hardcopy interface") - [ADDVARS [PRINTERTYPES ((PDF) - (CANPRINT (PDF)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION - ROTATION TITLE] - [PRINTFILETYPES (PDF (TEST PDFFILEP) - (EXTENSION (PDF)) - (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT] - (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) - (FONTCREATE POSTSCRIPT.FONTCREATE) - (FONTSAVAILABLE PDF.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC) - (FONTEXISTS? POSTSCRIPT.FONTEXISTS?] - (ALISTS (DEFAULTFILETYPELIST PDF)) - (VARS (DEFAULTPRINTERTYPE 'PDF)) - (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT PDF.FONTSAVAILABLE) + (ALISTS (PRINTFILETYPES PDF) + (IMAGESTREAMTYPES PDF) + (DEFAULTFILETYPELIST PDF)) + (FNS PDFFILEP PDF.HARDCOPYW PDF.TEDIT PDF.FONTSAVAILABLE) (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT] (* ;; "") @@ -46,29 +34,31 @@ (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) (GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) (FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF) + (FNS PDF.POSTSCRIPT) (FNS SEE-PDF) (ADDVARS (FB.SEE.METHODS (PDFFILEP SEE-PDF))) - (FNS PDFCONVERTER))) + (FNS PDFCONVERTER) + (FNS \PDFINIT) + (P (\PDFINIT)))) (FILESLOAD (SYSLOAD) POSTSCRIPTSTREAM) +(RPAQ? PDFFONTCOERCIONS POSTSCRIPTFONTCOERCIONS) + +(RPAQ? PDFCHARCOERCIONS POSTSCRIPTCHARCOERCIONS) + (* ; "Hook into hardcopy interface") -(ADDTOVAR PRINTERTYPES ((PDF) - (CANPRINT (PDF)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))) - (ADDTOVAR PRINTFILETYPES (PDF (TEST PDFFILEP) (EXTENSION (PDF)) - (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT)))) + (CONVERSION (POSTSCRIPT PDF.POSTSCRIPT)) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW IMAGEFILE BITMAP SCALEFACTOR REGION ROTATION + TITLE)))) (ADDTOVAR IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) (FONTCREATE POSTSCRIPT.FONTCREATE) @@ -77,54 +67,56 @@ (FONTEXISTS? POSTSCRIPT.FONTEXISTS?))) (ADDTOVAR DEFAULTFILETYPELIST (PDF . BINARY)) - -(RPAQQ DEFAULTPRINTERTYPE PDF) (DEFINEQ (PDFFILEP - [LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk") + [LAMBDA (FILE) (* ; "Edited 13-Sep-2025 23:24 by rmk") + (* ; "Edited 23-Jun-2023 14:43 by rmk") (* ; "Edited 5-Mar-93 21:40 by rmk:") (* ; "Edited 14-Jan-93 10:56 by jds") (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) '("PDF") :TEST (FUNCTION STRING-EQUAL)) - (CL:WHEN (STREAMP FILE) - (SETFILEPTR FILE 0) - (PROG1 (AND (EQ (BIN FILE) - (CHARCODE %%)) - (EQ (BIN FILE) - (CHARCODE P)) - (EQ (BIN FILE) - (CHARCODE D)) - (EQ (BIN FILE) - (CHARCODE F))) - (SETFILEPTR FILE 0)))]) + (RESETLST + [LET (STRM) + [if (SETQ STRM (\GETSTREAM FILE 'INPUT T)) + then [RESETSAVE NIL `(PROGN (SETFILEPTR ,STRM ,(GETFILEPTR STRM] + (SETFILEPTR STRM 0) + else (RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE] + (AND (EQ (BIN STRM) + (CHARCODE %%)) + (EQ (BIN STRM) + (CHARCODE P)) + (EQ (BIN STRM) + (CHARCODE D)) + (EQ (BIN STRM) + (CHARCODE F])]) (PDF.HARDCOPYW [LAMBDA (PDFFILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + (* ; "Edited 12-Jan-2026 23:35 by rmk") + (* ; "Edited 11-Jan-2026 14:07 by rmk") + (* ; "Edited 19-Sep-2025 17:36 by rmk") (* ; "Edited 24-Jul-2023 10:37 by rmk") - (* ; "Edited 23-Jun-2023 13:28 by rmk") - (* ; "Edited 6-Mar-2023 22:43 by rmk") - (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY PDFFILE))) - (PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP BITMAP SCALEFACTOR REGION Landscape? TITLE) - PDFFILE]) - -(PDF.TEXT - [LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 1-Oct-2023 15:24 by rmk") - (* ; "Edited 23-Jun-2023 13:23 by rmk") - (* ; "Edited 7-Mar-2023 08:39 by rmk") - (TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION - ROTATION ,(NOT (NOT - POSTSCRIPT.TEXTFILE.LANDSCAPE - ]) + (* ; "Edited 23-Jun-2023 13:28 by rmk") + (PS-TO-PDF (POSTSCRIPT.HARDCOPYW (OPENSTREAM (UNIX-TMP-FILE-NAME 'bitmap 'ps) + 'OUTPUT) + BITMAP SCALEFACTOR REGION Landscape? TITLE) + PDFFILE]) (PDF.TEDIT - [LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk") - (* ; "Edited 7-Mar-2023 08:39 by rmk") - (LET ((TSTREAM (OPENTEXTSTREAM FILE))) - (TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF) - (CLOSEF TSTREAM]) + [LAMBDA (FILE IMAGESTREAM IMAGETYPE OPTIONS) (* ; "Edited 13-Jan-2026 15:47 by rmk") + (* ; "Edited 26-Sep-2025 23:02 by rmk") + (* ; "Edited 19-Sep-2025 07:33 by rmk") + + (* ;; "Make a scratch postscript stream, then convert it to a PDF that is stored in the caller's IMAGESTREAM (which may have been opened with some postscript preamble, which we discard)") + + (PS-TO-PDF (TEDIT.TO.IMAGEFILE FILE (OPENSTREAM (UNIX-TMP-FILE-NAME 'tedit IMAGETYPE) + 'OUTPUT) + 'POSTSCRIPT OPTIONS) + IMAGESTREAM]) (PDF.FONTSAVAILABLE [LAMBDA (FONTSPEC) (* ; "Edited 23-Aug-2025 10:53 by rmk") @@ -162,137 +154,165 @@ (DEFINEQ (OPEN-PDF-STREAM - [LAMBDA (FILE OPTIONS) (* ; "Edited 5-Jun-2025 08:41 by rmk") + [LAMBDA (FILE OPTIONS) (* ; "Edited 14-Sep-2025 11:15 by rmk") + (* ; "Edited 5-Jun-2025 08:41 by rmk") (* ; "Edited 23-Feb-2025 12:18 by rmk") (* ; "Edited 23-Sep-2023 15:38 by rmk") (* ; "Edited 22-Sep-2023 11:04 by rmk") (* ; "Edited 24-Jun-2023 14:49 by rmk") - (* ;; "Open a temporary PS file, but set it up so that at closing it gets converted to PDF using an operating-system utility (if available), and then gets renamed to the original intended filename.") + (* ;; "Open FILE as a postscript file, but with IMAGETYPE=PDF and a closefn that calls PS-TO-PDF after the PS file closefn.") - (* ;; "We have to stash the original filename someplace. We could put it in the tmp filename and then parse it out, but then we would have to worry about how unix filenames might parse against our {, }, etc. ") - - (* ;; - "Simplest thing for now is to just add an extra field at the end of the \POSTSCRIPTDATA record.") - - (if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST] - then - (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.") - - (OPENPOSTSCRIPTSTREAM FILE OPTIONS) - elseif (EQ 'NULL (FILENAMEFIELD (TRUEFILENAME FILE) - 'HOST)) - then - (* ;; "Device NULL used by TMAX, maybe others, to get page number for table of contents, index. Nothing to convert") - - (OPENPOSTSCRIPTSTREAM FILE OPTIONS) - elseif (SETQ FILE (OR [AND (NEQ FILE T) - (OR (OUTFILEP FILE) - (OPENSTREAM FILE 'OUTPUT] - (ERROR "PDF target file not found" FILE))) - then (CL:UNLESS (ASSOC (PDFCONVERTER) - PDF-CONVERTER-TEMPLATES) - (ERROR "Can't find a POSTSCRIPT-to-PDF converter")) - (LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE) - "-" - (RAND) - ".ps") - OPTIONS))) - (STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM))) - (STREAMPROP PSSTREAM 'PDFTARGETINFO FILE) - PSSTREAM]) + (DECLARE (GLOBALVARS \PDFIMAGEOPS)) + (CL:UNLESS (ASSOC (PDFCONVERTER) + PDF-CONVERTER-TEMPLATES) + (ERROR "Can't find a POSTSCRIPT-to-PDF converter")) + (LET ((STRM (OPENPOSTSCRIPTSTREAM FILE OPTIONS))) + (replace (STREAM IMAGEOPS) of STRM with \PDFIMAGEOPS) + STRM]) (CLOSE-PDF-STREAM - [LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk") + [LAMBDA (PSSTREAM) (* ; "Edited 17-Jan-2026 12:10 by rmk") + (* ; "Edited 15-Jan-2026 10:16 by rmk") + (* ; "Edited 13-Jan-2026 15:49 by rmk") + (* ; "Edited 27-Sep-2025 14:02 by rmk") + (* ; "Edited 19-Sep-2025 14:16 by rmk") + (* ; "Edited 14-Sep-2025 12:16 by rmk") + (* ; "Edited 22-Sep-2023 11:18 by rmk") (* ; "Edited 24-Jul-2023 10:37 by rmk") (* ; "Edited 17-Jul-2023 22:32 by rmk") (* ; "Edited 24-Jun-2023 13:57 by rmk") - - (* ;; "PSSTREAM is a postscript (maybe in tmp) rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") - - (* ;; "But for a file we execute the PDFCONVERTER as a shell command to make a pdf, and then we rename it to the intended filename") - - (STREAMPROP PSSTREAM 'AFTERCLOSE NIL) (* ; - "Maybe just remove only CLOSE-PDF-STREAMfrom the list?") - (LET ((TARGETINFO (STREAMPROP PSSTREAM 'PDFTARGETINFO NIL))) - (CL:IF TARGETINFO - (RENAMEFILE (PS-TO-PDF PSSTREAM) - TARGETINFO) - PSSTREAM)]) + (* ; + "Don't run again for internal closing") + (CL:WHEN (IMAGESTREAMTYPE PSSTREAM 'PDF) (* ; + "If it's still a PDF stream, it hasn't been converted") + (CLOSEPOSTSCRIPTSTREAM PSSTREAM) + (replace (STREAM IMAGEOPS) of PSSTREAM with \NOIMAGEOPS) + (* ; + "Don't run again for internal closing") + (CLOSEF? PSSTREAM) (* ; "PS-TO-PDF wants it closed?") + (RESETLST + (LET (PDFSTREAM) (* ; + "PS-TO-PDF returns a /tmp file if not given a PDFFILE, we copy it into our stream") + [RESETSAVE (SETQ PDFSTREAM (OPENSTREAM (PS-TO-PDF (FULLNAME PSSTREAM) + (UNIX-TMP-FILE-NAME 'closepdf + 'pdf)) + 'INPUT)) + `(PROGN (DELFILE (CLOSEF? OLDVALUE] + [RESETSAVE (SETQ PSSTREAM (OPENSTREAM PSSTREAM 'OUTPUT)) + `(PROGN (CLOSEF? OLDVALUE] + (SETFILEPTR PSSTREAM 0) + (SETFILEINFO PSSTREAM 'LENGTH 0) + (COPYBYTES PDFSTREAM PSSTREAM 0 -1))))]) (PS-TO-PDF - [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 1-Oct-2023 15:18 by rmk") - (* ; "Edited 23-Sep-2023 22:54 by rmk") + [LAMBDA (PSFILE PDFFILE MAKEERRORFILE) (* ; "Edited 14-Jan-2026 21:02 by rmk") + (* ; "Edited 13-Jan-2026 15:44 by rmk") + (* ; "Edited 27-Sep-2025 16:51 by rmk") + (* ; "Edited 19-Sep-2025 14:14 by rmk") + (* ; "Edited 14-Sep-2025 09:44 by rmk") + (* ; "Edited 1-Oct-2023 15:18 by rmk") (* ; "Edited 23-Jul-2023 22:30 by rmk") - (* ; "Edited 24-Jun-2023 15:01 by rmk") (* ; "Edited 16-Jul-2022 13:06 by rmk") - (* ; "Edited 8-Jul-2022 10:20 by rmk") (* ; "Edited 7-May-2022 22:40 by rmk") (* ; "Edited 7-Oct-2021 11:15 by rmk:") - (* ;; "PSFILE is the name of a closed PS file on a DSK/UNIX device. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to PDFFILE. ") + (* ;; "PSFILE is a postscript file or stream whose contents are to be converted to a PDF-formatted file PDFFILE by means of a Shell PDFCONVERTER utility.") - (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") + (* ;; "") + + (* ;; "PSFILE may be a Medley filename or a stream that is recognized as a PS formatted file. If its contents do not reside in the Unix file system, it will be copied to a /tmp/ file to be given to the Shell. The /tmp/ file may be deleted at the end.") + + (* ;; "") + + (* ;; "PDFFILE is NIL, a file name, or perhaps a stream to receive the pdf.") + + (* ;; " If NIL, a name is made by attaching PDF to PSFILE; a stream without a name goes to a scratch stream.") + + (* ;; "") - (SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE))) - (CL:UNLESS (INFILEP PSFILE) - (ERROR "NO PS FILE TO CONVERT")) (CL:UNLESS (ASSOC (PDFCONVERTER) PDF-CONVERTER-TEMPLATES) - (ERROR "A specified POSTSCRIPT-to-PDF converter cannot be found")) - (SETQ PDFFILE (if PDFFILE - then (TRUEFILENAME PDFFILE) - else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE))) - (LET ((ERRORFILE (PACKFILENAME 'EXTENSION 'error 'BODY PSFILE)) - COMPLETIONCODE) + (ERROR "A POSTSCRIPT-to-PDF converter cannot be found for this system")) + (CL:UNLESS (POSTSCRIPTFILEP PSFILE) + (ERROR "NOT A POSTSCRIPT FILE" PSFILE)) + (SETQ PSFILE (TRUEFILENAME PSFILE)) + (SETQ PDFFILE (TRUEFILENAME PDFFILE)) + (RESETLST + (LET* ((PSNAMEU (SLASHIT (CL:IF (EQ 'UNIX (FILENAMEFIELD PSFILE 'HOST)) + (FULLNAME PSFILE) + (COPYFILE PSFILE (UNIX-TMP-FILE-NAME PSFILE 'ps))) + NIL T)) + TMPPDFFILE + [PDFNAMEU (CL:IF (EQ 'UNIX (FILENAMEFIELD PDFFILE 'HOST)) + (FULLNAME PDFFILE) + (SETQ TMPPDFFILE (UNIX-TMP-FILE-NAME PDFFILE 'pdf)))] + (ERRORFILE (CL:IF MAKEERRORFILE + (UNIX-TMP-FILE-NAME (OR TMPPDFFILE PDFFILE) + 'error) + "/dev/null")) + COMPLETIONCODE) - (* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.") + (* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.") - (* ;; - "We have to map the filenames down to Unix conventions: (not pseudohost or host, slashes, etc.") + [SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS `((PSFILE \, PSNAMEU) + (PDFFILE \, + (SLASHIT PDFNAMEU + NIL T)) + (ERRORFILE \, + (SLASHIT ERRORFILE + NIL T))) + (ASSOC (PDFCONVERTER) + PDF-CONVERTER-TEMPLATES + ] - [SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS - `((PSFILE \, (SLASHIT (TRUEFILENAME - PSFILE) - NIL T)) - (PDFFILE \, (SLASHIT (TRUEFILENAME - PDFFILE) - NIL T)) - (ERRORFILE \, (SLASHIT (TRUEFILENAME - ERRORFILE) - NIL T))) - (ASSOC (PDFCONVERTER) - PDF-CONVERTER-TEMPLATES] + (* ;; "Now use Medley names") - (* ;; "Now use Medley names") + (CL:WHEN (IGREATERP COMPLETIONCODE 0) + (CL:WHEN (AND MAKEERRORFILE (INFILEP ERRORFILE)) + (CLOSEF? ERRORFILE) + (CL:WHEN (IGREATERP (GETFILEINFO ERRORFILE 'LENGTH) + 0) + (PRINTOUT T "See error file at " '%" ERRORFILE '%" T))) + (ERROR "Cannot create PDF file for " PSFILE)) + (if TMPPDFFILE + then (* ; "Not on {UNIX}, could be {DSK}") + (PROG1 (COPYFILE TMPPDFFILE PDFFILE) + (DELFILE TMPPDFFILE)) + else (* ; "Originally on UNIX") + (FULLNAME PDFFILE))))]) +) +(DEFINEQ - (CLOSEF? PSFILE) - (CL:UNLESS DONTDELETE (DELFILE PSFILE)) - (CLOSEF? ERRORFILE) - (CL:WHEN (INFILEP ERRORFILE) - (CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILE 'LENGTH) - (CL:UNLESS DONTDELETE (DELFILE ERRORFILE))) - 0) - (ERROR "Cannot create PDF file for " PDFFILE))) - (CL:WHEN (IGREATERP COMPLETIONCODE 0) - (ERROR "Cannot create PDF file for " PDFFILE)) - PDFFILE]) +(PDF.POSTSCRIPT + [LAMBDA (PSFILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 18-Sep-2025 23:49 by rmk") + + (* ;; "Can't pass OPTIONS, until the MAKEERROFILE flag goes away.") + + (PS-TO-PDF PSFILE IMAGEFILE]) ) (DEFINEQ (SEE-PDF - [LAMBDA (PDFFILE) (* ; "Edited 30-Jul-2025 18:00 by rmk") + [LAMBDA (PDFFILE) (* ; "Edited 19-Jan-2026 14:06 by rmk") + (* ; "Edited 24-Dec-2025 23:32 by rmk") + (* ; "Edited 30-Jul-2025 18:00 by rmk") (* ; "Edited 25-Dec-2024 14:25 by rmk") (* ; "Edited 1-Oct-2023 20:47 by rmk") (* ; "Edited 26-Sep-2023 16:52 by rmk") (* ;; "Use the ShellOpener for this machine to open the PDF file outside of Medley") - (LET [(FOUND (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF] - (if FOUND + (LET (FOUND) + [SETQ FOUND (if (AND (STREAMP PDFFILE) + (PDFFILEP PDFFILE)) + then (UNIX-FILE-NAME PDFFILE 'INPUT 'pdf 'pdf) + else (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF] + (if (NOT FOUND) + then (ERROR "FILE NOT FOUND" PDFFILE) + elseif (PDFFILEP FOUND) then (ShellOpen FOUND) - FOUND - else (ERROR "FILE NOT FOUND" PDFFILE]) + else (ERROR FOUND "is not a PDF file"]) ) (ADDTOVAR FB.SEE.METHODS (PDFFILEP SEE-PDF)) @@ -304,9 +324,18 @@ (CAR (for TEMPLATE in PDF-CONVERTER-TEMPLATES thereis (ShellWhich (CAR TEMPLATE]) ) +(DEFINEQ + +(\PDFINIT + [LAMBDA NIL (* ; "Edited 14-Sep-2025 01:15 by rmk") + (SETQ \PDFIMAGEOPS (create IMAGEOPS using \POSTSCRIPTIMAGEOPS IMAGETYPE _ 'PDF IMCLOSEFN _ + (FUNCTION CLOSE-PDF-STREAM]) +) + +(\PDFINIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3421 6457 (PDFFILEP 3431 . 4345) (PDF.HARDCOPYW 4347 . 4945) (PDF.TEXT 4947 . 5664) ( -PDF.TEDIT 5666 . 6033) (PDF.FONTSAVAILABLE 6035 . 6455)) (6897 14542 (OPEN-PDF-STREAM 6907 . 9628) ( -CLOSE-PDF-STREAM 9630 . 10917) (PS-TO-PDF 10919 . 14540)) (14543 15301 (SEE-PDF 14553 . 15299)) (15352 - 15636 (PDFCONVERTER 15362 . 15634))))) + (FILEMAP (NIL (2498 5822 (PDFFILEP 2508 . 3785) (PDF.HARDCOPYW 3787 . 4639) (PDF.TEDIT 4641 . 5398) ( +PDF.FONTSAVAILABLE 5400 . 5820)) (6262 14970 (OPEN-PDF-STREAM 6272 . 7422) (CLOSE-PDF-STREAM 7424 . +10136) (PS-TO-PDF 10138 . 14968)) (14971 15227 (PDF.POSTSCRIPT 14981 . 15225)) (15228 16499 (SEE-PDF +15238 . 16497)) (16550 16834 (PDFCONVERTER 16560 . 16832)) (16835 17147 (\PDFINIT 16845 . 17145))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index ed13f5a97ab040243ffd46e004dbcb2521f64ebb..631a08f66609130fc52a3267f2937454d8c164e0 100644 GIT binary patch literal 6977 zcmbtZ+jARd6_@N#s0x`F%4IxE=OD-+Whzy>x>{wLtfiH;wY0m|u6!B%fFdciQrj}J zTIf*Tcfn~ngq_nn? z`*3iY(+hfqv}(OjtQRY3%A|+Wle5Y3ctq1vO4A?qx@NOu9{llF$CJmi!R)gS+-A%3 zaY#4+zE-GaDV5f0v6ISmy-+V#)AV>YUK}<4{n_mNew|LI^P|b>M>N6Ft$wFN@vZrM zK24*+99LgIQ>zzB>FjH<@G6qQtyZg0-E3NZZu5X&$632x99j~!+$_76$rBLlEn>P(dd|l-FI^>r`Po!P>VD*-ZMSZ zUkvKRcVsE?+vG|jxpptn`zV1wlehT0|NLF)$)`PflgEzM*VpmyXtch*vp!t8Y(Gu$ z@U!(P|ES$EvX5121s&gi`QnFdI(A>axQn0W%NO6qPwVBqM5bCM$2DzbHdL-cj=pg1 z_o!H+t*ED!=n!4C66&rN$g-LA=xdQf~HPh!|0eTqv1O} z^flVF{I21mSqNEz2;YSu-iSmdVvGc8Y&M$a_ugP>J(4NN3yit!tn7_cER*YazSrnk zt{)>*FU8Fcrq#Et{hZ&0yFgMo78N+vHpuDwY-1aAb`EA9Pv$3sGt7w5D+Mbdu}yzLS^Z z`ApKaCBC$q`2ws*QX#Dpa#}0;+ujSajXY3kQM`DLSkdV*guGwG~k_njj(P$(D zPn0g!l8N@8N68iZk>Q_QuB={s-G*{tI?IRRt|Al$Re`yMri22<1y*7%5S&~e!#QR( z6!=1<8t7RO_xTN5#gG0jJ||9f`AA8UsS}ft6>sO6E*+Z2brA)@osg&5>%l-vOk=~b zcg-HcD(EW}=@3IAddKw$$_e&t@Y393ZO%8lZU<1}VHXQK-58wya!yYsrz0A~n9j|o zVza~P>8In_d^|%?6S#^A;k9D{NQl|nZ2`gcf<-O%M~)h?=m6~=2SGuExFb>&g~~_F z@`~9q==au#chrVx*>EM8*iqqPN2Z=ilxgogJ^8m-IvYr#OpGO)2M`!-0FhJ#kmROT z47)DEL!}zGb?74&NQ%XntLU{G+<>$qah?&ldToP%kXwG6DthP+P-zfhigY%5f{cWQ z$J6sM+N??d^X*ZEs*A~{*%9BoDfV2~@c$EpV(MHDM9nLK=tcFBDDzR=57f{rqEY2~ z*nk|uXoSFYv&9yxY66iLQj|5}J=aAAI%Db{38YC=ZMnSdRouz&Q*6 zujwx(*c_bHWH@O!O^*6S<@lmGP6=={n@V320t5>5gE@pNPfgvPdkJZ>zC{3EFKAY& zYiyf>Fg%i_WbIq4iR5nNIMRCg*IiN9vmfj#oQ+)XNM&kkYsvoAO<(q9(-*OcgSF(! z-rc`h7pt+sKZ&!ht=*9W+UxT3VQ{eOZHGO0@p=qhg$}tzK8K^HUq2u2-F@zDOaJ+{ z`n}waXv2!KTsV=V)* zG5A7cjQ}g;oDI|S5DU6p!*1er0o#X#8NTFh8gBRcn`k2}h=nbJ268L_a>wx6NH8>x zEn&N`aTA!;ZiKjMC1Sb)xC3Eqs4dIvG^w<)IJ6X#6g>5ME<}0+mYh^Bodl25D+Rir zCcUJ7kWU3*ssW_oDK|w!(n_V6k7-C;L!Z)cUEm{Hp+w`^Y&s*zlR>zmIHhup+Q=8E zsB>zDyn?Al=E;MM&U$r2A}!vPG@Om`cI4v`b&tpN1jm6|#D%ms9tY>k%wUcQ4X35w z8;w7G@AQ-7V?^O7pA2%4|Ne!bFMGOVg(16=@rIDF4BYzw?$wyXEu}MJ_WuyiP}%RL zg7C))L#7_DyaLQ?*TEbn6M}g)mPjicEhDk-^F@=IFrftV3BbGafMM87PuHwVjQYsn_PT3+Jvk`oP1dL4qg@@obTtcfH47iEpiFI%%$T@*c4Ew>eB%89W4#%mWXb{GHIF{1~PRKDTzTli+ zbBc|Zxl-=)p9a5gtA~T&=Sb40FCHCf;6}WN!v(!@krXU{B~~fFhmBdd@y=Ju{r`9cah$!DD5&_ z;5h|XM&y?Kirp37orV@zH^_+tM@@4MNag|`!zL1X1|nBWY%M7FB*=}Hw>Gd6zr<9@t(4u4>*rP#PsA1?Bo89V;N5wn*=(Zl*f1%x(??Y>pebla zPis`XgxU8g%?yEU=G!_sJ072mPv?XA1l8T?6W&heb41RQb6&TkhJ|esfGju|jZz zuGS2$*>;4%3)#oeJ~(Dk%gsQj%Jx#N%{+$lUDIznO*Vi~Y2o6SHW%au=Y{TzF0{7j zaqUrg02}`|d4Y1Dhhiy99uQgevIE36ESY=E!Is8B2w3$UFe`cP!d4Zhl#x1M$TRp@ z;J!$Lc~?wxjSxc%a}%46x+z|%3Vl-ki_w#h4KEf6_Oq;Gej#2a6G6o=UPx5+#T20~ zZt!bPRU#qjIEUB#ly9I+tbTCCjzEvdSN?+}PIEMhCE|{;dKr_=3!)(`Qqar7M`eQ! zm%4e^YXn!B`;0RWDF$(JRxrNI&rSFuEag#DwT<3^7~21W6>&QXi(lgNaeKMNsWX9B ur;$H~6LMu1r?rpo`dVRHzrXuf?9PB?c;#@WW literal 5935 zcmds5O>Z056{Tb(X_-2(3bZM_FfImgL$)Qu8B!F<6cLA zB0Kq3Ev_T2l1-H&t6y^k5o zZaJ=) zwndsz%$YBq<&1){jp5pMu~w{Vl+lhRr_=Gta6pqY(&&pPUEAu|2VegDWPCX5&t87& zTdgp{Cf)oeJB2KzHNBG9$f)V%TA`rP;cU3vY51Gz?EGPkur%ND+$c03n@&eW9pjKz zuhXIAF8O?3qd|WTA=YkR)v|9_rubIjN#8DSSE*)OPLyjL(CqYcsx{lDyJv^F$fHcU z<%Vm7&Qi?}?8lDR3v(8XNm{Xx`^Afs*p`)AL9Z1`Z#lkP$);fsc8O0ltCG$*R3PqV zDHWwssg3$GJX2|YO!y&Pd3=w%7sdK_`Tgpr_2)9FPA3nqUi|CrWi6s{3ISb$xQM zG;$)K*r5`2`e%dlqyBWbi*Atudk-6;X;9cSJ9f)#MqYrvP7NpOn!Fr4DYL?kKif#9 z-d)*ET6MAB)<&vrHky`w_gyw(T`UOulynFJ=jX5q6}QRv!YFJ8jvpmthL%ZlKta7k z4bM8DDnSQ7gyc!}mCg}9Ej(Q!L~1BHwGp;3rYI%BA?n0Bh(2s~YO!J~VZaGyuM_2c z&_HaJ7Oaq%!N>8+e8+SxSj%T%eU#cvy;C>E5YS%UzC0g|uJC^!e|O(wi@+AeGVvyn z=X7xj@5LT3P~b&o#D0L*@!4fIIz|_oBBEBFjTEZZ>IIoJIB8R18D6QIzm?Gh|2h>B>W-9Vd)rIx!59dyaIp1MxM{s zWppeF;V&y2$?*bLX*_bESq_*WSc z3tvi8#%{FkzQc3XDQpKhS01DL@AHuQQdey@Nx8IOlECv3{0LV`8NPI39X7-YtFi7n z{Mz)~rWujW&;oA3JtcC4WUEE8g8_Psh0|5wjhm+P(}QoTgsS= z?5^KIssJ-UlwRcbBIZh0GGBq(2y7e%wX3A%r{@~fA-Owj>l&M>L<{an@@znjwWZn8qVg!nMP%un1N~DpFJD$l9M5w zP0*OUI2$0LzM<0+oC)QHUPEPJgi20AML|KluV6QlHbdpl3Xkm=p}+6SxJ1{AxMR^l7#{2n#{pHIWfO;*fJhGKG-4s{EgMrf--y@Z zAx=o#%+kh#%~a}+QbZ!XjRVpsQqQAWV>`oCs8?Y{9ifQXo*28o-td zJD~95+L)>6O=dDsqoEwzi`vjmNNO$L=-Wxi>nbye2Xx(tF;3M=T)q@(IGasoOf5*F zs(z!LZ8f@6AP^6g6SW;7oT0|LlbO$qvZ5&FnWNbd6+O>Z+;fa$G^BDvNbL3*s8KbO z&Zonp@$ncpf>qjhgXHL_f5saf4r5kJlTjkg^`NH^J)x?PF#yI3ZQ<}$q0;htNIBO_ z$RDd}Kw!V5wTlm=A6JbM1zZY%&BD>}d* z_cuP|?!AqJ4Vm+M=i=Yvum9EF-2eKYsSKxS7XQg;d^AE3Qui}6^16r>)c?+Y4&iFM zkKtE@@pbIp4nKrL0_BVem_t){O3qMA&G<@(TU8VtFlXa>5%EfuY48Q6$^^do=+X7B zl#xqqNSW{;?0BY?P2gjZrZT*qGC!eDNNZ0fpVRnkKA};6HaMD0Uvh6aJMJG1wJffD zre!@g156hgP+=VS$l4k41!bD1t7KEY!LcZXd!dj3R&#xWB@R}=u^oH~Z6Im|S?=;F z>b4?xn8av4@fovJPjJDL!)NU#t%=j5WfJl##m{TKwI| zq$M7`ZDb%O?-wf=_*wN-R-3;Z&}l)$bBX zW30YnO8R<@EmBd4o(|9E{rMQb@=T8TOgf)~p-<0wn&UcA z90iFGC1xvDTq3F4KcZic=OcPHnw-zik7ncPe3ut5EQdYUn{QNbhe+PMiHx2{S`^7crTYU;m7sE29* diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM index f088d9fe..ba48c99a 100644 --- a/library/POSTSCRIPTSTREAM +++ b/library/POSTSCRIPTSTREAM @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Oct-2025 18:05:08" {WMEDLEY}POSTSCRIPTSTREAM.;55 260304 +(FILECREATED "19-Jan-2026 17:04:42" {WMEDLEY}POSTSCRIPTSTREAM.;64 258252 :EDIT-BY rmk - :CHANGES-TO (FNS POSTSCRIPT.FONTCREATE) + :CHANGES-TO (FNS OPENPOSTSCRIPTSTREAM) + (VARS POSTSCRIPTSTREAMCOMS) - :PREVIOUS-DATE " 9-Oct-2025 21:16:27" {WMEDLEY}POSTSCRIPTSTREAM.;53) + :PREVIOUS-DATE "31-Dec-2025 22:38:51" {WMEDLEY}POSTSCRIPTSTREAM.;62) (PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS) @@ -45,7 +46,7 @@ POSTSCRIPT.FONTSAVAILABLE POSTSCRIPT.FONTEXISTS?) (FNS OPENPOSTSCRIPTSTREAM CLOSEPOSTSCRIPTSTREAM) (INITVARS (*POSTSCRIPT-FILE-TYPE* 'BINARY)) - (FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPT.TEXT POSTSCRIPTFILEP MAKEEPSFILE) + (FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPTFILEP MAKEEPSFILE) (FNS POSTSCRIPT.BITMAPSCALE POSTSCRIPT.CLOSESTRING POSTSCRIPT.ENDPAGE POSTSCRIPT.OUTSTR POSTSCRIPT.PUTBITMAPBYTES POSTSCRIPT.PUTCOMMAND POSTSCRIPT.SET-FAKE-LANDSCAPE POSTSCRIPT.SHOWACCUM POSTSCRIPT.STARTPAGE \POSTSCRIPTTAB \PS.BOUTFIXP \PS.SCALEHACK @@ -154,17 +155,9 @@ (OPTIMA (PALATINO 1)) (TITAN (COURIER 1)) (* (* 1] + (POSTSCRIPTCHARCOERCIONS NIL) (\POSTSCRIPT.MAX.WILD.FONTSIZE 72)) - [COMS (FNS POSTSCRIPTSEND) - (ADDVARS (PRINTERTYPES ((POSTSCRIPT) - (CANPRINT (POSTSCRIPT)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR - REGION ROTATION TITLE] - [ADDVARS (POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) + (ADDVARS (POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) (HELVETICAD . HELVETICA) (TIMESROMAN . TIMES) (TIMESROMAND . TIMES) @@ -176,15 +169,9 @@ (TERMINAL . COURIER) (LOGO . HELVETICA) (OPTIMA . PALATINO) - (TITAN . COURIER)) - [PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) - (EXTENSION (PS PSC PSF)) - (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT TEDIT.TO.IMAGEFILE] - (IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) - (FONTCREATE POSTSCRIPT.FONTCREATE) - (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC) - (FONTEXISTS? POSTSCRIPT.FONTEXISTS?] + (TITAN . COURIER))) + (ALISTS (PRINTFILETYPES POSTSCRIPT) + (IMAGESTREAMTYPES POSTSCRIPT)) (INITVARS (POSTSCRIPT.PAGETYPE 'LETTER)) (* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk") @@ -389,7 +376,8 @@ (DEFINEQ (POSTSCRIPT.INIT - [LAMBDA NIL (* ; "Edited 9-Sep-2025 21:57 by rmk") + [LAMBDA NIL (* ; "Edited 31-Dec-2025 22:38 by rmk") + (* ; "Edited 9-Sep-2025 21:57 by rmk") (* ; "Edited 22-Aug-2025 21:34 by rmk") (* ; "Edited 14-May-2018 10:48 by rmk:") (* ; "Edited 4-Feb-93 21:08 by jds") @@ -436,7 +424,7 @@ (* ;; "Eliminate any existing postscript fonts, to start with a clean slate if reinitializing.") - (FLUSHFONTSINCORE '* '* '* '* 'POSTSCRIPT) + (FLUSHFONTCACHE NIL '* '* '* '* 'POSTSCRIPT) (SETQ POSTSCRIPTFONTCACHE NIL) (SETQ \POSTSCRIPT.CHARTYPE (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT T)) @@ -1127,13 +1115,14 @@ NEWWIDTHS)]) (POSTSCRIPT.FONTSAVAILABLE - [LAMBDA (FONTSPEC) (* ; "Edited 25-Aug-2025 13:09 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 17-Dec-2025 20:55 by rmk") + (* ; "Edited 25-Aug-2025 13:09 by rmk") (* ; "Edited 23-Aug-2025 08:19 by rmk") (* ;; "Postscript only has font files of size 1, and only files for %"raw%" postscript families that Medley font families are mapped to by POSTSCRIPTFONTCOERCIONS. Therefore the search doesn't care about the given family, just looks at the corresponding raw files that exist in the directory. ") (LET [(SIZE (fetch (FONTSPEC FSSIZE) of FONTSPEC)) - (FONTSAVAILABLE (\SEARCHFONTFILES (CAR (COERCEFONTSPEC FONTSPEC] + (FONTSAVAILABLE (\SEARCHFONTFILES (COERCEFONTSPEC FONTSPEC] (* ;; "Switch from postscript family names back to the corresponding Medley names.") @@ -1186,7 +1175,8 @@ (DEFINEQ (OPENPOSTSCRIPTSTREAM - [LAMBDA (FILE OPTIONS) (* ; "Edited 19-Sep-2025 16:02 by rmk") + [LAMBDA (FILE OPTIONS) (* ; "Edited 19-Jan-2026 17:04 by rmk") + (* ; "Edited 19-Sep-2025 16:02 by rmk") (* ; "Edited 14-Sep-2025 12:50 by rmk") (* ; "Edited 12-Jun-2021 19:14 by rmk:") (* ; @@ -1278,7 +1268,8 @@ (* ;; "If a REGION parameter was supplied, it establishes the initial margins.") - (SETQ REG (OR (AND (SETQ REG (LISTGET OPTIONS 'REGION)) + (SETQ REG (OR (AND (SETQ REG (OR (LISTGET OPTIONS 'REGION) + POSTSCRIPT.DEFAULT.PAGEREGION)) (INTERSECTREGIONS REG CLIP)) (CREATEREGION 3600 3600 54000 72000))) (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with (fetch (REGION LEFT) @@ -1399,14 +1390,6 @@ (TEDIT.TO.IMAGESTREAM FILE IMAGESTREAM]) -(POSTSCRIPT.TEXT - [LAMBDA (FILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 17-Sep-2025 23:21 by rmk") - (* ; "Edited 23-Apr-89 11:31 by TAL") - (TEXTTOIMAGEFILE FILE IMAGEFILE IMAGETYPE `(,@OPTIONS REGION ,POSTSCRIPT.DEFAULT.PAGEREGION - ROTATION ,(NOT (NOT - POSTSCRIPT.TEXTFILE.LANDSCAPE - ]) - (POSTSCRIPTFILEP [LAMBDA (FILE) (* ; "Edited 9-Oct-2025 21:16 by rmk") (* ; "Edited 18-Sep-2025 09:35 by rmk") @@ -1432,7 +1415,8 @@ (CHARCODE !])]) (MAKEEPSFILE - [LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 16-Sep-2025 00:29 by rmk") + [LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 7-Dec-2025 16:37 by rmk") + (* ; "Edited 16-Sep-2025 00:29 by rmk") (* ; "Edited 7-Apr-94 14:48 by rmk:") (* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file. The lower-left corner of the image box will be at 0,0 on the page.") @@ -1441,7 +1425,7 @@ (LET ([IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN) IMAGEOBJ - (OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT] + (OPENIMAGESTREAM NIL 'POSTSCRIPT] STREAM) [SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT `(BOUNDINGBOX (0 0 ,(FETCH XSIZE OF IMAGEBOX) @@ -4335,28 +4319,9 @@ (TITAN (COURIER 1)) (* (* 1)))) +(RPAQ? POSTSCRIPTCHARCOERCIONS NIL) + (RPAQ? \POSTSCRIPT.MAX.WILD.FONTSIZE 72) -(DEFINEQ - -(POSTSCRIPTSEND - [LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 20-Nov-95 11:29 by ") - (* ; "Edited 20-Nov-95 11:26 by ") - - (* ;; "This is the send function for generic POSTSCRIPT printers. It branches on the architecture-specific function. The theory is that the send method is really a property of the operating system, not a property of specific postscript printers. These functions are contained in separate library files (or defined by user).") - - (SELECTQ (MKATOM (UNIX-GETPARM "ARCH")) - (dos (DOSPRINT HOST FILE PRINTOPTIONS)) - (UnixPrint HOST FILE PRINTOPTIONS]) -) - -(ADDTOVAR PRINTERTYPES ((POSTSCRIPT) - (CANPRINT (POSTSCRIPT)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION - TITLE)))) (ADDTOVAR POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) (HELVETICAD . HELVETICA) @@ -4373,8 +4338,10 @@ (TITAN . COURIER)) (ADDTOVAR PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) - (EXTENSION (PS PSC PSF)) - (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT TEDIT.TO.IMAGEFILE)))) + (EXTENSION (PS PSC PSF POSTSCRIPT)) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (POSTSCRIPT.HARDCOPYW IMAGEFILE BITMAP SCALEFACTOR REGION + ROTATION TITLE)))) (ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) (FONTCREATE POSTSCRIPT.FONTCREATE) @@ -4424,39 +4391,37 @@ (ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (23388 33596 (POSTSCRIPT.INIT 23398 . 30202) (POSTSCRIPT.PUTRGBCOLOR 30204 . 31226) ( -\PSC.COLOR.TO.RGB 31228 . 33594)) (34582 69900 (PSCFONT.READFONT 34592 . 36500) (PSCFONT.SPELLFILE -36502 . 37315) (PSCFONT.COERCEFILE 37317 . 38889) (PSCFONTFROMCACHE.SPELLFILE 38891 . 39876) ( -PSCFONTFROMCACHE.COERCEFILE 39878 . 41530) (PSCFONT.WRITEFONT 41532 . 42547) (READ-AFM-FILE 42549 . -48420) (CONVERT-AFM-FILES 48422 . 49634) (POSTSCRIPT.GETFONTID 49636 . 51031) (POSTSCRIPT.FONTCREATE -51033 . 63927) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63929 . 66326) (POSTSCRIPT.FONTSAVAILABLE 66328 - . 68511) (POSTSCRIPT.FONTEXISTS? 68513 . 69898)) (69901 79624 (OPENPOSTSCRIPTSTREAM 69911 . 79290) ( -CLOSEPOSTSCRIPTSTREAM 79292 . 79622)) (79669 86491 (POSTSCRIPT.HARDCOPYW 79679 . 82786) ( -POSTSCRIPT.TEDIT 82788 . 83240) (POSTSCRIPT.TEXT 83242 . 83829) (POSTSCRIPTFILEP 83831 . 85319) ( -MAKEEPSFILE 85321 . 86489)) (86492 130066 (POSTSCRIPT.BITMAPSCALE 86502 . 88958) ( -POSTSCRIPT.CLOSESTRING 88960 . 89513) (POSTSCRIPT.ENDPAGE 89515 . 90406) (POSTSCRIPT.OUTSTR 90408 . -91625) (POSTSCRIPT.PUTBITMAPBYTES 91627 . 100098) (POSTSCRIPT.PUTCOMMAND 100100 . 101089) ( -POSTSCRIPT.SET-FAKE-LANDSCAPE 101091 . 105611) (POSTSCRIPT.SHOWACCUM 105613 . 107768) ( -POSTSCRIPT.STARTPAGE 107770 . 110302) (\POSTSCRIPTTAB 110304 . 111101) (\PS.BOUTFIXP 111103 . 112383) -(\PS.SCALEHACK 112385 . 115028) (\PS.SCALEREGION 115030 . 115590) (\SCALEDBITBLT.PSC 115592 . 119902) -(\SETPOS.PSC 119904 . 120385) (\SETXFORM.PSC 120387 . 122971) (\STRINGWIDTH.PSC 122973 . 123446) ( -\SWITCHFONTS.PSC 123448 . 128940) (\TERPRI.PSC 128942 . 130064)) (130101 183957 (\BITBLT.PSC 130111 . -130663) (\BLTSHADE.PSC 130665 . 135326) (\CHARWIDTH.PSC 135328 . 135835) (\CREATECHARSET.PSC 135837 . -137193) (\DRAWARC.PSC 137195 . 139573) (\DRAWCIRCLE.PSC 139575 . 141826) (\DRAWCURVE.PSC 141828 . -145672) (\DRAWELLIPSE.PSC 145674 . 148038) (\DRAWLINE.PSC 148040 . 150780) (\DRAWPOINT.PSC 150782 . -151358) (\DRAWPOLYGON.PSC 151360 . 154489) (\DSPBOTTOMMARGIN.PSC 154491 . 155178) ( -\DSPCLIPPINGREGION.PSC 155180 . 156555) (\DSPCOLOR.PSC 156557 . 157488) (\DSPFONT.PSC 157490 . 161127) - (\DSPLEFTMARGIN.PSC 161129 . 161815) (\DSPLINEFEED.PSC 161817 . 162407) (\DSPPUSHSTATE.PSC 162409 . -163869) (\DSPPOPSTATE.PSC 163871 . 167356) (\DSPRESET.PSC 167358 . 168023) (\DSPRIGHTMARGIN.PSC 168025 - . 168714) (\DSPROTATE.PSC 168716 . 169715) (\DSPSCALE.PSC 169717 . 170669) (\DSPSCALE2.PSC 170671 . -171511) (\DSPSPACEFACTOR.PSC 171513 . 172434) (\DSPTOPMARGIN.PSC 172436 . 173007) (\DSPTRANSLATE.PSC -173009 . 175040) (\DSPXPOSITION.PSC 175042 . 175606) (\DSPYPOSITION.PSC 175608 . 176199) ( -\FILLCIRCLE.PSC 176201 . 178426) (\FILLPOLYGON.PSC 178428 . 181665) (\FIXLINELENGTH.PSC 181667 . -182986) (\MOVETO.PSC 182988 . 183758) (\NEWPAGE.PSC 183760 . 183955)) (184013 206159 ( -\POSTSCRIPT.CHANGECHARSET 184023 . 184741) (\POSTSCRIPT.OUTCHARFN 184743 . 197013) ( -\POSTSCRIPT.PRINTSLUG 197015 . 198739) (\POSTSCRIPT.SPECIALOUTCHARFN 198741 . 201092) (\UPDATE.PSC -201094 . 202340) (\POSTSCRIPT.ACCENTFN 202342 . 203284) (\POSTSCRIPT.ACCENTPAIR 203286 . 206157)) ( -206257 207902 (\PSC.SPACEDISP 206267 . 206546) (\PSC.SPACEWID 206548 . 207167) (\PSC.SYMBOLS 207169 . -207900)) (208011 211002 (\POSTSCRIPT.NSHASH 208021 . 211000)) (256412 257118 (POSTSCRIPTSEND 256422 . -257116))))) + (FILEMAP (NIL (22369 32688 (POSTSCRIPT.INIT 22379 . 29294) (POSTSCRIPT.PUTRGBCOLOR 29296 . 30318) ( +\PSC.COLOR.TO.RGB 30320 . 32686)) (33674 69096 (PSCFONT.READFONT 33684 . 35592) (PSCFONT.SPELLFILE +35594 . 36407) (PSCFONT.COERCEFILE 36409 . 37981) (PSCFONTFROMCACHE.SPELLFILE 37983 . 38968) ( +PSCFONTFROMCACHE.COERCEFILE 38970 . 40622) (PSCFONT.WRITEFONT 40624 . 41639) (READ-AFM-FILE 41641 . +47512) (CONVERT-AFM-FILES 47514 . 48726) (POSTSCRIPT.GETFONTID 48728 . 50123) (POSTSCRIPT.FONTCREATE +50125 . 63019) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63021 . 65418) (POSTSCRIPT.FONTSAVAILABLE 65420 + . 67707) (POSTSCRIPT.FONTEXISTS? 67709 . 69094)) (69097 79006 (OPENPOSTSCRIPTSTREAM 69107 . 78672) ( +CLOSEPOSTSCRIPTSTREAM 78674 . 79004)) (79051 85377 (POSTSCRIPT.HARDCOPYW 79061 . 82168) ( +POSTSCRIPT.TEDIT 82170 . 82622) (POSTSCRIPTFILEP 82624 . 84112) (MAKEEPSFILE 84114 . 85375)) (85378 +128952 (POSTSCRIPT.BITMAPSCALE 85388 . 87844) (POSTSCRIPT.CLOSESTRING 87846 . 88399) ( +POSTSCRIPT.ENDPAGE 88401 . 89292) (POSTSCRIPT.OUTSTR 89294 . 90511) (POSTSCRIPT.PUTBITMAPBYTES 90513 + . 98984) (POSTSCRIPT.PUTCOMMAND 98986 . 99975) (POSTSCRIPT.SET-FAKE-LANDSCAPE 99977 . 104497) ( +POSTSCRIPT.SHOWACCUM 104499 . 106654) (POSTSCRIPT.STARTPAGE 106656 . 109188) (\POSTSCRIPTTAB 109190 . +109987) (\PS.BOUTFIXP 109989 . 111269) (\PS.SCALEHACK 111271 . 113914) (\PS.SCALEREGION 113916 . +114476) (\SCALEDBITBLT.PSC 114478 . 118788) (\SETPOS.PSC 118790 . 119271) (\SETXFORM.PSC 119273 . +121857) (\STRINGWIDTH.PSC 121859 . 122332) (\SWITCHFONTS.PSC 122334 . 127826) (\TERPRI.PSC 127828 . +128950)) (128987 182843 (\BITBLT.PSC 128997 . 129549) (\BLTSHADE.PSC 129551 . 134212) (\CHARWIDTH.PSC +134214 . 134721) (\CREATECHARSET.PSC 134723 . 136079) (\DRAWARC.PSC 136081 . 138459) (\DRAWCIRCLE.PSC +138461 . 140712) (\DRAWCURVE.PSC 140714 . 144558) (\DRAWELLIPSE.PSC 144560 . 146924) (\DRAWLINE.PSC +146926 . 149666) (\DRAWPOINT.PSC 149668 . 150244) (\DRAWPOLYGON.PSC 150246 . 153375) ( +\DSPBOTTOMMARGIN.PSC 153377 . 154064) (\DSPCLIPPINGREGION.PSC 154066 . 155441) (\DSPCOLOR.PSC 155443 + . 156374) (\DSPFONT.PSC 156376 . 160013) (\DSPLEFTMARGIN.PSC 160015 . 160701) (\DSPLINEFEED.PSC +160703 . 161293) (\DSPPUSHSTATE.PSC 161295 . 162755) (\DSPPOPSTATE.PSC 162757 . 166242) (\DSPRESET.PSC + 166244 . 166909) (\DSPRIGHTMARGIN.PSC 166911 . 167600) (\DSPROTATE.PSC 167602 . 168601) ( +\DSPSCALE.PSC 168603 . 169555) (\DSPSCALE2.PSC 169557 . 170397) (\DSPSPACEFACTOR.PSC 170399 . 171320) +(\DSPTOPMARGIN.PSC 171322 . 171893) (\DSPTRANSLATE.PSC 171895 . 173926) (\DSPXPOSITION.PSC 173928 . +174492) (\DSPYPOSITION.PSC 174494 . 175085) (\FILLCIRCLE.PSC 175087 . 177312) (\FILLPOLYGON.PSC 177314 + . 180551) (\FIXLINELENGTH.PSC 180553 . 181872) (\MOVETO.PSC 181874 . 182644) (\NEWPAGE.PSC 182646 . +182841)) (182899 205045 (\POSTSCRIPT.CHANGECHARSET 182909 . 183627) (\POSTSCRIPT.OUTCHARFN 183629 . +195899) (\POSTSCRIPT.PRINTSLUG 195901 . 197625) (\POSTSCRIPT.SPECIALOUTCHARFN 197627 . 199978) ( +\UPDATE.PSC 199980 . 201226) (\POSTSCRIPT.ACCENTFN 201228 . 202170) (\POSTSCRIPT.ACCENTPAIR 202172 . +205043)) (205143 206788 (\PSC.SPACEDISP 205153 . 205432) (\PSC.SPACEWID 205434 . 206053) (\PSC.SYMBOLS + 206055 . 206786)) (206897 209888 (\POSTSCRIPT.NSHASH 206907 . 209886))))) STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM index c29c0a4f8d6206384b20eb5c414ee83b57a27b2a..fe8dc3ce06d799585949e4c785552eab59573527 100644 GIT binary patch delta 2565 zcmaJ@OKjX!6wR9?4VkpGO-a&%+FsI98lA9 z?8MV6OHVD#!@_ebCr{l|0=8leJ-oCGqm_o|L1)^;#Kb7f&z;8LjqeljgQH``gB91K zc0{d&Ixs5!2PI~a1O1u;l4?k*#8wEf@WDI!#^B(j6~*l9pN9`XDU9f(8#Ll^2VaC= zlf`jo;TW$?1xYH&MoAU(rT=D0_*GTtQdW9GMO(m6)z3peslr4VpG_t0`!1a?XP!!U@B(nV2TT2(j6pezlH)^H?t7)Ey6o!pErXhb=U}Y|ph*JTQXE;$2$zE-3F>t#s=E1i1SzX82s=>KMCu8R!pKe8 zs0Q*z4eh`Sq72cIG$OHWc~r_EjZ@B{3{jD(D#$m@amsFjeazxy)cuxc z6dgC?n&sqq67uI7*=}TeIVN)I*e&W|^>Gdg$ee>6fr_c*t+5-?WEQ6woIl2SuAd`% zMxO%}N}ZIMqUDOa)mqXakfLU~d$e*3tndRAhkQV?d<8412a^<%AOqyA5i{5#H*xcB zE0V;n3=G{T2uf#9Wm7-9d1$W=cuIMbXdHu#^U}@(Sv7Gkhwqh9 z@DiUY*Yd`xN9)v2Kt>Xsv69?+X7k9z?H6zB>LP~=pHN*2^>kSp!~` zgRW%LFbcT8uw(ZhAX@Y90@>TA32-0CV(X*(-`>Q|gu6$e0-^>Etym2&;i+TL{nnPA z)+6QfgamA>^J>qIInSa2_S3lkf>4Q_Ne`VN0w1R&0CdeDq<*@acR*5Ee`B9+=-{|<=vgzUy`n-nX!u-) zaxjgP)Y%EC^QrZGqj|RV>Cf-=^zkb^gd%(4*O>Mj?2|hR2(ErL#AdFQ zc5L*qB76T@Fg)tGRXDM-aB}YS(uw6$B^bq_T_at z$hU4Wq$1mYBiVYZ%@)~fH>NqWA8#z+PpkIZxq&_HKJY8Z4rpYjrxx#Fq|^MTK=y3Y zr7>Jvj>G@&K#t9C7RhV@e-9le-#o;(JQpu>IEeRvpKwu%_FsBu IiA)y$1@hpx%K!iX delta 3356 zcmbtWTWlOx8Q$@Q)Z?U1>coz%*7>zbt2M~WTy}07Xgr=d>z!n7otgDTa#14hHdqwf za*R}wMpjY815bogw1@|!3SJN*QMIB)JaBsgA%x(e6|YDLiCmgK6p$zl|2ebvu0!5f zOXG9?bN+Mw|NH*SdH)Z?|9F4+n=9k$T(rJBr$~whvRRe1s$|~!l3v!dSrCh|+_$P$ zC8a9MMc8SrZ+&@tAa?L0k@3R6l&hZy7v*pgB)*ihv|jed3Trtn7R(cpqGcC~=NX0yrv z9~MurHChu3Xij z<~P!MEef;L3!NyTe?780Egd?~!Beu;nBa*99n&W@q@?dYFR&L$6sKUy2815MY)WQ6 zFf40-Akkkub=s4=Q$y(vbQRVD;x3mL{EXcLhK9~?$x2kKr6dERg4c1$>b^wPDU6)l zGhoe4;~4EvGX%LDrw$mhiPFSgjw3J3a*<^5jag!cseiChLN8H0i4JsiOU`xe#NnE{ zslXaDYuR(NdM+~1;xtRVaPe55RIkuqj+`u^rTN|d>S7e;3dkzIhoCdL1Y!JmWV&QR zk2KKb+{iSx9a6KMEK2gtvP54LPj52I(m0Faz)lvu{AkTW^D>geiO2V9CfbI(oXGEL zYX+i;lGL$%qU4)&W@J~COEk1FB+D`Km+ZYyoD;0~`$7GFUDc@W%nSm(sy|61Wa{HK|Mu^LAuIOD5 zy~TRghd@QkW56f1L*j}FK68@Ab$)<~rU%gy$)fH&XMYtb@G`H= z%2oUMQY{@`9~#^bewH6+UkBCH0mF__Lednc@*y3~q`}eC&l^znLcG=X=ZH@N5@w*P z(xIJ-()q^G$@17cPZbKn{D3e&!t!3AcdB=uGaw+r0!ctMfH~-5p>YTXGAkbR`uP_G zgTDOe%n@CNPlKv-eslhNpE}`UP&NFF?Vp9gZyy`%e0SlFAY7ss-JA4J?pK5vS|{nq zPr~Kt_kRBNCqJe?Aa4pPz5V-%NlQYI$qITE+I}rc0y_g!Gw9yEGka!5LTkbX=Dfj* z%Oc5Yn8O-3EU%nkNQi2>>|uiQI>QOjtvoUh7}8CvUx~$buAh)a331B`{6QNMZ+InukkQ)ZkU67J_LUqQb<4{at-}4C^c}0PF@+)!M%@g_%)P(ZNnH zfvHIJt&g7DGi3$3_@SS@v0?RT8z#n_9lDrmSSk$zG3%u__5d3TSq19EcCmCYufb5Y z!*iBikLzF$80{({kOuu@XPgyn)K5WYmGLnJUBMiCT!tC>;d|qP)S0upDR`g&4{KiYJ&^MmYlXNb0Uy*rYHwZ^W|n55Fk27`L-Y26 z!+TQ9zn59Ke(@pxP2*2wv!m>DyimfT!Y^w zKu-B==ZzQ!r*?)4g@Ji~6F>WeP{?QWo%FIL%NUALN@{>fnrG<3MV=p~26+(x-9m>+ z$XC0;qgXV`&IZ^7TrZ7%dlkc`V!=Yx2pMM!(F!1gJ#0ZaG{XXZJ&ar|gi%6nU@x{Y z_Bubz+TYsi>7?l4KI95u;SRB+@8d4#*fNmo*v>h$g~H$#1CHlE|8TD#eg^>`Wedj- z1{~VP=EiIB&c^00U^KZA_BSt-Gxn+oF4crsI9mGG-Y<2sFMI3L<^`XD3$TPT(I!P{-uU9uBg z<*X3??Sg_#<9!dE-hpjW><7W?ax|bp_ zft|N!u|3oh&R^gOk&A)*lRpN!@!!h`G4nE?%<^BK@$~liMEl0NpiJO~fTT$j*ddgG zPtXo}{NtJ+wnv-7v+Yt-sN;AW$D>ZvNIa4-SK4nig%_`g_@ZMEsyMANp%aBmBuQDF zEb+S0b3YFgd?I@pW;TAy*kliqn;8hDzC2@P1#uPIv?W;VwcP$oOL&G#caOIRUlF9E zthSLA51+FafXa6#huHxl{p`Oc+ONJMobELK^XnGbfwt$1lsiem31M2(f>C&T#ec1yTA@Lvsu BeSQD{ diff --git a/library/UNIXPRINT b/library/UNIXPRINT index ef61abe4..c637e5cb 100644 --- a/library/UNIXPRINT +++ b/library/UNIXPRINT @@ -1,33 +1,26 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Jan-2023 22:44:05" {DSK}frank>il>medley>gmedley>library>UNIXPRINT.;4 13651 +(FILECREATED "25-Jan-2026 11:09:09" {WMEDLEY}UNIXPRINT.;15 11553 - :CHANGES-TO (VARS UNIXPRINTCOMS) + :EDIT-BY rmk - :PREVIOUS-DATE "18-Jan-2023 13:28:36" {DSK}frank>il>medley>gmedley>library>UNIXPRINT.;3 -) + :CHANGES-TO (FNS UnixPrint) + :PREVIOUS-DATE "18-Jan-2026 08:44:40" {WMEDLEY}UNIXPRINT.;14) -(* ; " -Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue. -") (PRETTYCOMPRINT UNIXPRINTCOMS) (RPAQQ UNIXPRINTCOMS [(FILES UNIXUTILS) - (FNS InstallUnixPrinter UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand) + (FNS UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand) + (ALISTS (PRINTERTYPES (UNIX))) (INITVARS (UnixPrinterName NIL) (UNIXPRINTSWITCHES " -r -s ")) - (P - (* ;; - "(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform") - - (PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW)) + (P (PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW)) (PROP FILETYPE UNIXPRINT) - (DECLARE%: DONTEVAL@COMPILE DOCOPY (FNS UnixPrintCommand)) - (DECLARE%: EVAL@COMPILE DOCOPY (FILES UNIXCOMM)) - (DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS UnixPrinterName)) + (GLOBALVARS UnixPrinterName) + (DECLARE%: EVAL@COMPILE (FILES UNIXCOMM)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) @@ -35,39 +28,33 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue. (FILESLOAD UNIXUTILS) (DEFINEQ -(InstallUnixPrinter - [LAMBDA (PrinterTypes) (* ; "Edited 8-Feb-97 11:33 by rmk:") - - (* ;; "Set up any printers in PrinterTypes (or just Postscript by default) so that they'll be printed using the unix LPR command.") - - (DECLARE (GLOBALVARS PRINTERTYPES)) - (for type inside (OR PrinterTypes '(POSTSCRIPT)) - do (for x in PRINTERTYPES when (EQMEMB type (CAR x)) - do (LET ((PRINTERTYPE type)) - (PUTASSOC 'SEND (LIST 'UnixPrint) - (CDR x]) - (UnixPrint - [LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 7-Dec-2001 14:55 by rmk:") + [LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 25-Jan-2026 11:08 by rmk") + (* ; "Edited 17-Jan-2026 15:47 by rmk") + (* ; "Edited 5-Dec-2025 11:46 by rmk") + (* ; "Edited 13-Sep-2025 20:28 by rmk") + (* ; "Edited 11-Sep-2025 20:48 by rmk") + (* ; "Edited 7-Dec-2001 14:55 by rmk:") (* ; "Edited 20-May-92 14:13 by nilsson") (* ;; "Given a print FILE, use the Unix %"lpr%" command to spool it to a printer.") + (* ;; "") + (* ;; "The printer is named by HOST or UnixPrinterName, a Global variable.") [LET* - ((PRINTER (OR HOST UnixPrinterName)) + ((PRINTER (SELECTQ HOST + ((NIL UNIX) + UnixPrinterName) + HOST)) (COPIES (LISTGET PRINTOPTIONS '%#COPIES)) (NAME (LISTGET PRINTOPTIONS 'DOCUMENT.NAME)) (NSIDES (LISTGET PRINTOPTIONS '%#SIDES)) (TYPE (PRINTERTYPE PRINTER))) - - (* ;; "Removed redundant check (we already know it's a PS printer), JDS 2/19/92:") - - (* ;; "(COND ((NULL TYPE) (ERROR (CONCAT %"Printertype unknown for %" PRINTER))) ((NOT (EQL (U-CASE TYPE) 'POSTSCRIPT)) (ERROR (CONCAT %"Printertype for %" PRINTER %" is not Postscript%"))))") - [COND ((OR (NULL NAME) + (EQ NAME 'LPT) (STRPOS "{LPT}" NAME 1 NIL T)) (SETQ NAME "Medley Output")) ((EQ (CHCON1 NAME) @@ -88,63 +75,63 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue. (* ;; "The temp file's name will be of the form medleyprint., so all such files can be found for deletion on a subsequent call after a certain amount of time (2 minutes) has gone by. If we delete immediately, it may happen before lpr has done its thing. ") - (CL:MULTIPLE-VALUE-BIND (tmpstream tmpname) - (UnixTempFile 'medleyprint.) - (COND - (tmpstream + (CL:MULTIPLE-VALUE-BIND + (tmpstream tmpname) + (UnixTempFile 'medleyprint.) + (COND + (tmpstream - (* ;; "First, copy the lisp file to /tmp so lpr can find it.") + (* ;; "First, copy the lisp file to /tmp so lpr can find it.") - [CL:WITH-OPEN-STREAM - (out tmpstream) - (CL:WITH-OPEN-STREAM - (in (OPENSTREAM FILE 'INPUT)) - (printout PROMPTWINDOW .TAB0 0 "Spooling output to Unix printer" - (COND - (PRINTER (CONCAT " '" PRINTER "'")) - (T "")) - "...") - (IF NSIDES - THEN - (* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.") + [CL:WITH-OPEN-STREAM + (out tmpstream) + (CL:WITH-OPEN-STREAM + (in (OPENSTREAM FILE 'INPUT)) + (printout PROMPTWINDOW .TAB0 0 "Sending output to Unix printer " (OR PRINTER "") + " ") + (IF NSIDES + THEN + (* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.") - (BIND C SAWCR - DO (SETQ C (BIN in)) - (IF (MEMB C (CHARCODE (CR LF))) - THEN (BOUT out C) - (SETQ SAWCR T) - ELSEIF SAWCR - THEN - (* ;; "First char of 2nd line: nonCR/LF after CR/LF") + (BIND C SAWCR + DO (SETQ C (BIN in)) + (IF (MEMB C (CHARCODE (CR LF))) + THEN (BOUT out C) + (SETQ SAWCR T) + ELSEIF SAWCR + THEN + (* ;; "First char of 2nd line: nonCR/LF after CR/LF") - (* ;; "Put out simplex header, then print character in C") + (* ;; "Put out simplex header, then print character in C") - (PRINTOUT out "%%BeginSetup" T) - (PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T - "<< /Duplex " (CL:IF (EQ NSIDES 1) - "false" - "true") - " /Tumble false >> setpagedevice" T - "%%%%EndFeature" T "} stopped cleartomark" T) - (PRINTOUT out "%%EndSetup" T) - (BOUT out C) - (COPYCHARS in out (GETFILEPTR in) - -1) - (RETURN) - ELSE (BOUT out C))) - ELSE (COPYCHARS in out 0 -1] + (PRINTOUT out "%%BeginSetup" T) + (PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T + "<< /Duplex " (CL:IF (EQ NSIDES 1) + "false" + "true") + " /Tumble false >> setpagedevice" T "%%%%EndFeature" + T "} stopped cleartomark" T) + (PRINTOUT out "%%EndSetup" T) + (BOUT out C) + (COPYCHARS in out (GETFILEPTR in) + -1) + (RETURN) + ELSE (BOUT out C))) + ELSE (COPYCHARS in out 0 -1] - (* ;; "Now make Unix print the /tmp file.") + (* ;; "Now make Unix print the /tmp file.") - (ShellCommand (UnixPrintCommand PRINTER COPIES NAME tmpname) - PROMPTWINDOW) - (printout PROMPTWINDOW "done" T)) - (T (ERROR "Couldn't create unix temp file"))))] + (ShellCommand (UnixPrintCommand PRINTER COPIES NAME tmpname) + PROMPTWINDOW) + (CL:WHEN NIL (* ; "This should be conditioned an error code--don't want to say %"done%" if it didn't happen. If we put this back, then put in ... in the Sending printout above") + (printout PROMPTWINDOW "done" T))) + (T (ERROR "Couldn't create unix temp file"] T]) (UnixShellQuote [LAMBDA (STRING) - (DECLARE (LOCALVARS . T)) (* ; "Edited 19-Apr-89 21:14 by TAL") + (DECLARE (LOCALVARS . T)) (* ; "Edited 18-Jan-2026 08:34 by rmk") + (* ; "Edited 19-Apr-89 21:14 by TAL") (LET* ((X (CHCON STRING)) (CT X) C FLG) @@ -168,9 +155,9 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue. (CHARCODE SPACE)) (T C)) (SETQ CT (CDR CT] - (COND - (FLG (CONCATCODES X)) - (T STRING]) + (MTOUTF8STRING (COND + (FLG (CONCATCODES X)) + (T STRING]) (UnixTempFile [LAMBDA (Prefix DontOpen) (* ; "Edited 28-Apr-93 13:49 by rmk:") @@ -234,66 +221,26 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue. " " TMPNAME]) ) +(ADDTOVAR PRINTERTYPES ((UNIX) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND UnixPrint))) + (RPAQ? UnixPrinterName NIL) (RPAQ? UNIXPRINTSWITCHES " -r -s ") - -(* ;; "(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform") - - (PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW) (PUTPROPS UNIXPRINT FILETYPE :COMPILE-FILE) -(DECLARE%: DONTEVAL@COMPILE DOCOPY -(DEFINEQ - -(UnixPrintCommand - [LAMBDA (PRINTER COPIES NAME TMPNAME) (* ; "Edited 4-May-2018 17:17 by rmk:") - (* ; "Edited 20-May-92 14:26 by nilsson") - - (* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr tmpname%". The arguments to this function are:") - - (* ;; " PRINTER - the name of the printer. Usually something like lw or plw.") - - (* ;; "COPIES - how many copies of this job to be printed.") - - (* ;; "NAME - the name of this job. This gets printed on the banner of your job.") - - (* ;; "TMPNAME - The name of the temporary file that contains the postscript code for this job. ") - - (* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax") - - (* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.") - - (* ;; "Use raw lpr, let system decide where it is located.") - - (CONCAT "lpr " (COND - ((AND PRINTER (NEQ 0 (NCHARS PRINTER))) - (CONCAT "-P" (UnixShellQuote PRINTER) - " ")) - (T "")) - (COND - ((AND (FIXP COPIES) - (NEQ COPIES 1)) - (CONCAT "-#" COPIES " ")) - (T "")) - " -J" - (UnixShellQuote NAME) - " " - (OR UNIXPRINTSWITCHES "") - " " TMPNAME]) -) -) -(DECLARE%: EVAL@COMPILE DOCOPY - -(FILESLOAD UNIXCOMM) -) -(DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS UnixPrinterName) ) +(DECLARE%: EVAL@COMPILE + +(FILESLOAD UNIXCOMM) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS @@ -303,9 +250,7 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue. (ADDTOVAR LAMA ) ) -(PUTPROPS UNIXPRINT COPYRIGHT ("Venue" 1990 1991 1992 1993 1995 1997 1999 2001 2018 2023)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1389 11216 (InstallUnixPrinter 1399 . 1991) (UnixPrint 1993 . 6875) (UnixShellQuote -6877 . 8306) (UnixTempFile 8308 . 9531) (UnixPrintCommand 9533 . 11214)) (11550 13243 ( -UnixPrintCommand 11560 . 13241))))) + (FILEMAP (NIL (1046 10887 (UnixPrint 1056 . 6392) (UnixShellQuote 6394 . 7977) (UnixTempFile 7979 . +9202) (UnixPrintCommand 9204 . 10885))))) STOP diff --git a/library/UNIXPRINT.DFASL b/library/UNIXPRINT.DFASL index ecfaa505e7706c08e579dc81c4e77a3df7f7658e..6b582ab0d01702b1448f02f9a4f501fdd191ae6b 100644 GIT binary patch delta 2641 zcmaJ@ZA@Hg6~13HcYql>1MFfc3^xl4r7+!L6t<<+TCu1!&><`zh(I4&)6B9S4Mx#c5)N|g; zhDMEKm~+l^KHl@5Ip^H_ljvsW=Hc+^w3bL|6VIMpD9$WRFRgwet0%`ZW>UA0p6Kq` zI{WBQPh@zy6p2M+y-Ig?U-US9DhE|7rF^ouP*Bb-6{eR9dBwV1%1^I$DX|^}%r8SE z1zo!Kd}2L!zxx*N^Ef+YaZtC&j-Yi2Ab8bO(y}dwpx|fcYNkDr(E#EBk}w_eo-pi1 z13p7;i1|TeD~D3XfSMXpO^bFoL9d z@zOrBBDMILo1xorBQrs6OR0(faoe48^VR=fChle04Zu38!6$so=H|yuOI)^!d4Bz=PaNO#a@T z_B8WbxO)Gajjnwqs?RWV{{D_@77AA65I%jZp~#TaeGMVeZ}{r&l>}+3VRu`uBL`#; z{2x48v&+uiklXpWdo^wj+eXd$Tn#_@W++%aEV7I??s6~jQ;lR&ZfZLZA$)j%(a7vs z4(~3k{CTcnD*R!%!{oLcRo(zoqmiWt%C_AN`7k$kueNqrc=PUqy!<%1FSm4k)QA>C z!l4q!HM4Z?^=tc5ajUbwP8zzJq6M0#=bX)Q1q_&GLhomu3u4<~c#me9h6xh?50L!UTw!4$zIfrnbSaPE zpQwW5+j#gh=`oxel<&}HB%2F}C$!WcG&}+ckgJ9?8|9=vXdreBFi$d}+GxSO50V$u zi6kD%{T4)jMvaf42i_UMU$N-iXVFxTpMq&a^m+0|<-xT}2*yvv4ZS;$tYw=S!#V+M z)kA|^4-WiaXbj0~pz~iS~5r2rTf|mO`GvfZ}l6U9|f5#+x^3rKF!)lbu$j*3*q?gr{@v5sPgv;!YV81Zac zgN=z*YXU@WaXY1kc2v>U3JAeJAiuAAoc|rE_YbY*MUjret%FCh`st*ez-!xD+{V5X zI38{+$5V!tHDPn{_$iA+-5=uv5V_LGK&Cd_JI(t*_9XR8))u;)n5j}K@VijHxMUH3OwTJTR zIYd5Q-ND}=v(-&&o0tTSo)@|sngB(aM$!9U%yS#rzq-gD_L28pr*BQwFo z;Cs$Zp*q7B;V3J7kP|s-iaZ@h5me&$AG_NuCKgI!_G}Sf%`m}32mHQ?`OL> z$kDJ2R(o4YptBAe;G{l8i_c*%aW6oj0%_aG+JncS<3K|^HJyC(x4LWk_~~Yu=Y&0P zkLqX2H=L8kXzd7G(Fd~$vz@W}X%rtTJ~ffB4R~jfPtaJDcD7;}bYlQ^Kr`(;NIOC- zj}QE`!!rt(q$daAAwuhEFYE;W-rGzBtJq7vC`Q&gowBS%mXydP1@?qMTO8s+w^sLk z$`@C4wu!M`(Dj)Fgu~|*tZLQHTCjp7+stYX^j2tGGmY^Gz8x8Q1RqSUX(i?luVnDt b14l_urc$m#vb2DnpiSH@_(^!_!GnJThd29( delta 3138 zcmb_eZ%kX)6@P#H2MjnircFu+JPLz^)Bzki7QzyY{eVZF-*fF}2yGf*;KU}zX0}Pf z(#nKoQM-9v;DzMfC~KEi+J~+mNT;eL=|oml?WT3>rY)M5?MtUg&Av>jG)>y3Ej#Bv z=g+i#*oRrxJ^y~^+9(cYtk(rI}JCdDDAKRBq?VF8Hr{W9y zj+W?hr{{2&Bbu4dPQ`^I$y8jJ%El-2@oB-=;T@h#dwm_g-Ga~8)790}@uXwGAC>OD9i;v&nQm zp4E?XqW)`csKA4r4I4V8Z6I)a_Zr2K?f>brLlCAiv$Jti89>@|s7KPz2Jte;*BPoV9(+hsYxKf4?{ zz1G7XVt+6kx^sA0`9_GpI2@{5PA(-D6Ia%@4!c?VQH0YWQ7dy5C~bHSaM#z~vsW-{ zSB6{+XEzF~#R}YEO^j$`VUfe#WlwS(5KDexF3vE(RhH^N14WK(D`Oaz@OV5rXMC$z z-lB#zNmcwZIcS_KmeXLe6b+wdC&0NZ9Mk;Ks2bo$Nqq$4MnxsqM8ig;!o8WJtliLA z&^jJe2y9KgaiL*}VYq7CoC(aq&2s%Tt5!G5-{&m%IqPt_3A4$|iN)l&b47K&M7LEw zmPl4v(Rh){@2<7V0SZo?y7Ok8Ortu`eu!#k?yQ>tOs=zZ4RKGz0yU$XCD6YJHKzq6vc78BL%xO3dO;dWK2PJX;@MXg)9%3NZ{YxOJE zZ7tgPmJQfXhEZ!DOn)TSQZTcUq9ZeSjs@Bq#fw5&{$==2!);%88$wB<9 zcPH$vdY7$fpQv^u-Q3nR!!*#v)-cB?O?Wpv!v|#5S4nf}rI~J+`ILmw-g5n`wr0Mg zbC3SI%?q?!zhygGnBl5Pf^(B&oQtHmO=Om-<&C-dZ))74lk=wlTl5j6r5`xgui^$ihG{1a(M z@(E}wqltJb6@Wf9nVv@FEz*eO3fSz2LL*Sb8p@Z6uv7rLfcl^)4?veey%*$)K~Y0l zQU+AiHG6DNKHQbdaNUR1YzNmMU*A$+H1Mw(wRMejGh9hb~6ocM?KPr+L z#02zzp^i>q}UPpD+r$*5-ok_H`b!_Ij!4CZ+N5hZ>UB+f+G_zaMyP=u)B=)9rrJJVoGgErcByX7HJEo18(l<@%ENTA= zc`irVpQX!qB?h}|35lWpUeew{+P5_0Q9zl&y>^jy{3P(2zn^jG*{a_*eBLPXyLRnr zGm1=uQDj>mgXIgY4x`u*oy%lW`eA3SzTot+tNI(xAp5@lne&mtG|!SLI@ena$1wMk zUu4TD|2E4}`VPZj&Qr#D{IHl;c%@in*7J~G3Cd!`tmG<+zX53G1(Q8)6stn?@g%78 z`MLSLdSB66((E^i)>Cp=d!EHvZcx8#mq~+h0jFio>T8>p8eM%ZhBVj#aPJ#O#teGd zBxMjf45z1EJ6YlTms~w;L9nw7SHkhohA_;p==e*3R-pJk73pvZs~8#uT>dbc&QtBH z$i8H<6DE0vlGFPs`I-;*!V{H3VOjKID^Lc#;!`od+(atT^*0_9rjJ(deDs7_SvSkj zvO(*MBXhb@?PnYHTh%LS7V^r$5#)J>w2(%IWh|xjTVefqk|S9f?l!F7c9OEM9wrST zliO~RdeY#a+!_6CkDp`vb!$y~A^gx6g?^@73`_!VH+L7j>*lCpi2RhmUdi1rEQ*;Zy7s OUNIXUTILS.;35 18084 +(FILECREATED "19-Jan-2026 14:09:03" {WMEDLEY}UNIXUTILS.;55 20711 :EDIT-BY rmk - :CHANGES-TO (VARS UNIXUTILSCOMS) + :CHANGES-TO (FNS UNIX-FILE-NAME) - :PREVIOUS-DATE " 4-Nov-2025 10:11:10" {WMEDLEY}UNIXUTILS.;34) + :PREVIOUS-DATE "17-Jan-2026 23:16:17" {WMEDLEY}UNIXUTILS.;54) (PRETTYCOMPRINT UNIXUTILSCOMS) @@ -21,7 +21,8 @@ (FUNCTIONS ShellCommand ShellWhich) (ADDVARS (MEDLEY-INIT-VARS (ShellBrowser NIL RESET) (ShellOpener NIL RESET))) - (FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) + (FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME + UNIX-TMP-FILE-NAME) (PROPS (UNIXUTILS FILETYPE)))) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -147,7 +148,8 @@ "true"]) (ShellOpen - [LAMBDA (FilenameOrURL) (* ; "Edited 10-Sep-2025 15:29 by rmk") + [LAMBDA (FilenameOrURL) (* ; "Edited 28-Dec-2025 18:26 by rmk") + (* ; "Edited 10-Sep-2025 15:29 by rmk") (* ; "Edited 4-May-2025 11:14 by rmk") (* ;; "Open the file or URL using the generic %"opener%" for this machine via a shell call.") @@ -184,7 +186,11 @@ then (CONCAT "File not found: " FilenameOrURL) elseif (STREQUAL OPENER "true") then (CONCAT "Unable to find a file opener to open: " FilenameOrURL) - else (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION)) + else (SETQ FilenameOrURL (TRUEFILENAME FilenameOrURL)) + + (* ;; "RMK: UNVERSIONED is in the Lisp space, I removed the SLASHIT there because it adds \ in front of spaces which screws up the following INFILEP.") + + (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION)) (UNPACKED (UNPACKFILENAME.STRING FULLNAME)) (NEWNAME (CONCAT (LISTGET UNPACKED 'NAME) "~" @@ -197,8 +203,7 @@ (SETQ FN (PACKFILENAME.STRING UNPACKED)) (if (STREQUAL (SUBSTRING FN -1) ".") - then (SETQ FN (SUBSTRING UNIXFILE 1 -2))) - (SETQ FN (SLASHIT FN] + then (SETQ FN (SUBSTRING UNIXFILE 1 -2] (UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED))) (TMPDIR (CONCAT "/tmp/" (RAND 1000 9999))) (TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR @@ -240,7 +245,8 @@ 0))) DO (BLOCK) FINALLY (RETURN CODE]) (SLASHIT - [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 4-Nov-2025 10:10 by rmk") + [LAMBDA (X LCASEDIRS NOHOST KEEPDOT) (* ; "Edited 17-Jan-2026 23:15 by rmk") + (* ; "Edited 4-Nov-2025 10:10 by rmk") (* ; "Edited 22-Oct-2025 13:05 by rmk") (* ; "Edited 25-Sep-2025 09:57 by rmk") (* ; "Edited 23-Sep-2023 15:27 by rmk") @@ -249,7 +255,7 @@ (* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.") - (* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ") + (* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, perhaps lower-casing the directory, and perhaps removing a final dot. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ") (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) 0] @@ -267,22 +273,34 @@ (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) "")))) - (CL:IF (OR (EQ DIRPOS 1) - NOHOST) - SLASHED - (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) - SLASHED))]) + (CL:UNLESS (OR (EQ DIRPOS 1) + NOHOST) + (SETQ SLASHED (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) + SLASHED))) + (CL:UNLESS (OR KEEPDOT (NEQ (CHARCODE %.) + (NTHCHARCODE SLASHED -1))) + (SETQ SLASHED (CL:IF (EQ (CHARCODE %') + (NTHCHARCODE SLASHED -2)) + (CONCAT (SUBSTRING SLASHED 1 -3) + ".") + (SUBSTRING SLASHED 1 -2)))) + SLASHED]) (UNIX-FILE-NAME - [LAMBDA (FILE ACCESS COPY) (* ; "Edited 27-Sep-2025 16:24 by rmk") + [LAMBDA (FILE ACCESS COPY EXTENSION) (* ; "Edited 19-Jan-2026 14:05 by rmk") + (* ; "Edited 17-Jan-2026 22:32 by rmk") + (* ; "Edited 11-Jan-2026 23:54 by rmk") + (* ; "Edited 27-Dec-2025 21:24 by rmk") + (* ; "Edited 26-Dec-2025 10:58 by rmk") + (* ; "Edited 27-Sep-2025 16:24 by rmk") (* ; "Edited 19-Sep-2025 07:29 by rmk") (* ; "Edited 13-Sep-2025 18:37 by rmk") (* ; "Edited 1-Oct-2023 20:52 by rmk") - (* ;; "Forces an extension %"ufn%" if there isn't one already, to avoid the dot/no-dot question") + (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file doesn't have the Medley version convention. If FILE does not have a corresponding Unix name (e.g. NODIRCORE), COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") + + (* ;; "NOTE: The value does not have a host field--no {UNIX}.") - (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") - (* ; "Might catch NODIRCORE") (CL:WHEN FILE (SETQ FILE (TRUEFILENAME FILE)) (CL:UNLESS (STREAMP FILE) @@ -292,42 +310,58 @@ (NIL (SETQ ACCESS 'INPUT) 'OLD) (\ILLEGAL.ARG ACCESS]) - (LET (UNAME VERSION) - [SELECTQ (FILENAMEFIELD FILE 'HOST) - ((UNIX DSK) - (SETQ UNAME FILE)) - (PROGN - (* ;; "Catch the streams as well as other devices (CORE, servers)") + [SLASHIT (SELECTQ (FILENAMEFIELD FILE 'HOST) + (UNIX (CL:IF [AND EXTENSION (NEQ (L-CASE EXTENSION) + (L-CASE (FILENAMEFIELD FILE 'EXTENSION] + (COPYFILE FILE (PACKFILENAME 'EXTENSION EXTENSION 'BODY FILE)) + FILE)) + (DSK [LET ((VERSION (FILENAMEFIELD FILE 'VERSION)) + (UNAME (PACKFILENAME 'VERSION NIL 'BODY FILE))) + (CL:UNLESS (EQ VERSION 1) + (CONCAT UNAME (CONCAT "~" VERSION "~")))]) + (LET (UNAME) - [SETQ UNAME (OUTFILEP (CONCAT "{DSK}/tmp/medley-" (CL:IF COPY - (CONCAT (L-CASE COPY) - "-") - "") - (IDATE] - (CL:WHEN (AND COPY FILE) - (RESETLST - (CL:WHEN (\GETSTREAM FILE 'INPUT T) + (* ;; "Catch the streams as well as other devices (CORE, servers)") + + (SETQ UNAME (UNIX-TMP-FILE-NAME FILE EXTENSION)) + (CL:IF (AND COPY FILE) + (RESETLST + (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope it's randaccess") - [RESETSAVE (GETFILEPTR FILE) - `(PROGN (SETFILEPTR ,FILE OLDVALUE]) + [RESETSAVE (GETFILEPTR FILE) + `(PROGN (SETFILEPTR ,FILE OLDVALUE]) + (COPYFILE FILE UNAME)) + UNAME)])]) - (* ;; "Let DSK pick a new version number, rather than RAND") +(UNIX-TMP-FILE-NAME + [LAMBDA (NAME EXT HOST) (* ; "Edited 17-Jan-2026 22:28 by rmk") + (* ; "Edited 13-Jan-2026 15:41 by rmk") + (* ; "Edited 26-Dec-2025 17:37 by rmk") - (COPYFILE FILE UNAME)))] - (SETQ VERSION (FILENAMEFIELD UNAME 'VERSION)) (* ; "Convert to Unix version. ") - (SETQ UNAME (PACKFILENAME 'VERSION NIL 'BODY UNAME)) - (CL:WHEN (AND VERSION (IGREATERP VERSION 1)) - (SETQ UNAME (CONCAT UNAME ".~" VERSION "~"))) - (SETQ UNAME (SLASHIT UNAME NIL T)) - (CL:IF (EQ (CHARCODE %.) - (NTHCHARCODE UNAME -1)) - (SUBSTRING UNAME 1 -2) - UNAME)))]) + (* ;; "Returns a unique {UNIX}/tmp/medley name that includes NAME as a hint and perhaps a useful extension. This goes through random candidates hoping to find a name that doesn't yet exist, and that can be %"reserved%" before anybody else gets it. There is a race-condition window where somebody could get in.") + + (* ;; " ") + + (* ;; "If DSK names were reformatted so that the ~version~ came before the intended extension, we could just open on an output stream on DSK to get a unique version number, then convert to the UNIX formatted string.") + + (bind UNAME (DATEPREFIX _ (CONCAT "{UNIX}/tmp/medley-" (IDATE) + "-")) + (SUFFIX _ (CONCAT (CL:IF NAME + [OR (AND (STREAMP (FULLNAME NAME)) + "stream") + (L-CASE (FILENAMEFIELD NAME 'NAME] + "unamed") + (CL:IF EXT + (CONCAT "." (L-CASE EXT)) + ""))) eachtime (SETQ UNAME (CONCAT DATEPREFIX (RAND 1 1000) + "-" SUFFIX)) + unless (INFILEP UNAME) do (RETURN (SLASHIT (CLOSEF (OPENSTREAM UNAME 'OUTPUT 'NEW]) ) (PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1137 1510 (ShellCommand 1137 . 1510)) (1512 1909 (ShellWhich 1512 . 1909)) (2019 18006 -(ShellBrowser 2029 . 3801) (ShellBrowse 3803 . 4488) (ShellOpener 4490 . 6178) (ShellOpen 6180 . 11659 -) (PROCESS-COMMAND 11661 . 12274) (SLASHIT 12276 . 14731) (UNIX-FILE-NAME 14733 . 18004))))) + (FILEMAP (NIL (1170 1543 (ShellCommand 1170 . 1543)) (1545 1942 (ShellWhich 1545 . 1942)) (2052 20633 +(ShellBrowser 2062 . 3834) (ShellBrowse 3836 . 4521) (ShellOpener 4523 . 6211) (ShellOpen 6213 . 11982 +) (PROCESS-COMMAND 11984 . 12597) (SLASHIT 12599 . 15623) (UNIX-FILE-NAME 15625 . 18952) ( +UNIX-TMP-FILE-NAME 18954 . 20631))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index 96e1669b9f37fa0ae01eba23b9c1f68c725ae4e6..8de673343f76efbdcedf375e6a59352c3096bb48 100644 GIT binary patch delta 3217 zcmZt}ZA@F&_1^bv%vXr9LqZ@Vuw|qpH30%$AcJ6@A7C)H@w16DMXgw2amq)UFJ&pD zhO|Gj;3|+Sm@ny%{%934Z4uB+?UJ>Nx`@&rlhSIPwkp*=T20fmt*NGV`Lkx{oJ$Ie zB3bWzpL_1T=i~Zn{i{urzNhNyvaKU0k3HRA`h&xR{iRPI>+e0$-&a~)@9F3r_S96> zJW*O*+fY^CP_;X|)oTU*U#;uNa9{7~$3eXm)KB&vJ6(zhEvo->_t z#e)90C)yPj|J1A9k61!f+sb&|>z1vZ*L0^ZrkoYA;C_G5=LttbQPYT4$Zi{BJUy9m z7=e%#iE-pL;A zmQ`L^RVPQqWY&kiPI(rLX6QRHo*9sPjr4RX!-_`2A*%_|fXDD!=HsLxcMzB@P?S?q z;!5_c`@Gzs;qrP~=wrm65Is5j`IF*m&T`pA=MfOHZ2Vjzw3%>ca~86`&%|VIN*hav z@^zo-H8r)OFz*dMFK*|>lUL+kH;4VAnMoX^G@75r2hz@=L_J zj+}E~>F@{9E{yaGO5+Hyv#eOls+&Htc?osCN9fy#b`wgz{pcy+x1!-#6h(VU^eaSn zrl(yg8^(=PAuYk~iG9wJD?m^V8elvjkWS;;xHyVkV4zUkrr3Md&p| zugMJvekyk%xU5t!fE%09?!|c6c{w^HM|+jEB{y~;mSoZ-&g^aivQkl76tziFSp+U= zxI?@O%Zxg~SgVr90Ps&qynyJ(xFTKv62Ai?%jb_k5rrZLkaHWw?IDW}=q8vY86&%2 zkc%bMStRsbMCS-yM$}kE>oANSGh+EeK@^pdh}^6r^gZNqLeV4pyW*Y#JG<3x1_B#_ zt3}c&XRElC@8%ui_xY36bGlA?Ki6#pujqDymt|D5JyfXmjuClENLPd7{cUpBW+=js zTy+I=pouBIrlf1C#CCUu`w=BAdfnemLP_^yEG_97EiZfsVrAVq_;oU!(du)$+Q?;j zh-qK9g-mD*8ny*AE>5TNMvPFzJVTocsr36UfXv7nHhG#r}uFniz-mLt>=BTlVG3xqSh< z*B;t^wdR3y`naH`^2?QdeDUag@EqCqvTRJxWa0YRqH*JVd@Au`%T!|Q@S?kUz(4Q@ zI+qS=H`k4+#QDL>j-mTR-d*$z?&ui$YK7R?F);LB(q3&==YaPW@ve6W`=*9m9h0cj zG{e47R5Weck+iLJCcElP5D-N|U&?=;xw3ON3N#|H2e5mp*#5Q3`3pGD2}awY^dd&c zhsD4?Bu{yWE-3@df5yngocsp1J~q3`nj&--xhcgJw>Ir5%dba*=WivD=OB?}Hq`q! zUZf}~+{|;tcM5xw&6H4dDse*ZE;bvBTMg>fYlKAKol2ZNJeF82Rsw?znsdReYWMRa z&GSEOUvcAIV@<5Y8uffl^AFs;m?)nw?4TR))0a-4f^p4P&{@!K!|`_LxfcmtoRoBg8#x4?Ps+Np#puaosVh^pJZf#|e6TMFJvpCjq)Nu~6RqT-4Y zr;2tZ3H|kYw0Rq2ZwdJhAn_&%u=BC2tLST>qWi2)WM4ow-;U^yNMqqy1)fAd*eNWc zmrXPZ1$>PF?fxK)GY^^WD3@n9gNw(uqC(KzucpHXn0tJ^XejPXmgws63sq0x#WKqE zhkC+py_VLw@ht-HXM(rvgKcIMX07S%(l^NG)~7F|?C|_*3o3Vy@gjU%!R&{ydc1*{ ziH#2)Su@O$3HyO|32lX@8TQ^W&LM$vC|T57PIiM7cmB~zi(|h_w7#7u^by1!cMt5Ss6@bqoya zext^T+M(>a;S_CalgBk*pB zujKnO<-2aiqcA;ii%W8!ok3BkhnQ{UA+|(U+&~)Y#WXQaSq5Dht$vIv;rrKYMe?FN zs#5W-({gl}tgiRUV5m%kXoBEZf|?jLF@A)Q_zwtzQH&AqIkzw&G|fHd{?6yU z@0|1AYs(KU84C^7H#m(=PYiaayc;(5r@Y;Rsr6e^JzjsKFShAPpMQbB!CSYm$zRu0 zSMOXAFrv4rb)(F8$Up%2F!@*=VkJ|{L z)|hDzMs=e-5w;kGzp1u1EMz}r1*yUA$_`W{Z{TzbwF^giF+Jvs>cK$N*Q)b4dpbKw zlkB_f3fj&7%0A~dsBp_~S_yBB?4o_g>$s{>P)ZZ z3j%yW15dM8bH2%6$#)8iJ-CjtUCw#MRuyh|5faNKckF%Vg!_5!QNX`yF?Bd&(wo~s z*Rc-~OqZ^66tE%r-6=fem1 zeQqjF1fDIXaGBOSGR8=?$WiIyX&{Y!Gm!amS7q%nZHYiE1X!-vID&e-YlRjK3xNL4 zmjSsTa5vLk#Y6N{^!PrYub>CI50NQAo)>y{Ee6(c*zb}WgVIZ{kmeZeEk-h-#acnW z7EMiH4P;LMD^tf1E#NS!8OeBi5=7pGsP+NycMF*fl7&qnMk1G)=9)9~tB~YF60yLl z@Cq#)g~O2_q{^2!W0DidPJ-|l_W*g5*8Gjgu;KedaD~tfI zM`G0g86teP+?GgT4w4B44g*(hgp)3zr_}Ms1)=9rd>GgtAtGcAn{UM?C!{4r8|aBH zK)wQTL^tp*KAJXr57|?oGRb#t5ZQhV{6U0I1G{vZt${SwgcF9Q$3Rp*?I#=AGXf=l zBMUCcIf*_c?6QnVI2tV$sA9063QK4k`?GMYZojIc&N0=7^njX$^mT41w%gilkv+|y zWXESV+0Rz++A`5a*Jd^p?H8I*zW;B?#VqKqcHf~P*|2-*kZ8yr$Rj8QP(d7r&uSbz zE}{~QzF(!8EH)73W>Y&vQ!CKaU_9G03(`S75#Ejm(`A(%vdrvsdra%xE_CR)WoFfG z9oP(&LAT!!m7=WEGHDIqd4kyi3}J@n7xjML%@!5ah#qZZy+z)cvRMAWbVf%+{1}@k z3e3Bjxwk9g^vZ3gU!wTLJ^fSUueq8z#}$6ZbI@Ggy^k-m_Bup-@)>)m_;6|Gcx1R` ze5I?oPwV?0Z)GJ;64q1F#NH^WT&HFRg-s3$>VVX!9amWeqay|2@04tX4={CTPjWya z6Vu2zvbdNMWrL-Q=jAVf4b7h`3MV&~j07WrL{JZfF$%GW%04eGqdDw+=^CTZOPlc- zVww*id+EXPwr5vLmNicuUX3HM<*2&_$Kdp=+=Z+|)64&|${*_gxxq4kh$%a==bs{WU zdWD`?Wr+8ck|oaTM95(C%RS{38mAq)T9Ji$hA4PVC)uOrbB2ofayuorKaeuKyHcr# z>*xp!4JsiVl=-ML15gD=EV(A14UCbzcp%tzV+g`?`vSdu1nkQ~?hwTe;#!#0WI`J5 zfmF3nAPEBqMjjCPqT&xqdsaECb_o0@6YXNS$|0Kvdfy4u)}n{HVDmL<<0v^J*?u8b zLq^+rP=oGTgZSw%;CeK)OwcSXCMLZP1hldeNfnfj8Vh&GVfv+A$co6-OuvzfmZ{W0 z=aCca!mPH=G8ONZdSq+S5^hlS*4AqDtMWDS-aVMXS%-+=e5f^?6mO<*V3q3O+h$n1 z%`EW^(i)TQs@T}SKETCH>SKETCH.;11 493235 +(FILECREATED "24-Dec-2025 14:48:39" {WMEDLEY}SKETCH>SKETCH.;16 491600 :EDIT-BY rmk :CHANGES-TO (VARS SKETCHCOMS) - (FNS UPDATE-SKETCH EDIT-SKETCH) + (FNS SK.INCLUDE.FILE SK.GET.IMAGEOBJ.FROM.FILE SKETCH.PUT SKETCH.FLUSH.EXISTING) - :PREVIOUS-DATE " 8-Nov-2025 12:19:12" {WMEDLEY}SKETCH>SKETCH.;10) + :PREVIOUS-DATE "30-Nov-2025 10:10:57" {WMEDLEY}SKETCH>SKETCH.;11) (PRETTYCOMPRINT SKETCHCOMS) @@ -15,52 +15,25 @@ (RPAQQ SKETCHCOMS [(FILES (SYSLOAD) TEDIT) - [DECLARE%: FIRST DOCOPY DONTEVAL@LOAD - (P (PROG ((NOTECARDSFLG (GETPROP 'NOTECARDS 'FILEDATES)) - (SKETCHFLG (AND (BOUNDP 'ALL.SKETCHES) - ALL.SKETCHES)) - TEDITFLG) - - (* ;; "current knows about SKETCH TEDIT and NOTECARDS. Everyone else loses.") + (DECLARE%: FIRST (FNS SKETCH.FLUSH.EXISTING)) + (DECLARE%: FIRST DOCOPY DONTEVAL@LOAD (P (SKETCH.FLUSH.EXISTING))) + + (* ;; "Putting and getting") - [MAP.PROCESSES (FUNCTION (LAMBDA (PROC PROCNAME PROCFORM) - (AND (EQ (CAR PROCFORM) - '\TEDIT1) - (SETQ TEDITFLG T] - (COND ((AND (BOUNDP 'ALL.SKETCHES) - (OR SKETCHFLG NOTECARDSFLG TEDITFLG)) - (ERROR (CONCAT "Please close" (COND (SKETCHFLG - " all open Sketch windows," - ) - (T "")) - (COND (NOTECARDSFLG (CONCAT (COND (SKETCHFLG " and") - (T "")) - " any open notefiles,")) - (T "")) - (COND (TEDITFLG (CONCAT (COND ((OR SKETCHFLG - NOTECARDSFLG) - " and") - (T "")) - - " any TEDIT windows that have sketches in them," - )) - (T "")) - - " then type 'RETURN'. -To abort loading the new version of Sketch, type '^'."] - (FNS SKETCH SKETCH.FROM.A.FILE SKETCHW.CREATE SKETCH.RESET SKETCHW.FIG.CHANGED - SK.WINDOW.TITLE EDITSLIDE EDITSKETCH SK.PUT.ON.FILE SK.OUTPUT.FILE.NAME SKETCH.PUT - SK.GET.FROM.FILE SK.INCLUDE.FILE SK.GET.IMAGEOBJ.FROM.FILE SKETCH.GET - ADD.SKETCH.TO.VIEWER SK.ADD.ELEMENTS.TO.SKETCH SKETCH.SET.A.DEFAULT SK.POPUP.SELECTIONFN - GETSKETCHWREGION SK.ADD.ELEMENT SK.ADD.PRIORITY.ELEMENT.TO.SKETCH SK.ELTS.BY.PRIORITY - SK.ORDER.ELEMENTS SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH SK.ADD.ELEMENTS - SK.CHECK.WHENADDEDFN SK.APPLY.MENU.COMMAND SK.DELETE.ELEMENT1 SK.MARK.DIRTY - SK.MARK.UNDIRTY SK.MENU.AND.RETURN.FIELD SKETCH.SET.BRUSH.SHAPE SKETCH.SET.BRUSH.SIZE - SKETCHW.CLOSEFN SK.CONFIRM.DESTRUCTION SKETCHW.OUTFN SKETCHW.REOPENFN MAKE.LOCAL.SKETCH - MAP.SKETCHSPEC.INTO.VIEWER SKETCHW.REPAINTFN SKETCHW.REPAINTFN1 SK.DRAWFIGURE.IF - SKETCHW.SCROLLFN SKETCHW.RESHAPEFN SK.UPDATE.EVENT.SELECTION LIGHTGRAYWINDOW - SK.ADD.SPACES SK.SKETCH.MENU SK.CHECK.IMAGEOBJ.WHENDELETEDFN - SK.APPLY.IMAGEOBJ.WHENDELETEDFN SK.RETURN.TTY SK.TAKE.TTY) + (FNS SKETCH.FROM.A.FILE SK.PUT.ON.FILE SKETCH.PUT SK.OUTPUT.FILE.NAME SK.INCLUDE.FILE + SK.GET.IMAGEOBJ.FROM.FILE SK.GET.FROM.FILE SKETCH.GET) + (FNS SKETCH SKETCHW.CREATE SKETCH.RESET SKETCHW.FIG.CHANGED SK.WINDOW.TITLE EDITSLIDE + EDITSKETCH ADD.SKETCH.TO.VIEWER SK.ADD.ELEMENTS.TO.SKETCH SKETCH.SET.A.DEFAULT + SK.POPUP.SELECTIONFN GETSKETCHWREGION SK.ADD.ELEMENT SK.ADD.PRIORITY.ELEMENT.TO.SKETCH + SK.ELTS.BY.PRIORITY SK.ORDER.ELEMENTS SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH + SK.ADD.ELEMENTS SK.CHECK.WHENADDEDFN SK.APPLY.MENU.COMMAND SK.DELETE.ELEMENT1 + SK.MARK.DIRTY SK.MARK.UNDIRTY SK.MENU.AND.RETURN.FIELD SKETCH.SET.BRUSH.SHAPE + SKETCH.SET.BRUSH.SIZE SKETCHW.CLOSEFN SK.CONFIRM.DESTRUCTION SKETCHW.OUTFN + SKETCHW.REOPENFN MAKE.LOCAL.SKETCH MAP.SKETCHSPEC.INTO.VIEWER SKETCHW.REPAINTFN + SKETCHW.REPAINTFN1 SK.DRAWFIGURE.IF SKETCHW.SCROLLFN SKETCHW.RESHAPEFN + SK.UPDATE.EVENT.SELECTION LIGHTGRAYWINDOW SK.ADD.SPACES SK.SKETCH.MENU + SK.CHECK.IMAGEOBJ.WHENDELETEDFN SK.APPLY.IMAGEOBJ.WHENDELETEDFN SK.RETURN.TTY + SK.TAKE.TTY) (COMS (* ;  "fns for dealing with the sketch menu") (FNS SKETCH.COMMANDMENU SKETCH.COMMANDMENU.ITEMS CREATE.SKETCHW.COMMANDMENU @@ -275,40 +248,240 @@ To abort loading the new version of Sketch, type '^'."] (FILESLOAD (SYSLOAD) TEDIT) +(DECLARE%: FIRST +(DEFINEQ + +(SKETCH.FLUSH.EXISTING + [LAMBDA NIL (* ; "Edited 22-Dec-2025 23:56 by rmk") + (PROG ((NOTECARDSFLG (GETPROP 'NOTECARDS 'FILEDATES)) + (SKETCHFLG (AND (BOUNDP 'ALL.SKETCHES) + ALL.SKETCHES)) + TEDITFLG) + + (* ;; "current knows about SKETCH TEDIT and NOTECARDS. Everyone else loses.") + + [MAP.PROCESSES (FUNCTION (LAMBDA (PROC PROCNAME PROCFORM) + (AND (EQ (CAR PROCFORM) + '\TEDIT1) + (SETQ TEDITFLG T] + (COND + ((AND (BOUNDP 'ALL.SKETCHES) + (OR SKETCHFLG NOTECARDSFLG TEDITFLG)) + (ERROR (CONCAT "Please close" (COND + (SKETCHFLG " all open Sketch windows,") + (T "")) + (COND + (NOTECARDSFLG (CONCAT (COND + (SKETCHFLG " and") + (T "")) + " any open notefiles,")) + (T "")) + (COND + (TEDITFLG (CONCAT (COND + ((OR SKETCHFLG NOTECARDSFLG) + " and") + (T "")) + " any TEDIT windows that have sketches in them,")) + (T "")) + + " then type 'RETURN'. +To abort loading the new version of Sketch, type '^'."]) +) +) (DECLARE%: FIRST DOCOPY DONTEVAL@LOAD -[PROG ((NOTECARDSFLG (GETPROP 'NOTECARDS 'FILEDATES)) - (SKETCHFLG (AND (BOUNDP 'ALL.SKETCHES) - ALL.SKETCHES)) - TEDITFLG) +(SKETCH.FLUSH.EXISTING) +) - (* ;; "current knows about SKETCH TEDIT and NOTECARDS. Everyone else loses.") - [MAP.PROCESSES (FUNCTION (LAMBDA (PROC PROCNAME PROCFORM) - (AND (EQ (CAR PROCFORM) - '\TEDIT1) - (SETQ TEDITFLG T] - (COND - ((AND (BOUNDP 'ALL.SKETCHES) - (OR SKETCHFLG NOTECARDSFLG TEDITFLG)) - (ERROR (CONCAT "Please close" (COND - (SKETCHFLG " all open Sketch windows,") - (T "")) - (COND - (NOTECARDSFLG (CONCAT (COND - (SKETCHFLG " and") - (T "")) - " any open notefiles,")) - (T "")) - (COND - (TEDITFLG (CONCAT (COND - ((OR SKETCHFLG NOTECARDSFLG) - " and") - (T "")) - " any TEDIT windows that have sketches in them,")) - (T "")) - " then type 'RETURN'. -To abort loading the new version of Sketch, type '^'."] + +(* ;; "Putting and getting") + +(DEFINEQ + +(SKETCH.FROM.A.FILE + [LAMBDA NIL (* rrb "24-Jun-86 11:40") + + (* reads a file name from the user and calls sketch on it.) + + (PROG ((NAME (PopUpWindowAndGetAtom "Sketch file name: "))) + (RETURN (AND NAME (SKETCH NAME]) + +(SK.PUT.ON.FILE + [LAMBDA (SKETCHW) (* ; "Edited 6-Apr-87 18:18 by rrb") + (* saves a sketch on a Tedit file.) + + (* also changes the name of the sketch to be the same as the name of the file.) + + (PROG ((SKETCH (INSURE.SKETCH (SKETCH.FROM.VIEWER SKETCHW))) + NOWNAME NEWNAME TEXTSTREAM) + (SETQ NOWNAME (SKETCH.TITLE SKETCH)) + (OR [SETQ NEWNAME (MKATOM (PROMPT.GETINPUT SKETCHW "File to PUT to: " (SK.OUTPUT.FILE.NAME + NOWNAME] + (RETURN NIL)) + (SETQ NEWNAME (SKETCH.PUT NEWNAME SKETCH SKETCHW)) + [COND + ((AND NEWNAME (NEQ NOWNAME NEWNAME)) + + (* change the name of the sketch to be the same as the file name.) + + (replace (SKETCH SKETCHNAME) of SKETCH with NEWNAME) + (* change the titles of the viewers + onto this sketch.) + (for SKW in (ALL.SKETCH.VIEWERS SKETCH) do (WINDOWPROP SKW 'TITLE (SK.WINDOW.TITLE + SKETCH] + (RETURN NEWNAME]) + +(SKETCH.PUT + [LAMBDA (FILENAME SKETCH VIEWER REGION SCALE GRID) (* ; "Edited 23-Dec-2025 00:27 by rmk") + (* ; "Edited 1-Feb-2022 09:17 by rmk") + (* ; "Edited 17-Nov-87 17:47 by rrb") + + (* ;; "puts the sketch SKETCH on the file named FILENAME. VIEWER if given provides promptwindows and PUTFNs.") + + (PROG (TEXTSTREAM FILESTREAM) + [SETQ TEXTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (AND VIEWER (LIST 'PUTFN + (WINDOWPROP VIEWER + 'TEDIT.PUTFN) + 'PROMPTWINDOW + (GETPROMPTWINDOW VIEWER] + (* ; + "make a text stream with nothing in it except the sketch.") + (TEDIT.INSERT.OBJECT [SKETCH.IMAGEOBJ (INSURE.SKETCH SKETCH) + (COND + ((REGIONP REGION)) + (VIEWER (SKETCH.REGION.VIEWED VIEWER))) + (COND + ((NUMBERP SCALE)) + (VIEWER (VIEWER.SCALE VIEWER))) + (COND + ((NUMBERP GRID)) + (VIEWER (SK.GRIDFACTOR VIEWER] + TEXTSTREAM 1) (* ; + "set the margins so that if the user hardcopies it directly the margins come out") + (TEDIT.PARALOOKS TEXTSTREAM '(LEFTMARGIN 0 RIGHTMARGIN 0 QUAD CENTER) + 1 1) + (TEDIT.PAGEFORMAT TEXTSTREAM (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 0 0 0 0)) + (* ; + "save the stream so that it can be closed.") + (SETQ FILESTREAM (TEDIT.PUT TEXTSTREAM FILENAME)) (* ; + "grab the full file name if it is available.") + (AND (OPENP FILESTREAM) + (SETQ FILENAME (CLOSEF FILESTREAM))) + (SK.MARK.UNDIRTY SKETCH) + (RETURN FILENAME]) + +(SK.OUTPUT.FILE.NAME + [LAMBDA (SKETCHFILENAME) (* ; "Edited 3-Nov-2025 15:05 by rmk") + (* rrb " 5-May-86 10:45") + (COND + ((STRPOS " " SKETCHFILENAME) (* ; + "don't put up dummy names that contain spaces") + NIL) + (T (PACKFILENAME 'VERSION NIL 'BODY SKETCHFILENAME]) + +(SK.INCLUDE.FILE + [LAMBDA (SKETCHW) (* ; "Edited 23-Dec-2025 09:17 by rmk") + (* rrb " 2-May-86 11:29") + + (* ;; "retrieves a sketch from a file and includes it into the existing sketch.") + (* ; + "also changes the name of the sketch to be the same as the name of the file.") + (PROG ((SKETCH (SKETCH.FROM.VIEWER SKETCHW)) + NOWNAME FILENAME READSKETCH DIRTYSTATUS) + (SETQ NOWNAME (fetch (SKETCH SKETCHNAME) of SKETCH)) + (SETQ FILENAME (MKATOM (PROMPT.GETINPUT SKETCHW "File to GET: "))) + (COND + ((MEMB FILENAME '(NIL %])) + (CLOSEPROMPTWINDOW SKETCHW) + (RETURN))) + (STATUSPRINT SKETCHW " ...") + (SETQ FILENAME (OR (FINDFILE FILENAME T) + (ERROR FILENAME "file not found."))) + (OR (SETQ READSKETCH (SKETCH.GET FILENAME SKETCHW)) + (RETURN)) + [COND + ((NEQ NOWNAME FILENAME) (* ; + "change the name of the sketch to be the same as the file name.") + (replace (SKETCH SKETCHNAME) of SKETCH with FILENAME) + (* ; + "change the name of the sketch to be the same as the file name.") + (for SKW in (ALL.SKETCH.VIEWERS SKETCH) do (WINDOWPROP SKW 'TITLE (SK.WINDOW.TITLE + SKETCH] + (ADD.SKETCH.TO.VIEWER READSKETCH SKETCHW (COND + ((fetch (SKETCH SKETCHELTS) of SKETCH) + + (* ;; "if the sketch has elements, ask about the defaults from the read file and set the status to leave the sketch marked dirty after the read.") + + (SETQ DIRTYSTATUS T) + 'ASK) + (T + + (* ;; "if the sketch doesn't have any elements, use the defaults from the read file and set the status to leave the sketch marked clean after the read.") + + NIL))) + (COND + ((NULL DIRTYSTATUS) (* ; + "if sketch was empty before, mark it as not needing to be dumped.") + (SK.MARK.UNDIRTY SKETCH))) + (STATUSPRINT SKETCHW " done."]) + +(SK.GET.IMAGEOBJ.FROM.FILE + [LAMBDA (FILENAME VIEWER) (* ; "Edited 23-Dec-2025 09:20 by rmk") + (* ; "Edited 12-Feb-88 14:13 by rrb") + + (* ;; "reads the sketch image object datum from a file.") + + (RESETFORM (CURSOR WAITINGCURSOR) + (PROG ([TEXTSTREAM (OPENTEXTSTREAM FILENAME NIL NIL NIL (AND VIEWER (LIST 'PROMPTWINDOW + (GETPROMPTWINDOW + VIEWER] + IMAGEOBJ READSKETCH) + (SETQ IMAGEOBJ (BIN TEXTSTREAM)) + (CLOSEF TEXTSTREAM) + (COND + ((NOT (IMAGEOBJP IMAGEOBJ)) + (STATUSPRINT (OR VIEWER PROMPTWINDOW) + FILENAME " is not a sketch file.") + (RETURN NIL))) + (COND + ([NOT (type? SKETCH (SETQ READSKETCH (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) + of (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM] + (STATUSPRINT (OR VIEWER PROMPTWINDOW) + FILENAME " is not a sketch file.") + (RETURN)) + (T (* ; + "save the name of where the sketch came from.") + (replace (SKETCH SKETCHNAME) of READSKETCH with (OR (GETTEXTPROP TEXTSTREAM + 'FILENAME) + FILENAME)) + (AND VIEWER (SK.CHANGE.GRID (fetch (SKETCHIMAGEOBJ SKIO.GRID) + of (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)) + VIEWER)) + (RETURN (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM]) + +(SK.GET.FROM.FILE + [LAMBDA (SKETCHW) (* rrb " 1-Oct-86 18:24") + + (* retrieves a sketch from a file clobbering any existing sketch.) + + (COND + ((SK.CONFIRM.DESTRUCTION SKETCHW "Press LEFT to delete current elements before GET.") + + (* put the delete on the history list so that it can be undone. + This leaves the gotten file there as well but seems better than nothing.) + + (SK.DELETE.ELEMENT2 (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH SKETCHW)) + SKETCHW) + (SK.INCLUDE.FILE SKETCHW)) + ((SK.CONFIRM.DESTRUCTION SKETCHW "Press LEFT to include file, RIGHT to abort the GET.") + (SK.INCLUDE.FILE SKETCHW)) + (T (STATUSPRINT SKETCHW "GET aborted. The INCLUDE subcommand to GET doesn't delete."]) + +(SKETCH.GET + [LAMBDA (FILENAME VIEWER) (* rrb "29-Jan-86 11:21") + (* reads a sketch from a file.) + (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) of (SK.GET.IMAGEOBJ.FROM.FILE FILENAME VIEWER]) ) (DEFINEQ @@ -343,14 +516,6 @@ To abort loading the new version of Sketch, type '^'."] (T (SKETCHW.CREATE SKETCH NIL (OR WINDOW (GETREGION)) NIL NIL T T]) -(SKETCH.FROM.A.FILE - [LAMBDA NIL (* rrb "24-Jun-86 11:40") - - (* reads a file name from the user and calls sketch on it.) - - (PROG ((NAME (PopUpWindowAndGetAtom "Sketch file name: "))) - (RETURN (AND NAME (SKETCH NAME]) - (SKETCHW.CREATE (LAMBDA (SKETCH SKETCHREGION SCREENREGION TITLE INITIALSCALE BRINGUPMENU INITIALGRID) (* ; "Edited 25-Apr-88 15:18 by drc:") (* ;;; "creates a sketch window and returns it.") (PROG (W SCALE SKPROC SKETCHSTRUCTURE) (SETQ SKETCHSTRUCTURE (SK.CHECK.SKETCH.VERSION (COND ((NULL SKETCH) (SKETCH.CREATE NIL)) ((LITATOM SKETCH) (* ; "treat it like a file name") (SKETCH.GET SKETCH)) ((type? SKETCH SKETCH) SKETCH) ((type? IMAGEOBJ SKETCH) (* ; "pull things out of the image object.") (SETQ SKPROC (IMAGEOBJPROP SKETCH (QUOTE OBJECTDATUM))) (OR (REGIONP SKETCHREGION) (SETQ SKETCHREGION (fetch (SKETCHIMAGEOBJ SKIO.REGION) of SKPROC))) (OR (NUMBERP INITIALSCALE) (SETQ INITIALSCALE (fetch (SKETCHIMAGEOBJ SKIO.SCALE) of SKPROC))) (OR (NUMBERP INITIALGRID) (SETQ INITIALGRID (fetch (SKETCHIMAGEOBJ SKIO.GRID) of SKPROC))) (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) of SKPROC)) ((AND (LITATOM (CAR SKETCH)) (for ELT in (CDR SKETCH) always (GLOBALELEMENTP ELT))) (* ; "old form, probably written out by notecards, update to new form.") (PROG (X) (SETQ X (SKIO.UPDATE.FROM.OLD.FORM SKETCH)) (* ; "smash sketch so this won't have to happen every time.") (RPLACA SKETCH (CAR X)) (RPLACD SKETCH (CDR X)) (RETURN X))) (T (\ILLEGAL.ARG SKETCH))))) (SETQ W (COND ((WINDOWP SCREENREGION) (AND TITLE (WINDOWPROP SCREENREGION (QUOTE TITLE) TITLE)) SCREENREGION) (T (CREATEW (COND ((REGIONP SCREENREGION)) (T (CREATEREGION LASTMOUSEX LASTMOUSEY 20 20))) (OR TITLE (SK.WINDOW.TITLE SKETCHSTRUCTURE)) NIL T)))) (SK.SET.UP.MENUS W (NOT (OPENWP SCREENREGION)) BRINGUPMENU) (COND ((OR (REGIONP SCREENREGION) (WINDOWP SCREENREGION)) (* ; "user gave a region, don't interact") NIL) (T (* ; "let prompting for reshape show room for both menu and window.") (SHAPEW W))) (* ;; "set the right margin so that text will never run into it. This can be removed when character positions are kept in points so \DSPPRINTCHAR doesn't have to look at the right margin.") (DSPRIGHTMARGIN 64000 W) (WINDOWPROP W (QUOTE SKETCH) SKETCHSTRUCTURE) (WINDOWPROP W (QUOTE SCALE) (SETQ SCALE (COND ((NUMBERP INITIALSCALE)) ((REGIONP SKETCHREGION) (* ; "determine the scale and offsets so that the given region of the sketch fits into the given window.") (FQUOTIENT (fetch (REGION HEIGHT) of SKETCHREGION) (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL W)))) ((NULL SKETCHREGION) INITIAL.SCALE) (T (\ILLEGAL.ARG SKETCHREGION))))) (* ; "check to make sure a context exists on the sketch because before July 1985 it didn't exist.") (WINDOWPROP W (QUOTE SKETCHCONTEXT) (OR (GETSKETCHPROP SKETCHSTRUCTURE (QUOTE SKETCHCONTEXT)) (PUTSKETCHPROP SKETCHSTRUCTURE (QUOTE SKETCHCONTEXT) (CREATE.DEFAULT.SKETCH.CONTEXT)))) (COND ((REGIONP SKETCHREGION) (* ; "if given a region, translate to it.") (WXOFFSET (IMINUS (FIX (QUOTIENT (fetch (REGION LEFT) of SKETCHREGION) SCALE))) W) (WYOFFSET (IMINUS (FIX (QUOTIENT (fetch (REGION BOTTOM) of SKETCHREGION) SCALE))) W))) (SK.UPDATE.REGION.VIEWED W) (* ; "calculate the sketch region being viewed before mapping the sketch into it.") (MAP.SKETCHSPEC.INTO.VIEWER SKETCHSTRUCTURE W) (SK.CREATE.HOTSPOT.CACHE W) (WINDOWPROP W (QUOTE GRIDFACTOR) (COND ((NUMBERP INITIALGRID) (LEASTPOWEROF2GT INITIALGRID)) (T (SK.DEFAULT.GRIDFACTOR W)))) (WINDOWPROP W (QUOTE USEGRID) (COND (INITIALGRID T))) (WINDOWPROP W (QUOTE BUTTONEVENTFN) (FUNCTION WB.BUTTON.HANDLER)) (WINDOWPROP W (QUOTE COPYBUTTONEVENTFN) (FUNCTION SK.COPY.BUTTONEVENTFN)) (WINDOWPROP W (QUOTE COPYINSERTFN) (FUNCTION SK.COPY.INSERTFN)) (WINDOWPROP W (QUOTE RIGHTBUTTONFN) (FUNCTION WB.BUTTON.HANDLER)) (WINDOWPROP W (QUOTE CURSOROUTFN) (FUNCTION SKETCHW.OUTFN)) (WINDOWPROP W (QUOTE REPAINTFN) (FUNCTION SKETCHW.REPAINTFN)) (WINDOWADDPROP W (QUOTE RESHAPEFN) (FUNCTION SKETCHW.RESHAPEFN)) (WINDOWADDPROP W (QUOTE SHRINKFN) (FUNCTION SK.RETURN.TTY)) (WINDOWPROP W (QUOTE ICONFN) (FUNCTION SK.SHRINK.ICONCREATE)) (WINDOWADDPROP W (QUOTE EXPANDFN) (FUNCTION SK.TAKE.TTY)) (WINDOWPROP W (QUOTE SCROLLFN) (FUNCTION SKETCHW.SCROLLFN)) (WINDOWPROP W (QUOTE HARDCOPYFN) (FUNCTION SKETCHW.HARDCOPYFN)) (* ; "I'm not sure why this ever gets called but it did once so to be sure, turn it off.") (WINDOWPROP W (QUOTE PAGEFULLFN) (FUNCTION NILL)) (WINDOWPROP W (QUOTE PROCESS) (SETQ SKPROC (ADD.PROCESS (LIST (FUNCTION WB.EDITOR) (KWOTE W)) (QUOTE RESTARTABLE) T (QUOTE TTYENTRYFN) (QUOTE SK.TTYENTRYFN) (QUOTE TTYEXITFN) (QUOTE SK.TTYEXITFN)))) (WINDOWPROP W (QUOTE SCROLLEXTENTUSE) T) (WINDOWADDPROP W (QUOTE CLOSEFN) (FUNCTION SKETCHW.CLOSEFN) T) (OPENW W) (ADD.SKETCH.VIEWER SKETCHSTRUCTURE W) (SKETCHW.REPAINTFN W) (RETURN W))) ) @@ -411,199 +576,6 @@ To abort loading the new version of Sketch, type '^'."] NIL NIL NIL NIL T 16.0) SLIDENAME]) -(SK.PUT.ON.FILE - [LAMBDA (SKETCHW) (* ; "Edited 6-Apr-87 18:18 by rrb") - (* saves a sketch on a Tedit file.) - - (* also changes the name of the sketch to be the same as the name of the file.) - - (PROG ((SKETCH (INSURE.SKETCH (SKETCH.FROM.VIEWER SKETCHW))) - NOWNAME NEWNAME TEXTSTREAM) - (SETQ NOWNAME (SKETCH.TITLE SKETCH)) - (OR [SETQ NEWNAME (MKATOM (PROMPT.GETINPUT SKETCHW "File to PUT to: " (SK.OUTPUT.FILE.NAME - NOWNAME] - (RETURN NIL)) - (SETQ NEWNAME (SKETCH.PUT NEWNAME SKETCH SKETCHW)) - [COND - ((AND NEWNAME (NEQ NOWNAME NEWNAME)) - - (* change the name of the sketch to be the same as the file name.) - - (replace (SKETCH SKETCHNAME) of SKETCH with NEWNAME) - (* change the titles of the viewers - onto this sketch.) - (for SKW in (ALL.SKETCH.VIEWERS SKETCH) do (WINDOWPROP SKW 'TITLE (SK.WINDOW.TITLE - SKETCH] - (RETURN NEWNAME]) - -(SK.OUTPUT.FILE.NAME - [LAMBDA (SKETCHFILENAME) (* ; "Edited 3-Nov-2025 15:05 by rmk") - (* rrb " 5-May-86 10:45") - (COND - ((STRPOS " " SKETCHFILENAME) (* ; - "don't put up dummy names that contain spaces") - NIL) - (T (PACKFILENAME 'VERSION NIL 'BODY SKETCHFILENAME]) - -(SKETCH.PUT - [LAMBDA (FILENAME SKETCH VIEWER REGION SCALE GRID) (* ; "Edited 1-Feb-2022 09:17 by rmk") - (* ; "Edited 17-Nov-87 17:47 by rrb") - - (* puts the sketch SKETCH on the file named FILENAME. - VIEWER if given provides promptwindows and PUTFNs.) - - (PROG (TEXTSTREAM FILESTREAM) - [COND - ((NOT (DEFINEDP (FUNCTION OPENTEXTSTREAM))) - (COND - ((MOUSECONFIRM "TEDIT must be loaded to save sketches." - "Click LEFT to load TEDIT now, RIGHT to abort.") - (FILESLOAD TEDIT)) - (T (STATUSPRINT VIEWER "Sketch not saved.") - (RETURN NIL] - [SETQ TEXTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (AND VIEWER (LIST 'PUTFN - (WINDOWPROP VIEWER - 'TEDIT.PUTFN) - 'PROMPTWINDOW - (GETPROMPTWINDOW VIEWER] - (* make a text stream with nothing in - it except the sketch.) - (TEDIT.INSERT.OBJECT [SKETCH.IMAGEOBJ (INSURE.SKETCH SKETCH) - (COND - ((REGIONP REGION)) - (VIEWER (SKETCH.REGION.VIEWED VIEWER))) - (COND - ((NUMBERP SCALE)) - (VIEWER (VIEWER.SCALE VIEWER))) - (COND - ((NUMBERP GRID)) - (VIEWER (SK.GRIDFACTOR VIEWER] - TEXTSTREAM 1) - - (* set the margins so that if the user hardcopies it directly the margins come - out) - - (TEDIT.PARALOOKS TEXTSTREAM '(LEFTMARGIN 0 RIGHTMARGIN 0 QUAD CENTER) - 1 1) - (TEDIT.PAGEFORMAT TEXTSTREAM (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 0 0 0 0)) - (* save the stream so that it can be - closed.) - (SETQ FILESTREAM (TEDIT.PUT TEXTSTREAM FILENAME)) (* grab the full file name if it is - available.) - (AND (OPENP FILESTREAM) - (SETQ FILENAME (CLOSEF FILESTREAM))) - (SK.MARK.UNDIRTY SKETCH) - (RETURN FILENAME]) - -(SK.GET.FROM.FILE - [LAMBDA (SKETCHW) (* rrb " 1-Oct-86 18:24") - - (* retrieves a sketch from a file clobbering any existing sketch.) - - (COND - ((SK.CONFIRM.DESTRUCTION SKETCHW "Press LEFT to delete current elements before GET.") - - (* put the delete on the history list so that it can be undone. - This leaves the gotten file there as well but seems better than nothing.) - - (SK.DELETE.ELEMENT2 (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH SKETCHW)) - SKETCHW) - (SK.INCLUDE.FILE SKETCHW)) - ((SK.CONFIRM.DESTRUCTION SKETCHW "Press LEFT to include file, RIGHT to abort the GET.") - (SK.INCLUDE.FILE SKETCHW)) - (T (STATUSPRINT SKETCHW "GET aborted. The INCLUDE subcommand to GET doesn't delete."]) - -(SK.INCLUDE.FILE - [LAMBDA (SKETCHW) (* rrb " 2-May-86 11:29") - - (* retrieves a sketch from a file and includes it into the existing sketch.) - - (* also changes the name of the sketch to be the same as the name of the file.) - - (PROG ((SKETCH (SKETCH.FROM.VIEWER SKETCHW)) - NOWNAME FILENAME READSKETCH DIRTYSTATUS) - (SETQ NOWNAME (fetch (SKETCH SKETCHNAME) of SKETCH)) - (SETQ FILENAME (MKATOM (PROMPT.GETINPUT SKETCHW "File to GET: "))) - (COND - ((MEMB FILENAME '(NIL %])) - (CLOSEPROMPTWINDOW SKETCHW) - (RETURN))) - (STATUSPRINT SKETCHW " ...") - (SETQ FILENAME (OR (INFILEP FILENAME) - (ERROR FILENAME "file not found."))) - (OR (SETQ READSKETCH (SKETCH.GET FILENAME SKETCHW)) - (RETURN)) - [COND - ((NEQ NOWNAME FILENAME) - - (* change the name of the sketch to be the same as the file name.) - - (replace (SKETCH SKETCHNAME) of SKETCH with FILENAME) - - (* change the name of the sketch to be the same as the file name.) - - (for SKW in (ALL.SKETCH.VIEWERS SKETCH) do (WINDOWPROP SKW 'TITLE (SK.WINDOW.TITLE - SKETCH] - (ADD.SKETCH.TO.VIEWER READSKETCH SKETCHW (COND - ((fetch (SKETCH SKETCHELTS) of SKETCH) - - (* if the sketch has elements, ask about the defaults from the read file and - set the status to leave the sketch marked dirty after the read.) - - (SETQ DIRTYSTATUS T) - 'ASK) - (T - - (* if the sketch doesn't have any elements, use the defaults from the read file - and set the status to leave the sketch marked clean after the read.) - - NIL))) - (COND - ((NULL DIRTYSTATUS) - - (* if sketch was empty before, mark it as not needing to be dumped.) - - (SK.MARK.UNDIRTY SKETCH))) - (STATUSPRINT SKETCHW " done."]) - -(SK.GET.IMAGEOBJ.FROM.FILE - [LAMBDA (FILENAME VIEWER) (* ; "Edited 12-Feb-88 14:13 by rrb") - (* reads the sketch image object - datum from a file.) - (RESETFORM (CURSOR WAITINGCURSOR) - (PROG ([TEXTSTREAM (OPENTEXTSTREAM FILENAME NIL NIL NIL (AND VIEWER (LIST 'PROMPTWINDOW - (GETPROMPTWINDOW - VIEWER] - (READFILE (INFILEP FILENAME)) - IMAGEOBJ READSKETCH) - (SETQ IMAGEOBJ (BIN TEXTSTREAM)) - (CLOSEF TEXTSTREAM) - (COND - ((NOT (IMAGEOBJP IMAGEOBJ)) - (STATUSPRINT (OR VIEWER PROMPTWINDOW) - FILENAME " is not a sketch file.") - (RETURN NIL))) - (COND - ([NOT (type? SKETCH (SETQ READSKETCH (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) - of (IMAGEOBJPROP IMAGEOBJ - 'OBJECTDATUM] - (STATUSPRINT (OR VIEWER PROMPTWINDOW) - FILENAME " is not a sketch file.") - (RETURN)) - (T (* save the name of where the sketch - came from.) - (replace (SKETCH SKETCHNAME) of READSKETCH with (OR READFILE - FILENAME)) - (AND VIEWER (SK.CHANGE.GRID (fetch (SKETCHIMAGEOBJ SKIO.GRID) - of (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)) - VIEWER)) - (RETURN (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM]) - -(SKETCH.GET - [LAMBDA (FILENAME VIEWER) (* rrb "29-Jan-86 11:21") - (* reads a sketch from a file.) - (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) of (SK.GET.IMAGEOBJ.FROM.FILE FILENAME VIEWER]) - (ADD.SKETCH.TO.VIEWER [LAMBDA (SKETCHTOADD VIEWER ABOUTDEFAULTS?) (* rrb "20-Mar-86 15:55") (* adds the element in SKETCHTOADD to @@ -8789,150 +8761,151 @@ Otherwise, type '^'.") (ADDTOVAR LAMA SK.UNIONREGIONS SKETCH.CREATE) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (21911 85500 (SKETCH 21921 . 24026) (SKETCH.FROM.A.FILE 24028 . 24343) (SKETCHW.CREATE -24345 . 28919) (SKETCH.RESET 28921 . 30443) (SKETCHW.FIG.CHANGED 30445 . 30785) (SK.WINDOW.TITLE 30787 - . 31174) (EDITSLIDE 31176 . 31582) (EDITSKETCH 31584 . 31908) (SK.PUT.ON.FILE 31910 . 33362) ( -SK.OUTPUT.FILE.NAME 33364 . 33849) (SKETCH.PUT 33851 . 36749) (SK.GET.FROM.FILE 36751 . 37644) ( -SK.INCLUDE.FILE 37646 . 40154) (SK.GET.IMAGEOBJ.FROM.FILE 40156 . 42359) (SKETCH.GET 42361 . 42668) ( -ADD.SKETCH.TO.VIEWER 42670 . 45256) (SK.ADD.ELEMENTS.TO.SKETCH 45258 . 45772) (SKETCH.SET.A.DEFAULT -45774 . 53325) (SK.POPUP.SELECTIONFN 53327 . 53869) (GETSKETCHWREGION 53871 . 54077) (SK.ADD.ELEMENT -54079 . 55658) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH 55660 . 57054) (SK.ELTS.BY.PRIORITY 57056 . 57352) ( -SK.ORDER.ELEMENTS 57354 . 57621) (SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57623 . 59117) ( -SK.ADD.ELEMENTS 59119 . 59643) (SK.CHECK.WHENADDEDFN 59645 . 60375) (SK.APPLY.MENU.COMMAND 60377 . -61175) (SK.DELETE.ELEMENT1 61177 . 62755) (SK.MARK.DIRTY 62757 . 63423) (SK.MARK.UNDIRTY 63425 . 63756 -) (SK.MENU.AND.RETURN.FIELD 63758 . 64423) (SKETCH.SET.BRUSH.SHAPE 64425 . 65010) ( -SKETCH.SET.BRUSH.SIZE 65012 . 65518) (SKETCHW.CLOSEFN 65520 . 67311) (SK.CONFIRM.DESTRUCTION 67313 . -68312) (SKETCHW.OUTFN 68314 . 68578) (SKETCHW.REOPENFN 68580 . 68992) (MAKE.LOCAL.SKETCH 68994 . 69724 -) (MAP.SKETCHSPEC.INTO.VIEWER 69726 . 70936) (SKETCHW.REPAINTFN 70938 . 71766) (SKETCHW.REPAINTFN1 -71768 . 72707) (SK.DRAWFIGURE.IF 72709 . 73231) (SKETCHW.SCROLLFN 73233 . 77426) (SKETCHW.RESHAPEFN -77428 . 79686) (SK.UPDATE.EVENT.SELECTION 79688 . 81743) (LIGHTGRAYWINDOW 81745 . 81908) ( -SK.ADD.SPACES 81910 . 82656) (SK.SKETCH.MENU 82658 . 82980) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 82982 . -83834) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83836 . 84796) (SK.RETURN.TTY 84798 . 85166) (SK.TAKE.TTY -85168 . 85498)) (85554 108969 (SKETCH.COMMANDMENU 85564 . 85988) (SKETCH.COMMANDMENU.ITEMS 85990 . -106073) (CREATE.SKETCHW.COMMANDMENU 106075 . 106495) (SKETCHW.SELECTIONFN 106497 . 107600) ( -SKETCH.MONITORLOCK 107602 . 108073) (SK.EVAL.AS.PROCESS 108075 . 108688) (SK.EVAL.WITH.LOCK 108690 . -108967)) (108970 116774 (SK.FIX.MENU 108980 . 110074) (SK.SET.UP.MENUS 110076 . 112377) ( -SK.INSURE.HAS.MENU 112379 . 113041) (SK.CREATE.STANDARD.MENU 113043 . 113488) (SK.ADD.ITEM.TO.MENU -113490 . 114165) (SK.GET.VIEWER.POPUP.MENU 114167 . 116368) (SK.CLEAR.POPUP.MENU 116370 . 116772)) ( -116830 125652 (SKETCH.CREATE 116840 . 117626) (GETSKETCHPROP 117628 . 120685) (PUTSKETCHPROP 120687 . -124619) (CREATE.DEFAULT.SKETCH.CONTEXT 124621 . 125650)) (125818 148714 (SK.COPY.BUTTONEVENTFN 125828 - . 137056) (SK.BUTTONEVENT.MARK 137058 . 137441) (SK.BUILD.IMAGEOBJ 137443 . 147358) ( -SK.BUTTONEVENT.OVERP 147360 . 147983) (SK.BUTTONEVENT.SAME.KEYS 147985 . 148712)) (148993 174808 ( -SK.SEL.AND.CHANGE 149003 . 149295) (SK.CHECK.WHENCHANGEDFN 149297 . 150003) (SK.CHECK.PRECHANGEFN -150005 . 150606) (SK.CHANGE.ELT 150608 . 150800) (SK.CHANGE.THING 150802 . 152053) ( -SKETCH.CHANGE.ELEMENTS 152055 . 153238) (SK.APPLY.SINGLE.CHANGEFN 153240 . 153813) (SK.DO.CHANGESPECS -153815 . 155474) (SK.VIEWER.FROM.SKETCH.ARG 155476 . 155918) (SK.DO.CHANGESPEC1 155920 . 157795) ( -SK.CHANGEFN 157797 . 158377) (SK.READCHANGEFN 158379 . 158838) (SK.DEFAULT.CHANGEFN 158840 . 161312) ( -CHANGEABLEFIELDITEMS 161314 . 161961) (SK.APPLY.CHANGE.COMMAND 161963 . 162580) ( -SK.DO.AND.RECORD.CHANGES 162582 . 163979) (SK.APPLY.CHANGE.COMMAND1 163981 . 165469) ( -SK.ELEMENTS.CHANGEFN 165471 . 167795) (READ.POINT.TO.ADD 167797 . 168741) (GLOBAL.KNOT.FROM.LOCAL -168743 . 169203) (SK.ADD.KNOT.TO.ELEMENT 169205 . 170149) (SK.GROUP.CHANGEFN 170151 . 171363) ( -SK.GROUP.CHANGEFN1 171365 . 174806)) (174975 188708 (ADD.ELEMENT.TO.SKETCH 174985 . 176691) ( -ADD.SKETCH.VIEWER 176693 . 177361) (REMOVE.SKETCH.VIEWER 177363 . 177976) (ALL.SKETCH.VIEWERS 177978 - . 178218) (SKETCH.ALL.VIEWERS 178220 . 178480) (VIEWER.BUCKET 178482 . 178633) (ELT.INSIDE.REGION? -178635 . 178962) (ELT.INSIDE.SKWP 178964 . 179255) (SCALE.FROM.SKW 179257 . 179507) ( -SK.ADDELT.TO.WINDOW 179509 . 180369) (SK.CALC.REGION.VIEWED 180371 . 180749) (SK.DRAWFIGURE 180751 . -182040) (SK.DRAWFIGURE1 182042 . 182426) (SK.LOCAL.FROM.GLOBAL 182428 . 183663) (SKETCH.REGION.VIEWED -183665 . 186352) (SKETCH.VIEW.FROM.NAME 186354 . 186784) (SK.UPDATE.REGION.VIEWED 186786 . 187178) ( -SKETCH.ADD.AND.DISPLAY 187180 . 187588) (SKETCH.ADD.AND.DISPLAY1 187590 . 188028) (SK.ADD.ITEM 188030 - . 188362) (SKETCHW.ADD.INSTANCE 188364 . 188706)) (188749 201937 (SK.SEL.AND.DELETE 188759 . 189147) -(SK.ERASE.AND.DELETE.ITEM 189149 . 189568) (REMOVE.ELEMENT.FROM.SKETCH 189570 . 190681) ( -SK.DELETE.ELEMENT 190683 . 191241) (SK.DELETE.ELEMENT2 191243 . 191904) (SK.DELETE.KNOT 191906 . -192197) (SK.SEL.AND.DELETE.KNOT 192199 . 193324) (SK.DELETE.ELEMENT.KNOT 193326 . 196533) ( -SK.CHECK.WHENDELETEDFN 196535 . 197315) (SK.CHECK.PREEDITFN 197317 . 197801) ( -SK.CHECK.END.INITIAL.EDIT 197803 . 198337) (SK.CHECK.WHENPOINTDELETEDFN 198339 . 199135) (SK.ERASE.ELT - 199137 . 199473) (SK.DELETE.ELT 199475 . 199850) (SK.DELETE.ITEM 199852 . 200260) (DELFROMTCONC -200262 . 201935)) (201976 215810 (SK.COPY.ELT 201986 . 202356) (SK.SEL.AND.COPY 202358 . 202741) ( -SK.COPY.ELEMENTS 202743 . 208371) (SK.ADD.COPY.OF.ELEMENTS 208373 . 210140) ( -SK.GLOBAL.FROM.LOCAL.ELEMENTS 210142 . 210382) (SK.COPY.ITEM 210384 . 211181) (SK.INSERT.SKETCH 211183 - . 215808)) (215850 245871 (SK.MOVE.ELT 215860 . 216135) (SK.MOVE.ELT.OR.PT 216137 . 216450) ( -SK.APPLY.DEFAULT.MOVE 216452 . 216886) (SK.SEL.AND.MOVE 216888 . 217435) (SK.MOVE.ELEMENTS 217437 . -228309) (SKETCH.MOVE.ELEMENTS 228311 . 230242) (SKETCH.COPY.ELEMENTS 230244 . 232291) ( -\SKETCH.COPY.ELEMENT 232293 . 233018) (SK.TRANSLATE.ELEMENT 233020 . 233503) (SK.COPY.GLOBAL.ELEMENT -233505 . 233716) (SK.MAKE.ELEMENT.MOVE.ARG 233718 . 234338) (SK.MAKE.ELEMENTS.MOVE.ARG 234340 . 234862 -) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234864 . 235933) (SK.SHOW.FIG.FROM.INFO 235935 . 236303) ( -SK.MOVE.THING 236305 . 237211) (UPDATE.ELEMENT.IN.SKETCH 237213 . 239268) (SK.UPDATE.ELEMENT 239270 . -240829) (SK.UPDATE.ELEMENTS 240831 . 241550) (SK.UPDATE.ELEMENT1 241552 . 245452) ( -SK.MOVE.ELEMENT.POINT 245454 . 245869)) (245934 268223 (SK.MOVE.POINTS 245944 . 246231) ( -SK.SEL.AND.MOVE.POINTS 246233 . 246538) (SK.DO.MOVE.ELEMENT.POINTS 246540 . 255197) ( -SK.MOVE.ITEM.POINTS 255199 . 256870) (SK.TRANSLATEPTSFN 256872 . 257256) (SK.TRANSLATE.POINTS 257258 - . 258159) (SK.SELECT.MULTIPLE.POINTS 258161 . 263801) (SK.CONTROL.POINTS.IN.REGION 263803 . 265224) ( -SK.ADD.PT.SELECTION 265226 . 265690) (SK.REMOVE.PT.SELECTION 265692 . 266309) (SK.ADD.POINT 266311 . -266934) (SK.ELTS.CONTAINING.PTS 266936 . 267561) (SK.HOTSPOTS.NOT.ON.LIST 267563 . 268221)) (268381 -271177 (SK.SET.MOVE.MODE 268391 . 269062) (SK.SET.MOVE.MODE.POINTS 269064 . 269403) ( -SK.SET.MOVE.MODE.ELEMENTS 269405 . 269749) (SK.SET.MOVE.MODE.COMBINED 269751 . 270101) (READMOVEMODE -270103 . 271175)) (271178 289933 (SK.ALIGN.POINTS 271188 . 271478) (SK.SEL.AND.ALIGN.POINTS 271480 . -271789) (SK.ALIGN.POINTS.LEFT 271791 . 272094) (SK.ALIGN.POINTS.RIGHT 272096 . 272401) ( -SK.ALIGN.POINTS.TOP 272403 . 272704) (SK.ALIGN.POINTS.BOTTOM 272706 . 273013) ( -SK.EVEN.SPACE.POINTS.IN.X 273015 . 273335) (SK.EVEN.SPACE.POINTS.IN.Y 273337 . 273657) ( -SK.DO.ALIGN.POINTS 273659 . 284281) (SK.NTH.CONTROL.POINT 284283 . 284744) ( -SK.GET.SELECTED.ELEMENT.STRUCTURE 284746 . 285412) (SK.CORRESPONDING.CONTROL.PT 285414 . 285968) ( -SK.CONTROL.POINT.NUMBER 285970 . 286340) (SK.DO.ALIGN.SETVALUE 286342 . 289931)) (289997 303429 ( -SKETCH.CREATE.GROUP 290007 . 290496) (SK.CREATE.GROUP1 290498 . 291045) (SK.UPDATE.GROUP.AFTER.CHANGE -291047 . 291836) (SK.GROUP.ELTS 291838 . 292119) (SK.SEL.AND.GROUP 292121 . 292507) (SK.GROUP.ELEMENTS - 292509 . 294158) (SK.UNGROUP.ELT 294160 . 294444) (SK.SEL.AND.UNGROUP 294446 . 296115) ( -SK.UNGROUP.ELEMENT 296117 . 297053) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 297055 . 297977) ( -SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297979 . 298990) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298992 . -300332) (SK.UNIONREGIONS 300334 . 302700) (SKETCH.REGION.OF.SKETCH 302702 . 303118) (SK.FLASHREGION -303120 . 303427)) (303430 316901 (INIT.GROUP.ELEMENT 303440 . 304312) (GROUP.DRAWFN 304314 . 304764) ( -GROUP.EXPANDFN 304766 . 306329) (GROUP.INSIDEFN 306331 . 306740) (GROUP.REGIONFN 306742 . 307137) ( -GROUP.GLOBALREGIONFN 307139 . 307457) (GROUP.TRANSLATEFN 307459 . 309491) (GROUP.TRANSFORMFN 309493 . -312973) (GROUP.READCHANGEFN 312975 . 316899)) (316902 317910 (REGION.CENTER 316912 . 317513) ( -REMOVE.LAST 317515 . 317908)) (317963 323070 (SK.MOVE.GROUP.CONTROL.PT 317973 . 318264) ( -SK.SEL.AND.MOVE.CONTROL.PT 318266 . 319670) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319672 . 321745) ( -SK.READ.NEW.GROUP.CONTROL.PT 321747 . 323068)) (323329 327953 (SK.DO.GROUP 323339 . 324791) ( -SK.CHECK.WHENGROUPEDFN 324793 . 325503) (SK.DO.UNGROUP 325505 . 326710) (SK.CHECK.WHENUNGROUPEDFN -326712 . 327299) (SK.GROUP.UNDO 327301 . 327624) (SK.UNGROUP.UNDO 327626 . 327951)) (328194 333116 ( -SK.FREEZE.ELTS 328204 . 328488) (SK.SEL.AND.FREEZE 328490 . 328880) (SK.FREEZE.ELEMENTS 328882 . -329433) (SK.UNFREEZE.ELT 329435 . 329724) (SK.SEL.AND.UNFREEZE 329726 . 331262) (SK.UNFREEZE.ELEMENTS -331264 . 331823) (SK.FREEZE.UNDO 331825 . 332070) (SK.UNFREEZE.UNDO 332072 . 332319) (SK.DO.FREEZE -332321 . 332714) (SK.DO.UNFREEZE 332716 . 333114)) (333346 343156 (SKETCH.ELEMENTS.OF.SKETCH 333356 . -334191) (SKETCH.LIST.OF.ELEMENTS 334193 . 334911) (SKETCH.ADD.ELEMENT 334913 . 335988) ( -SKETCH.DELETE.ELEMENT 335990 . 337722) (DELFROMGROUPELT 337724 . 338524) (SKETCH.ELEMENT.TYPE 338526 - . 338875) (SKETCH.ELEMENT.CHANGED 338877 . 340445) (SK.ELEMENT.CHANGED1 340447 . 341098) ( -SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 341100 . 343154)) (343210 347822 (INSURE.SKETCH 343220 . 345835) - (LOCALSPECS.FROM.VIEWER 345837 . 346197) (SK.LOCAL.ELT.FROM.GLOBALPART 346199 . 346667) ( -SKETCH.FROM.VIEWER 346669 . 346903) (INSPECT.SKETCH 346905 . 347230) (ELT.INSIDE.SKETCHWP 347232 . -347505) (SK.INSIDE.REGION 347507 . 347820)) (347823 352153 (MAPSKETCHSPECS 347833 . 348454) ( -MAPCOLLECTSKETCHSPECS 348456 . 349205) (MAPSKETCHSPECSUNTIL 349207 . 350015) (MAPGLOBALSKETCHSPECS -350017 . 350718) (MAPGLOBALSKETCHELEMENTS 350720 . 352151)) (352215 378107 (SK.ADD.SELECTION 352225 . -352965) (SK.COPY.INSERTFN 352967 . 356598) (SCREENELEMENTP 356600 . 357073) (SK.ITEM.REGION 357075 . -357562) (SK.ELEMENT.GLOBAL.REGION 357564 . 358092) (SK.LOCAL.ITEMS.IN.REGION 358094 . 360073) ( -SK.REGIONFN 360075 . 360397) (SK.GLOBAL.REGIONFN 360399 . 360757) (SK.REMOVE.SELECTION 360759 . 361487 -) (SK.SELECT.MULTIPLE.ITEMS 361489 . 371931) (SKETCH.GET.ELEMENTS 371933 . 373356) (SK.PUT.MARKS.UP -373358 . 373697) (SK.TAKE.MARKS.DOWN 373699 . 374038) (SK.TRANSLATE.GLOBALPART 374040 . 376167) ( -SK.TRANSLATE.ITEM 376169 . 377096) (SK.TRANSLATEFN 377098 . 377294) (TRANSLATE.SKETCH 377296 . 378105) -) (378373 381280 (SK.INPUT.SCALE 378383 . 379230) (SK.UPDATE.SKETCHCONTEXT 379232 . 379829) ( -SK.SET.INPUT.SCALE 379831 . 380480) (SK.SET.INPUT.SCALE.CURRENT 380482 . 380773) ( -SK.SET.INPUT.SCALE.VALUE 380775 . 381278)) (381331 383243 (SK.SET.FEEDBACK.MODE 381341 . 382647) ( -SK.SET.FEEDBACK.POINT 382649 . 382817) (SK.SET.FEEDBACK.VERBOSE 382819 . 382988) ( -SK.SET.FEEDBACK.ALWAYS 382990 . 383241)) (383394 384772 (SKETCH.TITLE 383404 . 383768) ( -SK.SHRINK.ICONCREATE 383770 . 384770)) (390462 393276 (READBRUSHSHAPE 390472 . 390931) (READ.FUNCTION -390933 . 391448) (READBRUSHSIZE 391450 . 391908) (READANGLE 391910 . 392402) (READARCDIRECTION 392404 - . 393274)) (393277 403688 (SK.CHANGE.DASHING 393287 . 397235) (READ.AND.SAVE.NEW.DASHING 397237 . -399005) (READ.NEW.DASHING 399007 . 400747) (READ.DASHING.CHANGE 400749 . 402224) (SK.CACHE.DASHING -402226 . 403228) (SK.DASHING.LABEL 403230 . 403686)) (403689 407394 (READ.FILLING.CHANGE 403699 . -405680) (SK.CACHE.FILLING 405682 . 406400) (READ.AND.SAVE.NEW.FILLING 406402 . 407000) ( -SK.FILLING.LABEL 407002 . 407392)) (407778 444031 (SK.GETGLOBALPOSITION 407788 . 408093) ( -SKETCH.TRACK.ELEMENTS 408095 . 411615) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411617 . 412176) ( -MAP.SKETCH.ELEMENTS.INTO.VIEWER 412178 . 412570) (MAP.GLOBAL.POSITION.INTO.VIEWER 412572 . 412952) ( -SKETCH.TO.VIEWER.POSITION 412954 . 413313) (SKETCH.TRACK.IMAGE 413315 . 414169) (SK.TRACK.IMAGE1 -414171 . 415583) (MAP.VIEWER.XY.INTO.GLOBAL 415585 . 416579) (SK.SET.POSITION 416581 . 416917) ( -MAP.VIEWER.PT.INTO.GLOBAL 416919 . 418025) (VIEWER.TO.SKETCH.POSITION 418027 . 418662) ( -SK.INSURE.SCALE 418664 . 418924) (SKETCH.TO.VIEWER.REGION 418926 . 419732) (VIEWER.TO.SKETCH.REGION -419734 . 420072) (SK.READ.POINT.WITH.FEEDBACK 420074 . 431077) (SKETCH.GET.POSITION 431079 . 432959) ( -\CLOBBER.POSITION 432961 . 433409) (NEAREST.HOT.SPOT 433411 . 434939) (GETWREGION 434941 . 435702) ( -GET.BITMAP.POSITION 435704 . 436488) (SK.TRACK.BITMAP1 436490 . 444029)) (444600 475486 ( -SK.BRING.UP.POSITION.PAD 444610 . 450470) (SK.PAD.READER.POSITION 450472 . 452121) ( -SK.POSITION.READER.REPAINTFN 452123 . 453907) (SK.POSITION.PAD.FROM.VIEWER 453909 . 455251) ( -SK.INIT.POSITION.NUMBER.PAD.MENU 455253 . 455603) (SK.READ.POSITION.PAD.HANDLER 455605 . 461337) ( -DISPLAY.POSITION.READER.TOTAL 461339 . 463637) (POSITION.PAD.READER.HANDLER 463639 . 471682) ( -POSITIONPAD.HELDFN 471684 . 473168) (\POSITION.PAD.ADD.DIGIT.MENU 473170 . 474749) ( -\POSITION.READER.NUMBERPAD 474751 . 475484)) (477112 479790 (SK.DRAWFN 477122 . 477488) ( -SK.TRANSFORMFN 477490 . 477871) (SK.EXPANDFN 477873 . 478150) (SK.INPUT 478152 . 478533) (SK.INSIDEFN -478535 . 479175) (SK.UPDATEFN 479177 . 479788)) (484955 487111 (UPDATE-SKETCH 484965 . 486078) ( -EDIT-SKETCH 486080 . 487109)) (487712 491657 (SK.CHECK.SKETCH.VERSION 487722 . 488962) ( -SK.INSURE.RECORD.LENGTH 488964 . 490447) (SK.INSURE.HAS.LENGTH 490449 . 491187) (SK.RECORD.LENGTH -491189 . 491363) (SK.SET.RECORD.LENGTHS 491365 . 491655)) (492120 493007 ( -SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 492130 . 493005))))) + (FILEMAP (NIL (18222 20092 (SKETCH.FLUSH.EXISTING 18232 . 20090)) (20202 31352 (SKETCH.FROM.A.FILE +20212 . 20527) (SK.PUT.ON.FILE 20529 . 21981) (SKETCH.PUT 21983 . 24626) (SK.OUTPUT.FILE.NAME 24628 . +25113) (SK.INCLUDE.FILE 25115 . 27981) (SK.GET.IMAGEOBJ.FROM.FILE 27983 . 30146) (SK.GET.FROM.FILE +30148 . 31041) (SKETCH.GET 31043 . 31350)) (31353 83865 (SKETCH 31363 . 33468) (SKETCHW.CREATE 33470 + . 38044) (SKETCH.RESET 38046 . 39568) (SKETCHW.FIG.CHANGED 39570 . 39910) (SK.WINDOW.TITLE 39912 . +40299) (EDITSLIDE 40301 . 40707) (EDITSKETCH 40709 . 41033) (ADD.SKETCH.TO.VIEWER 41035 . 43621) ( +SK.ADD.ELEMENTS.TO.SKETCH 43623 . 44137) (SKETCH.SET.A.DEFAULT 44139 . 51690) (SK.POPUP.SELECTIONFN +51692 . 52234) (GETSKETCHWREGION 52236 . 52442) (SK.ADD.ELEMENT 52444 . 54023) ( +SK.ADD.PRIORITY.ELEMENT.TO.SKETCH 54025 . 55419) (SK.ELTS.BY.PRIORITY 55421 . 55717) ( +SK.ORDER.ELEMENTS 55719 . 55986) (SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 55988 . 57482) ( +SK.ADD.ELEMENTS 57484 . 58008) (SK.CHECK.WHENADDEDFN 58010 . 58740) (SK.APPLY.MENU.COMMAND 58742 . +59540) (SK.DELETE.ELEMENT1 59542 . 61120) (SK.MARK.DIRTY 61122 . 61788) (SK.MARK.UNDIRTY 61790 . 62121 +) (SK.MENU.AND.RETURN.FIELD 62123 . 62788) (SKETCH.SET.BRUSH.SHAPE 62790 . 63375) ( +SKETCH.SET.BRUSH.SIZE 63377 . 63883) (SKETCHW.CLOSEFN 63885 . 65676) (SK.CONFIRM.DESTRUCTION 65678 . +66677) (SKETCHW.OUTFN 66679 . 66943) (SKETCHW.REOPENFN 66945 . 67357) (MAKE.LOCAL.SKETCH 67359 . 68089 +) (MAP.SKETCHSPEC.INTO.VIEWER 68091 . 69301) (SKETCHW.REPAINTFN 69303 . 70131) (SKETCHW.REPAINTFN1 +70133 . 71072) (SK.DRAWFIGURE.IF 71074 . 71596) (SKETCHW.SCROLLFN 71598 . 75791) (SKETCHW.RESHAPEFN +75793 . 78051) (SK.UPDATE.EVENT.SELECTION 78053 . 80108) (LIGHTGRAYWINDOW 80110 . 80273) ( +SK.ADD.SPACES 80275 . 81021) (SK.SKETCH.MENU 81023 . 81345) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 81347 . +82199) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 82201 . 83161) (SK.RETURN.TTY 83163 . 83531) (SK.TAKE.TTY +83533 . 83863)) (83919 107334 (SKETCH.COMMANDMENU 83929 . 84353) (SKETCH.COMMANDMENU.ITEMS 84355 . +104438) (CREATE.SKETCHW.COMMANDMENU 104440 . 104860) (SKETCHW.SELECTIONFN 104862 . 105965) ( +SKETCH.MONITORLOCK 105967 . 106438) (SK.EVAL.AS.PROCESS 106440 . 107053) (SK.EVAL.WITH.LOCK 107055 . +107332)) (107335 115139 (SK.FIX.MENU 107345 . 108439) (SK.SET.UP.MENUS 108441 . 110742) ( +SK.INSURE.HAS.MENU 110744 . 111406) (SK.CREATE.STANDARD.MENU 111408 . 111853) (SK.ADD.ITEM.TO.MENU +111855 . 112530) (SK.GET.VIEWER.POPUP.MENU 112532 . 114733) (SK.CLEAR.POPUP.MENU 114735 . 115137)) ( +115195 124017 (SKETCH.CREATE 115205 . 115991) (GETSKETCHPROP 115993 . 119050) (PUTSKETCHPROP 119052 . +122984) (CREATE.DEFAULT.SKETCH.CONTEXT 122986 . 124015)) (124183 147079 (SK.COPY.BUTTONEVENTFN 124193 + . 135421) (SK.BUTTONEVENT.MARK 135423 . 135806) (SK.BUILD.IMAGEOBJ 135808 . 145723) ( +SK.BUTTONEVENT.OVERP 145725 . 146348) (SK.BUTTONEVENT.SAME.KEYS 146350 . 147077)) (147358 173173 ( +SK.SEL.AND.CHANGE 147368 . 147660) (SK.CHECK.WHENCHANGEDFN 147662 . 148368) (SK.CHECK.PRECHANGEFN +148370 . 148971) (SK.CHANGE.ELT 148973 . 149165) (SK.CHANGE.THING 149167 . 150418) ( +SKETCH.CHANGE.ELEMENTS 150420 . 151603) (SK.APPLY.SINGLE.CHANGEFN 151605 . 152178) (SK.DO.CHANGESPECS +152180 . 153839) (SK.VIEWER.FROM.SKETCH.ARG 153841 . 154283) (SK.DO.CHANGESPEC1 154285 . 156160) ( +SK.CHANGEFN 156162 . 156742) (SK.READCHANGEFN 156744 . 157203) (SK.DEFAULT.CHANGEFN 157205 . 159677) ( +CHANGEABLEFIELDITEMS 159679 . 160326) (SK.APPLY.CHANGE.COMMAND 160328 . 160945) ( +SK.DO.AND.RECORD.CHANGES 160947 . 162344) (SK.APPLY.CHANGE.COMMAND1 162346 . 163834) ( +SK.ELEMENTS.CHANGEFN 163836 . 166160) (READ.POINT.TO.ADD 166162 . 167106) (GLOBAL.KNOT.FROM.LOCAL +167108 . 167568) (SK.ADD.KNOT.TO.ELEMENT 167570 . 168514) (SK.GROUP.CHANGEFN 168516 . 169728) ( +SK.GROUP.CHANGEFN1 169730 . 173171)) (173340 187073 (ADD.ELEMENT.TO.SKETCH 173350 . 175056) ( +ADD.SKETCH.VIEWER 175058 . 175726) (REMOVE.SKETCH.VIEWER 175728 . 176341) (ALL.SKETCH.VIEWERS 176343 + . 176583) (SKETCH.ALL.VIEWERS 176585 . 176845) (VIEWER.BUCKET 176847 . 176998) (ELT.INSIDE.REGION? +177000 . 177327) (ELT.INSIDE.SKWP 177329 . 177620) (SCALE.FROM.SKW 177622 . 177872) ( +SK.ADDELT.TO.WINDOW 177874 . 178734) (SK.CALC.REGION.VIEWED 178736 . 179114) (SK.DRAWFIGURE 179116 . +180405) (SK.DRAWFIGURE1 180407 . 180791) (SK.LOCAL.FROM.GLOBAL 180793 . 182028) (SKETCH.REGION.VIEWED +182030 . 184717) (SKETCH.VIEW.FROM.NAME 184719 . 185149) (SK.UPDATE.REGION.VIEWED 185151 . 185543) ( +SKETCH.ADD.AND.DISPLAY 185545 . 185953) (SKETCH.ADD.AND.DISPLAY1 185955 . 186393) (SK.ADD.ITEM 186395 + . 186727) (SKETCHW.ADD.INSTANCE 186729 . 187071)) (187114 200302 (SK.SEL.AND.DELETE 187124 . 187512) +(SK.ERASE.AND.DELETE.ITEM 187514 . 187933) (REMOVE.ELEMENT.FROM.SKETCH 187935 . 189046) ( +SK.DELETE.ELEMENT 189048 . 189606) (SK.DELETE.ELEMENT2 189608 . 190269) (SK.DELETE.KNOT 190271 . +190562) (SK.SEL.AND.DELETE.KNOT 190564 . 191689) (SK.DELETE.ELEMENT.KNOT 191691 . 194898) ( +SK.CHECK.WHENDELETEDFN 194900 . 195680) (SK.CHECK.PREEDITFN 195682 . 196166) ( +SK.CHECK.END.INITIAL.EDIT 196168 . 196702) (SK.CHECK.WHENPOINTDELETEDFN 196704 . 197500) (SK.ERASE.ELT + 197502 . 197838) (SK.DELETE.ELT 197840 . 198215) (SK.DELETE.ITEM 198217 . 198625) (DELFROMTCONC +198627 . 200300)) (200341 214175 (SK.COPY.ELT 200351 . 200721) (SK.SEL.AND.COPY 200723 . 201106) ( +SK.COPY.ELEMENTS 201108 . 206736) (SK.ADD.COPY.OF.ELEMENTS 206738 . 208505) ( +SK.GLOBAL.FROM.LOCAL.ELEMENTS 208507 . 208747) (SK.COPY.ITEM 208749 . 209546) (SK.INSERT.SKETCH 209548 + . 214173)) (214215 244236 (SK.MOVE.ELT 214225 . 214500) (SK.MOVE.ELT.OR.PT 214502 . 214815) ( +SK.APPLY.DEFAULT.MOVE 214817 . 215251) (SK.SEL.AND.MOVE 215253 . 215800) (SK.MOVE.ELEMENTS 215802 . +226674) (SKETCH.MOVE.ELEMENTS 226676 . 228607) (SKETCH.COPY.ELEMENTS 228609 . 230656) ( +\SKETCH.COPY.ELEMENT 230658 . 231383) (SK.TRANSLATE.ELEMENT 231385 . 231868) (SK.COPY.GLOBAL.ELEMENT +231870 . 232081) (SK.MAKE.ELEMENT.MOVE.ARG 232083 . 232703) (SK.MAKE.ELEMENTS.MOVE.ARG 232705 . 233227 +) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 233229 . 234298) (SK.SHOW.FIG.FROM.INFO 234300 . 234668) ( +SK.MOVE.THING 234670 . 235576) (UPDATE.ELEMENT.IN.SKETCH 235578 . 237633) (SK.UPDATE.ELEMENT 237635 . +239194) (SK.UPDATE.ELEMENTS 239196 . 239915) (SK.UPDATE.ELEMENT1 239917 . 243817) ( +SK.MOVE.ELEMENT.POINT 243819 . 244234)) (244299 266588 (SK.MOVE.POINTS 244309 . 244596) ( +SK.SEL.AND.MOVE.POINTS 244598 . 244903) (SK.DO.MOVE.ELEMENT.POINTS 244905 . 253562) ( +SK.MOVE.ITEM.POINTS 253564 . 255235) (SK.TRANSLATEPTSFN 255237 . 255621) (SK.TRANSLATE.POINTS 255623 + . 256524) (SK.SELECT.MULTIPLE.POINTS 256526 . 262166) (SK.CONTROL.POINTS.IN.REGION 262168 . 263589) ( +SK.ADD.PT.SELECTION 263591 . 264055) (SK.REMOVE.PT.SELECTION 264057 . 264674) (SK.ADD.POINT 264676 . +265299) (SK.ELTS.CONTAINING.PTS 265301 . 265926) (SK.HOTSPOTS.NOT.ON.LIST 265928 . 266586)) (266746 +269542 (SK.SET.MOVE.MODE 266756 . 267427) (SK.SET.MOVE.MODE.POINTS 267429 . 267768) ( +SK.SET.MOVE.MODE.ELEMENTS 267770 . 268114) (SK.SET.MOVE.MODE.COMBINED 268116 . 268466) (READMOVEMODE +268468 . 269540)) (269543 288298 (SK.ALIGN.POINTS 269553 . 269843) (SK.SEL.AND.ALIGN.POINTS 269845 . +270154) (SK.ALIGN.POINTS.LEFT 270156 . 270459) (SK.ALIGN.POINTS.RIGHT 270461 . 270766) ( +SK.ALIGN.POINTS.TOP 270768 . 271069) (SK.ALIGN.POINTS.BOTTOM 271071 . 271378) ( +SK.EVEN.SPACE.POINTS.IN.X 271380 . 271700) (SK.EVEN.SPACE.POINTS.IN.Y 271702 . 272022) ( +SK.DO.ALIGN.POINTS 272024 . 282646) (SK.NTH.CONTROL.POINT 282648 . 283109) ( +SK.GET.SELECTED.ELEMENT.STRUCTURE 283111 . 283777) (SK.CORRESPONDING.CONTROL.PT 283779 . 284333) ( +SK.CONTROL.POINT.NUMBER 284335 . 284705) (SK.DO.ALIGN.SETVALUE 284707 . 288296)) (288362 301794 ( +SKETCH.CREATE.GROUP 288372 . 288861) (SK.CREATE.GROUP1 288863 . 289410) (SK.UPDATE.GROUP.AFTER.CHANGE +289412 . 290201) (SK.GROUP.ELTS 290203 . 290484) (SK.SEL.AND.GROUP 290486 . 290872) (SK.GROUP.ELEMENTS + 290874 . 292523) (SK.UNGROUP.ELT 292525 . 292809) (SK.SEL.AND.UNGROUP 292811 . 294480) ( +SK.UNGROUP.ELEMENT 294482 . 295418) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 295420 . 296342) ( +SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 296344 . 297355) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 297357 . +298697) (SK.UNIONREGIONS 298699 . 301065) (SKETCH.REGION.OF.SKETCH 301067 . 301483) (SK.FLASHREGION +301485 . 301792)) (301795 315266 (INIT.GROUP.ELEMENT 301805 . 302677) (GROUP.DRAWFN 302679 . 303129) ( +GROUP.EXPANDFN 303131 . 304694) (GROUP.INSIDEFN 304696 . 305105) (GROUP.REGIONFN 305107 . 305502) ( +GROUP.GLOBALREGIONFN 305504 . 305822) (GROUP.TRANSLATEFN 305824 . 307856) (GROUP.TRANSFORMFN 307858 . +311338) (GROUP.READCHANGEFN 311340 . 315264)) (315267 316275 (REGION.CENTER 315277 . 315878) ( +REMOVE.LAST 315880 . 316273)) (316328 321435 (SK.MOVE.GROUP.CONTROL.PT 316338 . 316629) ( +SK.SEL.AND.MOVE.CONTROL.PT 316631 . 318035) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 318037 . 320110) ( +SK.READ.NEW.GROUP.CONTROL.PT 320112 . 321433)) (321694 326318 (SK.DO.GROUP 321704 . 323156) ( +SK.CHECK.WHENGROUPEDFN 323158 . 323868) (SK.DO.UNGROUP 323870 . 325075) (SK.CHECK.WHENUNGROUPEDFN +325077 . 325664) (SK.GROUP.UNDO 325666 . 325989) (SK.UNGROUP.UNDO 325991 . 326316)) (326559 331481 ( +SK.FREEZE.ELTS 326569 . 326853) (SK.SEL.AND.FREEZE 326855 . 327245) (SK.FREEZE.ELEMENTS 327247 . +327798) (SK.UNFREEZE.ELT 327800 . 328089) (SK.SEL.AND.UNFREEZE 328091 . 329627) (SK.UNFREEZE.ELEMENTS +329629 . 330188) (SK.FREEZE.UNDO 330190 . 330435) (SK.UNFREEZE.UNDO 330437 . 330684) (SK.DO.FREEZE +330686 . 331079) (SK.DO.UNFREEZE 331081 . 331479)) (331711 341521 (SKETCH.ELEMENTS.OF.SKETCH 331721 . +332556) (SKETCH.LIST.OF.ELEMENTS 332558 . 333276) (SKETCH.ADD.ELEMENT 333278 . 334353) ( +SKETCH.DELETE.ELEMENT 334355 . 336087) (DELFROMGROUPELT 336089 . 336889) (SKETCH.ELEMENT.TYPE 336891 + . 337240) (SKETCH.ELEMENT.CHANGED 337242 . 338810) (SK.ELEMENT.CHANGED1 338812 . 339463) ( +SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 339465 . 341519)) (341575 346187 (INSURE.SKETCH 341585 . 344200) + (LOCALSPECS.FROM.VIEWER 344202 . 344562) (SK.LOCAL.ELT.FROM.GLOBALPART 344564 . 345032) ( +SKETCH.FROM.VIEWER 345034 . 345268) (INSPECT.SKETCH 345270 . 345595) (ELT.INSIDE.SKETCHWP 345597 . +345870) (SK.INSIDE.REGION 345872 . 346185)) (346188 350518 (MAPSKETCHSPECS 346198 . 346819) ( +MAPCOLLECTSKETCHSPECS 346821 . 347570) (MAPSKETCHSPECSUNTIL 347572 . 348380) (MAPGLOBALSKETCHSPECS +348382 . 349083) (MAPGLOBALSKETCHELEMENTS 349085 . 350516)) (350580 376472 (SK.ADD.SELECTION 350590 . +351330) (SK.COPY.INSERTFN 351332 . 354963) (SCREENELEMENTP 354965 . 355438) (SK.ITEM.REGION 355440 . +355927) (SK.ELEMENT.GLOBAL.REGION 355929 . 356457) (SK.LOCAL.ITEMS.IN.REGION 356459 . 358438) ( +SK.REGIONFN 358440 . 358762) (SK.GLOBAL.REGIONFN 358764 . 359122) (SK.REMOVE.SELECTION 359124 . 359852 +) (SK.SELECT.MULTIPLE.ITEMS 359854 . 370296) (SKETCH.GET.ELEMENTS 370298 . 371721) (SK.PUT.MARKS.UP +371723 . 372062) (SK.TAKE.MARKS.DOWN 372064 . 372403) (SK.TRANSLATE.GLOBALPART 372405 . 374532) ( +SK.TRANSLATE.ITEM 374534 . 375461) (SK.TRANSLATEFN 375463 . 375659) (TRANSLATE.SKETCH 375661 . 376470) +) (376738 379645 (SK.INPUT.SCALE 376748 . 377595) (SK.UPDATE.SKETCHCONTEXT 377597 . 378194) ( +SK.SET.INPUT.SCALE 378196 . 378845) (SK.SET.INPUT.SCALE.CURRENT 378847 . 379138) ( +SK.SET.INPUT.SCALE.VALUE 379140 . 379643)) (379696 381608 (SK.SET.FEEDBACK.MODE 379706 . 381012) ( +SK.SET.FEEDBACK.POINT 381014 . 381182) (SK.SET.FEEDBACK.VERBOSE 381184 . 381353) ( +SK.SET.FEEDBACK.ALWAYS 381355 . 381606)) (381759 383137 (SKETCH.TITLE 381769 . 382133) ( +SK.SHRINK.ICONCREATE 382135 . 383135)) (388827 391641 (READBRUSHSHAPE 388837 . 389296) (READ.FUNCTION +389298 . 389813) (READBRUSHSIZE 389815 . 390273) (READANGLE 390275 . 390767) (READARCDIRECTION 390769 + . 391639)) (391642 402053 (SK.CHANGE.DASHING 391652 . 395600) (READ.AND.SAVE.NEW.DASHING 395602 . +397370) (READ.NEW.DASHING 397372 . 399112) (READ.DASHING.CHANGE 399114 . 400589) (SK.CACHE.DASHING +400591 . 401593) (SK.DASHING.LABEL 401595 . 402051)) (402054 405759 (READ.FILLING.CHANGE 402064 . +404045) (SK.CACHE.FILLING 404047 . 404765) (READ.AND.SAVE.NEW.FILLING 404767 . 405365) ( +SK.FILLING.LABEL 405367 . 405757)) (406143 442396 (SK.GETGLOBALPOSITION 406153 . 406458) ( +SKETCH.TRACK.ELEMENTS 406460 . 409980) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 409982 . 410541) ( +MAP.SKETCH.ELEMENTS.INTO.VIEWER 410543 . 410935) (MAP.GLOBAL.POSITION.INTO.VIEWER 410937 . 411317) ( +SKETCH.TO.VIEWER.POSITION 411319 . 411678) (SKETCH.TRACK.IMAGE 411680 . 412534) (SK.TRACK.IMAGE1 +412536 . 413948) (MAP.VIEWER.XY.INTO.GLOBAL 413950 . 414944) (SK.SET.POSITION 414946 . 415282) ( +MAP.VIEWER.PT.INTO.GLOBAL 415284 . 416390) (VIEWER.TO.SKETCH.POSITION 416392 . 417027) ( +SK.INSURE.SCALE 417029 . 417289) (SKETCH.TO.VIEWER.REGION 417291 . 418097) (VIEWER.TO.SKETCH.REGION +418099 . 418437) (SK.READ.POINT.WITH.FEEDBACK 418439 . 429442) (SKETCH.GET.POSITION 429444 . 431324) ( +\CLOBBER.POSITION 431326 . 431774) (NEAREST.HOT.SPOT 431776 . 433304) (GETWREGION 433306 . 434067) ( +GET.BITMAP.POSITION 434069 . 434853) (SK.TRACK.BITMAP1 434855 . 442394)) (442965 473851 ( +SK.BRING.UP.POSITION.PAD 442975 . 448835) (SK.PAD.READER.POSITION 448837 . 450486) ( +SK.POSITION.READER.REPAINTFN 450488 . 452272) (SK.POSITION.PAD.FROM.VIEWER 452274 . 453616) ( +SK.INIT.POSITION.NUMBER.PAD.MENU 453618 . 453968) (SK.READ.POSITION.PAD.HANDLER 453970 . 459702) ( +DISPLAY.POSITION.READER.TOTAL 459704 . 462002) (POSITION.PAD.READER.HANDLER 462004 . 470047) ( +POSITIONPAD.HELDFN 470049 . 471533) (\POSITION.PAD.ADD.DIGIT.MENU 471535 . 473114) ( +\POSITION.READER.NUMBERPAD 473116 . 473849)) (475477 478155 (SK.DRAWFN 475487 . 475853) ( +SK.TRANSFORMFN 475855 . 476236) (SK.EXPANDFN 476238 . 476515) (SK.INPUT 476517 . 476898) (SK.INSIDEFN +476900 . 477540) (SK.UPDATEFN 477542 . 478153)) (483320 485476 (UPDATE-SKETCH 483330 . 484443) ( +EDIT-SKETCH 484445 . 485474)) (486077 490022 (SK.CHECK.SKETCH.VERSION 486087 . 487327) ( +SK.INSURE.RECORD.LENGTH 487329 . 488812) (SK.INSURE.HAS.LENGTH 488814 . 489552) (SK.RECORD.LENGTH +489554 . 489728) (SK.SET.RECORD.LENGTHS 489730 . 490020)) (490485 491372 ( +SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 490495 . 491370))))) STOP diff --git a/library/sketch/SKETCH-ELEMENTS b/library/sketch/SKETCH-ELEMENTS index 5e56caa3..333f585d 100644 --- a/library/sketch/SKETCH-ELEMENTS +++ b/library/sketch/SKETCH-ELEMENTS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Nov-2025 10:57:24" {WMEDLEY}SKETCH>SKETCH-ELEMENTS.;25 545903 +(FILECREATED "18-Dec-2025 00:27:41" {WMEDLEY}SKETCH>SKETCH-ELEMENTS.;28 546107 :EDIT-BY rmk - :CHANGES-TO (FNS SK.CHANGE.TEXT SK.CHANGE.FONT) + :CHANGES-TO (FNS SK.DECREASING.FONT.LIST) - :PREVIOUS-DATE " 8-Nov-2025 14:02:38" {WMEDLEY}SKETCH>SKETCH-ELEMENTS.;24) + :PREVIOUS-DATE "30-Nov-2025 10:57:24" {WMEDLEY}SKETCH>SKETCH-ELEMENTS.;25) (PRETTYCOMPRINT SKETCH-ELEMENTSCOMS) @@ -5545,7 +5545,8 @@ Click outside the window to stop.") do (RETURN (FONTPROP FONT 'SPEC]) (SK.DECREASING.FONT.LIST - [LAMBDA (FAMILY DEVICE) (* ; "Edited 6-Nov-2025 17:40 by rmk") + [LAMBDA (FAMILY DEVICE) (* ; "Edited 18-Dec-2025 00:27 by rmk") + (* ; "Edited 6-Nov-2025 17:40 by rmk") (* ; "Edited 4-Nov-2025 15:34 by rmk") (* ;  "Edited 12-Oct-92 12:39 by sybalsky:mv:envos") @@ -5566,19 +5567,19 @@ Click outside the window to stop.") (SETQ FAMILY 'MODERN)) (LET ((FAMSPEC (create FONTSPEC FSFAMILY _ FAMILY - FSSIZE _ '* + FSSIZE _ 12 FSDEVICE _ DEVICE))) - (* ;; "Run through all sizes for all the fonts for FAMILY or any of its coercions on DEVICE. This gives us all the possible sizes for FAMILY, we ask FONTCREATE to create a FAMILY font for each of those sizes.") + (* ;; "Coerce for size 12 to getcoercions for all reasonable FAMILYs, then go to *. This gives us all the possible sizes for FAMILY, we ask FONTCREATE to create a FAMILY font for each of those sizes.") - (for FS SIZES in (for FS in [CONS FAMSPEC (COERCEFONTSPEC FAMSPEC (FONTDEVICEPROP + (for FS SIZES in (for FS in (CONS FAMSPEC (COERCEFONTSPEC FAMSPEC (FONTDEVICEPROP DEVICE - 'CHARCOERCIONS] - join (FONTSAVAILABLE FS NIL NIL NIL NIL T)) - do (pushnew SIZES (fetch (FONTSPEC FSSIZE) of FS)) - finally (RETURN (for S in [SORT SIZES (FUNCTION (LAMBDA (S1 S2) - (IGREATERP S1 S2] - collect (FONTCREATE FAMILY S NIL NIL DEVICE]) + 'CHARCOERCIONS T))) + join (FONTSAVAILABLE (create FONTSPEC using FS FSSIZE _ '*) + NIL NIL NIL NIL T)) do (pushnew SIZES (fetch (FONTSPEC + FSSIZE) + of FS)) + finally (RETURN (for S in (SORT SIZES) collect (FONTCREATE FAMILY S NIL NIL DEVICE]) ) (RPAQ? \KNOWN.SKETCH.FONTSIZES ) @@ -9076,136 +9077,136 @@ No more font sizes found.") (fetch (REGION TOP) of REGION]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (14197 24607 (INIT.SKETCH.ELEMENTS 14207 . 21770) (CREATE.SKETCH.ELEMENT.TYPE 21772 . -23294) (SKETCH.ELEMENT.TYPEP 23296 . 23684) (SKETCH.ELEMENT.NAMEP 23686 . 23949) ( -\CURSOR.IN.MIDDLE.MENU 23951 . 24605)) (24648 25325 (SKETCHINCOLORP 24658 . 24978) (READ.COLOR.CHANGE -24980 . 25323)) (25834 28613 (SK.CREATE.DEFAULT.FILLING 25844 . 26145) (SKFILLINGP 26147 . 26780) ( -SK.INSURE.FILLING 26782 . 28210) (SK.INSURE.COLOR 28212 . 28611)) (28614 34224 (SK.TRANSLATE.MODE -28624 . 29406) (SK.CHANGE.FILLING.MODE 29408 . 32991) (READ.FILLING.MODE 32993 . 34222)) (34225 64899 -(SKETCH.CREATE.CIRCLE 34235 . 35047) (CIRCLE.EXPANDFN 35049 . 38421) (CIRCLE.DRAWFN 38423 . 41424) ( -\CIRCLE.DRAWFN1 41426 . 44021) (CIRCLE.INPUTFN 44023 . 45872) (SK.UPDATE.CIRCLE.AFTER.CHANGE 45874 . -46233) (SK.READ.CIRCLE.POINT 46235 . 46706) (SK.SHOW.CIRCLE 46708 . 47354) (CIRCLE.INSIDEFN 47356 . -47621) (CIRCLE.REGIONFN 47623 . 49304) (CIRCLE.GLOBALREGIONFN 49306 . 50824) (CIRCLE.TRANSLATE 50826 - . 52687) (CIRCLE.READCHANGEFN 52689 . 57305) (CIRCLE.TRANSFORMFN 57307 . 59160) (CIRCLE.TRANSLATEPTS -59162 . 60776) (SK.CIRCLE.CREATE 60778 . 61621) (SET.CIRCLE.SCALE 61623 . 62389) (SK.BRUSH.READCHANGE -62391 . 64897)) (64900 65629 (SK.INSURE.BRUSH 64910 . 65304) (SK.INSURE.DASHING 65306 . 65627)) (66843 - 96337 (SKETCH.CREATE.ELLIPSE 66853 . 67452) (ELLIPSE.EXPANDFN 67454 . 71066) (ELLIPSE.DRAWFN 71068 . -75245) (ELLIPSE.INPUTFN 75247 . 77687) (SK.READ.ELLIPSE.MAJOR.PT 77689 . 78268) ( -SK.SHOW.ELLIPSE.MAJOR.RADIUS 78270 . 79025) (SK.READ.ELLIPSE.MINOR.PT 79027 . 79720) ( -SK.SHOW.ELLIPSE.MINOR.RADIUS 79722 . 80554) (ELLIPSE.INSIDEFN 80556 . 80826) (ELLIPSE.CREATE 80828 . -82203) (SK.UPDATE.ELLIPSE.AFTER.CHANGE 82205 . 82573) (ELLIPSE.REGIONFN 82575 . 84775) ( -ELLIPSE.GLOBALREGIONFN 84777 . 86590) (ELLIPSE.TRANSLATEFN 86592 . 89138) (ELLIPSE.TRANSFORMFN 89140 - . 90417) (ELLIPSE.TRANSLATEPTS 90419 . 92460) (MARK.SPOT 92462 . 93713) (DISTANCEBETWEEN 93715 . -94310) (SK.DISTANCE.TO 94312 . 94697) (SQUARE 94699 . 94741) (COMPUTE.ELLIPSE.ORIENTATION 94743 . -95462) (SK.COMPUTE.ELLIPSE.MINOR.RADIUS.PT 95464 . 96335)) (97450 138506 (SKETCH.CREATE.OPEN.CURVE -97460 . 98013) (OPENCURVE.INPUTFN 98015 . 98883) (SK.CURVE.CREATE 98885 . 100630) (MAXXEXTENT 100632 - . 101491) (MAXYEXTENT 101493 . 102353) (KNOT.SET.SCALE.FIELD 102355 . 103157) (OPENCURVE.DRAWFN -103159 . 104290) (OPENCURVE.EXPANDFN 104292 . 107607) (OPENCURVE.READCHANGEFN 107609 . 110811) ( -OPENCURVE.TRANSFORMFN 110813 . 113311) (OPENCURVE.TRANSLATEFN 113313 . 113735) ( -OPENCURVE.TRANSLATEPTSFN 113737 . 115118) (SKETCH.CREATE.CLOSED.CURVE 115120 . 115626) ( -CLOSEDCURVE.DRAWFN 115628 . 116412) (CLOSEDCURVE.EXPANDFN 116414 . 119527) (CLOSEDCURVE.REGIONFN -119529 . 120326) (CLOSEDCURVE.GLOBALREGIONFN 120328 . 121761) (READ.LIST.OF.POINTS 121763 . 123742) ( -CLOSEDCURVE.INPUTFN 123744 . 124389) (CLOSEDCURVE.READCHANGEFN 124391 . 127286) ( -CLOSEDCURVE.TRANSFORMFN 127288 . 129088) (CLOSEDCURVE.TRANSLATEPTSFN 129090 . 130435) (INVISIBLEPARTP -130437 . 130790) (SHOWSKETCHPOINT 130792 . 131097) (SHOWSKETCHXY 131099 . 131617) (KNOTS.REGIONFN -131619 . 132520) (OPENWIRE.GLOBALREGIONFN 132522 . 133386) (CURVE.REGIONFN 133388 . 134329) ( -OPENCURVE.GLOBALREGIONFN 134331 . 135738) (KNOTS.TRANSLATEFN 135740 . 136783) (REGION.CONTAINING.PTS -136785 . 138504)) (138507 160783 (CHANGE.ELTS.BRUSH.SIZE 138517 . 139127) (CHANGE.ELTS.BRUSH 139129 . -139646) (CHANGE.ELTS.BRUSH.SHAPE 139648 . 140049) (SK.CHANGE.BRUSH.SHAPE 140051 . 143563) ( -SK.CHANGE.BRUSH.COLOR 143565 . 148011) (SK.CHANGE.BRUSH.SIZE 148013 . 152971) (SK.CHANGE.ANGLE 152973 - . 155953) (SK.CHANGE.ARC.DIRECTION 155955 . 158334) (SK.SET.DEFAULT.BRUSH.SIZE 158336 . 159035) ( -READSIZECHANGE 159037 . 160781)) (160784 162403 (SK.CHANGE.ELEMENT.KNOTS 160794 . 162401)) (162404 -163051 (SK.INSURE.POINT.LIST 162414 . 162867) (SK.INSURE.POSITION 162869 . 163049)) (164419 196742 ( -SKETCH.CREATE.WIRE 164429 . 164919) (CLOSEDWIRE.EXPANDFN 164921 . 167609) (KNOTS.INSIDEFN 167611 . -168332) (OPEN.WIRE.DRAWFN 168334 . 168926) (WIRE.EXPANDFN 168928 . 172175) ( -SK.UPDATE.WIRE.ELT.AFTER.CHANGE 172177 . 172698) (OPENWIRE.READCHANGEFN 172700 . 175193) ( -OPENWIRE.TRANSFORMFN 175195 . 177318) (OPENWIRE.TRANSLATEFN 177320 . 177744) (OPENWIRE.TRANSLATEPTSFN -177746 . 179025) (WIRE.INPUTFN 179027 . 180658) (SK.READ.WIRE.POINTS 180660 . 181191) ( -SK.READ.POINTS.WITH.FEEDBACK 181193 . 183960) (OPENWIRE.FEEDBACKFN 183962 . 184716) ( -CLOSEDWIRE.FEEDBACKFN 184718 . 186074) (CLOSEDWIRE.REGIONFN 186076 . 187061) ( -CLOSEDWIRE.GLOBALREGIONFN 187063 . 188115) (SK.WIRE.CREATE 188117 . 189880) (WIRE.ADD.POINT.TO.END -189882 . 190798) (READ.ARROW.CHANGE 190800 . 196276) (CHANGE.ELTS.ARROWHEADS 196278 . 196740)) (196743 - 207749 (SKETCH.CREATE.CLOSED.WIRE 196753 . 197314) (CLOSED.WIRE.INPUTFN 197316 . 197671) ( -CLOSED.WIRE.DRAWFN 197673 . 199718) (CLOSEDWIRE.READCHANGEFN 199720 . 204625) (CLOSEDWIRE.TRANSFORMFN -204627 . 206421) (CLOSEDWIRE.TRANSLATEPTSFN 206423 . 207747)) (207750 260456 (SK.EXPAND.ARROWHEADS -207760 . 208110) (SK.COMPUTE.ARC.ARROWHEAD.POINTS 208112 . 209493) (ARC.ARROWHEAD.POINTS 209495 . -210718) (SET.ARC.ARROWHEAD.POINTS 210720 . 211701) (SET.OPENCURVE.ARROWHEAD.POINTS 211703 . 212604) ( -SK.COMPUTE.CURVE.ARROWHEAD.POINTS 212606 . 213876) (SET.WIRE.ARROWHEAD.POINTS 213878 . 214631) ( -SK.COMPUTE.WIRE.ARROWHEAD.POINTS 214633 . 215898) (SK.EXPAND.ARROWHEAD 215900 . 217083) (CHANGED.ARROW - 217085 . 220257) (SK.CHANGE.ARROWHEAD 220259 . 220712) (SK.CHANGE.ARROWHEAD1 220714 . 225969) ( -SK.CREATE.ARROWHEAD 225971 . 226491) (SK.ARROWHEAD.CREATE 226493 . 228067) (SK.ARROWHEAD.END.TEST -228069 . 228993) (READ.ARROWHEAD.END 228995 . 231020) (ARROW.HEAD.POSITIONS 231022 . 232862) ( -ARROWHEAD.POINTS.LIST 232864 . 236836) (CURVE.ARROWHEAD.POINTS 236838 . 237701) (LEFT.MOST.IS.BEGINP -237703 . 238584) (WIRE.ARROWHEAD.POINTS 238586 . 240112) (DRAWARROWHEADS 240114 . 242484) ( -\SK.DRAW.TRIANGLE.ARROWHEAD 242486 . 244146) (\SK.ENDPT.OF.ARROW 244148 . 246405) ( -\SK.ADJUST.FOR.ARROWHEADS 246407 . 248912) (SK.SET.ARROWHEAD.LENGTH 248914 . 250058) ( -SK.SET.ARROWHEAD.ANGLE 250060 . 251156) (SK.SET.ARROWHEAD.TYPE 251158 . 254447) (SK.SET.LINE.ARROWHEAD - 254449 . 256862) (SK.UPDATE.ARROWHEAD.FORMAT 256864 . 258974) (SK.SET.LINE.LENGTH.MODE 258976 . -260454)) (260457 262258 (SK.INSURE.ARROWHEADS 260467 . 261649) (SK.ARROWHEADP 261651 . 262256)) ( -265055 327497 (SKETCH.CREATE.TEXT 265065 . 265579) (TEXT.CHANGEFN 265581 . 265973) (TEXT.READCHANGEFN -265975 . 274046) (\SK.READ.FONT.SIZE1 274048 . 276214) (SK.TEXT.ELT.WITH.SAME.FIELDS 276216 . 277856) -(SK.READFONTFAMILY 277858 . 280328) (CLOSE.PROMPT.WINDOW 280330 . 280754) (TEXT.DRAWFN 280756 . 281477 -) (TEXT.DRAWFN1 281479 . 284981) (TEXT.INSIDEFN 284983 . 285372) (TEXT.EXPANDFN 285374 . 287499) ( -SK.TEXT.LINE.REGIONS 287501 . 289375) (TEXT.UPDATE.GLOBAL.REGIONS 289377 . 290609) (REL.MOVE.REGION -290611 . 291148) (LTEXT.LINE.REGIONS 291150 . 294568) (TEXT.INPUTFN 294570 . 295080) (READ.TEXT 295082 - . 295830) (TEXT.POSITION.AND.CREATE 295832 . 298143) (CREATE.TEXT.ELEMENT 298145 . 298963) ( -SK.UPDATE.TEXT.AFTER.CHANGE 298965 . 299367) (SK.TEXT.FROM.TEXTBOX 299369 . 303175) ( -TEXT.SET.GLOBAL.REGIONS 303177 . 304470) (TEXT.REGIONFN 304472 . 305242) (TEXT.GLOBALREGIONFN 305244 - . 305932) (TEXT.TRANSLATEFN 305934 . 307249) (TEXT.TRANSFORMFN 307251 . 308374) (TEXT.TRANSLATEPTSFN -308376 . 308893) (TEXT.UPDATEFN 308895 . 313551) (SK.CHANGE.TEXT 313553 . 323831) (SK.CHANGE.FONT -323833 . 325563) (TEXT.SET.SCALES 325565 . 326533) (BREAK.AT.CARRIAGE.RETURNS 326535 . 327495)) ( -327498 340483 (SK.PICK.FONT 327508 . 331780) (SK.CHOOSE.TEXT.FONT 331782 . 336053) (SK.NEXTSIZEFONT -336055 . 337687) (SK.DECREASING.FONT.LIST 337689 . 340481)) (340902 352576 (SK.SET.FONT 340912 . -342179) (SK.SET.TEXT.FONT 342181 . 343183) (SK.SET.TEXT.SIZE 343185 . 343872) (SK.SET.TEXT.HORIZ.ALIGN - 343874 . 345448) (SK.READFONTSIZE 345450 . 347348) (SK.COLLECT.FONT.SIZES 347350 . 348431) ( -SK.SET.TEXT.VERT.ALIGN 348433 . 350475) (SK.SET.TEXT.LOOKS 350477 . 351934) (SK.SET.DEFAULT.TEXT.FACE -351936 . 352574)) (352577 353163 (CREATE.SKETCH.TERMTABLE 352587 . 353161)) (353164 354930 ( -SK.FONT.LIST 353174 . 353500) (SK.INSURE.FONT 353502 . 354024) (SK.INSURE.STYLE 354026 . 354544) ( -SK.INSURE.TEXT 354546 . 354928)) (355470 412763 (SKETCH.CREATE.TEXTBOX 355480 . 357122) ( -SK.COMPUTE.TEXTBOX.REGION.FOR.STRING 357124 . 359201) (SK.BREAK.INTO.LINES 359203 . 370389) ( -SK.BRUSH.SIZE 370391 . 370772) (SK.TEXTBOX.CREATE 370774 . 371571) (SK.TEXTBOX.CREATE1 371573 . 372637 -) (SK.UPDATE.TEXTBOX.AFTER.CHANGE 372639 . 373179) (SK.TEXTBOX.POSITION.IN.BOX 373181 . 375092) ( -TEXTBOX.CHANGEFN 375094 . 375568) (TEXTBOX.DRAWFN 375570 . 377606) (SK.TEXTURE.AROUND.REGIONS 377608 - . 383681) (ALL.EMPTY.REGIONS 383683 . 384173) (TEXTBOX.EXPANDFN 384175 . 391331) (TEXTBOX.INPUTFN -391333 . 392946) (TEXTBOX.INSIDEFN 392948 . 393361) (TEXTBOX.REGIONFN 393363 . 394217) ( -TEXTBOX.GLOBALREGIONFN 394219 . 394547) (TEXTBOX.SET.GLOBAL.REGIONS 394549 . 395880) ( -TEXTBOX.TRANSLATEFN 395882 . 397723) (TEXTBOX.TRANSLATEPTSFN 397725 . 400508) (TEXTBOX.TRANSFORMFN -400510 . 402178) (TEXTBOX.UPDATEFN 402180 . 404073) (TEXTBOX.READCHANGEFN 404075 . 408964) ( -SK.TEXTBOX.TEXT.POSITION 408966 . 409387) (SK.TEXTBOX.FROM.TEXT 409389 . 411994) (ADD.EOLS 411996 . -412761)) (413292 416793 (SK.SET.TEXTBOX.VERT.ALIGN 413302 . 415182) (SK.SET.TEXTBOX.HORIZ.ALIGN 415184 - . 416791)) (417176 461651 (SKETCH.CREATE.BOX 417186 . 417669) (SK.BOX.DRAWFN 417671 . 418830) ( -BOX.DRAWFN1 418832 . 421671) (KNOTS.OF.REGION 421673 . 422907) (SK.DRAWAREABOX 422909 . 429510) ( -SK.DRAWBOX 429512 . 430701) (SK.BOX.EXPANDFN 430703 . 434451) (SK.BOX.GETREGIONFN 434453 . 435639) ( -BOX.SET.SCALES 435641 . 436881) (SK.BOX.INPUTFN 436883 . 438816) (SK.BOX.CREATE 438818 . 439519) ( -SK.UPDATE.BOX.AFTER.CHANGE 439521 . 440032) (SK.BOX.INSIDEFN 440034 . 440424) (SK.BOX.REGIONFN 440426 - . 441139) (SK.BOX.GLOBALREGIONFN 441141 . 441879) (SK.BOX.READCHANGEFN 441881 . 445602) ( -SK.CHANGE.FILLING 445604 . 449552) (SK.CHANGE.FILLING.COLOR 449554 . 453210) (SK.BOX.TRANSLATEFN -453212 . 454391) (SK.BOX.TRANSFORMFN 454393 . 455338) (SK.BOX.TRANSLATEPTSFN 455340 . 457708) ( -UNSCALE.REGION.TO.GRID 457710 . 458635) (INCREASEREGION 458637 . 459228) (INSUREREGIONSIZE 459230 . -460401) (EXPANDREGION 460403 . 461283) (REGION.FROM.COORDINATES 461285 . 461649)) (462187 488542 ( -SKETCH.CREATE.ARC 462197 . 463006) (ARC.DRAWFN 463008 . 464735) (ARC.EXPANDFN 464737 . 467070) ( -ARC.INPUTFN 467072 . 471290) (SK.INVERT.CIRCLE 471292 . 472152) (SK.READ.ARC.ANGLE.POINT 472154 . -472661) (SK.SHOW.ARC 472663 . 473273) (ARC.CREATE 473275 . 474630) (SK.UPDATE.ARC.AFTER.CHANGE 474632 - . 474972) (ARC.MOVEFN 474974 . 476557) (ARC.TRANSLATEPTS 476559 . 478444) (ARC.INSIDEFN 478446 . -478696) (ARC.REGIONFN 478698 . 479834) (ARC.GLOBALREGIONFN 479836 . 481558) (ARC.TRANSLATE 481560 . -482542) (ARC.TRANSFORMFN 482544 . 485494) (ARC.READCHANGEFN 485496 . 488540)) (488543 497622 ( -SK.COMPUTE.ARC.ANGLE.PT 488553 . 489479) (SK.COMPUTE.ARC.ANGLE.PT.FROM.ANGLE 489481 . 490474) ( -SK.COMPUTE.ARC.PTS 490476 . 494048) (SK.SET.ARC.DIRECTION 494050 . 494624) (SK.SET.ARC.DIRECTION.CW -494626 . 494800) (SK.SET.ARC.DIRECTION.CCW 494802 . 495075) (SK.COMPUTE.SLOPE.OF.LINE 495077 . 495569) - (SK.CREATE.ARC.USING 495571 . 496808) (SET.ARC.SCALES 496810 . 497620)) (497623 498068 ( -SK.INSURE.DIRECTION 497633 . 498066)) (499439 545298 (GETSKETCHELEMENTPROP 499449 . 500757) ( -\SK.GET.ARC.ANGLEPT 500759 . 501320) (\GETSKETCHELEMENTPROP1 501322 . 501576) (\SK.GET.BRUSH 501578 . -502502) (\SK.GET.FILLING 502504 . 503602) (\SK.GET.ARROWHEADS 503604 . 504383) (\SK.GET.FONT 504385 . -504865) (\SK.GET.JUSTIFICATION 504867 . 505391) (\SK.GET.DIRECTION 505393 . 505870) (\SK.GET.DASHING -505872 . 506891) (PUTSKETCHELEMENTPROP 506893 . 509162) (\SK.PUT.FILLING 509164 . 510434) ( -ADDSKETCHELEMENTPROP 510436 . 511241) (REMOVESKETCHELEMENTPROP 511243 . 512032) (\SK.PUT.FONT 512034 - . 512848) (\SK.PUT.JUSTIFICATION 512850 . 513861) (\SK.PUT.DIRECTION 513863 . 514470) ( -\SK.PUT.DASHING 514472 . 515807) (\SK.PUT.BRUSH 515809 . 517728) (\SK.PUT.ARROWHEADS 517730 . 519696) -(SK.COPY.ELEMENT.PROPERTY.LIST 519698 . 520274) (SKETCH.UPDATE 520276 . 521006) (SKETCH.UPDATE1 521008 - . 522296) (\SKELT.GET.SCALE 522298 . 523286) (\SKELT.PUT.SCALE 523288 . 524595) (\SKELT.PUT.DATA -524597 . 526394) (SK.REPLACE.TEXT.IN.ELEMENT 526396 . 527349) (\SKELT.GET.DATA 527351 . 528418) ( -\SK.GET.1STCONTROLPT 528420 . 529932) (\SK.PUT.1STCONTROLPT 529934 . 535407) (\SK.GET.2NDCONTROLPT -535409 . 536324) (\SK.PUT.2NDCONTROLPT 536326 . 540514) (\SK.GET.3RDCONTROLPT 540516 . 541394) ( -\SK.PUT.3RDCONTROLPT 541396 . 545296)) (545299 545880 (LOWERLEFTCORNER 545309 . 545555) ( -UPPERRIGHTCORNER 545557 . 545878))))) + (FILEMAP (NIL (14191 24601 (INIT.SKETCH.ELEMENTS 14201 . 21764) (CREATE.SKETCH.ELEMENT.TYPE 21766 . +23288) (SKETCH.ELEMENT.TYPEP 23290 . 23678) (SKETCH.ELEMENT.NAMEP 23680 . 23943) ( +\CURSOR.IN.MIDDLE.MENU 23945 . 24599)) (24642 25319 (SKETCHINCOLORP 24652 . 24972) (READ.COLOR.CHANGE +24974 . 25317)) (25828 28607 (SK.CREATE.DEFAULT.FILLING 25838 . 26139) (SKFILLINGP 26141 . 26774) ( +SK.INSURE.FILLING 26776 . 28204) (SK.INSURE.COLOR 28206 . 28605)) (28608 34218 (SK.TRANSLATE.MODE +28618 . 29400) (SK.CHANGE.FILLING.MODE 29402 . 32985) (READ.FILLING.MODE 32987 . 34216)) (34219 64893 +(SKETCH.CREATE.CIRCLE 34229 . 35041) (CIRCLE.EXPANDFN 35043 . 38415) (CIRCLE.DRAWFN 38417 . 41418) ( +\CIRCLE.DRAWFN1 41420 . 44015) (CIRCLE.INPUTFN 44017 . 45866) (SK.UPDATE.CIRCLE.AFTER.CHANGE 45868 . +46227) (SK.READ.CIRCLE.POINT 46229 . 46700) (SK.SHOW.CIRCLE 46702 . 47348) (CIRCLE.INSIDEFN 47350 . +47615) (CIRCLE.REGIONFN 47617 . 49298) (CIRCLE.GLOBALREGIONFN 49300 . 50818) (CIRCLE.TRANSLATE 50820 + . 52681) (CIRCLE.READCHANGEFN 52683 . 57299) (CIRCLE.TRANSFORMFN 57301 . 59154) (CIRCLE.TRANSLATEPTS +59156 . 60770) (SK.CIRCLE.CREATE 60772 . 61615) (SET.CIRCLE.SCALE 61617 . 62383) (SK.BRUSH.READCHANGE +62385 . 64891)) (64894 65623 (SK.INSURE.BRUSH 64904 . 65298) (SK.INSURE.DASHING 65300 . 65621)) (66837 + 96331 (SKETCH.CREATE.ELLIPSE 66847 . 67446) (ELLIPSE.EXPANDFN 67448 . 71060) (ELLIPSE.DRAWFN 71062 . +75239) (ELLIPSE.INPUTFN 75241 . 77681) (SK.READ.ELLIPSE.MAJOR.PT 77683 . 78262) ( +SK.SHOW.ELLIPSE.MAJOR.RADIUS 78264 . 79019) (SK.READ.ELLIPSE.MINOR.PT 79021 . 79714) ( +SK.SHOW.ELLIPSE.MINOR.RADIUS 79716 . 80548) (ELLIPSE.INSIDEFN 80550 . 80820) (ELLIPSE.CREATE 80822 . +82197) (SK.UPDATE.ELLIPSE.AFTER.CHANGE 82199 . 82567) (ELLIPSE.REGIONFN 82569 . 84769) ( +ELLIPSE.GLOBALREGIONFN 84771 . 86584) (ELLIPSE.TRANSLATEFN 86586 . 89132) (ELLIPSE.TRANSFORMFN 89134 + . 90411) (ELLIPSE.TRANSLATEPTS 90413 . 92454) (MARK.SPOT 92456 . 93707) (DISTANCEBETWEEN 93709 . +94304) (SK.DISTANCE.TO 94306 . 94691) (SQUARE 94693 . 94735) (COMPUTE.ELLIPSE.ORIENTATION 94737 . +95456) (SK.COMPUTE.ELLIPSE.MINOR.RADIUS.PT 95458 . 96329)) (97444 138500 (SKETCH.CREATE.OPEN.CURVE +97454 . 98007) (OPENCURVE.INPUTFN 98009 . 98877) (SK.CURVE.CREATE 98879 . 100624) (MAXXEXTENT 100626 + . 101485) (MAXYEXTENT 101487 . 102347) (KNOT.SET.SCALE.FIELD 102349 . 103151) (OPENCURVE.DRAWFN +103153 . 104284) (OPENCURVE.EXPANDFN 104286 . 107601) (OPENCURVE.READCHANGEFN 107603 . 110805) ( +OPENCURVE.TRANSFORMFN 110807 . 113305) (OPENCURVE.TRANSLATEFN 113307 . 113729) ( +OPENCURVE.TRANSLATEPTSFN 113731 . 115112) (SKETCH.CREATE.CLOSED.CURVE 115114 . 115620) ( +CLOSEDCURVE.DRAWFN 115622 . 116406) (CLOSEDCURVE.EXPANDFN 116408 . 119521) (CLOSEDCURVE.REGIONFN +119523 . 120320) (CLOSEDCURVE.GLOBALREGIONFN 120322 . 121755) (READ.LIST.OF.POINTS 121757 . 123736) ( +CLOSEDCURVE.INPUTFN 123738 . 124383) (CLOSEDCURVE.READCHANGEFN 124385 . 127280) ( +CLOSEDCURVE.TRANSFORMFN 127282 . 129082) (CLOSEDCURVE.TRANSLATEPTSFN 129084 . 130429) (INVISIBLEPARTP +130431 . 130784) (SHOWSKETCHPOINT 130786 . 131091) (SHOWSKETCHXY 131093 . 131611) (KNOTS.REGIONFN +131613 . 132514) (OPENWIRE.GLOBALREGIONFN 132516 . 133380) (CURVE.REGIONFN 133382 . 134323) ( +OPENCURVE.GLOBALREGIONFN 134325 . 135732) (KNOTS.TRANSLATEFN 135734 . 136777) (REGION.CONTAINING.PTS +136779 . 138498)) (138501 160777 (CHANGE.ELTS.BRUSH.SIZE 138511 . 139121) (CHANGE.ELTS.BRUSH 139123 . +139640) (CHANGE.ELTS.BRUSH.SHAPE 139642 . 140043) (SK.CHANGE.BRUSH.SHAPE 140045 . 143557) ( +SK.CHANGE.BRUSH.COLOR 143559 . 148005) (SK.CHANGE.BRUSH.SIZE 148007 . 152965) (SK.CHANGE.ANGLE 152967 + . 155947) (SK.CHANGE.ARC.DIRECTION 155949 . 158328) (SK.SET.DEFAULT.BRUSH.SIZE 158330 . 159029) ( +READSIZECHANGE 159031 . 160775)) (160778 162397 (SK.CHANGE.ELEMENT.KNOTS 160788 . 162395)) (162398 +163045 (SK.INSURE.POINT.LIST 162408 . 162861) (SK.INSURE.POSITION 162863 . 163043)) (164413 196736 ( +SKETCH.CREATE.WIRE 164423 . 164913) (CLOSEDWIRE.EXPANDFN 164915 . 167603) (KNOTS.INSIDEFN 167605 . +168326) (OPEN.WIRE.DRAWFN 168328 . 168920) (WIRE.EXPANDFN 168922 . 172169) ( +SK.UPDATE.WIRE.ELT.AFTER.CHANGE 172171 . 172692) (OPENWIRE.READCHANGEFN 172694 . 175187) ( +OPENWIRE.TRANSFORMFN 175189 . 177312) (OPENWIRE.TRANSLATEFN 177314 . 177738) (OPENWIRE.TRANSLATEPTSFN +177740 . 179019) (WIRE.INPUTFN 179021 . 180652) (SK.READ.WIRE.POINTS 180654 . 181185) ( +SK.READ.POINTS.WITH.FEEDBACK 181187 . 183954) (OPENWIRE.FEEDBACKFN 183956 . 184710) ( +CLOSEDWIRE.FEEDBACKFN 184712 . 186068) (CLOSEDWIRE.REGIONFN 186070 . 187055) ( +CLOSEDWIRE.GLOBALREGIONFN 187057 . 188109) (SK.WIRE.CREATE 188111 . 189874) (WIRE.ADD.POINT.TO.END +189876 . 190792) (READ.ARROW.CHANGE 190794 . 196270) (CHANGE.ELTS.ARROWHEADS 196272 . 196734)) (196737 + 207743 (SKETCH.CREATE.CLOSED.WIRE 196747 . 197308) (CLOSED.WIRE.INPUTFN 197310 . 197665) ( +CLOSED.WIRE.DRAWFN 197667 . 199712) (CLOSEDWIRE.READCHANGEFN 199714 . 204619) (CLOSEDWIRE.TRANSFORMFN +204621 . 206415) (CLOSEDWIRE.TRANSLATEPTSFN 206417 . 207741)) (207744 260450 (SK.EXPAND.ARROWHEADS +207754 . 208104) (SK.COMPUTE.ARC.ARROWHEAD.POINTS 208106 . 209487) (ARC.ARROWHEAD.POINTS 209489 . +210712) (SET.ARC.ARROWHEAD.POINTS 210714 . 211695) (SET.OPENCURVE.ARROWHEAD.POINTS 211697 . 212598) ( +SK.COMPUTE.CURVE.ARROWHEAD.POINTS 212600 . 213870) (SET.WIRE.ARROWHEAD.POINTS 213872 . 214625) ( +SK.COMPUTE.WIRE.ARROWHEAD.POINTS 214627 . 215892) (SK.EXPAND.ARROWHEAD 215894 . 217077) (CHANGED.ARROW + 217079 . 220251) (SK.CHANGE.ARROWHEAD 220253 . 220706) (SK.CHANGE.ARROWHEAD1 220708 . 225963) ( +SK.CREATE.ARROWHEAD 225965 . 226485) (SK.ARROWHEAD.CREATE 226487 . 228061) (SK.ARROWHEAD.END.TEST +228063 . 228987) (READ.ARROWHEAD.END 228989 . 231014) (ARROW.HEAD.POSITIONS 231016 . 232856) ( +ARROWHEAD.POINTS.LIST 232858 . 236830) (CURVE.ARROWHEAD.POINTS 236832 . 237695) (LEFT.MOST.IS.BEGINP +237697 . 238578) (WIRE.ARROWHEAD.POINTS 238580 . 240106) (DRAWARROWHEADS 240108 . 242478) ( +\SK.DRAW.TRIANGLE.ARROWHEAD 242480 . 244140) (\SK.ENDPT.OF.ARROW 244142 . 246399) ( +\SK.ADJUST.FOR.ARROWHEADS 246401 . 248906) (SK.SET.ARROWHEAD.LENGTH 248908 . 250052) ( +SK.SET.ARROWHEAD.ANGLE 250054 . 251150) (SK.SET.ARROWHEAD.TYPE 251152 . 254441) (SK.SET.LINE.ARROWHEAD + 254443 . 256856) (SK.UPDATE.ARROWHEAD.FORMAT 256858 . 258968) (SK.SET.LINE.LENGTH.MODE 258970 . +260448)) (260451 262252 (SK.INSURE.ARROWHEADS 260461 . 261643) (SK.ARROWHEADP 261645 . 262250)) ( +265049 327491 (SKETCH.CREATE.TEXT 265059 . 265573) (TEXT.CHANGEFN 265575 . 265967) (TEXT.READCHANGEFN +265969 . 274040) (\SK.READ.FONT.SIZE1 274042 . 276208) (SK.TEXT.ELT.WITH.SAME.FIELDS 276210 . 277850) +(SK.READFONTFAMILY 277852 . 280322) (CLOSE.PROMPT.WINDOW 280324 . 280748) (TEXT.DRAWFN 280750 . 281471 +) (TEXT.DRAWFN1 281473 . 284975) (TEXT.INSIDEFN 284977 . 285366) (TEXT.EXPANDFN 285368 . 287493) ( +SK.TEXT.LINE.REGIONS 287495 . 289369) (TEXT.UPDATE.GLOBAL.REGIONS 289371 . 290603) (REL.MOVE.REGION +290605 . 291142) (LTEXT.LINE.REGIONS 291144 . 294562) (TEXT.INPUTFN 294564 . 295074) (READ.TEXT 295076 + . 295824) (TEXT.POSITION.AND.CREATE 295826 . 298137) (CREATE.TEXT.ELEMENT 298139 . 298957) ( +SK.UPDATE.TEXT.AFTER.CHANGE 298959 . 299361) (SK.TEXT.FROM.TEXTBOX 299363 . 303169) ( +TEXT.SET.GLOBAL.REGIONS 303171 . 304464) (TEXT.REGIONFN 304466 . 305236) (TEXT.GLOBALREGIONFN 305238 + . 305926) (TEXT.TRANSLATEFN 305928 . 307243) (TEXT.TRANSFORMFN 307245 . 308368) (TEXT.TRANSLATEPTSFN +308370 . 308887) (TEXT.UPDATEFN 308889 . 313545) (SK.CHANGE.TEXT 313547 . 323825) (SK.CHANGE.FONT +323827 . 325557) (TEXT.SET.SCALES 325559 . 326527) (BREAK.AT.CARRIAGE.RETURNS 326529 . 327489)) ( +327492 340687 (SK.PICK.FONT 327502 . 331774) (SK.CHOOSE.TEXT.FONT 331776 . 336047) (SK.NEXTSIZEFONT +336049 . 337681) (SK.DECREASING.FONT.LIST 337683 . 340685)) (341106 352780 (SK.SET.FONT 341116 . +342383) (SK.SET.TEXT.FONT 342385 . 343387) (SK.SET.TEXT.SIZE 343389 . 344076) (SK.SET.TEXT.HORIZ.ALIGN + 344078 . 345652) (SK.READFONTSIZE 345654 . 347552) (SK.COLLECT.FONT.SIZES 347554 . 348635) ( +SK.SET.TEXT.VERT.ALIGN 348637 . 350679) (SK.SET.TEXT.LOOKS 350681 . 352138) (SK.SET.DEFAULT.TEXT.FACE +352140 . 352778)) (352781 353367 (CREATE.SKETCH.TERMTABLE 352791 . 353365)) (353368 355134 ( +SK.FONT.LIST 353378 . 353704) (SK.INSURE.FONT 353706 . 354228) (SK.INSURE.STYLE 354230 . 354748) ( +SK.INSURE.TEXT 354750 . 355132)) (355674 412967 (SKETCH.CREATE.TEXTBOX 355684 . 357326) ( +SK.COMPUTE.TEXTBOX.REGION.FOR.STRING 357328 . 359405) (SK.BREAK.INTO.LINES 359407 . 370593) ( +SK.BRUSH.SIZE 370595 . 370976) (SK.TEXTBOX.CREATE 370978 . 371775) (SK.TEXTBOX.CREATE1 371777 . 372841 +) (SK.UPDATE.TEXTBOX.AFTER.CHANGE 372843 . 373383) (SK.TEXTBOX.POSITION.IN.BOX 373385 . 375296) ( +TEXTBOX.CHANGEFN 375298 . 375772) (TEXTBOX.DRAWFN 375774 . 377810) (SK.TEXTURE.AROUND.REGIONS 377812 + . 383885) (ALL.EMPTY.REGIONS 383887 . 384377) (TEXTBOX.EXPANDFN 384379 . 391535) (TEXTBOX.INPUTFN +391537 . 393150) (TEXTBOX.INSIDEFN 393152 . 393565) (TEXTBOX.REGIONFN 393567 . 394421) ( +TEXTBOX.GLOBALREGIONFN 394423 . 394751) (TEXTBOX.SET.GLOBAL.REGIONS 394753 . 396084) ( +TEXTBOX.TRANSLATEFN 396086 . 397927) (TEXTBOX.TRANSLATEPTSFN 397929 . 400712) (TEXTBOX.TRANSFORMFN +400714 . 402382) (TEXTBOX.UPDATEFN 402384 . 404277) (TEXTBOX.READCHANGEFN 404279 . 409168) ( +SK.TEXTBOX.TEXT.POSITION 409170 . 409591) (SK.TEXTBOX.FROM.TEXT 409593 . 412198) (ADD.EOLS 412200 . +412965)) (413496 416997 (SK.SET.TEXTBOX.VERT.ALIGN 413506 . 415386) (SK.SET.TEXTBOX.HORIZ.ALIGN 415388 + . 416995)) (417380 461855 (SKETCH.CREATE.BOX 417390 . 417873) (SK.BOX.DRAWFN 417875 . 419034) ( +BOX.DRAWFN1 419036 . 421875) (KNOTS.OF.REGION 421877 . 423111) (SK.DRAWAREABOX 423113 . 429714) ( +SK.DRAWBOX 429716 . 430905) (SK.BOX.EXPANDFN 430907 . 434655) (SK.BOX.GETREGIONFN 434657 . 435843) ( +BOX.SET.SCALES 435845 . 437085) (SK.BOX.INPUTFN 437087 . 439020) (SK.BOX.CREATE 439022 . 439723) ( +SK.UPDATE.BOX.AFTER.CHANGE 439725 . 440236) (SK.BOX.INSIDEFN 440238 . 440628) (SK.BOX.REGIONFN 440630 + . 441343) (SK.BOX.GLOBALREGIONFN 441345 . 442083) (SK.BOX.READCHANGEFN 442085 . 445806) ( +SK.CHANGE.FILLING 445808 . 449756) (SK.CHANGE.FILLING.COLOR 449758 . 453414) (SK.BOX.TRANSLATEFN +453416 . 454595) (SK.BOX.TRANSFORMFN 454597 . 455542) (SK.BOX.TRANSLATEPTSFN 455544 . 457912) ( +UNSCALE.REGION.TO.GRID 457914 . 458839) (INCREASEREGION 458841 . 459432) (INSUREREGIONSIZE 459434 . +460605) (EXPANDREGION 460607 . 461487) (REGION.FROM.COORDINATES 461489 . 461853)) (462391 488746 ( +SKETCH.CREATE.ARC 462401 . 463210) (ARC.DRAWFN 463212 . 464939) (ARC.EXPANDFN 464941 . 467274) ( +ARC.INPUTFN 467276 . 471494) (SK.INVERT.CIRCLE 471496 . 472356) (SK.READ.ARC.ANGLE.POINT 472358 . +472865) (SK.SHOW.ARC 472867 . 473477) (ARC.CREATE 473479 . 474834) (SK.UPDATE.ARC.AFTER.CHANGE 474836 + . 475176) (ARC.MOVEFN 475178 . 476761) (ARC.TRANSLATEPTS 476763 . 478648) (ARC.INSIDEFN 478650 . +478900) (ARC.REGIONFN 478902 . 480038) (ARC.GLOBALREGIONFN 480040 . 481762) (ARC.TRANSLATE 481764 . +482746) (ARC.TRANSFORMFN 482748 . 485698) (ARC.READCHANGEFN 485700 . 488744)) (488747 497826 ( +SK.COMPUTE.ARC.ANGLE.PT 488757 . 489683) (SK.COMPUTE.ARC.ANGLE.PT.FROM.ANGLE 489685 . 490678) ( +SK.COMPUTE.ARC.PTS 490680 . 494252) (SK.SET.ARC.DIRECTION 494254 . 494828) (SK.SET.ARC.DIRECTION.CW +494830 . 495004) (SK.SET.ARC.DIRECTION.CCW 495006 . 495279) (SK.COMPUTE.SLOPE.OF.LINE 495281 . 495773) + (SK.CREATE.ARC.USING 495775 . 497012) (SET.ARC.SCALES 497014 . 497824)) (497827 498272 ( +SK.INSURE.DIRECTION 497837 . 498270)) (499643 545502 (GETSKETCHELEMENTPROP 499653 . 500961) ( +\SK.GET.ARC.ANGLEPT 500963 . 501524) (\GETSKETCHELEMENTPROP1 501526 . 501780) (\SK.GET.BRUSH 501782 . +502706) (\SK.GET.FILLING 502708 . 503806) (\SK.GET.ARROWHEADS 503808 . 504587) (\SK.GET.FONT 504589 . +505069) (\SK.GET.JUSTIFICATION 505071 . 505595) (\SK.GET.DIRECTION 505597 . 506074) (\SK.GET.DASHING +506076 . 507095) (PUTSKETCHELEMENTPROP 507097 . 509366) (\SK.PUT.FILLING 509368 . 510638) ( +ADDSKETCHELEMENTPROP 510640 . 511445) (REMOVESKETCHELEMENTPROP 511447 . 512236) (\SK.PUT.FONT 512238 + . 513052) (\SK.PUT.JUSTIFICATION 513054 . 514065) (\SK.PUT.DIRECTION 514067 . 514674) ( +\SK.PUT.DASHING 514676 . 516011) (\SK.PUT.BRUSH 516013 . 517932) (\SK.PUT.ARROWHEADS 517934 . 519900) +(SK.COPY.ELEMENT.PROPERTY.LIST 519902 . 520478) (SKETCH.UPDATE 520480 . 521210) (SKETCH.UPDATE1 521212 + . 522500) (\SKELT.GET.SCALE 522502 . 523490) (\SKELT.PUT.SCALE 523492 . 524799) (\SKELT.PUT.DATA +524801 . 526598) (SK.REPLACE.TEXT.IN.ELEMENT 526600 . 527553) (\SKELT.GET.DATA 527555 . 528622) ( +\SK.GET.1STCONTROLPT 528624 . 530136) (\SK.PUT.1STCONTROLPT 530138 . 535611) (\SK.GET.2NDCONTROLPT +535613 . 536528) (\SK.PUT.2NDCONTROLPT 536530 . 540718) (\SK.GET.3RDCONTROLPT 540720 . 541598) ( +\SK.PUT.3RDCONTROLPT 541600 . 545500)) (545503 546084 (LOWERLEFTCORNER 545513 . 545759) ( +UPPERRIGHTCORNER 545761 . 546082))))) STOP diff --git a/library/sketch/SKETCH-ELEMENTS.LCOM b/library/sketch/SKETCH-ELEMENTS.LCOM index 0f9dd78a63733c836d7b1b84fd843c09c45ff503..4a6c1e7b67bd7de71cd4d78764fc55e3923ab96d 100644 GIT binary patch delta 516 zcmexxpJVEMjtSu+h8DUmsmZ!V21cd|1_o9}=2j+#6SHk4Ei@Illnjj!l7^O6#%5Lq z#uE=pPCshFC=#QPnWv!S7V6`pfUHbUPftl9C9xzm1*?8TBPC5P4L468SLYyC#}HQ+ z1tn}Qm>j^U%VD8lYGP(+U_QB(Q5kIIHHLe)(k(2OAn#nVMS}nJ6i6O{~>z zmSEa0!Nka8Iz8K*(NXXW7Xt&6!&c681|Udc$l;lOz?@OMK9d{72g)%pNNuoBVH9L! z@nHn3@nK?O1Y!sQC7Gl^AR{FuC6kv8q(>-{d79T&InU^*{Y=bT4|xj-DzbVrZxt6b z;PB-HDcIlyrlLG0H{558Nnv92m01ELq+<7bGevK>KHbWKQK#PALcz`7F9Z?>3Wmn! z3O%+b@w(aFbE!NgR-+21wD*%hQOIKb6e!NdTp#>F+v z)7dp3$UguWux17dS_;M{3eFymL15*c{(iv<<_f<4F0Mg-Kn0py!QOho+u1A`Uws1r D@(y>v delta 615 zcmZ`$&ui2`7@f&l-KG>xDaft`KU0K_bi?G=ZVU*WCbMqb*QG|jA&wBBsV3Gn<@yL%g_r z@jMDRy@;*(;c8s>veqDjeeT1iLv+WmN1w2Y&6hL6@r;0HttCnb(ZKO+vBsgML97FT zSW^^0QwSkpnSQ&50-uZ7KKj|f{oy+?FHfd-GZ^il;u@rMP|cTwkwi-ElosWTiBNG= z$2U_f;Y)mwrs>}7*c{*jMYrgQR!Um1VI z{ZzP$y9;jx+^ue%bcD_EheI1L^(_PPNX|S3P1AwXILT7BAP%Dh8qETa=^FJpUEvJO zCb%JsT$bzN9&^Fe3yzmr=(1iE_OhTfLf{BD@%0;LJ{g&+O`}5Thd~UQ33ra)*!aiy EU$A?TZ2$lO diff --git a/library/sketch/SKETCH-OPS b/library/sketch/SKETCH-OPS index 506f20db..25781eee 100644 --- a/library/sketch/SKETCH-OPS +++ b/library/sketch/SKETCH-OPS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Dec-2023 00:08:46" {WMEDLEY}sketch>SKETCH-OPS.;1 221752 +(FILECREATED "14-Dec-2025 00:35:27" {WMEDLEY}sketch>SKETCH-OPS.;9 220612 :EDIT-BY rmk - :CHANGES-TO (RECORDS AFFINETRANSFORMATION SKHISTEVENT SKEVENTTYPE SKETCHVIEW) + :CHANGES-TO (FNS SK.PRINTER.FILE.CANDIDATE.NAME) - :PREVIOUS-DATE " 3-May-2023 21:06:28" {WMEDLEY}sketch>SKETCHOPS.;2) + :PREVIOUS-DATE "29-Nov-2025 21:49:05" {WMEDLEY}sketch>SKETCH-OPS.;8) (PRETTYCOMPRINT SKETCH-OPSCOMS) @@ -17,9 +17,8 @@ (COMS (* ;; "miscellaneous utility functions") - (FNS SK.FONTNAMELIST SCALE.REGION.OUT SK.SCALE.POSITION.INTO.VIEWER - SK.SCALE.POSITION.INTO.VIEWER.EXACT SK.MAKE.POSITION.INTEGER - SCALE.POSITION.INTO.SKETCHW UNSCALE UNSCALE.REGION) + (FNS SCALE.REGION.OUT SK.SCALE.POSITION.INTO.VIEWER SK.SCALE.POSITION.INTO.VIEWER.EXACT + SK.MAKE.POSITION.INTEGER SCALE.POSITION.INTO.SKETCHW UNSCALE UNSCALE.REGION) (* ;; "misc IO functions") @@ -45,9 +44,8 @@ (FNS SKETCHW.HARDCOPYFN SK.LIST.IMAGE SK.HARDCOPYIMAGEW) (FNS SK.DO.HARDCOPYIMAGEW.TOFILE SK.HARDCOPYIMAGEW.TOFILE SK.HARDCOPYIMAGEW.TOPRINTER SK.LIST.IMAGE.ON.FILE) - (FNS \SK.LIST.PAGE.IMAGE SK.GetImageFile SK.PRINTER.FILE.CANDIDATE.NAME - SK.SET.HARDCOPY.MODE SK.UNSET.HARDCOPY.MODE SK.UPDATE.AFTER.HARDCOPY - DEFAULTPRINTINGIMAGETYPE SK.SWITCH.REGION.X.AND.Y) + (FNS \SK.LIST.PAGE.IMAGE SK.PRINTER.FILE.CANDIDATE.NAME SK.SET.HARDCOPY.MODE + SK.UNSET.HARDCOPY.MODE SK.UPDATE.AFTER.HARDCOPY SK.SWITCH.REGION.X.AND.Y) (CONSTANTS MICASPERPT IMICASPERPT PTSPERMICA))) (COMS (* ;; "fns to implement transformations on the elements") @@ -140,8 +138,8 @@ SK.NAME.CURRENT.VIEW SKETCH.ADD.VIEW SK.RESTORE.VIEW SK.FORGET.VIEW) (DECLARE%: DONTCOPY (RECORDS SKETCHVIEW))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP) - SKETCH SKETCHELEMENTS SKETCHOBJ - SKETCHEDIT INTERPRESS)) + SKETCH SKETCH-ELEMENTS SKETCH-OBJ + SKETCH-EDIT INTERPRESS)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA STATUSPRINT]) @@ -157,12 +155,6 @@ (DEFINEQ -(SK.FONTNAMELIST - [LAMBDA (FONTDESC) (* rrb " 2-NOV-83 21:00") - (LIST (FONTPROP FONTDESC 'FAMILY) - (FONTPROP FONTDESC 'SIZE) - (FONTPROP FONTDESC 'FACE]) - (SCALE.REGION.OUT [LAMBDA (REGION SCALE) (* rrb "30-Dec-85 17:24") @@ -700,7 +692,8 @@ (DEFINEQ (SKETCHW.HARDCOPYFN - [LAMBDA (SKETCHW OPENIMAGESTREAM) (* ; "Edited 20-Aug-92 13:33 by jds") + [LAMBDA (SKETCHW OPENIMAGESTREAM) (* ; "Edited 3-Nov-2025 19:55 by rmk") + (* ; "Edited 20-Aug-92 13:33 by jds") (* ;  "dumps the sketch onto OPENIMAGESTREAM.") (* ; @@ -728,7 +721,9 @@ (* ;; "PAGETOSKETCHFACTOR is the factor to multiply the page coordinates by to get into sketch coordinates.") - (STATUSPRINT SKETCHW "Hardcopying ...") + (STATUSPRINT SKETCHW "Hardcopying" (CL:UNLESS (STREAMP (FULLNAME OPENIMAGESTREAM)) + (CONCAT " to " (FULLNAME OPENIMAGESTREAM))) + " ...") [STREAMPROP OPENIMAGESTREAM 'PRINTOPTIONS (APPEND (LIST 'DOCUMENT.NAME (OR (SKETCH.TITLE SKETCHW) "A Sketch")) @@ -950,15 +945,12 @@ (DEFINEQ (SK.DO.HARDCOPYIMAGEW.TOFILE - [LAMBDA (W) (* rrb " 5-May-86 13:38") - (* sketch version of - HARDCOPYIMAGEW.TOFILE that accepts a - candidate file name.) - (RESETFORM (TTY.PROCESS (THIS.PROCESS)) - (LET [(FILE&TYPE (SK.GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME W] - (COND - (FILE&TYPE (HARDCOPY.SOMEHOW W (CAR FILE&TYPE) - (CDR FILE&TYPE]) + [LAMBDA (W) (* ; "Edited 4-Nov-2025 21:47 by rmk") + (* ; "Edited 3-Nov-2025 16:17 by rmk") + (* rrb " 5-May-86 13:38") + (* ; + "sketch version of HARDCOPYIMAGEW.TOFILE that accepts a candidate file name.") + (HARDCOPY.SOMEHOW W (GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME W]) (SK.HARDCOPYIMAGEW.TOFILE [LAMBDA (SKW) (* rrb " 5-May-86 13:34") @@ -981,16 +973,16 @@ 'SketchHardcopy]) (SK.LIST.IMAGE.ON.FILE - [LAMBDA (SKETCHW) (* rrb " 5-May-86 13:39") + [LAMBDA (SKETCHW) (* ; "Edited 4-Nov-2025 21:46 by rmk") + (* ; "Edited 3-Nov-2025 16:20 by rmk") + (* rrb " 5-May-86 13:39") - (* makes a file suitable for the default printing host of the current sketch. - Pretty dumb about file names.) + (* ;; "makes a file suitable for the default printing host of the current sketch. Pretty dumb about file names.") - (RESETFORM (TTY.PROCESS (THIS.PROCESS)) - (LET [(FILE&TYPE (SK.GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME SKETCHW] - (COND - (FILE&TYPE (SK.LIST.IMAGE SKETCHW (CAR FILE&TYPE) - (CDR FILE&TYPE]) + (LET [(FILE&TYPE (GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME SKETCHW] + (CL:WHEN FILE&TYPE + (SK.LIST.IMAGE SKETCHW (CAR FILE&TYPE) + (CDR FILE&TYPE)))]) ) (DEFINEQ @@ -1027,46 +1019,21 @@ PAGETOSKETCHFACTOR OPENIMAGESTREAM T)) (DRAW.LOCAL.SKETCH SKETCHX OPENIMAGESTREAM REGIONONPAGE]) -(SK.GetImageFile - [LAMBDA (CANDIDATE) (* rrb " 5-May-86 10:41") - (* version of GetImageFile that takes - a candidate name.) - (PROG ((FILE (PopUpWindowAndGetAtom "File name (CR to abort): " CANDIDATE)) - PRINTFILETYPE FILETYPEMENU EXTENSIONSUPPLIED EXTENSIONFORTYPE) - (COND - ((NULL FILE) - (RETURN))) - (SETQ FILETYPEMENU (MakeMenuOfImageTypes "File type?")) - (COND - ((SETQ PRINTFILETYPE (PRINTFILETYPE.FROM.EXTENSION FILE)) - (RETURN (CONS FILE PRINTFILETYPE))) - (T (SETQ PRINTFILETYPE (MENU FILETYPEMENU)) - (COND - ((NULL PRINTFILETYPE) - (RETURN)) - (T (RETURN (CONS FILE PRINTFILETYPE]) - (SK.PRINTER.FILE.CANDIDATE.NAME - [LAMBDA (VIEWER) (* rrb " 5-May-86 13:30") + [LAMBDA (VIEWER) (* ; "Edited 14-Dec-2025 00:33 by rmk") + (* ; "Edited 3-Nov-2025 16:05 by rmk") + (* rrb " 5-May-86 13:30") - (* * returns the preferred printer file name for a viewer) + (* ;; "Returns the preferred imagefile name for a viewer.") - (PROG ((FILENAME (SK.OUTPUT.FILE.NAME (SKETCH.TITLE VIEWER))) - EXTENSION PRINTEXTENSION) - (OR FILENAME (RETURN)) - [COND - ((EQ (SELECTQ (SETQ PRINTEXTENSION (DEFAULTPRINTINGIMAGETYPE)) - (INTERPRESS (SETQ PRINTEXTENSION 'IP)) - NIL) - (FILENAMEFIELD FILENAME 'EXTENSION)) + (* ;; "RMK: Original had IP built in in some way, odd conditions, plus an unbound variable. I assume that the extension of the filename is something like .SKETCH and not usually .IP (or now .PDF). And that therefore the intent is really that the result should have the extension that the deffaultprinting host can print directly.") - (* file name has a printer extension for some reason, propose either a null - extension or hdcpy extension.) - - (COND - (PRINTEXTENSION (SETQ PRINTEREXTENSION NIL)) - (T (SETQ PRINTEREXTENSION 'HDCPY] - (RETURN (PACKFILENAME 'EXTENSION PRINTEXTENSION 'BODY FILENAME]) + (LET ((FILENAME (SK.OUTPUT.FILE.NAME (SKETCH.TITLE VIEWER))) + PRINTEXTENSION) + (CL:WHEN [AND FILENAME (SETQ PRINTEXTENSION (CAR (EXTENSIONS.FOR.IMAGEFILETYPE ( + CAN.PRINT.DIRECTLY + ] + (PACKFILENAME 'EXTENSION PRINTEXTENSION 'BODY FILENAME))]) (SK.SET.HARDCOPY.MODE [LAMBDA (SKETCHW IMAGETYPE) (* rrb "28-Oct-85 16:43") @@ -1121,15 +1088,6 @@ (VIEWER.SCALE SKETCHW)) (REDISPLAYW SKETCHW]) -(DEFAULTPRINTINGIMAGETYPE - [LAMBDA NIL (* rrb "20-Mar-85 12:45") - (* returns the image type of the - default printer.) - (* code copied from OPENIMAGESTREAM) - (CAR (MKLIST (PRINTERPROP (PRINTERTYPE (OR (CAR (LISTP DEFAULTPRINTINGHOST)) - DEFAULTPRINTINGHOST)) - 'CANPRINT]) - (SK.SWITCH.REGION.X.AND.Y [LAMBDA (REGION) (* rrb " 3-Sep-85 14:50") (* switchs the X and Y dimensions of a @@ -1145,7 +1103,7 @@ (RPAQQ IMICASPERPT 35) -(RPAQQ PTSPERMICA 0.02834646) +(RPAQQ PTSPERMICA 0.028346457) (CONSTANTS MICASPERPT IMICASPERPT PTSPERMICA) @@ -2884,10 +2842,12 @@ If you meant this, you should use the TWO PT TRANSFORM.") (STATUSPRINT SKW "Element subsequently modified, can't undo"]) (SK.UNDO.LAST - [LAMBDA (SKW) (* rrb " 5-Dec-85 17:19") - (* undoes the first not yet undone - history event.) + [LAMBDA (SKW) (* ; "Edited 29-Nov-2025 21:48 by rmk") + (* rrb " 5-Dec-85 17:19") + (* ; + "undoes the first not yet undone history event.") (SKED.CLEAR.SELECTION SKW) + (CLEARPROMPTWINDOW SKW) (PROG [EVENT UNDOFN (HISTLST (WINDOWPROP SKW 'SKETCHHISTORY] (COND ((NULL HISTLST) @@ -2905,8 +2865,8 @@ If you meant this, you should use the TWO PT TRANSFORM.") do (RETURN HISTEVENT))) (COND ((APPLY* UNDOFN (fetch (SKHISTEVENT EVENTARGS) of EVENT) - SKW EVENT) (* only add to history list if - something happened.) + SKW EVENT) (* ; + "only add to history list if something happened.") (STATUSPRINT SKW (SK.UNDO.NAME EVENT) " event undone.") (replace (SKHISTEVENT UNDONE?) of EVENT with T) @@ -4094,7 +4054,7 @@ It can be either larger or smaller than the present window size.") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILESLOAD (LOADCOMP) - SKETCH SKETCHELEMENTS SKETCHOBJ SKETCHEDIT INTERPRESS) + SKETCH SKETCH-ELEMENTS SKETCH-OBJ SKETCH-EDIT INTERPRESS) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS @@ -4105,85 +4065,84 @@ It can be either larger or smaller than the present window size.") (ADDTOVAR LAMA STATUSPRINT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (9853 14154 (SK.FONTNAMELIST 9863 . 10085) (SCALE.REGION.OUT 10087 . 11068) ( -SK.SCALE.POSITION.INTO.VIEWER 11070 . 11826) (SK.SCALE.POSITION.INTO.VIEWER.EXACT 11828 . 12370) ( -SK.MAKE.POSITION.INTEGER 12372 . 13040) (SCALE.POSITION.INTO.SKETCHW 13042 . 13434) (UNSCALE 13436 . -13564) (UNSCALE.REGION 13566 . 14152)) (14190 17888 (STATUSPRINT 14200 . 15562) (CLEARPROMPTWINDOW -15564 . 15971) (CLOSEPROMPTWINDOW 15973 . 16470) (MYGETPROMPTWINDOW 16472 . 17171) (PROMPT.GETINPUT -17173 . 17886)) (17946 28977 (SK.SEND.TO.BOTTOM 17956 . 18295) (SK.BRING.TO.TOP 18297 . 18665) ( -SK.SWITCH.PRIORITIES 18667 . 18993) (SK.SEL.AND.CHANGE.PRIORITY 18995 . 19563) ( -SK.SEL.AND.SWITCH.PRIORITIES 19565 . 21332) (SK.SORT.ELTS.BY.PRIORITY 21334 . 22055) ( -SK.SORT.GELTS.BY.PRIORITY 22057 . 22636) (SORT.CHANGESPECS.BY.NEW.PRIORITY 22638 . 23326) ( -SORT.CHANGESPECS.BY.OLD.PRIORITY 23328 . 24016) (SK.SEND.ELEMENTS.TO.BOTTOM 24018 . 25689) ( -SK.BRING.ELEMENTS.TO.TOP 25691 . 27375) (SK.COPY.GLOBAL.ELEMENT.AND.PROPERTY.LIST 27377 . 28975)) ( -28978 31834 (SK.ELEMENT.PRIORITY 28988 . 29316) (SK.SET.ELEMENT.PRIORITY 29318 . 30262) ( -SK.POP.NEXT.PRIORITY 30264 . 30607) (SK.PRIORITY.CELL 30609 . 30814) (SK.HIGH.PRIORITY 30816 . 31319) -(SK.LOW.PRIORITY 31321 . 31832)) (31897 38700 (DRAW.LOCAL.SKETCH 31907 . 32909) (SET.PRIORITYIMPORTANT - 32911 . 33479) (SK.FIGUREIMAGE 33481 . 38698)) (38744 57418 (SKETCHW.HARDCOPYFN 38754 . 45959) ( -SK.LIST.IMAGE 45961 . 57068) (SK.HARDCOPYIMAGEW 57070 . 57416)) (57419 59376 ( -SK.DO.HARDCOPYIMAGEW.TOFILE 57429 . 58103) (SK.HARDCOPYIMAGEW.TOFILE 58105 . 58467) ( -SK.HARDCOPYIMAGEW.TOPRINTER 58469 . 58831) (SK.LIST.IMAGE.ON.FILE 58833 . 59374)) (59377 67301 ( -\SK.LIST.PAGE.IMAGE 59387 . 61819) (SK.GetImageFile 61821 . 62751) (SK.PRINTER.FILE.CANDIDATE.NAME -62753 . 63672) (SK.SET.HARDCOPY.MODE 63674 . 65059) (SK.UNSET.HARDCOPY.MODE 65061 . 65479) ( -SK.UPDATE.AFTER.HARDCOPY 65481 . 66189) (DEFAULTPRINTINGIMAGETYPE 66191 . 66781) ( -SK.SWITCH.REGION.X.AND.Y 66783 . 67299)) (67539 80436 (SK.SEL.AND.TRANSFORM 67549 . 67899) ( -SK.TRANSFORM.ELEMENTS 67901 . 69156) (SK.TRANSFORM.ITEM 69158 . 69959) (SK.TRANSFORM.ELEMENT 69961 . -70419) (SK.TRANSFORM.POINT 70421 . 70771) (SK.TRANSFORM.POINT.LIST 70773 . 70994) (SK.TRANSFORM.REGION - 70996 . 73182) (SK.PUT.ELTS.ON.GRID 73184 . 73662) (SK.TRANSFORM.GLOBAL.ELEMENTS 73664 . 74166) ( -GLOBALELEMENTP 74168 . 74459) (SKETCH.LIST.OF.ELEMENTSP 74461 . 74765) (SK.TRANSFORM.SCALE.FACTOR -74767 . 76460) (SK.TRANSFORM.BRUSH 76462 . 76929) (SK.TRANSFORM.ARROWHEADS 76931 . 78522) (SCALE.BRUSH - 78524 . 80434)) (80437 100629 (TWO.PT.TRANSFORMATION.INPUTFN 80447 . 83220) (SK.TWO.PT.TRANSFORM.ELTS - 83222 . 83627) (SK.SEL.AND.TWO.PT.TRANSFORM 83629 . 84220) (SK.APPLY.AFFINE.TRANSFORM 84222 . 85341) -(SK.COMPUTE.TWO.PT.TRANSFORMATION 85343 . 89681) (SK.COMPUTE.SLOPE 89683 . 90448) ( -SK.THREE.PT.TRANSFORM.ELTS 90450 . 90861) (SK.COMPUTE.THREE.PT.TRANSFORMATION 90863 . 95400) ( -SK.SEL.AND.THREE.PT.TRANSFORM 95402 . 95999) (THREE.PT.TRANSFORMATION.INPUTFN 96001 . 100627)) (100630 - 104657 (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS 100640 . 101059) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM 101061 - . 101682) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS 101684 . 102113) (SK.SEL.COPY.AND.THREE.PT.TRANSFORM -102115 . 102739) (SK.COPY.AND.TRANSFORM.ELEMENTS 102741 . 103785) (SK.COPY.AND.TRANSFORM.ITEM 103787 - . 104655)) (106785 109980 (SK.SHOWMARKS 106795 . 107695) (MARKPOINT 107697 . 108417) (SK.MARKHOTSPOTS - 108419 . 109494) (SK.MARK.SELECTION 109496 . 109978)) (110509 117287 (SK.SELECT.ITEM 110519 . 113179) - (IN.SKETCH.ELT? 113181 . 115567) (SK.MARK.HOTSPOT 115569 . 116051) (SK.MARK.POSITION 116053 . 116490) - (SK.SELECT.ELT 116492 . 116919) (SK.DESELECT.ELT 116921 . 117285)) (117430 130244 (SK.HOTSPOT.CACHE -117440 . 117784) (SK.HOTSPOT.CACHE.FOR.OPERATION 117786 . 119141) (SK.BUILD.CACHE 119143 . 119966) ( -SK.ELEMENT.PROTECTED? 119968 . 120561) (SK.HAS.SOME.HOTSPOTS 120563 . 121017) (SK.SET.HOTSPOT.CACHE -121019 . 121374) (SK.CREATE.HOTSPOT.CACHE 121376 . 121826) (SK.ELTS.FROM.HOTSPOT 121828 . 122668) ( -SK.ADD.HOTSPOTS.TO.CACHE 122670 . 123071) (SK.ADD.HOTSPOTS.TO.CACHE1 123073 . 123619) ( -SK.ADD.HOTSPOT.TO.CACHE 123621 . 125497) (SK.REMOVE.HOTSPOTS.FROM.CACHE 125499 . 125902) ( -SK.REMOVE.HOTSPOTS.FROM.CACHE1 125904 . 126422) (SK.REMOVE.HOTSPOT.FROM.CACHE 126424 . 126987) ( -SK.REMOVE.VALUE.FROM.CACHE.BUCKET 126989 . 127958) (SK.FIND.CACHE.BUCKET 127960 . 128549) ( -SK.ADD.VALUE.TO.CACHE.BUCKET 128551 . 130242)) (130272 149715 (SK.SET.GRID 130282 . 130703) ( -SK.DISPLAY.GRID 130705 . 131254) (SK.DISPLAY.GRID.POINTS 131256 . 131452) (SK.REMOVE.GRID.POINTS -131454 . 132257) (SK.TAKE.DOWN.GRID 132259 . 132570) (SK.SHOW.GRID 132572 . 136186) (SK.GRIDFACTOR -136188 . 136709) (SK.TURN.GRID.ON 136711 . 137039) (SK.TURN.GRID.OFF 137041 . 137399) ( -SK.MAKE.GRID.LARGER 137401 . 138133) (SK.MAKE.GRID.SMALLER 138135 . 138888) (SK.CHANGE.GRID 138890 . -139338) (GRID.FACTOR1 139340 . 139697) (LEASTPOWEROF2GT 139699 . 140473) (GREATESTPOWEROF2LT 140475 . -141090) (SK.DEFAULT.GRIDFACTOR 141092 . 141645) (SK.PUT.ON.GRID 141647 . 142205) (MAP.WINDOW.ONTO.GRID - 142207 . 142641) (MAP.SCREEN.ONTO.GRID 142643 . 143131) (MAP.GLOBAL.PT.ONTO.GRID 143133 . 143515) ( -MAP.GLOBAL.REGION.ONTO.GRID 143517 . 145234) (MAP.WINDOW.POINT.ONTO.GLOBAL.GRID 145236 . 145779) ( -MAP.WINDOW.ONTO.GLOBAL.GRID 145781 . 146166) (SK.UPDATE.GRIDFACTOR 146168 . 146804) ( -SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID 146806 . 147344) (SK.MAP.INPUT.PT.TO.GLOBAL 147346 . 148563) ( -SK.MAP.FROM.WINDOW.TO.NEAREST.GRID 148565 . 149713)) (149855 158278 (SK.ADD.HISTEVENT 149865 . 151000) - (SK.SEL.AND.UNDO 151002 . 153916) (SK.UNDO.LAST 153918 . 155995) (SK.UNDO.NAME 155997 . 156501) ( -SKEVENTTYPEFNS 156503 . 156853) (SK.TYPE.OF.FIRST.ARG 156855 . 158276)) (158279 158965 (SK.DELETE.UNDO - 158289 . 158718) (SK.ADD.UNDO 158720 . 158963)) (158966 165748 (SK.CHANGE.UNDO 158976 . 160959) ( -SK.ELT.IN.SKETCH? 160961 . 161215) (SK.CHANGE.REDO 161217 . 163085) (SK.MOVE.UNDO 163087 . 164480) ( -SK.MOVE.REDO 164482 . 165746)) (165749 167848 (SK.UNDO.UNDO 165759 . 167025) (SK.UNDO.MENULABEL 167027 - . 167422) (SK.LABEL.FROM.TYPE 167424 . 167846)) (168698 176540 (SHOW.GLOBAL.COORDS 168708 . 169257) ( -LOCATOR.CLOSEFN 169259 . 169544) (SKETCHW.FROM.LOCATOR 169546 . 169954) (SKETCHW.UPDATE.LOCATORS -169956 . 170542) (LOCATOR.UPDATE 170544 . 171302) (UPDATE.GLOBAL.LOCATOR 171304 . 172105) ( -UPDATE.GLOBALCOORD.LOCATOR 172107 . 172684) (ADD.GLOBAL.DISPLAY 172686 . 173603) ( -ADD.GLOBAL.GRIDDED.DISPLAY 173605 . 173864) (CREATE.GLOBAL.DISPLAYER 173866 . 174943) ( -UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR 174945 . 176538)) (176747 189234 (DISPLAYREADCOLORHLSLEVELS 176757 - . 177593) (DISPLAYREADCOLORLEVEL 177595 . 178630) (DRAWREADCOLORBOX 178632 . 179621) ( -READ.CHANGE.COLOR 179623 . 179840) (READCOLOR1 179842 . 182756) (READCOLORCOMMANDMENUSELECTEDFN 182758 - . 183125) (READCOLOR2 183127 . 189232)) (189235 190694 (CREATE.CNS.MENU 189245 . 190692)) (190971 -193681 (SK.ABSWXOFFSET 190981 . 191275) (SK.ABSWYOFFSET 191277 . 191571) ( -SK.UNSCALE.POSITION.FROM.VIEWER 191573 . 192142) (SK.SCALE.REGION 192144 . 193679)) (193720 208718 ( -VIEWER.SCALE 193730 . 194039) (SKETCH.ZOOM 194041 . 195076) (SAME.ASPECT.RATIO 195078 . 196442) ( -SKETCH.DO.ZOOM 196444 . 197649) (SKETCH.NEW.VIEW 197651 . 198166) (ZOOM.UPDATE.ELT 198168 . 199061) ( -SK.UPDATE.AFTER.SCALE.CHANGE 199063 . 200932) (SKETCH.AUTOZOOM 200934 . 205354) ( -SKETCH.GLOBAL.REGION.ZOOM 205356 . 208716)) (209355 221267 (SKETCH.HOME 209365 . 209892) (SK.FRAME.IT -209894 . 210486) (SK.FRAME.WINDOW.TO.SKETCH 210488 . 214334) (SK.MOVE.TO.VIEW 214336 . 215750) ( -SK.NAME.CURRENT.VIEW 215752 . 216862) (SKETCH.ADD.VIEW 216864 . 217957) (SK.RESTORE.VIEW 217959 . -219835) (SK.FORGET.VIEW 219837 . 221265))))) + (FILEMAP (NIL (9724 13801 (SCALE.REGION.OUT 9734 . 10715) (SK.SCALE.POSITION.INTO.VIEWER 10717 . 11473 +) (SK.SCALE.POSITION.INTO.VIEWER.EXACT 11475 . 12017) (SK.MAKE.POSITION.INTEGER 12019 . 12687) ( +SCALE.POSITION.INTO.SKETCHW 12689 . 13081) (UNSCALE 13083 . 13211) (UNSCALE.REGION 13213 . 13799)) ( +13837 17535 (STATUSPRINT 13847 . 15209) (CLEARPROMPTWINDOW 15211 . 15618) (CLOSEPROMPTWINDOW 15620 . +16117) (MYGETPROMPTWINDOW 16119 . 16818) (PROMPT.GETINPUT 16820 . 17533)) (17593 28624 ( +SK.SEND.TO.BOTTOM 17603 . 17942) (SK.BRING.TO.TOP 17944 . 18312) (SK.SWITCH.PRIORITIES 18314 . 18640) +(SK.SEL.AND.CHANGE.PRIORITY 18642 . 19210) (SK.SEL.AND.SWITCH.PRIORITIES 19212 . 20979) ( +SK.SORT.ELTS.BY.PRIORITY 20981 . 21702) (SK.SORT.GELTS.BY.PRIORITY 21704 . 22283) ( +SORT.CHANGESPECS.BY.NEW.PRIORITY 22285 . 22973) (SORT.CHANGESPECS.BY.OLD.PRIORITY 22975 . 23663) ( +SK.SEND.ELEMENTS.TO.BOTTOM 23665 . 25336) (SK.BRING.ELEMENTS.TO.TOP 25338 . 27022) ( +SK.COPY.GLOBAL.ELEMENT.AND.PROPERTY.LIST 27024 . 28622)) (28625 31481 (SK.ELEMENT.PRIORITY 28635 . +28963) (SK.SET.ELEMENT.PRIORITY 28965 . 29909) (SK.POP.NEXT.PRIORITY 29911 . 30254) (SK.PRIORITY.CELL +30256 . 30461) (SK.HIGH.PRIORITY 30463 . 30966) (SK.LOW.PRIORITY 30968 . 31479)) (31544 38347 ( +DRAW.LOCAL.SKETCH 31554 . 32556) (SET.PRIORITYIMPORTANT 32558 . 33126) (SK.FIGUREIMAGE 33128 . 38345)) + (38391 57335 (SKETCHW.HARDCOPYFN 38401 . 45876) (SK.LIST.IMAGE 45878 . 56985) (SK.HARDCOPYIMAGEW +56987 . 57333)) (57336 59339 (SK.DO.HARDCOPYIMAGEW.TOFILE 57346 . 57943) (SK.HARDCOPYIMAGEW.TOFILE +57945 . 58307) (SK.HARDCOPYIMAGEW.TOPRINTER 58309 . 58671) (SK.LIST.IMAGE.ON.FILE 58673 . 59337)) ( +59340 66025 (\SK.LIST.PAGE.IMAGE 59350 . 61782) (SK.PRINTER.FILE.CANDIDATE.NAME 61784 . 62988) ( +SK.SET.HARDCOPY.MODE 62990 . 64375) (SK.UNSET.HARDCOPY.MODE 64377 . 64795) (SK.UPDATE.AFTER.HARDCOPY +64797 . 65505) (SK.SWITCH.REGION.X.AND.Y 65507 . 66023)) (66264 79161 (SK.SEL.AND.TRANSFORM 66274 . +66624) (SK.TRANSFORM.ELEMENTS 66626 . 67881) (SK.TRANSFORM.ITEM 67883 . 68684) (SK.TRANSFORM.ELEMENT +68686 . 69144) (SK.TRANSFORM.POINT 69146 . 69496) (SK.TRANSFORM.POINT.LIST 69498 . 69719) ( +SK.TRANSFORM.REGION 69721 . 71907) (SK.PUT.ELTS.ON.GRID 71909 . 72387) (SK.TRANSFORM.GLOBAL.ELEMENTS +72389 . 72891) (GLOBALELEMENTP 72893 . 73184) (SKETCH.LIST.OF.ELEMENTSP 73186 . 73490) ( +SK.TRANSFORM.SCALE.FACTOR 73492 . 75185) (SK.TRANSFORM.BRUSH 75187 . 75654) (SK.TRANSFORM.ARROWHEADS +75656 . 77247) (SCALE.BRUSH 77249 . 79159)) (79162 99354 (TWO.PT.TRANSFORMATION.INPUTFN 79172 . 81945) + (SK.TWO.PT.TRANSFORM.ELTS 81947 . 82352) (SK.SEL.AND.TWO.PT.TRANSFORM 82354 . 82945) ( +SK.APPLY.AFFINE.TRANSFORM 82947 . 84066) (SK.COMPUTE.TWO.PT.TRANSFORMATION 84068 . 88406) ( +SK.COMPUTE.SLOPE 88408 . 89173) (SK.THREE.PT.TRANSFORM.ELTS 89175 . 89586) ( +SK.COMPUTE.THREE.PT.TRANSFORMATION 89588 . 94125) (SK.SEL.AND.THREE.PT.TRANSFORM 94127 . 94724) ( +THREE.PT.TRANSFORMATION.INPUTFN 94726 . 99352)) (99355 103382 (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS 99365 + . 99784) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM 99786 . 100407) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS +100409 . 100838) (SK.SEL.COPY.AND.THREE.PT.TRANSFORM 100840 . 101464) (SK.COPY.AND.TRANSFORM.ELEMENTS +101466 . 102510) (SK.COPY.AND.TRANSFORM.ITEM 102512 . 103380)) (105510 108705 (SK.SHOWMARKS 105520 . +106420) (MARKPOINT 106422 . 107142) (SK.MARKHOTSPOTS 107144 . 108219) (SK.MARK.SELECTION 108221 . +108703)) (109234 116012 (SK.SELECT.ITEM 109244 . 111904) (IN.SKETCH.ELT? 111906 . 114292) ( +SK.MARK.HOTSPOT 114294 . 114776) (SK.MARK.POSITION 114778 . 115215) (SK.SELECT.ELT 115217 . 115644) ( +SK.DESELECT.ELT 115646 . 116010)) (116155 128969 (SK.HOTSPOT.CACHE 116165 . 116509) ( +SK.HOTSPOT.CACHE.FOR.OPERATION 116511 . 117866) (SK.BUILD.CACHE 117868 . 118691) ( +SK.ELEMENT.PROTECTED? 118693 . 119286) (SK.HAS.SOME.HOTSPOTS 119288 . 119742) (SK.SET.HOTSPOT.CACHE +119744 . 120099) (SK.CREATE.HOTSPOT.CACHE 120101 . 120551) (SK.ELTS.FROM.HOTSPOT 120553 . 121393) ( +SK.ADD.HOTSPOTS.TO.CACHE 121395 . 121796) (SK.ADD.HOTSPOTS.TO.CACHE1 121798 . 122344) ( +SK.ADD.HOTSPOT.TO.CACHE 122346 . 124222) (SK.REMOVE.HOTSPOTS.FROM.CACHE 124224 . 124627) ( +SK.REMOVE.HOTSPOTS.FROM.CACHE1 124629 . 125147) (SK.REMOVE.HOTSPOT.FROM.CACHE 125149 . 125712) ( +SK.REMOVE.VALUE.FROM.CACHE.BUCKET 125714 . 126683) (SK.FIND.CACHE.BUCKET 126685 . 127274) ( +SK.ADD.VALUE.TO.CACHE.BUCKET 127276 . 128967)) (128997 148440 (SK.SET.GRID 129007 . 129428) ( +SK.DISPLAY.GRID 129430 . 129979) (SK.DISPLAY.GRID.POINTS 129981 . 130177) (SK.REMOVE.GRID.POINTS +130179 . 130982) (SK.TAKE.DOWN.GRID 130984 . 131295) (SK.SHOW.GRID 131297 . 134911) (SK.GRIDFACTOR +134913 . 135434) (SK.TURN.GRID.ON 135436 . 135764) (SK.TURN.GRID.OFF 135766 . 136124) ( +SK.MAKE.GRID.LARGER 136126 . 136858) (SK.MAKE.GRID.SMALLER 136860 . 137613) (SK.CHANGE.GRID 137615 . +138063) (GRID.FACTOR1 138065 . 138422) (LEASTPOWEROF2GT 138424 . 139198) (GREATESTPOWEROF2LT 139200 . +139815) (SK.DEFAULT.GRIDFACTOR 139817 . 140370) (SK.PUT.ON.GRID 140372 . 140930) (MAP.WINDOW.ONTO.GRID + 140932 . 141366) (MAP.SCREEN.ONTO.GRID 141368 . 141856) (MAP.GLOBAL.PT.ONTO.GRID 141858 . 142240) ( +MAP.GLOBAL.REGION.ONTO.GRID 142242 . 143959) (MAP.WINDOW.POINT.ONTO.GLOBAL.GRID 143961 . 144504) ( +MAP.WINDOW.ONTO.GLOBAL.GRID 144506 . 144891) (SK.UPDATE.GRIDFACTOR 144893 . 145529) ( +SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID 145531 . 146069) (SK.MAP.INPUT.PT.TO.GLOBAL 146071 . 147288) ( +SK.MAP.FROM.WINDOW.TO.NEAREST.GRID 147290 . 148438)) (148580 157135 (SK.ADD.HISTEVENT 148590 . 149725) + (SK.SEL.AND.UNDO 149727 . 152641) (SK.UNDO.LAST 152643 . 154852) (SK.UNDO.NAME 154854 . 155358) ( +SKEVENTTYPEFNS 155360 . 155710) (SK.TYPE.OF.FIRST.ARG 155712 . 157133)) (157136 157822 (SK.DELETE.UNDO + 157146 . 157575) (SK.ADD.UNDO 157577 . 157820)) (157823 164605 (SK.CHANGE.UNDO 157833 . 159816) ( +SK.ELT.IN.SKETCH? 159818 . 160072) (SK.CHANGE.REDO 160074 . 161942) (SK.MOVE.UNDO 161944 . 163337) ( +SK.MOVE.REDO 163339 . 164603)) (164606 166705 (SK.UNDO.UNDO 164616 . 165882) (SK.UNDO.MENULABEL 165884 + . 166279) (SK.LABEL.FROM.TYPE 166281 . 166703)) (167555 175397 (SHOW.GLOBAL.COORDS 167565 . 168114) ( +LOCATOR.CLOSEFN 168116 . 168401) (SKETCHW.FROM.LOCATOR 168403 . 168811) (SKETCHW.UPDATE.LOCATORS +168813 . 169399) (LOCATOR.UPDATE 169401 . 170159) (UPDATE.GLOBAL.LOCATOR 170161 . 170962) ( +UPDATE.GLOBALCOORD.LOCATOR 170964 . 171541) (ADD.GLOBAL.DISPLAY 171543 . 172460) ( +ADD.GLOBAL.GRIDDED.DISPLAY 172462 . 172721) (CREATE.GLOBAL.DISPLAYER 172723 . 173800) ( +UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR 173802 . 175395)) (175604 188091 (DISPLAYREADCOLORHLSLEVELS 175614 + . 176450) (DISPLAYREADCOLORLEVEL 176452 . 177487) (DRAWREADCOLORBOX 177489 . 178478) ( +READ.CHANGE.COLOR 178480 . 178697) (READCOLOR1 178699 . 181613) (READCOLORCOMMANDMENUSELECTEDFN 181615 + . 181982) (READCOLOR2 181984 . 188089)) (188092 189551 (CREATE.CNS.MENU 188102 . 189549)) (189828 +192538 (SK.ABSWXOFFSET 189838 . 190132) (SK.ABSWYOFFSET 190134 . 190428) ( +SK.UNSCALE.POSITION.FROM.VIEWER 190430 . 190999) (SK.SCALE.REGION 191001 . 192536)) (192577 207575 ( +VIEWER.SCALE 192587 . 192896) (SKETCH.ZOOM 192898 . 193933) (SAME.ASPECT.RATIO 193935 . 195299) ( +SKETCH.DO.ZOOM 195301 . 196506) (SKETCH.NEW.VIEW 196508 . 197023) (ZOOM.UPDATE.ELT 197025 . 197918) ( +SK.UPDATE.AFTER.SCALE.CHANGE 197920 . 199789) (SKETCH.AUTOZOOM 199791 . 204211) ( +SKETCH.GLOBAL.REGION.ZOOM 204213 . 207573)) (208212 220124 (SKETCH.HOME 208222 . 208749) (SK.FRAME.IT +208751 . 209343) (SK.FRAME.WINDOW.TO.SKETCH 209345 . 213191) (SK.MOVE.TO.VIEW 213193 . 214607) ( +SK.NAME.CURRENT.VIEW 214609 . 215719) (SKETCH.ADD.VIEW 215721 . 216814) (SK.RESTORE.VIEW 216816 . +218692) (SK.FORGET.VIEW 218694 . 220122))))) STOP diff --git a/library/sketch/SKETCH-OPS.LCOM b/library/sketch/SKETCH-OPS.LCOM index e7b27488875a7edcfcfbad58abf87b292e4749ac..82c16a6862afafbc5ece07ffaf0304808330de05 100644 GIT binary patch delta 2290 zcmZuyT}&L;74`tO?CIKufH4r0JuD_&Vs_X&GdsJpP8x=tf!(k>Gntt+C5rc za42oOA+|aL}_IFh0`Zbl}4fTgVPh=?MMTDdoKK~lVcF+E9UdCJx>sX2=JrBlN9|G zfJ}^Z^3lFr-pDwH<{3H#eML!lgKOIxvusy5s)8uS6^16)THR;5c$q;I(zat9%UMM? zrV|K6L^WoPpQ&t1WNBGV#}ib>g_k#dc&c^c3oOuhTtqL+oM*KAufV$Wr_vE^n?nun!GQB zs0OkchX{<0kClj+l9Ys)$P#3e;wijwxVeush-lzGUz!|wHUccAP2dH5lqGFFy38LzSKR;;m3@}4z?eH zcKZvoa{dBa_;uWl?A1^Yo??LKm{Oh<)hZmGJG3vYr}(H1tkM?zzS1^D>0;HF((AbF z)wbRK5CoXq(AD}AzLpEV*^n<&`NS1l%MAGA8}yq+x_K{?=q0i?dVvpApSN3+oFa8VD4M!eA&qjsJD7m2 zXd1D8!yC*|cxbTb`edZRU<}{-v>wB+x2Q_|9-NO!mthJj0v&8cNcv^cb>Wv}IYT}x znWEzDpT!zgnb=i2QyQCu?~UChsUqWhuMh54A;J@5<#NLtpEPiLaP{3c_R_80XPI8* z%E9wjddi<%$?YO%*EMl3adeyW_%);2%;n4PU8@!G!<(@x;87cBEw_EzRfEUpp22_4 z4TLgQ!G-7}aP%m7rCa7f>P&D=(ODJ*BX9V#<&y8`x6=5y)`b7P)qo4V2e5v=71?~0 z<8j}KW}KLBz*puUA?;W5Nt`tgk@TX~g5iZW)E16Z@qj|H9WN~OkmJU}!+2!`YJhhK z@X^vCG)H#fH*WWmi;Xtc$hWMQWv9GyQpydj9tYY!HLDAWPE4wApUXD zYT|8+E{KBW41jA}fnYeD5XG(~A8u^vAw0XJk@V-Kc3fO~jHK@6Fj~uLl3rcz!k;|X zh<{pcCN2J#7W{m<36(po*mx(5F8#ZI)aG|>`p)C{;hk_T)k`FH?YuT5^gB5n;gu$Q zaHSEQpFXgUd@fCM;Gmo*S28%g(oVp?U19j2l@5~juWFcD4dL+J69>m)7A^i7h3;uq!5#PKJs-bQ1cz7*=Ppus$uph7W;P2L2Ncw1P zpq5}VS0$$Vl@@MAE`yuWD@=t%}Rr|TK*l=;(+*z=W89ch{597JT{rKuSYo_;@ zMyFDJ-s+{-En``Z?gIX8Jx>7PjYfR!7Z2i-8vN_n6Xst{15Cbkp*Byj>w5$Dd@ zSvv|64?OJbz2}~D?>*oB&Uf!yFRc3I_f|dMQw!0MTo?!mVL^m&I2mqBM#YH}@o_!~ z-T*|(gMye8V@W<7fYE{BQzIvL<>B}c1kyQ8gXMl4#|0qYKU&DcgW{usptm)xYD&sd zBuA0S>AoE#l95=z1Nb*j%UT`;fsaS=tfv9rnBJ~|-IY;oM>(MA4z=BXr`J?i+eu{( zs7g-|lBT5`P>q}&l4%8&h8W8BpDpDm@X2s2DI@}H0spvR+T0!?=(W4Jw4pn?lvOlZ z0FrXT+p0nsm{nHnR1hk5Ra8`X_8+5fg_nIE+#Ia0udl9X6$Llcv8rv}fv_!s{LkGJ?;X!Ep1+rV}tCuf_MN&rM6 z36L$RhtrIdq;Vw-$SOh!TubRt4ILtah}D7GaXz}zF1Cfiu_WEr2&ScIk#;28W=c~{ zQ`I{brx1lOLCo1bDxu7kjNCy^(q*m}M4lEj^pxZ{oN9s?jxC#(3__bbKEC82Bw}D0 zl!wCHg?Jne=`3CVL5zT!l{ysLA$DZh$&!O0fKB-+OY0grhalzIHeEXiVUciQ5iZ<( zTLKPArm5(%06Z;T8fz&H#%VT}ES#e{8X+HzE(aCA*!-)LLX6qigtU4a5Y~!Cq_S<` z6A5s^H%y1HB||I*vXRPViIE(m4_WvXE_9R-iAIR%`Qf1g6^9t+Atdlof?tRW`0@^4 zgpapDKmz+jVRT?HKzj;9Ak%+3KQKIU_V~~-aEpo;qm*|f9!ZF?NZk9=mY3FHP{b~3c^?aSNSfoh40LmM2ja=K1bTJnPxQTR6J!*7K);uUTLU*SG_P)1AT{lDi$Ij}P3 zTrw?BYHYV3eT|!HSei^RR;1Qnj^PZQW2pZB5+!(oUOarIwipVxRE~EPM%7dO#|r7= zCkrLDF$oyuprhzE5i4z2uC7rzm5p}JG&PkplZwJUbLK+C%aLJ`b8OFxfhAf16R{K( zs>;NW4l=Tu4sv*$abUkIV>QyM%%$dGW^kF(mvR4kF{9R3cb3}4TZ2THNEF=FM6pEh zrNy|kWn{T~dj}#`w*N#STNoNMj=EVoXGaQW*g2TPBe{{D<3nC}3>Jn37@UQf27q34M@l=|zjVXBFu zK0Ebkdc~P$Ggdo(e0?f_?@sL``+JWAer|drYST4qI7M@8z-JEcz{jWk_{?+zIeh8k z?fCQQ5GtSesApblLjScLI6u9OdQV*I+R9d=yDBSLT{f_MoMRw+sFv7cIR-KfX+Z*)D(!c!SZ?@-)wz>6nZG^v^t zs5opjOlv5&Hxn7@Lxq7X! zRG)+T``50o#*47LvbNAzo`=RVh~=7TLc6IXNg~Y6tfBsXJ{46=3W>5|l9Ed_pXeZ} z-TS5W!SInRqzg(`mV*^eZIwrO<*ZZlLGY%CU#duDv*uMKa>4L?!)Ow zI{FPpxpOs)q?58?k=G%yuN5Rrtvar2U>PPP&cZnm$y|fxuC`S}O%*d)xN;M&UtJWF zk1vRPzN3l0_jQ@vKR->DWd(|QUPxdh6&%+tm2I~Q3R_xQm4M8aNhsqAD`WU&6VDav zjB&A!ac(|_zdtq)HfCd8F{^2qLLv*7n4W^kJR@!x(gAhbBRCi{Odb8>n+%rilal7@ zUKsG34vfUYv4=ndv(-_$+C2OgKAW-QC-@!V&T4bn_^R^d~Fl=y2*{!bZ zF)sjxJ_V=;>7BY`AWU9`)>xc3k74pT5JgZ@*-zuV@{)ing$ZzOMVMKh!#yR%B(fT4 z2YUOUz$^-=7VhVnK`zshhxvh%0%Y?bI!pDL)jG^Bt*q8@3WMRpw>NI~e$53B`&N#8 z%g17ejsq7|`yV#3s5uo6DpfUiO2UE}u743|p-ZOikuoNm1=}GOVhJn6Kq%4SRMHX9 zBuASd6yUTMsaΜiQ^m*Pg0unQN|Q+V+$OiY@0Op<#K%^(A|Jl9bR9j!-moMiu>| z7z$aM=Y(tMWv%2R2=Xa7Z;)x?N?u7b3FKr5oL^6lXJv57gkfXO2m^Fnb4k=!z(o@eLvPe(*gf2cEC_HP3Mk3(uF${J-d#9B8^8Wh(i$6rK*Nnxb*S z2HR;k&ZC<+=QBrxXEgh(Ma!jtMDbH#UC3 z)t5(_*f)fBI2lMNHM~kFjM=0_?<#GzN!aD0$XR;5?4Y(lu|{uF$fb6f;dJa$RM-`@ zZ5YB@MZST?D*YCK8CYGcugxyN+xVG)Xu(N))*jBm*zi*XQdcm_3yF=!i=T7Bc>L1F z*umeqjR%K+>b!j~{`g*;yZ?7GQMSA&#l4q(67XU#nVL)Rb3|yJ6ZyerL=1aA3zDdc z_c~te&W*J-`qhH;3G;Qf7IBjX*}k%|K9VNUn$gbUbV;_g^~ydvP(*j^nol>WqQt7} zO?66!RWfTj3H9kY`;(NJ2q6P(yOeTMJprWv_9G9EEW6=@7l)OzgxBfLIT6O4mRv%K4_QlST}kjR$|c>^rpv|zrAMQT@*fg>wG-tmB}c>i5`|)tx2e!2 Se$BNcAFl`D@vS8Poc$jsID^~( delta 1914 zcmZ`(U5pb|6zN9HACl4cXp>U&HQXZQCw(c$u1Px z6*K|YAa4=^xgnF7sL>ZKrj?A62RT#5U%qgCDJRKkh$bE~W(s9RO~A3Ut>f)eXHG7+ zn$UXf%-NO6a`?0@P8e|VG$f3`vYwHMDvMGe-)nE z0=ZIF$>!+`f)YN1xl>TCyJX&U0&iMJFGxVK@8C*VE|p~^0nzIh6GItHSa+Q&q*9&B z;{E|4+PO9Mn?U1(7d!9n{$_jU?ZKNu_~oRygZ>%2K$W4k@{1UWY#s*TLuT@;U$F=DYNxp^pzA{Kvc)kE9f(0G_Y;fme4;+XqF?fj1}BGyXfe&&qN3U-kSu2#*H$Bs?T12XARbn`9O+yzo z+Y8WK&2pSM59EAieb2N#;`)+vaF$fiH||Bf)D5lTJ1)pb zfO(TNh%0#&%_1NV$O_QCKkn4!i~=sHnhu_{qylCSTq1Q-Lb1f};FCkX=OcnOC={Ve zd<39Y_Zz0II}K0^^aFi#Eei~1&vG;!loHesO;T}e!*pv{A9P}vHqq+{UqOM536$P- z1K+SAuL3p-7lnt4V<;$!0ts)awR(IJPPbQKW#L?_i5!&0yh^`_rPly2pW^LKgOY

4EssWGp4;Wzf7iOpVlJ3DdC@$ORdd*KD6|VLuCbdM|!Jh|!~?d+B4t`;u8? ziKegfq7Di?pc|f$+gJhG7=B`{$2BlO<)pB+8c9RslTBhom|tu*gIjT~#el1AabhC2 ziHUHYe-0~;%)oOqd_BwGon680EiZ8oF3BObT#V2199+J_^G62WvxI?nEI~N2#>~I} zPtcqonzsk$ci#;@8}CaX;v)n+*WJEtls)T8@2Xum@+AgGWk$2Bgo_MCSnTuhIA$oz zzF|?!^*Nv&llGfY+z)C%F4vnONQEA5KkP_4h?}ZHSNJ$51Jo6&f5SHlZG*Jr3>M;y z030~|u4;xJ8F_p&!(A@YH%A^7RD6$%=@@-qn4sT|+@U|+$k9V%N5ZwFxbv+`sXLca z!qq>*XD7w+&IM5&*as=Y_Il~pdB>%ob;S@3(@AkpXe7l_96N@rmK?ihx;H6~jdQB9 zsrayv=v6`4#5f$~)x#S}Q5T}&cS#Y#zea^bxMxZn-NE$dxH?WXVv!oLeUDCmpAMI% z#7T6%HYJXQH>bo|Axek!UGx=cEZmzC^DK-NZb&X+6B;K?_;N~gc{<(I8irYAGte|3 n{3<2ZwzD#tu1j8Bs}K*uWLk9irc3<5wIv@X|DDTeajWw;f7{(& diff --git a/library/tedit/TEDIT b/library/tedit/TEDIT index 39cb40cc..2522759e 100644 --- a/library/tedit/TEDIT +++ b/library/tedit/TEDIT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Nov-2025 21:00:34" {WMEDLEY}TEDIT>TEDIT.;844 144838 +(FILECREATED "24-Dec-2025 22:45:39" {WMEDLEY}TEDIT>TEDIT.;847 145111 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.INSERT \TEDIT.INSERT) + :CHANGES-TO (VARS TEDITCOMS) - :PREVIOUS-DATE "28-Oct-2025 00:29:56" {WMEDLEY}TEDIT>TEDIT.;843) + :PREVIOUS-DATE "24-Dec-2025 11:23:12" {WMEDLEY}TEDIT>TEDIT.;846) (PRETTYCOMPRINT TEDITCOMS) @@ -76,8 +76,9 @@ (VARS (TEDITSYSTEMDATE (TEDITSYSTEMDATE] (COMS (* ;  "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.") - (ADDVARS (PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP) - (EXTENSION (TEDIT TED]) + (FNS TEDIT.IMAGESOURCEP) + (ALISTS (PRINTFILETYPES TEDIT)) + (P (DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE]) (FILESLOAD (SYSLOAD) POSTSCRIPTSTREAM PDFSTREAM WHEELSCROLL) @@ -2317,30 +2318,40 @@ (* ; "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.") +(DEFINEQ -(ADDTOVAR PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP) +(TEDIT.IMAGESOURCEP + [LAMBDA (X) (* ; "Edited 23-Dec-2025 11:26 by rmk") + (OR (TEXTSTREAM X T) + (TEDIT.FORMATTEDFILEP X]) +) + +(ADDTOVAR PRINTFILETYPES (TEDIT (TEST TEDIT.IMAGESOURCEP) (EXTENSION (TEDIT TED)))) + +(DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4838 7232 (MAKE-TEDIT-EXPORTS.ALL 4848 . 5394) (UPDATE-TEDIT 5396 . 6325) (EDIT-TEDIT -6327 . 7230)) (8662 36440 (TEDIT 8672 . 11286) (TEXTSTREAM 11288 . 13177) (TEXTSTREAMP 13179 . 13563) -(COERCETEXTSTREAM 13565 . 17776) (TEDIT.CONCAT 17778 . 21080) (TEDITSTRING 21082 . 21996) (TEDIT-SEE -21998 . 22682) (TEDIT.COPY 22684 . 24829) (TEDIT.DELETE 24831 . 26192) (TEDIT.INSERT 26194 . 29163) ( -TEDIT.TERPRI 29165 . 30279) (TEDIT.KILL 30281 . 31263) (TEDIT.QUIT 31265 . 32631) (TEDIT.MOVE 32633 . -33521) (TEDIT.STRINGWIDTH 33523 . 34194) (TEDIT.CHARWIDTH 34196 . 36438)) (36441 38382 (TEXTOBJ 36451 - . 36916) (COERCETEXTOBJ 36918 . 38380)) (39782 41432 (TDRIBBLE 39792 . 41430)) (41473 53369 ( -TEDIT.INSERT.OBJECT 41483 . 45190) (TEDIT.EDIT.OBJECT 45192 . 48132) (TEDIT.OBJECT.CHANGED 48134 . -51324) (TEDIT.MAP.OBJECTS 51326 . 52897) (\TEDIT.FIRST.OBJPIECE 52899 . 53132) (\TEDIT.NEXT.OBJPIECE -53134 . 53367)) (53392 60835 (\TEDIT.CONCAT.PAGEFRAMES 53402 . 58469) (\TEDIT.GET.PAGE.HEADINGS 58471 - . 59500) (\TEDIT.CONCAT.INSTALL.HEADINGS 59502 . 60833)) (60836 64443 (\TEDIT.MOVE.MSG 60846 . 62927) - (\TEDIT.READONLY 62929 . 64441)) (64444 70335 (TEDIT.NCHARS 64454 . 64827) (TEDIT.RPLCHARCODE 64829 - . 67819) (TEDIT.NTHCHARCODE 67821 . 69864) (TEDIT.NTHCHAR 69866 . 70333)) (70381 127158 (\TEDIT1 -70391 . 72468) (\TEDIT.INSERT 72470 . 78583) (\TEDIT.MOVE 78585 . 86491) (\TEDIT.COPY 86493 . 91024) ( -\TEDIT.REPLACE.SELPIECES 91026 . 95562) (\TEDIT.INSERT.SELPIECES 95564 . 98561) (\TEDIT.RESTARTFN -98563 . 101068) (\TEDIT.CHARDELETE 101070 . 103999) (\TEDIT.COPYPIECE 104001 . 109163) ( -\TEDIT.APPLY.OBJFN 109165 . 112251) (\TEDIT.DELETE 112253 . 116621) (\TEDIT.DIFFUSE.PARALOOKS 116623 - . 118894) (\TEDIT.WORDDELETE 118896 . 120511) (\TEDIT.WORDDELETE.FORWARD 120513 . 122302) ( -\TEDIT.FINISHEDIT? 122304 . 127156)) (127159 127818 (\TEDIT.THELP 127169 . 127816)) (127852 136983 ( -\TEDIT.PARAPIECES 127862 . 129836) (\TEDIT.PARACHNOS 129838 . 130730) (\TEDIT.PARA.FIRST 130732 . -133833) (\TEDIT.PARA.LAST 133835 . 136981)) (136984 144079 (\TEDIT.WORD.FIRST 136994 . 140998) ( -\TEDIT.WORD.LAST 141000 . 144077)) (144280 144557 (TEDITSYSTEMDATE 144290 . 144555))))) + (FILEMAP (NIL (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))))) STOP diff --git a/library/tedit/TEDIT-HCPY b/library/tedit/TEDIT-HCPY index a112833e..1dafbeaa 100644 --- a/library/tedit/TEDIT-HCPY +++ b/library/tedit/TEDIT-HCPY @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "10-Sep-2025 19:05:00" {WMEDLEY}tedit>TEDIT-HCPY.;179 30623 +(FILECREATED "15-Jan-2026 11:08:15" {WMEDLEY}tedit>TEDIT-HCPY.;196 32421 :EDIT-BY rmk - :CHANGES-TO (VARS TEDIT-HCPYCOMS) + :CHANGES-TO (FNS TEDIT.IMAGEFILE.MESSAGE TEDIT.FORMAT.HARDCOPY) - :PREVIOUS-DATE " 9-Sep-2025 21:52:28" {WMEDLEY}tedit>TEDIT-HCPY.;177) + :PREVIOUS-DATE "24-Dec-2025 11:16:22" {WMEDLEY}tedit>TEDIT-HCPY.;194) (PRETTYCOMPRINT TEDIT-HCPYCOMS) @@ -15,9 +15,10 @@ ((COMS (* ;; "Generic interface functions and common code") - (FNS TEDIT.HARDCOPY \TEDIT.PRINT.MENU TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE - \TEDIT.HARDCOPY.FORMATLINE.HEADINGS \TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYFMTSPEC - \TEDIT.INTEGER.IMAGEBOX \TEDIT.DISPLAY.DIACRITIC)) + (FNS TEDIT.HARDCOPY TEDIT.FORMAT.HARDCOPY TEDIT.IMAGEFILE.MESSAGE \TEDIT.PRINT.MENU + \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE.HEADINGS + \TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX + \TEDIT.DISPLAY.DIACRITIC)) (COMS (* ;; "Functions for scaling regions as needed during hardcopy.") @@ -27,9 +28,9 @@ (INITVARS (TEDIT.DEFAULTPAGEREGION (\TEDIT.SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 6.4 9.25] (COMS - (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. THIS IS SCREWY") + (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. Eliminated postscript, but this still may be screwy") - (FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPYFILEFN \TEDIT.POSTSCRIPT.HARDCOPY)) + (FNS \TEDIT.HARDCOPYFILEFN)) [COMS (* ;; "vars for Japanese Line Break") @@ -56,68 +57,120 @@ (TEDIT.HARDCOPY [LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS) + (* ; "Edited 17-Dec-2025 01:06 by rmk") (* ; "Edited 6-Mar-2024 23:33 by rmk") (* ; "Edited 5-Jan-88 16:09 by jds") (* ;; "Send the text to a printer, unless DONTSEND. If DONTSEND and we can't find a server, we'll get the DEFAULTPRINTERTYPE.") - (CL:UNLESS SERVER (SETQ SERVER DEFAULTPRINTINGHOST)) + (CL:UNLESS SERVER + (SETQ SERVER (CAR (DEFAULTPRINTERS)))) (COND [(OR SERVER DONTSEND) (for IMAGETYPE in (PRINTERPROP (PRINTERTYPE SERVER) 'CANPRINT) - do (RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS + do (RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE)) finally (ERROR (CONCAT "Can't print TEDIT documents on a " (PRINTERTYPE SERVER) " printer."] (T (TEDIT.PROMPTPRINT (TEXTOBJ STREAM) "Can't HARDCOPY: No print server specified." T]) +(TEDIT.FORMAT.HARDCOPY + [LAMBDA (TSTREAM IMAGESTREAM DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG + ENDPG QUIET) (* ; "Edited 15-Jan-2026 08:52 by rmk") + (* ; "Edited 14-Dec-2025 17:40 by rmk") + (* ; "Edited 8-Dec-2025 18:08 by rmk") + (* ; "Edited 7-Dec-2025 15:06 by rmk") + (* ; "Edited 19-Sep-2025 22:04 by rmk") + (* ; "Edited 18-Sep-2025 10:11 by rmk") + (* ; "Edited 12-Sep-2025 23:54 by rmk") + (* ; "Edited 5-Jun-2025 08:24 by rmk") + (* ; "Edited 22-Apr-2025 08:12 by rmk") + (* ; "Edited 30-Aug-2024 15:45 by rmk") + (* ; "Edited 5-Apr-2024 08:01 by rmk") + (* ; "Edited 19-Jan-2024 23:39 by rmk") + (* ; "Edited 15-Nov-2023 23:56 by rmk") + (* ; "Edited 4-Jul-2023 11:16 by rmk") + (* ; "Edited 2-Oct-2022 00:00 by rmk") + (* ; + "Edited 25-May-93 13:06 by sybalsky:mv:envos") + + (* ;; "Format a document for hardcopy. Returns NIL if the before-print-fn said not to print.") + + (* ;; "TEXTSTREAM is either already a textstream or somehow denotes a tedit-formatted file, otherwise an error. We don't here try to decide that a non-formatted file is a plain text file, as opposed binary or anything else.") + + (RESETLST + (TEDIT.PROMPTCLEAR TSTREAM) + (LET [(IMAGEFILE (TEDIT.TO.IMAGEFILE TSTREAM IMAGESTREAM (OR IMAGETYPE DEFAULTPRINTERTYPE) + `(,@PRINTOPTIONS FIRSTPG# ,FIRSTPG# STARTPG ,STARTPG ENDPG + ,ENDPG DOCUMENT.NAME ,BREAKPAGETITLE] + (CL:UNLESS (OR DONTSEND (EQ IMAGEFILE IMAGESTREAM)) + + (* ;; "If the caller gave us an already open image stream, not just a filename (or NIL), we assume that the caller will close it and send to the printer, if necessary.") + + (SEND.FILE.TO.PRINTER IMAGEFILE SERVER `(DOCUMENT.NAME ,BREAKPAGETITLE + ,@PRINTOPTIONS DOCUMENT.NAME + "TEdit Hardcopy Output"))) + (CL:UNLESS QUIET (TEDIT.IMAGEFILE.MESSAGE TSTREAM SERVER)) + IMAGEFILE))]) + +(TEDIT.IMAGEFILE.MESSAGE + [LAMBDA (TSTREAM SERVER) (* ; "Edited 15-Jan-2026 11:07 by rmk") + (* ; "Edited 14-Dec-2025 17:40 by rmk") + + (* ;; "Description of last imagefile goes in promptwindow") + + (LET* [(LASTIMAGEFILE (GETTEXTPROP TSTREAM 'LASTIMAGEFILE)) + (NPAGES (pop LASTIMAGEFILE)) + (IMAGEFILE (pop LASTIMAGEFILE)) + (PRINTERNAME (OR (pop LASTIMAGEFILE) + (CL:IF (LISTP SERVER) + (CADR SERVER) + SERVER)] + (TEDIT.PROMPTPRINT TSTREAM [CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES) + "" + "s") + (if PRINTERNAME + then (CONCAT " printed on " PRINTERNAME) + elseif (STREAMP IMAGEFILE) + then " printed" + else (CONCAT " on " (PSEUDOFILENAME IMAGEFILE] + T]) + (\TEDIT.PRINT.MENU - [LAMBDA (TSTREAM) (* ; "Edited 28-Jun-2024 22:09 by rmk") - (* ; "Edited 25-Jun-2023 13:16 by rmk") - (* ; "Edited 6-Jun-2023 17:48 by rmk") - (LET ((W (GETTOBJ (TEXTOBJ TSTREAM) - PRIMARYPANE))) + [LAMBDA (TSTREAM) (* ; "Edited 17-Dec-2025 00:09 by rmk") + (* ; "Edited 14-Dec-2025 17:38 by rmk") + (* ; "Edited 13-Dec-2025 08:35 by rmk") + (* ; "Edited 19-Sep-2025 07:43 by rmk") + (* ; "Edited 28-Jun-2024 22:09 by rmk") + (* ; "Edited 25-Jun-2023 13:16 by rmk") + (SETQ TSTREAM (TEXTSTREAM (GETTOBJ (TEXTOBJ TSTREAM) + PRIMARYPANE))) + (TEDIT.PROMPTCLEAR TSTREAM) (* ; "Edited 6-Jun-2023 17:48 by rmk") + (LET (FILE&TYPE) (SELECTQ [MENU (create MENU ITEMS _ '(("Print to a file" 'FILE "Puts image on a file; prompts for filename and format" ) ("Send to a printer" 'PRINTER "Sends image to a printer of your choosing"] - (FILE (HARDCOPYIMAGEW.TOFILE W)) - (PRINTER (HARDCOPYIMAGEW.TOPRINTER W)) - NIL]) - -(TEDIT.HCPYFILE - [LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 29-Jun-2024 16:33 by rmk") - (* ; "Edited 4-Oct-2022 09:23 by rmk") - (* ; "Edited 1-Oct-2022 22:12 by rmk") - (* ; "Edited 12-Jun-90 18:36 by mitani") - - (* ;; "Create a hardcopy-format FILE from the text on TSTREAM, with the file type depending on what the default printer is.") - - (LET ([IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE) - 'CANPRINT] - (TEXTOBJ (TEXTOBJ TSTREAM)) - FILENM TXTFILE) - (CL:WHEN [SETQ FILENM (OR FILE (\TEDIT.MAKEFILENAME - (TEDIT.GETINPUT TEXTOBJ (CONCAT IMAGETYPE " file name: ") - (COND - ((type? STREAM (SETQ TXTFILE (fetch (TEXTOBJ - TXTFILE) - of TEXTOBJ))) - (* ; - "There was a file, so supply default") - (PACKFILENAME 'VERSION NIL 'EXTENSION - (OR (CAR (PRINTFILETYPE IMAGETYPE - 'EXTENSION)) - 'HCPY) - 'BODY - (fetch (STREAM FULLFILENAME) of TXTFILE] - (if FILENM - then (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE) - else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))]) + (FILE [LET [(FILENAME (GETTEXTPROP TSTREAM 'FILENAME] + (CL:WHEN FILENAME + (SETQ FILENAME (PACKFILENAME + 'VERSION NIL 'EXTENSION + [L-CASE (CAR (EXTENSIONS.FOR.IMAGEFILETYPE + (CAR (PRINTERPROP (PRINTERTYPE + :DEFAULTPRINTER) + 'CANPRINT] + 'BODY FILENAME))) + (CL:WHEN (SETQ FILE&TYPE (GetImageFile FILENAME)) + (TEDIT.TO.IMAGEFILE TSTREAM (CAR FILE&TYPE) + (CDR FILE&TYPE)))]) + (PRINTER [SEND.FILE.TO.PRINTER TSTREAM (GetPrinterName) + `(HEADING ,(GETTEXTPROP TSTREAM 'FILENAME]) + NIL) + (TEDIT.IMAGEFILE.MESSAGE TSTREAM]) (\TEDIT.HARDCOPY.DISPLAYLINE [LAMBDA (TSTREAM LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 21-Apr-2025 19:02 by rmk") @@ -415,31 +468,12 @@ -(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. THIS IS SCREWY") +(* ;; +"Support for the window-menu's HARDCOPY button, LISTFILES, etc. Eliminated postscript, but this still may be screwy" +) (DEFINEQ -(TEDIT.HARDCOPYFN - [LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 13-Dec-2024 22:33 by rmk") - (* ; "Edited 29-Jun-2024 14:42 by rmk") - (* ; "Edited 20-Mar-2024 10:49 by rmk") - (* ; "Edited 25-Sep-2023 16:29 by rmk") - (* ; "Edited 4-Jul-2023 11:16 by rmk") - (* ; "Edited 21-Sep-2021 15:33 by rmk:") - - (* ;; - "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.") - - (LET ((TEXTSTREAM (TEXTSTREAM WINDOW))) - - (* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it. Please don't remove this binding!") - - (TEDIT.FORMAT.HARDCOPY (CL:IF (FGETTOBJ (TEXTOBJ WINDOW) - MENUFLG) - (\TEDIT.MAINW WINDOW) - WINDOW) - IMAGESTREAM]) - (\TEDIT.HARDCOPYFILEFN [LAMBDA (W EXT) (* ; "Edited 25-Sep-2023 16:19 by rmk") (LET [(STRM (OR (GETTOBJ (TEXTOBJ W) @@ -452,22 +486,6 @@ (PACKFILENAME 'VERSION NIL 'EXTENSION (OR EXT 'IMAGEFILE) 'BODY (FULLNAME STRM)))]) - -(\TEDIT.POSTSCRIPT.HARDCOPY - [LAMBDA (FILE PFILE) (* ; "Edited 4-Oct-2022 10:40 by rmk") - (* ; "Edited 1-Oct-2022 22:08 by rmk") - (* ; "Edited 12-Jun-90 18:35 by mitani") - - (* ;; "Send the document FILE to the printer (or to a print file, as determined by PFILE).") - - (CL:WITH-OPEN-STREAM (TEXT-STREAM (OPENTEXTSTREAM FILE)) - (RESETLST - [RESETSAVE (\TEDIT.MARKACTIVE (TEXTOBJ TEXT-STREAM)) - '(AND (\TEDIT.MARKINACTIVE OLDVALUE] - [RESETSAVE NIL `(AND (CLOSEF? ',PFILE] - (replace (TEXTOBJ EDITOPACTIVE) of (TEXTOBJ TEXT-STREAM) with 'Hardcopy) - (TEDIT.FORMAT.HARDCOPY TEXT-STREAM PFILE T NIL NIL NIL 'POSTSCRIPT) - PFILE)]) ) @@ -505,11 +523,10 @@ (CLOSEF DOC]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2652 25209 (TEDIT.HARDCOPY 2662 . 3795) (\TEDIT.PRINT.MENU 3797 . 4763) (TEDIT.HCPYFILE - 4765 . 6939) (\TEDIT.HARDCOPY.DISPLAYLINE 6941 . 16164) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 16166 . -17895) (\TEDIT.HARDCOPY.MODIFYLOOKS 17897 . 20078) (\TEDIT.HCPYFMTSPEC 20080 . 23538) ( -\TEDIT.INTEGER.IMAGEBOX 23540 . 24211) (\TEDIT.DISPLAY.DIACRITIC 24213 . 25207)) (25284 26114 ( -\TEDIT.SCALEREGION 25294 . 26112)) (26367 29180 (TEDIT.HARDCOPYFN 26377 . 27682) ( -\TEDIT.HARDCOPYFILEFN 27684 . 28245) (\TEDIT.POSTSCRIPT.HARDCOPY 28247 . 29178)) (29799 30600 ( -TEDIT-BOOK 29809 . 30598))))) + (FILEMAP (NIL (2727 29208 (TEDIT.HARDCOPY 2737 . 3995) (TEDIT.FORMAT.HARDCOPY 3997 . 7234) ( +TEDIT.IMAGEFILE.MESSAGE 7236 . 8533) (\TEDIT.PRINT.MENU 8535 . 10938) (\TEDIT.HARDCOPY.DISPLAYLINE +10940 . 20163) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 20165 . 21894) (\TEDIT.HARDCOPY.MODIFYLOOKS 21896 + . 24077) (\TEDIT.HCPYFMTSPEC 24079 . 27537) (\TEDIT.INTEGER.IMAGEBOX 27539 . 28210) ( +\TEDIT.DISPLAY.DIACRITIC 28212 . 29206)) (29283 30113 (\TEDIT.SCALEREGION 29293 . 30111)) (30405 30978 + (\TEDIT.HARDCOPYFILEFN 30415 . 30976)) (31597 32398 (TEDIT-BOOK 31607 . 32396))))) STOP diff --git a/library/tedit/TEDIT-HCPY.LCOM b/library/tedit/TEDIT-HCPY.LCOM index 9c76df19871b538f2409aed3e8f38f7ac4e3bd85..6455505dbcabe459b347671c8ea8c3d13fc4e368 100644 GIT binary patch delta 2609 zcmZ`*O>7fK6tI9EA`YlV=t^j!Hx-AN zBuj)o3=N&n84jSj?nYm6g#LH*Oe6wn%hs;xX33e(qG1puc{*FU&B9bzm?WN-Bmu%Z zA72cmWO|~jHV}cphoL~AC%f0*8^B+XKI!^kG}XMvvdyC9TDESukWAv{l51X_ha|!K z-mb)D&}`eZK}kWzG%~6SatgS%X1mLl1~JkS(UJv{FY?m_WVM`HDtH%Ywu5OwJTj`m zZJ-3H7=74%c|egtfUWK7M!m9)xs_w|_wMmWy>C%@WTH<5KOOY>@c9M-*KskkMaY5V zo%wRi^T)JY-NbC>K!&TRx?mxguI?5z+)}{N>}#5h%eeP@Qt6mU&MXlO>(TNB8dhU=h=S*`{90>Q;&EXRxXwY{S&Y~|cx406bXF~&NW_# z5BJ%ECT%sF=MW!KoAO`*0fX_^!KDZV)p6Sx>3G;=bBELD=5}`=5SryaB2gO1Ez*?_ z=0o3o&&MD5xYw($cI||M&u4YcGX36*$9(Y#9~VCNrl*7RJVfv8A>Z_N+SIKwY6cFl zv7@*&kcdjFhA>Vx%SlQB%h5_%lhKpMo=6}}>~Uk*BH*KCHHj4$q=a%XcutZO7LH9U z(vXb#C1h2Ac(N_wc>|?50ih;Oh8~N`18~lnJe1GYSSq3A|{Qjw@5w7v#+2}0iB9}TYY+%9hR6So2D=F4`_&%fj z&L?3@Ika*}B+-crNFsr`O5O6Rw^3fN06{Rkq;?dPh6W_TRrPgDe6G5Nig6@>npyDk zOcZ==(;3x4WjO(ey=FM9lt*)>-L6d>1tR2cel9F2O4~UY4t7di?NUYuAfMB~zH=E#%R_P^J z{`|nOZ7YDyhy@9$RGV>0Zw+X-X@L2j*9zI3!P;=9V0#Y?VljH6XE-E_bh_u8-RWaD zPSVE%Z|)X`rh>b_jQ$zK+8B9V{dtA^^ydr1)at)TGr=J`GIomoboLzmGGkOE5D7VY)r`{!uRA`j4@{RV+S>b2Y3)vfvz+`3`YW3>c z8myNez^w}4Y2~8_LKuy*ub!qGdDYHlOlz6ZA!odFBRxO=7Z%EOCM!&-HZeoPm&SPv;f^47|DLcy{{z3!W*z_l delta 2739 zcmb_eOK;mo5T<0q55+00Bxn=YZYT6hiYtW=JsBV|O;HvjiKI!&k0wZ}MoO%vu?;6E zP!z4)OV2eHK~Dt=6zDZT9p4J%&{Kkq}=vSN)n_jh($%nDuS?oJ3o;xCLzX)N52-7tf*uQ`#(%BR8*&=S@s58 z_4JbArESMBy>wkS8{i8nn!QmrYC6QoGk%i%&M%&d1-k50-E(bS1F|wLkSEh8yATWZ z1qYYS@aWJKJ*_XbE!T53$FRM0sNh>pEm>9-I$OY(8?_o74IrIP^D$^O@3mX-Qe+EC zR#Jo_pNu7_9nH~I^yek55S>rv-^&+47IKmd3JpKCv;n(!ZbMAbDyq4xyD86t#H#AJ zfloAK&8oXeP;5tEHLQl4Dxn47q1cCCLUbiXD)127|8zE*&y#rc?hKScf|6cV8#Rx? zY?#Xxj6MlmGaBKBN{7cBazA>V&jirhj#amPRVc_PT=%S{%aG3j`G$Yp%@#p-9Ls@h z1~kjmR1Y#4U?=O2w_)ob<-#Q%WrNsT(yxe+B!Z@zYzMBOP$2sQ=i`|oMzgcq*}B)> zP4gfZ$diFNa(nd5oB(TJfB>HBA+B|F{8p6XB8#IO{teOLr@?rfJRZH&{pwMLNyl$d z@$-ix!IDdef&gKrjk>z5ucbXJ@EQu)SHCg#nZ&=sG(Wy`6nw0)8X{O~*$ebArls$s4Hf*Qu^N9~(E*n7JanF+i8 zt4&xH1VN;OMB;-$E)7m}1#k^TIp^rE?opfWIc#Zu_EJGCw8hyp$r#EtZh(t0GOsWS zvSD*#!k)O{v%k+;2gSj!SwMsf#ObIGxQ_i>-VHI|u?2fi}Z#?g)#reE^)Q zs(HpLC25EPHjV-^s~0ikMW}@7M(TuM$$405SlHT;|60v*_3|Z<@}Qa}+AA}Vz!@Y0 z0F!mqsTyWr%&L`E)mlSOCX?Y^*|SHYgChB2NFwUs=_wg%hHI}^4A(;_GoT7$UPkB^ z2BKVqTpyl%^MsGujgdz)LlK&E8Lrk>ahC_=v*EMd|B^r&F-slGT*IVfL)ojo^{-%> zc)Sy7H!RbJkL>NISnT=vT9?BMz-BpFVa*0z6!BK6DGV~Sk_AOwvK;SU4EnZci)9$F z27A;hEgD8Fb^!$pTZm%+463CQk4BgueXjXE(qMjt@X?#V_YEX$X91LAF{Df{PcLF2 zLKZArH>pcL)iEAffTSNBEwX>kgnaM_eu?yy{_d4Up7K-p#+r%5$l2-h_^8T^#prtj z66fH;1t9y=SB7J30pz#or(F-J1Ng%il)kpXCm~Tb-T&bUmc)~e*p2ZYHFxjA&Fx*d z+}vqywePl}*4b(kWA+reHmjh!zs~byJW;~gAF~T&FOk97^|=M|EODBAJ2y=OO3snb LXQmED=e6jcw@iy~ diff --git a/library/tedit/TEDIT-LOOKS b/library/tedit/TEDIT-LOOKS index 426d99ab..9c66d9ca 100644 --- a/library/tedit/TEDIT-LOOKS +++ b/library/tedit/TEDIT-LOOKS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Oct-2025 20:50:59" {WMEDLEY}TEDIT>TEDIT-LOOKS.;459 155349 +(FILECREATED " 7-Dec-2025 16:32:32" {WMEDLEY}tedit>TEDIT-LOOKS.;460 155196 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.MCCS.TRANSLATE) + :CHANGES-TO (VARS TEDIT-LOOKSCOMS) - :PREVIOUS-DATE " 5-Oct-2025 10:57:43" {WMEDLEY}TEDIT>TEDIT-LOOKS.;457) + :PREVIOUS-DATE " 6-Oct-2025 20:50:59" {WMEDLEY}tedit>TEDIT-LOOKS.;459) (PRETTYCOMPRINT TEDIT-LOOKSCOMS) @@ -60,7 +60,6 @@ (* ;; "Public entries") (FNS TEDIT.LOOKS TEDIT.GET.LOOKS TEDIT.SUBLOOKS TEDIT.FINDLOOKS) - [INITVARS (TEDIT.FONTCLASSES '(DISPLAY PDF POSTSCRIPT INTERPRESS] (FNS \TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.CHARLOOKS.NEW \TEDIT.CHARLOOKS.CHANGE.FONT \TEDIT.FONT.NEXTSIZE \TEDIT.LOOKS \TEDIT.FONTCOPY \TEDIT.COERCE.FONTCLASS \TEDIT.FONTCLASS.TO.FONT)) @@ -1375,8 +1374,6 @@ (TEDIT.NORMALIZECARET TEXTOBJ) (RETURN (\TEDIT.COPYSEL (FGETTOBJ TEXTOBJ SEL])]) ) - -(RPAQ? TEDIT.FONTCLASSES '(DISPLAY PDF POSTSCRIPT INTERPRESS)) (DEFINEQ (\TEDIT.CHANGE.CHARLOOKS @@ -2461,26 +2458,26 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (22099 24041 (\TEDIT.CHARLOOKS.DEFPRINT 22109 . 23245) (\TEDIT.PARALOOKS.DEFPRINT 23247 - . 24039)) (24145 24531 (\TEDIT.CREATE.FACE.MENU 24155 . 24327) (\TEDIT.CREATE.SIZE.MENU 24329 . 24529 -)) (25535 27424 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25545 . 27422)) (27696 52953 ( -\TEDIT.CHARLOOKS.FROM.FONT 27706 . 29990) (\TEDIT.EQCLOOKS 29992 . 33023) (\TEDIT.SAMECLOOKS 33025 . -36196) (TEDIT.CARETLOOKS 36198 . 37744) (TEDIT.COPY.LOOKS 37746 . 41029) ( -\TEDIT.UNPARSE.CHARLOOKS.LIST 41031 . 44525) (\TEDIT.MODIFYLOOKS 44527 . 46687) (TEDIT.NEW.FONT 46689 - . 47136) (\TEDIT.CARETLOOKS.VERIFY 47138 . 47975) (\TEDIT.CARETPIECE 47977 . 48282) ( -\TEDIT.GET.INSERT.CHARLOOKS 48284 . 51331) (\TEDIT.GET.TERMSA.WIDTHS 51333 . 51749) ( -\TEDIT.PARSE.CHARLOOKS.LIST 51751 . 52951)) (52954 65081 (\TEDIT.MCCS.TRANSLATE 52964 . 58817) ( -\TEDIT.CONVERT.TO.FORMATTED 58819 . 65079)) (65953 73290 (\TEDIT.UNIQUIFY.CHARLOOKS 65963 . 67623) ( -\TEDIT.UNIQUIFY.PARALOOKS 67625 . 68892) (\TEDIT.UNIQUIFY.ALL 68894 . 70982) ( -\TEDIT.FLUSH.UNUSED.LOOKS 70984 . 73288)) (73323 85281 (TEDIT.LOOKS 73333 . 75722) (TEDIT.GET.LOOKS -75724 . 78059) (TEDIT.SUBLOOKS 78061 . 82441) (TEDIT.FINDLOOKS 82443 . 85279)) (85350 115000 ( -\TEDIT.CHANGE.CHARLOOKS 85360 . 94138) (\TEDIT.CHANGE.CHARLOOKS.NEW 94140 . 97955) ( -\TEDIT.CHARLOOKS.CHANGE.FONT 97957 . 106264) (\TEDIT.FONT.NEXTSIZE 106266 . 107887) (\TEDIT.LOOKS -107889 . 111218) (\TEDIT.FONTCOPY 111220 . 112721) (\TEDIT.COERCE.FONTCLASS 112723 . 113874) ( -\TEDIT.FONTCLASS.TO.FONT 113876 . 114998)) (115043 146691 (\TEDIT.EQFMTSPEC 115053 . 118268) ( -TEDIT.GET.PARALOOKS 118270 . 122317) (\TEDIT.PARSE.PARALOOKS.LIST 122319 . 130352) (TEDIT.PARALOOKS -130354 . 131394) (\TEDIT.CHANGE.PARALOOKS 131396 . 138364) (\TEDIT.CHANGE.PARALOOKS.NEW 138366 . -142349) (TEDIT.COPY.PARALOOKS 142351 . 145025) (\TEDIT.PARABOUNDS 145027 . 146689)) (146751 154467 ( -TEDIT.SUBPARALOOKS 146761 . 150863) (SAMEPARALOOKS 150865 . 154465)) (154468 155155 ( -\TEDIT.MARK.REVISION 154478 . 155153))))) + (FILEMAP (NIL (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))))) STOP diff --git a/library/tedit/TEDIT-LOOKS.LCOM b/library/tedit/TEDIT-LOOKS.LCOM index 802c0d03f298ed9f38e77b6a681a2f4f58a379fc..066f0a1552dac306f0d36b44660325e55156333b 100644 GIT binary patch delta 490 zcmZvZ%}T>S6oqLO7lWu!Q4z#TP)L=8{-xR|V%khJ7&9f4)>gXdPtc&PC3c~R6r`=- zN|`5csjkGAaOJ`m(imO1DBRVBbIx}-A1~pj=kR?gvL>ibT}Z?d62#MTGU4CD$x^rD zG~CXXjaA(i3_|v(xRFZ7qJTJ%{wdbwWK2%RIjDI~{jAw`Pn`xh7j5r+S%%hG=h$r> zf!hL3D;Ng+mx`juL8I#D4D;;DsTdbUyrvsCXJN$$0S<<+a&UF9k5vPguQyNKnpgEM zw}!JrT$19MG{`}xY#F@f2_QMQtC%~O3N``0s8|$&&hx*eb7Y@JLC#yasFMN}R3C(i zp*i*$ip&g)kuvOYEb=xHzPlOGOv+vt=h#;-GmD@S_=*}aZPCOfo9c%c80qK75&shd z{0eLUd+G16W@Uj*4pfAGB{`C3p0Hi)9a N+v;t3V${?P^bJgZh`Im( delta 682 zcmbtRJ#P~+7*;b{2%#3yq06gND_xN8lrOjBifEm)ub4V#=j?4-5-DvSdjWRQ2zt}fSm;=5h9cY2@f9L$M5sykDm%xp9^od=9WFVcji?}6%3V9 zfXhLt^zLBs+%U?`gYoSNDL1vhTEq1sAP4^3DBlaJ*n!=ww|8=M+CS{=L+{yX_H-$L z?s(mAhN1RNLSik5VbDJYCu$1;(?q`SJFvfVX1B)*=hLRFL=8JdPWF6~;jbi6#<*ImLomweHB!iq4gdw=LlSQ=?G=p7w_h)` ziV&!Tb+~M6kB;0sfPWWOwwfzJt?B^!N8OeDTVw9>$IP2oipSh^NTR`=)D+3sgo0?z z?5Ne2R?MYbD?w6FGy)~H(P6@s0UjHcSYKKf?EyE6HK6>%U_O68sL%iEeMIQTY|Ci= zgjxLiK;3Xd*|hX`Vbu=A#YT>XDDQP=XHfp-g5H@p38hMXMG`Xpc>53yH*ZfM-EK?+ j{h_`E)atMf5$i${3h46dFunQ6O%!RZ!T&`=F&F43IQYD4 diff --git a/library/tedit/TEDIT-MENU b/library/tedit/TEDIT-MENU index cc340649..6794e9d7 100644 --- a/library/tedit/TEDIT-MENU +++ b/library/tedit/TEDIT-MENU @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "22-Oct-2025 12:55:36" {WMEDLEY}TEDIT>TEDIT-MENU.;498 183397 +(FILECREATED "12-Dec-2025 00:01:26" {WMEDLEY}tedit>TEDIT-MENU.;501 183343 :EDIT-BY rmk - :CHANGES-TO (FNS MARGINBAR.NEUTRALIZE \TEDIT.PARALOOKS.TO.MARBAR) + :CHANGES-TO (VARS TEDIT-MENUCOMS) - :PREVIOUS-DATE "19-Oct-2025 15:14:00" {WMEDLEY}TEDIT>TEDIT-MENU.;496) + :PREVIOUS-DATE " 7-Dec-2025 16:34:30" {WMEDLEY}tedit>TEDIT-MENU.;499) (PRETTYCOMPRINT TEDIT-MENUCOMS) @@ -67,7 +67,7 @@ (* ;; "") (* ; "CHARMENU") - [INITVARS (TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT)) + [INITVARS (TEDIT.FONTDEVICES '(DISPLAY PDF)) (TEDIT.FONTFAMILIES '(Classic Modern Terminal Helvetica TimesRoman Gacha] (FNS \TEDIT.CHARMENU.CREATE \TEDIT.CHARMENU.START \TEDIT.CHARMENU.SPEC \TEDIT.CHARMENU.PARSE \TEDIT.CHARMENU.FILLIN \TEDIT.SHOW.CHARLOOKS \TEDIT.APPLY.CHARLOOKS @@ -1952,7 +1952,7 @@ (* ; "CHARMENU") -(RPAQ? TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT)) +(RPAQ? TEDIT.FONTDEVICES '(DISPLAY PDF)) (RPAQ? TEDIT.FONTFAMILIES '(Classic Modern Terminal Helvetica TimesRoman Gacha)) (DEFINEQ @@ -2907,32 +2907,32 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4972 16610 (TEDIT.ADD.MENUITEM 4982 . 7099) (TEDIT.DEFAULT.MENUFN 7101 . 13822) ( -TEDIT.REMOVE.MENUITEM 13824 . 14821) (\TEDIT.CREATEMENU 14823 . 15388) (\TEDIT.MENU.WHENHELDFN 15390 - . 16295) (\TEDIT.MENU.WHENSELECTEDFN 16297 . 16608)) (17424 65459 (DRAWMARGINSCALE 17434 . 20893) ( -MARGINBAR 20895 . 28020) (MARGINBAR.CREATE 28022 . 32220) (MB.MARGINBAR.BUTTONEVENTINFN 32222 . 40024) - (MB.MARGINBAR.SELFN.TABS 40026 . 45266) (MB.MARGINBAR.SELFN.TABS.KIND 45268 . 46203) ( -MARGINBAR.GETSTATEFN 46205 . 50192) (MARGINBAR.SETSTATEFN 50194 . 50404) (MARGINBAR.NEUTRALIZE 50406 - . 51081) (MARGINBAR.LOOKS 51083 . 54189) (MB.MARGINBAR.SIZEFN 54191 . 54977) (MB.MARGINBAR.DISPLAYFN -54979 . 58040) (MDESCALE 58042 . 58582) (MSCALE 58584 . 58914) (MB.MARGINBAR.SHOWTAB 58916 . 61239) ( -MB.MARGINBAR.TABTRACK 61241 . 62626) (MARGINBAR.INIT 62628 . 64021) (\TEDIT.PARALOOKS.TO.MARBAR 64023 - . 65457)) (66284 73566 (TEDIT.MENUSTREAM 66294 . 67294) (TEDITMENUP 67296 . 68265) (\TEDIT.MENU.START - 68267 . 72614) (\TEDIT.MENU.OPEN? 72616 . 72990) (\TEDIT.MENU.BUTTONEVENTFN 72992 . 73564)) (73885 -81936 (\TEDIT.MENU.CREATE 73895 . 75835) (\TEDIT.MENU.PARSE 75837 . 79526) (\TEDIT.MENU.NEUTRALIZE -79528 . 81599) (\TEDITMENU.RECORD.UNFORMATTED 81601 . 81934)) (82002 101783 ( -\TEDIT.EXPANDEDMENU.CREATE 82012 . 87479) (\TEDIT.EXPANDEDMENU.START 87481 . 89105) ( -\TEDIT.EXPANDEDMENU.FN 89107 . 92362) (\TEDIT.EXPANDEDMENU.ACTIONFN 92364 . 101781)) (101845 121270 ( -\TEDIT.PARAMENU.CREATE 101855 . 110586) (\TEDIT.PARAMENU.START 110588 . 111842) ( -\TEDIT.APPLY.PARALOOKS 111844 . 112896) (\TEDIT.SHOW.PARALOOKS 112898 . 115615) ( -\TEDIT.PARAMENU.FILLIN 115617 . 120366) (\TEDIT.PARAMENU.RESHAPEFN 120368 . 121268)) (121475 148317 ( -\TEDIT.CHARMENU.CREATE 121485 . 124089) (\TEDIT.CHARMENU.START 124091 . 125381) (\TEDIT.CHARMENU.SPEC -125383 . 130066) (\TEDIT.CHARMENU.PARSE 130068 . 133236) (\TEDIT.CHARMENU.FILLIN 133238 . 137868) ( -\TEDIT.SHOW.CHARLOOKS 137870 . 141415) (\TEDIT.APPLY.CHARLOOKS 141417 . 142578) ( -\TEDIT.OFFSETTYPE.STATEFN 142580 . 144543) (\TEDIT.OTHER.STATECHANGEFN 144545 . 146190) ( -\TEDIT.OTHER.SELECTFN 146192 . 148315)) (148379 177437 (\TEDIT.PAGEMENU.CREATE 148389 . 156901) ( -\TEDIT.PAGEMENU.START 156903 . 157254) (\TEDIT.SHOW.PAGELOOKS 157256 . 159142) (\TEDIT.PAGEMENU.FILLIN - 159144 . 160694) (\TEDIT.PAGEREGION.UNPARSE 160696 . 170095) (\TEDIT.APPLY.PAGELOOKS 170097 . 172024) - (\TEDIT.CHANGE.PAGELOOKS 172026 . 176593) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176595 . 177435)) ( -177438 183241 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177448 . 180260) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN -180262 . 181687) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181689 . 183239))))) + (FILEMAP (NIL (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))))) STOP diff --git a/library/tedit/TEDIT-MENU.LCOM b/library/tedit/TEDIT-MENU.LCOM index 7be47f74510f87eb3d857b460193e8ee87bc86e8..8c35a52dc1e1ef10776debc2adc8559dbd0c993a 100644 GIT binary patch delta 398 zcmZ3qp85Vd<_Y1#hDN$BsmZ!V21cd|1_o9JhE_%svsCL#Qd2TZ>_S{!JVSJSUHwA! ztW6CJH5Is&3=I+Ljf|~~jjfC(3QxsAw3W|zVtrYU|OENO^(iJlE z6qMXTeS8#ad&SX?^Ukx>-8Qxyy? zjEzl<6|BHMaEeqY%FR~bvU2ut^mBI&)(!Dj&me)#s*3XT-D*et}Z^Vk+n8CGMPz5iA9xmm?36jX}MXDY4&MW lO-)S&jmf^(1K5GIn_n>3WZ`oWObT3^bI+aPnCx^t0RTIoY@GlA delta 428 zcmcb=j(O2~<_Y1#Mn<~+$tAi*21cd|hDKJVrdGxivs9fzTwOdv?7*b1ud83Ep0$ak zg{A_R5{h~QD+4ntQ*$MSq@vX1{M>@foYWMB)QWFFscq$HLA)nb}w4m46plS{+R)5q00$kh?(1O-$}A&xXtQm791b#?J^jjXlF$xJFr zEUJXK7s=JyU}q~BS{NH!nk!g={G{s?sZf-gt-xjF?BVF=?i#Ec;;*3L<`)cd@8kw& zsQ^s{tAHTaFi-!`U|koW{Xj<=S|SCKsgC5;cJUV*Bm05lmbPn@!K1;y_XR|5^e7PcnHC diff --git a/library/tedit/TEDIT-PAGE b/library/tedit/TEDIT-PAGE index 5e5cef71..557b9cbe 100644 --- a/library/tedit/TEDIT-PAGE +++ b/library/tedit/TEDIT-PAGE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Jun-2025 08:24:12" {WMEDLEY}tedit>TEDIT-PAGE.;222 134861 +(FILECREATED "17-Jan-2026 12:00:08" {WMEDLEY}tedit>TEDIT-PAGE.;241 130528 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY) + :CHANGES-TO (FNS TEDIT.TO.IMAGEFILE) - :PREVIOUS-DATE "11-May-2025 15:03:00" {WMEDLEY}tedit>TEDIT-PAGE.;221) + :PREVIOUS-DATE "15-Jan-2026 10:48:30" {WMEDLEY}tedit>TEDIT-PAGE.;240) (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.FORMAT.HARDCOPY) + (FNS TEDIT.TO.IMAGEFILE) (COMS (* ;; "Perform page layout, based on a regular expression of typed regions.") @@ -631,148 +631,103 @@ (TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 72 72 NIL 1))) (DEFINEQ -(TEDIT.FORMAT.HARDCOPY - [LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG - ENDPG QUIET) (* ; "Edited 5-Jun-2025 08:24 by rmk") - (* ; "Edited 22-Apr-2025 08:12 by rmk") - (* ; "Edited 23-Feb-2025 09:59 by rmk") - (* ; "Edited 30-Aug-2024 15:45 by rmk") - (* ; "Edited 10-Jul-2024 23:34 by rmk") - (* ; "Edited 29-Jun-2024 10:32 by rmk") - (* ; "Edited 5-Apr-2024 08:01 by rmk") - (* ; "Edited 16-Mar-2024 09:31 by rmk") - (* ; "Edited 7-Mar-2024 12:34 by rmk") - (* ; "Edited 19-Jan-2024 23:39 by rmk") - (* ; "Edited 24-Dec-2023 14:10 by rmk") - (* ; "Edited 15-Nov-2023 23:56 by rmk") - (* ; "Edited 22-Sep-2023 20:38 by rmk") - (* ; "Edited 4-Jul-2023 11:16 by rmk") - (* ; "Edited 2-Oct-2022 00:00 by rmk") - (* ; - "Edited 25-May-93 13:06 by sybalsky:mv:envos") +(TEDIT.TO.IMAGEFILE + [LAMBDA (TSTREAM IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 17-Jan-2026 11:59 by rmk") + (* ; "Edited 15-Jan-2026 08:46 by rmk") + (* ; "Edited 25-Dec-2025 15:07 by rmk") + (* ; "Edited 20-Dec-2025 23:03 by rmk") + (* ; "Edited 14-Dec-2025 17:38 by rmk") + (* ; "Edited 27-Sep-2025 14:05 by rmk") + (* ; "Edited 19-Sep-2025 22:08 by rmk") (* ;; "Format a document for hardcopy. Returns the number of pages printed (not the final page number!). Returns NIL if the before-print-fn said not to print.") - (* ;; "TEXTSTREAM is either already a textstream or somehow denotes a tedit-formatted file, otherwise an error. We don't here try to decide that a non-formatted file is a plain text file, as opposed binary or anything else.") + (* ;; "TSTREAM is either already a textstream or somehow denotes a tedit-formatted file, otherwise an error. ") (RESETLST - (SETQ TEXTSTREAM (if (TEXTSTREAM TEXTSTREAM T) - elseif (TEDIT.FORMATTEDFILEP TEXTSTREAM) - then [RESETSAVE (SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTSTREAM)) - `(PROGN (CLOSEF? OLDVALUE] - TEXTSTREAM - else (ERROR TEXTSTREAM "is not a Tedit stream"))) - (PROG ((TEXTOBJ (FTEXTOBJ TEXTSTREAM)) - [FORMATTINGSTATE (create PAGEFORMATTINGSTATE - PAGE# _ (FIXP FIRSTPG#) - FIRSTPAGE _ T - STATE _ FIRSTPG# - MINPAGE# _ STARTPG - MAXPAGE# _ (OR ENDPG 65535) - CHNO _ 1 - PAGEHEADINGS _ (LIST NIL NIL) - PAGE#GENERATOR _ (AND (LISTP FIRSTPG#) - (CDR FIRSTPG#)) - PAGE#TEXT _ (AND (LISTP FIRSTPG#) - (CAR FIRSTPG#] - PRSTREAM PAGEREGION SCRATCHFILE NPAGES WASOPEN TARGETFILENAME) - (CL:WHEN (EQ 'DON'T (APPLY* (OR (GETTEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN) - (FUNCTION NILL)) - TEXTSTREAM)) (* ; + (SETQ TSTREAM (if (TEXTSTREAM TSTREAM T) + elseif (TEDIT.FORMATTEDFILEP TSTREAM) + then [RESETSAVE (SETQ TSTREAM (OPENTEXTSTREAM TSTREAM)) + `(PROGN (CLOSEF? OLDVALUE] + TSTREAM + else (ERROR TSTREAM "is not a Tedit stream"))) + (CL:WHEN (GETTEXTPROP TSTREAM 'MENUFLG) + (SETQ TSTREAM (TEXTSTREAM (\TEDIT.MAINW TSTREAM)))) + (CL:UNLESS IMAGEFILE + [SETQ IMAGEFILE (if (GETTEXTPROP TSTREAM 'FILENAME) + then (PACKFILENAME 'VERSION NIL 'EXTENSION (CAR ( + EXTENSIONS.FOR.IMAGEFILETYPE + IMAGETYPE)) + 'BODY + (GETTEXTPROP TSTREAM 'FILENAME)) + else (UNIX-TMP-FILE-NAME 'tedit (CAR (EXTENSIONS.FOR.IMAGEFILETYPE + IMAGETYPE]) + (PUTTEXTPROP TSTREAM 'LASTIMAGEFILE NIL) + (PROG* ((FIRSTPG# (LISTGET OPTIONS 'FIRSTPG#)) + (TEXTOBJ (FTEXTOBJ TSTREAM)) + [FORMATTINGSTATE (create PAGEFORMATTINGSTATE + PAGE# _ (FIXP FIRSTPG#) + FIRSTPAGE _ T + STATE _ FIRSTPG# + MINPAGE# _ (LISTGET OPTIONS 'STARTPG) + MAXPAGE# _ (OR (LISTGET OPTIONS 'ENDPG) + 65535) + CHNO _ 1 + PAGEHEADINGS _ (LIST NIL NIL) + PAGE#GENERATOR _ (AND (LISTP FIRSTPG#) + (CDR FIRSTPG#)) + PAGE#TEXT _ (AND (LISTP FIRSTPG#) + (CAR FIRSTPG#] + IMAGESTREAM PAGEREGION SCRATCHFILE) + (CL:WHEN (EQ 'DON'T (APPLY* (OR (GETTEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN) + (FUNCTION NILL)) + TSTREAM)) (* ;  "Do pre-hardcopy processing as indicated, or refuse") - (RETURN)) - [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Hardcopy") - '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] - (SETQ PAGEREGION (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)) - (SETPFS FORMATTINGSTATE PRESSREGION TEDIT.DEFAULTPAGEREGION) + (RETURN)) + [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Hardcopy") + '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] + (SETQ PAGEREGION (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)) + (SETPFS FORMATTINGSTATE PRESSREGION TEDIT.DEFAULTPAGEREGION) (* ;  "Print in the usual region on the page") - (CL:UNLESS BREAKPAGETITLE - [SETQ BREAKPAGETITLE (COND - ((LISTGET PRINTOPTIONS 'DOCUMENT.NAME)) - ([OR (NOT (FGETTOBJ TEXTOBJ TXTFILE)) - (STRINGP (FGETTOBJ TEXTOBJ TXTFILE)) - (type? STREAM (fetch (STREAM FULLNAME) - of (FGETTOBJ TEXTOBJ TXTFILE))) - (STRINGP (fetch (STREAM FULLNAME) - of (FGETTOBJ TEXTOBJ TXTFILE] - (* ; - "This isn't a real file, so print a generic name on the document break page.") - "TEdit Hardcopy Output") - (T (* ; - "It's a real file, so use the file name on the break page.") - (fetch (STREAM FULLNAME) of (FGETTOBJ TEXTOBJ TXTFILE]) - [SETQ SCRATCHFILE (OR FILE (PRINTER.SCRATCH.FILE (TEXTSTREAM TEXTSTREAM] - (RESETLST (* ; - "Set up to do the user's cleanup on the way out, as well.") - (CL:UNLESS QUIET (TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T)) - [COND - ((AND FILE (OPENP FILE) - (IMAGESTREAMTYPE FILE)) (* ; - "The file he handed us is already an image-type file. Just append the new stuff to it.") - (SETQ WASOPEN T) - (SETQ PRSTREAM FILE)) - (T (* ; - "T'wasn't an image stream, so let's open us one.") - (RESETSAVE (SETQ PRSTREAM (OPENIMAGESTREAM - SCRATCHFILE - [OR IMAGETYPE (SETQ IMAGETYPE - (CAR (PRINTERPROP (PRINTERTYPE - SERVER) - 'CANPRINT] - (LIST 'FONT (FONTCREATE 'TERMINAL 10) - 'BREAKPAGEFILENAME BREAKPAGETITLE))) - '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] - (* ; - "So we close and delete the file in case of trouble.") - (* ;; "The right margin must be big enough to prevent line wrap on landscaped 14 inch paper, with Postscript's scaling of .01-point increments. (~ 101,000). This will cause a performance hit. Sigh. JDS 9/5/89") + (* ;; "TEDIT puts its own headings on the page") - (DSPRIGHTMARGIN 131072 PRSTREAM) - (while (ILEQ (GETPFS FORMATTINGSTATE CHNO) - (FGETTOBJ TEXTOBJ TEXTLEN)) - do - (* ;; "Format pages according to the existing layout:") + [SETQ IMAGESTREAM (OPENIMAGESTREAM IMAGEFILE IMAGETYPE `(HEADING NIL ,@OPTIONS] - (\TEDIT.FORMATBOX TEXTSTREAM PRSTREAM (GETPFS FORMATTINGSTATE CHNO) - PAGEREGION FORMATTINGSTATE IMAGETYPE) - (CL:WHEN (EQ (GETPFS FORMATTINGSTATE STATE) - :NEW-PAGE-LAYOUT) + (* ;; "The right margin must be big enough to prevent line wrap on landscaped 14 inch paper, with Postscript's scaling of .01-point increments. (~ 101,000). This will cause a performance hit. Sigh. JDS 9/5/89") - (* ;; "New page layout got specified. Prepare to re-enter the formatting code and skip to the equivalent page in the new format.") + (DSPRIGHTMARGIN 131072 IMAGESTREAM) + (while (ILEQ (GETPFS FORMATTINGSTATE CHNO) + (FGETTOBJ TEXTOBJ TEXTLEN)) + do + (* ;; "Format pages according to the existing layout:") - (SETQ PAGEREGION (GETPFS FORMATTINGSTATE NEWPAGELAYOUT)) + (\TEDIT.FORMATBOX TSTREAM IMAGESTREAM (GETPFS FORMATTINGSTATE CHNO) + PAGEREGION FORMATTINGSTATE IMAGETYPE) + (CL:WHEN (EQ (GETPFS FORMATTINGSTATE STATE) + :NEW-PAGE-LAYOUT) - (* ;; "Set up the formatting state so code knows we're looking for an equivalent page, and which page it is. (The SUB1 is because we counted an extra page for the page on which the new payout was detected.)") + (* ;; "New page layout got specified. Prepare to re-enter the formatting code and skip to the equivalent page in the new format.") - (SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE (SUB1 (GETPFS FORMATTINGSTATE - PAGECOUNT))) - (SETPFS FORMATTINGSTATE PAGECOUNT 0) - (SETPFS FORMATTINGSTATE STATE :SEARCHING-FOR-EQUIVALENT-PAGE))) - (SETQ TARGETFILENAME (STREAMPROP PRSTREAM 'PDFTARGETINFO)) - (CL:UNLESS WASOPEN (* ; - "Only if we created the image stream should we close it.") - (SETQ PRSTREAM (CLOSEF PRSTREAM)) - (CL:UNLESS DONTSEND - (SEND.FILE.TO.PRINTER PRSTREAM SERVER (APPEND PRINTOPTIONS - (LIST 'DOCUMENT.NAME - BREAKPAGETITLE))))) - (CL:UNLESS FILE (DELFILE SCRATCHFILE)) - (APPLY* (OR (GETTEXTPROP TEXTOBJ 'AFTERHARDCOPYFN) - (FUNCTION NILL)) - TEXTSTREAM)) - (SETQ NPAGES (GETPFS FORMATTINGSTATE PAGECOUNT)) - (CL:UNLESS QUIET - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES) - "" - "s") - " printed" - (CL:IF (EQ FILE SCRATCHFILE) - (CONCAT " to " (OR TARGETFILENAME - (FULLNAME FILE))) - "")) - T)) - (RETURN NPAGES)))]) + (SETQ PAGEREGION (GETPFS FORMATTINGSTATE NEWPAGELAYOUT)) + + (* ;; "Set up the formatting state so code knows we're looking for an equivalent page, and which page it is. (The SUB1 is because we counted an extra page for the page on which the new payout was detected.)") + + (SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE (SUB1 (GETPFS FORMATTINGSTATE + PAGECOUNT))) + (SETPFS FORMATTINGSTATE PAGECOUNT 0) + (SETPFS FORMATTINGSTATE STATE :SEARCHING-FOR-EQUIVALENT-PAGE))) + (APPLY* (OR (GETTEXTPROP TEXTOBJ 'AFTERHARDCOPYFN) + (FUNCTION NILL)) + TSTREAM) + + (* ;; "So caller can formulate a prompt message TEDIT.IMAGEFILE.MESSAGE") + + (PUTTEXTPROP TSTREAM 'LASTIMAGEFILE (LIST (GETPFS FORMATTINGSTATE PAGECOUNT) + (FULLNAME IMAGESTREAM) + (PRINTERNAME IMAGESTREAM))) + (RETURN (CLOSEF IMAGESTREAM))))]) ) @@ -2101,18 +2056,18 @@ (RETURN (DREMOVE NIL $$VAL]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (12139 15751 (\TEDIT.PARSE.PAGEFRAMES 12149 . 13928) (\TEDIT.PUT.PAGEFRAMES 13930 . -14754) (\TEDIT.UNPARSE.PAGEFRAMES 14756 . 15749)) (15814 37831 (TEDIT.SINGLE.PAGEFORMAT 15824 . 26817) - (TEDIT.COMPOUND.PAGEFORMAT 26819 . 27798) (TEDIT.PAGEFORMAT 27800 . 35089) (TEDIT.GET.PAGEFORMAT -35091 . 37829)) (38118 48925 (TEDIT.FORMAT.HARDCOPY 38128 . 48923)) (49012 102264 (\TEDIT.FORMATBOX -49022 . 62446) (\TEDIT.FORMATHEADING 62448 . 67094) (\TEDIT.FORMATPAGE 67096 . 76285) ( -\TEDIT.FORMATTEXTBOX 76287 . 92800) (\TEDIT.FORMATFOLIO 92802 . 98119) (\TEDIT.FORMAT.FOUNDBOX? 98121 - . 100160) (\TEDIT.SKIP.SPECIALCOND 100162 . 102262)) (102344 107399 (\TEDIT.HARDCOPY.PAGEHEADINGS -102354 . 107397)) (107508 115559 (\TEDIT.HARDCOPY-COLUMN-END 107518 . 115557)) (115604 120545 ( -SCALEPAGEUNITS 115614 . 116755) (SCALEPAGEXUNITS 116757 . 117527) (SCALEPAGEYUNITS 117529 . 118300) ( -\TEDIT.PAPERHEIGHT 118302 . 119237) (\TEDIT.PAPERWIDTH 119239 . 120543)) (120961 124529 (ROMANNUMERALS - 120971 . 124527)) (124568 131834 (TEDIT.PAGENO.CREATE 124578 . 124954) (\TEDIT.PAGENO.OBJINIT 124956 - . 126239) (\TEDIT.PAGENO.BUTTONEVENTINFN 126241 . 127307) (\TEDIT.PAGENO.IMAGEBOXFN 127309 . 129459) -(\TEDIT.PAGENO.DISPLAYFN 129461 . 131111) (\TEDIT.PAGENO.GETFN 131113 . 131505) (\TEDIT.PAGENO.PUTFN -131507 . 131832)) (131899 134838 (\TEDIT.FORMAT.FOOTNOTE 131909 . 134836))))) + (FILEMAP (NIL (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))))) STOP diff --git a/library/tedit/TEDIT-PAGE.LCOM b/library/tedit/TEDIT-PAGE.LCOM index 42cbcaf36d8504533b02afd9ac4ab8e735738a0f..79d8c691c3b11a18cd55db2a42541cfec55902fc 100644 GIT binary patch delta 1868 zcmaJ?&2Jk;6wiiGngD58g{P-W? z@4tkv!Z}jNt!?k;WJ%V6$R$ZCNyd}CLQf@Gn8}Rol9EJ9nv#JJj&|Ay4-a=g+UdZ~ zCx=HLFO?vm6+6fWZr*N~RchIF3cLG|v0C*yjH2Z8`3!Wnk1_N`c;qLU?95%uzE!7X zpPGmY<4N>WjBX1n(<%X?NSbU!_l0FL%AJLh=hF?_Z8dWhL_rX3q)w@%8YLxqDrBcr zDLWIrtEWych2K-JjbcP!-dfo*pjr0Kpj_h>c~Afk%kyc~b{+6Q2VQP7z+4+>Yhby4 z!wdr3sWt;f>;b{vYzFS?8qOuKY`+{*2p}0FUfxj~niqmXzvUtFTzSS1H>2x@kZqJ>E;^R={ zdpw{mc0Oc|-1w&N&Jo(;d6+)EABw~MlRTey`8S-Op6Fqu5L+W|uU}(`-^~r&m{-h} zM*bM%Rpt|>xUuqvITeb(v6Zhw@lhypfQu9#eyl05Tl*<-O~$jA_ph$rT*n^^+M4};stlM5zfb5Id60rXxy~RlRpxQ z!6*!flkj9q*!wdzph*@V^p|*Qsqe2o?^n%EX5uU^`xh*`eq%Oi{R_AbKkxX9Er^Rd zkL{ZicXeVwx$ZWp1v(+%wE}jRJ>SKvFUjEfwi8g_F&h-Lq7Lk}J7$kr8i6VudaJ4e z@5LGszmQdT6I4lsN)thrBS`0&<#iSkM<~T{CYk&%0;-ZU zUcDi64d}~6p)f4Rc0$mL(X%_QtQ8cfo6TS-pqgfYW21m-st%@wovxXFrR;iJmIIoi zM~81iPt|lNIW){MVanCbEw>ebf{Zn4R#1jOku|8e&I+!gkZ?Q&^IN4@IvoL&u}tbz zyeh~F0aPy^bqZus80eQwBwXiGM~bLjOxAj+Ys4@Hx`tw}{ih6~$$)yldyGP+qGQrl zxd5wfWeW&VhyBFf8L&Zpb~?bWRN}6y(4bDss#oz30`G}|XhbT^$)KnbWNO<-o%X@u zrx{QbHBy(l<68c7sdP^nNU9BTtf>6JZItL?(`^*#Xm5E@n2H`PTVp7v&z9dQkFUJ- H;Q0E#B&nhd delta 3002 zcmZve&2Jk;6u|AIEv-Y7G(?d}EAzUfOsw)XC3cbsWOP>Jl&xM|}M z+(Qr5N{9ne4^S-rfgU&^q{f)54{#tC&LD9C)FV>)2MBLw*B^C=l<~})+4tVey!V^; z$M3->FM?mvSy@@W@o;xp7Ucv;Vpf#13FYZd%9Z6Pgalb0%!*=GQnI2XK(pF-uy=p4 z2K8MK3YAg`hS$YnF#&3u&8-^z-}h-D8d@soB`s%bD$(*FKw`*9IxEMslH9r;Ts$Mo zASv;5Qflo5FQ*HpT~flZ+6bjCk@9{8!j z2J4m19GyJFx_4OW7wy&^VQid*R;l$*<;>ckQ|Qv zbMSbruhb1xFVMMmbdB4pj&&)tFRal?8X0Kj8hjtWS?3G8q^}{+d5!na1p_p^Q=FQd z<}02(Kgu}0-nDvluIr%o=SRCVyw>-I&bW5v>?yXnu3cj;2Dz@6_;qiQ?>U>R&U8KL z=v;8;x3E7oSbonJagE{b^M8*5OL8&=8<+|@iFuLcu9&w#RzxqJybI=0CCehP+qXc< zqyg`j1)pV`I8NhbY9$_PQi{czk&m%ajF>Tg?-+SfN`?*9LIrtDt#|@*CDYL`5EKPG zE1s?$F$H-CzgjJlGRBc^Ksvz<^8oiFE}6!}Fo>7O5KnvIrP*AE(jRiiSwQj);$+!E zmoX5L14>eEeRmyPIW0og(C9Ktg5{EW+pG|f#RM2S(nZQBpcaT`_j12rVC>2mytztQ zGf0d_xFn;=e8G!*-6)ulQU-a}PlTj|p4esGP)m?V@*RL1S0JYvJ+CnNBs>#I#N(1v zu%sG!;Cbj}|5ERqm%QV956n`2T`g6#Xf%qsEfgC24>p_4`tDu$sId=w`}N%>qhd5P ze93*1sbcHT`AaSy(U1|mQM{8;0-#ielI~cyin>F~Sug-ceMcz5#8_$cJ?UE@?l!u>im zfrN|HIXXHLjc^hiT;NFZN7V=;l`vlwx-{~HM)(~6pc<+D$e8dIjeJhs2Yi{xjHa9nzbLXm;yL6$0Nam|}vq6{6UG#h%2v2j4E}RO!(Ra^x zGx!0O+c%13ZlJvL(zEm#AM%DSlwKZ$dDoomoS_R`E8n*3EjxRXY4@J0@^oM+j!Zhn z8Hgh*a;A|}3B(g(zl;21#S4drlFaakQBVxQ1M+1slg zKtYW7sEzq=KSwYqNW-CQQ4lYfI9N_#-X#))zK8}r_mR3c)f~~+HBP!=(j&AqyYh>nQvkwr&<_OYcSItK-uj_~A{*{hdyhET79(=p#iDmWd>#9lE4Is+&p o-Gc68(?4-mIQAhIg+OFH7?^0)gus;!Z#7T<2f@R=o&W#< diff --git a/library/tedit/TEDIT-STREAM b/library/tedit/TEDIT-STREAM index c9360e8a..de978046 100644 --- a/library/tedit/TEDIT-STREAM +++ b/library/tedit/TEDIT-STREAM @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2025 08:19:29" {MEDLEY}tedit>TEDIT-STREAM.;15 192029 +(FILECREATED " 2-Dec-2025 17:50:45" {WMEDLEY}tedit>TEDIT-STREAM.;930 194007 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.TEXTINIT) + :CHANGES-TO (FNS OPENTEXTSTREAM \TEDIT.OPENTEXTFILE) - :PREVIOUS-DATE "20-Sep-2025 08:49:36" {MEDLEY}tedit>TEDIT-STREAM.;14) + :PREVIOUS-DATE "19-Oct-2025 15:09:09" {WMEDLEY}TEDIT>TEDIT-STREAM.;927) (PRETTYCOMPRINT TEDIT-STREAMCOMS) @@ -83,10 +83,6 @@ (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) @@ -126,7 +122,9 @@  "The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") [ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) - (PCONTENTS DATUM] + (PCONTENTS DATUM)) + (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) + (SETPC DATUM PCONTENTS NEWVALUE] PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0) (DATATYPE TEXTOBJ ( @@ -698,6 +696,8 @@ (\TEDIT.TEXTBIN [LAMBDA (TSTREAM) + (* ;; "Edited 13-Oct-2025 17:16 by rmk") + (* ;; "Edited 21-Oct-2024 00:26 by rmk") (* ;; "Edited 3-May-2024 14:57 by rmk") @@ -767,7 +767,7 @@ (if (\ENDOFPIECEP PCCHARSLEFT) then (SETQ PC (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE PC) 0)) - else (\TEDIT.INSTALL.FILEBUFFER TSTREAM (SUB1 PCCHARSLEFT)))) + else (\TEDIT.INSTALL.FILEBUFFER TSTREAM PCCHARSLEFT))) (if (NOT PC) then (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM) elseif (ffetch (STREAM BINABLE) of TSTREAM) @@ -1232,6 +1232,10 @@ (OPENTEXTSTREAM [LAMBDA (TEXT WINDOW START/PROPS END PROPS) + (* ;; "Edited 2-Dec-2025 17:49 by rmk") + + (* ;; "Edited 25-Sep-2025 21:30 by rmk") + (* ;; "Edited 9-Sep-2025 22:07 by rmk") (* ;; "Edited 17-Feb-2025 08:57 by rmk") @@ -1317,12 +1321,12 @@ (if TEXT then (* ;  "Verify/open the file before the window") - (SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS)) + (SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS T)) (FSETTOBJ TEXTOBJ TXTFILE TEXT) else (* ;; "An empty document starts in an MCCS environment") - (FPUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS) + (PUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS) 'CHARENCODING 'MCCS)) @@ -1352,7 +1356,8 @@ TSTREAM))]) (COPYTEXTSTREAM - [LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 21-Apr-2025 23:48 by rmk") + [LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 5-Oct-2025 10:54 by rmk") + (* ; "Edited 21-Apr-2025 23:48 by rmk") (* ; "Edited 8-Feb-2025 20:10 by rmk") (* ; "Edited 12-Jan-2025 12:16 by rmk") (* ; "Edited 17-Mar-2024 12:41 by rmk") @@ -1372,7 +1377,10 @@ (LET* ((TSTREAM (TEXTSTREAM ORIGINAL)) (TEXTOBJ (FTEXTOBJ TSTREAM)) - [NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (COPY (FGETTOBJ TEXTOBJ EDITPROPS] + [NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (APPEND (COPY (FGETTOBJ TEXTOBJ EDITPROPS)) + (for DP in (FGETTOBJ TEXTOBJ DOCPROPS) + collect (LIST (CAR DP) + (COPY (CDR DP] (NEWTEXTOBJ (FTEXTOBJ NEWSTREAM))) (* ;  "Create an empty textstream into which the pieces can be hammered") (for PC NEWPC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) @@ -1657,7 +1665,8 @@ (SETTOBJ TEXTOBJ DEFAULTPARALOOKS PARALOOKS]) (\TEDIT.OPENTEXTFILE - [LAMBDA (TEXT PROPS) (* ; "Edited 16-Sep-2025 00:28 by rmk") + [LAMBDA (TEXT PROPS ERROR) (* ; "Edited 2-Dec-2025 17:49 by rmk") + (* ; "Edited 16-Sep-2025 00:28 by rmk") (* ; "Edited 8-Sep-2025 21:52 by rmk") (* ; "Edited 21-Nov-2024 11:38 by rmk") (* ; "Edited 20-Dec-2023 10:49 by rmk") @@ -1668,29 +1677,22 @@ (* ; "Edited 17-Sep-2023 21:29 by rmk") (CL:WHEN TEXT (if (\GETSTREAM TEXT 'INPUT T) - elseif (OR (LITATOM TEXT) - (STRINGP TEXT) - (CL:PATHNAMEP TEXT) - (STREAMP TEXT)) - then (* ; "String detects empty extension") - [RESETSAVE [SETQ TEXT (OPENSTREAM (if (STREAMP TEXT) - elseif (OR (CL:PATHNAMEP TEXT) - (FILENAMEFIELD.STRING TEXT - 'EXTENSION)) - then (FINDFILE TEXT T) - elseif (FINDFILE-WITH-EXTENSIONS TEXT NIL - *TEDIT-EXTENSIONS*) - else TEXT) - 'INPUT - 'OLD - `((TYPE TEXT) - (FORMAT ,(LISTGET PROPS 'FORMAT] - '(PROGN (AND RESETSTATE (CLOSEF? OLDVALUE] - TEXT - else - (* ;; "Don't know what it is") - - (ERROR TEXT " does not identify a Tedit document")))]) + elseif [AND (OR (LITATOM TEXT) + (STRINGP TEXT) + (CL:PATHNAMEP TEXT) + (STREAMP TEXT)) + (CAR (NLSETQ (OPENSTREAM (if (STREAMP TEXT) + elseif (CL:PATHNAMEP TEXT) + then (FINDFILE TEXT T) + elseif (FINDFILE-WITH-EXTENSIONS TEXT NIL + *TEDIT-EXTENSIONS*) + else TEXT) + 'INPUT + 'OLD + `((TYPE TEXT) + (FORMAT ,(LISTGET PROPS 'FORMAT] + elseif ERROR + then (ERROR "File not found:" TEXT)))]) (\TEDIT.CREATE.TEXTSTREAM [LAMBDA (PROPS) (* ; "Edited 28-Jul-2025 22:56 by rmk") @@ -1751,7 +1753,7 @@ NEWSTREAM]) (\TEDIT.TEXTINIT - [LAMBDA NIL (* ; "Edited 23-Sep-2025 08:19 by rmk") + [LAMBDA NIL (* ; "Edited 23-Sep-2025 21:03 by rmk") (* ; "Edited 20-Sep-2025 08:48 by rmk") (* ; "Edited 18-Sep-2025 14:52 by rmk") (* ; "Edited 10-Jul-2025 11:28 by rmk") @@ -1791,7 +1793,7 @@ (* ;; "(FW8 WORD)") (SETQ \TEDITIMAGEOPS (create IMAGEOPS - IMAGETYPE _ 'TEXT + IMAGETYPE _ 'TEDIT IMXPOSITION _ (FUNCTION \TEDIT.TEXTDSPXPOSITION) IMYPOSITION _ (FUNCTION \TEDIT.TEXTDSPYPOSITION) IMLEFTMARGIN _ (FUNCTION \TEDIT.TEXTLEFTMARGIN) @@ -1821,6 +1823,9 @@ (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 @@ -1856,6 +1861,9 @@ 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))) @@ -2100,28 +2108,34 @@ (\TEDIT.INSTALL.PIECE TSTREAM PC (- CH# START-OF-PIECE)))]) (\TEDIT.TEXTDSPXPOSITION - [LAMBDA (TSTREAM XPOSITION) (* ; "Edited 20-Sep-2025 08:30 by rmk") + [LAMBDA (TSTREAM XPOSITION) (* ; "Edited 20-Sep-2025 22:48 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 17-Mar-2024 12:15 by rmk") (* ; "Edited 3-Jan-2001 17:27 by rmk:") (* ;  "Edited 24-Oct-88 23:09 by rmk:; Edited 26-Sep-85 16:30 by ajb:") + (* ;; "This doesn't make much sense for a character-oriented stream like a TEDIT stream. If the stream is displayed in a window, this returns the window's current position, and changes it as well. But that doesn't affect or particularly relate to the underlying sequence of characters.") - (* ;; - "Simply returns the XPOSITION of the primary window's display stream, this is a read-only function") + (* ;; "If there is no window (an OPENTEXTSTREAM being written on by a printing algorithm, like the pretty printer for source files, this estimates the XPOSITION from the number of characters that have been printed on the line since the last TERPRI (= POSITION), assuming that they are all the width of the space (or the average charwidth). And if XPOSITION is non-NIL, that is also translated into an estimated number of characters, and spaces are put out to get out to that position (essentially assuming that we are writing at the end of the file). We can't go backwards.") + + (* ;; "") + + (* ;; "We could be more accurate by reading backwards to the last TERPRI, and not rely on POSITION. And if we were going backwards, we could think of this as setting the caret position as close as possible to the specified XPOSITION, But going forward, we still would have to fill in with spaces--and that's the PRETTYPRINT case.") (LET ((WINDOW (\TEDIT.PRIMARYPANE TSTREAM)) - SPACEWIDTH) (* ; + SPACEWIDTH CHARPOS NSPACES) (* ;  "If there is no window, estimate from character position") (if WINDOW then (DSPXPOSITION XPOSITION WINDOW) else (SETQ SPACEWIDTH (CHARWIDTH (CHARCODE SPACE) TSTREAM)) - (PROG1 (TIMES SPACEWIDTH (POSITION TSTREAM)) - (CL:WHEN (AND XPOSITION (IGEQ XPOSITION 0)) - (SPACES (IDIFFERENCE (QUOTIENT XPOSITION SPACEWIDTH) - (POSITION TSTREAM)) - TSTREAM)))]) + (SETQ CHARPOS (POSITION TSTREAM)) + (PROG1 (TIMES SPACEWIDTH CHARPOS) + (CL:WHEN XPOSITION + (SETQ NSPACES (IDIFFERENCE (FIXR (FQUOTIENT XPOSITION SPACEWIDTH)) + CHARPOS)) + (CL:WHEN (IGREATERP NSPACES 0) + (SPACES NSPACES TSTREAM))))]) (\TEDIT.TEXTDSPYPOSITION [LAMBDA (TSTREAM YPOSITION) (* ; "Edited 25-Jun-2024 11:59 by rmk") @@ -2970,7 +2984,8 @@ OLDITEMS]) (\TEDIT.TEXTPROP - [LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 17-Jul-2025 00:19 by rmk") + [LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 5-Oct-2025 10:15 by rmk") + (* ; "Edited 17-Jul-2025 00:19 by rmk") (* ; "Edited 16-Feb-2025 23:27 by rmk") (* ; "Edited 15-Feb-2025 14:02 by rmk") (* ; "Edited 22-Dec-2024 00:23 by rmk") @@ -3056,32 +3071,42 @@ (CL:WHEN SETNEWVALUE (FSETTOBJ TEXTOBJ LOOPFN NEWVALUE)))) (CHARFN (PROG1 (FGETTOBJ TEXTOBJ CHARFN) (CL:WHEN SETNEWVALUE (FSETTOBJ TEXTOBJ CHARFN NEWVALUE)))) - (PROG1 (LISTGET (FGETTOBJ TEXTOBJ EDITPROPS) - PROP) - (CL:WHEN SETNEWVALUE - (CL:UNLESS (LISTP (FGETTOBJ TEXTOBJ EDITPROPS)) + (OR (PROG1 (LISTGET (FGETTOBJ TEXTOBJ EDITPROPS) + PROP) + (CL:WHEN SETNEWVALUE + (CL:UNLESS (LISTP (FGETTOBJ TEXTOBJ EDITPROPS)) (* ;  "Make sure we have a list to smash, no matter what.") - (FSETTOBJ TEXTOBJ EDITPROPS (LIST PROP NIL))) - (LISTPUT (FGETTOBJ TEXTOBJ EDITPROPS) - PROP NEWVALUE)))]) + (FSETTOBJ TEXTOBJ EDITPROPS (LIST PROP NIL))) + (LISTPUT (FGETTOBJ TEXTOBJ EDITPROPS) + PROP NEWVALUE))) + (PROG1 (GETMULTI (FGETTOBJ TEXTOBJ DOCPROPS) + PROP) + (CL:WHEN SETNEWVALUE + (PUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS) + PROP NEWVALUE)))]) ) (DEFINEQ (\TEDIT.TEXTOBJ.PROPNAMES - [LAMBDA (TEXTOBJ) (* ; "Edited 4-Jul-2024 11:08 by rmk") + [LAMBDA (TEXTOBJ) (* ; "Edited 5-Oct-2025 10:50 by rmk") + (* ; "Edited 4-Jul-2024 11:08 by rmk") (* ; "Edited 30-Jun-2024 09:04 by rmk") (* ;; "Stick the user properties at the end with --USERPROPS-- separator. INSPECTABLEFIELDNAMES does the sort for defined field names, the UFIELDS have to be sorted here.") - (LET ([TFIELDS (REMOVE 'EDITPROPS (INSPECTABLEFIELDNAMES (OR (RECLOOK 'TEXTOBJ) + (LET [[TFIELDS (REMOVE 'EDITPROPS (INSPECTABLEFIELDNAMES (OR (RECLOOK 'TEXTOBJ) (SYSRECLOOK1 'TEXTOBJ] - (UFIELDS (for X in (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ) by (CDDR X) collect X))) + (EPROPS (for X in (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ) by (CDDR X) collect X)) + (DPROPS (for X in (fetch (TEXTOBJ DOCPROPS) of TEXTOBJ) collect (CAR X] (CL:UNLESS (OR (EQ T INSPECTDONTSORTFIELDS) (MEMB 'TEXTOBJ INSPECTDONTSORTFIELDS)) - (SETQ UFIELDS (SORT UFIELDS))) - (APPEND TFIELDS (CONS '--USERPROPS--) - UFIELDS]) + (SETQ EPROPS (SORT EPROPS)) + (SETQ DPROPS (SORT DPROPS))) + (APPEND TFIELDS (CONS '--EDITPROPS--) + EPROPS + (CONS '--DOCPROPS--) + DPROPS]) (\TEDIT.TEXTOBJ.PROPFETCHFN [LAMBDA (TEXTOBJ PROPNAME) (* ; "Edited 4-Jul-2024 11:53 by rmk") @@ -3113,15 +3138,6 @@ (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) @@ -3135,34 +3151,34 @@ (ADDTOVAR LAMA TEXTPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (36887 67703 (\TEDIT.TEXTBIN 36897 . 47647) (\TEDIT.TEXTPEEKBIN 47649 . 53199) ( -\TEDIT.TEXTBACKFILEPTR 53201 . 58874) (\TEDIT.TEXTBOUT 58876 . 63493) (\TEDIT.INSTALL.FILEBUFFER 63495 - . 67701)) (68601 72892 (\TEDIT.TEXTOUTCHARFN 68611 . 70167) (\TEDIT.TEXTINCCODEFN 70169 . 70908) ( -\TEDIT.TEXTBACKCCODEFN 70910 . 71502) (\TEDIT.TEXTFORMATBYTESTREAM 71504 . 72341) ( -\TEDIT.TEXTFORMATBYTESTRING 72343 . 72890)) (72939 84503 (OPENTEXTSTREAM 72949 . 79824) ( -COPYTEXTSTREAM 79826 . 83726) (TEDIT.STREAMCHANGEDP 83728 . 84030) (TXTFILE 84032 . 84501)) (84504 -115746 (\TEDIT.REOPENTEXTSTREAM 84514 . 85866) (\TEDIT.OPENTEXTSTREAM.PIECES 85868 . 90796) ( -\TEDIT.OPENTEXTSTREAM.PROPS 90798 . 91900) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91902 . 97143) ( -\TEDIT.OPENTEXTSTREAM.WINDOW 97145 . 99936) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 99938 . 101877) ( -\TEDIT.OPENTEXTFILE 101879 . 104356) (\TEDIT.CREATE.TEXTSTREAM 104358 . 105505) (\TEDIT.REOPEN.STREAM -105507 . 107843) (\TEDIT.TEXTINIT 107845 . 115744)) (115784 116972 (\TEDIT.TTYBOUT 115794 . 116970)) ( -117090 137553 (\TEDIT.TEXTCLOSEF 117100 . 118424) (\TEDIT.TEXTDSPFONT 118426 . 119624) ( -\TEDIT.TEXTEOFP 119626 . 121381) (\TEDIT.TEXTGETEOFPTR 121383 . 121706) (\TEDIT.TEXTSETEOFPTR 121708 - . 122995) (\TEDIT.TEXTGETFILEPTR 122997 . 125832) (\TEDIT.TEXTSETFILEINFO 125834 . 126342) ( -\TEDIT.TEXTOPENF 126344 . 127275) (\TEDIT.TEXTSETEOF 127277 . 127893) (\TEDIT.TEXTSETFILEPTR 127895 . -130005) (\TEDIT.TEXTDSPXPOSITION 130007 . 131490) (\TEDIT.TEXTDSPYPOSITION 131492 . 132233) ( -\TEDIT.TEXTLEFTMARGIN 132235 . 132826) (\TEDIT.TEXTCOLOR 132828 . 133411) (\TEDIT.TEXTRIGHTMARGIN -133413 . 136702) (\TEDIT.TEXTDSPCHARWIDTH 136704 . 137008) (\TEDIT.TEXTDSPSTRINGWIDTH 137010 . 137316) - (\TEDIT.TEXTDSPLINEFEED 137318 . 137551)) (137591 150204 (\TEDIT.NTHCHARCODE 137601 . 139052) ( -\TEDIT.PIECE.NTHCHARCODE 139054 . 142964) (\TEDIT.RPLCHARCODE 142966 . 144424) ( -\TEDIT.PIECE.RPLCHARCODE 144426 . 149849) (\TEDIT.NTHCHARLOOKS 149851 . 150202)) (151251 172345 ( -\TEDIT.DELETE.SELPIECES 151261 . 154886) (\TEDIT.INSERTCH 154888 . 162927) (\TEDIT.INSERTCH.HISTORY -162929 . 166393) (\TEDIT.INSERTEOL 166395 . 168220) (\TEDIT.INSERTCH.INSERTION 168222 . 171059) ( -\TEDIT.INSERTCH.EXTEND 171061 . 172343)) (172346 173850 (\TEDIT.NEXTCHANGEABLE.CHNO 172356 . 173071) ( -\TEDIT.LASTCHANGEABLE.CHNO 173073 . 173848)) (173851 175555 (\SETUPGETCH 173861 . 175553)) (175613 -180071 (\TEDIT.INSTALL.PIECE 175623 . 180069)) (180109 189210 (TEXTPROP 180119 . 180466) (GETTEXTPROP -180468 . 180712) (PUTTEXTPROP 180714 . 180971) (GETTEXTPROPS 180973 . 181417) (PUTTEXTPROPS 181419 . -182323) (TEXTPROP.ADD 182325 . 182588) (\TEDIT.TEXTPROP 182590 . 189208)) (189211 191281 ( -\TEDIT.TEXTOBJ.PROPNAMES 189221 . 190173) (\TEDIT.TEXTOBJ.PROPFETCHFN 190175 . 190691) ( -\TEDIT.TEXTOBJ.PROPSTOREFN 190693 . 191279))))) + (FILEMAP (NIL (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))))) STOP diff --git a/library/tedit/TEDIT-STREAM.LCOM b/library/tedit/TEDIT-STREAM.LCOM index 42aceda279969fc78591998a55c8ffb9b7076e0f..d9bbf2466f92f6fec195decaf3f11479bf8f9437 100644 GIT binary patch delta 3274 zcmaJ@U2GKB72cTzLkzfUGhWO>oU2U$+c5V0?au7dCOh7pWykE!46|de4K6O&G;7CT zLTpHZYLoOOB5Kp-3Zb-86+)`ELWzu*t!R{VRrMvNm5^E~Qktr&`p_SxQVb7$=|g+& zo!zz7MqRDup1Jp)bI(2Bcg~r=-DZFL9{b%=ACmaYnQ2}Uq!<#_WK2jZu_)?`PA{B2 zKRbVB1}&UJQFNt*Q_NFhLKgZ_dsG&9YvE!;M@R~4Qi?~>=?iCCN@rd?f8m9FNrc~h zr56t!+&ndV4)n64`8?XFJUBQQMKh-s;g~NlD#xPz?R{A@Z=_vA_lyiU@`c{|-nD~w zNK7b#pyIO(J$j5N_oJla8e^tCTI4fe21UgLZ%;2a{EsDt1pK3@{Yt4|Wb($uH@`eT zd-}qu3*UGe&NMy$$rn9vqA++kA*uKu%zoxycqe;$XT+R)csrF_-8#1|0Kf59QzpK~ z_A>XXKV{D`T?(3{HU_<%k#~@yX?SYe9#)aDc>Zx#mB`yuvZSI>FRKj>n^xM+7)a7o zbj0vHW88CG+d)!XgpGSyQ6&TZu{Cf`nft%b7rVWqK!SP%q%W-6k=|DzF#K*dKg=0;eiU5;oq>Uny z5)v$Rs}lIy0CB@&Tp|dSOe}4b_}Zokl~khgoBc#;cM{-3#Z&1dORcv z0wSP71d*u45Jm?%oC<%!sMW}>lZ+yY$TCV!8aYT55FHa_rm5o~jl4FHcaVxQ4!+eB zXOC~kpY{w@I#XNB)yd^2W|*lC#_nJrBOxkBA|DiLTk_?|$(Qr{KV*ZoKU-bxWW^6* zr?|}y{ffN5VTWF|Lv2J{?V-a|SG_#NO@-?wHMQKkKo)I|s@Lss+3upTuiM<})>`FD zc9(fS8JJtEn$ImC@hxyUJ5+v_sQJfDg=@dDx%+|OeB0VewPDYHy?YzX1gI-_-y-7j z_vem3NCxU7b8F=_u)Uh%Qe;SSNiqy`!(_;C88V#YDksV4aUL1Qxp6X#abqyt*TAWp z&%HEv;(->ZAEo9(p+KJ`w6IOv&ICmsiSbs}nifFoHKt=SGF;bokq8OXU_{n*i;eX} zyh6bzU^Ng*2xwAwfDjo8fl+b3}qoHNuu*5)5~G&(DpM>44acAvHYzLL>+Q4Y1wW8 zDgodFmoDfYifK&=>XDt#5Xel+8TBA%k)wM#OD`CpjDQe*-h^Y&@bu%}gL^6tiBa0N zplv{O_?&J*LveX1>>1NK0?~rX;K$hyQZ}z2A(J8+fEcC?BLiVC8g!!%$i`qI6SRE} znxNuG-2~(a1qcw8|1m=_`F{=pJkJ6;!PLykG>xcVOlxDQ89B99?MYF@-b+!ye(b-k z9PA7QzD98HBC`~x(MV@72sNStb6wQT+TCETi>ZZ%@9v;GQWR-`O9XEFS5T#97Ll4s zu0T-p`3fO#pagZ8h!8!95+o*6U4I1-P_-6(fCW(RRFiufgNdNnH(`SUN}(k1B@`6R z!Y2+ox3Gx5zOZy|CK*L>5%s0>N#Dc44RmfmSzX}YY1<*Gz z>hr-ky)3;e4a53_5*+TIfQ$t$5$uo#t;KcpW6$6pCGEWl$kXQ60tCafOivd?K}A{u zn&IJaBq5@4@XfzIZ`mGC0*5p;jw{!r)vp}>`{rIC9^~WIO+mkyI7LFxC$EzGYMO}O zx-L|o(Qj=J%g8D^I_YzSk?EZ7I(8A^KNaF9^i6>P>m%JM26H#`oR8f+@TjvTMIn-n6CjPU<~ZrP)fcS#KKATZtSqWb0?#jIcRxy{ zxu@$Pea5HF59_Jb;o-OMu)oK@Ufjpr#Sa&Ind>;T6k#sogG&R9jmMVuce4jlWo~ah zow|PrDtmct?TtGuhrhSPGk?MLr6J~L`17Tou*`P+=0&0H)AZYS0w3cC7xyslV^+GvfcdSlEeqnc5++^Ki(z|!Utu?4Mc@ug9lnYhS@V74A>(QW^Lx8guQsV;3 z+qOeQMXVNI{3|mQgC5bLd*E-wr@2+?M2VhV`n*aa+ delta 2913 zcmZuzU2Gf25#~{rEYqiaxiA=m{diXcRZ4Jv{jQjp3JjPcW3fsNv)$mHffU* zEy^-&S&1FFN&g%qNSrN@0)1)SCP-_vu*J9t+#e$7ll+qY04~A%c4y{hzi(!CfB!T0KX18TpWH7*Lb<|XNC*p22ulfGP6)Ce0{+vLbBm>N zArF-W@Wb;rR=?=uqe1Za1^yueIS~~Tf^g&4y{ji}HLcmhwmM~NhGs(v?Zzf_9Ue9q z9v=2XezuB!ALS{+`-7gqn5L^rR!yNp@IN}f=f~Bwu1;S)R4$!bnq6A?a`ndR-8=Xw z@G|a1CST`3{=a~Nkg&4q3C*0yh0^F7U56jqiIfoKL?q@158bPq7fGM{Y3@Jdu=|ua zpv`@HE16kupWEre-_*-VZT>?K73-OwCflg6KKP5|{IQPCWd6R#HP=}CdF>DG1@4I$ zY(|k$bqho}OwMoXcZ(6Sw{@T;5*P7xz%R%!VUJ0}qne?ZX%z%Xh9jy?p|rB51wxE0 zZX0Ofd6`<1?XB6>2;^*pXdJ|7d`sk;q98TJu(&Bk5F$;F0;bhQq`ce=gqNCu@LOhlwD}!gkVv9UAt!)+2|N`b z>^*jtYB2?_ar4fD!m&FK=E?S+lRU<)+BDNFI}3E*>WP#N5h1+ESX$LpTeUP*QF9Q% ze0aa7+b8pnTo$A#E_-nmX`9rHv^hDEQ?m|v5gANNH71eAh`4EPWwr5CcG^lA2%-=t z9liZrnEb7GcMmnnVIIps`A4vUmqc=H*h}VmKjLCFb@vSSr8pSsq@{obF<_4HycpZ`XfAvALmtOLsE3k3D`>oO!mRuI->}xBDyf zVK}L7b`-~1{@0E5_PZV9+WiD(dQF+Xonn?V8NJBhcE0dz$KBr<_gyXJw#M2$#}9p5 zZEL){W~{r|$KQPirQ1K8`^pCiSN-T*qu3bN)|1{OjtOr9$5HPnj%jZi#~JSoj<(mv zamqV|;|cExj6%XFelUM+?yDb2uKF?RMDKJ3crm_-wPIS+j7Q+ZGHK+!I}uzpn>Di_ z#mMs(Jp7d#?#?>)R)zibMsu@QBeKoeEZBv7sfsJ7FP_6WKk(Q>0`|0}GAe_BeJp_V9x))0GSa{p&DlPB(gYOU z%&B9CX>{0SCe$GQJY?aUPu7eB-)`H*$1yW76;fe79m;Hium6v|*!x{4_ukHM6pCmb+C zhG~ard#a6${Ht|f%Es1lWm}7r_EwJW?+aHbFk*~+tn9A6rd)rFge~!z!)_NQBTKce zE-v$CD&wR?8Inwx&O3{LOs)0Jr9Q27r?fvgGaot%b=*u8*|t)&!A6k}Gshx@h*+yz z^?mL`+sL&`aju=bcWI1!pFFsf){DROi9=^pO$ zWYIfNSCaRKuqPB7jW_OapOC*Shq$|B=j8+3H^{-u@3>umCV#&iZu^OXh4dEbU+L$r zllY2%WKTW0ZjY|bD6DSYR@mO^NyTf|I~fIy?2B zg3=?1pldmsWuF*(QURhZKBku^{{Xz7|w6&EY4p#CtcB}vss4=EKj@= zolIHCZ(6{N#lvm$MaFX(KY(dM{(E(-J1jsbw0UObLLscxTJ?qF9jl5to`b+396X3O zw%oRLc2>7Ya*EwTdejs!N60b0I9MP-U^O z;Ajm~tI`F)f3dJs7=lxU)3X;Z6kw%t5ig$Q6_{V1U8q8}f`tcFs%jdFIs}DF=%RFn z>6I(9c~*lVC#B)s#d5W@SS~=dbPnq{Fna+FhR+TU(K~4#P0N)bkZe#J*VekHwwl0jR)r#AFzm!~yrrH&saH{yGVs)YNnHa4$# M8|4@D7@F?+A4U)iSO5S3 diff --git a/library/tedit/TEDIT-TFBRAVO b/library/tedit/TEDIT-TFBRAVO index 68f72383..18a1521c 100644 --- a/library/tedit/TEDIT-TFBRAVO +++ b/library/tedit/TEDIT-TFBRAVO @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Sep-2025 11:11:43"  -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;187 97463 +(FILECREATED "21-Jan-2026 12:15:57" {WMEDLEY}TEDIT>TEDIT-TFBRAVO.;190 98203 :EDIT-BY rmk - :CHANGES-TO (FNS TEDITFROMBRAVO \TFBRAVO.FONT.FROM.CHARLOOKS) + :CHANGES-TO (FNS BRAVOFILEP) + (VARS TEDIT-TFBRAVOCOMS) - :PREVIOUS-DATE "28-Jul-2025 23:34:14" {WMEDLEY}TEDIT>TEDIT-TFBRAVO.;185) + :PREVIOUS-DATE " 7-Sep-2025 11:11:43" {WMEDLEY}TEDIT>TEDIT-TFBRAVO.;187) (PRETTYCOMPRINT TEDIT-TFBRAVOCOMS) @@ -20,10 +20,12 @@ (CONSTANTS (BRAVO.TRAILER.CHARS '(l d z x e y k j c q %( %) %, s S u U b B i I g G v V w W t f o % \ 0 1 2 3 4 5 6 7 8 9] - (* ;; "Interface to TEDIT") + (* ;; "Interface to TEDIT and CONVERT.TO.IMAGE.FILE") - (FNS TEDIT.BRAVOFILE? TEDITFROMBRAVO) - (ADDVARS (TEDIT.INPUT.FORMATS (TEDIT.BRAVOFILE? TEDITFROMBRAVO))) + (FNS BRAVOFILEP TEDITFROMBRAVO) + (ADDVARS (TEDIT.INPUT.FORMATS (BRAVOFILEP TEDITFROMBRAVO))) + (ALISTS (PRINTFILETYPES BRAVO)) + [P (DEFAULT.IMAGETYPE.CONVERSIONS '(BRAVO TEDIT.TO.IMAGEFILE] (* ;; "Initial looks, USER.CM") @@ -154,36 +156,44 @@ -(* ;; "Interface to TEDIT") +(* ;; "Interface to TEDIT and CONVERT.TO.IMAGE.FILE") (DEFINEQ -(TEDIT.BRAVOFILE? - [LAMBDA (STREAM TEXTOBJ) (* ; "Edited 28-Nov-2023 10:34 by rmk") +(BRAVOFILEP + [LAMBDA (FILE TEXTOBJ) (* ; "Edited 21-Jan-2026 12:15 by rmk") + (* ; "Edited 28-Nov-2023 10:34 by rmk") (* ; "Edited 17-Aug-2023 08:09 by rmk") (* ; "Edited 11-Aug-2023 22:59 by rmk") (* ; "Edited 5-Aug-2023 23:05 by rmk") (* ; "Edited 1-Aug-2023 08:15 by rmk") (* gbn " 3-Jun-85 21:06") - (* ;; "T if the open STREAM looks like a Bravo file.") + (* ;; "T if FILE looks like a Bravo file.") - (PROG (PLOOKS ENDCONDITION (ORIGINAL.FILE.POSITION (GETFILEPTR STREAM)) - NAME DIRS USER.CM) (* ; + (RESETLST + (PROG* ((STREAM (\GETSTREAM FILE 'INPUT T)) + (ORIGINAL.FILE.POSITION (CL:IF STREAM + (GETFILEPTR STREAM) + 0)) + PLOOKS ENDCONDITION NAME DIRS USER.CM) (* ;  "first look for a ^z, (beginning of a Bravo trailer)") - (CL:UNLESS (\TFBRAVO.FIND.LAST.TRAILER STREAM) - (SETFILEPTR STREAM ORIGINAL.FILE.POSITION) - (RETURN NIL)) (* ; "BIN past the ^z") - (BIN STREAM) - (SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS STREAM)) (* ; + (CL:UNLESS STREAM + [RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE]) + (CL:UNLESS (\TFBRAVO.FIND.LAST.TRAILER STREAM) + (SETFILEPTR STREAM ORIGINAL.FILE.POSITION) + (RETURN NIL)) (* ; "BIN past the ^z") + (BIN STREAM) + (SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS STREAM)) (* ;  "if the next symbol is a slash then check if the character looks are valid") - [SETQ ENDCONDITION (CL:WHEN (EQ (CAR PLOOKS) - '\) - (repeatuntil (\TEST.CHARACTER.LOOKS STREAM)))] - (SETFILEPTR STREAM ORIGINAL.FILE.POSITION) - (CL:WHEN (EQ ENDCONDITION 'BADLOOKS) - (RETURN NIL)) - (RETURN T]) + [SETQ ENDCONDITION (CL:WHEN (EQ (CAR PLOOKS) + '\) + (repeatuntil (\TEST.CHARACTER.LOOKS STREAM)))] + (SETFILEPTR STREAM ORIGINAL.FILE.POSITION) + (CL:WHEN (EQ ENDCONDITION 'BADLOOKS) + (RETURN NIL)) + (RETURN T)))]) (TEDITFROMBRAVO [LAMBDA (BFILE TSTREAM PROPS USER.CM) (* ; "Edited 7-Sep-2025 11:09 by rmk") @@ -254,7 +264,12 @@ (RETURN TSTREAM)))]) ) -(ADDTOVAR TEDIT.INPUT.FORMATS (TEDIT.BRAVOFILE? TEDITFROMBRAVO)) +(ADDTOVAR TEDIT.INPUT.FORMATS (BRAVOFILEP TEDITFROMBRAVO)) + +(ADDTOVAR PRINTFILETYPES (BRAVO (TEST BRAVOFILEP) + (EXTENSION (BRAVO)))) + +(DEFAULT.IMAGETYPE.CONVERSIONS '(BRAVO TEDIT.TO.IMAGEFILE)) @@ -1556,18 +1571,18 @@ (AND NIL (\TEDIT.NAMEDTAB.INIT)) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7665 14759 (TEDIT.BRAVOFILE? 7675 . 9405) (TEDITFROMBRAVO 9407 . 14757)) (14870 31286 ( -\TFBRAVO.GET.USER.CM 14880 . 18060) (\TFBRAVO.USER.CM.LOOKS 18062 . 19555) (\TFBRAVO.READ.USER.CM -19557 . 24180) (\TFBRAVO.INIT.PARALOOKS 24182 . 26399) (\TFBRAVO.INIT.PAGEFORMAT 26401 . 27281) ( -\TFBRAVO.GETPARAMS 27283 . 30137) (\TFBRAVO.FIND.LAST.TRAILER 30139 . 31284)) (31328 52033 ( -\TFBRAVO.PARSE.PARA 31338 . 35265) (\TFBRAVO.READ.PARALOOKS 35267 . 42157) (\TFBRAVO.CREATE.RUNS 42159 - . 43547) (\TFBRAVO.READ.CHARLOOKS 43549 . 48578) (\TFBRAVO.FONT.FROM.CHARLOOKS 48580 . 50134) ( -\TFBRAVO.READNUM? 50136 . 52031)) (52070 63111 (\TFBRAVO.HANDLE.HEADING 52080 . 54807) ( -\TFBRAVO.PARSE.PROFILE.PARA 54809 . 63109)) (63154 85488 (\TFBRAVO.INSERT.PARA 63164 . 64005) ( -\TFBRAVO.INSERT.RUN 64007 . 67498) (\TFBRAVO.SPLIT.PARA 67500 . 74924) (\TFBRAVO.RUN.TABSPEC 74926 . -79793) (\TFBRAVO.INSTALL.PAGEFORMAT 79795 . 85486)) (85489 89632 (\TFBRAVO.ASSERT 85499 . 86029) ( -\TEST.CHARACTER.LOOKS 86031 . 87917) (\TEST.PARAGRAPH.LOOKS 87919 . 89630)) (90642 97297 ( -\TFBRAVO.ADD.NAMEDTAB 90652 . 94255) (\TFBRAVO.COPY.NAMEDTAB 94257 . 94705) (\TFBRAVO.PUT.NAMEDTAB -94707 . 94987) (\TFBRAVO.GET.NAMEDTAB 94989 . 95366) (\NAMEDTABNYET 95368 . 95528) (\NAMEDTABSIZE -95530 . 96045) (\NAMEDTABPREPRINT 96047 . 96245) (\TEDIT.NAMEDTAB.INIT 96247 . 97295))))) + (FILEMAP (NIL (7784 15335 (BRAVOFILEP 7794 . 9981) (TEDITFROMBRAVO 9983 . 15333)) (15610 32026 ( +\TFBRAVO.GET.USER.CM 15620 . 18800) (\TFBRAVO.USER.CM.LOOKS 18802 . 20295) (\TFBRAVO.READ.USER.CM +20297 . 24920) (\TFBRAVO.INIT.PARALOOKS 24922 . 27139) (\TFBRAVO.INIT.PAGEFORMAT 27141 . 28021) ( +\TFBRAVO.GETPARAMS 28023 . 30877) (\TFBRAVO.FIND.LAST.TRAILER 30879 . 32024)) (32068 52773 ( +\TFBRAVO.PARSE.PARA 32078 . 36005) (\TFBRAVO.READ.PARALOOKS 36007 . 42897) (\TFBRAVO.CREATE.RUNS 42899 + . 44287) (\TFBRAVO.READ.CHARLOOKS 44289 . 49318) (\TFBRAVO.FONT.FROM.CHARLOOKS 49320 . 50874) ( +\TFBRAVO.READNUM? 50876 . 52771)) (52810 63851 (\TFBRAVO.HANDLE.HEADING 52820 . 55547) ( +\TFBRAVO.PARSE.PROFILE.PARA 55549 . 63849)) (63894 86228 (\TFBRAVO.INSERT.PARA 63904 . 64745) ( +\TFBRAVO.INSERT.RUN 64747 . 68238) (\TFBRAVO.SPLIT.PARA 68240 . 75664) (\TFBRAVO.RUN.TABSPEC 75666 . +80533) (\TFBRAVO.INSTALL.PAGEFORMAT 80535 . 86226)) (86229 90372 (\TFBRAVO.ASSERT 86239 . 86769) ( +\TEST.CHARACTER.LOOKS 86771 . 88657) (\TEST.PARAGRAPH.LOOKS 88659 . 90370)) (91382 98037 ( +\TFBRAVO.ADD.NAMEDTAB 91392 . 94995) (\TFBRAVO.COPY.NAMEDTAB 94997 . 95445) (\TFBRAVO.PUT.NAMEDTAB +95447 . 95727) (\TFBRAVO.GET.NAMEDTAB 95729 . 96106) (\NAMEDTABNYET 96108 . 96268) (\NAMEDTABSIZE +96270 . 96785) (\NAMEDTABPREPRINT 96787 . 96985) (\TEDIT.NAMEDTAB.INIT 96987 . 98035))))) STOP diff --git a/library/tedit/TEDIT-TFBRAVO.LCOM b/library/tedit/TEDIT-TFBRAVO.LCOM index 70a477eb30e20d8ef351df0aef401c50df5c8477..8bf7c2d0b06f3ab7c84bb7be867da6c005cc5bc4 100644 GIT binary patch delta 1214 zcma)5%}*0S6mN@xxF~@rAgK7<1ltWs~-FdID2xY3sOH~+-!Dd-ut~bzxUp6K7I*4`4)UOdo8L* zCd-?Vs1{9v9yRoYkx0p)$jkMOt=f9E0`*Ohfu%yqUPcRpBdDz}q1Id`kn@$dq2*sde9n!)o49bk@5%y{6+%Oofhh}VC zA`y$9#Y;{_NOeo}B>}o_@HZY~@zChmR9HGGjD2pqKAVIRL7qBM1Q!xu*&gAGI5=hz z@kI=fV@+U(ld`eH4N-6l7*7e14%oAEwqq7lQK#x+a*Wb|Jw0`GF9pH@Sx5u14P(SZ z1ko(^iew}Vfd?I-KybEeCBUCrr}*{+1Nr^<-Ja?8{Qgi~SdQG1SkJ8v4$gKDE_WZ~ zPmBGFyxp{~b~m>#-{;}Tvk+`1jUT@5^r5f5uf9D(A51lUhm8-l?tr4}ItWf;&eQ{4 z(-^GuhthF&yRCmH6@%P~Gns6KCejR7FXkW~1?(b+P(J1&7a=V25P!!7pzCQEH!Z(q z866fOmIB*xOB9m+pMxN#u}8g^TPM@#HM(@5XpZ9XNw9%8)I2>946!qPw_0)KzM;mu zwtII}C~sDP4{8Q^RHaz8i)Icr=OS~Z{3;!gm|GdVLWR`SCK*)>#iRt37Ii$UoZmAG zHW6mmvz=y_=)8*v_!PoCvkQuavSz8kGl?UGU-fwqt{5IVUBXWnU{1_ONe&J-;x}xKUkb-#g*y=gfMz z*tCUtLru$~nBNZgjrI`w@ODj+M!(G4EW+O%k z{0GCv@Icx3n*M%xLR`59Bn1-ddIOeE@@YtAWg#i^((${i2(hH8RV!`k|k*NKjZDrz%MaIMymrG?d4H8F+s zyU5BH!Gt8Z2xn4eAZ9MaVsmTfV)$ITb2b96);7p7(TT4?#N2BV?J;xm=6poF{?XZ< zRu!X{(I-D1qa`e@qp@`xIUr`Cj&v7sVP`(h2>kSBtB$(vsP+aIndJG|rj!^G?dyO? zUjMCx7b!`QSGA}?OhSG1^UUM>OB4gNQE~BXc=p-c!k1oRbsDExv8#wPET^m@7wA7~ sPcM$aTcdA5E(c+~wM>xVVJjcLZ7pK-<>J!lduw}P`5zLaZ{5WFFTs=Kvj6}9 diff --git a/library/tedit/TEDIT-WINDOW b/library/tedit/TEDIT-WINDOW index 00ea577e..58ee6114 100644 --- a/library/tedit/TEDIT-WINDOW +++ b/library/tedit/TEDIT-WINDOW @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "15-Nov-2025 01:27:38" {WMEDLEY}TEDIT>TEDIT-WINDOW.;881 231034 +(FILECREATED "24-Dec-2025 11:22:33" {WMEDLEY}TEDIT>TEDIT-WINDOW.;883 231422 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.WINDOW.CREATE) + :CHANGES-TO (FNS \TEDIT.MINIMAL.WINDOW.SETUP TEDIT.PROMPTCLEAR TEDIT.PROMPTPRINT) - :PREVIOUS-DATE "25-Oct-2025 10:33:08" {WMEDLEY}TEDIT>TEDIT-WINDOW.;878) + :PREVIOUS-DATE "15-Nov-2025 01:27:38" {WMEDLEY}tedit>TEDIT-WINDOW.;881) (PRETTYCOMPRINT TEDIT-WINDOWCOMS) @@ -608,7 +608,9 @@ (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE]) (\TEDIT.MINIMAL.WINDOW.SETUP - [LAMBDA (PANEWINDOW TSTREAM PROPS) (* ; "Edited 19-Oct-2025 14:55 by rmk") + [LAMBDA (PANEWINDOW TSTREAM PROPS) (* ; "Edited 23-Dec-2025 23:41 by rmk") + (* ; "Edited 20-Dec-2025 23:04 by rmk") + (* ; "Edited 19-Oct-2025 14:55 by rmk") (* ; "Edited 20-Apr-2025 15:19 by rmk") (* ; "Edited 30-Nov-2024 13:32 by rmk") (* ; "Edited 4-Nov-2024 19:46 by rmk") @@ -687,8 +689,7 @@ (WINDOWPROP PANEWINDOW 'CURSOROUTFN (FUNCTION \TEDIT.CURSOROUTFN)) (WINDOWPROP PANEWINDOW 'BUTTONEVENTFN (FUNCTION \TEDIT.BUTTONEVENTFN)) (WINDOWPROP PANEWINDOW 'RIGHTBUTTONFN (FUNCTION \TEDIT.BUTTONEVENTFN)) - (WINDOWPROP PANEWINDOW 'HARDCOPYFN (FUNCTION TEDIT.HARDCOPYFN)) - (WINDOWPROP PANEWINDOW 'HARDCOPYFILEFN (FUNCTION \TEDIT.HARDCOPYFILEFN)) + (WINDOWPROP PANEWINDOW 'IMAGETYPE 'TEDIT) (* ; "For hardcopy") (WINDOWPROP PANEWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN)) (WINDOWPROP PANEWINDOW 'REPAINTFN (FUNCTION \TEDIT.REPAINTFN)) (WINDOWPROP PANEWINDOW 'AFTERMOVEFN (FUNCTION \TEDIT.AFTERMOVEFN)) @@ -2059,7 +2060,8 @@ PROMPTWINDOW]) (TEDIT.PROMPTPRINT - [LAMBDA (TEXTSTREAM MSG CLEAR? FLASH?) (* ; "Edited 29-Dec-2024 14:45 by rmk") + [LAMBDA (TSTREAM MSG CLEAR? FLASH?) (* ; "Edited 14-Dec-2025 17:41 by rmk") + (* ; "Edited 29-Dec-2024 14:45 by rmk") (* ; "Edited 26-Nov-2023 10:10 by rmk") (* ; "Edited 10-Sep-2023 00:27 by rmk") (* ; "Edited 30-Jul-2023 08:52 by rmk") @@ -2070,7 +2072,7 @@ (* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow). Optionally clear the window first.") - (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM T)) + (LET ((TEXTOBJ (TEXTOBJ TSTREAM T)) PWINDOW MAINWINDOW) (if TEXTOBJ then (CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ)) @@ -2078,7 +2080,7 @@ (CAR (NLSETQ (SELECTQ PWINDOW (DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND) (GETPROMPTWINDOW MAINWINDOW))) - (NIL (CL:WHEN TEXTSTREAM + (NIL (CL:WHEN TSTREAM [GETPROMPTWINDOW MAINWINDOW NIL NIL (NOT (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND])) PWINDOW]) (* ; @@ -2097,15 +2099,15 @@ else (PROMPTPRINT MSG]) (TEDIT.PROMPTCLEAR - [LAMBDA (TSTREAM FONT) (* ; "Edited 18-Sep-2025 23:08 by rmk") + [LAMBDA (TSTREAM FONT) (* ; "Edited 14-Dec-2025 17:34 by rmk") + (* ; "Edited 18-Sep-2025 23:08 by rmk") (* ; "Edited 14-Mar-98 12:52 by rmk:") (* ; "Edited 14-Oct-87 15:35 by bvm:") (* ;; "Clears the promptwindow attached to TSTREAM and shrinks it back to a single line in font FONT (or TEDIT.PROMPT.FONT) if it has grown. [TSTREAM could actually be a stream on the promptwindow itself.--is that true, does this code need to deal with that?]") (LET* [(MW (\TEDIT.MAINW TSTREAM)) - (PW (AND MW (WINDOWPROP (\TEDIT.MAINW TSTREAM) - 'TEDIT.PROMPTWINDOW] + (PW (AND MW (GETPROMPTWINDOW MW NIL NIL (NOT (GETTEXTPROP TSTREAM 'PWINDOW.ON.DEMAND] (CL:WHEN PW (WINDOWPROP PW 'TEDIT.NLINES 1) (CL:WHEN [AND (SETQ MW (WINDOWPROP PW 'MAINWINDOW)) @@ -3662,36 +3664,36 @@ (RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 45089 (\TEDIT.WINDOW.CREATE -18007 . 24870) (\TEDIT.WINDOW.GETREGION 24872 . 29576) (\TEDIT.WINDOW.SETUP 29578 . 33908) ( -\TEDIT.MINIMAL.WINDOW.SETUP 33910 . 41721) (\TEDIT.CLEARPANE 41723 . 42440) (\TEDIT.FILL.PANES 42442 - . 45087)) (45090 68791 (\TEDIT.CURSORMOVEDFN 45100 . 50710) (\TEDIT.CURSOROUTFN 50712 . 51400) ( -\TEDIT.ACTIVE.WINDOWP 51402 . 52472) (\TEDIT.EXPANDFN 52474 . 53037) (\TEDIT.MAINW 53039 . 54319) ( -\TEDIT.MAINSTREAM 54321 . 54655) (\TEDIT.PRIMARYPANE 54657 . 55427) (\TEDIT.PANELIST 55429 . 55925) ( -\TEDIT.NEWREGIONFN 55927 . 58443) (\TEDIT.SET.WINDOW.EXTENT 58445 . 63427) (\TEDIT.SHRINK.ICONCREATE -63429 . 66162) (\TEDIT.SHRINKFN 66164 . 66573) (\TEDIT.PANEREGION 66575 . 68789)) (68823 101869 ( -\TEDIT.BUTTONEVENTFN 68833 . 81806) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81808 . 89071) ( -\TEDIT.BUTTONEVENTFN.GETOPERATION 89073 . 90915) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90917 . 94587) ( -\TEDIT.BUTTONEVENTFN.INACTIVE 94589 . 97019) (\TEDIT.BUTTONEVENTFN.INTITLE 97021 . 98856) ( -\TEDIT.COPYINSERTFN 98858 . 99990) (\TEDIT.FOREIGN.COPY 99992 . 101867)) (101870 119433 ( -\TEDIT.PANE.SPLIT 101880 . 105828) (\TEDIT.SPLITW 105830 . 113889) (\TEDIT.UNSPLITW 113891 . 118090) ( -\TEDIT.LINKPANES 118092 . 118855) (\TEDIT.UNLINKPANE 118857 . 119431)) (120867 121758 (TEDITWINDOWP -120877 . 121756)) (121795 124898 (TEDIT.GETINPUT 121805 . 124248) (\TEDIT.MAKEFILENAME 124250 . 124896 -)) (124947 132597 (TEDIT.PROMPTWINDOW 124957 . 125271) (TEDIT.PROMPTPRINT 125273 . 127900) ( -TEDIT.PROMPTCLEAR 127902 . 129644) (TEDIT.PROMPTFLASH 129646 . 130904) (\TEDIT.PROMPT.PAGEFULLFN -130906 . 132595)) (132835 143413 (\TEDIT.FILENAME 132845 . 133617) (\TEDIT.DEFAULT.TITLE 133619 . -135998) (\TEDIT.WINDOW.TITLE 136000 . 138169) (\TEDIT.LIKELY.FILENAME 138171 . 140895) ( -\TEDIT.UPDATE.TITLE 140897 . 143411)) (143456 155940 (TEDIT.DEACTIVATE.WINDOW 143466 . 149039) ( -\TEDIT.RESHAPEFN 149041 . 151126) (\TEDIT.REPAINTFN 151128 . 151352) (\TEDIT.CLOSESPLITS 151354 . -153799) (\TEDIT.CLOSEPANE 153801 . 155938)) (155941 198740 (\TEDIT.SCROLLFN 155951 . 158182) ( -\TEDIT.SCROLLCH.TOP 158184 . 160295) (\TEDIT.SCROLLCH.BOTTOM 160297 . 164627) (\TEDIT.SCROLLUP 164629 - . 170355) (\TEDIT.TOPLINE.YTOP 170357 . 172026) (\TEDIT.SCROLLDOWN 172028 . 179067) ( -\TEDIT.SCROLL.CARET 179069 . 181907) (\TEDIT.VISIBLECARETP 181909 . 184203) (\TEDIT.VISIBLECHARP -184205 . 185296) (\TEDIT.BITMAPLINES 185298 . 189218) (\TEDIT.SETPANE.TOPLINE 189220 . 189832) ( -\TEDIT.SHIFTLINES 189834 . 198738)) (198741 209610 (\TEDIT.ONSCREEN? 198751 . 203302) ( -\TEDIT.ONSCREEN.REGION 203304 . 206955) (\TEDIT.AFTERMOVEFN 206957 . 207854) (OFFSCREENP 207856 . -209608)) (209652 212466 (\TEDIT.PROCIDLEFN 209662 . 211322) (\TEDIT.PROCENTRYFN 211324 . 211769) ( -\TEDIT.PROCEXITFN 211771 . 212464)) (212545 225770 (\TEDIT.DOWNCARET 212555 . 213348) ( -\TEDIT.FLASHCARET 213350 . 215461) (\TEDIT.UPCARET 215463 . 216567) (TEDIT.NORMALIZECARET 216569 . -219787) (\TEDIT.SETCARET 219789 . 225140) (\TEDIT.CARET 225142 . 225768))))) + (FILEMAP (NIL (17143 18039 (TEDIT.DEFER.UPDATES 17153 . 18037)) (18040 45281 (\TEDIT.WINDOW.CREATE +18050 . 24913) (\TEDIT.WINDOW.GETREGION 24915 . 29619) (\TEDIT.WINDOW.SETUP 29621 . 33951) ( +\TEDIT.MINIMAL.WINDOW.SETUP 33953 . 41913) (\TEDIT.CLEARPANE 41915 . 42632) (\TEDIT.FILL.PANES 42634 + . 45279)) (45282 68983 (\TEDIT.CURSORMOVEDFN 45292 . 50902) (\TEDIT.CURSOROUTFN 50904 . 51592) ( +\TEDIT.ACTIVE.WINDOWP 51594 . 52664) (\TEDIT.EXPANDFN 52666 . 53229) (\TEDIT.MAINW 53231 . 54511) ( +\TEDIT.MAINSTREAM 54513 . 54847) (\TEDIT.PRIMARYPANE 54849 . 55619) (\TEDIT.PANELIST 55621 . 56117) ( +\TEDIT.NEWREGIONFN 56119 . 58635) (\TEDIT.SET.WINDOW.EXTENT 58637 . 63619) (\TEDIT.SHRINK.ICONCREATE +63621 . 66354) (\TEDIT.SHRINKFN 66356 . 66765) (\TEDIT.PANEREGION 66767 . 68981)) (69015 102061 ( +\TEDIT.BUTTONEVENTFN 69025 . 81998) (\TEDIT.BUTTONEVENTFN.DOOPERATION 82000 . 89263) ( +\TEDIT.BUTTONEVENTFN.GETOPERATION 89265 . 91107) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 91109 . 94779) ( +\TEDIT.BUTTONEVENTFN.INACTIVE 94781 . 97211) (\TEDIT.BUTTONEVENTFN.INTITLE 97213 . 99048) ( +\TEDIT.COPYINSERTFN 99050 . 100182) (\TEDIT.FOREIGN.COPY 100184 . 102059)) (102062 119625 ( +\TEDIT.PANE.SPLIT 102072 . 106020) (\TEDIT.SPLITW 106022 . 114081) (\TEDIT.UNSPLITW 114083 . 118282) ( +\TEDIT.LINKPANES 118284 . 119047) (\TEDIT.UNLINKPANE 119049 . 119623)) (121059 121950 (TEDITWINDOWP +121069 . 121948)) (121987 125090 (TEDIT.GETINPUT 121997 . 124440) (\TEDIT.MAKEFILENAME 124442 . 125088 +)) (125139 132985 (TEDIT.PROMPTWINDOW 125149 . 125463) (TEDIT.PROMPTPRINT 125465 . 128195) ( +TEDIT.PROMPTCLEAR 128197 . 130032) (TEDIT.PROMPTFLASH 130034 . 131292) (\TEDIT.PROMPT.PAGEFULLFN +131294 . 132983)) (133223 143801 (\TEDIT.FILENAME 133233 . 134005) (\TEDIT.DEFAULT.TITLE 134007 . +136386) (\TEDIT.WINDOW.TITLE 136388 . 138557) (\TEDIT.LIKELY.FILENAME 138559 . 141283) ( +\TEDIT.UPDATE.TITLE 141285 . 143799)) (143844 156328 (TEDIT.DEACTIVATE.WINDOW 143854 . 149427) ( +\TEDIT.RESHAPEFN 149429 . 151514) (\TEDIT.REPAINTFN 151516 . 151740) (\TEDIT.CLOSESPLITS 151742 . +154187) (\TEDIT.CLOSEPANE 154189 . 156326)) (156329 199128 (\TEDIT.SCROLLFN 156339 . 158570) ( +\TEDIT.SCROLLCH.TOP 158572 . 160683) (\TEDIT.SCROLLCH.BOTTOM 160685 . 165015) (\TEDIT.SCROLLUP 165017 + . 170743) (\TEDIT.TOPLINE.YTOP 170745 . 172414) (\TEDIT.SCROLLDOWN 172416 . 179455) ( +\TEDIT.SCROLL.CARET 179457 . 182295) (\TEDIT.VISIBLECARETP 182297 . 184591) (\TEDIT.VISIBLECHARP +184593 . 185684) (\TEDIT.BITMAPLINES 185686 . 189606) (\TEDIT.SETPANE.TOPLINE 189608 . 190220) ( +\TEDIT.SHIFTLINES 190222 . 199126)) (199129 209998 (\TEDIT.ONSCREEN? 199139 . 203690) ( +\TEDIT.ONSCREEN.REGION 203692 . 207343) (\TEDIT.AFTERMOVEFN 207345 . 208242) (OFFSCREENP 208244 . +209996)) (210040 212854 (\TEDIT.PROCIDLEFN 210050 . 211710) (\TEDIT.PROCENTRYFN 211712 . 212157) ( +\TEDIT.PROCEXITFN 212159 . 212852)) (212933 226158 (\TEDIT.DOWNCARET 212943 . 213736) ( +\TEDIT.FLASHCARET 213738 . 215849) (\TEDIT.UPCARET 215851 . 216955) (TEDIT.NORMALIZECARET 216957 . +220175) (\TEDIT.SETCARET 220177 . 225528) (\TEDIT.CARET 225530 . 226156))))) STOP diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM index 4b6b6bdf22914d269b4975f40b6b5279127616a6..02c73d4d5efc1a6134303412bb4ec76666222377 100644 GIT binary patch delta 1309 zcmZux&u`O66mE(@yAcSLwm`}cJ+g;wR;t%C;~CpQ0!%zJEUC@5~2ty5CVj_ zaHzO)qA~|=fH-ggB*={eh{H;&UF{#hZEp)V{sVZn)8IzUA@cX;dvD(R-h1=%%Z_iK zcRcLRP-DTpd})E|lmj76N}G&rTx-@?1FCgGONVxoiKfmr-XBRH&(5A(y8-of&-0*6 z(lo6Os~7KFUai75-h|d0)%mvaWGj+RB3-C&d;h)PequlwF(^&%R({RyF9eKjS;4LG6GLPtEkW(^6T;!V^5b44i%1}JHpbz$1wp$VqlVHSJed1X*=Mm* z!ZDa8NzWagTNeUaUJ%Q+4<^UJg<`(!M{-dGes0!b3ug8vEs}A^33Fd&KnYQ{Ns-H; zw_yahO@D|8+#;KFY-UTjURF0Z#ZXr1C(%k~ z5hE3yb|Ry0kgmVmX>y^%5TDH*jgpF?gQJ=G8kveC#4!J7@ytA@7PNwJ1)DCToJY)} zUf_g+>N+@kE1?{`K3ek!e_wxI8Qi>KOxFL}IWaML>gNgkO;sj3t8e#TT|IRrgVpTs z>et=r$D6O#vCMp1`amoLf>8SX5Qu4FGqAa6?Nz8a6?*D;lbpX#2~Icr<*>y|oTSx9R)PODdPkMOeGGabxX} zXe<*HONH~U=d)_WoP^at?Bz<^PbWtaU>#|?AvSY!GX2p~2`XX4mc5`E&(|asirAbF zu5V<;Ag!Y770oI_VS95fPpx)2f8kVap?!I>nHSpB39&QvQ^yEe9TlSCOvV)M&je{$q7OY81N9RJWXPlgB~5h6_3Zwh-I08 zAbXI53m_k2PO)S}|Y)#)v2VW|2+%v=tX%DbeNUQ*_) z6|p5R;L1!0^kLK7r$sETJ7F4YYS4ppd!NEqLWkE>8r^^cfc2DcR^AoYBadHH3}nFp z(5N^!b9zhGop_1Q8jLq3hgbx%68o*%VOG+uB1>ELssYai28c;PL6y@)-J_xH7cS)t ze1A*%<lxm^SW+&3F>6DvQ;X)^QUSHG<`oND1^|(j#r? zcsx<}n?z}wLWPX(S5<>>Rn7*BlGJWMzd_G5mJ-*UsHS{sVH6cxFla)wqhQw|c?cgr zAWEzu@qJ<9&Ffj7XDjVjx8LT}dvV>&&wLvh8p+CP#&@Dxtt;K;lTvMgQJbK!ST0Es55V=o_KC&AuJ2rfG3^4(sal2 zrll5Y#GrB&#NLxB@p-qf)$LV7O51|2)+v<#6QmPpI4iMti2;&3-;m;}v!!>mkv(pN pNm*S7aw{^}DZ|udtW2B!C%{0R5bk@N#egv+LX3{JU)=xo_&;&vVM+i1 diff --git a/library/tedit/TEDIT.LCOM b/library/tedit/TEDIT.LCOM index bcfdf700b92e4552bfe92b97e4f9e8a4793a22cb..cfdf23b6563f2fe3063243018eba6e4a085dccca 100644 GIT binary patch delta 597 zcmbu4PfG$p7{*s4s3EAJ=u+^u5bPXWob_MM$;F+mq1D}XXU%SvN=c=r9y$mfs#}M` zd$&G;^g;SMotjl4gKo{`g?XRn_dd_pL;U?I{&KQmq!U)7mN1e=1`LCyGc=Wdy-p2t z7?3)@Bw3nCQbJU?=r(HY+fMVQQHRETr`y}3&}#RunypJ{wm`K*$ANjPuInn)&-+sU zCo`{Nq}kkIMW301S)dx5f5cK@^cmY-$^l7d2qB|ZY&%;q{Q#tei=tZ!Fi_8D74C*X z!jdEjn&S{cjT9xul(UeSSl<>b4}4mdU{;9UB6@sNr`HBkd@z65eV6*gi)D0cj{>r3dU|?F z3Mq*tKqD}%F|smHGgQ*#(s1+iadi%Ibp)EHfZ`aKOD7vJDsz}97@C+^7+Xw^W|VPv z^9#n~7)=GMfFRc}Pyf(hT^FFS3Q9&6y8g)}5dQ-`Z)9m@YNn*XHL+Ha(RlND#<}^M zFBH0SSvb15ggFKUD`*4+dHRKb+!YcT;0ok(f&HqW5#kyg0=3x9KgicH1Sk$vHrb&` WmPu1{^NgB#tUPEEax8wHK3o7H`DoGr diff --git a/library/tedit/tedit-exports.all b/library/tedit/tedit-exports.all index 7ad44b83..8f4f13bb 100644 --- a/library/tedit/tedit-exports.all +++ b/library/tedit/tedit-exports.all @@ -1,9 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Sep-2025 11:04:51"  -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;242 52344 +(FILECREATED "20-Oct-2025 11:20:51"  +{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;243 52506 - :EDIT-BY rmk) + :EDIT-BY rmk + + :PREVIOUS-DATE "20-Sep-2025 11:04:51" {WMEDLEY}TEDIT>tedit-exports.all;242) (PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION @@ -15,7 +17,7 @@ PRINT)))))))) (PUTPROPS FTEXTOBJ MACRO ((X) (TEXTOBJ! (CL:IF (type? TEXTOBJ X) X (GETTSTR X TEXTOBJ))))) (GLOBALVARS CHECK-TEDIT-ASSERTIONS) (RPAQ? CHECK-TEDIT-ASSERTIONS T) -(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 8-Sep-2025 22:10:20")) +(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "28-Sep-2025 11:35:06")) (RPAQQ \BTREEWORDSPERSLOT 4) (RPAQQ \BTREEMAXCOUNT 8) (CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8)) @@ -258,7 +260,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 " 7-Aug-2025 12:51:00")) +(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 00:07:29")) (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)." @@ -275,8 +277,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))))) -PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0) +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) (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 (* ; @@ -438,7 +440,7 @@ UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE F BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))) (GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV) -(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "20-Sep-2025 08:49:36")) +(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 15:09:09")) (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)) @@ -452,7 +454,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 " 9-Sep-2025 21:49:43")) +(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "25-Sep-2025 21:32:46")) (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 (* ; @@ -535,7 +537,7 @@ LINELEAD _ 0) (PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with NEWVALUE))) (PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS)))) -(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 9-Sep-2025 21:55:31")) +(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 6-Oct-2025 20:50:59")) (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 @@ -598,9 +600,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 "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-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-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 @@ -657,7 +659,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 "19-Sep-2025 22:09:03")) +(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "27-Sep-2025 16:25:26")) (PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE " 6-Sep-2025 00:10:45")) (PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE " 7-Sep-2025 11:11:43")) (DECLARE%: DONTCOPY diff --git a/lispusers/PRETTYFILEINDEX b/lispusers/PRETTYFILEINDEX index eb21bf0b..2ce14aa0 100644 --- a/lispusers/PRETTYFILEINDEX +++ b/lispusers/PRETTYFILEINDEX @@ -1,14 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Sep-2025 09:50:47"  -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;13 100936 +(FILECREATED "24-Dec-2025 11:15:32" {WMEDLEY}PRETTYFILEINDEX.;14 100927 :EDIT-BY rmk - :CHANGES-TO (VARS PRETTYFILEINDEXCOMS) + :CHANGES-TO (FNS PFI.MAKE.LPT.STREAM) - :PREVIOUS-DATE "10-May-2023 09:12:17" -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;12) + :PREVIOUS-DATE "21-Sep-2025 09:50:47" {WMEDLEY}PRETTYFILEINDEX.;13) (PRETTYCOMPRINT PRETTYFILEINDEXCOMS) @@ -381,12 +379,12 @@ PRINTOPTIONS))))])]) (PFI.MAKE.LPT.STREAM - [LAMBDA (PRINTOPTIONS) (* ; "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 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) (LISTGET PRINTOPTIONS 'HOST) - (CAR (LISTP DEFAULTPRINTINGHOST)) - DEFAULTPRINTINGHOST)) + (CAR (DEFAULTPRINTERS] [IMAGETYPE (COND [(AND PRINTER (CADDR (LISTP PRINTER] (T (CAR (MKLIST (PRINTERPROP (PRINTERTYPE PRINTER) @@ -394,13 +392,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)) @@ -411,19 +409,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 "")) @@ -1193,28 +1191,28 @@ 'NON.PFI.PRINT.BITMAP NIL T) ) (DECLARE%: DONTCOPY - (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))))) + (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))))) STOP diff --git a/lispusers/PRETTYFILEINDEX.LCOM b/lispusers/PRETTYFILEINDEX.LCOM index 51479acfac32330a228370c8fe47b102feaacb9c..c7afb9a159bca3c9de33c65879ead11b48fad568 100644 GIT binary patch delta 924 zcmZuw-D=c8813$jWd*S)Rz>76__JHdIx|T&KX_qGCT%dA37M>I!JFDHQnWu*FN9Kx zm)?l77rudbDHdNr-@-Q$9Cy3fUD#ZmeDi(hobP1v?RWjhullErhn5lbw+&9Y4aR(C z`z9x7lI?@N!`;{Y9USa~;CQ_&qEu|2Jo^0o)~VG(gD^fd==o;HrzXLRqkc8ne|LEF z=B|%CPTJkzsc5Hp*;ZvCf-ZJ7YurmyOw+X6ZGxSxw_0@`KjWm;XvWEdRD_zO6cGrY zYk$V>z6D09#~t`0N=oC&CXV)Aq2Y&XLAENCQA#x9OwIGzf}a=SSt5JNh_s>>WQOV= zj`E_OZ&TlL2pZFhx6gL!-qm!78m~)YJ=~tl zt?O4#O@uNFgA%;sOq#jvAx%`7_w<3u5hoi3SjVi2%yyx|AQgpJ)%L+Gdos;*oa1T6 z`D`O~CygFEMVLw@^zIfSl@BT5bRf0qq#NijFuD>p!!RvT3^%i?*K#u#&>E45gI-#m zHz|D=OlFN{&J%`7o!J8CTK{|j&R7L09Yf|i6?D7_q)3A-(r&dl)857@m{tXuJ%(Pz zVRaA&+0dg-3~N#i{@l3OY&5}L7leR27Ra&w6;22os$nLhqzGjpPW1IYTe|t>!#~_i B>O24d delta 1034 zcmbVKUrXCi6gMht6qNlDW#Hg&VVf0F?!9S}CXBL>+-g{wTy9e9*amhQoLJkg3Y&;@ zd)&(yAl+%F$686Re(d)5 z_d2`k2&rauWqF_#p@1mPDTrxP-NppLyM8+1NI&)Zhfi$ibdTQ46|g5cYmFd)e@9ED z5`vx9k<@h4PJ&Ufuu}5_<_hK{%mYN%Z!~vHGj}y07+ac=eNdKXHyjaXe6aAk2sRgN z!;c!V>PcQe1grJd@nxjiWu%1KL`Hf`R)wDbQS5~+kJX$;kZ|FLi65@5M{xo*sK6?( z`RWjjc;ZK4yeeU91Sic%jeU=Kt3^08RcTOIiDRZK2`2z zKNi0z53gE&kQZ7RYW}7GV(1f)7#L#L2?k8CHR%UP+04fYwen6{9(GO|3C=jvphZyMDmKW;@pZxj8Vr`zMx_2IzZ(+Ux}q8FJ&rY z3l%Fb$)q$X1WxElX`BI(LdNZy0b=XQJu%0yHCa-wfa`=q*)kp&{tG(9Ol&YA70d83 mAOzGj0G$LpIYl73&`B71zHlSKPEm0#dwYNB{Or-^uYUo>auw77 diff --git a/sources/APUTDQ b/sources/APUTDQ index 7fbeb952..ddbe8be3 100644 --- a/sources/APUTDQ +++ b/sources/APUTDQ @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Jun-2025 08:43:36" {WMEDLEY}APUTDQ.;5 10433 +(FILECREATED "28-Dec-2025 16:59:14" {WMEDLEY}APUTDQ.;6 10366 :EDIT-BY rmk :CHANGES-TO (VARS APUTDQCOMS) - :PREVIOUS-DATE "23-May-2025 09:03:46" {WMEDLEY}APUTDQ.;4) + :PREVIOUS-DATE "11-Jun-2025 08:43:36" {WMEDLEY}APUTDQ.;5) (PRETTYCOMPRINT APUTDQCOMS) @@ -29,8 +29,8 @@ (LOGINHOST/DIR '{DSK})) (FNS LOADUP ENDLOADUP) (ALISTS (SYSTEMINITVARS \CONNECTED.DIRECTORY DWIMFLG ADDSPELLFLG FILEPKGFLG BUILDMAPFLG - UPDATEMAPFLG DEFAULTREGISTRY DEFAULTPRINTINGHOST NETWORKOSTYPES CH.NET.HINT - CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION ADVISEDFNS)) + UPDATEMAPFLG DEFAULTREGISTRY NETWORKOSTYPES CH.NET.HINT CH.DEFAULT.DOMAIN + CH.DEFAULT.ORGANIZATION ADVISEDFNS)) [DECLARE%: DONTEVAL@LOAD DOCOPY (* ;; "many of these are obsolete and can be removed, but it is unclear which ones") @@ -174,7 +174,6 @@ (BUILDMAPFLG . T) (UPDATEMAPFLG . T) (DEFAULTREGISTRY) - (DEFAULTPRINTINGHOST) (NETWORKOSTYPES) (CH.NET.HINT) (CH.DEFAULT.DOMAIN) @@ -249,7 +248,7 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3701 5909 (GREETFILENAME 3711 . 5584) (FAULTEVAL 5586 . 5658) (FAULTAPPLY 5660 . 5746) -(ERRORX 5748 . 5814) (SET-DOCUMENTATION 5816 . 5907)) (5910 6930 (SMASHFILECOMS 5920 . 6262) ( -SMASHFILECOMSLST 6264 . 6928)) (7024 8628 (LOADUP 7034 . 7618) (ENDLOADUP 7620 . 8626))))) + (FILEMAP (NIL (3681 5889 (GREETFILENAME 3691 . 5564) (FAULTEVAL 5566 . 5638) (FAULTAPPLY 5640 . 5726) +(ERRORX 5728 . 5794) (SET-DOCUMENTATION 5796 . 5887)) (5890 6910 (SMASHFILECOMS 5900 . 6242) ( +SMASHFILECOMSLST 6244 . 6908)) (7004 8608 (LOADUP 7014 . 7598) (ENDLOADUP 7600 . 8606))))) STOP diff --git a/sources/APUTDQ.LCOM b/sources/APUTDQ.LCOM index 568867e67e31cf2614abffa42e0246fcf7c767f7..cb08e5048e99fc43a7d39140fe665bf47be3aeaf 100644 GIT binary patch delta 263 zcmaE)vrT70xQLO3u1jjNu91O}se+-Im8qqbp~=K-oq97(1ui8cGbBlKD`QJ50}CaE zq@vX1{M>@foYWMB)QW%@hm`jLpm@`!U*17H2fvyoYfn&*V(L zARY}DS7#r`AXlJcxHcc>OJq^-a}5di5Aya84v7qK4c1i9aQ4sxis^ZH`h@^_T$|&B GS(pLYw?q2? delta 300 zcmdm{^GIhxxQL;lu2*TEu91O}se*xpm5H&HvDw6IoqAJE1ui8+1B9fJp_P%jm4UgE zLQ+v`a(-?>W=?8~LUKl8UV3V=s+B@seo01VUb;eNo`RBFsE>~VvSvL!Jtc*d#1fzm zY^E9+Drs_QxOw`xItRHrhPb*YOzvPbVgnjsVr)FwhtXEp$XM4mu@dS`ODh9oE0f7{ z7-bnvHt%Ab$s^+8>gE{g6A}>Q=@;VZ=kDPj9HKBem@kNtYw|8Z>CFfE0$I$ksL@o= k@N*3b_Yd+0YKRPQ4F(EuIeX{<1@%0DMgh5-jf7d40b+qqrT_o{ diff --git a/sources/ATTACHEDWINDOW b/sources/ATTACHEDWINDOW index 0355cdea..90dd93d1 100644 --- a/sources/ATTACHEDWINDOW +++ b/sources/ATTACHEDWINDOW @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Jun-99 17:18:50" {DSK}medley3.5>sources>ATTACHEDWINDOW.;3 124287 - changes to%: (FNS RESHAPEALLWINDOWS) +(FILECREATED "23-Dec-2025 23:51:48" {WMEDLEY}ATTACHEDWINDOW.;2 124374 - previous date%: "28-Jun-99 15:59:05" {DSK}medley3.5>sources>ATTACHEDWINDOW.;2) + :EDIT-BY rmk + :CHANGES-TO (FNS DOATTACHEDWINDOWCOM) + + :PREVIOUS-DATE "28-Jun-99 17:18:50" {WMEDLEY}ATTACHEDWINDOW.;1) -(* ; " -Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1995, 1999 by Venue & Xerox Corporation. All rights reserved. -") (PRETTYCOMPRINT ATTACHEDWINDOWCOMS) @@ -246,15 +245,16 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1995, 1999 b 'MAINWINDOW NIL]) (DOATTACHEDWINDOWCOM - [LAMBDA (ATTACHEDW) (* ; "Edited 16-Jul-92 11:22 by cat") - (* ; "Edited 22-Jan-88 13:35 by woz") + [LAMBDA (ATTACHEDW) (* ; "Edited 23-Dec-2025 22:42 by rmk") + (* ; "Edited 16-Jul-92 11:22 by cat") + (* ; "Edited 22-Jan-88 13:35 by woz") - (* ;; "a right button function for attached windows that brings up the window command menu and then, depending upon the command selected, either passes the command to the main window or performs it on the attached window. The commands in the windowprop PASSTOMAINCOMS are passed to the central window. Others are applied to ATTACHEDW.") + (* ;; "a right button function for attached windows that brings up the window command menu and then, depending upon the command selected, either passes the command to the main window or performs it on the attached window. The commands in the windowprop PASSTOMAINCOMS are passed to the central window. Others are applied to ATTACHEDW.") (COND ((WINDOWP ATTACHEDW) (TOTOPW ATTACHEDW) - (LET [(COM (MENU (COND + (LET ([COM (MENU (COND ((type? MENU WindowMenu) WindowMenu) (T (SETQ WindowMenu (create MENU @@ -267,15 +267,20 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1995, 1999 b WHENHELDFN _ (FUNCTION PPROMPT3) WHENUNHELDFN _ (FUNCTION CLRPROMPT) CENTERFLG _ T] + WINDOW) + (DECLARE (SPECVARS WINDOW)) (CL:WHEN COM - (COND - ([OR (EQ (WINDOWPROP ATTACHEDW 'PASSTOMAINCOMS) - T) - (MEMB (OR (CDR (ASSOC COM *ATTACHED-WINDOW-COMMAND-SYNONYMS*)) - COM) - (WINDOWPROP ATTACHEDW 'PASSTOMAINCOMS] - (APPLY* COM (CENTRALWINDOW ATTACHEDW))) - (T (APPLY* COM ATTACHEDW))) + (SETQ WINDOW (COND + ([OR (EQ (WINDOWPROP ATTACHEDW 'PASSTOMAINCOMS) + T) + (MEMB (OR (CDR (ASSOC COM *ATTACHED-WINDOW-COMMAND-SYNONYMS*)) + COM) + (WINDOWPROP ATTACHEDW 'PASSTOMAINCOMS] + (CENTRALWINDOW ATTACHEDW)) + (T ATTACHEDW))) + (CL:IF (LISTP COM) + (EVAL COM) + (APPLY* COM WINDOW)) T))) ((NULL ATTACHEDW) (DOBACKGROUNDCOM]) @@ -2006,10 +2011,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1995, 1999 b (DECLARE%: EVAL@COMPILE (RECORD RESHAPINGWINDOWDATA (ATTACHEDW (ATEDGE . ATWHEREONEDGE) - (ATMINX . ATMINY) - (ATMAXX . ATMAXY) - (ATXSIZE . ATYSIZE) - (ATNOWX . ATNOWY))) + (ATMINX . ATMINY) + (ATMAXX . ATMAXY) + (ATXSIZE . ATYSIZE) + (ATNOWX . ATNOWY))) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -2024,32 +2029,30 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1995, 1999 b (CONS 'HARDCOPYIMAGEW.TOFILE 'HARDCOPYIMAGEW)) "used by attachwindows to associate window command substitutes with their original name, eg \interactive.closew with closew. Must be maintained as an alist, with each entry of the form (new-com . old-com)." ) -(PUTPROPS ATTACHEDWINDOW COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 -1991 1992 1995 1999)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2273 10646 (ATTACHWINDOW 2283 . 4854) (ATTACHEDWINDOWS 4856 . 5792) (ALLATTACHEDWINDOWS - 5794 . 6219) (DETACHWINDOW 6221 . 7121) (DETACHALLWINDOWS 7123 . 7440) (FREEATTACHEDWINDOW 7442 . -9079) (MAINWINDOW 9081 . 9761) (REMOVEWINDOW 9763 . 10065) (REPOSITIONATTACHEDWINDOWS 10067 . 10644)) -(10647 104021 (ATTACHEDWINDOWREGION 10657 . 11325) (ATTACHEDWINDOWTOTOPFN 11327 . 11804) ( -CENTERINHEIGHT 11806 . 12276) (CENTERINWIDTH 12278 . 12728) (CENTRALWINDOW 12730 . 13160) ( -CLOSEATTACHEDWINDOWS 13162 . 13738) (DOATTACHEDWINDOWCOM 13740 . 15811) (DOATTACHEDWINDOWCOM2 15813 . -16101) (DOMAINWINDOWCOMFN 16103 . 16657) (EXPANDATTACHEDWINDOWS 16659 . 17725) (MAKEMAINWINDOW 17727 - . 19442) (MAXATTACHEDWINDOWEXTENT 19444 . 24053) (MAXIMUMMAINWINDOWSIZE 24055 . 24740) ( -MAXIMUMWINDOWSIZE 24742 . 25491) (MINATTACHEDWINDOWEXTENT 25493 . 29820) (MINIMUMMAINWINDOWSIZE 29822 - . 30608) (MOVEATTACHEDWINDOWS 30610 . 31262) (MOVEATTACHEDWINDOWTOPLACE 31264 . 40365) ( -OPENATTACHEDWINDOWS 40367 . 41320) (RESHAPEALLWINDOWS 41322 . 51053) (\TOTALPROPOSEDSIZE 51055 . 52568 -) (SHRINKATTACHEDWINDOWS 52570 . 53529) (TOPATTACHEDWINDOWS 53531 . 54044) (UNMAKEMAINWINDOW 54046 . -54818) (UPIQUOTIENT 54820 . 55129) (WINDOWPOSITION 55131 . 55473) (WINDOWSIZE 55475 . 56020) ( -\ALLOCMINIMUMSIZES 56022 . 66540) (\ALLOCSPACETOGROUPEDWINDOWS 66542 . 67117) (\TOTALFIXEDHEIGHT 67119 - . 67877) (\TOTALFIXEDWIDTH 67879 . 68769) (\ALLOCHEIGHTTOGROUPEDWINDOW 68771 . 74324) ( -\ALLOCWIDTHTOGROUPEDWINDOW 74326 . 79621) (\ATWGROUPSIZE 79623 . 80738) (\BREAKAPARTATWSTRUCTURE 80740 - . 81244) (\BUILDATWSTRUCTURE 81246 . 85867) (\LIMITBYMAX 85869 . 86032) (\LIMITBYMIN 86034 . 86294) ( -\MAXHEIGHTOFGROUP 86296 . 87340) (\MAXWIDTHOFGROUP 87342 . 88384) (\RESHAPEATTACHEDWINDOWSAROUNDMAINW -88386 . 96384) (\SETGROUPMIN 96386 . 101125) (\SETWINFOXSIZE 101127 . 101971) (\SETWINFOYSIZE 101973 - . 102981) (\SHAREOFXTRAX 102983 . 103464) (\SHAREOFXTRAY 103466 . 104019)) (104022 117243 (ATTACHMENU - 104032 . 104740) (CREATEMENUEDWINDOW 104742 . 109899) (MENUWINDOW 109901 . 112303) (MENUWMINSIZEFN -112305 . 114268) (MENUWRESHAPEFN 114270 . 117241)) (117244 123236 (GETPROMPTWINDOW 117254 . 119306) ( -\PROMPTWINDOW.EXPAND 119308 . 119885) (\PROMPTWINDOW.SET.HEIGHT 119887 . 120815) (\PROMPTWINDOW.OPENFN - 120817 . 121792) (\PROMPTWINDOW.PAGEFULLFN 121794 . 122223) (REATTACHPROMPTWINDOW 122225 . 122666) ( -REMOVEPROMPTWINDOW 122668 . 123234))))) + (FILEMAP (NIL (2125 10498 (ATTACHWINDOW 2135 . 4706) (ATTACHEDWINDOWS 4708 . 5644) (ALLATTACHEDWINDOWS + 5646 . 6071) (DETACHWINDOW 6073 . 6973) (DETACHALLWINDOWS 6975 . 7292) (FREEATTACHEDWINDOW 7294 . +8931) (MAINWINDOW 8933 . 9613) (REMOVEWINDOW 9615 . 9917) (REPOSITIONATTACHEDWINDOWS 9919 . 10496)) ( +10499 104246 (ATTACHEDWINDOWREGION 10509 . 11177) (ATTACHEDWINDOWTOTOPFN 11179 . 11656) ( +CENTERINHEIGHT 11658 . 12128) (CENTERINWIDTH 12130 . 12580) (CENTRALWINDOW 12582 . 13012) ( +CLOSEATTACHEDWINDOWS 13014 . 13590) (DOATTACHEDWINDOWCOM 13592 . 16036) (DOATTACHEDWINDOWCOM2 16038 . +16326) (DOMAINWINDOWCOMFN 16328 . 16882) (EXPANDATTACHEDWINDOWS 16884 . 17950) (MAKEMAINWINDOW 17952 + . 19667) (MAXATTACHEDWINDOWEXTENT 19669 . 24278) (MAXIMUMMAINWINDOWSIZE 24280 . 24965) ( +MAXIMUMWINDOWSIZE 24967 . 25716) (MINATTACHEDWINDOWEXTENT 25718 . 30045) (MINIMUMMAINWINDOWSIZE 30047 + . 30833) (MOVEATTACHEDWINDOWS 30835 . 31487) (MOVEATTACHEDWINDOWTOPLACE 31489 . 40590) ( +OPENATTACHEDWINDOWS 40592 . 41545) (RESHAPEALLWINDOWS 41547 . 51278) (\TOTALPROPOSEDSIZE 51280 . 52793 +) (SHRINKATTACHEDWINDOWS 52795 . 53754) (TOPATTACHEDWINDOWS 53756 . 54269) (UNMAKEMAINWINDOW 54271 . +55043) (UPIQUOTIENT 55045 . 55354) (WINDOWPOSITION 55356 . 55698) (WINDOWSIZE 55700 . 56245) ( +\ALLOCMINIMUMSIZES 56247 . 66765) (\ALLOCSPACETOGROUPEDWINDOWS 66767 . 67342) (\TOTALFIXEDHEIGHT 67344 + . 68102) (\TOTALFIXEDWIDTH 68104 . 68994) (\ALLOCHEIGHTTOGROUPEDWINDOW 68996 . 74549) ( +\ALLOCWIDTHTOGROUPEDWINDOW 74551 . 79846) (\ATWGROUPSIZE 79848 . 80963) (\BREAKAPARTATWSTRUCTURE 80965 + . 81469) (\BUILDATWSTRUCTURE 81471 . 86092) (\LIMITBYMAX 86094 . 86257) (\LIMITBYMIN 86259 . 86519) ( +\MAXHEIGHTOFGROUP 86521 . 87565) (\MAXWIDTHOFGROUP 87567 . 88609) (\RESHAPEATTACHEDWINDOWSAROUNDMAINW +88611 . 96609) (\SETGROUPMIN 96611 . 101350) (\SETWINFOXSIZE 101352 . 102196) (\SETWINFOYSIZE 102198 + . 103206) (\SHAREOFXTRAX 103208 . 103689) (\SHAREOFXTRAY 103691 . 104244)) (104247 117468 (ATTACHMENU + 104257 . 104965) (CREATEMENUEDWINDOW 104967 . 110124) (MENUWINDOW 110126 . 112528) (MENUWMINSIZEFN +112530 . 114493) (MENUWRESHAPEFN 114495 . 117466)) (117469 123461 (GETPROMPTWINDOW 117479 . 119531) ( +\PROMPTWINDOW.EXPAND 119533 . 120110) (\PROMPTWINDOW.SET.HEIGHT 120112 . 121040) (\PROMPTWINDOW.OPENFN + 121042 . 122017) (\PROMPTWINDOW.PAGEFULLFN 122019 . 122448) (REATTACHPROMPTWINDOW 122450 . 122891) ( +REMOVEPROMPTWINDOW 122893 . 123459))))) STOP diff --git a/sources/ATTACHEDWINDOW.LCOM b/sources/ATTACHEDWINDOW.LCOM index 6c2935d81c6fca6b02b7c00ba55adac660b8d153..7b0cbbe37e3f309e03c7af5ade36f0eaad932260 100644 GIT binary patch delta 1089 zcma))NlX(_7=T-LM#CnwKnQsq6kC%aooRt~1k%zOpwLZdsaVh;Wm9PdZK2?j=tUD_ z&=(JSK@ExrMaT#$8WlArobaL~#)Bs>1UwlfXyX4y5+(8A9KQFj^DpmRSySHot{knk zP?WaD?htK_qSY%3h~^B8(AmLodae|42ELT#jV2mt>5g#U(cUASK@<)l8jbj!qTmo) zPFCQL%6v7VXqNkv$C`OV8Lu~7npfeMk!?Mw7jkNR4hQ->s-&cZM#1*u@XvpxvmCAa zuiiHGl2;5hjD~U};zhykWvW}yK;L0R@wPgvt5$4cyl$keaW&!jNH(iOyr)rYw!3{z zi~!@q^d_c05@O6|#Fq1{i7(aDh}u*j7t$!J*K4)a`Ry*j?MJ*|qNJ3#fF*QiXOxvo7;)(NRNKEA_{&TQoKu0D3q2|1$;NB6|eBvwn$=TeEkCp z&dWCJ4%Elbqy`Vyr>FI1$T3rEmRl(#IHM;+q2=@@B)F@swuah9x6dVz0xT>-Y_>XZ ze|9G{vXuQMfzs+Id?P0p)VZ7{V47+|?olHxsWdR6w5B#Bz`+!ph6DF&RQMITCrht^ zOu<8Gg`SDua6K;m2C>sSZ6x!nb~FX-FS0avf}I7!e$Gp_DwUrhyCZhL`Kc_a@Gkx> zxYqgYWXGt|0&K5z0`FHggCnV`1X6LSZ5;T)Ms|EnSO7;*Y=Gj@R9zwIVXlebbYL}+ zT)iHT4&>vr$CkksK29FbdzqDy0LWJ(V7VM6=I$tYH}g@_j%JWp&JFs3pJe$*SrI-o zWCneFs2!LTBR6=xFApD!k=4z|d_eWE2y7cB*{@};4y)sJh{EE?Vlt(pTy_Wb3*U-3 AP5=M^ delta 1294 zcmaKsO>7%g5XZdegzWW>X>IT(}#A)YvED@Gc;ZPVhmB>xMA4_B4Rs_Uyy2_Z&8@X`t9!1FrV2 z!Q@oLAxW7;G2}+uidba%vfW~##;g|jy|rpt!xtW@?xNZzu8O$N<{f%&qN}seJ$AW+ z#Jf*+Tbv$&N3wD_B*h~sWhyB{O?=L#L7#Qo&BtgbOUuf3eehIzSWn8JY;{{ zR5jRIw-3UlT6-PdhhRB0umTIdj&7K=}0nk*U5Te+7YBI1bHQpGWr-4d2CysAl3ExNMU*Nv&^`5uigQgMXmr@h57~ zv|5m|dSr4pESuSjB=h1kXHD+M2WMu%x-hd~av1Z+$m#mA?;&~i*&w;Z8^`-d->aGr zj<(iM%#%euRUkw9u=oHr*YtjJ&AX-Ffw#_l1bo@}2?C2{D+#<%A@Ae|lS*|4?E8=Q z;ZLha!0N4$*zKWy+^mt-_i99tcaeBsTg(D~HtkOT%5r}@d?|2t`OXSW9^zC+O(|-6=M|c- z1Rke4or*=G8Tbkv)rwUO9Y9ZOhF(XKZj^K*S1IU426=>lm%vBB6Ff!WCkOxpH==FONT.;645 281352 +(FILECREATED "31-Dec-2025 22:41:44" {WMEDLEY}FONT.;655 285234 :EDIT-BY rmk - :CHANGES-TO (MACROS SPREADFONTSPEC) + :CHANGES-TO (VARS FONTCOMS) - :PREVIOUS-DATE " 4-Dec-2025 09:46:06" {WMEDLEY}FONT.;644) + :PREVIOUS-DATE "25-Dec-2025 10:58:30" {WMEDLEY}FONT.;654) (PRETTYCOMPRINT FONTCOMS) @@ -28,7 +28,7 @@ (FNS FONTCREATE FONTCREATE1 FONTCREATE.SLUGFD \FONT.CHECKARGS1 \FONTCREATE1.NOFN FONTFILEP \READCHARSET) (FNS \FONT.CHECKARGS \CHARSET.CHECK) - (FNS COERCEFONTSPEC) + (FNS COERCEFONTSPEC COERCEFONTSPEC.TARGETFACE) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS COERCEFONTSPEC.MATCH COERCEFONTSPEC.TARGET)) (MACROS SPREADFONTSPEC) (FNS MAKEFONTSPEC) @@ -59,8 +59,7 @@ (FNS FONTCOPY FONTP FONTUNPARSE SETFONTDESCRIPTOR \STREAMCHARWIDTH \COERCECHARSET \BUILDSLUGCSINFO \FONTSYMBOL \DEVICESYMBOL \FONTFACE \FONTFACE.COLOR SETFONTCHARENCODING ) - (FNS FONTSAVAILABLE FONTEXISTS? \SEARCHFONTFILES FLUSHFONTCACHE FLUSHFONTSINCORE - FINDFONTFILES SORTFONTSPECS) + (FNS FONTSAVAILABLE FONTEXISTS? \SEARCHFONTFILES FLUSHFONTCACHE FINDFONTFILES SORTFONTSPECS) (FNS MATCHFONTFACE MAKEFONTFACE FONTFACETOATOM) (INITVARS \FONTSINCORE \FONTEXISTS?-CACHE \FONTSAVAILABLEFILECACHE \DEFAULTDEVICEFONTS) @@ -891,7 +890,11 @@ (DEFINEQ (COERCEFONTSPEC - [LAMBDA (FONTSPEC COERCIONS) (* ; "Edited 9-Nov-2025 17:54 by rmk") + [LAMBDA (FONTSPEC COERCIONS ALL) (* ; "Edited 22-Dec-2025 22:56 by rmk") + (* ; "Edited 18-Dec-2025 16:06 by rmk") + (* ; "Edited 2-Dec-2025 17:24 by rmk") + (* ; "Edited 25-Nov-2025 20:37 by rmk") + (* ; "Edited 9-Nov-2025 17:54 by rmk") (* ; "Edited 5-Oct-2025 09:41 by rmk") (* ; "Edited 28-Aug-2025 14:41 by rmk") (* ; "Edited 25-Aug-2025 10:22 by rmk") @@ -902,44 +905,77 @@ (* ; "Edited 5-Aug-2025 17:27 by rmk") (* ; "Edited 23-Jul-2025 15:39 by rmk") - (* ;; "Produces a list of coerced fontspecs, one for each coercion whose right side matches the given FONTSPEC parameters.") + (* ;; "If ALL, produces a list of coerced fontspecs, one for each coercion to an existing font whose right side matches the given FONTSPEC parameters. Otherwise, returns the first matching coercion.") - (* ;; "Doesn't make sense to coerce the device, DEVICE and also CHARSET are just carried along.") + (* ;; "The recursion allows for coercions on multiple dimensions (e.g. family, and then size).") + (* ;; "Doesn't make sense to coerce the device, DEVICE is just carried along.") + + (DECLARE (SPECVARS FONTSPEC)) (CL:WHEN (LITATOM COERCIONS) [SETQ COERCIONS (FONTDEVICEPROP FONTSPEC (OR COERCIONS 'FONTCOERCIONS]) + (for C RESULT MATCH TARGET MFAMILY MSIZE MFACE MROTATION TFAMILY TSIZE TFACE TROTATION COERCED + FAMILY SIZE FACE ROTATION DEVICE in COERCIONS declare (SPECVARS FAMILY SIZE FACE ROTATION + DEVICE) + first (SPREADFONTSPEC FONTSPEC) + when [SETQ COERCED (if (AND C (LITATOM C)) + then (APPLY* C FONTSPEC FAMILY SIZE FACE ROTATION DEVICE) + else (SETQ MATCH (MKLIST (CAR C))) + (CL:WHEN [AND (COERCEFONTSPEC.MATCH (pop MATCH) + FAMILY) + (COERCEFONTSPEC.MATCH (pop MATCH) + SIZE) + (MATCHFONTFACE (\FONTFACE (OR (pop MATCH) + '*)) + FACE) + (COERCEFONTSPEC.MATCH (CAR MATCH) + ROTATION) + (PROGN (SETQ TARGET (MKLIST (CADR C))) + (SETQ TFAMILY (COERCEFONTSPEC.TARGET + (pop TARGET) + FAMILY)) + (SETQ TSIZE (COERCEFONTSPEC.TARGET (pop TARGET) + SIZE)) + (SETQ TFACE (COERCEFONTSPEC.TARGETFACE + (pop TARGET) + FACE)) + (SETQ TROTATION (COERCEFONTSPEC.TARGET + ROTATION + (pop TARGET))) - (* ;; "A NIL match component matches everything, and a NIL target component denotes the corresponding argument.") + (* ;; + "Don't include the input in the output, if the coercions have a loop") - (for C MATCH TARGET MFAMILY MSIZE MFACE MROTATION TFAMILY TSIZE TFACE TROTATION COERCED FAMILY - SIZE FACE ROTATION DEVICE in COERCIONS first (SPREADFONTSPEC FONTSPEC) - eachtime (SETQ MATCH (MKLIST (CAR C))) - when [AND (COERCEFONTSPEC.MATCH (pop MATCH) - FAMILY) - (COERCEFONTSPEC.MATCH (pop MATCH) - SIZE) - (MATCHFONTFACE (\FONTFACE (OR (pop MATCH) - '*)) - FACE) - (COERCEFONTSPEC.MATCH (CAR MATCH) - ROTATION) - (PROGN (SETQ TARGET (MKLIST (CADR C))) - (SETQ TFAMILY (COERCEFONTSPEC.TARGET (pop TARGET) - FAMILY)) - (SETQ TSIZE (COERCEFONTSPEC.TARGET (pop TARGET) - SIZE)) - (SETQ TFACE (COERCEFONTSPEC.TARGET (pop TARGET) - FACE)) - (SETQ TROTATION (COERCEFONTSPEC.TARGET ROTATION (pop TARGET))) + (NOT (AND (EQ FAMILY TFAMILY) + (EQ SIZE TSIZE) + (EQUAL FACE TFACE) + (EQ ROTATION TROTATION] + (MAKEFONTSPEC TFAMILY TSIZE TFACE TROTATION DEVICE] + unless (MEMBER COERCED RESULT) + when (SETQ COERCED (if (FONTEXISTS? COERCED NIL NIL NIL NIL T) + then (CONS COERCED) + elseif ALL + then (COERCEFONTSPEC COERCED COERCIONS T) + elseif (SETQ COERCED (COERCEFONTSPEC COERCED COERCIONS)) + then (CONS COERCED))) do - (* ;; "Don't include the input in the output, if the coercions have a loop") + (* ;; "If COERCED exists, it's a singleton whether or not ALL. We always inflate it to a list, to simplify code") - (NOT (AND (EQ FAMILY TFAMILY) - (EQ SIZE TSIZE) - (EQUAL FACE TFACE) - (EQ ROTATION TROTATION] - unless (MEMBER (SETQ COERCED (MAKEFONTSPEC TFAMILY TSIZE TFACE TROTATION DEVICE)) - $$VAL) collect COERCED]) + (for C in COERCED + unless (MEMBER C RESULT) + do (push RESULT C)) + finally (RETURN (DREVERSE RESULT]) + +(COERCEFONTSPEC.TARGETFACE + [LAMBDA (TFACE FFACE) (* ; "Edited 22-Dec-2025 22:54 by rmk") + (if (MEMB TFACE '(NIL *)) + then FFACE + else (MAKEFONTFACE (COERCEFONTSPEC.TARGET (fetch (FONTFACE WEIGHT) of TFACE) + (fetch (FONTFACE WEIGHT) of FFACE)) + (COERCEFONTSPEC.TARGET (fetch (FONTFACE SLOPE) of TFACE) + (fetch (FONTFACE SLOPE) of FFACE)) + (COERCEFONTSPEC.TARGET (fetch (FONTFACE EXPANSION) of TFACE) + (fetch (FONTFACE EXPANSION) of FFACE]) ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -2333,7 +2369,8 @@ (SHOULDNT]) (\COERCECHARSET - [LAMBDA (FONTSPEC CHARSET CODE COERCIONS FONT) (* ; "Edited 7-Oct-2025 17:25 by rmk") + [LAMBDA (FONTSPEC CHARSET CODE COERCIONS FONT) (* ; "Edited 17-Dec-2025 21:51 by rmk") + (* ; "Edited 7-Oct-2025 17:25 by rmk") (* ; "Edited 31-Aug-2025 00:00 by rmk") (* ; "Edited 28-Aug-2025 23:07 by rmk") (* ; "Edited 27-Aug-2025 17:08 by rmk") @@ -2345,7 +2382,7 @@ (* ; "Edited 7-Jun-2025 13:39 by rmk") (* ; "Edited 21-May-2025 10:50 by rmk") - (* ;; "Returns the CHARSET's CSINFO from the first font that the requested font coerces to and that has a non-slug entry for THINCODE (if given). ") + (* ;; "Returns the CHARSET's CSINFO from the first font that the requested font coerces to and that has a non-slug entry for CODE (if given). ") (if (NULL COERCIONS) then [SETQ COERCIONS (FONTDEVICEPROP FONTSPEC (CL:IF CODE @@ -2353,10 +2390,18 @@ 'FONTCOERCIONS)] elseif (LITATOM COERCIONS) then (SETQ COERCIONS (FONTDEVICEPROP FONTSPEC COERCIONS))) - (for CFS CFONT CSINFO in (COERCEFONTSPEC FONTSPEC COERCIONS) - when (AND (SETQ CFONT (FONTCREATE1 CFS CHARSET)) - (SETQ CSINFO (\INSURECHARSETINFO CFONT CHARSET))) - unless (AND CODE (SLUGCHARP.DISPLAY CODE CFONT)) + + (* ;; "This creates a list of fontspecs for the coercions of FONTSPEC that exist, then looks for the first one with the required character. If we stopped at the first coercion and it failed, we wouldn't know how to continue the iteration") + + (for CFS CFONT CSINFO in (COERCEFONTSPEC FONTSPEC COERCIONS T) eachtime + + (* ;; + "Font CFS exists, FONTCREATE1 can't fail") + + (SETQ CFONT (FONTCREATE1 + CFS CHARSET)) + when (SETQ CSINFO (\INSURECHARSETINFO CFONT CHARSET)) unless (AND CODE (SLUGCHARP.DISPLAY + CODE CFONT)) do (CL:WHEN FONT (replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with (fetch (FONTDESCRIPTOR FONTCHARENCODING) @@ -2794,7 +2839,9 @@ then FILEFONTS)))]) (FONTEXISTS? - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOCOERCIONS) (* ; "Edited 26-Sep-2025 10:10 by rmk") + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOCOERCIONS) (* ; "Edited 18-Dec-2025 13:10 by rmk") + (* ; "Edited 25-Nov-2025 20:18 by rmk") + (* ; "Edited 26-Sep-2025 10:10 by rmk") (* ; "Edited 28-Aug-2025 22:16 by rmk") (* ; "Edited 23-Aug-2025 12:45 by rmk") (* ; "Edited 16-Aug-2025 17:49 by rmk") @@ -2808,46 +2855,37 @@  "Tries device specific coercions if the original request can't be satisfied and NOCOERCIONS is NIL.") (DECLARE (GLOBALVARS \FONTSINCORE \FONTEXISTS?-CACHE IMAGESTREAMTYPES)) - (LET ((FONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE)) + (LET ((FONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE T)) VAL DEVICE) - (if (type? FONTDESCRIPTOR FONTSPEC) - then - (* ;; - "FAMILY was a font descriptor, unmodified by other args: record that it exists") - (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC T) - else (if (FETCHMULTI \FONTSINCORE FONTSPEC T) - elseif (SETQ VAL (FETCHMULTI \FONTEXISTS?-CACHE FONTSPEC T)) - then (CL:UNLESS (EQ VAL 'NO) - VAL) - else (* ; + (* ;; "SASSOC everywhere because of face") + + (if (FETCHMULTI \FONTSINCORE FONTSPEC 'SASSOC) + elseif (SETQ VAL (FETCHMULTI \FONTEXISTS?-CACHE FONTSPEC 'SASSOC)) + then (CL:UNLESS (EQ VAL 'NO) + VAL) + else (* ;  "Only 0 really exists. Cache just the first file") - (SETQ DEVICE (fetch (FONTSPEC FSDEVICE) of FONTSPEC)) - (SETQ VAL (OR (CAR (FONTFILES (CL:IF (MEMB (fetch (FONTSPEC FSROTATION) - of FONTSPEC) - '(90 270)) - (create FONTSPEC using FONTSPEC FSROTATION _ - 0) - FONTSPEC))) - (APPLY* (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE 'FONTEXISTS?) - ) - (CAR (GETMULTI IMAGESTREAMTYPES DEVICE - 'FONTSAVAILABLE)) - (FUNCTION TRUE)) - FONTSPEC))) - (if VAL - then (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL T) - elseif [AND (NOT NOCOERCIONS) - (find FS in (COERCEFONTSPEC FONTSPEC (FONTDEVICEPROP - DEVICE - 'FONTCOERCIONS)) - suchthat (SETQ VAL (FONTEXISTS? FS NIL NIL NIL NIL T] - then - (* ;; "It's coerceable...but not yet coerced.") + (SETQ DEVICE (fetch (FONTSPEC FSDEVICE) of FONTSPEC)) + (SETQ VAL (OR (CAR (FONTFILES (CL:IF (MEMB (fetch (FONTSPEC FSROTATION) of FONTSPEC) + '(90 270)) + (create FONTSPEC using FONTSPEC FSROTATION _ 0) + FONTSPEC))) + (APPLY* (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE 'FONTEXISTS?)) + (CAR (GETMULTI IMAGESTREAMTYPES DEVICE 'FONTSAVAILABLE)) + (FUNCTION NILL)) + FONTSPEC))) + (if VAL + then (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL |(QUOTE SASSOC)|) + elseif [AND (NOT NOCOERCIONS) + (SETQ VAL (COERCEFONTSPEC FONTSPEC (FONTDEVICEPROP DEVICE + 'FONTCOERCIONS] + then + (* ;; "It's coerceable...even though coercion may not yet be instantiated") - (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL T) - else (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC 'NO T) - NIL]) + (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL 'SASSOC) + else (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC 'NO 'SASSOC) + NIL]) (\SEARCHFONTFILES [LAMBDA (FONTSPEC) (* ; "Edited 28-Aug-2025 14:47 by rmk") @@ -2935,10 +2973,6 @@ (RPLACD DPAIR))] (LIST TYPE NFLUSHED]) -(FLUSHFONTSINCORE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 22-Nov-2025 10:23 by rmk") - (FLUSHFONTCACHE :INCORE FAMILY SIZE FACE ROTATION DEVICE]) - (FINDFONTFILES [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE DIRLST EXTLST) (* ; "Edited 28-Aug-2025 14:45 by rmk") (* ; "Edited 25-Aug-2025 10:23 by rmk") @@ -3586,7 +3620,8 @@ (DEFINEQ (\CREATEFONT - [LAMBDA (FONTSPEC) (* ; "Edited 25-Sep-2025 21:24 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 25-Dec-2025 10:58 by rmk") + (* ; "Edited 25-Sep-2025 21:24 by rmk") (* ; "Edited 28-Aug-2025 14:30 by rmk") (* ; "Edited 18-Aug-2025 00:17 by rmk") (* ; "Edited 16-Aug-2025 20:52 by rmk") @@ -3598,14 +3633,22 @@ (* ;; "") - (LET [(FN (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTSPEC FSDEVICE) of FONTSPEC) + (LET ([FN (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTSPEC FSDEVICE) of FONTSPEC) 'FONTCREATE] + FONT) (CL:WHEN FN - (if (EQ (NARGS FN) - 1) - then (APPLY* FN FONTSPEC) - else (* ; "Old form: spreading FONTSPEC") - (APPLY FN FONTSPEC)))]) + (SETQ FONT (if (EQ (NARGS FN) + 1) + then (APPLY* FN FONTSPEC) + else (* ; "Old form: spreading FONTSPEC") + (APPLY FN FONTSPEC))) + (CL:UNLESS FONT + (CL:WHEN (SETQ FONTSPEC (COERCEFONTSPEC FONTSPEC)) + (SETQ FONT (if (EQ (NARGS FN) + 1) + then (APPLY* FN FONTSPEC) + else (APPLY FN FONTSPEC)))))) + FONT]) (\CREATECHARSET [LAMBDA (CHARSET FONT) (* ; "Edited 25-Sep-2025 21:24 by rmk") @@ -3871,7 +3914,8 @@ CSINFO]) (\FONTEXISTS?.DISPLAY - [LAMBDA (FONTSPEC) (* ; "Edited 28-Aug-2025 22:12 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 17-Dec-2025 20:56 by rmk") + (* ; "Edited 28-Aug-2025 22:12 by rmk") (* ; "Edited 25-Aug-2025 15:04 by rmk") (* ; "Edited 17-Aug-2025 09:56 by rmk") (* ; "Edited 8-Aug-2025 10:03 by rmk") @@ -3896,9 +3940,8 @@ (FONTEXISTS? (create FONTSPEC using FONTSPEC FSFACE _ (create FONTFACE using FACE EXPANSION _ 'REGULAR] - (for FS VAL in [COERCEFONTSPEC FONTSPEC (APPEND (FONTDEVICEPROP 'DISPLAY 'FONTCOERCIONS) - (FONTDEVICEPROP 'DISPLAY 'CHARCOERCIONS] - when (SETQ VAL (FONTEXISTS? FS)) do (RETURN VAL]) + (COERCEFONTSPEC FONTSPEC (APPEND (FONTDEVICEPROP 'DISPLAY 'FONTCOERCIONS) + (FONTDEVICEPROP 'DISPLAY 'CHARCOERCIONS]) ) (DEFINEQ @@ -4597,44 +4640,44 @@ (ADDTOVAR LAMA FONTCOPY) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (12152 21865 (CHARWIDTH 12162 . 12947) (CHARWIDTHY 12949 . 14466) (STRINGWIDTH 14468 . -15561) (\CHARWIDTH.DISPLAY 15563 . 15976) (\STRINGWIDTH.DISPLAY 15978 . 16402) (\STRINGWIDTH.GENERIC -16404 . 21863)) (21866 28386 (DEFAULTFONT 21876 . 23161) (FONTCLASS 23163 . 25325) (FONTCLASSUNPARSE -25327 . 26226) (FONTCLASSCOMPONENT 26228 . 26816) (SETFONTCLASSCOMPONENT 26818 . 27260) ( -GETFONTCLASSCOMPONENT 27262 . 28384)) (30099 47603 (FONTCREATE 30109 . 33354) (FONTCREATE1 33356 . -35971) (FONTCREATE.SLUGFD 35973 . 37455) (\FONT.CHECKARGS1 37457 . 41980) (\FONTCREATE1.NOFN 41982 . -42196) (FONTFILEP 42198 . 43086) (\READCHARSET 43088 . 47601)) (47604 54680 (\FONT.CHECKARGS 47614 . -54363) (\CHARSET.CHECK 54365 . 54678)) (54681 57941 (COERCEFONTSPEC 54691 . 57939)) (60136 61475 ( -MAKEFONTSPEC 60146 . 61473)) (61476 69653 (COMPLETE.FONT 61486 . 64009) (COMPLETEFONTP 64011 . 64634) -(COMPLETE.CHARSET 64636 . 67321) (PRUNESLUGCSINFOS 67323 . 68248) (MONOSPACEFONTP 68250 . 69651)) ( -69692 77947 (FONTASCENT 69702 . 70086) (FONTDESCENT 70088 . 70573) (FONTHEIGHT 70575 . 70977) ( -FONTPROP 70979 . 77224) (\AVGCHARWIDTH 77226 . 77945)) (78604 79512 (FONTDEVICEPROP 78614 . 79510)) ( -79558 80412 (EDITCHAR 79568 . 80410)) (80458 92648 (GETCHARBITMAP 80468 . 81592) (PUTCHARBITMAP 81594 - . 83752) (\GETCHARBITMAP.CSINFO 83754 . 85770) (\PUTCHARBITMAP.CSINFO 85772 . 92646)) (92649 113129 ( -MOVECHARBITMAP 92659 . 94553) (MOVEFONTCHARS 94555 . 98515) (\MOVEFONTCHAR 98517 . 103360) ( -\MOVEFONTCHARS.SOURCEDATA 103362 . 109467) (\MAKESLUGCHAR 109469 . 112004) (SLUGCHARP.DISPLAY 112006 - . 113127)) (114062 135227 (FONTFILES 114072 . 115905) (\FINDFONTFILE 115907 . 118216) (\FONTFILENAMES - 118218 . 119213) (\FONTFILENAME 119215 . 123198) (\FONTFILENAME.OLD 123200 . 126149) ( -\FONTFILENAME.NEW 126151 . 128408) (FONTSPECFROMFILENAME 128410 . 132946) (\FONTINFOFROMFILENAME.OLD -132948 . 135225)) (135494 171297 (FONTCOPY 135504 . 140567) (FONTP 140569 . 140868) (FONTUNPARSE -140870 . 142589) (SETFONTDESCRIPTOR 142591 . 144055) (\STREAMCHARWIDTH 144057 . 148221) ( -\COERCECHARSET 148223 . 150818) (\BUILDSLUGCSINFO 150820 . 154443) (\FONTSYMBOL 154445 . 155095) ( -\DEVICESYMBOL 155097 . 155966) (\FONTFACE 155968 . 163158) (\FONTFACE.COLOR 163160 . 170080) ( -SETFONTCHARENCODING 170082 . 171295)) (171298 191597 (FONTSAVAILABLE 171308 . 176662) (FONTEXISTS? -176664 . 180642) (\SEARCHFONTFILES 180644 . 183729) (FLUSHFONTCACHE 183731 . 185954) (FLUSHFONTSINCORE - 185956 . 186153) (FINDFONTFILES 186155 . 189369) (SORTFONTSPECS 189371 . 191595)) (191598 195207 ( -MATCHFONTFACE 191608 . 192423) (MAKEFONTFACE 192425 . 193451) (FONTFACETOATOM 193453 . 195205)) ( -195838 196330 (\UNITWIDTHSVECTOR 195848 . 196328)) (210924 212991 (FONTDESCRIPTOR.DEFPRINT 210934 . -212513) (FONTCLASS.DEFPRINT 212515 . 212989)) (216820 219610 (\CREATEKERNELEMENT 216830 . 217188) ( -\FSETLEFTKERN 217190 . 217681) (\FGETLEFTKERN 217683 . 219608)) (219611 229247 (\CREATEFONT 219621 . -221060) (\CREATECHARSET 221062 . 224998) (\INSTALLCHARSETINFO 225000 . 228334) ( -\INSTALLCHARSETINFO.CHARENCODING 228336 . 229245)) (229569 230933 (\FONTRESETCHARWIDTHS 229579 . -230931)) (231563 241610 (\CREATEDISPLAYFONT 231573 . 233422) (\CREATECHARSET.DISPLAY 233424 . 239133) -(\FONTEXISTS?.DISPLAY 239135 . 241608)) (241611 256476 (STRIKEFONT.FILEP 241621 . 242509) ( -STRIKEFONT.GETCHARSET 242511 . 248103) (WRITESTRIKEFONTFILE 248105 . 253016) (STRIKECSINFO 253018 . -256474)) (256507 272824 (MAKEBOLD.CHARSET 256517 . 260166) (MAKEBOLD.CHAR 260168 . 261920) ( -MAKEITALIC.CHARSET 261922 . 265595) (MAKEITALIC.CHAR 265597 . 267943) (\SFMAKEBOLD 267945 . 270169) ( -\SFMAKEITALIC 270171 . 272822)) (272825 276974 (\SFMAKEROTATEDFONT 272835 . 274236) (\SFROTATECSINFO -274238 . 274875) (\SFROTATEFONTCHARACTERS 274877 . 275257) (\SFROTATECSINFOOFFSETS 275259 . 276972)) ( -276975 278356 (\SFMAKECOLOR 276985 . 278354))))) + (FILEMAP (NIL (12139 21852 (CHARWIDTH 12149 . 12934) (CHARWIDTHY 12936 . 14453) (STRINGWIDTH 14455 . +15548) (\CHARWIDTH.DISPLAY 15550 . 15963) (\STRINGWIDTH.DISPLAY 15965 . 16389) (\STRINGWIDTH.GENERIC +16391 . 21850)) (21853 28373 (DEFAULTFONT 21863 . 23148) (FONTCLASS 23150 . 25312) (FONTCLASSUNPARSE +25314 . 26213) (FONTCLASSCOMPONENT 26215 . 26803) (SETFONTCLASSCOMPONENT 26805 . 27247) ( +GETFONTCLASSCOMPONENT 27249 . 28371)) (30086 47590 (FONTCREATE 30096 . 33341) (FONTCREATE1 33343 . +35958) (FONTCREATE.SLUGFD 35960 . 37442) (\FONT.CHECKARGS1 37444 . 41967) (\FONTCREATE1.NOFN 41969 . +42183) (FONTFILEP 42185 . 43073) (\READCHARSET 43075 . 47588)) (47591 54667 (\FONT.CHECKARGS 47601 . +54350) (\CHARSET.CHECK 54352 . 54665)) (54668 61279 (COERCEFONTSPEC 54678 . 60590) ( +COERCEFONTSPEC.TARGETFACE 60592 . 61277)) (63474 64813 (MAKEFONTSPEC 63484 . 64811)) (64814 72991 ( +COMPLETE.FONT 64824 . 67347) (COMPLETEFONTP 67349 . 67972) (COMPLETE.CHARSET 67974 . 70659) ( +PRUNESLUGCSINFOS 70661 . 71586) (MONOSPACEFONTP 71588 . 72989)) (73030 81285 (FONTASCENT 73040 . 73424 +) (FONTDESCENT 73426 . 73911) (FONTHEIGHT 73913 . 74315) (FONTPROP 74317 . 80562) (\AVGCHARWIDTH 80564 + . 81283)) (81942 82850 (FONTDEVICEPROP 81952 . 82848)) (82896 83750 (EDITCHAR 82906 . 83748)) (83796 +95986 (GETCHARBITMAP 83806 . 84930) (PUTCHARBITMAP 84932 . 87090) (\GETCHARBITMAP.CSINFO 87092 . 89108 +) (\PUTCHARBITMAP.CSINFO 89110 . 95984)) (95987 116467 (MOVECHARBITMAP 95997 . 97891) (MOVEFONTCHARS +97893 . 101853) (\MOVEFONTCHAR 101855 . 106698) (\MOVEFONTCHARS.SOURCEDATA 106700 . 112805) ( +\MAKESLUGCHAR 112807 . 115342) (SLUGCHARP.DISPLAY 115344 . 116465)) (117400 138565 (FONTFILES 117410 + . 119243) (\FINDFONTFILE 119245 . 121554) (\FONTFILENAMES 121556 . 122551) (\FONTFILENAME 122553 . +126536) (\FONTFILENAME.OLD 126538 . 129487) (\FONTFILENAME.NEW 129489 . 131746) (FONTSPECFROMFILENAME +131748 . 136284) (\FONTINFOFROMFILENAME.OLD 136286 . 138563)) (138832 175407 (FONTCOPY 138842 . 143905 +) (FONTP 143907 . 144206) (FONTUNPARSE 144208 . 145927) (SETFONTDESCRIPTOR 145929 . 147393) ( +\STREAMCHARWIDTH 147395 . 151559) (\COERCECHARSET 151561 . 154928) (\BUILDSLUGCSINFO 154930 . 158553) +(\FONTSYMBOL 158555 . 159205) (\DEVICESYMBOL 159207 . 160076) (\FONTFACE 160078 . 167268) ( +\FONTFACE.COLOR 167270 . 174190) (SETFONTCHARENCODING 174192 . 175405)) (175408 194969 (FONTSAVAILABLE + 175418 . 180772) (FONTEXISTS? 180774 . 184213) (\SEARCHFONTFILES 184215 . 187300) (FLUSHFONTCACHE +187302 . 189525) (FINDFONTFILES 189527 . 192741) (SORTFONTSPECS 192743 . 194967)) (194970 198579 ( +MATCHFONTFACE 194980 . 195795) (MAKEFONTFACE 195797 . 196823) (FONTFACETOATOM 196825 . 198577)) ( +199210 199702 (\UNITWIDTHSVECTOR 199220 . 199700)) (214296 216363 (FONTDESCRIPTOR.DEFPRINT 214306 . +215885) (FONTCLASS.DEFPRINT 215887 . 216361)) (220192 222982 (\CREATEKERNELEMENT 220202 . 220560) ( +\FSETLEFTKERN 220562 . 221053) (\FGETLEFTKERN 221055 . 222980)) (222983 233135 (\CREATEFONT 222993 . +224948) (\CREATECHARSET 224950 . 228886) (\INSTALLCHARSETINFO 228888 . 232222) ( +\INSTALLCHARSETINFO.CHARENCODING 232224 . 233133)) (233457 234821 (\FONTRESETCHARWIDTHS 233467 . +234819)) (235451 245492 (\CREATEDISPLAYFONT 235461 . 237310) (\CREATECHARSET.DISPLAY 237312 . 243021) +(\FONTEXISTS?.DISPLAY 243023 . 245490)) (245493 260358 (STRIKEFONT.FILEP 245503 . 246391) ( +STRIKEFONT.GETCHARSET 246393 . 251985) (WRITESTRIKEFONTFILE 251987 . 256898) (STRIKECSINFO 256900 . +260356)) (260389 276706 (MAKEBOLD.CHARSET 260399 . 264048) (MAKEBOLD.CHAR 264050 . 265802) ( +MAKEITALIC.CHARSET 265804 . 269477) (MAKEITALIC.CHAR 269479 . 271825) (\SFMAKEBOLD 271827 . 274051) ( +\SFMAKEITALIC 274053 . 276704)) (276707 280856 (\SFMAKEROTATEDFONT 276717 . 278118) (\SFROTATECSINFO +278120 . 278757) (\SFROTATEFONTCHARACTERS 278759 . 279139) (\SFROTATECSINFOOFFSETS 279141 . 280854)) ( +280857 282238 (\SFMAKECOLOR 280867 . 282236))))) STOP diff --git a/sources/FONT.LCOM b/sources/FONT.LCOM index 7cb640d7480d958c7df59956f5b5f07b2d4ed7f6..1006da09ce0ad458b2c84a540c95081142d5f993 100644 GIT binary patch delta 3499 zcmb7GU2G#)750qtL%fOC_Ika$PMY4$?xuFSo6fy6V~-3X zvp-0SAAHZ8d(OG%-gC}(&L3VMy7B#?mp7s+zL3BAu?s{YIwE92!wZ_Wz4c&R*OMqP zqbh@4#aPg_1vRt1Gr4-0KR-V|gBp*2`f3B+MP5tKBm;>hyJ+RAmRYm%Aas`_*_1Rn zrh^NHPE?I$rAckwtU4&LM9Z}tEjdZFP^nt$HeGWr~TQYN25+(9hu4q=Ra|?+5$FE8OMusqJ3~}mfLn`}) zp#BX!WmpH^)!~QOYr`5)KOZLSmF9649*M!%10yN+(UGJSXn$ekvwk)iIDNEa)^Y`Y zC_f1W*h=6cyRv@@MBWHIV>Jmfi$#QyaL%S>xLE~W9?ijmHI#=tf*Q~&s?wTS0}=j3 zkT3@nMvncckWheEvWuI@MnHPkOd|O^Cwx9XTdv&KszkH(>Bdid@Vnln(@%0D!2jyg zQauVBS*pkQ0_#b!0ugr!pr*P7e`joYjBA9X&Boq+jfR>%*o$?uG)iOiB#qOlkB`_# zgS*nZQp5kf#&$FQn6x6l6%NN}wB9;T=MFkkbncVff;hMnq;vlLF*+xVM)v)m*_A%O z(o>1m?@gm7G&-Z=Lc$U~Da;FdsTGNzAFr?9o3&9}?m2&1D#~xyQDflnt6du1N%;59 zghTvF=ercK_g0UMMn1 z{p_tr%=V9%t)FMVT#dD6xrMX!5FB4R*gHmJ<%4g*g9qP#4IVvo@Mft@gET~^CWiUj zKG&>A_9`^8EMB3#L?ex6qtSS3VubIuPjwf+K_liyqu%oJWwJ zQF{jTbOx2om4Ujhy2g=?Gss#ui%84ps5A=aAuW|*cqrBqsjq2iVFYPv$`gdD;C><1 z&^#iox?8FS$A~ScDPdJrymLs(01pn=C`n;-xnHqFO}iQdE+%YDW5Z)%urF9xQBfZ7 z$f`OP`=&D^>nV1_AuT}BMAbtMD2W9{xI0}$9i0^#%^ei(AH7blEUXs-8Rr22e) zAVLOYs=ZbFAT@=S5UAND^P=U{ph1>un-vRMg7kh!YCrwr6VmWA?dAqzzy8uIGm4v} z&Sq(mLX~I=0u{S_ao$>8gR)UGO8bQ`C!}fJtG$|4c6ft9D%{Mvzyyy;XrAgbo{^T+7 zD#qPjphZyqQ@ng zfyyvX4E!T*q#SeIw2S6q z(L&hZT5&&4DJ;}E0oW!`(y_}qT7_-68!f~5ffa)IgoQHNZ4qUk=xjU&Ii5z(CRW!d zjBV}(lg~nmtD}-{Bx^3_@?M(?KRzPDSP&r+)h+XwNx?hVZY;mTW`EFVy;ay+IU0oN zWUlbG5bR78rDnVthcU?KE7}{uaZZGU)r0mGJ7l%fg=O(6az*@Y?wu*TbA=0bCQ1YK zk}c$13xyk=KzSfgZV7>bR1*+Mh4vsSE-zwsp<>!qL{iYVcp2WpRJ~Df&=Gr)a7RHA zW&+LY4podrBGhYqx^_^n2kKB(RxMXJbTYKq+gUJ1ieS#?3RZ4~XDE#6B-2lF0)efUV4K) bax*JE&7QmYu=F77-c0%-joRaXsU-gk+}1rN delta 2847 zcma)8U2Gf25#}8w#-c2Sq$G-_6=x$WGAYaK-R>R#3OG8FCy^1!W$q}&bXC(y8JL0} zT(m_IpbvDLx1x2TY!UPiwUZWT(Ex>{GwYyE!v5r;MG>G61zI2~TJ)txfd+bLQxr&m z&h3#R75gD1a63CYGdnvo`|Z5_qmlhvBQHHYg;MA8&wcJ3mavL2&dBMEByV3m8&T94 z^3EZ3uqvlAM9L6(d*|d+!~A$WK8KpmeCfF+dVstl&BeUYm10TH8M;=}^C0wqE!m60 z$uR|7NXbOSY*{!dc-f_qnfXlB&^L;7-8`2EZBSMQ9!cqplE_F2TUk)7*M;+c`BVf&*PsDlru*=bLR zWjqO(ecltZzUz6x?JKRDg%w(k)n(iMqw_B0V3T5%FKwyT38gaUG(3z!6 z*A9(#e00fudyFoP*{tAeyKUk3<-S7rlPCz^eBE|)V+5);Gd!3 zIlEzm;$d5UzTxl5FC3MR9Lh%;@h)Akw;&N)WuX!5(phJd#cm^dRB!Q6Z_(C^+IsCp zTQAy}>e3MP9qdihF!djNpGIi#->=YFI(1;pQy=xyAf2M8CPwXWH;X(@Ke_v4$G6ss zT&#Bs;)UIhK3H40xbuN4nvgIm>*cI&AT_O`vbLu8D+j5H%-4`gB&2U>r8ZKfgu_yj zy)`A_tRaQ;m-;dU4BBdl^o2>^BI#K~q%Vw<#1Y17+SvkQAdXbLj4?)=wtxHrV5zsY zoa${YtJpCjlN2|?HfwXDoMhK)xDEbAE5(w16;w$+q?N>guaF`BkPI1;Awzb^kPKFp zzD+NZQv*XXA@+i`zww`hCx(Ro`d!w)zWJ?_vQ%XW%b?Zubph;uNrUe3}IQWS#B zno+E*#`UMx?GUDkb?l|60OzvLuV1L?6_a0el7J}pr-(rGie+t82W?#|*XmW>v?|-j zeZs5kGdIsX!iypBm}p<%mS52Lyxw^Tiel$|_MMy2d7jK;wlPT-=y>`I;5#92eTjG%~4C>({V}l%#^zD-bE9B*0;Nn2h|Cu>ybn~ zBq6muE(XOuNfcDkj8zlKi4@>%37(l+dA(FCB3TB|4MJ|J2CbqLK_$(EkR;eYf4(rK zrci}ebjWMkA#f_ev^yuolw=P=f-T>foyJMDY3iEM19^DEOoZ8E`%@t-r5!}qHnd_% z%a(K~u_UNQ+;W1jU*4HnN%abdzZbBq%7|7$pAoFWcY3*0?>0c8-L_ z%QoF-IeELm?!M7%zgf6ide~QQ?wu{X#f3T(<$=j^amz8ubA0gfuIqZyuUi|1Cpm)` zF8^F|cNSWE=L>+qjuk+_ff?%W+YuVRRWA{pG6ru6Ap8{1Z3I4Xau0LqC*QXw08pE$AS{G4YDih1k1iN?ImgwY7US= zV%NP>Zon@-;HM!K?i{$HSaq;azu;7h_5QtT?El!q!7%^; diff --git a/sources/HARDCOPY b/sources/HARDCOPY index 4011c002..9e7e0de2 100644 --- a/sources/HARDCOPY +++ b/sources/HARDCOPY @@ -1,12 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Sep-2025 17:08:34" {WMEDLEY}HARDCOPY.;47 148569 +(FILECREATED "19-Jan-2026 17:17:23" {WMEDLEY}HARDCOPY.;155 147674 :EDIT-BY rmk - :CHANGES-TO (FNS PRINTERDEVICE.OPENFN) + :CHANGES-TO (VARS HARDCOPYCOMS) + (FNS TEXT.TO.IMAGEFILE TEXTTOIMAGEFILE VIEWERPRINT PRINTERDEVICE.OPENFN + SEND.FILE.TO.PRINTER) - :PREVIOUS-DATE "11-Sep-2025 12:40:56" {WMEDLEY}HARDCOPY.;46) + :PREVIOUS-DATE "18-Jan-2026 15:20:21" {WMEDLEY}HARDCOPY.;149) (PRETTYCOMPRINT HARDCOPYCOMS) @@ -23,37 +25,38 @@ (PICASPERINCH (QUOTIENT PTSPERINCH PTSPERPICA)) (DEFAULTTAB (IQUOTIENT PTSPERINCH 2] (COMS (* ; "exported functionality") - (FNS HARDCOPY.SOMEHOW HARDCOPYIMAGEW HARDCOPYIMAGEW.TOFILE HARDCOPYIMAGEW.TOPRINTER - HARDCOPYREGION.TOFILE HARDCOPYREGION.TOPRINTER COPY.WINDOW.TO.BITMAP) - (* ; "user interface jazz") (INITVARS (ChangeDefaultPrinter)) (FNS MakeMenuOfPrinters PRINTERS.WHENSELECTEDFN MakeMenuOfImageTypes GetNewPrinterFromUser PopUpWindowAndGetAtom PopUpWindowAndGetList NewPrinter - GetPrinterName GetImageFile FetchDefaultPrinter) - (* ; "filename diddlers") - (FNS EXTENSIONS.FOR.PRINTFILETYPE PRINTFILETYPE.FROM.EXTENSION)) + GetPrinterName GetImageFile)) (COMS (* ;  "Interface for PRINTERS and IMAGEFILES") - (FNS DEFAULTPRINTER CAN.PRINT.DIRECTLY CONVERT.FILE.TO.TYPE.FOR.PRINTER EMPRESS - HARDCOPYW LISTFILES1 PRINTER.BITMAPFILE PRINTER.BITMAPSCALE PRINTER.SCRATCH.FILE - PRINTERPROP PRINTERSTATUS PRINTERTYPE PRINTERNAME PRINTFILEPROP PRINTFILETYPE - \EXPECTED.FILE.TYPE SEND.FILE.TO.PRINTER) - (FNS PRINTERDEVICE PRINTERDEVICE.OPENFN PRINTERDEVICE.CLOSEFN) - [DECLARE%: DONTEVAL@LOAD DOCOPY (P (PRINTERDEVICE 'LPT] + (FNS HARDCOPYW LISTFILES1 PRINTERPROP PRINTERSTATUS PRINTERTYPE PRINTERNAME + PRINTFILETYPE PRINTERTYPEP SEND.FILE.TO.PRINTER FIND.PRINTER.FOR.IMAGETYPE + CAN.PRINT.SOMEHOW CAN.PRINT.DIRECTLY) + [COMS (FNS PRINTERDEVICE PRINTERDEVICE.OPENFN PRINTERDEVICE.CLOSEFN PRINTERDEVICEP + PRINTERNAME) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (PRINTERDEVICE 'LPT] + (FNS DEFAULTPRINTERS) (INITVARS (DEFAULTPRINTINGHOST) - (DEFAULTPRINTERTYPE 'PDF) - (EMPRESS.SCRATCH) - (EMPRESS#SIDES T) - (PRINTFILETYPES NIL)) - (GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES - PRINTFILETYPES)) + (EMPRESS#SIDES T)) + (COMS (INITVARS (DEFAULTPRINTERTYPE 'VIEWER)) + (ADDVARS (PRINTERTYPES (VIEWER (CANPRINT (PDF HTML)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND VIEWERPRINT))) + (DEFAULTPRINTINGHOST (VIEWER VIEWER) + (UNIX UNIX))) + (FNS VIEWERPRINT)) + (GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES)) (FNS SCALEREGION) - (COMS (* ; + [COMS (* ;  "Converting text files to imagestreams") [INITVARS (TEXTDEFAULTPAGEREGION (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25 9.75] (GLOBALVARS TEXTDEFAULTPAGEREGION) - (FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE)) + (FNS TEXT.TO.IMAGEFILE COPY.TEXT.TO.IMAGE TEXTTOIMAGEFILE) + (P (DEFAULT.IMAGETYPE.CONVERSIONS '(TEXT TEXT.TO.IMAGEFILE] (COMS (* ;  "hack for printers that can't really BLTSHADE") (FNS \BLTSHADE.GENERICPRINTER)) @@ -121,152 +124,36 @@ (* ; "exported functionality") -(DEFINEQ - -(HARDCOPY.SOMEHOW - [LAMBDA (WINDOW FILE PRINTERTYPE IMAGETYPE) (* ; "Edited 26-Nov-96 15:59 by rmk:") - (* ; "Edited 13-Nov-87 14:16 by Snow") - - (* ;; "Either run window's HARDCOPYFN or run HARDCOPYW. The HARDCOPYFN can be a list of the form (fn heading) where heading=TITLE means use the window's title, otherwise using the non-nil heading.") - - (LET ((HARDCOPYFN (WINDOWPROP WINDOW 'HARDCOPYFN)) - HEADING) - (ALLOW.BUTTON.EVENTS) - (COND - ((NULL HARDCOPYFN) (* ; "knows how to default") - (HARDCOPYW WINDOW FILE NIL NIL NIL PRINTERTYPE)) - (T (CL:WHEN (AND (LISTP HARDCOPYFN) - (FNTYP (CAR HARDCOPYFN))) - (SETQ HEADING (CADR HARDCOPYFN)) - (CL:WHEN (EQ HEADING 'TITLE) - (SETQ HEADING (WINDOWPROP WINDOW 'TITLE))) - (SETQ HARDCOPYFN (CAR HARDCOPYFN))) - (CL:WITH-OPEN-STREAM [IMAGESTREAM (OPENIMAGESTREAM FILE (OR IMAGETYPE PRINTERTYPE) - (CL:WHEN HEADING - `(HEADING ,HEADING))] - (APPLY* HARDCOPYFN WINDOW IMAGESTREAM]) - -(HARDCOPYIMAGEW - [LAMBDA (W) (* ; "Edited 26-Aug-87 14:08 by Snow") - -(* ;;; "hardcopy this window to the DEFAULTPRINTINGHOST") - - (HARDCOPY.SOMEHOW W]) - -(HARDCOPYIMAGEW.TOFILE - [LAMBDA (W) (* ; "Edited 17-Jan-96 10:33 by rmk") - (LET ((FILE&TYPE (GetImageFile W))) - (if FILE&TYPE - then (HARDCOPY.SOMEHOW W (CAR FILE&TYPE) - (CDR FILE&TYPE]) - -(HARDCOPYIMAGEW.TOPRINTER - [LAMBDA (W) (* ; "Edited 18-Oct-2022 18:45 by lmm") - (* ; "Edited 22-Apr-98 16:19 by rmk:") - (* ; "Edited 11-Jul-90 13:55 by jds") - (LET ((PRINTERCHOICE (GetPrinterName)) - PRINTERTYPE IMAGETYPE) - [COND - ((LISTP PRINTERCHOICE) (* ; - "Got back a list, which is (TYPE NAME). Break it apart.") - (SETQ PRINTERTYPE (CAR PRINTERCHOICE)) - (SETQ PRINTERCHOICE (CADR PRINTERCHOICE))) - (PRINTERCHOICE (* ; "Got back just a name.") - (SETQ PRINTERTYPE (PRINTERTYPE PRINTERCHOICE] - (SETQ PRINTERTYPE (PRINTERTYPE PRINTERCHOICE)) - (COND - (PRINTERCHOICE (HARDCOPY.SOMEHOW W (CONCAT "{LPT}" PRINTERCHOICE) - PRINTERTYPE - (OR IMAGETYPE (CAR (PRINTERPROP PRINTERTYPE 'CANPRINT)) - PRINTERTYPE]) - -(HARDCOPYREGION.TOFILE - [LAMBDA NIL (* ; "Edited 26-Aug-87 14:08 by Snow") - (LET ((FILE&TYPE (GetImageFile))) - (if FILE&TYPE - then (PROG (REGION) - (SPAWN.MOUSE) - (PROMPTPRINT "Select a region") - (SETQ REGION (GETREGION)) - (CLRPROMPT) - (HARDCOPYW REGION (CAR FILE&TYPE) - NIL NIL NIL (CDR FILE&TYPE]) - -(HARDCOPYREGION.TOPRINTER - [LAMBDA NIL (* ; "Edited 13-Jul-90 01:57 by jds") - (LET ((PRINTERCHOICE (GetPrinterName)) - PRINTERTYPE) - [COND - ((LISTP PRINTERCHOICE) (* ; - "Got back a list, which is (TYPE NAME). Break it apart.") - (SETQ PRINTERTYPE (CAR PRINTERCHOICE)) - (SETQ PRINTERCHOICE (CADR PRINTERCHOICE))) - (PRINTERCHOICE (* ; "Got back just a name.") - (SETQ PRINTERTYPE (PRINTERTYPE PRINTERCHOICE] - (COND - (PRINTERCHOICE (PROG (REGION) - (SPAWN.MOUSE) - (PROMPTPRINT "Select a region") - (SETQ REGION (GETREGION)) - (CLRPROMPT) - (HARDCOPYW REGION (PACK* '{LPT} PRINTERCHOICE) - NIL NIL NIL (PRINTERTYPE PRINTERCHOICE]) - -(COPY.WINDOW.TO.BITMAP - [LAMBDA (WINDOW) (* ; "Edited 26-Aug-87 14:09 by Snow") - -(* ;;; "copies contents of window (including title and border) into a bitmap") - - (COND - ((OPENWP WINDOW) - (PROG (REGION SCREEN LEFT BOTTOM WIDTH HEIGHT BITMAP) - (SETQ REGION (WINDOWPROP WINDOW 'REGION)) - (SETQ SCREEN (WINDOWPROP WINDOW 'SCREEN)) - (SETQ LEFT (fetch (REGION LEFT) of REGION)) - (SETQ BOTTOM (fetch (REGION BOTTOM) of REGION)) - (SETQ WIDTH (fetch (REGION WIDTH) of REGION)) - (SETQ HEIGHT (fetch (REGION HEIGHT) of REGION)) - (SETQ BITMAP (BITMAPCREATE WIDTH HEIGHT (BITSPERPIXEL WINDOW))) - (.WHILE.TOP.DS. WINDOW (BITBLT (SCREENBITMAP SCREEN) - LEFT BOTTOM BITMAP 0 0 WIDTH HEIGHT)) - (RETURN BITMAP))) - (T (BITMAPCOPY (WINDOWPROP WINDOW 'IMAGECOVERED]) -) - - - -(* ; "user interface jazz") - (RPAQ? ChangeDefaultPrinter ) (DEFINEQ (MakeMenuOfPrinters - [LAMBDA (MENUTITLE) (* ; "Edited 22-Jun-2023 17:30 by rmk") + [LAMBDA (MENUTITLE) (* ; "Edited 17-Dec-2025 00:58 by rmk") + (* ; "Edited 6-Dec-2025 09:52 by rmk") + (* ; "Edited 22-Jun-2023 17:30 by rmk") (* ; "Edited 29-May-93 14:18 by rmk:") (* ; "Edited 11-Jul-90 13:35 by jds") - (DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) - (CREATE MENU - ITEMS _ (APPEND (FOR P INSIDE DEFAULTPRINTINGHOST - COLLECT (LIST (COND - ((LISTP P) - (IF (CADDR P) - THEN (CONCAT (CADR P) - " " - (CADDR P)) - ELSE (CADR P))) - (T (CL:IF (OR (NULL P) - (ZEROP (NCHARS P))) - "(Default printer)" - P))) - (KWOTE P))) - (LIST (LIST "Other..." (KWOTE 'OTHER) - "You will be prompted for a printer"))) + (create MENU + ITEMS _ `(("(Default printer)" (KWOTE :DEFAULTPRINTER)) + ,@(for P in (DEFAULTPRINTERS) when P unless (EQ P :DEFAULTPRINTER) + collect (* ; "Skipped the NIL %"%" defaults") + (LIST (CL:IF (LISTP P) + (CL:IF (CADDR P) + (CONCAT (CADR P) + " " + (CADDR P)) + (CADR P)) + P) + (KWOTE P))) + ("Other..." 'OTHER "You will be prompted for a printer")) TITLE _ MENUTITLE WHENSELECTEDFN _ (FUNCTION PRINTERS.WHENSELECTEDFN]) (PRINTERS.WHENSELECTEDFN - [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 16-Apr-2018 22:14 by rmk:") + [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 28-Dec-2025 00:38 by rmk") + (* ; "Edited 17-Dec-2025 00:46 by rmk") + (* ; "Edited 16-Apr-2018 22:14 by rmk:") (DECLARE (GLOBALVARS ChangeDefaultPrinter)) (* ;; "Fix Menu so that it doesn't ask about changing the default unless you click with middle") @@ -276,7 +163,8 @@ [COND ((EQ PRINTERCHOICE 'OTHER) (SETQ PRINTERCHOICE (GetNewPrinterFromUser] - (CL:WHEN [AND PRINTERCHOICE (NEQ PRINTERCHOICE (SETQ DEFAULTPRINTER (FetchDefaultPrinter] + (CL:WHEN [AND PRINTERCHOICE (NEQ PRINTERCHOICE (SETQ DEFAULTPRINTER (CAR (DEFAULTPRINTERS + NIL T] [NewPrinter PRINTERCHOICE (AND DEFAULTPRINTER (EQ BUTTON 'MIDDLE) (MENU (OR ChangeDefaultPrinter (SETQ ChangeDefaultPrinter @@ -308,13 +196,14 @@ TITLE _ MENUTITLE]) (GetNewPrinterFromUser - [LAMBDA (PROMPTSTRING) (* ; "Edited 7-Jun-93 15:33 by rmk:") + [LAMBDA (PROMPTSTRING) (* ; "Edited 25-Dec-2025 08:22 by rmk") + (* ; "Edited 7-Jun-93 15:33 by rmk:") (* ; "Edited 26-Aug-87 14:10 by Snow") (* ;;  "Changed from PopUpWindowAndGetAtom, so user can enter PRINTERTYPE PRINTERNAME PREFERREDIMAGETYPE.") - (PopUpWindowAndGetList (OR PROMPTSTRING "Printer (CR to abort): "]) + (PopUpWindowAndGetList (OR PROMPTSTRING "Printer name (CR to abort): "]) (PopUpWindowAndGetAtom [LAMBDA (PROMPTSTRING CANDIDATE) (* ; "Edited 6-Mar-2024 13:15 by rmk") @@ -368,32 +257,29 @@ (CAR RESPONSE))])]) (NewPrinter - [LAMBDA (PRINTER NEW-DEFAULT?) (* ; "Edited 11-Jul-90 13:48 by jds") + [LAMBDA (PRINTER NEW-DEFAULT?) (* ; "Edited 17-Dec-2025 01:00 by rmk") + (* ; "Edited 6-Dec-2025 10:01 by rmk") + (* ; "Edited 11-Jul-90 13:48 by jds") (* ;;; "If Printer is unknown it will be added to DEFAULTPRINTINGHOST. In addition, if NEW-DEFAULT? is true the printer will be pushed to the head of DEFAULTPRINTINGHOST, thus making it the default printer.") (DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) - (CL:WHEN (NOT (LISTP DEFAULTPRINTINGHOST)) (* ; - "If DEFAULTPRINTINGHOST Is an atom ") - (SETQ DEFAULTPRINTINGHOST (LIST DEFAULTPRINTINGHOST))) - (LET* ((PRINTER-NAME (COND - ((LISTP PRINTER) - (CADR PRINTER)) - (T PRINTER))) - [MEMBER? (CL:MEMBER PRINTER-NAME DEFAULTPRINTINGHOST :TEST - '(LAMBDA (PRINTER ENTRY) - (STRING-EQUAL PRINTER (CL:IF (LISTP ENTRY) - (CADR ENTRY) - ENTRY)] - (ENTRY (CL:IF MEMBER? - (CAR MEMBER?) - PRINTER))) - (CL:IF NEW-DEFAULT? - (SETQ DEFAULTPRINTINGHOST (CONS ENTRY (REMOVE ENTRY DEFAULTPRINTINGHOST))) - (CL:IF (NOT MEMBER?) - (RPLACD (LAST DEFAULTPRINTINGHOST) - (CONS ENTRY)))) - DEFAULTPRINTINGHOST]) + (CL:UNLESS (EQ :DEFAULTPRINTER PRINTER) + [LET* ((PRINTERS (DEFAULTPRINTERS)) + (PRINTER-NAME (CL:IF (LISTP PRINTER) + (CADR PRINTER) + PRINTER)) + [MEMBER? (CL:MEMBER PRINTER-NAME PRINTERS :TEST '(LAMBDA (PRINTER ENTRY) + (STRING-EQUAL PRINTER + (CL:IF (LISTP ENTRY) + (CADR ENTRY) + ENTRY)] + (ENTRY (CL:IF MEMBER? + (CAR MEMBER?) + PRINTER))) + (SETQ DEFAULTPRINTINGHOST (CL:IF NEW-DEFAULT? + (CONS ENTRY (REMOVE ENTRY PRINTERS)) + (NCONC1 PRINTERS ENTRY))])]) (GetPrinterName [LAMBDA NIL (* ; "Edited 29-May-93 13:58 by rmk:") @@ -401,66 +287,39 @@ (MENU (MakeMenuOfPrinters "Which printer?"]) (GetImageFile - [LAMBDA (W) (* ; "Edited 10-Sep-2025 14:50 by rmk") - (* ; "Edited 27-Apr-98 16:44 by rmk:") + [LAMBDA (FILEORW) (* ; "Edited 4-Nov-2025 22:43 by rmk") + (* ; "Edited 3-Nov-2025 19:52 by rmk") + (* ; "Edited 19-Sep-2025 08:07 by rmk") + (* ; "Edited 10-Sep-2025 14:50 by rmk") (* ; "Edited 18-Jan-96 11:17 by ") (* ; "Edited 17-Jan-96 10:42 by rmk") - (PROG (FILE PRINTFILETYPE FILETYPEMENU) - (* ;; "Strip candidate version so overwrites must be explicitly indicated each time. Use previous file as candidate, and if no previous one, apply function associated with the window to the window and the extension associated with the defaultprinting host. Such a function on a TEDIT window, for example, could suggest the image-type file named after the underlying TEDIT file.") + (* ;; " If FILEORW is a window, its HARDCOPY properties are used to create the menu's candidate filename. Otherwise, it is taken to already be the candidate. Returns NIL if the imagefile/type are not determined.") - [SETQ FILE (PopUpWindowAndGetAtom - "File name (Clear to abort): " - (OR [AND (WINDOWPROP W 'HARDCOPYFILE) - (PACKFILENAME 'VERSION NIL 'BODY (WINDOWPROP W 'HARDCOPYFILE] - (AND (WINDOWPROP W 'HARDCOPYFILEFN) - (APPLY* (WINDOWPROP W 'HARDCOPYFILEFN) - W - (CAR (EXTENSIONS.FOR.PRINTFILETYPE (OR (CADDR (LISTP ( - DEFAULTPRINTER - ))) - (PRINTERTYPE] - (CL:UNLESS (AND FILE (SETQ FILE (OUTFILEP FILE))) (* ; "Keep directory etc for reuse") - (RETURN)) - (WINDOWPROP W 'HARDCOPYFILE FILE) (* ; - "Save previous input for next candidate") - (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]) + (LET (IMAGEFILE IMAGEFILETYPE) -(FetchDefaultPrinter - [LAMBDA NIL (* ; "Edited 26-Aug-87 14:11 by Snow") - (LET ((P (DEFAULTPRINTER))) - (COND - ((LISTP P) - (CADR P)) - (T P]) -) + (* ;; "Strip candidate version so overwrites must be explicitly indicated each time. Use previous file as candidate, and if no previous one, apply function associated with the window to the window and the extension associated with the defaultprinting host. Such a function on a TEDIT window, for example, could suggest the image-type file named after the underlying TEDIT file.") - - -(* ; "filename diddlers") - -(DEFINEQ - -(EXTENSIONS.FOR.PRINTFILETYPE - [LAMBDA (TYPE) (* ; "Edited 10-Sep-2025 14:43 by rmk") - (* ; "Edited 26-Aug-87 14:11 by Snow") - (DECLARE (GLOBALVARS PRINTFILETYPES)) - (CAR (MKLIST (GETMULTI PRINTFILETYPES TYPE 'EXTENSION]) - -(PRINTFILETYPE.FROM.EXTENSION - [LAMBDA (FILE) (* ; "Edited 26-Aug-87 14:11 by Snow") - (* ; - "return the imagestream type corresponding to the extension") - (bind [EXT _ (U-CASE (FILENAMEFIELD FILE 'EXTENSION] for TYPE in PRINTFILETYPES - when [FMEMB EXT (CADR (ASSOC 'EXTENSION (CDR TYPE] do (RETURN (CAR TYPE]) + (SETQ IMAGEFILE (PopUpWindowAndGetAtom "File name (Clear to abort): " + (if (WINDOWP FILEORW) + then (CLEARW (GETPROMPTWINDOW FILEORW)) + [if (WINDOWPROP FILEORW 'HARDCOPYFILE) + then (PACKFILENAME 'VERSION NIL 'BODY + (WINDOWPROP FILEORW 'HARDCOPYFILE)) + elseif (WINDOWPROP FILEORW 'HARDCOPYFILEFN) + then (APPLY* (WINDOWPROP FILEORW 'HARDCOPYFILEFN) + FILEORW + (CAR (EXTENSIONS.FOR.IMAGEFILETYPE ( + PRINTERTYPE + ] + else FILEORW))) + (CL:WHEN [AND IMAGEFILE (SETQ IMAGEFILE (OUTFILEP IMAGEFILE)) + (SETQ IMAGEFILETYPE (OR (IMAGEFILETYPE.FROM.EXTENSION IMAGEFILE) + (MENU (MakeMenuOfImageTypes "File type?"] + (CL:WHEN (WINDOWP FILEORW) (* ; + "Save full name less version for reuse") + (WINDOWPROP FILEORW 'HARDCOPYFILE (PACKFILENAME 'VERSION NIL 'BODY IMAGEFILE))) + (CONS IMAGEFILE IMAGEFILETYPE))]) ) @@ -469,161 +328,35 @@ (DEFINEQ -(DEFAULTPRINTER - [LAMBDA NIL (* ; "Edited 26-Aug-87 14:11 by Snow") - (COND - ((LISTP DEFAULTPRINTINGHOST) - (CAR DEFAULTPRINTINGHOST)) - (T DEFAULTPRINTINGHOST]) - -(CAN.PRINT.DIRECTLY - [LAMBDA (PRINTERTYPE FILETYPE) (* ; "Edited 26-Aug-87 14:11 by Snow") - (FMEMB FILETYPE (PRINTERPROP PRINTERTYPE 'CANPRINT]) - -(CONVERT.FILE.TO.TYPE.FOR.PRINTER - [LAMBDA (FILE FILETYPE PRINTERTYPE HEADING PRINTOPTIONS) (* ; "Edited 24-Sep-2023 15:25 by rmk") - (* ; "Edited 14-Sep-2023 22:58 by rmk") - (* ; "Edited 29-Dec-88 15:39 by jds") - - (* ;; "Convert FILE to the kind of hardcopy file (Interpress, Press, 4045HQ, etc) appropriate to PRINTERTYPE.") - - (SETQ FILETYPE (OR FILETYPE 'TEXT)) - (PROG [(SCRATCH (CLOSEF (OPENSTREAM (PRINTER.SCRATCH.FILE FILE PRINTERTYPE) - 'OUTPUT - 'NEW] (* ; - "Doing the open & close gets us a guaranteed version number, so that all files are truly unique.") - (APPLY* (OR (LISTGET (PRINTERPROP PRINTERTYPE 'CONVERSION) - FILETYPE) - (for CANPRINT in (PRINTERPROP PRINTERTYPE 'CANPRINT) bind CONVERTER - when (SETQ CONVERTER (LISTGET (PRINTFILEPROP CANPRINT 'CONVERSION) - FILETYPE)) do (RETURN CONVERTER)) - (ERROR (CONCAT "Can't convert a " FILETYPE " for a " PRINTERTYPE " printer") - (FULLNAME FILE))) - FILE SCRATCH (LISTGET PRINTOPTIONS 'FONTS) - HEADING NIL PRINTOPTIONS) - (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (SCRATCH) - (CLOSEF? SCRATCH) - (DELFILE SCRATCH] - SCRATCH)) - (RETURN SCRATCH]) - -(EMPRESS - [LAMBDA (FILE %#COPIES HOST HEADING %#SIDES PRINTOPTIONS) (* ; "Edited 26-Aug-87 14:17 by Snow") - (SEND.FILE.TO.PRINTER FILE HOST (NCONC (COND - (HEADING (LIST 'HEADING HEADING))) - (COND - (%#COPIES (LIST '%#COPIES %#COPIES))) - (COND - (%#SIDES (LIST '%#SIDES %#SIDES))) - PRINTOPTIONS]) - (HARDCOPYW [LAMBDA (WINDOW/BITMAP/REGION FILE HOST SCALEFACTOR ROTATION PRINTERTYPE HARDCOPYTITLE) - (* ; "Edited 31-Aug-89 10:05 by jds") - - (* ;; "Makes a hard copy of a window, bitmap, or region of the screen.") - - (* ;; "") - - (* ;; "WINDOW/BITMAP/REGION can be a WINDOW, a REGION, a BITMAP, or NIL = select region. If FILE supplied, output goes there. If HOST supplied, it is printed. If neither FILE nor HOST supplied, default is to print; if HARDCOPYTITLE is supplied it will be used as the document title of the hardcopy file created. If it isn't, 'Window Image' is used.") - - (PROG (PRINTHOST BITMAP SCREENREGION REGION FULLFILE) - (SETQ PRINTHOST HOST) - [COND - ((WINDOWP WINDOW/BITMAP/REGION) - (SETQ BITMAP (COPY.WINDOW.TO.BITMAP WINDOW/BITMAP/REGION))) - ((BITMAPP WINDOW/BITMAP/REGION) - (SETQ BITMAP WINDOW/BITMAP/REGION)) - ((type? REGION WINDOW/BITMAP/REGION) - (SETQ BITMAP (SCREENBITMAP)) - (SETQ REGION WINDOW/BITMAP/REGION)) - (T (SETQ SCREENREGION (GETSCREENREGION)) - (SETQ BITMAP (SCREENBITMAP (fetch (SCREENREGION SCREEN) of SCREENREGION))) - (SETQ REGION (fetch (SCREENREGION REGION) of SCREENREGION] - RETRY - (COND - [PRINTERTYPE (COND - [PRINTHOST (COND - ((NOT (EQ PRINTERTYPE (PRINTERTYPE PRINTHOST))) - (ERROR PRINTHOST (CONCAT "not of printer type " - PRINTERTYPE)) - (GO RETRY] - (FILE (* ; - "don't need a PRINTHOST if you give a file") - ) - [(SETQ PRINTHOST (find HOST inside DEFAULTPRINTINGHOST - suchthat (EQ PRINTERTYPE (PRINTERTYPE HOST] - (T (ERROR - "Can't find a printing host in DEFAULTPRINTINGHOST that is of type " - PRINTERTYPE) - (GO RETRY] - (PRINTHOST (SETQ PRINTERTYPE (PRINTERTYPE PRINTHOST))) - (DEFAULTPRINTINGHOST (SETQ PRINTHOST (DEFAULTPRINTER)) - (SETQ PRINTERTYPE (PRINTERTYPE PRINTHOST))) - [FILE (COND - ((NOT (SETQ PRINTERTYPE (PRINTFILETYPE FILE T))) - (ERROR FILE "Can't tell what kind of print file to produce -- PRINTERTYPE, DEFAULTPRINTERTYPE, DEFAULTPRINTINGHOST all NIL" - ) - (GO RETRY] - (T (ERROR "Can't tell where to send window image -- HOST, DEFAULTPRINTINGHOST are NIL") - (GO RETRY))) - [COND - ((NOT SCALEFACTOR) - [SETQ SCALEFACTOR (COND - (REGION (PRINTER.BITMAPSCALE (fetch (REGION WIDTH) of REGION) - (fetch (REGION HEIGHT) of REGION) - PRINTERTYPE PRINTHOST)) - (T (PRINTER.BITMAPSCALE (fetch (BITMAP BITMAPWIDTH) of BITMAP) - (fetch (BITMAP BITMAPHEIGHT) of BITMAP) - PRINTERTYPE PRINTHOST] - (COND - ((LISTP SCALEFACTOR) - (SETQ ROTATION (CDR SCALEFACTOR)) - (SETQ SCALEFACTOR (CAR SCALEFACTOR] - (SETQ FULLFILE (PRINTER.BITMAPFILE (OR FILE (PRINTER.SCRATCH.FILE)) - PRINTERTYPE BITMAP SCALEFACTOR REGION ROTATION (OR HARDCOPYTITLE - "Window Image"))) - [COND - ((OR HOST (NULL FILE)) - (ADD.PROCESS `[PROGN [,(PRINTERPROP PRINTERTYPE 'SEND) - ',(COND - ((LISTP PRINTHOST) - (CADR PRINTHOST)) - (T PRINTHOST)) - ',FULLFILE - '(DELETE ,(NULL FILE) - DOCUMENT.NAME - ,(OR HARDCOPYTITLE "Window Image"] - ,(AND (NULL FILE) - `(DELFILE ',FULLFILE] - 'NAME - 'HARDCOPYW] - (RETURN (AND FILE FULLFILE]) + (* ; "Edited 11-Jan-2026 13:08 by rmk") + (* ; "Edited 28-Dec-2025 01:06 by rmk") + (if HOST + then (if (NULL PRINTERTYPE) + then (SETQ PRINTERTYPE (PRINTERTYPE HOST)) + elseif (NEQ PRINTERTYPE (PRINTERTYPE HOST)) + then (ERROR HOST (CONCAT "is not of printer type " PRINTERTYPE))) + elseif (NULL FILE) + then (SETQ HOST (OR (CAR (OR (DEFAULTPRINTERS PRINTERTYPE) + (DEFAULTPRINTERS))) + :DEFAULTPRINTER)) + (SETQ PRINTERTYPE (PRINTERTYPE HOST)) + else (SETQ PRINTERTYPE (PRINTERTYPE :DEFAULTPRINTER))) + (LET ([OPTIONS `(SCALEFACTOR ,SCALEFACTOR ROTATION ,ROTATION DOCUMENT.NAME + ,(OR HARDCOPYTITLE "Window Image"] + IMAGEFILE PRINTER) + (SETQ IMAGEFILE (CONVERT.TO.IMAGEFILE WINDOW/BITMAP/REGION FILE + [OR (IMAGEFILETYPE.FROM.EXTENSION FILE) + (CAR (PRINTERPROP PRINTERTYPE 'CANPRINT] + OPTIONS)) + (CL:WHEN HOST (SEND.FILE.TO.PRINTER IMAGEFILE HOST OPTIONS)) + IMAGEFILE]) (LISTFILES1 [LAMBDA (FILE PRINTOPTIONS) (* ; "Edited 26-Aug-87 14:17 by Snow") (SEND.FILE.TO.PRINTER FILE NIL PRINTOPTIONS]) -(PRINTER.BITMAPFILE - [LAMBDA (FILE PRINTERTYPE BITMAP SCALEFACTOR REGION ROTATION TITLE) - (* ; "Edited 26-Aug-87 14:19 by Snow") - (* ; "convert a bitmap into a file") - (DECLARE (SPECVARS . T)) - (EVAL (PRINTERPROP PRINTERTYPE 'BITMAPFILE]) - -(PRINTER.BITMAPSCALE - [LAMBDA (WIDTH HEIGHT PRINTERTYPE HOST) (* ; "Edited 26-Aug-87 14:19 by Snow") - (* ; - "could ask the host what size paper it has") - (PROG NIL - (RETURN (APPLY* (OR (PRINTERPROP PRINTERTYPE 'BITMAPSCALE) - (RETURN 1)) - WIDTH HEIGHT HOST]) - -(PRINTER.SCRATCH.FILE - [LAMBDA (FULLFILE) (* ; "Edited 26-Aug-87 14:20 by Snow") - '{SCRATCH}PRINTER-SCRATCH-FILE]) - (PRINTERPROP [LAMBDA (PRINTERTYPE PROP) (* ; "Edited 26-Aug-87 14:20 by Snow") (for X in PRINTERTYPES when (EQMEMB PRINTERTYPE (CAR X)) @@ -636,284 +369,459 @@ (AND STATUSFN (APPLY* STATUSFN PRINTER]) (PRINTERTYPE - [LAMBDA (HOST) (* ; "Edited 27-Apr-98 16:16 by rmk:") + [LAMBDA (HOST PREFERRED NODEFAULT) (* ; "Edited 18-Jan-2026 14:47 by rmk") + (* ; "Edited 16-Jan-2026 07:35 by rmk") + (* ; "Edited 17-Dec-2025 00:52 by rmk") + (* ; "Edited 14-Dec-2025 17:53 by rmk") + (* ; "Edited 12-Dec-2025 22:37 by rmk") + (* ; "Edited 5-Dec-2025 12:51 by rmk") + (* ; "Edited 19-Sep-2025 10:18 by rmk") + (* ; "Edited 27-Apr-98 16:16 by rmk:") (* ; "Edited 15-Feb-91 14:14 by gadener") - (* ;; "Attempt to deduce the printer type of HOST.") + (* ;; + "We uppercase before we look at the printer HOSTNAMEP functions--they can handle the casing") - (SELECTQ HOST - ((NIL LPT) - (SETQ HOST (DEFAULTPRINTER))) - NIL) + (SETQ HOST (MKATOM HOST)) (COND - [(CAR (LISTP HOST)) - - (* ;; "Is a pair (type hostname) or maybe a triple of the form (printertype hostname preferred-imagetype). Check that type is one we know about.") - - (LET ((TYPE (CAR HOST))) - (COND - ((for X in PRINTERTYPES thereis (EQMEMB TYPE (CAR X))) - TYPE) - (T (ERROR "Undefined printer-type:" TYPE] ((NULL HOST) DEFAULTPRINTERTYPE) - ((GETPROP (MKATOM HOST) - 'PRINTERTYPE)) + ((LISTP HOST) + + (* ;; "A pair (type hostname) or maybe a triple of the form (printertype hostname preferred-imagetype). Check that type is one we know about.") + + (LET ((TYPE (CAR HOST))) + (CL:UNLESS (PRINTERTYPEP TYPE) + (ERROR TYPE "is an undefined printer type")) + TYPE)) + [(OR (GETPROP HOST 'PRINTERTYPE) + (GETPROP (U-CASE HOST) + 'PRINTERTYPE] ((GETPROP (SETQ HOST (OR (CANONICAL.HOSTNAME HOST) HOST)) 'PRINTERTYPE)) - [(for TYPE in PRINTERTYPES bind FN when (AND (SETQ FN (CDR (ASSOC 'HOSTNAMEP TYPE))) - (APPLY* (CAR FN) + [(for TYPE FN in PRINTERTYPES when (AND (SETQ FN (CDR (ASSOC 'HOSTNAMEP TYPE))) + (APPLY* (CAR FN) + HOST)) do + + (* ;; "Try the predicates for each printer type for recognizing their own host names. This gets the colon for NS/Interpress printers") + + (RETURN (CAAR TYPE] + [(for PRINTER in (DEFAULTPRINTERS) when (AND (LISTP PRINTER) + (STRING-EQUAL (CADR PRINTER) HOST)) do - (* ; - "Try the predicates for each printer type for recognizing their own host names") - (RETURN (CAAR TYPE] - [(for PRINTER in (MKLIST DEFAULTPRINTINGHOST) do (* ;;  "Try looking for literal match before doing canonical hostname, cause that may be expensive.") - (COND - ((AND (LISTP PRINTER) - (STRING-EQUAL (CADR PRINTER) - HOST)) - (RETURN (CAR PRINTER] - [(for PRINTER in (MKLIST DEFAULTPRINTINGHOST) - do (COND - ((AND (LISTP PRINTER) - (STRING-EQUAL (OR (CANONICAL.HOSTNAME (CADR PRINTER)) - (CADR PRINTER)) - HOST)) - (RETURN (CAR PRINTER] - (T DEFAULTPRINTERTYPE]) + (RETURN (CAR PRINTER] + [(for PRINTER in (DEFAULTPRINTERS) when (AND (LISTP PRINTER) + (STRING-EQUAL (OR (CANONICAL.HOSTNAME + (CADR PRINTER)) + (CADR PRINTER)) + HOST)) do (RETURN (CAR PRINTER] + ((NOT NODEFAULT) + DEFAULTPRINTERTYPE]) (PRINTERNAME - [LAMBDA (PRINTER-SPEC) (* ; "Edited 26-Nov-86 13:51 by hdj") + [LAMBDA (PRINTER) (* ; "Edited 5-Dec-2025 09:35 by rmk") + (* ; "Edited 19-Sep-2025 09:59 by rmk") - (* ;; "takes a printer-spec (in form (type printer-name) or just printer-name) and returns printer-name. returns nil for null arg.") + (* ;; + "If PRINTER designates a printer (a printer-spec or stream/filename, returns the printer's name.") - (AND PRINTER-SPEC (if (LISTP PRINTER-SPEC) - then (CADR PRINTER-SPEC) - else PRINTER-SPEC]) + (* ;; "Takes a printer-spec (in form (type printer-name) or just printer-name) and returns printer-name. returns nil for null arg.") -(PRINTFILEPROP - [LAMBDA (PRINTFILETYPE PROP) (* ; "Edited 26-Aug-87 14:22 by Snow") - (for X in PRINTFILETYPES when (EQMEMB PRINTFILETYPE (CAR X)) - do (RETURN (CADR (ASSOC PROP (CDR X]) + (CL:WHEN (LISTP PRINTER) + (SETQ PRINTER (CADR PRINTER))) + (CL:WHEN (PRINTERDEVICEP PRINTER) + [LET (FDEV) + (if (AND (STREAMP PRINTER) + (STREAMPROP PRINTER 'PRINTERNAME)) + else (SETQ FDEV (TRUEDEVICE PRINTER)) + (if (EQ 'LPT (fetch (FDEV DEVICENAME) of FDEV)) + then (CL:UNLESS [EQ '%. (SETQ PRINTER (FILENAMEFIELD PRINTER 'NAME] + PRINTER) + else (fetch (FDEV DEVICENAME) of FDEV])]) (PRINTFILETYPE - [LAMBDA (FILE DONTOPEN) (* ; "Edited 3-Mar-93 14:34 by rmk:") - (* ; "Edited 22-Aug-92 14:27 by jds") - (* ; "Edited 26-Aug-87 14:22 by Snow") - (COND - ((IMAGESTREAMP FILE) - (IMAGESTREAMTYPE FILE)) - (T (LET* [(HOST (FILENAMEFIELD FILE 'HOST)) - (TYPE (GETFILEINFO FILE 'TYPE] - (COND - ((AND TYPE (ASSOC TYPE PRINTFILETYPES)) + [LAMBDA (FILE DONTOPEN) (* ; "Edited 24-Dec-2025 20:39 by rmk") + (* ; "Edited 18-Sep-2025 11:22 by rmk") + (* ; "For backward compatibility") + (IMAGESOURCETYPE FILE DONTOPEN]) - (* ;; "Type is in PRINTFILETYPES, so it's OK.") - - TYPE) - ((PRINTFILETYPE.FROM.EXTENSION FILE)) - [(NOT DONTOPEN) - (RESETLST - [COND - ((STRINGP FILE) (* ; - "Yecch, OPENP of a string interprets string as a string stream!") - (SETQ FILE (MKATOM FILE] - [COND - ((NOT (OPENP FILE 'INPUT)) (* ; - "Open file so testers don't have to repeatedly open and close it") - (SETQ FILE (OPENSTREAM FILE 'INPUT)) - (RESETSAVE NIL (LIST 'CLOSEF? FILE] - [COND - ((RANDACCESSP FILE) - (for TYPE in PRINTFILETYPES - when (CAR (NLSETQ (APPLY* (CADR (ASSOC 'TEST (CDR TYPE))) - FILE))) do (RETURN (CAR TYPE])] - ((EQ TYPE 'TEXT) - - (* ;; "This is AFTER the above clauses, so we catch PS files, which are type TEXT. Other formats might be lost as well....") - - TYPE]) - -(\EXPECTED.FILE.TYPE - [LAMBDA (FILE) (* ; "Edited 28-Jun-99 16:36 by rmk:") - (* ; "Edited 27-Oct-90 18:14 by nm") - - (* ;; "rmk: This is called by SEND.FILE.TO.PRINTER to somehow guess the TYPE parameter of the file in Maiko. I don't see the point of this. Eventually, the call to this function and even its definition should be removed, but nuking it is just as effective.") - - (AND NIL (EQ \MACHINETYPE \MAIKO) - FileTypeConfirmFlg - (LET [(HOST (UNPACKFILENAME.STRING FILE 'HOST] - (AND (OR (STRING-EQUAL HOST "DSK") - (STRING-EQUAL HOST "UNIX")) - `((TYPE ,(\UFSGetPrintFileType FILE]) +(PRINTERTYPEP + [LAMBDA (X) (* ; "Edited 5-Dec-2025 12:23 by rmk") + (CL:WHEN (for PTYPE in PRINTERTYPES thereis (EQMEMB X (CAR PTYPE))) + X]) (SEND.FILE.TO.PRINTER - [LAMBDA (FILE HOST PRINTOPTIONS) (* ; "Edited 21-Jan-93 11:34 by jds") + [LAMBDA (IMAGESOURCE HOST OPTIONS) (* ; "Edited 19-Jan-2026 08:40 by rmk") + (* ; "Edited 17-Jan-2026 00:32 by rmk") + (* ; "Edited 27-Dec-2025 23:06 by rmk") + (* ; "Edited 23-Dec-2025 15:33 by rmk") + (* ; "Edited 21-Dec-2025 09:03 by rmk") + (* ; "Edited 14-Dec-2025 15:48 by rmk") + (* ; "Edited 11-Dec-2025 23:56 by rmk") + (* ; "Edited 7-Dec-2025 11:08 by rmk") + (* ; "Edited 5-Dec-2025 14:41 by rmk") + (* ; "Edited 27-Sep-2025 07:43 by rmk") + (* ; "Edited 25-Sep-2025 21:34 by rmk") + (* ; "Edited 20-Sep-2025 13:23 by rmk") + (* ; "Edited 19-Sep-2025 00:15 by rmk") + (* ; "Edited 13-Sep-2025 23:39 by rmk") + (* ; "Edited 21-Jan-93 11:34 by jds") - (* ;; "Returns file name if successful, NIL if not. The RESETLST makes sure the scratch file, if any, is deleted.") + (* ;; "Returns IMAGESOURCE if successful, NIL if not. ") + + (* ;; "The heuristics for finding the right printer with the right kind of imagefile are in FIND.PRINTER.FOR.IMAGETYPE.") + + (CL:WHEN (IMAGESOURCEFILEP IMAGESOURCE) + (SETQ IMAGESOURCE (FINDFILE IMAGESOURCE T))) + + (* ;; " ") + + (CL:UNLESS HOST (* ; + "Not sure whether HOST or props should have priority") + [SETQ HOST (for X on OPTIONS by (CDDR X) when (MEMB (U-CASE (CAR X)) + '(HOST SERVER)) + do (RETURN (CADR X]) + + (* ;; "If HOST is still NIL, then it is clearly unspecified, we have to pick it based on the types. The default here is the first of (PRINTERS) that can print the type, not just the first printer.") (RESETLST - [PROG (FULLFILE STRM FILETYPE PRINTERTYPE PFILE) - [RESETSAVE NIL `(,(COND - [(LISTGET PRINTOPTIONS 'DELETE) - (FUNCTION (LAMBDA (STREAM) - (CLOSEF? STREAM) - (DELFILE (FULLNAME STREAM] - (T (FUNCTION CLOSEF?))) - ,(SETQ STRM (if (AND (STREAMP FILE) - (OPENP FILE 'INPUT)) - then + [bind PTYPE/PRINTER/ITYPE IMAGEFILETYPE IMAGEFILE SENDFN (IMAGESOURCETYPE _ (IMAGESOURCETYPE + IMAGESOURCE)) + first (SETQ IMAGEFILETYPE (OR (LISTGET OPTIONS 'IMAGEFILETYPE) + IMAGESOURCETYPE)) + do (* ; "Errors all at this level") + (SETQ IMAGEFILE NIL) + (CL:UNLESS (SETQ PTYPE/PRINTER/ITYPE (FIND.PRINTER.FOR.IMAGETYPE IMAGEFILETYPE HOST)) + (ERROR (CONCAT "Can't find printer for " IMAGEFILETYPE " file"))) + (CL:UNLESS (SETQ SENDFN (PRINTERPROP (PRINTERTYPE (CADR PTYPE/PRINTER/ITYPE)) + 'SEND)) + (ERROR (CONCAT "Don't know how to send to a " (PRINTERTYPE PTYPE/PRINTER/ITYPE) + " printer"))) + [RESETSAVE (SETQ IMAGEFILE (CONVERT.TO.IMAGEFILE IMAGESOURCE NIL (CADDR + PTYPE/PRINTER/ITYPE + ) + OPTIONS)) + `(PROGN (DELFILE (CLOSEF? OLDVALUE] + (CL:UNLESS IMAGEFILE + (ERROR (CONCAT "Can't convert " IMAGESOURCETYPE " file to " (CADDR + PTYPE/PRINTER/ITYPE + )) + IMAGESOURCE)) - (* ;; "Don't re-open it if it was previously open. (Some gibberish here about %"cause caller (PRINTERDEVICE) really wants us to use the same stream, which has the BEINGPRINTED property.%")") + (* ;; "Go around: maybe the user fixed something in an error break?") + repeatuntil (AND PTYPE/PRINTER/ITYPE SENDFN IMAGEFILE) + finally - FILE - else (OPENSTREAM FILE 'INPUT 'OLD (\EXPECTED.FILE.TYPE - FILE] - (* ; "Do we need to convert the FILE ?") - (SETQ FULLFILE (FULLNAME (SETQ PFILE STRM))) (* ; - "Do the FULLNAME on the open stream, as FULLNAME sometimes returns NIL on just a filename") - (SETQ FILETYPE (PRINTFILETYPE STRM)) (* ; - "Find out what kind of file this is, so we can figure out how to print it.") - RETRY - [COND - [[OR HOST (SETQ HOST (for X on PRINTOPTIONS by (CDDR X) - when (MEMB (U-CASE (CAR X)) - '(HOST SERVER)) do (RETURN (CADR X] - (SETQ PRINTERTYPE (PRINTERTYPE HOST)) - (COND - ((CAN.PRINT.DIRECTLY PRINTERTYPE FILETYPE) - (* ; "IS OK, NO CONVERSION") - ) - (T (SETQ PFILE (CONVERT.FILE.TO.TYPE.FOR.PRINTER STRM FILETYPE PRINTERTYPE - (LISTGET PRINTOPTIONS 'HEADING) - PRINTOPTIONS] - ((NULL DEFAULTPRINTINGHOST) - (ERROR "DEFAULTPRINTINGHOST and HOST arg are NIL; don't know where to print " - FULLFILE) - (GO RETRY)) - ([AND FILETYPE (for X inside (OR DEFAULTPRINTINGHOST '(NIL)) - when (CAN.PRINT.DIRECTLY (SETQ PRINTERTYPE (PRINTERTYPE X)) - FILETYPE) do (RETURN (SETQ HOST X] - (* ; "no conversion necessary") - ) - (T (SETQ PFILE (CONVERT.FILE.TO.TYPE.FOR.PRINTER STRM FILETYPE [SETQ PRINTERTYPE - (PRINTERTYPE - (SETQ HOST ( - DEFAULTPRINTER - ] - (LISTGET PRINTOPTIONS 'HEADING) - PRINTOPTIONS] - (COND - ([NLISTP (SETQ PFILE (CL:FUNCALL (OR (PRINTERPROP PRINTERTYPE 'SEND) - (ERROR (CONCAT "Don't know how to send to a " - PRINTERTYPE) - HOST)) - (COND - ((LISTP HOST) - (CADR HOST)) - (T HOST)) - PFILE - (APPEND PRINTOPTIONS '(%#COPIES 1) - (LIST 'DOCUMENT.NAME FULLFILE] - (RETURN FULLFILE)) - (T (LISPXPRIN1 (CDR PFILE) - T) - (LISPXTERPRI T) - (RETURN NIL])]) + (* ;; "Now have the printer and proper imagefile. Complexity here is because we want to say something meaningful about the image source, which may be a window, bitmap, tedit stream ") + + [SETQ OPTIONS `(HEADING ,(SELECTQ (LISTGET OPTIONS 'HEADING) + (T NIL) + (NIL (* ; + "If not a file, use the type or window title?") + (CL:WHEN (IMAGESOURCEFILEP IMAGESOURCE) + (CONCAT IMAGESOURCE " " + (GETFILEINFO IMAGESOURCE 'CREATIONDATE) + ))) + (LISTGET OPTIONS 'HEADING)) + ,@OPTIONS %#COPIES 1 DOCUMENT.NAME ,(CL:IF (IMAGESOURCEFILEP + IMAGESOURCE) + IMAGESOURCE + (TYPENAME IMAGESOURCE)) + ] + (CL:WHEN (LISTGET OPTIONS 'DELETE) + [RESETSAVE IMAGEFILE '(PROGN (DELFILE OLDVALUE]) + (CL:WHEN (APPLY* SENDFN (CADR PTYPE/PRINTER/ITYPE) + IMAGEFILE OPTIONS) + (RETURN (CL:IF (STREAMP IMAGESOURCE) + (FULLNAME IMAGESOURCE) + IMAGESOURCE)))])]) + +(FIND.PRINTER.FOR.IMAGETYPE + [LAMBDA (IMAGETYPE HOST) (* ; "Edited 12-Jan-2026 23:49 by rmk") + (* ; "Edited 28-Dec-2025 18:02 by rmk") + (* ; "Edited 23-Dec-2025 10:13 by rmk") + (* ; "Edited 17-Dec-2025 00:59 by rmk") + (* ; "Edited 15-Dec-2025 11:48 by rmk") + + (* ;; "Returns a (PTYPE PRINTER TARGETTYPE) triple. This is to be compatible with other interfaces where the type is separate (e.g. as for the default), even though here it is computable from the HOST.") + + (* ;; " If HOST is given and not the default, then it must be able to print IMAGETYPE. Otherwise, we first look for something that can print directly (e.g. PDF IMAGETYPE can be printed by a UNIX printer), and if not directly, something that can be converted (TEDIT can be converted to PDF--PDF is in the return) to tell the caller what conversion to pick for this printer.") + + (LET (TARGETTYPE) + (if (AND HOST (NEQ HOST :DEFAULTPRINTER)) + then + (* ;; "Really want to print on HOST, even by conversion") + + (CL:WHEN (SETQ TARGETTYPE (CAN.PRINT.SOMEHOW HOST IMAGETYPE)) + (LIST (PRINTERTYPE HOST) + HOST TARGETTYPE)) + elseif (for PRINTER in (DEFAULTPRINTERS) when (SETQ TARGETTYPE (CAN.PRINT.SOMEHOW PRINTER + IMAGETYPE T)) + do (* ; "Direct?") + (RETURN (LIST (PRINTERTYPE PRINTER) + (CL:IF (LISTP PRINTER) + (CADR PRINTER) + PRINTER) + TARGETTYPE))) + else (for PRINTER in (DEFAULTPRINTERS) when (SETQ TARGETTYPE (CAN.PRINT.SOMEHOW PRINTER + IMAGETYPE)) + do (* ; "Conversion") + (RETURN (LIST (PRINTERTYPE PRINTER) + (CL:IF (LISTP PRINTER) + (CADR PRINTER) + PRINTER) + TARGETTYPE]) + +(CAN.PRINT.SOMEHOW + [LAMBDA (PRINTER IMAGESOURCETYPE DIRECTONLY) (* ; "Edited 23-Dec-2025 11:09 by rmk") + (* ; "Edited 14-Dec-2025 14:28 by rmk") + + (* ;; "Returns the PRINTFILETYPE (e.g. PDF) by which PRINTER can print a source of IMAGESOURCETYPE (e.g. TEDIT or POSTSCRIPT), perhaps by conversion.") + + (if (CAN.PRINT.DIRECTLY (PRINTERTYPE PRINTER) + IMAGESOURCETYPE) + elseif DIRECTONLY + then NIL + else (thereis CPTYPE in (PRINTERPROP (PRINTERTYPE PRINTER) + 'CANPRINT) suchthat (OR (LISTGET (CAR (GETMULTI PRINTFILETYPES + CPTYPE 'CONVERSION) + ) + IMAGESOURCETYPE) + (LISTGET (CAR (GETMULTI PRINTFILETYPES + 'DEFAULT + 'CONVERSION)) + IMAGESOURCETYPE]) + +(CAN.PRINT.DIRECTLY + [LAMBDA (PRINTERTYPE IMAGEFILETYPE) (* ; "Edited 23-Dec-2025 10:37 by rmk") + (* ; "Edited 5-Dec-2025 14:44 by rmk") + (* ; "Edited 3-Nov-2025 15:46 by rmk") + (CAR (FMEMB IMAGEFILETYPE (PRINTERPROP PRINTERTYPE 'CANPRINT]) ) (DEFINEQ (PRINTERDEVICE - [LAMBDA (NAME) (* ; "Edited 11-Sep-2025 12:40 by rmk") + [LAMBDA (LPTNAME) (* ; "Edited 18-Jan-2026 00:45 by rmk") + (* ; "Edited 16-Jan-2026 16:15 by rmk") + (* ; "Edited 11-Sep-2025 12:40 by rmk") (* ; "Edited 5-Dec-96 11:23 by rmk:") (* ; "Edited 4-Dec-86 16:32 by hdj") - (* ;; "This defines an LPT device. An LPT file is a file that gets sent to printer and deleted when it is closed. This must be defined on a CORE device only because we have no way of inheriting the previous CLOSEFILE function that this function is replacing but needs to call internally. PRINTERDEVICE.CLOSEFN calls\CORE.CLOSEFILE explicitly.") + (* ;; "This defines an LPT device. An LPT file is a file that gets sent to printer and deleted when it is closed. The device is essentially UNIX with an FDEV with specialized OPEN and CLOSE functions. The openfn opens on UNIX, then switches the device so that the closefn will run. Closefn switches the device back, then closes.") - (LET ((DEV (\CREATECOREDEVICE NAME))) - (replace (FDEV OPENFILE) of DEV with (FUNCTION PRINTERDEVICE.OPENFN)) - (replace (FDEV CLOSEFILE) of DEV with (FUNCTION PRINTERDEVICE.CLOSEFN)) - (\DEFINEDEVICE NAME DEV) - NAME]) + [LET [(NAME (OR (U-CASE (FILENAMEFIELD LPTNAME 'HOST)) + 'LPT] + (\DEFINEDEVICE NAME (create FDEV using (\GETDEVICEFROMNAME 'UNIX) + DEVICENAME _ NAME NODIRECTORIES _ T DIRECTORYNAMEP _ + (FUNCTION NILL) + OPENFILE _ (FUNCTION PRINTERDEVICE.OPENFN) + CLOSEFILE _ (FUNCTION PRINTERDEVICE.CLOSEFN) + REGISTERFILE _ (FUNCTION NILL) + GENERATEFILES _ (FUNCTION \NULLFILEGENERATOR] + LPTNAME]) (PRINTERDEVICE.OPENFN - [LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* ; "Edited 11-Sep-2025 17:03 by rmk") - (LET [(STRM (\CORE.OPENFILE NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM)) - (PRINTERNAME (FILENAMEFIELD NAME 'NAME] + [LAMBDA (LPTNAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* ; "Edited 19-Jan-2026 12:19 by rmk") + (* ; "Edited 16-Jan-2026 23:09 by rmk") + (* ; "Edited 28-Dec-2025 17:44 by rmk") + (* ; "Edited 11-Sep-2025 17:03 by rmk") - (* ;; "Mark the original name of the printer on the stream. Unless the user overrides this by changing the PRINTERNAME property, SEND.FILE.TO.PRINTER in the close function will get the user's original spelling, without any case conversions that might otherwise be done by \CORE.OPENFILE. ") + (* ;; + "Creates a {Uni}x tmp/ file except that its FDEV has a closefn that calls SEND.FILE.TO.PRINTER.") - (STREAMPROP STRM 'PRINTERNAME (CL:UNLESS (EQ PRINTERNAME '%.) - PRINTERNAME)) + (* ;; "PRINTOPTIONS might be in PARAMETERS. ") + + (* ;; "LPTNAME is typically the target of a COPYFILE, in which case the source file is merely copied, and when the stream is closed there is an attempt to convert it to the imagetype extension, if provided, before sending to the (possibly also provided) printer.") + + (* ;; "The file can also be the target of an OPENIMAGESTREAM, in which case the file will be created according to the OPENIMAGESTREAM type, and then possibly converted to the LPTNAME's imagetype for printing.") + + (LET ((PRINTERNAME (FILENAMEFIELD LPTNAME 'NAME)) + [IMAGEFILETYPE (U-CASE (OR (LISTGET PARAMETERS 'IMAGEFILETYPE) + (FILENAMEFIELD LPTNAME 'EXTENSION] + STRM PN) + (CL:WHEN (EQ (CHARCODE %.) + (CHCON1 PRINTERNAME)) + (SETQ IMAGEFILETYPE (U-CASE (SUBATOM PRINTERNAME 2))) + (* ; "{LPT}.PDF") + (SETQ PRINTERNAME NIL)) + (CL:WHEN (AND IMAGEFILETYPE (NOT (GETMULTI PRINTFILETYPES IMAGEFILETYPE)) + (NOT (PRINTERTYPE PRINTERNAME NIL T)) + (PRINTERTYPE (SETQ PN (SUBATOM LPTNAME (STRPOS "}" LPTNAME NIL NIL NIL T))) + NIL T)) (* ; + "The case of foo.local as a printer name with no type") + (SETQ PRINTERNAME PN) + (SETQ IMAGEFILETYPE NIL)) + (CL:UNLESS PRINTERNAME (SETQ PRINTERNAME :DEFAULTPRINTER)) + + (* ;; "Filename is now decoded") + + [if IMAGEFILETYPE + then (CL:UNLESS (CAN.PRINT.SOMEHOW PRINTERNAME IMAGEFILETYPE) + (ERROR PRINTERNAME (CONCAT "cannot print files of type " IMAGEFILETYPE))) + else (SETQ IMAGEFILETYPE (CAR (PRINTERPROP (PRINTERTYPE PRINTERNAME) + 'CANPRINT] + + (* ;; "Open as a regular Unix tmp stream... with a funky closefn") + + (SETQ STRM (OPENSTREAM (UNIX-TMP-FILE-NAME 'lpt) + ACCESS RECOG PARAMETERS)) + (replace (STREAM DEVICE) of STRM with FDEV) + (STREAMPROP STRM 'PRINTERNAME PRINTERNAME) + (STREAMPROP STRM 'IMAGEFILETYPE IMAGEFILETYPE) STRM]) (PRINTERDEVICE.CLOSEFN - [LAMBDA (STREAM) (* ; "Edited 11-Sep-2025 12:37 by rmk") - (LET [(SDEV (fetch (STREAM DEVICE) of STREAM)) - (PRINTOPTIONS (STREAMPROP STREAM 'PRINTOPTIONS] + [LAMBDA (STRM) (* ; "Edited 17-Jan-2026 08:17 by rmk") + (* ; "Edited 28-Dec-2025 17:50 by rmk") + (* ; "Edited 4-Oct-2025 16:37 by rmk") + (* ; "Edited 28-Sep-2025 14:46 by rmk") + (* ; "Edited 20-Sep-2025 13:40 by rmk") + (* ; "Edited 19-Sep-2025 11:51 by rmk") + (* ; "Edited 11-Sep-2025 12:37 by rmk") - (* ;; - "Get PRINTOPTIONS property before closing the stream, in case the closing throws them away") + (* ;; "STRM's FDEV is LPT, even though a {UNIX} file. Revert to Unix.") - (* ;; "") + (* ;; " PRINTERNAME and IMAGEFILETYPE come from LPT name at original opening") - (* ;; "If we could save away and get at the previous CLOSEFILE method (e.g. by an FDEVPROP), this could be replaced by the generic (FDEVOP (QUOTE CLOSEFILE) SDEV STREAM). We know that SDEV is a CORE device, we call \CORE.CLOSEFILE directly") + (* ;; "We don't have the name or any metadata of the original COPYFILE source, so we can't pass its extension-based sourcetype. It has to be inferred from the internal bytes.") - (COND - [(AND (NOT RESETSTATE) - (OPENP STREAM 'OUTPUT) - (IGREATERP (GETEOFPTR STREAM) - 0)) + (replace (STREAM DEVICE) of STRM with (\GETDEVICEFROMNAME 'UNIX)) + (LET [(OPTIONS `(IMAGEFILETYPE ,(STREAMPROP STRM 'IMAGEFILETYPE) + ,@(STREAMPROP STRM 'PRINTOPTIONS) + DELETE T HEADING T] + (CLOSEF STRM) + (CL:UNLESS [OR RESETSTATE (EQ 0 (GETFILEINFO STRM 'LENGTH] - (* ;; "Close and send to printer only if open for output. If open for input, then we must already have started printing. Don't close until after getting EOF ptr.") + (* ;; "Don't send on error or if empty. ") - (\CORE.CLOSEFILE STREAM) - (replace (STREAM ACCESS) of STREAM with NIL) (* ; - "Hack, cause this is usually done later in the generic \CLOSEFILE.") + (SEND.FILE.TO.PRINTER (FULLNAME STRM) + (STREAMPROP STRM 'PRINTERNAME) + OPTIONS)) + (DELFILE STRM]) - (* ;; "The PRINTERNAME might be marked explicitly on the stream. Otherwise let SEND.FILE.TO.PRINTER choose the host if it is the generic printer LPT, or use the name in the devicename field.") +(PRINTERDEVICEP + [LAMBDA (X) (* ; "Edited 17-Dec-2025 00:04 by rmk") + (* ; "Edited 13-Dec-2025 10:12 by rmk") + (* ; "Edited 19-Sep-2025 14:47 by rmk") + (if (OR (NULL X) + (EQ X :DEFAULTPRINTER) + (STRING.EQUAL X "")) + then 'LPT + else (CL:WHEN (LISTP X) + (SETQ X (CADR X))) + (CL:WHEN (OR (LITATOM X) + (STRINGP X) + (STREAMP X)) + (LET [(FDEV (CAR (NLSETQ (TRUEDEVICE X] + (CL:WHEN (AND FDEV (EQ (FUNCTION PRINTERDEVICE.OPENFN) + (fetch (FDEV OPENFILE) of FDEV))) + (fetch (FDEV DEVICENAME) of FDEV))))]) - (SEND.FILE.TO.PRINTER STREAM (IF (STREAMPROP STREAM 'PRINTERNAME) - ELSEIF (NEQ 'LPT (fetch (FDEV DEVICENAME) of SDEV)) - THEN (fetch (FDEV DEVICENAME) of SDEV) - ELSE [LET ((NAME (fetch (STREAM FULLNAME) of STREAM)) - POS POS2) - (AND (SETQ POS (STRPOS "}" NAME)) - (SETQ POS2 (STRPOS "." NAME (ADD1 POS))) - (SUBATOM NAME (ADD1 POS) - (SUB1 POS2] - NIL) - (APPEND '(DELETE T) - PRINTOPTIONS - '(HEADING T] - (T - (* ;; "Error while creating the file, if the user had wrapped a RESETLST/CLOSEF around his code. Presumably, he doesn't want the file printed") +(PRINTERNAME + [LAMBDA (PRINTER) (* ; "Edited 5-Dec-2025 09:35 by rmk") + (* ; "Edited 19-Sep-2025 09:59 by rmk") - (\CORE.CLOSEFILE STREAM) - (FDEVOP 'DELETEFILE SDEV STREAM SDEV T]) + (* ;; + "If PRINTER designates a printer (a printer-spec or stream/filename, returns the printer's name.") + + (* ;; "Takes a printer-spec (in form (type printer-name) or just printer-name) and returns printer-name. returns nil for null arg.") + + (CL:WHEN (LISTP PRINTER) + (SETQ PRINTER (CADR PRINTER))) + (CL:WHEN (PRINTERDEVICEP PRINTER) + [LET (FDEV) + (if (AND (STREAMP PRINTER) + (STREAMPROP PRINTER 'PRINTERNAME)) + else (SETQ FDEV (TRUEDEVICE PRINTER)) + (if (EQ 'LPT (fetch (FDEV DEVICENAME) of FDEV)) + then (CL:UNLESS [EQ '%. (SETQ PRINTER (FILENAMEFIELD PRINTER 'NAME] + PRINTER) + else (fetch (FDEV DEVICENAME) of FDEV])]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (PRINTERDEVICE 'LPT) ) +(DEFINEQ + +(DEFAULTPRINTERS + [LAMBDA (PRINTERTYPE NAMESONLY) (* ; "Edited 28-Dec-2025 00:35 by rmk") + (* ; "Edited 17-Dec-2025 00:44 by rmk") + (* ; "Edited 13-Dec-2025 14:04 by rmk") + (* ; "Edited 5-Dec-2025 14:28 by rmk") + + (* ;; "The spec for DEFAULTPRINTINGHOSTS is ambiguous because a list whose CAR is a printertype could be a (PRINTERTYPE PRINTER) singleton. This tries to normalize that case to ((PRINTERTYPE PRINTER).") + + (DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) + (for P in (if (EQ 0 (NCHARS DEFAULTPRINTINGHOST)) + then (CONS NIL) + elseif (LITATOM DEFAULTPRINTINGHOST) + then (CONS DEFAULTPRINTINGHOST) + elseif (AND (LISTP DEFAULTPRINTINGHOST) + (LITATOM (CAR DEFAULTPRINTINGHOST)) + (LITATOM (CADR DEFAULTPRINTINGHOST))) + then + (* ;; + "Trying to decode FOO (PDF) and (PDF FOO) as singletons. The spec is ambiguous") + + (if (PRINTERTYPEP (CAR DEFAULTPRINTINGHOST)) + then (CONS DEFAULTPRINTINGHOST) + elseif (PRINTERTYPEP (CADR DEFAULTPRINTINGHOST)) + then (CONS (LIST* (CADR DEFAULTPRINTINGHOST) + (CAR DEFAULTPRINTINGHOST) + (CDDR DEFAULTPRINTINGHOST))) + elseif (GETMULTI PRINTFILETYPES (CAR DEFAULTPRINTINGHOST)) + then (CONS (LIST* NIL (CADR DEFAULTPRINTINGHOST) + (CAR DEFAULTPRINTINGHOST) + (CDDR DEFAULTPRINTINGHOST))) + else DEFAULTPRINTINGHOST) + else DEFAULTPRINTINGHOST) eachtime (CL:IF (AND NAMESONLY (LISTP P)) + (SETQ P (CADR P))) + when (OR (NULL PRINTERTYPE) + (EQ PRINTERTYPE (PRINTERTYPE P))) unless (MEMBER P $$VAL) collect P]) +) (RPAQ? DEFAULTPRINTINGHOST ) -(RPAQ? DEFAULTPRINTERTYPE 'PDF) - -(RPAQ? EMPRESS.SCRATCH ) - (RPAQ? EMPRESS#SIDES T) -(RPAQ? PRINTFILETYPES NIL) +(RPAQ? DEFAULTPRINTERTYPE 'VIEWER) + +(ADDTOVAR PRINTERTYPES (VIEWER (CANPRINT (PDF HTML)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND VIEWERPRINT))) + +(ADDTOVAR DEFAULTPRINTINGHOST (VIEWER VIEWER) + (UNIX UNIX)) +(DEFINEQ + +(VIEWERPRINT + [LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 19-Jan-2026 14:09 by rmk") + (* ; "Edited 28-Dec-2025 18:07 by rmk") + (* ; "Edited 25-Dec-2025 08:49 by rmk") + (LET [(IMAGEFILETYPE (OR (IMAGESOURCETYPE FILE) + (ERROR "Not a recognizable imagefile type" FILE] + [if (STREAMP FILE) + then (SETQ FILE (UNIX-FILE-NAME FILE 'INPUT IMAGEFILETYPE IMAGEFILETYPE)) + elseif [NOT (MEMB (U-CASE (FILENAMEFIELD FILE 'EXTENSION)) + (U-CASE (EXTENSIONS.FOR.IMAGEFILETYPE IMAGEFILETYPE] + then (SETQ FILE (if (AND (EQ 'UNIX (FILENAMEFIELD FILE 'HOST)) + (STRPOS "/tmp" (FILENAMEFIELD FILE 'DIRECTORY) + 1 NIL T)) + then (RENAMEFILE FILE (UNIX-TMP-FILE-NAME 'viewerprint IMAGEFILETYPE + )) + else (UNIX-FILE-NAME FILE 'INPUT IMAGEFILETYPE IMAGEFILETYPE] + (ShellOpen (TRUEFILENAME FILE]) +) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES PRINTFILETYPES) +(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES) ) (DEFINEQ @@ -939,42 +847,28 @@ ) (DEFINEQ -(TEXTTOIMAGEFILE - [LAMBDA (FILE IMAGEFILE IMAGETYPE FONTS HEADING TABS OPTIONS) +(TEXT.TO.IMAGEFILE + [LAMBDA (FILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 17-Jan-2026 12:25 by rmk") + (* ; "Edited 7-Dec-2025 16:36 by rmk") + (* ; "Edited 28-Sep-2025 11:52 by rmk") + (* ; "Edited 18-Sep-2025 23:17 by rmk") + (* ; "Edited 17-Sep-2025 22:47 by rmk") (* ; "Edited 26-Aug-87 14:23 by Snow") - -(* ;;; "Generic function for converting PSPOOL format text files into image files") - (RESETLST - [PROG (IMAGESTREAM INPUT-STREAM INPUT-FILENAME) (* ; - "FONTARRAY is an array of font-descriptors") - [RESETSAVE [SETQ INPUT-STREAM (OPENSTREAM FILE 'INPUT 'OLD 8 '((SEQUENTIAL T] - '(PROGN (CLOSEF? OLDVALUE] - (SETQ INPUT-FILENAME (FULLNAME INPUT-STREAM)) - - (* ;; "Strip off the extension if we are generating the name from the INFILE, so that OPENIMAGESTREAM can pack on the appropriate extension") - - [RESETSAVE [SETQ IMAGESTREAM - (OPENIMAGESTREAM (OR IMAGEFILE (PACKFILENAME 'EXTENSION NIL 'VERSION NIL - 'BODY INPUT-FILENAME)) - IMAGETYPE - (APPEND [AND (NEQ HEADING T) - (LIST 'HEADING (OR HEADING (CONCAT INPUT-FILENAME - " " - (GETFILEINFO - INPUT-STREAM - 'CREATIONDATE] - (APPEND (LIST 'DOCUMENT.NAME INPUT-FILENAME 'TABS TABS - 'FONTS FONTS) - OPTIONS] - '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] - (* ; "Make \BIN return NIL on EOS") - (COPY.TEXT.TO.IMAGE INPUT-STREAM IMAGESTREAM FONTS TABS) - (RETURN (LIST (CLOSEF INPUT-STREAM) - (CLOSEF IMAGESTREAM])]) + (CL:UNLESS (GETSTREAM FILE 'INPUT T) + [RESETSAVE (SETQ FILE (OPENSTREAM FILE 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE]) + (LET ((IMAGESTREAM (OPENIMAGESTREAM IMAGEFILE IMAGETYPE OPTIONS))) + [RESETSAVE NIL `(PROGN (CLOSEF ,IMAGESTREAM) + (AND RESETSTATE (DELFILE ,IMAGESTREAM] + (COPY.TEXT.TO.IMAGE FILE IMAGESTREAM (LISTGET OPTIONS 'FONTS) + (LISTGET OPTIONS 'TABS)) + (FULLNAME IMAGESTREAM)))]) (COPY.TEXT.TO.IMAGE - [LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 3-Mar-2023 23:46 by rmk") + [LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 16-Jan-2026 23:02 by rmk") + (* ; "Edited 28-Sep-2025 11:46 by rmk") + (* ; "Edited 3-Mar-2023 23:46 by rmk") (* ; "Edited 20-Jul-2022 17:14 by rmk") (* ; "Edited 8-Oct-2021 22:23 by rmk:") (* ; "Edited 10-Apr-95 21:23 by rmk:") @@ -986,13 +880,15 @@ (RIGHTMAR (DSPRIGHTMARGIN NIL IMAGESTREAM)) (FONTARRAY (FONTMAPARRAY FONTS)) (MAXFONT (ARRAYSIZE FONTARRAY)) - (INSTRM (GETSTREAM INFILE 'INPUT)) + [INSTRM (OR (GETSTREAM INFILE 'INPUT T) + (OPENSTREAM INFILE 'INPUT] DEFTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP] (* ;;  "RMK: EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch") (SETFILEINFO INSTRM 'ENDOFSTREAMOP (FUNCTION NILL)) + (SETFILEPTR INSTRM 0) [while (SETQ C (\INCCODE.EOLC INSTRM ANY.EOLC)) do (COND @@ -1063,9 +959,19 @@ 0 IMAGESTREAM))) (\OUTCHAR IMAGESTREAM C))) (\OUTCHAR IMAGESTREAM C] - (SETFILEINFO INSTRM 'ENDOFSTREAMOP EOSP]) + (SETFILEINFO INSTRM 'ENDOFSTREAMOP EOSP) + IMAGESTREAM]) + +(TEXTTOIMAGEFILE + [LAMBDA (FILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 19-Jan-2026 17:16 by rmk") + + (* ;; "Old name, keep around just in case...") + + (TEDIT.TO.IMAGEFILE FILE IMAGEFILE IMAGETYPE OPTIONS]) ) +(DEFAULT.IMAGETYPE.CONVERSIONS '(TEXT TEXT.TO.IMAGEFILE)) + (* ; "hack for printers that can't really BLTSHADE") @@ -2424,40 +2330,35 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6508 12346 (HARDCOPY.SOMEHOW 6518 . 7884) (HARDCOPYIMAGEW 7886 . 8107) ( -HARDCOPYIMAGEW.TOFILE 8109 . 8417) (HARDCOPYIMAGEW.TOPRINTER 8419 . 9666) (HARDCOPYREGION.TOFILE 9668 - . 10210) (HARDCOPYREGION.TOPRINTER 10212 . 11325) (COPY.WINDOW.TO.BITMAP 11327 . 12344)) (12418 24340 - (MakeMenuOfPrinters 12428 . 13960) (PRINTERS.WHENSELECTEDFN 13962 . 15585) (MakeMenuOfImageTypes -15587 . 16406) (GetNewPrinterFromUser 16408 . 16850) (PopUpWindowAndGetAtom 16852 . 18303) ( -PopUpWindowAndGetList 18305 . 19875) (NewPrinter 19877 . 21376) (GetPrinterName 21378 . 21666) ( -GetImageFile 21668 . 24088) (FetchDefaultPrinter 24090 . 24338)) (24375 25249 ( -EXTENSIONS.FOR.PRINTFILETYPE 24385 . 24741) (PRINTFILETYPE.FROM.EXTENSION 24743 . 25247)) (25304 45688 - (DEFAULTPRINTER 25314 . 25554) (CAN.PRINT.DIRECTLY 25556 . 25752) (CONVERT.FILE.TO.TYPE.FOR.PRINTER -25754 . 27491) (EMPRESS 27493 . 28068) (HARDCOPYW 28070 . 33072) (LISTFILES1 33074 . 33251) ( -PRINTER.BITMAPFILE 33253 . 33642) (PRINTER.BITMAPSCALE 33644 . 34128) (PRINTER.SCRATCH.FILE 34130 . -34300) (PRINTERPROP 34302 . 34552) (PRINTERSTATUS 34554 . 34829) (PRINTERTYPE 34831 . 37401) ( -PRINTERNAME 37403 . 37824) (PRINTFILEPROP 37826 . 38082) (PRINTFILETYPE 38084 . 40040) ( -\EXPECTED.FILE.TYPE 40042 . 40832) (SEND.FILE.TO.PRINTER 40834 . 45686)) (45689 50126 (PRINTERDEVICE -45699 . 46676) (PRINTERDEVICE.OPENFN 46678 . 47398) (PRINTERDEVICE.CLOSEFN 47400 . 50124)) (50482 -51040 (SCALEREGION 50492 . 51038)) (51264 59509 (TEXTTOIMAGEFILE 51274 . 53470) (COPY.TEXT.TO.IMAGE -53472 . 59507)) (59571 61314 (\BLTSHADE.GENERICPRINTER 59581 . 61312)) (61381 98547 ( -MAKEHARDCOPYSTREAM 61391 . 63107) (UNMAKEHARDCOPYSTREAM 63109 . 64039) (HARDCOPYSTREAMTYPE 64041 . -64448) (\CHARWIDTH.HDCPYDISPLAY 64450 . 65270) (\DSPFONT.HDCPYDISPLAY 65272 . 68067) ( -\DSPRIGHTMARGIN.HDCPYDISPLAY 68069 . 68924) (\DSPXPOSITION.HDCPYDISPLAY 68926 . 69301) ( -\DSPYPOSITION.HDCPYDISPLAY 69303 . 69678) (\STRINGWIDTH.HDCPYDISPLAY 69680 . 70635) ( -\STRINGWIDTH.HCPYDISPLAYAUX 70637 . 75977) (\HDCPYBLTCHAR 75979 . 80876) (\HDCPYDISPLAY.FIX.XPOS 80878 - . 81635) (\HDCPYDISPLAY.FIX.YPOS 81637 . 82378) (\HDCPYDISPLAYINIT 82380 . 84070) (\HDCPYDSPPRINTCHAR - 84072 . 89985) (\SLOWHDCPYBLTCHAR 89987 . 96603) (\CHANGECHARSET.HDCPYDISPLAY 96605 . 98545)) (98862 -148413 (MAKEHARDCOPYMODESTREAM 98872 . 101593) (UNMAKEHARDCOPYMODESTREAM 101595 . 103185) ( -\HCPYDISPLAYIMAGEOPS 103187 . 106007) (\BLTSHADE.HCPYMODE 106009 . 106675) (\BITBLT.HCPYMODE 106677 . -107425) (\BRUSHCONVERT.HCPYMODE 107427 . 107976) (\CHANGECHARSET.HCPYMODE 107978 . 111240) ( -\DASHINGCONVERT.HCPYMODE 111242 . 111583) (\CHARWIDTH.HCPYMODE 111585 . 112022) (\DRAWLINE.HCPYMODE -112024 . 112553) (\DRAWCURVE.HCPYMODE 112555 . 113142) (\DRAWCIRCLE.HCPYMODE 113144 . 113629) ( -\DRAWELLIPSE.HCPYMODE 113631 . 114315) (\DSPFONT.HCPYMODE 114317 . 117001) (\DSPLEFTMARGIN.HCPYMODE -117003 . 117745) (\DSPLINEFEED.HCPYMODE 117747 . 118380) (\DSPRIGHTMARGIN.HCPYMODE 118382 . 119450) ( -\DSPSPACEFACTOR.HCPYMODE 119452 . 120227) (\DSPXPOSITION.HCPYMODE 120229 . 121247) ( -\DSPYPOSITION.HCPYMODE 121249 . 121899) (\MOVETO.HCPYMODE 121901 . 122115) (\FONTCREATE.HCPYMODE -122117 . 124074) (\CREATECHARSET.HCPYMODE 124076 . 125799) (\STRINGWIDTH.HCPYMODE 125801 . 126596) ( -\HCPYMODEBLTCHAR 126598 . 132348) (\HCPYMODEDSPPRINTCHAR 132350 . 138284) (\SLOWHCPYMODEBLTCHAR 138286 - . 144915) (\SFFixY.HCPYMODE 144917 . 148411))))) + (FILEMAP (NIL (6606 19331 (MakeMenuOfPrinters 6616 . 8105) (PRINTERS.WHENSELECTEDFN 8107 . 10038) ( +MakeMenuOfImageTypes 10040 . 10859) (GetNewPrinterFromUser 10861 . 11417) (PopUpWindowAndGetAtom 11419 + . 12870) (PopUpWindowAndGetList 12872 . 14442) (NewPrinter 14444 . 16058) (GetPrinterName 16060 . +16348) (GetImageFile 16350 . 19329)) (19386 37306 (HARDCOPYW 19396 . 20869) (LISTFILES1 20871 . 21048) + (PRINTERPROP 21050 . 21300) (PRINTERSTATUS 21302 . 21577) (PRINTERTYPE 21579 . 24855) (PRINTERNAME +24857 . 25943) (PRINTFILETYPE 25945 . 26318) (PRINTERTYPEP 26320 . 26545) (SEND.FILE.TO.PRINTER 26547 + . 32796) (FIND.PRINTER.FOR.IMAGETYPE 32798 . 35503) (CAN.PRINT.SOMEHOW 35505 . 36877) ( +CAN.PRINT.DIRECTLY 36879 . 37304)) (37307 45651 (PRINTERDEVICE 37317 . 38926) (PRINTERDEVICE.OPENFN +38928 . 41914) (PRINTERDEVICE.CLOSEFN 41916 . 43635) (PRINTERDEVICEP 43637 . 44561) (PRINTERNAME 44563 + . 45649)) (45713 48137 (DEFAULTPRINTERS 45723 . 48135)) (48536 49833 (VIEWERPRINT 48546 . 49831)) ( +49951 50509 (SCALEREGION 49961 . 50507)) (50733 58555 (TEXT.TO.IMAGEFILE 50743 . 51956) ( +COPY.TEXT.TO.IMAGE 51958 . 58306) (TEXTTOIMAGEFILE 58308 . 58553)) (58676 60419 ( +\BLTSHADE.GENERICPRINTER 58686 . 60417)) (60486 97652 (MAKEHARDCOPYSTREAM 60496 . 62212) ( +UNMAKEHARDCOPYSTREAM 62214 . 63144) (HARDCOPYSTREAMTYPE 63146 . 63553) (\CHARWIDTH.HDCPYDISPLAY 63555 + . 64375) (\DSPFONT.HDCPYDISPLAY 64377 . 67172) (\DSPRIGHTMARGIN.HDCPYDISPLAY 67174 . 68029) ( +\DSPXPOSITION.HDCPYDISPLAY 68031 . 68406) (\DSPYPOSITION.HDCPYDISPLAY 68408 . 68783) ( +\STRINGWIDTH.HDCPYDISPLAY 68785 . 69740) (\STRINGWIDTH.HCPYDISPLAYAUX 69742 . 75082) (\HDCPYBLTCHAR +75084 . 79981) (\HDCPYDISPLAY.FIX.XPOS 79983 . 80740) (\HDCPYDISPLAY.FIX.YPOS 80742 . 81483) ( +\HDCPYDISPLAYINIT 81485 . 83175) (\HDCPYDSPPRINTCHAR 83177 . 89090) (\SLOWHDCPYBLTCHAR 89092 . 95708) +(\CHANGECHARSET.HDCPYDISPLAY 95710 . 97650)) (97967 147518 (MAKEHARDCOPYMODESTREAM 97977 . 100698) ( +UNMAKEHARDCOPYMODESTREAM 100700 . 102290) (\HCPYDISPLAYIMAGEOPS 102292 . 105112) (\BLTSHADE.HCPYMODE +105114 . 105780) (\BITBLT.HCPYMODE 105782 . 106530) (\BRUSHCONVERT.HCPYMODE 106532 . 107081) ( +\CHANGECHARSET.HCPYMODE 107083 . 110345) (\DASHINGCONVERT.HCPYMODE 110347 . 110688) ( +\CHARWIDTH.HCPYMODE 110690 . 111127) (\DRAWLINE.HCPYMODE 111129 . 111658) (\DRAWCURVE.HCPYMODE 111660 + . 112247) (\DRAWCIRCLE.HCPYMODE 112249 . 112734) (\DRAWELLIPSE.HCPYMODE 112736 . 113420) ( +\DSPFONT.HCPYMODE 113422 . 116106) (\DSPLEFTMARGIN.HCPYMODE 116108 . 116850) (\DSPLINEFEED.HCPYMODE +116852 . 117485) (\DSPRIGHTMARGIN.HCPYMODE 117487 . 118555) (\DSPSPACEFACTOR.HCPYMODE 118557 . 119332) + (\DSPXPOSITION.HCPYMODE 119334 . 120352) (\DSPYPOSITION.HCPYMODE 120354 . 121004) (\MOVETO.HCPYMODE +121006 . 121220) (\FONTCREATE.HCPYMODE 121222 . 123179) (\CREATECHARSET.HCPYMODE 123181 . 124904) ( +\STRINGWIDTH.HCPYMODE 124906 . 125701) (\HCPYMODEBLTCHAR 125703 . 131453) (\HCPYMODEDSPPRINTCHAR +131455 . 137389) (\SLOWHCPYMODEBLTCHAR 137391 . 144020) (\SFFixY.HCPYMODE 144022 . 147516))))) STOP diff --git a/sources/HARDCOPY.LCOM b/sources/HARDCOPY.LCOM index 6880c316f28f9980748332658a8a668641662961..25e412bc7498e308f2812b0b348c7c830e22f48d 100644 GIT binary patch delta 11445 zcmcIqYj7Lab;d48NkJrg@|fu~{n51jk?Ayjq@1*q>2x|t zzjN*aSU`%~{0MDf_ujpGALpF=o$s8xpZ~7phkSGlOlZN~TCKcOsd{kI;1MxI)lP{ zsli88#oXC{ygo2jbDv+@Nvn(3fBfLw-RB!Wba=F&UnKImM7%5lL6OKz#R~;JmxMe; zQcuMznKG|TFP0!!E$kQPDtW9%^G%AW?gkdPV==w3BT11}#F!Kla@$s~4x78G)&kVs_GeEYTqHR9VoHuyuOZ*%35we5j} zD|_n!q36oQB~cK5OfoyI7w^ZtCM->j<>FZ#6~0zQNf>yV(-+39rQDB-_EWELoa=Kq z)R<*VGt%&elvvgIjH)c9xt=X*KUvez>X37`IT(90{`_1uElu**mBtU!ur4kgp;m*n zL5C-ziRBzwmtTY;qNr!{^STI3l9|bQL(VO!*~}~wHoxXRd*KZ z$G@G`L>n>4lz7$c8eS!VLB6wK^gL?yp-5`XqHx^dq$o67F?z0+(xI$Ib2G`#U`w=PXgl9}$Uo zjw=N$F_}+P0KMgL-W^fkO}-p2!vp6;R1>8{9IB5e%IGv4?FAGO_Vre=etnu4U0C0& zUVcLGUV?jqms)>Jm^)`by!|&n*RRw=t!Y8k0RiJ8?YFUrZw%Dr^41y|i$M)iSRnWb z0dYECDtm>}zlYqF)T5*NrR$E*l3RBxLy9BKwXddGk*uxspwwKQV65rgaj&`G@G;A+67FHUqVT-24+3`1fa=&HGXJxUD>c^2O=xReo(yd4s#F z&yJ`MH1`_nQsXVl!TKC$t5{ zyUDt=fOc~opiP1e5Dc8f>OM10%3+IwA-5U;c`IXycnRiA5Ooh>6tq9tGFo6?$K(s} zU)i~MIiDq?1xaf42re#4_97W7_6u3%%BJ|x zW_9i2`X>1C6^qJT1O9^*TOIIHER^zzR8pT8M!ky+d_aMlgzq<1W!1q7x=|P!bVxgT z-sTURld^8H3d40c{#<2)*xhp5+E_-n`^6XtLE363nL*2urHneLq6h{=xmeLLAtM2j z5E4+i9?!C5vFWUm(ArodTNbeVNoygIsJLrfgu{Xt2}sWrKpw1zfwt?Sr+CW}38qok zS;{OGVoJ$;uAB!8Zu1APU_k&ldGBHVVTo|1e5IJ+x4o{Mk!g1-!LA_PK}L9dViBy> zF#(<>DgKb=1h3y$J9xtx8`PB7V}|nP`MKQ}=bX>Y&YgJHXnt?K@sA+tjqf<4@b;@WPlI(%pn*1QUi;@9SNLIj9~#7P8lhlnA$d*7yDH zx`kFN{e2Fl!uEk6WuA3^rs+(-QG0WCVUXpt)I7$3HOs&3Qn>w&VeR}5AT4j7ls!hrk2z|NfYro={S!VM}sgB{}rpz+6#X87{(9A7T*u-1&L z>$~Pot#Nkyv|P&#QIVr{=Ef8MxYd5X&JQl}uYBd1%CE>9_OLvz+kIg_w>YzPCtsz* zb@M&m07bq|l4> z(HeYu%Spra-`w}!jga1Yetvxo+;zwNtHLm~!L zN$$Y$Qa-Dv^9us$9eX20TQ|1}aYyw|TyU$75DNB21{koXij;IK_U?7vJgTJ%P|E^K zzD|akG>SUnf?Q^axw*|`E$y_K1B`Z6ZIg6K2AU_Qw~t98#OTg4Bnx&n`)Y&A>s)Ct zXC6^UR3(09`xw{J&y>Ud;L}Faxjsl<|4#w?ZTyoIs9oeqX_`6s!th!bO@tu8fLQWm zz0|HGz*<{@2Uw)UW{#7QG3aS3fwdJ!ccLp3I1uQ9EG9-a6+Azxbk(DkilZDriay?>ZNZu#E#774evJ} zebQaOy;VHA!|h^lo0Oqk#?p;ki&J8KIhhvri$GW`WB*AGnL>7w=ZK`Ig&r_7k|EWm z4A4`^R)Y&$&cPAWgBd-i7s2U^V$v@JC|X8D+kvj^bv%*DmpI!Hq`dG1r9!zOGL6W7 z67?n(-SIU1xTxfeMM^9(V`VTfzjg2F33Mp~O1S)NcP@d=z?S5rsha!li`6Y518#dY z3^o08pW@hKle_`r~X1S%zS{qTK$vCjycsp9(q{hPLY?@n4xPfsBVwscQ_u(h%p(@^C8XMV;M3R2b4<4L z95VRqLDVoT#0og!)~t?$$k(T_qcw__tj7Ugz1wiX1iC9=$$ozi1p&cm!wYW&zpoW> zK_mgOapfBFYK+jlY)bX_q};)oWbV+ASvVWdVoQbX%diU(9QevFj#A2I^uo&K=H+XW zk1(ZqOkBPwC}I_(UNipUNL_|dw!9f*4{wJQ+$OvC67oDcjQg6R094qlI`}c{;(MEY z+ip8-!tF+yMZ);GZEw3t#Nl{&ciSx=v}+v>X>2>Pp3sI9*^;aKwCFfz5Gada<`VJ41BJh|K^w`EWuYe!gddEDpp`84x4wfpw^#Ujus zVE%(P{J@B+s*d&8kg61UH`m-3_OOB&vTZ2%wWKb>L32EK>~?He@=G^mP01P}e)H+zDVRDUly}cE{VbDA z67=6a%k;BMGS%ND%hW?xJ9b-Ox=DMqWRcG{(Im(Op#1`RyvV4{$+)pZ9UF4sw}K?LB>#@wccthSuMEttrJ#Bwv+|c?XI~S znyqR?-8xz8ZHX+jil%7$F@7YEt^15Y<*m4hRPvG7bFmDMg7jcU5`%z1+{RQ;z4@KXe85Zj;|ss z>y$xV^8iDK3_swtWbM|WIO9aR%Is)WZG0#$w*_Mp3t#dozU9j8qI`!75@og~WanJs z`b)L-1F%CJmJVAZa5ew@M$ecZk#pe@08&WI19@s|8yop6YnznrW`L))v1`(hqh-29 zH5SzZb1GWAo6f^Qo^D0Rz+eDwl2e7c2@a(=tPv5oZSw3|Tx0vCzAobRzrI zB3zMHZ&qiZ?>%z{KDIy?>{6zwIGIqN!Pf3%i1{$h$l+WU>+*}o*Vmp{yUJ;LFhj(( zG7c>+36N5DyU0j!UI6K+_H2plaUX=f8VKa*#I;ARAmif~qd9P?6+xfdd~kF97gkn> zkRw{BGhmr50 z!!y=}&0JbEaR=lI+T=>}gR9~@p7E~FjL0Jr*XQX=h0*z;Xp zh&$40DVz!*o}Q#6A@5EQs}B7X;YkrkjtK{eGVT-jzDQ>Dh;6gd?TU+<|D8PDN18BC z>WO_Vahspe?@{{9FT6jtuQm7W_oSWyX}ZmPJ{{aAW!yYq{zZE1(8Da=%!ZS%KM&-8 z(;P7F-1p6mJ-aA;%bYS!9lNk2f%gLgUrBH5;g&n;jp0VY{IKB*tmFr{N@@NptIaAl z{%+gdZk=JV=LcDJ=|S@w#>vo7`)S&GW#{^j{wG)6II#P<9jO#l{L6-G_qlfIJLc)x zi;>6EIXQ{zKf2VpeaPVnfu$_ts|12>r0RT~LJ$ch)0aA04Z%z#JJatm4+>5j=(kyj7jYdoxp$pCUQ zNQLK9au?$46q$ILMCpA1F?P2^D9pRbJe577M9imxq7Q*gzZQ^hB_oM6A>NjQ3XjXy_S|)MT{0N% zJD$XmM6pCC3+*pDP?9b1e(P%tPa&BS>2fwhy}BqouV4tA?xIKu6daEl7?d=Q8a@@V z@gyFqy#&*B&wD3YLs)YW9(IrPgT^koXj>2F@Joe$9@~8KrNR+1i&lU5+_b3A5L&p* zzkg}YeBaB*T`s6!evWEpUp`UglFf{0(iHOY*O2myDAN3RCz%QvNHutGtM~13d1$ch@4ouT z9`jSzkD7LUx;#*4IS+-ljEYwEf2#AR)uxLy)EO#i{;~Ve@psXu`Ns7J^`A!Cw-PoV G#{Vxu(|%9@ delta 13788 zcmai5d2k!odB*}2Dbq49QItYU))Q?>q+~K!oFrpeSOQA|B!Gngkf0>SHbqbdEm~A$ zCT^}GPSQy-(=@R+zT(K8I<=Ebk_j)Qmg|_FW_q|8=jb$7Gfmr>PMkk76Z((d)2P4i zd%FvOVj9}B*nRu<9pCx;zVGQ9-*rFtukO!I?^XMA^H=(PUSCkC;bHIKus`_trGa+_ z!hNE-N3DGu8V-7g{oWpN;p+U{(!*C47Uzp%{`an2edOq{`F*A9{K93?Gdh_}irUWx z1_pXWadsJfcN}l1r?0tpG?CP!SzXKPF;PFMTvEV1;=bdSKv<}O!C+{}Tv85tM$yKfCZ3Fm*1K#0ahz95kg!-D}S~eCnGG_;JMoNzx1@lt)sQDL% zy31ZsNTg#%L5vDjBvRU#p37rNDLngx{ncn1kA9(f)nK4cxc0dkTuSE5qC4B#a*GRp zrMbq7ZXw3~M7s7E|pojhrE4FI!}=pW3N1*l%1fYq3On3@^R4n@!*= z?wdcG(M1AZX0nNNUe8+3svy?kg-tyW<)aNQS3`uC+f1u%Z&!BHZ@khP(MrYQ$Zd`E z*ygF+qeUy8k;KNW=v;QW5~c2L-rqvI+r!^8P5Cm;&lCKbDXehw+Us$*a+cq1Jrm)k zH+rwfm6un(1Qz(bVkVK!O=fkAwW=2jPGjw2$SZ96iSQs;Rc2m^u;1CfEg{4vRRo8G zklQlBnlB)VdK9L9M z1_P3J<-7TQ6GV1JQUxMY{nXxBtz?#2E958x zd4t)?qDc}#Psc2lgVPxLfZ`0@uDIeGdm?cq?zW}V2Z`FIXCf%Z=9d!>&ptRm3d>PD zHP7sKrnV%^7F$bLd3F-j8UZvPYuHD6i}g%+upZj4tNn;OUi3VrT!&;#f3o-#3&r&~ z|D26)9E&VbuQ-clV!YB`Wa;5YrQ%8Kp|_w`xT^FvxkSis&rWO9%IT<<7yf$1 zfHAFErU=m1GglWbFVA01&pwRJ_XhE;mgY`)5&@s+`Cu}W|1hkfO}VT-mVhAD^FkG} znH81TQf9t@0wEX)<~S)_eB&e&gZIi?=f|^rO~e(bVcaeCutcI!Rr-SPhoBlHsHqG# z#`0^;$=jl4Ubj$#B9|#^h4erQ##fiy+|FSECG5$~FV4>`i&=4X{=tQ%%R6n-qF0sc z&OYl{&il6dM&m{zTGp}mbKrh;?+*7rwV_MCUypCRtG&&=6G_f-qcks4D2O&pvMPNB zLykNb#Gtp9xn&W?0=4MG2{I8?!Ug@L_|_&MDUzO&aQ;CMu1YswsCK}eq$Ly-EFCN= z{yKV=ErPO7lXeCoGcc0Kr?iYsP0VME=A)C@oROW(fQDfaOXM&ACBuAGCmo{ziT$_y@U<=x4Ye90E&zIL&@(6QEE=-k*-ikK}^ zN6V21z;V~sdS@xZs#`d4@G1GlW`dbFK9PQ?m`vTq?A)&9>@gR01Tt2Ejp^;@=V^y8<|23 ze!w>h~W zn76JW$eydfekbfV)xzFZ748a)lS}jZsBJ&CKclAx>I4Ga>7wU_S4$sLUX8n7P8L0DcND?qwNAIf zA0+X>tX_GCTUpt+c5jlo^6rPW*8Qnnp33p0d5h=v@_~s`_qpq3#mG4g+ zdu8>;F;}lo9TGF6=X5g8Dwvgy!j^*e(8Z|1b~=bXY8m+Pm=9Z1hl1kFqyfx0q>7k6 zs!b;IDLp+I*OM_Iy+L1%J_8tJPD<>P8z{u}bWR6m1z<%-00AQ(*RujlmgA{jQw!|( zf2hGj6+o}(?o2PHR_OY>I= zKAV|_xuc(fiStC%Y`x=QHz9I9UcXfqSZ(s*%fL2xO7V?U^y@{Y7pYGou6sbfk23Vs8 zBuQw~;gH$VSl9)I^rTGDcwqgbjXzV?FYJDxsq7O#N!hb(OHz7jM9-dPTVh%G{+ zbVpv%)((spxd#iZ{J2e7`DNm(+$znE~83XE+ZdAp8MtR^?ljKIwOhfcfLLAD{Ly;3BDE&N--u{Jn*P zBqo!<8#MSbFt^ek@$mM{|7q_nSHd+AeB(sT!=Fc3Rysy8e$OIIeZ6c#QQmmbwF7lEC$<)w$kP)O+0c_kLl%YU|c|yZ$jt-p(gos8kqiqA_|CKlR>3%RAsZ5QAO?Q~bsaHcX9Y0Vl%AzMLzU~gkZP&^u=%l0 zZ+R!pCiITTQ@B{%nbE8e;E|)>7HJ$b{{Iq~!vS*dL|+J9FU0_?7PC;Yh(u5Bms!u` zLx;QQ`C{?$Qn!Lh;iz(2E@wo^ILJF}0il93Dd0vOOLKVN*UU{MLS-u+LFh!$D5(WL zWgQ@rVMQUB0=c3Zd1v8l?{LRGm4;HA@=AgiIPUIpD+iw#SK8w4>6Kq#d0sKuAJu?k zfoo|zV*F?Vt^lh5cl2pn_$a9R9c$huc@8UBitl5eceFpl5563B)2m5iK8$gC;E)&%$34@sN&^ zyGyd1kyS?$Vf3^k13S)CcJvKy&f-IWyecgUO#~3_fQBu&wE%F(VyclL)RRL4#Mp{v ze_KL<`Agg2C5{4-n*YALt&H7#ZI|NOrB#}khZo$D5jI%-#1|&8!cE*mJ6;*C zd2Bz@Fz%_OOC6QF*rsWG9pUS3yFf9Qq!oXAJra-6NM+aYXeqYXm}qU;C zoKxUnV`L=C*(R4O3f^hfy@vakbsxjM&TOwz=F^R3Rs zvhvd=m#e8g(=hU~lwT_+c6LRJe4C{D$w<*WyAp^jHt_D&x+8y3RQzpEx;>TuT6k=; z^z?4(bv^P&{CiF&*{+Yf&u{8$_r=!^Tk-VP`lUGQN)4q}ey)|*Cm*2i+uIvc#r3@% z)9ZRoua(z4UrfDL`glrtE#>}}o@OoGTKjRj@{@&?AI2-~{4HX{w|Vkuet)5PGrHb4 zQSp3q)%D#3Cl3Fn!TR;+advGN8a@2}g)$5Sf2${=6S2`slhkL>#N~Q*r zs-E&4(nTA)+zJ@ak4gK6pS02z|JtMBCB-)MKLn_>wXv69^QBCmTJNf@EIpgrh9}wP zzOZ{Us$6K?T)i<3_%%VH?&^(GTBVg&$~#{D&9e*4oD0oQtlnsnmWdlye^Z9*MwU?8 zjzG`?JR~!0G0Oqq6ziqeE3{Y)5Xp#=Hu->_YE6nSY?);}Yvl@9@_eupR<}A6f`Eil z7@RP$`sbn=unh_ac6auLy~}p&9RM;o0}noi)CH#4IX40?F7qW682b_4*oil!z>pqhlk5kX zWJKo=4LLs34`RfO=p@j2en9p^o-C#t;De4_pdD5EVUVq_kwKPsKETu*;!nhiL~3I! zji7MIPQLhHEA0HiAV&-y)yKbcFtYLunbiPNk(TjXo?l!PkCtYa#U&tSv2;-o_-7pSvj{IW>#n084tBMF6O$evW$As!(+i(WJWVjM)f62}Y93-$Az33Yb1sBNETJJB!ZJLnMe}gQ zghedUlMAU8K^uwm30DV9Nt4FP%{s{{+XlS^Xw;`P)V>^9Csz$#1+7s@zwl_`Sx4=p z8d+-wGLkN=Mya^&LKPZL$f1paPdP*ZmCVk!-n+6akj(M3ru(*c(i zLIDOpK^w!%Xadwn3L1Ow6UsY5Qzi0jL?-69o|ZX|3oehcc27iU*BTzcGF<09m8R0# zVZg3e<4NU}v*TMYjeDL=j30b5x&Et#mA59`D?ewW8gE8v2`T+ZW%mPo!z`n^*d`G=Jv?IY>Ge_0<%I(_gu@S{A{CDDm2Q2 zG7)gS^a{5W+PW9mQWQG6+daD`c&-kfVXM618CRZ2$RxpcC~&q)fOTY&u{ZLYSuGvY zq6D}=5?L^|LNj=83e-RVpRFh0A?v8D2iI_HLClT|(6D zmS)nbvb5DCD9Ghh8PcvOiOLDfriQfjzDWez{F(`CPPDe>nC@L`f0t;J$(XGTPXgYG zpdLg9;h&zLOcOX0*t>O%LI8lV&e>#OC863lw{n6AxD57)IwaDghVV&!A;slH4iUem zfX|c&*0wM!fSf6M6@%O6LkJ9!&Sn0K&Rfe#&2+A7>P` zc6jAO($8`iZu?vsWvOqc-R_m^iSdb*iSqc`5RYTUm>lu`X~)`KDOG!OWC)V zaWH^WNObstLK;hg7%ljq$1*$g+tZZ@1nNCFL6LeS0QFS~b;vY7>XKRLR1z6+n7neW z!~!j#;*c6a%`Z^R;bM6=f2&erzb3d;1Jz8NWk?*^N9xMaCj^}}dA3k^5~b3cbsVIU zMjrlEsxF6?SZ{r_=)-ve83Q6RwsWC?LWFhfc<&gphDI_*l>%wsVcRT2Pi09?*+MHU@avA_Nh5@&~4dpcX< zH4kl8X(9sAhe*vp%o1tc8XHA^dGau7WUV&P&I7Dye(z*gGeGbt&8iO35yw5KT+k!K zCG!W$zC&!P3D#Ir#UPQEN>5+f!>j<1?<-T1p>IfNyY&_OapjaX)o#RZ02*vC zr5!)Nc33`5T>1%9bLI=r$el1y4sapk@&)*C&fWE zGE|c0QV$8qszY8<#j-p$V%tjmdu>r*@QTy17#|rnm=kHndd39sB3l)}63T|rBTQEhP64aHV?7@> z|2tH4=MD2h*n0$UjIb-`3V1>iIoTu^YJMhsQt?xaP!2ejlER<7Hj-o6lf{WqlpGk% zj3TPD*GS-m;hyyd$b=sWut8A&+Or!##Or4E7g|^W`Lej1o1{M`e39#(Yb;xkLiX;c z$Xs!WKakgPsn>-Z`pXpa(kZ zglZw5=SF4$!ZpRmlOdm66$fCktK!hAYB3fIC8vosvJ|m&Li~FK{q+bO|LH}DR%5Wt zKRa^AA%GFl+nYnK1PR>)g5o^zd06zq;*O=w*N=2H67?XnGegni6v)|?OiKq+Ln(I#z=IehA_ z-G8~*xCNW|9rNO;!{VV$c_8Zkmi4aqVk3XG8DH#_H!GhqpFibQ4D)-Z4&3%t=l$x9 zfT`SjD7eRIi5v2O$L8v9{v%ynylw0An^J_(@QcOft!JI5pP0FOFNWR|PsV zd!7!A!f(Pf&;cu)e}Swx51~Qx*Y|dpVUKV;MnepT>Tm$TDbBS`!`>zM>|4N#^RM_; zo-XvmpyD;1DokmVZ4rKml><(Z$)&<4D2oFn&P0Adx9WpDUPpun>_HKvj3aq~JJlXO z=!8s5`2gn9C=B=@IdzNjA(pHz%7+>!jVI9oP$v?+G$<^gGp!FG*mjT$js zl+`ew%j2g3R0eSB0hOD&`KT~l-#}Q~CM2C0wDwI!*!qqjA6x_3H4b#4`u5CnuEE1F z&@~<4OKO!i=rg|=8E*k@w$ng?01jzs?|26}22>}EQK_^zNC!>;DkjY{+P-7;Z{U9< zBE4AG~j^t#aR?f9-95Y2h2Zw z`tPU34kv4zkEq0Q8Rxl0aiLgToWJ@=4_?t;9fP#fIVIiz(iQv72c9`KzAfh2A!cd* zow1ZGnVZi&b4ReY5MoiPu3jfk)1dlbrRh0CVXi)NyZPobM~*YZ`lDFQ(dJ z75D)jdgY4k_2ftx&A#U{onqSy8qfUw=Q2vO>HWe!^Q$l2+lrR4q%oo;d0o_gJI)TV zDQ9tF3A@=l(nwJwg`Kc$m_PhN&^$eIfOlEju3j59AB*iZ%h&c{($8HxX}*5VZ*E@O zrA(WvsV=ki`Jj2mIB4Gge5<+i`~dn~dp>No6%O7;q=_cAtbTM@G@JkX{Jo8Gs&(y; qA8s`N>c#GZOrYl8Y(_hCT5Kbe`QnR5I_kJ2sq*QU-rYdSr2hk=Z=iVq diff --git a/sources/IMAGEIO b/sources/IMAGEIO index cbe9b83a..a131fb5c 100644 --- a/sources/IMAGEIO +++ b/sources/IMAGEIO @@ -1,22 +1,37 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Jun-2025 11:48:01" {WMEDLEY}IMAGEIO.;11 79830 +(FILECREATED "19-Jan-2026 14:08:55" {WMEDLEY}IMAGEIO.;51 99943 :EDIT-BY rmk - :CHANGES-TO (ALISTS (IMAGESTREAMTYPES DISPLAY) - (IMAGESTREAMTYPES 4DISPLAY) - (IMAGESTREAMTYPES 8DISPLAY) - (IMAGESTREAMTYPES 24DISPLAY)) + :CHANGES-TO (FNS IMAGESTREAMTYPE) - :PREVIOUS-DATE "15-Jun-2025 20:46:26" {WMEDLEY}IMAGEIO.;10) + :PREVIOUS-DATE "18-Jan-2026 15:04:58" {WMEDLEY}IMAGEIO.;50) (PRETTYCOMPRINT IMAGEIOCOMS) (RPAQQ IMAGEIOCOMS - [(FNS IMAGESTREAMP IMAGESTREAMTYPE IMAGESTREAMTYPEP OPENIMAGESTREAM \GOOD.DASHLST) + [(FNS OPENIMAGESTREAM) + (FNS IMAGESTREAMP IMAGESTREAMTYPE IMAGESTREAMTYPEP IMAGEFILEPROP IMAGESOURCEFILEP + IMAGESOURCETYPE) + (FNS EXTENSIONS.FOR.IMAGEFILETYPE IMAGEFILETYPE.FROM.EXTENSION) + (FNS CONVERT.TO.IMAGEFILE) + (FNS BITMAPFILEP BITMAP.TO.BITMAPFILE BITMAPFILE.TO.BITMAP BITMAPFILE.TO.IMAGEFILE) + (FNS BITMAP.TO.IMAGEFILE WINDOW.TO.IMAGEFILE SCREENREGION.TO.IMAGEFILE COPY.WINDOW.TO.BITMAP) + (COMS (ADDVARS (PRINTFILETYPES (DEFAULT))) + (GLOBALVARS PRINTFILETYPES) + (FNS DEFAULT.IMAGETYPE.CONVERSIONS) + [P (DEFAULT.IMAGETYPE.CONVERSIONS '(BITMAP BITMAP.TO.IMAGEFILE WINDOW + WINDOW.TO.IMAGEFILE SCREENREGION + SCREENREGION.TO.IMAGEFILE BITMAPFILE + BITMAPFILE.TO.IMAGEFILE] + (ALISTS (PRINTFILETYPES BITMAP WINDOW SCREENREGION BITMAPFILE TEXT))) + (COMS (* ; "Until HTML streams") + (ALISTS (PRINTFILETYPES HTML)) + (FNS HTMLFILEP)) (INITVARS (IMAGESTREAMTYPES NIL)) + (FNS \GOOD.DASHLST) (FNS DRAWDASHEDLINE) (FNS DSPBACKCOLOR DSPBOTTOMMARGIN DSPCOLOR DSPCLIPPINGREGION DSPRESET DSPFONT DSPLEFTMARGIN DSPLINEFEED DSPOPERATION DSPRIGHTMARGIN DSPTOPMARGIN DSPSCALE DSPSPACEFACTOR @@ -59,6 +74,38 @@ (LAMA IMAGESTREAMP]) (DEFINEQ +(OPENIMAGESTREAM + [LAMBDA (IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 17-Jan-2026 12:18 by rmk") + (* ; "Edited 12-Jan-2026 15:20 by rmk") + (* ; "Edited 7-Dec-2025 13:47 by rmk") + (* ; "Edited 25-Sep-2025 21:32 by rmk") + (* ; "Edited 19-Sep-2025 15:58 by rmk") + (* ; "Edited 1-Jun-93 12:32 by rmk:") + (* ; "Edited 11-Jan-91 16:05 by jds") + + (* ;; "Opens IMAGEFILE as an IMAGETYPE imagestream, returning IMAGEFILE is it is already an open stream of that type") + + (DECLARE (GLOBALVARS IMAGESTREAMTYPES)) + (CL:UNLESS IMAGEFILE + [SETQ IMAGEFILE (UNIX-TMP-FILE-NAME 'imagefile (CAR (EXTENSIONS.FOR.IMAGEFILETYPE IMAGETYPE]) + (if [AND (\GETSTREAM IMAGEFILE 'OUTPUT T) + (OR (EQ IMAGETYPE (IMAGESTREAMP IMAGEFILE)) + (AND (NULL IMAGETYPE) + (IMAGESTREAMP IMAGEFILE] + then IMAGEFILE + else (APPLY* (OR (CAR (GETMULTI IMAGESTREAMTYPES IMAGETYPE 'OPENSTREAM)) + (ERROR "No open function for " IMAGETYPE " streams")) + (CL:IF (OR (EQ IMAGETYPE 'DISPLAY) + (STREAMP (FULLNAME IMAGEFILE))) + IMAGEFILE + (PACKFILENAME 'BODY (\CONVERT-PATHNAME IMAGEFILE) + 'EXTENSION + (OR (CAR (EXTENSIONS.FOR.IMAGEFILETYPE IMAGETYPE)) + IMAGETYPE))) + OPTIONS]) +) +(DEFINEQ + (IMAGESTREAMP [LAMBDA NARGS (* ; "Edited 18-Jan-87 17:25 by bvm:") (PROG ([STREAM (AND (IGREATERP NARGS 0) @@ -78,8 +125,12 @@ STREAM]) (IMAGESTREAMTYPE - [LAMBDA (STREAM) (* rmk%: "20-AUG-83 17:28") - (fetch (IMAGEOPS IMAGETYPE) of (fetch (STREAM IMAGEOPS) of (\STREAMARG STREAM]) + [LAMBDA (STREAM) (* ; "Edited 19-Jan-2026 13:40 by rmk") + (* ; "Edited 17-Jan-2026 08:10 by rmk") + (* rmk%: "20-AUG-83 17:28") + (AND (STREAMP STREAM) + (OR (fetch (IMAGEOPS IMAGETYPE) of (fetch (STREAM IMAGEOPS) of (\STREAMARG STREAM))) + (STREAMPROP STREAM 'IMAGEFILETYPE]) (IMAGESTREAMTYPEP [LAMBDA (STREAM STYPE) (* AJB "16-Jul-85 15:31") @@ -95,79 +146,392 @@ of (fetch (STREAM IMAGEOPS) of S]) -(OPENIMAGESTREAM - [LAMBDA (FILE IMAGETYPE OPTIONS) (* ; "Edited 1-Jun-93 12:32 by rmk:") - (* ; "Edited 11-Jan-91 16:05 by jds") +(IMAGEFILEPROP + [LAMBDA (IMAGEFILETYPE PROP) (* ; "Edited 19-Dec-2025 10:48 by rmk") + (* ; "Edited 29-Oct-2025 13:32 by rmk") + (LET [(VAL (CAR (GETMULTI PRINTFILETYPES IMAGEFILETYPE PROP] + (if (NULL VAL) + then (CAR (GETMULTI PRINTFILETYPES 'DEFAULT PROP)) + elseif (LISTP VAL) + then (APPEND VAL (CAR (GETMULTI PRINTFILETYPES 'DEFAULT PROP))) + else VAL]) - (* ;; "Opens an IMAGETYPE imagestream, or if NIL, an imagestream of a type that FILE (perhaps from DEFAULTPRINTINGHOST) can print directly. If FILE is an the LPT device, then the type of the corresponding printer is used. If FILE is NIL, then an LPT file on a printer from default printinghost is used, so the file will be printed on closing.") +(IMAGESOURCEFILEP + [LAMBDA (IMAGESOURCE) (* ; "Edited 23-Dec-2025 15:38 by rmk") + (AND IMAGESOURCE (OR (STRINGP IMAGESOURCE) + (LITATOM IMAGESOURCE) + (CL:PATHNAMEP IMAGESOURCE]) - (DECLARE (GLOBALVARS IMAGESTREAMTYPES)) - (LET (LPTNAME LPTP (DEFPRINTER (OR (CAR (LISTP DEFAULTPRINTINGHOST)) - DEFAULTPRINTINGHOST))) - (SETQ FILE (\CONVERT-PATHNAME FILE)) - [COND - ((AND (NULL FILE) - (NEQ IMAGETYPE 'DISPLAY)) (* ; - "YUCK! TAKE THIS OUT WHEN WE FIGURE OUT DISPLAY IMAGESTREAMS BETTER") - (SETQ LPTP T) - (SETQ FILE '{LPT})) - ((STREAMP FILE)) - ((EQ (FILENAMEFIELD FILE 'HOST) - 'LPT) - (SETQ LPTP T) - (LET (POS) +(IMAGESOURCETYPE + [LAMBDA (X) (* ; "Edited 17-Jan-2026 08:10 by rmk") + (* ; "Edited 16-Jan-2026 07:30 by rmk") + (* ; "Edited 14-Jan-2026 16:45 by rmk") + (* ; "Edited 13-Jan-2026 16:14 by rmk") + (* ; "Edited 12-Jan-2026 00:30 by rmk") + (* ; "Edited 29-Dec-2025 16:57 by rmk") + (* ; "Edited 24-Dec-2025 14:38 by rmk") + (* ; "Edited 20-Dec-2025 14:07 by rmk") + (* ; "Edited 28-Sep-2025 11:35 by rmk") + (* ; "Edited 18-Sep-2025 11:13 by rmk") + (* ; "Edited 13-Sep-2025 23:36 by rmk") + (* ; "Edited 3-Mar-93 14:34 by rmk:") + (* ; "Edited 22-Aug-92 14:27 by jds") + (* ; "Edited 26-Aug-87 14:22 by Snow") + (if (WINDOWP X) + then (OR (WINDOWPROP X 'IMAGETYPE) + 'WINDOW) + elseif (CAR (ASSOC (IMAGESTREAMTYPE X) + PRINTFILETYPES)) + else (LET ((FULLX X) + EXT) + (CL:WHEN (IMAGESOURCEFILEP X) (* ; "Should the caller do this?") + (SETQ FULLX (FINDFILE X T)) + (SETQ EXT (FILENAMEFIELD FULLX 'EXTENSION))) + (if (AND EXT (IMAGEFILETYPE.FROM.EXTENSION NIL EXT)) + elseif [CAR (find ITYPE TESTFN in PRINTFILETYPES + when [SETQ TESTFN (CAR (GETMULTI ITYPE 'TEST] + suchthat (CAR (NLSETQ (APPLY* TESTFN (OR FULLX X] + elseif FULLX + then (GETFILEINFO FULLX 'TYPE]) +) +(DEFINEQ - (* ;; "This should be (FILENAMEFIELD FILE 'NAME) except that FILENAMEFIELD won't accept : as part of the name, thinks it marks a device field. This code is borrowed from PRINTERDEVICE") +(EXTENSIONS.FOR.IMAGEFILETYPE + [LAMBDA (TYPE) (* ; "Edited 16-Jan-2026 23:58 by rmk") + (* ; "Edited 12-Jan-2026 15:20 by rmk") + (* ; "Edited 10-Sep-2025 14:43 by rmk") + (* ; "Edited 26-Aug-87 14:11 by Snow") + (DECLARE (GLOBALVARS PRINTFILETYPES)) + (CAR (MKLIST (OR (GETMULTI PRINTFILETYPES (U-CASE TYPE) + 'EXTENSION) + TYPE]) - (AND (SETQ POS (STRPOS "}" FILE)) - (SETQ LPTNAME (SUBATOM FILE (ADD1 POS) - (SUB1 (OR (STRPOS "." FILE (ADD1 POS)) - 0] - [COND - [(NULL IMAGETYPE) +(IMAGEFILETYPE.FROM.EXTENSION + [LAMBDA (FILE EXT) (* ; "Edited 20-Sep-2025 12:35 by rmk") + (* ; "Edited 26-Aug-87 14:11 by Snow") + (* ; + "return the imagestream type corresponding to the extension") + (CL:UNLESS EXT + [SETQ EXT (U-CASE (FILENAMEFIELD FILE 'EXTENSION]) + (for TYPE in PRINTFILETYPES when [FMEMB EXT (CADR (ASSOC 'EXTENSION (CDR TYPE] + do (RETURN (CAR TYPE]) +) +(DEFINEQ - (* ;; "Get the image type from FILE if it is an LPT file, otherwise choose the image type from the first printer on DEFAULTPRINTINGHOST") +(CONVERT.TO.IMAGEFILE + [LAMBDA (IMAGESOURCE IMAGEFILE IMAGEFILETYPE OPTIONS NOERROR) + (* ; "Edited 17-Jan-2026 12:41 by rmk") + (* ; "Edited 12-Jan-2026 23:49 by rmk") + (* ; "Edited 11-Jan-2026 13:21 by rmk") + (* ; "Edited 25-Dec-2025 09:08 by rmk") + (* ; "Edited 21-Dec-2025 09:02 by rmk") + (* ; "Edited 13-Dec-2025 11:46 by rmk") + (* ; "Edited 2-Nov-2025 08:53 by rmk") + (* ; "Edited 29-Oct-2025 13:33 by rmk") + (* ; "Edited 26-Sep-2025 23:46 by rmk") + (* ; "Edited 20-Sep-2025 12:57 by rmk") + (* ; "Edited 18-Sep-2025 23:35 by rmk") + (* ; "Edited 13-Sep-2025 20:11 by rmk") + (* ; "Edited 12-Sep-2025 19:50 by rmk") + (* ; "Edited 24-Sep-2023 15:25 by rmk") + (* ; "Edited 14-Sep-2023 22:58 by rmk") - (* ;; "Assume that it will be printed on the defaultprintinghost if it is an ordinary filename. If defaultprinter is a list, chooses the preferred-file-type if it is specified, otherwise uses the first of the printer type's CANPRINT property. ") + (* ;; "If this is the result of (COPYFILE 'XXX {LPT}), then XXX (e.g. a Tedit file) has already been copied once, to the LPT device, where it has lost its original identity. PRINTERDEVICE.CLOSEFN calls SEND.FILE.TO.PRINTER, which calls this to apply the (e.g. Tedit) conversion method for the imagetype of this PRINTERTYPE. In that case there is no reason for the conversion function to print the name of its target image stream") - (SETQ IMAGETYPE (COND - ((PRINTFILETYPE.FROM.EXTENSION FILE)) - [(AND (NOT LPTNAME) - (CADDR (LISTP DEFPRINTER] - [(CAR (MKLIST (PRINTERPROP (PRINTERTYPE (OR LPTNAME DEFPRINTER)) - 'CANPRINT] - (T (ERROR "Can't determine IMAGETYPE for " FILE] - [LPTNAME (OR (EQMEMB IMAGETYPE (PRINTERPROP (PRINTERTYPE LPTNAME) - 'CANPRINT)) - (ERROR (CONCAT "Printer " LPTNAME " can't print " IMAGETYPE " files"] - (LPTP (* ; - "This includes the NIL FILE case, cause of initial coercion") - (FOR P INSIDE DEFAULTPRINTINGHOST WHEN (EQMEMB IMAGETYPE - (PRINTERPROP (PRINTERTYPE - P) - 'CANPRINT)) - DO (SETQ LPTNAME (PRINTERNAME P)) - (SETQ FILE (PACKFILENAME 'HOST 'LPT 'NAME LPTNAME)) - (RETURN) FINALLY (ERROR (CONCAT - "Can't find a printer on DEFAULTPRINTINGHOST that can print " - IMAGETYPE " files"] - (LET ((STREAM (APPLY* (OR [CADR (ASSOC 'OPENSTREAM (CDR (ASSOC IMAGETYPE IMAGESTREAMTYPES] - (ERROR "No open function for " IMAGETYPE " streams")) - [COND - ((OR LPTP (STREAMP FILE) - (EQ IMAGETYPE 'DISPLAY)) - FILE) - (T (* ; - "Stick on default extension from PRINTFILETYPES") - (PACKFILENAME 'BODY FILE 'EXTENSION - (OR [CAR (CADR (ASSOC 'EXTENSION (CDR (ASSOC IMAGETYPE - PRINTFILETYPES - ] - IMAGETYPE] - OPTIONS))) - (IF LPTNAME - THEN (STREAMPROP STREAM 'PRINTERNAME LPTNAME)) - STREAM]) + (CL:WHEN (IMAGESOURCEFILEP IMAGESOURCE) + (SETQ IMAGESOURCE (FINDFILE IMAGESOURCE T))) + (CL:UNLESS IMAGEFILETYPE + (SETQ IMAGEFILETPE (LISTGET OPTIONS 'IMAGEFILETYPE))) + [if NOERROR + then (push OPTIONS 'NOERROR T) + else (SETQ NOERROR (LISTGET OPTIONS 'NOERROR] + (CL:WHEN (AND (NULL IMAGEFILETYPE) + (LISTP IMAGEFILE)) + (SETQ IMAGEFILETYPE (CDR IMAGEFILE)) + (SETQ IMAGEFILE (CAR IMAGEFILE))) + (CL:UNLESS IMAGEFILETYPE (* ; + "maybe we can get it from the filename") + (SETQ IMAGEFILETYPE (IMAGESOURCETYPE IMAGEFILE))) + (CL:WHEN (MEMB IMAGEFILETYPE '(PDF POSTSCRIPT)) (* ; "POSTSCRIPT SCREWS UP") + (push OPTIONS 'HEADING NIL)) + (LET + ((SOURCETYPE (IMAGESOURCETYPE IMAGESOURCE)) + CONVERTED CFN) + + (* ;; "The conversion function may abandon the IMAGEFILE we provide and create its own.") + + (if (EQ IMAGEFILETYPE SOURCETYPE) + then + (* ;; "Already have what we want") + + IMAGESOURCE + else (if [AND (SETQ CFN (OR (LISTGET (IMAGEFILEPROP IMAGEFILETYPE 'CONVERSION) + SOURCETYPE) + (LISTGET (IMAGEFILEPROP 'DEFAULT 'CONVERSION) + SOURCETYPE))) + (SETQ CONVERTED (CAR (NLSETQ (APPLY* CFN IMAGESOURCE + [OR (STREAMP IMAGEFILE) + (AND IMAGEFILE + (PACKFILENAME 'BODY IMAGEFILE + 'EXTENSION + (CAR ( + EXTENSIONS.FOR.IMAGEFILETYPE + IMAGEFILETYPE] + IMAGEFILETYPE OPTIONS] + then (CL:WHEN (STREAMP CONVERTED) (* ; "Can't tell from the name") + (STREAMPROP CONVERTED 'IMAGETYPE IMAGEFILETYPE)) + (CLOSEF? CONVERTED) + CONVERTED + elseif NOERROR + then NIL + else (ERROR (CONCAT "Can't convert " SOURCETYPE " file to " IMAGEFILETYPE) + (CL:IF (STREAMP IMAGESOURCE) + (FULLNAME IMAGESOURCE) + IMAGESOURCE)]) +) +(DEFINEQ + +(BITMAPFILEP + [LAMBDA (FILE) (* ; "Edited 23-Dec-2025 15:28 by rmk") + (* ; "Edited 19-Dec-2025 10:56 by rmk") + + (* ;; "True if FILE is a file containing a single bitmap.") + + (CL:WHEN + [AND FILE + (OR (EQ 'BITMAPFILE (IMAGEFILETYPE.FROM.EXTENSION FILE)) + (EQ 'BITMAP (OR (RESETLST + [LET ((STREAM (GETSTREAM FILE 'INPUT T))) + [if STREAM + then [RESETSAVE (GETFILEPTR FILE) + `(PROGN (SETFILEPTR ,FILE OLDVALUE] + else (RESETSAVE (SETQ STREAM (OPENSTREAM (CL:IF + (STREAMP FILE) + (FULLNAME + FILE) + FILE) + 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE] + (CAR (NLSETQ (RATOM FILE (FIND-READTABLE "INTERLISP"])] + 'BITMAPFILE]) + +(BITMAP.TO.BITMAPFILE + [LAMBDA (BITMAP IMAGEFILE REGION) (* ; "Edited 20-Dec-2025 23:29 by rmk") + (* ; "Edited 19-Dec-2025 17:51 by rmk") + (CL:WHEN (WINDOWP BITMAP) + (SETQ BITMAP (COPY.WINDOW.TO.BITMAP BITMAP))) + (CL:UNLESS IMAGEFILE + (SETQ IMAGEFILE (OPENSTREAM '{NODIRCORE} 'OUTPUT))) + (RESETLST + (LET ((STREAM (GETSTREAM IMAGEFILE 'OUTPUT T)) + (*READTABLE* (FIND-READTABLE "INTERLISP")) + SUBBITMAP) + (CL:UNLESS STREAM + [RESETSAVE (SETQ STREAM (OPENSTREAM [PACKFILENAME 'BODY IMAGEFILE 'EXTENSION + (CAR (EXTENSIONS.FOR.IMAGEFILETYPE + 'BITMAPFILE] + 'OUTPUT)) + `(PROGN (CLOSEF? OLDVALUE]) + (CL:WHEN REGION + (SETQ SUBBITMAP (BITMAPCREATE (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION) + (BITSPERPIXEL BITMAP))) + (BITBLT BITMAP (fetch (REGION LEFT) of REGION) + (fetch (REGION BOTTOM) of REGION) + SUBBITMAP 0 0 (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION))) + (PRINT 'BITMAP STREAM) + (\PRINTBINARYBITMAP (OR SUBBITMAP BITMAP) + STREAM) + (CLOSEF? STREAM)))]) + +(BITMAPFILE.TO.BITMAP + [LAMBDA (FILE) (* ; "Edited 19-Dec-2025 11:00 by rmk") + (CL:UNLESS (BITMAPFILEP FILE) + (ERROR FILE "is not a bitmap file")) + (RESETLST + (LET ((STREAM (GETSTREAM FILE 'INPUT T)) + (*READTABLE* (FIND-READTABLE "INTERLISP"))) + (CL:UNLESS STREAM + [RESETSAVE (SETQ STREAM (OPENSTREAM (FULLNAME FILE) + 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE]) + (RATOM STREAM) + (READCCODE STREAM) + (\READBINARYBITMAP STREAM)))]) + +(BITMAPFILE.TO.IMAGEFILE + [LAMBDA (BMFILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 20-Dec-2025 23:18 by rmk") + (BITMAP.TO.IMAGEFILE (BITMAPFILE.TO.BITMAP BMFILE) + IMAGEFILE IMAGETYPE OPTIONS]) +) +(DEFINEQ + +(BITMAP.TO.IMAGEFILE + [LAMBDA (BITMAP IMAGEFILE IMAGEFILETYPE OPTIONS) (* ; "Edited 23-Dec-2025 15:40 by rmk") + (* ; "Edited 18-Dec-2025 23:32 by rmk") + + (* ;; "Render BITMAP in IMAGEFILE of type IMAGETYPE") + + (DECLARE (SPECVARS T)) + (LET [(SCALEFACTOR (LISTGET OPTIONS 'SCALEFACTOR)) + (REGION (LISTGET OPTIONS 'REGION)) + (ROTATION (LISTGET OPTIONS 'ROTATION)) + (TITLE (LISTGET OPTIONS 'TITLE] + (DECLARE (SPECVARS . T)) + (CL:UNLESS SCALEFACTOR + [LET [(FN (IMAGEFILEPROP IMAGEFILETYPE 'BITMAPSCALE] + (SETQ SCALEFACTOR (if (NOT FN) + then 1 + elseif REGION + then (APPLY* FN (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION) + IMAGEFILETYPE) + else (APPLY* FN (fetch (BITMAP BITMAPWIDTH) of BITMAP) + (fetch (BITMAP BITMAPHEIGHT) of BITMAP) + IMAGEFILETYPE]) + (CL:WHEN (LISTP SCALEFACTOR) + (SETQ ROTATION (CDR SCALEFACTOR)) + (SETQ SCALEFACTOR (CAR SCALEFACTOR))) + (EVAL (IMAGEFILEPROP IMAGEFILETYPE 'BITMAPFILE]) + +(WINDOW.TO.IMAGEFILE + [LAMBDA (WINDOW IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 24-Dec-2025 07:57 by rmk") + (* ; "Edited 19-Dec-2025 18:20 by rmk") + (* ; "Edited 3-Nov-2025 16:10 by rmk") + (* ; "Edited 29-Sep-2025 23:54 by rmk") + (* ; "Edited 19-Sep-2025 17:09 by rmk") + (* ; "Edited 26-Nov-96 15:59 by rmk:") + (* ; "Edited 13-Nov-87 14:16 by Snow") + + (* ;; "Either run window's HARDCOPYFN or produce a bitmap file. The HARDCOPYFN can be a list of the form (fn heading) where heading=TITLE means use the window's title, otherwise using the non-nil heading.") + + (* ;; "If there is a hardcopy") + + (* ;; + "The information put in IMAGEFILE comes from WINDOW via the HARDCOPYFN, or the bitmap if no fn. ") + + (* ;; "Value is the completed IMAGEFILE.") + + (* ;; "Note: if the window has an IMAGETYPE property (e.g. TEDIT), then conversion to IMAGETYPE is handled by the appropriate entry on PRINTFILETYPES.") + + (CL:WHEN IMAGEFILE + (CL:WHEN (AND (LISTP IMAGEFILE) + (NULL IMAGETYPE)) + (SETQ IMAGETYPE (CDR IMAGEFILE)) + (SETQ IMAGEFILE (CAR IMAGEFILE))) + (LET ((HARDCOPYFN (WINDOWPROP WINDOW 'HARDCOPYFN)) + HEADING) + (if (NULL HARDCOPYFN) + then (* ; "knows how to default") + (CL:WHEN (EQ 'TITLE (LISTGET OPTIONS 'HEADING)) + [SETQ OPTIONS `(HEADING ,(WINDOWPROP WINDOW 'TITLE) + ,@OPTIONS]) + (CONVERT.TO.IMAGEFILE (COPY.WINDOW.TO.BITMAP WINDOW) + IMAGEFILE IMAGETYPE OPTIONS) + else (CL:WHEN (AND (LISTP HARDCOPYFN) + (FNTYP (CAR HARDCOPYFN))) + (SETQ HEADING (CADR HARDCOPYFN)) + (CL:WHEN (EQ HEADING 'TITLE) + (SETQ HEADING (WINDOWPROP WINDOW 'TITLE))) + (SETQ HARDCOPYFN (CAR HARDCOPYFN))) + (CL:WHEN HEADING + [SETQ OPTIONS `(HEADING ,HEADING ,@OPTIONS]) + (CL:WITH-OPEN-STREAM (IMAGESTREAM (OPENIMAGESTREAM IMAGEFILE IMAGETYPE OPTIONS)) + (APPLY* HARDCOPYFN WINDOW IMAGESTREAM IMAGETYPE OPTIONS)) + IMAGEFILE)))]) + +(SCREENREGION.TO.IMAGEFILE + [LAMBDA (REGION IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 23-Dec-2025 20:13 by rmk") + (* ; "Edited 19-Dec-2025 15:24 by rmk") + (CL:UNLESS REGION + (PROMPTPRINT "Select a region") + (SETQ REGION (GETREGION)) + (CLRPROMPT)) + (LET [(BITMAP (BITMAPCREATE (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION) + (BITSPERPIXEL (SCREENBITMAP] + (BITBLT (SCREENBITMAP) + (fetch (REGION LEFT) of REGION) + (fetch (REGION BOTTOM) of REGION) + BITMAP 0 0 (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION)) + (CONVERT.TO.IMAGEFILE BITMAP IMAGEFILE IMAGETYPE OPTIONS]) + +(COPY.WINDOW.TO.BITMAP + [LAMBDA (WINDOW) (* ; "Edited 26-Aug-87 14:09 by Snow") + +(* ;;; "copies contents of window (including title and border) into a bitmap") + + (COND + ((OPENWP WINDOW) + (PROG (REGION SCREEN LEFT BOTTOM WIDTH HEIGHT BITMAP) + (SETQ REGION (WINDOWPROP WINDOW 'REGION)) + (SETQ SCREEN (WINDOWPROP WINDOW 'SCREEN)) + (SETQ LEFT (fetch (REGION LEFT) of REGION)) + (SETQ BOTTOM (fetch (REGION BOTTOM) of REGION)) + (SETQ WIDTH (fetch (REGION WIDTH) of REGION)) + (SETQ HEIGHT (fetch (REGION HEIGHT) of REGION)) + (SETQ BITMAP (BITMAPCREATE WIDTH HEIGHT (BITSPERPIXEL WINDOW))) + (.WHILE.TOP.DS. WINDOW (BITBLT (SCREENBITMAP SCREEN) + LEFT BOTTOM BITMAP 0 0 WIDTH HEIGHT)) + (RETURN BITMAP))) + (T (BITMAPCOPY (WINDOWPROP WINDOW 'IMAGECOVERED]) +) + +(ADDTOVAR PRINTFILETYPES (DEFAULT)) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS PRINTFILETYPES) +) +(DEFINEQ + +(DEFAULT.IMAGETYPE.CONVERSIONS + [LAMBDA (CONVERSIONS) (* ; "Edited 18-Jan-2026 00:18 by rmk") + + (* ;; "Adds CONVERSIONS to the DEFAULT PRINTFILETYPE") + (* ; "Edited 24-Dec-2025 22:42 by rmk") + (CL:UNLESS (EQ 0 (IMOD (LENGTH CONVERSIONS) + 2)) + (ERROR "CONVERSIONS is not a property list")) + (PUTMULTI PRINTFILETYPES 'DEFAULT 'CONVERSION + (CONS (for CTAIL (CURRENT _ (OR (CAR (GETMULTI PRINTFILETYPES 'DEFAULT 'CONVERSION)) + (LIST (CAR CONVERSIONS) + NIL))) on CONVERSIONS by (CDDR CTAIL) + do (LISTPUT CURRENT (CAR CTAIL) + (CADR CTAIL)) finally (RETURN CURRENT]) +) + +(DEFAULT.IMAGETYPE.CONVERSIONS '(BITMAP BITMAP.TO.IMAGEFILE WINDOW WINDOW.TO.IMAGEFILE SCREENREGION + SCREENREGION.TO.IMAGEFILE BITMAPFILE BITMAPFILE.TO.IMAGEFILE)) + +(ADDTOVAR PRINTFILETYPES + (BITMAP (TEST BITMAPP)) + (WINDOW (TEST WINDOWP)) + (SCREENREGION (TEST REGIONP)) + (BITMAPFILE (TEST BITMAPFILEP) + (EXTENSION (BM BITMAP)) + (CONVERSION (BITMAP BITMAP.TO.BITMAPFILE))) + (TEXT (TEST LISPSOURCEFILEP) + (EXTENSION (TXT TEXT)))) + + + +(* ; "Until HTML streams") + + +(ADDTOVAR PRINTFILETYPES (HTML (TEST HTMLFILEP) + (EXTENSION (HTML HTM)))) +(DEFINEQ + +(HTMLFILEP + [LAMBDA (X) (* ; "Edited 28-Dec-2025 17:53 by rmk") + (MEMB (FILENAMEFIELD X 'EXTENSION) + (EXTENSIONS.FOR.IMAGEFILETYPE 'HTML]) +) + +(RPAQ? IMAGESTREAMTYPES NIL) +(DEFINEQ (\GOOD.DASHLST [LAMBDA (DASHING BRUSH) (* rrb " 9-Sep-86 16:16") @@ -205,8 +569,6 @@ BRUSHSIZE] (RETURN DASHLST]) ) - -(RPAQ? IMAGESTREAMTYPES NIL) (DEFINEQ (DRAWDASHEDLINE @@ -1515,24 +1877,32 @@ (ADDTOVAR LAMA IMAGESTREAMP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3376 12133 (IMAGESTREAMP 3386 . 4218) (IMAGESTREAMTYPE 4220 . 4433) (IMAGESTREAMTYPEP -4435 . 5070) (OPENIMAGESTREAM 5072 . 10026) (\GOOD.DASHLST 10028 . 12131)) (12168 14465 ( -DRAWDASHEDLINE 12178 . 14463)) (14466 21806 (DSPBACKCOLOR 14476 . 14848) (DSPBOTTOMMARGIN 14850 . -15235) (DSPCOLOR 15237 . 15601) (DSPCLIPPINGREGION 15603 . 16308) (DSPRESET 16310 . 16590) (DSPFONT -16592 . 16956) (DSPLEFTMARGIN 16958 . 17339) (DSPLINEFEED 17341 . 17641) (DSPOPERATION 17643 . 18020) -(DSPRIGHTMARGIN 18022 . 18405) (DSPTOPMARGIN 18407 . 18786) (DSPSCALE 18788 . 19155) (DSPSPACEFACTOR -19157 . 19550) (DSPXPOSITION 19552 . 19857) (DSPYPOSITION 19859 . 20164) (DSPROTATE 20166 . 20461) ( -DSPPUSHSTATE 20463 . 20709) (DSPPOPSTATE 20711 . 20954) (DSPDEFAULTSTATE 20956 . 21208) (DSPSCALE2 -21210 . 21501) (DSPTRANSLATE 21503 . 21804)) (21807 30608 (DSPNEWPAGE 21817 . 22509) (DRAWBETWEEN -22511 . 23213) (DRAWCIRCLE 23215 . 23711) (DRAWARC 23713 . 24230) (DRAWCURVE 24232 . 24909) ( -DRAWELLIPSE 24911 . 25697) (DRAWLINE 25699 . 26089) (DRAWPOLYGON 26091 . 26546) (DRAWPOINT 26548 . -26967) (FILLPOLYGON 26969 . 27535) (DRAWTO 27537 . 27955) (FILLCIRCLE 27957 . 28180) (MOVETO 28182 . -28546) (RELDRAWTO 28548 . 29465) (BITMAPIMAGESIZE 29467 . 29638) (SCALEDBITBLT 29640 . 30606)) (30609 -37648 (\DRAWPOINT.GENERIC 30619 . 30966) (\DRAWPOLYGON.GENERIC 30968 . 33276) (\DRAWCIRCLE.GENERIC -33278 . 34936) (\DRAWELLIPSE.GENERIC 34938 . 37646)) (37649 42593 (\IMAGEIOINIT 37659 . 40939) ( -\NOIMAGE.DSPFONT 40941 . 42427) (\UNIMPIMAGEOP 42429 . 42591)) (42716 45840 (INSURE.BRUSH 42726 . -44100) (BRUSHP 44102 . 44892) (\POSSIBLECOLOR 44894 . 45445) (NEGSHADE 45447 . 45838)) (46396 47080 ( -DASHINGP 46406 . 46736) (INSURE.DASHING 46738 . 47078)) (57818 78364 (\DisplayEventFn 57828 . 58338) ( -\DISPLAYINIT 58340 . 63923) (\4DISPLAYINIT 63925 . 68626) (\8DISPLAYINIT 68628 . 73331) ( -\24DISPLAYINIT 73333 . 78105) (\DISPLAYSTREAMTYPEBPP 78107 . 78362))))) + (FILEMAP (NIL (4337 6241 (OPENIMAGESTREAM 4347 . 6239)) (6242 11483 (IMAGESTREAMP 6252 . 7084) ( +IMAGESTREAMTYPE 7086 . 7602) (IMAGESTREAMTYPEP 7604 . 8239) (IMAGEFILEPROP 8241 . 8779) ( +IMAGESOURCEFILEP 8781 . 9058) (IMAGESOURCETYPE 9060 . 11481)) (11484 12775 ( +EXTENSIONS.FOR.IMAGEFILETYPE 11494 . 12136) (IMAGEFILETYPE.FROM.EXTENSION 12138 . 12773)) (12776 17758 + (CONVERT.TO.IMAGEFILE 12786 . 17756)) (17759 21850 (BITMAPFILEP 17769 . 19270) (BITMAP.TO.BITMAPFILE +19272 . 20949) (BITMAPFILE.TO.BITMAP 20951 . 21605) (BITMAPFILE.TO.IMAGEFILE 21607 . 21848)) (21851 +28176 (BITMAP.TO.IMAGEFILE 21861 . 23418) (WINDOW.TO.IMAGEFILE 23420 . 26249) ( +SCREENREGION.TO.IMAGEFILE 26251 . 27155) (COPY.WINDOW.TO.BITMAP 27157 . 28174)) (28284 29190 ( +DEFAULT.IMAGETYPE.CONVERSIONS 28294 . 29188)) (29904 30130 (HTMLFILEP 29914 . 30128)) (30165 32280 ( +\GOOD.DASHLST 30175 . 32278)) (32281 34578 (DRAWDASHEDLINE 32291 . 34576)) (34579 41919 (DSPBACKCOLOR +34589 . 34961) (DSPBOTTOMMARGIN 34963 . 35348) (DSPCOLOR 35350 . 35714) (DSPCLIPPINGREGION 35716 . +36421) (DSPRESET 36423 . 36703) (DSPFONT 36705 . 37069) (DSPLEFTMARGIN 37071 . 37452) (DSPLINEFEED +37454 . 37754) (DSPOPERATION 37756 . 38133) (DSPRIGHTMARGIN 38135 . 38518) (DSPTOPMARGIN 38520 . 38899 +) (DSPSCALE 38901 . 39268) (DSPSPACEFACTOR 39270 . 39663) (DSPXPOSITION 39665 . 39970) (DSPYPOSITION +39972 . 40277) (DSPROTATE 40279 . 40574) (DSPPUSHSTATE 40576 . 40822) (DSPPOPSTATE 40824 . 41067) ( +DSPDEFAULTSTATE 41069 . 41321) (DSPSCALE2 41323 . 41614) (DSPTRANSLATE 41616 . 41917)) (41920 50721 ( +DSPNEWPAGE 41930 . 42622) (DRAWBETWEEN 42624 . 43326) (DRAWCIRCLE 43328 . 43824) (DRAWARC 43826 . +44343) (DRAWCURVE 44345 . 45022) (DRAWELLIPSE 45024 . 45810) (DRAWLINE 45812 . 46202) (DRAWPOLYGON +46204 . 46659) (DRAWPOINT 46661 . 47080) (FILLPOLYGON 47082 . 47648) (DRAWTO 47650 . 48068) ( +FILLCIRCLE 48070 . 48293) (MOVETO 48295 . 48659) (RELDRAWTO 48661 . 49578) (BITMAPIMAGESIZE 49580 . +49751) (SCALEDBITBLT 49753 . 50719)) (50722 57761 (\DRAWPOINT.GENERIC 50732 . 51079) ( +\DRAWPOLYGON.GENERIC 51081 . 53389) (\DRAWCIRCLE.GENERIC 53391 . 55049) (\DRAWELLIPSE.GENERIC 55051 . +57759)) (57762 62706 (\IMAGEIOINIT 57772 . 61052) (\NOIMAGE.DSPFONT 61054 . 62540) (\UNIMPIMAGEOP +62542 . 62704)) (62829 65953 (INSURE.BRUSH 62839 . 64213) (BRUSHP 64215 . 65005) (\POSSIBLECOLOR 65007 + . 65558) (NEGSHADE 65560 . 65951)) (66509 67193 (DASHINGP 66519 . 66849) (INSURE.DASHING 66851 . +67191)) (77931 98477 (\DisplayEventFn 77941 . 78451) (\DISPLAYINIT 78453 . 84036) (\4DISPLAYINIT 84038 + . 88739) (\8DISPLAYINIT 88741 . 93444) (\24DISPLAYINIT 93446 . 98218) (\DISPLAYSTREAMTYPEBPP 98220 . +98475))))) STOP diff --git a/sources/IMAGEIO.LCOM b/sources/IMAGEIO.LCOM index 572b20320086c6a2f67609c269d35d505ae7baba..1af83af10c5af6f9277d1577e72249bbfed0215a 100644 GIT binary patch delta 11530 zcmbVS+ixS+dFPPY^)72`NqHmN@-{hE+FDW}fkTlLsr14jITUA?oZ)hYE6G)y>@GK! z_Kw|+<05FseJRkl*n)!;G4hb0fYYFetX;OX15^)1+V~-l?PDJbv~LB3{ssMg-#K$3 zb-|_!EH!h^nREHR-}n12Gar4F9R5f0d+QhV%Hrkg_ZRcId`akq)m(YCSp4A5qF>bK zMS4~*$9jva`P^!8WmepHbnE7Wdk=T+-WrHo?>&6<_;*)@)iKsg*Xx-^$J^|hV&}e? zZT8!35uajdX=zpru0O$ZN9Wd8bA{RY^jyumPn+k!!Ny)z(3GYPuy|b$HWj`-0+cSG@%k3`G zLr|n;uL)hx38~Yr&~rsW3gtP=WnuPuPESA!G4XUoVeEc6FSgc9PfjBAis;+c#-i8h zF4F#ZErIn<-5@ZbFIS==LeCd*M6V@}he>NrV^dUCL<9S88=In3jPHsL>55`SkTTUy zfOehswjlg>p5Lf3`B`lmemGH2&{wMPqWiWeR=mm>fiiO zJ6(E=5!V$tam{E8OXz}IEi{DVXa=D0kAT9YQT--uY&toe)PSni@MQ_Cs5LW4?Y}bK z7;G6*^0$mG1l7o6pM?sR12lqtx}s1J4YO(V+n&gm$2;@OVP|Qq50lL+TXg!px=Ayt z!-Z#YxyQ#*W^e?pI@q6PI~ZQ54wkEj!*kLOAlWj>5(w>LS}YoXVSEu1jFHRb^gxQb zaIMwVg}UL@TZ=u@>-X%%X3yy?2$C@OHT-_3v$+T}S>$00qABu>{0&?!3;Hbx4<^#I zaS5$rM!W5r-ql5@s85=BH93(?>{PQ!tv5`$cf1Re+cP)QY_^$%ZMCs!Y{_e4R{<1w!_|0np|6)RiOCHo*#~?hvy0?0hn?n*A@u>|^+Xl!r7Z z2~TbKztt?rP`2$)S9chf8$6OPH{Z8@ux;_>@L&0%>>Cr8Q^V=)DQ)=ot-=0&G&ZCC zf^V+C6t?#B*~}S!V0~(4=K=7QSid-vO`WqDVpBZw@L8%edYZaSh279}qj7|RkNYbm5&v7!s=BGzhJX1gIuIW*V}YK(}~ z@gws9d&bz6^`n<*&2>EHtoL2B$81m(vVqJ&2l**zfmvZF5j^9d0EsR$ikakj>asL; zKW6QvQjB(&SH^5wfQRM6SV``bCc-A*bXLS%y}c^E#8PY*3dQsD=}|!ognoG@y!WX3tyloXErf#`M?skDg3V5G5Wx$U#1)RVsN1hkjg%?tZGtxx=TJiUd#6j(+b=K#bHzyAo zAM@o-eP-sy*@M4Q9XHM$)P`9jHS`O$VOj>!Hzt^Cu4e*AFa<|&wyhk2528uH6I_|nHis`X z_P?^7;hv8zo~OpK{DH-7R)#m&;@=vhRBkPd)p;l2rF`;9lBNQm6}Nlh0}jXZl5A$s>6Kh)V|pou@~ew+XmOGvG4A>x3Ebzx zP*Ml;sXpo|uZWguPy{3po(9-QL>*k_6(0o*1v7?h^9buH#urZ>;3~gd60`N|_uqUX zZa%pG?yW~p(5SEE;k5kIyp~ugiMej0DY}m9x%Hma_29{Bme(=5ECJ?Q`pE|*@jNkS zJmmE2EfsT8TtIvqQbQDBiexf~Fd2J{M#dT<&9e+t0$on@4A1EZctVOa5b_!gw9 zAq1@injrzfZ_dgb&_@!5Jbe62@;IDw(S8>CHo1P%qG#4U3Om7Tr%(e1$din*VSb!s zd?vi{GfUoM>SpfZJ=EK#VfT?sB9dlyqGPhqN-VU6o{6|T>|GgON^;!Tru}$`4JY*% zXC@L_pG7M3cuK4Gzrqdt(`OCL%xurh^jQykZ*Yse`M&(~zMO$ow1JV=W^TTCkj-e4 zi6#Rk%FJZ_)Wl_;CX7j~DUNLPf*4nd1R5|IOKnSqh+c}w52U-J#7zaOU9X3rkM3k2 z)UN|6LD1+|Mi4h*rU+pzo3dv3OOh*s8*2==cv)8t0o8 z2p;^;YCU}VrV9_l*Q^izIY-{%;CIeyfp%0HBeQ)N2CpuSLx7aFI@hp}Czf+Zln4JB z`ePzXl`n+xC!|;`$DR_Pa|r+nyy>X%wGcl>=)j|a1(RQhI%47ANv7ok*0YAy&>^XS%3u!sNLbJ3_>zCA#f?0!iqfA1eC zDTKJM;9NBnLUdF@Iqb2p6&IDAkYKdbt$n15BZcV2C{AHek{4|08(^(mt-Q71dxe zZX~A1SZ-jrhyau?iMx_fAf9Z(K6#hZY?!Q`p>;H(Rk9?f88`1b%sV9mvmeMm2uY2n z7bEyEE)YM$;{6j%9v&4b`?%p1BO?zDbo8v!=s;&Nwd#oNo$lt6%%7w2qUgtxd6aI) zmjl+6(vZM^*LE6KukQ5BKZ}_>(Q-87bC^8YbZFx~!h`2Da@57*F-lx(uw)w{iYC)I z={RGCoYY!F=_O_27qeL(-qA%6b0Cc~{tE@HK-$DbBenyJp|*P6X_x|0rVM%j>X^V$ z3W=ib(`>}=K$Nfm>F8n}?f(P%QB|A_`WWVYj%A+Hap~;1n8kipW%)9a3CE|w7}4-J zu3+ZUSNU*O`G^jVAW286ENlO_q&aEtsm0yl*Gu~ds1pzuoI?wJ~3nTnH<^{Ok>Y~+akPLkmB4DFr2nviO$SfCeW~i6vA~~wu5$qR^56kk-B0^X^XcFHEv^ZiCPeHA*n5pfCj5 z$bo!WL8cR_9I}ah^GU-!>2epq#bg3C$S!OBD#tCf0_sKWRgO0xFO-9gn$z=65?w$_ z!O46Ab9_1S4ME0DfR2uOJf2UmQF%ygc{l+m8-pKzn%GPIu=Z0UEZ)es13ohtl}?At z3h8{j!+rUFRa*BKbMZ=0XzQu{*_Orv-+!%@)Hdal%ISYG_ZhHm$x4zXpU0Cdww-J; z#e*gOd5X*2a77k;pgemCXVPaQlpM?MxK39T&z0sxh>0f`#n=W zCn`u^Z4d8%#0g~`sy-YaHIxujj?9I8SO z8G}Z6S8295TF{2HBmxKH4J8uOw527Fl5hB4Q?WuwjXp}mVfFF^EXfIhrML0UbD}!D z6onQC=O{x%e8+zes^BpEPilP2YGr*QiRYFodbQT=K{)OupW9m@q!M$Lu>LxF1ibJG za{z?t@~rAO5U#vZDM5jw?kFR`i}I22RO4#X+nkQyMMlAIc@zPH3aP#8aekmk12yzn z_txE8H_5F&y7kV^gZuEP$Acq$ndmxAuio#uPOsmEo02cgx$1)kdgVu(^r@DGYv|In z)>_nD08koU3s=Z`9FHnWL=tdo)Ek@xm#8-dp?Qo_D`G2JxeMw`k%C*<1PFowXe53vXd44c2=BQpW4r@ zUwn39yUN`1O+v`wH!}OL^VP2s-&KE0@(S)ab7YPzcQd-;le zd(iHvoY2Yqh+!k=aVCGAurq3h6AU_{4%oNC1RMo)TpqJoeTC%W$CLzR^-Sc1L^L7P zbeP@WmFVcM@K0S?HgT%Sy(&v z8(|idFiJ9j>1YFTM0`51PH}(^uG%s?OY}`f1Tpwd+N#_rz9>05qT(OdT1KNpZtPsl zFzRar89owSEJd|qH}GvRF3+&qKxk0}GNouBHWX<4@CEwnz-N8k`LElDe;Z?!Y*o64 z0Yhebm>q1-@a4=a08>Jf@2EEit>pA@s`U$Nd*(`V=JP9q%dZ_IwZTBTHufiS0(ucR zJU7s`2QxF-sk803Q~NJ>Y|Tz;zVtW9p7#EyGxd81Nsbv{Z73sg=`9z=-*}n4=Cw%J zsN#>k90b^c4>eGOj}A&7!o=@X*@2=plAbGkP}SI6sAG+_pm?li$LdsGo{i>oMHuft zeDvTUYU_V0?(RH(0)A?Foi?o$`|@K0g1GB#~Mgx z^YT-(aQ5TMGSQTb(a}!>)C5w5-jW~7hJwi@ameN6b(FDCtBBP{qaMXKG+@MasRg5n z_(VJpVi6w%F*01FCEpz9$B%V6n7{6HTrp=fP`~ZrVhlfX0ea>!G`-e#YDSv}(zw_c z2x_CJ8ac*vMKIwBJTRBO+Q*9uF(;3#*G^uD41)GSpGbyANez~5 zc{!=F@lPjRfxI|)Xlu=J8cPksZM9u*xBPA;orXK9J8fjSyWf3xbCPaB^c|zOX4zu* zKi}&J2WJ{5u>do8gBM($1fSmkJx9RfkDAYj zR!31L)z4-aU5*Ta($i#A$Dc<&B>n(OIICF@hP(YRgo!mG7aCS;E7&HwyQs$$+U| W?p6W&)$z^p5d1v7@aKQ|;{O3vn{-eB delta 2057 zcmZuy&2Jl35ck?G&}|cvG^ABq#B`Mk8_Cgr`s;!>_9oeOvv2F&G>rhIPV6=&ja^cg z168#>a-=Ll)B+(D6(Ip?8q0@PC^>NA!VL+8#D9R)6DOoH@2wptC9?E(-n`$;{N8wG zUgxjq#zyp$`B7O)p1)O3%A%}+B<0jhPL%GgCVfdt058bmzEcTLWdWAftILhG8@21z z3M{Xb>({C`&*h-rXs*=i*PvDhVQS8@V6XAS#DoBqauY2M^qLhCe0<8Zj6%uKJ)<}V z!a>Y}AGz1ZB?;2mj3PqLD4Je!ask%YRv}lI(d}u&O?m|4eDL)KpGR2@pKuPDdrN zefrQKmmZ5mB3%9@TqA7xWg`4Uh9b6U@o^~)EF^JUkVFV6gBE;s_&1+8hP{Um2l5 zF~spqV!J3yAtTR6C%6@X{y#7Ul0t3tIm=^qrae7FT#p{8z%&%cvYi0#-+^c(Hh(I{ zbq>v+8vfwr{4nt<@} zN`CXB*tcYKacpPhV=~I&myAXiM|X5G_5#E0_v~js*s%wXpWm6a&*107F60Rd)?dtH zH0)C3@$)sN3=?1R_4zZD3&(Y0I)hAJkCMSx2Zy<1=9lCo!-OL3lvrBMF2%n!6=nT3FK^c zS5l!s?1JuroKkv94LhT&l(A*Px@Qz++Ct%;`IoY(u91}1;M`uQl+yM?>1C*C@b|_E zANvFEJ~yd*WEOjr<$-o3GQ+N>68h^UV#+kEBBXkqj7^#W){7R7sU*z=+F*y_bX5Bp z2~(I7!MN-hwu}7=s;0suDK3DoDj5g?$O9W4RP@O@RLROv&}~K)6itTiyaNUAzGuL& z-UUU}a2TL_Ha$U>Qhj47E%rAVk%d7OjpBnQ!EKCt2Lta$pvl&~8OjT<0*agk0d6+e ztL3$u0&W!$>;^P$RO@i{R(-iyYoO3rN06MM(5v{^AW+UAuu!hQ*+fmf0%f?dUaL2& z>wx%hDEa%RQgfx;gynKQ1cJbWj2G`aR8zRYbM(ku(TJ)Dg46XYfRx2;7_(BvP;0e% zwL2MU9fm9=9Et)yaarXM2zP|`r-|*=;OfRi{>9n-?ld9AiK6b#SgwapY}~X>?~-0} z4|uEaVMqkqUu5~B>lBEE<;@4&{e?l?dc>L4OVg%}s+Ie5!>H=cWY?ol5+D3}|6%~G i*El}VT1IfY^#)3kaplan>Local>medley3.5>working-medley>sources>INTERPRESS.;96 215772 +(FILECREATED "19-Jan-2026 17:21:17" {WMEDLEY}INTERPRESS.;105 215365 :EDIT-BY rmk - :CHANGES-TO (VARS INTERPRESSCOMS) - - :PREVIOUS-DATE " 9-Sep-2025 13:19:12" {WMEDLEY}INTERPRESS.;94) + :PREVIOUS-DATE "24-Dec-2025 11:24:31" {WMEDLEY}INTERPRESS.;104) (PRETTYCOMPRINT INTERPRESSCOMS) @@ -37,17 +34,17 @@ TRAJECTORY.IP TRANS.IP TRANSLATE.IP)) (COMS (* ; "DIG interface") (FNS \CHANGE-VISIBLE-REGION.IP \PAPERSIZE.IP HEADINGOP.IP) - (FNS DEFINEFONT.IP FONTNAME.IP INTERPRESS.BITMAPSCALE INTERPRESS.OUTCHARFN - INTERPRESSFILEP MAKEINTERPRESS NEWLINE.IP NEWPAGE.IP NEWPAGE?.IP OPENIPSTREAM - SETUPFONTS.IP SHOWBITMAP.IP \BITMAPSIZE.IP SHOWBITMAP1.IP SHOWSHADE.IP \BITBLT.IP - \SCALEDBITBLT.IP \BLTSHADE.IP \CHARWIDTH.IP \CLOSEIPSTREAM \DRAWARC.IP - \DRAWCURVE.IP \DRAWPOINT.IP \DSPCOLOR.IP ENSURE.RGB \IPCURVE2 \CLIPCURVELINE.IP - \DRAWLINE.IP \CLIPLINE \DSPBOTTOMMARGIN.IP \DSPFONT.IP \DSPLEFTMARGIN.IP - \DSPLINEFEED.IP \DSPRIGHTMARGIN.IP \DSPSPACEFACTOR.IP \DSPTOPMARGIN.IP - \DSPXPOSITION.IP \DSPROTATE.IP \PUSHSTATE.IP \POPSTATE.IP \DEFAULTSTATE.IP - \DSPTRANSLATE.IP \DSPSCALE2.IP \DSPYPOSITION.IP FILLCIRCLE.IP \FILLPOLYGON.IP - \DRAWPOLYGON.IP \FIXLINELENGTH.IP \MOVETO.IP \SETBRUSH.IP \STRINGWIDTH.IP - \DSPCLIPPINGREGION.IP \DSPOPERATION.IP)) + (FNS DEFINEFONT.IP FONTNAME.IP INTERPRESS.BITMAPSCALE INTERPRESS.OUTCHARFN NEWLINE.IP + NEWPAGE.IP NEWPAGE?.IP OPENIPSTREAM SETUPFONTS.IP SHOWBITMAP.IP \BITMAPSIZE.IP + SHOWBITMAP1.IP SHOWSHADE.IP \BITBLT.IP \SCALEDBITBLT.IP \BLTSHADE.IP \CHARWIDTH.IP + \CLOSEIPSTREAM \DRAWARC.IP \DRAWCURVE.IP \DRAWPOINT.IP \DSPCOLOR.IP ENSURE.RGB + \IPCURVE2 \CLIPCURVELINE.IP \DRAWLINE.IP \CLIPLINE \DSPBOTTOMMARGIN.IP \DSPFONT.IP + \DSPLEFTMARGIN.IP \DSPLINEFEED.IP \DSPRIGHTMARGIN.IP \DSPSPACEFACTOR.IP + \DSPTOPMARGIN.IP \DSPXPOSITION.IP \DSPROTATE.IP \PUSHSTATE.IP \POPSTATE.IP + \DEFAULTSTATE.IP \DSPTRANSLATE.IP \DSPSCALE2.IP \DSPYPOSITION.IP FILLCIRCLE.IP + \FILLPOLYGON.IP \DRAWPOLYGON.IP \FIXLINELENGTH.IP \MOVETO.IP \SETBRUSH.IP + \STRINGWIDTH.IP \DSPCLIPPINGREGION.IP \DSPOPERATION.IP) + (FNS INTERPRESSFILEP INTERPRESS.TEDIT)) (COMS (* ;  "Patch controller for the %"Bonnet%" printer bug that loses X,Y position when you do a DSPFONT") (INITVARS (*INTERPRESS-PRINTER-DSPFONT-PATCH* NIL))) @@ -78,26 +75,19 @@ (* ;; "HOSTNAMEP is NILL for DOCUPRINT instead of NSPRINTER.HOSTNAMEP, since that predicate merely tests for colon in the name. DOCUPRINT printers are only recognized from their PRINTERTYPE property, which must be on their CANONICAL.HOSTNAME. Preference is for INTERPRESS (CANPRINT ordering), for backward compatibility. But printer can be put on DEFAULTPRINTINGHOST twice, with the type CONSed on to the name, to give the user dynamic selection.") - [ADDVARS [PRINTERTYPES ((DOCUPRINT) + [ADDVARS (PRINTERTYPES ((DOCUPRINT) (CANPRINT (INTERPRESS POSTSCRIPT)) (HOSTNAMEP NILL) (STATUS NSPRINTER.STATUS) (PROPERTIES NSPRINTER.PROPERTIES) - (SEND NSPRINT) - (BITMAPSCALE INTERPRESS.BITMAPSCALE) - (BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION - TITLE))) + (SEND NSPRINT)) ((INTERPRESS 8044) (CANPRINT (INTERPRESS)) (HOSTNAMEP NSPRINTER.HOSTNAMEP) (STATUS NSPRINTER.STATUS) (PROPERTIES NSPRINTER.PROPERTIES) - (SEND NSPRINT) - (BITMAPSCALE INTERPRESS.BITMAPSCALE) - (BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE] - (PRINTFILETYPES (INTERPRESS (TEST INTERPRESSFILEP) - (EXTENSION (IP IPR INTERPRESS)) - (CONVERSION (TEXT MAKEINTERPRESS TEDIT \TEDIT.HARDCOPY] + (SEND NSPRINT] + (ALISTS (PRINTFILETYPES INTERPRESS)) [ADDVARS (IMAGESTREAMTYPES (INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE) (CREATECHARSET \CREATECHARSET.HCPYMODE] (INITVARS (DEFAULT.INTERPRESS.BITMAP.ROTATION 90)) @@ -1487,36 +1477,6 @@ (SHOW.IP IPSTREAM T) (* ; "Either failed CHARVIS, or failed both VISRIGHT and IPRIGHT, so not in clipping region. Just move X position") (SETX.IP IPSTREAM NEWXPOS]) -(INTERPRESSFILEP - [LAMBDA (FILE NOOPEN) (* ; "Edited 2-May-2023 09:09 by lmm") - (* jds "18-Feb-85 09:41") - - (* ;; "Returns fullname of FILE if it looks like an Interpress file") - - (OR (EQ (GETFILEINFO FILE 'FILETYPE) - (\IPC FILETYPE.INTERPRESS)) - (RESETLST - [PROG (STRM) - [COND - ((SETQ STRM (\GETSTREAM FILE 'INPUT T)) - (OR (RANDACCESSP STRM) - (RETURN)) - (RESETSAVE NIL (LIST 'SETFILEPTR STRM (GETFILEPTR STRM))) - (SETFILEPTR STRM 0)) - (NOOPEN (RETURN)) - (T (RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT 'OLD 8)) - '(PROGN (CLOSEF? OLDVALUE] - (RETURN (for I from 1 to (\IPC (NCHARS NOVERSIONENCODINGSTRING)) - when (OR (EOFP STRM) - (NEQ (NTHCHARCODE (\IPC NOVERSIONENCODINGSTRING) - I) - (BIN STRM))) do (RETURN NIL) - finally (RETURN (FULLNAME STRM])]) - -(MAKEINTERPRESS - [LAMBDA (FILE IPFILE FONTS HEADING TABS OPTIONS) (* jds " 9-May-85 16:28") - (TEXTTOIMAGEFILE FILE IPFILE 'INTERPRESS FONTS HEADING TABS OPTIONS]) - (NEWLINE.IP [LAMBDA (IPSTREAM) (* jds " 9-Feb-86 17:37") (* ; @@ -3069,6 +3029,44 @@ with OPERATION)) (T (\ILLEGAL.ARG OPERATION])]) ) +(DEFINEQ + +(INTERPRESSFILEP + [LAMBDA (FILE NOOPEN) (* ; "Edited 13-Sep-2025 23:25 by rmk") + (* ; "Edited 2-May-2023 09:09 by lmm") + (* jds "18-Feb-85 09:41") + + (* ;; "Returns fullname of FILE if it looks like an Interpress file") + + (OR (EQ (GETFILEINFO FILE 'FILETYPE) + (\IPC FILETYPE.INTERPRESS)) + (RESETLST + [PROG (STRM) + [COND + ((SETQ STRM (\GETSTREAM FILE 'INPUT T)) + (OR (RANDACCESSP STRM) + (RETURN)) + [RESETSAVE NIL `(PROGN (SETFILEPTR ,STRM ,(GETFILEPTR STRM] + (SETFILEPTR STRM 0)) + (NOOPEN (RETURN)) + (T (RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT 'OLD 8)) + '(PROGN (CLOSEF? OLDVALUE] + (RETURN (for I from 1 to (\IPC (NCHARS NOVERSIONENCODINGSTRING)) + when (OR (EOFP STRM) + (NEQ (NTHCHARCODE (\IPC NOVERSIONENCODINGSTRING) + I) + (BIN STRM))) do (RETURN NIL) + finally (RETURN (FULLNAME STRM])]) + +(INTERPRESS.TEDIT + [LAMBDA (FILE IMAGESTREAM) (* ; "Edited 13-Sep-2025 20:21 by rmk") + (* ; "Edited 12-Sep-2025 13:40 by rmk") + (* ; "Edited 18-Sep-91 18:16 by jds") + + (* ;; "IMAGESTREAM must be a postscript stream ") + + (TEDIT.TO.IMAGESTREAM FILE IMAGESTREAM]) +) @@ -3503,21 +3501,19 @@ (HOSTNAMEP NILL) (STATUS NSPRINTER.STATUS) (PROPERTIES NSPRINTER.PROPERTIES) - (SEND NSPRINT) - (BITMAPSCALE INTERPRESS.BITMAPSCALE) - (BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))) + (SEND NSPRINT)) ((INTERPRESS 8044) (CANPRINT (INTERPRESS)) (HOSTNAMEP NSPRINTER.HOSTNAMEP) (STATUS NSPRINTER.STATUS) (PROPERTIES NSPRINTER.PROPERTIES) - (SEND NSPRINT) - (BITMAPSCALE INTERPRESS.BITMAPSCALE) - (BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))) + (SEND NSPRINT))) (ADDTOVAR PRINTFILETYPES (INTERPRESS (TEST INTERPRESSFILEP) (EXTENSION (IP IPR INTERPRESS)) - (CONVERSION (TEXT MAKEINTERPRESS TEDIT \TEDIT.HARDCOPY)))) + (BITMAPSCALE INTERPRESS.BITMAPSCALE) + (BITMAPFILE (INTERPRESSBITMAP IMAGEFILE BITMAP SCALEFACTOR REGION + ROTATION TITLE)))) (ADDTOVAR IMAGESTREAMTYPES (INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE) (CREATECHARSET \CREATECHARSET.HCPYMODE))) @@ -3831,44 +3827,44 @@ (LOADDEF 'BRUSH 'RECORDS 'IMAGEIO) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (17251 22903 (APPENDBYTE.IP 17261 . 17397) (APPENDIDENTIFIER.IP 17399 . 17921) ( -APPENDINT.IP 17923 . 18374) (APPENDINTEGER.IP 18376 . 18948) (APPENDLARGEVECTOR.IP 18950 . 19915) ( -APPENDNUMBER.IP 19917 . 20386) (APPENDOP.IP 20388 . 21034) (APPENDRATIONAL.IP 21036 . 21529) ( -APPENDSEQUENCEDESCRIPTOR.IP 21531 . 22726) (BYTESININT.IP 22728 . 22901)) (22939 62746 (ARCTO.IP 22949 - . 24230) (BEGINMASTER.IP 24232 . 24505) (BEGINPAGE.IP 24507 . 24863) (BEGINPREAMBLE.IP 24865 . 25236) - (CLIPRECTANGLE.IP 25238 . 25728) (CONCAT.IP 25730 . 25995) (CONCATT.IP 25997 . 26264) (ENDMASTER.IP -26266 . 26710) (ENDPAGE.IP 26712 . 27089) (ENDPREAMBLE.IP 27091 . 27890) (FGET.IP 27892 . 28195) ( -FILLRECTANGLE.IP 28197 . 30525) (FILLTRAJECTORY.IP 30527 . 31162) (FILLNGON.IP 31164 . 33441) (FSET.IP - 33443 . 33746) (GETFRAMEVAR.IP 33748 . 34066) (INITIALIZEMASTER.IP 34068 . 34669) (INITIALIZECOLOR.IP - 34671 . 35992) (ISET.IP 35994 . 36365) (GETCP.IP 36367 . 36676) (LINETO.IP 36678 . 37283) ( -MASKSTROKE.IP 37285 . 37558) (MOVETO.IP 37560 . 37897) (ROTATE.IP 37899 . 38201) (SCALE.IP 38203 . -38506) (SCALE2.IP 38508 . 38845) (SETCOLOR.IP 38847 . 41076) (SETRGB.IP 41078 . 42134) (SETCOLORLV.IP -42136 . 46749) (SETCOLOR16.IP 46751 . 49857) (SETFONT.IP 49859 . 50680) (SETSPACE.IP 50682 . 50994) ( -SETXREL.IP 50996 . 52180) (SETX.IP 52182 . 53699) (SETXY.IP 53701 . 54873) (SETXYREL.IP 54875 . 56181) - (SETY.IP 56183 . 57492) (SETYREL.IP 57494 . 58394) (SHOW.IP 58396 . 61656) (TRAJECTORY.IP 61658 . -62056) (TRANS.IP 62058 . 62397) (TRANSLATE.IP 62399 . 62744)) (62777 68867 (\CHANGE-VISIBLE-REGION.IP -62787 . 66448) (\PAPERSIZE.IP 66450 . 67271) (HEADINGOP.IP 67273 . 68865)) (68868 174910 ( -DEFINEFONT.IP 68878 . 69852) (FONTNAME.IP 69854 . 70784) (INTERPRESS.BITMAPSCALE 70786 . 71579) ( -INTERPRESS.OUTCHARFN 71581 . 78088) (INTERPRESSFILEP 78090 . 79424) (MAKEINTERPRESS 79426 . 79610) ( -NEWLINE.IP 79612 . 80344) (NEWPAGE.IP 80346 . 85321) (NEWPAGE?.IP 85323 . 85802) (OPENIPSTREAM 85804 - . 94155) (SETUPFONTS.IP 94157 . 95149) (SHOWBITMAP.IP 95151 . 99692) (\BITMAPSIZE.IP 99694 . 100471) -(SHOWBITMAP1.IP 100473 . 104845) (SHOWSHADE.IP 104847 . 105800) (\BITBLT.IP 105802 . 110006) ( -\SCALEDBITBLT.IP 110008 . 113653) (\BLTSHADE.IP 113655 . 115113) (\CHARWIDTH.IP 115115 . 115565) ( -\CLOSEIPSTREAM 115567 . 115894) (\DRAWARC.IP 115896 . 116343) (\DRAWCURVE.IP 116345 . 118782) ( -\DRAWPOINT.IP 118784 . 119821) (\DSPCOLOR.IP 119823 . 120774) (ENSURE.RGB 120776 . 121440) (\IPCURVE2 -121442 . 134696) (\CLIPCURVELINE.IP 134698 . 139396) (\DRAWLINE.IP 139398 . 143130) (\CLIPLINE 143132 - . 147832) (\DSPBOTTOMMARGIN.IP 147834 . 148250) (\DSPFONT.IP 148252 . 153012) (\DSPLEFTMARGIN.IP -153014 . 153474) (\DSPLINEFEED.IP 153476 . 154143) (\DSPRIGHTMARGIN.IP 154145 . 154942) ( -\DSPSPACEFACTOR.IP 154944 . 156073) (\DSPTOPMARGIN.IP 156075 . 156511) (\DSPXPOSITION.IP 156513 . -157500) (\DSPROTATE.IP 157502 . 157680) (\PUSHSTATE.IP 157682 . 158574) (\POPSTATE.IP 158576 . 159211) - (\DEFAULTSTATE.IP 159213 . 159565) (\DSPTRANSLATE.IP 159567 . 159748) (\DSPSCALE2.IP 159750 . 159925) - (\DSPYPOSITION.IP 159927 . 160228) (FILLCIRCLE.IP 160230 . 161313) (\FILLPOLYGON.IP 161315 . 162646) -(\DRAWPOLYGON.IP 162648 . 168778) (\FIXLINELENGTH.IP 168780 . 169994) (\MOVETO.IP 169996 . 170360) ( -\SETBRUSH.IP 170362 . 172528) (\STRINGWIDTH.IP 172530 . 172933) (\DSPCLIPPINGREGION.IP 172935 . 174111 -) (\DSPOPERATION.IP 174113 . 174908)) (175101 175856 (IP-TOS 175111 . 175371) (POP-IP-STACK 175373 . -175668) (PUSH-IP-STACK 175670 . 175854)) (175917 176841 (\CHANGECHARSET.IP 175927 . 176839)) (176842 -180458 (\INTERPRESSINIT 176852 . 180456)) (193542 195966 (INTERPRESSBITMAP 193552 . 195964)) (198390 -201011 (\CREATEINTERPRESSFONT 198400 . 200128) (\CREATECHARSET.IP 200130 . 201009)) (201012 213185 ( -IPFONT.FILEP 201022 . 201206) (IPFONT.GETCHARSET 201208 . 211306) (\FACECODE 211308 . 211898) ( -\FAMILYCODE 211900 . 213183))))) + (FILEMAP (NIL (16593 22245 (APPENDBYTE.IP 16603 . 16739) (APPENDIDENTIFIER.IP 16741 . 17263) ( +APPENDINT.IP 17265 . 17716) (APPENDINTEGER.IP 17718 . 18290) (APPENDLARGEVECTOR.IP 18292 . 19257) ( +APPENDNUMBER.IP 19259 . 19728) (APPENDOP.IP 19730 . 20376) (APPENDRATIONAL.IP 20378 . 20871) ( +APPENDSEQUENCEDESCRIPTOR.IP 20873 . 22068) (BYTESININT.IP 22070 . 22243)) (22281 62088 (ARCTO.IP 22291 + . 23572) (BEGINMASTER.IP 23574 . 23847) (BEGINPAGE.IP 23849 . 24205) (BEGINPREAMBLE.IP 24207 . 24578) + (CLIPRECTANGLE.IP 24580 . 25070) (CONCAT.IP 25072 . 25337) (CONCATT.IP 25339 . 25606) (ENDMASTER.IP +25608 . 26052) (ENDPAGE.IP 26054 . 26431) (ENDPREAMBLE.IP 26433 . 27232) (FGET.IP 27234 . 27537) ( +FILLRECTANGLE.IP 27539 . 29867) (FILLTRAJECTORY.IP 29869 . 30504) (FILLNGON.IP 30506 . 32783) (FSET.IP + 32785 . 33088) (GETFRAMEVAR.IP 33090 . 33408) (INITIALIZEMASTER.IP 33410 . 34011) (INITIALIZECOLOR.IP + 34013 . 35334) (ISET.IP 35336 . 35707) (GETCP.IP 35709 . 36018) (LINETO.IP 36020 . 36625) ( +MASKSTROKE.IP 36627 . 36900) (MOVETO.IP 36902 . 37239) (ROTATE.IP 37241 . 37543) (SCALE.IP 37545 . +37848) (SCALE2.IP 37850 . 38187) (SETCOLOR.IP 38189 . 40418) (SETRGB.IP 40420 . 41476) (SETCOLORLV.IP +41478 . 46091) (SETCOLOR16.IP 46093 . 49199) (SETFONT.IP 49201 . 50022) (SETSPACE.IP 50024 . 50336) ( +SETXREL.IP 50338 . 51522) (SETX.IP 51524 . 53041) (SETXY.IP 53043 . 54215) (SETXYREL.IP 54217 . 55523) + (SETY.IP 55525 . 56834) (SETYREL.IP 56836 . 57736) (SHOW.IP 57738 . 60998) (TRAJECTORY.IP 61000 . +61398) (TRANS.IP 61400 . 61739) (TRANSLATE.IP 61741 . 62086)) (62119 68209 (\CHANGE-VISIBLE-REGION.IP +62129 . 65790) (\PAPERSIZE.IP 65792 . 66613) (HEADINGOP.IP 66615 . 68207)) (68210 172730 ( +DEFINEFONT.IP 68220 . 69194) (FONTNAME.IP 69196 . 70126) (INTERPRESS.BITMAPSCALE 70128 . 70921) ( +INTERPRESS.OUTCHARFN 70923 . 77430) (NEWLINE.IP 77432 . 78164) (NEWPAGE.IP 78166 . 83141) (NEWPAGE?.IP + 83143 . 83622) (OPENIPSTREAM 83624 . 91975) (SETUPFONTS.IP 91977 . 92969) (SHOWBITMAP.IP 92971 . +97512) (\BITMAPSIZE.IP 97514 . 98291) (SHOWBITMAP1.IP 98293 . 102665) (SHOWSHADE.IP 102667 . 103620) ( +\BITBLT.IP 103622 . 107826) (\SCALEDBITBLT.IP 107828 . 111473) (\BLTSHADE.IP 111475 . 112933) ( +\CHARWIDTH.IP 112935 . 113385) (\CLOSEIPSTREAM 113387 . 113714) (\DRAWARC.IP 113716 . 114163) ( +\DRAWCURVE.IP 114165 . 116602) (\DRAWPOINT.IP 116604 . 117641) (\DSPCOLOR.IP 117643 . 118594) ( +ENSURE.RGB 118596 . 119260) (\IPCURVE2 119262 . 132516) (\CLIPCURVELINE.IP 132518 . 137216) ( +\DRAWLINE.IP 137218 . 140950) (\CLIPLINE 140952 . 145652) (\DSPBOTTOMMARGIN.IP 145654 . 146070) ( +\DSPFONT.IP 146072 . 150832) (\DSPLEFTMARGIN.IP 150834 . 151294) (\DSPLINEFEED.IP 151296 . 151963) ( +\DSPRIGHTMARGIN.IP 151965 . 152762) (\DSPSPACEFACTOR.IP 152764 . 153893) (\DSPTOPMARGIN.IP 153895 . +154331) (\DSPXPOSITION.IP 154333 . 155320) (\DSPROTATE.IP 155322 . 155500) (\PUSHSTATE.IP 155502 . +156394) (\POPSTATE.IP 156396 . 157031) (\DEFAULTSTATE.IP 157033 . 157385) (\DSPTRANSLATE.IP 157387 . +157568) (\DSPSCALE2.IP 157570 . 157745) (\DSPYPOSITION.IP 157747 . 158048) (FILLCIRCLE.IP 158050 . +159133) (\FILLPOLYGON.IP 159135 . 160466) (\DRAWPOLYGON.IP 160468 . 166598) (\FIXLINELENGTH.IP 166600 + . 167814) (\MOVETO.IP 167816 . 168180) (\SETBRUSH.IP 168182 . 170348) (\STRINGWIDTH.IP 170350 . +170753) (\DSPCLIPPINGREGION.IP 170755 . 171931) (\DSPOPERATION.IP 171933 . 172728)) (172731 174630 ( +INTERPRESSFILEP 172741 . 174174) (INTERPRESS.TEDIT 174176 . 174628)) (174821 175576 (IP-TOS 174831 . +175091) (POP-IP-STACK 175093 . 175388) (PUSH-IP-STACK 175390 . 175574)) (175637 176561 ( +\CHANGECHARSET.IP 175647 . 176559)) (176562 180178 (\INTERPRESSINIT 176572 . 180176)) (193262 195686 ( +INTERPRESSBITMAP 193272 . 195684)) (197983 200604 (\CREATEINTERPRESSFONT 197993 . 199721) ( +\CREATECHARSET.IP 199723 . 200602)) (200605 212778 (IPFONT.FILEP 200615 . 200799) (IPFONT.GETCHARSET +200801 . 210899) (\FACECODE 210901 . 211491) (\FAMILYCODE 211493 . 212776))))) STOP diff --git a/sources/INTERPRESS.LCOM b/sources/INTERPRESS.LCOM index decfd60d04cbd78ecde4bb4903581f5415f8778c..19d50a01caa1c0fb67209a13d250b62cfb696fd1 100644 GIT binary patch delta 1096 zcmZvaOKj9e7{{I6CKN|vH>l+h0r~0_x`wW?z3Y9L=3&;e@uXhcvL`et;SiA(3wbOG z9JnD495_UMjHraD#Em1ZYLM6sQq&YG_Lf81!ll}_>Ya0iXva>g27wQw@A?0}-;B4` zlfSoDv#P8XKq=~~qN}O^8R1NG>B70i`aCq3L4Yq42M;K+CIT-gr5z2L zuFASr6yS^Q;b2EXk|Y7<=Pt4S*EXFNe*A;eoKXoiIL$eRxigTj74~UW4t4Gq;zz?ZTvBi=&?Enad)%B-5;|0IQB&@ zw)n^#NWL}s@uvL_w{Gv<+u@AGzyI8P!lk)Pz6i71P!-GY14I~Tt^ifnAtnkcKK6*~ zvzW-wR%|ywI7}_{%CuX#R=$}`ayLy>HE8;zSA1%-H~(euQ(GQ)_fdl z3=R%9=vQWS{_AE`G8u1Y!Sj2olM7p)e%rO;GPana$xxlLZO5n~P;xnNh!w3^aZTo{ zG9b6=K{*euhn#@0cd0?442&RpCy)4$FVJyx)GiglwM{6gfE{m&K<<^ITpm2%op7ME zoo1*^y$AwczEoeiuu{Kx@z`{IrFr?70L4Oh7ai_7g&l%?_LxB+v3~&*(9IH`!Jq)H z858K=WiT)Rwu%T`#FQ8}VpfJ$fVfQ}uC${;satmr^gHMi8#_qC9?q%>b_O;(*u@BlBJ>7nvSy$USeb^S5^=o^C?q7?n(Y4XitQmOh zqI`p3*I~LMWU5ZUkpClzFAezr1KVif>e^BtUEbK&UojldXKBdr^s|l2vM4eQ!^Qy# zAQNXI2{PlMow9L}X`VEE+FXB^!cYD5##2JCKN?L1GXX(0>|nyO0Z)H^G`)vOR@@pB zJOamoryo6@Nk;Qp&!q6j$E)c#Ekd_`nWHbh7wFL+QdHU)=#8(Gj%^I3c;6*4Fc3^^ K6rO*2e%C*_(lXWn delta 1475 zcmcJOPiz}S6vo#vYUoxZPANh}Eq&cUJ3RP!+`{4RPYg zE~2QQ2q7UZNK``=;8G#Mg##emN_Hv~XfBuo$|3H#wBmw<)Fa|j-mVWxgOK2W594oU z-n{p|-|XDo^6qVWKb+kN1?@C%Ez)%E3Sr3|$-5P-j|+0$>o zP-;}_jr7XGdUatfov$q}RMV@Ka<%eiBp6G-QLC>kuPp_7E9pk<_4;C^k=6}LidK=> zc5plu7eSC7s(4fmN3bfExY8Ou*i0}O6rj9t5nDKPL=H#gP*MEwMZ07w7&&8 zPNe_X`G#xeA6kd76iXz+AQMfefy^A#S66_S)tq8X5<5Um@Xshk8}<#WX2BLgM)Nbe zS+WBfHi|G)2Z%>xsYjf@e6B!P%ropsHNWzFJ<=z|o9CZ>exOfEG(U*^GRT6P?@3p@ zUd}V*E4#A`!|eCXZ29w=vo*y#V-D_LzdE(D z_wqM)a&C-|^Gne%WJ~$Hp%e&6_#GHDhpvjMso`7-12MA}B;#OO#IPyyE! z4tz4|*(fN}WFI5QT9Wtc5W@zjZW@RfqCl05BO;I^il!TrsL_ULP-j&F-Ex{k83IR$ zz&(!kk4z{opp2@K$NC*0j{i7NGE1qc7nDhY(LRDr#t&R%b6L%doL3*=xIU!{_peTL zLY<(`86O?;aJkOY%Dp?g9qz`-o>cDTT-ZZiuRgUqeS+JbKHlM!>Vsc*e{>2)BQW3l zY#q$VQREFh-#oqK3pGFb^s`fE_r1G>;SdjloXhJ53F;Q`Y@#*7%B^t^&#tvZ)@j92 zJwPS4Uqtn4`wV-(9Ygh9`x$n(Eu%WQC9s#aoZYujUE4|z@$;H(;q4X`hcD)BK5=vP zNFVswyIld}zUTt`se5{`Xi_% zH^YfT8AMUUV`JSjSj6gvv#M##kfM!EfZw^3!_M)c>lFBT_dkg6G}W}`FpHB%(KPn~ z`k8raa*%(BFtAr{53}uCX&-OT*_0G?L#J*u`~LP*Y;-3*z+(#M#e)Ai7zbA0ne+1C eZ~nY<)Av7+V83-wp>Z1fca{%1ZvN4It^Y43&9Nf@ diff --git a/sources/MCCS b/sources/MCCS index 0a9fe586..cea65763 100644 --- a/sources/MCCS +++ b/sources/MCCS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Oct-2025 14:52:10" {WMEDLEY}MCCS.;152 57023 +(FILECREATED "17-Oct-2025 08:50:00" {WMEDLEY}MCCS.;155 57020 :EDIT-BY rmk - :CHANGES-TO (FNS MCCSMAPPAIRS) + :CHANGES-TO (VARS MCCSCOMS) - :PREVIOUS-DATE " 6-Oct-2025 16:44:20" {WMEDLEY}MCCS.;149) + :PREVIOUS-DATE "15-Oct-2025 18:31:01" {WMEDLEY}MCCS.;154) (PRETTYCOMPRINT MCCSCOMS) @@ -1497,15 +1497,15 @@ PCODE]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2856 14427 (\MCCSINCCODE 2866 . 5954) (\MCCSPEEKCCODE 5956 . 8843) (\MCCSOUTCHAR 8845 - . 10944) (\MCCSBACKCCODE 10946 . 12490) (\MCCSFORMATBYTESTREAM 12492 . 13222) (\MCCSCHARSETFN 13224 - . 14425)) (14428 15310 (\CREATE.MCCS.EXTERNALFORMAT 14438 . 15308)) (15311 16288 ( -\MCCS.24BITENCODING.ERROR 15321 . 16286)) (17664 20302 (MTOXCODE 17674 . 18471) (XTOMCODE 18473 . -19130) (XTOMSTRING 19132 . 19717) (MTOXSTRING 19719 . 20300)) (20303 21963 (MTOX$CODE 20313 . 21045) ( -X$TOMCODE 21047 . 21961)) (21964 22604 (KANJICHARSETP 21974 . 22230) (CHINESECHARSETP 22232 . 22602)) -(43172 45046 (MCCSCODEMAPARRAY 43182 . 45044)) (45662 52143 (MCCSMAPFN 45672 . 47039) (MCCSMAPPAIRS -47041 . 51149) (XCCS.CS0.UNDEFINED 51151 . 51780) (XCCSUNDEFINEDPAIRS 51782 . 52141)) (52248 57000 ( -GACHATOMCODE 52258 . 52770) (SYMBOLTOMCODE 52772 . 53420) (SIGMATOMCODE 53422 . 54068) (ATOMCODE 54070 - . 54602) (MATHTOMCODE 54604 . 55260) (HIPPOTOMCODE 55262 . 55799) (CYRILLICTOMCODE 55801 . 56235) ( -PALATINOTOMCODE 56237 . 56998))))) + (FILEMAP (NIL (2853 14424 (\MCCSINCCODE 2863 . 5951) (\MCCSPEEKCCODE 5953 . 8840) (\MCCSOUTCHAR 8842 + . 10941) (\MCCSBACKCCODE 10943 . 12487) (\MCCSFORMATBYTESTREAM 12489 . 13219) (\MCCSCHARSETFN 13221 + . 14422)) (14425 15307 (\CREATE.MCCS.EXTERNALFORMAT 14435 . 15305)) (15308 16285 ( +\MCCS.24BITENCODING.ERROR 15318 . 16283)) (17661 20299 (MTOXCODE 17671 . 18468) (XTOMCODE 18470 . +19127) (XTOMSTRING 19129 . 19714) (MTOXSTRING 19716 . 20297)) (20300 21960 (MTOX$CODE 20310 . 21042) ( +X$TOMCODE 21044 . 21958)) (21961 22601 (KANJICHARSETP 21971 . 22227) (CHINESECHARSETP 22229 . 22599)) +(43169 45043 (MCCSCODEMAPARRAY 43179 . 45041)) (45659 52140 (MCCSMAPFN 45669 . 47036) (MCCSMAPPAIRS +47038 . 51146) (XCCS.CS0.UNDEFINED 51148 . 51777) (XCCSUNDEFINEDPAIRS 51779 . 52138)) (52245 56997 ( +GACHATOMCODE 52255 . 52767) (SYMBOLTOMCODE 52769 . 53417) (SIGMATOMCODE 53419 . 54065) (ATOMCODE 54067 + . 54599) (MATHTOMCODE 54601 . 55257) (HIPPOTOMCODE 55259 . 55796) (CYRILLICTOMCODE 55798 . 56232) ( +PALATINOTOMCODE 56234 . 56995))))) STOP diff --git a/sources/MCCS.LCOM b/sources/MCCS.LCOM index e5ad6affce7cde8607b9fa59dc3eb71ffbd324f3..b46f2b6549dbbcbd2b7cdf2d415c4ff97b9e36f5 100644 GIT binary patch delta 220 zcmdnEgK^~!#tGrVhUU8d$tAi*21cd|1{PMP237_Wvveg*H5Is&49yU7hUQiV23E!f z6E}zn=jE4VWagzSWacR-xrO@pC>WYeyeDpfsocasNs~*%&C|!#Imp#9#MMPX35$J` zbs1&ZO%+Vd4U7yX2Qo^VggFKUD{%QbI|n=a`vz+&SOo;RhI#sj2J5;24FQ^AisUW} WD`P_|1H;LBj53TSn-4G+Mgah!);D+n delta 247 zcmZ3vgK^^y#tGrV3g){0$tAi*21cd|h9*{~MplLsvvehmG!?j%P~?oPOiZne%qDIS z%kXt}4)%2n2ypZa3RcL>Q&4gX_3=?aR;{O}r=*aQSdyB8)fi(lB~303H%}i|=O9SOURCES>NSPRINT.;3| 30963 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS \NSPRINT.INTERNAL) +(FILECREATED "19-Jan-2026 13:20:47" {WMEDLEY}NSPRINT.;4 31625 - previous date%: "16-May-90 20:54:31" |{PELE:MV:ENVOS}SOURCES>NSPRINT.;2|) + :EDIT-BY rmk + :CHANGES-TO (FNS \FAX.PARSE.NAME FAX.HOSTNAMEP) + + :PREVIOUS-DATE "12-Dec-2025 19:35:12" {WMEDLEY}NSPRINT.;2) -(* ; " -Copyright (c) 1984, 1985, 1986, 1987, 1990, 1992 by Venue & Xerox Corporation. All rights reserved. -") (PRETTYCOMPRINT NSPRINTCOMS) @@ -37,10 +36,7 @@ Copyright (c) 1984, 1985, 1986, 1987, 1990, 1992 by Venue & Xerox Corporation. (HOSTNAMEP FAX.HOSTNAMEP) (STATUS FAX.STATUS) (PROPERTIES FAX.PROPERTIES) - (SEND FAX.SEND.FILE) - (BITMAPSCALE INTERPRESS.BITMAPSCALE) - (BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION - ROTATION TITLE]) + (SEND FAX.SEND.FILE]) (COURIERPROGRAM PRINTING (4 3) TYPES @@ -448,14 +444,61 @@ Copyright (c) 1984, 1985, 1986, 1987, 1990, 1992 by Venue & Xerox Corporation. ) (FAX.HOSTNAMEP -(LAMBDA (PRINTERNAME) (* bvm%: "16-Sep-85 22:51") (* ;;; "True if PRINTERNAME is something that looks like a FAX spec, i.e., person@place, where place is a phone number or something registered as a fax address. Stupid for now") (AND (STRPOS "@" PRINTERNAME) (QUOTE FAX))) -) + [LAMBDA (PRINTERNAME) (* ; "Edited 19-Jan-2026 12:15 by rmk") + (* bvm%: "16-Sep-85 22:51") + +(* ;;; "True if PRINTERNAME is something that looks like a FAX spec, i.e., person@place, where place is a phone number or something registered as a fax address. Stupid for now") + + (CL:WHEN (if PRINTERNAME + then (CAR (\FAX.PARSE.NAME PRINTERNAME T)) + elseif DEFAULTFAXHOST) + 'FAX]) (\FAX.PARSE.NAME -(LAMBDA (PLACE) (* bvm%: "17-Sep-85 15:58") (* ;;; "Parse a Fax spec 'Person@Place' and return a dotted pair (FaxServer . PrintOptions)") (PROG (AT PERSON DESTINATION PHONE HOST MSG INFO) RETRY (SETQ AT (STRPOS "@" PLACE)) (COND ((SETQ PERSON (AND (NEQ AT 1) (SUBSTRING PLACE 1 (SUB1 AT)))) (SETQ PERSON (LIST (QUOTE RECIPIENT.NAME) PERSON)))) (SETQ DESTINATION (SUBSTRING PLACE (ADD1 AT))) (COND ((for CH instring DESTINATION always (OR (DIGITCHARP CH) (EQ CH (CHARCODE -)) (EQ CH (CHARCODE *)) (EQ CH (CHARCODE %#)))) (* ; "Looks like a phone number") (SETQ PHONE DESTINATION)) ((AND (SETQ INFO (CDR (ASSOC (MKATOM (U-CASE DESTINATION)) FAXADDRESSES))) (SETQ PHONE (CAR INFO))) (SETQ HOST (CADR INFO))) (T (SETQ MSG (CONCAT "The FAX destination %"" DESTINATION "%" is unknown. -Edit the list FAXADDRESSES")) (GO FAIL))) (COND ((AND (NULL HOST) (NULL (SETQ HOST DEFAULTFAXHOST))) (SETQ MSG "Don't know the name of your local FAX server. -Set the variable DEFAULTFAXHOST") (GO FAIL))) (RETURN (CONS HOST (CONS (QUOTE MESSAGE) (CONS PHONE PERSON)))) FAIL (ERROR (CONCAT "Don't understand " PLACE " because:") (CONCAT MSG " appropriately, then say OK. -Alternatively, RETURN %"name@CorrectPhoneOrDestination%""))))) + [LAMBDA (PLACE NOERROR) (* ; "Edited 19-Jan-2026 13:18 by rmk") + (* bvm%: "17-Sep-85 15:58") + +(* ;;; "Parse a Fax spec 'Person@Place' and return a dotted pair (FaxServer . PrintOptions)") + + (PROG (AT PERSON DESTINATION PHONE HOST MSG INFO) + RETRY + (SETQ AT (STRPOS "@" PLACE)) + (CL:UNLESS AT (GO FAIL)) + [COND + ([SETQ PERSON (AND (NEQ AT 1) + (SUBSTRING PLACE 1 (SUB1 AT] + (SETQ PERSON (LIST 'RECIPIENT.NAME PERSON] + (SETQ DESTINATION (SUBSTRING PLACE (ADD1 AT))) + (COND + ([for CH instring DESTINATION always (OR (DIGITCHARP CH) + (EQ CH (CHARCODE -)) + (EQ CH (CHARCODE *)) + (EQ CH (CHARCODE %#] + (* ; "Looks like a phone number") + (SETQ PHONE DESTINATION)) + ((AND (SETQ INFO (CDR (ASSOC (MKATOM (U-CASE DESTINATION)) + FAXADDRESSES))) + (SETQ PHONE (CAR INFO))) + (SETQ HOST (CADR INFO))) + (T (SETQ MSG (CONCAT "The FAX destination %"" DESTINATION + "%" is unknown. +Edit the list FAXADDRESSES")) + (GO FAIL))) + (COND + ((AND (NULL HOST) + (NULL (SETQ HOST DEFAULTFAXHOST))) + (SETQ MSG + "Don't know the name of your local FAX server. +Set the variable DEFAULTFAXHOST") + (GO FAIL))) + [RETURN (CONS HOST (CONS 'MESSAGE (CONS PHONE PERSON] + FAIL + (CL:WHEN NOERROR (RETURN NIL)) + (ERROR (CONCAT "Don't understand " PLACE " because:") + (CONCAT MSG + " appropriately, then say OK. +Alternatively, RETURN %"name@CorrectPhoneOrDestination%"")) + (GO RETRY]) ) (RPAQ? DEFAULTFAXHOST ) @@ -468,23 +511,19 @@ Alternatively, RETURN %"name@CorrectPhoneOrDestination%""))))) (GLOBALVARS DEFAULTFAXHOST FAXADDRESSES FAX.NO.WATCHER) ) -(ADDTOVAR PRINTERTYPES - ((FAX TELECOPIER) - (CANPRINT (INTERPRESS)) - (HOSTNAMEP FAX.HOSTNAMEP) - (STATUS FAX.STATUS) - (PROPERTIES FAX.PROPERTIES) - (SEND FAX.SEND.FILE) - (BITMAPSCALE INTERPRESS.BITMAPSCALE) - (BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))) -(PUTPROPS NSPRINT COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1990 1992)) +(ADDTOVAR PRINTERTYPES ((FAX TELECOPIER) + (CANPRINT (INTERPRESS)) + (HOSTNAMEP FAX.HOSTNAMEP) + (STATUS FAX.STATUS) + (PROPERTIES FAX.PROPERTIES) + (SEND FAX.SEND.FILE))) (DECLARE%: DONTCOPY - (FILEMAP (NIL (10281 25115 (GETNSPRINTER 10291 . 11044) (NSPRINT 11046 . 12594) (\NSPRINT.INTERNAL -12596 . 23038) (\NSPRINT.MEDIUM.CHECK 23040 . 23418) (\NSPRINT.UNSUPPORTED 23420 . 23725) ( -NSPRINTER.HOSTNAMEP 23727 . 23998) (NSPRINTER.STATUS 24000 . 24123) (NSPRINTER.PROPERTIES 24125 . -24257) (NSPRINTREQUEST.STATUS 24259 . 24421) (\NSPRINT.ENQUIRE 24423 . 24906) (\NSPRINT.COURIER.OPEN -24908 . 25113)) (25148 27735 (\NSPRINT.WATCHDOG 25158 . 26415) (\NSPRINT.WATCH.JOB 26417 . 26848) ( -\NSPRINT.FULL.REQUEST.STATUS 26850 . 27733)) (27871 30302 (FAX.SEND.FILE 27881 . 28273) (FAX.STATUS -28275 . 28513) (FAX.PROPERTIES 28515 . 28771) (FAX.HOSTNAMEP 28773 . 29066) (\FAX.PARSE.NAME 29068 . -30300))))) + (FILEMAP (NIL (9930 24764 (GETNSPRINTER 9940 . 10693) (NSPRINT 10695 . 12243) (\NSPRINT.INTERNAL 12245 + . 22687) (\NSPRINT.MEDIUM.CHECK 22689 . 23067) (\NSPRINT.UNSUPPORTED 23069 . 23374) ( +NSPRINTER.HOSTNAMEP 23376 . 23647) (NSPRINTER.STATUS 23649 . 23772) (NSPRINTER.PROPERTIES 23774 . +23906) (NSPRINTREQUEST.STATUS 23908 . 24070) (\NSPRINT.ENQUIRE 24072 . 24555) (\NSPRINT.COURIER.OPEN +24557 . 24762)) (24797 27384 (\NSPRINT.WATCHDOG 24807 . 26064) (\NSPRINT.WATCH.JOB 26066 . 26497) ( +\NSPRINT.FULL.REQUEST.STATUS 26499 . 27382)) (27520 31135 (FAX.SEND.FILE 27530 . 27922) (FAX.STATUS +27924 . 28162) (FAX.PROPERTIES 28164 . 28420) (FAX.HOSTNAMEP 28422 . 28988) (\FAX.PARSE.NAME 28990 . +31133))))) STOP diff --git a/sources/NSPRINT.LCOM b/sources/NSPRINT.LCOM index 64606223ed8f25d212b03d42d01e57505cecc350..f57de53ce092f3c0dcfdcd0ee9969f8dbe2d21fe 100644 GIT binary patch delta 1739 zcma)6U1%It6y9AM5=OK?n55Yz^>kv)Y|@$R%va2~#U z?z!iF=gfD{y(f4IB%Srdp>dcw zxF2+LyI~CzSM+QUGL{S6gY~lVx7)7AiZ4V!FF0gZ)*f}mGzyA(Dq^}^VtQ&I_vxyp z%L?iz{kMQhgc~N_Ej@_?db*dZ{Th5H6y)g9HGd&4H?-Ag-3!c7*D#1^Hk=J|wdIBj zkKyFgCL8f)(>I7;H(y8meB;N6rIs?{S1lDEGxSJUKF~sGDO*FOX7bNLy?Fyp9 zX?qPPm)nYKaFF>i=3{Bkv~R_zqEK&59p+iGT~%K}abKOlY^5$WlO>RY9G zPRK$O{N5lA(uhvhqyeU8X*izlO zz*V~1rPKcImPZb*UZGxhXPy1TN-af?cW+5F*&7as%by^2EuTSbUw;4j*X^eLS0<=yhDXllYMH%^vAC4ZS|ucMc{VgBN| zn@a&fRTcQBPE|>OXjTeY$ zjpm22g=7@3h)u;VeI`4G%Ea!(F&__!yAC^(aft_79Nf_%*TY*q45~&iZEYOk1O<2I ziR-c#MbR{NBt|;zpoh4iV2|H_IuKL9A!fFaCHOY@$Il6%DhfR+ZpIEdE$RcREaQu^ zuUwj(n=R`+s8J30^mMiJFw9k_$}_WvC#zE!p(HS_gNMp2`uA6-U#vZ zK-?L97SU)A)9<2e?Ma#4nG^C9;&qwD<&~%EBmT$H8w!hd)k(x9mD#PaJ!?2(rRhYh zg`SFypzG%t+eS2oA89OTZJgn6S_?fHXGwna=VpS@e3&RAhI&~<#m7s%EVpvA=|Pq@S%`>t`ir26iF7H^4kc2ixeDK^?8)AY1!#ka;897{2M_ zpW7JA&g5Ri#UzvOYI1WuCpZOTXOgZ+&7lZKH>O(exKN?Yt>p(!9PgvQ>%Pvo*C|=H bwA=8^?bw%id+F&Et9>;!fUUQ#viI%aXLq8sd_) zuxTCL29tQ1rpY`YBs3(nCnh!)At4wVnlvF0UqXTnc;JnPX%gKVhzB^=Yqv>&ghU>G zKK|cxeb2e)o|{uAU1wf#F-$^EDjAtgDk+&&GD#J7=(3bBrHPabw30DpJ*5~LeRlKK z6%WM_w>UbOasp^R$nMHl*+>{TLF9v?z|p|a1?#zma-~!Rs|qwwM-#^GW6@%{J|83C zV~2|MMa!zxW0isstCZ^t1*=vPyuMi7TB;RF^;pKxbX?dw!g+ued~7;jV!qQXU&I*b`zjX@`H<)j(|=1N%t{Nm z1P@$D^CS`MNDOm?G5vCfqT(32|D0^kY@5s}=k2hZ5Xc3{MWfYlgx!}k>jkeaeC^X;e zP?4@}Un0NWb_@C8_IHr8oh9TKon?nfd)dvPb>4jvdAhgDj(7dyq8bC;11=P@Jty$x zMo(@7KK%4FYK_yq3NG8Y(U*2@q! zG>wGQQ34h~{5Ki0d zpx8D4!%W9jwXOJhbK9ZS^Q~my#Ai)2+pnq}_RE9)t@Af$I@I<%jS>6e;1k2&saq=S zYU3+>46HUj#YgXIwIh{hrr%6#60_fYwzXTnPyk+ z(z(KE2c zjt|bCvZ+unbsh}L0_Mw>(U;UXb_CtdsmZ5LpCA6fsvgsOl+q~Jfjc1 zZ~~yLsRr(`zy%>K8-_HAv4lc^TP-CLIx4aOJQoJMBBX4JH*sL6YM3B|K$qi+rpVZ( zq#UGBd_(}ckA`v`ma6kr>&2>>xRqbEI$;DEwzL>9K^8$~lhrGi$YtGw`Jmc*~UhwWiK02I5=7$T&>%#|- zjBf_{s&5wgtHUXd9NsHj5%~m9e105%as`+P#Y{_@5ts0ib2?Ka>3ScKJ?l>7#=~a5 z?{(J+9DU7pK9rQ=Ce~1wClxgVx@t-$F-*lw$)2?z#l+RD-Ebl~D{Qp~g%rkgSRfJq zERd{Xeqx{ZlUQ2UFS.;61 91949 +(FILECREATED "17-Jan-2026 11:06:10" {WMEDLEY}UFS.;62 91935 :EDIT-BY rmk - :CHANGES-TO (FNS \UFSDeleteFile) + :CHANGES-TO (VARS UFSCOMS) - :PREVIOUS-DATE "17-Oct-2025 08:49:57" {WMEDLEY}UFS.;60) + :PREVIOUS-DATE "27-Oct-2025 11:10:55" {WMEDLEY}UFS.;61) (PRETTYCOMPRINT UFSCOMS) @@ -75,8 +75,8 @@ (FNS \UFSError)) (COMS (* ; "File Type and EOL handling") (FNS \UFSGetFileType \UFSSetFileType \UFSeol) - [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (DEFAULTFILETYPE 'BINARY) - (DEFAULTFILETYPELIST '((NIL . BINARY) + [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (DEFAULTFILETYPE 'TEXT) + (DEFAULTFILETYPELIST '((NIL . TEXT) (C . TEXT) (H . TEXT) (EL . TEXT) @@ -1177,10 +1177,10 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap ) (DECLARE%: DONTEVAL@LOAD DOCOPY -(RPAQQ DEFAULTFILETYPE BINARY) +(RPAQQ DEFAULTFILETYPE TEXT) (RPAQQ DEFAULTFILETYPELIST - ((NIL . BINARY) + ((NIL . TEXT) (C . TEXT) (H . TEXT) (EL . TEXT) @@ -1557,23 +1557,23 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (9321 10874 (\UFSCreateDevice 9331 . 9696) (\UFS.CREATE.DEVICE 9698 . 10554) ( -\UFSOpenDevice 10556 . 10733) (\UFSCloseDevice 10735 . 10872)) (15137 63831 (\UFSOpenFile 15147 . -21723) (\UFS.OPENP 21725 . 22222) (\UFS.RECOGNIZE.FILE 22224 . 23654) (\UFS.DIRECTORY.NAME 23656 . -24746) (\UFSCloseFile 24748 . 26807) (\UFSGetFileName 26809 . 27008) (\UFSDeleteFile 27010 . 28204) ( -\UFSRenameFile 28206 . 30523) (\UFSReadPages 30525 . 31660) (\UFSWritePages 31662 . 32882) ( -\UFSTruncateFile 32884 . 35290) (\UFSDirectoryNameP 35292 . 37155) (\UFSEventFn 37157 . 37819) ( -\UFSGetFileInfo 37821 . 42284) (\UFS.CREATE.PROPS 42286 . 42639) (\UFSSetFileInfo 42641 . 44987) ( -\UFSGenerateFiles 44989 . 52601) (\UFS.NEXTFILEFN 52603 . 60419) (\UFS.FILEINFOFN 60421 . 61870) ( -\UFS.VALID.PROPP 61872 . 62164) (\UFS.REGISTER.GFS 62166 . 62421) (\UFS.UNREGISTER.GFS 62423 . 63006) -(\UFS.ABORT.DIRECTORY 63008 . 63356) (\UFS.ABORT.CL-DIRECTORY 63358 . 63645) (\UFS.CLEANUP.GFS.TABLE -63647 . 63829)) (63866 70550 (\UFSMakeUnixFormatName 63876 . 64897) (\UFSParseNameString 64899 . 65273 -) (\UFSParse-Directory 65275 . 65816) (\UFS.PARSE.BODY 65818 . 66363) (\UFS.ADJUST.HOST 66365 . 66524) - (\UFS.FULLNAME 66526 . 67734) (\UFS.ADD.HOST.FIELD 67736 . 68096) (\UFS.REMOVE.HOST.FIELD 68098 . -69768) (\UFS.HANDLE.RELATIVEDIRECTORY 69770 . 70548)) (71366 72511 (CHDIR 71376 . 72509)) (72583 73569 - (\DEVICEFILE.EOSERROR 72593 . 73567)) (73642 74879 (\UNVISIBLE.PAGED.REVALIDATEFILELST 73652 . 74497) - (\UNVISIBLE.FLUSH.OPEN.STREAMS 74499 . 74877)) (74912 76538 (\UFSError 74922 . 76536)) (76582 78997 ( -\UFSGetFileType 76592 . 77193) (\UFSSetFileType 77195 . 77792) (\UFSeol 77794 . 78995)) (87644 88768 ( -\UFSGetPrintFileType 87654 . 88066) (\UFSGetFileTypeConfirm 88068 . 88516) (\UFSPrintTypeMenu 88518 . -88766)) (88798 91636 (\UFStoOtherCopyMess 88808 . 90486) (\UFStoOtherRenameMess 90488 . 91634))))) + (FILEMAP (NIL (9311 10864 (\UFSCreateDevice 9321 . 9686) (\UFS.CREATE.DEVICE 9688 . 10544) ( +\UFSOpenDevice 10546 . 10723) (\UFSCloseDevice 10725 . 10862)) (15127 63821 (\UFSOpenFile 15137 . +21713) (\UFS.OPENP 21715 . 22212) (\UFS.RECOGNIZE.FILE 22214 . 23644) (\UFS.DIRECTORY.NAME 23646 . +24736) (\UFSCloseFile 24738 . 26797) (\UFSGetFileName 26799 . 26998) (\UFSDeleteFile 27000 . 28194) ( +\UFSRenameFile 28196 . 30513) (\UFSReadPages 30515 . 31650) (\UFSWritePages 31652 . 32872) ( +\UFSTruncateFile 32874 . 35280) (\UFSDirectoryNameP 35282 . 37145) (\UFSEventFn 37147 . 37809) ( +\UFSGetFileInfo 37811 . 42274) (\UFS.CREATE.PROPS 42276 . 42629) (\UFSSetFileInfo 42631 . 44977) ( +\UFSGenerateFiles 44979 . 52591) (\UFS.NEXTFILEFN 52593 . 60409) (\UFS.FILEINFOFN 60411 . 61860) ( +\UFS.VALID.PROPP 61862 . 62154) (\UFS.REGISTER.GFS 62156 . 62411) (\UFS.UNREGISTER.GFS 62413 . 62996) +(\UFS.ABORT.DIRECTORY 62998 . 63346) (\UFS.ABORT.CL-DIRECTORY 63348 . 63635) (\UFS.CLEANUP.GFS.TABLE +63637 . 63819)) (63856 70540 (\UFSMakeUnixFormatName 63866 . 64887) (\UFSParseNameString 64889 . 65263 +) (\UFSParse-Directory 65265 . 65806) (\UFS.PARSE.BODY 65808 . 66353) (\UFS.ADJUST.HOST 66355 . 66514) + (\UFS.FULLNAME 66516 . 67724) (\UFS.ADD.HOST.FIELD 67726 . 68086) (\UFS.REMOVE.HOST.FIELD 68088 . +69758) (\UFS.HANDLE.RELATIVEDIRECTORY 69760 . 70538)) (71356 72501 (CHDIR 71366 . 72499)) (72573 73559 + (\DEVICEFILE.EOSERROR 72583 . 73557)) (73632 74869 (\UNVISIBLE.PAGED.REVALIDATEFILELST 73642 . 74487) + (\UNVISIBLE.FLUSH.OPEN.STREAMS 74489 . 74867)) (74902 76528 (\UFSError 74912 . 76526)) (76572 78987 ( +\UFSGetFileType 76582 . 77183) (\UFSSetFileType 77185 . 77782) (\UFSeol 77784 . 78985)) (87630 88754 ( +\UFSGetPrintFileType 87640 . 88052) (\UFSGetFileTypeConfirm 88054 . 88502) (\UFSPrintTypeMenu 88504 . +88752)) (88784 91622 (\UFStoOtherCopyMess 88794 . 90472) (\UFStoOtherRenameMess 90474 . 91620))))) STOP diff --git a/sources/UFS.LCOM b/sources/UFS.LCOM index 628ddcbe270d2ffe37d539705b4ef354edd163dd..021af392a5666d6b1b63571364adbfbc4c185e89 100644 GIT binary patch delta 410 zcmaF3lIhG!rU~I9hUU6niFvw421aHIhK5!KW>$s<6SK7>j5HOL(B%xROpPb56;H~` zFUiQvOIOIuQ&4gX_3=?aR;Z_^r=*aQSdyB8X@HTHfuWKnmxi0CkE?T#t7C|(3#KBF z3nuF_O0gR$SQ=Uyn@;v)l$H&13<_4@3Uv#1_V*3eRImyNat-tJ4-M9J0U9z{oY8Re zUd9D293id|A)1;B8j~5TgeO4pPn2GyZ_Pqgg#)(6Uu6 zZE88Zprj@!k`h%w)pB{0&otn)cMNKFCtcju4BjjOs}~KR|E_bOmaE!szEm^#9BBeZ zN=&^@s!>IaCHm*flsI~z?yl%ezL>5yI1X5Rv%}bRLh};|*enQOYIT#CG)8<0$BszR zcCW)Sr|ipaOPLW u6@QC_pPUrl`YfSUcN4$-2qBM93pqj`ZW3QmAXM|>$PRvWINDOW.;21 221668 +(FILECREATED "24-Dec-2025 00:03:15" {WMEDLEY}WINDOW.;24 223729 :EDIT-BY rmk - :CHANGES-TO (FNS WFROMDS) + :CHANGES-TO (VARS WINDOWCOMS) + (FNS DOWINDOWCOM) - :PREVIOUS-DATE "10-Apr-2023 07:05:18" {WMEDLEY}WINDOW.;20) + :PREVIOUS-DATE "19-Sep-2025 10:51:13" {WMEDLEY}WINDOW.;22) (PRETTYCOMPRINT WINDOWCOMS) @@ -146,11 +147,15 @@ used to draw pictures or make notes on windows.") (Clear 'CLEARW "Clears a window to its gray.") (Bury 'BURYW "Puts a window on the bottom.") (Redisplay 'REDISPLAYW "Redisplays a window using its REPAINTFN.") - (Hardcopy 'HARDCOPYIMAGEW "Prints a window using its HARDCOPYFN." - (SUBITEMS ("To a file" 'HARDCOPYIMAGEW.TOFILE + (Hardcopy '(SEND.FILE.TO.PRINTER WINDOW :DEFAULTPRINTER) + "Prints a window using its HARDCOPYFN." + (SUBITEMS ("To a file" '(CONVERT.TO.IMAGEFILE WINDOW (GetImageFile) + NIL + '(NOERROR T)) + "Puts image on a file; prompts for filename and format" ) - ("To a printer" 'HARDCOPYIMAGEW.TOPRINTER + ("To a printer" '(SEND.FILE.TO.PRINTER WINDOW (GetPrinterName)) "Sends image to a printer of your choosing"))) (Move 'MOVEW "Moves a window by a corner.") (Shape 'SHAPEW "Gets a new region for a window. @@ -163,13 +168,19 @@ Middle button down moves closest corner.") "Updates the virtual memory.") (Snap '(SNAPW) "Saves a snapshot of a region of the screen.") - (Hardcopy '(HARDCOPYW) + (Hardcopy '(SEND.FILE.TO.PRINTER (GETREGION) + :DEFAULTPRINTER) "Send hardcopy of screen region to printer." - (SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE) + (SUBITEMS ("To a file" '(CONVERT.TO.IMAGEFILE (GETREGION) + (GetImageFile) + NIL + '(NOERROR T)) "Writes a region of screen to a file; prompts for filename and format" ) - ("To a printer" '(HARDCOPYREGION.TOPRINTER) + ("To a printer" '(SEND.FILE.TO.PRINTER (GETREGION) + (GetPrinterName) + `(NOERROR T)) "Sends a region of screen to a printer of your choosing"] (ADDVARS (WINDOWUSERFORMS) (ENDOFWINDOWUSERFORMS)) @@ -675,41 +686,46 @@ Middle button down moves closest corner.") (ERSETQ (APPLY* FN WINDOW]) (DOWINDOWCOM - [LAMBDA ARGS (* ; "Edited 25-Nov-86 17:30 by hdj") + [LAMBDA ARGS (* ; "Edited 23-Dec-2025 22:26 by rmk") + (* ; "Edited 25-Nov-86 17:30 by hdj") (* ;; "the button handler for the window system. if no arg, just return.") (if (NEQ ARGS 0) - then - (LET ((WINDOW (ARG ARGS 1))) - (COND - [(type? WINDOW WINDOW) - (PROG ($$VAR) - (COND - ((SETQ $$VAR (WINDOWPROP WINDOW 'DOWINDOWCOMFN)) - (RETURN (APPLY* $$VAR WINDOW))) - (T (\CHECKCARET WINDOW) - (TOTOPW WINDOW) - (RETURN (COND - ([SETQ $$VAR - (MENU (COND - ((type? MENU WindowMenu) - WindowMenu) - (T (SETQ WindowMenu - (create MENU - ITEMS _ WindowMenuCommands - CHANGEOFFSETFLG _ 'Y - MENUOFFSET _ - (create POSITION - XCOORD _ -1 - YCOORD _ 0) - WHENHELDFN _ (FUNCTION PPROMPT3) - WHENUNHELDFN _ (FUNCTION CLRPROMPT) - CENTERFLG _ T] - (APPLY* $$VAR WINDOW) - T] - ((NULL WINDOW) - (DOBACKGROUNDCOM]) + then (LET ((WINDOW (ARG ARGS 1))) + (DECLARE (SPECVARS WINDOW)) + (COND + [(type? WINDOW WINDOW) + (PROG ($$VAR) + (COND + ((SETQ $$VAR (WINDOWPROP WINDOW 'DOWINDOWCOMFN)) + (RETURN (APPLY* $$VAR WINDOW))) + (T (\CHECKCARET WINDOW) + (TOTOPW WINDOW) + (RETURN (COND + ([SETQ $$VAR + (MENU (COND + ((type? MENU WindowMenu) + WindowMenu) + (T (SETQ WindowMenu + (create MENU + ITEMS _ WindowMenuCommands + CHANGEOFFSETFLG _ 'Y + MENUOFFSET _ + (create POSITION + XCOORD _ -1 + YCOORD _ 0) + WHENHELDFN _ + (FUNCTION PPROMPT3) + WHENUNHELDFN _ + (FUNCTION CLRPROMPT) + CENTERFLG _ T] + (CL:IF (LISTP $$VAR) + (EVAL $$VAR) + (APPLY* $$VAR WINDOW)) + T] + ((NULL WINDOW) + (DOBACKGROUNDCOM]) (DOBACKGROUNDCOM [LAMBDA NIL (* ; "Edited 10-Mar-92 15:48 by jds") @@ -1803,7 +1819,8 @@ Middle button down moves closest corner.") (DEFINEQ (WFROMDS - [LAMBDA (DS DONTCREATE) (* ; "Edited 29-Jun-2024 00:17 by rmk") + [LAMBDA (DS DONTCREATE) (* ; "Edited 19-Sep-2025 10:50 by rmk") + (* ; "Edited 29-Jun-2024 00:17 by rmk") (* ; "Edited 7-Jan-94 12:12 by nilsson") (* ;; "Finds or creates a window for a display stream") @@ -1817,7 +1834,7 @@ Middle button down moves closest corner.") ((IMAGESTREAMP DS) (PROG (DD HINTW) [COND - ((IMAGESTREAMTYPEP DS 'TEXT) + ((IMAGESTREAMTYPEP DS 'TEDIT) (* ;; "generalize this mess!!! (If type TEXT exists, then these functions exist)") @@ -3944,10 +3961,13 @@ used to draw pictures or make notes on windows.") (Clear 'CLEARW "Clears a window to its gray.") (Bury 'BURYW "Puts a window on the bottom.") (Redisplay 'REDISPLAYW "Redisplays a window using its REPAINTFN.") - (Hardcopy 'HARDCOPYIMAGEW "Prints a window using its HARDCOPYFN." - (SUBITEMS ("To a file" 'HARDCOPYIMAGEW.TOFILE + (Hardcopy '(SEND.FILE.TO.PRINTER WINDOW :DEFAULTPRINTER) + "Prints a window using its HARDCOPYFN." + (SUBITEMS ("To a file" '(CONVERT.TO.IMAGEFILE WINDOW (GetImageFile) + NIL + '(NOERROR T)) "Puts image on a file; prompts for filename and format") - ("To a printer" 'HARDCOPYIMAGEW.TOPRINTER + ("To a printer" '(SEND.FILE.TO.PRINTER WINDOW (GetPrinterName)) "Sends image to a printer of your choosing"))) (Move 'MOVEW "Moves a window by a corner.") (Shape 'SHAPEW "Gets a new region for a window. @@ -3961,13 +3981,19 @@ Middle button down moves closest corner.") "Updates the virtual memory.") (Snap '(SNAPW) "Saves a snapshot of a region of the screen.") - (Hardcopy '(HARDCOPYW) + (Hardcopy '(SEND.FILE.TO.PRINTER (GETREGION) + :DEFAULTPRINTER) "Send hardcopy of screen region to printer." - (SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE) + (SUBITEMS ("To a file" '(CONVERT.TO.IMAGEFILE (GETREGION) + (GetImageFile) + NIL + '(NOERROR T)) "Writes a region of screen to a file; prompts for filename and format" ) - ("To a printer" '(HARDCOPYREGION.TOPRINTER) + ("To a printer" '(SEND.FILE.TO.PRINTER (GETREGION) + (GetPrinterName) + `(NOERROR T)) "Sends a region of screen to a printer of your choosing")))) (ADDTOVAR WINDOWUSERFORMS ) @@ -4003,42 +4029,42 @@ Middle button down moves closest corner.") (ADDTOVAR LAMA PROMPTPRINT WINDOWPROP DOWINDOWCOM) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (11403 26043 (WINDOWWORLD 11413 . 15166) (WINDOWWORLDP 15168 . 15468) (CHANGEBACKGROUND -15470 . 16507) (CHANGEBACKGROUNDBORDER 16509 . 17060) (TILE 17062 . 17654) ( -\TTY.CREATING.DISPLAYSTREAM 17656 . 18203) (\CREATE.TTY.OUTCHARFN 18205 . 18505) ( -\CREATE.TTYDISPLAYSTREAM 18507 . 21546) (HASTTYWINDOWP 21548 . 21828) (TTYINFOSTREAM 21830 . 22354) ( -CREATESCREEN 22356 . 25299) (\INSURESCREEN 25301 . 25550) (\BITMAPTOSCREEN 25552 . 25913) (MAINSCREEN -25915 . 26041)) (26690 43973 (WINDOW.MOUSE.HANDLER 26700 . 39495) (\PROTECTED.APPLY 39497 . 39745) ( -DOWINDOWCOM 39747 . 41767) (DOBACKGROUNDCOM 41769 . 42927) (DEFAULT.BACKGROUND.COPYFN 42929 . 43971)) -(44054 75937 (BURYW 44064 . 44352) (CLEARW 44354 . 44744) (CLOSEW 44746 . 45520) (\CLOSEW1 45522 . -45875) (\OKTOCLOSEW 45877 . 46236) (\INTERACTIVE.CLOSEW 46238 . 47061) (OPENW 47063 . 48118) ( -DOUSERFNS 48120 . 49281) (DOUSERFNS2 49283 . 49779) (\USERFNISDON'T 49781 . 50052) (\OPENW1 50054 . -50404) (CREATEW 50406 . 51670) (CREATEW1 51672 . 53950) (\CREATEW1 53952 . 55171) (OPENDISPLAYSTREAM -55173 . 55496) (MOVEW 55498 . 55713) (PPROMPT3 55715 . 56043) (\ONSCREENCLIPPINGREGION 56045 . 56596) -(RELMOVEW 56598 . 56896) (SHAPEW 56898 . 61817) (SHAPEW1 61819 . 64521) (\SHAPEW2 64523 . 67209) ( -RESHOWBORDER 67211 . 67722) (\RESHOWBORDER1 67724 . 72650) (TRACKW 72652 . 73767) (SNAPW 73769 . 75442 -) (WINDOWREGION 75444 . 75935)) (75938 76634 (MINIMUMWINDOWSIZE 75948 . 76632)) (78281 101546 ( -ADVISEWDS 78291 . 86234) (SHOWWFRAME 86236 . 87988) (SHOWWTITLE 87990 . 92024) (\STRINGWIDTHGUESS -92026 . 92385) (RESHOWTITLE 92387 . 97028) (TOTOPW 97030 . 97269) (\INTERNALTOTOPW 97271 . 98361) ( -\TTW1 98363 . 100963) (WHICHW 100965 . 101544)) (101675 104661 (WFROMDS 101685 . 103831) (NU\TOTOPWDS -103833 . 104269) (\COERCETODS 104271 . 104659)) (105304 112104 (WINDOWP 105314 . 105460) ( -INSURE.WINDOW 105462 . 105801) (WINDOWPROP 105803 . 106235) (WINDOWADDPROP 106237 . 107971) ( -WINDOWDELPROP 107973 . 108399) (GETWINDOWPROP 108401 . 108951) (GETWINDOWUSERPROP 108953 . 109380) ( -PUTWINDOWPROP 109382 . 109847) (REMWINDOWPROP 109849 . 110904) (WINDOWADDFNPROP 110906 . 112102)) ( -112308 119872 (CWINDOWPROP 112318 . 113323) (CGETWINDOWPROP 113325 . 118543) (\GETWINDOWHEIGHT 118545 - . 119453) (\GETWINDOWWIDTH 119455 . 119870)) (119873 120532 (WINDOW.BITMAP 119883 . 120530)) (120558 -136006 (OPENWP 120568 . 120846) (TOPWP 120848 . 121131) (RESHAPEBYREPAINTFN 121133 . 131385) ( -\INBETWEENP 131387 . 131603) (DECODE/WINDOW/OR/DISPLAYSTREAM 131605 . 133645) (GROW/REGION 133647 . -134210) (CLRPROMPT 134212 . 134616) (PROMPTPRINT 134618 . 134882) (OPENWINDOWS 134884 . 135668) ( -\INSUREWINDOW 135670 . 136004)) (136137 139386 (OVERLAPPINGWINDOWS 136147 . 138429) (WOVERLAPP 138431 - . 138686) (ORDERFROMBOTTOMTOTOP 138688 . 139384)) (139435 144218 (\ONSCREENW 139445 . 140151) ( -\PUTONSCREENW 140153 . 140980) (\UPDATECACHEDFIELDS 140982 . 141246) (\WWCHANGESCREENSIZE 141248 . -142637) (CREATEWFROMIMAGE 142639 . 143602) (UPDATEWFROMIMAGE 143604 . 144216)) (144775 197377 ( -\MEDW.CREATEW 144785 . 149459) (\MEDW.OPENW 149461 . 151819) (\MEDW.CLOSEW 151821 . 153187) ( -\MEDW.MOVEW 153189 . 163801) (\MEDW.RELMOVEW 163803 . 164182) (\MEDW.SHRINKW 164184 . 172368) ( -\MEDW.EXPANDW 172370 . 174637) (\MEDW.SHAPEW 174639 . 179245) (\MEDW.REDISPLAYW 179247 . 181202) ( -\MEDW.BURYW 181204 . 182486) (\MEDW.TOTOPW 182488 . 183836) (\MEDW.DSPCREATE 183838 . 184639) ( -\GENERIC.DSPCREATE 184641 . 186358) (\GENERIC.DSPCREATE.DESTINATION.BITMAP? 186360 . 186546) ( -\MEDW.GETWINDOWPROP 186548 . 188786) (\MEDW.PUTWINDOWPROP 188788 . 195573) (\MEDW.CURSOR 195575 . -197375)) (197378 197998 (\GENERIC.CURSOR 197388 . 197996))))) + (FILEMAP (NIL (12198 26838 (WINDOWWORLD 12208 . 15961) (WINDOWWORLDP 15963 . 16263) (CHANGEBACKGROUND +16265 . 17302) (CHANGEBACKGROUNDBORDER 17304 . 17855) (TILE 17857 . 18449) ( +\TTY.CREATING.DISPLAYSTREAM 18451 . 18998) (\CREATE.TTY.OUTCHARFN 19000 . 19300) ( +\CREATE.TTYDISPLAYSTREAM 19302 . 22341) (HASTTYWINDOWP 22343 . 22623) (TTYINFOSTREAM 22625 . 23149) ( +CREATESCREEN 23151 . 26094) (\INSURESCREEN 26096 . 26345) (\BITMAPTOSCREEN 26347 . 26708) (MAINSCREEN +26710 . 26836)) (27485 45332 (WINDOW.MOUSE.HANDLER 27495 . 40290) (\PROTECTED.APPLY 40292 . 40540) ( +DOWINDOWCOM 40542 . 43126) (DOBACKGROUNDCOM 43128 . 44286) (DEFAULT.BACKGROUND.COPYFN 44288 . 45330)) +(45413 77296 (BURYW 45423 . 45711) (CLEARW 45713 . 46103) (CLOSEW 46105 . 46879) (\CLOSEW1 46881 . +47234) (\OKTOCLOSEW 47236 . 47595) (\INTERACTIVE.CLOSEW 47597 . 48420) (OPENW 48422 . 49477) ( +DOUSERFNS 49479 . 50640) (DOUSERFNS2 50642 . 51138) (\USERFNISDON'T 51140 . 51411) (\OPENW1 51413 . +51763) (CREATEW 51765 . 53029) (CREATEW1 53031 . 55309) (\CREATEW1 55311 . 56530) (OPENDISPLAYSTREAM +56532 . 56855) (MOVEW 56857 . 57072) (PPROMPT3 57074 . 57402) (\ONSCREENCLIPPINGREGION 57404 . 57955) +(RELMOVEW 57957 . 58255) (SHAPEW 58257 . 63176) (SHAPEW1 63178 . 65880) (\SHAPEW2 65882 . 68568) ( +RESHOWBORDER 68570 . 69081) (\RESHOWBORDER1 69083 . 74009) (TRACKW 74011 . 75126) (SNAPW 75128 . 76801 +) (WINDOWREGION 76803 . 77294)) (77297 77993 (MINIMUMWINDOWSIZE 77307 . 77991)) (79640 102905 ( +ADVISEWDS 79650 . 87593) (SHOWWFRAME 87595 . 89347) (SHOWWTITLE 89349 . 93383) (\STRINGWIDTHGUESS +93385 . 93744) (RESHOWTITLE 93746 . 98387) (TOTOPW 98389 . 98628) (\INTERNALTOTOPW 98630 . 99720) ( +\TTW1 99722 . 102322) (WHICHW 102324 . 102903)) (103034 106130 (WFROMDS 103044 . 105300) (NU\TOTOPWDS +105302 . 105738) (\COERCETODS 105740 . 106128)) (106773 113573 (WINDOWP 106783 . 106929) ( +INSURE.WINDOW 106931 . 107270) (WINDOWPROP 107272 . 107704) (WINDOWADDPROP 107706 . 109440) ( +WINDOWDELPROP 109442 . 109868) (GETWINDOWPROP 109870 . 110420) (GETWINDOWUSERPROP 110422 . 110849) ( +PUTWINDOWPROP 110851 . 111316) (REMWINDOWPROP 111318 . 112373) (WINDOWADDFNPROP 112375 . 113571)) ( +113777 121341 (CWINDOWPROP 113787 . 114792) (CGETWINDOWPROP 114794 . 120012) (\GETWINDOWHEIGHT 120014 + . 120922) (\GETWINDOWWIDTH 120924 . 121339)) (121342 122001 (WINDOW.BITMAP 121352 . 121999)) (122027 +137475 (OPENWP 122037 . 122315) (TOPWP 122317 . 122600) (RESHAPEBYREPAINTFN 122602 . 132854) ( +\INBETWEENP 132856 . 133072) (DECODE/WINDOW/OR/DISPLAYSTREAM 133074 . 135114) (GROW/REGION 135116 . +135679) (CLRPROMPT 135681 . 136085) (PROMPTPRINT 136087 . 136351) (OPENWINDOWS 136353 . 137137) ( +\INSUREWINDOW 137139 . 137473)) (137606 140855 (OVERLAPPINGWINDOWS 137616 . 139898) (WOVERLAPP 139900 + . 140155) (ORDERFROMBOTTOMTOTOP 140157 . 140853)) (140904 145687 (\ONSCREENW 140914 . 141620) ( +\PUTONSCREENW 141622 . 142449) (\UPDATECACHEDFIELDS 142451 . 142715) (\WWCHANGESCREENSIZE 142717 . +144106) (CREATEWFROMIMAGE 144108 . 145071) (UPDATEWFROMIMAGE 145073 . 145685)) (146244 198846 ( +\MEDW.CREATEW 146254 . 150928) (\MEDW.OPENW 150930 . 153288) (\MEDW.CLOSEW 153290 . 154656) ( +\MEDW.MOVEW 154658 . 165270) (\MEDW.RELMOVEW 165272 . 165651) (\MEDW.SHRINKW 165653 . 173837) ( +\MEDW.EXPANDW 173839 . 176106) (\MEDW.SHAPEW 176108 . 180714) (\MEDW.REDISPLAYW 180716 . 182671) ( +\MEDW.BURYW 182673 . 183955) (\MEDW.TOTOPW 183957 . 185305) (\MEDW.DSPCREATE 185307 . 186108) ( +\GENERIC.DSPCREATE 186110 . 187827) (\GENERIC.DSPCREATE.DESTINATION.BITMAP? 187829 . 188015) ( +\MEDW.GETWINDOWPROP 188017 . 190255) (\MEDW.PUTWINDOWPROP 190257 . 197042) (\MEDW.CURSOR 197044 . +198844)) (198847 199467 (\GENERIC.CURSOR 198857 . 199465))))) STOP diff --git a/sources/WINDOW.LCOM b/sources/WINDOW.LCOM index ff1f1a974b458f96a28efd4ebffbf225147489c5..7114648022fcf6dbd23e4e45c486c41495d567ba 100644 GIT binary patch delta 4098 zcmdT{Yit}>72erR?09Kxuj4pz;w0B@)a;UaJ$K%_AmQDeS$oKOW;!$LjU_9Mm8@zv zaT=uoi6U?bs8tjqVs5ArAW$npQ4ms`NmKD7i34rbgi6pKAq4~i2_YdN(f;C1ICmbq zYu6S0gw;xO?z!*tedjwf*Dh?hesRNvgFV8qT0b((v7CrlHqY{Ty!d3cU&x^35aybF zIG5)o=w4jj`B90Lp5t9bHd4>blGqav?5mqO6FCq zT&Pyu(4Wa5^47MpmQI#TV^XtSI!B)+hcoZiMJk)~UG@r|YMTnfZDq^XmBoGslpB^j{X%J$QOd zb8T%*Hw{4W{ik1gWg}A=U;p&2Q~$dwEcLZ9b@M--W9=nSy0}g_DC3;^iK9!XjoCq7 z-abHnvUBs6AP!YWv&*LKBc3FG+UYK(+nF9Fxs-2bcye}N_tF>JnNDbbt)1CNel>u* z($m4rnrT;5lq9=$St->7Y$pqq(TZ6BpK6i^J$>ZjE@dJZYuTpNN~R=$l*xop1PkR= zC7HI6fLu;S7UJP4!IOih2u}=8!P~m~>zk86WDAMVR>%+bTWuM{Otr_!o=5+(@o)@& zq<{GCfPm4o1DT-#iFuB1X#htb4EHkv>Cf(75YhC6rq;3mZ7|w09o+?p5vNFDU#Vbg zZq^w$YlxHO&{-_Ha5MNLPEwk_vTf2EBTmdUoi0rxaIr|8d-~+@nNO8fZ4z<3h`jG) zuMh0GvoRKr)l*Dt{KJcqPIrYG z0(jEi-&}VCZRPydGgEit&=Od0eELv=TG+e%_%`3id9TmB$xt8fEgqTZXs=opDx)0f zywSG}vr&|bx;s&@Ktq`4HYLd3`IEhe=}E8duXSI0XttQ7jam=6G(W=hl6&*_8JUdU z?pxp`h^|xPiW2}?4iyi;I>m~Mcs7Sr$0}8H%hHXpAO`^p5m8WTWxFt;`7l&1Doi7Q zq*uH-Wr(vo}EjT|T#^8_;UKmgPNv(%Hy# zkY9dcwu=)`8B#YWAqbNf>st~~R=ne%Jd%VVKYezL>F~CH?h$5lj%^u9K6*y)#Bi(T zWb%bGH@(@OHR zs7I^A&s*26VTc|VO{4j-Y7`cEfC-jxv{I<_KokgllQy}CHM<+Mkyl06CygMJ#dEz6 zHMt;&fW+1XA4H!$z~~5C$lS<;14X9HHcSal93sn!V#6%}{e6K0B@r4X*Vu!@&DF3^ z)&;sX$2L~RO4F1ZbjGk>xG6ja`y>J)OW8X&Me1%N30u%`h2>65Oa5sf87wF(g0r%a!}18B?1;fP@-&AxV1`z zrByNUIR#?9W*FotC$KcdCpbvOh&dp`kqKfmt?CYl&=d$`0m$D(1JhC#9f1mOWQ*j= zIS>y)peqkx5aLD`?9vJqk#GGWtN;S70DW++fFq3p5c@?UL5{9G62-|`mEkV=#>xm& zC2y@f4cr*Lz5Qc!13#xRu(u^f?ApsCh1T>2ZTt|45?Q*9;uzDDFJOprsRFN1s(PQSSExuAv{6 zZaKf@J@>=kGn;~P3T2trQ+PjE8_vYDg9*=j?K(5^&aDbliJRSK&+HEP-AHw(J`OJn z=Tm4)K*`}+5o&EAsI@Bj${Qn0*?awslgxqybtz;;4JnZLf%=DKRe^0=`$1+`_d}ky z^vgMAb-xVq(b_M{tNW$A3<#J;5WzJyT>|2_OqK)%-fH|eRCtY(1oGSay$?$e{%PHC zsz%#B zF#D7Uc!`%$p$w&B!kpB~29h8u;c3Ji@bB){A)(=DDz!*6C?tT$(nO1cu)(8S@ZWtJ ze73yQkMC>+rIT3i*T4BpH?^?$_y)5+LOPNCFQ?Ai=pi zJ2ShR@I*%|&6#u0J@=k-zw@2D@4l8;JC!)KyC*yT=vNlUsX!$x2vbCz5>6kS7$9Rf zxt*%f7!{`o{N&RsgJz?CVq#)D-naM5`}g6y*i&KqSaP&bEa}sho^x~!jP6{J4WW@L z!ITn3QSp?n6`k??9(?3Whw#+&Y_2k++vARbM++4jC*6W&lr?({PnniJS2U{jxCWl_ zb|Q@DmX7d9L@Z>c1Q~*1!)O=@-euI)mzvF4+O%QrDVB3Hx(o3!w6)ONtetQSzFBr+ zt38msW5~3M6-T$cu7NG_dxBASjJv81mO@vSK2tO*fvX#X`v(KtaHQ@Drn0j`vs;pG zv7#An)z+B8{0bm&$!#edMDl=5>-5J!zt@< zNFo&)K8V2nH8Jp6g6GS+=1$D$PTttxYB- zRFNYc$3;ykE0NMMK;^wX`HP`@FKmj%WBXGmHhb{qw^w3ohxVqnwG}VN;CX!|_I>uv z(&^E)j^d%x=B@+X#UFR@f$oLw*eFpItQq;-^sX7ps8#?(WzQ~u)SeIkuk2QJl+8K6 z;U5_`UcJZ#)w@+angA&yde1(7JI*D^d;0TFv~fxHu0Gjc(<$B`pV~lNm+{`&SMDsB zwLH(;M!}h`TDDv7^O^FyxA}XAiV>pKCYBnZduGwbe_K3`F!$<(%6-=na4lEUsz^{sxtPofT<*eS}_vA zLwz+W$RIvkTbX2)U^$|O-iQLJ4PuidhAyV#qQZCW{p49|6KZGwetv-+d7-}tc(VYt z2a!)(Mbj}X?0xHnFC@X@FE7oYc29o!LBtLon_(A^oqvF2g;r}q)E1R@^y_OJC@S@& zSN?;RIRXIZQ7U~<0Lt%%i40iQ$}ob&;Y1=9&$V+HT#diJg6tGVJN-|(CxzRb)g9Hf z%?nR*gBn=oZhmfcp!T^D`#Jm7dVkkY!>HTkT|J&cpCs5Y^$MIFBB69)L<{R?rNf&v9IWdD83Chzgw4IE}~xd+bEog6Kn}Wl1a0GMsFhaVCi^ zM$m;sz+;FuhCWCya~uU4A%r5$hISM-6hKDFgrW>Pu49ABG*nAaF}2KNDw0s7;Tn`g z-UNXAvJZWd4Lt)71m1u|LJ`)hJ0`%gp%|74iI7c5xE}&J54H&m7KoWpY{LrSh>pu5 ze{r!GC%W3TRTnkb>l&Rv>he_iil zzrXaw-TxyIL<)Nf;hiE%1Yof_LY(1c-<$`TvhTi!<3fgSa2X1Hx@6dJXXFjIUWSBE z3u1$w6R4G_7-SM^#b_Rl$_c6^s39oBz*{!V2Zl~E?{xT$EmLb%NCCp=?F@75oxS{L zG{bQz@`%GQd}bD5{@thFw#Si`?*`&Uh@inM7QIJ$Wp4yIv# z2C~pJo&oM@9EUn?8du_wpqrZpup+CChKeM^ovC)Ah5Mi)W?AaP-erJIv0_&(y?$&8 zuvJc*E8050L&*F_(U{AizGMz)zq81kd+Q=kbBHh*@Z5qhnV)XtPcz!#1|q>#>%{vA zJtPMpP~Zr21?W>{V@@wrumUNm?@v}$&WsPp5vJsb20 ps4^>gx39n0%_Z4;?)F^jWBn6y0G)ZJ9j$&`|3rRvwga6*{{=re)VTlv