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