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