1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* X pop-up deck-of-cards menu facility for gnuemacs.
22 * Written by Jon Arnold and Roman Budzianowski
23 * Mods and rewrite by Robert Krawitz
27 /* Modified by Fred Pierresteguy on December 93
28 to make the popup menus and menubar use the Xt. */
30 /* Rewritten for clarity and GC protection by rms in Feb 94. */
34 /* On 4.3 this loses if it comes after xterm.h. */
38 #include "termhooks.h"
42 #include "blockinput.h"
44 /* This may include sys/types.h, and that somehow loses
45 if this is not done before the other system files. */
48 /* Load sys/types.h if not already loaded.
49 In some systems loading it twice is suicidal. */
51 #include <sys/types.h>
54 #include "dispextern.h"
57 #include "../oldXMenu/XMenu.h"
64 #include <X11/IntrinsicP.h>
65 #include <X11/CoreP.h>
66 #include <X11/StringDefs.h>
67 #include <X11/Xaw/Paned.h>
68 #include "../lwlib/lwlib.h"
69 #include "../lwlib/xlwmenuP.h"
70 #endif /* USE_X_TOOLKIT */
72 #define min(x,y) (((x) < (y)) ? (x) : (y))
73 #define max(x,y) (((x) > (y)) ? (x) : (y))
81 extern Display
*x_current_display
;
83 #define ButtonReleaseMask ButtonReleased
84 #endif /* not HAVE_X11 */
86 /* We need a unique id for each popup menu and dialog box. */
87 static unsigned int popup_id_tick
;
89 extern Lisp_Object Qmenu_enable
;
90 extern Lisp_Object Qmenu_bar
;
93 extern void process_expose_from_menu ();
94 extern XtAppContext Xt_app_con
;
96 static Lisp_Object
xdialog_show ();
99 static Lisp_Object
xmenu_show ();
100 static void keymap_panes ();
101 static void single_keymap_panes ();
102 static void list_of_panes ();
103 static void list_of_items ();
105 /* This holds a Lisp vector that holds the results of decoding
106 the keymaps or alist-of-alists that specify a menu.
108 It describes the panes and items within the panes.
110 Each pane is described by 3 elements in the vector:
111 t, the pane name, the pane's prefix key.
112 Then follow the pane's items, with 4 elements per item:
113 the item string, the enable flag, the item's value,
114 and the equivalent keyboard key's description string.
116 In some cases, multiple levels of menus may be described.
117 A single vector slot containing nil indicates the start of a submenu.
118 A single vector slot containing lambda indicates the end of a submenu.
119 The submenu follows a menu item which is the way to reach the submenu.
121 A single vector slot containing quote indicates that the
122 following items should appear on the right of a dialog box.
124 Using a Lisp vector to hold this information while we decode it
125 takes care of protecting all the data from GC. */
127 #define MENU_ITEMS_PANE_NAME 1
128 #define MENU_ITEMS_PANE_PREFIX 2
129 #define MENU_ITEMS_PANE_LENGTH 3
131 #define MENU_ITEMS_ITEM_NAME 0
132 #define MENU_ITEMS_ITEM_ENABLE 1
133 #define MENU_ITEMS_ITEM_VALUE 2
134 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
135 #define MENU_ITEMS_ITEM_LENGTH 4
137 static Lisp_Object menu_items
;
139 /* Number of slots currently allocated in menu_items. */
140 static int menu_items_allocated
;
142 /* This is the index in menu_items of the first empty slot. */
143 static int menu_items_used
;
145 /* The number of panes currently recorded in menu_items,
146 excluding those within submenus. */
147 static int menu_items_n_panes
;
149 /* Current depth within submenus. */
150 static int menu_items_submenu_depth
;
152 /* Initialize the menu_items structure if we haven't already done so.
153 Also mark it as currently empty. */
158 if (NILP (menu_items
))
160 menu_items_allocated
= 60;
161 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
165 menu_items_n_panes
= 0;
166 menu_items_submenu_depth
= 0;
169 /* Call at the end of generating the data in menu_items.
170 This fills in the number of items in the last pane. */
177 /* Call when finished using the data for the current menu
181 discard_menu_items ()
183 /* Free the structure if it is especially large.
184 Otherwise, hold on to it, to save time. */
185 if (menu_items_allocated
> 200)
188 menu_items_allocated
= 0;
192 /* Make the menu_items vector twice as large. */
198 int old_size
= menu_items_allocated
;
201 menu_items_allocated
*= 2;
202 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
203 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
204 old_size
* sizeof (Lisp_Object
));
207 /* Begin a submenu. */
210 push_submenu_start ()
212 if (menu_items_used
+ 1 > menu_items_allocated
)
215 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
216 menu_items_submenu_depth
++;
224 if (menu_items_used
+ 1 > menu_items_allocated
)
227 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
228 menu_items_submenu_depth
--;
231 /* Indicate boundary between left and right. */
234 push_left_right_boundary ()
236 if (menu_items_used
+ 1 > menu_items_allocated
)
239 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
242 /* Start a new menu pane in menu_items..
243 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
246 push_menu_pane (name
, prefix_vec
)
247 Lisp_Object name
, prefix_vec
;
249 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
252 if (menu_items_submenu_depth
== 0)
253 menu_items_n_panes
++;
254 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
255 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
256 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
259 /* Push one menu item into the current pane.
260 NAME is the string to display. ENABLE if non-nil means
261 this item can be selected. KEY is the key generated by
262 choosing this item. EQUIV is the textual description
263 of the keyboard equivalent for this item (or nil if none). */
266 push_menu_item (name
, enable
, key
, equiv
)
267 Lisp_Object name
, enable
, key
, equiv
;
269 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
272 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
273 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
274 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
275 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
278 /* Figure out the current keyboard equivalent of a menu item ITEM1.
279 The item string for menu display should be ITEM_STRING.
280 Store the equivalent keyboard key sequence's
281 textual description into *DESCRIP_PTR.
282 Also cache them in the item itself.
283 Return the real definition to execute. */
286 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
287 Lisp_Object item_string
;
289 Lisp_Object
*descrip_ptr
;
291 /* This is the real definition--the function to run. */
293 /* This is the sublist that records cached equiv key data
294 so we can save time. */
295 Lisp_Object cachelist
;
296 /* These are the saved equivalent keyboard key sequence
297 and its key-description. */
298 Lisp_Object savedkey
, descrip
;
302 /* If a help string follows the item string, skip it. */
303 if (CONSP (XCONS (item1
)->cdr
)
304 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
305 item1
= XCONS (item1
)->cdr
;
309 /* Get out the saved equivalent-keyboard-key info. */
310 cachelist
= savedkey
= descrip
= Qnil
;
311 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
312 && (NILP (XCONS (XCONS (def
)->car
)->car
)
313 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
315 cachelist
= XCONS (def
)->car
;
316 def
= XCONS (def
)->cdr
;
317 savedkey
= XCONS (cachelist
)->car
;
318 descrip
= XCONS (cachelist
)->cdr
;
321 /* Is it still valid? */
323 if (!NILP (savedkey
))
324 def1
= Fkey_binding (savedkey
, Qnil
);
325 /* If not, update it. */
327 /* If something had no key binding before, don't recheck it--
328 doing that takes too much time and makes menus too slow. */
329 && !(!NILP (cachelist
) && NILP (savedkey
)))
333 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
334 if (VECTORP (savedkey
)
335 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
337 if (!NILP (savedkey
))
339 descrip
= Fkey_description (savedkey
);
340 descrip
= concat2 (make_string (" (", 3), descrip
);
341 descrip
= concat2 (descrip
, make_string (")", 1));
345 /* Cache the data we just got in a sublist of the menu binding. */
346 if (NILP (cachelist
))
347 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
350 XCONS (cachelist
)->car
= savedkey
;
351 XCONS (cachelist
)->cdr
= descrip
;
354 *descrip_ptr
= descrip
;
358 /* This is used as the handler when calling internal_condition_case_1. */
361 menu_item_enabled_p_1 (arg
)
367 /* Return non-nil if the command DEF is enabled when used as a menu item.
368 This is based on looking for a menu-enable property.
369 If NOTREAL is set, don't bother really computing this. */
372 menu_item_enabled_p (def
, notreal
)
375 Lisp_Object enabled
, tem
;
380 if (XTYPE (def
) == Lisp_Symbol
)
382 /* No property, or nil, means enable.
383 Otherwise, enable if value is not nil. */
384 tem
= Fget (def
, Qmenu_enable
);
386 /* (condition-case nil (eval tem)
388 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
389 menu_item_enabled_p_1
);
394 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
395 and generate menu panes for them in menu_items.
396 If NOTREAL is nonzero,
397 don't bother really computing whether an item is enabled. */
400 keymap_panes (keymaps
, nmaps
, notreal
)
401 Lisp_Object
*keymaps
;
409 /* Loop over the given keymaps, making a pane for each map.
410 But don't make a pane that is empty--ignore that map instead.
411 P is the number of panes we have made so far. */
412 for (mapno
= 0; mapno
< nmaps
; mapno
++)
413 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
);
415 finish_menu_items ();
418 /* This is a recursive subroutine of keymap_panes.
419 It handles one keymap, KEYMAP.
420 The other arguments are passed along
421 or point to local variables of the previous function.
422 If NOTREAL is nonzero,
423 don't bother really computing whether an item is enabled. */
426 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
)
428 Lisp_Object pane_name
;
432 Lisp_Object pending_maps
;
433 Lisp_Object tail
, item
, item1
, item_string
, table
;
434 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
438 push_menu_pane (pane_name
, prefix
);
440 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
442 /* Look at each key binding, and if it has a menu string,
443 make a menu item from it. */
444 item
= XCONS (tail
)->car
;
445 if (XTYPE (item
) == Lisp_Cons
)
447 item1
= XCONS (item
)->cdr
;
448 if (XTYPE (item1
) == Lisp_Cons
)
450 item_string
= XCONS (item1
)->car
;
451 if (XTYPE (item_string
) == Lisp_String
)
453 /* This is the real definition--the function to run. */
455 /* These are the saved equivalent keyboard key sequence
456 and its key-description. */
458 Lisp_Object tem
, enabled
;
460 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
462 /* GCPRO because we will call eval.
463 Protecting KEYMAP preserves everything we use;
464 aside from that, must protect whatever might be
465 a string. Since there's no GCPRO5, we refetch
466 item_string instead of protecting it. */
467 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
468 enabled
= menu_item_enabled_p (def
, notreal
);
472 item_string
= XCONS (item1
)->car
;
474 tem
= Fkeymapp (def
);
475 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
476 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
481 submap
= get_keymap_1 (def
, 0, 1);
482 #ifndef USE_X_TOOLKIT
483 /* Indicate visually that this is a submenu. */
485 item_string
= concat2 (item_string
,
486 build_string (" >"));
488 push_menu_item (item_string
, enabled
, XCONS (item
)->car
,
491 /* Display a submenu using the toolkit. */
494 push_submenu_start ();
495 single_keymap_panes (submap
, Qnil
,
496 XCONS (item
)->car
, notreal
);
504 else if (XTYPE (item
) == Lisp_Vector
)
506 /* Loop over the char values represented in the vector. */
507 int len
= XVECTOR (item
)->size
;
509 for (c
= 0; c
< len
; c
++)
511 Lisp_Object character
;
512 XFASTINT (character
) = c
;
513 item1
= XVECTOR (item
)->contents
[c
];
514 if (XTYPE (item1
) == Lisp_Cons
)
516 item_string
= XCONS (item1
)->car
;
517 if (XTYPE (item_string
) == Lisp_String
)
521 /* These are the saved equivalent keyboard key sequence
522 and its key-description. */
524 Lisp_Object tem
, enabled
;
526 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
528 /* GCPRO because we will call eval.
529 Protecting KEYMAP preserves everything we use;
530 aside from that, must protect whatever might be
531 a string. Since there's no GCPRO5, we refetch
532 item_string instead of protecting it. */
533 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
534 enabled
= menu_item_enabled_p (def
, notreal
);
537 item_string
= XCONS (item1
)->car
;
539 tem
= Fkeymapp (def
);
540 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
541 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
546 submap
= get_keymap_1 (def
, 0, 1);
547 #ifndef USE_X_TOOLKIT
549 item_string
= concat2 (item_string
,
550 build_string (" >"));
552 push_menu_item (item_string
, enabled
, character
,
557 push_submenu_start ();
558 single_keymap_panes (submap
, Qnil
,
570 /* Process now any submenus which want to be panes at this level. */
571 while (!NILP (pending_maps
))
573 Lisp_Object elt
, eltcdr
, string
;
574 elt
= Fcar (pending_maps
);
575 eltcdr
= XCONS (elt
)->cdr
;
576 string
= XCONS (eltcdr
)->car
;
577 /* We no longer discard the @ from the beginning of the string here.
578 Instead, we do this in xmenu_show. */
579 single_keymap_panes (Fcar (elt
), string
,
580 XCONS (eltcdr
)->cdr
, notreal
);
581 pending_maps
= Fcdr (pending_maps
);
585 /* Push all the panes and items of a menu decsribed by the
586 alist-of-alists MENU.
587 This handles old-fashioned calls to x-popup-menu. */
597 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
599 Lisp_Object elt
, pane_name
, pane_data
;
601 pane_name
= Fcar (elt
);
602 CHECK_STRING (pane_name
, 0);
603 push_menu_pane (pane_name
, Qnil
);
604 pane_data
= Fcdr (elt
);
605 CHECK_CONS (pane_data
, 0);
606 list_of_items (pane_data
);
609 finish_menu_items ();
612 /* Push the items in a single pane defined by the alist PANE. */
618 Lisp_Object tail
, item
, item1
;
620 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
624 push_menu_item (item
, Qnil
, Qnil
, Qnil
);
625 else if (NILP (item
))
626 push_left_right_boundary ();
629 CHECK_CONS (item
, 0);
631 CHECK_STRING (item1
, 1);
632 push_menu_item (item1
, Qt
, Fcdr (item
), Qnil
);
637 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
638 "Pop up a deck-of-cards menu and return user's selection.\n\
639 POSITION is a position specification. This is either a mouse button event\n\
640 or a list ((XOFFSET YOFFSET) WINDOW)\n\
641 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
642 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
643 This controls the position of the center of the first line\n\
644 in the first pane of the menu, not the top left of the menu as a whole.\n\
645 If POSITION is t, it means to use the current mouse position.\n\
647 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
648 The menu items come from key bindings that have a menu string as well as\n\
649 a definition; actually, the \"definition\" in such a key binding looks like\n\
650 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
651 the keymap as a top-level element.\n\n\
652 You can also use a list of keymaps as MENU.\n\
653 Then each keymap makes a separate pane.\n\
654 When MENU is a keymap or a list of keymaps, the return value\n\
655 is a list of events.\n\n\
656 Alternatively, you can specify a menu of multiple panes\n\
657 with a list of the form (TITLE PANE1 PANE2...),\n\
658 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
659 Each ITEM is normally a cons cell (STRING . VALUE);\n\
660 but a string can appear as an item--that makes a nonselectable line\n\
662 With this form of menu, the return value is VALUE from the chosen item.\n\
664 If POSITION is nil, don't display the menu at all, just precalculate the\n\
665 cached information about equivalent key sequences.")
667 Lisp_Object position
, menu
;
669 int number_of_panes
, panes
;
670 Lisp_Object keymap
, tem
;
674 Lisp_Object selection
;
677 Lisp_Object x
, y
, window
;
682 if (! NILP (position
))
686 /* Decode the first argument: find the window and the coordinates. */
687 if (EQ (position
, Qt
))
689 /* Use the mouse's current position. */
691 Lisp_Object bar_window
;
695 if (mouse_position_hook
)
696 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
698 XSET (window
, Lisp_Frame
, new_f
);
701 window
= selected_window
;
708 tem
= Fcar (position
);
709 if (XTYPE (tem
) == Lisp_Cons
)
711 window
= Fcar (Fcdr (position
));
713 y
= Fcar (Fcdr (tem
));
717 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
718 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
719 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
723 /* Determine whether this menu is handling a menu bar click. */
724 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
725 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
733 /* Decode where to put the menu. */
735 if (XTYPE (window
) == Lisp_Frame
)
742 else if (XTYPE (window
) == Lisp_Window
)
744 CHECK_LIVE_WINDOW (window
, 0);
745 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
747 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
748 ypos
= (f
->display
.x
->line_height
* XWINDOW (window
)->top
);
751 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
752 but I don't want to make one now. */
753 CHECK_WINDOW (window
, 0);
762 /* Decode the menu items from what was specified. */
764 keymap
= Fkeymapp (menu
);
766 if (XTYPE (menu
) == Lisp_Cons
)
767 tem
= Fkeymapp (Fcar (menu
));
770 /* We were given a keymap. Extract menu info from the keymap. */
772 keymap
= get_keymap (menu
);
774 /* Extract the detailed info to make one pane. */
775 keymap_panes (&menu
, 1, NILP (position
));
777 /* Search for a string appearing directly as an element of the keymap.
778 That string is the title of the menu. */
779 prompt
= map_prompt (keymap
);
781 /* Make that be the pane title of the first pane. */
782 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
783 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
787 else if (!NILP (tem
))
789 /* We were given a list of keymaps. */
790 int nmaps
= XFASTINT (Flength (menu
));
792 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
797 /* The first keymap that has a prompt string
798 supplies the menu title. */
799 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
803 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
805 prompt
= map_prompt (keymap
);
806 if (NILP (title
) && !NILP (prompt
))
810 /* Extract the detailed info to make one pane. */
811 keymap_panes (maps
, nmaps
, NILP (position
));
813 /* Make the title be the pane title of the first pane. */
814 if (!NILP (title
) && menu_items_n_panes
>= 0)
815 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
821 /* We were given an old-fashioned menu. */
823 CHECK_STRING (title
, 1);
825 list_of_panes (Fcdr (menu
));
832 discard_menu_items ();
837 /* Display them in a menu. */
840 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
,
841 keymaps
, title
, &error_name
);
844 discard_menu_items ();
848 if (error_name
) error (error_name
);
852 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
853 "Pop up a dialog box and return user's selection.\n\
854 POSITION specifies which frame to use.\n\
855 This is normally a mouse button event or a window or frame.\n\
856 If POSITION is t, it means to use the frame the mouse is on.\n\
857 The dialog box appears in the middle of the specified frame.\n\
859 CONTENTS specifies the alternatives to display in the dialog box.\n\
860 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
861 Each ITEM is a cons cell (STRING . VALUE).\n\
862 The return value is VALUE from the chosen item.\n\n\
863 An ITEM may also be just a string--that makes a nonselectable item.\n\
864 An ITEM may also be nil--that means to put all preceding items\n\
865 on the left of the dialog box and all following items on the right.\n\
866 \(By default, approximately half appear on each side.)")
868 Lisp_Object position
, contents
;
875 /* Decode the first argument: find the window or frame to use. */
876 if (EQ (position
, Qt
))
878 #if 0 /* Using the frame the mouse is on may not be right. */
879 /* Use the mouse's current position. */
881 Lisp_Object bar_window
;
886 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
889 XSET (window
, Lisp_Frame
, new_f
);
891 window
= selected_window
;
893 /* Decode the first argument: find the window and the coordinates. */
894 if (EQ (position
, Qt
))
895 window
= selected_window
;
897 else if (CONSP (position
))
900 tem
= Fcar (position
);
901 if (XTYPE (tem
) == Lisp_Cons
)
902 window
= Fcar (Fcdr (position
));
905 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
906 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
909 else if (WINDOWP (position
) || FRAMEP (position
))
912 /* Decode where to put the menu. */
914 if (XTYPE (window
) == Lisp_Frame
)
916 else if (XTYPE (window
) == Lisp_Window
)
918 CHECK_LIVE_WINDOW (window
, 0);
919 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
922 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
923 but I don't want to make one now. */
924 CHECK_WINDOW (window
, 0);
926 #ifndef USE_X_TOOLKIT
927 /* Display a menu with these alternatives
928 in the middle of frame F. */
930 Lisp_Object x
, y
, frame
, newpos
;
931 XSET (frame
, Lisp_Frame
, f
);
932 XSET (x
, Lisp_Int
, x_pixel_width (f
) / 2);
933 XSET (y
, Lisp_Int
, x_pixel_height (f
) / 2);
934 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
936 return Fx_popup_menu (newpos
,
937 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
943 Lisp_Object selection
;
945 /* Decode the dialog items from what was specified. */
946 title
= Fcar (contents
);
947 CHECK_STRING (title
, 1);
949 list_of_panes (Fcons (contents
, Qnil
));
951 /* Display them in a dialog box. */
953 selection
= xdialog_show (f
, 0, 0, title
, &error_name
);
956 discard_menu_items ();
958 if (error_name
) error (error_name
);
967 dispatch_dummy_expose (w
, x
, y
)
975 dummy
.window
= XtWindow (w
);
978 dummy
.send_event
= 0;
979 dummy
.display
= XtDisplay (w
);
983 XtDispatchEvent ((XEvent
*) &dummy
);
987 event_is_in_menu_item (mw
, event
, name
, string_w
)
989 struct input_event
*event
;
993 *string_w
+= (string_width (mw
, name
)
994 + 2 * (mw
->menu
.horizontal_spacing
995 + mw
->menu
.shadow_thickness
));
996 return XINT (event
->x
) < *string_w
;
1000 /* Return the menu bar key which corresponds to event EVENT in frame F. */
1003 map_event_to_object (event
, f
)
1004 struct input_event
*event
;
1009 XlwMenuWidget mw
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1014 /* Find the window */
1015 for (val
= mw
->menu
.old_stack
[0]->contents
; val
; val
= val
->next
)
1017 ws
= &mw
->menu
.windows
[0];
1018 if (ws
&& event_is_in_menu_item (mw
, event
, val
->name
, &string_w
))
1023 items
= FRAME_MENU_BAR_ITEMS (f
);
1025 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1027 Lisp_Object pos
, string
, item
;
1028 item
= XVECTOR (items
)->contents
[i
];
1029 string
= XVECTOR (items
)->contents
[i
+ 1];
1030 pos
= XVECTOR (items
)->contents
[i
+ 2];
1034 if (!strcmp (val
->name
, XSTRING (string
)->data
))
1042 static Lisp_Object
*menu_item_selection
;
1045 popup_selection_callback (widget
, id
, client_data
)
1048 XtPointer client_data
;
1050 menu_item_selection
= (Lisp_Object
*) client_data
;
1054 popup_down_callback (widget
, id
, client_data
)
1057 XtPointer client_data
;
1060 lw_destroy_all_widgets (id
);
1065 dialog_selection_callback (widget
, id
, client_data
)
1068 XtPointer client_data
;
1070 if ((int)client_data
!= -1)
1071 menu_item_selection
= (Lisp_Object
*) client_data
;
1073 lw_destroy_all_widgets (id
);
1077 /* This recursively calls free_widget_value() on the tree of widgets.
1078 It must free all data that was malloc'ed for these widget_values.
1079 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1080 must be left alone. */
1083 free_menubar_widget_value_tree (wv
)
1088 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1090 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1092 free_menubar_widget_value_tree (wv
->contents
);
1093 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1097 free_menubar_widget_value_tree (wv
->next
);
1098 wv
->next
= (widget_value
*) 0xDEADBEEF;
1101 free_widget_value (wv
);
1105 extern void EmacsFrameSetCharSize ();
1108 update_frame_menubar (f
)
1111 struct x_display
*x
= f
->display
.x
;
1113 int menubar_changed
;
1115 menubar_changed
= (x
->menubar_widget
1116 && !XtIsManaged (x
->menubar_widget
));
1118 if (! (menubar_changed
))
1122 /* Save the size of the frame because the pane widget doesn't accept to
1123 resize itself. So force it. */
1128 XawPanedSetRefigureMode (x
->column_widget
, 0);
1130 /* the order in which children are managed is the top to
1131 bottom order in which they are displayed in the paned window.
1132 First, remove the text-area widget.
1134 XtUnmanageChild (x
->edit_widget
);
1136 /* remove the menubar that is there now, and put up the menubar that
1139 if (menubar_changed
)
1141 XtManageChild (x
->menubar_widget
);
1142 XtMapWidget (x
->menubar_widget
);
1143 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1147 /* Re-manage the text-area widget */
1148 XtManageChild (x
->edit_widget
);
1150 /* and now thrash the sizes */
1151 XawPanedSetRefigureMode (x
->column_widget
, 1);
1153 /* Force the pane widget to resize itself with the right values. */
1154 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1160 set_frame_menubar (f
, first_time
)
1164 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
1166 Lisp_Object tail
, items
;
1167 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
1172 wv
= malloc_widget_value ();
1173 wv
->name
= "menubar";
1176 save_wv
= first_wv
= wv
;
1178 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1179 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1181 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1185 string
= XVECTOR (items
)->contents
[i
+ 1];
1189 wv
= malloc_widget_value ();
1193 save_wv
->contents
= wv
;
1194 wv
->name
= (char *) XSTRING (string
)->data
;
1201 lw_modify_all_widgets (id
, first_wv
, False
);
1204 menubar_widget
= lw_create_widget ("menubar", "menubar",
1206 f
->display
.x
->column_widget
,
1209 f
->display
.x
->menubar_widget
= menubar_widget
;
1210 XtVaSetValues (menubar_widget
,
1212 XtNresizeToPreferred
, 1,
1217 free_menubar_widget_value_tree (first_wv
);
1219 /* Don't update the menubar the first time it is created via x_window. */
1221 update_frame_menubar (f
);
1227 free_frame_menubar (f
)
1230 Widget menubar_widget
;
1233 menubar_widget
= f
->display
.x
->menubar_widget
;
1239 lw_destroy_all_widgets (id
);
1243 /* Called from Fx_create_frame to create the inital menubar of a frame
1244 before it is mapped, so that the window is mapped with the menubar already
1245 there instead of us tacking it on later and thrashing the window after it
1248 initialize_frame_menubar (f
)
1251 set_frame_menubar (f
, 1);
1254 /* Horizontal bounds of the current menu bar item. */
1256 static int this_menu_bar_item_beg
;
1257 static int this_menu_bar_item_end
;
1259 /* Horizontal position of the end of the last menu bar item. */
1261 static int last_menu_bar_item_end
;
1263 /* Nonzero if position X, Y is in the menu bar and in some menu bar item
1264 but not in the current menu bar item. */
1267 other_menu_bar_item_p (f
, x
, y
)
1272 && f
->display
.x
->menubar_widget
!= 0
1273 && y
< f
->display
.x
->menubar_widget
->core
.height
1275 && x
< last_menu_bar_item_end
1276 && (x
>= this_menu_bar_item_end
1277 || x
< this_menu_bar_item_beg
));
1280 /* Unread a button-press event in the menu bar of frame F
1281 at x position XPOS relative to the inside of the frame. */
1284 unread_menu_bar_button (f
, xpos
)
1290 event
.type
= ButtonPress
;
1291 event
.xbutton
.display
= x_current_display
;
1292 event
.xbutton
.serial
= 0;
1293 event
.xbutton
.send_event
= 0;
1294 event
.xbutton
.time
= CurrentTime
;
1295 event
.xbutton
.button
= Button1
;
1296 event
.xbutton
.window
= XtWindow (f
->display
.x
->menubar_widget
);
1297 event
.xbutton
.x
= xpos
;
1298 XPutBackEvent (XDISPLAY
&event
);
1301 /* If the mouse has moved to another menu bar item,
1302 return 1 and unread a button press event for that item.
1303 Otherwise return 0. */
1306 check_mouse_other_menu_bar (f
)
1310 Lisp_Object bar_window
;
1315 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1317 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1319 unread_menu_bar_button (f
, x
);
1325 #endif /* USE_X_TOOLKIT */
1327 /* xmenu_show actually displays a menu using the panes and items in menu_items
1328 and returns the value selected from it.
1329 There are two versions of xmenu_show, one for Xt and one for Xlib.
1330 Both assume input is blocked by the caller. */
1332 /* F is the frame the menu is for.
1333 X and Y are the frame-relative specified position,
1334 relative to the inside upper left corner of the frame F.
1335 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1336 KEYMAPS is 1 if this menu was specified with keymaps;
1337 in that case, we return a list containing the chosen item's value
1338 and perhaps also the pane's prefix.
1339 TITLE is the specified menu title.
1340 ERROR is a place to store an error message string in case of failure.
1341 (We return nil on failure, but the value doesn't actually matter.) */
1343 #ifdef USE_X_TOOLKIT
1345 extern unsigned int x_mouse_grabbed
;
1346 extern Lisp_Object Vmouse_depressed
;
1349 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1361 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1363 /* This is the menu bar item (if any) that led to this menu. */
1364 widget_value
*menubar_item
= 0;
1366 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1367 widget_value
**submenu_stack
1368 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1369 Lisp_Object
*subprefix_stack
1370 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1371 int submenu_depth
= 0;
1373 /* Define a queue to save up for later unreading
1374 all X events that don't pertain to the menu. */
1378 struct event_queue
*next
;
1381 struct event_queue
*queue
= NULL
;
1382 struct event_queue
*queue_tmp
;
1384 Position root_x
, root_y
;
1390 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1392 *error
= "Empty menu";
1395 this_menu_bar_item_beg
= -1;
1396 this_menu_bar_item_end
= -1;
1397 last_menu_bar_item_end
= -1;
1399 /* Figure out which menu bar item, if any, this menu is for. */
1404 widget_value
*mb_item
= 0;
1406 for (mb_item
= menubar
->menu
.old_stack
[0]->contents
;
1408 mb_item
= mb_item
->next
)
1411 xend
+= (string_width (menubar
, mb_item
->name
)
1412 + 2 * (menubar
->menu
.horizontal_spacing
1413 + menubar
->menu
.shadow_thickness
));
1414 if (x
>= xbeg
&& x
< xend
)
1418 menubar_item
= mb_item
;
1419 /* Arrange to show a different menu if we move in the menu bar
1420 to a different item. */
1421 this_menu_bar_item_beg
= xbeg
;
1422 this_menu_bar_item_end
= xend
;
1425 last_menu_bar_item_end
= xend
;
1427 if (menubar_item
== 0)
1430 /* Offset the coordinates to root-relative. */
1431 if (f
->display
.x
->menubar_widget
!= 0)
1432 y
+= f
->display
.x
->menubar_widget
->core
.height
;
1433 XtTranslateCoords (f
->display
.x
->widget
,
1434 x
, y
, &root_x
, &root_y
);
1438 /* Create a tree of widget_value objects
1439 representing the panes and their items. */
1440 wv
= malloc_widget_value ();
1447 /* Loop over all panes and items, filling in the tree. */
1449 while (i
< menu_items_used
)
1451 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1453 submenu_stack
[submenu_depth
++] = save_wv
;
1459 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1462 save_wv
= submenu_stack
[--submenu_depth
];
1466 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1467 && submenu_depth
!= 0)
1468 i
+= MENU_ITEMS_PANE_LENGTH
;
1469 /* Ignore a nil in the item list.
1470 It's meaningful only for dialog boxes. */
1471 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1473 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1475 /* Create a new pane. */
1476 Lisp_Object pane_name
, prefix
;
1478 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1479 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1480 pane_string
= (NILP (pane_name
)
1481 ? "" : (char *) XSTRING (pane_name
)->data
);
1482 /* If there is just one top-level pane, put all its items directly
1483 under the top-level menu. */
1484 if (menu_items_n_panes
== 1)
1487 /* If the pane has a meaningful name,
1488 make the pane a top-level menu item
1489 with its items as a submenu beneath it. */
1490 if (!keymaps
&& strcmp (pane_string
, ""))
1492 wv
= malloc_widget_value ();
1496 first_wv
->contents
= wv
;
1497 wv
->name
= pane_string
;
1498 if (keymaps
&& !NILP (prefix
))
1505 else if (first_pane
)
1511 i
+= MENU_ITEMS_PANE_LENGTH
;
1515 /* Create a new item within current pane. */
1516 Lisp_Object item_name
, enable
, descrip
;
1517 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1518 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1520 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1522 wv
= malloc_widget_value ();
1526 save_wv
->contents
= wv
;
1527 wv
->name
= (char *) XSTRING (item_name
)->data
;
1528 if (!NILP (descrip
))
1529 wv
->key
= (char *) XSTRING (descrip
)->data
;
1531 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1532 wv
->enabled
= !NILP (enable
);
1535 i
+= MENU_ITEMS_ITEM_LENGTH
;
1539 /* Actually create the menu. */
1540 menu_id
= ++popup_id_tick
;
1541 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1542 f
->display
.x
->widget
, 1, 0,
1543 popup_selection_callback
, popup_down_callback
);
1544 /* Free the widget_value objects we used to specify the contents. */
1545 free_menubar_widget_value_tree (first_wv
);
1547 /* No selection has been chosen yet. */
1548 menu_item_selection
= 0;
1550 /* If the mouse moves out of the menu before we show the menu,
1551 don't show it at all. */
1552 if (check_mouse_other_menu_bar (f
))
1554 lw_destroy_all_widgets (menu_id
);
1559 /* Highlight the menu bar item (if any) that led to this menu. */
1562 menubar_item
->call_data
= (XtPointer
) 1;
1563 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1566 /* Display the menu. */
1568 XButtonPressedEvent dummy
;
1571 mw
= (XlwMenuWidget
) ((CompositeWidget
)menu
)->composite
.children
[0];
1573 dummy
.type
= ButtonPress
;
1575 dummy
.send_event
= 0;
1576 dummy
.display
= XtDisplay (menu
);
1577 dummy
.window
= XtWindow (XtParent (menu
));
1578 dummy
.time
= CurrentTime
;
1583 /* We activate directly the lucid implementation. */
1584 pop_up_menu (mw
, &dummy
);
1587 /* No need to check a second time since this is done in the XEvent loop.
1588 This slows done the execution. */
1590 /* Check again whether the mouse has moved to another menu bar item. */
1591 if (check_mouse_other_menu_bar (f
))
1593 /* The mouse moved into a different menu bar item.
1594 We should bring up that item's menu instead.
1595 First pop down this menu. */
1596 XtUngrabPointer ((Widget
)
1598 ((CompositeWidget
)menu
)->composite
.children
[0]),
1600 lw_destroy_all_widgets (menu_id
);
1605 /* Process events that apply to the menu. */
1610 XtAppNextEvent (Xt_app_con
, &event
);
1611 if (event
.type
== ButtonRelease
)
1613 XtDispatchEvent (&event
);
1616 /* Do the work of construct_mouse_click since it can't
1617 be called. Initially, the popup menu has been called
1618 from a ButtonPress in the edit_widget. Then the mouse
1619 has been set to grabbed. Reset it now. */
1620 x_mouse_grabbed
&= ~(1 << event
.xbutton
.button
);
1621 if (!x_mouse_grabbed
)
1622 Vmouse_depressed
= Qnil
;
1626 else if (event
.type
== Expose
)
1627 process_expose_from_menu (event
);
1628 else if (event
.type
== MotionNotify
)
1630 int event_x
= (event
.xmotion
.x_root
1631 - (f
->display
.x
->widget
->core
.x
1632 + f
->display
.x
->widget
->core
.border_width
));
1633 int event_y
= (event
.xmotion
.y_root
1634 - (f
->display
.x
->widget
->core
.y
1635 + f
->display
.x
->widget
->core
.border_width
));
1637 if (other_menu_bar_item_p (f
, event_x
, event_y
))
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 XtUngrabPointer ((Widget
)
1644 ((CompositeWidget
)menu
)->composite
.children
[0]),
1645 event
.xbutton
.time
);
1646 lw_destroy_all_widgets (menu_id
);
1648 /* Put back an event that will bring up the other item's menu. */
1649 unread_menu_bar_button (f
, event_x
);
1650 /* Don't let us select anything in this case. */
1651 menu_item_selection
= 0;
1656 XtDispatchEvent (&event
);
1657 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1660 = (struct event_queue
*) malloc (sizeof (struct event_queue
));
1662 if (queue_tmp
!= NULL
)
1664 queue_tmp
->event
= event
;
1665 queue_tmp
->next
= queue
;
1672 /* Unhighlight the menu bar item (if any) that led to this menu. */
1675 menubar_item
->call_data
= (XtPointer
) 0;
1676 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1679 /* fp turned off the following statement and wrote a comment
1680 that it is unnecessary--that the menu has already disappeared.
1681 I observer that is not so. -- rms. */
1682 /* Make sure the menu disappears. */
1683 lw_destroy_all_widgets (menu_id
);
1685 /* Unread any events that we got but did not handle. */
1686 while (queue
!= NULL
)
1689 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1690 queue
= queue_tmp
->next
;
1691 free ((char *)queue_tmp
);
1692 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1693 interrupt_input_pending
= 1;
1696 /* Find the selected item, and its pane, to return
1697 the proper value. */
1698 if (menu_item_selection
!= 0)
1704 while (i
< menu_items_used
)
1708 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1710 subprefix_stack
[submenu_depth
++] = prefix
;
1714 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1716 prefix
= subprefix_stack
[--submenu_depth
];
1719 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1722 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1723 i
+= MENU_ITEMS_PANE_LENGTH
;
1728 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1729 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1735 entry
= Fcons (entry
, Qnil
);
1737 entry
= Fcons (prefix
, entry
);
1738 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1739 if (!NILP (subprefix_stack
[j
]))
1740 entry
= Fcons (subprefix_stack
[j
], entry
);
1744 i
+= MENU_ITEMS_ITEM_LENGTH
;
1752 static char * button_names
[] = {
1753 "button1", "button2", "button3", "button4", "button5",
1754 "button6", "button7", "button8", "button9", "button10" };
1757 xdialog_show (f
, menubarp
, keymaps
, title
, error
)
1764 int i
, nb_buttons
=0;
1767 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1768 char dialog_name
[6];
1770 /* This is the menu bar item (if any) that led to this menu. */
1771 widget_value
*menubar_item
= 0;
1773 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1775 /* Define a queue to save up for later unreading
1776 all X events that don't pertain to the menu. */
1780 struct event_queue
*next
;
1783 struct event_queue
*queue
= NULL
;
1784 struct event_queue
*queue_tmp
;
1786 /* Number of elements seen so far, before boundary. */
1788 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1789 int boundary_seen
= 0;
1793 if (menu_items_n_panes
> 1)
1795 *error
= "Multiple panes in dialog box";
1799 /* Create a tree of widget_value objects
1800 representing the text label and buttons. */
1802 Lisp_Object pane_name
, prefix
;
1804 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1805 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1806 pane_string
= (NILP (pane_name
)
1807 ? "" : (char *) XSTRING (pane_name
)->data
);
1808 prev_wv
= malloc_widget_value ();
1809 prev_wv
->value
= pane_string
;
1810 if (keymaps
&& !NILP (prefix
))
1812 prev_wv
->enabled
= 1;
1813 prev_wv
->name
= "message";
1816 /* Loop over all panes and items, filling in the tree. */
1817 i
= MENU_ITEMS_PANE_LENGTH
;
1818 while (i
< menu_items_used
)
1821 /* Create a new item within current pane. */
1822 Lisp_Object item_name
, enable
, descrip
;
1823 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1824 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1826 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1828 if (NILP (item_name
))
1830 free_menubar_widget_value_tree (first_wv
);
1831 *error
= "Submenu in dialog items";
1834 if (EQ (item_name
, Qquote
))
1836 /* This is the boundary between left-side elts
1837 and right-side elts. Stop incrementing right_count. */
1842 if (nb_buttons
>= 10)
1844 free_menubar_widget_value_tree (first_wv
);
1845 *error
= "Too many dialog items";
1849 wv
= malloc_widget_value ();
1851 wv
->name
= (char *) button_names
[nb_buttons
];
1852 if (!NILP (descrip
))
1853 wv
->key
= (char *) XSTRING (descrip
)->data
;
1854 wv
->value
= (char *) XSTRING (item_name
)->data
;
1855 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1856 wv
->enabled
= !NILP (enable
);
1859 if (! boundary_seen
)
1863 i
+= MENU_ITEMS_ITEM_LENGTH
;
1866 /* If the boundary was not specified,
1867 by default put half on the left and half on the right. */
1868 if (! boundary_seen
)
1869 left_count
= nb_buttons
- nb_buttons
/ 2;
1871 wv
= malloc_widget_value ();
1872 wv
->name
= dialog_name
;
1874 /* Dialog boxes use a really stupid name encoding
1875 which specifies how many buttons to use
1876 and how many buttons are on the right.
1877 The Q means something also. */
1878 dialog_name
[0] = 'Q';
1879 dialog_name
[1] = '0' + nb_buttons
;
1880 dialog_name
[2] = 'B';
1881 dialog_name
[3] = 'R';
1882 /* Number of buttons to put on the right. */
1883 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1885 wv
->contents
= first_wv
;
1889 /* Actually create the dialog. */
1890 dialog_id
= ++popup_id_tick
;
1891 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1892 f
->display
.x
->widget
, 1, 0,
1893 dialog_selection_callback
, 0);
1894 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1895 lw_modify_all_widgets (dialog_id
, first_wv
, True
);
1897 lw_modify_all_widgets (dialog_id
, first_wv
->contents
->next
, True
);
1898 /* Free the widget_value objects we used to specify the contents. */
1899 free_menubar_widget_value_tree (first_wv
);
1901 /* No selection has been chosen yet. */
1902 menu_item_selection
= 0;
1904 /* Display the menu. */
1905 lw_pop_up_all_widgets (dialog_id
);
1907 /* Process events that apply to the menu. */
1912 XtAppNextEvent (Xt_app_con
, &event
);
1913 if (event
.type
== ButtonRelease
)
1915 XtDispatchEvent (&event
);
1918 else if (event
.type
== Expose
)
1919 process_expose_from_menu (event
);
1920 XtDispatchEvent (&event
);
1921 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1923 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1925 if (queue_tmp
!= NULL
)
1927 queue_tmp
->event
= event
;
1928 queue_tmp
->next
= queue
;
1935 /* State that no mouse buttons are now held.
1936 That is not necessarily true, but the fiction leads to reasonable
1937 results, and it is a pain to ask which are actually held now
1938 or track this in the loop above. */
1939 x_mouse_grabbed
= 0;
1941 /* Unread any events that we got but did not handle. */
1942 while (queue
!= NULL
)
1945 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1946 queue
= queue_tmp
->next
;
1947 free ((char *)queue_tmp
);
1948 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1949 interrupt_input_pending
= 1;
1952 /* Find the selected item, and its pane, to return
1953 the proper value. */
1954 if (menu_item_selection
!= 0)
1960 while (i
< menu_items_used
)
1964 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1967 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1968 i
+= MENU_ITEMS_PANE_LENGTH
;
1973 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1974 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1978 entry
= Fcons (entry
, Qnil
);
1980 entry
= Fcons (prefix
, entry
);
1984 i
+= MENU_ITEMS_ITEM_LENGTH
;
1991 #else /* not USE_X_TOOLKIT */
1994 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
2004 int pane
, selidx
, lpane
, status
;
2005 Lisp_Object entry
, pane_prefix
;
2007 int ulx
, uly
, width
, height
;
2008 int dispwidth
, dispheight
;
2012 unsigned int dummy_uint
;
2015 if (menu_items_n_panes
== 0)
2018 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2020 *error
= "Empty menu";
2024 /* Figure out which root window F is on. */
2025 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
2026 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2027 &dummy_uint
, &dummy_uint
);
2029 /* Make the menu on that window. */
2030 menu
= XMenuCreate (XDISPLAY root
, "emacs");
2033 *error
= "Can't create menu";
2037 /* Adjust coordinates to relative to the outer (window manager) window. */
2041 int win_x
= 0, win_y
= 0;
2043 /* Find the position of the outside upper-left corner of
2044 the inner window, with respect to the outer window. */
2045 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2048 XTranslateCoordinates (x_current_display
,
2050 /* From-window, to-window. */
2051 f
->display
.x
->window_desc
,
2052 f
->display
.x
->parent_desc
,
2054 /* From-position, to-position. */
2055 0, 0, &win_x
, &win_y
,
2057 /* Child of window. */
2064 #endif /* HAVE_X11 */
2066 /* Adjust coordinates to be root-window-relative. */
2067 x
+= f
->display
.x
->left_pos
;
2068 y
+= f
->display
.x
->top_pos
;
2070 /* Create all the necessary panes and their items. */
2072 while (i
< menu_items_used
)
2074 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2076 /* Create a new pane. */
2077 Lisp_Object pane_name
, prefix
;
2080 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2081 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2082 pane_string
= (NILP (pane_name
)
2083 ? "" : (char *) XSTRING (pane_name
)->data
);
2084 if (keymaps
&& !NILP (prefix
))
2087 lpane
= XMenuAddPane (XDISPLAY menu
, pane_string
, TRUE
);
2088 if (lpane
== XM_FAILURE
)
2090 XMenuDestroy (XDISPLAY menu
);
2091 *error
= "Can't create pane";
2094 i
+= MENU_ITEMS_PANE_LENGTH
;
2096 /* Find the width of the widest item in this pane. */
2099 while (j
< menu_items_used
)
2102 item
= XVECTOR (menu_items
)->contents
[j
];
2110 width
= XSTRING (item
)->size
;
2111 if (width
> maxwidth
)
2114 j
+= MENU_ITEMS_ITEM_LENGTH
;
2117 /* Ignore a nil in the item list.
2118 It's meaningful only for dialog boxes. */
2119 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2123 /* Create a new item within current pane. */
2124 Lisp_Object item_name
, enable
, descrip
;
2125 unsigned char *item_data
;
2127 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2128 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2130 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2131 if (!NILP (descrip
))
2133 int gap
= maxwidth
- XSTRING (item_name
)->size
;
2136 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2137 item_name
= concat2 (item_name
, spacer
);
2138 item_name
= concat2 (item_name
, descrip
);
2139 item_data
= XSTRING (item_name
)->data
;
2141 /* if alloca is fast, use that to make the space,
2142 to reduce gc needs. */
2144 = (unsigned char *) alloca (maxwidth
2145 + XSTRING (descrip
)->size
+ 1);
2146 bcopy (XSTRING (item_name
)->data
, item_data
,
2147 XSTRING (item_name
)->size
);
2148 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2150 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2151 XSTRING (descrip
)->size
);
2152 item_data
[j
+ XSTRING (descrip
)->size
] = 0;
2156 item_data
= XSTRING (item_name
)->data
;
2158 if (XMenuAddSelection (XDISPLAY menu
, lpane
, 0, item_data
,
2162 XMenuDestroy (XDISPLAY menu
);
2163 *error
= "Can't add selection to menu";
2166 i
+= MENU_ITEMS_ITEM_LENGTH
;
2170 /* All set and ready to fly. */
2171 XMenuRecompute (XDISPLAY menu
);
2172 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
2173 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
2174 x
= min (x
, dispwidth
);
2175 y
= min (y
, dispheight
);
2178 XMenuLocate (XDISPLAY menu
, 0, 0, x
, y
,
2179 &ulx
, &uly
, &width
, &height
);
2180 if (ulx
+width
> dispwidth
)
2182 x
-= (ulx
+ width
) - dispwidth
;
2183 ulx
= dispwidth
- width
;
2185 if (uly
+height
> dispheight
)
2187 y
-= (uly
+ height
) - dispheight
;
2188 uly
= dispheight
- height
;
2190 if (ulx
< 0) x
-= ulx
;
2191 if (uly
< 0) y
-= uly
;
2193 XMenuSetAEQ (menu
, TRUE
);
2194 XMenuSetFreeze (menu
, TRUE
);
2197 status
= XMenuActivate (XDISPLAY menu
, &pane
, &selidx
,
2198 x
, y
, ButtonReleaseMask
, &datap
);
2203 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2206 /* Find the item number SELIDX in pane number PANE. */
2208 while (i
< menu_items_used
)
2210 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2214 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2216 i
+= MENU_ITEMS_PANE_LENGTH
;
2225 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2228 entry
= Fcons (entry
, Qnil
);
2229 if (!NILP (pane_prefix
))
2230 entry
= Fcons (pane_prefix
, entry
);
2236 i
+= MENU_ITEMS_ITEM_LENGTH
;
2242 XMenuDestroy (XDISPLAY menu
);
2243 *error
= "Can't activate menu";
2249 XMenuDestroy (XDISPLAY menu
);
2251 /* State that no mouse buttons are now held.
2252 (The oldXMenu code doesn't track this info for us.)
2253 That is not necessarily true, but the fiction leads to reasonable
2254 results, and it is a pain to ask which are actually held now. */
2255 x_mouse_grabbed
= 0;
2259 #endif /* not USE_X_TOOLKIT */
2263 staticpro (&menu_items
);
2266 popup_id_tick
= (1<<16);
2267 defsubr (&Sx_popup_menu
);
2268 defsubr (&Sx_popup_dialog
);