(sgml-empty-tags): New var.
[emacs.git] / src / xmenu.c
blob341993ad3df4f152eb6a3198715780dcb70b94f1
1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 88, 93, 94, 96, 99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* X pop-up deck-of-cards menu facility for GNU Emacs.
24 * Written by Jon Arnold and Roman Budzianowski
25 * Mods and rewrite by Robert Krawitz
29 /* Modified by Fred Pierresteguy on December 93
30 to make the popup menus and menubar use the Xt. */
32 /* Rewritten for clarity and GC protection by rms in Feb 94. */
34 #include <config.h>
36 /* On 4.3 this loses if it comes after xterm.h. */
37 #include <signal.h>
39 #include <stdio.h>
41 #include "lisp.h"
42 #include "termhooks.h"
43 #include "keyboard.h"
44 #include "keymap.h"
45 #include "frame.h"
46 #include "window.h"
47 #include "blockinput.h"
48 #include "buffer.h"
50 #ifdef MSDOS
51 #include "msdos.h"
52 #endif
54 #ifdef HAVE_X_WINDOWS
55 /* This may include sys/types.h, and that somehow loses
56 if this is not done before the other system files. */
57 #include "xterm.h"
58 #endif
60 /* Load sys/types.h if not already loaded.
61 In some systems loading it twice is suicidal. */
62 #ifndef makedev
63 #include <sys/types.h>
64 #endif
66 #include "dispextern.h"
68 #ifdef HAVE_X_WINDOWS
69 #undef HAVE_MULTILINGUAL_MENU
70 #ifdef USE_X_TOOLKIT
71 #include "widget.h"
72 #include <X11/Xlib.h>
73 #include <X11/IntrinsicP.h>
74 #include <X11/CoreP.h>
75 #include <X11/StringDefs.h>
76 #include <X11/Shell.h>
77 #ifdef USE_LUCID
78 #include <X11/Xaw/Paned.h>
79 #endif /* USE_LUCID */
80 #include "../lwlib/lwlib.h"
81 #else /* not USE_X_TOOLKIT */
82 #include "../oldXMenu/XMenu.h"
83 #endif /* not USE_X_TOOLKIT */
84 #endif /* HAVE_X_WINDOWS */
86 #ifndef TRUE
87 #define TRUE 1
88 #define FALSE 0
89 #endif /* no TRUE */
91 Lisp_Object Vmenu_updating_frame;
93 Lisp_Object Qdebug_on_next_call;
95 extern Lisp_Object Qmenu_bar;
96 extern Lisp_Object Qmouse_click, Qevent_kind;
98 extern Lisp_Object QCtoggle, QCradio;
100 extern Lisp_Object Voverriding_local_map;
101 extern Lisp_Object Voverriding_local_map_menu_flag;
103 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
105 extern Lisp_Object Qmenu_bar_update_hook;
107 #ifdef USE_X_TOOLKIT
108 extern void set_frame_menubar ();
109 extern void process_expose_from_menu ();
110 extern XtAppContext Xt_app_con;
112 static Lisp_Object xdialog_show ();
113 void popup_get_selection ();
114 #endif
116 #ifdef USE_X_TOOLKIT
118 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
120 #define HAVE_BOXES 1
121 #endif
123 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
124 Lisp_Object, Lisp_Object, Lisp_Object,
125 Lisp_Object, Lisp_Object));
126 static int update_frame_menubar P_ ((struct frame *));
127 static Lisp_Object xmenu_show P_ ((struct frame *, int, int, int, int,
128 Lisp_Object, char **));
129 static void keymap_panes P_ ((Lisp_Object *, int, int));
130 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
131 int, int));
132 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object *,
133 int, int, int *));
134 static void list_of_panes P_ ((Lisp_Object));
135 static void list_of_items P_ ((Lisp_Object));
137 /* This holds a Lisp vector that holds the results of decoding
138 the keymaps or alist-of-alists that specify a menu.
140 It describes the panes and items within the panes.
142 Each pane is described by 3 elements in the vector:
143 t, the pane name, the pane's prefix key.
144 Then follow the pane's items, with 5 elements per item:
145 the item string, the enable flag, the item's value,
146 the definition, and the equivalent keyboard key's description string.
148 In some cases, multiple levels of menus may be described.
149 A single vector slot containing nil indicates the start of a submenu.
150 A single vector slot containing lambda indicates the end of a submenu.
151 The submenu follows a menu item which is the way to reach the submenu.
153 A single vector slot containing quote indicates that the
154 following items should appear on the right of a dialog box.
156 Using a Lisp vector to hold this information while we decode it
157 takes care of protecting all the data from GC. */
159 #define MENU_ITEMS_PANE_NAME 1
160 #define MENU_ITEMS_PANE_PREFIX 2
161 #define MENU_ITEMS_PANE_LENGTH 3
163 enum menu_item_idx
165 MENU_ITEMS_ITEM_NAME = 0,
166 MENU_ITEMS_ITEM_ENABLE,
167 MENU_ITEMS_ITEM_VALUE,
168 MENU_ITEMS_ITEM_EQUIV_KEY,
169 MENU_ITEMS_ITEM_DEFINITION,
170 MENU_ITEMS_ITEM_TYPE,
171 MENU_ITEMS_ITEM_SELECTED,
172 MENU_ITEMS_ITEM_HELP,
173 MENU_ITEMS_ITEM_LENGTH
176 static Lisp_Object menu_items;
178 /* Number of slots currently allocated in menu_items. */
179 static int menu_items_allocated;
181 /* This is the index in menu_items of the first empty slot. */
182 static int menu_items_used;
184 /* The number of panes currently recorded in menu_items,
185 excluding those within submenus. */
186 static int menu_items_n_panes;
188 /* Current depth within submenus. */
189 static int menu_items_submenu_depth;
191 /* Flag which when set indicates a dialog or menu has been posted by
192 Xt on behalf of one of the widget sets. */
193 int popup_activated_flag;
195 static int next_menubar_widget_id;
197 /* This is set nonzero after the user activates the menu bar, and set
198 to zero again after the menu bars are redisplayed by prepare_menu_bar.
199 While it is nonzero, all calls to set_frame_menubar go deep.
201 I don't understand why this is needed, but it does seem to be
202 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
204 int pending_menu_activation;
206 #ifdef USE_X_TOOLKIT
208 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
210 static struct frame *
211 menubar_id_to_frame (id)
212 LWLIB_ID id;
214 Lisp_Object tail, frame;
215 FRAME_PTR f;
217 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
219 frame = XCAR (tail);
220 if (!GC_FRAMEP (frame))
221 continue;
222 f = XFRAME (frame);
223 if (!FRAME_WINDOW_P (f))
224 continue;
225 if (f->output_data.x->id == id)
226 return f;
228 return 0;
231 #endif
233 /* Initialize the menu_items structure if we haven't already done so.
234 Also mark it as currently empty. */
236 static void
237 init_menu_items ()
239 if (NILP (menu_items))
241 menu_items_allocated = 60;
242 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
245 menu_items_used = 0;
246 menu_items_n_panes = 0;
247 menu_items_submenu_depth = 0;
250 /* Call at the end of generating the data in menu_items.
251 This fills in the number of items in the last pane. */
253 static void
254 finish_menu_items ()
258 /* Call when finished using the data for the current menu
259 in menu_items. */
261 static void
262 discard_menu_items ()
264 /* Free the structure if it is especially large.
265 Otherwise, hold on to it, to save time. */
266 if (menu_items_allocated > 200)
268 menu_items = Qnil;
269 menu_items_allocated = 0;
273 /* Make the menu_items vector twice as large. */
275 static void
276 grow_menu_items ()
278 Lisp_Object old;
279 int old_size = menu_items_allocated;
280 old = menu_items;
282 menu_items_allocated *= 2;
283 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
284 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
285 old_size * sizeof (Lisp_Object));
288 /* Begin a submenu. */
290 static void
291 push_submenu_start ()
293 if (menu_items_used + 1 > menu_items_allocated)
294 grow_menu_items ();
296 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
297 menu_items_submenu_depth++;
300 /* End a submenu. */
302 static void
303 push_submenu_end ()
305 if (menu_items_used + 1 > menu_items_allocated)
306 grow_menu_items ();
308 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
309 menu_items_submenu_depth--;
312 /* Indicate boundary between left and right. */
314 static void
315 push_left_right_boundary ()
317 if (menu_items_used + 1 > menu_items_allocated)
318 grow_menu_items ();
320 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
323 /* Start a new menu pane in menu_items.
324 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
326 static void
327 push_menu_pane (name, prefix_vec)
328 Lisp_Object name, prefix_vec;
330 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
331 grow_menu_items ();
333 if (menu_items_submenu_depth == 0)
334 menu_items_n_panes++;
335 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
336 XVECTOR (menu_items)->contents[menu_items_used++] = name;
337 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
340 /* Push one menu item into the current pane. NAME is the string to
341 display. ENABLE if non-nil means this item can be selected. KEY
342 is the key generated by choosing this item, or nil if this item
343 doesn't really have a definition. DEF is the definition of this
344 item. EQUIV is the textual description of the keyboard equivalent
345 for this item (or nil if none). TYPE is the type of this menu
346 item, one of nil, `toggle' or `radio'. */
348 static void
349 push_menu_item (name, enable, key, def, equiv, type, selected, help)
350 Lisp_Object name, enable, key, def, equiv, type, selected, help;
352 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
353 grow_menu_items ();
355 XVECTOR (menu_items)->contents[menu_items_used++] = name;
356 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
357 XVECTOR (menu_items)->contents[menu_items_used++] = key;
358 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
359 XVECTOR (menu_items)->contents[menu_items_used++] = def;
360 XVECTOR (menu_items)->contents[menu_items_used++] = type;
361 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
362 XVECTOR (menu_items)->contents[menu_items_used++] = help;
365 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
366 and generate menu panes for them in menu_items.
367 If NOTREAL is nonzero,
368 don't bother really computing whether an item is enabled. */
370 static void
371 keymap_panes (keymaps, nmaps, notreal)
372 Lisp_Object *keymaps;
373 int nmaps;
374 int notreal;
376 int mapno;
378 init_menu_items ();
380 /* Loop over the given keymaps, making a pane for each map.
381 But don't make a pane that is empty--ignore that map instead.
382 P is the number of panes we have made so far. */
383 for (mapno = 0; mapno < nmaps; mapno++)
384 single_keymap_panes (keymaps[mapno],
385 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
387 finish_menu_items ();
390 /* This is a recursive subroutine of keymap_panes.
391 It handles one keymap, KEYMAP.
392 The other arguments are passed along
393 or point to local variables of the previous function.
394 If NOTREAL is nonzero, only check for equivalent key bindings, don't
395 evaluate expressions in menu items and don't make any menu.
397 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
399 static void
400 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
401 Lisp_Object keymap;
402 Lisp_Object pane_name;
403 Lisp_Object prefix;
404 int notreal;
405 int maxdepth;
407 Lisp_Object pending_maps = Qnil;
408 Lisp_Object tail, item;
409 struct gcpro gcpro1, gcpro2;
410 int notbuttons = 0;
412 if (maxdepth <= 0)
413 return;
415 push_menu_pane (pane_name, prefix);
417 #ifndef HAVE_BOXES
418 /* Remember index for first item in this pane so we can go back and
419 add a prefix when (if) we see the first button. After that, notbuttons
420 is set to 0, to mark that we have seen a button and all non button
421 items need a prefix. */
422 notbuttons = menu_items_used;
423 #endif
425 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
427 GCPRO2 (keymap, pending_maps);
428 /* Look at each key binding, and if it is a menu item add it
429 to this menu. */
430 item = XCAR (tail);
431 if (CONSP (item))
432 single_menu_item (XCAR (item), XCDR (item),
433 &pending_maps, notreal, maxdepth, &notbuttons);
434 else if (VECTORP (item))
436 /* Loop over the char values represented in the vector. */
437 int len = XVECTOR (item)->size;
438 int c;
439 for (c = 0; c < len; c++)
441 Lisp_Object character;
442 XSETFASTINT (character, c);
443 single_menu_item (character, XVECTOR (item)->contents[c],
444 &pending_maps, notreal, maxdepth, &notbuttons);
447 UNGCPRO;
450 /* Process now any submenus which want to be panes at this level. */
451 while (!NILP (pending_maps))
453 Lisp_Object elt, eltcdr, string;
454 elt = Fcar (pending_maps);
455 eltcdr = XCDR (elt);
456 string = XCAR (eltcdr);
457 /* We no longer discard the @ from the beginning of the string here.
458 Instead, we do this in xmenu_show. */
459 single_keymap_panes (Fcar (elt), string,
460 XCDR (eltcdr), notreal, maxdepth - 1);
461 pending_maps = Fcdr (pending_maps);
465 /* This is a subroutine of single_keymap_panes that handles one
466 keymap entry.
467 KEY is a key in a keymap and ITEM is its binding.
468 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
469 separate panes.
470 If NOTREAL is nonzero, only check for equivalent key bindings, don't
471 evaluate expressions in menu items and don't make any menu.
472 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
473 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
474 buttons. It points to variable notbuttons in single_keymap_panes,
475 which keeps track of if we have seen a button in this menu or not. */
477 static void
478 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth,
479 notbuttons_ptr)
480 Lisp_Object key, item;
481 Lisp_Object *pending_maps_ptr;
482 int maxdepth, notreal;
483 int *notbuttons_ptr;
485 Lisp_Object map, item_string, enabled;
486 struct gcpro gcpro1, gcpro2;
487 int res;
489 /* Parse the menu item and leave the result in item_properties. */
490 GCPRO2 (key, item);
491 res = parse_menu_item (item, notreal, 0);
492 UNGCPRO;
493 if (!res)
494 return; /* Not a menu item. */
496 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
498 if (notreal)
500 /* We don't want to make a menu, just traverse the keymaps to
501 precompute equivalent key bindings. */
502 if (!NILP (map))
503 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
504 return;
507 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
508 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
510 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
512 if (!NILP (enabled))
513 /* An enabled separate pane. Remember this to handle it later. */
514 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
515 *pending_maps_ptr);
516 return;
519 #ifndef HAVE_BOXES
520 /* Simulate radio buttons and toggle boxes by putting a prefix in
521 front of them. */
523 Lisp_Object prefix = Qnil;
524 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
525 if (!NILP (type))
527 Lisp_Object selected
528 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
530 if (*notbuttons_ptr)
531 /* The first button. Line up previous items in this menu. */
533 int index = *notbuttons_ptr; /* Index for first item this menu. */
534 int submenu = 0;
535 Lisp_Object tem;
536 while (index < menu_items_used)
539 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
540 if (NILP (tem))
542 index++;
543 submenu++; /* Skip sub menu. */
545 else if (EQ (tem, Qlambda))
547 index++;
548 submenu--; /* End sub menu. */
550 else if (EQ (tem, Qt))
551 index += 3; /* Skip new pane marker. */
552 else if (EQ (tem, Qquote))
553 index++; /* Skip a left, right divider. */
554 else
556 if (!submenu && XSTRING (tem)->data[0] != '\0'
557 && XSTRING (tem)->data[0] != '-')
558 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
559 = concat2 (build_string (" "), tem);
560 index += MENU_ITEMS_ITEM_LENGTH;
563 *notbuttons_ptr = 0;
566 /* Calculate prefix, if any, for this item. */
567 if (EQ (type, QCtoggle))
568 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
569 else if (EQ (type, QCradio))
570 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
572 /* Not a button. If we have earlier buttons, then we need a prefix. */
573 else if (!*notbuttons_ptr && XSTRING (item_string)->data[0] != '\0'
574 && XSTRING (item_string)->data[0] != '-')
575 prefix = build_string (" ");
577 if (!NILP (prefix))
578 item_string = concat2 (prefix, item_string);
580 #endif /* not HAVE_BOXES */
582 #ifndef USE_X_TOOLKIT
583 if (!NILP(map))
584 /* Indicate visually that this is a submenu. */
585 item_string = concat2 (item_string, build_string (" >"));
586 #endif
588 push_menu_item (item_string, enabled, key,
589 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
590 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
591 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
592 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
593 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
595 #ifdef USE_X_TOOLKIT
596 /* Display a submenu using the toolkit. */
597 if (! (NILP (map) || NILP (enabled)))
599 push_submenu_start ();
600 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
601 push_submenu_end ();
603 #endif
606 /* Push all the panes and items of a menu described by the
607 alist-of-alists MENU.
608 This handles old-fashioned calls to x-popup-menu. */
610 static void
611 list_of_panes (menu)
612 Lisp_Object menu;
614 Lisp_Object tail;
616 init_menu_items ();
618 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
620 Lisp_Object elt, pane_name, pane_data;
621 elt = Fcar (tail);
622 pane_name = Fcar (elt);
623 CHECK_STRING (pane_name, 0);
624 push_menu_pane (pane_name, Qnil);
625 pane_data = Fcdr (elt);
626 CHECK_CONS (pane_data, 0);
627 list_of_items (pane_data);
630 finish_menu_items ();
633 /* Push the items in a single pane defined by the alist PANE. */
635 static void
636 list_of_items (pane)
637 Lisp_Object pane;
639 Lisp_Object tail, item, item1;
641 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
643 item = Fcar (tail);
644 if (STRINGP (item))
645 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
646 else if (NILP (item))
647 push_left_right_boundary ();
648 else
650 CHECK_CONS (item, 0);
651 item1 = Fcar (item);
652 CHECK_STRING (item1, 1);
653 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
658 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
659 doc: /* Pop up a deck-of-cards menu and return user's selection.
660 POSITION is a position specification. This is either a mouse button event
661 or a list ((XOFFSET YOFFSET) WINDOW)
662 where XOFFSET and YOFFSET are positions in pixels from the top left
663 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)
664 This controls the position of the center of the first line
665 in the first pane of the menu, not the top left of the menu as a whole.
666 If POSITION is t, it means to use the current mouse position.
668 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
669 The menu items come from key bindings that have a menu string as well as
670 a definition; actually, the "definition" in such a key binding looks like
671 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
672 the keymap as a top-level element.
674 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
675 Otherwise, REAL-DEFINITION should be a valid key binding definition.
677 You can also use a list of keymaps as MENU.
678 Then each keymap makes a separate pane.
679 When MENU is a keymap or a list of keymaps, the return value
680 is a list of events.
682 Alternatively, you can specify a menu of multiple panes
683 with a list of the form (TITLE PANE1 PANE2...),
684 where each pane is a list of form (TITLE ITEM1 ITEM2...).
685 Each ITEM is normally a cons cell (STRING . VALUE);
686 but a string can appear as an item--that makes a nonselectable line
687 in the menu.
688 With this form of menu, the return value is VALUE from the chosen item.
690 If POSITION is nil, don't display the menu at all, just precalculate the
691 cached information about equivalent key sequences. */)
692 (position, menu)
693 Lisp_Object position, menu;
695 Lisp_Object keymap, tem;
696 int xpos = 0, ypos = 0;
697 Lisp_Object title;
698 char *error_name;
699 Lisp_Object selection;
700 struct frame *f = NULL;
701 Lisp_Object x, y, window;
702 int keymaps = 0;
703 int for_click = 0;
704 struct gcpro gcpro1;
706 #ifdef HAVE_MENUS
707 if (! NILP (position))
709 check_x ();
711 /* Decode the first argument: find the window and the coordinates. */
712 if (EQ (position, Qt)
713 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
714 || EQ (XCAR (position), Qtool_bar))))
716 /* Use the mouse's current position. */
717 FRAME_PTR new_f = SELECTED_FRAME ();
718 Lisp_Object bar_window;
719 enum scroll_bar_part part;
720 unsigned long time;
722 if (mouse_position_hook)
723 (*mouse_position_hook) (&new_f, 1, &bar_window,
724 &part, &x, &y, &time);
725 if (new_f != 0)
726 XSETFRAME (window, new_f);
727 else
729 window = selected_window;
730 XSETFASTINT (x, 0);
731 XSETFASTINT (y, 0);
734 else
736 tem = Fcar (position);
737 if (CONSP (tem))
739 window = Fcar (Fcdr (position));
740 x = Fcar (tem);
741 y = Fcar (Fcdr (tem));
743 else
745 for_click = 1;
746 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
747 window = Fcar (tem); /* POSN_WINDOW (tem) */
748 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
749 x = Fcar (tem);
750 y = Fcdr (tem);
754 CHECK_NUMBER (x, 0);
755 CHECK_NUMBER (y, 0);
757 /* Decode where to put the menu. */
759 if (FRAMEP (window))
761 f = XFRAME (window);
762 xpos = 0;
763 ypos = 0;
765 else if (WINDOWP (window))
767 CHECK_LIVE_WINDOW (window, 0);
768 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
770 xpos = (FONT_WIDTH (f->output_data.x->font)
771 * XFASTINT (XWINDOW (window)->left));
772 ypos = (f->output_data.x->line_height
773 * XFASTINT (XWINDOW (window)->top));
775 else
776 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
777 but I don't want to make one now. */
778 CHECK_WINDOW (window, 0);
780 xpos += XINT (x);
781 ypos += XINT (y);
783 XSETFRAME (Vmenu_updating_frame, f);
785 Vmenu_updating_frame = Qnil;
786 #endif /* HAVE_MENUS */
788 title = Qnil;
789 GCPRO1 (title);
791 /* Decode the menu items from what was specified. */
793 keymap = get_keymap (menu, 0, 0);
794 if (CONSP (keymap))
796 /* We were given a keymap. Extract menu info from the keymap. */
797 Lisp_Object prompt;
799 /* Extract the detailed info to make one pane. */
800 keymap_panes (&menu, 1, NILP (position));
802 /* Search for a string appearing directly as an element of the keymap.
803 That string is the title of the menu. */
804 prompt = Fkeymap_prompt (keymap);
805 if (NILP (title) && !NILP (prompt))
806 title = prompt;
808 /* Make that be the pane title of the first pane. */
809 if (!NILP (prompt) && menu_items_n_panes >= 0)
810 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
812 keymaps = 1;
814 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
816 /* We were given a list of keymaps. */
817 int nmaps = XFASTINT (Flength (menu));
818 Lisp_Object *maps
819 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
820 int i;
822 title = Qnil;
824 /* The first keymap that has a prompt string
825 supplies the menu title. */
826 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
828 Lisp_Object prompt;
830 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
832 prompt = Fkeymap_prompt (keymap);
833 if (NILP (title) && !NILP (prompt))
834 title = prompt;
837 /* Extract the detailed info to make one pane. */
838 keymap_panes (maps, nmaps, NILP (position));
840 /* Make the title be the pane title of the first pane. */
841 if (!NILP (title) && menu_items_n_panes >= 0)
842 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
844 keymaps = 1;
846 else
848 /* We were given an old-fashioned menu. */
849 title = Fcar (menu);
850 CHECK_STRING (title, 1);
852 list_of_panes (Fcdr (menu));
854 keymaps = 0;
857 if (NILP (position))
859 discard_menu_items ();
860 UNGCPRO;
861 return Qnil;
864 #ifdef HAVE_MENUS
865 /* Display them in a menu. */
866 BLOCK_INPUT;
868 selection = xmenu_show (f, xpos, ypos, for_click,
869 keymaps, title, &error_name);
870 UNBLOCK_INPUT;
872 discard_menu_items ();
874 UNGCPRO;
875 #endif /* HAVE_MENUS */
877 if (error_name) error (error_name);
878 return selection;
881 #ifdef HAVE_MENUS
883 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
884 doc: /* Pop up a dialog box and return user's selection.
885 POSITION specifies which frame to use.
886 This is normally a mouse button event or a window or frame.
887 If POSITION is t, it means to use the frame the mouse is on.
888 The dialog box appears in the middle of the specified frame.
890 CONTENTS specifies the alternatives to display in the dialog box.
891 It is a list of the form (TITLE ITEM1 ITEM2...).
892 Each ITEM is a cons cell (STRING . VALUE).
893 The return value is VALUE from the chosen item.
895 An ITEM may also be just a string--that makes a nonselectable item.
896 An ITEM may also be nil--that means to put all preceding items
897 on the left of the dialog box and all following items on the right.
898 \(By default, approximately half appear on each side.) */)
899 (position, contents)
900 Lisp_Object position, contents;
902 struct frame * f = NULL;
903 Lisp_Object window;
905 check_x ();
907 /* Decode the first argument: find the window or frame to use. */
908 if (EQ (position, Qt)
909 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
910 || EQ (XCAR (position), Qtool_bar))))
912 #if 0 /* Using the frame the mouse is on may not be right. */
913 /* Use the mouse's current position. */
914 FRAME_PTR new_f = SELECTED_FRAME ();
915 Lisp_Object bar_window;
916 int part;
917 unsigned long time;
918 Lisp_Object x, y;
920 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
922 if (new_f != 0)
923 XSETFRAME (window, new_f);
924 else
925 window = selected_window;
926 #endif
927 window = selected_window;
929 else if (CONSP (position))
931 Lisp_Object tem;
932 tem = Fcar (position);
933 if (CONSP (tem))
934 window = Fcar (Fcdr (position));
935 else
937 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
938 window = Fcar (tem); /* POSN_WINDOW (tem) */
941 else if (WINDOWP (position) || FRAMEP (position))
942 window = position;
943 else
944 window = Qnil;
946 /* Decode where to put the menu. */
948 if (FRAMEP (window))
949 f = XFRAME (window);
950 else if (WINDOWP (window))
952 CHECK_LIVE_WINDOW (window, 0);
953 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
955 else
956 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
957 but I don't want to make one now. */
958 CHECK_WINDOW (window, 0);
960 #ifndef USE_X_TOOLKIT
961 /* Display a menu with these alternatives
962 in the middle of frame F. */
964 Lisp_Object x, y, frame, newpos;
965 XSETFRAME (frame, f);
966 XSETINT (x, x_pixel_width (f) / 2);
967 XSETINT (y, x_pixel_height (f) / 2);
968 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
970 return Fx_popup_menu (newpos,
971 Fcons (Fcar (contents), Fcons (contents, Qnil)));
973 #else
975 Lisp_Object title;
976 char *error_name;
977 Lisp_Object selection;
979 /* Decode the dialog items from what was specified. */
980 title = Fcar (contents);
981 CHECK_STRING (title, 1);
983 list_of_panes (Fcons (contents, Qnil));
985 /* Display them in a dialog box. */
986 BLOCK_INPUT;
987 selection = xdialog_show (f, 0, title, &error_name);
988 UNBLOCK_INPUT;
990 discard_menu_items ();
992 if (error_name) error (error_name);
993 return selection;
995 #endif
998 #ifdef USE_X_TOOLKIT
1000 /* Loop in Xt until the menu pulldown or dialog popup has been
1001 popped down (deactivated). This is used for x-popup-menu
1002 and x-popup-dialog; it is not used for the menu bar any more.
1004 NOTE: All calls to popup_get_selection should be protected
1005 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1007 void
1008 popup_get_selection (initial_event, dpyinfo, id)
1009 XEvent *initial_event;
1010 struct x_display_info *dpyinfo;
1011 LWLIB_ID id;
1013 XEvent event;
1015 /* Define a queue to save up for later unreading
1016 all X events that don't pertain to the menu. */
1017 struct event_queue
1019 XEvent event;
1020 struct event_queue *next;
1023 struct event_queue *queue = NULL;
1024 struct event_queue *queue_tmp;
1026 if (initial_event)
1027 event = *initial_event;
1028 else
1029 XtAppNextEvent (Xt_app_con, &event);
1031 while (1)
1033 /* Handle expose events for editor frames right away. */
1034 if (event.type == Expose)
1035 process_expose_from_menu (event);
1036 /* Make sure we don't consider buttons grabbed after menu goes.
1037 And make sure to deactivate for any ButtonRelease,
1038 even if XtDispatchEvent doesn't do that. */
1039 else if (event.type == ButtonRelease
1040 && dpyinfo->display == event.xbutton.display)
1042 dpyinfo->grabbed &= ~(1 << event.xbutton.button);
1043 popup_activated_flag = 0;
1044 #ifdef USE_MOTIF /* Pretending that the event came from a
1045 Btn1Down seems the only way to convince Motif to
1046 activate its callbacks; setting the XmNmenuPost
1047 isn't working. --marcus@sysc.pdx.edu. */
1048 event.xbutton.button = 1;
1049 #endif
1051 /* If the user presses a key, deactivate the menu.
1052 The user is likely to do that if we get wedged. */
1053 else if (event.type == KeyPress
1054 && dpyinfo->display == event.xbutton.display)
1056 KeySym keysym = XLookupKeysym (&event.xkey, 0);
1057 if (!IsModifierKey (keysym))
1059 popup_activated_flag = 0;
1060 break;
1063 /* Button presses outside the menu also pop it down. */
1064 else if (event.type == ButtonPress
1065 && event.xany.display == dpyinfo->display
1066 && x_any_window_to_frame (dpyinfo, event.xany.window))
1068 popup_activated_flag = 0;
1069 break;
1072 /* Queue all events not for this popup,
1073 except for Expose, which we've already handled, and ButtonRelease.
1074 Note that the X window is associated with the frame if this
1075 is a menu bar popup, but not if it's a dialog box. So we use
1076 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1077 if (event.type != Expose
1078 && !(event.type == ButtonRelease
1079 && dpyinfo->display == event.xbutton.display)
1080 && (event.xany.display != dpyinfo->display
1081 || x_non_menubar_window_to_frame (dpyinfo, event.xany.window)))
1083 queue_tmp = (struct event_queue *) xmalloc (sizeof *queue_tmp);
1084 queue_tmp->event = event;
1085 queue_tmp->next = queue;
1086 queue = queue_tmp;
1088 else
1089 XtDispatchEvent (&event);
1091 if (!popup_activated ())
1092 break;
1093 XtAppNextEvent (Xt_app_con, &event);
1096 /* Unread any events that we got but did not handle. */
1097 while (queue != NULL)
1099 queue_tmp = queue;
1100 XPutBackEvent (queue_tmp->event.xany.display, &queue_tmp->event);
1101 queue = queue_tmp->next;
1102 xfree ((char *)queue_tmp);
1103 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1104 interrupt_input_pending = 1;
1108 /* Activate the menu bar of frame F.
1109 This is called from keyboard.c when it gets the
1110 menu_bar_activate_event out of the Emacs event queue.
1112 To activate the menu bar, we use the X button-press event
1113 that was saved in saved_menu_event.
1114 That makes the toolkit do its thing.
1116 But first we recompute the menu bar contents (the whole tree).
1118 The reason for saving the button event until here, instead of
1119 passing it to the toolkit right away, is that we can safely
1120 execute Lisp code. */
1122 void
1123 x_activate_menubar (f)
1124 FRAME_PTR f;
1126 if (!f->output_data.x->saved_menu_event->type)
1127 return;
1129 set_frame_menubar (f, 0, 1);
1130 BLOCK_INPUT;
1131 XtDispatchEvent ((XEvent *) f->output_data.x->saved_menu_event);
1132 UNBLOCK_INPUT;
1133 #ifdef USE_MOTIF
1134 if (f->output_data.x->saved_menu_event->type == ButtonRelease)
1135 pending_menu_activation = 1;
1136 #endif
1138 /* Ignore this if we get it a second time. */
1139 f->output_data.x->saved_menu_event->type = 0;
1142 /* Detect if a dialog or menu has been posted. */
1145 popup_activated ()
1147 return popup_activated_flag;
1150 /* This callback is invoked when the user selects a menubar cascade
1151 pushbutton, but before the pulldown menu is posted. */
1153 static void
1154 popup_activate_callback (widget, id, client_data)
1155 Widget widget;
1156 LWLIB_ID id;
1157 XtPointer client_data;
1159 popup_activated_flag = 1;
1162 /* This callback is invoked when a dialog or menu is finished being
1163 used and has been unposted. */
1165 static void
1166 popup_deactivate_callback (widget, id, client_data)
1167 Widget widget;
1168 LWLIB_ID id;
1169 XtPointer client_data;
1171 popup_activated_flag = 0;
1174 /* Lwlib callback called when menu items are highlighted/unhighlighted
1175 while moving the mouse over them. WIDGET is the menu bar or menu
1176 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1177 the widget_value structure for the menu item, or null in case of
1178 unhighlighting. */
1180 void
1181 menu_highlight_callback (widget, id, call_data)
1182 Widget widget;
1183 LWLIB_ID id;
1184 void *call_data;
1186 widget_value *wv = (widget_value *) call_data;
1187 struct frame *f;
1188 Lisp_Object frame, help;
1190 help = wv && wv->help ? build_string (wv->help) : Qnil;
1192 /* Determine the frame for the help event. */
1193 f = menubar_id_to_frame (id);
1194 if (f)
1196 XSETFRAME (frame, f);
1197 kbd_buffer_store_help_event (frame, help);
1199 else
1201 /* WIDGET is the popup menu. It's parent is the frame's
1202 widget. See which frame that is. */
1203 Widget frame_widget = XtParent (widget);
1204 Lisp_Object tail;
1206 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
1208 frame = XCAR (tail);
1209 if (GC_FRAMEP (frame)
1210 && (f = XFRAME (frame),
1211 FRAME_X_P (f) && f->output_data.x->widget == frame_widget))
1212 break;
1215 show_help_echo (help, Qnil, Qnil, Qnil, 1);
1219 /* This callback is called from the menu bar pulldown menu
1220 when the user makes a selection.
1221 Figure out what the user chose
1222 and put the appropriate events into the keyboard buffer. */
1224 static void
1225 menubar_selection_callback (widget, id, client_data)
1226 Widget widget;
1227 LWLIB_ID id;
1228 XtPointer client_data;
1230 Lisp_Object prefix, entry;
1231 FRAME_PTR f = menubar_id_to_frame (id);
1232 Lisp_Object vector;
1233 Lisp_Object *subprefix_stack;
1234 int submenu_depth = 0;
1235 int i;
1237 if (!f)
1238 return;
1239 entry = Qnil;
1240 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1241 vector = f->menu_bar_vector;
1242 prefix = Qnil;
1243 i = 0;
1244 while (i < f->menu_bar_items_used)
1246 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1248 subprefix_stack[submenu_depth++] = prefix;
1249 prefix = entry;
1250 i++;
1252 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1254 prefix = subprefix_stack[--submenu_depth];
1255 i++;
1257 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1259 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1260 i += MENU_ITEMS_PANE_LENGTH;
1262 else
1264 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1265 /* The EMACS_INT cast avoids a warning. There's no problem
1266 as long as pointers have enough bits to hold small integers. */
1267 if ((int) (EMACS_INT) client_data == i)
1269 int j;
1270 struct input_event buf;
1271 Lisp_Object frame;
1273 XSETFRAME (frame, f);
1274 buf.kind = MENU_BAR_EVENT;
1275 buf.frame_or_window = frame;
1276 buf.arg = frame;
1277 kbd_buffer_store_event (&buf);
1279 for (j = 0; j < submenu_depth; j++)
1280 if (!NILP (subprefix_stack[j]))
1282 buf.kind = MENU_BAR_EVENT;
1283 buf.frame_or_window = frame;
1284 buf.arg = subprefix_stack[j];
1285 kbd_buffer_store_event (&buf);
1288 if (!NILP (prefix))
1290 buf.kind = MENU_BAR_EVENT;
1291 buf.frame_or_window = frame;
1292 buf.arg = prefix;
1293 kbd_buffer_store_event (&buf);
1296 buf.kind = MENU_BAR_EVENT;
1297 buf.frame_or_window = frame;
1298 buf.arg = entry;
1299 kbd_buffer_store_event (&buf);
1301 return;
1303 i += MENU_ITEMS_ITEM_LENGTH;
1308 /* Allocate a widget_value, blocking input. */
1310 widget_value *
1311 xmalloc_widget_value ()
1313 widget_value *value;
1315 BLOCK_INPUT;
1316 value = malloc_widget_value ();
1317 UNBLOCK_INPUT;
1319 return value;
1322 /* This recursively calls free_widget_value on the tree of widgets.
1323 It must free all data that was malloc'ed for these widget_values.
1324 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1325 must be left alone. */
1327 void
1328 free_menubar_widget_value_tree (wv)
1329 widget_value *wv;
1331 if (! wv) return;
1333 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1335 if (wv->contents && (wv->contents != (widget_value*)1))
1337 free_menubar_widget_value_tree (wv->contents);
1338 wv->contents = (widget_value *) 0xDEADBEEF;
1340 if (wv->next)
1342 free_menubar_widget_value_tree (wv->next);
1343 wv->next = (widget_value *) 0xDEADBEEF;
1345 BLOCK_INPUT;
1346 free_widget_value (wv);
1347 UNBLOCK_INPUT;
1350 /* Return a tree of widget_value structures for a menu bar item
1351 whose event type is ITEM_KEY (with string ITEM_NAME)
1352 and whose contents come from the list of keymaps MAPS. */
1354 static widget_value *
1355 single_submenu (item_key, item_name, maps)
1356 Lisp_Object item_key, item_name, maps;
1358 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1359 int i;
1360 int submenu_depth = 0;
1361 Lisp_Object length;
1362 int len;
1363 Lisp_Object *mapvec;
1364 widget_value **submenu_stack;
1365 int previous_items = menu_items_used;
1366 int top_level_items = 0;
1368 length = Flength (maps);
1369 len = XINT (length);
1371 /* Convert the list MAPS into a vector MAPVEC. */
1372 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1373 for (i = 0; i < len; i++)
1375 mapvec[i] = Fcar (maps);
1376 maps = Fcdr (maps);
1379 menu_items_n_panes = 0;
1381 /* Loop over the given keymaps, making a pane for each map.
1382 But don't make a pane that is empty--ignore that map instead. */
1383 for (i = 0; i < len; i++)
1385 if (SYMBOLP (mapvec[i])
1386 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1388 /* Here we have a command at top level in the menu bar
1389 as opposed to a submenu. */
1390 top_level_items = 1;
1391 push_menu_pane (Qnil, Qnil);
1392 push_menu_item (item_name, Qt, item_key, mapvec[i],
1393 Qnil, Qnil, Qnil, Qnil);
1395 else
1396 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1399 /* Create a tree of widget_value objects
1400 representing the panes and their items. */
1402 submenu_stack
1403 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1404 wv = xmalloc_widget_value ();
1405 wv->name = "menu";
1406 wv->value = 0;
1407 wv->enabled = 1;
1408 wv->button_type = BUTTON_TYPE_NONE;
1409 first_wv = wv;
1410 save_wv = 0;
1411 prev_wv = 0;
1413 /* Loop over all panes and items made during this call
1414 and construct a tree of widget_value objects.
1415 Ignore the panes and items made by previous calls to
1416 single_submenu, even though those are also in menu_items. */
1417 i = previous_items;
1418 while (i < menu_items_used)
1420 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1422 submenu_stack[submenu_depth++] = save_wv;
1423 save_wv = prev_wv;
1424 prev_wv = 0;
1425 i++;
1427 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1429 prev_wv = save_wv;
1430 save_wv = submenu_stack[--submenu_depth];
1431 i++;
1433 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1434 && submenu_depth != 0)
1435 i += MENU_ITEMS_PANE_LENGTH;
1436 /* Ignore a nil in the item list.
1437 It's meaningful only for dialog boxes. */
1438 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1439 i += 1;
1440 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1442 /* Create a new pane. */
1443 Lisp_Object pane_name, prefix;
1444 char *pane_string;
1446 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1447 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1449 #ifndef HAVE_MULTILINGUAL_MENU
1450 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1452 pane_name = string_make_unibyte (pane_name);
1453 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1455 #endif
1456 pane_string = (NILP (pane_name)
1457 ? "" : (char *) XSTRING (pane_name)->data);
1458 /* If there is just one top-level pane, put all its items directly
1459 under the top-level menu. */
1460 if (menu_items_n_panes == 1)
1461 pane_string = "";
1463 /* If the pane has a meaningful name,
1464 make the pane a top-level menu item
1465 with its items as a submenu beneath it. */
1466 if (strcmp (pane_string, ""))
1468 wv = xmalloc_widget_value ();
1469 if (save_wv)
1470 save_wv->next = wv;
1471 else
1472 first_wv->contents = wv;
1473 wv->name = pane_string;
1474 /* Ignore the @ that means "separate pane".
1475 This is a kludge, but this isn't worth more time. */
1476 if (!NILP (prefix) && wv->name[0] == '@')
1477 wv->name++;
1478 wv->value = 0;
1479 wv->enabled = 1;
1480 wv->button_type = BUTTON_TYPE_NONE;
1482 save_wv = wv;
1483 prev_wv = 0;
1484 i += MENU_ITEMS_PANE_LENGTH;
1486 else
1488 /* Create a new item within current pane. */
1489 Lisp_Object item_name, enable, descrip, def, type, selected;
1490 Lisp_Object help;
1492 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1493 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1494 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1495 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1496 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1497 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1498 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1500 #ifndef HAVE_MULTILINGUAL_MENU
1501 if (STRING_MULTIBYTE (item_name))
1503 item_name = string_make_unibyte (item_name);
1504 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1507 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1509 descrip = string_make_unibyte (descrip);
1510 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1512 #endif /* not HAVE_MULTILINGUAL_MENU */
1514 wv = xmalloc_widget_value ();
1515 if (prev_wv)
1516 prev_wv->next = wv;
1517 else
1518 save_wv->contents = wv;
1520 wv->name = (char *) XSTRING (item_name)->data;
1521 if (!NILP (descrip))
1522 wv->key = (char *) XSTRING (descrip)->data;
1523 wv->value = 0;
1524 /* The EMACS_INT cast avoids a warning. There's no problem
1525 as long as pointers have enough bits to hold small integers. */
1526 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1527 wv->enabled = !NILP (enable);
1529 if (NILP (type))
1530 wv->button_type = BUTTON_TYPE_NONE;
1531 else if (EQ (type, QCradio))
1532 wv->button_type = BUTTON_TYPE_RADIO;
1533 else if (EQ (type, QCtoggle))
1534 wv->button_type = BUTTON_TYPE_TOGGLE;
1535 else
1536 abort ();
1538 wv->selected = !NILP (selected);
1539 if (STRINGP (help))
1540 wv->help = XSTRING (help)->data;
1542 prev_wv = wv;
1544 i += MENU_ITEMS_ITEM_LENGTH;
1548 /* If we have just one "menu item"
1549 that was originally a button, return it by itself. */
1550 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1552 wv = first_wv->contents;
1553 free_widget_value (first_wv);
1554 return wv;
1557 return first_wv;
1562 /* Recompute all the widgets of frame F, when the menu bar has been
1563 changed. Value is non-zero if widgets were updated. */
1565 static int
1566 update_frame_menubar (f)
1567 FRAME_PTR f;
1569 struct x_output *x = f->output_data.x;
1570 int columns, rows;
1572 if (!x->menubar_widget || XtIsManaged (x->menubar_widget))
1573 return 0;
1575 BLOCK_INPUT;
1576 /* Save the size of the frame because the pane widget doesn't accept
1577 to resize itself. So force it. */
1578 columns = f->width;
1579 rows = f->height;
1581 /* Do the voodoo which means "I'm changing lots of things, don't try
1582 to refigure sizes until I'm done." */
1583 lw_refigure_widget (x->column_widget, False);
1585 /* The order in which children are managed is the top to bottom
1586 order in which they are displayed in the paned window. First,
1587 remove the text-area widget. */
1588 XtUnmanageChild (x->edit_widget);
1590 /* Remove the menubar that is there now, and put up the menubar that
1591 should be there. */
1592 XtManageChild (x->menubar_widget);
1593 XtMapWidget (x->menubar_widget);
1594 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, NULL);
1596 /* Re-manage the text-area widget, and then thrash the sizes. */
1597 XtManageChild (x->edit_widget);
1598 lw_refigure_widget (x->column_widget, True);
1600 /* Force the pane widget to resize itself with the right values. */
1601 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1602 UNBLOCK_INPUT;
1603 return 1;
1606 /* Set the contents of the menubar widgets of frame F.
1607 The argument FIRST_TIME is currently ignored;
1608 it is set the first time this is called, from initialize_frame_menubar. */
1610 void
1611 set_frame_menubar (f, first_time, deep_p)
1612 FRAME_PTR f;
1613 int first_time;
1614 int deep_p;
1616 Widget menubar_widget = f->output_data.x->menubar_widget;
1617 Lisp_Object items;
1618 widget_value *wv, *first_wv, *prev_wv = 0;
1619 int i;
1620 LWLIB_ID id;
1622 XSETFRAME (Vmenu_updating_frame, f);
1624 if (f->output_data.x->id == 0)
1625 f->output_data.x->id = next_menubar_widget_id++;
1626 id = f->output_data.x->id;
1628 if (! menubar_widget)
1629 deep_p = 1;
1630 else if (pending_menu_activation && !deep_p)
1631 deep_p = 1;
1632 /* Make the first call for any given frame always go deep. */
1633 else if (!f->output_data.x->saved_menu_event && !deep_p)
1635 deep_p = 1;
1636 f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent));
1637 f->output_data.x->saved_menu_event->type = 0;
1640 wv = xmalloc_widget_value ();
1641 wv->name = "menubar";
1642 wv->value = 0;
1643 wv->enabled = 1;
1644 wv->button_type = BUTTON_TYPE_NONE;
1645 first_wv = wv;
1647 if (deep_p)
1649 /* Make a widget-value tree representing the entire menu trees. */
1651 struct buffer *prev = current_buffer;
1652 Lisp_Object buffer;
1653 int specpdl_count = specpdl_ptr - specpdl;
1654 int previous_menu_items_used = f->menu_bar_items_used;
1655 Lisp_Object *previous_items
1656 = (Lisp_Object *) alloca (previous_menu_items_used
1657 * sizeof (Lisp_Object));
1659 /* If we are making a new widget, its contents are empty,
1660 do always reinitialize them. */
1661 if (! menubar_widget)
1662 previous_menu_items_used = 0;
1664 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1665 specbind (Qinhibit_quit, Qt);
1666 /* Don't let the debugger step into this code
1667 because it is not reentrant. */
1668 specbind (Qdebug_on_next_call, Qnil);
1670 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1671 if (NILP (Voverriding_local_map_menu_flag))
1673 specbind (Qoverriding_terminal_local_map, Qnil);
1674 specbind (Qoverriding_local_map, Qnil);
1677 set_buffer_internal_1 (XBUFFER (buffer));
1679 /* Run the Lucid hook. */
1680 safe_run_hooks (Qactivate_menubar_hook);
1682 /* If it has changed current-menubar from previous value,
1683 really recompute the menubar from the value. */
1684 if (! NILP (Vlucid_menu_bar_dirty_flag))
1685 call0 (Qrecompute_lucid_menubar);
1686 safe_run_hooks (Qmenu_bar_update_hook);
1687 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1689 items = FRAME_MENU_BAR_ITEMS (f);
1691 inhibit_garbage_collection ();
1693 /* Save the frame's previous menu bar contents data. */
1694 if (previous_menu_items_used)
1695 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1696 previous_menu_items_used * sizeof (Lisp_Object));
1698 /* Fill in the current menu bar contents. */
1699 menu_items = f->menu_bar_vector;
1700 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1701 init_menu_items ();
1702 for (i = 0; i < XVECTOR (items)->size; i += 4)
1704 Lisp_Object key, string, maps;
1706 key = XVECTOR (items)->contents[i];
1707 string = XVECTOR (items)->contents[i + 1];
1708 maps = XVECTOR (items)->contents[i + 2];
1709 if (NILP (string))
1710 break;
1712 wv = single_submenu (key, string, maps);
1713 if (prev_wv)
1714 prev_wv->next = wv;
1715 else
1716 first_wv->contents = wv;
1717 /* Don't set wv->name here; GC during the loop might relocate it. */
1718 wv->enabled = 1;
1719 wv->button_type = BUTTON_TYPE_NONE;
1720 prev_wv = wv;
1723 finish_menu_items ();
1725 set_buffer_internal_1 (prev);
1726 unbind_to (specpdl_count, Qnil);
1728 /* If there has been no change in the Lisp-level contents
1729 of the menu bar, skip redisplaying it. Just exit. */
1731 for (i = 0; i < previous_menu_items_used; i++)
1732 if (menu_items_used == i
1733 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1734 break;
1735 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1737 free_menubar_widget_value_tree (first_wv);
1738 menu_items = Qnil;
1740 return;
1743 /* Now GC cannot happen during the lifetime of the widget_value,
1744 so it's safe to store data from a Lisp_String. */
1745 wv = first_wv->contents;
1746 for (i = 0; i < XVECTOR (items)->size; i += 4)
1748 Lisp_Object string;
1749 string = XVECTOR (items)->contents[i + 1];
1750 if (NILP (string))
1751 break;
1752 wv->name = (char *) XSTRING (string)->data;
1753 wv = wv->next;
1756 f->menu_bar_vector = menu_items;
1757 f->menu_bar_items_used = menu_items_used;
1758 menu_items = Qnil;
1760 else
1762 /* Make a widget-value tree containing
1763 just the top level menu bar strings. */
1765 items = FRAME_MENU_BAR_ITEMS (f);
1766 for (i = 0; i < XVECTOR (items)->size; i += 4)
1768 Lisp_Object string;
1770 string = XVECTOR (items)->contents[i + 1];
1771 if (NILP (string))
1772 break;
1774 wv = xmalloc_widget_value ();
1775 wv->name = (char *) XSTRING (string)->data;
1776 wv->value = 0;
1777 wv->enabled = 1;
1778 wv->button_type = BUTTON_TYPE_NONE;
1779 /* This prevents lwlib from assuming this
1780 menu item is really supposed to be empty. */
1781 /* The EMACS_INT cast avoids a warning.
1782 This value just has to be different from small integers. */
1783 wv->call_data = (void *) (EMACS_INT) (-1);
1785 if (prev_wv)
1786 prev_wv->next = wv;
1787 else
1788 first_wv->contents = wv;
1789 prev_wv = wv;
1792 /* Forget what we thought we knew about what is in the
1793 detailed contents of the menu bar menus.
1794 Changing the top level always destroys the contents. */
1795 f->menu_bar_items_used = 0;
1798 /* Create or update the menu bar widget. */
1800 BLOCK_INPUT;
1802 if (menubar_widget)
1804 /* Disable resizing (done for Motif!) */
1805 lw_allow_resizing (f->output_data.x->widget, False);
1807 /* The third arg is DEEP_P, which says to consider the entire
1808 menu trees we supply, rather than just the menu bar item names. */
1809 lw_modify_all_widgets (id, first_wv, deep_p);
1811 /* Re-enable the edit widget to resize. */
1812 lw_allow_resizing (f->output_data.x->widget, True);
1814 else
1816 menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv,
1817 f->output_data.x->column_widget,
1819 popup_activate_callback,
1820 menubar_selection_callback,
1821 popup_deactivate_callback,
1822 menu_highlight_callback);
1823 f->output_data.x->menubar_widget = menubar_widget;
1827 int menubar_size
1828 = (f->output_data.x->menubar_widget
1829 ? (f->output_data.x->menubar_widget->core.height
1830 + f->output_data.x->menubar_widget->core.border_width)
1831 : 0);
1833 #if 0 /* Experimentally, we now get the right results
1834 for -geometry -0-0 without this. 24 Aug 96, rms. */
1835 #ifdef USE_LUCID
1836 if (FRAME_EXTERNAL_MENU_BAR (f))
1838 Dimension ibw = 0;
1839 XtVaGetValues (f->output_data.x->column_widget,
1840 XtNinternalBorderWidth, &ibw, NULL);
1841 menubar_size += ibw;
1843 #endif /* USE_LUCID */
1844 #endif /* 0 */
1846 f->output_data.x->menubar_height = menubar_size;
1849 free_menubar_widget_value_tree (first_wv);
1850 update_frame_menubar (f);
1852 UNBLOCK_INPUT;
1855 /* Called from Fx_create_frame to create the initial menubar of a frame
1856 before it is mapped, so that the window is mapped with the menubar already
1857 there instead of us tacking it on later and thrashing the window after it
1858 is visible. */
1860 void
1861 initialize_frame_menubar (f)
1862 FRAME_PTR f;
1864 /* This function is called before the first chance to redisplay
1865 the frame. It has to be, so the frame will have the right size. */
1866 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1867 set_frame_menubar (f, 1, 1);
1871 /* Get rid of the menu bar of frame F, and free its storage.
1872 This is used when deleting a frame, and when turning off the menu bar. */
1874 void
1875 free_frame_menubar (f)
1876 FRAME_PTR f;
1878 Widget menubar_widget;
1880 menubar_widget = f->output_data.x->menubar_widget;
1882 f->output_data.x->menubar_height = 0;
1884 if (menubar_widget)
1886 #ifdef USE_MOTIF
1887 /* Removing the menu bar magically changes the shell widget's x
1888 and y position of (0, 0) which, when the menu bar is turned
1889 on again, leads to pull-down menuss appearing in strange
1890 positions near the upper-left corner of the display. This
1891 happens only with some window managers like twm and ctwm,
1892 but not with other like Motif's mwm or kwm, because the
1893 latter generate ConfigureNotify events when the menu bar
1894 is switched off, which fixes the shell position. */
1895 Position x0, y0, x1, y1;
1896 #endif
1898 BLOCK_INPUT;
1900 #ifdef USE_MOTIF
1901 if (f->output_data.x->widget)
1902 XtVaGetValues (f->output_data.x->widget, XtNx, &x0, XtNy, &y0, NULL);
1903 #endif
1905 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
1906 f->output_data.x->menubar_widget = NULL;
1908 #ifdef USE_MOTIF
1909 if (f->output_data.x->widget)
1911 XtVaGetValues (f->output_data.x->widget, XtNx, &x1, XtNy, &y1, NULL);
1912 if (x1 == 0 && y1 == 0)
1913 XtVaSetValues (f->output_data.x->widget, XtNx, x0, XtNy, y0, NULL);
1915 #endif
1917 UNBLOCK_INPUT;
1921 #endif /* USE_X_TOOLKIT */
1923 /* xmenu_show actually displays a menu using the panes and items in menu_items
1924 and returns the value selected from it.
1925 There are two versions of xmenu_show, one for Xt and one for Xlib.
1926 Both assume input is blocked by the caller. */
1928 /* F is the frame the menu is for.
1929 X and Y are the frame-relative specified position,
1930 relative to the inside upper left corner of the frame F.
1931 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1932 KEYMAPS is 1 if this menu was specified with keymaps;
1933 in that case, we return a list containing the chosen item's value
1934 and perhaps also the pane's prefix.
1935 TITLE is the specified menu title.
1936 ERROR is a place to store an error message string in case of failure.
1937 (We return nil on failure, but the value doesn't actually matter.) */
1939 #ifdef USE_X_TOOLKIT
1941 /* We need a unique id for each widget handled by the Lucid Widget
1942 library.
1944 For the main windows, and popup menus, we use this counter,
1945 which we increment each time after use. This starts from 1<<16.
1947 For menu bars, we use numbers starting at 0, counted in
1948 next_menubar_widget_id. */
1949 LWLIB_ID widget_id_tick;
1951 static Lisp_Object *volatile menu_item_selection;
1953 static void
1954 popup_selection_callback (widget, id, client_data)
1955 Widget widget;
1956 LWLIB_ID id;
1957 XtPointer client_data;
1959 menu_item_selection = (Lisp_Object *) client_data;
1962 static Lisp_Object
1963 xmenu_show (f, x, y, for_click, keymaps, title, error)
1964 FRAME_PTR f;
1965 int x;
1966 int y;
1967 int for_click;
1968 int keymaps;
1969 Lisp_Object title;
1970 char **error;
1972 int i;
1973 LWLIB_ID menu_id;
1974 Widget menu;
1975 Arg av[2];
1976 int ac = 0;
1977 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1978 widget_value **submenu_stack
1979 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1980 Lisp_Object *subprefix_stack
1981 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1982 int submenu_depth = 0;
1983 XButtonPressedEvent dummy;
1985 int first_pane;
1987 *error = NULL;
1989 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1991 *error = "Empty menu";
1992 return Qnil;
1995 /* Create a tree of widget_value objects
1996 representing the panes and their items. */
1997 wv = xmalloc_widget_value ();
1998 wv->name = "menu";
1999 wv->value = 0;
2000 wv->enabled = 1;
2001 wv->button_type = BUTTON_TYPE_NONE;
2002 first_wv = wv;
2003 first_pane = 1;
2005 /* Loop over all panes and items, filling in the tree. */
2006 i = 0;
2007 while (i < menu_items_used)
2009 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2011 submenu_stack[submenu_depth++] = save_wv;
2012 save_wv = prev_wv;
2013 prev_wv = 0;
2014 first_pane = 1;
2015 i++;
2017 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2019 prev_wv = save_wv;
2020 save_wv = submenu_stack[--submenu_depth];
2021 first_pane = 0;
2022 i++;
2024 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
2025 && submenu_depth != 0)
2026 i += MENU_ITEMS_PANE_LENGTH;
2027 /* Ignore a nil in the item list.
2028 It's meaningful only for dialog boxes. */
2029 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2030 i += 1;
2031 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2033 /* Create a new pane. */
2034 Lisp_Object pane_name, prefix;
2035 char *pane_string;
2037 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2038 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2040 #ifndef HAVE_MULTILINGUAL_MENU
2041 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
2043 pane_name = string_make_unibyte (pane_name);
2044 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
2046 #endif
2047 pane_string = (NILP (pane_name)
2048 ? "" : (char *) XSTRING (pane_name)->data);
2049 /* If there is just one top-level pane, put all its items directly
2050 under the top-level menu. */
2051 if (menu_items_n_panes == 1)
2052 pane_string = "";
2054 /* If the pane has a meaningful name,
2055 make the pane a top-level menu item
2056 with its items as a submenu beneath it. */
2057 if (!keymaps && strcmp (pane_string, ""))
2059 wv = xmalloc_widget_value ();
2060 if (save_wv)
2061 save_wv->next = wv;
2062 else
2063 first_wv->contents = wv;
2064 wv->name = pane_string;
2065 if (keymaps && !NILP (prefix))
2066 wv->name++;
2067 wv->value = 0;
2068 wv->enabled = 1;
2069 wv->button_type = BUTTON_TYPE_NONE;
2070 save_wv = wv;
2071 prev_wv = 0;
2073 else if (first_pane)
2075 save_wv = wv;
2076 prev_wv = 0;
2078 first_pane = 0;
2079 i += MENU_ITEMS_PANE_LENGTH;
2081 else
2083 /* Create a new item within current pane. */
2084 Lisp_Object item_name, enable, descrip, def, type, selected, help;
2085 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2086 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2087 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2088 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
2089 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
2090 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
2091 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2093 #ifndef HAVE_MULTILINGUAL_MENU
2094 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
2096 item_name = string_make_unibyte (item_name);
2097 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
2100 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
2102 descrip = string_make_unibyte (descrip);
2103 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
2105 #endif /* not HAVE_MULTILINGUAL_MENU */
2107 wv = xmalloc_widget_value ();
2108 if (prev_wv)
2109 prev_wv->next = wv;
2110 else
2111 save_wv->contents = wv;
2112 wv->name = (char *) XSTRING (item_name)->data;
2113 if (!NILP (descrip))
2114 wv->key = (char *) XSTRING (descrip)->data;
2115 wv->value = 0;
2116 /* If this item has a null value,
2117 make the call_data null so that it won't display a box
2118 when the mouse is on it. */
2119 wv->call_data
2120 = (!NILP (def) ? (void *) &XVECTOR (menu_items)->contents[i] : 0);
2121 wv->enabled = !NILP (enable);
2123 if (NILP (type))
2124 wv->button_type = BUTTON_TYPE_NONE;
2125 else if (EQ (type, QCtoggle))
2126 wv->button_type = BUTTON_TYPE_TOGGLE;
2127 else if (EQ (type, QCradio))
2128 wv->button_type = BUTTON_TYPE_RADIO;
2129 else
2130 abort ();
2132 wv->selected = !NILP (selected);
2133 if (STRINGP (help))
2134 wv->help = XSTRING (help)->data;
2136 prev_wv = wv;
2138 i += MENU_ITEMS_ITEM_LENGTH;
2142 /* Deal with the title, if it is non-nil. */
2143 if (!NILP (title))
2145 widget_value *wv_title = xmalloc_widget_value ();
2146 widget_value *wv_sep1 = xmalloc_widget_value ();
2147 widget_value *wv_sep2 = xmalloc_widget_value ();
2149 wv_sep2->name = "--";
2150 wv_sep2->next = first_wv->contents;
2152 wv_sep1->name = "--";
2153 wv_sep1->next = wv_sep2;
2155 #ifndef HAVE_MULTILINGUAL_MENU
2156 if (STRING_MULTIBYTE (title))
2157 title = string_make_unibyte (title);
2158 #endif
2160 wv_title->name = (char *) XSTRING (title)->data;
2161 wv_title->enabled = True;
2162 wv_title->button_type = BUTTON_TYPE_NONE;
2163 wv_title->next = wv_sep1;
2164 first_wv->contents = wv_title;
2167 /* Actually create the menu. */
2168 menu_id = widget_id_tick++;
2169 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
2170 f->output_data.x->widget, 1, 0,
2171 popup_selection_callback,
2172 popup_deactivate_callback,
2173 menu_highlight_callback);
2175 /* Adjust coordinates to relative to the outer (window manager) window. */
2177 Window child;
2178 int win_x = 0, win_y = 0;
2180 /* Find the position of the outside upper-left corner of
2181 the inner window, with respect to the outer window. */
2182 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
2184 BLOCK_INPUT;
2185 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2187 /* From-window, to-window. */
2188 f->output_data.x->window_desc,
2189 f->output_data.x->parent_desc,
2191 /* From-position, to-position. */
2192 0, 0, &win_x, &win_y,
2194 /* Child of window. */
2195 &child);
2196 UNBLOCK_INPUT;
2197 x += win_x;
2198 y += win_y;
2202 /* Adjust coordinates to be root-window-relative. */
2203 x += f->output_data.x->left_pos;
2204 y += f->output_data.x->top_pos;
2206 dummy.type = ButtonPress;
2207 dummy.serial = 0;
2208 dummy.send_event = 0;
2209 dummy.display = FRAME_X_DISPLAY (f);
2210 dummy.time = CurrentTime;
2211 dummy.root = FRAME_X_DISPLAY_INFO (f)->root_window;
2212 dummy.window = dummy.root;
2213 dummy.subwindow = dummy.root;
2214 dummy.x_root = x;
2215 dummy.y_root = y;
2216 dummy.x = x;
2217 dummy.y = y;
2218 dummy.state = (FRAME_X_DISPLAY_INFO (f)->grabbed >> 1) * Button1Mask;
2219 dummy.button = 0;
2220 for (i = 0; i < 5; i++)
2221 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2222 dummy.button = i;
2224 /* Don't allow any geometry request from the user. */
2225 XtSetArg (av[ac], XtNgeometry, 0); ac++;
2226 XtSetValues (menu, av, ac);
2228 /* Free the widget_value objects we used to specify the contents. */
2229 free_menubar_widget_value_tree (first_wv);
2231 /* No selection has been chosen yet. */
2232 menu_item_selection = 0;
2234 /* Display the menu. */
2235 lw_popup_menu (menu, (XEvent *) &dummy);
2236 popup_activated_flag = 1;
2238 /* Process events that apply to the menu. */
2239 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id);
2241 /* fp turned off the following statement and wrote a comment
2242 that it is unnecessary--that the menu has already disappeared.
2243 Nowadays the menu disappears ok, all right, but
2244 we need to delete the widgets or multiple ones will pile up. */
2245 lw_destroy_all_widgets (menu_id);
2247 /* Find the selected item, and its pane, to return
2248 the proper value. */
2249 if (menu_item_selection != 0)
2251 Lisp_Object prefix, entry;
2253 prefix = entry = Qnil;
2254 i = 0;
2255 while (i < menu_items_used)
2257 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2259 subprefix_stack[submenu_depth++] = prefix;
2260 prefix = entry;
2261 i++;
2263 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2265 prefix = subprefix_stack[--submenu_depth];
2266 i++;
2268 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2270 prefix
2271 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2272 i += MENU_ITEMS_PANE_LENGTH;
2274 /* Ignore a nil in the item list.
2275 It's meaningful only for dialog boxes. */
2276 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2277 i += 1;
2278 else
2280 entry
2281 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2282 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2284 if (keymaps != 0)
2286 int j;
2288 entry = Fcons (entry, Qnil);
2289 if (!NILP (prefix))
2290 entry = Fcons (prefix, entry);
2291 for (j = submenu_depth - 1; j >= 0; j--)
2292 if (!NILP (subprefix_stack[j]))
2293 entry = Fcons (subprefix_stack[j], entry);
2295 return entry;
2297 i += MENU_ITEMS_ITEM_LENGTH;
2302 return Qnil;
2305 static void
2306 dialog_selection_callback (widget, id, client_data)
2307 Widget widget;
2308 LWLIB_ID id;
2309 XtPointer client_data;
2311 /* The EMACS_INT cast avoids a warning. There's no problem
2312 as long as pointers have enough bits to hold small integers. */
2313 if ((int) (EMACS_INT) client_data != -1)
2314 menu_item_selection = (Lisp_Object *) client_data;
2315 BLOCK_INPUT;
2316 lw_destroy_all_widgets (id);
2317 UNBLOCK_INPUT;
2318 popup_activated_flag = 0;
2321 static char * button_names [] = {
2322 "button1", "button2", "button3", "button4", "button5",
2323 "button6", "button7", "button8", "button9", "button10" };
2325 static Lisp_Object
2326 xdialog_show (f, keymaps, title, error)
2327 FRAME_PTR f;
2328 int keymaps;
2329 Lisp_Object title;
2330 char **error;
2332 int i, nb_buttons=0;
2333 LWLIB_ID dialog_id;
2334 Widget menu;
2335 char dialog_name[6];
2337 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2339 /* Number of elements seen so far, before boundary. */
2340 int left_count = 0;
2341 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2342 int boundary_seen = 0;
2344 *error = NULL;
2346 if (menu_items_n_panes > 1)
2348 *error = "Multiple panes in dialog box";
2349 return Qnil;
2352 /* Create a tree of widget_value objects
2353 representing the text label and buttons. */
2355 Lisp_Object pane_name, prefix;
2356 char *pane_string;
2357 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2358 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2359 pane_string = (NILP (pane_name)
2360 ? "" : (char *) XSTRING (pane_name)->data);
2361 prev_wv = xmalloc_widget_value ();
2362 prev_wv->value = pane_string;
2363 if (keymaps && !NILP (prefix))
2364 prev_wv->name++;
2365 prev_wv->enabled = 1;
2366 prev_wv->name = "message";
2367 first_wv = prev_wv;
2369 /* Loop over all panes and items, filling in the tree. */
2370 i = MENU_ITEMS_PANE_LENGTH;
2371 while (i < menu_items_used)
2374 /* Create a new item within current pane. */
2375 Lisp_Object item_name, enable, descrip;
2376 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2377 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2378 descrip
2379 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2381 if (NILP (item_name))
2383 free_menubar_widget_value_tree (first_wv);
2384 *error = "Submenu in dialog items";
2385 return Qnil;
2387 if (EQ (item_name, Qquote))
2389 /* This is the boundary between left-side elts
2390 and right-side elts. Stop incrementing right_count. */
2391 boundary_seen = 1;
2392 i++;
2393 continue;
2395 if (nb_buttons >= 9)
2397 free_menubar_widget_value_tree (first_wv);
2398 *error = "Too many dialog items";
2399 return Qnil;
2402 wv = xmalloc_widget_value ();
2403 prev_wv->next = wv;
2404 wv->name = (char *) button_names[nb_buttons];
2405 if (!NILP (descrip))
2406 wv->key = (char *) XSTRING (descrip)->data;
2407 wv->value = (char *) XSTRING (item_name)->data;
2408 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
2409 wv->enabled = !NILP (enable);
2410 prev_wv = wv;
2412 if (! boundary_seen)
2413 left_count++;
2415 nb_buttons++;
2416 i += MENU_ITEMS_ITEM_LENGTH;
2419 /* If the boundary was not specified,
2420 by default put half on the left and half on the right. */
2421 if (! boundary_seen)
2422 left_count = nb_buttons - nb_buttons / 2;
2424 wv = xmalloc_widget_value ();
2425 wv->name = dialog_name;
2427 /* Dialog boxes use a really stupid name encoding
2428 which specifies how many buttons to use
2429 and how many buttons are on the right.
2430 The Q means something also. */
2431 dialog_name[0] = 'Q';
2432 dialog_name[1] = '0' + nb_buttons;
2433 dialog_name[2] = 'B';
2434 dialog_name[3] = 'R';
2435 /* Number of buttons to put on the right. */
2436 dialog_name[4] = '0' + nb_buttons - left_count;
2437 dialog_name[5] = 0;
2438 wv->contents = first_wv;
2439 first_wv = wv;
2442 /* Actually create the dialog. */
2443 dialog_id = widget_id_tick++;
2444 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2445 f->output_data.x->widget, 1, 0,
2446 dialog_selection_callback, 0, 0);
2447 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
2448 /* Free the widget_value objects we used to specify the contents. */
2449 free_menubar_widget_value_tree (first_wv);
2451 /* No selection has been chosen yet. */
2452 menu_item_selection = 0;
2454 /* Display the menu. */
2455 lw_pop_up_all_widgets (dialog_id);
2456 popup_activated_flag = 1;
2458 /* Process events that apply to the menu. */
2459 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2461 lw_destroy_all_widgets (dialog_id);
2463 /* Find the selected item, and its pane, to return
2464 the proper value. */
2465 if (menu_item_selection != 0)
2467 Lisp_Object prefix;
2469 prefix = Qnil;
2470 i = 0;
2471 while (i < menu_items_used)
2473 Lisp_Object entry;
2475 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2477 prefix
2478 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2479 i += MENU_ITEMS_PANE_LENGTH;
2481 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2483 /* This is the boundary between left-side elts and
2484 right-side elts. */
2485 ++i;
2487 else
2489 entry
2490 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2491 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2493 if (keymaps != 0)
2495 entry = Fcons (entry, Qnil);
2496 if (!NILP (prefix))
2497 entry = Fcons (prefix, entry);
2499 return entry;
2501 i += MENU_ITEMS_ITEM_LENGTH;
2506 return Qnil;
2509 #else /* not USE_X_TOOLKIT */
2511 /* The frame of the last activated non-toolkit menu bar.
2512 Used to generate menu help events. */
2514 static struct frame *menu_help_frame;
2517 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
2519 PANE is the pane number, and ITEM is the menu item number in
2520 the menu (currently not used).
2522 This cannot be done with generating a HELP_EVENT because
2523 XMenuActivate contains a loop that doesn't let Emacs process
2524 keyboard events. */
2526 static void
2527 menu_help_callback (help_string, pane, item)
2528 char *help_string;
2529 int pane, item;
2531 extern Lisp_Object Qmenu_item;
2532 Lisp_Object *first_item;
2533 Lisp_Object pane_name;
2534 Lisp_Object menu_object;
2536 first_item = XVECTOR (menu_items)->contents;
2537 if (EQ (first_item[0], Qt))
2538 pane_name = first_item[MENU_ITEMS_PANE_NAME];
2539 else if (EQ (first_item[0], Qquote))
2540 /* This shouldn't happen, see xmenu_show. */
2541 pane_name = build_string ("");
2542 else
2543 pane_name = first_item[MENU_ITEMS_ITEM_NAME];
2545 /* (menu-item MENU-NAME PANE-NUMBER) */
2546 menu_object = Fcons (Qmenu_item,
2547 Fcons (pane_name,
2548 Fcons (make_number (pane), Qnil)));
2549 show_help_echo (help_string ? build_string (help_string) : Qnil,
2550 Qnil, menu_object, make_number (item), 1);
2554 static Lisp_Object
2555 xmenu_show (f, x, y, for_click, keymaps, title, error)
2556 FRAME_PTR f;
2557 int x, y;
2558 int for_click;
2559 int keymaps;
2560 Lisp_Object title;
2561 char **error;
2563 Window root;
2564 XMenu *menu;
2565 int pane, selidx, lpane, status;
2566 Lisp_Object entry, pane_prefix;
2567 char *datap;
2568 int ulx, uly, width, height;
2569 int dispwidth, dispheight;
2570 int i, j;
2571 int maxwidth;
2572 int dummy_int;
2573 unsigned int dummy_uint;
2575 *error = 0;
2576 if (menu_items_n_panes == 0)
2577 return Qnil;
2579 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2581 *error = "Empty menu";
2582 return Qnil;
2585 /* Figure out which root window F is on. */
2586 XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root,
2587 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
2588 &dummy_uint, &dummy_uint);
2590 /* Make the menu on that window. */
2591 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
2592 if (menu == NULL)
2594 *error = "Can't create menu";
2595 return Qnil;
2598 #ifdef HAVE_X_WINDOWS
2599 /* Adjust coordinates to relative to the outer (window manager) window. */
2601 Window child;
2602 int win_x = 0, win_y = 0;
2604 /* Find the position of the outside upper-left corner of
2605 the inner window, with respect to the outer window. */
2606 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
2608 BLOCK_INPUT;
2609 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2611 /* From-window, to-window. */
2612 f->output_data.x->window_desc,
2613 f->output_data.x->parent_desc,
2615 /* From-position, to-position. */
2616 0, 0, &win_x, &win_y,
2618 /* Child of window. */
2619 &child);
2620 UNBLOCK_INPUT;
2621 x += win_x;
2622 y += win_y;
2625 #endif /* HAVE_X_WINDOWS */
2627 /* Adjust coordinates to be root-window-relative. */
2628 x += f->output_data.x->left_pos;
2629 y += f->output_data.x->top_pos;
2631 /* Create all the necessary panes and their items. */
2632 i = 0;
2633 while (i < menu_items_used)
2635 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2637 /* Create a new pane. */
2638 Lisp_Object pane_name, prefix;
2639 char *pane_string;
2641 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
2642 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2643 pane_string = (NILP (pane_name)
2644 ? "" : (char *) XSTRING (pane_name)->data);
2645 if (keymaps && !NILP (prefix))
2646 pane_string++;
2648 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
2649 if (lpane == XM_FAILURE)
2651 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2652 *error = "Can't create pane";
2653 return Qnil;
2655 i += MENU_ITEMS_PANE_LENGTH;
2657 /* Find the width of the widest item in this pane. */
2658 maxwidth = 0;
2659 j = i;
2660 while (j < menu_items_used)
2662 Lisp_Object item;
2663 item = XVECTOR (menu_items)->contents[j];
2664 if (EQ (item, Qt))
2665 break;
2666 if (NILP (item))
2668 j++;
2669 continue;
2671 width = STRING_BYTES (XSTRING (item));
2672 if (width > maxwidth)
2673 maxwidth = width;
2675 j += MENU_ITEMS_ITEM_LENGTH;
2678 /* Ignore a nil in the item list.
2679 It's meaningful only for dialog boxes. */
2680 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2681 i += 1;
2682 else
2684 /* Create a new item within current pane. */
2685 Lisp_Object item_name, enable, descrip, help;
2686 unsigned char *item_data;
2687 char *help_string;
2689 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2690 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2691 descrip
2692 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2693 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
2694 help_string = STRINGP (help) ? XSTRING (help)->data : NULL;
2696 if (!NILP (descrip))
2698 int gap = maxwidth - STRING_BYTES (XSTRING (item_name));
2699 #ifdef C_ALLOCA
2700 Lisp_Object spacer;
2701 spacer = Fmake_string (make_number (gap), make_number (' '));
2702 item_name = concat2 (item_name, spacer);
2703 item_name = concat2 (item_name, descrip);
2704 item_data = XSTRING (item_name)->data;
2705 #else
2706 /* if alloca is fast, use that to make the space,
2707 to reduce gc needs. */
2708 item_data
2709 = (unsigned char *) alloca (maxwidth
2710 + STRING_BYTES (XSTRING (descrip)) + 1);
2711 bcopy (XSTRING (item_name)->data, item_data,
2712 STRING_BYTES (XSTRING (item_name)));
2713 for (j = XSTRING (item_name)->size; j < maxwidth; j++)
2714 item_data[j] = ' ';
2715 bcopy (XSTRING (descrip)->data, item_data + j,
2716 STRING_BYTES (XSTRING (descrip)));
2717 item_data[j + STRING_BYTES (XSTRING (descrip))] = 0;
2718 #endif
2720 else
2721 item_data = XSTRING (item_name)->data;
2723 if (XMenuAddSelection (FRAME_X_DISPLAY (f),
2724 menu, lpane, 0, item_data,
2725 !NILP (enable), help_string)
2726 == XM_FAILURE)
2728 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2729 *error = "Can't add selection to menu";
2730 return Qnil;
2732 i += MENU_ITEMS_ITEM_LENGTH;
2736 /* All set and ready to fly. */
2737 XMenuRecompute (FRAME_X_DISPLAY (f), menu);
2738 dispwidth = DisplayWidth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
2739 dispheight = DisplayHeight (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
2740 x = min (x, dispwidth);
2741 y = min (y, dispheight);
2742 x = max (x, 1);
2743 y = max (y, 1);
2744 XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y,
2745 &ulx, &uly, &width, &height);
2746 if (ulx+width > dispwidth)
2748 x -= (ulx + width) - dispwidth;
2749 ulx = dispwidth - width;
2751 if (uly+height > dispheight)
2753 y -= (uly + height) - dispheight;
2754 uly = dispheight - height;
2756 if (ulx < 0) x -= ulx;
2757 if (uly < 0) y -= uly;
2759 XMenuSetAEQ (menu, TRUE);
2760 XMenuSetFreeze (menu, TRUE);
2761 pane = selidx = 0;
2763 /* Help display under X won't work because XMenuActivate contains
2764 a loop that doesn't give Emacs a chance to process it. */
2765 menu_help_frame = f;
2766 status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
2767 x, y, ButtonReleaseMask, &datap,
2768 menu_help_callback);
2771 #ifdef HAVE_X_WINDOWS
2772 /* Assume the mouse has moved out of the X window.
2773 If it has actually moved in, we will get an EnterNotify. */
2774 x_mouse_leave (FRAME_X_DISPLAY_INFO (f));
2775 #endif
2777 switch (status)
2779 case XM_SUCCESS:
2780 #ifdef XDEBUG
2781 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
2782 #endif
2784 /* Find the item number SELIDX in pane number PANE. */
2785 i = 0;
2786 while (i < menu_items_used)
2788 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2790 if (pane == 0)
2791 pane_prefix
2792 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2793 pane--;
2794 i += MENU_ITEMS_PANE_LENGTH;
2796 else
2798 if (pane == -1)
2800 if (selidx == 0)
2802 entry
2803 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2804 if (keymaps != 0)
2806 entry = Fcons (entry, Qnil);
2807 if (!NILP (pane_prefix))
2808 entry = Fcons (pane_prefix, entry);
2810 break;
2812 selidx--;
2814 i += MENU_ITEMS_ITEM_LENGTH;
2817 break;
2819 case XM_FAILURE:
2820 *error = "Can't activate menu";
2821 case XM_IA_SELECT:
2822 case XM_NO_SELECT:
2823 entry = Qnil;
2824 break;
2826 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2828 #ifdef HAVE_X_WINDOWS
2829 /* State that no mouse buttons are now held.
2830 (The oldXMenu code doesn't track this info for us.)
2831 That is not necessarily true, but the fiction leads to reasonable
2832 results, and it is a pain to ask which are actually held now. */
2833 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
2834 #endif
2836 return entry;
2839 #endif /* not USE_X_TOOLKIT */
2841 #endif /* HAVE_MENUS */
2843 void
2844 syms_of_xmenu ()
2846 staticpro (&menu_items);
2847 menu_items = Qnil;
2849 Qdebug_on_next_call = intern ("debug-on-next-call");
2850 staticpro (&Qdebug_on_next_call);
2852 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2853 doc: /* Frame for which we are updating a menu.
2854 The enable predicate for a menu command should check this variable. */);
2855 Vmenu_updating_frame = Qnil;
2857 #ifdef USE_X_TOOLKIT
2858 widget_id_tick = (1<<16);
2859 next_menubar_widget_id = 1;
2860 #endif
2862 defsubr (&Sx_popup_menu);
2863 #ifdef HAVE_MENUS
2864 defsubr (&Sx_popup_dialog);
2865 #endif