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, 2006, 2007 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)
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. */
36 #if 0 /* Why was this included? And without syssignal.h? */
37 /* On 4.3 this loses if it comes after xterm.h. */
44 #include "termhooks.h"
49 #include "blockinput.h"
53 #include "sysselect.h"
60 /* This may include sys/types.h, and that somehow loses
61 if this is not done before the other system files. */
65 /* Load sys/types.h if not already loaded.
66 In some systems loading it twice is suicidal. */
68 #include <sys/types.h>
71 #include "dispextern.h"
74 /* Defining HAVE_MULTILINGUAL_MENU would mean that the toolkit menu
75 code accepts the Emacs internal encoding. */
76 #undef HAVE_MULTILINGUAL_MENU
80 #include <X11/IntrinsicP.h>
81 #include <X11/CoreP.h>
82 #include <X11/StringDefs.h>
83 #include <X11/Shell.h>
86 #include <X11/Xaw3d/Paned.h>
87 #else /* !HAVE_XAW3D */
88 #include <X11/Xaw/Paned.h>
89 #endif /* HAVE_XAW3D */
90 #endif /* USE_LUCID */
91 #include "../lwlib/lwlib.h"
92 #else /* not USE_X_TOOLKIT */
94 #include "../oldXMenu/XMenu.h"
96 #endif /* not USE_X_TOOLKIT */
97 #endif /* HAVE_X_WINDOWS */
104 Lisp_Object Qdebug_on_next_call
;
106 extern Lisp_Object Vmenu_updating_frame
;
108 extern Lisp_Object Qmenu_bar
;
110 extern Lisp_Object QCtoggle
, QCradio
;
112 extern Lisp_Object Voverriding_local_map
;
113 extern Lisp_Object Voverriding_local_map_menu_flag
;
115 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
117 extern Lisp_Object Qmenu_bar_update_hook
;
120 extern void set_frame_menubar
P_ ((FRAME_PTR
, int, int));
121 extern XtAppContext Xt_app_con
;
123 static Lisp_Object xdialog_show
P_ ((FRAME_PTR
, int, Lisp_Object
, Lisp_Object
,
125 static void popup_get_selection
P_ ((XEvent
*, struct x_display_info
*,
128 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
131 #endif /* USE_X_TOOLKIT */
136 extern void set_frame_menubar
P_ ((FRAME_PTR
, int, int));
137 static Lisp_Object xdialog_show
P_ ((FRAME_PTR
, int, Lisp_Object
, Lisp_Object
,
141 /* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU
142 isn't defined. The use of HAVE_MULTILINGUAL_MENU could probably be
143 confined to an extended version of this with sections of code below
144 using it unconditionally. */
146 /* gtk just uses utf-8. */
147 # define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
148 #elif defined HAVE_X_I18N
149 # define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
151 # define ENCODE_MENU_STRING(str) string_make_unibyte (str)
154 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
155 Lisp_Object
, Lisp_Object
, Lisp_Object
,
156 Lisp_Object
, Lisp_Object
));
157 static int update_frame_menubar
P_ ((struct frame
*));
158 static Lisp_Object xmenu_show
P_ ((struct frame
*, int, int, int, int,
159 Lisp_Object
, char **));
160 static void keymap_panes
P_ ((Lisp_Object
*, int, int));
161 static void single_keymap_panes
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
163 static void list_of_panes
P_ ((Lisp_Object
));
164 static void list_of_items
P_ ((Lisp_Object
));
167 /* This holds a Lisp vector that holds the results of decoding
168 the keymaps or alist-of-alists that specify a menu.
170 It describes the panes and items within the panes.
172 Each pane is described by 3 elements in the vector:
173 t, the pane name, the pane's prefix key.
174 Then follow the pane's items, with 5 elements per item:
175 the item string, the enable flag, the item's value,
176 the definition, and the equivalent keyboard key's description string.
178 In some cases, multiple levels of menus may be described.
179 A single vector slot containing nil indicates the start of a submenu.
180 A single vector slot containing lambda indicates the end of a submenu.
181 The submenu follows a menu item which is the way to reach the submenu.
183 A single vector slot containing quote indicates that the
184 following items should appear on the right of a dialog box.
186 Using a Lisp vector to hold this information while we decode it
187 takes care of protecting all the data from GC. */
189 #define MENU_ITEMS_PANE_NAME 1
190 #define MENU_ITEMS_PANE_PREFIX 2
191 #define MENU_ITEMS_PANE_LENGTH 3
195 MENU_ITEMS_ITEM_NAME
= 0,
196 MENU_ITEMS_ITEM_ENABLE
,
197 MENU_ITEMS_ITEM_VALUE
,
198 MENU_ITEMS_ITEM_EQUIV_KEY
,
199 MENU_ITEMS_ITEM_DEFINITION
,
200 MENU_ITEMS_ITEM_TYPE
,
201 MENU_ITEMS_ITEM_SELECTED
,
202 MENU_ITEMS_ITEM_HELP
,
203 MENU_ITEMS_ITEM_LENGTH
206 static Lisp_Object menu_items
;
208 /* If non-nil, means that the global vars defined here are already in use.
209 Used to detect cases where we try to re-enter this non-reentrant code. */
210 static Lisp_Object menu_items_inuse
;
212 /* Number of slots currently allocated in menu_items. */
213 static int menu_items_allocated
;
215 /* This is the index in menu_items of the first empty slot. */
216 static int menu_items_used
;
218 /* The number of panes currently recorded in menu_items,
219 excluding those within submenus. */
220 static int menu_items_n_panes
;
222 /* Current depth within submenus. */
223 static int menu_items_submenu_depth
;
225 /* Flag which when set indicates a dialog or menu has been posted by
226 Xt on behalf of one of the widget sets. */
227 static int popup_activated_flag
;
229 static int next_menubar_widget_id
;
231 /* This is set nonzero after the user activates the menu bar, and set
232 to zero again after the menu bars are redisplayed by prepare_menu_bar.
233 While it is nonzero, all calls to set_frame_menubar go deep.
235 I don't understand why this is needed, but it does seem to be
236 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
238 int pending_menu_activation
;
242 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
244 static struct frame
*
245 menubar_id_to_frame (id
)
248 Lisp_Object tail
, frame
;
251 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
254 if (!GC_FRAMEP (frame
))
257 if (!FRAME_WINDOW_P (f
))
259 if (f
->output_data
.x
->id
== id
)
267 /* Initialize the menu_items structure if we haven't already done so.
268 Also mark it as currently empty. */
273 if (!NILP (menu_items_inuse
))
274 error ("Trying to use a menu from within a menu-entry");
276 if (NILP (menu_items
))
278 menu_items_allocated
= 60;
279 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
282 menu_items_inuse
= Qt
;
284 menu_items_n_panes
= 0;
285 menu_items_submenu_depth
= 0;
288 /* Call at the end of generating the data in menu_items. */
296 unuse_menu_items (dummy
)
299 return menu_items_inuse
= Qnil
;
302 /* Call when finished using the data for the current menu
306 discard_menu_items ()
308 /* Free the structure if it is especially large.
309 Otherwise, hold on to it, to save time. */
310 if (menu_items_allocated
> 200)
313 menu_items_allocated
= 0;
315 xassert (NILP (menu_items_inuse
));
318 /* This undoes save_menu_items, and it is called by the specpdl unwind
322 restore_menu_items (saved
)
325 menu_items
= XCAR (saved
);
326 menu_items_inuse
= (! NILP (menu_items
) ? Qt
: Qnil
);
327 menu_items_allocated
= (VECTORP (menu_items
) ? ASIZE (menu_items
) : 0);
328 saved
= XCDR (saved
);
329 menu_items_used
= XINT (XCAR (saved
));
330 saved
= XCDR (saved
);
331 menu_items_n_panes
= XINT (XCAR (saved
));
332 saved
= XCDR (saved
);
333 menu_items_submenu_depth
= XINT (XCAR (saved
));
337 /* Push the whole state of menu_items processing onto the specpdl.
338 It will be restored when the specpdl is unwound. */
343 Lisp_Object saved
= list4 (!NILP (menu_items_inuse
) ? menu_items
: Qnil
,
344 make_number (menu_items_used
),
345 make_number (menu_items_n_panes
),
346 make_number (menu_items_submenu_depth
));
347 record_unwind_protect (restore_menu_items
, saved
);
348 menu_items_inuse
= Qnil
;
352 /* Make the menu_items vector twice as large. */
358 int old_size
= menu_items_allocated
;
361 menu_items_allocated
*= 2;
363 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
364 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
365 old_size
* sizeof (Lisp_Object
));
368 /* Begin a submenu. */
371 push_submenu_start ()
373 if (menu_items_used
+ 1 > menu_items_allocated
)
376 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
377 menu_items_submenu_depth
++;
385 if (menu_items_used
+ 1 > menu_items_allocated
)
388 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
389 menu_items_submenu_depth
--;
392 /* Indicate boundary between left and right. */
395 push_left_right_boundary ()
397 if (menu_items_used
+ 1 > menu_items_allocated
)
400 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
403 /* Start a new menu pane in menu_items.
404 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
407 push_menu_pane (name
, prefix_vec
)
408 Lisp_Object name
, prefix_vec
;
410 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
413 if (menu_items_submenu_depth
== 0)
414 menu_items_n_panes
++;
415 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
416 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
417 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
420 /* Push one menu item into the current pane. NAME is the string to
421 display. ENABLE if non-nil means this item can be selected. KEY
422 is the key generated by choosing this item, or nil if this item
423 doesn't really have a definition. DEF is the definition of this
424 item. EQUIV is the textual description of the keyboard equivalent
425 for this item (or nil if none). TYPE is the type of this menu
426 item, one of nil, `toggle' or `radio'. */
429 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
430 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
432 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
435 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
436 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
437 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
438 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
439 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
440 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
441 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
442 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
445 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
446 and generate menu panes for them in menu_items.
447 If NOTREAL is nonzero,
448 don't bother really computing whether an item is enabled. */
451 keymap_panes (keymaps
, nmaps
, notreal
)
452 Lisp_Object
*keymaps
;
460 /* Loop over the given keymaps, making a pane for each map.
461 But don't make a pane that is empty--ignore that map instead.
462 P is the number of panes we have made so far. */
463 for (mapno
= 0; mapno
< nmaps
; mapno
++)
464 single_keymap_panes (keymaps
[mapno
],
465 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
467 finish_menu_items ();
470 /* Args passed between single_keymap_panes and single_menu_item. */
473 Lisp_Object pending_maps
;
474 int maxdepth
, notreal
;
478 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
481 /* This is a recursive subroutine of keymap_panes.
482 It handles one keymap, KEYMAP.
483 The other arguments are passed along
484 or point to local variables of the previous function.
485 If NOTREAL is nonzero, only check for equivalent key bindings, don't
486 evaluate expressions in menu items and don't make any menu.
488 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
491 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
493 Lisp_Object pane_name
;
501 skp
.pending_maps
= Qnil
;
502 skp
.maxdepth
= maxdepth
;
503 skp
.notreal
= notreal
;
509 push_menu_pane (pane_name
, prefix
);
512 /* Remember index for first item in this pane so we can go back and
513 add a prefix when (if) we see the first button. After that, notbuttons
514 is set to 0, to mark that we have seen a button and all non button
515 items need a prefix. */
516 skp
.notbuttons
= menu_items_used
;
519 GCPRO1 (skp
.pending_maps
);
520 map_keymap (keymap
, single_menu_item
, Qnil
, &skp
, 1);
523 /* Process now any submenus which want to be panes at this level. */
524 while (CONSP (skp
.pending_maps
))
526 Lisp_Object elt
, eltcdr
, string
;
527 elt
= XCAR (skp
.pending_maps
);
529 string
= XCAR (eltcdr
);
530 /* We no longer discard the @ from the beginning of the string here.
531 Instead, we do this in xmenu_show. */
532 single_keymap_panes (Fcar (elt
), string
,
533 XCDR (eltcdr
), notreal
, maxdepth
- 1);
534 skp
.pending_maps
= XCDR (skp
.pending_maps
);
538 /* This is a subroutine of single_keymap_panes that handles one
540 KEY is a key in a keymap and ITEM is its binding.
541 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
543 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
544 evaluate expressions in menu items and don't make any menu.
545 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them.
546 SKP->NOTBUTTONS is only used when simulating toggle boxes and radio
547 buttons. It keeps track of if we have seen a button in this menu or
551 single_menu_item (key
, item
, dummy
, skp_v
)
552 Lisp_Object key
, item
, dummy
;
555 Lisp_Object map
, item_string
, enabled
;
556 struct gcpro gcpro1
, gcpro2
;
558 struct skp
*skp
= skp_v
;
560 /* Parse the menu item and leave the result in item_properties. */
562 res
= parse_menu_item (item
, skp
->notreal
, 0);
565 return; /* Not a menu item. */
567 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
571 /* We don't want to make a menu, just traverse the keymaps to
572 precompute equivalent key bindings. */
574 single_keymap_panes (map
, Qnil
, key
, 1, skp
->maxdepth
- 1);
578 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
579 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
581 if (!NILP (map
) && SREF (item_string
, 0) == '@')
584 /* An enabled separate pane. Remember this to handle it later. */
585 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
591 /* Simulate radio buttons and toggle boxes by putting a prefix in
594 Lisp_Object prefix
= Qnil
;
595 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
599 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
602 /* The first button. Line up previous items in this menu. */
604 int index
= skp
->notbuttons
; /* Index for first item this menu. */
607 while (index
< menu_items_used
)
610 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
614 submenu
++; /* Skip sub menu. */
616 else if (EQ (tem
, Qlambda
))
619 submenu
--; /* End sub menu. */
621 else if (EQ (tem
, Qt
))
622 index
+= 3; /* Skip new pane marker. */
623 else if (EQ (tem
, Qquote
))
624 index
++; /* Skip a left, right divider. */
627 if (!submenu
&& SREF (tem
, 0) != '\0'
628 && SREF (tem
, 0) != '-')
629 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
630 = concat2 (build_string (" "), tem
);
631 index
+= MENU_ITEMS_ITEM_LENGTH
;
637 /* Calculate prefix, if any, for this item. */
638 if (EQ (type
, QCtoggle
))
639 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
640 else if (EQ (type
, QCradio
))
641 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
643 /* Not a button. If we have earlier buttons, then we need a prefix. */
644 else if (!skp
->notbuttons
&& SREF (item_string
, 0) != '\0'
645 && SREF (item_string
, 0) != '-')
646 prefix
= build_string (" ");
649 item_string
= concat2 (prefix
, item_string
);
651 #endif /* not HAVE_BOXES */
653 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
655 /* Indicate visually that this is a submenu. */
656 item_string
= concat2 (item_string
, build_string (" >"));
659 push_menu_item (item_string
, enabled
, key
,
660 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
661 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
662 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
663 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
664 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
666 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
667 /* Display a submenu using the toolkit. */
668 if (! (NILP (map
) || NILP (enabled
)))
670 push_submenu_start ();
671 single_keymap_panes (map
, Qnil
, key
, 0, skp
->maxdepth
- 1);
677 /* Push all the panes and items of a menu described by the
678 alist-of-alists MENU.
679 This handles old-fashioned calls to x-popup-menu. */
689 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
691 Lisp_Object elt
, pane_name
, pane_data
;
693 pane_name
= Fcar (elt
);
694 CHECK_STRING (pane_name
);
695 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
696 pane_data
= Fcdr (elt
);
697 CHECK_CONS (pane_data
);
698 list_of_items (pane_data
);
701 finish_menu_items ();
704 /* Push the items in a single pane defined by the alist PANE. */
710 Lisp_Object tail
, item
, item1
;
712 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
716 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
717 Qnil
, Qnil
, Qnil
, Qnil
);
718 else if (CONSP (item
))
721 CHECK_STRING (item1
);
722 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
723 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
726 push_left_right_boundary ();
731 #ifdef HAVE_X_WINDOWS
732 /* Return the mouse position in *X and *Y. The coordinates are window
733 relative for the edit window in frame F.
734 This is for Fx_popup_menu. The mouse_position_hook can not
735 be used for X, as it returns window relative coordinates
736 for the window where the mouse is in. This could be the menu bar,
737 the scroll bar or the edit window. Fx_popup_menu needs to be
738 sure it is the edit window. */
740 mouse_position_for_popup (f
, x
, y
)
745 Window root
, dummy_window
;
750 XQueryPointer (FRAME_X_DISPLAY (f
),
751 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
753 /* The root window which contains the pointer. */
756 /* Window pointer is on, not used */
759 /* The position on that root window. */
762 /* x/y in dummy_window coordinates, not used. */
765 /* Modifier keys and pointer buttons, about which
767 (unsigned int *) &dummy
);
771 /* xmenu_show expects window coordinates, not root window
772 coordinates. Translate. */
773 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
774 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
777 #endif /* HAVE_X_WINDOWS */
779 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
780 doc
: /* Pop up a deck-of-cards menu and return user's selection.
781 POSITION is a position specification. This is either a mouse button event
782 or a list ((XOFFSET YOFFSET) WINDOW)
783 where XOFFSET and YOFFSET are positions in pixels from the top left
784 corner of WINDOW. (WINDOW may be a window or a frame object.)
785 This controls the position of the top left of the menu as a whole.
786 If POSITION is t, it means to use the current mouse position.
788 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
789 The menu items come from key bindings that have a menu string as well as
790 a definition; actually, the "definition" in such a key binding looks like
791 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
792 the keymap as a top-level element.
794 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
795 Otherwise, REAL-DEFINITION should be a valid key binding definition.
797 You can also use a list of keymaps as MENU.
798 Then each keymap makes a separate pane.
800 When MENU is a keymap or a list of keymaps, the return value is the
801 list of events corresponding to the user's choice. Note that
802 `x-popup-menu' does not actually execute the command bound to that
805 Alternatively, you can specify a menu of multiple panes
806 with a list of the form (TITLE PANE1 PANE2...),
807 where each pane is a list of form (TITLE ITEM1 ITEM2...).
808 Each ITEM is normally a cons cell (STRING . VALUE);
809 but a string can appear as an item--that makes a nonselectable line
811 With this form of menu, the return value is VALUE from the chosen item.
813 If POSITION is nil, don't display the menu at all, just precalculate the
814 cached information about equivalent key sequences.
816 If the user gets rid of the menu without making a valid choice, for
817 instance by clicking the mouse away from a valid choice or by typing
818 keyboard input, then this normally results in a quit and
819 `x-popup-menu' does not return. But if POSITION is a mouse button
820 event (indicating that the user invoked the menu with the mouse) then
821 no quit occurs and `x-popup-menu' returns nil. */)
823 Lisp_Object position
, menu
;
825 Lisp_Object keymap
, tem
;
826 int xpos
= 0, ypos
= 0;
828 char *error_name
= NULL
;
829 Lisp_Object selection
= Qnil
;
831 Lisp_Object x
, y
, window
;
834 int specpdl_count
= SPECPDL_INDEX ();
838 if (! NILP (position
))
840 int get_current_pos_p
= 0;
843 /* Decode the first argument: find the window and the coordinates. */
844 if (EQ (position
, Qt
)
845 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
846 || EQ (XCAR (position
), Qtool_bar
))))
848 get_current_pos_p
= 1;
852 tem
= Fcar (position
);
855 window
= Fcar (Fcdr (position
));
857 y
= Fcar (XCDR (tem
));
862 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
863 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
864 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
869 /* If a click happens in an external tool bar or a detached
870 tool bar, x and y is NIL. In that case, use the current
871 mouse position. This happens for the help button in the
872 tool bar. Ideally popup-menu should pass NIL to
873 this function, but it doesn't. */
874 if (NILP (x
) && NILP (y
))
875 get_current_pos_p
= 1;
878 if (get_current_pos_p
)
880 /* Use the mouse's current position. */
881 FRAME_PTR new_f
= SELECTED_FRAME ();
882 #ifdef HAVE_X_WINDOWS
883 /* Can't use mouse_position_hook for X since it returns
884 coordinates relative to the window the mouse is in,
885 we need coordinates relative to the edit widget always. */
890 mouse_position_for_popup (new_f
, &cur_x
, &cur_y
);
891 /* cur_x/y may be negative, so use make_number. */
892 x
= make_number (cur_x
);
893 y
= make_number (cur_y
);
896 #else /* not HAVE_X_WINDOWS */
897 Lisp_Object bar_window
;
898 enum scroll_bar_part part
;
901 if (mouse_position_hook
)
902 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
903 &part
, &x
, &y
, &time
);
904 #endif /* not HAVE_X_WINDOWS */
907 XSETFRAME (window
, new_f
);
910 window
= selected_window
;
919 /* Decode where to put the menu. */
927 else if (WINDOWP (window
))
929 CHECK_LIVE_WINDOW (window
);
930 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
932 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
933 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
936 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
937 but I don't want to make one now. */
938 CHECK_WINDOW (window
);
943 XSETFRAME (Vmenu_updating_frame
, f
);
946 Vmenu_updating_frame
= Qnil
;
947 #endif /* HAVE_MENUS */
949 record_unwind_protect (unuse_menu_items
, Qnil
);
953 /* Decode the menu items from what was specified. */
955 keymap
= get_keymap (menu
, 0, 0);
958 /* We were given a keymap. Extract menu info from the keymap. */
961 /* Extract the detailed info to make one pane. */
962 keymap_panes (&menu
, 1, NILP (position
));
964 /* Search for a string appearing directly as an element of the keymap.
965 That string is the title of the menu. */
966 prompt
= Fkeymap_prompt (keymap
);
967 if (NILP (title
) && !NILP (prompt
))
970 /* Make that be the pane title of the first pane. */
971 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
972 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
976 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
978 /* We were given a list of keymaps. */
979 int nmaps
= XFASTINT (Flength (menu
));
981 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
986 /* The first keymap that has a prompt string
987 supplies the menu title. */
988 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
992 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
994 prompt
= Fkeymap_prompt (keymap
);
995 if (NILP (title
) && !NILP (prompt
))
999 /* Extract the detailed info to make one pane. */
1000 keymap_panes (maps
, nmaps
, NILP (position
));
1002 /* Make the title be the pane title of the first pane. */
1003 if (!NILP (title
) && menu_items_n_panes
>= 0)
1004 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
1010 /* We were given an old-fashioned menu. */
1011 title
= Fcar (menu
);
1012 CHECK_STRING (title
);
1014 list_of_panes (Fcdr (menu
));
1019 unbind_to (specpdl_count
, Qnil
);
1021 if (NILP (position
))
1023 discard_menu_items ();
1029 /* Display them in a menu. */
1032 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
1033 keymaps
, title
, &error_name
);
1036 discard_menu_items ();
1039 #endif /* HAVE_MENUS */
1041 if (error_name
) error (error_name
);
1047 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
1048 doc
: /* Pop up a dialog box and return user's selection.
1049 POSITION specifies which frame to use.
1050 This is normally a mouse button event or a window or frame.
1051 If POSITION is t, it means to use the frame the mouse is on.
1052 The dialog box appears in the middle of the specified frame.
1054 CONTENTS specifies the alternatives to display in the dialog box.
1055 It is a list of the form (DIALOG ITEM1 ITEM2...).
1056 Each ITEM is a cons cell (STRING . VALUE).
1057 The return value is VALUE from the chosen item.
1059 An ITEM may also be just a string--that makes a nonselectable item.
1060 An ITEM may also be nil--that means to put all preceding items
1061 on the left of the dialog box and all following items on the right.
1062 \(By default, approximately half appear on each side.)
1064 If HEADER is non-nil, the frame title for the box is "Information",
1065 otherwise it is "Question".
1067 If the user gets rid of the dialog box without making a valid choice,
1068 for instance using the window manager, then this produces a quit and
1069 `x-popup-dialog' does not return. */)
1070 (position
, contents
, header
)
1071 Lisp_Object position
, contents
, header
;
1078 /* Decode the first argument: find the window or frame to use. */
1079 if (EQ (position
, Qt
)
1080 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
1081 || EQ (XCAR (position
), Qtool_bar
))))
1083 #if 0 /* Using the frame the mouse is on may not be right. */
1084 /* Use the mouse's current position. */
1085 FRAME_PTR new_f
= SELECTED_FRAME ();
1086 Lisp_Object bar_window
;
1087 enum scroll_bar_part part
;
1091 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
1094 XSETFRAME (window
, new_f
);
1096 window
= selected_window
;
1098 window
= selected_window
;
1100 else if (CONSP (position
))
1103 tem
= Fcar (position
);
1105 window
= Fcar (Fcdr (position
));
1108 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1109 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1112 else if (WINDOWP (position
) || FRAMEP (position
))
1117 /* Decode where to put the menu. */
1119 if (FRAMEP (window
))
1120 f
= XFRAME (window
);
1121 else if (WINDOWP (window
))
1123 CHECK_LIVE_WINDOW (window
);
1124 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
1127 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1128 but I don't want to make one now. */
1129 CHECK_WINDOW (window
);
1131 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
1132 /* Display a menu with these alternatives
1133 in the middle of frame F. */
1135 Lisp_Object x
, y
, frame
, newpos
;
1136 XSETFRAME (frame
, f
);
1137 XSETINT (x
, x_pixel_width (f
) / 2);
1138 XSETINT (y
, x_pixel_height (f
) / 2);
1139 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
1141 return Fx_popup_menu (newpos
,
1142 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
1148 Lisp_Object selection
;
1149 int specpdl_count
= SPECPDL_INDEX ();
1151 /* Decode the dialog items from what was specified. */
1152 title
= Fcar (contents
);
1153 CHECK_STRING (title
);
1154 record_unwind_protect (unuse_menu_items
, Qnil
);
1156 if (NILP (Fcar (Fcdr (contents
))))
1157 /* No buttons specified, add an "Ok" button so users can pop down
1158 the dialog. Also, the lesstif/motif version crashes if there are
1160 contents
= Fcons (title
, Fcons (Fcons (build_string ("Ok"), Qt
), Qnil
));
1162 list_of_panes (Fcons (contents
, Qnil
));
1164 /* Display them in a dialog box. */
1166 selection
= xdialog_show (f
, 0, title
, header
, &error_name
);
1169 unbind_to (specpdl_count
, Qnil
);
1170 discard_menu_items ();
1172 if (error_name
) error (error_name
);
1181 /* Set menu_items_inuse so no other popup menu or dialog is created. */
1184 x_menu_set_in_use (in_use
)
1187 menu_items_inuse
= in_use
? Qt
: Qnil
;
1188 popup_activated_flag
= in_use
;
1189 #ifdef USE_X_TOOLKIT
1190 if (popup_activated_flag
)
1191 x_activate_timeout_atimer ();
1195 /* Wait for an X event to arrive or for a timer to expire. */
1198 x_menu_wait_for_event (void *data
)
1200 extern EMACS_TIME timer_check
P_ ((int));
1202 /* Another way to do this is to register a timer callback, that can be
1203 done in GTK and Xt. But we have to do it like this when using only X
1204 anyway, and with callbacks we would have three variants for timer handling
1205 instead of the small ifdefs below. */
1208 #ifdef USE_X_TOOLKIT
1209 ! XtAppPending (Xt_app_con
)
1210 #elif defined USE_GTK
1211 ! gtk_events_pending ()
1213 ! XPending ((Display
*) data
)
1217 EMACS_TIME next_time
= timer_check (1);
1218 long secs
= EMACS_SECS (next_time
);
1219 long usecs
= EMACS_USECS (next_time
);
1220 SELECT_TYPE read_fds
;
1221 struct x_display_info
*dpyinfo
;
1224 FD_ZERO (&read_fds
);
1225 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
1227 int fd
= ConnectionNumber (dpyinfo
->display
);
1228 FD_SET (fd
, &read_fds
);
1232 if (secs
< 0 || (secs
== 0 && usecs
== 0))
1234 /* Sometimes timer_check returns -1 (no timers) even if there are
1235 timers. So do a timeout anyway. */
1236 EMACS_SET_SECS (next_time
, 1);
1237 EMACS_SET_USECS (next_time
, 0);
1240 select (n
+ 1, &read_fds
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0, &next_time
);
1243 #endif /* ! MSDOS */
1246 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1248 #ifdef USE_X_TOOLKIT
1250 /* Loop in Xt until the menu pulldown or dialog popup has been
1251 popped down (deactivated). This is used for x-popup-menu
1252 and x-popup-dialog; it is not used for the menu bar.
1254 NOTE: All calls to popup_get_selection should be protected
1255 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1258 popup_get_selection (initial_event
, dpyinfo
, id
, do_timers
)
1259 XEvent
*initial_event
;
1260 struct x_display_info
*dpyinfo
;
1266 while (popup_activated_flag
)
1270 event
= *initial_event
;
1275 if (do_timers
) x_menu_wait_for_event (0);
1276 XtAppNextEvent (Xt_app_con
, &event
);
1279 /* Make sure we don't consider buttons grabbed after menu goes.
1280 And make sure to deactivate for any ButtonRelease,
1281 even if XtDispatchEvent doesn't do that. */
1282 if (event
.type
== ButtonRelease
1283 && dpyinfo
->display
== event
.xbutton
.display
)
1285 dpyinfo
->grabbed
&= ~(1 << event
.xbutton
.button
);
1286 #ifdef USE_MOTIF /* Pretending that the event came from a
1287 Btn1Down seems the only way to convince Motif to
1288 activate its callbacks; setting the XmNmenuPost
1289 isn't working. --marcus@sysc.pdx.edu. */
1290 event
.xbutton
.button
= 1;
1291 /* Motif only pops down menus when no Ctrl, Alt or Mod
1292 key is pressed and the button is released. So reset key state
1293 so Motif thinks this is the case. */
1294 event
.xbutton
.state
= 0;
1297 /* Pop down on C-g and Escape. */
1298 else if (event
.type
== KeyPress
1299 && dpyinfo
->display
== event
.xbutton
.display
)
1301 KeySym keysym
= XLookupKeysym (&event
.xkey
, 0);
1303 if ((keysym
== XK_g
&& (event
.xkey
.state
& ControlMask
) != 0)
1304 || keysym
== XK_Escape
) /* Any escape, ignore modifiers. */
1305 popup_activated_flag
= 0;
1308 x_dispatch_event (&event
, event
.xany
.display
);
1312 DEFUN ("menu-bar-open", Fmenu_bar_open
, Smenu_bar_open
, 0, 1, "i",
1313 doc
: /* Start key navigation of the menu bar in FRAME.
1314 This initially opens the first menu bar item and you can then navigate with the
1315 arrow keys, select a menu entry with the return key or cancel with the
1316 escape key. If FRAME has no menu bar this function does nothing.
1318 If FRAME is nil or not given, use the selected frame. */)
1323 FRAME_PTR f
= check_x_frame (frame
);
1327 if (FRAME_EXTERNAL_MENU_BAR (f
))
1328 set_frame_menubar (f
, 0, 1);
1330 menubar
= FRAME_X_OUTPUT (f
)->menubar_widget
;
1336 x_catch_errors (FRAME_X_DISPLAY (f
));
1337 memset (&ev
, 0, sizeof ev
);
1338 ev
.xbutton
.display
= FRAME_X_DISPLAY (f
);
1339 ev
.xbutton
.window
= XtWindow (menubar
);
1340 ev
.xbutton
.root
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
1341 ev
.xbutton
.time
= XtLastTimestampProcessed (FRAME_X_DISPLAY (f
));
1342 ev
.xbutton
.button
= Button1
;
1343 ev
.xbutton
.x
= ev
.xbutton
.y
= FRAME_MENUBAR_HEIGHT (f
) / 2;
1344 ev
.xbutton
.same_screen
= True
;
1351 XtSetArg (al
[0], XtNchildren
, &list
);
1352 XtSetArg (al
[1], XtNnumChildren
, &nr
);
1353 XtGetValues (menubar
, al
, 2);
1354 ev
.xbutton
.window
= XtWindow (list
[0]);
1358 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1359 /* From-window, to-window. */
1360 ev
.xbutton
.window
, ev
.xbutton
.root
,
1362 /* From-position, to-position. */
1363 ev
.xbutton
.x
, ev
.xbutton
.y
,
1364 &ev
.xbutton
.x_root
, &ev
.xbutton
.y_root
,
1368 error_p
= x_had_errors_p (FRAME_X_DISPLAY (f
));
1369 x_uncatch_errors ();
1373 ev
.type
= ButtonPress
;
1374 ev
.xbutton
.state
= 0;
1376 XtDispatchEvent (&ev
);
1377 ev
.xbutton
.type
= ButtonRelease
;
1378 ev
.xbutton
.state
= Button1Mask
;
1379 XtDispatchEvent (&ev
);
1387 #endif /* USE_X_TOOLKIT */
1391 DEFUN ("menu-bar-open", Fmenu_bar_open
, Smenu_bar_open
, 0, 1, "i",
1392 doc
: /* Start key navigation of the menu bar in FRAME.
1393 This initially opens the first menu bar item and you can then navigate with the
1394 arrow keys, select a menu entry with the return key or cancel with the
1395 escape key. If FRAME has no menu bar this function does nothing.
1397 If FRAME is nil or not given, use the selected frame. */)
1404 /* gcc 2.95 doesn't accept the FRAME_PTR declaration after
1408 f
= check_x_frame (frame
);
1410 if (FRAME_EXTERNAL_MENU_BAR (f
))
1411 set_frame_menubar (f
, 0, 1);
1413 menubar
= FRAME_X_OUTPUT (f
)->menubar_widget
;
1416 /* Activate the first menu. */
1417 GList
*children
= gtk_container_get_children (GTK_CONTAINER (menubar
));
1419 gtk_menu_shell_select_item (GTK_MENU_SHELL (menubar
),
1420 GTK_WIDGET (children
->data
));
1422 popup_activated_flag
= 1;
1423 g_list_free (children
);
1430 /* Loop util popup_activated_flag is set to zero in a callback.
1431 Used for popup menus and dialogs. */
1434 popup_widget_loop (do_timers
, widget
)
1438 ++popup_activated_flag
;
1440 /* Process events in the Gtk event loop until done. */
1441 while (popup_activated_flag
)
1443 if (do_timers
) x_menu_wait_for_event (0);
1444 gtk_main_iteration ();
1449 /* Activate the menu bar of frame F.
1450 This is called from keyboard.c when it gets the
1451 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1453 To activate the menu bar, we use the X button-press event
1454 that was saved in saved_menu_event.
1455 That makes the toolkit do its thing.
1457 But first we recompute the menu bar contents (the whole tree).
1459 The reason for saving the button event until here, instead of
1460 passing it to the toolkit right away, is that we can safely
1461 execute Lisp code. */
1464 x_activate_menubar (f
)
1467 if (!f
->output_data
.x
->saved_menu_event
->type
)
1471 if (! xg_win_to_widget (FRAME_X_DISPLAY (f
),
1472 f
->output_data
.x
->saved_menu_event
->xany
.window
))
1476 set_frame_menubar (f
, 0, 1);
1479 XPutBackEvent (f
->output_data
.x
->display_info
->display
,
1480 f
->output_data
.x
->saved_menu_event
);
1481 popup_activated_flag
= 1;
1483 XtDispatchEvent (f
->output_data
.x
->saved_menu_event
);
1487 if (f
->output_data
.x
->saved_menu_event
->type
== ButtonRelease
)
1488 pending_menu_activation
= 1;
1491 /* Ignore this if we get it a second time. */
1492 f
->output_data
.x
->saved_menu_event
->type
= 0;
1495 /* This callback is invoked when the user selects a menubar cascade
1496 pushbutton, but before the pulldown menu is posted. */
1500 popup_activate_callback (widget
, id
, client_data
)
1503 XtPointer client_data
;
1505 popup_activated_flag
= 1;
1506 #ifdef USE_X_TOOLKIT
1507 x_activate_timeout_atimer ();
1512 /* This callback is invoked when a dialog or menu is finished being
1513 used and has been unposted. */
1517 popup_deactivate_callback (widget
, client_data
)
1519 gpointer client_data
;
1521 popup_activated_flag
= 0;
1525 popup_deactivate_callback (widget
, id
, client_data
)
1528 XtPointer client_data
;
1530 popup_activated_flag
= 0;
1535 /* Function that finds the frame for WIDGET and shows the HELP text
1537 F is the frame if known, or NULL if not known. */
1539 show_help_event (f
, widget
, help
)
1541 xt_or_gtk_widget widget
;
1548 XSETFRAME (frame
, f
);
1549 kbd_buffer_store_help_event (frame
, help
);
1553 #if 0 /* This code doesn't do anything useful. ++kfs */
1554 /* WIDGET is the popup menu. It's parent is the frame's
1555 widget. See which frame that is. */
1556 xt_or_gtk_widget frame_widget
= XtParent (widget
);
1559 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
1561 frame
= XCAR (tail
);
1562 if (GC_FRAMEP (frame
)
1563 && (f
= XFRAME (frame
),
1564 FRAME_X_P (f
) && f
->output_data
.x
->widget
== frame_widget
))
1568 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
1572 /* Callback called when menu items are highlighted/unhighlighted
1573 while moving the mouse over them. WIDGET is the menu bar or menu
1574 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1575 the data structure for the menu item, or null in case of
1580 menu_highlight_callback (widget
, call_data
)
1584 xg_menu_item_cb_data
*cb_data
;
1587 cb_data
= (xg_menu_item_cb_data
*) g_object_get_data (G_OBJECT (widget
),
1589 if (! cb_data
) return;
1591 help
= call_data
? cb_data
->help
: Qnil
;
1593 /* If popup_activated_flag is greater than 1 we are in a popup menu.
1594 Don't show help for them, they won't appear before the
1595 popup is popped down. */
1596 if (popup_activated_flag
<= 1)
1597 show_help_event (cb_data
->cl_data
->f
, widget
, help
);
1601 menu_highlight_callback (widget
, id
, call_data
)
1609 widget_value
*wv
= (widget_value
*) call_data
;
1611 help
= wv
? wv
->help
: Qnil
;
1613 /* Determine the frame for the help event. */
1614 f
= menubar_id_to_frame (id
);
1616 show_help_event (f
, widget
, help
);
1620 /* Find the menu selection and store it in the keyboard buffer.
1621 F is the frame the menu is on.
1622 MENU_BAR_ITEMS_USED is the length of VECTOR.
1623 VECTOR is an array of menu events for the whole menu. */
1626 find_and_call_menu_selection (f
, menu_bar_items_used
, vector
, client_data
)
1628 int menu_bar_items_used
;
1632 Lisp_Object prefix
, entry
;
1633 Lisp_Object
*subprefix_stack
;
1634 int submenu_depth
= 0;
1638 subprefix_stack
= (Lisp_Object
*) alloca (menu_bar_items_used
* sizeof (Lisp_Object
));
1642 while (i
< menu_bar_items_used
)
1644 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1646 subprefix_stack
[submenu_depth
++] = prefix
;
1650 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1652 prefix
= subprefix_stack
[--submenu_depth
];
1655 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1657 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1658 i
+= MENU_ITEMS_PANE_LENGTH
;
1662 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1663 /* The EMACS_INT cast avoids a warning. There's no problem
1664 as long as pointers have enough bits to hold small integers. */
1665 if ((int) (EMACS_INT
) client_data
== i
)
1668 struct input_event buf
;
1672 XSETFRAME (frame
, f
);
1673 buf
.kind
= MENU_BAR_EVENT
;
1674 buf
.frame_or_window
= frame
;
1676 kbd_buffer_store_event (&buf
);
1678 for (j
= 0; j
< submenu_depth
; j
++)
1679 if (!NILP (subprefix_stack
[j
]))
1681 buf
.kind
= MENU_BAR_EVENT
;
1682 buf
.frame_or_window
= frame
;
1683 buf
.arg
= subprefix_stack
[j
];
1684 kbd_buffer_store_event (&buf
);
1689 buf
.kind
= MENU_BAR_EVENT
;
1690 buf
.frame_or_window
= frame
;
1692 kbd_buffer_store_event (&buf
);
1695 buf
.kind
= MENU_BAR_EVENT
;
1696 buf
.frame_or_window
= frame
;
1698 kbd_buffer_store_event (&buf
);
1702 i
+= MENU_ITEMS_ITEM_LENGTH
;
1709 /* Gtk calls callbacks just because we tell it what item should be
1710 selected in a radio group. If this variable is set to a non-zero
1711 value, we are creating menus and don't want callbacks right now.
1713 static int xg_crazy_callback_abort
;
1715 /* This callback is called from the menu bar pulldown menu
1716 when the user makes a selection.
1717 Figure out what the user chose
1718 and put the appropriate events into the keyboard buffer. */
1720 menubar_selection_callback (widget
, client_data
)
1722 gpointer client_data
;
1724 xg_menu_item_cb_data
*cb_data
= (xg_menu_item_cb_data
*) client_data
;
1726 if (xg_crazy_callback_abort
)
1729 if (! cb_data
|| ! cb_data
->cl_data
|| ! cb_data
->cl_data
->f
)
1732 /* For a group of radio buttons, GTK calls the selection callback first
1733 for the item that was active before the selection and then for the one that
1734 is active after the selection. For C-h k this means we get the help on
1735 the deselected item and then the selected item is executed. Prevent that
1736 by ignoring the non-active item. */
1737 if (GTK_IS_RADIO_MENU_ITEM (widget
)
1738 && ! gtk_check_menu_item_get_active (GTK_CHECK_MENU_ITEM (widget
)))
1741 /* When a menu is popped down, X generates a focus event (i.e. focus
1742 goes back to the frame below the menu). Since GTK buffers events,
1743 we force it out here before the menu selection event. Otherwise
1744 sit-for will exit at once if the focus event follows the menu selection
1748 while (gtk_events_pending ())
1749 gtk_main_iteration ();
1752 find_and_call_menu_selection (cb_data
->cl_data
->f
,
1753 cb_data
->cl_data
->menu_bar_items_used
,
1754 cb_data
->cl_data
->menu_bar_vector
,
1755 cb_data
->call_data
);
1758 #else /* not USE_GTK */
1760 /* This callback is called from the menu bar pulldown menu
1761 when the user makes a selection.
1762 Figure out what the user chose
1763 and put the appropriate events into the keyboard buffer. */
1765 menubar_selection_callback (widget
, id
, client_data
)
1768 XtPointer client_data
;
1772 f
= menubar_id_to_frame (id
);
1775 find_and_call_menu_selection (f
, f
->menu_bar_items_used
,
1776 f
->menu_bar_vector
, client_data
);
1778 #endif /* not USE_GTK */
1780 /* Allocate a widget_value, blocking input. */
1783 xmalloc_widget_value ()
1785 widget_value
*value
;
1788 value
= malloc_widget_value ();
1794 /* This recursively calls free_widget_value on the tree of widgets.
1795 It must free all data that was malloc'ed for these widget_values.
1796 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1797 must be left alone. */
1800 free_menubar_widget_value_tree (wv
)
1805 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1807 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1809 free_menubar_widget_value_tree (wv
->contents
);
1810 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1814 free_menubar_widget_value_tree (wv
->next
);
1815 wv
->next
= (widget_value
*) 0xDEADBEEF;
1818 free_widget_value (wv
);
1822 /* Set up data in menu_items for a menu bar item
1823 whose event type is ITEM_KEY (with string ITEM_NAME)
1824 and whose contents come from the list of keymaps MAPS. */
1827 parse_single_submenu (item_key
, item_name
, maps
)
1828 Lisp_Object item_key
, item_name
, maps
;
1832 Lisp_Object
*mapvec
;
1834 int top_level_items
= 0;
1836 length
= Flength (maps
);
1837 len
= XINT (length
);
1839 /* Convert the list MAPS into a vector MAPVEC. */
1840 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1841 for (i
= 0; i
< len
; i
++)
1843 mapvec
[i
] = Fcar (maps
);
1847 /* Loop over the given keymaps, making a pane for each map.
1848 But don't make a pane that is empty--ignore that map instead. */
1849 for (i
= 0; i
< len
; i
++)
1851 if (!KEYMAPP (mapvec
[i
]))
1853 /* Here we have a command at top level in the menu bar
1854 as opposed to a submenu. */
1855 top_level_items
= 1;
1856 push_menu_pane (Qnil
, Qnil
);
1857 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1858 Qnil
, Qnil
, Qnil
, Qnil
);
1863 prompt
= Fkeymap_prompt (mapvec
[i
]);
1864 single_keymap_panes (mapvec
[i
],
1865 !NILP (prompt
) ? prompt
: item_name
,
1870 return top_level_items
;
1873 /* Create a tree of widget_value objects
1874 representing the panes and items
1875 in menu_items starting at index START, up to index END. */
1877 static widget_value
*
1878 digest_single_submenu (start
, end
, top_level_items
)
1879 int start
, end
, top_level_items
;
1881 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1883 int submenu_depth
= 0;
1884 widget_value
**submenu_stack
;
1888 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1889 wv
= xmalloc_widget_value ();
1893 wv
->button_type
= BUTTON_TYPE_NONE
;
1899 /* Loop over all panes and items made by the preceding call
1900 to parse_single_submenu and construct a tree of widget_value objects.
1901 Ignore the panes and items used by previous calls to
1902 digest_single_submenu, even though those are also in menu_items. */
1906 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1908 submenu_stack
[submenu_depth
++] = save_wv
;
1913 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1916 save_wv
= submenu_stack
[--submenu_depth
];
1919 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1920 && submenu_depth
!= 0)
1921 i
+= MENU_ITEMS_PANE_LENGTH
;
1922 /* Ignore a nil in the item list.
1923 It's meaningful only for dialog boxes. */
1924 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1926 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1928 /* Create a new pane. */
1929 Lisp_Object pane_name
, prefix
;
1934 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1935 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1937 #ifndef HAVE_MULTILINGUAL_MENU
1938 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1940 pane_name
= ENCODE_MENU_STRING (pane_name
);
1941 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1944 pane_string
= (NILP (pane_name
)
1945 ? "" : (char *) SDATA (pane_name
));
1946 /* If there is just one top-level pane, put all its items directly
1947 under the top-level menu. */
1948 if (menu_items_n_panes
== 1)
1951 /* If the pane has a meaningful name,
1952 make the pane a top-level menu item
1953 with its items as a submenu beneath it. */
1954 if (strcmp (pane_string
, ""))
1956 wv
= xmalloc_widget_value ();
1960 first_wv
->contents
= wv
;
1961 wv
->lname
= pane_name
;
1962 /* Set value to 1 so update_submenu_strings can handle '@' */
1963 wv
->value
= (char *)1;
1965 wv
->button_type
= BUTTON_TYPE_NONE
;
1973 i
+= MENU_ITEMS_PANE_LENGTH
;
1977 /* Create a new item within current pane. */
1978 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1981 /* All items should be contained in panes. */
1982 if (panes_seen
== 0)
1985 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1986 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1987 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1988 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1989 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1990 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1991 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1993 #ifndef HAVE_MULTILINGUAL_MENU
1994 if (STRING_MULTIBYTE (item_name
))
1996 item_name
= ENCODE_MENU_STRING (item_name
);
1997 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2000 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2002 descrip
= ENCODE_MENU_STRING (descrip
);
2003 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2005 #endif /* not HAVE_MULTILINGUAL_MENU */
2007 wv
= xmalloc_widget_value ();
2011 save_wv
->contents
= wv
;
2013 wv
->lname
= item_name
;
2014 if (!NILP (descrip
))
2017 /* The EMACS_INT cast avoids a warning. There's no problem
2018 as long as pointers have enough bits to hold small integers. */
2019 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
2020 wv
->enabled
= !NILP (enable
);
2023 wv
->button_type
= BUTTON_TYPE_NONE
;
2024 else if (EQ (type
, QCradio
))
2025 wv
->button_type
= BUTTON_TYPE_RADIO
;
2026 else if (EQ (type
, QCtoggle
))
2027 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2031 wv
->selected
= !NILP (selected
);
2032 if (! STRINGP (help
))
2039 i
+= MENU_ITEMS_ITEM_LENGTH
;
2043 /* If we have just one "menu item"
2044 that was originally a button, return it by itself. */
2045 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
2047 wv
= first_wv
->contents
;
2048 free_widget_value (first_wv
);
2055 /* Walk through the widget_value tree starting at FIRST_WV and update
2056 the char * pointers from the corresponding lisp values.
2057 We do this after building the whole tree, since GC may happen while the
2058 tree is constructed, and small strings are relocated. So we must wait
2059 until no GC can happen before storing pointers into lisp values. */
2061 update_submenu_strings (first_wv
)
2062 widget_value
*first_wv
;
2066 for (wv
= first_wv
; wv
; wv
= wv
->next
)
2068 if (STRINGP (wv
->lname
))
2070 wv
->name
= (char *) SDATA (wv
->lname
);
2072 /* Ignore the @ that means "separate pane".
2073 This is a kludge, but this isn't worth more time. */
2074 if (wv
->value
== (char *)1)
2076 if (wv
->name
[0] == '@')
2082 if (STRINGP (wv
->lkey
))
2083 wv
->key
= (char *) SDATA (wv
->lkey
);
2086 update_submenu_strings (wv
->contents
);
2091 /* Recompute all the widgets of frame F, when the menu bar has been
2092 changed. Value is non-zero if widgets were updated. */
2095 update_frame_menubar (f
)
2099 return xg_update_frame_menubar (f
);
2101 struct x_output
*x
= f
->output_data
.x
;
2104 if (!x
->menubar_widget
|| XtIsManaged (x
->menubar_widget
))
2108 /* Save the size of the frame because the pane widget doesn't accept
2109 to resize itself. So force it. */
2110 columns
= FRAME_COLS (f
);
2111 rows
= FRAME_LINES (f
);
2113 /* Do the voodoo which means "I'm changing lots of things, don't try
2114 to refigure sizes until I'm done." */
2115 lw_refigure_widget (x
->column_widget
, False
);
2117 /* The order in which children are managed is the top to bottom
2118 order in which they are displayed in the paned window. First,
2119 remove the text-area widget. */
2120 XtUnmanageChild (x
->edit_widget
);
2122 /* Remove the menubar that is there now, and put up the menubar that
2124 XtManageChild (x
->menubar_widget
);
2125 XtMapWidget (x
->menubar_widget
);
2126 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, NULL
);
2128 /* Re-manage the text-area widget, and then thrash the sizes. */
2129 XtManageChild (x
->edit_widget
);
2130 lw_refigure_widget (x
->column_widget
, True
);
2132 /* Force the pane widget to resize itself with the right values. */
2133 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
2139 /* Set the contents of the menubar widgets of frame F.
2140 The argument FIRST_TIME is currently ignored;
2141 it is set the first time this is called, from initialize_frame_menubar. */
2144 set_frame_menubar (f
, first_time
, deep_p
)
2149 xt_or_gtk_widget menubar_widget
= f
->output_data
.x
->menubar_widget
;
2150 #ifdef USE_X_TOOLKIT
2154 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
2156 int *submenu_start
, *submenu_end
;
2157 int *submenu_top_level_items
, *submenu_n_panes
;
2160 XSETFRAME (Vmenu_updating_frame
, f
);
2162 #ifdef USE_X_TOOLKIT
2163 if (f
->output_data
.x
->id
== 0)
2164 f
->output_data
.x
->id
= next_menubar_widget_id
++;
2165 id
= f
->output_data
.x
->id
;
2168 if (! menubar_widget
)
2170 else if (pending_menu_activation
&& !deep_p
)
2172 /* Make the first call for any given frame always go deep. */
2173 else if (!f
->output_data
.x
->saved_menu_event
&& !deep_p
)
2176 f
->output_data
.x
->saved_menu_event
= (XEvent
*)xmalloc (sizeof (XEvent
));
2177 f
->output_data
.x
->saved_menu_event
->type
= 0;
2181 /* If we have detached menus, we must update deep so detached menus
2182 also gets updated. */
2183 deep_p
= deep_p
|| xg_have_tear_offs ();
2188 /* Make a widget-value tree representing the entire menu trees. */
2190 struct buffer
*prev
= current_buffer
;
2192 int specpdl_count
= SPECPDL_INDEX ();
2193 int previous_menu_items_used
= f
->menu_bar_items_used
;
2194 Lisp_Object
*previous_items
2195 = (Lisp_Object
*) alloca (previous_menu_items_used
2196 * sizeof (Lisp_Object
));
2198 /* If we are making a new widget, its contents are empty,
2199 do always reinitialize them. */
2200 if (! menubar_widget
)
2201 previous_menu_items_used
= 0;
2203 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
2204 specbind (Qinhibit_quit
, Qt
);
2205 /* Don't let the debugger step into this code
2206 because it is not reentrant. */
2207 specbind (Qdebug_on_next_call
, Qnil
);
2209 record_unwind_save_match_data ();
2210 if (NILP (Voverriding_local_map_menu_flag
))
2212 specbind (Qoverriding_terminal_local_map
, Qnil
);
2213 specbind (Qoverriding_local_map
, Qnil
);
2216 set_buffer_internal_1 (XBUFFER (buffer
));
2218 /* Run the Lucid hook. */
2219 safe_run_hooks (Qactivate_menubar_hook
);
2221 /* If it has changed current-menubar from previous value,
2222 really recompute the menubar from the value. */
2223 if (! NILP (Vlucid_menu_bar_dirty_flag
))
2224 call0 (Qrecompute_lucid_menubar
);
2225 safe_run_hooks (Qmenu_bar_update_hook
);
2226 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
2228 items
= FRAME_MENU_BAR_ITEMS (f
);
2230 /* Save the frame's previous menu bar contents data. */
2231 if (previous_menu_items_used
)
2232 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
2233 previous_menu_items_used
* sizeof (Lisp_Object
));
2235 /* Fill in menu_items with the current menu bar contents.
2236 This can evaluate Lisp code. */
2239 menu_items
= f
->menu_bar_vector
;
2240 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
2241 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
2242 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
2243 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
2244 submenu_top_level_items
2245 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
2247 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
2249 Lisp_Object key
, string
, maps
;
2253 key
= XVECTOR (items
)->contents
[i
];
2254 string
= XVECTOR (items
)->contents
[i
+ 1];
2255 maps
= XVECTOR (items
)->contents
[i
+ 2];
2259 submenu_start
[i
] = menu_items_used
;
2261 menu_items_n_panes
= 0;
2262 submenu_top_level_items
[i
]
2263 = parse_single_submenu (key
, string
, maps
);
2264 submenu_n_panes
[i
] = menu_items_n_panes
;
2266 submenu_end
[i
] = menu_items_used
;
2269 finish_menu_items ();
2271 /* Convert menu_items into widget_value trees
2272 to display the menu. This cannot evaluate Lisp code. */
2274 wv
= xmalloc_widget_value ();
2275 wv
->name
= "menubar";
2278 wv
->button_type
= BUTTON_TYPE_NONE
;
2282 for (i
= 0; i
< last_i
; i
+= 4)
2284 menu_items_n_panes
= submenu_n_panes
[i
];
2285 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
2286 submenu_top_level_items
[i
]);
2290 first_wv
->contents
= wv
;
2291 /* Don't set wv->name here; GC during the loop might relocate it. */
2293 wv
->button_type
= BUTTON_TYPE_NONE
;
2297 set_buffer_internal_1 (prev
);
2299 /* If there has been no change in the Lisp-level contents
2300 of the menu bar, skip redisplaying it. Just exit. */
2302 /* Compare the new menu items with the ones computed last time. */
2303 for (i
= 0; i
< previous_menu_items_used
; i
++)
2304 if (menu_items_used
== i
2305 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
2307 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
2309 /* The menu items have not changed. Don't bother updating
2310 the menus in any form, since it would be a no-op. */
2311 free_menubar_widget_value_tree (first_wv
);
2312 discard_menu_items ();
2313 unbind_to (specpdl_count
, Qnil
);
2317 /* The menu items are different, so store them in the frame. */
2318 f
->menu_bar_vector
= menu_items
;
2319 f
->menu_bar_items_used
= menu_items_used
;
2321 /* This calls restore_menu_items to restore menu_items, etc.,
2322 as they were outside. */
2323 unbind_to (specpdl_count
, Qnil
);
2325 /* Now GC cannot happen during the lifetime of the widget_value,
2326 so it's safe to store data from a Lisp_String. */
2327 wv
= first_wv
->contents
;
2328 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
2331 string
= XVECTOR (items
)->contents
[i
+ 1];
2334 wv
->name
= (char *) SDATA (string
);
2335 update_submenu_strings (wv
->contents
);
2342 /* Make a widget-value tree containing
2343 just the top level menu bar strings. */
2345 wv
= xmalloc_widget_value ();
2346 wv
->name
= "menubar";
2349 wv
->button_type
= BUTTON_TYPE_NONE
;
2353 items
= FRAME_MENU_BAR_ITEMS (f
);
2354 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
2358 string
= XVECTOR (items
)->contents
[i
+ 1];
2362 wv
= xmalloc_widget_value ();
2363 wv
->name
= (char *) SDATA (string
);
2366 wv
->button_type
= BUTTON_TYPE_NONE
;
2368 /* This prevents lwlib from assuming this
2369 menu item is really supposed to be empty. */
2370 /* The EMACS_INT cast avoids a warning.
2371 This value just has to be different from small integers. */
2372 wv
->call_data
= (void *) (EMACS_INT
) (-1);
2377 first_wv
->contents
= wv
;
2381 /* Forget what we thought we knew about what is in the
2382 detailed contents of the menu bar menus.
2383 Changing the top level always destroys the contents. */
2384 f
->menu_bar_items_used
= 0;
2387 /* Create or update the menu bar widget. */
2392 xg_crazy_callback_abort
= 1;
2395 /* The fourth arg is DEEP_P, which says to consider the entire
2396 menu trees we supply, rather than just the menu bar item names. */
2397 xg_modify_menubar_widgets (menubar_widget
,
2401 G_CALLBACK (menubar_selection_callback
),
2402 G_CALLBACK (popup_deactivate_callback
),
2403 G_CALLBACK (menu_highlight_callback
));
2407 GtkWidget
*wvbox
= f
->output_data
.x
->vbox_widget
;
2410 = xg_create_widget ("menubar", "menubar", f
, first_wv
,
2411 G_CALLBACK (menubar_selection_callback
),
2412 G_CALLBACK (popup_deactivate_callback
),
2413 G_CALLBACK (menu_highlight_callback
));
2415 f
->output_data
.x
->menubar_widget
= menubar_widget
;
2419 #else /* not USE_GTK */
2422 /* Disable resizing (done for Motif!) */
2423 lw_allow_resizing (f
->output_data
.x
->widget
, False
);
2425 /* The third arg is DEEP_P, which says to consider the entire
2426 menu trees we supply, rather than just the menu bar item names. */
2427 lw_modify_all_widgets (id
, first_wv
, deep_p
);
2429 /* Re-enable the edit widget to resize. */
2430 lw_allow_resizing (f
->output_data
.x
->widget
, True
);
2434 char menuOverride
[] = "Ctrl<KeyPress>g: MenuGadgetEscape()";
2435 XtTranslations override
= XtParseTranslationTable (menuOverride
);
2437 menubar_widget
= lw_create_widget ("menubar", "menubar", id
, first_wv
,
2438 f
->output_data
.x
->column_widget
,
2440 popup_activate_callback
,
2441 menubar_selection_callback
,
2442 popup_deactivate_callback
,
2443 menu_highlight_callback
);
2444 f
->output_data
.x
->menubar_widget
= menubar_widget
;
2446 /* Make menu pop down on C-g. */
2447 XtOverrideTranslations (menubar_widget
, override
);
2452 = (f
->output_data
.x
->menubar_widget
2453 ? (f
->output_data
.x
->menubar_widget
->core
.height
2454 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
2457 #if 0 /* Experimentally, we now get the right results
2458 for -geometry -0-0 without this. 24 Aug 96, rms. */
2460 if (FRAME_EXTERNAL_MENU_BAR (f
))
2463 XtVaGetValues (f
->output_data
.x
->column_widget
,
2464 XtNinternalBorderWidth
, &ibw
, NULL
);
2465 menubar_size
+= ibw
;
2467 #endif /* USE_LUCID */
2470 f
->output_data
.x
->menubar_height
= menubar_size
;
2472 #endif /* not USE_GTK */
2474 free_menubar_widget_value_tree (first_wv
);
2475 update_frame_menubar (f
);
2478 xg_crazy_callback_abort
= 0;
2484 /* Called from Fx_create_frame to create the initial menubar of a frame
2485 before it is mapped, so that the window is mapped with the menubar already
2486 there instead of us tacking it on later and thrashing the window after it
2490 initialize_frame_menubar (f
)
2493 /* This function is called before the first chance to redisplay
2494 the frame. It has to be, so the frame will have the right size. */
2495 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
2496 set_frame_menubar (f
, 1, 1);
2500 /* Get rid of the menu bar of frame F, and free its storage.
2501 This is used when deleting a frame, and when turning off the menu bar.
2502 For GTK this function is in gtkutil.c. */
2506 free_frame_menubar (f
)
2509 Widget menubar_widget
;
2511 menubar_widget
= f
->output_data
.x
->menubar_widget
;
2513 f
->output_data
.x
->menubar_height
= 0;
2518 /* Removing the menu bar magically changes the shell widget's x
2519 and y position of (0, 0) which, when the menu bar is turned
2520 on again, leads to pull-down menuss appearing in strange
2521 positions near the upper-left corner of the display. This
2522 happens only with some window managers like twm and ctwm,
2523 but not with other like Motif's mwm or kwm, because the
2524 latter generate ConfigureNotify events when the menu bar
2525 is switched off, which fixes the shell position. */
2526 Position x0
, y0
, x1
, y1
;
2532 if (f
->output_data
.x
->widget
)
2533 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x0
, XtNy
, &y0
, NULL
);
2536 lw_destroy_all_widgets ((LWLIB_ID
) f
->output_data
.x
->id
);
2537 f
->output_data
.x
->menubar_widget
= NULL
;
2540 if (f
->output_data
.x
->widget
)
2542 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x1
, XtNy
, &y1
, NULL
);
2543 if (x1
== 0 && y1
== 0)
2544 XtVaSetValues (f
->output_data
.x
->widget
, XtNx
, x0
, XtNy
, y0
, NULL
);
2551 #endif /* not USE_GTK */
2553 #endif /* USE_X_TOOLKIT || USE_GTK */
2555 /* xmenu_show actually displays a menu using the panes and items in menu_items
2556 and returns the value selected from it.
2557 There are two versions of xmenu_show, one for Xt and one for Xlib.
2558 Both assume input is blocked by the caller. */
2560 /* F is the frame the menu is for.
2561 X and Y are the frame-relative specified position,
2562 relative to the inside upper left corner of the frame F.
2563 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
2564 KEYMAPS is 1 if this menu was specified with keymaps;
2565 in that case, we return a list containing the chosen item's value
2566 and perhaps also the pane's prefix.
2567 TITLE is the specified menu title.
2568 ERROR is a place to store an error message string in case of failure.
2569 (We return nil on failure, but the value doesn't actually matter.) */
2571 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
2573 /* The item selected in the popup menu. */
2574 static Lisp_Object
*volatile menu_item_selection
;
2578 /* Used when position a popup menu. See menu_position_func and
2579 create_and_show_popup_menu below. */
2580 struct next_popup_x_y
2587 /* The menu position function to use if we are not putting a popup
2588 menu where the pointer is.
2589 MENU is the menu to pop up.
2590 X and Y shall on exit contain x/y where the menu shall pop up.
2591 PUSH_IN is not documented in the GTK manual.
2592 USER_DATA is any data passed in when calling gtk_menu_popup.
2593 Here it points to a struct next_popup_x_y where the coordinates
2594 to store in *X and *Y are as well as the frame for the popup.
2596 Here only X and Y are used. */
2598 menu_position_func (menu
, x
, y
, push_in
, user_data
)
2605 struct next_popup_x_y
* data
= (struct next_popup_x_y
*)user_data
;
2607 int disp_width
= FRAME_X_DISPLAY_INFO (data
->f
)->width
;
2608 int disp_height
= FRAME_X_DISPLAY_INFO (data
->f
)->height
;
2613 /* Check if there is room for the menu. If not, adjust x/y so that
2614 the menu is fully visible. */
2615 gtk_widget_size_request (GTK_WIDGET (menu
), &req
);
2616 if (data
->x
+ req
.width
> disp_width
)
2617 *x
-= data
->x
+ req
.width
- disp_width
;
2618 if (data
->y
+ req
.height
> disp_height
)
2619 *y
-= data
->y
+ req
.height
- disp_height
;
2623 popup_selection_callback (widget
, client_data
)
2625 gpointer client_data
;
2627 xg_menu_item_cb_data
*cb_data
= (xg_menu_item_cb_data
*) client_data
;
2629 if (xg_crazy_callback_abort
) return;
2630 if (cb_data
) menu_item_selection
= (Lisp_Object
*) cb_data
->call_data
;
2637 struct Lisp_Save_Value
*p
= XSAVE_VALUE (arg
);
2639 popup_activated_flag
= 0;
2641 gtk_widget_destroy (GTK_WIDGET (p
->pointer
));
2646 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
2648 menu_item_selection will be set to the selection. */
2650 create_and_show_popup_menu (f
, first_wv
, x
, y
, for_click
)
2652 widget_value
*first_wv
;
2659 GtkMenuPositionFunc pos_func
= 0; /* Pop up at pointer. */
2660 struct next_popup_x_y popup_x_y
;
2661 int specpdl_count
= SPECPDL_INDEX ();
2663 xg_crazy_callback_abort
= 1;
2664 menu
= xg_create_widget ("popup", first_wv
->name
, f
, first_wv
,
2665 G_CALLBACK (popup_selection_callback
),
2666 G_CALLBACK (popup_deactivate_callback
),
2667 G_CALLBACK (menu_highlight_callback
));
2668 xg_crazy_callback_abort
= 0;
2672 /* Not invoked by a click. pop up at x/y. */
2673 pos_func
= menu_position_func
;
2675 /* Adjust coordinates to be root-window-relative. */
2676 x
+= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2677 y
+= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2683 i
= 0; /* gtk_menu_popup needs this to be 0 for a non-button popup. */
2687 for (i
= 0; i
< 5; i
++)
2688 if (FRAME_X_DISPLAY_INFO (f
)->grabbed
& (1 << i
))
2692 /* Display the menu. */
2693 gtk_widget_show_all (menu
);
2694 gtk_menu_popup (GTK_MENU (menu
), 0, 0, pos_func
, &popup_x_y
, i
, 0);
2696 record_unwind_protect (pop_down_menu
, make_save_value (menu
, 0));
2698 if (GTK_WIDGET_MAPPED (menu
))
2700 /* Set this to one. popup_widget_loop increases it by one, so it becomes
2701 two. show_help_echo uses this to detect popup menus. */
2702 popup_activated_flag
= 1;
2703 /* Process events that apply to the menu. */
2704 popup_widget_loop (1, menu
);
2707 unbind_to (specpdl_count
, Qnil
);
2709 /* Must reset this manually because the button release event is not passed
2710 to Emacs event loop. */
2711 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2714 #else /* not USE_GTK */
2716 /* We need a unique id for each widget handled by the Lucid Widget
2719 For the main windows, and popup menus, we use this counter,
2720 which we increment each time after use. This starts from 1<<16.
2722 For menu bars, we use numbers starting at 0, counted in
2723 next_menubar_widget_id. */
2724 LWLIB_ID widget_id_tick
;
2727 popup_selection_callback (widget
, id
, client_data
)
2730 XtPointer client_data
;
2732 menu_item_selection
= (Lisp_Object
*) client_data
;
2735 /* ARG is the LWLIB ID of the dialog box, represented
2736 as a Lisp object as (HIGHPART . LOWPART). */
2742 LWLIB_ID id
= (XINT (XCAR (arg
)) << 4 * sizeof (LWLIB_ID
)
2743 | XINT (XCDR (arg
)));
2746 lw_destroy_all_widgets (id
);
2748 popup_activated_flag
= 0;
2753 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
2755 menu_item_selection will be set to the selection. */
2757 create_and_show_popup_menu (f
, first_wv
, x
, y
, for_click
)
2759 widget_value
*first_wv
;
2767 XButtonPressedEvent dummy
;
2771 menu_id
= widget_id_tick
++;
2772 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
2773 f
->output_data
.x
->widget
, 1, 0,
2774 popup_selection_callback
,
2775 popup_deactivate_callback
,
2776 menu_highlight_callback
);
2778 dummy
.type
= ButtonPress
;
2780 dummy
.send_event
= 0;
2781 dummy
.display
= FRAME_X_DISPLAY (f
);
2782 dummy
.time
= CurrentTime
;
2783 dummy
.root
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
2784 dummy
.window
= dummy
.root
;
2785 dummy
.subwindow
= dummy
.root
;
2789 /* Adjust coordinates to be root-window-relative. */
2790 x
+= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2791 y
+= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2798 for (i
= 0; i
< 5; i
++)
2799 if (FRAME_X_DISPLAY_INFO (f
)->grabbed
& (1 << i
))
2802 /* Don't allow any geometry request from the user. */
2803 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
2804 XtSetValues (menu
, av
, ac
);
2806 /* Display the menu. */
2807 lw_popup_menu (menu
, (XEvent
*) &dummy
);
2808 popup_activated_flag
= 1;
2809 x_activate_timeout_atimer ();
2812 int fact
= 4 * sizeof (LWLIB_ID
);
2813 int specpdl_count
= SPECPDL_INDEX ();
2814 record_unwind_protect (pop_down_menu
,
2815 Fcons (make_number (menu_id
>> (fact
)),
2816 make_number (menu_id
& ~(-1 << (fact
)))));
2818 /* Process events that apply to the menu. */
2819 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), menu_id
, 1);
2821 unbind_to (specpdl_count
, Qnil
);
2825 #endif /* not USE_GTK */
2828 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2838 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
2839 widget_value
**submenu_stack
2840 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
2841 Lisp_Object
*subprefix_stack
2842 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
2843 int submenu_depth
= 0;
2849 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2851 *error
= "Empty menu";
2855 /* Create a tree of widget_value objects
2856 representing the panes and their items. */
2857 wv
= xmalloc_widget_value ();
2861 wv
->button_type
= BUTTON_TYPE_NONE
;
2866 /* Loop over all panes and items, filling in the tree. */
2868 while (i
< menu_items_used
)
2870 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2872 submenu_stack
[submenu_depth
++] = save_wv
;
2878 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2881 save_wv
= submenu_stack
[--submenu_depth
];
2885 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
2886 && submenu_depth
!= 0)
2887 i
+= MENU_ITEMS_PANE_LENGTH
;
2888 /* Ignore a nil in the item list.
2889 It's meaningful only for dialog boxes. */
2890 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2892 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2894 /* Create a new pane. */
2895 Lisp_Object pane_name
, prefix
;
2898 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
2899 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2901 #ifndef HAVE_MULTILINGUAL_MENU
2902 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
2904 pane_name
= ENCODE_MENU_STRING (pane_name
);
2905 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
2908 pane_string
= (NILP (pane_name
)
2909 ? "" : (char *) SDATA (pane_name
));
2910 /* If there is just one top-level pane, put all its items directly
2911 under the top-level menu. */
2912 if (menu_items_n_panes
== 1)
2915 /* If the pane has a meaningful name,
2916 make the pane a top-level menu item
2917 with its items as a submenu beneath it. */
2918 if (!keymaps
&& strcmp (pane_string
, ""))
2920 wv
= xmalloc_widget_value ();
2924 first_wv
->contents
= wv
;
2925 wv
->name
= pane_string
;
2926 if (keymaps
&& !NILP (prefix
))
2930 wv
->button_type
= BUTTON_TYPE_NONE
;
2935 else if (first_pane
)
2941 i
+= MENU_ITEMS_PANE_LENGTH
;
2945 /* Create a new item within current pane. */
2946 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
2947 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2948 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2949 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2950 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
2951 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
2952 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
2953 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2955 #ifndef HAVE_MULTILINGUAL_MENU
2956 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2958 item_name
= ENCODE_MENU_STRING (item_name
);
2959 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2962 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2964 descrip
= ENCODE_MENU_STRING (descrip
);
2965 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2967 #endif /* not HAVE_MULTILINGUAL_MENU */
2969 wv
= xmalloc_widget_value ();
2973 save_wv
->contents
= wv
;
2974 wv
->name
= (char *) SDATA (item_name
);
2975 if (!NILP (descrip
))
2976 wv
->key
= (char *) SDATA (descrip
);
2978 /* If this item has a null value,
2979 make the call_data null so that it won't display a box
2980 when the mouse is on it. */
2982 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
2983 wv
->enabled
= !NILP (enable
);
2986 wv
->button_type
= BUTTON_TYPE_NONE
;
2987 else if (EQ (type
, QCtoggle
))
2988 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2989 else if (EQ (type
, QCradio
))
2990 wv
->button_type
= BUTTON_TYPE_RADIO
;
2994 wv
->selected
= !NILP (selected
);
2996 if (! STRINGP (help
))
3003 i
+= MENU_ITEMS_ITEM_LENGTH
;
3007 /* Deal with the title, if it is non-nil. */
3010 widget_value
*wv_title
= xmalloc_widget_value ();
3011 widget_value
*wv_sep1
= xmalloc_widget_value ();
3012 widget_value
*wv_sep2
= xmalloc_widget_value ();
3014 wv_sep2
->name
= "--";
3015 wv_sep2
->next
= first_wv
->contents
;
3016 wv_sep2
->help
= Qnil
;
3018 wv_sep1
->name
= "--";
3019 wv_sep1
->next
= wv_sep2
;
3020 wv_sep1
->help
= Qnil
;
3022 #ifndef HAVE_MULTILINGUAL_MENU
3023 if (STRING_MULTIBYTE (title
))
3024 title
= ENCODE_MENU_STRING (title
);
3027 wv_title
->name
= (char *) SDATA (title
);
3028 wv_title
->enabled
= TRUE
;
3029 wv_title
->button_type
= BUTTON_TYPE_NONE
;
3030 wv_title
->next
= wv_sep1
;
3031 wv_title
->help
= Qnil
;
3032 first_wv
->contents
= wv_title
;
3035 /* No selection has been chosen yet. */
3036 menu_item_selection
= 0;
3038 /* Actually create and show the menu until popped down. */
3039 create_and_show_popup_menu (f
, first_wv
, x
, y
, for_click
);
3041 /* Free the widget_value objects we used to specify the contents. */
3042 free_menubar_widget_value_tree (first_wv
);
3044 /* Find the selected item, and its pane, to return
3045 the proper value. */
3046 if (menu_item_selection
!= 0)
3048 Lisp_Object prefix
, entry
;
3050 prefix
= entry
= Qnil
;
3052 while (i
< menu_items_used
)
3054 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
3056 subprefix_stack
[submenu_depth
++] = prefix
;
3060 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
3062 prefix
= subprefix_stack
[--submenu_depth
];
3065 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
3068 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
3069 i
+= MENU_ITEMS_PANE_LENGTH
;
3071 /* Ignore a nil in the item list.
3072 It's meaningful only for dialog boxes. */
3073 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
3078 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
3079 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
3085 entry
= Fcons (entry
, Qnil
);
3087 entry
= Fcons (prefix
, entry
);
3088 for (j
= submenu_depth
- 1; j
>= 0; j
--)
3089 if (!NILP (subprefix_stack
[j
]))
3090 entry
= Fcons (subprefix_stack
[j
], entry
);
3094 i
+= MENU_ITEMS_ITEM_LENGTH
;
3098 else if (!for_click
)
3099 /* Make "Cancel" equivalent to C-g. */
3100 Fsignal (Qquit
, Qnil
);
3107 dialog_selection_callback (widget
, client_data
)
3109 gpointer client_data
;
3111 /* The EMACS_INT cast avoids a warning. There's no problem
3112 as long as pointers have enough bits to hold small integers. */
3113 if ((int) (EMACS_INT
) client_data
!= -1)
3114 menu_item_selection
= (Lisp_Object
*) client_data
;
3116 popup_activated_flag
= 0;
3119 /* Pop up the dialog for frame F defined by FIRST_WV and loop until the
3121 menu_item_selection will be set to the selection. */
3123 create_and_show_dialog (f
, first_wv
)
3125 widget_value
*first_wv
;
3129 menu
= xg_create_widget ("dialog", first_wv
->name
, f
, first_wv
,
3130 G_CALLBACK (dialog_selection_callback
),
3131 G_CALLBACK (popup_deactivate_callback
),
3136 int specpdl_count
= SPECPDL_INDEX ();
3137 record_unwind_protect (pop_down_menu
, make_save_value (menu
, 0));
3139 /* Display the menu. */
3140 gtk_widget_show_all (menu
);
3142 /* Process events that apply to the menu. */
3143 popup_widget_loop (1, menu
);
3145 unbind_to (specpdl_count
, Qnil
);
3149 #else /* not USE_GTK */
3151 dialog_selection_callback (widget
, id
, client_data
)
3154 XtPointer client_data
;
3156 /* The EMACS_INT cast avoids a warning. There's no problem
3157 as long as pointers have enough bits to hold small integers. */
3158 if ((int) (EMACS_INT
) client_data
!= -1)
3159 menu_item_selection
= (Lisp_Object
*) client_data
;
3162 lw_destroy_all_widgets (id
);
3164 popup_activated_flag
= 0;
3168 /* Pop up the dialog for frame F defined by FIRST_WV and loop until the
3170 menu_item_selection will be set to the selection. */
3172 create_and_show_dialog (f
, first_wv
)
3174 widget_value
*first_wv
;
3178 dialog_id
= widget_id_tick
++;
3179 lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
3180 f
->output_data
.x
->widget
, 1, 0,
3181 dialog_selection_callback
, 0, 0);
3182 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
3184 /* Display the dialog box. */
3185 lw_pop_up_all_widgets (dialog_id
);
3186 popup_activated_flag
= 1;
3187 x_activate_timeout_atimer ();
3189 /* Process events that apply to the dialog box.
3190 Also handle timers. */
3192 int count
= SPECPDL_INDEX ();
3193 int fact
= 4 * sizeof (LWLIB_ID
);
3195 /* xdialog_show_unwind is responsible for popping the dialog box down. */
3196 record_unwind_protect (pop_down_menu
,
3197 Fcons (make_number (dialog_id
>> (fact
)),
3198 make_number (dialog_id
& ~(-1 << (fact
)))));
3200 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
),
3203 unbind_to (count
, Qnil
);
3207 #endif /* not USE_GTK */
3209 static char * button_names
[] = {
3210 "button1", "button2", "button3", "button4", "button5",
3211 "button6", "button7", "button8", "button9", "button10" };
3214 xdialog_show (f
, keymaps
, title
, header
, error_name
)
3217 Lisp_Object title
, header
;
3220 int i
, nb_buttons
=0;
3221 char dialog_name
[6];
3223 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
3225 /* Number of elements seen so far, before boundary. */
3227 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
3228 int boundary_seen
= 0;
3232 if (menu_items_n_panes
> 1)
3234 *error_name
= "Multiple panes in dialog box";
3238 /* Create a tree of widget_value objects
3239 representing the text label and buttons. */
3241 Lisp_Object pane_name
, prefix
;
3243 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
3244 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
3245 pane_string
= (NILP (pane_name
)
3246 ? "" : (char *) SDATA (pane_name
));
3247 prev_wv
= xmalloc_widget_value ();
3248 prev_wv
->value
= pane_string
;
3249 if (keymaps
&& !NILP (prefix
))
3251 prev_wv
->enabled
= 1;
3252 prev_wv
->name
= "message";
3253 prev_wv
->help
= Qnil
;
3256 /* Loop over all panes and items, filling in the tree. */
3257 i
= MENU_ITEMS_PANE_LENGTH
;
3258 while (i
< menu_items_used
)
3261 /* Create a new item within current pane. */
3262 Lisp_Object item_name
, enable
, descrip
;
3263 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
3264 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
3266 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
3268 if (NILP (item_name
))
3270 free_menubar_widget_value_tree (first_wv
);
3271 *error_name
= "Submenu in dialog items";
3274 if (EQ (item_name
, Qquote
))
3276 /* This is the boundary between left-side elts
3277 and right-side elts. Stop incrementing right_count. */
3282 if (nb_buttons
>= 9)
3284 free_menubar_widget_value_tree (first_wv
);
3285 *error_name
= "Too many dialog items";
3289 wv
= xmalloc_widget_value ();
3291 wv
->name
= (char *) button_names
[nb_buttons
];
3292 if (!NILP (descrip
))
3293 wv
->key
= (char *) SDATA (descrip
);
3294 wv
->value
= (char *) SDATA (item_name
);
3295 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
3296 wv
->enabled
= !NILP (enable
);
3300 if (! boundary_seen
)
3304 i
+= MENU_ITEMS_ITEM_LENGTH
;
3307 /* If the boundary was not specified,
3308 by default put half on the left and half on the right. */
3309 if (! boundary_seen
)
3310 left_count
= nb_buttons
- nb_buttons
/ 2;
3312 wv
= xmalloc_widget_value ();
3313 wv
->name
= dialog_name
;
3316 /* Frame title: 'Q' = Question, 'I' = Information.
3317 Can also have 'E' = Error if, one day, we want
3318 a popup for errors. */
3320 dialog_name
[0] = 'Q';
3322 dialog_name
[0] = 'I';
3324 /* Dialog boxes use a really stupid name encoding
3325 which specifies how many buttons to use
3326 and how many buttons are on the right. */
3327 dialog_name
[1] = '0' + nb_buttons
;
3328 dialog_name
[2] = 'B';
3329 dialog_name
[3] = 'R';
3330 /* Number of buttons to put on the right. */
3331 dialog_name
[4] = '0' + nb_buttons
- left_count
;
3333 wv
->contents
= first_wv
;
3337 /* No selection has been chosen yet. */
3338 menu_item_selection
= 0;
3340 /* Force a redisplay before showing the dialog. If a frame is created
3341 just before showing the dialog, its contents may not have been fully
3342 drawn, as this depends on timing of events from the X server. Redisplay
3343 is not done when a dialog is shown. If redisplay could be done in the
3344 X event loop (i.e. the X event loop does not run in a signal handler)
3345 this would not be needed. */
3348 /* Actually create and show the dialog. */
3349 create_and_show_dialog (f
, first_wv
);
3351 /* Free the widget_value objects we used to specify the contents. */
3352 free_menubar_widget_value_tree (first_wv
);
3354 /* Find the selected item, and its pane, to return
3355 the proper value. */
3356 if (menu_item_selection
!= 0)
3362 while (i
< menu_items_used
)
3366 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
3369 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
3370 i
+= MENU_ITEMS_PANE_LENGTH
;
3372 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
3374 /* This is the boundary between left-side elts and
3381 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
3382 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
3386 entry
= Fcons (entry
, Qnil
);
3388 entry
= Fcons (prefix
, entry
);
3392 i
+= MENU_ITEMS_ITEM_LENGTH
;
3397 /* Make "Cancel" equivalent to C-g. */
3398 Fsignal (Qquit
, Qnil
);
3403 #else /* not USE_X_TOOLKIT && not USE_GTK */
3405 /* The frame of the last activated non-toolkit menu bar.
3406 Used to generate menu help events. */
3408 static struct frame
*menu_help_frame
;
3411 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
3413 PANE is the pane number, and ITEM is the menu item number in
3414 the menu (currently not used).
3416 This cannot be done with generating a HELP_EVENT because
3417 XMenuActivate contains a loop that doesn't let Emacs process
3421 menu_help_callback (help_string
, pane
, item
)
3425 extern Lisp_Object Qmenu_item
;
3426 Lisp_Object
*first_item
;
3427 Lisp_Object pane_name
;
3428 Lisp_Object menu_object
;
3430 first_item
= XVECTOR (menu_items
)->contents
;
3431 if (EQ (first_item
[0], Qt
))
3432 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
3433 else if (EQ (first_item
[0], Qquote
))
3434 /* This shouldn't happen, see xmenu_show. */
3435 pane_name
= empty_unibyte_string
;
3437 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
3439 /* (menu-item MENU-NAME PANE-NUMBER) */
3440 menu_object
= Fcons (Qmenu_item
,
3442 Fcons (make_number (pane
), Qnil
)));
3443 show_help_echo (help_string
? build_string (help_string
) : Qnil
,
3444 Qnil
, menu_object
, make_number (item
), 1);
3451 struct Lisp_Save_Value
*p1
= XSAVE_VALUE (Fcar (arg
));
3452 struct Lisp_Save_Value
*p2
= XSAVE_VALUE (Fcdr (arg
));
3454 FRAME_PTR f
= p1
->pointer
;
3455 XMenu
*menu
= p2
->pointer
;
3459 XUngrabPointer (FRAME_X_DISPLAY (f
), CurrentTime
);
3460 XUngrabKeyboard (FRAME_X_DISPLAY (f
), CurrentTime
);
3462 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
3464 #ifdef HAVE_X_WINDOWS
3465 /* Assume the mouse has moved out of the X window.
3466 If it has actually moved in, we will get an EnterNotify. */
3467 x_mouse_leave (FRAME_X_DISPLAY_INFO (f
));
3469 /* State that no mouse buttons are now held.
3470 (The oldXMenu code doesn't track this info for us.)
3471 That is not necessarily true, but the fiction leads to reasonable
3472 results, and it is a pain to ask which are actually held now. */
3473 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
3475 #endif /* HAVE_X_WINDOWS */
3484 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
3494 int pane
, selidx
, lpane
, status
;
3495 Lisp_Object entry
, pane_prefix
;
3497 int ulx
, uly
, width
, height
;
3498 int dispwidth
, dispheight
;
3499 int i
, j
, lines
, maxlines
;
3502 unsigned int dummy_uint
;
3503 int specpdl_count
= SPECPDL_INDEX ();
3506 if (menu_items_n_panes
== 0)
3509 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
3511 *error
= "Empty menu";
3515 /* Figure out which root window F is on. */
3516 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
3517 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
3518 &dummy_uint
, &dummy_uint
);
3520 /* Make the menu on that window. */
3521 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
3524 *error
= "Can't create menu";
3528 /* Don't GC while we prepare and show the menu,
3529 because we give the oldxmenu library pointers to the
3530 contents of strings. */
3531 inhibit_garbage_collection ();
3533 #ifdef HAVE_X_WINDOWS
3534 /* Adjust coordinates to relative to the outer (window manager) window. */
3535 x
+= FRAME_OUTER_TO_INNER_DIFF_X (f
);
3536 y
+= FRAME_OUTER_TO_INNER_DIFF_Y (f
);
3537 #endif /* HAVE_X_WINDOWS */
3539 /* Adjust coordinates to be root-window-relative. */
3543 /* Create all the necessary panes and their items. */
3544 maxlines
= lines
= i
= 0;
3545 while (i
< menu_items_used
)
3547 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
3549 /* Create a new pane. */
3550 Lisp_Object pane_name
, prefix
;
3553 maxlines
= max (maxlines
, lines
);
3555 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
3556 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
3557 pane_string
= (NILP (pane_name
)
3558 ? "" : (char *) SDATA (pane_name
));
3559 if (keymaps
&& !NILP (prefix
))
3562 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
3563 if (lpane
== XM_FAILURE
)
3565 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
3566 *error
= "Can't create pane";
3569 i
+= MENU_ITEMS_PANE_LENGTH
;
3571 /* Find the width of the widest item in this pane. */
3574 while (j
< menu_items_used
)
3577 item
= XVECTOR (menu_items
)->contents
[j
];
3585 width
= SBYTES (item
);
3586 if (width
> maxwidth
)
3589 j
+= MENU_ITEMS_ITEM_LENGTH
;
3592 /* Ignore a nil in the item list.
3593 It's meaningful only for dialog boxes. */
3594 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
3598 /* Create a new item within current pane. */
3599 Lisp_Object item_name
, enable
, descrip
, help
;
3600 unsigned char *item_data
;
3603 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
3604 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
3606 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
3607 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
3608 help_string
= STRINGP (help
) ? SDATA (help
) : NULL
;
3610 if (!NILP (descrip
))
3612 int gap
= maxwidth
- SBYTES (item_name
);
3615 spacer
= Fmake_string (make_number (gap
), make_number (' '));
3616 item_name
= concat2 (item_name
, spacer
);
3617 item_name
= concat2 (item_name
, descrip
);
3618 item_data
= SDATA (item_name
);
3620 /* if alloca is fast, use that to make the space,
3621 to reduce gc needs. */
3623 = (unsigned char *) alloca (maxwidth
3624 + SBYTES (descrip
) + 1);
3625 bcopy (SDATA (item_name
), item_data
,
3626 SBYTES (item_name
));
3627 for (j
= SCHARS (item_name
); j
< maxwidth
; j
++)
3629 bcopy (SDATA (descrip
), item_data
+ j
,
3631 item_data
[j
+ SBYTES (descrip
)] = 0;
3635 item_data
= SDATA (item_name
);
3637 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
3638 menu
, lpane
, 0, item_data
,
3639 !NILP (enable
), help_string
)
3642 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
3643 *error
= "Can't add selection to menu";
3646 i
+= MENU_ITEMS_ITEM_LENGTH
;
3651 maxlines
= max (maxlines
, lines
);
3653 /* All set and ready to fly. */
3654 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
3655 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
3656 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
3657 x
= min (x
, dispwidth
);
3658 y
= min (y
, dispheight
);
3661 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
3662 &ulx
, &uly
, &width
, &height
);
3663 if (ulx
+width
> dispwidth
)
3665 x
-= (ulx
+ width
) - dispwidth
;
3666 ulx
= dispwidth
- width
;
3668 if (uly
+height
> dispheight
)
3670 y
-= (uly
+ height
) - dispheight
;
3671 uly
= dispheight
- height
;
3673 if (ulx
< 0) x
-= ulx
;
3674 if (uly
< 0) y
-= uly
;
3678 /* If position was not given by a mouse click, adjust so upper left
3679 corner of the menu as a whole ends up at given coordinates. This
3680 is what x-popup-menu says in its documentation. */
3682 y
+= 1.5*height
/(maxlines
+2);
3685 XMenuSetAEQ (menu
, TRUE
);
3686 XMenuSetFreeze (menu
, TRUE
);
3690 XMenuActivateSetWaitFunction (x_menu_wait_for_event
, FRAME_X_DISPLAY (f
));
3693 record_unwind_protect (pop_down_menu
,
3694 Fcons (make_save_value (f
, 0),
3695 make_save_value (menu
, 0)));
3697 /* Help display under X won't work because XMenuActivate contains
3698 a loop that doesn't give Emacs a chance to process it. */
3699 menu_help_frame
= f
;
3700 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
3701 x
, y
, ButtonReleaseMask
, &datap
,
3702 menu_help_callback
);
3708 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
3711 /* Find the item number SELIDX in pane number PANE. */
3713 while (i
< menu_items_used
)
3715 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
3719 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
3721 i
+= MENU_ITEMS_PANE_LENGTH
;
3730 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
3733 entry
= Fcons (entry
, Qnil
);
3734 if (!NILP (pane_prefix
))
3735 entry
= Fcons (pane_prefix
, entry
);
3741 i
+= MENU_ITEMS_ITEM_LENGTH
;
3747 *error
= "Can't activate menu";
3752 /* Make "Cancel" equivalent to C-g unless FOR_CLICK (which means
3753 the menu was invoked with a mouse event as POSITION). */
3755 Fsignal (Qquit
, Qnil
);
3760 unbind_to (specpdl_count
, Qnil
);
3765 #endif /* not USE_X_TOOLKIT */
3767 #endif /* HAVE_MENUS */
3769 /* Detect if a dialog or menu has been posted. */
3774 return popup_activated_flag
;
3777 /* The following is used by delayed window autoselection. */
3779 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
3780 doc
: /* Return t if a menu or popup dialog is active. */)
3784 return (popup_activated ()) ? Qt
: Qnil
;
3787 #endif /* HAVE_MENUS */
3793 staticpro (&menu_items
);
3795 menu_items_inuse
= Qnil
;
3797 Qdebug_on_next_call
= intern ("debug-on-next-call");
3798 staticpro (&Qdebug_on_next_call
);
3800 #ifdef USE_X_TOOLKIT
3801 widget_id_tick
= (1<<16);
3802 next_menubar_widget_id
= 1;
3805 defsubr (&Sx_popup_menu
);
3806 defsubr (&Smenu_or_popup_active_p
);
3808 #if defined (USE_GTK) || defined (USE_X_TOOLKIT)
3809 defsubr (&Smenu_bar_open
);
3810 Ffset (intern ("accelerate-menu"), intern (Smenu_bar_open
.symbol_name
));
3814 defsubr (&Sx_popup_dialog
);
3818 /* arch-tag: 92ea573c-398e-496e-ac73-2436f7d63242
3819 (do not change this comment) */