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"
50 /* This may include sys/types.h, and that somehow loses
51 if this is not done before the other system files. */
55 /* Load sys/types.h if not already loaded.
56 In some systems loading it twice is suicidal. */
58 #include <sys/types.h>
61 #include "dispextern.h"
66 #include <X11/IntrinsicP.h>
67 #include <X11/CoreP.h>
68 #include <X11/StringDefs.h>
69 #include <X11/Shell.h>
70 #include "../lwlib/lwlib.h"
71 #else /* not USE_X_TOOLKIT */
72 #include "../oldXMenu/XMenu.h"
73 #endif /* not USE_X_TOOLKIT */
74 #endif /* HAVE_X_WINDOWS */
76 #define min(x,y) (((x) < (y)) ? (x) : (y))
77 #define max(x,y) (((x) > (y)) ? (x) : (y))
84 extern Lisp_Object Qmenu_enable
;
85 extern Lisp_Object Qmenu_bar
;
86 extern Lisp_Object Qmouse_click
, Qevent_kind
;
89 extern void process_expose_from_menu ();
90 extern XtAppContext Xt_app_con
;
92 static Lisp_Object
xdialog_show ();
93 void popup_get_selection ();
96 static Lisp_Object
xmenu_show ();
97 static void keymap_panes ();
98 static void single_keymap_panes ();
99 static void list_of_panes ();
100 static void list_of_items ();
102 /* This holds a Lisp vector that holds the results of decoding
103 the keymaps or alist-of-alists that specify a menu.
105 It describes the panes and items within the panes.
107 Each pane is described by 3 elements in the vector:
108 t, the pane name, the pane's prefix key.
109 Then follow the pane's items, with 5 elements per item:
110 the item string, the enable flag, the item's value,
111 the definition, and the equivalent keyboard key's description string.
113 In some cases, multiple levels of menus may be described.
114 A single vector slot containing nil indicates the start of a submenu.
115 A single vector slot containing lambda indicates the end of a submenu.
116 The submenu follows a menu item which is the way to reach the submenu.
118 A single vector slot containing quote indicates that the
119 following items should appear on the right of a dialog box.
121 Using a Lisp vector to hold this information while we decode it
122 takes care of protecting all the data from GC. */
124 #define MENU_ITEMS_PANE_NAME 1
125 #define MENU_ITEMS_PANE_PREFIX 2
126 #define MENU_ITEMS_PANE_LENGTH 3
128 #define MENU_ITEMS_ITEM_NAME 0
129 #define MENU_ITEMS_ITEM_ENABLE 1
130 #define MENU_ITEMS_ITEM_VALUE 2
131 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
132 #define MENU_ITEMS_ITEM_DEFINITION 4
133 #define MENU_ITEMS_ITEM_LENGTH 5
135 static Lisp_Object menu_items
;
137 /* Number of slots currently allocated in menu_items. */
138 static int menu_items_allocated
;
140 /* This is the index in menu_items of the first empty slot. */
141 static int menu_items_used
;
143 /* The number of panes currently recorded in menu_items,
144 excluding those within submenus. */
145 static int menu_items_n_panes
;
147 /* Current depth within submenus. */
148 static int menu_items_submenu_depth
;
150 /* Flag which when set indicates a dialog or menu has been posted by
151 Xt on behalf of one of the widget sets. */
152 static int popup_activated_flag
;
155 /* Initialize the menu_items structure if we haven't already done so.
156 Also mark it as currently empty. */
161 if (NILP (menu_items
))
163 menu_items_allocated
= 60;
164 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
168 menu_items_n_panes
= 0;
169 menu_items_submenu_depth
= 0;
172 /* Call at the end of generating the data in menu_items.
173 This fills in the number of items in the last pane. */
180 /* Call when finished using the data for the current menu
184 discard_menu_items ()
186 /* Free the structure if it is especially large.
187 Otherwise, hold on to it, to save time. */
188 if (menu_items_allocated
> 200)
191 menu_items_allocated
= 0;
195 /* Make the menu_items vector twice as large. */
201 int old_size
= menu_items_allocated
;
204 menu_items_allocated
*= 2;
205 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
206 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
207 old_size
* sizeof (Lisp_Object
));
210 /* Begin a submenu. */
213 push_submenu_start ()
215 if (menu_items_used
+ 1 > menu_items_allocated
)
218 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
219 menu_items_submenu_depth
++;
227 if (menu_items_used
+ 1 > menu_items_allocated
)
230 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
231 menu_items_submenu_depth
--;
234 /* Indicate boundary between left and right. */
237 push_left_right_boundary ()
239 if (menu_items_used
+ 1 > menu_items_allocated
)
242 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
245 /* Start a new menu pane in menu_items..
246 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
249 push_menu_pane (name
, prefix_vec
)
250 Lisp_Object name
, prefix_vec
;
252 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
255 if (menu_items_submenu_depth
== 0)
256 menu_items_n_panes
++;
257 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
258 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
259 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
262 /* Push one menu item into the current pane.
263 NAME is the string to display. ENABLE if non-nil means
264 this item can be selected. KEY is the key generated by
265 choosing this item, or nil if this item doesn't really have a definition.
266 DEF is the definition of this item.
267 EQUIV is the textual description of the keyboard equivalent for
268 this item (or nil if none). */
271 push_menu_item (name
, enable
, key
, def
, equiv
)
272 Lisp_Object name
, enable
, key
, def
, equiv
;
274 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
277 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
278 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
279 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
280 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
281 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
284 /* Figure out the current keyboard equivalent of a menu item ITEM1.
285 The item string for menu display should be ITEM_STRING.
286 Store the equivalent keyboard key sequence's
287 textual description into *DESCRIP_PTR.
288 Also cache them in the item itself.
289 Return the real definition to execute. */
292 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
293 Lisp_Object item_string
;
295 Lisp_Object
*descrip_ptr
;
297 /* This is the real definition--the function to run. */
299 /* This is the sublist that records cached equiv key data
300 so we can save time. */
301 Lisp_Object cachelist
;
302 /* These are the saved equivalent keyboard key sequence
303 and its key-description. */
304 Lisp_Object savedkey
, descrip
;
307 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
309 /* If a help string follows the item string, skip it. */
310 if (CONSP (XCONS (item1
)->cdr
)
311 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
312 item1
= XCONS (item1
)->cdr
;
316 /* Get out the saved equivalent-keyboard-key info. */
317 cachelist
= savedkey
= descrip
= Qnil
;
318 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
319 && (NILP (XCONS (XCONS (def
)->car
)->car
)
320 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
322 cachelist
= XCONS (def
)->car
;
323 def
= XCONS (def
)->cdr
;
324 savedkey
= XCONS (cachelist
)->car
;
325 descrip
= XCONS (cachelist
)->cdr
;
328 GCPRO4 (def
, def1
, savedkey
, descrip
);
330 /* Is it still valid? */
332 if (!NILP (savedkey
))
333 def1
= Fkey_binding (savedkey
, Qnil
);
334 /* If not, update it. */
336 /* If the command is an alias for another
337 (such as easymenu.el and lmenu.el set it up),
338 check if the original command matches the cached command. */
339 && !(SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
)
340 && EQ (def1
, XSYMBOL (def
)->function
))
341 /* If something had no key binding before, don't recheck it--
342 doing that takes too much time and makes menus too slow. */
343 && !(!NILP (cachelist
) && NILP (savedkey
)))
347 /* If the command is an alias for another
348 (such as easymenu.el and lmenu.el set it up),
349 see if the original command name has equivalent keys. */
350 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
351 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
354 /* Otherwise look up the specified command itself.
355 We don't try both, because that makes easymenu menus slow. */
356 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
359 if (VECTORP (savedkey
)
360 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
362 /* Reject two-key sequences that start with a mouse click.
363 These are probably menu items. */
364 if (VECTORP (savedkey
)
365 && XVECTOR (savedkey
)->size
> 1
366 && SYMBOLP (XVECTOR (savedkey
)->contents
[0]))
370 tem
= Fget (XVECTOR (savedkey
)->contents
[0], Qevent_kind
);
371 if (EQ (tem
, Qmouse_click
))
374 if (!NILP (savedkey
))
376 descrip
= Fkey_description (savedkey
);
377 descrip
= concat2 (make_string (" (", 3), descrip
);
378 descrip
= concat2 (descrip
, make_string (")", 1));
382 /* Cache the data we just got in a sublist of the menu binding. */
383 if (NILP (cachelist
))
385 CHECK_IMPURE (item1
);
386 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
390 XCONS (cachelist
)->car
= savedkey
;
391 XCONS (cachelist
)->cdr
= descrip
;
395 *descrip_ptr
= descrip
;
399 /* This is used as the handler when calling internal_condition_case_1. */
402 menu_item_enabled_p_1 (arg
)
408 /* Return non-nil if the command DEF is enabled when used as a menu item.
409 This is based on looking for a menu-enable property.
410 If NOTREAL is set, don't bother really computing this. */
413 menu_item_enabled_p (def
, notreal
)
417 Lisp_Object enabled
, tem
;
424 /* No property, or nil, means enable.
425 Otherwise, enable if value is not nil. */
426 tem
= Fget (def
, Qmenu_enable
);
428 /* (condition-case nil (eval tem)
430 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
431 menu_item_enabled_p_1
);
436 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
437 and generate menu panes for them in menu_items.
438 If NOTREAL is nonzero,
439 don't bother really computing whether an item is enabled. */
442 keymap_panes (keymaps
, nmaps
, notreal
)
443 Lisp_Object
*keymaps
;
451 /* Loop over the given keymaps, making a pane for each map.
452 But don't make a pane that is empty--ignore that map instead.
453 P is the number of panes we have made so far. */
454 for (mapno
= 0; mapno
< nmaps
; mapno
++)
455 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
457 finish_menu_items ();
460 /* This is a recursive subroutine of keymap_panes.
461 It handles one keymap, KEYMAP.
462 The other arguments are passed along
463 or point to local variables of the previous function.
464 If NOTREAL is nonzero,
465 don't bother really computing whether an item is enabled. */
468 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
470 Lisp_Object pane_name
;
474 Lisp_Object pending_maps
;
475 Lisp_Object tail
, item
, item1
, item_string
, table
;
476 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
480 push_menu_pane (pane_name
, prefix
);
482 for (tail
= keymap
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
484 /* Look at each key binding, and if it has a menu string,
485 make a menu item from it. */
486 item
= XCONS (tail
)->car
;
489 item1
= XCONS (item
)->cdr
;
492 item_string
= XCONS (item1
)->car
;
493 if (STRINGP (item_string
))
495 /* This is the real definition--the function to run. */
497 /* These are the saved equivalent keyboard key sequence
498 and its key-description. */
500 Lisp_Object tem
, enabled
;
502 /* GCPRO because ...enabled_p will call eval
503 and ..._equiv_key may autoload something.
504 Protecting KEYMAP preserves everything we use;
505 aside from that, must protect whatever might be
506 a string. Since there's no GCPRO5, we refetch
507 item_string instead of protecting it. */
508 descrip
= def
= Qnil
;
509 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
511 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
512 enabled
= menu_item_enabled_p (def
, notreal
);
516 item_string
= XCONS (item1
)->car
;
518 tem
= Fkeymapp (def
);
519 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
520 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
525 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
526 submap
= get_keymap_1 (def
, 0, 1);
528 #ifndef USE_X_TOOLKIT
529 /* Indicate visually that this is a submenu. */
531 item_string
= concat2 (item_string
,
532 build_string (" >"));
534 /* If definition is nil, pass nil as the key. */
535 push_menu_item (item_string
, enabled
,
536 XCONS (item
)->car
, def
,
539 /* Display a submenu using the toolkit. */
542 push_submenu_start ();
543 single_keymap_panes (submap
, Qnil
,
544 XCONS (item
)->car
, notreal
);
552 else if (VECTORP (item
))
554 /* Loop over the char values represented in the vector. */
555 int len
= XVECTOR (item
)->size
;
557 for (c
= 0; c
< len
; c
++)
559 Lisp_Object character
;
560 XSETFASTINT (character
, c
);
561 item1
= XVECTOR (item
)->contents
[c
];
564 item_string
= XCONS (item1
)->car
;
565 if (STRINGP (item_string
))
569 /* These are the saved equivalent keyboard key sequence
570 and its key-description. */
572 Lisp_Object tem
, enabled
;
574 /* GCPRO because ...enabled_p will call eval
575 and ..._equiv_key may autoload something.
576 Protecting KEYMAP preserves everything we use;
577 aside from that, must protect whatever might be
578 a string. Since there's no GCPRO5, we refetch
579 item_string instead of protecting it. */
580 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
581 descrip
= def
= Qnil
;
583 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
584 enabled
= menu_item_enabled_p (def
, notreal
);
588 item_string
= XCONS (item1
)->car
;
590 tem
= Fkeymapp (def
);
591 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
592 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
597 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
598 submap
= get_keymap_1 (def
, 0, 1);
600 #ifndef USE_X_TOOLKIT
602 item_string
= concat2 (item_string
,
603 build_string (" >"));
605 /* If definition is nil, pass nil as the key. */
606 push_menu_item (item_string
, enabled
, character
,
611 push_submenu_start ();
612 single_keymap_panes (submap
, Qnil
,
624 /* Process now any submenus which want to be panes at this level. */
625 while (!NILP (pending_maps
))
627 Lisp_Object elt
, eltcdr
, string
;
628 elt
= Fcar (pending_maps
);
629 eltcdr
= XCONS (elt
)->cdr
;
630 string
= XCONS (eltcdr
)->car
;
631 /* We no longer discard the @ from the beginning of the string here.
632 Instead, we do this in xmenu_show. */
633 single_keymap_panes (Fcar (elt
), string
,
634 XCONS (eltcdr
)->cdr
, notreal
);
635 pending_maps
= Fcdr (pending_maps
);
639 /* Push all the panes and items of a menu decsribed by the
640 alist-of-alists MENU.
641 This handles old-fashioned calls to x-popup-menu. */
651 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
653 Lisp_Object elt
, pane_name
, pane_data
;
655 pane_name
= Fcar (elt
);
656 CHECK_STRING (pane_name
, 0);
657 push_menu_pane (pane_name
, Qnil
);
658 pane_data
= Fcdr (elt
);
659 CHECK_CONS (pane_data
, 0);
660 list_of_items (pane_data
);
663 finish_menu_items ();
666 /* Push the items in a single pane defined by the alist PANE. */
672 Lisp_Object tail
, item
, item1
;
674 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
678 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
);
679 else if (NILP (item
))
680 push_left_right_boundary ();
683 CHECK_CONS (item
, 0);
685 CHECK_STRING (item1
, 1);
686 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
);
691 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
692 "Pop up a deck-of-cards menu and return user's selection.\n\
693 POSITION is a position specification. This is either a mouse button event\n\
694 or a list ((XOFFSET YOFFSET) WINDOW)\n\
695 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
696 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
697 This controls the position of the center of the first line\n\
698 in the first pane of the menu, not the top left of the menu as a whole.\n\
699 If POSITION is t, it means to use the current mouse position.\n\
701 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
702 The menu items come from key bindings that have a menu string as well as\n\
703 a definition; actually, the \"definition\" in such a key binding looks like\n\
704 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
705 the keymap as a top-level element.\n\n\
706 You can also use a list of keymaps as MENU.\n\
707 Then each keymap makes a separate pane.\n\
708 When MENU is a keymap or a list of keymaps, the return value\n\
709 is a list of events.\n\n\
710 Alternatively, you can specify a menu of multiple panes\n\
711 with a list of the form (TITLE PANE1 PANE2...),\n\
712 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
713 Each ITEM is normally a cons cell (STRING . VALUE);\n\
714 but a string can appear as an item--that makes a nonselectable line\n\
716 With this form of menu, the return value is VALUE from the chosen item.\n\
718 If POSITION is nil, don't display the menu at all, just precalculate the\n\
719 cached information about equivalent key sequences.")
721 Lisp_Object position
, menu
;
723 int number_of_panes
, panes
;
724 Lisp_Object keymap
, tem
;
728 Lisp_Object selection
;
731 Lisp_Object x
, y
, window
;
736 if (! NILP (position
))
740 /* Decode the first argument: find the window and the coordinates. */
741 if (EQ (position
, Qt
))
743 /* Use the mouse's current position. */
745 Lisp_Object bar_window
;
749 if (mouse_position_hook
)
750 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
752 XSETFRAME (window
, new_f
);
755 window
= selected_window
;
762 tem
= Fcar (position
);
765 window
= Fcar (Fcdr (position
));
767 y
= Fcar (Fcdr (tem
));
771 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
772 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
773 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
777 /* Determine whether this menu is handling a menu bar click. */
778 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
779 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
787 /* Decode where to put the menu. */
795 else if (WINDOWP (window
))
797 CHECK_LIVE_WINDOW (window
, 0);
798 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
800 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
801 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
804 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
805 but I don't want to make one now. */
806 CHECK_WINDOW (window
, 0);
815 /* Decode the menu items from what was specified. */
817 keymap
= Fkeymapp (menu
);
820 tem
= Fkeymapp (Fcar (menu
));
823 /* We were given a keymap. Extract menu info from the keymap. */
825 keymap
= get_keymap (menu
);
827 /* Extract the detailed info to make one pane. */
828 keymap_panes (&menu
, 1, NILP (position
));
830 /* Search for a string appearing directly as an element of the keymap.
831 That string is the title of the menu. */
832 prompt
= map_prompt (keymap
);
834 /* Make that be the pane title of the first pane. */
835 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
836 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
840 else if (!NILP (tem
))
842 /* We were given a list of keymaps. */
843 int nmaps
= XFASTINT (Flength (menu
));
845 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
850 /* The first keymap that has a prompt string
851 supplies the menu title. */
852 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
856 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
858 prompt
= map_prompt (keymap
);
859 if (NILP (title
) && !NILP (prompt
))
863 /* Extract the detailed info to make one pane. */
864 keymap_panes (maps
, nmaps
, NILP (position
));
866 /* Make the title be the pane title of the first pane. */
867 if (!NILP (title
) && menu_items_n_panes
>= 0)
868 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
874 /* We were given an old-fashioned menu. */
876 CHECK_STRING (title
, 1);
878 list_of_panes (Fcdr (menu
));
885 discard_menu_items ();
890 /* Display them in a menu. */
893 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
,
894 keymaps
, title
, &error_name
);
897 discard_menu_items ();
901 if (error_name
) error (error_name
);
905 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
906 "Pop up a dialog box and return user's selection.\n\
907 POSITION specifies which frame to use.\n\
908 This is normally a mouse button event or a window or frame.\n\
909 If POSITION is t, it means to use the frame the mouse is on.\n\
910 The dialog box appears in the middle of the specified frame.\n\
912 CONTENTS specifies the alternatives to display in the dialog box.\n\
913 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
914 Each ITEM is a cons cell (STRING . VALUE).\n\
915 The return value is VALUE from the chosen item.\n\n\
916 An ITEM may also be just a string--that makes a nonselectable item.\n\
917 An ITEM may also be nil--that means to put all preceding items\n\
918 on the left of the dialog box and all following items on the right.\n\
919 \(By default, approximately half appear on each side.)")
921 Lisp_Object position
, contents
;
928 /* Decode the first argument: find the window or frame to use. */
929 if (EQ (position
, Qt
))
931 #if 0 /* Using the frame the mouse is on may not be right. */
932 /* Use the mouse's current position. */
934 Lisp_Object bar_window
;
939 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
942 XSETFRAME (window
, new_f
);
944 window
= selected_window
;
946 /* Decode the first argument: find the window and the coordinates. */
947 if (EQ (position
, Qt
))
948 window
= selected_window
;
950 else if (CONSP (position
))
953 tem
= Fcar (position
);
955 window
= Fcar (Fcdr (position
));
958 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
959 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
962 else if (WINDOWP (position
) || FRAMEP (position
))
965 /* Decode where to put the menu. */
969 else if (WINDOWP (window
))
971 CHECK_LIVE_WINDOW (window
, 0);
972 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
975 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
976 but I don't want to make one now. */
977 CHECK_WINDOW (window
, 0);
979 #ifndef USE_X_TOOLKIT
980 /* Display a menu with these alternatives
981 in the middle of frame F. */
983 Lisp_Object x
, y
, frame
, newpos
;
984 XSETFRAME (frame
, f
);
985 XSETINT (x
, x_pixel_width (f
) / 2);
986 XSETINT (y
, x_pixel_height (f
) / 2);
987 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
989 return Fx_popup_menu (newpos
,
990 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
996 Lisp_Object selection
;
998 /* Decode the dialog items from what was specified. */
999 title
= Fcar (contents
);
1000 CHECK_STRING (title
, 1);
1002 list_of_panes (Fcons (contents
, Qnil
));
1004 /* Display them in a dialog box. */
1006 selection
= xdialog_show (f
, 0, 0, title
, &error_name
);
1009 discard_menu_items ();
1011 if (error_name
) error (error_name
);
1017 #ifdef USE_X_TOOLKIT
1019 /* Loop in Xt until the menu pulldown or dialog popup has been
1020 popped down (deactivated).
1022 NOTE: All calls to popup_get_selection() should be protected
1023 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1025 popup_get_selection (initial_event
)
1026 XEvent
*initial_event
;
1031 event
= *initial_event
;
1033 XtAppNextEvent (Xt_app_con
, &event
);
1037 XtDispatchEvent (&event
);
1038 if (!popup_activated())
1040 XtAppNextEvent (Xt_app_con
, &event
);
1044 /* Detect if a dialog or menu has been posted. */
1048 return popup_activated_flag
;
1052 /* This callback is invoked when the user selects a menubar cascade
1053 pushbutton, but before the pulldown menu is posted. */
1056 popup_activate_callback (widget
, id
, client_data
)
1059 XtPointer client_data
;
1061 popup_activated_flag
= 1;
1064 /* This callback is called from the menu bar pulldown menu
1065 when the user makes a selection.
1066 Figure out what the user chose
1067 and put the appropriate events into the keyboard buffer. */
1070 menubar_selection_callback (widget
, id
, client_data
)
1073 XtPointer client_data
;
1076 FRAME_PTR f
= (FRAME_PTR
) id
;
1078 Lisp_Object
*subprefix_stack
;
1079 int submenu_depth
= 0;
1084 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1085 vector
= f
->menu_bar_vector
;
1088 while (i
< f
->menu_bar_items_used
)
1092 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1094 subprefix_stack
[submenu_depth
++] = prefix
;
1098 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1100 prefix
= subprefix_stack
[--submenu_depth
];
1103 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1106 = XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1107 i
+= MENU_ITEMS_PANE_LENGTH
;
1112 = XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1113 if ((int) client_data
== i
)
1116 struct input_event buf
;
1118 buf
.kind
= menu_bar_event
;
1119 buf
.frame_or_window
= Qmenu_bar
;
1120 kbd_buffer_store_event (&buf
);
1122 for (j
= 0; j
< submenu_depth
; j
++)
1123 if (!NILP (subprefix_stack
[j
]))
1125 buf
.kind
= menu_bar_event
;
1126 buf
.frame_or_window
= subprefix_stack
[j
];
1127 kbd_buffer_store_event (&buf
);
1132 buf
.kind
= menu_bar_event
;
1133 buf
.frame_or_window
= prefix
;
1134 kbd_buffer_store_event (&buf
);
1137 buf
.kind
= menu_bar_event
;
1138 buf
.frame_or_window
= entry
;
1139 kbd_buffer_store_event (&buf
);
1143 i
+= MENU_ITEMS_ITEM_LENGTH
;
1148 /* This callback is invoked when a dialog or menu is finished being
1149 used and has been unposted. */
1152 popup_deactivate_callback (widget
, id
, client_data
)
1155 XtPointer client_data
;
1157 popup_activated_flag
= 0;
1161 /* This recursively calls free_widget_value on the tree of widgets.
1162 It must free all data that was malloc'ed for these widget_values.
1163 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1164 must be left alone. */
1167 free_menubar_widget_value_tree (wv
)
1172 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1174 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1176 free_menubar_widget_value_tree (wv
->contents
);
1177 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1181 free_menubar_widget_value_tree (wv
->next
);
1182 wv
->next
= (widget_value
*) 0xDEADBEEF;
1185 free_widget_value (wv
);
1189 /* Return a tree of widget_value structures for a menu bar item
1190 whose event type is ITEM_KEY (with string ITEM_NAME)
1191 and whose contents come from the list of keymaps MAPS. */
1193 static widget_value
*
1194 single_submenu (item_key
, item_name
, maps
)
1195 Lisp_Object item_key
, item_name
, maps
;
1197 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1199 int submenu_depth
= 0;
1202 Lisp_Object
*mapvec
;
1203 widget_value
**submenu_stack
;
1205 int previous_items
= menu_items_used
;
1207 length
= Flength (maps
);
1208 len
= XINT (length
);
1210 /* Convert the list MAPS into a vector MAPVEC. */
1211 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1212 for (i
= 0; i
< len
; i
++)
1214 mapvec
[i
] = Fcar (maps
);
1218 menu_items_n_panes
= 0;
1220 /* Loop over the given keymaps, making a pane for each map.
1221 But don't make a pane that is empty--ignore that map instead. */
1222 for (i
= 0; i
< len
; i
++)
1223 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0);
1225 /* Create a tree of widget_value objects
1226 representing the panes and their items. */
1229 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1230 wv
= malloc_widget_value ();
1237 /* Loop over all panes and items made during this call
1238 and construct a tree of widget_value objects.
1239 Ignore the panes and items made by previous calls to
1240 single_submenu, even though those are also in menu_items. */
1242 while (i
< menu_items_used
)
1244 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1246 submenu_stack
[submenu_depth
++] = save_wv
;
1251 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1254 save_wv
= submenu_stack
[--submenu_depth
];
1257 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1258 && submenu_depth
!= 0)
1259 i
+= MENU_ITEMS_PANE_LENGTH
;
1260 /* Ignore a nil in the item list.
1261 It's meaningful only for dialog boxes. */
1262 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1264 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1266 /* Create a new pane. */
1267 Lisp_Object pane_name
, prefix
;
1269 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1270 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1271 pane_string
= (NILP (pane_name
)
1272 ? "" : (char *) XSTRING (pane_name
)->data
);
1273 /* If there is just one top-level pane, put all its items directly
1274 under the top-level menu. */
1275 if (menu_items_n_panes
== 1)
1278 /* If the pane has a meaningful name,
1279 make the pane a top-level menu item
1280 with its items as a submenu beneath it. */
1281 if (strcmp (pane_string
, ""))
1283 wv
= malloc_widget_value ();
1287 first_wv
->contents
= wv
;
1288 wv
->name
= pane_string
;
1296 i
+= MENU_ITEMS_PANE_LENGTH
;
1300 /* Create a new item within current pane. */
1301 Lisp_Object item_name
, enable
, descrip
, def
;
1302 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1303 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1305 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1306 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1308 wv
= malloc_widget_value ();
1312 save_wv
->contents
= wv
;
1313 wv
->name
= (char *) XSTRING (item_name
)->data
;
1314 if (!NILP (descrip
))
1315 wv
->key
= (char *) XSTRING (descrip
)->data
;
1317 wv
->call_data
= (!NILP (def
) ? (void *) i
: 0);
1318 wv
->enabled
= !NILP (enable
);
1321 i
+= MENU_ITEMS_ITEM_LENGTH
;
1328 extern void EmacsFrameSetCharSize ();
1330 /* Recompute the menu bar of frame F. */
1333 update_frame_menubar (f
)
1336 struct x_display
*x
= f
->display
.x
;
1338 int menubar_changed
;
1340 Dimension shell_height
;
1342 /* We assume the menubar contents has changed if the global flag is set,
1343 or if the current buffer has changed, or if the menubar has never
1344 been updated before.
1346 menubar_changed
= (x
->menubar_widget
1347 && !XtIsManaged (x
->menubar_widget
));
1349 if (! (menubar_changed
))
1353 /* Save the size of the frame because the pane widget doesn't accept to
1354 resize itself. So force it. */
1358 /* Do the voodoo which means "I'm changing lots of things, don't try to
1359 refigure sizes until I'm done." */
1360 lw_refigure_widget (x
->column_widget
, False
);
1362 /* the order in which children are managed is the top to
1363 bottom order in which they are displayed in the paned window.
1364 First, remove the text-area widget.
1366 XtUnmanageChild (x
->edit_widget
);
1368 /* remove the menubar that is there now, and put up the menubar that
1371 if (menubar_changed
)
1373 XtManageChild (x
->menubar_widget
);
1374 XtMapWidget (x
->menubar_widget
);
1375 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1378 /* Re-manage the text-area widget, and then thrash the sizes. */
1379 XtManageChild (x
->edit_widget
);
1380 lw_refigure_widget (x
->column_widget
, True
);
1382 /* Force the pane widget to resize itself with the right values. */
1383 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1389 set_frame_menubar (f
, first_time
)
1393 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1395 Lisp_Object tail
, items
;
1396 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1401 wv
= malloc_widget_value ();
1402 wv
->name
= "menubar";
1406 items
= FRAME_MENU_BAR_ITEMS (f
);
1407 menu_items
= f
->menu_bar_vector
;
1408 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1411 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1413 Lisp_Object key
, string
, maps
;
1415 key
= XVECTOR (items
)->contents
[i
];
1416 string
= XVECTOR (items
)->contents
[i
+ 1];
1417 maps
= XVECTOR (items
)->contents
[i
+ 2];
1421 wv
= single_submenu (key
, string
, maps
);
1425 first_wv
->contents
= wv
;
1426 /* Don't set wv->name here; GC during the loop might relocate it. */
1431 /* Now GC cannot happen during the lifetime of the widget_value,
1432 so it's safe to store data from a Lisp_String. */
1433 wv
= first_wv
->contents
;
1434 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1437 string
= XVECTOR (items
)->contents
[i
+ 1];
1440 wv
->name
= (char *) XSTRING (string
)->data
;
1444 finish_menu_items ();
1446 f
->menu_bar_vector
= menu_items
;
1447 f
->menu_bar_items_used
= menu_items_used
;
1452 /* Disable resizing (done for Motif!) */
1453 lw_allow_resizing (f
->display
.x
->widget
, False
);
1455 /* The third arg is DEEP_P, which says to consider the entire
1456 menu trees we supply, rather than just the menu bar item names. */
1457 lw_modify_all_widgets (id
, first_wv
, 1);
1459 /* Re-enable the edit widget to resize. */
1460 lw_allow_resizing (f
->display
.x
->widget
, True
);
1464 menubar_widget
= lw_create_widget ("menubar", "menubar",
1466 f
->display
.x
->column_widget
,
1468 popup_activate_callback
,
1469 menubar_selection_callback
,
1470 popup_deactivate_callback
);
1471 f
->display
.x
->menubar_widget
= menubar_widget
;
1474 free_menubar_widget_value_tree (first_wv
);
1476 /* Don't update the menubar the first time it is created via x_window. */
1478 update_frame_menubar (f
);
1483 /* Called from Fx_create_frame to create the inital menubar of a frame
1484 before it is mapped, so that the window is mapped with the menubar already
1485 there instead of us tacking it on later and thrashing the window after it
1489 initialize_frame_menubar (f
)
1492 /* This function is called before the first chance to redisplay
1493 the frame. It has to be, so the frame will have the right size. */
1494 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1495 set_frame_menubar (f
, 1);
1498 /* Get rid of the menu bar of frame F, and free its storage.
1499 This is used when deleting a frame, and when turning off the menu bar. */
1502 free_frame_menubar (f
)
1505 Widget menubar_widget
;
1508 menubar_widget
= f
->display
.x
->menubar_widget
;
1514 lw_destroy_all_widgets (id
);
1519 #endif /* USE_X_TOOLKIT */
1521 /* xmenu_show actually displays a menu using the panes and items in menu_items
1522 and returns the value selected from it.
1523 There are two versions of xmenu_show, one for Xt and one for Xlib.
1524 Both assume input is blocked by the caller. */
1526 /* F is the frame the menu is for.
1527 X and Y are the frame-relative specified position,
1528 relative to the inside upper left corner of the frame F.
1529 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1530 KEYMAPS is 1 if this menu was specified with keymaps;
1531 in that case, we return a list containing the chosen item's value
1532 and perhaps also the pane's prefix.
1533 TITLE is the specified menu title.
1534 ERROR is a place to store an error message string in case of failure.
1535 (We return nil on failure, but the value doesn't actually matter.) */
1537 #ifdef USE_X_TOOLKIT
1539 /* We need a unique id for each widget handled by the Lucid Widget
1540 library. This includes the frame main windows, popup menu and
1542 LWLIB_ID widget_id_tick
;
1545 static Lisp_Object
*volatile menu_item_selection
;
1547 static Lisp_Object
*menu_item_selection
;
1551 popup_selection_callback (widget
, id
, client_data
)
1554 XtPointer client_data
;
1556 menu_item_selection
= (Lisp_Object
*) client_data
;
1560 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1564 int menubarp
; /* This arg is unused in Xt version. */
1574 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1575 widget_value
**submenu_stack
1576 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1577 Lisp_Object
*subprefix_stack
1578 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1579 int submenu_depth
= 0;
1581 /* Define a queue to save up for later unreading
1582 all X events that don't pertain to the menu. */
1586 struct event_queue
*next
;
1589 struct event_queue
*queue
= NULL
;
1590 struct event_queue
*queue_tmp
;
1592 Position root_x
, root_y
;
1595 int next_release_must_exit
= 0;
1599 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1601 *error
= "Empty menu";
1605 /* Create a tree of widget_value objects
1606 representing the panes and their items. */
1607 wv
= malloc_widget_value ();
1614 /* Loop over all panes and items, filling in the tree. */
1616 while (i
< menu_items_used
)
1618 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1620 submenu_stack
[submenu_depth
++] = save_wv
;
1626 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1629 save_wv
= submenu_stack
[--submenu_depth
];
1633 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1634 && submenu_depth
!= 0)
1635 i
+= MENU_ITEMS_PANE_LENGTH
;
1636 /* Ignore a nil in the item list.
1637 It's meaningful only for dialog boxes. */
1638 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1640 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1642 /* Create a new pane. */
1643 Lisp_Object pane_name
, prefix
;
1645 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1646 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1647 pane_string
= (NILP (pane_name
)
1648 ? "" : (char *) XSTRING (pane_name
)->data
);
1649 /* If there is just one top-level pane, put all its items directly
1650 under the top-level menu. */
1651 if (menu_items_n_panes
== 1)
1654 /* If the pane has a meaningful name,
1655 make the pane a top-level menu item
1656 with its items as a submenu beneath it. */
1657 if (!keymaps
&& strcmp (pane_string
, ""))
1659 wv
= malloc_widget_value ();
1663 first_wv
->contents
= wv
;
1664 wv
->name
= pane_string
;
1665 if (keymaps
&& !NILP (prefix
))
1672 else if (first_pane
)
1678 i
+= MENU_ITEMS_PANE_LENGTH
;
1682 /* Create a new item within current pane. */
1683 Lisp_Object item_name
, enable
, descrip
, def
;
1684 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1685 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1687 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1688 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1690 wv
= malloc_widget_value ();
1694 save_wv
->contents
= wv
;
1695 wv
->name
= (char *) XSTRING (item_name
)->data
;
1696 if (!NILP (descrip
))
1697 wv
->key
= (char *) XSTRING (descrip
)->data
;
1699 /* If this item has a null value,
1700 make the call_data null so that it won't display a box
1701 when the mouse is on it. */
1703 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
1704 wv
->enabled
= !NILP (enable
);
1707 i
+= MENU_ITEMS_ITEM_LENGTH
;
1711 /* Deal with the title, if it is non-nil. */
1714 widget_value
*wv_title
= malloc_widget_value ();
1715 widget_value
*wv_sep1
= malloc_widget_value ();
1716 widget_value
*wv_sep2
= malloc_widget_value ();
1718 wv_sep2
->name
= "--";
1719 wv_sep2
->next
= first_wv
->contents
;
1721 wv_sep1
->name
= "--";
1722 wv_sep1
->next
= wv_sep2
;
1724 wv_title
->name
= (char *) XSTRING (title
)->data
;
1725 wv_title
->enabled
= True
;
1726 wv_title
->next
= wv_sep1
;
1727 first_wv
->contents
= wv_title
;
1730 /* Actually create the menu. */
1731 menu_id
= ++widget_id_tick
;
1732 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1733 f
->display
.x
->widget
, 1, 0,
1734 popup_selection_callback
,
1735 popup_deactivate_callback
);
1737 /* Don't allow any geometry request from the user. */
1738 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
1739 XtSetValues (menu
, av
, ac
);
1741 /* Free the widget_value objects we used to specify the contents. */
1742 free_menubar_widget_value_tree (first_wv
);
1744 /* No selection has been chosen yet. */
1745 menu_item_selection
= 0;
1747 /* Display the menu. */
1748 lw_popup_menu (menu
);
1749 popup_activated_flag
= 1;
1751 /* Process events that apply to the menu. */
1752 popup_get_selection ((XEvent
*) 0);
1755 /* fp turned off the following statement and wrote a comment
1756 that it is unnecessary--that the menu has already disappeared.
1757 I observer that is not so. -- rms. */
1758 /* Make sure the menu disappears. */
1759 lw_destroy_all_widgets (menu_id
);
1761 /* Unread any events that we got but did not handle. */
1762 while (queue
!= NULL
)
1765 XPutBackEvent (FRAME_X_DISPLAY (f
), &queue_tmp
->event
);
1766 queue
= queue_tmp
->next
;
1767 free ((char *)queue_tmp
);
1768 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1769 interrupt_input_pending
= 1;
1772 /* Find the selected item, and its pane, to return
1773 the proper value. */
1774 if (menu_item_selection
!= 0)
1780 while (i
< menu_items_used
)
1784 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1786 subprefix_stack
[submenu_depth
++] = prefix
;
1790 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1792 prefix
= subprefix_stack
[--submenu_depth
];
1795 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1798 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1799 i
+= MENU_ITEMS_PANE_LENGTH
;
1804 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1805 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1811 entry
= Fcons (entry
, Qnil
);
1813 entry
= Fcons (prefix
, entry
);
1814 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1815 if (!NILP (subprefix_stack
[j
]))
1816 entry
= Fcons (subprefix_stack
[j
], entry
);
1820 i
+= MENU_ITEMS_ITEM_LENGTH
;
1829 dialog_selection_callback (widget
, id
, client_data
)
1832 XtPointer client_data
;
1834 if ((int)client_data
!= -1)
1835 menu_item_selection
= (Lisp_Object
*) client_data
;
1837 lw_destroy_all_widgets (id
);
1841 static char * button_names
[] = {
1842 "button1", "button2", "button3", "button4", "button5",
1843 "button6", "button7", "button8", "button9", "button10" };
1846 xdialog_show (f
, menubarp
, keymaps
, title
, error
)
1853 int i
, nb_buttons
=0;
1856 char dialog_name
[6];
1858 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1860 /* Define a queue to save up for later unreading
1861 all X events that don't pertain to the menu. */
1865 struct event_queue
*next
;
1868 struct event_queue
*queue
= NULL
;
1869 struct event_queue
*queue_tmp
;
1871 /* Number of elements seen so far, before boundary. */
1873 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1874 int boundary_seen
= 0;
1878 if (menu_items_n_panes
> 1)
1880 *error
= "Multiple panes in dialog box";
1884 /* Create a tree of widget_value objects
1885 representing the text label and buttons. */
1887 Lisp_Object pane_name
, prefix
;
1889 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1890 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1891 pane_string
= (NILP (pane_name
)
1892 ? "" : (char *) XSTRING (pane_name
)->data
);
1893 prev_wv
= malloc_widget_value ();
1894 prev_wv
->value
= pane_string
;
1895 if (keymaps
&& !NILP (prefix
))
1897 prev_wv
->enabled
= 1;
1898 prev_wv
->name
= "message";
1901 /* Loop over all panes and items, filling in the tree. */
1902 i
= MENU_ITEMS_PANE_LENGTH
;
1903 while (i
< menu_items_used
)
1906 /* Create a new item within current pane. */
1907 Lisp_Object item_name
, enable
, descrip
;
1908 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1909 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1911 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1913 if (NILP (item_name
))
1915 free_menubar_widget_value_tree (first_wv
);
1916 *error
= "Submenu in dialog items";
1919 if (EQ (item_name
, Qquote
))
1921 /* This is the boundary between left-side elts
1922 and right-side elts. Stop incrementing right_count. */
1927 if (nb_buttons
>= 10)
1929 free_menubar_widget_value_tree (first_wv
);
1930 *error
= "Too many dialog items";
1934 wv
= malloc_widget_value ();
1936 wv
->name
= (char *) button_names
[nb_buttons
];
1937 if (!NILP (descrip
))
1938 wv
->key
= (char *) XSTRING (descrip
)->data
;
1939 wv
->value
= (char *) XSTRING (item_name
)->data
;
1940 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1941 wv
->enabled
= !NILP (enable
);
1944 if (! boundary_seen
)
1948 i
+= MENU_ITEMS_ITEM_LENGTH
;
1951 /* If the boundary was not specified,
1952 by default put half on the left and half on the right. */
1953 if (! boundary_seen
)
1954 left_count
= nb_buttons
- nb_buttons
/ 2;
1956 wv
= malloc_widget_value ();
1957 wv
->name
= dialog_name
;
1959 /* Dialog boxes use a really stupid name encoding
1960 which specifies how many buttons to use
1961 and how many buttons are on the right.
1962 The Q means something also. */
1963 dialog_name
[0] = 'Q';
1964 dialog_name
[1] = '0' + nb_buttons
;
1965 dialog_name
[2] = 'B';
1966 dialog_name
[3] = 'R';
1967 /* Number of buttons to put on the right. */
1968 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1970 wv
->contents
= first_wv
;
1974 /* Actually create the dialog. */
1975 dialog_id
= ++widget_id_tick
;
1976 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1977 f
->display
.x
->widget
, 1, 0,
1978 dialog_selection_callback
, 0);
1979 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1980 /* Free the widget_value objects we used to specify the contents. */
1981 free_menubar_widget_value_tree (first_wv
);
1983 /* No selection has been chosen yet. */
1984 menu_item_selection
= 0;
1986 /* Display the menu. */
1987 lw_pop_up_all_widgets (dialog_id
);
1989 /* Process events that apply to the menu. */
1994 XtAppNextEvent (Xt_app_con
, &event
);
1995 if (event
.type
== ButtonRelease
)
1997 XtDispatchEvent (&event
);
2000 else if (event
.type
== Expose
)
2001 process_expose_from_menu (event
);
2002 XtDispatchEvent (&event
);
2003 if (XtWindowToWidget (FRAME_X_DISPLAY (f
), event
.xany
.window
) != menu
)
2005 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
2007 if (queue_tmp
!= NULL
)
2009 queue_tmp
->event
= event
;
2010 queue_tmp
->next
= queue
;
2017 #ifdef HAVE_X_WINDOWS
2018 /* State that no mouse buttons are now held.
2019 That is not necessarily true, but the fiction leads to reasonable
2020 results, and it is a pain to ask which are actually held now
2021 or track this in the loop above. */
2022 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2025 /* Unread any events that we got but did not handle. */
2026 while (queue
!= NULL
)
2029 XPutBackEvent (FRAME_X_DISPLAY (f
), &queue_tmp
->event
);
2030 queue
= queue_tmp
->next
;
2031 free ((char *)queue_tmp
);
2032 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
2033 interrupt_input_pending
= 1;
2036 /* Find the selected item, and its pane, to return
2037 the proper value. */
2038 if (menu_item_selection
!= 0)
2044 while (i
< menu_items_used
)
2048 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2051 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2052 i
+= MENU_ITEMS_PANE_LENGTH
;
2057 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2058 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2062 entry
= Fcons (entry
, Qnil
);
2064 entry
= Fcons (prefix
, entry
);
2068 i
+= MENU_ITEMS_ITEM_LENGTH
;
2075 #else /* not USE_X_TOOLKIT */
2078 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
2088 int pane
, selidx
, lpane
, status
;
2089 Lisp_Object entry
, pane_prefix
;
2091 int ulx
, uly
, width
, height
;
2092 int dispwidth
, dispheight
;
2096 unsigned int dummy_uint
;
2099 if (menu_items_n_panes
== 0)
2102 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2104 *error
= "Empty menu";
2108 /* Figure out which root window F is on. */
2109 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2110 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2111 &dummy_uint
, &dummy_uint
);
2113 /* Make the menu on that window. */
2114 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2117 *error
= "Can't create menu";
2121 #ifdef HAVE_X_WINDOWS
2122 /* Adjust coordinates to relative to the outer (window manager) window. */
2125 int win_x
= 0, win_y
= 0;
2127 /* Find the position of the outside upper-left corner of
2128 the inner window, with respect to the outer window. */
2129 if (f
->display
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2132 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2134 /* From-window, to-window. */
2135 f
->display
.x
->window_desc
,
2136 f
->display
.x
->parent_desc
,
2138 /* From-position, to-position. */
2139 0, 0, &win_x
, &win_y
,
2141 /* Child of window. */
2148 #endif /* HAVE_X_WINDOWS */
2150 /* Adjust coordinates to be root-window-relative. */
2151 x
+= f
->display
.x
->left_pos
;
2152 y
+= f
->display
.x
->top_pos
;
2154 /* Create all the necessary panes and their items. */
2156 while (i
< menu_items_used
)
2158 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2160 /* Create a new pane. */
2161 Lisp_Object pane_name
, prefix
;
2164 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2165 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2166 pane_string
= (NILP (pane_name
)
2167 ? "" : (char *) XSTRING (pane_name
)->data
);
2168 if (keymaps
&& !NILP (prefix
))
2171 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2172 if (lpane
== XM_FAILURE
)
2174 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2175 *error
= "Can't create pane";
2178 i
+= MENU_ITEMS_PANE_LENGTH
;
2180 /* Find the width of the widest item in this pane. */
2183 while (j
< menu_items_used
)
2186 item
= XVECTOR (menu_items
)->contents
[j
];
2194 width
= XSTRING (item
)->size
;
2195 if (width
> maxwidth
)
2198 j
+= MENU_ITEMS_ITEM_LENGTH
;
2201 /* Ignore a nil in the item list.
2202 It's meaningful only for dialog boxes. */
2203 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2207 /* Create a new item within current pane. */
2208 Lisp_Object item_name
, enable
, descrip
;
2209 unsigned char *item_data
;
2211 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2212 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2214 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2215 if (!NILP (descrip
))
2217 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2220 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2221 item_name
= concat2 (item_name
, spacer
);
2222 item_name
= concat2 (item_name
, descrip
);
2223 item_data
= XSTRING (item_name
)->data
;
2225 /* if alloca is fast, use that to make the space,
2226 to reduce gc needs. */
2228 = (unsigned char *) alloca (maxwidth
2229 + XSTRING (descrip
)->size
+ 1);
2230 bcopy (XSTRING (item_name
)->data
, item_data
,
2231 XSTRING (item_name
)->size
);
2232 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2234 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2235 XSTRING (descrip
)->size
);
2236 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2240 item_data
= XSTRING (item_name
)->data
;
2242 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2243 menu
, lpane
, 0, item_data
,
2247 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2248 *error
= "Can't add selection to menu";
2251 i
+= MENU_ITEMS_ITEM_LENGTH
;
2255 /* All set and ready to fly. */
2256 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2257 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
),
2258 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)));
2259 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
),
2260 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)));
2261 x
= min (x
, dispwidth
);
2262 y
= min (y
, dispheight
);
2265 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2266 &ulx
, &uly
, &width
, &height
);
2267 if (ulx
+width
> dispwidth
)
2269 x
-= (ulx
+ width
) - dispwidth
;
2270 ulx
= dispwidth
- width
;
2272 if (uly
+height
> dispheight
)
2274 y
-= (uly
+ height
) - dispheight
;
2275 uly
= dispheight
- height
;
2277 if (ulx
< 0) x
-= ulx
;
2278 if (uly
< 0) y
-= uly
;
2280 XMenuSetAEQ (menu
, TRUE
);
2281 XMenuSetFreeze (menu
, TRUE
);
2284 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2285 x
, y
, ButtonReleaseMask
, &datap
);
2288 /* Assume the mouse has moved out of the X window.
2289 If it has actually moved in, we will get an EnterNotify. */
2296 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2299 /* Find the item number SELIDX in pane number PANE. */
2301 while (i
< menu_items_used
)
2303 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2307 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2309 i
+= MENU_ITEMS_PANE_LENGTH
;
2318 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2321 entry
= Fcons (entry
, Qnil
);
2322 if (!NILP (pane_prefix
))
2323 entry
= Fcons (pane_prefix
, entry
);
2329 i
+= MENU_ITEMS_ITEM_LENGTH
;
2335 *error
= "Can't activate menu";
2341 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2343 #ifdef HAVE_X_WINDOWS
2344 /* State that no mouse buttons are now held.
2345 (The oldXMenu code doesn't track this info for us.)
2346 That is not necessarily true, but the fiction leads to reasonable
2347 results, and it is a pain to ask which are actually held now. */
2348 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2354 #endif /* not USE_X_TOOLKIT */
2358 staticpro (&menu_items
);
2361 #ifdef USE_X_TOOLKIT
2362 widget_id_tick
= (1<<16);
2365 defsubr (&Sx_popup_menu
);
2366 defsubr (&Sx_popup_dialog
);