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