From 9067cc034808e78ebb229ba7749299d51782797c Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 21 Jul 2025 12:45:52 -0700 Subject: [PATCH 1/7] Inspectcode scrolls, has the correct window title --- library/tedit/TEDIT-WINDOW | 76 ++++++++++---------- library/tedit/TEDIT-WINDOW.LCOM | Bin 63156 -> 63180 bytes sources/INSPECT | 118 +++++++++++++++++--------------- sources/INSPECT.LCOM | Bin 53351 -> 53274 bytes 4 files changed, 100 insertions(+), 94 deletions(-) diff --git a/library/tedit/TEDIT-WINDOW b/library/tedit/TEDIT-WINDOW index 49dfe893b..6a9754708 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 "30-May-2025 12:54:56" {WMEDLEY}TEDIT>TEDIT-WINDOW.;860 229476 +(FILECREATED "21-Jul-2025 11:55:26" {WMEDLEY}TEDIT>TEDIT-WINDOW.;861 229641 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.DEACTIVATE.WINDOW) + :CHANGES-TO (FNS \TEDIT.WINDOW.CREATE) - :PREVIOUS-DATE "29-May-2025 15:02:25" {WMEDLEY}TEDIT>TEDIT-WINDOW.;858) + :PREVIOUS-DATE "30-May-2025 12:54:56" {WMEDLEY}TEDIT>TEDIT-WINDOW.;860) (PRETTYCOMPRINT TEDIT-WINDOWCOMS) @@ -354,7 +354,8 @@ (DEFINEQ (\TEDIT.WINDOW.CREATE - [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 9-May-2025 12:11 by rmk") + [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 21-Jul-2025 11:55 by rmk") + (* ; "Edited 9-May-2025 12:11 by rmk") (* ; "Edited 25-Apr-2025 21:24 by rmk") (* ; "Edited 20-Apr-2025 15:21 by rmk") (* ; "Edited 18-Feb-2025 09:49 by rmk") @@ -392,7 +393,8 @@ (TEDIT.KILL WINDOW) (\TEDIT.CLOSESPLITS (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW) T)) - (SETQ TITLE (LISTGET PROPS 'TITLE))) + [SETQ TITLE (OR (LISTGET PROPS 'TITLE) + (WINDOWPROP WINDOW 'TITLE]) (SETQ REGIONTYPE (OR (GETTEXTPROP TEXTOBJ 'REGION-TYPE) (AND (LITATOM WINDOW) WINDOW))) @@ -3627,36 +3629,36 @@ (RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (17103 17999 (TEDIT.DEFER.UPDATES 17113 . 17997)) (18000 43777 (\TEDIT.WINDOW.CREATE -18010 . 25172) (\TEDIT.WINDOW.GETREGION 25174 . 28664) (\TEDIT.WINDOW.SETUP 28666 . 32996) ( -\TEDIT.MINIMAL.WINDOW.SETUP 32998 . 40409) (\TEDIT.CLEARPANE 40411 . 41128) (\TEDIT.FILL.PANES 41130 - . 43775)) (43778 67751 (\TEDIT.CURSORMOVEDFN 43788 . 49398) (\TEDIT.CURSOROUTFN 49400 . 50088) ( -\TEDIT.ACTIVE.WINDOWP 50090 . 51160) (\TEDIT.EXPANDFN 51162 . 51725) (\TEDIT.MAINW 51727 . 53007) ( -\TEDIT.MAINSTREAM 53009 . 53343) (\TEDIT.PRIMARYPANE 53345 . 54115) (\TEDIT.PANELIST 54117 . 54613) ( -\TEDIT.NEWREGIONFN 54615 . 57131) (\TEDIT.SET.WINDOW.EXTENT 57133 . 62387) (\TEDIT.SHRINK.ICONCREATE -62389 . 65122) (\TEDIT.SHRINKFN 65124 . 65533) (\TEDIT.PANEREGION 65535 . 67749)) (67783 100829 ( -\TEDIT.BUTTONEVENTFN 67793 . 80766) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80768 . 88031) ( -\TEDIT.BUTTONEVENTFN.GETOPERATION 88033 . 89875) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89877 . 93547) ( -\TEDIT.BUTTONEVENTFN.INACTIVE 93549 . 95979) (\TEDIT.BUTTONEVENTFN.INTITLE 95981 . 97816) ( -\TEDIT.COPYINSERTFN 97818 . 98950) (\TEDIT.FOREIGN.COPY 98952 . 100827)) (100830 118072 ( -\TEDIT.PANE.SPLIT 100840 . 104788) (\TEDIT.SPLITW 104790 . 112528) (\TEDIT.UNSPLITW 112530 . 116729) ( -\TEDIT.LINKPANES 116731 . 117494) (\TEDIT.UNLINKPANE 117496 . 118070)) (119506 120397 (TEDITWINDOWP -119516 . 120395)) (120434 123537 (TEDIT.GETINPUT 120444 . 122887) (\TEDIT.MAKEFILENAME 122889 . 123535 -)) (123586 131213 (TEDIT.PROMPTWINDOW 123596 . 123910) (TEDIT.PROMPTPRINT 123912 . 126539) ( -TEDIT.PROMPTCLEAR 126541 . 128260) (TEDIT.PROMPTFLASH 128262 . 129520) (\TEDIT.PROMPT.PAGEFULLFN -129522 . 131211)) (131451 141855 (\TEDIT.FILENAME 131461 . 132233) (\TEDIT.DEFAULT.TITLE 132235 . -134614) (\TEDIT.WINDOW.TITLE 134616 . 136785) (\TEDIT.LIKELY.FILENAME 136787 . 139337) ( -\TEDIT.UPDATE.TITLE 139339 . 141853)) (141898 154382 (TEDIT.DEACTIVATE.WINDOW 141908 . 147481) ( -\TEDIT.RESHAPEFN 147483 . 149568) (\TEDIT.REPAINTFN 149570 . 149794) (\TEDIT.CLOSESPLITS 149796 . -152241) (\TEDIT.CLOSEPANE 152243 . 154380)) (154383 197182 (\TEDIT.SCROLLFN 154393 . 156624) ( -\TEDIT.SCROLLCH.TOP 156626 . 158737) (\TEDIT.SCROLLCH.BOTTOM 158739 . 163069) (\TEDIT.SCROLLUP 163071 - . 168797) (\TEDIT.TOPLINE.YTOP 168799 . 170468) (\TEDIT.SCROLLDOWN 170470 . 177509) ( -\TEDIT.SCROLL.CARET 177511 . 180349) (\TEDIT.VISIBLECARETP 180351 . 182645) (\TEDIT.VISIBLECHARP -182647 . 183738) (\TEDIT.BITMAPLINES 183740 . 187660) (\TEDIT.SETPANE.TOPLINE 187662 . 188274) ( -\TEDIT.SHIFTLINES 188276 . 197180)) (197183 208052 (\TEDIT.ONSCREEN? 197193 . 201744) ( -\TEDIT.ONSCREEN.REGION 201746 . 205397) (\TEDIT.AFTERMOVEFN 205399 . 206296) (OFFSCREENP 206298 . -208050)) (208094 210908 (\TEDIT.PROCIDLEFN 208104 . 209764) (\TEDIT.PROCENTRYFN 209766 . 210211) ( -\TEDIT.PROCEXITFN 210213 . 210906)) (210987 224212 (\TEDIT.DOWNCARET 210997 . 211790) ( -\TEDIT.FLASHCARET 211792 . 213903) (\TEDIT.UPCARET 213905 . 215009) (TEDIT.NORMALIZECARET 215011 . -218229) (\TEDIT.SETCARET 218231 . 223582) (\TEDIT.CARET 223584 . 224210))))) + (FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 43942 (\TEDIT.WINDOW.CREATE +18007 . 25337) (\TEDIT.WINDOW.GETREGION 25339 . 28829) (\TEDIT.WINDOW.SETUP 28831 . 33161) ( +\TEDIT.MINIMAL.WINDOW.SETUP 33163 . 40574) (\TEDIT.CLEARPANE 40576 . 41293) (\TEDIT.FILL.PANES 41295 + . 43940)) (43943 67916 (\TEDIT.CURSORMOVEDFN 43953 . 49563) (\TEDIT.CURSOROUTFN 49565 . 50253) ( +\TEDIT.ACTIVE.WINDOWP 50255 . 51325) (\TEDIT.EXPANDFN 51327 . 51890) (\TEDIT.MAINW 51892 . 53172) ( +\TEDIT.MAINSTREAM 53174 . 53508) (\TEDIT.PRIMARYPANE 53510 . 54280) (\TEDIT.PANELIST 54282 . 54778) ( +\TEDIT.NEWREGIONFN 54780 . 57296) (\TEDIT.SET.WINDOW.EXTENT 57298 . 62552) (\TEDIT.SHRINK.ICONCREATE +62554 . 65287) (\TEDIT.SHRINKFN 65289 . 65698) (\TEDIT.PANEREGION 65700 . 67914)) (67948 100994 ( +\TEDIT.BUTTONEVENTFN 67958 . 80931) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80933 . 88196) ( +\TEDIT.BUTTONEVENTFN.GETOPERATION 88198 . 90040) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90042 . 93712) ( +\TEDIT.BUTTONEVENTFN.INACTIVE 93714 . 96144) (\TEDIT.BUTTONEVENTFN.INTITLE 96146 . 97981) ( +\TEDIT.COPYINSERTFN 97983 . 99115) (\TEDIT.FOREIGN.COPY 99117 . 100992)) (100995 118237 ( +\TEDIT.PANE.SPLIT 101005 . 104953) (\TEDIT.SPLITW 104955 . 112693) (\TEDIT.UNSPLITW 112695 . 116894) ( +\TEDIT.LINKPANES 116896 . 117659) (\TEDIT.UNLINKPANE 117661 . 118235)) (119671 120562 (TEDITWINDOWP +119681 . 120560)) (120599 123702 (TEDIT.GETINPUT 120609 . 123052) (\TEDIT.MAKEFILENAME 123054 . 123700 +)) (123751 131378 (TEDIT.PROMPTWINDOW 123761 . 124075) (TEDIT.PROMPTPRINT 124077 . 126704) ( +TEDIT.PROMPTCLEAR 126706 . 128425) (TEDIT.PROMPTFLASH 128427 . 129685) (\TEDIT.PROMPT.PAGEFULLFN +129687 . 131376)) (131616 142020 (\TEDIT.FILENAME 131626 . 132398) (\TEDIT.DEFAULT.TITLE 132400 . +134779) (\TEDIT.WINDOW.TITLE 134781 . 136950) (\TEDIT.LIKELY.FILENAME 136952 . 139502) ( +\TEDIT.UPDATE.TITLE 139504 . 142018)) (142063 154547 (TEDIT.DEACTIVATE.WINDOW 142073 . 147646) ( +\TEDIT.RESHAPEFN 147648 . 149733) (\TEDIT.REPAINTFN 149735 . 149959) (\TEDIT.CLOSESPLITS 149961 . +152406) (\TEDIT.CLOSEPANE 152408 . 154545)) (154548 197347 (\TEDIT.SCROLLFN 154558 . 156789) ( +\TEDIT.SCROLLCH.TOP 156791 . 158902) (\TEDIT.SCROLLCH.BOTTOM 158904 . 163234) (\TEDIT.SCROLLUP 163236 + . 168962) (\TEDIT.TOPLINE.YTOP 168964 . 170633) (\TEDIT.SCROLLDOWN 170635 . 177674) ( +\TEDIT.SCROLL.CARET 177676 . 180514) (\TEDIT.VISIBLECARETP 180516 . 182810) (\TEDIT.VISIBLECHARP +182812 . 183903) (\TEDIT.BITMAPLINES 183905 . 187825) (\TEDIT.SETPANE.TOPLINE 187827 . 188439) ( +\TEDIT.SHIFTLINES 188441 . 197345)) (197348 208217 (\TEDIT.ONSCREEN? 197358 . 201909) ( +\TEDIT.ONSCREEN.REGION 201911 . 205562) (\TEDIT.AFTERMOVEFN 205564 . 206461) (OFFSCREENP 206463 . +208215)) (208259 211073 (\TEDIT.PROCIDLEFN 208269 . 209929) (\TEDIT.PROCENTRYFN 209931 . 210376) ( +\TEDIT.PROCEXITFN 210378 . 211071)) (211152 224377 (\TEDIT.DOWNCARET 211162 . 211955) ( +\TEDIT.FLASHCARET 211957 . 214068) (\TEDIT.UPCARET 214070 . 215174) (TEDIT.NORMALIZECARET 215176 . +218394) (\TEDIT.SETCARET 218396 . 223747) (\TEDIT.CARET 223749 . 224375))))) STOP diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM index 672179b94c229df5b289fbfad2e56cff04f1dfa6..b0944370118e778fa05f3da60d09862a840d271e 100644 GIT binary patch delta 987 zcmZuv(QXn!6m<(xAwJX;6Z>GiS#1Ojo4qr$yDU#qc9w2~>}ER%O-PMW9-7p)sWj0i ze!*nEK>xs?kA8rOeeyf_0*!ID3k0z9G&ytUoO|xMUniNLlg!8NBP{P;9G8hnEI_PU zR+ZQ~6!re;+q0wN!6BTUfNW?_M_7Wqj+KRKvr4dv6&>E359Z~A_h;wtwyMw*+zW)! z30hv*G3qg|2@Xdmp!@A+6Bc<4!_eXI^-yVDCqP`ilrQ=ZgCBpjbi>X2-|yQPjw(syRYSCpq0jJYri$^kNlh2(rWT?mgT?YpXY9< z^P?!c*`byjUuKKiJRw@jcN07U>bUcI>QMRVV52~pyTVGT{Bm=1L=e)6bb#2Em5D2*m^Xs31;naABd%?i z#eT%S@(g7*)Wc{W2z4RFB6Y{PJRuBrc+l7pfuC9cf;RN(A&=|a4_hPQ@x3~rYbUnm z7I1E1s)RP1lOj{SEEZG6m~M*4{aU*z3=xPX2Q;0fLYG1>XzjIQKJCSEzRgOC^rI_Nfg6I-$-4n zY*fArVa;GQ>O~l+<$@Qso(Q07lvlj7MJ0&W2oY1R4+~(_8>8D^U)-nSVlXV1I&Mc()s`ywj7VEA8;^;%Tl>2QJMC5z_V+-Cv17No`tDinu=V<|@TzgpZtNAx`&*56VYk(6w~k1T6}ERe zM)FmVp*DTOaTatuC~r9=?@+GfI)^zUD|UmgC*YaUcjmQb`>!v*h3NsS`{sC`Aj4hS&%_*ND85A5>J?9F~G`Bd!OM zS*Xsa?~M_KWzR1y3%{5I0A%qvPCqK@N9~CsM*Dn3l&u2ax>^ijE`PkAykqAFMda5T zHQlm6_@e9qf5oPjuW_pHl2p39T{8)+=pekS-C0JZh#hUW;=fnuH<%i77 zx@E#3KUo6^vxde%s10sVnH4}(375WC?+Ke6ia|xVUUez*LlH!PO%!{ikWJ*r%!5^A gp&_}R3sNgw)j?UTFO&fyWC#psAiaIIdvo*RAJNhGr2qf` diff --git a/sources/INSPECT b/sources/INSPECT index 0f4439cc7..e72eba08c 100644 --- a/sources/INSPECT +++ b/sources/INSPECT @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Jul-2024 18:28:42" {WMEDLEY}INSPECT.;33 129220 +(FILECREATED "21-Jul-2025 11:55:38" {WMEDLEY}INSPECT.;35 129603 :EDIT-BY rmk - :CHANGES-TO (FNS IMAGEOBJ\PROPFETCHFN IMAGEOBJ\PROPSTOREFN) - (VARS INSPECTCOMS) + :CHANGES-TO (FNS \TEDIT.INSPECTCODE) - :PREVIOUS-DATE " 4-Jul-2024 12:16:52" {WMEDLEY}INSPECT.;31) + :PREVIOUS-DATE "16-Jul-2024 18:28:42" {WMEDLEY}INSPECT.;33) (PRETTYCOMPRINT INSPECTCOMS) @@ -1802,24 +1801,29 @@ (\INSPECT/CODE/RESHAPEFN WINDOW]) (\TEDIT.INSPECTCODE - [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* ; "Edited 11-Oct-2021 14:04 by rmk:") + [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* ; "Edited 21-Jul-2025 11:49 by rmk") + (* ; "Edited 11-Oct-2021 14:04 by rmk:") (PROG ((STREAM (OPENSTREAM '{NODIRCORE} 'BOTH)) WINDOW SEL) (APPLY* (OR CODEPRINTER (FUNCTION PRINTCODE)) FN LVFLG RADIX STREAM NIL PC) - [SETQ STREAM (OPENTEXTSTREAM STREAM [SETQ WINDOW (DECODE.WINDOW.ARG - WHERE 400 280 - (COND - ((OR (LITATOM FN) - (NOT (CCODEP FN))) - (CONCAT "Code for " FN)) - (T (CONCAT (COND - (PC "Code for frame ") - (T "CCODEP named ")) - (fetch (COMPILED-CLOSURE - FRAMENAME) - of FN] - NIL NIL `(READONLY T PROMPTWINDOW DON'T FONT ,DEFAULTFONT] + [SETQ STREAM (TEDIT STREAM [SETQ WINDOW (DECODE.WINDOW.ARG + WHERE 400 280 (COND + ((OR (LITATOM FN) + (NOT (CCODEP FN))) + (CONCAT "Code for " FN)) + (T (CONCAT (COND + (PC + "Code for frame " + ) + (T "CCODEP named ") + ) + (fetch ( + COMPILED-CLOSURE + FRAMENAME) + of FN] + NIL + `(READONLY T PROMPTWINDOW DON'T FONT ,DEFAULTFONT] (COND ((AND PC (SETQ SEL (TEDIT.FIND STREAM "----------" 1))) (* ; "Highlight location of PC") @@ -2311,43 +2315,43 @@ ("As Character array" '(8 \INSPECT.FETCH.CHAR \INSPECT.STORE.CHAR)) ("As Fat Character array" '(16 \INSPECT.FETCH.FATCHAR \INSPECT.STORE.FATCHAR]) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7776 46129 (INSPECTW.CREATE 7786 . 13081) (INSPECTW.REPAINTFN 13083 . 18619) ( -INSPECTW.REDISPLAY 18621 . 27493) (\INSPECTW.VALUE.MARGIN 27495 . 27898) (INSPECTW.REPLACE 27900 . -28608) (INSPECTW.SELECTITEM 28610 . 29600) (\INSPECTW.REDISPLAYPROP 29602 . 32032) (INSPECTW.FETCH -32034 . 32457) (INSPECTW.PROPERTIES 32459 . 33100) (DECODE.WINDOW.ARG 33102 . 34830) ( -DEFAULT.INSPECTW.PROPCOMMANDFN 34832 . 36860) (DEFAULT.INSPECTW.VALUECOMMANDFN 36862 . 38278) ( -DEFAULT.INSPECTW.TITLECOMMANDFN 38280 . 41729) (\SELITEM.FROM.PROPERTY 41731 . 42173) ( -\INSPECT.COMPUTE.TITLE 42175 . 43459) (LEVELEDFORM 43461 . 44180) (MAKEWITHINREGION 44182 . 46127)) ( -46130 63435 (ITEMW.REPAINTFN 46140 . 47360) (\ITEM.WINDOW.BUTTON.HANDLER 47362 . 47781) ( -\ITEM.WINDOW.SELECTION.HANDLER 47783 . 50450) (\INSPECTW.COMMAND.HANDLER 50452 . 54453) ( -ITEM.WINDOW.SET.STACK.ARG 54455 . 56659) (REPLACESTKARG 56661 . 57760) (IN/ITEM? 57762 . 58644) ( -\ITEMW.DESELECTITEM 58646 . 58910) (\ITEMW.SELECTITEM 58912 . 59174) (\ITEMW.CLEARSELECTION 59176 . -59531) (\ITEMW.FLIPITEM 59533 . 60006) (PRINTANDBOX 60008 . 62517) (PRINTATBOX 62519 . 63036) ( -ITEMOFPROPERTYVALUE 63038 . 63433)) (63436 67177 (\ITEM.WINDOW.COPY.HANDLER 63446 . 65303) ( -\ITEMW.FLIPCOPY 65305 . 65764) (BKSYSBUF.GENERAL 65766 . 67175)) (67569 92484 (INSPECT 67579 . 72109) -(\APPLYINSPECTMACRO 72111 . 73172) (INSPECT/BITMAP 73174 . 74326) (INSPECT/DATATYPE 74328 . 77842) ( -INSPECTABLEFIELDNAMES 77844 . 79177) (REMOVEDUPS 79179 . 79384) (INSPECT/ARRAY 79386 . 80451) ( -INSPECT/TOP/LEVEL/LIST 80453 . 81570) (INSPECT/PROPLIST 81572 . 82660) (NONSYSPROPNAMES 82662 . 82958) - (INSPECT/LISTP 82960 . 83399) (ALISTP 83401 . 83610) (PROPLISTP 83612 . 84252) (INSPECT/ALIST 84254 - . 84730) (ASSOCGET 84732 . 84943) (/ASSOCPUT 84945 . 85210) (INSPECT/PLIST 85212 . 85696) ( -INSPECT/TYPERECORD 85698 . 86055) (INSPECT/AS/RECORD 86057 . 87294) (SELECT.LIST.INSPECTOR 87296 . -89347) (STANDARDEDITE 89349 . 89632) (NTHTOPLEVELELT 89634 . 89950) (SETNTHTOPLEVELELT 89952 . 90712) -(DEDITE 90714 . 90921) (FINDRECDECL 90923 . 91506) (FINDSYSRECDECL 91508 . 91909) ( -MAKE-INSPECTOR-PROFILE 91911 . 92296) (CONFIRM-SET 92298 . 92482)) (94308 102522 (INSPECT/ATOM 94318 - . 98423) (SELECT.ATOM.ASPECT 98425 . 99569) (INSPECT/AS/FUNCTION 99571 . 101857) (SELECT.FNS.EDITOR -101859 . 102520)) (102563 107988 (INSPECTCODE 102573 . 103725) (\TEDIT.INSPECTCODE 103727 . 105705) ( -\INSPECT/CODE/RESHAPEFN 105707 . 107246) (\INSPECT/CODE/REPAINTFN 107248 . 107986)) (108026 109632 ( -INSPECT/HARRAYP 108036 . 108784) (HARRAYKEYS 108786 . 109165) (INSPECTW.GETHASH 109167 . 109394) ( -INSPECTW.PUTHASH 109396 . 109630)) (109681 115890 (RDTBL\NONOTHERCODES 109691 . 110711) (GETSYNTAXPROP - 110713 . 112211) (SETSYNTAXPROP 112213 . 113940) (GETTTBLPROP 113942 . 114860) (SETTTBLPROP 114862 . -115888)) (116395 117845 (WINDOW\INSPECTPROPS 116405 . 117260) (WINDOW\PROPFETCHFN 117262 . 117616) ( -WINDOW\PROPSTOREFN 117618 . 117843)) (117994 120023 (IMAGEOBJ\INSPECTPROPS 118004 . 119070) ( -IMAGEOBJ\PROPFETCHFN 119072 . 119602) (IMAGEOBJ\PROPSTOREFN 119604 . 120021)) (120160 128802 ( -INSPECT/AS/BLOCKRECORD 120170 . 121170) (INSPECT/TYPELESS 121172 . 122563) (LIST-ALL-BLOCKRECORDS -122565 . 122840) (INSPECT/HUNK 122842 . 125445) (\INSPECT.DATATYPE.RAW.FETCH 125447 . 125773) ( -\INSPECT.FETCH.8 125775 . 125924) (\INSPECT.FETCH.32 125926 . 126097) (\INSPECT.FETCH.CHAR 126099 . -126262) (\INSPECT.FETCH.FATCHAR 126264 . 126426) (\INSPECT.FETCH.PTR 126428 . 126599) ( -\INSPECT.STORE.8 126601 . 126907) (\INSPECT.STORE.16 126909 . 127209) (\INSPECT.STORE.32 127211 . -127646) (\INSPECT.STORE.CHAR 127648 . 127974) (\INSPECT.STORE.FATCHAR 127976 . 128298) ( -\INSPECT.STORE.PTR 128300 . 128647) (INSPECT/MAKE/CCODEP 128649 . 128800))))) + (FILEMAP (NIL (7716 46069 (INSPECTW.CREATE 7726 . 13021) (INSPECTW.REPAINTFN 13023 . 18559) ( +INSPECTW.REDISPLAY 18561 . 27433) (\INSPECTW.VALUE.MARGIN 27435 . 27838) (INSPECTW.REPLACE 27840 . +28548) (INSPECTW.SELECTITEM 28550 . 29540) (\INSPECTW.REDISPLAYPROP 29542 . 31972) (INSPECTW.FETCH +31974 . 32397) (INSPECTW.PROPERTIES 32399 . 33040) (DECODE.WINDOW.ARG 33042 . 34770) ( +DEFAULT.INSPECTW.PROPCOMMANDFN 34772 . 36800) (DEFAULT.INSPECTW.VALUECOMMANDFN 36802 . 38218) ( +DEFAULT.INSPECTW.TITLECOMMANDFN 38220 . 41669) (\SELITEM.FROM.PROPERTY 41671 . 42113) ( +\INSPECT.COMPUTE.TITLE 42115 . 43399) (LEVELEDFORM 43401 . 44120) (MAKEWITHINREGION 44122 . 46067)) ( +46070 63375 (ITEMW.REPAINTFN 46080 . 47300) (\ITEM.WINDOW.BUTTON.HANDLER 47302 . 47721) ( +\ITEM.WINDOW.SELECTION.HANDLER 47723 . 50390) (\INSPECTW.COMMAND.HANDLER 50392 . 54393) ( +ITEM.WINDOW.SET.STACK.ARG 54395 . 56599) (REPLACESTKARG 56601 . 57700) (IN/ITEM? 57702 . 58584) ( +\ITEMW.DESELECTITEM 58586 . 58850) (\ITEMW.SELECTITEM 58852 . 59114) (\ITEMW.CLEARSELECTION 59116 . +59471) (\ITEMW.FLIPITEM 59473 . 59946) (PRINTANDBOX 59948 . 62457) (PRINTATBOX 62459 . 62976) ( +ITEMOFPROPERTYVALUE 62978 . 63373)) (63376 67117 (\ITEM.WINDOW.COPY.HANDLER 63386 . 65243) ( +\ITEMW.FLIPCOPY 65245 . 65704) (BKSYSBUF.GENERAL 65706 . 67115)) (67509 92424 (INSPECT 67519 . 72049) +(\APPLYINSPECTMACRO 72051 . 73112) (INSPECT/BITMAP 73114 . 74266) (INSPECT/DATATYPE 74268 . 77782) ( +INSPECTABLEFIELDNAMES 77784 . 79117) (REMOVEDUPS 79119 . 79324) (INSPECT/ARRAY 79326 . 80391) ( +INSPECT/TOP/LEVEL/LIST 80393 . 81510) (INSPECT/PROPLIST 81512 . 82600) (NONSYSPROPNAMES 82602 . 82898) + (INSPECT/LISTP 82900 . 83339) (ALISTP 83341 . 83550) (PROPLISTP 83552 . 84192) (INSPECT/ALIST 84194 + . 84670) (ASSOCGET 84672 . 84883) (/ASSOCPUT 84885 . 85150) (INSPECT/PLIST 85152 . 85636) ( +INSPECT/TYPERECORD 85638 . 85995) (INSPECT/AS/RECORD 85997 . 87234) (SELECT.LIST.INSPECTOR 87236 . +89287) (STANDARDEDITE 89289 . 89572) (NTHTOPLEVELELT 89574 . 89890) (SETNTHTOPLEVELELT 89892 . 90652) +(DEDITE 90654 . 90861) (FINDRECDECL 90863 . 91446) (FINDSYSRECDECL 91448 . 91849) ( +MAKE-INSPECTOR-PROFILE 91851 . 92236) (CONFIRM-SET 92238 . 92422)) (94248 102462 (INSPECT/ATOM 94258 + . 98363) (SELECT.ATOM.ASPECT 98365 . 99509) (INSPECT/AS/FUNCTION 99511 . 101797) (SELECT.FNS.EDITOR +101799 . 102460)) (102503 108371 (INSPECTCODE 102513 . 103665) (\TEDIT.INSPECTCODE 103667 . 106088) ( +\INSPECT/CODE/RESHAPEFN 106090 . 107629) (\INSPECT/CODE/REPAINTFN 107631 . 108369)) (108409 110015 ( +INSPECT/HARRAYP 108419 . 109167) (HARRAYKEYS 109169 . 109548) (INSPECTW.GETHASH 109550 . 109777) ( +INSPECTW.PUTHASH 109779 . 110013)) (110064 116273 (RDTBL\NONOTHERCODES 110074 . 111094) (GETSYNTAXPROP + 111096 . 112594) (SETSYNTAXPROP 112596 . 114323) (GETTTBLPROP 114325 . 115243) (SETTTBLPROP 115245 . +116271)) (116778 118228 (WINDOW\INSPECTPROPS 116788 . 117643) (WINDOW\PROPFETCHFN 117645 . 117999) ( +WINDOW\PROPSTOREFN 118001 . 118226)) (118377 120406 (IMAGEOBJ\INSPECTPROPS 118387 . 119453) ( +IMAGEOBJ\PROPFETCHFN 119455 . 119985) (IMAGEOBJ\PROPSTOREFN 119987 . 120404)) (120543 129185 ( +INSPECT/AS/BLOCKRECORD 120553 . 121553) (INSPECT/TYPELESS 121555 . 122946) (LIST-ALL-BLOCKRECORDS +122948 . 123223) (INSPECT/HUNK 123225 . 125828) (\INSPECT.DATATYPE.RAW.FETCH 125830 . 126156) ( +\INSPECT.FETCH.8 126158 . 126307) (\INSPECT.FETCH.32 126309 . 126480) (\INSPECT.FETCH.CHAR 126482 . +126645) (\INSPECT.FETCH.FATCHAR 126647 . 126809) (\INSPECT.FETCH.PTR 126811 . 126982) ( +\INSPECT.STORE.8 126984 . 127290) (\INSPECT.STORE.16 127292 . 127592) (\INSPECT.STORE.32 127594 . +128029) (\INSPECT.STORE.CHAR 128031 . 128357) (\INSPECT.STORE.FATCHAR 128359 . 128681) ( +\INSPECT.STORE.PTR 128683 . 129030) (INSPECT/MAKE/CCODEP 129032 . 129183))))) STOP diff --git a/sources/INSPECT.LCOM b/sources/INSPECT.LCOM index 38e847e6986ce7fdaba40cf87ea15cf4d10fb260..bdcbc4dd2c97a554bafedfe35fa86f98ca1764a6 100644 GIT binary patch delta 473 zcmZvXKTpCy7{*gs3~|&rNnV>6%h0BGrGI0h*j}}yTpM}_CN3%r1WtIG=s(%`8JvM$Xz$ z_b~F1Bg5Ued;d5b^#qCwJ18%YYtwILv3 zL`fhD$Kr?6eZ_WR89yT|BOq{!p02O}={EnH63JSe&Xlu%#~pou delta 442 zcmZvXKTE?v7>9{Pl!BYprNT=1@p-knMXaIxnT z?23nF@%O$$W Date: Mon, 21 Jul 2025 17:00:09 -0700 Subject: [PATCH 2/7] Add promptwindo so M-f search strings are locally visible --- sources/INSPECT | 38 +++++++++++++++++++------------------- sources/INSPECT.LCOM | Bin 53274 -> 53235 bytes 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/sources/INSPECT b/sources/INSPECT index e72eba08c..e0940d4fe 100644 --- a/sources/INSPECT +++ b/sources/INSPECT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Jul-2025 11:55:38" {WMEDLEY}INSPECT.;35 129603 +(FILECREATED "21-Jul-2025 16:55:18" {WMEDLEY}INSPECT.;36 129584 :EDIT-BY rmk :CHANGES-TO (FNS \TEDIT.INSPECTCODE) - :PREVIOUS-DATE "16-Jul-2024 18:28:42" {WMEDLEY}INSPECT.;33) + :PREVIOUS-DATE "21-Jul-2025 11:55:38" {WMEDLEY}INSPECT.;35) (PRETTYCOMPRINT INSPECTCOMS) @@ -1801,7 +1801,7 @@ (\INSPECT/CODE/RESHAPEFN WINDOW]) (\TEDIT.INSPECTCODE - [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* ; "Edited 21-Jul-2025 11:49 by rmk") + [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* ; "Edited 21-Jul-2025 16:54 by rmk") (* ; "Edited 11-Oct-2021 14:04 by rmk:") (PROG ((STREAM (OPENSTREAM '{NODIRCORE} 'BOTH)) WINDOW SEL) @@ -1823,7 +1823,7 @@ FRAMENAME) of FN] NIL - `(READONLY T PROMPTWINDOW DON'T FONT ,DEFAULTFONT] + `(READONLY T FONT ,DEFAULTFONT] (COND ((AND PC (SETQ SEL (TEDIT.FIND STREAM "----------" 1))) (* ; "Highlight location of PC") @@ -2339,19 +2339,19 @@ INSPECT/TYPERECORD 85638 . 85995) (INSPECT/AS/RECORD 85997 . 87234) (SELECT.LIST (DEDITE 90654 . 90861) (FINDRECDECL 90863 . 91446) (FINDSYSRECDECL 91448 . 91849) ( MAKE-INSPECTOR-PROFILE 91851 . 92236) (CONFIRM-SET 92238 . 92422)) (94248 102462 (INSPECT/ATOM 94258 . 98363) (SELECT.ATOM.ASPECT 98365 . 99509) (INSPECT/AS/FUNCTION 99511 . 101797) (SELECT.FNS.EDITOR -101799 . 102460)) (102503 108371 (INSPECTCODE 102513 . 103665) (\TEDIT.INSPECTCODE 103667 . 106088) ( -\INSPECT/CODE/RESHAPEFN 106090 . 107629) (\INSPECT/CODE/REPAINTFN 107631 . 108369)) (108409 110015 ( -INSPECT/HARRAYP 108419 . 109167) (HARRAYKEYS 109169 . 109548) (INSPECTW.GETHASH 109550 . 109777) ( -INSPECTW.PUTHASH 109779 . 110013)) (110064 116273 (RDTBL\NONOTHERCODES 110074 . 111094) (GETSYNTAXPROP - 111096 . 112594) (SETSYNTAXPROP 112596 . 114323) (GETTTBLPROP 114325 . 115243) (SETTTBLPROP 115245 . -116271)) (116778 118228 (WINDOW\INSPECTPROPS 116788 . 117643) (WINDOW\PROPFETCHFN 117645 . 117999) ( -WINDOW\PROPSTOREFN 118001 . 118226)) (118377 120406 (IMAGEOBJ\INSPECTPROPS 118387 . 119453) ( -IMAGEOBJ\PROPFETCHFN 119455 . 119985) (IMAGEOBJ\PROPSTOREFN 119987 . 120404)) (120543 129185 ( -INSPECT/AS/BLOCKRECORD 120553 . 121553) (INSPECT/TYPELESS 121555 . 122946) (LIST-ALL-BLOCKRECORDS -122948 . 123223) (INSPECT/HUNK 123225 . 125828) (\INSPECT.DATATYPE.RAW.FETCH 125830 . 126156) ( -\INSPECT.FETCH.8 126158 . 126307) (\INSPECT.FETCH.32 126309 . 126480) (\INSPECT.FETCH.CHAR 126482 . -126645) (\INSPECT.FETCH.FATCHAR 126647 . 126809) (\INSPECT.FETCH.PTR 126811 . 126982) ( -\INSPECT.STORE.8 126984 . 127290) (\INSPECT.STORE.16 127292 . 127592) (\INSPECT.STORE.32 127594 . -128029) (\INSPECT.STORE.CHAR 128031 . 128357) (\INSPECT.STORE.FATCHAR 128359 . 128681) ( -\INSPECT.STORE.PTR 128683 . 129030) (INSPECT/MAKE/CCODEP 129032 . 129183))))) +101799 . 102460)) (102503 108352 (INSPECTCODE 102513 . 103665) (\TEDIT.INSPECTCODE 103667 . 106069) ( +\INSPECT/CODE/RESHAPEFN 106071 . 107610) (\INSPECT/CODE/REPAINTFN 107612 . 108350)) (108390 109996 ( +INSPECT/HARRAYP 108400 . 109148) (HARRAYKEYS 109150 . 109529) (INSPECTW.GETHASH 109531 . 109758) ( +INSPECTW.PUTHASH 109760 . 109994)) (110045 116254 (RDTBL\NONOTHERCODES 110055 . 111075) (GETSYNTAXPROP + 111077 . 112575) (SETSYNTAXPROP 112577 . 114304) (GETTTBLPROP 114306 . 115224) (SETTTBLPROP 115226 . +116252)) (116759 118209 (WINDOW\INSPECTPROPS 116769 . 117624) (WINDOW\PROPFETCHFN 117626 . 117980) ( +WINDOW\PROPSTOREFN 117982 . 118207)) (118358 120387 (IMAGEOBJ\INSPECTPROPS 118368 . 119434) ( +IMAGEOBJ\PROPFETCHFN 119436 . 119966) (IMAGEOBJ\PROPSTOREFN 119968 . 120385)) (120524 129166 ( +INSPECT/AS/BLOCKRECORD 120534 . 121534) (INSPECT/TYPELESS 121536 . 122927) (LIST-ALL-BLOCKRECORDS +122929 . 123204) (INSPECT/HUNK 123206 . 125809) (\INSPECT.DATATYPE.RAW.FETCH 125811 . 126137) ( +\INSPECT.FETCH.8 126139 . 126288) (\INSPECT.FETCH.32 126290 . 126461) (\INSPECT.FETCH.CHAR 126463 . +126626) (\INSPECT.FETCH.FATCHAR 126628 . 126790) (\INSPECT.FETCH.PTR 126792 . 126963) ( +\INSPECT.STORE.8 126965 . 127271) (\INSPECT.STORE.16 127273 . 127573) (\INSPECT.STORE.32 127575 . +128010) (\INSPECT.STORE.CHAR 128012 . 128338) (\INSPECT.STORE.FATCHAR 128340 . 128662) ( +\INSPECT.STORE.PTR 128664 . 129011) (INSPECT/MAKE/CCODEP 129013 . 129164))))) STOP diff --git a/sources/INSPECT.LCOM b/sources/INSPECT.LCOM index bdcbc4dd2c97a554bafedfe35fa86f98ca1764a6..7efbed7ecf70f2f8070bcbc48e3008d7d02ae0e4 100644 GIT binary patch delta 288 zcmbQWfcf)$<_Rh6W>%)AR>sB?v-Kp+G!?j%j0|HyP<7 zi|gs>DJi5RmZYX&)nH^WS&&f10#ii(2#IXKNtV-fFS<>1w#u{1s7L0Pd`@|AjjNf^4&ghB{Oq{ z5LXw^5WQg6kYHCI1w#`9r~pu*3(yvm$zuJEW`>p^brB(+&i;N1hL%POAch-|X#r9W i6E`zb@NsnuQ7|+#R&ew83z@v4--F56Wb>zf4F>=qDNW4) delta 337 zcmex7pLx~-<_Rg2*D`WW%+--J)l}e8GPKb3D$UU~GB7e#Ff_0-GPE+Zn7GME7g=0S zPftl9C9xzm1*--l%gKU_azInn*cA+oEX@pzC&w_lh!~o|Og2$4w6HR=ure{4SS`nB zy!kRCM-Stz$#;6o_|h4G08E5tNJ&i&>5EY`G*Ji$4GH)3bMX%k2=Wh5FtjvRaB+3> z^mBCqaxBayU+fcCGPhI+adq(w(F=AB33l~SFf=uS3IG+lC>R=>P3G!%3^XzTsf!5l zboTdCFfuSv05RPBfM$Y}L&XivO%!}w-9mt_H&$@-_X9EvEfie*{nSA$V+Eiqd;_2^ Rn%vm$!DM2#`E Date: Wed, 23 Jul 2025 19:17:13 -0700 Subject: [PATCH 3/7] Update lispusers/INSPECTCODE-TEDIT for changes to Tedit. This could be considered to be incorporated directly into sources/INSPECT. (This was changed from TCOMPL (LCOM) to COMPILE-FILE (DFASL) because it just wouldn't compile correctly otherwise, for me.) --- lispusers/INSPECTCODE-TEDIT | 361 ++++++++++++++---------------- lispusers/INSPECTCODE-TEDIT.DFASL | Bin 0 -> 9489 bytes lispusers/INSPECTCODE-TEDIT.LCOM | Bin 9612 -> 0 bytes lispusers/INSPECTCODE-TEDIT.TEDIT | Bin 6338 -> 6405 bytes 4 files changed, 166 insertions(+), 195 deletions(-) create mode 100644 lispusers/INSPECTCODE-TEDIT.DFASL delete mode 100644 lispusers/INSPECTCODE-TEDIT.LCOM diff --git a/lispusers/INSPECTCODE-TEDIT b/lispusers/INSPECTCODE-TEDIT index 5e35475ec..1586fc31a 100644 --- a/lispusers/INSPECTCODE-TEDIT +++ b/lispusers/INSPECTCODE-TEDIT @@ -1,59 +1,36 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE (DEFPACKAGE "INSPECTCODE-TEDIT" (USE "INTERLISP") ( -NICKNAMES "ICT") (PREFIX-NAME "ICT"))) -(FILECREATED " 4-May-87 11:52:50" {DSK}MATT>INSPECTCODE-TEDIT.;10 16087 +(DEFINE-FILE-INFO PACKAGE (PROGN (CLINTERN "INSPECTCODE-TEDITCOMS" "INTERLISP") (* ;; +"Above is to ensure the COMS is in the INTERLISP package!") (DEFPACKAGE "INSPECTCODE-TEDIT" (USE +"INTERLISP") (NICKNAMES "ICT") (PREFIX-NAME "ICT"))) READTABLE "INTERLISP" BASE 10) - changes to%: (ADVICE IL:OPENTEXTSTREAM-IN-\TEDIT.INSPECTCODE) - (FILEVARS IL:INSPECTCODE-TEDITCOMS) - (FNS TITLEMENU-FN OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE) +(FILECREATED "23-Jul-2025 18:40:40" {DSK}matt>Interlisp>medley>lispusers>INSPECTCODE-TEDIT.;13 18439 - previous date%: " 7-Apr-87 16:03:12" IL:{DSK}MATT>INSPECTCODE-TEDIT.;9) + :EDIT-BY "mth" + :PREVIOUS-DATE "23-Jul-2025 18:25:48" +{DSK}matt>Interlisp>medley>lispusers>INSPECTCODE-TEDIT.;12) -(* " -Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc.. All rights reserved. -") -(PRETTYCOMPRINT IL:INSPECTCODE-TEDITCOMS) +(PRETTYCOMPRINT INSPECTCODE-TEDITCOMS) -(RPAQQ IL:INSPECTCODE-TEDITCOMS ((FNS BUILD.TITLEMENU ICON-FN INSP.ERROR KILL.TEDIT.PROCESS NOSELFN - OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE TITLEMENU-FN) - (UGLYVARS ICON.TEMPLATE) - (P (CHANGENAME '\TEDIT.INSPECTCODE 'TEXTICON 'ICON-FN) - (CHANGENAME '\TEDIT.INSPECTCODE 'OPENTEXTSTREAM ' - OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE)) - (COMMANDS IC) - (PROP (FILETYPE MAKEFILE-ENVIRONMENT) - INSPECTCODE-TEDIT))) -(DEFINEQ +(RPAQQ INSPECTCODE-TEDITCOMS + ((FILES (FROM LISPUSERS) + GRAPHCALLS) + (FNS ICON-FN INSP.ERROR KILL.TEDIT.PROCESS OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE TITLEMENU-FN + ) + (FUNCTIONS BUILD-TITLEMENU) + (GLOBALVARS TITLEMENU-ITEMS) + (VARS ICON.TEMPLATE TITLEMENU-ITEMS-TEMPLATE (TITLEMENU-ITEMS (BUILD-TITLEMENU + TITLEMENU-ITEMS-TEMPLATE + ))) + (P (CHANGENAME '\TEDIT.INSPECTCODE 'TEXTICON 'ICON-FN)) + (ADVISE (DECODE.WINDOW.ARG :IN \TEDIT.INSPECTCODE)) + (COMMANDS IC) + (PROP (FILETYPE MAKEFILE-ENVIRONMENT) + INSPECTCODE-TEDIT))) -(BUILD.TITLEMENU - [LAMBDA NIL (* ; "Edited 30-Mar-87 16:32 by Matt Heffron") - (DECLARE (GLOBALVARS TITLEMENU)) - (SETQ TITLEMENU (create MENU - ITEMS _ '((GraphCalls 'GC "Invoke GRAPHCALLS on the current selection") - (InspectCode 'IC "INSPECTCODE the current selection") - (Inspect 'INSP "INSPECT the current selection" - (SUBITEMS (Freely 'INSP - "INSPECT the free-reference value of the selection" - ) - (Globally 'INSP.GLOB - "INSPECT the Global (Top Level) value of the selection" - ) - ("In Process Context" 'INSP.PROC - "INSPECT the value of the selection in a process' context" - ))) - ("Pretty Print Value" 'PPV - "Pretty Print the value of the current selection" - (SUBITEMS (Freely 'PPV - "Pretty Print the free-reference value of the selection" - ) - (Globally 'PPV.GLOB - "Pretty Print the Global (Top Level) value of the selection" - ) - ("In Process Context" 'PPV.PROC - "Pretty Print the value of the selection in a process' context" - ))) - (Quit 'QUIT "Terminates this INSPECTCODE"]) +(FILESLOAD (FROM LISPUSERS) + GRAPHCALLS) +(DEFINEQ (ICON-FN [LAMBDA (W) (* ; "Edited 30-Mar-87 15:59 by Matt Heffron") @@ -67,59 +44,44 @@ Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc.. All rights reserve ICON]) (INSP.ERROR - [LAMBDA (MESS1 MESS2 MESS3) (* ; "Edited 30-Mar-87 16:00 by Matt Heffron") - (CLRPROMPT) - (if (NOT MESS2) - then (PROMPTPRINT MESS1) - elseif (NOT MESS3) - then (PROMPTPRINT MESS1 MESS2) - else (PROMPTPRINT MESS1 MESS2 MESS3)) - (RINGBELLS]) + [LAMBDA (TSTREAM MESS1 MESS2 MESS3) (* ; "Edited 23-Jul-2025 16:51 by mth") + (* ; "Edited 30-Mar-87 16:00 by Matt Heffron") + (TEDIT.PROMPTPRINT TSTREAM (CONCAT MESS1 (OR MESS2 "") + (OR MESS3 "")) + T]) (KILL.TEDIT.PROCESS [LAMBDA (W) (* ; "Edited 30-Mar-87 16:00 by Matt Heffron") (DEL.PROCESS (WINDOWPROP W 'PROCESS]) -(NOSELFN - [LAMBDA NIL (* ; "Edited 30-Mar-87 16:01 by Matt Heffron") - (CLRPROMPT) - (PROMPTPRINT "No current selection") - (RINGBELLS]) - (OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE [LAMBDA (TEXT WINDOW START END PROPS) (* ; "Edited 4-May-87 11:47 by ") (PROG1 [OPENTEXTSTREAM TEXT WINDOW START END (APPEND PROPS '(QUITFN T TITLEMENUFN TITLEMENU-FN NOTITLE T] - (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION KILL.TEDIT.PROCESS)) - (WINDOWPROP WINDOW 'FNNAME FN) - (WINDOWPROP WINDOW '*PACKAGE* *PACKAGE*) - (WINDOWPROP WINDOW '*READTABLE* *READTABLE*]) + (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION KILL.TEDIT.PROCESS)) + (WINDOWPROP WINDOW 'FNNAME FN) + (WINDOWPROP WINDOW '*PACKAGE* *PACKAGE*) + (WINDOWPROP WINDOW '*READTABLE* *READTABLE*))]) (TITLEMENU-FN - [LAMBDA (W) (* ; "Edited 4-May-87 11:32 by ") - (* ; "Edited 4-May-87 11:25 by ") - (* ; "Edited 4-May-87 11:19 by ") - (DECLARE (GLOBALVARS TITLEMENU)) - (if (OR (NOT (BOUNDP 'TITLEMENU)) - (NOT (type? MENU TITLEMENU))) - then (BUILD.TITLEMENU)) + [LAMBDA (STREAM MI) (* ; "Edited 23-Jul-2025 16:56 by mth") + (* ; "Edited 4-May-87 11:32 by ") [LET* - ((STREAM (TEXTSTREAM W)) + ((W (\TEDIT.PRIMARYPANE STREAM)) (W*PACKAGE* (WINDOWPROP W '*PACKAGE*)) (W*READTABLE* (WINDOWPROP W '*READTABLE*)) (SELLEN (fetch (SELECTION DCH) of (TEDIT.GETSEL STREAM))) - (MENUCHOICE (MENU TITLEMENU)) (SpecifyRegionString "Specify a region for the value pretty print window") INSPVAL SELSTR DISPLAYWINDOW) - (if (NOT MENUCHOICE) + (if (NOT MI) then (* ;  "Nothing to do, clicked out of menu") - elseif (EQ MENUCHOICE 'QUIT) + elseif (EQ MI 'QUIT) then (TEDIT.QUIT STREAM) (if (OPENWP W) then (CLOSEW W)) else [if (EQ SELLEN 0) - then (NOSELFN) + then (TEDIT.PROMPTPRINT STREAM SpecifyRegionString T) elseif (GREATERP SELLEN 255) then (INSP.ERROR "Selection is too long (> 255 characters)") (TEDIT.SHOWSEL STREAM NIL NIL) @@ -129,25 +91,24 @@ Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc.. All rights reserve (STRM (OPENSTRINGSTREAM (TEDIT.SEL.AS.STRING STREAM NIL) 'INPUT] (READ STRM] - (SELECTQ MENUCHOICE + (SELECTQ MI (IC (LET ((*PACKAGE* W*PACKAGE*) (*READTABLE* W*READTABLE*)) (INSPECTCODE SELSTR))) - (GC (if (FGETD 'GRAPHCALLSW) + (GC (if (FGETD 'IL:GRAPHCALLSW) then (if (NOT (LET ((*PACKAGE* W*PACKAGE*) (*READTABLE* W*READTABLE*)) - (GRAPHCALLS SELSTR))) + (IL:GRAPHCALLS SELSTR))) then (INSP.ERROR "Nothing to graph!!")) else (INSP.ERROR "The GRAPHCALLS package is not loaded. Cannot graph " SELSTR) )) ((INSP PPV) (if (BOUNDP SELSTR) then (if (EQ MENUCHOICE 'PPV) - then (PROMPTPRINT SpecifyRegionString) + then (TEDIT.PROMPTPRINT STREAM SpecifyRegionString T) (SETQ DISPLAYWINDOW (CREATEW (GETREGION (WIDTHIFWINDOW 72) (HEIGHTIFWINDOW 72 T)) SELSTR)) - (CLRPROMPT) (printout DISPLAYWINDOW .PPV (EVAL SELSTR)) else (INSPECT (EVALV SELSTR))) else (INSP.ERROR SELSTR " has no value to " (if (EQ MENUCHOICE 'PPV) @@ -157,11 +118,10 @@ Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc.. All rights reserve (if (NEQ (SETQ INSPVAL (GETTOPVAL SELSTR)) 'NOBIND) then (if (EQ MENUCHOICE 'PPV.GLOB) - then (PROMPTPRINT SpecifyRegionString) + then (TEDIT.PROMPTPRINT STREAM SpecifyRegionString T) (SETQ DISPLAYWINDOW (CREATEW (GETREGION (WIDTHIFWINDOW 72) (HEIGHTIFWINDOW 72 T)) SELSTR)) - (CLRPROMPT) (printout DISPLAYWINDOW .PPV INSPVAL) else (INSPECT INSPVAL)) else (INSP.ERROR SELSTR " has no Global value to " @@ -181,12 +141,11 @@ Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc.. All rights reserve then [if (NEQ (SETQ INSPVAL (PROCESS.EVALV PROC SELSTR)) 'NOBIND) then (if (EQ MENUCHOICE 'PPV.PROC) - then (PROMPTPRINT SpecifyRegionString) + then (TEDIT.PROMPTPRINT STREAM SpecifyRegionString T) (SETQ DISPLAYWINDOW (CREATEW (GETREGION (WIDTHIFWINDOW 72) (HEIGHTIFWINDOW 72 T)) SELSTR)) - (CLRPROMPT) (printout DISPLAYWINDOW .PPV INSPVAL) else (INSPECT INSPVAL)) else (INSP.ERROR SELSTR (if (EQ MENUCHOICE 'PPV.PROC) @@ -205,117 +164,129 @@ Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc.. All rights reserve ] NIL]) ) -(READVAR-FROM-STRING 'ICON.TEMPLATE "({(READBITMAP)(87 91 -%"OOOOOOOOOOOOOOOOOOOOON@@%" -%"OOOOOOOOOOOOOOOOOOOOON@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@COO@@@@@F@@%" -%"L@@@@@@@@@@@AOOON@@@@F@@%" -%"L@@@@@@@@@@@GN@AOH@@@F@@%" -%"L@@@@@@@@@@AO@@@CN@@@F@@%" -%"L@@@@@@@@@@CL@@@@O@@@F@@%" -%"L@@@@@@@@@@O@@@@@CL@@F@@%" -%"L@@@@@@@@@AN@@@@@AN@@F@@%" -%"L@@@@@@@@@CH@@@@@@G@@F@@%" -%"L@@@@@@@@@C@@@@@@@C@@F@@%" -%"L@@@@@@@@@G@@@@@@@CH@F@@%" -%"L@@@@@@@@@N@@@@@@@AL@F@@%" -%"L@@@@@@@@@L@@@@@@@@L@F@@%" -%"L@@@@@@@@AL@@@@@@@@N@F@@%" -%"L@@@@@@@@AH@@@@@@@@F@F@@%" -%"L@@@@@@@@CH@@@@@@@@G@F@@%" -%"L@@@@@@@@C@@@@@@@@@C@F@@%" -%"L@@@@@@@@C@@@@@@@@@C@F@@%" -%"L@@@@@@@@GGL@OHGO@OOHF@@%" -%"L@@@@@@@@GLFCHNFALLAHF@@%" -%"L@@@@@@@@GHCC@FF@LLAHF@@%" -%"L@@@@@@@@G@@F@CF@FLAHF@@%" -%"LBIGKMLNOO@@F@CF@FOOHF@@%" -%"LBMDBEA@BG@@F@CF@FLAHF@@%" -%"LBOGKMM@BG@@F@CF@FLAHF@@%" -%"LBK@JAA@BGHCC@FF@LLAHF@@%" -%"LBIGJALNBGLFCHNFALLAHF@@%" -%"L@@@@@@@@GGL@OHGO@OOHF@@%" -%"L@@@@@@@@C@@@@@@@@@C@F@@%" -%"L@@@@@@@@C@@@@@@@@@C@F@@%" -%"L@@@@@@@@CH@@@@@@@@G@F@@%" -%"L@@@@@@@@AH@@@@@@@@F@F@@%" -%"L@@@@@@@@AL@@@@@@@@N@F@@%" -%"L@@@@@@@@@L@@@@@@@@L@F@@%" -%"L@@@@@@@@@N@@@@@@@AL@F@@%" -%"L@@@@@@@@@G@@@@@@@CH@F@@%" -%"L@@@@@@@@@G@@@@@@@C@@F@@%" -%"L@@@@@@@@@OL@@@@@@G@@F@@%" -%"L@@@@@@@@@ON@@@@@AN@@F@@%" -%"L@@@@@@@@AGO@@@@@CL@@F@@%" -%"L@@@@@@@@CKCL@@@@O@@@F@@%" -%"L@@@@@@@@GLAO@@@CN@@@F@@%" -%"L@@@@@@@@OH@GN@AOH@@@F@@%" -%"L@@@@@@@AO@@AOOON@@@@F@@%" -%"L@@@@@@@FN@@@COO@@@@@F@@%" -%"L@@@@@@@OD@@@@@@@@@@@F@@%" -%"L@@@@@@AOH@@@@@@@@@@@F@@%" -%"L@@@@@@COH@@@@@@@@@@@F@@%" -%"L@@@@@@GO@@@@@@@@@@@@F@@%" -%"L@@@@@@ON@@@@@@@@@@@@F@@%" -%"L@@@@@AOL@@@@@@@@@@@@F@@%" -%"L@@@@@COH@@@@@@@@@@@@F@@%" -%"L@@@@@GO@@@@@@@@@@@@@F@@%" -%"L@@@@@ON@@@@@@@@@@@@@F@@%" -%"L@@@@AOL@@@@@@@@@@@@@F@@%" -%"L@@@@COH@@@@@@@@@@@@@F@@%" -%"L@@@@GO@@@@@@@@@@@@@@F@@%" -%"L@@@@ON@@@@@@@@@@@@@@F@@%" -%"L@@@AOL@@@@@@@@@@@@@@F@@%" -%"L@@@COH@@@@@@@@@@@@@@F@@%" -%"L@@@GO@@@@@@@@@@@@@@@F@@%" -%"L@@@GN@@@@@@@@@@@@@@@F@@%" -%"L@@@CL@@@@@@@@@@@@@@@F@@%" -%"L@@@AH@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"L@@@@@@@@@@@@@@@@@@@@F@@%" -%"OOOOOOOOOOOOOOOOOOOOON@@%" -%"OOOOOOOOOOOOOOOOOOOOON@@%")} NIL (4 5 79 18)) -") + +(CL:DEFUN BUILD-TITLEMENU (ITEMS-TEMPLATE &AUX IL-PKG ICT-PKG) + (* ; "Edited 23-Jul-2025 17:20 by mth") + (SETQ IL-PKG (CL:FIND-PACKAGE "IL")) + (SETQ ICT-PKG (CL:FIND-PACKAGE "ICT")) + [CL:FLET [(TITLEMENU-FN-CALLER (MI) + #'(CL:LAMBDA (STREAM) + (TITLEMENU-FN STREAM MI] + (CL:LOOP :FOR ITEM :IN ITEMS-TEMPLATE :COLLECT + (LET (ITEM1) + (COND + ((LITATOM ITEM) + ITEM) + ((NOT (LISTP ITEM)) + + (* ;; "Report ill-formed ITEMS-TEMPLATE") + + NIL) + ((AND (LITATOM (SETQ ITEM1 (CL:FIRST ITEM))) + (EQ (CL:SYMBOL-PACKAGE ITEM1) + IL-PKG)) + ITEM) + ((OR (STRINGP ITEM1) + (AND (LITATOM ITEM1) + (EQ (CL:SYMBOL-PACKAGE ITEM1) + ICT-PKG))) + (LET ((LEN (LENGTH ITEM)) + NEWITEM PIECE) + (SETQ NEWITEM (LIST ITEM1 (TITLEMENU-FN-CALLER (CL:SECOND ITEM)) + (CL:THIRD ITEM))) + (CL:WHEN (AND (SETQ PIECE (CL:FOURTH ITEM)) + (EQ (CL:FIRST PIECE) + 'SUBITEMS)) + [NCONC1 NEWITEM (CONS 'SUBITEMS (CL:LOOP + :FOR SI :IN (CL:REST PIECE) + :COLLECT + (LIST (CL:FIRST SI) + (TITLEMENU-FN-CALLER + (CL:SECOND SI)) + (CL:THIRD SI]) + NEWITEM]) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS TITLEMENU-ITEMS) +) + +(RPAQQ ICON.TEMPLATE (#*(87 91)OOOOOOOOOOOOOOOOOOOOON@@OOOOOOOOOOOOOOOOOOOOON@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@COO@@@@@F@@L@@@@@@@@@@@AOOON@@@@F@@L@@@@@@@@@@@GN@AOH@@@F@@L@@@@@@@@@@AO@@@CN@@@F@@L@@@@@@@@@@CL@@@@O@@@F@@L@@@@@@@@@@O@@@@@CL@@F@@L@@@@@@@@@AN@@@@@AN@@F@@L@@@@@@@@@CH@@@@@@G@@F@@L@@@@@@@@@C@@@@@@@C@@F@@L@@@@@@@@@G@@@@@@@CH@F@@L@@@@@@@@@N@@@@@@@AL@F@@L@@@@@@@@@L@@@@@@@@L@F@@L@@@@@@@@AL@@@@@@@@N@F@@L@@@@@@@@AH@@@@@@@@F@F@@L@@@@@@@@CH@@@@@@@@G@F@@L@@@@@@@@C@@@@@@@@@C@F@@L@@@@@@@@C@@@@@@@@@C@F@@L@@@@@@@@GGL@OHGO@OOHF@@L@@@@@@@@GLFCHNFALLAHF@@L@@@@@@@@GHCC@FF@LLAHF@@L@@@@@@@@G@@F@CF@FLAHF@@LBIGKMLNOO@@F@CF@FOOHF@@LBMDBEA@BG@@F@CF@FLAHF@@LBOGKMM@BG@@F@CF@FLAHF@@LBK@JAA@BGHCC@FF@LLAHF@@LBIGJALNBGLFCHNFALLAHF@@L@@@@@@@@GGL@OHGO@OOHF@@L@@@@@@@@C@@@@@@@@@C@F@@L@@@@@@@@C@@@@@@@@@C@F@@L@@@@@@@@CH@@@@@@@@G@F@@L@@@@@@@@AH@@@@@@@@F@F@@L@@@@@@@@AL@@@@@@@@N@F@@L@@@@@@@@@L@@@@@@@@L@F@@L@@@@@@@@@N@@@@@@@AL@F@@L@@@@@@@@@G@@@@@@@CH@F@@L@@@@@@@@@G@@@@@@@C@@F@@L@@@@@@@@@OL@@@@@@G@@F@@L@@@@@@@@@ON@@@@@AN@@F@@L@@@@@@@@AGO@@@@@CL@@F@@L@@@@@@@@CKCL@@@@O@@@F@@L@@@@@@@@GLAO@@@CN@@@F@@L@@@@@@@@OH@GN@AOH@@@F@@L@@@@@@@AO@@AOOON@@@@F@@L@@@@@@@FN@@@COO@@@@@F@@L@@@@@@@OD@@@@@@@@@@@F@@L@@@@@@AOH@@@@@@@@@@@F@@L@@@@@@COH@@@@@@@@@@@F@@L@@@@@@GO@@@@@@@@@@@@F@@L@@@@@@ON@@@@@@@@@@@@F@@L@@@@@AOL@@@@@@@@@@@@F@@L@@@@@COH@@@@@@@@@@@@F@@L@@@@@GO@@@@@@@@@@@@@F@@L@@@@@ON@@@@@@@@@@@@@F@@L@@@@AOL@@@@@@@@@@@@@F@@L@@@@COH@@@@@@@@@@@@@F@@L@@@@GO@@@@@@@@@@@@@@F@@L@@@@ON@@@@@@@@@@@@@@F@@L@@@AOL@@@@@@@@@@@@@@F@@L@@@COH@@@@@@@@@@@@@@F@@L@@@GO@@@@@@@@@@@@@@@F@@L@@@GN@@@@@@@@@@@@@@@F@@L@@@CL@@@@@@@@@@@@@@@F@@L@@@AH@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@OOOOOOOOOOOOOOOOOOOOON@@OOOOOOOOOOOOOOOOOOOOON@@ + NIL + (4 5 79 18))) + +(RPAQQ TITLEMENU-ITEMS-TEMPLATE + (("GraphCalls" GC "Invoke GRAPHCALLS on the current selection") + ("InspectCode" IC "INSPECTCODE the current selection") + ("Inspect" INSP "INSPECT the current selection" (SUBITEMS ("Freely" INSP + "INSPECT the free-reference value of the selection" + ) + ("Globally" INSP.GLOB + "INSPECT the Global (Top Level) value of the selection" + ) + ("In Process Context" INSP.PROC + "INSPECT the value of the selection in a process' context" + ))) + ("Pretty Print Value" PPV "Pretty Print the value of the current selection" + (SUBITEMS ("Freely" PPV "Pretty Print the free-reference value of the selection") + ("Globally" PPV.GLOB + "Pretty Print the Global (Top Level) value of the selection") + ("In Process Context" PPV.PROC + "Pretty Print the value of the selection in a process' context"))) + ("Quit" QUIT "Terminates this INSPECTCODE") + (Expanded% Menu 'Expanded% Menu) + (Put 'Put NIL (SUBITEMS |Put Formatted Document| Plain-Text)) + Find + (Buttons 'Buttons "Display action buttons"))) + +(RPAQ TITLEMENU-ITEMS (BUILD-TITLEMENU TITLEMENU-ITEMS-TEMPLATE)) + (CHANGENAME '\TEDIT.INSPECTCODE 'TEXTICON 'ICON-FN) -(CHANGENAME '\TEDIT.INSPECTCODE 'OPENTEXTSTREAM 'OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE) -(DEFCOMMAND IC (FN) (INSPECTCODE FN)) +[XCL:REINSTALL-ADVICE '(DECODE.WINDOW.ARG :IN \TEDIT.INSPECTCODE) + :AROUND + '((:LAST (LET ((W *)) + (DECLARE (SPECVARS FN)) + (ADVICE-ON-\TEDIT.INSPECTCODE W FN) + W)) + (:LAST (LET ((W *)) + (DECLARE (GLOBALVARS TITLEMENU-ITEMS) + (SPECVARS FN)) + (WINDOWPROP W 'TEDIT.MENU.COMMANDS TITLEMENU-ITEMS) + [WINDOWPROP W 'FNNAME (COND + ((OR (LITATOM FN) + (NOT (CCODEP FN))) + FN) + (T (fetch (COMPILED-CLOSURE FRAMENAME) of FN] + (WINDOWPROP W '*PACKAGE* *PACKAGE*) + (WINDOWPROP W '*READTABLE* *READTABLE*) + W)) + (:LAST (LET ((W *)) + (DECLARE (GLOBALVARS TITLEMENU-ITEMS)) + (WINDOWPROP W 'TEDIT.MENU.COMMANDS TITLEMENU-ITEMS) + (WINDOWPROP W 'FNNAME (WINDOWPROP W 'TITLE)) + (WINDOWPROP W '*PACKAGE* *PACKAGE*) + (WINDOWPROP W '*READTABLE* *READTABLE*) + W] + +(READVISE (DECODE.WINDOW.ARG :IN \TEDIT.INSPECTCODE)) + +(DEFCOMMAND IC (FN) (INSPECTCODE FN)) +(PUTPROPS INSPECTCODE-TEDIT FILETYPE :COMPILE-FILE) -(PUTPROPS INSPECTCODE-TEDIT FILETYPE :TCOMPL) +(PUTPROPS INSPECTCODE-TEDIT MAKEFILE-ENVIRONMENT [:READTABLE "INTERLISP" :PACKAGE + (PROGN (CL:INTERN "INSPECTCODE-TEDITCOMS" + "INTERLISP") + + (* ;; + "Above is to ensure the COMS is in the INTERLISP package!") -(PUTPROPS INSPECTCODE-TEDIT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE (DEFPACKAGE - - "INSPECTCODE-TEDIT" - (:USE "INTERLISP") - (:NICKNAMES "ICT") - (:PREFIX-NAME - "ICT")))) -(PUTPROPS INSPECTCODE-TEDIT COPYRIGHT ("Beckman Instruments, Inc." 1985 1986 1987)) + (DEFPACKAGE "INSPECTCODE-TEDIT" + (:USE "INTERLISP") + (:NICKNAMES "ICT") + (:PREFIX-NAME "ICT"]) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1353 12345 (BUILD.TITLEMENU 1363 . 3517) (ICON-FN 3519 . 3975) (INSP.ERROR 3977 . 4315) - (KILL.TEDIT.PROCESS 4317 . 4491) (NOSELFN 4493 . 4688) (OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE 4690 . -5238) (TITLEMENU-FN 5240 . 12343))))) + (FILEMAP (NIL (1400 9658 (ICON-FN 1410 . 1866) (INSP.ERROR 1868 . 2228) (KILL.TEDIT.PROCESS 2230 . +2404) (OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE 2406 . 2944) (TITLEMENU-FN 2946 . 9656)) (9660 11932 ( +BUILD-TITLEMENU 9660 . 11932))))) STOP diff --git a/lispusers/INSPECTCODE-TEDIT.DFASL b/lispusers/INSPECTCODE-TEDIT.DFASL new file mode 100644 index 0000000000000000000000000000000000000000..5bc986a682547cb91843fb9a3989f3fb31ce4335 GIT binary patch literal 9489 zcmds7eQ+Dsala1`;I{yZl4VD-PO>e@w7^J|Da*1Y69f(?8xUHE|g~Shi7t?%HhOpC0{O1&(9s6$xjvYrwvshW=s!TdMsh}KD2jVYqmkyWI3O!Yu#c)V494_$!qCGc7wmB}2#G#3ts6=k82sj_1(AM$EwMxfwgI!U$vID$ zKspi~i45t^c@<1e>5Mr9!36sghNWi=$KJ5UqER!Ib?g=GDSGCQ zNMX*H6&Xyf7W1m@8;oT2R@t%rpD`AS#m`A_m9)F=CH4-xYMH^?$Wa3He1@6q`-msz ziO5yi0XyJ;7P5RcX+~l}v;r_T?3h+RfyT{^=dUuwun4lWDArm=-A41p-v!$j&zLD< zAuGaEnJgNuLzzf=I2uVNvm2fBE#$Ndb`xs?F84lnx7$lTzF@0yBMbio5>YrJZaCze zwT^%T3E8V>GG@l@2Se9LBAM(Jdk7PX>e(#g@1dn->El+`g4t8yxS0tb7i0}$nY7(X zSV=vl8>1K)7@kf`bp?}F>jp;?$ym5XS0!p4N}7X_Z*H98zIhIC$A&=ou4=%{Jw=;>NJ zLy~X=UCm?*Qh*Weej(Byi5*K|S+ie4F`WWZ?^wc!nPa_?%n;VMk}%v6LEKE+1Ob5N zswAQ`J#wdy){#d+p0yrLlP=w<$O!fTcDrsIOJqy~2DaRuHY`ZzcNE9&zFB0uU=RFn zqp0*cCU;T!)CpSu1H6e^31q0)%wL7Vbcdgi_->-_knE8Ti)|+ORy7KuXBYueqFIwI z5$i74@|e3{mL!?>8ve*3Ej!FK1+Ylc%~Oo11)($k3^+Ql`Gk?lbh>-$fP3m*;M;gL z#7OekHndygreTR7+>T~wNcY%idl73O3ACT+c|gVu>5HdSo{$!CVhG7k%3XB7a@n-`odaRi9^)CikTKwEL91;8xti8HGYlsJ3HMX#^q|XanhmnM5O&qy!yX z3g92w9dItn>jpT^UGMe69Rge4J%ABvM#l(wlHCF+Z81IB>%{`nwBtB-{AflOCI{E+ z?t{+7=A)Q$G{!UL1tM0$n~{3l6&@Feqm7MBV7Lq7MiAphVlmQ>mPF_32-yZy^YKU;VKdg(6lF0l@8_?V?sdys z+yk_p0@0+I)#HZj7h&6fbTnbbjWg&HtCzwkqUb@QHB4U6XJGJy&czK-Sp8GsN$j`b z`qm7|@~W01hsp0B4-PW(;>Op44zw3$ApJ&T;3x1mWO$n zys@Mn643IJx^Lvvjjs(P#bRE*G%`|L`H#yxSS}MU4-~u&K5*(3Yt|0)O3RnFC5{Xf z>H&nIklJQ$WVWs!cw_%=;z&s8Fodl2OUhqXb$W<}G5)efMC$}m*SRI-8x7+xDX((N z;1QOWlrx@$3GJMzz2G(8Sdv~8{FgsH*2AK2T#nV|RTT3r4o|Zbeh7gRoy&sH>||XE zg@V~BVj#xaAo_&%ON!rMRjLDA;8sIOSYDF<^%mN_AS8X-Q|+GrS&~~F=JF#SZyu?e zO+n72JniM-o2w@8329xklC+g)(=7?|6XfNs6WYX%Wm7Zn?)EL4JG|C(cYD3T^Xb+; zirCDEBqnY;(JCN7X*}8P(Z08rj^=!?F8B zaJlr`Rl3WEe{(Bcy3aGxrR}$LuptIqU;7l0@Vb!kQPOgCh4RjF`xS~Hl=-8|IuRuH8q)#|$+;wUS1#85dVBaezmrTEe7&+19Af`E$m z099_skW~8>ADZj4bNR{XlczKJC#FlY*-CkO_6c;U9$!*NF{dbKwU0H%(S96oP)Cl{ zLM^C}PY|6^)}#_{KN1;E7NTxcHxMlawdk;!h@xt94{nep#f!tL7l(h3XY>Z5?gJF% z-f;PA5pq~(9A^mqG$z^1$quIwLKGQcW)oB_5F!UeKxF(eYCnc{3(|f@AMz-U0n<6G zCx(WtL|j;k2o0bS;$zluBR1|nOPza#I=ewr^&%w!>f-$9dA3)FZI1z~ya!4jO_~}n zk?2$;T}`QamavcUjK59bQ3k(5V4T6`FRFO2l=x!4o)3dtuJB!%R0R!EM~LKrkhjTjkA-Y(QwFTQ+kFObr&NZaG$bjxJYzW~$LaL6F4 zw@DL9=G3@~Mv$^E)>y(A5-W{5{u~|aMP-DA-y6yH3JU7`F8bQ5eHOY2`8tpt9&*?m z^RVYxL21!_b`Jf1PT6B838X>C(h~q%1sA37ooITJVRgv3)13*rGqg0S2MR3OR3!6g zI%4RXF|PUwc13eKeT>(H+fOLr?`s5-Kpz#D)L73}WqdR6e#0C@fr=jGI+{3h#3Q3g zixwM7)L5Lhf$}DLTB1p+aZw%;=2c+Yd@7OA`Qk3Zm1~lfJoG`8jguj*WmZU`oy$7X zA&pV;2h4FD%<{i8_*Vq}Lmm5eO-`NZk1@20xe{rLNqxO_A^k0Sk&bgdtJ zX(LNN2TmD^68LxSIDK6Krit%SsP!$hd`UfS(f;<4S7^7kz!~ByvJL{YQTO6oD8aW*iEc6HGbjPo2oM!DwZD473)Tz{wu3_ z|E!Vs+qj^p^42UzOq(71eyfnz>MKB-%S}F+dm^t*lbtJCv6P!)S44BO)PACzn=6nH z+A2=CJVW84lXXw-@D(j z`@Gz!<+L)VN4~ABKrNx`TsdEN?QV0EY;LMc z1}sGHAij;ncj?DwmvRSBP88{8=NAf#g&kLt%J-L6+K(tf$vxBoBT;c6)1TeR7eTdK zofa}7l{$gr1|4<#s7>cSA6k@Fktfi=2`oJepfmeuYS2uEy))r)ViXA>EdtRm@8RYC ziwz)d$MtHgN-8R?_Y@Mj1h(ev=pd^?h;K2|`*g^r8%t~uC6Po)Lwz66<7aU8?Nlm{ z4|Ge*4K?#{H|FRdMKxTQh3R%r&+rWhG5>RQ?x>|OyH3bz8yLPWvB`*g%gy)pE#-KX znB3$Zgm|xr{5b`Ymg8wFGdyaH^wo9e6S1t~22~#CMbdCtD!?>*P{6!8>JL%-G8-cq zYCtk)P(qxFVfXJ}bK?plu`fV-c0Ws=pK?S^&-hRXKxmogmL4#_TmtgZe9>WEG`k@TN#&k z%?z|x2jo@<#4!*g!billCDDfnD`7OgwiMMWRh~lP5$NSrJCxUZtJjOf?_+seJVLij z3X5&Rm!aHJ%#4^^AepctmMQiGMx!02;_^ZC`lEEKnHH*46;jR!rJ7FWE0YCMn>3{? z-4f3rGx6mrQg%t)v(OY)YeeKPG1E&o?R%N~Uj8_?6Sl3}ZtY0&owu;bDxIKw6YtEM zD)h0GJwTr1r3MeTkkN64PuVG&D;7lo{f=YzBxau~J-I5wAtzCCnOrEB^T;To+(4#c z5p4-krbJ6qd3W5gw>1>Uw_@`l^?Gb<$sZ$dcx<<1VZ!%$NPoPX&lgWuS@$-woB0?r$9XK%>-~t3#Dgu3C-l)Fy=hTEli%TIBLH=kjAz#IfKXIrb-4b=9-KH`$wb zi`SmC)`k$ae~qx;)R5O5``{X3|2NjW=GceUi2n6ViZ$;$x-c!g^ApGZgq1JPOwZzN zEQ+oIDlgAl6jelo>Cm5<%gv&s(^C1_1qvod$OG~m`G*b<3za%@ev$SVg^%~qw-J3> z94}7s!WjIq(&WMnHV}GR)5YBMY}mp&LCY6MjYcaQCBWc9rBa%muZw&Z1#=AVmW#R5 z8cIMa5FZybs6tfd8)J{jE49yuQVm@BP`U~|#K-?@!0L)5Rq3~`yjz1mFMm*lYwkI7nRec<+Rb-t}O*&7bq&J%IOk@EqU+9{eug%^rLeaJztIf;&BU5wKst zD!~B{1}Ld(;lO9tefh@93q1G0Umy6l%|G)x%yTd&sPM;7ZaG@}pC9U50*nP!3y;XUyTd*T`P#53%PXV??ZuqU43&kKZwXvUe)O=jUVD45V;I4Y6J&WV#_1H%fr}%rVAK+L zjajX{m2DIv@q%?Yk{xab9LnleIA%siQPiPIq@R^+2D-aPAJ?P&%MaW>g!yL~J$`pg zy^TWVd70IEQOpJfI^QC8(Mc)FUGiDh_cqpyr~c93WAv>#9n^KC%kyUM7Z_Q#fP6tx zP;#kmk9(ZTw>ukuY2s2P=C;zK?PLDb#SPu`_Y+7>>l-Cg4%t}y;fi~^04Zxgk;gFa TcJD5Lf43ujjk4NzR#yHCJL+3B literal 0 HcmV?d00001 diff --git a/lispusers/INSPECTCODE-TEDIT.LCOM b/lispusers/INSPECTCODE-TEDIT.LCOM deleted file mode 100644 index bd9b604c975be22a04f4c7c9346128fb7b3ad956..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 9612 zcmeHN-H#hr758Ra)VgWNrV*eD(o@r@cGO+jV~;-;8hJb(+mjv7Ozhd+Mv9bd)=t)~ zvtD_fl&Gzc5TZgL9*__ck4RNtc*q9&zzh4p3;hrHGb$k=-pcRXJ7dq-vzrDGPqh+z z?mhRO?|be!XD3}Z8m4WmHcZP{HSLB&mt0NX(3%FN0ScZ|rrmW7-P4`AvFaIh(@RnM z(q`8nKs=*knO!%P!IW+48@ARqx&Y`NPbDw89ng4Zm8bpL3|;CNTHVuXRs;iGs%gNP z%Vv_vG_#~*8OTwJDyxnDomC~PD3mL#<6k}x7E-&T`v-$zzel5eEJ}V*?{0kb!@be{ z{?*~mc>L(<{eExQe{^*?I6Qc8*dHHWT@YmL2e}NkmO}W|bv3)5Ra10_(GTD3(O{pF zsm7*dQF!6n+FFWwI}?zPLr_j-=A|gCws#(_mP?e&t*Z*iq)4*N3S@!1SKFHB#d4XY zTrrESyL&tP_xgu48C_n7dbRqNsT<_D1`P3z*Y%*XHcYvCQ`l)OBrvSOG`6%(mqOFh zpt{rU@&da{p6OXe+psrR8#X29FgKh|Eb4=C|KVWt;7}+8oUul|M<(^ z-mCbmoLOr1%!|q63*Y8d=MzAaOsnOYprlj??yhZG9?RV_tU5$jvZPxbx8t;3j|%kR zbIT0$Zn(zxKZI#vL`tWd(lOo@wmS~p~L>LzdIR>_W6*Q`-cY@>7!mhz+wt4vt#$v&C`w8!wkr+Cv2m1ce7@C zM!O4>kNf@Mqf@ru#e&sw|85_Q@Am28&hSB>Mt243h#1Y`=ngay!L`=3oZ1{eavi0; z(E(Zghy7vZ6r@lkx#Q7p|L~CX(f*|WqX|yFR5c5^1_On3CAf-bk&p2X9Y|bn(yosz zlYs?N?zlghJOZTwjI+fePN}%=76gbaU`s}bESmLX6`z3bKUOpF1zKKU@_(jkCgN*) zfk;FXQ;#@J-Pa!sCV>&JZ<-$T>-ER?2m6So2yJ_V!*GO3!9+<@cWe$w90$@aWr-)q z#KU%m65C6O#L{g(-c=C_lKd#1hA)Vpz24yEZ}8;a;N|D}cV)?6+IoqHa$ER$Pt3Q@ zC(`9Sxtrd$Y1f@?=)k2?Zf-)Y%uN&uGP=~6%WcXRso~h3yw517Qq%D9;S%K#<07Dx zNcSX9N6q)2LB%Bqy8-RW>xLV(&bJX6x`yRDkGMp>#li_W#1$gY1!CnYA+d6Wh#ZTI zQ-xCYC@!vlwW~7_QqXa6GgF=nyN+Llx}MhYgsps6V0Y(ho*H<7JPnxfil3!j!APMi z)6D8hh7wLh8X&v3vT%<8|1-@IXge4)h7!tFP4}3nKqZqGIitsKNykYY#UEw%m zdQg@(yYP7w&T?!=49P>F2?MljHk*?cvM3EPk^Z!yb5|U>EV(Vsu3JV1s>c8q5xf@J z4dPkirNmNVS*s!gabMl_lMdh0!xSWPmvUvXpYT))W8w)2KeH-Ns3C1&SeS?Bqi}X4 zu#J`QmMErdWMzfA$U_EqA9ecokeYNSxDD@NUs*)sEzQDniExyF506EvBX6~|8@_kC zq#~%;n|jOPoYY0qgteAo<1tU$QPK(~rk>03T&Auf9wDMH|NIpkcj2GnaQ^N#pV+_h z*C*nj9?MX$va%G4_$y0iBBSM&*enA7=Vw=zp1aKm#N3MZqBs+`E*!T%d;VzodxF*% zPhOK-eDr@>{>jnuvLtnUbmm`H@7*tcD+A!;Yr`-9@#OL>ejK;@Jy>fKsW1p+HXPS8OI1bl4Fm@9 zS*bcMecqXaChsx z1paX=;Ij4%T%M0%u;iQ%czf&VyuBFkCV$x(68~JG3t}ko+-4KM)^k!^g$yp94JwfM zQsmE~4iP(Vz46(rVcoD*#P}%j3t!z+@jHR|)&EBP#}!}r$64oGj76L`gj~YlKNGAt z=Y*B^5cDgEgQ0YyT$b?)@lM3^GAAj1$x%k~Ba#4=R8-Dm;B-yTM7CB|)Y-*PWn8o} zBihEZ!Z}gLXo_{&5^@}~+49VWA6rV53a*g4*9y%b4u?{V60#;g1h1jUwYI2~&x&|N z#S-!!O_mDa810E-9x2u=J1S<8Px|buW!zqz!!Y}534?%rwG^%h)gqDsL{rb$CRHtk z*jH6$o_!TMiL$TaP7JfJB9(&%JjdlYTL9e5YZ6Mi ziaMS50K%1;3np65wwQq*gqX^yDg~KguE4fM*04=ED3z&h|t zG2Wt3r1aDvp@#`syK|HIJaz_c8iJhjZH|hsPoyqo)Ey$vC>N1T`}G%LpSCNwZPxNt5RN`eZ=nWuROe3%m$&ah^?{ZftroKTi4 z1xgKM#|CY#a;b>#y`4kaANf6j$q2Qt=;&|_>^B_5(rnDq1JQDbEG(&Nl2Q_YMjEuj zB}RZqR@nXC8qxM(I0W4Z&=wKw0=6(xz@$KcXQ*k)q2CaYB|8{RCE=(ufl{zZdAhTJ z12Ww?+d}zV9tAskAT!(0!Ore`JNNp8(w!L^j&^#2MSW+V$M?qQlQA^~fgIAH#z$%i z1_a>s*HcJyOO)ycZ863(8I6Dk%hFd7BUEmEj(2t^=;LP45eA!nwu-LKSR|};cQg() zfDU9&N9ytY!G3S_KKEqNkoLSAXn4v>mEAGY+ZL_RWV+*O*RKm_U4WwR$BokYvm3N1 zLLnxmJP9JsS1b>weu(A=8daN3>xS&$qOmZm_6aSKw2o?|X^4>FH^`E)U0~Tf<2b|| z1F7Fl!+?okViD6Rh~@;D;)@n|t0#1h1v#hPMj?gbSI2H#Fc5}Y)!b{PWLw+7O@Tj9 z81|Ogacmq!6j%#p<0es>4>r`Z+CXBk>R${Y@j?nqrqUmX<>-SVH^`*XTd(Ajms3vM z$F5c{r=AA1sxhC2zw`eA)E!4~5JyvkSdgMxjRQ9As^+xffg0n~d27s0U5LdiVt|qv zUa|<(1TR(oSp@3L3O>zPpoCTRI3RY24=^mEl_aZG&58j|?GppU2LEF(?$mr{nVkii zfg~);A~3)TS)L8pY+6;P)pV+k(^}Zsv>JNLZs4yDS`4tIgIJ>)4`dm1h!NgdGn*T2 z%VyV-z%b2PyIwQ2YE4*bVW)$g?UR5T)oU8>jAIBiuW6QDJ6)91lmPGWKhLV$Q%!cN zu}^iA>ePo~9ISe(Yo6-VQ()Y2aD1Y|JTih!*{I5J5Pt+U_!fU+53jy)%CT=+rvwbd zm=i+{Z#ywaHCRC>g*T@zc$Hss$3cd*06quQMa(+^=xe}-&h7Md7Yoz^txIThXO!gJ zv5%6R14cX1ixY3&W@(P zAPfxck&j;k=hXMLh88ps(okGZ$fx5eNnz$A;y*W0x`5U=S~|Hhl2ooio+-gTIa7Z| zMA3|VnyAku@F!;KNq#2?)e-0FTz{ho0*+83j=#%r5{`)6XgzpaDg5SAGI$Xp^6Jw1;;T#Ri?1%N$Go}p6!CP&z0u*m tCEh5g^>^R9zq3zxxnnYZa33#y9KMCYE?yeSRnVTmSCPL;z{!6Y`ZqU=Jd*$b diff --git a/lispusers/INSPECTCODE-TEDIT.TEDIT b/lispusers/INSPECTCODE-TEDIT.TEDIT index 3e4bac2b6d9955ed5f3e8cc75335264f7f095a45..66df5758330dad88b43d90ea9163654ade4a4e4d 100644 GIT binary patch delta 1910 zcma)6O>7%Q6rQ!$c03M|id6_oie5>Dyj9r7CIu8OwKtp8A-1Wrv_jCsc6Tgqwf0)x zF>T=B6PF+XWs$gW|@#q7_OvDJ@fa+9g2YsvT|tG;Ge{D(iHHK_5!p ziE+jDN4>tMJGRf6)76-XO|f$@-I^`NdD0>I-Fk1Mows)%8Mf183A@eGa}I za$v5Ktr84CH$Vwg?=BEQ~(LJ(&`E-()_H4zjn`!0Q9YLPQaxbzpZLHsH_+hH!1< z@pX)e?iH4!KeEdO8$#wYhkHRkD(9Xamt+SRILYMo9e?DCg2JH3Am|8T1|b)z?V$@6 zHV53}KD%WPWj@gg>xH@omLLWL6b>f^u{q+MuIF^Y9tynybG(k{0EYl(jtiYzba!YE zx`yrhVLop}U*$A~M!)5D#I7xL#Qx#JCt@$VbLfHM41$(5&yvr!+aY4Gl`s!zJUm@z`g|x$3@UwwqP!A8E%AmwrsIY8t_n zAq%7|t?8Cl$c3m}T#c?2)iaw2DnF2%_)4W!a^a)m`67`4{w$mXpp=h6xYFqvDVapX zoDmLn&T~YLl$T_Pib-bFCZ6o6m_1|*HMwNWm&F%F$=R_=vg9JkHpH)}-6T{Jo+y>x zlowGqTKlaw)b^{!D{=rD$?R5*tJVJ`{!hu&n9O8f{I~3>StfQ!$fN7j3AO4C^Pt^o zRGVb^(dI<&Y$zL{FVvnR{JJ_;C>42C1T= zOQ_^ds;H{#YjxXc}kC@U^5Alq{87zP8AL0#L@C3Q1@lT&?C8Hgmz*mCdx6Le2@VCJqCw)q1;H5!`GCX)5ecahm;MWg1L6kUI3V%f?2o!_s+N^Jp8dY>z4yI& zvmX}D@(W#V4B?VY%9yOtsJ{qxW2Ydmp1b2%k1X${K{IsaD!5!5O}^bZmTg$#UE;M z*wv3YbL}2y{C$sGhy0MW^}gOROv5v{%TBu7VqTXs*&5TWL$-6UwO`S;YPAOI>+K`` zJ&@@RXQr)V_>z(1Ic9il-~w@8*m90mJ3b>G#6J;>iKDAosNd#&k9DA-I|IYZG6M@6 zE`yc_m`waSxgdT@EDT+4^0sH#7T7bquC&*)LBU!B4^F`KL!mDZ{OZnO;NnC-b#sh0 zp&PsJ$IBX=jSY%4vyo2HviS3AOvUz%oM%x^f0^)1#GUnQ3n zDt<|pVVzEOU_DKJ0qe!|m#}`D{#2o(w=P^$GIYnZTafKEooS@RPYrt$Op5F-Pw&-(Mj~g z#;c(}`S{hut(nA71#fdC30J()sA^<75Reywe(NMg$Sg_h!q;|CCz&YvF@}x!&tvR@ z4?yglXTU%l^G^WZCg3MO6wvz{e3M8-#Q~Atlj5Jb#cRr#sh}7Lf*>3b42i^rGC%V_ zq#G}l6~^E@!3~yCvCQmvYGZf1&1}j9!;*(-RCJ{jGDvzejG9=lO`^Q2$p=})S^mwIb~gWLou=!BGM=HFH_0ovyhTeDE>G^!lrOoQv3GP nOjO{4}SO$o0|%3 From 1b8d89f36e77131e7100f673ce2c022075fdfba3 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 27 Jul 2025 15:02:51 -0700 Subject: [PATCH 4/7] Delete orphan file TMAX.TOC --- lispusers/tmax/TMAX.TOC | Bin 2115 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 lispusers/tmax/TMAX.TOC diff --git a/lispusers/tmax/TMAX.TOC b/lispusers/tmax/TMAX.TOC deleted file mode 100644 index b605c055ea2bb768ca1f45e37c00abaa739abc9b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 2115 zcmah}YflqF6rJ+Wtcov;k3`LUQu?K`^leN`Sqd~lF;Muvbf@hm?QF9Nn3Cd~@Co{E70MqeazlM1>T&?#dkl@b{LjK!}oN|VK9qHiGq6Tx?902_-c zShQszBLxN|Rz-shaw;faMfr|QM6C2hqHjQYPmF~Uxf>`Bt3Fe+u>iJltbt=Uom|2g z4&o@CW>Ph@?Gi%mpBvQBx+|`-8x4YMPh2a$D+W<4oGNBnD}f`StpUtfgH`D9$d|)V z4!If$9*BXTjuqdBwcx%C;1ExIrRg=31e6s{LQqPa+FZY`yMS7D2^ph-15H#k32%@S zQqM$ii(H?}HF0LC)QM%a4`Y8ia_WnI)uCT{hxvX8&1_(N9sA|Q0``XYPCN}lyDmcL z*Aj%yI`Jq}`V;XLsAd=q5bww!#PuTC2Fd~=uJto0wy)t03ZM?_0(5`K=t>%aCg#<^ zF&z6c^~V{#xv*<4?B=CVNOP%_xkCo)Vk{7B>3ON3B?osKEY7B)9}Z^NS)T^&xZ8^) zTzvaaVf4`iHX=%gBbCr5j6(REKq|w}IxDaeowA?R0%L{3pS5KycV1%;*&F5@wvR5_ zy^hynj|}B5c$MABUbzK7nTr6t$<_~A-r>EvPYv@sbGP=|`>pe%-u_9q$6dZfk=)%b z>SF^=z4qyGr`tN>jbd>rThv*B7BKb_j}PDr$zod=dy5C`1N8!t7dhm$Mlh119^(Nu z4DvjOY$5_>E;yuvQN}B;OhsGDl%a)ChL+AN^g>mW54G8fBF=vh<8Cs1ms6%nt-78e z$5OtBV?`A)3Ws8Hrfyis`yA(U4*8&wf8?CckX{TcXW9)!j1EoE>MFefRupk8#ORp1 oXkJ*mQ8rs=b1a>F&Sru}=OfmRPq?`B^9c`#XwKR Date: Sun, 27 Jul 2025 20:31:43 -0700 Subject: [PATCH 5/7] Fix FILETYPE for LLDISPLAY --- sources/LLDISPLAY | 178 +++++++++++++++++++++++++++-------------- sources/LLDISPLAY.LCOM | 134 +++++++++++++++++++------------ 2 files changed, 199 insertions(+), 113 deletions(-) diff --git a/sources/LLDISPLAY b/sources/LLDISPLAY index 634f7a058..30a34c5b9 100644 --- a/sources/LLDISPLAY +++ b/sources/LLDISPLAY @@ -1,12 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Jul-2023 14:50:58" {WMEDLEY}LLDISPLAY.;19 270570 +(FILECREATED "27-Jul-2025 20:25:24"  +{DSK}kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25 272767 :EDIT-BY rmk - :CHANGES-TO (FNS BITMAPEQUAL) + :CHANGES-TO (VARS LLDISPLAYCOMS) - :PREVIOUS-DATE "31-Jul-2023 14:45:32" {WMEDLEY}LLDISPLAY.;18) + :PREVIOUS-DATE "14-Jul-2025 22:06:59" +{DSK}kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;23) (PRETTYCOMPRINT LLDISPLAYCOMS) @@ -30,9 +32,10 @@ [COMS (* ; "bitmap functions.") (FNS BITBLT BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY BITMAPCREATE BITMAPBIT BITMAPEQUAL BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING - \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP - \INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE - \MEDW.BITBLT) + \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH + BITMAPHEIGHT READBITMAP \INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR + MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) + (FNS \READBINARYBITMAP \PRINTBINARYBITMAP) (FUNCTIONS FINISH-READING-BITMAP) (CONSTANTS (MINIMUMCOLOR 0) (MINIMUMSHADE 0)) @@ -1361,6 +1364,18 @@ (WINDOWPROP BITMAP 'WIDTH)) (T (\ILLEGAL.ARG BITMAP]) +(BITMAPHEIGHT + [LAMBDA (BITMAP) (* kbr%: " 8-Jul-85 16:01") + + (* ;; "returns the height in pixels of a bitmap.") + + (COND + ((type? BITMAP BITMAP) + (fetch (BITMAP BITMAPHEIGHT) of BITMAP)) + ((type? WINDOW BITMAP) + (WINDOWPROP BITMAP 'HEIGHT)) + (T (\ILLEGAL.ARG BITMAP]) + (READBITMAP [LAMBDA (FILE) (* ; "Edited 8-Aug-2021 00:18 by rmk:") @@ -1501,6 +1516,44 @@ (T (SHOULDNT "Invalid argument to \XW.BIBLT"))) T]) ) +(DEFINEQ + +(\READBINARYBITMAP + [LAMBDA (STREAM) (* rrb "23-Jul-84 15:17") + + (* * reads a bitmap printed on STREAM by \PRINTBINARYBITMAP.) + + (SETQ STREAM (GETSTREAM STREAM 'INPUT)) + (PROG ((BMW (\WIN STREAM)) + (BMH (\WIN STREAM)) + (BPP (\WIN STREAM)) + BITMAP) + (SETQ BITMAP (BITMAPCREATE BMW BMH BPP)) + (\BINS STREAM (fetch (BITMAP BITMAPBASE) of BITMAP) + 0 + (ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP) + BMH BYTESPERWORD)) + (RETURN BITMAP]) + +(\PRINTBINARYBITMAP + [LAMBDA (BITMAP STREAM) (* rrb "23-Jul-84 15:16") + + (* * prints the representation of a bitmap onto STREAM in a form that can be read + back by \READBINARYBITMAP.) + + (PROG ((STREAM (GETSTREAM STREAM 'OUTPUT)) + BMH) + (OR (BITMAPP BITMAP) + (\ILLEGAL.ARG BITMAP)) + (\WOUT STREAM (BITMAPWIDTH BITMAP)) + (\WOUT STREAM (SETQ BMH (BITMAPHEIGHT BITMAP))) + (\WOUT STREAM (BITSPERPIXEL BITMAP)) + (\BOUTS STREAM (fetch (BITMAP BITMAPBASE) of BITMAP) + 0 + (ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP) + BMH BYTESPERWORD)) + (RETURN BITMAP]) +) (CL:DEFUN FINISH-READING-BITMAP (STREAM) @@ -3249,34 +3302,33 @@ (\INVALIDATEDISPLAYCACHE DD))])]) (\DSPFONT.DISPLAY - [LAMBDA (DISPLAYSTREAM FONT) (* ; "Edited 11-Nov-87 15:36 by FS") + [LAMBDA (DISPLAYSTREAM FONT) (* ; "Edited 14-Jul-2025 22:06 by rmk") + (* ; "Edited 11-Nov-87 15:36 by FS") (* ;; "sets the font that a display stream uses to print characters. DISPLAYSTREAM is guaranteed to be a stream of type display") (PROG (XFONT OLDFONT DD) (SETQ DD (fetch (STREAM IMAGEDATA) of DISPLAYSTREAM)) (* ; - "save old value to return, smash new value and update the bitchar portion of the record.") + "save old value to return, smash new value and update the bitchar portion of the record.") (RETURN (PROG1 (SETQ OLDFONT (fetch (\DISPLAYDATA DDFONT) of DD)) [COND (FONT (* ;; "Either FONT is coerceable to a font, or its a proplist of ways to change the current font (see IRM), otherwise an error.") - (SETQ XFONT (OR (\COERCEFONTDESC FONT DISPLAYSTREAM T) - (FONTCOPY (ffetch (\DISPLAYDATA DDFONT) - of DD) + (SETQ XFONT (OR (FONTCREATE FONT NIL NIL NIL DISPLAYSTREAM T) + (FONTCOPY (ffetch (\DISPLAYDATA DDFONT) of DD) (CONS 'NOERROR (CONS T FONT))) (ERROR "FONT NOT FOUND OR ILLEGAL FONTCOPY PARAMETER") )) (* ; - "updating font information is fairly expensive operation. Don't bother unless font has changed.") + "updating font information is fairly expensive operation. Don't bother unless font has changed.") (OR (EQ XFONT OLDFONT) (UNINTERRUPTABLY (freplace (\DISPLAYDATA DDFONT) of DD with XFONT) (freplace (\DISPLAYDATA DDLINEFEED) of DD - with (IMINUS (fetch (FONTDESCRIPTOR \SFHeight) - of XFONT))) + with (IMINUS (fetch (FONTDESCRIPTOR \SFHeight) of XFONT))) (* ; - "This will be difference when spacefactor is implemented for the display. ") + "This will be difference when spacefactor is implemented for the display. ") (freplace (\DISPLAYDATA DDSPACEWIDTH) of DD with (\FGETCHARWIDTH XFONT (CHARCODE SPACE))) (\SFFixFont DISPLAYSTREAM DD))])]) @@ -4541,14 +4593,17 @@ (DEFINEQ (INITIALIZEDISPLAYSTREAMS - [LAMBDA NIL (* lmm " 7-Jan-86 16:51") + [LAMBDA NIL (* ; "Edited 6-Jul-2025 12:57 by rmk") + (* lmm " 7-Jan-86 16:51") (SETQ WHOLEDISPLAY (create REGION)) - (SETQ \SYSPILOTBBT (create PILOTBBT)) (* ; "For BITBLT") - (SETQ \SYSBBTEXTURE (BITMAPCREATE 16 16)) (* ; - "For texture handling in \BITBLTSUB") + (SETQ \SYSPILOTBBT (create PILOTBBT)) (* ; "For BITBLT") + (SETQ \SYSBBTEXTURE (BITMAPCREATE 16 16)) (* ; + "For texture handling in \BITBLTSUB") (* ; - "A guaranteed display font is initialized here after pup, font, and bitmap code has been loaded.") - (SETQ \GUARANTEEDDISPLAYFONT (FONTCREATE 'GACHA 10 NIL NIL 'DISPLAY)) + "A guaranteed display font is initialized here after pup, font, and bitmap code has been loaded.") + (SETQ \GUARANTEEDDISPLAYFONT (FONTCREATE 'GACHA 10 '(MEDIUM REGULAR REGULAR) + NIL + 'DISPLAY)) (SETQ DEFAULTFONT (FONTCLASS 'DEFAULTFONT (LIST 1 \GUARANTEEDDISPLAYFONT]) ) (DECLARE%: DOCOPY DONTEVAL@LOAD @@ -4563,7 +4618,7 @@ (DISPLAYSTREAMINIT 1000) ) -(PUTPROPS LLDISPLAY FILETYPE COMPILE-FILE) +(PUTPROPS LLDISPLAY FILETYPE :FAKE-COMPILE-FILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) @@ -4573,43 +4628,44 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (20459 23127 (\FBITMAPBIT 20469 . 20929) (\FBITMAPBIT.UFN 20931 . 21950) ( -\NEWPAGE.DISPLAY 21952 . 22087) (INITBITMASKS 22089 . 23125)) (25052 25561 (\CreateCursorBitMap 25062 - . 25559)) (25678 86230 (BITBLT 25688 . 36078) (BLTSHADE 36080 . 36858) (\BITBLTSUB 36860 . 46995) ( -\GETPILOTBBTSCRATCHBM 46997 . 47612) (BITMAPCOPY 47614 . 48190) (BITMAPCREATE 48192 . 49752) ( -BITMAPBIT 49754 . 58141) (BITMAPEQUAL 58143 . 59605) (BLTCHAR 59607 . 60223) (\BLTCHAR 60225 . 60727) -(\MEDW.BLTCHAR 60729 . 65607) (\CHANGECHARSET.DISPLAY 65609 . 68567) (\INDICATESTRING 68569 . 69765) ( -\SLOWBLTCHAR 69767 . 76863) (TEXTUREP 76865 . 77135) (INVERT.TEXTURE 77137 . 77411) ( -INVERT.TEXTURE.BITMAP 77413 . 78948) (BITMAPWIDTH 78950 . 79322) (READBITMAP 79324 . 81834) ( -\INSUREBITSPERPIXEL 81836 . 82131) (MAXIMUMCOLOR 82133 . 82274) (OPPOSITECOLOR 82276 . 82455) ( -MAXIMUMSHADE 82457 . 82668) (OPPOSITESHADE 82670 . 82849) (\MEDW.BITBLT 82851 . 86228)) (86232 91418 ( -FINISH-READING-BITMAP 86232 . 91418)) (92540 93021 (BITMAPBIT.EXPANDER 92550 . 93019)) (93022 141556 ( -\BITBLT.DISPLAY 93032 . 116271) (\BITBLT.BITMAP 116273 . 125372) (\BITBLT.MERGE 125374 . 127627) ( -\BLTSHADE.DISPLAY 127629 . 134729) (\BLTSHADE.BITMAP 134731 . 141554)) (141557 150877 ( -\BITBLT.BITMAP.SLOW 141567 . 150875)) (150878 167259 (\PUNT.BLTSHADE.BITMAP 150888 . 157984) ( -\PUNT.BITBLT.BITMAP 157986 . 167257)) (167260 170700 (\SCALEDBITBLT.DISPLAY 167270 . 168903) ( -\BACKCOLOR.DISPLAY 168905 . 170698)) (174555 176828 (DISPLAYSTREAMP 174565 . 175173) (DSPSOURCETYPE -175175 . 176184) (DSPXOFFSET 176186 . 176505) (DSPYOFFSET 176507 . 176826)) (176829 191024 ( -DSPDESTINATION 176839 . 179942) (DSPTEXTURE 179944 . 180106) (\DISPLAYSTREAMINCRXPOSITION 180108 . -180395) (\SFFixDestination 180397 . 181575) (\SFFixClippingRegion 181577 . 183749) (\SFFixFont 183751 - . 184801) (\SFFIXLINELENGTH 184803 . 186299) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 186301 . 188114 -) (\SFFixY 188116 . 191022)) (191025 194872 (\SIMPLE.DSPCREATE 191035 . 191585) (\COMMON.DSPCREATE -191587 . 194870)) (194973 197167 (\MEDW.XOFFSET 194983 . 196124) (\MEDW.YOFFSET 196126 . 197165)) ( -197168 205094 (\DSPCLIPPINGREGION.DISPLAY 197178 . 197924) (\DSPFONT.DISPLAY 197926 . 200296) ( -\DISPLAY.PILOTBITBLT 200298 . 200447) (\DSPLINEFEED.DISPLAY 200449 . 201020) (\DSPLEFTMARGIN.DISPLAY -201022 . 201753) (\DSPOPERATION.DISPLAY 201755 . 202779) (\DSPRIGHTMARGIN.DISPLAY 202781 . 203626) ( -\DSPXPOSITION.DISPLAY 203628 . 204485) (\DSPYPOSITION.DISPLAY 204487 . 205092)) (209282 214318 ( -TTYDISPLAYSTREAM 209292 . 214316)) (214621 215651 (DSPSCROLL 214631 . 215331) (PAGEHEIGHT 215333 . -215649)) (215696 218718 (\DSPRESET.DISPLAY 215706 . 218716)) (218754 219277 (\MAYBE-DRIBBLE-CHAR -218754 . 219277)) (219278 239916 (\DSPPRINTCHAR 219288 . 227126) (\DSPPRINTCR/LF 227128 . 239914)) ( -239917 240509 (\TTYBACKGROUND 239927 . 240507)) (240510 243797 (DSPBACKUP 240520 . 243795)) (243981 -244237 (COLORDISPLAYP 243991 . 244235)) (244238 246309 (DISPLAYBEFOREEXIT 244248 . 245074) ( -DISPLAYAFTERENTRY 245076 . 246307)) (246681 251213 (\DSPCLIPTRANSFORMX 246691 . 247280) ( -\DSPCLIPTRANSFORMY 247282 . 248007) (\DSPTRANSFORMREGION 248009 . 248541) (\DSPUNTRANSFORMY 248543 . -248803) (\DSPUNTRANSFORMX 248805 . 249065) (\OFFSETCLIPPINGREGION 249067 . 251211)) (252527 255114 ( -UPDATESCREENDIMENSIONS 252537 . 253166) (\CreateScreenBitMap 253168 . 255112)) (255673 268832 ( -\CoerceToDisplayDevice 255683 . 256096) (\CREATEDISPLAY 256098 . 257938) (DISPLAYSTREAMINIT 257940 . -261084) (\STARTDISPLAY 261086 . 263997) (\MOVE.WINDOWS.ONTO.SCREEN 263999 . 266191) ( -\UPDATE.PBT.RASTERWIDTHS 266193 . 267975) (\STOPDISPLAY 267977 . 268469) (\DEFINEDISPLAYINFO 268471 . -268830)) (269440 270201 (INITIALIZEDISPLAYSTREAMS 269450 . 270199))))) + (FILEMAP (NIL (20615 23283 (\FBITMAPBIT 20625 . 21085) (\FBITMAPBIT.UFN 21087 . 22106) ( +\NEWPAGE.DISPLAY 22108 . 22243) (INITBITMASKS 22245 . 23281)) (25208 25717 (\CreateCursorBitMap 25218 + . 25715)) (25834 86764 (BITBLT 25844 . 36234) (BLTSHADE 36236 . 37014) (\BITBLTSUB 37016 . 47151) ( +\GETPILOTBBTSCRATCHBM 47153 . 47768) (BITMAPCOPY 47770 . 48346) (BITMAPCREATE 48348 . 49908) ( +BITMAPBIT 49910 . 58297) (BITMAPEQUAL 58299 . 59761) (BLTCHAR 59763 . 60379) (\BLTCHAR 60381 . 60883) +(\MEDW.BLTCHAR 60885 . 65763) (\CHANGECHARSET.DISPLAY 65765 . 68723) (\INDICATESTRING 68725 . 69921) ( +\SLOWBLTCHAR 69923 . 77019) (TEXTUREP 77021 . 77291) (INVERT.TEXTURE 77293 . 77567) ( +INVERT.TEXTURE.BITMAP 77569 . 79104) (BITMAPWIDTH 79106 . 79478) (BITMAPHEIGHT 79480 . 79856) ( +READBITMAP 79858 . 82368) (\INSUREBITSPERPIXEL 82370 . 82665) (MAXIMUMCOLOR 82667 . 82808) ( +OPPOSITECOLOR 82810 . 82989) (MAXIMUMSHADE 82991 . 83202) (OPPOSITESHADE 83204 . 83383) (\MEDW.BITBLT +83385 . 86762)) (86765 88194 (\READBINARYBITMAP 86775 . 87413) (\PRINTBINARYBITMAP 87415 . 88192)) ( +88196 93382 (FINISH-READING-BITMAP 88196 . 93382)) (94504 94985 (BITMAPBIT.EXPANDER 94514 . 94983)) ( +94986 143520 (\BITBLT.DISPLAY 94996 . 118235) (\BITBLT.BITMAP 118237 . 127336) (\BITBLT.MERGE 127338 + . 129591) (\BLTSHADE.DISPLAY 129593 . 136693) (\BLTSHADE.BITMAP 136695 . 143518)) (143521 152841 ( +\BITBLT.BITMAP.SLOW 143531 . 152839)) (152842 169223 (\PUNT.BLTSHADE.BITMAP 152852 . 159948) ( +\PUNT.BITBLT.BITMAP 159950 . 169221)) (169224 172664 (\SCALEDBITBLT.DISPLAY 169234 . 170867) ( +\BACKCOLOR.DISPLAY 170869 . 172662)) (176519 178792 (DISPLAYSTREAMP 176529 . 177137) (DSPSOURCETYPE +177139 . 178148) (DSPXOFFSET 178150 . 178469) (DSPYOFFSET 178471 . 178790)) (178793 192988 ( +DSPDESTINATION 178803 . 181906) (DSPTEXTURE 181908 . 182070) (\DISPLAYSTREAMINCRXPOSITION 182072 . +182359) (\SFFixDestination 182361 . 183539) (\SFFixClippingRegion 183541 . 185713) (\SFFixFont 185715 + . 186765) (\SFFIXLINELENGTH 186767 . 188263) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 188265 . 190078 +) (\SFFixY 190080 . 192986)) (192989 196836 (\SIMPLE.DSPCREATE 192999 . 193549) (\COMMON.DSPCREATE +193551 . 196834)) (196937 199131 (\MEDW.XOFFSET 196947 . 198088) (\MEDW.YOFFSET 198090 . 199129)) ( +199132 207062 (\DSPCLIPPINGREGION.DISPLAY 199142 . 199888) (\DSPFONT.DISPLAY 199890 . 202264) ( +\DISPLAY.PILOTBITBLT 202266 . 202415) (\DSPLINEFEED.DISPLAY 202417 . 202988) (\DSPLEFTMARGIN.DISPLAY +202990 . 203721) (\DSPOPERATION.DISPLAY 203723 . 204747) (\DSPRIGHTMARGIN.DISPLAY 204749 . 205594) ( +\DSPXPOSITION.DISPLAY 205596 . 206453) (\DSPYPOSITION.DISPLAY 206455 . 207060)) (211250 216286 ( +TTYDISPLAYSTREAM 211260 . 216284)) (216589 217619 (DSPSCROLL 216599 . 217299) (PAGEHEIGHT 217301 . +217617)) (217664 220686 (\DSPRESET.DISPLAY 217674 . 220684)) (220722 221245 (\MAYBE-DRIBBLE-CHAR +220722 . 221245)) (221246 241884 (\DSPPRINTCHAR 221256 . 229094) (\DSPPRINTCR/LF 229096 . 241882)) ( +241885 242477 (\TTYBACKGROUND 241895 . 242475)) (242478 245765 (DSPBACKUP 242488 . 245763)) (245949 +246205 (COLORDISPLAYP 245959 . 246203)) (246206 248277 (DISPLAYBEFOREEXIT 246216 . 247042) ( +DISPLAYAFTERENTRY 247044 . 248275)) (248649 253181 (\DSPCLIPTRANSFORMX 248659 . 249248) ( +\DSPCLIPTRANSFORMY 249250 . 249975) (\DSPTRANSFORMREGION 249977 . 250509) (\DSPUNTRANSFORMY 250511 . +250771) (\DSPUNTRANSFORMX 250773 . 251033) (\OFFSETCLIPPINGREGION 251035 . 253179)) (254495 257082 ( +UPDATESCREENDIMENSIONS 254505 . 255134) (\CreateScreenBitMap 255136 . 257080)) (257641 270800 ( +\CoerceToDisplayDevice 257651 . 258064) (\CREATEDISPLAY 258066 . 259906) (DISPLAYSTREAMINIT 259908 . +263052) (\STARTDISPLAY 263054 . 265965) (\MOVE.WINDOWS.ONTO.SCREEN 265967 . 268159) ( +\UPDATE.PBT.RASTERWIDTHS 268161 . 269943) (\STOPDISPLAY 269945 . 270437) (\DEFINEDISPLAYINFO 270439 . +270798)) (271408 272392 (INITIALIZEDISPLAYSTREAMS 271418 . 272390))))) STOP diff --git a/sources/LLDISPLAY.LCOM b/sources/LLDISPLAY.LCOM index 7aba939d9..6a366d3ee 100644 --- a/sources/LLDISPLAY.LCOM +++ b/sources/LLDISPLAY.LCOM @@ -1,9 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Jul-2023 14:50:58" ("compiled on " {WMEDLEY}LLDISPLAY.;19) -"31-Jul-2023 14:48:17" "COMPILE-FILEd" in "FULL 31-Jul-2023 ..." dated "31-Jul-2023 14:48:24") -(FILECREATED "31-Jul-2023 14:50:58" {WMEDLEY}LLDISPLAY.;19 270570 :EDIT-BY rmk :CHANGES-TO ( -FNS BITMAPEQUAL) :PREVIOUS-DATE "31-Jul-2023 14:45:32" {WMEDLEY}LLDISPLAY.;18) +(FILECREATED "27-Jul-2025 20:25:50" ("compiled on " +{DSK}kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25) "27-Jul-2025 13:59:31" +"COMPILE-FILEd" in "FULL 27-Jul-2025 ..." dated "27-Jul-2025 13:59:38") +(FILECREATED "27-Jul-2025 20:25:24" +{DSK}kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25 272767 :EDIT-BY rmk +:CHANGES-TO (VARS LLDISPLAYCOMS) :PREVIOUS-DATE "14-Jul-2025 22:06:59" +{DSK}kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;23) (RPAQQ LLDISPLAYCOMS ((DECLARE%: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE DISPLAYINFO) (MACROS \GETDISPLAYDATA))) (* ; "User-visible records are on ADISPLAY --- must be init'ed here") (INITRECORDS BITMAP PILOTBBT REGION @@ -14,12 +17,13 @@ WORDMASK 65535)))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITBITMASKS)))) (COMS (* \CreateCursorBitMap) (DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (CursorBitMap (\CreateCursorBitMap))))) ( COMS (* ; "bitmap functions.") (FNS BITBLT BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY BITMAPCREATE BITMAPBIT BITMAPEQUAL BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY -\INDICATESTRING \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP -\INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) (FUNCTIONS -FINISH-READING-BITMAP) (CONSTANTS (MINIMUMCOLOR 0) (MINIMUMSHADE 0)) (P (MOVD (QUOTE BITMAPBIT) (QUOTE - \BITMAPBIT))) (DECLARE%: DONTCOPY (EXPORT (MACROS \INVALIDATEDISPLAYCACHE))) (OPTIMIZERS BITMAPBIT -BITMAPP) (FNS BITMAPBIT.EXPANDER) (FNS \BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY -\BLTSHADE.BITMAP) (FNS (* ;; "For SunLoadup") \BITBLT.BITMAP.SLOW) (FNS (* ;; +\INDICATESTRING \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH BITMAPHEIGHT +READBITMAP \INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) ( +FNS \READBINARYBITMAP \PRINTBINARYBITMAP) (FUNCTIONS FINISH-READING-BITMAP) (CONSTANTS (MINIMUMCOLOR 0 +) (MINIMUMSHADE 0)) (P (MOVD (QUOTE BITMAPBIT) (QUOTE \BITMAPBIT))) (DECLARE%: DONTCOPY (EXPORT ( +MACROS \INVALIDATEDISPLAYCACHE))) (OPTIMIZERS BITMAPBIT BITMAPP) (FNS BITMAPBIT.EXPANDER) (FNS +\BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY \BLTSHADE.BITMAP) (FNS (* ;; +"For SunLoadup") \BITBLT.BITMAP.SLOW) (FNS (* ;; " punt case for C funcs.bitblt_bitmap,bitshade.bitmap") \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP) ( FNS (* ;; "from SUMEX-AIM") \SCALEDBITBLT.DISPLAY \BACKCOLOR.DISPLAY) (DECLARE%: DONTCOPY (CONSTANTS ( \DisplayWordAlign 16) (\MaxBitMapWidth 65535) (\MaxBitMapHeight 65535) (\MaxBitMapWords 131066)) ( @@ -192,7 +196,7 @@ BLTCHAR :D8 (42 \DISPLAYDATA 35 STREAM 24 OUTPUT) () \BLTCHAR :D8 -(P 0 A0229 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh b.Z@ABlH(11 \GETSTREAM) +(P 0 A0169 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh b.Z@ABlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () \MEDW.BLTCHAR :D8 @@ -205,10 +209,11 @@ BLTCHAR :D8 (256 \EM.DISPINTERRUPT 191 \TOPWDS 175 \EM.DISPINTERRUPT 167 \EM.DISPINTERRUPT 132 PILOTBBT) () \CHANGECHARSET.DISPLAY :D8 -(P 4 \INTERRUPTABLE P 2 BM P 1 CSINFO P 0 PBT I 1 CHARSET I 0 DISPLAYDATA) @*@ A A@ h "@I@I@I0@A>IHJn@'I -@@I @I -#JJ@BлHKHKh(98 \SFFixY 24 \CREATECHARSET) -(130 PILOTBBT 119 PILOTBBT) +(P 7 \INTERRUPTABLE P 5 BM P 4 CSINFO P 3 PBT I 1 CHARSET I 0 DISPLAYDATA) @*@ A@ AA@ +HIJJ"@L@L@L0@A>LKMn@'L +@@L @L +#MM@BоKNKNh(116 \SFFixY 30 \CREATECHARSET) +(148 PILOTBBT 137 PILOTBBT) () \INDICATESTRINGA0001 :D8 (NAME SI::*UNWIND-PROTECT* I 0 SI::*CLEANUP-FORMS* F 0 SI::*RESETFORMS* F 1 CHARCODE) Hgd gi @@ -220,17 +225,18 @@ BLTCHAR :D8 (75 ^ 52 %# 16 SI::RESETUNWIND) ( 81 "" 58 "") \SLOWBLTCHAR :D8 -(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 17 \SOFTCURSORP F 18 \SOFTCURSORUPP F 19 \CURSORDESTINATION F 20 \SCREENBITMAPS) K@@lYA0Zd Xdj~ J_JI\Jl A -J_JIؼJLOJ_J"dOOJ#LJػdKKJ*_NM O jM_NM_JIMO_JdkadlO_O_O_DdlO_O_O_$llO_lO_lO_ W"-W$ hA -W&_`_`jA`hA -W(A OOOOOOOjvO`O0J_JI_J @ @J h _ HdlZ;AOO +(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 20 \SOFTCURSORP F 21 \SOFTCURSORUPP F 22 \CURSORDESTINATION F 23 \SCREENBITMAPS) b@@lYA0Zd Xdj~ J_JI\Jl A +J_JIؼJLOJ_J"dOOJ#LJػdKKJ*_NM O jM_NM_JIMO_JdkadlO_O_O_DdlO_O_O_$llO_lO_lO_ W(-W* hA +W,_`_`jA`hA +W.A OOOOOOOjvO`O0J_JI_J @$J @@J +O"O$O&O&_ HdlZ;AOO O jJIAJO kOO O O Hn8AOO O jJIAJO JO -O O o h(583 ERROR 572 BKBITBLT 530 \DSPYPOSITION.DISPLAY 511 BKBITBLT 468 \DSPYPOSITION.DISPLAY 446 \CREATECHARSET 387 \SOFTCURSORUPCURRENT 352 \TOTOPWDS 342 DSPDESTINATION 325 \SOFTCURSORDOWN 294 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF) +O O o h(606 ERROR 595 BKBITBLT 553 \DSPYPOSITION.DISPLAY 534 BKBITBLT 491 \DSPYPOSITION.DISPLAY 453 \CREATECHARSET 387 \SOFTCURSORUPCURRENT 352 \TOTOPWDS 342 DSPDESTINATION 325 \SOFTCURSORDOWN 294 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF) (393 \EM.DISPINTERRUPT 332 \TOPWDS 316 \EM.DISPINTERRUPT 306 \EM.DISPINTERRUPT 111 \DISPLAYDATA 83 \DISPLAYDATA) -( 578 "Not implemented to rotate by other than 0, 90 or 270") +( 601 "Not implemented to rotate by other than 0, 90 or 270") TEXTUREP :D8 (I 0 OBJECT) @d3 @k@NIL (18 BITMAP 10 BITMAP) @@ -250,6 +256,11 @@ BITMAPWIDTH :D8 @ (35 \ILLEGAL.ARG 28 GETWINDOWPROP) (23 WIDTH 16 WINDOW 5 BITMAP) () +BITMAPHEIGHT :D8 +(I 0 BITMAP) +@@@@g +@ (40 \ILLEGAL.ARG 33 GETWINDOWPROP) +(28 HEIGHT 21 WINDOW 12 BITMAP 5 BITMAP) +() READBITMAP :D8 (P 6 BITSPERPIXEL P 5 W P 4 BM P 3 BASE P 2 STRM P 1 HEIGHT P 0 WIDTH I 0 FILE) @ @ go @ @ @g CJ dgdgk@ ^HlHIN \IjJ gjIdjtJ J l"QMdj@KjJ l@J l@ǿKkJ l@J l@ǿKkлkٰJ l"o hkٰJ J l)L(270 \INCCODE 263 SKIPSEPRS 250 ERROR 235 \INCCODE 214 \INCCODE 201 \INCCODE 187 \INCCODE 174 \INCCODE 155 \INCCODE 148 SKIPSEPRS 128 SKIPSEPRS 106 BITMAPCREATE 87 RATOM 61 SKIPSEPRS 52 GETSTREAM 41 RATOM 35 RATOM 28 ERROR 11 READC 5 SKIPSEPRS) @@ -278,7 +289,7 @@ OPPOSITESHADE :D8 NIL () \MEDW.BITBLT :D8 -(P 9 A0232 P 8 A0231 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0230 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS)  +(P 9 A0172 P 8 A0171 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0170 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS)   @ C o @Z@WCi Cgh 0H2HH2@ABCDEFGGGGGABlJCC@i !@gh 0AIصABIصBK2J_K2INOCDEFGGGGGNI"dLLOI$dMMlO@ @@ -288,6 +299,25 @@ NIL W@ K2L K2INOCDEFGGGGGNI"dLLOI$dMMlOo i(524 SHOULDNT 418 \TOTOPWDS 408 DSPDESTINATION 345 \GETSTREAM 330 WFROMDS 318 DSPDESTINATION 311 DSPDESTINATION 162 \GETSTREAM 147 WFROMDS 55 \GETSTREAM 43 WFROMDS 24 SHOULDNT 13 IMAGESTREAMP 5 IMAGESTREAMP) (494 \DISPLAYDATA 477 \DISPLAYDATA 451 \DISPLAYDATA 443 WINDOW 432 SCREEN 425 WINDOW 398 \TOPWDS 383 \DISPLAYDATA 367 \DISPLAYDATA 357 \DISPLAYDATA 350 STREAM 339 OUTPUT 284 \DISPLAYDATA 267 \DISPLAYDATA 241 \DISPLAYDATA 233 WINDOW 222 SCREEN 215 WINDOW 200 \DISPLAYDATA 184 \DISPLAYDATA 174 \DISPLAYDATA 167 STREAM 156 OUTPUT 127 BITMAP 92 WINDOW 83 SCREEN 76 WINDOW 67 \DISPLAYDATA 60 STREAM 49 OUTPUT 31 BITMAP) ( 519 "Invalid argument to \XW.BIBLT" 19 "Neither SOURCE nor DESTINATION is an imagestream.") +\READBINARYBITMAP :D8 +(P 3 BITMAP P 2 BPP P 1 BMH P 0 BMW I 0 STREAM) `@g +bd @ @ @ @ @ #HIJ [@KKIlM +>MNjOlLK(41 BITMAPCREATE 10 GETSTREAM) +(80 FDEV 73 STREAM 57 BITMAP 49 BITMAP 5 INPUT) +() +\PRINTBINARYBITMAP :D8 +(P 1 BMH P 0 STREAM I 1 STREAM I 0 BITMAP) Ag +q@@@ H@ ZK +JKl +H@ \I +LIl +H@ ]N +MNl +H@@Il +O +@_OOjOlO@(112 \BOUT 101 \BOUT 92 BITSPERPIXEL 84 \BOUT 73 \BOUT 64 BITMAPHEIGHT 56 \BOUT 45 \BOUT 36 BITMAPWIDTH 28 \ILLEGAL.ARG 10 GETSTREAM) +(152 FDEV 145 STREAM 128 BITMAP 120 BITMAP 19 BITMAP 5 OUTPUT) +() FINISH-READING-BITMAP :D8 (L (0 STREAM) F 29 *READ-SUPPRESS*) (@  HdoH YI[K]LkM_J3 L3 N3 OoH @@ -425,11 +455,11 @@ Q (145 ERASE 138 INVERT 121 INVERT 110 PAINT 99 ERASE 86 \DISPLAYDATA 77 \DISPLAYDATA 53 INVERT 43 INPUT 32 \DISPLAYDATA 23 \DISPLAYDATA 16 STREAM 5 OUTPUT) () DSPXOFFSET :D8 -(P 0 A0244 I 1 DISPLAYSTREAM I 0 XOFFSET) 'Agh b.\@AlH(11 \GETSTREAM) +(P 0 A0186 I 1 DISPLAYSTREAM I 0 XOFFSET) 'Agh b.\@AlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () DSPYOFFSET :D8 -(P 0 A0245 I 1 DISPLAYSTREAM I 0 YOFFSET) 'Agh b.^@AlH(11 \GETSTREAM) +(P 0 A0187 I 1 DISPLAYSTREAM I 0 YOFFSET) 'Agh b.^@AlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () DSPDESTINATION :D8 @@ -514,13 +544,13 @@ A (23 \DISPLAYDATA 16 STREAM 5 OUTPUT) ( 63 " is not a REGION.") \DSPFONT.DISPLAY :D8 -(P 3 \INTERRUPTABLE P 2 DD P 1 OLDFONT P 0 XFONT I 1 FONT I 0 DISPLAYSTREAM) {0@0Zd YAcA@i J giA - o XI7JH JjH -JH -jHh A@J -(119 \SFFixFont 105 \CREATECHARSET 62 ERROR 50 FONTCOPY 31 \COERCEFONTDESC) -(83 FONTDESCRIPTOR 41 NOERROR 17 \DISPLAYDATA 8 STREAM) -( 57 "FONT NOT FOUND OR ILLEGAL FONTCOPY PARAMETER") +(P 4 \INTERRUPTABLE P 2 DD P 1 OLDFONT P 0 XFONT I 1 FONT I 0 DISPLAYSTREAM) @@0Zd YAnAhdd@i J giA + o XI>JH JjH +JHHjH +[K A@J +(130 \SFFixFont 111 \CREATECHARSET 66 ERROR 54 FONTCOPY 35 FONTCREATE) +(87 FONTDESCRIPTOR 45 NOERROR 17 \DISPLAYDATA 8 STREAM) +( 61 "FONT NOT FOUND OR ILLEGAL FONTCOPY PARAMETER") \DISPLAY.PILOTBITBLT :D8 (I 1 N I 0 PILOTBBT) @AvNIL NIL @@ -594,7 +624,7 @@ NIL hI I H -ZH [d\K dj%@H +ZH [d \K dj%@H @JJmLk UdlZ@JL @J @@ -602,8 +632,8 @@ ZH @JJm o hdd@JJJJggH6 @i Md" .]d @Mo -h(297 PROCESS.EVAL 282 PROCESS.TTY 271 \INSUREWINDOW 259 WFROMDS 252 BKBITBLT 214 ERROR 203 \DSPYPOSITION.DISPLAY 184 \DSPXPOSITION.DISPLAY 158 \DSPYPOSITION.DISPLAY 148 \DSPXPOSITION.DISPLAY 129 \DSPYPOSITION.DISPLAY 106 \DSPXPOSITION.DISPLAY 61 WYOFFSET 55 WYOFFSET 48 WXOFFSET 42 WXOFFSET 32 WFROMDS 11 \GETSTREAM) -(243 REPLACE 238 TEXTURE 89 FONTDESCRIPTOR 80 FONTDESCRIPTOR 71 \DISPLAYDATA 25 \DISPLAYDATA 18 STREAM 5 OUTPUT) +h(297 PROCESS.EVAL 282 PROCESS.TTY 271 \INSUREWINDOW 259 WFROMDS 252 BKBITBLT 214 ERROR 203 \DSPYPOSITION.DISPLAY 184 \DSPXPOSITION.DISPLAY 158 \DSPYPOSITION.DISPLAY 148 \DSPXPOSITION.DISPLAY 129 \DSPYPOSITION.DISPLAY 106 \DSPXPOSITION.DISPLAY 80 FONTCREATE 61 WYOFFSET 55 WYOFFSET 48 WXOFFSET 42 WXOFFSET 32 WFROMDS 11 \GETSTREAM) +(243 REPLACE 238 TEXTURE 89 FONTDESCRIPTOR 71 \DISPLAYDATA 25 \DISPLAYDATA 18 STREAM 5 OUTPUT) ( 292 (SETQ \CURRENTDISPLAYLINE 0) 209 "only supported rotations are 0, 90 and 270") (RPAQ? *DRIBBLE-OUTPUT* NIL) expand-\MAYBE-DRIBBLE-CHAR :D8 @@ -655,14 +685,14 @@ expand-\MAYBE-DRIBBLE-CHAR :D8 DSPBACKUP :D8 (P 4 XPOS P 3 BLTWIDTH P 2 ROTATION P 1 FONT P 0 DD I 1 DISPLAYSTREAM I 0 WIDTH) fA Ag b Agh b0q@H\HٽdMM[H YHI jZKj`A Jdj0LKA -hjdAHHI KI -qlZ0hjdAHIHHjK^N5JnGhjdAHI HHK_OI +hjdAHHI KI +qlZ0hjdAHI HHjK^N5JnGhjdAHI HHK_OI Kgg i@Mj#Al Al Al -Mk]N(347 BOUT 338 BOUT 329 BOUT 310 BKBITBLT 147 DSPXPOSITION 130 \CARET.DOWN 41 \GETSTREAM 25 DISPLAYSTREAMP 18 GETSTREAM 5 DISPLAYSTREAMP) -(304 REPLACE 299 TEXTURE 291 FONTDESCRIPTOR 274 \DISPLAYDATA 268 \DISPLAYDATA 259 FONTDESCRIPTOR 251 \DISPLAYDATA 221 \DISPLAYDATA 215 \DISPLAYDATA 206 FONTDESCRIPTOR 198 \DISPLAYDATA 179 FONTDESCRIPTOR 169 FONTDESCRIPTOR 158 \DISPLAYDATA 123 \CARET.UP 104 FONTDESCRIPTOR 95 \DISPLAYDATA 86 \DISPLAYDATA 65 \DISPLAYDATA 55 \DISPLAYDATA 48 STREAM 35 OUTPUT 13 OUTPUT) +Mk]N(347 BOUT 338 BOUT 329 BOUT 310 BKBITBLT 291 FONTCREATE 259 FONTCREATE 206 FONTCREATE 179 FONTCREATE 169 FONTCREATE 147 DSPXPOSITION 130 \CARET.DOWN 41 \GETSTREAM 25 DISPLAYSTREAMP 18 GETSTREAM 5 DISPLAYSTREAMP) +(304 REPLACE 299 TEXTURE 274 \DISPLAYDATA 268 \DISPLAYDATA 251 \DISPLAYDATA 221 \DISPLAYDATA 215 \DISPLAYDATA 198 \DISPLAYDATA 158 \DISPLAYDATA 123 \CARET.UP 104 FONTDESCRIPTOR 95 \DISPLAYDATA 86 \DISPLAYDATA 65 \DISPLAYDATA 55 \DISPLAYDATA 48 STREAM 35 OUTPUT 13 OUTPUT) () (RPAQ? \CARET.UP) (RPAQQ BELLCNT 2) @@ -749,22 +779,22 @@ NIL () DISPLAYSTREAMINIT :D8 (P 2 TTYFONTHEIGHT P 1 TTYHEIGHT P 0 TTYFONT I 0 N F 3 TtyDisplayStream) chS -!H +!H Z`S S `@3LdJڹ`IS -H S +H S jS jd`IhS `S -J``Jlـ@(139 DSPRIGHTMARGIN 127 DSPCLIPPINGREGION 107 DSPXOFFSET 99 DSPYPOSITION 84 DSPYOFFSET 57 TERMINAL-OUTPUT 41 DSPDESTINATION 18 DSPFONT 9 DSPCREATE 4 \STARTDISPLAY) -(167 \LastTTYLines 155 SCREENHEIGHT 148 SCREENHEIGHT 133 SCREENWIDTH 115 SCREENWIDTH 91 FONTDESCRIPTOR 76 SCREENHEIGHT 62 \LastTTYLines 52 \TopLevelTtyWindow 47 \DEFAULTTTYDISPLAYSTREAM 35 ScreenBitMap 27 FONTDESCRIPTOR) +J``Jlـ@(139 DSPRIGHTMARGIN 127 DSPCLIPPINGREGION 107 DSPXOFFSET 99 DSPYPOSITION 91 FONTCREATE 84 DSPYOFFSET 57 TERMINAL-OUTPUT 41 DSPDESTINATION 27 FONTCREATE 18 DSPFONT 9 DSPCREATE 4 \STARTDISPLAY) +(167 \LastTTYLines 155 SCREENHEIGHT 148 SCREENHEIGHT 133 SCREENWIDTH 115 SCREENWIDTH 76 SCREENHEIGHT 62 \LastTTYLines 52 \TopLevelTtyWindow 47 \DEFAULTTTYDISPLAYSTREAM 35 ScreenBitMap) () \STARTDISPLAY :D8 -(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 WINDOWBACKGROUNDSHADE F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT F 9 \CURSORDESTRASTERWIDTH) <````AT> ````H HdI `` +(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 \CURSORDESTRASTERWIDTH F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT) @````AT> ````H HdI `` ` -ijd``hS7`c -`c`c`cHLV H :`S`S`dI ``h(287 \OPENW1 231 REVERSE 224 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS) -(312 \OLDSCREENWIDTH 307 SCREENWIDTH 302 \OLDSCREENHEIGHT 297 SCREENHEIGHT 271 SCREENHEIGHT 266 SCREEN 257 SCREENWIDTH 252 SCREEN 243 ScreenBitMap 238 SCREEN 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH) +ijd``hS;`c +`c`c`c HP` H :`S`S`dI ``h(291 \OPENW1 235 REVERSE 228 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS) +(316 \OLDSCREENWIDTH 311 SCREENWIDTH 306 \OLDSCREENHEIGHT 301 SCREENHEIGHT 275 SCREENHEIGHT 270 SCREEN 261 SCREENWIDTH 256 SCREEN 247 ScreenBitMap 242 SCREEN 223 WINDOWBACKGROUNDSHADE 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH) () \MOVE.WINDOWS.ONTO.SCREEN :D8 (P 4 REG P 3 YFACTOR P 2 XFACTOR P 1 W I 0 WINDOWS) @H+h&```Z``[@HAhYLLm`LLm`IiHXYd \Ii @@ -785,15 +815,15 @@ NIL (PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted)) (ADDTOVAR GLOBALVARS WHOLESCREEN) INITIALIZEDISPLAYSTREAMS :D8 -(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) Uodndh`ld +(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) Yodndh`ld gl -hdg cgkPh -c(80 FONTCLASS 63 FONTCREATE 38 BITMAPCREATE) -(70 DEFAULTFONT 57 DISPLAY 48 GACHA 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY) -( 4 -16383) +ohg cgkPh +c(84 FONTCLASS 67 FONTCREATE 38 BITMAPCREATE) +(74 DEFAULTFONT 61 DISPLAY 48 GACHA 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY) +( 55 (MEDIUM REGULAR REGULAR) 4 -16383) (RPAQQ \DisplayStarted NIL) (RPAQQ \LastTTYLines 12) (INITIALIZEDISPLAYSTREAMS) (DISPLAYSTREAMINIT 1000) -(PUTPROPS LLDISPLAY FILETYPE COMPILE-FILE) +(PUTPROPS LLDISPLAY FILETYPE :FAKE-COMPILE-FILE) NIL From b9f99131d128017c79f298b2ed8c491f631d0739 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 27 Jul 2025 22:33:54 -0700 Subject: [PATCH 6/7] MEDLEYFONTFORMAT More efficient store and read of numeric Interlisp arrays --- sources/MEDLEYFONTFORMAT | 914 ++++++++++++++++++++++++++++++++++ sources/MEDLEYFONTFORMAT.LCOM | Bin 0 -> 20840 bytes 2 files changed, 914 insertions(+) create mode 100644 sources/MEDLEYFONTFORMAT create mode 100644 sources/MEDLEYFONTFORMAT.LCOM diff --git a/sources/MEDLEYFONTFORMAT b/sources/MEDLEYFONTFORMAT new file mode 100644 index 000000000..d7acd0bb4 --- /dev/null +++ b/sources/MEDLEYFONTFORMAT @@ -0,0 +1,914 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "27-Jul-2025 22:22:23" {WMEDLEY}MEDLEYFONTFORMAT.;218 57699 + + :EDIT-BY rmk + + :CHANGES-TO (FNS MEDLEYFONT.READ.ITEM) + + :PREVIOUS-DATE "24-Jul-2025 22:07:35" {WMEDLEY}MEDLEYFONTFORMAT.;217) + + +(PRETTYCOMPRINT MEDLEYFONTFORMATCOMS) + +(RPAQQ MEDLEYFONTFORMATCOMS + [ + (* ;; "Eventually, MEDLEYFONT should be a package") + + + (* ;; "Main public entries") + + (FNS MEDLEYFONT.WRITE.FONT MEDLEYFONT.GETCHARSET MEDLEYFONT.CHARSET? MEDLEYFONT.GETFILEPROP + MEDLEYFONT.FILEP) + + (* ;; "Reading") + + (FNS MEDLEYFONT.READ.FONT MEDLEYFONT.READ.CHARSET MEDLEYFONT.READ.ITEM MEDLEYFONT.PEEK.ITEM + MEDLEYFONT.READ.FONTPROPS MEDLEYFONT.READ.VERIFIEDFONT) + + (* ;; "Writing") + + (FNS MEDLEYFONT.WRITE.CHARSET MEDLEYFONT.WRITE.ITEM MEDLEYFONT.WRITE.FONTPROPS + MEDLEYFONT.WRITE.HEADER) + (FNS MEDLEYFONT.FILENAME) + (ADDVARS (DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT) + (DISPLAYCHARSETFNS (MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET)) + (INTERPRESSFONTEXTENSIONS MEDLEYINTERPRESSFONT)) + (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (PRINTDATA 0) + (SMALLPDATA 1) + (BITMAPDATA 2) + (WORDBLOCKDATA 3) + (CLARRAYDATA 4) + (FIXPDATA 5) + (ILPOINTERARRAY 6) + (ILNUMBERARRAY 11) + (HPRINTDATA 7) + (ALISTDATA 8) + (PLISTDATA 9) + (LISTDATA 10]) + + + +(* ;; "Eventually, MEDLEYFONT should be a package") + + + + +(* ;; "Main public entries") + +(DEFINEQ + +(MEDLEYFONT.WRITE.FONT + [LAMBDA (FONT FILE CHARSETNOS OTHERFONTPROPS NOINDIRECTS) (* ; "Edited 15-Jul-2025 16:43 by rmk") + (* ; "Edited 9-Jul-2025 09:32 by rmk") + (* ; "Edited 19-Jun-2025 10:59 by rmk") + (* ; "Edited 9-Jun-2025 12:17 by rmk") + (* ; "Edited 25-May-2025 20:48 by rmk") + (* ; "Edited 23-May-2025 14:59 by rmk") + (* ; "Edited 22-May-2025 09:58 by rmk") + (* ; "Edited 16-May-2025 20:17 by rmk") + (* ; "Edited 14-May-2025 17:45 by rmk") + (SETQ FONT (FONTCREATE FONT)) + (CL:UNLESS FILE + (SETQ FILE (MEDLEYFONT.FILENAME FONT CHARSETNOS))) + (SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS))) + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) + (MEDLEYFONT.WRITE.HEADER STREAM OTHERFONTPROPS) + (LET ((CHARSETLOCS (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT 0)) + (FONTCHARENCODING (FONTPROP FONT 'CHARENCODING)) + (*READTABLE* (FIND-READTABLE "INTERLISP")) + CSVECTORPTRLOC CSVECTORLOC FILECHARSETS) + + (* ;; "Figure out the actual non empty/sluggish charsets that will be wrtitten.") + + (SETQ FILECHARSETS (for CSNO CSINFO from 0 to \MAXCHARSET + when (OR (NULL CHARSETNOS) + (MEMB CSNO CHARSETNOS)) + when (SETQ CSINFO (\XGETCHARSETINFO FONT CSNO)) + unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CSNO)) + (CL:UNLESS FILECHARSETS (ERROR "No character sets to write" FONT)) + + (* ;; "Right after the header, leave 4 bytes for the pointer to the charset dispatch vector. If writing a single charset, we store the negative of the byte location so we can still easily skip the font properties without writing the whole vector. The byte in front of the single charset holds its number.") + + (* ;; "") + + (SETQ CSVECTORPTRLOC (GETFILEPTR STREAM)) (* ; + "Ptr is before fontproperties, vector is after") + (\FIXPOUT STREAM 0) + (MEDLEYFONT.WRITE.FONTPROPS STREAM FONT) + (if (CDR FILECHARSETS) + then (PRINTOUT STREAM "CHARSET LOCATIONS" T) + (* ; + "Allocate the vector space if multiple") + (SETQ CSVECTORLOC (GETFILEPTR STREAM)) + (for I from 0 to \MAXCHARSET do (\FIXPOUT STREAM 0)) + (TERPRI STREAM) + (for CSNO in FILECHARSETS do + + (* ;; + "LOC remains zero for missing charsets, slug properties are determined by font-level properties.") + + (CL:SETF (CL:SVREF CHARSETLOCS CSNO) + (GETFILEPTR STREAM)) + (MEDLEYFONT.WRITE.CHARSET FONT CSNO STREAM + NOINDIRECTS)) + (SETFILEPTR STREAM CSVECTORLOC) + (for CSNO from 0 to \MAXCHARSET do (\FIXPOUT STREAM (CL:SVREF CHARSETLOCS + CSNO))) + else + (* ;; "Only one. The %"vector%" is the charset byte immediately before the charset, the sign bit tells the tale.") + + (SETQ CSVECTORLOC (IMINUS (GETFILEPTR STREAM))) + (BOUT STREAM (CAR FILECHARSETS)) + (MEDLEYFONT.WRITE.CHARSET FONT (CAR FILECHARSETS) + STREAM NOINDIRECTS)) + (SETFILEPTR STREAM CSVECTORPTRLOC) + (\FIXPOUT STREAM CSVECTORLOC) (* ; + "Pointer to the charset dispatch vector--or negative of actual location for a singleton") + (FULLNAME STREAM]) + +(MEDLEYFONT.GETCHARSET + [LAMBDA (STREAM CHARSET) (* ; "Edited 15-Jul-2025 17:09 by rmk") + (* ; "Edited 9-Jul-2025 15:45 by rmk") + (* ; "Edited 14-May-2025 17:46 by rmk") + + (* ;; "If open, assume its a medleyfont stream, that the initial Me etc. has been checked, and we are positioned after the header information") + + (CL:UNLESS (<= 0 CHARSET \MAXCHARSET) + (\ILLEGAL.ARG CHARSET)) + (RESETLST + (CL:UNLESS (\GETSTREAM STREAM 'INPUT T) + [RESETSAVE (SETQ STREAM (OPENSTREAM STREAM 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE] + (CL:UNLESS (MEDLEYFONT.FILEP STREAM) (* ; + "Checks and positions, if reopening.") + (ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM)))) + (LET ((CSVECTORLOC (\FIXPIN STREAM)) + CSLOC) + + (* ;; "We know now that this file has information about the requested charset, including NIL entries for empty/slugglish ones in the middle of populated ones. A file that would have contain a single empty/sluggish charset cannot be created--the caller would recognize the case of a missing file and provide either NIL or a slug-vector.") + + (CL:WHEN (if (ILESSP CSVECTORLOC 0) + then + (* ;; "File contains only one charset. Is it the one we want? If the intended charset is empty/sluggish, the file would not have been constructed and we wouldn't be here.") + + (SETFILEPTR STREAM (IMINUS CSVECTORLOC)) + (EQ CHARSET (BIN STREAM)) + else + (* ;; "The vector-entry points to the one we want. Is it there?") + + (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CHARSET BYTESPERCELL))) + (CL:UNLESS (EQ 0 (SETQ CSLOC (\FIXPIN STREAM))) + (SETFILEPTR STREAM CSLOC))) + (MEDLEYFONT.READ.CHARSET STREAM CHARSET))))]) + +(MEDLEYFONT.CHARSET? + [LAMBDA (FILE CHARSET) (* ; "Edited 15-Jul-2025 15:21 by rmk") + (* ; "Edited 25-May-2025 20:53 by rmk") + (* ; "Edited 21-May-2025 11:35 by rmk") + (* ; "Edited 17-May-2025 11:29 by rmk") + (* ; "Edited 14-May-2025 17:46 by rmk") + + (* ;; "If CHARSET, returns CHARSET if FILE contains a non-slug entry for CHARSET. If not CHARSET, returns the list of non-slug charsets in FILE.") + + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) + (CL:UNLESS (MEDLEYFONT.FILEP STREAM) + (ERROR "Not a MEDLEYFONT file" FILE)) + (LET ((CSVECTORLOC (\FIXPIN STREAM))) + (CL:WHEN (if (ILESSP CSVECTORLOC 0) + then + (* ;; "File contains only one charse, is it the one we want? ") + + (SETFILEPTR STREAM (IMINUS CSVECTORLOC)) + (EQ CHARSET (BIN STREAM)) + else (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CHARSET BYTESPERCELL))) + (NEQ 0 (\FIXPIN STREAM))) + CHARSET]) + +(MEDLEYFONT.GETFILEPROP + [LAMBDA (FILE PROP) (* ; "Edited 15-Jul-2025 20:21 by rmk") + (* ; "Edited 10-Jul-2025 17:50 by rmk") + (* ; "Edited 25-May-2025 20:53 by rmk") + (* ; "Edited 21-May-2025 11:36 by rmk") + (* ; "Edited 17-May-2025 19:07 by rmk") + (* ; "Edited 14-May-2025 17:46 by rmk") + (CL:UNLESS (OR (LITATOM FILE) + (STRINGP FILE)) + [SETQ FILE (CAR (APPLY (FUNCTION FONTFILES) + (FONTPROP (FONTCREATE FILE) + 'SPEC]) + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) + (LET (HEADERPROPS CSVECTORLOC) + (CL:UNLESS (SETQ HEADERPROPS (MEDLEYFONT.FILEP STREAM)) + (ERROR "Not a MEDLEYFONT file" (FULLNAME STREAM))) + (SETQ CSVECTORLOC (\FIXPIN STREAM)) + (SELECTQ PROP + (OTHERPROPS (CDDR HEADERPROPS)) + (DATE (CADR HEADERPROPS)) + (FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM)) + (CHARSETS (if (ILESSP CSVECTORLOC 0) + then + (* ;; "File contains only one charset ") + + (SETFILEPTR STREAM (IMINUS CSVECTORLOC)) + (CONS (BIN STREAM)) + else (SETFILEPTR STREAM CSVECTORLOC) + (for CS from 0 to \MAXCHARSET unless (EQ 0 (\FIXPIN STREAM)) + collect CS))) + (ERROR "Unknown MEDLEYFONT property"]) + +(MEDLEYFONT.FILEP + [LAMBDA (FILE) (* ; "Edited 6-Jul-2025 11:44 by rmk") + (* ; "Edited 10-Jun-2025 18:19 by rmk") + (* ; "Edited 8-Jun-2025 22:55 by rmk") + (* ; "Edited 25-May-2025 20:54 by rmk") + (* ; "Edited 21-May-2025 11:37 by rmk") + (* ; "Edited 16-May-2025 21:58 by rmk") + (* ; "Edited 14-May-2025 17:00 by rmk") + + (* ;; "Me in first 2 bytes distinguishes MEDLEYFONT format from others. This may be called after the first 2 bytes have been read to verify the %"Me%", if not we skip over it here.") + + (* ;; "For a valid file, returns (fullname date)") + + (* ;; "If FILE is an open stream, it is left open. Otherwise it is opened and closed.") + + (RESETLST + [LET (STREAM VERSION DATE) + [if (\GETSTREAM FILE 'INPUT T) + then (SETQ STREAM FILE) + else (RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE] + (CL:UNLESS (ZEROP (GETFILEPTR STREAM)) + (SETFILEPTR STREAM 0)) + (CL:WHEN (for C in (CONSTANT (CHCON "Medley font")) always (EQ C (READCCODE STREAM))) + [CAR (NLSETQ [CL:WHEN (EQ 0 (SETQ VERSION (MEDLEYFONT.READ.ITEM STREAM 'VERSION] + `(,(FULLNAME STREAM) + ,(MEDLEYFONT.READ.ITEM STREAM 'DATE) + ,VERSION + ,@(MEDLEYFONT.READ.ITEM STREAM 'OTHERFONTPROPS])])]) +) + + + +(* ;; "Reading") + +(DEFINEQ + +(MEDLEYFONT.READ.FONT + [LAMBDA (FILE CHARSETNOS FONT) (* ; "Edited 15-Jul-2025 20:20 by rmk") + (* ; "Edited 9-Jul-2025 00:06 by rmk") + (* ; "Edited 6-Jul-2025 11:45 by rmk") + (CL:UNLESS FILE (SETQ FILE FONT)) + (CL:WHEN (OR (type? FONTDESCRIPTOR FILE) + (LISTP FILE)) + (SETQ FILE (MEDLEYFONT.FILENAME FILE))) + (SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS))) + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) + (CL:UNLESS (MEDLEYFONT.FILEP STREAM) + (ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM))) + (LET ((*READTABLE* (FIND-READTABLE "INTERLISP")) + FONTCHARSETVECTOR CSVECTORLOC NOTFOUND SINGLECS) + (SETQ CSVECTORLOC (\FIXPIN STREAM)) (* ; + "Byte location of the charset dispatch vector") + + (* ;; "We know now that this file has information about all requested charsets, including NIL entries for empty/slugglish ones in the middle of populated ones. A file that would have contain a single empty/sluggish charset cannot be created--the caller would recognize the case of a missing file and provide either NIL or a slug-vector.") + + (SETQ FONT (MEDLEYFONT.READ.VERIFIEDFONT STREAM FONT)) + (SETQ FONTCHARSETVECTOR (fetch (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONT)) + (CL:UNLESS (EQ CSVECTORLOC 0) (* ; "Not empty") + [if (ILESSP CSVECTORLOC 0) + then + (* ;; + "File contains only one charset and it's the one we want. Its CHARSET number is in the first byte.") + + (* ;; "If the intended charset is empty/sluggish, the file would not have been constructed and we wouldn't be here.") + + (SETFILEPTR STREAM (IMINUS CSVECTORLOC)) + (SETQ SINGLECS (BIN STREAM)) + (CL:WHEN CHARSETNOS + (CL:UNLESS (AND (EQ SINGLECS (CAR CHARSETNOS)) + (NULL (CDR CHARSETNOS))) + (ERROR (CONCAT FILE + " does not contain information for charsets 4" + (REMOVE SINGLECS CHARSETNOS))))) + (\SETCHARSETINFO FONTCHARSETVECTOR SINGLECS (MEDLEYFONT.READ.CHARSET + STREAM SINGLECS)) + else + (* ;; + "Gather all of the CSLOCS before reading, so that we always move forward") + + (for CSNO CSLOC + in (OR CHARSETNOS (for I from 0 to \MAXCHARSET collect I)) + eachtime (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CSNO + BYTESPERCELL))) + (SETQ CSLOC (\FIXPIN STREAM)) + (CL:WHEN (ZEROP CSLOC) + (push NOTFOUND CSNO)) unless (ZEROP CSLOC) + collect (CONS CSNO CSLOC) + finally (CL:WHEN (AND CHARSETNOS NOTFOUND) + (ERROR FILE (CONCAT + " does not contain information for charsets " + (DREVERSE NOTFOUND)))) + (for X CS in $$VAL do (SETQ CSNO (CAR X)) + (SETFILEPTR STREAM (CDR X)) + (\SETCHARSETINFO FONTCHARSETVECTOR CSNO + (MEDLEYFONT.READ.CHARSET STREAM CSNO + ]) + FONT]) + +(MEDLEYFONT.READ.CHARSET + [LAMBDA (STREAM CHARSET) (* ; "Edited 15-Jul-2025 11:27 by rmk") + (* ; "Edited 9-Jul-2025 19:33 by rmk") + (* ; "Edited 6-Jul-2025 10:11 by rmk") + (* ; "Edited 25-May-2025 20:54 by rmk") + (* ; "Edited 23-May-2025 11:01 by rmk") + (* ; "Edited 21-May-2025 16:25 by rmk") + (* ; "Edited 16-May-2025 20:19 by rmk") + (* ; "Edited 14-May-2025 10:43 by rmk") + (* ; "Edited 12-May-2025 07:55 by rmk") + (MEDLEYFONT.READ.ITEM STREAM 'CHARSETSTRING) (* ; + "Throwaway for looking with text editor") + (LET (CSNO INDIRECT) + (CL:UNLESS [EQ CHARSET (SETQ CSNO (MEDLEYFONT.READ.ITEM STREAM 'CHARSET] + (ERROR "Charset mismatch" (LIST CHARSET CSNO))) + (if [EQ 'INDIRECTCHARSET (CAR (SETQ INDIRECT (MEDLEYFONT.PEEK.ITEM STREAM] + then (* ; + "Read a complete charset from another file (e.g. shared Kanji)") + (MEDLEYFONT.READ.ITEM STREAM 'INDIRECTCHARSET) + (APPLY (FUNCTION \READCHARSET) + (CADR INDIRECT)) + else (bind PAIR LABEL ITEM (CSINFO _ (create CHARSETINFO + WIDTHS _ NIL + OFFSETS _ NIL)) eachtime (SETQ PAIR + ( + MEDLEYFONT.READ.ITEM + STREAM)) + (SETQ LABEL (CAR PAIR)) + (SETQ ITEM (CADR PAIR)) + until (EQ LABEL 'STOP) do (SELECTQ LABEL + (WIDTHS (replace (CHARSETINFO WIDTHS) of CSINFO + with ITEM)) + (OFFSETS (replace (CHARSETINFO OFFSETS) of CSINFO + with ITEM)) + (IMAGEWIDTHS (replace (CHARSETINFO IMAGEWIDTHS) + of CSINFO with ITEM)) + (YWIDTHS (replace (CHARSETINFO YWIDTHS) of CSINFO + with ITEM)) + (ASCENT (replace (CHARSETINFO CHARSETASCENT) + of CSINFO with ITEM)) + (DESCENT (replace (CHARSETINFO CHARSETDESCENT) + of CSINFO with ITEM)) + (LEFTKERN (replace (CHARSETINFO LEFTKERN) + of CSINFO with ITEM)) + (BITMAP (replace (CHARSETINFO CHARSETBITMAP) + of CSINFO with ITEM)) + (CSINFOPROPS (replace (CHARSETINFO CSINFOPROPS) + of CSINFO with ITEM)) + (CSCOMPLETEP (replace (CHARSETINFO CSCOMPLETEP) + of CSINFO with ITEM)) + (HELP "Unrecognized charsetinfo label'" LABEL)) + finally (CL:UNLESS (fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO) + (replace (CHARSETINFO IMAGEWIDTHS) of CSINFO + with (fetch (CHARSETINFO WIDTHS) of CSINFO))) + (RETURN CSINFO]) + +(MEDLEYFONT.READ.ITEM + [LAMBDA (STREAM LABEL?) (* ; "Edited 27-Jul-2025 22:22 by rmk") + (* ; "Edited 24-Jul-2025 22:07 by rmk") + (* ; "Edited 14-Jul-2025 15:47 by rmk") + + (* ;; "Reads and returns the (label data) that starts at the current position in STREAM according to its storage type. If LABEL? is provided, error if the data read does not have that label. ") + + (LET + [(ITEM (GETSTREAMPROP STREAM 'MEDLEYFONT.PEEKEDITEM] + (if ITEM + then (PUTSTREAMPROP STREAM 'MEDLEYFONT.PEEKEDITEM NIL) + else (LET ((*READTABLE* (FIND-READTABLE 'INTERLISP)) + (*PACKAGE* (CL:FIND-PACKAGE 'INTERLISP)) + LABEL NELTS) + (SETQ LABEL (RATOM STREAM)) + (READCCODE STREAM) + [SETQ ITEM + (LIST LABEL (SELECTC (BIN STREAM) + (SMALLPDATA (\WIN STREAM)) + (FIXPDATA (\FIXPIN STREAM)) + (PRINTDATA (READ STREAM)) + (ALISTDATA (bind X until [EQ 'STOP (CAR (SETQ X ( + MEDLEYFONT.READ.ITEM + STREAM] + collect (CONS (CAR X) + (CADR X)))) + (PLISTDATA (bind X until [EQ 'STOP (CAR (SETQ X ( + MEDLEYFONT.READ.ITEM + STREAM] + join X)) + (LISTDATA (bind ELT until [EQ 'STOP (CAR (SETQ ELT ( + MEDLEYFONT.READ.ITEM + STREAM] + collect (CADR ELT) + finally (CL:WHEN (CADR ELT) + (NCONC $$VAL ELT)))) + (BITMAPDATA (\READBINARYBITMAP STREAM)) + (CLARRAYDATA (LET [[ARRAY (CL:MAKE-ARRAY (READ STREAM) + :ELEMENT-TYPE + (MEDLEYFONT.READ.ITEM STREAM + 'ELEMENT-TYPE] + (ALLFIXED (EQ 1 (BIN STREAM] + (for I from 0 to (\FIXPIN STREAM) + do [CL:SETF (XCL:ROW-MAJOR-AREF ARRAY I) + (CL:IF ALLFIXED + (\FIXPIN STREAM) + (CADR (MEDLEYFONT.READ.ITEM + STREAM)))] + finally (RETURN ARRAY)))) + (ILPOINTERARRAY + (LET [(NELTS (\FIXPIN STREAM)) + (ORIG (BIN STREAM)) + (ALLFIXED (EQ 1 (BIN STREAM] + (for I (ARRAY _ (ARRAY NELTS NIL NIL ORIG)) from ORIG + to (CL:IF (EQ ORIG 1) + NELTS + (SUB1 NELTS)) + do (SETA ARRAY I (CL:IF ALLFIXED + (\FIXPIN STREAM) + (MEDLEYFONT.READ.ITEM STREAM I))) + finally (RETURN ARRAY)))) + (ILNUMBERARRAY (LET ((NELTS (\FIXPIN STREAM)) + (ORIG (BIN STREAM))) + (AIN (ARRAY NELTS (MEDLEYFONT.READ.ITEM + STREAM + 'ARRAYTYP) + NIL ORIG) + ORIG NELTS STREAM))) + (WORDBLOCKDATA (LET* [(NWORDS (\FIXPIN STREAM)) + (BLOCK (\ALLOCBLOCK (FOLDHI NWORDS + WORDSPERCELL] + (\BINS STREAM BLOCK 0 (UNFOLD NWORDS + BYTESPERWORD)) + BLOCK)) + (HPRINTDATA (HREAD STREAM)) + (SHOULDNT "UNKNOWN MEDLEYFONT DATA TYPE"] + (* ; "Skip the EOL") + (READCCODE STREAM))) + (CL:WHEN (AND LABEL? (NEQ LABEL? (CAR ITEM))) + (ERROR (CONCAT LABEL? " item not found") + ITEM)) + (CL:IF LABEL? + (CADR ITEM) + ITEM)]) + +(MEDLEYFONT.PEEK.ITEM + [LAMBDA (STREAM LABEL?) (* ; "Edited 6-Jul-2025 14:10 by rmk") + + (* ;; "If previously peeked and not read, returns that item. Otherwise calls the reader to get the new item. We always record the (LABEL DATA pair)") + + (LET [(PEEKEDITEM (GETSTREAMPROP STREAM 'MEDLEYFONT.PEEKEDITEM] + (CL:UNLESS PEEKEDITEM + (PUTSTREAMPROP STREAM 'MEDLEYFONT.PEEKEDITEM (SETQ PEEKEDITEM (MEDLEYFONT.READ.ITEM + STREAM)))) + (CL:WHEN (AND LABEL? (NEQ LABEL? (CAR PEEKEDITEM))) + (ERROR (CONCAT "Peeked " (CAR PEEKEDITEM) + " instead of " LABEL?) + PEEKEDITEM)) + (CL:IF LABEL? + (CADR PEEKEDITEM) + PEEKEDITEM)]) + +(MEDLEYFONT.READ.FONTPROPS + [LAMBDA (STREAM) (* ; "Edited 25-May-2025 20:55 by rmk") + (* ; "Edited 16-May-2025 21:58 by rmk") + (* ; "Edited 14-May-2025 09:11 by rmk") + (bind PAIR until [EQ 'STOP (CAR (SETQ PAIR (MEDLEYFONT.READ.ITEM STREAM] collect PAIR]) + +(MEDLEYFONT.READ.VERIFIEDFONT + [LAMBDA (STREAM FONT) (* ; "Edited 10-Jun-2025 20:57 by rmk") + (* ; "Edited 21-May-2025 22:55 by rmk") + (* ; "Edited 19-May-2025 17:42 by rmk") + (* ; "Edited 16-May-2025 10:28 by rmk") + (LET ((FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM))) + [if FONT + then (* ; "compare/verify") + (for P in FONTPROPS unless (EQUAL (CADR P) + (RECORDACCESS (CAR P) + FONT NIL 'FETCH)) + do (ERROR "Mismatching font property" P)) + else (SETQ FONT (create FONTDESCRIPTOR)) (* ; "Construct") + (for P VAL in FONTPROPS do (SETQ VAL (CADR P)) + (SELECTQ (CAR P) + (FONTDEVICE (replace (FONTDESCRIPTOR FONTDEVICE) + of FONT with VAL)) + (FONTCOMPLETEP (replace (FONTDESCRIPTOR FONTCOMPLETEP) + of FONT with VAL)) + (FONTFAMILY (replace (FONTDESCRIPTOR FONTFAMILY) + of FONT with VAL)) + (FONTSIZE (replace (FONTDESCRIPTOR FONTSIZE) + of FONT with VAL)) + (FONTFACE (replace (FONTDESCRIPTOR FONTFACE) + of FONT with VAL)) + (\SFAscent (replace (FONTDESCRIPTOR \SFAscent) + of FONT with VAL)) + (\SFDescent (replace (FONTDESCRIPTOR \SFDescent) + of FONT with VAL)) + (\SFHeight (replace (FONTDESCRIPTOR \SFHeight) + of FONT with VAL)) + (ROTATION (replace (FONTDESCRIPTOR ROTATION) + of FONT with VAL)) + (FONTDEVICESPEC + (replace (FONTDESCRIPTOR FONTDEVICESPEC) + of FONT with VAL)) + (OTHERDEVICEFONTPROPS + (replace (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) + of FONT with VAL)) + (FONTSCALE (replace (FONTDESCRIPTOR FONTSCALE) + of FONT with VAL)) + (\SFFACECODE (replace (FONTDESCRIPTOR \SFFACECODE) + of FONT with VAL)) + (FONTAVGCHARWIDTH + (replace (FONTDESCRIPTOR FONTAVGCHARWIDTH) + of FONT with VAL)) + (FONTCHARENCODING + (replace (FONTDESCRIPTOR FONTCHARENCODING) + of FONT with VAL)) + (FONTCHARSETVECTOR + (replace (FONTDESCRIPTOR FONTCHARSETVECTOR) + of FONT with VAL)) + (FONTHASLEFTKERNS + (replace (FONTDESCRIPTOR FONTHASLEFTKERNS) + of FONT with VAL)) + (FONTEXTRAFIELD2 + (replace (FONTDESCRIPTOR FONTEXTRAFIELD2) + of FONT with VAL)) + (HELP "UNKNOWN FONTDESCRIPTOR PROPERTY: P"] + FONT]) +) + + + +(* ;; "Writing") + +(DEFINEQ + +(MEDLEYFONT.WRITE.CHARSET + [LAMBDA (FONT CHARSET STREAM NOINDIRECTS) (* ; "Edited 9-Jul-2025 19:14 by rmk") + (* ; "Edited 25-May-2025 20:49 by rmk") + (* ; "Edited 22-May-2025 09:58 by rmk") + (* ; "Edited 16-May-2025 20:18 by rmk") + (* ; "Edited 13-May-2025 23:26 by rmk") + + (* ;; "This outputs the characterset info for CHARSET in FONT.") + + (LET ((CSINFO (\INSURECHARSETINFO CHARSET FONT)) + CSCHARENCODING) + (MEDLEYFONT.WRITE.ITEM STREAM 'CHARSETSTRING (MKSTRING CHARSET)) + (* ; "For human file-scan") + (MEDLEYFONT.WRITE.ITEM STREAM 'CHARSET CHARSET) + (CL:UNLESS (OR (NULL CSINFO) + (fetch (CHARSETINFO CSSLUGP) of CSINFO)) + (* ; + "Slug info is determined by FONT properties") + + (* ;; "Copy the fonts charencoding down to each charset info so that it is available when the charsetinfo is read. The fontdescriptor isn't available at that point and coercion could lead to fonts of different encodings. At least this would make it possible to fix things up.") + + (if (CL:UNLESS NOINDIRECTS (INDIRECTCHARSETP CSINFO FONT CHARSET)) + then + (* ;; + "This charset is is taken entirely from on another file, no need to copy it to this file.") + + (MEDLEYFONT.WRITE.ITEM STREAM 'INDIRECTCHARSET (GETMULTI (fetch (CHARSETINFO + CSINFOPROPS) + of CSINFO) + 'SOURCE) + NIL + 'PRINT) + else (MEDLEYFONT.WRITE.ITEM STREAM 'CSINFOPROPS (fetch (CHARSETINFO CSINFOPROPS) + of CSINFO) + NIL + 'ALIST) + (MEDLEYFONT.WRITE.ITEM STREAM 'WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) + (CL:UNLESS [OR (EQ (fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO) + (fetch (CHARSETINFO WIDTHS) of CSINFO)) + (for I (W _ (fetch (CHARSETINFO WIDTHS) of CSINFO)) + (IM _ (fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO)) + from 0 to (SUB1 (IPLUS \MAXTHINCHAR 3)) + always (EQ (\GETBASE W I) + (\GETBASE IM I] + (MEDLEYFONT.WRITE.ITEM STREAM 'IMAGEWIDTHS (fetch (CHARSETINFO IMAGEWIDTHS) + of CSINFO))) + (MEDLEYFONT.WRITE.ITEM STREAM 'OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'YWIDTHS (fetch (CHARSETINFO YWIDTHS) of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'ASCENT (fetch (CHARSETINFO CHARSETASCENT) + of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'DESCENT (fetch (CHARSETINFO CHARSETDESCENT) + of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'LEFTKERN (fetch (CHARSETINFO LEFTKERN) + of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'BITMAP (fetch (CHARSETINFO CHARSETBITMAP) + of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'CSCOMPLETEP (fetch (CHARSETINFO CSCOMPLETEP) + of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'STOP T)))]) + +(MEDLEYFONT.WRITE.ITEM + [LAMBDA (STREAM LABEL ITEM EVENIFNIL TYPE BLOCKNELTS) (* ; "Edited 24-Jul-2025 22:07 by rmk") + (* ; "Edited 15-Jul-2025 11:06 by rmk") + (* ; "Edited 8-Jul-2025 23:03 by rmk") + (* ; "Edited 20-Jun-2025 11:10 by rmk") + (* ; "Edited 8-Jun-2025 21:14 by rmk") + (* ; "Edited 25-May-2025 20:48 by rmk") + (* ; "Edited 23-May-2025 10:58 by rmk") + (* ; "Edited 22-May-2025 10:31 by rmk") + (* ; "Edited 17-May-2025 10:10 by rmk") + (* ; "Edited 14-May-2025 00:07 by rmk") + + (* ;; "Writes ITEM preceded by LABEL. BLOCKNELTS overrides the default for array blocks, because of the uncertainty/complexity in determining arrayblock length.") + + (LET [(*READTABLE* (FIND-READTABLE 'INTERLISP)) + (*PACKAGE* (CL:FIND-PACKAGE 'INTERLISP] + (CL:WHEN (OR ITEM EVENIFNIL) + (PRIN2 LABEL STREAM) + (PRIN1 " " STREAM) + (SELECTQ (OR TYPE (TYPENAME ITEM)) + (SMALLP (BOUT STREAM SMALLPDATA) + (\WOUT STREAM ITEM)) + (FIXP (* ; "Must come after SMALLP") + (BOUT STREAM FIXPDATA) + (\FIXPOUT STREAM ITEM)) + ((LITATOM STRINGP PRINT) + (BOUT STREAM PRINTDATA) (* ; + "A printable Lisp object, even some lists (below)") + (PRIN2 ITEM STREAM)) + (LISTP [if (for TAIL on ITEM always (ATOM (CAR TAIL)) + finally + + (* ;; "Check the final CDR.") + + (CL:UNLESS (ATOM TAIL) + (RETURN NIL))) + then (BOUT STREAM PRINTDATA) (* ; "More compact for simple lists.") + (PRIN2 ITEM STREAM) + else (BOUT STREAM LISTDATA) + (for TAIL on ITEM as I from 1 do (MEDLEYFONT.WRITE.ITEM STREAM I + (CAR TAIL) + T) + (CL:UNLESS (LISTP (CDR TAIL)) + (MEDLEYFONT.WRITE.ITEM + STREAM + 'STOP + (CDR TAIL) + T) + (RETURN))]) + (ALIST + (* ;; + " This could be done as LISTDATA, but this way it uses the alist keys as labels.") + + (BOUT STREAM ALISTDATA) + (for X KEY in ITEM do (SETQ KEY (CAR X)) + (CL:UNLESS (OR (LITATOM KEY) + (SMALLP KEY)) + (ERROR "NOT AN ALIST" ITEM)) + (MEDLEYFONT.WRITE.ITEM STREAM KEY (CDR X) + EVENIFNIL)) + (MEDLEYFONT.WRITE.ITEM STREAM 'STOP T)) + (PLIST (BOUT STREAM PLISTDATA) + (for DTAIL KEY on ITEM by (CDDR DTAIL) + do (SETQ KEY (CAR DTAIL)) + (CL:UNLESS (OR (LITATOM KEY) + (SMALLP KEY)) + (ERROR "NOT A PLIST" ITEM)) + (MEDLEYFONT.WRITE.ITEM STREAM KEY (CADR DTAIL) + EVENIFNIL)) + (MEDLEYFONT.WRITE.ITEM STREAM 'STOP T)) + (BITMAP (BOUT STREAM BITMAPDATA) + (\PRINTBINARYBITMAP ITEM STREAM)) + ((ONED-ARRAY TWOD-ARRAY GENERAL-ARRAY) (* ; + "Note: can't be used in MAKEINIT fonts") + (BOUT STREAM CLARRAYDATA) + (PRIN2 (CL:ARRAY-DIMENSIONS ITEM) + STREAM) (* ; "A list, READ's OK") + (MEDLEYFONT.WRITE.ITEM STREAM 'ELEMENT-TYPE (CL:ARRAY-ELEMENT-TYPE ITEM)) + (for I ALLFIXED ELT from 0 to (SUB1 (CL:ARRAY-TOTAL-SIZE ITEM)) + first [SETQ ALLFIXED (for I from 0 to (SUB1 (CL:ARRAY-TOTAL-SIZE ITEM)) + always (FIXP (XCL:ROW-MAJOR-AREF ITEM I] + (BOUT STREAM (CL:IF ALLFIXED + 1 + 0)) + (\FIXPOUT STREAM (SUB1 (CL:ARRAY-TOTAL-SIZE ITEM))) + do (SETQ ELT (XCL:ROW-MAJOR-AREF ITEM I)) + (CL:IF ALLFIXED + (\FIXPOUT STREAM ELT) + (MEDLEYFONT.WRITE.ITEM STREAM I ELT T)))) + (ARRAYP (if (EQ 'POINTER (ARRAYTYP ITEM)) + then (BOUT STREAM ILPOINTERARRAY) + (\FIXPOUT STREAM (ARRAYSIZE ITEM)) + (BOUT STREAM (ARRAYORIG ITEM)) + (for I ALLFIXED from (ARRAYORIG ITEM) + to (IPLUS (ARRAYORIG ITEM) + (SUB1 (ARRAYSIZE ITEM))) + first [SETQ ALLFIXED (for I from (ARRAYORIG ITEM) + to (IPLUS (ARRAYORIG ITEM) + (SUB1 (ARRAYSIZE ITEM))) + always (FIXP (ELT ITEM I] + (BOUT STREAM (CL:IF ALLFIXED + 1 + 0)) + do + (* ;; "Don't need to do the item recursion if all integers") + + (CL:IF ALLFIXED + (\FIXPOUT STREAM (ELT ITEM I)) + (MEDLEYFONT.WRITE.ITEM STREAM I (ELT ITEM I) + T))) + else (BOUT STREAM ILNUMBERARRAY) + (\FIXPOUT STREAM (ARRAYSIZE ITEM)) + (BOUT STREAM (ARRAYORIG ITEM)) + (MEDLEYFONT.WRITE.ITEM STREAM 'ARRAYTYP (ARRAYTYP ITEM)) + (AOUT ITEM (ARRAYORIG ITEM) + (ARRAYSIZE ITEM) + STREAM))) + (if (\BLOCKDATAP ITEM) + then + (* ;; "This assumes word-element blocks. We can distinguish pointer blocks (from the DTD, see BLOCKEQUALP), caller would have to tell us (a different TYPE?) whether we are looking at full integer or word blocks--how to interpret NELTS") + + (BOUT STREAM WORDBLOCKDATA) + (CL:UNLESS BLOCKNELTS (* ; "Why 3 ?") + (SETQ BLOCKNELTS (IPLUS \MAXTHINCHAR 3))) + (\FIXPOUT STREAM BLOCKNELTS) + (\BOUTS STREAM ITEM 0 (UNFOLD BLOCKNELTS BYTESPERWORD)) + else (BOUT STREAM HPRINTDATA) (* ; "A datatype?") + (HPRINT ITEM STREAM T T))) + + (* ;; "Terpri to make sure ratom is OK, also looks better") + + (TERPRI STREAM))]) + +(MEDLEYFONT.WRITE.FONTPROPS + [LAMBDA (STREAM FONT) (* ; "Edited 10-Jun-2025 20:50 by rmk") + (* ; "Edited 25-May-2025 20:50 by rmk") + (* ; "Edited 22-May-2025 10:31 by rmk") + (* ; "Edited 19-May-2025 10:42 by rmk") + (* ; "Edited 14-May-2025 17:26 by rmk") + + (* ;; "RECORDFIELDACCESS would be more succinct but would depend on runtime availability of the record. If the record changes, this and the reader have to be updated.") + + (* ;; "HPRINT would be obvious, but it would get charsetvector etc.") + + (* ;; "Exclude FONTCHARSETVECTOR and \SFFACECODE") + + (* ;; "Write even NIL values for default overerides") + + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTDEVICE (fetch (FONTDESCRIPTOR FONTDEVICE) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTCOMPLETEP (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTFAMILY (fetch (FONTDESCRIPTOR FONTFAMILY) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTSIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTFACE (fetch (FONTDESCRIPTOR FONTFACE) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM '\SFAscent (fetch (FONTDESCRIPTOR \SFAscent) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM '\SFDescent (fetch (FONTDESCRIPTOR \SFDescent) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM '\SFHeight (fetch (FONTDESCRIPTOR \SFHeight) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'ROTATION (fetch (FONTDESCRIPTOR ROTATION) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTDEVICESPEC (fetch (FONTDESCRIPTOR FONTDEVICESPEC) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'OTHERDEVICEFONTPROPS (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) + of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTSCALE (fetch (FONTDESCRIPTOR FONTSCALE) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTAVGCHARWIDTH (fetch (FONTDESCRIPTOR FONTAVGCHARWIDTH) + of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTCHARENCODING (fetch (FONTDESCRIPTOR FONTCHARENCODING) + of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTHASLEFTKERNS (fetch (FONTDESCRIPTOR FONTHASLEFTKERNS) + of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTEXTRAFIELD2 (fetch (FONTDESCRIPTOR FONTEXTRAFIELD2) + of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'STOP T]) + +(MEDLEYFONT.WRITE.HEADER + [LAMBDA (STREAM OTHERFONTPROPS) (* ; "Edited 25-May-2025 20:51 by rmk") + (* ; "Edited 16-May-2025 20:20 by rmk") + (* ; "Edited 14-May-2025 17:01 by rmk") + + (* ;; "Me in first 2 bytes distinguishes MEDLEYFONT format from others") + + (PRINTOUT STREAM "Medley font" T) + (MEDLEYFONT.WRITE.ITEM STREAM 'VERSION 0) + (MEDLEYFONT.WRITE.ITEM STREAM 'DATE (DATE)) + (MEDLEYFONT.WRITE.ITEM STREAM 'OTHERFONTPROPS OTHERFONTPROPS T]) +) +(DEFINEQ + +(MEDLEYFONT.FILENAME + [LAMBDA (FONT CHARSET EXTENSION FILE) (* ; "Edited 10-Jun-2025 11:02 by rmk") + (* ; "Edited 25-May-2025 21:25 by rmk") + (* ; "Edited 19-May-2025 17:42 by rmk") + (* ; "Edited 16-May-2025 14:09 by rmk") + + (* ;; "If EXTENSION and FILE are NIL, puts the file in the MEDLEYDIR fonts/medley[device]fonts/ directory with extension MEDLEY[device]FONT. If CHARSET, goes in the CHARSET subdirectory.") + + (CL:WHEN (AND (LISTP CHARSET) + (NULL (CDR CHARSET))) + (SETQ CHARSET (CAR CHARSET))) (* ; "Edited 14-May-2025 12:02 by rmk") + (LET (FAMILY SIZE FACE DEVICE FILENAME) + [if (LISTP FONT) + then (SETQ FAMILY (CAR FONT)) + (SETQ SIZE (CADR FONT)) + (SETQ FACE (OR (CADDR FONT) + 'MRR)) + (SETQ DEVICE (OR (CADDDR FONT) + 'DISPLAY)) + elseif (type? FONTDESCRIPTOR FONT) + then (SETQ FAMILY (FONTPROP FONT 'FAMILY)) + (SETQ SIZE (FONTPROP FONT 'SIZE)) + (SETQ FACE (FONTPROP FONT 'FACE)) + (SETQ DEVICE (FONTPROP FONT 'DEVICE] + (CL:WHEN (LISTP FACE) + (SETQ FACE (CONCAT (NTHCHAR (CAR FACE) + 1) + (NTHCHAR (CADR FACE) + 1) + (NTHCHAR (CADDR FACE) + 1)))) + (CL:UNLESS EXTENSION + (SETQ EXTENSION (CONCAT "MEDLEY" (U-CASE DEVICE) + "FONT")) + (CL:UNLESS FILE + [SETQ FILE (PSEUDOFILENAME (MEDLEYDIR (CONCAT "fonts/" (L-CASE EXTENSION) + "s"])) + (SETQ FILENAME (PACK* FAMILY (CL:IF (ILEQ SIZE 9) + "0" + "") + SIZE "-" FACE (CL:IF (SMALLP CHARSET) + (CONCAT "-C" (OCTALSTRING CHARSET)) + "") + "." EXTENSION)) + (PACKFILENAME 'BODY FILE 'BODY FILENAME]) +) + +(ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT) + +(ADDTOVAR DISPLAYCHARSETFNS (MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET)) + +(ADDTOVAR INTERPRESSFONTEXTENSIONS MEDLEYINTERPRESSFONT) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RPAQQ PRINTDATA 0) + +(RPAQQ SMALLPDATA 1) + +(RPAQQ BITMAPDATA 2) + +(RPAQQ WORDBLOCKDATA 3) + +(RPAQQ CLARRAYDATA 4) + +(RPAQQ FIXPDATA 5) + +(RPAQQ ILPOINTERARRAY 6) + +(RPAQQ ILNUMBERARRAY 11) + +(RPAQQ HPRINTDATA 7) + +(RPAQQ ALISTDATA 8) + +(RPAQQ PLISTDATA 9) + +(RPAQQ LISTDATA 10) + + +(CONSTANTS (PRINTDATA 0) + (SMALLPDATA 1) + (BITMAPDATA 2) + (WORDBLOCKDATA 3) + (CLARRAYDATA 4) + (FIXPDATA 5) + (ILPOINTERARRAY 6) + (ILNUMBERARRAY 11) + (HPRINTDATA 7) + (ALISTDATA 8) + (PLISTDATA 9) + (LISTDATA 10)) +) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (2127 14772 (MEDLEYFONT.WRITE.FONT 2137 . 6995) (MEDLEYFONT.GETCHARSET 6997 . 9296) ( +MEDLEYFONT.CHARSET? 9298 . 10767) (MEDLEYFONT.GETFILEPROP 10769 . 12804) (MEDLEYFONT.FILEP 12806 . +14770)) (14798 36689 (MEDLEYFONT.READ.FONT 14808 . 19241) (MEDLEYFONT.READ.CHARSET 19243 . 24137) ( +MEDLEYFONT.READ.ITEM 24139 . 30288) (MEDLEYFONT.PEEK.ITEM 30290 . 31152) (MEDLEYFONT.READ.FONTPROPS +31154 . 31619) (MEDLEYFONT.READ.VERIFIEDFONT 31621 . 36687)) (36715 54244 (MEDLEYFONT.WRITE.CHARSET +36725 . 41330) (MEDLEYFONT.WRITE.ITEM 41332 . 50385) (MEDLEYFONT.WRITE.FONTPROPS 50387 . 53589) ( +MEDLEYFONT.WRITE.HEADER 53591 . 54242)) (54245 56814 (MEDLEYFONT.FILENAME 54255 . 56812))))) +STOP diff --git a/sources/MEDLEYFONTFORMAT.LCOM b/sources/MEDLEYFONTFORMAT.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..c6da3118131bbb9ccf0f088f21d5d4f0fbf82aab GIT binary patch literal 20840 zcmbt+ZE#yxdLAx7(Gq2I36SQhT$wpS6`Ep9EpP!4BzJ2A1TRI904@c9g0z;GmISUz z3YI*QoOIjG%ubS-WHbHI-FQ9OiPN2KJG(a4#hp=s(NgKA}KS%l5x?AptkPiCZsT7ekAg)pX&URhli^ zVtS=e>N)*0VsWErUC7#-rP*a{F!nd@+22TVF_s96p@*AE^30I7NtGgY=qzn{IueOQ z#p3e(&~zc4w?rwsxHz*}sALPvvl~UbY-P$bVnamdL^={r#_2J^k1=|T^P@?RF_EQz zq9Rjbmf8?WJQi#a6N33jkACc3~cK&uQ3+ROhJ5%>^M>Jjfgbjb)8EQz ze&M2G`n{(`Br1h9^M*j+M&ZSdu(T7E3`Gzw1=<%cx!n7LBSrI+6p!6AG_1DCr~m` z|EEqlel z5))!t%od{1*YWNF+l;*sZx1o=Sw%7_tYXnF3akcJV|msUOA!M_iH5*HncQMNy>88> zi^cRM(PMq9P|a2m`qhk}wv=4f6)`Euu4F@A7qf+IIh)SSS~)9k70PG@pa@N=2vefucBr4MFr9rPm4%aM&B~gOPU4L4UBeuYq?qTg`qJO8F0oWx^*5KQfqzl``p$$b z8c6dxI{rL%grsvf=r_24tMZ>!e$Vo%l^iW#Dr)6oKH`d0GSQpOq@4lJ+8b6u#7t4b zK9O0`q=2N2MN#sVbS$u!^K)un>7=##UMpsb1oppRRc0?(#S%C}BqCs=m09Z|WW7ZE zy9g=WfOLZ)7Nwd;wa&wW1S=kUSlbBeCG8m4ShH*W?GaY*u$LzKRxU9=2UL z(BJY0d`6M?f0y_FAi*|3lK6D54eU%zlqaqoZ5H{o4n}1Sevw*H76gOF-s;ESF7B;< zD9NRwXw^>@S4$s#^nqUS(q8L(#Vk|4x^wqfvBZzW@3EME0_iiVwEh+1!g3*jWiODO}^ng&A7-G=%5qwUyww? zgp#n!BCXAzr6)`-!8Gjqxq_HxNnUwI*tz8k>D;Du=8Q*>+q~fjvMKnuN@a4bTM4IrHemStd+GcCGF^Lc|J5{~WU~}JpnTQjm+ zcf=L#T*Q|UC?NvTPDesKx+6{Xz`*CBeGQ5{nhM+Pmb|&gem0_v$o8*(5 zgX?Se4^FAJd#&%UznwpPtgtij+*|9{fBbCyuL@H?tp8mu^fjIzPu7v4kdmS3d|Qa3 z^QMxCsN)!uWiUOqAc`Z?BnqymcDQV99FMaEzuOfzC^so?;0D)jcoZI=Fc^p27AFve zuhQ-ft_g?PU`zJ8_z=+m!DCW{H*Z|Oar0MhXtNP7-MabG_N_Z#hW$W=hmd6GT%FJQ z3A5yapI?}@VRU&$x1I9LtVe9Bg!w89b2XM~9ZX9X@<1@d$QOQO{^LK!Ro_>CKFMEb zJIw;&jH6|NE@+3XEkjD>Ttxbg5dHMVM(&a~{Lo!SFcsMlU<4aDK=6=K6>}br=omn{ zk4jtU{-Hp0QrfUGgclII&}Nm;uSZMs!SX!mPprN1><%DO$*dx9DsL7GvnxeAPlyJ3 zC9Gw6GoQaiP{l0QBDlii9y-pf;~o}rkdO1T(mN5pr~LuHZ#M;(U3Ulvl_#jtO4{?p z#KaEVMLtjpiIe)qvy?G_hWJi9kTzWxGN3`d>R^8ofV~O?=;cJ*?2Kfvrz~v{ceTL& zJ1RHxlhCOJF_WDd`LC0D3sC(MSaUpO??T zb`a6hfYb@uFhCV&1WemQ#udC7j?(zqLkgF}VnPohCJ{s!|Bs*nxD9QR9yA~va#S+d zP?PTVk&#;MY}YBkuC;zhrwW=xdR1|85#k21aKdWrsX~(H5I+%o42bz0ZXU=9ivcu2 zw7gkZW*PN*WWYzDv6aD>h%;(MJlOIlNG`O26NrxCl0>2@!gRl zz=j2jm*c?6H|fB&U8Z1qK-GJ*A{5qp?KI=D_a@(1+iQJe-}lpu&HQua~Vg@ zHrNyXt%>~y^DuuAk6*xitIit0FPKe(bdv2oF z!eqhZ!>w2l%ed(QXayw+_fwNN&s+$5k*%ZVyxSTAT(t7`1xvu!)~1^1?g&Fz z-#67=~#cEx&x(zKmKMgssQ|FjknhQ#t(BUjBiXf*Q8w-_#^qCUVUQ& zYa?=)-;<;~>G`*uhOeo1d30X?Zb!v|X8m`ZiofqxJlfoU@T;=sYpTolhCtixs`}n> zkY#Mqa;lC!3fj|MRmTQFe$w0P*f40LIZ14csj6oMV;O7Ama)g+S_O5`70j=SNWv$DMfw-e!q5rfB?VkIL2tJP? z+)->Oue2~mrj)Vs8#$|N!A${L;VB1XA#chl3I~|cb}-bH*t}TEmh))@9E<^RU(RtkJtgOKHlyIQ~%cR}xMG>_-%^>5RBFx6~4nygAN4!ufBLKi~Ul|B! zMdeEy*5Ch%z_sgTIvQ0X=HMMFfp$oVWETmV$}M%CAmwl<$#T(MF2Ej2F?r#}?mt47 z2;C~eNRjOlwJTS*YfpwLd1PcW#hb_b-GA#HG6_2>dAPTY$ayeX1BhLnJ*l*PcDGRC*&jnOsaNFy;az>>CQIy=7h!K&>l@ui_*JnI>(*LKYI`m}FSpBwC zeLM2{aNqyyEbZ*9wV#4vrS;yDinEzZiR$&%x0)&OUsB?Oeg9Imc7$HJ-M&9o-P7KF zv06LYYJ9F4OdXRIwn9~d^5$q}gZD2b zuD61Itdpz;(mh7)Df{&OgDGTMOxfXACH*($KYl}Qxjls}jj8&Fwg`ogLsG2`wi?f? zK~jQy42;_|*IVDPr+?j^zW$*-V^8l??HSJ22nPP19kI{S7$zQ`a>uYEyh=4j1Y<-n zhDl?5vsydeYDC;Ig8t9gacwC(_8j+Z&w#E(4g2%<(|dNRHjo`2wHHI7`loA;wA3UuY#N67b-690>BE85 zk?N|^QlS|yV^tnmy7AwDodXq{TbNf)@En20(pjIwWhLtzhBW4&-Ab$WW^NhUb`JV& zmC8f{^)EwS?Ti%p1c98CSpvK}0f#wF|01bFie>^RNl#;wfO2q}#W5Ku*fboaZa0dJ zUL01>tqm|+b{^OIh@lTSdW%K7GMi7Y0dWNCMX4@*tYl2Su@pO_%MwAY++ZxN`d!Qf}e& z$=DU1kdj)u`tY0@Ot7|7#2?ZD>~Wefy;@amS)Z_}@CC7_H*VkAzJjdRFX4r<4>q>9 zufw76ZXJ(JA&ztd)&9i494V4=~Pwd3MHr}Y5W~B zi2QPfNH$3~OymRx)&hq|M(bJQS--Jvq<7e?@zMQ6UfZk8y*2+A>VN(`nYCZ2`D+h8 z*ky(MMm0M&*+c@ z-&pA)4(uDzF5=+6ak7*6-qC&IkuKt~ec#`95r_7Df6+xezVCadlQ=fE?>p!sj_>>a zSr_rdzVBllAp3+GIVcXpK>)G4I}_ul@udTI*ZR zRtwFrHgRzKKivV4hCqcQGxE%J`{#sJP=d&GS$&n9Y3VAu%#>k+yu|uVmm2?K%fxD3y@RW|Z#o!hYsgz0M@+gLo zqq72H1HP$-smW$6DwUEMgTd^qiz`Vd1jt&;I6m(-hE>fSMTB3?A@Gs1rgrgtE9Z!%3e;)fIbluofm z4hHB5OIb(ThAKKDjh;2*E+aRdr%8}aQ(wQhot@;2o4O{Blht9 zgOhg19(n&AA0kWor}fWwe#;&~@HA5Y%iYkyxM!3B9;NA_`L$hEogeKYy))EJI^IRP z_h>h1u#5DrZ-jE>G`hTPMv#>7dj67GrO)a0$n}zl=O#fbi9>yAj*DIbT&Yh9)KH(2 zzB7o!G4I``BN)%cf}q4aW!GgXvEcGyz{$k8#YxJL2< ziE%^@4*nPib9fqJG75i;)As@zP8f#@cJRkI-HmBw6t_C~BE_VhGGuA$*kla*>M4i& z?s@O{^1xg`kf4o4CeZT^SH^)wVFc3r*@y`n`sxA*Y{xQ9EVE>9 z7GY8-tnGv=>0YnHY($ZntB*xF2dW3SA9@L9s=v1JXiC3PC6ZG*y?>3%9s7cNN(mOu zd*DRCsjxSI64$Lu^bi;LKrl-I0#>7F4!o!eq;Z-PPCX>M$Zrj04wU|tR~8N-BPJ5l zqz@uEJSOXf`_V#n1(~y$0XB}JS~sr5Q#%A1xb|tEZ;+LI7s41=`fi3S(7>`XWgJFI ztG0Z2bcq`{KJck#>N?w^W@_m#orl_kzvjpN!2faTjW<)ZBTl(0biDn8QB~_-Ikg{e zrc|=ck{owGP*-L6yz4icOS{3)VD5{!VE-q^7hYM59lbkP@Yg^7Vd0emo&)(%W2~!# zo2lB6oWRocU22VX|j|C1xqq4Qs|NH*`iCcDK>jb9^j^d);kO7_i=%kqf5IXM9sNu)_ zTVwUNoz6GW`7yV1q!etO?C$5Y?-;SHPy6F|8B~b-|GE#3dK{-5r%O@;rf3V-8a6% z9NvO=H7s)JL%xhvHq* z`=k55@26_Vd(2hsmMY<8%4w=2sq&FYl7y1$&&jt&CRGc_cGmaUExS6@Oj*tt7SQBz zds=#M3QbP^z@D~e_Uxx>1M9=1^~Y1SM`ZP-)NWNWvP3uF`$VI-OL9KJiz4-4RVsbl zOTu>22Z7NDECs`+@(syriVj78nN=MjYJ?)9tF){HrOHU5jBp~*_x#E?KFB)j=W8s$ zlDP=u0?ZhXw19A_-F$)5>eMHW3uMm-lH`FFFjLvWoAs&Lh6T#9hE-Sqh~zG60j?Ag z=MheF`*}D7OrXm~>YgV)4+yS3*gTf6l_4h7-xN~H)0&4b&@M{?#N|PfK-e|1160!n zCIPl{5w}kQ4U{b$yd4%rB)zGK+8UFvWA57M2H+wvVGS@ZS}TA|^*RXdQH4ju_uOTC zvB(3@0c7TZ=im(V>I9qEvmH4AhV*x@~Y4#Bfb0I0vr?CSyO$!p~Dj%x>P$Kn`7;;nHY=)I>HNAI$mzU)iLiR>l@PVC(c zfgs!srCar`Vq&3vN`R-x#)Jm*u9(iWqL2$oqOWSX7GS%Q#IiReh0^C8wEy66Y`^Dj0U(6uY5`7JGy-pyZw~O}UL7nT@L=|0&c!$z z_(&aUM5oCGl=$`LA37-IuhcwmG=BtpJSfB6X-jB|Ka1PDM?e}w z^hYEef;YR7a1&WORLujyn}|_6x^rM=3Q%3-k^=0`dQdJz@*wMGH>7U@0HAsjHaDTT zJ39h)+7mX9b}xc5on&(tHjj2MAqxD*h0PuOS%t4V zHt(LOnkR$i-4n$8cuNQ}@7`Ipu`6i?%yARlF*dT1h|-3N;PG`-aZq^LrQYCz{4i2x z!jdNL`eB210Pp(;q?5JC+({x~*I)j+id48qQBlIMN&!nHM6hIEw6Gt-hMNoiAgQlj z0&?T{`qIoru~K+E9V>z4$bMqZS3+#b0QYZKYujIDq~B|;oMc%iO_)ri`W*y9@a63e z5EfkO(47cOCO&__N%D29JTwAGs1ai$5KQUbF+ie#ABITi)bMS>H122z(t*R7;Ko3z z8fZLayq@wKZ>0QwAH{|zqVKTD4>D_!RGX83Q8gFUd42_TdZEB8=L zxO_yIL7pBGVPsyA34hDZ!25TwSU5^f5yTmKkPZUb9PQ^QoLGk*g{QMovNo4(cNof~ zlvW5i%DCx*1FyapKqQmnFV^5&A&5{^__CXds&3WD`4R9~>Dc)hpD(%3@GqTbFsKRd zd&yqDgxo~(fAK&cGbz?1?V6_Gj@znf^2w9uX^t z<<>xw@P(CCE?*+`#E@&-a?4*6LjirQS=>mUKd+hfcA=P_o)Mq>oCsULj7!UxuheQ^ zeoCt-ZtvWDxmFcdxACR^OINO4zw!dU&=<1JP&iK?HoWxm)!Obgf#$b%w{KHv$FF*| zJyNabvq&6r#Irr?vx@YL(0>I$`&d=)fw*PEnM}BdbQ9br_88y2TlaLz)E+Z%6Grr* z+BrVjT-|=9qpi=Fi}aKdcbXOaDo^ie%5CZ~Bh5F`$7pY>9ABH6EKUG8}+6pN@qRY9$MctJ|EAXx6k|xI^u8#3|uPp9MxM) z4VJA;4vrFj^3FnHPKvmm^#0H?CY`Z2F5wGC#P#Jg93cAk5FK#JRs>CDz{Ril^|EOh z?eVLLS4v2B0Vxp!g$4qA!!_``1k*zlx$zsmimR2VAbM||xFQeiW{gpiY(A=Ct( UPm@Z|9K2`I#US2d`5Pbq7f!ZXPyhe` literal 0 HcmV?d00001 From 2607471469f118bc87aa4952ebcd587fa23994ca Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Mon, 28 Jul 2025 17:25:27 -0700 Subject: [PATCH 7/7] Fix issues with the compiled advice --- lispusers/INSPECTCODE-TEDIT | 54 ++++++++++++++---------------- lispusers/INSPECTCODE-TEDIT.DFASL | Bin 9489 -> 9169 bytes 2 files changed, 26 insertions(+), 28 deletions(-) diff --git a/lispusers/INSPECTCODE-TEDIT b/lispusers/INSPECTCODE-TEDIT index 1586fc31a..739795f68 100644 --- a/lispusers/INSPECTCODE-TEDIT +++ b/lispusers/INSPECTCODE-TEDIT @@ -2,12 +2,16 @@ "Above is to ensure the COMS is in the INTERLISP package!") (DEFPACKAGE "INSPECTCODE-TEDIT" (USE "INTERLISP") (NICKNAMES "ICT") (PREFIX-NAME "ICT"))) READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Jul-2025 18:40:40" {DSK}matt>Interlisp>medley>lispusers>INSPECTCODE-TEDIT.;13 18439 +(FILECREATED "28-Jul-2025 12:42:03" {DSK}matt>Interlisp>medley>lispusers>INSPECTCODE-TEDIT.;16 18137 :EDIT-BY "mth" - :PREVIOUS-DATE "23-Jul-2025 18:25:48" -{DSK}matt>Interlisp>medley>lispusers>INSPECTCODE-TEDIT.;12) + :CHANGES-TO (VARS INSPECTCODE-TEDITCOMS) + (FNS ADVICE-ON-\TEDIT.INSPECTCODE) + (ADVICE (DECODE.WINDOW.ARG :IN \TEDIT.INSPECTCODE)) + + :PREVIOUS-DATE "23-Jul-2025 18:40:40" +{DSK}matt>Interlisp>medley>lispusers>INSPECTCODE-TEDIT.;14) (PRETTYCOMPRINT INSPECTCODE-TEDITCOMS) @@ -15,8 +19,8 @@ (RPAQQ INSPECTCODE-TEDITCOMS ((FILES (FROM LISPUSERS) GRAPHCALLS) - (FNS ICON-FN INSP.ERROR KILL.TEDIT.PROCESS OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE TITLEMENU-FN - ) + (FNS ADVICE-ON-\TEDIT.INSPECTCODE ICON-FN INSP.ERROR KILL.TEDIT.PROCESS + OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE TITLEMENU-FN) (FUNCTIONS BUILD-TITLEMENU) (GLOBALVARS TITLEMENU-ITEMS) (VARS ICON.TEMPLATE TITLEMENU-ITEMS-TEMPLATE (TITLEMENU-ITEMS (BUILD-TITLEMENU @@ -32,6 +36,19 @@ GRAPHCALLS) (DEFINEQ +(ADVICE-ON-\TEDIT.INSPECTCODE + [LAMBDA (W FN) + (DECLARE (GLOBALVARS TITLEMENU-ITEMS)) (* ; "Edited 28-Jul-2025 12:28 by mth") + (WINDOWPROP W 'TEDIT.MENU.COMMANDS TITLEMENU-ITEMS) + [WINDOWPROP W 'FNNAME (COND + ((OR (LITATOM FN) + (NOT (CCODEP FN))) + FN) + (T (fetch (COMPILED-CLOSURE FRAMENAME) of FN] + (WINDOWPROP W '*PACKAGE* *PACKAGE*) + (WINDOWPROP W '*READTABLE* *READTABLE*) + W]) + (ICON-FN [LAMBDA (W) (* ; "Edited 30-Mar-87 15:59 by Matt Heffron") (DECLARE (GLOBALVARS ICON.TEMPLATE)) @@ -246,26 +263,7 @@ :AROUND '((:LAST (LET ((W *)) (DECLARE (SPECVARS FN)) - (ADVICE-ON-\TEDIT.INSPECTCODE W FN) - W)) - (:LAST (LET ((W *)) - (DECLARE (GLOBALVARS TITLEMENU-ITEMS) - (SPECVARS FN)) - (WINDOWPROP W 'TEDIT.MENU.COMMANDS TITLEMENU-ITEMS) - [WINDOWPROP W 'FNNAME (COND - ((OR (LITATOM FN) - (NOT (CCODEP FN))) - FN) - (T (fetch (COMPILED-CLOSURE FRAMENAME) of FN] - (WINDOWPROP W '*PACKAGE* *PACKAGE*) - (WINDOWPROP W '*READTABLE* *READTABLE*) - W)) - (:LAST (LET ((W *)) - (DECLARE (GLOBALVARS TITLEMENU-ITEMS)) - (WINDOWPROP W 'TEDIT.MENU.COMMANDS TITLEMENU-ITEMS) - (WINDOWPROP W 'FNNAME (WINDOWPROP W 'TITLE)) - (WINDOWPROP W '*PACKAGE* *PACKAGE*) - (WINDOWPROP W '*READTABLE* *READTABLE*) + (ADVICE-ON-\TEDIT.INSPECTCODE W FN) W] (READVISE (DECODE.WINDOW.ARG :IN \TEDIT.INSPECTCODE)) @@ -286,7 +284,7 @@ (:NICKNAMES "ICT") (:PREFIX-NAME "ICT"]) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1400 9658 (ICON-FN 1410 . 1866) (INSP.ERROR 1868 . 2228) (KILL.TEDIT.PROCESS 2230 . -2404) (OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE 2406 . 2944) (TITLEMENU-FN 2946 . 9656)) (9660 11932 ( -BUILD-TITLEMENU 9660 . 11932))))) + (FILEMAP (NIL (1600 10420 (ADVICE-ON-\TEDIT.INSPECTCODE 1610 . 2170) (ICON-FN 2172 . 2628) (INSP.ERROR + 2630 . 2990) (KILL.TEDIT.PROCESS 2992 . 3166) (OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE 3168 . 3706) ( +TITLEMENU-FN 3708 . 10418)) (10422 12694 (BUILD-TITLEMENU 10422 . 12694))))) STOP diff --git a/lispusers/INSPECTCODE-TEDIT.DFASL b/lispusers/INSPECTCODE-TEDIT.DFASL index 5bc986a682547cb91843fb9a3989f3fb31ce4335..d76ad7466ac5045ca0b4dc92beed9723f3371e5c 100644 GIT binary patch delta 1822 zcmZuxUu;uV7{BM<{@p)Yx_`Kp6gF`z>sHFvb(;?E+S^ffd)u|QY#^E~Th{`sTLvUx z4BHeVBo#KkVD2$Uf^QHb;&{;qCDE6~2VqF$!6-^JKKQ_s7%}2^P8&r-b92t``<>tU z&hLEZ^epeXIk+_SLZB=)b7XEJ$o+e}2C^(~9Dxrk* zP&}-7btN3tjk5)7G!)mo5sh}iDe1mVHbA8PRDng)_Ua+bVAGXRooU#>5bcJqO>IO4 zV&3g~f>StP9+(dZ=V`!r+q8E_R>0pFYsy*kS&@(@x9zw;y1et0Y-j9pZejnjd`h;k zU{zQ(J+2*oJV=%ThaeENCPp+tz@Cgq#5hy1wTU(k zMz+#fLc=Us5bj#^jX^A=sg%i#nO?(qk+%zUo*t(MA!hZF9yo5Tt(l@dIQqYJ;gWR= z>4jU?f5%;SVgm9CC!Ny*q5Wol+u$iu?!hIGB&)k zlD^FcW0fb!6#P`VWpiH*`S)x~zAkeYm(WEw?p}HiE7Mu^W(BLn2}W#1;`6GJ`42D< zhq?F)gAootWU!CJs|m++%cwMI{S5C9A zyzV=40cKqtHN{K%1DD<9?f3NH$~9MznCZ-U+P@;zv=Gt{ZMAvZ@6T|-1GrdQNB)41 zYa8nxiVmY7MMJvTD2P!NuLG_s`~|<(%H$rj*A4dGGk~zKV8QF8$T7^@hY~!l8TOXg z_a*e?&a^hTfaFN4ny4X_7?P6Zj}q6!1->|H994bF|v=0fAs)5Sx- z4OI=>v0Pe1fZT#N8d_Wrxy}-q%VegHaih23dcz>O3AV;G`3hcY95t;Og$}sl-T-$R z*FRyx8kpQFxdFrOy?A)(b5P% zcT7shA66SMhF&&~4hh1Z{IWeZD^Y7#wN<>pbF*U!G z&v_L!os=VbM2pHHU5+X`Jum*@?9Nkxb+RZuYwarU15>9i@6*u^5BgXe{ma@w`f0$n zw`_wb=}B9Ut=V!0^zPV46|g4*tc_SKgo$|yKOuiA=h~(vbwyL9I5YB#IhUg9aw@K* zlhgJTSZqpW^Z`YUY6HoXmXz6On2pjIM=Cf}fvF@?DKC6oyXE*^86uM$u(QWhRZ7T& zMJzzxPXBf2TiPuai?u*&W5euK_6nO~lWc^JIU5_o`FBZiw+nPEtK0df1Ryh57(Vx- z1v3K-R-E-@7ro`o4FZ=CQ$?OeFeyd)rCvEGijY-NFeOV-UFwO;LAHyC7F&Va4o=53kg zry1KCetBkbXd=Mly@ynyg&4lg2X zC0ERY54Z(#l025=0G%x<@gOmo z;YSzf*%E&YImtK|ASW5&5IM;~4v~}W6sx(c-ce zvX4f~T0H1^p@@s;>FZ^`lK1HT@*O_2XMW-G>wNv0jVymy9wvTBxg??`l1f~Th9Yq- zok_`OSm*M(ua1yTYV(hG-g=Uo{ONv>A>m$O43$x?#YSO=&V8tNv&dpeNRQ@b;2e-rm{2i@_8 zCnBAzI7p)OMuogbsbHOsPI&WnDTSpDv9>yv*vk5AShtr&?JQzTa4wOhna=uq3NvFd zXN^l~Jx^_rj~JH$K|lgCXm-n1Cvu$xO=^gNENg`q%Ox;eKm{Nv%2Ou?o_ltDw+U=G zC_%+8#%CYudr^umt&o}f!7MU8;#4f-6LWh)Rx{h-DiV?!O{2Xv%N^DfG}#0ua4Kho z`56Tgb0=si#L&2LMVE9fagPqCiU{x9Jhew~HYd%)`zq6BRJLJb^3VvzjiKJe8;GS~ z0%max!cI7BHV`I(D&&4hs6WrG<~KZB;AabuQa!V}52^=D+5b_I$9P#D4gst3kOTs@ z@u{|9M2{407=5N$4Rj6MvI{GnbN5aR9vO)Yj*T7VNqtX$*wO{huC%g^T%}57UD<7} zXOB%7#@I2gbCu3k_LA@D)yhoKNu)L2g JaQ^Py{{Z~LtdRf!