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