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 the command is an alias for another
328 (such as easymenu.el and lmenu.el set it up),
329 check if the original command matches the cached command. */
330 && !(SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
)
331 && EQ (def1
, XSYMBOL (def
)->function
))
332 /* If something had no key binding before, don't recheck it--
333 doing that takes too much time and makes menus too slow. */
334 && !(!NILP (cachelist
) && NILP (savedkey
)))
338 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
339 /* If the command is an alias for another
340 (such as easymenu.el and lmenu.el set it up),
341 see if the original command name has equivalent keys. */
342 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
343 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
346 if (VECTORP (savedkey
)
347 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
349 if (!NILP (savedkey
))
351 descrip
= Fkey_description (savedkey
);
352 descrip
= concat2 (make_string (" (", 3), descrip
);
353 descrip
= concat2 (descrip
, make_string (")", 1));
357 /* Cache the data we just got in a sublist of the menu binding. */
358 if (NILP (cachelist
))
359 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
362 XCONS (cachelist
)->car
= savedkey
;
363 XCONS (cachelist
)->cdr
= descrip
;
366 *descrip_ptr
= descrip
;
370 /* This is used as the handler when calling internal_condition_case_1. */
373 menu_item_enabled_p_1 (arg
)
379 /* Return non-nil if the command DEF is enabled when used as a menu item.
380 This is based on looking for a menu-enable property.
381 If NOTREAL is set, don't bother really computing this. */
384 menu_item_enabled_p (def
, notreal
)
387 Lisp_Object enabled
, tem
;
392 if (XTYPE (def
) == Lisp_Symbol
)
394 /* No property, or nil, means enable.
395 Otherwise, enable if value is not nil. */
396 tem
= Fget (def
, Qmenu_enable
);
398 /* (condition-case nil (eval tem)
400 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
401 menu_item_enabled_p_1
);
406 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
407 and generate menu panes for them in menu_items.
408 If NOTREAL is nonzero,
409 don't bother really computing whether an item is enabled. */
412 keymap_panes (keymaps
, nmaps
, notreal
)
413 Lisp_Object
*keymaps
;
421 /* Loop over the given keymaps, making a pane for each map.
422 But don't make a pane that is empty--ignore that map instead.
423 P is the number of panes we have made so far. */
424 for (mapno
= 0; mapno
< nmaps
; mapno
++)
425 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
427 finish_menu_items ();
430 /* This is a recursive subroutine of keymap_panes.
431 It handles one keymap, KEYMAP.
432 The other arguments are passed along
433 or point to local variables of the previous function.
434 If NOTREAL is nonzero,
435 don't bother really computing whether an item is enabled. */
438 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
440 Lisp_Object pane_name
;
444 Lisp_Object pending_maps
;
445 Lisp_Object tail
, item
, item1
, item_string
, table
;
446 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
450 push_menu_pane (pane_name
, prefix
);
452 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
454 /* Look at each key binding, and if it has a menu string,
455 make a menu item from it. */
456 item
= XCONS (tail
)->car
;
457 if (XTYPE (item
) == Lisp_Cons
)
459 item1
= XCONS (item
)->cdr
;
460 if (XTYPE (item1
) == Lisp_Cons
)
462 item_string
= XCONS (item1
)->car
;
463 if (XTYPE (item_string
) == Lisp_String
)
465 /* This is the real definition--the function to run. */
467 /* These are the saved equivalent keyboard key sequence
468 and its key-description. */
470 Lisp_Object tem
, enabled
;
472 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
474 /* GCPRO because we will call eval.
475 Protecting KEYMAP preserves everything we use;
476 aside from that, must protect whatever might be
477 a string. Since there's no GCPRO5, we refetch
478 item_string instead of protecting it. */
479 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
480 enabled
= menu_item_enabled_p (def
, notreal
);
484 item_string
= XCONS (item1
)->car
;
486 tem
= Fkeymapp (def
);
487 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
488 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
493 submap
= get_keymap_1 (def
, 0, 1);
494 #ifndef USE_X_TOOLKIT
495 /* Indicate visually that this is a submenu. */
497 item_string
= concat2 (item_string
,
498 build_string (" >"));
500 push_menu_item (item_string
, enabled
, XCONS (item
)->car
,
503 /* Display a submenu using the toolkit. */
506 push_submenu_start ();
507 single_keymap_panes (submap
, Qnil
,
508 XCONS (item
)->car
, notreal
);
516 else if (XTYPE (item
) == Lisp_Vector
)
518 /* Loop over the char values represented in the vector. */
519 int len
= XVECTOR (item
)->size
;
521 for (c
= 0; c
< len
; c
++)
523 Lisp_Object character
;
524 XFASTINT (character
) = c
;
525 item1
= XVECTOR (item
)->contents
[c
];
526 if (XTYPE (item1
) == Lisp_Cons
)
528 item_string
= XCONS (item1
)->car
;
529 if (XTYPE (item_string
) == Lisp_String
)
533 /* These are the saved equivalent keyboard key sequence
534 and its key-description. */
536 Lisp_Object tem
, enabled
;
538 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
540 /* GCPRO because we will call eval.
541 Protecting KEYMAP preserves everything we use;
542 aside from that, must protect whatever might be
543 a string. Since there's no GCPRO5, we refetch
544 item_string instead of protecting it. */
545 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
546 enabled
= menu_item_enabled_p (def
, notreal
);
549 item_string
= XCONS (item1
)->car
;
551 tem
= Fkeymapp (def
);
552 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
553 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
558 submap
= get_keymap_1 (def
, 0, 1);
559 #ifndef USE_X_TOOLKIT
561 item_string
= concat2 (item_string
,
562 build_string (" >"));
564 push_menu_item (item_string
, enabled
, character
,
569 push_submenu_start ();
570 single_keymap_panes (submap
, Qnil
,
582 /* Process now any submenus which want to be panes at this level. */
583 while (!NILP (pending_maps
))
585 Lisp_Object elt
, eltcdr
, string
;
586 elt
= Fcar (pending_maps
);
587 eltcdr
= XCONS (elt
)->cdr
;
588 string
= XCONS (eltcdr
)->car
;
589 /* We no longer discard the @ from the beginning of the string here.
590 Instead, we do this in xmenu_show. */
591 single_keymap_panes (Fcar (elt
), string
,
592 XCONS (eltcdr
)->cdr
, notreal
);
593 pending_maps
= Fcdr (pending_maps
);
597 /* Push all the panes and items of a menu decsribed by the
598 alist-of-alists MENU.
599 This handles old-fashioned calls to x-popup-menu. */
609 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
611 Lisp_Object elt
, pane_name
, pane_data
;
613 pane_name
= Fcar (elt
);
614 CHECK_STRING (pane_name
, 0);
615 push_menu_pane (pane_name
, Qnil
);
616 pane_data
= Fcdr (elt
);
617 CHECK_CONS (pane_data
, 0);
618 list_of_items (pane_data
);
621 finish_menu_items ();
624 /* Push the items in a single pane defined by the alist PANE. */
630 Lisp_Object tail
, item
, item1
;
632 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
636 push_menu_item (item
, Qnil
, Qnil
, Qnil
);
637 else if (NILP (item
))
638 push_left_right_boundary ();
641 CHECK_CONS (item
, 0);
643 CHECK_STRING (item1
, 1);
644 push_menu_item (item1
, Qt
, Fcdr (item
), Qnil
);
649 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
650 "Pop up a deck-of-cards menu and return user's selection.\n\
651 POSITION is a position specification. This is either a mouse button event\n\
652 or a list ((XOFFSET YOFFSET) WINDOW)\n\
653 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
654 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
655 This controls the position of the center of the first line\n\
656 in the first pane of the menu, not the top left of the menu as a whole.\n\
657 If POSITION is t, it means to use the current mouse position.\n\
659 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
660 The menu items come from key bindings that have a menu string as well as\n\
661 a definition; actually, the \"definition\" in such a key binding looks like\n\
662 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
663 the keymap as a top-level element.\n\n\
664 You can also use a list of keymaps as MENU.\n\
665 Then each keymap makes a separate pane.\n\
666 When MENU is a keymap or a list of keymaps, the return value\n\
667 is a list of events.\n\n\
668 Alternatively, you can specify a menu of multiple panes\n\
669 with a list of the form (TITLE PANE1 PANE2...),\n\
670 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
671 Each ITEM is normally a cons cell (STRING . VALUE);\n\
672 but a string can appear as an item--that makes a nonselectable line\n\
674 With this form of menu, the return value is VALUE from the chosen item.\n\
676 If POSITION is nil, don't display the menu at all, just precalculate the\n\
677 cached information about equivalent key sequences.")
679 Lisp_Object position
, menu
;
681 int number_of_panes
, panes
;
682 Lisp_Object keymap
, tem
;
686 Lisp_Object selection
;
689 Lisp_Object x
, y
, window
;
694 if (! NILP (position
))
698 /* Decode the first argument: find the window and the coordinates. */
699 if (EQ (position
, Qt
))
701 /* Use the mouse's current position. */
703 Lisp_Object bar_window
;
707 if (mouse_position_hook
)
708 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
710 XSET (window
, Lisp_Frame
, new_f
);
713 window
= selected_window
;
720 tem
= Fcar (position
);
721 if (XTYPE (tem
) == Lisp_Cons
)
723 window
= Fcar (Fcdr (position
));
725 y
= Fcar (Fcdr (tem
));
729 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
730 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
731 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
735 /* Determine whether this menu is handling a menu bar click. */
736 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
737 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
745 /* Decode where to put the menu. */
747 if (XTYPE (window
) == Lisp_Frame
)
754 else if (XTYPE (window
) == Lisp_Window
)
756 CHECK_LIVE_WINDOW (window
, 0);
757 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
759 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
760 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
763 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
764 but I don't want to make one now. */
765 CHECK_WINDOW (window
, 0);
774 /* Decode the menu items from what was specified. */
776 keymap
= Fkeymapp (menu
);
778 if (XTYPE (menu
) == Lisp_Cons
)
779 tem
= Fkeymapp (Fcar (menu
));
782 /* We were given a keymap. Extract menu info from the keymap. */
784 keymap
= get_keymap (menu
);
786 /* Extract the detailed info to make one pane. */
787 keymap_panes (&menu
, 1, NILP (position
));
789 /* Search for a string appearing directly as an element of the keymap.
790 That string is the title of the menu. */
791 prompt
= map_prompt (keymap
);
793 /* Make that be the pane title of the first pane. */
794 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
795 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
799 else if (!NILP (tem
))
801 /* We were given a list of keymaps. */
802 int nmaps
= XFASTINT (Flength (menu
));
804 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
809 /* The first keymap that has a prompt string
810 supplies the menu title. */
811 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
815 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
817 prompt
= map_prompt (keymap
);
818 if (NILP (title
) && !NILP (prompt
))
822 /* Extract the detailed info to make one pane. */
823 keymap_panes (maps
, nmaps
, NILP (position
));
825 /* Make the title be the pane title of the first pane. */
826 if (!NILP (title
) && menu_items_n_panes
>= 0)
827 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
833 /* We were given an old-fashioned menu. */
835 CHECK_STRING (title
, 1);
837 list_of_panes (Fcdr (menu
));
844 discard_menu_items ();
849 /* Display them in a menu. */
852 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
,
853 keymaps
, title
, &error_name
);
856 discard_menu_items ();
860 if (error_name
) error (error_name
);
864 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
865 "Pop up a dialog box and return user's selection.\n\
866 POSITION specifies which frame to use.\n\
867 This is normally a mouse button event or a window or frame.\n\
868 If POSITION is t, it means to use the frame the mouse is on.\n\
869 The dialog box appears in the middle of the specified frame.\n\
871 CONTENTS specifies the alternatives to display in the dialog box.\n\
872 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
873 Each ITEM is a cons cell (STRING . VALUE).\n\
874 The return value is VALUE from the chosen item.\n\n\
875 An ITEM may also be just a string--that makes a nonselectable item.\n\
876 An ITEM may also be nil--that means to put all preceding items\n\
877 on the left of the dialog box and all following items on the right.\n\
878 \(By default, approximately half appear on each side.)")
880 Lisp_Object position
, contents
;
887 /* Decode the first argument: find the window or frame to use. */
888 if (EQ (position
, Qt
))
890 #if 0 /* Using the frame the mouse is on may not be right. */
891 /* Use the mouse's current position. */
893 Lisp_Object bar_window
;
898 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
901 XSET (window
, Lisp_Frame
, new_f
);
903 window
= selected_window
;
905 /* Decode the first argument: find the window and the coordinates. */
906 if (EQ (position
, Qt
))
907 window
= selected_window
;
909 else if (CONSP (position
))
912 tem
= Fcar (position
);
913 if (XTYPE (tem
) == Lisp_Cons
)
914 window
= Fcar (Fcdr (position
));
917 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
918 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
921 else if (WINDOWP (position
) || FRAMEP (position
))
924 /* Decode where to put the menu. */
926 if (XTYPE (window
) == Lisp_Frame
)
928 else if (XTYPE (window
) == Lisp_Window
)
930 CHECK_LIVE_WINDOW (window
, 0);
931 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
934 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
935 but I don't want to make one now. */
936 CHECK_WINDOW (window
, 0);
938 #ifndef USE_X_TOOLKIT
939 /* Display a menu with these alternatives
940 in the middle of frame F. */
942 Lisp_Object x
, y
, frame
, newpos
;
943 XSET (frame
, Lisp_Frame
, f
);
944 XSET (x
, Lisp_Int
, x_pixel_width (f
) / 2);
945 XSET (y
, Lisp_Int
, x_pixel_height (f
) / 2);
946 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
948 return Fx_popup_menu (newpos
,
949 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
955 Lisp_Object selection
;
957 /* Decode the dialog items from what was specified. */
958 title
= Fcar (contents
);
959 CHECK_STRING (title
, 1);
961 list_of_panes (Fcons (contents
, Qnil
));
963 /* Display them in a dialog box. */
965 selection
= xdialog_show (f
, 0, 0, title
, &error_name
);
968 discard_menu_items ();
970 if (error_name
) error (error_name
);
979 dispatch_dummy_expose (w
, x
, y
)
987 dummy
.window
= XtWindow (w
);
990 dummy
.send_event
= 0;
991 dummy
.display
= XtDisplay (w
);
995 XtDispatchEvent ((XEvent
*) &dummy
);
999 event_is_in_menu_item (mw
, event
, name
, string_w
)
1001 struct input_event
*event
;
1005 *string_w
+= (string_width (mw
, name
)
1006 + 2 * (mw
->menu
.horizontal_spacing
1007 + mw
->menu
.shadow_thickness
));
1008 return XINT (event
->x
) < *string_w
;
1012 /* Return the menu bar key which corresponds to event EVENT in frame F. */
1015 map_event_to_object (event
, f
)
1016 struct input_event
*event
;
1021 XlwMenuWidget mw
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1026 /* Find the window */
1027 for (val
= mw
->menu
.old_stack
[0]->contents
; val
; val
= val
->next
)
1029 ws
= &mw
->menu
.windows
[0];
1030 if (ws
&& event_is_in_menu_item (mw
, event
, val
->name
, &string_w
))
1035 items
= FRAME_MENU_BAR_ITEMS (f
);
1037 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1039 Lisp_Object pos
, string
, item
;
1040 item
= XVECTOR (items
)->contents
[i
];
1041 string
= XVECTOR (items
)->contents
[i
+ 1];
1042 pos
= XVECTOR (items
)->contents
[i
+ 2];
1046 if (!strcmp (val
->name
, XSTRING (string
)->data
))
1054 static Lisp_Object
*menu_item_selection
;
1057 popup_selection_callback (widget
, id
, client_data
)
1060 XtPointer client_data
;
1062 menu_item_selection
= (Lisp_Object
*) client_data
;
1066 popup_down_callback (widget
, id
, client_data
)
1069 XtPointer client_data
;
1072 lw_destroy_all_widgets (id
);
1077 dialog_selection_callback (widget
, id
, client_data
)
1080 XtPointer client_data
;
1082 if ((int)client_data
!= -1)
1083 menu_item_selection
= (Lisp_Object
*) client_data
;
1085 lw_destroy_all_widgets (id
);
1089 /* This recursively calls free_widget_value() on the tree of widgets.
1090 It must free all data that was malloc'ed for these widget_values.
1091 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1092 must be left alone. */
1095 free_menubar_widget_value_tree (wv
)
1100 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1102 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1104 free_menubar_widget_value_tree (wv
->contents
);
1105 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1109 free_menubar_widget_value_tree (wv
->next
);
1110 wv
->next
= (widget_value
*) 0xDEADBEEF;
1113 free_widget_value (wv
);
1117 extern void EmacsFrameSetCharSize ();
1120 update_frame_menubar (f
)
1123 struct x_display
*x
= f
->display
.x
;
1125 int menubar_changed
;
1127 menubar_changed
= (x
->menubar_widget
1128 && !XtIsManaged (x
->menubar_widget
));
1130 if (! (menubar_changed
))
1134 /* Save the size of the frame because the pane widget doesn't accept to
1135 resize itself. So force it. */
1140 XawPanedSetRefigureMode (x
->column_widget
, 0);
1142 /* the order in which children are managed is the top to
1143 bottom order in which they are displayed in the paned window.
1144 First, remove the text-area widget.
1146 XtUnmanageChild (x
->edit_widget
);
1148 /* remove the menubar that is there now, and put up the menubar that
1151 if (menubar_changed
)
1153 XtManageChild (x
->menubar_widget
);
1154 XtMapWidget (x
->menubar_widget
);
1155 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1159 /* Re-manage the text-area widget */
1160 XtManageChild (x
->edit_widget
);
1162 /* and now thrash the sizes */
1163 XawPanedSetRefigureMode (x
->column_widget
, 1);
1165 /* Force the pane widget to resize itself with the right values. */
1166 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1172 set_frame_menubar (f
, first_time
)
1176 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1178 Lisp_Object tail
, items
;
1179 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
1184 wv
= malloc_widget_value ();
1185 wv
->name
= "menubar";
1188 save_wv
= first_wv
= wv
;
1190 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1191 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1193 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1197 string
= XVECTOR (items
)->contents
[i
+ 1];
1201 wv
= malloc_widget_value ();
1205 save_wv
->contents
= wv
;
1206 wv
->name
= (char *) XSTRING (string
)->data
;
1213 lw_modify_all_widgets (id
, first_wv
, False
);
1216 menubar_widget
= lw_create_widget ("menubar", "menubar",
1218 f
->display
.x
->column_widget
,
1221 f
->display
.x
->menubar_widget
= menubar_widget
;
1222 XtVaSetValues (menubar_widget
,
1224 XtNresizeToPreferred
, 1,
1229 free_menubar_widget_value_tree (first_wv
);
1231 /* Don't update the menubar the first time it is created via x_window. */
1233 update_frame_menubar (f
);
1239 free_frame_menubar (f
)
1242 Widget menubar_widget
;
1245 menubar_widget
= f
->display
.x
->menubar_widget
;
1251 lw_destroy_all_widgets (id
);
1255 /* Called from Fx_create_frame to create the inital menubar of a frame
1256 before it is mapped, so that the window is mapped with the menubar already
1257 there instead of us tacking it on later and thrashing the window after it
1260 initialize_frame_menubar (f
)
1263 set_frame_menubar (f
, 1);
1266 /* Horizontal bounds of the current menu bar item. */
1268 static int this_menu_bar_item_beg
;
1269 static int this_menu_bar_item_end
;
1271 /* Horizontal position of the end of the last menu bar item. */
1273 static int last_menu_bar_item_end
;
1275 /* Nonzero if position X, Y is in the menu bar and in some menu bar item
1276 but not in the current menu bar item. */
1279 other_menu_bar_item_p (f
, x
, y
)
1284 && f
->display
.x
->menubar_widget
!= 0
1285 && y
< f
->display
.x
->menubar_widget
->core
.height
1287 && x
< last_menu_bar_item_end
1288 && (x
>= this_menu_bar_item_end
1289 || x
< this_menu_bar_item_beg
));
1292 /* Unread a button-press event in the menu bar of frame F
1293 at x position XPOS relative to the inside of the frame. */
1296 unread_menu_bar_button (f
, xpos
)
1302 event
.type
= ButtonPress
;
1303 event
.xbutton
.display
= x_current_display
;
1304 event
.xbutton
.serial
= 0;
1305 event
.xbutton
.send_event
= 0;
1306 event
.xbutton
.time
= CurrentTime
;
1307 event
.xbutton
.button
= Button1
;
1308 event
.xbutton
.window
= XtWindow (f
->display
.x
->menubar_widget
);
1309 event
.xbutton
.x
= xpos
;
1310 XPutBackEvent (XDISPLAY
&event
);
1313 /* If the mouse has moved to another menu bar item,
1314 return 1 and unread a button press event for that item.
1315 Otherwise return 0. */
1318 check_mouse_other_menu_bar (f
)
1322 Lisp_Object bar_window
;
1327 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1329 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1331 unread_menu_bar_button (f
, x
);
1337 #endif /* USE_X_TOOLKIT */
1339 /* xmenu_show actually displays a menu using the panes and items in menu_items
1340 and returns the value selected from it.
1341 There are two versions of xmenu_show, one for Xt and one for Xlib.
1342 Both assume input is blocked by the caller. */
1344 /* F is the frame the menu is for.
1345 X and Y are the frame-relative specified position,
1346 relative to the inside upper left corner of the frame F.
1347 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1348 KEYMAPS is 1 if this menu was specified with keymaps;
1349 in that case, we return a list containing the chosen item's value
1350 and perhaps also the pane's prefix.
1351 TITLE is the specified menu title.
1352 ERROR is a place to store an error message string in case of failure.
1353 (We return nil on failure, but the value doesn't actually matter.) */
1355 #ifdef USE_X_TOOLKIT
1357 extern unsigned int x_mouse_grabbed
;
1358 extern Lisp_Object Vmouse_depressed
;
1361 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1373 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1375 /* This is the menu bar item (if any) that led to this menu. */
1376 widget_value
*menubar_item
= 0;
1378 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1379 widget_value
**submenu_stack
1380 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1381 Lisp_Object
*subprefix_stack
1382 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1383 int submenu_depth
= 0;
1385 /* Define a queue to save up for later unreading
1386 all X events that don't pertain to the menu. */
1390 struct event_queue
*next
;
1393 struct event_queue
*queue
= NULL
;
1394 struct event_queue
*queue_tmp
;
1396 Position root_x
, root_y
;
1402 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1404 *error
= "Empty menu";
1407 this_menu_bar_item_beg
= -1;
1408 this_menu_bar_item_end
= -1;
1409 last_menu_bar_item_end
= -1;
1411 /* Figure out which menu bar item, if any, this menu is for. */
1416 widget_value
*mb_item
= 0;
1418 for (mb_item
= menubar
->menu
.old_stack
[0]->contents
;
1420 mb_item
= mb_item
->next
)
1423 xend
+= (string_width (menubar
, mb_item
->name
)
1424 + 2 * (menubar
->menu
.horizontal_spacing
1425 + menubar
->menu
.shadow_thickness
));
1426 if (x
>= xbeg
&& x
< xend
)
1430 menubar_item
= mb_item
;
1431 /* Arrange to show a different menu if we move in the menu bar
1432 to a different item. */
1433 this_menu_bar_item_beg
= xbeg
;
1434 this_menu_bar_item_end
= xend
;
1437 last_menu_bar_item_end
= xend
;
1439 if (menubar_item
== 0)
1442 /* Offset the coordinates to root-relative. */
1443 if (f
->display
.x
->menubar_widget
!= 0)
1444 y
+= f
->display
.x
->menubar_widget
->core
.height
;
1445 XtTranslateCoords (f
->display
.x
->widget
,
1446 x
, y
, &root_x
, &root_y
);
1450 /* Create a tree of widget_value objects
1451 representing the panes and their items. */
1452 wv
= malloc_widget_value ();
1459 /* Loop over all panes and items, filling in the tree. */
1461 while (i
< menu_items_used
)
1463 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1465 submenu_stack
[submenu_depth
++] = save_wv
;
1471 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1474 save_wv
= submenu_stack
[--submenu_depth
];
1478 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1479 && submenu_depth
!= 0)
1480 i
+= MENU_ITEMS_PANE_LENGTH
;
1481 /* Ignore a nil in the item list.
1482 It's meaningful only for dialog boxes. */
1483 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1485 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1487 /* Create a new pane. */
1488 Lisp_Object pane_name
, prefix
;
1490 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1491 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1492 pane_string
= (NILP (pane_name
)
1493 ? "" : (char *) XSTRING (pane_name
)->data
);
1494 /* If there is just one top-level pane, put all its items directly
1495 under the top-level menu. */
1496 if (menu_items_n_panes
== 1)
1499 /* If the pane has a meaningful name,
1500 make the pane a top-level menu item
1501 with its items as a submenu beneath it. */
1502 if (!keymaps
&& strcmp (pane_string
, ""))
1504 wv
= malloc_widget_value ();
1508 first_wv
->contents
= wv
;
1509 wv
->name
= pane_string
;
1510 if (keymaps
&& !NILP (prefix
))
1517 else if (first_pane
)
1523 i
+= MENU_ITEMS_PANE_LENGTH
;
1527 /* Create a new item within current pane. */
1528 Lisp_Object item_name
, enable
, descrip
;
1529 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1530 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1532 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1534 wv
= malloc_widget_value ();
1538 save_wv
->contents
= wv
;
1539 wv
->name
= (char *) XSTRING (item_name
)->data
;
1540 if (!NILP (descrip
))
1541 wv
->key
= (char *) XSTRING (descrip
)->data
;
1543 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1544 wv
->enabled
= !NILP (enable
);
1547 i
+= MENU_ITEMS_ITEM_LENGTH
;
1551 /* Actually create the menu. */
1552 menu_id
= ++popup_id_tick
;
1553 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1554 f
->display
.x
->widget
, 1, 0,
1555 popup_selection_callback
, popup_down_callback
);
1556 /* Free the widget_value objects we used to specify the contents. */
1557 free_menubar_widget_value_tree (first_wv
);
1559 /* No selection has been chosen yet. */
1560 menu_item_selection
= 0;
1562 /* If the mouse moves out of the menu before we show the menu,
1563 don't show it at all. */
1564 if (check_mouse_other_menu_bar (f
))
1566 lw_destroy_all_widgets (menu_id
);
1571 /* Highlight the menu bar item (if any) that led to this menu. */
1574 menubar_item
->call_data
= (XtPointer
) 1;
1575 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1578 /* Display the menu. */
1580 XButtonPressedEvent dummy
;
1583 mw
= (XlwMenuWidget
) ((CompositeWidget
)menu
)->composite
.children
[0];
1585 dummy
.type
= ButtonPress
;
1587 dummy
.send_event
= 0;
1588 dummy
.display
= XtDisplay (menu
);
1589 dummy
.window
= XtWindow (XtParent (menu
));
1590 dummy
.time
= CurrentTime
;
1595 /* We activate directly the lucid implementation. */
1596 pop_up_menu (mw
, &dummy
);
1599 /* No need to check a second time since this is done in the XEvent loop.
1600 This slows done the execution. */
1602 /* Check again whether the mouse has moved to another menu bar item. */
1603 if (check_mouse_other_menu_bar (f
))
1605 /* The mouse moved into a different menu bar item.
1606 We should bring up that item's menu instead.
1607 First pop down this menu. */
1608 XtUngrabPointer ((Widget
)
1610 ((CompositeWidget
)menu
)->composite
.children
[0]),
1612 lw_destroy_all_widgets (menu_id
);
1617 /* Process events that apply to the menu. */
1622 XtAppNextEvent (Xt_app_con
, &event
);
1623 if (event
.type
== ButtonRelease
)
1625 XtDispatchEvent (&event
);
1628 /* Do the work of construct_mouse_click since it can't
1629 be called. Initially, the popup menu has been called
1630 from a ButtonPress in the edit_widget. Then the mouse
1631 has been set to grabbed. Reset it now. */
1632 x_mouse_grabbed
&= ~(1 << event
.xbutton
.button
);
1633 if (!x_mouse_grabbed
)
1634 Vmouse_depressed
= Qnil
;
1638 else if (event
.type
== Expose
)
1639 process_expose_from_menu (event
);
1640 else if (event
.type
== MotionNotify
)
1642 int event_x
= (event
.xmotion
.x_root
1643 - (f
->display
.x
->widget
->core
.x
1644 + f
->display
.x
->widget
->core
.border_width
));
1645 int event_y
= (event
.xmotion
.y_root
1646 - (f
->display
.x
->widget
->core
.y
1647 + f
->display
.x
->widget
->core
.border_width
));
1649 if (other_menu_bar_item_p (f
, event_x
, event_y
))
1651 /* The mouse moved into a different menu bar item.
1652 We should bring up that item's menu instead.
1653 First pop down this menu. */
1654 XtUngrabPointer ((Widget
)
1656 ((CompositeWidget
)menu
)->composite
.children
[0]),
1657 event
.xbutton
.time
);
1658 lw_destroy_all_widgets (menu_id
);
1660 /* Put back an event that will bring up the other item's menu. */
1661 unread_menu_bar_button (f
, event_x
);
1662 /* Don't let us select anything in this case. */
1663 menu_item_selection
= 0;
1668 XtDispatchEvent (&event
);
1669 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1672 = (struct event_queue
*) malloc (sizeof (struct event_queue
));
1674 if (queue_tmp
!= NULL
)
1676 queue_tmp
->event
= event
;
1677 queue_tmp
->next
= queue
;
1684 /* Unhighlight the menu bar item (if any) that led to this menu. */
1687 menubar_item
->call_data
= (XtPointer
) 0;
1688 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1691 /* fp turned off the following statement and wrote a comment
1692 that it is unnecessary--that the menu has already disappeared.
1693 I observer that is not so. -- rms. */
1694 /* Make sure the menu disappears. */
1695 lw_destroy_all_widgets (menu_id
);
1697 /* Unread any events that we got but did not handle. */
1698 while (queue
!= NULL
)
1701 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1702 queue
= queue_tmp
->next
;
1703 free ((char *)queue_tmp
);
1704 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1705 interrupt_input_pending
= 1;
1708 /* Find the selected item, and its pane, to return
1709 the proper value. */
1710 if (menu_item_selection
!= 0)
1716 while (i
< menu_items_used
)
1720 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1722 subprefix_stack
[submenu_depth
++] = prefix
;
1726 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1728 prefix
= subprefix_stack
[--submenu_depth
];
1731 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1734 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1735 i
+= MENU_ITEMS_PANE_LENGTH
;
1740 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1741 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1747 entry
= Fcons (entry
, Qnil
);
1749 entry
= Fcons (prefix
, entry
);
1750 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1751 if (!NILP (subprefix_stack
[j
]))
1752 entry
= Fcons (subprefix_stack
[j
], entry
);
1756 i
+= MENU_ITEMS_ITEM_LENGTH
;
1764 static char * button_names
[] = {
1765 "button1", "button2", "button3", "button4", "button5",
1766 "button6", "button7", "button8", "button9", "button10" };
1769 xdialog_show (f
, menubarp
, keymaps
, title
, error
)
1776 int i
, nb_buttons
=0;
1779 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1780 char dialog_name
[6];
1782 /* This is the menu bar item (if any) that led to this menu. */
1783 widget_value
*menubar_item
= 0;
1785 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1787 /* Define a queue to save up for later unreading
1788 all X events that don't pertain to the menu. */
1792 struct event_queue
*next
;
1795 struct event_queue
*queue
= NULL
;
1796 struct event_queue
*queue_tmp
;
1798 /* Number of elements seen so far, before boundary. */
1800 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1801 int boundary_seen
= 0;
1805 if (menu_items_n_panes
> 1)
1807 *error
= "Multiple panes in dialog box";
1811 /* Create a tree of widget_value objects
1812 representing the text label and buttons. */
1814 Lisp_Object pane_name
, prefix
;
1816 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1817 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1818 pane_string
= (NILP (pane_name
)
1819 ? "" : (char *) XSTRING (pane_name
)->data
);
1820 prev_wv
= malloc_widget_value ();
1821 prev_wv
->value
= pane_string
;
1822 if (keymaps
&& !NILP (prefix
))
1824 prev_wv
->enabled
= 1;
1825 prev_wv
->name
= "message";
1828 /* Loop over all panes and items, filling in the tree. */
1829 i
= MENU_ITEMS_PANE_LENGTH
;
1830 while (i
< menu_items_used
)
1833 /* Create a new item within current pane. */
1834 Lisp_Object item_name
, enable
, descrip
;
1835 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1836 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1838 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1840 if (NILP (item_name
))
1842 free_menubar_widget_value_tree (first_wv
);
1843 *error
= "Submenu in dialog items";
1846 if (EQ (item_name
, Qquote
))
1848 /* This is the boundary between left-side elts
1849 and right-side elts. Stop incrementing right_count. */
1854 if (nb_buttons
>= 10)
1856 free_menubar_widget_value_tree (first_wv
);
1857 *error
= "Too many dialog items";
1861 wv
= malloc_widget_value ();
1863 wv
->name
= (char *) button_names
[nb_buttons
];
1864 if (!NILP (descrip
))
1865 wv
->key
= (char *) XSTRING (descrip
)->data
;
1866 wv
->value
= (char *) XSTRING (item_name
)->data
;
1867 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1868 wv
->enabled
= !NILP (enable
);
1871 if (! boundary_seen
)
1875 i
+= MENU_ITEMS_ITEM_LENGTH
;
1878 /* If the boundary was not specified,
1879 by default put half on the left and half on the right. */
1880 if (! boundary_seen
)
1881 left_count
= nb_buttons
- nb_buttons
/ 2;
1883 wv
= malloc_widget_value ();
1884 wv
->name
= dialog_name
;
1886 /* Dialog boxes use a really stupid name encoding
1887 which specifies how many buttons to use
1888 and how many buttons are on the right.
1889 The Q means something also. */
1890 dialog_name
[0] = 'Q';
1891 dialog_name
[1] = '0' + nb_buttons
;
1892 dialog_name
[2] = 'B';
1893 dialog_name
[3] = 'R';
1894 /* Number of buttons to put on the right. */
1895 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1897 wv
->contents
= first_wv
;
1901 /* Actually create the dialog. */
1902 dialog_id
= ++popup_id_tick
;
1903 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1904 f
->display
.x
->widget
, 1, 0,
1905 dialog_selection_callback
, 0);
1906 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1907 lw_modify_all_widgets (dialog_id
, first_wv
, True
);
1909 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1910 /* Free the widget_value objects we used to specify the contents. */
1911 free_menubar_widget_value_tree (first_wv
);
1913 /* No selection has been chosen yet. */
1914 menu_item_selection
= 0;
1916 /* Display the menu. */
1917 lw_pop_up_all_widgets (dialog_id
);
1919 /* Process events that apply to the menu. */
1924 XtAppNextEvent (Xt_app_con
, &event
);
1925 if (event
.type
== ButtonRelease
)
1927 XtDispatchEvent (&event
);
1930 else if (event
.type
== Expose
)
1931 process_expose_from_menu (event
);
1932 XtDispatchEvent (&event
);
1933 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1935 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1937 if (queue_tmp
!= NULL
)
1939 queue_tmp
->event
= event
;
1940 queue_tmp
->next
= queue
;
1947 /* State that no mouse buttons are now held.
1948 That is not necessarily true, but the fiction leads to reasonable
1949 results, and it is a pain to ask which are actually held now
1950 or track this in the loop above. */
1951 x_mouse_grabbed
= 0;
1953 /* Unread any events that we got but did not handle. */
1954 while (queue
!= NULL
)
1957 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1958 queue
= queue_tmp
->next
;
1959 free ((char *)queue_tmp
);
1960 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1961 interrupt_input_pending
= 1;
1964 /* Find the selected item, and its pane, to return
1965 the proper value. */
1966 if (menu_item_selection
!= 0)
1972 while (i
< menu_items_used
)
1976 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1979 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1980 i
+= MENU_ITEMS_PANE_LENGTH
;
1985 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1986 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1990 entry
= Fcons (entry
, Qnil
);
1992 entry
= Fcons (prefix
, entry
);
1996 i
+= MENU_ITEMS_ITEM_LENGTH
;
2003 #else /* not USE_X_TOOLKIT */
2006 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
2016 int pane
, selidx
, lpane
, status
;
2017 Lisp_Object entry
, pane_prefix
;
2019 int ulx
, uly
, width
, height
;
2020 int dispwidth
, dispheight
;
2024 unsigned int dummy_uint
;
2027 if (menu_items_n_panes
== 0)
2030 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2032 *error
= "Empty menu";
2036 /* Figure out which root window F is on. */
2037 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
2038 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2039 &dummy_uint
, &dummy_uint
);
2041 /* Make the menu on that window. */
2042 menu
= XMenuCreate (XDISPLAY root
, "emacs");
2045 *error
= "Can't create menu";
2049 /* Adjust coordinates to relative to the outer (window manager) window. */
2053 int win_x
= 0, win_y
= 0;
2055 /* Find the position of the outside upper-left corner of
2056 the inner window, with respect to the outer window. */
2057 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2060 XTranslateCoordinates (x_current_display
,
2062 /* From-window, to-window. */
2063 f
->display
.x
->window_desc
,
2064 f
->display
.x
->parent_desc
,
2066 /* From-position, to-position. */
2067 0, 0, &win_x
, &win_y
,
2069 /* Child of window. */
2076 #endif /* HAVE_X11 */
2078 /* Adjust coordinates to be root-window-relative. */
2079 x
+= f
->display
.x
->left_pos
;
2080 y
+= f
->display
.x
->top_pos
;
2082 /* Create all the necessary panes and their items. */
2084 while (i
< menu_items_used
)
2086 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2088 /* Create a new pane. */
2089 Lisp_Object pane_name
, prefix
;
2092 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2093 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2094 pane_string
= (NILP (pane_name
)
2095 ? "" : (char *) XSTRING (pane_name
)->data
);
2096 if (keymaps
&& !NILP (prefix
))
2099 lpane
= XMenuAddPane (XDISPLAY menu
, pane_string
, TRUE
);
2100 if (lpane
== XM_FAILURE
)
2102 XMenuDestroy (XDISPLAY menu
);
2103 *error
= "Can't create pane";
2106 i
+= MENU_ITEMS_PANE_LENGTH
;
2108 /* Find the width of the widest item in this pane. */
2111 while (j
< menu_items_used
)
2114 item
= XVECTOR (menu_items
)->contents
[j
];
2122 width
= XSTRING (item
)->size
;
2123 if (width
> maxwidth
)
2126 j
+= MENU_ITEMS_ITEM_LENGTH
;
2129 /* Ignore a nil in the item list.
2130 It's meaningful only for dialog boxes. */
2131 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2135 /* Create a new item within current pane. */
2136 Lisp_Object item_name
, enable
, descrip
;
2137 unsigned char *item_data
;
2139 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2140 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2142 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2143 if (!NILP (descrip
))
2145 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2148 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2149 item_name
= concat2 (item_name
, spacer
);
2150 item_name
= concat2 (item_name
, descrip
);
2151 item_data
= XSTRING (item_name
)->data
;
2153 /* if alloca is fast, use that to make the space,
2154 to reduce gc needs. */
2156 = (unsigned char *) alloca (maxwidth
2157 + XSTRING (descrip
)->size
+ 1);
2158 bcopy (XSTRING (item_name
)->data
, item_data
,
2159 XSTRING (item_name
)->size
);
2160 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2162 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2163 XSTRING (descrip
)->size
);
2164 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2168 item_data
= XSTRING (item_name
)->data
;
2170 if (XMenuAddSelection (XDISPLAY menu
, lpane
, 0, item_data
,
2174 XMenuDestroy (XDISPLAY menu
);
2175 *error
= "Can't add selection to menu";
2178 i
+= MENU_ITEMS_ITEM_LENGTH
;
2182 /* All set and ready to fly. */
2183 XMenuRecompute (XDISPLAY menu
);
2184 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
2185 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
2186 x
= min (x
, dispwidth
);
2187 y
= min (y
, dispheight
);
2190 XMenuLocate (XDISPLAY menu
, 0, 0, x
, y
,
2191 &ulx
, &uly
, &width
, &height
);
2192 if (ulx
+width
> dispwidth
)
2194 x
-= (ulx
+ width
) - dispwidth
;
2195 ulx
= dispwidth
- width
;
2197 if (uly
+height
> dispheight
)
2199 y
-= (uly
+ height
) - dispheight
;
2200 uly
= dispheight
- height
;
2202 if (ulx
< 0) x
-= ulx
;
2203 if (uly
< 0) y
-= uly
;
2205 XMenuSetAEQ (menu
, TRUE
);
2206 XMenuSetFreeze (menu
, TRUE
);
2209 status
= XMenuActivate (XDISPLAY menu
, &pane
, &selidx
,
2210 x
, y
, ButtonReleaseMask
, &datap
);
2215 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2218 /* Find the item number SELIDX in pane number PANE. */
2220 while (i
< menu_items_used
)
2222 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2226 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2228 i
+= MENU_ITEMS_PANE_LENGTH
;
2237 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2240 entry
= Fcons (entry
, Qnil
);
2241 if (!NILP (pane_prefix
))
2242 entry
= Fcons (pane_prefix
, entry
);
2248 i
+= MENU_ITEMS_ITEM_LENGTH
;
2254 XMenuDestroy (XDISPLAY menu
);
2255 *error
= "Can't activate menu";
2261 XMenuDestroy (XDISPLAY menu
);
2263 /* State that no mouse buttons are now held.
2264 (The oldXMenu code doesn't track this info for us.)
2265 That is not necessarily true, but the fiction leads to reasonable
2266 results, and it is a pain to ask which are actually held now. */
2267 x_mouse_grabbed
= 0;
2271 #endif /* not USE_X_TOOLKIT */
2275 staticpro (&menu_items
);
2278 popup_id_tick
= (1<<16);
2279 defsubr (&Sx_popup_menu
);
2280 defsubr (&Sx_popup_dialog
);