(unuse_menu_items, digest_single_submenu):
[bpt/emacs.git] / src / xmenu.c
1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 88, 93, 94, 96, 99, 2000, 2001
3 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 /* X pop-up deck-of-cards menu facility for GNU Emacs.
23 *
24 * Written by Jon Arnold and Roman Budzianowski
25 * Mods and rewrite by Robert Krawitz
26 *
27 */
28
29 /* Modified by Fred Pierresteguy on December 93
30 to make the popup menus and menubar use the Xt. */
31
32 /* Rewritten for clarity and GC protection by rms in Feb 94. */
33
34 #include <config.h>
35
36 /* On 4.3 this loses if it comes after xterm.h. */
37 #include <signal.h>
38
39 #include <stdio.h>
40
41 #include "lisp.h"
42 #include "termhooks.h"
43 #include "keyboard.h"
44 #include "keymap.h"
45 #include "frame.h"
46 #include "window.h"
47 #include "blockinput.h"
48 #include "buffer.h"
49 #include "charset.h"
50 #include "coding.h"
51
52 #ifdef MSDOS
53 #include "msdos.h"
54 #endif
55
56 #ifdef HAVE_X_WINDOWS
57 /* This may include sys/types.h, and that somehow loses
58 if this is not done before the other system files. */
59 #include "xterm.h"
60 #endif
61
62 /* Load sys/types.h if not already loaded.
63 In some systems loading it twice is suicidal. */
64 #ifndef makedev
65 #include <sys/types.h>
66 #endif
67
68 #include "dispextern.h"
69
70 #ifdef HAVE_X_WINDOWS
71 #undef HAVE_MULTILINGUAL_MENU
72 #ifdef USE_X_TOOLKIT
73 #include "widget.h"
74 #include <X11/Xlib.h>
75 #include <X11/IntrinsicP.h>
76 #include <X11/CoreP.h>
77 #include <X11/StringDefs.h>
78 #include <X11/Shell.h>
79 #ifdef USE_LUCID
80 #include <X11/Xaw/Paned.h>
81 #endif /* USE_LUCID */
82 #include "../lwlib/lwlib.h"
83 #else /* not USE_X_TOOLKIT */
84 #include "../oldXMenu/XMenu.h"
85 #endif /* not USE_X_TOOLKIT */
86 #endif /* HAVE_X_WINDOWS */
87
88 #ifndef TRUE
89 #define TRUE 1
90 #define FALSE 0
91 #endif /* no TRUE */
92
93 Lisp_Object Vmenu_updating_frame;
94
95 Lisp_Object Qdebug_on_next_call;
96
97 extern Lisp_Object Qmenu_bar;
98 extern Lisp_Object Qmouse_click, Qevent_kind;
99
100 extern Lisp_Object QCtoggle, QCradio;
101
102 extern Lisp_Object Voverriding_local_map;
103 extern Lisp_Object Voverriding_local_map_menu_flag;
104
105 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
106
107 extern Lisp_Object Qmenu_bar_update_hook;
108
109 #ifdef USE_X_TOOLKIT
110 extern void set_frame_menubar ();
111 extern void process_expose_from_menu ();
112 extern XtAppContext Xt_app_con;
113
114 static Lisp_Object xdialog_show ();
115 void popup_get_selection ();
116
117 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
118
119 #define HAVE_BOXES 1
120 #endif
121
122 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
123 Lisp_Object, Lisp_Object, Lisp_Object,
124 Lisp_Object, Lisp_Object));
125 static int update_frame_menubar P_ ((struct frame *));
126 static Lisp_Object xmenu_show P_ ((struct frame *, int, int, int, int,
127 Lisp_Object, char **));
128 static void keymap_panes P_ ((Lisp_Object *, int, int));
129 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
130 int, int));
131 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object *,
132 int, int, int *));
133 static void list_of_panes P_ ((Lisp_Object));
134 static void list_of_items P_ ((Lisp_Object));
135 \f
136 /* This holds a Lisp vector that holds the results of decoding
137 the keymaps or alist-of-alists that specify a menu.
138
139 It describes the panes and items within the panes.
140
141 Each pane is described by 3 elements in the vector:
142 t, the pane name, the pane's prefix key.
143 Then follow the pane's items, with 5 elements per item:
144 the item string, the enable flag, the item's value,
145 the definition, and the equivalent keyboard key's description string.
146
147 In some cases, multiple levels of menus may be described.
148 A single vector slot containing nil indicates the start of a submenu.
149 A single vector slot containing lambda indicates the end of a submenu.
150 The submenu follows a menu item which is the way to reach the submenu.
151
152 A single vector slot containing quote indicates that the
153 following items should appear on the right of a dialog box.
154
155 Using a Lisp vector to hold this information while we decode it
156 takes care of protecting all the data from GC. */
157
158 #define MENU_ITEMS_PANE_NAME 1
159 #define MENU_ITEMS_PANE_PREFIX 2
160 #define MENU_ITEMS_PANE_LENGTH 3
161
162 enum menu_item_idx
163 {
164 MENU_ITEMS_ITEM_NAME = 0,
165 MENU_ITEMS_ITEM_ENABLE,
166 MENU_ITEMS_ITEM_VALUE,
167 MENU_ITEMS_ITEM_EQUIV_KEY,
168 MENU_ITEMS_ITEM_DEFINITION,
169 MENU_ITEMS_ITEM_TYPE,
170 MENU_ITEMS_ITEM_SELECTED,
171 MENU_ITEMS_ITEM_HELP,
172 MENU_ITEMS_ITEM_LENGTH
173 };
174
175 static Lisp_Object menu_items;
176
177 /* If non-nil, means that the global vars defined here are already in use.
178 Used to detect cases where we try to re-enter this non-reentrant code. */
179 static Lisp_Object menu_items_inuse;
180
181 /* Number of slots currently allocated in menu_items. */
182 static int menu_items_allocated;
183
184 /* This is the index in menu_items of the first empty slot. */
185 static int menu_items_used;
186
187 /* The number of panes currently recorded in menu_items,
188 excluding those within submenus. */
189 static int menu_items_n_panes;
190
191 /* Current depth within submenus. */
192 static int menu_items_submenu_depth;
193
194 /* Flag which when set indicates a dialog or menu has been posted by
195 Xt on behalf of one of the widget sets. */
196 int popup_activated_flag;
197
198 static int next_menubar_widget_id;
199
200 /* This is set nonzero after the user activates the menu bar, and set
201 to zero again after the menu bars are redisplayed by prepare_menu_bar.
202 While it is nonzero, all calls to set_frame_menubar go deep.
203
204 I don't understand why this is needed, but it does seem to be
205 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
206
207 int pending_menu_activation;
208 \f
209 #ifdef USE_X_TOOLKIT
210
211 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
212
213 static struct frame *
214 menubar_id_to_frame (id)
215 LWLIB_ID id;
216 {
217 Lisp_Object tail, frame;
218 FRAME_PTR f;
219
220 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
221 {
222 frame = XCAR (tail);
223 if (!GC_FRAMEP (frame))
224 continue;
225 f = XFRAME (frame);
226 if (!FRAME_WINDOW_P (f))
227 continue;
228 if (f->output_data.x->id == id)
229 return f;
230 }
231 return 0;
232 }
233
234 #endif
235 \f
236 /* Initialize the menu_items structure if we haven't already done so.
237 Also mark it as currently empty. */
238
239 static void
240 init_menu_items ()
241 {
242 if (NILP (menu_items))
243 {
244 menu_items_allocated = 60;
245 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
246 }
247
248 if (!NILP (menu_items_inuse))
249 error ("Trying to use a menu from within a menu-entry");
250 menu_items_inuse = Qt;
251 menu_items_used = 0;
252 menu_items_n_panes = 0;
253 menu_items_submenu_depth = 0;
254 }
255
256 /* Call at the end of generating the data in menu_items. */
257
258 static void
259 finish_menu_items ()
260 {
261 }
262
263 static Lisp_Object
264 unuse_menu_items (dummy)
265 int dummy;
266 {
267 return menu_items_inuse = Qnil;
268 }
269
270 /* Call when finished using the data for the current menu
271 in menu_items. */
272
273 static void
274 discard_menu_items ()
275 {
276 /* Free the structure if it is especially large.
277 Otherwise, hold on to it, to save time. */
278 if (menu_items_allocated > 200)
279 {
280 menu_items = Qnil;
281 menu_items_allocated = 0;
282 }
283 xassert (NILP (menu_items_inuse));
284 }
285
286 /* Make the menu_items vector twice as large. */
287
288 static void
289 grow_menu_items ()
290 {
291 Lisp_Object old;
292 int old_size = menu_items_allocated;
293 old = menu_items;
294
295 menu_items_allocated *= 2;
296 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
297 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
298 old_size * sizeof (Lisp_Object));
299 }
300
301 /* Begin a submenu. */
302
303 static void
304 push_submenu_start ()
305 {
306 if (menu_items_used + 1 > menu_items_allocated)
307 grow_menu_items ();
308
309 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
310 menu_items_submenu_depth++;
311 }
312
313 /* End a submenu. */
314
315 static void
316 push_submenu_end ()
317 {
318 if (menu_items_used + 1 > menu_items_allocated)
319 grow_menu_items ();
320
321 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
322 menu_items_submenu_depth--;
323 }
324
325 /* Indicate boundary between left and right. */
326
327 static void
328 push_left_right_boundary ()
329 {
330 if (menu_items_used + 1 > menu_items_allocated)
331 grow_menu_items ();
332
333 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
334 }
335
336 /* Start a new menu pane in menu_items.
337 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
338
339 static void
340 push_menu_pane (name, prefix_vec)
341 Lisp_Object name, prefix_vec;
342 {
343 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
344 grow_menu_items ();
345
346 if (menu_items_submenu_depth == 0)
347 menu_items_n_panes++;
348 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
349 XVECTOR (menu_items)->contents[menu_items_used++] = name;
350 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
351 }
352
353 /* Push one menu item into the current pane. NAME is the string to
354 display. ENABLE if non-nil means this item can be selected. KEY
355 is the key generated by choosing this item, or nil if this item
356 doesn't really have a definition. DEF is the definition of this
357 item. EQUIV is the textual description of the keyboard equivalent
358 for this item (or nil if none). TYPE is the type of this menu
359 item, one of nil, `toggle' or `radio'. */
360
361 static void
362 push_menu_item (name, enable, key, def, equiv, type, selected, help)
363 Lisp_Object name, enable, key, def, equiv, type, selected, help;
364 {
365 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
366 grow_menu_items ();
367
368 XVECTOR (menu_items)->contents[menu_items_used++] = name;
369 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
370 XVECTOR (menu_items)->contents[menu_items_used++] = key;
371 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
372 XVECTOR (menu_items)->contents[menu_items_used++] = def;
373 XVECTOR (menu_items)->contents[menu_items_used++] = type;
374 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
375 XVECTOR (menu_items)->contents[menu_items_used++] = help;
376 }
377 \f
378 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
379 and generate menu panes for them in menu_items.
380 If NOTREAL is nonzero,
381 don't bother really computing whether an item is enabled. */
382
383 static void
384 keymap_panes (keymaps, nmaps, notreal)
385 Lisp_Object *keymaps;
386 int nmaps;
387 int notreal;
388 {
389 int mapno;
390
391 init_menu_items ();
392
393 /* Loop over the given keymaps, making a pane for each map.
394 But don't make a pane that is empty--ignore that map instead.
395 P is the number of panes we have made so far. */
396 for (mapno = 0; mapno < nmaps; mapno++)
397 single_keymap_panes (keymaps[mapno],
398 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
399
400 finish_menu_items ();
401 }
402
403 /* This is a recursive subroutine of keymap_panes.
404 It handles one keymap, KEYMAP.
405 The other arguments are passed along
406 or point to local variables of the previous function.
407 If NOTREAL is nonzero, only check for equivalent key bindings, don't
408 evaluate expressions in menu items and don't make any menu.
409
410 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
411
412 static void
413 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
414 Lisp_Object keymap;
415 Lisp_Object pane_name;
416 Lisp_Object prefix;
417 int notreal;
418 int maxdepth;
419 {
420 Lisp_Object pending_maps = Qnil;
421 Lisp_Object tail, item;
422 struct gcpro gcpro1, gcpro2;
423 int notbuttons = 0;
424
425 if (maxdepth <= 0)
426 return;
427
428 push_menu_pane (pane_name, prefix);
429
430 #ifndef HAVE_BOXES
431 /* Remember index for first item in this pane so we can go back and
432 add a prefix when (if) we see the first button. After that, notbuttons
433 is set to 0, to mark that we have seen a button and all non button
434 items need a prefix. */
435 notbuttons = menu_items_used;
436 #endif
437
438 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
439 {
440 GCPRO2 (keymap, pending_maps);
441 /* Look at each key binding, and if it is a menu item add it
442 to this menu. */
443 item = XCAR (tail);
444 if (CONSP (item))
445 single_menu_item (XCAR (item), XCDR (item),
446 &pending_maps, notreal, maxdepth, &notbuttons);
447 else if (VECTORP (item))
448 {
449 /* Loop over the char values represented in the vector. */
450 int len = XVECTOR (item)->size;
451 int c;
452 for (c = 0; c < len; c++)
453 {
454 Lisp_Object character;
455 XSETFASTINT (character, c);
456 single_menu_item (character, XVECTOR (item)->contents[c],
457 &pending_maps, notreal, maxdepth, &notbuttons);
458 }
459 }
460 UNGCPRO;
461 }
462
463 /* Process now any submenus which want to be panes at this level. */
464 while (!NILP (pending_maps))
465 {
466 Lisp_Object elt, eltcdr, string;
467 elt = Fcar (pending_maps);
468 eltcdr = XCDR (elt);
469 string = XCAR (eltcdr);
470 /* We no longer discard the @ from the beginning of the string here.
471 Instead, we do this in xmenu_show. */
472 single_keymap_panes (Fcar (elt), string,
473 XCDR (eltcdr), notreal, maxdepth - 1);
474 pending_maps = Fcdr (pending_maps);
475 }
476 }
477 \f
478 /* This is a subroutine of single_keymap_panes that handles one
479 keymap entry.
480 KEY is a key in a keymap and ITEM is its binding.
481 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
482 separate panes.
483 If NOTREAL is nonzero, only check for equivalent key bindings, don't
484 evaluate expressions in menu items and don't make any menu.
485 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
486 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
487 buttons. It points to variable notbuttons in single_keymap_panes,
488 which keeps track of if we have seen a button in this menu or not. */
489
490 static void
491 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth,
492 notbuttons_ptr)
493 Lisp_Object key, item;
494 Lisp_Object *pending_maps_ptr;
495 int maxdepth, notreal;
496 int *notbuttons_ptr;
497 {
498 Lisp_Object map, item_string, enabled;
499 struct gcpro gcpro1, gcpro2;
500 int res;
501
502 /* Parse the menu item and leave the result in item_properties. */
503 GCPRO2 (key, item);
504 res = parse_menu_item (item, notreal, 0);
505 UNGCPRO;
506 if (!res)
507 return; /* Not a menu item. */
508
509 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
510
511 if (notreal)
512 {
513 /* We don't want to make a menu, just traverse the keymaps to
514 precompute equivalent key bindings. */
515 if (!NILP (map))
516 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
517 return;
518 }
519
520 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
521 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
522
523 if (!NILP (map) && SREF (item_string, 0) == '@')
524 {
525 if (!NILP (enabled))
526 /* An enabled separate pane. Remember this to handle it later. */
527 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
528 *pending_maps_ptr);
529 return;
530 }
531
532 #ifndef HAVE_BOXES
533 /* Simulate radio buttons and toggle boxes by putting a prefix in
534 front of them. */
535 {
536 Lisp_Object prefix = Qnil;
537 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
538 if (!NILP (type))
539 {
540 Lisp_Object selected
541 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
542
543 if (*notbuttons_ptr)
544 /* The first button. Line up previous items in this menu. */
545 {
546 int index = *notbuttons_ptr; /* Index for first item this menu. */
547 int submenu = 0;
548 Lisp_Object tem;
549 while (index < menu_items_used)
550 {
551 tem
552 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
553 if (NILP (tem))
554 {
555 index++;
556 submenu++; /* Skip sub menu. */
557 }
558 else if (EQ (tem, Qlambda))
559 {
560 index++;
561 submenu--; /* End sub menu. */
562 }
563 else if (EQ (tem, Qt))
564 index += 3; /* Skip new pane marker. */
565 else if (EQ (tem, Qquote))
566 index++; /* Skip a left, right divider. */
567 else
568 {
569 if (!submenu && SREF (tem, 0) != '\0'
570 && SREF (tem, 0) != '-')
571 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
572 = concat2 (build_string (" "), tem);
573 index += MENU_ITEMS_ITEM_LENGTH;
574 }
575 }
576 *notbuttons_ptr = 0;
577 }
578
579 /* Calculate prefix, if any, for this item. */
580 if (EQ (type, QCtoggle))
581 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
582 else if (EQ (type, QCradio))
583 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
584 }
585 /* Not a button. If we have earlier buttons, then we need a prefix. */
586 else if (!*notbuttons_ptr && SREF (item_string, 0) != '\0'
587 && SREF (item_string, 0) != '-')
588 prefix = build_string (" ");
589
590 if (!NILP (prefix))
591 item_string = concat2 (prefix, item_string);
592 }
593 #endif /* not HAVE_BOXES */
594
595 #ifndef USE_X_TOOLKIT
596 if (!NILP(map))
597 /* Indicate visually that this is a submenu. */
598 item_string = concat2 (item_string, build_string (" >"));
599 #endif
600
601 push_menu_item (item_string, enabled, key,
602 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
603 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
604 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
605 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
606 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
607
608 #ifdef USE_X_TOOLKIT
609 /* Display a submenu using the toolkit. */
610 if (! (NILP (map) || NILP (enabled)))
611 {
612 push_submenu_start ();
613 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
614 push_submenu_end ();
615 }
616 #endif
617 }
618 \f
619 /* Push all the panes and items of a menu described by the
620 alist-of-alists MENU.
621 This handles old-fashioned calls to x-popup-menu. */
622
623 static void
624 list_of_panes (menu)
625 Lisp_Object menu;
626 {
627 Lisp_Object tail;
628
629 init_menu_items ();
630
631 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
632 {
633 Lisp_Object elt, pane_name, pane_data;
634 elt = Fcar (tail);
635 pane_name = Fcar (elt);
636 CHECK_STRING (pane_name);
637 push_menu_pane (pane_name, Qnil);
638 pane_data = Fcdr (elt);
639 CHECK_CONS (pane_data);
640 list_of_items (pane_data);
641 }
642
643 finish_menu_items ();
644 }
645
646 /* Push the items in a single pane defined by the alist PANE. */
647
648 static void
649 list_of_items (pane)
650 Lisp_Object pane;
651 {
652 Lisp_Object tail, item, item1;
653
654 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
655 {
656 item = Fcar (tail);
657 if (STRINGP (item))
658 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
659 else if (NILP (item))
660 push_left_right_boundary ();
661 else
662 {
663 CHECK_CONS (item);
664 item1 = Fcar (item);
665 CHECK_STRING (item1);
666 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
667 }
668 }
669 }
670 \f
671 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
672 doc: /* Pop up a deck-of-cards menu and return user's selection.
673 POSITION is a position specification. This is either a mouse button event
674 or a list ((XOFFSET YOFFSET) WINDOW)
675 where XOFFSET and YOFFSET are positions in pixels from the top left
676 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)
677 This controls the position of the center of the first line
678 in the first pane of the menu, not the top left of the menu as a whole.
679 If POSITION is t, it means to use the current mouse position.
680
681 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
682 The menu items come from key bindings that have a menu string as well as
683 a definition; actually, the "definition" in such a key binding looks like
684 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
685 the keymap as a top-level element.
686
687 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
688 Otherwise, REAL-DEFINITION should be a valid key binding definition.
689
690 You can also use a list of keymaps as MENU.
691 Then each keymap makes a separate pane.
692 When MENU is a keymap or a list of keymaps, the return value
693 is a list of events.
694
695 Alternatively, you can specify a menu of multiple panes
696 with a list of the form (TITLE PANE1 PANE2...),
697 where each pane is a list of form (TITLE ITEM1 ITEM2...).
698 Each ITEM is normally a cons cell (STRING . VALUE);
699 but a string can appear as an item--that makes a nonselectable line
700 in the menu.
701 With this form of menu, the return value is VALUE from the chosen item.
702
703 If POSITION is nil, don't display the menu at all, just precalculate the
704 cached information about equivalent key sequences. */)
705 (position, menu)
706 Lisp_Object position, menu;
707 {
708 Lisp_Object keymap, tem;
709 int xpos = 0, ypos = 0;
710 Lisp_Object title;
711 char *error_name;
712 Lisp_Object selection;
713 FRAME_PTR f = NULL;
714 Lisp_Object x, y, window;
715 int keymaps = 0;
716 int for_click = 0;
717 int specpdl_count = SPECPDL_INDEX ();
718 struct gcpro gcpro1;
719
720 #ifdef HAVE_MENUS
721 if (! NILP (position))
722 {
723 check_x ();
724
725 /* Decode the first argument: find the window and the coordinates. */
726 if (EQ (position, Qt)
727 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
728 || EQ (XCAR (position), Qtool_bar))))
729 {
730 /* Use the mouse's current position. */
731 FRAME_PTR new_f = SELECTED_FRAME ();
732 Lisp_Object bar_window;
733 enum scroll_bar_part part;
734 unsigned long time;
735
736 if (mouse_position_hook)
737 (*mouse_position_hook) (&new_f, 1, &bar_window,
738 &part, &x, &y, &time);
739 if (new_f != 0)
740 XSETFRAME (window, new_f);
741 else
742 {
743 window = selected_window;
744 XSETFASTINT (x, 0);
745 XSETFASTINT (y, 0);
746 }
747 }
748 else
749 {
750 tem = Fcar (position);
751 if (CONSP (tem))
752 {
753 window = Fcar (Fcdr (position));
754 x = Fcar (tem);
755 y = Fcar (Fcdr (tem));
756 }
757 else
758 {
759 for_click = 1;
760 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
761 window = Fcar (tem); /* POSN_WINDOW (tem) */
762 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
763 x = Fcar (tem);
764 y = Fcdr (tem);
765 }
766 }
767
768 CHECK_NUMBER (x);
769 CHECK_NUMBER (y);
770
771 /* Decode where to put the menu. */
772
773 if (FRAMEP (window))
774 {
775 f = XFRAME (window);
776 xpos = 0;
777 ypos = 0;
778 }
779 else if (WINDOWP (window))
780 {
781 CHECK_LIVE_WINDOW (window);
782 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
783
784 xpos = (FONT_WIDTH (FRAME_FONT (f))
785 * XFASTINT (XWINDOW (window)->left));
786 ypos = (FRAME_LINE_HEIGHT (f)
787 * XFASTINT (XWINDOW (window)->top));
788 }
789 else
790 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
791 but I don't want to make one now. */
792 CHECK_WINDOW (window);
793
794 xpos += XINT (x);
795 ypos += XINT (y);
796 }
797 Vmenu_updating_frame = Qnil;
798 #endif /* HAVE_MENUS */
799
800 record_unwind_protect (unuse_menu_items, Qnil);
801 title = Qnil;
802 GCPRO1 (title);
803
804 /* Decode the menu items from what was specified. */
805
806 keymap = get_keymap (menu, 0, 0);
807 if (CONSP (keymap))
808 {
809 /* We were given a keymap. Extract menu info from the keymap. */
810 Lisp_Object prompt;
811
812 /* Extract the detailed info to make one pane. */
813 keymap_panes (&menu, 1, NILP (position));
814
815 /* Search for a string appearing directly as an element of the keymap.
816 That string is the title of the menu. */
817 prompt = Fkeymap_prompt (keymap);
818 if (NILP (title) && !NILP (prompt))
819 title = prompt;
820
821 /* Make that be the pane title of the first pane. */
822 if (!NILP (prompt) && menu_items_n_panes >= 0)
823 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
824
825 keymaps = 1;
826 }
827 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
828 {
829 /* We were given a list of keymaps. */
830 int nmaps = XFASTINT (Flength (menu));
831 Lisp_Object *maps
832 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
833 int i;
834
835 title = Qnil;
836
837 /* The first keymap that has a prompt string
838 supplies the menu title. */
839 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
840 {
841 Lisp_Object prompt;
842
843 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
844
845 prompt = Fkeymap_prompt (keymap);
846 if (NILP (title) && !NILP (prompt))
847 title = prompt;
848 }
849
850 /* Extract the detailed info to make one pane. */
851 keymap_panes (maps, nmaps, NILP (position));
852
853 /* Make the title be the pane title of the first pane. */
854 if (!NILP (title) && menu_items_n_panes >= 0)
855 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
856
857 keymaps = 1;
858 }
859 else
860 {
861 /* We were given an old-fashioned menu. */
862 title = Fcar (menu);
863 CHECK_STRING (title);
864
865 list_of_panes (Fcdr (menu));
866
867 keymaps = 0;
868 }
869
870 unbind_to (specpdl_count, Qnil);
871
872 if (NILP (position))
873 {
874 discard_menu_items ();
875 UNGCPRO;
876 return Qnil;
877 }
878
879 #ifdef HAVE_MENUS
880 /* Display them in a menu. */
881 BLOCK_INPUT;
882
883 selection = xmenu_show (f, xpos, ypos, for_click,
884 keymaps, title, &error_name);
885 UNBLOCK_INPUT;
886
887 discard_menu_items ();
888
889 UNGCPRO;
890 #endif /* HAVE_MENUS */
891
892 if (error_name) error (error_name);
893 return selection;
894 }
895
896 #ifdef HAVE_MENUS
897
898 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
899 doc: /* Pop up a dialog box and return user's selection.
900 POSITION specifies which frame to use.
901 This is normally a mouse button event or a window or frame.
902 If POSITION is t, it means to use the frame the mouse is on.
903 The dialog box appears in the middle of the specified frame.
904
905 CONTENTS specifies the alternatives to display in the dialog box.
906 It is a list of the form (TITLE ITEM1 ITEM2...).
907 Each ITEM is a cons cell (STRING . VALUE).
908 The return value is VALUE from the chosen item.
909
910 An ITEM may also be just a string--that makes a nonselectable item.
911 An ITEM may also be nil--that means to put all preceding items
912 on the left of the dialog box and all following items on the right.
913 \(By default, approximately half appear on each side.) */)
914 (position, contents)
915 Lisp_Object position, contents;
916 {
917 FRAME_PTR f = NULL;
918 Lisp_Object window;
919
920 check_x ();
921
922 /* Decode the first argument: find the window or frame to use. */
923 if (EQ (position, Qt)
924 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
925 || EQ (XCAR (position), Qtool_bar))))
926 {
927 #if 0 /* Using the frame the mouse is on may not be right. */
928 /* Use the mouse's current position. */
929 FRAME_PTR new_f = SELECTED_FRAME ();
930 Lisp_Object bar_window;
931 enum scroll_bar_part part;
932 unsigned long time;
933 Lisp_Object x, y;
934
935 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
936
937 if (new_f != 0)
938 XSETFRAME (window, new_f);
939 else
940 window = selected_window;
941 #endif
942 window = selected_window;
943 }
944 else if (CONSP (position))
945 {
946 Lisp_Object tem;
947 tem = Fcar (position);
948 if (CONSP (tem))
949 window = Fcar (Fcdr (position));
950 else
951 {
952 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
953 window = Fcar (tem); /* POSN_WINDOW (tem) */
954 }
955 }
956 else if (WINDOWP (position) || FRAMEP (position))
957 window = position;
958 else
959 window = Qnil;
960
961 /* Decode where to put the menu. */
962
963 if (FRAMEP (window))
964 f = XFRAME (window);
965 else if (WINDOWP (window))
966 {
967 CHECK_LIVE_WINDOW (window);
968 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
969 }
970 else
971 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
972 but I don't want to make one now. */
973 CHECK_WINDOW (window);
974
975 #ifndef USE_X_TOOLKIT
976 /* Display a menu with these alternatives
977 in the middle of frame F. */
978 {
979 Lisp_Object x, y, frame, newpos;
980 XSETFRAME (frame, f);
981 XSETINT (x, x_pixel_width (f) / 2);
982 XSETINT (y, x_pixel_height (f) / 2);
983 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
984
985 return Fx_popup_menu (newpos,
986 Fcons (Fcar (contents), Fcons (contents, Qnil)));
987 }
988 #else
989 {
990 Lisp_Object title;
991 char *error_name;
992 Lisp_Object selection;
993 int specpdl_count = SPECPDL_INDEX ();
994
995 /* Decode the dialog items from what was specified. */
996 title = Fcar (contents);
997 CHECK_STRING (title);
998 record_unwind_protect (unuse_menu_items, Qnil);
999
1000 list_of_panes (Fcons (contents, Qnil));
1001
1002 /* Display them in a dialog box. */
1003 BLOCK_INPUT;
1004 selection = xdialog_show (f, 0, title, &error_name);
1005 UNBLOCK_INPUT;
1006
1007 unbind_to (specpdl_count, Qnil);
1008 discard_menu_items ();
1009
1010 if (error_name) error (error_name);
1011 return selection;
1012 }
1013 #endif
1014 }
1015 \f
1016 #ifdef USE_X_TOOLKIT
1017
1018 /* Loop in Xt until the menu pulldown or dialog popup has been
1019 popped down (deactivated). This is used for x-popup-menu
1020 and x-popup-dialog; it is not used for the menu bar any more.
1021
1022 NOTE: All calls to popup_get_selection should be protected
1023 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1024
1025 void
1026 popup_get_selection (initial_event, dpyinfo, id)
1027 XEvent *initial_event;
1028 struct x_display_info *dpyinfo;
1029 LWLIB_ID id;
1030 {
1031 XEvent event;
1032
1033 /* Define a queue to save up for later unreading
1034 all X events that don't pertain to the menu. */
1035 struct event_queue
1036 {
1037 XEvent event;
1038 struct event_queue *next;
1039 };
1040
1041 struct event_queue *queue = NULL;
1042 struct event_queue *queue_tmp;
1043
1044 if (initial_event)
1045 event = *initial_event;
1046 else
1047 XtAppNextEvent (Xt_app_con, &event);
1048
1049 while (1)
1050 {
1051 /* Handle expose events for editor frames right away. */
1052 if (event.type == Expose)
1053 process_expose_from_menu (event);
1054 /* Make sure we don't consider buttons grabbed after menu goes.
1055 And make sure to deactivate for any ButtonRelease,
1056 even if XtDispatchEvent doesn't do that. */
1057 else if (event.type == ButtonRelease
1058 && dpyinfo->display == event.xbutton.display)
1059 {
1060 dpyinfo->grabbed &= ~(1 << event.xbutton.button);
1061 popup_activated_flag = 0;
1062 #ifdef USE_MOTIF /* Pretending that the event came from a
1063 Btn1Down seems the only way to convince Motif to
1064 activate its callbacks; setting the XmNmenuPost
1065 isn't working. --marcus@sysc.pdx.edu. */
1066 event.xbutton.button = 1;
1067 #endif
1068 }
1069 /* If the user presses a key, deactivate the menu.
1070 The user is likely to do that if we get wedged. */
1071 else if (event.type == KeyPress
1072 && dpyinfo->display == event.xbutton.display)
1073 {
1074 KeySym keysym = XLookupKeysym (&event.xkey, 0);
1075 if (!IsModifierKey (keysym))
1076 {
1077 popup_activated_flag = 0;
1078 break;
1079 }
1080 }
1081 /* Button presses outside the menu also pop it down. */
1082 else if (event.type == ButtonPress
1083 && event.xany.display == dpyinfo->display
1084 && x_any_window_to_frame (dpyinfo, event.xany.window))
1085 {
1086 popup_activated_flag = 0;
1087 break;
1088 }
1089
1090 /* Queue all events not for this popup,
1091 except for Expose, which we've already handled, and ButtonRelease.
1092 Note that the X window is associated with the frame if this
1093 is a menu bar popup, but not if it's a dialog box. So we use
1094 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1095 if (event.type != Expose
1096 && !(event.type == ButtonRelease
1097 && dpyinfo->display == event.xbutton.display)
1098 && (event.xany.display != dpyinfo->display
1099 || x_non_menubar_window_to_frame (dpyinfo, event.xany.window)))
1100 {
1101 queue_tmp = (struct event_queue *) xmalloc (sizeof *queue_tmp);
1102 queue_tmp->event = event;
1103 queue_tmp->next = queue;
1104 queue = queue_tmp;
1105 }
1106 else
1107 XtDispatchEvent (&event);
1108
1109 if (!popup_activated ())
1110 break;
1111 XtAppNextEvent (Xt_app_con, &event);
1112 }
1113
1114 /* Unread any events that we got but did not handle. */
1115 while (queue != NULL)
1116 {
1117 queue_tmp = queue;
1118 XPutBackEvent (queue_tmp->event.xany.display, &queue_tmp->event);
1119 queue = queue_tmp->next;
1120 xfree ((char *)queue_tmp);
1121 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1122 interrupt_input_pending = 1;
1123 }
1124 }
1125
1126 /* Activate the menu bar of frame F.
1127 This is called from keyboard.c when it gets the
1128 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1129
1130 To activate the menu bar, we use the X button-press event
1131 that was saved in saved_menu_event.
1132 That makes the toolkit do its thing.
1133
1134 But first we recompute the menu bar contents (the whole tree).
1135
1136 The reason for saving the button event until here, instead of
1137 passing it to the toolkit right away, is that we can safely
1138 execute Lisp code. */
1139
1140 void
1141 x_activate_menubar (f)
1142 FRAME_PTR f;
1143 {
1144 if (!f->output_data.x->saved_menu_event->type)
1145 return;
1146
1147 set_frame_menubar (f, 0, 1);
1148 BLOCK_INPUT;
1149 XtDispatchEvent (f->output_data.x->saved_menu_event);
1150 UNBLOCK_INPUT;
1151 #ifdef USE_MOTIF
1152 if (f->output_data.x->saved_menu_event->type == ButtonRelease)
1153 pending_menu_activation = 1;
1154 #endif
1155
1156 /* Ignore this if we get it a second time. */
1157 f->output_data.x->saved_menu_event->type = 0;
1158 }
1159
1160 /* Detect if a dialog or menu has been posted. */
1161
1162 int
1163 popup_activated ()
1164 {
1165 return popup_activated_flag;
1166 }
1167
1168 /* This callback is invoked when the user selects a menubar cascade
1169 pushbutton, but before the pulldown menu is posted. */
1170
1171 static void
1172 popup_activate_callback (widget, id, client_data)
1173 Widget widget;
1174 LWLIB_ID id;
1175 XtPointer client_data;
1176 {
1177 popup_activated_flag = 1;
1178 }
1179
1180 /* This callback is invoked when a dialog or menu is finished being
1181 used and has been unposted. */
1182
1183 static void
1184 popup_deactivate_callback (widget, id, client_data)
1185 Widget widget;
1186 LWLIB_ID id;
1187 XtPointer client_data;
1188 {
1189 popup_activated_flag = 0;
1190 }
1191
1192 /* Lwlib callback called when menu items are highlighted/unhighlighted
1193 while moving the mouse over them. WIDGET is the menu bar or menu
1194 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1195 the widget_value structure for the menu item, or null in case of
1196 unhighlighting. */
1197
1198 void
1199 menu_highlight_callback (widget, id, call_data)
1200 Widget widget;
1201 LWLIB_ID id;
1202 void *call_data;
1203 {
1204 widget_value *wv = (widget_value *) call_data;
1205 struct frame *f;
1206 Lisp_Object frame, help;
1207
1208 help = wv ? wv->help : Qnil;
1209
1210 /* Determine the frame for the help event. */
1211 f = menubar_id_to_frame (id);
1212 if (f)
1213 {
1214 XSETFRAME (frame, f);
1215 kbd_buffer_store_help_event (frame, help);
1216 }
1217 else
1218 {
1219 /* WIDGET is the popup menu. It's parent is the frame's
1220 widget. See which frame that is. */
1221 Widget frame_widget = XtParent (widget);
1222 Lisp_Object tail;
1223
1224 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
1225 {
1226 frame = XCAR (tail);
1227 if (GC_FRAMEP (frame)
1228 && (f = XFRAME (frame),
1229 FRAME_X_P (f) && f->output_data.x->widget == frame_widget))
1230 break;
1231 }
1232
1233 show_help_echo (help, Qnil, Qnil, Qnil, 1);
1234 }
1235 }
1236
1237 /* This callback is called from the menu bar pulldown menu
1238 when the user makes a selection.
1239 Figure out what the user chose
1240 and put the appropriate events into the keyboard buffer. */
1241
1242 static void
1243 menubar_selection_callback (widget, id, client_data)
1244 Widget widget;
1245 LWLIB_ID id;
1246 XtPointer client_data;
1247 {
1248 Lisp_Object prefix, entry;
1249 FRAME_PTR f = menubar_id_to_frame (id);
1250 Lisp_Object vector;
1251 Lisp_Object *subprefix_stack;
1252 int submenu_depth = 0;
1253 int i;
1254
1255 if (!f)
1256 return;
1257 entry = Qnil;
1258 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1259 vector = f->menu_bar_vector;
1260 prefix = Qnil;
1261 i = 0;
1262 while (i < f->menu_bar_items_used)
1263 {
1264 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1265 {
1266 subprefix_stack[submenu_depth++] = prefix;
1267 prefix = entry;
1268 i++;
1269 }
1270 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1271 {
1272 prefix = subprefix_stack[--submenu_depth];
1273 i++;
1274 }
1275 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1276 {
1277 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1278 i += MENU_ITEMS_PANE_LENGTH;
1279 }
1280 else
1281 {
1282 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1283 /* The EMACS_INT cast avoids a warning. There's no problem
1284 as long as pointers have enough bits to hold small integers. */
1285 if ((int) (EMACS_INT) client_data == i)
1286 {
1287 int j;
1288 struct input_event buf;
1289 Lisp_Object frame;
1290
1291 XSETFRAME (frame, f);
1292 buf.kind = MENU_BAR_EVENT;
1293 buf.frame_or_window = frame;
1294 buf.arg = frame;
1295 kbd_buffer_store_event (&buf);
1296
1297 for (j = 0; j < submenu_depth; j++)
1298 if (!NILP (subprefix_stack[j]))
1299 {
1300 buf.kind = MENU_BAR_EVENT;
1301 buf.frame_or_window = frame;
1302 buf.arg = subprefix_stack[j];
1303 kbd_buffer_store_event (&buf);
1304 }
1305
1306 if (!NILP (prefix))
1307 {
1308 buf.kind = MENU_BAR_EVENT;
1309 buf.frame_or_window = frame;
1310 buf.arg = prefix;
1311 kbd_buffer_store_event (&buf);
1312 }
1313
1314 buf.kind = MENU_BAR_EVENT;
1315 buf.frame_or_window = frame;
1316 buf.arg = entry;
1317 kbd_buffer_store_event (&buf);
1318
1319 return;
1320 }
1321 i += MENU_ITEMS_ITEM_LENGTH;
1322 }
1323 }
1324 }
1325
1326 /* Allocate a widget_value, blocking input. */
1327
1328 widget_value *
1329 xmalloc_widget_value ()
1330 {
1331 widget_value *value;
1332
1333 BLOCK_INPUT;
1334 value = malloc_widget_value ();
1335 UNBLOCK_INPUT;
1336
1337 return value;
1338 }
1339
1340 /* This recursively calls free_widget_value on the tree of widgets.
1341 It must free all data that was malloc'ed for these widget_values.
1342 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1343 must be left alone. */
1344
1345 void
1346 free_menubar_widget_value_tree (wv)
1347 widget_value *wv;
1348 {
1349 if (! wv) return;
1350
1351 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1352
1353 if (wv->contents && (wv->contents != (widget_value*)1))
1354 {
1355 free_menubar_widget_value_tree (wv->contents);
1356 wv->contents = (widget_value *) 0xDEADBEEF;
1357 }
1358 if (wv->next)
1359 {
1360 free_menubar_widget_value_tree (wv->next);
1361 wv->next = (widget_value *) 0xDEADBEEF;
1362 }
1363 BLOCK_INPUT;
1364 free_widget_value (wv);
1365 UNBLOCK_INPUT;
1366 }
1367 \f
1368 /* Set up data in menu_items for a menu bar item
1369 whose event type is ITEM_KEY (with string ITEM_NAME)
1370 and whose contents come from the list of keymaps MAPS. */
1371
1372 static int
1373 parse_single_submenu (item_key, item_name, maps)
1374 Lisp_Object item_key, item_name, maps;
1375 {
1376 Lisp_Object length;
1377 int len;
1378 Lisp_Object *mapvec;
1379 int i;
1380 int top_level_items = 0;
1381
1382 length = Flength (maps);
1383 len = XINT (length);
1384
1385 /* Convert the list MAPS into a vector MAPVEC. */
1386 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1387 for (i = 0; i < len; i++)
1388 {
1389 mapvec[i] = Fcar (maps);
1390 maps = Fcdr (maps);
1391 }
1392
1393 /* Loop over the given keymaps, making a pane for each map.
1394 But don't make a pane that is empty--ignore that map instead. */
1395 for (i = 0; i < len; i++)
1396 {
1397 if (!KEYMAPP (mapvec[i]))
1398 {
1399 /* Here we have a command at top level in the menu bar
1400 as opposed to a submenu. */
1401 top_level_items = 1;
1402 push_menu_pane (Qnil, Qnil);
1403 push_menu_item (item_name, Qt, item_key, mapvec[i],
1404 Qnil, Qnil, Qnil, Qnil);
1405 }
1406 else
1407 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1408 }
1409
1410 return top_level_items;
1411 }
1412
1413 /* Create a tree of widget_value objects
1414 representing the panes and items
1415 in menu_items starting at index START, up to index END. */
1416
1417 static widget_value *
1418 digest_single_submenu (start, end, top_level_items)
1419 int start, end, top_level_items;
1420 {
1421 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1422 int i;
1423 int submenu_depth = 0;
1424 widget_value **submenu_stack;
1425
1426 submenu_stack
1427 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1428 wv = xmalloc_widget_value ();
1429 wv->name = "menu";
1430 wv->value = 0;
1431 wv->enabled = 1;
1432 wv->button_type = BUTTON_TYPE_NONE;
1433 wv->help = Qnil;
1434 first_wv = wv;
1435 save_wv = 0;
1436 prev_wv = 0;
1437
1438 /* Loop over all panes and items made during this call
1439 and construct a tree of widget_value objects.
1440 Ignore the panes and items made by previous calls to
1441 single_submenu, even though those are also in menu_items. */
1442 i = start;
1443 while (i < end)
1444 {
1445 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1446 {
1447 submenu_stack[submenu_depth++] = save_wv;
1448 save_wv = prev_wv;
1449 prev_wv = 0;
1450 i++;
1451 }
1452 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1453 {
1454 prev_wv = save_wv;
1455 save_wv = submenu_stack[--submenu_depth];
1456 i++;
1457 }
1458 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1459 && submenu_depth != 0)
1460 i += MENU_ITEMS_PANE_LENGTH;
1461 /* Ignore a nil in the item list.
1462 It's meaningful only for dialog boxes. */
1463 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1464 i += 1;
1465 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1466 {
1467 /* Create a new pane. */
1468 Lisp_Object pane_name, prefix;
1469 char *pane_string;
1470
1471 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1472 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1473
1474 #ifndef HAVE_MULTILINGUAL_MENU
1475 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1476 {
1477 pane_name = ENCODE_SYSTEM (pane_name);
1478 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1479 }
1480 #endif
1481 pane_string = (NILP (pane_name)
1482 ? "" : (char *) SDATA (pane_name));
1483 /* If there is just one top-level pane, put all its items directly
1484 under the top-level menu. */
1485 if (menu_items_n_panes == 1)
1486 pane_string = "";
1487
1488 /* If the pane has a meaningful name,
1489 make the pane a top-level menu item
1490 with its items as a submenu beneath it. */
1491 if (strcmp (pane_string, ""))
1492 {
1493 wv = xmalloc_widget_value ();
1494 if (save_wv)
1495 save_wv->next = wv;
1496 else
1497 first_wv->contents = wv;
1498 wv->name = pane_string;
1499 /* Ignore the @ that means "separate pane".
1500 This is a kludge, but this isn't worth more time. */
1501 if (!NILP (prefix) && wv->name[0] == '@')
1502 wv->name++;
1503 wv->value = 0;
1504 wv->enabled = 1;
1505 wv->button_type = BUTTON_TYPE_NONE;
1506 wv->help = Qnil;
1507 }
1508 save_wv = wv;
1509 prev_wv = 0;
1510 i += MENU_ITEMS_PANE_LENGTH;
1511 }
1512 else
1513 {
1514 /* Create a new item within current pane. */
1515 Lisp_Object item_name, enable, descrip, def, type, selected;
1516 Lisp_Object help;
1517
1518 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1519 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1520 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1521 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1522 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1523 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1524 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1525
1526 #ifndef HAVE_MULTILINGUAL_MENU
1527 if (STRING_MULTIBYTE (item_name))
1528 {
1529 item_name = ENCODE_SYSTEM (item_name);
1530 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1531 }
1532
1533 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1534 {
1535 descrip = ENCODE_SYSTEM (descrip);
1536 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1537 }
1538 #endif /* not HAVE_MULTILINGUAL_MENU */
1539
1540 wv = xmalloc_widget_value ();
1541 if (prev_wv)
1542 prev_wv->next = wv;
1543 else
1544 save_wv->contents = wv;
1545
1546 wv->name = (char *) SDATA (item_name);
1547 if (!NILP (descrip))
1548 wv->key = (char *) SDATA (descrip);
1549 wv->value = 0;
1550 /* The EMACS_INT cast avoids a warning. There's no problem
1551 as long as pointers have enough bits to hold small integers. */
1552 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1553 wv->enabled = !NILP (enable);
1554
1555 if (NILP (type))
1556 wv->button_type = BUTTON_TYPE_NONE;
1557 else if (EQ (type, QCradio))
1558 wv->button_type = BUTTON_TYPE_RADIO;
1559 else if (EQ (type, QCtoggle))
1560 wv->button_type = BUTTON_TYPE_TOGGLE;
1561 else
1562 abort ();
1563
1564 wv->selected = !NILP (selected);
1565 if (! STRINGP (help))
1566 help = Qnil;
1567
1568 wv->help = help;
1569
1570 prev_wv = wv;
1571
1572 i += MENU_ITEMS_ITEM_LENGTH;
1573 }
1574 }
1575
1576 /* If we have just one "menu item"
1577 that was originally a button, return it by itself. */
1578 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1579 {
1580 wv = first_wv->contents;
1581 free_widget_value (first_wv);
1582 return wv;
1583 }
1584
1585 return first_wv;
1586 }
1587 \f
1588 /* Recompute all the widgets of frame F, when the menu bar has been
1589 changed. Value is non-zero if widgets were updated. */
1590
1591 static int
1592 update_frame_menubar (f)
1593 FRAME_PTR f;
1594 {
1595 struct x_output *x = f->output_data.x;
1596 int columns, rows;
1597
1598 if (!x->menubar_widget || XtIsManaged (x->menubar_widget))
1599 return 0;
1600
1601 BLOCK_INPUT;
1602 /* Save the size of the frame because the pane widget doesn't accept
1603 to resize itself. So force it. */
1604 columns = f->width;
1605 rows = f->height;
1606
1607 /* Do the voodoo which means "I'm changing lots of things, don't try
1608 to refigure sizes until I'm done." */
1609 lw_refigure_widget (x->column_widget, False);
1610
1611 /* The order in which children are managed is the top to bottom
1612 order in which they are displayed in the paned window. First,
1613 remove the text-area widget. */
1614 XtUnmanageChild (x->edit_widget);
1615
1616 /* Remove the menubar that is there now, and put up the menubar that
1617 should be there. */
1618 XtManageChild (x->menubar_widget);
1619 XtMapWidget (x->menubar_widget);
1620 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, NULL);
1621
1622 /* Re-manage the text-area widget, and then thrash the sizes. */
1623 XtManageChild (x->edit_widget);
1624 lw_refigure_widget (x->column_widget, True);
1625
1626 /* Force the pane widget to resize itself with the right values. */
1627 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1628 UNBLOCK_INPUT;
1629 return 1;
1630 }
1631
1632 /* Set the contents of the menubar widgets of frame F.
1633 The argument FIRST_TIME is currently ignored;
1634 it is set the first time this is called, from initialize_frame_menubar. */
1635
1636 void
1637 set_frame_menubar (f, first_time, deep_p)
1638 FRAME_PTR f;
1639 int first_time;
1640 int deep_p;
1641 {
1642 Widget menubar_widget = f->output_data.x->menubar_widget;
1643 Lisp_Object items;
1644 widget_value *wv, *first_wv, *prev_wv = 0;
1645 int i, last_i;
1646 int *submenu_start, *submenu_end;
1647 int *submenu_top_level_items;
1648
1649 LWLIB_ID id;
1650
1651 XSETFRAME (Vmenu_updating_frame, f);
1652
1653 if (f->output_data.x->id == 0)
1654 f->output_data.x->id = next_menubar_widget_id++;
1655 id = f->output_data.x->id;
1656
1657 if (! menubar_widget)
1658 deep_p = 1;
1659 else if (pending_menu_activation && !deep_p)
1660 deep_p = 1;
1661 /* Make the first call for any given frame always go deep. */
1662 else if (!f->output_data.x->saved_menu_event && !deep_p)
1663 {
1664 deep_p = 1;
1665 f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent));
1666 f->output_data.x->saved_menu_event->type = 0;
1667 }
1668
1669 if (deep_p)
1670 {
1671 /* Make a widget-value tree representing the entire menu trees. */
1672
1673 struct buffer *prev = current_buffer;
1674 Lisp_Object buffer;
1675 int specpdl_count = SPECPDL_INDEX ();
1676 int previous_menu_items_used = f->menu_bar_items_used;
1677 Lisp_Object *previous_items
1678 = (Lisp_Object *) alloca (previous_menu_items_used
1679 * sizeof (Lisp_Object));
1680
1681 /* If we are making a new widget, its contents are empty,
1682 do always reinitialize them. */
1683 if (! menubar_widget)
1684 previous_menu_items_used = 0;
1685
1686 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1687 specbind (Qinhibit_quit, Qt);
1688 /* Don't let the debugger step into this code
1689 because it is not reentrant. */
1690 specbind (Qdebug_on_next_call, Qnil);
1691
1692 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1693 record_unwind_protect (unuse_menu_items, Qnil);
1694 if (NILP (Voverriding_local_map_menu_flag))
1695 {
1696 specbind (Qoverriding_terminal_local_map, Qnil);
1697 specbind (Qoverriding_local_map, Qnil);
1698 }
1699
1700 set_buffer_internal_1 (XBUFFER (buffer));
1701
1702 /* Run the Lucid hook. */
1703 safe_run_hooks (Qactivate_menubar_hook);
1704
1705 /* If it has changed current-menubar from previous value,
1706 really recompute the menubar from the value. */
1707 if (! NILP (Vlucid_menu_bar_dirty_flag))
1708 call0 (Qrecompute_lucid_menubar);
1709 safe_run_hooks (Qmenu_bar_update_hook);
1710 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1711
1712 items = FRAME_MENU_BAR_ITEMS (f);
1713
1714 /* Save the frame's previous menu bar contents data. */
1715 if (previous_menu_items_used)
1716 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1717 previous_menu_items_used * sizeof (Lisp_Object));
1718
1719 /* Fill in menu_items with the current menu bar contents.
1720 This can evaluate Lisp code. */
1721 menu_items = f->menu_bar_vector;
1722 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1723 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1724 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1725 submenu_top_level_items
1726 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1727 init_menu_items ();
1728 for (i = 0; i < XVECTOR (items)->size; i += 4)
1729 {
1730 Lisp_Object key, string, maps;
1731
1732 last_i = i;
1733
1734 key = XVECTOR (items)->contents[i];
1735 string = XVECTOR (items)->contents[i + 1];
1736 maps = XVECTOR (items)->contents[i + 2];
1737 if (NILP (string))
1738 break;
1739
1740 submenu_start[i] = menu_items_used;
1741
1742 menu_items_n_panes = 0;
1743 submenu_top_level_items[i]
1744 = parse_single_submenu (key, string, maps);
1745
1746 submenu_end[i] = menu_items_used;
1747 }
1748
1749 finish_menu_items ();
1750
1751 /* Convert menu_items into widget_value trees
1752 to display the menu. This cannot evaluate Lisp code. */
1753
1754 wv = xmalloc_widget_value ();
1755 wv->name = "menubar";
1756 wv->value = 0;
1757 wv->enabled = 1;
1758 wv->button_type = BUTTON_TYPE_NONE;
1759 wv->help = Qnil;
1760 first_wv = wv;
1761
1762 for (i = 0; i < last_i; i += 4)
1763 {
1764 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1765 submenu_top_level_items[i]);
1766 if (prev_wv)
1767 prev_wv->next = wv;
1768 else
1769 first_wv->contents = wv;
1770 /* Don't set wv->name here; GC during the loop might relocate it. */
1771 wv->enabled = 1;
1772 wv->button_type = BUTTON_TYPE_NONE;
1773 prev_wv = wv;
1774 }
1775
1776 set_buffer_internal_1 (prev);
1777 unbind_to (specpdl_count, Qnil);
1778
1779 /* If there has been no change in the Lisp-level contents
1780 of the menu bar, skip redisplaying it. Just exit. */
1781
1782 for (i = 0; i < previous_menu_items_used; i++)
1783 if (menu_items_used == i
1784 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1785 break;
1786 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1787 {
1788 free_menubar_widget_value_tree (first_wv);
1789 discard_menu_items ();
1790
1791 return;
1792 }
1793
1794 /* Now GC cannot happen during the lifetime of the widget_value,
1795 so it's safe to store data from a Lisp_String. */
1796 wv = first_wv->contents;
1797 for (i = 0; i < XVECTOR (items)->size; i += 4)
1798 {
1799 Lisp_Object string;
1800 string = XVECTOR (items)->contents[i + 1];
1801 if (NILP (string))
1802 break;
1803 wv->name = (char *) SDATA (string);
1804 wv = wv->next;
1805 }
1806
1807 f->menu_bar_vector = menu_items;
1808 f->menu_bar_items_used = menu_items_used;
1809 discard_menu_items ();
1810 }
1811 else
1812 {
1813 /* Make a widget-value tree containing
1814 just the top level menu bar strings. */
1815
1816 wv = xmalloc_widget_value ();
1817 wv->name = "menubar";
1818 wv->value = 0;
1819 wv->enabled = 1;
1820 wv->button_type = BUTTON_TYPE_NONE;
1821 wv->help = Qnil;
1822 first_wv = wv;
1823
1824 items = FRAME_MENU_BAR_ITEMS (f);
1825 for (i = 0; i < XVECTOR (items)->size; i += 4)
1826 {
1827 Lisp_Object string;
1828
1829 string = XVECTOR (items)->contents[i + 1];
1830 if (NILP (string))
1831 break;
1832
1833 wv = xmalloc_widget_value ();
1834 wv->name = (char *) SDATA (string);
1835 wv->value = 0;
1836 wv->enabled = 1;
1837 wv->button_type = BUTTON_TYPE_NONE;
1838 wv->help = Qnil;
1839 /* This prevents lwlib from assuming this
1840 menu item is really supposed to be empty. */
1841 /* The EMACS_INT cast avoids a warning.
1842 This value just has to be different from small integers. */
1843 wv->call_data = (void *) (EMACS_INT) (-1);
1844
1845 if (prev_wv)
1846 prev_wv->next = wv;
1847 else
1848 first_wv->contents = wv;
1849 prev_wv = wv;
1850 }
1851
1852 /* Forget what we thought we knew about what is in the
1853 detailed contents of the menu bar menus.
1854 Changing the top level always destroys the contents. */
1855 f->menu_bar_items_used = 0;
1856 }
1857
1858 /* Create or update the menu bar widget. */
1859
1860 BLOCK_INPUT;
1861
1862 if (menubar_widget)
1863 {
1864 /* Disable resizing (done for Motif!) */
1865 lw_allow_resizing (f->output_data.x->widget, False);
1866
1867 /* The third arg is DEEP_P, which says to consider the entire
1868 menu trees we supply, rather than just the menu bar item names. */
1869 lw_modify_all_widgets (id, first_wv, deep_p);
1870
1871 /* Re-enable the edit widget to resize. */
1872 lw_allow_resizing (f->output_data.x->widget, True);
1873 }
1874 else
1875 {
1876 menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv,
1877 f->output_data.x->column_widget,
1878 0,
1879 popup_activate_callback,
1880 menubar_selection_callback,
1881 popup_deactivate_callback,
1882 menu_highlight_callback);
1883 f->output_data.x->menubar_widget = menubar_widget;
1884 }
1885
1886 {
1887 int menubar_size
1888 = (f->output_data.x->menubar_widget
1889 ? (f->output_data.x->menubar_widget->core.height
1890 + f->output_data.x->menubar_widget->core.border_width)
1891 : 0);
1892
1893 #if 0 /* Experimentally, we now get the right results
1894 for -geometry -0-0 without this. 24 Aug 96, rms. */
1895 #ifdef USE_LUCID
1896 if (FRAME_EXTERNAL_MENU_BAR (f))
1897 {
1898 Dimension ibw = 0;
1899 XtVaGetValues (f->output_data.x->column_widget,
1900 XtNinternalBorderWidth, &ibw, NULL);
1901 menubar_size += ibw;
1902 }
1903 #endif /* USE_LUCID */
1904 #endif /* 0 */
1905
1906 f->output_data.x->menubar_height = menubar_size;
1907 }
1908
1909 free_menubar_widget_value_tree (first_wv);
1910 update_frame_menubar (f);
1911
1912 UNBLOCK_INPUT;
1913 }
1914
1915 /* Called from Fx_create_frame to create the initial menubar of a frame
1916 before it is mapped, so that the window is mapped with the menubar already
1917 there instead of us tacking it on later and thrashing the window after it
1918 is visible. */
1919
1920 void
1921 initialize_frame_menubar (f)
1922 FRAME_PTR f;
1923 {
1924 /* This function is called before the first chance to redisplay
1925 the frame. It has to be, so the frame will have the right size. */
1926 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1927 set_frame_menubar (f, 1, 1);
1928 }
1929
1930
1931 /* Get rid of the menu bar of frame F, and free its storage.
1932 This is used when deleting a frame, and when turning off the menu bar. */
1933
1934 void
1935 free_frame_menubar (f)
1936 FRAME_PTR f;
1937 {
1938 Widget menubar_widget;
1939
1940 menubar_widget = f->output_data.x->menubar_widget;
1941
1942 f->output_data.x->menubar_height = 0;
1943
1944 if (menubar_widget)
1945 {
1946 #ifdef USE_MOTIF
1947 /* Removing the menu bar magically changes the shell widget's x
1948 and y position of (0, 0) which, when the menu bar is turned
1949 on again, leads to pull-down menuss appearing in strange
1950 positions near the upper-left corner of the display. This
1951 happens only with some window managers like twm and ctwm,
1952 but not with other like Motif's mwm or kwm, because the
1953 latter generate ConfigureNotify events when the menu bar
1954 is switched off, which fixes the shell position. */
1955 Position x0, y0, x1, y1;
1956 #endif
1957
1958 BLOCK_INPUT;
1959
1960 #ifdef USE_MOTIF
1961 if (f->output_data.x->widget)
1962 XtVaGetValues (f->output_data.x->widget, XtNx, &x0, XtNy, &y0, NULL);
1963 #endif
1964
1965 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
1966 f->output_data.x->menubar_widget = NULL;
1967
1968 #ifdef USE_MOTIF
1969 if (f->output_data.x->widget)
1970 {
1971 XtVaGetValues (f->output_data.x->widget, XtNx, &x1, XtNy, &y1, NULL);
1972 if (x1 == 0 && y1 == 0)
1973 XtVaSetValues (f->output_data.x->widget, XtNx, x0, XtNy, y0, NULL);
1974 }
1975 #endif
1976
1977 UNBLOCK_INPUT;
1978 }
1979 }
1980
1981 #endif /* USE_X_TOOLKIT */
1982 \f
1983 /* xmenu_show actually displays a menu using the panes and items in menu_items
1984 and returns the value selected from it.
1985 There are two versions of xmenu_show, one for Xt and one for Xlib.
1986 Both assume input is blocked by the caller. */
1987
1988 /* F is the frame the menu is for.
1989 X and Y are the frame-relative specified position,
1990 relative to the inside upper left corner of the frame F.
1991 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1992 KEYMAPS is 1 if this menu was specified with keymaps;
1993 in that case, we return a list containing the chosen item's value
1994 and perhaps also the pane's prefix.
1995 TITLE is the specified menu title.
1996 ERROR is a place to store an error message string in case of failure.
1997 (We return nil on failure, but the value doesn't actually matter.) */
1998
1999 #ifdef USE_X_TOOLKIT
2000
2001 /* We need a unique id for each widget handled by the Lucid Widget
2002 library.
2003
2004 For the main windows, and popup menus, we use this counter,
2005 which we increment each time after use. This starts from 1<<16.
2006
2007 For menu bars, we use numbers starting at 0, counted in
2008 next_menubar_widget_id. */
2009 LWLIB_ID widget_id_tick;
2010
2011 static Lisp_Object *volatile menu_item_selection;
2012
2013 static void
2014 popup_selection_callback (widget, id, client_data)
2015 Widget widget;
2016 LWLIB_ID id;
2017 XtPointer client_data;
2018 {
2019 menu_item_selection = (Lisp_Object *) client_data;
2020 }
2021
2022 static Lisp_Object
2023 xmenu_show (f, x, y, for_click, keymaps, title, error)
2024 FRAME_PTR f;
2025 int x;
2026 int y;
2027 int for_click;
2028 int keymaps;
2029 Lisp_Object title;
2030 char **error;
2031 {
2032 int i;
2033 LWLIB_ID menu_id;
2034 Widget menu;
2035 Arg av[2];
2036 int ac = 0;
2037 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2038 widget_value **submenu_stack
2039 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
2040 Lisp_Object *subprefix_stack
2041 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
2042 int submenu_depth = 0;
2043 XButtonPressedEvent dummy;
2044
2045 int first_pane;
2046
2047 *error = NULL;
2048
2049 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2050 {
2051 *error = "Empty menu";
2052 return Qnil;
2053 }
2054
2055 /* Create a tree of widget_value objects
2056 representing the panes and their items. */
2057 wv = xmalloc_widget_value ();
2058 wv->name = "menu";
2059 wv->value = 0;
2060 wv->enabled = 1;
2061 wv->button_type = BUTTON_TYPE_NONE;
2062 wv->help =Qnil;
2063 first_wv = wv;
2064 first_pane = 1;
2065
2066 /* Loop over all panes and items, filling in the tree. */
2067 i = 0;
2068 while (i < menu_items_used)
2069 {
2070 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2071 {
2072 submenu_stack[submenu_depth++] = save_wv;
2073 save_wv = prev_wv;
2074 prev_wv = 0;
2075 first_pane = 1;
2076 i++;
2077 }
2078 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2079 {
2080 prev_wv = save_wv;
2081 save_wv = submenu_stack[--submenu_depth];
2082 first_pane = 0;
2083 i++;
2084 }
2085 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
2086 && submenu_depth != 0)
2087 i += MENU_ITEMS_PANE_LENGTH;
2088 /* Ignore a nil in the item list.
2089 It's meaningful only for dialog boxes. */
2090 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2091 i += 1;
2092 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2093 {
2094 /* Create a new pane. */
2095 Lisp_Object pane_name, prefix;
2096 char *pane_string;
2097
2098 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2099 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2100
2101 #ifndef HAVE_MULTILINGUAL_MENU
2102 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
2103 {
2104 pane_name = ENCODE_SYSTEM (pane_name);
2105 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
2106 }
2107 #endif
2108 pane_string = (NILP (pane_name)
2109 ? "" : (char *) SDATA (pane_name));
2110 /* If there is just one top-level pane, put all its items directly
2111 under the top-level menu. */
2112 if (menu_items_n_panes == 1)
2113 pane_string = "";
2114
2115 /* If the pane has a meaningful name,
2116 make the pane a top-level menu item
2117 with its items as a submenu beneath it. */
2118 if (!keymaps && strcmp (pane_string, ""))
2119 {
2120 wv = xmalloc_widget_value ();
2121 if (save_wv)
2122 save_wv->next = wv;
2123 else
2124 first_wv->contents = wv;
2125 wv->name = pane_string;
2126 if (keymaps && !NILP (prefix))
2127 wv->name++;
2128 wv->value = 0;
2129 wv->enabled = 1;
2130 wv->button_type = BUTTON_TYPE_NONE;
2131 wv->help = Qnil;
2132 save_wv = wv;
2133 prev_wv = 0;
2134 }
2135 else if (first_pane)
2136 {
2137 save_wv = wv;
2138 prev_wv = 0;
2139 }
2140 first_pane = 0;
2141 i += MENU_ITEMS_PANE_LENGTH;
2142 }
2143 else
2144 {
2145 /* Create a new item within current pane. */
2146 Lisp_Object item_name, enable, descrip, def, type, selected, help;
2147 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2148 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2149 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2150 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
2151 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
2152 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
2153 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2154
2155 #ifndef HAVE_MULTILINGUAL_MENU
2156 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
2157 {
2158 item_name = ENCODE_SYSTEM (item_name);
2159 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
2160 }
2161
2162 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
2163 {
2164 descrip = ENCODE_SYSTEM (descrip);
2165 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
2166 }
2167 #endif /* not HAVE_MULTILINGUAL_MENU */
2168
2169 wv = xmalloc_widget_value ();
2170 if (prev_wv)
2171 prev_wv->next = wv;
2172 else
2173 save_wv->contents = wv;
2174 wv->name = (char *) SDATA (item_name);
2175 if (!NILP (descrip))
2176 wv->key = (char *) SDATA (descrip);
2177 wv->value = 0;
2178 /* If this item has a null value,
2179 make the call_data null so that it won't display a box
2180 when the mouse is on it. */
2181 wv->call_data
2182 = (!NILP (def) ? (void *) &XVECTOR (menu_items)->contents[i] : 0);
2183 wv->enabled = !NILP (enable);
2184
2185 if (NILP (type))
2186 wv->button_type = BUTTON_TYPE_NONE;
2187 else if (EQ (type, QCtoggle))
2188 wv->button_type = BUTTON_TYPE_TOGGLE;
2189 else if (EQ (type, QCradio))
2190 wv->button_type = BUTTON_TYPE_RADIO;
2191 else
2192 abort ();
2193
2194 wv->selected = !NILP (selected);
2195
2196 if (! STRINGP (help))
2197 help = Qnil;
2198
2199 wv->help = help;
2200
2201 prev_wv = wv;
2202
2203 i += MENU_ITEMS_ITEM_LENGTH;
2204 }
2205 }
2206
2207 /* Deal with the title, if it is non-nil. */
2208 if (!NILP (title))
2209 {
2210 widget_value *wv_title = xmalloc_widget_value ();
2211 widget_value *wv_sep1 = xmalloc_widget_value ();
2212 widget_value *wv_sep2 = xmalloc_widget_value ();
2213
2214 wv_sep2->name = "--";
2215 wv_sep2->next = first_wv->contents;
2216 wv_sep2->help = Qnil;
2217
2218 wv_sep1->name = "--";
2219 wv_sep1->next = wv_sep2;
2220 wv_sep1->help = Qnil;
2221
2222 #ifndef HAVE_MULTILINGUAL_MENU
2223 if (STRING_MULTIBYTE (title))
2224 title = ENCODE_SYSTEM (title);
2225 #endif
2226
2227 wv_title->name = (char *) SDATA (title);
2228 wv_title->enabled = TRUE;
2229 wv_title->button_type = BUTTON_TYPE_NONE;
2230 wv_title->next = wv_sep1;
2231 wv_title->help = Qnil;
2232 first_wv->contents = wv_title;
2233 }
2234
2235 /* Actually create the menu. */
2236 menu_id = widget_id_tick++;
2237 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
2238 f->output_data.x->widget, 1, 0,
2239 popup_selection_callback,
2240 popup_deactivate_callback,
2241 menu_highlight_callback);
2242
2243 /* Adjust coordinates to relative to the outer (window manager) window. */
2244 {
2245 Window child;
2246 int win_x = 0, win_y = 0;
2247
2248 /* Find the position of the outside upper-left corner of
2249 the inner window, with respect to the outer window. */
2250 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
2251 {
2252 BLOCK_INPUT;
2253 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2254
2255 /* From-window, to-window. */
2256 f->output_data.x->window_desc,
2257 f->output_data.x->parent_desc,
2258
2259 /* From-position, to-position. */
2260 0, 0, &win_x, &win_y,
2261
2262 /* Child of window. */
2263 &child);
2264 UNBLOCK_INPUT;
2265 x += win_x;
2266 y += win_y;
2267 }
2268 }
2269
2270 /* Adjust coordinates to be root-window-relative. */
2271 x += f->output_data.x->left_pos;
2272 y += f->output_data.x->top_pos;
2273
2274 dummy.type = ButtonPress;
2275 dummy.serial = 0;
2276 dummy.send_event = 0;
2277 dummy.display = FRAME_X_DISPLAY (f);
2278 dummy.time = CurrentTime;
2279 dummy.root = FRAME_X_DISPLAY_INFO (f)->root_window;
2280 dummy.window = dummy.root;
2281 dummy.subwindow = dummy.root;
2282 dummy.x_root = x;
2283 dummy.y_root = y;
2284 dummy.x = x;
2285 dummy.y = y;
2286 dummy.state = (FRAME_X_DISPLAY_INFO (f)->grabbed >> 1) * Button1Mask;
2287 dummy.button = 0;
2288 for (i = 0; i < 5; i++)
2289 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2290 dummy.button = i;
2291
2292 /* Don't allow any geometry request from the user. */
2293 XtSetArg (av[ac], XtNgeometry, 0); ac++;
2294 XtSetValues (menu, av, ac);
2295
2296 /* Free the widget_value objects we used to specify the contents. */
2297 free_menubar_widget_value_tree (first_wv);
2298
2299 /* No selection has been chosen yet. */
2300 menu_item_selection = 0;
2301
2302 /* Display the menu. */
2303 lw_popup_menu (menu, (XEvent *) &dummy);
2304 popup_activated_flag = 1;
2305
2306 /* Process events that apply to the menu. */
2307 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id);
2308
2309 /* fp turned off the following statement and wrote a comment
2310 that it is unnecessary--that the menu has already disappeared.
2311 Nowadays the menu disappears ok, all right, but
2312 we need to delete the widgets or multiple ones will pile up. */
2313 lw_destroy_all_widgets (menu_id);
2314
2315 /* Find the selected item, and its pane, to return
2316 the proper value. */
2317 if (menu_item_selection != 0)
2318 {
2319 Lisp_Object prefix, entry;
2320
2321 prefix = entry = Qnil;
2322 i = 0;
2323 while (i < menu_items_used)
2324 {
2325 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2326 {
2327 subprefix_stack[submenu_depth++] = prefix;
2328 prefix = entry;
2329 i++;
2330 }
2331 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2332 {
2333 prefix = subprefix_stack[--submenu_depth];
2334 i++;
2335 }
2336 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2337 {
2338 prefix
2339 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2340 i += MENU_ITEMS_PANE_LENGTH;
2341 }
2342 /* Ignore a nil in the item list.
2343 It's meaningful only for dialog boxes. */
2344 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2345 i += 1;
2346 else
2347 {
2348 entry
2349 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2350 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2351 {
2352 if (keymaps != 0)
2353 {
2354 int j;
2355
2356 entry = Fcons (entry, Qnil);
2357 if (!NILP (prefix))
2358 entry = Fcons (prefix, entry);
2359 for (j = submenu_depth - 1; j >= 0; j--)
2360 if (!NILP (subprefix_stack[j]))
2361 entry = Fcons (subprefix_stack[j], entry);
2362 }
2363 return entry;
2364 }
2365 i += MENU_ITEMS_ITEM_LENGTH;
2366 }
2367 }
2368 }
2369
2370 return Qnil;
2371 }
2372 \f
2373 static void
2374 dialog_selection_callback (widget, id, client_data)
2375 Widget widget;
2376 LWLIB_ID id;
2377 XtPointer client_data;
2378 {
2379 /* The EMACS_INT cast avoids a warning. There's no problem
2380 as long as pointers have enough bits to hold small integers. */
2381 if ((int) (EMACS_INT) client_data != -1)
2382 menu_item_selection = (Lisp_Object *) client_data;
2383 BLOCK_INPUT;
2384 lw_destroy_all_widgets (id);
2385 UNBLOCK_INPUT;
2386 popup_activated_flag = 0;
2387 }
2388
2389 static char * button_names [] = {
2390 "button1", "button2", "button3", "button4", "button5",
2391 "button6", "button7", "button8", "button9", "button10" };
2392
2393 static Lisp_Object
2394 xdialog_show (f, keymaps, title, error)
2395 FRAME_PTR f;
2396 int keymaps;
2397 Lisp_Object title;
2398 char **error;
2399 {
2400 int i, nb_buttons=0;
2401 LWLIB_ID dialog_id;
2402 Widget menu;
2403 char dialog_name[6];
2404
2405 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2406
2407 /* Number of elements seen so far, before boundary. */
2408 int left_count = 0;
2409 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2410 int boundary_seen = 0;
2411
2412 *error = NULL;
2413
2414 if (menu_items_n_panes > 1)
2415 {
2416 *error = "Multiple panes in dialog box";
2417 return Qnil;
2418 }
2419
2420 /* Create a tree of widget_value objects
2421 representing the text label and buttons. */
2422 {
2423 Lisp_Object pane_name, prefix;
2424 char *pane_string;
2425 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2426 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2427 pane_string = (NILP (pane_name)
2428 ? "" : (char *) SDATA (pane_name));
2429 prev_wv = xmalloc_widget_value ();
2430 prev_wv->value = pane_string;
2431 if (keymaps && !NILP (prefix))
2432 prev_wv->name++;
2433 prev_wv->enabled = 1;
2434 prev_wv->name = "message";
2435 prev_wv->help = Qnil;
2436 first_wv = prev_wv;
2437
2438 /* Loop over all panes and items, filling in the tree. */
2439 i = MENU_ITEMS_PANE_LENGTH;
2440 while (i < menu_items_used)
2441 {
2442
2443 /* Create a new item within current pane. */
2444 Lisp_Object item_name, enable, descrip;
2445 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2446 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2447 descrip
2448 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2449
2450 if (NILP (item_name))
2451 {
2452 free_menubar_widget_value_tree (first_wv);
2453 *error = "Submenu in dialog items";
2454 return Qnil;
2455 }
2456 if (EQ (item_name, Qquote))
2457 {
2458 /* This is the boundary between left-side elts
2459 and right-side elts. Stop incrementing right_count. */
2460 boundary_seen = 1;
2461 i++;
2462 continue;
2463 }
2464 if (nb_buttons >= 9)
2465 {
2466 free_menubar_widget_value_tree (first_wv);
2467 *error = "Too many dialog items";
2468 return Qnil;
2469 }
2470
2471 wv = xmalloc_widget_value ();
2472 prev_wv->next = wv;
2473 wv->name = (char *) button_names[nb_buttons];
2474 if (!NILP (descrip))
2475 wv->key = (char *) SDATA (descrip);
2476 wv->value = (char *) SDATA (item_name);
2477 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
2478 wv->enabled = !NILP (enable);
2479 wv->help = Qnil;
2480 prev_wv = wv;
2481
2482 if (! boundary_seen)
2483 left_count++;
2484
2485 nb_buttons++;
2486 i += MENU_ITEMS_ITEM_LENGTH;
2487 }
2488
2489 /* If the boundary was not specified,
2490 by default put half on the left and half on the right. */
2491 if (! boundary_seen)
2492 left_count = nb_buttons - nb_buttons / 2;
2493
2494 wv = xmalloc_widget_value ();
2495 wv->name = dialog_name;
2496 wv->help = Qnil;
2497 /* Dialog boxes use a really stupid name encoding
2498 which specifies how many buttons to use
2499 and how many buttons are on the right.
2500 The Q means something also. */
2501 dialog_name[0] = 'Q';
2502 dialog_name[1] = '0' + nb_buttons;
2503 dialog_name[2] = 'B';
2504 dialog_name[3] = 'R';
2505 /* Number of buttons to put on the right. */
2506 dialog_name[4] = '0' + nb_buttons - left_count;
2507 dialog_name[5] = 0;
2508 wv->contents = first_wv;
2509 first_wv = wv;
2510 }
2511
2512 /* Actually create the dialog. */
2513 dialog_id = widget_id_tick++;
2514 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2515 f->output_data.x->widget, 1, 0,
2516 dialog_selection_callback, 0, 0);
2517 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
2518 /* Free the widget_value objects we used to specify the contents. */
2519 free_menubar_widget_value_tree (first_wv);
2520
2521 /* No selection has been chosen yet. */
2522 menu_item_selection = 0;
2523
2524 /* Display the menu. */
2525 lw_pop_up_all_widgets (dialog_id);
2526 popup_activated_flag = 1;
2527
2528 /* Process events that apply to the menu. */
2529 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2530
2531 lw_destroy_all_widgets (dialog_id);
2532
2533 /* Find the selected item, and its pane, to return
2534 the proper value. */
2535 if (menu_item_selection != 0)
2536 {
2537 Lisp_Object prefix;
2538
2539 prefix = Qnil;
2540 i = 0;
2541 while (i < menu_items_used)
2542 {
2543 Lisp_Object entry;
2544
2545 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2546 {
2547 prefix
2548 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2549 i += MENU_ITEMS_PANE_LENGTH;
2550 }
2551 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2552 {
2553 /* This is the boundary between left-side elts and
2554 right-side elts. */
2555 ++i;
2556 }
2557 else
2558 {
2559 entry
2560 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2561 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2562 {
2563 if (keymaps != 0)
2564 {
2565 entry = Fcons (entry, Qnil);
2566 if (!NILP (prefix))
2567 entry = Fcons (prefix, entry);
2568 }
2569 return entry;
2570 }
2571 i += MENU_ITEMS_ITEM_LENGTH;
2572 }
2573 }
2574 }
2575
2576 return Qnil;
2577 }
2578
2579 #else /* not USE_X_TOOLKIT */
2580
2581 /* The frame of the last activated non-toolkit menu bar.
2582 Used to generate menu help events. */
2583
2584 static struct frame *menu_help_frame;
2585
2586
2587 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
2588
2589 PANE is the pane number, and ITEM is the menu item number in
2590 the menu (currently not used).
2591
2592 This cannot be done with generating a HELP_EVENT because
2593 XMenuActivate contains a loop that doesn't let Emacs process
2594 keyboard events. */
2595
2596 static void
2597 menu_help_callback (help_string, pane, item)
2598 char *help_string;
2599 int pane, item;
2600 {
2601 extern Lisp_Object Qmenu_item;
2602 Lisp_Object *first_item;
2603 Lisp_Object pane_name;
2604 Lisp_Object menu_object;
2605
2606 first_item = XVECTOR (menu_items)->contents;
2607 if (EQ (first_item[0], Qt))
2608 pane_name = first_item[MENU_ITEMS_PANE_NAME];
2609 else if (EQ (first_item[0], Qquote))
2610 /* This shouldn't happen, see xmenu_show. */
2611 pane_name = empty_string;
2612 else
2613 pane_name = first_item[MENU_ITEMS_ITEM_NAME];
2614
2615 /* (menu-item MENU-NAME PANE-NUMBER) */
2616 menu_object = Fcons (Qmenu_item,
2617 Fcons (pane_name,
2618 Fcons (make_number (pane), Qnil)));
2619 show_help_echo (help_string ? build_string (help_string) : Qnil,
2620 Qnil, menu_object, make_number (item), 1);
2621 }
2622
2623
2624 static Lisp_Object
2625 xmenu_show (f, x, y, for_click, keymaps, title, error)
2626 FRAME_PTR f;
2627 int x, y;
2628 int for_click;
2629 int keymaps;
2630 Lisp_Object title;
2631 char **error;
2632 {
2633 Window root;
2634 XMenu *menu;
2635 int pane, selidx, lpane, status;
2636 Lisp_Object entry, pane_prefix;
2637 char *datap;
2638 int ulx, uly, width, height;
2639 int dispwidth, dispheight;
2640 int i, j;
2641 int maxwidth;
2642 int dummy_int;
2643 unsigned int dummy_uint;
2644
2645 *error = 0;
2646 if (menu_items_n_panes == 0)
2647 return Qnil;
2648
2649 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2650 {
2651 *error = "Empty menu";
2652 return Qnil;
2653 }
2654
2655 /* Figure out which root window F is on. */
2656 XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root,
2657 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
2658 &dummy_uint, &dummy_uint);
2659
2660 /* Make the menu on that window. */
2661 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
2662 if (menu == NULL)
2663 {
2664 *error = "Can't create menu";
2665 return Qnil;
2666 }
2667
2668 #ifdef HAVE_X_WINDOWS
2669 /* Adjust coordinates to relative to the outer (window manager) window. */
2670 {
2671 Window child;
2672 int win_x = 0, win_y = 0;
2673
2674 /* Find the position of the outside upper-left corner of
2675 the inner window, with respect to the outer window. */
2676 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
2677 {
2678 BLOCK_INPUT;
2679 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2680
2681 /* From-window, to-window. */
2682 f->output_data.x->window_desc,
2683 f->output_data.x->parent_desc,
2684
2685 /* From-position, to-position. */
2686 0, 0, &win_x, &win_y,
2687
2688 /* Child of window. */
2689 &child);
2690 UNBLOCK_INPUT;
2691 x += win_x;
2692 y += win_y;
2693 }
2694 }
2695 #endif /* HAVE_X_WINDOWS */
2696
2697 /* Adjust coordinates to be root-window-relative. */
2698 x += f->output_data.x->left_pos;
2699 y += f->output_data.x->top_pos;
2700
2701 /* Create all the necessary panes and their items. */
2702 i = 0;
2703 while (i < menu_items_used)
2704 {
2705 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2706 {
2707 /* Create a new pane. */
2708 Lisp_Object pane_name, prefix;
2709 char *pane_string;
2710
2711 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
2712 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2713 pane_string = (NILP (pane_name)
2714 ? "" : (char *) SDATA (pane_name));
2715 if (keymaps && !NILP (prefix))
2716 pane_string++;
2717
2718 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
2719 if (lpane == XM_FAILURE)
2720 {
2721 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2722 *error = "Can't create pane";
2723 return Qnil;
2724 }
2725 i += MENU_ITEMS_PANE_LENGTH;
2726
2727 /* Find the width of the widest item in this pane. */
2728 maxwidth = 0;
2729 j = i;
2730 while (j < menu_items_used)
2731 {
2732 Lisp_Object item;
2733 item = XVECTOR (menu_items)->contents[j];
2734 if (EQ (item, Qt))
2735 break;
2736 if (NILP (item))
2737 {
2738 j++;
2739 continue;
2740 }
2741 width = SBYTES (item);
2742 if (width > maxwidth)
2743 maxwidth = width;
2744
2745 j += MENU_ITEMS_ITEM_LENGTH;
2746 }
2747 }
2748 /* Ignore a nil in the item list.
2749 It's meaningful only for dialog boxes. */
2750 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2751 i += 1;
2752 else
2753 {
2754 /* Create a new item within current pane. */
2755 Lisp_Object item_name, enable, descrip, help;
2756 unsigned char *item_data;
2757 char *help_string;
2758
2759 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2760 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2761 descrip
2762 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2763 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
2764 help_string = STRINGP (help) ? SDATA (help) : NULL;
2765
2766 if (!NILP (descrip))
2767 {
2768 int gap = maxwidth - SBYTES (item_name);
2769 #ifdef C_ALLOCA
2770 Lisp_Object spacer;
2771 spacer = Fmake_string (make_number (gap), make_number (' '));
2772 item_name = concat2 (item_name, spacer);
2773 item_name = concat2 (item_name, descrip);
2774 item_data = SDATA (item_name);
2775 #else
2776 /* if alloca is fast, use that to make the space,
2777 to reduce gc needs. */
2778 item_data
2779 = (unsigned char *) alloca (maxwidth
2780 + SBYTES (descrip) + 1);
2781 bcopy (SDATA (item_name), item_data,
2782 SBYTES (item_name));
2783 for (j = SCHARS (item_name); j < maxwidth; j++)
2784 item_data[j] = ' ';
2785 bcopy (SDATA (descrip), item_data + j,
2786 SBYTES (descrip));
2787 item_data[j + SBYTES (descrip)] = 0;
2788 #endif
2789 }
2790 else
2791 item_data = SDATA (item_name);
2792
2793 if (XMenuAddSelection (FRAME_X_DISPLAY (f),
2794 menu, lpane, 0, item_data,
2795 !NILP (enable), help_string)
2796 == XM_FAILURE)
2797 {
2798 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2799 *error = "Can't add selection to menu";
2800 return Qnil;
2801 }
2802 i += MENU_ITEMS_ITEM_LENGTH;
2803 }
2804 }
2805
2806 /* All set and ready to fly. */
2807 XMenuRecompute (FRAME_X_DISPLAY (f), menu);
2808 dispwidth = DisplayWidth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
2809 dispheight = DisplayHeight (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
2810 x = min (x, dispwidth);
2811 y = min (y, dispheight);
2812 x = max (x, 1);
2813 y = max (y, 1);
2814 XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y,
2815 &ulx, &uly, &width, &height);
2816 if (ulx+width > dispwidth)
2817 {
2818 x -= (ulx + width) - dispwidth;
2819 ulx = dispwidth - width;
2820 }
2821 if (uly+height > dispheight)
2822 {
2823 y -= (uly + height) - dispheight;
2824 uly = dispheight - height;
2825 }
2826 if (ulx < 0) x -= ulx;
2827 if (uly < 0) y -= uly;
2828
2829 XMenuSetAEQ (menu, TRUE);
2830 XMenuSetFreeze (menu, TRUE);
2831 pane = selidx = 0;
2832
2833 /* Help display under X won't work because XMenuActivate contains
2834 a loop that doesn't give Emacs a chance to process it. */
2835 menu_help_frame = f;
2836 status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
2837 x, y, ButtonReleaseMask, &datap,
2838 menu_help_callback);
2839
2840
2841 #ifdef HAVE_X_WINDOWS
2842 /* Assume the mouse has moved out of the X window.
2843 If it has actually moved in, we will get an EnterNotify. */
2844 x_mouse_leave (FRAME_X_DISPLAY_INFO (f));
2845 #endif
2846
2847 switch (status)
2848 {
2849 case XM_SUCCESS:
2850 #ifdef XDEBUG
2851 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
2852 #endif
2853
2854 /* Find the item number SELIDX in pane number PANE. */
2855 i = 0;
2856 while (i < menu_items_used)
2857 {
2858 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2859 {
2860 if (pane == 0)
2861 pane_prefix
2862 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2863 pane--;
2864 i += MENU_ITEMS_PANE_LENGTH;
2865 }
2866 else
2867 {
2868 if (pane == -1)
2869 {
2870 if (selidx == 0)
2871 {
2872 entry
2873 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2874 if (keymaps != 0)
2875 {
2876 entry = Fcons (entry, Qnil);
2877 if (!NILP (pane_prefix))
2878 entry = Fcons (pane_prefix, entry);
2879 }
2880 break;
2881 }
2882 selidx--;
2883 }
2884 i += MENU_ITEMS_ITEM_LENGTH;
2885 }
2886 }
2887 break;
2888
2889 case XM_FAILURE:
2890 *error = "Can't activate menu";
2891 case XM_IA_SELECT:
2892 case XM_NO_SELECT:
2893 entry = Qnil;
2894 break;
2895 }
2896 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2897
2898 #ifdef HAVE_X_WINDOWS
2899 /* State that no mouse buttons are now held.
2900 (The oldXMenu code doesn't track this info for us.)
2901 That is not necessarily true, but the fiction leads to reasonable
2902 results, and it is a pain to ask which are actually held now. */
2903 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
2904 #endif
2905
2906 return entry;
2907 }
2908
2909 #endif /* not USE_X_TOOLKIT */
2910
2911 #endif /* HAVE_MENUS */
2912 \f
2913 void
2914 syms_of_xmenu ()
2915 {
2916 staticpro (&menu_items);
2917 menu_items = Qnil;
2918 menu_items_inuse = Qnil;
2919
2920 Qdebug_on_next_call = intern ("debug-on-next-call");
2921 staticpro (&Qdebug_on_next_call);
2922
2923 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2924 doc: /* Frame for which we are updating a menu.
2925 The enable predicate for a menu command should check this variable. */);
2926 Vmenu_updating_frame = Qnil;
2927
2928 #ifdef USE_X_TOOLKIT
2929 widget_id_tick = (1<<16);
2930 next_menubar_widget_id = 1;
2931 #endif
2932
2933 defsubr (&Sx_popup_menu);
2934 #ifdef HAVE_MENUS
2935 defsubr (&Sx_popup_dialog);
2936 #endif
2937 }