(Progress, Defining Faces):
[emacs.git] / src / xmenu.c
blob184ff2c8c474ff3b47aef983876c3e17a2801c6e
1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
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.
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.
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. */
22 /* X pop-up deck-of-cards menu facility for GNU Emacs.
24 * Written by Jon Arnold and Roman Budzianowski
25 * Mods and rewrite by Robert Krawitz
29 /* Modified by Fred Pierresteguy on December 93
30 to make the popup menus and menubar use the Xt. */
32 /* Rewritten for clarity and GC protection by rms in Feb 94. */
34 #include <config.h>
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
41 #include <stdio.h>
43 #include "lisp.h"
44 #include "termhooks.h"
45 #include "keyboard.h"
46 #include "keymap.h"
47 #include "frame.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"
55 #ifdef MSDOS
56 #include "msdos.h"
57 #endif
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
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
71 #include "dispextern.h"
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 */
95 #ifndef TRUE
96 #define TRUE 1
97 #define FALSE 0
98 #endif /* no TRUE */
100 Lisp_Object Vmenu_updating_frame;
102 Lisp_Object Qdebug_on_next_call;
104 extern Lisp_Object Qmenu_bar;
106 extern Lisp_Object QCtoggle, QCradio;
108 extern Lisp_Object Voverriding_local_map;
109 extern Lisp_Object Voverriding_local_map_menu_flag;
111 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
113 extern Lisp_Object Qmenu_bar_update_hook;
115 #ifdef USE_X_TOOLKIT
116 extern void set_frame_menubar P_ ((FRAME_PTR, int, int));
117 extern XtAppContext Xt_app_con;
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));
124 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
126 #define HAVE_BOXES 1
127 #endif /* USE_X_TOOLKIT */
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
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
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));
163 /* This holds a Lisp vector that holds the results of decoding
164 the keymaps or alist-of-alists that specify a menu.
166 It describes the panes and items within the panes.
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.
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.
179 A single vector slot containing quote indicates that the
180 following items should appear on the right of a dialog box.
182 Using a Lisp vector to hold this information while we decode it
183 takes care of protecting all the data from GC. */
185 #define MENU_ITEMS_PANE_NAME 1
186 #define MENU_ITEMS_PANE_PREFIX 2
187 #define MENU_ITEMS_PANE_LENGTH 3
189 enum menu_item_idx
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
202 static Lisp_Object menu_items;
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;
208 /* Number of slots currently allocated in menu_items. */
209 static int menu_items_allocated;
211 /* This is the index in menu_items of the first empty slot. */
212 static int menu_items_used;
214 /* The number of panes currently recorded in menu_items,
215 excluding those within submenus. */
216 static int menu_items_n_panes;
218 /* Current depth within submenus. */
219 static int menu_items_submenu_depth;
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;
225 static int next_menubar_widget_id;
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.
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>. */
234 int pending_menu_activation;
236 #ifdef USE_X_TOOLKIT
238 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
240 static struct frame *
241 menubar_id_to_frame (id)
242 LWLIB_ID id;
244 Lisp_Object tail, frame;
245 FRAME_PTR f;
247 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
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;
258 return 0;
261 #endif
263 /* Initialize the menu_items structure if we haven't already done so.
264 Also mark it as currently empty. */
266 static void
267 init_menu_items ()
269 if (NILP (menu_items))
271 menu_items_allocated = 60;
272 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
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;
283 /* Call at the end of generating the data in menu_items. */
285 static void
286 finish_menu_items ()
290 static Lisp_Object
291 unuse_menu_items (dummy)
292 Lisp_Object dummy;
294 return menu_items_inuse = Qnil;
297 /* Call when finished using the data for the current menu
298 in menu_items. */
300 static void
301 discard_menu_items ()
303 /* Free the structure if it is especially large.
304 Otherwise, hold on to it, to save time. */
305 if (menu_items_allocated > 200)
307 menu_items = Qnil;
308 menu_items_allocated = 0;
310 xassert (NILP (menu_items_inuse));
313 /* Make the menu_items vector twice as large. */
315 static void
316 grow_menu_items ()
318 Lisp_Object old;
319 int old_size = menu_items_allocated;
320 old = menu_items;
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));
328 /* Begin a submenu. */
330 static void
331 push_submenu_start ()
333 if (menu_items_used + 1 > menu_items_allocated)
334 grow_menu_items ();
336 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
337 menu_items_submenu_depth++;
340 /* End a submenu. */
342 static void
343 push_submenu_end ()
345 if (menu_items_used + 1 > menu_items_allocated)
346 grow_menu_items ();
348 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
349 menu_items_submenu_depth--;
352 /* Indicate boundary between left and right. */
354 static void
355 push_left_right_boundary ()
357 if (menu_items_used + 1 > menu_items_allocated)
358 grow_menu_items ();
360 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
363 /* Start a new menu pane in menu_items.
364 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
366 static void
367 push_menu_pane (name, prefix_vec)
368 Lisp_Object name, prefix_vec;
370 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
371 grow_menu_items ();
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;
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'. */
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;
392 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
393 grow_menu_items ();
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;
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. */
410 static void
411 keymap_panes (keymaps, nmaps, notreal)
412 Lisp_Object *keymaps;
413 int nmaps;
414 int notreal;
416 int mapno;
418 init_menu_items ();
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);
427 finish_menu_items ();
430 /* Args passed between single_keymap_panes and single_menu_item. */
431 struct skp
433 Lisp_Object pending_maps;
434 int maxdepth, notreal;
435 int notbuttons;
438 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
439 void *));
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.
448 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
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;
458 struct skp skp;
459 struct gcpro gcpro1;
461 skp.pending_maps = Qnil;
462 skp.maxdepth = maxdepth;
463 skp.notreal = notreal;
464 skp.notbuttons = 0;
466 if (maxdepth <= 0)
467 return;
469 push_menu_pane (pane_name, prefix);
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
479 GCPRO1 (skp.pending_maps);
480 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
481 UNGCPRO;
483 /* Process now any submenus which want to be panes at this level. */
484 while (CONSP (skp.pending_maps))
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);
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. */
510 static void
511 single_menu_item (key, item, dummy, skp_v)
512 Lisp_Object key, item, dummy;
513 void *skp_v;
515 Lisp_Object map, item_string, enabled;
516 struct gcpro gcpro1, gcpro2;
517 int res;
518 struct skp *skp = skp_v;
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. */
527 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
529 if (skp->notreal)
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;
538 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
539 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
541 if (!NILP (map) && SREF (item_string, 0) == '@')
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;
550 #ifndef HAVE_BOXES
551 /* Simulate radio buttons and toggle boxes by putting a prefix in
552 front of them. */
554 Lisp_Object prefix = Qnil;
555 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
556 if (!NILP (type))
558 Lisp_Object selected
559 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
561 if (skp->notbuttons)
562 /* The first button. Line up previous items in this menu. */
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)
570 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
571 if (NILP (tem))
573 index++;
574 submenu++; /* Skip sub menu. */
576 else if (EQ (tem, Qlambda))
578 index++;
579 submenu--; /* End sub menu. */
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
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;
594 skp->notbuttons = 0;
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) ? "( ) " : "(*) ");
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 (" ");
608 if (!NILP (prefix))
609 item_string = concat2 (prefix, item_string);
611 #endif /* not HAVE_BOXES */
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
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]);
626 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
627 /* Display a submenu using the toolkit. */
628 if (! (NILP (map) || NILP (enabled)))
630 push_submenu_start ();
631 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
632 push_submenu_end ();
634 #endif
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. */
641 static void
642 list_of_panes (menu)
643 Lisp_Object menu;
645 Lisp_Object tail;
647 init_menu_items ();
649 for (tail = menu; CONSP (tail); tail = XCDR (tail))
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);
661 finish_menu_items ();
664 /* Push the items in a single pane defined by the alist PANE. */
666 static void
667 list_of_items (pane)
668 Lisp_Object pane;
670 Lisp_Object tail, item, item1;
672 for (tail = pane; CONSP (tail); tail = XCDR (tail))
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))
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);
685 else
686 push_left_right_boundary ();
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;
705 Window root, dummy_window;
706 int dummy;
708 BLOCK_INPUT;
710 XQueryPointer (FRAME_X_DISPLAY (f),
711 DefaultRootWindow (FRAME_X_DISPLAY (f)),
713 /* The root window which contains the pointer. */
714 &root,
716 /* Window pointer is on, not used */
717 &dummy_window,
719 /* The position on that root window. */
720 x, y,
722 /* x/y in dummy_window coordinates, not used. */
723 &dummy, &dummy,
725 /* Modifier keys and pointer buttons, about which
726 we don't care. */
727 (unsigned int *) &dummy);
729 UNBLOCK_INPUT;
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);
737 #endif /* HAVE_X_WINDOWS */
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.
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.
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.
757 You can also use a list of keymaps as MENU.
758 Then each keymap makes a separate pane.
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.
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.
773 If POSITION is nil, don't display the menu at all, just precalculate the
774 cached information about equivalent key sequences.
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;
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;
797 #ifdef HAVE_MENUS
798 if (! NILP (position))
800 int get_current_pos_p = 0;
801 check_x ();
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))))
808 get_current_pos_p = 1;
810 else
812 tem = Fcar (position);
813 if (CONSP (tem))
815 window = Fcar (Fcdr (position));
816 x = XCAR (tem);
817 y = Fcar (XCDR (tem));
819 else
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);
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;
838 if (get_current_pos_p)
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)
848 int cur_x, cur_y;
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);
856 #else /* not HAVE_X_WINDOWS */
857 Lisp_Object bar_window;
858 enum scroll_bar_part part;
859 unsigned long time;
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 */
866 if (new_f != 0)
867 XSETFRAME (window, new_f);
868 else
870 window = selected_window;
871 XSETFASTINT (x, 0);
872 XSETFASTINT (y, 0);
876 CHECK_NUMBER (x);
877 CHECK_NUMBER (y);
879 /* Decode where to put the menu. */
881 if (FRAMEP (window))
883 f = XFRAME (window);
884 xpos = 0;
885 ypos = 0;
887 else if (WINDOWP (window))
889 CHECK_LIVE_WINDOW (window);
890 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
892 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
893 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
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);
900 xpos += XINT (x);
901 ypos += XINT (y);
903 Vmenu_updating_frame = Qnil;
904 #endif /* HAVE_MENUS */
906 record_unwind_protect (unuse_menu_items, Qnil);
907 title = Qnil;
908 GCPRO1 (title);
910 /* Decode the menu items from what was specified. */
912 keymap = get_keymap (menu, 0, 0);
913 if (CONSP (keymap))
915 /* We were given a keymap. Extract menu info from the keymap. */
916 Lisp_Object prompt;
918 /* Extract the detailed info to make one pane. */
919 keymap_panes (&menu, 1, NILP (position));
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;
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;
931 keymaps = 1;
933 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
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;
941 title = Qnil;
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))
947 Lisp_Object prompt;
949 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
951 prompt = Fkeymap_prompt (keymap);
952 if (NILP (title) && !NILP (prompt))
953 title = prompt;
956 /* Extract the detailed info to make one pane. */
957 keymap_panes (maps, nmaps, NILP (position));
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;
963 keymaps = 1;
965 else
967 /* We were given an old-fashioned menu. */
968 title = Fcar (menu);
969 CHECK_STRING (title);
971 list_of_panes (Fcdr (menu));
973 keymaps = 0;
976 unbind_to (specpdl_count, Qnil);
978 if (NILP (position))
980 discard_menu_items ();
981 UNGCPRO;
982 return Qnil;
985 #ifdef HAVE_MENUS
986 /* Display them in a menu. */
987 BLOCK_INPUT;
989 selection = xmenu_show (f, xpos, ypos, for_click,
990 keymaps, title, &error_name);
991 UNBLOCK_INPUT;
993 discard_menu_items ();
995 UNGCPRO;
996 #endif /* HAVE_MENUS */
998 if (error_name) error (error_name);
999 return selection;
1002 #ifdef HAVE_MENUS
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.
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.
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.)
1021 If HEADER is non-nil, the frame title for the box is "Information",
1022 otherwise it is "Question".
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;
1030 FRAME_PTR f = NULL;
1031 Lisp_Object window;
1033 check_x ();
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))))
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;
1048 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1050 if (new_f != 0)
1051 XSETFRAME (window, new_f);
1052 else
1053 window = selected_window;
1054 #endif
1055 window = selected_window;
1057 else if (CONSP (position))
1059 Lisp_Object tem;
1060 tem = Fcar (position);
1061 if (CONSP (tem))
1062 window = Fcar (Fcdr (position));
1063 else
1065 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1066 window = Fcar (tem); /* POSN_WINDOW (tem) */
1069 else if (WINDOWP (position) || FRAMEP (position))
1070 window = position;
1071 else
1072 window = Qnil;
1074 /* Decode where to put the menu. */
1076 if (FRAMEP (window))
1077 f = XFRAME (window);
1078 else if (WINDOWP (window))
1080 CHECK_LIVE_WINDOW (window);
1081 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
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);
1088 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
1089 /* Display a menu with these alternatives
1090 in the middle of frame F. */
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));
1098 return Fx_popup_menu (newpos,
1099 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1101 #else
1103 Lisp_Object title;
1104 char *error_name;
1105 Lisp_Object selection;
1106 int specpdl_count = SPECPDL_INDEX ();
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);
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));
1119 list_of_panes (Fcons (contents, Qnil));
1121 /* Display them in a dialog box. */
1122 BLOCK_INPUT;
1123 selection = xdialog_show (f, 0, title, header, &error_name);
1124 UNBLOCK_INPUT;
1126 unbind_to (specpdl_count, Qnil);
1127 discard_menu_items ();
1129 if (error_name) error (error_name);
1130 return selection;
1132 #endif
1136 #ifndef MSDOS
1138 /* Set menu_items_inuse so no other popup menu or dialog is created. */
1140 void
1141 x_menu_set_in_use (in_use)
1142 int in_use;
1144 menu_items_inuse = in_use ? Qt : Qnil;
1145 popup_activated_flag = in_use;
1148 /* Wait for an X event to arrive or for a timer to expire. */
1150 void
1151 x_menu_wait_for_event (void *data)
1153 extern EMACS_TIME timer_check P_ ((int));
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. */
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
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;
1177 FD_ZERO (&read_fds);
1178 for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
1180 int fd = ConnectionNumber (dpyinfo->display);
1181 FD_SET (fd, &read_fds);
1182 if (fd > n) n = fd;
1185 if (secs < 0 || (secs == 0 && usecs == 0))
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);
1193 select (n + 1, &read_fds, (SELECT_TYPE *)0, (SELECT_TYPE *)0, &next_time);
1196 #endif /* ! MSDOS */
1199 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1201 #ifdef USE_X_TOOLKIT
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.
1207 NOTE: All calls to popup_get_selection should be protected
1208 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
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;
1217 XEvent event;
1219 while (popup_activated_flag)
1221 if (initial_event)
1223 event = *initial_event;
1224 initial_event = 0;
1226 else
1228 if (do_timers) x_menu_wait_for_event (0);
1229 XtAppNextEvent (Xt_app_con, &event);
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)
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
1250 /* Pop down on C-g and Escape. */
1251 else if (event.type == KeyPress
1252 && dpyinfo->display == event.xbutton.display)
1254 KeySym keysym = XLookupKeysym (&event.xkey, 0);
1256 if ((keysym == XK_g && (event.xkey.state & ControlMask) != 0)
1257 || keysym == XK_Escape) /* Any escape, ignore modifiers. */
1258 popup_activated_flag = 0;
1261 x_dispatch_event (&event, event.xany.display);
1265 #endif /* USE_X_TOOLKIT */
1267 #ifdef USE_GTK
1268 /* Loop util popup_activated_flag is set to zero in a callback.
1269 Used for popup menus and dialogs. */
1271 static void
1272 popup_widget_loop (do_timers, widget)
1273 int do_timers;
1274 GtkWidget *widget;
1276 ++popup_activated_flag;
1278 /* Process events in the Gtk event loop until done. */
1279 while (popup_activated_flag)
1281 if (do_timers) x_menu_wait_for_event (0);
1282 gtk_main_iteration ();
1285 #endif
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.
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.
1295 But first we recompute the menu bar contents (the whole tree).
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. */
1301 void
1302 x_activate_menubar (f)
1303 FRAME_PTR f;
1305 if (!f->output_data.x->saved_menu_event->type)
1306 return;
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
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
1329 /* Ignore this if we get it a second time. */
1330 f->output_data.x->saved_menu_event->type = 0;
1333 /* Detect if a dialog or menu has been posted. */
1336 popup_activated ()
1338 return popup_activated_flag;
1341 /* This callback is invoked when the user selects a menubar cascade
1342 pushbutton, but before the pulldown menu is posted. */
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;
1351 popup_activated_flag = 1;
1353 #endif
1355 /* This callback is invoked when a dialog or menu is finished being
1356 used and has been unposted. */
1358 #ifdef USE_GTK
1359 static void
1360 popup_deactivate_callback (widget, client_data)
1361 GtkWidget *widget;
1362 gpointer client_data;
1364 popup_activated_flag = 0;
1366 #else
1367 static void
1368 popup_deactivate_callback (widget, id, client_data)
1369 Widget widget;
1370 LWLIB_ID id;
1371 XtPointer client_data;
1373 popup_activated_flag = 0;
1375 #endif
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;
1387 Lisp_Object frame;
1389 if (f)
1391 XSETFRAME (frame, f);
1392 kbd_buffer_store_help_event (frame, help);
1394 else
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;
1402 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
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;
1410 #endif
1411 show_help_echo (help, Qnil, Qnil, Qnil, 1);
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. */
1421 #ifdef USE_GTK
1422 void
1423 menu_highlight_callback (widget, call_data)
1424 GtkWidget *widget;
1425 gpointer call_data;
1427 xg_menu_item_cb_data *cb_data;
1428 Lisp_Object help;
1430 cb_data = (xg_menu_item_cb_data*) g_object_get_data (G_OBJECT (widget),
1431 XG_ITEM_DATA);
1432 if (! cb_data) return;
1434 help = call_data ? cb_data->help : Qnil;
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);
1442 #else
1443 void
1444 menu_highlight_callback (widget, id, call_data)
1445 Widget widget;
1446 LWLIB_ID id;
1447 void *call_data;
1449 struct frame *f;
1450 Lisp_Object help;
1452 widget_value *wv = (widget_value *) call_data;
1454 help = wv ? wv->help : Qnil;
1456 /* Determine the frame for the help event. */
1457 f = menubar_id_to_frame (id);
1459 show_help_event (f, widget, help);
1461 #endif
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. */
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;
1475 Lisp_Object prefix, entry;
1476 Lisp_Object *subprefix_stack;
1477 int submenu_depth = 0;
1478 int i;
1480 entry = Qnil;
1481 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
1482 prefix = Qnil;
1483 i = 0;
1485 while (i < menu_bar_items_used)
1487 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1489 subprefix_stack[submenu_depth++] = prefix;
1490 prefix = entry;
1491 i++;
1493 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1495 prefix = subprefix_stack[--submenu_depth];
1496 i++;
1498 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1500 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1501 i += MENU_ITEMS_PANE_LENGTH;
1503 else
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)
1510 int j;
1511 struct input_event buf;
1512 Lisp_Object frame;
1513 EVENT_INIT (buf);
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);
1521 for (j = 0; j < submenu_depth; j++)
1522 if (!NILP (subprefix_stack[j]))
1524 buf.kind = MENU_BAR_EVENT;
1525 buf.frame_or_window = frame;
1526 buf.arg = subprefix_stack[j];
1527 kbd_buffer_store_event (&buf);
1530 if (!NILP (prefix))
1532 buf.kind = MENU_BAR_EVENT;
1533 buf.frame_or_window = frame;
1534 buf.arg = prefix;
1535 kbd_buffer_store_event (&buf);
1538 buf.kind = MENU_BAR_EVENT;
1539 buf.frame_or_window = frame;
1540 buf.arg = entry;
1541 kbd_buffer_store_event (&buf);
1543 return;
1545 i += MENU_ITEMS_ITEM_LENGTH;
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.
1556 static int xg_crazy_callback_abort;
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;
1567 xg_menu_item_cb_data *cb_data = (xg_menu_item_cb_data*) client_data;
1569 if (xg_crazy_callback_abort)
1570 return;
1572 if (! cb_data || ! cb_data->cl_data || ! cb_data->cl_data->f)
1573 return;
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. */
1581 BLOCK_INPUT;
1582 while (gtk_events_pending ())
1583 gtk_main_iteration ();
1584 UNBLOCK_INPUT;
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);
1592 #else /* not USE_GTK */
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;
1604 FRAME_PTR f;
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);
1612 #endif /* not USE_GTK */
1614 /* Allocate a widget_value, blocking input. */
1616 widget_value *
1617 xmalloc_widget_value ()
1619 widget_value *value;
1621 BLOCK_INPUT;
1622 value = malloc_widget_value ();
1623 UNBLOCK_INPUT;
1625 return value;
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. */
1633 void
1634 free_menubar_widget_value_tree (wv)
1635 widget_value *wv;
1637 if (! wv) return;
1639 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1641 if (wv->contents && (wv->contents != (widget_value*)1))
1643 free_menubar_widget_value_tree (wv->contents);
1644 wv->contents = (widget_value *) 0xDEADBEEF;
1646 if (wv->next)
1648 free_menubar_widget_value_tree (wv->next);
1649 wv->next = (widget_value *) 0xDEADBEEF;
1651 BLOCK_INPUT;
1652 free_widget_value (wv);
1653 UNBLOCK_INPUT;
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. */
1660 static int
1661 parse_single_submenu (item_key, item_name, maps)
1662 Lisp_Object item_key, item_name, maps;
1664 Lisp_Object length;
1665 int len;
1666 Lisp_Object *mapvec;
1667 int i;
1668 int top_level_items = 0;
1670 length = Flength (maps);
1671 len = XINT (length);
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++)
1677 mapvec[i] = Fcar (maps);
1678 maps = Fcdr (maps);
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++)
1685 if (!KEYMAPP (mapvec[i]))
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);
1694 else
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);
1704 return top_level_items;
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. */
1711 static widget_value *
1712 digest_single_submenu (start, end, top_level_items)
1713 int start, end, top_level_items;
1715 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1716 int i;
1717 int submenu_depth = 0;
1718 widget_value **submenu_stack;
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;
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)
1739 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1741 submenu_stack[submenu_depth++] = save_wv;
1742 save_wv = prev_wv;
1743 prev_wv = 0;
1744 i++;
1746 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1748 prev_wv = save_wv;
1749 save_wv = submenu_stack[--submenu_depth];
1750 i++;
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))
1761 /* Create a new pane. */
1762 Lisp_Object pane_name, prefix;
1763 char *pane_string;
1765 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1766 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1768 #ifndef HAVE_MULTILINGUAL_MENU
1769 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1771 pane_name = ENCODE_MENU_STRING (pane_name);
1772 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
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 = "";
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, ""))
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;
1799 save_wv = wv;
1800 prev_wv = 0;
1801 i += MENU_ITEMS_PANE_LENGTH;
1803 else
1805 /* Create a new item within current pane. */
1806 Lisp_Object item_name, enable, descrip, def, type, selected;
1807 Lisp_Object help;
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);
1817 #ifndef HAVE_MULTILINGUAL_MENU
1818 if (STRING_MULTIBYTE (item_name))
1820 item_name = ENCODE_MENU_STRING (item_name);
1821 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1824 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1826 descrip = ENCODE_MENU_STRING (descrip);
1827 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1829 #endif /* not HAVE_MULTILINGUAL_MENU */
1831 wv = xmalloc_widget_value ();
1832 if (prev_wv)
1833 prev_wv->next = wv;
1834 else
1835 save_wv->contents = wv;
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);
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 ();
1855 wv->selected = !NILP (selected);
1856 if (! STRINGP (help))
1857 help = Qnil;
1859 wv->help = help;
1861 prev_wv = wv;
1863 i += MENU_ITEMS_ITEM_LENGTH;
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)
1871 wv = first_wv->contents;
1872 free_widget_value (first_wv);
1873 return wv;
1876 return first_wv;
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;
1888 widget_value *wv;
1890 for (wv = first_wv; wv; wv = wv->next)
1892 if (STRINGP (wv->lname))
1894 wv->name = SDATA (wv->lname);
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)
1900 if (wv->name[0] == '@')
1901 wv->name++;
1902 wv->value = 0;
1906 if (STRINGP (wv->lkey))
1907 wv->key = SDATA (wv->lkey);
1909 if (wv->contents)
1910 update_submenu_strings (wv->contents);
1915 /* Recompute all the widgets of frame F, when the menu bar has been
1916 changed. Value is non-zero if widgets were updated. */
1918 static int
1919 update_frame_menubar (f)
1920 FRAME_PTR f;
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;
1928 if (!x->menubar_widget || XtIsManaged (x->menubar_widget))
1929 return 0;
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);
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);
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);
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);
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);
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;
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. */
1967 void
1968 set_frame_menubar (f, first_time, deep_p)
1969 FRAME_PTR f;
1970 int first_time;
1971 int deep_p;
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;
1984 XSETFRAME (Vmenu_updating_frame, f);
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
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)
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;
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
2010 if (deep_p)
2012 /* Make a widget-value tree representing the entire menu trees. */
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));
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;
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);
2033 record_unwind_save_match_data ();
2034 record_unwind_protect (unuse_menu_items, Qnil);
2035 if (NILP (Voverriding_local_map_menu_flag))
2037 specbind (Qoverriding_terminal_local_map, Qnil);
2038 specbind (Qoverriding_local_map, Qnil);
2041 set_buffer_internal_1 (XBUFFER (buffer));
2043 /* Run the Lucid hook. */
2044 safe_run_hooks (Qactivate_menubar_hook);
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));
2053 items = FRAME_MENU_BAR_ITEMS (f);
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));
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)
2072 Lisp_Object key, string, maps;
2074 last_i = i;
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;
2082 submenu_start[i] = menu_items_used;
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;
2089 submenu_end[i] = menu_items_used;
2092 finish_menu_items ();
2094 /* Convert menu_items into widget_value trees
2095 to display the menu. This cannot evaluate Lisp code. */
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;
2105 for (i = 0; i < last_i; i += 4)
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;
2120 set_buffer_internal_1 (prev);
2121 unbind_to (specpdl_count, Qnil);
2123 /* If there has been no change in the Lisp-level contents
2124 of the menu bar, skip redisplaying it. Just exit. */
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)
2132 free_menubar_widget_value_tree (first_wv);
2133 discard_menu_items ();
2135 return;
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)
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;
2152 f->menu_bar_vector = menu_items;
2153 f->menu_bar_items_used = menu_items_used;
2154 discard_menu_items ();
2156 else
2158 /* Make a widget-value tree containing
2159 just the top level menu bar strings. */
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;
2169 items = FRAME_MENU_BAR_ITEMS (f);
2170 for (i = 0; i < XVECTOR (items)->size; i += 4)
2172 Lisp_Object string;
2174 string = XVECTOR (items)->contents[i + 1];
2175 if (NILP (string))
2176 break;
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);
2190 if (prev_wv)
2191 prev_wv->next = wv;
2192 else
2193 first_wv->contents = wv;
2194 prev_wv = wv;
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;
2203 /* Create or update the menu bar widget. */
2205 BLOCK_INPUT;
2207 #ifdef USE_GTK
2208 xg_crazy_callback_abort = 1;
2209 if (menubar_widget)
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,
2215 first_wv,
2216 deep_p,
2217 G_CALLBACK (menubar_selection_callback),
2218 G_CALLBACK (popup_deactivate_callback),
2219 G_CALLBACK (menu_highlight_callback));
2221 else
2223 GtkWidget *wvbox = f->output_data.x->vbox_widget;
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));
2231 f->output_data.x->menubar_widget = menubar_widget;
2235 #else /* not USE_GTK */
2236 if (menubar_widget)
2238 /* Disable resizing (done for Motif!) */
2239 lw_allow_resizing (f->output_data.x->widget, False);
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);
2245 /* Re-enable the edit widget to resize. */
2246 lw_allow_resizing (f->output_data.x->widget, True);
2248 else
2250 char menuOverride[] = "Ctrl<KeyPress>g: MenuGadgetEscape()";
2251 XtTranslations override = XtParseTranslationTable (menuOverride);
2253 menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv,
2254 f->output_data.x->column_widget,
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;
2262 /* Make menu pop down on C-g. */
2263 XtOverrideTranslations (menubar_widget, override);
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);
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))
2278 Dimension ibw = 0;
2279 XtVaGetValues (f->output_data.x->column_widget,
2280 XtNinternalBorderWidth, &ibw, NULL);
2281 menubar_size += ibw;
2283 #endif /* USE_LUCID */
2284 #endif /* 0 */
2286 f->output_data.x->menubar_height = menubar_size;
2288 #endif /* not USE_GTK */
2290 free_menubar_widget_value_tree (first_wv);
2291 update_frame_menubar (f);
2293 #ifdef USE_GTK
2294 xg_crazy_callback_abort = 0;
2295 #endif
2297 UNBLOCK_INPUT;
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. */
2305 void
2306 initialize_frame_menubar (f)
2307 FRAME_PTR f;
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);
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. */
2320 #ifndef USE_GTK
2321 void
2322 free_frame_menubar (f)
2323 FRAME_PTR f;
2325 Widget menubar_widget;
2327 menubar_widget = f->output_data.x->menubar_widget;
2329 f->output_data.x->menubar_height = 0;
2331 if (menubar_widget)
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
2345 BLOCK_INPUT;
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
2352 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
2353 f->output_data.x->menubar_widget = NULL;
2355 #ifdef USE_MOTIF
2356 if (f->output_data.x->widget)
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);
2362 #endif
2364 UNBLOCK_INPUT;
2367 #endif /* not USE_GTK */
2369 #endif /* USE_X_TOOLKIT || USE_GTK */
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. */
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.) */
2387 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
2389 /* The item selected in the popup menu. */
2390 static Lisp_Object *volatile menu_item_selection;
2392 #ifdef USE_GTK
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
2398 FRAME_PTR f;
2399 int x;
2400 int y;
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.
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;
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;
2426 *x = data->x;
2427 *y = data->y;
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;
2438 static void
2439 popup_selection_callback (widget, client_data)
2440 GtkWidget *widget;
2441 gpointer client_data;
2443 xg_menu_item_cb_data *cb_data = (xg_menu_item_cb_data*) client_data;
2445 if (xg_crazy_callback_abort) return;
2446 if (cb_data) menu_item_selection = (Lisp_Object *) cb_data->call_data;
2449 static Lisp_Object
2450 pop_down_menu (arg)
2451 Lisp_Object arg;
2453 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
2455 popup_activated_flag = 0;
2456 BLOCK_INPUT;
2457 gtk_widget_destroy (GTK_WIDGET (p->pointer));
2458 UNBLOCK_INPUT;
2459 return Qnil;
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;
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 ();
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;
2486 if (! for_click)
2488 /* Not invoked by a click. pop up at x/y. */
2489 pos_func = menu_position_func;
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);
2495 popup_x_y.x = x;
2496 popup_x_y.y = y;
2497 popup_x_y.f = f;
2499 i = 0; /* gtk_menu_popup needs this to be 0 for a non-button popup. */
2501 else
2503 for (i = 0; i < 5; i++)
2504 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2505 break;
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);
2512 record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
2514 if (GTK_WIDGET_MAPPED (menu))
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);
2523 unbind_to (specpdl_count, Qnil);
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;
2530 #else /* not USE_GTK */
2532 /* We need a unique id for each widget handled by the Lucid Widget
2533 library.
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.
2538 For menu bars, we use numbers starting at 0, counted in
2539 next_menubar_widget_id. */
2540 LWLIB_ID widget_id_tick;
2542 static void
2543 popup_selection_callback (widget, id, client_data)
2544 Widget widget;
2545 LWLIB_ID id;
2546 XtPointer client_data;
2548 menu_item_selection = (Lisp_Object *) client_data;
2551 /* ARG is the LWLIB ID of the dialog box, represented
2552 as a Lisp object as (HIGHPART . LOWPART). */
2554 static Lisp_Object
2555 pop_down_menu (arg)
2556 Lisp_Object arg;
2558 LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID)
2559 | XINT (XCDR (arg)));
2561 BLOCK_INPUT;
2562 lw_destroy_all_widgets (id);
2563 UNBLOCK_INPUT;
2564 popup_activated_flag = 0;
2566 return Qnil;
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;
2580 int i;
2581 Arg av[2];
2582 int ac = 0;
2583 XButtonPressedEvent dummy;
2584 LWLIB_ID menu_id;
2585 Widget menu;
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);
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;
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);
2609 dummy.x_root = x;
2610 dummy.y_root = y;
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;
2618 /* Don't allow any geometry request from the user. */
2619 XtSetArg (av[ac], XtNgeometry, 0); ac++;
2620 XtSetValues (menu, av, ac);
2622 /* Display the menu. */
2623 lw_popup_menu (menu, (XEvent *) &dummy);
2624 popup_activated_flag = 1;
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)))));
2633 /* Process events that apply to the menu. */
2634 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 1);
2636 unbind_to (specpdl_count, Qnil);
2640 #endif /* not USE_GTK */
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;
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;
2660 int first_pane;
2662 *error = NULL;
2664 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2666 *error = "Empty menu";
2667 return Qnil;
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;
2681 /* Loop over all panes and items, filling in the tree. */
2682 i = 0;
2683 while (i < menu_items_used)
2685 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2687 submenu_stack[submenu_depth++] = save_wv;
2688 save_wv = prev_wv;
2689 prev_wv = 0;
2690 first_pane = 1;
2691 i++;
2693 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2695 prev_wv = save_wv;
2696 save_wv = submenu_stack[--submenu_depth];
2697 first_pane = 0;
2698 i++;
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))
2709 /* Create a new pane. */
2710 Lisp_Object pane_name, prefix;
2711 char *pane_string;
2713 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2714 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2716 #ifndef HAVE_MULTILINGUAL_MENU
2717 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
2719 pane_name = ENCODE_MENU_STRING (pane_name);
2720 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
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 = "";
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, ""))
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;
2750 else if (first_pane)
2752 save_wv = wv;
2753 prev_wv = 0;
2755 first_pane = 0;
2756 i += MENU_ITEMS_PANE_LENGTH;
2758 else
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);
2770 #ifndef HAVE_MULTILINGUAL_MENU
2771 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
2773 item_name = ENCODE_MENU_STRING (item_name);
2774 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
2777 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
2779 descrip = ENCODE_MENU_STRING (descrip);
2780 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
2782 #endif /* not HAVE_MULTILINGUAL_MENU */
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);
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 ();
2809 wv->selected = !NILP (selected);
2811 if (! STRINGP (help))
2812 help = Qnil;
2814 wv->help = help;
2816 prev_wv = wv;
2818 i += MENU_ITEMS_ITEM_LENGTH;
2822 /* Deal with the title, if it is non-nil. */
2823 if (!NILP (title))
2825 widget_value *wv_title = xmalloc_widget_value ();
2826 widget_value *wv_sep1 = xmalloc_widget_value ();
2827 widget_value *wv_sep2 = xmalloc_widget_value ();
2829 wv_sep2->name = "--";
2830 wv_sep2->next = first_wv->contents;
2831 wv_sep2->help = Qnil;
2833 wv_sep1->name = "--";
2834 wv_sep1->next = wv_sep2;
2835 wv_sep1->help = Qnil;
2837 #ifndef HAVE_MULTILINGUAL_MENU
2838 if (STRING_MULTIBYTE (title))
2839 title = ENCODE_MENU_STRING (title);
2840 #endif
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;
2850 /* No selection has been chosen yet. */
2851 menu_item_selection = 0;
2853 /* Actually create and show the menu until popped down. */
2854 create_and_show_popup_menu (f, first_wv, x, y, for_click);
2856 /* Free the widget_value objects we used to specify the contents. */
2857 free_menubar_widget_value_tree (first_wv);
2859 /* Find the selected item, and its pane, to return
2860 the proper value. */
2861 if (menu_item_selection != 0)
2863 Lisp_Object prefix, entry;
2865 prefix = entry = Qnil;
2866 i = 0;
2867 while (i < menu_items_used)
2869 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2871 subprefix_stack[submenu_depth++] = prefix;
2872 prefix = entry;
2873 i++;
2875 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2877 prefix = subprefix_stack[--submenu_depth];
2878 i++;
2880 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2882 prefix
2883 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2884 i += MENU_ITEMS_PANE_LENGTH;
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
2892 entry
2893 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2894 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2896 if (keymaps != 0)
2898 int j;
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);
2907 return entry;
2909 i += MENU_ITEMS_ITEM_LENGTH;
2913 else if (!for_click)
2914 /* Make "Cancel" equivalent to C-g. */
2915 Fsignal (Qquit, Qnil);
2917 return Qnil;
2920 #ifdef USE_GTK
2921 static void
2922 dialog_selection_callback (widget, client_data)
2923 GtkWidget *widget;
2924 gpointer client_data;
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;
2931 popup_activated_flag = 0;
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;
2942 GtkWidget *menu;
2944 menu = xg_create_widget ("dialog", first_wv->name, f, first_wv,
2945 G_CALLBACK (dialog_selection_callback),
2946 G_CALLBACK (popup_deactivate_callback),
2949 if (menu)
2951 int specpdl_count = SPECPDL_INDEX ();
2952 record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
2954 /* Display the menu. */
2955 gtk_widget_show_all (menu);
2957 /* Process events that apply to the menu. */
2958 popup_widget_loop (1, menu);
2960 unbind_to (specpdl_count, Qnil);
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;
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;
2976 BLOCK_INPUT;
2977 lw_destroy_all_widgets (id);
2978 UNBLOCK_INPUT;
2979 popup_activated_flag = 0;
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;
2991 LWLIB_ID dialog_id;
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);
2999 /* Display the dialog box. */
3000 lw_pop_up_all_widgets (dialog_id);
3001 popup_activated_flag = 1;
3003 /* Process events that apply to the dialog box.
3004 Also handle timers. */
3006 int count = SPECPDL_INDEX ();
3007 int fact = 4 * sizeof (LWLIB_ID);
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)))));
3014 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f),
3015 dialog_id, 1);
3017 unbind_to (count, Qnil);
3021 #endif /* not USE_GTK */
3023 static char * button_names [] = {
3024 "button1", "button2", "button3", "button4", "button5",
3025 "button6", "button7", "button8", "button9", "button10" };
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;
3034 int i, nb_buttons=0;
3035 char dialog_name[6];
3037 widget_value *wv, *first_wv = 0, *prev_wv = 0;
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;
3044 *error_name = NULL;
3046 if (menu_items_n_panes > 1)
3048 *error_name = "Multiple panes in dialog box";
3049 return Qnil;
3052 /* Create a tree of widget_value objects
3053 representing the text label and buttons. */
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;
3070 /* Loop over all panes and items, filling in the tree. */
3071 i = MENU_ITEMS_PANE_LENGTH;
3072 while (i < menu_items_used)
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];
3082 if (NILP (item_name))
3084 free_menubar_widget_value_tree (first_wv);
3085 *error_name = "Submenu in dialog items";
3086 return Qnil;
3088 if (EQ (item_name, Qquote))
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;
3096 if (nb_buttons >= 9)
3098 free_menubar_widget_value_tree (first_wv);
3099 *error_name = "Too many dialog items";
3100 return Qnil;
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;
3114 if (! boundary_seen)
3115 left_count++;
3117 nb_buttons++;
3118 i += MENU_ITEMS_ITEM_LENGTH;
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;
3126 wv = xmalloc_widget_value ();
3127 wv->name = dialog_name;
3128 wv->help = Qnil;
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';
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;
3151 /* No selection has been chosen yet. */
3152 menu_item_selection = 0;
3154 /* Actually create and show the dialog. */
3155 create_and_show_dialog (f, first_wv);
3157 /* Free the widget_value objects we used to specify the contents. */
3158 free_menubar_widget_value_tree (first_wv);
3160 /* Find the selected item, and its pane, to return
3161 the proper value. */
3162 if (menu_item_selection != 0)
3164 Lisp_Object prefix;
3166 prefix = Qnil;
3167 i = 0;
3168 while (i < menu_items_used)
3170 Lisp_Object entry;
3172 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3174 prefix
3175 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3176 i += MENU_ITEMS_PANE_LENGTH;
3178 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
3180 /* This is the boundary between left-side elts and
3181 right-side elts. */
3182 ++i;
3184 else
3186 entry
3187 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
3188 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
3190 if (keymaps != 0)
3192 entry = Fcons (entry, Qnil);
3193 if (!NILP (prefix))
3194 entry = Fcons (prefix, entry);
3196 return entry;
3198 i += MENU_ITEMS_ITEM_LENGTH;
3202 else
3203 /* Make "Cancel" equivalent to C-g. */
3204 Fsignal (Qquit, Qnil);
3206 return Qnil;
3209 #else /* not USE_X_TOOLKIT && not USE_GTK */
3211 /* The frame of the last activated non-toolkit menu bar.
3212 Used to generate menu help events. */
3214 static struct frame *menu_help_frame;
3217 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
3219 PANE is the pane number, and ITEM is the menu item number in
3220 the menu (currently not used).
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. */
3226 static void
3227 menu_help_callback (help_string, pane, item)
3228 char *help_string;
3229 int pane, item;
3231 extern Lisp_Object Qmenu_item;
3232 Lisp_Object *first_item;
3233 Lisp_Object pane_name;
3234 Lisp_Object menu_object;
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];
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);
3253 static Lisp_Object
3254 pop_down_menu (arg)
3255 Lisp_Object arg;
3257 struct Lisp_Save_Value *p1 = XSAVE_VALUE (Fcar (arg));
3258 struct Lisp_Save_Value *p2 = XSAVE_VALUE (Fcdr (arg));
3260 FRAME_PTR f = p1->pointer;
3261 XMenu *menu = p2->pointer;
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);
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));
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;
3281 #endif /* HAVE_X_WINDOWS */
3283 UNBLOCK_INPUT;
3285 return Qnil;
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;
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 ();
3311 *error = 0;
3312 if (menu_items_n_panes == 0)
3313 return Qnil;
3315 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
3317 *error = "Empty menu";
3318 return Qnil;
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);
3326 /* Make the menu on that window. */
3327 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
3328 if (menu == NULL)
3330 *error = "Can't create menu";
3331 return Qnil;
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 */
3340 /* Adjust coordinates to be root-window-relative. */
3341 x += f->left_pos;
3342 y += f->top_pos;
3344 /* Create all the necessary panes and their items. */
3345 maxlines = lines = i = 0;
3346 while (i < menu_items_used)
3348 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3350 /* Create a new pane. */
3351 Lisp_Object pane_name, prefix;
3352 char *pane_string;
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++;
3363 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
3364 if (lpane == XM_FAILURE)
3366 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3367 *error = "Can't create pane";
3368 return Qnil;
3370 i += MENU_ITEMS_PANE_LENGTH;
3372 /* Find the width of the widest item in this pane. */
3373 maxwidth = 0;
3374 j = i;
3375 while (j < menu_items_used)
3377 Lisp_Object item;
3378 item = XVECTOR (menu_items)->contents[j];
3379 if (EQ (item, Qt))
3380 break;
3381 if (NILP (item))
3383 j++;
3384 continue;
3386 width = SBYTES (item);
3387 if (width > maxwidth)
3388 maxwidth = width;
3390 j += MENU_ITEMS_ITEM_LENGTH;
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
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;
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;
3411 if (!NILP (descrip))
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
3435 else
3436 item_data = SDATA (item_name);
3438 if (XMenuAddSelection (FRAME_X_DISPLAY (f),
3439 menu, lpane, 0, item_data,
3440 !NILP (enable), help_string)
3441 == XM_FAILURE)
3443 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3444 *error = "Can't add selection to menu";
3445 return Qnil;
3447 i += MENU_ITEMS_ITEM_LENGTH;
3448 lines++;
3452 maxlines = max (maxlines, lines);
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)
3466 x -= (ulx + width) - dispwidth;
3467 ulx = dispwidth - width;
3469 if (uly+height > dispheight)
3471 y -= (uly + height) - dispheight;
3472 uly = dispheight - height;
3474 if (ulx < 0) x -= ulx;
3475 if (uly < 0) y -= uly;
3477 if (! for_click)
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);
3486 XMenuSetAEQ (menu, TRUE);
3487 XMenuSetFreeze (menu, TRUE);
3488 pane = selidx = 0;
3490 #ifndef MSDOS
3491 XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f));
3492 #endif
3494 record_unwind_protect (pop_down_menu,
3495 Fcons (make_save_value (f, 0),
3496 make_save_value (menu, 0)));
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);
3505 switch (status)
3507 case XM_SUCCESS:
3508 #ifdef XDEBUG
3509 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
3510 #endif
3512 /* Find the item number SELIDX in pane number PANE. */
3513 i = 0;
3514 while (i < menu_items_used)
3516 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
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;
3524 else
3526 if (pane == -1)
3528 if (selidx == 0)
3530 entry
3531 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
3532 if (keymaps != 0)
3534 entry = Fcons (entry, Qnil);
3535 if (!NILP (pane_prefix))
3536 entry = Fcons (pane_prefix, entry);
3538 break;
3540 selidx--;
3542 i += MENU_ITEMS_ITEM_LENGTH;
3545 break;
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;
3561 unbind_to (specpdl_count, Qnil);
3563 return entry;
3566 #endif /* not USE_X_TOOLKIT */
3568 #endif /* HAVE_MENUS */
3570 void
3571 syms_of_xmenu ()
3573 staticpro (&menu_items);
3574 menu_items = Qnil;
3575 menu_items_inuse = Qnil;
3577 Qdebug_on_next_call = intern ("debug-on-next-call");
3578 staticpro (&Qdebug_on_next_call);
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;
3585 #ifdef USE_X_TOOLKIT
3586 widget_id_tick = (1<<16);
3587 next_menubar_widget_id = 1;
3588 #endif
3590 defsubr (&Sx_popup_menu);
3591 #ifdef HAVE_MENUS
3592 defsubr (&Sx_popup_dialog);
3593 #endif
3596 /* arch-tag: 92ea573c-398e-496e-ac73-2436f7d63242
3597 (do not change this comment) */