|
1 | 1 | (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) |
2 | 2 |
|
3 | | -(FILECREATED "14-Jul-2025 22:35:12" {DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MENU.;3 101431 |
| 3 | +(FILECREATED " 2-Oct-2025 17:53:41" {SOURCES}MENU.;2 102104 |
4 | 4 |
|
5 | | - :EDIT-BY rmk |
| 5 | + :EDIT-BY "mth" |
6 | 6 |
|
7 | | - :CHANGES-TO (FNS MENUTITLEFONT UPDATE/MENU/IMAGE) |
| 7 | + :CHANGES-TO (FNS ADDMENU CHECK/MENU/IMAGE UPDATE/MENU/IMAGE MENU) |
8 | 8 |
|
9 | | - :PREVIOUS-DATE "16-Jul-99 15:51:36" |
10 | | -{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MENU.;1) |
| 9 | + :PREVIOUS-DATE "14-Jul-2025 22:35:12" {SOURCES}MENU.;1) |
11 | 10 |
|
12 | 11 |
|
13 | 12 | (PRETTYCOMPRINT MENUCOMS) |
|
92 | 91 | (T 0] finally (RETURN ANSWER]) |
93 | 92 |
|
94 | 93 | (MENU |
95 | | - [LAMBDA (MENU POSITION RELEASECONTROLFLG NESTEDFLG)(* ; "Edited 21-Jun-88 19:00 by jds") |
| 94 | + [LAMBDA (MENU POSITION RELEASECONTROLFLG NESTEDFLG) (* ; "Edited 2-Oct-2025 17:49 by mth") |
| 95 | + (* ; "Edited 21-Jun-88 19:00 by jds") |
96 | 96 | (DECLARE (LOCALVARS . T)) |
97 | 97 |
|
98 | 98 | (* ;; "puts a menu on the screen and waits for the user to select one of the items") |
99 | 99 |
|
100 | 100 | (\DTEST MENU 'MENU) |
| 101 | + (COND |
| 102 | + ((NOT (LISTP (fetch (MENU ITEMS) of MENU))) |
| 103 | + (ERROR 'MENU "ITEMS list is empty"))) |
101 | 104 | (PROG (IMAGE SELVAL DSP) (* ; "make sure the image is a window") |
102 | 105 | [SETQ IMAGE (COND |
103 | 106 | ((NOT (EQ POSITION 'INPLACE)) |
|
119 | 122 | (RETURN NIL)) |
120 | 123 | (GETMOUSESTATE) |
121 | 124 | (* ; |
122 | | - "if mouse state is up, then someone came into the window with the mouse down. Ignore it.") |
| 125 | + "if mouse state is up, then someone came into the window with the mouse down. Ignore it.") |
123 | 126 | (OR (MOUSESTATE (OR LEFT RIGHT MIDDLE)) |
124 | 127 | (GO LP)) |
125 | 128 | (* ; |
126 | | - "MVAL will be NIL only if the user clicked up outside the window") |
127 | | - (OR (SETQ MVAL (MENU.HANDLER MENU DSP NIL |
128 | | - T NESTEDFLG)) |
| 129 | + "MVAL will be NIL only if the user clicked up outside the window") |
| 130 | + (OR (SETQ MVAL (MENU.HANDLER MENU DSP NIL T |
| 131 | + NESTEDFLG)) |
129 | 132 | (GO LP)) |
130 | 133 | (RETURN MVAL))) |
131 | 134 | (T (MENU.HANDLER MENU DSP T T NESTEDFLG))))] |
132 | 135 | (* ; |
133 | | - "evaluate menu form after image has been taken down.") |
| 136 | + "evaluate menu form after image has been taken down.") |
134 | 137 | (RETURN (COND |
135 | 138 | (NESTEDFLG SELVAL) |
136 | 139 | (SELVAL (DOSELECTEDITEM MENU (CAR SELVAL) |
|
159 | 162 | (T (DSPFONT NIL (fetch (SCREEN SCTITLEDS) of SCREEN]) |
160 | 163 |
|
161 | 164 | (ADDMENU |
162 | | - [LAMBDA (ADDEDMENU W POSITION DONTOPENFLG) (* kbr%: "24-Jan-86 18:00") |
| 165 | + [LAMBDA (ADDEDMENU W POSITION DONTOPENFLG) (* ; "Edited 2-Oct-2025 17:51 by mth") |
| 166 | + (* kbr%: "24-Jan-86 18:00") |
163 | 167 |
|
164 | 168 | (* adds a menu to a window. If W is not given, it is created; |
165 | | - sized a necessary.) |
| 169 | + sized a necessary.) |
166 | 170 |
|
167 | 171 | (OR (TYPENAMEP ADDEDMENU 'MENU) |
168 | 172 | (\ILLEGAL.ARG ADDEDMENU)) |
| 173 | + (COND |
| 174 | + ((NOT (LISTP (fetch (MENU ITEMS) of ADDEDMENU))) |
| 175 | + (ERROR 'ADDEDMENU "ITEMS list is empty"))) |
169 | 176 | (PROG (IMAGEWIDTH IMAGEHEIGHT SCREEN) |
170 | 177 | (SETQ IMAGEWIDTH (fetch (MENU IMAGEWIDTH) of ADDEDMENU)) |
171 | 178 | (SETQ IMAGEHEIGHT (fetch (MENU IMAGEHEIGHT) of ADDEDMENU)) |
172 | 179 | (* put menu at POSITION if argument, |
173 | | - otherwise its stored position, |
174 | | - otherwise at cursorposition) |
| 180 | + otherwise its stored position, |
| 181 | + otherwise at cursorposition) |
175 | 182 | [COND |
176 | 183 | ((POSITIONP POSITION)) |
177 | 184 | ((SETQ POSITION (fetch (MENU MENUPOSITION) of ADDEDMENU))) |
178 | | - (W (* if a window is given, put it in |
179 | | - the lower left corner.) |
| 185 | + (W (* if a window is given, put it in the |
| 186 | + lower left corner.) |
180 | 187 | (SETQ POSITION (create POSITION |
181 | 188 | XCOORD _ 0 |
182 | 189 | YCOORD _ 0))) |
|
187 | 194 | ((WINDOWP W) |
188 | 195 |
|
189 | 196 | (* adding to an existing window. To avoid partial images when window is partly |
190 | | - off the screen, this case could close window then blt to save region then |
191 | | - reopen window.) |
| 197 | + off the screen, this case could close window then blt to save region then reopen |
| 198 | + window.) |
192 | 199 | (* locate menu grid in MENU.) |
193 | 200 | (replace (REGION LEFT) of (fetch (MENU MENUGRID) of ADDEDMENU) |
194 | 201 | with (IPLUS (fetch (POSITION XCOORD) of POSITION) |
195 | | - (fetch (MENU MENUOUTLINESIZE) of ADDEDMENU))) |
| 202 | + (fetch (MENU MENUOUTLINESIZE) of ADDEDMENU))) |
196 | 203 | (replace (REGION BOTTOM) of (fetch (MENU MENUGRID) of ADDEDMENU) |
197 | 204 | with (IPLUS (fetch (POSITION YCOORD) of POSITION) |
198 | | - (fetch (MENU MENUOUTLINESIZE) of ADDEDMENU))) |
| 205 | + (fetch (MENU MENUOUTLINESIZE) of ADDEDMENU))) |
199 | 206 | (* Blt image into Window.) |
200 | 207 | (BLTMENUIMAGE ADDEDMENU (WINDOWPROP W 'DSP) |
201 | 208 | DONTOPENFLG)) |
202 | 209 | (T (* have to create new window. |
203 | | - Put position at Origin.) |
| 210 | + Put position at Origin.) |
204 | 211 | (SETQ SCREEN (COND |
205 | 212 | ((type? SCREEN W) |
206 | 213 | W) |
|
221 | 228 | (OR DONTOPENFLG (OPENW W] |
222 | 229 |
|
223 | 230 | (* put MENUBUTTONFN in CURSORINFN so it will get called if button is down and |
224 | | - moves into W.) |
| 231 | + moves into W.) |
225 | 232 |
|
226 | | - (WINDOWPROP W 'CURSORINFN (FUNCTION MENUBUTTONFN)) (* Set ButtonEventFn to activate |
227 | | - menu selection.) |
| 233 | + (WINDOWPROP W 'CURSORINFN (FUNCTION MENUBUTTONFN)) (* Set ButtonEventFn to activate menu |
| 234 | + selection.) |
228 | 235 | (WINDOWPROP W 'BUTTONEVENTFN (FUNCTION MENUBUTTONFN)) |
229 | 236 | (WINDOWPROP W 'CURSORMOVEDFN (FUNCTION MENUBUTTONFN)) |
230 | 237 | (* put ADDEDMENU on USERDATA so |
231 | | - MENUBUTTONFN can get at it.) |
| 238 | + MENUBUTTONFN can get at it.) |
232 | 239 | (WINDOWADDPROP W 'MENU ADDEDMENU) |
233 | 240 | (WINDOWADDPROP W 'REPAINTFN (FUNCTION MENUREPAINTFN)) |
234 | 241 | [COND |
235 | 242 | ((NULL (fetch (MENU WHENSELECTEDFN) of ADDEDMENU)) |
236 | 243 |
|
237 | | - (* make the default selection function call EVAL.AS.PROCESS instead of EVAL so |
238 | | - it won't tie up background.) |
| 244 | + (* make the default selection function call EVAL.AS.PROCESS instead of EVAL so it |
| 245 | + won't tie up background.) |
239 | 246 |
|
240 | | - (replace (MENU WHENSELECTEDFN) of ADDEDMENU with (FUNCTION |
241 | | - BACKGROUNDWHENSELECTEDFN |
242 | | - ] |
| 247 | + (replace (MENU WHENSELECTEDFN) of ADDEDMENU with (FUNCTION BACKGROUNDWHENSELECTEDFN] |
243 | 248 | [COND |
244 | 249 | ((NOT (SUBREGIONP (DSPCLIPPINGREGION NIL W) |
245 | | - (MENUREGION ADDEDMENU))) (* if the menu didn't fit, make it |
246 | | - scrollable.) |
| 250 | + (MENUREGION ADDEDMENU))) (* if the menu didn't fit, make it |
| 251 | + scrollable.) |
247 | 252 | (WINDOWPROP W 'SCROLLFN (FUNCTION SCROLLBYREPAINTFN)) |
248 | 253 | (EXTENDEXTENT W (MENUREGION ADDEDMENU] |
249 | 254 | (RETURN W]) |
|
748 | 753 | MENU ITEM]) |
749 | 754 |
|
750 | 755 | (CHECK/MENU/IMAGE |
751 | | - [LAMBDA (MENU MAKEWINDOWFLG SCREEN) (* kbr%: " 5-Sep-85 20:31") |
| 756 | + [LAMBDA (MENU MAKEWINDOWFLG SCREEN) (* ; "Edited 2-Oct-2025 17:50 by mth") |
| 757 | + (* kbr%: " 5-Sep-85 20:31") |
752 | 758 |
|
753 | 759 | (* returns menus image, creating one if necessary. |
754 | | - The image field will be a WINDOW for popup menus.) |
| 760 | + The image field will be a WINDOW for popup menus.) |
755 | 761 |
|
756 | 762 | (PROG (IMAGE DSP WINDOW) |
757 | 763 | (OR (type? MENU MENU) |
758 | 764 | (\ILLEGAL.ARG MENU)) |
| 765 | + (COND |
| 766 | + ((NOT (LISTP (fetch (MENU ITEMS) of MENU))) |
| 767 | + (ERROR 'MENU "ITEMS list is empty"))) |
759 | 768 | (SETQ IMAGE (fetch (MENU IMAGE) of MENU)) |
760 | 769 | [OR SCREEN (SETQ SCREEN (COND |
761 | 770 | ((type? WINDOW IMAGE) |
|
765 | 774 | ((OR (NULL IMAGE) |
766 | 775 | (NOT (EQ (fetch (WINDOW SCREEN) of IMAGE) |
767 | 776 | SCREEN))) (* Switched screens. |
768 | | - *) |
| 777 | + *) |
769 | 778 | (UPDATE/MENU/IMAGE MENU SCREEN) |
770 | 779 | (SETQ IMAGE (fetch (MENU IMAGE) of MENU] |
771 | 780 | (COND |
|
774 | 783 | (UPDATEWFROMIMAGE IMAGE)) |
775 | 784 | (T (SETQ IMAGE (CREATEWFROMIMAGE IMAGE SCREEN)) |
776 | 785 | (replace (MENU IMAGE) of MENU with IMAGE))) |
777 | | - (SETQ DSP (fetch (WINDOW DSP) of IMAGE)) |
778 | | - (* set the offset in the display |
779 | | - stream to agree with the region.) |
| 786 | + (SETQ DSP (fetch (WINDOW DSP) of IMAGE)) (* set the offset in the display |
| 787 | + stream to agree with the region.) |
780 | 788 | (DSPXOFFSET (fetch (WINDOW WBORDER) of IMAGE) |
781 | 789 | DSP) |
782 | 790 | (DSPYOFFSET (fetch (WINDOW WBORDER) of IMAGE) |
|
796 | 804 | (PROMPTPRINT (CADR ITEM]) |
797 | 805 |
|
798 | 806 | (UPDATE/MENU/IMAGE |
799 | | - [LAMBDA (MNU SCREEN) (* ; "Edited 14-Jul-2025 22:34 by rmk") |
| 807 | + [LAMBDA (MNU SCREEN) (* ; "Edited 2-Oct-2025 17:49 by mth") |
| 808 | + (* ; "Edited 14-Jul-2025 22:34 by rmk") |
800 | 809 | (* ; "Edited 16-Jul-99 15:51 by rmk:") |
801 | 810 | (* ; "Edited 10-Dec-93 16:01 by sybalsky") |
802 | 811 | (* ; |
|
811 | 820 | (SETQ SCREEN (fetch (WINDOW SCREEN) of (fetch (MENU IMAGE) of MNU] |
812 | 821 | (T (SETQ SCREEN LASTSCREEN] |
813 | 822 | (SETQ MENUITEMS (fetch (MENU ITEMS) of MNU)) |
| 823 | + (COND |
| 824 | + ((NOT (LISTP MENUITEMS)) |
| 825 | + (ERROR 'MENU "ITEMS list is empty"))) |
814 | 826 | (SETQ CENTER? (fetch (MENU CENTERFLG) of MNU)) (* ; "check the font.") |
815 | 827 | (COND |
816 | 828 | [(FONTP (SETQ FONT (AND (fetch (MENU MENUFONT) of MNU) |
|
1710 | 1722 | (MENU 42 POINTER)) |
1711 | 1723 | '44) |
1712 | 1724 | (DECLARE%: DONTCOPY |
1713 | | - (FILEMAP (NIL (2583 86884 (MAXMENUITEMHEIGHT 2593 . 3530) (MAXMENUITEMWIDTH 3532 . 5231) (MENU 5233 . |
1714 | | -8130) (MENUTITLEFONT 8132 . 9572) (ADDMENU 9574 . 15012) (DELETEMENU 15014 . 16495) (MENUREGION 16497 |
1715 | | - . 17357) (BLTMENUIMAGE 17359 . 19387) (ERASEMENUIMAGE 19389 . 20311) (DEFAULTMENUHELDFN 20313 . 20603 |
1716 | | -) (DEFAULTWHENSELECTEDFN 20605 . 21016) (BACKGROUNDWHENSELECTEDFN 21018 . 21453) (GETMENUITEM 21455 . |
1717 | | -22044) (MENUBUTTONFN 22046 . 22677) (MENU.HANDLER 22679 . 40781) (DOSELECTEDITEM 40783 . 41208) ( |
1718 | | -SHOWSHADEDITEMS 41210 . 42627) (\AddShade 42629 . 43821) (\DelShade 43823 . 44094) (\FDECODE/BUTTON |
1719 | | -44096 . 44483) (MENUITEMREGION 44485 . 47220) (\MENUITEMLABEL 47222 . 47568) (\MENUSUBITEMS 47570 . |
1720 | | -47808) (CHECK/MENU/IMAGE 47810 . 49816) (PPROMPT2 49818 . 50207) (UPDATE/MENU/IMAGE 50209 . 65643) ( |
1721 | | -\MAKE.ITEMS.VERT.ORDER 65645 . 67172) (\SHOWMENULABEL 67174 . 71101) (\POSITION.MENU.IMAGE 71103 . |
1722 | | -73958) (\SMASHMENUIMAGEONRESET 73960 . 74308) (CLOSE.PROCESS.MENU 74310 . 74492) (DEFAULTSUBITEMFN |
1723 | | -74494 . 75214) (GETMENUPROP 75216 . 75408) (PUTMENUPROP 75410 . 75783) (WAKE.MY.PROCESS 75785 . 75968) |
1724 | | - (\INVERTITEM 75970 . 76426) (\MENU.ITEM.SELECT 76428 . 77991) (\MENU.ITEM.DESELECT 77993 . 78695) ( |
1725 | | -\ItemNumber 78697 . 79264) (\BOXITEM 79266 . 80813) (NESTED.SUBMENU 80815 . 83533) (NESTED.SUBMENU.POS |
1726 | | - 83535 . 86506) (WFROMMENU 86508 . 86882)) (88093 88513 (MENUREPAINTFN 88103 . 88511)) (88548 91597 ( |
1727 | | -MAXSTRINGWIDTH 88558 . 88801) (CENTEREDPRIN1 88803 . 89240) (CENTERPRINTINREGION 89242 . 89771) ( |
1728 | | -CENTERPRINTINAREA 89773 . 91230) (STRICTLY/BETWEEN 91232 . 91595)) (91631 97573 (UNREADITEM 91641 . |
1729 | | -91963) (TYPEINMENU 91965 . 92166) (SHADEITEM 92168 . 93912) (RESHADEITEM 93914 . 95007) ( |
1730 | | -MOST/VISIBLE/OPERATION 95009 . 95280) (%#BITSON 95282 . 96000) (BUTTONPANEL 96002 . 96794) ( |
1731 | | -BUTTONPANEL/SELECTION/FN 96796 . 97348) (GETSELECTEDITEMS 97350 . 97571)) (97889 98430 (MENUDESELECT |
1732 | | -97899 . 98116) (MENUSELECT 98118 . 98428))))) |
| 1725 | + (FILEMAP (NIL (2504 87557 (MAXMENUITEMHEIGHT 2514 . 3451) (MAXMENUITEMWIDTH 3453 . 5152) (MENU 5154 . |
| 1726 | +8294) (MENUTITLEFONT 8296 . 9736) (ADDMENU 9738 . 15275) (DELETEMENU 15277 . 16758) (MENUREGION 16760 |
| 1727 | + . 17620) (BLTMENUIMAGE 17622 . 19650) (ERASEMENUIMAGE 19652 . 20574) (DEFAULTMENUHELDFN 20576 . 20866 |
| 1728 | +) (DEFAULTWHENSELECTEDFN 20868 . 21279) (BACKGROUNDWHENSELECTEDFN 21281 . 21716) (GETMENUITEM 21718 . |
| 1729 | +22307) (MENUBUTTONFN 22309 . 22940) (MENU.HANDLER 22942 . 41044) (DOSELECTEDITEM 41046 . 41471) ( |
| 1730 | +SHOWSHADEDITEMS 41473 . 42890) (\AddShade 42892 . 44084) (\DelShade 44086 . 44357) (\FDECODE/BUTTON |
| 1731 | +44359 . 44746) (MENUITEMREGION 44748 . 47483) (\MENUITEMLABEL 47485 . 47831) (\MENUSUBITEMS 47833 . |
| 1732 | +48071) (CHECK/MENU/IMAGE 48073 . 50274) (PPROMPT2 50276 . 50665) (UPDATE/MENU/IMAGE 50667 . 66316) ( |
| 1733 | +\MAKE.ITEMS.VERT.ORDER 66318 . 67845) (\SHOWMENULABEL 67847 . 71774) (\POSITION.MENU.IMAGE 71776 . |
| 1734 | +74631) (\SMASHMENUIMAGEONRESET 74633 . 74981) (CLOSE.PROCESS.MENU 74983 . 75165) (DEFAULTSUBITEMFN |
| 1735 | +75167 . 75887) (GETMENUPROP 75889 . 76081) (PUTMENUPROP 76083 . 76456) (WAKE.MY.PROCESS 76458 . 76641) |
| 1736 | + (\INVERTITEM 76643 . 77099) (\MENU.ITEM.SELECT 77101 . 78664) (\MENU.ITEM.DESELECT 78666 . 79368) ( |
| 1737 | +\ItemNumber 79370 . 79937) (\BOXITEM 79939 . 81486) (NESTED.SUBMENU 81488 . 84206) (NESTED.SUBMENU.POS |
| 1738 | + 84208 . 87179) (WFROMMENU 87181 . 87555)) (88766 89186 (MENUREPAINTFN 88776 . 89184)) (89221 92270 ( |
| 1739 | +MAXSTRINGWIDTH 89231 . 89474) (CENTEREDPRIN1 89476 . 89913) (CENTERPRINTINREGION 89915 . 90444) ( |
| 1740 | +CENTERPRINTINAREA 90446 . 91903) (STRICTLY/BETWEEN 91905 . 92268)) (92304 98246 (UNREADITEM 92314 . |
| 1741 | +92636) (TYPEINMENU 92638 . 92839) (SHADEITEM 92841 . 94585) (RESHADEITEM 94587 . 95680) ( |
| 1742 | +MOST/VISIBLE/OPERATION 95682 . 95953) (%#BITSON 95955 . 96673) (BUTTONPANEL 96675 . 97467) ( |
| 1743 | +BUTTONPANEL/SELECTION/FN 97469 . 98021) (GETSELECTEDITEMS 98023 . 98244)) (98562 99103 (MENUDESELECT |
| 1744 | +98572 . 98789) (MENUSELECT 98791 . 99101))))) |
1733 | 1745 | STOP |
0 commit comments