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