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