Merge changes made in Gnus trunk.
[bpt/emacs.git] / src / menu.c
1 /* Platform-independent code for terminal communications.
2 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2011 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 3 of the License, or
9 (at your option) 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. If not, see <http://www.gnu.org/licenses/>. */
18
19 #include <config.h>
20 #include <stdio.h>
21 #include <setjmp.h>
22
23 #include "lisp.h"
24 #include "keyboard.h"
25 #include "keymap.h"
26 #include "frame.h"
27 #include "window.h"
28 #include "termhooks.h"
29 #include "blockinput.h"
30 #include "dispextern.h"
31
32 #ifdef USE_X_TOOLKIT
33 #include "../lwlib/lwlib.h"
34 #endif
35
36 #ifdef HAVE_X_WINDOWS
37 #include "xterm.h"
38 #endif
39
40 #ifdef HAVE_NS
41 #include "nsterm.h"
42 #endif
43
44 #ifdef USE_GTK
45 #include "gtkutil.h"
46 #endif
47
48 #ifdef HAVE_NTGUI
49 #include "w32term.h"
50
51 extern AppendMenuW_Proc unicode_append_menu;
52 extern HMENU current_popup_menu;
53
54 #endif /* HAVE_NTGUI */
55
56 #include "menu.h"
57
58 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
59 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
60 #define HAVE_BOXES 1
61 #endif
62
63 Lisp_Object menu_items;
64
65 /* If non-nil, means that the global vars defined here are already in use.
66 Used to detect cases where we try to re-enter this non-reentrant code. */
67 Lisp_Object menu_items_inuse;
68
69 /* Number of slots currently allocated in menu_items. */
70 int menu_items_allocated;
71
72 /* This is the index in menu_items of the first empty slot. */
73 int menu_items_used;
74
75 /* The number of panes currently recorded in menu_items,
76 excluding those within submenus. */
77 int menu_items_n_panes;
78
79 /* Current depth within submenus. */
80 static int menu_items_submenu_depth;
81
82 void
83 init_menu_items (void)
84 {
85 if (!NILP (menu_items_inuse))
86 error ("Trying to use a menu from within a menu-entry");
87
88 if (NILP (menu_items))
89 {
90 menu_items_allocated = 60;
91 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
92 }
93
94 menu_items_inuse = Qt;
95 menu_items_used = 0;
96 menu_items_n_panes = 0;
97 menu_items_submenu_depth = 0;
98 }
99
100 /* Call at the end of generating the data in menu_items. */
101
102 void
103 finish_menu_items (void)
104 {
105 }
106
107 Lisp_Object
108 unuse_menu_items (Lisp_Object dummy)
109 {
110 return menu_items_inuse = Qnil;
111 }
112
113 /* Call when finished using the data for the current menu
114 in menu_items. */
115
116 void
117 discard_menu_items (void)
118 {
119 /* Free the structure if it is especially large.
120 Otherwise, hold on to it, to save time. */
121 if (menu_items_allocated > 200)
122 {
123 menu_items = Qnil;
124 menu_items_allocated = 0;
125 }
126 xassert (NILP (menu_items_inuse));
127 }
128
129 #ifdef HAVE_NS
130 static Lisp_Object
131 cleanup_popup_menu (Lisp_Object arg)
132 {
133 discard_menu_items ();
134 return Qnil;
135 }
136 #endif
137
138 /* This undoes save_menu_items, and it is called by the specpdl unwind
139 mechanism. */
140
141 static Lisp_Object
142 restore_menu_items (Lisp_Object saved)
143 {
144 menu_items = XCAR (saved);
145 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
146 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
147 saved = XCDR (saved);
148 menu_items_used = XINT (XCAR (saved));
149 saved = XCDR (saved);
150 menu_items_n_panes = XINT (XCAR (saved));
151 saved = XCDR (saved);
152 menu_items_submenu_depth = XINT (XCAR (saved));
153 return Qnil;
154 }
155
156 /* Push the whole state of menu_items processing onto the specpdl.
157 It will be restored when the specpdl is unwound. */
158
159 void
160 save_menu_items (void)
161 {
162 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
163 make_number (menu_items_used),
164 make_number (menu_items_n_panes),
165 make_number (menu_items_submenu_depth));
166 record_unwind_protect (restore_menu_items, saved);
167 menu_items_inuse = Qnil;
168 menu_items = Qnil;
169 }
170
171 \f
172 /* Make the menu_items vector twice as large. */
173
174 static void
175 grow_menu_items (void)
176 {
177 menu_items_allocated *= 2;
178 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
179 }
180
181 /* Begin a submenu. */
182
183 static void
184 push_submenu_start (void)
185 {
186 if (menu_items_used + 1 > menu_items_allocated)
187 grow_menu_items ();
188
189 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
190 menu_items_submenu_depth++;
191 }
192
193 /* End a submenu. */
194
195 static void
196 push_submenu_end (void)
197 {
198 if (menu_items_used + 1 > menu_items_allocated)
199 grow_menu_items ();
200
201 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
202 menu_items_submenu_depth--;
203 }
204
205 /* Indicate boundary between left and right. */
206
207 static void
208 push_left_right_boundary (void)
209 {
210 if (menu_items_used + 1 > menu_items_allocated)
211 grow_menu_items ();
212
213 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
214 }
215
216 /* Start a new menu pane in menu_items.
217 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
218
219 static void
220 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
221 {
222 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
223 grow_menu_items ();
224
225 if (menu_items_submenu_depth == 0)
226 menu_items_n_panes++;
227 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
228 XVECTOR (menu_items)->contents[menu_items_used++] = name;
229 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
230 }
231
232 /* Push one menu item into the current pane. NAME is the string to
233 display. ENABLE if non-nil means this item can be selected. KEY
234 is the key generated by choosing this item, or nil if this item
235 doesn't really have a definition. DEF is the definition of this
236 item. EQUIV is the textual description of the keyboard equivalent
237 for this item (or nil if none). TYPE is the type of this menu
238 item, one of nil, `toggle' or `radio'. */
239
240 static void
241 push_menu_item (Lisp_Object name, Lisp_Object enable, Lisp_Object key, Lisp_Object def, Lisp_Object equiv, Lisp_Object type, Lisp_Object selected, Lisp_Object help)
242 {
243 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
244 grow_menu_items ();
245
246 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
247 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
248 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
249 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
250 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
251 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
252 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
253 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
254
255 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
256 }
257
258 /* Args passed between single_keymap_panes and single_menu_item. */
259 struct skp
260 {
261 Lisp_Object pending_maps;
262 int maxdepth;
263 int notbuttons;
264 };
265
266 static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
267 void *);
268
269 /* This is a recursive subroutine of keymap_panes.
270 It handles one keymap, KEYMAP.
271 The other arguments are passed along
272 or point to local variables of the previous function.
273
274 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
275
276 static void
277 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
278 Lisp_Object prefix, int maxdepth)
279 {
280 struct skp skp;
281 struct gcpro gcpro1;
282
283 skp.pending_maps = Qnil;
284 skp.maxdepth = maxdepth;
285 skp.notbuttons = 0;
286
287 if (maxdepth <= 0)
288 return;
289
290 push_menu_pane (pane_name, prefix);
291
292 #ifndef HAVE_BOXES
293 /* Remember index for first item in this pane so we can go back and
294 add a prefix when (if) we see the first button. After that, notbuttons
295 is set to 0, to mark that we have seen a button and all non button
296 items need a prefix. */
297 skp.notbuttons = menu_items_used;
298 #endif
299
300 GCPRO1 (skp.pending_maps);
301 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
302 UNGCPRO;
303
304 /* Process now any submenus which want to be panes at this level. */
305 while (CONSP (skp.pending_maps))
306 {
307 Lisp_Object elt, eltcdr, string;
308 elt = XCAR (skp.pending_maps);
309 eltcdr = XCDR (elt);
310 string = XCAR (eltcdr);
311 /* We no longer discard the @ from the beginning of the string here.
312 Instead, we do this in *menu_show. */
313 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
314 skp.pending_maps = XCDR (skp.pending_maps);
315 }
316 }
317
318 /* This is a subroutine of single_keymap_panes that handles one
319 keymap entry.
320 KEY is a key in a keymap and ITEM is its binding.
321 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
322 separate panes.
323 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
324
325 static void
326 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
327 {
328 Lisp_Object map, item_string, enabled;
329 struct gcpro gcpro1, gcpro2;
330 int res;
331 struct skp *skp = skp_v;
332
333 /* Parse the menu item and leave the result in item_properties. */
334 GCPRO2 (key, item);
335 res = parse_menu_item (item, 0);
336 UNGCPRO;
337 if (!res)
338 return; /* Not a menu item. */
339
340 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
341
342 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
343 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
344
345 if (!NILP (map) && SREF (item_string, 0) == '@')
346 {
347 if (!NILP (enabled))
348 /* An enabled separate pane. Remember this to handle it later. */
349 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
350 skp->pending_maps);
351 return;
352 }
353
354 #if defined(HAVE_X_WINDOWS) || defined(MSDOS)
355 #ifndef HAVE_BOXES
356 /* Simulate radio buttons and toggle boxes by putting a prefix in
357 front of them. */
358 {
359 Lisp_Object prefix = Qnil;
360 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
361 if (!NILP (type))
362 {
363 Lisp_Object selected
364 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
365
366 if (skp->notbuttons)
367 /* The first button. Line up previous items in this menu. */
368 {
369 int index = skp->notbuttons; /* Index for first item this menu. */
370 int submenu = 0;
371 Lisp_Object tem;
372 while (index < menu_items_used)
373 {
374 tem
375 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
376 if (NILP (tem))
377 {
378 index++;
379 submenu++; /* Skip sub menu. */
380 }
381 else if (EQ (tem, Qlambda))
382 {
383 index++;
384 submenu--; /* End sub menu. */
385 }
386 else if (EQ (tem, Qt))
387 index += 3; /* Skip new pane marker. */
388 else if (EQ (tem, Qquote))
389 index++; /* Skip a left, right divider. */
390 else
391 {
392 if (!submenu && SREF (tem, 0) != '\0'
393 && SREF (tem, 0) != '-')
394 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
395 = concat2 (build_string (" "), tem);
396 index += MENU_ITEMS_ITEM_LENGTH;
397 }
398 }
399 skp->notbuttons = 0;
400 }
401
402 /* Calculate prefix, if any, for this item. */
403 if (EQ (type, QCtoggle))
404 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
405 else if (EQ (type, QCradio))
406 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
407 }
408 /* Not a button. If we have earlier buttons, then we need a prefix. */
409 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
410 && SREF (item_string, 0) != '-')
411 prefix = build_string (" ");
412
413 if (!NILP (prefix))
414 item_string = concat2 (prefix, item_string);
415 }
416 #endif /* not HAVE_BOXES */
417
418 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
419 if (!NILP (map))
420 /* Indicate visually that this is a submenu. */
421 item_string = concat2 (item_string, build_string (" >"));
422 #endif
423
424 #endif /* HAVE_X_WINDOWS || MSDOS */
425
426 push_menu_item (item_string, enabled, key,
427 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
428 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
429 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
430 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
431 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
432
433 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
434 /* Display a submenu using the toolkit. */
435 if (! (NILP (map) || NILP (enabled)))
436 {
437 push_submenu_start ();
438 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
439 push_submenu_end ();
440 }
441 #endif
442 }
443
444 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
445 and generate menu panes for them in menu_items. */
446
447 static void
448 keymap_panes (Lisp_Object *keymaps, int nmaps)
449 {
450 int mapno;
451
452 init_menu_items ();
453
454 /* Loop over the given keymaps, making a pane for each map.
455 But don't make a pane that is empty--ignore that map instead.
456 P is the number of panes we have made so far. */
457 for (mapno = 0; mapno < nmaps; mapno++)
458 single_keymap_panes (keymaps[mapno],
459 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
460
461 finish_menu_items ();
462 }
463
464
465 /* Push the items in a single pane defined by the alist PANE. */
466 static void
467 list_of_items (Lisp_Object pane)
468 {
469 Lisp_Object tail, item, item1;
470
471 for (tail = pane; CONSP (tail); tail = XCDR (tail))
472 {
473 item = XCAR (tail);
474 if (STRINGP (item))
475 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
476 Qnil, Qnil, Qnil, Qnil);
477 else if (CONSP (item))
478 {
479 item1 = XCAR (item);
480 CHECK_STRING (item1);
481 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
482 Qt, Qnil, Qnil, Qnil, Qnil);
483 }
484 else
485 push_left_right_boundary ();
486
487 }
488 }
489
490 /* Push all the panes and items of a menu described by the
491 alist-of-alists MENU.
492 This handles old-fashioned calls to x-popup-menu. */
493 void
494 list_of_panes (Lisp_Object menu)
495 {
496 Lisp_Object tail;
497
498 init_menu_items ();
499
500 for (tail = menu; CONSP (tail); tail = XCDR (tail))
501 {
502 Lisp_Object elt, pane_name, pane_data;
503 elt = XCAR (tail);
504 pane_name = Fcar (elt);
505 CHECK_STRING (pane_name);
506 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
507 pane_data = Fcdr (elt);
508 CHECK_CONS (pane_data);
509 list_of_items (pane_data);
510 }
511
512 finish_menu_items ();
513 }
514
515 /* Set up data in menu_items for a menu bar item
516 whose event type is ITEM_KEY (with string ITEM_NAME)
517 and whose contents come from the list of keymaps MAPS. */
518 int
519 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
520 {
521 Lisp_Object length;
522 int len;
523 Lisp_Object *mapvec;
524 int i;
525 int top_level_items = 0;
526
527 length = Flength (maps);
528 len = XINT (length);
529
530 /* Convert the list MAPS into a vector MAPVEC. */
531 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
532 for (i = 0; i < len; i++)
533 {
534 mapvec[i] = Fcar (maps);
535 maps = Fcdr (maps);
536 }
537
538 /* Loop over the given keymaps, making a pane for each map.
539 But don't make a pane that is empty--ignore that map instead. */
540 for (i = 0; i < len; i++)
541 {
542 if (!KEYMAPP (mapvec[i]))
543 {
544 /* Here we have a command at top level in the menu bar
545 as opposed to a submenu. */
546 top_level_items = 1;
547 push_menu_pane (Qnil, Qnil);
548 push_menu_item (item_name, Qt, item_key, mapvec[i],
549 Qnil, Qnil, Qnil, Qnil);
550 }
551 else
552 {
553 Lisp_Object prompt;
554 prompt = Fkeymap_prompt (mapvec[i]);
555 single_keymap_panes (mapvec[i],
556 !NILP (prompt) ? prompt : item_name,
557 item_key, 10);
558 }
559 }
560
561 return top_level_items;
562 }
563
564 \f
565 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
566
567 /* Allocate a widget_value, blocking input. */
568
569 widget_value *
570 xmalloc_widget_value (void)
571 {
572 widget_value *value;
573
574 BLOCK_INPUT;
575 value = malloc_widget_value ();
576 UNBLOCK_INPUT;
577
578 return value;
579 }
580
581 /* This recursively calls free_widget_value on the tree of widgets.
582 It must free all data that was malloc'ed for these widget_values.
583 In Emacs, many slots are pointers into the data of Lisp_Strings, and
584 must be left alone. */
585
586 void
587 free_menubar_widget_value_tree (widget_value *wv)
588 {
589 if (! wv) return;
590
591 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
592
593 if (wv->contents && (wv->contents != (widget_value*)1))
594 {
595 free_menubar_widget_value_tree (wv->contents);
596 wv->contents = (widget_value *) 0xDEADBEEF;
597 }
598 if (wv->next)
599 {
600 free_menubar_widget_value_tree (wv->next);
601 wv->next = (widget_value *) 0xDEADBEEF;
602 }
603 BLOCK_INPUT;
604 free_widget_value (wv);
605 UNBLOCK_INPUT;
606 }
607
608 /* Create a tree of widget_value objects
609 representing the panes and items
610 in menu_items starting at index START, up to index END. */
611
612 widget_value *
613 digest_single_submenu (int start, int end, int top_level_items)
614 {
615 widget_value *wv, *prev_wv, *save_wv, *first_wv;
616 int i;
617 int submenu_depth = 0;
618 widget_value **submenu_stack;
619 int panes_seen = 0;
620
621 submenu_stack
622 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
623 wv = xmalloc_widget_value ();
624 wv->name = "menu";
625 wv->value = 0;
626 wv->enabled = 1;
627 wv->button_type = BUTTON_TYPE_NONE;
628 wv->help = Qnil;
629 first_wv = wv;
630 save_wv = 0;
631 prev_wv = 0;
632
633 /* Loop over all panes and items made by the preceding call
634 to parse_single_submenu and construct a tree of widget_value objects.
635 Ignore the panes and items used by previous calls to
636 digest_single_submenu, even though those are also in menu_items. */
637 i = start;
638 while (i < end)
639 {
640 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
641 {
642 submenu_stack[submenu_depth++] = save_wv;
643 save_wv = prev_wv;
644 prev_wv = 0;
645 i++;
646 }
647 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
648 {
649 prev_wv = save_wv;
650 save_wv = submenu_stack[--submenu_depth];
651 i++;
652 }
653 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
654 && submenu_depth != 0)
655 i += MENU_ITEMS_PANE_LENGTH;
656 /* Ignore a nil in the item list.
657 It's meaningful only for dialog boxes. */
658 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
659 i += 1;
660 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
661 {
662 /* Create a new pane. */
663 Lisp_Object pane_name, prefix;
664 const char *pane_string;
665
666 panes_seen++;
667
668 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
669 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
670
671 #ifdef HAVE_NTGUI
672 if (STRINGP (pane_name))
673 {
674 if (unicode_append_menu)
675 /* Encode as UTF-8 for now. */
676 pane_name = ENCODE_UTF_8 (pane_name);
677 else if (STRING_MULTIBYTE (pane_name))
678 pane_name = ENCODE_SYSTEM (pane_name);
679
680 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
681 }
682 #elif defined (USE_LUCID) && defined (HAVE_XFT)
683 if (STRINGP (pane_name))
684 {
685 pane_name = ENCODE_UTF_8 (pane_name);
686 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
687 }
688 #elif !defined (HAVE_MULTILINGUAL_MENU)
689 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
690 {
691 pane_name = ENCODE_MENU_STRING (pane_name);
692 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
693 }
694 #endif
695
696 pane_string = (NILP (pane_name)
697 ? "" : SSDATA (pane_name));
698 /* If there is just one top-level pane, put all its items directly
699 under the top-level menu. */
700 if (menu_items_n_panes == 1)
701 pane_string = "";
702
703 /* If the pane has a meaningful name,
704 make the pane a top-level menu item
705 with its items as a submenu beneath it. */
706 if (strcmp (pane_string, ""))
707 {
708 wv = xmalloc_widget_value ();
709 if (save_wv)
710 save_wv->next = wv;
711 else
712 first_wv->contents = wv;
713 wv->lname = pane_name;
714 /* Set value to 1 so update_submenu_strings can handle '@' */
715 wv->value = (char *)1;
716 wv->enabled = 1;
717 wv->button_type = BUTTON_TYPE_NONE;
718 wv->help = Qnil;
719 save_wv = wv;
720 }
721 else
722 save_wv = first_wv;
723
724 prev_wv = 0;
725 i += MENU_ITEMS_PANE_LENGTH;
726 }
727 else
728 {
729 /* Create a new item within current pane. */
730 Lisp_Object item_name, enable, descrip, def, type, selected;
731 Lisp_Object help;
732
733 /* All items should be contained in panes. */
734 if (panes_seen == 0)
735 abort ();
736
737 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
738 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
739 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
740 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
741 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
742 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
743 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
744
745 #ifdef HAVE_NTGUI
746 if (STRINGP (item_name))
747 {
748 if (unicode_append_menu)
749 item_name = ENCODE_UTF_8 (item_name);
750 else if (STRING_MULTIBYTE (item_name))
751 item_name = ENCODE_SYSTEM (item_name);
752
753 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
754 }
755
756 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
757 {
758 descrip = ENCODE_SYSTEM (descrip);
759 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
760 }
761 #elif USE_LUCID
762 if (STRINGP (item_name))
763 {
764 item_name = ENCODE_UTF_8 (item_name);
765 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
766 }
767
768 if (STRINGP (descrip))
769 {
770 descrip = ENCODE_UTF_8 (descrip);
771 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
772 }
773 #elif !defined (HAVE_MULTILINGUAL_MENU)
774 if (STRING_MULTIBYTE (item_name))
775 {
776 item_name = ENCODE_MENU_STRING (item_name);
777 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
778 }
779
780 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
781 {
782 descrip = ENCODE_MENU_STRING (descrip);
783 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
784 }
785 #endif
786
787 wv = xmalloc_widget_value ();
788 if (prev_wv)
789 prev_wv->next = wv;
790 else
791 save_wv->contents = wv;
792
793 wv->lname = item_name;
794 if (!NILP (descrip))
795 wv->lkey = descrip;
796 wv->value = 0;
797 /* The EMACS_INT cast avoids a warning. There's no problem
798 as long as pointers have enough bits to hold small integers. */
799 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
800 wv->enabled = !NILP (enable);
801
802 if (NILP (type))
803 wv->button_type = BUTTON_TYPE_NONE;
804 else if (EQ (type, QCradio))
805 wv->button_type = BUTTON_TYPE_RADIO;
806 else if (EQ (type, QCtoggle))
807 wv->button_type = BUTTON_TYPE_TOGGLE;
808 else
809 abort ();
810
811 wv->selected = !NILP (selected);
812 if (! STRINGP (help))
813 help = Qnil;
814
815 wv->help = help;
816
817 prev_wv = wv;
818
819 i += MENU_ITEMS_ITEM_LENGTH;
820 }
821 }
822
823 /* If we have just one "menu item"
824 that was originally a button, return it by itself. */
825 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
826 {
827 wv = first_wv->contents;
828 free_widget_value (first_wv);
829 return wv;
830 }
831
832 return first_wv;
833 }
834
835 /* Walk through the widget_value tree starting at FIRST_WV and update
836 the char * pointers from the corresponding lisp values.
837 We do this after building the whole tree, since GC may happen while the
838 tree is constructed, and small strings are relocated. So we must wait
839 until no GC can happen before storing pointers into lisp values. */
840 void
841 update_submenu_strings (widget_value *first_wv)
842 {
843 widget_value *wv;
844
845 for (wv = first_wv; wv; wv = wv->next)
846 {
847 if (STRINGP (wv->lname))
848 {
849 wv->name = SSDATA (wv->lname);
850
851 /* Ignore the @ that means "separate pane".
852 This is a kludge, but this isn't worth more time. */
853 if (wv->value == (char *)1)
854 {
855 if (wv->name[0] == '@')
856 wv->name++;
857 wv->value = 0;
858 }
859 }
860
861 if (STRINGP (wv->lkey))
862 wv->key = SSDATA (wv->lkey);
863
864 if (wv->contents)
865 update_submenu_strings (wv->contents);
866 }
867 }
868
869 /* Find the menu selection and store it in the keyboard buffer.
870 F is the frame the menu is on.
871 MENU_BAR_ITEMS_USED is the length of VECTOR.
872 VECTOR is an array of menu events for the whole menu. */
873
874 void
875 find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data)
876 {
877 Lisp_Object prefix, entry;
878 Lisp_Object *subprefix_stack;
879 int submenu_depth = 0;
880 int i;
881
882 entry = Qnil;
883 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
884 prefix = Qnil;
885 i = 0;
886
887 while (i < menu_bar_items_used)
888 {
889 if (EQ (XVECTOR (vector)->contents[i], Qnil))
890 {
891 subprefix_stack[submenu_depth++] = prefix;
892 prefix = entry;
893 i++;
894 }
895 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
896 {
897 prefix = subprefix_stack[--submenu_depth];
898 i++;
899 }
900 else if (EQ (XVECTOR (vector)->contents[i], Qt))
901 {
902 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
903 i += MENU_ITEMS_PANE_LENGTH;
904 }
905 else
906 {
907 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
908 /* The EMACS_INT cast avoids a warning. There's no problem
909 as long as pointers have enough bits to hold small integers. */
910 if ((int) (EMACS_INT) client_data == i)
911 {
912 int j;
913 struct input_event buf;
914 Lisp_Object frame;
915 EVENT_INIT (buf);
916
917 XSETFRAME (frame, f);
918 buf.kind = MENU_BAR_EVENT;
919 buf.frame_or_window = frame;
920 buf.arg = frame;
921 kbd_buffer_store_event (&buf);
922
923 for (j = 0; j < submenu_depth; j++)
924 if (!NILP (subprefix_stack[j]))
925 {
926 buf.kind = MENU_BAR_EVENT;
927 buf.frame_or_window = frame;
928 buf.arg = subprefix_stack[j];
929 kbd_buffer_store_event (&buf);
930 }
931
932 if (!NILP (prefix))
933 {
934 buf.kind = MENU_BAR_EVENT;
935 buf.frame_or_window = frame;
936 buf.arg = prefix;
937 kbd_buffer_store_event (&buf);
938 }
939
940 buf.kind = MENU_BAR_EVENT;
941 buf.frame_or_window = frame;
942 buf.arg = entry;
943 kbd_buffer_store_event (&buf);
944
945 return;
946 }
947 i += MENU_ITEMS_ITEM_LENGTH;
948 }
949 }
950 }
951
952 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
953
954 #ifdef HAVE_NS
955 /* As above, but return the menu selection instead of storing in kb buffer.
956 If keymaps==1, return full prefixes to selection. */
957 Lisp_Object
958 find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
959 {
960 Lisp_Object prefix, entry;
961 int i;
962 Lisp_Object *subprefix_stack;
963 int submenu_depth = 0;
964
965 prefix = entry = Qnil;
966 i = 0;
967 subprefix_stack =
968 (Lisp_Object *)alloca(menu_items_used * sizeof (Lisp_Object));
969
970 while (i < menu_items_used)
971 {
972 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
973 {
974 subprefix_stack[submenu_depth++] = prefix;
975 prefix = entry;
976 i++;
977 }
978 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
979 {
980 prefix = subprefix_stack[--submenu_depth];
981 i++;
982 }
983 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
984 {
985 prefix
986 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
987 i += MENU_ITEMS_PANE_LENGTH;
988 }
989 /* Ignore a nil in the item list.
990 It's meaningful only for dialog boxes. */
991 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
992 i += 1;
993 else
994 {
995 entry
996 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
997 if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
998 {
999 if (keymaps != 0)
1000 {
1001 int j;
1002
1003 entry = Fcons (entry, Qnil);
1004 if (!NILP (prefix))
1005 entry = Fcons (prefix, entry);
1006 for (j = submenu_depth - 1; j >= 0; j--)
1007 if (!NILP (subprefix_stack[j]))
1008 entry = Fcons (subprefix_stack[j], entry);
1009 }
1010 return entry;
1011 }
1012 i += MENU_ITEMS_ITEM_LENGTH;
1013 }
1014 }
1015 return Qnil;
1016 }
1017 #endif /* HAVE_NS */
1018
1019 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1020 doc: /* Pop up a deck-of-cards menu and return user's selection.
1021 POSITION is a position specification. This is either a mouse button event
1022 or a list ((XOFFSET YOFFSET) WINDOW)
1023 where XOFFSET and YOFFSET are positions in pixels from the top left
1024 corner of WINDOW. (WINDOW may be a window or a frame object.)
1025 This controls the position of the top left of the menu as a whole.
1026 If POSITION is t, it means to use the current mouse position.
1027
1028 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1029 The menu items come from key bindings that have a menu string as well as
1030 a definition; actually, the "definition" in such a key binding looks like
1031 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1032 the keymap as a top-level element.
1033
1034 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1035 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1036
1037 You can also use a list of keymaps as MENU.
1038 Then each keymap makes a separate pane.
1039
1040 When MENU is a keymap or a list of keymaps, the return value is the
1041 list of events corresponding to the user's choice. Note that
1042 `x-popup-menu' does not actually execute the command bound to that
1043 sequence of events.
1044
1045 Alternatively, you can specify a menu of multiple panes
1046 with a list of the form (TITLE PANE1 PANE2...),
1047 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1048 Each ITEM is normally a cons cell (STRING . VALUE);
1049 but a string can appear as an item--that makes a nonselectable line
1050 in the menu.
1051 With this form of menu, the return value is VALUE from the chosen item.
1052
1053 If POSITION is nil, don't display the menu at all, just precalculate the
1054 cached information about equivalent key sequences.
1055
1056 If the user gets rid of the menu without making a valid choice, for
1057 instance by clicking the mouse away from a valid choice or by typing
1058 keyboard input, then this normally results in a quit and
1059 `x-popup-menu' does not return. But if POSITION is a mouse button
1060 event (indicating that the user invoked the menu with the mouse) then
1061 no quit occurs and `x-popup-menu' returns nil. */)
1062 (Lisp_Object position, Lisp_Object menu)
1063 {
1064 Lisp_Object keymap, tem;
1065 int xpos = 0, ypos = 0;
1066 Lisp_Object title;
1067 const char *error_name = NULL;
1068 Lisp_Object selection = Qnil;
1069 FRAME_PTR f = NULL;
1070 Lisp_Object x, y, window;
1071 int keymaps = 0;
1072 int for_click = 0;
1073 int specpdl_count = SPECPDL_INDEX ();
1074 struct gcpro gcpro1;
1075
1076 if (NILP (position))
1077 /* This is an obsolete call, which wants us to precompute the
1078 keybinding equivalents, but we don't do that any more anyway. */
1079 return Qnil;
1080
1081 #ifdef HAVE_MENUS
1082 {
1083 int get_current_pos_p = 0;
1084 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1085
1086 /* Decode the first argument: find the window and the coordinates. */
1087 if (EQ (position, Qt)
1088 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1089 || EQ (XCAR (position), Qtool_bar))))
1090 {
1091 get_current_pos_p = 1;
1092 }
1093 else
1094 {
1095 tem = Fcar (position);
1096 if (CONSP (tem))
1097 {
1098 window = Fcar (Fcdr (position));
1099 x = XCAR (tem);
1100 y = Fcar (XCDR (tem));
1101 }
1102 else
1103 {
1104 for_click = 1;
1105 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1106 window = Fcar (tem); /* POSN_WINDOW (tem) */
1107 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1108 x = Fcar (tem);
1109 y = Fcdr (tem);
1110 }
1111
1112 /* If a click happens in an external tool bar or a detached
1113 tool bar, x and y is NIL. In that case, use the current
1114 mouse position. This happens for the help button in the
1115 tool bar. Ideally popup-menu should pass NIL to
1116 this function, but it doesn't. */
1117 if (NILP (x) && NILP (y))
1118 get_current_pos_p = 1;
1119 }
1120
1121 if (get_current_pos_p)
1122 {
1123 /* Use the mouse's current position. */
1124 FRAME_PTR new_f = SELECTED_FRAME ();
1125 #ifdef HAVE_X_WINDOWS
1126 /* Can't use mouse_position_hook for X since it returns
1127 coordinates relative to the window the mouse is in,
1128 we need coordinates relative to the edit widget always. */
1129 if (new_f != 0)
1130 {
1131 int cur_x, cur_y;
1132
1133 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1134 /* cur_x/y may be negative, so use make_number. */
1135 x = make_number (cur_x);
1136 y = make_number (cur_y);
1137 }
1138
1139 #else /* not HAVE_X_WINDOWS */
1140 Lisp_Object bar_window;
1141 enum scroll_bar_part part;
1142 unsigned long time;
1143 void (*mouse_position_hook) (struct frame **, int,
1144 Lisp_Object *,
1145 enum scroll_bar_part *,
1146 Lisp_Object *,
1147 Lisp_Object *,
1148 unsigned long *) =
1149 FRAME_TERMINAL (new_f)->mouse_position_hook;
1150
1151 if (mouse_position_hook)
1152 (*mouse_position_hook) (&new_f, 1, &bar_window,
1153 &part, &x, &y, &time);
1154 #endif /* not HAVE_X_WINDOWS */
1155
1156 if (new_f != 0)
1157 XSETFRAME (window, new_f);
1158 else
1159 {
1160 window = selected_window;
1161 XSETFASTINT (x, 0);
1162 XSETFASTINT (y, 0);
1163 }
1164 }
1165
1166 CHECK_NUMBER (x);
1167 CHECK_NUMBER (y);
1168
1169 /* Decode where to put the menu. */
1170
1171 if (FRAMEP (window))
1172 {
1173 f = XFRAME (window);
1174 xpos = 0;
1175 ypos = 0;
1176 }
1177 else if (WINDOWP (window))
1178 {
1179 struct window *win = XWINDOW (window);
1180 CHECK_LIVE_WINDOW (window);
1181 f = XFRAME (WINDOW_FRAME (win));
1182
1183 xpos = WINDOW_LEFT_EDGE_X (win);
1184 ypos = WINDOW_TOP_EDGE_Y (win);
1185 }
1186 else
1187 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1188 but I don't want to make one now. */
1189 CHECK_WINDOW (window);
1190
1191 xpos += XINT (x);
1192 ypos += XINT (y);
1193
1194 /* FIXME: Find a more general check! */
1195 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1196 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1197 error ("Can not put GUI menu on this terminal");
1198
1199 XSETFRAME (Vmenu_updating_frame, f);
1200 }
1201 #endif /* HAVE_MENUS */
1202
1203 /* Now parse the lisp menus. */
1204 record_unwind_protect (unuse_menu_items, Qnil);
1205
1206 title = Qnil;
1207 GCPRO1 (title);
1208
1209 /* Decode the menu items from what was specified. */
1210
1211 keymap = get_keymap (menu, 0, 0);
1212 if (CONSP (keymap))
1213 {
1214 /* We were given a keymap. Extract menu info from the keymap. */
1215 Lisp_Object prompt;
1216
1217 /* Extract the detailed info to make one pane. */
1218 keymap_panes (&menu, 1);
1219
1220 /* Search for a string appearing directly as an element of the keymap.
1221 That string is the title of the menu. */
1222 prompt = Fkeymap_prompt (keymap);
1223 if (!NILP (prompt))
1224 title = prompt;
1225 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1226 else
1227 title = build_string ("Select");
1228 #endif
1229
1230 /* Make that be the pane title of the first pane. */
1231 if (!NILP (prompt) && menu_items_n_panes >= 0)
1232 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1233
1234 keymaps = 1;
1235 }
1236 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1237 {
1238 /* We were given a list of keymaps. */
1239 int nmaps = XFASTINT (Flength (menu));
1240 Lisp_Object *maps
1241 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1242 int i;
1243
1244 title = Qnil;
1245
1246 /* The first keymap that has a prompt string
1247 supplies the menu title. */
1248 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1249 {
1250 Lisp_Object prompt;
1251
1252 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1253
1254 prompt = Fkeymap_prompt (keymap);
1255 if (NILP (title) && !NILP (prompt))
1256 title = prompt;
1257 }
1258
1259 /* Extract the detailed info to make one pane. */
1260 keymap_panes (maps, nmaps);
1261
1262 /* Make the title be the pane title of the first pane. */
1263 if (!NILP (title) && menu_items_n_panes >= 0)
1264 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1265
1266 keymaps = 1;
1267 }
1268 else
1269 {
1270 /* We were given an old-fashioned menu. */
1271 title = Fcar (menu);
1272 CHECK_STRING (title);
1273
1274 list_of_panes (Fcdr (menu));
1275
1276 keymaps = 0;
1277 }
1278
1279 unbind_to (specpdl_count, Qnil);
1280
1281 #ifdef HAVE_MENUS
1282 #ifdef HAVE_WINDOW_SYSTEM
1283 /* Hide a previous tip, if any. */
1284 Fx_hide_tip ();
1285 #endif
1286
1287 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1288 /* If resources from a previous popup menu still exist, does nothing
1289 until the `menu_free_timer' has freed them (see w32fns.c). This
1290 can occur if you press ESC or click outside a menu without selecting
1291 a menu item.
1292 */
1293 if (current_popup_menu)
1294 {
1295 discard_menu_items ();
1296 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1297 UNGCPRO;
1298 return Qnil;
1299 }
1300 #endif
1301
1302 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1303 record_unwind_protect (cleanup_popup_menu, Qnil);
1304 #endif
1305
1306 /* Display them in a menu. */
1307 BLOCK_INPUT;
1308
1309 /* FIXME: Use a terminal hook! */
1310 #if defined HAVE_NTGUI
1311 selection = w32_menu_show (f, xpos, ypos, for_click,
1312 keymaps, title, &error_name);
1313 #elif defined HAVE_NS
1314 selection = ns_menu_show (f, xpos, ypos, for_click,
1315 keymaps, title, &error_name);
1316 #else /* MSDOS and X11 */
1317 /* Assume last_event_timestamp is the timestamp of the button event.
1318 Is this assumption ever violated? We can't use the timestamp
1319 stored within POSITION because there the top bits from the actual
1320 timestamp may be truncated away (Bug#4930). */
1321 selection = xmenu_show (f, xpos, ypos, for_click,
1322 keymaps, title, &error_name,
1323 last_event_timestamp);
1324 #endif
1325
1326 UNBLOCK_INPUT;
1327
1328 #ifdef HAVE_NS
1329 unbind_to (specpdl_count, Qnil);
1330 #else
1331 discard_menu_items ();
1332 #endif
1333
1334 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1335 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1336 #endif
1337
1338 #endif /* HAVE_MENUS */
1339
1340 UNGCPRO;
1341
1342 if (error_name) error (error_name);
1343 return selection;
1344 }
1345
1346 void
1347 syms_of_menu (void)
1348 {
1349 staticpro (&menu_items);
1350 menu_items = Qnil;
1351 menu_items_inuse = Qnil;
1352
1353 defsubr (&Sx_popup_menu);
1354 }