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