(speedbar-update-current-file): Added call to
[emacs.git] / src / xmenu.c
blob5e7c0c966ec0048ddfeb606cbc8e3ceecbaeb375
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)
9 any later version.
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. */
34 #include <signal.h>
35 #include <config.h>
37 #include <stdio.h>
38 #include "lisp.h"
39 #include "termhooks.h"
40 #include "frame.h"
41 #include "window.h"
42 #include "keyboard.h"
43 #include "blockinput.h"
44 #include "buffer.h"
46 #ifdef MSDOS
47 #include "msdos.h"
48 #endif
50 #ifdef HAVE_X_WINDOWS
51 /* This may include sys/types.h, and that somehow loses
52 if this is not done before the other system files. */
53 #include "xterm.h"
54 #endif
56 /* Load sys/types.h if not already loaded.
57 In some systems loading it twice is suicidal. */
58 #ifndef makedev
59 #include <sys/types.h>
60 #endif
62 #include "dispextern.h"
64 #ifdef HAVE_X_WINDOWS
65 #ifdef USE_X_TOOLKIT
66 #include <X11/Xlib.h>
67 #include <X11/IntrinsicP.h>
68 #include <X11/CoreP.h>
69 #include <X11/StringDefs.h>
70 #include <X11/Shell.h>
71 #ifdef USE_LUCID
72 #include <X11/Xaw/Paned.h>
73 #endif /* USE_LUCID */
74 #include "../lwlib/lwlib.h"
75 #else /* not USE_X_TOOLKIT */
76 #include "../oldXMenu/XMenu.h"
77 #endif /* not USE_X_TOOLKIT */
78 #endif /* HAVE_X_WINDOWS */
80 #define min(x,y) (((x) < (y)) ? (x) : (y))
81 #define max(x,y) (((x) > (y)) ? (x) : (y))
83 #ifndef TRUE
84 #define TRUE 1
85 #define FALSE 0
86 #endif /* no TRUE */
88 Lisp_Object Vmenu_updating_frame;
90 Lisp_Object Qdebug_on_next_call;
92 extern Lisp_Object Qmenu_bar;
93 extern Lisp_Object Qmouse_click, Qevent_kind;
95 extern Lisp_Object QCtoggle, QCradio;
97 extern Lisp_Object Voverriding_local_map;
98 extern Lisp_Object Voverriding_local_map_menu_flag;
100 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
102 extern Lisp_Object Qmenu_bar_update_hook;
104 #ifdef USE_X_TOOLKIT
105 extern void set_frame_menubar ();
106 extern void process_expose_from_menu ();
107 extern XtAppContext Xt_app_con;
109 static Lisp_Object xdialog_show ();
110 void popup_get_selection ();
111 #endif
113 static Lisp_Object xmenu_show ();
114 static void keymap_panes ();
115 static void single_keymap_panes ();
116 static void single_menu_item ();
117 static void list_of_panes ();
118 static void list_of_items ();
120 /* This holds a Lisp vector that holds the results of decoding
121 the keymaps or alist-of-alists that specify a menu.
123 It describes the panes and items within the panes.
125 Each pane is described by 3 elements in the vector:
126 t, the pane name, the pane's prefix key.
127 Then follow the pane's items, with 5 elements per item:
128 the item string, the enable flag, the item's value,
129 the definition, and the equivalent keyboard key's description string.
131 In some cases, multiple levels of menus may be described.
132 A single vector slot containing nil indicates the start of a submenu.
133 A single vector slot containing lambda indicates the end of a submenu.
134 The submenu follows a menu item which is the way to reach the submenu.
136 A single vector slot containing quote indicates that the
137 following items should appear on the right of a dialog box.
139 Using a Lisp vector to hold this information while we decode it
140 takes care of protecting all the data from GC. */
142 #define MENU_ITEMS_PANE_NAME 1
143 #define MENU_ITEMS_PANE_PREFIX 2
144 #define MENU_ITEMS_PANE_LENGTH 3
146 #define MENU_ITEMS_ITEM_NAME 0
147 #define MENU_ITEMS_ITEM_ENABLE 1
148 #define MENU_ITEMS_ITEM_VALUE 2
149 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
150 #define MENU_ITEMS_ITEM_DEFINITION 4
151 #define MENU_ITEMS_ITEM_LENGTH 5
153 static Lisp_Object menu_items;
155 /* Number of slots currently allocated in menu_items. */
156 static int menu_items_allocated;
158 /* This is the index in menu_items of the first empty slot. */
159 static int menu_items_used;
161 /* The number of panes currently recorded in menu_items,
162 excluding those within submenus. */
163 static int menu_items_n_panes;
165 /* Current depth within submenus. */
166 static int menu_items_submenu_depth;
168 /* Flag which when set indicates a dialog or menu has been posted by
169 Xt on behalf of one of the widget sets. */
170 static int popup_activated_flag;
172 static int next_menubar_widget_id;
174 /* This is set nonzero after the user activates the menu bar, and set
175 to zero again after the menu bars are redisplayed by prepare_menu_bar.
176 While it is nonzero, all calls to set_frame_menubar go deep.
178 I don't understand why this is needed, but it does seem to be
179 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
181 int pending_menu_activation;
183 #ifdef USE_X_TOOLKIT
185 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
187 static struct frame *
188 menubar_id_to_frame (id)
189 LWLIB_ID id;
191 Lisp_Object tail, frame;
192 FRAME_PTR f;
194 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
196 frame = XCONS (tail)->car;
197 if (!GC_FRAMEP (frame))
198 continue;
199 f = XFRAME (frame);
200 if (f->output_data.nothing == 1)
201 continue;
202 if (f->output_data.x->id == id)
203 return f;
205 return 0;
208 #endif
210 /* Initialize the menu_items structure if we haven't already done so.
211 Also mark it as currently empty. */
213 static void
214 init_menu_items ()
216 if (NILP (menu_items))
218 menu_items_allocated = 60;
219 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
222 menu_items_used = 0;
223 menu_items_n_panes = 0;
224 menu_items_submenu_depth = 0;
227 /* Call at the end of generating the data in menu_items.
228 This fills in the number of items in the last pane. */
230 static void
231 finish_menu_items ()
235 /* Call when finished using the data for the current menu
236 in menu_items. */
238 static void
239 discard_menu_items ()
241 /* Free the structure if it is especially large.
242 Otherwise, hold on to it, to save time. */
243 if (menu_items_allocated > 200)
245 menu_items = Qnil;
246 menu_items_allocated = 0;
250 /* Make the menu_items vector twice as large. */
252 static void
253 grow_menu_items ()
255 Lisp_Object old;
256 int old_size = menu_items_allocated;
257 old = menu_items;
259 menu_items_allocated *= 2;
260 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
261 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
262 old_size * sizeof (Lisp_Object));
265 /* Begin a submenu. */
267 static void
268 push_submenu_start ()
270 if (menu_items_used + 1 > menu_items_allocated)
271 grow_menu_items ();
273 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
274 menu_items_submenu_depth++;
277 /* End a submenu. */
279 static void
280 push_submenu_end ()
282 if (menu_items_used + 1 > menu_items_allocated)
283 grow_menu_items ();
285 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
286 menu_items_submenu_depth--;
289 /* Indicate boundary between left and right. */
291 static void
292 push_left_right_boundary ()
294 if (menu_items_used + 1 > menu_items_allocated)
295 grow_menu_items ();
297 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
300 /* Start a new menu pane in menu_items..
301 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
303 static void
304 push_menu_pane (name, prefix_vec)
305 Lisp_Object name, prefix_vec;
307 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
308 grow_menu_items ();
310 if (menu_items_submenu_depth == 0)
311 menu_items_n_panes++;
312 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
313 XVECTOR (menu_items)->contents[menu_items_used++] = name;
314 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
317 /* Push one menu item into the current pane.
318 NAME is the string to display. ENABLE if non-nil means
319 this item can be selected. KEY is the key generated by
320 choosing this item, or nil if this item doesn't really have a definition.
321 DEF is the definition of this item.
322 EQUIV is the textual description of the keyboard equivalent for
323 this item (or nil if none). */
325 static void
326 push_menu_item (name, enable, key, def, equiv)
327 Lisp_Object name, enable, key, def, equiv;
329 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
330 grow_menu_items ();
332 XVECTOR (menu_items)->contents[menu_items_used++] = name;
333 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
334 XVECTOR (menu_items)->contents[menu_items_used++] = key;
335 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
336 XVECTOR (menu_items)->contents[menu_items_used++] = def;
339 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
340 and generate menu panes for them in menu_items.
341 If NOTREAL is nonzero,
342 don't bother really computing whether an item is enabled. */
344 static void
345 keymap_panes (keymaps, nmaps, notreal)
346 Lisp_Object *keymaps;
347 int nmaps;
348 int notreal;
350 int mapno;
352 init_menu_items ();
354 /* Loop over the given keymaps, making a pane for each map.
355 But don't make a pane that is empty--ignore that map instead.
356 P is the number of panes we have made so far. */
357 for (mapno = 0; mapno < nmaps; mapno++)
358 single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal, 10);
360 finish_menu_items ();
363 /* This is a recursive subroutine of keymap_panes.
364 It handles one keymap, KEYMAP.
365 The other arguments are passed along
366 or point to local variables of the previous function.
367 If NOTREAL is nonzero, only check for equivalent key bindings, don't
368 evaluate expressions in menu items and don't make any menu.
370 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
372 static void
373 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
374 Lisp_Object keymap;
375 Lisp_Object pane_name;
376 Lisp_Object prefix;
377 int notreal;
378 int maxdepth;
380 Lisp_Object pending_maps = Qnil;
381 Lisp_Object tail, item;
382 struct gcpro gcpro1, gcpro2;
383 int notbuttons = 0;
385 if (maxdepth <= 0)
386 return;
388 push_menu_pane (pane_name, prefix);
390 #ifndef HAVE_BOXES
391 /* Remember index for first item in this pane so we can go back and
392 add a prefix when (if) we see the first button. After that, notbuttons
393 is set to 0, to mark that we have seen a button and all non button
394 items need a prefix. */
395 notbuttons = menu_items_used;
396 #endif
398 for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
400 GCPRO2 (keymap, pending_maps);
401 /* Look at each key binding, and if it is a menu item add it
402 to this menu. */
403 item = XCONS (tail)->car;
404 if (CONSP (item))
405 single_menu_item (XCONS (item)->car, XCONS (item)->cdr,
406 &pending_maps, notreal, maxdepth, &notbuttons);
407 else if (VECTORP (item))
409 /* Loop over the char values represented in the vector. */
410 int len = XVECTOR (item)->size;
411 int c;
412 for (c = 0; c < len; c++)
414 Lisp_Object character;
415 XSETFASTINT (character, c);
416 single_menu_item (character, XVECTOR (item)->contents[c],
417 &pending_maps, notreal, maxdepth, &notbuttons);
420 UNGCPRO;
423 /* Process now any submenus which want to be panes at this level. */
424 while (!NILP (pending_maps))
426 Lisp_Object elt, eltcdr, string;
427 elt = Fcar (pending_maps);
428 eltcdr = XCONS (elt)->cdr;
429 string = XCONS (eltcdr)->car;
430 /* We no longer discard the @ from the beginning of the string here.
431 Instead, we do this in xmenu_show. */
432 single_keymap_panes (Fcar (elt), string,
433 XCONS (eltcdr)->cdr, notreal, maxdepth - 1);
434 pending_maps = Fcdr (pending_maps);
438 /* This is a subroutine of single_keymap_panes that handles one
439 keymap entry.
440 KEY is a key in a keymap and ITEM is its binding.
441 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
442 separate panes.
443 If NOTREAL is nonzero, only check for equivalent key bindings, don't
444 evaluate expressions in menu items and don't make any menu.
445 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
446 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
447 buttons. It points to variable notbuttons in single_keymap_panes,
448 which keeps track of if we have seen a button in this menu or not. */
450 static void
451 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth,
452 notbuttons_ptr)
453 Lisp_Object key, item;
454 Lisp_Object *pending_maps_ptr;
455 int maxdepth, notreal;
456 int *notbuttons_ptr;
458 Lisp_Object def, map, item_string, enabled;
459 struct gcpro gcpro1, gcpro2;
460 int res;
462 /* Parse the menu item and leave the result in item_properties. */
463 GCPRO2 (key, item);
464 res = parse_menu_item (item, notreal, 0);
465 UNGCPRO;
466 if (!res)
467 return; /* Not a menu item. */
469 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
471 if (notreal)
473 /* We don't want to make a menu, just traverse the keymaps to
474 precompute equivalent key bindings. */
475 if (!NILP (map))
476 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
477 return;
480 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
481 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
483 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
485 if (!NILP (enabled))
486 /* An enabled separate pane. Remember this to handle it later. */
487 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
488 *pending_maps_ptr);
489 return;
492 #ifndef HAVE_BOXES
493 /* Simulate radio buttons and toggle boxes by putting a prefix in
494 front of them. */
496 Lisp_Object prefix = Qnil;
497 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
498 if (!NILP (type))
500 Lisp_Object selected
501 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
503 if (*notbuttons_ptr)
504 /* The first button. Line up previous items in this menu. */
506 int index = *notbuttons_ptr; /* Index for first item this menu. */
507 int submenu = 0;
508 Lisp_Object tem;
509 while (index < menu_items_used)
512 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
513 if (NILP (tem))
515 index++;
516 submenu++; /* Skip sub menu. */
518 else if (EQ (tem, Qlambda))
520 index++;
521 submenu--; /* End sub menu. */
523 else if (EQ (tem, Qt))
524 index += 3; /* Skip new pane marker. */
525 else if (EQ (tem, Qquote))
526 index++; /* Skip a left, right divider. */
527 else
529 if (!submenu && XSTRING (tem)->data[0] != '\0'
530 && XSTRING (tem)->data[0] != '-')
531 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
532 = concat2 (build_string (" "), tem);
533 index += MENU_ITEMS_ITEM_LENGTH;
536 *notbuttons_ptr = 0;
539 /* Calculate prefix, if any, for this item. */
540 if (EQ (type, QCtoggle))
541 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
542 else if (EQ (type, QCradio))
543 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
545 /* Not a button. If we have earlier buttons, then we need a prefix. */
546 else if (!*notbuttons_ptr && XSTRING (item_string)->data[0] != '\0'
547 && XSTRING (item_string)->data[0] != '-')
548 prefix = build_string (" ");
550 if (!NILP (prefix))
551 item_string = concat2 (prefix, item_string);
553 #endif /* not HAVE_BOXES */
555 #ifndef USE_X_TOOLKIT
556 if (!NILP(map))
557 /* Indicate visually that this is a submenu. */
558 item_string = concat2 (item_string, build_string (" >"));
559 #endif
561 push_menu_item (item_string, enabled, key,
562 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
563 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]);
565 #ifdef USE_X_TOOLKIT
566 /* Display a submenu using the toolkit. */
567 if (! (NILP (map) || NILP (enabled)))
569 push_submenu_start ();
570 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
571 push_submenu_end ();
573 #endif
576 /* Push all the panes and items of a menu described by the
577 alist-of-alists MENU.
578 This handles old-fashioned calls to x-popup-menu. */
580 static void
581 list_of_panes (menu)
582 Lisp_Object menu;
584 Lisp_Object tail;
586 init_menu_items ();
588 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
590 Lisp_Object elt, pane_name, pane_data;
591 elt = Fcar (tail);
592 pane_name = Fcar (elt);
593 CHECK_STRING (pane_name, 0);
594 push_menu_pane (pane_name, Qnil);
595 pane_data = Fcdr (elt);
596 CHECK_CONS (pane_data, 0);
597 list_of_items (pane_data);
600 finish_menu_items ();
603 /* Push the items in a single pane defined by the alist PANE. */
605 static void
606 list_of_items (pane)
607 Lisp_Object pane;
609 Lisp_Object tail, item, item1;
611 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
613 item = Fcar (tail);
614 if (STRINGP (item))
615 push_menu_item (item, Qnil, Qnil, Qt, Qnil);
616 else if (NILP (item))
617 push_left_right_boundary ();
618 else
620 CHECK_CONS (item, 0);
621 item1 = Fcar (item);
622 CHECK_STRING (item1, 1);
623 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil);
628 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
629 "Pop up a deck-of-cards menu and return user's selection.\n\
630 POSITION is a position specification. This is either a mouse button event\n\
631 or a list ((XOFFSET YOFFSET) WINDOW)\n\
632 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
633 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
634 This controls the position of the center of the first line\n\
635 in the first pane of the menu, not the top left of the menu as a whole.\n\
636 If POSITION is t, it means to use the current mouse position.\n\
638 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
639 The menu items come from key bindings that have a menu string as well as\n\
640 a definition; actually, the \"definition\" in such a key binding looks like\n\
641 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
642 the keymap as a top-level element.\n\n\
643 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
644 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
646 You can also use a list of keymaps as MENU.\n\
647 Then each keymap makes a separate pane.\n\
648 When MENU is a keymap or a list of keymaps, the return value\n\
649 is a list of events.\n\n\
651 Alternatively, you can specify a menu of multiple panes\n\
652 with a list of the form (TITLE PANE1 PANE2...),\n\
653 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
654 Each ITEM is normally a cons cell (STRING . VALUE);\n\
655 but a string can appear as an item--that makes a nonselectable line\n\
656 in the menu.\n\
657 With this form of menu, the return value is VALUE from the chosen item.\n\
659 If POSITION is nil, don't display the menu at all, just precalculate the\n\
660 cached information about equivalent key sequences.")
661 (position, menu)
662 Lisp_Object position, menu;
664 int number_of_panes, panes;
665 Lisp_Object keymap, tem;
666 int xpos, ypos;
667 Lisp_Object title;
668 char *error_name;
669 Lisp_Object selection;
670 int i, j;
671 FRAME_PTR f;
672 Lisp_Object x, y, window;
673 int keymaps = 0;
674 int for_click = 0;
675 struct gcpro gcpro1;
677 #ifdef HAVE_MENUS
678 if (! NILP (position))
680 check_x ();
682 /* Decode the first argument: find the window and the coordinates. */
683 if (EQ (position, Qt)
684 || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
686 /* Use the mouse's current position. */
687 FRAME_PTR new_f = selected_frame;
688 Lisp_Object bar_window;
689 enum scroll_bar_part part;
690 unsigned long time;
692 if (mouse_position_hook)
693 (*mouse_position_hook) (&new_f, 1, &bar_window,
694 &part, &x, &y, &time);
695 if (new_f != 0)
696 XSETFRAME (window, new_f);
697 else
699 window = selected_window;
700 XSETFASTINT (x, 0);
701 XSETFASTINT (y, 0);
704 else
706 tem = Fcar (position);
707 if (CONSP (tem))
709 window = Fcar (Fcdr (position));
710 x = Fcar (tem);
711 y = Fcar (Fcdr (tem));
713 else
715 for_click = 1;
716 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
717 window = Fcar (tem); /* POSN_WINDOW (tem) */
718 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
719 x = Fcar (tem);
720 y = Fcdr (tem);
724 CHECK_NUMBER (x, 0);
725 CHECK_NUMBER (y, 0);
727 /* Decode where to put the menu. */
729 if (FRAMEP (window))
731 f = XFRAME (window);
732 xpos = 0;
733 ypos = 0;
735 else if (WINDOWP (window))
737 CHECK_LIVE_WINDOW (window, 0);
738 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
740 xpos = (FONT_WIDTH (f->output_data.x->font)
741 * XFASTINT (XWINDOW (window)->left));
742 ypos = (f->output_data.x->line_height
743 * XFASTINT (XWINDOW (window)->top));
745 else
746 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
747 but I don't want to make one now. */
748 CHECK_WINDOW (window, 0);
750 xpos += XINT (x);
751 ypos += XINT (y);
753 XSETFRAME (Vmenu_updating_frame, f);
755 Vmenu_updating_frame = Qnil;
756 #endif /* HAVE_MENUS */
758 title = Qnil;
759 GCPRO1 (title);
761 /* Decode the menu items from what was specified. */
763 keymap = Fkeymapp (menu);
764 tem = Qnil;
765 if (CONSP (menu))
766 tem = Fkeymapp (Fcar (menu));
767 if (!NILP (keymap))
769 /* We were given a keymap. Extract menu info from the keymap. */
770 Lisp_Object prompt;
771 keymap = get_keymap (menu);
773 /* Extract the detailed info to make one pane. */
774 keymap_panes (&menu, 1, NILP (position));
776 /* Search for a string appearing directly as an element of the keymap.
777 That string is the title of the menu. */
778 prompt = map_prompt (keymap);
779 if (NILP (title) && !NILP (prompt))
780 title = prompt;
782 /* Make that be the pane title of the first pane. */
783 if (!NILP (prompt) && menu_items_n_panes >= 0)
784 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
786 keymaps = 1;
788 else if (!NILP (tem))
790 /* We were given a list of keymaps. */
791 int nmaps = XFASTINT (Flength (menu));
792 Lisp_Object *maps
793 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
794 int i;
796 title = Qnil;
798 /* The first keymap that has a prompt string
799 supplies the menu title. */
800 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
802 Lisp_Object prompt;
804 maps[i++] = keymap = get_keymap (Fcar (tem));
806 prompt = map_prompt (keymap);
807 if (NILP (title) && !NILP (prompt))
808 title = prompt;
811 /* Extract the detailed info to make one pane. */
812 keymap_panes (maps, nmaps, NILP (position));
814 /* Make the title be the pane title of the first pane. */
815 if (!NILP (title) && menu_items_n_panes >= 0)
816 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
818 keymaps = 1;
820 else
822 /* We were given an old-fashioned menu. */
823 title = Fcar (menu);
824 CHECK_STRING (title, 1);
826 list_of_panes (Fcdr (menu));
828 keymaps = 0;
831 if (NILP (position))
833 discard_menu_items ();
834 UNGCPRO;
835 return Qnil;
838 #ifdef HAVE_MENUS
839 /* Display them in a menu. */
840 BLOCK_INPUT;
842 selection = xmenu_show (f, xpos, ypos, for_click,
843 keymaps, title, &error_name);
844 UNBLOCK_INPUT;
846 discard_menu_items ();
848 UNGCPRO;
849 #endif /* HAVE_MENUS */
851 if (error_name) error (error_name);
852 return selection;
855 #ifdef HAVE_MENUS
857 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
858 "Pop up a dialog box and return user's selection.\n\
859 POSITION specifies which frame to use.\n\
860 This is normally a mouse button event or a window or frame.\n\
861 If POSITION is t, it means to use the frame the mouse is on.\n\
862 The dialog box appears in the middle of the specified frame.\n\
864 CONTENTS specifies the alternatives to display in the dialog box.\n\
865 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
866 Each ITEM is a cons cell (STRING . VALUE).\n\
867 The return value is VALUE from the chosen item.\n\n\
868 An ITEM may also be just a string--that makes a nonselectable item.\n\
869 An ITEM may also be nil--that means to put all preceding items\n\
870 on the left of the dialog box and all following items on the right.\n\
871 \(By default, approximately half appear on each side.)")
872 (position, contents)
873 Lisp_Object position, contents;
875 FRAME_PTR f;
876 Lisp_Object window;
878 check_x ();
880 /* Decode the first argument: find the window or frame to use. */
881 if (EQ (position, Qt)
882 || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
884 #if 0 /* Using the frame the mouse is on may not be right. */
885 /* Use the mouse's current position. */
886 FRAME_PTR new_f = selected_frame;
887 Lisp_Object bar_window;
888 int part;
889 unsigned long time;
890 Lisp_Object x, y;
892 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
894 if (new_f != 0)
895 XSETFRAME (window, new_f);
896 else
897 window = selected_window;
898 #endif
899 window = selected_window;
901 else if (CONSP (position))
903 Lisp_Object tem;
904 tem = Fcar (position);
905 if (CONSP (tem))
906 window = Fcar (Fcdr (position));
907 else
909 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
910 window = Fcar (tem); /* POSN_WINDOW (tem) */
913 else if (WINDOWP (position) || FRAMEP (position))
914 window = position;
915 else
916 window = Qnil;
918 /* Decode where to put the menu. */
920 if (FRAMEP (window))
921 f = XFRAME (window);
922 else if (WINDOWP (window))
924 CHECK_LIVE_WINDOW (window, 0);
925 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
927 else
928 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
929 but I don't want to make one now. */
930 CHECK_WINDOW (window, 0);
932 #ifndef USE_X_TOOLKIT
933 /* Display a menu with these alternatives
934 in the middle of frame F. */
936 Lisp_Object x, y, frame, newpos;
937 XSETFRAME (frame, f);
938 XSETINT (x, x_pixel_width (f) / 2);
939 XSETINT (y, x_pixel_height (f) / 2);
940 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
942 return Fx_popup_menu (newpos,
943 Fcons (Fcar (contents), Fcons (contents, Qnil)));
945 #else
947 Lisp_Object title;
948 char *error_name;
949 Lisp_Object selection;
951 /* Decode the dialog items from what was specified. */
952 title = Fcar (contents);
953 CHECK_STRING (title, 1);
955 list_of_panes (Fcons (contents, Qnil));
957 /* Display them in a dialog box. */
958 BLOCK_INPUT;
959 selection = xdialog_show (f, 0, title, &error_name);
960 UNBLOCK_INPUT;
962 discard_menu_items ();
964 if (error_name) error (error_name);
965 return selection;
967 #endif
970 #ifdef USE_X_TOOLKIT
972 /* Loop in Xt until the menu pulldown or dialog popup has been
973 popped down (deactivated). This is used for x-popup-menu
974 and x-popup-dialog; it is not used for the menu bar any more.
976 NOTE: All calls to popup_get_selection should be protected
977 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
979 void
980 popup_get_selection (initial_event, dpyinfo, id)
981 XEvent *initial_event;
982 struct x_display_info *dpyinfo;
983 LWLIB_ID id;
985 XEvent event;
987 /* Define a queue to save up for later unreading
988 all X events that don't pertain to the menu. */
989 struct event_queue
991 XEvent event;
992 struct event_queue *next;
995 struct event_queue *queue = NULL;
996 struct event_queue *queue_tmp;
998 if (initial_event)
999 event = *initial_event;
1000 else
1001 XtAppNextEvent (Xt_app_con, &event);
1003 while (1)
1005 /* Handle expose events for editor frames right away. */
1006 if (event.type == Expose)
1007 process_expose_from_menu (event);
1008 /* Make sure we don't consider buttons grabbed after menu goes.
1009 And make sure to deactivate for any ButtonRelease,
1010 even if XtDispatchEvent doesn't do that. */
1011 else if (event.type == ButtonRelease
1012 && dpyinfo->display == event.xbutton.display)
1014 dpyinfo->grabbed &= ~(1 << event.xbutton.button);
1015 popup_activated_flag = 0;
1016 #ifdef USE_MOTIF /* Pretending that the event came from a
1017 Btn1Down seems the only way to convince Motif to
1018 activate its callbacks; setting the XmNmenuPost
1019 isn't working. --marcus@sysc.pdx.edu. */
1020 event.xbutton.button = 1;
1021 #endif
1023 /* If the user presses a key, deactivate the menu.
1024 The user is likely to do that if we get wedged. */
1025 else if (event.type == KeyPress
1026 && dpyinfo->display == event.xbutton.display)
1028 KeySym keysym = XLookupKeysym (&event.xkey, 0);
1029 if (!IsModifierKey (keysym))
1031 popup_activated_flag = 0;
1032 break;
1035 /* Button presses outside the menu also pop it down. */
1036 else if (event.type == ButtonPress
1037 && event.xany.display == dpyinfo->display
1038 && x_any_window_to_frame (dpyinfo, event.xany.window))
1040 popup_activated_flag = 0;
1041 break;
1044 /* Queue all events not for this popup,
1045 except for Expose, which we've already handled, and ButtonRelease.
1046 Note that the X window is associated with the frame if this
1047 is a menu bar popup, but not if it's a dialog box. So we use
1048 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1049 if (event.type != Expose
1050 && !(event.type == ButtonRelease
1051 && dpyinfo->display == event.xbutton.display)
1052 && (event.xany.display != dpyinfo->display
1053 || x_non_menubar_window_to_frame (dpyinfo, event.xany.window)))
1055 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1057 if (queue_tmp != NULL)
1059 queue_tmp->event = event;
1060 queue_tmp->next = queue;
1061 queue = queue_tmp;
1064 else
1065 XtDispatchEvent (&event);
1067 if (!popup_activated ())
1068 break;
1069 XtAppNextEvent (Xt_app_con, &event);
1072 /* Unread any events that we got but did not handle. */
1073 while (queue != NULL)
1075 queue_tmp = queue;
1076 XPutBackEvent (queue_tmp->event.xany.display, &queue_tmp->event);
1077 queue = queue_tmp->next;
1078 free ((char *)queue_tmp);
1079 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1080 interrupt_input_pending = 1;
1084 /* Activate the menu bar of frame F.
1085 This is called from keyboard.c when it gets the
1086 menu_bar_activate_event out of the Emacs event queue.
1088 To activate the menu bar, we use the X button-press event
1089 that was saved in saved_menu_event.
1090 That makes the toolkit do its thing.
1092 But first we recompute the menu bar contents (the whole tree).
1094 The reason for saving the button event until here, instead of
1095 passing it to the toolkit right away, is that we can safely
1096 execute Lisp code. */
1098 void
1099 x_activate_menubar (f)
1100 FRAME_PTR f;
1102 if (!f->output_data.x->saved_menu_event->type)
1103 return;
1105 set_frame_menubar (f, 0, 1);
1106 BLOCK_INPUT;
1107 XtDispatchEvent ((XEvent *) f->output_data.x->saved_menu_event);
1108 UNBLOCK_INPUT;
1109 #ifdef USE_MOTIF
1110 if (f->output_data.x->saved_menu_event->type == ButtonRelease)
1111 pending_menu_activation = 1;
1112 #endif
1114 /* Ignore this if we get it a second time. */
1115 f->output_data.x->saved_menu_event->type = 0;
1118 /* Detect if a dialog or menu has been posted. */
1121 popup_activated ()
1123 return popup_activated_flag;
1127 /* This callback is invoked when the user selects a menubar cascade
1128 pushbutton, but before the pulldown menu is posted. */
1130 static void
1131 popup_activate_callback (widget, id, client_data)
1132 Widget widget;
1133 LWLIB_ID id;
1134 XtPointer client_data;
1136 popup_activated_flag = 1;
1139 /* This callback is called from the menu bar pulldown menu
1140 when the user makes a selection.
1141 Figure out what the user chose
1142 and put the appropriate events into the keyboard buffer. */
1144 static void
1145 menubar_selection_callback (widget, id, client_data)
1146 Widget widget;
1147 LWLIB_ID id;
1148 XtPointer client_data;
1150 Lisp_Object prefix, entry;
1151 FRAME_PTR f = menubar_id_to_frame (id);
1152 Lisp_Object vector;
1153 Lisp_Object *subprefix_stack;
1154 int submenu_depth = 0;
1155 int i;
1157 if (!f)
1158 return;
1159 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1160 vector = f->menu_bar_vector;
1161 prefix = Qnil;
1162 i = 0;
1163 while (i < f->menu_bar_items_used)
1165 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1167 subprefix_stack[submenu_depth++] = prefix;
1168 prefix = entry;
1169 i++;
1171 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1173 prefix = subprefix_stack[--submenu_depth];
1174 i++;
1176 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1178 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1179 i += MENU_ITEMS_PANE_LENGTH;
1181 else
1183 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1184 /* The EMACS_INT cast avoids a warning. There's no problem
1185 as long as pointers have enough bits to hold small integers. */
1186 if ((int) (EMACS_INT) client_data == i)
1188 int j;
1189 struct input_event buf;
1190 Lisp_Object frame;
1192 XSETFRAME (frame, f);
1193 buf.kind = menu_bar_event;
1194 buf.frame_or_window = Fcons (frame, Fcons (Qmenu_bar, Qnil));
1195 kbd_buffer_store_event (&buf);
1197 for (j = 0; j < submenu_depth; j++)
1198 if (!NILP (subprefix_stack[j]))
1200 buf.kind = menu_bar_event;
1201 buf.frame_or_window = Fcons (frame, subprefix_stack[j]);
1202 kbd_buffer_store_event (&buf);
1205 if (!NILP (prefix))
1207 buf.kind = menu_bar_event;
1208 buf.frame_or_window = Fcons (frame, prefix);
1209 kbd_buffer_store_event (&buf);
1212 buf.kind = menu_bar_event;
1213 buf.frame_or_window = Fcons (frame, entry);
1214 kbd_buffer_store_event (&buf);
1216 return;
1218 i += MENU_ITEMS_ITEM_LENGTH;
1223 /* This callback is invoked when a dialog or menu is finished being
1224 used and has been unposted. */
1226 static void
1227 popup_deactivate_callback (widget, id, client_data)
1228 Widget widget;
1229 LWLIB_ID id;
1230 XtPointer client_data;
1232 popup_activated_flag = 0;
1235 /* Allocate a widget_value, blocking input. */
1237 widget_value *
1238 xmalloc_widget_value ()
1240 widget_value *value;
1242 BLOCK_INPUT;
1243 value = malloc_widget_value ();
1244 UNBLOCK_INPUT;
1246 return value;
1249 /* This recursively calls free_widget_value on the tree of widgets.
1250 It must free all data that was malloc'ed for these widget_values.
1251 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1252 must be left alone. */
1254 void
1255 free_menubar_widget_value_tree (wv)
1256 widget_value *wv;
1258 if (! wv) return;
1260 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1262 if (wv->contents && (wv->contents != (widget_value*)1))
1264 free_menubar_widget_value_tree (wv->contents);
1265 wv->contents = (widget_value *) 0xDEADBEEF;
1267 if (wv->next)
1269 free_menubar_widget_value_tree (wv->next);
1270 wv->next = (widget_value *) 0xDEADBEEF;
1272 BLOCK_INPUT;
1273 free_widget_value (wv);
1274 UNBLOCK_INPUT;
1277 /* Return a tree of widget_value structures for a menu bar item
1278 whose event type is ITEM_KEY (with string ITEM_NAME)
1279 and whose contents come from the list of keymaps MAPS. */
1281 static widget_value *
1282 single_submenu (item_key, item_name, maps)
1283 Lisp_Object item_key, item_name, maps;
1285 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1286 int i;
1287 int submenu_depth = 0;
1288 Lisp_Object length;
1289 int len;
1290 Lisp_Object *mapvec;
1291 widget_value **submenu_stack;
1292 int mapno;
1293 int previous_items = menu_items_used;
1294 int top_level_items = 0;
1296 length = Flength (maps);
1297 len = XINT (length);
1299 /* Convert the list MAPS into a vector MAPVEC. */
1300 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1301 for (i = 0; i < len; i++)
1303 mapvec[i] = Fcar (maps);
1304 maps = Fcdr (maps);
1307 menu_items_n_panes = 0;
1309 /* Loop over the given keymaps, making a pane for each map.
1310 But don't make a pane that is empty--ignore that map instead. */
1311 for (i = 0; i < len; i++)
1313 if (SYMBOLP (mapvec[i])
1314 || (CONSP (mapvec[i])
1315 && NILP (Fkeymapp (mapvec[i]))))
1317 /* Here we have a command at top level in the menu bar
1318 as opposed to a submenu. */
1319 top_level_items = 1;
1320 push_menu_pane (Qnil, Qnil);
1321 push_menu_item (item_name, Qt, item_key, mapvec[i], Qnil);
1323 else
1324 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1327 /* Create a tree of widget_value objects
1328 representing the panes and their items. */
1330 submenu_stack
1331 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1332 wv = xmalloc_widget_value ();
1333 wv->name = "menu";
1334 wv->value = 0;
1335 wv->enabled = 1;
1336 first_wv = wv;
1337 save_wv = 0;
1338 prev_wv = 0;
1340 /* Loop over all panes and items made during this call
1341 and construct a tree of widget_value objects.
1342 Ignore the panes and items made by previous calls to
1343 single_submenu, even though those are also in menu_items. */
1344 i = previous_items;
1345 while (i < menu_items_used)
1347 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1349 submenu_stack[submenu_depth++] = save_wv;
1350 save_wv = prev_wv;
1351 prev_wv = 0;
1352 i++;
1354 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1356 prev_wv = save_wv;
1357 save_wv = submenu_stack[--submenu_depth];
1358 i++;
1360 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1361 && submenu_depth != 0)
1362 i += MENU_ITEMS_PANE_LENGTH;
1363 /* Ignore a nil in the item list.
1364 It's meaningful only for dialog boxes. */
1365 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1366 i += 1;
1367 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1369 /* Create a new pane. */
1370 Lisp_Object pane_name, prefix;
1371 char *pane_string;
1372 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1373 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1374 pane_string = (NILP (pane_name)
1375 ? "" : (char *) XSTRING (pane_name)->data);
1376 /* If there is just one top-level pane, put all its items directly
1377 under the top-level menu. */
1378 if (menu_items_n_panes == 1)
1379 pane_string = "";
1381 /* If the pane has a meaningful name,
1382 make the pane a top-level menu item
1383 with its items as a submenu beneath it. */
1384 if (strcmp (pane_string, ""))
1386 wv = xmalloc_widget_value ();
1387 if (save_wv)
1388 save_wv->next = wv;
1389 else
1390 first_wv->contents = wv;
1391 wv->name = pane_string;
1392 /* Ignore the @ that means "separate pane".
1393 This is a kludge, but this isn't worth more time. */
1394 if (!NILP (prefix) && wv->name[0] == '@')
1395 wv->name++;
1396 wv->value = 0;
1397 wv->enabled = 1;
1399 save_wv = wv;
1400 prev_wv = 0;
1401 i += MENU_ITEMS_PANE_LENGTH;
1403 else
1405 /* Create a new item within current pane. */
1406 Lisp_Object item_name, enable, descrip, def;
1407 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1408 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1409 descrip
1410 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1411 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1413 wv = xmalloc_widget_value ();
1414 if (prev_wv)
1415 prev_wv->next = wv;
1416 else
1417 save_wv->contents = wv;
1419 wv->name = (char *) XSTRING (item_name)->data;
1420 if (!NILP (descrip))
1421 wv->key = (char *) XSTRING (descrip)->data;
1422 wv->value = 0;
1423 /* The EMACS_INT cast avoids a warning. There's no problem
1424 as long as pointers have enough bits to hold small integers. */
1425 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1426 wv->enabled = !NILP (enable);
1427 prev_wv = wv;
1429 i += MENU_ITEMS_ITEM_LENGTH;
1433 /* If we have just one "menu item"
1434 that was originally a button, return it by itself. */
1435 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1437 wv = first_wv->contents;
1438 free_widget_value (first_wv);
1439 return wv;
1442 return first_wv;
1445 extern void EmacsFrameSetCharSize ();
1447 /* Recompute all the widgets of frame F, when the menu bar
1448 has been changed. */
1450 static void
1451 update_frame_menubar (f)
1452 FRAME_PTR f;
1454 struct x_output *x = f->output_data.x;
1455 int columns, rows;
1456 int menubar_changed;
1458 Dimension shell_height;
1460 /* We assume the menubar contents has changed if the global flag is set,
1461 or if the current buffer has changed, or if the menubar has never
1462 been updated before.
1464 menubar_changed = (x->menubar_widget
1465 && !XtIsManaged (x->menubar_widget));
1467 if (! (menubar_changed))
1468 return;
1470 BLOCK_INPUT;
1471 /* Save the size of the frame because the pane widget doesn't accept to
1472 resize itself. So force it. */
1473 columns = f->width;
1474 rows = f->height;
1476 /* Do the voodoo which means "I'm changing lots of things, don't try to
1477 refigure sizes until I'm done." */
1478 lw_refigure_widget (x->column_widget, False);
1480 /* the order in which children are managed is the top to
1481 bottom order in which they are displayed in the paned window.
1482 First, remove the text-area widget.
1484 XtUnmanageChild (x->edit_widget);
1486 /* remove the menubar that is there now, and put up the menubar that
1487 should be there.
1489 if (menubar_changed)
1491 XtManageChild (x->menubar_widget);
1492 XtMapWidget (x->menubar_widget);
1493 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0);
1496 /* Re-manage the text-area widget, and then thrash the sizes. */
1497 XtManageChild (x->edit_widget);
1498 lw_refigure_widget (x->column_widget, True);
1500 /* Force the pane widget to resize itself with the right values. */
1501 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1503 UNBLOCK_INPUT;
1506 /* Set the contents of the menubar widgets of frame F.
1507 The argument FIRST_TIME is currently ignored;
1508 it is set the first time this is called, from initialize_frame_menubar. */
1510 void
1511 set_frame_menubar (f, first_time, deep_p)
1512 FRAME_PTR f;
1513 int first_time;
1514 int deep_p;
1516 Widget menubar_widget = f->output_data.x->menubar_widget;
1517 Lisp_Object tail, items, frame;
1518 widget_value *wv, *first_wv, *prev_wv = 0;
1519 int i;
1520 LWLIB_ID id;
1522 XSETFRAME (Vmenu_updating_frame, f);
1524 if (f->output_data.x->id == 0)
1525 f->output_data.x->id = next_menubar_widget_id++;
1526 id = f->output_data.x->id;
1528 if (! menubar_widget)
1529 deep_p = 1;
1530 else if (pending_menu_activation && !deep_p)
1531 deep_p = 1;
1532 /* Make the first call for any given frame always go deep. */
1533 else if (!f->output_data.x->saved_menu_event && !deep_p)
1535 deep_p = 1;
1536 f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent));
1537 f->output_data.x->saved_menu_event->type = 0;
1540 wv = xmalloc_widget_value ();
1541 wv->name = "menubar";
1542 wv->value = 0;
1543 wv->enabled = 1;
1544 first_wv = wv;
1546 if (deep_p)
1548 /* Make a widget-value tree representing the entire menu trees. */
1550 struct buffer *prev = current_buffer;
1551 Lisp_Object buffer;
1552 int specpdl_count = specpdl_ptr - specpdl;
1553 int previous_menu_items_used = f->menu_bar_items_used;
1554 Lisp_Object *previous_items
1555 = (Lisp_Object *) alloca (previous_menu_items_used
1556 * sizeof (Lisp_Object));
1558 /* If we are making a new widget, its contents are empty,
1559 do always reinitialize them. */
1560 if (! menubar_widget)
1561 previous_menu_items_used = 0;
1563 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1564 specbind (Qinhibit_quit, Qt);
1565 /* Don't let the debugger step into this code
1566 because it is not reentrant. */
1567 specbind (Qdebug_on_next_call, Qnil);
1569 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1570 if (NILP (Voverriding_local_map_menu_flag))
1572 specbind (Qoverriding_terminal_local_map, Qnil);
1573 specbind (Qoverriding_local_map, Qnil);
1576 set_buffer_internal_1 (XBUFFER (buffer));
1578 /* Run the Lucid hook. */
1579 call1 (Vrun_hooks, Qactivate_menubar_hook);
1580 /* If it has changed current-menubar from previous value,
1581 really recompute the menubar from the value. */
1582 if (! NILP (Vlucid_menu_bar_dirty_flag))
1583 call0 (Qrecompute_lucid_menubar);
1584 safe_run_hooks (Qmenu_bar_update_hook);
1585 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1587 items = FRAME_MENU_BAR_ITEMS (f);
1589 inhibit_garbage_collection ();
1591 /* Save the frame's previous menu bar contents data. */
1592 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1593 previous_menu_items_used * sizeof (Lisp_Object));
1595 /* Fill in the current menu bar contents. */
1596 menu_items = f->menu_bar_vector;
1597 menu_items_allocated = XVECTOR (menu_items)->size;
1598 init_menu_items ();
1599 for (i = 0; i < XVECTOR (items)->size; i += 4)
1601 Lisp_Object key, string, maps;
1603 key = XVECTOR (items)->contents[i];
1604 string = XVECTOR (items)->contents[i + 1];
1605 maps = XVECTOR (items)->contents[i + 2];
1606 if (NILP (string))
1607 break;
1609 wv = single_submenu (key, string, maps);
1610 if (prev_wv)
1611 prev_wv->next = wv;
1612 else
1613 first_wv->contents = wv;
1614 /* Don't set wv->name here; GC during the loop might relocate it. */
1615 wv->enabled = 1;
1616 prev_wv = wv;
1619 finish_menu_items ();
1621 set_buffer_internal_1 (prev);
1622 unbind_to (specpdl_count, Qnil);
1624 /* If there has been no change in the Lisp-level contents
1625 of the menu bar, skip redisplaying it. Just exit. */
1627 for (i = 0; i < previous_menu_items_used; i++)
1628 if (menu_items_used == i
1629 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1630 break;
1631 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1633 free_menubar_widget_value_tree (first_wv);
1634 menu_items = Qnil;
1636 return;
1639 /* Now GC cannot happen during the lifetime of the widget_value,
1640 so it's safe to store data from a Lisp_String. */
1641 wv = first_wv->contents;
1642 for (i = 0; i < XVECTOR (items)->size; i += 4)
1644 Lisp_Object string;
1645 string = XVECTOR (items)->contents[i + 1];
1646 if (NILP (string))
1647 break;
1648 wv->name = (char *) XSTRING (string)->data;
1649 wv = wv->next;
1652 f->menu_bar_vector = menu_items;
1653 f->menu_bar_items_used = menu_items_used;
1654 menu_items = Qnil;
1656 else
1658 /* Make a widget-value tree containing
1659 just the top level menu bar strings. */
1661 items = FRAME_MENU_BAR_ITEMS (f);
1662 for (i = 0; i < XVECTOR (items)->size; i += 4)
1664 Lisp_Object string;
1666 string = XVECTOR (items)->contents[i + 1];
1667 if (NILP (string))
1668 break;
1670 wv = xmalloc_widget_value ();
1671 wv->name = (char *) XSTRING (string)->data;
1672 wv->value = 0;
1673 wv->enabled = 1;
1674 /* This prevents lwlib from assuming this
1675 menu item is really supposed to be empty. */
1676 /* The EMACS_INT cast avoids a warning.
1677 This value just has to be different from small integers. */
1678 wv->call_data = (void *) (EMACS_INT) (-1);
1680 if (prev_wv)
1681 prev_wv->next = wv;
1682 else
1683 first_wv->contents = wv;
1684 prev_wv = wv;
1687 /* Forget what we thought we knew about what is in the
1688 detailed contents of the menu bar menus.
1689 Changing the top level always destroys the contents. */
1690 f->menu_bar_items_used = 0;
1693 /* Create or update the menu bar widget. */
1695 BLOCK_INPUT;
1697 if (menubar_widget)
1699 /* Disable resizing (done for Motif!) */
1700 lw_allow_resizing (f->output_data.x->widget, False);
1702 /* The third arg is DEEP_P, which says to consider the entire
1703 menu trees we supply, rather than just the menu bar item names. */
1704 lw_modify_all_widgets (id, first_wv, deep_p);
1706 /* Re-enable the edit widget to resize. */
1707 lw_allow_resizing (f->output_data.x->widget, True);
1709 else
1711 menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv,
1712 f->output_data.x->column_widget,
1714 popup_activate_callback,
1715 menubar_selection_callback,
1716 popup_deactivate_callback);
1717 f->output_data.x->menubar_widget = menubar_widget;
1721 int menubar_size
1722 = (f->output_data.x->menubar_widget
1723 ? (f->output_data.x->menubar_widget->core.height
1724 + f->output_data.x->menubar_widget->core.border_width)
1725 : 0);
1727 #if 0 /* Experimentally, we now get the right results
1728 for -geometry -0-0 without this. 24 Aug 96, rms. */
1729 #ifdef USE_LUCID
1730 if (FRAME_EXTERNAL_MENU_BAR (f))
1732 Dimension ibw = 0;
1733 XtVaGetValues (f->output_data.x->column_widget,
1734 XtNinternalBorderWidth, &ibw, NULL);
1735 menubar_size += ibw;
1737 #endif /* USE_LUCID */
1738 #endif /* 0 */
1740 f->output_data.x->menubar_height = menubar_size;
1743 free_menubar_widget_value_tree (first_wv);
1745 update_frame_menubar (f);
1747 UNBLOCK_INPUT;
1750 /* Called from Fx_create_frame to create the initial menubar of a frame
1751 before it is mapped, so that the window is mapped with the menubar already
1752 there instead of us tacking it on later and thrashing the window after it
1753 is visible. */
1755 void
1756 initialize_frame_menubar (f)
1757 FRAME_PTR f;
1759 /* This function is called before the first chance to redisplay
1760 the frame. It has to be, so the frame will have the right size. */
1761 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1762 set_frame_menubar (f, 1, 1);
1765 /* Get rid of the menu bar of frame F, and free its storage.
1766 This is used when deleting a frame, and when turning off the menu bar. */
1768 void
1769 free_frame_menubar (f)
1770 FRAME_PTR f;
1772 Widget menubar_widget;
1773 int id;
1775 menubar_widget = f->output_data.x->menubar_widget;
1777 f->output_data.x->menubar_height = 0;
1779 if (menubar_widget)
1781 BLOCK_INPUT;
1782 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
1783 UNBLOCK_INPUT;
1787 #endif /* USE_X_TOOLKIT */
1789 /* xmenu_show actually displays a menu using the panes and items in menu_items
1790 and returns the value selected from it.
1791 There are two versions of xmenu_show, one for Xt and one for Xlib.
1792 Both assume input is blocked by the caller. */
1794 /* F is the frame the menu is for.
1795 X and Y are the frame-relative specified position,
1796 relative to the inside upper left corner of the frame F.
1797 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1798 KEYMAPS is 1 if this menu was specified with keymaps;
1799 in that case, we return a list containing the chosen item's value
1800 and perhaps also the pane's prefix.
1801 TITLE is the specified menu title.
1802 ERROR is a place to store an error message string in case of failure.
1803 (We return nil on failure, but the value doesn't actually matter.) */
1805 #ifdef USE_X_TOOLKIT
1807 /* We need a unique id for each widget handled by the Lucid Widget
1808 library.
1810 For the main windows, and popup menus, we use this counter,
1811 which we increment each time after use. This starts from 1<<16.
1813 For menu bars, we use numbers starting at 0, counted in
1814 next_menubar_widget_id. */
1815 LWLIB_ID widget_id_tick;
1817 #ifdef __STDC__
1818 static Lisp_Object *volatile menu_item_selection;
1819 #else
1820 static Lisp_Object *menu_item_selection;
1821 #endif
1823 static void
1824 popup_selection_callback (widget, id, client_data)
1825 Widget widget;
1826 LWLIB_ID id;
1827 XtPointer client_data;
1829 menu_item_selection = (Lisp_Object *) client_data;
1832 static Lisp_Object
1833 xmenu_show (f, x, y, for_click, keymaps, title, error)
1834 FRAME_PTR f;
1835 int x;
1836 int y;
1837 int for_click;
1838 int keymaps;
1839 Lisp_Object title;
1840 char **error;
1842 int i;
1843 LWLIB_ID menu_id;
1844 Widget menu;
1845 Arg av[2];
1846 int ac = 0;
1847 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1848 widget_value **submenu_stack
1849 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1850 Lisp_Object *subprefix_stack
1851 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1852 int submenu_depth = 0;
1853 XButtonPressedEvent dummy;
1855 int first_pane;
1856 int next_release_must_exit = 0;
1858 *error = NULL;
1860 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1862 *error = "Empty menu";
1863 return Qnil;
1866 /* Create a tree of widget_value objects
1867 representing the panes and their items. */
1868 wv = xmalloc_widget_value ();
1869 wv->name = "menu";
1870 wv->value = 0;
1871 wv->enabled = 1;
1872 first_wv = wv;
1873 first_pane = 1;
1875 /* Loop over all panes and items, filling in the tree. */
1876 i = 0;
1877 while (i < menu_items_used)
1879 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1881 submenu_stack[submenu_depth++] = save_wv;
1882 save_wv = prev_wv;
1883 prev_wv = 0;
1884 first_pane = 1;
1885 i++;
1887 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1889 prev_wv = save_wv;
1890 save_wv = submenu_stack[--submenu_depth];
1891 first_pane = 0;
1892 i++;
1894 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1895 && submenu_depth != 0)
1896 i += MENU_ITEMS_PANE_LENGTH;
1897 /* Ignore a nil in the item list.
1898 It's meaningful only for dialog boxes. */
1899 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1900 i += 1;
1901 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1903 /* Create a new pane. */
1904 Lisp_Object pane_name, prefix;
1905 char *pane_string;
1906 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1907 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1908 pane_string = (NILP (pane_name)
1909 ? "" : (char *) XSTRING (pane_name)->data);
1910 /* If there is just one top-level pane, put all its items directly
1911 under the top-level menu. */
1912 if (menu_items_n_panes == 1)
1913 pane_string = "";
1915 /* If the pane has a meaningful name,
1916 make the pane a top-level menu item
1917 with its items as a submenu beneath it. */
1918 if (!keymaps && strcmp (pane_string, ""))
1920 wv = xmalloc_widget_value ();
1921 if (save_wv)
1922 save_wv->next = wv;
1923 else
1924 first_wv->contents = wv;
1925 wv->name = pane_string;
1926 if (keymaps && !NILP (prefix))
1927 wv->name++;
1928 wv->value = 0;
1929 wv->enabled = 1;
1930 save_wv = wv;
1931 prev_wv = 0;
1933 else if (first_pane)
1935 save_wv = wv;
1936 prev_wv = 0;
1938 first_pane = 0;
1939 i += MENU_ITEMS_PANE_LENGTH;
1941 else
1943 /* Create a new item within current pane. */
1944 Lisp_Object item_name, enable, descrip, def;
1945 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1946 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1947 descrip
1948 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1949 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1951 wv = xmalloc_widget_value ();
1952 if (prev_wv)
1953 prev_wv->next = wv;
1954 else
1955 save_wv->contents = wv;
1956 wv->name = (char *) XSTRING (item_name)->data;
1957 if (!NILP (descrip))
1958 wv->key = (char *) XSTRING (descrip)->data;
1959 wv->value = 0;
1960 /* If this item has a null value,
1961 make the call_data null so that it won't display a box
1962 when the mouse is on it. */
1963 wv->call_data
1964 = (!NILP (def) ? (void *) &XVECTOR (menu_items)->contents[i] : 0);
1965 wv->enabled = !NILP (enable);
1966 prev_wv = wv;
1968 i += MENU_ITEMS_ITEM_LENGTH;
1972 /* Deal with the title, if it is non-nil. */
1973 if (!NILP (title))
1975 widget_value *wv_title = xmalloc_widget_value ();
1976 widget_value *wv_sep1 = xmalloc_widget_value ();
1977 widget_value *wv_sep2 = xmalloc_widget_value ();
1979 wv_sep2->name = "--";
1980 wv_sep2->next = first_wv->contents;
1982 wv_sep1->name = "--";
1983 wv_sep1->next = wv_sep2;
1985 wv_title->name = (char *) XSTRING (title)->data;
1986 wv_title->enabled = True;
1987 wv_title->next = wv_sep1;
1988 first_wv->contents = wv_title;
1991 /* Actually create the menu. */
1992 menu_id = widget_id_tick++;
1993 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
1994 f->output_data.x->widget, 1, 0,
1995 popup_selection_callback,
1996 popup_deactivate_callback);
1998 /* Adjust coordinates to relative to the outer (window manager) window. */
2000 Window child;
2001 int win_x = 0, win_y = 0;
2003 /* Find the position of the outside upper-left corner of
2004 the inner window, with respect to the outer window. */
2005 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
2007 BLOCK_INPUT;
2008 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2010 /* From-window, to-window. */
2011 f->output_data.x->window_desc,
2012 f->output_data.x->parent_desc,
2014 /* From-position, to-position. */
2015 0, 0, &win_x, &win_y,
2017 /* Child of window. */
2018 &child);
2019 UNBLOCK_INPUT;
2020 x += win_x;
2021 y += win_y;
2025 /* Adjust coordinates to be root-window-relative. */
2026 x += f->output_data.x->left_pos;
2027 y += f->output_data.x->top_pos;
2029 dummy.type = ButtonPress;
2030 dummy.serial = 0;
2031 dummy.send_event = 0;
2032 dummy.display = FRAME_X_DISPLAY (f);
2033 dummy.time = CurrentTime;
2034 dummy.root = FRAME_X_DISPLAY_INFO (f)->root_window;
2035 dummy.window = dummy.root;
2036 dummy.subwindow = dummy.root;
2037 dummy.x_root = x;
2038 dummy.y_root = y;
2039 dummy.x = x;
2040 dummy.y = y;
2041 dummy.state = (FRAME_X_DISPLAY_INFO (f)->grabbed >> 1) * Button1Mask;
2042 dummy.button = 0;
2043 for (i = 0; i < 5; i++)
2044 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2045 dummy.button = i;
2047 /* Don't allow any geometry request from the user. */
2048 XtSetArg (av[ac], XtNgeometry, 0); ac++;
2049 XtSetValues (menu, av, ac);
2051 /* Free the widget_value objects we used to specify the contents. */
2052 free_menubar_widget_value_tree (first_wv);
2054 /* No selection has been chosen yet. */
2055 menu_item_selection = 0;
2057 /* Display the menu. */
2058 lw_popup_menu (menu, &dummy);
2059 popup_activated_flag = 1;
2061 /* Process events that apply to the menu. */
2062 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id);
2064 /* fp turned off the following statement and wrote a comment
2065 that it is unnecessary--that the menu has already disappeared.
2066 Nowadays the menu disappears ok, all right, but
2067 we need to delete the widgets or multiple ones will pile up. */
2068 lw_destroy_all_widgets (menu_id);
2070 /* Find the selected item, and its pane, to return
2071 the proper value. */
2072 if (menu_item_selection != 0)
2074 Lisp_Object prefix, entry;
2076 prefix = Qnil;
2077 i = 0;
2078 while (i < menu_items_used)
2080 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2082 subprefix_stack[submenu_depth++] = prefix;
2083 prefix = entry;
2084 i++;
2086 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2088 prefix = subprefix_stack[--submenu_depth];
2089 i++;
2091 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2093 prefix
2094 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2095 i += MENU_ITEMS_PANE_LENGTH;
2097 /* Ignore a nil in the item list.
2098 It's meaningful only for dialog boxes. */
2099 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2100 i += 1;
2101 else
2103 entry
2104 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2105 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2107 if (keymaps != 0)
2109 int j;
2111 entry = Fcons (entry, Qnil);
2112 if (!NILP (prefix))
2113 entry = Fcons (prefix, entry);
2114 for (j = submenu_depth - 1; j >= 0; j--)
2115 if (!NILP (subprefix_stack[j]))
2116 entry = Fcons (subprefix_stack[j], entry);
2118 return entry;
2120 i += MENU_ITEMS_ITEM_LENGTH;
2125 return Qnil;
2128 static void
2129 dialog_selection_callback (widget, id, client_data)
2130 Widget widget;
2131 LWLIB_ID id;
2132 XtPointer client_data;
2134 /* The EMACS_INT cast avoids a warning. There's no problem
2135 as long as pointers have enough bits to hold small integers. */
2136 if ((int) (EMACS_INT) client_data != -1)
2137 menu_item_selection = (Lisp_Object *) client_data;
2138 BLOCK_INPUT;
2139 lw_destroy_all_widgets (id);
2140 UNBLOCK_INPUT;
2141 popup_activated_flag = 0;
2144 static char * button_names [] = {
2145 "button1", "button2", "button3", "button4", "button5",
2146 "button6", "button7", "button8", "button9", "button10" };
2148 static Lisp_Object
2149 xdialog_show (f, keymaps, title, error)
2150 FRAME_PTR f;
2151 int keymaps;
2152 Lisp_Object title;
2153 char **error;
2155 int i, nb_buttons=0;
2156 LWLIB_ID dialog_id;
2157 Widget menu;
2158 char dialog_name[6];
2160 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2162 /* Number of elements seen so far, before boundary. */
2163 int left_count = 0;
2164 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2165 int boundary_seen = 0;
2167 *error = NULL;
2169 if (menu_items_n_panes > 1)
2171 *error = "Multiple panes in dialog box";
2172 return Qnil;
2175 /* Create a tree of widget_value objects
2176 representing the text label and buttons. */
2178 Lisp_Object pane_name, prefix;
2179 char *pane_string;
2180 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2181 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2182 pane_string = (NILP (pane_name)
2183 ? "" : (char *) XSTRING (pane_name)->data);
2184 prev_wv = xmalloc_widget_value ();
2185 prev_wv->value = pane_string;
2186 if (keymaps && !NILP (prefix))
2187 prev_wv->name++;
2188 prev_wv->enabled = 1;
2189 prev_wv->name = "message";
2190 first_wv = prev_wv;
2192 /* Loop over all panes and items, filling in the tree. */
2193 i = MENU_ITEMS_PANE_LENGTH;
2194 while (i < menu_items_used)
2197 /* Create a new item within current pane. */
2198 Lisp_Object item_name, enable, descrip;
2199 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2200 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2201 descrip
2202 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2204 if (NILP (item_name))
2206 free_menubar_widget_value_tree (first_wv);
2207 *error = "Submenu in dialog items";
2208 return Qnil;
2210 if (EQ (item_name, Qquote))
2212 /* This is the boundary between left-side elts
2213 and right-side elts. Stop incrementing right_count. */
2214 boundary_seen = 1;
2215 i++;
2216 continue;
2218 if (nb_buttons >= 9)
2220 free_menubar_widget_value_tree (first_wv);
2221 *error = "Too many dialog items";
2222 return Qnil;
2225 wv = xmalloc_widget_value ();
2226 prev_wv->next = wv;
2227 wv->name = (char *) button_names[nb_buttons];
2228 if (!NILP (descrip))
2229 wv->key = (char *) XSTRING (descrip)->data;
2230 wv->value = (char *) XSTRING (item_name)->data;
2231 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
2232 wv->enabled = !NILP (enable);
2233 prev_wv = wv;
2235 if (! boundary_seen)
2236 left_count++;
2238 nb_buttons++;
2239 i += MENU_ITEMS_ITEM_LENGTH;
2242 /* If the boundary was not specified,
2243 by default put half on the left and half on the right. */
2244 if (! boundary_seen)
2245 left_count = nb_buttons - nb_buttons / 2;
2247 wv = xmalloc_widget_value ();
2248 wv->name = dialog_name;
2250 /* Dialog boxes use a really stupid name encoding
2251 which specifies how many buttons to use
2252 and how many buttons are on the right.
2253 The Q means something also. */
2254 dialog_name[0] = 'Q';
2255 dialog_name[1] = '0' + nb_buttons;
2256 dialog_name[2] = 'B';
2257 dialog_name[3] = 'R';
2258 /* Number of buttons to put on the right. */
2259 dialog_name[4] = '0' + nb_buttons - left_count;
2260 dialog_name[5] = 0;
2261 wv->contents = first_wv;
2262 first_wv = wv;
2265 /* Actually create the dialog. */
2266 dialog_id = widget_id_tick++;
2267 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2268 f->output_data.x->widget, 1, 0,
2269 dialog_selection_callback, 0);
2270 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
2271 /* Free the widget_value objects we used to specify the contents. */
2272 free_menubar_widget_value_tree (first_wv);
2274 /* No selection has been chosen yet. */
2275 menu_item_selection = 0;
2277 /* Display the menu. */
2278 lw_pop_up_all_widgets (dialog_id);
2279 popup_activated_flag = 1;
2281 /* Process events that apply to the menu. */
2282 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2284 lw_destroy_all_widgets (dialog_id);
2286 /* Find the selected item, and its pane, to return
2287 the proper value. */
2288 if (menu_item_selection != 0)
2290 Lisp_Object prefix;
2292 prefix = Qnil;
2293 i = 0;
2294 while (i < menu_items_used)
2296 Lisp_Object entry;
2298 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2300 prefix
2301 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2302 i += MENU_ITEMS_PANE_LENGTH;
2304 else
2306 entry
2307 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2308 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2310 if (keymaps != 0)
2312 entry = Fcons (entry, Qnil);
2313 if (!NILP (prefix))
2314 entry = Fcons (prefix, entry);
2316 return entry;
2318 i += MENU_ITEMS_ITEM_LENGTH;
2323 return Qnil;
2325 #else /* not USE_X_TOOLKIT */
2327 static Lisp_Object
2328 xmenu_show (f, x, y, for_click, keymaps, title, error)
2329 FRAME_PTR f;
2330 int x, y;
2331 int for_click;
2332 int keymaps;
2333 Lisp_Object title;
2334 char **error;
2336 Window root;
2337 XMenu *menu;
2338 int pane, selidx, lpane, status;
2339 Lisp_Object entry, pane_prefix;
2340 char *datap;
2341 int ulx, uly, width, height;
2342 int dispwidth, dispheight;
2343 int i, j;
2344 int maxwidth;
2345 int dummy_int;
2346 unsigned int dummy_uint;
2348 *error = 0;
2349 if (menu_items_n_panes == 0)
2350 return Qnil;
2352 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2354 *error = "Empty menu";
2355 return Qnil;
2358 /* Figure out which root window F is on. */
2359 XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root,
2360 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
2361 &dummy_uint, &dummy_uint);
2363 /* Make the menu on that window. */
2364 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
2365 if (menu == NULL)
2367 *error = "Can't create menu";
2368 return Qnil;
2371 #ifdef HAVE_X_WINDOWS
2372 /* Adjust coordinates to relative to the outer (window manager) window. */
2374 Window child;
2375 int win_x = 0, win_y = 0;
2377 /* Find the position of the outside upper-left corner of
2378 the inner window, with respect to the outer window. */
2379 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
2381 BLOCK_INPUT;
2382 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2384 /* From-window, to-window. */
2385 f->output_data.x->window_desc,
2386 f->output_data.x->parent_desc,
2388 /* From-position, to-position. */
2389 0, 0, &win_x, &win_y,
2391 /* Child of window. */
2392 &child);
2393 UNBLOCK_INPUT;
2394 x += win_x;
2395 y += win_y;
2398 #endif /* HAVE_X_WINDOWS */
2400 /* Adjust coordinates to be root-window-relative. */
2401 x += f->output_data.x->left_pos;
2402 y += f->output_data.x->top_pos;
2404 /* Create all the necessary panes and their items. */
2405 i = 0;
2406 while (i < menu_items_used)
2408 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2410 /* Create a new pane. */
2411 Lisp_Object pane_name, prefix;
2412 char *pane_string;
2414 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
2415 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2416 pane_string = (NILP (pane_name)
2417 ? "" : (char *) XSTRING (pane_name)->data);
2418 if (keymaps && !NILP (prefix))
2419 pane_string++;
2421 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
2422 if (lpane == XM_FAILURE)
2424 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2425 *error = "Can't create pane";
2426 return Qnil;
2428 i += MENU_ITEMS_PANE_LENGTH;
2430 /* Find the width of the widest item in this pane. */
2431 maxwidth = 0;
2432 j = i;
2433 while (j < menu_items_used)
2435 Lisp_Object item;
2436 item = XVECTOR (menu_items)->contents[j];
2437 if (EQ (item, Qt))
2438 break;
2439 if (NILP (item))
2441 j++;
2442 continue;
2444 width = STRING_BYTES (XSTRING (item));
2445 if (width > maxwidth)
2446 maxwidth = width;
2448 j += MENU_ITEMS_ITEM_LENGTH;
2451 /* Ignore a nil in the item list.
2452 It's meaningful only for dialog boxes. */
2453 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2454 i += 1;
2455 else
2457 /* Create a new item within current pane. */
2458 Lisp_Object item_name, enable, descrip;
2459 unsigned char *item_data;
2461 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2462 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2463 descrip
2464 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2465 if (!NILP (descrip))
2467 int gap = maxwidth - STRING_BYTES (XSTRING (item_name));
2468 #ifdef C_ALLOCA
2469 Lisp_Object spacer;
2470 spacer = Fmake_string (make_number (gap), make_number (' '));
2471 item_name = concat2 (item_name, spacer);
2472 item_name = concat2 (item_name, descrip);
2473 item_data = XSTRING (item_name)->data;
2474 #else
2475 /* if alloca is fast, use that to make the space,
2476 to reduce gc needs. */
2477 item_data
2478 = (unsigned char *) alloca (maxwidth
2479 + STRING_BYTES (XSTRING (descrip)) + 1);
2480 bcopy (XSTRING (item_name)->data, item_data,
2481 STRING_BYTES (XSTRING (item_name)));
2482 for (j = XSTRING (item_name)->size; j < maxwidth; j++)
2483 item_data[j] = ' ';
2484 bcopy (XSTRING (descrip)->data, item_data + j,
2485 STRING_BYTES (XSTRING (descrip)));
2486 item_data[j + STRING_BYTES (XSTRING (descrip))] = 0;
2487 #endif
2489 else
2490 item_data = XSTRING (item_name)->data;
2492 if (XMenuAddSelection (FRAME_X_DISPLAY (f),
2493 menu, lpane, 0, item_data,
2494 !NILP (enable))
2495 == XM_FAILURE)
2497 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2498 *error = "Can't add selection to menu";
2499 return Qnil;
2501 i += MENU_ITEMS_ITEM_LENGTH;
2505 /* All set and ready to fly. */
2506 XMenuRecompute (FRAME_X_DISPLAY (f), menu);
2507 dispwidth = DisplayWidth (FRAME_X_DISPLAY (f),
2508 XScreenNumberOfScreen (FRAME_X_SCREEN (f)));
2509 dispheight = DisplayHeight (FRAME_X_DISPLAY (f),
2510 XScreenNumberOfScreen (FRAME_X_SCREEN (f)));
2511 x = min (x, dispwidth);
2512 y = min (y, dispheight);
2513 x = max (x, 1);
2514 y = max (y, 1);
2515 XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y,
2516 &ulx, &uly, &width, &height);
2517 if (ulx+width > dispwidth)
2519 x -= (ulx + width) - dispwidth;
2520 ulx = dispwidth - width;
2522 if (uly+height > dispheight)
2524 y -= (uly + height) - dispheight;
2525 uly = dispheight - height;
2527 if (ulx < 0) x -= ulx;
2528 if (uly < 0) y -= uly;
2530 XMenuSetAEQ (menu, TRUE);
2531 XMenuSetFreeze (menu, TRUE);
2532 pane = selidx = 0;
2534 status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
2535 x, y, ButtonReleaseMask, &datap);
2538 #ifdef HAVE_X_WINDOWS
2539 /* Assume the mouse has moved out of the X window.
2540 If it has actually moved in, we will get an EnterNotify. */
2541 x_mouse_leave (FRAME_X_DISPLAY_INFO (f));
2542 #endif
2544 switch (status)
2546 case XM_SUCCESS:
2547 #ifdef XDEBUG
2548 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
2549 #endif
2551 /* Find the item number SELIDX in pane number PANE. */
2552 i = 0;
2553 while (i < menu_items_used)
2555 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2557 if (pane == 0)
2558 pane_prefix
2559 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2560 pane--;
2561 i += MENU_ITEMS_PANE_LENGTH;
2563 else
2565 if (pane == -1)
2567 if (selidx == 0)
2569 entry
2570 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2571 if (keymaps != 0)
2573 entry = Fcons (entry, Qnil);
2574 if (!NILP (pane_prefix))
2575 entry = Fcons (pane_prefix, entry);
2577 break;
2579 selidx--;
2581 i += MENU_ITEMS_ITEM_LENGTH;
2584 break;
2586 case XM_FAILURE:
2587 *error = "Can't activate menu";
2588 case XM_IA_SELECT:
2589 case XM_NO_SELECT:
2590 entry = Qnil;
2591 break;
2593 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2595 #ifdef HAVE_X_WINDOWS
2596 /* State that no mouse buttons are now held.
2597 (The oldXMenu code doesn't track this info for us.)
2598 That is not necessarily true, but the fiction leads to reasonable
2599 results, and it is a pain to ask which are actually held now. */
2600 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
2601 #endif
2603 return entry;
2606 #endif /* not USE_X_TOOLKIT */
2608 #endif /* HAVE_MENUS */
2610 void
2611 syms_of_xmenu ()
2613 staticpro (&menu_items);
2614 menu_items = Qnil;
2616 Qdebug_on_next_call = intern ("debug-on-next-call");
2617 staticpro (&Qdebug_on_next_call);
2619 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2620 "Frame for which we are updating a menu.\n\
2621 The enable predicate for a menu command should check this variable.");
2622 Vmenu_updating_frame = Qnil;
2624 #ifdef USE_X_TOOLKIT
2625 widget_id_tick = (1<<16);
2626 next_menubar_widget_id = 1;
2627 #endif
2629 defsubr (&Sx_popup_menu);
2630 #ifdef HAVE_MENUS
2631 defsubr (&Sx_popup_dialog);
2632 #endif