(widget_id_tick): Move definition into conditional.
[bpt/emacs.git] / src / xmenu.c
1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20 /* X pop-up deck-of-cards menu facility for gnuemacs.
21 *
22 * Written by Jon Arnold and Roman Budzianowski
23 * Mods and rewrite by Robert Krawitz
24 *
25 */
26
27 /* Modified by Fred Pierresteguy on December 93
28 to make the popup menus and menubar use the Xt. */
29
30 /* Rewritten for clarity and GC protection by rms in Feb 94. */
31
32 /* On 4.3 this loses if it comes after xterm.h. */
33 #include <signal.h>
34 #include <config.h>
35
36 #include <stdio.h>
37 #include "lisp.h"
38 #include "termhooks.h"
39 #include "frame.h"
40 #include "window.h"
41 #include "keyboard.h"
42 #include "blockinput.h"
43 #include "puresize.h"
44
45 /* This may include sys/types.h, and that somehow loses
46 if this is not done before the other system files. */
47 #include "xterm.h"
48
49 /* Load sys/types.h if not already loaded.
50 In some systems loading it twice is suicidal. */
51 #ifndef makedev
52 #include <sys/types.h>
53 #endif
54
55 #include "dispextern.h"
56
57 #ifdef HAVE_X11
58 #include "../oldXMenu/XMenu.h"
59 #else
60 #include <X/XMenu.h>
61 #endif
62
63 #ifdef USE_X_TOOLKIT
64 #include <X11/Xlib.h>
65 #include <X11/IntrinsicP.h>
66 #include <X11/CoreP.h>
67 #include <X11/StringDefs.h>
68 #include <X11/Shell.h>
69 #include "../lwlib/lwlib.h"
70 #endif /* USE_X_TOOLKIT */
71
72 #define min(x,y) (((x) < (y)) ? (x) : (y))
73 #define max(x,y) (((x) > (y)) ? (x) : (y))
74
75 #ifndef TRUE
76 #define TRUE 1
77 #define FALSE 0
78 #endif /* no TRUE */
79
80 #ifdef HAVE_X11
81 extern Display *x_current_display;
82 #else
83 #define ButtonReleaseMask ButtonReleased
84 #endif /* not HAVE_X11 */
85
86 extern Lisp_Object Qmenu_enable;
87 extern Lisp_Object Qmenu_bar;
88
89 #ifdef USE_X_TOOLKIT
90 extern void process_expose_from_menu ();
91 extern XtAppContext Xt_app_con;
92
93 static Lisp_Object xdialog_show ();
94 void popup_get_selection ();
95 #endif
96
97 static Lisp_Object xmenu_show ();
98 static void keymap_panes ();
99 static void single_keymap_panes ();
100 static void list_of_panes ();
101 static void list_of_items ();
102 \f
103 /* This holds a Lisp vector that holds the results of decoding
104 the keymaps or alist-of-alists that specify a menu.
105
106 It describes the panes and items within the panes.
107
108 Each pane is described by 3 elements in the vector:
109 t, the pane name, the pane's prefix key.
110 Then follow the pane's items, with 4 elements per item:
111 the item string, the enable flag, the item's value,
112 and the equivalent keyboard key's description string.
113
114 In some cases, multiple levels of menus may be described.
115 A single vector slot containing nil indicates the start of a submenu.
116 A single vector slot containing lambda indicates the end of a submenu.
117 The submenu follows a menu item which is the way to reach the submenu.
118
119 A single vector slot containing quote indicates that the
120 following items should appear on the right of a dialog box.
121
122 Using a Lisp vector to hold this information while we decode it
123 takes care of protecting all the data from GC. */
124
125 #define MENU_ITEMS_PANE_NAME 1
126 #define MENU_ITEMS_PANE_PREFIX 2
127 #define MENU_ITEMS_PANE_LENGTH 3
128
129 #define MENU_ITEMS_ITEM_NAME 0
130 #define MENU_ITEMS_ITEM_ENABLE 1
131 #define MENU_ITEMS_ITEM_VALUE 2
132 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
133 #define MENU_ITEMS_ITEM_LENGTH 4
134
135 static Lisp_Object menu_items;
136
137 /* Number of slots currently allocated in menu_items. */
138 static int menu_items_allocated;
139
140 /* This is the index in menu_items of the first empty slot. */
141 static int menu_items_used;
142
143 /* The number of panes currently recorded in menu_items,
144 excluding those within submenus. */
145 static int menu_items_n_panes;
146
147 /* Current depth within submenus. */
148 static int menu_items_submenu_depth;
149
150 /* Flag which when set indicates a dialog or menu has been posted by
151 Xt on behalf of one of the widget sets. */
152 static int popup_activated_flag;
153
154 \f
155 /* Initialize the menu_items structure if we haven't already done so.
156 Also mark it as currently empty. */
157
158 static void
159 init_menu_items ()
160 {
161 if (NILP (menu_items))
162 {
163 menu_items_allocated = 60;
164 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
165 }
166
167 menu_items_used = 0;
168 menu_items_n_panes = 0;
169 menu_items_submenu_depth = 0;
170 }
171
172 /* Call at the end of generating the data in menu_items.
173 This fills in the number of items in the last pane. */
174
175 static void
176 finish_menu_items ()
177 {
178 }
179
180 /* Call when finished using the data for the current menu
181 in menu_items. */
182
183 static void
184 discard_menu_items ()
185 {
186 /* Free the structure if it is especially large.
187 Otherwise, hold on to it, to save time. */
188 if (menu_items_allocated > 200)
189 {
190 menu_items = Qnil;
191 menu_items_allocated = 0;
192 }
193 }
194
195 /* Make the menu_items vector twice as large. */
196
197 static void
198 grow_menu_items ()
199 {
200 Lisp_Object old;
201 int old_size = menu_items_allocated;
202 old = menu_items;
203
204 menu_items_allocated *= 2;
205 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
206 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
207 old_size * sizeof (Lisp_Object));
208 }
209
210 /* Begin a submenu. */
211
212 static void
213 push_submenu_start ()
214 {
215 if (menu_items_used + 1 > menu_items_allocated)
216 grow_menu_items ();
217
218 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
219 menu_items_submenu_depth++;
220 }
221
222 /* End a submenu. */
223
224 static void
225 push_submenu_end ()
226 {
227 if (menu_items_used + 1 > menu_items_allocated)
228 grow_menu_items ();
229
230 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
231 menu_items_submenu_depth--;
232 }
233
234 /* Indicate boundary between left and right. */
235
236 static void
237 push_left_right_boundary ()
238 {
239 if (menu_items_used + 1 > menu_items_allocated)
240 grow_menu_items ();
241
242 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
243 }
244
245 /* Start a new menu pane in menu_items..
246 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
247
248 static void
249 push_menu_pane (name, prefix_vec)
250 Lisp_Object name, prefix_vec;
251 {
252 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
253 grow_menu_items ();
254
255 if (menu_items_submenu_depth == 0)
256 menu_items_n_panes++;
257 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
258 XVECTOR (menu_items)->contents[menu_items_used++] = name;
259 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
260 }
261
262 /* Push one menu item into the current pane.
263 NAME is the string to display. ENABLE if non-nil means
264 this item can be selected. KEY is the key generated by
265 choosing this item. EQUIV is the textual description
266 of the keyboard equivalent for this item (or nil if none). */
267
268 static void
269 push_menu_item (name, enable, key, equiv)
270 Lisp_Object name, enable, key, equiv;
271 {
272 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
273 grow_menu_items ();
274
275 XVECTOR (menu_items)->contents[menu_items_used++] = name;
276 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
277 XVECTOR (menu_items)->contents[menu_items_used++] = key;
278 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
279 }
280 \f
281 /* Figure out the current keyboard equivalent of a menu item ITEM1.
282 The item string for menu display should be ITEM_STRING.
283 Store the equivalent keyboard key sequence's
284 textual description into *DESCRIP_PTR.
285 Also cache them in the item itself.
286 Return the real definition to execute. */
287
288 static Lisp_Object
289 menu_item_equiv_key (item_string, item1, descrip_ptr)
290 Lisp_Object item_string;
291 Lisp_Object item1;
292 Lisp_Object *descrip_ptr;
293 {
294 /* This is the real definition--the function to run. */
295 Lisp_Object def;
296 /* This is the sublist that records cached equiv key data
297 so we can save time. */
298 Lisp_Object cachelist;
299 /* These are the saved equivalent keyboard key sequence
300 and its key-description. */
301 Lisp_Object savedkey, descrip;
302 Lisp_Object def1;
303 int changed = 0;
304 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
305
306 /* If a help string follows the item string, skip it. */
307 if (CONSP (XCONS (item1)->cdr)
308 && STRINGP (XCONS (XCONS (item1)->cdr)->car))
309 item1 = XCONS (item1)->cdr;
310
311 def = Fcdr (item1);
312
313 /* Get out the saved equivalent-keyboard-key info. */
314 cachelist = savedkey = descrip = Qnil;
315 if (CONSP (def) && CONSP (XCONS (def)->car)
316 && (NILP (XCONS (XCONS (def)->car)->car)
317 || VECTORP (XCONS (XCONS (def)->car)->car)))
318 {
319 cachelist = XCONS (def)->car;
320 def = XCONS (def)->cdr;
321 savedkey = XCONS (cachelist)->car;
322 descrip = XCONS (cachelist)->cdr;
323 }
324
325 GCPRO4 (def, def1, savedkey, descrip);
326
327 /* Is it still valid? */
328 def1 = Qnil;
329 if (!NILP (savedkey))
330 def1 = Fkey_binding (savedkey, Qnil);
331 /* If not, update it. */
332 if (! EQ (def1, def)
333 /* If the command is an alias for another
334 (such as easymenu.el and lmenu.el set it up),
335 check if the original command matches the cached command. */
336 && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
337 && EQ (def1, XSYMBOL (def)->function))
338 /* If something had no key binding before, don't recheck it--
339 doing that takes too much time and makes menus too slow. */
340 && !(!NILP (cachelist) && NILP (savedkey)))
341 {
342 changed = 1;
343 descrip = Qnil;
344 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
345 /* If the command is an alias for another
346 (such as easymenu.el and lmenu.el set it up),
347 see if the original command name has equivalent keys. */
348 if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function))
349 savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
350 Qnil, Qt, Qnil);
351
352 if (VECTORP (savedkey)
353 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
354 savedkey = Qnil;
355 if (!NILP (savedkey))
356 {
357 descrip = Fkey_description (savedkey);
358 descrip = concat2 (make_string (" (", 3), descrip);
359 descrip = concat2 (descrip, make_string (")", 1));
360 }
361 }
362
363 /* Cache the data we just got in a sublist of the menu binding. */
364 if (NILP (cachelist))
365 {
366 CHECK_IMPURE (item1);
367 XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
368 }
369 else if (changed)
370 {
371 XCONS (cachelist)->car = savedkey;
372 XCONS (cachelist)->cdr = descrip;
373 }
374
375 UNGCPRO;
376 *descrip_ptr = descrip;
377 return def;
378 }
379
380 /* This is used as the handler when calling internal_condition_case_1. */
381
382 static Lisp_Object
383 menu_item_enabled_p_1 (arg)
384 Lisp_Object arg;
385 {
386 return Qnil;
387 }
388
389 /* Return non-nil if the command DEF is enabled when used as a menu item.
390 This is based on looking for a menu-enable property.
391 If NOTREAL is set, don't bother really computing this. */
392
393 static Lisp_Object
394 menu_item_enabled_p (def, notreal)
395 Lisp_Object def;
396 int notreal;
397 {
398 Lisp_Object enabled, tem;
399
400 enabled = Qt;
401 if (notreal)
402 return enabled;
403 if (SYMBOLP (def))
404 {
405 /* No property, or nil, means enable.
406 Otherwise, enable if value is not nil. */
407 tem = Fget (def, Qmenu_enable);
408 if (!NILP (tem))
409 /* (condition-case nil (eval tem)
410 (error nil)) */
411 enabled = internal_condition_case_1 (Feval, tem, Qerror,
412 menu_item_enabled_p_1);
413 }
414 return enabled;
415 }
416 \f
417 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
418 and generate menu panes for them in menu_items.
419 If NOTREAL is nonzero,
420 don't bother really computing whether an item is enabled. */
421
422 static void
423 keymap_panes (keymaps, nmaps, notreal)
424 Lisp_Object *keymaps;
425 int nmaps;
426 int notreal;
427 {
428 int mapno;
429
430 init_menu_items ();
431
432 /* Loop over the given keymaps, making a pane for each map.
433 But don't make a pane that is empty--ignore that map instead.
434 P is the number of panes we have made so far. */
435 for (mapno = 0; mapno < nmaps; mapno++)
436 single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal);
437
438 finish_menu_items ();
439 }
440
441 /* This is a recursive subroutine of keymap_panes.
442 It handles one keymap, KEYMAP.
443 The other arguments are passed along
444 or point to local variables of the previous function.
445 If NOTREAL is nonzero,
446 don't bother really computing whether an item is enabled. */
447
448 static void
449 single_keymap_panes (keymap, pane_name, prefix, notreal)
450 Lisp_Object keymap;
451 Lisp_Object pane_name;
452 Lisp_Object prefix;
453 int notreal;
454 {
455 Lisp_Object pending_maps;
456 Lisp_Object tail, item, item1, item_string, table;
457 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
458
459 pending_maps = Qnil;
460
461 push_menu_pane (pane_name, prefix);
462
463 for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
464 {
465 /* Look at each key binding, and if it has a menu string,
466 make a menu item from it. */
467 item = XCONS (tail)->car;
468 if (CONSP (item))
469 {
470 item1 = XCONS (item)->cdr;
471 if (CONSP (item1))
472 {
473 item_string = XCONS (item1)->car;
474 if (STRINGP (item_string))
475 {
476 /* This is the real definition--the function to run. */
477 Lisp_Object def;
478 /* These are the saved equivalent keyboard key sequence
479 and its key-description. */
480 Lisp_Object descrip;
481 Lisp_Object tem, enabled;
482
483 /* GCPRO because ...enabled_p will call eval
484 and ..._equiv_key may autoload something.
485 Protecting KEYMAP preserves everything we use;
486 aside from that, must protect whatever might be
487 a string. Since there's no GCPRO5, we refetch
488 item_string instead of protecting it. */
489 descrip = def = Qnil;
490 GCPRO4 (keymap, pending_maps, def, descrip);
491
492 def = menu_item_equiv_key (item_string, item1, &descrip);
493 enabled = menu_item_enabled_p (def, notreal);
494
495 UNGCPRO;
496
497 item_string = XCONS (item1)->car;
498
499 tem = Fkeymapp (def);
500 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
501 pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)),
502 pending_maps);
503 else
504 {
505 Lisp_Object submap;
506 GCPRO4 (keymap, pending_maps, descrip, item_string);
507 submap = get_keymap_1 (def, 0, 1);
508 UNGCPRO;
509 #ifndef USE_X_TOOLKIT
510 /* Indicate visually that this is a submenu. */
511 if (!NILP (submap))
512 item_string = concat2 (item_string,
513 build_string (" >"));
514 #endif
515 push_menu_item (item_string, enabled, XCONS (item)->car,
516 descrip);
517 #ifdef USE_X_TOOLKIT
518 /* Display a submenu using the toolkit. */
519 if (! NILP (submap))
520 {
521 push_submenu_start ();
522 single_keymap_panes (submap, Qnil,
523 XCONS (item)->car, notreal);
524 push_submenu_end ();
525 }
526 #endif
527 }
528 }
529 }
530 }
531 else if (VECTORP (item))
532 {
533 /* Loop over the char values represented in the vector. */
534 int len = XVECTOR (item)->size;
535 int c;
536 for (c = 0; c < len; c++)
537 {
538 Lisp_Object character;
539 XFASTINT (character) = c;
540 item1 = XVECTOR (item)->contents[c];
541 if (CONSP (item1))
542 {
543 item_string = XCONS (item1)->car;
544 if (STRINGP (item_string))
545 {
546 Lisp_Object def;
547
548 /* These are the saved equivalent keyboard key sequence
549 and its key-description. */
550 Lisp_Object descrip;
551 Lisp_Object tem, enabled;
552
553 /* GCPRO because ...enabled_p will call eval
554 and ..._equiv_key may autoload something.
555 Protecting KEYMAP preserves everything we use;
556 aside from that, must protect whatever might be
557 a string. Since there's no GCPRO5, we refetch
558 item_string instead of protecting it. */
559 GCPRO4 (keymap, pending_maps, def, descrip);
560 descrip = def = Qnil;
561
562 def = menu_item_equiv_key (item_string, item1, &descrip);
563 enabled = menu_item_enabled_p (def, notreal);
564
565 UNGCPRO;
566
567 item_string = XCONS (item1)->car;
568
569 tem = Fkeymapp (def);
570 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
571 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
572 pending_maps);
573 else
574 {
575 Lisp_Object submap;
576 GCPRO4 (keymap, pending_maps, descrip, item_string);
577 submap = get_keymap_1 (def, 0, 1);
578 UNGCPRO;
579 #ifndef USE_X_TOOLKIT
580 if (!NILP (submap))
581 item_string = concat2 (item_string,
582 build_string (" >"));
583 #endif
584 push_menu_item (item_string, enabled, character,
585 descrip);
586 #ifdef USE_X_TOOLKIT
587 if (! NILP (submap))
588 {
589 push_submenu_start ();
590 single_keymap_panes (submap, Qnil,
591 character, notreal);
592 push_submenu_end ();
593 }
594 #endif
595 }
596 }
597 }
598 }
599 }
600 }
601
602 /* Process now any submenus which want to be panes at this level. */
603 while (!NILP (pending_maps))
604 {
605 Lisp_Object elt, eltcdr, string;
606 elt = Fcar (pending_maps);
607 eltcdr = XCONS (elt)->cdr;
608 string = XCONS (eltcdr)->car;
609 /* We no longer discard the @ from the beginning of the string here.
610 Instead, we do this in xmenu_show. */
611 single_keymap_panes (Fcar (elt), string,
612 XCONS (eltcdr)->cdr, notreal);
613 pending_maps = Fcdr (pending_maps);
614 }
615 }
616 \f
617 /* Push all the panes and items of a menu decsribed by the
618 alist-of-alists MENU.
619 This handles old-fashioned calls to x-popup-menu. */
620
621 static void
622 list_of_panes (menu)
623 Lisp_Object menu;
624 {
625 Lisp_Object tail;
626
627 init_menu_items ();
628
629 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
630 {
631 Lisp_Object elt, pane_name, pane_data;
632 elt = Fcar (tail);
633 pane_name = Fcar (elt);
634 CHECK_STRING (pane_name, 0);
635 push_menu_pane (pane_name, Qnil);
636 pane_data = Fcdr (elt);
637 CHECK_CONS (pane_data, 0);
638 list_of_items (pane_data);
639 }
640
641 finish_menu_items ();
642 }
643
644 /* Push the items in a single pane defined by the alist PANE. */
645
646 static void
647 list_of_items (pane)
648 Lisp_Object pane;
649 {
650 Lisp_Object tail, item, item1;
651
652 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
653 {
654 item = Fcar (tail);
655 if (STRINGP (item))
656 push_menu_item (item, Qnil, Qnil, Qnil);
657 else if (NILP (item))
658 push_left_right_boundary ();
659 else
660 {
661 CHECK_CONS (item, 0);
662 item1 = Fcar (item);
663 CHECK_STRING (item1, 1);
664 push_menu_item (item1, Qt, Fcdr (item), Qnil);
665 }
666 }
667 }
668 \f
669 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
670 "Pop up a deck-of-cards menu and return user's selection.\n\
671 POSITION is a position specification. This is either a mouse button event\n\
672 or a list ((XOFFSET YOFFSET) WINDOW)\n\
673 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
674 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
675 This controls the position of the center of the first line\n\
676 in the first pane of the menu, not the top left of the menu as a whole.\n\
677 If POSITION is t, it means to use the current mouse position.\n\
678 \n\
679 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
680 The menu items come from key bindings that have a menu string as well as\n\
681 a definition; actually, the \"definition\" in such a key binding looks like\n\
682 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
683 the keymap as a top-level element.\n\n\
684 You can also use a list of keymaps as MENU.\n\
685 Then each keymap makes a separate pane.\n\
686 When MENU is a keymap or a list of keymaps, the return value\n\
687 is a list of events.\n\n\
688 Alternatively, you can specify a menu of multiple panes\n\
689 with a list of the form (TITLE PANE1 PANE2...),\n\
690 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
691 Each ITEM is normally a cons cell (STRING . VALUE);\n\
692 but a string can appear as an item--that makes a nonselectable line\n\
693 in the menu.\n\
694 With this form of menu, the return value is VALUE from the chosen item.\n\
695 \n\
696 If POSITION is nil, don't display the menu at all, just precalculate the\n\
697 cached information about equivalent key sequences.")
698 (position, menu)
699 Lisp_Object position, menu;
700 {
701 int number_of_panes, panes;
702 Lisp_Object keymap, tem;
703 int xpos, ypos;
704 Lisp_Object title;
705 char *error_name;
706 Lisp_Object selection;
707 int i, j;
708 FRAME_PTR f;
709 Lisp_Object x, y, window;
710 int keymaps = 0;
711 int menubarp = 0;
712 struct gcpro gcpro1;
713
714 if (! NILP (position))
715 {
716 check_x ();
717
718 /* Decode the first argument: find the window and the coordinates. */
719 if (EQ (position, Qt))
720 {
721 /* Use the mouse's current position. */
722 FRAME_PTR new_f = 0;
723 Lisp_Object bar_window;
724 int part;
725 unsigned long time;
726
727 if (mouse_position_hook)
728 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
729 if (new_f != 0)
730 XSET (window, Lisp_Frame, new_f);
731 else
732 {
733 window = selected_window;
734 XFASTINT (x) = 0;
735 XFASTINT (y) = 0;
736 }
737 }
738 else
739 {
740 tem = Fcar (position);
741 if (CONSP (tem))
742 {
743 window = Fcar (Fcdr (position));
744 x = Fcar (tem);
745 y = Fcar (Fcdr (tem));
746 }
747 else
748 {
749 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
750 window = Fcar (tem); /* POSN_WINDOW (tem) */
751 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
752 x = Fcar (tem);
753 y = Fcdr (tem);
754
755 /* Determine whether this menu is handling a menu bar click. */
756 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
757 if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
758 menubarp = 1;
759 }
760 }
761
762 CHECK_NUMBER (x, 0);
763 CHECK_NUMBER (y, 0);
764
765 /* Decode where to put the menu. */
766
767 if (FRAMEP (window))
768 {
769 f = XFRAME (window);
770
771 xpos = 0;
772 ypos = 0;
773 }
774 else if (WINDOWP (window))
775 {
776 CHECK_LIVE_WINDOW (window, 0);
777 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
778
779 xpos = (FONT_WIDTH (f->display.x->font) * XWINDOW (window)->left);
780 ypos = (f->display.x->line_height * XWINDOW (window)->top);
781 }
782 else
783 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
784 but I don't want to make one now. */
785 CHECK_WINDOW (window, 0);
786
787 xpos += XINT (x);
788 ypos += XINT (y);
789 }
790
791 title = Qnil;
792 GCPRO1 (title);
793
794 /* Decode the menu items from what was specified. */
795
796 keymap = Fkeymapp (menu);
797 tem = Qnil;
798 if (CONSP (menu))
799 tem = Fkeymapp (Fcar (menu));
800 if (!NILP (keymap))
801 {
802 /* We were given a keymap. Extract menu info from the keymap. */
803 Lisp_Object prompt;
804 keymap = get_keymap (menu);
805
806 /* Extract the detailed info to make one pane. */
807 keymap_panes (&menu, 1, NILP (position));
808
809 /* Search for a string appearing directly as an element of the keymap.
810 That string is the title of the menu. */
811 prompt = map_prompt (keymap);
812
813 /* Make that be the pane title of the first pane. */
814 if (!NILP (prompt) && menu_items_n_panes >= 0)
815 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
816
817 keymaps = 1;
818 }
819 else if (!NILP (tem))
820 {
821 /* We were given a list of keymaps. */
822 int nmaps = XFASTINT (Flength (menu));
823 Lisp_Object *maps
824 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
825 int i;
826
827 title = Qnil;
828
829 /* The first keymap that has a prompt string
830 supplies the menu title. */
831 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
832 {
833 Lisp_Object prompt;
834
835 maps[i++] = keymap = get_keymap (Fcar (tem));
836
837 prompt = map_prompt (keymap);
838 if (NILP (title) && !NILP (prompt))
839 title = prompt;
840 }
841
842 /* Extract the detailed info to make one pane. */
843 keymap_panes (maps, nmaps, NILP (position));
844
845 /* Make the title be the pane title of the first pane. */
846 if (!NILP (title) && menu_items_n_panes >= 0)
847 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
848
849 keymaps = 1;
850 }
851 else
852 {
853 /* We were given an old-fashioned menu. */
854 title = Fcar (menu);
855 CHECK_STRING (title, 1);
856
857 list_of_panes (Fcdr (menu));
858
859 keymaps = 0;
860 }
861
862 if (NILP (position))
863 {
864 discard_menu_items ();
865 UNGCPRO;
866 return Qnil;
867 }
868
869 /* Display them in a menu. */
870 BLOCK_INPUT;
871
872 selection = xmenu_show (f, xpos, ypos, menubarp,
873 keymaps, title, &error_name);
874 UNBLOCK_INPUT;
875
876 discard_menu_items ();
877
878 UNGCPRO;
879
880 if (error_name) error (error_name);
881 return selection;
882 }
883
884 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
885 "Pop up a dialog box and return user's selection.\n\
886 POSITION specifies which frame to use.\n\
887 This is normally a mouse button event or a window or frame.\n\
888 If POSITION is t, it means to use the frame the mouse is on.\n\
889 The dialog box appears in the middle of the specified frame.\n\
890 \n\
891 CONTENTS specifies the alternatives to display in the dialog box.\n\
892 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
893 Each ITEM is a cons cell (STRING . VALUE).\n\
894 The return value is VALUE from the chosen item.\n\n\
895 An ITEM may also be just a string--that makes a nonselectable item.\n\
896 An ITEM may also be nil--that means to put all preceding items\n\
897 on the left of the dialog box and all following items on the right.\n\
898 \(By default, approximately half appear on each side.)")
899 (position, contents)
900 Lisp_Object position, contents;
901 {
902 FRAME_PTR f;
903 Lisp_Object window;
904
905 check_x ();
906
907 /* Decode the first argument: find the window or frame to use. */
908 if (EQ (position, Qt))
909 {
910 #if 0 /* Using the frame the mouse is on may not be right. */
911 /* Use the mouse's current position. */
912 FRAME_PTR new_f = 0;
913 Lisp_Object bar_window;
914 int part;
915 unsigned long time;
916 Lisp_Object x, y;
917
918 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
919
920 if (new_f != 0)
921 XSET (window, Lisp_Frame, new_f);
922 else
923 window = selected_window;
924 #endif
925 /* Decode the first argument: find the window and the coordinates. */
926 if (EQ (position, Qt))
927 window = selected_window;
928 }
929 else if (CONSP (position))
930 {
931 Lisp_Object tem;
932 tem = Fcar (position);
933 if (CONSP (tem))
934 window = Fcar (Fcdr (position));
935 else
936 {
937 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
938 window = Fcar (tem); /* POSN_WINDOW (tem) */
939 }
940 }
941 else if (WINDOWP (position) || FRAMEP (position))
942 window = position;
943
944 /* Decode where to put the menu. */
945
946 if (FRAMEP (window))
947 f = XFRAME (window);
948 else if (WINDOWP (window))
949 {
950 CHECK_LIVE_WINDOW (window, 0);
951 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
952 }
953 else
954 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
955 but I don't want to make one now. */
956 CHECK_WINDOW (window, 0);
957
958 #ifndef USE_X_TOOLKIT
959 /* Display a menu with these alternatives
960 in the middle of frame F. */
961 {
962 Lisp_Object x, y, frame, newpos;
963 XSET (frame, Lisp_Frame, f);
964 XSET (x, Lisp_Int, x_pixel_width (f) / 2);
965 XSET (y, Lisp_Int, x_pixel_height (f) / 2);
966 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
967
968 return Fx_popup_menu (newpos,
969 Fcons (Fcar (contents), Fcons (contents, Qnil)));
970 }
971 #else
972 {
973 Lisp_Object title;
974 char *error_name;
975 Lisp_Object selection;
976
977 /* Decode the dialog items from what was specified. */
978 title = Fcar (contents);
979 CHECK_STRING (title, 1);
980
981 list_of_panes (Fcons (contents, Qnil));
982
983 /* Display them in a dialog box. */
984 BLOCK_INPUT;
985 selection = xdialog_show (f, 0, 0, title, &error_name);
986 UNBLOCK_INPUT;
987
988 discard_menu_items ();
989
990 if (error_name) error (error_name);
991 return selection;
992 }
993 #endif
994 }
995 \f
996 #ifdef USE_X_TOOLKIT
997
998 /* Loop in Xt until the menu pulldown or dialog popup has been
999 popped down (deactivated).
1000
1001 NOTE: All calls to popup_get_selection() should be protected
1002 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1003 void
1004 popup_get_selection (initial_event)
1005 XEvent *initial_event;
1006 {
1007 XEvent event;
1008
1009 if (initial_event)
1010 event = *initial_event;
1011 else
1012 XtAppNextEvent (Xt_app_con, &event);
1013
1014 while (1)
1015 {
1016 XtDispatchEvent (&event);
1017 if (!popup_activated())
1018 break;
1019 XtAppNextEvent (Xt_app_con, &event);
1020 }
1021 }
1022
1023 /* Detect if a dialog or menu has been posted. */
1024 int
1025 popup_activated ()
1026 {
1027 return popup_activated_flag;
1028 }
1029
1030
1031 /* This callback is invoked when the user selects a menubar cascade
1032 pushbutton, but before the pulldown menu is posted. */
1033
1034 static void
1035 popup_activate_callback (widget, id, client_data)
1036 Widget widget;
1037 LWLIB_ID id;
1038 XtPointer client_data;
1039 {
1040 popup_activated_flag = 1;
1041 }
1042
1043 /* This callback is called from the menu bar pulldown menu
1044 when the user makes a selection.
1045 Figure out what the user chose
1046 and put the appropriate events into the keyboard buffer. */
1047
1048 static void
1049 menubar_selection_callback (widget, id, client_data)
1050 Widget widget;
1051 LWLIB_ID id;
1052 XtPointer client_data;
1053 {
1054 Lisp_Object prefix;
1055 FRAME_PTR f = (FRAME_PTR) id;
1056 Lisp_Object vector;
1057 Lisp_Object *subprefix_stack;
1058 int submenu_depth = 0;
1059 int i;
1060
1061 if (!f)
1062 return;
1063 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1064 vector = f->menu_bar_vector;
1065 prefix = Qnil;
1066 i = 0;
1067 while (i < f->menu_bar_items_used)
1068 {
1069 Lisp_Object entry;
1070
1071 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1072 {
1073 subprefix_stack[submenu_depth++] = prefix;
1074 prefix = entry;
1075 i++;
1076 }
1077 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1078 {
1079 prefix = subprefix_stack[--submenu_depth];
1080 i++;
1081 }
1082 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1083 {
1084 prefix
1085 = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1086 i += MENU_ITEMS_PANE_LENGTH;
1087 }
1088 else
1089 {
1090 entry
1091 = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1092 if ((int) client_data == i)
1093 {
1094 int j;
1095 struct input_event buf;
1096
1097 buf.kind = menu_bar_event;
1098 buf.frame_or_window = Qmenu_bar;
1099 kbd_buffer_store_event (&buf);
1100
1101 for (j = 0; j < submenu_depth; j++)
1102 if (!NILP (subprefix_stack[j]))
1103 {
1104 buf.kind = menu_bar_event;
1105 buf.frame_or_window = subprefix_stack[j];
1106 kbd_buffer_store_event (&buf);
1107 }
1108
1109 if (!NILP (prefix))
1110 {
1111 buf.kind = menu_bar_event;
1112 buf.frame_or_window = prefix;
1113 kbd_buffer_store_event (&buf);
1114 }
1115
1116 buf.kind = menu_bar_event;
1117 buf.frame_or_window = entry;
1118 kbd_buffer_store_event (&buf);
1119
1120 return;
1121 }
1122 i += MENU_ITEMS_ITEM_LENGTH;
1123 }
1124 }
1125 }
1126
1127 /* This callback is invoked when a dialog or menu is finished being
1128 used and has been unposted. */
1129
1130 static void
1131 popup_deactivate_callback (widget, id, client_data)
1132 Widget widget;
1133 LWLIB_ID id;
1134 XtPointer client_data;
1135 {
1136 popup_activated_flag = 0;
1137 }
1138
1139
1140 /* This recursively calls free_widget_value on the tree of widgets.
1141 It must free all data that was malloc'ed for these widget_values.
1142 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1143 must be left alone. */
1144
1145 void
1146 free_menubar_widget_value_tree (wv)
1147 widget_value *wv;
1148 {
1149 if (! wv) return;
1150
1151 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1152
1153 if (wv->contents && (wv->contents != (widget_value*)1))
1154 {
1155 free_menubar_widget_value_tree (wv->contents);
1156 wv->contents = (widget_value *) 0xDEADBEEF;
1157 }
1158 if (wv->next)
1159 {
1160 free_menubar_widget_value_tree (wv->next);
1161 wv->next = (widget_value *) 0xDEADBEEF;
1162 }
1163 BLOCK_INPUT;
1164 free_widget_value (wv);
1165 UNBLOCK_INPUT;
1166 }
1167 \f
1168 /* Return a tree of widget_value structures for a menu bar item
1169 whose event type is ITEM_KEY (with string ITEM_NAME)
1170 and whose contents come from the list of keymaps MAPS. */
1171
1172 static widget_value *
1173 single_submenu (item_key, item_name, maps)
1174 Lisp_Object item_key, item_name, maps;
1175 {
1176 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1177 int i;
1178 int submenu_depth = 0;
1179 Lisp_Object length;
1180 int len;
1181 Lisp_Object *mapvec;
1182 widget_value **submenu_stack;
1183 int mapno;
1184 int previous_items = menu_items_used;
1185
1186 length = Flength (maps);
1187 len = XINT (length);
1188
1189 /* Convert the list MAPS into a vector MAPVEC. */
1190 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1191 for (i = 0; i < len; i++)
1192 {
1193 mapvec[i] = Fcar (maps);
1194 maps = Fcdr (maps);
1195 }
1196
1197 menu_items_n_panes = 0;
1198
1199 /* Loop over the given keymaps, making a pane for each map.
1200 But don't make a pane that is empty--ignore that map instead. */
1201 for (i = 0; i < len; i++)
1202 single_keymap_panes (mapvec[i], item_name, item_key, 0);
1203
1204 /* Create a tree of widget_value objects
1205 representing the panes and their items. */
1206
1207 submenu_stack
1208 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1209 wv = malloc_widget_value ();
1210 wv->name = "menu";
1211 wv->value = 0;
1212 wv->enabled = 1;
1213 first_wv = wv;
1214 save_wv = 0;
1215
1216 /* Loop over all panes and items made during this call
1217 and construct a tree of widget_value objects.
1218 Ignore the panes and items made by previous calls to
1219 single_submenu, even though those are also in menu_items. */
1220 i = previous_items;
1221 while (i < menu_items_used)
1222 {
1223 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1224 {
1225 submenu_stack[submenu_depth++] = save_wv;
1226 save_wv = prev_wv;
1227 prev_wv = 0;
1228 i++;
1229 }
1230 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1231 {
1232 prev_wv = save_wv;
1233 save_wv = submenu_stack[--submenu_depth];
1234 i++;
1235 }
1236 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1237 && submenu_depth != 0)
1238 i += MENU_ITEMS_PANE_LENGTH;
1239 /* Ignore a nil in the item list.
1240 It's meaningful only for dialog boxes. */
1241 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1242 i += 1;
1243 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1244 {
1245 /* Create a new pane. */
1246 Lisp_Object pane_name, prefix;
1247 char *pane_string;
1248 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1249 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1250 pane_string = (NILP (pane_name)
1251 ? "" : (char *) XSTRING (pane_name)->data);
1252 /* If there is just one top-level pane, put all its items directly
1253 under the top-level menu. */
1254 if (menu_items_n_panes == 1)
1255 pane_string = "";
1256
1257 /* If the pane has a meaningful name,
1258 make the pane a top-level menu item
1259 with its items as a submenu beneath it. */
1260 if (strcmp (pane_string, ""))
1261 {
1262 wv = malloc_widget_value ();
1263 if (save_wv)
1264 save_wv->next = wv;
1265 else
1266 first_wv->contents = wv;
1267 wv->name = pane_string;
1268 if (!NILP (prefix))
1269 wv->name++;
1270 wv->value = 0;
1271 wv->enabled = 1;
1272 }
1273 save_wv = wv;
1274 prev_wv = 0;
1275 i += MENU_ITEMS_PANE_LENGTH;
1276 }
1277 else
1278 {
1279 /* Create a new item within current pane. */
1280 Lisp_Object item_name, enable, descrip;
1281 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1282 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1283 descrip
1284 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1285
1286 wv = malloc_widget_value ();
1287 if (prev_wv)
1288 prev_wv->next = wv;
1289 else
1290 save_wv->contents = wv;
1291 wv->name = (char *) XSTRING (item_name)->data;
1292 if (!NILP (descrip))
1293 wv->key = (char *) XSTRING (descrip)->data;
1294 wv->value = 0;
1295 wv->call_data = (void *) i;
1296 wv->enabled = !NILP (enable);
1297 prev_wv = wv;
1298
1299 i += MENU_ITEMS_ITEM_LENGTH;
1300 }
1301 }
1302
1303 return first_wv;
1304 }
1305 \f
1306 extern void EmacsFrameSetCharSize ();
1307
1308 /* Recompute the menu bar of frame F. */
1309
1310 static void
1311 update_frame_menubar (f)
1312 FRAME_PTR f;
1313 {
1314 struct x_display *x = f->display.x;
1315 int columns, rows;
1316 int menubar_changed;
1317
1318 Dimension shell_height;
1319
1320 /* We assume the menubar contents has changed if the global flag is set,
1321 or if the current buffer has changed, or if the menubar has never
1322 been updated before.
1323 */
1324 menubar_changed = (x->menubar_widget
1325 && !XtIsManaged (x->menubar_widget));
1326
1327 if (! (menubar_changed))
1328 return;
1329
1330 BLOCK_INPUT;
1331 /* Save the size of the frame because the pane widget doesn't accept to
1332 resize itself. So force it. */
1333 columns = f->width;
1334 rows = f->height;
1335
1336 /* Do the voodoo which means "I'm changing lots of things, don't try to
1337 refigure sizes until I'm done." */
1338 lw_refigure_widget (x->column_widget, False);
1339
1340 /* the order in which children are managed is the top to
1341 bottom order in which they are displayed in the paned window.
1342 First, remove the text-area widget.
1343 */
1344 XtUnmanageChild (x->edit_widget);
1345
1346 /* remove the menubar that is there now, and put up the menubar that
1347 should be there.
1348 */
1349 if (menubar_changed)
1350 {
1351 XtManageChild (x->menubar_widget);
1352 XtMapWidget (x->menubar_widget);
1353 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0);
1354 }
1355
1356 /* Re-manage the text-area widget, and then thrash the sizes. */
1357 XtManageChild (x->edit_widget);
1358 lw_refigure_widget (x->column_widget, True);
1359
1360 /* Force the pane widget to resize itself with the right values. */
1361 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1362
1363 UNBLOCK_INPUT;
1364 }
1365
1366 void
1367 set_frame_menubar (f, first_time)
1368 FRAME_PTR f;
1369 int first_time;
1370 {
1371 Widget menubar_widget = f->display.x->menubar_widget;
1372 int id = (int) f;
1373 Lisp_Object tail, items;
1374 widget_value *wv, *save_wv, *first_wv, *prev_wv = 0;
1375 int i;
1376
1377 BLOCK_INPUT;
1378
1379 wv = malloc_widget_value ();
1380 wv->name = "menubar";
1381 wv->value = 0;
1382 wv->enabled = 1;
1383 save_wv = first_wv = wv;
1384 items = FRAME_MENU_BAR_ITEMS (f);
1385 menu_items = f->menu_bar_vector;
1386 menu_items_allocated = XVECTOR (menu_items)->size;
1387 init_menu_items ();
1388
1389 for (i = 0; i < XVECTOR (items)->size; i += 3)
1390 {
1391 Lisp_Object key, string, maps;
1392
1393 key = XVECTOR (items)->contents[i];
1394 string = XVECTOR (items)->contents[i + 1];
1395 maps = XVECTOR (items)->contents[i + 2];
1396 if (NILP (string))
1397 break;
1398
1399 wv = single_submenu (key, string, maps);
1400 if (prev_wv)
1401 prev_wv->next = wv;
1402 else
1403 save_wv->contents = wv;
1404 wv->name = (char *) XSTRING (string)->data;
1405 wv->enabled = 1;
1406 prev_wv = wv;
1407 }
1408
1409 finish_menu_items ();
1410
1411 f->menu_bar_vector = menu_items;
1412 f->menu_bar_items_used = menu_items_used;
1413 menu_items = Qnil;
1414
1415 if (menubar_widget)
1416 {
1417 /* Disable resizing (done for Motif!) */
1418 lw_allow_resizing (f->display.x->widget, False);
1419
1420 /* The third arg is DEEP_P, which says to consider the entire
1421 menu trees we supply, rather than just the menu bar item names. */
1422 lw_modify_all_widgets (id, first_wv, 1);
1423
1424 /* Re-enable the edit widget to resize. */
1425 lw_allow_resizing (f->display.x->widget, True);
1426 }
1427 else
1428 {
1429 menubar_widget = lw_create_widget ("menubar", "menubar",
1430 id, first_wv,
1431 f->display.x->column_widget,
1432 0,
1433 popup_activate_callback,
1434 menubar_selection_callback,
1435 popup_deactivate_callback);
1436 f->display.x->menubar_widget = menubar_widget;
1437 }
1438
1439 free_menubar_widget_value_tree (first_wv);
1440
1441 /* Don't update the menubar the first time it is created via x_window. */
1442 if (!first_time)
1443 update_frame_menubar (f);
1444
1445 UNBLOCK_INPUT;
1446 }
1447
1448 /* Called from Fx_create_frame to create the inital menubar of a frame
1449 before it is mapped, so that the window is mapped with the menubar already
1450 there instead of us tacking it on later and thrashing the window after it
1451 is visible. */
1452
1453 void
1454 initialize_frame_menubar (f)
1455 FRAME_PTR f;
1456 {
1457 /* This function is called before the first chance to redisplay
1458 the frame. It has to be, so the frame will have the right size. */
1459 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1460 set_frame_menubar (f, 1);
1461 }
1462
1463 /* Get rid of the menu bar of frame F, and free its storage.
1464 This is used when deleting a frame, and when turning off the menu bar. */
1465
1466 void
1467 free_frame_menubar (f)
1468 FRAME_PTR f;
1469 {
1470 Widget menubar_widget;
1471 int id;
1472
1473 menubar_widget = f->display.x->menubar_widget;
1474 id = (int) f;
1475
1476 if (menubar_widget)
1477 {
1478 BLOCK_INPUT;
1479 lw_destroy_all_widgets (id);
1480 UNBLOCK_INPUT;
1481 }
1482 }
1483
1484 #endif /* USE_X_TOOLKIT */
1485 \f
1486 /* xmenu_show actually displays a menu using the panes and items in menu_items
1487 and returns the value selected from it.
1488 There are two versions of xmenu_show, one for Xt and one for Xlib.
1489 Both assume input is blocked by the caller. */
1490
1491 /* F is the frame the menu is for.
1492 X and Y are the frame-relative specified position,
1493 relative to the inside upper left corner of the frame F.
1494 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1495 KEYMAPS is 1 if this menu was specified with keymaps;
1496 in that case, we return a list containing the chosen item's value
1497 and perhaps also the pane's prefix.
1498 TITLE is the specified menu title.
1499 ERROR is a place to store an error message string in case of failure.
1500 (We return nil on failure, but the value doesn't actually matter.) */
1501
1502 #ifdef USE_X_TOOLKIT
1503
1504 extern unsigned int x_mouse_grabbed;
1505
1506 /* We need a unique id for each widget handled by the Lucid Widget
1507 library. This includes the frame main windows, popup menu and
1508 dialog box. */
1509 LWLIB_ID widget_id_tick;
1510
1511 #ifdef __STDC__
1512 static Lisp_Object *volatile menu_item_selection;
1513 #else
1514 static Lisp_Object *menu_item_selection;
1515 #endif
1516
1517 static void
1518 popup_selection_callback (widget, id, client_data)
1519 Widget widget;
1520 LWLIB_ID id;
1521 XtPointer client_data;
1522 {
1523 menu_item_selection = (Lisp_Object *) client_data;
1524 }
1525
1526 static Lisp_Object
1527 xmenu_show (f, x, y, menubarp, keymaps, title, error)
1528 FRAME_PTR f;
1529 int x;
1530 int y;
1531 int menubarp; /* Dummy parameter for Xt version of
1532 xmenu_show() */
1533 int keymaps;
1534 Lisp_Object title;
1535 char **error;
1536 {
1537 int i;
1538 int menu_id;
1539 Widget menu;
1540 Arg av [2];
1541 int ac = 0;
1542 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1543 widget_value **submenu_stack
1544 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1545 Lisp_Object *subprefix_stack
1546 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1547 int submenu_depth = 0;
1548
1549 /* Define a queue to save up for later unreading
1550 all X events that don't pertain to the menu. */
1551 struct event_queue
1552 {
1553 XEvent event;
1554 struct event_queue *next;
1555 };
1556
1557 struct event_queue *queue = NULL;
1558 struct event_queue *queue_tmp;
1559
1560 Position root_x, root_y;
1561
1562 int first_pane;
1563 int next_release_must_exit = 0;
1564
1565 *error = NULL;
1566
1567 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1568 {
1569 *error = "Empty menu";
1570 return Qnil;
1571 }
1572
1573 /* Create a tree of widget_value objects
1574 representing the panes and their items. */
1575 wv = malloc_widget_value ();
1576 wv->name = "menu";
1577 wv->value = 0;
1578 wv->enabled = 1;
1579 first_wv = wv;
1580 first_pane = 1;
1581
1582 /* Loop over all panes and items, filling in the tree. */
1583 i = 0;
1584 while (i < menu_items_used)
1585 {
1586 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1587 {
1588 submenu_stack[submenu_depth++] = save_wv;
1589 save_wv = prev_wv;
1590 prev_wv = 0;
1591 first_pane = 1;
1592 i++;
1593 }
1594 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1595 {
1596 prev_wv = save_wv;
1597 save_wv = submenu_stack[--submenu_depth];
1598 first_pane = 0;
1599 i++;
1600 }
1601 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1602 && submenu_depth != 0)
1603 i += MENU_ITEMS_PANE_LENGTH;
1604 /* Ignore a nil in the item list.
1605 It's meaningful only for dialog boxes. */
1606 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1607 i += 1;
1608 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1609 {
1610 /* Create a new pane. */
1611 Lisp_Object pane_name, prefix;
1612 char *pane_string;
1613 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1614 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1615 pane_string = (NILP (pane_name)
1616 ? "" : (char *) XSTRING (pane_name)->data);
1617 /* If there is just one top-level pane, put all its items directly
1618 under the top-level menu. */
1619 if (menu_items_n_panes == 1)
1620 pane_string = "";
1621
1622 /* If the pane has a meaningful name,
1623 make the pane a top-level menu item
1624 with its items as a submenu beneath it. */
1625 if (!keymaps && strcmp (pane_string, ""))
1626 {
1627 wv = malloc_widget_value ();
1628 if (save_wv)
1629 save_wv->next = wv;
1630 else
1631 first_wv->contents = wv;
1632 wv->name = pane_string;
1633 if (keymaps && !NILP (prefix))
1634 wv->name++;
1635 wv->value = 0;
1636 wv->enabled = 1;
1637 save_wv = wv;
1638 prev_wv = 0;
1639 }
1640 else if (first_pane)
1641 {
1642 save_wv = wv;
1643 prev_wv = 0;
1644 }
1645 first_pane = 0;
1646 i += MENU_ITEMS_PANE_LENGTH;
1647 }
1648 else
1649 {
1650 /* Create a new item within current pane. */
1651 Lisp_Object item_name, enable, descrip;
1652 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1653 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1654 descrip
1655 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1656
1657 wv = malloc_widget_value ();
1658 if (prev_wv)
1659 prev_wv->next = wv;
1660 else
1661 save_wv->contents = wv;
1662 wv->name = (char *) XSTRING (item_name)->data;
1663 if (!NILP (descrip))
1664 wv->key = (char *) XSTRING (descrip)->data;
1665 wv->value = 0;
1666 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1667 wv->enabled = !NILP (enable);
1668 prev_wv = wv;
1669
1670 i += MENU_ITEMS_ITEM_LENGTH;
1671 }
1672 }
1673
1674 /* Deal with the title, if it is non-nil. */
1675 if (!NILP (title))
1676 {
1677 widget_value *wv_title = malloc_widget_value ();
1678 widget_value *wv_sep1 = malloc_widget_value ();
1679 widget_value *wv_sep2 = malloc_widget_value ();
1680
1681 wv_sep2->name = "--";
1682 wv_sep2->next = first_wv->contents;
1683
1684 wv_sep1->name = "--";
1685 wv_sep1->next = wv_sep2;
1686
1687 wv_title->name = (char *) XSTRING (title)->data;
1688 wv_title->enabled = True;
1689 wv_title->next = wv_sep1;
1690 first_wv->contents = wv_title;
1691 }
1692
1693 /* Actually create the menu. */
1694 menu_id = ++widget_id_tick;
1695 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
1696 f->display.x->widget, 1, 0,
1697 popup_selection_callback,
1698 popup_deactivate_callback);
1699
1700 /* Don't allow any geometry request from the user. */
1701 XtSetArg (av[ac], XtNgeometry, 0); ac++;
1702 XtSetValues (menu, av, ac);
1703
1704 /* Free the widget_value objects we used to specify the contents. */
1705 free_menubar_widget_value_tree (first_wv);
1706
1707 /* No selection has been chosen yet. */
1708 menu_item_selection = 0;
1709
1710 /* Display the menu. */
1711 lw_popup_menu (menu);
1712 popup_activated_flag = 1;
1713
1714 /* Process events that apply to the menu. */
1715 popup_get_selection ((XEvent *) 0);
1716
1717 pop_down:
1718 /* fp turned off the following statement and wrote a comment
1719 that it is unnecessary--that the menu has already disappeared.
1720 I observer that is not so. -- rms. */
1721 /* Make sure the menu disappears. */
1722 lw_destroy_all_widgets (menu_id);
1723
1724 /* Unread any events that we got but did not handle. */
1725 while (queue != NULL)
1726 {
1727 queue_tmp = queue;
1728 XPutBackEvent (XDISPLAY &queue_tmp->event);
1729 queue = queue_tmp->next;
1730 free ((char *)queue_tmp);
1731 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1732 interrupt_input_pending = 1;
1733 }
1734
1735 /* Find the selected item, and its pane, to return
1736 the proper value. */
1737 if (menu_item_selection != 0)
1738 {
1739 Lisp_Object prefix;
1740
1741 prefix = Qnil;
1742 i = 0;
1743 while (i < menu_items_used)
1744 {
1745 Lisp_Object entry;
1746
1747 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1748 {
1749 subprefix_stack[submenu_depth++] = prefix;
1750 prefix = entry;
1751 i++;
1752 }
1753 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1754 {
1755 prefix = subprefix_stack[--submenu_depth];
1756 i++;
1757 }
1758 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1759 {
1760 prefix
1761 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1762 i += MENU_ITEMS_PANE_LENGTH;
1763 }
1764 else
1765 {
1766 entry
1767 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1768 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1769 {
1770 if (keymaps != 0)
1771 {
1772 int j;
1773
1774 entry = Fcons (entry, Qnil);
1775 if (!NILP (prefix))
1776 entry = Fcons (prefix, entry);
1777 for (j = submenu_depth - 1; j >= 0; j--)
1778 if (!NILP (subprefix_stack[j]))
1779 entry = Fcons (subprefix_stack[j], entry);
1780 }
1781 return entry;
1782 }
1783 i += MENU_ITEMS_ITEM_LENGTH;
1784 }
1785 }
1786 }
1787
1788 return Qnil;
1789 }
1790 \f
1791 static void
1792 dialog_selection_callback (widget, id, client_data)
1793 Widget widget;
1794 LWLIB_ID id;
1795 XtPointer client_data;
1796 {
1797 if ((int)client_data != -1)
1798 menu_item_selection = (Lisp_Object *) client_data;
1799 BLOCK_INPUT;
1800 lw_destroy_all_widgets (id);
1801 UNBLOCK_INPUT;
1802 }
1803
1804 static char * button_names [] = {
1805 "button1", "button2", "button3", "button4", "button5",
1806 "button6", "button7", "button8", "button9", "button10" };
1807
1808 static Lisp_Object
1809 xdialog_show (f, menubarp, keymaps, title, error)
1810 FRAME_PTR f;
1811 int menubarp;
1812 int keymaps;
1813 Lisp_Object title;
1814 char **error;
1815 {
1816 int i, nb_buttons=0;
1817 int dialog_id;
1818 Widget menu;
1819 char dialog_name[6];
1820
1821 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1822
1823 /* Define a queue to save up for later unreading
1824 all X events that don't pertain to the menu. */
1825 struct event_queue
1826 {
1827 XEvent event;
1828 struct event_queue *next;
1829 };
1830
1831 struct event_queue *queue = NULL;
1832 struct event_queue *queue_tmp;
1833
1834 /* Number of elements seen so far, before boundary. */
1835 int left_count = 0;
1836 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1837 int boundary_seen = 0;
1838
1839 *error = NULL;
1840
1841 if (menu_items_n_panes > 1)
1842 {
1843 *error = "Multiple panes in dialog box";
1844 return Qnil;
1845 }
1846
1847 /* Create a tree of widget_value objects
1848 representing the text label and buttons. */
1849 {
1850 Lisp_Object pane_name, prefix;
1851 char *pane_string;
1852 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1853 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1854 pane_string = (NILP (pane_name)
1855 ? "" : (char *) XSTRING (pane_name)->data);
1856 prev_wv = malloc_widget_value ();
1857 prev_wv->value = pane_string;
1858 if (keymaps && !NILP (prefix))
1859 prev_wv->name++;
1860 prev_wv->enabled = 1;
1861 prev_wv->name = "message";
1862 first_wv = prev_wv;
1863
1864 /* Loop over all panes and items, filling in the tree. */
1865 i = MENU_ITEMS_PANE_LENGTH;
1866 while (i < menu_items_used)
1867 {
1868
1869 /* Create a new item within current pane. */
1870 Lisp_Object item_name, enable, descrip;
1871 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1872 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1873 descrip
1874 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1875
1876 if (NILP (item_name))
1877 {
1878 free_menubar_widget_value_tree (first_wv);
1879 *error = "Submenu in dialog items";
1880 return Qnil;
1881 }
1882 if (EQ (item_name, Qquote))
1883 {
1884 /* This is the boundary between left-side elts
1885 and right-side elts. Stop incrementing right_count. */
1886 boundary_seen = 1;
1887 i++;
1888 continue;
1889 }
1890 if (nb_buttons >= 10)
1891 {
1892 free_menubar_widget_value_tree (first_wv);
1893 *error = "Too many dialog items";
1894 return Qnil;
1895 }
1896
1897 wv = malloc_widget_value ();
1898 prev_wv->next = wv;
1899 wv->name = (char *) button_names[nb_buttons];
1900 if (!NILP (descrip))
1901 wv->key = (char *) XSTRING (descrip)->data;
1902 wv->value = (char *) XSTRING (item_name)->data;
1903 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1904 wv->enabled = !NILP (enable);
1905 prev_wv = wv;
1906
1907 if (! boundary_seen)
1908 left_count++;
1909
1910 nb_buttons++;
1911 i += MENU_ITEMS_ITEM_LENGTH;
1912 }
1913
1914 /* If the boundary was not specified,
1915 by default put half on the left and half on the right. */
1916 if (! boundary_seen)
1917 left_count = nb_buttons - nb_buttons / 2;
1918
1919 wv = malloc_widget_value ();
1920 wv->name = dialog_name;
1921
1922 /* Dialog boxes use a really stupid name encoding
1923 which specifies how many buttons to use
1924 and how many buttons are on the right.
1925 The Q means something also. */
1926 dialog_name[0] = 'Q';
1927 dialog_name[1] = '0' + nb_buttons;
1928 dialog_name[2] = 'B';
1929 dialog_name[3] = 'R';
1930 /* Number of buttons to put on the right. */
1931 dialog_name[4] = '0' + nb_buttons - left_count;
1932 dialog_name[5] = 0;
1933 wv->contents = first_wv;
1934 first_wv = wv;
1935 }
1936
1937 /* Actually create the dialog. */
1938 dialog_id = ++widget_id_tick;
1939 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1940 f->display.x->widget, 1, 0,
1941 dialog_selection_callback, 0);
1942 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1943 /* Free the widget_value objects we used to specify the contents. */
1944 free_menubar_widget_value_tree (first_wv);
1945
1946 /* No selection has been chosen yet. */
1947 menu_item_selection = 0;
1948
1949 /* Display the menu. */
1950 lw_pop_up_all_widgets (dialog_id);
1951
1952 /* Process events that apply to the menu. */
1953 while (1)
1954 {
1955 XEvent event;
1956
1957 XtAppNextEvent (Xt_app_con, &event);
1958 if (event.type == ButtonRelease)
1959 {
1960 XtDispatchEvent (&event);
1961 break;
1962 }
1963 else if (event.type == Expose)
1964 process_expose_from_menu (event);
1965 XtDispatchEvent (&event);
1966 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1967 {
1968 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1969
1970 if (queue_tmp != NULL)
1971 {
1972 queue_tmp->event = event;
1973 queue_tmp->next = queue;
1974 queue = queue_tmp;
1975 }
1976 }
1977 }
1978 pop_down:
1979
1980 /* State that no mouse buttons are now held.
1981 That is not necessarily true, but the fiction leads to reasonable
1982 results, and it is a pain to ask which are actually held now
1983 or track this in the loop above. */
1984 x_mouse_grabbed = 0;
1985
1986 /* Unread any events that we got but did not handle. */
1987 while (queue != NULL)
1988 {
1989 queue_tmp = queue;
1990 XPutBackEvent (XDISPLAY &queue_tmp->event);
1991 queue = queue_tmp->next;
1992 free ((char *)queue_tmp);
1993 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1994 interrupt_input_pending = 1;
1995 }
1996
1997 /* Find the selected item, and its pane, to return
1998 the proper value. */
1999 if (menu_item_selection != 0)
2000 {
2001 Lisp_Object prefix;
2002
2003 prefix = Qnil;
2004 i = 0;
2005 while (i < menu_items_used)
2006 {
2007 Lisp_Object entry;
2008
2009 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2010 {
2011 prefix
2012 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2013 i += MENU_ITEMS_PANE_LENGTH;
2014 }
2015 else
2016 {
2017 entry
2018 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2019 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2020 {
2021 if (keymaps != 0)
2022 {
2023 entry = Fcons (entry, Qnil);
2024 if (!NILP (prefix))
2025 entry = Fcons (prefix, entry);
2026 }
2027 return entry;
2028 }
2029 i += MENU_ITEMS_ITEM_LENGTH;
2030 }
2031 }
2032 }
2033
2034 return Qnil;
2035 }
2036 #else /* not USE_X_TOOLKIT */
2037
2038 static Lisp_Object
2039 xmenu_show (f, x, y, menubarp, keymaps, title, error)
2040 FRAME_PTR f;
2041 int x, y;
2042 int keymaps;
2043 int menubarp;
2044 Lisp_Object title;
2045 char **error;
2046 {
2047 Window root;
2048 XMenu *menu;
2049 int pane, selidx, lpane, status;
2050 Lisp_Object entry, pane_prefix;
2051 char *datap;
2052 int ulx, uly, width, height;
2053 int dispwidth, dispheight;
2054 int i, j;
2055 int maxwidth;
2056 int dummy_int;
2057 unsigned int dummy_uint;
2058
2059 *error = 0;
2060 if (menu_items_n_panes == 0)
2061 return Qnil;
2062
2063 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2064 {
2065 *error = "Empty menu";
2066 return Qnil;
2067 }
2068
2069 /* Figure out which root window F is on. */
2070 XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root,
2071 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
2072 &dummy_uint, &dummy_uint);
2073
2074 /* Make the menu on that window. */
2075 menu = XMenuCreate (XDISPLAY root, "emacs");
2076 if (menu == NULL)
2077 {
2078 *error = "Can't create menu";
2079 return Qnil;
2080 }
2081
2082 /* Adjust coordinates to relative to the outer (window manager) window. */
2083 #ifdef HAVE_X11
2084 {
2085 Window child;
2086 int win_x = 0, win_y = 0;
2087
2088 /* Find the position of the outside upper-left corner of
2089 the inner window, with respect to the outer window. */
2090 if (f->display.x->parent_desc != ROOT_WINDOW)
2091 {
2092 BLOCK_INPUT;
2093 XTranslateCoordinates (x_current_display,
2094
2095 /* From-window, to-window. */
2096 f->display.x->window_desc,
2097 f->display.x->parent_desc,
2098
2099 /* From-position, to-position. */
2100 0, 0, &win_x, &win_y,
2101
2102 /* Child of window. */
2103 &child);
2104 UNBLOCK_INPUT;
2105 x += win_x;
2106 y += win_y;
2107 }
2108 }
2109 #endif /* HAVE_X11 */
2110
2111 /* Adjust coordinates to be root-window-relative. */
2112 x += f->display.x->left_pos;
2113 y += f->display.x->top_pos;
2114
2115 /* Create all the necessary panes and their items. */
2116 i = 0;
2117 while (i < menu_items_used)
2118 {
2119 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2120 {
2121 /* Create a new pane. */
2122 Lisp_Object pane_name, prefix;
2123 char *pane_string;
2124
2125 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
2126 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2127 pane_string = (NILP (pane_name)
2128 ? "" : (char *) XSTRING (pane_name)->data);
2129 if (keymaps && !NILP (prefix))
2130 pane_string++;
2131
2132 lpane = XMenuAddPane (XDISPLAY menu, pane_string, TRUE);
2133 if (lpane == XM_FAILURE)
2134 {
2135 XMenuDestroy (XDISPLAY menu);
2136 *error = "Can't create pane";
2137 return Qnil;
2138 }
2139 i += MENU_ITEMS_PANE_LENGTH;
2140
2141 /* Find the width of the widest item in this pane. */
2142 maxwidth = 0;
2143 j = i;
2144 while (j < menu_items_used)
2145 {
2146 Lisp_Object item;
2147 item = XVECTOR (menu_items)->contents[j];
2148 if (EQ (item, Qt))
2149 break;
2150 if (NILP (item))
2151 {
2152 j++;
2153 continue;
2154 }
2155 width = XSTRING (item)->size;
2156 if (width > maxwidth)
2157 maxwidth = width;
2158
2159 j += MENU_ITEMS_ITEM_LENGTH;
2160 }
2161 }
2162 /* Ignore a nil in the item list.
2163 It's meaningful only for dialog boxes. */
2164 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2165 i += 1;
2166 else
2167 {
2168 /* Create a new item within current pane. */
2169 Lisp_Object item_name, enable, descrip;
2170 unsigned char *item_data;
2171
2172 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2173 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2174 descrip
2175 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2176 if (!NILP (descrip))
2177 {
2178 int gap = maxwidth - XSTRING (item_name)->size;
2179 #ifdef C_ALLOCA
2180 Lisp_Object spacer;
2181 spacer = Fmake_string (make_number (gap), make_number (' '));
2182 item_name = concat2 (item_name, spacer);
2183 item_name = concat2 (item_name, descrip);
2184 item_data = XSTRING (item_name)->data;
2185 #else
2186 /* if alloca is fast, use that to make the space,
2187 to reduce gc needs. */
2188 item_data
2189 = (unsigned char *) alloca (maxwidth
2190 + XSTRING (descrip)->size + 1);
2191 bcopy (XSTRING (item_name)->data, item_data,
2192 XSTRING (item_name)->size);
2193 for (j = XSTRING (item_name)->size; j < maxwidth; j++)
2194 item_data[j] = ' ';
2195 bcopy (XSTRING (descrip)->data, item_data + j,
2196 XSTRING (descrip)->size);
2197 item_data[j + XSTRING (descrip)->size] = 0;
2198 #endif
2199 }
2200 else
2201 item_data = XSTRING (item_name)->data;
2202
2203 if (XMenuAddSelection (XDISPLAY menu, lpane, 0, item_data,
2204 !NILP (enable))
2205 == XM_FAILURE)
2206 {
2207 XMenuDestroy (XDISPLAY menu);
2208 *error = "Can't add selection to menu";
2209 return Qnil;
2210 }
2211 i += MENU_ITEMS_ITEM_LENGTH;
2212 }
2213 }
2214
2215 /* All set and ready to fly. */
2216 XMenuRecompute (XDISPLAY menu);
2217 dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display));
2218 dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display));
2219 x = min (x, dispwidth);
2220 y = min (y, dispheight);
2221 x = max (x, 1);
2222 y = max (y, 1);
2223 XMenuLocate (XDISPLAY menu, 0, 0, x, y,
2224 &ulx, &uly, &width, &height);
2225 if (ulx+width > dispwidth)
2226 {
2227 x -= (ulx + width) - dispwidth;
2228 ulx = dispwidth - width;
2229 }
2230 if (uly+height > dispheight)
2231 {
2232 y -= (uly + height) - dispheight;
2233 uly = dispheight - height;
2234 }
2235 if (ulx < 0) x -= ulx;
2236 if (uly < 0) y -= uly;
2237
2238 XMenuSetAEQ (menu, TRUE);
2239 XMenuSetFreeze (menu, TRUE);
2240 pane = selidx = 0;
2241
2242 status = XMenuActivate (XDISPLAY menu, &pane, &selidx,
2243 x, y, ButtonReleaseMask, &datap);
2244 switch (status)
2245 {
2246 case XM_SUCCESS:
2247 #ifdef XDEBUG
2248 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
2249 #endif
2250
2251 /* Find the item number SELIDX in pane number PANE. */
2252 i = 0;
2253 while (i < menu_items_used)
2254 {
2255 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2256 {
2257 if (pane == 0)
2258 pane_prefix
2259 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2260 pane--;
2261 i += MENU_ITEMS_PANE_LENGTH;
2262 }
2263 else
2264 {
2265 if (pane == -1)
2266 {
2267 if (selidx == 0)
2268 {
2269 entry
2270 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2271 if (keymaps != 0)
2272 {
2273 entry = Fcons (entry, Qnil);
2274 if (!NILP (pane_prefix))
2275 entry = Fcons (pane_prefix, entry);
2276 }
2277 break;
2278 }
2279 selidx--;
2280 }
2281 i += MENU_ITEMS_ITEM_LENGTH;
2282 }
2283 }
2284 break;
2285
2286 case XM_FAILURE:
2287 *error = "Can't activate menu";
2288 case XM_IA_SELECT:
2289 case XM_NO_SELECT:
2290 entry = Qnil;
2291 break;
2292 }
2293 XMenuDestroy (XDISPLAY menu);
2294
2295 /* State that no mouse buttons are now held.
2296 (The oldXMenu code doesn't track this info for us.)
2297 That is not necessarily true, but the fiction leads to reasonable
2298 results, and it is a pain to ask which are actually held now. */
2299 x_mouse_grabbed = 0;
2300
2301 return entry;
2302 }
2303
2304 #endif /* not USE_X_TOOLKIT */
2305 \f
2306 syms_of_xmenu ()
2307 {
2308 staticpro (&menu_items);
2309 menu_items = Qnil;
2310
2311 #ifdef USE_X_TOOLKIT
2312 widget_id_tick = (1<<16);
2313 #endif
2314
2315 defsubr (&Sx_popup_menu);
2316 defsubr (&Sx_popup_dialog);
2317 }