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