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