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
);
358 if (!NILP (savedkey
))
360 descrip
= Fkey_description (savedkey
);
361 descrip
= concat2 (make_string (" (", 3), descrip
);
362 descrip
= concat2 (descrip
, make_string (")", 1));
366 /* Cache the data we just got in a sublist of the menu binding. */
367 if (NILP (cachelist
))
369 CHECK_IMPURE (item1
);
370 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
374 XCONS (cachelist
)->car
= savedkey
;
375 XCONS (cachelist
)->cdr
= descrip
;
379 *descrip_ptr
= descrip
;
383 /* This is used as the handler when calling internal_condition_case_1. */
386 menu_item_enabled_p_1 (arg
)
392 /* Return non-nil if the command DEF is enabled when used as a menu item.
393 This is based on looking for a menu-enable property.
394 If NOTREAL is set, don't bother really computing this. */
397 menu_item_enabled_p (def
, notreal
)
401 Lisp_Object enabled
, tem
;
408 /* No property, or nil, means enable.
409 Otherwise, enable if value is not nil. */
410 tem
= Fget (def
, Qmenu_enable
);
412 /* (condition-case nil (eval tem)
414 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
415 menu_item_enabled_p_1
);
420 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
421 and generate menu panes for them in menu_items.
422 If NOTREAL is nonzero,
423 don't bother really computing whether an item is enabled. */
426 keymap_panes (keymaps
, nmaps
, notreal
)
427 Lisp_Object
*keymaps
;
435 /* Loop over the given keymaps, making a pane for each map.
436 But don't make a pane that is empty--ignore that map instead.
437 P is the number of panes we have made so far. */
438 for (mapno
= 0; mapno
< nmaps
; mapno
++)
439 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
441 finish_menu_items ();
444 /* This is a recursive subroutine of keymap_panes.
445 It handles one keymap, KEYMAP.
446 The other arguments are passed along
447 or point to local variables of the previous function.
448 If NOTREAL is nonzero,
449 don't bother really computing whether an item is enabled. */
452 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
454 Lisp_Object pane_name
;
458 Lisp_Object pending_maps
;
459 Lisp_Object tail
, item
, item1
, item_string
, table
;
460 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
464 push_menu_pane (pane_name
, prefix
);
466 for (tail
= keymap
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
468 /* Look at each key binding, and if it has a menu string,
469 make a menu item from it. */
470 item
= XCONS (tail
)->car
;
473 item1
= XCONS (item
)->cdr
;
476 item_string
= XCONS (item1
)->car
;
477 if (STRINGP (item_string
))
479 /* This is the real definition--the function to run. */
481 /* These are the saved equivalent keyboard key sequence
482 and its key-description. */
484 Lisp_Object tem
, enabled
;
486 /* GCPRO because ...enabled_p will call eval
487 and ..._equiv_key may autoload something.
488 Protecting KEYMAP preserves everything we use;
489 aside from that, must protect whatever might be
490 a string. Since there's no GCPRO5, we refetch
491 item_string instead of protecting it. */
492 descrip
= def
= Qnil
;
493 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
495 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
496 enabled
= menu_item_enabled_p (def
, notreal
);
500 item_string
= XCONS (item1
)->car
;
502 tem
= Fkeymapp (def
);
503 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
504 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
509 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
510 submap
= get_keymap_1 (def
, 0, 1);
512 #ifndef USE_X_TOOLKIT
513 /* Indicate visually that this is a submenu. */
515 item_string
= concat2 (item_string
,
516 build_string (" >"));
518 /* If definition is nil, pass nil as the key. */
519 push_menu_item (item_string
, enabled
,
520 XCONS (item
)->car
, def
,
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 XSETFASTINT (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 /* If definition is nil, pass nil as the key. */
590 push_menu_item (item_string
, enabled
, character
,
595 push_submenu_start ();
596 single_keymap_panes (submap
, Qnil
,
608 /* Process now any submenus which want to be panes at this level. */
609 while (!NILP (pending_maps
))
611 Lisp_Object elt
, eltcdr
, string
;
612 elt
= Fcar (pending_maps
);
613 eltcdr
= XCONS (elt
)->cdr
;
614 string
= XCONS (eltcdr
)->car
;
615 /* We no longer discard the @ from the beginning of the string here.
616 Instead, we do this in xmenu_show. */
617 single_keymap_panes (Fcar (elt
), string
,
618 XCONS (eltcdr
)->cdr
, notreal
);
619 pending_maps
= Fcdr (pending_maps
);
623 /* Push all the panes and items of a menu decsribed by the
624 alist-of-alists MENU.
625 This handles old-fashioned calls to x-popup-menu. */
635 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
637 Lisp_Object elt
, pane_name
, pane_data
;
639 pane_name
= Fcar (elt
);
640 CHECK_STRING (pane_name
, 0);
641 push_menu_pane (pane_name
, Qnil
);
642 pane_data
= Fcdr (elt
);
643 CHECK_CONS (pane_data
, 0);
644 list_of_items (pane_data
);
647 finish_menu_items ();
650 /* Push the items in a single pane defined by the alist PANE. */
656 Lisp_Object tail
, item
, item1
;
658 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
662 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
);
663 else if (NILP (item
))
664 push_left_right_boundary ();
667 CHECK_CONS (item
, 0);
669 CHECK_STRING (item1
, 1);
670 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
);
675 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
676 "Pop up a deck-of-cards menu and return user's selection.\n\
677 POSITION is a position specification. This is either a mouse button event\n\
678 or a list ((XOFFSET YOFFSET) WINDOW)\n\
679 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
680 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
681 This controls the position of the center of the first line\n\
682 in the first pane of the menu, not the top left of the menu as a whole.\n\
683 If POSITION is t, it means to use the current mouse position.\n\
685 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
686 The menu items come from key bindings that have a menu string as well as\n\
687 a definition; actually, the \"definition\" in such a key binding looks like\n\
688 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
689 the keymap as a top-level element.\n\n\
690 You can also use a list of keymaps as MENU.\n\
691 Then each keymap makes a separate pane.\n\
692 When MENU is a keymap or a list of keymaps, the return value\n\
693 is a list of events.\n\n\
694 Alternatively, you can specify a menu of multiple panes\n\
695 with a list of the form (TITLE PANE1 PANE2...),\n\
696 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
697 Each ITEM is normally a cons cell (STRING . VALUE);\n\
698 but a string can appear as an item--that makes a nonselectable line\n\
700 With this form of menu, the return value is VALUE from the chosen item.\n\
702 If POSITION is nil, don't display the menu at all, just precalculate the\n\
703 cached information about equivalent key sequences.")
705 Lisp_Object position
, menu
;
707 int number_of_panes
, panes
;
708 Lisp_Object keymap
, tem
;
712 Lisp_Object selection
;
715 Lisp_Object x
, y
, window
;
721 if (! NILP (position
))
725 /* Decode the first argument: find the window and the coordinates. */
726 if (EQ (position
, Qt
))
728 /* Use the mouse's current position. */
730 Lisp_Object bar_window
;
734 if (mouse_position_hook
)
735 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
737 XSETFRAME (window
, new_f
);
740 window
= selected_window
;
747 tem
= Fcar (position
);
750 window
= Fcar (Fcdr (position
));
752 y
= Fcar (Fcdr (tem
));
757 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
758 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
759 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
763 /* Determine whether this menu is handling a menu bar click. */
764 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
765 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
773 /* Decode where to put the menu. */
781 else if (WINDOWP (window
))
783 CHECK_LIVE_WINDOW (window
, 0);
784 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
786 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
787 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
790 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
791 but I don't want to make one now. */
792 CHECK_WINDOW (window
, 0);
801 /* Decode the menu items from what was specified. */
803 keymap
= Fkeymapp (menu
);
806 tem
= Fkeymapp (Fcar (menu
));
809 /* We were given a keymap. Extract menu info from the keymap. */
811 keymap
= get_keymap (menu
);
813 /* Extract the detailed info to make one pane. */
814 keymap_panes (&menu
, 1, NILP (position
));
816 /* Search for a string appearing directly as an element of the keymap.
817 That string is the title of the menu. */
818 prompt
= map_prompt (keymap
);
820 /* Make that be the pane title of the first pane. */
821 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
822 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
826 else if (!NILP (tem
))
828 /* We were given a list of keymaps. */
829 int nmaps
= XFASTINT (Flength (menu
));
831 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
836 /* The first keymap that has a prompt string
837 supplies the menu title. */
838 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
842 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
844 prompt
= map_prompt (keymap
);
845 if (NILP (title
) && !NILP (prompt
))
849 /* Extract the detailed info to make one pane. */
850 keymap_panes (maps
, nmaps
, NILP (position
));
852 /* Make the title be the pane title of the first pane. */
853 if (!NILP (title
) && menu_items_n_panes
>= 0)
854 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
860 /* We were given an old-fashioned menu. */
862 CHECK_STRING (title
, 1);
864 list_of_panes (Fcdr (menu
));
871 discard_menu_items ();
876 /* Display them in a menu. */
879 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
, for_click
,
880 keymaps
, title
, &error_name
);
883 discard_menu_items ();
887 if (error_name
) error (error_name
);
891 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
892 "Pop up a dialog box and return user's selection.\n\
893 POSITION specifies which frame to use.\n\
894 This is normally a mouse button event or a window or frame.\n\
895 If POSITION is t, it means to use the frame the mouse is on.\n\
896 The dialog box appears in the middle of the specified frame.\n\
898 CONTENTS specifies the alternatives to display in the dialog box.\n\
899 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
900 Each ITEM is a cons cell (STRING . VALUE).\n\
901 The return value is VALUE from the chosen item.\n\n\
902 An ITEM may also be just a string--that makes a nonselectable item.\n\
903 An ITEM may also be nil--that means to put all preceding items\n\
904 on the left of the dialog box and all following items on the right.\n\
905 \(By default, approximately half appear on each side.)")
907 Lisp_Object position
, contents
;
914 /* Decode the first argument: find the window or frame to use. */
915 if (EQ (position
, Qt
))
917 #if 0 /* Using the frame the mouse is on may not be right. */
918 /* Use the mouse's current position. */
920 Lisp_Object bar_window
;
925 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
928 XSETFRAME (window
, new_f
);
930 window
= selected_window
;
932 /* Decode the first argument: find the window and the coordinates. */
933 if (EQ (position
, Qt
))
934 window
= selected_window
;
936 else if (CONSP (position
))
939 tem
= Fcar (position
);
941 window
= Fcar (Fcdr (position
));
944 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
945 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
948 else if (WINDOWP (position
) || FRAMEP (position
))
951 /* Decode where to put the menu. */
955 else if (WINDOWP (window
))
957 CHECK_LIVE_WINDOW (window
, 0);
958 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
961 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
962 but I don't want to make one now. */
963 CHECK_WINDOW (window
, 0);
965 #ifndef USE_X_TOOLKIT
966 /* Display a menu with these alternatives
967 in the middle of frame F. */
969 Lisp_Object x
, y
, frame
, newpos
;
970 XSETFRAME (frame
, f
);
971 XSETINT (x
, x_pixel_width (f
) / 2);
972 XSETINT (y
, x_pixel_height (f
) / 2);
973 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
975 return Fx_popup_menu (newpos
,
976 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
982 Lisp_Object selection
;
984 /* Decode the dialog items from what was specified. */
985 title
= Fcar (contents
);
986 CHECK_STRING (title
, 1);
988 list_of_panes (Fcons (contents
, Qnil
));
990 /* Display them in a dialog box. */
992 selection
= xdialog_show (f
, 0, 0, title
, &error_name
);
995 discard_menu_items ();
997 if (error_name
) error (error_name
);
1003 #ifdef USE_X_TOOLKIT
1005 /* Loop in Xt until the menu pulldown or dialog popup has been
1006 popped down (deactivated).
1008 NOTE: All calls to popup_get_selection() should be protected
1009 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1011 popup_get_selection (initial_event
)
1012 XEvent
*initial_event
;
1017 event
= *initial_event
;
1019 XtAppNextEvent (Xt_app_con
, &event
);
1023 XtDispatchEvent (&event
);
1024 if (!popup_activated())
1026 XtAppNextEvent (Xt_app_con
, &event
);
1030 /* Detect if a dialog or menu has been posted. */
1034 return popup_activated_flag
;
1038 /* This callback is invoked when the user selects a menubar cascade
1039 pushbutton, but before the pulldown menu is posted. */
1042 popup_activate_callback (widget
, id
, client_data
)
1045 XtPointer client_data
;
1047 popup_activated_flag
= 1;
1050 /* This callback is called from the menu bar pulldown menu
1051 when the user makes a selection.
1052 Figure out what the user chose
1053 and put the appropriate events into the keyboard buffer. */
1056 menubar_selection_callback (widget
, id
, client_data
)
1059 XtPointer client_data
;
1062 FRAME_PTR f
= (FRAME_PTR
) id
;
1064 Lisp_Object
*subprefix_stack
;
1065 int submenu_depth
= 0;
1070 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1071 vector
= f
->menu_bar_vector
;
1074 while (i
< f
->menu_bar_items_used
)
1078 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1080 subprefix_stack
[submenu_depth
++] = prefix
;
1084 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1086 prefix
= subprefix_stack
[--submenu_depth
];
1089 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1091 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1092 i
+= MENU_ITEMS_PANE_LENGTH
;
1096 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1097 if ((int) client_data
== i
)
1100 struct input_event buf
;
1103 XSETFRAME (frame
, f
);
1104 buf
.kind
= menu_bar_event
;
1105 buf
.frame_or_window
= Fcons (frame
, Qmenu_bar
);
1106 kbd_buffer_store_event (&buf
);
1108 for (j
= 0; j
< submenu_depth
; j
++)
1109 if (!NILP (subprefix_stack
[j
]))
1111 buf
.kind
= menu_bar_event
;
1112 buf
.frame_or_window
= Fcons (frame
, subprefix_stack
[j
]);
1113 kbd_buffer_store_event (&buf
);
1118 buf
.kind
= menu_bar_event
;
1119 buf
.frame_or_window
= Fcons (frame
, prefix
);
1120 kbd_buffer_store_event (&buf
);
1123 buf
.kind
= menu_bar_event
;
1124 buf
.frame_or_window
= Fcons (frame
, entry
);
1125 kbd_buffer_store_event (&buf
);
1129 i
+= MENU_ITEMS_ITEM_LENGTH
;
1134 /* This callback is invoked when a dialog or menu is finished being
1135 used and has been unposted. */
1138 popup_deactivate_callback (widget
, id
, client_data
)
1141 XtPointer client_data
;
1143 popup_activated_flag
= 0;
1147 /* This recursively calls free_widget_value on the tree of widgets.
1148 It must free all data that was malloc'ed for these widget_values.
1149 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1150 must be left alone. */
1153 free_menubar_widget_value_tree (wv
)
1158 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1160 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1162 free_menubar_widget_value_tree (wv
->contents
);
1163 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1167 free_menubar_widget_value_tree (wv
->next
);
1168 wv
->next
= (widget_value
*) 0xDEADBEEF;
1171 free_widget_value (wv
);
1175 /* Return a tree of widget_value structures for a menu bar item
1176 whose event type is ITEM_KEY (with string ITEM_NAME)
1177 and whose contents come from the list of keymaps MAPS. */
1179 static widget_value
*
1180 single_submenu (item_key
, item_name
, maps
)
1181 Lisp_Object item_key
, item_name
, maps
;
1183 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1185 int submenu_depth
= 0;
1188 Lisp_Object
*mapvec
;
1189 widget_value
**submenu_stack
;
1191 int previous_items
= menu_items_used
;
1193 length
= Flength (maps
);
1194 len
= XINT (length
);
1196 /* Convert the list MAPS into a vector MAPVEC. */
1197 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1198 for (i
= 0; i
< len
; i
++)
1200 mapvec
[i
] = Fcar (maps
);
1204 menu_items_n_panes
= 0;
1206 /* Loop over the given keymaps, making a pane for each map.
1207 But don't make a pane that is empty--ignore that map instead. */
1208 for (i
= 0; i
< len
; i
++)
1209 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0);
1211 /* Create a tree of widget_value objects
1212 representing the panes and their items. */
1215 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1216 wv
= malloc_widget_value ();
1223 /* Loop over all panes and items made during this call
1224 and construct a tree of widget_value objects.
1225 Ignore the panes and items made by previous calls to
1226 single_submenu, even though those are also in menu_items. */
1228 while (i
< menu_items_used
)
1230 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1232 submenu_stack
[submenu_depth
++] = save_wv
;
1237 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1240 save_wv
= submenu_stack
[--submenu_depth
];
1243 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1244 && submenu_depth
!= 0)
1245 i
+= MENU_ITEMS_PANE_LENGTH
;
1246 /* Ignore a nil in the item list.
1247 It's meaningful only for dialog boxes. */
1248 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1250 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1252 /* Create a new pane. */
1253 Lisp_Object pane_name
, prefix
;
1255 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1256 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1257 pane_string
= (NILP (pane_name
)
1258 ? "" : (char *) XSTRING (pane_name
)->data
);
1259 /* If there is just one top-level pane, put all its items directly
1260 under the top-level menu. */
1261 if (menu_items_n_panes
== 1)
1264 /* If the pane has a meaningful name,
1265 make the pane a top-level menu item
1266 with its items as a submenu beneath it. */
1267 if (strcmp (pane_string
, ""))
1269 wv
= malloc_widget_value ();
1273 first_wv
->contents
= wv
;
1274 wv
->name
= pane_string
;
1282 i
+= MENU_ITEMS_PANE_LENGTH
;
1286 /* Create a new item within current pane. */
1287 Lisp_Object item_name
, enable
, descrip
, def
;
1288 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1289 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1291 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1292 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1294 wv
= malloc_widget_value ();
1298 save_wv
->contents
= wv
;
1299 wv
->name
= (char *) XSTRING (item_name
)->data
;
1300 if (!NILP (descrip
))
1301 wv
->key
= (char *) XSTRING (descrip
)->data
;
1303 wv
->call_data
= (!NILP (def
) ? (void *) i
: 0);
1304 wv
->enabled
= !NILP (enable
);
1307 i
+= MENU_ITEMS_ITEM_LENGTH
;
1314 extern void EmacsFrameSetCharSize ();
1316 /* Recompute the menu bar of frame F. */
1319 update_frame_menubar (f
)
1322 struct x_display
*x
= f
->display
.x
;
1324 int menubar_changed
;
1326 Dimension shell_height
;
1328 /* We assume the menubar contents has changed if the global flag is set,
1329 or if the current buffer has changed, or if the menubar has never
1330 been updated before.
1332 menubar_changed
= (x
->menubar_widget
1333 && !XtIsManaged (x
->menubar_widget
));
1335 if (! (menubar_changed
))
1339 /* Save the size of the frame because the pane widget doesn't accept to
1340 resize itself. So force it. */
1344 /* Do the voodoo which means "I'm changing lots of things, don't try to
1345 refigure sizes until I'm done." */
1346 lw_refigure_widget (x
->column_widget
, False
);
1348 /* the order in which children are managed is the top to
1349 bottom order in which they are displayed in the paned window.
1350 First, remove the text-area widget.
1352 XtUnmanageChild (x
->edit_widget
);
1354 /* remove the menubar that is there now, and put up the menubar that
1357 if (menubar_changed
)
1359 XtManageChild (x
->menubar_widget
);
1360 XtMapWidget (x
->menubar_widget
);
1361 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1364 /* Re-manage the text-area widget, and then thrash the sizes. */
1365 XtManageChild (x
->edit_widget
);
1366 lw_refigure_widget (x
->column_widget
, True
);
1368 /* Force the pane widget to resize itself with the right values. */
1369 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1375 set_frame_menubar (f
, first_time
)
1379 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1381 Lisp_Object tail
, items
;
1382 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1387 wv
= malloc_widget_value ();
1388 wv
->name
= "menubar";
1392 items
= FRAME_MENU_BAR_ITEMS (f
);
1393 menu_items
= f
->menu_bar_vector
;
1394 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1397 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1399 Lisp_Object key
, string
, maps
;
1401 key
= XVECTOR (items
)->contents
[i
];
1402 string
= XVECTOR (items
)->contents
[i
+ 1];
1403 maps
= XVECTOR (items
)->contents
[i
+ 2];
1407 wv
= single_submenu (key
, string
, maps
);
1411 first_wv
->contents
= wv
;
1412 /* Don't set wv->name here; GC during the loop might relocate it. */
1417 /* Now GC cannot happen during the lifetime of the widget_value,
1418 so it's safe to store data from a Lisp_String. */
1419 wv
= first_wv
->contents
;
1420 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1423 string
= XVECTOR (items
)->contents
[i
+ 1];
1426 wv
->name
= (char *) XSTRING (string
)->data
;
1430 finish_menu_items ();
1432 f
->menu_bar_vector
= menu_items
;
1433 f
->menu_bar_items_used
= menu_items_used
;
1438 /* Disable resizing (done for Motif!) */
1439 lw_allow_resizing (f
->display
.x
->widget
, False
);
1441 /* The third arg is DEEP_P, which says to consider the entire
1442 menu trees we supply, rather than just the menu bar item names. */
1443 lw_modify_all_widgets (id
, first_wv
, 1);
1445 /* Re-enable the edit widget to resize. */
1446 lw_allow_resizing (f
->display
.x
->widget
, True
);
1450 menubar_widget
= lw_create_widget ("menubar", "menubar",
1452 f
->display
.x
->column_widget
,
1454 popup_activate_callback
,
1455 menubar_selection_callback
,
1456 popup_deactivate_callback
);
1457 f
->display
.x
->menubar_widget
= menubar_widget
;
1460 free_menubar_widget_value_tree (first_wv
);
1462 /* Don't update the menubar the first time it is created via x_window. */
1464 update_frame_menubar (f
);
1469 /* Called from Fx_create_frame to create the inital menubar of a frame
1470 before it is mapped, so that the window is mapped with the menubar already
1471 there instead of us tacking it on later and thrashing the window after it
1475 initialize_frame_menubar (f
)
1478 /* This function is called before the first chance to redisplay
1479 the frame. It has to be, so the frame will have the right size. */
1480 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1481 set_frame_menubar (f
, 1);
1484 /* Get rid of the menu bar of frame F, and free its storage.
1485 This is used when deleting a frame, and when turning off the menu bar. */
1488 free_frame_menubar (f
)
1491 Widget menubar_widget
;
1494 menubar_widget
= f
->display
.x
->menubar_widget
;
1500 lw_destroy_all_widgets (id
);
1505 #endif /* USE_X_TOOLKIT */
1507 /* xmenu_show actually displays a menu using the panes and items in menu_items
1508 and returns the value selected from it.
1509 There are two versions of xmenu_show, one for Xt and one for Xlib.
1510 Both assume input is blocked by the caller. */
1512 /* F is the frame the menu is for.
1513 X and Y are the frame-relative specified position,
1514 relative to the inside upper left corner of the frame F.
1515 MENUBARP is 1 if this menu came from the menu bar.
1516 FOR_CLICK if this menu was invoked for a mouse click.
1517 KEYMAPS is 1 if this menu was specified with keymaps;
1518 in that case, we return a list containing the chosen item's value
1519 and perhaps also the pane's prefix.
1520 TITLE is the specified menu title.
1521 ERROR is a place to store an error message string in case of failure.
1522 (We return nil on failure, but the value doesn't actually matter.) */
1524 #ifdef USE_X_TOOLKIT
1526 /* We need a unique id for each widget handled by the Lucid Widget
1527 library. This includes the frame main windows, popup menu and
1529 LWLIB_ID widget_id_tick
;
1532 static Lisp_Object
*volatile menu_item_selection
;
1534 static Lisp_Object
*menu_item_selection
;
1538 popup_selection_callback (widget
, id
, client_data
)
1541 XtPointer client_data
;
1543 menu_item_selection
= (Lisp_Object
*) client_data
;
1547 xmenu_show (f
, x
, y
, menubarp
, for_click
, keymaps
, title
, error
)
1551 int menubarp
; /* This arg is unused in Xt version. */
1562 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1563 widget_value
**submenu_stack
1564 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1565 Lisp_Object
*subprefix_stack
1566 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1567 int submenu_depth
= 0;
1569 /* Define a queue to save up for later unreading
1570 all X events that don't pertain to the menu. */
1574 struct event_queue
*next
;
1577 struct event_queue
*queue
= NULL
;
1578 struct event_queue
*queue_tmp
;
1580 Position root_x
, root_y
;
1583 int next_release_must_exit
= 0;
1587 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1589 *error
= "Empty menu";
1593 /* Create a tree of widget_value objects
1594 representing the panes and their items. */
1595 wv
= malloc_widget_value ();
1602 /* Loop over all panes and items, filling in the tree. */
1604 while (i
< menu_items_used
)
1606 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1608 submenu_stack
[submenu_depth
++] = save_wv
;
1614 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1617 save_wv
= submenu_stack
[--submenu_depth
];
1621 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1622 && submenu_depth
!= 0)
1623 i
+= MENU_ITEMS_PANE_LENGTH
;
1624 /* Ignore a nil in the item list.
1625 It's meaningful only for dialog boxes. */
1626 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1628 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1630 /* Create a new pane. */
1631 Lisp_Object pane_name
, prefix
;
1633 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1634 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1635 pane_string
= (NILP (pane_name
)
1636 ? "" : (char *) XSTRING (pane_name
)->data
);
1637 /* If there is just one top-level pane, put all its items directly
1638 under the top-level menu. */
1639 if (menu_items_n_panes
== 1)
1642 /* If the pane has a meaningful name,
1643 make the pane a top-level menu item
1644 with its items as a submenu beneath it. */
1645 if (!keymaps
&& strcmp (pane_string
, ""))
1647 wv
= malloc_widget_value ();
1651 first_wv
->contents
= wv
;
1652 wv
->name
= pane_string
;
1653 if (keymaps
&& !NILP (prefix
))
1660 else if (first_pane
)
1666 i
+= MENU_ITEMS_PANE_LENGTH
;
1670 /* Create a new item within current pane. */
1671 Lisp_Object item_name
, enable
, descrip
, def
;
1672 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1673 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1675 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1676 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1678 wv
= malloc_widget_value ();
1682 save_wv
->contents
= wv
;
1683 wv
->name
= (char *) XSTRING (item_name
)->data
;
1684 if (!NILP (descrip
))
1685 wv
->key
= (char *) XSTRING (descrip
)->data
;
1687 /* If this item has a null value,
1688 make the call_data null so that it won't display a box
1689 when the mouse is on it. */
1691 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
1692 wv
->enabled
= !NILP (enable
);
1695 i
+= MENU_ITEMS_ITEM_LENGTH
;
1699 /* Deal with the title, if it is non-nil. */
1702 widget_value
*wv_title
= malloc_widget_value ();
1703 widget_value
*wv_sep1
= malloc_widget_value ();
1704 widget_value
*wv_sep2
= malloc_widget_value ();
1706 wv_sep2
->name
= "--";
1707 wv_sep2
->next
= first_wv
->contents
;
1709 wv_sep1
->name
= "--";
1710 wv_sep1
->next
= wv_sep2
;
1712 wv_title
->name
= (char *) XSTRING (title
)->data
;
1713 wv_title
->enabled
= True
;
1714 wv_title
->next
= wv_sep1
;
1715 first_wv
->contents
= wv_title
;
1718 /* Actually create the menu. */
1719 menu_id
= ++widget_id_tick
;
1720 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1721 f
->display
.x
->widget
, 1, 0,
1722 popup_selection_callback
,
1723 popup_deactivate_callback
);
1725 /* Don't allow any geometry request from the user. */
1726 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
1727 XtSetValues (menu
, av
, ac
);
1729 /* Free the widget_value objects we used to specify the contents. */
1730 free_menubar_widget_value_tree (first_wv
);
1732 /* No selection has been chosen yet. */
1733 menu_item_selection
= 0;
1735 /* Display the menu. */
1736 lw_popup_menu (menu
);
1737 popup_activated_flag
= 1;
1739 /* Process events that apply to the menu. */
1740 popup_get_selection ((XEvent
*) 0);
1743 /* fp turned off the following statement and wrote a comment
1744 that it is unnecessary--that the menu has already disappeared.
1745 I observer that is not so. -- rms. */
1746 /* Make sure the menu disappears. */
1747 lw_destroy_all_widgets (menu_id
);
1749 /* Unread any events that we got but did not handle. */
1750 while (queue
!= NULL
)
1753 XPutBackEvent (FRAME_X_DISPLAY (f
), &queue_tmp
->event
);
1754 queue
= queue_tmp
->next
;
1755 free ((char *)queue_tmp
);
1756 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1757 interrupt_input_pending
= 1;
1760 /* Find the selected item, and its pane, to return
1761 the proper value. */
1762 if (menu_item_selection
!= 0)
1768 while (i
< menu_items_used
)
1772 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1774 subprefix_stack
[submenu_depth
++] = prefix
;
1778 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1780 prefix
= subprefix_stack
[--submenu_depth
];
1783 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1786 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1787 i
+= MENU_ITEMS_PANE_LENGTH
;
1792 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1793 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1799 entry
= Fcons (entry
, Qnil
);
1801 entry
= Fcons (prefix
, entry
);
1802 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1803 if (!NILP (subprefix_stack
[j
]))
1804 entry
= Fcons (subprefix_stack
[j
], entry
);
1808 i
+= MENU_ITEMS_ITEM_LENGTH
;
1817 dialog_selection_callback (widget
, id
, client_data
)
1820 XtPointer client_data
;
1822 if ((int)client_data
!= -1)
1823 menu_item_selection
= (Lisp_Object
*) client_data
;
1825 lw_destroy_all_widgets (id
);
1829 static char * button_names
[] = {
1830 "button1", "button2", "button3", "button4", "button5",
1831 "button6", "button7", "button8", "button9", "button10" };
1834 xdialog_show (f
, menubarp
, keymaps
, title
, error
)
1841 int i
, nb_buttons
=0;
1844 char dialog_name
[6];
1846 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1848 /* Define a queue to save up for later unreading
1849 all X events that don't pertain to the menu. */
1853 struct event_queue
*next
;
1856 struct event_queue
*queue
= NULL
;
1857 struct event_queue
*queue_tmp
;
1859 /* Number of elements seen so far, before boundary. */
1861 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1862 int boundary_seen
= 0;
1866 if (menu_items_n_panes
> 1)
1868 *error
= "Multiple panes in dialog box";
1872 /* Create a tree of widget_value objects
1873 representing the text label and buttons. */
1875 Lisp_Object pane_name
, prefix
;
1877 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1878 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1879 pane_string
= (NILP (pane_name
)
1880 ? "" : (char *) XSTRING (pane_name
)->data
);
1881 prev_wv
= malloc_widget_value ();
1882 prev_wv
->value
= pane_string
;
1883 if (keymaps
&& !NILP (prefix
))
1885 prev_wv
->enabled
= 1;
1886 prev_wv
->name
= "message";
1889 /* Loop over all panes and items, filling in the tree. */
1890 i
= MENU_ITEMS_PANE_LENGTH
;
1891 while (i
< menu_items_used
)
1894 /* Create a new item within current pane. */
1895 Lisp_Object item_name
, enable
, descrip
;
1896 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1897 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1899 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1901 if (NILP (item_name
))
1903 free_menubar_widget_value_tree (first_wv
);
1904 *error
= "Submenu in dialog items";
1907 if (EQ (item_name
, Qquote
))
1909 /* This is the boundary between left-side elts
1910 and right-side elts. Stop incrementing right_count. */
1915 if (nb_buttons
>= 10)
1917 free_menubar_widget_value_tree (first_wv
);
1918 *error
= "Too many dialog items";
1922 wv
= malloc_widget_value ();
1924 wv
->name
= (char *) button_names
[nb_buttons
];
1925 if (!NILP (descrip
))
1926 wv
->key
= (char *) XSTRING (descrip
)->data
;
1927 wv
->value
= (char *) XSTRING (item_name
)->data
;
1928 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1929 wv
->enabled
= !NILP (enable
);
1932 if (! boundary_seen
)
1936 i
+= MENU_ITEMS_ITEM_LENGTH
;
1939 /* If the boundary was not specified,
1940 by default put half on the left and half on the right. */
1941 if (! boundary_seen
)
1942 left_count
= nb_buttons
- nb_buttons
/ 2;
1944 wv
= malloc_widget_value ();
1945 wv
->name
= dialog_name
;
1947 /* Dialog boxes use a really stupid name encoding
1948 which specifies how many buttons to use
1949 and how many buttons are on the right.
1950 The Q means something also. */
1951 dialog_name
[0] = 'Q';
1952 dialog_name
[1] = '0' + nb_buttons
;
1953 dialog_name
[2] = 'B';
1954 dialog_name
[3] = 'R';
1955 /* Number of buttons to put on the right. */
1956 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1958 wv
->contents
= first_wv
;
1962 /* Actually create the dialog. */
1963 dialog_id
= ++widget_id_tick
;
1964 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1965 f
->display
.x
->widget
, 1, 0,
1966 dialog_selection_callback
, 0);
1967 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1968 /* Free the widget_value objects we used to specify the contents. */
1969 free_menubar_widget_value_tree (first_wv
);
1971 /* No selection has been chosen yet. */
1972 menu_item_selection
= 0;
1974 /* Display the menu. */
1975 lw_pop_up_all_widgets (dialog_id
);
1977 /* Process events that apply to the menu. */
1982 XtAppNextEvent (Xt_app_con
, &event
);
1983 if (event
.type
== ButtonRelease
)
1985 XtDispatchEvent (&event
);
1988 else if (event
.type
== Expose
)
1989 process_expose_from_menu (event
);
1990 XtDispatchEvent (&event
);
1991 if (XtWindowToWidget (FRAME_X_DISPLAY (f
), event
.xany
.window
) != menu
)
1993 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1995 if (queue_tmp
!= NULL
)
1997 queue_tmp
->event
= event
;
1998 queue_tmp
->next
= queue
;
2005 #ifdef HAVE_X_WINDOWS
2006 /* State that no mouse buttons are now held.
2007 That is not necessarily true, but the fiction leads to reasonable
2008 results, and it is a pain to ask which are actually held now
2009 or track this in the loop above. */
2010 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2013 /* Unread any events that we got but did not handle. */
2014 while (queue
!= NULL
)
2017 XPutBackEvent (FRAME_X_DISPLAY (f
), &queue_tmp
->event
);
2018 queue
= queue_tmp
->next
;
2019 free ((char *)queue_tmp
);
2020 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
2021 interrupt_input_pending
= 1;
2024 /* Find the selected item, and its pane, to return
2025 the proper value. */
2026 if (menu_item_selection
!= 0)
2032 while (i
< menu_items_used
)
2036 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2039 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2040 i
+= MENU_ITEMS_PANE_LENGTH
;
2045 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2046 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2050 entry
= Fcons (entry
, Qnil
);
2052 entry
= Fcons (prefix
, entry
);
2056 i
+= MENU_ITEMS_ITEM_LENGTH
;
2063 #else /* not USE_X_TOOLKIT */
2066 xmenu_show (f
, x
, y
, menubarp
, for_click
, keymaps
, title
, error
)
2077 int pane
, selidx
, lpane
, status
;
2078 Lisp_Object entry
, pane_prefix
;
2080 int ulx
, uly
, width
, height
;
2081 int dispwidth
, dispheight
;
2085 unsigned int dummy_uint
;
2088 if (menu_items_n_panes
== 0)
2091 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2093 *error
= "Empty menu";
2097 /* Figure out which root window F is on. */
2098 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2099 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2100 &dummy_uint
, &dummy_uint
);
2102 /* Make the menu on that window. */
2103 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2106 *error
= "Can't create menu";
2110 #ifdef HAVE_X_WINDOWS
2111 /* Adjust coordinates to relative to the outer (window manager) window. */
2114 int win_x
= 0, win_y
= 0;
2116 /* Find the position of the outside upper-left corner of
2117 the inner window, with respect to the outer window. */
2118 if (f
->display
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2121 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2123 /* From-window, to-window. */
2124 f
->display
.x
->window_desc
,
2125 f
->display
.x
->parent_desc
,
2127 /* From-position, to-position. */
2128 0, 0, &win_x
, &win_y
,
2130 /* Child of window. */
2137 #endif /* HAVE_X_WINDOWS */
2139 /* Adjust coordinates to be root-window-relative. */
2140 x
+= f
->display
.x
->left_pos
;
2141 y
+= f
->display
.x
->top_pos
;
2143 /* Create all the necessary panes and their items. */
2145 while (i
< menu_items_used
)
2147 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2149 /* Create a new pane. */
2150 Lisp_Object pane_name
, prefix
;
2153 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2154 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2155 pane_string
= (NILP (pane_name
)
2156 ? "" : (char *) XSTRING (pane_name
)->data
);
2157 if (keymaps
&& !NILP (prefix
))
2160 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2161 if (lpane
== XM_FAILURE
)
2163 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2164 *error
= "Can't create pane";
2167 i
+= MENU_ITEMS_PANE_LENGTH
;
2169 /* Find the width of the widest item in this pane. */
2172 while (j
< menu_items_used
)
2175 item
= XVECTOR (menu_items
)->contents
[j
];
2183 width
= XSTRING (item
)->size
;
2184 if (width
> maxwidth
)
2187 j
+= MENU_ITEMS_ITEM_LENGTH
;
2190 /* Ignore a nil in the item list.
2191 It's meaningful only for dialog boxes. */
2192 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2196 /* Create a new item within current pane. */
2197 Lisp_Object item_name
, enable
, descrip
;
2198 unsigned char *item_data
;
2200 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2201 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2203 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2204 if (!NILP (descrip
))
2206 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2209 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2210 item_name
= concat2 (item_name
, spacer
);
2211 item_name
= concat2 (item_name
, descrip
);
2212 item_data
= XSTRING (item_name
)->data
;
2214 /* if alloca is fast, use that to make the space,
2215 to reduce gc needs. */
2217 = (unsigned char *) alloca (maxwidth
2218 + XSTRING (descrip
)->size
+ 1);
2219 bcopy (XSTRING (item_name
)->data
, item_data
,
2220 XSTRING (item_name
)->size
);
2221 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2223 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2224 XSTRING (descrip
)->size
);
2225 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2229 item_data
= XSTRING (item_name
)->data
;
2231 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2232 menu
, lpane
, 0, item_data
,
2236 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2237 *error
= "Can't add selection to menu";
2240 i
+= MENU_ITEMS_ITEM_LENGTH
;
2244 /* All set and ready to fly. */
2245 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2246 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
),
2247 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)));
2248 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
),
2249 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)));
2250 x
= min (x
, dispwidth
);
2251 y
= min (y
, dispheight
);
2254 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2255 &ulx
, &uly
, &width
, &height
);
2256 if (ulx
+width
> dispwidth
)
2258 x
-= (ulx
+ width
) - dispwidth
;
2259 ulx
= dispwidth
- width
;
2261 if (uly
+height
> dispheight
)
2263 y
-= (uly
+ height
) - dispheight
;
2264 uly
= dispheight
- height
;
2266 if (ulx
< 0) x
-= ulx
;
2267 if (uly
< 0) y
-= uly
;
2269 XMenuSetAEQ (menu
, TRUE
);
2270 XMenuSetFreeze (menu
, TRUE
);
2273 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2274 x
, y
, ButtonReleaseMask
, &datap
);
2277 /* Assume the mouse has moved out of the X window.
2278 If it has actually moved in, we will get an EnterNotify. */
2285 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2288 /* Find the item number SELIDX in pane number PANE. */
2290 while (i
< menu_items_used
)
2292 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2296 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2298 i
+= MENU_ITEMS_PANE_LENGTH
;
2307 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2310 entry
= Fcons (entry
, Qnil
);
2311 if (!NILP (pane_prefix
))
2312 entry
= Fcons (pane_prefix
, entry
);
2318 i
+= MENU_ITEMS_ITEM_LENGTH
;
2324 *error
= "Can't activate menu";
2330 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2332 #ifdef HAVE_X_WINDOWS
2333 /* State that no mouse buttons are now held.
2334 (The oldXMenu code doesn't track this info for us.)
2335 That is not necessarily true, but the fiction leads to reasonable
2336 results, and it is a pain to ask which are actually held now. */
2337 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2343 #endif /* not USE_X_TOOLKIT */
2347 staticpro (&menu_items
);
2350 #ifdef USE_X_TOOLKIT
2351 widget_id_tick
= (1<<16);
2354 defsubr (&Sx_popup_menu
);
2355 defsubr (&Sx_popup_dialog
);