(iso-languages): For Portuguese ~c and
[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 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* X pop-up deck-of-cards menu facility for gnuemacs.
22 *
23 * Written by Jon Arnold and Roman Budzianowski
24 * Mods and rewrite by Robert Krawitz
25 *
26 */
27
28 /* Modified by Fred Pierresteguy on December 93
29 to make the popup menus and menubar use the Xt. */
30
31 /* Rewritten for clarity and GC protection by rms in Feb 94. */
32
33 /* On 4.3 this loses if it comes after xterm.h. */
34 #include <signal.h>
35 #include <config.h>
36
37 #include <stdio.h>
38 #include "lisp.h"
39 #include "termhooks.h"
40 #include "frame.h"
41 #include "window.h"
42 #include "keyboard.h"
43 #include "blockinput.h"
44 #include "buffer.h"
45
46 #ifdef MSDOS
47 #include "msdos.h"
48 #endif
49
50 #ifdef HAVE_X_WINDOWS
51 /* This may include sys/types.h, and that somehow loses
52 if this is not done before the other system files. */
53 #include "xterm.h"
54 #endif
55
56 /* Load sys/types.h if not already loaded.
57 In some systems loading it twice is suicidal. */
58 #ifndef makedev
59 #include <sys/types.h>
60 #endif
61
62 #include "dispextern.h"
63
64 #ifdef HAVE_X_WINDOWS
65 #undef HAVE_MULTILINGUAL_MENU
66 #ifdef USE_X_TOOLKIT
67 #include <X11/Xlib.h>
68 #include <X11/IntrinsicP.h>
69 #include <X11/CoreP.h>
70 #include <X11/StringDefs.h>
71 #include <X11/Shell.h>
72 #ifdef USE_LUCID
73 #include <X11/Xaw/Paned.h>
74 #endif /* USE_LUCID */
75 #include "../lwlib/lwlib.h"
76 #else /* not USE_X_TOOLKIT */
77 #include "../oldXMenu/XMenu.h"
78 #endif /* not USE_X_TOOLKIT */
79 #endif /* HAVE_X_WINDOWS */
80
81 #define min(x,y) (((x) < (y)) ? (x) : (y))
82 #define max(x,y) (((x) > (y)) ? (x) : (y))
83
84 #ifndef TRUE
85 #define TRUE 1
86 #define FALSE 0
87 #endif /* no TRUE */
88
89 Lisp_Object Vmenu_updating_frame;
90
91 Lisp_Object Qdebug_on_next_call;
92
93 extern Lisp_Object Qmenu_bar;
94 extern Lisp_Object Qmouse_click, Qevent_kind;
95
96 extern Lisp_Object QCtoggle, QCradio;
97
98 extern Lisp_Object Voverriding_local_map;
99 extern Lisp_Object Voverriding_local_map_menu_flag;
100
101 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
102
103 extern Lisp_Object Qmenu_bar_update_hook;
104
105 #ifdef USE_X_TOOLKIT
106 extern void set_frame_menubar ();
107 extern void process_expose_from_menu ();
108 extern XtAppContext Xt_app_con;
109
110 static Lisp_Object xdialog_show ();
111 void popup_get_selection ();
112 #endif
113
114 static Lisp_Object xmenu_show ();
115 static void keymap_panes ();
116 static void single_keymap_panes ();
117 static void single_menu_item ();
118 static void list_of_panes ();
119 static void list_of_items ();
120 \f
121 /* This holds a Lisp vector that holds the results of decoding
122 the keymaps or alist-of-alists that specify a menu.
123
124 It describes the panes and items within the panes.
125
126 Each pane is described by 3 elements in the vector:
127 t, the pane name, the pane's prefix key.
128 Then follow the pane's items, with 5 elements per item:
129 the item string, the enable flag, the item's value,
130 the definition, and the equivalent keyboard key's description string.
131
132 In some cases, multiple levels of menus may be described.
133 A single vector slot containing nil indicates the start of a submenu.
134 A single vector slot containing lambda indicates the end of a submenu.
135 The submenu follows a menu item which is the way to reach the submenu.
136
137 A single vector slot containing quote indicates that the
138 following items should appear on the right of a dialog box.
139
140 Using a Lisp vector to hold this information while we decode it
141 takes care of protecting all the data from GC. */
142
143 #define MENU_ITEMS_PANE_NAME 1
144 #define MENU_ITEMS_PANE_PREFIX 2
145 #define MENU_ITEMS_PANE_LENGTH 3
146
147 #define MENU_ITEMS_ITEM_NAME 0
148 #define MENU_ITEMS_ITEM_ENABLE 1
149 #define MENU_ITEMS_ITEM_VALUE 2
150 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
151 #define MENU_ITEMS_ITEM_DEFINITION 4
152 #define MENU_ITEMS_ITEM_LENGTH 5
153
154 static Lisp_Object menu_items;
155
156 /* Number of slots currently allocated in menu_items. */
157 static int menu_items_allocated;
158
159 /* This is the index in menu_items of the first empty slot. */
160 static int menu_items_used;
161
162 /* The number of panes currently recorded in menu_items,
163 excluding those within submenus. */
164 static int menu_items_n_panes;
165
166 /* Current depth within submenus. */
167 static int menu_items_submenu_depth;
168
169 /* Flag which when set indicates a dialog or menu has been posted by
170 Xt on behalf of one of the widget sets. */
171 static int popup_activated_flag;
172
173 static int next_menubar_widget_id;
174
175 /* This is set nonzero after the user activates the menu bar, and set
176 to zero again after the menu bars are redisplayed by prepare_menu_bar.
177 While it is nonzero, all calls to set_frame_menubar go deep.
178
179 I don't understand why this is needed, but it does seem to be
180 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
181
182 int pending_menu_activation;
183 \f
184 #ifdef USE_X_TOOLKIT
185
186 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
187
188 static struct frame *
189 menubar_id_to_frame (id)
190 LWLIB_ID id;
191 {
192 Lisp_Object tail, frame;
193 FRAME_PTR f;
194
195 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
196 {
197 frame = XCONS (tail)->car;
198 if (!GC_FRAMEP (frame))
199 continue;
200 f = XFRAME (frame);
201 if (f->output_data.nothing == 1)
202 continue;
203 if (f->output_data.x->id == id)
204 return f;
205 }
206 return 0;
207 }
208
209 #endif
210 \f
211 /* Initialize the menu_items structure if we haven't already done so.
212 Also mark it as currently empty. */
213
214 static void
215 init_menu_items ()
216 {
217 if (NILP (menu_items))
218 {
219 menu_items_allocated = 60;
220 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
221 }
222
223 menu_items_used = 0;
224 menu_items_n_panes = 0;
225 menu_items_submenu_depth = 0;
226 }
227
228 /* Call at the end of generating the data in menu_items.
229 This fills in the number of items in the last pane. */
230
231 static void
232 finish_menu_items ()
233 {
234 }
235
236 /* Call when finished using the data for the current menu
237 in menu_items. */
238
239 static void
240 discard_menu_items ()
241 {
242 /* Free the structure if it is especially large.
243 Otherwise, hold on to it, to save time. */
244 if (menu_items_allocated > 200)
245 {
246 menu_items = Qnil;
247 menu_items_allocated = 0;
248 }
249 }
250
251 /* Make the menu_items vector twice as large. */
252
253 static void
254 grow_menu_items ()
255 {
256 Lisp_Object old;
257 int old_size = menu_items_allocated;
258 old = menu_items;
259
260 menu_items_allocated *= 2;
261 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
262 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
263 old_size * sizeof (Lisp_Object));
264 }
265
266 /* Begin a submenu. */
267
268 static void
269 push_submenu_start ()
270 {
271 if (menu_items_used + 1 > menu_items_allocated)
272 grow_menu_items ();
273
274 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
275 menu_items_submenu_depth++;
276 }
277
278 /* End a submenu. */
279
280 static void
281 push_submenu_end ()
282 {
283 if (menu_items_used + 1 > menu_items_allocated)
284 grow_menu_items ();
285
286 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
287 menu_items_submenu_depth--;
288 }
289
290 /* Indicate boundary between left and right. */
291
292 static void
293 push_left_right_boundary ()
294 {
295 if (menu_items_used + 1 > menu_items_allocated)
296 grow_menu_items ();
297
298 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
299 }
300
301 /* Start a new menu pane in menu_items..
302 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
303
304 static void
305 push_menu_pane (name, prefix_vec)
306 Lisp_Object name, prefix_vec;
307 {
308 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
309 grow_menu_items ();
310
311 if (menu_items_submenu_depth == 0)
312 menu_items_n_panes++;
313 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
314 XVECTOR (menu_items)->contents[menu_items_used++] = name;
315 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
316 }
317
318 /* Push one menu item into the current pane.
319 NAME is the string to display. ENABLE if non-nil means
320 this item can be selected. KEY is the key generated by
321 choosing this item, or nil if this item doesn't really have a definition.
322 DEF is the definition of this item.
323 EQUIV is the textual description of the keyboard equivalent for
324 this item (or nil if none). */
325
326 static void
327 push_menu_item (name, enable, key, def, equiv)
328 Lisp_Object name, enable, key, def, equiv;
329 {
330 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
331 grow_menu_items ();
332
333 XVECTOR (menu_items)->contents[menu_items_used++] = name;
334 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
335 XVECTOR (menu_items)->contents[menu_items_used++] = key;
336 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
337 XVECTOR (menu_items)->contents[menu_items_used++] = def;
338 }
339 \f
340 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
341 and generate menu panes for them in menu_items.
342 If NOTREAL is nonzero,
343 don't bother really computing whether an item is enabled. */
344
345 static void
346 keymap_panes (keymaps, nmaps, notreal)
347 Lisp_Object *keymaps;
348 int nmaps;
349 int notreal;
350 {
351 int mapno;
352
353 init_menu_items ();
354
355 /* Loop over the given keymaps, making a pane for each map.
356 But don't make a pane that is empty--ignore that map instead.
357 P is the number of panes we have made so far. */
358 for (mapno = 0; mapno < nmaps; mapno++)
359 single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal, 10);
360
361 finish_menu_items ();
362 }
363
364 /* This is a recursive subroutine of keymap_panes.
365 It handles one keymap, KEYMAP.
366 The other arguments are passed along
367 or point to local variables of the previous function.
368 If NOTREAL is nonzero, only check for equivalent key bindings, don't
369 evaluate expressions in menu items and don't make any menu.
370
371 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
372
373 static void
374 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
375 Lisp_Object keymap;
376 Lisp_Object pane_name;
377 Lisp_Object prefix;
378 int notreal;
379 int maxdepth;
380 {
381 Lisp_Object pending_maps = Qnil;
382 Lisp_Object tail, item;
383 struct gcpro gcpro1, gcpro2;
384 int notbuttons = 0;
385
386 if (maxdepth <= 0)
387 return;
388
389 push_menu_pane (pane_name, prefix);
390
391 #ifndef HAVE_BOXES
392 /* Remember index for first item in this pane so we can go back and
393 add a prefix when (if) we see the first button. After that, notbuttons
394 is set to 0, to mark that we have seen a button and all non button
395 items need a prefix. */
396 notbuttons = menu_items_used;
397 #endif
398
399 for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
400 {
401 GCPRO2 (keymap, pending_maps);
402 /* Look at each key binding, and if it is a menu item add it
403 to this menu. */
404 item = XCONS (tail)->car;
405 if (CONSP (item))
406 single_menu_item (XCONS (item)->car, XCONS (item)->cdr,
407 &pending_maps, notreal, maxdepth, &notbuttons);
408 else if (VECTORP (item))
409 {
410 /* Loop over the char values represented in the vector. */
411 int len = XVECTOR (item)->size;
412 int c;
413 for (c = 0; c < len; c++)
414 {
415 Lisp_Object character;
416 XSETFASTINT (character, c);
417 single_menu_item (character, XVECTOR (item)->contents[c],
418 &pending_maps, notreal, maxdepth, &notbuttons);
419 }
420 }
421 UNGCPRO;
422 }
423
424 /* Process now any submenus which want to be panes at this level. */
425 while (!NILP (pending_maps))
426 {
427 Lisp_Object elt, eltcdr, string;
428 elt = Fcar (pending_maps);
429 eltcdr = XCONS (elt)->cdr;
430 string = XCONS (eltcdr)->car;
431 /* We no longer discard the @ from the beginning of the string here.
432 Instead, we do this in xmenu_show. */
433 single_keymap_panes (Fcar (elt), string,
434 XCONS (eltcdr)->cdr, notreal, maxdepth - 1);
435 pending_maps = Fcdr (pending_maps);
436 }
437 }
438 \f
439 /* This is a subroutine of single_keymap_panes that handles one
440 keymap entry.
441 KEY is a key in a keymap and ITEM is its binding.
442 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
443 separate panes.
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 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
447 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
448 buttons. It points to variable notbuttons in single_keymap_panes,
449 which keeps track of if we have seen a button in this menu or not. */
450
451 static void
452 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth,
453 notbuttons_ptr)
454 Lisp_Object key, item;
455 Lisp_Object *pending_maps_ptr;
456 int maxdepth, notreal;
457 int *notbuttons_ptr;
458 {
459 Lisp_Object def, map, item_string, enabled;
460 struct gcpro gcpro1, gcpro2;
461 int res;
462
463 /* Parse the menu item and leave the result in item_properties. */
464 GCPRO2 (key, item);
465 res = parse_menu_item (item, notreal, 0);
466 UNGCPRO;
467 if (!res)
468 return; /* Not a menu item. */
469
470 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
471
472 if (notreal)
473 {
474 /* We don't want to make a menu, just traverse the keymaps to
475 precompute equivalent key bindings. */
476 if (!NILP (map))
477 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
478 return;
479 }
480
481 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
482 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
483
484 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
485 {
486 if (!NILP (enabled))
487 /* An enabled separate pane. Remember this to handle it later. */
488 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
489 *pending_maps_ptr);
490 return;
491 }
492
493 #ifndef HAVE_BOXES
494 /* Simulate radio buttons and toggle boxes by putting a prefix in
495 front of them. */
496 {
497 Lisp_Object prefix = Qnil;
498 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
499 if (!NILP (type))
500 {
501 Lisp_Object selected
502 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
503
504 if (*notbuttons_ptr)
505 /* The first button. Line up previous items in this menu. */
506 {
507 int index = *notbuttons_ptr; /* Index for first item this menu. */
508 int submenu = 0;
509 Lisp_Object tem;
510 while (index < menu_items_used)
511 {
512 tem
513 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
514 if (NILP (tem))
515 {
516 index++;
517 submenu++; /* Skip sub menu. */
518 }
519 else if (EQ (tem, Qlambda))
520 {
521 index++;
522 submenu--; /* End sub menu. */
523 }
524 else if (EQ (tem, Qt))
525 index += 3; /* Skip new pane marker. */
526 else if (EQ (tem, Qquote))
527 index++; /* Skip a left, right divider. */
528 else
529 {
530 if (!submenu && XSTRING (tem)->data[0] != '\0'
531 && XSTRING (tem)->data[0] != '-')
532 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
533 = concat2 (build_string (" "), tem);
534 index += MENU_ITEMS_ITEM_LENGTH;
535 }
536 }
537 *notbuttons_ptr = 0;
538 }
539
540 /* Calculate prefix, if any, for this item. */
541 if (EQ (type, QCtoggle))
542 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
543 else if (EQ (type, QCradio))
544 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
545 }
546 /* Not a button. If we have earlier buttons, then we need a prefix. */
547 else if (!*notbuttons_ptr && XSTRING (item_string)->data[0] != '\0'
548 && XSTRING (item_string)->data[0] != '-')
549 prefix = build_string (" ");
550
551 if (!NILP (prefix))
552 item_string = concat2 (prefix, item_string);
553 }
554 #endif /* not HAVE_BOXES */
555
556 #ifndef USE_X_TOOLKIT
557 if (!NILP(map))
558 /* Indicate visually that this is a submenu. */
559 item_string = concat2 (item_string, build_string (" >"));
560 #endif
561
562 push_menu_item (item_string, enabled, key,
563 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
564 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]);
565
566 #ifdef USE_X_TOOLKIT
567 /* Display a submenu using the toolkit. */
568 if (! (NILP (map) || NILP (enabled)))
569 {
570 push_submenu_start ();
571 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
572 push_submenu_end ();
573 }
574 #endif
575 }
576 \f
577 /* Push all the panes and items of a menu described by the
578 alist-of-alists MENU.
579 This handles old-fashioned calls to x-popup-menu. */
580
581 static void
582 list_of_panes (menu)
583 Lisp_Object menu;
584 {
585 Lisp_Object tail;
586
587 init_menu_items ();
588
589 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
590 {
591 Lisp_Object elt, pane_name, pane_data;
592 elt = Fcar (tail);
593 pane_name = Fcar (elt);
594 CHECK_STRING (pane_name, 0);
595 push_menu_pane (pane_name, Qnil);
596 pane_data = Fcdr (elt);
597 CHECK_CONS (pane_data, 0);
598 list_of_items (pane_data);
599 }
600
601 finish_menu_items ();
602 }
603
604 /* Push the items in a single pane defined by the alist PANE. */
605
606 static void
607 list_of_items (pane)
608 Lisp_Object pane;
609 {
610 Lisp_Object tail, item, item1;
611
612 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
613 {
614 item = Fcar (tail);
615 if (STRINGP (item))
616 push_menu_item (item, Qnil, Qnil, Qt, Qnil);
617 else if (NILP (item))
618 push_left_right_boundary ();
619 else
620 {
621 CHECK_CONS (item, 0);
622 item1 = Fcar (item);
623 CHECK_STRING (item1, 1);
624 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil);
625 }
626 }
627 }
628 \f
629 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
630 "Pop up a deck-of-cards menu and return user's selection.\n\
631 POSITION is a position specification. This is either a mouse button event\n\
632 or a list ((XOFFSET YOFFSET) WINDOW)\n\
633 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
634 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
635 This controls the position of the center of the first line\n\
636 in the first pane of the menu, not the top left of the menu as a whole.\n\
637 If POSITION is t, it means to use the current mouse position.\n\
638 \n\
639 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
640 The menu items come from key bindings that have a menu string as well as\n\
641 a definition; actually, the \"definition\" in such a key binding looks like\n\
642 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
643 the keymap as a top-level element.\n\n\
644 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
645 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
646 \n\
647 You can also use a list of keymaps as MENU.\n\
648 Then each keymap makes a separate pane.\n\
649 When MENU is a keymap or a list of keymaps, the return value\n\
650 is a list of events.\n\n\
651 \n\
652 Alternatively, you can specify a menu of multiple panes\n\
653 with a list of the form (TITLE PANE1 PANE2...),\n\
654 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
655 Each ITEM is normally a cons cell (STRING . VALUE);\n\
656 but a string can appear as an item--that makes a nonselectable line\n\
657 in the menu.\n\
658 With this form of menu, the return value is VALUE from the chosen item.\n\
659 \n\
660 If POSITION is nil, don't display the menu at all, just precalculate the\n\
661 cached information about equivalent key sequences.")
662 (position, menu)
663 Lisp_Object position, menu;
664 {
665 int number_of_panes, panes;
666 Lisp_Object keymap, tem;
667 int xpos, ypos;
668 Lisp_Object title;
669 char *error_name;
670 Lisp_Object selection;
671 int i, j;
672 FRAME_PTR f;
673 Lisp_Object x, y, window;
674 int keymaps = 0;
675 int for_click = 0;
676 struct gcpro gcpro1;
677
678 #ifdef HAVE_MENUS
679 if (! NILP (position))
680 {
681 check_x ();
682
683 /* Decode the first argument: find the window and the coordinates. */
684 if (EQ (position, Qt)
685 || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
686 {
687 /* Use the mouse's current position. */
688 FRAME_PTR new_f = selected_frame;
689 Lisp_Object bar_window;
690 enum scroll_bar_part part;
691 unsigned long time;
692
693 if (mouse_position_hook)
694 (*mouse_position_hook) (&new_f, 1, &bar_window,
695 &part, &x, &y, &time);
696 if (new_f != 0)
697 XSETFRAME (window, new_f);
698 else
699 {
700 window = selected_window;
701 XSETFASTINT (x, 0);
702 XSETFASTINT (y, 0);
703 }
704 }
705 else
706 {
707 tem = Fcar (position);
708 if (CONSP (tem))
709 {
710 window = Fcar (Fcdr (position));
711 x = Fcar (tem);
712 y = Fcar (Fcdr (tem));
713 }
714 else
715 {
716 for_click = 1;
717 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
718 window = Fcar (tem); /* POSN_WINDOW (tem) */
719 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
720 x = Fcar (tem);
721 y = Fcdr (tem);
722 }
723 }
724
725 CHECK_NUMBER (x, 0);
726 CHECK_NUMBER (y, 0);
727
728 /* Decode where to put the menu. */
729
730 if (FRAMEP (window))
731 {
732 f = XFRAME (window);
733 xpos = 0;
734 ypos = 0;
735 }
736 else if (WINDOWP (window))
737 {
738 CHECK_LIVE_WINDOW (window, 0);
739 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
740
741 xpos = (FONT_WIDTH (f->output_data.x->font)
742 * XFASTINT (XWINDOW (window)->left));
743 ypos = (f->output_data.x->line_height
744 * XFASTINT (XWINDOW (window)->top));
745 }
746 else
747 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
748 but I don't want to make one now. */
749 CHECK_WINDOW (window, 0);
750
751 xpos += XINT (x);
752 ypos += XINT (y);
753
754 XSETFRAME (Vmenu_updating_frame, f);
755 }
756 Vmenu_updating_frame = Qnil;
757 #endif /* HAVE_MENUS */
758
759 title = Qnil;
760 GCPRO1 (title);
761
762 /* Decode the menu items from what was specified. */
763
764 keymap = Fkeymapp (menu);
765 tem = Qnil;
766 if (CONSP (menu))
767 tem = Fkeymapp (Fcar (menu));
768 if (!NILP (keymap))
769 {
770 /* We were given a keymap. Extract menu info from the keymap. */
771 Lisp_Object prompt;
772 keymap = get_keymap (menu);
773
774 /* Extract the detailed info to make one pane. */
775 keymap_panes (&menu, 1, NILP (position));
776
777 /* Search for a string appearing directly as an element of the keymap.
778 That string is the title of the menu. */
779 prompt = map_prompt (keymap);
780 if (NILP (title) && !NILP (prompt))
781 title = prompt;
782
783 /* Make that be the pane title of the first pane. */
784 if (!NILP (prompt) && menu_items_n_panes >= 0)
785 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
786
787 keymaps = 1;
788 }
789 else if (!NILP (tem))
790 {
791 /* We were given a list of keymaps. */
792 int nmaps = XFASTINT (Flength (menu));
793 Lisp_Object *maps
794 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
795 int i;
796
797 title = Qnil;
798
799 /* The first keymap that has a prompt string
800 supplies the menu title. */
801 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
802 {
803 Lisp_Object prompt;
804
805 maps[i++] = keymap = get_keymap (Fcar (tem));
806
807 prompt = map_prompt (keymap);
808 if (NILP (title) && !NILP (prompt))
809 title = prompt;
810 }
811
812 /* Extract the detailed info to make one pane. */
813 keymap_panes (maps, nmaps, NILP (position));
814
815 /* Make the title be the pane title of the first pane. */
816 if (!NILP (title) && menu_items_n_panes >= 0)
817 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
818
819 keymaps = 1;
820 }
821 else
822 {
823 /* We were given an old-fashioned menu. */
824 title = Fcar (menu);
825 CHECK_STRING (title, 1);
826
827 list_of_panes (Fcdr (menu));
828
829 keymaps = 0;
830 }
831
832 if (NILP (position))
833 {
834 discard_menu_items ();
835 UNGCPRO;
836 return Qnil;
837 }
838
839 #ifdef HAVE_MENUS
840 /* Display them in a menu. */
841 BLOCK_INPUT;
842
843 selection = xmenu_show (f, xpos, ypos, for_click,
844 keymaps, title, &error_name);
845 UNBLOCK_INPUT;
846
847 discard_menu_items ();
848
849 UNGCPRO;
850 #endif /* HAVE_MENUS */
851
852 if (error_name) error (error_name);
853 return selection;
854 }
855
856 #ifdef HAVE_MENUS
857
858 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
859 "Pop up a dialog box and return user's selection.\n\
860 POSITION specifies which frame to use.\n\
861 This is normally a mouse button event or a window or frame.\n\
862 If POSITION is t, it means to use the frame the mouse is on.\n\
863 The dialog box appears in the middle of the specified frame.\n\
864 \n\
865 CONTENTS specifies the alternatives to display in the dialog box.\n\
866 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
867 Each ITEM is a cons cell (STRING . VALUE).\n\
868 The return value is VALUE from the chosen item.\n\n\
869 An ITEM may also be just a string--that makes a nonselectable item.\n\
870 An ITEM may also be nil--that means to put all preceding items\n\
871 on the left of the dialog box and all following items on the right.\n\
872 \(By default, approximately half appear on each side.)")
873 (position, contents)
874 Lisp_Object position, contents;
875 {
876 FRAME_PTR f;
877 Lisp_Object window;
878
879 check_x ();
880
881 /* Decode the first argument: find the window or frame to use. */
882 if (EQ (position, Qt)
883 || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
884 {
885 #if 0 /* Using the frame the mouse is on may not be right. */
886 /* Use the mouse's current position. */
887 FRAME_PTR new_f = selected_frame;
888 Lisp_Object bar_window;
889 int part;
890 unsigned long time;
891 Lisp_Object x, y;
892
893 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
894
895 if (new_f != 0)
896 XSETFRAME (window, new_f);
897 else
898 window = selected_window;
899 #endif
900 window = selected_window;
901 }
902 else if (CONSP (position))
903 {
904 Lisp_Object tem;
905 tem = Fcar (position);
906 if (CONSP (tem))
907 window = Fcar (Fcdr (position));
908 else
909 {
910 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
911 window = Fcar (tem); /* POSN_WINDOW (tem) */
912 }
913 }
914 else if (WINDOWP (position) || FRAMEP (position))
915 window = position;
916 else
917 window = Qnil;
918
919 /* Decode where to put the menu. */
920
921 if (FRAMEP (window))
922 f = XFRAME (window);
923 else if (WINDOWP (window))
924 {
925 CHECK_LIVE_WINDOW (window, 0);
926 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
927 }
928 else
929 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
930 but I don't want to make one now. */
931 CHECK_WINDOW (window, 0);
932
933 #ifndef USE_X_TOOLKIT
934 /* Display a menu with these alternatives
935 in the middle of frame F. */
936 {
937 Lisp_Object x, y, frame, newpos;
938 XSETFRAME (frame, f);
939 XSETINT (x, x_pixel_width (f) / 2);
940 XSETINT (y, x_pixel_height (f) / 2);
941 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
942
943 return Fx_popup_menu (newpos,
944 Fcons (Fcar (contents), Fcons (contents, Qnil)));
945 }
946 #else
947 {
948 Lisp_Object title;
949 char *error_name;
950 Lisp_Object selection;
951
952 /* Decode the dialog items from what was specified. */
953 title = Fcar (contents);
954 CHECK_STRING (title, 1);
955
956 list_of_panes (Fcons (contents, Qnil));
957
958 /* Display them in a dialog box. */
959 BLOCK_INPUT;
960 selection = xdialog_show (f, 0, title, &error_name);
961 UNBLOCK_INPUT;
962
963 discard_menu_items ();
964
965 if (error_name) error (error_name);
966 return selection;
967 }
968 #endif
969 }
970 \f
971 #ifdef USE_X_TOOLKIT
972
973 /* Loop in Xt until the menu pulldown or dialog popup has been
974 popped down (deactivated). This is used for x-popup-menu
975 and x-popup-dialog; it is not used for the menu bar any more.
976
977 NOTE: All calls to popup_get_selection should be protected
978 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
979
980 void
981 popup_get_selection (initial_event, dpyinfo, id)
982 XEvent *initial_event;
983 struct x_display_info *dpyinfo;
984 LWLIB_ID id;
985 {
986 XEvent event;
987
988 /* Define a queue to save up for later unreading
989 all X events that don't pertain to the menu. */
990 struct event_queue
991 {
992 XEvent event;
993 struct event_queue *next;
994 };
995
996 struct event_queue *queue = NULL;
997 struct event_queue *queue_tmp;
998
999 if (initial_event)
1000 event = *initial_event;
1001 else
1002 XtAppNextEvent (Xt_app_con, &event);
1003
1004 while (1)
1005 {
1006 /* Handle expose events for editor frames right away. */
1007 if (event.type == Expose)
1008 process_expose_from_menu (event);
1009 /* Make sure we don't consider buttons grabbed after menu goes.
1010 And make sure to deactivate for any ButtonRelease,
1011 even if XtDispatchEvent doesn't do that. */
1012 else if (event.type == ButtonRelease
1013 && dpyinfo->display == event.xbutton.display)
1014 {
1015 dpyinfo->grabbed &= ~(1 << event.xbutton.button);
1016 popup_activated_flag = 0;
1017 #ifdef USE_MOTIF /* Pretending that the event came from a
1018 Btn1Down seems the only way to convince Motif to
1019 activate its callbacks; setting the XmNmenuPost
1020 isn't working. --marcus@sysc.pdx.edu. */
1021 event.xbutton.button = 1;
1022 #endif
1023 }
1024 /* If the user presses a key, deactivate the menu.
1025 The user is likely to do that if we get wedged. */
1026 else if (event.type == KeyPress
1027 && dpyinfo->display == event.xbutton.display)
1028 {
1029 KeySym keysym = XLookupKeysym (&event.xkey, 0);
1030 if (!IsModifierKey (keysym))
1031 {
1032 popup_activated_flag = 0;
1033 break;
1034 }
1035 }
1036 /* Button presses outside the menu also pop it down. */
1037 else if (event.type == ButtonPress
1038 && event.xany.display == dpyinfo->display
1039 && x_any_window_to_frame (dpyinfo, event.xany.window))
1040 {
1041 popup_activated_flag = 0;
1042 break;
1043 }
1044
1045 /* Queue all events not for this popup,
1046 except for Expose, which we've already handled, and ButtonRelease.
1047 Note that the X window is associated with the frame if this
1048 is a menu bar popup, but not if it's a dialog box. So we use
1049 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1050 if (event.type != Expose
1051 && !(event.type == ButtonRelease
1052 && dpyinfo->display == event.xbutton.display)
1053 && (event.xany.display != dpyinfo->display
1054 || x_non_menubar_window_to_frame (dpyinfo, event.xany.window)))
1055 {
1056 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1057
1058 if (queue_tmp != NULL)
1059 {
1060 queue_tmp->event = event;
1061 queue_tmp->next = queue;
1062 queue = queue_tmp;
1063 }
1064 }
1065 else
1066 XtDispatchEvent (&event);
1067
1068 if (!popup_activated ())
1069 break;
1070 XtAppNextEvent (Xt_app_con, &event);
1071 }
1072
1073 /* Unread any events that we got but did not handle. */
1074 while (queue != NULL)
1075 {
1076 queue_tmp = queue;
1077 XPutBackEvent (queue_tmp->event.xany.display, &queue_tmp->event);
1078 queue = queue_tmp->next;
1079 free ((char *)queue_tmp);
1080 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1081 interrupt_input_pending = 1;
1082 }
1083 }
1084
1085 /* Activate the menu bar of frame F.
1086 This is called from keyboard.c when it gets the
1087 menu_bar_activate_event out of the Emacs event queue.
1088
1089 To activate the menu bar, we use the X button-press event
1090 that was saved in saved_menu_event.
1091 That makes the toolkit do its thing.
1092
1093 But first we recompute the menu bar contents (the whole tree).
1094
1095 The reason for saving the button event until here, instead of
1096 passing it to the toolkit right away, is that we can safely
1097 execute Lisp code. */
1098
1099 void
1100 x_activate_menubar (f)
1101 FRAME_PTR f;
1102 {
1103 if (!f->output_data.x->saved_menu_event->type)
1104 return;
1105
1106 set_frame_menubar (f, 0, 1);
1107 BLOCK_INPUT;
1108 XtDispatchEvent ((XEvent *) f->output_data.x->saved_menu_event);
1109 UNBLOCK_INPUT;
1110 #ifdef USE_MOTIF
1111 if (f->output_data.x->saved_menu_event->type == ButtonRelease)
1112 pending_menu_activation = 1;
1113 #endif
1114
1115 /* Ignore this if we get it a second time. */
1116 f->output_data.x->saved_menu_event->type = 0;
1117 }
1118
1119 /* Detect if a dialog or menu has been posted. */
1120
1121 int
1122 popup_activated ()
1123 {
1124 return popup_activated_flag;
1125 }
1126
1127
1128 /* This callback is invoked when the user selects a menubar cascade
1129 pushbutton, but before the pulldown menu is posted. */
1130
1131 static void
1132 popup_activate_callback (widget, id, client_data)
1133 Widget widget;
1134 LWLIB_ID id;
1135 XtPointer client_data;
1136 {
1137 popup_activated_flag = 1;
1138 }
1139
1140 /* This callback is called from the menu bar pulldown menu
1141 when the user makes a selection.
1142 Figure out what the user chose
1143 and put the appropriate events into the keyboard buffer. */
1144
1145 static void
1146 menubar_selection_callback (widget, id, client_data)
1147 Widget widget;
1148 LWLIB_ID id;
1149 XtPointer client_data;
1150 {
1151 Lisp_Object prefix, entry;
1152 FRAME_PTR f = menubar_id_to_frame (id);
1153 Lisp_Object vector;
1154 Lisp_Object *subprefix_stack;
1155 int submenu_depth = 0;
1156 int i;
1157
1158 if (!f)
1159 return;
1160 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1161 vector = f->menu_bar_vector;
1162 prefix = Qnil;
1163 i = 0;
1164 while (i < f->menu_bar_items_used)
1165 {
1166 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1167 {
1168 subprefix_stack[submenu_depth++] = prefix;
1169 prefix = entry;
1170 i++;
1171 }
1172 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1173 {
1174 prefix = subprefix_stack[--submenu_depth];
1175 i++;
1176 }
1177 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1178 {
1179 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1180 i += MENU_ITEMS_PANE_LENGTH;
1181 }
1182 else
1183 {
1184 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1185 /* The EMACS_INT cast avoids a warning. There's no problem
1186 as long as pointers have enough bits to hold small integers. */
1187 if ((int) (EMACS_INT) client_data == i)
1188 {
1189 int j;
1190 struct input_event buf;
1191 Lisp_Object frame;
1192
1193 XSETFRAME (frame, f);
1194 buf.kind = menu_bar_event;
1195 buf.frame_or_window = Fcons (frame, Fcons (Qmenu_bar, Qnil));
1196 kbd_buffer_store_event (&buf);
1197
1198 for (j = 0; j < submenu_depth; j++)
1199 if (!NILP (subprefix_stack[j]))
1200 {
1201 buf.kind = menu_bar_event;
1202 buf.frame_or_window = Fcons (frame, subprefix_stack[j]);
1203 kbd_buffer_store_event (&buf);
1204 }
1205
1206 if (!NILP (prefix))
1207 {
1208 buf.kind = menu_bar_event;
1209 buf.frame_or_window = Fcons (frame, prefix);
1210 kbd_buffer_store_event (&buf);
1211 }
1212
1213 buf.kind = menu_bar_event;
1214 buf.frame_or_window = Fcons (frame, entry);
1215 kbd_buffer_store_event (&buf);
1216
1217 return;
1218 }
1219 i += MENU_ITEMS_ITEM_LENGTH;
1220 }
1221 }
1222 }
1223
1224 /* This callback is invoked when a dialog or menu is finished being
1225 used and has been unposted. */
1226
1227 static void
1228 popup_deactivate_callback (widget, id, client_data)
1229 Widget widget;
1230 LWLIB_ID id;
1231 XtPointer client_data;
1232 {
1233 popup_activated_flag = 0;
1234 }
1235
1236 /* Allocate a widget_value, blocking input. */
1237
1238 widget_value *
1239 xmalloc_widget_value ()
1240 {
1241 widget_value *value;
1242
1243 BLOCK_INPUT;
1244 value = malloc_widget_value ();
1245 UNBLOCK_INPUT;
1246
1247 return value;
1248 }
1249
1250 /* This recursively calls free_widget_value on the tree of widgets.
1251 It must free all data that was malloc'ed for these widget_values.
1252 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1253 must be left alone. */
1254
1255 void
1256 free_menubar_widget_value_tree (wv)
1257 widget_value *wv;
1258 {
1259 if (! wv) return;
1260
1261 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1262
1263 if (wv->contents && (wv->contents != (widget_value*)1))
1264 {
1265 free_menubar_widget_value_tree (wv->contents);
1266 wv->contents = (widget_value *) 0xDEADBEEF;
1267 }
1268 if (wv->next)
1269 {
1270 free_menubar_widget_value_tree (wv->next);
1271 wv->next = (widget_value *) 0xDEADBEEF;
1272 }
1273 BLOCK_INPUT;
1274 free_widget_value (wv);
1275 UNBLOCK_INPUT;
1276 }
1277 \f
1278 /* Return a tree of widget_value structures for a menu bar item
1279 whose event type is ITEM_KEY (with string ITEM_NAME)
1280 and whose contents come from the list of keymaps MAPS. */
1281
1282 static widget_value *
1283 single_submenu (item_key, item_name, maps)
1284 Lisp_Object item_key, item_name, maps;
1285 {
1286 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1287 int i;
1288 int submenu_depth = 0;
1289 Lisp_Object length;
1290 int len;
1291 Lisp_Object *mapvec;
1292 widget_value **submenu_stack;
1293 int mapno;
1294 int previous_items = menu_items_used;
1295 int top_level_items = 0;
1296
1297 length = Flength (maps);
1298 len = XINT (length);
1299
1300 /* Convert the list MAPS into a vector MAPVEC. */
1301 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1302 for (i = 0; i < len; i++)
1303 {
1304 mapvec[i] = Fcar (maps);
1305 maps = Fcdr (maps);
1306 }
1307
1308 menu_items_n_panes = 0;
1309
1310 /* Loop over the given keymaps, making a pane for each map.
1311 But don't make a pane that is empty--ignore that map instead. */
1312 for (i = 0; i < len; i++)
1313 {
1314 if (SYMBOLP (mapvec[i])
1315 || (CONSP (mapvec[i])
1316 && NILP (Fkeymapp (mapvec[i]))))
1317 {
1318 /* Here we have a command at top level in the menu bar
1319 as opposed to a submenu. */
1320 top_level_items = 1;
1321 push_menu_pane (Qnil, Qnil);
1322 push_menu_item (item_name, Qt, item_key, mapvec[i], Qnil);
1323 }
1324 else
1325 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1326 }
1327
1328 /* Create a tree of widget_value objects
1329 representing the panes and their items. */
1330
1331 submenu_stack
1332 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1333 wv = xmalloc_widget_value ();
1334 wv->name = "menu";
1335 wv->value = 0;
1336 wv->enabled = 1;
1337 first_wv = wv;
1338 save_wv = 0;
1339 prev_wv = 0;
1340
1341 /* Loop over all panes and items made during this call
1342 and construct a tree of widget_value objects.
1343 Ignore the panes and items made by previous calls to
1344 single_submenu, even though those are also in menu_items. */
1345 i = previous_items;
1346 while (i < menu_items_used)
1347 {
1348 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1349 {
1350 submenu_stack[submenu_depth++] = save_wv;
1351 save_wv = prev_wv;
1352 prev_wv = 0;
1353 i++;
1354 }
1355 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1356 {
1357 prev_wv = save_wv;
1358 save_wv = submenu_stack[--submenu_depth];
1359 i++;
1360 }
1361 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1362 && submenu_depth != 0)
1363 i += MENU_ITEMS_PANE_LENGTH;
1364 /* Ignore a nil in the item list.
1365 It's meaningful only for dialog boxes. */
1366 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1367 i += 1;
1368 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1369 {
1370 /* Create a new pane. */
1371 Lisp_Object pane_name, prefix;
1372 char *pane_string;
1373 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1374 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1375 #ifndef HAVE_MULTILINGUAL_MENU
1376 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1377 pane_name = string_make_unibyte (pane_name);
1378 #endif
1379 pane_string = (NILP (pane_name)
1380 ? "" : (char *) XSTRING (pane_name)->data);
1381 /* If there is just one top-level pane, put all its items directly
1382 under the top-level menu. */
1383 if (menu_items_n_panes == 1)
1384 pane_string = "";
1385
1386 /* If the pane has a meaningful name,
1387 make the pane a top-level menu item
1388 with its items as a submenu beneath it. */
1389 if (strcmp (pane_string, ""))
1390 {
1391 wv = xmalloc_widget_value ();
1392 if (save_wv)
1393 save_wv->next = wv;
1394 else
1395 first_wv->contents = wv;
1396 wv->name = pane_string;
1397 /* Ignore the @ that means "separate pane".
1398 This is a kludge, but this isn't worth more time. */
1399 if (!NILP (prefix) && wv->name[0] == '@')
1400 wv->name++;
1401 wv->value = 0;
1402 wv->enabled = 1;
1403 }
1404 save_wv = wv;
1405 prev_wv = 0;
1406 i += MENU_ITEMS_PANE_LENGTH;
1407 }
1408 else
1409 {
1410 /* Create a new item within current pane. */
1411 Lisp_Object item_name, enable, descrip, def;
1412 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1413 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1414 descrip
1415 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1416 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1417 #ifndef HAVE_MULTILINGUAL_MENU
1418 if (STRING_MULTIBYTE (item_name))
1419 item_name = string_make_unibyte (item_name);
1420 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1421 descrip = string_make_unibyte (descrip);
1422 #endif
1423 wv = xmalloc_widget_value ();
1424 if (prev_wv)
1425 prev_wv->next = wv;
1426 else
1427 save_wv->contents = wv;
1428
1429 wv->name = (char *) XSTRING (item_name)->data;
1430 if (!NILP (descrip))
1431 wv->key = (char *) XSTRING (descrip)->data;
1432 wv->value = 0;
1433 /* The EMACS_INT cast avoids a warning. There's no problem
1434 as long as pointers have enough bits to hold small integers. */
1435 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1436 wv->enabled = !NILP (enable);
1437 prev_wv = wv;
1438
1439 i += MENU_ITEMS_ITEM_LENGTH;
1440 }
1441 }
1442
1443 /* If we have just one "menu item"
1444 that was originally a button, return it by itself. */
1445 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1446 {
1447 wv = first_wv->contents;
1448 free_widget_value (first_wv);
1449 return wv;
1450 }
1451
1452 return first_wv;
1453 }
1454 \f
1455 extern void EmacsFrameSetCharSize ();
1456
1457 /* Recompute all the widgets of frame F, when the menu bar
1458 has been changed. */
1459
1460 static void
1461 update_frame_menubar (f)
1462 FRAME_PTR f;
1463 {
1464 struct x_output *x = f->output_data.x;
1465 int columns, rows;
1466 int menubar_changed;
1467
1468 Dimension shell_height;
1469
1470 /* We assume the menubar contents has changed if the global flag is set,
1471 or if the current buffer has changed, or if the menubar has never
1472 been updated before.
1473 */
1474 menubar_changed = (x->menubar_widget
1475 && !XtIsManaged (x->menubar_widget));
1476
1477 if (! (menubar_changed))
1478 return;
1479
1480 BLOCK_INPUT;
1481 /* Save the size of the frame because the pane widget doesn't accept to
1482 resize itself. So force it. */
1483 columns = f->width;
1484 rows = f->height;
1485
1486 /* Do the voodoo which means "I'm changing lots of things, don't try to
1487 refigure sizes until I'm done." */
1488 lw_refigure_widget (x->column_widget, False);
1489
1490 /* the order in which children are managed is the top to
1491 bottom order in which they are displayed in the paned window.
1492 First, remove the text-area widget.
1493 */
1494 XtUnmanageChild (x->edit_widget);
1495
1496 /* remove the menubar that is there now, and put up the menubar that
1497 should be there.
1498 */
1499 if (menubar_changed)
1500 {
1501 XtManageChild (x->menubar_widget);
1502 XtMapWidget (x->menubar_widget);
1503 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0);
1504 }
1505
1506 /* Re-manage the text-area widget, and then thrash the sizes. */
1507 XtManageChild (x->edit_widget);
1508 lw_refigure_widget (x->column_widget, True);
1509
1510 /* Force the pane widget to resize itself with the right values. */
1511 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1512
1513 UNBLOCK_INPUT;
1514 }
1515
1516 /* Set the contents of the menubar widgets of frame F.
1517 The argument FIRST_TIME is currently ignored;
1518 it is set the first time this is called, from initialize_frame_menubar. */
1519
1520 void
1521 set_frame_menubar (f, first_time, deep_p)
1522 FRAME_PTR f;
1523 int first_time;
1524 int deep_p;
1525 {
1526 Widget menubar_widget = f->output_data.x->menubar_widget;
1527 Lisp_Object tail, items, frame;
1528 widget_value *wv, *first_wv, *prev_wv = 0;
1529 int i;
1530 LWLIB_ID id;
1531
1532 XSETFRAME (Vmenu_updating_frame, f);
1533
1534 if (f->output_data.x->id == 0)
1535 f->output_data.x->id = next_menubar_widget_id++;
1536 id = f->output_data.x->id;
1537
1538 if (! menubar_widget)
1539 deep_p = 1;
1540 else if (pending_menu_activation && !deep_p)
1541 deep_p = 1;
1542 /* Make the first call for any given frame always go deep. */
1543 else if (!f->output_data.x->saved_menu_event && !deep_p)
1544 {
1545 deep_p = 1;
1546 f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent));
1547 f->output_data.x->saved_menu_event->type = 0;
1548 }
1549
1550 wv = xmalloc_widget_value ();
1551 wv->name = "menubar";
1552 wv->value = 0;
1553 wv->enabled = 1;
1554 first_wv = wv;
1555
1556 if (deep_p)
1557 {
1558 /* Make a widget-value tree representing the entire menu trees. */
1559
1560 struct buffer *prev = current_buffer;
1561 Lisp_Object buffer;
1562 int specpdl_count = specpdl_ptr - specpdl;
1563 int previous_menu_items_used = f->menu_bar_items_used;
1564 Lisp_Object *previous_items
1565 = (Lisp_Object *) alloca (previous_menu_items_used
1566 * sizeof (Lisp_Object));
1567
1568 /* If we are making a new widget, its contents are empty,
1569 do always reinitialize them. */
1570 if (! menubar_widget)
1571 previous_menu_items_used = 0;
1572
1573 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1574 specbind (Qinhibit_quit, Qt);
1575 /* Don't let the debugger step into this code
1576 because it is not reentrant. */
1577 specbind (Qdebug_on_next_call, Qnil);
1578
1579 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1580 if (NILP (Voverriding_local_map_menu_flag))
1581 {
1582 specbind (Qoverriding_terminal_local_map, Qnil);
1583 specbind (Qoverriding_local_map, Qnil);
1584 }
1585
1586 set_buffer_internal_1 (XBUFFER (buffer));
1587
1588 /* Run the Lucid hook. */
1589 call1 (Vrun_hooks, Qactivate_menubar_hook);
1590 /* If it has changed current-menubar from previous value,
1591 really recompute the menubar from the value. */
1592 if (! NILP (Vlucid_menu_bar_dirty_flag))
1593 call0 (Qrecompute_lucid_menubar);
1594 safe_run_hooks (Qmenu_bar_update_hook);
1595 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1596
1597 items = FRAME_MENU_BAR_ITEMS (f);
1598
1599 inhibit_garbage_collection ();
1600
1601 /* Save the frame's previous menu bar contents data. */
1602 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1603 previous_menu_items_used * sizeof (Lisp_Object));
1604
1605 /* Fill in the current menu bar contents. */
1606 menu_items = f->menu_bar_vector;
1607 menu_items_allocated = XVECTOR (menu_items)->size;
1608 init_menu_items ();
1609 for (i = 0; i < XVECTOR (items)->size; i += 4)
1610 {
1611 Lisp_Object key, string, maps;
1612
1613 key = XVECTOR (items)->contents[i];
1614 string = XVECTOR (items)->contents[i + 1];
1615 maps = XVECTOR (items)->contents[i + 2];
1616 if (NILP (string))
1617 break;
1618
1619 wv = single_submenu (key, string, maps);
1620 if (prev_wv)
1621 prev_wv->next = wv;
1622 else
1623 first_wv->contents = wv;
1624 /* Don't set wv->name here; GC during the loop might relocate it. */
1625 wv->enabled = 1;
1626 prev_wv = wv;
1627 }
1628
1629 finish_menu_items ();
1630
1631 set_buffer_internal_1 (prev);
1632 unbind_to (specpdl_count, Qnil);
1633
1634 /* If there has been no change in the Lisp-level contents
1635 of the menu bar, skip redisplaying it. Just exit. */
1636
1637 for (i = 0; i < previous_menu_items_used; i++)
1638 if (menu_items_used == i
1639 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1640 break;
1641 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1642 {
1643 free_menubar_widget_value_tree (first_wv);
1644 menu_items = Qnil;
1645
1646 return;
1647 }
1648
1649 /* Now GC cannot happen during the lifetime of the widget_value,
1650 so it's safe to store data from a Lisp_String. */
1651 wv = first_wv->contents;
1652 for (i = 0; i < XVECTOR (items)->size; i += 4)
1653 {
1654 Lisp_Object string;
1655 string = XVECTOR (items)->contents[i + 1];
1656 if (NILP (string))
1657 break;
1658 wv->name = (char *) XSTRING (string)->data;
1659 wv = wv->next;
1660 }
1661
1662 f->menu_bar_vector = menu_items;
1663 f->menu_bar_items_used = menu_items_used;
1664 menu_items = Qnil;
1665 }
1666 else
1667 {
1668 /* Make a widget-value tree containing
1669 just the top level menu bar strings. */
1670
1671 items = FRAME_MENU_BAR_ITEMS (f);
1672 for (i = 0; i < XVECTOR (items)->size; i += 4)
1673 {
1674 Lisp_Object string;
1675
1676 string = XVECTOR (items)->contents[i + 1];
1677 if (NILP (string))
1678 break;
1679
1680 wv = xmalloc_widget_value ();
1681 wv->name = (char *) XSTRING (string)->data;
1682 wv->value = 0;
1683 wv->enabled = 1;
1684 /* This prevents lwlib from assuming this
1685 menu item is really supposed to be empty. */
1686 /* The EMACS_INT cast avoids a warning.
1687 This value just has to be different from small integers. */
1688 wv->call_data = (void *) (EMACS_INT) (-1);
1689
1690 if (prev_wv)
1691 prev_wv->next = wv;
1692 else
1693 first_wv->contents = wv;
1694 prev_wv = wv;
1695 }
1696
1697 /* Forget what we thought we knew about what is in the
1698 detailed contents of the menu bar menus.
1699 Changing the top level always destroys the contents. */
1700 f->menu_bar_items_used = 0;
1701 }
1702
1703 /* Create or update the menu bar widget. */
1704
1705 BLOCK_INPUT;
1706
1707 if (menubar_widget)
1708 {
1709 /* Disable resizing (done for Motif!) */
1710 lw_allow_resizing (f->output_data.x->widget, False);
1711
1712 /* The third arg is DEEP_P, which says to consider the entire
1713 menu trees we supply, rather than just the menu bar item names. */
1714 lw_modify_all_widgets (id, first_wv, deep_p);
1715
1716 /* Re-enable the edit widget to resize. */
1717 lw_allow_resizing (f->output_data.x->widget, True);
1718 }
1719 else
1720 {
1721 menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv,
1722 f->output_data.x->column_widget,
1723 0,
1724 popup_activate_callback,
1725 menubar_selection_callback,
1726 popup_deactivate_callback);
1727 f->output_data.x->menubar_widget = menubar_widget;
1728 }
1729
1730 {
1731 int menubar_size
1732 = (f->output_data.x->menubar_widget
1733 ? (f->output_data.x->menubar_widget->core.height
1734 + f->output_data.x->menubar_widget->core.border_width)
1735 : 0);
1736
1737 #if 0 /* Experimentally, we now get the right results
1738 for -geometry -0-0 without this. 24 Aug 96, rms. */
1739 #ifdef USE_LUCID
1740 if (FRAME_EXTERNAL_MENU_BAR (f))
1741 {
1742 Dimension ibw = 0;
1743 XtVaGetValues (f->output_data.x->column_widget,
1744 XtNinternalBorderWidth, &ibw, NULL);
1745 menubar_size += ibw;
1746 }
1747 #endif /* USE_LUCID */
1748 #endif /* 0 */
1749
1750 f->output_data.x->menubar_height = menubar_size;
1751 }
1752
1753 free_menubar_widget_value_tree (first_wv);
1754
1755 update_frame_menubar (f);
1756
1757 UNBLOCK_INPUT;
1758 }
1759
1760 /* Called from Fx_create_frame to create the initial menubar of a frame
1761 before it is mapped, so that the window is mapped with the menubar already
1762 there instead of us tacking it on later and thrashing the window after it
1763 is visible. */
1764
1765 void
1766 initialize_frame_menubar (f)
1767 FRAME_PTR f;
1768 {
1769 /* This function is called before the first chance to redisplay
1770 the frame. It has to be, so the frame will have the right size. */
1771 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1772 set_frame_menubar (f, 1, 1);
1773 }
1774
1775 /* Get rid of the menu bar of frame F, and free its storage.
1776 This is used when deleting a frame, and when turning off the menu bar. */
1777
1778 void
1779 free_frame_menubar (f)
1780 FRAME_PTR f;
1781 {
1782 Widget menubar_widget;
1783 int id;
1784
1785 menubar_widget = f->output_data.x->menubar_widget;
1786
1787 f->output_data.x->menubar_height = 0;
1788
1789 if (menubar_widget)
1790 {
1791 BLOCK_INPUT;
1792 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
1793 UNBLOCK_INPUT;
1794 }
1795 }
1796
1797 #endif /* USE_X_TOOLKIT */
1798 \f
1799 /* xmenu_show actually displays a menu using the panes and items in menu_items
1800 and returns the value selected from it.
1801 There are two versions of xmenu_show, one for Xt and one for Xlib.
1802 Both assume input is blocked by the caller. */
1803
1804 /* F is the frame the menu is for.
1805 X and Y are the frame-relative specified position,
1806 relative to the inside upper left corner of the frame F.
1807 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1808 KEYMAPS is 1 if this menu was specified with keymaps;
1809 in that case, we return a list containing the chosen item's value
1810 and perhaps also the pane's prefix.
1811 TITLE is the specified menu title.
1812 ERROR is a place to store an error message string in case of failure.
1813 (We return nil on failure, but the value doesn't actually matter.) */
1814
1815 #ifdef USE_X_TOOLKIT
1816
1817 /* We need a unique id for each widget handled by the Lucid Widget
1818 library.
1819
1820 For the main windows, and popup menus, we use this counter,
1821 which we increment each time after use. This starts from 1<<16.
1822
1823 For menu bars, we use numbers starting at 0, counted in
1824 next_menubar_widget_id. */
1825 LWLIB_ID widget_id_tick;
1826
1827 #ifdef __STDC__
1828 static Lisp_Object *volatile menu_item_selection;
1829 #else
1830 static Lisp_Object *menu_item_selection;
1831 #endif
1832
1833 static void
1834 popup_selection_callback (widget, id, client_data)
1835 Widget widget;
1836 LWLIB_ID id;
1837 XtPointer client_data;
1838 {
1839 menu_item_selection = (Lisp_Object *) client_data;
1840 }
1841
1842 static Lisp_Object
1843 xmenu_show (f, x, y, for_click, keymaps, title, error)
1844 FRAME_PTR f;
1845 int x;
1846 int y;
1847 int for_click;
1848 int keymaps;
1849 Lisp_Object title;
1850 char **error;
1851 {
1852 int i;
1853 LWLIB_ID menu_id;
1854 Widget menu;
1855 Arg av[2];
1856 int ac = 0;
1857 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1858 widget_value **submenu_stack
1859 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1860 Lisp_Object *subprefix_stack
1861 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1862 int submenu_depth = 0;
1863 XButtonPressedEvent dummy;
1864
1865 int first_pane;
1866 int next_release_must_exit = 0;
1867
1868 *error = NULL;
1869
1870 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1871 {
1872 *error = "Empty menu";
1873 return Qnil;
1874 }
1875
1876 /* Create a tree of widget_value objects
1877 representing the panes and their items. */
1878 wv = xmalloc_widget_value ();
1879 wv->name = "menu";
1880 wv->value = 0;
1881 wv->enabled = 1;
1882 first_wv = wv;
1883 first_pane = 1;
1884
1885 /* Loop over all panes and items, filling in the tree. */
1886 i = 0;
1887 while (i < menu_items_used)
1888 {
1889 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1890 {
1891 submenu_stack[submenu_depth++] = save_wv;
1892 save_wv = prev_wv;
1893 prev_wv = 0;
1894 first_pane = 1;
1895 i++;
1896 }
1897 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1898 {
1899 prev_wv = save_wv;
1900 save_wv = submenu_stack[--submenu_depth];
1901 first_pane = 0;
1902 i++;
1903 }
1904 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1905 && submenu_depth != 0)
1906 i += MENU_ITEMS_PANE_LENGTH;
1907 /* Ignore a nil in the item list.
1908 It's meaningful only for dialog boxes. */
1909 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1910 i += 1;
1911 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1912 {
1913 /* Create a new pane. */
1914 Lisp_Object pane_name, prefix;
1915 char *pane_string;
1916 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1917 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1918 #ifndef HAVE_MULTILINGUAL_MENU
1919 if (!NILP (pane_name) && STRING_MULTIBYTE (pane_name))
1920 pane_name = string_make_unibyte (pane_name);
1921 #endif
1922 pane_string = (NILP (pane_name)
1923 ? "" : (char *) XSTRING (pane_name)->data);
1924 /* If there is just one top-level pane, put all its items directly
1925 under the top-level menu. */
1926 if (menu_items_n_panes == 1)
1927 pane_string = "";
1928
1929 /* If the pane has a meaningful name,
1930 make the pane a top-level menu item
1931 with its items as a submenu beneath it. */
1932 if (!keymaps && strcmp (pane_string, ""))
1933 {
1934 wv = xmalloc_widget_value ();
1935 if (save_wv)
1936 save_wv->next = wv;
1937 else
1938 first_wv->contents = wv;
1939 wv->name = pane_string;
1940 if (keymaps && !NILP (prefix))
1941 wv->name++;
1942 wv->value = 0;
1943 wv->enabled = 1;
1944 save_wv = wv;
1945 prev_wv = 0;
1946 }
1947 else if (first_pane)
1948 {
1949 save_wv = wv;
1950 prev_wv = 0;
1951 }
1952 first_pane = 0;
1953 i += MENU_ITEMS_PANE_LENGTH;
1954 }
1955 else
1956 {
1957 /* Create a new item within current pane. */
1958 Lisp_Object item_name, enable, descrip, def;
1959 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1960 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1961 descrip
1962 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1963 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1964 #ifndef HAVE_MULTILINGUAL_MENU
1965 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1966 item_name = string_make_unibyte (item_name);
1967 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1968 item_name = string_make_unibyte (descrip);
1969 #endif
1970
1971 wv = xmalloc_widget_value ();
1972 if (prev_wv)
1973 prev_wv->next = wv;
1974 else
1975 save_wv->contents = wv;
1976 wv->name = (char *) XSTRING (item_name)->data;
1977 if (!NILP (descrip))
1978 wv->key = (char *) XSTRING (descrip)->data;
1979 wv->value = 0;
1980 /* If this item has a null value,
1981 make the call_data null so that it won't display a box
1982 when the mouse is on it. */
1983 wv->call_data
1984 = (!NILP (def) ? (void *) &XVECTOR (menu_items)->contents[i] : 0);
1985 wv->enabled = !NILP (enable);
1986 prev_wv = wv;
1987
1988 i += MENU_ITEMS_ITEM_LENGTH;
1989 }
1990 }
1991
1992 /* Deal with the title, if it is non-nil. */
1993 if (!NILP (title))
1994 {
1995 widget_value *wv_title = xmalloc_widget_value ();
1996 widget_value *wv_sep1 = xmalloc_widget_value ();
1997 widget_value *wv_sep2 = xmalloc_widget_value ();
1998
1999 wv_sep2->name = "--";
2000 wv_sep2->next = first_wv->contents;
2001
2002 wv_sep1->name = "--";
2003 wv_sep1->next = wv_sep2;
2004
2005 #ifndef HAVE_MULTILINGUAL_MENU
2006 if (STRING_MULTIBYTE (title))
2007 title = string_make_unibyte (title);
2008 #endif
2009 wv_title->name = (char *) XSTRING (title)->data;
2010 wv_title->enabled = True;
2011 wv_title->next = wv_sep1;
2012 first_wv->contents = wv_title;
2013 }
2014
2015 /* Actually create the menu. */
2016 menu_id = widget_id_tick++;
2017 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
2018 f->output_data.x->widget, 1, 0,
2019 popup_selection_callback,
2020 popup_deactivate_callback);
2021
2022 /* Adjust coordinates to relative to the outer (window manager) window. */
2023 {
2024 Window child;
2025 int win_x = 0, win_y = 0;
2026
2027 /* Find the position of the outside upper-left corner of
2028 the inner window, with respect to the outer window. */
2029 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
2030 {
2031 BLOCK_INPUT;
2032 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2033
2034 /* From-window, to-window. */
2035 f->output_data.x->window_desc,
2036 f->output_data.x->parent_desc,
2037
2038 /* From-position, to-position. */
2039 0, 0, &win_x, &win_y,
2040
2041 /* Child of window. */
2042 &child);
2043 UNBLOCK_INPUT;
2044 x += win_x;
2045 y += win_y;
2046 }
2047 }
2048
2049 /* Adjust coordinates to be root-window-relative. */
2050 x += f->output_data.x->left_pos;
2051 y += f->output_data.x->top_pos;
2052
2053 dummy.type = ButtonPress;
2054 dummy.serial = 0;
2055 dummy.send_event = 0;
2056 dummy.display = FRAME_X_DISPLAY (f);
2057 dummy.time = CurrentTime;
2058 dummy.root = FRAME_X_DISPLAY_INFO (f)->root_window;
2059 dummy.window = dummy.root;
2060 dummy.subwindow = dummy.root;
2061 dummy.x_root = x;
2062 dummy.y_root = y;
2063 dummy.x = x;
2064 dummy.y = y;
2065 dummy.state = (FRAME_X_DISPLAY_INFO (f)->grabbed >> 1) * Button1Mask;
2066 dummy.button = 0;
2067 for (i = 0; i < 5; i++)
2068 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2069 dummy.button = i;
2070
2071 /* Don't allow any geometry request from the user. */
2072 XtSetArg (av[ac], XtNgeometry, 0); ac++;
2073 XtSetValues (menu, av, ac);
2074
2075 /* Free the widget_value objects we used to specify the contents. */
2076 free_menubar_widget_value_tree (first_wv);
2077
2078 /* No selection has been chosen yet. */
2079 menu_item_selection = 0;
2080
2081 /* Display the menu. */
2082 lw_popup_menu (menu, &dummy);
2083 popup_activated_flag = 1;
2084
2085 /* Process events that apply to the menu. */
2086 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id);
2087
2088 /* fp turned off the following statement and wrote a comment
2089 that it is unnecessary--that the menu has already disappeared.
2090 Nowadays the menu disappears ok, all right, but
2091 we need to delete the widgets or multiple ones will pile up. */
2092 lw_destroy_all_widgets (menu_id);
2093
2094 /* Find the selected item, and its pane, to return
2095 the proper value. */
2096 if (menu_item_selection != 0)
2097 {
2098 Lisp_Object prefix, entry;
2099
2100 prefix = Qnil;
2101 i = 0;
2102 while (i < menu_items_used)
2103 {
2104 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2105 {
2106 subprefix_stack[submenu_depth++] = prefix;
2107 prefix = entry;
2108 i++;
2109 }
2110 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2111 {
2112 prefix = subprefix_stack[--submenu_depth];
2113 i++;
2114 }
2115 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2116 {
2117 prefix
2118 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2119 i += MENU_ITEMS_PANE_LENGTH;
2120 }
2121 /* Ignore a nil in the item list.
2122 It's meaningful only for dialog boxes. */
2123 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2124 i += 1;
2125 else
2126 {
2127 entry
2128 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2129 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2130 {
2131 if (keymaps != 0)
2132 {
2133 int j;
2134
2135 entry = Fcons (entry, Qnil);
2136 if (!NILP (prefix))
2137 entry = Fcons (prefix, entry);
2138 for (j = submenu_depth - 1; j >= 0; j--)
2139 if (!NILP (subprefix_stack[j]))
2140 entry = Fcons (subprefix_stack[j], entry);
2141 }
2142 return entry;
2143 }
2144 i += MENU_ITEMS_ITEM_LENGTH;
2145 }
2146 }
2147 }
2148
2149 return Qnil;
2150 }
2151 \f
2152 static void
2153 dialog_selection_callback (widget, id, client_data)
2154 Widget widget;
2155 LWLIB_ID id;
2156 XtPointer client_data;
2157 {
2158 /* The EMACS_INT cast avoids a warning. There's no problem
2159 as long as pointers have enough bits to hold small integers. */
2160 if ((int) (EMACS_INT) client_data != -1)
2161 menu_item_selection = (Lisp_Object *) client_data;
2162 BLOCK_INPUT;
2163 lw_destroy_all_widgets (id);
2164 UNBLOCK_INPUT;
2165 popup_activated_flag = 0;
2166 }
2167
2168 static char * button_names [] = {
2169 "button1", "button2", "button3", "button4", "button5",
2170 "button6", "button7", "button8", "button9", "button10" };
2171
2172 static Lisp_Object
2173 xdialog_show (f, keymaps, title, error)
2174 FRAME_PTR f;
2175 int keymaps;
2176 Lisp_Object title;
2177 char **error;
2178 {
2179 int i, nb_buttons=0;
2180 LWLIB_ID dialog_id;
2181 Widget menu;
2182 char dialog_name[6];
2183
2184 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2185
2186 /* Number of elements seen so far, before boundary. */
2187 int left_count = 0;
2188 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2189 int boundary_seen = 0;
2190
2191 *error = NULL;
2192
2193 if (menu_items_n_panes > 1)
2194 {
2195 *error = "Multiple panes in dialog box";
2196 return Qnil;
2197 }
2198
2199 /* Create a tree of widget_value objects
2200 representing the text label and buttons. */
2201 {
2202 Lisp_Object pane_name, prefix;
2203 char *pane_string;
2204 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2205 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2206 pane_string = (NILP (pane_name)
2207 ? "" : (char *) XSTRING (pane_name)->data);
2208 prev_wv = xmalloc_widget_value ();
2209 prev_wv->value = pane_string;
2210 if (keymaps && !NILP (prefix))
2211 prev_wv->name++;
2212 prev_wv->enabled = 1;
2213 prev_wv->name = "message";
2214 first_wv = prev_wv;
2215
2216 /* Loop over all panes and items, filling in the tree. */
2217 i = MENU_ITEMS_PANE_LENGTH;
2218 while (i < menu_items_used)
2219 {
2220
2221 /* Create a new item within current pane. */
2222 Lisp_Object item_name, enable, descrip;
2223 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2224 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2225 descrip
2226 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2227
2228 if (NILP (item_name))
2229 {
2230 free_menubar_widget_value_tree (first_wv);
2231 *error = "Submenu in dialog items";
2232 return Qnil;
2233 }
2234 if (EQ (item_name, Qquote))
2235 {
2236 /* This is the boundary between left-side elts
2237 and right-side elts. Stop incrementing right_count. */
2238 boundary_seen = 1;
2239 i++;
2240 continue;
2241 }
2242 if (nb_buttons >= 9)
2243 {
2244 free_menubar_widget_value_tree (first_wv);
2245 *error = "Too many dialog items";
2246 return Qnil;
2247 }
2248
2249 wv = xmalloc_widget_value ();
2250 prev_wv->next = wv;
2251 wv->name = (char *) button_names[nb_buttons];
2252 if (!NILP (descrip))
2253 wv->key = (char *) XSTRING (descrip)->data;
2254 wv->value = (char *) XSTRING (item_name)->data;
2255 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
2256 wv->enabled = !NILP (enable);
2257 prev_wv = wv;
2258
2259 if (! boundary_seen)
2260 left_count++;
2261
2262 nb_buttons++;
2263 i += MENU_ITEMS_ITEM_LENGTH;
2264 }
2265
2266 /* If the boundary was not specified,
2267 by default put half on the left and half on the right. */
2268 if (! boundary_seen)
2269 left_count = nb_buttons - nb_buttons / 2;
2270
2271 wv = xmalloc_widget_value ();
2272 wv->name = dialog_name;
2273
2274 /* Dialog boxes use a really stupid name encoding
2275 which specifies how many buttons to use
2276 and how many buttons are on the right.
2277 The Q means something also. */
2278 dialog_name[0] = 'Q';
2279 dialog_name[1] = '0' + nb_buttons;
2280 dialog_name[2] = 'B';
2281 dialog_name[3] = 'R';
2282 /* Number of buttons to put on the right. */
2283 dialog_name[4] = '0' + nb_buttons - left_count;
2284 dialog_name[5] = 0;
2285 wv->contents = first_wv;
2286 first_wv = wv;
2287 }
2288
2289 /* Actually create the dialog. */
2290 dialog_id = widget_id_tick++;
2291 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2292 f->output_data.x->widget, 1, 0,
2293 dialog_selection_callback, 0);
2294 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
2295 /* Free the widget_value objects we used to specify the contents. */
2296 free_menubar_widget_value_tree (first_wv);
2297
2298 /* No selection has been chosen yet. */
2299 menu_item_selection = 0;
2300
2301 /* Display the menu. */
2302 lw_pop_up_all_widgets (dialog_id);
2303 popup_activated_flag = 1;
2304
2305 /* Process events that apply to the menu. */
2306 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2307
2308 lw_destroy_all_widgets (dialog_id);
2309
2310 /* Find the selected item, and its pane, to return
2311 the proper value. */
2312 if (menu_item_selection != 0)
2313 {
2314 Lisp_Object prefix;
2315
2316 prefix = Qnil;
2317 i = 0;
2318 while (i < menu_items_used)
2319 {
2320 Lisp_Object entry;
2321
2322 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2323 {
2324 prefix
2325 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2326 i += MENU_ITEMS_PANE_LENGTH;
2327 }
2328 else
2329 {
2330 entry
2331 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2332 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2333 {
2334 if (keymaps != 0)
2335 {
2336 entry = Fcons (entry, Qnil);
2337 if (!NILP (prefix))
2338 entry = Fcons (prefix, entry);
2339 }
2340 return entry;
2341 }
2342 i += MENU_ITEMS_ITEM_LENGTH;
2343 }
2344 }
2345 }
2346
2347 return Qnil;
2348 }
2349 #else /* not USE_X_TOOLKIT */
2350
2351 static Lisp_Object
2352 xmenu_show (f, x, y, for_click, keymaps, title, error)
2353 FRAME_PTR f;
2354 int x, y;
2355 int for_click;
2356 int keymaps;
2357 Lisp_Object title;
2358 char **error;
2359 {
2360 Window root;
2361 XMenu *menu;
2362 int pane, selidx, lpane, status;
2363 Lisp_Object entry, pane_prefix;
2364 char *datap;
2365 int ulx, uly, width, height;
2366 int dispwidth, dispheight;
2367 int i, j;
2368 int maxwidth;
2369 int dummy_int;
2370 unsigned int dummy_uint;
2371
2372 *error = 0;
2373 if (menu_items_n_panes == 0)
2374 return Qnil;
2375
2376 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2377 {
2378 *error = "Empty menu";
2379 return Qnil;
2380 }
2381
2382 /* Figure out which root window F is on. */
2383 XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root,
2384 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
2385 &dummy_uint, &dummy_uint);
2386
2387 /* Make the menu on that window. */
2388 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
2389 if (menu == NULL)
2390 {
2391 *error = "Can't create menu";
2392 return Qnil;
2393 }
2394
2395 #ifdef HAVE_X_WINDOWS
2396 /* Adjust coordinates to relative to the outer (window manager) window. */
2397 {
2398 Window child;
2399 int win_x = 0, win_y = 0;
2400
2401 /* Find the position of the outside upper-left corner of
2402 the inner window, with respect to the outer window. */
2403 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
2404 {
2405 BLOCK_INPUT;
2406 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2407
2408 /* From-window, to-window. */
2409 f->output_data.x->window_desc,
2410 f->output_data.x->parent_desc,
2411
2412 /* From-position, to-position. */
2413 0, 0, &win_x, &win_y,
2414
2415 /* Child of window. */
2416 &child);
2417 UNBLOCK_INPUT;
2418 x += win_x;
2419 y += win_y;
2420 }
2421 }
2422 #endif /* HAVE_X_WINDOWS */
2423
2424 /* Adjust coordinates to be root-window-relative. */
2425 x += f->output_data.x->left_pos;
2426 y += f->output_data.x->top_pos;
2427
2428 /* Create all the necessary panes and their items. */
2429 i = 0;
2430 while (i < menu_items_used)
2431 {
2432 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2433 {
2434 /* Create a new pane. */
2435 Lisp_Object pane_name, prefix;
2436 char *pane_string;
2437
2438 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
2439 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2440 pane_string = (NILP (pane_name)
2441 ? "" : (char *) XSTRING (pane_name)->data);
2442 if (keymaps && !NILP (prefix))
2443 pane_string++;
2444
2445 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
2446 if (lpane == XM_FAILURE)
2447 {
2448 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2449 *error = "Can't create pane";
2450 return Qnil;
2451 }
2452 i += MENU_ITEMS_PANE_LENGTH;
2453
2454 /* Find the width of the widest item in this pane. */
2455 maxwidth = 0;
2456 j = i;
2457 while (j < menu_items_used)
2458 {
2459 Lisp_Object item;
2460 item = XVECTOR (menu_items)->contents[j];
2461 if (EQ (item, Qt))
2462 break;
2463 if (NILP (item))
2464 {
2465 j++;
2466 continue;
2467 }
2468 width = STRING_BYTES (XSTRING (item));
2469 if (width > maxwidth)
2470 maxwidth = width;
2471
2472 j += MENU_ITEMS_ITEM_LENGTH;
2473 }
2474 }
2475 /* Ignore a nil in the item list.
2476 It's meaningful only for dialog boxes. */
2477 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2478 i += 1;
2479 else
2480 {
2481 /* Create a new item within current pane. */
2482 Lisp_Object item_name, enable, descrip;
2483 unsigned char *item_data;
2484
2485 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2486 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2487 descrip
2488 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2489 if (!NILP (descrip))
2490 {
2491 int gap = maxwidth - STRING_BYTES (XSTRING (item_name));
2492 #ifdef C_ALLOCA
2493 Lisp_Object spacer;
2494 spacer = Fmake_string (make_number (gap), make_number (' '));
2495 item_name = concat2 (item_name, spacer);
2496 item_name = concat2 (item_name, descrip);
2497 item_data = XSTRING (item_name)->data;
2498 #else
2499 /* if alloca is fast, use that to make the space,
2500 to reduce gc needs. */
2501 item_data
2502 = (unsigned char *) alloca (maxwidth
2503 + STRING_BYTES (XSTRING (descrip)) + 1);
2504 bcopy (XSTRING (item_name)->data, item_data,
2505 STRING_BYTES (XSTRING (item_name)));
2506 for (j = XSTRING (item_name)->size; j < maxwidth; j++)
2507 item_data[j] = ' ';
2508 bcopy (XSTRING (descrip)->data, item_data + j,
2509 STRING_BYTES (XSTRING (descrip)));
2510 item_data[j + STRING_BYTES (XSTRING (descrip))] = 0;
2511 #endif
2512 }
2513 else
2514 item_data = XSTRING (item_name)->data;
2515
2516 if (XMenuAddSelection (FRAME_X_DISPLAY (f),
2517 menu, lpane, 0, item_data,
2518 !NILP (enable))
2519 == XM_FAILURE)
2520 {
2521 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2522 *error = "Can't add selection to menu";
2523 return Qnil;
2524 }
2525 i += MENU_ITEMS_ITEM_LENGTH;
2526 }
2527 }
2528
2529 /* All set and ready to fly. */
2530 XMenuRecompute (FRAME_X_DISPLAY (f), menu);
2531 dispwidth = DisplayWidth (FRAME_X_DISPLAY (f),
2532 XScreenNumberOfScreen (FRAME_X_SCREEN (f)));
2533 dispheight = DisplayHeight (FRAME_X_DISPLAY (f),
2534 XScreenNumberOfScreen (FRAME_X_SCREEN (f)));
2535 x = min (x, dispwidth);
2536 y = min (y, dispheight);
2537 x = max (x, 1);
2538 y = max (y, 1);
2539 XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y,
2540 &ulx, &uly, &width, &height);
2541 if (ulx+width > dispwidth)
2542 {
2543 x -= (ulx + width) - dispwidth;
2544 ulx = dispwidth - width;
2545 }
2546 if (uly+height > dispheight)
2547 {
2548 y -= (uly + height) - dispheight;
2549 uly = dispheight - height;
2550 }
2551 if (ulx < 0) x -= ulx;
2552 if (uly < 0) y -= uly;
2553
2554 XMenuSetAEQ (menu, TRUE);
2555 XMenuSetFreeze (menu, TRUE);
2556 pane = selidx = 0;
2557
2558 status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
2559 x, y, ButtonReleaseMask, &datap);
2560
2561
2562 #ifdef HAVE_X_WINDOWS
2563 /* Assume the mouse has moved out of the X window.
2564 If it has actually moved in, we will get an EnterNotify. */
2565 x_mouse_leave (FRAME_X_DISPLAY_INFO (f));
2566 #endif
2567
2568 switch (status)
2569 {
2570 case XM_SUCCESS:
2571 #ifdef XDEBUG
2572 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
2573 #endif
2574
2575 /* Find the item number SELIDX in pane number PANE. */
2576 i = 0;
2577 while (i < menu_items_used)
2578 {
2579 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2580 {
2581 if (pane == 0)
2582 pane_prefix
2583 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2584 pane--;
2585 i += MENU_ITEMS_PANE_LENGTH;
2586 }
2587 else
2588 {
2589 if (pane == -1)
2590 {
2591 if (selidx == 0)
2592 {
2593 entry
2594 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2595 if (keymaps != 0)
2596 {
2597 entry = Fcons (entry, Qnil);
2598 if (!NILP (pane_prefix))
2599 entry = Fcons (pane_prefix, entry);
2600 }
2601 break;
2602 }
2603 selidx--;
2604 }
2605 i += MENU_ITEMS_ITEM_LENGTH;
2606 }
2607 }
2608 break;
2609
2610 case XM_FAILURE:
2611 *error = "Can't activate menu";
2612 case XM_IA_SELECT:
2613 case XM_NO_SELECT:
2614 entry = Qnil;
2615 break;
2616 }
2617 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2618
2619 #ifdef HAVE_X_WINDOWS
2620 /* State that no mouse buttons are now held.
2621 (The oldXMenu code doesn't track this info for us.)
2622 That is not necessarily true, but the fiction leads to reasonable
2623 results, and it is a pain to ask which are actually held now. */
2624 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
2625 #endif
2626
2627 return entry;
2628 }
2629
2630 #endif /* not USE_X_TOOLKIT */
2631
2632 #endif /* HAVE_MENUS */
2633 \f
2634 void
2635 syms_of_xmenu ()
2636 {
2637 staticpro (&menu_items);
2638 menu_items = Qnil;
2639
2640 Qdebug_on_next_call = intern ("debug-on-next-call");
2641 staticpro (&Qdebug_on_next_call);
2642
2643 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2644 "Frame for which we are updating a menu.\n\
2645 The enable predicate for a menu command should check this variable.");
2646 Vmenu_updating_frame = Qnil;
2647
2648 #ifdef USE_X_TOOLKIT
2649 widget_id_tick = (1<<16);
2650 next_menubar_widget_id = 1;
2651 #endif
2652
2653 defsubr (&Sx_popup_menu);
2654 #ifdef HAVE_MENUS
2655 defsubr (&Sx_popup_dialog);
2656 #endif
2657 }