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
;
797 map_event_to_object (event
, f
)
798 struct input_event
*event
;
803 XlwMenuWidget mw
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
808 /* Find the window */
809 for (val
= mw
->menu
.old_stack
[0]->contents
; val
; val
= val
->next
)
811 ws
= &mw
->menu
.windows
[0];
812 if (ws
&& event_is_in_menu_item (mw
, event
, val
->name
, &string_w
))
815 items
= FRAME_MENU_BAR_ITEMS (f
);
816 for (; CONSP (items
); items
= XCONS (items
)->cdr
)
817 if (!strcmp (val
->name
,
818 XSTRING (Fcar (Fcdr (Fcar (items
))))->data
))
825 static Lisp_Object
*menu_item_selection
;
828 popup_selection_callback (widget
, id
, client_data
)
831 XtPointer client_data
;
833 menu_item_selection
= (Lisp_Object
*) client_data
;
837 popup_down_callback (widget
, id
, client_data
)
840 XtPointer client_data
;
843 lw_destroy_all_widgets (id
);
847 /* This recursively calls free_widget_value() on the tree of widgets.
848 It must free all data that was malloc'ed for these widget_values.
849 In Emacs, many slots are pointers into the data of Lisp_Strings, and
850 must be left alone. */
853 free_menubar_widget_value_tree (wv
)
858 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
860 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
862 free_menubar_widget_value_tree (wv
->contents
);
863 wv
->contents
= (widget_value
*) 0xDEADBEEF;
867 free_menubar_widget_value_tree (wv
->next
);
868 wv
->next
= (widget_value
*) 0xDEADBEEF;
871 free_widget_value (wv
);
876 update_one_frame_psheets (f
)
879 struct x_display
*x
= f
->display
.x
;
883 menubar_changed
= (x
->menubar_widget
884 && !XtIsManaged (x
->menubar_widget
));
886 if (! (menubar_changed
))
890 XawPanedSetRefigureMode (x
->column_widget
, 0);
892 /* the order in which children are managed is the top to
893 bottom order in which they are displayed in the paned window.
894 First, remove the text-area widget.
896 XtUnmanageChild (x
->edit_widget
);
898 /* remove the menubar that is there now, and put up the menubar that
903 XtManageChild (x
->menubar_widget
);
904 XtMapWidget (x
->menubar_widget
);
905 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
909 /* Re-manage the text-area widget */
910 XtManageChild (x
->edit_widget
);
912 /* and now thrash the sizes */
913 XawPanedSetRefigureMode (x
->column_widget
, 1);
918 set_frame_menubar (f
)
921 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
924 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
928 wv
= malloc_widget_value ();
929 wv
->name
= "menubar";
932 save_wv
= first_wv
= wv
;
935 for (tail
= FRAME_MENU_BAR_ITEMS (f
); CONSP (tail
); tail
= XCONS (tail
)->cdr
)
939 string
= Fcar (Fcdr (Fcar (tail
)));
941 wv
= malloc_widget_value ();
945 save_wv
->contents
= wv
;
946 wv
->name
= XSTRING (string
)->data
;
953 lw_modify_all_widgets (id
, first_wv
, False
);
956 menubar_widget
= lw_create_widget ("menubar", "menubar",
958 f
->display
.x
->column_widget
,
961 f
->display
.x
->menubar_widget
= menubar_widget
;
962 XtVaSetValues (menubar_widget
,
964 XtNresizeToPreferred
, 1,
969 free_menubar_widget_value_tree (first_wv
);
971 update_one_frame_psheets (f
);
977 free_frame_menubar (f
)
980 Widget menubar_widget
;
983 menubar_widget
= f
->display
.x
->menubar_widget
;
989 lw_destroy_all_widgets (id
);
994 /* Nonzero if position X, Y relative to inside of frame F
995 is in some other menu bar item. */
997 static int this_menu_bar_item_beg
;
998 static int this_menu_bar_item_end
;
1001 other_menu_bar_item_p (f
, x
, y
)
1006 && y
< f
->display
.x
->menubar_widget
->core
.height
1008 && x
< f
->display
.x
->menubar_widget
->core
.width
1009 && (x
>= this_menu_bar_item_end
1010 || x
< this_menu_bar_item_beg
));
1013 /* Unread a button-press event in the menu bar of frame F
1014 at x position XPOS relative to the inside of the frame. */
1017 unread_menu_bar_button (f
, xpos
)
1023 event
.type
= ButtonPress
;
1024 event
.xbutton
.display
= x_current_display
;
1025 event
.xbutton
.serial
= 0;
1026 event
.xbutton
.send_event
= 0;
1027 event
.xbutton
.time
= CurrentTime
;
1028 event
.xbutton
.button
= Button1
;
1029 event
.xbutton
.window
= XtWindow (f
->display
.x
->menubar_widget
);
1030 event
.xbutton
.x
= xpos
;
1031 XPutBackEvent (XDISPLAY
&event
);
1034 /* If the mouse has moved to another menu bar item,
1035 return 1 and unread a button press event for that item.
1036 Otherwise return 0. */
1039 check_mouse_other_menu_bar (f
)
1043 Lisp_Object bar_window
;
1048 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1050 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1052 unread_menu_bar_button (f
, x
);
1058 #endif /* USE_X_TOOLKIT */
1060 /* xmenu_show actually displays a menu using the panes and items in menu_items
1061 and returns the value selected from it.
1062 There are two versions of xmenu_show, one for Xt and one for Xlib.
1063 Both assume input is blocked by the caller. */
1065 /* F is the frame the menu is for.
1066 X and Y are the frame-relative specified position,
1067 relative to the inside upper left corner of the frame F.
1068 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1069 KEYMAPS is 1 if this menu was specified with keymaps;
1070 in that case, we return a list containing the chosen item's value
1071 and perhaps also the pane's prefix.
1072 TITLE is the specified menu title.
1073 ERROR is a place to store an error message string in case of failure.
1074 (We return nil on failure, but the value doesn't actually matter.) */
1076 #ifdef USE_X_TOOLKIT
1079 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1091 XlwMenuWidget menubar
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
1093 /* This is the menu bar item (if any) that led to this menu. */
1094 widget_value
*menubar_item
= 0;
1096 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1098 /* Define a queue to save up for later unreading
1099 all X events that don't pertain to the menu. */
1103 struct event_queue
*next
;
1106 struct event_queue
*queue
= NULL
;
1107 struct event_queue
*queue_tmp
;
1111 this_menu_bar_item_beg
= -1;
1112 this_menu_bar_item_end
= -1;
1114 /* Figure out which menu bar item, if any, this menu is for. */
1120 for (menubar_item
= menubar
->menu
.old_stack
[0]->contents
;
1122 menubar_item
= menubar_item
->next
)
1125 xend
+= (string_width (menubar
, menubar_item
->name
)
1126 + 2 * (menubar
->menu
.horizontal_spacing
1127 + menubar
->menu
.shadow_thickness
));
1132 /* Arrange to show a different menu if we move in the menu bar
1133 to a different item. */
1134 this_menu_bar_item_beg
= xbeg
;
1135 this_menu_bar_item_end
= xend
;
1140 if (menubar_item
== 0)
1143 /* Offset the coordinates to root-relative. */
1144 x
+= (f
->display
.x
->widget
->core
.x
1145 + f
->display
.x
->widget
->core
.border_width
);
1146 y
+= (f
->display
.x
->widget
->core
.y
1147 + f
->display
.x
->widget
->core
.border_width
1148 + f
->display
.x
->menubar_widget
->core
.height
);
1150 /* Create a tree of widget_value objects
1151 representing the panes and their items. */
1152 wv
= malloc_widget_value ();
1158 /* Loop over all panes and items, filling in the tree. */
1160 while (i
< menu_items_used
)
1162 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1164 /* Create a new pane. */
1165 Lisp_Object pane_name
, prefix
;
1167 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1168 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1169 pane_string
= (NILP (pane_name
)
1170 ? "" : (char *) XSTRING (pane_name
)->data
);
1171 /* If there is just one pane, put all its items directly
1172 under the top-level menu. */
1173 if (menu_items_n_panes
== 1)
1176 /* If the pane has a meaningful name,
1177 make the pane a top-level menu item
1178 with its items as a submenu beneath it. */
1179 if (strcmp (pane_string
, ""))
1181 wv
= malloc_widget_value ();
1185 first_wv
->contents
= wv
;
1186 wv
->name
= pane_string
;
1187 if (keymaps
&& !NILP (prefix
))
1194 i
+= MENU_ITEMS_PANE_LENGTH
;
1198 /* Create a new item within current pane. */
1199 Lisp_Object item_name
, enable
, descrip
;
1200 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1201 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1203 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1205 wv
= malloc_widget_value ();
1209 save_wv
->contents
= wv
;
1210 wv
->name
= XSTRING (item_name
)->data
;
1211 if (!NILP (descrip
))
1212 wv
->key
= XSTRING (descrip
)->data
;
1214 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1215 wv
->enabled
= !NILP (enable
);
1218 i
+= MENU_ITEMS_ITEM_LENGTH
;
1222 /* Actually create the menu. */
1223 menu_id
= ++popup_id_tick
;
1224 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
1225 f
->display
.x
->widget
, 1, 0,
1226 popup_selection_callback
, popup_down_callback
);
1227 /* Free the widget_value objects we used to specify the contents. */
1228 free_menubar_widget_value_tree (first_wv
);
1230 /* No selection has been chosen yet. */
1231 menu_item_selection
= 0;
1233 /* If the mouse moves out of the menu before we show the menu,
1234 don't show it at all. */
1235 if (check_mouse_other_menu_bar (f
))
1237 lw_destroy_all_widgets (menu_id
);
1242 /* Highlight the menu bar item (if any) that led to this menu. */
1245 menubar_item
->call_data
= (XtPointer
) 1;
1246 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1249 /* Display the menu. */
1251 XButtonPressedEvent dummy
;
1254 mw
= (XlwMenuWidget
) ((CompositeWidget
)menu
)->composite
.children
[0];
1256 dummy
.type
= ButtonPress
;
1258 dummy
.send_event
= 0;
1259 dummy
.display
= XtDisplay (menu
);
1260 dummy
.window
= XtWindow (XtParent (menu
));
1261 dummy
.time
= CurrentTime
;
1266 /* We activate directly the lucid implementation. */
1267 pop_up_menu (mw
, &dummy
);
1270 /* Check again whether the mouse has moved to another menu bar item. */
1271 if (check_mouse_other_menu_bar (f
))
1273 /* The mouse moved into a different menu bar item.
1274 We should bring up that item's menu instead.
1275 First pop down this menu. */
1276 XtUngrabPointer ((Widget
)
1278 ((CompositeWidget
)menu
)->composite
.children
[0]),
1280 lw_destroy_all_widgets (menu_id
);
1284 /* Process events that apply to the menu. */
1289 XtAppNextEvent (Xt_app_con
, &event
);
1290 if (event
.type
== ButtonRelease
)
1292 XtDispatchEvent (&event
);
1295 else if (event
.type
== Expose
)
1296 process_expose_from_menu (event
);
1297 else if (event
.type
== MotionNotify
)
1299 int event_x
= (event
.xmotion
.x_root
1300 - (f
->display
.x
->widget
->core
.x
1301 + f
->display
.x
->widget
->core
.border_width
));
1302 int event_y
= (event
.xmotion
.y_root
1303 - (f
->display
.x
->widget
->core
.y
1304 + f
->display
.x
->widget
->core
.border_width
));
1306 if (other_menu_bar_item_p (f
, event_x
, event_y
))
1308 /* The mouse moved into a different menu bar item.
1309 We should bring up that item's menu instead.
1310 First pop down this menu. */
1311 XtUngrabPointer ((Widget
)
1313 ((CompositeWidget
)menu
)->composite
.children
[0]),
1314 event
.xbutton
.time
);
1315 lw_destroy_all_widgets (menu_id
);
1317 /* Put back an event that will bring up the other item's menu. */
1318 unread_menu_bar_button (f
, event_x
);
1319 /* Don't let us select anything in this case. */
1320 menu_item_selection
= 0;
1325 XtDispatchEvent (&event
);
1326 if (XtWindowToWidget(event
.xany
.window
) != menu
)
1328 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1330 if (queue_tmp
!= NULL
)
1332 queue_tmp
->event
= event
;
1333 queue_tmp
->next
= queue
;
1340 /* Unhighlight the menu bar item (if any) that led to this menu. */
1343 menubar_item
->call_data
= (XtPointer
) 0;
1344 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1347 /* Make sure the menu disappears. */
1348 lw_destroy_all_widgets (menu_id
);
1350 /* Unread any events that we got but did not handle. */
1351 while (queue
!= NULL
)
1354 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1355 queue
= queue_tmp
->next
;
1356 free ((char *)queue_tmp
);
1359 /* Find the selected item, and its pane, to return
1360 the proper value. */
1361 if (menu_item_selection
!= 0)
1367 while (i
< menu_items_used
)
1371 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1374 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1375 i
+= MENU_ITEMS_PANE_LENGTH
;
1380 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1381 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1385 entry
= Fcons (entry
, Qnil
);
1387 entry
= Fcons (prefix
, entry
);
1391 i
+= MENU_ITEMS_ITEM_LENGTH
;
1399 #else /* not USE_X_TOOLKIT */
1402 xmenu_show (f
, x
, y
, menubarp
, keymaps
, title
, error
)
1412 int pane
, selidx
, lpane
, status
;
1413 Lisp_Object entry
, pane_prefix
;
1415 int ulx
, uly
, width
, height
;
1416 int dispwidth
, dispheight
;
1419 unsigned int dummy_uint
;
1422 if (menu_items_n_panes
== 0)
1425 /* Figure out which root window F is on. */
1426 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
1427 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
1428 &dummy_uint
, &dummy_uint
);
1430 /* Make the menu on that window. */
1431 menu
= XMenuCreate (XDISPLAY root
, "emacs");
1434 *error
= "Can't create menu";
1438 /* Adjust coordinates to relative to the outer (window manager) window. */
1442 int win_x
= 0, win_y
= 0;
1444 /* Find the position of the outside upper-left corner of
1445 the inner window, with respect to the outer window. */
1446 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
1449 XTranslateCoordinates (x_current_display
,
1451 /* From-window, to-window. */
1452 f
->display
.x
->window_desc
,
1453 f
->display
.x
->parent_desc
,
1455 /* From-position, to-position. */
1456 0, 0, &win_x
, &win_y
,
1458 /* Child of window. */
1465 #endif /* HAVE_X11 */
1467 /* Adjust coordinates to be root-window-relative. */
1468 x
+= f
->display
.x
->left_pos
;
1469 y
+= f
->display
.x
->top_pos
;
1471 /* Create all the necessary panes and their items. */
1473 while (i
< menu_items_used
)
1475 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1477 /* Create a new pane. */
1478 Lisp_Object pane_name
, prefix
;
1481 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1482 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1483 pane_string
= (NILP (pane_name
)
1484 ? "" : (char *) XSTRING (pane_name
)->data
);
1485 if (keymaps
&& !NILP (prefix
))
1488 lpane
= XMenuAddPane (XDISPLAY menu
, pane_string
, TRUE
);
1489 if (lpane
== XM_FAILURE
)
1491 XMenuDestroy (XDISPLAY menu
);
1492 *error
= "Can't create pane";
1495 i
+= MENU_ITEMS_PANE_LENGTH
;
1499 /* Create a new item within current pane. */
1500 Lisp_Object item_name
, enable
, descrip
;
1502 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1503 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1505 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1506 if (!NILP (descrip
))
1507 item_name
= concat2 (item_name
, descrip
);
1509 if (XMenuAddSelection (XDISPLAY menu
, lpane
, 0,
1510 XSTRING (item_name
)->data
,
1514 XMenuDestroy (XDISPLAY menu
);
1515 *error
= "Can't add selection to menu";
1518 i
+= MENU_ITEMS_ITEM_LENGTH
;
1522 /* All set and ready to fly. */
1523 XMenuRecompute (XDISPLAY menu
);
1524 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
1525 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
1526 x
= min (x
, dispwidth
);
1527 y
= min (y
, dispheight
);
1530 XMenuLocate (XDISPLAY menu
, 0, 0, x
, y
,
1531 &ulx
, &uly
, &width
, &height
);
1532 if (ulx
+width
> dispwidth
)
1534 x
-= (ulx
+ width
) - dispwidth
;
1535 ulx
= dispwidth
- width
;
1537 if (uly
+height
> dispheight
)
1539 y
-= (uly
+ height
) - dispheight
;
1540 uly
= dispheight
- height
;
1542 if (ulx
< 0) x
-= ulx
;
1543 if (uly
< 0) y
-= uly
;
1545 XMenuSetFreeze (menu
, TRUE
);
1548 status
= XMenuActivate (XDISPLAY menu
, &pane
, &selidx
,
1549 x
, y
, ButtonReleaseMask
, &datap
);
1554 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
1557 /* Find the item number SELIDX in pane number PANE. */
1559 while (i
< menu_items_used
)
1561 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1565 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1567 i
+= MENU_ITEMS_PANE_LENGTH
;
1576 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1579 entry
= Fcons (entry
, Qnil
);
1580 if (!NILP (pane_prefix
))
1581 entry
= Fcons (pane_prefix
, entry
);
1587 i
+= MENU_ITEMS_ITEM_LENGTH
;
1593 XMenuDestroy (XDISPLAY menu
);
1594 *error
= "Can't activate menu";
1600 XMenuDestroy (XDISPLAY menu
);
1603 #endif /* not USE_X_TOOLKIT */
1607 staticpro (&menu_items
);
1610 popup_id_tick
= (1<<16);
1611 defsubr (&Sx_popup_menu
);