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