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