1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 88, 93, 94, 96, 99, 2000, 2001
3 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., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, 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 /* On 4.3 this loses if it comes after xterm.h. */
42 #include "termhooks.h"
47 #include "blockinput.h"
57 /* This may include sys/types.h, and that somehow loses
58 if this is not done before the other system files. */
62 /* Load sys/types.h if not already loaded.
63 In some systems loading it twice is suicidal. */
65 #include <sys/types.h>
68 #include "dispextern.h"
71 #undef HAVE_MULTILINGUAL_MENU
75 #include <X11/IntrinsicP.h>
76 #include <X11/CoreP.h>
77 #include <X11/StringDefs.h>
78 #include <X11/Shell.h>
80 #include <X11/Xaw/Paned.h>
81 #endif /* USE_LUCID */
82 #include "../lwlib/lwlib.h"
83 #else /* not USE_X_TOOLKIT */
84 #include "../oldXMenu/XMenu.h"
85 #endif /* not USE_X_TOOLKIT */
86 #endif /* HAVE_X_WINDOWS */
93 Lisp_Object Vmenu_updating_frame
;
95 Lisp_Object Qdebug_on_next_call
;
97 extern Lisp_Object Qmenu_bar
;
98 extern Lisp_Object Qmouse_click
, Qevent_kind
;
100 extern Lisp_Object QCtoggle
, QCradio
;
102 extern Lisp_Object Voverriding_local_map
;
103 extern Lisp_Object Voverriding_local_map_menu_flag
;
105 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
107 extern Lisp_Object Qmenu_bar_update_hook
;
110 extern void set_frame_menubar ();
111 extern void process_expose_from_menu ();
112 extern XtAppContext Xt_app_con
;
114 static Lisp_Object
xdialog_show ();
115 void popup_get_selection ();
117 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
122 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
123 Lisp_Object
, Lisp_Object
, Lisp_Object
,
124 Lisp_Object
, Lisp_Object
));
125 static int update_frame_menubar
P_ ((struct frame
*));
126 static Lisp_Object xmenu_show
P_ ((struct frame
*, int, int, int, int,
127 Lisp_Object
, char **));
128 static void keymap_panes
P_ ((Lisp_Object
*, int, int));
129 static void single_keymap_panes
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
131 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
*,
133 static void list_of_panes
P_ ((Lisp_Object
));
134 static void list_of_items
P_ ((Lisp_Object
));
136 /* This holds a Lisp vector that holds the results of decoding
137 the keymaps or alist-of-alists that specify a menu.
139 It describes the panes and items within the panes.
141 Each pane is described by 3 elements in the vector:
142 t, the pane name, the pane's prefix key.
143 Then follow the pane's items, with 5 elements per item:
144 the item string, the enable flag, the item's value,
145 the definition, and the equivalent keyboard key's description string.
147 In some cases, multiple levels of menus may be described.
148 A single vector slot containing nil indicates the start of a submenu.
149 A single vector slot containing lambda indicates the end of a submenu.
150 The submenu follows a menu item which is the way to reach the submenu.
152 A single vector slot containing quote indicates that the
153 following items should appear on the right of a dialog box.
155 Using a Lisp vector to hold this information while we decode it
156 takes care of protecting all the data from GC. */
158 #define MENU_ITEMS_PANE_NAME 1
159 #define MENU_ITEMS_PANE_PREFIX 2
160 #define MENU_ITEMS_PANE_LENGTH 3
164 MENU_ITEMS_ITEM_NAME
= 0,
165 MENU_ITEMS_ITEM_ENABLE
,
166 MENU_ITEMS_ITEM_VALUE
,
167 MENU_ITEMS_ITEM_EQUIV_KEY
,
168 MENU_ITEMS_ITEM_DEFINITION
,
169 MENU_ITEMS_ITEM_TYPE
,
170 MENU_ITEMS_ITEM_SELECTED
,
171 MENU_ITEMS_ITEM_HELP
,
172 MENU_ITEMS_ITEM_LENGTH
175 static Lisp_Object menu_items
;
177 /* Number of slots currently allocated in menu_items. */
178 static int menu_items_allocated
;
180 /* This is the index in menu_items of the first empty slot. */
181 static int menu_items_used
;
183 /* The number of panes currently recorded in menu_items,
184 excluding those within submenus. */
185 static int menu_items_n_panes
;
187 /* Current depth within submenus. */
188 static int menu_items_submenu_depth
;
190 /* Flag which when set indicates a dialog or menu has been posted by
191 Xt on behalf of one of the widget sets. */
192 int popup_activated_flag
;
194 static int next_menubar_widget_id
;
196 /* This is set nonzero after the user activates the menu bar, and set
197 to zero again after the menu bars are redisplayed by prepare_menu_bar.
198 While it is nonzero, all calls to set_frame_menubar go deep.
200 I don't understand why this is needed, but it does seem to be
201 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
203 int pending_menu_activation
;
207 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
209 static struct frame
*
210 menubar_id_to_frame (id
)
213 Lisp_Object tail
, frame
;
216 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
219 if (!GC_FRAMEP (frame
))
222 if (!FRAME_WINDOW_P (f
))
224 if (f
->output_data
.x
->id
== id
)
232 /* Initialize the menu_items structure if we haven't already done so.
233 Also mark it as currently empty. */
238 if (NILP (menu_items
))
240 menu_items_allocated
= 60;
241 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
245 menu_items_n_panes
= 0;
246 menu_items_submenu_depth
= 0;
249 /* Call at the end of generating the data in menu_items.
250 This fills in the number of items in the last pane. */
257 /* Call when finished using the data for the current menu
261 discard_menu_items ()
263 /* Free the structure if it is especially large.
264 Otherwise, hold on to it, to save time. */
265 if (menu_items_allocated
> 200)
268 menu_items_allocated
= 0;
272 /* Make the menu_items vector twice as large. */
278 int old_size
= menu_items_allocated
;
281 menu_items_allocated
*= 2;
282 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
283 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
284 old_size
* sizeof (Lisp_Object
));
287 /* Begin a submenu. */
290 push_submenu_start ()
292 if (menu_items_used
+ 1 > menu_items_allocated
)
295 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
296 menu_items_submenu_depth
++;
304 if (menu_items_used
+ 1 > menu_items_allocated
)
307 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
308 menu_items_submenu_depth
--;
311 /* Indicate boundary between left and right. */
314 push_left_right_boundary ()
316 if (menu_items_used
+ 1 > menu_items_allocated
)
319 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
322 /* Start a new menu pane in menu_items.
323 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
326 push_menu_pane (name
, prefix_vec
)
327 Lisp_Object name
, prefix_vec
;
329 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
332 if (menu_items_submenu_depth
== 0)
333 menu_items_n_panes
++;
334 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
335 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
336 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
339 /* Push one menu item into the current pane. NAME is the string to
340 display. ENABLE if non-nil means this item can be selected. KEY
341 is the key generated by choosing this item, or nil if this item
342 doesn't really have a definition. DEF is the definition of this
343 item. EQUIV is the textual description of the keyboard equivalent
344 for this item (or nil if none). TYPE is the type of this menu
345 item, one of nil, `toggle' or `radio'. */
348 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
349 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
351 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
354 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
355 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
356 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
357 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
358 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
359 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
360 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
361 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
364 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
365 and generate menu panes for them in menu_items.
366 If NOTREAL is nonzero,
367 don't bother really computing whether an item is enabled. */
370 keymap_panes (keymaps
, nmaps
, notreal
)
371 Lisp_Object
*keymaps
;
379 /* Loop over the given keymaps, making a pane for each map.
380 But don't make a pane that is empty--ignore that map instead.
381 P is the number of panes we have made so far. */
382 for (mapno
= 0; mapno
< nmaps
; mapno
++)
383 single_keymap_panes (keymaps
[mapno
],
384 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
386 finish_menu_items ();
389 /* This is a recursive subroutine of keymap_panes.
390 It handles one keymap, KEYMAP.
391 The other arguments are passed along
392 or point to local variables of the previous function.
393 If NOTREAL is nonzero, only check for equivalent key bindings, don't
394 evaluate expressions in menu items and don't make any menu.
396 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
399 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
401 Lisp_Object pane_name
;
406 Lisp_Object pending_maps
= Qnil
;
407 Lisp_Object tail
, item
;
408 struct gcpro gcpro1
, gcpro2
;
414 push_menu_pane (pane_name
, prefix
);
417 /* Remember index for first item in this pane so we can go back and
418 add a prefix when (if) we see the first button. After that, notbuttons
419 is set to 0, to mark that we have seen a button and all non button
420 items need a prefix. */
421 notbuttons
= menu_items_used
;
424 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
426 GCPRO2 (keymap
, pending_maps
);
427 /* Look at each key binding, and if it is a menu item add it
431 single_menu_item (XCAR (item
), XCDR (item
),
432 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
433 else if (VECTORP (item
))
435 /* Loop over the char values represented in the vector. */
436 int len
= XVECTOR (item
)->size
;
438 for (c
= 0; c
< len
; c
++)
440 Lisp_Object character
;
441 XSETFASTINT (character
, c
);
442 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
443 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
449 /* Process now any submenus which want to be panes at this level. */
450 while (!NILP (pending_maps
))
452 Lisp_Object elt
, eltcdr
, string
;
453 elt
= Fcar (pending_maps
);
455 string
= XCAR (eltcdr
);
456 /* We no longer discard the @ from the beginning of the string here.
457 Instead, we do this in xmenu_show. */
458 single_keymap_panes (Fcar (elt
), string
,
459 XCDR (eltcdr
), notreal
, maxdepth
- 1);
460 pending_maps
= Fcdr (pending_maps
);
464 /* This is a subroutine of single_keymap_panes that handles one
466 KEY is a key in a keymap and ITEM is its binding.
467 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
469 If NOTREAL is nonzero, only check for equivalent key bindings, don't
470 evaluate expressions in menu items and don't make any menu.
471 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
472 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
473 buttons. It points to variable notbuttons in single_keymap_panes,
474 which keeps track of if we have seen a button in this menu or not. */
477 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
,
479 Lisp_Object key
, item
;
480 Lisp_Object
*pending_maps_ptr
;
481 int maxdepth
, notreal
;
484 Lisp_Object map
, item_string
, enabled
;
485 struct gcpro gcpro1
, gcpro2
;
488 /* Parse the menu item and leave the result in item_properties. */
490 res
= parse_menu_item (item
, notreal
, 0);
493 return; /* Not a menu item. */
495 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
499 /* We don't want to make a menu, just traverse the keymaps to
500 precompute equivalent key bindings. */
502 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
506 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
507 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
509 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
512 /* An enabled separate pane. Remember this to handle it later. */
513 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
519 /* Simulate radio buttons and toggle boxes by putting a prefix in
522 Lisp_Object prefix
= Qnil
;
523 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
527 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
530 /* The first button. Line up previous items in this menu. */
532 int index
= *notbuttons_ptr
; /* Index for first item this menu. */
535 while (index
< menu_items_used
)
538 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
542 submenu
++; /* Skip sub menu. */
544 else if (EQ (tem
, Qlambda
))
547 submenu
--; /* End sub menu. */
549 else if (EQ (tem
, Qt
))
550 index
+= 3; /* Skip new pane marker. */
551 else if (EQ (tem
, Qquote
))
552 index
++; /* Skip a left, right divider. */
555 if (!submenu
&& XSTRING (tem
)->data
[0] != '\0'
556 && XSTRING (tem
)->data
[0] != '-')
557 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
558 = concat2 (build_string (" "), tem
);
559 index
+= MENU_ITEMS_ITEM_LENGTH
;
565 /* Calculate prefix, if any, for this item. */
566 if (EQ (type
, QCtoggle
))
567 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
568 else if (EQ (type
, QCradio
))
569 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
571 /* Not a button. If we have earlier buttons, then we need a prefix. */
572 else if (!*notbuttons_ptr
&& XSTRING (item_string
)->data
[0] != '\0'
573 && XSTRING (item_string
)->data
[0] != '-')
574 prefix
= build_string (" ");
577 item_string
= concat2 (prefix
, item_string
);
579 #endif /* not HAVE_BOXES */
581 #ifndef USE_X_TOOLKIT
583 /* Indicate visually that this is a submenu. */
584 item_string
= concat2 (item_string
, build_string (" >"));
587 push_menu_item (item_string
, enabled
, key
,
588 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
589 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
590 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
591 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
592 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
595 /* Display a submenu using the toolkit. */
596 if (! (NILP (map
) || NILP (enabled
)))
598 push_submenu_start ();
599 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
605 /* Push all the panes and items of a menu described by the
606 alist-of-alists MENU.
607 This handles old-fashioned calls to x-popup-menu. */
617 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
619 Lisp_Object elt
, pane_name
, pane_data
;
621 pane_name
= Fcar (elt
);
622 CHECK_STRING (pane_name
);
623 push_menu_pane (pane_name
, Qnil
);
624 pane_data
= Fcdr (elt
);
625 CHECK_CONS (pane_data
);
626 list_of_items (pane_data
);
629 finish_menu_items ();
632 /* Push the items in a single pane defined by the alist PANE. */
638 Lisp_Object tail
, item
, item1
;
640 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
644 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
645 else if (NILP (item
))
646 push_left_right_boundary ();
651 CHECK_STRING (item1
);
652 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
657 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
658 doc
: /* Pop up a deck-of-cards menu and return user's selection.
659 POSITION is a position specification. This is either a mouse button event
660 or a list ((XOFFSET YOFFSET) WINDOW)
661 where XOFFSET and YOFFSET are positions in pixels from the top left
662 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)
663 This controls the position of the center of the first line
664 in the first pane of the menu, not the top left of the menu as a whole.
665 If POSITION is t, it means to use the current mouse position.
667 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
668 The menu items come from key bindings that have a menu string as well as
669 a definition; actually, the "definition" in such a key binding looks like
670 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
671 the keymap as a top-level element.
673 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
674 Otherwise, REAL-DEFINITION should be a valid key binding definition.
676 You can also use a list of keymaps as MENU.
677 Then each keymap makes a separate pane.
678 When MENU is a keymap or a list of keymaps, the return value
681 Alternatively, you can specify a menu of multiple panes
682 with a list of the form (TITLE PANE1 PANE2...),
683 where each pane is a list of form (TITLE ITEM1 ITEM2...).
684 Each ITEM is normally a cons cell (STRING . VALUE);
685 but a string can appear as an item--that makes a nonselectable line
687 With this form of menu, the return value is VALUE from the chosen item.
689 If POSITION is nil, don't display the menu at all, just precalculate the
690 cached information about equivalent key sequences. */)
692 Lisp_Object position
, menu
;
694 Lisp_Object keymap
, tem
;
695 int xpos
= 0, ypos
= 0;
698 Lisp_Object selection
;
700 Lisp_Object x
, y
, window
;
706 if (! NILP (position
))
710 /* Decode the first argument: find the window and the coordinates. */
711 if (EQ (position
, Qt
)
712 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
713 || EQ (XCAR (position
), Qtool_bar
))))
715 /* Use the mouse's current position. */
716 FRAME_PTR new_f
= SELECTED_FRAME ();
717 Lisp_Object bar_window
;
718 enum scroll_bar_part part
;
721 if (mouse_position_hook
)
722 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
723 &part
, &x
, &y
, &time
);
725 XSETFRAME (window
, new_f
);
728 window
= selected_window
;
735 tem
= Fcar (position
);
738 window
= Fcar (Fcdr (position
));
740 y
= Fcar (Fcdr (tem
));
745 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
746 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
747 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
756 /* Decode where to put the menu. */
764 else if (WINDOWP (window
))
766 CHECK_LIVE_WINDOW (window
);
767 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
769 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
770 * XFASTINT (XWINDOW (window
)->left
));
771 ypos
= (FRAME_LINE_HEIGHT (f
)
772 * XFASTINT (XWINDOW (window
)->top
));
775 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
776 but I don't want to make one now. */
777 CHECK_WINDOW (window
);
782 XSETFRAME (Vmenu_updating_frame
, f
);
784 Vmenu_updating_frame
= Qnil
;
785 #endif /* HAVE_MENUS */
790 /* Decode the menu items from what was specified. */
792 keymap
= get_keymap (menu
, 0, 0);
795 /* We were given a keymap. Extract menu info from the keymap. */
798 /* Extract the detailed info to make one pane. */
799 keymap_panes (&menu
, 1, NILP (position
));
801 /* Search for a string appearing directly as an element of the keymap.
802 That string is the title of the menu. */
803 prompt
= Fkeymap_prompt (keymap
);
804 if (NILP (title
) && !NILP (prompt
))
807 /* Make that be the pane title of the first pane. */
808 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
809 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
813 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
815 /* We were given a list of keymaps. */
816 int nmaps
= XFASTINT (Flength (menu
));
818 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
823 /* The first keymap that has a prompt string
824 supplies the menu title. */
825 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
829 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
831 prompt
= Fkeymap_prompt (keymap
);
832 if (NILP (title
) && !NILP (prompt
))
836 /* Extract the detailed info to make one pane. */
837 keymap_panes (maps
, nmaps
, NILP (position
));
839 /* Make the title be the pane title of the first pane. */
840 if (!NILP (title
) && menu_items_n_panes
>= 0)
841 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
847 /* We were given an old-fashioned menu. */
849 CHECK_STRING (title
);
851 list_of_panes (Fcdr (menu
));
858 discard_menu_items ();
864 /* Display them in a menu. */
867 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
868 keymaps
, title
, &error_name
);
871 discard_menu_items ();
874 #endif /* HAVE_MENUS */
876 if (error_name
) error (error_name
);
882 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
883 doc
: /* Pop up a dialog box and return user's selection.
884 POSITION specifies which frame to use.
885 This is normally a mouse button event or a window or frame.
886 If POSITION is t, it means to use the frame the mouse is on.
887 The dialog box appears in the middle of the specified frame.
889 CONTENTS specifies the alternatives to display in the dialog box.
890 It is a list of the form (TITLE ITEM1 ITEM2...).
891 Each ITEM is a cons cell (STRING . VALUE).
892 The return value is VALUE from the chosen item.
894 An ITEM may also be just a string--that makes a nonselectable item.
895 An ITEM may also be nil--that means to put all preceding items
896 on the left of the dialog box and all following items on the right.
897 \(By default, approximately half appear on each side.) */)
899 Lisp_Object position
, contents
;
906 /* Decode the first argument: find the window or frame to use. */
907 if (EQ (position
, Qt
)
908 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
909 || EQ (XCAR (position
), Qtool_bar
))))
911 #if 0 /* Using the frame the mouse is on may not be right. */
912 /* Use the mouse's current position. */
913 FRAME_PTR new_f
= SELECTED_FRAME ();
914 Lisp_Object bar_window
;
915 enum scroll_bar_part part
;
919 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
922 XSETFRAME (window
, new_f
);
924 window
= selected_window
;
926 window
= selected_window
;
928 else if (CONSP (position
))
931 tem
= Fcar (position
);
933 window
= Fcar (Fcdr (position
));
936 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
937 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
940 else if (WINDOWP (position
) || FRAMEP (position
))
945 /* Decode where to put the menu. */
949 else if (WINDOWP (window
))
951 CHECK_LIVE_WINDOW (window
);
952 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
955 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
956 but I don't want to make one now. */
957 CHECK_WINDOW (window
);
959 #ifndef USE_X_TOOLKIT
960 /* Display a menu with these alternatives
961 in the middle of frame F. */
963 Lisp_Object x
, y
, frame
, newpos
;
964 XSETFRAME (frame
, f
);
965 XSETINT (x
, x_pixel_width (f
) / 2);
966 XSETINT (y
, x_pixel_height (f
) / 2);
967 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
969 return Fx_popup_menu (newpos
,
970 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
976 Lisp_Object selection
;
978 /* Decode the dialog items from what was specified. */
979 title
= Fcar (contents
);
980 CHECK_STRING (title
);
982 list_of_panes (Fcons (contents
, Qnil
));
984 /* Display them in a dialog box. */
986 selection
= xdialog_show (f
, 0, title
, &error_name
);
989 discard_menu_items ();
991 if (error_name
) error (error_name
);
999 /* Loop in Xt until the menu pulldown or dialog popup has been
1000 popped down (deactivated). This is used for x-popup-menu
1001 and x-popup-dialog; it is not used for the menu bar any more.
1003 NOTE: All calls to popup_get_selection should be protected
1004 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1007 popup_get_selection (initial_event
, dpyinfo
, id
)
1008 XEvent
*initial_event
;
1009 struct x_display_info
*dpyinfo
;
1014 /* Define a queue to save up for later unreading
1015 all X events that don't pertain to the menu. */
1019 struct event_queue
*next
;
1022 struct event_queue
*queue
= NULL
;
1023 struct event_queue
*queue_tmp
;
1026 event
= *initial_event
;
1028 XtAppNextEvent (Xt_app_con
, &event
);
1032 /* Handle expose events for editor frames right away. */
1033 if (event
.type
== Expose
)
1034 process_expose_from_menu (event
);
1035 /* Make sure we don't consider buttons grabbed after menu goes.
1036 And make sure to deactivate for any ButtonRelease,
1037 even if XtDispatchEvent doesn't do that. */
1038 else if (event
.type
== ButtonRelease
1039 && dpyinfo
->display
== event
.xbutton
.display
)
1041 dpyinfo
->grabbed
&= ~(1 << event
.xbutton
.button
);
1042 popup_activated_flag
= 0;
1043 #ifdef USE_MOTIF /* Pretending that the event came from a
1044 Btn1Down seems the only way to convince Motif to
1045 activate its callbacks; setting the XmNmenuPost
1046 isn't working. --marcus@sysc.pdx.edu. */
1047 event
.xbutton
.button
= 1;
1050 /* If the user presses a key, deactivate the menu.
1051 The user is likely to do that if we get wedged. */
1052 else if (event
.type
== KeyPress
1053 && dpyinfo
->display
== event
.xbutton
.display
)
1055 KeySym keysym
= XLookupKeysym (&event
.xkey
, 0);
1056 if (!IsModifierKey (keysym
))
1058 popup_activated_flag
= 0;
1062 /* Button presses outside the menu also pop it down. */
1063 else if (event
.type
== ButtonPress
1064 && event
.xany
.display
== dpyinfo
->display
1065 && x_any_window_to_frame (dpyinfo
, event
.xany
.window
))
1067 popup_activated_flag
= 0;
1071 /* Queue all events not for this popup,
1072 except for Expose, which we've already handled, and ButtonRelease.
1073 Note that the X window is associated with the frame if this
1074 is a menu bar popup, but not if it's a dialog box. So we use
1075 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1076 if (event
.type
!= Expose
1077 && !(event
.type
== ButtonRelease
1078 && dpyinfo
->display
== event
.xbutton
.display
)
1079 && (event
.xany
.display
!= dpyinfo
->display
1080 || x_non_menubar_window_to_frame (dpyinfo
, event
.xany
.window
)))
1082 queue_tmp
= (struct event_queue
*) xmalloc (sizeof *queue_tmp
);
1083 queue_tmp
->event
= event
;
1084 queue_tmp
->next
= queue
;
1088 XtDispatchEvent (&event
);
1090 if (!popup_activated ())
1092 XtAppNextEvent (Xt_app_con
, &event
);
1095 /* Unread any events that we got but did not handle. */
1096 while (queue
!= NULL
)
1099 XPutBackEvent (queue_tmp
->event
.xany
.display
, &queue_tmp
->event
);
1100 queue
= queue_tmp
->next
;
1101 xfree ((char *)queue_tmp
);
1102 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1103 interrupt_input_pending
= 1;
1107 /* Activate the menu bar of frame F.
1108 This is called from keyboard.c when it gets the
1109 menu_bar_activate_event out of the Emacs event queue.
1111 To activate the menu bar, we use the X button-press event
1112 that was saved in saved_menu_event.
1113 That makes the toolkit do its thing.
1115 But first we recompute the menu bar contents (the whole tree).
1117 The reason for saving the button event until here, instead of
1118 passing it to the toolkit right away, is that we can safely
1119 execute Lisp code. */
1122 x_activate_menubar (f
)
1125 if (!f
->output_data
.x
->saved_menu_event
->type
)
1128 set_frame_menubar (f
, 0, 1);
1130 XtDispatchEvent ((XEvent
*) f
->output_data
.x
->saved_menu_event
);
1133 if (f
->output_data
.x
->saved_menu_event
->type
== ButtonRelease
)
1134 pending_menu_activation
= 1;
1137 /* Ignore this if we get it a second time. */
1138 f
->output_data
.x
->saved_menu_event
->type
= 0;
1141 /* Detect if a dialog or menu has been posted. */
1146 return popup_activated_flag
;
1149 /* This callback is invoked when the user selects a menubar cascade
1150 pushbutton, but before the pulldown menu is posted. */
1153 popup_activate_callback (widget
, id
, client_data
)
1156 XtPointer client_data
;
1158 popup_activated_flag
= 1;
1161 /* This callback is invoked when a dialog or menu is finished being
1162 used and has been unposted. */
1165 popup_deactivate_callback (widget
, id
, client_data
)
1168 XtPointer client_data
;
1170 popup_activated_flag
= 0;
1173 /* Lwlib callback called when menu items are highlighted/unhighlighted
1174 while moving the mouse over them. WIDGET is the menu bar or menu
1175 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1176 the widget_value structure for the menu item, or null in case of
1180 menu_highlight_callback (widget
, id
, call_data
)
1185 widget_value
*wv
= (widget_value
*) call_data
;
1187 Lisp_Object frame
, help
;
1189 help
= wv
&& wv
->help
? build_string (wv
->help
) : Qnil
;
1191 /* Determine the frame for the help event. */
1192 f
= menubar_id_to_frame (id
);
1195 XSETFRAME (frame
, f
);
1196 kbd_buffer_store_help_event (frame
, help
);
1200 /* WIDGET is the popup menu. It's parent is the frame's
1201 widget. See which frame that is. */
1202 Widget frame_widget
= XtParent (widget
);
1205 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
1207 frame
= XCAR (tail
);
1208 if (GC_FRAMEP (frame
)
1209 && (f
= XFRAME (frame
),
1210 FRAME_X_P (f
) && f
->output_data
.x
->widget
== frame_widget
))
1214 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
1218 /* This callback is called from the menu bar pulldown menu
1219 when the user makes a selection.
1220 Figure out what the user chose
1221 and put the appropriate events into the keyboard buffer. */
1224 menubar_selection_callback (widget
, id
, client_data
)
1227 XtPointer client_data
;
1229 Lisp_Object prefix
, entry
;
1230 FRAME_PTR f
= menubar_id_to_frame (id
);
1232 Lisp_Object
*subprefix_stack
;
1233 int submenu_depth
= 0;
1239 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1240 vector
= f
->menu_bar_vector
;
1243 while (i
< f
->menu_bar_items_used
)
1245 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1247 subprefix_stack
[submenu_depth
++] = prefix
;
1251 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1253 prefix
= subprefix_stack
[--submenu_depth
];
1256 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1258 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1259 i
+= MENU_ITEMS_PANE_LENGTH
;
1263 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1264 /* The EMACS_INT cast avoids a warning. There's no problem
1265 as long as pointers have enough bits to hold small integers. */
1266 if ((int) (EMACS_INT
) client_data
== i
)
1269 struct input_event buf
;
1272 XSETFRAME (frame
, f
);
1273 buf
.kind
= MENU_BAR_EVENT
;
1274 buf
.frame_or_window
= frame
;
1276 kbd_buffer_store_event (&buf
);
1278 for (j
= 0; j
< submenu_depth
; j
++)
1279 if (!NILP (subprefix_stack
[j
]))
1281 buf
.kind
= MENU_BAR_EVENT
;
1282 buf
.frame_or_window
= frame
;
1283 buf
.arg
= subprefix_stack
[j
];
1284 kbd_buffer_store_event (&buf
);
1289 buf
.kind
= MENU_BAR_EVENT
;
1290 buf
.frame_or_window
= frame
;
1292 kbd_buffer_store_event (&buf
);
1295 buf
.kind
= MENU_BAR_EVENT
;
1296 buf
.frame_or_window
= frame
;
1298 kbd_buffer_store_event (&buf
);
1302 i
+= MENU_ITEMS_ITEM_LENGTH
;
1307 /* Allocate a widget_value, blocking input. */
1310 xmalloc_widget_value ()
1312 widget_value
*value
;
1315 value
= malloc_widget_value ();
1321 /* This recursively calls free_widget_value on the tree of widgets.
1322 It must free all data that was malloc'ed for these widget_values.
1323 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1324 must be left alone. */
1327 free_menubar_widget_value_tree (wv
)
1332 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1334 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1336 free_menubar_widget_value_tree (wv
->contents
);
1337 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1341 free_menubar_widget_value_tree (wv
->next
);
1342 wv
->next
= (widget_value
*) 0xDEADBEEF;
1345 free_widget_value (wv
);
1349 /* Return a tree of widget_value structures for a menu bar item
1350 whose event type is ITEM_KEY (with string ITEM_NAME)
1351 and whose contents come from the list of keymaps MAPS. */
1353 static widget_value
*
1354 single_submenu (item_key
, item_name
, maps
)
1355 Lisp_Object item_key
, item_name
, maps
;
1357 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1359 int submenu_depth
= 0;
1362 Lisp_Object
*mapvec
;
1363 widget_value
**submenu_stack
;
1364 int previous_items
= menu_items_used
;
1365 int top_level_items
= 0;
1367 length
= Flength (maps
);
1368 len
= XINT (length
);
1370 /* Convert the list MAPS into a vector MAPVEC. */
1371 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1372 for (i
= 0; i
< len
; i
++)
1374 mapvec
[i
] = Fcar (maps
);
1378 menu_items_n_panes
= 0;
1380 /* Loop over the given keymaps, making a pane for each map.
1381 But don't make a pane that is empty--ignore that map instead. */
1382 for (i
= 0; i
< len
; i
++)
1384 if (SYMBOLP (mapvec
[i
])
1385 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1387 /* Here we have a command at top level in the menu bar
1388 as opposed to a submenu. */
1389 top_level_items
= 1;
1390 push_menu_pane (Qnil
, Qnil
);
1391 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1392 Qnil
, Qnil
, Qnil
, Qnil
);
1395 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1398 /* Create a tree of widget_value objects
1399 representing the panes and their items. */
1402 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1403 wv
= xmalloc_widget_value ();
1407 wv
->button_type
= BUTTON_TYPE_NONE
;
1412 /* Loop over all panes and items made during this call
1413 and construct a tree of widget_value objects.
1414 Ignore the panes and items made by previous calls to
1415 single_submenu, even though those are also in menu_items. */
1417 while (i
< menu_items_used
)
1419 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1421 submenu_stack
[submenu_depth
++] = save_wv
;
1426 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1429 save_wv
= submenu_stack
[--submenu_depth
];
1432 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1433 && submenu_depth
!= 0)
1434 i
+= MENU_ITEMS_PANE_LENGTH
;
1435 /* Ignore a nil in the item list.
1436 It's meaningful only for dialog boxes. */
1437 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1439 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1441 /* Create a new pane. */
1442 Lisp_Object pane_name
, prefix
;
1445 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1446 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1448 #ifndef HAVE_MULTILINGUAL_MENU
1449 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1451 pane_name
= ENCODE_SYSTEM (pane_name
);
1452 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1455 pane_string
= (NILP (pane_name
)
1456 ? "" : (char *) XSTRING (pane_name
)->data
);
1457 /* If there is just one top-level pane, put all its items directly
1458 under the top-level menu. */
1459 if (menu_items_n_panes
== 1)
1462 /* If the pane has a meaningful name,
1463 make the pane a top-level menu item
1464 with its items as a submenu beneath it. */
1465 if (strcmp (pane_string
, ""))
1467 wv
= xmalloc_widget_value ();
1471 first_wv
->contents
= wv
;
1472 wv
->name
= pane_string
;
1473 /* Ignore the @ that means "separate pane".
1474 This is a kludge, but this isn't worth more time. */
1475 if (!NILP (prefix
) && wv
->name
[0] == '@')
1479 wv
->button_type
= BUTTON_TYPE_NONE
;
1483 i
+= MENU_ITEMS_PANE_LENGTH
;
1487 /* Create a new item within current pane. */
1488 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1491 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1492 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1493 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1494 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1495 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1496 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1497 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1499 #ifndef HAVE_MULTILINGUAL_MENU
1500 if (STRING_MULTIBYTE (item_name
))
1502 item_name
= ENCODE_SYSTEM (item_name
);
1503 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1506 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1508 descrip
= ENCODE_SYSTEM (descrip
);
1509 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1511 #endif /* not HAVE_MULTILINGUAL_MENU */
1513 wv
= xmalloc_widget_value ();
1517 save_wv
->contents
= wv
;
1519 wv
->name
= (char *) XSTRING (item_name
)->data
;
1520 if (!NILP (descrip
))
1521 wv
->key
= (char *) XSTRING (descrip
)->data
;
1523 /* The EMACS_INT cast avoids a warning. There's no problem
1524 as long as pointers have enough bits to hold small integers. */
1525 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1526 wv
->enabled
= !NILP (enable
);
1529 wv
->button_type
= BUTTON_TYPE_NONE
;
1530 else if (EQ (type
, QCradio
))
1531 wv
->button_type
= BUTTON_TYPE_RADIO
;
1532 else if (EQ (type
, QCtoggle
))
1533 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1537 wv
->selected
= !NILP (selected
);
1539 wv
->help
= (char *) XSTRING (help
)->data
;
1545 i
+= MENU_ITEMS_ITEM_LENGTH
;
1549 /* If we have just one "menu item"
1550 that was originally a button, return it by itself. */
1551 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1553 wv
= first_wv
->contents
;
1554 free_widget_value (first_wv
);
1563 /* Recompute all the widgets of frame F, when the menu bar has been
1564 changed. Value is non-zero if widgets were updated. */
1567 update_frame_menubar (f
)
1570 struct x_output
*x
= f
->output_data
.x
;
1573 if (!x
->menubar_widget
|| XtIsManaged (x
->menubar_widget
))
1577 /* Save the size of the frame because the pane widget doesn't accept
1578 to resize itself. So force it. */
1582 /* Do the voodoo which means "I'm changing lots of things, don't try
1583 to refigure sizes until I'm done." */
1584 lw_refigure_widget (x
->column_widget
, False
);
1586 /* The order in which children are managed is the top to bottom
1587 order in which they are displayed in the paned window. First,
1588 remove the text-area widget. */
1589 XtUnmanageChild (x
->edit_widget
);
1591 /* Remove the menubar that is there now, and put up the menubar that
1593 XtManageChild (x
->menubar_widget
);
1594 XtMapWidget (x
->menubar_widget
);
1595 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, NULL
);
1597 /* Re-manage the text-area widget, and then thrash the sizes. */
1598 XtManageChild (x
->edit_widget
);
1599 lw_refigure_widget (x
->column_widget
, True
);
1601 /* Force the pane widget to resize itself with the right values. */
1602 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1607 /* Set the contents of the menubar widgets of frame F.
1608 The argument FIRST_TIME is currently ignored;
1609 it is set the first time this is called, from initialize_frame_menubar. */
1612 set_frame_menubar (f
, first_time
, deep_p
)
1617 Widget menubar_widget
= f
->output_data
.x
->menubar_widget
;
1619 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1624 XSETFRAME (Vmenu_updating_frame
, f
);
1626 if (f
->output_data
.x
->id
== 0)
1627 f
->output_data
.x
->id
= next_menubar_widget_id
++;
1628 id
= f
->output_data
.x
->id
;
1630 if (! menubar_widget
)
1632 else if (pending_menu_activation
&& !deep_p
)
1634 /* Make the first call for any given frame always go deep. */
1635 else if (!f
->output_data
.x
->saved_menu_event
&& !deep_p
)
1638 f
->output_data
.x
->saved_menu_event
= (XEvent
*)xmalloc (sizeof (XEvent
));
1639 f
->output_data
.x
->saved_menu_event
->type
= 0;
1642 wv
= xmalloc_widget_value ();
1643 wv
->name
= "menubar";
1646 wv
->button_type
= BUTTON_TYPE_NONE
;
1651 /* Make a widget-value tree representing the entire menu trees. */
1653 struct buffer
*prev
= current_buffer
;
1655 int specpdl_count
= specpdl_ptr
- specpdl
;
1656 int previous_menu_items_used
= f
->menu_bar_items_used
;
1657 Lisp_Object
*previous_items
1658 = (Lisp_Object
*) alloca (previous_menu_items_used
1659 * sizeof (Lisp_Object
));
1661 /* If we are making a new widget, its contents are empty,
1662 do always reinitialize them. */
1663 if (! menubar_widget
)
1664 previous_menu_items_used
= 0;
1666 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1667 specbind (Qinhibit_quit
, Qt
);
1668 /* Don't let the debugger step into this code
1669 because it is not reentrant. */
1670 specbind (Qdebug_on_next_call
, Qnil
);
1672 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1673 if (NILP (Voverriding_local_map_menu_flag
))
1675 specbind (Qoverriding_terminal_local_map
, Qnil
);
1676 specbind (Qoverriding_local_map
, Qnil
);
1679 set_buffer_internal_1 (XBUFFER (buffer
));
1681 /* Run the Lucid hook. */
1682 safe_run_hooks (Qactivate_menubar_hook
);
1684 /* If it has changed current-menubar from previous value,
1685 really recompute the menubar from the value. */
1686 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1687 call0 (Qrecompute_lucid_menubar
);
1688 safe_run_hooks (Qmenu_bar_update_hook
);
1689 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1691 items
= FRAME_MENU_BAR_ITEMS (f
);
1693 inhibit_garbage_collection ();
1695 /* Save the frame's previous menu bar contents data. */
1696 if (previous_menu_items_used
)
1697 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1698 previous_menu_items_used
* sizeof (Lisp_Object
));
1700 /* Fill in the current menu bar contents. */
1701 menu_items
= f
->menu_bar_vector
;
1702 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1704 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1706 Lisp_Object key
, string
, maps
;
1708 key
= XVECTOR (items
)->contents
[i
];
1709 string
= XVECTOR (items
)->contents
[i
+ 1];
1710 maps
= XVECTOR (items
)->contents
[i
+ 2];
1714 wv
= single_submenu (key
, string
, maps
);
1718 first_wv
->contents
= wv
;
1719 /* Don't set wv->name here; GC during the loop might relocate it. */
1721 wv
->button_type
= BUTTON_TYPE_NONE
;
1725 finish_menu_items ();
1727 set_buffer_internal_1 (prev
);
1728 unbind_to (specpdl_count
, Qnil
);
1730 /* If there has been no change in the Lisp-level contents
1731 of the menu bar, skip redisplaying it. Just exit. */
1733 for (i
= 0; i
< previous_menu_items_used
; i
++)
1734 if (menu_items_used
== i
1735 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1737 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1739 free_menubar_widget_value_tree (first_wv
);
1745 /* Now GC cannot happen during the lifetime of the widget_value,
1746 so it's safe to store data from a Lisp_String. */
1747 wv
= first_wv
->contents
;
1748 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1751 string
= XVECTOR (items
)->contents
[i
+ 1];
1754 wv
->name
= (char *) XSTRING (string
)->data
;
1758 f
->menu_bar_vector
= menu_items
;
1759 f
->menu_bar_items_used
= menu_items_used
;
1764 /* Make a widget-value tree containing
1765 just the top level menu bar strings. */
1767 items
= FRAME_MENU_BAR_ITEMS (f
);
1768 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1772 string
= XVECTOR (items
)->contents
[i
+ 1];
1776 wv
= xmalloc_widget_value ();
1777 wv
->name
= (char *) XSTRING (string
)->data
;
1780 wv
->button_type
= BUTTON_TYPE_NONE
;
1781 /* This prevents lwlib from assuming this
1782 menu item is really supposed to be empty. */
1783 /* The EMACS_INT cast avoids a warning.
1784 This value just has to be different from small integers. */
1785 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1790 first_wv
->contents
= wv
;
1794 /* Forget what we thought we knew about what is in the
1795 detailed contents of the menu bar menus.
1796 Changing the top level always destroys the contents. */
1797 f
->menu_bar_items_used
= 0;
1800 /* Create or update the menu bar widget. */
1806 /* Disable resizing (done for Motif!) */
1807 lw_allow_resizing (f
->output_data
.x
->widget
, False
);
1809 /* The third arg is DEEP_P, which says to consider the entire
1810 menu trees we supply, rather than just the menu bar item names. */
1811 lw_modify_all_widgets (id
, first_wv
, deep_p
);
1813 /* Re-enable the edit widget to resize. */
1814 lw_allow_resizing (f
->output_data
.x
->widget
, True
);
1818 menubar_widget
= lw_create_widget ("menubar", "menubar", id
, first_wv
,
1819 f
->output_data
.x
->column_widget
,
1821 popup_activate_callback
,
1822 menubar_selection_callback
,
1823 popup_deactivate_callback
,
1824 menu_highlight_callback
);
1825 f
->output_data
.x
->menubar_widget
= menubar_widget
;
1830 = (f
->output_data
.x
->menubar_widget
1831 ? (f
->output_data
.x
->menubar_widget
->core
.height
1832 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
1835 #if 0 /* Experimentally, we now get the right results
1836 for -geometry -0-0 without this. 24 Aug 96, rms. */
1838 if (FRAME_EXTERNAL_MENU_BAR (f
))
1841 XtVaGetValues (f
->output_data
.x
->column_widget
,
1842 XtNinternalBorderWidth
, &ibw
, NULL
);
1843 menubar_size
+= ibw
;
1845 #endif /* USE_LUCID */
1848 f
->output_data
.x
->menubar_height
= menubar_size
;
1851 free_menubar_widget_value_tree (first_wv
);
1852 update_frame_menubar (f
);
1857 /* Called from Fx_create_frame to create the initial menubar of a frame
1858 before it is mapped, so that the window is mapped with the menubar already
1859 there instead of us tacking it on later and thrashing the window after it
1863 initialize_frame_menubar (f
)
1866 /* This function is called before the first chance to redisplay
1867 the frame. It has to be, so the frame will have the right size. */
1868 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1869 set_frame_menubar (f
, 1, 1);
1873 /* Get rid of the menu bar of frame F, and free its storage.
1874 This is used when deleting a frame, and when turning off the menu bar. */
1877 free_frame_menubar (f
)
1880 Widget menubar_widget
;
1882 menubar_widget
= f
->output_data
.x
->menubar_widget
;
1884 f
->output_data
.x
->menubar_height
= 0;
1889 /* Removing the menu bar magically changes the shell widget's x
1890 and y position of (0, 0) which, when the menu bar is turned
1891 on again, leads to pull-down menuss appearing in strange
1892 positions near the upper-left corner of the display. This
1893 happens only with some window managers like twm and ctwm,
1894 but not with other like Motif's mwm or kwm, because the
1895 latter generate ConfigureNotify events when the menu bar
1896 is switched off, which fixes the shell position. */
1897 Position x0
, y0
, x1
, y1
;
1903 if (f
->output_data
.x
->widget
)
1904 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x0
, XtNy
, &y0
, NULL
);
1907 lw_destroy_all_widgets ((LWLIB_ID
) f
->output_data
.x
->id
);
1908 f
->output_data
.x
->menubar_widget
= NULL
;
1911 if (f
->output_data
.x
->widget
)
1913 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x1
, XtNy
, &y1
, NULL
);
1914 if (x1
== 0 && y1
== 0)
1915 XtVaSetValues (f
->output_data
.x
->widget
, XtNx
, x0
, XtNy
, y0
, NULL
);
1923 #endif /* USE_X_TOOLKIT */
1925 /* xmenu_show actually displays a menu using the panes and items in menu_items
1926 and returns the value selected from it.
1927 There are two versions of xmenu_show, one for Xt and one for Xlib.
1928 Both assume input is blocked by the caller. */
1930 /* F is the frame the menu is for.
1931 X and Y are the frame-relative specified position,
1932 relative to the inside upper left corner of the frame F.
1933 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1934 KEYMAPS is 1 if this menu was specified with keymaps;
1935 in that case, we return a list containing the chosen item's value
1936 and perhaps also the pane's prefix.
1937 TITLE is the specified menu title.
1938 ERROR is a place to store an error message string in case of failure.
1939 (We return nil on failure, but the value doesn't actually matter.) */
1941 #ifdef USE_X_TOOLKIT
1943 /* We need a unique id for each widget handled by the Lucid Widget
1946 For the main windows, and popup menus, we use this counter,
1947 which we increment each time after use. This starts from 1<<16.
1949 For menu bars, we use numbers starting at 0, counted in
1950 next_menubar_widget_id. */
1951 LWLIB_ID widget_id_tick
;
1953 static Lisp_Object
*volatile menu_item_selection
;
1956 popup_selection_callback (widget
, id
, client_data
)
1959 XtPointer client_data
;
1961 menu_item_selection
= (Lisp_Object
*) client_data
;
1965 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1979 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1980 widget_value
**submenu_stack
1981 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1982 Lisp_Object
*subprefix_stack
1983 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1984 int submenu_depth
= 0;
1985 XButtonPressedEvent dummy
;
1991 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1993 *error
= "Empty menu";
1997 /* Create a tree of widget_value objects
1998 representing the panes and their items. */
1999 wv
= xmalloc_widget_value ();
2003 wv
->button_type
= BUTTON_TYPE_NONE
;
2007 /* Loop over all panes and items, filling in the tree. */
2009 while (i
< menu_items_used
)
2011 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2013 submenu_stack
[submenu_depth
++] = save_wv
;
2019 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2022 save_wv
= submenu_stack
[--submenu_depth
];
2026 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
2027 && submenu_depth
!= 0)
2028 i
+= MENU_ITEMS_PANE_LENGTH
;
2029 /* Ignore a nil in the item list.
2030 It's meaningful only for dialog boxes. */
2031 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2033 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2035 /* Create a new pane. */
2036 Lisp_Object pane_name
, prefix
;
2039 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
2040 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2042 #ifndef HAVE_MULTILINGUAL_MENU
2043 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
2045 pane_name
= ENCODE_SYSTEM (pane_name
);
2046 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
2049 pane_string
= (NILP (pane_name
)
2050 ? "" : (char *) XSTRING (pane_name
)->data
);
2051 /* If there is just one top-level pane, put all its items directly
2052 under the top-level menu. */
2053 if (menu_items_n_panes
== 1)
2056 /* If the pane has a meaningful name,
2057 make the pane a top-level menu item
2058 with its items as a submenu beneath it. */
2059 if (!keymaps
&& strcmp (pane_string
, ""))
2061 wv
= xmalloc_widget_value ();
2065 first_wv
->contents
= wv
;
2066 wv
->name
= pane_string
;
2067 if (keymaps
&& !NILP (prefix
))
2071 wv
->button_type
= BUTTON_TYPE_NONE
;
2075 else if (first_pane
)
2081 i
+= MENU_ITEMS_PANE_LENGTH
;
2085 /* Create a new item within current pane. */
2086 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
2087 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2088 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2089 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2090 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
2091 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
2092 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
2093 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2095 #ifndef HAVE_MULTILINGUAL_MENU
2096 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2098 item_name
= ENCODE_SYSTEM (item_name
);
2099 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2102 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2104 descrip
= ENCODE_SYSTEM (descrip
);
2105 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2107 #endif /* not HAVE_MULTILINGUAL_MENU */
2109 wv
= xmalloc_widget_value ();
2113 save_wv
->contents
= wv
;
2114 wv
->name
= (char *) XSTRING (item_name
)->data
;
2115 if (!NILP (descrip
))
2116 wv
->key
= (char *) XSTRING (descrip
)->data
;
2118 /* If this item has a null value,
2119 make the call_data null so that it won't display a box
2120 when the mouse is on it. */
2122 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
2123 wv
->enabled
= !NILP (enable
);
2126 wv
->button_type
= BUTTON_TYPE_NONE
;
2127 else if (EQ (type
, QCtoggle
))
2128 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2129 else if (EQ (type
, QCradio
))
2130 wv
->button_type
= BUTTON_TYPE_RADIO
;
2134 wv
->selected
= !NILP (selected
);
2137 wv
->help
= (char *) XSTRING (help
)->data
;
2143 i
+= MENU_ITEMS_ITEM_LENGTH
;
2147 /* Deal with the title, if it is non-nil. */
2150 widget_value
*wv_title
= xmalloc_widget_value ();
2151 widget_value
*wv_sep1
= xmalloc_widget_value ();
2152 widget_value
*wv_sep2
= xmalloc_widget_value ();
2154 wv_sep2
->name
= "--";
2155 wv_sep2
->next
= first_wv
->contents
;
2157 wv_sep1
->name
= "--";
2158 wv_sep1
->next
= wv_sep2
;
2160 #ifndef HAVE_MULTILINGUAL_MENU
2161 if (STRING_MULTIBYTE (title
))
2162 title
= ENCODE_SYSTEM (title
);
2165 wv_title
->name
= (char *) XSTRING (title
)->data
;
2166 wv_title
->enabled
= TRUE
;
2167 wv_title
->button_type
= BUTTON_TYPE_NONE
;
2168 wv_title
->next
= wv_sep1
;
2169 first_wv
->contents
= wv_title
;
2172 /* Actually create the menu. */
2173 menu_id
= widget_id_tick
++;
2174 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
2175 f
->output_data
.x
->widget
, 1, 0,
2176 popup_selection_callback
,
2177 popup_deactivate_callback
,
2178 menu_highlight_callback
);
2180 /* Adjust coordinates to relative to the outer (window manager) window. */
2183 int win_x
= 0, win_y
= 0;
2185 /* Find the position of the outside upper-left corner of
2186 the inner window, with respect to the outer window. */
2187 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2190 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2192 /* From-window, to-window. */
2193 f
->output_data
.x
->window_desc
,
2194 f
->output_data
.x
->parent_desc
,
2196 /* From-position, to-position. */
2197 0, 0, &win_x
, &win_y
,
2199 /* Child of window. */
2207 /* Adjust coordinates to be root-window-relative. */
2208 x
+= f
->output_data
.x
->left_pos
;
2209 y
+= f
->output_data
.x
->top_pos
;
2211 dummy
.type
= ButtonPress
;
2213 dummy
.send_event
= 0;
2214 dummy
.display
= FRAME_X_DISPLAY (f
);
2215 dummy
.time
= CurrentTime
;
2216 dummy
.root
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
2217 dummy
.window
= dummy
.root
;
2218 dummy
.subwindow
= dummy
.root
;
2223 dummy
.state
= (FRAME_X_DISPLAY_INFO (f
)->grabbed
>> 1) * Button1Mask
;
2225 for (i
= 0; i
< 5; i
++)
2226 if (FRAME_X_DISPLAY_INFO (f
)->grabbed
& (1 << i
))
2229 /* Don't allow any geometry request from the user. */
2230 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
2231 XtSetValues (menu
, av
, ac
);
2233 /* Free the widget_value objects we used to specify the contents. */
2234 free_menubar_widget_value_tree (first_wv
);
2236 /* No selection has been chosen yet. */
2237 menu_item_selection
= 0;
2239 /* Display the menu. */
2240 lw_popup_menu (menu
, (XEvent
*) &dummy
);
2241 popup_activated_flag
= 1;
2243 /* Process events that apply to the menu. */
2244 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), menu_id
);
2246 /* fp turned off the following statement and wrote a comment
2247 that it is unnecessary--that the menu has already disappeared.
2248 Nowadays the menu disappears ok, all right, but
2249 we need to delete the widgets or multiple ones will pile up. */
2250 lw_destroy_all_widgets (menu_id
);
2252 /* Find the selected item, and its pane, to return
2253 the proper value. */
2254 if (menu_item_selection
!= 0)
2256 Lisp_Object prefix
, entry
;
2258 prefix
= entry
= Qnil
;
2260 while (i
< menu_items_used
)
2262 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2264 subprefix_stack
[submenu_depth
++] = prefix
;
2268 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2270 prefix
= subprefix_stack
[--submenu_depth
];
2273 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2276 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2277 i
+= MENU_ITEMS_PANE_LENGTH
;
2279 /* Ignore a nil in the item list.
2280 It's meaningful only for dialog boxes. */
2281 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2286 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2287 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2293 entry
= Fcons (entry
, Qnil
);
2295 entry
= Fcons (prefix
, entry
);
2296 for (j
= submenu_depth
- 1; j
>= 0; j
--)
2297 if (!NILP (subprefix_stack
[j
]))
2298 entry
= Fcons (subprefix_stack
[j
], entry
);
2302 i
+= MENU_ITEMS_ITEM_LENGTH
;
2311 dialog_selection_callback (widget
, id
, client_data
)
2314 XtPointer client_data
;
2316 /* The EMACS_INT cast avoids a warning. There's no problem
2317 as long as pointers have enough bits to hold small integers. */
2318 if ((int) (EMACS_INT
) client_data
!= -1)
2319 menu_item_selection
= (Lisp_Object
*) client_data
;
2321 lw_destroy_all_widgets (id
);
2323 popup_activated_flag
= 0;
2326 static char * button_names
[] = {
2327 "button1", "button2", "button3", "button4", "button5",
2328 "button6", "button7", "button8", "button9", "button10" };
2331 xdialog_show (f
, keymaps
, title
, error
)
2337 int i
, nb_buttons
=0;
2340 char dialog_name
[6];
2342 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2344 /* Number of elements seen so far, before boundary. */
2346 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2347 int boundary_seen
= 0;
2351 if (menu_items_n_panes
> 1)
2353 *error
= "Multiple panes in dialog box";
2357 /* Create a tree of widget_value objects
2358 representing the text label and buttons. */
2360 Lisp_Object pane_name
, prefix
;
2362 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2363 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2364 pane_string
= (NILP (pane_name
)
2365 ? "" : (char *) XSTRING (pane_name
)->data
);
2366 prev_wv
= xmalloc_widget_value ();
2367 prev_wv
->value
= pane_string
;
2368 if (keymaps
&& !NILP (prefix
))
2370 prev_wv
->enabled
= 1;
2371 prev_wv
->name
= "message";
2374 /* Loop over all panes and items, filling in the tree. */
2375 i
= MENU_ITEMS_PANE_LENGTH
;
2376 while (i
< menu_items_used
)
2379 /* Create a new item within current pane. */
2380 Lisp_Object item_name
, enable
, descrip
;
2381 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2382 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2384 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2386 if (NILP (item_name
))
2388 free_menubar_widget_value_tree (first_wv
);
2389 *error
= "Submenu in dialog items";
2392 if (EQ (item_name
, Qquote
))
2394 /* This is the boundary between left-side elts
2395 and right-side elts. Stop incrementing right_count. */
2400 if (nb_buttons
>= 9)
2402 free_menubar_widget_value_tree (first_wv
);
2403 *error
= "Too many dialog items";
2407 wv
= xmalloc_widget_value ();
2409 wv
->name
= (char *) button_names
[nb_buttons
];
2410 if (!NILP (descrip
))
2411 wv
->key
= (char *) XSTRING (descrip
)->data
;
2412 wv
->value
= (char *) XSTRING (item_name
)->data
;
2413 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
2414 wv
->enabled
= !NILP (enable
);
2417 if (! boundary_seen
)
2421 i
+= MENU_ITEMS_ITEM_LENGTH
;
2424 /* If the boundary was not specified,
2425 by default put half on the left and half on the right. */
2426 if (! boundary_seen
)
2427 left_count
= nb_buttons
- nb_buttons
/ 2;
2429 wv
= xmalloc_widget_value ();
2430 wv
->name
= dialog_name
;
2432 /* Dialog boxes use a really stupid name encoding
2433 which specifies how many buttons to use
2434 and how many buttons are on the right.
2435 The Q means something also. */
2436 dialog_name
[0] = 'Q';
2437 dialog_name
[1] = '0' + nb_buttons
;
2438 dialog_name
[2] = 'B';
2439 dialog_name
[3] = 'R';
2440 /* Number of buttons to put on the right. */
2441 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2443 wv
->contents
= first_wv
;
2447 /* Actually create the dialog. */
2448 dialog_id
= widget_id_tick
++;
2449 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2450 f
->output_data
.x
->widget
, 1, 0,
2451 dialog_selection_callback
, 0, 0);
2452 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2453 /* Free the widget_value objects we used to specify the contents. */
2454 free_menubar_widget_value_tree (first_wv
);
2456 /* No selection has been chosen yet. */
2457 menu_item_selection
= 0;
2459 /* Display the menu. */
2460 lw_pop_up_all_widgets (dialog_id
);
2461 popup_activated_flag
= 1;
2463 /* Process events that apply to the menu. */
2464 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2466 lw_destroy_all_widgets (dialog_id
);
2468 /* Find the selected item, and its pane, to return
2469 the proper value. */
2470 if (menu_item_selection
!= 0)
2476 while (i
< menu_items_used
)
2480 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2483 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2484 i
+= MENU_ITEMS_PANE_LENGTH
;
2486 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2488 /* This is the boundary between left-side elts and
2495 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2496 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2500 entry
= Fcons (entry
, Qnil
);
2502 entry
= Fcons (prefix
, entry
);
2506 i
+= MENU_ITEMS_ITEM_LENGTH
;
2514 #else /* not USE_X_TOOLKIT */
2516 /* The frame of the last activated non-toolkit menu bar.
2517 Used to generate menu help events. */
2519 static struct frame
*menu_help_frame
;
2522 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
2524 PANE is the pane number, and ITEM is the menu item number in
2525 the menu (currently not used).
2527 This cannot be done with generating a HELP_EVENT because
2528 XMenuActivate contains a loop that doesn't let Emacs process
2532 menu_help_callback (help_string
, pane
, item
)
2536 extern Lisp_Object Qmenu_item
;
2537 Lisp_Object
*first_item
;
2538 Lisp_Object pane_name
;
2539 Lisp_Object menu_object
;
2541 first_item
= XVECTOR (menu_items
)->contents
;
2542 if (EQ (first_item
[0], Qt
))
2543 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2544 else if (EQ (first_item
[0], Qquote
))
2545 /* This shouldn't happen, see xmenu_show. */
2546 pane_name
= empty_string
;
2548 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2550 /* (menu-item MENU-NAME PANE-NUMBER) */
2551 menu_object
= Fcons (Qmenu_item
,
2553 Fcons (make_number (pane
), Qnil
)));
2554 show_help_echo (help_string
? build_string (help_string
) : Qnil
,
2555 Qnil
, menu_object
, make_number (item
), 1);
2560 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2570 int pane
, selidx
, lpane
, status
;
2571 Lisp_Object entry
, pane_prefix
;
2573 int ulx
, uly
, width
, height
;
2574 int dispwidth
, dispheight
;
2578 unsigned int dummy_uint
;
2581 if (menu_items_n_panes
== 0)
2584 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2586 *error
= "Empty menu";
2590 /* Figure out which root window F is on. */
2591 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2592 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2593 &dummy_uint
, &dummy_uint
);
2595 /* Make the menu on that window. */
2596 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2599 *error
= "Can't create menu";
2603 #ifdef HAVE_X_WINDOWS
2604 /* Adjust coordinates to relative to the outer (window manager) window. */
2607 int win_x
= 0, win_y
= 0;
2609 /* Find the position of the outside upper-left corner of
2610 the inner window, with respect to the outer window. */
2611 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2614 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2616 /* From-window, to-window. */
2617 f
->output_data
.x
->window_desc
,
2618 f
->output_data
.x
->parent_desc
,
2620 /* From-position, to-position. */
2621 0, 0, &win_x
, &win_y
,
2623 /* Child of window. */
2630 #endif /* HAVE_X_WINDOWS */
2632 /* Adjust coordinates to be root-window-relative. */
2633 x
+= f
->output_data
.x
->left_pos
;
2634 y
+= f
->output_data
.x
->top_pos
;
2636 /* Create all the necessary panes and their items. */
2638 while (i
< menu_items_used
)
2640 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2642 /* Create a new pane. */
2643 Lisp_Object pane_name
, prefix
;
2646 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2647 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2648 pane_string
= (NILP (pane_name
)
2649 ? "" : (char *) XSTRING (pane_name
)->data
);
2650 if (keymaps
&& !NILP (prefix
))
2653 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2654 if (lpane
== XM_FAILURE
)
2656 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2657 *error
= "Can't create pane";
2660 i
+= MENU_ITEMS_PANE_LENGTH
;
2662 /* Find the width of the widest item in this pane. */
2665 while (j
< menu_items_used
)
2668 item
= XVECTOR (menu_items
)->contents
[j
];
2676 width
= STRING_BYTES (XSTRING (item
));
2677 if (width
> maxwidth
)
2680 j
+= MENU_ITEMS_ITEM_LENGTH
;
2683 /* Ignore a nil in the item list.
2684 It's meaningful only for dialog boxes. */
2685 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2689 /* Create a new item within current pane. */
2690 Lisp_Object item_name
, enable
, descrip
, help
;
2691 unsigned char *item_data
;
2694 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2695 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2697 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2698 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2699 help_string
= STRINGP (help
) ? XSTRING (help
)->data
: NULL
;
2701 if (!NILP (descrip
))
2703 int gap
= maxwidth
- STRING_BYTES (XSTRING (item_name
));
2706 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2707 item_name
= concat2 (item_name
, spacer
);
2708 item_name
= concat2 (item_name
, descrip
);
2709 item_data
= XSTRING (item_name
)->data
;
2711 /* if alloca is fast, use that to make the space,
2712 to reduce gc needs. */
2714 = (unsigned char *) alloca (maxwidth
2715 + STRING_BYTES (XSTRING (descrip
)) + 1);
2716 bcopy (XSTRING (item_name
)->data
, item_data
,
2717 STRING_BYTES (XSTRING (item_name
)));
2718 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2720 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2721 STRING_BYTES (XSTRING (descrip
)));
2722 item_data
[j
+ STRING_BYTES (XSTRING (descrip
))] = 0;
2726 item_data
= XSTRING (item_name
)->data
;
2728 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2729 menu
, lpane
, 0, item_data
,
2730 !NILP (enable
), help_string
)
2733 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2734 *error
= "Can't add selection to menu";
2737 i
+= MENU_ITEMS_ITEM_LENGTH
;
2741 /* All set and ready to fly. */
2742 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2743 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2744 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2745 x
= min (x
, dispwidth
);
2746 y
= min (y
, dispheight
);
2749 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2750 &ulx
, &uly
, &width
, &height
);
2751 if (ulx
+width
> dispwidth
)
2753 x
-= (ulx
+ width
) - dispwidth
;
2754 ulx
= dispwidth
- width
;
2756 if (uly
+height
> dispheight
)
2758 y
-= (uly
+ height
) - dispheight
;
2759 uly
= dispheight
- height
;
2761 if (ulx
< 0) x
-= ulx
;
2762 if (uly
< 0) y
-= uly
;
2764 XMenuSetAEQ (menu
, TRUE
);
2765 XMenuSetFreeze (menu
, TRUE
);
2768 /* Help display under X won't work because XMenuActivate contains
2769 a loop that doesn't give Emacs a chance to process it. */
2770 menu_help_frame
= f
;
2771 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2772 x
, y
, ButtonReleaseMask
, &datap
,
2773 menu_help_callback
);
2776 #ifdef HAVE_X_WINDOWS
2777 /* Assume the mouse has moved out of the X window.
2778 If it has actually moved in, we will get an EnterNotify. */
2779 x_mouse_leave (FRAME_X_DISPLAY_INFO (f
));
2786 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2789 /* Find the item number SELIDX in pane number PANE. */
2791 while (i
< menu_items_used
)
2793 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2797 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2799 i
+= MENU_ITEMS_PANE_LENGTH
;
2808 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2811 entry
= Fcons (entry
, Qnil
);
2812 if (!NILP (pane_prefix
))
2813 entry
= Fcons (pane_prefix
, entry
);
2819 i
+= MENU_ITEMS_ITEM_LENGTH
;
2825 *error
= "Can't activate menu";
2831 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2833 #ifdef HAVE_X_WINDOWS
2834 /* State that no mouse buttons are now held.
2835 (The oldXMenu code doesn't track this info for us.)
2836 That is not necessarily true, but the fiction leads to reasonable
2837 results, and it is a pain to ask which are actually held now. */
2838 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2844 #endif /* not USE_X_TOOLKIT */
2846 #endif /* HAVE_MENUS */
2851 staticpro (&menu_items
);
2854 Qdebug_on_next_call
= intern ("debug-on-next-call");
2855 staticpro (&Qdebug_on_next_call
);
2857 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2858 doc
: /* Frame for which we are updating a menu.
2859 The enable predicate for a menu command should check this variable. */);
2860 Vmenu_updating_frame
= Qnil
;
2862 #ifdef USE_X_TOOLKIT
2863 widget_id_tick
= (1<<16);
2864 next_menubar_widget_id
= 1;
2867 defsubr (&Sx_popup_menu
);
2869 defsubr (&Sx_popup_dialog
);