From 4d6aa38b8b26d8b6a349920359591326dbc6d0f5 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Thu, 2 Oct 2025 18:00:08 -0700 Subject: [PATCH] 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 e6706c076..01835fc2e 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