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