Mercurial > emacs
comparison src/xmenu.c @ 6058:662b9cd767fe
(Fx_popup_menu): Allow t as position, meaning use mouse pos.
Allow nil as position, meaning just precompute equiv-key data.
Mouse events have coords in pixel units.
(menu_item_equiv_key): Cached equiv-key data is a sublist.
Most of file rewritten.
(menu_items, menu_items_*): New variables.
(MENU_ITEMS_*): New macros.
(init_menu_items, discard_menu_items, push_menu_pane, push_menu_item)
(finish_menu_items): New functions.
(menu_item_enabled_p): New function.
(keymap_panes, single_keymap_panes): Major rewrite; most args changed.
(list_of_panes, list_of_items): Major rewrite; most args changed.
(Fx_popup_menu): Major rewrite. Now independent of display mechanism.
No more conditionals here.
(set_menu_items, free_menu_items): Functions deleted.
(xmenu_show): Both versions rewritten to work from menu_items
and to do all the conditionalized things that were in Fx_popup_menu.
(unread_menu_bar_button, other_menu_bar_item_p): New functions.
(check_mouse_other_menu_bar): New function.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 24 Feb 1994 08:07:16 +0000 |
parents | 51d9a0c72a29 |
children | e3d6c30a3906 |
comparison
equal
deleted
inserted
replaced
6057:b2cc63a56415 | 6058:662b9cd767fe |
---|---|
24 * | 24 * |
25 */ | 25 */ |
26 | 26 |
27 /* Modified by Fred Pierresteguy on December 93 | 27 /* Modified by Fred Pierresteguy on December 93 |
28 to make the popup menus and menubar use the Xt. */ | 28 to make the popup menus and menubar use the Xt. */ |
29 | |
30 /* Rewritten for clarity and GC protection by rms in Feb 94. */ | |
29 | 31 |
30 #include <stdio.h> | 32 #include <stdio.h> |
31 | 33 |
32 /* On 4.3 this loses if it comes after xterm.h. */ | 34 /* On 4.3 this loses if it comes after xterm.h. */ |
33 #include <signal.h> | 35 #include <signal.h> |
68 #endif /* USE_X_TOOLKIT */ | 70 #endif /* USE_X_TOOLKIT */ |
69 | 71 |
70 #define min(x,y) (((x) < (y)) ? (x) : (y)) | 72 #define min(x,y) (((x) < (y)) ? (x) : (y)) |
71 #define max(x,y) (((x) > (y)) ? (x) : (y)) | 73 #define max(x,y) (((x) > (y)) ? (x) : (y)) |
72 | 74 |
73 #define NUL 0 | |
74 | |
75 #ifndef TRUE | 75 #ifndef TRUE |
76 #define TRUE 1 | 76 #define TRUE 1 |
77 #define FALSE 0 | 77 #define FALSE 0 |
78 #endif /* TRUE */ | 78 #endif /* no TRUE */ |
79 | 79 |
80 #ifdef HAVE_X11 | 80 #ifdef HAVE_X11 |
81 extern Display *x_current_display; | 81 extern Display *x_current_display; |
82 #else | 82 #else |
83 #define ButtonReleaseMask ButtonReleased | 83 #define ButtonReleaseMask ButtonReleased |
84 #endif /* not HAVE_X11 */ | 84 #endif /* not HAVE_X11 */ |
85 | 85 |
86 /* We need a unique id for each popup menu and dialog box. */ | |
87 static unsigned int popup_id_tick; | |
88 | |
86 extern Lisp_Object Qmenu_enable; | 89 extern Lisp_Object Qmenu_enable; |
87 extern Lisp_Object Qmenu_bar; | 90 extern Lisp_Object Qmenu_bar; |
88 Lisp_Object xmenu_show (); | 91 |
89 extern int x_error_handler (); | |
90 #ifdef USE_X_TOOLKIT | 92 #ifdef USE_X_TOOLKIT |
91 static widget_value *set_menu_items (); | 93 extern void process_expose_from_menu (); |
94 extern XtAppContext Xt_app_con; | |
95 | |
92 static int string_width (); | 96 static int string_width (); |
93 static void free_menu_items (); | |
94 #endif | 97 #endif |
95 | 98 |
96 /* we need a unique id for each popup menu and dialog box */ | 99 static Lisp_Object xmenu_show (); |
97 unsigned int popup_id_tick; | 100 static void keymap_panes (); |
98 | 101 static void single_keymap_panes (); |
99 /*************************************************************/ | 102 static void list_of_panes (); |
100 | 103 static void list_of_items (); |
101 #if 0 | |
102 /* Ignoring the args is easiest. */ | |
103 xmenu_quit () | |
104 { | |
105 error ("Unknown XMenu error"); | |
106 } | |
107 #endif | |
108 | |
109 | 104 |
110 DEFUN ("x-popup-menu",Fx_popup_menu, Sx_popup_menu, 1, 2, 0, | 105 /* This holds a Lisp vector that holds the results of decoding |
106 the keymaps or alist-of-alists that specify a menu. | |
107 | |
108 It describes the panes and items within the panes. | |
109 | |
110 Each pane is described by 3 elements in the vector: | |
111 t, the pane name, the pane's prefix key. | |
112 Then follow the pane's items, with 4 elements per item: | |
113 the item string, the enable flag, the item's value, | |
114 and the equivalent keyboard key's description string. | |
115 | |
116 Using a Lisp vector to hold this information while we decode it | |
117 takes care of protecting all the data from GC. */ | |
118 | |
119 #define MENU_ITEMS_PANE_NAME 1 | |
120 #define MENU_ITEMS_PANE_PREFIX 2 | |
121 #define MENU_ITEMS_PANE_LENGTH 3 | |
122 | |
123 #define MENU_ITEMS_ITEM_NAME 0 | |
124 #define MENU_ITEMS_ITEM_ENABLE 1 | |
125 #define MENU_ITEMS_ITEM_VALUE 2 | |
126 #define MENU_ITEMS_ITEM_EQUIV_KEY 3 | |
127 #define MENU_ITEMS_ITEM_LENGTH 4 | |
128 | |
129 static Lisp_Object menu_items; | |
130 | |
131 /* Number of slots currently allocated in menu_items. */ | |
132 static int menu_items_allocated; | |
133 | |
134 /* This is the index in menu_items of the first empty slot. */ | |
135 static int menu_items_used; | |
136 | |
137 /* The number of panes currently recorded in menu_items. */ | |
138 static int menu_items_n_panes; | |
139 | |
140 /* Initialize the menu_items structure if we haven't already done so. | |
141 Also mark it as currently empty. */ | |
142 | |
143 static void | |
144 init_menu_items () | |
145 { | |
146 if (NILP (menu_items)) | |
147 { | |
148 menu_items_allocated = 60; | |
149 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); | |
150 } | |
151 | |
152 menu_items_used = 0; | |
153 menu_items_n_panes = 0; | |
154 } | |
155 | |
156 /* Call at the end of generating the data in menu_items. | |
157 This fills in the number of items in the last pane. */ | |
158 | |
159 static void | |
160 finish_menu_items () | |
161 { | |
162 } | |
163 | |
164 /* Call when finished using the data for the current menu | |
165 in menu_items. */ | |
166 | |
167 static void | |
168 discard_menu_items () | |
169 { | |
170 /* Free the structure if it is especially large. | |
171 Otherwise, hold on to it, to save time. */ | |
172 if (menu_items_allocated > 200) | |
173 { | |
174 menu_items = Qnil; | |
175 menu_items_allocated = 0; | |
176 } | |
177 } | |
178 | |
179 /* Start a new menu pane in menu_items.. | |
180 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */ | |
181 | |
182 static void | |
183 push_menu_pane (name, prefix_vec) | |
184 Lisp_Object name, prefix_vec; | |
185 { | |
186 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated) | |
187 { | |
188 Lisp_Object old; | |
189 int old_size = menu_items_allocated; | |
190 old = menu_items; | |
191 | |
192 menu_items_allocated *= 2; | |
193 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); | |
194 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents, | |
195 old_size * sizeof (Lisp_Object)); | |
196 } | |
197 | |
198 menu_items_n_panes++; | |
199 XVECTOR (menu_items)->contents[menu_items_used++] = Qt; | |
200 XVECTOR (menu_items)->contents[menu_items_used++] = name; | |
201 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec; | |
202 } | |
203 | |
204 /* Push one menu item into the current pane. | |
205 NAME is the string to display. ENABLE if non-nil means | |
206 this item can be selected. KEY is the key generated by | |
207 choosing this item. EQUIV is the textual description | |
208 of the keyboard equivalent for this item (or nil if none). */ | |
209 | |
210 static void | |
211 push_menu_item (name, enable, key, equiv) | |
212 Lisp_Object name, enable, key, equiv; | |
213 { | |
214 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated) | |
215 { | |
216 Lisp_Object old; | |
217 int old_size = menu_items_allocated; | |
218 old = menu_items; | |
219 | |
220 menu_items_allocated *= 2; | |
221 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); | |
222 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents, | |
223 old_size * sizeof (Lisp_Object)); | |
224 } | |
225 | |
226 XVECTOR (menu_items)->contents[menu_items_used++] = name; | |
227 XVECTOR (menu_items)->contents[menu_items_used++] = enable; | |
228 XVECTOR (menu_items)->contents[menu_items_used++] = key; | |
229 XVECTOR (menu_items)->contents[menu_items_used++] = equiv; | |
230 } | |
231 | |
232 /* Figure out the current keyboard equivalent of a menu item ITEM1. | |
233 The item string for menu display should be ITEM_STRING. | |
234 Store the equivalent keyboard key sequence's | |
235 textual description into *DESCRIP_PTR. | |
236 Also cache them in the item itself. | |
237 Return the real definition to execute. */ | |
238 | |
239 static Lisp_Object | |
240 menu_item_equiv_key (item_string, item1, descrip_ptr) | |
241 Lisp_Object item_string; | |
242 Lisp_Object item1; | |
243 Lisp_Object *descrip_ptr; | |
244 { | |
245 /* This is the real definition--the function to run. */ | |
246 Lisp_Object def; | |
247 /* This is the sublist that records cached equiv key data | |
248 so we can save time. */ | |
249 Lisp_Object cachelist; | |
250 /* These are the saved equivalent keyboard key sequence | |
251 and its key-description. */ | |
252 Lisp_Object savedkey, descrip; | |
253 Lisp_Object def1; | |
254 int changed = 0; | |
255 | |
256 /* If a help string follows the item string, skip it. */ | |
257 if (CONSP (XCONS (item1)->cdr) | |
258 && STRINGP (XCONS (XCONS (item1)->cdr)->car)) | |
259 item1 = XCONS (item1)->cdr; | |
260 | |
261 def = Fcdr (item1); | |
262 | |
263 /* Get out the saved equivalent-keyboard-key info. */ | |
264 cachelist = savedkey = descrip = Qnil; | |
265 if (CONSP (def) && CONSP (XCONS (def)->car) | |
266 && (NILP (XCONS (XCONS (def)->car)->car) | |
267 || VECTORP (XCONS (XCONS (def)->car)->car))) | |
268 { | |
269 cachelist = XCONS (def)->car; | |
270 def = XCONS (def)->cdr; | |
271 savedkey = XCONS (cachelist)->car; | |
272 descrip = XCONS (cachelist)->cdr; | |
273 } | |
274 | |
275 /* Is it still valid? */ | |
276 def1 = Qnil; | |
277 if (!NILP (savedkey)) | |
278 def1 = Fkey_binding (savedkey, Qnil); | |
279 /* If not, update it. */ | |
280 if (! EQ (def1, def) | |
281 /* If something had no key binding before, don't recheck it-- | |
282 doing that takes too much time and makes menus too slow. */ | |
283 && !(!NILP (cachelist) && NILP (savedkey))) | |
284 { | |
285 changed = 1; | |
286 descrip = Qnil; | |
287 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil); | |
288 if (VECTORP (savedkey) | |
289 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar)) | |
290 savedkey = Qnil; | |
291 if (!NILP (savedkey)) | |
292 { | |
293 descrip = Fkey_description (savedkey); | |
294 descrip = concat2 (make_string (" (", 3), descrip); | |
295 descrip = concat2 (descrip, make_string (")", 1)); | |
296 } | |
297 } | |
298 | |
299 /* Cache the data we just got in a sublist of the menu binding. */ | |
300 if (NILP (cachelist)) | |
301 XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def); | |
302 else if (changed) | |
303 { | |
304 XCONS (cachelist)->car = savedkey; | |
305 XCONS (cachelist)->cdr = descrip; | |
306 } | |
307 | |
308 *descrip_ptr = descrip; | |
309 return def; | |
310 } | |
311 | |
312 /* This is used as the handler when calling internal_condition_case_1. */ | |
313 | |
314 static Lisp_Object | |
315 menu_item_enabled_p_1 (arg) | |
316 Lisp_Object arg; | |
317 { | |
318 return Qnil; | |
319 } | |
320 | |
321 /* Return non-nil if the command DEF is enabled when used as a menu item. | |
322 This is based on looking for a menu-enable property. */ | |
323 | |
324 static Lisp_Object | |
325 menu_item_enabled_p (def) | |
326 Lisp_Object def; | |
327 { | |
328 Lisp_Object enabled, tem; | |
329 | |
330 enabled = Qt; | |
331 if (XTYPE (def) == Lisp_Symbol) | |
332 { | |
333 /* No property, or nil, means enable. | |
334 Otherwise, enable if value is not nil. */ | |
335 tem = Fget (def, Qmenu_enable); | |
336 if (!NILP (tem)) | |
337 /* (condition-case nil (eval tem) | |
338 (error nil)) */ | |
339 enabled = internal_condition_case_1 (Feval, tem, Qerror, | |
340 menu_item_enabled_p_1); | |
341 } | |
342 return enabled; | |
343 } | |
344 | |
345 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long, | |
346 and generate menu panes for them in menu_items. */ | |
347 | |
348 static void | |
349 keymap_panes (keymaps, nmaps) | |
350 Lisp_Object *keymaps; | |
351 int nmaps; | |
352 { | |
353 int mapno; | |
354 | |
355 init_menu_items (); | |
356 | |
357 /* Loop over the given keymaps, making a pane for each map. | |
358 But don't make a pane that is empty--ignore that map instead. | |
359 P is the number of panes we have made so far. */ | |
360 for (mapno = 0; mapno < nmaps; mapno++) | |
361 single_keymap_panes (keymaps[mapno], Qnil, Qnil); | |
362 | |
363 finish_menu_items (); | |
364 } | |
365 | |
366 /* This is a recursive subroutine of keymap_panes. | |
367 It handles one keymap, KEYMAP. | |
368 The other arguments are passed along | |
369 or point to local variables of the previous function. */ | |
370 | |
371 static void | |
372 single_keymap_panes (keymap, pane_name, prefix) | |
373 Lisp_Object keymap; | |
374 Lisp_Object pane_name; | |
375 Lisp_Object prefix; | |
376 { | |
377 Lisp_Object pending_maps; | |
378 Lisp_Object tail, item, item1, item_string, table; | |
379 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
380 | |
381 pending_maps = Qnil; | |
382 | |
383 push_menu_pane (pane_name, prefix); | |
384 | |
385 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) | |
386 { | |
387 /* Look at each key binding, and if it has a menu string, | |
388 make a menu item from it. */ | |
389 item = XCONS (tail)->car; | |
390 if (XTYPE (item) == Lisp_Cons) | |
391 { | |
392 item1 = XCONS (item)->cdr; | |
393 if (XTYPE (item1) == Lisp_Cons) | |
394 { | |
395 item_string = XCONS (item1)->car; | |
396 if (XTYPE (item_string) == Lisp_String) | |
397 { | |
398 /* This is the real definition--the function to run. */ | |
399 Lisp_Object def; | |
400 /* These are the saved equivalent keyboard key sequence | |
401 and its key-description. */ | |
402 Lisp_Object descrip; | |
403 Lisp_Object tem, enabled; | |
404 | |
405 def = menu_item_equiv_key (item_string, item1, &descrip); | |
406 | |
407 /* GCPRO because we will call eval. | |
408 Protecting KEYMAP preserves everything we use; | |
409 aside from that, must protect whatever might be | |
410 a string. Since there's no GCPRO5, we refetch | |
411 item_string instead of protecting it. */ | |
412 GCPRO4 (keymap, pending_maps, def, descrip); | |
413 enabled = menu_item_enabled_p (def); | |
414 UNGCPRO; | |
415 | |
416 item_string = XCONS (item1)->car; | |
417 | |
418 tem = Fkeymapp (def); | |
419 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) | |
420 pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)), | |
421 pending_maps); | |
422 else | |
423 push_menu_item (item_string, enabled, XCONS (item)->car, | |
424 descrip); | |
425 } | |
426 } | |
427 } | |
428 else if (XTYPE (item) == Lisp_Vector) | |
429 { | |
430 /* Loop over the char values represented in the vector. */ | |
431 int len = XVECTOR (item)->size; | |
432 int c; | |
433 for (c = 0; c < len; c++) | |
434 { | |
435 Lisp_Object character; | |
436 XFASTINT (character) = c; | |
437 item1 = XVECTOR (item)->contents[c]; | |
438 if (XTYPE (item1) == Lisp_Cons) | |
439 { | |
440 item_string = XCONS (item1)->car; | |
441 if (XTYPE (item_string) == Lisp_String) | |
442 { | |
443 Lisp_Object def; | |
444 | |
445 /* These are the saved equivalent keyboard key sequence | |
446 and its key-description. */ | |
447 Lisp_Object descrip; | |
448 Lisp_Object tem, enabled; | |
449 | |
450 def = menu_item_equiv_key (item_string, item1, &descrip); | |
451 | |
452 /* GCPRO because we will call eval. | |
453 Protecting KEYMAP preserves everything we use; | |
454 aside from that, must protect whatever might be | |
455 a string. Since there's no GCPRO5, we refetch | |
456 item_string instead of protecting it. */ | |
457 GCPRO4 (keymap, pending_maps, def, descrip); | |
458 enabled = menu_item_enabled_p (def); | |
459 UNGCPRO; | |
460 | |
461 item_string = XCONS (item1)->car; | |
462 | |
463 tem = Fkeymapp (def); | |
464 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) | |
465 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)), | |
466 pending_maps); | |
467 else | |
468 push_menu_item (item_string, enabled, | |
469 character, descrip); | |
470 } | |
471 } | |
472 } | |
473 } | |
474 } | |
475 | |
476 /* Process now any submenus which want to be panes at this level. */ | |
477 while (!NILP (pending_maps)) | |
478 { | |
479 Lisp_Object elt, eltcdr; | |
480 elt = Fcar (pending_maps); | |
481 eltcdr = XCONS (elt)->cdr; | |
482 single_keymap_panes (Fcar (elt), | |
483 /* Fails to discard the @. */ | |
484 XCONS (eltcdr)->car, XCONS (eltcdr)->cdr); | |
485 pending_maps = Fcdr (pending_maps); | |
486 } | |
487 } | |
488 | |
489 /* Push all the panes and items of a menu decsribed by the | |
490 alist-of-alists MENU. | |
491 This handles old-fashioned calls to x-popup-menu. */ | |
492 | |
493 static void | |
494 list_of_panes (menu) | |
495 Lisp_Object menu; | |
496 { | |
497 Lisp_Object tail; | |
498 | |
499 init_menu_items (); | |
500 | |
501 for (tail = menu; !NILP (tail); tail = Fcdr (tail)) | |
502 { | |
503 Lisp_Object elt, pane_name, pane_data; | |
504 elt = Fcar (tail); | |
505 pane_name = Fcar (elt); | |
506 CHECK_STRING (pane_name, 0); | |
507 push_menu_pane (pane_name, Qnil); | |
508 pane_data = Fcdr (elt); | |
509 CHECK_CONS (pane_data, 0); | |
510 list_of_items (pane_data); | |
511 } | |
512 | |
513 finish_menu_items (); | |
514 } | |
515 | |
516 /* Push the items in a single pane defined by the alist PANE. */ | |
517 | |
518 static void | |
519 list_of_items (pane) | |
520 Lisp_Object pane; | |
521 { | |
522 Lisp_Object tail, item, item1; | |
523 | |
524 for (tail = pane; !NILP (tail); tail = Fcdr (tail)) | |
525 { | |
526 item = Fcar (tail); | |
527 if (STRINGP (item)) | |
528 push_menu_item (item, Qnil, Qnil); | |
529 else | |
530 { | |
531 CHECK_CONS (item, 0); | |
532 item1 = Fcar (item); | |
533 CHECK_STRING (item1, 1); | |
534 push_menu_item (item1, Qt, Fcdr (item), Qnil); | |
535 } | |
536 } | |
537 } | |
538 | |
539 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 1, 2, 0, | |
111 "Pop up a deck-of-cards menu and return user's selection.\n\ | 540 "Pop up a deck-of-cards menu and return user's selection.\n\ |
112 POSITION is a position specification. This is either a mouse button event\n\ | 541 POSITION is a position specification. This is either a mouse button event\n\ |
113 or a list ((XOFFSET YOFFSET) WINDOW)\n\ | 542 or a list ((XOFFSET YOFFSET) WINDOW)\n\ |
114 where XOFFSET and YOFFSET are positions in characters from the top left\n\ | 543 where XOFFSET and YOFFSET are positions in characters from the top left\n\ |
115 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\ | 544 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\ |
116 This controls the position of the center of the first line\n\ | 545 This controls the position of the center of the first line\n\ |
117 in the first pane of the menu, not the top left of the menu as a whole.\n\ | 546 in the first pane of the menu, not the top left of the menu as a whole.\n\ |
547 If POSITION is t, it means to use the current mouse position.\n\ | |
118 \n\ | 548 \n\ |
119 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\ | 549 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\ |
120 The menu items come from key bindings that have a menu string as well as\n\ | 550 The menu items come from key bindings that have a menu string as well as\n\ |
121 a definition; actually, the \"definition\" in such a key binding looks like\n\ | 551 a definition; actually, the \"definition\" in such a key binding looks like\n\ |
122 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\ | 552 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\ |
129 with a list of the form (TITLE PANE1 PANE2...),\n\ | 559 with a list of the form (TITLE PANE1 PANE2...),\n\ |
130 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ | 560 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ |
131 Each ITEM is normally a cons cell (STRING . VALUE);\n\ | 561 Each ITEM is normally a cons cell (STRING . VALUE);\n\ |
132 but a string can appear as an item--that makes a nonselectable line\n\ | 562 but a string can appear as an item--that makes a nonselectable line\n\ |
133 in the menu.\n\ | 563 in the menu.\n\ |
134 With this form of menu, the return value is VALUE from the chosen item.") | 564 With this form of menu, the return value is VALUE from the chosen item.\n\ |
565 \n\ | |
566 If POSITION is nil, don't display the menu at all, just precalculate the\n\ | |
567 cached information about equivalent key sequences.") | |
135 (position, menu) | 568 (position, menu) |
136 Lisp_Object position, menu; | 569 Lisp_Object position, menu; |
137 { | 570 { |
138 int number_of_panes, panes; | 571 int number_of_panes, panes; |
139 Lisp_Object XMenu_return, keymap, tem; | 572 Lisp_Object keymap, tem; |
140 int XMenu_xpos, XMenu_ypos; | 573 int xpos, ypos; |
141 char **menus; | 574 Lisp_Object title; |
142 char ***names; | |
143 int **enables; | |
144 Lisp_Object **obj_list; | |
145 Lisp_Object *prefixes; | |
146 int *items; | |
147 char *title; | |
148 char *error_name; | 575 char *error_name; |
149 Lisp_Object ltitle, selection; | 576 Lisp_Object selection; |
150 int i, j, menubarp = 0; | 577 int i, j; |
151 FRAME_PTR f; | 578 FRAME_PTR f; |
152 Lisp_Object x, y, window; | 579 Lisp_Object x, y, window; |
153 #ifdef USE_X_TOOLKIT | 580 int keymaps = 0; |
154 widget_value *val, *vw = 0; | 581 int menubarp = 0; |
155 #endif /* USE_X_TOOLKIT */ | 582 struct gcpro gcpro1; |
156 | 583 |
157 check_x (); | 584 check_x (); |
158 /* Decode the first argument: find the window and the coordinates. */ | 585 |
159 tem = Fcar (position); | 586 if (! NILP (position)) |
160 if (XTYPE (tem) == Lisp_Cons) | 587 { |
161 { | 588 /* Decode the first argument: find the window and the coordinates. */ |
162 window = Fcar (Fcdr (position)); | 589 if (EQ (position, Qt)) |
163 x = Fcar (tem); | 590 { |
164 y = Fcar (Fcdr (tem)); | 591 /* Use the mouse's current position. */ |
165 } | 592 FRAME_PTR new_f; |
166 else | 593 Lisp_Object bar_window; |
167 { | 594 int part; |
168 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ | 595 unsigned long time; |
169 window = Fcar (tem); /* POSN_WINDOW (tem) */ | 596 |
170 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ | 597 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time); |
171 x = Fcar (tem); | 598 XSET (window, Lisp_Frame, new_f); |
172 y = Fcdr (tem); | 599 } |
173 } | 600 else |
174 CHECK_NUMBER (x, 0); | 601 { |
175 CHECK_NUMBER (y, 0); | 602 tem = Fcar (position); |
176 | 603 if (XTYPE (tem) == Lisp_Cons) |
177 if (XTYPE (window) == Lisp_Frame) | |
178 { | |
179 f = XFRAME (window); | |
180 | |
181 XMenu_xpos = 0; | |
182 XMenu_ypos = 0; | |
183 } | |
184 else if (XTYPE (window) == Lisp_Window) | |
185 { | |
186 CHECK_LIVE_WINDOW (window, 0); | |
187 f = XFRAME (WINDOW_FRAME (XWINDOW (window))); | |
188 | |
189 XMenu_xpos = FONT_WIDTH (f->display.x->font) | |
190 * XWINDOW (window)->left; | |
191 XMenu_ypos = FONT_HEIGHT (f->display.x->font) | |
192 * XWINDOW (window)->top; | |
193 } | |
194 else | |
195 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, | |
196 but I don't want to make one now. */ | |
197 CHECK_WINDOW (window, 0); | |
198 | |
199 #ifdef USE_X_TOOLKIT | |
200 tem = Fcar (Fcdr (Fcar (Fcdr (position)))); | |
201 if (XTYPE (Fcar (position)) != Lisp_Cons | |
202 && CONSP (tem) | |
203 && EQ (Fcar (tem), Qmenu_bar)) | |
204 { | |
205 /* We are in the menubar */ | |
206 XlwMenuWidget mw; | |
207 int w1 = 0, w2; | |
208 | |
209 mw = (XlwMenuWidget)f->display.x->menubar_widget; | |
210 menubarp = 1; | |
211 for (vw = mw->menu.old_stack [0]->contents; vw; vw = vw->next) | |
212 { | |
213 w2 = w1; | |
214 w1 += string_width (mw, vw->name) | |
215 + 2 * (mw->menu.horizontal_spacing + | |
216 mw->menu.shadow_thickness); | |
217 if (XINT (x) < w1) | |
218 { | 604 { |
219 XMenu_xpos = w2 + 4; | 605 window = Fcar (Fcdr (position)); |
220 XMenu_ypos = 0; | 606 x = Fcar (tem); |
221 break; | 607 y = Fcar (Fcdr (tem)); |
222 } | 608 } |
223 } | 609 else |
224 } | 610 { |
225 else | 611 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ |
226 { | 612 window = Fcar (tem); /* POSN_WINDOW (tem) */ |
227 XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x); | 613 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ |
228 XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y); | 614 x = Fcar (tem); |
229 } | 615 y = Fcdr (tem); |
230 | 616 |
231 BLOCK_INPUT; | 617 /* Determine whether this menu is handling a menu bar click. */ |
232 XMenu_xpos += (f->display.x->widget->core.x | 618 tem = Fcar (Fcdr (Fcar (Fcdr (position)))); |
233 + f->display.x->widget->core.border_width); | 619 if (XTYPE (Fcar (position)) != Lisp_Cons |
234 XMenu_ypos += (f->display.x->widget->core.y | 620 && CONSP (tem) |
235 + f->display.x->widget->core.border_width | 621 && EQ (Fcar (tem), Qmenu_bar)) |
236 + f->display.x->menubar_widget->core.height); | 622 menubarp = 1; |
237 UNBLOCK_INPUT; | 623 } |
238 | 624 } |
239 val = set_menu_items (menu, &prefixes, &panes, &names, | 625 |
240 &enables, &menus, &items, &number_of_panes, &obj_list, | 626 CHECK_NUMBER (x, 0); |
241 &title, &error_name); | 627 CHECK_NUMBER (y, 0); |
242 selection = xmenu_show (f, val, XMenu_xpos, XMenu_ypos, | 628 |
243 menubarp, vw); | 629 /* Decode where to put the menu. */ |
244 | 630 |
245 free_menu_items (names, enables, menus, items, number_of_panes, obj_list, | 631 if (XTYPE (window) == Lisp_Frame) |
246 title, error_name); | 632 { |
247 | 633 f = XFRAME (window); |
248 if (selection != NUL) | 634 |
249 { /* selected something */ | 635 xpos = 0; |
250 XMenu_return = selection; | 636 ypos = 0; |
251 } | 637 } |
252 else | 638 else if (XTYPE (window) == Lisp_Window) |
253 { /* nothing selected */ | 639 { |
254 XMenu_return = Qnil; | 640 CHECK_LIVE_WINDOW (window, 0); |
255 } | 641 f = XFRAME (WINDOW_FRAME (XWINDOW (window))); |
256 | 642 |
257 return XMenu_return; | 643 xpos = (FONT_WIDTH (f->display.x->font) * XWINDOW (window)->left); |
258 | 644 ypos = (FONT_HEIGHT (f->display.x->font) * XWINDOW (window)->top); |
259 #else /* not USE_X_TOOLKIT */ | 645 } |
260 #ifdef HAVE_X11 | 646 else |
261 { | 647 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, |
262 Window child; | 648 but I don't want to make one now. */ |
263 int win_x = 0, win_y = 0; | 649 CHECK_WINDOW (window, 0); |
264 | 650 |
265 /* Find the position of the outside upper-left corner of | 651 xpos += XINT (x); |
266 the inner window, with respect to the outer window. */ | 652 ypos += XINT (y); |
267 if (f->display.x->parent_desc != ROOT_WINDOW) | 653 } |
268 { | 654 |
269 BLOCK_INPUT; | 655 title = Qnil; |
270 XTranslateCoordinates (x_current_display, | 656 GCPRO1 (title); |
271 | 657 |
272 /* From-window, to-window. */ | 658 /* Decode the menu items from what was specified. */ |
273 f->display.x->window_desc, | |
274 f->display.x->parent_desc, | |
275 | |
276 /* From-position, to-position. */ | |
277 0, 0, &win_x, &win_y, | |
278 | |
279 /* Child of window. */ | |
280 &child); | |
281 UNBLOCK_INPUT; | |
282 XMenu_xpos += win_x; | |
283 XMenu_ypos += win_y; | |
284 } | |
285 } | |
286 #endif /* HAVE_X11 */ | |
287 | |
288 XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x); | |
289 XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y); | |
290 | |
291 XMenu_xpos += f->display.x->left_pos; | |
292 XMenu_ypos += f->display.x->top_pos; | |
293 | |
294 | 659 |
295 keymap = Fkeymapp (menu); | 660 keymap = Fkeymapp (menu); |
296 tem = Qnil; | 661 tem = Qnil; |
297 if (XTYPE (menu) == Lisp_Cons) | 662 if (XTYPE (menu) == Lisp_Cons) |
298 tem = Fkeymapp (Fcar (menu)); | 663 tem = Fkeymapp (Fcar (menu)); |
300 { | 665 { |
301 /* We were given a keymap. Extract menu info from the keymap. */ | 666 /* We were given a keymap. Extract menu info from the keymap. */ |
302 Lisp_Object prompt; | 667 Lisp_Object prompt; |
303 keymap = get_keymap (menu); | 668 keymap = get_keymap (menu); |
304 | 669 |
670 /* Extract the detailed info to make one pane. */ | |
671 keymap_panes (&menu, 1); | |
672 | |
305 /* Search for a string appearing directly as an element of the keymap. | 673 /* Search for a string appearing directly as an element of the keymap. |
306 That string is the title of the menu. */ | 674 That string is the title of the menu. */ |
307 prompt = map_prompt (keymap); | 675 prompt = map_prompt (keymap); |
308 if (!NILP (prompt)) | 676 |
309 title = (char *) XSTRING (prompt)->data; | 677 /* Make that be the pane title of the first pane. */ |
310 | 678 if (!NILP (prompt) && menu_items_n_panes >= 0) |
311 /* Extract the detailed info to make one pane. */ | 679 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt; |
312 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables, | 680 |
313 &items, &prefixes, &menu, 1); | 681 keymaps = 1; |
314 /* The menu title seems to be ignored, | |
315 so put it in the pane title. */ | |
316 if (menus[0] == 0) | |
317 menus[0] = title; | |
318 } | 682 } |
319 else if (!NILP (tem)) | 683 else if (!NILP (tem)) |
320 { | 684 { |
321 /* We were given a list of keymaps. */ | 685 /* We were given a list of keymaps. */ |
322 Lisp_Object prompt; | |
323 int nmaps = XFASTINT (Flength (menu)); | 686 int nmaps = XFASTINT (Flength (menu)); |
324 Lisp_Object *maps | 687 Lisp_Object *maps |
325 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); | 688 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); |
326 int i; | 689 int i; |
327 title = 0; | 690 |
691 title = Qnil; | |
328 | 692 |
329 /* The first keymap that has a prompt string | 693 /* The first keymap that has a prompt string |
330 supplies the menu title. */ | 694 supplies the menu title. */ |
331 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) | 695 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) |
332 { | 696 { |
697 Lisp_Object prompt; | |
698 | |
333 maps[i++] = keymap = get_keymap (Fcar (tem)); | 699 maps[i++] = keymap = get_keymap (Fcar (tem)); |
334 | 700 |
335 prompt = map_prompt (keymap); | 701 prompt = map_prompt (keymap); |
336 if (title == 0 && !NILP (prompt)) | 702 if (NILP (title) && !NILP (prompt)) |
337 title = (char *) XSTRING (prompt)->data; | 703 title = prompt; |
338 } | 704 } |
339 | 705 |
340 /* Extract the detailed info to make one pane. */ | 706 /* Extract the detailed info to make one pane. */ |
341 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables, | 707 keymap_panes (maps, nmaps); |
342 &items, &prefixes, maps, nmaps); | 708 |
343 /* The menu title seems to be ignored, | 709 /* Make the title be the pane title of the first pane. */ |
344 so put it in the pane title. */ | 710 if (!NILP (title) && menu_items_n_panes >= 0) |
345 if (menus[0] == 0) | 711 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title; |
346 menus[0] = title; | 712 |
713 keymaps = 1; | |
347 } | 714 } |
348 else | 715 else |
349 { | 716 { |
350 /* We were given an old-fashioned menu. */ | 717 /* We were given an old-fashioned menu. */ |
351 ltitle = Fcar (menu); | 718 title = Fcar (menu); |
352 CHECK_STRING (ltitle, 1); | 719 CHECK_STRING (title, 1); |
353 title = (char *) XSTRING (ltitle)->data; | 720 |
354 prefixes = 0; | 721 list_of_panes (Fcdr (menu)); |
355 number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables, | 722 |
356 &items, Fcdr (menu)); | 723 keymaps = 0; |
357 } | 724 } |
358 #ifdef XDEBUG | 725 |
359 fprintf (stderr, "Panes = %d\n", number_of_panes); | 726 if (NILP (position)) |
360 for (i = 0; i < number_of_panes; i++) | 727 { |
361 { | 728 discard_menu_items (); |
362 fprintf (stderr, "Pane %d has lines %d title %s\n", | 729 UNGCPRO; |
363 i, items[i], menus[i]); | 730 return Qnil; |
364 for (j = 0; j < items[i]; j++) | 731 } |
365 fprintf (stderr, " Item %d %s\n", j, names[i][j]); | 732 |
366 } | 733 /* Display them in a menu. */ |
367 #endif | |
368 | |
369 BLOCK_INPUT; | 734 BLOCK_INPUT; |
370 { | 735 |
371 Window root; | 736 selection = xmenu_show (f, xpos, ypos, menubarp, |
372 int root_x, root_y; | 737 keymaps, title, &error_name); |
373 int dummy_int; | |
374 unsigned int dummy_uint; | |
375 Window dummy_window; | |
376 | |
377 /* Figure out which root window F is on. */ | |
378 XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root, | |
379 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint, | |
380 &dummy_uint, &dummy_uint); | |
381 | |
382 /* Translate the menu co-ordinates within f to menu co-ordinates | |
383 on that root window. */ | |
384 if (! XTranslateCoordinates (x_current_display, | |
385 FRAME_X_WINDOW (f), root, | |
386 XMenu_xpos, XMenu_ypos, &root_x, &root_y, | |
387 &dummy_window)) | |
388 /* But XGetGeometry said root was the root window of f's screen! */ | |
389 abort (); | |
390 selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables, | |
391 menus, prefixes, items, number_of_panes, obj_list, | |
392 title, &error_name); | |
393 } | |
394 UNBLOCK_INPUT; | 738 UNBLOCK_INPUT; |
395 /* fprintf (stderr, "selection = %x\n", selection); */ | 739 |
396 if (selection != NUL) | 740 discard_menu_items (); |
397 { /* selected something */ | 741 |
398 XMenu_return = selection; | 742 UNGCPRO; |
399 } | 743 |
400 else | |
401 { /* nothing selected */ | |
402 XMenu_return = Qnil; | |
403 } | |
404 /* now free up the strings */ | |
405 for (i = 0; i < number_of_panes; i++) | |
406 { | |
407 xfree (names[i]); | |
408 xfree (enables[i]); | |
409 xfree (obj_list[i]); | |
410 } | |
411 xfree (menus); | |
412 xfree (obj_list); | |
413 xfree (names); | |
414 xfree (enables); | |
415 xfree (items); | |
416 /* free (title); */ | |
417 if (error_name) error (error_name); | 744 if (error_name) error (error_name); |
418 return XMenu_return; | 745 return selection; |
419 #endif /* not USE_X_TOOLKIT */ | |
420 } | 746 } |
421 | 747 |
422 #ifdef USE_X_TOOLKIT | 748 #ifdef USE_X_TOOLKIT |
423 | 749 |
424 static void | 750 static void |
458 XlwMenuWidget mw; | 784 XlwMenuWidget mw; |
459 struct input_event *event; | 785 struct input_event *event; |
460 char *name; | 786 char *name; |
461 int *string_w; | 787 int *string_w; |
462 { | 788 { |
463 *string_w += string_width (mw, name) | 789 *string_w += (string_width (mw, name) |
464 + 2 * (mw->menu.horizontal_spacing + mw->menu.shadow_thickness); | 790 + 2 * (mw->menu.horizontal_spacing |
465 return (XINT (event->x) < *string_w); | 791 + mw->menu.shadow_thickness)); |
792 return XINT (event->x) < *string_w; | |
466 } | 793 } |
467 | 794 |
468 | 795 |
469 Lisp_Object | 796 Lisp_Object |
470 map_event_to_object (event, f) | 797 map_event_to_object (event, f) |
493 } | 820 } |
494 } | 821 } |
495 return Qnil; | 822 return Qnil; |
496 } | 823 } |
497 | 824 |
498 static widget_value * | 825 static Lisp_Object *menu_item_selection; |
499 set_menu_items (menu, prefixes, panes, names, enables, menus, | |
500 items, number_of_panes, obj_list, title, error_name) | |
501 Lisp_Object menu; | |
502 Lisp_Object **prefixes; | |
503 int *panes; | |
504 char ***names[]; | |
505 int ***enables; | |
506 char ***menus; | |
507 int **items; | |
508 int *number_of_panes; | |
509 Lisp_Object ***obj_list; | |
510 char **title; | |
511 char **error_name; | |
512 { | |
513 Lisp_Object keymap, tem; | |
514 Lisp_Object ltitle, selection; | |
515 int i, j; | |
516 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; | |
517 int last, selidx, lpane, status; | |
518 int lines, sofar; | |
519 | |
520 keymap = Fkeymapp (menu); | |
521 tem = Qnil; | |
522 | |
523 if (XTYPE (menu) == Lisp_Cons) | |
524 tem = Fkeymapp (Fcar (menu)); | |
525 if (!NILP (keymap)) | |
526 { | |
527 /* We were given a keymap. Extract menu info from the keymap. */ | |
528 Lisp_Object prompt; | |
529 keymap = get_keymap (menu); | |
530 | |
531 /* Search for a string appearing directly as an element of the keymap. | |
532 That string is the title of the menu. */ | |
533 prompt = map_prompt (keymap); | |
534 if (!NILP (prompt)) | |
535 *title = (char *) XSTRING (prompt)->data; | |
536 | |
537 /* Extract the detailed info to make one pane. */ | |
538 *number_of_panes = keymap_panes (obj_list, menus, names, enables, | |
539 items, prefixes, menu, 1); | |
540 /* The menu title seems to be ignored, | |
541 so put it in the pane title. */ | |
542 if ((*menus)[0] == 0) | |
543 (*menus)[0] = *title; | |
544 } | |
545 else if (!NILP (tem)) | |
546 { | |
547 /* We were given a list of keymaps. */ | |
548 Lisp_Object prompt; | |
549 int nmaps = XFASTINT (Flength (menu)); | |
550 Lisp_Object *maps | |
551 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); | |
552 int i; | |
553 *title = 0; | |
554 | |
555 /* The first keymap that has a prompt string | |
556 supplies the menu title. */ | |
557 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) | |
558 { | |
559 maps[i++] = keymap = get_keymap (Fcar (tem)); | |
560 | |
561 prompt = map_prompt (keymap); | |
562 if (*title == 0 && !NILP (prompt)) | |
563 *title = (char *) XSTRING (prompt)->data; | |
564 } | |
565 | |
566 /* Extract the detailed info to make one pane. */ | |
567 *number_of_panes = keymap_panes (obj_list, menus, names, enables, | |
568 items, prefixes, maps, nmaps); | |
569 /* The menu title seems to be ignored, | |
570 so put it in the pane title. */ | |
571 if ((*menus)[0] == 0) | |
572 (*menus)[0] = *title; | |
573 } | |
574 else | |
575 { | |
576 /* We were given an old-fashioned menu. */ | |
577 ltitle = Fcar (menu); | |
578 CHECK_STRING (ltitle, 1); | |
579 *title = (char *) XSTRING (ltitle)->data; | |
580 *prefixes = 0; | |
581 *number_of_panes = list_of_panes (obj_list, menus, names, enables, | |
582 items, Fcdr (menu)); | |
583 } | |
584 | |
585 *error_name = 0; | |
586 if (*number_of_panes == 0) | |
587 return 0; | |
588 | |
589 *error_name = (char *) 0; /* Initialize error pointer to null */ | |
590 | |
591 wv = malloc_widget_value (); | |
592 wv->name = "menu"; | |
593 wv->value = 0; | |
594 wv->enabled = 1; | |
595 first_wv = wv; | |
596 | |
597 for (*panes = 0, lines = 0; *panes < *number_of_panes; | |
598 lines += (*items)[*panes], (*panes)++) | |
599 ; | |
600 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */ | |
601 /* datap = (char *) xmalloc (lines * sizeof (char)); | |
602 datap_save = datap;*/ | |
603 | |
604 for (*panes = 0, sofar = 0; *panes < *number_of_panes; | |
605 sofar += (*items)[*panes], (*panes)++) | |
606 { | |
607 if (strcmp((*menus)[*panes], "")) | |
608 { | |
609 wv = malloc_widget_value (); | |
610 if (save_wv) | |
611 save_wv->next = wv; | |
612 else | |
613 first_wv->contents = wv; | |
614 wv->name = (*menus)[*panes]; | |
615 wv->value = 0; | |
616 wv->enabled = 1; | |
617 } | |
618 prev_wv = 0; | |
619 save_wv = wv; | |
620 | |
621 for (selidx = 0; selidx < (*items)[*panes]; selidx++) | |
622 { | |
623 wv = malloc_widget_value (); | |
624 if (prev_wv) | |
625 prev_wv->next = wv; | |
626 else | |
627 save_wv->contents = wv; | |
628 wv->name = (*names)[*panes][selidx]; | |
629 wv->value = 0; | |
630 selection = (*obj_list)[*panes][selidx]; | |
631 if (*prefixes != 0) | |
632 { | |
633 selection = Fcons (selection, Qnil); | |
634 if (!NILP ((*prefixes)[*panes])) | |
635 selection = Fcons ((*prefixes)[*panes], selection); | |
636 } | |
637 wv->call_data = LISP_TO_VOID(selection); | |
638 wv->enabled = (*enables)[*panes][selidx]; | |
639 prev_wv = wv; | |
640 } | |
641 } | |
642 | |
643 return (first_wv); | |
644 } | |
645 | |
646 static void | |
647 free_menu_items (names, enables, menus, items, number_of_panes, | |
648 obj_list, title, error_name) | |
649 char **names[]; | |
650 int *enables[]; | |
651 char **menus; | |
652 int *items; | |
653 int number_of_panes; | |
654 Lisp_Object **obj_list; | |
655 char *title; | |
656 char *error_name; | |
657 { | |
658 int i; | |
659 /* now free up the strings */ | |
660 for (i = 0; i < number_of_panes; i++) | |
661 { | |
662 xfree (names[i]); | |
663 xfree (enables[i]); | |
664 xfree (obj_list[i]); | |
665 } | |
666 xfree (menus); | |
667 xfree (obj_list); | |
668 xfree (names); | |
669 xfree (enables); | |
670 xfree (items); | |
671 /* free (title); */ | |
672 if (error_name) error (error_name); | |
673 | |
674 } | |
675 | |
676 static Lisp_Object menu_item_selection; | |
677 | 826 |
678 static void | 827 static void |
679 popup_selection_callback (widget, id, client_data) | 828 popup_selection_callback (widget, id, client_data) |
680 Widget widget; | 829 Widget widget; |
681 LWLIB_ID id; | 830 LWLIB_ID id; |
682 XtPointer client_data; | 831 XtPointer client_data; |
683 { | 832 { |
684 VOID_TO_LISP (menu_item_selection, client_data); | 833 menu_item_selection = (Lisp_Object *) client_data; |
685 } | 834 } |
686 | 835 |
687 static void | 836 static void |
688 popup_down_callback (widget, id, client_data) | 837 popup_down_callback (widget, id, client_data) |
689 Widget widget; | 838 Widget widget; |
695 UNBLOCK_INPUT; | 844 UNBLOCK_INPUT; |
696 } | 845 } |
697 | 846 |
698 /* This recursively calls free_widget_value() on the tree of widgets. | 847 /* This recursively calls free_widget_value() on the tree of widgets. |
699 It must free all data that was malloc'ed for these widget_values. | 848 It must free all data that was malloc'ed for these widget_values. |
700 Currently, emacs only allocates new storage for the `key' slot. | 849 In Emacs, many slots are pointers into the data of Lisp_Strings, and |
701 All other slots are pointers into the data of Lisp_Strings, and | 850 must be left alone. */ |
702 must be left alone. | 851 |
703 */ | |
704 void | 852 void |
705 free_menubar_widget_value_tree (wv) | 853 free_menubar_widget_value_tree (wv) |
706 widget_value *wv; | 854 widget_value *wv; |
707 { | 855 { |
708 if (! wv) return; | 856 if (! wv) return; |
709 if (wv->key) xfree (wv->key); | |
710 | 857 |
711 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; | 858 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; |
712 | 859 |
713 if (wv->contents && (wv->contents != (widget_value*)1)) | 860 if (wv->contents && (wv->contents != (widget_value*)1)) |
714 { | 861 { |
841 BLOCK_INPUT; | 988 BLOCK_INPUT; |
842 lw_destroy_all_widgets (id); | 989 lw_destroy_all_widgets (id); |
843 UNBLOCK_INPUT; | 990 UNBLOCK_INPUT; |
844 } | 991 } |
845 } | 992 } |
993 | |
994 /* Nonzero if position X, Y relative to inside of frame F | |
995 is in some other menu bar item. */ | |
996 | |
997 static int this_menu_bar_item_beg; | |
998 static int this_menu_bar_item_end; | |
999 | |
1000 static int | |
1001 other_menu_bar_item_p (f, x, y) | |
1002 FRAME_PTR f; | |
1003 int x, y; | |
1004 { | |
1005 return (y >= 0 | |
1006 && y < f->display.x->menubar_widget->core.height | |
1007 && x >= 0 | |
1008 && x < f->display.x->menubar_widget->core.width | |
1009 && (x >= this_menu_bar_item_end | |
1010 || x < this_menu_bar_item_beg)); | |
1011 } | |
1012 | |
1013 /* Unread a button-press event in the menu bar of frame F | |
1014 at x position XPOS relative to the inside of the frame. */ | |
1015 | |
1016 static void | |
1017 unread_menu_bar_button (f, xpos) | |
1018 FRAME_PTR f; | |
1019 int xpos; | |
1020 { | |
1021 XEvent event; | |
1022 | |
1023 event.type = ButtonPress; | |
1024 event.xbutton.display = x_current_display; | |
1025 event.xbutton.serial = 0; | |
1026 event.xbutton.send_event = 0; | |
1027 event.xbutton.time = CurrentTime; | |
1028 event.xbutton.button = Button1; | |
1029 event.xbutton.window = XtWindow (f->display.x->menubar_widget); | |
1030 event.xbutton.x = xpos; | |
1031 XPutBackEvent (XDISPLAY &event); | |
1032 } | |
1033 | |
1034 /* If the mouse has moved to another menu bar item, | |
1035 return 1 and unread a button press event for that item. | |
1036 Otherwise return 0. */ | |
1037 | |
1038 static int | |
1039 check_mouse_other_menu_bar (f) | |
1040 FRAME_PTR f; | |
1041 { | |
1042 FRAME_PTR new_f; | |
1043 Lisp_Object bar_window; | |
1044 int part; | |
1045 Lisp_Object x, y; | |
1046 unsigned long time; | |
1047 | |
1048 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time); | |
1049 | |
1050 if (f == new_f && other_menu_bar_item_p (f, x, y)) | |
1051 { | |
1052 unread_menu_bar_button (f, x); | |
1053 return 1; | |
1054 } | |
1055 | |
1056 return 0; | |
1057 } | |
846 #endif /* USE_X_TOOLKIT */ | 1058 #endif /* USE_X_TOOLKIT */ |
847 | 1059 |
848 struct indices { | 1060 /* xmenu_show actually displays a menu using the panes and items in menu_items |
849 int pane; | 1061 and returns the value selected from it. |
850 int line; | 1062 There are two versions of xmenu_show, one for Xt and one for Xlib. |
851 }; | 1063 Both assume input is blocked by the caller. */ |
852 | 1064 |
853 extern void process_expose_from_menu (); | 1065 /* F is the frame the menu is for. |
1066 X and Y are the frame-relative specified position, | |
1067 relative to the inside upper left corner of the frame F. | |
1068 MENUBARP is 1 if the click that asked for this menu came from the menu bar. | |
1069 KEYMAPS is 1 if this menu was specified with keymaps; | |
1070 in that case, we return a list containing the chosen item's value | |
1071 and perhaps also the pane's prefix. | |
1072 TITLE is the specified menu title. | |
1073 ERROR is a place to store an error message string in case of failure. | |
1074 (We return nil on failure, but the value doesn't actually matter.) */ | |
854 | 1075 |
855 #ifdef USE_X_TOOLKIT | 1076 #ifdef USE_X_TOOLKIT |
856 extern XtAppContext Xt_app_con; | 1077 |
857 | 1078 static Lisp_Object |
858 Lisp_Object | 1079 xmenu_show (f, x, y, menubarp, keymaps, title, error) |
859 xmenu_show (f, val, x, y, menubarp, vw) | |
860 FRAME_PTR f; | 1080 FRAME_PTR f; |
861 widget_value *val; | |
862 int x; | 1081 int x; |
863 int y; | 1082 int y; |
864 int menubarp; | 1083 int menubarp; |
865 widget_value *vw; | 1084 int keymaps; |
866 { | 1085 Lisp_Object title; |
867 int menu_id, item_length; | 1086 char **error; |
868 Lisp_Object selection; | 1087 { |
1088 int i; | |
1089 int menu_id; | |
869 Widget menu; | 1090 Widget menu; |
870 XlwMenuWidget menuw = (XlwMenuWidget) f->display.x->menubar_widget; | 1091 XlwMenuWidget menubar = (XlwMenuWidget) f->display.x->menubar_widget; |
871 | 1092 |
872 /* | 1093 /* This is the menu bar item (if any) that led to this menu. */ |
873 * Define and allocate a foreign event queue to hold events | 1094 widget_value *menubar_item = 0; |
874 * that don't belong to XMenu. These events are later restored | 1095 |
875 * to the X event queue. | 1096 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; |
876 */ | 1097 |
877 typedef struct _xmeventque | 1098 /* Define a queue to save up for later unreading |
1099 all X events that don't pertain to the menu. */ | |
1100 struct event_queue | |
878 { | 1101 { |
879 XEvent event; | 1102 XEvent event; |
880 struct _xmeventque *next; | 1103 struct event_queue *next; |
881 } XMEventQue; | 1104 }; |
882 | 1105 |
883 XMEventQue *feq = NULL; /* Foreign event queue. */ | 1106 struct event_queue *queue = NULL; |
884 XMEventQue *feq_tmp; /* Foreign event queue temporary. */ | 1107 struct event_queue *queue_tmp; |
885 | 1108 |
886 BLOCK_INPUT; | 1109 *error = NULL; |
887 if (val == 0) return Qnil; | 1110 |
888 | 1111 this_menu_bar_item_beg = -1; |
1112 this_menu_bar_item_end = -1; | |
1113 | |
1114 /* Figure out which menu bar item, if any, this menu is for. */ | |
1115 if (menubarp) | |
1116 { | |
1117 int xbeg; | |
1118 int xend = 0; | |
1119 | |
1120 for (menubar_item = menubar->menu.old_stack[0]->contents; | |
1121 menubar_item; | |
1122 menubar_item = menubar_item->next) | |
1123 { | |
1124 xbeg = xend; | |
1125 xend += (string_width (menubar, menubar_item->name) | |
1126 + 2 * (menubar->menu.horizontal_spacing | |
1127 + menubar->menu.shadow_thickness)); | |
1128 if (x < xend) | |
1129 { | |
1130 x = xbeg + 4; | |
1131 y = 0; | |
1132 /* Arrange to show a different menu if we move in the menu bar | |
1133 to a different item. */ | |
1134 this_menu_bar_item_beg = xbeg; | |
1135 this_menu_bar_item_end = xend; | |
1136 break; | |
1137 } | |
1138 } | |
1139 } | |
1140 if (menubar_item == 0) | |
1141 menubarp = 0; | |
1142 | |
1143 /* Offset the coordinates to root-relative. */ | |
1144 x += (f->display.x->widget->core.x | |
1145 + f->display.x->widget->core.border_width); | |
1146 y += (f->display.x->widget->core.y | |
1147 + f->display.x->widget->core.border_width | |
1148 + f->display.x->menubar_widget->core.height); | |
1149 | |
1150 /* Create a tree of widget_value objects | |
1151 representing the panes and their items. */ | |
1152 wv = malloc_widget_value (); | |
1153 wv->name = "menu"; | |
1154 wv->value = 0; | |
1155 wv->enabled = 1; | |
1156 first_wv = wv; | |
1157 | |
1158 /* Loop over all panes and items, filling in the tree. */ | |
1159 i = 0; | |
1160 while (i < menu_items_used) | |
1161 { | |
1162 if (EQ (XVECTOR (menu_items)->contents[i], Qt)) | |
1163 { | |
1164 /* Create a new pane. */ | |
1165 Lisp_Object pane_name, prefix; | |
1166 char *pane_string; | |
1167 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; | |
1168 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; | |
1169 pane_string = (NILP (pane_name) | |
1170 ? "" : (char *) XSTRING (pane_name)->data); | |
1171 /* If there is just one pane, put all its items directly | |
1172 under the top-level menu. */ | |
1173 if (menu_items_n_panes == 1) | |
1174 pane_string = ""; | |
1175 | |
1176 /* If the pane has a meaningful name, | |
1177 make the pane a top-level menu item | |
1178 with its items as a submenu beneath it. */ | |
1179 if (strcmp (pane_string, "")) | |
1180 { | |
1181 wv = malloc_widget_value (); | |
1182 if (save_wv) | |
1183 save_wv->next = wv; | |
1184 else | |
1185 first_wv->contents = wv; | |
1186 wv->name = pane_string; | |
1187 if (keymaps && !NILP (prefix)) | |
1188 wv->name++; | |
1189 wv->value = 0; | |
1190 wv->enabled = 1; | |
1191 } | |
1192 save_wv = wv; | |
1193 prev_wv = 0; | |
1194 i += MENU_ITEMS_PANE_LENGTH; | |
1195 } | |
1196 else | |
1197 { | |
1198 /* Create a new item within current pane. */ | |
1199 Lisp_Object item_name, enable, descrip; | |
1200 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; | |
1201 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; | |
1202 descrip | |
1203 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; | |
1204 | |
1205 wv = malloc_widget_value (); | |
1206 if (prev_wv) | |
1207 prev_wv->next = wv; | |
1208 else | |
1209 save_wv->contents = wv; | |
1210 wv->name = XSTRING (item_name)->data; | |
1211 if (!NILP (descrip)) | |
1212 wv->key = XSTRING (descrip)->data; | |
1213 wv->value = 0; | |
1214 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i]; | |
1215 wv->enabled = !NILP (enable); | |
1216 prev_wv = wv; | |
1217 | |
1218 i += MENU_ITEMS_ITEM_LENGTH; | |
1219 } | |
1220 } | |
1221 | |
1222 /* Actually create the menu. */ | |
889 menu_id = ++popup_id_tick; | 1223 menu_id = ++popup_id_tick; |
890 menu = lw_create_widget ("popup", val->name, menu_id, val, | 1224 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv, |
891 f->display.x->widget, 1, 0, | 1225 f->display.x->widget, 1, 0, |
892 popup_selection_callback, popup_down_callback); | 1226 popup_selection_callback, popup_down_callback); |
893 free_menubar_widget_value_tree (val); | 1227 /* Free the widget_value objects we used to specify the contents. */ |
894 | 1228 free_menubar_widget_value_tree (first_wv); |
895 /* reset the selection */ | 1229 |
896 menu_item_selection = Qnil; | 1230 /* No selection has been chosen yet. */ |
897 | 1231 menu_item_selection = 0; |
1232 | |
1233 /* If the mouse moves out of the menu before we show the menu, | |
1234 don't show it at all. */ | |
1235 if (check_mouse_other_menu_bar (f)) | |
1236 { | |
1237 lw_destroy_all_widgets (menu_id); | |
1238 return Qnil; | |
1239 } | |
1240 | |
1241 | |
1242 /* Highlight the menu bar item (if any) that led to this menu. */ | |
1243 if (menubarp) | |
1244 { | |
1245 menubar_item->call_data = (XtPointer) 1; | |
1246 dispatch_dummy_expose (f->display.x->menubar_widget, x, y); | |
1247 } | |
1248 | |
1249 /* Display the menu. */ | |
898 { | 1250 { |
899 XButtonPressedEvent dummy; | 1251 XButtonPressedEvent dummy; |
900 XlwMenuWidget mw; | 1252 XlwMenuWidget mw; |
901 | 1253 |
902 mw = ((XlwMenuWidget) | 1254 mw = (XlwMenuWidget) ((CompositeWidget)menu)->composite.children[0]; |
903 ((CompositeWidget)menu)->composite.children[0]); | |
904 | 1255 |
905 dummy.type = ButtonPress; | 1256 dummy.type = ButtonPress; |
906 dummy.serial = 0; | 1257 dummy.serial = 0; |
907 dummy.send_event = 0; | 1258 dummy.send_event = 0; |
908 dummy.display = XtDisplay (menu); | 1259 dummy.display = XtDisplay (menu); |
910 dummy.time = CurrentTime; | 1261 dummy.time = CurrentTime; |
911 dummy.button = 0; | 1262 dummy.button = 0; |
912 dummy.x_root = x; | 1263 dummy.x_root = x; |
913 dummy.y_root = y; | 1264 dummy.y_root = y; |
914 | 1265 |
915 if (menubarp) | 1266 /* We activate directly the lucid implementation. */ |
916 { | |
917 vw->call_data = (XtPointer) 1; | |
918 dispatch_dummy_expose (f->display.x->menubar_widget, x, y); | |
919 } | |
920 | |
921 | |
922 /* We activate directly the lucid implementation */ | |
923 pop_up_menu (mw, &dummy); | 1267 pop_up_menu (mw, &dummy); |
924 } | 1268 } |
925 | 1269 |
926 if (menubarp) | 1270 /* Check again whether the mouse has moved to another menu bar item. */ |
927 { | 1271 if (check_mouse_other_menu_bar (f)) |
928 item_length = (x + string_width (menuw, vw->name) | 1272 { |
929 + (2 * (menuw->menu.horizontal_spacing | 1273 /* The mouse moved into a different menu bar item. |
930 + menuw->menu.shadow_thickness)) | 1274 We should bring up that item's menu instead. |
931 - 4); | 1275 First pop down this menu. */ |
932 } | 1276 XtUngrabPointer ((Widget) |
933 | 1277 ((XlwMenuWidget) |
934 /* Enters XEvent loop */ | 1278 ((CompositeWidget)menu)->composite.children[0]), |
1279 CurrentTime); | |
1280 lw_destroy_all_widgets (menu_id); | |
1281 goto pop_down; | |
1282 } | |
1283 | |
1284 /* Process events that apply to the menu. */ | |
935 while (1) | 1285 while (1) |
936 { | 1286 { |
937 | |
938 XEvent event; | 1287 XEvent event; |
1288 | |
939 XtAppNextEvent (Xt_app_con, &event); | 1289 XtAppNextEvent (Xt_app_con, &event); |
940 if (event.type == ButtonRelease) | 1290 if (event.type == ButtonRelease) |
941 { | 1291 { |
942 XtDispatchEvent (&event); | 1292 XtDispatchEvent (&event); |
943 break; | 1293 break; |
944 } | 1294 } |
945 else | 1295 else if (event.type == Expose) |
946 if (event.type == Expose) | 1296 process_expose_from_menu (event); |
947 process_expose_from_menu (event); | 1297 else if (event.type == MotionNotify) |
948 else | 1298 { |
949 if (event.type == MotionNotify | 1299 int event_x = (event.xmotion.x_root |
950 && menubarp | 1300 - (f->display.x->widget->core.x |
951 && ((event.xmotion.y_root | 1301 + f->display.x->widget->core.border_width)); |
952 >= (f->display.x->widget->core.y | 1302 int event_y = (event.xmotion.y_root |
953 + f->display.x->widget->core.border_width)) | 1303 - (f->display.x->widget->core.y |
954 && (event.xmotion.y_root | 1304 + f->display.x->widget->core.border_width)); |
955 < (f->display.x->widget->core.y | 1305 |
956 + f->display.x->widget->core.border_width | 1306 if (other_menu_bar_item_p (f, event_x, event_y)) |
957 + f->display.x->menubar_widget->core.height))) | 1307 { |
958 && ((event.xmotion.x_root | 1308 /* The mouse moved into a different menu bar item. |
959 >= (f->display.x->widget->core.x | 1309 We should bring up that item's menu instead. |
960 + f->display.x->widget->core.border_width)) | 1310 First pop down this menu. */ |
961 && (event.xmotion.x_root | 1311 XtUngrabPointer ((Widget) |
962 < (f->display.x->widget->core.x | 1312 ((XlwMenuWidget) |
963 + f->display.x->widget->core.border_width | 1313 ((CompositeWidget)menu)->composite.children[0]), |
964 + f->display.x->widget->core.width))) | 1314 event.xbutton.time); |
965 && (event.xmotion.x_root >= item_length | 1315 lw_destroy_all_widgets (menu_id); |
966 || event.xmotion.x_root < (x - 4))) | 1316 |
967 { | 1317 /* Put back an event that will bring up the other item's menu. */ |
968 BLOCK_INPUT; | 1318 unread_menu_bar_button (f, event_x); |
969 XtUngrabPointer ((Widget) | 1319 /* Don't let us select anything in this case. */ |
970 ((XlwMenuWidget) | 1320 menu_item_selection = 0; |
971 ((CompositeWidget)menu)->composite.children[0]), | 1321 break; |
972 event.xbutton.time); | 1322 } |
973 lw_destroy_all_widgets (menu_id); | 1323 } |
974 UNBLOCK_INPUT; | |
975 | |
976 event.type = ButtonPress; | |
977 event.xbutton.time = CurrentTime; | |
978 event.xbutton.button = Button1; | |
979 event.xbutton.window = XtWindow (f->display.x->menubar_widget); | |
980 event.xbutton.x = (event.xbutton.x_root | |
981 - (f->display.x->widget->core.x | |
982 + f->display.x->widget->core.border_width)); | |
983 XPutBackEvent (XDISPLAY &event); | |
984 break; | |
985 } | |
986 | 1324 |
987 XtDispatchEvent (&event); | 1325 XtDispatchEvent (&event); |
988 feq_tmp = (XMEventQue *) malloc (sizeof (XMEventQue)); | 1326 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue)); |
989 | 1327 |
990 if (feq_tmp == NULL) | 1328 if (queue_tmp != NULL) |
991 return(Qnil); | 1329 { |
992 | 1330 queue_tmp->event = event; |
993 feq_tmp->event = event; | 1331 queue_tmp->next = queue; |
994 feq_tmp->next = feq; | 1332 queue = queue_tmp; |
995 feq = feq_tmp; | 1333 } |
996 } | 1334 } |
997 | 1335 |
1336 pop_down: | |
1337 /* Unhighlight the menu bar item (if any) that led to this menu. */ | |
998 if (menubarp) | 1338 if (menubarp) |
999 { | 1339 { |
1000 vw->call_data = (XtPointer) 0; | 1340 menubar_item->call_data = (XtPointer) 0; |
1001 dispatch_dummy_expose (f->display.x->menubar_widget, x, y); | 1341 dispatch_dummy_expose (f->display.x->menubar_widget, x, y); |
1002 } | 1342 } |
1003 | 1343 |
1004 /* Return any foreign events that were queued to the X event queue. */ | 1344 /* Make sure the menu disappears. */ |
1005 while (feq != NULL) | 1345 lw_destroy_all_widgets (menu_id); |
1006 { | 1346 |
1007 feq_tmp = feq; | 1347 /* Unread any events that we got but did not handle. */ |
1008 XPutBackEvent (XDISPLAY &feq_tmp->event); | 1348 while (queue != NULL) |
1009 feq = feq_tmp->next; | 1349 { |
1010 free ((char *)feq_tmp); | 1350 queue_tmp = queue; |
1011 } | 1351 XPutBackEvent (XDISPLAY &queue_tmp->event); |
1012 | 1352 queue = queue_tmp->next; |
1013 UNBLOCK_INPUT; | 1353 free ((char *)queue_tmp); |
1014 | 1354 } |
1015 return menu_item_selection; | 1355 |
1356 /* Find the selected item, and its pane, to return | |
1357 the proper value. */ | |
1358 if (menu_item_selection != 0) | |
1359 { | |
1360 Lisp_Object prefix; | |
1361 | |
1362 prefix = Qnil; | |
1363 i = 0; | |
1364 while (i < menu_items_used) | |
1365 { | |
1366 Lisp_Object entry; | |
1367 | |
1368 if (EQ (XVECTOR (menu_items)->contents[i], Qt)) | |
1369 { | |
1370 prefix | |
1371 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; | |
1372 i += MENU_ITEMS_PANE_LENGTH; | |
1373 } | |
1374 else | |
1375 { | |
1376 entry | |
1377 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; | |
1378 if (menu_item_selection == &XVECTOR (menu_items)->contents[i]) | |
1379 { | |
1380 if (keymaps != 0) | |
1381 { | |
1382 entry = Fcons (entry, Qnil); | |
1383 if (!NILP (prefix)) | |
1384 entry = Fcons (prefix, entry); | |
1385 } | |
1386 return entry; | |
1387 } | |
1388 i += MENU_ITEMS_ITEM_LENGTH; | |
1389 } | |
1390 } | |
1391 } | |
1392 | |
1393 return Qnil; | |
1016 } | 1394 } |
1017 | 1395 |
1018 #else /* not USE_X_TOOLKIT */ | 1396 #else /* not USE_X_TOOLKIT */ |
1019 xmenu_show (parent, startx, starty, line_list, enable_list, pane_list, | 1397 |
1020 prefixes, line_cnt, pane_cnt, item_list, title, error) | 1398 static Lisp_Object |
1021 Window parent; | 1399 xmenu_show (f, x, y, menubarp, keymaps, title, error) |
1022 int startx, starty; /* upper left corner position BROKEN */ | 1400 FRAME_PTR f; |
1023 char **line_list[]; /* list of strings for items */ | 1401 int x, y; |
1024 int *enable_list[]; /* enable flags of lines */ | 1402 int keymaps; |
1025 char *pane_list[]; /* list of pane titles */ | 1403 int menubarp; |
1026 Lisp_Object *prefixes; /* Prefix key for each pane */ | 1404 Lisp_Object title; |
1027 char *title; | 1405 char **error; |
1028 int pane_cnt; /* total number of panes */ | 1406 { |
1029 Lisp_Object *item_list[]; /* All items */ | 1407 Window root; |
1030 int line_cnt[]; /* Lines in each pane */ | 1408 XMenu *menu; |
1031 char **error; /* Error returned */ | 1409 int pane, selidx, lpane, status; |
1032 { | 1410 Lisp_Object entry, pane_prefix; |
1033 XMenu *GXMenu; | |
1034 int last, panes, selidx, lpane, status; | |
1035 int lines, sofar; | |
1036 Lisp_Object entry; | |
1037 /* struct indices *datap, *datap_save; */ | |
1038 char *datap; | 1411 char *datap; |
1039 int ulx, uly, width, height; | 1412 int ulx, uly, width, height; |
1040 int dispwidth, dispheight; | 1413 int dispwidth, dispheight; |
1414 int i; | |
1415 int dummy_int; | |
1416 unsigned int dummy_uint; | |
1041 | 1417 |
1042 *error = 0; | 1418 *error = 0; |
1043 if (pane_cnt == 0) | 1419 if (menu_items_n_panes == 0) |
1044 return 0; | 1420 return Qnil; |
1045 | 1421 |
1046 BLOCK_INPUT; | 1422 /* Figure out which root window F is on. */ |
1047 *error = (char *) 0; /* Initialize error pointer to null */ | 1423 XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root, |
1048 | 1424 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint, |
1049 GXMenu = XMenuCreate (XDISPLAY parent, "emacs"); | 1425 &dummy_uint, &dummy_uint); |
1050 if (GXMenu == NUL) | 1426 |
1427 /* Make the menu on that window. */ | |
1428 menu = XMenuCreate (XDISPLAY root, "emacs"); | |
1429 if (menu == NULL) | |
1051 { | 1430 { |
1052 *error = "Can't create menu"; | 1431 *error = "Can't create menu"; |
1053 UNBLOCK_INPUT; | 1432 return Qnil; |
1054 return (0); | 1433 } |
1055 } | 1434 |
1435 /* Adjust coordinates to relative to the outer (window manager) window. */ | |
1436 #ifdef HAVE_X11 | |
1437 { | |
1438 Window child; | |
1439 int win_x = 0, win_y = 0; | |
1440 | |
1441 /* Find the position of the outside upper-left corner of | |
1442 the inner window, with respect to the outer window. */ | |
1443 if (f->display.x->parent_desc != ROOT_WINDOW) | |
1444 { | |
1445 BLOCK_INPUT; | |
1446 XTranslateCoordinates (x_current_display, | |
1447 | |
1448 /* From-window, to-window. */ | |
1449 f->display.x->window_desc, | |
1450 f->display.x->parent_desc, | |
1451 | |
1452 /* From-position, to-position. */ | |
1453 0, 0, &win_x, &win_y, | |
1454 | |
1455 /* Child of window. */ | |
1456 &child); | |
1457 UNBLOCK_INPUT; | |
1458 x += win_x; | |
1459 y += win_y; | |
1460 } | |
1461 } | |
1462 #endif /* HAVE_X11 */ | |
1463 | |
1464 /* Adjust coordinates to be root-window-relative. */ | |
1465 x += f->display.x->left_pos; | |
1466 y += f->display.x->top_pos; | |
1056 | 1467 |
1057 for (panes = 0, lines = 0; panes < pane_cnt; | 1468 /* Create all the necessary panes and their items. */ |
1058 lines += line_cnt[panes], panes++) | 1469 i = 0; |
1059 ; | 1470 while (i < menu_items_used) |
1060 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */ | 1471 { |
1061 /* datap = (char *) xmalloc (lines * sizeof (char)); | 1472 if (EQ (XVECTOR (menu_items)->contents[i], Qt)) |
1062 datap_save = datap;*/ | 1473 { |
1063 | 1474 /* Create a new pane. */ |
1064 for (panes = 0, sofar = 0; panes < pane_cnt; | 1475 Lisp_Object pane_name, prefix; |
1065 sofar += line_cnt[panes], panes++) | 1476 char *pane_string; |
1066 { | 1477 |
1067 /* create all the necessary panes */ | 1478 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; |
1068 lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE); | 1479 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; |
1069 if (lpane == XM_FAILURE) | 1480 pane_string = (NILP (pane_name) |
1070 { | 1481 ? "" : (char *) XSTRING (pane_name)->data); |
1071 XMenuDestroy (XDISPLAY GXMenu); | 1482 if (keymaps && !NILP (prefix)) |
1072 *error = "Can't create pane"; | 1483 pane_string++; |
1073 UNBLOCK_INPUT; | 1484 |
1074 return (0); | 1485 lpane = XMenuAddPane (XDISPLAY menu, pane_string, TRUE); |
1075 } | 1486 if (lpane == XM_FAILURE) |
1076 | 1487 { |
1077 for (selidx = 0; selidx < line_cnt[panes]; selidx++) | 1488 XMenuDestroy (XDISPLAY menu); |
1078 { | 1489 *error = "Can't create pane"; |
1079 /* add the selection stuff to the menus */ | 1490 return Qnil; |
1080 /* datap[selidx+sofar].pane = panes; | 1491 } |
1081 datap[selidx+sofar].line = selidx; */ | 1492 i += MENU_ITEMS_PANE_LENGTH; |
1082 if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0, | 1493 } |
1083 line_list[panes][selidx], | 1494 else |
1084 enable_list[panes][selidx]) | 1495 { |
1496 /* Create a new item within current pane. */ | |
1497 Lisp_Object item_name, enable, descrip; | |
1498 | |
1499 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; | |
1500 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; | |
1501 descrip | |
1502 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; | |
1503 if (!NILP (descrip)) | |
1504 item_name = concat2 (item_name, descrip); | |
1505 | |
1506 if (XMenuAddSelection (XDISPLAY menu, lpane, 0, | |
1507 XSTRING (item_name)->data, | |
1508 !NILP (enable)) | |
1085 == XM_FAILURE) | 1509 == XM_FAILURE) |
1086 { | 1510 { |
1087 XMenuDestroy (XDISPLAY GXMenu); | 1511 XMenuDestroy (XDISPLAY menu); |
1088 /* free (datap); */ | |
1089 *error = "Can't add selection to menu"; | 1512 *error = "Can't add selection to menu"; |
1090 /* error ("Can't add selection to menu"); */ | 1513 return Qnil; |
1091 UNBLOCK_INPUT; | |
1092 return (0); | |
1093 } | 1514 } |
1094 } | 1515 i += MENU_ITEMS_ITEM_LENGTH; |
1095 } | 1516 } |
1096 /* all set and ready to fly */ | 1517 } |
1097 XMenuRecompute (XDISPLAY GXMenu); | 1518 |
1519 /* All set and ready to fly. */ | |
1520 XMenuRecompute (XDISPLAY menu); | |
1098 dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display)); | 1521 dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display)); |
1099 dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display)); | 1522 dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display)); |
1100 startx = min (startx, dispwidth); | 1523 x = min (x, dispwidth); |
1101 starty = min (starty, dispheight); | 1524 y = min (y, dispheight); |
1102 startx = max (startx, 1); | 1525 x = max (x, 1); |
1103 starty = max (starty, 1); | 1526 y = max (y, 1); |
1104 XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty, | 1527 XMenuLocate (XDISPLAY menu, 0, 0, x, y, |
1105 &ulx, &uly, &width, &height); | 1528 &ulx, &uly, &width, &height); |
1106 if (ulx+width > dispwidth) | 1529 if (ulx+width > dispwidth) |
1107 { | 1530 { |
1108 startx -= (ulx + width) - dispwidth; | 1531 x -= (ulx + width) - dispwidth; |
1109 ulx = dispwidth - width; | 1532 ulx = dispwidth - width; |
1110 } | 1533 } |
1111 if (uly+height > dispheight) | 1534 if (uly+height > dispheight) |
1112 { | 1535 { |
1113 starty -= (uly + height) - dispheight; | 1536 y -= (uly + height) - dispheight; |
1114 uly = dispheight - height; | 1537 uly = dispheight - height; |
1115 } | 1538 } |
1116 if (ulx < 0) startx -= ulx; | 1539 if (ulx < 0) x -= ulx; |
1117 if (uly < 0) starty -= uly; | 1540 if (uly < 0) y -= uly; |
1118 | 1541 |
1119 XMenuSetFreeze (GXMenu, TRUE); | 1542 XMenuSetFreeze (menu, TRUE); |
1120 panes = selidx = 0; | 1543 pane = selidx = 0; |
1121 | 1544 |
1122 status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx, | 1545 status = XMenuActivate (XDISPLAY menu, &pane, &selidx, |
1123 startx, starty, ButtonReleaseMask, &datap); | 1546 x, y, ButtonReleaseMask, &datap); |
1124 switch (status) | 1547 switch (status) |
1125 { | 1548 { |
1126 case XM_SUCCESS: | 1549 case XM_SUCCESS: |
1127 #ifdef XDEBUG | 1550 #ifdef XDEBUG |
1128 fprintf (stderr, "pane= %d line = %d\n", panes, selidx); | 1551 fprintf (stderr, "pane= %d line = %d\n", panes, selidx); |
1129 #endif | 1552 #endif |
1130 entry = item_list[panes][selidx]; | 1553 |
1131 if (prefixes != 0) | 1554 /* Find the item number SELIDX in pane number PANE. */ |
1132 { | 1555 i = 0; |
1133 entry = Fcons (entry, Qnil); | 1556 while (i < menu_items_used) |
1134 if (!NILP (prefixes[panes])) | 1557 { |
1135 entry = Fcons (prefixes[panes], entry); | 1558 if (EQ (XVECTOR (menu_items)->contents[i], Qt)) |
1559 { | |
1560 if (pane == 0) | |
1561 pane_prefix | |
1562 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; | |
1563 pane--; | |
1564 i += MENU_ITEMS_PANE_LENGTH; | |
1565 } | |
1566 else | |
1567 { | |
1568 if (pane == -1) | |
1569 { | |
1570 if (selidx == 0) | |
1571 { | |
1572 entry | |
1573 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; | |
1574 if (keymaps != 0) | |
1575 { | |
1576 entry = Fcons (entry, Qnil); | |
1577 if (!NILP (pane_prefix)) | |
1578 entry = Fcons (pane_prefix, entry); | |
1579 } | |
1580 break; | |
1581 } | |
1582 selidx--; | |
1583 } | |
1584 i += MENU_ITEMS_ITEM_LENGTH; | |
1585 } | |
1136 } | 1586 } |
1137 break; | 1587 break; |
1588 | |
1138 case XM_FAILURE: | 1589 case XM_FAILURE: |
1139 /* free (datap_save); */ | 1590 XMenuDestroy (XDISPLAY menu); |
1140 XMenuDestroy (XDISPLAY GXMenu); | |
1141 *error = "Can't activate menu"; | 1591 *error = "Can't activate menu"; |
1142 /* error ("Can't activate menu"); */ | |
1143 case XM_IA_SELECT: | 1592 case XM_IA_SELECT: |
1144 case XM_NO_SELECT: | 1593 case XM_NO_SELECT: |
1145 entry = Qnil; | 1594 entry = Qnil; |
1146 break; | 1595 break; |
1147 } | 1596 } |
1148 XMenuDestroy (XDISPLAY GXMenu); | 1597 XMenuDestroy (XDISPLAY menu); |
1149 UNBLOCK_INPUT; | 1598 return entry; |
1150 /* free (datap_save);*/ | |
1151 return (entry); | |
1152 } | 1599 } |
1153 #endif /* not USE_X_TOOLKIT */ | 1600 #endif /* not USE_X_TOOLKIT */ |
1154 | 1601 |
1155 syms_of_xmenu () | 1602 syms_of_xmenu () |
1156 { | 1603 { |
1604 staticpro (&menu_items); | |
1605 menu_items = Qnil; | |
1606 | |
1157 popup_id_tick = (1<<16); | 1607 popup_id_tick = (1<<16); |
1158 defsubr (&Sx_popup_menu); | 1608 defsubr (&Sx_popup_menu); |
1159 } | 1609 } |
1160 | |
1161 /* Figure out the current keyboard equivalent of a menu item ITEM1. | |
1162 Store the equivalent key sequence in *SAVEDKEY_PTR | |
1163 and the textual description (to use in the menu display) in *DESCRIP_PTR. | |
1164 Also cache them in the item itself. | |
1165 Return the real definition to execute. */ | |
1166 | |
1167 static Lisp_Object | |
1168 menu_item_equiv_key (item1, savedkey_ptr, descrip_ptr) | |
1169 Lisp_Object item1; | |
1170 Lisp_Object *savedkey_ptr, *descrip_ptr; | |
1171 { | |
1172 /* This is what is left after the menu item name. */ | |
1173 Lisp_Object overdef; | |
1174 /* This is the real definition--the function to run. */ | |
1175 Lisp_Object def; | |
1176 /* These are the saved equivalent keyboard key sequence | |
1177 and its key-description. */ | |
1178 Lisp_Object savedkey, descrip; | |
1179 Lisp_Object def1; | |
1180 int changed = 0; | |
1181 | |
1182 overdef = def = Fcdr (item1); | |
1183 | |
1184 /* Get out the saved equivalent-keyboard-key info. */ | |
1185 savedkey = descrip = Qnil; | |
1186 if (CONSP (overdef) && VECTORP (XCONS (overdef)->car)) | |
1187 { | |
1188 savedkey = XCONS (overdef)->car; | |
1189 def = XCONS (def)->cdr; | |
1190 if (CONSP (def) && STRINGP (XCONS (def)->car)) | |
1191 { | |
1192 descrip = XCONS (def)->car; | |
1193 def = XCONS (def)->cdr; | |
1194 } | |
1195 } | |
1196 | |
1197 /* Is it still valid? */ | |
1198 def1 = Qnil; | |
1199 if (!NILP (savedkey)) | |
1200 def1 = Fkey_binding (savedkey, Qnil); | |
1201 /* If not, update it. */ | |
1202 if (! EQ (def1, def)) | |
1203 { | |
1204 changed = 1; | |
1205 descrip = Qnil; | |
1206 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil); | |
1207 if (VECTORP (savedkey) | |
1208 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar)) | |
1209 savedkey = Qnil; | |
1210 if (!NILP (savedkey)) | |
1211 { | |
1212 descrip = Fkey_description (savedkey); | |
1213 descrip = concat2 (make_string (" (", 3), descrip); | |
1214 descrip = concat2 (descrip, make_string (")", 1)); | |
1215 } | |
1216 } | |
1217 | |
1218 /* Store back the recorded keyboard key sequence | |
1219 if we changed it. */ | |
1220 if (!NILP (savedkey) | |
1221 && CONSP (overdef) && VECTORP (XCONS (overdef)->car)) | |
1222 { | |
1223 if (changed) | |
1224 { | |
1225 XCONS (overdef)->car = savedkey; | |
1226 def1 = XCONS (overdef)->cdr; | |
1227 if (CONSP (def1) && STRINGP (XCONS (def1)->car)) | |
1228 XCONS (def1)->car = descrip; | |
1229 } | |
1230 } | |
1231 /* If we had none but need one now, add it. */ | |
1232 else if (!NILP (savedkey)) | |
1233 XCONS (item1)->cdr | |
1234 = overdef = Fcons (savedkey, Fcons (descrip, def)); | |
1235 /* If we had one but no longer should have one, delete it. */ | |
1236 else if (CONSP (overdef) && VECTORP (XCONS (overdef)->car)) | |
1237 { | |
1238 XCONS (item1)->cdr = overdef = XCONS (overdef)->cdr; | |
1239 if (CONSP (overdef) && STRINGP (XCONS (overdef)->car)) | |
1240 XCONS (item1)->cdr = overdef = XCONS (overdef)->cdr; | |
1241 } | |
1242 | |
1243 *savedkey_ptr = savedkey; | |
1244 *descrip_ptr = descrip; | |
1245 return def; | |
1246 } | |
1247 | |
1248 /* Construct the vectors that describe a menu | |
1249 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS. | |
1250 Each of those four values is a vector indexed by pane number. | |
1251 Return the number of panes. | |
1252 | |
1253 KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */ | |
1254 | |
1255 int | |
1256 keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps) | |
1257 Lisp_Object ***vector; /* RETURN all menu objects */ | |
1258 char ***panes; /* RETURN pane names */ | |
1259 char ****names; /* RETURN all line names */ | |
1260 int ***enables; /* RETURN enable-flags of lines */ | |
1261 int **items; /* RETURN number of items per pane */ | |
1262 Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */ | |
1263 Lisp_Object *keymaps; | |
1264 int nmaps; | |
1265 { | |
1266 /* Number of panes we have made. */ | |
1267 int p = 0; | |
1268 /* Number of panes we have space for. */ | |
1269 int npanes_allocated = nmaps; | |
1270 int mapno; | |
1271 | |
1272 if (npanes_allocated < 4) | |
1273 npanes_allocated = 4; | |
1274 | |
1275 /* Make space for an estimated number of panes. */ | |
1276 *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *)); | |
1277 *panes = (char **) xmalloc (npanes_allocated * sizeof (char *)); | |
1278 *items = (int *) xmalloc (npanes_allocated * sizeof (int)); | |
1279 *names = (char ***) xmalloc (npanes_allocated * sizeof (char **)); | |
1280 *enables = (int **) xmalloc (npanes_allocated * sizeof (int *)); | |
1281 *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object)); | |
1282 | |
1283 /* Loop over the given keymaps, making a pane for each map. | |
1284 But don't make a pane that is empty--ignore that map instead. | |
1285 P is the number of panes we have made so far. */ | |
1286 for (mapno = 0; mapno < nmaps; mapno++) | |
1287 single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items, | |
1288 prefixes, &p, &npanes_allocated, ""); | |
1289 | |
1290 /* Return the number of panes. */ | |
1291 return p; | |
1292 } | |
1293 | |
1294 /* This is used as the handler when calling internal_condition_case_1. */ | |
1295 | |
1296 static Lisp_Object | |
1297 single_keymap_panes_1 (arg) | |
1298 Lisp_Object arg; | |
1299 { | |
1300 return Qnil; | |
1301 } | |
1302 | |
1303 /* This is a recursive subroutine of keymap_panes. | |
1304 It handles one keymap, KEYMAP. | |
1305 The other arguments are passed along | |
1306 or point to local variables of the previous function. */ | |
1307 | |
1308 single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes, | |
1309 p_ptr, npanes_allocated_ptr, pane_name) | |
1310 Lisp_Object keymap; | |
1311 Lisp_Object ***vector; /* RETURN all menu objects */ | |
1312 char ***panes; /* RETURN pane names */ | |
1313 char ****names; /* RETURN all line names */ | |
1314 int ***enables; /* RETURN enable flags of lines */ | |
1315 int **items; /* RETURN number of items per pane */ | |
1316 Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */ | |
1317 int *p_ptr; | |
1318 int *npanes_allocated_ptr; | |
1319 char *pane_name; | |
1320 { | |
1321 int i; | |
1322 Lisp_Object pending_maps; | |
1323 Lisp_Object tail, item, item1, item_string, table; | |
1324 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
1325 | |
1326 pending_maps = Qnil; | |
1327 | |
1328 /* Make sure we have room for another pane. */ | |
1329 if (*p_ptr == *npanes_allocated_ptr) | |
1330 { | |
1331 *npanes_allocated_ptr *= 2; | |
1332 | |
1333 *vector | |
1334 = (Lisp_Object **) xrealloc (*vector, | |
1335 *npanes_allocated_ptr * sizeof (Lisp_Object *)); | |
1336 *panes | |
1337 = (char **) xrealloc (*panes, | |
1338 *npanes_allocated_ptr * sizeof (char *)); | |
1339 *items | |
1340 = (int *) xrealloc (*items, | |
1341 *npanes_allocated_ptr * sizeof (int)); | |
1342 *prefixes | |
1343 = (Lisp_Object *) xrealloc (*prefixes, | |
1344 (*npanes_allocated_ptr | |
1345 * sizeof (Lisp_Object))); | |
1346 *names | |
1347 = (char ***) xrealloc (*names, | |
1348 *npanes_allocated_ptr * sizeof (char **)); | |
1349 *enables | |
1350 = (int **) xrealloc (*enables, | |
1351 *npanes_allocated_ptr * sizeof (int *)); | |
1352 } | |
1353 | |
1354 /* When a menu comes from keymaps, don't give names to the panes. */ | |
1355 (*panes)[*p_ptr] = pane_name; | |
1356 | |
1357 /* Normally put nil as pane's prefix key. | |
1358 Caller will override this if appropriate. */ | |
1359 (*prefixes)[*p_ptr] = Qnil; | |
1360 | |
1361 /* Get the length of the list level of the keymap. */ | |
1362 i = XFASTINT (Flength (keymap)); | |
1363 | |
1364 /* Add in lengths of any arrays. */ | |
1365 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) | |
1366 if (XTYPE (XCONS (tail)->car) == Lisp_Vector) | |
1367 i += XVECTOR (XCONS (tail)->car)->size; | |
1368 | |
1369 /* Create vectors for the names and values of the items in the pane. | |
1370 I is an upper bound for the number of items. */ | |
1371 (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object)); | |
1372 (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *)); | |
1373 (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int)); | |
1374 | |
1375 /* I is now the index of the next unused slots. */ | |
1376 i = 0; | |
1377 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) | |
1378 { | |
1379 /* Look at each key binding, and if it has a menu string, | |
1380 make a menu item from it. */ | |
1381 item = XCONS (tail)->car; | |
1382 if (XTYPE (item) == Lisp_Cons) | |
1383 { | |
1384 item1 = XCONS (item)->cdr; | |
1385 if (XTYPE (item1) == Lisp_Cons) | |
1386 { | |
1387 item_string = XCONS (item1)->car; | |
1388 if (XTYPE (item_string) == Lisp_String) | |
1389 { | |
1390 /* This is the real definition--the function to run. */ | |
1391 Lisp_Object def; | |
1392 /* These are the saved equivalent keyboard key sequence | |
1393 and its key-description. */ | |
1394 Lisp_Object savedkey, descrip; | |
1395 Lisp_Object tem, enabled; | |
1396 | |
1397 /* If a help string follows the item string, | |
1398 skip it. */ | |
1399 if (CONSP (XCONS (item1)->cdr) | |
1400 && STRINGP (XCONS (XCONS (item1)->cdr)->car)) | |
1401 item1 = XCONS (item1)->cdr; | |
1402 | |
1403 def = menu_item_equiv_key (item1, &savedkey, &descrip); | |
1404 | |
1405 enabled = Qt; | |
1406 if (XTYPE (def) == Lisp_Symbol) | |
1407 { | |
1408 /* No property, or nil, means enable. | |
1409 Otherwise, enable if value is not nil. */ | |
1410 tem = Fget (def, Qmenu_enable); | |
1411 /* GCPRO because we will call eval. | |
1412 Protecting KEYMAP preserves everything we use; | |
1413 aside from that, must protect whatever might be | |
1414 a string. */ | |
1415 GCPRO3 (keymap, def, descrip, item_string); | |
1416 if (!NILP (tem)) | |
1417 /* (condition-case nil (eval tem) | |
1418 (error nil)) */ | |
1419 enabled = internal_condition_case_1 (Feval, tem, | |
1420 Qerror, | |
1421 single_keymap_panes_1); | |
1422 UNGCPRO; | |
1423 } | |
1424 tem = Fkeymapp (def); | |
1425 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) | |
1426 pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)), | |
1427 pending_maps); | |
1428 else | |
1429 { | |
1430 Lisp_Object concat; | |
1431 if (!NILP (descrip)) | |
1432 concat = concat2 (item_string, descrip); | |
1433 else | |
1434 concat = item_string; | |
1435 (*names)[*p_ptr][i] = (char *) XSTRING (concat)->data; | |
1436 /* The menu item "value" is the key bound here. */ | |
1437 (*vector)[*p_ptr][i] = XCONS (item)->car; | |
1438 (*enables)[*p_ptr][i] | |
1439 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0); | |
1440 i++; | |
1441 } | |
1442 } | |
1443 } | |
1444 } | |
1445 else if (XTYPE (item) == Lisp_Vector) | |
1446 { | |
1447 /* Loop over the char values represented in the vector. */ | |
1448 int len = XVECTOR (item)->size; | |
1449 int c; | |
1450 for (c = 0; c < len; c++) | |
1451 { | |
1452 Lisp_Object character; | |
1453 XFASTINT (character) = c; | |
1454 item1 = XVECTOR (item)->contents[c]; | |
1455 if (XTYPE (item1) == Lisp_Cons) | |
1456 { | |
1457 item_string = XCONS (item1)->car; | |
1458 if (XTYPE (item_string) == Lisp_String) | |
1459 { | |
1460 Lisp_Object def; | |
1461 | |
1462 /* These are the saved equivalent keyboard key sequence | |
1463 and its key-description. */ | |
1464 Lisp_Object savedkey, descrip; | |
1465 Lisp_Object tem, enabled; | |
1466 | |
1467 /* If a help string follows the item string, | |
1468 skip it. */ | |
1469 if (CONSP (XCONS (item1)->cdr) | |
1470 && STRINGP (XCONS (XCONS (item1)->cdr)->car)) | |
1471 item1 = XCONS (item1)->cdr; | |
1472 | |
1473 def = menu_item_equiv_key (item1, &savedkey, &descrip); | |
1474 | |
1475 enabled = Qt; | |
1476 if (XTYPE (def) == Lisp_Symbol) | |
1477 { | |
1478 tem = Fget (def, Qmenu_enable); | |
1479 /* GCPRO because we will call eval. | |
1480 Protecting KEYMAP preserves everything we use; | |
1481 aside from that, must protect whatever might be | |
1482 a string. */ | |
1483 GCPRO3 (keymap, def, descrip, item_string); | |
1484 /* No property, or nil, means enable. | |
1485 Otherwise, enable if value is not nil. */ | |
1486 if (!NILP (tem)) | |
1487 /* (condition-case nil (eval tem) | |
1488 (error nil)) */ | |
1489 enabled = internal_condition_case_1 (Feval, tem, | |
1490 Qerror, | |
1491 single_keymap_panes_1); | |
1492 UNGCPRO; | |
1493 } | |
1494 | |
1495 tem = Fkeymapp (def); | |
1496 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) | |
1497 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)), | |
1498 pending_maps); | |
1499 else | |
1500 { | |
1501 Lisp_Object concat; | |
1502 if (!NILP (descrip)) | |
1503 concat = concat2 (item_string, descrip); | |
1504 else | |
1505 concat = item_string; | |
1506 (*names)[*p_ptr][i] | |
1507 = (char *) XSTRING (concat)->data; | |
1508 /* The menu item "value" is the key bound here. */ | |
1509 (*vector)[*p_ptr][i] = character; | |
1510 (*enables)[*p_ptr][i] | |
1511 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0); | |
1512 i++; | |
1513 } | |
1514 } | |
1515 } | |
1516 } | |
1517 } | |
1518 } | |
1519 /* Record the number of items in the pane. */ | |
1520 (*items)[*p_ptr] = i; | |
1521 | |
1522 /* If we just made an empty pane, get rid of it. */ | |
1523 if (i == 0) | |
1524 { | |
1525 xfree ((*vector)[*p_ptr]); | |
1526 xfree ((*names)[*p_ptr]); | |
1527 xfree ((*enables)[*p_ptr]); | |
1528 } | |
1529 /* Otherwise, advance past it. */ | |
1530 else | |
1531 (*p_ptr)++; | |
1532 | |
1533 /* Process now any submenus which want to be panes at this level. */ | |
1534 while (!NILP (pending_maps)) | |
1535 { | |
1536 Lisp_Object elt, eltcdr; | |
1537 int panenum = *p_ptr; | |
1538 elt = Fcar (pending_maps); | |
1539 eltcdr = XCONS (elt)->cdr; | |
1540 single_keymap_panes (Fcar (elt), panes, vector, names, enables, items, | |
1541 prefixes, p_ptr, npanes_allocated_ptr, | |
1542 /* Add 1 to discard the @. */ | |
1543 (char *) XSTRING (XCONS (eltcdr)->car)->data + 1); | |
1544 (*prefixes)[panenum] = XCONS (eltcdr)->cdr; | |
1545 pending_maps = Fcdr (pending_maps); | |
1546 } | |
1547 } | |
1548 | |
1549 /* Construct the vectors that describe a menu | |
1550 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS. | |
1551 Each of those four values is a vector indexed by pane number. | |
1552 Return the number of panes. | |
1553 | |
1554 MENU is the argument that was given to Fx_popup_menu. */ | |
1555 | |
1556 int | |
1557 list_of_panes (vector, panes, names, enables, items, menu) | |
1558 Lisp_Object ***vector; /* RETURN all menu objects */ | |
1559 char ***panes; /* RETURN pane names */ | |
1560 char ****names; /* RETURN all line names */ | |
1561 int ***enables; /* RETURN enable flags of lines */ | |
1562 int **items; /* RETURN number of items per pane */ | |
1563 Lisp_Object menu; | |
1564 { | |
1565 Lisp_Object tail, item, item1; | |
1566 int i; | |
1567 | |
1568 if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu); | |
1569 | |
1570 i = XFASTINT (Flength (menu)); | |
1571 | |
1572 *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *)); | |
1573 *panes = (char **) xmalloc (i * sizeof (char *)); | |
1574 *items = (int *) xmalloc (i * sizeof (int)); | |
1575 *names = (char ***) xmalloc (i * sizeof (char **)); | |
1576 *enables = (int **) xmalloc (i * sizeof (int *)); | |
1577 | |
1578 for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++) | |
1579 { | |
1580 item = Fcdr (Fcar (tail)); | |
1581 if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item); | |
1582 #ifdef XDEBUG | |
1583 fprintf (stderr, "list_of_panes check tail, i=%d\n", i); | |
1584 #endif | |
1585 item1 = Fcar (Fcar (tail)); | |
1586 CHECK_STRING (item1, 1); | |
1587 #ifdef XDEBUG | |
1588 fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i, | |
1589 XSTRING (item1)->data); | |
1590 #endif | |
1591 (*panes)[i] = (char *) XSTRING (item1)->data; | |
1592 (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item); | |
1593 /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1); | |
1594 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1) | |
1595 ; */ | |
1596 } | |
1597 return i; | |
1598 } | |
1599 | |
1600 /* Construct the lists of values and names for a single pane, from the | |
1601 alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags | |
1602 int *ENABLES. Return the number of items. */ | |
1603 | |
1604 int | |
1605 list_of_items (vector, names, enables, pane) | |
1606 Lisp_Object **vector; /* RETURN menu "objects" */ | |
1607 char ***names; /* RETURN line names */ | |
1608 int **enables; /* RETURN enable flags of lines */ | |
1609 Lisp_Object pane; | |
1610 { | |
1611 Lisp_Object tail, item, item1; | |
1612 int i; | |
1613 | |
1614 if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane); | |
1615 | |
1616 i = XFASTINT (Flength (pane)); | |
1617 | |
1618 *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object)); | |
1619 *names = (char **) xmalloc (i * sizeof (char *)); | |
1620 *enables = (int *) xmalloc (i * sizeof (int)); | |
1621 | |
1622 for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++) | |
1623 { | |
1624 item = Fcar (tail); | |
1625 if (STRINGP (item)) | |
1626 { | |
1627 (*vector)[i] = Qnil; | |
1628 (*names)[i] = (char *) XSTRING (item)->data; | |
1629 (*enables)[i] = -1; | |
1630 } | |
1631 else | |
1632 { | |
1633 CHECK_CONS (item, 0); | |
1634 (*vector)[i] = Fcdr (item); | |
1635 item1 = Fcar (item); | |
1636 CHECK_STRING (item1, 1); | |
1637 (*names)[i] = (char *) XSTRING (item1)->data; | |
1638 (*enables)[i] = 1; | |
1639 } | |
1640 } | |
1641 return i; | |
1642 } |