]> code.delx.au - gnu-emacs/blob - src/menu.c
020186eabafdcfda69d84f3d84bd58ef69783670
[gnu-emacs] / src / menu.c
1 /* Platform-independent code for terminal communications.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20 #include <config.h>
21 #include <stdio.h>
22 #include <setjmp.h>
23
24 #include "lisp.h"
25 #include "keyboard.h"
26 #include "keymap.h"
27 #include "frame.h"
28 #include "window.h"
29 #include "termhooks.h"
30 #include "blockinput.h"
31 #include "dispextern.h"
32
33 #ifdef USE_X_TOOLKIT
34 #include "../lwlib/lwlib.h"
35 #endif
36
37 #ifdef HAVE_X_WINDOWS
38 #include "xterm.h"
39 #endif
40
41 #ifdef HAVE_NS
42 #include "nsterm.h"
43 #endif
44
45 #ifdef USE_GTK
46 #include "gtkutil.h"
47 #endif
48
49 #ifdef HAVE_NTGUI
50 #include "w32term.h"
51
52 extern AppendMenuW_Proc unicode_append_menu;
53 extern HMENU current_popup_menu;
54
55 #endif /* HAVE_NTGUI */
56
57 #include "menu.h"
58
59 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
60 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
61 #define HAVE_BOXES 1
62 #endif
63
64 /* The timestamp of the last input event Emacs received from the X server. */
65 /* Defined in keyboard.c. */
66 extern unsigned long last_event_timestamp;
67
68 extern Lisp_Object QCtoggle, QCradio;
69
70 Lisp_Object menu_items;
71
72 /* If non-nil, means that the global vars defined here are already in use.
73 Used to detect cases where we try to re-enter this non-reentrant code. */
74 Lisp_Object menu_items_inuse;
75
76 /* Number of slots currently allocated in menu_items. */
77 int menu_items_allocated;
78
79 /* This is the index in menu_items of the first empty slot. */
80 int menu_items_used;
81
82 /* The number of panes currently recorded in menu_items,
83 excluding those within submenus. */
84 int menu_items_n_panes;
85
86 /* Current depth within submenus. */
87 static int menu_items_submenu_depth;
88
89 void
90 init_menu_items ()
91 {
92 if (!NILP (menu_items_inuse))
93 error ("Trying to use a menu from within a menu-entry");
94
95 if (NILP (menu_items))
96 {
97 menu_items_allocated = 60;
98 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
99 }
100
101 menu_items_inuse = Qt;
102 menu_items_used = 0;
103 menu_items_n_panes = 0;
104 menu_items_submenu_depth = 0;
105 }
106
107 /* Call at the end of generating the data in menu_items. */
108
109 void
110 finish_menu_items ()
111 {
112 }
113
114 Lisp_Object
115 unuse_menu_items (dummy)
116 Lisp_Object dummy;
117 {
118 return menu_items_inuse = Qnil;
119 }
120
121 /* Call when finished using the data for the current menu
122 in menu_items. */
123
124 void
125 discard_menu_items ()
126 {
127 /* Free the structure if it is especially large.
128 Otherwise, hold on to it, to save time. */
129 if (menu_items_allocated > 200)
130 {
131 menu_items = Qnil;
132 menu_items_allocated = 0;
133 }
134 xassert (NILP (menu_items_inuse));
135 }
136
137 static Lisp_Object
138 cleanup_popup_menu (Lisp_Object arg)
139 {
140 discard_menu_items ();
141 return Qnil;
142 }
143
144 /* This undoes save_menu_items, and it is called by the specpdl unwind
145 mechanism. */
146
147 static Lisp_Object
148 restore_menu_items (saved)
149 Lisp_Object saved;
150 {
151 menu_items = XCAR (saved);
152 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
153 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
154 saved = XCDR (saved);
155 menu_items_used = XINT (XCAR (saved));
156 saved = XCDR (saved);
157 menu_items_n_panes = XINT (XCAR (saved));
158 saved = XCDR (saved);
159 menu_items_submenu_depth = XINT (XCAR (saved));
160 return Qnil;
161 }
162
163 /* Push the whole state of menu_items processing onto the specpdl.
164 It will be restored when the specpdl is unwound. */
165
166 void
167 save_menu_items ()
168 {
169 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
170 make_number (menu_items_used),
171 make_number (menu_items_n_panes),
172 make_number (menu_items_submenu_depth));
173 record_unwind_protect (restore_menu_items, saved);
174 menu_items_inuse = Qnil;
175 menu_items = Qnil;
176 }
177
178 \f
179 /* Make the menu_items vector twice as large. */
180
181 static void
182 grow_menu_items ()
183 {
184 menu_items_allocated *= 2;
185 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
186 }
187
188 /* Begin a submenu. */
189
190 static void
191 push_submenu_start ()
192 {
193 if (menu_items_used + 1 > menu_items_allocated)
194 grow_menu_items ();
195
196 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
197 menu_items_submenu_depth++;
198 }
199
200 /* End a submenu. */
201
202 static void
203 push_submenu_end ()
204 {
205 if (menu_items_used + 1 > menu_items_allocated)
206 grow_menu_items ();
207
208 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
209 menu_items_submenu_depth--;
210 }
211
212 /* Indicate boundary between left and right. */
213
214 static void
215 push_left_right_boundary ()
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 (name, prefix_vec)
228 Lisp_Object name, prefix_vec;
229 {
230 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
231 grow_menu_items ();
232
233 if (menu_items_submenu_depth == 0)
234 menu_items_n_panes++;
235 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
236 XVECTOR (menu_items)->contents[menu_items_used++] = name;
237 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
238 }
239
240 /* Push one menu item into the current pane. NAME is the string to
241 display. ENABLE if non-nil means this item can be selected. KEY
242 is the key generated by choosing this item, or nil if this item
243 doesn't really have a definition. DEF is the definition of this
244 item. EQUIV is the textual description of the keyboard equivalent
245 for this item (or nil if none). TYPE is the type of this menu
246 item, one of nil, `toggle' or `radio'. */
247
248 static void
249 push_menu_item (name, enable, key, def, equiv, type, selected, help)
250 Lisp_Object name, enable, key, def, equiv, type, selected, help;
251 {
252 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
253 grow_menu_items ();
254
255 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
256 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
257 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
258 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
259 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
260 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
261 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
262 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
263
264 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
265 }
266
267 /* Args passed between single_keymap_panes and single_menu_item. */
268 struct skp
269 {
270 Lisp_Object pending_maps;
271 int maxdepth;
272 int notbuttons;
273 };
274
275 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
276 void *));
277
278 /* This is a recursive subroutine of keymap_panes.
279 It handles one keymap, KEYMAP.
280 The other arguments are passed along
281 or point to local variables of the previous function.
282
283 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
284
285 static void
286 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
287 Lisp_Object prefix, int maxdepth)
288 {
289 struct skp skp;
290 struct gcpro gcpro1;
291
292 skp.pending_maps = Qnil;
293 skp.maxdepth = maxdepth;
294 skp.notbuttons = 0;
295
296 if (maxdepth <= 0)
297 return;
298
299 push_menu_pane (pane_name, prefix);
300
301 #ifndef HAVE_BOXES
302 /* Remember index for first item in this pane so we can go back and
303 add a prefix when (if) we see the first button. After that, notbuttons
304 is set to 0, to mark that we have seen a button and all non button
305 items need a prefix. */
306 skp.notbuttons = menu_items_used;
307 #endif
308
309 GCPRO1 (skp.pending_maps);
310 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
311 UNGCPRO;
312
313 /* Process now any submenus which want to be panes at this level. */
314 while (CONSP (skp.pending_maps))
315 {
316 Lisp_Object elt, eltcdr, string;
317 elt = XCAR (skp.pending_maps);
318 eltcdr = XCDR (elt);
319 string = XCAR (eltcdr);
320 /* We no longer discard the @ from the beginning of the string here.
321 Instead, we do this in *menu_show. */
322 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
323 skp.pending_maps = XCDR (skp.pending_maps);
324 }
325 }
326
327 /* This is a subroutine of single_keymap_panes that handles one
328 keymap entry.
329 KEY is a key in a keymap and ITEM is its binding.
330 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
331 separate panes.
332 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
333
334 static void
335 single_menu_item (key, item, dummy, skp_v)
336 Lisp_Object key, item, dummy;
337 void *skp_v;
338 {
339 Lisp_Object map, item_string, enabled;
340 struct gcpro gcpro1, gcpro2;
341 int res;
342 struct skp *skp = skp_v;
343
344 /* Parse the menu item and leave the result in item_properties. */
345 GCPRO2 (key, item);
346 res = parse_menu_item (item, 0);
347 UNGCPRO;
348 if (!res)
349 return; /* Not a menu item. */
350
351 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
352
353 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
354 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
355
356 if (!NILP (map) && SREF (item_string, 0) == '@')
357 {
358 if (!NILP (enabled))
359 /* An enabled separate pane. Remember this to handle it later. */
360 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
361 skp->pending_maps);
362 return;
363 }
364
365 #if defined(HAVE_X_WINDOWS) || defined(MSDOS)
366 #ifndef HAVE_BOXES
367 /* Simulate radio buttons and toggle boxes by putting a prefix in
368 front of them. */
369 {
370 Lisp_Object prefix = Qnil;
371 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
372 if (!NILP (type))
373 {
374 Lisp_Object selected
375 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
376
377 if (skp->notbuttons)
378 /* The first button. Line up previous items in this menu. */
379 {
380 int index = skp->notbuttons; /* Index for first item this menu. */
381 int submenu = 0;
382 Lisp_Object tem;
383 while (index < menu_items_used)
384 {
385 tem
386 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
387 if (NILP (tem))
388 {
389 index++;
390 submenu++; /* Skip sub menu. */
391 }
392 else if (EQ (tem, Qlambda))
393 {
394 index++;
395 submenu--; /* End sub menu. */
396 }
397 else if (EQ (tem, Qt))
398 index += 3; /* Skip new pane marker. */
399 else if (EQ (tem, Qquote))
400 index++; /* Skip a left, right divider. */
401 else
402 {
403 if (!submenu && SREF (tem, 0) != '\0'
404 && SREF (tem, 0) != '-')
405 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
406 = concat2 (build_string (" "), tem);
407 index += MENU_ITEMS_ITEM_LENGTH;
408 }
409 }
410 skp->notbuttons = 0;
411 }
412
413 /* Calculate prefix, if any, for this item. */
414 if (EQ (type, QCtoggle))
415 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
416 else if (EQ (type, QCradio))
417 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
418 }
419 /* Not a button. If we have earlier buttons, then we need a prefix. */
420 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
421 && SREF (item_string, 0) != '-')
422 prefix = build_string (" ");
423
424 if (!NILP (prefix))
425 item_string = concat2 (prefix, item_string);
426 }
427 #endif /* not HAVE_BOXES */
428
429 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
430 if (!NILP (map))
431 /* Indicate visually that this is a submenu. */
432 item_string = concat2 (item_string, build_string (" >"));
433 #endif
434
435 #endif /* HAVE_X_WINDOWS || MSDOS */
436
437 push_menu_item (item_string, enabled, key,
438 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
439 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
440 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
441 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
442 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
443
444 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
445 /* Display a submenu using the toolkit. */
446 if (! (NILP (map) || NILP (enabled)))
447 {
448 push_submenu_start ();
449 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
450 push_submenu_end ();
451 }
452 #endif
453 }
454
455 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
456 and generate menu panes for them in menu_items. */
457
458 static void
459 keymap_panes (keymaps, nmaps)
460 Lisp_Object *keymaps;
461 int nmaps;
462 {
463 int mapno;
464
465 init_menu_items ();
466
467 /* Loop over the given keymaps, making a pane for each map.
468 But don't make a pane that is empty--ignore that map instead.
469 P is the number of panes we have made so far. */
470 for (mapno = 0; mapno < nmaps; mapno++)
471 single_keymap_panes (keymaps[mapno],
472 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
473
474 finish_menu_items ();
475 }
476
477
478 /* Push the items in a single pane defined by the alist PANE. */
479 static void
480 list_of_items (pane)
481 Lisp_Object pane;
482 {
483 Lisp_Object tail, item, item1;
484
485 for (tail = pane; CONSP (tail); tail = XCDR (tail))
486 {
487 item = XCAR (tail);
488 if (STRINGP (item))
489 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
490 Qnil, Qnil, Qnil, Qnil);
491 else if (CONSP (item))
492 {
493 item1 = XCAR (item);
494 CHECK_STRING (item1);
495 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
496 Qt, Qnil, Qnil, Qnil, Qnil);
497 }
498 else
499 push_left_right_boundary ();
500
501 }
502 }
503
504 /* Push all the panes and items of a menu described by the
505 alist-of-alists MENU.
506 This handles old-fashioned calls to x-popup-menu. */
507 void
508 list_of_panes (menu)
509 Lisp_Object menu;
510 {
511 Lisp_Object tail;
512
513 init_menu_items ();
514
515 for (tail = menu; CONSP (tail); tail = XCDR (tail))
516 {
517 Lisp_Object elt, pane_name, pane_data;
518 elt = XCAR (tail);
519 pane_name = Fcar (elt);
520 CHECK_STRING (pane_name);
521 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
522 pane_data = Fcdr (elt);
523 CHECK_CONS (pane_data);
524 list_of_items (pane_data);
525 }
526
527 finish_menu_items ();
528 }
529
530 /* Set up data in menu_items for a menu bar item
531 whose event type is ITEM_KEY (with string ITEM_NAME)
532 and whose contents come from the list of keymaps MAPS. */
533 int
534 parse_single_submenu (item_key, item_name, maps)
535 Lisp_Object item_key, item_name, maps;
536 {
537 Lisp_Object length;
538 int len;
539 Lisp_Object *mapvec;
540 int i;
541 int top_level_items = 0;
542
543 length = Flength (maps);
544 len = XINT (length);
545
546 /* Convert the list MAPS into a vector MAPVEC. */
547 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
548 for (i = 0; i < len; i++)
549 {
550 mapvec[i] = Fcar (maps);
551 maps = Fcdr (maps);
552 }
553
554 /* Loop over the given keymaps, making a pane for each map.
555 But don't make a pane that is empty--ignore that map instead. */
556 for (i = 0; i < len; i++)
557 {
558 if (!KEYMAPP (mapvec[i]))
559 {
560 /* Here we have a command at top level in the menu bar
561 as opposed to a submenu. */
562 top_level_items = 1;
563 push_menu_pane (Qnil, Qnil);
564 push_menu_item (item_name, Qt, item_key, mapvec[i],
565 Qnil, Qnil, Qnil, Qnil);
566 }
567 else
568 {
569 Lisp_Object prompt;
570 prompt = Fkeymap_prompt (mapvec[i]);
571 single_keymap_panes (mapvec[i],
572 !NILP (prompt) ? prompt : item_name,
573 item_key, 10);
574 }
575 }
576
577 return top_level_items;
578 }
579
580 \f
581 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
582
583 /* Allocate a widget_value, blocking input. */
584
585 widget_value *
586 xmalloc_widget_value ()
587 {
588 widget_value *value;
589
590 BLOCK_INPUT;
591 value = malloc_widget_value ();
592 UNBLOCK_INPUT;
593
594 return value;
595 }
596
597 /* This recursively calls free_widget_value on the tree of widgets.
598 It must free all data that was malloc'ed for these widget_values.
599 In Emacs, many slots are pointers into the data of Lisp_Strings, and
600 must be left alone. */
601
602 void
603 free_menubar_widget_value_tree (wv)
604 widget_value *wv;
605 {
606 if (! wv) return;
607
608 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
609
610 if (wv->contents && (wv->contents != (widget_value*)1))
611 {
612 free_menubar_widget_value_tree (wv->contents);
613 wv->contents = (widget_value *) 0xDEADBEEF;
614 }
615 if (wv->next)
616 {
617 free_menubar_widget_value_tree (wv->next);
618 wv->next = (widget_value *) 0xDEADBEEF;
619 }
620 BLOCK_INPUT;
621 free_widget_value (wv);
622 UNBLOCK_INPUT;
623 }
624
625 /* Create a tree of widget_value objects
626 representing the panes and items
627 in menu_items starting at index START, up to index END. */
628
629 widget_value *
630 digest_single_submenu (start, end, top_level_items)
631 int start, end, top_level_items;
632 {
633 widget_value *wv, *prev_wv, *save_wv, *first_wv;
634 int i;
635 int submenu_depth = 0;
636 widget_value **submenu_stack;
637 int panes_seen = 0;
638
639 submenu_stack
640 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
641 wv = xmalloc_widget_value ();
642 wv->name = "menu";
643 wv->value = 0;
644 wv->enabled = 1;
645 wv->button_type = BUTTON_TYPE_NONE;
646 wv->help = Qnil;
647 first_wv = wv;
648 save_wv = 0;
649 prev_wv = 0;
650
651 /* Loop over all panes and items made by the preceding call
652 to parse_single_submenu and construct a tree of widget_value objects.
653 Ignore the panes and items used by previous calls to
654 digest_single_submenu, even though those are also in menu_items. */
655 i = start;
656 while (i < end)
657 {
658 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
659 {
660 submenu_stack[submenu_depth++] = save_wv;
661 save_wv = prev_wv;
662 prev_wv = 0;
663 i++;
664 }
665 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
666 {
667 prev_wv = save_wv;
668 save_wv = submenu_stack[--submenu_depth];
669 i++;
670 }
671 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
672 && submenu_depth != 0)
673 i += MENU_ITEMS_PANE_LENGTH;
674 /* Ignore a nil in the item list.
675 It's meaningful only for dialog boxes. */
676 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
677 i += 1;
678 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
679 {
680 /* Create a new pane. */
681 Lisp_Object pane_name, prefix;
682 char *pane_string;
683
684 panes_seen++;
685
686 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
687 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
688
689 #ifdef HAVE_NTGUI
690 if (STRINGP (pane_name))
691 {
692 if (unicode_append_menu)
693 /* Encode as UTF-8 for now. */
694 pane_name = ENCODE_UTF_8 (pane_name);
695 else if (STRING_MULTIBYTE (pane_name))
696 pane_name = ENCODE_SYSTEM (pane_name);
697
698 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
699 }
700 #elif !defined (HAVE_MULTILINGUAL_MENU)
701 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
702 {
703 pane_name = ENCODE_MENU_STRING (pane_name);
704 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
705 }
706 #endif
707
708 pane_string = (NILP (pane_name)
709 ? "" : (char *) SDATA (pane_name));
710 /* If there is just one top-level pane, put all its items directly
711 under the top-level menu. */
712 if (menu_items_n_panes == 1)
713 pane_string = "";
714
715 /* If the pane has a meaningful name,
716 make the pane a top-level menu item
717 with its items as a submenu beneath it. */
718 if (strcmp (pane_string, ""))
719 {
720 wv = xmalloc_widget_value ();
721 if (save_wv)
722 save_wv->next = wv;
723 else
724 first_wv->contents = wv;
725 wv->lname = pane_name;
726 /* Set value to 1 so update_submenu_strings can handle '@' */
727 wv->value = (char *)1;
728 wv->enabled = 1;
729 wv->button_type = BUTTON_TYPE_NONE;
730 wv->help = Qnil;
731 save_wv = wv;
732 }
733 else
734 save_wv = first_wv;
735
736 prev_wv = 0;
737 i += MENU_ITEMS_PANE_LENGTH;
738 }
739 else
740 {
741 /* Create a new item within current pane. */
742 Lisp_Object item_name, enable, descrip, def, type, selected;
743 Lisp_Object help;
744
745 /* All items should be contained in panes. */
746 if (panes_seen == 0)
747 abort ();
748
749 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
750 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
751 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
752 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
753 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
754 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
755 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
756
757 #ifdef HAVE_NTGUI
758 if (STRINGP (item_name))
759 {
760 if (unicode_append_menu)
761 item_name = ENCODE_UTF_8 (item_name);
762 else if (STRING_MULTIBYTE (item_name))
763 item_name = ENCODE_SYSTEM (item_name);
764
765 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
766 }
767
768 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
769 {
770 descrip = ENCODE_SYSTEM (descrip);
771 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
772 }
773 #elif !defined (HAVE_MULTILINGUAL_MENU)
774 if (STRING_MULTIBYTE (item_name))
775 {
776 item_name = ENCODE_MENU_STRING (item_name);
777 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
778 }
779
780 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
781 {
782 descrip = ENCODE_MENU_STRING (descrip);
783 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
784 }
785 #endif
786
787 wv = xmalloc_widget_value ();
788 if (prev_wv)
789 prev_wv->next = wv;
790 else
791 save_wv->contents = wv;
792
793 wv->lname = item_name;
794 if (!NILP (descrip))
795 wv->lkey = descrip;
796 wv->value = 0;
797 /* The EMACS_INT cast avoids a warning. There's no problem
798 as long as pointers have enough bits to hold small integers. */
799 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
800 wv->enabled = !NILP (enable);
801
802 if (NILP (type))
803 wv->button_type = BUTTON_TYPE_NONE;
804 else if (EQ (type, QCradio))
805 wv->button_type = BUTTON_TYPE_RADIO;
806 else if (EQ (type, QCtoggle))
807 wv->button_type = BUTTON_TYPE_TOGGLE;
808 else
809 abort ();
810
811 wv->selected = !NILP (selected);
812 if (! STRINGP (help))
813 help = Qnil;
814
815 wv->help = help;
816
817 prev_wv = wv;
818
819 i += MENU_ITEMS_ITEM_LENGTH;
820 }
821 }
822
823 /* If we have just one "menu item"
824 that was originally a button, return it by itself. */
825 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
826 {
827 wv = first_wv->contents;
828 free_widget_value (first_wv);
829 return wv;
830 }
831
832 return first_wv;
833 }
834
835 /* Walk through the widget_value tree starting at FIRST_WV and update
836 the char * pointers from the corresponding lisp values.
837 We do this after building the whole tree, since GC may happen while the
838 tree is constructed, and small strings are relocated. So we must wait
839 until no GC can happen before storing pointers into lisp values. */
840 void
841 update_submenu_strings (first_wv)
842 widget_value *first_wv;
843 {
844 widget_value *wv;
845
846 for (wv = first_wv; wv; wv = wv->next)
847 {
848 if (STRINGP (wv->lname))
849 {
850 wv->name = (char *) SDATA (wv->lname);
851
852 /* Ignore the @ that means "separate pane".
853 This is a kludge, but this isn't worth more time. */
854 if (wv->value == (char *)1)
855 {
856 if (wv->name[0] == '@')
857 wv->name++;
858 wv->value = 0;
859 }
860 }
861
862 if (STRINGP (wv->lkey))
863 wv->key = (char *) SDATA (wv->lkey);
864
865 if (wv->contents)
866 update_submenu_strings (wv->contents);
867 }
868 }
869
870 /* Find the menu selection and store it in the keyboard buffer.
871 F is the frame the menu is on.
872 MENU_BAR_ITEMS_USED is the length of VECTOR.
873 VECTOR is an array of menu events for the whole menu. */
874
875 void
876 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
877 FRAME_PTR f;
878 int menu_bar_items_used;
879 Lisp_Object vector;
880 void *client_data;
881 {
882 Lisp_Object prefix, entry;
883 Lisp_Object *subprefix_stack;
884 int submenu_depth = 0;
885 int i;
886
887 entry = Qnil;
888 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
889 prefix = Qnil;
890 i = 0;
891
892 while (i < menu_bar_items_used)
893 {
894 if (EQ (XVECTOR (vector)->contents[i], Qnil))
895 {
896 subprefix_stack[submenu_depth++] = prefix;
897 prefix = entry;
898 i++;
899 }
900 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
901 {
902 prefix = subprefix_stack[--submenu_depth];
903 i++;
904 }
905 else if (EQ (XVECTOR (vector)->contents[i], Qt))
906 {
907 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
908 i += MENU_ITEMS_PANE_LENGTH;
909 }
910 else
911 {
912 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
913 /* The EMACS_INT cast avoids a warning. There's no problem
914 as long as pointers have enough bits to hold small integers. */
915 if ((int) (EMACS_INT) client_data == i)
916 {
917 int j;
918 struct input_event buf;
919 Lisp_Object frame;
920 EVENT_INIT (buf);
921
922 XSETFRAME (frame, f);
923 buf.kind = MENU_BAR_EVENT;
924 buf.frame_or_window = frame;
925 buf.arg = frame;
926 kbd_buffer_store_event (&buf);
927
928 for (j = 0; j < submenu_depth; j++)
929 if (!NILP (subprefix_stack[j]))
930 {
931 buf.kind = MENU_BAR_EVENT;
932 buf.frame_or_window = frame;
933 buf.arg = subprefix_stack[j];
934 kbd_buffer_store_event (&buf);
935 }
936
937 if (!NILP (prefix))
938 {
939 buf.kind = MENU_BAR_EVENT;
940 buf.frame_or_window = frame;
941 buf.arg = prefix;
942 kbd_buffer_store_event (&buf);
943 }
944
945 buf.kind = MENU_BAR_EVENT;
946 buf.frame_or_window = frame;
947 buf.arg = entry;
948 kbd_buffer_store_event (&buf);
949
950 return;
951 }
952 i += MENU_ITEMS_ITEM_LENGTH;
953 }
954 }
955 }
956
957 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
958
959 #ifdef HAVE_NS
960 /* As above, but return the menu selection instead of storing in kb buffer.
961 If keymaps==1, return full prefixes to selection. */
962 Lisp_Object
963 find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
964 {
965 Lisp_Object prefix, entry;
966 int i;
967 Lisp_Object *subprefix_stack;
968 int submenu_depth = 0;
969
970 prefix = entry = Qnil;
971 i = 0;
972 subprefix_stack =
973 (Lisp_Object *)alloca(menu_items_used * sizeof (Lisp_Object));
974
975 while (i < menu_items_used)
976 {
977 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
978 {
979 subprefix_stack[submenu_depth++] = prefix;
980 prefix = entry;
981 i++;
982 }
983 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
984 {
985 prefix = subprefix_stack[--submenu_depth];
986 i++;
987 }
988 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
989 {
990 prefix
991 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
992 i += MENU_ITEMS_PANE_LENGTH;
993 }
994 /* Ignore a nil in the item list.
995 It's meaningful only for dialog boxes. */
996 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
997 i += 1;
998 else
999 {
1000 entry
1001 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1002 if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
1003 {
1004 if (keymaps != 0)
1005 {
1006 int j;
1007
1008 entry = Fcons (entry, Qnil);
1009 if (!NILP (prefix))
1010 entry = Fcons (prefix, entry);
1011 for (j = submenu_depth - 1; j >= 0; j--)
1012 if (!NILP (subprefix_stack[j]))
1013 entry = Fcons (subprefix_stack[j], entry);
1014 }
1015 return entry;
1016 }
1017 i += MENU_ITEMS_ITEM_LENGTH;
1018 }
1019 }
1020 return Qnil;
1021 }
1022 #endif /* HAVE_NS */
1023
1024 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1025 doc: /* Pop up a deck-of-cards menu and return user's selection.
1026 POSITION is a position specification. This is either a mouse button event
1027 or a list ((XOFFSET YOFFSET) WINDOW)
1028 where XOFFSET and YOFFSET are positions in pixels from the top left
1029 corner of WINDOW. (WINDOW may be a window or a frame object.)
1030 This controls the position of the top left of the menu as a whole.
1031 If POSITION is t, it means to use the current mouse position.
1032
1033 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1034 The menu items come from key bindings that have a menu string as well as
1035 a definition; actually, the "definition" in such a key binding looks like
1036 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1037 the keymap as a top-level element.
1038
1039 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1040 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1041
1042 You can also use a list of keymaps as MENU.
1043 Then each keymap makes a separate pane.
1044
1045 When MENU is a keymap or a list of keymaps, the return value is the
1046 list of events corresponding to the user's choice. Note that
1047 `x-popup-menu' does not actually execute the command bound to that
1048 sequence of events.
1049
1050 Alternatively, you can specify a menu of multiple panes
1051 with a list of the form (TITLE PANE1 PANE2...),
1052 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1053 Each ITEM is normally a cons cell (STRING . VALUE);
1054 but a string can appear as an item--that makes a nonselectable line
1055 in the menu.
1056 With this form of menu, the return value is VALUE from the chosen item.
1057
1058 If POSITION is nil, don't display the menu at all, just precalculate the
1059 cached information about equivalent key sequences.
1060
1061 If the user gets rid of the menu without making a valid choice, for
1062 instance by clicking the mouse away from a valid choice or by typing
1063 keyboard input, then this normally results in a quit and
1064 `x-popup-menu' does not return. But if POSITION is a mouse button
1065 event (indicating that the user invoked the menu with the mouse) then
1066 no quit occurs and `x-popup-menu' returns nil. */)
1067 (position, menu)
1068 Lisp_Object position, menu;
1069 {
1070 Lisp_Object keymap, tem;
1071 int xpos = 0, ypos = 0;
1072 Lisp_Object title;
1073 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) P_ ((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 (error_name);
1349 return selection;
1350 }
1351
1352 void
1353 syms_of_menu ()
1354 {
1355 staticpro (&menu_items);
1356 menu_items = Qnil;
1357 menu_items_inuse = Qnil;
1358
1359 defsubr (&Sx_popup_menu);
1360 }
1361
1362 /* arch-tag: 78bbc7cf-8025-4156-aa8a-6c7fd99bf51d
1363 (do not change this comment) */