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 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
494 submap
= get_keymap_1 (def
, 0, 1);
496 #ifndef USE_X_TOOLKIT
497 /* Indicate visually that this is a submenu. */
499 item_string
= concat2 (item_string
,
500 build_string (" >"));
502 push_menu_item (item_string
, enabled
, XCONS (item
)->car
,
505 /* Display a submenu using the toolkit. */
508 push_submenu_start ();
509 single_keymap_panes (submap
, Qnil
,
510 XCONS (item
)->car
, notreal
);
518 else if (XTYPE (item
) == Lisp_Vector
)
520 /* Loop over the char values represented in the vector. */
521 int len
= XVECTOR (item
)->size
;
523 for (c
= 0; c
< len
; c
++)
525 Lisp_Object character
;
526 XFASTINT (character
) = c
;
527 item1
= XVECTOR (item
)->contents
[c
];
528 if (XTYPE (item1
) == Lisp_Cons
)
530 item_string
= XCONS (item1
)->car
;
531 if (XTYPE (item_string
) == Lisp_String
)
535 /* These are the saved equivalent keyboard key sequence
536 and its key-description. */
538 Lisp_Object tem
, enabled
;
540 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
542 /* GCPRO because we will call eval.
543 Protecting KEYMAP preserves everything we use;
544 aside from that, must protect whatever might be
545 a string. Since there's no GCPRO5, we refetch
546 item_string instead of protecting it. */
547 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
548 enabled
= menu_item_enabled_p (def
, notreal
);
551 item_string
= XCONS (item1
)->car
;
553 tem
= Fkeymapp (def
);
554 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
555 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
560 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
561 submap
= get_keymap_1 (def
, 0, 1);
563 #ifndef USE_X_TOOLKIT
565 item_string
= concat2 (item_string
,
566 build_string (" >"));
568 push_menu_item (item_string
, enabled
, character
,
573 push_submenu_start ();
574 single_keymap_panes (submap
, Qnil
,
586 /* Process now any submenus which want to be panes at this level. */
587 while (!NILP (pending_maps
))
589 Lisp_Object elt
, eltcdr
, string
;
590 elt
= Fcar (pending_maps
);
591 eltcdr
= XCONS (elt
)->cdr
;
592 string
= XCONS (eltcdr
)->car
;
593 /* We no longer discard the @ from the beginning of the string here.
594 Instead, we do this in xmenu_show. */
595 single_keymap_panes (Fcar (elt
), string
,
596 XCONS (eltcdr
)->cdr
, notreal
);
597 pending_maps
= Fcdr (pending_maps
);
601 /* Push all the panes and items of a menu decsribed by the
602 alist-of-alists MENU.
603 This handles old-fashioned calls to x-popup-menu. */
613 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
615 Lisp_Object elt
, pane_name
, pane_data
;
617 pane_name
= Fcar (elt
);
618 CHECK_STRING (pane_name
, 0);
619 push_menu_pane (pane_name
, Qnil
);
620 pane_data
= Fcdr (elt
);
621 CHECK_CONS (pane_data
, 0);
622 list_of_items (pane_data
);
625 finish_menu_items ();
628 /* Push the items in a single pane defined by the alist PANE. */
634 Lisp_Object tail
, item
, item1
;
636 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
640 push_menu_item (item
, Qnil
, Qnil
, Qnil
);
641 else if (NILP (item
))
642 push_left_right_boundary ();
645 CHECK_CONS (item
, 0);
647 CHECK_STRING (item1
, 1);
648 push_menu_item (item1
, Qt
, Fcdr (item
), Qnil
);
653 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
654 "Pop up a deck-of-cards menu and return user's selection.\n\
655 POSITION is a position specification. This is either a mouse button event\n\
656 or a list ((XOFFSET YOFFSET) WINDOW)\n\
657 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
658 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
659 This controls the position of the center of the first line\n\
660 in the first pane of the menu, not the top left of the menu as a whole.\n\
661 If POSITION is t, it means to use the current mouse position.\n\
663 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
664 The menu items come from key bindings that have a menu string as well as\n\
665 a definition; actually, the \"definition\" in such a key binding looks like\n\
666 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
667 the keymap as a top-level element.\n\n\
668 You can also use a list of keymaps as MENU.\n\
669 Then each keymap makes a separate pane.\n\
670 When MENU is a keymap or a list of keymaps, the return value\n\
671 is a list of events.\n\n\
672 Alternatively, you can specify a menu of multiple panes\n\
673 with a list of the form (TITLE PANE1 PANE2...),\n\
674 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
675 Each ITEM is normally a cons cell (STRING . VALUE);\n\
676 but a string can appear as an item--that makes a nonselectable line\n\
678 With this form of menu, the return value is VALUE from the chosen item.\n\
680 If POSITION is nil, don't display the menu at all, just precalculate the\n\
681 cached information about equivalent key sequences.")
683 Lisp_Object position
, menu
;
685 int number_of_panes
, panes
;
686 Lisp_Object keymap
, tem
;
690 Lisp_Object selection
;
693 Lisp_Object x
, y
, window
;
698 if (! NILP (position
))
702 /* Decode the first argument: find the window and the coordinates. */
703 if (EQ (position
, Qt
))
705 /* Use the mouse's current position. */
707 Lisp_Object bar_window
;
711 if (mouse_position_hook
)
712 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
714 XSET (window
, Lisp_Frame
, new_f
);
717 window
= selected_window
;
724 tem
= Fcar (position
);
725 if (XTYPE (tem
) == Lisp_Cons
)
727 window
= Fcar (Fcdr (position
));
729 y
= Fcar (Fcdr (tem
));
733 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
734 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
735 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
739 /* Determine whether this menu is handling a menu bar click. */
740 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
741 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
749 /* Decode where to put the menu. */
751 if (XTYPE (window
) == Lisp_Frame
)
758 else if (XTYPE (window
) == Lisp_Window
)
760 CHECK_LIVE_WINDOW (window
, 0);
761 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
763 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
764 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
767 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
768 but I don't want to make one now. */
769 CHECK_WINDOW (window
, 0);
778 /* Decode the menu items from what was specified. */
780 keymap
= Fkeymapp (menu
);
782 if (XTYPE (menu
) == Lisp_Cons
)
783 tem
= Fkeymapp (Fcar (menu
));
786 /* We were given a keymap. Extract menu info from the keymap. */
788 keymap
= get_keymap (menu
);
790 /* Extract the detailed info to make one pane. */
791 keymap_panes (&menu
, 1, NILP (position
));
793 /* Search for a string appearing directly as an element of the keymap.
794 That string is the title of the menu. */
795 prompt
= map_prompt (keymap
);
797 /* Make that be the pane title of the first pane. */
798 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
799 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
803 else if (!NILP (tem
))
805 /* We were given a list of keymaps. */
806 int nmaps
= XFASTINT (Flength (menu
));
808 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
813 /* The first keymap that has a prompt string
814 supplies the menu title. */
815 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
819 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
821 prompt
= map_prompt (keymap
);
822 if (NILP (title
) && !NILP (prompt
))
826 /* Extract the detailed info to make one pane. */
827 keymap_panes (maps
, nmaps
, NILP (position
));
829 /* Make the title be the pane title of the first pane. */
830 if (!NILP (title
) && menu_items_n_panes
>= 0)
831 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
837 /* We were given an old-fashioned menu. */
839 CHECK_STRING (title
, 1);
841 list_of_panes (Fcdr (menu
));
848 discard_menu_items ();
853 /* Display them in a menu. */
856 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
,
857 keymaps
, title
, &error_name
);
860 discard_menu_items ();
864 if (error_name
) error (error_name
);
868 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
869 "Pop up a dialog box and return user's selection.\n\
870 POSITION specifies which frame to use.\n\
871 This is normally a mouse button event or a window or frame.\n\
872 If POSITION is t, it means to use the frame the mouse is on.\n\
873 The dialog box appears in the middle of the specified frame.\n\
875 CONTENTS specifies the alternatives to display in the dialog box.\n\
876 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
877 Each ITEM is a cons cell (STRING . VALUE).\n\
878 The return value is VALUE from the chosen item.\n\n\
879 An ITEM may also be just a string--that makes a nonselectable item.\n\
880 An ITEM may also be nil--that means to put all preceding items\n\
881 on the left of the dialog box and all following items on the right.\n\
882 \(By default, approximately half appear on each side.)")
884 Lisp_Object position
, contents
;
891 /* Decode the first argument: find the window or frame to use. */
892 if (EQ (position
, Qt
))
894 #if 0 /* Using the frame the mouse is on may not be right. */
895 /* Use the mouse's current position. */
897 Lisp_Object bar_window
;
902 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
905 XSET (window
, Lisp_Frame
, new_f
);
907 window
= selected_window
;
909 /* Decode the first argument: find the window and the coordinates. */
910 if (EQ (position
, Qt
))
911 window
= selected_window
;
913 else if (CONSP (position
))
916 tem
= Fcar (position
);
917 if (XTYPE (tem
) == Lisp_Cons
)
918 window
= Fcar (Fcdr (position
));
921 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
922 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
925 else if (WINDOWP (position
) || FRAMEP (position
))
928 /* Decode where to put the menu. */
930 if (XTYPE (window
) == Lisp_Frame
)
932 else if (XTYPE (window
) == Lisp_Window
)
934 CHECK_LIVE_WINDOW (window
, 0);
935 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
938 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
939 but I don't want to make one now. */
940 CHECK_WINDOW (window
, 0);
942 #ifndef USE_X_TOOLKIT
943 /* Display a menu with these alternatives
944 in the middle of frame F. */
946 Lisp_Object x
, y
, frame
, newpos
;
947 XSET (frame
, Lisp_Frame
, f
);
948 XSET (x
, Lisp_Int
, x_pixel_width (f
) / 2);
949 XSET (y
, Lisp_Int
, x_pixel_height (f
) / 2);
950 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
952 return Fx_popup_menu (newpos
,
953 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
959 Lisp_Object selection
;
961 /* Decode the dialog items from what was specified. */
962 title
= Fcar (contents
);
963 CHECK_STRING (title
, 1);
965 list_of_panes (Fcons (contents
, Qnil
));
967 /* Display them in a dialog box. */
969 selection
= xdialog_show (f
, 0, 0, title
, &error_name
);
972 discard_menu_items ();
974 if (error_name
) error (error_name
);
983 dispatch_dummy_expose (w
, x
, y
)
991 dummy
.window
= XtWindow (w
);
994 dummy
.send_event
= 0;
995 dummy
.display
= XtDisplay (w
);
999 XtDispatchEvent ((XEvent
*) &dummy
);
1003 event_is_in_menu_item (mw
, event
, name
, string_w
)
1005 struct input_event
*event
;
1009 *string_w
+= (string_width (mw
, name
)
1010 + 2 * (mw
->menu
.horizontal_spacing
1011 + mw
->menu
.shadow_thickness
));
1012 return XINT (event
->x
) < *string_w
;
1016 /* Return the menu bar key which corresponds to event EVENT in frame F. */
1019 map_event_to_object (event
, f
)
1020 struct input_event
*event
;
1025 XlwMenuWidget mw
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1030 /* Find the window */
1031 for (val
= mw
->menu
.old_stack
[0]->contents
; val
; val
= val
->next
)
1033 ws
= &mw
->menu
.windows
[0];
1034 if (ws
&& event_is_in_menu_item (mw
, event
, val
->name
, &string_w
))
1039 items
= FRAME_MENU_BAR_ITEMS (f
);
1041 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1043 Lisp_Object pos
, string
, item
;
1044 item
= XVECTOR (items
)->contents
[i
];
1045 string
= XVECTOR (items
)->contents
[i
+ 1];
1046 pos
= XVECTOR (items
)->contents
[i
+ 2];
1050 if (!strcmp (val
->name
, XSTRING (string
)->data
))
1058 static Lisp_Object
*menu_item_selection
;
1061 popup_selection_callback (widget
, id
, client_data
)
1064 XtPointer client_data
;
1066 menu_item_selection
= (Lisp_Object
*) client_data
;
1070 popup_down_callback (widget
, id
, client_data
)
1073 XtPointer client_data
;
1076 lw_destroy_all_widgets (id
);
1081 dialog_selection_callback (widget
, id
, client_data
)
1084 XtPointer client_data
;
1086 if ((int)client_data
!= -1)
1087 menu_item_selection
= (Lisp_Object
*) client_data
;
1089 lw_destroy_all_widgets (id
);
1093 /* This recursively calls free_widget_value() on the tree of widgets.
1094 It must free all data that was malloc'ed for these widget_values.
1095 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1096 must be left alone. */
1099 free_menubar_widget_value_tree (wv
)
1104 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1106 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1108 free_menubar_widget_value_tree (wv
->contents
);
1109 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1113 free_menubar_widget_value_tree (wv
->next
);
1114 wv
->next
= (widget_value
*) 0xDEADBEEF;
1117 free_widget_value (wv
);
1121 extern void EmacsFrameSetCharSize ();
1124 update_frame_menubar (f
)
1127 struct x_display
*x
= f
->display
.x
;
1129 int menubar_changed
;
1131 menubar_changed
= (x
->menubar_widget
1132 && !XtIsManaged (x
->menubar_widget
));
1134 if (! (menubar_changed
))
1138 /* Save the size of the frame because the pane widget doesn't accept to
1139 resize itself. So force it. */
1144 XawPanedSetRefigureMode (x
->column_widget
, 0);
1146 /* the order in which children are managed is the top to
1147 bottom order in which they are displayed in the paned window.
1148 First, remove the text-area widget.
1150 XtUnmanageChild (x
->edit_widget
);
1152 /* remove the menubar that is there now, and put up the menubar that
1155 if (menubar_changed
)
1157 XtManageChild (x
->menubar_widget
);
1158 XtMapWidget (x
->menubar_widget
);
1159 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1163 /* Re-manage the text-area widget */
1164 XtManageChild (x
->edit_widget
);
1166 /* and now thrash the sizes */
1167 XawPanedSetRefigureMode (x
->column_widget
, 1);
1169 /* Force the pane widget to resize itself with the right values. */
1170 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1176 set_frame_menubar (f
, first_time
)
1180 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1182 Lisp_Object tail
, items
;
1183 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
1188 wv
= malloc_widget_value ();
1189 wv
->name
= "menubar";
1192 save_wv
= first_wv
= wv
;
1194 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1195 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1197 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1201 string
= XVECTOR (items
)->contents
[i
+ 1];
1205 wv
= malloc_widget_value ();
1209 save_wv
->contents
= wv
;
1210 wv
->name
= (char *) XSTRING (string
)->data
;
1217 lw_modify_all_widgets (id
, first_wv
, False
);
1220 menubar_widget
= lw_create_widget ("menubar", "menubar",
1222 f
->display
.x
->column_widget
,
1225 f
->display
.x
->menubar_widget
= menubar_widget
;
1226 XtVaSetValues (menubar_widget
,
1228 XtNresizeToPreferred
, 1,
1233 free_menubar_widget_value_tree (first_wv
);
1235 /* Don't update the menubar the first time it is created via x_window. */
1237 update_frame_menubar (f
);
1243 free_frame_menubar (f
)
1246 Widget menubar_widget
;
1249 menubar_widget
= f
->display
.x
->menubar_widget
;
1255 lw_destroy_all_widgets (id
);
1259 /* Called from Fx_create_frame to create the inital menubar of a frame
1260 before it is mapped, so that the window is mapped with the menubar already
1261 there instead of us tacking it on later and thrashing the window after it
1264 initialize_frame_menubar (f
)
1267 set_frame_menubar (f
, 1);
1270 /* Horizontal bounds of the current menu bar item. */
1272 static int this_menu_bar_item_beg
;
1273 static int this_menu_bar_item_end
;
1275 /* Horizontal position of the end of the last menu bar item. */
1277 static int last_menu_bar_item_end
;
1279 /* Nonzero if position X, Y is in the menu bar and in some menu bar item
1280 but not in the current menu bar item. */
1283 other_menu_bar_item_p (f
, x
, y
)
1288 && f
->display
.x
->menubar_widget
!= 0
1289 && y
< f
->display
.x
->menubar_widget
->core
.height
1291 && x
< last_menu_bar_item_end
1292 && (x
>= this_menu_bar_item_end
1293 || x
< this_menu_bar_item_beg
));
1296 /* Unread a button-press event in the menu bar of frame F
1297 at x position XPOS relative to the inside of the frame. */
1300 unread_menu_bar_button (f
, xpos
)
1306 event
.type
= ButtonPress
;
1307 event
.xbutton
.display
= x_current_display
;
1308 event
.xbutton
.serial
= 0;
1309 event
.xbutton
.send_event
= 0;
1310 event
.xbutton
.time
= CurrentTime
;
1311 event
.xbutton
.button
= Button1
;
1312 event
.xbutton
.window
= XtWindow (f
->display
.x
->menubar_widget
);
1313 event
.xbutton
.x
= xpos
;
1314 XPutBackEvent (XDISPLAY
&event
);
1317 /* If the mouse has moved to another menu bar item,
1318 return 1 and unread a button press event for that item.
1319 Otherwise return 0. */
1322 check_mouse_other_menu_bar (f
)
1326 Lisp_Object bar_window
;
1331 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1333 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1335 unread_menu_bar_button (f
, x
);
1341 #endif /* USE_X_TOOLKIT */
1343 /* xmenu_show actually displays a menu using the panes and items in menu_items
1344 and returns the value selected from it.
1345 There are two versions of xmenu_show, one for Xt and one for Xlib.
1346 Both assume input is blocked by the caller. */
1348 /* F is the frame the menu is for.
1349 X and Y are the frame-relative specified position,
1350 relative to the inside upper left corner of the frame F.
1351 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1352 KEYMAPS is 1 if this menu was specified with keymaps;
1353 in that case, we return a list containing the chosen item's value
1354 and perhaps also the pane's prefix.
1355 TITLE is the specified menu title.
1356 ERROR is a place to store an error message string in case of failure.
1357 (We return nil on failure, but the value doesn't actually matter.) */
1359 #ifdef USE_X_TOOLKIT
1361 extern unsigned int x_mouse_grabbed
;
1362 extern Lisp_Object Vmouse_depressed
;
1365 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1377 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1379 /* This is the menu bar item (if any) that led to this menu. */
1380 widget_value
*menubar_item
= 0;
1382 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1383 widget_value
**submenu_stack
1384 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1385 Lisp_Object
*subprefix_stack
1386 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1387 int submenu_depth
= 0;
1389 /* Define a queue to save up for later unreading
1390 all X events that don't pertain to the menu. */
1394 struct event_queue
*next
;
1397 struct event_queue
*queue
= NULL
;
1398 struct event_queue
*queue_tmp
;
1400 Position root_x
, root_y
;
1406 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1408 *error
= "Empty menu";
1411 this_menu_bar_item_beg
= -1;
1412 this_menu_bar_item_end
= -1;
1413 last_menu_bar_item_end
= -1;
1415 /* Figure out which menu bar item, if any, this menu is for. */
1420 widget_value
*mb_item
= 0;
1422 for (mb_item
= menubar
->menu
.old_stack
[0]->contents
;
1424 mb_item
= mb_item
->next
)
1427 xend
+= (string_width (menubar
, mb_item
->name
)
1428 + 2 * (menubar
->menu
.horizontal_spacing
1429 + menubar
->menu
.shadow_thickness
));
1430 if (x
>= xbeg
&& x
< xend
)
1434 menubar_item
= mb_item
;
1435 /* Arrange to show a different menu if we move in the menu bar
1436 to a different item. */
1437 this_menu_bar_item_beg
= xbeg
;
1438 this_menu_bar_item_end
= xend
;
1441 last_menu_bar_item_end
= xend
;
1443 if (menubar_item
== 0)
1446 /* Offset the coordinates to root-relative. */
1447 if (f
->display
.x
->menubar_widget
!= 0)
1448 y
+= f
->display
.x
->menubar_widget
->core
.height
;
1449 XtTranslateCoords (f
->display
.x
->widget
,
1450 x
, y
, &root_x
, &root_y
);
1454 /* Create a tree of widget_value objects
1455 representing the panes and their items. */
1456 wv
= malloc_widget_value ();
1463 /* Loop over all panes and items, filling in the tree. */
1465 while (i
< menu_items_used
)
1467 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1469 submenu_stack
[submenu_depth
++] = save_wv
;
1475 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1478 save_wv
= submenu_stack
[--submenu_depth
];
1482 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1483 && submenu_depth
!= 0)
1484 i
+= MENU_ITEMS_PANE_LENGTH
;
1485 /* Ignore a nil in the item list.
1486 It's meaningful only for dialog boxes. */
1487 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1489 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1491 /* Create a new pane. */
1492 Lisp_Object pane_name
, prefix
;
1494 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1495 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1496 pane_string
= (NILP (pane_name
)
1497 ? "" : (char *) XSTRING (pane_name
)->data
);
1498 /* If there is just one top-level pane, put all its items directly
1499 under the top-level menu. */
1500 if (menu_items_n_panes
== 1)
1503 /* If the pane has a meaningful name,
1504 make the pane a top-level menu item
1505 with its items as a submenu beneath it. */
1506 if (!keymaps
&& strcmp (pane_string
, ""))
1508 wv
= malloc_widget_value ();
1512 first_wv
->contents
= wv
;
1513 wv
->name
= pane_string
;
1514 if (keymaps
&& !NILP (prefix
))
1521 else if (first_pane
)
1527 i
+= MENU_ITEMS_PANE_LENGTH
;
1531 /* Create a new item within current pane. */
1532 Lisp_Object item_name
, enable
, descrip
;
1533 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1534 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1536 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1538 wv
= malloc_widget_value ();
1542 save_wv
->contents
= wv
;
1543 wv
->name
= (char *) XSTRING (item_name
)->data
;
1544 if (!NILP (descrip
))
1545 wv
->key
= (char *) XSTRING (descrip
)->data
;
1547 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1548 wv
->enabled
= !NILP (enable
);
1551 i
+= MENU_ITEMS_ITEM_LENGTH
;
1555 /* Actually create the menu. */
1556 menu_id
= ++popup_id_tick
;
1557 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1558 f
->display
.x
->widget
, 1, 0,
1559 popup_selection_callback
, popup_down_callback
);
1560 /* Free the widget_value objects we used to specify the contents. */
1561 free_menubar_widget_value_tree (first_wv
);
1563 /* No selection has been chosen yet. */
1564 menu_item_selection
= 0;
1566 /* If the mouse moves out of the menu before we show the menu,
1567 don't show it at all. */
1568 if (check_mouse_other_menu_bar (f
))
1570 lw_destroy_all_widgets (menu_id
);
1575 /* Highlight the menu bar item (if any) that led to this menu. */
1578 menubar_item
->call_data
= (XtPointer
) 1;
1579 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1582 /* Display the menu. */
1584 XButtonPressedEvent dummy
;
1587 mw
= (XlwMenuWidget
) ((CompositeWidget
)menu
)->composite
.children
[0];
1589 dummy
.type
= ButtonPress
;
1591 dummy
.send_event
= 0;
1592 dummy
.display
= XtDisplay (menu
);
1593 dummy
.window
= XtWindow (XtParent (menu
));
1594 dummy
.time
= CurrentTime
;
1599 /* We activate directly the lucid implementation. */
1600 pop_up_menu (mw
, &dummy
);
1603 /* No need to check a second time since this is done in the XEvent loop.
1604 This slows done the execution. */
1606 /* Check again whether the mouse has moved to another menu bar item. */
1607 if (check_mouse_other_menu_bar (f
))
1609 /* The mouse moved into a different menu bar item.
1610 We should bring up that item's menu instead.
1611 First pop down this menu. */
1612 XtUngrabPointer ((Widget
)
1614 ((CompositeWidget
)menu
)->composite
.children
[0]),
1616 lw_destroy_all_widgets (menu_id
);
1621 /* Process events that apply to the menu. */
1626 XtAppNextEvent (Xt_app_con
, &event
);
1627 if (event
.type
== ButtonRelease
)
1629 XtDispatchEvent (&event
);
1632 /* Do the work of construct_mouse_click since it can't
1633 be called. Initially, the popup menu has been called
1634 from a ButtonPress in the edit_widget. Then the mouse
1635 has been set to grabbed. Reset it now. */
1636 x_mouse_grabbed
&= ~(1 << event
.xbutton
.button
);
1637 if (!x_mouse_grabbed
)
1638 Vmouse_depressed
= Qnil
;
1642 else if (event
.type
== Expose
)
1643 process_expose_from_menu (event
);
1644 else if (event
.type
== MotionNotify
)
1646 int event_x
= (event
.xmotion
.x_root
1647 - (f
->display
.x
->widget
->core
.x
1648 + f
->display
.x
->widget
->core
.border_width
));
1649 int event_y
= (event
.xmotion
.y_root
1650 - (f
->display
.x
->widget
->core
.y
1651 + f
->display
.x
->widget
->core
.border_width
));
1653 if (other_menu_bar_item_p (f
, event_x
, event_y
))
1655 /* The mouse moved into a different menu bar item.
1656 We should bring up that item's menu instead.
1657 First pop down this menu. */
1658 XtUngrabPointer ((Widget
)
1660 ((CompositeWidget
)menu
)->composite
.children
[0]),
1661 event
.xbutton
.time
);
1662 lw_destroy_all_widgets (menu_id
);
1664 /* Put back an event that will bring up the other item's menu. */
1665 unread_menu_bar_button (f
, event_x
);
1666 /* Don't let us select anything in this case. */
1667 menu_item_selection
= 0;
1672 XtDispatchEvent (&event
);
1673 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1676 = (struct event_queue
*) malloc (sizeof (struct event_queue
));
1678 if (queue_tmp
!= NULL
)
1680 queue_tmp
->event
= event
;
1681 queue_tmp
->next
= queue
;
1688 /* Unhighlight the menu bar item (if any) that led to this menu. */
1691 menubar_item
->call_data
= (XtPointer
) 0;
1692 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1695 /* fp turned off the following statement and wrote a comment
1696 that it is unnecessary--that the menu has already disappeared.
1697 I observer that is not so. -- rms. */
1698 /* Make sure the menu disappears. */
1699 lw_destroy_all_widgets (menu_id
);
1701 /* Unread any events that we got but did not handle. */
1702 while (queue
!= NULL
)
1705 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1706 queue
= queue_tmp
->next
;
1707 free ((char *)queue_tmp
);
1708 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1709 interrupt_input_pending
= 1;
1712 /* Find the selected item, and its pane, to return
1713 the proper value. */
1714 if (menu_item_selection
!= 0)
1720 while (i
< menu_items_used
)
1724 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1726 subprefix_stack
[submenu_depth
++] = prefix
;
1730 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1732 prefix
= subprefix_stack
[--submenu_depth
];
1735 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1738 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1739 i
+= MENU_ITEMS_PANE_LENGTH
;
1744 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1745 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1751 entry
= Fcons (entry
, Qnil
);
1753 entry
= Fcons (prefix
, entry
);
1754 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1755 if (!NILP (subprefix_stack
[j
]))
1756 entry
= Fcons (subprefix_stack
[j
], entry
);
1760 i
+= MENU_ITEMS_ITEM_LENGTH
;
1768 static char * button_names
[] = {
1769 "button1", "button2", "button3", "button4", "button5",
1770 "button6", "button7", "button8", "button9", "button10" };
1773 xdialog_show (f
, menubarp
, keymaps
, title
, error
)
1780 int i
, nb_buttons
=0;
1783 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1784 char dialog_name
[6];
1786 /* This is the menu bar item (if any) that led to this menu. */
1787 widget_value
*menubar_item
= 0;
1789 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1791 /* Define a queue to save up for later unreading
1792 all X events that don't pertain to the menu. */
1796 struct event_queue
*next
;
1799 struct event_queue
*queue
= NULL
;
1800 struct event_queue
*queue_tmp
;
1802 /* Number of elements seen so far, before boundary. */
1804 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1805 int boundary_seen
= 0;
1809 if (menu_items_n_panes
> 1)
1811 *error
= "Multiple panes in dialog box";
1815 /* Create a tree of widget_value objects
1816 representing the text label and buttons. */
1818 Lisp_Object pane_name
, prefix
;
1820 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1821 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1822 pane_string
= (NILP (pane_name
)
1823 ? "" : (char *) XSTRING (pane_name
)->data
);
1824 prev_wv
= malloc_widget_value ();
1825 prev_wv
->value
= pane_string
;
1826 if (keymaps
&& !NILP (prefix
))
1828 prev_wv
->enabled
= 1;
1829 prev_wv
->name
= "message";
1832 /* Loop over all panes and items, filling in the tree. */
1833 i
= MENU_ITEMS_PANE_LENGTH
;
1834 while (i
< menu_items_used
)
1837 /* Create a new item within current pane. */
1838 Lisp_Object item_name
, enable
, descrip
;
1839 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1840 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1842 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1844 if (NILP (item_name
))
1846 free_menubar_widget_value_tree (first_wv
);
1847 *error
= "Submenu in dialog items";
1850 if (EQ (item_name
, Qquote
))
1852 /* This is the boundary between left-side elts
1853 and right-side elts. Stop incrementing right_count. */
1858 if (nb_buttons
>= 10)
1860 free_menubar_widget_value_tree (first_wv
);
1861 *error
= "Too many dialog items";
1865 wv
= malloc_widget_value ();
1867 wv
->name
= (char *) button_names
[nb_buttons
];
1868 if (!NILP (descrip
))
1869 wv
->key
= (char *) XSTRING (descrip
)->data
;
1870 wv
->value
= (char *) XSTRING (item_name
)->data
;
1871 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1872 wv
->enabled
= !NILP (enable
);
1875 if (! boundary_seen
)
1879 i
+= MENU_ITEMS_ITEM_LENGTH
;
1882 /* If the boundary was not specified,
1883 by default put half on the left and half on the right. */
1884 if (! boundary_seen
)
1885 left_count
= nb_buttons
- nb_buttons
/ 2;
1887 wv
= malloc_widget_value ();
1888 wv
->name
= dialog_name
;
1890 /* Dialog boxes use a really stupid name encoding
1891 which specifies how many buttons to use
1892 and how many buttons are on the right.
1893 The Q means something also. */
1894 dialog_name
[0] = 'Q';
1895 dialog_name
[1] = '0' + nb_buttons
;
1896 dialog_name
[2] = 'B';
1897 dialog_name
[3] = 'R';
1898 /* Number of buttons to put on the right. */
1899 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1901 wv
->contents
= first_wv
;
1905 /* Actually create the dialog. */
1906 dialog_id
= ++popup_id_tick
;
1907 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1908 f
->display
.x
->widget
, 1, 0,
1909 dialog_selection_callback
, 0);
1910 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1911 lw_modify_all_widgets (dialog_id
, first_wv
, True
);
1913 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1914 /* Free the widget_value objects we used to specify the contents. */
1915 free_menubar_widget_value_tree (first_wv
);
1917 /* No selection has been chosen yet. */
1918 menu_item_selection
= 0;
1920 /* Display the menu. */
1921 lw_pop_up_all_widgets (dialog_id
);
1923 /* Process events that apply to the menu. */
1928 XtAppNextEvent (Xt_app_con
, &event
);
1929 if (event
.type
== ButtonRelease
)
1931 XtDispatchEvent (&event
);
1934 else if (event
.type
== Expose
)
1935 process_expose_from_menu (event
);
1936 XtDispatchEvent (&event
);
1937 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1939 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1941 if (queue_tmp
!= NULL
)
1943 queue_tmp
->event
= event
;
1944 queue_tmp
->next
= queue
;
1951 /* State that no mouse buttons are now held.
1952 That is not necessarily true, but the fiction leads to reasonable
1953 results, and it is a pain to ask which are actually held now
1954 or track this in the loop above. */
1955 x_mouse_grabbed
= 0;
1957 /* Unread any events that we got but did not handle. */
1958 while (queue
!= NULL
)
1961 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1962 queue
= queue_tmp
->next
;
1963 free ((char *)queue_tmp
);
1964 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1965 interrupt_input_pending
= 1;
1968 /* Find the selected item, and its pane, to return
1969 the proper value. */
1970 if (menu_item_selection
!= 0)
1976 while (i
< menu_items_used
)
1980 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1983 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1984 i
+= MENU_ITEMS_PANE_LENGTH
;
1989 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1990 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1994 entry
= Fcons (entry
, Qnil
);
1996 entry
= Fcons (prefix
, entry
);
2000 i
+= MENU_ITEMS_ITEM_LENGTH
;
2007 #else /* not USE_X_TOOLKIT */
2010 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
2020 int pane
, selidx
, lpane
, status
;
2021 Lisp_Object entry
, pane_prefix
;
2023 int ulx
, uly
, width
, height
;
2024 int dispwidth
, dispheight
;
2028 unsigned int dummy_uint
;
2031 if (menu_items_n_panes
== 0)
2034 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2036 *error
= "Empty menu";
2040 /* Figure out which root window F is on. */
2041 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
2042 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2043 &dummy_uint
, &dummy_uint
);
2045 /* Make the menu on that window. */
2046 menu
= XMenuCreate (XDISPLAY root
, "emacs");
2049 *error
= "Can't create menu";
2053 /* Adjust coordinates to relative to the outer (window manager) window. */
2057 int win_x
= 0, win_y
= 0;
2059 /* Find the position of the outside upper-left corner of
2060 the inner window, with respect to the outer window. */
2061 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2064 XTranslateCoordinates (x_current_display
,
2066 /* From-window, to-window. */
2067 f
->display
.x
->window_desc
,
2068 f
->display
.x
->parent_desc
,
2070 /* From-position, to-position. */
2071 0, 0, &win_x
, &win_y
,
2073 /* Child of window. */
2080 #endif /* HAVE_X11 */
2082 /* Adjust coordinates to be root-window-relative. */
2083 x
+= f
->display
.x
->left_pos
;
2084 y
+= f
->display
.x
->top_pos
;
2086 /* Create all the necessary panes and their items. */
2088 while (i
< menu_items_used
)
2090 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2092 /* Create a new pane. */
2093 Lisp_Object pane_name
, prefix
;
2096 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2097 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2098 pane_string
= (NILP (pane_name
)
2099 ? "" : (char *) XSTRING (pane_name
)->data
);
2100 if (keymaps
&& !NILP (prefix
))
2103 lpane
= XMenuAddPane (XDISPLAY menu
, pane_string
, TRUE
);
2104 if (lpane
== XM_FAILURE
)
2106 XMenuDestroy (XDISPLAY menu
);
2107 *error
= "Can't create pane";
2110 i
+= MENU_ITEMS_PANE_LENGTH
;
2112 /* Find the width of the widest item in this pane. */
2115 while (j
< menu_items_used
)
2118 item
= XVECTOR (menu_items
)->contents
[j
];
2126 width
= XSTRING (item
)->size
;
2127 if (width
> maxwidth
)
2130 j
+= MENU_ITEMS_ITEM_LENGTH
;
2133 /* Ignore a nil in the item list.
2134 It's meaningful only for dialog boxes. */
2135 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2139 /* Create a new item within current pane. */
2140 Lisp_Object item_name
, enable
, descrip
;
2141 unsigned char *item_data
;
2143 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2144 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2146 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2147 if (!NILP (descrip
))
2149 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2152 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2153 item_name
= concat2 (item_name
, spacer
);
2154 item_name
= concat2 (item_name
, descrip
);
2155 item_data
= XSTRING (item_name
)->data
;
2157 /* if alloca is fast, use that to make the space,
2158 to reduce gc needs. */
2160 = (unsigned char *) alloca (maxwidth
2161 + XSTRING (descrip
)->size
+ 1);
2162 bcopy (XSTRING (item_name
)->data
, item_data
,
2163 XSTRING (item_name
)->size
);
2164 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2166 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2167 XSTRING (descrip
)->size
);
2168 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2172 item_data
= XSTRING (item_name
)->data
;
2174 if (XMenuAddSelection (XDISPLAY menu
, lpane
, 0, item_data
,
2178 XMenuDestroy (XDISPLAY menu
);
2179 *error
= "Can't add selection to menu";
2182 i
+= MENU_ITEMS_ITEM_LENGTH
;
2186 /* All set and ready to fly. */
2187 XMenuRecompute (XDISPLAY menu
);
2188 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
2189 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
2190 x
= min (x
, dispwidth
);
2191 y
= min (y
, dispheight
);
2194 XMenuLocate (XDISPLAY menu
, 0, 0, x
, y
,
2195 &ulx
, &uly
, &width
, &height
);
2196 if (ulx
+width
> dispwidth
)
2198 x
-= (ulx
+ width
) - dispwidth
;
2199 ulx
= dispwidth
- width
;
2201 if (uly
+height
> dispheight
)
2203 y
-= (uly
+ height
) - dispheight
;
2204 uly
= dispheight
- height
;
2206 if (ulx
< 0) x
-= ulx
;
2207 if (uly
< 0) y
-= uly
;
2209 XMenuSetAEQ (menu
, TRUE
);
2210 XMenuSetFreeze (menu
, TRUE
);
2213 status
= XMenuActivate (XDISPLAY menu
, &pane
, &selidx
,
2214 x
, y
, ButtonReleaseMask
, &datap
);
2219 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2222 /* Find the item number SELIDX in pane number PANE. */
2224 while (i
< menu_items_used
)
2226 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2230 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2232 i
+= MENU_ITEMS_PANE_LENGTH
;
2241 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2244 entry
= Fcons (entry
, Qnil
);
2245 if (!NILP (pane_prefix
))
2246 entry
= Fcons (pane_prefix
, entry
);
2252 i
+= MENU_ITEMS_ITEM_LENGTH
;
2258 *error
= "Can't activate menu";
2264 XMenuDestroy (XDISPLAY menu
);
2266 /* State that no mouse buttons are now held.
2267 (The oldXMenu code doesn't track this info for us.)
2268 That is not necessarily true, but the fiction leads to reasonable
2269 results, and it is a pain to ask which are actually held now. */
2270 x_mouse_grabbed
= 0;
2274 #endif /* not USE_X_TOOLKIT */
2278 staticpro (&menu_items
);
2281 popup_id_tick
= (1<<16);
2282 defsubr (&Sx_popup_menu
);
2283 defsubr (&Sx_popup_dialog
);