]> code.delx.au - gnu-emacs/blob - src/xmenu.c
Don't include signal.h.
[gnu-emacs] / src / xmenu.c
1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1999, 2000, 2001, 2003, 2004,
3 2005 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 #if 0 /* Why was this included? And without syssignal.h? */
37 /* On 4.3 this loses if it comes after xterm.h. */
38 #include <signal.h>
39 #endif
40
41 #include <stdio.h>
42
43 #include "lisp.h"
44 #include "termhooks.h"
45 #include "keyboard.h"
46 #include "keymap.h"
47 #include "frame.h"
48 #include "window.h"
49 #include "blockinput.h"
50 #include "buffer.h"
51 #include "charset.h"
52 #include "coding.h"
53 #include "sysselect.h"
54
55 #ifdef MSDOS
56 #include "msdos.h"
57 #endif
58
59 #ifdef HAVE_X_WINDOWS
60 /* This may include sys/types.h, and that somehow loses
61 if this is not done before the other system files. */
62 #include "xterm.h"
63 #endif
64
65 /* Load sys/types.h if not already loaded.
66 In some systems loading it twice is suicidal. */
67 #ifndef makedev
68 #include <sys/types.h>
69 #endif
70
71 #include "dispextern.h"
72
73 #ifdef HAVE_X_WINDOWS
74 /* Defining HAVE_MULTILINGUAL_MENU would mean that the toolkit menu
75 code accepts the Emacs internal encoding. */
76 #undef HAVE_MULTILINGUAL_MENU
77 #ifdef USE_X_TOOLKIT
78 #include "widget.h"
79 #include <X11/Xlib.h>
80 #include <X11/IntrinsicP.h>
81 #include <X11/CoreP.h>
82 #include <X11/StringDefs.h>
83 #include <X11/Shell.h>
84 #ifdef USE_LUCID
85 #include <X11/Xaw/Paned.h>
86 #endif /* USE_LUCID */
87 #include "../lwlib/lwlib.h"
88 #else /* not USE_X_TOOLKIT */
89 #ifndef USE_GTK
90 #include "../oldXMenu/XMenu.h"
91 #endif
92 #endif /* not USE_X_TOOLKIT */
93 #endif /* HAVE_X_WINDOWS */
94
95 #ifndef TRUE
96 #define TRUE 1
97 #define FALSE 0
98 #endif /* no TRUE */
99
100 Lisp_Object Vmenu_updating_frame;
101
102 Lisp_Object Qdebug_on_next_call;
103
104 extern Lisp_Object Qmenu_bar;
105
106 extern Lisp_Object QCtoggle, QCradio;
107
108 extern Lisp_Object Voverriding_local_map;
109 extern Lisp_Object Voverriding_local_map_menu_flag;
110
111 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
112
113 extern Lisp_Object Qmenu_bar_update_hook;
114
115 #ifdef USE_X_TOOLKIT
116 extern void set_frame_menubar P_ ((FRAME_PTR, int, int));
117 extern XtAppContext Xt_app_con;
118
119 static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **));
120 static void popup_get_selection P_ ((XEvent *, struct x_display_info *,
121 LWLIB_ID, int));
122
123 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
124
125 #define HAVE_BOXES 1
126 #endif /* USE_X_TOOLKIT */
127
128 #ifdef USE_GTK
129 #include "gtkutil.h"
130 #define HAVE_BOXES 1
131 extern void set_frame_menubar P_ ((FRAME_PTR, int, int));
132 static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **));
133 #endif
134
135 /* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU
136 isn't defined. The use of HAVE_MULTILINGUAL_MENU could probably be
137 confined to an extended version of this with sections of code below
138 using it unconditionally. */
139 #ifdef USE_GTK
140 /* gtk just uses utf-8. */
141 # define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
142 #elif defined HAVE_X_I18N
143 # define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
144 #else
145 # define ENCODE_MENU_STRING(str) string_make_unibyte (str)
146 #endif
147
148 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
149 Lisp_Object, Lisp_Object, Lisp_Object,
150 Lisp_Object, Lisp_Object));
151 static int update_frame_menubar P_ ((struct frame *));
152 static Lisp_Object xmenu_show P_ ((struct frame *, int, int, int, int,
153 Lisp_Object, char **));
154 static void keymap_panes P_ ((Lisp_Object *, int, int));
155 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
156 int, int));
157 static void list_of_panes P_ ((Lisp_Object));
158 static void list_of_items P_ ((Lisp_Object));
159
160 \f
161 /* This holds a Lisp vector that holds the results of decoding
162 the keymaps or alist-of-alists that specify a menu.
163
164 It describes the panes and items within the panes.
165
166 Each pane is described by 3 elements in the vector:
167 t, the pane name, the pane's prefix key.
168 Then follow the pane's items, with 5 elements per item:
169 the item string, the enable flag, the item's value,
170 the definition, and the equivalent keyboard key's description string.
171
172 In some cases, multiple levels of menus may be described.
173 A single vector slot containing nil indicates the start of a submenu.
174 A single vector slot containing lambda indicates the end of a submenu.
175 The submenu follows a menu item which is the way to reach the submenu.
176
177 A single vector slot containing quote indicates that the
178 following items should appear on the right of a dialog box.
179
180 Using a Lisp vector to hold this information while we decode it
181 takes care of protecting all the data from GC. */
182
183 #define MENU_ITEMS_PANE_NAME 1
184 #define MENU_ITEMS_PANE_PREFIX 2
185 #define MENU_ITEMS_PANE_LENGTH 3
186
187 enum menu_item_idx
188 {
189 MENU_ITEMS_ITEM_NAME = 0,
190 MENU_ITEMS_ITEM_ENABLE,
191 MENU_ITEMS_ITEM_VALUE,
192 MENU_ITEMS_ITEM_EQUIV_KEY,
193 MENU_ITEMS_ITEM_DEFINITION,
194 MENU_ITEMS_ITEM_TYPE,
195 MENU_ITEMS_ITEM_SELECTED,
196 MENU_ITEMS_ITEM_HELP,
197 MENU_ITEMS_ITEM_LENGTH
198 };
199
200 static Lisp_Object menu_items;
201
202 /* If non-nil, means that the global vars defined here are already in use.
203 Used to detect cases where we try to re-enter this non-reentrant code. */
204 static Lisp_Object menu_items_inuse;
205
206 /* Number of slots currently allocated in menu_items. */
207 static int menu_items_allocated;
208
209 /* This is the index in menu_items of the first empty slot. */
210 static int menu_items_used;
211
212 /* The number of panes currently recorded in menu_items,
213 excluding those within submenus. */
214 static int menu_items_n_panes;
215
216 /* Current depth within submenus. */
217 static int menu_items_submenu_depth;
218
219 /* Flag which when set indicates a dialog or menu has been posted by
220 Xt on behalf of one of the widget sets. */
221 static int popup_activated_flag;
222
223 static int next_menubar_widget_id;
224
225 /* This is set nonzero after the user activates the menu bar, and set
226 to zero again after the menu bars are redisplayed by prepare_menu_bar.
227 While it is nonzero, all calls to set_frame_menubar go deep.
228
229 I don't understand why this is needed, but it does seem to be
230 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
231
232 int pending_menu_activation;
233 \f
234 #ifdef USE_X_TOOLKIT
235
236 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
237
238 static struct frame *
239 menubar_id_to_frame (id)
240 LWLIB_ID id;
241 {
242 Lisp_Object tail, frame;
243 FRAME_PTR f;
244
245 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
246 {
247 frame = XCAR (tail);
248 if (!GC_FRAMEP (frame))
249 continue;
250 f = XFRAME (frame);
251 if (!FRAME_WINDOW_P (f))
252 continue;
253 if (f->output_data.x->id == id)
254 return f;
255 }
256 return 0;
257 }
258
259 #endif
260 \f
261 /* Initialize the menu_items structure if we haven't already done so.
262 Also mark it as currently empty. */
263
264 static void
265 init_menu_items ()
266 {
267 if (NILP (menu_items))
268 {
269 menu_items_allocated = 60;
270 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
271 }
272
273 if (!NILP (menu_items_inuse))
274 error ("Trying to use a menu from within a menu-entry");
275 menu_items_inuse = Qt;
276 menu_items_used = 0;
277 menu_items_n_panes = 0;
278 menu_items_submenu_depth = 0;
279 }
280
281 /* Call at the end of generating the data in menu_items. */
282
283 static void
284 finish_menu_items ()
285 {
286 }
287
288 static Lisp_Object
289 unuse_menu_items (dummy)
290 Lisp_Object dummy;
291 {
292 return menu_items_inuse = Qnil;
293 }
294
295 /* Call when finished using the data for the current menu
296 in menu_items. */
297
298 static void
299 discard_menu_items ()
300 {
301 /* Free the structure if it is especially large.
302 Otherwise, hold on to it, to save time. */
303 if (menu_items_allocated > 200)
304 {
305 menu_items = Qnil;
306 menu_items_allocated = 0;
307 }
308 xassert (NILP (menu_items_inuse));
309 }
310
311 /* Make the menu_items vector twice as large. */
312
313 static void
314 grow_menu_items ()
315 {
316 Lisp_Object old;
317 int old_size = menu_items_allocated;
318 old = menu_items;
319
320 menu_items_allocated *= 2;
321 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
322 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
323 old_size * sizeof (Lisp_Object));
324 }
325
326 /* Begin a submenu. */
327
328 static void
329 push_submenu_start ()
330 {
331 if (menu_items_used + 1 > menu_items_allocated)
332 grow_menu_items ();
333
334 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
335 menu_items_submenu_depth++;
336 }
337
338 /* End a submenu. */
339
340 static void
341 push_submenu_end ()
342 {
343 if (menu_items_used + 1 > menu_items_allocated)
344 grow_menu_items ();
345
346 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
347 menu_items_submenu_depth--;
348 }
349
350 /* Indicate boundary between left and right. */
351
352 static void
353 push_left_right_boundary ()
354 {
355 if (menu_items_used + 1 > menu_items_allocated)
356 grow_menu_items ();
357
358 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
359 }
360
361 /* Start a new menu pane in menu_items.
362 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
363
364 static void
365 push_menu_pane (name, prefix_vec)
366 Lisp_Object name, prefix_vec;
367 {
368 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
369 grow_menu_items ();
370
371 if (menu_items_submenu_depth == 0)
372 menu_items_n_panes++;
373 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
374 XVECTOR (menu_items)->contents[menu_items_used++] = name;
375 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
376 }
377
378 /* Push one menu item into the current pane. NAME is the string to
379 display. ENABLE if non-nil means this item can be selected. KEY
380 is the key generated by choosing this item, or nil if this item
381 doesn't really have a definition. DEF is the definition of this
382 item. EQUIV is the textual description of the keyboard equivalent
383 for this item (or nil if none). TYPE is the type of this menu
384 item, one of nil, `toggle' or `radio'. */
385
386 static void
387 push_menu_item (name, enable, key, def, equiv, type, selected, help)
388 Lisp_Object name, enable, key, def, equiv, type, selected, help;
389 {
390 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
391 grow_menu_items ();
392
393 XVECTOR (menu_items)->contents[menu_items_used++] = name;
394 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
395 XVECTOR (menu_items)->contents[menu_items_used++] = key;
396 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
397 XVECTOR (menu_items)->contents[menu_items_used++] = def;
398 XVECTOR (menu_items)->contents[menu_items_used++] = type;
399 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
400 XVECTOR (menu_items)->contents[menu_items_used++] = help;
401 }
402 \f
403 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
404 and generate menu panes for them in menu_items.
405 If NOTREAL is nonzero,
406 don't bother really computing whether an item is enabled. */
407
408 static void
409 keymap_panes (keymaps, nmaps, notreal)
410 Lisp_Object *keymaps;
411 int nmaps;
412 int notreal;
413 {
414 int mapno;
415
416 init_menu_items ();
417
418 /* Loop over the given keymaps, making a pane for each map.
419 But don't make a pane that is empty--ignore that map instead.
420 P is the number of panes we have made so far. */
421 for (mapno = 0; mapno < nmaps; mapno++)
422 single_keymap_panes (keymaps[mapno],
423 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
424
425 finish_menu_items ();
426 }
427
428 /* Args passed between single_keymap_panes and single_menu_item. */
429 struct skp
430 {
431 Lisp_Object pending_maps;
432 int maxdepth, notreal;
433 int notbuttons;
434 };
435
436 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
437 void *));
438
439 /* This is a recursive subroutine of keymap_panes.
440 It handles one keymap, KEYMAP.
441 The other arguments are passed along
442 or point to local variables of the previous function.
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
446 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
447
448 static void
449 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
450 Lisp_Object keymap;
451 Lisp_Object pane_name;
452 Lisp_Object prefix;
453 int notreal;
454 int maxdepth;
455 {
456 struct skp skp;
457 struct gcpro gcpro1;
458
459 skp.pending_maps = Qnil;
460 skp.maxdepth = maxdepth;
461 skp.notreal = notreal;
462 skp.notbuttons = 0;
463
464 if (maxdepth <= 0)
465 return;
466
467 push_menu_pane (pane_name, prefix);
468
469 #ifndef HAVE_BOXES
470 /* Remember index for first item in this pane so we can go back and
471 add a prefix when (if) we see the first button. After that, notbuttons
472 is set to 0, to mark that we have seen a button and all non button
473 items need a prefix. */
474 skp.notbuttons = menu_items_used;
475 #endif
476
477 GCPRO1 (skp.pending_maps);
478 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
479 UNGCPRO;
480
481 /* Process now any submenus which want to be panes at this level. */
482 while (CONSP (skp.pending_maps))
483 {
484 Lisp_Object elt, eltcdr, string;
485 elt = XCAR (skp.pending_maps);
486 eltcdr = XCDR (elt);
487 string = XCAR (eltcdr);
488 /* We no longer discard the @ from the beginning of the string here.
489 Instead, we do this in xmenu_show. */
490 single_keymap_panes (Fcar (elt), string,
491 XCDR (eltcdr), notreal, maxdepth - 1);
492 skp.pending_maps = XCDR (skp.pending_maps);
493 }
494 }
495 \f
496 /* This is a subroutine of single_keymap_panes that handles one
497 keymap entry.
498 KEY is a key in a keymap and ITEM is its binding.
499 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
500 separate panes.
501 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
502 evaluate expressions in menu items and don't make any menu.
503 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them.
504 SKP->NOTBUTTONS is only used when simulating toggle boxes and radio
505 buttons. It keeps track of if we have seen a button in this menu or
506 not. */
507
508 static void
509 single_menu_item (key, item, dummy, skp_v)
510 Lisp_Object key, item, dummy;
511 void *skp_v;
512 {
513 Lisp_Object map, item_string, enabled;
514 struct gcpro gcpro1, gcpro2;
515 int res;
516 struct skp *skp = skp_v;
517
518 /* Parse the menu item and leave the result in item_properties. */
519 GCPRO2 (key, item);
520 res = parse_menu_item (item, skp->notreal, 0);
521 UNGCPRO;
522 if (!res)
523 return; /* Not a menu item. */
524
525 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
526
527 if (skp->notreal)
528 {
529 /* We don't want to make a menu, just traverse the keymaps to
530 precompute equivalent key bindings. */
531 if (!NILP (map))
532 single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
533 return;
534 }
535
536 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
537 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
538
539 if (!NILP (map) && SREF (item_string, 0) == '@')
540 {
541 if (!NILP (enabled))
542 /* An enabled separate pane. Remember this to handle it later. */
543 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
544 skp->pending_maps);
545 return;
546 }
547
548 #ifndef HAVE_BOXES
549 /* Simulate radio buttons and toggle boxes by putting a prefix in
550 front of them. */
551 {
552 Lisp_Object prefix = Qnil;
553 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
554 if (!NILP (type))
555 {
556 Lisp_Object selected
557 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
558
559 if (skp->notbuttons)
560 /* The first button. Line up previous items in this menu. */
561 {
562 int index = skp->notbuttons; /* Index for first item this menu. */
563 int submenu = 0;
564 Lisp_Object tem;
565 while (index < menu_items_used)
566 {
567 tem
568 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
569 if (NILP (tem))
570 {
571 index++;
572 submenu++; /* Skip sub menu. */
573 }
574 else if (EQ (tem, Qlambda))
575 {
576 index++;
577 submenu--; /* End sub menu. */
578 }
579 else if (EQ (tem, Qt))
580 index += 3; /* Skip new pane marker. */
581 else if (EQ (tem, Qquote))
582 index++; /* Skip a left, right divider. */
583 else
584 {
585 if (!submenu && SREF (tem, 0) != '\0'
586 && SREF (tem, 0) != '-')
587 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
588 = concat2 (build_string (" "), tem);
589 index += MENU_ITEMS_ITEM_LENGTH;
590 }
591 }
592 skp->notbuttons = 0;
593 }
594
595 /* Calculate prefix, if any, for this item. */
596 if (EQ (type, QCtoggle))
597 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
598 else if (EQ (type, QCradio))
599 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
600 }
601 /* Not a button. If we have earlier buttons, then we need a prefix. */
602 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
603 && SREF (item_string, 0) != '-')
604 prefix = build_string (" ");
605
606 if (!NILP (prefix))
607 item_string = concat2 (prefix, item_string);
608 }
609 #endif /* not HAVE_BOXES */
610
611 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
612 if (!NILP (map))
613 /* Indicate visually that this is a submenu. */
614 item_string = concat2 (item_string, build_string (" >"));
615 #endif
616
617 push_menu_item (item_string, enabled, key,
618 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
619 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
620 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
621 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
622 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
623
624 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
625 /* Display a submenu using the toolkit. */
626 if (! (NILP (map) || NILP (enabled)))
627 {
628 push_submenu_start ();
629 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
630 push_submenu_end ();
631 }
632 #endif
633 }
634 \f
635 /* Push all the panes and items of a menu described by the
636 alist-of-alists MENU.
637 This handles old-fashioned calls to x-popup-menu. */
638
639 static void
640 list_of_panes (menu)
641 Lisp_Object menu;
642 {
643 Lisp_Object tail;
644
645 init_menu_items ();
646
647 for (tail = menu; CONSP (tail); tail = XCDR (tail))
648 {
649 Lisp_Object elt, pane_name, pane_data;
650 elt = XCAR (tail);
651 pane_name = Fcar (elt);
652 CHECK_STRING (pane_name);
653 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
654 pane_data = Fcdr (elt);
655 CHECK_CONS (pane_data);
656 list_of_items (pane_data);
657 }
658
659 finish_menu_items ();
660 }
661
662 /* Push the items in a single pane defined by the alist PANE. */
663
664 static void
665 list_of_items (pane)
666 Lisp_Object pane;
667 {
668 Lisp_Object tail, item, item1;
669
670 for (tail = pane; CONSP (tail); tail = XCDR (tail))
671 {
672 item = XCAR (tail);
673 if (STRINGP (item))
674 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
675 Qnil, Qnil, Qnil, Qnil);
676 else if (CONSP (item))
677 {
678 item1 = XCAR (item);
679 CHECK_STRING (item1);
680 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
681 Qt, Qnil, Qnil, Qnil, Qnil);
682 }
683 else
684 push_left_right_boundary ();
685
686 }
687 }
688 \f
689 #ifdef HAVE_X_WINDOWS
690 /* Return the mouse position in *X and *Y. The coordinates are window
691 relative for the edit window in frame F.
692 This is for Fx_popup_menu. The mouse_position_hook can not
693 be used for X, as it returns window relative coordinates
694 for the window where the mouse is in. This could be the menu bar,
695 the scroll bar or the edit window. Fx_popup_menu needs to be
696 sure it is the edit window. */
697 static void
698 mouse_position_for_popup (f, x, y)
699 FRAME_PTR f;
700 int *x;
701 int *y;
702 {
703 Window root, dummy_window;
704 int dummy;
705
706 BLOCK_INPUT;
707
708 XQueryPointer (FRAME_X_DISPLAY (f),
709 DefaultRootWindow (FRAME_X_DISPLAY (f)),
710
711 /* The root window which contains the pointer. */
712 &root,
713
714 /* Window pointer is on, not used */
715 &dummy_window,
716
717 /* The position on that root window. */
718 x, y,
719
720 /* x/y in dummy_window coordinates, not used. */
721 &dummy, &dummy,
722
723 /* Modifier keys and pointer buttons, about which
724 we don't care. */
725 (unsigned int *) &dummy);
726
727 UNBLOCK_INPUT;
728
729 /* xmenu_show expects window coordinates, not root window
730 coordinates. Translate. */
731 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
732 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
733 }
734
735 #endif /* HAVE_X_WINDOWS */
736
737 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
738 doc: /* Pop up a deck-of-cards menu and return user's selection.
739 POSITION is a position specification. This is either a mouse button event
740 or a list ((XOFFSET YOFFSET) WINDOW)
741 where XOFFSET and YOFFSET are positions in pixels from the top left
742 corner of WINDOW. (WINDOW may be a window or a frame object.)
743 This controls the position of the top left of the menu as a whole.
744 If POSITION is t, it means to use the current mouse position.
745
746 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
747 The menu items come from key bindings that have a menu string as well as
748 a definition; actually, the "definition" in such a key binding looks like
749 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
750 the keymap as a top-level element.
751
752 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
753 Otherwise, REAL-DEFINITION should be a valid key binding definition.
754
755 You can also use a list of keymaps as MENU.
756 Then each keymap makes a separate pane.
757
758 When MENU is a keymap or a list of keymaps, the return value is the
759 list of events corresponding to the user's choice. Note that
760 `x-popup-menu' does not actually execute the command bound to that
761 sequence of events.
762
763 Alternatively, you can specify a menu of multiple panes
764 with a list of the form (TITLE PANE1 PANE2...),
765 where each pane is a list of form (TITLE ITEM1 ITEM2...).
766 Each ITEM is normally a cons cell (STRING . VALUE);
767 but a string can appear as an item--that makes a nonselectable line
768 in the menu.
769 With this form of menu, the return value is VALUE from the chosen item.
770
771 If POSITION is nil, don't display the menu at all, just precalculate the
772 cached information about equivalent key sequences.
773
774 If the user gets rid of the menu without making a valid choice, for
775 instance by clicking the mouse away from a valid choice or by typing
776 keyboard input, then this normally results in a quit and
777 `x-popup-menu' does not return. But if POSITION is a mouse button
778 event (indicating that the user invoked the menu with the mouse) then
779 no quit occurs and `x-popup-menu' returns nil. */)
780 (position, menu)
781 Lisp_Object position, menu;
782 {
783 Lisp_Object keymap, tem;
784 int xpos = 0, ypos = 0;
785 Lisp_Object title;
786 char *error_name = NULL;
787 Lisp_Object selection;
788 FRAME_PTR f = NULL;
789 Lisp_Object x, y, window;
790 int keymaps = 0;
791 int for_click = 0;
792 int specpdl_count = SPECPDL_INDEX ();
793 struct gcpro gcpro1;
794
795 #ifdef HAVE_MENUS
796 if (! NILP (position))
797 {
798 int get_current_pos_p = 0;
799 check_x ();
800
801 /* Decode the first argument: find the window and the coordinates. */
802 if (EQ (position, Qt)
803 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
804 || EQ (XCAR (position), Qtool_bar))))
805 {
806 get_current_pos_p = 1;
807 }
808 else
809 {
810 tem = Fcar (position);
811 if (CONSP (tem))
812 {
813 window = Fcar (Fcdr (position));
814 x = XCAR (tem);
815 y = Fcar (XCDR (tem));
816 }
817 else
818 {
819 for_click = 1;
820 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
821 window = Fcar (tem); /* POSN_WINDOW (tem) */
822 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
823 x = Fcar (tem);
824 y = Fcdr (tem);
825 }
826
827 /* If a click happens in an external tool bar or a detached
828 tool bar, x and y is NIL. In that case, use the current
829 mouse position. This happens for the help button in the
830 tool bar. Ideally popup-menu should pass NIL to
831 this function, but it doesn't. */
832 if (NILP (x) && NILP (y))
833 get_current_pos_p = 1;
834 }
835
836 if (get_current_pos_p)
837 {
838 /* Use the mouse's current position. */
839 FRAME_PTR new_f = SELECTED_FRAME ();
840 #ifdef HAVE_X_WINDOWS
841 /* Can't use mouse_position_hook for X since it returns
842 coordinates relative to the window the mouse is in,
843 we need coordinates relative to the edit widget always. */
844 if (new_f != 0)
845 {
846 int cur_x, cur_y;
847
848 mouse_position_for_popup (new_f, &cur_x, &cur_y);
849 /* cur_x/y may be negative, so use make_number. */
850 x = make_number (cur_x);
851 y = make_number (cur_y);
852 }
853
854 #else /* not HAVE_X_WINDOWS */
855 Lisp_Object bar_window;
856 enum scroll_bar_part part;
857 unsigned long time;
858
859 if (mouse_position_hook)
860 (*mouse_position_hook) (&new_f, 1, &bar_window,
861 &part, &x, &y, &time);
862 #endif /* not HAVE_X_WINDOWS */
863
864 if (new_f != 0)
865 XSETFRAME (window, new_f);
866 else
867 {
868 window = selected_window;
869 XSETFASTINT (x, 0);
870 XSETFASTINT (y, 0);
871 }
872 }
873
874 CHECK_NUMBER (x);
875 CHECK_NUMBER (y);
876
877 /* Decode where to put the menu. */
878
879 if (FRAMEP (window))
880 {
881 f = XFRAME (window);
882 xpos = 0;
883 ypos = 0;
884 }
885 else if (WINDOWP (window))
886 {
887 CHECK_LIVE_WINDOW (window);
888 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
889
890 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
891 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
892 }
893 else
894 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
895 but I don't want to make one now. */
896 CHECK_WINDOW (window);
897
898 xpos += XINT (x);
899 ypos += XINT (y);
900 }
901 Vmenu_updating_frame = Qnil;
902 #endif /* HAVE_MENUS */
903
904 record_unwind_protect (unuse_menu_items, Qnil);
905 title = Qnil;
906 GCPRO1 (title);
907
908 /* Decode the menu items from what was specified. */
909
910 keymap = get_keymap (menu, 0, 0);
911 if (CONSP (keymap))
912 {
913 /* We were given a keymap. Extract menu info from the keymap. */
914 Lisp_Object prompt;
915
916 /* Extract the detailed info to make one pane. */
917 keymap_panes (&menu, 1, NILP (position));
918
919 /* Search for a string appearing directly as an element of the keymap.
920 That string is the title of the menu. */
921 prompt = Fkeymap_prompt (keymap);
922 if (NILP (title) && !NILP (prompt))
923 title = prompt;
924
925 /* Make that be the pane title of the first pane. */
926 if (!NILP (prompt) && menu_items_n_panes >= 0)
927 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
928
929 keymaps = 1;
930 }
931 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
932 {
933 /* We were given a list of keymaps. */
934 int nmaps = XFASTINT (Flength (menu));
935 Lisp_Object *maps
936 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
937 int i;
938
939 title = Qnil;
940
941 /* The first keymap that has a prompt string
942 supplies the menu title. */
943 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
944 {
945 Lisp_Object prompt;
946
947 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
948
949 prompt = Fkeymap_prompt (keymap);
950 if (NILP (title) && !NILP (prompt))
951 title = prompt;
952 }
953
954 /* Extract the detailed info to make one pane. */
955 keymap_panes (maps, nmaps, NILP (position));
956
957 /* Make the title be the pane title of the first pane. */
958 if (!NILP (title) && menu_items_n_panes >= 0)
959 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
960
961 keymaps = 1;
962 }
963 else
964 {
965 /* We were given an old-fashioned menu. */
966 title = Fcar (menu);
967 CHECK_STRING (title);
968
969 list_of_panes (Fcdr (menu));
970
971 keymaps = 0;
972 }
973
974 unbind_to (specpdl_count, Qnil);
975
976 if (NILP (position))
977 {
978 discard_menu_items ();
979 UNGCPRO;
980 return Qnil;
981 }
982
983 #ifdef HAVE_MENUS
984 /* Display them in a menu. */
985 BLOCK_INPUT;
986
987 selection = xmenu_show (f, xpos, ypos, for_click,
988 keymaps, title, &error_name);
989 UNBLOCK_INPUT;
990
991 discard_menu_items ();
992
993 UNGCPRO;
994 #endif /* HAVE_MENUS */
995
996 if (error_name) error (error_name);
997 return selection;
998 }
999
1000 #ifdef HAVE_MENUS
1001
1002 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
1003 doc: /* Pop up a dialog box and return user's selection.
1004 POSITION specifies which frame to use.
1005 This is normally a mouse button event or a window or frame.
1006 If POSITION is t, it means to use the frame the mouse is on.
1007 The dialog box appears in the middle of the specified frame.
1008
1009 CONTENTS specifies the alternatives to display in the dialog box.
1010 It is a list of the form (TITLE ITEM1 ITEM2...).
1011 Each ITEM is a cons cell (STRING . VALUE).
1012 The return value is VALUE from the chosen item.
1013
1014 An ITEM may also be just a string--that makes a nonselectable item.
1015 An ITEM may also be nil--that means to put all preceding items
1016 on the left of the dialog box and all following items on the right.
1017 \(By default, approximately half appear on each side.)
1018
1019 If the user gets rid of the dialog box without making a valid choice,
1020 for instance using the window manager, then this produces a quit and
1021 `x-popup-dialog' does not return. */)
1022 (position, contents)
1023 Lisp_Object position, contents;
1024 {
1025 FRAME_PTR f = NULL;
1026 Lisp_Object window;
1027
1028 check_x ();
1029
1030 /* Decode the first argument: find the window or frame to use. */
1031 if (EQ (position, Qt)
1032 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1033 || EQ (XCAR (position), Qtool_bar))))
1034 {
1035 #if 0 /* Using the frame the mouse is on may not be right. */
1036 /* Use the mouse's current position. */
1037 FRAME_PTR new_f = SELECTED_FRAME ();
1038 Lisp_Object bar_window;
1039 enum scroll_bar_part part;
1040 unsigned long time;
1041 Lisp_Object x, y;
1042
1043 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1044
1045 if (new_f != 0)
1046 XSETFRAME (window, new_f);
1047 else
1048 window = selected_window;
1049 #endif
1050 window = selected_window;
1051 }
1052 else if (CONSP (position))
1053 {
1054 Lisp_Object tem;
1055 tem = Fcar (position);
1056 if (CONSP (tem))
1057 window = Fcar (Fcdr (position));
1058 else
1059 {
1060 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1061 window = Fcar (tem); /* POSN_WINDOW (tem) */
1062 }
1063 }
1064 else if (WINDOWP (position) || FRAMEP (position))
1065 window = position;
1066 else
1067 window = Qnil;
1068
1069 /* Decode where to put the menu. */
1070
1071 if (FRAMEP (window))
1072 f = XFRAME (window);
1073 else if (WINDOWP (window))
1074 {
1075 CHECK_LIVE_WINDOW (window);
1076 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1077 }
1078 else
1079 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1080 but I don't want to make one now. */
1081 CHECK_WINDOW (window);
1082
1083 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
1084 /* Display a menu with these alternatives
1085 in the middle of frame F. */
1086 {
1087 Lisp_Object x, y, frame, newpos;
1088 XSETFRAME (frame, f);
1089 XSETINT (x, x_pixel_width (f) / 2);
1090 XSETINT (y, x_pixel_height (f) / 2);
1091 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1092
1093 return Fx_popup_menu (newpos,
1094 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1095 }
1096 #else
1097 {
1098 Lisp_Object title;
1099 char *error_name;
1100 Lisp_Object selection;
1101 int specpdl_count = SPECPDL_INDEX ();
1102
1103 /* Decode the dialog items from what was specified. */
1104 title = Fcar (contents);
1105 CHECK_STRING (title);
1106 record_unwind_protect (unuse_menu_items, Qnil);
1107
1108 if (NILP (Fcar (Fcdr (contents))))
1109 /* No buttons specified, add an "Ok" button so users can pop down
1110 the dialog. Also, the lesstif/motif version crashes if there are
1111 no buttons. */
1112 contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil));
1113
1114 list_of_panes (Fcons (contents, Qnil));
1115
1116 /* Display them in a dialog box. */
1117 BLOCK_INPUT;
1118 selection = xdialog_show (f, 0, title, &error_name);
1119 UNBLOCK_INPUT;
1120
1121 unbind_to (specpdl_count, Qnil);
1122 discard_menu_items ();
1123
1124 if (error_name) error (error_name);
1125 return selection;
1126 }
1127 #endif
1128 }
1129
1130
1131 #ifndef MSDOS
1132
1133 /* Set menu_items_inuse so no other popup menu or dialog is created. */
1134
1135 void
1136 x_menu_set_in_use (in_use)
1137 int in_use;
1138 {
1139 menu_items_inuse = in_use ? Qt : Qnil;
1140 popup_activated_flag = in_use;
1141 }
1142
1143 /* Wait for an X event to arrive or for a timer to expire. */
1144
1145 void
1146 x_menu_wait_for_event (void *data)
1147 {
1148 extern EMACS_TIME timer_check P_ ((int));
1149
1150 /* Another way to do this is to register a timer callback, that can be
1151 done in GTK and Xt. But we have to do it like this when using only X
1152 anyway, and with callbacks we would have three variants for timer handling
1153 instead of the small ifdefs below. */
1154
1155 while (
1156 #ifdef USE_X_TOOLKIT
1157 ! XtAppPending (Xt_app_con)
1158 #elif defined USE_GTK
1159 ! gtk_events_pending ()
1160 #else
1161 ! XPending ((Display*) data)
1162 #endif
1163 )
1164 {
1165 EMACS_TIME next_time = timer_check (1);
1166 long secs = EMACS_SECS (next_time);
1167 long usecs = EMACS_USECS (next_time);
1168 SELECT_TYPE read_fds;
1169 struct x_display_info *dpyinfo;
1170 int n = 0;
1171
1172 FD_ZERO (&read_fds);
1173 for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
1174 {
1175 int fd = ConnectionNumber (dpyinfo->display);
1176 FD_SET (fd, &read_fds);
1177 if (fd > n) n = fd;
1178 }
1179
1180 if (secs < 0 || (secs == 0 && usecs == 0))
1181 {
1182 /* Sometimes timer_check returns -1 (no timers) even if there are
1183 timers. So do a timeout anyway. */
1184 EMACS_SET_SECS (next_time, 1);
1185 EMACS_SET_USECS (next_time, 0);
1186 }
1187
1188 select (n + 1, &read_fds, (SELECT_TYPE *)0, (SELECT_TYPE *)0, &next_time);
1189 }
1190 }
1191 #endif /* ! MSDOS */
1192
1193 \f
1194 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1195
1196 #ifdef USE_X_TOOLKIT
1197
1198 /* Loop in Xt until the menu pulldown or dialog popup has been
1199 popped down (deactivated). This is used for x-popup-menu
1200 and x-popup-dialog; it is not used for the menu bar.
1201
1202 NOTE: All calls to popup_get_selection should be protected
1203 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1204
1205 static void
1206 popup_get_selection (initial_event, dpyinfo, id, do_timers)
1207 XEvent *initial_event;
1208 struct x_display_info *dpyinfo;
1209 LWLIB_ID id;
1210 int do_timers;
1211 {
1212 XEvent event;
1213
1214 while (popup_activated_flag)
1215 {
1216 if (initial_event)
1217 {
1218 event = *initial_event;
1219 initial_event = 0;
1220 }
1221 else
1222 {
1223 if (do_timers) x_menu_wait_for_event (0);
1224 XtAppNextEvent (Xt_app_con, &event);
1225 }
1226
1227 /* Make sure we don't consider buttons grabbed after menu goes.
1228 And make sure to deactivate for any ButtonRelease,
1229 even if XtDispatchEvent doesn't do that. */
1230 if (event.type == ButtonRelease
1231 && dpyinfo->display == event.xbutton.display)
1232 {
1233 dpyinfo->grabbed &= ~(1 << event.xbutton.button);
1234 #ifdef USE_MOTIF /* Pretending that the event came from a
1235 Btn1Down seems the only way to convince Motif to
1236 activate its callbacks; setting the XmNmenuPost
1237 isn't working. --marcus@sysc.pdx.edu. */
1238 event.xbutton.button = 1;
1239 /* Motif only pops down menus when no Ctrl, Alt or Mod
1240 key is pressed and the button is released. So reset key state
1241 so Motif thinks this is the case. */
1242 event.xbutton.state = 0;
1243 #endif
1244 }
1245 /* Pop down on C-g and Escape. */
1246 else if (event.type == KeyPress
1247 && dpyinfo->display == event.xbutton.display)
1248 {
1249 KeySym keysym = XLookupKeysym (&event.xkey, 0);
1250
1251 if ((keysym == XK_g && (event.xkey.state & ControlMask) != 0)
1252 || keysym == XK_Escape) /* Any escape, ignore modifiers. */
1253 popup_activated_flag = 0;
1254 }
1255
1256 x_dispatch_event (&event, event.xany.display);
1257 }
1258 }
1259
1260 #endif /* USE_X_TOOLKIT */
1261
1262 #ifdef USE_GTK
1263 /* Loop util popup_activated_flag is set to zero in a callback.
1264 Used for popup menus and dialogs. */
1265
1266 static void
1267 popup_widget_loop (do_timers, widget)
1268 int do_timers;
1269 GtkWidget *widget;
1270 {
1271 ++popup_activated_flag;
1272
1273 /* Process events in the Gtk event loop until done. */
1274 while (popup_activated_flag)
1275 {
1276 if (do_timers) x_menu_wait_for_event (0);
1277 gtk_main_iteration ();
1278 }
1279 }
1280 #endif
1281
1282 /* Activate the menu bar of frame F.
1283 This is called from keyboard.c when it gets the
1284 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1285
1286 To activate the menu bar, we use the X button-press event
1287 that was saved in saved_menu_event.
1288 That makes the toolkit do its thing.
1289
1290 But first we recompute the menu bar contents (the whole tree).
1291
1292 The reason for saving the button event until here, instead of
1293 passing it to the toolkit right away, is that we can safely
1294 execute Lisp code. */
1295
1296 void
1297 x_activate_menubar (f)
1298 FRAME_PTR f;
1299 {
1300 if (!f->output_data.x->saved_menu_event->type)
1301 return;
1302
1303 #ifdef USE_GTK
1304 if (! xg_win_to_widget (FRAME_X_DISPLAY (f),
1305 f->output_data.x->saved_menu_event->xany.window))
1306 return;
1307 #endif
1308
1309 set_frame_menubar (f, 0, 1);
1310 BLOCK_INPUT;
1311 #ifdef USE_GTK
1312 XPutBackEvent (f->output_data.x->display_info->display,
1313 f->output_data.x->saved_menu_event);
1314 popup_activated_flag = 1;
1315 #else
1316 XtDispatchEvent (f->output_data.x->saved_menu_event);
1317 #endif
1318 UNBLOCK_INPUT;
1319 #ifdef USE_MOTIF
1320 if (f->output_data.x->saved_menu_event->type == ButtonRelease)
1321 pending_menu_activation = 1;
1322 #endif
1323
1324 /* Ignore this if we get it a second time. */
1325 f->output_data.x->saved_menu_event->type = 0;
1326 }
1327
1328 /* Detect if a dialog or menu has been posted. */
1329
1330 int
1331 popup_activated ()
1332 {
1333 return popup_activated_flag;
1334 }
1335
1336 /* This callback is invoked when the user selects a menubar cascade
1337 pushbutton, but before the pulldown menu is posted. */
1338
1339 #ifndef USE_GTK
1340 static void
1341 popup_activate_callback (widget, id, client_data)
1342 Widget widget;
1343 LWLIB_ID id;
1344 XtPointer client_data;
1345 {
1346 popup_activated_flag = 1;
1347 }
1348 #endif
1349
1350 /* This callback is invoked when a dialog or menu is finished being
1351 used and has been unposted. */
1352
1353 #ifdef USE_GTK
1354 static void
1355 popup_deactivate_callback (widget, client_data)
1356 GtkWidget *widget;
1357 gpointer client_data;
1358 {
1359 popup_activated_flag = 0;
1360 }
1361 #else
1362 static void
1363 popup_deactivate_callback (widget, id, client_data)
1364 Widget widget;
1365 LWLIB_ID id;
1366 XtPointer client_data;
1367 {
1368 popup_activated_flag = 0;
1369 }
1370 #endif
1371
1372
1373 /* Function that finds the frame for WIDGET and shows the HELP text
1374 for that widget.
1375 F is the frame if known, or NULL if not known. */
1376 static void
1377 show_help_event (f, widget, help)
1378 FRAME_PTR f;
1379 xt_or_gtk_widget widget;
1380 Lisp_Object help;
1381 {
1382 Lisp_Object frame;
1383
1384 if (f)
1385 {
1386 XSETFRAME (frame, f);
1387 kbd_buffer_store_help_event (frame, help);
1388 }
1389 else
1390 {
1391 #if 0 /* This code doesn't do anything useful. ++kfs */
1392 /* WIDGET is the popup menu. It's parent is the frame's
1393 widget. See which frame that is. */
1394 xt_or_gtk_widget frame_widget = XtParent (widget);
1395 Lisp_Object tail;
1396
1397 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
1398 {
1399 frame = XCAR (tail);
1400 if (GC_FRAMEP (frame)
1401 && (f = XFRAME (frame),
1402 FRAME_X_P (f) && f->output_data.x->widget == frame_widget))
1403 break;
1404 }
1405 #endif
1406 show_help_echo (help, Qnil, Qnil, Qnil, 1);
1407 }
1408 }
1409
1410 /* Callback called when menu items are highlighted/unhighlighted
1411 while moving the mouse over them. WIDGET is the menu bar or menu
1412 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1413 the data structure for the menu item, or null in case of
1414 unhighlighting. */
1415
1416 #ifdef USE_GTK
1417 void
1418 menu_highlight_callback (widget, call_data)
1419 GtkWidget *widget;
1420 gpointer call_data;
1421 {
1422 xg_menu_item_cb_data *cb_data;
1423 Lisp_Object help;
1424
1425 cb_data = (xg_menu_item_cb_data*) g_object_get_data (G_OBJECT (widget),
1426 XG_ITEM_DATA);
1427 if (! cb_data) return;
1428
1429 help = call_data ? cb_data->help : Qnil;
1430
1431 /* If popup_activated_flag is greater than 1 we are in a popup menu.
1432 Don't show help for them, they won't appear before the
1433 popup is popped down. */
1434 if (popup_activated_flag <= 1)
1435 show_help_event (cb_data->cl_data->f, widget, help);
1436 }
1437 #else
1438 void
1439 menu_highlight_callback (widget, id, call_data)
1440 Widget widget;
1441 LWLIB_ID id;
1442 void *call_data;
1443 {
1444 struct frame *f;
1445 Lisp_Object help;
1446
1447 widget_value *wv = (widget_value *) call_data;
1448
1449 help = wv ? wv->help : Qnil;
1450
1451 /* Determine the frame for the help event. */
1452 f = menubar_id_to_frame (id);
1453
1454 show_help_event (f, widget, help);
1455 }
1456 #endif
1457
1458 /* Find the menu selection and store it in the keyboard buffer.
1459 F is the frame the menu is on.
1460 MENU_BAR_ITEMS_USED is the length of VECTOR.
1461 VECTOR is an array of menu events for the whole menu. */
1462
1463 static void
1464 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
1465 FRAME_PTR f;
1466 int menu_bar_items_used;
1467 Lisp_Object vector;
1468 void *client_data;
1469 {
1470 Lisp_Object prefix, entry;
1471 Lisp_Object *subprefix_stack;
1472 int submenu_depth = 0;
1473 int i;
1474
1475 entry = Qnil;
1476 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
1477 prefix = Qnil;
1478 i = 0;
1479
1480 while (i < menu_bar_items_used)
1481 {
1482 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1483 {
1484 subprefix_stack[submenu_depth++] = prefix;
1485 prefix = entry;
1486 i++;
1487 }
1488 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1489 {
1490 prefix = subprefix_stack[--submenu_depth];
1491 i++;
1492 }
1493 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1494 {
1495 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1496 i += MENU_ITEMS_PANE_LENGTH;
1497 }
1498 else
1499 {
1500 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1501 /* The EMACS_INT cast avoids a warning. There's no problem
1502 as long as pointers have enough bits to hold small integers. */
1503 if ((int) (EMACS_INT) client_data == i)
1504 {
1505 int j;
1506 struct input_event buf;
1507 Lisp_Object frame;
1508 EVENT_INIT (buf);
1509
1510 XSETFRAME (frame, f);
1511 buf.kind = MENU_BAR_EVENT;
1512 buf.frame_or_window = frame;
1513 buf.arg = frame;
1514 kbd_buffer_store_event (&buf);
1515
1516 for (j = 0; j < submenu_depth; j++)
1517 if (!NILP (subprefix_stack[j]))
1518 {
1519 buf.kind = MENU_BAR_EVENT;
1520 buf.frame_or_window = frame;
1521 buf.arg = subprefix_stack[j];
1522 kbd_buffer_store_event (&buf);
1523 }
1524
1525 if (!NILP (prefix))
1526 {
1527 buf.kind = MENU_BAR_EVENT;
1528 buf.frame_or_window = frame;
1529 buf.arg = prefix;
1530 kbd_buffer_store_event (&buf);
1531 }
1532
1533 buf.kind = MENU_BAR_EVENT;
1534 buf.frame_or_window = frame;
1535 buf.arg = entry;
1536 kbd_buffer_store_event (&buf);
1537
1538 return;
1539 }
1540 i += MENU_ITEMS_ITEM_LENGTH;
1541 }
1542 }
1543 }
1544
1545
1546 #ifdef USE_GTK
1547 /* Gtk calls callbacks just because we tell it what item should be
1548 selected in a radio group. If this variable is set to a non-zero
1549 value, we are creating menus and don't want callbacks right now.
1550 */
1551 static int xg_crazy_callback_abort;
1552
1553 /* This callback is called from the menu bar pulldown menu
1554 when the user makes a selection.
1555 Figure out what the user chose
1556 and put the appropriate events into the keyboard buffer. */
1557 static void
1558 menubar_selection_callback (widget, client_data)
1559 GtkWidget *widget;
1560 gpointer client_data;
1561 {
1562 xg_menu_item_cb_data *cb_data = (xg_menu_item_cb_data*) client_data;
1563
1564 if (xg_crazy_callback_abort)
1565 return;
1566
1567 if (! cb_data || ! cb_data->cl_data || ! cb_data->cl_data->f)
1568 return;
1569
1570 /* When a menu is popped down, X generates a focus event (i.e. focus
1571 goes back to the frame below the menu). Since GTK buffers events,
1572 we force it out here before the menu selection event. Otherwise
1573 sit-for will exit at once if the focus event follows the menu selection
1574 event. */
1575
1576 BLOCK_INPUT;
1577 while (gtk_events_pending ())
1578 gtk_main_iteration ();
1579 UNBLOCK_INPUT;
1580
1581 find_and_call_menu_selection (cb_data->cl_data->f,
1582 cb_data->cl_data->menu_bar_items_used,
1583 cb_data->cl_data->menu_bar_vector,
1584 cb_data->call_data);
1585 }
1586
1587 #else /* not USE_GTK */
1588
1589 /* This callback is called from the menu bar pulldown menu
1590 when the user makes a selection.
1591 Figure out what the user chose
1592 and put the appropriate events into the keyboard buffer. */
1593 static void
1594 menubar_selection_callback (widget, id, client_data)
1595 Widget widget;
1596 LWLIB_ID id;
1597 XtPointer client_data;
1598 {
1599 FRAME_PTR f;
1600
1601 f = menubar_id_to_frame (id);
1602 if (!f)
1603 return;
1604 find_and_call_menu_selection (f, f->menu_bar_items_used,
1605 f->menu_bar_vector, client_data);
1606 }
1607 #endif /* not USE_GTK */
1608
1609 /* Allocate a widget_value, blocking input. */
1610
1611 widget_value *
1612 xmalloc_widget_value ()
1613 {
1614 widget_value *value;
1615
1616 BLOCK_INPUT;
1617 value = malloc_widget_value ();
1618 UNBLOCK_INPUT;
1619
1620 return value;
1621 }
1622
1623 /* This recursively calls free_widget_value on the tree of widgets.
1624 It must free all data that was malloc'ed for these widget_values.
1625 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1626 must be left alone. */
1627
1628 void
1629 free_menubar_widget_value_tree (wv)
1630 widget_value *wv;
1631 {
1632 if (! wv) return;
1633
1634 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1635
1636 if (wv->contents && (wv->contents != (widget_value*)1))
1637 {
1638 free_menubar_widget_value_tree (wv->contents);
1639 wv->contents = (widget_value *) 0xDEADBEEF;
1640 }
1641 if (wv->next)
1642 {
1643 free_menubar_widget_value_tree (wv->next);
1644 wv->next = (widget_value *) 0xDEADBEEF;
1645 }
1646 BLOCK_INPUT;
1647 free_widget_value (wv);
1648 UNBLOCK_INPUT;
1649 }
1650 \f
1651 /* Set up data in menu_items for a menu bar item
1652 whose event type is ITEM_KEY (with string ITEM_NAME)
1653 and whose contents come from the list of keymaps MAPS. */
1654
1655 static int
1656 parse_single_submenu (item_key, item_name, maps)
1657 Lisp_Object item_key, item_name, maps;
1658 {
1659 Lisp_Object length;
1660 int len;
1661 Lisp_Object *mapvec;
1662 int i;
1663 int top_level_items = 0;
1664
1665 length = Flength (maps);
1666 len = XINT (length);
1667
1668 /* Convert the list MAPS into a vector MAPVEC. */
1669 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1670 for (i = 0; i < len; i++)
1671 {
1672 mapvec[i] = Fcar (maps);
1673 maps = Fcdr (maps);
1674 }
1675
1676 /* Loop over the given keymaps, making a pane for each map.
1677 But don't make a pane that is empty--ignore that map instead. */
1678 for (i = 0; i < len; i++)
1679 {
1680 if (!KEYMAPP (mapvec[i]))
1681 {
1682 /* Here we have a command at top level in the menu bar
1683 as opposed to a submenu. */
1684 top_level_items = 1;
1685 push_menu_pane (Qnil, Qnil);
1686 push_menu_item (item_name, Qt, item_key, mapvec[i],
1687 Qnil, Qnil, Qnil, Qnil);
1688 }
1689 else
1690 {
1691 Lisp_Object prompt;
1692 prompt = Fkeymap_prompt (mapvec[i]);
1693 single_keymap_panes (mapvec[i],
1694 !NILP (prompt) ? prompt : item_name,
1695 item_key, 0, 10);
1696 }
1697 }
1698
1699 return top_level_items;
1700 }
1701
1702 /* Create a tree of widget_value objects
1703 representing the panes and items
1704 in menu_items starting at index START, up to index END. */
1705
1706 static widget_value *
1707 digest_single_submenu (start, end, top_level_items)
1708 int start, end, top_level_items;
1709 {
1710 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1711 int i;
1712 int submenu_depth = 0;
1713 widget_value **submenu_stack;
1714
1715 submenu_stack
1716 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1717 wv = xmalloc_widget_value ();
1718 wv->name = "menu";
1719 wv->value = 0;
1720 wv->enabled = 1;
1721 wv->button_type = BUTTON_TYPE_NONE;
1722 wv->help = Qnil;
1723 first_wv = wv;
1724 save_wv = 0;
1725 prev_wv = 0;
1726
1727 /* Loop over all panes and items made by the preceding call
1728 to parse_single_submenu and construct a tree of widget_value objects.
1729 Ignore the panes and items used by previous calls to
1730 digest_single_submenu, even though those are also in menu_items. */
1731 i = start;
1732 while (i < end)
1733 {
1734 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1735 {
1736 submenu_stack[submenu_depth++] = save_wv;
1737 save_wv = prev_wv;
1738 prev_wv = 0;
1739 i++;
1740 }
1741 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1742 {
1743 prev_wv = save_wv;
1744 save_wv = submenu_stack[--submenu_depth];
1745 i++;
1746 }
1747 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1748 && submenu_depth != 0)
1749 i += MENU_ITEMS_PANE_LENGTH;
1750 /* Ignore a nil in the item list.
1751 It's meaningful only for dialog boxes. */
1752 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1753 i += 1;
1754 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1755 {
1756 /* Create a new pane. */
1757 Lisp_Object pane_name, prefix;
1758 char *pane_string;
1759
1760 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1761 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1762
1763 #ifndef HAVE_MULTILINGUAL_MENU
1764 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1765 {
1766 pane_name = ENCODE_MENU_STRING (pane_name);
1767 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1768 }
1769 #endif
1770 pane_string = (NILP (pane_name)
1771 ? "" : (char *) SDATA (pane_name));
1772 /* If there is just one top-level pane, put all its items directly
1773 under the top-level menu. */
1774 if (menu_items_n_panes == 1)
1775 pane_string = "";
1776
1777 /* If the pane has a meaningful name,
1778 make the pane a top-level menu item
1779 with its items as a submenu beneath it. */
1780 if (strcmp (pane_string, ""))
1781 {
1782 wv = xmalloc_widget_value ();
1783 if (save_wv)
1784 save_wv->next = wv;
1785 else
1786 first_wv->contents = wv;
1787 wv->lname = pane_name;
1788 /* Set value to 1 so update_submenu_strings can handle '@' */
1789 wv->value = (char *)1;
1790 wv->enabled = 1;
1791 wv->button_type = BUTTON_TYPE_NONE;
1792 wv->help = Qnil;
1793 }
1794 save_wv = wv;
1795 prev_wv = 0;
1796 i += MENU_ITEMS_PANE_LENGTH;
1797 }
1798 else
1799 {
1800 /* Create a new item within current pane. */
1801 Lisp_Object item_name, enable, descrip, def, type, selected;
1802 Lisp_Object help;
1803
1804 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1805 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1806 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1807 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1808 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1809 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1810 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1811
1812 #ifndef HAVE_MULTILINGUAL_MENU
1813 if (STRING_MULTIBYTE (item_name))
1814 {
1815 item_name = ENCODE_MENU_STRING (item_name);
1816 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1817 }
1818
1819 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1820 {
1821 descrip = ENCODE_MENU_STRING (descrip);
1822 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1823 }
1824 #endif /* not HAVE_MULTILINGUAL_MENU */
1825
1826 wv = xmalloc_widget_value ();
1827 if (prev_wv)
1828 prev_wv->next = wv;
1829 else
1830 save_wv->contents = wv;
1831
1832 wv->lname = item_name;
1833 if (!NILP (descrip))
1834 wv->lkey = descrip;
1835 wv->value = 0;
1836 /* The EMACS_INT cast avoids a warning. There's no problem
1837 as long as pointers have enough bits to hold small integers. */
1838 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1839 wv->enabled = !NILP (enable);
1840
1841 if (NILP (type))
1842 wv->button_type = BUTTON_TYPE_NONE;
1843 else if (EQ (type, QCradio))
1844 wv->button_type = BUTTON_TYPE_RADIO;
1845 else if (EQ (type, QCtoggle))
1846 wv->button_type = BUTTON_TYPE_TOGGLE;
1847 else
1848 abort ();
1849
1850 wv->selected = !NILP (selected);
1851 if (! STRINGP (help))
1852 help = Qnil;
1853
1854 wv->help = help;
1855
1856 prev_wv = wv;
1857
1858 i += MENU_ITEMS_ITEM_LENGTH;
1859 }
1860 }
1861
1862 /* If we have just one "menu item"
1863 that was originally a button, return it by itself. */
1864 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1865 {
1866 wv = first_wv->contents;
1867 free_widget_value (first_wv);
1868 return wv;
1869 }
1870
1871 return first_wv;
1872 }
1873
1874 /* Walk through the widget_value tree starting at FIRST_WV and update
1875 the char * pointers from the corresponding lisp values.
1876 We do this after building the whole tree, since GC may happen while the
1877 tree is constructed, and small strings are relocated. So we must wait
1878 until no GC can happen before storing pointers into lisp values. */
1879 static void
1880 update_submenu_strings (first_wv)
1881 widget_value *first_wv;
1882 {
1883 widget_value *wv;
1884
1885 for (wv = first_wv; wv; wv = wv->next)
1886 {
1887 if (STRINGP (wv->lname))
1888 {
1889 wv->name = SDATA (wv->lname);
1890
1891 /* Ignore the @ that means "separate pane".
1892 This is a kludge, but this isn't worth more time. */
1893 if (wv->value == (char *)1)
1894 {
1895 if (wv->name[0] == '@')
1896 wv->name++;
1897 wv->value = 0;
1898 }
1899 }
1900
1901 if (STRINGP (wv->lkey))
1902 wv->key = SDATA (wv->lkey);
1903
1904 if (wv->contents)
1905 update_submenu_strings (wv->contents);
1906 }
1907 }
1908
1909 \f
1910 /* Recompute all the widgets of frame F, when the menu bar has been
1911 changed. Value is non-zero if widgets were updated. */
1912
1913 static int
1914 update_frame_menubar (f)
1915 FRAME_PTR f;
1916 {
1917 #ifdef USE_GTK
1918 return xg_update_frame_menubar (f);
1919 #else
1920 struct x_output *x = f->output_data.x;
1921 int columns, rows;
1922
1923 if (!x->menubar_widget || XtIsManaged (x->menubar_widget))
1924 return 0;
1925
1926 BLOCK_INPUT;
1927 /* Save the size of the frame because the pane widget doesn't accept
1928 to resize itself. So force it. */
1929 columns = FRAME_COLS (f);
1930 rows = FRAME_LINES (f);
1931
1932 /* Do the voodoo which means "I'm changing lots of things, don't try
1933 to refigure sizes until I'm done." */
1934 lw_refigure_widget (x->column_widget, False);
1935
1936 /* The order in which children are managed is the top to bottom
1937 order in which they are displayed in the paned window. First,
1938 remove the text-area widget. */
1939 XtUnmanageChild (x->edit_widget);
1940
1941 /* Remove the menubar that is there now, and put up the menubar that
1942 should be there. */
1943 XtManageChild (x->menubar_widget);
1944 XtMapWidget (x->menubar_widget);
1945 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, NULL);
1946
1947 /* Re-manage the text-area widget, and then thrash the sizes. */
1948 XtManageChild (x->edit_widget);
1949 lw_refigure_widget (x->column_widget, True);
1950
1951 /* Force the pane widget to resize itself with the right values. */
1952 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1953 UNBLOCK_INPUT;
1954 #endif
1955 return 1;
1956 }
1957
1958 /* Set the contents of the menubar widgets of frame F.
1959 The argument FIRST_TIME is currently ignored;
1960 it is set the first time this is called, from initialize_frame_menubar. */
1961
1962 void
1963 set_frame_menubar (f, first_time, deep_p)
1964 FRAME_PTR f;
1965 int first_time;
1966 int deep_p;
1967 {
1968 xt_or_gtk_widget menubar_widget = f->output_data.x->menubar_widget;
1969 #ifdef USE_X_TOOLKIT
1970 LWLIB_ID id;
1971 #endif
1972 Lisp_Object items;
1973 widget_value *wv, *first_wv, *prev_wv = 0;
1974 int i, last_i = 0;
1975 int *submenu_start, *submenu_end;
1976 int *submenu_top_level_items, *submenu_n_panes;
1977
1978
1979 XSETFRAME (Vmenu_updating_frame, f);
1980
1981 #ifdef USE_X_TOOLKIT
1982 if (f->output_data.x->id == 0)
1983 f->output_data.x->id = next_menubar_widget_id++;
1984 id = f->output_data.x->id;
1985 #endif
1986
1987 if (! menubar_widget)
1988 deep_p = 1;
1989 else if (pending_menu_activation && !deep_p)
1990 deep_p = 1;
1991 /* Make the first call for any given frame always go deep. */
1992 else if (!f->output_data.x->saved_menu_event && !deep_p)
1993 {
1994 deep_p = 1;
1995 f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent));
1996 f->output_data.x->saved_menu_event->type = 0;
1997 }
1998
1999 #ifdef USE_GTK
2000 /* If we have detached menus, we must update deep so detached menus
2001 also gets updated. */
2002 deep_p = deep_p || xg_have_tear_offs ();
2003 #endif
2004
2005 if (deep_p)
2006 {
2007 /* Make a widget-value tree representing the entire menu trees. */
2008
2009 struct buffer *prev = current_buffer;
2010 Lisp_Object buffer;
2011 int specpdl_count = SPECPDL_INDEX ();
2012 int previous_menu_items_used = f->menu_bar_items_used;
2013 Lisp_Object *previous_items
2014 = (Lisp_Object *) alloca (previous_menu_items_used
2015 * sizeof (Lisp_Object));
2016
2017 /* If we are making a new widget, its contents are empty,
2018 do always reinitialize them. */
2019 if (! menubar_widget)
2020 previous_menu_items_used = 0;
2021
2022 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
2023 specbind (Qinhibit_quit, Qt);
2024 /* Don't let the debugger step into this code
2025 because it is not reentrant. */
2026 specbind (Qdebug_on_next_call, Qnil);
2027
2028 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
2029 record_unwind_protect (unuse_menu_items, Qnil);
2030 if (NILP (Voverriding_local_map_menu_flag))
2031 {
2032 specbind (Qoverriding_terminal_local_map, Qnil);
2033 specbind (Qoverriding_local_map, Qnil);
2034 }
2035
2036 set_buffer_internal_1 (XBUFFER (buffer));
2037
2038 /* Run the Lucid hook. */
2039 safe_run_hooks (Qactivate_menubar_hook);
2040
2041 /* If it has changed current-menubar from previous value,
2042 really recompute the menubar from the value. */
2043 if (! NILP (Vlucid_menu_bar_dirty_flag))
2044 call0 (Qrecompute_lucid_menubar);
2045 safe_run_hooks (Qmenu_bar_update_hook);
2046 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
2047
2048 items = FRAME_MENU_BAR_ITEMS (f);
2049
2050 /* Save the frame's previous menu bar contents data. */
2051 if (previous_menu_items_used)
2052 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
2053 previous_menu_items_used * sizeof (Lisp_Object));
2054
2055 /* Fill in menu_items with the current menu bar contents.
2056 This can evaluate Lisp code. */
2057 menu_items = f->menu_bar_vector;
2058 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
2059 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
2060 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
2061 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
2062 submenu_top_level_items
2063 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
2064 init_menu_items ();
2065 for (i = 0; i < XVECTOR (items)->size; i += 4)
2066 {
2067 Lisp_Object key, string, maps;
2068
2069 last_i = i;
2070
2071 key = XVECTOR (items)->contents[i];
2072 string = XVECTOR (items)->contents[i + 1];
2073 maps = XVECTOR (items)->contents[i + 2];
2074 if (NILP (string))
2075 break;
2076
2077 submenu_start[i] = menu_items_used;
2078
2079 menu_items_n_panes = 0;
2080 submenu_top_level_items[i]
2081 = parse_single_submenu (key, string, maps);
2082 submenu_n_panes[i] = menu_items_n_panes;
2083
2084 submenu_end[i] = menu_items_used;
2085 }
2086
2087 finish_menu_items ();
2088
2089 /* Convert menu_items into widget_value trees
2090 to display the menu. This cannot evaluate Lisp code. */
2091
2092 wv = xmalloc_widget_value ();
2093 wv->name = "menubar";
2094 wv->value = 0;
2095 wv->enabled = 1;
2096 wv->button_type = BUTTON_TYPE_NONE;
2097 wv->help = Qnil;
2098 first_wv = wv;
2099
2100 for (i = 0; i < last_i; i += 4)
2101 {
2102 menu_items_n_panes = submenu_n_panes[i];
2103 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
2104 submenu_top_level_items[i]);
2105 if (prev_wv)
2106 prev_wv->next = wv;
2107 else
2108 first_wv->contents = wv;
2109 /* Don't set wv->name here; GC during the loop might relocate it. */
2110 wv->enabled = 1;
2111 wv->button_type = BUTTON_TYPE_NONE;
2112 prev_wv = wv;
2113 }
2114
2115 set_buffer_internal_1 (prev);
2116 unbind_to (specpdl_count, Qnil);
2117
2118 /* If there has been no change in the Lisp-level contents
2119 of the menu bar, skip redisplaying it. Just exit. */
2120
2121 for (i = 0; i < previous_menu_items_used; i++)
2122 if (menu_items_used == i
2123 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
2124 break;
2125 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
2126 {
2127 free_menubar_widget_value_tree (first_wv);
2128 discard_menu_items ();
2129
2130 return;
2131 }
2132
2133 /* Now GC cannot happen during the lifetime of the widget_value,
2134 so it's safe to store data from a Lisp_String. */
2135 wv = first_wv->contents;
2136 for (i = 0; i < XVECTOR (items)->size; i += 4)
2137 {
2138 Lisp_Object string;
2139 string = XVECTOR (items)->contents[i + 1];
2140 if (NILP (string))
2141 break;
2142 wv->name = (char *) SDATA (string);
2143 update_submenu_strings (wv->contents);
2144 wv = wv->next;
2145 }
2146
2147 f->menu_bar_vector = menu_items;
2148 f->menu_bar_items_used = menu_items_used;
2149 discard_menu_items ();
2150 }
2151 else
2152 {
2153 /* Make a widget-value tree containing
2154 just the top level menu bar strings. */
2155
2156 wv = xmalloc_widget_value ();
2157 wv->name = "menubar";
2158 wv->value = 0;
2159 wv->enabled = 1;
2160 wv->button_type = BUTTON_TYPE_NONE;
2161 wv->help = Qnil;
2162 first_wv = wv;
2163
2164 items = FRAME_MENU_BAR_ITEMS (f);
2165 for (i = 0; i < XVECTOR (items)->size; i += 4)
2166 {
2167 Lisp_Object string;
2168
2169 string = XVECTOR (items)->contents[i + 1];
2170 if (NILP (string))
2171 break;
2172
2173 wv = xmalloc_widget_value ();
2174 wv->name = (char *) SDATA (string);
2175 wv->value = 0;
2176 wv->enabled = 1;
2177 wv->button_type = BUTTON_TYPE_NONE;
2178 wv->help = Qnil;
2179 /* This prevents lwlib from assuming this
2180 menu item is really supposed to be empty. */
2181 /* The EMACS_INT cast avoids a warning.
2182 This value just has to be different from small integers. */
2183 wv->call_data = (void *) (EMACS_INT) (-1);
2184
2185 if (prev_wv)
2186 prev_wv->next = wv;
2187 else
2188 first_wv->contents = wv;
2189 prev_wv = wv;
2190 }
2191
2192 /* Forget what we thought we knew about what is in the
2193 detailed contents of the menu bar menus.
2194 Changing the top level always destroys the contents. */
2195 f->menu_bar_items_used = 0;
2196 }
2197
2198 /* Create or update the menu bar widget. */
2199
2200 BLOCK_INPUT;
2201
2202 #ifdef USE_GTK
2203 xg_crazy_callback_abort = 1;
2204 if (menubar_widget)
2205 {
2206 /* The fourth arg is DEEP_P, which says to consider the entire
2207 menu trees we supply, rather than just the menu bar item names. */
2208 xg_modify_menubar_widgets (menubar_widget,
2209 f,
2210 first_wv,
2211 deep_p,
2212 G_CALLBACK (menubar_selection_callback),
2213 G_CALLBACK (popup_deactivate_callback),
2214 G_CALLBACK (menu_highlight_callback));
2215 }
2216 else
2217 {
2218 GtkWidget *wvbox = f->output_data.x->vbox_widget;
2219
2220 menubar_widget
2221 = xg_create_widget ("menubar", "menubar", f, first_wv,
2222 G_CALLBACK (menubar_selection_callback),
2223 G_CALLBACK (popup_deactivate_callback),
2224 G_CALLBACK (menu_highlight_callback));
2225
2226 f->output_data.x->menubar_widget = menubar_widget;
2227 }
2228
2229
2230 #else /* not USE_GTK */
2231 if (menubar_widget)
2232 {
2233 /* Disable resizing (done for Motif!) */
2234 lw_allow_resizing (f->output_data.x->widget, False);
2235
2236 /* The third arg is DEEP_P, which says to consider the entire
2237 menu trees we supply, rather than just the menu bar item names. */
2238 lw_modify_all_widgets (id, first_wv, deep_p);
2239
2240 /* Re-enable the edit widget to resize. */
2241 lw_allow_resizing (f->output_data.x->widget, True);
2242 }
2243 else
2244 {
2245 char menuOverride[] = "Ctrl<KeyPress>g: MenuGadgetEscape()";
2246 XtTranslations override = XtParseTranslationTable (menuOverride);
2247
2248 menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv,
2249 f->output_data.x->column_widget,
2250 0,
2251 popup_activate_callback,
2252 menubar_selection_callback,
2253 popup_deactivate_callback,
2254 menu_highlight_callback);
2255 f->output_data.x->menubar_widget = menubar_widget;
2256
2257 /* Make menu pop down on C-g. */
2258 XtOverrideTranslations (menubar_widget, override);
2259 }
2260
2261 {
2262 int menubar_size
2263 = (f->output_data.x->menubar_widget
2264 ? (f->output_data.x->menubar_widget->core.height
2265 + f->output_data.x->menubar_widget->core.border_width)
2266 : 0);
2267
2268 #if 0 /* Experimentally, we now get the right results
2269 for -geometry -0-0 without this. 24 Aug 96, rms. */
2270 #ifdef USE_LUCID
2271 if (FRAME_EXTERNAL_MENU_BAR (f))
2272 {
2273 Dimension ibw = 0;
2274 XtVaGetValues (f->output_data.x->column_widget,
2275 XtNinternalBorderWidth, &ibw, NULL);
2276 menubar_size += ibw;
2277 }
2278 #endif /* USE_LUCID */
2279 #endif /* 0 */
2280
2281 f->output_data.x->menubar_height = menubar_size;
2282 }
2283 #endif /* not USE_GTK */
2284
2285 free_menubar_widget_value_tree (first_wv);
2286 update_frame_menubar (f);
2287
2288 #ifdef USE_GTK
2289 xg_crazy_callback_abort = 0;
2290 #endif
2291
2292 UNBLOCK_INPUT;
2293 }
2294
2295 /* Called from Fx_create_frame to create the initial menubar of a frame
2296 before it is mapped, so that the window is mapped with the menubar already
2297 there instead of us tacking it on later and thrashing the window after it
2298 is visible. */
2299
2300 void
2301 initialize_frame_menubar (f)
2302 FRAME_PTR f;
2303 {
2304 /* This function is called before the first chance to redisplay
2305 the frame. It has to be, so the frame will have the right size. */
2306 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
2307 set_frame_menubar (f, 1, 1);
2308 }
2309
2310
2311 /* Get rid of the menu bar of frame F, and free its storage.
2312 This is used when deleting a frame, and when turning off the menu bar.
2313 For GTK this function is in gtkutil.c. */
2314
2315 #ifndef USE_GTK
2316 void
2317 free_frame_menubar (f)
2318 FRAME_PTR f;
2319 {
2320 Widget menubar_widget;
2321
2322 menubar_widget = f->output_data.x->menubar_widget;
2323
2324 f->output_data.x->menubar_height = 0;
2325
2326 if (menubar_widget)
2327 {
2328 #ifdef USE_MOTIF
2329 /* Removing the menu bar magically changes the shell widget's x
2330 and y position of (0, 0) which, when the menu bar is turned
2331 on again, leads to pull-down menuss appearing in strange
2332 positions near the upper-left corner of the display. This
2333 happens only with some window managers like twm and ctwm,
2334 but not with other like Motif's mwm or kwm, because the
2335 latter generate ConfigureNotify events when the menu bar
2336 is switched off, which fixes the shell position. */
2337 Position x0, y0, x1, y1;
2338 #endif
2339
2340 BLOCK_INPUT;
2341
2342 #ifdef USE_MOTIF
2343 if (f->output_data.x->widget)
2344 XtVaGetValues (f->output_data.x->widget, XtNx, &x0, XtNy, &y0, NULL);
2345 #endif
2346
2347 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
2348 f->output_data.x->menubar_widget = NULL;
2349
2350 #ifdef USE_MOTIF
2351 if (f->output_data.x->widget)
2352 {
2353 XtVaGetValues (f->output_data.x->widget, XtNx, &x1, XtNy, &y1, NULL);
2354 if (x1 == 0 && y1 == 0)
2355 XtVaSetValues (f->output_data.x->widget, XtNx, x0, XtNy, y0, NULL);
2356 }
2357 #endif
2358
2359 UNBLOCK_INPUT;
2360 }
2361 }
2362 #endif /* not USE_GTK */
2363
2364 #endif /* USE_X_TOOLKIT || USE_GTK */
2365 \f
2366 /* xmenu_show actually displays a menu using the panes and items in menu_items
2367 and returns the value selected from it.
2368 There are two versions of xmenu_show, one for Xt and one for Xlib.
2369 Both assume input is blocked by the caller. */
2370
2371 /* F is the frame the menu is for.
2372 X and Y are the frame-relative specified position,
2373 relative to the inside upper left corner of the frame F.
2374 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
2375 KEYMAPS is 1 if this menu was specified with keymaps;
2376 in that case, we return a list containing the chosen item's value
2377 and perhaps also the pane's prefix.
2378 TITLE is the specified menu title.
2379 ERROR is a place to store an error message string in case of failure.
2380 (We return nil on failure, but the value doesn't actually matter.) */
2381
2382 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
2383
2384 /* The item selected in the popup menu. */
2385 static Lisp_Object *volatile menu_item_selection;
2386
2387 #ifdef USE_GTK
2388
2389 /* Used when position a popup menu. See menu_position_func and
2390 create_and_show_popup_menu below. */
2391 struct next_popup_x_y
2392 {
2393 FRAME_PTR f;
2394 int x;
2395 int y;
2396 };
2397
2398 /* The menu position function to use if we are not putting a popup
2399 menu where the pointer is.
2400 MENU is the menu to pop up.
2401 X and Y shall on exit contain x/y where the menu shall pop up.
2402 PUSH_IN is not documented in the GTK manual.
2403 USER_DATA is any data passed in when calling gtk_menu_popup.
2404 Here it points to a struct next_popup_x_y where the coordinates
2405 to store in *X and *Y are as well as the frame for the popup.
2406
2407 Here only X and Y are used. */
2408 static void
2409 menu_position_func (menu, x, y, push_in, user_data)
2410 GtkMenu *menu;
2411 gint *x;
2412 gint *y;
2413 gboolean *push_in;
2414 gpointer user_data;
2415 {
2416 struct next_popup_x_y* data = (struct next_popup_x_y*)user_data;
2417 GtkRequisition req;
2418 int disp_width = FRAME_X_DISPLAY_INFO (data->f)->width;
2419 int disp_height = FRAME_X_DISPLAY_INFO (data->f)->height;
2420
2421 *x = data->x;
2422 *y = data->y;
2423
2424 /* Check if there is room for the menu. If not, adjust x/y so that
2425 the menu is fully visible. */
2426 gtk_widget_size_request (GTK_WIDGET (menu), &req);
2427 if (data->x + req.width > disp_width)
2428 *x -= data->x + req.width - disp_width;
2429 if (data->y + req.height > disp_height)
2430 *y -= data->y + req.height - disp_height;
2431 }
2432
2433 static void
2434 popup_selection_callback (widget, client_data)
2435 GtkWidget *widget;
2436 gpointer client_data;
2437 {
2438 xg_menu_item_cb_data *cb_data = (xg_menu_item_cb_data*) client_data;
2439
2440 if (xg_crazy_callback_abort) return;
2441 if (cb_data) menu_item_selection = (Lisp_Object *) cb_data->call_data;
2442 }
2443
2444 static Lisp_Object
2445 pop_down_menu (arg)
2446 Lisp_Object arg;
2447 {
2448 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
2449
2450 popup_activated_flag = 0;
2451 BLOCK_INPUT;
2452 gtk_widget_destroy (GTK_WIDGET (p->pointer));
2453 UNBLOCK_INPUT;
2454 return Qnil;
2455 }
2456
2457 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
2458 menu pops down.
2459 menu_item_selection will be set to the selection. */
2460 static void
2461 create_and_show_popup_menu (f, first_wv, x, y, for_click)
2462 FRAME_PTR f;
2463 widget_value *first_wv;
2464 int x;
2465 int y;
2466 int for_click;
2467 {
2468 int i;
2469 GtkWidget *menu;
2470 GtkMenuPositionFunc pos_func = 0; /* Pop up at pointer. */
2471 struct next_popup_x_y popup_x_y;
2472 int specpdl_count = SPECPDL_INDEX ();
2473
2474 xg_crazy_callback_abort = 1;
2475 menu = xg_create_widget ("popup", first_wv->name, f, first_wv,
2476 G_CALLBACK (popup_selection_callback),
2477 G_CALLBACK (popup_deactivate_callback),
2478 G_CALLBACK (menu_highlight_callback));
2479 xg_crazy_callback_abort = 0;
2480
2481 if (! for_click)
2482 {
2483 /* Not invoked by a click. pop up at x/y. */
2484 pos_func = menu_position_func;
2485
2486 /* Adjust coordinates to be root-window-relative. */
2487 x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2488 y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2489
2490 popup_x_y.x = x;
2491 popup_x_y.y = y;
2492 popup_x_y.f = f;
2493
2494 i = 0; /* gtk_menu_popup needs this to be 0 for a non-button popup. */
2495 }
2496 else
2497 {
2498 for (i = 0; i < 5; i++)
2499 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2500 break;
2501 }
2502
2503 /* Display the menu. */
2504 gtk_widget_show_all (menu);
2505 gtk_menu_popup (GTK_MENU (menu), 0, 0, pos_func, &popup_x_y, i, 0);
2506
2507 record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
2508
2509 if (GTK_WIDGET_MAPPED (menu))
2510 {
2511 /* Set this to one. popup_widget_loop increases it by one, so it becomes
2512 two. show_help_echo uses this to detect popup menus. */
2513 popup_activated_flag = 1;
2514 /* Process events that apply to the menu. */
2515 popup_widget_loop (1, menu);
2516 }
2517
2518 unbind_to (specpdl_count, Qnil);
2519
2520 /* Must reset this manually because the button release event is not passed
2521 to Emacs event loop. */
2522 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
2523 }
2524
2525 #else /* not USE_GTK */
2526
2527 /* We need a unique id for each widget handled by the Lucid Widget
2528 library.
2529
2530 For the main windows, and popup menus, we use this counter,
2531 which we increment each time after use. This starts from 1<<16.
2532
2533 For menu bars, we use numbers starting at 0, counted in
2534 next_menubar_widget_id. */
2535 LWLIB_ID widget_id_tick;
2536
2537 static void
2538 popup_selection_callback (widget, id, client_data)
2539 Widget widget;
2540 LWLIB_ID id;
2541 XtPointer client_data;
2542 {
2543 menu_item_selection = (Lisp_Object *) client_data;
2544 }
2545
2546 /* ARG is the LWLIB ID of the dialog box, represented
2547 as a Lisp object as (HIGHPART . LOWPART). */
2548
2549 static Lisp_Object
2550 pop_down_menu (arg)
2551 Lisp_Object arg;
2552 {
2553 LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID)
2554 | XINT (XCDR (arg)));
2555
2556 BLOCK_INPUT;
2557 lw_destroy_all_widgets (id);
2558 UNBLOCK_INPUT;
2559 popup_activated_flag = 0;
2560
2561 return Qnil;
2562 }
2563
2564 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
2565 menu pops down.
2566 menu_item_selection will be set to the selection. */
2567 static void
2568 create_and_show_popup_menu (f, first_wv, x, y, for_click)
2569 FRAME_PTR f;
2570 widget_value *first_wv;
2571 int x;
2572 int y;
2573 int for_click;
2574 {
2575 int i;
2576 Arg av[2];
2577 int ac = 0;
2578 XButtonPressedEvent dummy;
2579 LWLIB_ID menu_id;
2580 Widget menu;
2581
2582 menu_id = widget_id_tick++;
2583 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
2584 f->output_data.x->widget, 1, 0,
2585 popup_selection_callback,
2586 popup_deactivate_callback,
2587 menu_highlight_callback);
2588
2589 dummy.type = ButtonPress;
2590 dummy.serial = 0;
2591 dummy.send_event = 0;
2592 dummy.display = FRAME_X_DISPLAY (f);
2593 dummy.time = CurrentTime;
2594 dummy.root = FRAME_X_DISPLAY_INFO (f)->root_window;
2595 dummy.window = dummy.root;
2596 dummy.subwindow = dummy.root;
2597 dummy.x = x;
2598 dummy.y = y;
2599
2600 /* Adjust coordinates to be root-window-relative. */
2601 x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2602 y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2603
2604 dummy.x_root = x;
2605 dummy.y_root = y;
2606
2607 dummy.state = 0;
2608 dummy.button = 0;
2609 for (i = 0; i < 5; i++)
2610 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2611 dummy.button = i;
2612
2613 /* Don't allow any geometry request from the user. */
2614 XtSetArg (av[ac], XtNgeometry, 0); ac++;
2615 XtSetValues (menu, av, ac);
2616
2617 /* Display the menu. */
2618 lw_popup_menu (menu, (XEvent *) &dummy);
2619 popup_activated_flag = 1;
2620
2621 {
2622 int fact = 4 * sizeof (LWLIB_ID);
2623 int specpdl_count = SPECPDL_INDEX ();
2624 record_unwind_protect (pop_down_menu,
2625 Fcons (make_number (menu_id >> (fact)),
2626 make_number (menu_id & ~(-1 << (fact)))));
2627
2628 /* Process events that apply to the menu. */
2629 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 1);
2630
2631 unbind_to (specpdl_count, Qnil);
2632 }
2633 }
2634
2635 #endif /* not USE_GTK */
2636
2637 static Lisp_Object
2638 xmenu_show (f, x, y, for_click, keymaps, title, error)
2639 FRAME_PTR f;
2640 int x;
2641 int y;
2642 int for_click;
2643 int keymaps;
2644 Lisp_Object title;
2645 char **error;
2646 {
2647 int i;
2648 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2649 widget_value **submenu_stack
2650 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
2651 Lisp_Object *subprefix_stack
2652 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
2653 int submenu_depth = 0;
2654
2655 int first_pane;
2656
2657 *error = NULL;
2658
2659 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2660 {
2661 *error = "Empty menu";
2662 return Qnil;
2663 }
2664
2665 /* Create a tree of widget_value objects
2666 representing the panes and their items. */
2667 wv = xmalloc_widget_value ();
2668 wv->name = "menu";
2669 wv->value = 0;
2670 wv->enabled = 1;
2671 wv->button_type = BUTTON_TYPE_NONE;
2672 wv->help =Qnil;
2673 first_wv = wv;
2674 first_pane = 1;
2675
2676 /* Loop over all panes and items, filling in the tree. */
2677 i = 0;
2678 while (i < menu_items_used)
2679 {
2680 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2681 {
2682 submenu_stack[submenu_depth++] = save_wv;
2683 save_wv = prev_wv;
2684 prev_wv = 0;
2685 first_pane = 1;
2686 i++;
2687 }
2688 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2689 {
2690 prev_wv = save_wv;
2691 save_wv = submenu_stack[--submenu_depth];
2692 first_pane = 0;
2693 i++;
2694 }
2695 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
2696 && submenu_depth != 0)
2697 i += MENU_ITEMS_PANE_LENGTH;
2698 /* Ignore a nil in the item list.
2699 It's meaningful only for dialog boxes. */
2700 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2701 i += 1;
2702 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2703 {
2704 /* Create a new pane. */
2705 Lisp_Object pane_name, prefix;
2706 char *pane_string;
2707
2708 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2709 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2710
2711 #ifndef HAVE_MULTILINGUAL_MENU
2712 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
2713 {
2714 pane_name = ENCODE_MENU_STRING (pane_name);
2715 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
2716 }
2717 #endif
2718 pane_string = (NILP (pane_name)
2719 ? "" : (char *) SDATA (pane_name));
2720 /* If there is just one top-level pane, put all its items directly
2721 under the top-level menu. */
2722 if (menu_items_n_panes == 1)
2723 pane_string = "";
2724
2725 /* If the pane has a meaningful name,
2726 make the pane a top-level menu item
2727 with its items as a submenu beneath it. */
2728 if (!keymaps && strcmp (pane_string, ""))
2729 {
2730 wv = xmalloc_widget_value ();
2731 if (save_wv)
2732 save_wv->next = wv;
2733 else
2734 first_wv->contents = wv;
2735 wv->name = pane_string;
2736 if (keymaps && !NILP (prefix))
2737 wv->name++;
2738 wv->value = 0;
2739 wv->enabled = 1;
2740 wv->button_type = BUTTON_TYPE_NONE;
2741 wv->help = Qnil;
2742 save_wv = wv;
2743 prev_wv = 0;
2744 }
2745 else if (first_pane)
2746 {
2747 save_wv = wv;
2748 prev_wv = 0;
2749 }
2750 first_pane = 0;
2751 i += MENU_ITEMS_PANE_LENGTH;
2752 }
2753 else
2754 {
2755 /* Create a new item within current pane. */
2756 Lisp_Object item_name, enable, descrip, def, type, selected, help;
2757 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2758 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2759 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2760 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
2761 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
2762 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
2763 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2764
2765 #ifndef HAVE_MULTILINGUAL_MENU
2766 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
2767 {
2768 item_name = ENCODE_MENU_STRING (item_name);
2769 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
2770 }
2771
2772 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
2773 {
2774 descrip = ENCODE_MENU_STRING (descrip);
2775 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
2776 }
2777 #endif /* not HAVE_MULTILINGUAL_MENU */
2778
2779 wv = xmalloc_widget_value ();
2780 if (prev_wv)
2781 prev_wv->next = wv;
2782 else
2783 save_wv->contents = wv;
2784 wv->name = (char *) SDATA (item_name);
2785 if (!NILP (descrip))
2786 wv->key = (char *) SDATA (descrip);
2787 wv->value = 0;
2788 /* If this item has a null value,
2789 make the call_data null so that it won't display a box
2790 when the mouse is on it. */
2791 wv->call_data
2792 = (!NILP (def) ? (void *) &XVECTOR (menu_items)->contents[i] : 0);
2793 wv->enabled = !NILP (enable);
2794
2795 if (NILP (type))
2796 wv->button_type = BUTTON_TYPE_NONE;
2797 else if (EQ (type, QCtoggle))
2798 wv->button_type = BUTTON_TYPE_TOGGLE;
2799 else if (EQ (type, QCradio))
2800 wv->button_type = BUTTON_TYPE_RADIO;
2801 else
2802 abort ();
2803
2804 wv->selected = !NILP (selected);
2805
2806 if (! STRINGP (help))
2807 help = Qnil;
2808
2809 wv->help = help;
2810
2811 prev_wv = wv;
2812
2813 i += MENU_ITEMS_ITEM_LENGTH;
2814 }
2815 }
2816
2817 /* Deal with the title, if it is non-nil. */
2818 if (!NILP (title))
2819 {
2820 widget_value *wv_title = xmalloc_widget_value ();
2821 widget_value *wv_sep1 = xmalloc_widget_value ();
2822 widget_value *wv_sep2 = xmalloc_widget_value ();
2823
2824 wv_sep2->name = "--";
2825 wv_sep2->next = first_wv->contents;
2826 wv_sep2->help = Qnil;
2827
2828 wv_sep1->name = "--";
2829 wv_sep1->next = wv_sep2;
2830 wv_sep1->help = Qnil;
2831
2832 #ifndef HAVE_MULTILINGUAL_MENU
2833 if (STRING_MULTIBYTE (title))
2834 title = ENCODE_MENU_STRING (title);
2835 #endif
2836
2837 wv_title->name = (char *) SDATA (title);
2838 wv_title->enabled = TRUE;
2839 wv_title->button_type = BUTTON_TYPE_NONE;
2840 wv_title->next = wv_sep1;
2841 wv_title->help = Qnil;
2842 first_wv->contents = wv_title;
2843 }
2844
2845 /* No selection has been chosen yet. */
2846 menu_item_selection = 0;
2847
2848 /* Actually create and show the menu until popped down. */
2849 create_and_show_popup_menu (f, first_wv, x, y, for_click);
2850
2851 /* Free the widget_value objects we used to specify the contents. */
2852 free_menubar_widget_value_tree (first_wv);
2853
2854 /* Find the selected item, and its pane, to return
2855 the proper value. */
2856 if (menu_item_selection != 0)
2857 {
2858 Lisp_Object prefix, entry;
2859
2860 prefix = entry = Qnil;
2861 i = 0;
2862 while (i < menu_items_used)
2863 {
2864 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2865 {
2866 subprefix_stack[submenu_depth++] = prefix;
2867 prefix = entry;
2868 i++;
2869 }
2870 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2871 {
2872 prefix = subprefix_stack[--submenu_depth];
2873 i++;
2874 }
2875 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2876 {
2877 prefix
2878 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2879 i += MENU_ITEMS_PANE_LENGTH;
2880 }
2881 /* Ignore a nil in the item list.
2882 It's meaningful only for dialog boxes. */
2883 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2884 i += 1;
2885 else
2886 {
2887 entry
2888 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2889 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2890 {
2891 if (keymaps != 0)
2892 {
2893 int j;
2894
2895 entry = Fcons (entry, Qnil);
2896 if (!NILP (prefix))
2897 entry = Fcons (prefix, entry);
2898 for (j = submenu_depth - 1; j >= 0; j--)
2899 if (!NILP (subprefix_stack[j]))
2900 entry = Fcons (subprefix_stack[j], entry);
2901 }
2902 return entry;
2903 }
2904 i += MENU_ITEMS_ITEM_LENGTH;
2905 }
2906 }
2907 }
2908 else if (!for_click)
2909 /* Make "Cancel" equivalent to C-g. */
2910 Fsignal (Qquit, Qnil);
2911
2912 return Qnil;
2913 }
2914 \f
2915 #ifdef USE_GTK
2916 static void
2917 dialog_selection_callback (widget, client_data)
2918 GtkWidget *widget;
2919 gpointer client_data;
2920 {
2921 /* The EMACS_INT cast avoids a warning. There's no problem
2922 as long as pointers have enough bits to hold small integers. */
2923 if ((int) (EMACS_INT) client_data != -1)
2924 menu_item_selection = (Lisp_Object *) client_data;
2925
2926 popup_activated_flag = 0;
2927 }
2928
2929 /* Pop up the dialog for frame F defined by FIRST_WV and loop until the
2930 dialog pops down.
2931 menu_item_selection will be set to the selection. */
2932 static void
2933 create_and_show_dialog (f, first_wv)
2934 FRAME_PTR f;
2935 widget_value *first_wv;
2936 {
2937 GtkWidget *menu;
2938
2939 menu = xg_create_widget ("dialog", first_wv->name, f, first_wv,
2940 G_CALLBACK (dialog_selection_callback),
2941 G_CALLBACK (popup_deactivate_callback),
2942 0);
2943
2944 if (menu)
2945 {
2946 int specpdl_count = SPECPDL_INDEX ();
2947 record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
2948
2949 /* Display the menu. */
2950 gtk_widget_show_all (menu);
2951
2952 /* Process events that apply to the menu. */
2953 popup_widget_loop (1, menu);
2954
2955 unbind_to (specpdl_count, Qnil);
2956 }
2957 }
2958
2959 #else /* not USE_GTK */
2960 static void
2961 dialog_selection_callback (widget, id, client_data)
2962 Widget widget;
2963 LWLIB_ID id;
2964 XtPointer client_data;
2965 {
2966 /* The EMACS_INT cast avoids a warning. There's no problem
2967 as long as pointers have enough bits to hold small integers. */
2968 if ((int) (EMACS_INT) client_data != -1)
2969 menu_item_selection = (Lisp_Object *) client_data;
2970
2971 BLOCK_INPUT;
2972 lw_destroy_all_widgets (id);
2973 UNBLOCK_INPUT;
2974 popup_activated_flag = 0;
2975 }
2976
2977
2978 /* Pop up the dialog for frame F defined by FIRST_WV and loop until the
2979 dialog pops down.
2980 menu_item_selection will be set to the selection. */
2981 static void
2982 create_and_show_dialog (f, first_wv)
2983 FRAME_PTR f;
2984 widget_value *first_wv;
2985 {
2986 LWLIB_ID dialog_id;
2987
2988 dialog_id = widget_id_tick++;
2989 lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2990 f->output_data.x->widget, 1, 0,
2991 dialog_selection_callback, 0, 0);
2992 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
2993
2994 /* Display the dialog box. */
2995 lw_pop_up_all_widgets (dialog_id);
2996 popup_activated_flag = 1;
2997
2998 /* Process events that apply to the dialog box.
2999 Also handle timers. */
3000 {
3001 int count = SPECPDL_INDEX ();
3002 int fact = 4 * sizeof (LWLIB_ID);
3003
3004 /* xdialog_show_unwind is responsible for popping the dialog box down. */
3005 record_unwind_protect (pop_down_menu,
3006 Fcons (make_number (dialog_id >> (fact)),
3007 make_number (dialog_id & ~(-1 << (fact)))));
3008
3009 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f),
3010 dialog_id, 1);
3011
3012 unbind_to (count, Qnil);
3013 }
3014 }
3015
3016 #endif /* not USE_GTK */
3017
3018 static char * button_names [] = {
3019 "button1", "button2", "button3", "button4", "button5",
3020 "button6", "button7", "button8", "button9", "button10" };
3021
3022 static Lisp_Object
3023 xdialog_show (f, keymaps, title, error)
3024 FRAME_PTR f;
3025 int keymaps;
3026 Lisp_Object title;
3027 char **error;
3028 {
3029 int i, nb_buttons=0;
3030 char dialog_name[6];
3031
3032 widget_value *wv, *first_wv = 0, *prev_wv = 0;
3033
3034 /* Number of elements seen so far, before boundary. */
3035 int left_count = 0;
3036 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
3037 int boundary_seen = 0;
3038
3039 *error = NULL;
3040
3041 if (menu_items_n_panes > 1)
3042 {
3043 *error = "Multiple panes in dialog box";
3044 return Qnil;
3045 }
3046
3047 /* Create a tree of widget_value objects
3048 representing the text label and buttons. */
3049 {
3050 Lisp_Object pane_name, prefix;
3051 char *pane_string;
3052 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
3053 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
3054 pane_string = (NILP (pane_name)
3055 ? "" : (char *) SDATA (pane_name));
3056 prev_wv = xmalloc_widget_value ();
3057 prev_wv->value = pane_string;
3058 if (keymaps && !NILP (prefix))
3059 prev_wv->name++;
3060 prev_wv->enabled = 1;
3061 prev_wv->name = "message";
3062 prev_wv->help = Qnil;
3063 first_wv = prev_wv;
3064
3065 /* Loop over all panes and items, filling in the tree. */
3066 i = MENU_ITEMS_PANE_LENGTH;
3067 while (i < menu_items_used)
3068 {
3069
3070 /* Create a new item within current pane. */
3071 Lisp_Object item_name, enable, descrip;
3072 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
3073 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
3074 descrip
3075 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
3076
3077 if (NILP (item_name))
3078 {
3079 free_menubar_widget_value_tree (first_wv);
3080 *error = "Submenu in dialog items";
3081 return Qnil;
3082 }
3083 if (EQ (item_name, Qquote))
3084 {
3085 /* This is the boundary between left-side elts
3086 and right-side elts. Stop incrementing right_count. */
3087 boundary_seen = 1;
3088 i++;
3089 continue;
3090 }
3091 if (nb_buttons >= 9)
3092 {
3093 free_menubar_widget_value_tree (first_wv);
3094 *error = "Too many dialog items";
3095 return Qnil;
3096 }
3097
3098 wv = xmalloc_widget_value ();
3099 prev_wv->next = wv;
3100 wv->name = (char *) button_names[nb_buttons];
3101 if (!NILP (descrip))
3102 wv->key = (char *) SDATA (descrip);
3103 wv->value = (char *) SDATA (item_name);
3104 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
3105 wv->enabled = !NILP (enable);
3106 wv->help = Qnil;
3107 prev_wv = wv;
3108
3109 if (! boundary_seen)
3110 left_count++;
3111
3112 nb_buttons++;
3113 i += MENU_ITEMS_ITEM_LENGTH;
3114 }
3115
3116 /* If the boundary was not specified,
3117 by default put half on the left and half on the right. */
3118 if (! boundary_seen)
3119 left_count = nb_buttons - nb_buttons / 2;
3120
3121 wv = xmalloc_widget_value ();
3122 wv->name = dialog_name;
3123 wv->help = Qnil;
3124 /* Dialog boxes use a really stupid name encoding
3125 which specifies how many buttons to use
3126 and how many buttons are on the right.
3127 The Q means something also. */
3128 dialog_name[0] = 'Q';
3129 dialog_name[1] = '0' + nb_buttons;
3130 dialog_name[2] = 'B';
3131 dialog_name[3] = 'R';
3132 /* Number of buttons to put on the right. */
3133 dialog_name[4] = '0' + nb_buttons - left_count;
3134 dialog_name[5] = 0;
3135 wv->contents = first_wv;
3136 first_wv = wv;
3137 }
3138
3139 /* No selection has been chosen yet. */
3140 menu_item_selection = 0;
3141
3142 /* Actually create and show the dialog. */
3143 create_and_show_dialog (f, first_wv);
3144
3145 /* Free the widget_value objects we used to specify the contents. */
3146 free_menubar_widget_value_tree (first_wv);
3147
3148 /* Find the selected item, and its pane, to return
3149 the proper value. */
3150 if (menu_item_selection != 0)
3151 {
3152 Lisp_Object prefix;
3153
3154 prefix = Qnil;
3155 i = 0;
3156 while (i < menu_items_used)
3157 {
3158 Lisp_Object entry;
3159
3160 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3161 {
3162 prefix
3163 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3164 i += MENU_ITEMS_PANE_LENGTH;
3165 }
3166 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
3167 {
3168 /* This is the boundary between left-side elts and
3169 right-side elts. */
3170 ++i;
3171 }
3172 else
3173 {
3174 entry
3175 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
3176 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
3177 {
3178 if (keymaps != 0)
3179 {
3180 entry = Fcons (entry, Qnil);
3181 if (!NILP (prefix))
3182 entry = Fcons (prefix, entry);
3183 }
3184 return entry;
3185 }
3186 i += MENU_ITEMS_ITEM_LENGTH;
3187 }
3188 }
3189 }
3190 else
3191 /* Make "Cancel" equivalent to C-g. */
3192 Fsignal (Qquit, Qnil);
3193
3194 return Qnil;
3195 }
3196
3197 #else /* not USE_X_TOOLKIT && not USE_GTK */
3198
3199 /* The frame of the last activated non-toolkit menu bar.
3200 Used to generate menu help events. */
3201
3202 static struct frame *menu_help_frame;
3203
3204
3205 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
3206
3207 PANE is the pane number, and ITEM is the menu item number in
3208 the menu (currently not used).
3209
3210 This cannot be done with generating a HELP_EVENT because
3211 XMenuActivate contains a loop that doesn't let Emacs process
3212 keyboard events. */
3213
3214 static void
3215 menu_help_callback (help_string, pane, item)
3216 char *help_string;
3217 int pane, item;
3218 {
3219 extern Lisp_Object Qmenu_item;
3220 Lisp_Object *first_item;
3221 Lisp_Object pane_name;
3222 Lisp_Object menu_object;
3223
3224 first_item = XVECTOR (menu_items)->contents;
3225 if (EQ (first_item[0], Qt))
3226 pane_name = first_item[MENU_ITEMS_PANE_NAME];
3227 else if (EQ (first_item[0], Qquote))
3228 /* This shouldn't happen, see xmenu_show. */
3229 pane_name = empty_string;
3230 else
3231 pane_name = first_item[MENU_ITEMS_ITEM_NAME];
3232
3233 /* (menu-item MENU-NAME PANE-NUMBER) */
3234 menu_object = Fcons (Qmenu_item,
3235 Fcons (pane_name,
3236 Fcons (make_number (pane), Qnil)));
3237 show_help_echo (help_string ? build_string (help_string) : Qnil,
3238 Qnil, menu_object, make_number (item), 1);
3239 }
3240
3241 static Lisp_Object
3242 pop_down_menu (arg)
3243 Lisp_Object arg;
3244 {
3245 struct Lisp_Save_Value *p1 = XSAVE_VALUE (Fcar (arg));
3246 struct Lisp_Save_Value *p2 = XSAVE_VALUE (Fcdr (arg));
3247
3248 FRAME_PTR f = p1->pointer;
3249 XMenu *menu = p2->pointer;
3250
3251 BLOCK_INPUT;
3252 #ifndef MSDOS
3253 XUngrabPointer (FRAME_X_DISPLAY (f), CurrentTime);
3254 XUngrabKeyboard (FRAME_X_DISPLAY (f), CurrentTime);
3255 #endif
3256 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3257
3258 #ifdef HAVE_X_WINDOWS
3259 /* Assume the mouse has moved out of the X window.
3260 If it has actually moved in, we will get an EnterNotify. */
3261 x_mouse_leave (FRAME_X_DISPLAY_INFO (f));
3262
3263 /* State that no mouse buttons are now held.
3264 (The oldXMenu code doesn't track this info for us.)
3265 That is not necessarily true, but the fiction leads to reasonable
3266 results, and it is a pain to ask which are actually held now. */
3267 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
3268
3269 #endif /* HAVE_X_WINDOWS */
3270
3271 UNBLOCK_INPUT;
3272
3273 return Qnil;
3274 }
3275
3276
3277 static Lisp_Object
3278 xmenu_show (f, x, y, for_click, keymaps, title, error)
3279 FRAME_PTR f;
3280 int x, y;
3281 int for_click;
3282 int keymaps;
3283 Lisp_Object title;
3284 char **error;
3285 {
3286 Window root;
3287 XMenu *menu;
3288 int pane, selidx, lpane, status;
3289 Lisp_Object entry, pane_prefix;
3290 char *datap;
3291 int ulx, uly, width, height;
3292 int dispwidth, dispheight;
3293 int i, j, lines, maxlines;
3294 int maxwidth;
3295 int dummy_int;
3296 unsigned int dummy_uint;
3297 int specpdl_count = SPECPDL_INDEX ();
3298
3299 *error = 0;
3300 if (menu_items_n_panes == 0)
3301 return Qnil;
3302
3303 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
3304 {
3305 *error = "Empty menu";
3306 return Qnil;
3307 }
3308
3309 /* Figure out which root window F is on. */
3310 XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root,
3311 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
3312 &dummy_uint, &dummy_uint);
3313
3314 /* Make the menu on that window. */
3315 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
3316 if (menu == NULL)
3317 {
3318 *error = "Can't create menu";
3319 return Qnil;
3320 }
3321
3322 #ifdef HAVE_X_WINDOWS
3323 /* Adjust coordinates to relative to the outer (window manager) window. */
3324 x += FRAME_OUTER_TO_INNER_DIFF_X (f);
3325 y += FRAME_OUTER_TO_INNER_DIFF_Y (f);
3326 #endif /* HAVE_X_WINDOWS */
3327
3328 /* Adjust coordinates to be root-window-relative. */
3329 x += f->left_pos;
3330 y += f->top_pos;
3331
3332 /* Create all the necessary panes and their items. */
3333 maxlines = lines = i = 0;
3334 while (i < menu_items_used)
3335 {
3336 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3337 {
3338 /* Create a new pane. */
3339 Lisp_Object pane_name, prefix;
3340 char *pane_string;
3341
3342 maxlines = max (maxlines, lines);
3343 lines = 0;
3344 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
3345 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3346 pane_string = (NILP (pane_name)
3347 ? "" : (char *) SDATA (pane_name));
3348 if (keymaps && !NILP (prefix))
3349 pane_string++;
3350
3351 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
3352 if (lpane == XM_FAILURE)
3353 {
3354 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3355 *error = "Can't create pane";
3356 return Qnil;
3357 }
3358 i += MENU_ITEMS_PANE_LENGTH;
3359
3360 /* Find the width of the widest item in this pane. */
3361 maxwidth = 0;
3362 j = i;
3363 while (j < menu_items_used)
3364 {
3365 Lisp_Object item;
3366 item = XVECTOR (menu_items)->contents[j];
3367 if (EQ (item, Qt))
3368 break;
3369 if (NILP (item))
3370 {
3371 j++;
3372 continue;
3373 }
3374 width = SBYTES (item);
3375 if (width > maxwidth)
3376 maxwidth = width;
3377
3378 j += MENU_ITEMS_ITEM_LENGTH;
3379 }
3380 }
3381 /* Ignore a nil in the item list.
3382 It's meaningful only for dialog boxes. */
3383 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
3384 i += 1;
3385 else
3386 {
3387 /* Create a new item within current pane. */
3388 Lisp_Object item_name, enable, descrip, help;
3389 unsigned char *item_data;
3390 char *help_string;
3391
3392 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
3393 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
3394 descrip
3395 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
3396 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
3397 help_string = STRINGP (help) ? SDATA (help) : NULL;
3398
3399 if (!NILP (descrip))
3400 {
3401 int gap = maxwidth - SBYTES (item_name);
3402 #ifdef C_ALLOCA
3403 Lisp_Object spacer;
3404 spacer = Fmake_string (make_number (gap), make_number (' '));
3405 item_name = concat2 (item_name, spacer);
3406 item_name = concat2 (item_name, descrip);
3407 item_data = SDATA (item_name);
3408 #else
3409 /* if alloca is fast, use that to make the space,
3410 to reduce gc needs. */
3411 item_data
3412 = (unsigned char *) alloca (maxwidth
3413 + SBYTES (descrip) + 1);
3414 bcopy (SDATA (item_name), item_data,
3415 SBYTES (item_name));
3416 for (j = SCHARS (item_name); j < maxwidth; j++)
3417 item_data[j] = ' ';
3418 bcopy (SDATA (descrip), item_data + j,
3419 SBYTES (descrip));
3420 item_data[j + SBYTES (descrip)] = 0;
3421 #endif
3422 }
3423 else
3424 item_data = SDATA (item_name);
3425
3426 if (XMenuAddSelection (FRAME_X_DISPLAY (f),
3427 menu, lpane, 0, item_data,
3428 !NILP (enable), help_string)
3429 == XM_FAILURE)
3430 {
3431 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3432 *error = "Can't add selection to menu";
3433 return Qnil;
3434 }
3435 i += MENU_ITEMS_ITEM_LENGTH;
3436 lines++;
3437 }
3438 }
3439
3440 maxlines = max (maxlines, lines);
3441
3442 /* All set and ready to fly. */
3443 XMenuRecompute (FRAME_X_DISPLAY (f), menu);
3444 dispwidth = DisplayWidth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
3445 dispheight = DisplayHeight (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
3446 x = min (x, dispwidth);
3447 y = min (y, dispheight);
3448 x = max (x, 1);
3449 y = max (y, 1);
3450 XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y,
3451 &ulx, &uly, &width, &height);
3452 if (ulx+width > dispwidth)
3453 {
3454 x -= (ulx + width) - dispwidth;
3455 ulx = dispwidth - width;
3456 }
3457 if (uly+height > dispheight)
3458 {
3459 y -= (uly + height) - dispheight;
3460 uly = dispheight - height;
3461 }
3462 if (ulx < 0) x -= ulx;
3463 if (uly < 0) y -= uly;
3464
3465 if (! for_click)
3466 {
3467 /* If position was not given by a mouse click, adjust so upper left
3468 corner of the menu as a whole ends up at given coordinates. This
3469 is what x-popup-menu says in its documentation. */
3470 x += width/2;
3471 y += 1.5*height/(maxlines+2);
3472 }
3473
3474 XMenuSetAEQ (menu, TRUE);
3475 XMenuSetFreeze (menu, TRUE);
3476 pane = selidx = 0;
3477
3478 #ifndef MSDOS
3479 XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f));
3480 #endif
3481
3482 record_unwind_protect (pop_down_menu,
3483 Fcons (make_save_value (f, 0),
3484 make_save_value (menu, 0)));
3485
3486 /* Help display under X won't work because XMenuActivate contains
3487 a loop that doesn't give Emacs a chance to process it. */
3488 menu_help_frame = f;
3489 status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
3490 x, y, ButtonReleaseMask, &datap,
3491 menu_help_callback);
3492
3493 switch (status)
3494 {
3495 case XM_SUCCESS:
3496 #ifdef XDEBUG
3497 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
3498 #endif
3499
3500 /* Find the item number SELIDX in pane number PANE. */
3501 i = 0;
3502 while (i < menu_items_used)
3503 {
3504 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3505 {
3506 if (pane == 0)
3507 pane_prefix
3508 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3509 pane--;
3510 i += MENU_ITEMS_PANE_LENGTH;
3511 }
3512 else
3513 {
3514 if (pane == -1)
3515 {
3516 if (selidx == 0)
3517 {
3518 entry
3519 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
3520 if (keymaps != 0)
3521 {
3522 entry = Fcons (entry, Qnil);
3523 if (!NILP (pane_prefix))
3524 entry = Fcons (pane_prefix, entry);
3525 }
3526 break;
3527 }
3528 selidx--;
3529 }
3530 i += MENU_ITEMS_ITEM_LENGTH;
3531 }
3532 }
3533 break;
3534
3535 case XM_FAILURE:
3536 *error = "Can't activate menu";
3537 case XM_IA_SELECT:
3538 entry = Qnil;
3539 break;
3540 case XM_NO_SELECT:
3541 /* Make "Cancel" equivalent to C-g unless FOR_CLICK (which means
3542 the menu was invoked with a mouse event as POSITION). */
3543 if (! for_click)
3544 Fsignal (Qquit, Qnil);
3545 entry = Qnil;
3546 break;
3547 }
3548
3549 unbind_to (specpdl_count, Qnil);
3550
3551 return entry;
3552 }
3553
3554 #endif /* not USE_X_TOOLKIT */
3555
3556 #endif /* HAVE_MENUS */
3557 \f
3558 void
3559 syms_of_xmenu ()
3560 {
3561 staticpro (&menu_items);
3562 menu_items = Qnil;
3563 menu_items_inuse = Qnil;
3564
3565 Qdebug_on_next_call = intern ("debug-on-next-call");
3566 staticpro (&Qdebug_on_next_call);
3567
3568 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
3569 doc: /* Frame for which we are updating a menu.
3570 The enable predicate for a menu command should check this variable. */);
3571 Vmenu_updating_frame = Qnil;
3572
3573 #ifdef USE_X_TOOLKIT
3574 widget_id_tick = (1<<16);
3575 next_menubar_widget_id = 1;
3576 #endif
3577
3578 defsubr (&Sx_popup_menu);
3579 #ifdef HAVE_MENUS
3580 defsubr (&Sx_popup_dialog);
3581 #endif
3582 }
3583
3584 /* arch-tag: 92ea573c-398e-496e-ac73-2436f7d63242
3585 (do not change this comment) */