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