* textmodes/artist.el (artist-mode): Fix typo in docstring. (Bug#5807)
[bpt/emacs.git] / src / menu.c
CommitLineData
279a1d4b
CY
1/* Platform-independent code for terminal communications.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1999, 2000, 2001, 2002, 2003,
114f9c96 3 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
279a1d4b
CY
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20#include <config.h>
21#include <stdio.h>
d7306fe6 22#include <setjmp.h>
279a1d4b
CY
23
24#include "lisp.h"
25#include "keyboard.h"
26#include "keymap.h"
27#include "frame.h"
ef7417fd 28#include "window.h"
279a1d4b
CY
29#include "termhooks.h"
30#include "blockinput.h"
31#include "dispextern.h"
32
33#ifdef USE_X_TOOLKIT
34#include "../lwlib/lwlib.h"
35#endif
36
a4240420
AS
37#ifdef HAVE_X_WINDOWS
38#include "xterm.h"
39#endif
40
edfda783
AR
41#ifdef HAVE_NS
42#include "nsterm.h"
43#endif
44
279a1d4b
CY
45#ifdef USE_GTK
46#include "gtkutil.h"
47#endif
48
49#ifdef HAVE_NTGUI
a8495745 50#include "w32term.h"
279a1d4b 51
279a1d4b 52extern AppendMenuW_Proc unicode_append_menu;
04e452cb 53extern HMENU current_popup_menu;
279a1d4b
CY
54
55#endif /* HAVE_NTGUI */
56
e7c9048f 57#include "menu.h"
279a1d4b
CY
58
59/* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
60#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
61#define HAVE_BOXES 1
62#endif
63
64extern Lisp_Object QCtoggle, QCradio;
65
66Lisp_Object menu_items;
67
68/* If non-nil, means that the global vars defined here are already in use.
69 Used to detect cases where we try to re-enter this non-reentrant code. */
70Lisp_Object menu_items_inuse;
71
72/* Number of slots currently allocated in menu_items. */
73int menu_items_allocated;
74
75/* This is the index in menu_items of the first empty slot. */
76int menu_items_used;
77
78/* The number of panes currently recorded in menu_items,
79 excluding those within submenus. */
80int menu_items_n_panes;
81
82/* Current depth within submenus. */
83static int menu_items_submenu_depth;
84
85void
86init_menu_items ()
87{
88 if (!NILP (menu_items_inuse))
89 error ("Trying to use a menu from within a menu-entry");
90
91 if (NILP (menu_items))
92 {
93 menu_items_allocated = 60;
94 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
95 }
96
97 menu_items_inuse = Qt;
98 menu_items_used = 0;
99 menu_items_n_panes = 0;
100 menu_items_submenu_depth = 0;
101}
102
103/* Call at the end of generating the data in menu_items. */
104
105void
106finish_menu_items ()
107{
108}
109
110Lisp_Object
111unuse_menu_items (dummy)
112 Lisp_Object dummy;
113{
114 return menu_items_inuse = Qnil;
115}
116
117/* Call when finished using the data for the current menu
118 in menu_items. */
119
120void
121discard_menu_items ()
122{
123 /* Free the structure if it is especially large.
124 Otherwise, hold on to it, to save time. */
125 if (menu_items_allocated > 200)
126 {
127 menu_items = Qnil;
128 menu_items_allocated = 0;
129 }
130 xassert (NILP (menu_items_inuse));
131}
132
ef7417fd
SM
133static Lisp_Object
134cleanup_popup_menu (Lisp_Object arg)
135{
136 discard_menu_items ();
137 return Qnil;
138}
139
279a1d4b
CY
140/* This undoes save_menu_items, and it is called by the specpdl unwind
141 mechanism. */
142
143static Lisp_Object
144restore_menu_items (saved)
145 Lisp_Object saved;
146{
147 menu_items = XCAR (saved);
148 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
149 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
150 saved = XCDR (saved);
151 menu_items_used = XINT (XCAR (saved));
152 saved = XCDR (saved);
153 menu_items_n_panes = XINT (XCAR (saved));
154 saved = XCDR (saved);
155 menu_items_submenu_depth = XINT (XCAR (saved));
156 return Qnil;
157}
158
159/* Push the whole state of menu_items processing onto the specpdl.
160 It will be restored when the specpdl is unwound. */
161
162void
163save_menu_items ()
164{
165 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
166 make_number (menu_items_used),
167 make_number (menu_items_n_panes),
168 make_number (menu_items_submenu_depth));
169 record_unwind_protect (restore_menu_items, saved);
170 menu_items_inuse = Qnil;
171 menu_items = Qnil;
172}
173
174\f
175/* Make the menu_items vector twice as large. */
176
177static void
178grow_menu_items ()
179{
180 menu_items_allocated *= 2;
181 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
182}
183
184/* Begin a submenu. */
185
186static void
187push_submenu_start ()
188{
189 if (menu_items_used + 1 > menu_items_allocated)
190 grow_menu_items ();
191
192 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
193 menu_items_submenu_depth++;
194}
195
196/* End a submenu. */
197
198static void
199push_submenu_end ()
200{
201 if (menu_items_used + 1 > menu_items_allocated)
202 grow_menu_items ();
203
204 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
205 menu_items_submenu_depth--;
206}
207
208/* Indicate boundary between left and right. */
209
210static void
211push_left_right_boundary ()
212{
213 if (menu_items_used + 1 > menu_items_allocated)
214 grow_menu_items ();
215
216 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
217}
218
219/* Start a new menu pane in menu_items.
220 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
221
593c843c 222static void
279a1d4b
CY
223push_menu_pane (name, prefix_vec)
224 Lisp_Object name, prefix_vec;
225{
226 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
227 grow_menu_items ();
228
229 if (menu_items_submenu_depth == 0)
230 menu_items_n_panes++;
231 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
232 XVECTOR (menu_items)->contents[menu_items_used++] = name;
233 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
234}
235
236/* Push one menu item into the current pane. NAME is the string to
237 display. ENABLE if non-nil means this item can be selected. KEY
238 is the key generated by choosing this item, or nil if this item
239 doesn't really have a definition. DEF is the definition of this
240 item. EQUIV is the textual description of the keyboard equivalent
241 for this item (or nil if none). TYPE is the type of this menu
242 item, one of nil, `toggle' or `radio'. */
243
593c843c 244static void
279a1d4b
CY
245push_menu_item (name, enable, key, def, equiv, type, selected, help)
246 Lisp_Object name, enable, key, def, equiv, type, selected, help;
247{
248 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
249 grow_menu_items ();
250
b7c7a4d1
SM
251 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
252 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
253 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
254 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
255 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
256 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
257 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
258 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
259
260 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
279a1d4b
CY
261}
262
263/* Args passed between single_keymap_panes and single_menu_item. */
264struct skp
265 {
266 Lisp_Object pending_maps;
ef7417fd 267 int maxdepth;
279a1d4b
CY
268 int notbuttons;
269 };
270
271static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
272 void *));
273
274/* This is a recursive subroutine of keymap_panes.
275 It handles one keymap, KEYMAP.
276 The other arguments are passed along
277 or point to local variables of the previous function.
279a1d4b
CY
278
279 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
280
593c843c 281static void
ef7417fd
SM
282single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
283 Lisp_Object prefix, int maxdepth)
279a1d4b
CY
284{
285 struct skp skp;
286 struct gcpro gcpro1;
287
288 skp.pending_maps = Qnil;
289 skp.maxdepth = maxdepth;
279a1d4b
CY
290 skp.notbuttons = 0;
291
292 if (maxdepth <= 0)
293 return;
294
295 push_menu_pane (pane_name, prefix);
296
297#ifndef HAVE_BOXES
298 /* Remember index for first item in this pane so we can go back and
299 add a prefix when (if) we see the first button. After that, notbuttons
300 is set to 0, to mark that we have seen a button and all non button
301 items need a prefix. */
302 skp.notbuttons = menu_items_used;
303#endif
304
305 GCPRO1 (skp.pending_maps);
306 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
307 UNGCPRO;
308
309 /* Process now any submenus which want to be panes at this level. */
310 while (CONSP (skp.pending_maps))
311 {
312 Lisp_Object elt, eltcdr, string;
313 elt = XCAR (skp.pending_maps);
314 eltcdr = XCDR (elt);
315 string = XCAR (eltcdr);
316 /* We no longer discard the @ from the beginning of the string here.
317 Instead, we do this in *menu_show. */
ef7417fd 318 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
279a1d4b
CY
319 skp.pending_maps = XCDR (skp.pending_maps);
320 }
321}
322
323/* This is a subroutine of single_keymap_panes that handles one
324 keymap entry.
325 KEY is a key in a keymap and ITEM is its binding.
326 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
327 separate panes.
279a1d4b
CY
328 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
329
330static void
331single_menu_item (key, item, dummy, skp_v)
332 Lisp_Object key, item, dummy;
333 void *skp_v;
334{
335 Lisp_Object map, item_string, enabled;
336 struct gcpro gcpro1, gcpro2;
337 int res;
338 struct skp *skp = skp_v;
339
340 /* Parse the menu item and leave the result in item_properties. */
341 GCPRO2 (key, item);
ef7417fd 342 res = parse_menu_item (item, 0);
279a1d4b
CY
343 UNGCPRO;
344 if (!res)
345 return; /* Not a menu item. */
346
347 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
348
279a1d4b
CY
349 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
350 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
351
352 if (!NILP (map) && SREF (item_string, 0) == '@')
353 {
354 if (!NILP (enabled))
355 /* An enabled separate pane. Remember this to handle it later. */
356 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
357 skp->pending_maps);
358 return;
359 }
360
dda86321 361#if defined(HAVE_X_WINDOWS) || defined(MSDOS)
279a1d4b
CY
362#ifndef HAVE_BOXES
363 /* Simulate radio buttons and toggle boxes by putting a prefix in
364 front of them. */
365 {
366 Lisp_Object prefix = Qnil;
367 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
368 if (!NILP (type))
369 {
370 Lisp_Object selected
371 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
372
373 if (skp->notbuttons)
374 /* The first button. Line up previous items in this menu. */
375 {
376 int index = skp->notbuttons; /* Index for first item this menu. */
377 int submenu = 0;
378 Lisp_Object tem;
379 while (index < menu_items_used)
380 {
381 tem
382 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
383 if (NILP (tem))
384 {
385 index++;
386 submenu++; /* Skip sub menu. */
387 }
388 else if (EQ (tem, Qlambda))
389 {
390 index++;
391 submenu--; /* End sub menu. */
392 }
393 else if (EQ (tem, Qt))
394 index += 3; /* Skip new pane marker. */
395 else if (EQ (tem, Qquote))
396 index++; /* Skip a left, right divider. */
397 else
398 {
399 if (!submenu && SREF (tem, 0) != '\0'
400 && SREF (tem, 0) != '-')
401 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
402 = concat2 (build_string (" "), tem);
403 index += MENU_ITEMS_ITEM_LENGTH;
404 }
405 }
406 skp->notbuttons = 0;
407 }
408
409 /* Calculate prefix, if any, for this item. */
410 if (EQ (type, QCtoggle))
411 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
412 else if (EQ (type, QCradio))
413 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
414 }
415 /* Not a button. If we have earlier buttons, then we need a prefix. */
416 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
417 && SREF (item_string, 0) != '-')
418 prefix = build_string (" ");
419
420 if (!NILP (prefix))
421 item_string = concat2 (prefix, item_string);
422 }
423#endif /* not HAVE_BOXES */
424
425#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
426 if (!NILP (map))
427 /* Indicate visually that this is a submenu. */
428 item_string = concat2 (item_string, build_string (" >"));
429#endif
430
dda86321 431#endif /* HAVE_X_WINDOWS || MSDOS */
279a1d4b
CY
432
433 push_menu_item (item_string, enabled, key,
434 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
435 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
436 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
437 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
438 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
439
edfda783 440#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
279a1d4b
CY
441 /* Display a submenu using the toolkit. */
442 if (! (NILP (map) || NILP (enabled)))
443 {
444 push_submenu_start ();
ef7417fd 445 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
279a1d4b
CY
446 push_submenu_end ();
447 }
448#endif
449}
450
451/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
ef7417fd 452 and generate menu panes for them in menu_items. */
279a1d4b 453
ef7417fd
SM
454static void
455keymap_panes (keymaps, nmaps)
279a1d4b
CY
456 Lisp_Object *keymaps;
457 int nmaps;
279a1d4b
CY
458{
459 int mapno;
460
461 init_menu_items ();
462
463 /* Loop over the given keymaps, making a pane for each map.
464 But don't make a pane that is empty--ignore that map instead.
465 P is the number of panes we have made so far. */
466 for (mapno = 0; mapno < nmaps; mapno++)
467 single_keymap_panes (keymaps[mapno],
ef7417fd 468 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
279a1d4b
CY
469
470 finish_menu_items ();
471}
472
473
474/* Push the items in a single pane defined by the alist PANE. */
475static void
476list_of_items (pane)
477 Lisp_Object pane;
478{
479 Lisp_Object tail, item, item1;
480
481 for (tail = pane; CONSP (tail); tail = XCDR (tail))
482 {
483 item = XCAR (tail);
484 if (STRINGP (item))
485 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
486 Qnil, Qnil, Qnil, Qnil);
487 else if (CONSP (item))
488 {
489 item1 = XCAR (item);
490 CHECK_STRING (item1);
491 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
492 Qt, Qnil, Qnil, Qnil, Qnil);
493 }
494 else
495 push_left_right_boundary ();
496
497 }
498}
499
500/* Push all the panes and items of a menu described by the
501 alist-of-alists MENU.
502 This handles old-fashioned calls to x-popup-menu. */
503void
504list_of_panes (menu)
505 Lisp_Object menu;
506{
507 Lisp_Object tail;
508
509 init_menu_items ();
510
511 for (tail = menu; CONSP (tail); tail = XCDR (tail))
512 {
513 Lisp_Object elt, pane_name, pane_data;
514 elt = XCAR (tail);
515 pane_name = Fcar (elt);
516 CHECK_STRING (pane_name);
517 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
518 pane_data = Fcdr (elt);
519 CHECK_CONS (pane_data);
520 list_of_items (pane_data);
521 }
522
523 finish_menu_items ();
524}
525
526/* Set up data in menu_items for a menu bar item
527 whose event type is ITEM_KEY (with string ITEM_NAME)
528 and whose contents come from the list of keymaps MAPS. */
529int
530parse_single_submenu (item_key, item_name, maps)
531 Lisp_Object item_key, item_name, maps;
532{
533 Lisp_Object length;
534 int len;
535 Lisp_Object *mapvec;
536 int i;
537 int top_level_items = 0;
538
539 length = Flength (maps);
540 len = XINT (length);
541
542 /* Convert the list MAPS into a vector MAPVEC. */
543 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
544 for (i = 0; i < len; i++)
545 {
546 mapvec[i] = Fcar (maps);
547 maps = Fcdr (maps);
548 }
549
550 /* Loop over the given keymaps, making a pane for each map.
551 But don't make a pane that is empty--ignore that map instead. */
552 for (i = 0; i < len; i++)
553 {
554 if (!KEYMAPP (mapvec[i]))
555 {
556 /* Here we have a command at top level in the menu bar
557 as opposed to a submenu. */
558 top_level_items = 1;
559 push_menu_pane (Qnil, Qnil);
560 push_menu_item (item_name, Qt, item_key, mapvec[i],
561 Qnil, Qnil, Qnil, Qnil);
562 }
563 else
564 {
565 Lisp_Object prompt;
566 prompt = Fkeymap_prompt (mapvec[i]);
567 single_keymap_panes (mapvec[i],
568 !NILP (prompt) ? prompt : item_name,
ef7417fd 569 item_key, 10);
279a1d4b
CY
570 }
571 }
572
573 return top_level_items;
574}
575
576\f
edfda783 577#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
279a1d4b
CY
578
579/* Allocate a widget_value, blocking input. */
580
581widget_value *
582xmalloc_widget_value ()
583{
584 widget_value *value;
585
586 BLOCK_INPUT;
587 value = malloc_widget_value ();
588 UNBLOCK_INPUT;
589
590 return value;
591}
592
593/* This recursively calls free_widget_value on the tree of widgets.
594 It must free all data that was malloc'ed for these widget_values.
595 In Emacs, many slots are pointers into the data of Lisp_Strings, and
596 must be left alone. */
597
598void
599free_menubar_widget_value_tree (wv)
600 widget_value *wv;
601{
602 if (! wv) return;
603
604 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
605
606 if (wv->contents && (wv->contents != (widget_value*)1))
607 {
608 free_menubar_widget_value_tree (wv->contents);
609 wv->contents = (widget_value *) 0xDEADBEEF;
610 }
611 if (wv->next)
612 {
613 free_menubar_widget_value_tree (wv->next);
614 wv->next = (widget_value *) 0xDEADBEEF;
615 }
616 BLOCK_INPUT;
617 free_widget_value (wv);
618 UNBLOCK_INPUT;
619}
620
621/* Create a tree of widget_value objects
622 representing the panes and items
623 in menu_items starting at index START, up to index END. */
624
625widget_value *
626digest_single_submenu (start, end, top_level_items)
627 int start, end, 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 int panes_seen = 0;
634
635 submenu_stack
636 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
637 wv = xmalloc_widget_value ();
638 wv->name = "menu";
639 wv->value = 0;
640 wv->enabled = 1;
641 wv->button_type = BUTTON_TYPE_NONE;
642 wv->help = Qnil;
643 first_wv = wv;
644 save_wv = 0;
645 prev_wv = 0;
646
647 /* Loop over all panes and items made by the preceding call
648 to parse_single_submenu and construct a tree of widget_value objects.
649 Ignore the panes and items used by previous calls to
650 digest_single_submenu, even though those are also in menu_items. */
651 i = start;
652 while (i < end)
653 {
654 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
655 {
656 submenu_stack[submenu_depth++] = save_wv;
657 save_wv = prev_wv;
658 prev_wv = 0;
659 i++;
660 }
661 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
662 {
663 prev_wv = save_wv;
664 save_wv = submenu_stack[--submenu_depth];
665 i++;
666 }
667 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
668 && submenu_depth != 0)
669 i += MENU_ITEMS_PANE_LENGTH;
670 /* Ignore a nil in the item list.
671 It's meaningful only for dialog boxes. */
672 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
673 i += 1;
674 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
675 {
676 /* Create a new pane. */
677 Lisp_Object pane_name, prefix;
678 char *pane_string;
679
680 panes_seen++;
681
682 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
683 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
684
685#ifdef HAVE_NTGUI
686 if (STRINGP (pane_name))
687 {
688 if (unicode_append_menu)
689 /* Encode as UTF-8 for now. */
690 pane_name = ENCODE_UTF_8 (pane_name);
691 else if (STRING_MULTIBYTE (pane_name))
692 pane_name = ENCODE_SYSTEM (pane_name);
693
694 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
695 }
696#elif !defined (HAVE_MULTILINGUAL_MENU)
697 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
698 {
699 pane_name = ENCODE_MENU_STRING (pane_name);
700 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
701 }
702#endif
703
704 pane_string = (NILP (pane_name)
705 ? "" : (char *) SDATA (pane_name));
706 /* If there is just one top-level pane, put all its items directly
707 under the top-level menu. */
708 if (menu_items_n_panes == 1)
709 pane_string = "";
710
711 /* If the pane has a meaningful name,
712 make the pane a top-level menu item
713 with its items as a submenu beneath it. */
714 if (strcmp (pane_string, ""))
715 {
716 wv = xmalloc_widget_value ();
717 if (save_wv)
718 save_wv->next = wv;
719 else
720 first_wv->contents = wv;
721 wv->lname = pane_name;
722 /* Set value to 1 so update_submenu_strings can handle '@' */
723 wv->value = (char *)1;
724 wv->enabled = 1;
725 wv->button_type = BUTTON_TYPE_NONE;
726 wv->help = Qnil;
727 save_wv = wv;
728 }
729 else
730 save_wv = first_wv;
731
732 prev_wv = 0;
733 i += MENU_ITEMS_PANE_LENGTH;
734 }
735 else
736 {
737 /* Create a new item within current pane. */
738 Lisp_Object item_name, enable, descrip, def, type, selected;
739 Lisp_Object help;
740
741 /* All items should be contained in panes. */
742 if (panes_seen == 0)
743 abort ();
744
745 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
746 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
747 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
748 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
749 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
750 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
751 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
752
753#ifdef HAVE_NTGUI
754 if (STRINGP (item_name))
755 {
756 if (unicode_append_menu)
757 item_name = ENCODE_UTF_8 (item_name);
758 else if (STRING_MULTIBYTE (item_name))
759 item_name = ENCODE_SYSTEM (item_name);
760
761 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
762 }
763
764 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
765 {
766 descrip = ENCODE_SYSTEM (descrip);
767 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
768 }
769#elif !defined (HAVE_MULTILINGUAL_MENU)
770 if (STRING_MULTIBYTE (item_name))
771 {
772 item_name = ENCODE_MENU_STRING (item_name);
773 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
774 }
775
776 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
777 {
778 descrip = ENCODE_MENU_STRING (descrip);
779 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
780 }
781#endif
782
783 wv = xmalloc_widget_value ();
784 if (prev_wv)
785 prev_wv->next = wv;
786 else
787 save_wv->contents = wv;
788
789 wv->lname = item_name;
790 if (!NILP (descrip))
791 wv->lkey = descrip;
792 wv->value = 0;
793 /* The EMACS_INT cast avoids a warning. There's no problem
794 as long as pointers have enough bits to hold small integers. */
795 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
796 wv->enabled = !NILP (enable);
797
798 if (NILP (type))
799 wv->button_type = BUTTON_TYPE_NONE;
800 else if (EQ (type, QCradio))
801 wv->button_type = BUTTON_TYPE_RADIO;
802 else if (EQ (type, QCtoggle))
803 wv->button_type = BUTTON_TYPE_TOGGLE;
804 else
805 abort ();
806
807 wv->selected = !NILP (selected);
808 if (! STRINGP (help))
809 help = Qnil;
810
811 wv->help = help;
812
813 prev_wv = wv;
814
815 i += MENU_ITEMS_ITEM_LENGTH;
816 }
817 }
818
819 /* If we have just one "menu item"
820 that was originally a button, return it by itself. */
821 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
822 {
823 wv = first_wv->contents;
824 free_widget_value (first_wv);
825 return wv;
826 }
827
828 return first_wv;
829}
830
831/* Walk through the widget_value tree starting at FIRST_WV and update
832 the char * pointers from the corresponding lisp values.
833 We do this after building the whole tree, since GC may happen while the
834 tree is constructed, and small strings are relocated. So we must wait
835 until no GC can happen before storing pointers into lisp values. */
836void
837update_submenu_strings (first_wv)
838 widget_value *first_wv;
839{
840 widget_value *wv;
841
842 for (wv = first_wv; wv; wv = wv->next)
843 {
844 if (STRINGP (wv->lname))
845 {
846 wv->name = (char *) SDATA (wv->lname);
847
848 /* Ignore the @ that means "separate pane".
849 This is a kludge, but this isn't worth more time. */
850 if (wv->value == (char *)1)
851 {
852 if (wv->name[0] == '@')
853 wv->name++;
854 wv->value = 0;
855 }
856 }
857
858 if (STRINGP (wv->lkey))
859 wv->key = (char *) SDATA (wv->lkey);
860
861 if (wv->contents)
862 update_submenu_strings (wv->contents);
863 }
864}
865
866/* Find the menu selection and store it in the keyboard buffer.
867 F is the frame the menu is on.
868 MENU_BAR_ITEMS_USED is the length of VECTOR.
869 VECTOR is an array of menu events for the whole menu. */
870
871void
872find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
873 FRAME_PTR f;
facfbbbd 874 int menu_bar_items_used;
279a1d4b
CY
875 Lisp_Object vector;
876 void *client_data;
877{
878 Lisp_Object prefix, entry;
879 Lisp_Object *subprefix_stack;
880 int submenu_depth = 0;
881 int i;
882
883 entry = Qnil;
884 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
885 prefix = Qnil;
886 i = 0;
887
888 while (i < menu_bar_items_used)
889 {
890 if (EQ (XVECTOR (vector)->contents[i], Qnil))
891 {
892 subprefix_stack[submenu_depth++] = prefix;
893 prefix = entry;
894 i++;
895 }
896 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
897 {
898 prefix = subprefix_stack[--submenu_depth];
899 i++;
900 }
901 else if (EQ (XVECTOR (vector)->contents[i], Qt))
902 {
903 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
904 i += MENU_ITEMS_PANE_LENGTH;
905 }
906 else
907 {
908 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
909 /* The EMACS_INT cast avoids a warning. There's no problem
910 as long as pointers have enough bits to hold small integers. */
911 if ((int) (EMACS_INT) client_data == i)
912 {
913 int j;
914 struct input_event buf;
915 Lisp_Object frame;
916 EVENT_INIT (buf);
917
918 XSETFRAME (frame, f);
919 buf.kind = MENU_BAR_EVENT;
920 buf.frame_or_window = frame;
921 buf.arg = frame;
922 kbd_buffer_store_event (&buf);
923
924 for (j = 0; j < submenu_depth; j++)
925 if (!NILP (subprefix_stack[j]))
926 {
927 buf.kind = MENU_BAR_EVENT;
928 buf.frame_or_window = frame;
929 buf.arg = subprefix_stack[j];
930 kbd_buffer_store_event (&buf);
931 }
932
933 if (!NILP (prefix))
934 {
935 buf.kind = MENU_BAR_EVENT;
936 buf.frame_or_window = frame;
937 buf.arg = prefix;
938 kbd_buffer_store_event (&buf);
939 }
940
941 buf.kind = MENU_BAR_EVENT;
942 buf.frame_or_window = frame;
943 buf.arg = entry;
944 kbd_buffer_store_event (&buf);
945
946 return;
947 }
948 i += MENU_ITEMS_ITEM_LENGTH;
949 }
950 }
951}
952
edfda783
AR
953#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
954
955#ifdef HAVE_NS
956/* As above, but return the menu selection instead of storing in kb buffer.
957 If keymaps==1, return full prefixes to selection. */
958Lisp_Object
959find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
960{
961 Lisp_Object prefix, entry;
962 int i;
963 Lisp_Object *subprefix_stack;
964 int submenu_depth = 0;
965
966 prefix = entry = Qnil;
967 i = 0;
968 subprefix_stack =
969 (Lisp_Object *)alloca(menu_items_used * sizeof (Lisp_Object));
970
971 while (i < menu_items_used)
972 {
973 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
974 {
975 subprefix_stack[submenu_depth++] = prefix;
976 prefix = entry;
977 i++;
978 }
979 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
980 {
981 prefix = subprefix_stack[--submenu_depth];
982 i++;
983 }
984 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
985 {
986 prefix
987 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
988 i += MENU_ITEMS_PANE_LENGTH;
989 }
990 /* Ignore a nil in the item list.
991 It's meaningful only for dialog boxes. */
992 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
993 i += 1;
994 else
995 {
996 entry
997 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
31c2d412 998 if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
edfda783
AR
999 {
1000 if (keymaps != 0)
1001 {
1002 int j;
1003
1004 entry = Fcons (entry, Qnil);
1005 if (!NILP (prefix))
1006 entry = Fcons (prefix, entry);
1007 for (j = submenu_depth - 1; j >= 0; j--)
1008 if (!NILP (subprefix_stack[j]))
1009 entry = Fcons (subprefix_stack[j], entry);
1010 }
1011 return entry;
1012 }
1013 i += MENU_ITEMS_ITEM_LENGTH;
1014 }
1015 }
facfbbbd 1016 return Qnil;
edfda783 1017}
31c2d412 1018#endif /* HAVE_NS */
279a1d4b 1019
ef7417fd
SM
1020DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1021 doc: /* Pop up a deck-of-cards menu and return user's selection.
1022POSITION is a position specification. This is either a mouse button event
1023or a list ((XOFFSET YOFFSET) WINDOW)
1024where XOFFSET and YOFFSET are positions in pixels from the top left
1025corner of WINDOW. (WINDOW may be a window or a frame object.)
1026This controls the position of the top left of the menu as a whole.
1027If POSITION is t, it means to use the current mouse position.
1028
1029MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1030The menu items come from key bindings that have a menu string as well as
1031a definition; actually, the "definition" in such a key binding looks like
1032\(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1033the keymap as a top-level element.
1034
1035If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1036Otherwise, REAL-DEFINITION should be a valid key binding definition.
1037
1038You can also use a list of keymaps as MENU.
1039 Then each keymap makes a separate pane.
1040
1041When MENU is a keymap or a list of keymaps, the return value is the
1042list of events corresponding to the user's choice. Note that
1043`x-popup-menu' does not actually execute the command bound to that
1044sequence of events.
1045
1046Alternatively, you can specify a menu of multiple panes
1047 with a list of the form (TITLE PANE1 PANE2...),
1048where each pane is a list of form (TITLE ITEM1 ITEM2...).
1049Each ITEM is normally a cons cell (STRING . VALUE);
1050but a string can appear as an item--that makes a nonselectable line
1051in the menu.
1052With this form of menu, the return value is VALUE from the chosen item.
1053
1054If POSITION is nil, don't display the menu at all, just precalculate the
1055cached information about equivalent key sequences.
1056
1057If the user gets rid of the menu without making a valid choice, for
1058instance by clicking the mouse away from a valid choice or by typing
1059keyboard input, then this normally results in a quit and
1060`x-popup-menu' does not return. But if POSITION is a mouse button
1061event (indicating that the user invoked the menu with the mouse) then
1062no quit occurs and `x-popup-menu' returns nil. */)
1063 (position, menu)
1064 Lisp_Object position, menu;
1065{
1066 Lisp_Object keymap, tem;
1067 int xpos = 0, ypos = 0;
1068 Lisp_Object title;
1069 char *error_name = NULL;
1070 Lisp_Object selection = Qnil;
1071 FRAME_PTR f = NULL;
1072 Lisp_Object x, y, window;
1073 int keymaps = 0;
1074 int for_click = 0;
1075 int specpdl_count = SPECPDL_INDEX ();
1076 Lisp_Object timestamp = Qnil;
1077 struct gcpro gcpro1;
ef7417fd 1078
ef7417fd
SM
1079 if (NILP (position))
1080 /* This is an obsolete call, which wants us to precompute the
1081 keybinding equivalents, but we don't do that any more anyway. */
1082 return Qnil;
1083
1084#ifdef HAVE_MENUS
1085 {
1086 int get_current_pos_p = 0;
1087 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1088
1089 /* Decode the first argument: find the window and the coordinates. */
1090 if (EQ (position, Qt)
1091 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1092 || EQ (XCAR (position), Qtool_bar))))
1093 {
1094 get_current_pos_p = 1;
1095 }
1096 else
1097 {
1098 tem = Fcar (position);
1099 if (CONSP (tem))
1100 {
1101 window = Fcar (Fcdr (position));
1102 x = XCAR (tem);
1103 y = Fcar (XCDR (tem));
1104 }
1105 else
1106 {
1107 for_click = 1;
1108 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1109 window = Fcar (tem); /* POSN_WINDOW (tem) */
1110 tem = Fcdr (Fcdr (tem));
1111 x = Fcar (Fcar (tem));
1112 y = Fcdr (Fcar (tem));
1113 timestamp = Fcar (Fcdr (tem));
1114 }
1115
1116 /* If a click happens in an external tool bar or a detached
1117 tool bar, x and y is NIL. In that case, use the current
1118 mouse position. This happens for the help button in the
1119 tool bar. Ideally popup-menu should pass NIL to
1120 this function, but it doesn't. */
1121 if (NILP (x) && NILP (y))
1122 get_current_pos_p = 1;
1123 }
1124
1125 if (get_current_pos_p)
1126 {
1127 /* Use the mouse's current position. */
1128 FRAME_PTR new_f = SELECTED_FRAME ();
1129#ifdef HAVE_X_WINDOWS
1130 /* Can't use mouse_position_hook for X since it returns
1131 coordinates relative to the window the mouse is in,
1132 we need coordinates relative to the edit widget always. */
1133 if (new_f != 0)
1134 {
1135 int cur_x, cur_y;
1136
1137 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1138 /* cur_x/y may be negative, so use make_number. */
1139 x = make_number (cur_x);
1140 y = make_number (cur_y);
1141 }
1142
1143#else /* not HAVE_X_WINDOWS */
1144 Lisp_Object bar_window;
1145 enum scroll_bar_part part;
1146 unsigned long time;
1147 void (*mouse_position_hook) P_ ((struct frame **, int,
1148 Lisp_Object *,
1149 enum scroll_bar_part *,
1150 Lisp_Object *,
1151 Lisp_Object *,
1152 unsigned long *)) =
1153 FRAME_TERMINAL (new_f)->mouse_position_hook;
1154
1155 if (mouse_position_hook)
1156 (*mouse_position_hook) (&new_f, 1, &bar_window,
1157 &part, &x, &y, &time);
1158#endif /* not HAVE_X_WINDOWS */
1159
1160 if (new_f != 0)
1161 XSETFRAME (window, new_f);
1162 else
1163 {
1164 window = selected_window;
1165 XSETFASTINT (x, 0);
1166 XSETFASTINT (y, 0);
1167 }
1168 }
1169
1170 CHECK_NUMBER (x);
1171 CHECK_NUMBER (y);
1172
1173 /* Decode where to put the menu. */
1174
1175 if (FRAMEP (window))
1176 {
1177 f = XFRAME (window);
1178 xpos = 0;
1179 ypos = 0;
1180 }
1181 else if (WINDOWP (window))
1182 {
1183 struct window *win = XWINDOW (window);
1184 CHECK_LIVE_WINDOW (window);
1185 f = XFRAME (WINDOW_FRAME (win));
1186
ef7417fd
SM
1187 xpos = WINDOW_LEFT_EDGE_X (win);
1188 ypos = WINDOW_TOP_EDGE_Y (win);
ef7417fd
SM
1189 }
1190 else
1191 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1192 but I don't want to make one now. */
1193 CHECK_WINDOW (window);
1194
1195 xpos += XINT (x);
1196 ypos += XINT (y);
1197
1198 /* FIXME: Find a more general check! */
1199 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1200 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1201 error ("Can not put GUI menu on this terminal");
1202
1203 XSETFRAME (Vmenu_updating_frame, f);
1204 }
1205#endif /* HAVE_MENUS */
1206
1207 /* Now parse the lisp menus. */
1208 record_unwind_protect (unuse_menu_items, Qnil);
1209
1210 title = Qnil;
1211 GCPRO1 (title);
1212
1213 /* Decode the menu items from what was specified. */
1214
1215 keymap = get_keymap (menu, 0, 0);
1216 if (CONSP (keymap))
1217 {
1218 /* We were given a keymap. Extract menu info from the keymap. */
1219 Lisp_Object prompt;
1220
1221 /* Extract the detailed info to make one pane. */
1222 keymap_panes (&menu, 1);
1223
1224 /* Search for a string appearing directly as an element of the keymap.
1225 That string is the title of the menu. */
1226 prompt = Fkeymap_prompt (keymap);
1227 if (!NILP (prompt))
1228 title = prompt;
1229#ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1230 else
1231 title = build_string ("Select");
1232#endif
1233
1234 /* Make that be the pane title of the first pane. */
1235 if (!NILP (prompt) && menu_items_n_panes >= 0)
1236 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1237
1238 keymaps = 1;
1239 }
1240 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1241 {
1242 /* We were given a list of keymaps. */
1243 int nmaps = XFASTINT (Flength (menu));
1244 Lisp_Object *maps
1245 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1246 int i;
1247
1248 title = Qnil;
1249
1250 /* The first keymap that has a prompt string
1251 supplies the menu title. */
1252 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1253 {
1254 Lisp_Object prompt;
1255
1256 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1257
1258 prompt = Fkeymap_prompt (keymap);
1259 if (NILP (title) && !NILP (prompt))
1260 title = prompt;
1261 }
1262
1263 /* Extract the detailed info to make one pane. */
1264 keymap_panes (maps, nmaps);
1265
1266 /* Make the title be the pane title of the first pane. */
1267 if (!NILP (title) && menu_items_n_panes >= 0)
1268 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1269
1270 keymaps = 1;
1271 }
1272 else
1273 {
1274 /* We were given an old-fashioned menu. */
1275 title = Fcar (menu);
1276 CHECK_STRING (title);
1277
1278 list_of_panes (Fcdr (menu));
1279
1280 keymaps = 0;
1281 }
1282
1283 unbind_to (specpdl_count, Qnil);
1284
1285#ifdef HAVE_MENUS
dc92c039 1286#ifdef HAVE_WINDOW_SYSTEM
ef7417fd
SM
1287 /* Hide a previous tip, if any. */
1288 Fx_hide_tip ();
dc92c039 1289#endif
ef7417fd
SM
1290
1291#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1292 /* If resources from a previous popup menu still exist, does nothing
1293 until the `menu_free_timer' has freed them (see w32fns.c). This
1294 can occur if you press ESC or click outside a menu without selecting
1295 a menu item.
1296 */
1297 if (current_popup_menu)
1298 {
1299 discard_menu_items ();
1300 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1301 UNGCPRO;
1302 return Qnil;
1303 }
1304#endif
1305
1306#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1307 record_unwind_protect (cleanup_popup_menu, Qnil);
1308#endif
1309
1310 /* Display them in a menu. */
1311 BLOCK_INPUT;
1312
1313 /* FIXME: Use a terminal hook! */
1314#if defined HAVE_NTGUI
1315 selection = w32_menu_show (f, xpos, ypos, for_click,
1316 keymaps, title, &error_name);
1317#elif defined HAVE_NS
1318 selection = ns_menu_show (f, xpos, ypos, for_click,
1319 keymaps, title, &error_name);
1320#else /* MSDOS and X11 */
1321 selection = xmenu_show (f, xpos, ypos, for_click,
1322 keymaps, title, &error_name,
1323 INTEGERP (timestamp) ? XUINT (timestamp) : 0);
1324#endif
1325
1326 UNBLOCK_INPUT;
1327
1328#ifdef HAVE_NS
1329 unbind_to (specpdl_count, Qnil);
1330#else
1331 discard_menu_items ();
1332#endif
1333
1334#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1335 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1336#endif
1337
1338#endif /* HAVE_MENUS */
1339
1340 UNGCPRO;
1341
1342 if (error_name) error (error_name);
1343 return selection;
1344}
1345
279a1d4b
CY
1346void
1347syms_of_menu ()
1348{
1349 staticpro (&menu_items);
1350 menu_items = Qnil;
1351 menu_items_inuse = Qnil;
ef7417fd
SM
1352
1353 defsubr (&Sx_popup_menu);
279a1d4b 1354}
041fa0d4
MB
1355
1356/* arch-tag: 78bbc7cf-8025-4156-aa8a-6c7fd99bf51d
1357 (do not change this comment) */