* xmenu.c (menubar_selection_callback): Force out GTK buffered
[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 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 (gtk_events_pending ())
1468 gtk_main_iteration ();
1469 while (i < menu_bar_items_used)
1470 {
1471 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1472 {
1473 subprefix_stack[submenu_depth++] = prefix;
1474 prefix = entry;
1475 i++;
1476 }
1477 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1478 {
1479 prefix = subprefix_stack[--submenu_depth];
1480 i++;
1481 }
1482 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1483 {
1484 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1485 i += MENU_ITEMS_PANE_LENGTH;
1486 }
1487 else
1488 {
1489 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1490 /* The EMACS_INT cast avoids a warning. There's no problem
1491 as long as pointers have enough bits to hold small integers. */
1492 if ((int) (EMACS_INT) client_data == i)
1493 {
1494 int j;
1495 struct input_event buf;
1496 Lisp_Object frame;
1497 EVENT_INIT (buf);
1498
1499 XSETFRAME (frame, f);
1500 buf.kind = MENU_BAR_EVENT;
1501 buf.frame_or_window = frame;
1502 buf.arg = frame;
1503 kbd_buffer_store_event (&buf);
1504
1505 for (j = 0; j < submenu_depth; j++)
1506 if (!NILP (subprefix_stack[j]))
1507 {
1508 buf.kind = MENU_BAR_EVENT;
1509 buf.frame_or_window = frame;
1510 buf.arg = subprefix_stack[j];
1511 kbd_buffer_store_event (&buf);
1512 }
1513
1514 if (!NILP (prefix))
1515 {
1516 buf.kind = MENU_BAR_EVENT;
1517 buf.frame_or_window = frame;
1518 buf.arg = prefix;
1519 kbd_buffer_store_event (&buf);
1520 }
1521
1522 buf.kind = MENU_BAR_EVENT;
1523 buf.frame_or_window = frame;
1524 buf.arg = entry;
1525 kbd_buffer_store_event (&buf);
1526
1527 return;
1528 }
1529 i += MENU_ITEMS_ITEM_LENGTH;
1530 }
1531 }
1532 }
1533
1534
1535 #ifdef USE_GTK
1536 /* Gtk calls callbacks just because we tell it what item should be
1537 selected in a radio group. If this variable is set to a non-zero
1538 value, we are creating menus and don't want callbacks right now.
1539 */
1540 static int xg_crazy_callback_abort;
1541
1542 /* This callback is called from the menu bar pulldown menu
1543 when the user makes a selection.
1544 Figure out what the user chose
1545 and put the appropriate events into the keyboard buffer. */
1546 static void
1547 menubar_selection_callback (widget, client_data)
1548 GtkWidget *widget;
1549 gpointer client_data;
1550 {
1551 xg_menu_item_cb_data *cb_data = (xg_menu_item_cb_data*) client_data;
1552
1553 if (xg_crazy_callback_abort)
1554 return;
1555
1556 if (! cb_data || ! cb_data->cl_data || ! cb_data->cl_data->f)
1557 return;
1558
1559 /* When a menu is popped down, X generates a focus event (i.e. focus
1560 goes back to the frame below the menu). Since GTK buffers events,
1561 we force it out here before the menu selection event. Otherwise
1562 sit-for will exit at once if the focus event follows the menu selection
1563 event. */
1564
1565 BLOCK_INPUT;
1566 while (gtk_events_pending ())
1567 gtk_main_iteration ();
1568 UNBLOCK_INPUT;
1569
1570 find_and_call_menu_selection (cb_data->cl_data->f,
1571 cb_data->cl_data->menu_bar_items_used,
1572 cb_data->cl_data->menu_bar_vector,
1573 cb_data->call_data);
1574 }
1575
1576 #else /* not USE_GTK */
1577
1578 /* This callback is called from the menu bar pulldown menu
1579 when the user makes a selection.
1580 Figure out what the user chose
1581 and put the appropriate events into the keyboard buffer. */
1582 static void
1583 menubar_selection_callback (widget, id, client_data)
1584 Widget widget;
1585 LWLIB_ID id;
1586 XtPointer client_data;
1587 {
1588 FRAME_PTR f;
1589
1590 f = menubar_id_to_frame (id);
1591 if (!f)
1592 return;
1593 find_and_call_menu_selection (f, f->menu_bar_items_used,
1594 f->menu_bar_vector, client_data);
1595 }
1596 #endif /* not USE_GTK */
1597
1598 /* Allocate a widget_value, blocking input. */
1599
1600 widget_value *
1601 xmalloc_widget_value ()
1602 {
1603 widget_value *value;
1604
1605 BLOCK_INPUT;
1606 value = malloc_widget_value ();
1607 UNBLOCK_INPUT;
1608
1609 return value;
1610 }
1611
1612 /* This recursively calls free_widget_value on the tree of widgets.
1613 It must free all data that was malloc'ed for these widget_values.
1614 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1615 must be left alone. */
1616
1617 void
1618 free_menubar_widget_value_tree (wv)
1619 widget_value *wv;
1620 {
1621 if (! wv) return;
1622
1623 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1624
1625 if (wv->contents && (wv->contents != (widget_value*)1))
1626 {
1627 free_menubar_widget_value_tree (wv->contents);
1628 wv->contents = (widget_value *) 0xDEADBEEF;
1629 }
1630 if (wv->next)
1631 {
1632 free_menubar_widget_value_tree (wv->next);
1633 wv->next = (widget_value *) 0xDEADBEEF;
1634 }
1635 BLOCK_INPUT;
1636 free_widget_value (wv);
1637 UNBLOCK_INPUT;
1638 }
1639 \f
1640 /* Set up data in menu_items for a menu bar item
1641 whose event type is ITEM_KEY (with string ITEM_NAME)
1642 and whose contents come from the list of keymaps MAPS. */
1643
1644 static int
1645 parse_single_submenu (item_key, item_name, maps)
1646 Lisp_Object item_key, item_name, maps;
1647 {
1648 Lisp_Object length;
1649 int len;
1650 Lisp_Object *mapvec;
1651 int i;
1652 int top_level_items = 0;
1653
1654 length = Flength (maps);
1655 len = XINT (length);
1656
1657 /* Convert the list MAPS into a vector MAPVEC. */
1658 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1659 for (i = 0; i < len; i++)
1660 {
1661 mapvec[i] = Fcar (maps);
1662 maps = Fcdr (maps);
1663 }
1664
1665 /* Loop over the given keymaps, making a pane for each map.
1666 But don't make a pane that is empty--ignore that map instead. */
1667 for (i = 0; i < len; i++)
1668 {
1669 if (!KEYMAPP (mapvec[i]))
1670 {
1671 /* Here we have a command at top level in the menu bar
1672 as opposed to a submenu. */
1673 top_level_items = 1;
1674 push_menu_pane (Qnil, Qnil);
1675 push_menu_item (item_name, Qt, item_key, mapvec[i],
1676 Qnil, Qnil, Qnil, Qnil);
1677 }
1678 else
1679 {
1680 Lisp_Object prompt;
1681 prompt = Fkeymap_prompt (mapvec[i]);
1682 single_keymap_panes (mapvec[i],
1683 !NILP (prompt) ? prompt : item_name,
1684 item_key, 0, 10);
1685 }
1686 }
1687
1688 return top_level_items;
1689 }
1690
1691 /* Create a tree of widget_value objects
1692 representing the panes and items
1693 in menu_items starting at index START, up to index END. */
1694
1695 static widget_value *
1696 digest_single_submenu (start, end, top_level_items)
1697 int start, end, top_level_items;
1698 {
1699 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1700 int i;
1701 int submenu_depth = 0;
1702 widget_value **submenu_stack;
1703
1704 submenu_stack
1705 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1706 wv = xmalloc_widget_value ();
1707 wv->name = "menu";
1708 wv->value = 0;
1709 wv->enabled = 1;
1710 wv->button_type = BUTTON_TYPE_NONE;
1711 wv->help = Qnil;
1712 first_wv = wv;
1713 save_wv = 0;
1714 prev_wv = 0;
1715
1716 /* Loop over all panes and items made by the preceding call
1717 to parse_single_submenu and construct a tree of widget_value objects.
1718 Ignore the panes and items used by previous calls to
1719 digest_single_submenu, even though those are also in menu_items. */
1720 i = start;
1721 while (i < end)
1722 {
1723 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1724 {
1725 submenu_stack[submenu_depth++] = save_wv;
1726 save_wv = prev_wv;
1727 prev_wv = 0;
1728 i++;
1729 }
1730 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1731 {
1732 prev_wv = save_wv;
1733 save_wv = submenu_stack[--submenu_depth];
1734 i++;
1735 }
1736 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1737 && submenu_depth != 0)
1738 i += MENU_ITEMS_PANE_LENGTH;
1739 /* Ignore a nil in the item list.
1740 It's meaningful only for dialog boxes. */
1741 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1742 i += 1;
1743 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1744 {
1745 /* Create a new pane. */
1746 Lisp_Object pane_name, prefix;
1747 char *pane_string;
1748
1749 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1750 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1751
1752 #ifndef HAVE_MULTILINGUAL_MENU
1753 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1754 {
1755 pane_name = ENCODE_SYSTEM (pane_name);
1756 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1757 }
1758 #endif
1759 pane_string = (NILP (pane_name)
1760 ? "" : (char *) SDATA (pane_name));
1761 /* If there is just one top-level pane, put all its items directly
1762 under the top-level menu. */
1763 if (menu_items_n_panes == 1)
1764 pane_string = "";
1765
1766 /* If the pane has a meaningful name,
1767 make the pane a top-level menu item
1768 with its items as a submenu beneath it. */
1769 if (strcmp (pane_string, ""))
1770 {
1771 wv = xmalloc_widget_value ();
1772 if (save_wv)
1773 save_wv->next = wv;
1774 else
1775 first_wv->contents = wv;
1776 wv->lname = pane_name;
1777 /* Set value to 1 so update_submenu_strings can handle '@' */
1778 wv->value = (char *)1;
1779 wv->enabled = 1;
1780 wv->button_type = BUTTON_TYPE_NONE;
1781 wv->help = Qnil;
1782 }
1783 save_wv = wv;
1784 prev_wv = 0;
1785 i += MENU_ITEMS_PANE_LENGTH;
1786 }
1787 else
1788 {
1789 /* Create a new item within current pane. */
1790 Lisp_Object item_name, enable, descrip, def, type, selected;
1791 Lisp_Object help;
1792
1793 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1794 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1795 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1796 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1797 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1798 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1799 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1800
1801 #ifndef HAVE_MULTILINGUAL_MENU
1802 if (STRING_MULTIBYTE (item_name))
1803 {
1804 item_name = ENCODE_MENU_STRING (item_name);
1805 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1806 }
1807
1808 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1809 {
1810 descrip = ENCODE_MENU_STRING (descrip);
1811 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1812 }
1813 #endif /* not HAVE_MULTILINGUAL_MENU */
1814
1815 wv = xmalloc_widget_value ();
1816 if (prev_wv)
1817 prev_wv->next = wv;
1818 else
1819 save_wv->contents = wv;
1820
1821 wv->lname = item_name;
1822 if (!NILP (descrip))
1823 wv->lkey = descrip;
1824 wv->value = 0;
1825 /* The EMACS_INT cast avoids a warning. There's no problem
1826 as long as pointers have enough bits to hold small integers. */
1827 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1828 wv->enabled = !NILP (enable);
1829
1830 if (NILP (type))
1831 wv->button_type = BUTTON_TYPE_NONE;
1832 else if (EQ (type, QCradio))
1833 wv->button_type = BUTTON_TYPE_RADIO;
1834 else if (EQ (type, QCtoggle))
1835 wv->button_type = BUTTON_TYPE_TOGGLE;
1836 else
1837 abort ();
1838
1839 wv->selected = !NILP (selected);
1840 if (! STRINGP (help))
1841 help = Qnil;
1842
1843 wv->help = help;
1844
1845 prev_wv = wv;
1846
1847 i += MENU_ITEMS_ITEM_LENGTH;
1848 }
1849 }
1850
1851 /* If we have just one "menu item"
1852 that was originally a button, return it by itself. */
1853 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1854 {
1855 wv = first_wv->contents;
1856 free_widget_value (first_wv);
1857 return wv;
1858 }
1859
1860 return first_wv;
1861 }
1862
1863 /* Walk through the widget_value tree starting at FIRST_WV and update
1864 the char * pointers from the corresponding lisp values.
1865 We do this after building the whole tree, since GC may happen while the
1866 tree is constructed, and small strings are relocated. So we must wait
1867 until no GC can happen before storing pointers into lisp values. */
1868 static void
1869 update_submenu_strings (first_wv)
1870 widget_value *first_wv;
1871 {
1872 widget_value *wv;
1873
1874 for (wv = first_wv; wv; wv = wv->next)
1875 {
1876 if (STRINGP (wv->lname))
1877 {
1878 wv->name = SDATA (wv->lname);
1879
1880 /* Ignore the @ that means "separate pane".
1881 This is a kludge, but this isn't worth more time. */
1882 if (wv->value == (char *)1)
1883 {
1884 if (wv->name[0] == '@')
1885 wv->name++;
1886 wv->value = 0;
1887 }
1888 }
1889
1890 if (STRINGP (wv->lkey))
1891 wv->key = SDATA (wv->lkey);
1892
1893 if (wv->contents)
1894 update_submenu_strings (wv->contents);
1895 }
1896 }
1897
1898 \f
1899 /* Recompute all the widgets of frame F, when the menu bar has been
1900 changed. Value is non-zero if widgets were updated. */
1901
1902 static int
1903 update_frame_menubar (f)
1904 FRAME_PTR f;
1905 {
1906 #ifdef USE_GTK
1907 return xg_update_frame_menubar (f);
1908 #else
1909 struct x_output *x = f->output_data.x;
1910 int columns, rows;
1911
1912 if (!x->menubar_widget || XtIsManaged (x->menubar_widget))
1913 return 0;
1914
1915 BLOCK_INPUT;
1916 /* Save the size of the frame because the pane widget doesn't accept
1917 to resize itself. So force it. */
1918 columns = FRAME_COLS (f);
1919 rows = FRAME_LINES (f);
1920
1921 /* Do the voodoo which means "I'm changing lots of things, don't try
1922 to refigure sizes until I'm done." */
1923 lw_refigure_widget (x->column_widget, False);
1924
1925 /* The order in which children are managed is the top to bottom
1926 order in which they are displayed in the paned window. First,
1927 remove the text-area widget. */
1928 XtUnmanageChild (x->edit_widget);
1929
1930 /* Remove the menubar that is there now, and put up the menubar that
1931 should be there. */
1932 XtManageChild (x->menubar_widget);
1933 XtMapWidget (x->menubar_widget);
1934 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, NULL);
1935
1936 /* Re-manage the text-area widget, and then thrash the sizes. */
1937 XtManageChild (x->edit_widget);
1938 lw_refigure_widget (x->column_widget, True);
1939
1940 /* Force the pane widget to resize itself with the right values. */
1941 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1942 UNBLOCK_INPUT;
1943 #endif
1944 return 1;
1945 }
1946
1947 /* Set the contents of the menubar widgets of frame F.
1948 The argument FIRST_TIME is currently ignored;
1949 it is set the first time this is called, from initialize_frame_menubar. */
1950
1951 void
1952 set_frame_menubar (f, first_time, deep_p)
1953 FRAME_PTR f;
1954 int first_time;
1955 int deep_p;
1956 {
1957 xt_or_gtk_widget menubar_widget = f->output_data.x->menubar_widget;
1958 #ifdef USE_X_TOOLKIT
1959 LWLIB_ID id;
1960 #endif
1961 Lisp_Object items;
1962 widget_value *wv, *first_wv, *prev_wv = 0;
1963 int i, last_i = 0;
1964 int *submenu_start, *submenu_end;
1965 int *submenu_top_level_items, *submenu_n_panes;
1966
1967
1968 XSETFRAME (Vmenu_updating_frame, f);
1969
1970 #ifdef USE_X_TOOLKIT
1971 if (f->output_data.x->id == 0)
1972 f->output_data.x->id = next_menubar_widget_id++;
1973 id = f->output_data.x->id;
1974 #endif
1975
1976 if (! menubar_widget)
1977 deep_p = 1;
1978 else if (pending_menu_activation && !deep_p)
1979 deep_p = 1;
1980 /* Make the first call for any given frame always go deep. */
1981 else if (!f->output_data.x->saved_menu_event && !deep_p)
1982 {
1983 deep_p = 1;
1984 f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent));
1985 f->output_data.x->saved_menu_event->type = 0;
1986 }
1987
1988 #ifdef USE_GTK
1989 /* If we have detached menus, we must update deep so detached menus
1990 also gets updated. */
1991 deep_p = deep_p || xg_have_tear_offs ();
1992 #endif
1993
1994 if (deep_p)
1995 {
1996 /* Make a widget-value tree representing the entire menu trees. */
1997
1998 struct buffer *prev = current_buffer;
1999 Lisp_Object buffer;
2000 int specpdl_count = SPECPDL_INDEX ();
2001 int previous_menu_items_used = f->menu_bar_items_used;
2002 Lisp_Object *previous_items
2003 = (Lisp_Object *) alloca (previous_menu_items_used
2004 * sizeof (Lisp_Object));
2005
2006 /* If we are making a new widget, its contents are empty,
2007 do always reinitialize them. */
2008 if (! menubar_widget)
2009 previous_menu_items_used = 0;
2010
2011 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
2012 specbind (Qinhibit_quit, Qt);
2013 /* Don't let the debugger step into this code
2014 because it is not reentrant. */
2015 specbind (Qdebug_on_next_call, Qnil);
2016
2017 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
2018 record_unwind_protect (unuse_menu_items, Qnil);
2019 if (NILP (Voverriding_local_map_menu_flag))
2020 {
2021 specbind (Qoverriding_terminal_local_map, Qnil);
2022 specbind (Qoverriding_local_map, Qnil);
2023 }
2024
2025 set_buffer_internal_1 (XBUFFER (buffer));
2026
2027 /* Run the Lucid hook. */
2028 safe_run_hooks (Qactivate_menubar_hook);
2029
2030 /* If it has changed current-menubar from previous value,
2031 really recompute the menubar from the value. */
2032 if (! NILP (Vlucid_menu_bar_dirty_flag))
2033 call0 (Qrecompute_lucid_menubar);
2034 safe_run_hooks (Qmenu_bar_update_hook);
2035 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
2036
2037 items = FRAME_MENU_BAR_ITEMS (f);
2038
2039 /* Save the frame's previous menu bar contents data. */
2040 if (previous_menu_items_used)
2041 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
2042 previous_menu_items_used * sizeof (Lisp_Object));
2043
2044 /* Fill in menu_items with the current menu bar contents.
2045 This can evaluate Lisp code. */
2046 menu_items = f->menu_bar_vector;
2047 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
2048 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
2049 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
2050 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
2051 submenu_top_level_items
2052 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
2053 init_menu_items ();
2054 for (i = 0; i < XVECTOR (items)->size; i += 4)
2055 {
2056 Lisp_Object key, string, maps;
2057
2058 last_i = i;
2059
2060 key = XVECTOR (items)->contents[i];
2061 string = XVECTOR (items)->contents[i + 1];
2062 maps = XVECTOR (items)->contents[i + 2];
2063 if (NILP (string))
2064 break;
2065
2066 submenu_start[i] = menu_items_used;
2067
2068 menu_items_n_panes = 0;
2069 submenu_top_level_items[i]
2070 = parse_single_submenu (key, string, maps);
2071 submenu_n_panes[i] = menu_items_n_panes;
2072
2073 submenu_end[i] = menu_items_used;
2074 }
2075
2076 finish_menu_items ();
2077
2078 /* Convert menu_items into widget_value trees
2079 to display the menu. This cannot evaluate Lisp code. */
2080
2081 wv = xmalloc_widget_value ();
2082 wv->name = "menubar";
2083 wv->value = 0;
2084 wv->enabled = 1;
2085 wv->button_type = BUTTON_TYPE_NONE;
2086 wv->help = Qnil;
2087 first_wv = wv;
2088
2089 for (i = 0; i < last_i; i += 4)
2090 {
2091 menu_items_n_panes = submenu_n_panes[i];
2092 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
2093 submenu_top_level_items[i]);
2094 if (prev_wv)
2095 prev_wv->next = wv;
2096 else
2097 first_wv->contents = wv;
2098 /* Don't set wv->name here; GC during the loop might relocate it. */
2099 wv->enabled = 1;
2100 wv->button_type = BUTTON_TYPE_NONE;
2101 prev_wv = wv;
2102 }
2103
2104 set_buffer_internal_1 (prev);
2105 unbind_to (specpdl_count, Qnil);
2106
2107 /* If there has been no change in the Lisp-level contents
2108 of the menu bar, skip redisplaying it. Just exit. */
2109
2110 for (i = 0; i < previous_menu_items_used; i++)
2111 if (menu_items_used == i
2112 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
2113 break;
2114 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
2115 {
2116 free_menubar_widget_value_tree (first_wv);
2117 discard_menu_items ();
2118
2119 return;
2120 }
2121
2122 /* Now GC cannot happen during the lifetime of the widget_value,
2123 so it's safe to store data from a Lisp_String. */
2124 wv = first_wv->contents;
2125 for (i = 0; i < XVECTOR (items)->size; i += 4)
2126 {
2127 Lisp_Object string;
2128 string = XVECTOR (items)->contents[i + 1];
2129 if (NILP (string))
2130 break;
2131 wv->name = (char *) SDATA (string);
2132 update_submenu_strings (wv->contents);
2133 wv = wv->next;
2134 }
2135
2136 f->menu_bar_vector = menu_items;
2137 f->menu_bar_items_used = menu_items_used;
2138 discard_menu_items ();
2139 }
2140 else
2141 {
2142 /* Make a widget-value tree containing
2143 just the top level menu bar strings. */
2144
2145 wv = xmalloc_widget_value ();
2146 wv->name = "menubar";
2147 wv->value = 0;
2148 wv->enabled = 1;
2149 wv->button_type = BUTTON_TYPE_NONE;
2150 wv->help = Qnil;
2151 first_wv = wv;
2152
2153 items = FRAME_MENU_BAR_ITEMS (f);
2154 for (i = 0; i < XVECTOR (items)->size; i += 4)
2155 {
2156 Lisp_Object string;
2157
2158 string = XVECTOR (items)->contents[i + 1];
2159 if (NILP (string))
2160 break;
2161
2162 wv = xmalloc_widget_value ();
2163 wv->name = (char *) SDATA (string);
2164 wv->value = 0;
2165 wv->enabled = 1;
2166 wv->button_type = BUTTON_TYPE_NONE;
2167 wv->help = Qnil;
2168 /* This prevents lwlib from assuming this
2169 menu item is really supposed to be empty. */
2170 /* The EMACS_INT cast avoids a warning.
2171 This value just has to be different from small integers. */
2172 wv->call_data = (void *) (EMACS_INT) (-1);
2173
2174 if (prev_wv)
2175 prev_wv->next = wv;
2176 else
2177 first_wv->contents = wv;
2178 prev_wv = wv;
2179 }
2180
2181 /* Forget what we thought we knew about what is in the
2182 detailed contents of the menu bar menus.
2183 Changing the top level always destroys the contents. */
2184 f->menu_bar_items_used = 0;
2185 }
2186
2187 /* Create or update the menu bar widget. */
2188
2189 BLOCK_INPUT;
2190
2191 #ifdef USE_GTK
2192 xg_crazy_callback_abort = 1;
2193 if (menubar_widget)
2194 {
2195 /* The fourth arg is DEEP_P, which says to consider the entire
2196 menu trees we supply, rather than just the menu bar item names. */
2197 xg_modify_menubar_widgets (menubar_widget,
2198 f,
2199 first_wv,
2200 deep_p,
2201 G_CALLBACK (menubar_selection_callback),
2202 G_CALLBACK (popup_deactivate_callback),
2203 G_CALLBACK (menu_highlight_callback));
2204 }
2205 else
2206 {
2207 GtkWidget *wvbox = f->output_data.x->vbox_widget;
2208
2209 menubar_widget
2210 = xg_create_widget ("menubar", "menubar", f, first_wv,
2211 G_CALLBACK (menubar_selection_callback),
2212 G_CALLBACK (popup_deactivate_callback),
2213 G_CALLBACK (menu_highlight_callback));
2214
2215 f->output_data.x->menubar_widget = menubar_widget;
2216 }
2217
2218
2219 #else /* not USE_GTK */
2220 if (menubar_widget)
2221 {
2222 /* Disable resizing (done for Motif!) */
2223 lw_allow_resizing (f->output_data.x->widget, False);
2224
2225 /* The third arg is DEEP_P, which says to consider the entire
2226 menu trees we supply, rather than just the menu bar item names. */
2227 lw_modify_all_widgets (id, first_wv, deep_p);
2228
2229 /* Re-enable the edit widget to resize. */
2230 lw_allow_resizing (f->output_data.x->widget, True);
2231 }
2232 else
2233 {
2234 char menuOverride[] = "Ctrl<KeyPress>g: MenuGadgetEscape()";
2235 XtTranslations override = XtParseTranslationTable (menuOverride);
2236
2237 menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv,
2238 f->output_data.x->column_widget,
2239 0,
2240 popup_activate_callback,
2241 menubar_selection_callback,
2242 popup_deactivate_callback,
2243 menu_highlight_callback);
2244 f->output_data.x->menubar_widget = menubar_widget;
2245
2246 /* Make menu pop down on C-g. */
2247 XtOverrideTranslations (menubar_widget, override);
2248 }
2249
2250 {
2251 int menubar_size
2252 = (f->output_data.x->menubar_widget
2253 ? (f->output_data.x->menubar_widget->core.height
2254 + f->output_data.x->menubar_widget->core.border_width)
2255 : 0);
2256
2257 #if 0 /* Experimentally, we now get the right results
2258 for -geometry -0-0 without this. 24 Aug 96, rms. */
2259 #ifdef USE_LUCID
2260 if (FRAME_EXTERNAL_MENU_BAR (f))
2261 {
2262 Dimension ibw = 0;
2263 XtVaGetValues (f->output_data.x->column_widget,
2264 XtNinternalBorderWidth, &ibw, NULL);
2265 menubar_size += ibw;
2266 }
2267 #endif /* USE_LUCID */
2268 #endif /* 0 */
2269
2270 f->output_data.x->menubar_height = menubar_size;
2271 }
2272 #endif /* not USE_GTK */
2273
2274 free_menubar_widget_value_tree (first_wv);
2275 update_frame_menubar (f);
2276
2277 #ifdef USE_GTK
2278 xg_crazy_callback_abort = 0;
2279 #endif
2280
2281 UNBLOCK_INPUT;
2282 }
2283
2284 /* Called from Fx_create_frame to create the initial menubar of a frame
2285 before it is mapped, so that the window is mapped with the menubar already
2286 there instead of us tacking it on later and thrashing the window after it
2287 is visible. */
2288
2289 void
2290 initialize_frame_menubar (f)
2291 FRAME_PTR f;
2292 {
2293 /* This function is called before the first chance to redisplay
2294 the frame. It has to be, so the frame will have the right size. */
2295 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
2296 set_frame_menubar (f, 1, 1);
2297 }
2298
2299
2300 /* Get rid of the menu bar of frame F, and free its storage.
2301 This is used when deleting a frame, and when turning off the menu bar.
2302 For GTK this function is in gtkutil.c. */
2303
2304 #ifndef USE_GTK
2305 void
2306 free_frame_menubar (f)
2307 FRAME_PTR f;
2308 {
2309 Widget menubar_widget;
2310
2311 menubar_widget = f->output_data.x->menubar_widget;
2312
2313 f->output_data.x->menubar_height = 0;
2314
2315 if (menubar_widget)
2316 {
2317 #ifdef USE_MOTIF
2318 /* Removing the menu bar magically changes the shell widget's x
2319 and y position of (0, 0) which, when the menu bar is turned
2320 on again, leads to pull-down menuss appearing in strange
2321 positions near the upper-left corner of the display. This
2322 happens only with some window managers like twm and ctwm,
2323 but not with other like Motif's mwm or kwm, because the
2324 latter generate ConfigureNotify events when the menu bar
2325 is switched off, which fixes the shell position. */
2326 Position x0, y0, x1, y1;
2327 #endif
2328
2329 BLOCK_INPUT;
2330
2331 #ifdef USE_MOTIF
2332 if (f->output_data.x->widget)
2333 XtVaGetValues (f->output_data.x->widget, XtNx, &x0, XtNy, &y0, NULL);
2334 #endif
2335
2336 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
2337 f->output_data.x->menubar_widget = NULL;
2338
2339 #ifdef USE_MOTIF
2340 if (f->output_data.x->widget)
2341 {
2342 XtVaGetValues (f->output_data.x->widget, XtNx, &x1, XtNy, &y1, NULL);
2343 if (x1 == 0 && y1 == 0)
2344 XtVaSetValues (f->output_data.x->widget, XtNx, x0, XtNy, y0, NULL);
2345 }
2346 #endif
2347
2348 UNBLOCK_INPUT;
2349 }
2350 }
2351 #endif /* not USE_GTK */
2352
2353 #endif /* USE_X_TOOLKIT || USE_GTK */
2354 \f
2355 /* xmenu_show actually displays a menu using the panes and items in menu_items
2356 and returns the value selected from it.
2357 There are two versions of xmenu_show, one for Xt and one for Xlib.
2358 Both assume input is blocked by the caller. */
2359
2360 /* F is the frame the menu is for.
2361 X and Y are the frame-relative specified position,
2362 relative to the inside upper left corner of the frame F.
2363 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
2364 KEYMAPS is 1 if this menu was specified with keymaps;
2365 in that case, we return a list containing the chosen item's value
2366 and perhaps also the pane's prefix.
2367 TITLE is the specified menu title.
2368 ERROR is a place to store an error message string in case of failure.
2369 (We return nil on failure, but the value doesn't actually matter.) */
2370
2371 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
2372
2373 /* The item selected in the popup menu. */
2374 static Lisp_Object *volatile menu_item_selection;
2375
2376 #ifdef USE_GTK
2377
2378 /* Used when position a popup menu. See menu_position_func and
2379 create_and_show_popup_menu below. */
2380 struct next_popup_x_y
2381 {
2382 FRAME_PTR f;
2383 int x;
2384 int y;
2385 };
2386
2387 /* The menu position function to use if we are not putting a popup
2388 menu where the pointer is.
2389 MENU is the menu to pop up.
2390 X and Y shall on exit contain x/y where the menu shall pop up.
2391 PUSH_IN is not documented in the GTK manual.
2392 USER_DATA is any data passed in when calling gtk_menu_popup.
2393 Here it points to a struct next_popup_x_y where the coordinates
2394 to store in *X and *Y are as well as the frame for the popup.
2395
2396 Here only X and Y are used. */
2397 static void
2398 menu_position_func (menu, x, y, push_in, user_data)
2399 GtkMenu *menu;
2400 gint *x;
2401 gint *y;
2402 gboolean *push_in;
2403 gpointer user_data;
2404 {
2405 struct next_popup_x_y* data = (struct next_popup_x_y*)user_data;
2406 GtkRequisition req;
2407 int disp_width = FRAME_X_DISPLAY_INFO (data->f)->width;
2408 int disp_height = FRAME_X_DISPLAY_INFO (data->f)->height;
2409
2410 *x = data->x;
2411 *y = data->y;
2412
2413 /* Check if there is room for the menu. If not, adjust x/y so that
2414 the menu is fully visible. */
2415 gtk_widget_size_request (GTK_WIDGET (menu), &req);
2416 if (data->x + req.width > disp_width)
2417 *x -= data->x + req.width - disp_width;
2418 if (data->y + req.height > disp_height)
2419 *y -= data->y + req.height - disp_height;
2420 }
2421
2422 static void
2423 popup_selection_callback (widget, client_data)
2424 GtkWidget *widget;
2425 gpointer client_data;
2426 {
2427 xg_menu_item_cb_data *cb_data = (xg_menu_item_cb_data*) client_data;
2428
2429 if (xg_crazy_callback_abort) return;
2430 if (cb_data) menu_item_selection = (Lisp_Object *) cb_data->call_data;
2431 }
2432
2433 static Lisp_Object
2434 pop_down_menu (arg)
2435 Lisp_Object arg;
2436 {
2437 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
2438
2439 popup_activated_flag = 0;
2440 BLOCK_INPUT;
2441 gtk_widget_destroy (GTK_WIDGET (p->pointer));
2442 UNBLOCK_INPUT;
2443 return Qnil;
2444 }
2445
2446 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
2447 menu pops down.
2448 menu_item_selection will be set to the selection. */
2449 static void
2450 create_and_show_popup_menu (f, first_wv, x, y, for_click)
2451 FRAME_PTR f;
2452 widget_value *first_wv;
2453 int x;
2454 int y;
2455 int for_click;
2456 {
2457 int i;
2458 GtkWidget *menu;
2459 GtkMenuPositionFunc pos_func = 0; /* Pop up at pointer. */
2460 struct next_popup_x_y popup_x_y;
2461 int specpdl_count = SPECPDL_INDEX ();
2462
2463 xg_crazy_callback_abort = 1;
2464 menu = xg_create_widget ("popup", first_wv->name, f, first_wv,
2465 G_CALLBACK (popup_selection_callback),
2466 G_CALLBACK (popup_deactivate_callback),
2467 G_CALLBACK (menu_highlight_callback));
2468 xg_crazy_callback_abort = 0;
2469
2470 if (! for_click)
2471 {
2472 /* Not invoked by a click. pop up at x/y. */
2473 pos_func = menu_position_func;
2474
2475 /* Adjust coordinates to be root-window-relative. */
2476 x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2477 y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2478
2479 popup_x_y.x = x;
2480 popup_x_y.y = y;
2481 popup_x_y.f = f;
2482
2483 i = 0; /* gtk_menu_popup needs this to be 0 for a non-button popup. */
2484 }
2485 else
2486 {
2487 for (i = 0; i < 5; i++)
2488 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2489 break;
2490 }
2491
2492 /* Display the menu. */
2493 gtk_widget_show_all (menu);
2494 gtk_menu_popup (GTK_MENU (menu), 0, 0, pos_func, &popup_x_y, i, 0);
2495
2496 record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
2497
2498 /* Set this to one. popup_widget_loop increases it by one, so it becomes
2499 two. show_help_echo uses this to detect popup menus. */
2500 popup_activated_flag = 1;
2501 /* Process events that apply to the menu. */
2502 popup_widget_loop (1, menu);
2503
2504 unbind_to (specpdl_count, Qnil);
2505
2506 /* Must reset this manually because the button release event is not passed
2507 to Emacs event loop. */
2508 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
2509 }
2510
2511 #else /* not USE_GTK */
2512
2513 /* We need a unique id for each widget handled by the Lucid Widget
2514 library.
2515
2516 For the main windows, and popup menus, we use this counter,
2517 which we increment each time after use. This starts from 1<<16.
2518
2519 For menu bars, we use numbers starting at 0, counted in
2520 next_menubar_widget_id. */
2521 LWLIB_ID widget_id_tick;
2522
2523 static void
2524 popup_selection_callback (widget, id, client_data)
2525 Widget widget;
2526 LWLIB_ID id;
2527 XtPointer client_data;
2528 {
2529 menu_item_selection = (Lisp_Object *) client_data;
2530 }
2531
2532 /* ARG is the LWLIB ID of the dialog box, represented
2533 as a Lisp object as (HIGHPART . LOWPART). */
2534
2535 static Lisp_Object
2536 pop_down_menu (arg)
2537 Lisp_Object arg;
2538 {
2539 LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID)
2540 | XINT (XCDR (arg)));
2541
2542 BLOCK_INPUT;
2543 lw_destroy_all_widgets (id);
2544 UNBLOCK_INPUT;
2545 popup_activated_flag = 0;
2546
2547 return Qnil;
2548 }
2549
2550 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
2551 menu pops down.
2552 menu_item_selection will be set to the selection. */
2553 static void
2554 create_and_show_popup_menu (f, first_wv, x, y, for_click)
2555 FRAME_PTR f;
2556 widget_value *first_wv;
2557 int x;
2558 int y;
2559 int for_click;
2560 {
2561 int i;
2562 Arg av[2];
2563 int ac = 0;
2564 XButtonPressedEvent dummy;
2565 LWLIB_ID menu_id;
2566 Widget menu;
2567
2568 menu_id = widget_id_tick++;
2569 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
2570 f->output_data.x->widget, 1, 0,
2571 popup_selection_callback,
2572 popup_deactivate_callback,
2573 menu_highlight_callback);
2574
2575 dummy.type = ButtonPress;
2576 dummy.serial = 0;
2577 dummy.send_event = 0;
2578 dummy.display = FRAME_X_DISPLAY (f);
2579 dummy.time = CurrentTime;
2580 dummy.root = FRAME_X_DISPLAY_INFO (f)->root_window;
2581 dummy.window = dummy.root;
2582 dummy.subwindow = dummy.root;
2583 dummy.x = x;
2584 dummy.y = y;
2585
2586 /* Adjust coordinates to be root-window-relative. */
2587 x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2588 y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2589
2590 dummy.x_root = x;
2591 dummy.y_root = y;
2592
2593 dummy.state = 0;
2594 dummy.button = 0;
2595 for (i = 0; i < 5; i++)
2596 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2597 dummy.button = i;
2598
2599 /* Don't allow any geometry request from the user. */
2600 XtSetArg (av[ac], XtNgeometry, 0); ac++;
2601 XtSetValues (menu, av, ac);
2602
2603 /* Display the menu. */
2604 lw_popup_menu (menu, (XEvent *) &dummy);
2605 popup_activated_flag = 1;
2606
2607 {
2608 int fact = 4 * sizeof (LWLIB_ID);
2609 int specpdl_count = SPECPDL_INDEX ();
2610 record_unwind_protect (pop_down_menu,
2611 Fcons (make_number (menu_id >> (fact)),
2612 make_number (menu_id & ~(-1 << (fact)))));
2613
2614 /* Process events that apply to the menu. */
2615 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 1);
2616
2617 unbind_to (specpdl_count, Qnil);
2618 }
2619 }
2620
2621 #endif /* not USE_GTK */
2622
2623 static Lisp_Object
2624 xmenu_show (f, x, y, for_click, keymaps, title, error)
2625 FRAME_PTR f;
2626 int x;
2627 int y;
2628 int for_click;
2629 int keymaps;
2630 Lisp_Object title;
2631 char **error;
2632 {
2633 int i;
2634 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2635 widget_value **submenu_stack
2636 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
2637 Lisp_Object *subprefix_stack
2638 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
2639 int submenu_depth = 0;
2640
2641 int first_pane;
2642
2643 *error = NULL;
2644
2645 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2646 {
2647 *error = "Empty menu";
2648 return Qnil;
2649 }
2650
2651 /* Create a tree of widget_value objects
2652 representing the panes and their items. */
2653 wv = xmalloc_widget_value ();
2654 wv->name = "menu";
2655 wv->value = 0;
2656 wv->enabled = 1;
2657 wv->button_type = BUTTON_TYPE_NONE;
2658 wv->help =Qnil;
2659 first_wv = wv;
2660 first_pane = 1;
2661
2662 /* Loop over all panes and items, filling in the tree. */
2663 i = 0;
2664 while (i < menu_items_used)
2665 {
2666 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2667 {
2668 submenu_stack[submenu_depth++] = save_wv;
2669 save_wv = prev_wv;
2670 prev_wv = 0;
2671 first_pane = 1;
2672 i++;
2673 }
2674 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2675 {
2676 prev_wv = save_wv;
2677 save_wv = submenu_stack[--submenu_depth];
2678 first_pane = 0;
2679 i++;
2680 }
2681 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
2682 && submenu_depth != 0)
2683 i += MENU_ITEMS_PANE_LENGTH;
2684 /* Ignore a nil in the item list.
2685 It's meaningful only for dialog boxes. */
2686 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2687 i += 1;
2688 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2689 {
2690 /* Create a new pane. */
2691 Lisp_Object pane_name, prefix;
2692 char *pane_string;
2693
2694 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2695 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2696
2697 #ifndef HAVE_MULTILINGUAL_MENU
2698 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
2699 {
2700 pane_name = ENCODE_SYSTEM (pane_name);
2701 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
2702 }
2703 #endif
2704 pane_string = (NILP (pane_name)
2705 ? "" : (char *) SDATA (pane_name));
2706 /* If there is just one top-level pane, put all its items directly
2707 under the top-level menu. */
2708 if (menu_items_n_panes == 1)
2709 pane_string = "";
2710
2711 /* If the pane has a meaningful name,
2712 make the pane a top-level menu item
2713 with its items as a submenu beneath it. */
2714 if (!keymaps && strcmp (pane_string, ""))
2715 {
2716 wv = xmalloc_widget_value ();
2717 if (save_wv)
2718 save_wv->next = wv;
2719 else
2720 first_wv->contents = wv;
2721 wv->name = pane_string;
2722 if (keymaps && !NILP (prefix))
2723 wv->name++;
2724 wv->value = 0;
2725 wv->enabled = 1;
2726 wv->button_type = BUTTON_TYPE_NONE;
2727 wv->help = Qnil;
2728 save_wv = wv;
2729 prev_wv = 0;
2730 }
2731 else if (first_pane)
2732 {
2733 save_wv = wv;
2734 prev_wv = 0;
2735 }
2736 first_pane = 0;
2737 i += MENU_ITEMS_PANE_LENGTH;
2738 }
2739 else
2740 {
2741 /* Create a new item within current pane. */
2742 Lisp_Object item_name, enable, descrip, def, type, selected, help;
2743 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2744 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2745 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2746 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
2747 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
2748 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
2749 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2750
2751 #ifndef HAVE_MULTILINGUAL_MENU
2752 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
2753 {
2754 item_name = ENCODE_MENU_STRING (item_name);
2755 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
2756 }
2757
2758 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
2759 {
2760 descrip = ENCODE_MENU_STRING (descrip);
2761 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
2762 }
2763 #endif /* not HAVE_MULTILINGUAL_MENU */
2764
2765 wv = xmalloc_widget_value ();
2766 if (prev_wv)
2767 prev_wv->next = wv;
2768 else
2769 save_wv->contents = wv;
2770 wv->name = (char *) SDATA (item_name);
2771 if (!NILP (descrip))
2772 wv->key = (char *) SDATA (descrip);
2773 wv->value = 0;
2774 /* If this item has a null value,
2775 make the call_data null so that it won't display a box
2776 when the mouse is on it. */
2777 wv->call_data
2778 = (!NILP (def) ? (void *) &XVECTOR (menu_items)->contents[i] : 0);
2779 wv->enabled = !NILP (enable);
2780
2781 if (NILP (type))
2782 wv->button_type = BUTTON_TYPE_NONE;
2783 else if (EQ (type, QCtoggle))
2784 wv->button_type = BUTTON_TYPE_TOGGLE;
2785 else if (EQ (type, QCradio))
2786 wv->button_type = BUTTON_TYPE_RADIO;
2787 else
2788 abort ();
2789
2790 wv->selected = !NILP (selected);
2791
2792 if (! STRINGP (help))
2793 help = Qnil;
2794
2795 wv->help = help;
2796
2797 prev_wv = wv;
2798
2799 i += MENU_ITEMS_ITEM_LENGTH;
2800 }
2801 }
2802
2803 /* Deal with the title, if it is non-nil. */
2804 if (!NILP (title))
2805 {
2806 widget_value *wv_title = xmalloc_widget_value ();
2807 widget_value *wv_sep1 = xmalloc_widget_value ();
2808 widget_value *wv_sep2 = xmalloc_widget_value ();
2809
2810 wv_sep2->name = "--";
2811 wv_sep2->next = first_wv->contents;
2812 wv_sep2->help = Qnil;
2813
2814 wv_sep1->name = "--";
2815 wv_sep1->next = wv_sep2;
2816 wv_sep1->help = Qnil;
2817
2818 #ifndef HAVE_MULTILINGUAL_MENU
2819 if (STRING_MULTIBYTE (title))
2820 title = ENCODE_MENU_STRING (title);
2821 #endif
2822
2823 wv_title->name = (char *) SDATA (title);
2824 wv_title->enabled = TRUE;
2825 wv_title->button_type = BUTTON_TYPE_NONE;
2826 wv_title->next = wv_sep1;
2827 wv_title->help = Qnil;
2828 first_wv->contents = wv_title;
2829 }
2830
2831 /* No selection has been chosen yet. */
2832 menu_item_selection = 0;
2833
2834 /* Actually create and show the menu until popped down. */
2835 create_and_show_popup_menu (f, first_wv, x, y, for_click);
2836
2837 /* Free the widget_value objects we used to specify the contents. */
2838 free_menubar_widget_value_tree (first_wv);
2839
2840 /* Find the selected item, and its pane, to return
2841 the proper value. */
2842 if (menu_item_selection != 0)
2843 {
2844 Lisp_Object prefix, entry;
2845
2846 prefix = entry = Qnil;
2847 i = 0;
2848 while (i < menu_items_used)
2849 {
2850 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2851 {
2852 subprefix_stack[submenu_depth++] = prefix;
2853 prefix = entry;
2854 i++;
2855 }
2856 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2857 {
2858 prefix = subprefix_stack[--submenu_depth];
2859 i++;
2860 }
2861 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2862 {
2863 prefix
2864 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2865 i += MENU_ITEMS_PANE_LENGTH;
2866 }
2867 /* Ignore a nil in the item list.
2868 It's meaningful only for dialog boxes. */
2869 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2870 i += 1;
2871 else
2872 {
2873 entry
2874 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2875 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2876 {
2877 if (keymaps != 0)
2878 {
2879 int j;
2880
2881 entry = Fcons (entry, Qnil);
2882 if (!NILP (prefix))
2883 entry = Fcons (prefix, entry);
2884 for (j = submenu_depth - 1; j >= 0; j--)
2885 if (!NILP (subprefix_stack[j]))
2886 entry = Fcons (subprefix_stack[j], entry);
2887 }
2888 return entry;
2889 }
2890 i += MENU_ITEMS_ITEM_LENGTH;
2891 }
2892 }
2893 }
2894
2895 return Qnil;
2896 }
2897 \f
2898 #ifdef USE_GTK
2899 static void
2900 dialog_selection_callback (widget, client_data)
2901 GtkWidget *widget;
2902 gpointer client_data;
2903 {
2904 /* The EMACS_INT cast avoids a warning. There's no problem
2905 as long as pointers have enough bits to hold small integers. */
2906 if ((int) (EMACS_INT) client_data != -1)
2907 menu_item_selection = (Lisp_Object *) client_data;
2908
2909 popup_activated_flag = 0;
2910 }
2911
2912 /* Pop up the dialog for frame F defined by FIRST_WV and loop until the
2913 dialog pops down.
2914 menu_item_selection will be set to the selection. */
2915 static void
2916 create_and_show_dialog (f, first_wv)
2917 FRAME_PTR f;
2918 widget_value *first_wv;
2919 {
2920 GtkWidget *menu;
2921
2922 menu = xg_create_widget ("dialog", first_wv->name, f, first_wv,
2923 G_CALLBACK (dialog_selection_callback),
2924 G_CALLBACK (popup_deactivate_callback),
2925 0);
2926
2927 if (menu)
2928 {
2929 int specpdl_count = SPECPDL_INDEX ();
2930 record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
2931
2932 /* Display the menu. */
2933 gtk_widget_show_all (menu);
2934
2935 /* Process events that apply to the menu. */
2936 popup_widget_loop (1, menu);
2937
2938 unbind_to (specpdl_count, Qnil);
2939 }
2940 }
2941
2942 #else /* not USE_GTK */
2943 static void
2944 dialog_selection_callback (widget, id, client_data)
2945 Widget widget;
2946 LWLIB_ID id;
2947 XtPointer client_data;
2948 {
2949 /* The EMACS_INT cast avoids a warning. There's no problem
2950 as long as pointers have enough bits to hold small integers. */
2951 if ((int) (EMACS_INT) client_data != -1)
2952 menu_item_selection = (Lisp_Object *) client_data;
2953
2954 BLOCK_INPUT;
2955 lw_destroy_all_widgets (id);
2956 UNBLOCK_INPUT;
2957 popup_activated_flag = 0;
2958 }
2959
2960
2961 /* Pop up the dialog for frame F defined by FIRST_WV and loop until the
2962 dialog pops down.
2963 menu_item_selection will be set to the selection. */
2964 static void
2965 create_and_show_dialog (f, first_wv)
2966 FRAME_PTR f;
2967 widget_value *first_wv;
2968 {
2969 LWLIB_ID dialog_id;
2970
2971 dialog_id = widget_id_tick++;
2972 lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2973 f->output_data.x->widget, 1, 0,
2974 dialog_selection_callback, 0, 0);
2975 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
2976
2977 /* Display the dialog box. */
2978 lw_pop_up_all_widgets (dialog_id);
2979 popup_activated_flag = 1;
2980
2981 /* Process events that apply to the dialog box.
2982 Also handle timers. */
2983 {
2984 int count = SPECPDL_INDEX ();
2985 int fact = 4 * sizeof (LWLIB_ID);
2986
2987 /* xdialog_show_unwind is responsible for popping the dialog box down. */
2988 record_unwind_protect (pop_down_menu,
2989 Fcons (make_number (dialog_id >> (fact)),
2990 make_number (dialog_id & ~(-1 << (fact)))));
2991
2992 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f),
2993 dialog_id, 1);
2994
2995 unbind_to (count, Qnil);
2996 }
2997 }
2998
2999 #endif /* not USE_GTK */
3000
3001 static char * button_names [] = {
3002 "button1", "button2", "button3", "button4", "button5",
3003 "button6", "button7", "button8", "button9", "button10" };
3004
3005 static Lisp_Object
3006 xdialog_show (f, keymaps, title, error)
3007 FRAME_PTR f;
3008 int keymaps;
3009 Lisp_Object title;
3010 char **error;
3011 {
3012 int i, nb_buttons=0;
3013 char dialog_name[6];
3014
3015 widget_value *wv, *first_wv = 0, *prev_wv = 0;
3016
3017 /* Number of elements seen so far, before boundary. */
3018 int left_count = 0;
3019 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
3020 int boundary_seen = 0;
3021
3022 *error = NULL;
3023
3024 if (menu_items_n_panes > 1)
3025 {
3026 *error = "Multiple panes in dialog box";
3027 return Qnil;
3028 }
3029
3030 /* Create a tree of widget_value objects
3031 representing the text label and buttons. */
3032 {
3033 Lisp_Object pane_name, prefix;
3034 char *pane_string;
3035 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
3036 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
3037 pane_string = (NILP (pane_name)
3038 ? "" : (char *) SDATA (pane_name));
3039 prev_wv = xmalloc_widget_value ();
3040 prev_wv->value = pane_string;
3041 if (keymaps && !NILP (prefix))
3042 prev_wv->name++;
3043 prev_wv->enabled = 1;
3044 prev_wv->name = "message";
3045 prev_wv->help = Qnil;
3046 first_wv = prev_wv;
3047
3048 /* Loop over all panes and items, filling in the tree. */
3049 i = MENU_ITEMS_PANE_LENGTH;
3050 while (i < menu_items_used)
3051 {
3052
3053 /* Create a new item within current pane. */
3054 Lisp_Object item_name, enable, descrip;
3055 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
3056 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
3057 descrip
3058 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
3059
3060 if (NILP (item_name))
3061 {
3062 free_menubar_widget_value_tree (first_wv);
3063 *error = "Submenu in dialog items";
3064 return Qnil;
3065 }
3066 if (EQ (item_name, Qquote))
3067 {
3068 /* This is the boundary between left-side elts
3069 and right-side elts. Stop incrementing right_count. */
3070 boundary_seen = 1;
3071 i++;
3072 continue;
3073 }
3074 if (nb_buttons >= 9)
3075 {
3076 free_menubar_widget_value_tree (first_wv);
3077 *error = "Too many dialog items";
3078 return Qnil;
3079 }
3080
3081 wv = xmalloc_widget_value ();
3082 prev_wv->next = wv;
3083 wv->name = (char *) button_names[nb_buttons];
3084 if (!NILP (descrip))
3085 wv->key = (char *) SDATA (descrip);
3086 wv->value = (char *) SDATA (item_name);
3087 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
3088 wv->enabled = !NILP (enable);
3089 wv->help = Qnil;
3090 prev_wv = wv;
3091
3092 if (! boundary_seen)
3093 left_count++;
3094
3095 nb_buttons++;
3096 i += MENU_ITEMS_ITEM_LENGTH;
3097 }
3098
3099 /* If the boundary was not specified,
3100 by default put half on the left and half on the right. */
3101 if (! boundary_seen)
3102 left_count = nb_buttons - nb_buttons / 2;
3103
3104 wv = xmalloc_widget_value ();
3105 wv->name = dialog_name;
3106 wv->help = Qnil;
3107 /* Dialog boxes use a really stupid name encoding
3108 which specifies how many buttons to use
3109 and how many buttons are on the right.
3110 The Q means something also. */
3111 dialog_name[0] = 'Q';
3112 dialog_name[1] = '0' + nb_buttons;
3113 dialog_name[2] = 'B';
3114 dialog_name[3] = 'R';
3115 /* Number of buttons to put on the right. */
3116 dialog_name[4] = '0' + nb_buttons - left_count;
3117 dialog_name[5] = 0;
3118 wv->contents = first_wv;
3119 first_wv = wv;
3120 }
3121
3122 /* No selection has been chosen yet. */
3123 menu_item_selection = 0;
3124
3125 /* Actually create and show the dialog. */
3126 create_and_show_dialog (f, first_wv);
3127
3128 /* Free the widget_value objects we used to specify the contents. */
3129 free_menubar_widget_value_tree (first_wv);
3130
3131 /* Find the selected item, and its pane, to return
3132 the proper value. */
3133 if (menu_item_selection != 0)
3134 {
3135 Lisp_Object prefix;
3136
3137 prefix = Qnil;
3138 i = 0;
3139 while (i < menu_items_used)
3140 {
3141 Lisp_Object entry;
3142
3143 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3144 {
3145 prefix
3146 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3147 i += MENU_ITEMS_PANE_LENGTH;
3148 }
3149 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
3150 {
3151 /* This is the boundary between left-side elts and
3152 right-side elts. */
3153 ++i;
3154 }
3155 else
3156 {
3157 entry
3158 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
3159 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
3160 {
3161 if (keymaps != 0)
3162 {
3163 entry = Fcons (entry, Qnil);
3164 if (!NILP (prefix))
3165 entry = Fcons (prefix, entry);
3166 }
3167 return entry;
3168 }
3169 i += MENU_ITEMS_ITEM_LENGTH;
3170 }
3171 }
3172 }
3173 else
3174 /* Make "Cancel" equivalent to C-g. */
3175 Fsignal (Qquit, Qnil);
3176
3177 return Qnil;
3178 }
3179
3180 #else /* not USE_X_TOOLKIT && not USE_GTK */
3181
3182 /* The frame of the last activated non-toolkit menu bar.
3183 Used to generate menu help events. */
3184
3185 static struct frame *menu_help_frame;
3186
3187
3188 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
3189
3190 PANE is the pane number, and ITEM is the menu item number in
3191 the menu (currently not used).
3192
3193 This cannot be done with generating a HELP_EVENT because
3194 XMenuActivate contains a loop that doesn't let Emacs process
3195 keyboard events. */
3196
3197 static void
3198 menu_help_callback (help_string, pane, item)
3199 char *help_string;
3200 int pane, item;
3201 {
3202 extern Lisp_Object Qmenu_item;
3203 Lisp_Object *first_item;
3204 Lisp_Object pane_name;
3205 Lisp_Object menu_object;
3206
3207 first_item = XVECTOR (menu_items)->contents;
3208 if (EQ (first_item[0], Qt))
3209 pane_name = first_item[MENU_ITEMS_PANE_NAME];
3210 else if (EQ (first_item[0], Qquote))
3211 /* This shouldn't happen, see xmenu_show. */
3212 pane_name = empty_string;
3213 else
3214 pane_name = first_item[MENU_ITEMS_ITEM_NAME];
3215
3216 /* (menu-item MENU-NAME PANE-NUMBER) */
3217 menu_object = Fcons (Qmenu_item,
3218 Fcons (pane_name,
3219 Fcons (make_number (pane), Qnil)));
3220 show_help_echo (help_string ? build_string (help_string) : Qnil,
3221 Qnil, menu_object, make_number (item), 1);
3222 }
3223
3224 static Lisp_Object
3225 pop_down_menu (arg)
3226 Lisp_Object arg;
3227 {
3228 struct Lisp_Save_Value *p1 = XSAVE_VALUE (Fcar (arg));
3229 struct Lisp_Save_Value *p2 = XSAVE_VALUE (Fcdr (arg));
3230
3231 FRAME_PTR f = p1->pointer;
3232 XMenu *menu = p2->pointer;
3233
3234 BLOCK_INPUT;
3235 #ifndef MSDOS
3236 XUngrabPointer (FRAME_X_DISPLAY (f), CurrentTime);
3237 XUngrabKeyboard (FRAME_X_DISPLAY (f), CurrentTime);
3238 #endif
3239 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3240
3241 #ifdef HAVE_X_WINDOWS
3242 /* Assume the mouse has moved out of the X window.
3243 If it has actually moved in, we will get an EnterNotify. */
3244 x_mouse_leave (FRAME_X_DISPLAY_INFO (f));
3245
3246 /* State that no mouse buttons are now held.
3247 (The oldXMenu code doesn't track this info for us.)
3248 That is not necessarily true, but the fiction leads to reasonable
3249 results, and it is a pain to ask which are actually held now. */
3250 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
3251
3252 #endif /* HAVE_X_WINDOWS */
3253
3254 UNBLOCK_INPUT;
3255
3256 return Qnil;
3257 }
3258
3259
3260 static Lisp_Object
3261 xmenu_show (f, x, y, for_click, keymaps, title, error)
3262 FRAME_PTR f;
3263 int x, y;
3264 int for_click;
3265 int keymaps;
3266 Lisp_Object title;
3267 char **error;
3268 {
3269 Window root;
3270 XMenu *menu;
3271 int pane, selidx, lpane, status;
3272 Lisp_Object entry, pane_prefix;
3273 char *datap;
3274 int ulx, uly, width, height;
3275 int dispwidth, dispheight;
3276 int i, j, lines, maxlines;
3277 int maxwidth;
3278 int dummy_int;
3279 unsigned int dummy_uint;
3280 int specpdl_count = SPECPDL_INDEX ();
3281
3282 *error = 0;
3283 if (menu_items_n_panes == 0)
3284 return Qnil;
3285
3286 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
3287 {
3288 *error = "Empty menu";
3289 return Qnil;
3290 }
3291
3292 /* Figure out which root window F is on. */
3293 XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root,
3294 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
3295 &dummy_uint, &dummy_uint);
3296
3297 /* Make the menu on that window. */
3298 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
3299 if (menu == NULL)
3300 {
3301 *error = "Can't create menu";
3302 return Qnil;
3303 }
3304
3305 #ifdef HAVE_X_WINDOWS
3306 /* Adjust coordinates to relative to the outer (window manager) window. */
3307 x += FRAME_OUTER_TO_INNER_DIFF_X (f);
3308 y += FRAME_OUTER_TO_INNER_DIFF_Y (f);
3309 #endif /* HAVE_X_WINDOWS */
3310
3311 /* Adjust coordinates to be root-window-relative. */
3312 x += f->left_pos;
3313 y += f->top_pos;
3314
3315 /* Create all the necessary panes and their items. */
3316 maxlines = lines = i = 0;
3317 while (i < menu_items_used)
3318 {
3319 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3320 {
3321 /* Create a new pane. */
3322 Lisp_Object pane_name, prefix;
3323 char *pane_string;
3324
3325 maxlines = max (maxlines, lines);
3326 lines = 0;
3327 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
3328 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3329 pane_string = (NILP (pane_name)
3330 ? "" : (char *) SDATA (pane_name));
3331 if (keymaps && !NILP (prefix))
3332 pane_string++;
3333
3334 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
3335 if (lpane == XM_FAILURE)
3336 {
3337 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3338 *error = "Can't create pane";
3339 return Qnil;
3340 }
3341 i += MENU_ITEMS_PANE_LENGTH;
3342
3343 /* Find the width of the widest item in this pane. */
3344 maxwidth = 0;
3345 j = i;
3346 while (j < menu_items_used)
3347 {
3348 Lisp_Object item;
3349 item = XVECTOR (menu_items)->contents[j];
3350 if (EQ (item, Qt))
3351 break;
3352 if (NILP (item))
3353 {
3354 j++;
3355 continue;
3356 }
3357 width = SBYTES (item);
3358 if (width > maxwidth)
3359 maxwidth = width;
3360
3361 j += MENU_ITEMS_ITEM_LENGTH;
3362 }
3363 }
3364 /* Ignore a nil in the item list.
3365 It's meaningful only for dialog boxes. */
3366 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
3367 i += 1;
3368 else
3369 {
3370 /* Create a new item within current pane. */
3371 Lisp_Object item_name, enable, descrip, help;
3372 unsigned char *item_data;
3373 char *help_string;
3374
3375 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
3376 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
3377 descrip
3378 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
3379 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
3380 help_string = STRINGP (help) ? SDATA (help) : NULL;
3381
3382 if (!NILP (descrip))
3383 {
3384 int gap = maxwidth - SBYTES (item_name);
3385 #ifdef C_ALLOCA
3386 Lisp_Object spacer;
3387 spacer = Fmake_string (make_number (gap), make_number (' '));
3388 item_name = concat2 (item_name, spacer);
3389 item_name = concat2 (item_name, descrip);
3390 item_data = SDATA (item_name);
3391 #else
3392 /* if alloca is fast, use that to make the space,
3393 to reduce gc needs. */
3394 item_data
3395 = (unsigned char *) alloca (maxwidth
3396 + SBYTES (descrip) + 1);
3397 bcopy (SDATA (item_name), item_data,
3398 SBYTES (item_name));
3399 for (j = SCHARS (item_name); j < maxwidth; j++)
3400 item_data[j] = ' ';
3401 bcopy (SDATA (descrip), item_data + j,
3402 SBYTES (descrip));
3403 item_data[j + SBYTES (descrip)] = 0;
3404 #endif
3405 }
3406 else
3407 item_data = SDATA (item_name);
3408
3409 if (XMenuAddSelection (FRAME_X_DISPLAY (f),
3410 menu, lpane, 0, item_data,
3411 !NILP (enable), help_string)
3412 == XM_FAILURE)
3413 {
3414 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
3415 *error = "Can't add selection to menu";
3416 return Qnil;
3417 }
3418 i += MENU_ITEMS_ITEM_LENGTH;
3419 lines++;
3420 }
3421 }
3422
3423 maxlines = max (maxlines, lines);
3424
3425 /* All set and ready to fly. */
3426 XMenuRecompute (FRAME_X_DISPLAY (f), menu);
3427 dispwidth = DisplayWidth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
3428 dispheight = DisplayHeight (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
3429 x = min (x, dispwidth);
3430 y = min (y, dispheight);
3431 x = max (x, 1);
3432 y = max (y, 1);
3433 XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y,
3434 &ulx, &uly, &width, &height);
3435 if (ulx+width > dispwidth)
3436 {
3437 x -= (ulx + width) - dispwidth;
3438 ulx = dispwidth - width;
3439 }
3440 if (uly+height > dispheight)
3441 {
3442 y -= (uly + height) - dispheight;
3443 uly = dispheight - height;
3444 }
3445 if (ulx < 0) x -= ulx;
3446 if (uly < 0) y -= uly;
3447
3448 if (! for_click)
3449 {
3450 /* If position was not given by a mouse click, adjust so upper left
3451 corner of the menu as a whole ends up at given coordinates. This
3452 is what x-popup-menu says in its documentation. */
3453 x += width/2;
3454 y += 1.5*height/(maxlines+2);
3455 }
3456
3457 XMenuSetAEQ (menu, TRUE);
3458 XMenuSetFreeze (menu, TRUE);
3459 pane = selidx = 0;
3460
3461 #ifndef MSDOS
3462 XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f));
3463 #endif
3464
3465 record_unwind_protect (pop_down_menu,
3466 Fcons (make_save_value (f, 0),
3467 make_save_value (menu, 0)));
3468
3469 /* Help display under X won't work because XMenuActivate contains
3470 a loop that doesn't give Emacs a chance to process it. */
3471 menu_help_frame = f;
3472 status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
3473 x, y, ButtonReleaseMask, &datap,
3474 menu_help_callback);
3475
3476 switch (status)
3477 {
3478 case XM_SUCCESS:
3479 #ifdef XDEBUG
3480 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
3481 #endif
3482
3483 /* Find the item number SELIDX in pane number PANE. */
3484 i = 0;
3485 while (i < menu_items_used)
3486 {
3487 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3488 {
3489 if (pane == 0)
3490 pane_prefix
3491 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3492 pane--;
3493 i += MENU_ITEMS_PANE_LENGTH;
3494 }
3495 else
3496 {
3497 if (pane == -1)
3498 {
3499 if (selidx == 0)
3500 {
3501 entry
3502 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
3503 if (keymaps != 0)
3504 {
3505 entry = Fcons (entry, Qnil);
3506 if (!NILP (pane_prefix))
3507 entry = Fcons (pane_prefix, entry);
3508 }
3509 break;
3510 }
3511 selidx--;
3512 }
3513 i += MENU_ITEMS_ITEM_LENGTH;
3514 }
3515 }
3516 break;
3517
3518 case XM_FAILURE:
3519 *error = "Can't activate menu";
3520 case XM_IA_SELECT:
3521 entry = Qnil;
3522 break;
3523 case XM_NO_SELECT:
3524 /* Make "Cancel" equivalent to C-g unless this menu was popped up by
3525 a mouse press. */
3526 if (! for_click)
3527 Fsignal (Qquit, Qnil);
3528 entry = Qnil;
3529 break;
3530 }
3531
3532 unbind_to (specpdl_count, Qnil);
3533
3534 return entry;
3535 }
3536
3537 #endif /* not USE_X_TOOLKIT */
3538
3539 #endif /* HAVE_MENUS */
3540 \f
3541 void
3542 syms_of_xmenu ()
3543 {
3544 staticpro (&menu_items);
3545 menu_items = Qnil;
3546 menu_items_inuse = Qnil;
3547
3548 Qdebug_on_next_call = intern ("debug-on-next-call");
3549 staticpro (&Qdebug_on_next_call);
3550
3551 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
3552 doc: /* Frame for which we are updating a menu.
3553 The enable predicate for a menu command should check this variable. */);
3554 Vmenu_updating_frame = Qnil;
3555
3556 #ifdef USE_X_TOOLKIT
3557 widget_id_tick = (1<<16);
3558 next_menubar_widget_id = 1;
3559 #endif
3560
3561 defsubr (&Sx_popup_menu);
3562 #ifdef HAVE_MENUS
3563 defsubr (&Sx_popup_dialog);
3564 #endif
3565 }
3566
3567 /* arch-tag: 92ea573c-398e-496e-ac73-2436f7d63242
3568 (do not change this comment) */