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