github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

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

Browse Source 
Checking added to FNS: ADDMENU, CHECK/MENU/IMAGE, UPDATE/MENU/IMAGE, and MENU.
This commit is contained in:
Matt Heffron 2025-10-02 18:00:08 -07:00
parent 69832c5db0
commit 4d6aa38b8b
2 changed files with 72 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
sources/MENU
View File

@ -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)
@ -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))
@ -124,8 +127,8 @@
(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))
(OR (SETQ MVAL (MENU.HANDLER MENU DSP NIL T
NESTEDFLG))
(GO LP))
(RETURN MVAL)))
(T (MENU.HANDLER MENU DSP T T NESTEDFLG))))]
@ -159,13 +162,17 @@
(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.)
(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))
@ -175,8 +182,8 @@
[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,8 +194,8 @@
((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)
@ -223,8 +230,8 @@
(* put MENUBUTTONFN in CURSORINFN so it will get called if button is down and
 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
@ -234,12 +241,10 @@
[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
@ -748,7 +753,8 @@
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.)
@ -756,6 +762,9 @@
(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)
@ -774,8 +783,7 @@
(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
(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)
@ -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

BIN
sources/MENU.LCOM
View File

Binary file not shown.