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 /* If non-nil, means that the global vars defined here are already in use.
178 Used to detect cases where we try to re-enter this non-reentrant code. */
179 static Lisp_Object menu_items_inuse
;
181 /* Number of slots currently allocated in menu_items. */
182 static int menu_items_allocated
;
184 /* This is the index in menu_items of the first empty slot. */
185 static int menu_items_used
;
187 /* The number of panes currently recorded in menu_items,
188 excluding those within submenus. */
189 static int menu_items_n_panes
;
191 /* Current depth within submenus. */
192 static int menu_items_submenu_depth
;
194 /* Flag which when set indicates a dialog or menu has been posted by
195 Xt on behalf of one of the widget sets. */
196 int popup_activated_flag
;
198 static int next_menubar_widget_id
;
200 /* This is set nonzero after the user activates the menu bar, and set
201 to zero again after the menu bars are redisplayed by prepare_menu_bar.
202 While it is nonzero, all calls to set_frame_menubar go deep.
204 I don't understand why this is needed, but it does seem to be
205 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
207 int pending_menu_activation
;
211 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
213 static struct frame
*
214 menubar_id_to_frame (id
)
217 Lisp_Object tail
, frame
;
220 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
223 if (!GC_FRAMEP (frame
))
226 if (!FRAME_WINDOW_P (f
))
228 if (f
->output_data
.x
->id
== id
)
236 /* Initialize the menu_items structure if we haven't already done so.
237 Also mark it as currently empty. */
242 if (NILP (menu_items
))
244 menu_items_allocated
= 60;
245 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
248 if (!NILP (menu_items_inuse
))
249 error ("Trying to use a menu from within a menu-entry");
250 menu_items_inuse
= Qt
;
252 menu_items_n_panes
= 0;
253 menu_items_submenu_depth
= 0;
256 /* Call at the end of generating the data in menu_items. */
264 unuse_menu_items (dummy
)
266 return menu_items_inuse
= Qnil
;
269 /* Call when finished using the data for the current menu
273 discard_menu_items ()
275 /* Free the structure if it is especially large.
276 Otherwise, hold on to it, to save time. */
277 if (menu_items_allocated
> 200)
280 menu_items_allocated
= 0;
282 xassert (NILP (menu_items_inuse
));
285 /* Make the menu_items vector twice as large. */
291 int old_size
= menu_items_allocated
;
294 menu_items_allocated
*= 2;
295 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
296 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
297 old_size
* sizeof (Lisp_Object
));
300 /* Begin a submenu. */
303 push_submenu_start ()
305 if (menu_items_used
+ 1 > menu_items_allocated
)
308 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
309 menu_items_submenu_depth
++;
317 if (menu_items_used
+ 1 > menu_items_allocated
)
320 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
321 menu_items_submenu_depth
--;
324 /* Indicate boundary between left and right. */
327 push_left_right_boundary ()
329 if (menu_items_used
+ 1 > menu_items_allocated
)
332 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
335 /* Start a new menu pane in menu_items.
336 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
339 push_menu_pane (name
, prefix_vec
)
340 Lisp_Object name
, prefix_vec
;
342 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
345 if (menu_items_submenu_depth
== 0)
346 menu_items_n_panes
++;
347 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
348 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
349 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
352 /* Push one menu item into the current pane. NAME is the string to
353 display. ENABLE if non-nil means this item can be selected. KEY
354 is the key generated by choosing this item, or nil if this item
355 doesn't really have a definition. DEF is the definition of this
356 item. EQUIV is the textual description of the keyboard equivalent
357 for this item (or nil if none). TYPE is the type of this menu
358 item, one of nil, `toggle' or `radio'. */
361 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
362 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
364 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
367 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
368 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
369 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
370 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
371 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
372 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
373 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
374 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
377 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
378 and generate menu panes for them in menu_items.
379 If NOTREAL is nonzero,
380 don't bother really computing whether an item is enabled. */
383 keymap_panes (keymaps
, nmaps
, notreal
)
384 Lisp_Object
*keymaps
;
392 /* Loop over the given keymaps, making a pane for each map.
393 But don't make a pane that is empty--ignore that map instead.
394 P is the number of panes we have made so far. */
395 for (mapno
= 0; mapno
< nmaps
; mapno
++)
396 single_keymap_panes (keymaps
[mapno
],
397 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
399 finish_menu_items ();
402 /* This is a recursive subroutine of keymap_panes.
403 It handles one keymap, KEYMAP.
404 The other arguments are passed along
405 or point to local variables of the previous function.
406 If NOTREAL is nonzero, only check for equivalent key bindings, don't
407 evaluate expressions in menu items and don't make any menu.
409 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
412 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
414 Lisp_Object pane_name
;
419 Lisp_Object pending_maps
= Qnil
;
420 Lisp_Object tail
, item
;
421 struct gcpro gcpro1
, gcpro2
;
427 push_menu_pane (pane_name
, prefix
);
430 /* Remember index for first item in this pane so we can go back and
431 add a prefix when (if) we see the first button. After that, notbuttons
432 is set to 0, to mark that we have seen a button and all non button
433 items need a prefix. */
434 notbuttons
= menu_items_used
;
437 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
439 GCPRO2 (keymap
, pending_maps
);
440 /* Look at each key binding, and if it is a menu item add it
444 single_menu_item (XCAR (item
), XCDR (item
),
445 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
446 else if (VECTORP (item
))
448 /* Loop over the char values represented in the vector. */
449 int len
= XVECTOR (item
)->size
;
451 for (c
= 0; c
< len
; c
++)
453 Lisp_Object character
;
454 XSETFASTINT (character
, c
);
455 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
456 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
462 /* Process now any submenus which want to be panes at this level. */
463 while (!NILP (pending_maps
))
465 Lisp_Object elt
, eltcdr
, string
;
466 elt
= Fcar (pending_maps
);
468 string
= XCAR (eltcdr
);
469 /* We no longer discard the @ from the beginning of the string here.
470 Instead, we do this in xmenu_show. */
471 single_keymap_panes (Fcar (elt
), string
,
472 XCDR (eltcdr
), notreal
, maxdepth
- 1);
473 pending_maps
= Fcdr (pending_maps
);
477 /* This is a subroutine of single_keymap_panes that handles one
479 KEY is a key in a keymap and ITEM is its binding.
480 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
482 If NOTREAL is nonzero, only check for equivalent key bindings, don't
483 evaluate expressions in menu items and don't make any menu.
484 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
485 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
486 buttons. It points to variable notbuttons in single_keymap_panes,
487 which keeps track of if we have seen a button in this menu or not. */
490 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
,
492 Lisp_Object key
, item
;
493 Lisp_Object
*pending_maps_ptr
;
494 int maxdepth
, notreal
;
497 Lisp_Object map
, item_string
, enabled
;
498 struct gcpro gcpro1
, gcpro2
;
501 /* Parse the menu item and leave the result in item_properties. */
503 res
= parse_menu_item (item
, notreal
, 0);
506 return; /* Not a menu item. */
508 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
512 /* We don't want to make a menu, just traverse the keymaps to
513 precompute equivalent key bindings. */
515 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
519 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
520 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
522 if (!NILP (map
) && SREF (item_string
, 0) == '@')
525 /* An enabled separate pane. Remember this to handle it later. */
526 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
532 /* Simulate radio buttons and toggle boxes by putting a prefix in
535 Lisp_Object prefix
= Qnil
;
536 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
540 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
543 /* The first button. Line up previous items in this menu. */
545 int index
= *notbuttons_ptr
; /* Index for first item this menu. */
548 while (index
< menu_items_used
)
551 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
555 submenu
++; /* Skip sub menu. */
557 else if (EQ (tem
, Qlambda
))
560 submenu
--; /* End sub menu. */
562 else if (EQ (tem
, Qt
))
563 index
+= 3; /* Skip new pane marker. */
564 else if (EQ (tem
, Qquote
))
565 index
++; /* Skip a left, right divider. */
568 if (!submenu
&& SREF (tem
, 0) != '\0'
569 && SREF (tem
, 0) != '-')
570 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
571 = concat2 (build_string (" "), tem
);
572 index
+= MENU_ITEMS_ITEM_LENGTH
;
578 /* Calculate prefix, if any, for this item. */
579 if (EQ (type
, QCtoggle
))
580 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
581 else if (EQ (type
, QCradio
))
582 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
584 /* Not a button. If we have earlier buttons, then we need a prefix. */
585 else if (!*notbuttons_ptr
&& SREF (item_string
, 0) != '\0'
586 && SREF (item_string
, 0) != '-')
587 prefix
= build_string (" ");
590 item_string
= concat2 (prefix
, item_string
);
592 #endif /* not HAVE_BOXES */
594 #ifndef USE_X_TOOLKIT
596 /* Indicate visually that this is a submenu. */
597 item_string
= concat2 (item_string
, build_string (" >"));
600 push_menu_item (item_string
, enabled
, key
,
601 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
602 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
603 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
604 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
605 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
608 /* Display a submenu using the toolkit. */
609 if (! (NILP (map
) || NILP (enabled
)))
611 push_submenu_start ();
612 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
618 /* Push all the panes and items of a menu described by the
619 alist-of-alists MENU.
620 This handles old-fashioned calls to x-popup-menu. */
630 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
632 Lisp_Object elt
, pane_name
, pane_data
;
634 pane_name
= Fcar (elt
);
635 CHECK_STRING (pane_name
);
636 push_menu_pane (pane_name
, Qnil
);
637 pane_data
= Fcdr (elt
);
638 CHECK_CONS (pane_data
);
639 list_of_items (pane_data
);
642 finish_menu_items ();
645 /* Push the items in a single pane defined by the alist PANE. */
651 Lisp_Object tail
, item
, item1
;
653 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
657 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
658 else if (NILP (item
))
659 push_left_right_boundary ();
664 CHECK_STRING (item1
);
665 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
670 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
671 doc
: /* Pop up a deck-of-cards menu and return user's selection.
672 POSITION is a position specification. This is either a mouse button event
673 or a list ((XOFFSET YOFFSET) WINDOW)
674 where XOFFSET and YOFFSET are positions in pixels from the top left
675 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)
676 This controls the position of the center of the first line
677 in the first pane of the menu, not the top left of the menu as a whole.
678 If POSITION is t, it means to use the current mouse position.
680 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
681 The menu items come from key bindings that have a menu string as well as
682 a definition; actually, the "definition" in such a key binding looks like
683 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
684 the keymap as a top-level element.
686 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
687 Otherwise, REAL-DEFINITION should be a valid key binding definition.
689 You can also use a list of keymaps as MENU.
690 Then each keymap makes a separate pane.
691 When MENU is a keymap or a list of keymaps, the return value
694 Alternatively, you can specify a menu of multiple panes
695 with a list of the form (TITLE PANE1 PANE2...),
696 where each pane is a list of form (TITLE ITEM1 ITEM2...).
697 Each ITEM is normally a cons cell (STRING . VALUE);
698 but a string can appear as an item--that makes a nonselectable line
700 With this form of menu, the return value is VALUE from the chosen item.
702 If POSITION is nil, don't display the menu at all, just precalculate the
703 cached information about equivalent key sequences. */)
705 Lisp_Object position
, menu
;
707 Lisp_Object keymap
, tem
;
708 int xpos
= 0, ypos
= 0;
711 Lisp_Object selection
;
713 Lisp_Object x
, y
, window
;
716 int specpdl_count
= SPECPDL_INDEX ();
720 if (! NILP (position
))
724 /* Decode the first argument: find the window and the coordinates. */
725 if (EQ (position
, Qt
)
726 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
727 || EQ (XCAR (position
), Qtool_bar
))))
729 /* Use the mouse's current position. */
730 FRAME_PTR new_f
= SELECTED_FRAME ();
731 Lisp_Object bar_window
;
732 enum scroll_bar_part part
;
735 if (mouse_position_hook
)
736 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
737 &part
, &x
, &y
, &time
);
739 XSETFRAME (window
, new_f
);
742 window
= selected_window
;
749 tem
= Fcar (position
);
752 window
= Fcar (Fcdr (position
));
754 y
= Fcar (Fcdr (tem
));
759 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
760 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
761 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
770 /* Decode where to put the menu. */
778 else if (WINDOWP (window
))
780 CHECK_LIVE_WINDOW (window
);
781 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
783 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
784 * XFASTINT (XWINDOW (window
)->left
));
785 ypos
= (FRAME_LINE_HEIGHT (f
)
786 * XFASTINT (XWINDOW (window
)->top
));
789 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
790 but I don't want to make one now. */
791 CHECK_WINDOW (window
);
796 Vmenu_updating_frame
= Qnil
;
797 #endif /* HAVE_MENUS */
799 record_unwind_protect (unuse_menu_items
, Qnil
);
803 /* Decode the menu items from what was specified. */
805 keymap
= get_keymap (menu
, 0, 0);
808 /* We were given a keymap. Extract menu info from the keymap. */
811 /* Extract the detailed info to make one pane. */
812 keymap_panes (&menu
, 1, NILP (position
));
814 /* Search for a string appearing directly as an element of the keymap.
815 That string is the title of the menu. */
816 prompt
= Fkeymap_prompt (keymap
);
817 if (NILP (title
) && !NILP (prompt
))
820 /* Make that be the pane title of the first pane. */
821 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
822 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
826 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
828 /* We were given a list of keymaps. */
829 int nmaps
= XFASTINT (Flength (menu
));
831 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
836 /* The first keymap that has a prompt string
837 supplies the menu title. */
838 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
842 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
844 prompt
= Fkeymap_prompt (keymap
);
845 if (NILP (title
) && !NILP (prompt
))
849 /* Extract the detailed info to make one pane. */
850 keymap_panes (maps
, nmaps
, NILP (position
));
852 /* Make the title be the pane title of the first pane. */
853 if (!NILP (title
) && menu_items_n_panes
>= 0)
854 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
860 /* We were given an old-fashioned menu. */
862 CHECK_STRING (title
);
864 list_of_panes (Fcdr (menu
));
869 unbind_to (specpdl_count
, Qnil
);
873 discard_menu_items ();
879 /* Display them in a menu. */
882 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
883 keymaps
, title
, &error_name
);
886 discard_menu_items ();
889 #endif /* HAVE_MENUS */
891 if (error_name
) error (error_name
);
897 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
898 doc
: /* Pop up a dialog box and return user's selection.
899 POSITION specifies which frame to use.
900 This is normally a mouse button event or a window or frame.
901 If POSITION is t, it means to use the frame the mouse is on.
902 The dialog box appears in the middle of the specified frame.
904 CONTENTS specifies the alternatives to display in the dialog box.
905 It is a list of the form (TITLE ITEM1 ITEM2...).
906 Each ITEM is a cons cell (STRING . VALUE).
907 The return value is VALUE from the chosen item.
909 An ITEM may also be just a string--that makes a nonselectable item.
910 An ITEM may also be nil--that means to put all preceding items
911 on the left of the dialog box and all following items on the right.
912 \(By default, approximately half appear on each side.) */)
914 Lisp_Object position
, contents
;
921 /* Decode the first argument: find the window or frame to use. */
922 if (EQ (position
, Qt
)
923 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
924 || EQ (XCAR (position
), Qtool_bar
))))
926 #if 0 /* Using the frame the mouse is on may not be right. */
927 /* Use the mouse's current position. */
928 FRAME_PTR new_f
= SELECTED_FRAME ();
929 Lisp_Object bar_window
;
930 enum scroll_bar_part part
;
934 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
937 XSETFRAME (window
, new_f
);
939 window
= selected_window
;
941 window
= selected_window
;
943 else if (CONSP (position
))
946 tem
= Fcar (position
);
948 window
= Fcar (Fcdr (position
));
951 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
952 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
955 else if (WINDOWP (position
) || FRAMEP (position
))
960 /* Decode where to put the menu. */
964 else if (WINDOWP (window
))
966 CHECK_LIVE_WINDOW (window
);
967 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
970 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
971 but I don't want to make one now. */
972 CHECK_WINDOW (window
);
974 #ifndef USE_X_TOOLKIT
975 /* Display a menu with these alternatives
976 in the middle of frame F. */
978 Lisp_Object x
, y
, frame
, newpos
;
979 XSETFRAME (frame
, f
);
980 XSETINT (x
, x_pixel_width (f
) / 2);
981 XSETINT (y
, x_pixel_height (f
) / 2);
982 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
984 return Fx_popup_menu (newpos
,
985 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
991 Lisp_Object selection
;
992 int specpdl_count
= SPECPDL_INDEX ();
994 /* Decode the dialog items from what was specified. */
995 title
= Fcar (contents
);
996 CHECK_STRING (title
);
997 record_unwind_protect (unuse_menu_items
, Qnil
);
999 list_of_panes (Fcons (contents
, Qnil
));
1001 /* Display them in a dialog box. */
1003 selection
= xdialog_show (f
, 0, title
, &error_name
);
1006 unbind_to (specpdl_count
, Qnil
);
1007 discard_menu_items ();
1009 if (error_name
) error (error_name
);
1015 #ifdef USE_X_TOOLKIT
1017 /* Loop in Xt until the menu pulldown or dialog popup has been
1018 popped down (deactivated). This is used for x-popup-menu
1019 and x-popup-dialog; it is not used for the menu bar any more.
1021 NOTE: All calls to popup_get_selection should be protected
1022 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1025 popup_get_selection (initial_event
, dpyinfo
, id
)
1026 XEvent
*initial_event
;
1027 struct x_display_info
*dpyinfo
;
1032 /* Define a queue to save up for later unreading
1033 all X events that don't pertain to the menu. */
1037 struct event_queue
*next
;
1040 struct event_queue
*queue
= NULL
;
1041 struct event_queue
*queue_tmp
;
1044 event
= *initial_event
;
1046 XtAppNextEvent (Xt_app_con
, &event
);
1050 /* Handle expose events for editor frames right away. */
1051 if (event
.type
== Expose
)
1052 process_expose_from_menu (event
);
1053 /* Make sure we don't consider buttons grabbed after menu goes.
1054 And make sure to deactivate for any ButtonRelease,
1055 even if XtDispatchEvent doesn't do that. */
1056 else if (event
.type
== ButtonRelease
1057 && dpyinfo
->display
== event
.xbutton
.display
)
1059 dpyinfo
->grabbed
&= ~(1 << event
.xbutton
.button
);
1060 popup_activated_flag
= 0;
1061 #ifdef USE_MOTIF /* Pretending that the event came from a
1062 Btn1Down seems the only way to convince Motif to
1063 activate its callbacks; setting the XmNmenuPost
1064 isn't working. --marcus@sysc.pdx.edu. */
1065 event
.xbutton
.button
= 1;
1068 /* If the user presses a key, deactivate the menu.
1069 The user is likely to do that if we get wedged. */
1070 else if (event
.type
== KeyPress
1071 && dpyinfo
->display
== event
.xbutton
.display
)
1073 KeySym keysym
= XLookupKeysym (&event
.xkey
, 0);
1074 if (!IsModifierKey (keysym
))
1076 popup_activated_flag
= 0;
1080 /* Button presses outside the menu also pop it down. */
1081 else if (event
.type
== ButtonPress
1082 && event
.xany
.display
== dpyinfo
->display
1083 && x_any_window_to_frame (dpyinfo
, event
.xany
.window
))
1085 popup_activated_flag
= 0;
1089 /* Queue all events not for this popup,
1090 except for Expose, which we've already handled, and ButtonRelease.
1091 Note that the X window is associated with the frame if this
1092 is a menu bar popup, but not if it's a dialog box. So we use
1093 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1094 if (event
.type
!= Expose
1095 && !(event
.type
== ButtonRelease
1096 && dpyinfo
->display
== event
.xbutton
.display
)
1097 && (event
.xany
.display
!= dpyinfo
->display
1098 || x_non_menubar_window_to_frame (dpyinfo
, event
.xany
.window
)))
1100 queue_tmp
= (struct event_queue
*) xmalloc (sizeof *queue_tmp
);
1101 queue_tmp
->event
= event
;
1102 queue_tmp
->next
= queue
;
1106 XtDispatchEvent (&event
);
1108 if (!popup_activated ())
1110 XtAppNextEvent (Xt_app_con
, &event
);
1113 /* Unread any events that we got but did not handle. */
1114 while (queue
!= NULL
)
1117 XPutBackEvent (queue_tmp
->event
.xany
.display
, &queue_tmp
->event
);
1118 queue
= queue_tmp
->next
;
1119 xfree ((char *)queue_tmp
);
1120 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1121 interrupt_input_pending
= 1;
1125 /* Activate the menu bar of frame F.
1126 This is called from keyboard.c when it gets the
1127 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1129 To activate the menu bar, we use the X button-press event
1130 that was saved in saved_menu_event.
1131 That makes the toolkit do its thing.
1133 But first we recompute the menu bar contents (the whole tree).
1135 The reason for saving the button event until here, instead of
1136 passing it to the toolkit right away, is that we can safely
1137 execute Lisp code. */
1140 x_activate_menubar (f
)
1143 if (!f
->output_data
.x
->saved_menu_event
->type
)
1146 set_frame_menubar (f
, 0, 1);
1148 XtDispatchEvent (f
->output_data
.x
->saved_menu_event
);
1151 if (f
->output_data
.x
->saved_menu_event
->type
== ButtonRelease
)
1152 pending_menu_activation
= 1;
1155 /* Ignore this if we get it a second time. */
1156 f
->output_data
.x
->saved_menu_event
->type
= 0;
1159 /* Detect if a dialog or menu has been posted. */
1164 return popup_activated_flag
;
1167 /* This callback is invoked when the user selects a menubar cascade
1168 pushbutton, but before the pulldown menu is posted. */
1171 popup_activate_callback (widget
, id
, client_data
)
1174 XtPointer client_data
;
1176 popup_activated_flag
= 1;
1179 /* This callback is invoked when a dialog or menu is finished being
1180 used and has been unposted. */
1183 popup_deactivate_callback (widget
, id
, client_data
)
1186 XtPointer client_data
;
1188 popup_activated_flag
= 0;
1191 /* Lwlib callback called when menu items are highlighted/unhighlighted
1192 while moving the mouse over them. WIDGET is the menu bar or menu
1193 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1194 the widget_value structure for the menu item, or null in case of
1198 menu_highlight_callback (widget
, id
, call_data
)
1203 widget_value
*wv
= (widget_value
*) call_data
;
1205 Lisp_Object frame
, help
;
1207 help
= wv
? wv
->help
: Qnil
;
1209 /* Determine the frame for the help event. */
1210 f
= menubar_id_to_frame (id
);
1213 XSETFRAME (frame
, f
);
1214 kbd_buffer_store_help_event (frame
, help
);
1218 /* WIDGET is the popup menu. It's parent is the frame's
1219 widget. See which frame that is. */
1220 Widget frame_widget
= XtParent (widget
);
1223 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
1225 frame
= XCAR (tail
);
1226 if (GC_FRAMEP (frame
)
1227 && (f
= XFRAME (frame
),
1228 FRAME_X_P (f
) && f
->output_data
.x
->widget
== frame_widget
))
1232 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
1236 /* This callback is called from the menu bar pulldown menu
1237 when the user makes a selection.
1238 Figure out what the user chose
1239 and put the appropriate events into the keyboard buffer. */
1242 menubar_selection_callback (widget
, id
, client_data
)
1245 XtPointer client_data
;
1247 Lisp_Object prefix
, entry
;
1248 FRAME_PTR f
= menubar_id_to_frame (id
);
1250 Lisp_Object
*subprefix_stack
;
1251 int submenu_depth
= 0;
1257 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1258 vector
= f
->menu_bar_vector
;
1261 while (i
< f
->menu_bar_items_used
)
1263 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1265 subprefix_stack
[submenu_depth
++] = prefix
;
1269 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1271 prefix
= subprefix_stack
[--submenu_depth
];
1274 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1276 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1277 i
+= MENU_ITEMS_PANE_LENGTH
;
1281 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1282 /* The EMACS_INT cast avoids a warning. There's no problem
1283 as long as pointers have enough bits to hold small integers. */
1284 if ((int) (EMACS_INT
) client_data
== i
)
1287 struct input_event buf
;
1290 XSETFRAME (frame
, f
);
1291 buf
.kind
= MENU_BAR_EVENT
;
1292 buf
.frame_or_window
= frame
;
1294 kbd_buffer_store_event (&buf
);
1296 for (j
= 0; j
< submenu_depth
; j
++)
1297 if (!NILP (subprefix_stack
[j
]))
1299 buf
.kind
= MENU_BAR_EVENT
;
1300 buf
.frame_or_window
= frame
;
1301 buf
.arg
= subprefix_stack
[j
];
1302 kbd_buffer_store_event (&buf
);
1307 buf
.kind
= MENU_BAR_EVENT
;
1308 buf
.frame_or_window
= frame
;
1310 kbd_buffer_store_event (&buf
);
1313 buf
.kind
= MENU_BAR_EVENT
;
1314 buf
.frame_or_window
= frame
;
1316 kbd_buffer_store_event (&buf
);
1320 i
+= MENU_ITEMS_ITEM_LENGTH
;
1325 /* Allocate a widget_value, blocking input. */
1328 xmalloc_widget_value ()
1330 widget_value
*value
;
1333 value
= malloc_widget_value ();
1339 /* This recursively calls free_widget_value on the tree of widgets.
1340 It must free all data that was malloc'ed for these widget_values.
1341 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1342 must be left alone. */
1345 free_menubar_widget_value_tree (wv
)
1350 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1352 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1354 free_menubar_widget_value_tree (wv
->contents
);
1355 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1359 free_menubar_widget_value_tree (wv
->next
);
1360 wv
->next
= (widget_value
*) 0xDEADBEEF;
1363 free_widget_value (wv
);
1367 /* Set up data i menu_items for a menu bar item
1368 whose event type is ITEM_KEY (with string ITEM_NAME)
1369 and whose contents come from the list of keymaps MAPS. */
1372 parse_single_submenu (item_key
, item_name
, maps
)
1373 Lisp_Object item_key
, item_name
, maps
;
1377 Lisp_Object
*mapvec
;
1379 int top_level_items
= 0;
1381 length
= Flength (maps
);
1382 len
= XINT (length
);
1384 /* Convert the list MAPS into a vector MAPVEC. */
1385 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1386 for (i
= 0; i
< len
; i
++)
1388 mapvec
[i
] = Fcar (maps
);
1392 /* Loop over the given keymaps, making a pane for each map.
1393 But don't make a pane that is empty--ignore that map instead. */
1394 for (i
= 0; i
< len
; i
++)
1396 if (SYMBOLP (mapvec
[i
])
1397 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1399 /* Here we have a command at top level in the menu bar
1400 as opposed to a submenu. */
1401 top_level_items
= 1;
1402 push_menu_pane (Qnil
, Qnil
);
1403 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1404 Qnil
, Qnil
, Qnil
, Qnil
);
1407 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1410 return top_level_items
;
1413 /* Create a tree of widget_value objects
1414 representing the panes and items
1415 in menu_items starting at index START, up to index END. */
1417 static widget_value
*
1418 digest_single_submenu (start
, end
, top_level_items
)
1421 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1423 int submenu_depth
= 0;
1424 widget_value
**submenu_stack
;
1427 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1428 wv
= xmalloc_widget_value ();
1432 wv
->button_type
= BUTTON_TYPE_NONE
;
1438 /* Loop over all panes and items made during this call
1439 and construct a tree of widget_value objects.
1440 Ignore the panes and items made by previous calls to
1441 single_submenu, even though those are also in menu_items. */
1445 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1447 submenu_stack
[submenu_depth
++] = save_wv
;
1452 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1455 save_wv
= submenu_stack
[--submenu_depth
];
1458 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1459 && submenu_depth
!= 0)
1460 i
+= MENU_ITEMS_PANE_LENGTH
;
1461 /* Ignore a nil in the item list.
1462 It's meaningful only for dialog boxes. */
1463 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1465 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1467 /* Create a new pane. */
1468 Lisp_Object pane_name
, prefix
;
1471 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1472 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1474 #ifndef HAVE_MULTILINGUAL_MENU
1475 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1477 pane_name
= ENCODE_SYSTEM (pane_name
);
1478 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1481 pane_string
= (NILP (pane_name
)
1482 ? "" : (char *) SDATA (pane_name
));
1483 /* If there is just one top-level pane, put all its items directly
1484 under the top-level menu. */
1485 if (menu_items_n_panes
== 1)
1488 /* If the pane has a meaningful name,
1489 make the pane a top-level menu item
1490 with its items as a submenu beneath it. */
1491 if (strcmp (pane_string
, ""))
1493 wv
= xmalloc_widget_value ();
1497 first_wv
->contents
= wv
;
1498 wv
->name
= pane_string
;
1499 /* Ignore the @ that means "separate pane".
1500 This is a kludge, but this isn't worth more time. */
1501 if (!NILP (prefix
) && wv
->name
[0] == '@')
1505 wv
->button_type
= BUTTON_TYPE_NONE
;
1510 i
+= MENU_ITEMS_PANE_LENGTH
;
1514 /* Create a new item within current pane. */
1515 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1518 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1519 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1520 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1521 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1522 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1523 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1524 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1526 #ifndef HAVE_MULTILINGUAL_MENU
1527 if (STRING_MULTIBYTE (item_name
))
1529 item_name
= ENCODE_SYSTEM (item_name
);
1530 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1533 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1535 descrip
= ENCODE_SYSTEM (descrip
);
1536 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1538 #endif /* not HAVE_MULTILINGUAL_MENU */
1540 wv
= xmalloc_widget_value ();
1544 save_wv
->contents
= wv
;
1546 wv
->name
= (char *) SDATA (item_name
);
1547 if (!NILP (descrip
))
1548 wv
->key
= (char *) SDATA (descrip
);
1550 /* The EMACS_INT cast avoids a warning. There's no problem
1551 as long as pointers have enough bits to hold small integers. */
1552 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1553 wv
->enabled
= !NILP (enable
);
1556 wv
->button_type
= BUTTON_TYPE_NONE
;
1557 else if (EQ (type
, QCradio
))
1558 wv
->button_type
= BUTTON_TYPE_RADIO
;
1559 else if (EQ (type
, QCtoggle
))
1560 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1564 wv
->selected
= !NILP (selected
);
1565 if (! STRINGP (help
))
1572 i
+= MENU_ITEMS_ITEM_LENGTH
;
1576 /* If we have just one "menu item"
1577 that was originally a button, return it by itself. */
1578 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1580 wv
= first_wv
->contents
;
1581 free_widget_value (first_wv
);
1588 /* Recompute all the widgets of frame F, when the menu bar has been
1589 changed. Value is non-zero if widgets were updated. */
1592 update_frame_menubar (f
)
1595 struct x_output
*x
= f
->output_data
.x
;
1598 if (!x
->menubar_widget
|| XtIsManaged (x
->menubar_widget
))
1602 /* Save the size of the frame because the pane widget doesn't accept
1603 to resize itself. So force it. */
1607 /* Do the voodoo which means "I'm changing lots of things, don't try
1608 to refigure sizes until I'm done." */
1609 lw_refigure_widget (x
->column_widget
, False
);
1611 /* The order in which children are managed is the top to bottom
1612 order in which they are displayed in the paned window. First,
1613 remove the text-area widget. */
1614 XtUnmanageChild (x
->edit_widget
);
1616 /* Remove the menubar that is there now, and put up the menubar that
1618 XtManageChild (x
->menubar_widget
);
1619 XtMapWidget (x
->menubar_widget
);
1620 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, NULL
);
1622 /* Re-manage the text-area widget, and then thrash the sizes. */
1623 XtManageChild (x
->edit_widget
);
1624 lw_refigure_widget (x
->column_widget
, True
);
1626 /* Force the pane widget to resize itself with the right values. */
1627 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1632 /* Set the contents of the menubar widgets of frame F.
1633 The argument FIRST_TIME is currently ignored;
1634 it is set the first time this is called, from initialize_frame_menubar. */
1637 set_frame_menubar (f
, first_time
, deep_p
)
1642 Widget menubar_widget
= f
->output_data
.x
->menubar_widget
;
1644 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1646 int *submenu_start
, *submenu_end
;
1647 int *submenu_top_level_items
;
1651 XSETFRAME (Vmenu_updating_frame
, f
);
1653 if (f
->output_data
.x
->id
== 0)
1654 f
->output_data
.x
->id
= next_menubar_widget_id
++;
1655 id
= f
->output_data
.x
->id
;
1657 if (! menubar_widget
)
1659 else if (pending_menu_activation
&& !deep_p
)
1661 /* Make the first call for any given frame always go deep. */
1662 else if (!f
->output_data
.x
->saved_menu_event
&& !deep_p
)
1665 f
->output_data
.x
->saved_menu_event
= (XEvent
*)xmalloc (sizeof (XEvent
));
1666 f
->output_data
.x
->saved_menu_event
->type
= 0;
1671 /* Make a widget-value tree representing the entire menu trees. */
1673 struct buffer
*prev
= current_buffer
;
1675 int specpdl_count
= SPECPDL_INDEX ();
1676 int previous_menu_items_used
= f
->menu_bar_items_used
;
1677 Lisp_Object
*previous_items
1678 = (Lisp_Object
*) alloca (previous_menu_items_used
1679 * sizeof (Lisp_Object
));
1681 /* If we are making a new widget, its contents are empty,
1682 do always reinitialize them. */
1683 if (! menubar_widget
)
1684 previous_menu_items_used
= 0;
1686 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1687 specbind (Qinhibit_quit
, Qt
);
1688 /* Don't let the debugger step into this code
1689 because it is not reentrant. */
1690 specbind (Qdebug_on_next_call
, Qnil
);
1692 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1693 record_unwind_protect (unuse_menu_items
, Qnil
);
1694 if (NILP (Voverriding_local_map_menu_flag
))
1696 specbind (Qoverriding_terminal_local_map
, Qnil
);
1697 specbind (Qoverriding_local_map
, Qnil
);
1700 set_buffer_internal_1 (XBUFFER (buffer
));
1702 /* Run the Lucid hook. */
1703 safe_run_hooks (Qactivate_menubar_hook
);
1705 /* If it has changed current-menubar from previous value,
1706 really recompute the menubar from the value. */
1707 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1708 call0 (Qrecompute_lucid_menubar
);
1709 safe_run_hooks (Qmenu_bar_update_hook
);
1710 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1712 items
= FRAME_MENU_BAR_ITEMS (f
);
1714 /* Save the frame's previous menu bar contents data. */
1715 if (previous_menu_items_used
)
1716 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1717 previous_menu_items_used
* sizeof (Lisp_Object
));
1719 /* Fill in menu_items with the current menu bar contents.
1720 This can evaluate Lisp code. */
1721 menu_items
= f
->menu_bar_vector
;
1722 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1723 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1724 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1725 submenu_top_level_items
1726 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1728 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1730 Lisp_Object key
, string
, maps
;
1734 key
= XVECTOR (items
)->contents
[i
];
1735 string
= XVECTOR (items
)->contents
[i
+ 1];
1736 maps
= XVECTOR (items
)->contents
[i
+ 2];
1740 submenu_start
[i
] = menu_items_used
;
1742 menu_items_n_panes
= 0;
1743 submenu_top_level_items
[i
]
1744 = parse_single_submenu (key
, string
, maps
);
1746 submenu_end
[i
] = menu_items_used
;
1749 finish_menu_items ();
1751 /* Convert menu_items into widget_value trees
1752 to display the menu. This cannot evaluate Lisp code. */
1754 wv
= xmalloc_widget_value ();
1755 wv
->name
= "menubar";
1758 wv
->button_type
= BUTTON_TYPE_NONE
;
1762 for (i
= 0; i
< last_i
; i
+= 4)
1764 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1765 submenu_top_level_items
[i
]);
1769 first_wv
->contents
= wv
;
1770 /* Don't set wv->name here; GC during the loop might relocate it. */
1772 wv
->button_type
= BUTTON_TYPE_NONE
;
1776 set_buffer_internal_1 (prev
);
1777 unbind_to (specpdl_count
, Qnil
);
1779 /* If there has been no change in the Lisp-level contents
1780 of the menu bar, skip redisplaying it. Just exit. */
1782 for (i
= 0; i
< previous_menu_items_used
; i
++)
1783 if (menu_items_used
== i
1784 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1786 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1788 free_menubar_widget_value_tree (first_wv
);
1789 discard_menu_items ();
1794 /* Now GC cannot happen during the lifetime of the widget_value,
1795 so it's safe to store data from a Lisp_String. */
1796 wv
= first_wv
->contents
;
1797 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1800 string
= XVECTOR (items
)->contents
[i
+ 1];
1803 wv
->name
= (char *) SDATA (string
);
1807 f
->menu_bar_vector
= menu_items
;
1808 f
->menu_bar_items_used
= menu_items_used
;
1809 discard_menu_items ();
1813 /* Make a widget-value tree containing
1814 just the top level menu bar strings. */
1816 wv
= xmalloc_widget_value ();
1817 wv
->name
= "menubar";
1820 wv
->button_type
= BUTTON_TYPE_NONE
;
1824 items
= FRAME_MENU_BAR_ITEMS (f
);
1825 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1829 string
= XVECTOR (items
)->contents
[i
+ 1];
1833 wv
= xmalloc_widget_value ();
1834 wv
->name
= (char *) SDATA (string
);
1837 wv
->button_type
= BUTTON_TYPE_NONE
;
1839 /* This prevents lwlib from assuming this
1840 menu item is really supposed to be empty. */
1841 /* The EMACS_INT cast avoids a warning.
1842 This value just has to be different from small integers. */
1843 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1848 first_wv
->contents
= wv
;
1852 /* Forget what we thought we knew about what is in the
1853 detailed contents of the menu bar menus.
1854 Changing the top level always destroys the contents. */
1855 f
->menu_bar_items_used
= 0;
1858 /* Create or update the menu bar widget. */
1864 /* Disable resizing (done for Motif!) */
1865 lw_allow_resizing (f
->output_data
.x
->widget
, False
);
1867 /* The third arg is DEEP_P, which says to consider the entire
1868 menu trees we supply, rather than just the menu bar item names. */
1869 lw_modify_all_widgets (id
, first_wv
, deep_p
);
1871 /* Re-enable the edit widget to resize. */
1872 lw_allow_resizing (f
->output_data
.x
->widget
, True
);
1876 menubar_widget
= lw_create_widget ("menubar", "menubar", id
, first_wv
,
1877 f
->output_data
.x
->column_widget
,
1879 popup_activate_callback
,
1880 menubar_selection_callback
,
1881 popup_deactivate_callback
,
1882 menu_highlight_callback
);
1883 f
->output_data
.x
->menubar_widget
= menubar_widget
;
1888 = (f
->output_data
.x
->menubar_widget
1889 ? (f
->output_data
.x
->menubar_widget
->core
.height
1890 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
1893 #if 0 /* Experimentally, we now get the right results
1894 for -geometry -0-0 without this. 24 Aug 96, rms. */
1896 if (FRAME_EXTERNAL_MENU_BAR (f
))
1899 XtVaGetValues (f
->output_data
.x
->column_widget
,
1900 XtNinternalBorderWidth
, &ibw
, NULL
);
1901 menubar_size
+= ibw
;
1903 #endif /* USE_LUCID */
1906 f
->output_data
.x
->menubar_height
= menubar_size
;
1909 free_menubar_widget_value_tree (first_wv
);
1910 update_frame_menubar (f
);
1915 /* Called from Fx_create_frame to create the initial menubar of a frame
1916 before it is mapped, so that the window is mapped with the menubar already
1917 there instead of us tacking it on later and thrashing the window after it
1921 initialize_frame_menubar (f
)
1924 /* This function is called before the first chance to redisplay
1925 the frame. It has to be, so the frame will have the right size. */
1926 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1927 set_frame_menubar (f
, 1, 1);
1931 /* Get rid of the menu bar of frame F, and free its storage.
1932 This is used when deleting a frame, and when turning off the menu bar. */
1935 free_frame_menubar (f
)
1938 Widget menubar_widget
;
1940 menubar_widget
= f
->output_data
.x
->menubar_widget
;
1942 f
->output_data
.x
->menubar_height
= 0;
1947 /* Removing the menu bar magically changes the shell widget's x
1948 and y position of (0, 0) which, when the menu bar is turned
1949 on again, leads to pull-down menuss appearing in strange
1950 positions near the upper-left corner of the display. This
1951 happens only with some window managers like twm and ctwm,
1952 but not with other like Motif's mwm or kwm, because the
1953 latter generate ConfigureNotify events when the menu bar
1954 is switched off, which fixes the shell position. */
1955 Position x0
, y0
, x1
, y1
;
1961 if (f
->output_data
.x
->widget
)
1962 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x0
, XtNy
, &y0
, NULL
);
1965 lw_destroy_all_widgets ((LWLIB_ID
) f
->output_data
.x
->id
);
1966 f
->output_data
.x
->menubar_widget
= NULL
;
1969 if (f
->output_data
.x
->widget
)
1971 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x1
, XtNy
, &y1
, NULL
);
1972 if (x1
== 0 && y1
== 0)
1973 XtVaSetValues (f
->output_data
.x
->widget
, XtNx
, x0
, XtNy
, y0
, NULL
);
1981 #endif /* USE_X_TOOLKIT */
1983 /* xmenu_show actually displays a menu using the panes and items in menu_items
1984 and returns the value selected from it.
1985 There are two versions of xmenu_show, one for Xt and one for Xlib.
1986 Both assume input is blocked by the caller. */
1988 /* F is the frame the menu is for.
1989 X and Y are the frame-relative specified position,
1990 relative to the inside upper left corner of the frame F.
1991 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1992 KEYMAPS is 1 if this menu was specified with keymaps;
1993 in that case, we return a list containing the chosen item's value
1994 and perhaps also the pane's prefix.
1995 TITLE is the specified menu title.
1996 ERROR is a place to store an error message string in case of failure.
1997 (We return nil on failure, but the value doesn't actually matter.) */
1999 #ifdef USE_X_TOOLKIT
2001 /* We need a unique id for each widget handled by the Lucid Widget
2004 For the main windows, and popup menus, we use this counter,
2005 which we increment each time after use. This starts from 1<<16.
2007 For menu bars, we use numbers starting at 0, counted in
2008 next_menubar_widget_id. */
2009 LWLIB_ID widget_id_tick
;
2011 static Lisp_Object
*volatile menu_item_selection
;
2014 popup_selection_callback (widget
, id
, client_data
)
2017 XtPointer client_data
;
2019 menu_item_selection
= (Lisp_Object
*) client_data
;
2023 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2037 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
2038 widget_value
**submenu_stack
2039 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
2040 Lisp_Object
*subprefix_stack
2041 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
2042 int submenu_depth
= 0;
2043 XButtonPressedEvent dummy
;
2049 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2051 *error
= "Empty menu";
2055 /* Create a tree of widget_value objects
2056 representing the panes and their items. */
2057 wv
= xmalloc_widget_value ();
2061 wv
->button_type
= BUTTON_TYPE_NONE
;
2066 /* Loop over all panes and items, filling in the tree. */
2068 while (i
< menu_items_used
)
2070 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2072 submenu_stack
[submenu_depth
++] = save_wv
;
2078 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2081 save_wv
= submenu_stack
[--submenu_depth
];
2085 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
2086 && submenu_depth
!= 0)
2087 i
+= MENU_ITEMS_PANE_LENGTH
;
2088 /* Ignore a nil in the item list.
2089 It's meaningful only for dialog boxes. */
2090 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2092 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2094 /* Create a new pane. */
2095 Lisp_Object pane_name
, prefix
;
2098 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
2099 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2101 #ifndef HAVE_MULTILINGUAL_MENU
2102 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
2104 pane_name
= ENCODE_SYSTEM (pane_name
);
2105 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
2108 pane_string
= (NILP (pane_name
)
2109 ? "" : (char *) SDATA (pane_name
));
2110 /* If there is just one top-level pane, put all its items directly
2111 under the top-level menu. */
2112 if (menu_items_n_panes
== 1)
2115 /* If the pane has a meaningful name,
2116 make the pane a top-level menu item
2117 with its items as a submenu beneath it. */
2118 if (!keymaps
&& strcmp (pane_string
, ""))
2120 wv
= xmalloc_widget_value ();
2124 first_wv
->contents
= wv
;
2125 wv
->name
= pane_string
;
2126 if (keymaps
&& !NILP (prefix
))
2130 wv
->button_type
= BUTTON_TYPE_NONE
;
2135 else if (first_pane
)
2141 i
+= MENU_ITEMS_PANE_LENGTH
;
2145 /* Create a new item within current pane. */
2146 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
2147 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2148 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2149 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2150 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
2151 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
2152 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
2153 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2155 #ifndef HAVE_MULTILINGUAL_MENU
2156 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2158 item_name
= ENCODE_SYSTEM (item_name
);
2159 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2162 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2164 descrip
= ENCODE_SYSTEM (descrip
);
2165 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2167 #endif /* not HAVE_MULTILINGUAL_MENU */
2169 wv
= xmalloc_widget_value ();
2173 save_wv
->contents
= wv
;
2174 wv
->name
= (char *) SDATA (item_name
);
2175 if (!NILP (descrip
))
2176 wv
->key
= (char *) SDATA (descrip
);
2178 /* If this item has a null value,
2179 make the call_data null so that it won't display a box
2180 when the mouse is on it. */
2182 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
2183 wv
->enabled
= !NILP (enable
);
2186 wv
->button_type
= BUTTON_TYPE_NONE
;
2187 else if (EQ (type
, QCtoggle
))
2188 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2189 else if (EQ (type
, QCradio
))
2190 wv
->button_type
= BUTTON_TYPE_RADIO
;
2194 wv
->selected
= !NILP (selected
);
2196 if (! STRINGP (help
))
2203 i
+= MENU_ITEMS_ITEM_LENGTH
;
2207 /* Deal with the title, if it is non-nil. */
2210 widget_value
*wv_title
= xmalloc_widget_value ();
2211 widget_value
*wv_sep1
= xmalloc_widget_value ();
2212 widget_value
*wv_sep2
= xmalloc_widget_value ();
2214 wv_sep2
->name
= "--";
2215 wv_sep2
->next
= first_wv
->contents
;
2216 wv_sep2
->help
= Qnil
;
2218 wv_sep1
->name
= "--";
2219 wv_sep1
->next
= wv_sep2
;
2220 wv_sep1
->help
= Qnil
;
2222 #ifndef HAVE_MULTILINGUAL_MENU
2223 if (STRING_MULTIBYTE (title
))
2224 title
= ENCODE_SYSTEM (title
);
2227 wv_title
->name
= (char *) SDATA (title
);
2228 wv_title
->enabled
= TRUE
;
2229 wv_title
->button_type
= BUTTON_TYPE_NONE
;
2230 wv_title
->next
= wv_sep1
;
2231 wv_title
->help
= Qnil
;
2232 first_wv
->contents
= wv_title
;
2235 /* Actually create the menu. */
2236 menu_id
= widget_id_tick
++;
2237 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
2238 f
->output_data
.x
->widget
, 1, 0,
2239 popup_selection_callback
,
2240 popup_deactivate_callback
,
2241 menu_highlight_callback
);
2243 /* Adjust coordinates to relative to the outer (window manager) window. */
2246 int win_x
= 0, win_y
= 0;
2248 /* Find the position of the outside upper-left corner of
2249 the inner window, with respect to the outer window. */
2250 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2253 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2255 /* From-window, to-window. */
2256 f
->output_data
.x
->window_desc
,
2257 f
->output_data
.x
->parent_desc
,
2259 /* From-position, to-position. */
2260 0, 0, &win_x
, &win_y
,
2262 /* Child of window. */
2270 /* Adjust coordinates to be root-window-relative. */
2271 x
+= f
->output_data
.x
->left_pos
;
2272 y
+= f
->output_data
.x
->top_pos
;
2274 dummy
.type
= ButtonPress
;
2276 dummy
.send_event
= 0;
2277 dummy
.display
= FRAME_X_DISPLAY (f
);
2278 dummy
.time
= CurrentTime
;
2279 dummy
.root
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
2280 dummy
.window
= dummy
.root
;
2281 dummy
.subwindow
= dummy
.root
;
2286 dummy
.state
= (FRAME_X_DISPLAY_INFO (f
)->grabbed
>> 1) * Button1Mask
;
2288 for (i
= 0; i
< 5; i
++)
2289 if (FRAME_X_DISPLAY_INFO (f
)->grabbed
& (1 << i
))
2292 /* Don't allow any geometry request from the user. */
2293 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
2294 XtSetValues (menu
, av
, ac
);
2296 /* Free the widget_value objects we used to specify the contents. */
2297 free_menubar_widget_value_tree (first_wv
);
2299 /* No selection has been chosen yet. */
2300 menu_item_selection
= 0;
2302 /* Display the menu. */
2303 lw_popup_menu (menu
, (XEvent
*) &dummy
);
2304 popup_activated_flag
= 1;
2306 /* Process events that apply to the menu. */
2307 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), menu_id
);
2309 /* fp turned off the following statement and wrote a comment
2310 that it is unnecessary--that the menu has already disappeared.
2311 Nowadays the menu disappears ok, all right, but
2312 we need to delete the widgets or multiple ones will pile up. */
2313 lw_destroy_all_widgets (menu_id
);
2315 /* Find the selected item, and its pane, to return
2316 the proper value. */
2317 if (menu_item_selection
!= 0)
2319 Lisp_Object prefix
, entry
;
2321 prefix
= entry
= Qnil
;
2323 while (i
< menu_items_used
)
2325 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2327 subprefix_stack
[submenu_depth
++] = prefix
;
2331 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2333 prefix
= subprefix_stack
[--submenu_depth
];
2336 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2339 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2340 i
+= MENU_ITEMS_PANE_LENGTH
;
2342 /* Ignore a nil in the item list.
2343 It's meaningful only for dialog boxes. */
2344 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2349 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2350 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2356 entry
= Fcons (entry
, Qnil
);
2358 entry
= Fcons (prefix
, entry
);
2359 for (j
= submenu_depth
- 1; j
>= 0; j
--)
2360 if (!NILP (subprefix_stack
[j
]))
2361 entry
= Fcons (subprefix_stack
[j
], entry
);
2365 i
+= MENU_ITEMS_ITEM_LENGTH
;
2374 dialog_selection_callback (widget
, id
, client_data
)
2377 XtPointer client_data
;
2379 /* The EMACS_INT cast avoids a warning. There's no problem
2380 as long as pointers have enough bits to hold small integers. */
2381 if ((int) (EMACS_INT
) client_data
!= -1)
2382 menu_item_selection
= (Lisp_Object
*) client_data
;
2384 lw_destroy_all_widgets (id
);
2386 popup_activated_flag
= 0;
2389 static char * button_names
[] = {
2390 "button1", "button2", "button3", "button4", "button5",
2391 "button6", "button7", "button8", "button9", "button10" };
2394 xdialog_show (f
, keymaps
, title
, error
)
2400 int i
, nb_buttons
=0;
2403 char dialog_name
[6];
2405 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2407 /* Number of elements seen so far, before boundary. */
2409 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2410 int boundary_seen
= 0;
2414 if (menu_items_n_panes
> 1)
2416 *error
= "Multiple panes in dialog box";
2420 /* Create a tree of widget_value objects
2421 representing the text label and buttons. */
2423 Lisp_Object pane_name
, prefix
;
2425 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2426 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2427 pane_string
= (NILP (pane_name
)
2428 ? "" : (char *) SDATA (pane_name
));
2429 prev_wv
= xmalloc_widget_value ();
2430 prev_wv
->value
= pane_string
;
2431 if (keymaps
&& !NILP (prefix
))
2433 prev_wv
->enabled
= 1;
2434 prev_wv
->name
= "message";
2435 prev_wv
->help
= Qnil
;
2438 /* Loop over all panes and items, filling in the tree. */
2439 i
= MENU_ITEMS_PANE_LENGTH
;
2440 while (i
< menu_items_used
)
2443 /* Create a new item within current pane. */
2444 Lisp_Object item_name
, enable
, descrip
;
2445 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2446 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2448 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2450 if (NILP (item_name
))
2452 free_menubar_widget_value_tree (first_wv
);
2453 *error
= "Submenu in dialog items";
2456 if (EQ (item_name
, Qquote
))
2458 /* This is the boundary between left-side elts
2459 and right-side elts. Stop incrementing right_count. */
2464 if (nb_buttons
>= 9)
2466 free_menubar_widget_value_tree (first_wv
);
2467 *error
= "Too many dialog items";
2471 wv
= xmalloc_widget_value ();
2473 wv
->name
= (char *) button_names
[nb_buttons
];
2474 if (!NILP (descrip
))
2475 wv
->key
= (char *) SDATA (descrip
);
2476 wv
->value
= (char *) SDATA (item_name
);
2477 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
2478 wv
->enabled
= !NILP (enable
);
2482 if (! boundary_seen
)
2486 i
+= MENU_ITEMS_ITEM_LENGTH
;
2489 /* If the boundary was not specified,
2490 by default put half on the left and half on the right. */
2491 if (! boundary_seen
)
2492 left_count
= nb_buttons
- nb_buttons
/ 2;
2494 wv
= xmalloc_widget_value ();
2495 wv
->name
= dialog_name
;
2497 /* Dialog boxes use a really stupid name encoding
2498 which specifies how many buttons to use
2499 and how many buttons are on the right.
2500 The Q means something also. */
2501 dialog_name
[0] = 'Q';
2502 dialog_name
[1] = '0' + nb_buttons
;
2503 dialog_name
[2] = 'B';
2504 dialog_name
[3] = 'R';
2505 /* Number of buttons to put on the right. */
2506 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2508 wv
->contents
= first_wv
;
2512 /* Actually create the dialog. */
2513 dialog_id
= widget_id_tick
++;
2514 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2515 f
->output_data
.x
->widget
, 1, 0,
2516 dialog_selection_callback
, 0, 0);
2517 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2518 /* Free the widget_value objects we used to specify the contents. */
2519 free_menubar_widget_value_tree (first_wv
);
2521 /* No selection has been chosen yet. */
2522 menu_item_selection
= 0;
2524 /* Display the menu. */
2525 lw_pop_up_all_widgets (dialog_id
);
2526 popup_activated_flag
= 1;
2528 /* Process events that apply to the menu. */
2529 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2531 lw_destroy_all_widgets (dialog_id
);
2533 /* Find the selected item, and its pane, to return
2534 the proper value. */
2535 if (menu_item_selection
!= 0)
2541 while (i
< menu_items_used
)
2545 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2548 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2549 i
+= MENU_ITEMS_PANE_LENGTH
;
2551 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2553 /* This is the boundary between left-side elts and
2560 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2561 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2565 entry
= Fcons (entry
, Qnil
);
2567 entry
= Fcons (prefix
, entry
);
2571 i
+= MENU_ITEMS_ITEM_LENGTH
;
2579 #else /* not USE_X_TOOLKIT */
2581 /* The frame of the last activated non-toolkit menu bar.
2582 Used to generate menu help events. */
2584 static struct frame
*menu_help_frame
;
2587 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
2589 PANE is the pane number, and ITEM is the menu item number in
2590 the menu (currently not used).
2592 This cannot be done with generating a HELP_EVENT because
2593 XMenuActivate contains a loop that doesn't let Emacs process
2597 menu_help_callback (help_string
, pane
, item
)
2601 extern Lisp_Object Qmenu_item
;
2602 Lisp_Object
*first_item
;
2603 Lisp_Object pane_name
;
2604 Lisp_Object menu_object
;
2606 first_item
= XVECTOR (menu_items
)->contents
;
2607 if (EQ (first_item
[0], Qt
))
2608 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2609 else if (EQ (first_item
[0], Qquote
))
2610 /* This shouldn't happen, see xmenu_show. */
2611 pane_name
= empty_string
;
2613 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2615 /* (menu-item MENU-NAME PANE-NUMBER) */
2616 menu_object
= Fcons (Qmenu_item
,
2618 Fcons (make_number (pane
), Qnil
)));
2619 show_help_echo (help_string
? build_string (help_string
) : Qnil
,
2620 Qnil
, menu_object
, make_number (item
), 1);
2625 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2635 int pane
, selidx
, lpane
, status
;
2636 Lisp_Object entry
, pane_prefix
;
2638 int ulx
, uly
, width
, height
;
2639 int dispwidth
, dispheight
;
2643 unsigned int dummy_uint
;
2646 if (menu_items_n_panes
== 0)
2649 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2651 *error
= "Empty menu";
2655 /* Figure out which root window F is on. */
2656 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2657 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2658 &dummy_uint
, &dummy_uint
);
2660 /* Make the menu on that window. */
2661 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2664 *error
= "Can't create menu";
2668 #ifdef HAVE_X_WINDOWS
2669 /* Adjust coordinates to relative to the outer (window manager) window. */
2672 int win_x
= 0, win_y
= 0;
2674 /* Find the position of the outside upper-left corner of
2675 the inner window, with respect to the outer window. */
2676 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2679 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2681 /* From-window, to-window. */
2682 f
->output_data
.x
->window_desc
,
2683 f
->output_data
.x
->parent_desc
,
2685 /* From-position, to-position. */
2686 0, 0, &win_x
, &win_y
,
2688 /* Child of window. */
2695 #endif /* HAVE_X_WINDOWS */
2697 /* Adjust coordinates to be root-window-relative. */
2698 x
+= f
->output_data
.x
->left_pos
;
2699 y
+= f
->output_data
.x
->top_pos
;
2701 /* Create all the necessary panes and their items. */
2703 while (i
< menu_items_used
)
2705 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2707 /* Create a new pane. */
2708 Lisp_Object pane_name
, prefix
;
2711 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2712 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2713 pane_string
= (NILP (pane_name
)
2714 ? "" : (char *) SDATA (pane_name
));
2715 if (keymaps
&& !NILP (prefix
))
2718 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2719 if (lpane
== XM_FAILURE
)
2721 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2722 *error
= "Can't create pane";
2725 i
+= MENU_ITEMS_PANE_LENGTH
;
2727 /* Find the width of the widest item in this pane. */
2730 while (j
< menu_items_used
)
2733 item
= XVECTOR (menu_items
)->contents
[j
];
2741 width
= SBYTES (item
);
2742 if (width
> maxwidth
)
2745 j
+= MENU_ITEMS_ITEM_LENGTH
;
2748 /* Ignore a nil in the item list.
2749 It's meaningful only for dialog boxes. */
2750 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2754 /* Create a new item within current pane. */
2755 Lisp_Object item_name
, enable
, descrip
, help
;
2756 unsigned char *item_data
;
2759 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2760 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2762 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2763 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2764 help_string
= STRINGP (help
) ? SDATA (help
) : NULL
;
2766 if (!NILP (descrip
))
2768 int gap
= maxwidth
- SBYTES (item_name
);
2771 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2772 item_name
= concat2 (item_name
, spacer
);
2773 item_name
= concat2 (item_name
, descrip
);
2774 item_data
= SDATA (item_name
);
2776 /* if alloca is fast, use that to make the space,
2777 to reduce gc needs. */
2779 = (unsigned char *) alloca (maxwidth
2780 + SBYTES (descrip
) + 1);
2781 bcopy (SDATA (item_name
), item_data
,
2782 SBYTES (item_name
));
2783 for (j
= SCHARS (item_name
); j
< maxwidth
; j
++)
2785 bcopy (SDATA (descrip
), item_data
+ j
,
2787 item_data
[j
+ SBYTES (descrip
)] = 0;
2791 item_data
= SDATA (item_name
);
2793 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2794 menu
, lpane
, 0, item_data
,
2795 !NILP (enable
), help_string
)
2798 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2799 *error
= "Can't add selection to menu";
2802 i
+= MENU_ITEMS_ITEM_LENGTH
;
2806 /* All set and ready to fly. */
2807 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2808 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2809 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2810 x
= min (x
, dispwidth
);
2811 y
= min (y
, dispheight
);
2814 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2815 &ulx
, &uly
, &width
, &height
);
2816 if (ulx
+width
> dispwidth
)
2818 x
-= (ulx
+ width
) - dispwidth
;
2819 ulx
= dispwidth
- width
;
2821 if (uly
+height
> dispheight
)
2823 y
-= (uly
+ height
) - dispheight
;
2824 uly
= dispheight
- height
;
2826 if (ulx
< 0) x
-= ulx
;
2827 if (uly
< 0) y
-= uly
;
2829 XMenuSetAEQ (menu
, TRUE
);
2830 XMenuSetFreeze (menu
, TRUE
);
2833 /* Help display under X won't work because XMenuActivate contains
2834 a loop that doesn't give Emacs a chance to process it. */
2835 menu_help_frame
= f
;
2836 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2837 x
, y
, ButtonReleaseMask
, &datap
,
2838 menu_help_callback
);
2841 #ifdef HAVE_X_WINDOWS
2842 /* Assume the mouse has moved out of the X window.
2843 If it has actually moved in, we will get an EnterNotify. */
2844 x_mouse_leave (FRAME_X_DISPLAY_INFO (f
));
2851 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2854 /* Find the item number SELIDX in pane number PANE. */
2856 while (i
< menu_items_used
)
2858 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2862 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2864 i
+= MENU_ITEMS_PANE_LENGTH
;
2873 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2876 entry
= Fcons (entry
, Qnil
);
2877 if (!NILP (pane_prefix
))
2878 entry
= Fcons (pane_prefix
, entry
);
2884 i
+= MENU_ITEMS_ITEM_LENGTH
;
2890 *error
= "Can't activate menu";
2896 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2898 #ifdef HAVE_X_WINDOWS
2899 /* State that no mouse buttons are now held.
2900 (The oldXMenu code doesn't track this info for us.)
2901 That is not necessarily true, but the fiction leads to reasonable
2902 results, and it is a pain to ask which are actually held now. */
2903 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2909 #endif /* not USE_X_TOOLKIT */
2911 #endif /* HAVE_MENUS */
2916 staticpro (&menu_items
);
2918 menu_items_inuse
= Qnil
;
2920 Qdebug_on_next_call
= intern ("debug-on-next-call");
2921 staticpro (&Qdebug_on_next_call
);
2923 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2924 doc
: /* Frame for which we are updating a menu.
2925 The enable predicate for a menu command should check this variable. */);
2926 Vmenu_updating_frame
= Qnil
;
2928 #ifdef USE_X_TOOLKIT
2929 widget_id_tick
= (1<<16);
2930 next_menubar_widget_id
= 1;
2933 defsubr (&Sx_popup_menu
);
2935 defsubr (&Sx_popup_dialog
);