Mercurial > emacs

comparison src/xmenu.c @ 6058:662b9cd767fe

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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 }