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