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 ();
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 Using a Lisp vector to hold this information while we decode it
117 takes care of protecting all the data from GC. */
119 #define MENU_ITEMS_PANE_NAME 1
120 #define MENU_ITEMS_PANE_PREFIX 2
121 #define MENU_ITEMS_PANE_LENGTH 3
123 #define MENU_ITEMS_ITEM_NAME 0
124 #define MENU_ITEMS_ITEM_ENABLE 1
125 #define MENU_ITEMS_ITEM_VALUE 2
126 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
127 #define MENU_ITEMS_ITEM_LENGTH 4
129 static Lisp_Object menu_items
;
131 /* Number of slots currently allocated in menu_items. */
132 static int menu_items_allocated
;
134 /* This is the index in menu_items of the first empty slot. */
135 static int menu_items_used
;
137 /* The number of panes currently recorded in menu_items. */
138 static int menu_items_n_panes
;
140 /* Initialize the menu_items structure if we haven't already done so.
141 Also mark it as currently empty. */
146 if (NILP (menu_items
))
148 menu_items_allocated
= 60;
149 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
153 menu_items_n_panes
= 0;
156 /* Call at the end of generating the data in menu_items.
157 This fills in the number of items in the last pane. */
164 /* Call when finished using the data for the current menu
168 discard_menu_items ()
170 /* Free the structure if it is especially large.
171 Otherwise, hold on to it, to save time. */
172 if (menu_items_allocated
> 200)
175 menu_items_allocated
= 0;
179 /* Start a new menu pane in menu_items..
180 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
183 push_menu_pane (name
, prefix_vec
)
184 Lisp_Object name
, prefix_vec
;
186 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
189 int old_size
= menu_items_allocated
;
192 menu_items_allocated
*= 2;
193 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
194 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
195 old_size
* sizeof (Lisp_Object
));
198 menu_items_n_panes
++;
199 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
200 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
201 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
204 /* Push one menu item into the current pane.
205 NAME is the string to display. ENABLE if non-nil means
206 this item can be selected. KEY is the key generated by
207 choosing this item. EQUIV is the textual description
208 of the keyboard equivalent for this item (or nil if none). */
211 push_menu_item (name
, enable
, key
, equiv
)
212 Lisp_Object name
, enable
, key
, equiv
;
214 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
217 int old_size
= menu_items_allocated
;
220 menu_items_allocated
*= 2;
221 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
222 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
223 old_size
* sizeof (Lisp_Object
));
226 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
227 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
228 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
229 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
232 /* Figure out the current keyboard equivalent of a menu item ITEM1.
233 The item string for menu display should be ITEM_STRING.
234 Store the equivalent keyboard key sequence's
235 textual description into *DESCRIP_PTR.
236 Also cache them in the item itself.
237 Return the real definition to execute. */
240 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
241 Lisp_Object item_string
;
243 Lisp_Object
*descrip_ptr
;
245 /* This is the real definition--the function to run. */
247 /* This is the sublist that records cached equiv key data
248 so we can save time. */
249 Lisp_Object cachelist
;
250 /* These are the saved equivalent keyboard key sequence
251 and its key-description. */
252 Lisp_Object savedkey
, descrip
;
256 /* If a help string follows the item string, skip it. */
257 if (CONSP (XCONS (item1
)->cdr
)
258 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
259 item1
= XCONS (item1
)->cdr
;
263 /* Get out the saved equivalent-keyboard-key info. */
264 cachelist
= savedkey
= descrip
= Qnil
;
265 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
266 && (NILP (XCONS (XCONS (def
)->car
)->car
)
267 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
269 cachelist
= XCONS (def
)->car
;
270 def
= XCONS (def
)->cdr
;
271 savedkey
= XCONS (cachelist
)->car
;
272 descrip
= XCONS (cachelist
)->cdr
;
275 /* Is it still valid? */
277 if (!NILP (savedkey
))
278 def1
= Fkey_binding (savedkey
, Qnil
);
279 /* If not, update it. */
281 /* If something had no key binding before, don't recheck it--
282 doing that takes too much time and makes menus too slow. */
283 && !(!NILP (cachelist
) && NILP (savedkey
)))
287 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
288 if (VECTORP (savedkey
)
289 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
291 if (!NILP (savedkey
))
293 descrip
= Fkey_description (savedkey
);
294 descrip
= concat2 (make_string (" (", 3), descrip
);
295 descrip
= concat2 (descrip
, make_string (")", 1));
299 /* Cache the data we just got in a sublist of the menu binding. */
300 if (NILP (cachelist
))
301 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
304 XCONS (cachelist
)->car
= savedkey
;
305 XCONS (cachelist
)->cdr
= descrip
;
308 *descrip_ptr
= descrip
;
312 /* This is used as the handler when calling internal_condition_case_1. */
315 menu_item_enabled_p_1 (arg
)
321 /* Return non-nil if the command DEF is enabled when used as a menu item.
322 This is based on looking for a menu-enable property. */
325 menu_item_enabled_p (def
)
328 Lisp_Object enabled
, tem
;
331 if (XTYPE (def
) == Lisp_Symbol
)
333 /* No property, or nil, means enable.
334 Otherwise, enable if value is not nil. */
335 tem
= Fget (def
, Qmenu_enable
);
337 /* (condition-case nil (eval tem)
339 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
340 menu_item_enabled_p_1
);
345 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
346 and generate menu panes for them in menu_items. */
349 keymap_panes (keymaps
, nmaps
)
350 Lisp_Object
*keymaps
;
357 /* Loop over the given keymaps, making a pane for each map.
358 But don't make a pane that is empty--ignore that map instead.
359 P is the number of panes we have made so far. */
360 for (mapno
= 0; mapno
< nmaps
; mapno
++)
361 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
);
363 finish_menu_items ();
366 /* This is a recursive subroutine of keymap_panes.
367 It handles one keymap, KEYMAP.
368 The other arguments are passed along
369 or point to local variables of the previous function. */
372 single_keymap_panes (keymap
, pane_name
, prefix
)
374 Lisp_Object pane_name
;
377 Lisp_Object pending_maps
;
378 Lisp_Object tail
, item
, item1
, item_string
, table
;
379 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
383 push_menu_pane (pane_name
, prefix
);
385 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
387 /* Look at each key binding, and if it has a menu string,
388 make a menu item from it. */
389 item
= XCONS (tail
)->car
;
390 if (XTYPE (item
) == Lisp_Cons
)
392 item1
= XCONS (item
)->cdr
;
393 if (XTYPE (item1
) == Lisp_Cons
)
395 item_string
= XCONS (item1
)->car
;
396 if (XTYPE (item_string
) == Lisp_String
)
398 /* This is the real definition--the function to run. */
400 /* These are the saved equivalent keyboard key sequence
401 and its key-description. */
403 Lisp_Object tem
, enabled
;
405 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
407 /* GCPRO because we will call eval.
408 Protecting KEYMAP preserves everything we use;
409 aside from that, must protect whatever might be
410 a string. Since there's no GCPRO5, we refetch
411 item_string instead of protecting it. */
412 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
413 enabled
= menu_item_enabled_p (def
);
416 item_string
= XCONS (item1
)->car
;
418 tem
= Fkeymapp (def
);
419 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
420 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
423 push_menu_item (item_string
, enabled
, XCONS (item
)->car
,
428 else if (XTYPE (item
) == Lisp_Vector
)
430 /* Loop over the char values represented in the vector. */
431 int len
= XVECTOR (item
)->size
;
433 for (c
= 0; c
< len
; c
++)
435 Lisp_Object character
;
436 XFASTINT (character
) = c
;
437 item1
= XVECTOR (item
)->contents
[c
];
438 if (XTYPE (item1
) == Lisp_Cons
)
440 item_string
= XCONS (item1
)->car
;
441 if (XTYPE (item_string
) == Lisp_String
)
445 /* These are the saved equivalent keyboard key sequence
446 and its key-description. */
448 Lisp_Object tem
, enabled
;
450 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
452 /* GCPRO because we will call eval.
453 Protecting KEYMAP preserves everything we use;
454 aside from that, must protect whatever might be
455 a string. Since there's no GCPRO5, we refetch
456 item_string instead of protecting it. */
457 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
458 enabled
= menu_item_enabled_p (def
);
461 item_string
= XCONS (item1
)->car
;
463 tem
= Fkeymapp (def
);
464 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
465 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
468 push_menu_item (item_string
, enabled
,
476 /* Process now any submenus which want to be panes at this level. */
477 while (!NILP (pending_maps
))
479 Lisp_Object elt
, eltcdr
;
480 elt
= Fcar (pending_maps
);
481 eltcdr
= XCONS (elt
)->cdr
;
482 single_keymap_panes (Fcar (elt
),
483 /* Fails to discard the @. */
484 XCONS (eltcdr
)->car
, XCONS (eltcdr
)->cdr
);
485 pending_maps
= Fcdr (pending_maps
);
489 /* Push all the panes and items of a menu decsribed by the
490 alist-of-alists MENU.
491 This handles old-fashioned calls to x-popup-menu. */
501 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
503 Lisp_Object elt
, pane_name
, pane_data
;
505 pane_name
= Fcar (elt
);
506 CHECK_STRING (pane_name
, 0);
507 push_menu_pane (pane_name
, Qnil
);
508 pane_data
= Fcdr (elt
);
509 CHECK_CONS (pane_data
, 0);
510 list_of_items (pane_data
);
513 finish_menu_items ();
516 /* Push the items in a single pane defined by the alist PANE. */
522 Lisp_Object tail
, item
, item1
;
524 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
528 push_menu_item (item
, Qnil
, Qnil
);
531 CHECK_CONS (item
, 0);
533 CHECK_STRING (item1
, 1);
534 push_menu_item (item1
, Qt
, Fcdr (item
), Qnil
);
539 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 1, 2, 0,
540 "Pop up a deck-of-cards menu and return user's selection.\n\
541 POSITION is a position specification. This is either a mouse button event\n\
542 or a list ((XOFFSET YOFFSET) WINDOW)\n\
543 where XOFFSET and YOFFSET are positions in characters from the top left\n\
544 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
545 This controls the position of the center of the first line\n\
546 in the first pane of the menu, not the top left of the menu as a whole.\n\
547 If POSITION is t, it means to use the current mouse position.\n\
549 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
550 The menu items come from key bindings that have a menu string as well as\n\
551 a definition; actually, the \"definition\" in such a key binding looks like\n\
552 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
553 the keymap as a top-level element.\n\n\
554 You can also use a list of keymaps as MENU.\n\
555 Then each keymap makes a separate pane.\n\
556 When MENU is a keymap or a list of keymaps, the return value\n\
557 is a list of events.\n\n\
558 Alternatively, you can specify a menu of multiple panes\n\
559 with a list of the form (TITLE PANE1 PANE2...),\n\
560 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
561 Each ITEM is normally a cons cell (STRING . VALUE);\n\
562 but a string can appear as an item--that makes a nonselectable line\n\
564 With this form of menu, the return value is VALUE from the chosen item.\n\
566 If POSITION is nil, don't display the menu at all, just precalculate the\n\
567 cached information about equivalent key sequences.")
569 Lisp_Object position
, menu
;
571 int number_of_panes
, panes
;
572 Lisp_Object keymap
, tem
;
576 Lisp_Object selection
;
579 Lisp_Object x
, y
, window
;
586 if (! NILP (position
))
588 /* Decode the first argument: find the window and the coordinates. */
589 if (EQ (position
, Qt
))
591 /* Use the mouse's current position. */
593 Lisp_Object bar_window
;
597 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
598 XSET (window
, Lisp_Frame
, new_f
);
602 tem
= Fcar (position
);
603 if (XTYPE (tem
) == Lisp_Cons
)
605 window
= Fcar (Fcdr (position
));
607 y
= Fcar (Fcdr (tem
));
611 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
612 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
613 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
617 /* Determine whether this menu is handling a menu bar click. */
618 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
619 if (XTYPE (Fcar (position
)) != Lisp_Cons
621 && EQ (Fcar (tem
), Qmenu_bar
))
629 /* Decode where to put the menu. */
631 if (XTYPE (window
) == Lisp_Frame
)
638 else if (XTYPE (window
) == Lisp_Window
)
640 CHECK_LIVE_WINDOW (window
, 0);
641 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
643 xpos
= (FONT_WIDTH (f
->display
.x
->font
) * XWINDOW (window
)->left
);
644 ypos
= (FONT_HEIGHT (f
->display
.x
->font
) * XWINDOW (window
)->top
);
647 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
648 but I don't want to make one now. */
649 CHECK_WINDOW (window
, 0);
658 /* Decode the menu items from what was specified. */
660 keymap
= Fkeymapp (menu
);
662 if (XTYPE (menu
) == Lisp_Cons
)
663 tem
= Fkeymapp (Fcar (menu
));
666 /* We were given a keymap. Extract menu info from the keymap. */
668 keymap
= get_keymap (menu
);
670 /* Extract the detailed info to make one pane. */
671 keymap_panes (&menu
, 1);
673 /* Search for a string appearing directly as an element of the keymap.
674 That string is the title of the menu. */
675 prompt
= map_prompt (keymap
);
677 /* Make that be the pane title of the first pane. */
678 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
679 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
683 else if (!NILP (tem
))
685 /* We were given a list of keymaps. */
686 int nmaps
= XFASTINT (Flength (menu
));
688 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
693 /* The first keymap that has a prompt string
694 supplies the menu title. */
695 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
699 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
701 prompt
= map_prompt (keymap
);
702 if (NILP (title
) && !NILP (prompt
))
706 /* Extract the detailed info to make one pane. */
707 keymap_panes (maps
, nmaps
);
709 /* Make the title be the pane title of the first pane. */
710 if (!NILP (title
) && menu_items_n_panes
>= 0)
711 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
717 /* We were given an old-fashioned menu. */
719 CHECK_STRING (title
, 1);
721 list_of_panes (Fcdr (menu
));
728 discard_menu_items ();
733 /* Display them in a menu. */
736 selection
= xmenu_show (f
, xpos
, ypos
, menubarp
,
737 keymaps
, title
, &error_name
);
740 discard_menu_items ();
744 if (error_name
) error (error_name
);
751 dispatch_dummy_expose (w
, x
, y
)
759 dummy
.window
= XtWindow (w
);
762 dummy
.send_event
= 0;
763 dummy
.display
= XtDisplay (w
);
767 XtDispatchEvent (&dummy
);
778 XTextExtents (mw
->menu
.font
, s
, strlen (s
), &drop
, &drop
, &drop
, &xcs
);
783 event_is_in_menu_item (mw
, event
, name
, string_w
)
785 struct input_event
*event
;
789 *string_w
+= (string_width (mw
, name
)
790 + 2 * (mw
->menu
.horizontal_spacing
791 + mw
->menu
.shadow_thickness
));
792 return XINT (event
->x
) < *string_w
;
796 /* Return the menu bar key which corresponds to event EVENT in frame F. */
799 map_event_to_object (event
, f
)
800 struct input_event
*event
;
805 XlwMenuWidget mw
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
810 /* Find the window */
811 for (val
= mw
->menu
.old_stack
[0]->contents
; val
; val
= val
->next
)
813 ws
= &mw
->menu
.windows
[0];
814 if (ws
&& event_is_in_menu_item (mw
, event
, val
->name
, &string_w
))
819 items
= FRAME_MENU_BAR_ITEMS (f
);
821 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
823 Lisp_Object pos
, string
, item
;
824 item
= XVECTOR (items
)->contents
[i
];
825 string
= XVECTOR (items
)->contents
[i
+ 1];
826 pos
= XVECTOR (items
)->contents
[i
+ 2];
830 if (!strcmp (val
->name
, XSTRING (string
)->data
))
838 static Lisp_Object
*menu_item_selection
;
841 popup_selection_callback (widget
, id
, client_data
)
844 XtPointer client_data
;
846 menu_item_selection
= (Lisp_Object
*) client_data
;
850 popup_down_callback (widget
, id
, client_data
)
853 XtPointer client_data
;
856 lw_destroy_all_widgets (id
);
860 /* This recursively calls free_widget_value() on the tree of widgets.
861 It must free all data that was malloc'ed for these widget_values.
862 In Emacs, many slots are pointers into the data of Lisp_Strings, and
863 must be left alone. */
866 free_menubar_widget_value_tree (wv
)
871 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
873 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
875 free_menubar_widget_value_tree (wv
->contents
);
876 wv
->contents
= (widget_value
*) 0xDEADBEEF;
880 free_menubar_widget_value_tree (wv
->next
);
881 wv
->next
= (widget_value
*) 0xDEADBEEF;
884 free_widget_value (wv
);
889 update_one_frame_psheets (f
)
892 struct x_display
*x
= f
->display
.x
;
896 menubar_changed
= (x
->menubar_widget
897 && !XtIsManaged (x
->menubar_widget
));
899 if (! (menubar_changed
))
903 XawPanedSetRefigureMode (x
->column_widget
, 0);
905 /* the order in which children are managed is the top to
906 bottom order in which they are displayed in the paned window.
907 First, remove the text-area widget.
909 XtUnmanageChild (x
->edit_widget
);
911 /* remove the menubar that is there now, and put up the menubar that
916 XtManageChild (x
->menubar_widget
);
917 XtMapWidget (x
->menubar_widget
);
918 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
922 /* Re-manage the text-area widget */
923 XtManageChild (x
->edit_widget
);
925 /* and now thrash the sizes */
926 XawPanedSetRefigureMode (x
->column_widget
, 1);
931 set_frame_menubar (f
)
934 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
936 Lisp_Object tail
, items
;
937 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
942 wv
= malloc_widget_value ();
943 wv
->name
= "menubar";
946 save_wv
= first_wv
= wv
;
948 items
= FRAME_MENU_BAR_ITEMS (f
);
950 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
954 string
= XVECTOR (items
)->contents
[i
+ 1];
958 wv
= malloc_widget_value ();
962 save_wv
->contents
= wv
;
963 wv
->name
= XSTRING (string
)->data
;
970 lw_modify_all_widgets (id
, first_wv
, False
);
973 menubar_widget
= lw_create_widget ("menubar", "menubar",
975 f
->display
.x
->column_widget
,
978 f
->display
.x
->menubar_widget
= menubar_widget
;
979 XtVaSetValues (menubar_widget
,
981 XtNresizeToPreferred
, 1,
986 free_menubar_widget_value_tree (first_wv
);
988 update_one_frame_psheets (f
);
994 free_frame_menubar (f
)
997 Widget menubar_widget
;
1000 menubar_widget
= f
->display
.x
->menubar_widget
;
1006 lw_destroy_all_widgets (id
);
1011 /* Nonzero if position X, Y relative to inside of frame F
1012 is in some other menu bar item. */
1014 static int this_menu_bar_item_beg
;
1015 static int this_menu_bar_item_end
;
1018 other_menu_bar_item_p (f
, x
, y
)
1023 && y
< f
->display
.x
->menubar_widget
->core
.height
1025 && x
< f
->display
.x
->menubar_widget
->core
.width
1026 && (x
>= this_menu_bar_item_end
1027 || x
< this_menu_bar_item_beg
));
1030 /* Unread a button-press event in the menu bar of frame F
1031 at x position XPOS relative to the inside of the frame. */
1034 unread_menu_bar_button (f
, xpos
)
1040 event
.type
= ButtonPress
;
1041 event
.xbutton
.display
= x_current_display
;
1042 event
.xbutton
.serial
= 0;
1043 event
.xbutton
.send_event
= 0;
1044 event
.xbutton
.time
= CurrentTime
;
1045 event
.xbutton
.button
= Button1
;
1046 event
.xbutton
.window
= XtWindow (f
->display
.x
->menubar_widget
);
1047 event
.xbutton
.x
= xpos
;
1048 XPutBackEvent (XDISPLAY
&event
);
1051 /* If the mouse has moved to another menu bar item,
1052 return 1 and unread a button press event for that item.
1053 Otherwise return 0. */
1056 check_mouse_other_menu_bar (f
)
1060 Lisp_Object bar_window
;
1065 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1067 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1069 unread_menu_bar_button (f
, x
);
1075 #endif /* USE_X_TOOLKIT */
1077 /* xmenu_show actually displays a menu using the panes and items in menu_items
1078 and returns the value selected from it.
1079 There are two versions of xmenu_show, one for Xt and one for Xlib.
1080 Both assume input is blocked by the caller. */
1082 /* F is the frame the menu is for.
1083 X and Y are the frame-relative specified position,
1084 relative to the inside upper left corner of the frame F.
1085 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1086 KEYMAPS is 1 if this menu was specified with keymaps;
1087 in that case, we return a list containing the chosen item's value
1088 and perhaps also the pane's prefix.
1089 TITLE is the specified menu title.
1090 ERROR is a place to store an error message string in case of failure.
1091 (We return nil on failure, but the value doesn't actually matter.) */
1093 #ifdef USE_X_TOOLKIT
1096 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1108 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1110 /* This is the menu bar item (if any) that led to this menu. */
1111 widget_value
*menubar_item
= 0;
1113 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1115 /* Define a queue to save up for later unreading
1116 all X events that don't pertain to the menu. */
1120 struct event_queue
*next
;
1123 struct event_queue
*queue
= NULL
;
1124 struct event_queue
*queue_tmp
;
1128 this_menu_bar_item_beg
= -1;
1129 this_menu_bar_item_end
= -1;
1131 /* Figure out which menu bar item, if any, this menu is for. */
1137 for (menubar_item
= menubar
->menu
.old_stack
[0]->contents
;
1139 menubar_item
= menubar_item
->next
)
1142 xend
+= (string_width (menubar
, menubar_item
->name
)
1143 + 2 * (menubar
->menu
.horizontal_spacing
1144 + menubar
->menu
.shadow_thickness
));
1149 /* Arrange to show a different menu if we move in the menu bar
1150 to a different item. */
1151 this_menu_bar_item_beg
= xbeg
;
1152 this_menu_bar_item_end
= xend
;
1157 if (menubar_item
== 0)
1160 /* Offset the coordinates to root-relative. */
1161 x
+= (f
->display
.x
->widget
->core
.x
1162 + f
->display
.x
->widget
->core
.border_width
);
1163 y
+= (f
->display
.x
->widget
->core
.y
1164 + f
->display
.x
->widget
->core
.border_width
1165 + f
->display
.x
->menubar_widget
->core
.height
);
1167 /* Create a tree of widget_value objects
1168 representing the panes and their items. */
1169 wv
= malloc_widget_value ();
1175 /* Loop over all panes and items, filling in the tree. */
1177 while (i
< menu_items_used
)
1179 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1181 /* Create a new pane. */
1182 Lisp_Object pane_name
, prefix
;
1184 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1185 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1186 pane_string
= (NILP (pane_name
)
1187 ? "" : (char *) XSTRING (pane_name
)->data
);
1188 /* If there is just one pane, put all its items directly
1189 under the top-level menu. */
1190 if (menu_items_n_panes
== 1)
1193 /* If the pane has a meaningful name,
1194 make the pane a top-level menu item
1195 with its items as a submenu beneath it. */
1196 if (strcmp (pane_string
, ""))
1198 wv
= malloc_widget_value ();
1202 first_wv
->contents
= wv
;
1203 wv
->name
= pane_string
;
1204 if (keymaps
&& !NILP (prefix
))
1211 i
+= MENU_ITEMS_PANE_LENGTH
;
1215 /* Create a new item within current pane. */
1216 Lisp_Object item_name
, enable
, descrip
;
1217 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1218 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1220 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1222 wv
= malloc_widget_value ();
1226 save_wv
->contents
= wv
;
1227 wv
->name
= XSTRING (item_name
)->data
;
1228 if (!NILP (descrip
))
1229 wv
->key
= XSTRING (descrip
)->data
;
1231 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1232 wv
->enabled
= !NILP (enable
);
1235 i
+= MENU_ITEMS_ITEM_LENGTH
;
1239 /* Actually create the menu. */
1240 menu_id
= ++popup_id_tick
;
1241 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1242 f
->display
.x
->widget
, 1, 0,
1243 popup_selection_callback
, popup_down_callback
);
1244 /* Free the widget_value objects we used to specify the contents. */
1245 free_menubar_widget_value_tree (first_wv
);
1247 /* No selection has been chosen yet. */
1248 menu_item_selection
= 0;
1250 /* If the mouse moves out of the menu before we show the menu,
1251 don't show it at all. */
1252 if (check_mouse_other_menu_bar (f
))
1254 lw_destroy_all_widgets (menu_id
);
1259 /* Highlight the menu bar item (if any) that led to this menu. */
1262 menubar_item
->call_data
= (XtPointer
) 1;
1263 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1266 /* Display the menu. */
1268 XButtonPressedEvent dummy
;
1271 mw
= (XlwMenuWidget
) ((CompositeWidget
)menu
)->composite
.children
[0];
1273 dummy
.type
= ButtonPress
;
1275 dummy
.send_event
= 0;
1276 dummy
.display
= XtDisplay (menu
);
1277 dummy
.window
= XtWindow (XtParent (menu
));
1278 dummy
.time
= CurrentTime
;
1283 /* We activate directly the lucid implementation. */
1284 pop_up_menu (mw
, &dummy
);
1287 /* Check again whether the mouse has moved to another menu bar item. */
1288 if (check_mouse_other_menu_bar (f
))
1290 /* The mouse moved into a different menu bar item.
1291 We should bring up that item's menu instead.
1292 First pop down this menu. */
1293 XtUngrabPointer ((Widget
)
1295 ((CompositeWidget
)menu
)->composite
.children
[0]),
1297 lw_destroy_all_widgets (menu_id
);
1301 /* Process events that apply to the menu. */
1306 XtAppNextEvent (Xt_app_con
, &event
);
1307 if (event
.type
== ButtonRelease
)
1309 XtDispatchEvent (&event
);
1312 else if (event
.type
== Expose
)
1313 process_expose_from_menu (event
);
1314 else if (event
.type
== MotionNotify
)
1316 int event_x
= (event
.xmotion
.x_root
1317 - (f
->display
.x
->widget
->core
.x
1318 + f
->display
.x
->widget
->core
.border_width
));
1319 int event_y
= (event
.xmotion
.y_root
1320 - (f
->display
.x
->widget
->core
.y
1321 + f
->display
.x
->widget
->core
.border_width
));
1323 if (other_menu_bar_item_p (f
, event_x
, event_y
))
1325 /* The mouse moved into a different menu bar item.
1326 We should bring up that item's menu instead.
1327 First pop down this menu. */
1328 XtUngrabPointer ((Widget
)
1330 ((CompositeWidget
)menu
)->composite
.children
[0]),
1331 event
.xbutton
.time
);
1332 lw_destroy_all_widgets (menu_id
);
1334 /* Put back an event that will bring up the other item's menu. */
1335 unread_menu_bar_button (f
, event_x
);
1336 /* Don't let us select anything in this case. */
1337 menu_item_selection
= 0;
1342 XtDispatchEvent (&event
);
1343 if (XtWindowToWidget(event
.xany
.window
) != menu
)
1345 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1347 if (queue_tmp
!= NULL
)
1349 queue_tmp
->event
= event
;
1350 queue_tmp
->next
= queue
;
1357 /* Unhighlight the menu bar item (if any) that led to this menu. */
1360 menubar_item
->call_data
= (XtPointer
) 0;
1361 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1364 /* Make sure the menu disappears. */
1365 lw_destroy_all_widgets (menu_id
);
1367 /* Unread any events that we got but did not handle. */
1368 while (queue
!= NULL
)
1371 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1372 queue
= queue_tmp
->next
;
1373 free ((char *)queue_tmp
);
1376 /* Find the selected item, and its pane, to return
1377 the proper value. */
1378 if (menu_item_selection
!= 0)
1384 while (i
< menu_items_used
)
1388 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1391 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1392 i
+= MENU_ITEMS_PANE_LENGTH
;
1397 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1398 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1402 entry
= Fcons (entry
, Qnil
);
1404 entry
= Fcons (prefix
, entry
);
1408 i
+= MENU_ITEMS_ITEM_LENGTH
;
1416 #else /* not USE_X_TOOLKIT */
1419 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1429 int pane
, selidx
, lpane
, status
;
1430 Lisp_Object entry
, pane_prefix
;
1432 int ulx
, uly
, width
, height
;
1433 int dispwidth
, dispheight
;
1436 unsigned int dummy_uint
;
1439 if (menu_items_n_panes
== 0)
1442 /* Figure out which root window F is on. */
1443 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
1444 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
1445 &dummy_uint
, &dummy_uint
);
1447 /* Make the menu on that window. */
1448 menu
= XMenuCreate (XDISPLAY root
, "emacs");
1451 *error
= "Can't create menu";
1455 /* Adjust coordinates to relative to the outer (window manager) window. */
1459 int win_x
= 0, win_y
= 0;
1461 /* Find the position of the outside upper-left corner of
1462 the inner window, with respect to the outer window. */
1463 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
1466 XTranslateCoordinates (x_current_display
,
1468 /* From-window, to-window. */
1469 f
->display
.x
->window_desc
,
1470 f
->display
.x
->parent_desc
,
1472 /* From-position, to-position. */
1473 0, 0, &win_x
, &win_y
,
1475 /* Child of window. */
1482 #endif /* HAVE_X11 */
1484 /* Adjust coordinates to be root-window-relative. */
1485 x
+= f
->display
.x
->left_pos
;
1486 y
+= f
->display
.x
->top_pos
;
1488 /* Create all the necessary panes and their items. */
1490 while (i
< menu_items_used
)
1492 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1494 /* Create a new pane. */
1495 Lisp_Object pane_name
, prefix
;
1498 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1499 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1500 pane_string
= (NILP (pane_name
)
1501 ? "" : (char *) XSTRING (pane_name
)->data
);
1502 if (keymaps
&& !NILP (prefix
))
1505 lpane
= XMenuAddPane (XDISPLAY menu
, pane_string
, TRUE
);
1506 if (lpane
== XM_FAILURE
)
1508 XMenuDestroy (XDISPLAY menu
);
1509 *error
= "Can't create pane";
1512 i
+= MENU_ITEMS_PANE_LENGTH
;
1516 /* Create a new item within current pane. */
1517 Lisp_Object item_name
, enable
, descrip
;
1519 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1520 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1522 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1523 if (!NILP (descrip
))
1524 item_name
= concat2 (item_name
, descrip
);
1526 if (XMenuAddSelection (XDISPLAY menu
, lpane
, 0,
1527 XSTRING (item_name
)->data
,
1531 XMenuDestroy (XDISPLAY menu
);
1532 *error
= "Can't add selection to menu";
1535 i
+= MENU_ITEMS_ITEM_LENGTH
;
1539 /* All set and ready to fly. */
1540 XMenuRecompute (XDISPLAY menu
);
1541 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
1542 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
1543 x
= min (x
, dispwidth
);
1544 y
= min (y
, dispheight
);
1547 XMenuLocate (XDISPLAY menu
, 0, 0, x
, y
,
1548 &ulx
, &uly
, &width
, &height
);
1549 if (ulx
+width
> dispwidth
)
1551 x
-= (ulx
+ width
) - dispwidth
;
1552 ulx
= dispwidth
- width
;
1554 if (uly
+height
> dispheight
)
1556 y
-= (uly
+ height
) - dispheight
;
1557 uly
= dispheight
- height
;
1559 if (ulx
< 0) x
-= ulx
;
1560 if (uly
< 0) y
-= uly
;
1562 XMenuSetFreeze (menu
, TRUE
);
1565 status
= XMenuActivate (XDISPLAY menu
, &pane
, &selidx
,
1566 x
, y
, ButtonReleaseMask
, &datap
);
1571 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
1574 /* Find the item number SELIDX in pane number PANE. */
1576 while (i
< menu_items_used
)
1578 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1582 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1584 i
+= MENU_ITEMS_PANE_LENGTH
;
1593 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1596 entry
= Fcons (entry
, Qnil
);
1597 if (!NILP (pane_prefix
))
1598 entry
= Fcons (pane_prefix
, entry
);
1604 i
+= MENU_ITEMS_ITEM_LENGTH
;
1610 XMenuDestroy (XDISPLAY menu
);
1611 *error
= "Can't activate menu";
1617 XMenuDestroy (XDISPLAY menu
);
1620 #endif /* not USE_X_TOOLKIT */
1624 staticpro (&menu_items
);
1627 popup_id_tick
= (1<<16);
1628 defsubr (&Sx_popup_menu
);