Skip to content

Check that a MENU has ITEMS that is LISTP before trying to display/use it. #2309

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Oct 6, 2025
Merged

Check that a MENU has ITEMS that is LISTP before trying to display/use it. #2309

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
132 changes: 72 additions & 60 deletions sources/MENU
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "14-Jul-2025 22:35:12" {DSK}<Users>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}<Users>kaplan>Local>medley3.5>working-medley>sources>MENU.;1)
:PREVIOUS-DATE "14-Jul-2025 22:35:12" {SOURCES}MENU.;1)


(PRETTYCOMPRINT MENUCOMS)
Expand Down Expand Up @@ -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))
Expand All @@ -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)
Expand Down Expand Up @@ -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)))
Expand All @@ -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)
Expand All @@ -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])
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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")
(* ;
Expand All @@ -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)
Expand Down Expand Up @@ -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
Binary file modified sources/MENU.LCOM
View file
Open in desktop
Binary file not shown.