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 <X11/Xaw/Paned.h>
71 #include "../lwlib/lwlib.h"
72 #else /* not USE_X_TOOLKIT */
73 #include "../oldXMenu/XMenu.h"
74 #endif /* not USE_X_TOOLKIT */
75 #endif /* HAVE_X_WINDOWS */
77 #define min(x,y) (((x) < (y)) ? (x) : (y))
78 #define max(x,y) (((x) > (y)) ? (x) : (y))
85 extern Lisp_Object Qmenu_enable
;
86 extern Lisp_Object Qmenu_bar
;
87 extern Lisp_Object Qmouse_click
, Qevent_kind
;
89 extern Lisp_Object Vdefine_key_rebound_commands
;
92 extern void process_expose_from_menu ();
93 extern XtAppContext Xt_app_con
;
95 static Lisp_Object
xdialog_show ();
96 void popup_get_selection ();
99 static Lisp_Object
xmenu_show ();
100 static void keymap_panes ();
101 static void single_keymap_panes ();
102 static void list_of_panes ();
103 static void list_of_items ();
105 /* This holds a Lisp vector that holds the results of decoding
106 the keymaps or alist-of-alists that specify a menu.
108 It describes the panes and items within the panes.
110 Each pane is described by 3 elements in the vector:
111 t, the pane name, the pane's prefix key.
112 Then follow the pane's items, with 5 elements per item:
113 the item string, the enable flag, the item's value,
114 the definition, and the equivalent keyboard key's description string.
116 In some cases, multiple levels of menus may be described.
117 A single vector slot containing nil indicates the start of a submenu.
118 A single vector slot containing lambda indicates the end of a submenu.
119 The submenu follows a menu item which is the way to reach the submenu.
121 A single vector slot containing quote indicates that the
122 following items should appear on the right of a dialog box.
124 Using a Lisp vector to hold this information while we decode it
125 takes care of protecting all the data from GC. */
127 #define MENU_ITEMS_PANE_NAME 1
128 #define MENU_ITEMS_PANE_PREFIX 2
129 #define MENU_ITEMS_PANE_LENGTH 3
131 #define MENU_ITEMS_ITEM_NAME 0
132 #define MENU_ITEMS_ITEM_ENABLE 1
133 #define MENU_ITEMS_ITEM_VALUE 2
134 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
135 #define MENU_ITEMS_ITEM_DEFINITION 4
136 #define MENU_ITEMS_ITEM_LENGTH 5
138 static Lisp_Object menu_items
;
140 /* Number of slots currently allocated in menu_items. */
141 static int menu_items_allocated
;
143 /* This is the index in menu_items of the first empty slot. */
144 static int menu_items_used
;
146 /* The number of panes currently recorded in menu_items,
147 excluding those within submenus. */
148 static int menu_items_n_panes
;
150 /* Current depth within submenus. */
151 static int menu_items_submenu_depth
;
153 /* Flag which when set indicates a dialog or menu has been posted by
154 Xt on behalf of one of the widget sets. */
155 static int popup_activated_flag
;
157 /* This holds a Lisp vector
158 which contains frames that have menu bars.
159 Each frame that has a menu bar is found at some index in this vector
160 and the menu bar widget refers to the frame through that index. */
161 static Lisp_Object frame_vector
;
163 /* Return the index of FRAME in frame_vector.
164 If FRAME isn't in frame_vector yet, put it in,
165 lengthening the vector if necessary. */
168 frame_vector_add_frame (f
)
171 int length
= XVECTOR (frame_vector
)->size
;
173 Lisp_Object
new, frame
;
175 XSETFRAME (frame
, f
);
177 for (i
= 0; i
< length
; i
++)
179 if (EQ (frame
, XVECTOR (frame_vector
)->contents
[i
]))
181 if (NILP (XVECTOR (frame_vector
)->contents
[i
]))
187 XVECTOR (frame_vector
)->contents
[empty
] = frame
;
191 new = Fmake_vector (make_number (length
* 2), Qnil
);
192 bcopy (XVECTOR (frame_vector
)->contents
,
193 XVECTOR (new)->contents
, sizeof (Lisp_Object
) * length
);
196 XVECTOR (frame_vector
)->contents
[length
] = frame
;
200 /* Initialize the menu_items structure if we haven't already done so.
201 Also mark it as currently empty. */
206 if (NILP (menu_items
))
208 menu_items_allocated
= 60;
209 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
213 menu_items_n_panes
= 0;
214 menu_items_submenu_depth
= 0;
217 /* Call at the end of generating the data in menu_items.
218 This fills in the number of items in the last pane. */
225 /* Call when finished using the data for the current menu
229 discard_menu_items ()
231 /* Free the structure if it is especially large.
232 Otherwise, hold on to it, to save time. */
233 if (menu_items_allocated
> 200)
236 menu_items_allocated
= 0;
240 /* Make the menu_items vector twice as large. */
246 int old_size
= menu_items_allocated
;
249 menu_items_allocated
*= 2;
250 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
251 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
252 old_size
* sizeof (Lisp_Object
));
255 /* Begin a submenu. */
258 push_submenu_start ()
260 if (menu_items_used
+ 1 > menu_items_allocated
)
263 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
264 menu_items_submenu_depth
++;
272 if (menu_items_used
+ 1 > menu_items_allocated
)
275 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
276 menu_items_submenu_depth
--;
279 /* Indicate boundary between left and right. */
282 push_left_right_boundary ()
284 if (menu_items_used
+ 1 > menu_items_allocated
)
287 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
290 /* Start a new menu pane in menu_items..
291 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
294 push_menu_pane (name
, prefix_vec
)
295 Lisp_Object name
, prefix_vec
;
297 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
300 if (menu_items_submenu_depth
== 0)
301 menu_items_n_panes
++;
302 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
303 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
304 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
307 /* Push one menu item into the current pane.
308 NAME is the string to display. ENABLE if non-nil means
309 this item can be selected. KEY is the key generated by
310 choosing this item, or nil if this item doesn't really have a definition.
311 DEF is the definition of this item.
312 EQUIV is the textual description of the keyboard equivalent for
313 this item (or nil if none). */
316 push_menu_item (name
, enable
, key
, def
, equiv
)
317 Lisp_Object name
, enable
, key
, def
, equiv
;
319 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
322 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
323 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
324 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
325 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
326 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
329 /* Figure out the current keyboard equivalent of a menu item ITEM1.
330 The item string for menu display should be ITEM_STRING.
331 Store the equivalent keyboard key sequence's
332 textual description into *DESCRIP_PTR.
333 Also cache them in the item itself.
334 Return the real definition to execute. */
337 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
338 Lisp_Object item_string
;
340 Lisp_Object
*descrip_ptr
;
342 /* This is the real definition--the function to run. */
344 /* This is the sublist that records cached equiv key data
345 so we can save time. */
346 Lisp_Object cachelist
;
347 /* These are the saved equivalent keyboard key sequence
348 and its key-description. */
349 Lisp_Object savedkey
, descrip
;
352 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
354 /* If a help string follows the item string, skip it. */
355 if (CONSP (XCONS (item1
)->cdr
)
356 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
357 item1
= XCONS (item1
)->cdr
;
361 /* Get out the saved equivalent-keyboard-key info. */
362 cachelist
= savedkey
= descrip
= Qnil
;
363 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
364 && (NILP (XCONS (XCONS (def
)->car
)->car
)
365 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
367 cachelist
= XCONS (def
)->car
;
368 def
= XCONS (def
)->cdr
;
369 savedkey
= XCONS (cachelist
)->car
;
370 descrip
= XCONS (cachelist
)->cdr
;
373 GCPRO4 (def
, def1
, savedkey
, descrip
);
375 /* Is it still valid? */
377 if (!NILP (savedkey
))
378 def1
= Fkey_binding (savedkey
, Qnil
);
379 /* If not, update it. */
381 /* If the command is an alias for another
382 (such as easymenu.el and lmenu.el set it up),
383 check if the original command matches the cached command. */
384 && !(SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
)
385 && EQ (def1
, XSYMBOL (def
)->function
))
386 /* If something had no key binding before, don't recheck it
387 because that is too slow--except if we have a list of rebound
388 commands in Vdefine_key_rebound_commands, do recheck any command
389 that appears in that list. */
390 && (NILP (cachelist
) || !NILP (savedkey
)
391 || (! EQ (Qt
, Vdefine_key_rebound_commands
)
392 && !NILP (Fmemq (def
, Vdefine_key_rebound_commands
)))))
396 /* If the command is an alias for another
397 (such as easymenu.el and lmenu.el set it up),
398 see if the original command name has equivalent keys. */
399 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
400 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
403 /* Otherwise look up the specified command itself.
404 We don't try both, because that makes easymenu menus slow. */
405 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
407 if (!NILP (savedkey
))
409 descrip
= Fkey_description (savedkey
);
410 descrip
= concat2 (make_string (" (", 3), descrip
);
411 descrip
= concat2 (descrip
, make_string (")", 1));
415 /* Cache the data we just got in a sublist of the menu binding. */
416 if (NILP (cachelist
))
418 CHECK_IMPURE (item1
);
419 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
423 XCONS (cachelist
)->car
= savedkey
;
424 XCONS (cachelist
)->cdr
= descrip
;
428 *descrip_ptr
= descrip
;
432 /* This is used as the handler when calling internal_condition_case_1. */
435 menu_item_enabled_p_1 (arg
)
441 /* Return non-nil if the command DEF is enabled when used as a menu item.
442 This is based on looking for a menu-enable property.
443 If NOTREAL is set, don't bother really computing this. */
446 menu_item_enabled_p (def
, notreal
)
450 Lisp_Object enabled
, tem
;
457 /* No property, or nil, means enable.
458 Otherwise, enable if value is not nil. */
459 tem
= Fget (def
, Qmenu_enable
);
461 /* (condition-case nil (eval tem)
463 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
464 menu_item_enabled_p_1
);
469 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
470 and generate menu panes for them in menu_items.
471 If NOTREAL is nonzero,
472 don't bother really computing whether an item is enabled. */
475 keymap_panes (keymaps
, nmaps
, notreal
)
476 Lisp_Object
*keymaps
;
484 /* Loop over the given keymaps, making a pane for each map.
485 But don't make a pane that is empty--ignore that map instead.
486 P is the number of panes we have made so far. */
487 for (mapno
= 0; mapno
< nmaps
; mapno
++)
488 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
490 finish_menu_items ();
493 /* This is a recursive subroutine of keymap_panes.
494 It handles one keymap, KEYMAP.
495 The other arguments are passed along
496 or point to local variables of the previous function.
497 If NOTREAL is nonzero,
498 don't bother really computing whether an item is enabled. */
501 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
503 Lisp_Object pane_name
;
507 Lisp_Object pending_maps
;
508 Lisp_Object tail
, item
, item1
, item_string
, table
;
509 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
513 push_menu_pane (pane_name
, prefix
);
515 for (tail
= keymap
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
517 /* Look at each key binding, and if it has a menu string,
518 make a menu item from it. */
519 item
= XCONS (tail
)->car
;
522 item1
= XCONS (item
)->cdr
;
525 item_string
= XCONS (item1
)->car
;
526 if (STRINGP (item_string
))
528 /* This is the real definition--the function to run. */
530 /* These are the saved equivalent keyboard key sequence
531 and its key-description. */
533 Lisp_Object tem
, enabled
;
535 /* GCPRO because ...enabled_p will call eval
536 and ..._equiv_key may autoload something.
537 Protecting KEYMAP preserves everything we use;
538 aside from that, must protect whatever might be
539 a string. Since there's no GCPRO5, we refetch
540 item_string instead of protecting it. */
541 descrip
= def
= Qnil
;
542 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
544 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
545 enabled
= menu_item_enabled_p (def
, notreal
);
549 item_string
= XCONS (item1
)->car
;
551 tem
= Fkeymapp (def
);
552 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
553 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
558 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
559 submap
= get_keymap_1 (def
, 0, 1);
561 #ifndef USE_X_TOOLKIT
562 /* Indicate visually that this is a submenu. */
564 item_string
= concat2 (item_string
,
565 build_string (" >"));
567 /* If definition is nil, pass nil as the key. */
568 push_menu_item (item_string
, enabled
,
569 XCONS (item
)->car
, def
,
572 /* Display a submenu using the toolkit. */
575 push_submenu_start ();
576 single_keymap_panes (submap
, Qnil
,
577 XCONS (item
)->car
, notreal
);
585 else if (VECTORP (item
))
587 /* Loop over the char values represented in the vector. */
588 int len
= XVECTOR (item
)->size
;
590 for (c
= 0; c
< len
; c
++)
592 Lisp_Object character
;
593 XSETFASTINT (character
, c
);
594 item1
= XVECTOR (item
)->contents
[c
];
597 item_string
= XCONS (item1
)->car
;
598 if (STRINGP (item_string
))
602 /* These are the saved equivalent keyboard key sequence
603 and its key-description. */
605 Lisp_Object tem
, enabled
;
607 /* GCPRO because ...enabled_p will call eval
608 and ..._equiv_key may autoload something.
609 Protecting KEYMAP preserves everything we use;
610 aside from that, must protect whatever might be
611 a string. Since there's no GCPRO5, we refetch
612 item_string instead of protecting it. */
613 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
614 descrip
= def
= Qnil
;
616 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
617 enabled
= menu_item_enabled_p (def
, notreal
);
621 item_string
= XCONS (item1
)->car
;
623 tem
= Fkeymapp (def
);
624 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
625 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
630 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
631 submap
= get_keymap_1 (def
, 0, 1);
633 #ifndef USE_X_TOOLKIT
635 item_string
= concat2 (item_string
,
636 build_string (" >"));
638 /* If definition is nil, pass nil as the key. */
639 push_menu_item (item_string
, enabled
, character
,
644 push_submenu_start ();
645 single_keymap_panes (submap
, Qnil
,
657 /* Process now any submenus which want to be panes at this level. */
658 while (!NILP (pending_maps
))
660 Lisp_Object elt
, eltcdr
, string
;
661 elt
= Fcar (pending_maps
);
662 eltcdr
= XCONS (elt
)->cdr
;
663 string
= XCONS (eltcdr
)->car
;
664 /* We no longer discard the @ from the beginning of the string here.
665 Instead, we do this in xmenu_show. */
666 single_keymap_panes (Fcar (elt
), string
,
667 XCONS (eltcdr
)->cdr
, notreal
);
668 pending_maps
= Fcdr (pending_maps
);
672 /* Push all the panes and items of a menu decsribed by the
673 alist-of-alists MENU.
674 This handles old-fashioned calls to x-popup-menu. */
684 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
686 Lisp_Object elt
, pane_name
, pane_data
;
688 pane_name
= Fcar (elt
);
689 CHECK_STRING (pane_name
, 0);
690 push_menu_pane (pane_name
, Qnil
);
691 pane_data
= Fcdr (elt
);
692 CHECK_CONS (pane_data
, 0);
693 list_of_items (pane_data
);
696 finish_menu_items ();
699 /* Push the items in a single pane defined by the alist PANE. */
705 Lisp_Object tail
, item
, item1
;
707 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
711 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
);
712 else if (NILP (item
))
713 push_left_right_boundary ();
716 CHECK_CONS (item
, 0);
718 CHECK_STRING (item1
, 1);
719 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
);
724 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
725 "Pop up a deck-of-cards menu and return user's selection.\n\
726 POSITION is a position specification. This is either a mouse button event\n\
727 or a list ((XOFFSET YOFFSET) WINDOW)\n\
728 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
729 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
730 This controls the position of the center of the first line\n\
731 in the first pane of the menu, not the top left of the menu as a whole.\n\
732 If POSITION is t, it means to use the current mouse position.\n\
734 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
735 The menu items come from key bindings that have a menu string as well as\n\
736 a definition; actually, the \"definition\" in such a key binding looks like\n\
737 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
738 the keymap as a top-level element.\n\n\
739 You can also use a list of keymaps as MENU.\n\
740 Then each keymap makes a separate pane.\n\
741 When MENU is a keymap or a list of keymaps, the return value\n\
742 is a list of events.\n\n\
743 Alternatively, you can specify a menu of multiple panes\n\
744 with a list of the form (TITLE PANE1 PANE2...),\n\
745 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
746 Each ITEM is normally a cons cell (STRING . VALUE);\n\
747 but a string can appear as an item--that makes a nonselectable line\n\
749 With this form of menu, the return value is VALUE from the chosen item.\n\
751 If POSITION is nil, don't display the menu at all, just precalculate the\n\
752 cached information about equivalent key sequences.")
754 Lisp_Object position
, menu
;
756 int number_of_panes
, panes
;
757 Lisp_Object keymap
, tem
;
761 Lisp_Object selection
;
764 Lisp_Object x
, y
, window
;
769 if (! NILP (position
))
773 /* Decode the first argument: find the window and the coordinates. */
774 if (EQ (position
, Qt
)
775 || (CONSP (position
) && EQ (XCONS (position
)->car
, Qmenu_bar
)))
777 /* Use the mouse's current position. */
778 FRAME_PTR new_f
= selected_frame
;
779 Lisp_Object bar_window
;
783 if (mouse_position_hook
)
784 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
785 &part
, &x
, &y
, &time
);
787 XSETFRAME (window
, new_f
);
790 window
= selected_window
;
797 tem
= Fcar (position
);
800 window
= Fcar (Fcdr (position
));
802 y
= Fcar (Fcdr (tem
));
807 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
808 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
809 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
818 /* Decode where to put the menu. */
826 else if (WINDOWP (window
))
828 CHECK_LIVE_WINDOW (window
, 0);
829 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
831 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
832 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
835 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
836 but I don't want to make one now. */
837 CHECK_WINDOW (window
, 0);
846 /* Decode the menu items from what was specified. */
848 keymap
= Fkeymapp (menu
);
851 tem
= Fkeymapp (Fcar (menu
));
854 /* We were given a keymap. Extract menu info from the keymap. */
856 keymap
= get_keymap (menu
);
858 /* Extract the detailed info to make one pane. */
859 keymap_panes (&menu
, 1, NILP (position
));
861 /* Search for a string appearing directly as an element of the keymap.
862 That string is the title of the menu. */
863 prompt
= map_prompt (keymap
);
865 /* Make that be the pane title of the first pane. */
866 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
867 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
871 else if (!NILP (tem
))
873 /* We were given a list of keymaps. */
874 int nmaps
= XFASTINT (Flength (menu
));
876 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
881 /* The first keymap that has a prompt string
882 supplies the menu title. */
883 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
887 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
889 prompt
= map_prompt (keymap
);
890 if (NILP (title
) && !NILP (prompt
))
894 /* Extract the detailed info to make one pane. */
895 keymap_panes (maps
, nmaps
, NILP (position
));
897 /* Make the title be the pane title of the first pane. */
898 if (!NILP (title
) && menu_items_n_panes
>= 0)
899 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
905 /* We were given an old-fashioned menu. */
907 CHECK_STRING (title
, 1);
909 list_of_panes (Fcdr (menu
));
916 discard_menu_items ();
921 /* Display them in a menu. */
924 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
925 keymaps
, title
, &error_name
);
928 discard_menu_items ();
932 if (error_name
) error (error_name
);
936 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
937 "Pop up a dialog box and return user's selection.\n\
938 POSITION specifies which frame to use.\n\
939 This is normally a mouse button event or a window or frame.\n\
940 If POSITION is t, it means to use the frame the mouse is on.\n\
941 The dialog box appears in the middle of the specified frame.\n\
943 CONTENTS specifies the alternatives to display in the dialog box.\n\
944 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
945 Each ITEM is a cons cell (STRING . VALUE).\n\
946 The return value is VALUE from the chosen item.\n\n\
947 An ITEM may also be just a string--that makes a nonselectable item.\n\
948 An ITEM may also be nil--that means to put all preceding items\n\
949 on the left of the dialog box and all following items on the right.\n\
950 \(By default, approximately half appear on each side.)")
952 Lisp_Object position
, contents
;
959 /* Decode the first argument: find the window or frame to use. */
960 if (EQ (position
, Qt
)
961 || (CONSP (position
) && EQ (XCONS (position
)->car
, Qmenu_bar
)))
963 #if 0 /* Using the frame the mouse is on may not be right. */
964 /* Use the mouse's current position. */
965 FRAME_PTR new_f
= selected_frame
;
966 Lisp_Object bar_window
;
971 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
974 XSETFRAME (window
, new_f
);
976 window
= selected_window
;
978 window
= selected_window
;
980 else if (CONSP (position
))
983 tem
= Fcar (position
);
985 window
= Fcar (Fcdr (position
));
988 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
989 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
992 else if (WINDOWP (position
) || FRAMEP (position
))
995 /* Decode where to put the menu. */
999 else if (WINDOWP (window
))
1001 CHECK_LIVE_WINDOW (window
, 0);
1002 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
1005 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1006 but I don't want to make one now. */
1007 CHECK_WINDOW (window
, 0);
1009 #ifndef USE_X_TOOLKIT
1010 /* Display a menu with these alternatives
1011 in the middle of frame F. */
1013 Lisp_Object x
, y
, frame
, newpos
;
1014 XSETFRAME (frame
, f
);
1015 XSETINT (x
, x_pixel_width (f
) / 2);
1016 XSETINT (y
, x_pixel_height (f
) / 2);
1017 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
1019 return Fx_popup_menu (newpos
,
1020 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
1026 Lisp_Object selection
;
1028 /* Decode the dialog items from what was specified. */
1029 title
= Fcar (contents
);
1030 CHECK_STRING (title
, 1);
1032 list_of_panes (Fcons (contents
, Qnil
));
1034 /* Display them in a dialog box. */
1036 selection
= xdialog_show (f
, 0, title
, &error_name
);
1039 discard_menu_items ();
1041 if (error_name
) error (error_name
);
1047 #ifdef USE_X_TOOLKIT
1049 /* Loop in Xt until the menu pulldown or dialog popup has been
1050 popped down (deactivated).
1052 NOTE: All calls to popup_get_selection should be protected
1053 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1056 popup_get_selection (initial_event
, dpyinfo
, id
)
1057 XEvent
*initial_event
;
1058 struct x_display_info
*dpyinfo
;
1063 /* Define a queue to save up for later unreading
1064 all X events that don't pertain to the menu. */
1068 struct event_queue
*next
;
1071 struct event_queue
*queue
= NULL
;
1072 struct event_queue
*queue_tmp
;
1075 event
= *initial_event
;
1077 XtAppNextEvent (Xt_app_con
, &event
);
1081 /* Handle expose events for editor frames right away. */
1082 if (event
.type
== Expose
)
1083 process_expose_from_menu (event
);
1084 /* Make sure we don't consider buttons grabbed after menu goes. */
1085 else if (event
.type
== ButtonRelease
1086 && dpyinfo
->display
== event
.xbutton
.display
)
1087 dpyinfo
->grabbed
&= ~(1 << event
.xbutton
.button
);
1088 /* If the user presses a key, deactivate the menu.
1089 The user is likely to do that if we get wedged. */
1090 else if (event
.type
== KeyPress
1091 && dpyinfo
->display
== event
.xbutton
.display
)
1093 popup_activated_flag
= 0;
1097 /* Queue all events not for this popup,
1098 except for Expose, which we've already handled.
1099 Note that the X window is associated with the frame if this
1100 is a menu bar popup, but not if it's a dialog box. So we use
1101 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1102 if (event
.type
!= Expose
1103 && (event
.xany
.display
!= dpyinfo
->display
1104 || x_non_menubar_window_to_frame (dpyinfo
, event
.xany
.window
)))
1106 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1108 if (queue_tmp
!= NULL
)
1110 queue_tmp
->event
= event
;
1111 queue_tmp
->next
= queue
;
1116 XtDispatchEvent (&event
);
1118 if (!popup_activated ())
1120 XtAppNextEvent (Xt_app_con
, &event
);
1123 /* Unread any events that we got but did not handle. */
1124 while (queue
!= NULL
)
1127 XPutBackEvent (queue_tmp
->event
.xany
.display
, &queue_tmp
->event
);
1128 queue
= queue_tmp
->next
;
1129 free ((char *)queue_tmp
);
1130 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1131 interrupt_input_pending
= 1;
1135 /* Detect if a dialog or menu has been posted. */
1140 return popup_activated_flag
;
1144 /* This callback is invoked when the user selects a menubar cascade
1145 pushbutton, but before the pulldown menu is posted. */
1148 popup_activate_callback (widget
, id
, client_data
)
1151 XtPointer client_data
;
1153 popup_activated_flag
= 1;
1156 /* This callback is called from the menu bar pulldown menu
1157 when the user makes a selection.
1158 Figure out what the user chose
1159 and put the appropriate events into the keyboard buffer. */
1162 menubar_selection_callback (widget
, id
, client_data
)
1165 XtPointer client_data
;
1167 Lisp_Object prefix
, entry
;
1168 FRAME_PTR f
= XFRAME (XVECTOR (frame_vector
)->contents
[id
]);
1170 Lisp_Object
*subprefix_stack
;
1171 int submenu_depth
= 0;
1176 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1177 vector
= f
->menu_bar_vector
;
1180 while (i
< f
->menu_bar_items_used
)
1182 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1184 subprefix_stack
[submenu_depth
++] = prefix
;
1188 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1190 prefix
= subprefix_stack
[--submenu_depth
];
1193 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1195 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1196 i
+= MENU_ITEMS_PANE_LENGTH
;
1200 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1201 /* The EMACS_INT cast avoids a warning. There's no problem
1202 as long as pointers have enough bits to hold small integers. */
1203 if ((int) (EMACS_INT
) client_data
== i
)
1206 struct input_event buf
;
1209 XSETFRAME (frame
, f
);
1210 buf
.kind
= menu_bar_event
;
1211 buf
.frame_or_window
= Fcons (frame
, Fcons (Qmenu_bar
, Qnil
));
1212 kbd_buffer_store_event (&buf
);
1214 for (j
= 0; j
< submenu_depth
; j
++)
1215 if (!NILP (subprefix_stack
[j
]))
1217 buf
.kind
= menu_bar_event
;
1218 buf
.frame_or_window
= Fcons (frame
, subprefix_stack
[j
]);
1219 kbd_buffer_store_event (&buf
);
1224 buf
.kind
= menu_bar_event
;
1225 buf
.frame_or_window
= Fcons (frame
, prefix
);
1226 kbd_buffer_store_event (&buf
);
1229 buf
.kind
= menu_bar_event
;
1230 buf
.frame_or_window
= Fcons (frame
, entry
);
1231 kbd_buffer_store_event (&buf
);
1235 i
+= MENU_ITEMS_ITEM_LENGTH
;
1240 /* This callback is invoked when a dialog or menu is finished being
1241 used and has been unposted. */
1244 popup_deactivate_callback (widget
, id
, client_data
)
1247 XtPointer client_data
;
1249 popup_activated_flag
= 0;
1253 /* This recursively calls free_widget_value on the tree of widgets.
1254 It must free all data that was malloc'ed for these widget_values.
1255 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1256 must be left alone. */
1259 free_menubar_widget_value_tree (wv
)
1264 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1266 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1268 free_menubar_widget_value_tree (wv
->contents
);
1269 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1273 free_menubar_widget_value_tree (wv
->next
);
1274 wv
->next
= (widget_value
*) 0xDEADBEEF;
1277 free_widget_value (wv
);
1281 /* Return a tree of widget_value structures for a menu bar item
1282 whose event type is ITEM_KEY (with string ITEM_NAME)
1283 and whose contents come from the list of keymaps MAPS. */
1285 static widget_value
*
1286 single_submenu (item_key
, item_name
, maps
)
1287 Lisp_Object item_key
, item_name
, maps
;
1289 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1291 int submenu_depth
= 0;
1294 Lisp_Object
*mapvec
;
1295 widget_value
**submenu_stack
;
1297 int previous_items
= menu_items_used
;
1299 length
= Flength (maps
);
1300 len
= XINT (length
);
1302 /* Convert the list MAPS into a vector MAPVEC. */
1303 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1304 for (i
= 0; i
< len
; i
++)
1306 mapvec
[i
] = Fcar (maps
);
1310 menu_items_n_panes
= 0;
1312 /* Loop over the given keymaps, making a pane for each map.
1313 But don't make a pane that is empty--ignore that map instead. */
1314 for (i
= 0; i
< len
; i
++)
1315 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0);
1317 /* Create a tree of widget_value objects
1318 representing the panes and their items. */
1321 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1322 wv
= malloc_widget_value ();
1329 /* Loop over all panes and items made during this call
1330 and construct a tree of widget_value objects.
1331 Ignore the panes and items made by previous calls to
1332 single_submenu, even though those are also in menu_items. */
1334 while (i
< menu_items_used
)
1336 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1338 submenu_stack
[submenu_depth
++] = save_wv
;
1343 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1346 save_wv
= submenu_stack
[--submenu_depth
];
1349 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1350 && submenu_depth
!= 0)
1351 i
+= MENU_ITEMS_PANE_LENGTH
;
1352 /* Ignore a nil in the item list.
1353 It's meaningful only for dialog boxes. */
1354 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1356 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1358 /* Create a new pane. */
1359 Lisp_Object pane_name
, prefix
;
1361 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1362 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1363 pane_string
= (NILP (pane_name
)
1364 ? "" : (char *) XSTRING (pane_name
)->data
);
1365 /* If there is just one top-level pane, put all its items directly
1366 under the top-level menu. */
1367 if (menu_items_n_panes
== 1)
1370 /* If the pane has a meaningful name,
1371 make the pane a top-level menu item
1372 with its items as a submenu beneath it. */
1373 if (strcmp (pane_string
, ""))
1375 wv
= malloc_widget_value ();
1379 first_wv
->contents
= wv
;
1380 wv
->name
= pane_string
;
1388 i
+= MENU_ITEMS_PANE_LENGTH
;
1392 /* Create a new item within current pane. */
1393 Lisp_Object item_name
, enable
, descrip
, def
;
1394 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1395 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1397 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1398 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1400 wv
= malloc_widget_value ();
1404 save_wv
->contents
= wv
;
1405 wv
->name
= (char *) XSTRING (item_name
)->data
;
1406 if (!NILP (descrip
))
1407 wv
->key
= (char *) XSTRING (descrip
)->data
;
1409 /* The EMACS_INT cast avoids a warning. There's no problem
1410 as long as pointers have enough bits to hold small integers. */
1411 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1412 wv
->enabled
= !NILP (enable
);
1415 i
+= MENU_ITEMS_ITEM_LENGTH
;
1422 extern void EmacsFrameSetCharSize ();
1424 /* Recompute all the widgets of frame F, when the menu bar
1425 has been changed. */
1428 update_frame_menubar (f
)
1431 struct x_display
*x
= f
->display
.x
;
1433 int menubar_changed
;
1435 Dimension shell_height
;
1437 /* We assume the menubar contents has changed if the global flag is set,
1438 or if the current buffer has changed, or if the menubar has never
1439 been updated before.
1441 menubar_changed
= (x
->menubar_widget
1442 && !XtIsManaged (x
->menubar_widget
));
1444 if (! (menubar_changed
))
1448 /* Save the size of the frame because the pane widget doesn't accept to
1449 resize itself. So force it. */
1453 /* Do the voodoo which means "I'm changing lots of things, don't try to
1454 refigure sizes until I'm done." */
1455 lw_refigure_widget (x
->column_widget
, False
);
1457 /* the order in which children are managed is the top to
1458 bottom order in which they are displayed in the paned window.
1459 First, remove the text-area widget.
1461 XtUnmanageChild (x
->edit_widget
);
1463 /* remove the menubar that is there now, and put up the menubar that
1466 if (menubar_changed
)
1468 XtManageChild (x
->menubar_widget
);
1469 XtMapWidget (x
->menubar_widget
);
1470 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1473 /* Re-manage the text-area widget, and then thrash the sizes. */
1474 XtManageChild (x
->edit_widget
);
1475 lw_refigure_widget (x
->column_widget
, True
);
1477 /* Force the pane widget to resize itself with the right values. */
1478 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1483 /* Set the contents of the menubar widgets of frame F.
1484 The argument FIRST_TIME is currently ignored;
1485 it is set the first time this is called, from initialize_frame_menubar. */
1488 set_frame_menubar (f
, first_time
)
1492 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1493 Lisp_Object tail
, items
, frame
;
1494 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1499 count
= inhibit_garbage_collection ();
1501 id
= frame_vector_add_frame (f
);
1503 wv
= malloc_widget_value ();
1504 wv
->name
= "menubar";
1508 items
= FRAME_MENU_BAR_ITEMS (f
);
1509 menu_items
= f
->menu_bar_vector
;
1510 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1513 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1515 Lisp_Object key
, string
, maps
;
1517 key
= XVECTOR (items
)->contents
[i
];
1518 string
= XVECTOR (items
)->contents
[i
+ 1];
1519 maps
= XVECTOR (items
)->contents
[i
+ 2];
1523 wv
= single_submenu (key
, string
, maps
);
1527 first_wv
->contents
= wv
;
1528 /* Don't set wv->name here; GC during the loop might relocate it. */
1533 /* Now GC cannot happen during the lifetime of the widget_value,
1534 so it's safe to store data from a Lisp_String. */
1535 wv
= first_wv
->contents
;
1536 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1539 string
= XVECTOR (items
)->contents
[i
+ 1];
1542 wv
->name
= (char *) XSTRING (string
)->data
;
1546 finish_menu_items ();
1548 f
->menu_bar_vector
= menu_items
;
1549 f
->menu_bar_items_used
= menu_items_used
;
1552 unbind_to (count
, Qnil
);
1558 /* Disable resizing (done for Motif!) */
1559 lw_allow_resizing (f
->display
.x
->widget
, False
);
1561 /* The third arg is DEEP_P, which says to consider the entire
1562 menu trees we supply, rather than just the menu bar item names. */
1563 lw_modify_all_widgets ((LWLIB_ID
) id
, first_wv
, 1);
1565 /* Re-enable the edit widget to resize. */
1566 lw_allow_resizing (f
->display
.x
->widget
, True
);
1570 menubar_widget
= lw_create_widget ("menubar", "menubar",
1571 (LWLIB_ID
) id
, first_wv
,
1572 f
->display
.x
->column_widget
,
1574 popup_activate_callback
,
1575 menubar_selection_callback
,
1576 popup_deactivate_callback
);
1577 f
->display
.x
->menubar_widget
= menubar_widget
;
1582 = (f
->display
.x
->menubar_widget
1583 ? (f
->display
.x
->menubar_widget
->core
.height
1584 + f
->display
.x
->menubar_widget
->core
.border_width
)
1587 if (FRAME_EXTERNAL_MENU_BAR (f
))
1590 XtVaGetValues (f
->display
.x
->column_widget
,
1591 XtNinternalBorderWidth
, &ibw
, NULL
);
1592 menubar_size
+= ibw
;
1595 f
->display
.x
->menubar_height
= menubar_size
;
1598 free_menubar_widget_value_tree (first_wv
);
1600 update_frame_menubar (f
);
1605 /* Called from Fx_create_frame to create the inital menubar of a frame
1606 before it is mapped, so that the window is mapped with the menubar already
1607 there instead of us tacking it on later and thrashing the window after it
1611 initialize_frame_menubar (f
)
1614 /* This function is called before the first chance to redisplay
1615 the frame. It has to be, so the frame will have the right size. */
1616 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1617 set_frame_menubar (f
, 1);
1620 /* Get rid of the menu bar of frame F, and free its storage.
1621 This is used when deleting a frame, and when turning off the menu bar. */
1624 free_frame_menubar (f
)
1627 Widget menubar_widget
;
1630 menubar_widget
= f
->display
.x
->menubar_widget
;
1634 id
= frame_vector_add_frame (f
);
1636 lw_destroy_all_widgets ((LWLIB_ID
) id
);
1637 XVECTOR (frame_vector
)->contents
[id
] = Qnil
;
1642 #endif /* USE_X_TOOLKIT */
1644 /* xmenu_show actually displays a menu using the panes and items in menu_items
1645 and returns the value selected from it.
1646 There are two versions of xmenu_show, one for Xt and one for Xlib.
1647 Both assume input is blocked by the caller. */
1649 /* F is the frame the menu is for.
1650 X and Y are the frame-relative specified position,
1651 relative to the inside upper left corner of the frame F.
1652 FOR_CLICK if this menu was invoked for a mouse click.
1653 KEYMAPS is 1 if this menu was specified with keymaps;
1654 in that case, we return a list containing the chosen item's value
1655 and perhaps also the pane's prefix.
1656 TITLE is the specified menu title.
1657 ERROR is a place to store an error message string in case of failure.
1658 (We return nil on failure, but the value doesn't actually matter.) */
1660 #ifdef USE_X_TOOLKIT
1662 /* We need a unique id for each widget handled by the Lucid Widget
1665 For the main windows, and popup menus, we use this counter,
1666 which we increment each time after use.
1668 For menu bars, we use the index of the frame in frame_vector
1670 LWLIB_ID widget_id_tick
;
1673 static Lisp_Object
*volatile menu_item_selection
;
1675 static Lisp_Object
*menu_item_selection
;
1679 popup_selection_callback (widget
, id
, client_data
)
1682 XtPointer client_data
;
1684 menu_item_selection
= (Lisp_Object
*) client_data
;
1688 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1702 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1703 widget_value
**submenu_stack
1704 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1705 Lisp_Object
*subprefix_stack
1706 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1707 int submenu_depth
= 0;
1709 Position root_x
, root_y
;
1712 int next_release_must_exit
= 0;
1716 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1718 *error
= "Empty menu";
1722 /* Create a tree of widget_value objects
1723 representing the panes and their items. */
1724 wv
= malloc_widget_value ();
1731 /* Loop over all panes and items, filling in the tree. */
1733 while (i
< menu_items_used
)
1735 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1737 submenu_stack
[submenu_depth
++] = save_wv
;
1743 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1746 save_wv
= submenu_stack
[--submenu_depth
];
1750 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1751 && submenu_depth
!= 0)
1752 i
+= MENU_ITEMS_PANE_LENGTH
;
1753 /* Ignore a nil in the item list.
1754 It's meaningful only for dialog boxes. */
1755 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1757 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1759 /* Create a new pane. */
1760 Lisp_Object pane_name
, prefix
;
1762 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1763 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1764 pane_string
= (NILP (pane_name
)
1765 ? "" : (char *) XSTRING (pane_name
)->data
);
1766 /* If there is just one top-level pane, put all its items directly
1767 under the top-level menu. */
1768 if (menu_items_n_panes
== 1)
1771 /* If the pane has a meaningful name,
1772 make the pane a top-level menu item
1773 with its items as a submenu beneath it. */
1774 if (!keymaps
&& strcmp (pane_string
, ""))
1776 wv
= malloc_widget_value ();
1780 first_wv
->contents
= wv
;
1781 wv
->name
= pane_string
;
1782 if (keymaps
&& !NILP (prefix
))
1789 else if (first_pane
)
1795 i
+= MENU_ITEMS_PANE_LENGTH
;
1799 /* Create a new item within current pane. */
1800 Lisp_Object item_name
, enable
, descrip
, def
;
1801 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1802 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1804 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1805 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1807 wv
= malloc_widget_value ();
1811 save_wv
->contents
= wv
;
1812 wv
->name
= (char *) XSTRING (item_name
)->data
;
1813 if (!NILP (descrip
))
1814 wv
->key
= (char *) XSTRING (descrip
)->data
;
1816 /* If this item has a null value,
1817 make the call_data null so that it won't display a box
1818 when the mouse is on it. */
1820 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
1821 wv
->enabled
= !NILP (enable
);
1824 i
+= MENU_ITEMS_ITEM_LENGTH
;
1828 /* Deal with the title, if it is non-nil. */
1831 widget_value
*wv_title
= malloc_widget_value ();
1832 widget_value
*wv_sep1
= malloc_widget_value ();
1833 widget_value
*wv_sep2
= malloc_widget_value ();
1835 wv_sep2
->name
= "--";
1836 wv_sep2
->next
= first_wv
->contents
;
1838 wv_sep1
->name
= "--";
1839 wv_sep1
->next
= wv_sep2
;
1841 wv_title
->name
= (char *) XSTRING (title
)->data
;
1842 wv_title
->enabled
= True
;
1843 wv_title
->next
= wv_sep1
;
1844 first_wv
->contents
= wv_title
;
1847 /* Actually create the menu. */
1848 menu_id
= widget_id_tick
++;
1849 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1850 f
->display
.x
->widget
, 1, 0,
1851 popup_selection_callback
,
1852 popup_deactivate_callback
);
1854 /* Don't allow any geometry request from the user. */
1855 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
1856 XtSetValues (menu
, av
, ac
);
1858 /* Free the widget_value objects we used to specify the contents. */
1859 free_menubar_widget_value_tree (first_wv
);
1861 /* No selection has been chosen yet. */
1862 menu_item_selection
= 0;
1864 /* Display the menu. */
1865 lw_popup_menu (menu
);
1866 popup_activated_flag
= 1;
1868 /* Process events that apply to the menu. */
1869 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), menu_id
);
1871 /* fp turned off the following statement and wrote a comment
1872 that it is unnecessary--that the menu has already disappeared.
1873 Nowadays the menu disappears ok, all right, but
1874 we need to delete the widgets or multiple ones will pile up. */
1875 lw_destroy_all_widgets (menu_id
);
1877 /* Find the selected item, and its pane, to return
1878 the proper value. */
1879 if (menu_item_selection
!= 0)
1881 Lisp_Object prefix
, entry
;
1885 while (i
< menu_items_used
)
1887 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1889 subprefix_stack
[submenu_depth
++] = prefix
;
1893 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1895 prefix
= subprefix_stack
[--submenu_depth
];
1898 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1901 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1902 i
+= MENU_ITEMS_PANE_LENGTH
;
1907 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1908 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1914 entry
= Fcons (entry
, Qnil
);
1916 entry
= Fcons (prefix
, entry
);
1917 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1918 if (!NILP (subprefix_stack
[j
]))
1919 entry
= Fcons (subprefix_stack
[j
], entry
);
1923 i
+= MENU_ITEMS_ITEM_LENGTH
;
1932 dialog_selection_callback (widget
, id
, client_data
)
1935 XtPointer client_data
;
1937 /* The EMACS_INT cast avoids a warning. There's no problem
1938 as long as pointers have enough bits to hold small integers. */
1939 if ((int) (EMACS_INT
) client_data
!= -1)
1940 menu_item_selection
= (Lisp_Object
*) client_data
;
1942 lw_destroy_all_widgets (id
);
1944 popup_activated_flag
= 0;
1947 static char * button_names
[] = {
1948 "button1", "button2", "button3", "button4", "button5",
1949 "button6", "button7", "button8", "button9", "button10" };
1952 xdialog_show (f
, keymaps
, title
, error
)
1958 int i
, nb_buttons
=0;
1961 char dialog_name
[6];
1963 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1965 /* Number of elements seen so far, before boundary. */
1967 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1968 int boundary_seen
= 0;
1972 if (menu_items_n_panes
> 1)
1974 *error
= "Multiple panes in dialog box";
1978 /* Create a tree of widget_value objects
1979 representing the text label and buttons. */
1981 Lisp_Object pane_name
, prefix
;
1983 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1984 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1985 pane_string
= (NILP (pane_name
)
1986 ? "" : (char *) XSTRING (pane_name
)->data
);
1987 prev_wv
= malloc_widget_value ();
1988 prev_wv
->value
= pane_string
;
1989 if (keymaps
&& !NILP (prefix
))
1991 prev_wv
->enabled
= 1;
1992 prev_wv
->name
= "message";
1995 /* Loop over all panes and items, filling in the tree. */
1996 i
= MENU_ITEMS_PANE_LENGTH
;
1997 while (i
< menu_items_used
)
2000 /* Create a new item within current pane. */
2001 Lisp_Object item_name
, enable
, descrip
;
2002 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2003 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2005 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2007 if (NILP (item_name
))
2009 free_menubar_widget_value_tree (first_wv
);
2010 *error
= "Submenu in dialog items";
2013 if (EQ (item_name
, Qquote
))
2015 /* This is the boundary between left-side elts
2016 and right-side elts. Stop incrementing right_count. */
2021 if (nb_buttons
>= 10)
2023 free_menubar_widget_value_tree (first_wv
);
2024 *error
= "Too many dialog items";
2028 wv
= malloc_widget_value ();
2030 wv
->name
= (char *) button_names
[nb_buttons
];
2031 if (!NILP (descrip
))
2032 wv
->key
= (char *) XSTRING (descrip
)->data
;
2033 wv
->value
= (char *) XSTRING (item_name
)->data
;
2034 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
2035 wv
->enabled
= !NILP (enable
);
2038 if (! boundary_seen
)
2042 i
+= MENU_ITEMS_ITEM_LENGTH
;
2045 /* If the boundary was not specified,
2046 by default put half on the left and half on the right. */
2047 if (! boundary_seen
)
2048 left_count
= nb_buttons
- nb_buttons
/ 2;
2050 wv
= malloc_widget_value ();
2051 wv
->name
= dialog_name
;
2053 /* Dialog boxes use a really stupid name encoding
2054 which specifies how many buttons to use
2055 and how many buttons are on the right.
2056 The Q means something also. */
2057 dialog_name
[0] = 'Q';
2058 dialog_name
[1] = '0' + nb_buttons
;
2059 dialog_name
[2] = 'B';
2060 dialog_name
[3] = 'R';
2061 /* Number of buttons to put on the right. */
2062 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2064 wv
->contents
= first_wv
;
2068 /* Actually create the dialog. */
2069 dialog_id
= widget_id_tick
++;
2070 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2071 f
->display
.x
->widget
, 1, 0,
2072 dialog_selection_callback
, 0);
2073 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2074 /* Free the widget_value objects we used to specify the contents. */
2075 free_menubar_widget_value_tree (first_wv
);
2077 /* No selection has been chosen yet. */
2078 menu_item_selection
= 0;
2080 /* Display the menu. */
2081 lw_pop_up_all_widgets (dialog_id
);
2082 popup_activated_flag
= 1;
2084 /* Process events that apply to the menu. */
2085 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2087 lw_destroy_all_widgets (dialog_id
);
2089 /* Find the selected item, and its pane, to return
2090 the proper value. */
2091 if (menu_item_selection
!= 0)
2097 while (i
< menu_items_used
)
2101 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2104 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2105 i
+= MENU_ITEMS_PANE_LENGTH
;
2110 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2111 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2115 entry
= Fcons (entry
, Qnil
);
2117 entry
= Fcons (prefix
, entry
);
2121 i
+= MENU_ITEMS_ITEM_LENGTH
;
2128 #else /* not USE_X_TOOLKIT */
2131 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2141 int pane
, selidx
, lpane
, status
;
2142 Lisp_Object entry
, pane_prefix
;
2144 int ulx
, uly
, width
, height
;
2145 int dispwidth
, dispheight
;
2149 unsigned int dummy_uint
;
2152 if (menu_items_n_panes
== 0)
2155 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2157 *error
= "Empty menu";
2161 /* Figure out which root window F is on. */
2162 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2163 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2164 &dummy_uint
, &dummy_uint
);
2166 /* Make the menu on that window. */
2167 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2170 *error
= "Can't create menu";
2174 #ifdef HAVE_X_WINDOWS
2175 /* Adjust coordinates to relative to the outer (window manager) window. */
2178 int win_x
= 0, win_y
= 0;
2180 /* Find the position of the outside upper-left corner of
2181 the inner window, with respect to the outer window. */
2182 if (f
->display
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2185 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2187 /* From-window, to-window. */
2188 f
->display
.x
->window_desc
,
2189 f
->display
.x
->parent_desc
,
2191 /* From-position, to-position. */
2192 0, 0, &win_x
, &win_y
,
2194 /* Child of window. */
2201 #endif /* HAVE_X_WINDOWS */
2203 /* Adjust coordinates to be root-window-relative. */
2204 x
+= f
->display
.x
->left_pos
;
2205 y
+= f
->display
.x
->top_pos
;
2207 /* Create all the necessary panes and their items. */
2209 while (i
< menu_items_used
)
2211 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2213 /* Create a new pane. */
2214 Lisp_Object pane_name
, prefix
;
2217 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2218 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2219 pane_string
= (NILP (pane_name
)
2220 ? "" : (char *) XSTRING (pane_name
)->data
);
2221 if (keymaps
&& !NILP (prefix
))
2224 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2225 if (lpane
== XM_FAILURE
)
2227 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2228 *error
= "Can't create pane";
2231 i
+= MENU_ITEMS_PANE_LENGTH
;
2233 /* Find the width of the widest item in this pane. */
2236 while (j
< menu_items_used
)
2239 item
= XVECTOR (menu_items
)->contents
[j
];
2247 width
= XSTRING (item
)->size
;
2248 if (width
> maxwidth
)
2251 j
+= MENU_ITEMS_ITEM_LENGTH
;
2254 /* Ignore a nil in the item list.
2255 It's meaningful only for dialog boxes. */
2256 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2260 /* Create a new item within current pane. */
2261 Lisp_Object item_name
, enable
, descrip
;
2262 unsigned char *item_data
;
2264 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2265 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2267 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2268 if (!NILP (descrip
))
2270 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2273 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2274 item_name
= concat2 (item_name
, spacer
);
2275 item_name
= concat2 (item_name
, descrip
);
2276 item_data
= XSTRING (item_name
)->data
;
2278 /* if alloca is fast, use that to make the space,
2279 to reduce gc needs. */
2281 = (unsigned char *) alloca (maxwidth
2282 + XSTRING (descrip
)->size
+ 1);
2283 bcopy (XSTRING (item_name
)->data
, item_data
,
2284 XSTRING (item_name
)->size
);
2285 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2287 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2288 XSTRING (descrip
)->size
);
2289 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2293 item_data
= XSTRING (item_name
)->data
;
2295 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2296 menu
, lpane
, 0, item_data
,
2300 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2301 *error
= "Can't add selection to menu";
2304 i
+= MENU_ITEMS_ITEM_LENGTH
;
2308 /* All set and ready to fly. */
2309 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2310 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
),
2311 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)));
2312 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
),
2313 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)));
2314 x
= min (x
, dispwidth
);
2315 y
= min (y
, dispheight
);
2318 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2319 &ulx
, &uly
, &width
, &height
);
2320 if (ulx
+width
> dispwidth
)
2322 x
-= (ulx
+ width
) - dispwidth
;
2323 ulx
= dispwidth
- width
;
2325 if (uly
+height
> dispheight
)
2327 y
-= (uly
+ height
) - dispheight
;
2328 uly
= dispheight
- height
;
2330 if (ulx
< 0) x
-= ulx
;
2331 if (uly
< 0) y
-= uly
;
2333 XMenuSetAEQ (menu
, TRUE
);
2334 XMenuSetFreeze (menu
, TRUE
);
2337 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2338 x
, y
, ButtonReleaseMask
, &datap
);
2341 #ifdef HAVE_X_WINDOWS
2342 /* Assume the mouse has moved out of the X window.
2343 If it has actually moved in, we will get an EnterNotify. */
2344 x_mouse_leave (FRAME_X_DISPLAY_INFO (f
));
2351 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2354 /* Find the item number SELIDX in pane number PANE. */
2356 while (i
< menu_items_used
)
2358 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2362 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2364 i
+= MENU_ITEMS_PANE_LENGTH
;
2373 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2376 entry
= Fcons (entry
, Qnil
);
2377 if (!NILP (pane_prefix
))
2378 entry
= Fcons (pane_prefix
, entry
);
2384 i
+= MENU_ITEMS_ITEM_LENGTH
;
2390 *error
= "Can't activate menu";
2396 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2398 #ifdef HAVE_X_WINDOWS
2399 /* State that no mouse buttons are now held.
2400 (The oldXMenu code doesn't track this info for us.)
2401 That is not necessarily true, but the fiction leads to reasonable
2402 results, and it is a pain to ask which are actually held now. */
2403 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2409 #endif /* not USE_X_TOOLKIT */
2413 staticpro (&menu_items
);
2416 #ifdef USE_X_TOOLKIT
2417 widget_id_tick
= (1<<16);
2420 staticpro (&frame_vector
);
2421 frame_vector
= Fmake_vector (make_number (10), Qnil
);
2423 defsubr (&Sx_popup_menu
);
2424 defsubr (&Sx_popup_dialog
);