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 4f37be6b5..785838090 100644 Binary files a/sources/MENU.LCOM and b/sources/MENU.LCOM differ