1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* X pop-up deck-of-cards menu facility for gnuemacs.
23 * Written by Jon Arnold and Roman Budzianowski
24 * Mods and rewrite by Robert Krawitz
28 /* Modified by Fred Pierresteguy on December 93
29 to make the popup menus and menubar use the Xt. */
31 /* Rewritten for clarity and GC protection by rms in Feb 94. */
33 /* On 4.3 this loses if it comes after xterm.h. */
39 #include "termhooks.h"
43 #include "blockinput.h"
51 /* This may include sys/types.h, and that somehow loses
52 if this is not done before the other system files. */
56 /* Load sys/types.h if not already loaded.
57 In some systems loading it twice is suicidal. */
59 #include <sys/types.h>
62 #include "dispextern.h"
65 #undef HAVE_MULTILINGUAL_MENU
68 #include <X11/IntrinsicP.h>
69 #include <X11/CoreP.h>
70 #include <X11/StringDefs.h>
71 #include <X11/Shell.h>
73 #include <X11/Xaw/Paned.h>
74 #endif /* USE_LUCID */
75 #include "../lwlib/lwlib.h"
76 #else /* not USE_X_TOOLKIT */
77 #include "../oldXMenu/XMenu.h"
78 #endif /* not USE_X_TOOLKIT */
79 #endif /* HAVE_X_WINDOWS */
82 #include <Xm/Xm.h> /* for LESSTIF_VERSION */
85 #define min(x,y) (((x) < (y)) ? (x) : (y))
86 #define max(x,y) (((x) > (y)) ? (x) : (y))
93 Lisp_Object Vmenu_updating_frame
;
95 Lisp_Object Qdebug_on_next_call
;
97 extern Lisp_Object Qmenu_bar
;
98 extern Lisp_Object Qmouse_click
, Qevent_kind
;
100 extern Lisp_Object QCtoggle
, QCradio
;
102 extern Lisp_Object Voverriding_local_map
;
103 extern Lisp_Object Voverriding_local_map_menu_flag
;
105 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
107 extern Lisp_Object Qmenu_bar_update_hook
;
110 extern void set_frame_menubar ();
111 extern void process_expose_from_menu ();
112 extern XtAppContext Xt_app_con
;
114 static Lisp_Object
xdialog_show ();
115 void popup_get_selection ();
120 /* Define HAVE_BOXES if meus can handle radio and toggle buttons. */
125 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
126 Lisp_Object
, Lisp_Object
, Lisp_Object
,
128 static Lisp_Object
xmenu_show ();
129 static void keymap_panes ();
130 static void single_keymap_panes ();
131 static void single_menu_item ();
132 static void list_of_panes ();
133 static void list_of_items ();
135 /* This holds a Lisp vector that holds the results of decoding
136 the keymaps or alist-of-alists that specify a menu.
138 It describes the panes and items within the panes.
140 Each pane is described by 3 elements in the vector:
141 t, the pane name, the pane's prefix key.
142 Then follow the pane's items, with 5 elements per item:
143 the item string, the enable flag, the item's value,
144 the definition, and the equivalent keyboard key's description string.
146 In some cases, multiple levels of menus may be described.
147 A single vector slot containing nil indicates the start of a submenu.
148 A single vector slot containing lambda indicates the end of a submenu.
149 The submenu follows a menu item which is the way to reach the submenu.
151 A single vector slot containing quote indicates that the
152 following items should appear on the right of a dialog box.
154 Using a Lisp vector to hold this information while we decode it
155 takes care of protecting all the data from GC. */
157 #define MENU_ITEMS_PANE_NAME 1
158 #define MENU_ITEMS_PANE_PREFIX 2
159 #define MENU_ITEMS_PANE_LENGTH 3
161 #define MENU_ITEMS_ITEM_NAME 0
162 #define MENU_ITEMS_ITEM_ENABLE 1
163 #define MENU_ITEMS_ITEM_VALUE 2
164 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
165 #define MENU_ITEMS_ITEM_DEFINITION 4
166 #define MENU_ITEMS_ITEM_TYPE 5
167 #define MENU_ITEMS_ITEM_SELECTED 6
168 #define MENU_ITEMS_ITEM_LENGTH 7
170 static Lisp_Object menu_items
;
172 /* Number of slots currently allocated in menu_items. */
173 static int menu_items_allocated
;
175 /* This is the index in menu_items of the first empty slot. */
176 static int menu_items_used
;
178 /* The number of panes currently recorded in menu_items,
179 excluding those within submenus. */
180 static int menu_items_n_panes
;
182 /* Current depth within submenus. */
183 static int menu_items_submenu_depth
;
185 /* Flag which when set indicates a dialog or menu has been posted by
186 Xt on behalf of one of the widget sets. */
187 static int popup_activated_flag
;
189 static int next_menubar_widget_id
;
191 /* This is set nonzero after the user activates the menu bar, and set
192 to zero again after the menu bars are redisplayed by prepare_menu_bar.
193 While it is nonzero, all calls to set_frame_menubar go deep.
195 I don't understand why this is needed, but it does seem to be
196 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
198 int pending_menu_activation
;
202 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
204 static struct frame
*
205 menubar_id_to_frame (id
)
208 Lisp_Object tail
, frame
;
211 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
213 frame
= XCONS (tail
)->car
;
214 if (!GC_FRAMEP (frame
))
217 if (f
->output_data
.nothing
== 1)
219 if (f
->output_data
.x
->id
== id
)
227 /* Initialize the menu_items structure if we haven't already done so.
228 Also mark it as currently empty. */
233 if (NILP (menu_items
))
235 menu_items_allocated
= 60;
236 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
240 menu_items_n_panes
= 0;
241 menu_items_submenu_depth
= 0;
244 /* Call at the end of generating the data in menu_items.
245 This fills in the number of items in the last pane. */
252 /* Call when finished using the data for the current menu
256 discard_menu_items ()
258 /* Free the structure if it is especially large.
259 Otherwise, hold on to it, to save time. */
260 if (menu_items_allocated
> 200)
263 menu_items_allocated
= 0;
267 /* Make the menu_items vector twice as large. */
273 int old_size
= menu_items_allocated
;
276 menu_items_allocated
*= 2;
277 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
278 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
279 old_size
* sizeof (Lisp_Object
));
282 /* Begin a submenu. */
285 push_submenu_start ()
287 if (menu_items_used
+ 1 > menu_items_allocated
)
290 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
291 menu_items_submenu_depth
++;
299 if (menu_items_used
+ 1 > menu_items_allocated
)
302 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
303 menu_items_submenu_depth
--;
306 /* Indicate boundary between left and right. */
309 push_left_right_boundary ()
311 if (menu_items_used
+ 1 > menu_items_allocated
)
314 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
317 /* Start a new menu pane in menu_items..
318 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
321 push_menu_pane (name
, prefix_vec
)
322 Lisp_Object name
, prefix_vec
;
324 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
327 if (menu_items_submenu_depth
== 0)
328 menu_items_n_panes
++;
329 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
330 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
331 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
334 /* Push one menu item into the current pane. NAME is the string to
335 display. ENABLE if non-nil means this item can be selected. KEY
336 is the key generated by choosing this item, or nil if this item
337 doesn't really have a definition. DEF is the definition of this
338 item. EQUIV is the textual description of the keyboard equivalent
339 for this item (or nil if none). TYPE is the type of this menu
340 item, one of nil, `toggle' or `radio'. */
343 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
)
344 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
;
346 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
349 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
350 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
351 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
352 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
353 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
354 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
355 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
358 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
359 and generate menu panes for them in menu_items.
360 If NOTREAL is nonzero,
361 don't bother really computing whether an item is enabled. */
364 keymap_panes (keymaps
, nmaps
, notreal
)
365 Lisp_Object
*keymaps
;
373 /* Loop over the given keymaps, making a pane for each map.
374 But don't make a pane that is empty--ignore that map instead.
375 P is the number of panes we have made so far. */
376 for (mapno
= 0; mapno
< nmaps
; mapno
++)
377 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
, 10);
379 finish_menu_items ();
382 /* This is a recursive subroutine of keymap_panes.
383 It handles one keymap, KEYMAP.
384 The other arguments are passed along
385 or point to local variables of the previous function.
386 If NOTREAL is nonzero, only check for equivalent key bindings, don't
387 evaluate expressions in menu items and don't make any menu.
389 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
392 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
394 Lisp_Object pane_name
;
399 Lisp_Object pending_maps
= Qnil
;
400 Lisp_Object tail
, item
;
401 struct gcpro gcpro1
, gcpro2
;
407 push_menu_pane (pane_name
, prefix
);
410 /* Remember index for first item in this pane so we can go back and
411 add a prefix when (if) we see the first button. After that, notbuttons
412 is set to 0, to mark that we have seen a button and all non button
413 items need a prefix. */
414 notbuttons
= menu_items_used
;
417 for (tail
= keymap
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
419 GCPRO2 (keymap
, pending_maps
);
420 /* Look at each key binding, and if it is a menu item add it
422 item
= XCONS (tail
)->car
;
424 single_menu_item (XCONS (item
)->car
, XCONS (item
)->cdr
,
425 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
426 else if (VECTORP (item
))
428 /* Loop over the char values represented in the vector. */
429 int len
= XVECTOR (item
)->size
;
431 for (c
= 0; c
< len
; c
++)
433 Lisp_Object character
;
434 XSETFASTINT (character
, c
);
435 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
436 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
442 /* Process now any submenus which want to be panes at this level. */
443 while (!NILP (pending_maps
))
445 Lisp_Object elt
, eltcdr
, string
;
446 elt
= Fcar (pending_maps
);
447 eltcdr
= XCONS (elt
)->cdr
;
448 string
= XCONS (eltcdr
)->car
;
449 /* We no longer discard the @ from the beginning of the string here.
450 Instead, we do this in xmenu_show. */
451 single_keymap_panes (Fcar (elt
), string
,
452 XCONS (eltcdr
)->cdr
, notreal
, maxdepth
- 1);
453 pending_maps
= Fcdr (pending_maps
);
457 /* This is a subroutine of single_keymap_panes that handles one
459 KEY is a key in a keymap and ITEM is its binding.
460 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
462 If NOTREAL is nonzero, only check for equivalent key bindings, don't
463 evaluate expressions in menu items and don't make any menu.
464 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
465 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
466 buttons. It points to variable notbuttons in single_keymap_panes,
467 which keeps track of if we have seen a button in this menu or not. */
470 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
,
472 Lisp_Object key
, item
;
473 Lisp_Object
*pending_maps_ptr
;
474 int maxdepth
, notreal
;
477 Lisp_Object def
, map
, item_string
, enabled
;
478 struct gcpro gcpro1
, gcpro2
;
481 /* Parse the menu item and leave the result in item_properties. */
483 res
= parse_menu_item (item
, notreal
, 0);
486 return; /* Not a menu item. */
488 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
492 /* We don't want to make a menu, just traverse the keymaps to
493 precompute equivalent key bindings. */
495 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
499 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
500 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
502 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
505 /* An enabled separate pane. Remember this to handle it later. */
506 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
512 /* Simulate radio buttons and toggle boxes by putting a prefix in
515 Lisp_Object prefix
= Qnil
;
516 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
520 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
523 /* The first button. Line up previous items in this menu. */
525 int index
= *notbuttons_ptr
; /* Index for first item this menu. */
528 while (index
< menu_items_used
)
531 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
535 submenu
++; /* Skip sub menu. */
537 else if (EQ (tem
, Qlambda
))
540 submenu
--; /* End sub menu. */
542 else if (EQ (tem
, Qt
))
543 index
+= 3; /* Skip new pane marker. */
544 else if (EQ (tem
, Qquote
))
545 index
++; /* Skip a left, right divider. */
548 if (!submenu
&& XSTRING (tem
)->data
[0] != '\0'
549 && XSTRING (tem
)->data
[0] != '-')
550 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
551 = concat2 (build_string (" "), tem
);
552 index
+= MENU_ITEMS_ITEM_LENGTH
;
558 /* Calculate prefix, if any, for this item. */
559 if (EQ (type
, QCtoggle
))
560 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
561 else if (EQ (type
, QCradio
))
562 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
564 /* Not a button. If we have earlier buttons, then we need a prefix. */
565 else if (!*notbuttons_ptr
&& XSTRING (item_string
)->data
[0] != '\0'
566 && XSTRING (item_string
)->data
[0] != '-')
567 prefix
= build_string (" ");
570 item_string
= concat2 (prefix
, item_string
);
572 #endif /* not HAVE_BOXES */
574 #ifndef USE_X_TOOLKIT
576 /* Indicate visually that this is a submenu. */
577 item_string
= concat2 (item_string
, build_string (" >"));
580 push_menu_item (item_string
, enabled
, key
,
581 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
582 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
583 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
584 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
]);
587 /* Display a submenu using the toolkit. */
588 if (! (NILP (map
) || NILP (enabled
)))
590 push_submenu_start ();
591 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
597 /* Push all the panes and items of a menu described by the
598 alist-of-alists MENU.
599 This handles old-fashioned calls to x-popup-menu. */
609 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
611 Lisp_Object elt
, pane_name
, pane_data
;
613 pane_name
= Fcar (elt
);
614 CHECK_STRING (pane_name
, 0);
615 push_menu_pane (pane_name
, Qnil
);
616 pane_data
= Fcdr (elt
);
617 CHECK_CONS (pane_data
, 0);
618 list_of_items (pane_data
);
621 finish_menu_items ();
624 /* Push the items in a single pane defined by the alist PANE. */
630 Lisp_Object tail
, item
, item1
;
632 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
636 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
);
637 else if (NILP (item
))
638 push_left_right_boundary ();
641 CHECK_CONS (item
, 0);
643 CHECK_STRING (item1
, 1);
644 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
);
649 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
650 "Pop up a deck-of-cards menu and return user's selection.\n\
651 POSITION is a position specification. This is either a mouse button event\n\
652 or a list ((XOFFSET YOFFSET) WINDOW)\n\
653 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
654 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
655 This controls the position of the center of the first line\n\
656 in the first pane of the menu, not the top left of the menu as a whole.\n\
657 If POSITION is t, it means to use the current mouse position.\n\
659 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
660 The menu items come from key bindings that have a menu string as well as\n\
661 a definition; actually, the \"definition\" in such a key binding looks like\n\
662 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
663 the keymap as a top-level element.\n\n\
664 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
665 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
667 You can also use a list of keymaps as MENU.\n\
668 Then each keymap makes a separate pane.\n\
669 When MENU is a keymap or a list of keymaps, the return value\n\
670 is a list of events.\n\n\
672 Alternatively, you can specify a menu of multiple panes\n\
673 with a list of the form (TITLE PANE1 PANE2...),\n\
674 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
675 Each ITEM is normally a cons cell (STRING . VALUE);\n\
676 but a string can appear as an item--that makes a nonselectable line\n\
678 With this form of menu, the return value is VALUE from the chosen item.\n\
680 If POSITION is nil, don't display the menu at all, just precalculate the\n\
681 cached information about equivalent key sequences.")
683 Lisp_Object position
, menu
;
685 int number_of_panes
, panes
;
686 Lisp_Object keymap
, tem
;
690 Lisp_Object selection
;
693 Lisp_Object x
, y
, window
;
699 if (! NILP (position
))
703 /* Decode the first argument: find the window and the coordinates. */
704 if (EQ (position
, Qt
)
705 || (CONSP (position
) && EQ (XCONS (position
)->car
, Qmenu_bar
)))
707 /* Use the mouse's current position. */
708 FRAME_PTR new_f
= selected_frame
;
709 Lisp_Object bar_window
;
710 enum scroll_bar_part part
;
713 if (mouse_position_hook
)
714 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
715 &part
, &x
, &y
, &time
);
717 XSETFRAME (window
, new_f
);
720 window
= selected_window
;
727 tem
= Fcar (position
);
730 window
= Fcar (Fcdr (position
));
732 y
= Fcar (Fcdr (tem
));
737 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
738 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
739 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
748 /* Decode where to put the menu. */
756 else if (WINDOWP (window
))
758 CHECK_LIVE_WINDOW (window
, 0);
759 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
761 xpos
= (FONT_WIDTH (f
->output_data
.x
->font
)
762 * XFASTINT (XWINDOW (window
)->left
));
763 ypos
= (f
->output_data
.x
->line_height
764 * XFASTINT (XWINDOW (window
)->top
));
767 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
768 but I don't want to make one now. */
769 CHECK_WINDOW (window
, 0);
774 XSETFRAME (Vmenu_updating_frame
, f
);
776 Vmenu_updating_frame
= Qnil
;
777 #endif /* HAVE_MENUS */
782 /* Decode the menu items from what was specified. */
784 keymap
= Fkeymapp (menu
);
787 tem
= Fkeymapp (Fcar (menu
));
790 /* We were given a keymap. Extract menu info from the keymap. */
792 keymap
= get_keymap (menu
);
794 /* Extract the detailed info to make one pane. */
795 keymap_panes (&menu
, 1, NILP (position
));
797 /* Search for a string appearing directly as an element of the keymap.
798 That string is the title of the menu. */
799 prompt
= map_prompt (keymap
);
800 if (NILP (title
) && !NILP (prompt
))
803 /* Make that be the pane title of the first pane. */
804 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
805 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
809 else if (!NILP (tem
))
811 /* We were given a list of keymaps. */
812 int nmaps
= XFASTINT (Flength (menu
));
814 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
819 /* The first keymap that has a prompt string
820 supplies the menu title. */
821 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
825 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
827 prompt
= map_prompt (keymap
);
828 if (NILP (title
) && !NILP (prompt
))
832 /* Extract the detailed info to make one pane. */
833 keymap_panes (maps
, nmaps
, NILP (position
));
835 /* Make the title be the pane title of the first pane. */
836 if (!NILP (title
) && menu_items_n_panes
>= 0)
837 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
843 /* We were given an old-fashioned menu. */
845 CHECK_STRING (title
, 1);
847 list_of_panes (Fcdr (menu
));
854 discard_menu_items ();
860 /* Display them in a menu. */
863 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
864 keymaps
, title
, &error_name
);
867 discard_menu_items ();
870 #endif /* HAVE_MENUS */
872 if (error_name
) error (error_name
);
878 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
879 "Pop up a dialog box and return user's selection.\n\
880 POSITION specifies which frame to use.\n\
881 This is normally a mouse button event or a window or frame.\n\
882 If POSITION is t, it means to use the frame the mouse is on.\n\
883 The dialog box appears in the middle of the specified frame.\n\
885 CONTENTS specifies the alternatives to display in the dialog box.\n\
886 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
887 Each ITEM is a cons cell (STRING . VALUE).\n\
888 The return value is VALUE from the chosen item.\n\n\
889 An ITEM may also be just a string--that makes a nonselectable item.\n\
890 An ITEM may also be nil--that means to put all preceding items\n\
891 on the left of the dialog box and all following items on the right.\n\
892 \(By default, approximately half appear on each side.)")
894 Lisp_Object position
, contents
;
901 /* Decode the first argument: find the window or frame to use. */
902 if (EQ (position
, Qt
)
903 || (CONSP (position
) && EQ (XCONS (position
)->car
, Qmenu_bar
)))
905 #if 0 /* Using the frame the mouse is on may not be right. */
906 /* Use the mouse's current position. */
907 FRAME_PTR new_f
= selected_frame
;
908 Lisp_Object bar_window
;
913 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
916 XSETFRAME (window
, new_f
);
918 window
= selected_window
;
920 window
= selected_window
;
922 else if (CONSP (position
))
925 tem
= Fcar (position
);
927 window
= Fcar (Fcdr (position
));
930 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
931 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
934 else if (WINDOWP (position
) || FRAMEP (position
))
939 /* Decode where to put the menu. */
943 else if (WINDOWP (window
))
945 CHECK_LIVE_WINDOW (window
, 0);
946 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
949 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
950 but I don't want to make one now. */
951 CHECK_WINDOW (window
, 0);
953 #ifndef USE_X_TOOLKIT
954 /* Display a menu with these alternatives
955 in the middle of frame F. */
957 Lisp_Object x
, y
, frame
, newpos
;
958 XSETFRAME (frame
, f
);
959 XSETINT (x
, x_pixel_width (f
) / 2);
960 XSETINT (y
, x_pixel_height (f
) / 2);
961 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
963 return Fx_popup_menu (newpos
,
964 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
970 Lisp_Object selection
;
972 /* Decode the dialog items from what was specified. */
973 title
= Fcar (contents
);
974 CHECK_STRING (title
, 1);
976 list_of_panes (Fcons (contents
, Qnil
));
978 /* Display them in a dialog box. */
980 selection
= xdialog_show (f
, 0, title
, &error_name
);
983 discard_menu_items ();
985 if (error_name
) error (error_name
);
993 /* Loop in Xt until the menu pulldown or dialog popup has been
994 popped down (deactivated). This is used for x-popup-menu
995 and x-popup-dialog; it is not used for the menu bar any more.
997 NOTE: All calls to popup_get_selection should be protected
998 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1001 popup_get_selection (initial_event
, dpyinfo
, id
)
1002 XEvent
*initial_event
;
1003 struct x_display_info
*dpyinfo
;
1008 /* Define a queue to save up for later unreading
1009 all X events that don't pertain to the menu. */
1013 struct event_queue
*next
;
1016 struct event_queue
*queue
= NULL
;
1017 struct event_queue
*queue_tmp
;
1020 event
= *initial_event
;
1022 XtAppNextEvent (Xt_app_con
, &event
);
1026 /* Handle expose events for editor frames right away. */
1027 if (event
.type
== Expose
)
1028 process_expose_from_menu (event
);
1029 /* Make sure we don't consider buttons grabbed after menu goes.
1030 And make sure to deactivate for any ButtonRelease,
1031 even if XtDispatchEvent doesn't do that. */
1032 else if (event
.type
== ButtonRelease
1033 && dpyinfo
->display
== event
.xbutton
.display
)
1035 dpyinfo
->grabbed
&= ~(1 << event
.xbutton
.button
);
1036 popup_activated_flag
= 0;
1037 #ifdef USE_MOTIF /* Pretending that the event came from a
1038 Btn1Down seems the only way to convince Motif to
1039 activate its callbacks; setting the XmNmenuPost
1040 isn't working. --marcus@sysc.pdx.edu. */
1041 event
.xbutton
.button
= 1;
1044 /* If the user presses a key, deactivate the menu.
1045 The user is likely to do that if we get wedged. */
1046 else if (event
.type
== KeyPress
1047 && dpyinfo
->display
== event
.xbutton
.display
)
1049 KeySym keysym
= XLookupKeysym (&event
.xkey
, 0);
1050 if (!IsModifierKey (keysym
))
1052 popup_activated_flag
= 0;
1056 /* Button presses outside the menu also pop it down. */
1057 else if (event
.type
== ButtonPress
1058 && event
.xany
.display
== dpyinfo
->display
1059 && x_any_window_to_frame (dpyinfo
, event
.xany
.window
))
1061 popup_activated_flag
= 0;
1065 /* Queue all events not for this popup,
1066 except for Expose, which we've already handled, and ButtonRelease.
1067 Note that the X window is associated with the frame if this
1068 is a menu bar popup, but not if it's a dialog box. So we use
1069 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1070 if (event
.type
!= Expose
1071 && !(event
.type
== ButtonRelease
1072 && dpyinfo
->display
== event
.xbutton
.display
)
1073 && (event
.xany
.display
!= dpyinfo
->display
1074 || x_non_menubar_window_to_frame (dpyinfo
, event
.xany
.window
)))
1076 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1078 if (queue_tmp
!= NULL
)
1080 queue_tmp
->event
= event
;
1081 queue_tmp
->next
= queue
;
1086 XtDispatchEvent (&event
);
1088 if (!popup_activated ())
1090 XtAppNextEvent (Xt_app_con
, &event
);
1093 /* Unread any events that we got but did not handle. */
1094 while (queue
!= NULL
)
1097 XPutBackEvent (queue_tmp
->event
.xany
.display
, &queue_tmp
->event
);
1098 queue
= queue_tmp
->next
;
1099 free ((char *)queue_tmp
);
1100 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1101 interrupt_input_pending
= 1;
1105 /* Activate the menu bar of frame F.
1106 This is called from keyboard.c when it gets the
1107 menu_bar_activate_event out of the Emacs event queue.
1109 To activate the menu bar, we use the X button-press event
1110 that was saved in saved_menu_event.
1111 That makes the toolkit do its thing.
1113 But first we recompute the menu bar contents (the whole tree).
1115 The reason for saving the button event until here, instead of
1116 passing it to the toolkit right away, is that we can safely
1117 execute Lisp code. */
1120 x_activate_menubar (f
)
1123 if (!f
->output_data
.x
->saved_menu_event
->type
)
1126 set_frame_menubar (f
, 0, 1);
1128 XtDispatchEvent ((XEvent
*) f
->output_data
.x
->saved_menu_event
);
1131 if (f
->output_data
.x
->saved_menu_event
->type
== ButtonRelease
)
1132 pending_menu_activation
= 1;
1135 /* Ignore this if we get it a second time. */
1136 f
->output_data
.x
->saved_menu_event
->type
= 0;
1139 /* Detect if a dialog or menu has been posted. */
1144 return popup_activated_flag
;
1148 /* This callback is invoked when the user selects a menubar cascade
1149 pushbutton, but before the pulldown menu is posted. */
1152 popup_activate_callback (widget
, id
, client_data
)
1155 XtPointer client_data
;
1157 popup_activated_flag
= 1;
1160 /* This callback is called from the menu bar pulldown menu
1161 when the user makes a selection.
1162 Figure out what the user chose
1163 and put the appropriate events into the keyboard buffer. */
1166 menubar_selection_callback (widget
, id
, client_data
)
1169 XtPointer client_data
;
1171 Lisp_Object prefix
, entry
;
1172 FRAME_PTR f
= menubar_id_to_frame (id
);
1174 Lisp_Object
*subprefix_stack
;
1175 int submenu_depth
= 0;
1180 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1181 vector
= f
->menu_bar_vector
;
1184 while (i
< f
->menu_bar_items_used
)
1186 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1188 subprefix_stack
[submenu_depth
++] = prefix
;
1192 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1194 prefix
= subprefix_stack
[--submenu_depth
];
1197 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1199 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1200 i
+= MENU_ITEMS_PANE_LENGTH
;
1204 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1205 /* The EMACS_INT cast avoids a warning. There's no problem
1206 as long as pointers have enough bits to hold small integers. */
1207 if ((int) (EMACS_INT
) client_data
== i
)
1210 struct input_event buf
;
1213 XSETFRAME (frame
, f
);
1214 buf
.kind
= menu_bar_event
;
1215 buf
.frame_or_window
= Fcons (frame
, Fcons (Qmenu_bar
, Qnil
));
1216 kbd_buffer_store_event (&buf
);
1218 for (j
= 0; j
< submenu_depth
; j
++)
1219 if (!NILP (subprefix_stack
[j
]))
1221 buf
.kind
= menu_bar_event
;
1222 buf
.frame_or_window
= Fcons (frame
, subprefix_stack
[j
]);
1223 kbd_buffer_store_event (&buf
);
1228 buf
.kind
= menu_bar_event
;
1229 buf
.frame_or_window
= Fcons (frame
, prefix
);
1230 kbd_buffer_store_event (&buf
);
1233 buf
.kind
= menu_bar_event
;
1234 buf
.frame_or_window
= Fcons (frame
, entry
);
1235 kbd_buffer_store_event (&buf
);
1239 i
+= MENU_ITEMS_ITEM_LENGTH
;
1244 /* This callback is invoked when a dialog or menu is finished being
1245 used and has been unposted. */
1248 popup_deactivate_callback (widget
, id
, client_data
)
1251 XtPointer client_data
;
1253 popup_activated_flag
= 0;
1256 /* Allocate a widget_value, blocking input. */
1259 xmalloc_widget_value ()
1261 widget_value
*value
;
1264 value
= malloc_widget_value ();
1270 /* This recursively calls free_widget_value on the tree of widgets.
1271 It must free all data that was malloc'ed for these widget_values.
1272 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1273 must be left alone. */
1276 free_menubar_widget_value_tree (wv
)
1281 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1283 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1285 free_menubar_widget_value_tree (wv
->contents
);
1286 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1290 free_menubar_widget_value_tree (wv
->next
);
1291 wv
->next
= (widget_value
*) 0xDEADBEEF;
1294 free_widget_value (wv
);
1298 /* Return a tree of widget_value structures for a menu bar item
1299 whose event type is ITEM_KEY (with string ITEM_NAME)
1300 and whose contents come from the list of keymaps MAPS. */
1302 static widget_value
*
1303 single_submenu (item_key
, item_name
, maps
)
1304 Lisp_Object item_key
, item_name
, maps
;
1306 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1308 int submenu_depth
= 0;
1311 Lisp_Object
*mapvec
;
1312 widget_value
**submenu_stack
;
1314 int previous_items
= menu_items_used
;
1315 int top_level_items
= 0;
1317 length
= Flength (maps
);
1318 len
= XINT (length
);
1320 /* Convert the list MAPS into a vector MAPVEC. */
1321 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1322 for (i
= 0; i
< len
; i
++)
1324 mapvec
[i
] = Fcar (maps
);
1328 menu_items_n_panes
= 0;
1330 /* Loop over the given keymaps, making a pane for each map.
1331 But don't make a pane that is empty--ignore that map instead. */
1332 for (i
= 0; i
< len
; i
++)
1334 if (SYMBOLP (mapvec
[i
])
1335 || (CONSP (mapvec
[i
])
1336 && NILP (Fkeymapp (mapvec
[i
]))))
1338 /* Here we have a command at top level in the menu bar
1339 as opposed to a submenu. */
1340 top_level_items
= 1;
1341 push_menu_pane (Qnil
, Qnil
);
1342 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
], Qnil
, Qnil
, Qnil
);
1345 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1348 /* Create a tree of widget_value objects
1349 representing the panes and their items. */
1352 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1353 wv
= xmalloc_widget_value ();
1357 wv
->button_type
= BUTTON_TYPE_NONE
;
1362 /* Loop over all panes and items made during this call
1363 and construct a tree of widget_value objects.
1364 Ignore the panes and items made by previous calls to
1365 single_submenu, even though those are also in menu_items. */
1367 while (i
< menu_items_used
)
1369 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1371 submenu_stack
[submenu_depth
++] = save_wv
;
1376 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1379 save_wv
= submenu_stack
[--submenu_depth
];
1382 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1383 && submenu_depth
!= 0)
1384 i
+= MENU_ITEMS_PANE_LENGTH
;
1385 /* Ignore a nil in the item list.
1386 It's meaningful only for dialog boxes. */
1387 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1389 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1391 /* Create a new pane. */
1392 Lisp_Object pane_name
, prefix
;
1394 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1395 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1396 #ifndef HAVE_MULTILINGUAL_MENU
1397 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1398 pane_name
= string_make_unibyte (pane_name
);
1400 pane_string
= (NILP (pane_name
)
1401 ? "" : (char *) XSTRING (pane_name
)->data
);
1402 /* If there is just one top-level pane, put all its items directly
1403 under the top-level menu. */
1404 if (menu_items_n_panes
== 1)
1407 /* If the pane has a meaningful name,
1408 make the pane a top-level menu item
1409 with its items as a submenu beneath it. */
1410 if (strcmp (pane_string
, ""))
1412 wv
= xmalloc_widget_value ();
1416 first_wv
->contents
= wv
;
1417 wv
->name
= pane_string
;
1418 /* Ignore the @ that means "separate pane".
1419 This is a kludge, but this isn't worth more time. */
1420 if (!NILP (prefix
) && wv
->name
[0] == '@')
1424 wv
->button_type
= BUTTON_TYPE_NONE
;
1428 i
+= MENU_ITEMS_PANE_LENGTH
;
1432 /* Create a new item within current pane. */
1433 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1434 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1435 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1437 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1438 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1439 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1440 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1442 #ifndef HAVE_MULTILINGUAL_MENU
1443 if (STRING_MULTIBYTE (item_name
))
1444 item_name
= string_make_unibyte (item_name
);
1445 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1446 descrip
= string_make_unibyte (descrip
);
1449 wv
= xmalloc_widget_value ();
1453 save_wv
->contents
= wv
;
1455 wv
->name
= (char *) XSTRING (item_name
)->data
;
1456 if (!NILP (descrip
))
1457 wv
->key
= (char *) XSTRING (descrip
)->data
;
1459 /* The EMACS_INT cast avoids a warning. There's no problem
1460 as long as pointers have enough bits to hold small integers. */
1461 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1462 wv
->enabled
= !NILP (enable
);
1465 wv
->button_type
= BUTTON_TYPE_NONE
;
1466 else if (EQ (type
, QCradio
))
1467 wv
->button_type
= BUTTON_TYPE_RADIO
;
1468 else if (EQ (type
, QCtoggle
))
1469 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1473 wv
->selected
= !NILP (selected
);
1477 i
+= MENU_ITEMS_ITEM_LENGTH
;
1481 /* If we have just one "menu item"
1482 that was originally a button, return it by itself. */
1483 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1485 wv
= first_wv
->contents
;
1486 free_widget_value (first_wv
);
1493 extern void EmacsFrameSetCharSize ();
1495 /* Recompute all the widgets of frame F, when the menu bar
1496 has been changed. */
1499 update_frame_menubar (f
)
1502 struct x_output
*x
= f
->output_data
.x
;
1504 int menubar_changed
;
1506 Dimension shell_height
;
1508 /* We assume the menubar contents has changed if the global flag is set,
1509 or if the current buffer has changed, or if the menubar has never
1510 been updated before.
1512 menubar_changed
= (x
->menubar_widget
1513 && !XtIsManaged (x
->menubar_widget
));
1515 if (! (menubar_changed
))
1519 /* Save the size of the frame because the pane widget doesn't accept to
1520 resize itself. So force it. */
1524 /* Do the voodoo which means "I'm changing lots of things, don't try to
1525 refigure sizes until I'm done." */
1526 lw_refigure_widget (x
->column_widget
, False
);
1528 /* the order in which children are managed is the top to
1529 bottom order in which they are displayed in the paned window.
1530 First, remove the text-area widget.
1532 XtUnmanageChild (x
->edit_widget
);
1534 /* remove the menubar that is there now, and put up the menubar that
1537 if (menubar_changed
)
1539 XtManageChild (x
->menubar_widget
);
1540 XtMapWidget (x
->menubar_widget
);
1541 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
1544 /* Re-manage the text-area widget, and then thrash the sizes. */
1545 XtManageChild (x
->edit_widget
);
1546 lw_refigure_widget (x
->column_widget
, True
);
1548 /* Force the pane widget to resize itself with the right values. */
1549 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1554 /* Set the contents of the menubar widgets of frame F.
1555 The argument FIRST_TIME is currently ignored;
1556 it is set the first time this is called, from initialize_frame_menubar. */
1559 set_frame_menubar (f
, first_time
, deep_p
)
1564 Widget menubar_widget
= f
->output_data
.x
->menubar_widget
;
1565 Lisp_Object tail
, items
, frame
;
1566 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1570 XSETFRAME (Vmenu_updating_frame
, f
);
1572 if (f
->output_data
.x
->id
== 0)
1573 f
->output_data
.x
->id
= next_menubar_widget_id
++;
1574 id
= f
->output_data
.x
->id
;
1576 if (! menubar_widget
)
1578 else if (pending_menu_activation
&& !deep_p
)
1580 /* Make the first call for any given frame always go deep. */
1581 else if (!f
->output_data
.x
->saved_menu_event
&& !deep_p
)
1584 f
->output_data
.x
->saved_menu_event
= (XEvent
*)xmalloc (sizeof (XEvent
));
1585 f
->output_data
.x
->saved_menu_event
->type
= 0;
1588 wv
= xmalloc_widget_value ();
1589 wv
->name
= "menubar";
1592 wv
->button_type
= BUTTON_TYPE_NONE
;
1597 /* Make a widget-value tree representing the entire menu trees. */
1599 struct buffer
*prev
= current_buffer
;
1601 int specpdl_count
= specpdl_ptr
- specpdl
;
1602 int previous_menu_items_used
= f
->menu_bar_items_used
;
1603 Lisp_Object
*previous_items
1604 = (Lisp_Object
*) alloca (previous_menu_items_used
1605 * sizeof (Lisp_Object
));
1607 /* If we are making a new widget, its contents are empty,
1608 do always reinitialize them. */
1609 if (! menubar_widget
)
1610 previous_menu_items_used
= 0;
1612 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1613 specbind (Qinhibit_quit
, Qt
);
1614 /* Don't let the debugger step into this code
1615 because it is not reentrant. */
1616 specbind (Qdebug_on_next_call
, Qnil
);
1618 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1619 if (NILP (Voverriding_local_map_menu_flag
))
1621 specbind (Qoverriding_terminal_local_map
, Qnil
);
1622 specbind (Qoverriding_local_map
, Qnil
);
1625 set_buffer_internal_1 (XBUFFER (buffer
));
1627 /* Run the Lucid hook. */
1628 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1629 /* If it has changed current-menubar from previous value,
1630 really recompute the menubar from the value. */
1631 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1632 call0 (Qrecompute_lucid_menubar
);
1633 safe_run_hooks (Qmenu_bar_update_hook
);
1634 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1636 items
= FRAME_MENU_BAR_ITEMS (f
);
1638 inhibit_garbage_collection ();
1640 /* Save the frame's previous menu bar contents data. */
1641 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1642 previous_menu_items_used
* sizeof (Lisp_Object
));
1644 /* Fill in the current menu bar contents. */
1645 menu_items
= f
->menu_bar_vector
;
1646 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1648 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1650 Lisp_Object key
, string
, maps
;
1652 key
= XVECTOR (items
)->contents
[i
];
1653 string
= XVECTOR (items
)->contents
[i
+ 1];
1654 maps
= XVECTOR (items
)->contents
[i
+ 2];
1658 wv
= single_submenu (key
, string
, maps
);
1662 first_wv
->contents
= wv
;
1663 /* Don't set wv->name here; GC during the loop might relocate it. */
1665 wv
->button_type
= BUTTON_TYPE_NONE
;
1669 finish_menu_items ();
1671 set_buffer_internal_1 (prev
);
1672 unbind_to (specpdl_count
, Qnil
);
1674 /* If there has been no change in the Lisp-level contents
1675 of the menu bar, skip redisplaying it. Just exit. */
1677 for (i
= 0; i
< previous_menu_items_used
; i
++)
1678 if (menu_items_used
== i
1679 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1681 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1683 free_menubar_widget_value_tree (first_wv
);
1689 /* Now GC cannot happen during the lifetime of the widget_value,
1690 so it's safe to store data from a Lisp_String. */
1691 wv
= first_wv
->contents
;
1692 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1695 string
= XVECTOR (items
)->contents
[i
+ 1];
1698 wv
->name
= (char *) XSTRING (string
)->data
;
1702 f
->menu_bar_vector
= menu_items
;
1703 f
->menu_bar_items_used
= menu_items_used
;
1708 /* Make a widget-value tree containing
1709 just the top level menu bar strings. */
1711 items
= FRAME_MENU_BAR_ITEMS (f
);
1712 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1716 string
= XVECTOR (items
)->contents
[i
+ 1];
1720 wv
= xmalloc_widget_value ();
1721 wv
->name
= (char *) XSTRING (string
)->data
;
1724 wv
->button_type
= BUTTON_TYPE_NONE
;
1725 /* This prevents lwlib from assuming this
1726 menu item is really supposed to be empty. */
1727 /* The EMACS_INT cast avoids a warning.
1728 This value just has to be different from small integers. */
1729 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1734 first_wv
->contents
= wv
;
1738 /* Forget what we thought we knew about what is in the
1739 detailed contents of the menu bar menus.
1740 Changing the top level always destroys the contents. */
1741 f
->menu_bar_items_used
= 0;
1744 /* Create or update the menu bar widget. */
1750 /* Disable resizing (done for Motif!) */
1751 lw_allow_resizing (f
->output_data
.x
->widget
, False
);
1753 /* The third arg is DEEP_P, which says to consider the entire
1754 menu trees we supply, rather than just the menu bar item names. */
1755 lw_modify_all_widgets (id
, first_wv
, deep_p
);
1757 /* Re-enable the edit widget to resize. */
1758 lw_allow_resizing (f
->output_data
.x
->widget
, True
);
1762 menubar_widget
= lw_create_widget ("menubar", "menubar", id
, first_wv
,
1763 f
->output_data
.x
->column_widget
,
1765 popup_activate_callback
,
1766 menubar_selection_callback
,
1767 popup_deactivate_callback
);
1768 f
->output_data
.x
->menubar_widget
= menubar_widget
;
1773 = (f
->output_data
.x
->menubar_widget
1774 ? (f
->output_data
.x
->menubar_widget
->core
.height
1775 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
1778 #if 0 /* Experimentally, we now get the right results
1779 for -geometry -0-0 without this. 24 Aug 96, rms. */
1781 if (FRAME_EXTERNAL_MENU_BAR (f
))
1784 XtVaGetValues (f
->output_data
.x
->column_widget
,
1785 XtNinternalBorderWidth
, &ibw
, NULL
);
1786 menubar_size
+= ibw
;
1788 #endif /* USE_LUCID */
1791 f
->output_data
.x
->menubar_height
= menubar_size
;
1794 free_menubar_widget_value_tree (first_wv
);
1796 update_frame_menubar (f
);
1801 /* Called from Fx_create_frame to create the initial menubar of a frame
1802 before it is mapped, so that the window is mapped with the menubar already
1803 there instead of us tacking it on later and thrashing the window after it
1807 initialize_frame_menubar (f
)
1810 /* This function is called before the first chance to redisplay
1811 the frame. It has to be, so the frame will have the right size. */
1812 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1813 set_frame_menubar (f
, 1, 1);
1816 /* Get rid of the menu bar of frame F, and free its storage.
1817 This is used when deleting a frame, and when turning off the menu bar. */
1820 free_frame_menubar (f
)
1823 Widget menubar_widget
;
1826 menubar_widget
= f
->output_data
.x
->menubar_widget
;
1828 f
->output_data
.x
->menubar_height
= 0;
1833 lw_destroy_all_widgets ((LWLIB_ID
) f
->output_data
.x
->id
);
1838 #endif /* USE_X_TOOLKIT */
1840 /* xmenu_show actually displays a menu using the panes and items in menu_items
1841 and returns the value selected from it.
1842 There are two versions of xmenu_show, one for Xt and one for Xlib.
1843 Both assume input is blocked by the caller. */
1845 /* F is the frame the menu is for.
1846 X and Y are the frame-relative specified position,
1847 relative to the inside upper left corner of the frame F.
1848 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1849 KEYMAPS is 1 if this menu was specified with keymaps;
1850 in that case, we return a list containing the chosen item's value
1851 and perhaps also the pane's prefix.
1852 TITLE is the specified menu title.
1853 ERROR is a place to store an error message string in case of failure.
1854 (We return nil on failure, but the value doesn't actually matter.) */
1856 #ifdef USE_X_TOOLKIT
1858 /* We need a unique id for each widget handled by the Lucid Widget
1861 For the main windows, and popup menus, we use this counter,
1862 which we increment each time after use. This starts from 1<<16.
1864 For menu bars, we use numbers starting at 0, counted in
1865 next_menubar_widget_id. */
1866 LWLIB_ID widget_id_tick
;
1869 static Lisp_Object
*volatile menu_item_selection
;
1871 static Lisp_Object
*menu_item_selection
;
1875 popup_selection_callback (widget
, id
, client_data
)
1878 XtPointer client_data
;
1880 menu_item_selection
= (Lisp_Object
*) client_data
;
1884 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1898 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1899 widget_value
**submenu_stack
1900 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1901 Lisp_Object
*subprefix_stack
1902 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1903 int submenu_depth
= 0;
1904 XButtonPressedEvent dummy
;
1907 int next_release_must_exit
= 0;
1911 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1913 *error
= "Empty menu";
1917 /* Create a tree of widget_value objects
1918 representing the panes and their items. */
1919 wv
= xmalloc_widget_value ();
1923 wv
->button_type
= BUTTON_TYPE_NONE
;
1927 /* Loop over all panes and items, filling in the tree. */
1929 while (i
< menu_items_used
)
1931 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1933 submenu_stack
[submenu_depth
++] = save_wv
;
1939 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1942 save_wv
= submenu_stack
[--submenu_depth
];
1946 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1947 && submenu_depth
!= 0)
1948 i
+= MENU_ITEMS_PANE_LENGTH
;
1949 /* Ignore a nil in the item list.
1950 It's meaningful only for dialog boxes. */
1951 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1953 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1955 /* Create a new pane. */
1956 Lisp_Object pane_name
, prefix
;
1958 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1959 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1960 #ifndef HAVE_MULTILINGUAL_MENU
1961 if (!NILP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1962 pane_name
= string_make_unibyte (pane_name
);
1964 pane_string
= (NILP (pane_name
)
1965 ? "" : (char *) XSTRING (pane_name
)->data
);
1966 /* If there is just one top-level pane, put all its items directly
1967 under the top-level menu. */
1968 if (menu_items_n_panes
== 1)
1971 /* If the pane has a meaningful name,
1972 make the pane a top-level menu item
1973 with its items as a submenu beneath it. */
1974 if (!keymaps
&& strcmp (pane_string
, ""))
1976 wv
= xmalloc_widget_value ();
1980 first_wv
->contents
= wv
;
1981 wv
->name
= pane_string
;
1982 if (keymaps
&& !NILP (prefix
))
1986 wv
->button_type
= BUTTON_TYPE_NONE
;
1990 else if (first_pane
)
1996 i
+= MENU_ITEMS_PANE_LENGTH
;
2000 /* Create a new item within current pane. */
2001 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
2002 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2003 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2005 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2006 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
2007 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
2008 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
2010 #ifndef HAVE_MULTILINGUAL_MENU
2011 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2012 item_name
= string_make_unibyte (item_name
);
2013 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2014 item_name
= string_make_unibyte (descrip
);
2017 wv
= xmalloc_widget_value ();
2021 save_wv
->contents
= wv
;
2022 wv
->name
= (char *) XSTRING (item_name
)->data
;
2023 if (!NILP (descrip
))
2024 wv
->key
= (char *) XSTRING (descrip
)->data
;
2026 /* If this item has a null value,
2027 make the call_data null so that it won't display a box
2028 when the mouse is on it. */
2030 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
2031 wv
->enabled
= !NILP (enable
);
2034 wv
->button_type
= BUTTON_TYPE_NONE
;
2035 else if (EQ (type
, QCtoggle
))
2036 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2037 else if (EQ (type
, QCradio
))
2038 wv
->button_type
= BUTTON_TYPE_RADIO
;
2042 wv
->selected
= !NILP (selected
);
2046 i
+= MENU_ITEMS_ITEM_LENGTH
;
2050 /* Deal with the title, if it is non-nil. */
2053 widget_value
*wv_title
= xmalloc_widget_value ();
2054 widget_value
*wv_sep1
= xmalloc_widget_value ();
2055 widget_value
*wv_sep2
= xmalloc_widget_value ();
2057 wv_sep2
->name
= "--";
2058 wv_sep2
->next
= first_wv
->contents
;
2060 wv_sep1
->name
= "--";
2061 wv_sep1
->next
= wv_sep2
;
2063 #ifndef HAVE_MULTILINGUAL_MENU
2064 if (STRING_MULTIBYTE (title
))
2065 title
= string_make_unibyte (title
);
2067 wv_title
->name
= (char *) XSTRING (title
)->data
;
2068 wv_title
->enabled
= True
;
2069 wv_title
->button_type
= BUTTON_TYPE_NONE
;
2070 wv_title
->next
= wv_sep1
;
2071 first_wv
->contents
= wv_title
;
2074 /* Actually create the menu. */
2075 menu_id
= widget_id_tick
++;
2076 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
2077 f
->output_data
.x
->widget
, 1, 0,
2078 popup_selection_callback
,
2079 popup_deactivate_callback
);
2081 /* Adjust coordinates to relative to the outer (window manager) window. */
2084 int win_x
= 0, win_y
= 0;
2086 /* Find the position of the outside upper-left corner of
2087 the inner window, with respect to the outer window. */
2088 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2091 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2093 /* From-window, to-window. */
2094 f
->output_data
.x
->window_desc
,
2095 f
->output_data
.x
->parent_desc
,
2097 /* From-position, to-position. */
2098 0, 0, &win_x
, &win_y
,
2100 /* Child of window. */
2108 /* Adjust coordinates to be root-window-relative. */
2109 x
+= f
->output_data
.x
->left_pos
;
2110 y
+= f
->output_data
.x
->top_pos
;
2112 dummy
.type
= ButtonPress
;
2114 dummy
.send_event
= 0;
2115 dummy
.display
= FRAME_X_DISPLAY (f
);
2116 dummy
.time
= CurrentTime
;
2117 dummy
.root
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
2118 dummy
.window
= dummy
.root
;
2119 dummy
.subwindow
= dummy
.root
;
2124 dummy
.state
= (FRAME_X_DISPLAY_INFO (f
)->grabbed
>> 1) * Button1Mask
;
2126 for (i
= 0; i
< 5; i
++)
2127 if (FRAME_X_DISPLAY_INFO (f
)->grabbed
& (1 << i
))
2130 /* Don't allow any geometry request from the user. */
2131 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
2132 XtSetValues (menu
, av
, ac
);
2134 /* Free the widget_value objects we used to specify the contents. */
2135 free_menubar_widget_value_tree (first_wv
);
2137 /* No selection has been chosen yet. */
2138 menu_item_selection
= 0;
2140 /* Display the menu. */
2141 lw_popup_menu (menu
, &dummy
);
2142 popup_activated_flag
= 1;
2144 /* Process events that apply to the menu. */
2145 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), menu_id
);
2147 #ifdef LESSTIF_VERSION
2148 /* Nov 1998: For an unknown reason a button grab remains active
2149 after the popup menu has gone. */
2150 XUngrabButton (XtDisplay (f
->output_data
.x
->widget
),
2151 AnyButton
, AnyModifier
,
2152 XtWindow (f
->output_data
.x
->widget
));
2153 XUngrabButton (XtDisplay (f
->output_data
.x
->edit_widget
),
2154 AnyButton
, AnyModifier
,
2155 XtWindow (f
->output_data
.x
->edit_widget
));
2156 #endif /* LESSTIF_VERSION */
2158 /* fp turned off the following statement and wrote a comment
2159 that it is unnecessary--that the menu has already disappeared.
2160 Nowadays the menu disappears ok, all right, but
2161 we need to delete the widgets or multiple ones will pile up. */
2162 lw_destroy_all_widgets (menu_id
);
2164 /* Find the selected item, and its pane, to return
2165 the proper value. */
2166 if (menu_item_selection
!= 0)
2168 Lisp_Object prefix
, entry
;
2172 while (i
< menu_items_used
)
2174 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2176 subprefix_stack
[submenu_depth
++] = prefix
;
2180 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2182 prefix
= subprefix_stack
[--submenu_depth
];
2185 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2188 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2189 i
+= MENU_ITEMS_PANE_LENGTH
;
2191 /* Ignore a nil in the item list.
2192 It's meaningful only for dialog boxes. */
2193 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2198 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2199 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2205 entry
= Fcons (entry
, Qnil
);
2207 entry
= Fcons (prefix
, entry
);
2208 for (j
= submenu_depth
- 1; j
>= 0; j
--)
2209 if (!NILP (subprefix_stack
[j
]))
2210 entry
= Fcons (subprefix_stack
[j
], entry
);
2214 i
+= MENU_ITEMS_ITEM_LENGTH
;
2223 dialog_selection_callback (widget
, id
, client_data
)
2226 XtPointer client_data
;
2228 /* The EMACS_INT cast avoids a warning. There's no problem
2229 as long as pointers have enough bits to hold small integers. */
2230 if ((int) (EMACS_INT
) client_data
!= -1)
2231 menu_item_selection
= (Lisp_Object
*) client_data
;
2233 lw_destroy_all_widgets (id
);
2235 popup_activated_flag
= 0;
2238 static char * button_names
[] = {
2239 "button1", "button2", "button3", "button4", "button5",
2240 "button6", "button7", "button8", "button9", "button10" };
2243 xdialog_show (f
, keymaps
, title
, error
)
2249 int i
, nb_buttons
=0;
2252 char dialog_name
[6];
2254 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
2256 /* Number of elements seen so far, before boundary. */
2258 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2259 int boundary_seen
= 0;
2263 if (menu_items_n_panes
> 1)
2265 *error
= "Multiple panes in dialog box";
2269 /* Create a tree of widget_value objects
2270 representing the text label and buttons. */
2272 Lisp_Object pane_name
, prefix
;
2274 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2275 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2276 pane_string
= (NILP (pane_name
)
2277 ? "" : (char *) XSTRING (pane_name
)->data
);
2278 prev_wv
= xmalloc_widget_value ();
2279 prev_wv
->value
= pane_string
;
2280 if (keymaps
&& !NILP (prefix
))
2282 prev_wv
->enabled
= 1;
2283 prev_wv
->name
= "message";
2286 /* Loop over all panes and items, filling in the tree. */
2287 i
= MENU_ITEMS_PANE_LENGTH
;
2288 while (i
< menu_items_used
)
2291 /* Create a new item within current pane. */
2292 Lisp_Object item_name
, enable
, descrip
;
2293 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2294 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2296 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2298 if (NILP (item_name
))
2300 free_menubar_widget_value_tree (first_wv
);
2301 *error
= "Submenu in dialog items";
2304 if (EQ (item_name
, Qquote
))
2306 /* This is the boundary between left-side elts
2307 and right-side elts. Stop incrementing right_count. */
2312 if (nb_buttons
>= 9)
2314 free_menubar_widget_value_tree (first_wv
);
2315 *error
= "Too many dialog items";
2319 wv
= xmalloc_widget_value ();
2321 wv
->name
= (char *) button_names
[nb_buttons
];
2322 if (!NILP (descrip
))
2323 wv
->key
= (char *) XSTRING (descrip
)->data
;
2324 wv
->value
= (char *) XSTRING (item_name
)->data
;
2325 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
2326 wv
->enabled
= !NILP (enable
);
2329 if (! boundary_seen
)
2333 i
+= MENU_ITEMS_ITEM_LENGTH
;
2336 /* If the boundary was not specified,
2337 by default put half on the left and half on the right. */
2338 if (! boundary_seen
)
2339 left_count
= nb_buttons
- nb_buttons
/ 2;
2341 wv
= xmalloc_widget_value ();
2342 wv
->name
= dialog_name
;
2344 /* Dialog boxes use a really stupid name encoding
2345 which specifies how many buttons to use
2346 and how many buttons are on the right.
2347 The Q means something also. */
2348 dialog_name
[0] = 'Q';
2349 dialog_name
[1] = '0' + nb_buttons
;
2350 dialog_name
[2] = 'B';
2351 dialog_name
[3] = 'R';
2352 /* Number of buttons to put on the right. */
2353 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2355 wv
->contents
= first_wv
;
2359 /* Actually create the dialog. */
2360 dialog_id
= widget_id_tick
++;
2361 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2362 f
->output_data
.x
->widget
, 1, 0,
2363 dialog_selection_callback
, 0);
2364 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2365 /* Free the widget_value objects we used to specify the contents. */
2366 free_menubar_widget_value_tree (first_wv
);
2368 /* No selection has been chosen yet. */
2369 menu_item_selection
= 0;
2371 /* Display the menu. */
2372 lw_pop_up_all_widgets (dialog_id
);
2373 popup_activated_flag
= 1;
2375 /* Process events that apply to the menu. */
2376 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2378 lw_destroy_all_widgets (dialog_id
);
2380 /* Find the selected item, and its pane, to return
2381 the proper value. */
2382 if (menu_item_selection
!= 0)
2388 while (i
< menu_items_used
)
2392 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2395 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2396 i
+= MENU_ITEMS_PANE_LENGTH
;
2401 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2402 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2406 entry
= Fcons (entry
, Qnil
);
2408 entry
= Fcons (prefix
, entry
);
2412 i
+= MENU_ITEMS_ITEM_LENGTH
;
2419 #else /* not USE_X_TOOLKIT */
2422 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2432 int pane
, selidx
, lpane
, status
;
2433 Lisp_Object entry
, pane_prefix
;
2435 int ulx
, uly
, width
, height
;
2436 int dispwidth
, dispheight
;
2440 unsigned int dummy_uint
;
2443 if (menu_items_n_panes
== 0)
2446 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2448 *error
= "Empty menu";
2452 /* Figure out which root window F is on. */
2453 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2454 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2455 &dummy_uint
, &dummy_uint
);
2457 /* Make the menu on that window. */
2458 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2461 *error
= "Can't create menu";
2465 #ifdef HAVE_X_WINDOWS
2466 /* Adjust coordinates to relative to the outer (window manager) window. */
2469 int win_x
= 0, win_y
= 0;
2471 /* Find the position of the outside upper-left corner of
2472 the inner window, with respect to the outer window. */
2473 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2476 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2478 /* From-window, to-window. */
2479 f
->output_data
.x
->window_desc
,
2480 f
->output_data
.x
->parent_desc
,
2482 /* From-position, to-position. */
2483 0, 0, &win_x
, &win_y
,
2485 /* Child of window. */
2492 #endif /* HAVE_X_WINDOWS */
2494 /* Adjust coordinates to be root-window-relative. */
2495 x
+= f
->output_data
.x
->left_pos
;
2496 y
+= f
->output_data
.x
->top_pos
;
2498 /* Create all the necessary panes and their items. */
2500 while (i
< menu_items_used
)
2502 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2504 /* Create a new pane. */
2505 Lisp_Object pane_name
, prefix
;
2508 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2509 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2510 pane_string
= (NILP (pane_name
)
2511 ? "" : (char *) XSTRING (pane_name
)->data
);
2512 if (keymaps
&& !NILP (prefix
))
2515 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2516 if (lpane
== XM_FAILURE
)
2518 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2519 *error
= "Can't create pane";
2522 i
+= MENU_ITEMS_PANE_LENGTH
;
2524 /* Find the width of the widest item in this pane. */
2527 while (j
< menu_items_used
)
2530 item
= XVECTOR (menu_items
)->contents
[j
];
2538 width
= STRING_BYTES (XSTRING (item
));
2539 if (width
> maxwidth
)
2542 j
+= MENU_ITEMS_ITEM_LENGTH
;
2545 /* Ignore a nil in the item list.
2546 It's meaningful only for dialog boxes. */
2547 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2551 /* Create a new item within current pane. */
2552 Lisp_Object item_name
, enable
, descrip
;
2553 unsigned char *item_data
;
2555 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2556 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2558 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2559 if (!NILP (descrip
))
2561 int gap
= maxwidth
- STRING_BYTES (XSTRING (item_name
));
2564 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2565 item_name
= concat2 (item_name
, spacer
);
2566 item_name
= concat2 (item_name
, descrip
);
2567 item_data
= XSTRING (item_name
)->data
;
2569 /* if alloca is fast, use that to make the space,
2570 to reduce gc needs. */
2572 = (unsigned char *) alloca (maxwidth
2573 + STRING_BYTES (XSTRING (descrip
)) + 1);
2574 bcopy (XSTRING (item_name
)->data
, item_data
,
2575 STRING_BYTES (XSTRING (item_name
)));
2576 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2578 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2579 STRING_BYTES (XSTRING (descrip
)));
2580 item_data
[j
+ STRING_BYTES (XSTRING (descrip
))] = 0;
2584 item_data
= XSTRING (item_name
)->data
;
2586 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2587 menu
, lpane
, 0, item_data
,
2591 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2592 *error
= "Can't add selection to menu";
2595 i
+= MENU_ITEMS_ITEM_LENGTH
;
2599 /* All set and ready to fly. */
2600 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2601 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
),
2602 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)));
2603 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
),
2604 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)));
2605 x
= min (x
, dispwidth
);
2606 y
= min (y
, dispheight
);
2609 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2610 &ulx
, &uly
, &width
, &height
);
2611 if (ulx
+width
> dispwidth
)
2613 x
-= (ulx
+ width
) - dispwidth
;
2614 ulx
= dispwidth
- width
;
2616 if (uly
+height
> dispheight
)
2618 y
-= (uly
+ height
) - dispheight
;
2619 uly
= dispheight
- height
;
2621 if (ulx
< 0) x
-= ulx
;
2622 if (uly
< 0) y
-= uly
;
2624 XMenuSetAEQ (menu
, TRUE
);
2625 XMenuSetFreeze (menu
, TRUE
);
2628 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2629 x
, y
, ButtonReleaseMask
, &datap
);
2632 #ifdef HAVE_X_WINDOWS
2633 /* Assume the mouse has moved out of the X window.
2634 If it has actually moved in, we will get an EnterNotify. */
2635 x_mouse_leave (FRAME_X_DISPLAY_INFO (f
));
2642 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2645 /* Find the item number SELIDX in pane number PANE. */
2647 while (i
< menu_items_used
)
2649 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2653 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2655 i
+= MENU_ITEMS_PANE_LENGTH
;
2664 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2667 entry
= Fcons (entry
, Qnil
);
2668 if (!NILP (pane_prefix
))
2669 entry
= Fcons (pane_prefix
, entry
);
2675 i
+= MENU_ITEMS_ITEM_LENGTH
;
2681 *error
= "Can't activate menu";
2687 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2689 #ifdef HAVE_X_WINDOWS
2690 /* State that no mouse buttons are now held.
2691 (The oldXMenu code doesn't track this info for us.)
2692 That is not necessarily true, but the fiction leads to reasonable
2693 results, and it is a pain to ask which are actually held now. */
2694 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2700 #endif /* not USE_X_TOOLKIT */
2702 #endif /* HAVE_MENUS */
2707 staticpro (&menu_items
);
2710 Qdebug_on_next_call
= intern ("debug-on-next-call");
2711 staticpro (&Qdebug_on_next_call
);
2713 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2714 "Frame for which we are updating a menu.\n\
2715 The enable predicate for a menu command should check this variable.");
2716 Vmenu_updating_frame
= Qnil
;
2718 #ifdef USE_X_TOOLKIT
2719 widget_id_tick
= (1<<16);
2720 next_menubar_widget_id
= 1;
2723 defsubr (&Sx_popup_menu
);
2725 defsubr (&Sx_popup_dialog
);