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 int string_width ();
97 static Lisp_Object
xdialog_show ();
100 static Lisp_Object
xmenu_show ();
101 static void keymap_panes ();
102 static void single_keymap_panes ();
103 static void list_of_panes ();
104 static void list_of_items ();
106 /* This holds a Lisp vector that holds the results of decoding
107 the keymaps or alist-of-alists that specify a menu.
109 It describes the panes and items within the panes.
111 Each pane is described by 3 elements in the vector:
112 t, the pane name, the pane's prefix key.
113 Then follow the pane's items, with 4 elements per item:
114 the item string, the enable flag, the item's value,
115 and the equivalent keyboard key's description string.
117 In some cases, multiple levels of menus may be described.
118 A single vector slot containing nil indicates the start of a submenu.
119 A single vector slot containing lambda indicates the end of a submenu.
120 The submenu follows a menu item which is the way to reach the submenu.
122 Using a Lisp vector to hold this information while we decode it
123 takes care of protecting all the data from GC. */
125 #define MENU_ITEMS_PANE_NAME 1
126 #define MENU_ITEMS_PANE_PREFIX 2
127 #define MENU_ITEMS_PANE_LENGTH 3
129 #define MENU_ITEMS_ITEM_NAME 0
130 #define MENU_ITEMS_ITEM_ENABLE 1
131 #define MENU_ITEMS_ITEM_VALUE 2
132 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
133 #define MENU_ITEMS_ITEM_LENGTH 4
135 static Lisp_Object menu_items
;
137 /* Number of slots currently allocated in menu_items. */
138 static int menu_items_allocated
;
140 /* This is the index in menu_items of the first empty slot. */
141 static int menu_items_used
;
143 /* The number of panes currently recorded in menu_items,
144 excluding those within submenus. */
145 static int menu_items_n_panes
;
147 /* Current depth within submenus. */
148 static int menu_items_submenu_depth
;
150 /* Initialize the menu_items structure if we haven't already done so.
151 Also mark it as currently empty. */
156 if (NILP (menu_items
))
158 menu_items_allocated
= 60;
159 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
163 menu_items_n_panes
= 0;
164 menu_items_submenu_depth
= 0;
167 /* Call at the end of generating the data in menu_items.
168 This fills in the number of items in the last pane. */
175 /* Call when finished using the data for the current menu
179 discard_menu_items ()
181 /* Free the structure if it is especially large.
182 Otherwise, hold on to it, to save time. */
183 if (menu_items_allocated
> 200)
186 menu_items_allocated
= 0;
190 /* Make the menu_items vector twice as large. */
196 int old_size
= menu_items_allocated
;
199 menu_items_allocated
*= 2;
200 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
201 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
202 old_size
* sizeof (Lisp_Object
));
205 /* Begin a submenu. */
208 push_submenu_start ()
210 if (menu_items_used
+ 1 > menu_items_allocated
)
213 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
214 menu_items_submenu_depth
++;
222 if (menu_items_used
+ 1 > menu_items_allocated
)
225 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
226 menu_items_submenu_depth
--;
229 /* Start a new menu pane in menu_items..
230 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
233 push_menu_pane (name
, prefix_vec
)
234 Lisp_Object name
, prefix_vec
;
236 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
239 if (menu_items_submenu_depth
== 0)
240 menu_items_n_panes
++;
241 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
242 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
243 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
246 /* Push one menu item into the current pane.
247 NAME is the string to display. ENABLE if non-nil means
248 this item can be selected. KEY is the key generated by
249 choosing this item. EQUIV is the textual description
250 of the keyboard equivalent for this item (or nil if none). */
253 push_menu_item (name
, enable
, key
, equiv
)
254 Lisp_Object name
, enable
, key
, equiv
;
256 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
259 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
260 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
261 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
262 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
265 /* Figure out the current keyboard equivalent of a menu item ITEM1.
266 The item string for menu display should be ITEM_STRING.
267 Store the equivalent keyboard key sequence's
268 textual description into *DESCRIP_PTR.
269 Also cache them in the item itself.
270 Return the real definition to execute. */
273 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
274 Lisp_Object item_string
;
276 Lisp_Object
*descrip_ptr
;
278 /* This is the real definition--the function to run. */
280 /* This is the sublist that records cached equiv key data
281 so we can save time. */
282 Lisp_Object cachelist
;
283 /* These are the saved equivalent keyboard key sequence
284 and its key-description. */
285 Lisp_Object savedkey
, descrip
;
289 /* If a help string follows the item string, skip it. */
290 if (CONSP (XCONS (item1
)->cdr
)
291 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
292 item1
= XCONS (item1
)->cdr
;
296 /* Get out the saved equivalent-keyboard-key info. */
297 cachelist
= savedkey
= descrip
= Qnil
;
298 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
299 && (NILP (XCONS (XCONS (def
)->car
)->car
)
300 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
302 cachelist
= XCONS (def
)->car
;
303 def
= XCONS (def
)->cdr
;
304 savedkey
= XCONS (cachelist
)->car
;
305 descrip
= XCONS (cachelist
)->cdr
;
308 /* Is it still valid? */
310 if (!NILP (savedkey
))
311 def1
= Fkey_binding (savedkey
, Qnil
);
312 /* If not, update it. */
314 /* If something had no key binding before, don't recheck it--
315 doing that takes too much time and makes menus too slow. */
316 && !(!NILP (cachelist
) && NILP (savedkey
)))
320 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
321 if (VECTORP (savedkey
)
322 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
324 if (!NILP (savedkey
))
326 descrip
= Fkey_description (savedkey
);
327 descrip
= concat2 (make_string (" (", 3), descrip
);
328 descrip
= concat2 (descrip
, make_string (")", 1));
332 /* Cache the data we just got in a sublist of the menu binding. */
333 if (NILP (cachelist
))
334 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
337 XCONS (cachelist
)->car
= savedkey
;
338 XCONS (cachelist
)->cdr
= descrip
;
341 *descrip_ptr
= descrip
;
345 /* This is used as the handler when calling internal_condition_case_1. */
348 menu_item_enabled_p_1 (arg
)
354 /* Return non-nil if the command DEF is enabled when used as a menu item.
355 This is based on looking for a menu-enable property.
356 If NOTREAL is set, don't bother really computing this. */
359 menu_item_enabled_p (def
, notreal
)
362 Lisp_Object enabled
, tem
;
367 if (XTYPE (def
) == Lisp_Symbol
)
369 /* No property, or nil, means enable.
370 Otherwise, enable if value is not nil. */
371 tem
= Fget (def
, Qmenu_enable
);
373 /* (condition-case nil (eval tem)
375 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
376 menu_item_enabled_p_1
);
381 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
382 and generate menu panes for them in menu_items.
383 If NOTREAL is nonzero,
384 don't bother really computing whether an item is enabled. */
387 keymap_panes (keymaps
, nmaps
, notreal
)
388 Lisp_Object
*keymaps
;
396 /* Loop over the given keymaps, making a pane for each map.
397 But don't make a pane that is empty--ignore that map instead.
398 P is the number of panes we have made so far. */
399 for (mapno
= 0; mapno
< nmaps
; mapno
++)
400 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
402 finish_menu_items ();
405 /* This is a recursive subroutine of keymap_panes.
406 It handles one keymap, KEYMAP.
407 The other arguments are passed along
408 or point to local variables of the previous function.
409 If NOTREAL is nonzero,
410 don't bother really computing whether an item is enabled. */
413 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
415 Lisp_Object pane_name
;
419 Lisp_Object pending_maps
;
420 Lisp_Object tail
, item
, item1
, item_string
, table
;
421 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
425 push_menu_pane (pane_name
, prefix
);
427 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
429 /* Look at each key binding, and if it has a menu string,
430 make a menu item from it. */
431 item
= XCONS (tail
)->car
;
432 if (XTYPE (item
) == Lisp_Cons
)
434 item1
= XCONS (item
)->cdr
;
435 if (XTYPE (item1
) == Lisp_Cons
)
437 item_string
= XCONS (item1
)->car
;
438 if (XTYPE (item_string
) == Lisp_String
)
440 /* This is the real definition--the function to run. */
442 /* These are the saved equivalent keyboard key sequence
443 and its key-description. */
445 Lisp_Object tem
, enabled
;
447 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
449 /* GCPRO because we will call eval.
450 Protecting KEYMAP preserves everything we use;
451 aside from that, must protect whatever might be
452 a string. Since there's no GCPRO5, we refetch
453 item_string instead of protecting it. */
454 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
455 enabled
= menu_item_enabled_p (def
, notreal
);
459 item_string
= XCONS (item1
)->car
;
461 tem
= Fkeymapp (def
);
462 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
463 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
468 submap
= get_keymap_1 (def
, 0, 1);
469 #ifndef USE_X_TOOLKIT
470 /* Indicate visually that this is a submenu. */
472 item_string
= concat2 (item_string
,
473 build_string (" >"));
475 push_menu_item (item_string
, enabled
, XCONS (item
)->car
,
478 /* Display a submenu using the toolkit. */
481 push_submenu_start ();
482 single_keymap_panes (submap
, Qnil
,
483 XCONS (item
)->car
, notreal
);
491 else if (XTYPE (item
) == Lisp_Vector
)
493 /* Loop over the char values represented in the vector. */
494 int len
= XVECTOR (item
)->size
;
496 for (c
= 0; c
< len
; c
++)
498 Lisp_Object character
;
499 XFASTINT (character
) = c
;
500 item1
= XVECTOR (item
)->contents
[c
];
501 if (XTYPE (item1
) == Lisp_Cons
)
503 item_string
= XCONS (item1
)->car
;
504 if (XTYPE (item_string
) == Lisp_String
)
508 /* These are the saved equivalent keyboard key sequence
509 and its key-description. */
511 Lisp_Object tem
, enabled
;
513 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
515 /* GCPRO because we will call eval.
516 Protecting KEYMAP preserves everything we use;
517 aside from that, must protect whatever might be
518 a string. Since there's no GCPRO5, we refetch
519 item_string instead of protecting it. */
520 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
521 enabled
= menu_item_enabled_p (def
, notreal
);
524 item_string
= XCONS (item1
)->car
;
526 tem
= Fkeymapp (def
);
527 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
528 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
533 submap
= get_keymap_1 (def
, 0, 1);
534 #ifndef USE_X_TOOLKIT
536 item_string
= concat2 (item_string
,
537 build_string (" >"));
539 push_menu_item (item_string
, enabled
, character
,
544 push_submenu_start ();
545 single_keymap_panes (submap
, Qnil
,
557 /* Process now any submenus which want to be panes at this level. */
558 while (!NILP (pending_maps
))
560 Lisp_Object elt
, eltcdr
, string
;
561 elt
= Fcar (pending_maps
);
562 eltcdr
= XCONS (elt
)->cdr
;
563 string
= XCONS (eltcdr
)->car
;
564 /* We no longer discard the @ from the beginning of the string here.
565 Instead, we do this in xmenu_show. */
566 single_keymap_panes (Fcar (elt
), string
,
567 XCONS (eltcdr
)->cdr
, notreal
);
568 pending_maps
= Fcdr (pending_maps
);
572 /* Push all the panes and items of a menu decsribed by the
573 alist-of-alists MENU.
574 This handles old-fashioned calls to x-popup-menu. */
584 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
586 Lisp_Object elt
, pane_name
, pane_data
;
588 pane_name
= Fcar (elt
);
589 CHECK_STRING (pane_name
, 0);
590 push_menu_pane (pane_name
, Qnil
);
591 pane_data
= Fcdr (elt
);
592 CHECK_CONS (pane_data
, 0);
593 list_of_items (pane_data
);
596 finish_menu_items ();
599 /* Push the items in a single pane defined by the alist PANE. */
605 Lisp_Object tail
, item
, item1
;
607 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
611 push_menu_item (item
, Qnil
, Qnil
, Qnil
);
614 CHECK_CONS (item
, 0);
616 CHECK_STRING (item1
, 1);
617 push_menu_item (item1
, Qt
, Fcdr (item
), Qnil
);
622 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
623 "Pop up a deck-of-cards menu and return user's selection.\n\
624 POSITION is a position specification. This is either a mouse button event\n\
625 or a list ((XOFFSET YOFFSET) WINDOW)\n\
626 where XOFFSET and YOFFSET are positions in characters from the top left\n\
627 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
628 This controls the position of the center of the first line\n\
629 in the first pane of the menu, not the top left of the menu as a whole.\n\
630 If POSITION is t, it means to use the current mouse position.\n\
632 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
633 The menu items come from key bindings that have a menu string as well as\n\
634 a definition; actually, the \"definition\" in such a key binding looks like\n\
635 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
636 the keymap as a top-level element.\n\n\
637 You can also use a list of keymaps as MENU.\n\
638 Then each keymap makes a separate pane.\n\
639 When MENU is a keymap or a list of keymaps, the return value\n\
640 is a list of events.\n\n\
641 Alternatively, you can specify a menu of multiple panes\n\
642 with a list of the form (TITLE PANE1 PANE2...),\n\
643 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
644 Each ITEM is normally a cons cell (STRING . VALUE);\n\
645 but a string can appear as an item--that makes a nonselectable line\n\
647 With this form of menu, the return value is VALUE from the chosen item.\n\
649 If POSITION is nil, don't display the menu at all, just precalculate the\n\
650 cached information about equivalent key sequences.")
652 Lisp_Object position
, menu
;
654 int number_of_panes
, panes
;
655 Lisp_Object keymap
, tem
;
659 Lisp_Object selection
;
662 Lisp_Object x
, y
, window
;
667 if (! NILP (position
))
671 /* Decode the first argument: find the window and the coordinates. */
672 if (EQ (position
, Qt
))
674 /* Use the mouse's current position. */
676 Lisp_Object bar_window
;
681 XSET (window
, Lisp_Frame
, new_f
);
684 window
= selected_window
;
691 tem
= Fcar (position
);
692 if (XTYPE (tem
) == Lisp_Cons
)
694 window
= Fcar (Fcdr (position
));
696 y
= Fcar (Fcdr (tem
));
700 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
701 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
702 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
706 /* Determine whether this menu is handling a menu bar click. */
707 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
708 if (XTYPE (Fcar (position
)) != Lisp_Cons
710 && EQ (Fcar (tem
), Qmenu_bar
))
718 /* Decode where to put the menu. */
720 if (XTYPE (window
) == Lisp_Frame
)
727 else if (XTYPE (window
) == Lisp_Window
)
729 CHECK_LIVE_WINDOW (window
, 0);
730 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
732 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
733 ypos
= (FONT_HEIGHT (f
->display
.x
->font
) * XWINDOW (window
)->top
);
736 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
737 but I don't want to make one now. */
738 CHECK_WINDOW (window
, 0);
747 /* Decode the menu items from what was specified. */
749 keymap
= Fkeymapp (menu
);
751 if (XTYPE (menu
) == Lisp_Cons
)
752 tem
= Fkeymapp (Fcar (menu
));
755 /* We were given a keymap. Extract menu info from the keymap. */
757 keymap
= get_keymap (menu
);
759 /* Extract the detailed info to make one pane. */
760 keymap_panes (&menu
, 1, NILP (position
));
762 /* Search for a string appearing directly as an element of the keymap.
763 That string is the title of the menu. */
764 prompt
= map_prompt (keymap
);
766 /* Make that be the pane title of the first pane. */
767 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
768 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
772 else if (!NILP (tem
))
774 /* We were given a list of keymaps. */
775 int nmaps
= XFASTINT (Flength (menu
));
777 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
782 /* The first keymap that has a prompt string
783 supplies the menu title. */
784 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
788 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
790 prompt
= map_prompt (keymap
);
791 if (NILP (title
) && !NILP (prompt
))
795 /* Extract the detailed info to make one pane. */
796 keymap_panes (maps
, nmaps
, NILP (position
));
798 /* Make the title be the pane title of the first pane. */
799 if (!NILP (title
) && menu_items_n_panes
>= 0)
800 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
806 /* We were given an old-fashioned menu. */
808 CHECK_STRING (title
, 1);
810 list_of_panes (Fcdr (menu
));
817 discard_menu_items ();
822 /* Display them in a menu. */
825 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
,
826 keymaps
, title
, &error_name
);
829 discard_menu_items ();
833 if (error_name
) error (error_name
);
837 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
838 "Pop up a dialog box and return user's selection.\n\
839 POSITION specifies which frame to use.\n\
840 This is normally a mouse button event or a window or frame.\n\
841 If POSITION is t, it means to use the frame the mouse is on.\n\
842 The dialog box appears in the middle of the specified frame.\n\
844 CONTENTS specifies the alternatives to display in the dialog box.\n\
845 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
846 Each ITEM is a cons cell (STRING . VALUE).\n\
847 The return value is VALUE from the chosen item.")
849 Lisp_Object position
, contents
;
856 /* Decode the first argument: find the window or frame to use. */
857 if (EQ (position
, Qt
))
859 /* Use the mouse's current position. */
861 Lisp_Object bar_window
;
866 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
869 XSET (window
, Lisp_Frame
, new_f
);
871 window
= selected_window
;
873 else if (CONSP (position
))
876 tem
= Fcar (position
);
877 if (XTYPE (tem
) == Lisp_Cons
)
878 window
= Fcar (Fcdr (position
));
881 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
882 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
885 else if (WINDOWP (position
) || FRAMEP (position
))
888 /* Decode where to put the menu. */
890 if (XTYPE (window
) == Lisp_Frame
)
892 else if (XTYPE (window
) == Lisp_Window
)
894 CHECK_LIVE_WINDOW (window
, 0);
895 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
898 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
899 but I don't want to make one now. */
900 CHECK_WINDOW (window
, 0);
902 #ifndef USE_X_TOOLKIT
903 /* Display a menu with these alternatives
904 in the middle of frame F. */
906 Lisp_Object x
, y
, frame
, newpos
;
907 XSET (frame
, Lisp_Frame
, f
);
908 XSET (x
, Lisp_Int
, x_pixel_width (f
) / 2);
909 XSET (y
, Lisp_Int
, x_pixel_height (f
) / 2);
910 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
912 return Fx_popup_menu (newpos
,
913 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
919 Lisp_Object selection
;
921 /* Decode the dialog items from what was specified. */
922 title
= Fcar (contents
);
923 CHECK_STRING (title
, 1);
925 list_of_panes (Fcons (contents
, Qnil
));
927 /* Display them in a dialog box. */
929 selection
= xdialog_show (f
, 0, 0, title
, &error_name
);
932 discard_menu_items ();
934 if (error_name
) error (error_name
);
943 dispatch_dummy_expose (w
, x
, y
)
951 dummy
.window
= XtWindow (w
);
954 dummy
.send_event
= 0;
955 dummy
.display
= XtDisplay (w
);
959 XtDispatchEvent (&dummy
);
970 XTextExtents (mw
->menu
.font
, s
, strlen (s
), &drop
, &drop
, &drop
, &xcs
);
975 event_is_in_menu_item (mw
, event
, name
, string_w
)
977 struct input_event
*event
;
981 *string_w
+= (string_width (mw
, name
)
982 + 2 * (mw
->menu
.horizontal_spacing
983 + mw
->menu
.shadow_thickness
));
984 return XINT (event
->x
) < *string_w
;
988 /* Return the menu bar key which corresponds to event EVENT in frame F. */
991 map_event_to_object (event
, f
)
992 struct input_event
*event
;
997 XlwMenuWidget mw
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1002 /* Find the window */
1003 for (val
= mw
->menu
.old_stack
[0]->contents
; val
; val
= val
->next
)
1005 ws
= &mw
->menu
.windows
[0];
1006 if (ws
&& event_is_in_menu_item (mw
, event
, val
->name
, &string_w
))
1011 items
= FRAME_MENU_BAR_ITEMS (f
);
1013 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1015 Lisp_Object pos
, string
, item
;
1016 item
= XVECTOR (items
)->contents
[i
];
1017 string
= XVECTOR (items
)->contents
[i
+ 1];
1018 pos
= XVECTOR (items
)->contents
[i
+ 2];
1022 if (!strcmp (val
->name
, XSTRING (string
)->data
))
1030 static Lisp_Object
*menu_item_selection
;
1033 popup_selection_callback (widget
, id
, client_data
)
1036 XtPointer client_data
;
1038 menu_item_selection
= (Lisp_Object
*) client_data
;
1042 popup_down_callback (widget
, id
, client_data
)
1045 XtPointer client_data
;
1048 lw_destroy_all_widgets (id
);
1053 dialog_selection_callback (widget
, id
, client_data
)
1056 XtPointer client_data
;
1058 if ((int)client_data
!= -1)
1059 menu_item_selection
= (Lisp_Object
*) client_data
;
1061 lw_destroy_all_widgets (id
);
1065 /* This recursively calls free_widget_value() on the tree of widgets.
1066 It must free all data that was malloc'ed for these widget_values.
1067 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1068 must be left alone. */
1071 free_menubar_widget_value_tree (wv
)
1076 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1078 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1080 free_menubar_widget_value_tree (wv
->contents
);
1081 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1085 free_menubar_widget_value_tree (wv
->next
);
1086 wv
->next
= (widget_value
*) 0xDEADBEEF;
1089 free_widget_value (wv
);
1093 extern void EmacsFrameSetCharSize ();
1096 update_frame_menubar (f
)
1099 struct x_display
*x
= f
->display
.x
;
1101 int menubar_changed
;
1103 menubar_changed
= (x
->menubar_widget
1104 && !XtIsManaged (x
->menubar_widget
));
1106 if (! (menubar_changed
))
1110 /* Save the size of the frame because the pane widget doesn't accept to
1111 resize itself. So force it. */
1116 XawPanedSetRefigureMode (x
->column_widget
, 0);
1118 /* the order in which children are managed is the top to
1119 bottom order in which they are displayed in the paned window.
1120 First, remove the text-area widget.
1122 XtUnmanageChild (x
->edit_widget
);
1124 /* remove the menubar that is there now, and put up the menubar that
1127 if (menubar_changed
)
1129 XtManageChild (x
->menubar_widget
);
1130 XtMapWidget (x
->menubar_widget
);
1131 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1135 /* Re-manage the text-area widget */
1136 XtManageChild (x
->edit_widget
);
1138 /* and now thrash the sizes */
1139 XawPanedSetRefigureMode (x
->column_widget
, 1);
1141 /* Force the pane widget to resize itself with the right values. */
1142 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1148 set_frame_menubar (f
, first_time
)
1152 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1154 Lisp_Object tail
, items
;
1155 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
1160 wv
= malloc_widget_value ();
1161 wv
->name
= "menubar";
1164 save_wv
= first_wv
= wv
;
1166 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1167 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1169 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1173 string
= XVECTOR (items
)->contents
[i
+ 1];
1177 wv
= malloc_widget_value ();
1181 save_wv
->contents
= wv
;
1182 wv
->name
= XSTRING (string
)->data
;
1189 lw_modify_all_widgets (id
, first_wv
, False
);
1192 menubar_widget
= lw_create_widget ("menubar", "menubar",
1194 f
->display
.x
->column_widget
,
1197 f
->display
.x
->menubar_widget
= menubar_widget
;
1198 XtVaSetValues (menubar_widget
,
1200 XtNresizeToPreferred
, 1,
1205 free_menubar_widget_value_tree (first_wv
);
1207 /* Don't update the menubar the first time it is created via x_window. */
1209 update_frame_menubar (f
);
1215 free_frame_menubar (f
)
1218 Widget menubar_widget
;
1221 menubar_widget
= f
->display
.x
->menubar_widget
;
1227 lw_destroy_all_widgets (id
);
1231 /* Called from Fx_create_frame to create the inital menubar of a frame
1232 before it is mapped, so that the window is mapped with the menubar already
1233 there instead of us tacking it on later and thrashing the window after it
1236 initialize_frame_menubar (f
)
1239 set_frame_menubar (f
, 1);
1242 /* Nonzero if position X, Y relative to inside of frame F
1243 is in some other menu bar item. */
1245 static int this_menu_bar_item_beg
;
1246 static int this_menu_bar_item_end
;
1249 other_menu_bar_item_p (f
, x
, y
)
1254 && y
< f
->display
.x
->menubar_widget
->core
.height
1256 && x
< f
->display
.x
->menubar_widget
->core
.width
1257 && (x
>= this_menu_bar_item_end
1258 || x
< this_menu_bar_item_beg
));
1261 /* Unread a button-press event in the menu bar of frame F
1262 at x position XPOS relative to the inside of the frame. */
1265 unread_menu_bar_button (f
, xpos
)
1271 event
.type
= ButtonPress
;
1272 event
.xbutton
.display
= x_current_display
;
1273 event
.xbutton
.serial
= 0;
1274 event
.xbutton
.send_event
= 0;
1275 event
.xbutton
.time
= CurrentTime
;
1276 event
.xbutton
.button
= Button1
;
1277 event
.xbutton
.window
= XtWindow (f
->display
.x
->menubar_widget
);
1278 event
.xbutton
.x
= xpos
;
1279 XPutBackEvent (XDISPLAY
&event
);
1282 /* If the mouse has moved to another menu bar item,
1283 return 1 and unread a button press event for that item.
1284 Otherwise return 0. */
1287 check_mouse_other_menu_bar (f
)
1291 Lisp_Object bar_window
;
1296 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1298 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1300 unread_menu_bar_button (f
, x
);
1306 #endif /* USE_X_TOOLKIT */
1308 /* xmenu_show actually displays a menu using the panes and items in menu_items
1309 and returns the value selected from it.
1310 There are two versions of xmenu_show, one for Xt and one for Xlib.
1311 Both assume input is blocked by the caller. */
1313 /* F is the frame the menu is for.
1314 X and Y are the frame-relative specified position,
1315 relative to the inside upper left corner of the frame F.
1316 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1317 KEYMAPS is 1 if this menu was specified with keymaps;
1318 in that case, we return a list containing the chosen item's value
1319 and perhaps also the pane's prefix.
1320 TITLE is the specified menu title.
1321 ERROR is a place to store an error message string in case of failure.
1322 (We return nil on failure, but the value doesn't actually matter.) */
1324 #ifdef USE_X_TOOLKIT
1326 extern unsigned int x_mouse_grabbed
;
1327 extern Lisp_Object Vmouse_depressed
;
1330 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1342 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1344 /* This is the menu bar item (if any) that led to this menu. */
1345 widget_value
*menubar_item
= 0;
1347 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1348 widget_value
**submenu_stack
1349 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1350 Lisp_Object
*subprefix_stack
1351 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1352 int submenu_depth
= 0;
1354 /* Define a queue to save up for later unreading
1355 all X events that don't pertain to the menu. */
1359 struct event_queue
*next
;
1362 struct event_queue
*queue
= NULL
;
1363 struct event_queue
*queue_tmp
;
1367 this_menu_bar_item_beg
= -1;
1368 this_menu_bar_item_end
= -1;
1370 /* Figure out which menu bar item, if any, this menu is for. */
1376 for (menubar_item
= menubar
->menu
.old_stack
[0]->contents
;
1378 menubar_item
= menubar_item
->next
)
1381 xend
+= (string_width (menubar
, menubar_item
->name
)
1382 + 2 * (menubar
->menu
.horizontal_spacing
1383 + menubar
->menu
.shadow_thickness
));
1388 /* Arrange to show a different menu if we move in the menu bar
1389 to a different item. */
1390 this_menu_bar_item_beg
= xbeg
;
1391 this_menu_bar_item_end
= xend
;
1396 if (menubar_item
== 0)
1399 /* Offset the coordinates to root-relative. */
1400 x
+= (f
->display
.x
->widget
->core
.x
1401 + f
->display
.x
->widget
->core
.border_width
);
1402 y
+= (f
->display
.x
->widget
->core
.y
1403 + f
->display
.x
->widget
->core
.border_width
1404 + f
->display
.x
->menubar_widget
->core
.height
);
1406 /* Create a tree of widget_value objects
1407 representing the panes and their items. */
1408 wv
= malloc_widget_value ();
1414 /* Loop over all panes and items, filling in the tree. */
1416 while (i
< menu_items_used
)
1418 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1420 submenu_stack
[submenu_depth
++] = save_wv
;
1425 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1428 save_wv
= submenu_stack
[--submenu_depth
];
1431 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1432 && submenu_depth
!= 0)
1433 i
+= MENU_ITEMS_PANE_LENGTH
;
1434 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1436 /* Create a new pane. */
1437 Lisp_Object pane_name
, prefix
;
1439 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1440 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1441 pane_string
= (NILP (pane_name
)
1442 ? "" : (char *) XSTRING (pane_name
)->data
);
1443 /* If there is just one top-level pane, put all its items directly
1444 under the top-level menu. */
1445 if (menu_items_n_panes
== 1)
1448 /* If the pane has a meaningful name,
1449 make the pane a top-level menu item
1450 with its items as a submenu beneath it. */
1451 if (strcmp (pane_string
, ""))
1453 wv
= malloc_widget_value ();
1457 first_wv
->contents
= wv
;
1458 wv
->name
= pane_string
;
1459 if (keymaps
&& !NILP (prefix
))
1466 i
+= MENU_ITEMS_PANE_LENGTH
;
1470 /* Create a new item within current pane. */
1471 Lisp_Object item_name
, enable
, descrip
;
1472 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1473 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1475 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1477 wv
= malloc_widget_value ();
1481 save_wv
->contents
= wv
;
1482 wv
->name
= XSTRING (item_name
)->data
;
1483 if (!NILP (descrip
))
1484 wv
->key
= XSTRING (descrip
)->data
;
1486 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1487 wv
->enabled
= !NILP (enable
);
1490 i
+= MENU_ITEMS_ITEM_LENGTH
;
1494 /* Actually create the menu. */
1495 menu_id
= ++popup_id_tick
;
1496 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1497 f
->display
.x
->widget
, 1, 0,
1498 popup_selection_callback
, popup_down_callback
);
1499 /* Free the widget_value objects we used to specify the contents. */
1500 free_menubar_widget_value_tree (first_wv
);
1502 /* No selection has been chosen yet. */
1503 menu_item_selection
= 0;
1505 /* If the mouse moves out of the menu before we show the menu,
1506 don't show it at all. */
1507 if (check_mouse_other_menu_bar (f
))
1509 lw_destroy_all_widgets (menu_id
);
1514 /* Highlight the menu bar item (if any) that led to this menu. */
1517 menubar_item
->call_data
= (XtPointer
) 1;
1518 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1521 /* Display the menu. */
1523 XButtonPressedEvent dummy
;
1526 mw
= (XlwMenuWidget
) ((CompositeWidget
)menu
)->composite
.children
[0];
1528 dummy
.type
= ButtonPress
;
1530 dummy
.send_event
= 0;
1531 dummy
.display
= XtDisplay (menu
);
1532 dummy
.window
= XtWindow (XtParent (menu
));
1533 dummy
.time
= CurrentTime
;
1538 /* We activate directly the lucid implementation. */
1539 pop_up_menu (mw
, &dummy
);
1542 /* No need to check a second time since this is done in the XEvent loop.
1543 This slows done the execution. */
1545 /* Check again whether the mouse has moved to another menu bar item. */
1546 if (check_mouse_other_menu_bar (f
))
1548 /* The mouse moved into a different menu bar item.
1549 We should bring up that item's menu instead.
1550 First pop down this menu. */
1551 XtUngrabPointer ((Widget
)
1553 ((CompositeWidget
)menu
)->composite
.children
[0]),
1555 lw_destroy_all_widgets (menu_id
);
1560 /* Process events that apply to the menu. */
1565 XtAppNextEvent (Xt_app_con
, &event
);
1566 if (event
.type
== ButtonRelease
)
1568 XtDispatchEvent (&event
);
1571 /* Do the work of construct_mouse_click since it can't
1572 be called. Initially, the popup menu has been called
1573 from a ButtonPress in the edit_widget. Then the mouse
1574 has been set to grabbed. Reset it now. */
1575 x_mouse_grabbed
&= ~(1 << event
.xbutton
.button
);
1576 if (!x_mouse_grabbed
)
1577 Vmouse_depressed
= Qnil
;
1581 else if (event
.type
== Expose
)
1582 process_expose_from_menu (event
);
1583 else if (event
.type
== MotionNotify
)
1585 int event_x
= (event
.xmotion
.x_root
1586 - (f
->display
.x
->widget
->core
.x
1587 + f
->display
.x
->widget
->core
.border_width
));
1588 int event_y
= (event
.xmotion
.y_root
1589 - (f
->display
.x
->widget
->core
.y
1590 + f
->display
.x
->widget
->core
.border_width
));
1592 if (other_menu_bar_item_p (f
, event_x
, event_y
))
1594 /* The mouse moved into a different menu bar item.
1595 We should bring up that item's menu instead.
1596 First pop down this menu. */
1597 XtUngrabPointer ((Widget
)
1599 ((CompositeWidget
)menu
)->composite
.children
[0]),
1600 event
.xbutton
.time
);
1601 lw_destroy_all_widgets (menu_id
);
1603 /* Put back an event that will bring up the other item's menu. */
1604 unread_menu_bar_button (f
, event_x
);
1605 /* Don't let us select anything in this case. */
1606 menu_item_selection
= 0;
1611 XtDispatchEvent (&event
);
1612 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1615 = (struct event_queue
*) malloc (sizeof (struct event_queue
));
1617 if (queue_tmp
!= NULL
)
1619 queue_tmp
->event
= event
;
1620 queue_tmp
->next
= queue
;
1627 /* Unhighlight the menu bar item (if any) that led to this menu. */
1630 menubar_item
->call_data
= (XtPointer
) 0;
1631 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1634 #if 0 /* No need to do that. The menu has disappeared. */
1635 /* Make sure the menu disappears. */
1636 lw_destroy_all_widgets (menu_id
);
1639 /* Unread any events that we got but did not handle. */
1640 while (queue
!= NULL
)
1643 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1644 queue
= queue_tmp
->next
;
1645 free ((char *)queue_tmp
);
1648 /* Find the selected item, and its pane, to return
1649 the proper value. */
1650 if (menu_item_selection
!= 0)
1656 while (i
< menu_items_used
)
1660 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1662 subprefix_stack
[submenu_depth
++] = prefix
;
1666 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1668 prefix
= subprefix_stack
[--submenu_depth
];
1671 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1674 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1675 i
+= MENU_ITEMS_PANE_LENGTH
;
1680 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1681 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1687 entry
= Fcons (entry
, Qnil
);
1689 entry
= Fcons (prefix
, entry
);
1690 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1691 entry
= Fcons (subprefix_stack
[j
], entry
);
1695 i
+= MENU_ITEMS_ITEM_LENGTH
;
1703 static char * button_names
[] = {
1704 "button1", "button2", "button3", "button4", "button5",
1705 "button6", "button7", "button8", "button9", "button10" };
1708 xdialog_show (f
, menubarp
, keymaps
, title
, error
)
1715 int i
, nb_buttons
=0;
1718 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1719 char dialog_name
[6];
1721 /* This is the menu bar item (if any) that led to this menu. */
1722 widget_value
*menubar_item
= 0;
1724 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1726 /* Define a queue to save up for later unreading
1727 all X events that don't pertain to the menu. */
1731 struct event_queue
*next
;
1734 struct event_queue
*queue
= NULL
;
1735 struct event_queue
*queue_tmp
;
1739 if (menu_items_n_panes
> 1)
1741 *error
= "Multiple panes in dialog box";
1745 /* Create a tree of widget_value objects
1746 representing the text label and buttons. */
1748 Lisp_Object pane_name
, prefix
;
1750 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1751 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1752 pane_string
= (NILP (pane_name
)
1753 ? "" : (char *) XSTRING (pane_name
)->data
);
1754 prev_wv
= malloc_widget_value ();
1755 prev_wv
->value
= pane_string
;
1756 if (keymaps
&& !NILP (prefix
))
1758 prev_wv
->enabled
= 1;
1759 prev_wv
->name
= "message";
1762 /* Loop over all panes and items, filling in the tree. */
1763 i
= MENU_ITEMS_PANE_LENGTH
;
1764 while (i
< menu_items_used
)
1767 /* Create a new item within current pane. */
1768 Lisp_Object item_name
, enable
, descrip
;
1769 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1770 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1772 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1774 if (NILP (item_name
))
1776 free_menubar_widget_value_tree (first_wv
);
1777 *error
= "Submenu in dialog items";
1780 if (nb_buttons
>= 10)
1782 free_menubar_widget_value_tree (first_wv
);
1783 *error
= "Too many dialog items";
1787 wv
= malloc_widget_value ();
1789 wv
->name
= (char *) button_names
[nb_buttons
];
1790 if (!NILP (descrip
))
1791 wv
->key
= XSTRING (descrip
)->data
;
1792 wv
->value
= XSTRING (item_name
)->data
;
1793 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1794 wv
->enabled
= !NILP (enable
);
1798 i
+= MENU_ITEMS_ITEM_LENGTH
;
1801 wv
= malloc_widget_value ();
1802 wv
->name
= dialog_name
;
1804 /* Dialog boxes use a really stupid name encoding
1805 which specifies how many buttons to use
1806 and how many buttons are on the right.
1807 The Q means something also. */
1808 dialog_name
[0] = 'Q';
1809 dialog_name
[1] = '0' + nb_buttons
;
1810 dialog_name
[2] = 'B';
1811 dialog_name
[3] = 'R';
1812 dialog_name
[4] = '0' + nb_buttons
/ 2;
1814 wv
->contents
= first_wv
;
1819 /* Actually create the dialog. */
1820 dialog_id
= ++popup_id_tick
;
1821 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1822 f
->display
.x
->widget
, 1, 0,
1823 dialog_selection_callback
, 0);
1824 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1825 lw_modify_all_widgets (dialog_id
, first_wv
, True
);
1827 lw_modify_all_widgets (dialog_id
, first_wv
->contents
->next
, True
);
1828 /* Free the widget_value objects we used to specify the contents. */
1829 free_menubar_widget_value_tree (first_wv
);
1831 /* No selection has been chosen yet. */
1832 menu_item_selection
= 0;
1834 /* Display the menu. */
1835 lw_pop_up_all_widgets (dialog_id
);
1837 /* Process events that apply to the menu. */
1842 XtAppNextEvent (Xt_app_con
, &event
);
1843 if (event
.type
== ButtonRelease
)
1845 XtDispatchEvent (&event
);
1848 else if (event
.type
== Expose
)
1849 process_expose_from_menu (event
);
1850 XtDispatchEvent (&event
);
1851 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1853 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1855 if (queue_tmp
!= NULL
)
1857 queue_tmp
->event
= event
;
1858 queue_tmp
->next
= queue
;
1865 /* Unread any events that we got but did not handle. */
1866 while (queue
!= NULL
)
1869 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1870 queue
= queue_tmp
->next
;
1871 free ((char *)queue_tmp
);
1874 /* Find the selected item, and its pane, to return
1875 the proper value. */
1876 if (menu_item_selection
!= 0)
1882 while (i
< menu_items_used
)
1886 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1889 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1890 i
+= MENU_ITEMS_PANE_LENGTH
;
1895 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1896 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1900 entry
= Fcons (entry
, Qnil
);
1902 entry
= Fcons (prefix
, entry
);
1906 i
+= MENU_ITEMS_ITEM_LENGTH
;
1913 #else /* not USE_X_TOOLKIT */
1916 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1926 int pane
, selidx
, lpane
, status
;
1927 Lisp_Object entry
, pane_prefix
;
1929 int ulx
, uly
, width
, height
;
1930 int dispwidth
, dispheight
;
1933 unsigned int dummy_uint
;
1936 if (menu_items_n_panes
== 0)
1939 /* Figure out which root window F is on. */
1940 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
1941 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
1942 &dummy_uint
, &dummy_uint
);
1944 /* Make the menu on that window. */
1945 menu
= XMenuCreate (XDISPLAY root
, "emacs");
1948 *error
= "Can't create menu";
1952 /* Adjust coordinates to relative to the outer (window manager) window. */
1956 int win_x
= 0, win_y
= 0;
1958 /* Find the position of the outside upper-left corner of
1959 the inner window, with respect to the outer window. */
1960 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
1963 XTranslateCoordinates (x_current_display
,
1965 /* From-window, to-window. */
1966 f
->display
.x
->window_desc
,
1967 f
->display
.x
->parent_desc
,
1969 /* From-position, to-position. */
1970 0, 0, &win_x
, &win_y
,
1972 /* Child of window. */
1979 #endif /* HAVE_X11 */
1981 /* Adjust coordinates to be root-window-relative. */
1982 x
+= f
->display
.x
->left_pos
;
1983 y
+= f
->display
.x
->top_pos
;
1985 /* Create all the necessary panes and their items. */
1987 while (i
< menu_items_used
)
1989 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1991 /* Create a new pane. */
1992 Lisp_Object pane_name
, prefix
;
1995 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1996 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1997 pane_string
= (NILP (pane_name
)
1998 ? "" : (char *) XSTRING (pane_name
)->data
);
1999 if (keymaps
&& !NILP (prefix
))
2002 lpane
= XMenuAddPane (XDISPLAY menu
, pane_string
, TRUE
);
2003 if (lpane
== XM_FAILURE
)
2005 XMenuDestroy (XDISPLAY menu
);
2006 *error
= "Can't create pane";
2009 i
+= MENU_ITEMS_PANE_LENGTH
;
2013 /* Create a new item within current pane. */
2014 Lisp_Object item_name
, enable
, descrip
;
2016 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2017 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2019 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2020 if (!NILP (descrip
))
2021 item_name
= concat2 (item_name
, descrip
);
2023 if (XMenuAddSelection (XDISPLAY menu
, lpane
, 0,
2024 XSTRING (item_name
)->data
,
2028 XMenuDestroy (XDISPLAY menu
);
2029 *error
= "Can't add selection to menu";
2032 i
+= MENU_ITEMS_ITEM_LENGTH
;
2036 /* All set and ready to fly. */
2037 XMenuRecompute (XDISPLAY menu
);
2038 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
2039 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
2040 x
= min (x
, dispwidth
);
2041 y
= min (y
, dispheight
);
2044 XMenuLocate (XDISPLAY menu
, 0, 0, x
, y
,
2045 &ulx
, &uly
, &width
, &height
);
2046 if (ulx
+width
> dispwidth
)
2048 x
-= (ulx
+ width
) - dispwidth
;
2049 ulx
= dispwidth
- width
;
2051 if (uly
+height
> dispheight
)
2053 y
-= (uly
+ height
) - dispheight
;
2054 uly
= dispheight
- height
;
2056 if (ulx
< 0) x
-= ulx
;
2057 if (uly
< 0) y
-= uly
;
2059 XMenuSetAEQ (menu
, TRUE
);
2060 XMenuSetFreeze (menu
, TRUE
);
2063 status
= XMenuActivate (XDISPLAY menu
, &pane
, &selidx
,
2064 x
, y
, ButtonReleaseMask
, &datap
);
2069 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2072 /* Find the item number SELIDX in pane number PANE. */
2074 while (i
< menu_items_used
)
2076 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2080 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2082 i
+= MENU_ITEMS_PANE_LENGTH
;
2091 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2094 entry
= Fcons (entry
, Qnil
);
2095 if (!NILP (pane_prefix
))
2096 entry
= Fcons (pane_prefix
, entry
);
2102 i
+= MENU_ITEMS_ITEM_LENGTH
;
2108 XMenuDestroy (XDISPLAY menu
);
2109 *error
= "Can't activate menu";
2115 XMenuDestroy (XDISPLAY menu
);
2118 #endif /* not USE_X_TOOLKIT */
2122 staticpro (&menu_items
);
2125 popup_id_tick
= (1<<16);
2126 defsubr (&Sx_popup_menu
);
2127 defsubr (&Sx_popup_dialog
);