Merge from emacs-24; up to 2014-06-06T02:22:40Z!monnier@iro.umontreal.ca
[bpt/emacs.git] / src / menu.c
1 /* Platform-independent code for terminal communications.
2
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2014 Free Software
4 Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21 #include <config.h>
22 #include <stdio.h>
23 #include <limits.h> /* for INT_MAX */
24
25 #include "lisp.h"
26 #include "keyboard.h"
27 #include "keymap.h"
28 #include "frame.h"
29 #include "window.h"
30 #include "termhooks.h"
31 #include "blockinput.h"
32 #include "dispextern.h"
33 #include "buffer.h"
34
35 #ifdef USE_X_TOOLKIT
36 #include "../lwlib/lwlib.h"
37 #endif
38
39 #ifdef HAVE_WINDOW_SYSTEM
40 #include TERM_HEADER
41 #endif /* HAVE_WINDOW_SYSTEM */
42
43 #ifdef HAVE_NTGUI
44 # ifdef NTGUI_UNICODE
45 # define unicode_append_menu AppendMenuW
46 # else /* !NTGUI_UNICODE */
47 extern AppendMenuW_Proc unicode_append_menu;
48 # endif /* NTGUI_UNICODE */
49 extern HMENU current_popup_menu;
50 #endif /* HAVE_NTGUI */
51
52 #include "menu.h"
53
54 /* Return non-zero if menus can handle radio and toggle buttons. */
55 static bool
56 have_boxes (void)
57 {
58 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || 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 struct gcpro gcpro1;
280
281 skp.pending_maps = Qnil;
282 skp.maxdepth = maxdepth;
283 skp.notbuttons = 0;
284
285 if (maxdepth <= 0)
286 return;
287
288 push_menu_pane (pane_name, prefix);
289
290 if (!have_boxes ())
291 {
292 /* Remember index for first item in this pane so we can go back
293 and add a prefix when (if) we see the first button. After
294 that, notbuttons is set to 0, to mark that we have seen a
295 button and all non button items need a prefix. */
296 skp.notbuttons = menu_items_used;
297 }
298
299 GCPRO1 (skp.pending_maps);
300 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
301 UNGCPRO;
302
303 /* Process now any submenus which want to be panes at this level. */
304 while (CONSP (skp.pending_maps))
305 {
306 Lisp_Object elt, eltcdr, string;
307 elt = XCAR (skp.pending_maps);
308 eltcdr = XCDR (elt);
309 string = XCAR (eltcdr);
310 /* We no longer discard the @ from the beginning of the string here.
311 Instead, we do this in *menu_show. */
312 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
313 skp.pending_maps = XCDR (skp.pending_maps);
314 }
315 }
316
317 /* This is a subroutine of single_keymap_panes that handles one
318 keymap entry.
319 KEY is a key in a keymap and ITEM is its binding.
320 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
321 separate panes.
322 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
323
324 static void
325 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
326 {
327 Lisp_Object map, item_string, enabled;
328 struct gcpro gcpro1, gcpro2;
329 bool res;
330 struct skp *skp = skp_v;
331
332 /* Parse the menu item and leave the result in item_properties. */
333 GCPRO2 (key, item);
334 res = parse_menu_item (item, 0);
335 UNGCPRO;
336 if (!res)
337 return; /* Not a menu item. */
338
339 map = AREF (item_properties, ITEM_PROPERTY_MAP);
340
341 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
342 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
343
344 if (!NILP (map) && SREF (item_string, 0) == '@')
345 {
346 if (!NILP (enabled))
347 /* An enabled separate pane. Remember this to handle it later. */
348 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
349 skp->pending_maps);
350 return;
351 }
352
353 /* Simulate radio buttons and toggle boxes by putting a prefix in
354 front of them. */
355 if (!have_boxes ())
356 {
357 Lisp_Object prefix = Qnil;
358 Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
359 if (!NILP (type))
360 {
361 Lisp_Object selected
362 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
363
364 if (skp->notbuttons)
365 /* The first button. Line up previous items in this menu. */
366 {
367 int idx = skp->notbuttons; /* Index for first item this menu. */
368 int submenu = 0;
369 Lisp_Object tem;
370 while (idx < menu_items_used)
371 {
372 tem
373 = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
374 if (NILP (tem))
375 {
376 idx++;
377 submenu++; /* Skip sub menu. */
378 }
379 else if (EQ (tem, Qlambda))
380 {
381 idx++;
382 submenu--; /* End sub menu. */
383 }
384 else if (EQ (tem, Qt))
385 idx += 3; /* Skip new pane marker. */
386 else if (EQ (tem, Qquote))
387 idx++; /* Skip a left, right divider. */
388 else
389 {
390 if (!submenu && SREF (tem, 0) != '\0'
391 && SREF (tem, 0) != '-')
392 ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
393 concat2 (build_string (" "), tem));
394 idx += MENU_ITEMS_ITEM_LENGTH;
395 }
396 }
397 skp->notbuttons = 0;
398 }
399
400 /* Calculate prefix, if any, for this item. */
401 if (EQ (type, QCtoggle))
402 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
403 else if (EQ (type, QCradio))
404 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
405 }
406 /* Not a button. If we have earlier buttons, then we need a prefix. */
407 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
408 && SREF (item_string, 0) != '-')
409 prefix = build_string (" ");
410
411 if (!NILP (prefix))
412 item_string = concat2 (prefix, item_string);
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 item_string = concat2 (item_string, build_string (" >"));
420
421 push_menu_item (item_string, enabled, key,
422 AREF (item_properties, ITEM_PROPERTY_DEF),
423 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
424 AREF (item_properties, ITEM_PROPERTY_TYPE),
425 AREF (item_properties, ITEM_PROPERTY_SELECTED),
426 AREF (item_properties, ITEM_PROPERTY_HELP));
427
428 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
429 /* Display a submenu using the toolkit. */
430 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))
431 && ! (NILP (map) || NILP (enabled)))
432 {
433 push_submenu_start ();
434 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
435 push_submenu_end ();
436 }
437 #endif
438 }
439
440 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
441 and generate menu panes for them in menu_items. */
442
443 static void
444 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
445 {
446 ptrdiff_t mapno;
447
448 init_menu_items ();
449
450 /* Loop over the given keymaps, making a pane for each map.
451 But don't make a pane that is empty--ignore that map instead.
452 P is the number of panes we have made so far. */
453 for (mapno = 0; mapno < nmaps; mapno++)
454 single_keymap_panes (keymaps[mapno],
455 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
456
457 finish_menu_items ();
458 }
459
460 /* Encode a menu string as appropriate for menu-updating-frame's type. */
461 static Lisp_Object
462 encode_menu_string (Lisp_Object str)
463 {
464 /* TTY menu strings are encoded by write_glyphs, when they are
465 delivered to the glass, so no need to encode them here. */
466 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)))
467 return str;
468 return ENCODE_MENU_STRING (str);
469 }
470
471 /* Push the items in a single pane defined by the alist PANE. */
472 static void
473 list_of_items (Lisp_Object pane)
474 {
475 Lisp_Object tail, item, item1;
476
477 for (tail = pane; CONSP (tail); tail = XCDR (tail))
478 {
479 item = XCAR (tail);
480 if (STRINGP (item))
481 push_menu_item (encode_menu_string (item), Qnil, Qnil, Qt,
482 Qnil, Qnil, Qnil, Qnil);
483 else if (CONSP (item))
484 {
485 item1 = XCAR (item);
486 CHECK_STRING (item1);
487 push_menu_item (encode_menu_string (item1), Qt, XCDR (item),
488 Qt, Qnil, Qnil, Qnil, Qnil);
489 }
490 else
491 push_left_right_boundary ();
492
493 }
494 }
495
496 /* Push all the panes and items of a menu described by the
497 alist-of-alists MENU.
498 This handles old-fashioned calls to x-popup-menu. */
499 void
500 list_of_panes (Lisp_Object menu)
501 {
502 Lisp_Object tail;
503
504 init_menu_items ();
505
506 for (tail = menu; CONSP (tail); tail = XCDR (tail))
507 {
508 Lisp_Object elt, pane_name, pane_data;
509 elt = XCAR (tail);
510 pane_name = Fcar (elt);
511 CHECK_STRING (pane_name);
512 push_menu_pane (encode_menu_string (pane_name), Qnil);
513 pane_data = Fcdr (elt);
514 CHECK_CONS (pane_data);
515 list_of_items (pane_data);
516 }
517
518 finish_menu_items ();
519 }
520
521 /* Set up data in menu_items for a menu bar item
522 whose event type is ITEM_KEY (with string ITEM_NAME)
523 and whose contents come from the list of keymaps MAPS. */
524 bool
525 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
526 Lisp_Object maps)
527 {
528 Lisp_Object length;
529 EMACS_INT len;
530 Lisp_Object *mapvec;
531 ptrdiff_t i;
532 bool top_level_items = 0;
533 USE_SAFE_ALLOCA;
534
535 length = Flength (maps);
536 len = XINT (length);
537
538 /* Convert the list MAPS into a vector MAPVEC. */
539 SAFE_ALLOCA_LISP (mapvec, len);
540 for (i = 0; i < len; i++)
541 {
542 mapvec[i] = Fcar (maps);
543 maps = Fcdr (maps);
544 }
545
546 /* Loop over the given keymaps, making a pane for each map.
547 But don't make a pane that is empty--ignore that map instead. */
548 for (i = 0; i < len; i++)
549 {
550 if (!KEYMAPP (mapvec[i]))
551 {
552 /* Here we have a command at top level in the menu bar
553 as opposed to a submenu. */
554 top_level_items = 1;
555 push_menu_pane (Qnil, Qnil);
556 push_menu_item (item_name, Qt, item_key, mapvec[i],
557 Qnil, Qnil, Qnil, Qnil);
558 }
559 else
560 {
561 Lisp_Object prompt;
562 prompt = Fkeymap_prompt (mapvec[i]);
563 single_keymap_panes (mapvec[i],
564 !NILP (prompt) ? prompt : item_name,
565 item_key, 10);
566 }
567 }
568
569 SAFE_FREE ();
570 return top_level_items;
571 }
572
573 \f
574 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
575
576 /* Allocate and basically initialize widget_value, blocking input. */
577
578 widget_value *
579 make_widget_value (const char *name, char *value,
580 bool enabled, Lisp_Object help)
581 {
582 widget_value *wv;
583
584 block_input ();
585 wv = xzalloc (sizeof (widget_value));
586 unblock_input ();
587
588 wv->name = (char *) name;
589 wv->value = value;
590 wv->enabled = enabled;
591 wv->help = help;
592 return wv;
593 }
594
595 /* This recursively calls xfree on the tree of widgets.
596 It must free all data that was malloc'ed for these widget_values.
597 In Emacs, many slots are pointers into the data of Lisp_Strings, and
598 must be left alone. */
599
600 void
601 free_menubar_widget_value_tree (widget_value *wv)
602 {
603 if (! wv) return;
604
605 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
606
607 if (wv->contents && (wv->contents != (widget_value*)1))
608 {
609 free_menubar_widget_value_tree (wv->contents);
610 wv->contents = (widget_value *) 0xDEADBEEF;
611 }
612 if (wv->next)
613 {
614 free_menubar_widget_value_tree (wv->next);
615 wv->next = (widget_value *) 0xDEADBEEF;
616 }
617 block_input ();
618 xfree (wv);
619 unblock_input ();
620 }
621
622 /* Create a tree of widget_value objects
623 representing the panes and items
624 in menu_items starting at index START, up to index END. */
625
626 widget_value *
627 digest_single_submenu (int start, int end, bool top_level_items)
628 {
629 widget_value *wv, *prev_wv, *save_wv, *first_wv;
630 int i;
631 int submenu_depth = 0;
632 widget_value **submenu_stack;
633 bool panes_seen = 0;
634 struct frame *f = XFRAME (Vmenu_updating_frame);
635
636 submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
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->contents;
839 xfree (first_wv);
840 return wv;
841 }
842
843 return first_wv;
844 }
845
846 /* Walk through the widget_value tree starting at FIRST_WV and update
847 the char * pointers from the corresponding lisp values.
848 We do this after building the whole tree, since GC may happen while the
849 tree is constructed, and small strings are relocated. So we must wait
850 until no GC can happen before storing pointers into lisp values. */
851 void
852 update_submenu_strings (widget_value *first_wv)
853 {
854 widget_value *wv;
855
856 for (wv = first_wv; wv; wv = wv->next)
857 {
858 if (STRINGP (wv->lname))
859 {
860 wv->name = SSDATA (wv->lname);
861
862 /* Ignore the @ that means "separate pane".
863 This is a kludge, but this isn't worth more time. */
864 if (wv->value == (char *)1)
865 {
866 if (wv->name[0] == '@')
867 wv->name++;
868 wv->value = 0;
869 }
870 }
871
872 if (STRINGP (wv->lkey))
873 wv->key = SSDATA (wv->lkey);
874
875 if (wv->contents)
876 update_submenu_strings (wv->contents);
877 }
878 }
879
880 /* Find the menu selection and store it in the keyboard buffer.
881 F is the frame the menu is on.
882 MENU_BAR_ITEMS_USED is the length of VECTOR.
883 VECTOR is an array of menu events for the whole menu. */
884
885 void
886 find_and_call_menu_selection (struct frame *f, int menu_bar_items_used,
887 Lisp_Object vector, void *client_data)
888 {
889 Lisp_Object prefix, entry;
890 Lisp_Object *subprefix_stack;
891 int submenu_depth = 0;
892 int i;
893
894 entry = Qnil;
895 subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
896 prefix = Qnil;
897 i = 0;
898
899 while (i < menu_bar_items_used)
900 {
901 if (EQ (AREF (vector, i), Qnil))
902 {
903 subprefix_stack[submenu_depth++] = prefix;
904 prefix = entry;
905 i++;
906 }
907 else if (EQ (AREF (vector, i), Qlambda))
908 {
909 prefix = subprefix_stack[--submenu_depth];
910 i++;
911 }
912 else if (EQ (AREF (vector, i), Qt))
913 {
914 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
915 i += MENU_ITEMS_PANE_LENGTH;
916 }
917 else
918 {
919 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
920 /* Treat the pointer as an integer. There's no problem
921 as long as pointers have enough bits to hold small integers. */
922 if ((intptr_t) client_data == i)
923 {
924 int j;
925 struct input_event buf;
926 Lisp_Object frame;
927 EVENT_INIT (buf);
928
929 XSETFRAME (frame, f);
930 buf.kind = MENU_BAR_EVENT;
931 buf.frame_or_window = frame;
932 buf.arg = frame;
933 kbd_buffer_store_event (&buf);
934
935 for (j = 0; j < submenu_depth; j++)
936 if (!NILP (subprefix_stack[j]))
937 {
938 buf.kind = MENU_BAR_EVENT;
939 buf.frame_or_window = frame;
940 buf.arg = subprefix_stack[j];
941 kbd_buffer_store_event (&buf);
942 }
943
944 if (!NILP (prefix))
945 {
946 buf.kind = MENU_BAR_EVENT;
947 buf.frame_or_window = frame;
948 buf.arg = prefix;
949 kbd_buffer_store_event (&buf);
950 }
951
952 buf.kind = MENU_BAR_EVENT;
953 buf.frame_or_window = frame;
954 buf.arg = entry;
955 kbd_buffer_store_event (&buf);
956
957 return;
958 }
959 i += MENU_ITEMS_ITEM_LENGTH;
960 }
961 }
962 }
963
964 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
965
966 #ifdef HAVE_NS
967 /* As above, but return the menu selection instead of storing in kb buffer.
968 If KEYMAPS, return full prefixes to selection. */
969 Lisp_Object
970 find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data)
971 {
972 Lisp_Object prefix, entry;
973 int i;
974 Lisp_Object *subprefix_stack;
975 int submenu_depth = 0;
976
977 prefix = entry = Qnil;
978 i = 0;
979 subprefix_stack = alloca (menu_items_used * word_size);
980
981 while (i < menu_items_used)
982 {
983 if (EQ (AREF (menu_items, i), Qnil))
984 {
985 subprefix_stack[submenu_depth++] = prefix;
986 prefix = entry;
987 i++;
988 }
989 else if (EQ (AREF (menu_items, i), Qlambda))
990 {
991 prefix = subprefix_stack[--submenu_depth];
992 i++;
993 }
994 else if (EQ (AREF (menu_items, i), Qt))
995 {
996 prefix
997 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
998 i += MENU_ITEMS_PANE_LENGTH;
999 }
1000 /* Ignore a nil in the item list.
1001 It's meaningful only for dialog boxes. */
1002 else if (EQ (AREF (menu_items, i), Qquote))
1003 i += 1;
1004 else
1005 {
1006 entry
1007 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1008 if (aref_addr (menu_items, i) == client_data)
1009 {
1010 if (keymaps)
1011 {
1012 int j;
1013
1014 entry = list1 (entry);
1015 if (!NILP (prefix))
1016 entry = Fcons (prefix, entry);
1017 for (j = submenu_depth - 1; j >= 0; j--)
1018 if (!NILP (subprefix_stack[j]))
1019 entry = Fcons (subprefix_stack[j], entry);
1020 }
1021 return entry;
1022 }
1023 i += MENU_ITEMS_ITEM_LENGTH;
1024 }
1025 }
1026 return Qnil;
1027 }
1028 #endif /* HAVE_NS */
1029
1030 ptrdiff_t
1031 menu_item_width (const unsigned char *str)
1032 {
1033 ptrdiff_t len;
1034 const unsigned char *p;
1035
1036 for (len = 0, p = str; *p; )
1037 {
1038 int ch_len;
1039 int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
1040
1041 len += CHAR_WIDTH (ch);
1042 p += ch_len;
1043 }
1044 return len;
1045 }
1046
1047 DEFUN ("menu-bar-menu-at-x-y", Fmenu_bar_menu_at_x_y, Smenu_bar_menu_at_x_y,
1048 2, 3, 0,
1049 doc: /* Return the menu-bar menu on FRAME at pixel coordinates X, Y.
1050 X and Y are frame-relative pixel coordinates, assumed to define
1051 a location within the menu bar.
1052 If FRAME is nil or omitted, it defaults to the selected frame.
1053
1054 Value is the symbol of the menu at X/Y, or nil if the specified
1055 coordinates are not within the FRAME's menu bar. The symbol can
1056 be used to look up the menu like this:
1057
1058 (lookup-key MAP [menu-bar SYMBOL])
1059
1060 where MAP is either the current global map or the current local map,
1061 since menu-bar items come from both.
1062
1063 This function can return non-nil only on a text-terminal frame
1064 or on an X frame that doesn't use any GUI toolkit. Otherwise,
1065 Emacs does not manage the menu bar and cannot convert coordinates
1066 into menu items. */)
1067 (Lisp_Object x, Lisp_Object y, Lisp_Object frame)
1068 {
1069 int row, col;
1070 struct frame *f = decode_any_frame (frame);
1071
1072 if (!FRAME_LIVE_P (f))
1073 return Qnil;
1074
1075 pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1);
1076 if (0 <= row && row < FRAME_MENU_BAR_LINES (f))
1077 {
1078 Lisp_Object items, item;
1079 int i;
1080
1081 /* Find the menu bar item under `col'. */
1082 item = Qnil;
1083 items = FRAME_MENU_BAR_ITEMS (f);
1084 /* This loop assumes a single menu-bar line, and will fail to
1085 find an item if it is not in the first line. Note that
1086 make_lispy_event in keyboard.c makes the same assumption. */
1087 for (i = 0; i < ASIZE (items); i += 4)
1088 {
1089 Lisp_Object pos, str;
1090
1091 str = AREF (items, i + 1);
1092 pos = AREF (items, i + 3);
1093 if (NILP (str))
1094 return item;
1095 if (XINT (pos) <= col
1096 /* We use <= so the blank between 2 items on a TTY is
1097 considered part of the previous item. */
1098 && col <= XINT (pos) + menu_item_width (SDATA (str)))
1099 {
1100 item = AREF (items, i);
1101 return item;
1102 }
1103 }
1104 }
1105 return Qnil;
1106 }
1107
1108
1109 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1110 doc: /* Pop up a deck-of-cards menu and return user's selection.
1111 POSITION is a position specification. This is either a mouse button event
1112 or a list ((XOFFSET YOFFSET) WINDOW)
1113 where XOFFSET and YOFFSET are positions in pixels from the top left
1114 corner of WINDOW. (WINDOW may be a window or a frame object.)
1115 This controls the position of the top left of the menu as a whole.
1116 If POSITION is t, it means to use the current mouse position.
1117
1118 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1119 The menu items come from key bindings that have a menu string as well as
1120 a definition; actually, the "definition" in such a key binding looks like
1121 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1122 the keymap as a top-level element.
1123
1124 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1125 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1126
1127 You can also use a list of keymaps as MENU.
1128 Then each keymap makes a separate pane.
1129
1130 When MENU is a keymap or a list of keymaps, the return value is the
1131 list of events corresponding to the user's choice. Note that
1132 `x-popup-menu' does not actually execute the command bound to that
1133 sequence of events.
1134
1135 Alternatively, you can specify a menu of multiple panes
1136 with a list of the form (TITLE PANE1 PANE2...),
1137 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1138 Each ITEM is normally a cons cell (STRING . VALUE);
1139 but a string can appear as an item--that makes a nonselectable line
1140 in the menu.
1141 With this form of menu, the return value is VALUE from the chosen item.
1142
1143 If POSITION is nil, don't display the menu at all, just precalculate the
1144 cached information about equivalent key sequences.
1145
1146 If the user gets rid of the menu without making a valid choice, for
1147 instance by clicking the mouse away from a valid choice or by typing
1148 keyboard input, then this normally results in a quit and
1149 `x-popup-menu' does not return. But if POSITION is a mouse button
1150 event (indicating that the user invoked the menu with the mouse) then
1151 no quit occurs and `x-popup-menu' returns nil. */)
1152 (Lisp_Object position, Lisp_Object menu)
1153 {
1154 Lisp_Object keymap, tem, tem2;
1155 int xpos = 0, ypos = 0;
1156 Lisp_Object title;
1157 const char *error_name = NULL;
1158 Lisp_Object selection = Qnil;
1159 struct frame *f = NULL;
1160 Lisp_Object x, y, window;
1161 int menuflags = 0;
1162 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1163 struct gcpro gcpro1;
1164
1165 if (NILP (position))
1166 /* This is an obsolete call, which wants us to precompute the
1167 keybinding equivalents, but we don't do that any more anyway. */
1168 return Qnil;
1169
1170 {
1171 bool get_current_pos_p = 0;
1172
1173 /* Decode the first argument: find the window and the coordinates. */
1174 if (EQ (position, Qt)
1175 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1176 || EQ (XCAR (position), Qtool_bar))))
1177 {
1178 get_current_pos_p = 1;
1179 }
1180 else
1181 {
1182 tem = Fcar (position);
1183 if (CONSP (tem))
1184 {
1185 window = Fcar (Fcdr (position));
1186 x = XCAR (tem);
1187 y = Fcar (XCDR (tem));
1188 }
1189 else
1190 {
1191 menuflags |= MENU_FOR_CLICK;
1192 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1193 window = Fcar (tem); /* POSN_WINDOW (tem) */
1194 tem2 = Fcar (Fcdr (tem)); /* POSN_POSN (tem) */
1195 /* The MENU_KBD_NAVIGATION field is set when the menu
1196 was invoked by F10, which probably means they have no
1197 mouse. In that case, we let them switch between
1198 top-level menu-bar menus by using C-f/C-b and
1199 horizontal arrow keys, since they cannot click the
1200 mouse to open a different submenu. This flag is only
1201 supported by tty_menu_show. We set it when POSITION
1202 and last_nonmenu_event are different, which means we
1203 constructed POSITION by hand (in popup-menu, see
1204 menu-bar.el) to look like a mouse click on the menu bar
1205 event. */
1206 if (!EQ (POSN_POSN (last_nonmenu_event),
1207 POSN_POSN (position))
1208 && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar))
1209 menuflags |= MENU_KBD_NAVIGATION;
1210 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1211 x = Fcar (tem);
1212 y = Fcdr (tem);
1213 }
1214
1215 /* If a click happens in an external tool bar or a detached
1216 tool bar, x and y is NIL. In that case, use the current
1217 mouse position. This happens for the help button in the
1218 tool bar. Ideally popup-menu should pass NIL to
1219 this function, but it doesn't. */
1220 if (NILP (x) && NILP (y))
1221 get_current_pos_p = 1;
1222 }
1223
1224 if (get_current_pos_p)
1225 {
1226 /* Use the mouse's current position. */
1227 struct frame *new_f = SELECTED_FRAME ();
1228 #ifdef HAVE_X_WINDOWS
1229 /* Can't use mouse_position_hook for X since it returns
1230 coordinates relative to the window the mouse is in,
1231 we need coordinates relative to the edit widget always. */
1232 if (new_f != 0)
1233 {
1234 int cur_x, cur_y;
1235
1236 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1237 /* cur_x/y may be negative, so use make_number. */
1238 x = make_number (cur_x);
1239 y = make_number (cur_y);
1240 }
1241
1242 #else /* not HAVE_X_WINDOWS */
1243 Lisp_Object bar_window;
1244 enum scroll_bar_part part;
1245 Time time;
1246 void (*mouse_position_hook) (struct frame **, int,
1247 Lisp_Object *,
1248 enum scroll_bar_part *,
1249 Lisp_Object *,
1250 Lisp_Object *,
1251 Time *) =
1252 FRAME_TERMINAL (new_f)->mouse_position_hook;
1253
1254 if (mouse_position_hook)
1255 (*mouse_position_hook) (&new_f, 1, &bar_window,
1256 &part, &x, &y, &time);
1257 #endif /* not HAVE_X_WINDOWS */
1258
1259 if (new_f != 0)
1260 XSETFRAME (window, new_f);
1261 else
1262 {
1263 window = selected_window;
1264 XSETFASTINT (x, 0);
1265 XSETFASTINT (y, 0);
1266 }
1267 }
1268
1269 /* Decode where to put the menu. */
1270
1271 if (FRAMEP (window))
1272 {
1273 f = XFRAME (window);
1274 xpos = 0;
1275 ypos = 0;
1276 }
1277 else if (WINDOWP (window))
1278 {
1279 struct window *win = XWINDOW (window);
1280 CHECK_LIVE_WINDOW (window);
1281 f = XFRAME (WINDOW_FRAME (win));
1282
1283 xpos = WINDOW_LEFT_EDGE_X (win);
1284 ypos = WINDOW_TOP_EDGE_Y (win);
1285 }
1286 else
1287 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1288 but I don't want to make one now. */
1289 CHECK_WINDOW (window);
1290
1291 CHECK_RANGED_INTEGER (x,
1292 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1293 ? (EMACS_INT) INT_MIN - xpos
1294 : MOST_NEGATIVE_FIXNUM),
1295 INT_MAX - xpos);
1296 CHECK_RANGED_INTEGER (y,
1297 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1298 ? (EMACS_INT) INT_MIN - ypos
1299 : MOST_NEGATIVE_FIXNUM),
1300 INT_MAX - ypos);
1301 xpos += XINT (x);
1302 ypos += XINT (y);
1303
1304 XSETFRAME (Vmenu_updating_frame, f);
1305 }
1306
1307 /* Now parse the lisp menus. */
1308 record_unwind_protect_void (unuse_menu_items);
1309
1310 title = Qnil;
1311 GCPRO1 (title);
1312
1313 /* Decode the menu items from what was specified. */
1314
1315 keymap = get_keymap (menu, 0, 0);
1316 if (CONSP (keymap))
1317 {
1318 /* We were given a keymap. Extract menu info from the keymap. */
1319 Lisp_Object prompt;
1320
1321 /* Extract the detailed info to make one pane. */
1322 keymap_panes (&menu, 1);
1323
1324 /* Search for a string appearing directly as an element of the keymap.
1325 That string is the title of the menu. */
1326 prompt = Fkeymap_prompt (keymap);
1327 if (!NILP (prompt))
1328 title = prompt;
1329 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1330 else
1331 title = build_string ("Select");
1332 #endif
1333
1334 /* Make that be the pane title of the first pane. */
1335 if (!NILP (prompt) && menu_items_n_panes >= 0)
1336 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1337
1338 menuflags |= MENU_KEYMAPS;
1339 }
1340 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1341 {
1342 /* We were given a list of keymaps. */
1343 EMACS_INT nmaps = XFASTINT (Flength (menu));
1344 Lisp_Object *maps;
1345 ptrdiff_t i;
1346 USE_SAFE_ALLOCA;
1347
1348 SAFE_ALLOCA_LISP (maps, nmaps);
1349 title = Qnil;
1350
1351 /* The first keymap that has a prompt string
1352 supplies the menu title. */
1353 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1354 {
1355 Lisp_Object prompt;
1356
1357 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1358
1359 prompt = Fkeymap_prompt (keymap);
1360 if (NILP (title) && !NILP (prompt))
1361 title = prompt;
1362 }
1363
1364 /* Extract the detailed info to make one pane. */
1365 keymap_panes (maps, nmaps);
1366
1367 /* Make the title be the pane title of the first pane. */
1368 if (!NILP (title) && menu_items_n_panes >= 0)
1369 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1370
1371 menuflags |= MENU_KEYMAPS;
1372
1373 SAFE_FREE ();
1374 }
1375 else
1376 {
1377 /* We were given an old-fashioned menu. */
1378 title = Fcar (menu);
1379 CHECK_STRING (title);
1380
1381 list_of_panes (Fcdr (menu));
1382
1383 menuflags &= ~MENU_KEYMAPS;
1384 }
1385
1386 unbind_to (specpdl_count, Qnil);
1387
1388 #ifdef HAVE_WINDOW_SYSTEM
1389 /* Hide a previous tip, if any. */
1390 if (!FRAME_TERMCAP_P (f))
1391 Fx_hide_tip ();
1392 #endif
1393
1394 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1395 /* If resources from a previous popup menu still exist, does nothing
1396 until the `menu_free_timer' has freed them (see w32fns.c). This
1397 can occur if you press ESC or click outside a menu without selecting
1398 a menu item.
1399 */
1400 if (current_popup_menu && FRAME_W32_P (f))
1401 {
1402 discard_menu_items ();
1403 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1404 UNGCPRO;
1405 return Qnil;
1406 }
1407 #endif
1408
1409 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1410 record_unwind_protect_void (discard_menu_items);
1411 #endif
1412
1413 /* Display them in a menu, but not if F is the initial frame that
1414 doesn't have its hooks set (e.g., in a batch session), because
1415 such a frame cannot display menus. */
1416 if (!FRAME_INITIAL_P (f))
1417 selection = FRAME_TERMINAL (f)->menu_show_hook (f, xpos, ypos, menuflags,
1418 title, &error_name);
1419
1420 #ifdef HAVE_NS
1421 unbind_to (specpdl_count, Qnil);
1422 #else
1423 discard_menu_items ();
1424 #endif
1425
1426 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1427 if (FRAME_W32_P (f))
1428 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1429 #endif
1430
1431 UNGCPRO;
1432
1433 if (error_name) error ("%s", error_name);
1434 return selection;
1435 }
1436
1437 /* If F's terminal is not capable of displaying a popup dialog,
1438 emulate it with a menu. */
1439
1440 static Lisp_Object
1441 emulate_dialog_with_menu (struct frame *f, Lisp_Object contents)
1442 {
1443 Lisp_Object x, y, frame, newpos, prompt = Fcar (contents);
1444 int x_coord, y_coord;
1445
1446 if (FRAME_WINDOW_P (f))
1447 {
1448 x_coord = FRAME_PIXEL_WIDTH (f);
1449 y_coord = FRAME_PIXEL_HEIGHT (f);
1450 }
1451 else
1452 {
1453 x_coord = FRAME_COLS (f);
1454 /* Center the title at frame middle. (TTY menus have
1455 their upper-left corner at the given position.) */
1456 if (STRINGP (prompt))
1457 x_coord -= SCHARS (prompt);
1458 y_coord = FRAME_LINES (f);
1459 }
1460
1461 XSETFRAME (frame, f);
1462 XSETINT (x, x_coord / 2);
1463 XSETINT (y, y_coord / 2);
1464 newpos = list2 (list2 (x, y), frame);
1465
1466 return Fx_popup_menu (newpos, list2 (prompt, contents));
1467 }
1468
1469 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
1470 doc: /* Pop up a dialog box and return user's selection.
1471 POSITION specifies which frame to use.
1472 This is normally a mouse button event or a window or frame.
1473 If POSITION is t, it means to use the frame the mouse is on.
1474 The dialog box appears in the middle of the specified frame.
1475
1476 CONTENTS specifies the alternatives to display in the dialog box.
1477 It is a list of the form (DIALOG ITEM1 ITEM2...).
1478 Each ITEM is a cons cell (STRING . VALUE).
1479 The return value is VALUE from the chosen item.
1480
1481 An ITEM may also be just a string--that makes a nonselectable item.
1482 An ITEM may also be nil--that means to put all preceding items
1483 on the left of the dialog box and all following items on the right.
1484 \(By default, approximately half appear on each side.)
1485
1486 If HEADER is non-nil, the frame title for the box is "Information",
1487 otherwise it is "Question".
1488
1489 If the user gets rid of the dialog box without making a valid choice,
1490 for instance using the window manager, then this produces a quit and
1491 `x-popup-dialog' does not return. */)
1492 (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
1493 {
1494 struct frame *f = NULL;
1495 Lisp_Object window;
1496
1497 /* Decode the first argument: find the window or frame to use. */
1498 if (EQ (position, Qt)
1499 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1500 || EQ (XCAR (position), Qtool_bar))))
1501 window = selected_window;
1502 else if (CONSP (position))
1503 {
1504 Lisp_Object tem = XCAR (position);
1505 if (CONSP (tem))
1506 window = Fcar (XCDR (position));
1507 else
1508 {
1509 tem = Fcar (XCDR (position)); /* EVENT_START (position) */
1510 window = Fcar (tem); /* POSN_WINDOW (tem) */
1511 }
1512 }
1513 else if (WINDOWP (position) || FRAMEP (position))
1514 window = position;
1515 else
1516 window = Qnil;
1517
1518 /* Decode where to put the menu. */
1519
1520 if (FRAMEP (window))
1521 f = XFRAME (window);
1522 else if (WINDOWP (window))
1523 {
1524 CHECK_LIVE_WINDOW (window);
1525 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1526 }
1527 else
1528 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1529 but I don't want to make one now. */
1530 CHECK_WINDOW (window);
1531
1532 /* Force a redisplay before showing the dialog. If a frame is created
1533 just before showing the dialog, its contents may not have been fully
1534 drawn, as this depends on timing of events from the X server. Redisplay
1535 is not done when a dialog is shown. If redisplay could be done in the
1536 X event loop (i.e. the X event loop does not run in a signal handler)
1537 this would not be needed.
1538
1539 Do this before creating the widget value that points to Lisp
1540 string contents, because Fredisplay may GC and relocate them. */
1541 Fredisplay (Qt);
1542
1543 /* Display the popup dialog by a terminal-specific hook ... */
1544 if (FRAME_TERMINAL (f)->popup_dialog_hook)
1545 {
1546 Lisp_Object selection
1547 = FRAME_TERMINAL (f)->popup_dialog_hook (f, header, contents);
1548 #ifdef HAVE_NTGUI
1549 /* NTGUI supports only simple dialogs with Yes/No choices. For
1550 other dialogs, it returns the symbol 'unsupported--w32-dialog',
1551 as a signal for the caller to fall back to the emulation code. */
1552 if (!EQ (selection, Qunsupported__w32_dialog))
1553 #endif
1554 return selection;
1555 }
1556 /* ... or emulate it with a menu. */
1557 return emulate_dialog_with_menu (f, contents);
1558 }
1559
1560 void
1561 syms_of_menu (void)
1562 {
1563 staticpro (&menu_items);
1564 menu_items = Qnil;
1565 menu_items_inuse = Qnil;
1566
1567 defsubr (&Sx_popup_menu);
1568 defsubr (&Sx_popup_dialog);
1569 defsubr (&Smenu_bar_menu_at_x_y);
1570 }