]> code.delx.au - gnu-emacs/blob - src/xmenu.c
Merged from miles@gnu.org--gnu-2005 (patch 469)
[gnu-emacs] / src / xmenu.c
1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1999, 2000, 2001, 2003, 2004,
3 2005 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
21
22 /* X pop-up deck-of-cards menu facility for GNU Emacs.
23 *
24 * Written by Jon Arnold and Roman Budzianowski
25 * Mods and rewrite by Robert Krawitz
26 *
27 */
28
29 /* Modified by Fred Pierresteguy on December 93
30 to make the popup menus and menubar use the Xt. */
31
32 /* Rewritten for clarity and GC protection by rms in Feb 94. */
33
34 #include <config.h>
35
36 #if 0 /* Why was this included? And without syssignal.h? */
37 /* On 4.3 this loses if it comes after xterm.h. */
38 #include <signal.h>
39 #endif
40
41 #include <stdio.h>
42
43 #include "lisp.h"
44 #include "keyboard.h"
45 #include "keymap.h"
46 #include "frame.h"
47 #include "termhooks.h"
48 #include "window.h"
49 #include "blockinput.h"
50 #include "buffer.h"
51 #include "charset.h"
52 #include "coding.h"
53 #include "sysselect.h"
54
55 #ifdef MSDOS
56 #include "msdos.h"
57 #endif
58
59 #ifdef HAVE_X_WINDOWS
60 /* This may include sys/types.h, and that somehow loses
61 if this is not done before the other system files. */
62 #include "xterm.h"
63 #endif
64
65 /* Load sys/types.h if not already loaded.
66 In some systems loading it twice is suicidal. */
67 #ifndef makedev
68 #include <sys/types.h>
69 #endif
70
71 #include "dispextern.h"
72
73 #ifdef HAVE_X_WINDOWS
74 /* Defining HAVE_MULTILINGUAL_MENU would mean that the toolkit menu
75 code accepts the Emacs internal encoding. */
76 #undef HAVE_MULTILINGUAL_MENU
77 #ifdef USE_X_TOOLKIT
78 #include "widget.h"
79 #include <X11/Xlib.h>
80 #include <X11/IntrinsicP.h>
81 #include <X11/CoreP.h>
82 #include <X11/StringDefs.h>
83 #include <X11/Shell.h>
84 #ifdef USE_LUCID
85 #include <X11/Xaw/Paned.h>
86 #endif /* USE_LUCID */
87 #include "../lwlib/lwlib.h"
88 #else /* not USE_X_TOOLKIT */
89 #ifndef USE_GTK
90 #include "../oldXMenu/XMenu.h"
91 #endif
92 #endif /* not USE_X_TOOLKIT */
93 #endif /* HAVE_X_WINDOWS */
94
95 #ifndef TRUE
96 #define TRUE 1
97 #define FALSE 0
98 #endif /* no TRUE */
99
100 Lisp_Object Vmenu_updating_frame;
101
102 Lisp_Object Qdebug_on_next_call;
103
104 extern Lisp_Object Qmenu_bar;
105
106 extern Lisp_Object QCtoggle, QCradio;
107
108 extern Lisp_Object Voverriding_local_map;
109 extern Lisp_Object Voverriding_local_map_menu_flag;
110
111 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
112
113 extern Lisp_Object Qmenu_bar_update_hook;
114
115 #ifdef USE_X_TOOLKIT
116 extern void set_frame_menubar P_ ((FRAME_PTR, int, int));
117 extern XtAppContext Xt_app_con;
118
119 static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, Lisp_Object,
120 char **));
121 static void popup_get_selection P_ ((XEvent *, struct x_display_info *,
122 LWLIB_ID, int));
123
124 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
125
126 #define HAVE_BOXES 1
127 #endif /* USE_X_TOOLKIT */
128
129 #ifdef USE_GTK
130 #include "gtkutil.h"
131 #define HAVE_BOXES 1
132 extern void set_frame_menubar P_ ((FRAME_PTR, int, int));
133 static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, Lisp_Object,
134 char **));
135 #endif
136
137 /* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU
138 isn't defined. The use of HAVE_MULTILINGUAL_MENU could probably be
139 confined to an extended version of this with sections of code below
140 using it unconditionally. */
141 #ifdef USE_GTK
142 /* gtk just uses utf-8. */
143 # define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
144 #elif defined HAVE_X_I18N
145 # define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
146 #else
147 # define ENCODE_MENU_STRING(str) string_make_unibyte (str)
148 #endif
149
150 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
151 Lisp_Object, Lisp_Object, Lisp_Object,
152 Lisp_Object, Lisp_Object));
153 static int update_frame_menubar P_ ((struct frame *));
154 static Lisp_Object xmenu_show P_ ((struct frame *, int, int, int, int,
155 Lisp_Object, char **));
156 static void keymap_panes P_ ((Lisp_Object *, int, int));
157 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
158 int, int));
159 static void list_of_panes P_ ((Lisp_Object));
160 static void list_of_items P_ ((Lisp_Object));
161
162 \f
163 /* This holds a Lisp vector that holds the results of decoding
164 the keymaps or alist-of-alists that specify a menu.
165
166 It describes the panes and items within the panes.
167
168 Each pane is described by 3 elements in the vector:
169 t, the pane name, the pane's prefix key.
170 Then follow the pane's items, with 5 elements per item:
171 the item string, the enable flag, the item's value,
172 the definition, and the equivalent keyboard key's description string.
173
174 In some cases, multiple levels of menus may be described.
175 A single vector slot containing nil indicates the start of a submenu.
176 A single vector slot containing lambda indicates the end of a submenu.
177 The submenu follows a menu item which is the way to reach the submenu.
178
179 A single vector slot containing quote indicates that the
180 following items should appear on the right of a dialog box.
181
182 Using a Lisp vector to hold this information while we decode it
183 takes care of protecting all the data from GC. */
184
185 #define MENU_ITEMS_PANE_NAME 1
186 #define MENU_ITEMS_PANE_PREFIX 2
187 #define MENU_ITEMS_PANE_LENGTH 3
188
189 enum menu_item_idx
190 {
191 MENU_ITEMS_ITEM_NAME = 0,
192 MENU_ITEMS_ITEM_ENABLE,
193 MENU_ITEMS_ITEM_VALUE,
194 MENU_ITEMS_ITEM_EQUIV_KEY,
195 MENU_ITEMS_ITEM_DEFINITION,
196 MENU_ITEMS_ITEM_TYPE,
197 MENU_ITEMS_ITEM_SELECTED,
198 MENU_ITEMS_ITEM_HELP,
199 MENU_ITEMS_ITEM_LENGTH
200 };
201
202 static Lisp_Object menu_items;
203
204 /* If non-nil, means that the global vars defined here are already in use.
205 Used to detect cases where we try to re-enter this non-reentrant code. */
206 static Lisp_Object menu_items_inuse;
207
208 /* Number of slots currently allocated in menu_items. */
209 static int menu_items_allocated;
210
211 /* This is the index in menu_items of the first empty slot. */
212 static int menu_items_used;
213
214 /* The number of panes currently recorded in menu_items,
215 excluding those within submenus. */
216 static int menu_items_n_panes;
217
218 /* Current depth within submenus. */
219 static int menu_items_submenu_depth;
220
221 /* Flag which when set indicates a dialog or menu has been posted by
222 Xt on behalf of one of the widget sets. */
223 static int popup_activated_flag;
224
225 static int next_menubar_widget_id;
226
227 /* This is set nonzero after the user activates the menu bar, and set
228 to zero again after the menu bars are redisplayed by prepare_menu_bar.
229 While it is nonzero, all calls to set_frame_menubar go deep.
230
231 I don't understand why this is needed, but it does seem to be
232 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
233
234 int pending_menu_activation;
235 \f
236 #ifdef USE_X_TOOLKIT
237
238 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
239
240 static struct frame *
241 menubar_id_to_frame (id)
242 LWLIB_ID id;
243 {
244 Lisp_Object tail, frame;
245 FRAME_PTR f;
246
247 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
248 {
249 frame = XCAR (tail);
250 if (!GC_FRAMEP (frame))
251 continue;
252 f = XFRAME (frame);
253 if (!FRAME_WINDOW_P (f))
254 continue;
255 if (f->output_data.x->id == id)
256 return f;
257 }
258 return 0;
259 }
260
261 #endif
262 \f
263 /* Initialize the menu_items structure if we haven't already done so.
264 Also mark it as currently empty. */
265
266 static void
267 init_menu_items ()
268 {
269 if (NILP (menu_items))
270 {
271 menu_items_allocated = 60;
272 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
273 }
274
275 if (!NILP (menu_items_inuse))
276 error ("Trying to use a menu from within a menu-entry");
277 menu_items_inuse = Qt;
278 menu_items_used = 0;
279 menu_items_n_panes = 0;
280 menu_items_submenu_depth = 0;
281 }
282
283 /* Call at the end of generating the data in menu_items. */
284
285 static void
286 finish_menu_items ()
287 {
288 }
289
290 static Lisp_Object
291 unuse_menu_items (dummy)
292 Lisp_Object dummy;
293 {
294 return menu_items_inuse = Qnil;
295 }
296
297 /* Call when finished using the data for the current menu
298 in menu_items. */
299
300 static void
301 discard_menu_items ()
302 {
303 /* Free the structure if it is especially large.
304 Otherwise, hold on to it, to save time. */
305 if (menu_items_allocated > 200)
306 {
307 menu_items = Qnil;
308 menu_items_allocated = 0;
309 }
310 xassert (NILP (menu_items_inuse));
311 }
312
313 /* Make the menu_items vector twice as large. */
314
315 static void
316 grow_menu_items ()
317 {
318 Lisp_Object old;
319 int old_size = menu_items_allocated;
320 old = menu_items;
321
322 menu_items_allocated *= 2;
323 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
324 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
325 old_size * sizeof (Lisp_Object));
326 }
327
328 /* Begin a submenu. */
329
330 static void
331 push_submenu_start ()
332 {
333 if (menu_items_used + 1 > menu_items_allocated)
334 grow_menu_items ();
335
336 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
337 menu_items_submenu_depth++;
338 }
339
340 /* End a submenu. */
341
342 static void
343 push_submenu_end ()
344 {
345 if (menu_items_used + 1 > menu_items_allocated)
346 grow_menu_items ();
347
348 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
349 menu_items_submenu_depth--;
350 }
351
352 /* Indicate boundary between left and right. */
353
354 static void
355 push_left_right_boundary ()
356 {
357 if (menu_items_used + 1 > menu_items_allocated)
358 grow_menu_items ();
359
360 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
361 }
362
363 /* Start a new menu pane in menu_items.
364 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
365
366 static void
367 push_menu_pane (name, prefix_vec)
368 Lisp_Object name, prefix_vec;
369 {
370 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
371 grow_menu_items ();
372
373 if (menu_items_submenu_depth == 0)
374 menu_items_n_panes++;
375 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
376 XVECTOR (menu_items)->contents[menu_items_used++] = name;
377 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
378 }
379
380 /* Push one menu item into the current pane. NAME is the string to
381 display. ENABLE if non-nil means this item can be selected. KEY
382 is the key generated by choosing this item, or nil if this item
383 doesn't really have a definition. DEF is the definition of this
384 item. EQUIV is the textual description of the keyboard equivalent
385 for this item (or nil if none). TYPE is the type of this menu
386 item, one of nil, `toggle' or `radio'. */
387
388 static void
389 push_menu_item (name, enable, key, def, equiv, type, selected, help)
390 Lisp_Object name, enable, key, def, equiv, type, selected, help;
391 {
392 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
393 grow_menu_items ();
394
395 XVECTOR (menu_items)->contents[menu_items_used++] = name;
396 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
397 XVECTOR (menu_items)->contents[menu_items_used++] = key;
398 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
399 XVECTOR (menu_items)->contents[menu_items_used++] = def;
400 XVECTOR (menu_items)->contents[menu_items_used++] = type;
401 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
402 XVECTOR (menu_items)->contents[menu_items_used++] = help;
403 }
404 \f
405 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
406 and generate menu panes for them in menu_items.
407 If NOTREAL is nonzero,
408 don't bother really computing whether an item is enabled. */
409
410 static void
411 keymap_panes (keymaps, nmaps, notreal)
412 Lisp_Object *keymaps;
413 int nmaps;
414 int notreal;
415 {
416 int mapno;
417
418 init_menu_items ();
419
420 /* Loop over the given keymaps, making a pane for each map.
421 But don't make a pane that is empty--ignore that map instead.
422 P is the number of panes we have made so far. */
423 for (mapno = 0; mapno < nmaps; mapno++)
424 single_keymap_panes (keymaps[mapno],
425 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
426
427 finish_menu_items ();
428 }
429
430 /* Args passed between single_keymap_panes and single_menu_item. */
431 struct skp
432 {
433 Lisp_Object pending_maps;
434 int maxdepth, notreal;
435 int notbuttons;
436 };
437
438 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
439 void *));
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, only check for equivalent key bindings, don't
446 evaluate expressions in menu items and don't make any menu.
447
448 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
449
450 static void
451 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
452 Lisp_Object keymap;
453 Lisp_Object pane_name;
454 Lisp_Object prefix;
455 int notreal;
456 int maxdepth;
457 {
458 struct skp skp;
459 struct gcpro gcpro1;
460
461 skp.pending_maps = Qnil;
462 skp.maxdepth = maxdepth;
463 skp.notreal = notreal;
464 skp.notbuttons = 0;
465
466 if (maxdepth <= 0)
467 return;
468
469 push_menu_pane (pane_name, prefix);
470
471 #ifndef HAVE_BOXES
472 /* Remember index for first item in this pane so we can go back and
473 add a prefix when (if) we see the first button. After that, notbuttons
474 is set to 0, to mark that we have seen a button and all non button
475 items need a prefix. */
476 skp.notbuttons = menu_items_used;
477 #endif
478
479 GCPRO1 (skp.pending_maps);
480 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
481 UNGCPRO;
482
483 /* Process now any submenus which want to be panes at this level. */
484 while (CONSP (skp.pending_maps))
485 {
486 Lisp_Object elt, eltcdr, string;
487 elt = XCAR (skp.pending_maps);
488 eltcdr = XCDR (elt);
489 string = XCAR (eltcdr);
490 /* We no longer discard the @ from the beginning of the string here.
491 Instead, we do this in xmenu_show. */
492 single_keymap_panes (Fcar (elt), string,
493 XCDR (eltcdr), notreal, maxdepth - 1);
494 skp.pending_maps = XCDR (skp.pending_maps);
495 }
496 }
497 \f
498 /* This is a subroutine of single_keymap_panes that handles one
499 keymap entry.
500 KEY is a key in a keymap and ITEM is its binding.
501 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
502 separate panes.
503 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
504 evaluate expressions in menu items and don't make any menu.
505 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them.
506 SKP->NOTBUTTONS is only used when simulating toggle boxes and radio
507 buttons. It keeps track of if we have seen a button in this menu or
508 not. */
509
510 static void
511 single_menu_item (key, item, dummy, skp_v)
512 Lisp_Object key, item, dummy;
513 void *skp_v;
514 {
515 Lisp_Object map, item_string, enabled;
516 struct gcpro gcpro1, gcpro2;
517 int res;
518 struct skp *skp = skp_v;
519
520 /* Parse the menu item and leave the result in item_properties. */
521 GCPRO2 (key, item);
522 res = parse_menu_item (item, skp->notreal, 0);
523 UNGCPRO;
524 if (!res)
525 return; /* Not a menu item. */
526
527 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
528
529 if (skp->notreal)
530 {
531 /* We don't want to make a menu, just traverse the keymaps to
532 precompute equivalent key bindings. */
533 if (!NILP (map))
534 single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
535 return;
536 }
537
538 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
539 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
540
541 if (!NILP (map) && SREF (item_string, 0) == '@')
542 {
543 if (!NILP (enabled))
544 /* An enabled separate pane. Remember this to handle it later. */
545 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
546 skp->pending_maps);
547 return;
548 }
549
550 #ifndef HAVE_BOXES
551 /* Simulate radio buttons and toggle boxes by putting a prefix in
552 front of them. */
553 {
554 Lisp_Object prefix = Qnil;
555 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
556 if (!NILP (type))
557 {
558 Lisp_Object selected
559 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
560
561 if (skp->notbuttons)
562 /* The first button. Line up previous items in this menu. */
563 {
564 int index = skp->notbuttons; /* Index for first item this menu. */
565 int submenu = 0;
566 Lisp_Object tem;
567 while (index < menu_items_used)
568 {
569 tem
570 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
571 if (NILP (tem))
572 {
573 index++;
574 submenu++; /* Skip sub menu. */
575 }
576 else if (EQ (tem, Qlambda))
577 {
578 index++;
579 submenu--; /* End sub menu. */
580 }
581 else if (EQ (tem, Qt))
582 index += 3; /* Skip new pane marker. */
583 else if (EQ (tem, Qquote))
584 index++; /* Skip a left, right divider. */
585 else
586 {
587 if (!submenu && SREF (tem, 0) != '\0'
588 && SREF (tem, 0) != '-')
589 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
590 = concat2 (build_string (" "), tem);
591 index += MENU_ITEMS_ITEM_LENGTH;
592 }
593 }
594 skp->notbuttons = 0;
595 }
596
597 /* Calculate prefix, if any, for this item. */
598 if (EQ (type, QCtoggle))
599 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
600 else if (EQ (type, QCradio))
601 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
602 }
603 /* Not a button. If we have earlier buttons, then we need a prefix. */
604 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
605 && SREF (item_string, 0) != '-')
606 prefix = build_string (" ");
607
608 if (!NILP (prefix))
609 item_string = concat2 (prefix, item_string);
610 }
611 #endif /* not HAVE_BOXES */
612
613 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
614 if (!NILP (map))
615 /* Indicate visually that this is a submenu. */
616 item_string = concat2 (item_string, build_string (" >"));
617 #endif
618
619 push_menu_item (item_string, enabled, key,
620 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
621 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
622 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
623 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
624 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
625
626 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
627 /* Display a submenu using the toolkit. */
628 if (! (NILP (map) || NILP (enabled)))
629 {
630 push_submenu_start ();
631 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
632 push_submenu_end ();
633 }
634 #endif
635 }
636 \f
637 /* Push all the panes and items of a menu described by the
638 alist-of-alists MENU.
639 This handles old-fashioned calls to x-popup-menu. */
640
641 static void
642 list_of_panes (menu)
643 Lisp_Object menu;
644 {
645 Lisp_Object tail;
646
647 init_menu_items ();
648
649 for (tail = menu; CONSP (tail); tail = XCDR (tail))
650 {
651 Lisp_Object elt, pane_name, pane_data;
652 elt = XCAR (tail);
653 pane_name = Fcar (elt);
654 CHECK_STRING (pane_name);
655 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
656 pane_data = Fcdr (elt);
657 CHECK_CONS (pane_data);
658 list_of_items (pane_data);
659 }
660
661 finish_menu_items ();
662 }
663
664 /* Push the items in a single pane defined by the alist PANE. */
665
666 static void
667 list_of_items (pane)
668 Lisp_Object pane;
669 {
670 Lisp_Object tail, item, item1;
671
672 for (tail = pane; CONSP (tail); tail = XCDR (tail))
673 {
674 item = XCAR (tail);
675 if (STRINGP (item))
676 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
677 Qnil, Qnil, Qnil, Qnil);
678 else if (CONSP (item))
679 {
680 item1 = XCAR (item);
681 CHECK_STRING (item1);
682 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
683 Qt, Qnil, Qnil, Qnil, Qnil);
684 }
685 else
686 push_left_right_boundary ();
687
688 }
689 }
690 \f
691 #ifdef HAVE_X_WINDOWS
692 /* Return the mouse position in *X and *Y. The coordinates are window
693 relative for the edit window in frame F.
694 This is for Fx_popup_menu. The mouse_position_hook can not
695 be used for X, as it returns window relative coordinates
696 for the window where the mouse is in. This could be the menu bar,
697 the scroll bar or the edit window. Fx_popup_menu needs to be
698 sure it is the edit window. */
699 static void
700 mouse_position_for_popup (f, x, y)
701 FRAME_PTR f;
702 int *x;
703 int *y;
704 {
705 Window root, dummy_window;
706 int dummy;
707
708 BLOCK_INPUT;
709
710 XQueryPointer (FRAME_X_DISPLAY (f),
711 DefaultRootWindow (FRAME_X_DISPLAY (f)),
712
713 /* The root window which contains the pointer. */
714 &root,
715
716 /* Window pointer is on, not used */
717 &dummy_window,
718
719 /* The position on that root window. */
720 x, y,
721
722 /* x/y in dummy_window coordinates, not used. */
723 &dummy, &dummy,
724
725 /* Modifier keys and pointer buttons, about which
726 we don't care. */
727 (unsigned int *) &dummy);
728
729 UNBLOCK_INPUT;
730
731 /* xmenu_show expects window coordinates, not root window
732 coordinates. Translate. */
733 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
734 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
735 }
736
737 #endif /* HAVE_X_WINDOWS */
738
739 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
740 doc: /* Pop up a deck-of-cards menu and return user's selection.
741 POSITION is a position specification. This is either a mouse button event
742 or a list ((XOFFSET YOFFSET) WINDOW)
743 where XOFFSET and YOFFSET are positions in pixels from the top left
744 corner of WINDOW. (WINDOW may be a window or a frame object.)
745 This controls the position of the top left of the menu as a whole.
746 If POSITION is t, it means to use the current mouse position.
747
748 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
749 The menu items come from key bindings that have a menu string as well as
750 a definition; actually, the "definition" in such a key binding looks like
751 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
752 the keymap as a top-level element.
753
754 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
755 Otherwise, REAL-DEFINITION should be a valid key binding definition.
756
757 You can also use a list of keymaps as MENU.
758 Then each keymap makes a separate pane.
759
760 When MENU is a keymap or a list of keymaps, the return value is the
761 list of events corresponding to the user's choice. Note that
762 `x-popup-menu' does not actually execute the command bound to that
763 sequence of events.
764
765 Alternatively, you can specify a menu of multiple panes
766 with a list of the form (TITLE PANE1 PANE2...),
767 where each pane is a list of form (TITLE ITEM1 ITEM2...).
768 Each ITEM is normally a cons cell (STRING . VALUE);
769 but a string can appear as an item--that makes a nonselectable line
770 in the menu.
771 With this form of menu, the return value is VALUE from the chosen item.
772
773 If POSITION is nil, don't display the menu at all, just precalculate the
774 cached information about equivalent key sequences.
775
776 If the user gets rid of the menu without making a valid choice, for
777 instance by clicking the mouse away from a valid choice or by typing
778 keyboard input, then this normally results in a quit and
779 `x-popup-menu' does not return. But if POSITION is a mouse button
780 event (indicating that the user invoked the menu with the mouse) then
781 no quit occurs and `x-popup-menu' returns nil. */)
782 (position, menu)
783 Lisp_Object position, menu;
784 {
785 Lisp_Object keymap, tem;
786 int xpos = 0, ypos = 0;
787 Lisp_Object title;
788 char *error_name = NULL;
789 Lisp_Object selection;
790 FRAME_PTR f = NULL;
791 Lisp_Object x, y, window;
792 int keymaps = 0;
793 int for_click = 0;
794 int specpdl_count = SPECPDL_INDEX ();
795 struct gcpro gcpro1;
796
797 #ifdef HAVE_MENUS
798 if (! NILP (position))
799 {
800 int get_current_pos_p = 0;
801 check_x ();
802
803 /* Decode the first argument: find the window and the coordinates. */
804 if (EQ (position, Qt)
805 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
806 || EQ (XCAR (position), Qtool_bar))))
807 {
808 get_current_pos_p = 1;
809 }
810 else
811 {
812 tem = Fcar (position);
813 if (CONSP (tem))
814 {
815 window = Fcar (Fcdr (position));
816 x = XCAR (tem);
817 y = Fcar (XCDR (tem));
818 }
819 else
820 {
821 for_click = 1;
822 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
823 window = Fcar (tem); /* POSN_WINDOW (tem) */
824 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
825 x = Fcar (tem);
826 y = Fcdr (tem);
827 }
828
829 /* If a click happens in an external tool bar or a detached
830 tool bar, x and y is NIL. In that case, use the current
831 mouse position. This happens for the help button in the
832 tool bar. Ideally popup-menu should pass NIL to
833 this function, but it doesn't. */
834 if (NILP (x) && NILP (y))
835 get_current_pos_p = 1;
836 }
837
838 if (get_current_pos_p)
839 {
840 /* Use the mouse's current position. */
841 FRAME_PTR new_f = SELECTED_FRAME ();
842 #ifdef HAVE_X_WINDOWS
843 /* Can't use mouse_position_hook for X since it returns
844 coordinates relative to the window the mouse is in,
845 we need coordinates relative to the edit widget always. */
846 if (new_f != 0)
847 {
848 int cur_x, cur_y;
849
850 mouse_position_for_popup (new_f, &cur_x, &cur_y);
851 /* cur_x/y may be negative, so use make_number. */
852 x = make_number (cur_x);
853 y = make_number (cur_y);
854 }
855
856 #else /* not HAVE_X_WINDOWS */
857 Lisp_Object bar_window;
858 enum scroll_bar_part part;
859 unsigned long time;
860
861 if (mouse_position_hook)
862 (*mouse_position_hook) (&new_f, 1, &bar_window,
863 &part, &x, &y, &time);
864 #endif /* not HAVE_X_WINDOWS */
865
866 if (new_f != 0)
867 XSETFRAME (window, new_f);
868 else
869 {
870 window = selected_window;
871 XSETFASTINT (x, 0);
872 XSETFASTINT (y, 0);
873 }
874 }
875
876 CHECK_NUMBER (x);
877 CHECK_NUMBER (y);
878
879 /* Decode where to put the menu. */
880
881 if (FRAMEP (window))
882 {
883 f = XFRAME (window);
884 xpos = 0;
885 ypos = 0;
886 }
887 else if (WINDOWP (window))
888 {
889 CHECK_LIVE_WINDOW (window);
890 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
891
892 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
893 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
894 }
895 else
896 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
897 but I don't want to make one now. */
898 CHECK_WINDOW (window);
899
900 xpos += XINT (x);
901 ypos += XINT (y);
902 }
903 Vmenu_updating_frame = Qnil;
904 #endif /* HAVE_MENUS */
905
906 record_unwind_protect (unuse_menu_items, Qnil);
907 title = Qnil;
908 GCPRO1 (title);
909
910 /* Decode the menu items from what was specified. */
911
912 keymap = get_keymap (menu, 0, 0);
913 if (CONSP (keymap))
914 {
915 /* We were given a keymap. Extract menu info from the keymap. */
916 Lisp_Object prompt;
917
918 /* Extract the detailed info to make one pane. */
919 keymap_panes (&menu, 1, NILP (position));
920
921 /* Search for a string appearing directly as an element of the keymap.
922 That string is the title of the menu. */
923 prompt = Fkeymap_prompt (keymap);
924 if (NILP (title) && !NILP (prompt))
925 title = prompt;
926
927 /* Make that be the pane title of the first pane. */
928 if (!NILP (prompt) && menu_items_n_panes >= 0)
929 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
930
931 keymaps = 1;
932 }
933 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
934 {
935 /* We were given a list of keymaps. */
936 int nmaps = XFASTINT (Flength (menu));
937 Lisp_Object *maps
938 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
939 int i;
940
941 title = Qnil;
942
943 /* The first keymap that has a prompt string
944 supplies the menu title. */
945 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
946 {
947 Lisp_Object prompt;
948
949 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
950
951 prompt = Fkeymap_prompt (keymap);
952 if (NILP (title) && !NILP (prompt))
953 title = prompt;
954 }
955
956 /* Extract the detailed info to make one pane. */
957 keymap_panes (maps, nmaps, NILP (position));
958
959 /* Make the title be the pane title of the first pane. */
960 if (!NILP (title) && menu_items_n_panes >= 0)
961 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
962
963 keymaps = 1;
964 }
965 else
966 {
967 /* We were given an old-fashioned menu. */
968 title = Fcar (menu);
969 CHECK_STRING (title);
970
971 list_of_panes (Fcdr (menu));
972
973 keymaps = 0;
974 }
975
976 unbind_to (specpdl_count, Qnil);
977
978 if (NILP (position))
979 {
980 discard_menu_items ();
981 UNGCPRO;
982 return Qnil;
983 }
984
985 #ifdef HAVE_MENUS
986 /* Display them in a menu. */
987 BLOCK_INPUT;
988
989 selection = xmenu_show (f, xpos, ypos, for_click,
990 keymaps, title, &error_name);
991 UNBLOCK_INPUT;
992
993 discard_menu_items ();
994
995 UNGCPRO;
996 #endif /* HAVE_MENUS */
997
998 if (error_name) error (error_name);
999 return selection;
1000 }
1001
1002 #ifdef HAVE_MENUS
1003
1004 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
1005 doc: /* Pop up a dialog box and return user's selection.
1006 POSITION specifies which frame to use.
1007 This is normally a mouse button event or a window or frame.
1008 If POSITION is t, it means to use the frame the mouse is on.
1009 The dialog box appears in the middle of the specified frame.
1010
1011 CONTENTS specifies the alternatives to display in the dialog box.
1012 It is a list of the form (DIALOG ITEM1 ITEM2...).
1013 Each ITEM is a cons cell (STRING . VALUE).
1014 The return value is VALUE from the chosen item.
1015
1016 An ITEM may also be just a string--that makes a nonselectable item.
1017 An ITEM may also be nil--that means to put all preceding items
1018 on the left of the dialog box and all following items on the right.
1019 \(By default, approximately half appear on each side.)
1020
1021 If HEADER is non-nil, the frame title for the box is "Information",
1022 otherwise it is "Question".
1023
1024 If the user gets rid of the dialog box without making a valid choice,
1025 for instance using the window manager, then this produces a quit and
1026 `x-popup-dialog' does not return. */)
1027 (position, contents, header)
1028 Lisp_Object position, contents, header;
1029 {
1030 FRAME_PTR f = NULL;
1031 Lisp_Object window;
1032
1033 check_x ();
1034
1035 /* Decode the first argument: find the window or frame to use. */
1036 if (EQ (position, Qt)
1037 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1038 || EQ (XCAR (position), Qtool_bar))))
1039 {
1040 #if 0 /* Using the frame the mouse is on may not be right. */
1041 /* Use the mouse's current position. */
1042 FRAME_PTR new_f = SELECTED_FRAME ();
1043 Lisp_Object bar_window;
1044 enum scroll_bar_part part;
1045 unsigned long time;
1046 Lisp_Object x, y;
1047
1048 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1049
1050 if (new_f != 0)
1051 XSETFRAME (window, new_f);
1052 else
1053 window = selected_window;
1054 #endif
1055 window = selected_window;
1056 }
1057 else if (CONSP (position))
1058 {
1059 Lisp_Object tem;
1060 tem = Fcar (position);
1061 if (CONSP (tem))
1062 window = Fcar (Fcdr (position));
1063 else
1064 {
1065 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1066 window = Fcar (tem); /* POSN_WINDOW (tem) */
1067 }
1068 }
1069 else if (WINDOWP (position) || FRAMEP (position))
1070 window = position;
1071 else
1072 window = Qnil;
1073
1074 /* Decode where to put the menu. */
1075
1076 if (FRAMEP (window))
1077 f = XFRAME (window);
1078 else if (WINDOWP (window))
1079 {
1080 CHECK_LIVE_WINDOW (window);
1081 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1082 }
1083 else
1084 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1085 but I don't want to make one now. */
1086 CHECK_WINDOW (window);
1087
1088 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
1089 /* Display a menu with these alternatives
1090 in the middle of frame F. */
1091 {
1092 Lisp_Object x, y, frame, newpos;
1093 XSETFRAME (frame, f);
1094 XSETINT (x, x_pixel_width (f) / 2);
1095 XSETINT (y, x_pixel_height (f) / 2);
1096 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1097
1098 return Fx_popup_menu (newpos,
1099 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1100 }
1101 #else
1102 {
1103 Lisp_Object title;
1104 char *error_name;
1105 Lisp_Object selection;
1106 int specpdl_count = SPECPDL_INDEX ();
1107
1108 /* Decode the dialog items from what was specified. */
1109 title = Fcar (contents);
1110 CHECK_STRING (title);
1111 record_unwind_protect (unuse_menu_items, Qnil);
1112
1113 if (NILP (Fcar (Fcdr (contents))))
1114 /* No buttons specified, add an "Ok" button so users can pop down
1115 the dialog. Also, the lesstif/motif version crashes if there are
1116 no buttons. */
1117 contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil));
1118
1119 list_of_panes (Fcons (contents, Qnil));
1120
1121 /* Display them in a dialog box. */
1122 BLOCK_INPUT;
1123 selection = xdialog_show (f, 0, title, header, &error_name);
1124 UNBLOCK_INPUT;
1125
1126 unbind_to (specpdl_count, Qnil);
1127 discard_menu_items ();
1128
1129 if (error_name) error (error_name);
1130 return selection;
1131 }
1132 #endif
1133 }
1134
1135
1136 #ifndef MSDOS
1137
1138 /* Set menu_items_inuse so no other popup menu or dialog is created. */
1139
1140 void
1141 x_menu_set_in_use (in_use)
1142 int in_use;
1143 {
1144 menu_items_inuse = in_use ? Qt : Qnil;
1145 popup_activated_flag = in_use;
1146 }
1147
1148 /* Wait for an X event to arrive or for a timer to expire. */
1149
1150 void
1151 x_menu_wait_for_event (void *data)
1152 {
1153 extern EMACS_TIME timer_check P_ ((int));
1154
1155 /* Another way to do this is to register a timer callback, that can be
1156 done in GTK and Xt. But we have to do it like this when using only X
1157 anyway, and with callbacks we would have three variants for timer handling
1158 instead of the small ifdefs below. */
1159
1160 while (
1161 #ifdef USE_X_TOOLKIT
1162 ! XtAppPending (Xt_app_con)
1163 #elif defined USE_GTK
1164 ! gtk_events_pending ()
1165 #else
1166 ! XPending ((Display*) data)
1167 #endif
1168 )
1169 {
1170 EMACS_TIME next_time = timer_check (1);
1171 long secs = EMACS_SECS (next_time);
1172 long usecs = EMACS_USECS (next_time);
1173 SELECT_TYPE read_fds;
1174 struct x_display_info *dpyinfo;
1175 int n = 0;
1176
1177 FD_ZERO (&read_fds);
1178 for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
1179 {
1180 int fd = ConnectionNumber (dpyinfo->display);
1181 FD_SET (fd, &read_fds);
1182 if (fd > n) n = fd;
1183 }
1184
1185 if (secs < 0 || (secs == 0 && usecs == 0))
1186 {
1187 /* Sometimes timer_check returns -1 (no timers) even if there are
1188 timers. So do a timeout anyway. */
1189 EMACS_SET_SECS (next_time, 1);
1190 EMACS_SET_USECS (next_time, 0);
1191 }
1192
1193 select (n + 1, &read_fds, (SELECT_TYPE *)0, (SELECT_TYPE *)0, &next_time);
1194 }
1195 }
1196 #endif /* ! MSDOS */
1197
1198 \f
1199 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1200
1201 #ifdef USE_X_TOOLKIT
1202
1203 /* Loop in Xt until the menu pulldown or dialog popup has been
1204 popped down (deactivated). This is used for x-popup-menu
1205 and x-popup-dialog; it is not used for the menu bar.
1206
1207 NOTE: All calls to popup_get_selection should be protected
1208 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1209
1210 static void
1211 popup_get_selection (initial_event, dpyinfo, id, do_timers)
1212 XEvent *initial_event;
1213 struct x_display_info *dpyinfo;
1214 LWLIB_ID id;
1215 int do_timers;
1216 {
1217 XEvent event;
1218
1219 while (popup_activated_flag)
1220 {
1221 if (initial_event)
1222 {
1223 event = *initial_event;
1224 initial_event = 0;
1225 }
1226 else
1227 {
1228 if (do_timers) x_menu_wait_for_event (0);
1229 XtAppNextEvent (Xt_app_con, &event);
1230 }
1231
1232 /* Make sure we don't consider buttons grabbed after menu goes.
1233 And make sure to deactivate for any ButtonRelease,
1234 even if XtDispatchEvent doesn't do that. */
1235 if (event.type == ButtonRelease
1236 && dpyinfo->display == event.xbutton.display)
1237 {
1238 dpyinfo->grabbed &= ~(1 << event.xbutton.button);
1239 #ifdef USE_MOTIF /* Pretending that the event came from a
1240 Btn1Down seems the only way to convince Motif to
1241 activate its callbacks; setting the XmNmenuPost
1242 isn't working. --marcus@sysc.pdx.edu. */
1243 event.xbutton.button = 1;
1244 /* Motif only pops down menus when no Ctrl, Alt or Mod
1245 key is pressed and the button is released. So reset key state
1246 so Motif thinks this is the case. */
1247 event.xbutton.state = 0;
1248 #endif
1249 }
1250 /* Pop down on C-g and Escape. */
1251 else if (event.type == KeyPress
1252 && dpyinfo->display == event.xbutton.display)
1253 {
1254 KeySym keysym = XLookupKeysym (&event.xkey, 0);
1255
1256 if ((keysym == XK_g && (event.xkey.state & ControlMask) != 0)
1257 || keysym == XK_Escape) /* Any escape, ignore modifiers. */
1258 popup_activated_flag = 0;
1259 }
1260
1261 x_dispatch_event (&event, event.xany.display);
1262 }
1263 }
1264
1265 #endif /* USE_X_TOOLKIT */
1266
1267 #ifdef USE_GTK
1268 /* Loop util popup_activated_flag is set to zero in a callback.
1269 Used for popup menus and dialogs. */
1270
1271 static void
1272 popup_widget_loop (do_timers, widget)
1273 int do_timers;
1274 GtkWidget *widget;
1275 {
1276 ++popup_activated_flag;
1277
1278 /* Process events in the Gtk event loop until done. */
1279 while (popup_activated_flag)
1280 {
1281 if (do_timers) x_menu_wait_for_event (0);
1282 gtk_main_iteration ();
1283 }
1284 }
1285 #endif
1286
1287 /* Activate the menu bar of frame F.
1288 This is called from keyboard.c when it gets the
1289 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1290
1291 To activate the menu bar, we use the X button-press event
1292 that was saved in saved_menu_event.
1293 That makes the toolkit do its thing.
1294
1295 But first we recompute the menu bar contents (the whole tree).
1296
1297 The reason for saving the button event until here, instead of
1298 passing it to the toolkit right away, is that we can safely
1299 execute Lisp code. */
1300
1301 void
1302 x_activate_menubar (f)
1303 FRAME_PTR f;
1304 {
1305 if (!f->output_data.x->saved_menu_event->type)
1306 return;
1307
1308 #ifdef USE_GTK
1309 if (! xg_win_to_widget (FRAME_X_DISPLAY (f),
1310 f->output_data.x->saved_menu_event->xany.window))
1311 return;
1312 #endif
1313
1314 set_frame_menubar (f, 0, 1);
1315 BLOCK_INPUT;
1316 #ifdef USE_GTK
1317 XPutBackEvent (f->output_data.x->display_info->display,
1318 f->output_data.x->saved_menu_event);
1319 popup_activated_flag = 1;
1320 #else
1321 XtDispatchEvent (f->output_data.x->saved_menu_event);
1322 #endif
1323 UNBLOCK_INPUT;
1324 #ifdef USE_MOTIF
1325 if (f->output_data.x->saved_menu_event->type == ButtonRelease)
1326 pending_menu_activation = 1;
1327 #endif
1328
1329 /* Ignore this if we get it a second time. */
1330 f->output_data.x->saved_menu_event->type = 0;
1331 }
1332
1333 /* Detect if a dialog or menu has been posted. */
1334
1335 int
1336 popup_activated ()
1337 {
1338 return popup_activated_flag;
1339 }
1340
1341 /* This callback is invoked when the user selects a menubar cascade
1342 pushbutton, but before the pulldown menu is posted. */
1343
1344 #ifndef USE_GTK
1345 static void
1346 popup_activate_callback (widget, id, client_data)
1347 Widget widget;
1348 LWLIB_ID id;
1349 XtPointer client_data;
1350 {
1351 popup_activated_flag = 1;
1352 }
1353 #endif
1354
1355 /* This callback is invoked when a dialog or menu is finished being
1356 used and has been unposted. */
1357
1358 #ifdef USE_GTK
1359 static void
1360 popup_deactivate_callback (widget, client_data)
1361 GtkWidget *widget;
1362 gpointer client_data;
1363 {
1364 popup_activated_flag = 0;
1365 }
1366 #else
1367 static void
1368 popup_deactivate_callback (widget, id, client_data)
1369 Widget widget;
1370 LWLIB_ID id;
1371 XtPointer client_data;
1372 {
1373 popup_activated_flag = 0;
1374 }
1375 #endif
1376
1377
1378 /* Function that finds the frame for WIDGET and shows the HELP text
1379 for that widget.
1380 F is the frame if known, or NULL if not known. */
1381 static void
1382 show_help_event (f, widget, help)
1383 FRAME_PTR f;
1384 xt_or_gtk_widget widget;
1385 Lisp_Object help;
1386 {
1387 Lisp_Object frame;
1388
1389 if (f)
1390 {
1391 XSETFRAME (frame, f);
1392 kbd_buffer_store_help_event (frame, help);
1393 }
1394 else
1395 {
1396 #if 0 /* This code doesn't do anything useful. ++kfs */
1397 /* WIDGET is the popup menu. It's parent is the frame's
1398 widget. See which frame that is. */
1399 xt_or_gtk_widget frame_widget = XtParent (widget);
1400 Lisp_Object tail;
1401
1402 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
1403 {
1404 frame = XCAR (tail);
1405 if (GC_FRAMEP (frame)
1406 && (f = XFRAME (frame),
1407 FRAME_X_P (f) && f->output_data.x->widget == frame_widget))
1408 break;
1409 }
1410 #endif
1411 show_help_echo (help, Qnil, Qnil, Qnil, 1);
1412 }
1413 }
1414
1415 /* Callback called when menu items are highlighted/unhighlighted
1416 while moving the mouse over them. WIDGET is the menu bar or menu
1417 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1418 the data structure for the menu item, or null in case of
1419 unhighlighting. */
1420
1421 #ifdef USE_GTK
1422 void
1423 menu_highlight_callback (widget, call_data)
1424 GtkWidget *widget;
1425 gpointer call_data;
1426 {
1427 xg_menu_item_cb_data *cb_data;
1428 Lisp_Object help;
1429
1430 cb_data = (xg_menu_item_cb_data*) g_object_get_data (G_OBJECT (widget),
1431 XG_ITEM_DATA);
1432 if (! cb_data) return;
1433
1434 help = call_data ? cb_data->help : Qnil;
1435
1436 /* If popup_activated_flag is greater than 1 we are in a popup menu.
1437 Don't show help for them, they won't appear before the
1438 popup is popped down. */
1439 if (popup_activated_flag <= 1)
1440 show_help_event (cb_data->cl_data->f, widget, help);
1441 }
1442 #else
1443 void
1444 menu_highlight_callback (widget, id, call_data)
1445 Widget widget;
1446 LWLIB_ID id;
1447 void *call_data;
1448 {
1449 struct frame *f;
1450 Lisp_Object help;
1451
1452 widget_value *wv = (widget_value *) call_data;
1453
1454 help = wv ? wv->help : Qnil;
1455
1456 /* Determine the frame for the help event. */
1457 f = menubar_id_to_frame (id);
1458
1459 show_help_event (f, widget, help);
1460 }
1461 #endif
1462
1463 /* Find the menu selection and store it in the keyboard buffer.
1464 F is the frame the menu is on.
1465 MENU_BAR_ITEMS_USED is the length of VECTOR.
1466 VECTOR is an array of menu events for the whole menu. */
1467
1468 static void
1469 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
1470 FRAME_PTR f;
1471 int menu_bar_items_used;
1472 Lisp_Object vector;
1473 void *client_data;
1474 {
1475 Lisp_Object prefix, entry;
1476 Lisp_Object *subprefix_stack;
1477 int submenu_depth = 0;
1478 int i;
1479
1480 entry = Qnil;
1481 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
1482 prefix = Qnil;
1483 i = 0;
1484
1485 while (i < menu_bar_items_used)
1486 {
1487 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1488 {
1489 subprefix_stack[submenu_depth++] = prefix;
1490 prefix = entry;
1491 i++;
1492 }
1493 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1494 {
1495 prefix = subprefix_stack[--submenu_depth];
1496 i++;
1497 }
1498 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1499 {
1500 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1501 i += MENU_ITEMS_PANE_LENGTH;
1502 }
1503 else
1504 {
1505 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1506 /* The EMACS_INT cast avoids a warning. There's no problem
1507 as long as pointers have enough bits to hold small integers. */
1508 if ((int) (EMACS_INT) client_data == i)
1509 {
1510 int j;
1511 struct input_event buf;
1512 Lisp_Object frame;
1513 EVENT_INIT (buf);
1514
1515 XSETFRAME (frame, f);
1516 buf.kind = MENU_BAR_EVENT;
1517 buf.frame_or_window = frame;
1518 buf.arg = frame;
1519 kbd_buffer_store_event (&buf);
1520
1521 for (j = 0; j < submenu_depth; j++)
1522 if (!NILP (subprefix_stack[j]))
1523 {
1524 buf.kind = MENU_BAR_EVENT;
1525 buf.frame_or_window = frame;
1526 buf.arg = subprefix_stack[j];
1527 kbd_buffer_store_event (&buf);
1528 }
1529
1530 if (!NILP (prefix))
1531 {
1532 buf.kind = MENU_BAR_EVENT;
1533 buf.frame_or_window = frame;
1534 buf.arg = prefix;
1535 kbd_buffer_store_event (&buf);
1536 }
1537
1538 buf.kind = MENU_BAR_EVENT;
1539 buf.frame_or_window = frame;
1540 buf.arg = entry;
1541 kbd_buffer_store_event (&buf);
1542
1543 return;
1544 }
1545 i += MENU_ITEMS_ITEM_LENGTH;
1546 }
1547 }
1548 }
1549
1550
1551 #ifdef USE_GTK
1552 /* Gtk calls callbacks just because we tell it what item should be
1553 selected in a radio group. If this variable is set to a non-zero
1554 value, we are creating menus and don't want callbacks right now.
1555 */
1556 static int xg_crazy_callback_abort;
1557
1558 /* This callback is called from the menu bar pulldown menu
1559 when the user makes a selection.
1560 Figure out what the user chose
1561 and put the appropriate events into the keyboard buffer. */
1562 static void
1563 menubar_selection_callback (widget, client_data)
1564 GtkWidget *widget;
1565 gpointer client_data;
1566 {
1567 xg_menu_item_cb_data *cb_data = (xg_menu_item_cb_data*) client_data;
1568
1569 if (xg_crazy_callback_abort)
1570 return;
1571
1572 if (! cb_data || ! cb_data->cl_data || ! cb_data->cl_data->f)
1573 return;
1574
1575 /* When a menu is popped down, X generates a focus event (i.e. focus
1576 goes back to the frame below the menu). Since GTK buffers events,
1577 we force it out here before the menu selection event. Otherwise
1578 sit-for will exit at once if the focus event follows the menu selection
1579 event. */
1580
1581 BLOCK_INPUT;
1582 while (gtk_events_pending ())
1583 gtk_main_iteration ();
1584 UNBLOCK_INPUT;
1585
1586 find_and_call_menu_selection (cb_data->cl_data->f,
1587 cb_data->cl_data->menu_bar_items_used,
1588 cb_data->cl_data->menu_bar_vector,
1589 cb_data->call_data);
1590 }
1591
1592 #else /* not USE_GTK */
1593
1594 /* This callback is called from the menu bar pulldown menu
1595 when the user makes a selection.
1596 Figure out what the user chose
1597 and put the appropriate events into the keyboard buffer. */
1598 static void
1599 menubar_selection_callback (widget, id, client_data)
1600 Widget widget;
1601 LWLIB_ID id;
1602 XtPointer client_data;
1603 {
1604 FRAME_PTR f;
1605
1606 f = menubar_id_to_frame (id);
1607 if (!f)
1608 return;
1609 find_and_call_menu_selection (f, f->menu_bar_items_used,
1610 f->menu_bar_vector, client_data);
1611 }
1612 #endif /* not USE_GTK */
1613
1614 /* Allocate a widget_value, blocking input. */
1615
1616 widget_value *
1617 xmalloc_widget_value ()
1618 {
1619 widget_value *value;
1620
1621 BLOCK_INPUT;
1622 value = malloc_widget_value ();
1623 UNBLOCK_INPUT;
1624
1625 return value;
1626 }
1627
1628 /* This recursively calls free_widget_value on the tree of widgets.
1629 It must free all data that was malloc'ed for these widget_values.
1630 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1631 must be left alone. */
1632
1633 void
1634 free_menubar_widget_value_tree (wv)
1635 widget_value *wv;
1636 {
1637 if (! wv) return;
1638
1639 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1640
1641 if (wv->contents && (wv->contents != (widget_value*)1))
1642 {
1643 free_menubar_widget_value_tree (wv->contents);
1644 wv->contents = (widget_value *) 0xDEADBEEF;
1645 }
1646 if (wv->next)
1647 {
1648 free_menubar_widget_value_tree (wv->next);
1649 wv->next = (widget_value *) 0xDEADBEEF;
1650 }
1651 BLOCK_INPUT;
1652 free_widget_value (wv);
1653 UNBLOCK_INPUT;
1654 }
1655 \f
1656 /* Set up data in menu_items for a menu bar item
1657 whose event type is ITEM_KEY (with string ITEM_NAME)
1658 and whose contents come from the list of keymaps MAPS. */
1659
1660 static int
1661 parse_single_submenu (item_key, item_name, maps)
1662 Lisp_Object item_key, item_name, maps;
1663 {
1664 Lisp_Object length;
1665 int len;
1666 Lisp_Object *mapvec;
1667 int i;
1668 int top_level_items = 0;
1669
1670 length = Flength (maps);
1671 len = XINT (length);
1672
1673 /* Convert the list MAPS into a vector MAPVEC. */
1674 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1675 for (i = 0; i < len; i++)
1676 {
1677 mapvec[i] = Fcar (maps);
1678 maps = Fcdr (maps);
1679 }
1680
1681 /* Loop over the given keymaps, making a pane for each map.
1682 But don't make a pane that is empty--ignore that map instead. */
1683 for (i = 0; i < len; i++)
1684 {
1685 if (!KEYMAPP (mapvec[i]))
1686 {
1687 /* Here we have a command at top level in the menu bar
1688 as opposed to a submenu. */
1689 top_level_items = 1;
1690 push_menu_pane (Qnil, Qnil);
1691 push_menu_item (item_name, Qt, item_key, mapvec[i],
1692 Qnil, Qnil, Qnil, Qnil);
1693 }
1694 else
1695 {
1696 Lisp_Object prompt;
1697 prompt = Fkeymap_prompt (mapvec[i]);
1698 single_keymap_panes (mapvec[i],
1699 !NILP (prompt) ? prompt : item_name,
1700 item_key, 0, 10);
1701 }
1702 }
1703
1704 return top_level_items;
1705 }
1706
1707 /* Create a tree of widget_value objects
1708 representing the panes and items
1709 in menu_items starting at index START, up to index END. */
1710
1711 static widget_value *
1712 digest_single_submenu (start, end, top_level_items)
1713 int start, end, top_level_items;
1714 {
1715 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1716 int i;
1717 int submenu_depth = 0;
1718 widget_value **submenu_stack;
1719
1720 submenu_stack
1721 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1722 wv = xmalloc_widget_value ();
1723 wv->name = "menu";
1724 wv->value = 0;
1725 wv->enabled = 1;
1726 wv->button_type = BUTTON_TYPE_NONE;
1727 wv->help = Qnil;
1728 first_wv = wv;
1729 save_wv = 0;
1730 prev_wv = 0;
1731
1732 /* Loop over all panes and items made by the preceding call
1733 to parse_single_submenu and construct a tree of widget_value objects.
1734 Ignore the panes and items used by previous calls to
1735 digest_single_submenu, even though those are also in menu_items. */
1736 i = start;
1737 while (i < end)
1738 {
1739 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1740 {
1741 submenu_stack[submenu_depth++] = save_wv;
1742 save_wv = prev_wv;
1743 prev_wv = 0;
1744 i++;
1745 }
1746 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1747 {
1748 prev_wv = save_wv;
1749 save_wv = submenu_stack[--submenu_depth];
1750 i++;
1751 }
1752 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1753 && submenu_depth != 0)
1754 i += MENU_ITEMS_PANE_LENGTH;
1755 /* Ignore a nil in the item list.
1756 It's meaningful only for dialog boxes. */
1757 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1758 i += 1;
1759 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1760 {
1761 /* Create a new pane. */
1762 Lisp_Object pane_name, prefix;
1763 char *pane_string;
1764
1765 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1766 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1767
1768 #ifndef HAVE_MULTILINGUAL_MENU
1769 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1770 {
1771 pane_name = ENCODE_MENU_STRING (pane_name);
1772 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1773 }
1774 #endif
1775 pane_string = (NILP (pane_name)
1776 ? "" : (char *) SDATA (pane_name));
1777 /* If there is just one top-level pane, put all its items directly
1778 under the top-level menu. */
1779 if (menu_items_n_panes == 1)
1780 pane_string = "";
1781
1782 /* If the pane has a meaningful name,
1783 make the pane a top-level menu item
1784 with its items as a submenu beneath it. */
1785 if (strcmp (pane_string, ""))
1786 {
1787 wv = xmalloc_widget_value ();
1788 if (save_wv)
1789 save_wv->next = wv;
1790 else
1791 first_wv->contents = wv;
1792 wv->lname = pane_name;
1793 /* Set value to 1 so update_submenu_strings can handle '@' */
1794 wv->value = (char *)1;
1795 wv->enabled = 1;
1796 wv->button_type = BUTTON_TYPE_NONE;
1797 wv->help = Qnil;
1798 }
1799 save_wv = wv;
1800 prev_wv = 0;
1801 i += MENU_ITEMS_PANE_LENGTH;
1802 }
1803 else
1804 {
1805 /* Create a new item within current pane. */
1806 Lisp_Object item_name, enable, descrip, def, type, selected;
1807 Lisp_Object help;
1808
1809 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1810 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1811 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1812 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1813 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1814 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1815 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1816
1817 #ifndef HAVE_MULTILINGUAL_MENU
1818 if (STRING_MULTIBYTE (item_name))
1819 {
1820 item_name = ENCODE_MENU_STRING (item_name);
1821 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1822 }
1823
1824 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1825 {
1826 descrip = ENCODE_MENU_STRING (descrip);
1827 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1828 }
1829 #endif /* not HAVE_MULTILINGUAL_MENU */
1830
1831 wv = xmalloc_widget_value ();
1832 if (prev_wv)
1833 prev_wv->next = wv;
1834 else
1835 save_wv->contents = wv;
1836
1837 wv->lname = item_name;
1838 if (!NILP (descrip))
1839 wv->lkey = descrip;
1840 wv->value = 0;
1841 /* The EMACS_INT cast avoids a warning. There's no problem
1842 as long as pointers have enough bits to hold small integers. */
1843 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1844 wv->enabled = !NILP (enable);
1845
1846 if (NILP (type))
1847 wv->button_type = BUTTON_TYPE_NONE;
1848 else if (EQ (type, QCradio))
1849 wv->button_type = BUTTON_TYPE_RADIO;
1850 else if (EQ (type, QCtoggle))
1851 wv->button_type = BUTTON_TYPE_TOGGLE;
1852 else
1853 abort ();
1854
1855 wv->selected = !NILP (selected);
1856 if (! STRINGP (help))
1857 help = Qnil;
1858
1859 wv->help = help;
1860
1861 prev_wv = wv;
1862
1863 i += MENU_ITEMS_ITEM_LENGTH;
1864 }
1865 }
1866
1867 /* If we have just one "menu item"
1868 that was originally a button, return it by itself. */
1869 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1870 {
1871 wv = first_wv->contents;
1872 free_widget_value (first_wv);
1873 return wv;
1874 }
1875
1876 return first_wv;
1877 }
1878
1879 /* Walk through the widget_value tree starting at FIRST_WV and update
1880 the char * pointers from the corresponding lisp values.
1881 We do this after building the whole tree, since GC may happen while the
1882 tree is constructed, and small strings are relocated. So we must wait
1883 until no GC can happen before storing pointers into lisp values. */
1884 static void
1885 update_submenu_strings (first_wv)
1886 widget_value *first_wv;
1887 {
1888 widget_value *wv;
1889
1890 for (wv = first_wv; wv; wv = wv->next)
1891 {
1892 if (STRINGP (wv->lname))
1893 {
1894 wv->name = SDATA (wv->lname);
1895
1896 /* Ignore the @ that means "separate pane".
1897 This is a kludge, but this isn't worth more time. */
1898 if (wv->value == (char *)1)
1899 {
1900 if (wv->name[0] == '@')
1901 wv->name++;
1902 wv->value = 0;
1903 }
1904 }
1905
1906 if (STRINGP (wv->lkey))
1907 wv->key = SDATA (wv->lkey);
1908
1909 if (wv->contents)
1910 update_submenu_strings (wv->contents);
1911 }
1912 }
1913
1914 \f
1915 /* Recompute all the widgets of frame F, when the menu bar has been
1916 changed. Value is non-zero if widgets were updated. */
1917
1918 static int
1919 update_frame_menubar (f)
1920 FRAME_PTR f;
1921 {
1922 #ifdef USE_GTK
1923 return xg_update_frame_menubar (f);
1924 #else
1925 struct x_output *x = f->output_data.x;
1926 int columns, rows;
1927
1928 if (!x->menubar_widget || XtIsManaged (x->menubar_widget))
1929 return 0;
1930
1931 BLOCK_INPUT;
1932 /* Save the size of the frame because the pane widget doesn't accept
1933 to resize itself. So force it. */
1934 columns = FRAME_COLS (f);
1935 rows = FRAME_LINES (f);
1936
1937 /* Do the voodoo which means "I'm changing lots of things, don't try
1938 to refigure sizes until I'm done." */
1939 lw_refigure_widget (x->column_widget, False);
1940
1941 /* The order in which children are managed is the top to bottom
1942 order in which they are displayed in the paned window. First,
1943 remove the text-area widget. */
1944 XtUnmanageChild (x->edit_widget);
1945
1946 /* Remove the menubar that is there now, and put up the menubar that
1947 should be there. */
1948 XtManageChild (x->menubar_widget);
1949 XtMapWidget (x->menubar_widget);
1950 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, NULL);
1951
1952 /* Re-manage the text-area widget, and then thrash the sizes. */
1953 XtManageChild (x->edit_widget);
1954 lw_refigure_widget (x->column_widget, True);
1955
1956 /* Force the pane widget to resize itself with the right values. */
1957 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1958 UNBLOCK_INPUT;
1959 #endif
1960 return 1;
1961 }
1962
1963 /* Set the contents of the menubar widgets of frame F.
1964 The argument FIRST_TIME is currently ignored;
1965 it is set the first time this is called, from initialize_frame_menubar. */
1966
1967 void
1968 set_frame_menubar (f, first_time, deep_p)
1969 FRAME_PTR f;
1970 int first_time;
1971 int deep_p;
1972 {
1973 xt_or_gtk_widget menubar_widget = f->output_data.x->menubar_widget;
1974 #ifdef USE_X_TOOLKIT
1975 LWLIB_ID id;
1976 #endif
1977 Lisp_Object items;
1978 widget_value *wv, *first_wv, *prev_wv = 0;
1979 int i, last_i = 0;
1980 int *submenu_start, *submenu_end;
1981 int *submenu_top_level_items, *submenu_n_panes;
1982
1983
1984 XSETFRAME (Vmenu_updating_frame, f);
1985
1986 #ifdef USE_X_TOOLKIT
1987 if (f->output_data.x->id == 0)
1988 f->output_data.x->id = next_menubar_widget_id++;
1989 id = f->output_data.x->id;
1990 #endif
1991
1992 if (! menubar_widget)
1993 deep_p = 1;
1994 else if (pending_menu_activation && !deep_p)
1995 deep_p = 1;
1996 /* Make the first call for any given frame always go deep. */
1997 else if (!f->output_data.x->saved_menu_event && !deep_p)
1998 {
1999 deep_p = 1;
2000 f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent));
2001 f->output_data.x->saved_menu_event->type = 0;
2002 }
2003
2004 #ifdef USE_GTK
2005 /* If we have detached menus, we must update deep so detached menus
2006 also gets updated. */
2007 deep_p = deep_p || xg_have_tear_offs ();
2008 #endif
2009
2010 if (deep_p)
2011 {
2012 /* Make a widget-value tree representing the entire menu trees. */
2013
2014 struct buffer *prev = current_buffer;
2015 Lisp_Object buffer;
2016 int specpdl_count = SPECPDL_INDEX ();
2017 int previous_menu_items_used = f->menu_bar_items_used;
2018 Lisp_Object *previous_items
2019 = (Lisp_Object *) alloca (previous_menu_items_used
2020 * sizeof (Lisp_Object));
2021
2022 /* If we are making a new widget, its contents are empty,
2023 do always reinitialize them. */
2024 if (! menubar_widget)
2025 previous_menu_items_used = 0;
2026
2027 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
2028 specbind (Qinhibit_quit, Qt);
2029 /* Don't let the debugger step into this code
2030 because it is not reentrant. */
2031 specbind (Qdebug_on_next_call, Qnil);
2032
2033 record_unwind_save_match_data ();
2034 record_unwind_protect (unuse_menu_items, Qnil);
2035 if (NILP (Voverriding_local_map_menu_flag))
2036 {
2037 specbind (Qoverriding_terminal_local_map, Qnil);
2038 specbind (Qoverriding_local_map, Qnil);
2039 }
2040
2041 set_buffer_internal_1 (XBUFFER (buffer));
2042
2043 /* Run the Lucid hook. */
2044 safe_run_hooks (Qactivate_menubar_hook);
2045
2046 /* If it has changed current-menubar from previous value,
2047 really recompute the menubar from the value. */
2048 if (! NILP (Vlucid_menu_bar_dirty_flag))
2049 call0 (Qrecompute_lucid_menubar);
2050 safe_run_hooks (Qmenu_bar_update_hook);
2051 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
2052
2053 items = FRAME_MENU_BAR_ITEMS (f);
2054
2055 /* Save the frame's previous menu bar contents data. */
2056 if (previous_menu_items_used)
2057 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
2058 previous_menu_items_used * sizeof (Lisp_Object));
2059
2060 /* Fill in menu_items with the current menu bar contents.
2061 This can evaluate Lisp code. */
2062 menu_items = f->menu_bar_vector;
2063 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
2064 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
2065 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
2066 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
2067 submenu_top_level_items
2068 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
2069 init_menu_items ();
2070 for (i = 0; i < XVECTOR (items)->size; i += 4)
2071 {
2072 Lisp_Object key, string, maps;
2073
2074 last_i = i;
2075
2076 key = XVECTOR (items)->contents[i];
2077 string = XVECTOR (items)->contents[i + 1];
2078 maps = XVECTOR (items)->contents[i + 2];
2079 if (NILP (string))
2080 break;
2081
2082 submenu_start[i] = menu_items_used;
2083
2084 menu_items_n_panes = 0;
2085 submenu_top_level_items[i]
2086 = parse_single_submenu (key, string, maps);
2087 submenu_n_panes[i] = menu_items_n_panes;
2088
2089 submenu_end[i] = menu_items_used;
2090 }
2091
2092 finish_menu_items ();
2093
2094 /* Convert menu_items into widget_value trees
2095 to display the menu. This cannot evaluate Lisp code. */
2096
2097 wv = xmalloc_widget_value ();
2098 wv->name = "menubar";
2099 wv->value = 0;
2100 wv->enabled = 1;
2101 wv->button_type = BUTTON_TYPE_NONE;
2102 wv->help = Qnil;
2103 first_wv = wv;
2104
2105 for (i = 0; i < last_i; i += 4)
2106 {
2107 menu_items_n_panes = submenu_n_panes[i];
2108 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
2109 submenu_top_level_items[i]);
2110 if (prev_wv)
2111 prev_wv->next = wv;
2112 else
2113 first_wv->contents = wv;
2114 /* Don't set wv->name here; GC during the loop might relocate it. */
2115 wv->enabled = 1;
2116 wv->button_type = BUTTON_TYPE_NONE;
2117 prev_wv = wv;
2118 }
2119
2120 set_buffer_internal_1 (prev);
2121 unbind_to (specpdl_count, Qnil);
2122
2123 /* If there has been no change in the Lisp-level contents
2124 of the menu bar, skip redisplaying it. Just exit. */
2125
2126 for (i = 0; i < previous_menu_items_used; i++)
2127 if (menu_items_used == i
2128 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
2129 break;
2130 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
2131 {
2132 free_menubar_widget_value_tree (first_wv);
2133 discard_menu_items ();
2134
2135 return;
2136 }
2137
2138 /* Now GC cannot happen during the lifetime of the widget_value,
2139 so it's safe to store data from a Lisp_String. */
2140 wv = first_wv->contents;
2141 for (i = 0; i < XVECTOR (items)->size; i += 4)
2142 {
2143 Lisp_Object string;
2144 string = XVECTOR (items)->contents[i + 1];
2145 if (NILP (string))
2146 break;
2147 wv->name = (char *) SDATA (string);
2148 update_submenu_strings (wv->contents);
2149 wv = wv->next;
2150 }
2151
2152 f->menu_bar_vector = menu_items;
2153 f->menu_bar_items_used = menu_items_used;
2154 discard_menu_items ();
2155 }
2156 else
2157 {
2158 /* Make a widget-value tree containing
2159 just the top level menu bar strings. */
2160
2161 wv = xmalloc_widget_value ();
2162 wv->name = "menubar";
2163 wv->value = 0;
2164 wv->enabled = 1;
2165 wv->button_type = BUTTON_TYPE_NONE;
2166 wv->help = Qnil;
2167 first_wv = wv;
2168
2169 items = FRAME_MENU_BAR_ITEMS (f);
2170 for (i = 0; i < XVECTOR (items)->size; i += 4)
2171 {
2172 Lisp_Object string;
2173
2174 string = XVECTOR (items)->contents[i + 1];
2175 if (NILP (string))
2176 break;
2177
2178 wv = xmalloc_widget_value ();
2179 wv->name = (char *) SDATA (string);
2180 wv->value = 0;
2181 wv->enabled = 1;
2182 wv->button_type = BUTTON_TYPE_NONE;
2183 wv->help = Qnil;
2184 /* This prevents lwlib from assuming this
2185 menu item is really supposed to be empty. */
2186 /* The EMACS_INT cast avoids a warning.
2187 This value just has to be different from small integers. */
2188 wv->call_data = (void *) (EMACS_INT) (-1);
2189
2190 if (prev_wv)
2191 prev_wv->next = wv;
2192 else
2193 first_wv->contents = wv;
2194 prev_wv = wv;
2195 }
2196
2197 /* Forget what we thought we knew about what is in the
2198 detailed contents of the menu bar menus.
2199 Changing the top level always destroys the contents. */
2200 f->menu_bar_items_used = 0;
2201 }
2202
2203 /* Create or update the menu bar widget. */
2204
2205 BLOCK_INPUT;
2206
2207 #ifdef USE_GTK
2208 xg_crazy_callback_abort = 1;
2209 if (menubar_widget)
2210 {
2211 /* The fourth arg is DEEP_P, which says to consider the entire
2212 menu trees we supply, rather than just the menu bar item names. */
2213 xg_modify_menubar_widgets (menubar_widget,
2214 f,
2215 first_wv,
2216 deep_p,
2217 G_CALLBACK (menubar_selection_callback),
2218 G_CALLBACK (popup_deactivate_callback),
2219 G_CALLBACK (menu_highlight_callback));
2220 }
2221 else
2222 {
2223 GtkWidget *wvbox = f->output_data.x->vbox_widget;
2224
2225 menubar_widget
2226 = xg_create_widget ("menubar", "menubar", f, first_wv,
2227 G_CALLBACK (menubar_selection_callback),
2228 G_CALLBACK (popup_deactivate_callback),
2229 G_CALLBACK (menu_highlight_callback));
2230
2231 f->output_data.x->menubar_widget = menubar_widget;
2232 }
2233
2234
2235 #else /* not USE_GTK */
2236 if (menubar_widget)
2237 {
2238 /* Disable resizing (done for Motif!) */
2239 lw_allow_resizing (f->output_data.x->widget, False);
2240
2241 /* The third arg is DEEP_P, which says to consider the entire
2242 menu trees we supply, rather than just the menu bar item names. */
2243 lw_modify_all_widgets (id, first_wv, deep_p);
2244
2245 /* Re-enable the edit widget to resize. */
2246 lw_allow_resizing (f->output_data.x->widget, True);
2247 }
2248 else
2249 {
2250 char menuOverride[] = "Ctrl<KeyPress>g: MenuGadgetEscape()";
2251 XtTranslations override = XtParseTranslationTable (menuOverride);
2252
2253 menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv,
2254 f->output_data.x->column_widget,
2255 0,
2256 popup_activate_callback,
2257 menubar_selection_callback,
2258 popup_deactivate_callback,
2259 menu_highlight_callback);
2260 f->output_data.x->menubar_widget = menubar_widget;
2261
2262 /* Make menu pop down on C-g. */
2263 XtOverrideTranslations (menubar_widget, override);
2264 }
2265
2266 {
2267 int menubar_size
2268 = (f->output_data.x->menubar_widget
2269 ? (f->output_data.x->menubar_widget->core.height
2270 + f->output_data.x->menubar_widget->core.border_width)
2271 : 0);
2272
2273 #if 0 /* Experimentally, we now get the right results
2274 for -geometry -0-0 without this. 24 Aug 96, rms. */
2275 #ifdef USE_LUCID
2276 if (FRAME_EXTERNAL_MENU_BAR (f))
2277 {
2278 Dimension ibw = 0;
2279 XtVaGetValues (f->output_data.x->column_widget,
2280 XtNinternalBorderWidth, &ibw, NULL);
2281 menubar_size += ibw;
2282 }
2283 #endif /* USE_LUCID */
2284 #endif /* 0 */
2285
2286 f->output_data.x->menubar_height = menubar_size;
2287 }
2288 #endif /* not USE_GTK */
2289
2290 free_menubar_widget_value_tree (first_wv);
2291 update_frame_menubar (f);
2292
2293 #ifdef USE_GTK
2294 xg_crazy_callback_abort = 0;
2295 #endif
2296
2297 UNBLOCK_INPUT;
2298 }
2299
2300 /* Called from Fx_create_frame to create the initial menubar of a frame
2301 before it is mapped, so that the window is mapped with the menubar already
2302 there instead of us tacking it on later and thrashing the window after it
2303 is visible. */
2304
2305 void
2306 initialize_frame_menubar (f)
2307 FRAME_PTR f;
2308 {
2309 /* This function is called before the first chance to redisplay
2310 the frame. It has to be, so the frame will have the right size. */
2311 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
2312 set_frame_menubar (f, 1, 1);
2313 }
2314
2315
2316 /* Get rid of the menu bar of frame F, and free its storage.
2317 This is used when deleting a frame, and when turning off the menu bar.
2318 For GTK this function is in gtkutil.c. */
2319
2320 #ifndef USE_GTK
2321 void
2322 free_frame_menubar (f)
2323 FRAME_PTR f;
2324 {
2325 Widget menubar_widget;
2326
2327 menubar_widget = f->output_data.x->menubar_widget;
2328
2329 f->output_data.x->menubar_height = 0;
2330
2331 if (menubar_widget)
2332 {
2333 #ifdef USE_MOTIF
2334 /* Removing the menu bar magically changes the shell widget's x
2335 and y position of (0, 0) which, when the menu bar is turned
2336 on again, leads to pull-down menuss appearing in strange
2337 positions near the upper-left corner of the display. This
2338 happens only with some window managers like twm and ctwm,
2339 but not with other like Motif's mwm or kwm, because the
2340 latter generate ConfigureNotify events when the menu bar
2341 is switched off, which fixes the shell position. */
2342 Position x0, y0, x1, y1;
2343 #endif
2344
2345 BLOCK_INPUT;
2346
2347 #ifdef USE_MOTIF
2348 if (f->output_data.x->widget)
2349 XtVaGetValues (f->output_data.x->widget, XtNx, &x0, XtNy, &y0, NULL);
2350 #endif
2351
2352 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
2353 f->output_data.x->menubar_widget = NULL;
2354
2355 #ifdef USE_MOTIF
2356 if (f->output_data.x->widget)
2357 {
2358 XtVaGetValues (f->output_data.x->widget, XtNx, &x1, XtNy, &y1, NULL);
2359 if (x1 == 0 && y1 == 0)
2360 XtVaSetValues (f->output_data.x->widget, XtNx, x0, XtNy, y0, NULL);
2361 }
2362 #endif
2363
2364 UNBLOCK_INPUT;
2365 }
2366 }
2367 #endif /* not USE_GTK */
2368
2369 #endif /* USE_X_TOOLKIT || USE_GTK */
2370 \f
2371 /* xmenu_show actually displays a menu using the panes and items in menu_items
2372 and returns the value selected from it.
2373 There are two versions of xmenu_show, one for Xt and one for Xlib.
2374 Both assume input is blocked by the caller. */
2375
2376 /* F is the frame the menu is for.
2377 X and Y are the frame-relative specified position,
2378 relative to the inside upper left corner of the frame F.
2379 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
2380 KEYMAPS is 1 if this menu was specified with keymaps;
2381 in that case, we return a list containing the chosen item's value
2382 and perhaps also the pane's prefix.
2383 TITLE is the specified menu title.
2384 ERROR is a place to store an error message string in case of failure.
2385 (We return nil on failure, but the value doesn't actually matter.) */
2386
2387 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
2388
2389 /* The item selected in the popup menu. */
2390 static Lisp_Object *volatile menu_item_selection;
2391
2392 #ifdef USE_GTK
2393
2394 /* Used when position a popup menu. See menu_position_func and
2395 create_and_show_popup_menu below. */
2396 struct next_popup_x_y
2397 {
2398 FRAME_PTR f;
2399 int x;
2400 int y;
2401 };
2402
2403 /* The menu position function to use if we are not putting a popup
2404 menu where the pointer is.
2405 MENU is the menu to pop up.
2406 X and Y shall on exit contain x/y where the menu shall pop up.
2407 PUSH_IN is not documented in the GTK manual.
2408 USER_DATA is any data passed in when calling gtk_menu_popup.
2409 Here it points to a struct next_popup_x_y where the coordinates
2410 to store in *X and *Y are as well as the frame for the popup.
2411
2412 Here only X and Y are used. */
2413 static void
2414 menu_position_func (menu, x, y, push_in, user_data)
2415 GtkMenu *menu;
2416 gint *x;
2417 gint *y;
2418 gboolean *push_in;
2419 gpointer user_data;
2420 {
2421 struct next_popup_x_y* data = (struct next_popup_x_y*)user_data;
2422 GtkRequisition req;
2423 int disp_width = FRAME_X_DISPLAY_INFO (data->f)->width;
2424 int disp_height = FRAME_X_DISPLAY_INFO (data->f)->height;
2425
2426 *x = data->x;
2427 *y = data->y;
2428
2429 /* Check if there is room for the menu. If not, adjust x/y so that
2430 the menu is fully visible. */
2431 gtk_widget_size_request (GTK_WIDGET (menu), &req);
2432 if (data->x + req.width > disp_width)
2433 *x -= data->x + req.width - disp_width;
2434 if (data->y + req.height > disp_height)
2435 *y -= data->y + req.height - disp_height;
2436 }
2437
2438 static void
2439 popup_selection_callback (widget, client_data)
2440 GtkWidget *widget;
2441 gpointer client_data;
2442 {
2443 xg_menu_item_cb_data *cb_data = (xg_menu_item_cb_data*) client_data;
2444
2445 if (xg_crazy_callback_abort) return;
2446 if (cb_data) menu_item_selection = (Lisp_Object *) cb_data->call_data;
2447 }
2448
2449 static Lisp_Object
2450 pop_down_menu (arg)
2451 Lisp_Object arg;
2452 {
2453 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
2454
2455 popup_activated_flag = 0;
2456 BLOCK_INPUT;
2457 gtk_widget_destroy (GTK_WIDGET (p->pointer));
2458 UNBLOCK_INPUT;
2459 return Qnil;
2460 }
2461
2462 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
2463 menu pops down.
2464 menu_item_selection will be set to the selection. */
2465 static void
2466 create_and_show_popup_menu (f, first_wv, x, y, for_click)
2467 FRAME_PTR f;
2468 widget_value *first_wv;
2469 int x;
2470 int y;
2471 int for_click;
2472 {
2473 int i;
2474 GtkWidget *menu;
2475 GtkMenuPositionFunc pos_func = 0; /* Pop up at pointer. */
2476 struct next_popup_x_y popup_x_y;
2477 int specpdl_count = SPECPDL_INDEX ();
2478
2479 xg_crazy_callback_abort = 1;
2480 menu = xg_create_widget ("popup", first_wv->name, f, first_wv,
2481 G_CALLBACK (popup_selection_callback),
2482 G_CALLBACK (popup_deactivate_callback),
2483 G_CALLBACK (menu_highlight_callback));
2484 xg_crazy_callback_abort = 0;
2485
2486 if (! for_click)
2487 {
2488 /* Not invoked by a click. pop up at x/y. */
2489 pos_func = menu_position_func;
2490
2491 /* Adjust coordinates to be root-window-relative. */
2492 x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2493 y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2494
2495 popup_x_y.x = x;
2496 popup_x_y.y = y;
2497 popup_x_y.f = f;
2498
2499 i = 0; /* gtk_menu_popup needs this to be 0 for a non-button popup. */
2500 }
2501 else
2502 {
2503 for (i = 0; i < 5; i++)
2504 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2505 break;
2506 }
2507
2508 /* Display the menu. */
2509 gtk_widget_show_all (menu);
2510 gtk_menu_popup (GTK_MENU (menu), 0, 0, pos_func, &popup_x_y, i, 0);
2511
2512 record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
2513
2514 if (GTK_WIDGET_MAPPED (menu))
2515 {
2516 /* Set this to one. popup_widget_loop increases it by one, so it becomes
2517 two. show_help_echo uses this to detect popup menus. */
2518 popup_activated_flag = 1;
2519 /* Process events that apply to the menu. */
2520 popup_widget_loop (1, menu);
2521 }
2522
2523 unbind_to (specpdl_count, Qnil);
2524
2525 /* Must reset this manually because the button release event is not passed
2526 to Emacs event loop. */
2527 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
2528 }
2529
2530 #else /* not USE_GTK */
2531
2532 /* We need a unique id for each widget handled by the Lucid Widget
2533 library.
2534
2535 For the main windows, and popup menus, we use this counter,
2536 which we increment each time after use. This starts from 1<<16.
2537
2538 For menu bars, we use numbers starting at 0, counted in
2539 next_menubar_widget_id. */
2540 LWLIB_ID widget_id_tick;
2541
2542 static void
2543 popup_selection_callback (widget, id, client_data)
2544 Widget widget;
2545 LWLIB_ID id;
2546 XtPointer client_data;
2547 {
2548 menu_item_selection = (Lisp_Object *) client_data;
2549 }
2550
2551 /* ARG is the LWLIB ID of the dialog box, represented
2552 as a Lisp object as (HIGHPART . LOWPART). */
2553
2554 static Lisp_Object
2555 pop_down_menu (arg)
2556 Lisp_Object arg;
2557 {
2558 LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID)
2559 | XINT (XCDR (arg)));
2560
2561 BLOCK_INPUT;
2562 lw_destroy_all_widgets (id);
2563 UNBLOCK_INPUT;
2564 popup_activated_flag = 0;
2565
2566 return Qnil;
2567 }
2568
2569 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
2570 menu pops down.
2571 menu_item_selection will be set to the selection. */
2572 static void
2573 create_and_show_popup_menu (f, first_wv, x, y, for_click)
2574 FRAME_PTR f;
2575 widget_value *first_wv;
2576 int x;
2577 int y;
2578 int for_click;
2579 {
2580 int i;
2581 Arg av[2];
2582 int ac = 0;
2583 XButtonPressedEvent dummy;
2584 LWLIB_ID menu_id;
2585 Widget menu;
2586
2587 menu_id = widget_id_tick++;
2588 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
2589 f->output_data.x->widget, 1, 0,
2590 popup_selection_callback,
2591 popup_deactivate_callback,
2592 menu_highlight_callback);
2593
2594 dummy.type = ButtonPress;
2595 dummy.serial = 0;
2596 dummy.send_event = 0;
2597 dummy.display = FRAME_X_DISPLAY (f);
2598 dummy.time = CurrentTime;
2599 dummy.root = FRAME_X_DISPLAY_INFO (f)->root_window;
2600 dummy.window = dummy.root;
2601 dummy.subwindow = dummy.root;
2602 dummy.x = x;
2603 dummy.y = y;
2604
2605 /* Adjust coordinates to be root-window-relative. */
2606 x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2607 y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2608
2609 dummy.x_root = x;
2610 dummy.y_root = y;
2611
2612 dummy.state = 0;
2613 dummy.button = 0;
2614 for (i = 0; i < 5; i++)
2615 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2616 dummy.button = i;
2617
2618 /* Don't allow any geometry request from the user. */
2619 XtSetArg (av[ac], XtNgeometry, 0); ac++;
2620 XtSetValues (menu, av, ac);
2621
2622 /* Display the menu. */
2623 lw_popup_menu (menu, (XEvent *) &dummy);
2624 popup_activated_flag = 1;
2625
2626 {
2627 int fact = 4 * sizeof (LWLIB_ID);
2628 int specpdl_count = SPECPDL_INDEX ();
2629 record_unwind_protect (pop_down_menu,
2630 Fcons (make_number (menu_id >> (fact)),
2631 make_number (menu_id & ~(-1 << (fact)))));
2632
2633 /* Process events that apply to the menu. */
2634 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 1);
2635
2636 unbind_to (specpdl_count, Qnil);
2637 }
2638 }
2639
2640 #endif /* not USE_GTK */
2641
2642 static Lisp_Object
2643 xmenu_show (f, x, y, for_click, keymaps, title, error)
2644 FRAME_PTR f;
2645 int x;
2646 int y;
2647 int for_click;
2648 int keymaps;
2649 Lisp_Object title;
2650 char **error;
2651 {
2652 int i;
2653 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2654 widget_value **submenu_stack
2655 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
2656 Lisp_Object *subprefix_stack
2657 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
2658 int submenu_depth = 0;
2659
2660 int first_pane;
2661
2662 *error = NULL;
2663
2664 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2665 {
2666 *error = "Empty menu";
2667 return Qnil;
2668 }
2669
2670 /* Create a tree of widget_value objects
2671 representing the panes and their items. */
2672 wv = xmalloc_widget_value ();
2673 wv->name = "menu";
2674 wv->value = 0;
2675 wv->enabled = 1;
2676 wv->button_type = BUTTON_TYPE_NONE;
2677 wv->help =Qnil;
2678 first_wv = wv;
2679 first_pane = 1;
2680
2681 /* Loop over all panes and items, filling in the tree. */
2682 i = 0;
2683 while (i < menu_items_used)
2684 {
2685 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2686 {
2687 submenu_stack[submenu_depth++] = save_wv;
2688 save_wv = prev_wv;
2689 prev_wv = 0;
2690 first_pane = 1;
2691 i++;
2692 }
2693 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2694 {
2695 prev_wv = save_wv;
2696 save_wv = submenu_stack[--submenu_depth];
2697 first_pane = 0;
2698 i++;
2699 }
2700 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
2701 && submenu_depth != 0)
2702 i += MENU_ITEMS_PANE_LENGTH;
2703 /* Ignore a nil in the item list.
2704 It's meaningful only for dialog boxes. */
2705 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2706 i += 1;
2707 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2708 {
2709 /* Create a new pane. */
2710 Lisp_Object pane_name, prefix;
2711 char *pane_string;
2712
2713 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2714 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2715
2716 #ifndef HAVE_MULTILINGUAL_MENU
2717 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
2718 {
2719 pane_name = ENCODE_MENU_STRING (pane_name);
2720 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
2721 }
2722 #endif
2723 pane_string = (NILP (pane_name)
2724 ? "" : (char *) SDATA (pane_name));
2725 /* If there is just one top-level pane, put all its items directly
2726 under the top-level menu. */
2727 if (menu_items_n_panes == 1)
2728 pane_string = "";
2729
2730 /* If the pane has a meaningful name,
2731 make the pane a top-level menu item
2732 with its items as a submenu beneath it. */
2733 if (!keymaps && strcmp (pane_string, ""))
2734 {
2735 wv = xmalloc_widget_value ();
2736 if (save_wv)
2737 save_wv->next = wv;
2738 else
2739 first_wv->contents = wv;
2740 wv->name = pane_string;
2741 if (keymaps && !NILP (prefix))
2742 wv->name++;
2743 wv->value = 0;
2744 wv->enabled = 1;
2745 wv->button_type = BUTTON_TYPE_NONE;
2746 wv->help = Qnil;
2747 save_wv = wv;
2748 prev_wv = 0;
2749 }
2750 else if (first_pane)
2751 {
2752 save_wv = wv;
2753 prev_wv = 0;
2754 }
2755 first_pane = 0;
2756 i += MENU_ITEMS_PANE_LENGTH;
2757 }
2758 else
2759 {
2760 /* Create a new item within current pane. */
2761 Lisp_Object item_name, enable, descrip, def, type, selected, help;
2762 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2763 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2764 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2765 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
2766 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
2767 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
2768 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2769
2770 #ifndef HAVE_MULTILINGUAL_MENU
2771 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
2772 {
2773 item_name = ENCODE_MENU_STRING (item_name);
2774 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
2775 }
2776
2777 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
2778 {
2779 descrip = ENCODE_MENU_STRING (descrip);
2780 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
2781 }
2782 #endif /* not HAVE_MULTILINGUAL_MENU */
2783
2784 wv = xmalloc_widget_value ();
2785 if (prev_wv)
2786 prev_wv->next = wv;
2787 else
2788 save_wv->contents = wv;
2789 wv->name = (char *) SDATA (item_name);
2790 if (!NILP (descrip))
2791 wv->key = (char *) SDATA (descrip);
2792 wv->value = 0;
2793 /* If this item has a null value,
2794 make the call_data null so that it won't display a box
2795 when the mouse is on it. */
2796 wv->call_data
2797 = (!NILP (def) ? (void *) &XVECTOR (menu_items)->contents[i] : 0);
2798 wv->enabled = !NILP (enable);
2799
2800 if (NILP (type))
2801 wv->button_type = BUTTON_TYPE_NONE;
2802 else if (EQ (type, QCtoggle))
2803 wv->button_type = BUTTON_TYPE_TOGGLE;
2804 else if (EQ (type, QCradio))
2805 wv->button_type = BUTTON_TYPE_RADIO;
2806 else
2807 abort ();
2808
2809 wv->selected = !NILP (selected);
2810
2811 if (! STRINGP (help))
2812 help = Qnil;
2813
2814 wv->help = help;
2815
2816 prev_wv = wv;
2817
2818 i += MENU_ITEMS_ITEM_LENGTH;
2819 }
2820 }
2821
2822 /* Deal with the title, if it is non-nil. */
2823 if (!NILP (title))
2824 {
2825 widget_value *wv_title = xmalloc_widget_value ();
2826 widget_value *wv_sep1 = xmalloc_widget_value ();
2827 widget_value *wv_sep2 = xmalloc_widget_value ();
2828
2829 wv_sep2->name = "--";
2830 wv_sep2->next = first_wv->contents;
2831 wv_sep2->help = Qnil;
2832
2833 wv_sep1->name = "--";
2834 wv_sep1->next = wv_sep2;
2835 wv_sep1->help = Qnil;
2836
2837 #ifndef HAVE_MULTILINGUAL_MENU
2838 if (STRING_MULTIBYTE (title))
2839 title = ENCODE_MENU_STRING (title);
2840 #endif
2841
2842 wv_title->name = (char *) SDATA (title);
2843 wv_title->enabled = TRUE;
2844 wv_title->button_type = BUTTON_TYPE_NONE;
2845 wv_title->next = wv_sep1;
2846 wv_title->help = Qnil;
2847 first_wv->contents = wv_title;
2848 }
2849
2850 /* No selection has been chosen yet. */
2851 menu_item_selection = 0;
2852
2853 /* Actually create and show the menu until popped down. */
2854 create_and_show_popup_menu (f, first_wv, x, y, for_click);
2855
2856 /* Free the widget_value objects we used to specify the contents. */
2857 free_menubar_widget_value_tree (first_wv);
2858
2859 /* Find the selected item, and its pane, to return
2860 the proper value. */
2861 if (menu_item_selection != 0)
2862 {
2863 Lisp_Object prefix, entry;
2864
2865 prefix = entry = Qnil;
2866 i = 0;
2867 while (i < menu_items_used)
2868 {
2869 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2870 {
2871 subprefix_stack[submenu_depth++] = prefix;
2872 prefix = entry;
2873 i++;
2874 }
2875 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2876 {
2877 prefix = subprefix_stack[--submenu_depth];
2878 i++;
2879 }
2880 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2881 {
2882 prefix
2883 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2884 i += MENU_ITEMS_PANE_LENGTH;
2885 }
2886 /* Ignore a nil in the item list.
2887 It's meaningful only for dialog boxes. */
2888 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2889 i += 1;
2890 else
2891 {
2892 entry
2893 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2894 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2895 {
2896 if (keymaps != 0)
2897 {
2898 int j;
2899
2900 entry = Fcons (entry, Qnil);
2901 if (!NILP (prefix))
2902 entry = Fcons (prefix, entry);
2903 for (j = submenu_depth - 1; j >= 0; j--)
2904 if (!NILP (subprefix_stack[j]))
2905 entry = Fcons (subprefix_stack[j], entry);
2906 }
2907 return entry;
2908 }
2909 i += MENU_ITEMS_ITEM_LENGTH;
2910 }
2911 }
2912 }
2913 else if (!for_click)
2914 /* Make "Cancel" equivalent to C-g. */
2915 Fsignal (Qquit, Qnil);
2916
2917 return Qnil;
2918 }
2919 \f
2920 #ifdef USE_GTK
2921 static void
2922 dialog_selection_callback (widget, client_data)
2923 GtkWidget *widget;
2924 gpointer client_data;
2925 {
2926 /* The EMACS_INT cast avoids a warning. There's no problem
2927 as long as pointers have enough bits to hold small integers. */
2928 if ((int) (EMACS_INT) client_data != -1)
2929 menu_item_selection = (Lisp_Object *) client_data;
2930
2931 popup_activated_flag = 0;
2932 }
2933
2934 /* Pop up the dialog for frame F defined by FIRST_WV and loop until the
2935 dialog pops down.
2936 menu_item_selection will be set to the selection. */
2937 static void
2938 create_and_show_dialog (f, first_wv)
2939 FRAME_PTR f;
2940 widget_value *first_wv;
2941 {
2942 GtkWidget *menu;
2943
2944 menu = xg_create_widget ("dialog", first_wv->name, f, first_wv,
2945 G_CALLBACK (dialog_selection_callback),
2946 G_CALLBACK (popup_deactivate_callback),
2947 0);
2948
2949 if (menu)
2950 {
2951 int specpdl_count = SPECPDL_INDEX ();
2952 record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
2953
2954 /* Display the menu. */
2955 gtk_widget_show_all (menu);
2956
2957 /* Process events that apply to the menu. */
2958 popup_widget_loop (1, menu);
2959
2960 unbind_to (specpdl_count, Qnil);
2961 }
2962 }
2963
2964 #else /* not USE_GTK */
2965 static void
2966 dialog_selection_callback (widget, id, client_data)
2967 Widget widget;
2968 LWLIB_ID id;
2969 XtPointer client_data;
2970 {
2971 /* The EMACS_INT cast avoids a warning. There's no problem
2972 as long as pointers have enough bits to hold small integers. */
2973 if ((int) (EMACS_INT) client_data != -1)
2974 menu_item_selection = (Lisp_Object *) client_data;
2975
2976 BLOCK_INPUT;
2977 lw_destroy_all_widgets (id);
2978 UNBLOCK_INPUT;
2979 popup_activated_flag = 0;
2980 }
2981
2982
2983 /* Pop up the dialog for frame F defined by FIRST_WV and loop until the
2984 dialog pops down.
2985 menu_item_selection will be set to the selection. */
2986 static void
2987 create_and_show_dialog (f, first_wv)
2988 FRAME_PTR f;
2989 widget_value *first_wv;
2990 {
2991 LWLIB_ID dialog_id;
2992
2993 dialog_id = widget_id_tick++;
2994 lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2995 f->output_data.x->widget, 1, 0,
2996 dialog_selection_callback, 0, 0);
2997 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
2998
2999 /* Display the dialog box. */
3000 lw_pop_up_all_widgets (dialog_id);
3001 popup_activated_flag = 1;
3002
3003 /* Process events that apply to the dialog box.
3004 Also handle timers. */
3005 {
3006 int count = SPECPDL_INDEX ();
3007 int fact = 4 * sizeof (LWLIB_ID);
3008
3009 /* xdialog_show_unwind is responsible for popping the dialog box down. */
3010 record_unwind_protect (pop_down_menu,
3011 Fcons (make_number (dialog_id >> (fact)),
3012 make_number (dialog_id & ~(-1 << (fact)))));
3013
3014 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f),
3015 dialog_id, 1);
3016
3017 unbind_to (count, Qnil);
3018 }
3019 }
3020
3021 #endif /* not USE_GTK */
3022
3023 static char * button_names [] = {
3024 "button1", "button2", "button3", "button4", "button5",
3025 "button6", "button7", "button8", "button9", "button10" };
3026
3027 static Lisp_Object
3028 xdialog_show (f, keymaps, title, header, error_name)
3029 FRAME_PTR f;
3030 int keymaps;
3031 Lisp_Object title, header;
3032 char **error_name;
3033 {
3034 int i, nb_buttons=0;
3035 char dialog_name[6];
3036
3037 widget_value *wv, *first_wv = 0, *prev_wv = 0;
3038
3039 /* Number of elements seen so far, before boundary. */
3040 int left_count = 0;
3041 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
3042 int boundary_seen = 0;
3043
3044 *error_name = NULL;
3045
3046 if (menu_items_n_panes > 1)
3047 {
3048 *error_name = "Multiple panes in dialog box";
3049 return Qnil;
3050 }
3051
3052 /* Create a tree of widget_value objects
3053 representing the text label and buttons. */
3054 {
3055 Lisp_Object pane_name, prefix;
3056 char *pane_string;
3057 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
3058 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
3059 pane_string = (NILP (pane_name)
3060 ? "" : (char *) SDATA (pane_name));
3061 prev_wv = xmalloc_widget_value ();
3062 prev_wv->value = pane_string;
3063 if (keymaps && !NILP (prefix))
3064 prev_wv->name++;
3065 prev_wv->enabled = 1;
3066 prev_wv->name = "message";
3067 prev_wv->help = Qnil;
3068 first_wv = prev_wv;
3069
3070 /* Loop over all panes and items, filling in the tree. */
3071 i = MENU_ITEMS_PANE_LENGTH;
3072 while (i < menu_items_used)
3073 {
3074
3075 /* Create a new item within current pane. */
3076 Lisp_Object item_name, enable, descrip;
3077 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
3078 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
3079 descrip
3080 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
3081
3082 if (NILP (item_name))
3083 {
3084 free_menubar_widget_value_tree (first_wv);
3085 *error_name = "Submenu in dialog items";
3086 return Qnil;
3087 }
3088 if (EQ (item_name, Qquote))
3089 {
3090 /* This is the boundary between left-side elts
3091 and right-side elts. Stop incrementing right_count. */
3092 boundary_seen = 1;
3093 i++;
3094 continue;
3095 }
3096 if (nb_buttons >= 9)
3097 {
3098 free_menubar_widget_value_tree (first_wv);
3099 *error_name = "Too many dialog items";
3100 return Qnil;
3101 }
3102
3103 wv = xmalloc_widget_value ();
3104 prev_wv->next = wv;
3105 wv->name = (char *) button_names[nb_buttons];
3106 if (!NILP (descrip))
3107 wv->key = (char *) SDATA (descrip);
3108 wv->value = (char *) SDATA (item_name);
3109 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
3110 wv->enabled = !NILP (enable);
3111 wv->help = Qnil;
3112 prev_wv = wv;
3113
3114 if (! boundary_seen)
3115 left_count++;
3116
3117 nb_buttons++;
3118 i += MENU_ITEMS_ITEM_LENGTH;
3119 }
3120
3121 /* If the boundary was not specified,
3122 by default put half on the left and half on the right. */
3123 if (! boundary_seen)
3124 left_count = nb_buttons - nb_buttons / 2;
3125
3126 wv = xmalloc_widget_value ();
3127 wv->name = dialog_name;
3128 wv->help = Qnil;
3129
3130 /* Frame title: 'Q' = Question, 'I' = Information.
3131 Can also have 'E' = Error if, one day, we want
3132 a popup for errors. */
3133 if (NILP(header))
3134 dialog_name[0] = 'Q';
3135 else
3136 dialog_name[0] = 'I';
3137
3138 /* Dialog boxes use a really stupid name encoding
3139 which specifies how many buttons to use
3140 and how many buttons are on the right. */
3141 dialog_name[1] = '0' + nb_buttons;
3142 dialog_name[2] = 'B';
3143 dialog_name[3] = 'R';
3144 /* Number of buttons to put on the right. */
3145 dialog_name[4] = '0' + nb_buttons - left_count;
3146 dialog_name[5] = 0;
3147 wv->contents = first_wv;
3148 first_wv = wv;
3149 }
3150
3151 /* No selection has been chosen yet. */
3152 menu_item_selection = 0;
3153
3154 /* Actually create and show the dialog. */
3155 create_and_show_dialog (f, first_wv);
3156
3157 /* Free the widget_value objects we used to specify the contents. */
3158 free_menubar_widget_value_tree (first_wv);
3159
3160 /* Find the selected item, and its pane, to return
3161 the proper value. */
3162 if (menu_item_selection != 0)
3163 {
3164 Lisp_Object prefix;
3165
3166 prefix = Qnil;
3167 i = 0;
3168 while (i < menu_items_used)
3169 {
3170 Lisp_Object entry;
3171
3172 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3173 {
3174 prefix
3175 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3176 i += MENU_ITEMS_PANE_LENGTH;
3177 }
3178 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
3179 {
3180 /* This is the boundary between left-side elts and
3181 right-side elts. */
3182 ++i;
3183 }
3184 else
3185 {
3186 entry
3187 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
3188 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
3189 {
3190 if (keymaps != 0)
3191 {
3192 entry = Fcons (entry, Qnil);
3193 if (!NILP (prefix))
3194 entry = Fcons (prefix, entry);
3195 }
3196 return entry;
3197 }
3198 i += MENU_ITEMS_ITEM_LENGTH;
3199 }
3200 }
3201 }
3202 else
3203 /* Make "Cancel" equivalent to C-g. */
3204 Fsignal (Qquit, Qnil);
3205
3206 return Qnil;
3207 }
3208
3209 #else /* not USE_X_TOOLKIT && not USE_GTK */
3210
3211 /* The frame of the last activated non-toolkit menu bar.
3212 Used to generate menu help events. */
3213
3214 static struct frame *menu_help_frame;
3215
3216
3217 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
3218
3219 PANE is the pane number, and ITEM is the menu item number in
3220 the menu (currently not used).
3221
3222 This cannot be done with generating a HELP_EVENT because
3223 XMenuActivate contains a loop that doesn't let Emacs process
3224 keyboard events. */
3225
3226 static void
3227 menu_help_callback (help_string, pane, item)
3228 char *help_string;
3229 int pane, item;
3230 {
3231 extern Lisp_Object Qmenu_item;
3232 Lisp_Object *first_item;
3233 Lisp_Object pane_name;
3234 Lisp_Object menu_object;
3235
3236 first_item = XVECTOR (menu_items)->contents;
3237 if (EQ (first_item[0], Qt))
3238 pane_name = first_item[MENU_ITEMS_PANE_NAME];
3239 else if (EQ (first_item[0], Qquote))
3240 /* This shouldn't happen, see xmenu_show. */
3241 pane_name = empty_string;
3242 else
3243 pane_name = first_item[MENU_ITEMS_ITEM_NAME];
3244
3245 /* (menu-item MENU-NAME PANE-NUMBER) */
3246 menu_object = Fcons (Qmenu_item,
3247 Fcons (pane_name,
3248 Fcons (make_number (pane), Qnil)));
3249 show_help_echo (help_string ? build_string (help_string) : Qnil,
3250 Qnil, menu_object, make_number (item), 1);
3251 }
3252
3253 static Lisp_Object
3254 pop_down_menu (arg)
3255 Lisp_Object arg;
3256 {
3257 struct Lisp_Save_Value *p1 = XSAVE_VALUE (Fcar (arg));
3258 struct Lisp_Save_Value *p2 = XSAVE_VALUE (Fcdr (arg));
3259
3260 FRAME_PTR f = p1->pointer;
3261 XMenu *menu = p2->pointer;
3262
3263 BLOCK_INPUT;
3264 #ifndef MSDOS
3265 XUngrabPointer (FRAME_X_DISPLAY (f), CurrentTime);
3266 XUngrabKeyboard (FRAME_X_DISPLAY (f), CurrentTime);
3267 #endif
3268 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3269
3270 #ifdef HAVE_X_WINDOWS
3271 /* Assume the mouse has moved out of the X window.
3272 If it has actually moved in, we will get an EnterNotify. */
3273 x_mouse_leave (FRAME_X_DISPLAY_INFO (f));
3274
3275 /* State that no mouse buttons are now held.
3276 (The oldXMenu code doesn't track this info for us.)
3277 That is not necessarily true, but the fiction leads to reasonable
3278 results, and it is a pain to ask which are actually held now. */
3279 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
3280
3281 #endif /* HAVE_X_WINDOWS */
3282
3283 UNBLOCK_INPUT;
3284
3285 return Qnil;
3286 }
3287
3288
3289 static Lisp_Object
3290 xmenu_show (f, x, y, for_click, keymaps, title, error)
3291 FRAME_PTR f;
3292 int x, y;
3293 int for_click;
3294 int keymaps;
3295 Lisp_Object title;
3296 char **error;
3297 {
3298 Window root;
3299 XMenu *menu;
3300 int pane, selidx, lpane, status;
3301 Lisp_Object entry, pane_prefix;
3302 char *datap;
3303 int ulx, uly, width, height;
3304 int dispwidth, dispheight;
3305 int i, j, lines, maxlines;
3306 int maxwidth;
3307 int dummy_int;
3308 unsigned int dummy_uint;
3309 int specpdl_count = SPECPDL_INDEX ();
3310
3311 *error = 0;
3312 if (menu_items_n_panes == 0)
3313 return Qnil;
3314
3315 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
3316 {
3317 *error = "Empty menu";
3318 return Qnil;
3319 }
3320
3321 /* Figure out which root window F is on. */
3322 XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root,
3323 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
3324 &dummy_uint, &dummy_uint);
3325
3326 /* Make the menu on that window. */
3327 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
3328 if (menu == NULL)
3329 {
3330 *error = "Can't create menu";
3331 return Qnil;
3332 }
3333
3334 #ifdef HAVE_X_WINDOWS
3335 /* Adjust coordinates to relative to the outer (window manager) window. */
3336 x += FRAME_OUTER_TO_INNER_DIFF_X (f);
3337 y += FRAME_OUTER_TO_INNER_DIFF_Y (f);
3338 #endif /* HAVE_X_WINDOWS */
3339
3340 /* Adjust coordinates to be root-window-relative. */
3341 x += f->left_pos;
3342 y += f->top_pos;
3343
3344 /* Create all the necessary panes and their items. */
3345 maxlines = lines = i = 0;
3346 while (i < menu_items_used)
3347 {
3348 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3349 {
3350 /* Create a new pane. */
3351 Lisp_Object pane_name, prefix;
3352 char *pane_string;
3353
3354 maxlines = max (maxlines, lines);
3355 lines = 0;
3356 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
3357 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3358 pane_string = (NILP (pane_name)
3359 ? "" : (char *) SDATA (pane_name));
3360 if (keymaps && !NILP (prefix))
3361 pane_string++;
3362
3363 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
3364 if (lpane == XM_FAILURE)
3365 {
3366 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3367 *error = "Can't create pane";
3368 return Qnil;
3369 }
3370 i += MENU_ITEMS_PANE_LENGTH;
3371
3372 /* Find the width of the widest item in this pane. */
3373 maxwidth = 0;
3374 j = i;
3375 while (j < menu_items_used)
3376 {
3377 Lisp_Object item;
3378 item = XVECTOR (menu_items)->contents[j];
3379 if (EQ (item, Qt))
3380 break;
3381 if (NILP (item))
3382 {
3383 j++;
3384 continue;
3385 }
3386 width = SBYTES (item);
3387 if (width > maxwidth)
3388 maxwidth = width;
3389
3390 j += MENU_ITEMS_ITEM_LENGTH;
3391 }
3392 }
3393 /* Ignore a nil in the item list.
3394 It's meaningful only for dialog boxes. */
3395 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
3396 i += 1;
3397 else
3398 {
3399 /* Create a new item within current pane. */
3400 Lisp_Object item_name, enable, descrip, help;
3401 unsigned char *item_data;
3402 char *help_string;
3403
3404 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
3405 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
3406 descrip
3407 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
3408 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
3409 help_string = STRINGP (help) ? SDATA (help) : NULL;
3410
3411 if (!NILP (descrip))
3412 {
3413 int gap = maxwidth - SBYTES (item_name);
3414 #ifdef C_ALLOCA
3415 Lisp_Object spacer;
3416 spacer = Fmake_string (make_number (gap), make_number (' '));
3417 item_name = concat2 (item_name, spacer);
3418 item_name = concat2 (item_name, descrip);
3419 item_data = SDATA (item_name);
3420 #else
3421 /* if alloca is fast, use that to make the space,
3422 to reduce gc needs. */
3423 item_data
3424 = (unsigned char *) alloca (maxwidth
3425 + SBYTES (descrip) + 1);
3426 bcopy (SDATA (item_name), item_data,
3427 SBYTES (item_name));
3428 for (j = SCHARS (item_name); j < maxwidth; j++)
3429 item_data[j] = ' ';
3430 bcopy (SDATA (descrip), item_data + j,
3431 SBYTES (descrip));
3432 item_data[j + SBYTES (descrip)] = 0;
3433 #endif
3434 }
3435 else
3436 item_data = SDATA (item_name);
3437
3438 if (XMenuAddSelection (FRAME_X_DISPLAY (f),
3439 menu, lpane, 0, item_data,
3440 !NILP (enable), help_string)
3441 == XM_FAILURE)
3442 {
3443 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3444 *error = "Can't add selection to menu";
3445 return Qnil;
3446 }
3447 i += MENU_ITEMS_ITEM_LENGTH;
3448 lines++;
3449 }
3450 }
3451
3452 maxlines = max (maxlines, lines);
3453
3454 /* All set and ready to fly. */
3455 XMenuRecompute (FRAME_X_DISPLAY (f), menu);
3456 dispwidth = DisplayWidth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
3457 dispheight = DisplayHeight (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
3458 x = min (x, dispwidth);
3459 y = min (y, dispheight);
3460 x = max (x, 1);
3461 y = max (y, 1);
3462 XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y,
3463 &ulx, &uly, &width, &height);
3464 if (ulx+width > dispwidth)
3465 {
3466 x -= (ulx + width) - dispwidth;
3467 ulx = dispwidth - width;
3468 }
3469 if (uly+height > dispheight)
3470 {
3471 y -= (uly + height) - dispheight;
3472 uly = dispheight - height;
3473 }
3474 if (ulx < 0) x -= ulx;
3475 if (uly < 0) y -= uly;
3476
3477 if (! for_click)
3478 {
3479 /* If position was not given by a mouse click, adjust so upper left
3480 corner of the menu as a whole ends up at given coordinates. This
3481 is what x-popup-menu says in its documentation. */
3482 x += width/2;
3483 y += 1.5*height/(maxlines+2);
3484 }
3485
3486 XMenuSetAEQ (menu, TRUE);
3487 XMenuSetFreeze (menu, TRUE);
3488 pane = selidx = 0;
3489
3490 #ifndef MSDOS
3491 XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f));
3492 #endif
3493
3494 record_unwind_protect (pop_down_menu,
3495 Fcons (make_save_value (f, 0),
3496 make_save_value (menu, 0)));
3497
3498 /* Help display under X won't work because XMenuActivate contains
3499 a loop that doesn't give Emacs a chance to process it. */
3500 menu_help_frame = f;
3501 status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
3502 x, y, ButtonReleaseMask, &datap,
3503 menu_help_callback);
3504
3505 switch (status)
3506 {
3507 case XM_SUCCESS:
3508 #ifdef XDEBUG
3509 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
3510 #endif
3511
3512 /* Find the item number SELIDX in pane number PANE. */
3513 i = 0;
3514 while (i < menu_items_used)
3515 {
3516 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3517 {
3518 if (pane == 0)
3519 pane_prefix
3520 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3521 pane--;
3522 i += MENU_ITEMS_PANE_LENGTH;
3523 }
3524 else
3525 {
3526 if (pane == -1)
3527 {
3528 if (selidx == 0)
3529 {
3530 entry
3531 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
3532 if (keymaps != 0)
3533 {
3534 entry = Fcons (entry, Qnil);
3535 if (!NILP (pane_prefix))
3536 entry = Fcons (pane_prefix, entry);
3537 }
3538 break;
3539 }
3540 selidx--;
3541 }
3542 i += MENU_ITEMS_ITEM_LENGTH;
3543 }
3544 }
3545 break;
3546
3547 case XM_FAILURE:
3548 *error = "Can't activate menu";
3549 case XM_IA_SELECT:
3550 entry = Qnil;
3551 break;
3552 case XM_NO_SELECT:
3553 /* Make "Cancel" equivalent to C-g unless FOR_CLICK (which means
3554 the menu was invoked with a mouse event as POSITION). */
3555 if (! for_click)
3556 Fsignal (Qquit, Qnil);
3557 entry = Qnil;
3558 break;
3559 }
3560
3561 unbind_to (specpdl_count, Qnil);
3562
3563 return entry;
3564 }
3565
3566 #endif /* not USE_X_TOOLKIT */
3567
3568 #endif /* HAVE_MENUS */
3569 \f
3570 void
3571 syms_of_xmenu ()
3572 {
3573 staticpro (&menu_items);
3574 menu_items = Qnil;
3575 menu_items_inuse = Qnil;
3576
3577 Qdebug_on_next_call = intern ("debug-on-next-call");
3578 staticpro (&Qdebug_on_next_call);
3579
3580 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
3581 doc: /* Frame for which we are updating a menu.
3582 The enable predicate for a menu command should check this variable. */);
3583 Vmenu_updating_frame = Qnil;
3584
3585 #ifdef USE_X_TOOLKIT
3586 widget_id_tick = (1<<16);
3587 next_menubar_widget_id = 1;
3588 #endif
3589
3590 defsubr (&Sx_popup_menu);
3591 #ifdef HAVE_MENUS
3592 defsubr (&Sx_popup_dialog);
3593 #endif
3594 }
3595
3596 /* arch-tag: 92ea573c-398e-496e-ac73-2436f7d63242
3597 (do not change this comment) */