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. */
34 /* On 4.3 this loses if it comes after xterm.h. */
38 #include "termhooks.h"
42 #include "blockinput.h"
44 /* This may include sys/types.h, and that somehow loses
45 if this is not done before the other system files. */
48 /* Load sys/types.h if not already loaded.
49 In some systems loading it twice is suicidal. */
51 #include <sys/types.h>
54 #include "dispextern.h"
57 #include "../oldXMenu/XMenu.h"
64 #include <X11/IntrinsicP.h>
65 #include <X11/CoreP.h>
66 #include <X11/StringDefs.h>
67 #include <X11/Xaw/Paned.h>
68 #include "../lwlib/lwlib.h"
69 #include "../lwlib/xlwmenuP.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 /* We need a unique id for each popup menu and dialog box. */
87 static unsigned int popup_id_tick
;
89 extern Lisp_Object Qmenu_enable
;
90 extern Lisp_Object Qmenu_bar
;
93 extern void process_expose_from_menu ();
94 extern XtAppContext Xt_app_con
;
96 static Lisp_Object
xdialog_show ();
99 static Lisp_Object
xmenu_show ();
100 static void keymap_panes ();
101 static void single_keymap_panes ();
102 static void list_of_panes ();
103 static void list_of_items ();
105 /* This holds a Lisp vector that holds the results of decoding
106 the keymaps or alist-of-alists that specify a menu.
108 It describes the panes and items within the panes.
110 Each pane is described by 3 elements in the vector:
111 t, the pane name, the pane's prefix key.
112 Then follow the pane's items, with 4 elements per item:
113 the item string, the enable flag, the item's value,
114 and the equivalent keyboard key's description string.
116 In some cases, multiple levels of menus may be described.
117 A single vector slot containing nil indicates the start of a submenu.
118 A single vector slot containing lambda indicates the end of a submenu.
119 The submenu follows a menu item which is the way to reach the submenu.
121 A single vector slot containing quote indicates that the
122 following items should appear on the right of a dialog box.
124 Using a Lisp vector to hold this information while we decode it
125 takes care of protecting all the data from GC. */
127 #define MENU_ITEMS_PANE_NAME 1
128 #define MENU_ITEMS_PANE_PREFIX 2
129 #define MENU_ITEMS_PANE_LENGTH 3
131 #define MENU_ITEMS_ITEM_NAME 0
132 #define MENU_ITEMS_ITEM_ENABLE 1
133 #define MENU_ITEMS_ITEM_VALUE 2
134 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
135 #define MENU_ITEMS_ITEM_LENGTH 4
137 static Lisp_Object menu_items
;
139 /* Number of slots currently allocated in menu_items. */
140 static int menu_items_allocated
;
142 /* This is the index in menu_items of the first empty slot. */
143 static int menu_items_used
;
145 /* The number of panes currently recorded in menu_items,
146 excluding those within submenus. */
147 static int menu_items_n_panes
;
149 /* Current depth within submenus. */
150 static int menu_items_submenu_depth
;
152 /* Initialize the menu_items structure if we haven't already done so.
153 Also mark it as currently empty. */
158 if (NILP (menu_items
))
160 menu_items_allocated
= 60;
161 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
165 menu_items_n_panes
= 0;
166 menu_items_submenu_depth
= 0;
169 /* Call at the end of generating the data in menu_items.
170 This fills in the number of items in the last pane. */
177 /* Call when finished using the data for the current menu
181 discard_menu_items ()
183 /* Free the structure if it is especially large.
184 Otherwise, hold on to it, to save time. */
185 if (menu_items_allocated
> 200)
188 menu_items_allocated
= 0;
192 /* Make the menu_items vector twice as large. */
198 int old_size
= menu_items_allocated
;
201 menu_items_allocated
*= 2;
202 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
203 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
204 old_size
* sizeof (Lisp_Object
));
207 /* Begin a submenu. */
210 push_submenu_start ()
212 if (menu_items_used
+ 1 > menu_items_allocated
)
215 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
216 menu_items_submenu_depth
++;
224 if (menu_items_used
+ 1 > menu_items_allocated
)
227 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
228 menu_items_submenu_depth
--;
231 /* Indicate boundary between left and right. */
234 push_left_right_boundary ()
236 if (menu_items_used
+ 1 > menu_items_allocated
)
239 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
242 /* Start a new menu pane in menu_items..
243 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
246 push_menu_pane (name
, prefix_vec
)
247 Lisp_Object name
, prefix_vec
;
249 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
252 if (menu_items_submenu_depth
== 0)
253 menu_items_n_panes
++;
254 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
255 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
256 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
259 /* Push one menu item into the current pane.
260 NAME is the string to display. ENABLE if non-nil means
261 this item can be selected. KEY is the key generated by
262 choosing this item. EQUIV is the textual description
263 of the keyboard equivalent for this item (or nil if none). */
266 push_menu_item (name
, enable
, key
, equiv
)
267 Lisp_Object name
, enable
, key
, equiv
;
269 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
272 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
273 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
274 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
275 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
278 /* Figure out the current keyboard equivalent of a menu item ITEM1.
279 The item string for menu display should be ITEM_STRING.
280 Store the equivalent keyboard key sequence's
281 textual description into *DESCRIP_PTR.
282 Also cache them in the item itself.
283 Return the real definition to execute. */
286 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
287 Lisp_Object item_string
;
289 Lisp_Object
*descrip_ptr
;
291 /* This is the real definition--the function to run. */
293 /* This is the sublist that records cached equiv key data
294 so we can save time. */
295 Lisp_Object cachelist
;
296 /* These are the saved equivalent keyboard key sequence
297 and its key-description. */
298 Lisp_Object savedkey
, descrip
;
302 /* If a help string follows the item string, skip it. */
303 if (CONSP (XCONS (item1
)->cdr
)
304 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
305 item1
= XCONS (item1
)->cdr
;
309 /* Get out the saved equivalent-keyboard-key info. */
310 cachelist
= savedkey
= descrip
= Qnil
;
311 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
312 && (NILP (XCONS (XCONS (def
)->car
)->car
)
313 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
315 cachelist
= XCONS (def
)->car
;
316 def
= XCONS (def
)->cdr
;
317 savedkey
= XCONS (cachelist
)->car
;
318 descrip
= XCONS (cachelist
)->cdr
;
321 /* Is it still valid? */
323 if (!NILP (savedkey
))
324 def1
= Fkey_binding (savedkey
, Qnil
);
325 /* If not, update it. */
327 /* If something had no key binding before, don't recheck it--
328 doing that takes too much time and makes menus too slow. */
329 && !(!NILP (cachelist
) && NILP (savedkey
)))
333 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
334 /* If the command is an alias for another
335 (such as easymenu.el and lmenu.el set it up),
336 see if the original command name has equivalent keys. */
337 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
338 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
341 if (VECTORP (savedkey
)
342 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
344 if (!NILP (savedkey
))
346 descrip
= Fkey_description (savedkey
);
347 descrip
= concat2 (make_string (" (", 3), descrip
);
348 descrip
= concat2 (descrip
, make_string (")", 1));
352 /* Cache the data we just got in a sublist of the menu binding. */
353 if (NILP (cachelist
))
354 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
357 XCONS (cachelist
)->car
= savedkey
;
358 XCONS (cachelist
)->cdr
= descrip
;
361 *descrip_ptr
= descrip
;
365 /* This is used as the handler when calling internal_condition_case_1. */
368 menu_item_enabled_p_1 (arg
)
374 /* Return non-nil if the command DEF is enabled when used as a menu item.
375 This is based on looking for a menu-enable property.
376 If NOTREAL is set, don't bother really computing this. */
379 menu_item_enabled_p (def
, notreal
)
382 Lisp_Object enabled
, tem
;
387 if (XTYPE (def
) == Lisp_Symbol
)
389 /* No property, or nil, means enable.
390 Otherwise, enable if value is not nil. */
391 tem
= Fget (def
, Qmenu_enable
);
393 /* (condition-case nil (eval tem)
395 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
396 menu_item_enabled_p_1
);
401 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
402 and generate menu panes for them in menu_items.
403 If NOTREAL is nonzero,
404 don't bother really computing whether an item is enabled. */
407 keymap_panes (keymaps
, nmaps
, notreal
)
408 Lisp_Object
*keymaps
;
416 /* Loop over the given keymaps, making a pane for each map.
417 But don't make a pane that is empty--ignore that map instead.
418 P is the number of panes we have made so far. */
419 for (mapno
= 0; mapno
< nmaps
; mapno
++)
420 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
422 finish_menu_items ();
425 /* This is a recursive subroutine of keymap_panes.
426 It handles one keymap, KEYMAP.
427 The other arguments are passed along
428 or point to local variables of the previous function.
429 If NOTREAL is nonzero,
430 don't bother really computing whether an item is enabled. */
433 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
435 Lisp_Object pane_name
;
439 Lisp_Object pending_maps
;
440 Lisp_Object tail
, item
, item1
, item_string
, table
;
441 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
445 push_menu_pane (pane_name
, prefix
);
447 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
449 /* Look at each key binding, and if it has a menu string,
450 make a menu item from it. */
451 item
= XCONS (tail
)->car
;
452 if (XTYPE (item
) == Lisp_Cons
)
454 item1
= XCONS (item
)->cdr
;
455 if (XTYPE (item1
) == Lisp_Cons
)
457 item_string
= XCONS (item1
)->car
;
458 if (XTYPE (item_string
) == Lisp_String
)
460 /* This is the real definition--the function to run. */
462 /* These are the saved equivalent keyboard key sequence
463 and its key-description. */
465 Lisp_Object tem
, enabled
;
467 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
469 /* GCPRO because we will call eval.
470 Protecting KEYMAP preserves everything we use;
471 aside from that, must protect whatever might be
472 a string. Since there's no GCPRO5, we refetch
473 item_string instead of protecting it. */
474 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
475 enabled
= menu_item_enabled_p (def
, notreal
);
479 item_string
= XCONS (item1
)->car
;
481 tem
= Fkeymapp (def
);
482 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
483 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
488 submap
= get_keymap_1 (def
, 0, 1);
489 #ifndef USE_X_TOOLKIT
490 /* Indicate visually that this is a submenu. */
492 item_string
= concat2 (item_string
,
493 build_string (" >"));
495 push_menu_item (item_string
, enabled
, XCONS (item
)->car
,
498 /* Display a submenu using the toolkit. */
501 push_submenu_start ();
502 single_keymap_panes (submap
, Qnil
,
503 XCONS (item
)->car
, notreal
);
511 else if (XTYPE (item
) == Lisp_Vector
)
513 /* Loop over the char values represented in the vector. */
514 int len
= XVECTOR (item
)->size
;
516 for (c
= 0; c
< len
; c
++)
518 Lisp_Object character
;
519 XFASTINT (character
) = c
;
520 item1
= XVECTOR (item
)->contents
[c
];
521 if (XTYPE (item1
) == Lisp_Cons
)
523 item_string
= XCONS (item1
)->car
;
524 if (XTYPE (item_string
) == Lisp_String
)
528 /* These are the saved equivalent keyboard key sequence
529 and its key-description. */
531 Lisp_Object tem
, enabled
;
533 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
535 /* GCPRO because we will call eval.
536 Protecting KEYMAP preserves everything we use;
537 aside from that, must protect whatever might be
538 a string. Since there's no GCPRO5, we refetch
539 item_string instead of protecting it. */
540 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
541 enabled
= menu_item_enabled_p (def
, notreal
);
544 item_string
= XCONS (item1
)->car
;
546 tem
= Fkeymapp (def
);
547 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
548 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
553 submap
= get_keymap_1 (def
, 0, 1);
554 #ifndef USE_X_TOOLKIT
556 item_string
= concat2 (item_string
,
557 build_string (" >"));
559 push_menu_item (item_string
, enabled
, character
,
564 push_submenu_start ();
565 single_keymap_panes (submap
, Qnil
,
577 /* Process now any submenus which want to be panes at this level. */
578 while (!NILP (pending_maps
))
580 Lisp_Object elt
, eltcdr
, string
;
581 elt
= Fcar (pending_maps
);
582 eltcdr
= XCONS (elt
)->cdr
;
583 string
= XCONS (eltcdr
)->car
;
584 /* We no longer discard the @ from the beginning of the string here.
585 Instead, we do this in xmenu_show. */
586 single_keymap_panes (Fcar (elt
), string
,
587 XCONS (eltcdr
)->cdr
, notreal
);
588 pending_maps
= Fcdr (pending_maps
);
592 /* Push all the panes and items of a menu decsribed by the
593 alist-of-alists MENU.
594 This handles old-fashioned calls to x-popup-menu. */
604 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
606 Lisp_Object elt
, pane_name
, pane_data
;
608 pane_name
= Fcar (elt
);
609 CHECK_STRING (pane_name
, 0);
610 push_menu_pane (pane_name
, Qnil
);
611 pane_data
= Fcdr (elt
);
612 CHECK_CONS (pane_data
, 0);
613 list_of_items (pane_data
);
616 finish_menu_items ();
619 /* Push the items in a single pane defined by the alist PANE. */
625 Lisp_Object tail
, item
, item1
;
627 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
631 push_menu_item (item
, Qnil
, Qnil
, Qnil
);
632 else if (NILP (item
))
633 push_left_right_boundary ();
636 CHECK_CONS (item
, 0);
638 CHECK_STRING (item1
, 1);
639 push_menu_item (item1
, Qt
, Fcdr (item
), Qnil
);
644 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
645 "Pop up a deck-of-cards menu and return user's selection.\n\
646 POSITION is a position specification. This is either a mouse button event\n\
647 or a list ((XOFFSET YOFFSET) WINDOW)\n\
648 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
649 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
650 This controls the position of the center of the first line\n\
651 in the first pane of the menu, not the top left of the menu as a whole.\n\
652 If POSITION is t, it means to use the current mouse position.\n\
654 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
655 The menu items come from key bindings that have a menu string as well as\n\
656 a definition; actually, the \"definition\" in such a key binding looks like\n\
657 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
658 the keymap as a top-level element.\n\n\
659 You can also use a list of keymaps as MENU.\n\
660 Then each keymap makes a separate pane.\n\
661 When MENU is a keymap or a list of keymaps, the return value\n\
662 is a list of events.\n\n\
663 Alternatively, you can specify a menu of multiple panes\n\
664 with a list of the form (TITLE PANE1 PANE2...),\n\
665 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
666 Each ITEM is normally a cons cell (STRING . VALUE);\n\
667 but a string can appear as an item--that makes a nonselectable line\n\
669 With this form of menu, the return value is VALUE from the chosen item.\n\
671 If POSITION is nil, don't display the menu at all, just precalculate the\n\
672 cached information about equivalent key sequences.")
674 Lisp_Object position
, menu
;
676 int number_of_panes
, panes
;
677 Lisp_Object keymap
, tem
;
681 Lisp_Object selection
;
684 Lisp_Object x
, y
, window
;
689 if (! NILP (position
))
693 /* Decode the first argument: find the window and the coordinates. */
694 if (EQ (position
, Qt
))
696 /* Use the mouse's current position. */
698 Lisp_Object bar_window
;
702 if (mouse_position_hook
)
703 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
705 XSET (window
, Lisp_Frame
, new_f
);
708 window
= selected_window
;
715 tem
= Fcar (position
);
716 if (XTYPE (tem
) == Lisp_Cons
)
718 window
= Fcar (Fcdr (position
));
720 y
= Fcar (Fcdr (tem
));
724 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
725 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
726 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
730 /* Determine whether this menu is handling a menu bar click. */
731 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
732 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
740 /* Decode where to put the menu. */
742 if (XTYPE (window
) == Lisp_Frame
)
749 else if (XTYPE (window
) == Lisp_Window
)
751 CHECK_LIVE_WINDOW (window
, 0);
752 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
754 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
755 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
758 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
759 but I don't want to make one now. */
760 CHECK_WINDOW (window
, 0);
769 /* Decode the menu items from what was specified. */
771 keymap
= Fkeymapp (menu
);
773 if (XTYPE (menu
) == Lisp_Cons
)
774 tem
= Fkeymapp (Fcar (menu
));
777 /* We were given a keymap. Extract menu info from the keymap. */
779 keymap
= get_keymap (menu
);
781 /* Extract the detailed info to make one pane. */
782 keymap_panes (&menu
, 1, NILP (position
));
784 /* Search for a string appearing directly as an element of the keymap.
785 That string is the title of the menu. */
786 prompt
= map_prompt (keymap
);
788 /* Make that be the pane title of the first pane. */
789 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
790 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
794 else if (!NILP (tem
))
796 /* We were given a list of keymaps. */
797 int nmaps
= XFASTINT (Flength (menu
));
799 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
804 /* The first keymap that has a prompt string
805 supplies the menu title. */
806 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
810 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
812 prompt
= map_prompt (keymap
);
813 if (NILP (title
) && !NILP (prompt
))
817 /* Extract the detailed info to make one pane. */
818 keymap_panes (maps
, nmaps
, NILP (position
));
820 /* Make the title be the pane title of the first pane. */
821 if (!NILP (title
) && menu_items_n_panes
>= 0)
822 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
828 /* We were given an old-fashioned menu. */
830 CHECK_STRING (title
, 1);
832 list_of_panes (Fcdr (menu
));
839 discard_menu_items ();
844 /* Display them in a menu. */
847 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
,
848 keymaps
, title
, &error_name
);
851 discard_menu_items ();
855 if (error_name
) error (error_name
);
859 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
860 "Pop up a dialog box and return user's selection.\n\
861 POSITION specifies which frame to use.\n\
862 This is normally a mouse button event or a window or frame.\n\
863 If POSITION is t, it means to use the frame the mouse is on.\n\
864 The dialog box appears in the middle of the specified frame.\n\
866 CONTENTS specifies the alternatives to display in the dialog box.\n\
867 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
868 Each ITEM is a cons cell (STRING . VALUE).\n\
869 The return value is VALUE from the chosen item.\n\n\
870 An ITEM may also be just a string--that makes a nonselectable item.\n\
871 An ITEM may also be nil--that means to put all preceding items\n\
872 on the left of the dialog box and all following items on the right.\n\
873 \(By default, approximately half appear on each side.)")
875 Lisp_Object position
, contents
;
882 /* Decode the first argument: find the window or frame to use. */
883 if (EQ (position
, Qt
))
885 #if 0 /* Using the frame the mouse is on may not be right. */
886 /* Use the mouse's current position. */
888 Lisp_Object bar_window
;
893 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
896 XSET (window
, Lisp_Frame
, new_f
);
898 window
= selected_window
;
900 /* Decode the first argument: find the window and the coordinates. */
901 if (EQ (position
, Qt
))
902 window
= selected_window
;
904 else if (CONSP (position
))
907 tem
= Fcar (position
);
908 if (XTYPE (tem
) == Lisp_Cons
)
909 window
= Fcar (Fcdr (position
));
912 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
913 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
916 else if (WINDOWP (position
) || FRAMEP (position
))
919 /* Decode where to put the menu. */
921 if (XTYPE (window
) == Lisp_Frame
)
923 else if (XTYPE (window
) == Lisp_Window
)
925 CHECK_LIVE_WINDOW (window
, 0);
926 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
929 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
930 but I don't want to make one now. */
931 CHECK_WINDOW (window
, 0);
933 #ifndef USE_X_TOOLKIT
934 /* Display a menu with these alternatives
935 in the middle of frame F. */
937 Lisp_Object x
, y
, frame
, newpos
;
938 XSET (frame
, Lisp_Frame
, f
);
939 XSET (x
, Lisp_Int
, x_pixel_width (f
) / 2);
940 XSET (y
, Lisp_Int
, x_pixel_height (f
) / 2);
941 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
943 return Fx_popup_menu (newpos
,
944 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
950 Lisp_Object selection
;
952 /* Decode the dialog items from what was specified. */
953 title
= Fcar (contents
);
954 CHECK_STRING (title
, 1);
956 list_of_panes (Fcons (contents
, Qnil
));
958 /* Display them in a dialog box. */
960 selection
= xdialog_show (f
, 0, 0, title
, &error_name
);
963 discard_menu_items ();
965 if (error_name
) error (error_name
);
974 dispatch_dummy_expose (w
, x
, y
)
982 dummy
.window
= XtWindow (w
);
985 dummy
.send_event
= 0;
986 dummy
.display
= XtDisplay (w
);
990 XtDispatchEvent ((XEvent
*) &dummy
);
994 event_is_in_menu_item (mw
, event
, name
, string_w
)
996 struct input_event
*event
;
1000 *string_w
+= (string_width (mw
, name
)
1001 + 2 * (mw
->menu
.horizontal_spacing
1002 + mw
->menu
.shadow_thickness
));
1003 return XINT (event
->x
) < *string_w
;
1007 /* Return the menu bar key which corresponds to event EVENT in frame F. */
1010 map_event_to_object (event
, f
)
1011 struct input_event
*event
;
1016 XlwMenuWidget mw
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1021 /* Find the window */
1022 for (val
= mw
->menu
.old_stack
[0]->contents
; val
; val
= val
->next
)
1024 ws
= &mw
->menu
.windows
[0];
1025 if (ws
&& event_is_in_menu_item (mw
, event
, val
->name
, &string_w
))
1030 items
= FRAME_MENU_BAR_ITEMS (f
);
1032 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1034 Lisp_Object pos
, string
, item
;
1035 item
= XVECTOR (items
)->contents
[i
];
1036 string
= XVECTOR (items
)->contents
[i
+ 1];
1037 pos
= XVECTOR (items
)->contents
[i
+ 2];
1041 if (!strcmp (val
->name
, XSTRING (string
)->data
))
1049 static Lisp_Object
*menu_item_selection
;
1052 popup_selection_callback (widget
, id
, client_data
)
1055 XtPointer client_data
;
1057 menu_item_selection
= (Lisp_Object
*) client_data
;
1061 popup_down_callback (widget
, id
, client_data
)
1064 XtPointer client_data
;
1067 lw_destroy_all_widgets (id
);
1072 dialog_selection_callback (widget
, id
, client_data
)
1075 XtPointer client_data
;
1077 if ((int)client_data
!= -1)
1078 menu_item_selection
= (Lisp_Object
*) client_data
;
1080 lw_destroy_all_widgets (id
);
1084 /* This recursively calls free_widget_value() on the tree of widgets.
1085 It must free all data that was malloc'ed for these widget_values.
1086 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1087 must be left alone. */
1090 free_menubar_widget_value_tree (wv
)
1095 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1097 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1099 free_menubar_widget_value_tree (wv
->contents
);
1100 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1104 free_menubar_widget_value_tree (wv
->next
);
1105 wv
->next
= (widget_value
*) 0xDEADBEEF;
1108 free_widget_value (wv
);
1112 extern void EmacsFrameSetCharSize ();
1115 update_frame_menubar (f
)
1118 struct x_display
*x
= f
->display
.x
;
1120 int menubar_changed
;
1122 menubar_changed
= (x
->menubar_widget
1123 && !XtIsManaged (x
->menubar_widget
));
1125 if (! (menubar_changed
))
1129 /* Save the size of the frame because the pane widget doesn't accept to
1130 resize itself. So force it. */
1135 XawPanedSetRefigureMode (x
->column_widget
, 0);
1137 /* the order in which children are managed is the top to
1138 bottom order in which they are displayed in the paned window.
1139 First, remove the text-area widget.
1141 XtUnmanageChild (x
->edit_widget
);
1143 /* remove the menubar that is there now, and put up the menubar that
1146 if (menubar_changed
)
1148 XtManageChild (x
->menubar_widget
);
1149 XtMapWidget (x
->menubar_widget
);
1150 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1154 /* Re-manage the text-area widget */
1155 XtManageChild (x
->edit_widget
);
1157 /* and now thrash the sizes */
1158 XawPanedSetRefigureMode (x
->column_widget
, 1);
1160 /* Force the pane widget to resize itself with the right values. */
1161 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1167 set_frame_menubar (f
, first_time
)
1171 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1173 Lisp_Object tail
, items
;
1174 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
1179 wv
= malloc_widget_value ();
1180 wv
->name
= "menubar";
1183 save_wv
= first_wv
= wv
;
1185 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1186 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1188 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1192 string
= XVECTOR (items
)->contents
[i
+ 1];
1196 wv
= malloc_widget_value ();
1200 save_wv
->contents
= wv
;
1201 wv
->name
= (char *) XSTRING (string
)->data
;
1208 lw_modify_all_widgets (id
, first_wv
, False
);
1211 menubar_widget
= lw_create_widget ("menubar", "menubar",
1213 f
->display
.x
->column_widget
,
1216 f
->display
.x
->menubar_widget
= menubar_widget
;
1217 XtVaSetValues (menubar_widget
,
1219 XtNresizeToPreferred
, 1,
1224 free_menubar_widget_value_tree (first_wv
);
1226 /* Don't update the menubar the first time it is created via x_window. */
1228 update_frame_menubar (f
);
1234 free_frame_menubar (f
)
1237 Widget menubar_widget
;
1240 menubar_widget
= f
->display
.x
->menubar_widget
;
1246 lw_destroy_all_widgets (id
);
1250 /* Called from Fx_create_frame to create the inital menubar of a frame
1251 before it is mapped, so that the window is mapped with the menubar already
1252 there instead of us tacking it on later and thrashing the window after it
1255 initialize_frame_menubar (f
)
1258 set_frame_menubar (f
, 1);
1261 /* Horizontal bounds of the current menu bar item. */
1263 static int this_menu_bar_item_beg
;
1264 static int this_menu_bar_item_end
;
1266 /* Horizontal position of the end of the last menu bar item. */
1268 static int last_menu_bar_item_end
;
1270 /* Nonzero if position X, Y is in the menu bar and in some menu bar item
1271 but not in the current menu bar item. */
1274 other_menu_bar_item_p (f
, x
, y
)
1279 && f
->display
.x
->menubar_widget
!= 0
1280 && y
< f
->display
.x
->menubar_widget
->core
.height
1282 && x
< last_menu_bar_item_end
1283 && (x
>= this_menu_bar_item_end
1284 || x
< this_menu_bar_item_beg
));
1287 /* Unread a button-press event in the menu bar of frame F
1288 at x position XPOS relative to the inside of the frame. */
1291 unread_menu_bar_button (f
, xpos
)
1297 event
.type
= ButtonPress
;
1298 event
.xbutton
.display
= x_current_display
;
1299 event
.xbutton
.serial
= 0;
1300 event
.xbutton
.send_event
= 0;
1301 event
.xbutton
.time
= CurrentTime
;
1302 event
.xbutton
.button
= Button1
;
1303 event
.xbutton
.window
= XtWindow (f
->display
.x
->menubar_widget
);
1304 event
.xbutton
.x
= xpos
;
1305 XPutBackEvent (XDISPLAY
&event
);
1308 /* If the mouse has moved to another menu bar item,
1309 return 1 and unread a button press event for that item.
1310 Otherwise return 0. */
1313 check_mouse_other_menu_bar (f
)
1317 Lisp_Object bar_window
;
1322 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1324 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1326 unread_menu_bar_button (f
, x
);
1332 #endif /* USE_X_TOOLKIT */
1334 /* xmenu_show actually displays a menu using the panes and items in menu_items
1335 and returns the value selected from it.
1336 There are two versions of xmenu_show, one for Xt and one for Xlib.
1337 Both assume input is blocked by the caller. */
1339 /* F is the frame the menu is for.
1340 X and Y are the frame-relative specified position,
1341 relative to the inside upper left corner of the frame F.
1342 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1343 KEYMAPS is 1 if this menu was specified with keymaps;
1344 in that case, we return a list containing the chosen item's value
1345 and perhaps also the pane's prefix.
1346 TITLE is the specified menu title.
1347 ERROR is a place to store an error message string in case of failure.
1348 (We return nil on failure, but the value doesn't actually matter.) */
1350 #ifdef USE_X_TOOLKIT
1352 extern unsigned int x_mouse_grabbed
;
1353 extern Lisp_Object Vmouse_depressed
;
1356 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1368 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1370 /* This is the menu bar item (if any) that led to this menu. */
1371 widget_value
*menubar_item
= 0;
1373 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1374 widget_value
**submenu_stack
1375 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1376 Lisp_Object
*subprefix_stack
1377 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1378 int submenu_depth
= 0;
1380 /* Define a queue to save up for later unreading
1381 all X events that don't pertain to the menu. */
1385 struct event_queue
*next
;
1388 struct event_queue
*queue
= NULL
;
1389 struct event_queue
*queue_tmp
;
1391 Position root_x
, root_y
;
1397 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1399 *error
= "Empty menu";
1402 this_menu_bar_item_beg
= -1;
1403 this_menu_bar_item_end
= -1;
1404 last_menu_bar_item_end
= -1;
1406 /* Figure out which menu bar item, if any, this menu is for. */
1411 widget_value
*mb_item
= 0;
1413 for (mb_item
= menubar
->menu
.old_stack
[0]->contents
;
1415 mb_item
= mb_item
->next
)
1418 xend
+= (string_width (menubar
, mb_item
->name
)
1419 + 2 * (menubar
->menu
.horizontal_spacing
1420 + menubar
->menu
.shadow_thickness
));
1421 if (x
>= xbeg
&& x
< xend
)
1425 menubar_item
= mb_item
;
1426 /* Arrange to show a different menu if we move in the menu bar
1427 to a different item. */
1428 this_menu_bar_item_beg
= xbeg
;
1429 this_menu_bar_item_end
= xend
;
1432 last_menu_bar_item_end
= xend
;
1434 if (menubar_item
== 0)
1437 /* Offset the coordinates to root-relative. */
1438 if (f
->display
.x
->menubar_widget
!= 0)
1439 y
+= f
->display
.x
->menubar_widget
->core
.height
;
1440 XtTranslateCoords (f
->display
.x
->widget
,
1441 x
, y
, &root_x
, &root_y
);
1445 /* Create a tree of widget_value objects
1446 representing the panes and their items. */
1447 wv
= malloc_widget_value ();
1454 /* Loop over all panes and items, filling in the tree. */
1456 while (i
< menu_items_used
)
1458 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1460 submenu_stack
[submenu_depth
++] = save_wv
;
1466 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1469 save_wv
= submenu_stack
[--submenu_depth
];
1473 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1474 && submenu_depth
!= 0)
1475 i
+= MENU_ITEMS_PANE_LENGTH
;
1476 /* Ignore a nil in the item list.
1477 It's meaningful only for dialog boxes. */
1478 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1480 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1482 /* Create a new pane. */
1483 Lisp_Object pane_name
, prefix
;
1485 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1486 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1487 pane_string
= (NILP (pane_name
)
1488 ? "" : (char *) XSTRING (pane_name
)->data
);
1489 /* If there is just one top-level pane, put all its items directly
1490 under the top-level menu. */
1491 if (menu_items_n_panes
== 1)
1494 /* If the pane has a meaningful name,
1495 make the pane a top-level menu item
1496 with its items as a submenu beneath it. */
1497 if (!keymaps
&& strcmp (pane_string
, ""))
1499 wv
= malloc_widget_value ();
1503 first_wv
->contents
= wv
;
1504 wv
->name
= pane_string
;
1505 if (keymaps
&& !NILP (prefix
))
1512 else if (first_pane
)
1518 i
+= MENU_ITEMS_PANE_LENGTH
;
1522 /* Create a new item within current pane. */
1523 Lisp_Object item_name
, enable
, descrip
;
1524 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1525 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1527 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1529 wv
= malloc_widget_value ();
1533 save_wv
->contents
= wv
;
1534 wv
->name
= (char *) XSTRING (item_name
)->data
;
1535 if (!NILP (descrip
))
1536 wv
->key
= (char *) XSTRING (descrip
)->data
;
1538 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1539 wv
->enabled
= !NILP (enable
);
1542 i
+= MENU_ITEMS_ITEM_LENGTH
;
1546 /* Actually create the menu. */
1547 menu_id
= ++popup_id_tick
;
1548 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1549 f
->display
.x
->widget
, 1, 0,
1550 popup_selection_callback
, popup_down_callback
);
1551 /* Free the widget_value objects we used to specify the contents. */
1552 free_menubar_widget_value_tree (first_wv
);
1554 /* No selection has been chosen yet. */
1555 menu_item_selection
= 0;
1557 /* If the mouse moves out of the menu before we show the menu,
1558 don't show it at all. */
1559 if (check_mouse_other_menu_bar (f
))
1561 lw_destroy_all_widgets (menu_id
);
1566 /* Highlight the menu bar item (if any) that led to this menu. */
1569 menubar_item
->call_data
= (XtPointer
) 1;
1570 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1573 /* Display the menu. */
1575 XButtonPressedEvent dummy
;
1578 mw
= (XlwMenuWidget
) ((CompositeWidget
)menu
)->composite
.children
[0];
1580 dummy
.type
= ButtonPress
;
1582 dummy
.send_event
= 0;
1583 dummy
.display
= XtDisplay (menu
);
1584 dummy
.window
= XtWindow (XtParent (menu
));
1585 dummy
.time
= CurrentTime
;
1590 /* We activate directly the lucid implementation. */
1591 pop_up_menu (mw
, &dummy
);
1594 /* No need to check a second time since this is done in the XEvent loop.
1595 This slows done the execution. */
1597 /* Check again whether the mouse has moved to another menu bar item. */
1598 if (check_mouse_other_menu_bar (f
))
1600 /* The mouse moved into a different menu bar item.
1601 We should bring up that item's menu instead.
1602 First pop down this menu. */
1603 XtUngrabPointer ((Widget
)
1605 ((CompositeWidget
)menu
)->composite
.children
[0]),
1607 lw_destroy_all_widgets (menu_id
);
1612 /* Process events that apply to the menu. */
1617 XtAppNextEvent (Xt_app_con
, &event
);
1618 if (event
.type
== ButtonRelease
)
1620 XtDispatchEvent (&event
);
1623 /* Do the work of construct_mouse_click since it can't
1624 be called. Initially, the popup menu has been called
1625 from a ButtonPress in the edit_widget. Then the mouse
1626 has been set to grabbed. Reset it now. */
1627 x_mouse_grabbed
&= ~(1 << event
.xbutton
.button
);
1628 if (!x_mouse_grabbed
)
1629 Vmouse_depressed
= Qnil
;
1633 else if (event
.type
== Expose
)
1634 process_expose_from_menu (event
);
1635 else if (event
.type
== MotionNotify
)
1637 int event_x
= (event
.xmotion
.x_root
1638 - (f
->display
.x
->widget
->core
.x
1639 + f
->display
.x
->widget
->core
.border_width
));
1640 int event_y
= (event
.xmotion
.y_root
1641 - (f
->display
.x
->widget
->core
.y
1642 + f
->display
.x
->widget
->core
.border_width
));
1644 if (other_menu_bar_item_p (f
, event_x
, event_y
))
1646 /* The mouse moved into a different menu bar item.
1647 We should bring up that item's menu instead.
1648 First pop down this menu. */
1649 XtUngrabPointer ((Widget
)
1651 ((CompositeWidget
)menu
)->composite
.children
[0]),
1652 event
.xbutton
.time
);
1653 lw_destroy_all_widgets (menu_id
);
1655 /* Put back an event that will bring up the other item's menu. */
1656 unread_menu_bar_button (f
, event_x
);
1657 /* Don't let us select anything in this case. */
1658 menu_item_selection
= 0;
1663 XtDispatchEvent (&event
);
1664 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1667 = (struct event_queue
*) malloc (sizeof (struct event_queue
));
1669 if (queue_tmp
!= NULL
)
1671 queue_tmp
->event
= event
;
1672 queue_tmp
->next
= queue
;
1679 /* Unhighlight the menu bar item (if any) that led to this menu. */
1682 menubar_item
->call_data
= (XtPointer
) 0;
1683 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1686 /* fp turned off the following statement and wrote a comment
1687 that it is unnecessary--that the menu has already disappeared.
1688 I observer that is not so. -- rms. */
1689 /* Make sure the menu disappears. */
1690 lw_destroy_all_widgets (menu_id
);
1692 /* Unread any events that we got but did not handle. */
1693 while (queue
!= NULL
)
1696 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1697 queue
= queue_tmp
->next
;
1698 free ((char *)queue_tmp
);
1699 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1700 interrupt_input_pending
= 1;
1703 /* Find the selected item, and its pane, to return
1704 the proper value. */
1705 if (menu_item_selection
!= 0)
1711 while (i
< menu_items_used
)
1715 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1717 subprefix_stack
[submenu_depth
++] = prefix
;
1721 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1723 prefix
= subprefix_stack
[--submenu_depth
];
1726 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1729 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1730 i
+= MENU_ITEMS_PANE_LENGTH
;
1735 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1736 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1742 entry
= Fcons (entry
, Qnil
);
1744 entry
= Fcons (prefix
, entry
);
1745 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1746 if (!NILP (subprefix_stack
[j
]))
1747 entry
= Fcons (subprefix_stack
[j
], entry
);
1751 i
+= MENU_ITEMS_ITEM_LENGTH
;
1759 static char * button_names
[] = {
1760 "button1", "button2", "button3", "button4", "button5",
1761 "button6", "button7", "button8", "button9", "button10" };
1764 xdialog_show (f
, menubarp
, keymaps
, title
, error
)
1771 int i
, nb_buttons
=0;
1774 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1775 char dialog_name
[6];
1777 /* This is the menu bar item (if any) that led to this menu. */
1778 widget_value
*menubar_item
= 0;
1780 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1782 /* Define a queue to save up for later unreading
1783 all X events that don't pertain to the menu. */
1787 struct event_queue
*next
;
1790 struct event_queue
*queue
= NULL
;
1791 struct event_queue
*queue_tmp
;
1793 /* Number of elements seen so far, before boundary. */
1795 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1796 int boundary_seen
= 0;
1800 if (menu_items_n_panes
> 1)
1802 *error
= "Multiple panes in dialog box";
1806 /* Create a tree of widget_value objects
1807 representing the text label and buttons. */
1809 Lisp_Object pane_name
, prefix
;
1811 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1812 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1813 pane_string
= (NILP (pane_name
)
1814 ? "" : (char *) XSTRING (pane_name
)->data
);
1815 prev_wv
= malloc_widget_value ();
1816 prev_wv
->value
= pane_string
;
1817 if (keymaps
&& !NILP (prefix
))
1819 prev_wv
->enabled
= 1;
1820 prev_wv
->name
= "message";
1823 /* Loop over all panes and items, filling in the tree. */
1824 i
= MENU_ITEMS_PANE_LENGTH
;
1825 while (i
< menu_items_used
)
1828 /* Create a new item within current pane. */
1829 Lisp_Object item_name
, enable
, descrip
;
1830 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1831 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1833 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1835 if (NILP (item_name
))
1837 free_menubar_widget_value_tree (first_wv
);
1838 *error
= "Submenu in dialog items";
1841 if (EQ (item_name
, Qquote
))
1843 /* This is the boundary between left-side elts
1844 and right-side elts. Stop incrementing right_count. */
1849 if (nb_buttons
>= 10)
1851 free_menubar_widget_value_tree (first_wv
);
1852 *error
= "Too many dialog items";
1856 wv
= malloc_widget_value ();
1858 wv
->name
= (char *) button_names
[nb_buttons
];
1859 if (!NILP (descrip
))
1860 wv
->key
= (char *) XSTRING (descrip
)->data
;
1861 wv
->value
= (char *) XSTRING (item_name
)->data
;
1862 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1863 wv
->enabled
= !NILP (enable
);
1866 if (! boundary_seen
)
1870 i
+= MENU_ITEMS_ITEM_LENGTH
;
1873 /* If the boundary was not specified,
1874 by default put half on the left and half on the right. */
1875 if (! boundary_seen
)
1876 left_count
= nb_buttons
- nb_buttons
/ 2;
1878 wv
= malloc_widget_value ();
1879 wv
->name
= dialog_name
;
1881 /* Dialog boxes use a really stupid name encoding
1882 which specifies how many buttons to use
1883 and how many buttons are on the right.
1884 The Q means something also. */
1885 dialog_name
[0] = 'Q';
1886 dialog_name
[1] = '0' + nb_buttons
;
1887 dialog_name
[2] = 'B';
1888 dialog_name
[3] = 'R';
1889 /* Number of buttons to put on the right. */
1890 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1892 wv
->contents
= first_wv
;
1896 /* Actually create the dialog. */
1897 dialog_id
= ++popup_id_tick
;
1898 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1899 f
->display
.x
->widget
, 1, 0,
1900 dialog_selection_callback
, 0);
1901 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1902 lw_modify_all_widgets (dialog_id
, first_wv
, True
);
1904 lw_modify_all_widgets (dialog_id
, first_wv
->contents
->next
, True
);
1905 /* Free the widget_value objects we used to specify the contents. */
1906 free_menubar_widget_value_tree (first_wv
);
1908 /* No selection has been chosen yet. */
1909 menu_item_selection
= 0;
1911 /* Display the menu. */
1912 lw_pop_up_all_widgets (dialog_id
);
1914 /* Process events that apply to the menu. */
1919 XtAppNextEvent (Xt_app_con
, &event
);
1920 if (event
.type
== ButtonRelease
)
1922 XtDispatchEvent (&event
);
1925 else if (event
.type
== Expose
)
1926 process_expose_from_menu (event
);
1927 XtDispatchEvent (&event
);
1928 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1930 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1932 if (queue_tmp
!= NULL
)
1934 queue_tmp
->event
= event
;
1935 queue_tmp
->next
= queue
;
1942 /* State that no mouse buttons are now held.
1943 That is not necessarily true, but the fiction leads to reasonable
1944 results, and it is a pain to ask which are actually held now
1945 or track this in the loop above. */
1946 x_mouse_grabbed
= 0;
1948 /* Unread any events that we got but did not handle. */
1949 while (queue
!= NULL
)
1952 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1953 queue
= queue_tmp
->next
;
1954 free ((char *)queue_tmp
);
1955 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1956 interrupt_input_pending
= 1;
1959 /* Find the selected item, and its pane, to return
1960 the proper value. */
1961 if (menu_item_selection
!= 0)
1967 while (i
< menu_items_used
)
1971 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1974 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1975 i
+= MENU_ITEMS_PANE_LENGTH
;
1980 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1981 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1985 entry
= Fcons (entry
, Qnil
);
1987 entry
= Fcons (prefix
, entry
);
1991 i
+= MENU_ITEMS_ITEM_LENGTH
;
1998 #else /* not USE_X_TOOLKIT */
2001 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
2011 int pane
, selidx
, lpane
, status
;
2012 Lisp_Object entry
, pane_prefix
;
2014 int ulx
, uly
, width
, height
;
2015 int dispwidth
, dispheight
;
2019 unsigned int dummy_uint
;
2022 if (menu_items_n_panes
== 0)
2025 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2027 *error
= "Empty menu";
2031 /* Figure out which root window F is on. */
2032 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
2033 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2034 &dummy_uint
, &dummy_uint
);
2036 /* Make the menu on that window. */
2037 menu
= XMenuCreate (XDISPLAY root
, "emacs");
2040 *error
= "Can't create menu";
2044 /* Adjust coordinates to relative to the outer (window manager) window. */
2048 int win_x
= 0, win_y
= 0;
2050 /* Find the position of the outside upper-left corner of
2051 the inner window, with respect to the outer window. */
2052 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2055 XTranslateCoordinates (x_current_display
,
2057 /* From-window, to-window. */
2058 f
->display
.x
->window_desc
,
2059 f
->display
.x
->parent_desc
,
2061 /* From-position, to-position. */
2062 0, 0, &win_x
, &win_y
,
2064 /* Child of window. */
2071 #endif /* HAVE_X11 */
2073 /* Adjust coordinates to be root-window-relative. */
2074 x
+= f
->display
.x
->left_pos
;
2075 y
+= f
->display
.x
->top_pos
;
2077 /* Create all the necessary panes and their items. */
2079 while (i
< menu_items_used
)
2081 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2083 /* Create a new pane. */
2084 Lisp_Object pane_name
, prefix
;
2087 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2088 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2089 pane_string
= (NILP (pane_name
)
2090 ? "" : (char *) XSTRING (pane_name
)->data
);
2091 if (keymaps
&& !NILP (prefix
))
2094 lpane
= XMenuAddPane (XDISPLAY menu
, pane_string
, TRUE
);
2095 if (lpane
== XM_FAILURE
)
2097 XMenuDestroy (XDISPLAY menu
);
2098 *error
= "Can't create pane";
2101 i
+= MENU_ITEMS_PANE_LENGTH
;
2103 /* Find the width of the widest item in this pane. */
2106 while (j
< menu_items_used
)
2109 item
= XVECTOR (menu_items
)->contents
[j
];
2117 width
= XSTRING (item
)->size
;
2118 if (width
> maxwidth
)
2121 j
+= MENU_ITEMS_ITEM_LENGTH
;
2124 /* Ignore a nil in the item list.
2125 It's meaningful only for dialog boxes. */
2126 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2130 /* Create a new item within current pane. */
2131 Lisp_Object item_name
, enable
, descrip
;
2132 unsigned char *item_data
;
2134 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2135 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2137 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2138 if (!NILP (descrip
))
2140 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2143 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2144 item_name
= concat2 (item_name
, spacer
);
2145 item_name
= concat2 (item_name
, descrip
);
2146 item_data
= XSTRING (item_name
)->data
;
2148 /* if alloca is fast, use that to make the space,
2149 to reduce gc needs. */
2151 = (unsigned char *) alloca (maxwidth
2152 + XSTRING (descrip
)->size
+ 1);
2153 bcopy (XSTRING (item_name
)->data
, item_data
,
2154 XSTRING (item_name
)->size
);
2155 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2157 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2158 XSTRING (descrip
)->size
);
2159 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2163 item_data
= XSTRING (item_name
)->data
;
2165 if (XMenuAddSelection (XDISPLAY menu
, lpane
, 0, item_data
,
2169 XMenuDestroy (XDISPLAY menu
);
2170 *error
= "Can't add selection to menu";
2173 i
+= MENU_ITEMS_ITEM_LENGTH
;
2177 /* All set and ready to fly. */
2178 XMenuRecompute (XDISPLAY menu
);
2179 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
2180 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
2181 x
= min (x
, dispwidth
);
2182 y
= min (y
, dispheight
);
2185 XMenuLocate (XDISPLAY menu
, 0, 0, x
, y
,
2186 &ulx
, &uly
, &width
, &height
);
2187 if (ulx
+width
> dispwidth
)
2189 x
-= (ulx
+ width
) - dispwidth
;
2190 ulx
= dispwidth
- width
;
2192 if (uly
+height
> dispheight
)
2194 y
-= (uly
+ height
) - dispheight
;
2195 uly
= dispheight
- height
;
2197 if (ulx
< 0) x
-= ulx
;
2198 if (uly
< 0) y
-= uly
;
2200 XMenuSetAEQ (menu
, TRUE
);
2201 XMenuSetFreeze (menu
, TRUE
);
2204 status
= XMenuActivate (XDISPLAY menu
, &pane
, &selidx
,
2205 x
, y
, ButtonReleaseMask
, &datap
);
2210 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2213 /* Find the item number SELIDX in pane number PANE. */
2215 while (i
< menu_items_used
)
2217 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2221 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2223 i
+= MENU_ITEMS_PANE_LENGTH
;
2232 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2235 entry
= Fcons (entry
, Qnil
);
2236 if (!NILP (pane_prefix
))
2237 entry
= Fcons (pane_prefix
, entry
);
2243 i
+= MENU_ITEMS_ITEM_LENGTH
;
2249 XMenuDestroy (XDISPLAY menu
);
2250 *error
= "Can't activate menu";
2256 XMenuDestroy (XDISPLAY menu
);
2258 /* State that no mouse buttons are now held.
2259 (The oldXMenu code doesn't track this info for us.)
2260 That is not necessarily true, but the fiction leads to reasonable
2261 results, and it is a pain to ask which are actually held now. */
2262 x_mouse_grabbed
= 0;
2266 #endif /* not USE_X_TOOLKIT */
2270 staticpro (&menu_items
);
2273 popup_id_tick
= (1<<16);
2274 defsubr (&Sx_popup_menu
);
2275 defsubr (&Sx_popup_dialog
);