From 4d6aa38b8b26d8b6a349920359591326dbc6d0f5 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Thu, 2 Oct 2025 18:00:08 -0700 Subject: [PATCH 1/3] Check that a MENU has ITEMS that is LISTP before trying to display/use it. Checking added to FNS: ADDMENU, CHECK/MENU/IMAGE, UPDATE/MENU/IMAGE, and MENU. --- sources/MENU | 132 +++++++++++++++++++++++++--------------------- sources/MENU.LCOM | Bin 27793 -> 28004 bytes 2 files changed, 72 insertions(+), 60 deletions(-) diff --git a/sources/MENU b/sources/MENU index e6706c07..01835fc2 100644 --- a/sources/MENU +++ b/sources/MENU @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2025 22:35:12" {DSK}kaplan>Local>medley3.5>working-medley>sources>MENU.;3 101431 +(FILECREATED " 2-Oct-2025 17:53:41" {SOURCES}MENU.;2 102104 - :EDIT-BY rmk + :EDIT-BY "mth" - :CHANGES-TO (FNS MENUTITLEFONT UPDATE/MENU/IMAGE) + :CHANGES-TO (FNS ADDMENU CHECK/MENU/IMAGE UPDATE/MENU/IMAGE MENU) - :PREVIOUS-DATE "16-Jul-99 15:51:36" -{DSK}kaplan>Local>medley3.5>working-medley>sources>MENU.;1) + :PREVIOUS-DATE "14-Jul-2025 22:35:12" {SOURCES}MENU.;1) (PRETTYCOMPRINT MENUCOMS) @@ -92,12 +91,16 @@ (T 0] finally (RETURN ANSWER]) (MENU - [LAMBDA (MENU POSITION RELEASECONTROLFLG NESTEDFLG)(* ; "Edited 21-Jun-88 19:00 by jds") + [LAMBDA (MENU POSITION RELEASECONTROLFLG NESTEDFLG) (* ; "Edited 2-Oct-2025 17:49 by mth") + (* ; "Edited 21-Jun-88 19:00 by jds") (DECLARE (LOCALVARS . T)) (* ;; "puts a menu on the screen and waits for the user to select one of the items") (\DTEST MENU 'MENU) + (COND + ((NOT (LISTP (fetch (MENU ITEMS) of MENU))) + (ERROR 'MENU "ITEMS list is empty"))) (PROG (IMAGE SELVAL DSP) (* ; "make sure the image is a window") [SETQ IMAGE (COND ((NOT (EQ POSITION 'INPLACE)) @@ -119,18 +122,18 @@ (RETURN NIL)) (GETMOUSESTATE) (* ; - "if mouse state is up, then someone came into the window with the mouse down. Ignore it.") + "if mouse state is up, then someone came into the window with the mouse down. Ignore it.") (OR (MOUSESTATE (OR LEFT RIGHT MIDDLE)) (GO LP)) (* ; - "MVAL will be NIL only if the user clicked up outside the window") - (OR (SETQ MVAL (MENU.HANDLER MENU DSP NIL - T NESTEDFLG)) + "MVAL will be NIL only if the user clicked up outside the window") + (OR (SETQ MVAL (MENU.HANDLER MENU DSP NIL T + NESTEDFLG)) (GO LP)) (RETURN MVAL))) (T (MENU.HANDLER MENU DSP T T NESTEDFLG))))] (* ; - "evaluate menu form after image has been taken down.") + "evaluate menu form after image has been taken down.") (RETURN (COND (NESTEDFLG SELVAL) (SELVAL (DOSELECTEDITEM MENU (CAR SELVAL) @@ -159,24 +162,28 @@ (T (DSPFONT NIL (fetch (SCREEN SCTITLEDS) of SCREEN]) (ADDMENU - [LAMBDA (ADDEDMENU W POSITION DONTOPENFLG) (* kbr%: "24-Jan-86 18:00") + [LAMBDA (ADDEDMENU W POSITION DONTOPENFLG) (* ; "Edited 2-Oct-2025 17:51 by mth") + (* kbr%: "24-Jan-86 18:00") (* adds a menu to a window. If W is not given, it is created; - sized a necessary.) + sized a necessary.) (OR (TYPENAMEP ADDEDMENU 'MENU) (\ILLEGAL.ARG ADDEDMENU)) + (COND + ((NOT (LISTP (fetch (MENU ITEMS) of ADDEDMENU))) + (ERROR 'ADDEDMENU "ITEMS list is empty"))) (PROG (IMAGEWIDTH IMAGEHEIGHT SCREEN) (SETQ IMAGEWIDTH (fetch (MENU IMAGEWIDTH) of ADDEDMENU)) (SETQ IMAGEHEIGHT (fetch (MENU IMAGEHEIGHT) of ADDEDMENU)) (* put menu at POSITION if argument, - otherwise its stored position, - otherwise at cursorposition) + otherwise its stored position, + otherwise at cursorposition) [COND ((POSITIONP POSITION)) ((SETQ POSITION (fetch (MENU MENUPOSITION) of ADDEDMENU))) - (W (* if a window is given, put it in - the lower left corner.) + (W (* if a window is given, put it in the + lower left corner.) (SETQ POSITION (create POSITION XCOORD _ 0 YCOORD _ 0))) @@ -187,20 +194,20 @@ ((WINDOWP W) (* adding to an existing window. To avoid partial images when window is partly - off the screen, this case could close window then blt to save region then - reopen window.) + off the screen, this case could close window then blt to save region then reopen + window.) (* locate menu grid in MENU.) (replace (REGION LEFT) of (fetch (MENU MENUGRID) of ADDEDMENU) with (IPLUS (fetch (POSITION XCOORD) of POSITION) - (fetch (MENU MENUOUTLINESIZE) of ADDEDMENU))) + (fetch (MENU MENUOUTLINESIZE) of ADDEDMENU))) (replace (REGION BOTTOM) of (fetch (MENU MENUGRID) of ADDEDMENU) with (IPLUS (fetch (POSITION YCOORD) of POSITION) - (fetch (MENU MENUOUTLINESIZE) of ADDEDMENU))) + (fetch (MENU MENUOUTLINESIZE) of ADDEDMENU))) (* Blt image into Window.) (BLTMENUIMAGE ADDEDMENU (WINDOWPROP W 'DSP) DONTOPENFLG)) (T (* have to create new window. - Put position at Origin.) + Put position at Origin.) (SETQ SCREEN (COND ((type? SCREEN W) W) @@ -221,29 +228,27 @@ (OR DONTOPENFLG (OPENW W] (* put MENUBUTTONFN in CURSORINFN so it will get called if button is down and - moves into W.) + moves into W.) - (WINDOWPROP W 'CURSORINFN (FUNCTION MENUBUTTONFN)) (* Set ButtonEventFn to activate - menu selection.) + (WINDOWPROP W 'CURSORINFN (FUNCTION MENUBUTTONFN)) (* Set ButtonEventFn to activate menu + selection.) (WINDOWPROP W 'BUTTONEVENTFN (FUNCTION MENUBUTTONFN)) (WINDOWPROP W 'CURSORMOVEDFN (FUNCTION MENUBUTTONFN)) (* put ADDEDMENU on USERDATA so - MENUBUTTONFN can get at it.) + MENUBUTTONFN can get at it.) (WINDOWADDPROP W 'MENU ADDEDMENU) (WINDOWADDPROP W 'REPAINTFN (FUNCTION MENUREPAINTFN)) [COND ((NULL (fetch (MENU WHENSELECTEDFN) of ADDEDMENU)) - (* make the default selection function call EVAL.AS.PROCESS instead of EVAL so - it won't tie up background.) + (* make the default selection function call EVAL.AS.PROCESS instead of EVAL so it + won't tie up background.) - (replace (MENU WHENSELECTEDFN) of ADDEDMENU with (FUNCTION - BACKGROUNDWHENSELECTEDFN - ] + (replace (MENU WHENSELECTEDFN) of ADDEDMENU with (FUNCTION BACKGROUNDWHENSELECTEDFN] [COND ((NOT (SUBREGIONP (DSPCLIPPINGREGION NIL W) - (MENUREGION ADDEDMENU))) (* if the menu didn't fit, make it - scrollable.) + (MENUREGION ADDEDMENU))) (* if the menu didn't fit, make it + scrollable.) (WINDOWPROP W 'SCROLLFN (FUNCTION SCROLLBYREPAINTFN)) (EXTENDEXTENT W (MENUREGION ADDEDMENU] (RETURN W]) @@ -748,14 +753,18 @@ MENU ITEM]) (CHECK/MENU/IMAGE - [LAMBDA (MENU MAKEWINDOWFLG SCREEN) (* kbr%: " 5-Sep-85 20:31") + [LAMBDA (MENU MAKEWINDOWFLG SCREEN) (* ; "Edited 2-Oct-2025 17:50 by mth") + (* kbr%: " 5-Sep-85 20:31") (* returns menus image, creating one if necessary. - The image field will be a WINDOW for popup menus.) + The image field will be a WINDOW for popup menus.) (PROG (IMAGE DSP WINDOW) (OR (type? MENU MENU) (\ILLEGAL.ARG MENU)) + (COND + ((NOT (LISTP (fetch (MENU ITEMS) of MENU))) + (ERROR 'MENU "ITEMS list is empty"))) (SETQ IMAGE (fetch (MENU IMAGE) of MENU)) [OR SCREEN (SETQ SCREEN (COND ((type? WINDOW IMAGE) @@ -765,7 +774,7 @@ ((OR (NULL IMAGE) (NOT (EQ (fetch (WINDOW SCREEN) of IMAGE) SCREEN))) (* Switched screens. - *) + *) (UPDATE/MENU/IMAGE MENU SCREEN) (SETQ IMAGE (fetch (MENU IMAGE) of MENU] (COND @@ -774,9 +783,8 @@ (UPDATEWFROMIMAGE IMAGE)) (T (SETQ IMAGE (CREATEWFROMIMAGE IMAGE SCREEN)) (replace (MENU IMAGE) of MENU with IMAGE))) - (SETQ DSP (fetch (WINDOW DSP) of IMAGE)) - (* set the offset in the display - stream to agree with the region.) + (SETQ DSP (fetch (WINDOW DSP) of IMAGE)) (* set the offset in the display + stream to agree with the region.) (DSPXOFFSET (fetch (WINDOW WBORDER) of IMAGE) DSP) (DSPYOFFSET (fetch (WINDOW WBORDER) of IMAGE) @@ -796,7 +804,8 @@ (PROMPTPRINT (CADR ITEM]) (UPDATE/MENU/IMAGE - [LAMBDA (MNU SCREEN) (* ; "Edited 14-Jul-2025 22:34 by rmk") + [LAMBDA (MNU SCREEN) (* ; "Edited 2-Oct-2025 17:49 by mth") + (* ; "Edited 14-Jul-2025 22:34 by rmk") (* ; "Edited 16-Jul-99 15:51 by rmk:") (* ; "Edited 10-Dec-93 16:01 by sybalsky") (* ; @@ -811,6 +820,9 @@ (SETQ SCREEN (fetch (WINDOW SCREEN) of (fetch (MENU IMAGE) of MNU] (T (SETQ SCREEN LASTSCREEN] (SETQ MENUITEMS (fetch (MENU ITEMS) of MNU)) + (COND + ((NOT (LISTP MENUITEMS)) + (ERROR 'MENU "ITEMS list is empty"))) (SETQ CENTER? (fetch (MENU CENTERFLG) of MNU)) (* ; "check the font.") (COND [(FONTP (SETQ FONT (AND (fetch (MENU MENUFONT) of MNU) @@ -1710,24 +1722,24 @@ (MENU 42 POINTER)) '44) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2583 86884 (MAXMENUITEMHEIGHT 2593 . 3530) (MAXMENUITEMWIDTH 3532 . 5231) (MENU 5233 . -8130) (MENUTITLEFONT 8132 . 9572) (ADDMENU 9574 . 15012) (DELETEMENU 15014 . 16495) (MENUREGION 16497 - . 17357) (BLTMENUIMAGE 17359 . 19387) (ERASEMENUIMAGE 19389 . 20311) (DEFAULTMENUHELDFN 20313 . 20603 -) (DEFAULTWHENSELECTEDFN 20605 . 21016) (BACKGROUNDWHENSELECTEDFN 21018 . 21453) (GETMENUITEM 21455 . -22044) (MENUBUTTONFN 22046 . 22677) (MENU.HANDLER 22679 . 40781) (DOSELECTEDITEM 40783 . 41208) ( -SHOWSHADEDITEMS 41210 . 42627) (\AddShade 42629 . 43821) (\DelShade 43823 . 44094) (\FDECODE/BUTTON -44096 . 44483) (MENUITEMREGION 44485 . 47220) (\MENUITEMLABEL 47222 . 47568) (\MENUSUBITEMS 47570 . -47808) (CHECK/MENU/IMAGE 47810 . 49816) (PPROMPT2 49818 . 50207) (UPDATE/MENU/IMAGE 50209 . 65643) ( -\MAKE.ITEMS.VERT.ORDER 65645 . 67172) (\SHOWMENULABEL 67174 . 71101) (\POSITION.MENU.IMAGE 71103 . -73958) (\SMASHMENUIMAGEONRESET 73960 . 74308) (CLOSE.PROCESS.MENU 74310 . 74492) (DEFAULTSUBITEMFN -74494 . 75214) (GETMENUPROP 75216 . 75408) (PUTMENUPROP 75410 . 75783) (WAKE.MY.PROCESS 75785 . 75968) - (\INVERTITEM 75970 . 76426) (\MENU.ITEM.SELECT 76428 . 77991) (\MENU.ITEM.DESELECT 77993 . 78695) ( -\ItemNumber 78697 . 79264) (\BOXITEM 79266 . 80813) (NESTED.SUBMENU 80815 . 83533) (NESTED.SUBMENU.POS - 83535 . 86506) (WFROMMENU 86508 . 86882)) (88093 88513 (MENUREPAINTFN 88103 . 88511)) (88548 91597 ( -MAXSTRINGWIDTH 88558 . 88801) (CENTEREDPRIN1 88803 . 89240) (CENTERPRINTINREGION 89242 . 89771) ( -CENTERPRINTINAREA 89773 . 91230) (STRICTLY/BETWEEN 91232 . 91595)) (91631 97573 (UNREADITEM 91641 . -91963) (TYPEINMENU 91965 . 92166) (SHADEITEM 92168 . 93912) (RESHADEITEM 93914 . 95007) ( -MOST/VISIBLE/OPERATION 95009 . 95280) (%#BITSON 95282 . 96000) (BUTTONPANEL 96002 . 96794) ( -BUTTONPANEL/SELECTION/FN 96796 . 97348) (GETSELECTEDITEMS 97350 . 97571)) (97889 98430 (MENUDESELECT -97899 . 98116) (MENUSELECT 98118 . 98428))))) + (FILEMAP (NIL (2504 87557 (MAXMENUITEMHEIGHT 2514 . 3451) (MAXMENUITEMWIDTH 3453 . 5152) (MENU 5154 . +8294) (MENUTITLEFONT 8296 . 9736) (ADDMENU 9738 . 15275) (DELETEMENU 15277 . 16758) (MENUREGION 16760 + . 17620) (BLTMENUIMAGE 17622 . 19650) (ERASEMENUIMAGE 19652 . 20574) (DEFAULTMENUHELDFN 20576 . 20866 +) (DEFAULTWHENSELECTEDFN 20868 . 21279) (BACKGROUNDWHENSELECTEDFN 21281 . 21716) (GETMENUITEM 21718 . +22307) (MENUBUTTONFN 22309 . 22940) (MENU.HANDLER 22942 . 41044) (DOSELECTEDITEM 41046 . 41471) ( +SHOWSHADEDITEMS 41473 . 42890) (\AddShade 42892 . 44084) (\DelShade 44086 . 44357) (\FDECODE/BUTTON +44359 . 44746) (MENUITEMREGION 44748 . 47483) (\MENUITEMLABEL 47485 . 47831) (\MENUSUBITEMS 47833 . +48071) (CHECK/MENU/IMAGE 48073 . 50274) (PPROMPT2 50276 . 50665) (UPDATE/MENU/IMAGE 50667 . 66316) ( +\MAKE.ITEMS.VERT.ORDER 66318 . 67845) (\SHOWMENULABEL 67847 . 71774) (\POSITION.MENU.IMAGE 71776 . +74631) (\SMASHMENUIMAGEONRESET 74633 . 74981) (CLOSE.PROCESS.MENU 74983 . 75165) (DEFAULTSUBITEMFN +75167 . 75887) (GETMENUPROP 75889 . 76081) (PUTMENUPROP 76083 . 76456) (WAKE.MY.PROCESS 76458 . 76641) + (\INVERTITEM 76643 . 77099) (\MENU.ITEM.SELECT 77101 . 78664) (\MENU.ITEM.DESELECT 78666 . 79368) ( +\ItemNumber 79370 . 79937) (\BOXITEM 79939 . 81486) (NESTED.SUBMENU 81488 . 84206) (NESTED.SUBMENU.POS + 84208 . 87179) (WFROMMENU 87181 . 87555)) (88766 89186 (MENUREPAINTFN 88776 . 89184)) (89221 92270 ( +MAXSTRINGWIDTH 89231 . 89474) (CENTEREDPRIN1 89476 . 89913) (CENTERPRINTINREGION 89915 . 90444) ( +CENTERPRINTINAREA 90446 . 91903) (STRICTLY/BETWEEN 91905 . 92268)) (92304 98246 (UNREADITEM 92314 . +92636) (TYPEINMENU 92638 . 92839) (SHADEITEM 92841 . 94585) (RESHADEITEM 94587 . 95680) ( +MOST/VISIBLE/OPERATION 95682 . 95953) (%#BITSON 95955 . 96673) (BUTTONPANEL 96675 . 97467) ( +BUTTONPANEL/SELECTION/FN 97469 . 98021) (GETSELECTEDITEMS 98023 . 98244)) (98562 99103 (MENUDESELECT +98572 . 98789) (MENUSELECT 98791 . 99101))))) STOP diff --git a/sources/MENU.LCOM b/sources/MENU.LCOM index 4f37be6b595b3405e406d8996704c4b177b53a18..7858380903d4848e239a2138895cd4e5b9b78631 100644 GIT binary patch delta 3219 zcmZ`*&5s;M75A*|03#7Ti~z+P9wWu_qU>x}Rew%$*xu=y+4lByH{CruyV5F-V_Wfx zwH@$sKnS(Oi3148@E34EoM4lUxJHOeB5{HPArc29E}RHbu8H!iuIib|+MdI7)$8|O zy^r7fRsZ^*o&S8$`PHl@zLDKN+29s;h%H3#@4tR@eD@ALd_X<=ahXkv zp)7wgk?FMmB43A$tr+rw6%2&iqwcFexVtdDeec$T*X}-gen85M!YFE@yXAfve2*gl}%{gZn=8Vq;BbS%q_Dx>S8v|MD+T}|OB8L0f$X^1!(&};&IjU4&VZrbi~62jTYL5L^C!=AE?nAr<^q2D|Gi5W|M;5P zK2(2Q_4m$v{<&$*n4l;tC2~f>aU~}da4O@$ppd1krs*tBBl0~uoa`lWS&`41W`vey zF>)O`jMH*jNTrs|$PVZ*&&s%pv$U@==*LZZ!XjA|S%La`-irHO?cZ^Ahi!}EG*7~z zByMRDWBTbd57-lc)>DC&bbR#agpMB3-TSYf{HS+UfBrX}>!%klAoahf41c%vg(lG_ zmf-B$-CuTU?vvcFWEwU971>-g=M-{`49I2<<$4Ideo;yFi`CKg!y9%6ytJ_4v(UPU1uw7c&3ENm0AZ$;oDod45 zhQOvpnH8#{k&>XM%KK8q;-oinPa>*1B_8PW7CIaV(QabpmAl#pK<(>;ISSCk%z=?+ z!7zPESXM|{$`m9Us7#xs$%fcMm!sn(kslVGM|7%5}^<;V%~l#%=Uv&Yo=>wIhTThD%$VdnYf@5u+Zl=(q68i7iPxxU)&w_9P)JN}g# z1(`wc1WLD=Mgd_c591_}<1p!m#TcBxV4x8Q5L*UMsFbsi0(z|iiqGF-Mo%tX5i&ySEPTyz$<Ad1lgAVygVa9BWxCJW62%wq0&ivVzK4FZiOkY5q1+lB(iqj3>O6fkcUc7YX8 zbZ3dX0Fl5+p%@8O9>*#9m{N!|L6Yx-wssK| z(}lDh7{-Hzv}PRB->PtUT&!^`s0!dvNX-h(G^>^e8ME4p0pLJZx=2`K8W(FIsIdz` z@Nv2)i;4ntY$EYpMgeF`zcplz?-*Z^ee;3gdx9!l`}lYPQ8`OFzExVehbEf1y=6Kc zEKLMnn~diyWeBRQHA8zSwjpazUC>5~ayNl_z-F^>P20!?yK9NtE^Ko}IJgIl1E;N= z~Pr6C1Ds20Pj_fu}(HaV;z35uX5-shEwx2vOI?G$iHofDbMS^EKz}h2N z^D!5vQw=_JV@D=?vWkZx=s=t4SNLp*;u77!rw4{ox5_-*$X$E>)0eidV!WPApX=TE OFJAe^*}qpx^iLT((7|tvUqjt`jvC*R~P#-9?l;Zv(&uH z6>ABrW%8m)*OaTx=g-r|C7Nk24Wo#rHRtE&n{2Nm4cr;hB%nGYJN!AYLZWgL{hbNF=1N2%X|jrzbnhQ@w||s&qzSkoSo5Ju2hv&cTAiVHC-(AIENm(aNqNu%^%7Guo`4S4^c$HLLEQ8v9XStgu!#EiAWL&qJ`iP`dMkItT5eblu zuGOwJZjiQJl*SELKjBpuw1;_~#4yG^1U*c%Bn7%MP!hnaj7?M=oAgDl$TC)LYkw0J z+o-IBrBPFxKwtBsatv_FpgG#5JTOd0MyFT z-u5x}a+T0aySLM1RStBF2h^0Xhc~HlWBkR!Gvl8YJ})c`Z#Gy>mX`P9aY;*sRB z3%54+-@cVRcjMW!N^nH|+J36>>iqYolKE2STMHCl1)Afxk}{F6PHSt>5uS^rIzqeE`#H3I6#i50+Z}+LmQiDOzTIfd8yhl%C9LePC5qSetd20*$1M zO`|C4iU?7utCE*4)mWDYj{l_e0nM)uwP((&{l=MiMSo)es8nJoi#{Mcb Date: Fri, 3 Oct 2025 22:09:21 -0700 Subject: [PATCH 2/3] Add function COMPILEFILETYPE (#2304) --- sources/MACHINEINDEPENDENT | 92 +++++++++++++++++++++----------- sources/MACHINEINDEPENDENT.LCOM | Bin 41486 -> 42862 bytes 2 files changed, 62 insertions(+), 30 deletions(-) diff --git a/sources/MACHINEINDEPENDENT b/sources/MACHINEINDEPENDENT index d1393294..67e15d34 100644 --- a/sources/MACHINEINDEPENDENT +++ b/sources/MACHINEINDEPENDENT @@ -1,12 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Jan-2024 10:40:56" {WMEDLEY}MACHINEINDEPENDENT.;38 117576 +(FILECREATED "29-Sep-2025 12:51:06"  +{DSK}kaplan>Local>medley3.5>working-medley>sources>MACHINEINDEPENDENT.;39 119579 :EDIT-BY rmk - :CHANGES-TO (FNS LISPSOURCEFILEP) + :CHANGES-TO (VARS MACHINEINDEPENDENTCOMS) - :PREVIOUS-DATE "20-Jul-2022 19:55:30" {WMEDLEY}MACHINEINDEPENDENT.;36) + :PREVIOUS-DATE "18-Jan-2024 10:40:56" +{DSK}kaplan>Local>medley3.5>working-medley>sources>MACHINEINDEPENDENT.;38) (PRETTYCOMPRINT MACHINEINDEPENDENTCOMS) @@ -28,10 +30,10 @@ (INITVARS (OK.TO.MODIFY.FNS)) [COMS (* ;  "FILEDATE, for finding out the creation date of source files, from the compiled files.") + (FNS FILEDATE COMPILEFILETYPE) (* ;; "FASL isn't loaded when MACHINEINDEPENDENT is, so we have to fake the FASL checker for now. It's defined in FASLOAD.") - (FNS FILEDATE) (P (MOVD? 'NILL 'FASL-FILEDATE] (P (MOVD? 'CL:FMAKUNBOUND 'UNDOABLY-FMAKUNBOUND)) (* ; @@ -1348,13 +1350,6 @@ WRITEFILE OF ") (* ; "FILEDATE, for finding out the creation date of source files, from the compiled files.") - - - -(* ;; -"FASL isn't loaded when MACHINEINDEPENDENT is, so we have to fake the FASL checker for now. It's defined in FASLOAD." -) - (DEFINEQ (FILEDATE @@ -1403,8 +1398,45 @@ WRITEFILE OF ") (COND (OLDPTR (SETFILEPTR STREAM OLDPTR))) (RETURN VALUE)))]) + +(COMPILEFILETYPE + [LAMBDA (CFILE) (* ; "Edited 29-Sep-2025 12:26 by rmk") + + (* ;; "Returns the type of compiler used to compile the compiled-file CFILE: CL:COMPILE-FILE IL:FAKE-COMPILE-FILE IL:BCOMP") + + (CL:WHEN CFILE + [CAR (NLSETQ + (RESETLST + [LET (STREAM COMPILER) + [if (SETQ STREAM (\GETSTREAM CFILE 'INPUT T)) + then [RESETSAVE NIL `(PROGN (SETFILEPTR ,STREAM ,(GETFILEPTR STREAM] + else (* ; + "OPENSTREAM used instead of INFILEP to allow for error correction.") + (RESETSAVE (SETQ STREAM (OPENSTREAM CFILE 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE] + (CL:WHEN (RANDACCESSP STREAM) + (SETFILEPTR STREAM 0) + [if (FASL-FILEDATE STREAM T) + then (* ; " A Dfasl file") + 'CL:COMPILE-FILE + else (SETFILEPTR STREAM 0) (* ; "Any other filetype") + (CL:MULTIPLE-VALUE-BIND (ENV FORM) + (\PARSE-FILE-HEADER STREAM 'RETURN) + (CL:WHEN (LISTP FORM) + (* ; + "First expression is for compiled file") + (SELECTQ (MKATOM (CADDDR (CDR FORM))) + (COMPILE-FILEd 'FAKE-COMPILE-FILE) + 'BCOMPL))])])])]) ) + + +(* ;; +"FASL isn't loaded when MACHINEINDEPENDENT is, so we have to fake the FASL checker for now. It's defined in FASLOAD." +) + + (MOVD? 'NILL 'FASL-FILEDATE) (MOVD? 'CL:FMAKUNBOUND 'UNDOABLY-FMAKUNBOUND) @@ -2463,23 +2495,23 @@ This has little hope of working any more.") (LOCALVARS . T) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (12537 25962 (LOAD? 12547 . 14398) (FILESLOAD 14400 . 14689) (DOFILESLOAD 14691 . 22317) - (FINDFILE-WITH-EXTENSIONS 22319 . 25518) (READ-FILECREATED 25520 . 25960)) (26079 31400 (DMPHASH -26089 . 27683) (HASHOVERFLOW 27685 . 31398)) (32156 64264 (BKBUFS 32166 . 33285) (CHANGENAME 33287 . -33548) (CHNGNM 33550 . 35398) (CLBUFS 35400 . 36673) (DEFINE 36675 . 37399) (FNS.PUTDEF 37401 . 40816) - (EQMEMB 40818 . 41000) (EQUALN 41002 . 41831) (FNCHECK 41833 . 43840) (FNTYP1 43842 . 43939) (LCSKIP -43941 . 44785) (MAPRINT 44787 . 45733) (MKLIST 45735 . 45885) (NAMEFIELD 45887 . 47412) (NLIST 47414 - . 47749) (PRINTBELLS 47751 . 47877) (PROMPTCHAR 47879 . 49769) (RAISEP 49771 . 50032) (READFILE 50034 - . 52378) (READLINE 52380 . 57820) (REMPROPLIST 57822 . 58710) (RESETBUFS 58712 . 59162) (TAB 59164 . -59760) (UNSAVED1 59762 . 60867) (WRITEFILE 60869 . 62611) (CLOSE-AND-MAYBE-DELETE 62613 . 62957) ( -UNSAFE.TO.MODIFY 62959 . 64262)) (66619 69563 (FILEDATE 66629 . 69561)) (69793 96996 (FILEMAP 69803 . -70273) (\PARSE-FILE-HEADER 70275 . 74090) (GET-ENVIRONMENT-AND-FILEMAP 74092 . 76319) ( -LOOKUP-ENVIRONMENT-AND-FILEMAP 76321 . 78512) (GET-FILEMAP-FROM-FILECREATED 78514 . 79338) ( -\FILEMAP-HASHOVERFLOW 79340 . 84004) (FLUSHFILEMAPS 84006 . 84629) (LISPSOURCEFILEP 84631 . 86023) ( -LISPFILETYPE 86025 . 89274) (GETFILEMAP 89276 . 89695) (PUTFILEMAP 89697 . 91888) (UPDATEFILEMAP 91890 - . 96994)) (97662 101248 (LVLPRINT 97672 . 97845) (LVLPRIN1 97847 . 98029) (LVLPRIN2 98031 . 98263) ( -LVLPRIN 98265 . 99279) (LVLPRIN0 99281 . 101246)) (101282 106199 (FLUSHRIGHT 101292 . 102107) ( -PRINTPARA 102109 . 103207) (PRINTPARA1 103209 . 106197)) (106235 108520 (SUBLIS 106245 . 106853) ( -SUBPAIR 106855 . 108083) (DSUBLIS 108085 . 108518)) (108543 109143 (CONSTANTOK 108553 . 109141)) ( -110896 111601 (NLAMBDA.ARGS 110906 . 111599))))) + (FILEMAP (NIL (12643 26068 (LOAD? 12653 . 14504) (FILESLOAD 14506 . 14795) (DOFILESLOAD 14797 . 22423) + (FINDFILE-WITH-EXTENSIONS 22425 . 25624) (READ-FILECREATED 25626 . 26066)) (26185 31506 (DMPHASH +26195 . 27789) (HASHOVERFLOW 27791 . 31504)) (32262 64370 (BKBUFS 32272 . 33391) (CHANGENAME 33393 . +33654) (CHNGNM 33656 . 35504) (CLBUFS 35506 . 36779) (DEFINE 36781 . 37505) (FNS.PUTDEF 37507 . 40922) + (EQMEMB 40924 . 41106) (EQUALN 41108 . 41937) (FNCHECK 41939 . 43946) (FNTYP1 43948 . 44045) (LCSKIP +44047 . 44891) (MAPRINT 44893 . 45839) (MKLIST 45841 . 45991) (NAMEFIELD 45993 . 47518) (NLIST 47520 + . 47855) (PRINTBELLS 47857 . 47983) (PROMPTCHAR 47985 . 49875) (RAISEP 49877 . 50138) (READFILE 50140 + . 52484) (READLINE 52486 . 57926) (REMPROPLIST 57928 . 58816) (RESETBUFS 58818 . 59268) (TAB 59270 . +59866) (UNSAVED1 59868 . 60973) (WRITEFILE 60975 . 62717) (CLOSE-AND-MAYBE-DELETE 62719 . 63063) ( +UNSAFE.TO.MODIFY 63065 . 64368)) (66589 71430 (FILEDATE 66599 . 69531) (COMPILEFILETYPE 69533 . 71428) +) (71796 98999 (FILEMAP 71806 . 72276) (\PARSE-FILE-HEADER 72278 . 76093) (GET-ENVIRONMENT-AND-FILEMAP + 76095 . 78322) (LOOKUP-ENVIRONMENT-AND-FILEMAP 78324 . 80515) (GET-FILEMAP-FROM-FILECREATED 80517 . +81341) (\FILEMAP-HASHOVERFLOW 81343 . 86007) (FLUSHFILEMAPS 86009 . 86632) (LISPSOURCEFILEP 86634 . +88026) (LISPFILETYPE 88028 . 91277) (GETFILEMAP 91279 . 91698) (PUTFILEMAP 91700 . 93891) ( +UPDATEFILEMAP 93893 . 98997)) (99665 103251 (LVLPRINT 99675 . 99848) (LVLPRIN1 99850 . 100032) ( +LVLPRIN2 100034 . 100266) (LVLPRIN 100268 . 101282) (LVLPRIN0 101284 . 103249)) (103285 108202 ( +FLUSHRIGHT 103295 . 104110) (PRINTPARA 104112 . 105210) (PRINTPARA1 105212 . 108200)) (108238 110523 ( +SUBLIS 108248 . 108856) (SUBPAIR 108858 . 110086) (DSUBLIS 110088 . 110521)) (110546 111146 ( +CONSTANTOK 110556 . 111144)) (112899 113604 (NLAMBDA.ARGS 112909 . 113602))))) STOP diff --git a/sources/MACHINEINDEPENDENT.LCOM b/sources/MACHINEINDEPENDENT.LCOM index f87de65ba0a4986c4555bee1a9cea8176e9366c0..3a4d6ef134724d933e83b51a323f77d49ea35c44 100644 GIT binary patch delta 1139 zcmbVLU2D@&7;dX`8o>`xFNz;8fw8ullB7-B1gXUKq>anha+111L2FyKx~{G5{6e(< zzzu?UC3xe#xZUr@>-`3QfhhO`JUQ*gieBx&IpjR=^L{<&&HL}Mp9is>hpVE@;r4(N zc~JsER3t&+b1Wp-W`A?g>9$+Y?*R+Un=)Q{d)FVehoj;~W6*8%iblWL=oUBIt#12u zCM^|T_JL6-7z@GN?L zTvJ^Prdq1%7SgRUau7Kzk92~Qpg1n7>9&u#GARUDp};+8^g^+-An;0-S0p0#3F;X2 zpAVbuQPB+i=+)idQBj+pY8Skyi^2Y4d@MpK6ah5I0M->H|S>$TE}+WyV3ufo?gz2V(wsjihPEwJR1BCT5ZwBpwnIFi|pWjI?`T8|9j6_$Zl7 zGBj+=K*8wIpQEwZc$~jD%@@iO{$9bp)0v|~5~P<4b9YXYi3mPc_zSbV-Gj=f+bpA5 s7(!2~<17OuA(4WhH+mOyAlTVX1&dn?^UJ67trUDbg9C#7 zLxY@M-8_9<0~9iWX1ay?_$VM7qNk^)q>z$W0<;sW>847WTpA$#n$AJ4jv=lt3QE`= zkK$Mk3k5?%b5nD($p;x_+}!+v(H*0yU= Date: Mon, 6 Oct 2025 10:39:33 -0700 Subject: [PATCH 3/3] CLIPBOARD passes file to xclip (windows) (#2297) * CLIPBOARD passes file to xclip (windows) * More careful to specify {UNIX} as the host on the Medley side * Make sure the process stream is closed in the xclip case * This time using ShellCommand * Use DSK and UNIX-FILE-NAME * Added .txt to the tmp file --- library/CLIPBOARD | 54 ++++++++++++++++++++++++++--------------- library/CLIPBOARD.LCOM | Bin 3740 -> 4578 bytes 2 files changed, 35 insertions(+), 19 deletions(-) diff --git a/library/CLIPBOARD b/library/CLIPBOARD index 6dfe3bb9..df92fffe 100644 --- a/library/CLIPBOARD +++ b/library/CLIPBOARD @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Apr-2024 09:12:04" {WMEDLEY}CLIPBOARD.;18 7248 +(FILECREATED "25-Sep-2025 15:00:01"  +{DSK}kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;28 8305 :EDIT-BY rmk - :CHANGES-TO (FNS INSTALL-CLIPBOARD) - (VARS CLIPBOARDCOMS) + :CHANGES-TO (FNS PUTCLIPBOARD CLIPBOARD-COPY-STREAM) - :PREVIOUS-DATE " 2-Apr-2024 17:02:09" {WMEDLEY}CLIPBOARD.;17) + :PREVIOUS-DATE "21-Apr-2024 09:12:04" {WMEDLEY}CLIPBOARD.;18) (PRETTYCOMPRINT CLIPBOARDCOMS) @@ -58,12 +58,29 @@ (CONCATCODES (BIND C WHILE (SETQ C (READCCODE s)) COLLECT C]) (PUTCLIPBOARD - [LAMBDA (OBJECT PRINTFN) (* ; "Edited 23-Feb-2021 11:32 by rmk:") - (* ; "Edited 25-Apr-2018 16:49 by rmk:") - (CL:WITH-OPEN-STREAM (s (CLIPBOARD-COPY-STREAM)) - (IF PRINTFN - THEN (APPLY* PRINTFN OBJECT s) - ELSE (PRIN3 OBJECT s]) + [LAMBDA (OBJECT PRINTFN) (* ; "Edited 25-Sep-2025 14:59 by rmk") + (* ; "Edited 23-Feb-2021 11:32 by rmk:") + (* ; "Edited 25-Apr-2018 16:49 by rmk:") + (if (STRPOS "darwin" (UNIX-GETENV "OSTYPE")) + then + (* ;; "pbpaste doesn't seem to take a file argument.") + + (CL:WITH-OPEN-STREAM (S (CREATE-PROCESS-STREAM "pbcopy")) + (CL:IF PRINTFN + (APPLY* PRINTFN OBJECT S) + (PRIN3 OBJECT S))) + else + (* ;; "Try to make xclip more reliable by passing a file that already contains the input.") + + (LET ((TEMPFILE (OUTFILEP "{DSK}/tmp/xclip-copy.txt"))) + (CL:WITH-OPEN-FILE (S TEMPFILE :DIRECTION :OUTPUT :EXTERNAL-FORMAT ( + SYSTEM-EXTERNALFORMAT + )) + (CL:IF PRINTFN + (APPLY* PRINTFN OBJECT S) + (PRIN3 OBJECT S))) + (ShellCommand (CONCAT "xclip -i -selection clipboard " (UNIX-FILE-NAME TEMPFILE))) + (DELFILE TEMPFILE]) (PASTEFROMCLIPBOARD [LAMBDA NIL (* ; "Edited 15-Feb-2021 23:43 by rmk:") @@ -81,13 +98,12 @@ ELSE (BIND C WHILE (SETQ C (GNCCODE STR)) DO (BKSYSCHARCODE C]) (CLIPBOARD-COPY-STREAM - [LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk") + [LAMBDA NIL (* ; "Edited 24-Sep-2025 14:27 by rmk") + (* ; "Edited 7-Jul-2022 23:51 by rmk") (* ; "Edited 23-Feb-2021 22:11 by rmk:") - (LET (STRM (OST (UNIX-GETENV "OSTYPE"))) - (SETQ STRM (CREATE-PROCESS-STREAM (CL:IF (STRPOS "darwin" OST) - "pbcopy" - "xclip -i -selection clipboard"))) - STRM]) + (CREATE-PROCESS-STREAM (CL:IF (STRPOS "darwin" (UNIX-GETENV "OSTYPE")) + "pbcopy" + "xclip -i -selection clipboard")]) (CLIPBOARD-PASTE-STREAM [LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk") @@ -146,7 +162,7 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1148 5429 (INSTALL-CLIPBOARD 1158 . 2485) (GETCLIPBOARD 2487 . 2861) (PUTCLIPBOARD 2863 - . 3268) (PASTEFROMCLIPBOARD 3270 . 4188) (CLIPBOARD-COPY-STREAM 4190 . 4705) (CLIPBOARD-PASTE-STREAM -4707 . 5427)) (5430 6969 (SEDIT.COPYTOCLIPBOARD 5440 . 6967))))) + (FILEMAP (NIL (1167 6486 (INSTALL-CLIPBOARD 1177 . 2504) (GETCLIPBOARD 2506 . 2880) (PUTCLIPBOARD 2882 + . 4306) (PASTEFROMCLIPBOARD 4308 . 5226) (CLIPBOARD-COPY-STREAM 5228 . 5762) (CLIPBOARD-PASTE-STREAM +5764 . 6484)) (6487 8026 (SEDIT.COPYTOCLIPBOARD 6497 . 8024))))) STOP diff --git a/library/CLIPBOARD.LCOM b/library/CLIPBOARD.LCOM index f5565a4fc245977d76feeb6360d8f89f0fdb9f92..b077be285e6fbbd0a97f069e4b04c325eb34de7d 100644 GIT binary patch delta 1286 zcmb_c%Wl(95Ou0FkW__MAc{b!g8|VjoL;{Y$Dl~5Ad4M*0vq}P{SDTv`3D#~p^jR?iY%_?+&lN2Gcz~-eDBAD4_hOValAgm5l#eF zlnIduOT!A?>~;EW-)ljy3p8ZjR-BEKr}YDGa8TNB^!-M+r1zQ)ztr(szIV*$#L{7J zu;1?PG2@+*-`*WG2FE2u*Q_N2UY|@`yuGRLtxSymL+Os6RM(B!g9V z&#yxpja2Kp4$};|T#klTV~9pCG9xid=xk=Cs_Cj?t7TWMVA6$popHhct3Z%=A_gxL zchab9IAH~WJiok<1=+IIP0g%3Oa+|;_Y=1hnU5!M`ZMt=Ip;tXcqkK*7lV50b%fao zK1-Em%Y+aqVYv3I7?MWLPR2gh4knKIB?aP6?O!{ zL;<7lqK4SAHN&kM7!xqp)>XyL0`+y4qGoy&{-PxvMwxK=M&gb3;!I*M+>DN+<@p{J z__NnWanfR9W<5%Zm#g8Oc~qb%q)1+%*od$`7apHIOeJnaTrAhYK1KjsHl2W z9-9}ydE@#1Na=MtjcyB{cM%lRP|7Zb0@Mv{iwRR1qg+#gL?J*i5Aq*7%*0QT1sM%t zEg<1>MYD0fnrVQDXiO%MnCm+JXTw@K)I$eSu#;X^@LN#efQ~)~tHVxz^{DB$`%JUf zKh6!0hBRQ~=>BeqX($41I_|cm(jWlcY77qBT{;_(`J1QTuOt(Kq3J+94rd#UHGU`2 l>-rSo_wg6i4c!>`pE%fX3=6@q8ZYSM4`nsmbRdlL!i^%;i^8;+^<`6LpW$G&maH;T&&wB``S9V!1^WLX%c2Ht*}%S z)yo~EfMEt9=#XY%Tm&(nF(lnr)GInrdnD9qg2=v$3j5LAV1l&9em7SdUXu1%y>+{t z_KHP#7h_C#hx3i)^*Vbax9eN%R90`?tnp)+h;bN63K);sH|gF(9>fMz4iBg083Nq` eG#XUzCnpF@KuKQoQ;OJg`3_rMZOsMwXX6iq&5;)X