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