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