1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* X pop-up deck-of-cards menu facility for gnuemacs.
22 * Written by Jon Arnold and Roman Budzianowski
23 * Mods and rewrite by Robert Krawitz
27 /* Modified by Fred Pierresteguy on December 93
28 to make the popup menus and menubar use the Xt. */
30 /* Rewritten for clarity and GC protection by rms in Feb 94. */
32 /* On 4.3 this loses if it comes after xterm.h. */
38 #include "termhooks.h"
42 #include "blockinput.h"
45 /* This may include sys/types.h, and that somehow loses
46 if this is not done before the other system files. */
49 /* Load sys/types.h if not already loaded.
50 In some systems loading it twice is suicidal. */
52 #include <sys/types.h>
55 #include "dispextern.h"
58 #include "../oldXMenu/XMenu.h"
65 #include <X11/IntrinsicP.h>
66 #include <X11/CoreP.h>
67 #include <X11/StringDefs.h>
68 #include <X11/Shell.h>
69 #include <X11/Xaw/Paned.h>
70 #include "../lwlib/lwlib.h"
71 #include "../lwlib/xlwmenuP.h"
72 #endif /* USE_X_TOOLKIT */
74 #define min(x,y) (((x) < (y)) ? (x) : (y))
75 #define max(x,y) (((x) > (y)) ? (x) : (y))
83 extern Display
*x_current_display
;
85 #define ButtonReleaseMask ButtonReleased
86 #endif /* not HAVE_X11 */
88 /* We need a unique id for each popup menu and dialog box. */
89 static unsigned int popup_id_tick
;
91 extern Lisp_Object Qmenu_enable
;
92 extern Lisp_Object Qmenu_bar
;
95 extern void process_expose_from_menu ();
96 extern XtAppContext Xt_app_con
;
98 static Lisp_Object
xdialog_show ();
101 static Lisp_Object
xmenu_show ();
102 static void keymap_panes ();
103 static void single_keymap_panes ();
104 static void list_of_panes ();
105 static void list_of_items ();
107 /* This holds a Lisp vector that holds the results of decoding
108 the keymaps or alist-of-alists that specify a menu.
110 It describes the panes and items within the panes.
112 Each pane is described by 3 elements in the vector:
113 t, the pane name, the pane's prefix key.
114 Then follow the pane's items, with 4 elements per item:
115 the item string, the enable flag, the item's value,
116 and the equivalent keyboard key's description string.
118 In some cases, multiple levels of menus may be described.
119 A single vector slot containing nil indicates the start of a submenu.
120 A single vector slot containing lambda indicates the end of a submenu.
121 The submenu follows a menu item which is the way to reach the submenu.
123 A single vector slot containing quote indicates that the
124 following items should appear on the right of a dialog box.
126 Using a Lisp vector to hold this information while we decode it
127 takes care of protecting all the data from GC. */
129 #define MENU_ITEMS_PANE_NAME 1
130 #define MENU_ITEMS_PANE_PREFIX 2
131 #define MENU_ITEMS_PANE_LENGTH 3
133 #define MENU_ITEMS_ITEM_NAME 0
134 #define MENU_ITEMS_ITEM_ENABLE 1
135 #define MENU_ITEMS_ITEM_VALUE 2
136 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
137 #define MENU_ITEMS_ITEM_LENGTH 4
139 static Lisp_Object menu_items
;
141 /* Number of slots currently allocated in menu_items. */
142 static int menu_items_allocated
;
144 /* This is the index in menu_items of the first empty slot. */
145 static int menu_items_used
;
147 /* The number of panes currently recorded in menu_items,
148 excluding those within submenus. */
149 static int menu_items_n_panes
;
151 /* Current depth within submenus. */
152 static int menu_items_submenu_depth
;
154 /* Initialize the menu_items structure if we haven't already done so.
155 Also mark it as currently empty. */
160 if (NILP (menu_items
))
162 menu_items_allocated
= 60;
163 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
167 menu_items_n_panes
= 0;
168 menu_items_submenu_depth
= 0;
171 /* Call at the end of generating the data in menu_items.
172 This fills in the number of items in the last pane. */
179 /* Call when finished using the data for the current menu
183 discard_menu_items ()
185 /* Free the structure if it is especially large.
186 Otherwise, hold on to it, to save time. */
187 if (menu_items_allocated
> 200)
190 menu_items_allocated
= 0;
194 /* Make the menu_items vector twice as large. */
200 int old_size
= menu_items_allocated
;
203 menu_items_allocated
*= 2;
204 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
205 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
206 old_size
* sizeof (Lisp_Object
));
209 /* Begin a submenu. */
212 push_submenu_start ()
214 if (menu_items_used
+ 1 > menu_items_allocated
)
217 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
218 menu_items_submenu_depth
++;
226 if (menu_items_used
+ 1 > menu_items_allocated
)
229 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
230 menu_items_submenu_depth
--;
233 /* Indicate boundary between left and right. */
236 push_left_right_boundary ()
238 if (menu_items_used
+ 1 > menu_items_allocated
)
241 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
244 /* Start a new menu pane in menu_items..
245 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
248 push_menu_pane (name
, prefix_vec
)
249 Lisp_Object name
, prefix_vec
;
251 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
254 if (menu_items_submenu_depth
== 0)
255 menu_items_n_panes
++;
256 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
257 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
258 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
261 /* Push one menu item into the current pane.
262 NAME is the string to display. ENABLE if non-nil means
263 this item can be selected. KEY is the key generated by
264 choosing this item. EQUIV is the textual description
265 of the keyboard equivalent for this item (or nil if none). */
268 push_menu_item (name
, enable
, key
, equiv
)
269 Lisp_Object name
, enable
, key
, equiv
;
271 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
274 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
275 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
276 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
277 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
280 /* Figure out the current keyboard equivalent of a menu item ITEM1.
281 The item string for menu display should be ITEM_STRING.
282 Store the equivalent keyboard key sequence's
283 textual description into *DESCRIP_PTR.
284 Also cache them in the item itself.
285 Return the real definition to execute. */
288 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
289 Lisp_Object item_string
;
291 Lisp_Object
*descrip_ptr
;
293 /* This is the real definition--the function to run. */
295 /* This is the sublist that records cached equiv key data
296 so we can save time. */
297 Lisp_Object cachelist
;
298 /* These are the saved equivalent keyboard key sequence
299 and its key-description. */
300 Lisp_Object savedkey
, descrip
;
303 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
305 /* If a help string follows the item string, skip it. */
306 if (CONSP (XCONS (item1
)->cdr
)
307 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
308 item1
= XCONS (item1
)->cdr
;
312 /* Get out the saved equivalent-keyboard-key info. */
313 cachelist
= savedkey
= descrip
= Qnil
;
314 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
315 && (NILP (XCONS (XCONS (def
)->car
)->car
)
316 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
318 cachelist
= XCONS (def
)->car
;
319 def
= XCONS (def
)->cdr
;
320 savedkey
= XCONS (cachelist
)->car
;
321 descrip
= XCONS (cachelist
)->cdr
;
324 GCPRO4 (def
, def1
, savedkey
, descrip
);
326 /* Is it still valid? */
328 if (!NILP (savedkey
))
329 def1
= Fkey_binding (savedkey
, Qnil
);
330 /* If not, update it. */
332 /* If the command is an alias for another
333 (such as easymenu.el and lmenu.el set it up),
334 check if the original command matches the cached command. */
335 && !(SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
)
336 && EQ (def1
, XSYMBOL (def
)->function
))
337 /* If something had no key binding before, don't recheck it--
338 doing that takes too much time and makes menus too slow. */
339 && !(!NILP (cachelist
) && NILP (savedkey
)))
343 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
344 /* If the command is an alias for another
345 (such as easymenu.el and lmenu.el set it up),
346 see if the original command name has equivalent keys. */
347 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
348 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
351 if (VECTORP (savedkey
)
352 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
354 if (!NILP (savedkey
))
356 descrip
= Fkey_description (savedkey
);
357 descrip
= concat2 (make_string (" (", 3), descrip
);
358 descrip
= concat2 (descrip
, make_string (")", 1));
362 /* Cache the data we just got in a sublist of the menu binding. */
363 if (NILP (cachelist
))
365 CHECK_IMPURE (item1
);
366 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
370 XCONS (cachelist
)->car
= savedkey
;
371 XCONS (cachelist
)->cdr
= descrip
;
375 *descrip_ptr
= descrip
;
379 /* This is used as the handler when calling internal_condition_case_1. */
382 menu_item_enabled_p_1 (arg
)
388 /* Return non-nil if the command DEF is enabled when used as a menu item.
389 This is based on looking for a menu-enable property.
390 If NOTREAL is set, don't bother really computing this. */
393 menu_item_enabled_p (def
, notreal
)
397 Lisp_Object enabled
, tem
;
402 if (XTYPE (def
) == Lisp_Symbol
)
404 /* No property, or nil, means enable.
405 Otherwise, enable if value is not nil. */
406 tem
= Fget (def
, Qmenu_enable
);
408 /* (condition-case nil (eval tem)
410 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
411 menu_item_enabled_p_1
);
416 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
417 and generate menu panes for them in menu_items.
418 If NOTREAL is nonzero,
419 don't bother really computing whether an item is enabled. */
422 keymap_panes (keymaps
, nmaps
, notreal
)
423 Lisp_Object
*keymaps
;
431 /* Loop over the given keymaps, making a pane for each map.
432 But don't make a pane that is empty--ignore that map instead.
433 P is the number of panes we have made so far. */
434 for (mapno
= 0; mapno
< nmaps
; mapno
++)
435 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
437 finish_menu_items ();
440 /* This is a recursive subroutine of keymap_panes.
441 It handles one keymap, KEYMAP.
442 The other arguments are passed along
443 or point to local variables of the previous function.
444 If NOTREAL is nonzero,
445 don't bother really computing whether an item is enabled. */
448 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
450 Lisp_Object pane_name
;
454 Lisp_Object pending_maps
;
455 Lisp_Object tail
, item
, item1
, item_string
, table
;
456 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
460 push_menu_pane (pane_name
, prefix
);
462 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
464 /* Look at each key binding, and if it has a menu string,
465 make a menu item from it. */
466 item
= XCONS (tail
)->car
;
467 if (XTYPE (item
) == Lisp_Cons
)
469 item1
= XCONS (item
)->cdr
;
470 if (XTYPE (item1
) == Lisp_Cons
)
472 item_string
= XCONS (item1
)->car
;
473 if (XTYPE (item_string
) == Lisp_String
)
475 /* This is the real definition--the function to run. */
477 /* These are the saved equivalent keyboard key sequence
478 and its key-description. */
480 Lisp_Object tem
, enabled
;
482 /* GCPRO because ...enabled_p will call eval
483 and ..._equiv_key may autoload something.
484 Protecting KEYMAP preserves everything we use;
485 aside from that, must protect whatever might be
486 a string. Since there's no GCPRO5, we refetch
487 item_string instead of protecting it. */
488 descrip
= def
= Qnil
;
489 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
491 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
492 enabled
= menu_item_enabled_p (def
, notreal
);
496 item_string
= XCONS (item1
)->car
;
498 tem
= Fkeymapp (def
);
499 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
500 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
505 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
506 submap
= get_keymap_1 (def
, 0, 1);
508 #ifndef USE_X_TOOLKIT
509 /* Indicate visually that this is a submenu. */
511 item_string
= concat2 (item_string
,
512 build_string (" >"));
514 push_menu_item (item_string
, enabled
, XCONS (item
)->car
,
517 /* Display a submenu using the toolkit. */
520 push_submenu_start ();
521 single_keymap_panes (submap
, Qnil
,
522 XCONS (item
)->car
, notreal
);
530 else if (XTYPE (item
) == Lisp_Vector
)
532 /* Loop over the char values represented in the vector. */
533 int len
= XVECTOR (item
)->size
;
535 for (c
= 0; c
< len
; c
++)
537 Lisp_Object character
;
538 XFASTINT (character
) = c
;
539 item1
= XVECTOR (item
)->contents
[c
];
540 if (XTYPE (item1
) == Lisp_Cons
)
542 item_string
= XCONS (item1
)->car
;
543 if (XTYPE (item_string
) == Lisp_String
)
547 /* These are the saved equivalent keyboard key sequence
548 and its key-description. */
550 Lisp_Object tem
, enabled
;
552 /* GCPRO because ...enabled_p will call eval
553 and ..._equiv_key may autoload something.
554 Protecting KEYMAP preserves everything we use;
555 aside from that, must protect whatever might be
556 a string. Since there's no GCPRO5, we refetch
557 item_string instead of protecting it. */
558 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
559 descrip
= def
= Qnil
;
561 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
562 enabled
= menu_item_enabled_p (def
, notreal
);
566 item_string
= XCONS (item1
)->car
;
568 tem
= Fkeymapp (def
);
569 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
570 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
575 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
576 submap
= get_keymap_1 (def
, 0, 1);
578 #ifndef USE_X_TOOLKIT
580 item_string
= concat2 (item_string
,
581 build_string (" >"));
583 push_menu_item (item_string
, enabled
, character
,
588 push_submenu_start ();
589 single_keymap_panes (submap
, Qnil
,
601 /* Process now any submenus which want to be panes at this level. */
602 while (!NILP (pending_maps
))
604 Lisp_Object elt
, eltcdr
, string
;
605 elt
= Fcar (pending_maps
);
606 eltcdr
= XCONS (elt
)->cdr
;
607 string
= XCONS (eltcdr
)->car
;
608 /* We no longer discard the @ from the beginning of the string here.
609 Instead, we do this in xmenu_show. */
610 single_keymap_panes (Fcar (elt
), string
,
611 XCONS (eltcdr
)->cdr
, notreal
);
612 pending_maps
= Fcdr (pending_maps
);
616 /* Push all the panes and items of a menu decsribed by the
617 alist-of-alists MENU.
618 This handles old-fashioned calls to x-popup-menu. */
628 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
630 Lisp_Object elt
, pane_name
, pane_data
;
632 pane_name
= Fcar (elt
);
633 CHECK_STRING (pane_name
, 0);
634 push_menu_pane (pane_name
, Qnil
);
635 pane_data
= Fcdr (elt
);
636 CHECK_CONS (pane_data
, 0);
637 list_of_items (pane_data
);
640 finish_menu_items ();
643 /* Push the items in a single pane defined by the alist PANE. */
649 Lisp_Object tail
, item
, item1
;
651 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
655 push_menu_item (item
, Qnil
, Qnil
, Qnil
);
656 else if (NILP (item
))
657 push_left_right_boundary ();
660 CHECK_CONS (item
, 0);
662 CHECK_STRING (item1
, 1);
663 push_menu_item (item1
, Qt
, Fcdr (item
), Qnil
);
668 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
669 "Pop up a deck-of-cards menu and return user's selection.\n\
670 POSITION is a position specification. This is either a mouse button event\n\
671 or a list ((XOFFSET YOFFSET) WINDOW)\n\
672 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
673 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
674 This controls the position of the center of the first line\n\
675 in the first pane of the menu, not the top left of the menu as a whole.\n\
676 If POSITION is t, it means to use the current mouse position.\n\
678 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
679 The menu items come from key bindings that have a menu string as well as\n\
680 a definition; actually, the \"definition\" in such a key binding looks like\n\
681 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
682 the keymap as a top-level element.\n\n\
683 You can also use a list of keymaps as MENU.\n\
684 Then each keymap makes a separate pane.\n\
685 When MENU is a keymap or a list of keymaps, the return value\n\
686 is a list of events.\n\n\
687 Alternatively, you can specify a menu of multiple panes\n\
688 with a list of the form (TITLE PANE1 PANE2...),\n\
689 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
690 Each ITEM is normally a cons cell (STRING . VALUE);\n\
691 but a string can appear as an item--that makes a nonselectable line\n\
693 With this form of menu, the return value is VALUE from the chosen item.\n\
695 If POSITION is nil, don't display the menu at all, just precalculate the\n\
696 cached information about equivalent key sequences.")
698 Lisp_Object position
, menu
;
700 int number_of_panes
, panes
;
701 Lisp_Object keymap
, tem
;
705 Lisp_Object selection
;
708 Lisp_Object x
, y
, window
;
713 if (! NILP (position
))
717 /* Decode the first argument: find the window and the coordinates. */
718 if (EQ (position
, Qt
))
720 /* Use the mouse's current position. */
722 Lisp_Object bar_window
;
726 if (mouse_position_hook
)
727 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
729 XSET (window
, Lisp_Frame
, new_f
);
732 window
= selected_window
;
739 tem
= Fcar (position
);
740 if (XTYPE (tem
) == Lisp_Cons
)
742 window
= Fcar (Fcdr (position
));
744 y
= Fcar (Fcdr (tem
));
748 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
749 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
750 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
754 /* Determine whether this menu is handling a menu bar click. */
755 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
756 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
764 /* Decode where to put the menu. */
766 if (XTYPE (window
) == Lisp_Frame
)
773 else if (XTYPE (window
) == Lisp_Window
)
775 CHECK_LIVE_WINDOW (window
, 0);
776 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
778 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
779 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
782 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
783 but I don't want to make one now. */
784 CHECK_WINDOW (window
, 0);
793 /* Decode the menu items from what was specified. */
795 keymap
= Fkeymapp (menu
);
797 if (XTYPE (menu
) == Lisp_Cons
)
798 tem
= Fkeymapp (Fcar (menu
));
801 /* We were given a keymap. Extract menu info from the keymap. */
803 keymap
= get_keymap (menu
);
805 /* Extract the detailed info to make one pane. */
806 keymap_panes (&menu
, 1, NILP (position
));
808 /* Search for a string appearing directly as an element of the keymap.
809 That string is the title of the menu. */
810 prompt
= map_prompt (keymap
);
812 /* Make that be the pane title of the first pane. */
813 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
814 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
818 else if (!NILP (tem
))
820 /* We were given a list of keymaps. */
821 int nmaps
= XFASTINT (Flength (menu
));
823 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
828 /* The first keymap that has a prompt string
829 supplies the menu title. */
830 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
834 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
836 prompt
= map_prompt (keymap
);
837 if (NILP (title
) && !NILP (prompt
))
841 /* Extract the detailed info to make one pane. */
842 keymap_panes (maps
, nmaps
, NILP (position
));
844 /* Make the title be the pane title of the first pane. */
845 if (!NILP (title
) && menu_items_n_panes
>= 0)
846 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
852 /* We were given an old-fashioned menu. */
854 CHECK_STRING (title
, 1);
856 list_of_panes (Fcdr (menu
));
863 discard_menu_items ();
868 /* Display them in a menu. */
871 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
,
872 keymaps
, title
, &error_name
);
875 discard_menu_items ();
879 if (error_name
) error (error_name
);
883 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
884 "Pop up a dialog box and return user's selection.\n\
885 POSITION specifies which frame to use.\n\
886 This is normally a mouse button event or a window or frame.\n\
887 If POSITION is t, it means to use the frame the mouse is on.\n\
888 The dialog box appears in the middle of the specified frame.\n\
890 CONTENTS specifies the alternatives to display in the dialog box.\n\
891 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
892 Each ITEM is a cons cell (STRING . VALUE).\n\
893 The return value is VALUE from the chosen item.\n\n\
894 An ITEM may also be just a string--that makes a nonselectable item.\n\
895 An ITEM may also be nil--that means to put all preceding items\n\
896 on the left of the dialog box and all following items on the right.\n\
897 \(By default, approximately half appear on each side.)")
899 Lisp_Object position
, contents
;
906 /* Decode the first argument: find the window or frame to use. */
907 if (EQ (position
, Qt
))
909 #if 0 /* Using the frame the mouse is on may not be right. */
910 /* Use the mouse's current position. */
912 Lisp_Object bar_window
;
917 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
920 XSET (window
, Lisp_Frame
, new_f
);
922 window
= selected_window
;
924 /* Decode the first argument: find the window and the coordinates. */
925 if (EQ (position
, Qt
))
926 window
= selected_window
;
928 else if (CONSP (position
))
931 tem
= Fcar (position
);
932 if (XTYPE (tem
) == Lisp_Cons
)
933 window
= Fcar (Fcdr (position
));
936 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
937 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
940 else if (WINDOWP (position
) || FRAMEP (position
))
943 /* Decode where to put the menu. */
945 if (XTYPE (window
) == Lisp_Frame
)
947 else if (XTYPE (window
) == Lisp_Window
)
949 CHECK_LIVE_WINDOW (window
, 0);
950 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
953 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
954 but I don't want to make one now. */
955 CHECK_WINDOW (window
, 0);
957 #ifndef USE_X_TOOLKIT
958 /* Display a menu with these alternatives
959 in the middle of frame F. */
961 Lisp_Object x
, y
, frame
, newpos
;
962 XSET (frame
, Lisp_Frame
, f
);
963 XSET (x
, Lisp_Int
, x_pixel_width (f
) / 2);
964 XSET (y
, Lisp_Int
, x_pixel_height (f
) / 2);
965 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
967 return Fx_popup_menu (newpos
,
968 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
974 Lisp_Object selection
;
976 /* Decode the dialog items from what was specified. */
977 title
= Fcar (contents
);
978 CHECK_STRING (title
, 1);
980 list_of_panes (Fcons (contents
, Qnil
));
982 /* Display them in a dialog box. */
984 selection
= xdialog_show (f
, 0, 0, title
, &error_name
);
987 discard_menu_items ();
989 if (error_name
) error (error_name
);
998 dispatch_dummy_expose (w
, x
, y
)
1005 dummy
.type
= Expose
;
1006 dummy
.window
= XtWindow (w
);
1009 dummy
.send_event
= 0;
1010 dummy
.display
= XtDisplay (w
);
1014 XtDispatchEvent ((XEvent
*) &dummy
);
1018 event_is_in_menu_item (mw
, event
, name
, string_w
)
1020 struct input_event
*event
;
1024 *string_w
+= (string_width (mw
, name
)
1025 + 2 * (mw
->menu
.horizontal_spacing
1026 + mw
->menu
.shadow_thickness
));
1027 return XINT (event
->x
) < *string_w
;
1031 /* Return the menu bar key which corresponds to event EVENT in frame F. */
1034 map_event_to_object (event
, f
)
1035 struct input_event
*event
;
1040 XlwMenuWidget mw
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1045 /* Find the window */
1046 for (val
= mw
->menu
.old_stack
[0]->contents
; val
; val
= val
->next
)
1048 ws
= &mw
->menu
.windows
[0];
1049 if (ws
&& event_is_in_menu_item (mw
, event
, val
->name
, &string_w
))
1054 items
= FRAME_MENU_BAR_ITEMS (f
);
1056 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1058 Lisp_Object pos
, string
, item
;
1059 item
= XVECTOR (items
)->contents
[i
];
1060 string
= XVECTOR (items
)->contents
[i
+ 1];
1061 pos
= XVECTOR (items
)->contents
[i
+ 2];
1065 if (!strcmp (val
->name
, XSTRING (string
)->data
))
1074 static Lisp_Object
*volatile menu_item_selection
;
1076 static Lisp_Object
*menu_item_selection
;
1080 popup_selection_callback (widget
, id
, client_data
)
1083 XtPointer client_data
;
1085 menu_item_selection
= (Lisp_Object
*) client_data
;
1089 popup_down_callback (widget
, id
, client_data
)
1092 XtPointer client_data
;
1095 lw_destroy_all_widgets (id
);
1100 dialog_selection_callback (widget
, id
, client_data
)
1103 XtPointer client_data
;
1105 if ((int)client_data
!= -1)
1106 menu_item_selection
= (Lisp_Object
*) client_data
;
1108 lw_destroy_all_widgets (id
);
1112 /* This recursively calls free_widget_value() on the tree of widgets.
1113 It must free all data that was malloc'ed for these widget_values.
1114 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1115 must be left alone. */
1118 free_menubar_widget_value_tree (wv
)
1123 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1125 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1127 free_menubar_widget_value_tree (wv
->contents
);
1128 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1132 free_menubar_widget_value_tree (wv
->next
);
1133 wv
->next
= (widget_value
*) 0xDEADBEEF;
1136 free_widget_value (wv
);
1140 extern void EmacsFrameSetCharSize ();
1143 update_frame_menubar (f
)
1146 struct x_display
*x
= f
->display
.x
;
1148 int menubar_changed
;
1150 menubar_changed
= (x
->menubar_widget
1151 && !XtIsManaged (x
->menubar_widget
));
1153 if (! (menubar_changed
))
1157 /* Save the size of the frame because the pane widget doesn't accept to
1158 resize itself. So force it. */
1163 XawPanedSetRefigureMode (x
->column_widget
, 0);
1165 /* the order in which children are managed is the top to
1166 bottom order in which they are displayed in the paned window.
1167 First, remove the text-area widget.
1169 XtUnmanageChild (x
->edit_widget
);
1171 /* remove the menubar that is there now, and put up the menubar that
1174 if (menubar_changed
)
1176 XtManageChild (x
->menubar_widget
);
1177 XtMapWidget (x
->menubar_widget
);
1178 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1182 /* Re-manage the text-area widget */
1183 XtManageChild (x
->edit_widget
);
1185 /* and now thrash the sizes */
1186 XawPanedSetRefigureMode (x
->column_widget
, 1);
1188 /* Force the pane widget to resize itself with the right values. */
1189 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1195 set_frame_menubar (f
, first_time
)
1199 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1201 Lisp_Object tail
, items
;
1202 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
1207 wv
= malloc_widget_value ();
1208 wv
->name
= "menubar";
1211 save_wv
= first_wv
= wv
;
1213 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1214 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1216 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1220 string
= XVECTOR (items
)->contents
[i
+ 1];
1224 wv
= malloc_widget_value ();
1228 save_wv
->contents
= wv
;
1229 wv
->name
= (char *) XSTRING (string
)->data
;
1236 lw_modify_all_widgets (id
, first_wv
, False
);
1239 menubar_widget
= lw_create_widget ("menubar", "menubar",
1241 f
->display
.x
->column_widget
,
1244 f
->display
.x
->menubar_widget
= menubar_widget
;
1245 XtVaSetValues (menubar_widget
,
1247 XtNresizeToPreferred
, 1,
1252 free_menubar_widget_value_tree (first_wv
);
1254 /* Don't update the menubar the first time it is created via x_window. */
1256 update_frame_menubar (f
);
1262 free_frame_menubar (f
)
1265 Widget menubar_widget
;
1268 menubar_widget
= f
->display
.x
->menubar_widget
;
1274 lw_destroy_all_widgets (id
);
1278 /* Called from Fx_create_frame to create the inital menubar of a frame
1279 before it is mapped, so that the window is mapped with the menubar already
1280 there instead of us tacking it on later and thrashing the window after it
1283 initialize_frame_menubar (f
)
1286 set_frame_menubar (f
, 1);
1289 /* Horizontal bounds of the current menu bar item. */
1291 static int this_menu_bar_item_beg
;
1292 static int this_menu_bar_item_end
;
1294 /* Horizontal position of the end of the last menu bar item. */
1296 static int last_menu_bar_item_end
;
1298 /* Nonzero if position X, Y is in the menu bar and in some menu bar item
1299 but not in the current menu bar item. */
1302 other_menu_bar_item_p (f
, x
, y
)
1307 && f
->display
.x
->menubar_widget
!= 0
1308 && y
< f
->display
.x
->menubar_widget
->core
.height
1310 && x
< last_menu_bar_item_end
1311 && (x
>= this_menu_bar_item_end
1312 || x
< this_menu_bar_item_beg
));
1315 /* Unread a button-press event in the menu bar of frame F
1316 at x position XPOS relative to the inside of the frame. */
1319 unread_menu_bar_button (f
, xpos
)
1325 event
.type
= ButtonPress
;
1326 event
.xbutton
.display
= x_current_display
;
1327 event
.xbutton
.serial
= 0;
1328 event
.xbutton
.send_event
= 0;
1329 event
.xbutton
.time
= CurrentTime
;
1330 event
.xbutton
.button
= Button1
;
1331 event
.xbutton
.window
= XtWindow (f
->display
.x
->menubar_widget
);
1332 event
.xbutton
.x
= xpos
;
1333 XPutBackEvent (XDISPLAY
&event
);
1336 /* If the mouse has moved to another menu bar item,
1337 return 1 and unread a button press event for that item.
1338 Otherwise return 0. */
1341 check_mouse_other_menu_bar (f
)
1345 Lisp_Object bar_window
;
1350 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1352 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1354 unread_menu_bar_button (f
, x
);
1360 #endif /* USE_X_TOOLKIT */
1362 /* xmenu_show actually displays a menu using the panes and items in menu_items
1363 and returns the value selected from it.
1364 There are two versions of xmenu_show, one for Xt and one for Xlib.
1365 Both assume input is blocked by the caller. */
1367 /* F is the frame the menu is for.
1368 X and Y are the frame-relative specified position,
1369 relative to the inside upper left corner of the frame F.
1370 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1371 KEYMAPS is 1 if this menu was specified with keymaps;
1372 in that case, we return a list containing the chosen item's value
1373 and perhaps also the pane's prefix.
1374 TITLE is the specified menu title.
1375 ERROR is a place to store an error message string in case of failure.
1376 (We return nil on failure, but the value doesn't actually matter.) */
1378 #ifdef USE_X_TOOLKIT
1380 extern unsigned last_event_timestamp
;
1381 extern Lisp_Object Vdouble_click_time
;
1383 extern unsigned int x_mouse_grabbed
;
1384 extern Lisp_Object Vmouse_depressed
;
1387 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1399 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1403 /* This is the menu bar item (if any) that led to this menu. */
1404 widget_value
*menubar_item
= 0;
1406 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1407 widget_value
**submenu_stack
1408 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1409 Lisp_Object
*subprefix_stack
1410 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1411 int submenu_depth
= 0;
1413 /* Define a queue to save up for later unreading
1414 all X events that don't pertain to the menu. */
1418 struct event_queue
*next
;
1421 struct event_queue
*queue
= NULL
;
1422 struct event_queue
*queue_tmp
;
1424 Position root_x
, root_y
;
1427 int next_release_must_exit
= 0;
1431 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1433 *error
= "Empty menu";
1436 this_menu_bar_item_beg
= -1;
1437 this_menu_bar_item_end
= -1;
1438 last_menu_bar_item_end
= -1;
1440 /* Figure out which menu bar item, if any, this menu is for. */
1445 widget_value
*mb_item
= 0;
1447 for (mb_item
= menubar
->menu
.old_stack
[0]->contents
;
1449 mb_item
= mb_item
->next
)
1452 xend
+= (string_width (menubar
, mb_item
->name
)
1453 + 2 * (menubar
->menu
.horizontal_spacing
1454 + menubar
->menu
.shadow_thickness
));
1455 if (x
>= xbeg
&& x
< xend
)
1459 menubar_item
= mb_item
;
1460 /* Arrange to show a different menu if we move in the menu bar
1461 to a different item. */
1462 this_menu_bar_item_beg
= xbeg
;
1463 this_menu_bar_item_end
= xend
;
1466 last_menu_bar_item_end
= xend
;
1468 if (menubar_item
== 0)
1471 /* Offset the coordinates to root-relative. */
1472 if (f
->display
.x
->menubar_widget
!= 0)
1473 y
+= f
->display
.x
->menubar_widget
->core
.height
;
1474 XtTranslateCoords (f
->display
.x
->widget
,
1475 x
, y
, &root_x
, &root_y
);
1479 /* Create a tree of widget_value objects
1480 representing the panes and their items. */
1481 wv
= malloc_widget_value ();
1488 /* Loop over all panes and items, filling in the tree. */
1490 while (i
< menu_items_used
)
1492 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1494 submenu_stack
[submenu_depth
++] = save_wv
;
1500 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1503 save_wv
= submenu_stack
[--submenu_depth
];
1507 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1508 && submenu_depth
!= 0)
1509 i
+= MENU_ITEMS_PANE_LENGTH
;
1510 /* Ignore a nil in the item list.
1511 It's meaningful only for dialog boxes. */
1512 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1514 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1516 /* Create a new pane. */
1517 Lisp_Object pane_name
, prefix
;
1519 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1520 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1521 pane_string
= (NILP (pane_name
)
1522 ? "" : (char *) XSTRING (pane_name
)->data
);
1523 /* If there is just one top-level pane, put all its items directly
1524 under the top-level menu. */
1525 if (menu_items_n_panes
== 1)
1528 /* If the pane has a meaningful name,
1529 make the pane a top-level menu item
1530 with its items as a submenu beneath it. */
1531 if (!keymaps
&& strcmp (pane_string
, ""))
1533 wv
= malloc_widget_value ();
1537 first_wv
->contents
= wv
;
1538 wv
->name
= pane_string
;
1539 if (keymaps
&& !NILP (prefix
))
1546 else if (first_pane
)
1552 i
+= MENU_ITEMS_PANE_LENGTH
;
1556 /* Create a new item within current pane. */
1557 Lisp_Object item_name
, enable
, descrip
;
1558 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1559 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1561 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1563 wv
= malloc_widget_value ();
1567 save_wv
->contents
= wv
;
1568 wv
->name
= (char *) XSTRING (item_name
)->data
;
1569 if (!NILP (descrip
))
1570 wv
->key
= (char *) XSTRING (descrip
)->data
;
1572 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1573 wv
->enabled
= !NILP (enable
);
1576 i
+= MENU_ITEMS_ITEM_LENGTH
;
1580 /* Actually create the menu. */
1581 menu_id
= ++popup_id_tick
;
1582 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1583 f
->display
.x
->widget
, 1, 0,
1584 popup_selection_callback
, popup_down_callback
);
1586 /* Don't allow any geometry request from the user. */
1587 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
1588 XtSetValues (menu
, av
, ac
);
1590 /* Free the widget_value objects we used to specify the contents. */
1591 free_menubar_widget_value_tree (first_wv
);
1593 /* No selection has been chosen yet. */
1594 menu_item_selection
= 0;
1596 /* If the mouse moves out of the menu before we show the menu,
1597 don't show it at all. */
1598 if (check_mouse_other_menu_bar (f
))
1600 lw_destroy_all_widgets (menu_id
);
1605 /* Highlight the menu bar item (if any) that led to this menu. */
1608 menubar_item
->call_data
= (XtPointer
) 1;
1609 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1612 /* Display the menu. */
1614 XButtonPressedEvent dummy
;
1617 mw
= (XlwMenuWidget
) ((CompositeWidget
)menu
)->composite
.children
[0];
1619 dummy
.type
= ButtonPress
;
1621 dummy
.send_event
= 0;
1622 dummy
.display
= XtDisplay (menu
);
1623 dummy
.window
= XtWindow (XtParent (menu
));
1624 dummy
.time
= CurrentTime
;
1629 /* We activate directly the lucid implementation. */
1630 pop_up_menu (mw
, &dummy
);
1633 /* No need to check a second time since this is done in the XEvent loop.
1634 This slows done the execution. */
1636 /* Check again whether the mouse has moved to another menu bar item. */
1637 if (check_mouse_other_menu_bar (f
))
1639 /* The mouse moved into a different menu bar item.
1640 We should bring up that item's menu instead.
1641 First pop down this menu. */
1642 #if 0 /* xlwmenu.c now does this. */
1643 XtUngrabPointer ((Widget
)
1645 ((CompositeWidget
)menu
)->composite
.children
[0]),
1648 lw_destroy_all_widgets (menu_id
);
1653 /* Process events that apply to the menu. */
1657 int queue_and_exit
= 0;
1658 int in_this_menu
= 0, in_menu_bar
= 0;
1661 XtAppNextEvent (Xt_app_con
, &event
);
1663 /* Check whether the event happened in the menu
1664 or any child of it. */
1665 widget
= XtWindowToWidget (XDISPLAY event
.xany
.window
);
1674 if (widget
== f
->display
.x
->menubar_widget
)
1679 widget
= XtParent (widget
);
1682 if (event
.type
== ButtonRelease
)
1684 /* Do the work of construct_mouse_click since it can't
1685 be called. Initially, the popup menu has been called
1686 from a ButtonPress in the edit_widget. Then the mouse
1687 has been set to grabbed. Reset it now. */
1688 x_mouse_grabbed
&= ~(1 << event
.xbutton
.button
);
1689 if (!x_mouse_grabbed
)
1690 Vmouse_depressed
= Qnil
;
1692 /* If we release the button soon without selecting anything,
1693 stay in the loop--that is, leave the menu posted.
1694 Otherwise, exit this loop and thus pop down the menu. */
1696 && (next_release_must_exit
1697 || !(((XButtonEvent
*) (&event
))->time
- last_event_timestamp
1698 < XINT (Vdouble_click_time
))))
1701 /* A button press outside the menu => pop it down. */
1702 else if (event
.type
== ButtonPress
&& !in_this_menu
)
1704 else if (event
.type
== ButtonPress
)
1705 next_release_must_exit
= 1;
1706 else if (event
.type
== KeyPress
)
1708 /* Exit the loop, but first queue this event for reuse. */
1711 else if (event
.type
== Expose
)
1712 process_expose_from_menu (event
);
1713 /* If the mouse moves to a different menu bar item, switch to
1714 that item's menu. But only if the button is still held down. */
1715 else if (event
.type
== MotionNotify
1718 int event_x
= (event
.xmotion
.x_root
1719 - (f
->display
.x
->widget
->core
.x
1720 + f
->display
.x
->widget
->core
.border_width
));
1721 int event_y
= (event
.xmotion
.y_root
1722 - (f
->display
.x
->widget
->core
.y
1723 + f
->display
.x
->widget
->core
.border_width
));
1725 if (other_menu_bar_item_p (f
, event_x
, event_y
))
1727 /* The mouse moved into a different menu bar item.
1728 We should bring up that item's menu instead.
1729 First pop down this menu. */
1730 #if 0 /* xlwmenu.c now does this. */
1731 XtUngrabPointer ((Widget
)
1733 ((CompositeWidget
)menu
)->composite
.children
[0]),
1734 event
.xbutton
.time
);
1736 lw_destroy_all_widgets (menu_id
);
1738 /* Put back an event that will bring up the other item's menu. */
1739 unread_menu_bar_button (f
, event_x
);
1740 /* Don't let us select anything in this case. */
1741 menu_item_selection
= 0;
1745 else if (event
.type
== UnmapNotify
)
1747 /* If the menu disappears, there is no need to stay in the
1749 if (event
.xunmap
.window
== menu
->core
.window
)
1753 XtDispatchEvent (&event
);
1755 if (queue_and_exit
|| (!in_this_menu
&& !in_menu_bar
))
1758 = (struct event_queue
*) malloc (sizeof (struct event_queue
));
1760 if (queue_tmp
!= NULL
)
1762 queue_tmp
->event
= event
;
1763 queue_tmp
->next
= queue
;
1772 /* Unhighlight the menu bar item (if any) that led to this menu. */
1775 menubar_item
->call_data
= (XtPointer
) 0;
1776 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1779 /* fp turned off the following statement and wrote a comment
1780 that it is unnecessary--that the menu has already disappeared.
1781 I observer that is not so. -- rms. */
1782 /* Make sure the menu disappears. */
1783 lw_destroy_all_widgets (menu_id
);
1785 /* Unread any events that we got but did not handle. */
1786 while (queue
!= NULL
)
1789 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1790 queue
= queue_tmp
->next
;
1791 free ((char *)queue_tmp
);
1792 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1793 interrupt_input_pending
= 1;
1796 /* Find the selected item, and its pane, to return
1797 the proper value. */
1798 if (menu_item_selection
!= 0)
1804 while (i
< menu_items_used
)
1808 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1810 subprefix_stack
[submenu_depth
++] = prefix
;
1814 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1816 prefix
= subprefix_stack
[--submenu_depth
];
1819 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1822 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1823 i
+= MENU_ITEMS_PANE_LENGTH
;
1828 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1829 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1835 entry
= Fcons (entry
, Qnil
);
1837 entry
= Fcons (prefix
, entry
);
1838 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1839 if (!NILP (subprefix_stack
[j
]))
1840 entry
= Fcons (subprefix_stack
[j
], entry
);
1844 i
+= MENU_ITEMS_ITEM_LENGTH
;
1852 static char * button_names
[] = {
1853 "button1", "button2", "button3", "button4", "button5",
1854 "button6", "button7", "button8", "button9", "button10" };
1857 xdialog_show (f
, menubarp
, keymaps
, title
, error
)
1864 int i
, nb_buttons
=0;
1867 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1868 char dialog_name
[6];
1870 /* This is the menu bar item (if any) that led to this menu. */
1871 widget_value
*menubar_item
= 0;
1873 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1875 /* Define a queue to save up for later unreading
1876 all X events that don't pertain to the menu. */
1880 struct event_queue
*next
;
1883 struct event_queue
*queue
= NULL
;
1884 struct event_queue
*queue_tmp
;
1886 /* Number of elements seen so far, before boundary. */
1888 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1889 int boundary_seen
= 0;
1893 if (menu_items_n_panes
> 1)
1895 *error
= "Multiple panes in dialog box";
1899 /* Create a tree of widget_value objects
1900 representing the text label and buttons. */
1902 Lisp_Object pane_name
, prefix
;
1904 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1905 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1906 pane_string
= (NILP (pane_name
)
1907 ? "" : (char *) XSTRING (pane_name
)->data
);
1908 prev_wv
= malloc_widget_value ();
1909 prev_wv
->value
= pane_string
;
1910 if (keymaps
&& !NILP (prefix
))
1912 prev_wv
->enabled
= 1;
1913 prev_wv
->name
= "message";
1916 /* Loop over all panes and items, filling in the tree. */
1917 i
= MENU_ITEMS_PANE_LENGTH
;
1918 while (i
< menu_items_used
)
1921 /* Create a new item within current pane. */
1922 Lisp_Object item_name
, enable
, descrip
;
1923 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1924 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1926 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1928 if (NILP (item_name
))
1930 free_menubar_widget_value_tree (first_wv
);
1931 *error
= "Submenu in dialog items";
1934 if (EQ (item_name
, Qquote
))
1936 /* This is the boundary between left-side elts
1937 and right-side elts. Stop incrementing right_count. */
1942 if (nb_buttons
>= 10)
1944 free_menubar_widget_value_tree (first_wv
);
1945 *error
= "Too many dialog items";
1949 wv
= malloc_widget_value ();
1951 wv
->name
= (char *) button_names
[nb_buttons
];
1952 if (!NILP (descrip
))
1953 wv
->key
= (char *) XSTRING (descrip
)->data
;
1954 wv
->value
= (char *) XSTRING (item_name
)->data
;
1955 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1956 wv
->enabled
= !NILP (enable
);
1959 if (! boundary_seen
)
1963 i
+= MENU_ITEMS_ITEM_LENGTH
;
1966 /* If the boundary was not specified,
1967 by default put half on the left and half on the right. */
1968 if (! boundary_seen
)
1969 left_count
= nb_buttons
- nb_buttons
/ 2;
1971 wv
= malloc_widget_value ();
1972 wv
->name
= dialog_name
;
1974 /* Dialog boxes use a really stupid name encoding
1975 which specifies how many buttons to use
1976 and how many buttons are on the right.
1977 The Q means something also. */
1978 dialog_name
[0] = 'Q';
1979 dialog_name
[1] = '0' + nb_buttons
;
1980 dialog_name
[2] = 'B';
1981 dialog_name
[3] = 'R';
1982 /* Number of buttons to put on the right. */
1983 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1985 wv
->contents
= first_wv
;
1989 /* Actually create the dialog. */
1990 dialog_id
= ++popup_id_tick
;
1991 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1992 f
->display
.x
->widget
, 1, 0,
1993 dialog_selection_callback
, 0);
1994 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1995 lw_modify_all_widgets (dialog_id
, first_wv
, True
);
1997 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1998 /* Free the widget_value objects we used to specify the contents. */
1999 free_menubar_widget_value_tree (first_wv
);
2001 /* No selection has been chosen yet. */
2002 menu_item_selection
= 0;
2004 /* Display the menu. */
2005 lw_pop_up_all_widgets (dialog_id
);
2007 /* Process events that apply to the menu. */
2012 XtAppNextEvent (Xt_app_con
, &event
);
2013 if (event
.type
== ButtonRelease
)
2015 XtDispatchEvent (&event
);
2018 else if (event
.type
== Expose
)
2019 process_expose_from_menu (event
);
2020 XtDispatchEvent (&event
);
2021 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
2023 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
2025 if (queue_tmp
!= NULL
)
2027 queue_tmp
->event
= event
;
2028 queue_tmp
->next
= queue
;
2035 /* State that no mouse buttons are now held.
2036 That is not necessarily true, but the fiction leads to reasonable
2037 results, and it is a pain to ask which are actually held now
2038 or track this in the loop above. */
2039 x_mouse_grabbed
= 0;
2041 /* Unread any events that we got but did not handle. */
2042 while (queue
!= NULL
)
2045 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
2046 queue
= queue_tmp
->next
;
2047 free ((char *)queue_tmp
);
2048 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
2049 interrupt_input_pending
= 1;
2052 /* Find the selected item, and its pane, to return
2053 the proper value. */
2054 if (menu_item_selection
!= 0)
2060 while (i
< menu_items_used
)
2064 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2067 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2068 i
+= MENU_ITEMS_PANE_LENGTH
;
2073 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2074 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2078 entry
= Fcons (entry
, Qnil
);
2080 entry
= Fcons (prefix
, entry
);
2084 i
+= MENU_ITEMS_ITEM_LENGTH
;
2091 #else /* not USE_X_TOOLKIT */
2094 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
2104 int pane
, selidx
, lpane
, status
;
2105 Lisp_Object entry
, pane_prefix
;
2107 int ulx
, uly
, width
, height
;
2108 int dispwidth
, dispheight
;
2112 unsigned int dummy_uint
;
2115 if (menu_items_n_panes
== 0)
2118 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2120 *error
= "Empty menu";
2124 /* Figure out which root window F is on. */
2125 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
2126 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2127 &dummy_uint
, &dummy_uint
);
2129 /* Make the menu on that window. */
2130 menu
= XMenuCreate (XDISPLAY root
, "emacs");
2133 *error
= "Can't create menu";
2137 /* Adjust coordinates to relative to the outer (window manager) window. */
2141 int win_x
= 0, win_y
= 0;
2143 /* Find the position of the outside upper-left corner of
2144 the inner window, with respect to the outer window. */
2145 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2148 XTranslateCoordinates (x_current_display
,
2150 /* From-window, to-window. */
2151 f
->display
.x
->window_desc
,
2152 f
->display
.x
->parent_desc
,
2154 /* From-position, to-position. */
2155 0, 0, &win_x
, &win_y
,
2157 /* Child of window. */
2164 #endif /* HAVE_X11 */
2166 /* Adjust coordinates to be root-window-relative. */
2167 x
+= f
->display
.x
->left_pos
;
2168 y
+= f
->display
.x
->top_pos
;
2170 /* Create all the necessary panes and their items. */
2172 while (i
< menu_items_used
)
2174 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2176 /* Create a new pane. */
2177 Lisp_Object pane_name
, prefix
;
2180 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2181 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2182 pane_string
= (NILP (pane_name
)
2183 ? "" : (char *) XSTRING (pane_name
)->data
);
2184 if (keymaps
&& !NILP (prefix
))
2187 lpane
= XMenuAddPane (XDISPLAY menu
, pane_string
, TRUE
);
2188 if (lpane
== XM_FAILURE
)
2190 XMenuDestroy (XDISPLAY menu
);
2191 *error
= "Can't create pane";
2194 i
+= MENU_ITEMS_PANE_LENGTH
;
2196 /* Find the width of the widest item in this pane. */
2199 while (j
< menu_items_used
)
2202 item
= XVECTOR (menu_items
)->contents
[j
];
2210 width
= XSTRING (item
)->size
;
2211 if (width
> maxwidth
)
2214 j
+= MENU_ITEMS_ITEM_LENGTH
;
2217 /* Ignore a nil in the item list.
2218 It's meaningful only for dialog boxes. */
2219 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2223 /* Create a new item within current pane. */
2224 Lisp_Object item_name
, enable
, descrip
;
2225 unsigned char *item_data
;
2227 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2228 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2230 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2231 if (!NILP (descrip
))
2233 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2236 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2237 item_name
= concat2 (item_name
, spacer
);
2238 item_name
= concat2 (item_name
, descrip
);
2239 item_data
= XSTRING (item_name
)->data
;
2241 /* if alloca is fast, use that to make the space,
2242 to reduce gc needs. */
2244 = (unsigned char *) alloca (maxwidth
2245 + XSTRING (descrip
)->size
+ 1);
2246 bcopy (XSTRING (item_name
)->data
, item_data
,
2247 XSTRING (item_name
)->size
);
2248 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2250 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2251 XSTRING (descrip
)->size
);
2252 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2256 item_data
= XSTRING (item_name
)->data
;
2258 if (XMenuAddSelection (XDISPLAY menu
, lpane
, 0, item_data
,
2262 XMenuDestroy (XDISPLAY menu
);
2263 *error
= "Can't add selection to menu";
2266 i
+= MENU_ITEMS_ITEM_LENGTH
;
2270 /* All set and ready to fly. */
2271 XMenuRecompute (XDISPLAY menu
);
2272 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
2273 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
2274 x
= min (x
, dispwidth
);
2275 y
= min (y
, dispheight
);
2278 XMenuLocate (XDISPLAY menu
, 0, 0, x
, y
,
2279 &ulx
, &uly
, &width
, &height
);
2280 if (ulx
+width
> dispwidth
)
2282 x
-= (ulx
+ width
) - dispwidth
;
2283 ulx
= dispwidth
- width
;
2285 if (uly
+height
> dispheight
)
2287 y
-= (uly
+ height
) - dispheight
;
2288 uly
= dispheight
- height
;
2290 if (ulx
< 0) x
-= ulx
;
2291 if (uly
< 0) y
-= uly
;
2293 XMenuSetAEQ (menu
, TRUE
);
2294 XMenuSetFreeze (menu
, TRUE
);
2297 status
= XMenuActivate (XDISPLAY menu
, &pane
, &selidx
,
2298 x
, y
, ButtonReleaseMask
, &datap
);
2303 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2306 /* Find the item number SELIDX in pane number PANE. */
2308 while (i
< menu_items_used
)
2310 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2314 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2316 i
+= MENU_ITEMS_PANE_LENGTH
;
2325 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2328 entry
= Fcons (entry
, Qnil
);
2329 if (!NILP (pane_prefix
))
2330 entry
= Fcons (pane_prefix
, entry
);
2336 i
+= MENU_ITEMS_ITEM_LENGTH
;
2342 *error
= "Can't activate menu";
2348 XMenuDestroy (XDISPLAY menu
);
2350 /* State that no mouse buttons are now held.
2351 (The oldXMenu code doesn't track this info for us.)
2352 That is not necessarily true, but the fiction leads to reasonable
2353 results, and it is a pain to ask which are actually held now. */
2354 x_mouse_grabbed
= 0;
2358 #endif /* not USE_X_TOOLKIT */
2362 staticpro (&menu_items
);
2365 popup_id_tick
= (1<<16);
2366 defsubr (&Sx_popup_menu
);
2367 defsubr (&Sx_popup_dialog
);