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 Lisp_Object Qdebug_on_next_call
;
87 extern Lisp_Object Qmenu_enable
;
88 extern Lisp_Object Qmenu_bar
;
89 extern Lisp_Object Qmouse_click
, Qevent_kind
;
91 extern Lisp_Object Vdefine_key_rebound_commands
;
94 extern void process_expose_from_menu ();
95 extern XtAppContext Xt_app_con
;
97 static Lisp_Object
xdialog_show ();
98 void popup_get_selection ();
101 static Lisp_Object
xmenu_show ();
102 static void keymap_panes ();
103 static void single_keymap_panes ();
104 static void list_of_panes ();
105 static void list_of_items ();
107 /* This holds a Lisp vector that holds the results of decoding
108 the keymaps or alist-of-alists that specify a menu.
110 It describes the panes and items within the panes.
112 Each pane is described by 3 elements in the vector:
113 t, the pane name, the pane's prefix key.
114 Then follow the pane's items, with 5 elements per item:
115 the item string, the enable flag, the item's value,
116 the definition, and the equivalent keyboard key's description string.
118 In some cases, multiple levels of menus may be described.
119 A single vector slot containing nil indicates the start of a submenu.
120 A single vector slot containing lambda indicates the end of a submenu.
121 The submenu follows a menu item which is the way to reach the submenu.
123 A single vector slot containing quote indicates that the
124 following items should appear on the right of a dialog box.
126 Using a Lisp vector to hold this information while we decode it
127 takes care of protecting all the data from GC. */
129 #define MENU_ITEMS_PANE_NAME 1
130 #define MENU_ITEMS_PANE_PREFIX 2
131 #define MENU_ITEMS_PANE_LENGTH 3
133 #define MENU_ITEMS_ITEM_NAME 0
134 #define MENU_ITEMS_ITEM_ENABLE 1
135 #define MENU_ITEMS_ITEM_VALUE 2
136 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
137 #define MENU_ITEMS_ITEM_DEFINITION 4
138 #define MENU_ITEMS_ITEM_LENGTH 5
140 static Lisp_Object menu_items
;
142 /* Number of slots currently allocated in menu_items. */
143 static int menu_items_allocated
;
145 /* This is the index in menu_items of the first empty slot. */
146 static int menu_items_used
;
148 /* The number of panes currently recorded in menu_items,
149 excluding those within submenus. */
150 static int menu_items_n_panes
;
152 /* Current depth within submenus. */
153 static int menu_items_submenu_depth
;
155 /* Flag which when set indicates a dialog or menu has been posted by
156 Xt on behalf of one of the widget sets. */
157 static int popup_activated_flag
;
159 /* This holds a Lisp vector
160 which contains frames that have menu bars.
161 Each frame that has a menu bar is found at some index in this vector
162 and the menu bar widget refers to the frame through that index. */
163 static Lisp_Object frame_vector
;
165 /* Return the index of FRAME in frame_vector.
166 If FRAME isn't in frame_vector yet, put it in,
167 lengthening the vector if necessary. */
170 frame_vector_add_frame (f
)
173 int length
= XVECTOR (frame_vector
)->size
;
175 Lisp_Object
new, frame
;
177 XSETFRAME (frame
, f
);
179 for (i
= 0; i
< length
; i
++)
181 if (EQ (frame
, XVECTOR (frame_vector
)->contents
[i
]))
183 if (NILP (XVECTOR (frame_vector
)->contents
[i
]))
189 XVECTOR (frame_vector
)->contents
[empty
] = frame
;
193 new = Fmake_vector (make_number (length
* 2), Qnil
);
194 bcopy (XVECTOR (frame_vector
)->contents
,
195 XVECTOR (new)->contents
, sizeof (Lisp_Object
) * length
);
198 XVECTOR (frame_vector
)->contents
[length
] = frame
;
202 /* Initialize the menu_items structure if we haven't already done so.
203 Also mark it as currently empty. */
208 if (NILP (menu_items
))
210 menu_items_allocated
= 60;
211 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
215 menu_items_n_panes
= 0;
216 menu_items_submenu_depth
= 0;
219 /* Call at the end of generating the data in menu_items.
220 This fills in the number of items in the last pane. */
227 /* Call when finished using the data for the current menu
231 discard_menu_items ()
233 /* Free the structure if it is especially large.
234 Otherwise, hold on to it, to save time. */
235 if (menu_items_allocated
> 200)
238 menu_items_allocated
= 0;
242 /* Make the menu_items vector twice as large. */
248 int old_size
= menu_items_allocated
;
251 menu_items_allocated
*= 2;
252 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
253 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
254 old_size
* sizeof (Lisp_Object
));
257 /* Begin a submenu. */
260 push_submenu_start ()
262 if (menu_items_used
+ 1 > menu_items_allocated
)
265 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
266 menu_items_submenu_depth
++;
274 if (menu_items_used
+ 1 > menu_items_allocated
)
277 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
278 menu_items_submenu_depth
--;
281 /* Indicate boundary between left and right. */
284 push_left_right_boundary ()
286 if (menu_items_used
+ 1 > menu_items_allocated
)
289 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
292 /* Start a new menu pane in menu_items..
293 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
296 push_menu_pane (name
, prefix_vec
)
297 Lisp_Object name
, prefix_vec
;
299 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
302 if (menu_items_submenu_depth
== 0)
303 menu_items_n_panes
++;
304 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
305 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
306 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
309 /* Push one menu item into the current pane.
310 NAME is the string to display. ENABLE if non-nil means
311 this item can be selected. KEY is the key generated by
312 choosing this item, or nil if this item doesn't really have a definition.
313 DEF is the definition of this item.
314 EQUIV is the textual description of the keyboard equivalent for
315 this item (or nil if none). */
318 push_menu_item (name
, enable
, key
, def
, equiv
)
319 Lisp_Object name
, enable
, key
, def
, equiv
;
321 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
324 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
325 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
326 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
327 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
328 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
331 /* Figure out the current keyboard equivalent of a menu item ITEM1.
332 The item string for menu display should be ITEM_STRING.
333 Store the equivalent keyboard key sequence's
334 textual description into *DESCRIP_PTR.
335 Also cache them in the item itself.
336 Return the real definition to execute. */
339 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
340 Lisp_Object item_string
;
342 Lisp_Object
*descrip_ptr
;
344 /* This is the real definition--the function to run. */
346 /* This is the sublist that records cached equiv key data
347 so we can save time. */
348 Lisp_Object cachelist
;
349 /* These are the saved equivalent keyboard key sequence
350 and its key-description. */
351 Lisp_Object savedkey
, descrip
;
354 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
356 /* If a help string follows the item string, skip it. */
357 if (CONSP (XCONS (item1
)->cdr
)
358 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
359 item1
= XCONS (item1
)->cdr
;
363 /* Get out the saved equivalent-keyboard-key info. */
364 cachelist
= savedkey
= descrip
= Qnil
;
365 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
366 && (NILP (XCONS (XCONS (def
)->car
)->car
)
367 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
369 cachelist
= XCONS (def
)->car
;
370 def
= XCONS (def
)->cdr
;
371 savedkey
= XCONS (cachelist
)->car
;
372 descrip
= XCONS (cachelist
)->cdr
;
375 GCPRO4 (def
, def1
, savedkey
, descrip
);
377 /* Is it still valid? */
379 if (!NILP (savedkey
))
380 def1
= Fkey_binding (savedkey
, Qnil
);
381 /* If not, update it. */
383 /* If the command is an alias for another
384 (such as easymenu.el and lmenu.el set it up),
385 check if the original command matches the cached command. */
386 && !(SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
)
387 && EQ (def1
, XSYMBOL (def
)->function
))
388 /* If something had no key binding before, don't recheck it
389 because that is too slow--except if we have a list of rebound
390 commands in Vdefine_key_rebound_commands, do recheck any command
391 that appears in that list. */
392 && (NILP (cachelist
) || !NILP (savedkey
)
393 || (! EQ (Qt
, Vdefine_key_rebound_commands
)
394 && !NILP (Fmemq (def
, Vdefine_key_rebound_commands
)))))
398 /* If the command is an alias for another
399 (such as easymenu.el and lmenu.el set it up),
400 see if the original command name has equivalent keys. */
401 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
402 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
405 /* Otherwise look up the specified command itself.
406 We don't try both, because that makes easymenu menus slow. */
407 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
409 if (!NILP (savedkey
))
411 descrip
= Fkey_description (savedkey
);
412 descrip
= concat2 (make_string (" (", 3), descrip
);
413 descrip
= concat2 (descrip
, make_string (")", 1));
417 /* Cache the data we just got in a sublist of the menu binding. */
418 if (NILP (cachelist
))
420 CHECK_IMPURE (item1
);
421 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
425 XCONS (cachelist
)->car
= savedkey
;
426 XCONS (cachelist
)->cdr
= descrip
;
430 *descrip_ptr
= descrip
;
434 /* This is used as the handler when calling internal_condition_case_1. */
437 menu_item_enabled_p_1 (arg
)
440 /* If we got a quit from within the menu computation,
441 quit all the way out of it. This takes care of C-] in the debugger. */
442 if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qquit
))
443 Fsignal (Qquit
, Qnil
);
448 /* Return non-nil if the command DEF is enabled when used as a menu item.
449 This is based on looking for a menu-enable property.
450 If NOTREAL is set, don't bother really computing this. */
453 menu_item_enabled_p (def
, notreal
)
457 Lisp_Object enabled
, tem
;
464 /* No property, or nil, means enable.
465 Otherwise, enable if value is not nil. */
466 tem
= Fget (def
, Qmenu_enable
);
468 /* (condition-case nil (eval tem)
470 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
471 menu_item_enabled_p_1
);
476 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
477 and generate menu panes for them in menu_items.
478 If NOTREAL is nonzero,
479 don't bother really computing whether an item is enabled. */
482 keymap_panes (keymaps
, nmaps
, notreal
)
483 Lisp_Object
*keymaps
;
491 /* Loop over the given keymaps, making a pane for each map.
492 But don't make a pane that is empty--ignore that map instead.
493 P is the number of panes we have made so far. */
494 for (mapno
= 0; mapno
< nmaps
; mapno
++)
495 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
497 finish_menu_items ();
500 /* This is a recursive subroutine of keymap_panes.
501 It handles one keymap, KEYMAP.
502 The other arguments are passed along
503 or point to local variables of the previous function.
504 If NOTREAL is nonzero,
505 don't bother really computing whether an item is enabled. */
508 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
510 Lisp_Object pane_name
;
514 Lisp_Object pending_maps
;
515 Lisp_Object tail
, item
, item1
, item_string
, table
;
516 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
520 push_menu_pane (pane_name
, prefix
);
522 for (tail
= keymap
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
524 /* Look at each key binding, and if it has a menu string,
525 make a menu item from it. */
526 item
= XCONS (tail
)->car
;
529 item1
= XCONS (item
)->cdr
;
532 item_string
= XCONS (item1
)->car
;
533 if (STRINGP (item_string
))
535 /* This is the real definition--the function to run. */
537 /* These are the saved equivalent keyboard key sequence
538 and its key-description. */
540 Lisp_Object tem
, enabled
;
542 /* GCPRO because ...enabled_p will call eval
543 and ..._equiv_key may autoload something.
544 Protecting KEYMAP preserves everything we use;
545 aside from that, must protect whatever might be
546 a string. Since there's no GCPRO5, we refetch
547 item_string instead of protecting it. */
548 descrip
= def
= Qnil
;
549 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
551 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
552 enabled
= menu_item_enabled_p (def
, notreal
);
556 item_string
= XCONS (item1
)->car
;
558 tem
= Fkeymapp (def
);
559 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
560 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
565 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
566 submap
= get_keymap_1 (def
, 0, 1);
568 #ifndef USE_X_TOOLKIT
569 /* Indicate visually that this is a submenu. */
571 item_string
= concat2 (item_string
,
572 build_string (" >"));
574 /* If definition is nil, pass nil as the key. */
575 push_menu_item (item_string
, enabled
,
576 XCONS (item
)->car
, def
,
579 /* Display a submenu using the toolkit. */
582 push_submenu_start ();
583 single_keymap_panes (submap
, Qnil
,
584 XCONS (item
)->car
, notreal
);
592 else if (VECTORP (item
))
594 /* Loop over the char values represented in the vector. */
595 int len
= XVECTOR (item
)->size
;
597 for (c
= 0; c
< len
; c
++)
599 Lisp_Object character
;
600 XSETFASTINT (character
, c
);
601 item1
= XVECTOR (item
)->contents
[c
];
604 item_string
= XCONS (item1
)->car
;
605 if (STRINGP (item_string
))
609 /* These are the saved equivalent keyboard key sequence
610 and its key-description. */
612 Lisp_Object tem
, enabled
;
614 /* GCPRO because ...enabled_p will call eval
615 and ..._equiv_key may autoload something.
616 Protecting KEYMAP preserves everything we use;
617 aside from that, must protect whatever might be
618 a string. Since there's no GCPRO5, we refetch
619 item_string instead of protecting it. */
620 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
621 descrip
= def
= Qnil
;
623 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
624 enabled
= menu_item_enabled_p (def
, notreal
);
628 item_string
= XCONS (item1
)->car
;
630 tem
= Fkeymapp (def
);
631 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
632 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
637 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
638 submap
= get_keymap_1 (def
, 0, 1);
640 #ifndef USE_X_TOOLKIT
642 item_string
= concat2 (item_string
,
643 build_string (" >"));
645 /* If definition is nil, pass nil as the key. */
646 push_menu_item (item_string
, enabled
, character
,
651 push_submenu_start ();
652 single_keymap_panes (submap
, Qnil
,
664 /* Process now any submenus which want to be panes at this level. */
665 while (!NILP (pending_maps
))
667 Lisp_Object elt
, eltcdr
, string
;
668 elt
= Fcar (pending_maps
);
669 eltcdr
= XCONS (elt
)->cdr
;
670 string
= XCONS (eltcdr
)->car
;
671 /* We no longer discard the @ from the beginning of the string here.
672 Instead, we do this in xmenu_show. */
673 single_keymap_panes (Fcar (elt
), string
,
674 XCONS (eltcdr
)->cdr
, notreal
);
675 pending_maps
= Fcdr (pending_maps
);
679 /* Push all the panes and items of a menu decsribed by the
680 alist-of-alists MENU.
681 This handles old-fashioned calls to x-popup-menu. */
691 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
693 Lisp_Object elt
, pane_name
, pane_data
;
695 pane_name
= Fcar (elt
);
696 CHECK_STRING (pane_name
, 0);
697 push_menu_pane (pane_name
, Qnil
);
698 pane_data
= Fcdr (elt
);
699 CHECK_CONS (pane_data
, 0);
700 list_of_items (pane_data
);
703 finish_menu_items ();
706 /* Push the items in a single pane defined by the alist PANE. */
712 Lisp_Object tail
, item
, item1
;
714 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
718 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
);
719 else if (NILP (item
))
720 push_left_right_boundary ();
723 CHECK_CONS (item
, 0);
725 CHECK_STRING (item1
, 1);
726 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
);
731 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
732 "Pop up a deck-of-cards menu and return user's selection.\n\
733 POSITION is a position specification. This is either a mouse button event\n\
734 or a list ((XOFFSET YOFFSET) WINDOW)\n\
735 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
736 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
737 This controls the position of the center of the first line\n\
738 in the first pane of the menu, not the top left of the menu as a whole.\n\
739 If POSITION is t, it means to use the current mouse position.\n\
741 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
742 The menu items come from key bindings that have a menu string as well as\n\
743 a definition; actually, the \"definition\" in such a key binding looks like\n\
744 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
745 the keymap as a top-level element.\n\n\
746 You can also use a list of keymaps as MENU.\n\
747 Then each keymap makes a separate pane.\n\
748 When MENU is a keymap or a list of keymaps, the return value\n\
749 is a list of events.\n\n\
750 Alternatively, you can specify a menu of multiple panes\n\
751 with a list of the form (TITLE PANE1 PANE2...),\n\
752 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
753 Each ITEM is normally a cons cell (STRING . VALUE);\n\
754 but a string can appear as an item--that makes a nonselectable line\n\
756 With this form of menu, the return value is VALUE from the chosen item.\n\
758 If POSITION is nil, don't display the menu at all, just precalculate the\n\
759 cached information about equivalent key sequences.")
761 Lisp_Object position
, menu
;
763 int number_of_panes
, panes
;
764 Lisp_Object keymap
, tem
;
768 Lisp_Object selection
;
771 Lisp_Object x
, y
, window
;
776 if (! NILP (position
))
780 /* Decode the first argument: find the window and the coordinates. */
781 if (EQ (position
, Qt
)
782 || (CONSP (position
) && EQ (XCONS (position
)->car
, Qmenu_bar
)))
784 /* Use the mouse's current position. */
785 FRAME_PTR new_f
= selected_frame
;
786 Lisp_Object bar_window
;
790 if (mouse_position_hook
)
791 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
792 &part
, &x
, &y
, &time
);
794 XSETFRAME (window
, new_f
);
797 window
= selected_window
;
804 tem
= Fcar (position
);
807 window
= Fcar (Fcdr (position
));
809 y
= Fcar (Fcdr (tem
));
814 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
815 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
816 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
825 /* Decode where to put the menu. */
833 else if (WINDOWP (window
))
835 CHECK_LIVE_WINDOW (window
, 0);
836 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
838 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
839 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
842 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
843 but I don't want to make one now. */
844 CHECK_WINDOW (window
, 0);
853 /* Decode the menu items from what was specified. */
855 keymap
= Fkeymapp (menu
);
858 tem
= Fkeymapp (Fcar (menu
));
861 /* We were given a keymap. Extract menu info from the keymap. */
863 keymap
= get_keymap (menu
);
865 /* Extract the detailed info to make one pane. */
866 keymap_panes (&menu
, 1, NILP (position
));
868 /* Search for a string appearing directly as an element of the keymap.
869 That string is the title of the menu. */
870 prompt
= map_prompt (keymap
);
872 /* Make that be the pane title of the first pane. */
873 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
874 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
878 else if (!NILP (tem
))
880 /* We were given a list of keymaps. */
881 int nmaps
= XFASTINT (Flength (menu
));
883 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
888 /* The first keymap that has a prompt string
889 supplies the menu title. */
890 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
894 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
896 prompt
= map_prompt (keymap
);
897 if (NILP (title
) && !NILP (prompt
))
901 /* Extract the detailed info to make one pane. */
902 keymap_panes (maps
, nmaps
, NILP (position
));
904 /* Make the title be the pane title of the first pane. */
905 if (!NILP (title
) && menu_items_n_panes
>= 0)
906 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
912 /* We were given an old-fashioned menu. */
914 CHECK_STRING (title
, 1);
916 list_of_panes (Fcdr (menu
));
923 discard_menu_items ();
928 /* Display them in a menu. */
931 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
932 keymaps
, title
, &error_name
);
935 discard_menu_items ();
939 if (error_name
) error (error_name
);
943 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
944 "Pop up a dialog box and return user's selection.\n\
945 POSITION specifies which frame to use.\n\
946 This is normally a mouse button event or a window or frame.\n\
947 If POSITION is t, it means to use the frame the mouse is on.\n\
948 The dialog box appears in the middle of the specified frame.\n\
950 CONTENTS specifies the alternatives to display in the dialog box.\n\
951 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
952 Each ITEM is a cons cell (STRING . VALUE).\n\
953 The return value is VALUE from the chosen item.\n\n\
954 An ITEM may also be just a string--that makes a nonselectable item.\n\
955 An ITEM may also be nil--that means to put all preceding items\n\
956 on the left of the dialog box and all following items on the right.\n\
957 \(By default, approximately half appear on each side.)")
959 Lisp_Object position
, contents
;
966 /* Decode the first argument: find the window or frame to use. */
967 if (EQ (position
, Qt
)
968 || (CONSP (position
) && EQ (XCONS (position
)->car
, Qmenu_bar
)))
970 #if 0 /* Using the frame the mouse is on may not be right. */
971 /* Use the mouse's current position. */
972 FRAME_PTR new_f
= selected_frame
;
973 Lisp_Object bar_window
;
978 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
981 XSETFRAME (window
, new_f
);
983 window
= selected_window
;
985 window
= selected_window
;
987 else if (CONSP (position
))
990 tem
= Fcar (position
);
992 window
= Fcar (Fcdr (position
));
995 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
996 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
999 else if (WINDOWP (position
) || FRAMEP (position
))
1002 /* Decode where to put the menu. */
1004 if (FRAMEP (window
))
1005 f
= XFRAME (window
);
1006 else if (WINDOWP (window
))
1008 CHECK_LIVE_WINDOW (window
, 0);
1009 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
1012 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1013 but I don't want to make one now. */
1014 CHECK_WINDOW (window
, 0);
1016 #ifndef USE_X_TOOLKIT
1017 /* Display a menu with these alternatives
1018 in the middle of frame F. */
1020 Lisp_Object x
, y
, frame
, newpos
;
1021 XSETFRAME (frame
, f
);
1022 XSETINT (x
, x_pixel_width (f
) / 2);
1023 XSETINT (y
, x_pixel_height (f
) / 2);
1024 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
1026 return Fx_popup_menu (newpos
,
1027 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
1033 Lisp_Object selection
;
1035 /* Decode the dialog items from what was specified. */
1036 title
= Fcar (contents
);
1037 CHECK_STRING (title
, 1);
1039 list_of_panes (Fcons (contents
, Qnil
));
1041 /* Display them in a dialog box. */
1043 selection
= xdialog_show (f
, 0, title
, &error_name
);
1046 discard_menu_items ();
1048 if (error_name
) error (error_name
);
1054 #ifdef USE_X_TOOLKIT
1056 /* Loop in Xt until the menu pulldown or dialog popup has been
1057 popped down (deactivated).
1059 NOTE: All calls to popup_get_selection should be protected
1060 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1063 popup_get_selection (initial_event
, dpyinfo
, id
)
1064 XEvent
*initial_event
;
1065 struct x_display_info
*dpyinfo
;
1070 /* Define a queue to save up for later unreading
1071 all X events that don't pertain to the menu. */
1075 struct event_queue
*next
;
1078 struct event_queue
*queue
= NULL
;
1079 struct event_queue
*queue_tmp
;
1082 event
= *initial_event
;
1084 XtAppNextEvent (Xt_app_con
, &event
);
1088 /* Handle expose events for editor frames right away. */
1089 if (event
.type
== Expose
)
1090 process_expose_from_menu (event
);
1091 /* Make sure we don't consider buttons grabbed after menu goes. */
1092 else if (event
.type
== ButtonRelease
1093 && dpyinfo
->display
== event
.xbutton
.display
)
1094 dpyinfo
->grabbed
&= ~(1 << event
.xbutton
.button
);
1095 /* If the user presses a key, deactivate the menu.
1096 The user is likely to do that if we get wedged. */
1097 else if (event
.type
== KeyPress
1098 && dpyinfo
->display
== event
.xbutton
.display
)
1100 popup_activated_flag
= 0;
1104 /* Queue all events not for this popup,
1105 except for Expose, which we've already handled.
1106 Note that the X window is associated with the frame if this
1107 is a menu bar popup, but not if it's a dialog box. So we use
1108 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1109 if (event
.type
!= Expose
1110 && (event
.xany
.display
!= dpyinfo
->display
1111 || x_non_menubar_window_to_frame (dpyinfo
, event
.xany
.window
)))
1113 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1115 if (queue_tmp
!= NULL
)
1117 queue_tmp
->event
= event
;
1118 queue_tmp
->next
= queue
;
1123 XtDispatchEvent (&event
);
1125 if (!popup_activated ())
1127 XtAppNextEvent (Xt_app_con
, &event
);
1130 /* Unread any events that we got but did not handle. */
1131 while (queue
!= NULL
)
1134 XPutBackEvent (queue_tmp
->event
.xany
.display
, &queue_tmp
->event
);
1135 queue
= queue_tmp
->next
;
1136 free ((char *)queue_tmp
);
1137 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1138 interrupt_input_pending
= 1;
1142 /* Detect if a dialog or menu has been posted. */
1147 return popup_activated_flag
;
1151 /* This callback is invoked when the user selects a menubar cascade
1152 pushbutton, but before the pulldown menu is posted. */
1155 popup_activate_callback (widget
, id
, client_data
)
1158 XtPointer client_data
;
1160 popup_activated_flag
= 1;
1163 /* This callback is called from the menu bar pulldown menu
1164 when the user makes a selection.
1165 Figure out what the user chose
1166 and put the appropriate events into the keyboard buffer. */
1169 menubar_selection_callback (widget
, id
, client_data
)
1172 XtPointer client_data
;
1174 Lisp_Object prefix
, entry
;
1175 FRAME_PTR f
= XFRAME (XVECTOR (frame_vector
)->contents
[id
]);
1177 Lisp_Object
*subprefix_stack
;
1178 int submenu_depth
= 0;
1183 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1184 vector
= f
->menu_bar_vector
;
1187 while (i
< f
->menu_bar_items_used
)
1189 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1191 subprefix_stack
[submenu_depth
++] = prefix
;
1195 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1197 prefix
= subprefix_stack
[--submenu_depth
];
1200 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1202 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1203 i
+= MENU_ITEMS_PANE_LENGTH
;
1207 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1208 /* The EMACS_INT cast avoids a warning. There's no problem
1209 as long as pointers have enough bits to hold small integers. */
1210 if ((int) (EMACS_INT
) client_data
== i
)
1213 struct input_event buf
;
1216 XSETFRAME (frame
, f
);
1217 buf
.kind
= menu_bar_event
;
1218 buf
.frame_or_window
= Fcons (frame
, Fcons (Qmenu_bar
, Qnil
));
1219 kbd_buffer_store_event (&buf
);
1221 for (j
= 0; j
< submenu_depth
; j
++)
1222 if (!NILP (subprefix_stack
[j
]))
1224 buf
.kind
= menu_bar_event
;
1225 buf
.frame_or_window
= Fcons (frame
, subprefix_stack
[j
]);
1226 kbd_buffer_store_event (&buf
);
1231 buf
.kind
= menu_bar_event
;
1232 buf
.frame_or_window
= Fcons (frame
, prefix
);
1233 kbd_buffer_store_event (&buf
);
1236 buf
.kind
= menu_bar_event
;
1237 buf
.frame_or_window
= Fcons (frame
, entry
);
1238 kbd_buffer_store_event (&buf
);
1242 i
+= MENU_ITEMS_ITEM_LENGTH
;
1247 /* This callback is invoked when a dialog or menu is finished being
1248 used and has been unposted. */
1251 popup_deactivate_callback (widget
, id
, client_data
)
1254 XtPointer client_data
;
1256 popup_activated_flag
= 0;
1260 /* This recursively calls free_widget_value on the tree of widgets.
1261 It must free all data that was malloc'ed for these widget_values.
1262 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1263 must be left alone. */
1266 free_menubar_widget_value_tree (wv
)
1271 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1273 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1275 free_menubar_widget_value_tree (wv
->contents
);
1276 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1280 free_menubar_widget_value_tree (wv
->next
);
1281 wv
->next
= (widget_value
*) 0xDEADBEEF;
1284 free_widget_value (wv
);
1288 /* Return a tree of widget_value structures for a menu bar item
1289 whose event type is ITEM_KEY (with string ITEM_NAME)
1290 and whose contents come from the list of keymaps MAPS. */
1292 static widget_value
*
1293 single_submenu (item_key
, item_name
, maps
)
1294 Lisp_Object item_key
, item_name
, maps
;
1296 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1298 int submenu_depth
= 0;
1301 Lisp_Object
*mapvec
;
1302 widget_value
**submenu_stack
;
1304 int previous_items
= menu_items_used
;
1305 int top_level_items
= 0;
1307 length
= Flength (maps
);
1308 len
= XINT (length
);
1310 /* Convert the list MAPS into a vector MAPVEC. */
1311 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1312 for (i
= 0; i
< len
; i
++)
1314 mapvec
[i
] = Fcar (maps
);
1318 menu_items_n_panes
= 0;
1320 /* Loop over the given keymaps, making a pane for each map.
1321 But don't make a pane that is empty--ignore that map instead. */
1322 for (i
= 0; i
< len
; i
++)
1324 if (SYMBOLP (mapvec
[i
]))
1326 top_level_items
= 1;
1327 push_menu_pane (Qnil
, Qnil
);
1328 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
], Qnil
);
1331 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0);
1334 /* Create a tree of widget_value objects
1335 representing the panes and their items. */
1338 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1339 wv
= malloc_widget_value ();
1347 /* Loop over all panes and items made during this call
1348 and construct a tree of widget_value objects.
1349 Ignore the panes and items made by previous calls to
1350 single_submenu, even though those are also in menu_items. */
1352 while (i
< menu_items_used
)
1354 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1356 submenu_stack
[submenu_depth
++] = save_wv
;
1361 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1364 save_wv
= submenu_stack
[--submenu_depth
];
1367 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1368 && submenu_depth
!= 0)
1369 i
+= MENU_ITEMS_PANE_LENGTH
;
1370 /* Ignore a nil in the item list.
1371 It's meaningful only for dialog boxes. */
1372 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1374 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1376 /* Create a new pane. */
1377 Lisp_Object pane_name
, prefix
;
1379 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1380 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1381 pane_string
= (NILP (pane_name
)
1382 ? "" : (char *) XSTRING (pane_name
)->data
);
1383 /* If there is just one top-level pane, put all its items directly
1384 under the top-level menu. */
1385 if (menu_items_n_panes
== 1)
1388 /* If the pane has a meaningful name,
1389 make the pane a top-level menu item
1390 with its items as a submenu beneath it. */
1391 if (strcmp (pane_string
, ""))
1393 wv
= malloc_widget_value ();
1397 first_wv
->contents
= wv
;
1398 wv
->name
= pane_string
;
1406 i
+= MENU_ITEMS_PANE_LENGTH
;
1410 /* Create a new item within current pane. */
1411 Lisp_Object item_name
, enable
, descrip
, def
;
1412 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1413 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1415 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1416 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1418 wv
= malloc_widget_value ();
1422 save_wv
->contents
= wv
;
1424 wv
->name
= (char *) XSTRING (item_name
)->data
;
1425 if (!NILP (descrip
))
1426 wv
->key
= (char *) XSTRING (descrip
)->data
;
1428 /* The EMACS_INT cast avoids a warning. There's no problem
1429 as long as pointers have enough bits to hold small integers. */
1430 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1431 wv
->enabled
= !NILP (enable
);
1434 i
+= MENU_ITEMS_ITEM_LENGTH
;
1438 /* If we have just one "menu item"
1439 that was originally a button, return it by itself. */
1440 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1442 wv
= first_wv
->contents
;
1443 free_widget_value (first_wv
);
1450 extern void EmacsFrameSetCharSize ();
1452 /* Recompute all the widgets of frame F, when the menu bar
1453 has been changed. */
1456 update_frame_menubar (f
)
1459 struct x_display
*x
= f
->display
.x
;
1461 int menubar_changed
;
1463 Dimension shell_height
;
1465 /* We assume the menubar contents has changed if the global flag is set,
1466 or if the current buffer has changed, or if the menubar has never
1467 been updated before.
1469 menubar_changed
= (x
->menubar_widget
1470 && !XtIsManaged (x
->menubar_widget
));
1472 if (! (menubar_changed
))
1476 /* Save the size of the frame because the pane widget doesn't accept to
1477 resize itself. So force it. */
1481 /* Do the voodoo which means "I'm changing lots of things, don't try to
1482 refigure sizes until I'm done." */
1483 lw_refigure_widget (x
->column_widget
, False
);
1485 /* the order in which children are managed is the top to
1486 bottom order in which they are displayed in the paned window.
1487 First, remove the text-area widget.
1489 XtUnmanageChild (x
->edit_widget
);
1491 /* remove the menubar that is there now, and put up the menubar that
1494 if (menubar_changed
)
1496 XtManageChild (x
->menubar_widget
);
1497 XtMapWidget (x
->menubar_widget
);
1498 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1501 /* Re-manage the text-area widget, and then thrash the sizes. */
1502 XtManageChild (x
->edit_widget
);
1503 lw_refigure_widget (x
->column_widget
, True
);
1505 /* Force the pane widget to resize itself with the right values. */
1506 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1511 /* Set the contents of the menubar widgets of frame F.
1512 The argument FIRST_TIME is currently ignored;
1513 it is set the first time this is called, from initialize_frame_menubar. */
1516 set_frame_menubar (f
, first_time
)
1520 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1521 Lisp_Object tail
, items
, frame
;
1522 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1526 int specpdl_count
= specpdl_ptr
- specpdl
;
1528 count
= inhibit_garbage_collection ();
1530 specbind (Qinhibit_quit
, Qt
);
1531 /* Don't let the debugger step into this code
1532 because it is not reentrant. */
1533 specbind (Qdebug_on_next_call
, Qnil
);
1535 id
= frame_vector_add_frame (f
);
1537 wv
= malloc_widget_value ();
1538 wv
->name
= "menubar";
1542 items
= FRAME_MENU_BAR_ITEMS (f
);
1543 menu_items
= f
->menu_bar_vector
;
1544 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1547 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1549 Lisp_Object key
, string
, maps
;
1551 key
= XVECTOR (items
)->contents
[i
];
1552 string
= XVECTOR (items
)->contents
[i
+ 1];
1553 maps
= XVECTOR (items
)->contents
[i
+ 2];
1557 wv
= single_submenu (key
, string
, maps
);
1561 first_wv
->contents
= wv
;
1562 /* Don't set wv->name here; GC during the loop might relocate it. */
1567 /* Now GC cannot happen during the lifetime of the widget_value,
1568 so it's safe to store data from a Lisp_String. */
1569 wv
= first_wv
->contents
;
1570 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1573 string
= XVECTOR (items
)->contents
[i
+ 1];
1576 wv
->name
= (char *) XSTRING (string
)->data
;
1580 finish_menu_items ();
1582 f
->menu_bar_vector
= menu_items
;
1583 f
->menu_bar_items_used
= menu_items_used
;
1586 unbind_to (count
, Qnil
);
1592 /* Disable resizing (done for Motif!) */
1593 lw_allow_resizing (f
->display
.x
->widget
, False
);
1595 /* The third arg is DEEP_P, which says to consider the entire
1596 menu trees we supply, rather than just the menu bar item names. */
1597 lw_modify_all_widgets ((LWLIB_ID
) id
, first_wv
, 1);
1599 /* Re-enable the edit widget to resize. */
1600 lw_allow_resizing (f
->display
.x
->widget
, True
);
1604 menubar_widget
= lw_create_widget ("menubar", "menubar",
1605 (LWLIB_ID
) id
, first_wv
,
1606 f
->display
.x
->column_widget
,
1608 popup_activate_callback
,
1609 menubar_selection_callback
,
1610 popup_deactivate_callback
);
1611 f
->display
.x
->menubar_widget
= menubar_widget
;
1616 = (f
->display
.x
->menubar_widget
1617 ? (f
->display
.x
->menubar_widget
->core
.height
1618 + f
->display
.x
->menubar_widget
->core
.border_width
)
1621 if (FRAME_EXTERNAL_MENU_BAR (f
))
1624 XtVaGetValues (f
->display
.x
->column_widget
,
1625 XtNinternalBorderWidth
, &ibw
, NULL
);
1626 menubar_size
+= ibw
;
1629 f
->display
.x
->menubar_height
= menubar_size
;
1632 free_menubar_widget_value_tree (first_wv
);
1634 update_frame_menubar (f
);
1636 unbind_to (specpdl_count
, Qnil
);
1641 /* Called from Fx_create_frame to create the inital menubar of a frame
1642 before it is mapped, so that the window is mapped with the menubar already
1643 there instead of us tacking it on later and thrashing the window after it
1647 initialize_frame_menubar (f
)
1650 /* This function is called before the first chance to redisplay
1651 the frame. It has to be, so the frame will have the right size. */
1652 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1653 set_frame_menubar (f
, 1);
1656 /* Get rid of the menu bar of frame F, and free its storage.
1657 This is used when deleting a frame, and when turning off the menu bar. */
1660 free_frame_menubar (f
)
1663 Widget menubar_widget
;
1666 menubar_widget
= f
->display
.x
->menubar_widget
;
1670 id
= frame_vector_add_frame (f
);
1672 lw_destroy_all_widgets ((LWLIB_ID
) id
);
1673 XVECTOR (frame_vector
)->contents
[id
] = Qnil
;
1678 #endif /* USE_X_TOOLKIT */
1680 /* xmenu_show actually displays a menu using the panes and items in menu_items
1681 and returns the value selected from it.
1682 There are two versions of xmenu_show, one for Xt and one for Xlib.
1683 Both assume input is blocked by the caller. */
1685 /* F is the frame the menu is for.
1686 X and Y are the frame-relative specified position,
1687 relative to the inside upper left corner of the frame F.
1688 FOR_CLICK if this menu was invoked for a mouse click.
1689 KEYMAPS is 1 if this menu was specified with keymaps;
1690 in that case, we return a list containing the chosen item's value
1691 and perhaps also the pane's prefix.
1692 TITLE is the specified menu title.
1693 ERROR is a place to store an error message string in case of failure.
1694 (We return nil on failure, but the value doesn't actually matter.) */
1696 #ifdef USE_X_TOOLKIT
1698 /* We need a unique id for each widget handled by the Lucid Widget
1701 For the main windows, and popup menus, we use this counter,
1702 which we increment each time after use.
1704 For menu bars, we use the index of the frame in frame_vector
1706 LWLIB_ID widget_id_tick
;
1709 static Lisp_Object
*volatile menu_item_selection
;
1711 static Lisp_Object
*menu_item_selection
;
1715 popup_selection_callback (widget
, id
, client_data
)
1718 XtPointer client_data
;
1720 menu_item_selection
= (Lisp_Object
*) client_data
;
1724 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1738 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1739 widget_value
**submenu_stack
1740 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1741 Lisp_Object
*subprefix_stack
1742 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1743 int submenu_depth
= 0;
1745 Position root_x
, root_y
;
1748 int next_release_must_exit
= 0;
1752 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1754 *error
= "Empty menu";
1758 /* Create a tree of widget_value objects
1759 representing the panes and their items. */
1760 wv
= malloc_widget_value ();
1767 /* Loop over all panes and items, filling in the tree. */
1769 while (i
< menu_items_used
)
1771 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1773 submenu_stack
[submenu_depth
++] = save_wv
;
1779 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1782 save_wv
= submenu_stack
[--submenu_depth
];
1786 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1787 && submenu_depth
!= 0)
1788 i
+= MENU_ITEMS_PANE_LENGTH
;
1789 /* Ignore a nil in the item list.
1790 It's meaningful only for dialog boxes. */
1791 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1793 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1795 /* Create a new pane. */
1796 Lisp_Object pane_name
, prefix
;
1798 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1799 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1800 pane_string
= (NILP (pane_name
)
1801 ? "" : (char *) XSTRING (pane_name
)->data
);
1802 /* If there is just one top-level pane, put all its items directly
1803 under the top-level menu. */
1804 if (menu_items_n_panes
== 1)
1807 /* If the pane has a meaningful name,
1808 make the pane a top-level menu item
1809 with its items as a submenu beneath it. */
1810 if (!keymaps
&& strcmp (pane_string
, ""))
1812 wv
= malloc_widget_value ();
1816 first_wv
->contents
= wv
;
1817 wv
->name
= pane_string
;
1818 if (keymaps
&& !NILP (prefix
))
1825 else if (first_pane
)
1831 i
+= MENU_ITEMS_PANE_LENGTH
;
1835 /* Create a new item within current pane. */
1836 Lisp_Object item_name
, enable
, descrip
, def
;
1837 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1838 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1840 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1841 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1843 wv
= malloc_widget_value ();
1847 save_wv
->contents
= wv
;
1848 wv
->name
= (char *) XSTRING (item_name
)->data
;
1849 if (!NILP (descrip
))
1850 wv
->key
= (char *) XSTRING (descrip
)->data
;
1852 /* If this item has a null value,
1853 make the call_data null so that it won't display a box
1854 when the mouse is on it. */
1856 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
1857 wv
->enabled
= !NILP (enable
);
1860 i
+= MENU_ITEMS_ITEM_LENGTH
;
1864 /* Deal with the title, if it is non-nil. */
1867 widget_value
*wv_title
= malloc_widget_value ();
1868 widget_value
*wv_sep1
= malloc_widget_value ();
1869 widget_value
*wv_sep2
= malloc_widget_value ();
1871 wv_sep2
->name
= "--";
1872 wv_sep2
->next
= first_wv
->contents
;
1874 wv_sep1
->name
= "--";
1875 wv_sep1
->next
= wv_sep2
;
1877 wv_title
->name
= (char *) XSTRING (title
)->data
;
1878 wv_title
->enabled
= True
;
1879 wv_title
->next
= wv_sep1
;
1880 first_wv
->contents
= wv_title
;
1883 /* Actually create the menu. */
1884 menu_id
= widget_id_tick
++;
1885 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1886 f
->display
.x
->widget
, 1, 0,
1887 popup_selection_callback
,
1888 popup_deactivate_callback
);
1890 /* Don't allow any geometry request from the user. */
1891 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
1892 XtSetValues (menu
, av
, ac
);
1894 /* Free the widget_value objects we used to specify the contents. */
1895 free_menubar_widget_value_tree (first_wv
);
1897 /* No selection has been chosen yet. */
1898 menu_item_selection
= 0;
1900 /* Display the menu. */
1901 lw_popup_menu (menu
);
1902 popup_activated_flag
= 1;
1904 /* Process events that apply to the menu. */
1905 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), menu_id
);
1907 /* fp turned off the following statement and wrote a comment
1908 that it is unnecessary--that the menu has already disappeared.
1909 Nowadays the menu disappears ok, all right, but
1910 we need to delete the widgets or multiple ones will pile up. */
1911 lw_destroy_all_widgets (menu_id
);
1913 /* Find the selected item, and its pane, to return
1914 the proper value. */
1915 if (menu_item_selection
!= 0)
1917 Lisp_Object prefix
, entry
;
1921 while (i
< menu_items_used
)
1923 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1925 subprefix_stack
[submenu_depth
++] = prefix
;
1929 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1931 prefix
= subprefix_stack
[--submenu_depth
];
1934 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1937 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1938 i
+= MENU_ITEMS_PANE_LENGTH
;
1943 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1944 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1950 entry
= Fcons (entry
, Qnil
);
1952 entry
= Fcons (prefix
, entry
);
1953 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1954 if (!NILP (subprefix_stack
[j
]))
1955 entry
= Fcons (subprefix_stack
[j
], entry
);
1959 i
+= MENU_ITEMS_ITEM_LENGTH
;
1968 dialog_selection_callback (widget
, id
, client_data
)
1971 XtPointer client_data
;
1973 /* The EMACS_INT cast avoids a warning. There's no problem
1974 as long as pointers have enough bits to hold small integers. */
1975 if ((int) (EMACS_INT
) client_data
!= -1)
1976 menu_item_selection
= (Lisp_Object
*) client_data
;
1978 lw_destroy_all_widgets (id
);
1980 popup_activated_flag
= 0;
1983 static char * button_names
[] = {
1984 "button1", "button2", "button3", "button4", "button5",
1985 "button6", "button7", "button8", "button9", "button10" };
1988 xdialog_show (f
, keymaps
, title
, error
)
1994 int i
, nb_buttons
=0;
1997 char dialog_name
[6];
1999 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
2001 /* Number of elements seen so far, before boundary. */
2003 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2004 int boundary_seen
= 0;
2008 if (menu_items_n_panes
> 1)
2010 *error
= "Multiple panes in dialog box";
2014 /* Create a tree of widget_value objects
2015 representing the text label and buttons. */
2017 Lisp_Object pane_name
, prefix
;
2019 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2020 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2021 pane_string
= (NILP (pane_name
)
2022 ? "" : (char *) XSTRING (pane_name
)->data
);
2023 prev_wv
= malloc_widget_value ();
2024 prev_wv
->value
= pane_string
;
2025 if (keymaps
&& !NILP (prefix
))
2027 prev_wv
->enabled
= 1;
2028 prev_wv
->name
= "message";
2031 /* Loop over all panes and items, filling in the tree. */
2032 i
= MENU_ITEMS_PANE_LENGTH
;
2033 while (i
< menu_items_used
)
2036 /* Create a new item within current pane. */
2037 Lisp_Object item_name
, enable
, descrip
;
2038 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2039 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2041 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2043 if (NILP (item_name
))
2045 free_menubar_widget_value_tree (first_wv
);
2046 *error
= "Submenu in dialog items";
2049 if (EQ (item_name
, Qquote
))
2051 /* This is the boundary between left-side elts
2052 and right-side elts. Stop incrementing right_count. */
2057 if (nb_buttons
>= 10)
2059 free_menubar_widget_value_tree (first_wv
);
2060 *error
= "Too many dialog items";
2064 wv
= malloc_widget_value ();
2066 wv
->name
= (char *) button_names
[nb_buttons
];
2067 if (!NILP (descrip
))
2068 wv
->key
= (char *) XSTRING (descrip
)->data
;
2069 wv
->value
= (char *) XSTRING (item_name
)->data
;
2070 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
2071 wv
->enabled
= !NILP (enable
);
2074 if (! boundary_seen
)
2078 i
+= MENU_ITEMS_ITEM_LENGTH
;
2081 /* If the boundary was not specified,
2082 by default put half on the left and half on the right. */
2083 if (! boundary_seen
)
2084 left_count
= nb_buttons
- nb_buttons
/ 2;
2086 wv
= malloc_widget_value ();
2087 wv
->name
= dialog_name
;
2089 /* Dialog boxes use a really stupid name encoding
2090 which specifies how many buttons to use
2091 and how many buttons are on the right.
2092 The Q means something also. */
2093 dialog_name
[0] = 'Q';
2094 dialog_name
[1] = '0' + nb_buttons
;
2095 dialog_name
[2] = 'B';
2096 dialog_name
[3] = 'R';
2097 /* Number of buttons to put on the right. */
2098 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2100 wv
->contents
= first_wv
;
2104 /* Actually create the dialog. */
2105 dialog_id
= widget_id_tick
++;
2106 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2107 f
->display
.x
->widget
, 1, 0,
2108 dialog_selection_callback
, 0);
2109 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2110 /* Free the widget_value objects we used to specify the contents. */
2111 free_menubar_widget_value_tree (first_wv
);
2113 /* No selection has been chosen yet. */
2114 menu_item_selection
= 0;
2116 /* Display the menu. */
2117 lw_pop_up_all_widgets (dialog_id
);
2118 popup_activated_flag
= 1;
2120 /* Process events that apply to the menu. */
2121 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2123 lw_destroy_all_widgets (dialog_id
);
2125 /* Find the selected item, and its pane, to return
2126 the proper value. */
2127 if (menu_item_selection
!= 0)
2133 while (i
< menu_items_used
)
2137 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2140 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2141 i
+= MENU_ITEMS_PANE_LENGTH
;
2146 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2147 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2151 entry
= Fcons (entry
, Qnil
);
2153 entry
= Fcons (prefix
, entry
);
2157 i
+= MENU_ITEMS_ITEM_LENGTH
;
2164 #else /* not USE_X_TOOLKIT */
2167 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2177 int pane
, selidx
, lpane
, status
;
2178 Lisp_Object entry
, pane_prefix
;
2180 int ulx
, uly
, width
, height
;
2181 int dispwidth
, dispheight
;
2185 unsigned int dummy_uint
;
2188 if (menu_items_n_panes
== 0)
2191 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2193 *error
= "Empty menu";
2197 /* Figure out which root window F is on. */
2198 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2199 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2200 &dummy_uint
, &dummy_uint
);
2202 /* Make the menu on that window. */
2203 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2206 *error
= "Can't create menu";
2210 #ifdef HAVE_X_WINDOWS
2211 /* Adjust coordinates to relative to the outer (window manager) window. */
2214 int win_x
= 0, win_y
= 0;
2216 /* Find the position of the outside upper-left corner of
2217 the inner window, with respect to the outer window. */
2218 if (f
->display
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2221 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2223 /* From-window, to-window. */
2224 f
->display
.x
->window_desc
,
2225 f
->display
.x
->parent_desc
,
2227 /* From-position, to-position. */
2228 0, 0, &win_x
, &win_y
,
2230 /* Child of window. */
2237 #endif /* HAVE_X_WINDOWS */
2239 /* Adjust coordinates to be root-window-relative. */
2240 x
+= f
->display
.x
->left_pos
;
2241 y
+= f
->display
.x
->top_pos
;
2243 /* Create all the necessary panes and their items. */
2245 while (i
< menu_items_used
)
2247 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2249 /* Create a new pane. */
2250 Lisp_Object pane_name
, prefix
;
2253 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2254 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2255 pane_string
= (NILP (pane_name
)
2256 ? "" : (char *) XSTRING (pane_name
)->data
);
2257 if (keymaps
&& !NILP (prefix
))
2260 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2261 if (lpane
== XM_FAILURE
)
2263 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2264 *error
= "Can't create pane";
2267 i
+= MENU_ITEMS_PANE_LENGTH
;
2269 /* Find the width of the widest item in this pane. */
2272 while (j
< menu_items_used
)
2275 item
= XVECTOR (menu_items
)->contents
[j
];
2283 width
= XSTRING (item
)->size
;
2284 if (width
> maxwidth
)
2287 j
+= MENU_ITEMS_ITEM_LENGTH
;
2290 /* Ignore a nil in the item list.
2291 It's meaningful only for dialog boxes. */
2292 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2296 /* Create a new item within current pane. */
2297 Lisp_Object item_name
, enable
, descrip
;
2298 unsigned char *item_data
;
2300 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2301 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2303 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2304 if (!NILP (descrip
))
2306 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2309 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2310 item_name
= concat2 (item_name
, spacer
);
2311 item_name
= concat2 (item_name
, descrip
);
2312 item_data
= XSTRING (item_name
)->data
;
2314 /* if alloca is fast, use that to make the space,
2315 to reduce gc needs. */
2317 = (unsigned char *) alloca (maxwidth
2318 + XSTRING (descrip
)->size
+ 1);
2319 bcopy (XSTRING (item_name
)->data
, item_data
,
2320 XSTRING (item_name
)->size
);
2321 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2323 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2324 XSTRING (descrip
)->size
);
2325 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2329 item_data
= XSTRING (item_name
)->data
;
2331 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2332 menu
, lpane
, 0, item_data
,
2336 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2337 *error
= "Can't add selection to menu";
2340 i
+= MENU_ITEMS_ITEM_LENGTH
;
2344 /* All set and ready to fly. */
2345 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2346 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
),
2347 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)));
2348 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
),
2349 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)));
2350 x
= min (x
, dispwidth
);
2351 y
= min (y
, dispheight
);
2354 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2355 &ulx
, &uly
, &width
, &height
);
2356 if (ulx
+width
> dispwidth
)
2358 x
-= (ulx
+ width
) - dispwidth
;
2359 ulx
= dispwidth
- width
;
2361 if (uly
+height
> dispheight
)
2363 y
-= (uly
+ height
) - dispheight
;
2364 uly
= dispheight
- height
;
2366 if (ulx
< 0) x
-= ulx
;
2367 if (uly
< 0) y
-= uly
;
2369 XMenuSetAEQ (menu
, TRUE
);
2370 XMenuSetFreeze (menu
, TRUE
);
2373 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2374 x
, y
, ButtonReleaseMask
, &datap
);
2377 #ifdef HAVE_X_WINDOWS
2378 /* Assume the mouse has moved out of the X window.
2379 If it has actually moved in, we will get an EnterNotify. */
2380 x_mouse_leave (FRAME_X_DISPLAY_INFO (f
));
2387 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2390 /* Find the item number SELIDX in pane number PANE. */
2392 while (i
< menu_items_used
)
2394 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2398 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2400 i
+= MENU_ITEMS_PANE_LENGTH
;
2409 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2412 entry
= Fcons (entry
, Qnil
);
2413 if (!NILP (pane_prefix
))
2414 entry
= Fcons (pane_prefix
, entry
);
2420 i
+= MENU_ITEMS_ITEM_LENGTH
;
2426 *error
= "Can't activate menu";
2432 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2434 #ifdef HAVE_X_WINDOWS
2435 /* State that no mouse buttons are now held.
2436 (The oldXMenu code doesn't track this info for us.)
2437 That is not necessarily true, but the fiction leads to reasonable
2438 results, and it is a pain to ask which are actually held now. */
2439 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2445 #endif /* not USE_X_TOOLKIT */
2449 staticpro (&menu_items
);
2452 Qdebug_on_next_call
= intern ("debug-on-next-call");
2453 staticpro (&Qdebug_on_next_call
);
2455 #ifdef USE_X_TOOLKIT
2456 widget_id_tick
= (1<<16);
2459 staticpro (&frame_vector
);
2460 frame_vector
= Fmake_vector (make_number (10), Qnil
);
2462 defsubr (&Sx_popup_menu
);
2463 defsubr (&Sx_popup_dialog
);