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