Support menus on text-mode terminals.
[bpt/emacs.git] / src / menu.c
1 /* Platform-independent code for terminal communications.
2
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2013 Free Software
4 Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21 #include <config.h>
22 #include <stdio.h>
23 #include <limits.h> /* for INT_MAX */
24
25 #include "lisp.h"
26 #include "keyboard.h"
27 #include "keymap.h"
28 #include "frame.h"
29 #include "window.h"
30 #include "termhooks.h"
31 #include "blockinput.h"
32 #include "dispextern.h"
33 #include "buffer.h"
34
35 #ifdef USE_X_TOOLKIT
36 #include "../lwlib/lwlib.h"
37 #endif
38
39 #ifdef HAVE_WINDOW_SYSTEM
40 #include TERM_HEADER
41 #endif /* HAVE_WINDOW_SYSTEM */
42
43 #ifdef HAVE_NTGUI
44 # ifdef NTGUI_UNICODE
45 # define unicode_append_menu AppendMenuW
46 # else /* !NTGUI_UNICODE */
47 extern AppendMenuW_Proc unicode_append_menu;
48 # endif /* NTGUI_UNICODE */
49 extern HMENU current_popup_menu;
50 #endif /* HAVE_NTGUI */
51
52 #include "menu.h"
53
54 /* Return non-zero if menus can handle radio and toggle buttons. */
55 static bool
56 have_boxes (void)
57 {
58 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
59 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)))
60 return 1;
61 #endif
62 return 0;
63 }
64
65 Lisp_Object menu_items;
66
67 /* If non-nil, means that the global vars defined here are already in use.
68 Used to detect cases where we try to re-enter this non-reentrant code. */
69 #if ! (defined USE_GTK || defined USE_MOTIF)
70 static
71 #endif
72 Lisp_Object menu_items_inuse;
73
74 /* Number of slots currently allocated in menu_items. */
75 int menu_items_allocated;
76
77 /* This is the index in menu_items of the first empty slot. */
78 int menu_items_used;
79
80 /* The number of panes currently recorded in menu_items,
81 excluding those within submenus. */
82 int menu_items_n_panes;
83
84 /* Current depth within submenus. */
85 static int menu_items_submenu_depth;
86
87 void
88 init_menu_items (void)
89 {
90 if (!NILP (menu_items_inuse))
91 error ("Trying to use a menu from within a menu-entry");
92
93 if (NILP (menu_items))
94 {
95 menu_items_allocated = 60;
96 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
97 }
98
99 menu_items_inuse = Qt;
100 menu_items_used = 0;
101 menu_items_n_panes = 0;
102 menu_items_submenu_depth = 0;
103 }
104
105 /* Call at the end of generating the data in menu_items. */
106
107 void
108 finish_menu_items (void)
109 {
110 }
111
112 void
113 unuse_menu_items (void)
114 {
115 menu_items_inuse = Qnil;
116 }
117
118 /* Call when finished using the data for the current menu
119 in menu_items. */
120
121 void
122 discard_menu_items (void)
123 {
124 /* Free the structure if it is especially large.
125 Otherwise, hold on to it, to save time. */
126 if (menu_items_allocated > 200)
127 {
128 menu_items = Qnil;
129 menu_items_allocated = 0;
130 }
131 eassert (NILP (menu_items_inuse));
132 }
133
134 /* This undoes save_menu_items, and it is called by the specpdl unwind
135 mechanism. */
136
137 static void
138 restore_menu_items (Lisp_Object saved)
139 {
140 menu_items = XCAR (saved);
141 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
142 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
143 saved = XCDR (saved);
144 menu_items_used = XINT (XCAR (saved));
145 saved = XCDR (saved);
146 menu_items_n_panes = XINT (XCAR (saved));
147 saved = XCDR (saved);
148 menu_items_submenu_depth = XINT (XCAR (saved));
149 }
150
151 /* Push the whole state of menu_items processing onto the specpdl.
152 It will be restored when the specpdl is unwound. */
153
154 void
155 save_menu_items (void)
156 {
157 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
158 make_number (menu_items_used),
159 make_number (menu_items_n_panes),
160 make_number (menu_items_submenu_depth));
161 record_unwind_protect (restore_menu_items, saved);
162 menu_items_inuse = Qnil;
163 menu_items = Qnil;
164 }
165
166 \f
167 /* Ensure that there is room for ITEMS items in the menu_items vector. */
168
169 static void
170 ensure_menu_items (int items)
171 {
172 int incr = items - (menu_items_allocated - menu_items_used);
173 if (incr > 0)
174 {
175 menu_items = larger_vector (menu_items, incr, INT_MAX);
176 menu_items_allocated = ASIZE (menu_items);
177 }
178 }
179
180 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
181 || defined HAVE_NTGUI)
182
183 /* Begin a submenu. */
184
185 static void
186 push_submenu_start (void)
187 {
188 ensure_menu_items (1);
189 ASET (menu_items, menu_items_used, Qnil);
190 menu_items_used++;
191 menu_items_submenu_depth++;
192 }
193
194 /* End a submenu. */
195
196 static void
197 push_submenu_end (void)
198 {
199 ensure_menu_items (1);
200 ASET (menu_items, menu_items_used, Qlambda);
201 menu_items_used++;
202 menu_items_submenu_depth--;
203 }
204
205 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
206
207 /* Indicate boundary between left and right. */
208
209 static void
210 push_left_right_boundary (void)
211 {
212 ensure_menu_items (1);
213 ASET (menu_items, menu_items_used, Qquote);
214 menu_items_used++;
215 }
216
217 /* Start a new menu pane in menu_items.
218 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
219
220 static void
221 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
222 {
223 ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
224 if (menu_items_submenu_depth == 0)
225 menu_items_n_panes++;
226 ASET (menu_items, menu_items_used, Qt);
227 menu_items_used++;
228 ASET (menu_items, menu_items_used, name);
229 menu_items_used++;
230 ASET (menu_items, menu_items_used, prefix_vec);
231 menu_items_used++;
232 }
233
234 /* Push one menu item into the current pane. NAME is the string to
235 display. ENABLE if non-nil means this item can be selected. KEY
236 is the key generated by choosing this item, or nil if this item
237 doesn't really have a definition. DEF is the definition of this
238 item. EQUIV is the textual description of the keyboard equivalent
239 for this item (or nil if none). TYPE is the type of this menu
240 item, one of nil, `toggle' or `radio'. */
241
242 static void
243 push_menu_item (Lisp_Object name, Lisp_Object enable, Lisp_Object key, Lisp_Object def, Lisp_Object equiv, Lisp_Object type, Lisp_Object selected, Lisp_Object help)
244 {
245 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
246
247 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
248 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
249 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
250 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
251 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
252 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
253 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
254 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
255
256 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
257 }
258
259 /* Args passed between single_keymap_panes and single_menu_item. */
260 struct skp
261 {
262 Lisp_Object pending_maps;
263 int maxdepth;
264 int notbuttons;
265 };
266
267 static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
268 void *);
269
270 /* This is a recursive subroutine of keymap_panes.
271 It handles one keymap, KEYMAP.
272 The other arguments are passed along
273 or point to local variables of the previous function.
274
275 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
276
277 static void
278 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
279 Lisp_Object prefix, int maxdepth)
280 {
281 struct skp skp;
282 struct gcpro gcpro1;
283
284 skp.pending_maps = Qnil;
285 skp.maxdepth = maxdepth;
286 skp.notbuttons = 0;
287
288 if (maxdepth <= 0)
289 return;
290
291 push_menu_pane (pane_name, prefix);
292
293 if (!have_boxes ())
294 {
295 /* Remember index for first item in this pane so we can go back
296 and add a prefix when (if) we see the first button. After
297 that, notbuttons is set to 0, to mark that we have seen a
298 button and all non button items need a prefix. */
299 skp.notbuttons = menu_items_used;
300 }
301
302 GCPRO1 (skp.pending_maps);
303 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
304 UNGCPRO;
305
306 /* Process now any submenus which want to be panes at this level. */
307 while (CONSP (skp.pending_maps))
308 {
309 Lisp_Object elt, eltcdr, string;
310 elt = XCAR (skp.pending_maps);
311 eltcdr = XCDR (elt);
312 string = XCAR (eltcdr);
313 /* We no longer discard the @ from the beginning of the string here.
314 Instead, we do this in *menu_show. */
315 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
316 skp.pending_maps = XCDR (skp.pending_maps);
317 }
318 }
319
320 /* This is a subroutine of single_keymap_panes that handles one
321 keymap entry.
322 KEY is a key in a keymap and ITEM is its binding.
323 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
324 separate panes.
325 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
326
327 static void
328 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
329 {
330 Lisp_Object map, item_string, enabled;
331 struct gcpro gcpro1, gcpro2;
332 bool res;
333 struct skp *skp = skp_v;
334
335 /* Parse the menu item and leave the result in item_properties. */
336 GCPRO2 (key, item);
337 res = parse_menu_item (item, 0);
338 UNGCPRO;
339 if (!res)
340 return; /* Not a menu item. */
341
342 map = AREF (item_properties, ITEM_PROPERTY_MAP);
343
344 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
345 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
346
347 if (!NILP (map) && SREF (item_string, 0) == '@')
348 {
349 if (!NILP (enabled))
350 /* An enabled separate pane. Remember this to handle it later. */
351 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
352 skp->pending_maps);
353 return;
354 }
355
356 /* Simulate radio buttons and toggle boxes by putting a prefix in
357 front of them. */
358 if (!have_boxes ())
359 {
360 Lisp_Object prefix = Qnil;
361 Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
362 if (!NILP (type))
363 {
364 Lisp_Object selected
365 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
366
367 if (skp->notbuttons)
368 /* The first button. Line up previous items in this menu. */
369 {
370 int idx = skp->notbuttons; /* Index for first item this menu. */
371 int submenu = 0;
372 Lisp_Object tem;
373 while (idx < menu_items_used)
374 {
375 tem
376 = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
377 if (NILP (tem))
378 {
379 idx++;
380 submenu++; /* Skip sub menu. */
381 }
382 else if (EQ (tem, Qlambda))
383 {
384 idx++;
385 submenu--; /* End sub menu. */
386 }
387 else if (EQ (tem, Qt))
388 idx += 3; /* Skip new pane marker. */
389 else if (EQ (tem, Qquote))
390 idx++; /* Skip a left, right divider. */
391 else
392 {
393 if (!submenu && SREF (tem, 0) != '\0'
394 && SREF (tem, 0) != '-')
395 ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
396 concat2 (build_string (" "), tem));
397 idx += MENU_ITEMS_ITEM_LENGTH;
398 }
399 }
400 skp->notbuttons = 0;
401 }
402
403 /* Calculate prefix, if any, for this item. */
404 if (EQ (type, QCtoggle))
405 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
406 else if (EQ (type, QCradio))
407 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
408 }
409 /* Not a button. If we have earlier buttons, then we need a prefix. */
410 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
411 && SREF (item_string, 0) != '-')
412 prefix = build_string (" ");
413
414 if (!NILP (prefix))
415 item_string = concat2 (prefix, item_string);
416 }
417
418 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))
419 && !NILP (map))
420 /* Indicate visually that this is a submenu. */
421 item_string = concat2 (item_string, build_string (" >"));
422
423 push_menu_item (item_string, enabled, key,
424 AREF (item_properties, ITEM_PROPERTY_DEF),
425 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
426 AREF (item_properties, ITEM_PROPERTY_TYPE),
427 AREF (item_properties, ITEM_PROPERTY_SELECTED),
428 AREF (item_properties, ITEM_PROPERTY_HELP));
429
430 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
431 /* Display a submenu using the toolkit. */
432 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))
433 && ! (NILP (map) || NILP (enabled)))
434 {
435 push_submenu_start ();
436 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
437 push_submenu_end ();
438 }
439 #endif
440 }
441
442 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
443 and generate menu panes for them in menu_items. */
444
445 static void
446 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
447 {
448 ptrdiff_t mapno;
449
450 init_menu_items ();
451
452 /* Loop over the given keymaps, making a pane for each map.
453 But don't make a pane that is empty--ignore that map instead.
454 P is the number of panes we have made so far. */
455 for (mapno = 0; mapno < nmaps; mapno++)
456 single_keymap_panes (keymaps[mapno],
457 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
458
459 finish_menu_items ();
460 }
461
462 /* Encode a menu string as appropriate for menu-updating-frame's type. */
463 static Lisp_Object
464 encode_menu_string (Lisp_Object str)
465 {
466 /* TTY menu strings are encoded by write_glyphs, when they are
467 delivered to the glass, so no need to encode them here. */
468 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)))
469 return str;
470 return ENCODE_MENU_STRING (str);
471 }
472
473 /* Push the items in a single pane defined by the alist PANE. */
474 static void
475 list_of_items (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 (Lisp_Object menu)
503 {
504 Lisp_Object tail;
505
506 init_menu_items ();
507
508 for (tail = menu; CONSP (tail); tail = XCDR (tail))
509 {
510 Lisp_Object elt, pane_name, pane_data;
511 elt = XCAR (tail);
512 pane_name = Fcar (elt);
513 CHECK_STRING (pane_name);
514 push_menu_pane (encode_menu_string (pane_name), Qnil);
515 pane_data = Fcdr (elt);
516 CHECK_CONS (pane_data);
517 list_of_items (pane_data);
518 }
519
520 finish_menu_items ();
521 }
522
523 /* Set up data in menu_items for a menu bar item
524 whose event type is ITEM_KEY (with string ITEM_NAME)
525 and whose contents come from the list of keymaps MAPS. */
526 bool
527 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
528 Lisp_Object maps)
529 {
530 Lisp_Object length;
531 EMACS_INT len;
532 Lisp_Object *mapvec;
533 ptrdiff_t i;
534 bool top_level_items = 0;
535 USE_SAFE_ALLOCA;
536
537 length = Flength (maps);
538 len = XINT (length);
539
540 /* Convert the list MAPS into a vector MAPVEC. */
541 SAFE_ALLOCA_LISP (mapvec, len);
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 SAFE_FREE ();
572 return top_level_items;
573 }
574
575 \f
576 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
577
578 /* Allocate a widget_value, blocking input. */
579
580 widget_value *
581 xmalloc_widget_value (void)
582 {
583 widget_value *value;
584
585 block_input ();
586 value = malloc_widget_value ();
587 unblock_input ();
588
589 return value;
590 }
591
592 /* This recursively calls free_widget_value on the tree of widgets.
593 It must free all data that was malloc'ed for these widget_values.
594 In Emacs, many slots are pointers into the data of Lisp_Strings, and
595 must be left alone. */
596
597 void
598 free_menubar_widget_value_tree (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 (int start, int end, bool top_level_items)
625 {
626 widget_value *wv, *prev_wv, *save_wv, *first_wv;
627 int i;
628 int submenu_depth = 0;
629 widget_value **submenu_stack;
630 bool panes_seen = 0;
631 struct frame *f = XFRAME (Vmenu_updating_frame);
632
633 submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
634 wv = xmalloc_widget_value ();
635 wv->name = "menu";
636 wv->value = 0;
637 wv->enabled = 1;
638 wv->button_type = BUTTON_TYPE_NONE;
639 wv->help = Qnil;
640 first_wv = wv;
641 save_wv = 0;
642 prev_wv = 0;
643
644 /* Loop over all panes and items made by the preceding call
645 to parse_single_submenu and construct a tree of widget_value objects.
646 Ignore the panes and items used by previous calls to
647 digest_single_submenu, even though those are also in menu_items. */
648 i = start;
649 while (i < end)
650 {
651 if (EQ (AREF (menu_items, i), Qnil))
652 {
653 submenu_stack[submenu_depth++] = save_wv;
654 save_wv = prev_wv;
655 prev_wv = 0;
656 i++;
657 }
658 else if (EQ (AREF (menu_items, i), Qlambda))
659 {
660 prev_wv = save_wv;
661 save_wv = submenu_stack[--submenu_depth];
662 i++;
663 }
664 else if (EQ (AREF (menu_items, i), Qt)
665 && submenu_depth != 0)
666 i += MENU_ITEMS_PANE_LENGTH;
667 /* Ignore a nil in the item list.
668 It's meaningful only for dialog boxes. */
669 else if (EQ (AREF (menu_items, i), Qquote))
670 i += 1;
671 else if (EQ (AREF (menu_items, i), Qt))
672 {
673 /* Create a new pane. */
674 Lisp_Object pane_name;
675 const char *pane_string;
676
677 panes_seen = 1;
678
679 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
680
681 /* TTY menus display menu items via tty_write_glyphs, which
682 will encode the strings as appropriate. */
683 if (!FRAME_TERMCAP_P (f))
684 {
685 #ifdef HAVE_NTGUI
686 if (STRINGP (pane_name))
687 {
688 if (unicode_append_menu)
689 /* Encode as UTF-8 for now. */
690 pane_name = ENCODE_UTF_8 (pane_name);
691 else if (STRING_MULTIBYTE (pane_name))
692 pane_name = ENCODE_SYSTEM (pane_name);
693
694 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
695 }
696 #elif defined (USE_LUCID) && defined (HAVE_XFT)
697 if (STRINGP (pane_name))
698 {
699 pane_name = ENCODE_UTF_8 (pane_name);
700 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
701 }
702 #elif !defined (HAVE_MULTILINGUAL_MENU)
703 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
704 {
705 pane_name = ENCODE_MENU_STRING (pane_name);
706 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
707 }
708 #endif
709 }
710
711 pane_string = (NILP (pane_name)
712 ? "" : SSDATA (pane_name));
713 /* If there is just one top-level pane, put all its items directly
714 under the top-level menu. */
715 if (menu_items_n_panes == 1)
716 pane_string = "";
717
718 /* If the pane has a meaningful name,
719 make the pane a top-level menu item
720 with its items as a submenu beneath it. */
721 if (strcmp (pane_string, ""))
722 {
723 wv = xmalloc_widget_value ();
724 if (save_wv)
725 save_wv->next = wv;
726 else
727 first_wv->contents = wv;
728 wv->lname = pane_name;
729 /* Set value to 1 so update_submenu_strings can handle '@' */
730 wv->value = (char *)1;
731 wv->enabled = 1;
732 wv->button_type = BUTTON_TYPE_NONE;
733 wv->help = Qnil;
734 save_wv = wv;
735 }
736 else
737 save_wv = first_wv;
738
739 prev_wv = 0;
740 i += MENU_ITEMS_PANE_LENGTH;
741 }
742 else
743 {
744 /* Create a new item within current pane. */
745 Lisp_Object item_name, enable, descrip, def, type, selected;
746 Lisp_Object help;
747
748 /* All items should be contained in panes. */
749 if (! panes_seen)
750 emacs_abort ();
751
752 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
753 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
754 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
755 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
756 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
757 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
758 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
759
760 /* TTY menu items and their descriptions will be encoded by
761 tty_write_glyphs. */
762 if (!FRAME_TERMCAP_P (f))
763 {
764 #ifdef HAVE_NTGUI
765 if (STRINGP (item_name))
766 {
767 if (unicode_append_menu)
768 item_name = ENCODE_UTF_8 (item_name);
769 else if (STRING_MULTIBYTE (item_name))
770 item_name = ENCODE_SYSTEM (item_name);
771
772 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
773 }
774
775 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
776 {
777 descrip = ENCODE_SYSTEM (descrip);
778 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
779 }
780 #elif USE_LUCID
781 if (STRINGP (item_name))
782 {
783 item_name = ENCODE_UTF_8 (item_name);
784 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
785 }
786
787 if (STRINGP (descrip))
788 {
789 descrip = ENCODE_UTF_8 (descrip);
790 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
791 }
792 #elif !defined (HAVE_MULTILINGUAL_MENU)
793 if (STRING_MULTIBYTE (item_name))
794 {
795 item_name = ENCODE_MENU_STRING (item_name);
796 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
797 }
798
799 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
800 {
801 descrip = ENCODE_MENU_STRING (descrip);
802 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
803 }
804 #endif
805 }
806
807 wv = xmalloc_widget_value ();
808 if (prev_wv)
809 prev_wv->next = wv;
810 else
811 save_wv->contents = wv;
812
813 wv->lname = item_name;
814 if (!NILP (descrip))
815 wv->lkey = descrip;
816 wv->value = 0;
817 /* The intptr_t cast avoids a warning. There's no problem
818 as long as pointers have enough bits to hold small integers. */
819 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
820 wv->enabled = !NILP (enable);
821
822 if (NILP (type))
823 wv->button_type = BUTTON_TYPE_NONE;
824 else if (EQ (type, QCradio))
825 wv->button_type = BUTTON_TYPE_RADIO;
826 else if (EQ (type, QCtoggle))
827 wv->button_type = BUTTON_TYPE_TOGGLE;
828 else
829 emacs_abort ();
830
831 wv->selected = !NILP (selected);
832 if (! STRINGP (help))
833 help = Qnil;
834
835 wv->help = help;
836
837 prev_wv = wv;
838
839 i += MENU_ITEMS_ITEM_LENGTH;
840 }
841 }
842
843 /* If we have just one "menu item"
844 that was originally a button, return it by itself. */
845 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
846 {
847 wv = first_wv->contents;
848 free_widget_value (first_wv);
849 return wv;
850 }
851
852 return first_wv;
853 }
854
855 /* Walk through the widget_value tree starting at FIRST_WV and update
856 the char * pointers from the corresponding lisp values.
857 We do this after building the whole tree, since GC may happen while the
858 tree is constructed, and small strings are relocated. So we must wait
859 until no GC can happen before storing pointers into lisp values. */
860 void
861 update_submenu_strings (widget_value *first_wv)
862 {
863 widget_value *wv;
864
865 for (wv = first_wv; wv; wv = wv->next)
866 {
867 if (STRINGP (wv->lname))
868 {
869 wv->name = SSDATA (wv->lname);
870
871 /* Ignore the @ that means "separate pane".
872 This is a kludge, but this isn't worth more time. */
873 if (wv->value == (char *)1)
874 {
875 if (wv->name[0] == '@')
876 wv->name++;
877 wv->value = 0;
878 }
879 }
880
881 if (STRINGP (wv->lkey))
882 wv->key = SSDATA (wv->lkey);
883
884 if (wv->contents)
885 update_submenu_strings (wv->contents);
886 }
887 }
888
889 /* Find the menu selection and store it in the keyboard buffer.
890 F is the frame the menu is on.
891 MENU_BAR_ITEMS_USED is the length of VECTOR.
892 VECTOR is an array of menu events for the whole menu. */
893
894 void
895 find_and_call_menu_selection (struct frame *f, int menu_bar_items_used,
896 Lisp_Object vector, void *client_data)
897 {
898 Lisp_Object prefix, entry;
899 Lisp_Object *subprefix_stack;
900 int submenu_depth = 0;
901 int i;
902
903 entry = Qnil;
904 subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
905 prefix = Qnil;
906 i = 0;
907
908 while (i < menu_bar_items_used)
909 {
910 if (EQ (AREF (vector, i), Qnil))
911 {
912 subprefix_stack[submenu_depth++] = prefix;
913 prefix = entry;
914 i++;
915 }
916 else if (EQ (AREF (vector, i), Qlambda))
917 {
918 prefix = subprefix_stack[--submenu_depth];
919 i++;
920 }
921 else if (EQ (AREF (vector, i), Qt))
922 {
923 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
924 i += MENU_ITEMS_PANE_LENGTH;
925 }
926 else
927 {
928 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
929 /* Treat the pointer as an integer. There's no problem
930 as long as pointers have enough bits to hold small integers. */
931 if ((intptr_t) client_data == i)
932 {
933 int j;
934 struct input_event buf;
935 Lisp_Object frame;
936 EVENT_INIT (buf);
937
938 XSETFRAME (frame, f);
939 buf.kind = MENU_BAR_EVENT;
940 buf.frame_or_window = frame;
941 buf.arg = frame;
942 kbd_buffer_store_event (&buf);
943
944 for (j = 0; j < submenu_depth; j++)
945 if (!NILP (subprefix_stack[j]))
946 {
947 buf.kind = MENU_BAR_EVENT;
948 buf.frame_or_window = frame;
949 buf.arg = subprefix_stack[j];
950 kbd_buffer_store_event (&buf);
951 }
952
953 if (!NILP (prefix))
954 {
955 buf.kind = MENU_BAR_EVENT;
956 buf.frame_or_window = frame;
957 buf.arg = prefix;
958 kbd_buffer_store_event (&buf);
959 }
960
961 buf.kind = MENU_BAR_EVENT;
962 buf.frame_or_window = frame;
963 buf.arg = entry;
964 kbd_buffer_store_event (&buf);
965
966 return;
967 }
968 i += MENU_ITEMS_ITEM_LENGTH;
969 }
970 }
971 }
972
973 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
974
975 #ifdef HAVE_NS
976 /* As above, but return the menu selection instead of storing in kb buffer.
977 If KEYMAPS, return full prefixes to selection. */
978 Lisp_Object
979 find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data)
980 {
981 Lisp_Object prefix, entry;
982 int i;
983 Lisp_Object *subprefix_stack;
984 int submenu_depth = 0;
985
986 prefix = entry = Qnil;
987 i = 0;
988 subprefix_stack = alloca (menu_items_used * word_size);
989
990 while (i < menu_items_used)
991 {
992 if (EQ (AREF (menu_items, i), Qnil))
993 {
994 subprefix_stack[submenu_depth++] = prefix;
995 prefix = entry;
996 i++;
997 }
998 else if (EQ (AREF (menu_items, i), Qlambda))
999 {
1000 prefix = subprefix_stack[--submenu_depth];
1001 i++;
1002 }
1003 else if (EQ (AREF (menu_items, i), Qt))
1004 {
1005 prefix
1006 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1007 i += MENU_ITEMS_PANE_LENGTH;
1008 }
1009 /* Ignore a nil in the item list.
1010 It's meaningful only for dialog boxes. */
1011 else if (EQ (AREF (menu_items, i), Qquote))
1012 i += 1;
1013 else
1014 {
1015 entry
1016 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1017 if (aref_addr (menu_items, i) == client_data)
1018 {
1019 if (keymaps)
1020 {
1021 int j;
1022
1023 entry = list1 (entry);
1024 if (!NILP (prefix))
1025 entry = Fcons (prefix, entry);
1026 for (j = submenu_depth - 1; j >= 0; j--)
1027 if (!NILP (subprefix_stack[j]))
1028 entry = Fcons (subprefix_stack[j], entry);
1029 }
1030 return entry;
1031 }
1032 i += MENU_ITEMS_ITEM_LENGTH;
1033 }
1034 }
1035 return Qnil;
1036 }
1037 #endif /* HAVE_NS */
1038
1039 int
1040 menu_item_width (const char *str)
1041 {
1042 int len;
1043 const char *p;
1044
1045 for (len = 0, p = str; *p; )
1046 {
1047 int ch_len;
1048 int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
1049
1050 len += CHAR_WIDTH (ch);
1051 p += ch_len;
1052 }
1053 return len;
1054 }
1055
1056 DEFUN ("menu-bar-menu-at-x-y", Fmenu_bar_menu_at_x_y, Smenu_bar_menu_at_x_y,
1057 2, 3, 0,
1058 doc: /* Return the menu-bar menu on FRAME at pixel coordinates X, Y.
1059 X and Y are frame-relative pixel coordinates, assumed to define
1060 a location within the menu bar.
1061 If FRAME is nil or omitted, it defaults to the selected frame.
1062
1063 Value is the symbol of the menu at X/Y, or nil if the specified
1064 coordinates are not within the FRAME's menu bar. The symbol can
1065 be used to look up the menu like this:
1066
1067 (lookup-key MAP [menu-bar SYMBOL])
1068
1069 where MAP is either the current global map or the current local map,
1070 since menu-bar items come from both.
1071
1072 This function can return non-nil only on a text-terminal frame
1073 or on an X frame that doesn't use any GUI toolkit. Otherwise,
1074 Emacs does not manage the menu bar and cannot convert coordinates
1075 into menu items. */)
1076 (Lisp_Object x, Lisp_Object y, Lisp_Object frame)
1077 {
1078 int row, col;
1079 struct frame *f = decode_any_frame (frame);
1080
1081 if (!FRAME_LIVE_P (f))
1082 return Qnil;
1083
1084 pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1);
1085 if (0 <= row && row < FRAME_MENU_BAR_LINES (f))
1086 {
1087 Lisp_Object items, item;
1088 int i;
1089
1090 /* Find the menu bar item under `col'. */
1091 item = Qnil;
1092 items = FRAME_MENU_BAR_ITEMS (f);
1093 /* This loop assumes a single menu-bar line, and will fail to
1094 find an item if it is not in the first line. Note that
1095 make_lispy_event in keyboard.c makes the same assumption. */
1096 for (i = 0; i < ASIZE (items); i += 4)
1097 {
1098 Lisp_Object pos, str;
1099
1100 str = AREF (items, i + 1);
1101 pos = AREF (items, i + 3);
1102 if (NILP (str))
1103 return item;
1104 if (XINT (pos) <= col
1105 /* We use <= so the blank between 2 items on a TTY is
1106 considered part of the previous item. */
1107 && col <= XINT (pos) + menu_item_width (SSDATA (str)))
1108 {
1109 item = AREF (items, i);
1110 return item;
1111 }
1112 }
1113 }
1114 return Qnil;
1115 }
1116
1117
1118 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1119 doc: /* Pop up a deck-of-cards menu and return user's selection.
1120 POSITION is a position specification. This is either a mouse button event
1121 or a list ((XOFFSET YOFFSET) WINDOW)
1122 where XOFFSET and YOFFSET are positions in pixels from the top left
1123 corner of WINDOW. (WINDOW may be a window or a frame object.)
1124 This controls the position of the top left of the menu as a whole.
1125 If POSITION is t, it means to use the current mouse position.
1126
1127 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1128 The menu items come from key bindings that have a menu string as well as
1129 a definition; actually, the "definition" in such a key binding looks like
1130 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1131 the keymap as a top-level element.
1132
1133 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1134 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1135
1136 You can also use a list of keymaps as MENU.
1137 Then each keymap makes a separate pane.
1138
1139 When MENU is a keymap or a list of keymaps, the return value is the
1140 list of events corresponding to the user's choice. Note that
1141 `x-popup-menu' does not actually execute the command bound to that
1142 sequence of events.
1143
1144 Alternatively, you can specify a menu of multiple panes
1145 with a list of the form (TITLE PANE1 PANE2...),
1146 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1147 Each ITEM is normally a cons cell (STRING . VALUE);
1148 but a string can appear as an item--that makes a nonselectable line
1149 in the menu.
1150 With this form of menu, the return value is VALUE from the chosen item.
1151
1152 If POSITION is nil, don't display the menu at all, just precalculate the
1153 cached information about equivalent key sequences.
1154
1155 If the user gets rid of the menu without making a valid choice, for
1156 instance by clicking the mouse away from a valid choice or by typing
1157 keyboard input, then this normally results in a quit and
1158 `x-popup-menu' does not return. But if POSITION is a mouse button
1159 event (indicating that the user invoked the menu with the mouse) then
1160 no quit occurs and `x-popup-menu' returns nil. */)
1161 (Lisp_Object position, Lisp_Object menu)
1162 {
1163 Lisp_Object keymap, tem, tem2;
1164 int xpos = 0, ypos = 0;
1165 Lisp_Object title;
1166 const char *error_name = NULL;
1167 Lisp_Object selection = Qnil;
1168 struct frame *f = NULL;
1169 Lisp_Object x, y, window;
1170 bool keymaps = 0;
1171 bool for_click = 0;
1172 bool kbd_menu_navigation = 0;
1173 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1174 struct gcpro gcpro1;
1175
1176 if (NILP (position))
1177 /* This is an obsolete call, which wants us to precompute the
1178 keybinding equivalents, but we don't do that any more anyway. */
1179 return Qnil;
1180
1181 #ifdef HAVE_MENUS
1182 {
1183 bool get_current_pos_p = 0;
1184
1185 /* Decode the first argument: find the window and the coordinates. */
1186 if (EQ (position, Qt)
1187 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1188 || EQ (XCAR (position), Qtool_bar))))
1189 {
1190 get_current_pos_p = 1;
1191 }
1192 else
1193 {
1194 tem = Fcar (position);
1195 if (CONSP (tem))
1196 {
1197 window = Fcar (Fcdr (position));
1198 x = XCAR (tem);
1199 y = Fcar (XCDR (tem));
1200 }
1201 else
1202 {
1203 for_click = 1;
1204 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1205 window = Fcar (tem); /* POSN_WINDOW (tem) */
1206 tem2 = Fcar (Fcdr (tem)); /* POSN_POSN (tem) */
1207 /* The kbd_menu_navigation flag is set when the menu was
1208 invoked by F10, which probably means they have no
1209 mouse. In that case, we let them switch between
1210 top-level menu-bar menus by using C-f/C-b and
1211 horizontal arrow keys, since they cannot click the
1212 mouse to open a different submenu. This flag is only
1213 supported by tty_menu_show. We set it when POSITION
1214 and last_nonmenu_event are different, which means we
1215 constructed POSITION by hand (in popup-menu, see
1216 menu-bar.el) to look like a mouse click on the menu bar
1217 event. */
1218 if (!EQ (POSN_POSN (last_nonmenu_event),
1219 POSN_POSN (position))
1220 && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar))
1221 kbd_menu_navigation = 1;
1222 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1223 x = Fcar (tem);
1224 y = Fcdr (tem);
1225 }
1226
1227 /* If a click happens in an external tool bar or a detached
1228 tool bar, x and y is NIL. In that case, use the current
1229 mouse position. This happens for the help button in the
1230 tool bar. Ideally popup-menu should pass NIL to
1231 this function, but it doesn't. */
1232 if (NILP (x) && NILP (y))
1233 get_current_pos_p = 1;
1234 }
1235
1236 if (get_current_pos_p)
1237 {
1238 /* Use the mouse's current position. */
1239 struct frame *new_f = SELECTED_FRAME ();
1240 #ifdef HAVE_X_WINDOWS
1241 /* Can't use mouse_position_hook for X since it returns
1242 coordinates relative to the window the mouse is in,
1243 we need coordinates relative to the edit widget always. */
1244 if (new_f != 0)
1245 {
1246 int cur_x, cur_y;
1247
1248 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1249 /* cur_x/y may be negative, so use make_number. */
1250 x = make_number (cur_x);
1251 y = make_number (cur_y);
1252 }
1253
1254 #else /* not HAVE_X_WINDOWS */
1255 Lisp_Object bar_window;
1256 enum scroll_bar_part part;
1257 Time time;
1258 void (*mouse_position_hook) (struct frame **, int,
1259 Lisp_Object *,
1260 enum scroll_bar_part *,
1261 Lisp_Object *,
1262 Lisp_Object *,
1263 Time *) =
1264 FRAME_TERMINAL (new_f)->mouse_position_hook;
1265
1266 if (mouse_position_hook)
1267 (*mouse_position_hook) (&new_f, 1, &bar_window,
1268 &part, &x, &y, &time);
1269 #endif /* not HAVE_X_WINDOWS */
1270
1271 if (new_f != 0)
1272 XSETFRAME (window, new_f);
1273 else
1274 {
1275 window = selected_window;
1276 XSETFASTINT (x, 0);
1277 XSETFASTINT (y, 0);
1278 }
1279 }
1280
1281 /* Decode where to put the menu. */
1282
1283 if (FRAMEP (window))
1284 {
1285 f = XFRAME (window);
1286 xpos = 0;
1287 ypos = 0;
1288 }
1289 else if (WINDOWP (window))
1290 {
1291 struct window *win = XWINDOW (window);
1292 CHECK_LIVE_WINDOW (window);
1293 f = XFRAME (WINDOW_FRAME (win));
1294
1295 xpos = WINDOW_LEFT_EDGE_X (win);
1296 ypos = WINDOW_TOP_EDGE_Y (win);
1297 }
1298 else
1299 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1300 but I don't want to make one now. */
1301 CHECK_WINDOW (window);
1302
1303 CHECK_RANGED_INTEGER (x,
1304 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1305 ? (EMACS_INT) INT_MIN - xpos
1306 : MOST_NEGATIVE_FIXNUM),
1307 INT_MAX - xpos);
1308 CHECK_RANGED_INTEGER (y,
1309 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1310 ? (EMACS_INT) INT_MIN - ypos
1311 : MOST_NEGATIVE_FIXNUM),
1312 INT_MAX - ypos);
1313 xpos += XINT (x);
1314 ypos += XINT (y);
1315
1316 XSETFRAME (Vmenu_updating_frame, f);
1317 }
1318 #endif /* HAVE_MENUS */
1319
1320 /* Now parse the lisp menus. */
1321 record_unwind_protect_void (unuse_menu_items);
1322
1323 title = Qnil;
1324 GCPRO1 (title);
1325
1326 /* Decode the menu items from what was specified. */
1327
1328 keymap = get_keymap (menu, 0, 0);
1329 if (CONSP (keymap))
1330 {
1331 /* We were given a keymap. Extract menu info from the keymap. */
1332 Lisp_Object prompt;
1333
1334 /* Extract the detailed info to make one pane. */
1335 keymap_panes (&menu, 1);
1336
1337 /* Search for a string appearing directly as an element of the keymap.
1338 That string is the title of the menu. */
1339 prompt = Fkeymap_prompt (keymap);
1340 if (!NILP (prompt))
1341 title = prompt;
1342 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1343 else
1344 title = build_string ("Select");
1345 #endif
1346
1347 /* Make that be the pane title of the first pane. */
1348 if (!NILP (prompt) && menu_items_n_panes >= 0)
1349 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1350
1351 keymaps = 1;
1352 }
1353 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1354 {
1355 /* We were given a list of keymaps. */
1356 EMACS_INT nmaps = XFASTINT (Flength (menu));
1357 Lisp_Object *maps;
1358 ptrdiff_t i;
1359 USE_SAFE_ALLOCA;
1360
1361 SAFE_ALLOCA_LISP (maps, nmaps);
1362 title = Qnil;
1363
1364 /* The first keymap that has a prompt string
1365 supplies the menu title. */
1366 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1367 {
1368 Lisp_Object prompt;
1369
1370 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1371
1372 prompt = Fkeymap_prompt (keymap);
1373 if (NILP (title) && !NILP (prompt))
1374 title = prompt;
1375 }
1376
1377 /* Extract the detailed info to make one pane. */
1378 keymap_panes (maps, nmaps);
1379
1380 /* Make the title be the pane title of the first pane. */
1381 if (!NILP (title) && menu_items_n_panes >= 0)
1382 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1383
1384 keymaps = 1;
1385
1386 SAFE_FREE ();
1387 }
1388 else
1389 {
1390 /* We were given an old-fashioned menu. */
1391 title = Fcar (menu);
1392 CHECK_STRING (title);
1393
1394 list_of_panes (Fcdr (menu));
1395
1396 keymaps = 0;
1397 }
1398
1399 unbind_to (specpdl_count, Qnil);
1400
1401 #ifdef HAVE_MENUS
1402 #ifdef HAVE_WINDOW_SYSTEM
1403 /* Hide a previous tip, if any. */
1404 if (!FRAME_TERMCAP_P (f))
1405 Fx_hide_tip ();
1406 #endif
1407
1408 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1409 /* If resources from a previous popup menu still exist, does nothing
1410 until the `menu_free_timer' has freed them (see w32fns.c). This
1411 can occur if you press ESC or click outside a menu without selecting
1412 a menu item.
1413 */
1414 if (current_popup_menu && FRAME_W32_P (f))
1415 {
1416 discard_menu_items ();
1417 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1418 UNGCPRO;
1419 return Qnil;
1420 }
1421 #endif
1422
1423 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1424 record_unwind_protect_void (discard_menu_items);
1425 #endif
1426
1427 /* Display them in a menu. */
1428
1429 /* FIXME: Use a terminal hook! */
1430 #if defined HAVE_NTGUI
1431 if (FRAME_W32_P (f))
1432 selection = w32_menu_show (f, xpos, ypos, for_click,
1433 keymaps, title, &error_name);
1434 else
1435 #endif
1436 #if defined HAVE_NS
1437 if (FRAME_NS_P (f))
1438 selection = ns_menu_show (f, xpos, ypos, for_click,
1439 keymaps, title, &error_name);
1440 else
1441 #endif
1442 #if (defined (HAVE_X_WINDOWS) || defined (MSDOS))
1443 /* Assume last_event_timestamp is the timestamp of the button event.
1444 Is this assumption ever violated? We can't use the timestamp
1445 stored within POSITION because there the top bits from the actual
1446 timestamp may be truncated away (Bug#4930). */
1447 if (FRAME_X_P (f) || FRAME_MSDOS_P (f))
1448 selection = xmenu_show (f, xpos, ypos, for_click,
1449 keymaps, title, &error_name,
1450 last_event_timestamp);
1451 else
1452 #endif
1453 if (FRAME_TERMCAP_P (f))
1454 selection = tty_menu_show (f, xpos, ypos, for_click, keymaps, title,
1455 kbd_menu_navigation, &error_name);
1456
1457 #ifdef HAVE_NS
1458 unbind_to (specpdl_count, Qnil);
1459 #else
1460 discard_menu_items ();
1461 #endif
1462
1463 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1464 if (FRAME_W32_P (f))
1465 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1466 #endif
1467
1468 #endif /* HAVE_MENUS */
1469
1470 UNGCPRO;
1471
1472 if (error_name) error ("%s", error_name);
1473 return selection;
1474 }
1475
1476 #ifdef HAVE_MENUS
1477
1478 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
1479 doc: /* Pop up a dialog box and return user's selection.
1480 POSITION specifies which frame to use.
1481 This is normally a mouse button event or a window or frame.
1482 If POSITION is t, it means to use the frame the mouse is on.
1483 The dialog box appears in the middle of the specified frame.
1484
1485 CONTENTS specifies the alternatives to display in the dialog box.
1486 It is a list of the form (DIALOG ITEM1 ITEM2...).
1487 Each ITEM is a cons cell (STRING . VALUE).
1488 The return value is VALUE from the chosen item.
1489
1490 An ITEM may also be just a string--that makes a nonselectable item.
1491 An ITEM may also be nil--that means to put all preceding items
1492 on the left of the dialog box and all following items on the right.
1493 \(By default, approximately half appear on each side.)
1494
1495 If HEADER is non-nil, the frame title for the box is "Information",
1496 otherwise it is "Question".
1497
1498 If the user gets rid of the dialog box without making a valid choice,
1499 for instance using the window manager, then this produces a quit and
1500 `x-popup-dialog' does not return. */)
1501 (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
1502 {
1503 struct frame *f = NULL;
1504 Lisp_Object window;
1505
1506 /* Decode the first argument: find the window or frame to use. */
1507 if (EQ (position, Qt)
1508 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1509 || EQ (XCAR (position), Qtool_bar))))
1510 {
1511 #if 0 /* Using the frame the mouse is on may not be right. */
1512 /* Use the mouse's current position. */
1513 struct frame *new_f = SELECTED_FRAME ();
1514 Lisp_Object bar_window;
1515 enum scroll_bar_part part;
1516 Time time;
1517 Lisp_Object x, y;
1518
1519 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1520
1521 if (new_f != 0)
1522 XSETFRAME (window, new_f);
1523 else
1524 window = selected_window;
1525 #endif
1526 window = selected_window;
1527 }
1528 else if (CONSP (position))
1529 {
1530 Lisp_Object tem = XCAR (position);
1531 if (CONSP (tem))
1532 window = Fcar (XCDR (position));
1533 else
1534 {
1535 tem = Fcar (XCDR (position)); /* EVENT_START (position) */
1536 window = Fcar (tem); /* POSN_WINDOW (tem) */
1537 }
1538 }
1539 else if (WINDOWP (position) || FRAMEP (position))
1540 window = position;
1541 else
1542 window = Qnil;
1543
1544 /* Decode where to put the menu. */
1545
1546 if (FRAMEP (window))
1547 f = XFRAME (window);
1548 else if (WINDOWP (window))
1549 {
1550 CHECK_LIVE_WINDOW (window);
1551 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1552 }
1553 else
1554 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1555 but I don't want to make one now. */
1556 CHECK_WINDOW (window);
1557
1558 /* Force a redisplay before showing the dialog. If a frame is created
1559 just before showing the dialog, its contents may not have been fully
1560 drawn, as this depends on timing of events from the X server. Redisplay
1561 is not done when a dialog is shown. If redisplay could be done in the
1562 X event loop (i.e. the X event loop does not run in a signal handler)
1563 this would not be needed.
1564
1565 Do this before creating the widget value that points to Lisp
1566 string contents, because Fredisplay may GC and relocate them. */
1567 Fredisplay (Qt);
1568 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1569 if (FRAME_WINDOW_P (f))
1570 return xw_popup_dialog (f, header, contents);
1571 else
1572 #endif
1573 #if defined (HAVE_NTGUI) && defined (HAVE_DIALOGS)
1574 if (FRAME_W32_P (f))
1575 return w32_popup_dialog (f, header, contents);
1576 else
1577 #endif
1578 #ifdef HAVE_NS
1579 if (FRAME_NS_P (f))
1580 return ns_popup_dialog (position, header, contents);
1581 else
1582 #endif
1583 /* Display a menu with these alternatives
1584 in the middle of frame F. */
1585 {
1586 Lisp_Object x, y, frame, newpos, prompt;
1587 int x_coord, y_coord;
1588
1589 prompt = Fcar (contents);
1590 if (FRAME_WINDOW_P (f))
1591 {
1592 x_coord = FRAME_PIXEL_WIDTH (f);
1593 y_coord = FRAME_PIXEL_HEIGHT (f);
1594 }
1595 else
1596 {
1597 x_coord = FRAME_COLS (f);
1598 /* Center the title at frame middle. (TTY menus have their
1599 upper-left corner at the given position.) */
1600 if (STRINGP (prompt))
1601 x_coord -= SCHARS (prompt);
1602 y_coord = FRAME_LINES (f);
1603 }
1604 XSETFRAME (frame, f);
1605 XSETINT (x, x_coord / 2);
1606 XSETINT (y, y_coord / 2);
1607 newpos = list2 (list2 (x, y), frame);
1608
1609 return Fx_popup_menu (newpos, list2 (prompt, contents));
1610 }
1611 }
1612
1613 #endif /* HAVE_MENUS */
1614
1615 void
1616 syms_of_menu (void)
1617 {
1618 staticpro (&menu_items);
1619 menu_items = Qnil;
1620 menu_items_inuse = Qnil;
1621
1622 defsubr (&Sx_popup_menu);
1623
1624 #ifdef HAVE_MENUS
1625 defsubr (&Sx_popup_dialog);
1626 #endif
1627 defsubr (&Smenu_bar_menu_at_x_y);
1628 }