1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* X pop-up deck-of-cards menu facility for gnuemacs.
22 * Written by Jon Arnold and Roman Budzianowski
23 * Mods and rewrite by Robert Krawitz
27 /* Modified by Fred Pierresteguy on December 93
28 to make the popup menus and menubar use the Xt. */
30 /* Rewritten for clarity and GC protection by rms in Feb 94. */
32 /* On 4.3 this loses if it comes after xterm.h. */
38 #include "termhooks.h"
42 #include "blockinput.h"
45 /* This may include sys/types.h, and that somehow loses
46 if this is not done before the other system files. */
49 /* Load sys/types.h if not already loaded.
50 In some systems loading it twice is suicidal. */
52 #include <sys/types.h>
55 #include "dispextern.h"
58 #include "../oldXMenu/XMenu.h"
65 #include <X11/IntrinsicP.h>
66 #include <X11/CoreP.h>
67 #include <X11/StringDefs.h>
68 #include <X11/Shell.h>
69 #include "../lwlib/lwlib.h"
70 #endif /* USE_X_TOOLKIT */
72 #define min(x,y) (((x) < (y)) ? (x) : (y))
73 #define max(x,y) (((x) > (y)) ? (x) : (y))
81 extern Display
*x_current_display
;
83 #define ButtonReleaseMask ButtonReleased
84 #endif /* not HAVE_X11 */
86 /* We need a unique id for each widget handled by the Lucid Widget
87 library. This includes the frame main windows, popup menu and
89 LWLIB_ID widget_id_tick
;
91 extern Lisp_Object Qmenu_enable
;
92 extern Lisp_Object Qmenu_bar
;
95 extern void process_expose_from_menu ();
96 extern XtAppContext Xt_app_con
;
98 static Lisp_Object
xdialog_show ();
99 void popup_get_selection ();
102 static Lisp_Object
xmenu_show ();
103 static void keymap_panes ();
104 static void single_keymap_panes ();
105 static void list_of_panes ();
106 static void list_of_items ();
108 /* This holds a Lisp vector that holds the results of decoding
109 the keymaps or alist-of-alists that specify a menu.
111 It describes the panes and items within the panes.
113 Each pane is described by 3 elements in the vector:
114 t, the pane name, the pane's prefix key.
115 Then follow the pane's items, with 4 elements per item:
116 the item string, the enable flag, the item's value,
117 and the equivalent keyboard key's description string.
119 In some cases, multiple levels of menus may be described.
120 A single vector slot containing nil indicates the start of a submenu.
121 A single vector slot containing lambda indicates the end of a submenu.
122 The submenu follows a menu item which is the way to reach the submenu.
124 A single vector slot containing quote indicates that the
125 following items should appear on the right of a dialog box.
127 Using a Lisp vector to hold this information while we decode it
128 takes care of protecting all the data from GC. */
130 #define MENU_ITEMS_PANE_NAME 1
131 #define MENU_ITEMS_PANE_PREFIX 2
132 #define MENU_ITEMS_PANE_LENGTH 3
134 #define MENU_ITEMS_ITEM_NAME 0
135 #define MENU_ITEMS_ITEM_ENABLE 1
136 #define MENU_ITEMS_ITEM_VALUE 2
137 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
138 #define MENU_ITEMS_ITEM_LENGTH 4
140 static Lisp_Object menu_items
;
142 /* Number of slots currently allocated in menu_items. */
143 static int menu_items_allocated
;
145 /* This is the index in menu_items of the first empty slot. */
146 static int menu_items_used
;
148 /* The number of panes currently recorded in menu_items,
149 excluding those within submenus. */
150 static int menu_items_n_panes
;
152 /* Current depth within submenus. */
153 static int menu_items_submenu_depth
;
155 /* Flag which when set indicates a dialog or menu has been posted by
156 Xt on behalf of one of the widget sets. */
157 static int popup_activated_flag
;
160 /* Initialize the menu_items structure if we haven't already done so.
161 Also mark it as currently empty. */
166 if (NILP (menu_items
))
168 menu_items_allocated
= 60;
169 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
173 menu_items_n_panes
= 0;
174 menu_items_submenu_depth
= 0;
177 /* Call at the end of generating the data in menu_items.
178 This fills in the number of items in the last pane. */
185 /* Call when finished using the data for the current menu
189 discard_menu_items ()
191 /* Free the structure if it is especially large.
192 Otherwise, hold on to it, to save time. */
193 if (menu_items_allocated
> 200)
196 menu_items_allocated
= 0;
200 /* Make the menu_items vector twice as large. */
206 int old_size
= menu_items_allocated
;
209 menu_items_allocated
*= 2;
210 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
211 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
212 old_size
* sizeof (Lisp_Object
));
215 /* Begin a submenu. */
218 push_submenu_start ()
220 if (menu_items_used
+ 1 > menu_items_allocated
)
223 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
224 menu_items_submenu_depth
++;
232 if (menu_items_used
+ 1 > menu_items_allocated
)
235 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
236 menu_items_submenu_depth
--;
239 /* Indicate boundary between left and right. */
242 push_left_right_boundary ()
244 if (menu_items_used
+ 1 > menu_items_allocated
)
247 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
250 /* Start a new menu pane in menu_items..
251 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
254 push_menu_pane (name
, prefix_vec
)
255 Lisp_Object name
, prefix_vec
;
257 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
260 if (menu_items_submenu_depth
== 0)
261 menu_items_n_panes
++;
262 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
263 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
264 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
267 /* Push one menu item into the current pane.
268 NAME is the string to display. ENABLE if non-nil means
269 this item can be selected. KEY is the key generated by
270 choosing this item. EQUIV is the textual description
271 of the keyboard equivalent for this item (or nil if none). */
274 push_menu_item (name
, enable
, key
, equiv
)
275 Lisp_Object name
, enable
, key
, equiv
;
277 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
280 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
281 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
282 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
283 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
286 /* Figure out the current keyboard equivalent of a menu item ITEM1.
287 The item string for menu display should be ITEM_STRING.
288 Store the equivalent keyboard key sequence's
289 textual description into *DESCRIP_PTR.
290 Also cache them in the item itself.
291 Return the real definition to execute. */
294 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
295 Lisp_Object item_string
;
297 Lisp_Object
*descrip_ptr
;
299 /* This is the real definition--the function to run. */
301 /* This is the sublist that records cached equiv key data
302 so we can save time. */
303 Lisp_Object cachelist
;
304 /* These are the saved equivalent keyboard key sequence
305 and its key-description. */
306 Lisp_Object savedkey
, descrip
;
309 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
311 /* If a help string follows the item string, skip it. */
312 if (CONSP (XCONS (item1
)->cdr
)
313 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
314 item1
= XCONS (item1
)->cdr
;
318 /* Get out the saved equivalent-keyboard-key info. */
319 cachelist
= savedkey
= descrip
= Qnil
;
320 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
321 && (NILP (XCONS (XCONS (def
)->car
)->car
)
322 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
324 cachelist
= XCONS (def
)->car
;
325 def
= XCONS (def
)->cdr
;
326 savedkey
= XCONS (cachelist
)->car
;
327 descrip
= XCONS (cachelist
)->cdr
;
330 GCPRO4 (def
, def1
, savedkey
, descrip
);
332 /* Is it still valid? */
334 if (!NILP (savedkey
))
335 def1
= Fkey_binding (savedkey
, Qnil
);
336 /* If not, update it. */
338 /* If the command is an alias for another
339 (such as easymenu.el and lmenu.el set it up),
340 check if the original command matches the cached command. */
341 && !(SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
)
342 && EQ (def1
, XSYMBOL (def
)->function
))
343 /* If something had no key binding before, don't recheck it--
344 doing that takes too much time and makes menus too slow. */
345 && !(!NILP (cachelist
) && NILP (savedkey
)))
349 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
350 /* If the command is an alias for another
351 (such as easymenu.el and lmenu.el set it up),
352 see if the original command name has equivalent keys. */
353 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
354 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
357 if (VECTORP (savedkey
)
358 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
360 if (!NILP (savedkey
))
362 descrip
= Fkey_description (savedkey
);
363 descrip
= concat2 (make_string (" (", 3), descrip
);
364 descrip
= concat2 (descrip
, make_string (")", 1));
368 /* Cache the data we just got in a sublist of the menu binding. */
369 if (NILP (cachelist
))
371 CHECK_IMPURE (item1
);
372 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
376 XCONS (cachelist
)->car
= savedkey
;
377 XCONS (cachelist
)->cdr
= descrip
;
381 *descrip_ptr
= descrip
;
385 /* This is used as the handler when calling internal_condition_case_1. */
388 menu_item_enabled_p_1 (arg
)
394 /* Return non-nil if the command DEF is enabled when used as a menu item.
395 This is based on looking for a menu-enable property.
396 If NOTREAL is set, don't bother really computing this. */
399 menu_item_enabled_p (def
, notreal
)
403 Lisp_Object enabled
, tem
;
410 /* No property, or nil, means enable.
411 Otherwise, enable if value is not nil. */
412 tem
= Fget (def
, Qmenu_enable
);
414 /* (condition-case nil (eval tem)
416 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
417 menu_item_enabled_p_1
);
422 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
423 and generate menu panes for them in menu_items.
424 If NOTREAL is nonzero,
425 don't bother really computing whether an item is enabled. */
428 keymap_panes (keymaps
, nmaps
, notreal
)
429 Lisp_Object
*keymaps
;
437 /* Loop over the given keymaps, making a pane for each map.
438 But don't make a pane that is empty--ignore that map instead.
439 P is the number of panes we have made so far. */
440 for (mapno
= 0; mapno
< nmaps
; mapno
++)
441 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
443 finish_menu_items ();
446 /* This is a recursive subroutine of keymap_panes.
447 It handles one keymap, KEYMAP.
448 The other arguments are passed along
449 or point to local variables of the previous function.
450 If NOTREAL is nonzero,
451 don't bother really computing whether an item is enabled. */
454 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
456 Lisp_Object pane_name
;
460 Lisp_Object pending_maps
;
461 Lisp_Object tail
, item
, item1
, item_string
, table
;
462 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
466 push_menu_pane (pane_name
, prefix
);
468 for (tail
= keymap
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
470 /* Look at each key binding, and if it has a menu string,
471 make a menu item from it. */
472 item
= XCONS (tail
)->car
;
475 item1
= XCONS (item
)->cdr
;
478 item_string
= XCONS (item1
)->car
;
479 if (STRINGP (item_string
))
481 /* This is the real definition--the function to run. */
483 /* These are the saved equivalent keyboard key sequence
484 and its key-description. */
486 Lisp_Object tem
, enabled
;
488 /* GCPRO because ...enabled_p will call eval
489 and ..._equiv_key may autoload something.
490 Protecting KEYMAP preserves everything we use;
491 aside from that, must protect whatever might be
492 a string. Since there's no GCPRO5, we refetch
493 item_string instead of protecting it. */
494 descrip
= def
= Qnil
;
495 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
497 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
498 enabled
= menu_item_enabled_p (def
, notreal
);
502 item_string
= XCONS (item1
)->car
;
504 tem
= Fkeymapp (def
);
505 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
506 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
511 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
512 submap
= get_keymap_1 (def
, 0, 1);
514 #ifndef USE_X_TOOLKIT
515 /* Indicate visually that this is a submenu. */
517 item_string
= concat2 (item_string
,
518 build_string (" >"));
520 push_menu_item (item_string
, enabled
, XCONS (item
)->car
,
523 /* Display a submenu using the toolkit. */
526 push_submenu_start ();
527 single_keymap_panes (submap
, Qnil
,
528 XCONS (item
)->car
, notreal
);
536 else if (VECTORP (item
))
538 /* Loop over the char values represented in the vector. */
539 int len
= XVECTOR (item
)->size
;
541 for (c
= 0; c
< len
; c
++)
543 Lisp_Object character
;
544 XFASTINT (character
) = c
;
545 item1
= XVECTOR (item
)->contents
[c
];
548 item_string
= XCONS (item1
)->car
;
549 if (STRINGP (item_string
))
553 /* These are the saved equivalent keyboard key sequence
554 and its key-description. */
556 Lisp_Object tem
, enabled
;
558 /* GCPRO because ...enabled_p will call eval
559 and ..._equiv_key may autoload something.
560 Protecting KEYMAP preserves everything we use;
561 aside from that, must protect whatever might be
562 a string. Since there's no GCPRO5, we refetch
563 item_string instead of protecting it. */
564 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
565 descrip
= def
= Qnil
;
567 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
568 enabled
= menu_item_enabled_p (def
, notreal
);
572 item_string
= XCONS (item1
)->car
;
574 tem
= Fkeymapp (def
);
575 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
576 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
581 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
582 submap
= get_keymap_1 (def
, 0, 1);
584 #ifndef USE_X_TOOLKIT
586 item_string
= concat2 (item_string
,
587 build_string (" >"));
589 push_menu_item (item_string
, enabled
, character
,
594 push_submenu_start ();
595 single_keymap_panes (submap
, Qnil
,
607 /* Process now any submenus which want to be panes at this level. */
608 while (!NILP (pending_maps
))
610 Lisp_Object elt
, eltcdr
, string
;
611 elt
= Fcar (pending_maps
);
612 eltcdr
= XCONS (elt
)->cdr
;
613 string
= XCONS (eltcdr
)->car
;
614 /* We no longer discard the @ from the beginning of the string here.
615 Instead, we do this in xmenu_show. */
616 single_keymap_panes (Fcar (elt
), string
,
617 XCONS (eltcdr
)->cdr
, notreal
);
618 pending_maps
= Fcdr (pending_maps
);
622 /* Push all the panes and items of a menu decsribed by the
623 alist-of-alists MENU.
624 This handles old-fashioned calls to x-popup-menu. */
634 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
636 Lisp_Object elt
, pane_name
, pane_data
;
638 pane_name
= Fcar (elt
);
639 CHECK_STRING (pane_name
, 0);
640 push_menu_pane (pane_name
, Qnil
);
641 pane_data
= Fcdr (elt
);
642 CHECK_CONS (pane_data
, 0);
643 list_of_items (pane_data
);
646 finish_menu_items ();
649 /* Push the items in a single pane defined by the alist PANE. */
655 Lisp_Object tail
, item
, item1
;
657 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
661 push_menu_item (item
, Qnil
, Qnil
, Qnil
);
662 else if (NILP (item
))
663 push_left_right_boundary ();
666 CHECK_CONS (item
, 0);
668 CHECK_STRING (item1
, 1);
669 push_menu_item (item1
, Qt
, Fcdr (item
), Qnil
);
674 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
675 "Pop up a deck-of-cards menu and return user's selection.\n\
676 POSITION is a position specification. This is either a mouse button event\n\
677 or a list ((XOFFSET YOFFSET) WINDOW)\n\
678 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
679 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
680 This controls the position of the center of the first line\n\
681 in the first pane of the menu, not the top left of the menu as a whole.\n\
682 If POSITION is t, it means to use the current mouse position.\n\
684 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
685 The menu items come from key bindings that have a menu string as well as\n\
686 a definition; actually, the \"definition\" in such a key binding looks like\n\
687 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
688 the keymap as a top-level element.\n\n\
689 You can also use a list of keymaps as MENU.\n\
690 Then each keymap makes a separate pane.\n\
691 When MENU is a keymap or a list of keymaps, the return value\n\
692 is a list of events.\n\n\
693 Alternatively, you can specify a menu of multiple panes\n\
694 with a list of the form (TITLE PANE1 PANE2...),\n\
695 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
696 Each ITEM is normally a cons cell (STRING . VALUE);\n\
697 but a string can appear as an item--that makes a nonselectable line\n\
699 With this form of menu, the return value is VALUE from the chosen item.\n\
701 If POSITION is nil, don't display the menu at all, just precalculate the\n\
702 cached information about equivalent key sequences.")
704 Lisp_Object position
, menu
;
706 int number_of_panes
, panes
;
707 Lisp_Object keymap
, tem
;
711 Lisp_Object selection
;
714 Lisp_Object x
, y
, window
;
719 if (! NILP (position
))
723 /* Decode the first argument: find the window and the coordinates. */
724 if (EQ (position
, Qt
))
726 /* Use the mouse's current position. */
728 Lisp_Object bar_window
;
732 if (mouse_position_hook
)
733 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
735 XSET (window
, Lisp_Frame
, new_f
);
738 window
= selected_window
;
745 tem
= Fcar (position
);
748 window
= Fcar (Fcdr (position
));
750 y
= Fcar (Fcdr (tem
));
754 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
755 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
756 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
760 /* Determine whether this menu is handling a menu bar click. */
761 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
762 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
770 /* Decode where to put the menu. */
779 else if (WINDOWP (window
))
781 CHECK_LIVE_WINDOW (window
, 0);
782 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
784 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
785 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
788 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
789 but I don't want to make one now. */
790 CHECK_WINDOW (window
, 0);
799 /* Decode the menu items from what was specified. */
801 keymap
= Fkeymapp (menu
);
804 tem
= Fkeymapp (Fcar (menu
));
807 /* We were given a keymap. Extract menu info from the keymap. */
809 keymap
= get_keymap (menu
);
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
= map_prompt (keymap
);
818 /* Make that be the pane title of the first pane. */
819 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
820 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
824 else if (!NILP (tem
))
826 /* We were given a list of keymaps. */
827 int nmaps
= XFASTINT (Flength (menu
));
829 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
834 /* The first keymap that has a prompt string
835 supplies the menu title. */
836 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
840 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
842 prompt
= map_prompt (keymap
);
843 if (NILP (title
) && !NILP (prompt
))
847 /* Extract the detailed info to make one pane. */
848 keymap_panes (maps
, nmaps
, NILP (position
));
850 /* Make the title be the pane title of the first pane. */
851 if (!NILP (title
) && menu_items_n_panes
>= 0)
852 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
858 /* We were given an old-fashioned menu. */
860 CHECK_STRING (title
, 1);
862 list_of_panes (Fcdr (menu
));
869 discard_menu_items ();
874 /* Display them in a menu. */
877 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
,
878 keymaps
, title
, &error_name
);
881 discard_menu_items ();
885 if (error_name
) error (error_name
);
889 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
890 "Pop up a dialog box and return user's selection.\n\
891 POSITION specifies which frame to use.\n\
892 This is normally a mouse button event or a window or frame.\n\
893 If POSITION is t, it means to use the frame the mouse is on.\n\
894 The dialog box appears in the middle of the specified frame.\n\
896 CONTENTS specifies the alternatives to display in the dialog box.\n\
897 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
898 Each ITEM is a cons cell (STRING . VALUE).\n\
899 The return value is VALUE from the chosen item.\n\n\
900 An ITEM may also be just a string--that makes a nonselectable item.\n\
901 An ITEM may also be nil--that means to put all preceding items\n\
902 on the left of the dialog box and all following items on the right.\n\
903 \(By default, approximately half appear on each side.)")
905 Lisp_Object position
, contents
;
912 /* Decode the first argument: find the window or frame to use. */
913 if (EQ (position
, Qt
))
915 #if 0 /* Using the frame the mouse is on may not be right. */
916 /* Use the mouse's current position. */
918 Lisp_Object bar_window
;
923 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
926 XSET (window
, Lisp_Frame
, new_f
);
928 window
= selected_window
;
930 /* Decode the first argument: find the window and the coordinates. */
931 if (EQ (position
, Qt
))
932 window
= selected_window
;
934 else if (CONSP (position
))
937 tem
= Fcar (position
);
939 window
= Fcar (Fcdr (position
));
942 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
943 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
946 else if (WINDOWP (position
) || FRAMEP (position
))
949 /* Decode where to put the menu. */
953 else if (WINDOWP (window
))
955 CHECK_LIVE_WINDOW (window
, 0);
956 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
959 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
960 but I don't want to make one now. */
961 CHECK_WINDOW (window
, 0);
963 #ifndef USE_X_TOOLKIT
964 /* Display a menu with these alternatives
965 in the middle of frame F. */
967 Lisp_Object x
, y
, frame
, newpos
;
968 XSET (frame
, Lisp_Frame
, f
);
969 XSET (x
, Lisp_Int
, x_pixel_width (f
) / 2);
970 XSET (y
, Lisp_Int
, x_pixel_height (f
) / 2);
971 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
973 return Fx_popup_menu (newpos
,
974 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
980 Lisp_Object selection
;
982 /* Decode the dialog items from what was specified. */
983 title
= Fcar (contents
);
984 CHECK_STRING (title
, 1);
986 list_of_panes (Fcons (contents
, Qnil
));
988 /* Display them in a dialog box. */
990 selection
= xdialog_show (f
, 0, 0, title
, &error_name
);
993 discard_menu_items ();
995 if (error_name
) error (error_name
);
1001 #ifdef USE_X_TOOLKIT
1003 /* Loop in Xt until the menu pulldown or dialog popup has been
1004 popped down (deactivated). */
1006 popup_get_selection (initial_event
)
1007 XEvent
*initial_event
;
1012 event
= *initial_event
;
1014 XtAppNextEvent (Xt_app_con
, &event
);
1019 XtDispatchEvent (&event
);
1021 if (!popup_activated())
1023 XtAppNextEvent (Xt_app_con
, &event
);
1027 /* Detect if a dialog or menu has been posted. */
1031 return popup_activated_flag
;
1035 /* This callback is invoked when the user selects a menubar cascade
1036 pushbutton, but before the pulldown menu is posted. */
1039 popup_activate_callback (widget
, id
, client_data
)
1042 XtPointer client_data
;
1044 popup_activated_flag
= 1;
1047 /* This callback is called from the menu bar pulldown menu
1048 when the user makes a selection.
1049 Figure out what the user chose
1050 and put the appropriate events into the keyboard buffer. */
1053 menubar_selection_callback (widget
, id
, client_data
)
1056 XtPointer client_data
;
1059 FRAME_PTR f
= (FRAME_PTR
) id
;
1061 Lisp_Object
*subprefix_stack
;
1062 int submenu_depth
= 0;
1067 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1068 vector
= f
->menu_bar_vector
;
1071 while (i
< f
->menu_bar_items_used
)
1075 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1077 subprefix_stack
[submenu_depth
++] = prefix
;
1081 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1083 prefix
= subprefix_stack
[--submenu_depth
];
1086 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1089 = XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1090 i
+= MENU_ITEMS_PANE_LENGTH
;
1095 = XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1096 if ((int) client_data
== i
)
1099 struct input_event buf
;
1101 buf
.kind
= menu_bar_event
;
1102 buf
.frame_or_window
= Qmenu_bar
;
1103 kbd_buffer_store_event (&buf
);
1105 for (j
= 0; j
< submenu_depth
; j
++)
1106 if (!NILP (subprefix_stack
[j
]))
1108 buf
.kind
= menu_bar_event
;
1109 buf
.frame_or_window
= subprefix_stack
[j
];
1110 kbd_buffer_store_event (&buf
);
1115 buf
.kind
= menu_bar_event
;
1116 buf
.frame_or_window
= prefix
;
1117 kbd_buffer_store_event (&buf
);
1120 buf
.kind
= menu_bar_event
;
1121 buf
.frame_or_window
= entry
;
1122 kbd_buffer_store_event (&buf
);
1126 i
+= MENU_ITEMS_ITEM_LENGTH
;
1131 /* This callback is invoked when a dialog or menu is finished being
1132 used and has been unposted. */
1135 popup_deactivate_callback (widget
, id
, client_data
)
1138 XtPointer client_data
;
1140 popup_activated_flag
= 0;
1144 /* This recursively calls free_widget_value on the tree of widgets.
1145 It must free all data that was malloc'ed for these widget_values.
1146 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1147 must be left alone. */
1150 free_menubar_widget_value_tree (wv
)
1155 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1157 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1159 free_menubar_widget_value_tree (wv
->contents
);
1160 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1164 free_menubar_widget_value_tree (wv
->next
);
1165 wv
->next
= (widget_value
*) 0xDEADBEEF;
1168 free_widget_value (wv
);
1172 /* Return a tree of widget_value structures for a menu bar item
1173 whose event type is ITEM_KEY (with string ITEM_NAME)
1174 and whose contents come from the list of keymaps MAPS. */
1176 static widget_value
*
1177 single_submenu (item_key
, item_name
, maps
)
1178 Lisp_Object item_key
, item_name
, maps
;
1180 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1182 int submenu_depth
= 0;
1185 Lisp_Object
*mapvec
;
1186 widget_value
**submenu_stack
;
1188 int previous_items
= menu_items_used
;
1190 length
= Flength (maps
);
1191 len
= XINT (length
);
1193 /* Convert the list MAPS into a vector MAPVEC. */
1194 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1195 for (i
= 0; i
< len
; i
++)
1197 mapvec
[i
] = Fcar (maps
);
1201 menu_items_n_panes
= 0;
1203 /* Loop over the given keymaps, making a pane for each map.
1204 But don't make a pane that is empty--ignore that map instead. */
1205 for (i
= 0; i
< len
; i
++)
1206 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0);
1208 /* Create a tree of widget_value objects
1209 representing the panes and their items. */
1212 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1213 wv
= malloc_widget_value ();
1220 /* Loop over all panes and items made during this call
1221 and construct a tree of widget_value objects.
1222 Ignore the panes and items made by previous calls to
1223 single_submenu, even though those are also in menu_items. */
1225 while (i
< menu_items_used
)
1227 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1229 submenu_stack
[submenu_depth
++] = save_wv
;
1234 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1237 save_wv
= submenu_stack
[--submenu_depth
];
1240 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1241 && submenu_depth
!= 0)
1242 i
+= MENU_ITEMS_PANE_LENGTH
;
1243 /* Ignore a nil in the item list.
1244 It's meaningful only for dialog boxes. */
1245 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1247 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1249 /* Create a new pane. */
1250 Lisp_Object pane_name
, prefix
;
1252 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1253 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1254 pane_string
= (NILP (pane_name
)
1255 ? "" : (char *) XSTRING (pane_name
)->data
);
1256 /* If there is just one top-level pane, put all its items directly
1257 under the top-level menu. */
1258 if (menu_items_n_panes
== 1)
1261 /* If the pane has a meaningful name,
1262 make the pane a top-level menu item
1263 with its items as a submenu beneath it. */
1264 if (strcmp (pane_string
, ""))
1266 wv
= malloc_widget_value ();
1270 first_wv
->contents
= wv
;
1271 wv
->name
= pane_string
;
1279 i
+= MENU_ITEMS_PANE_LENGTH
;
1283 /* Create a new item within current pane. */
1284 Lisp_Object item_name
, enable
, descrip
;
1285 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1286 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1288 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1290 wv
= malloc_widget_value ();
1294 save_wv
->contents
= wv
;
1295 wv
->name
= (char *) XSTRING (item_name
)->data
;
1296 if (!NILP (descrip
))
1297 wv
->key
= (char *) XSTRING (descrip
)->data
;
1299 wv
->call_data
= (void *) i
;
1300 wv
->enabled
= !NILP (enable
);
1303 i
+= MENU_ITEMS_ITEM_LENGTH
;
1310 extern void EmacsFrameSetCharSize ();
1312 /* Recompute the menu bar of frame F. */
1315 update_frame_menubar (f
)
1318 struct x_display
*x
= f
->display
.x
;
1320 int menubar_changed
;
1322 Dimension shell_height
;
1324 /* We assume the menubar contents has changed if the global flag is set,
1325 or if the current buffer has changed, or if the menubar has never
1326 been updated before.
1328 menubar_changed
= (x
->menubar_widget
1329 && !XtIsManaged (x
->menubar_widget
));
1331 if (! (menubar_changed
))
1335 /* Save the size of the frame because the pane widget doesn't accept to
1336 resize itself. So force it. */
1340 /* Do the voodoo which means "I'm changing lots of things, don't try to
1341 refigure sizes until I'm done." */
1342 lw_refigure_widget (x
->column_widget
, False
);
1344 /* the order in which children are managed is the top to
1345 bottom order in which they are displayed in the paned window.
1346 First, remove the text-area widget.
1348 XtUnmanageChild (x
->edit_widget
);
1350 /* remove the menubar that is there now, and put up the menubar that
1353 if (menubar_changed
)
1355 XtManageChild (x
->menubar_widget
);
1356 XtMapWidget (x
->menubar_widget
);
1357 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1360 /* Re-manage the text-area widget, and then thrash the sizes. */
1361 XtManageChild (x
->edit_widget
);
1362 lw_refigure_widget (x
->column_widget
, True
);
1364 /* Force the pane widget to resize itself with the right values. */
1365 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1371 set_frame_menubar (f
, first_time
)
1375 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1377 Lisp_Object tail
, items
;
1378 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
1383 wv
= malloc_widget_value ();
1384 wv
->name
= "menubar";
1387 save_wv
= first_wv
= wv
;
1388 items
= FRAME_MENU_BAR_ITEMS (f
);
1389 menu_items
= f
->menu_bar_vector
;
1390 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1393 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1395 Lisp_Object key
, string
, maps
;
1397 key
= XVECTOR (items
)->contents
[i
];
1398 string
= XVECTOR (items
)->contents
[i
+ 1];
1399 maps
= XVECTOR (items
)->contents
[i
+ 2];
1403 wv
= single_submenu (key
, string
, maps
);
1407 save_wv
->contents
= wv
;
1408 wv
->name
= (char *) XSTRING (string
)->data
;
1413 finish_menu_items ();
1415 f
->menu_bar_vector
= menu_items
;
1416 f
->menu_bar_items_used
= menu_items_used
;
1421 /* Disable resizing (done for Motif!) */
1422 lw_allow_resizing (f
->display
.x
->widget
, False
);
1424 /* The third arg is DEEP_P, which says to consider the entire
1425 menu trees we supply, rather than just the menu bar item names. */
1426 lw_modify_all_widgets (id
, first_wv
, 1);
1428 /* Re-enable the edit widget to resize. */
1429 lw_allow_resizing (f
->display
.x
->widget
, True
);
1433 menubar_widget
= lw_create_widget ("menubar", "menubar",
1435 f
->display
.x
->column_widget
,
1437 popup_activate_callback
,
1438 menubar_selection_callback
,
1439 popup_deactivate_callback
);
1440 f
->display
.x
->menubar_widget
= menubar_widget
;
1443 free_menubar_widget_value_tree (first_wv
);
1445 /* Don't update the menubar the first time it is created via x_window. */
1447 update_frame_menubar (f
);
1452 /* Called from Fx_create_frame to create the inital menubar of a frame
1453 before it is mapped, so that the window is mapped with the menubar already
1454 there instead of us tacking it on later and thrashing the window after it
1458 initialize_frame_menubar (f
)
1461 /* This function is called before the first chance to redisplay
1462 the frame. It has to be, so the frame will have the right size. */
1463 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1464 set_frame_menubar (f
, 1);
1467 /* Get rid of the menu bar of frame F, and free its storage.
1468 This is used when deleting a frame, and when turning off the menu bar. */
1471 free_frame_menubar (f
)
1474 Widget menubar_widget
;
1477 menubar_widget
= f
->display
.x
->menubar_widget
;
1483 lw_destroy_all_widgets (id
);
1488 /* Horizontal bounds of the current menu bar item. */
1490 static int this_menu_bar_item_beg
;
1491 static int this_menu_bar_item_end
;
1493 /* Horizontal position of the end of the last menu bar item. */
1495 static int last_menu_bar_item_end
;
1497 /* Nonzero if position X, Y is in the menu bar and in some menu bar item
1498 but not in the current menu bar item. */
1501 other_menu_bar_item_p (f
, x
, y
)
1506 && f
->display
.x
->menubar_widget
!= 0
1507 && y
< f
->display
.x
->menubar_widget
->core
.height
1509 && x
< last_menu_bar_item_end
1510 && (x
>= this_menu_bar_item_end
1511 || x
< this_menu_bar_item_beg
));
1514 /* Unread a button-press event in the menu bar of frame F
1515 at x position XPOS relative to the inside of the frame. */
1518 unread_menu_bar_button (f
, xpos
)
1524 event
.type
= ButtonPress
;
1525 event
.xbutton
.display
= x_current_display
;
1526 event
.xbutton
.serial
= 0;
1527 event
.xbutton
.send_event
= 0;
1528 event
.xbutton
.time
= CurrentTime
;
1529 event
.xbutton
.button
= Button1
;
1530 event
.xbutton
.window
= XtWindow (f
->display
.x
->menubar_widget
);
1531 event
.xbutton
.x
= xpos
;
1532 XPutBackEvent (XDISPLAY
&event
);
1535 /* If the mouse has moved to another menu bar item,
1536 return 1 and unread a button press event for that item.
1537 Otherwise return 0. */
1540 check_mouse_other_menu_bar (f
)
1544 Lisp_Object bar_window
;
1549 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1551 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1553 unread_menu_bar_button (f
, x
);
1559 #endif /* USE_X_TOOLKIT */
1561 /* xmenu_show actually displays a menu using the panes and items in menu_items
1562 and returns the value selected from it.
1563 There are two versions of xmenu_show, one for Xt and one for Xlib.
1564 Both assume input is blocked by the caller. */
1566 /* F is the frame the menu is for.
1567 X and Y are the frame-relative specified position,
1568 relative to the inside upper left corner of the frame F.
1569 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1570 KEYMAPS is 1 if this menu was specified with keymaps;
1571 in that case, we return a list containing the chosen item's value
1572 and perhaps also the pane's prefix.
1573 TITLE is the specified menu title.
1574 ERROR is a place to store an error message string in case of failure.
1575 (We return nil on failure, but the value doesn't actually matter.) */
1577 #ifdef USE_X_TOOLKIT
1579 extern unsigned last_event_timestamp
;
1580 extern Lisp_Object Vdouble_click_time
;
1582 extern unsigned int x_mouse_grabbed
;
1583 extern Lisp_Object Vmouse_depressed
;
1586 static Lisp_Object
*volatile menu_item_selection
;
1588 static Lisp_Object
*menu_item_selection
;
1592 popup_selection_callback (widget
, id
, client_data
)
1595 XtPointer client_data
;
1597 menu_item_selection
= (Lisp_Object
*) client_data
;
1601 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1605 int menubarp
; /* Dummy parameter for Xt version of
1616 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1617 widget_value
**submenu_stack
1618 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1619 Lisp_Object
*subprefix_stack
1620 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1621 int submenu_depth
= 0;
1623 /* Define a queue to save up for later unreading
1624 all X events that don't pertain to the menu. */
1628 struct event_queue
*next
;
1631 struct event_queue
*queue
= NULL
;
1632 struct event_queue
*queue_tmp
;
1634 Position root_x
, root_y
;
1637 int next_release_must_exit
= 0;
1641 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1643 *error
= "Empty menu";
1647 /* Create a tree of widget_value objects
1648 representing the panes and their items. */
1649 wv
= malloc_widget_value ();
1656 /* Loop over all panes and items, filling in the tree. */
1658 while (i
< menu_items_used
)
1660 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1662 submenu_stack
[submenu_depth
++] = save_wv
;
1668 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1671 save_wv
= submenu_stack
[--submenu_depth
];
1675 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1676 && submenu_depth
!= 0)
1677 i
+= MENU_ITEMS_PANE_LENGTH
;
1678 /* Ignore a nil in the item list.
1679 It's meaningful only for dialog boxes. */
1680 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1682 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1684 /* Create a new pane. */
1685 Lisp_Object pane_name
, prefix
;
1687 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1688 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1689 pane_string
= (NILP (pane_name
)
1690 ? "" : (char *) XSTRING (pane_name
)->data
);
1691 /* If there is just one top-level pane, put all its items directly
1692 under the top-level menu. */
1693 if (menu_items_n_panes
== 1)
1696 /* If the pane has a meaningful name,
1697 make the pane a top-level menu item
1698 with its items as a submenu beneath it. */
1699 if (!keymaps
&& strcmp (pane_string
, ""))
1701 wv
= malloc_widget_value ();
1705 first_wv
->contents
= wv
;
1706 wv
->name
= pane_string
;
1707 if (keymaps
&& !NILP (prefix
))
1714 else if (first_pane
)
1720 i
+= MENU_ITEMS_PANE_LENGTH
;
1724 /* Create a new item within current pane. */
1725 Lisp_Object item_name
, enable
, descrip
;
1726 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1727 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1729 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1731 wv
= malloc_widget_value ();
1735 save_wv
->contents
= wv
;
1736 wv
->name
= (char *) XSTRING (item_name
)->data
;
1737 if (!NILP (descrip
))
1738 wv
->key
= (char *) XSTRING (descrip
)->data
;
1740 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1741 wv
->enabled
= !NILP (enable
);
1744 i
+= MENU_ITEMS_ITEM_LENGTH
;
1748 /* Deal with the title, if it is non-nil. */
1751 widget_value
*wv_title
= malloc_widget_value ();
1752 widget_value
*wv_sep1
= malloc_widget_value ();
1753 widget_value
*wv_sep2
= malloc_widget_value ();
1755 wv_sep2
->name
= "--";
1756 wv_sep2
->next
= first_wv
->contents
;
1758 wv_sep1
->name
= "--";
1759 wv_sep1
->next
= wv_sep2
;
1761 wv_title
->name
= (char *) XSTRING (title
)->data
;
1762 wv_title
->enabled
= True
;
1763 wv_title
->next
= wv_sep1
;
1764 first_wv
->contents
= wv_title
;
1767 /* Actually create the menu. */
1768 menu_id
= ++widget_id_tick
;
1769 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1770 f
->display
.x
->widget
, 1, 0,
1771 popup_selection_callback
,
1772 popup_deactivate_callback
);
1774 /* Don't allow any geometry request from the user. */
1775 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
1776 XtSetValues (menu
, av
, ac
);
1778 /* Free the widget_value objects we used to specify the contents. */
1779 free_menubar_widget_value_tree (first_wv
);
1781 /* No selection has been chosen yet. */
1782 menu_item_selection
= 0;
1784 /* Display the menu. */
1785 lw_popup_menu (menu
);
1786 popup_activated_flag
= 1;
1788 /* No need to check a second time since this is done in the XEvent loop.
1789 This slows done the execution. */
1791 /* Check again whether the mouse has moved to another menu bar item. */
1792 if (check_mouse_other_menu_bar (f
))
1794 /* The mouse moved into a different menu bar item.
1795 We should bring up that item's menu instead.
1796 First pop down this menu. */
1797 lw_destroy_all_widgets (menu_id
);
1802 /* Process events that apply to the menu. */
1803 popup_get_selection ((XEvent
*) 0);
1806 /* fp turned off the following statement and wrote a comment
1807 that it is unnecessary--that the menu has already disappeared.
1808 I observer that is not so. -- rms. */
1809 /* Make sure the menu disappears. */
1810 lw_destroy_all_widgets (menu_id
);
1812 /* Unread any events that we got but did not handle. */
1813 while (queue
!= NULL
)
1816 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1817 queue
= queue_tmp
->next
;
1818 free ((char *)queue_tmp
);
1819 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1820 interrupt_input_pending
= 1;
1823 /* Find the selected item, and its pane, to return
1824 the proper value. */
1825 if (menu_item_selection
!= 0)
1831 while (i
< menu_items_used
)
1835 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1837 subprefix_stack
[submenu_depth
++] = prefix
;
1841 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1843 prefix
= subprefix_stack
[--submenu_depth
];
1846 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1849 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1850 i
+= MENU_ITEMS_PANE_LENGTH
;
1855 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1856 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1862 entry
= Fcons (entry
, Qnil
);
1864 entry
= Fcons (prefix
, entry
);
1865 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1866 if (!NILP (subprefix_stack
[j
]))
1867 entry
= Fcons (subprefix_stack
[j
], entry
);
1871 i
+= MENU_ITEMS_ITEM_LENGTH
;
1880 dialog_selection_callback (widget
, id
, client_data
)
1883 XtPointer client_data
;
1885 if ((int)client_data
!= -1)
1886 menu_item_selection
= (Lisp_Object
*) client_data
;
1888 lw_destroy_all_widgets (id
);
1892 static char * button_names
[] = {
1893 "button1", "button2", "button3", "button4", "button5",
1894 "button6", "button7", "button8", "button9", "button10" };
1897 xdialog_show (f
, menubarp
, keymaps
, title
, error
)
1904 int i
, nb_buttons
=0;
1907 char dialog_name
[6];
1909 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1911 /* Define a queue to save up for later unreading
1912 all X events that don't pertain to the menu. */
1916 struct event_queue
*next
;
1919 struct event_queue
*queue
= NULL
;
1920 struct event_queue
*queue_tmp
;
1922 /* Number of elements seen so far, before boundary. */
1924 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1925 int boundary_seen
= 0;
1929 if (menu_items_n_panes
> 1)
1931 *error
= "Multiple panes in dialog box";
1935 /* Create a tree of widget_value objects
1936 representing the text label and buttons. */
1938 Lisp_Object pane_name
, prefix
;
1940 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1941 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1942 pane_string
= (NILP (pane_name
)
1943 ? "" : (char *) XSTRING (pane_name
)->data
);
1944 prev_wv
= malloc_widget_value ();
1945 prev_wv
->value
= pane_string
;
1946 if (keymaps
&& !NILP (prefix
))
1948 prev_wv
->enabled
= 1;
1949 prev_wv
->name
= "message";
1952 /* Loop over all panes and items, filling in the tree. */
1953 i
= MENU_ITEMS_PANE_LENGTH
;
1954 while (i
< menu_items_used
)
1957 /* Create a new item within current pane. */
1958 Lisp_Object item_name
, enable
, descrip
;
1959 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1960 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1962 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1964 if (NILP (item_name
))
1966 free_menubar_widget_value_tree (first_wv
);
1967 *error
= "Submenu in dialog items";
1970 if (EQ (item_name
, Qquote
))
1972 /* This is the boundary between left-side elts
1973 and right-side elts. Stop incrementing right_count. */
1978 if (nb_buttons
>= 10)
1980 free_menubar_widget_value_tree (first_wv
);
1981 *error
= "Too many dialog items";
1985 wv
= malloc_widget_value ();
1987 wv
->name
= (char *) button_names
[nb_buttons
];
1988 if (!NILP (descrip
))
1989 wv
->key
= (char *) XSTRING (descrip
)->data
;
1990 wv
->value
= (char *) XSTRING (item_name
)->data
;
1991 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1992 wv
->enabled
= !NILP (enable
);
1995 if (! boundary_seen
)
1999 i
+= MENU_ITEMS_ITEM_LENGTH
;
2002 /* If the boundary was not specified,
2003 by default put half on the left and half on the right. */
2004 if (! boundary_seen
)
2005 left_count
= nb_buttons
- nb_buttons
/ 2;
2007 wv
= malloc_widget_value ();
2008 wv
->name
= dialog_name
;
2010 /* Dialog boxes use a really stupid name encoding
2011 which specifies how many buttons to use
2012 and how many buttons are on the right.
2013 The Q means something also. */
2014 dialog_name
[0] = 'Q';
2015 dialog_name
[1] = '0' + nb_buttons
;
2016 dialog_name
[2] = 'B';
2017 dialog_name
[3] = 'R';
2018 /* Number of buttons to put on the right. */
2019 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2021 wv
->contents
= first_wv
;
2025 /* Actually create the dialog. */
2026 dialog_id
= ++widget_id_tick
;
2027 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2028 f
->display
.x
->widget
, 1, 0,
2029 dialog_selection_callback
, 0);
2030 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2031 /* Free the widget_value objects we used to specify the contents. */
2032 free_menubar_widget_value_tree (first_wv
);
2034 /* No selection has been chosen yet. */
2035 menu_item_selection
= 0;
2037 /* Display the menu. */
2038 lw_pop_up_all_widgets (dialog_id
);
2040 /* Process events that apply to the menu. */
2045 XtAppNextEvent (Xt_app_con
, &event
);
2046 if (event
.type
== ButtonRelease
)
2048 XtDispatchEvent (&event
);
2051 else if (event
.type
== Expose
)
2052 process_expose_from_menu (event
);
2053 XtDispatchEvent (&event
);
2054 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
2056 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
2058 if (queue_tmp
!= NULL
)
2060 queue_tmp
->event
= event
;
2061 queue_tmp
->next
= queue
;
2068 /* State that no mouse buttons are now held.
2069 That is not necessarily true, but the fiction leads to reasonable
2070 results, and it is a pain to ask which are actually held now
2071 or track this in the loop above. */
2072 x_mouse_grabbed
= 0;
2074 /* Unread any events that we got but did not handle. */
2075 while (queue
!= NULL
)
2078 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
2079 queue
= queue_tmp
->next
;
2080 free ((char *)queue_tmp
);
2081 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
2082 interrupt_input_pending
= 1;
2085 /* Find the selected item, and its pane, to return
2086 the proper value. */
2087 if (menu_item_selection
!= 0)
2093 while (i
< menu_items_used
)
2097 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2100 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2101 i
+= MENU_ITEMS_PANE_LENGTH
;
2106 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2107 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2111 entry
= Fcons (entry
, Qnil
);
2113 entry
= Fcons (prefix
, entry
);
2117 i
+= MENU_ITEMS_ITEM_LENGTH
;
2124 #else /* not USE_X_TOOLKIT */
2127 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
2137 int pane
, selidx
, lpane
, status
;
2138 Lisp_Object entry
, pane_prefix
;
2140 int ulx
, uly
, width
, height
;
2141 int dispwidth
, dispheight
;
2145 unsigned int dummy_uint
;
2148 if (menu_items_n_panes
== 0)
2151 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2153 *error
= "Empty menu";
2157 /* Figure out which root window F is on. */
2158 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
2159 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2160 &dummy_uint
, &dummy_uint
);
2162 /* Make the menu on that window. */
2163 menu
= XMenuCreate (XDISPLAY root
, "emacs");
2166 *error
= "Can't create menu";
2170 /* Adjust coordinates to relative to the outer (window manager) window. */
2174 int win_x
= 0, win_y
= 0;
2176 /* Find the position of the outside upper-left corner of
2177 the inner window, with respect to the outer window. */
2178 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2181 XTranslateCoordinates (x_current_display
,
2183 /* From-window, to-window. */
2184 f
->display
.x
->window_desc
,
2185 f
->display
.x
->parent_desc
,
2187 /* From-position, to-position. */
2188 0, 0, &win_x
, &win_y
,
2190 /* Child of window. */
2197 #endif /* HAVE_X11 */
2199 /* Adjust coordinates to be root-window-relative. */
2200 x
+= f
->display
.x
->left_pos
;
2201 y
+= f
->display
.x
->top_pos
;
2203 /* Create all the necessary panes and their items. */
2205 while (i
< menu_items_used
)
2207 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2209 /* Create a new pane. */
2210 Lisp_Object pane_name
, prefix
;
2213 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2214 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2215 pane_string
= (NILP (pane_name
)
2216 ? "" : (char *) XSTRING (pane_name
)->data
);
2217 if (keymaps
&& !NILP (prefix
))
2220 lpane
= XMenuAddPane (XDISPLAY menu
, pane_string
, TRUE
);
2221 if (lpane
== XM_FAILURE
)
2223 XMenuDestroy (XDISPLAY menu
);
2224 *error
= "Can't create pane";
2227 i
+= MENU_ITEMS_PANE_LENGTH
;
2229 /* Find the width of the widest item in this pane. */
2232 while (j
< menu_items_used
)
2235 item
= XVECTOR (menu_items
)->contents
[j
];
2243 width
= XSTRING (item
)->size
;
2244 if (width
> maxwidth
)
2247 j
+= MENU_ITEMS_ITEM_LENGTH
;
2250 /* Ignore a nil in the item list.
2251 It's meaningful only for dialog boxes. */
2252 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2256 /* Create a new item within current pane. */
2257 Lisp_Object item_name
, enable
, descrip
;
2258 unsigned char *item_data
;
2260 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2261 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2263 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2264 if (!NILP (descrip
))
2266 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2269 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2270 item_name
= concat2 (item_name
, spacer
);
2271 item_name
= concat2 (item_name
, descrip
);
2272 item_data
= XSTRING (item_name
)->data
;
2274 /* if alloca is fast, use that to make the space,
2275 to reduce gc needs. */
2277 = (unsigned char *) alloca (maxwidth
2278 + XSTRING (descrip
)->size
+ 1);
2279 bcopy (XSTRING (item_name
)->data
, item_data
,
2280 XSTRING (item_name
)->size
);
2281 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2283 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2284 XSTRING (descrip
)->size
);
2285 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2289 item_data
= XSTRING (item_name
)->data
;
2291 if (XMenuAddSelection (XDISPLAY menu
, lpane
, 0, item_data
,
2295 XMenuDestroy (XDISPLAY menu
);
2296 *error
= "Can't add selection to menu";
2299 i
+= MENU_ITEMS_ITEM_LENGTH
;
2303 /* All set and ready to fly. */
2304 XMenuRecompute (XDISPLAY menu
);
2305 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
2306 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
2307 x
= min (x
, dispwidth
);
2308 y
= min (y
, dispheight
);
2311 XMenuLocate (XDISPLAY menu
, 0, 0, x
, y
,
2312 &ulx
, &uly
, &width
, &height
);
2313 if (ulx
+width
> dispwidth
)
2315 x
-= (ulx
+ width
) - dispwidth
;
2316 ulx
= dispwidth
- width
;
2318 if (uly
+height
> dispheight
)
2320 y
-= (uly
+ height
) - dispheight
;
2321 uly
= dispheight
- height
;
2323 if (ulx
< 0) x
-= ulx
;
2324 if (uly
< 0) y
-= uly
;
2326 XMenuSetAEQ (menu
, TRUE
);
2327 XMenuSetFreeze (menu
, TRUE
);
2330 status
= XMenuActivate (XDISPLAY menu
, &pane
, &selidx
,
2331 x
, y
, ButtonReleaseMask
, &datap
);
2336 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2339 /* Find the item number SELIDX in pane number PANE. */
2341 while (i
< menu_items_used
)
2343 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2347 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2349 i
+= MENU_ITEMS_PANE_LENGTH
;
2358 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2361 entry
= Fcons (entry
, Qnil
);
2362 if (!NILP (pane_prefix
))
2363 entry
= Fcons (pane_prefix
, entry
);
2369 i
+= MENU_ITEMS_ITEM_LENGTH
;
2375 *error
= "Can't activate menu";
2381 XMenuDestroy (XDISPLAY menu
);
2383 /* State that no mouse buttons are now held.
2384 (The oldXMenu code doesn't track this info for us.)
2385 That is not necessarily true, but the fiction leads to reasonable
2386 results, and it is a pain to ask which are actually held now. */
2387 x_mouse_grabbed
= 0;
2392 #endif /* not USE_X_TOOLKIT */
2396 staticpro (&menu_items
);
2399 widget_id_tick
= (1<<16);
2400 defsubr (&Sx_popup_menu
);
2401 defsubr (&Sx_popup_dialog
);