1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* X pop-up deck-of-cards menu facility for gnuemacs.
22 * Written by Jon Arnold and Roman Budzianowski
23 * Mods and rewrite by Robert Krawitz
27 /* Modified by Fred Pierresteguy on December 93
28 to make the popup menus and menubar use the Xt. */
30 /* Rewritten for clarity and GC protection by rms in Feb 94. */
32 /* On 4.3 this loses if it comes after xterm.h. */
38 #include "termhooks.h"
42 #include "blockinput.h"
45 /* This may include sys/types.h, and that somehow loses
46 if this is not done before the other system files. */
49 /* Load sys/types.h if not already loaded.
50 In some systems loading it twice is suicidal. */
52 #include <sys/types.h>
55 #include "dispextern.h"
58 #include "../oldXMenu/XMenu.h"
65 #include <X11/IntrinsicP.h>
66 #include <X11/CoreP.h>
67 #include <X11/StringDefs.h>
68 #include <X11/Shell.h>
69 #include "../lwlib/lwlib.h"
70 #endif /* USE_X_TOOLKIT */
72 #define min(x,y) (((x) < (y)) ? (x) : (y))
73 #define max(x,y) (((x) > (y)) ? (x) : (y))
81 extern Display
*x_current_display
;
83 #define ButtonReleaseMask ButtonReleased
84 #endif /* not HAVE_X11 */
86 extern Lisp_Object Qmenu_enable
;
87 extern Lisp_Object Qmenu_bar
;
90 extern void process_expose_from_menu ();
91 extern XtAppContext Xt_app_con
;
93 static Lisp_Object
xdialog_show ();
94 void popup_get_selection ();
97 static Lisp_Object
xmenu_show ();
98 static void keymap_panes ();
99 static void single_keymap_panes ();
100 static void list_of_panes ();
101 static void list_of_items ();
103 /* This holds a Lisp vector that holds the results of decoding
104 the keymaps or alist-of-alists that specify a menu.
106 It describes the panes and items within the panes.
108 Each pane is described by 3 elements in the vector:
109 t, the pane name, the pane's prefix key.
110 Then follow the pane's items, with 4 elements per item:
111 the item string, the enable flag, the item's value,
112 and the equivalent keyboard key's description string.
114 In some cases, multiple levels of menus may be described.
115 A single vector slot containing nil indicates the start of a submenu.
116 A single vector slot containing lambda indicates the end of a submenu.
117 The submenu follows a menu item which is the way to reach the submenu.
119 A single vector slot containing quote indicates that the
120 following items should appear on the right of a dialog box.
122 Using a Lisp vector to hold this information while we decode it
123 takes care of protecting all the data from GC. */
125 #define MENU_ITEMS_PANE_NAME 1
126 #define MENU_ITEMS_PANE_PREFIX 2
127 #define MENU_ITEMS_PANE_LENGTH 3
129 #define MENU_ITEMS_ITEM_NAME 0
130 #define MENU_ITEMS_ITEM_ENABLE 1
131 #define MENU_ITEMS_ITEM_VALUE 2
132 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
133 #define MENU_ITEMS_ITEM_LENGTH 4
135 static Lisp_Object menu_items
;
137 /* Number of slots currently allocated in menu_items. */
138 static int menu_items_allocated
;
140 /* This is the index in menu_items of the first empty slot. */
141 static int menu_items_used
;
143 /* The number of panes currently recorded in menu_items,
144 excluding those within submenus. */
145 static int menu_items_n_panes
;
147 /* Current depth within submenus. */
148 static int menu_items_submenu_depth
;
150 /* Flag which when set indicates a dialog or menu has been posted by
151 Xt on behalf of one of the widget sets. */
152 static int popup_activated_flag
;
155 /* Initialize the menu_items structure if we haven't already done so.
156 Also mark it as currently empty. */
161 if (NILP (menu_items
))
163 menu_items_allocated
= 60;
164 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
168 menu_items_n_panes
= 0;
169 menu_items_submenu_depth
= 0;
172 /* Call at the end of generating the data in menu_items.
173 This fills in the number of items in the last pane. */
180 /* Call when finished using the data for the current menu
184 discard_menu_items ()
186 /* Free the structure if it is especially large.
187 Otherwise, hold on to it, to save time. */
188 if (menu_items_allocated
> 200)
191 menu_items_allocated
= 0;
195 /* Make the menu_items vector twice as large. */
201 int old_size
= menu_items_allocated
;
204 menu_items_allocated
*= 2;
205 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
206 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
207 old_size
* sizeof (Lisp_Object
));
210 /* Begin a submenu. */
213 push_submenu_start ()
215 if (menu_items_used
+ 1 > menu_items_allocated
)
218 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
219 menu_items_submenu_depth
++;
227 if (menu_items_used
+ 1 > menu_items_allocated
)
230 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
231 menu_items_submenu_depth
--;
234 /* Indicate boundary between left and right. */
237 push_left_right_boundary ()
239 if (menu_items_used
+ 1 > menu_items_allocated
)
242 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
245 /* Start a new menu pane in menu_items..
246 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
249 push_menu_pane (name
, prefix_vec
)
250 Lisp_Object name
, prefix_vec
;
252 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
255 if (menu_items_submenu_depth
== 0)
256 menu_items_n_panes
++;
257 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
258 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
259 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
262 /* Push one menu item into the current pane.
263 NAME is the string to display. ENABLE if non-nil means
264 this item can be selected. KEY is the key generated by
265 choosing this item. EQUIV is the textual description
266 of the keyboard equivalent for this item (or nil if none). */
269 push_menu_item (name
, enable
, key
, equiv
)
270 Lisp_Object name
, enable
, key
, equiv
;
272 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
275 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
276 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
277 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
278 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
281 /* Figure out the current keyboard equivalent of a menu item ITEM1.
282 The item string for menu display should be ITEM_STRING.
283 Store the equivalent keyboard key sequence's
284 textual description into *DESCRIP_PTR.
285 Also cache them in the item itself.
286 Return the real definition to execute. */
289 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
290 Lisp_Object item_string
;
292 Lisp_Object
*descrip_ptr
;
294 /* This is the real definition--the function to run. */
296 /* This is the sublist that records cached equiv key data
297 so we can save time. */
298 Lisp_Object cachelist
;
299 /* These are the saved equivalent keyboard key sequence
300 and its key-description. */
301 Lisp_Object savedkey
, descrip
;
304 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
306 /* If a help string follows the item string, skip it. */
307 if (CONSP (XCONS (item1
)->cdr
)
308 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
309 item1
= XCONS (item1
)->cdr
;
313 /* Get out the saved equivalent-keyboard-key info. */
314 cachelist
= savedkey
= descrip
= Qnil
;
315 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
316 && (NILP (XCONS (XCONS (def
)->car
)->car
)
317 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
319 cachelist
= XCONS (def
)->car
;
320 def
= XCONS (def
)->cdr
;
321 savedkey
= XCONS (cachelist
)->car
;
322 descrip
= XCONS (cachelist
)->cdr
;
325 GCPRO4 (def
, def1
, savedkey
, descrip
);
327 /* Is it still valid? */
329 if (!NILP (savedkey
))
330 def1
= Fkey_binding (savedkey
, Qnil
);
331 /* If not, update it. */
333 /* If the command is an alias for another
334 (such as easymenu.el and lmenu.el set it up),
335 check if the original command matches the cached command. */
336 && !(SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
)
337 && EQ (def1
, XSYMBOL (def
)->function
))
338 /* If something had no key binding before, don't recheck it--
339 doing that takes too much time and makes menus too slow. */
340 && !(!NILP (cachelist
) && NILP (savedkey
)))
344 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
345 /* If the command is an alias for another
346 (such as easymenu.el and lmenu.el set it up),
347 see if the original command name has equivalent keys. */
348 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
349 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
352 if (VECTORP (savedkey
)
353 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
355 if (!NILP (savedkey
))
357 descrip
= Fkey_description (savedkey
);
358 descrip
= concat2 (make_string (" (", 3), descrip
);
359 descrip
= concat2 (descrip
, make_string (")", 1));
363 /* Cache the data we just got in a sublist of the menu binding. */
364 if (NILP (cachelist
))
366 CHECK_IMPURE (item1
);
367 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
371 XCONS (cachelist
)->car
= savedkey
;
372 XCONS (cachelist
)->cdr
= descrip
;
376 *descrip_ptr
= descrip
;
380 /* This is used as the handler when calling internal_condition_case_1. */
383 menu_item_enabled_p_1 (arg
)
389 /* Return non-nil if the command DEF is enabled when used as a menu item.
390 This is based on looking for a menu-enable property.
391 If NOTREAL is set, don't bother really computing this. */
394 menu_item_enabled_p (def
, notreal
)
398 Lisp_Object enabled
, tem
;
405 /* No property, or nil, means enable.
406 Otherwise, enable if value is not nil. */
407 tem
= Fget (def
, Qmenu_enable
);
409 /* (condition-case nil (eval tem)
411 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
412 menu_item_enabled_p_1
);
417 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
418 and generate menu panes for them in menu_items.
419 If NOTREAL is nonzero,
420 don't bother really computing whether an item is enabled. */
423 keymap_panes (keymaps
, nmaps
, notreal
)
424 Lisp_Object
*keymaps
;
432 /* Loop over the given keymaps, making a pane for each map.
433 But don't make a pane that is empty--ignore that map instead.
434 P is the number of panes we have made so far. */
435 for (mapno
= 0; mapno
< nmaps
; mapno
++)
436 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
438 finish_menu_items ();
441 /* This is a recursive subroutine of keymap_panes.
442 It handles one keymap, KEYMAP.
443 The other arguments are passed along
444 or point to local variables of the previous function.
445 If NOTREAL is nonzero,
446 don't bother really computing whether an item is enabled. */
449 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
451 Lisp_Object pane_name
;
455 Lisp_Object pending_maps
;
456 Lisp_Object tail
, item
, item1
, item_string
, table
;
457 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
461 push_menu_pane (pane_name
, prefix
);
463 for (tail
= keymap
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
465 /* Look at each key binding, and if it has a menu string,
466 make a menu item from it. */
467 item
= XCONS (tail
)->car
;
470 item1
= XCONS (item
)->cdr
;
473 item_string
= XCONS (item1
)->car
;
474 if (STRINGP (item_string
))
476 /* This is the real definition--the function to run. */
478 /* These are the saved equivalent keyboard key sequence
479 and its key-description. */
481 Lisp_Object tem
, enabled
;
483 /* GCPRO because ...enabled_p will call eval
484 and ..._equiv_key may autoload something.
485 Protecting KEYMAP preserves everything we use;
486 aside from that, must protect whatever might be
487 a string. Since there's no GCPRO5, we refetch
488 item_string instead of protecting it. */
489 descrip
= def
= Qnil
;
490 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
492 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
493 enabled
= menu_item_enabled_p (def
, notreal
);
497 item_string
= XCONS (item1
)->car
;
499 tem
= Fkeymapp (def
);
500 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
501 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
506 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
507 submap
= get_keymap_1 (def
, 0, 1);
509 #ifndef USE_X_TOOLKIT
510 /* Indicate visually that this is a submenu. */
512 item_string
= concat2 (item_string
,
513 build_string (" >"));
515 push_menu_item (item_string
, enabled
, XCONS (item
)->car
,
518 /* Display a submenu using the toolkit. */
521 push_submenu_start ();
522 single_keymap_panes (submap
, Qnil
,
523 XCONS (item
)->car
, notreal
);
531 else if (VECTORP (item
))
533 /* Loop over the char values represented in the vector. */
534 int len
= XVECTOR (item
)->size
;
536 for (c
= 0; c
< len
; c
++)
538 Lisp_Object character
;
539 XSETFASTINT (character
, c
);
540 item1
= XVECTOR (item
)->contents
[c
];
543 item_string
= XCONS (item1
)->car
;
544 if (STRINGP (item_string
))
548 /* These are the saved equivalent keyboard key sequence
549 and its key-description. */
551 Lisp_Object tem
, enabled
;
553 /* GCPRO because ...enabled_p will call eval
554 and ..._equiv_key may autoload something.
555 Protecting KEYMAP preserves everything we use;
556 aside from that, must protect whatever might be
557 a string. Since there's no GCPRO5, we refetch
558 item_string instead of protecting it. */
559 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
560 descrip
= def
= Qnil
;
562 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
563 enabled
= menu_item_enabled_p (def
, notreal
);
567 item_string
= XCONS (item1
)->car
;
569 tem
= Fkeymapp (def
);
570 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
571 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
576 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
577 submap
= get_keymap_1 (def
, 0, 1);
579 #ifndef USE_X_TOOLKIT
581 item_string
= concat2 (item_string
,
582 build_string (" >"));
584 push_menu_item (item_string
, enabled
, character
,
589 push_submenu_start ();
590 single_keymap_panes (submap
, Qnil
,
602 /* Process now any submenus which want to be panes at this level. */
603 while (!NILP (pending_maps
))
605 Lisp_Object elt
, eltcdr
, string
;
606 elt
= Fcar (pending_maps
);
607 eltcdr
= XCONS (elt
)->cdr
;
608 string
= XCONS (eltcdr
)->car
;
609 /* We no longer discard the @ from the beginning of the string here.
610 Instead, we do this in xmenu_show. */
611 single_keymap_panes (Fcar (elt
), string
,
612 XCONS (eltcdr
)->cdr
, notreal
);
613 pending_maps
= Fcdr (pending_maps
);
617 /* Push all the panes and items of a menu decsribed by the
618 alist-of-alists MENU.
619 This handles old-fashioned calls to x-popup-menu. */
629 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
631 Lisp_Object elt
, pane_name
, pane_data
;
633 pane_name
= Fcar (elt
);
634 CHECK_STRING (pane_name
, 0);
635 push_menu_pane (pane_name
, Qnil
);
636 pane_data
= Fcdr (elt
);
637 CHECK_CONS (pane_data
, 0);
638 list_of_items (pane_data
);
641 finish_menu_items ();
644 /* Push the items in a single pane defined by the alist PANE. */
650 Lisp_Object tail
, item
, item1
;
652 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
656 push_menu_item (item
, Qnil
, Qnil
, Qnil
);
657 else if (NILP (item
))
658 push_left_right_boundary ();
661 CHECK_CONS (item
, 0);
663 CHECK_STRING (item1
, 1);
664 push_menu_item (item1
, Qt
, Fcdr (item
), Qnil
);
669 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
670 "Pop up a deck-of-cards menu and return user's selection.\n\
671 POSITION is a position specification. This is either a mouse button event\n\
672 or a list ((XOFFSET YOFFSET) WINDOW)\n\
673 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
674 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
675 This controls the position of the center of the first line\n\
676 in the first pane of the menu, not the top left of the menu as a whole.\n\
677 If POSITION is t, it means to use the current mouse position.\n\
679 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
680 The menu items come from key bindings that have a menu string as well as\n\
681 a definition; actually, the \"definition\" in such a key binding looks like\n\
682 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
683 the keymap as a top-level element.\n\n\
684 You can also use a list of keymaps as MENU.\n\
685 Then each keymap makes a separate pane.\n\
686 When MENU is a keymap or a list of keymaps, the return value\n\
687 is a list of events.\n\n\
688 Alternatively, you can specify a menu of multiple panes\n\
689 with a list of the form (TITLE PANE1 PANE2...),\n\
690 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
691 Each ITEM is normally a cons cell (STRING . VALUE);\n\
692 but a string can appear as an item--that makes a nonselectable line\n\
694 With this form of menu, the return value is VALUE from the chosen item.\n\
696 If POSITION is nil, don't display the menu at all, just precalculate the\n\
697 cached information about equivalent key sequences.")
699 Lisp_Object position
, menu
;
701 int number_of_panes
, panes
;
702 Lisp_Object keymap
, tem
;
706 Lisp_Object selection
;
709 Lisp_Object x
, y
, window
;
714 if (! NILP (position
))
718 /* Decode the first argument: find the window and the coordinates. */
719 if (EQ (position
, Qt
))
721 /* Use the mouse's current position. */
723 Lisp_Object bar_window
;
727 if (mouse_position_hook
)
728 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
730 XSETFRAME (window
, new_f
);
733 window
= selected_window
;
740 tem
= Fcar (position
);
743 window
= Fcar (Fcdr (position
));
745 y
= Fcar (Fcdr (tem
));
749 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
750 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
751 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
755 /* Determine whether this menu is handling a menu bar click. */
756 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
757 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
765 /* Decode where to put the menu. */
774 else if (WINDOWP (window
))
776 CHECK_LIVE_WINDOW (window
, 0);
777 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
779 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
780 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
783 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
784 but I don't want to make one now. */
785 CHECK_WINDOW (window
, 0);
794 /* Decode the menu items from what was specified. */
796 keymap
= Fkeymapp (menu
);
799 tem
= Fkeymapp (Fcar (menu
));
802 /* We were given a keymap. Extract menu info from the keymap. */
804 keymap
= get_keymap (menu
);
806 /* Extract the detailed info to make one pane. */
807 keymap_panes (&menu
, 1, NILP (position
));
809 /* Search for a string appearing directly as an element of the keymap.
810 That string is the title of the menu. */
811 prompt
= map_prompt (keymap
);
813 /* Make that be the pane title of the first pane. */
814 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
815 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
819 else if (!NILP (tem
))
821 /* We were given a list of keymaps. */
822 int nmaps
= XFASTINT (Flength (menu
));
824 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
829 /* The first keymap that has a prompt string
830 supplies the menu title. */
831 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
835 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
837 prompt
= map_prompt (keymap
);
838 if (NILP (title
) && !NILP (prompt
))
842 /* Extract the detailed info to make one pane. */
843 keymap_panes (maps
, nmaps
, NILP (position
));
845 /* Make the title be the pane title of the first pane. */
846 if (!NILP (title
) && menu_items_n_panes
>= 0)
847 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
853 /* We were given an old-fashioned menu. */
855 CHECK_STRING (title
, 1);
857 list_of_panes (Fcdr (menu
));
864 discard_menu_items ();
869 /* Display them in a menu. */
872 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
,
873 keymaps
, title
, &error_name
);
876 discard_menu_items ();
880 if (error_name
) error (error_name
);
884 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
885 "Pop up a dialog box and return user's selection.\n\
886 POSITION specifies which frame to use.\n\
887 This is normally a mouse button event or a window or frame.\n\
888 If POSITION is t, it means to use the frame the mouse is on.\n\
889 The dialog box appears in the middle of the specified frame.\n\
891 CONTENTS specifies the alternatives to display in the dialog box.\n\
892 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
893 Each ITEM is a cons cell (STRING . VALUE).\n\
894 The return value is VALUE from the chosen item.\n\n\
895 An ITEM may also be just a string--that makes a nonselectable item.\n\
896 An ITEM may also be nil--that means to put all preceding items\n\
897 on the left of the dialog box and all following items on the right.\n\
898 \(By default, approximately half appear on each side.)")
900 Lisp_Object position
, contents
;
907 /* Decode the first argument: find the window or frame to use. */
908 if (EQ (position
, Qt
))
910 #if 0 /* Using the frame the mouse is on may not be right. */
911 /* Use the mouse's current position. */
913 Lisp_Object bar_window
;
918 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
921 XSETFRAME (window
, new_f
);
923 window
= selected_window
;
925 /* Decode the first argument: find the window and the coordinates. */
926 if (EQ (position
, Qt
))
927 window
= selected_window
;
929 else if (CONSP (position
))
932 tem
= Fcar (position
);
934 window
= Fcar (Fcdr (position
));
937 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
938 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
941 else if (WINDOWP (position
) || FRAMEP (position
))
944 /* Decode where to put the menu. */
948 else if (WINDOWP (window
))
950 CHECK_LIVE_WINDOW (window
, 0);
951 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
954 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
955 but I don't want to make one now. */
956 CHECK_WINDOW (window
, 0);
958 #ifndef USE_X_TOOLKIT
959 /* Display a menu with these alternatives
960 in the middle of frame F. */
962 Lisp_Object x
, y
, frame
, newpos
;
963 XSETFRAME (frame
, f
);
964 XSETINT (x
, x_pixel_width (f
) / 2);
965 XSETINT (y
, x_pixel_height (f
) / 2);
966 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
968 return Fx_popup_menu (newpos
,
969 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
975 Lisp_Object selection
;
977 /* Decode the dialog items from what was specified. */
978 title
= Fcar (contents
);
979 CHECK_STRING (title
, 1);
981 list_of_panes (Fcons (contents
, Qnil
));
983 /* Display them in a dialog box. */
985 selection
= xdialog_show (f
, 0, 0, title
, &error_name
);
988 discard_menu_items ();
990 if (error_name
) error (error_name
);
998 /* Loop in Xt until the menu pulldown or dialog popup has been
999 popped down (deactivated).
1001 NOTE: All calls to popup_get_selection() should be protected
1002 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1004 popup_get_selection (initial_event
)
1005 XEvent
*initial_event
;
1010 event
= *initial_event
;
1012 XtAppNextEvent (Xt_app_con
, &event
);
1016 XtDispatchEvent (&event
);
1017 if (!popup_activated())
1019 XtAppNextEvent (Xt_app_con
, &event
);
1023 /* Detect if a dialog or menu has been posted. */
1027 return popup_activated_flag
;
1031 /* This callback is invoked when the user selects a menubar cascade
1032 pushbutton, but before the pulldown menu is posted. */
1035 popup_activate_callback (widget
, id
, client_data
)
1038 XtPointer client_data
;
1040 popup_activated_flag
= 1;
1043 /* This callback is called from the menu bar pulldown menu
1044 when the user makes a selection.
1045 Figure out what the user chose
1046 and put the appropriate events into the keyboard buffer. */
1049 menubar_selection_callback (widget
, id
, client_data
)
1052 XtPointer client_data
;
1055 FRAME_PTR f
= (FRAME_PTR
) id
;
1057 Lisp_Object
*subprefix_stack
;
1058 int submenu_depth
= 0;
1063 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1064 vector
= f
->menu_bar_vector
;
1067 while (i
< f
->menu_bar_items_used
)
1071 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1073 subprefix_stack
[submenu_depth
++] = prefix
;
1077 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1079 prefix
= subprefix_stack
[--submenu_depth
];
1082 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1085 = XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1086 i
+= MENU_ITEMS_PANE_LENGTH
;
1091 = XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1092 if ((int) client_data
== i
)
1095 struct input_event buf
;
1097 buf
.kind
= menu_bar_event
;
1098 buf
.frame_or_window
= Qmenu_bar
;
1099 kbd_buffer_store_event (&buf
);
1101 for (j
= 0; j
< submenu_depth
; j
++)
1102 if (!NILP (subprefix_stack
[j
]))
1104 buf
.kind
= menu_bar_event
;
1105 buf
.frame_or_window
= subprefix_stack
[j
];
1106 kbd_buffer_store_event (&buf
);
1111 buf
.kind
= menu_bar_event
;
1112 buf
.frame_or_window
= prefix
;
1113 kbd_buffer_store_event (&buf
);
1116 buf
.kind
= menu_bar_event
;
1117 buf
.frame_or_window
= entry
;
1118 kbd_buffer_store_event (&buf
);
1122 i
+= MENU_ITEMS_ITEM_LENGTH
;
1127 /* This callback is invoked when a dialog or menu is finished being
1128 used and has been unposted. */
1131 popup_deactivate_callback (widget
, id
, client_data
)
1134 XtPointer client_data
;
1136 popup_activated_flag
= 0;
1140 /* This recursively calls free_widget_value on the tree of widgets.
1141 It must free all data that was malloc'ed for these widget_values.
1142 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1143 must be left alone. */
1146 free_menubar_widget_value_tree (wv
)
1151 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1153 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1155 free_menubar_widget_value_tree (wv
->contents
);
1156 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1160 free_menubar_widget_value_tree (wv
->next
);
1161 wv
->next
= (widget_value
*) 0xDEADBEEF;
1164 free_widget_value (wv
);
1168 /* Return a tree of widget_value structures for a menu bar item
1169 whose event type is ITEM_KEY (with string ITEM_NAME)
1170 and whose contents come from the list of keymaps MAPS. */
1172 static widget_value
*
1173 single_submenu (item_key
, item_name
, maps
)
1174 Lisp_Object item_key
, item_name
, maps
;
1176 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1178 int submenu_depth
= 0;
1181 Lisp_Object
*mapvec
;
1182 widget_value
**submenu_stack
;
1184 int previous_items
= menu_items_used
;
1186 length
= Flength (maps
);
1187 len
= XINT (length
);
1189 /* Convert the list MAPS into a vector MAPVEC. */
1190 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1191 for (i
= 0; i
< len
; i
++)
1193 mapvec
[i
] = Fcar (maps
);
1197 menu_items_n_panes
= 0;
1199 /* Loop over the given keymaps, making a pane for each map.
1200 But don't make a pane that is empty--ignore that map instead. */
1201 for (i
= 0; i
< len
; i
++)
1202 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0);
1204 /* Create a tree of widget_value objects
1205 representing the panes and their items. */
1208 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1209 wv
= malloc_widget_value ();
1216 /* Loop over all panes and items made during this call
1217 and construct a tree of widget_value objects.
1218 Ignore the panes and items made by previous calls to
1219 single_submenu, even though those are also in menu_items. */
1221 while (i
< menu_items_used
)
1223 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1225 submenu_stack
[submenu_depth
++] = save_wv
;
1230 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1233 save_wv
= submenu_stack
[--submenu_depth
];
1236 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1237 && submenu_depth
!= 0)
1238 i
+= MENU_ITEMS_PANE_LENGTH
;
1239 /* Ignore a nil in the item list.
1240 It's meaningful only for dialog boxes. */
1241 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1243 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1245 /* Create a new pane. */
1246 Lisp_Object pane_name
, prefix
;
1248 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1249 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1250 pane_string
= (NILP (pane_name
)
1251 ? "" : (char *) XSTRING (pane_name
)->data
);
1252 /* If there is just one top-level pane, put all its items directly
1253 under the top-level menu. */
1254 if (menu_items_n_panes
== 1)
1257 /* If the pane has a meaningful name,
1258 make the pane a top-level menu item
1259 with its items as a submenu beneath it. */
1260 if (strcmp (pane_string
, ""))
1262 wv
= malloc_widget_value ();
1266 first_wv
->contents
= wv
;
1267 wv
->name
= pane_string
;
1275 i
+= MENU_ITEMS_PANE_LENGTH
;
1279 /* Create a new item within current pane. */
1280 Lisp_Object item_name
, enable
, descrip
;
1281 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1282 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1284 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1286 wv
= malloc_widget_value ();
1290 save_wv
->contents
= wv
;
1291 wv
->name
= (char *) XSTRING (item_name
)->data
;
1292 if (!NILP (descrip
))
1293 wv
->key
= (char *) XSTRING (descrip
)->data
;
1295 wv
->call_data
= (void *) i
;
1296 wv
->enabled
= !NILP (enable
);
1299 i
+= MENU_ITEMS_ITEM_LENGTH
;
1306 extern void EmacsFrameSetCharSize ();
1308 /* Recompute the menu bar of frame F. */
1311 update_frame_menubar (f
)
1314 struct x_display
*x
= f
->display
.x
;
1316 int menubar_changed
;
1318 Dimension shell_height
;
1320 /* We assume the menubar contents has changed if the global flag is set,
1321 or if the current buffer has changed, or if the menubar has never
1322 been updated before.
1324 menubar_changed
= (x
->menubar_widget
1325 && !XtIsManaged (x
->menubar_widget
));
1327 if (! (menubar_changed
))
1331 /* Save the size of the frame because the pane widget doesn't accept to
1332 resize itself. So force it. */
1336 /* Do the voodoo which means "I'm changing lots of things, don't try to
1337 refigure sizes until I'm done." */
1338 lw_refigure_widget (x
->column_widget
, False
);
1340 /* the order in which children are managed is the top to
1341 bottom order in which they are displayed in the paned window.
1342 First, remove the text-area widget.
1344 XtUnmanageChild (x
->edit_widget
);
1346 /* remove the menubar that is there now, and put up the menubar that
1349 if (menubar_changed
)
1351 XtManageChild (x
->menubar_widget
);
1352 XtMapWidget (x
->menubar_widget
);
1353 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1356 /* Re-manage the text-area widget, and then thrash the sizes. */
1357 XtManageChild (x
->edit_widget
);
1358 lw_refigure_widget (x
->column_widget
, True
);
1360 /* Force the pane widget to resize itself with the right values. */
1361 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1367 set_frame_menubar (f
, first_time
)
1371 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1373 Lisp_Object tail
, items
;
1374 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
1379 wv
= malloc_widget_value ();
1380 wv
->name
= "menubar";
1383 save_wv
= first_wv
= wv
;
1384 items
= FRAME_MENU_BAR_ITEMS (f
);
1385 menu_items
= f
->menu_bar_vector
;
1386 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1389 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1391 Lisp_Object key
, string
, maps
;
1393 key
= XVECTOR (items
)->contents
[i
];
1394 string
= XVECTOR (items
)->contents
[i
+ 1];
1395 maps
= XVECTOR (items
)->contents
[i
+ 2];
1399 wv
= single_submenu (key
, string
, maps
);
1403 save_wv
->contents
= wv
;
1404 wv
->name
= (char *) XSTRING (string
)->data
;
1409 finish_menu_items ();
1411 f
->menu_bar_vector
= menu_items
;
1412 f
->menu_bar_items_used
= menu_items_used
;
1417 /* Disable resizing (done for Motif!) */
1418 lw_allow_resizing (f
->display
.x
->widget
, False
);
1420 /* The third arg is DEEP_P, which says to consider the entire
1421 menu trees we supply, rather than just the menu bar item names. */
1422 lw_modify_all_widgets (id
, first_wv
, 1);
1424 /* Re-enable the edit widget to resize. */
1425 lw_allow_resizing (f
->display
.x
->widget
, True
);
1429 menubar_widget
= lw_create_widget ("menubar", "menubar",
1431 f
->display
.x
->column_widget
,
1433 popup_activate_callback
,
1434 menubar_selection_callback
,
1435 popup_deactivate_callback
);
1436 f
->display
.x
->menubar_widget
= menubar_widget
;
1439 free_menubar_widget_value_tree (first_wv
);
1441 /* Don't update the menubar the first time it is created via x_window. */
1443 update_frame_menubar (f
);
1448 /* Called from Fx_create_frame to create the inital menubar of a frame
1449 before it is mapped, so that the window is mapped with the menubar already
1450 there instead of us tacking it on later and thrashing the window after it
1454 initialize_frame_menubar (f
)
1457 /* This function is called before the first chance to redisplay
1458 the frame. It has to be, so the frame will have the right size. */
1459 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1460 set_frame_menubar (f
, 1);
1463 /* Get rid of the menu bar of frame F, and free its storage.
1464 This is used when deleting a frame, and when turning off the menu bar. */
1467 free_frame_menubar (f
)
1470 Widget menubar_widget
;
1473 menubar_widget
= f
->display
.x
->menubar_widget
;
1479 lw_destroy_all_widgets (id
);
1484 #endif /* USE_X_TOOLKIT */
1486 /* xmenu_show actually displays a menu using the panes and items in menu_items
1487 and returns the value selected from it.
1488 There are two versions of xmenu_show, one for Xt and one for Xlib.
1489 Both assume input is blocked by the caller. */
1491 /* F is the frame the menu is for.
1492 X and Y are the frame-relative specified position,
1493 relative to the inside upper left corner of the frame F.
1494 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1495 KEYMAPS is 1 if this menu was specified with keymaps;
1496 in that case, we return a list containing the chosen item's value
1497 and perhaps also the pane's prefix.
1498 TITLE is the specified menu title.
1499 ERROR is a place to store an error message string in case of failure.
1500 (We return nil on failure, but the value doesn't actually matter.) */
1502 #ifdef USE_X_TOOLKIT
1504 extern unsigned int x_mouse_grabbed
;
1506 /* We need a unique id for each widget handled by the Lucid Widget
1507 library. This includes the frame main windows, popup menu and
1509 LWLIB_ID widget_id_tick
;
1512 static Lisp_Object
*volatile menu_item_selection
;
1514 static Lisp_Object
*menu_item_selection
;
1518 popup_selection_callback (widget
, id
, client_data
)
1521 XtPointer client_data
;
1523 menu_item_selection
= (Lisp_Object
*) client_data
;
1527 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1531 int menubarp
; /* Dummy parameter for Xt version of
1542 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1543 widget_value
**submenu_stack
1544 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1545 Lisp_Object
*subprefix_stack
1546 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1547 int submenu_depth
= 0;
1549 /* Define a queue to save up for later unreading
1550 all X events that don't pertain to the menu. */
1554 struct event_queue
*next
;
1557 struct event_queue
*queue
= NULL
;
1558 struct event_queue
*queue_tmp
;
1560 Position root_x
, root_y
;
1563 int next_release_must_exit
= 0;
1567 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1569 *error
= "Empty menu";
1573 /* Create a tree of widget_value objects
1574 representing the panes and their items. */
1575 wv
= malloc_widget_value ();
1582 /* Loop over all panes and items, filling in the tree. */
1584 while (i
< menu_items_used
)
1586 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1588 submenu_stack
[submenu_depth
++] = save_wv
;
1594 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1597 save_wv
= submenu_stack
[--submenu_depth
];
1601 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1602 && submenu_depth
!= 0)
1603 i
+= MENU_ITEMS_PANE_LENGTH
;
1604 /* Ignore a nil in the item list.
1605 It's meaningful only for dialog boxes. */
1606 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1608 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1610 /* Create a new pane. */
1611 Lisp_Object pane_name
, prefix
;
1613 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1614 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1615 pane_string
= (NILP (pane_name
)
1616 ? "" : (char *) XSTRING (pane_name
)->data
);
1617 /* If there is just one top-level pane, put all its items directly
1618 under the top-level menu. */
1619 if (menu_items_n_panes
== 1)
1622 /* If the pane has a meaningful name,
1623 make the pane a top-level menu item
1624 with its items as a submenu beneath it. */
1625 if (!keymaps
&& strcmp (pane_string
, ""))
1627 wv
= malloc_widget_value ();
1631 first_wv
->contents
= wv
;
1632 wv
->name
= pane_string
;
1633 if (keymaps
&& !NILP (prefix
))
1640 else if (first_pane
)
1646 i
+= MENU_ITEMS_PANE_LENGTH
;
1650 /* Create a new item within current pane. */
1651 Lisp_Object item_name
, enable
, descrip
;
1652 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1653 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1655 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1657 wv
= malloc_widget_value ();
1661 save_wv
->contents
= wv
;
1662 wv
->name
= (char *) XSTRING (item_name
)->data
;
1663 if (!NILP (descrip
))
1664 wv
->key
= (char *) XSTRING (descrip
)->data
;
1666 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1667 wv
->enabled
= !NILP (enable
);
1670 i
+= MENU_ITEMS_ITEM_LENGTH
;
1674 /* Deal with the title, if it is non-nil. */
1677 widget_value
*wv_title
= malloc_widget_value ();
1678 widget_value
*wv_sep1
= malloc_widget_value ();
1679 widget_value
*wv_sep2
= malloc_widget_value ();
1681 wv_sep2
->name
= "--";
1682 wv_sep2
->next
= first_wv
->contents
;
1684 wv_sep1
->name
= "--";
1685 wv_sep1
->next
= wv_sep2
;
1687 wv_title
->name
= (char *) XSTRING (title
)->data
;
1688 wv_title
->enabled
= True
;
1689 wv_title
->next
= wv_sep1
;
1690 first_wv
->contents
= wv_title
;
1693 /* Actually create the menu. */
1694 menu_id
= ++widget_id_tick
;
1695 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1696 f
->display
.x
->widget
, 1, 0,
1697 popup_selection_callback
,
1698 popup_deactivate_callback
);
1700 /* Don't allow any geometry request from the user. */
1701 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
1702 XtSetValues (menu
, av
, ac
);
1704 /* Free the widget_value objects we used to specify the contents. */
1705 free_menubar_widget_value_tree (first_wv
);
1707 /* No selection has been chosen yet. */
1708 menu_item_selection
= 0;
1710 /* Display the menu. */
1711 lw_popup_menu (menu
);
1712 popup_activated_flag
= 1;
1714 /* Process events that apply to the menu. */
1715 popup_get_selection ((XEvent
*) 0);
1718 /* fp turned off the following statement and wrote a comment
1719 that it is unnecessary--that the menu has already disappeared.
1720 I observer that is not so. -- rms. */
1721 /* Make sure the menu disappears. */
1722 lw_destroy_all_widgets (menu_id
);
1724 /* Unread any events that we got but did not handle. */
1725 while (queue
!= NULL
)
1728 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1729 queue
= queue_tmp
->next
;
1730 free ((char *)queue_tmp
);
1731 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1732 interrupt_input_pending
= 1;
1735 /* Find the selected item, and its pane, to return
1736 the proper value. */
1737 if (menu_item_selection
!= 0)
1743 while (i
< menu_items_used
)
1747 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1749 subprefix_stack
[submenu_depth
++] = prefix
;
1753 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1755 prefix
= subprefix_stack
[--submenu_depth
];
1758 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1761 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1762 i
+= MENU_ITEMS_PANE_LENGTH
;
1767 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1768 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1774 entry
= Fcons (entry
, Qnil
);
1776 entry
= Fcons (prefix
, entry
);
1777 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1778 if (!NILP (subprefix_stack
[j
]))
1779 entry
= Fcons (subprefix_stack
[j
], entry
);
1783 i
+= MENU_ITEMS_ITEM_LENGTH
;
1792 dialog_selection_callback (widget
, id
, client_data
)
1795 XtPointer client_data
;
1797 if ((int)client_data
!= -1)
1798 menu_item_selection
= (Lisp_Object
*) client_data
;
1800 lw_destroy_all_widgets (id
);
1804 static char * button_names
[] = {
1805 "button1", "button2", "button3", "button4", "button5",
1806 "button6", "button7", "button8", "button9", "button10" };
1809 xdialog_show (f
, menubarp
, keymaps
, title
, error
)
1816 int i
, nb_buttons
=0;
1819 char dialog_name
[6];
1821 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1823 /* Define a queue to save up for later unreading
1824 all X events that don't pertain to the menu. */
1828 struct event_queue
*next
;
1831 struct event_queue
*queue
= NULL
;
1832 struct event_queue
*queue_tmp
;
1834 /* Number of elements seen so far, before boundary. */
1836 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1837 int boundary_seen
= 0;
1841 if (menu_items_n_panes
> 1)
1843 *error
= "Multiple panes in dialog box";
1847 /* Create a tree of widget_value objects
1848 representing the text label and buttons. */
1850 Lisp_Object pane_name
, prefix
;
1852 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1853 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1854 pane_string
= (NILP (pane_name
)
1855 ? "" : (char *) XSTRING (pane_name
)->data
);
1856 prev_wv
= malloc_widget_value ();
1857 prev_wv
->value
= pane_string
;
1858 if (keymaps
&& !NILP (prefix
))
1860 prev_wv
->enabled
= 1;
1861 prev_wv
->name
= "message";
1864 /* Loop over all panes and items, filling in the tree. */
1865 i
= MENU_ITEMS_PANE_LENGTH
;
1866 while (i
< menu_items_used
)
1869 /* Create a new item within current pane. */
1870 Lisp_Object item_name
, enable
, descrip
;
1871 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1872 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1874 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1876 if (NILP (item_name
))
1878 free_menubar_widget_value_tree (first_wv
);
1879 *error
= "Submenu in dialog items";
1882 if (EQ (item_name
, Qquote
))
1884 /* This is the boundary between left-side elts
1885 and right-side elts. Stop incrementing right_count. */
1890 if (nb_buttons
>= 10)
1892 free_menubar_widget_value_tree (first_wv
);
1893 *error
= "Too many dialog items";
1897 wv
= malloc_widget_value ();
1899 wv
->name
= (char *) button_names
[nb_buttons
];
1900 if (!NILP (descrip
))
1901 wv
->key
= (char *) XSTRING (descrip
)->data
;
1902 wv
->value
= (char *) XSTRING (item_name
)->data
;
1903 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1904 wv
->enabled
= !NILP (enable
);
1907 if (! boundary_seen
)
1911 i
+= MENU_ITEMS_ITEM_LENGTH
;
1914 /* If the boundary was not specified,
1915 by default put half on the left and half on the right. */
1916 if (! boundary_seen
)
1917 left_count
= nb_buttons
- nb_buttons
/ 2;
1919 wv
= malloc_widget_value ();
1920 wv
->name
= dialog_name
;
1922 /* Dialog boxes use a really stupid name encoding
1923 which specifies how many buttons to use
1924 and how many buttons are on the right.
1925 The Q means something also. */
1926 dialog_name
[0] = 'Q';
1927 dialog_name
[1] = '0' + nb_buttons
;
1928 dialog_name
[2] = 'B';
1929 dialog_name
[3] = 'R';
1930 /* Number of buttons to put on the right. */
1931 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1933 wv
->contents
= first_wv
;
1937 /* Actually create the dialog. */
1938 dialog_id
= ++widget_id_tick
;
1939 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1940 f
->display
.x
->widget
, 1, 0,
1941 dialog_selection_callback
, 0);
1942 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1943 /* Free the widget_value objects we used to specify the contents. */
1944 free_menubar_widget_value_tree (first_wv
);
1946 /* No selection has been chosen yet. */
1947 menu_item_selection
= 0;
1949 /* Display the menu. */
1950 lw_pop_up_all_widgets (dialog_id
);
1952 /* Process events that apply to the menu. */
1957 XtAppNextEvent (Xt_app_con
, &event
);
1958 if (event
.type
== ButtonRelease
)
1960 XtDispatchEvent (&event
);
1963 else if (event
.type
== Expose
)
1964 process_expose_from_menu (event
);
1965 XtDispatchEvent (&event
);
1966 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1968 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1970 if (queue_tmp
!= NULL
)
1972 queue_tmp
->event
= event
;
1973 queue_tmp
->next
= queue
;
1980 /* State that no mouse buttons are now held.
1981 That is not necessarily true, but the fiction leads to reasonable
1982 results, and it is a pain to ask which are actually held now
1983 or track this in the loop above. */
1984 x_mouse_grabbed
= 0;
1986 /* Unread any events that we got but did not handle. */
1987 while (queue
!= NULL
)
1990 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1991 queue
= queue_tmp
->next
;
1992 free ((char *)queue_tmp
);
1993 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1994 interrupt_input_pending
= 1;
1997 /* Find the selected item, and its pane, to return
1998 the proper value. */
1999 if (menu_item_selection
!= 0)
2005 while (i
< menu_items_used
)
2009 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2012 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2013 i
+= MENU_ITEMS_PANE_LENGTH
;
2018 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2019 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2023 entry
= Fcons (entry
, Qnil
);
2025 entry
= Fcons (prefix
, entry
);
2029 i
+= MENU_ITEMS_ITEM_LENGTH
;
2036 #else /* not USE_X_TOOLKIT */
2039 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
2049 int pane
, selidx
, lpane
, status
;
2050 Lisp_Object entry
, pane_prefix
;
2052 int ulx
, uly
, width
, height
;
2053 int dispwidth
, dispheight
;
2057 unsigned int dummy_uint
;
2060 if (menu_items_n_panes
== 0)
2063 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2065 *error
= "Empty menu";
2069 /* Figure out which root window F is on. */
2070 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
2071 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2072 &dummy_uint
, &dummy_uint
);
2074 /* Make the menu on that window. */
2075 menu
= XMenuCreate (XDISPLAY root
, "emacs");
2078 *error
= "Can't create menu";
2082 /* Adjust coordinates to relative to the outer (window manager) window. */
2086 int win_x
= 0, win_y
= 0;
2088 /* Find the position of the outside upper-left corner of
2089 the inner window, with respect to the outer window. */
2090 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2093 XTranslateCoordinates (x_current_display
,
2095 /* From-window, to-window. */
2096 f
->display
.x
->window_desc
,
2097 f
->display
.x
->parent_desc
,
2099 /* From-position, to-position. */
2100 0, 0, &win_x
, &win_y
,
2102 /* Child of window. */
2109 #endif /* HAVE_X11 */
2111 /* Adjust coordinates to be root-window-relative. */
2112 x
+= f
->display
.x
->left_pos
;
2113 y
+= f
->display
.x
->top_pos
;
2115 /* Create all the necessary panes and their items. */
2117 while (i
< menu_items_used
)
2119 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2121 /* Create a new pane. */
2122 Lisp_Object pane_name
, prefix
;
2125 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2126 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2127 pane_string
= (NILP (pane_name
)
2128 ? "" : (char *) XSTRING (pane_name
)->data
);
2129 if (keymaps
&& !NILP (prefix
))
2132 lpane
= XMenuAddPane (XDISPLAY menu
, pane_string
, TRUE
);
2133 if (lpane
== XM_FAILURE
)
2135 XMenuDestroy (XDISPLAY menu
);
2136 *error
= "Can't create pane";
2139 i
+= MENU_ITEMS_PANE_LENGTH
;
2141 /* Find the width of the widest item in this pane. */
2144 while (j
< menu_items_used
)
2147 item
= XVECTOR (menu_items
)->contents
[j
];
2155 width
= XSTRING (item
)->size
;
2156 if (width
> maxwidth
)
2159 j
+= MENU_ITEMS_ITEM_LENGTH
;
2162 /* Ignore a nil in the item list.
2163 It's meaningful only for dialog boxes. */
2164 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2168 /* Create a new item within current pane. */
2169 Lisp_Object item_name
, enable
, descrip
;
2170 unsigned char *item_data
;
2172 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2173 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2175 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2176 if (!NILP (descrip
))
2178 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2181 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2182 item_name
= concat2 (item_name
, spacer
);
2183 item_name
= concat2 (item_name
, descrip
);
2184 item_data
= XSTRING (item_name
)->data
;
2186 /* if alloca is fast, use that to make the space,
2187 to reduce gc needs. */
2189 = (unsigned char *) alloca (maxwidth
2190 + XSTRING (descrip
)->size
+ 1);
2191 bcopy (XSTRING (item_name
)->data
, item_data
,
2192 XSTRING (item_name
)->size
);
2193 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2195 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2196 XSTRING (descrip
)->size
);
2197 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2201 item_data
= XSTRING (item_name
)->data
;
2203 if (XMenuAddSelection (XDISPLAY menu
, lpane
, 0, item_data
,
2207 XMenuDestroy (XDISPLAY menu
);
2208 *error
= "Can't add selection to menu";
2211 i
+= MENU_ITEMS_ITEM_LENGTH
;
2215 /* All set and ready to fly. */
2216 XMenuRecompute (XDISPLAY menu
);
2217 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
2218 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
2219 x
= min (x
, dispwidth
);
2220 y
= min (y
, dispheight
);
2223 XMenuLocate (XDISPLAY menu
, 0, 0, x
, y
,
2224 &ulx
, &uly
, &width
, &height
);
2225 if (ulx
+width
> dispwidth
)
2227 x
-= (ulx
+ width
) - dispwidth
;
2228 ulx
= dispwidth
- width
;
2230 if (uly
+height
> dispheight
)
2232 y
-= (uly
+ height
) - dispheight
;
2233 uly
= dispheight
- height
;
2235 if (ulx
< 0) x
-= ulx
;
2236 if (uly
< 0) y
-= uly
;
2238 XMenuSetAEQ (menu
, TRUE
);
2239 XMenuSetFreeze (menu
, TRUE
);
2242 status
= XMenuActivate (XDISPLAY menu
, &pane
, &selidx
,
2243 x
, y
, ButtonReleaseMask
, &datap
);
2248 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2251 /* Find the item number SELIDX in pane number PANE. */
2253 while (i
< menu_items_used
)
2255 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2259 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2261 i
+= MENU_ITEMS_PANE_LENGTH
;
2270 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2273 entry
= Fcons (entry
, Qnil
);
2274 if (!NILP (pane_prefix
))
2275 entry
= Fcons (pane_prefix
, entry
);
2281 i
+= MENU_ITEMS_ITEM_LENGTH
;
2287 *error
= "Can't activate menu";
2293 XMenuDestroy (XDISPLAY menu
);
2295 /* State that no mouse buttons are now held.
2296 (The oldXMenu code doesn't track this info for us.)
2297 That is not necessarily true, but the fiction leads to reasonable
2298 results, and it is a pain to ask which are actually held now. */
2299 x_mouse_grabbed
= 0;
2304 #endif /* not USE_X_TOOLKIT */
2308 staticpro (&menu_items
);
2311 #ifdef USE_X_TOOLKIT
2312 widget_id_tick
= (1<<16);
2315 defsubr (&Sx_popup_menu
);
2316 defsubr (&Sx_popup_dialog
);