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