Fix -Wimplicit warnings.
[bpt/emacs.git] / src / xmenu.c
1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
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.
10
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.
15
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. */
20
21 /* X pop-up deck-of-cards menu facility for gnuemacs.
22 *
23 * Written by Jon Arnold and Roman Budzianowski
24 * Mods and rewrite by Robert Krawitz
25 *
26 */
27
28 /* Modified by Fred Pierresteguy on December 93
29 to make the popup menus and menubar use the Xt. */
30
31 /* Rewritten for clarity and GC protection by rms in Feb 94. */
32
33 /* On 4.3 this loses if it comes after xterm.h. */
34 #include <signal.h>
35 #include <config.h>
36
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"
45
46 #ifdef MSDOS
47 #include "msdos.h"
48 #endif
49
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
55
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
61
62 #include "dispextern.h"
63
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 */
79
80 #define min(x,y) (((x) < (y)) ? (x) : (y))
81 #define max(x,y) (((x) > (y)) ? (x) : (y))
82
83 #ifndef TRUE
84 #define TRUE 1
85 #define FALSE 0
86 #endif /* no TRUE */
87
88 Lisp_Object Vmenu_updating_frame;
89
90 Lisp_Object Qdebug_on_next_call;
91
92 extern Lisp_Object Qmenu_bar;
93 extern Lisp_Object Qmouse_click, Qevent_kind;
94
95 extern Lisp_Object QCtoggle, QCradio;
96
97 extern Lisp_Object Voverriding_local_map;
98 extern Lisp_Object Voverriding_local_map_menu_flag;
99
100 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
101
102 extern Lisp_Object Qmenu_bar_update_hook;
103
104 #ifdef USE_X_TOOLKIT
105 extern void set_frame_menubar ();
106 extern void process_expose_from_menu ();
107 extern XtAppContext Xt_app_con;
108
109 static Lisp_Object xdialog_show ();
110 void popup_get_selection ();
111 #endif
112
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 ();
119 \f
120 /* This holds a Lisp vector that holds the results of decoding
121 the keymaps or alist-of-alists that specify a menu.
122
123 It describes the panes and items within the panes.
124
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.
130
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.
135
136 A single vector slot containing quote indicates that the
137 following items should appear on the right of a dialog box.
138
139 Using a Lisp vector to hold this information while we decode it
140 takes care of protecting all the data from GC. */
141
142 #define MENU_ITEMS_PANE_NAME 1
143 #define MENU_ITEMS_PANE_PREFIX 2
144 #define MENU_ITEMS_PANE_LENGTH 3
145
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
152
153 static Lisp_Object menu_items;
154
155 /* Number of slots currently allocated in menu_items. */
156 static int menu_items_allocated;
157
158 /* This is the index in menu_items of the first empty slot. */
159 static int menu_items_used;
160
161 /* The number of panes currently recorded in menu_items,
162 excluding those within submenus. */
163 static int menu_items_n_panes;
164
165 /* Current depth within submenus. */
166 static int menu_items_submenu_depth;
167
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;
171
172 static int next_menubar_widget_id;
173
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.
177
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>. */
180
181 int pending_menu_activation;
182 \f
183 #ifdef USE_X_TOOLKIT
184
185 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
186
187 static struct frame *
188 menubar_id_to_frame (id)
189 LWLIB_ID id;
190 {
191 Lisp_Object tail, frame;
192 FRAME_PTR f;
193
194 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
195 {
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;
204 }
205 return 0;
206 }
207
208 #endif
209 \f
210 /* Initialize the menu_items structure if we haven't already done so.
211 Also mark it as currently empty. */
212
213 static void
214 init_menu_items ()
215 {
216 if (NILP (menu_items))
217 {
218 menu_items_allocated = 60;
219 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
220 }
221
222 menu_items_used = 0;
223 menu_items_n_panes = 0;
224 menu_items_submenu_depth = 0;
225 }
226
227 /* Call at the end of generating the data in menu_items.
228 This fills in the number of items in the last pane. */
229
230 static void
231 finish_menu_items ()
232 {
233 }
234
235 /* Call when finished using the data for the current menu
236 in menu_items. */
237
238 static void
239 discard_menu_items ()
240 {
241 /* Free the structure if it is especially large.
242 Otherwise, hold on to it, to save time. */
243 if (menu_items_allocated > 200)
244 {
245 menu_items = Qnil;
246 menu_items_allocated = 0;
247 }
248 }
249
250 /* Make the menu_items vector twice as large. */
251
252 static void
253 grow_menu_items ()
254 {
255 Lisp_Object old;
256 int old_size = menu_items_allocated;
257 old = menu_items;
258
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));
263 }
264
265 /* Begin a submenu. */
266
267 static void
268 push_submenu_start ()
269 {
270 if (menu_items_used + 1 > menu_items_allocated)
271 grow_menu_items ();
272
273 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
274 menu_items_submenu_depth++;
275 }
276
277 /* End a submenu. */
278
279 static void
280 push_submenu_end ()
281 {
282 if (menu_items_used + 1 > menu_items_allocated)
283 grow_menu_items ();
284
285 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
286 menu_items_submenu_depth--;
287 }
288
289 /* Indicate boundary between left and right. */
290
291 static void
292 push_left_right_boundary ()
293 {
294 if (menu_items_used + 1 > menu_items_allocated)
295 grow_menu_items ();
296
297 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
298 }
299
300 /* Start a new menu pane in menu_items..
301 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
302
303 static void
304 push_menu_pane (name, prefix_vec)
305 Lisp_Object name, prefix_vec;
306 {
307 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
308 grow_menu_items ();
309
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;
315 }
316
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). */
324
325 static void
326 push_menu_item (name, enable, key, def, equiv)
327 Lisp_Object name, enable, key, def, equiv;
328 {
329 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
330 grow_menu_items ();
331
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;
337 }
338 \f
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. */
343
344 static void
345 keymap_panes (keymaps, nmaps, notreal)
346 Lisp_Object *keymaps;
347 int nmaps;
348 int notreal;
349 {
350 int mapno;
351
352 init_menu_items ();
353
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);
359
360 finish_menu_items ();
361 }
362
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.
369
370 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
371
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;
379 {
380 Lisp_Object pending_maps = Qnil;
381 Lisp_Object tail, item;
382 struct gcpro gcpro1, gcpro2;
383 int notbuttons = 0;
384
385 if (maxdepth <= 0)
386 return;
387
388 push_menu_pane (pane_name, prefix);
389
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
397
398 for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
399 {
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))
408 {
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++)
413 {
414 Lisp_Object character;
415 XSETFASTINT (character, c);
416 single_menu_item (character, XVECTOR (item)->contents[c],
417 &pending_maps, notreal, maxdepth, &notbuttons);
418 }
419 }
420 UNGCPRO;
421 }
422
423 /* Process now any submenus which want to be panes at this level. */
424 while (!NILP (pending_maps))
425 {
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);
435 }
436 }
437 \f
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. */
449
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;
457 {
458 Lisp_Object def, map, item_string, enabled;
459 struct gcpro gcpro1, gcpro2;
460 int res;
461
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. */
468
469 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
470
471 if (notreal)
472 {
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;
478 }
479
480 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
481 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
482
483 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
484 {
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;
490 }
491
492 #ifndef HAVE_BOXES
493 /* Simulate radio buttons and toggle boxes by putting a prefix in
494 front of them. */
495 {
496 Lisp_Object prefix = Qnil;
497 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
498 if (!NILP (type))
499 {
500 Lisp_Object selected
501 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
502
503 if (*notbuttons_ptr)
504 /* The first button. Line up previous items in this menu. */
505 {
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)
510 {
511 tem
512 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
513 if (NILP (tem))
514 {
515 index++;
516 submenu++; /* Skip sub menu. */
517 }
518 else if (EQ (tem, Qlambda))
519 {
520 index++;
521 submenu--; /* End sub menu. */
522 }
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
528 {
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;
534 }
535 }
536 *notbuttons_ptr = 0;
537 }
538
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) ? "( ) " : "(*) ");
544 }
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 (" ");
549
550 if (!NILP (prefix))
551 item_string = concat2 (prefix, item_string);
552 }
553 #endif /* not HAVE_BOXES */
554
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
560
561 push_menu_item (item_string, enabled, key,
562 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
563 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]);
564
565 #ifdef USE_X_TOOLKIT
566 /* Display a submenu using the toolkit. */
567 if (! (NILP (map) || NILP (enabled)))
568 {
569 push_submenu_start ();
570 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
571 push_submenu_end ();
572 }
573 #endif
574 }
575 \f
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. */
579
580 static void
581 list_of_panes (menu)
582 Lisp_Object menu;
583 {
584 Lisp_Object tail;
585
586 init_menu_items ();
587
588 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
589 {
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);
598 }
599
600 finish_menu_items ();
601 }
602
603 /* Push the items in a single pane defined by the alist PANE. */
604
605 static void
606 list_of_items (pane)
607 Lisp_Object pane;
608 {
609 Lisp_Object tail, item, item1;
610
611 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
612 {
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
619 {
620 CHECK_CONS (item, 0);
621 item1 = Fcar (item);
622 CHECK_STRING (item1, 1);
623 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil);
624 }
625 }
626 }
627 \f
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\
637 \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\
645 \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\
650 \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\
658 \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;
663 {
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;
676
677 #ifdef HAVE_MENUS
678 if (! NILP (position))
679 {
680 check_x ();
681
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)))
685 {
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;
691
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
698 {
699 window = selected_window;
700 XSETFASTINT (x, 0);
701 XSETFASTINT (y, 0);
702 }
703 }
704 else
705 {
706 tem = Fcar (position);
707 if (CONSP (tem))
708 {
709 window = Fcar (Fcdr (position));
710 x = Fcar (tem);
711 y = Fcar (Fcdr (tem));
712 }
713 else
714 {
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);
721 }
722 }
723
724 CHECK_NUMBER (x, 0);
725 CHECK_NUMBER (y, 0);
726
727 /* Decode where to put the menu. */
728
729 if (FRAMEP (window))
730 {
731 f = XFRAME (window);
732 xpos = 0;
733 ypos = 0;
734 }
735 else if (WINDOWP (window))
736 {
737 CHECK_LIVE_WINDOW (window, 0);
738 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
739
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));
744 }
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);
749
750 xpos += XINT (x);
751 ypos += XINT (y);
752
753 XSETFRAME (Vmenu_updating_frame, f);
754 }
755 Vmenu_updating_frame = Qnil;
756 #endif /* HAVE_MENUS */
757
758 title = Qnil;
759 GCPRO1 (title);
760
761 /* Decode the menu items from what was specified. */
762
763 keymap = Fkeymapp (menu);
764 tem = Qnil;
765 if (CONSP (menu))
766 tem = Fkeymapp (Fcar (menu));
767 if (!NILP (keymap))
768 {
769 /* We were given a keymap. Extract menu info from the keymap. */
770 Lisp_Object prompt;
771 keymap = get_keymap (menu);
772
773 /* Extract the detailed info to make one pane. */
774 keymap_panes (&menu, 1, NILP (position));
775
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;
781
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;
785
786 keymaps = 1;
787 }
788 else if (!NILP (tem))
789 {
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;
795
796 title = Qnil;
797
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))
801 {
802 Lisp_Object prompt;
803
804 maps[i++] = keymap = get_keymap (Fcar (tem));
805
806 prompt = map_prompt (keymap);
807 if (NILP (title) && !NILP (prompt))
808 title = prompt;
809 }
810
811 /* Extract the detailed info to make one pane. */
812 keymap_panes (maps, nmaps, NILP (position));
813
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;
817
818 keymaps = 1;
819 }
820 else
821 {
822 /* We were given an old-fashioned menu. */
823 title = Fcar (menu);
824 CHECK_STRING (title, 1);
825
826 list_of_panes (Fcdr (menu));
827
828 keymaps = 0;
829 }
830
831 if (NILP (position))
832 {
833 discard_menu_items ();
834 UNGCPRO;
835 return Qnil;
836 }
837
838 #ifdef HAVE_MENUS
839 /* Display them in a menu. */
840 BLOCK_INPUT;
841
842 selection = xmenu_show (f, xpos, ypos, for_click,
843 keymaps, title, &error_name);
844 UNBLOCK_INPUT;
845
846 discard_menu_items ();
847
848 UNGCPRO;
849 #endif /* HAVE_MENUS */
850
851 if (error_name) error (error_name);
852 return selection;
853 }
854
855 #ifdef HAVE_MENUS
856
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\
863 \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;
874 {
875 FRAME_PTR f;
876 Lisp_Object window;
877
878 check_x ();
879
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)))
883 {
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;
891
892 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
893
894 if (new_f != 0)
895 XSETFRAME (window, new_f);
896 else
897 window = selected_window;
898 #endif
899 window = selected_window;
900 }
901 else if (CONSP (position))
902 {
903 Lisp_Object tem;
904 tem = Fcar (position);
905 if (CONSP (tem))
906 window = Fcar (Fcdr (position));
907 else
908 {
909 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
910 window = Fcar (tem); /* POSN_WINDOW (tem) */
911 }
912 }
913 else if (WINDOWP (position) || FRAMEP (position))
914 window = position;
915 else
916 window = Qnil;
917
918 /* Decode where to put the menu. */
919
920 if (FRAMEP (window))
921 f = XFRAME (window);
922 else if (WINDOWP (window))
923 {
924 CHECK_LIVE_WINDOW (window, 0);
925 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
926 }
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);
931
932 #ifndef USE_X_TOOLKIT
933 /* Display a menu with these alternatives
934 in the middle of frame F. */
935 {
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));
941
942 return Fx_popup_menu (newpos,
943 Fcons (Fcar (contents), Fcons (contents, Qnil)));
944 }
945 #else
946 {
947 Lisp_Object title;
948 char *error_name;
949 Lisp_Object selection;
950
951 /* Decode the dialog items from what was specified. */
952 title = Fcar (contents);
953 CHECK_STRING (title, 1);
954
955 list_of_panes (Fcons (contents, Qnil));
956
957 /* Display them in a dialog box. */
958 BLOCK_INPUT;
959 selection = xdialog_show (f, 0, title, &error_name);
960 UNBLOCK_INPUT;
961
962 discard_menu_items ();
963
964 if (error_name) error (error_name);
965 return selection;
966 }
967 #endif
968 }
969 \f
970 #ifdef USE_X_TOOLKIT
971
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.
975
976 NOTE: All calls to popup_get_selection should be protected
977 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
978
979 void
980 popup_get_selection (initial_event, dpyinfo, id)
981 XEvent *initial_event;
982 struct x_display_info *dpyinfo;
983 LWLIB_ID id;
984 {
985 XEvent event;
986
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
990 {
991 XEvent event;
992 struct event_queue *next;
993 };
994
995 struct event_queue *queue = NULL;
996 struct event_queue *queue_tmp;
997
998 if (initial_event)
999 event = *initial_event;
1000 else
1001 XtAppNextEvent (Xt_app_con, &event);
1002
1003 while (1)
1004 {
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)
1013 {
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
1022 }
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)
1027 {
1028 KeySym keysym = XLookupKeysym (&event.xkey, 0);
1029 if (!IsModifierKey (keysym))
1030 {
1031 popup_activated_flag = 0;
1032 break;
1033 }
1034 }
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))
1039 {
1040 popup_activated_flag = 0;
1041 break;
1042 }
1043
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)))
1054 {
1055 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1056
1057 if (queue_tmp != NULL)
1058 {
1059 queue_tmp->event = event;
1060 queue_tmp->next = queue;
1061 queue = queue_tmp;
1062 }
1063 }
1064 else
1065 XtDispatchEvent (&event);
1066
1067 if (!popup_activated ())
1068 break;
1069 XtAppNextEvent (Xt_app_con, &event);
1070 }
1071
1072 /* Unread any events that we got but did not handle. */
1073 while (queue != NULL)
1074 {
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;
1081 }
1082 }
1083
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.
1087
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.
1091
1092 But first we recompute the menu bar contents (the whole tree).
1093
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. */
1097
1098 void
1099 x_activate_menubar (f)
1100 FRAME_PTR f;
1101 {
1102 if (!f->output_data.x->saved_menu_event->type)
1103 return;
1104
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
1113
1114 /* Ignore this if we get it a second time. */
1115 f->output_data.x->saved_menu_event->type = 0;
1116 }
1117
1118 /* Detect if a dialog or menu has been posted. */
1119
1120 int
1121 popup_activated ()
1122 {
1123 return popup_activated_flag;
1124 }
1125
1126
1127 /* This callback is invoked when the user selects a menubar cascade
1128 pushbutton, but before the pulldown menu is posted. */
1129
1130 static void
1131 popup_activate_callback (widget, id, client_data)
1132 Widget widget;
1133 LWLIB_ID id;
1134 XtPointer client_data;
1135 {
1136 popup_activated_flag = 1;
1137 }
1138
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. */
1143
1144 static void
1145 menubar_selection_callback (widget, id, client_data)
1146 Widget widget;
1147 LWLIB_ID id;
1148 XtPointer client_data;
1149 {
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;
1156
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)
1164 {
1165 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1166 {
1167 subprefix_stack[submenu_depth++] = prefix;
1168 prefix = entry;
1169 i++;
1170 }
1171 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1172 {
1173 prefix = subprefix_stack[--submenu_depth];
1174 i++;
1175 }
1176 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1177 {
1178 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1179 i += MENU_ITEMS_PANE_LENGTH;
1180 }
1181 else
1182 {
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)
1187 {
1188 int j;
1189 struct input_event buf;
1190 Lisp_Object frame;
1191
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);
1196
1197 for (j = 0; j < submenu_depth; j++)
1198 if (!NILP (subprefix_stack[j]))
1199 {
1200 buf.kind = menu_bar_event;
1201 buf.frame_or_window = Fcons (frame, subprefix_stack[j]);
1202 kbd_buffer_store_event (&buf);
1203 }
1204
1205 if (!NILP (prefix))
1206 {
1207 buf.kind = menu_bar_event;
1208 buf.frame_or_window = Fcons (frame, prefix);
1209 kbd_buffer_store_event (&buf);
1210 }
1211
1212 buf.kind = menu_bar_event;
1213 buf.frame_or_window = Fcons (frame, entry);
1214 kbd_buffer_store_event (&buf);
1215
1216 return;
1217 }
1218 i += MENU_ITEMS_ITEM_LENGTH;
1219 }
1220 }
1221 }
1222
1223 /* This callback is invoked when a dialog or menu is finished being
1224 used and has been unposted. */
1225
1226 static void
1227 popup_deactivate_callback (widget, id, client_data)
1228 Widget widget;
1229 LWLIB_ID id;
1230 XtPointer client_data;
1231 {
1232 popup_activated_flag = 0;
1233 }
1234
1235 /* Allocate a widget_value, blocking input. */
1236
1237 widget_value *
1238 xmalloc_widget_value ()
1239 {
1240 widget_value *value;
1241
1242 BLOCK_INPUT;
1243 value = malloc_widget_value ();
1244 UNBLOCK_INPUT;
1245
1246 return value;
1247 }
1248
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. */
1253
1254 void
1255 free_menubar_widget_value_tree (wv)
1256 widget_value *wv;
1257 {
1258 if (! wv) return;
1259
1260 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1261
1262 if (wv->contents && (wv->contents != (widget_value*)1))
1263 {
1264 free_menubar_widget_value_tree (wv->contents);
1265 wv->contents = (widget_value *) 0xDEADBEEF;
1266 }
1267 if (wv->next)
1268 {
1269 free_menubar_widget_value_tree (wv->next);
1270 wv->next = (widget_value *) 0xDEADBEEF;
1271 }
1272 BLOCK_INPUT;
1273 free_widget_value (wv);
1274 UNBLOCK_INPUT;
1275 }
1276 \f
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. */
1280
1281 static widget_value *
1282 single_submenu (item_key, item_name, maps)
1283 Lisp_Object item_key, item_name, maps;
1284 {
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;
1295
1296 length = Flength (maps);
1297 len = XINT (length);
1298
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++)
1302 {
1303 mapvec[i] = Fcar (maps);
1304 maps = Fcdr (maps);
1305 }
1306
1307 menu_items_n_panes = 0;
1308
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++)
1312 {
1313 if (SYMBOLP (mapvec[i])
1314 || (CONSP (mapvec[i])
1315 && NILP (Fkeymapp (mapvec[i]))))
1316 {
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);
1322 }
1323 else
1324 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1325 }
1326
1327 /* Create a tree of widget_value objects
1328 representing the panes and their items. */
1329
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;
1339
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)
1346 {
1347 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1348 {
1349 submenu_stack[submenu_depth++] = save_wv;
1350 save_wv = prev_wv;
1351 prev_wv = 0;
1352 i++;
1353 }
1354 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1355 {
1356 prev_wv = save_wv;
1357 save_wv = submenu_stack[--submenu_depth];
1358 i++;
1359 }
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))
1368 {
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 = "";
1380
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, ""))
1385 {
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;
1398 }
1399 save_wv = wv;
1400 prev_wv = 0;
1401 i += MENU_ITEMS_PANE_LENGTH;
1402 }
1403 else
1404 {
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];
1412
1413 wv = xmalloc_widget_value ();
1414 if (prev_wv)
1415 prev_wv->next = wv;
1416 else
1417 save_wv->contents = wv;
1418
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;
1428
1429 i += MENU_ITEMS_ITEM_LENGTH;
1430 }
1431 }
1432
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)
1436 {
1437 wv = first_wv->contents;
1438 free_widget_value (first_wv);
1439 return wv;
1440 }
1441
1442 return first_wv;
1443 }
1444 \f
1445 extern void EmacsFrameSetCharSize ();
1446
1447 /* Recompute all the widgets of frame F, when the menu bar
1448 has been changed. */
1449
1450 static void
1451 update_frame_menubar (f)
1452 FRAME_PTR f;
1453 {
1454 struct x_output *x = f->output_data.x;
1455 int columns, rows;
1456 int menubar_changed;
1457
1458 Dimension shell_height;
1459
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.
1463 */
1464 menubar_changed = (x->menubar_widget
1465 && !XtIsManaged (x->menubar_widget));
1466
1467 if (! (menubar_changed))
1468 return;
1469
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;
1475
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);
1479
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.
1483 */
1484 XtUnmanageChild (x->edit_widget);
1485
1486 /* remove the menubar that is there now, and put up the menubar that
1487 should be there.
1488 */
1489 if (menubar_changed)
1490 {
1491 XtManageChild (x->menubar_widget);
1492 XtMapWidget (x->menubar_widget);
1493 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0);
1494 }
1495
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);
1499
1500 /* Force the pane widget to resize itself with the right values. */
1501 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1502
1503 UNBLOCK_INPUT;
1504 }
1505
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. */
1509
1510 void
1511 set_frame_menubar (f, first_time, deep_p)
1512 FRAME_PTR f;
1513 int first_time;
1514 int deep_p;
1515 {
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;
1521
1522 XSETFRAME (Vmenu_updating_frame, f);
1523
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;
1527
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)
1534 {
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;
1538 }
1539
1540 wv = xmalloc_widget_value ();
1541 wv->name = "menubar";
1542 wv->value = 0;
1543 wv->enabled = 1;
1544 first_wv = wv;
1545
1546 if (deep_p)
1547 {
1548 /* Make a widget-value tree representing the entire menu trees. */
1549
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));
1557
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;
1562
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);
1568
1569 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1570 if (NILP (Voverriding_local_map_menu_flag))
1571 {
1572 specbind (Qoverriding_terminal_local_map, Qnil);
1573 specbind (Qoverriding_local_map, Qnil);
1574 }
1575
1576 set_buffer_internal_1 (XBUFFER (buffer));
1577
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));
1586
1587 items = FRAME_MENU_BAR_ITEMS (f);
1588
1589 inhibit_garbage_collection ();
1590
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));
1594
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)
1600 {
1601 Lisp_Object key, string, maps;
1602
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;
1608
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;
1617 }
1618
1619 finish_menu_items ();
1620
1621 set_buffer_internal_1 (prev);
1622 unbind_to (specpdl_count, Qnil);
1623
1624 /* If there has been no change in the Lisp-level contents
1625 of the menu bar, skip redisplaying it. Just exit. */
1626
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)
1632 {
1633 free_menubar_widget_value_tree (first_wv);
1634 menu_items = Qnil;
1635
1636 return;
1637 }
1638
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)
1643 {
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;
1650 }
1651
1652 f->menu_bar_vector = menu_items;
1653 f->menu_bar_items_used = menu_items_used;
1654 menu_items = Qnil;
1655 }
1656 else
1657 {
1658 /* Make a widget-value tree containing
1659 just the top level menu bar strings. */
1660
1661 items = FRAME_MENU_BAR_ITEMS (f);
1662 for (i = 0; i < XVECTOR (items)->size; i += 4)
1663 {
1664 Lisp_Object string;
1665
1666 string = XVECTOR (items)->contents[i + 1];
1667 if (NILP (string))
1668 break;
1669
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);
1679
1680 if (prev_wv)
1681 prev_wv->next = wv;
1682 else
1683 first_wv->contents = wv;
1684 prev_wv = wv;
1685 }
1686
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;
1691 }
1692
1693 /* Create or update the menu bar widget. */
1694
1695 BLOCK_INPUT;
1696
1697 if (menubar_widget)
1698 {
1699 /* Disable resizing (done for Motif!) */
1700 lw_allow_resizing (f->output_data.x->widget, False);
1701
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);
1705
1706 /* Re-enable the edit widget to resize. */
1707 lw_allow_resizing (f->output_data.x->widget, True);
1708 }
1709 else
1710 {
1711 menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv,
1712 f->output_data.x->column_widget,
1713 0,
1714 popup_activate_callback,
1715 menubar_selection_callback,
1716 popup_deactivate_callback);
1717 f->output_data.x->menubar_widget = menubar_widget;
1718 }
1719
1720 {
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);
1726
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))
1731 {
1732 Dimension ibw = 0;
1733 XtVaGetValues (f->output_data.x->column_widget,
1734 XtNinternalBorderWidth, &ibw, NULL);
1735 menubar_size += ibw;
1736 }
1737 #endif /* USE_LUCID */
1738 #endif /* 0 */
1739
1740 f->output_data.x->menubar_height = menubar_size;
1741 }
1742
1743 free_menubar_widget_value_tree (first_wv);
1744
1745 update_frame_menubar (f);
1746
1747 UNBLOCK_INPUT;
1748 }
1749
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. */
1754
1755 void
1756 initialize_frame_menubar (f)
1757 FRAME_PTR f;
1758 {
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);
1763 }
1764
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. */
1767
1768 void
1769 free_frame_menubar (f)
1770 FRAME_PTR f;
1771 {
1772 Widget menubar_widget;
1773 int id;
1774
1775 menubar_widget = f->output_data.x->menubar_widget;
1776
1777 f->output_data.x->menubar_height = 0;
1778
1779 if (menubar_widget)
1780 {
1781 BLOCK_INPUT;
1782 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
1783 UNBLOCK_INPUT;
1784 }
1785 }
1786
1787 #endif /* USE_X_TOOLKIT */
1788 \f
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. */
1793
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.) */
1804
1805 #ifdef USE_X_TOOLKIT
1806
1807 /* We need a unique id for each widget handled by the Lucid Widget
1808 library.
1809
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.
1812
1813 For menu bars, we use numbers starting at 0, counted in
1814 next_menubar_widget_id. */
1815 LWLIB_ID widget_id_tick;
1816
1817 #ifdef __STDC__
1818 static Lisp_Object *volatile menu_item_selection;
1819 #else
1820 static Lisp_Object *menu_item_selection;
1821 #endif
1822
1823 static void
1824 popup_selection_callback (widget, id, client_data)
1825 Widget widget;
1826 LWLIB_ID id;
1827 XtPointer client_data;
1828 {
1829 menu_item_selection = (Lisp_Object *) client_data;
1830 }
1831
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;
1841 {
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;
1854
1855 int first_pane;
1856 int next_release_must_exit = 0;
1857
1858 *error = NULL;
1859
1860 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1861 {
1862 *error = "Empty menu";
1863 return Qnil;
1864 }
1865
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;
1874
1875 /* Loop over all panes and items, filling in the tree. */
1876 i = 0;
1877 while (i < menu_items_used)
1878 {
1879 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1880 {
1881 submenu_stack[submenu_depth++] = save_wv;
1882 save_wv = prev_wv;
1883 prev_wv = 0;
1884 first_pane = 1;
1885 i++;
1886 }
1887 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1888 {
1889 prev_wv = save_wv;
1890 save_wv = submenu_stack[--submenu_depth];
1891 first_pane = 0;
1892 i++;
1893 }
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))
1902 {
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 = "";
1914
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, ""))
1919 {
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;
1932 }
1933 else if (first_pane)
1934 {
1935 save_wv = wv;
1936 prev_wv = 0;
1937 }
1938 first_pane = 0;
1939 i += MENU_ITEMS_PANE_LENGTH;
1940 }
1941 else
1942 {
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];
1950
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;
1967
1968 i += MENU_ITEMS_ITEM_LENGTH;
1969 }
1970 }
1971
1972 /* Deal with the title, if it is non-nil. */
1973 if (!NILP (title))
1974 {
1975 widget_value *wv_title = xmalloc_widget_value ();
1976 widget_value *wv_sep1 = xmalloc_widget_value ();
1977 widget_value *wv_sep2 = xmalloc_widget_value ();
1978
1979 wv_sep2->name = "--";
1980 wv_sep2->next = first_wv->contents;
1981
1982 wv_sep1->name = "--";
1983 wv_sep1->next = wv_sep2;
1984
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;
1989 }
1990
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);
1997
1998 /* Adjust coordinates to relative to the outer (window manager) window. */
1999 {
2000 Window child;
2001 int win_x = 0, win_y = 0;
2002
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)
2006 {
2007 BLOCK_INPUT;
2008 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2009
2010 /* From-window, to-window. */
2011 f->output_data.x->window_desc,
2012 f->output_data.x->parent_desc,
2013
2014 /* From-position, to-position. */
2015 0, 0, &win_x, &win_y,
2016
2017 /* Child of window. */
2018 &child);
2019 UNBLOCK_INPUT;
2020 x += win_x;
2021 y += win_y;
2022 }
2023 }
2024
2025 /* Adjust coordinates to be root-window-relative. */
2026 x += f->output_data.x->left_pos;
2027 y += f->output_data.x->top_pos;
2028
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;
2046
2047 /* Don't allow any geometry request from the user. */
2048 XtSetArg (av[ac], XtNgeometry, 0); ac++;
2049 XtSetValues (menu, av, ac);
2050
2051 /* Free the widget_value objects we used to specify the contents. */
2052 free_menubar_widget_value_tree (first_wv);
2053
2054 /* No selection has been chosen yet. */
2055 menu_item_selection = 0;
2056
2057 /* Display the menu. */
2058 lw_popup_menu (menu, &dummy);
2059 popup_activated_flag = 1;
2060
2061 /* Process events that apply to the menu. */
2062 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id);
2063
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);
2069
2070 /* Find the selected item, and its pane, to return
2071 the proper value. */
2072 if (menu_item_selection != 0)
2073 {
2074 Lisp_Object prefix, entry;
2075
2076 prefix = Qnil;
2077 i = 0;
2078 while (i < menu_items_used)
2079 {
2080 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2081 {
2082 subprefix_stack[submenu_depth++] = prefix;
2083 prefix = entry;
2084 i++;
2085 }
2086 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2087 {
2088 prefix = subprefix_stack[--submenu_depth];
2089 i++;
2090 }
2091 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2092 {
2093 prefix
2094 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2095 i += MENU_ITEMS_PANE_LENGTH;
2096 }
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
2102 {
2103 entry
2104 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2105 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2106 {
2107 if (keymaps != 0)
2108 {
2109 int j;
2110
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);
2117 }
2118 return entry;
2119 }
2120 i += MENU_ITEMS_ITEM_LENGTH;
2121 }
2122 }
2123 }
2124
2125 return Qnil;
2126 }
2127 \f
2128 static void
2129 dialog_selection_callback (widget, id, client_data)
2130 Widget widget;
2131 LWLIB_ID id;
2132 XtPointer client_data;
2133 {
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;
2142 }
2143
2144 static char * button_names [] = {
2145 "button1", "button2", "button3", "button4", "button5",
2146 "button6", "button7", "button8", "button9", "button10" };
2147
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;
2154 {
2155 int i, nb_buttons=0;
2156 LWLIB_ID dialog_id;
2157 Widget menu;
2158 char dialog_name[6];
2159
2160 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2161
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;
2166
2167 *error = NULL;
2168
2169 if (menu_items_n_panes > 1)
2170 {
2171 *error = "Multiple panes in dialog box";
2172 return Qnil;
2173 }
2174
2175 /* Create a tree of widget_value objects
2176 representing the text label and buttons. */
2177 {
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;
2191
2192 /* Loop over all panes and items, filling in the tree. */
2193 i = MENU_ITEMS_PANE_LENGTH;
2194 while (i < menu_items_used)
2195 {
2196
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];
2203
2204 if (NILP (item_name))
2205 {
2206 free_menubar_widget_value_tree (first_wv);
2207 *error = "Submenu in dialog items";
2208 return Qnil;
2209 }
2210 if (EQ (item_name, Qquote))
2211 {
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;
2217 }
2218 if (nb_buttons >= 9)
2219 {
2220 free_menubar_widget_value_tree (first_wv);
2221 *error = "Too many dialog items";
2222 return Qnil;
2223 }
2224
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;
2234
2235 if (! boundary_seen)
2236 left_count++;
2237
2238 nb_buttons++;
2239 i += MENU_ITEMS_ITEM_LENGTH;
2240 }
2241
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;
2246
2247 wv = xmalloc_widget_value ();
2248 wv->name = dialog_name;
2249
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;
2263 }
2264
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);
2273
2274 /* No selection has been chosen yet. */
2275 menu_item_selection = 0;
2276
2277 /* Display the menu. */
2278 lw_pop_up_all_widgets (dialog_id);
2279 popup_activated_flag = 1;
2280
2281 /* Process events that apply to the menu. */
2282 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2283
2284 lw_destroy_all_widgets (dialog_id);
2285
2286 /* Find the selected item, and its pane, to return
2287 the proper value. */
2288 if (menu_item_selection != 0)
2289 {
2290 Lisp_Object prefix;
2291
2292 prefix = Qnil;
2293 i = 0;
2294 while (i < menu_items_used)
2295 {
2296 Lisp_Object entry;
2297
2298 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2299 {
2300 prefix
2301 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2302 i += MENU_ITEMS_PANE_LENGTH;
2303 }
2304 else
2305 {
2306 entry
2307 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2308 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2309 {
2310 if (keymaps != 0)
2311 {
2312 entry = Fcons (entry, Qnil);
2313 if (!NILP (prefix))
2314 entry = Fcons (prefix, entry);
2315 }
2316 return entry;
2317 }
2318 i += MENU_ITEMS_ITEM_LENGTH;
2319 }
2320 }
2321 }
2322
2323 return Qnil;
2324 }
2325 #else /* not USE_X_TOOLKIT */
2326
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;
2335 {
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;
2347
2348 *error = 0;
2349 if (menu_items_n_panes == 0)
2350 return Qnil;
2351
2352 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2353 {
2354 *error = "Empty menu";
2355 return Qnil;
2356 }
2357
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);
2362
2363 /* Make the menu on that window. */
2364 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
2365 if (menu == NULL)
2366 {
2367 *error = "Can't create menu";
2368 return Qnil;
2369 }
2370
2371 #ifdef HAVE_X_WINDOWS
2372 /* Adjust coordinates to relative to the outer (window manager) window. */
2373 {
2374 Window child;
2375 int win_x = 0, win_y = 0;
2376
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)
2380 {
2381 BLOCK_INPUT;
2382 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2383
2384 /* From-window, to-window. */
2385 f->output_data.x->window_desc,
2386 f->output_data.x->parent_desc,
2387
2388 /* From-position, to-position. */
2389 0, 0, &win_x, &win_y,
2390
2391 /* Child of window. */
2392 &child);
2393 UNBLOCK_INPUT;
2394 x += win_x;
2395 y += win_y;
2396 }
2397 }
2398 #endif /* HAVE_X_WINDOWS */
2399
2400 /* Adjust coordinates to be root-window-relative. */
2401 x += f->output_data.x->left_pos;
2402 y += f->output_data.x->top_pos;
2403
2404 /* Create all the necessary panes and their items. */
2405 i = 0;
2406 while (i < menu_items_used)
2407 {
2408 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2409 {
2410 /* Create a new pane. */
2411 Lisp_Object pane_name, prefix;
2412 char *pane_string;
2413
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++;
2420
2421 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
2422 if (lpane == XM_FAILURE)
2423 {
2424 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2425 *error = "Can't create pane";
2426 return Qnil;
2427 }
2428 i += MENU_ITEMS_PANE_LENGTH;
2429
2430 /* Find the width of the widest item in this pane. */
2431 maxwidth = 0;
2432 j = i;
2433 while (j < menu_items_used)
2434 {
2435 Lisp_Object item;
2436 item = XVECTOR (menu_items)->contents[j];
2437 if (EQ (item, Qt))
2438 break;
2439 if (NILP (item))
2440 {
2441 j++;
2442 continue;
2443 }
2444 width = STRING_BYTES (XSTRING (item));
2445 if (width > maxwidth)
2446 maxwidth = width;
2447
2448 j += MENU_ITEMS_ITEM_LENGTH;
2449 }
2450 }
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
2456 {
2457 /* Create a new item within current pane. */
2458 Lisp_Object item_name, enable, descrip;
2459 unsigned char *item_data;
2460
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))
2466 {
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
2488 }
2489 else
2490 item_data = XSTRING (item_name)->data;
2491
2492 if (XMenuAddSelection (FRAME_X_DISPLAY (f),
2493 menu, lpane, 0, item_data,
2494 !NILP (enable))
2495 == XM_FAILURE)
2496 {
2497 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2498 *error = "Can't add selection to menu";
2499 return Qnil;
2500 }
2501 i += MENU_ITEMS_ITEM_LENGTH;
2502 }
2503 }
2504
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)
2518 {
2519 x -= (ulx + width) - dispwidth;
2520 ulx = dispwidth - width;
2521 }
2522 if (uly+height > dispheight)
2523 {
2524 y -= (uly + height) - dispheight;
2525 uly = dispheight - height;
2526 }
2527 if (ulx < 0) x -= ulx;
2528 if (uly < 0) y -= uly;
2529
2530 XMenuSetAEQ (menu, TRUE);
2531 XMenuSetFreeze (menu, TRUE);
2532 pane = selidx = 0;
2533
2534 status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
2535 x, y, ButtonReleaseMask, &datap);
2536
2537
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
2543
2544 switch (status)
2545 {
2546 case XM_SUCCESS:
2547 #ifdef XDEBUG
2548 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
2549 #endif
2550
2551 /* Find the item number SELIDX in pane number PANE. */
2552 i = 0;
2553 while (i < menu_items_used)
2554 {
2555 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2556 {
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;
2562 }
2563 else
2564 {
2565 if (pane == -1)
2566 {
2567 if (selidx == 0)
2568 {
2569 entry
2570 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2571 if (keymaps != 0)
2572 {
2573 entry = Fcons (entry, Qnil);
2574 if (!NILP (pane_prefix))
2575 entry = Fcons (pane_prefix, entry);
2576 }
2577 break;
2578 }
2579 selidx--;
2580 }
2581 i += MENU_ITEMS_ITEM_LENGTH;
2582 }
2583 }
2584 break;
2585
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;
2592 }
2593 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2594
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
2602
2603 return entry;
2604 }
2605
2606 #endif /* not USE_X_TOOLKIT */
2607
2608 #endif /* HAVE_MENUS */
2609 \f
2610 void
2611 syms_of_xmenu ()
2612 {
2613 staticpro (&menu_items);
2614 menu_items = Qnil;
2615
2616 Qdebug_on_next_call = intern ("debug-on-next-call");
2617 staticpro (&Qdebug_on_next_call);
2618
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;
2623
2624 #ifdef USE_X_TOOLKIT
2625 widget_id_tick = (1<<16);
2626 next_menubar_widget_id = 1;
2627 #endif
2628
2629 defsubr (&Sx_popup_menu);
2630 #ifdef HAVE_MENUS
2631 defsubr (&Sx_popup_dialog);
2632 #endif
2633 }