1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 88, 93, 94, 96, 99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* X pop-up deck-of-cards menu facility for GNU Emacs.
24 * Written by Jon Arnold and Roman Budzianowski
25 * Mods and rewrite by Robert Krawitz
29 /* Modified by Fred Pierresteguy on December 93
30 to make the popup menus and menubar use the Xt. */
32 /* Rewritten for clarity and GC protection by rms in Feb 94. */
36 /* On 4.3 this loses if it comes after xterm.h. */
42 #include "termhooks.h"
47 #include "blockinput.h"
57 /* This may include sys/types.h, and that somehow loses
58 if this is not done before the other system files. */
62 /* Load sys/types.h if not already loaded.
63 In some systems loading it twice is suicidal. */
65 #include <sys/types.h>
68 #include "dispextern.h"
71 #undef HAVE_MULTILINGUAL_MENU
75 #include <X11/IntrinsicP.h>
76 #include <X11/CoreP.h>
77 #include <X11/StringDefs.h>
78 #include <X11/Shell.h>
80 #include <X11/Xaw/Paned.h>
81 #endif /* USE_LUCID */
82 #include "../lwlib/lwlib.h"
83 #else /* not USE_X_TOOLKIT */
84 #include "../oldXMenu/XMenu.h"
85 #endif /* not USE_X_TOOLKIT */
86 #endif /* HAVE_X_WINDOWS */
93 Lisp_Object Vmenu_updating_frame
;
95 Lisp_Object Qdebug_on_next_call
;
97 extern Lisp_Object Qmenu_bar
;
98 extern Lisp_Object Qmouse_click
, Qevent_kind
;
100 extern Lisp_Object QCtoggle
, QCradio
;
102 extern Lisp_Object Voverriding_local_map
;
103 extern Lisp_Object Voverriding_local_map_menu_flag
;
105 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
107 extern Lisp_Object Qmenu_bar_update_hook
;
110 extern void set_frame_menubar ();
111 extern void process_expose_from_menu ();
112 extern XtAppContext Xt_app_con
;
114 static Lisp_Object
xdialog_show ();
115 static void popup_get_selection ();
117 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
122 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
123 Lisp_Object
, Lisp_Object
, Lisp_Object
,
124 Lisp_Object
, Lisp_Object
));
125 static int update_frame_menubar
P_ ((struct frame
*));
126 static Lisp_Object xmenu_show
P_ ((struct frame
*, int, int, int, int,
127 Lisp_Object
, char **));
128 static void keymap_panes
P_ ((Lisp_Object
*, int, int));
129 static void single_keymap_panes
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
131 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
*,
133 static void list_of_panes
P_ ((Lisp_Object
));
134 static void list_of_items
P_ ((Lisp_Object
));
136 extern EMACS_TIME timer_check
P_ ((int));
138 /* This holds a Lisp vector that holds the results of decoding
139 the keymaps or alist-of-alists that specify a menu.
141 It describes the panes and items within the panes.
143 Each pane is described by 3 elements in the vector:
144 t, the pane name, the pane's prefix key.
145 Then follow the pane's items, with 5 elements per item:
146 the item string, the enable flag, the item's value,
147 the definition, and the equivalent keyboard key's description string.
149 In some cases, multiple levels of menus may be described.
150 A single vector slot containing nil indicates the start of a submenu.
151 A single vector slot containing lambda indicates the end of a submenu.
152 The submenu follows a menu item which is the way to reach the submenu.
154 A single vector slot containing quote indicates that the
155 following items should appear on the right of a dialog box.
157 Using a Lisp vector to hold this information while we decode it
158 takes care of protecting all the data from GC. */
160 #define MENU_ITEMS_PANE_NAME 1
161 #define MENU_ITEMS_PANE_PREFIX 2
162 #define MENU_ITEMS_PANE_LENGTH 3
166 MENU_ITEMS_ITEM_NAME
= 0,
167 MENU_ITEMS_ITEM_ENABLE
,
168 MENU_ITEMS_ITEM_VALUE
,
169 MENU_ITEMS_ITEM_EQUIV_KEY
,
170 MENU_ITEMS_ITEM_DEFINITION
,
171 MENU_ITEMS_ITEM_TYPE
,
172 MENU_ITEMS_ITEM_SELECTED
,
173 MENU_ITEMS_ITEM_HELP
,
174 MENU_ITEMS_ITEM_LENGTH
177 static Lisp_Object menu_items
;
179 /* If non-nil, means that the global vars defined here are already in use.
180 Used to detect cases where we try to re-enter this non-reentrant code. */
181 static Lisp_Object menu_items_inuse
;
183 /* Number of slots currently allocated in menu_items. */
184 static int menu_items_allocated
;
186 /* This is the index in menu_items of the first empty slot. */
187 static int menu_items_used
;
189 /* The number of panes currently recorded in menu_items,
190 excluding those within submenus. */
191 static int menu_items_n_panes
;
193 /* Current depth within submenus. */
194 static int menu_items_submenu_depth
;
196 /* Flag which when set indicates a dialog or menu has been posted by
197 Xt on behalf of one of the widget sets. */
198 int popup_activated_flag
;
200 static int next_menubar_widget_id
;
202 /* This is set nonzero after the user activates the menu bar, and set
203 to zero again after the menu bars are redisplayed by prepare_menu_bar.
204 While it is nonzero, all calls to set_frame_menubar go deep.
206 I don't understand why this is needed, but it does seem to be
207 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
209 int pending_menu_activation
;
213 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
215 static struct frame
*
216 menubar_id_to_frame (id
)
219 Lisp_Object tail
, frame
;
222 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
225 if (!GC_FRAMEP (frame
))
228 if (!FRAME_WINDOW_P (f
))
230 if (f
->output_data
.x
->id
== id
)
238 /* Initialize the menu_items structure if we haven't already done so.
239 Also mark it as currently empty. */
244 if (NILP (menu_items
))
246 menu_items_allocated
= 60;
247 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
250 if (!NILP (menu_items_inuse
))
251 error ("Trying to use a menu from within a menu-entry");
252 menu_items_inuse
= Qt
;
254 menu_items_n_panes
= 0;
255 menu_items_submenu_depth
= 0;
258 /* Call at the end of generating the data in menu_items. */
266 unuse_menu_items (dummy
)
269 return menu_items_inuse
= Qnil
;
272 /* Call when finished using the data for the current menu
276 discard_menu_items ()
278 /* Free the structure if it is especially large.
279 Otherwise, hold on to it, to save time. */
280 if (menu_items_allocated
> 200)
283 menu_items_allocated
= 0;
285 xassert (NILP (menu_items_inuse
));
288 /* Make the menu_items vector twice as large. */
294 int old_size
= menu_items_allocated
;
297 menu_items_allocated
*= 2;
298 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
299 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
300 old_size
* sizeof (Lisp_Object
));
303 /* Begin a submenu. */
306 push_submenu_start ()
308 if (menu_items_used
+ 1 > menu_items_allocated
)
311 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
312 menu_items_submenu_depth
++;
320 if (menu_items_used
+ 1 > menu_items_allocated
)
323 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
324 menu_items_submenu_depth
--;
327 /* Indicate boundary between left and right. */
330 push_left_right_boundary ()
332 if (menu_items_used
+ 1 > menu_items_allocated
)
335 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
338 /* Start a new menu pane in menu_items.
339 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
342 push_menu_pane (name
, prefix_vec
)
343 Lisp_Object name
, prefix_vec
;
345 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
348 if (menu_items_submenu_depth
== 0)
349 menu_items_n_panes
++;
350 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
351 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
352 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
355 /* Push one menu item into the current pane. NAME is the string to
356 display. ENABLE if non-nil means this item can be selected. KEY
357 is the key generated by choosing this item, or nil if this item
358 doesn't really have a definition. DEF is the definition of this
359 item. EQUIV is the textual description of the keyboard equivalent
360 for this item (or nil if none). TYPE is the type of this menu
361 item, one of nil, `toggle' or `radio'. */
364 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
365 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
367 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
370 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
371 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
372 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
373 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
374 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
375 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
376 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
377 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
380 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
381 and generate menu panes for them in menu_items.
382 If NOTREAL is nonzero,
383 don't bother really computing whether an item is enabled. */
386 keymap_panes (keymaps
, nmaps
, notreal
)
387 Lisp_Object
*keymaps
;
395 /* Loop over the given keymaps, making a pane for each map.
396 But don't make a pane that is empty--ignore that map instead.
397 P is the number of panes we have made so far. */
398 for (mapno
= 0; mapno
< nmaps
; mapno
++)
399 single_keymap_panes (keymaps
[mapno
],
400 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
402 finish_menu_items ();
405 /* This is a recursive subroutine of keymap_panes.
406 It handles one keymap, KEYMAP.
407 The other arguments are passed along
408 or point to local variables of the previous function.
409 If NOTREAL is nonzero, only check for equivalent key bindings, don't
410 evaluate expressions in menu items and don't make any menu.
412 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
415 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
417 Lisp_Object pane_name
;
422 Lisp_Object pending_maps
= Qnil
;
423 Lisp_Object tail
, item
;
424 struct gcpro gcpro1
, gcpro2
;
430 push_menu_pane (pane_name
, prefix
);
433 /* Remember index for first item in this pane so we can go back and
434 add a prefix when (if) we see the first button. After that, notbuttons
435 is set to 0, to mark that we have seen a button and all non button
436 items need a prefix. */
437 notbuttons
= menu_items_used
;
440 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
442 GCPRO2 (keymap
, pending_maps
);
443 /* Look at each key binding, and if it is a menu item add it
447 single_menu_item (XCAR (item
), XCDR (item
),
448 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
449 else if (VECTORP (item
))
451 /* Loop over the char values represented in the vector. */
452 int len
= XVECTOR (item
)->size
;
454 for (c
= 0; c
< len
; c
++)
456 Lisp_Object character
;
457 XSETFASTINT (character
, c
);
458 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
459 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
465 /* Process now any submenus which want to be panes at this level. */
466 while (!NILP (pending_maps
))
468 Lisp_Object elt
, eltcdr
, string
;
469 elt
= Fcar (pending_maps
);
471 string
= XCAR (eltcdr
);
472 /* We no longer discard the @ from the beginning of the string here.
473 Instead, we do this in xmenu_show. */
474 single_keymap_panes (Fcar (elt
), string
,
475 XCDR (eltcdr
), notreal
, maxdepth
- 1);
476 pending_maps
= Fcdr (pending_maps
);
480 /* This is a subroutine of single_keymap_panes that handles one
482 KEY is a key in a keymap and ITEM is its binding.
483 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
485 If NOTREAL is nonzero, only check for equivalent key bindings, don't
486 evaluate expressions in menu items and don't make any menu.
487 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
488 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
489 buttons. It points to variable notbuttons in single_keymap_panes,
490 which keeps track of if we have seen a button in this menu or not. */
493 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
,
495 Lisp_Object key
, item
;
496 Lisp_Object
*pending_maps_ptr
;
497 int maxdepth
, notreal
;
500 Lisp_Object map
, item_string
, enabled
;
501 struct gcpro gcpro1
, gcpro2
;
504 /* Parse the menu item and leave the result in item_properties. */
506 res
= parse_menu_item (item
, notreal
, 0);
509 return; /* Not a menu item. */
511 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
515 /* We don't want to make a menu, just traverse the keymaps to
516 precompute equivalent key bindings. */
518 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
522 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
523 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
525 if (!NILP (map
) && SREF (item_string
, 0) == '@')
528 /* An enabled separate pane. Remember this to handle it later. */
529 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
535 /* Simulate radio buttons and toggle boxes by putting a prefix in
538 Lisp_Object prefix
= Qnil
;
539 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
543 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
546 /* The first button. Line up previous items in this menu. */
548 int index
= *notbuttons_ptr
; /* Index for first item this menu. */
551 while (index
< menu_items_used
)
554 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
558 submenu
++; /* Skip sub menu. */
560 else if (EQ (tem
, Qlambda
))
563 submenu
--; /* End sub menu. */
565 else if (EQ (tem
, Qt
))
566 index
+= 3; /* Skip new pane marker. */
567 else if (EQ (tem
, Qquote
))
568 index
++; /* Skip a left, right divider. */
571 if (!submenu
&& SREF (tem
, 0) != '\0'
572 && SREF (tem
, 0) != '-')
573 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
574 = concat2 (build_string (" "), tem
);
575 index
+= MENU_ITEMS_ITEM_LENGTH
;
581 /* Calculate prefix, if any, for this item. */
582 if (EQ (type
, QCtoggle
))
583 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
584 else if (EQ (type
, QCradio
))
585 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
587 /* Not a button. If we have earlier buttons, then we need a prefix. */
588 else if (!*notbuttons_ptr
&& SREF (item_string
, 0) != '\0'
589 && SREF (item_string
, 0) != '-')
590 prefix
= build_string (" ");
593 item_string
= concat2 (prefix
, item_string
);
595 #endif /* not HAVE_BOXES */
597 #ifndef USE_X_TOOLKIT
599 /* Indicate visually that this is a submenu. */
600 item_string
= concat2 (item_string
, build_string (" >"));
603 push_menu_item (item_string
, enabled
, key
,
604 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
605 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
606 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
607 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
608 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
611 /* Display a submenu using the toolkit. */
612 if (! (NILP (map
) || NILP (enabled
)))
614 push_submenu_start ();
615 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
621 /* Push all the panes and items of a menu described by the
622 alist-of-alists MENU.
623 This handles old-fashioned calls to x-popup-menu. */
633 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
635 Lisp_Object elt
, pane_name
, pane_data
;
637 pane_name
= Fcar (elt
);
638 CHECK_STRING (pane_name
);
639 push_menu_pane (pane_name
, Qnil
);
640 pane_data
= Fcdr (elt
);
641 CHECK_CONS (pane_data
);
642 list_of_items (pane_data
);
645 finish_menu_items ();
648 /* Push the items in a single pane defined by the alist PANE. */
654 Lisp_Object tail
, item
, item1
;
656 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
660 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
661 else if (NILP (item
))
662 push_left_right_boundary ();
667 CHECK_STRING (item1
);
668 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
673 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
674 doc
: /* Pop up a deck-of-cards menu and return user's selection.
675 POSITION is a position specification. This is either a mouse button event
676 or a list ((XOFFSET YOFFSET) WINDOW)
677 where XOFFSET and YOFFSET are positions in pixels from the top left
678 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)
679 This controls the position of the center of the first line
680 in the first pane of the menu, not the top left of the menu as a whole.
681 If POSITION is t, it means to use the current mouse position.
683 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
684 The menu items come from key bindings that have a menu string as well as
685 a definition; actually, the "definition" in such a key binding looks like
686 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
687 the keymap as a top-level element.
689 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
690 Otherwise, REAL-DEFINITION should be a valid key binding definition.
692 You can also use a list of keymaps as MENU.
693 Then each keymap makes a separate pane.
694 When MENU is a keymap or a list of keymaps, the return value
697 Alternatively, you can specify a menu of multiple panes
698 with a list of the form (TITLE PANE1 PANE2...),
699 where each pane is a list of form (TITLE ITEM1 ITEM2...).
700 Each ITEM is normally a cons cell (STRING . VALUE);
701 but a string can appear as an item--that makes a nonselectable line
703 With this form of menu, the return value is VALUE from the chosen item.
705 If POSITION is nil, don't display the menu at all, just precalculate the
706 cached information about equivalent key sequences. */)
708 Lisp_Object position
, menu
;
710 Lisp_Object keymap
, tem
;
711 int xpos
= 0, ypos
= 0;
714 Lisp_Object selection
;
716 Lisp_Object x
, y
, window
;
719 int specpdl_count
= SPECPDL_INDEX ();
723 if (! NILP (position
))
727 /* Decode the first argument: find the window and the coordinates. */
728 if (EQ (position
, Qt
)
729 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
730 || EQ (XCAR (position
), Qtool_bar
))))
732 /* Use the mouse's current position. */
733 FRAME_PTR new_f
= SELECTED_FRAME ();
734 Lisp_Object bar_window
;
735 enum scroll_bar_part part
;
738 if (mouse_position_hook
)
739 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
740 &part
, &x
, &y
, &time
);
742 XSETFRAME (window
, new_f
);
745 window
= selected_window
;
752 tem
= Fcar (position
);
755 window
= Fcar (Fcdr (position
));
757 y
= Fcar (Fcdr (tem
));
762 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
763 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
764 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
773 /* Decode where to put the menu. */
781 else if (WINDOWP (window
))
783 CHECK_LIVE_WINDOW (window
);
784 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
786 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
787 * XFASTINT (XWINDOW (window
)->left
));
788 ypos
= (FRAME_LINE_HEIGHT (f
)
789 * XFASTINT (XWINDOW (window
)->top
));
792 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
793 but I don't want to make one now. */
794 CHECK_WINDOW (window
);
799 Vmenu_updating_frame
= Qnil
;
800 #endif /* HAVE_MENUS */
802 record_unwind_protect (unuse_menu_items
, Qnil
);
806 /* Decode the menu items from what was specified. */
808 keymap
= get_keymap (menu
, 0, 0);
811 /* We were given a keymap. Extract menu info from the keymap. */
814 /* Extract the detailed info to make one pane. */
815 keymap_panes (&menu
, 1, NILP (position
));
817 /* Search for a string appearing directly as an element of the keymap.
818 That string is the title of the menu. */
819 prompt
= Fkeymap_prompt (keymap
);
820 if (NILP (title
) && !NILP (prompt
))
823 /* Make that be the pane title of the first pane. */
824 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
825 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
829 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
831 /* We were given a list of keymaps. */
832 int nmaps
= XFASTINT (Flength (menu
));
834 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
839 /* The first keymap that has a prompt string
840 supplies the menu title. */
841 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
845 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
847 prompt
= Fkeymap_prompt (keymap
);
848 if (NILP (title
) && !NILP (prompt
))
852 /* Extract the detailed info to make one pane. */
853 keymap_panes (maps
, nmaps
, NILP (position
));
855 /* Make the title be the pane title of the first pane. */
856 if (!NILP (title
) && menu_items_n_panes
>= 0)
857 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
863 /* We were given an old-fashioned menu. */
865 CHECK_STRING (title
);
867 list_of_panes (Fcdr (menu
));
872 unbind_to (specpdl_count
, Qnil
);
876 discard_menu_items ();
882 /* Display them in a menu. */
885 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
886 keymaps
, title
, &error_name
);
889 discard_menu_items ();
892 #endif /* HAVE_MENUS */
894 if (error_name
) error (error_name
);
900 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
901 doc
: /* Pop up a dialog box and return user's selection.
902 POSITION specifies which frame to use.
903 This is normally a mouse button event or a window or frame.
904 If POSITION is t, it means to use the frame the mouse is on.
905 The dialog box appears in the middle of the specified frame.
907 CONTENTS specifies the alternatives to display in the dialog box.
908 It is a list of the form (TITLE ITEM1 ITEM2...).
909 Each ITEM is a cons cell (STRING . VALUE).
910 The return value is VALUE from the chosen item.
912 An ITEM may also be just a string--that makes a nonselectable item.
913 An ITEM may also be nil--that means to put all preceding items
914 on the left of the dialog box and all following items on the right.
915 \(By default, approximately half appear on each side.) */)
917 Lisp_Object position
, contents
;
924 /* Decode the first argument: find the window or frame to use. */
925 if (EQ (position
, Qt
)
926 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
927 || EQ (XCAR (position
), Qtool_bar
))))
929 #if 0 /* Using the frame the mouse is on may not be right. */
930 /* Use the mouse's current position. */
931 FRAME_PTR new_f
= SELECTED_FRAME ();
932 Lisp_Object bar_window
;
933 enum scroll_bar_part part
;
937 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
940 XSETFRAME (window
, new_f
);
942 window
= selected_window
;
944 window
= selected_window
;
946 else if (CONSP (position
))
949 tem
= Fcar (position
);
951 window
= Fcar (Fcdr (position
));
954 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
955 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
958 else if (WINDOWP (position
) || FRAMEP (position
))
963 /* Decode where to put the menu. */
967 else if (WINDOWP (window
))
969 CHECK_LIVE_WINDOW (window
);
970 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
973 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
974 but I don't want to make one now. */
975 CHECK_WINDOW (window
);
977 #ifndef USE_X_TOOLKIT
978 /* Display a menu with these alternatives
979 in the middle of frame F. */
981 Lisp_Object x
, y
, frame
, newpos
;
982 XSETFRAME (frame
, f
);
983 XSETINT (x
, x_pixel_width (f
) / 2);
984 XSETINT (y
, x_pixel_height (f
) / 2);
985 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
987 return Fx_popup_menu (newpos
,
988 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
994 Lisp_Object selection
;
995 int specpdl_count
= SPECPDL_INDEX ();
997 /* Decode the dialog items from what was specified. */
998 title
= Fcar (contents
);
999 CHECK_STRING (title
);
1000 record_unwind_protect (unuse_menu_items
, Qnil
);
1002 list_of_panes (Fcons (contents
, Qnil
));
1004 /* Display them in a dialog box. */
1006 selection
= xdialog_show (f
, 0, title
, &error_name
);
1009 unbind_to (specpdl_count
, Qnil
);
1010 discard_menu_items ();
1012 if (error_name
) error (error_name
);
1018 #ifdef USE_X_TOOLKIT
1020 /* Define a queue to save up for later unreading
1021 all X events that don't pertain to the menu. */
1025 struct event_queue
*next
;
1028 /* It is ok that this queue is a static variable,
1029 because init_menu_items won't allow the menu mechanism
1030 to be entered recursively. */
1031 static struct event_queue
*popup_get_selection_queue
;
1033 static Lisp_Object
popup_get_selection_unwind ();
1035 /* Loop in Xt until the menu pulldown or dialog popup has been
1036 popped down (deactivated). This is used for x-popup-menu
1037 and x-popup-dialog; it is not used for the menu bar.
1039 If DO_TIMERS is nonzero, run timers.
1041 NOTE: All calls to popup_get_selection should be protected
1042 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1045 popup_get_selection (initial_event
, dpyinfo
, id
, do_timers
)
1046 XEvent
*initial_event
;
1047 struct x_display_info
*dpyinfo
;
1052 struct event_queue
*queue_tmp
;
1053 int count
= SPECPDL_INDEX ();
1055 popup_get_selection_queue
= NULL
;
1057 record_unwind_protect (popup_get_selection_unwind
, Qnil
);
1060 event
= *initial_event
;
1062 XtAppNextEvent (Xt_app_con
, &event
);
1066 /* Handle expose events for editor frames right away. */
1067 if (event
.type
== Expose
)
1068 process_expose_from_menu (event
);
1069 /* Make sure we don't consider buttons grabbed after menu goes.
1070 And make sure to deactivate for any ButtonRelease,
1071 even if XtDispatchEvent doesn't do that. */
1072 else if (event
.type
== ButtonRelease
1073 && dpyinfo
->display
== event
.xbutton
.display
)
1075 dpyinfo
->grabbed
&= ~(1 << event
.xbutton
.button
);
1076 popup_activated_flag
= 0;
1077 #ifdef USE_MOTIF /* Pretending that the event came from a
1078 Btn1Down seems the only way to convince Motif to
1079 activate its callbacks; setting the XmNmenuPost
1080 isn't working. --marcus@sysc.pdx.edu. */
1081 event
.xbutton
.button
= 1;
1084 /* If the user presses a key, deactivate the menu.
1085 The user is likely to do that if we get wedged. */
1086 else if (event
.type
== KeyPress
1087 && dpyinfo
->display
== event
.xbutton
.display
)
1089 KeySym keysym
= XLookupKeysym (&event
.xkey
, 0);
1090 if (!IsModifierKey (keysym
))
1092 popup_activated_flag
= 0;
1096 /* Button presses outside the menu also pop it down. */
1097 else if (event
.type
== ButtonPress
1098 && event
.xany
.display
== dpyinfo
->display
1099 && x_any_window_to_frame (dpyinfo
, event
.xany
.window
))
1101 popup_activated_flag
= 0;
1105 /* Queue all events not for this popup,
1106 except for Expose, which we've already handled, and ButtonRelease.
1107 Note that the X window is associated with the frame if this
1108 is a menu bar popup, but not if it's a dialog box. So we use
1109 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1110 if (event
.type
!= Expose
1111 && !(event
.type
== ButtonRelease
1112 && dpyinfo
->display
== event
.xbutton
.display
)
1113 && (event
.xany
.display
!= dpyinfo
->display
1114 || x_non_menubar_window_to_frame (dpyinfo
, event
.xany
.window
)))
1116 queue_tmp
= (struct event_queue
*) xmalloc (sizeof *queue_tmp
);
1117 queue_tmp
->event
= event
;
1118 queue_tmp
->next
= popup_get_selection_queue
;
1119 popup_get_selection_queue
= queue_tmp
;
1122 XtDispatchEvent (&event
);
1124 /* If the event deactivated the menu, we are finished. */
1125 if (!popup_activated_flag
)
1128 /* If we have no events to run, consider timers. */
1129 if (do_timers
&& !XtAppPending (Xt_app_con
))
1132 XtAppNextEvent (Xt_app_con
, &event
);
1135 unbind_to (count
, Qnil
);
1138 /* Unread any events that popup_get_selection read but did not handle. */
1141 popup_get_selection_unwind (ignore
)
1144 while (popup_get_selection_queue
!= NULL
)
1146 struct event_queue
*queue_tmp
;
1147 queue_tmp
= popup_get_selection_queue
;
1148 XPutBackEvent (queue_tmp
->event
.xany
.display
, &queue_tmp
->event
);
1149 popup_get_selection_queue
= queue_tmp
->next
;
1150 xfree ((char *)queue_tmp
);
1151 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1152 interrupt_input_pending
= 1;
1156 /* Activate the menu bar of frame F.
1157 This is called from keyboard.c when it gets the
1158 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1160 To activate the menu bar, we use the X button-press event
1161 that was saved in saved_menu_event.
1162 That makes the toolkit do its thing.
1164 But first we recompute the menu bar contents (the whole tree).
1166 The reason for saving the button event until here, instead of
1167 passing it to the toolkit right away, is that we can safely
1168 execute Lisp code. */
1171 x_activate_menubar (f
)
1174 if (!f
->output_data
.x
->saved_menu_event
->type
)
1177 set_frame_menubar (f
, 0, 1);
1179 XtDispatchEvent (f
->output_data
.x
->saved_menu_event
);
1182 if (f
->output_data
.x
->saved_menu_event
->type
== ButtonRelease
)
1183 pending_menu_activation
= 1;
1186 /* Ignore this if we get it a second time. */
1187 f
->output_data
.x
->saved_menu_event
->type
= 0;
1190 /* Detect if a dialog or menu has been posted. */
1195 return popup_activated_flag
;
1198 /* This callback is invoked when the user selects a menubar cascade
1199 pushbutton, but before the pulldown menu is posted. */
1202 popup_activate_callback (widget
, id
, client_data
)
1205 XtPointer client_data
;
1207 popup_activated_flag
= 1;
1210 /* This callback is invoked when a dialog or menu is finished being
1211 used and has been unposted. */
1214 popup_deactivate_callback (widget
, id
, client_data
)
1217 XtPointer client_data
;
1219 popup_activated_flag
= 0;
1222 /* Lwlib callback called when menu items are highlighted/unhighlighted
1223 while moving the mouse over them. WIDGET is the menu bar or menu
1224 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1225 the widget_value structure for the menu item, or null in case of
1229 menu_highlight_callback (widget
, id
, call_data
)
1234 widget_value
*wv
= (widget_value
*) call_data
;
1236 Lisp_Object frame
, help
;
1238 help
= wv
? wv
->help
: Qnil
;
1240 /* Determine the frame for the help event. */
1241 f
= menubar_id_to_frame (id
);
1244 XSETFRAME (frame
, f
);
1245 kbd_buffer_store_help_event (frame
, help
);
1249 /* WIDGET is the popup menu. It's parent is the frame's
1250 widget. See which frame that is. */
1251 Widget frame_widget
= XtParent (widget
);
1254 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
1256 frame
= XCAR (tail
);
1257 if (GC_FRAMEP (frame
)
1258 && (f
= XFRAME (frame
),
1259 FRAME_X_P (f
) && f
->output_data
.x
->widget
== frame_widget
))
1263 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
1267 /* This callback is called from the menu bar pulldown menu
1268 when the user makes a selection.
1269 Figure out what the user chose
1270 and put the appropriate events into the keyboard buffer. */
1273 menubar_selection_callback (widget
, id
, client_data
)
1276 XtPointer client_data
;
1278 Lisp_Object prefix
, entry
;
1279 FRAME_PTR f
= menubar_id_to_frame (id
);
1281 Lisp_Object
*subprefix_stack
;
1282 int submenu_depth
= 0;
1288 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1289 vector
= f
->menu_bar_vector
;
1292 while (i
< f
->menu_bar_items_used
)
1294 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1296 subprefix_stack
[submenu_depth
++] = prefix
;
1300 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1302 prefix
= subprefix_stack
[--submenu_depth
];
1305 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1307 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1308 i
+= MENU_ITEMS_PANE_LENGTH
;
1312 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1313 /* The EMACS_INT cast avoids a warning. There's no problem
1314 as long as pointers have enough bits to hold small integers. */
1315 if ((int) (EMACS_INT
) client_data
== i
)
1318 struct input_event buf
;
1321 XSETFRAME (frame
, f
);
1322 buf
.kind
= MENU_BAR_EVENT
;
1323 buf
.frame_or_window
= frame
;
1325 kbd_buffer_store_event (&buf
);
1327 for (j
= 0; j
< submenu_depth
; j
++)
1328 if (!NILP (subprefix_stack
[j
]))
1330 buf
.kind
= MENU_BAR_EVENT
;
1331 buf
.frame_or_window
= frame
;
1332 buf
.arg
= subprefix_stack
[j
];
1333 kbd_buffer_store_event (&buf
);
1338 buf
.kind
= MENU_BAR_EVENT
;
1339 buf
.frame_or_window
= frame
;
1341 kbd_buffer_store_event (&buf
);
1344 buf
.kind
= MENU_BAR_EVENT
;
1345 buf
.frame_or_window
= frame
;
1347 kbd_buffer_store_event (&buf
);
1351 i
+= MENU_ITEMS_ITEM_LENGTH
;
1356 /* Allocate a widget_value, blocking input. */
1359 xmalloc_widget_value ()
1361 widget_value
*value
;
1364 value
= malloc_widget_value ();
1370 /* This recursively calls free_widget_value on the tree of widgets.
1371 It must free all data that was malloc'ed for these widget_values.
1372 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1373 must be left alone. */
1376 free_menubar_widget_value_tree (wv
)
1381 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1383 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1385 free_menubar_widget_value_tree (wv
->contents
);
1386 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1390 free_menubar_widget_value_tree (wv
->next
);
1391 wv
->next
= (widget_value
*) 0xDEADBEEF;
1394 free_widget_value (wv
);
1398 /* Set up data in menu_items for a menu bar item
1399 whose event type is ITEM_KEY (with string ITEM_NAME)
1400 and whose contents come from the list of keymaps MAPS. */
1403 parse_single_submenu (item_key
, item_name
, maps
)
1404 Lisp_Object item_key
, item_name
, maps
;
1408 Lisp_Object
*mapvec
;
1410 int top_level_items
= 0;
1412 length
= Flength (maps
);
1413 len
= XINT (length
);
1415 /* Convert the list MAPS into a vector MAPVEC. */
1416 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1417 for (i
= 0; i
< len
; i
++)
1419 mapvec
[i
] = Fcar (maps
);
1423 /* Loop over the given keymaps, making a pane for each map.
1424 But don't make a pane that is empty--ignore that map instead. */
1425 for (i
= 0; i
< len
; i
++)
1427 if (!KEYMAPP (mapvec
[i
]))
1429 /* Here we have a command at top level in the menu bar
1430 as opposed to a submenu. */
1431 top_level_items
= 1;
1432 push_menu_pane (Qnil
, Qnil
);
1433 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1434 Qnil
, Qnil
, Qnil
, Qnil
);
1437 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1440 return top_level_items
;
1443 /* Create a tree of widget_value objects
1444 representing the panes and items
1445 in menu_items starting at index START, up to index END. */
1447 static widget_value
*
1448 digest_single_submenu (start
, end
, top_level_items
)
1449 int start
, end
, top_level_items
;
1451 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1453 int submenu_depth
= 0;
1454 widget_value
**submenu_stack
;
1457 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1458 wv
= xmalloc_widget_value ();
1462 wv
->button_type
= BUTTON_TYPE_NONE
;
1468 /* Loop over all panes and items made during this call
1469 and construct a tree of widget_value objects.
1470 Ignore the panes and items made by previous calls to
1471 single_submenu, even though those are also in menu_items. */
1475 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1477 submenu_stack
[submenu_depth
++] = save_wv
;
1482 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1485 save_wv
= submenu_stack
[--submenu_depth
];
1488 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1489 && submenu_depth
!= 0)
1490 i
+= MENU_ITEMS_PANE_LENGTH
;
1491 /* Ignore a nil in the item list.
1492 It's meaningful only for dialog boxes. */
1493 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1495 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1497 /* Create a new pane. */
1498 Lisp_Object pane_name
, prefix
;
1501 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1502 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1504 #ifndef HAVE_MULTILINGUAL_MENU
1505 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1507 pane_name
= ENCODE_SYSTEM (pane_name
);
1508 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1511 pane_string
= (NILP (pane_name
)
1512 ? "" : (char *) SDATA (pane_name
));
1513 /* If there is just one top-level pane, put all its items directly
1514 under the top-level menu. */
1515 if (menu_items_n_panes
== 1)
1518 /* If the pane has a meaningful name,
1519 make the pane a top-level menu item
1520 with its items as a submenu beneath it. */
1521 if (strcmp (pane_string
, ""))
1523 wv
= xmalloc_widget_value ();
1527 first_wv
->contents
= wv
;
1528 wv
->name
= pane_string
;
1529 /* Ignore the @ that means "separate pane".
1530 This is a kludge, but this isn't worth more time. */
1531 if (!NILP (prefix
) && wv
->name
[0] == '@')
1535 wv
->button_type
= BUTTON_TYPE_NONE
;
1540 i
+= MENU_ITEMS_PANE_LENGTH
;
1544 /* Create a new item within current pane. */
1545 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1548 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1549 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1550 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1551 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1552 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1553 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1554 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1556 #ifndef HAVE_MULTILINGUAL_MENU
1557 if (STRING_MULTIBYTE (item_name
))
1559 item_name
= ENCODE_SYSTEM (item_name
);
1560 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1563 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1565 descrip
= ENCODE_SYSTEM (descrip
);
1566 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1568 #endif /* not HAVE_MULTILINGUAL_MENU */
1570 wv
= xmalloc_widget_value ();
1574 save_wv
->contents
= wv
;
1576 wv
->name
= (char *) SDATA (item_name
);
1577 if (!NILP (descrip
))
1578 wv
->key
= (char *) SDATA (descrip
);
1580 /* The EMACS_INT cast avoids a warning. There's no problem
1581 as long as pointers have enough bits to hold small integers. */
1582 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1583 wv
->enabled
= !NILP (enable
);
1586 wv
->button_type
= BUTTON_TYPE_NONE
;
1587 else if (EQ (type
, QCradio
))
1588 wv
->button_type
= BUTTON_TYPE_RADIO
;
1589 else if (EQ (type
, QCtoggle
))
1590 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1594 wv
->selected
= !NILP (selected
);
1595 if (! STRINGP (help
))
1602 i
+= MENU_ITEMS_ITEM_LENGTH
;
1606 /* If we have just one "menu item"
1607 that was originally a button, return it by itself. */
1608 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1610 wv
= first_wv
->contents
;
1611 free_widget_value (first_wv
);
1618 /* Recompute all the widgets of frame F, when the menu bar has been
1619 changed. Value is non-zero if widgets were updated. */
1622 update_frame_menubar (f
)
1625 struct x_output
*x
= f
->output_data
.x
;
1628 if (!x
->menubar_widget
|| XtIsManaged (x
->menubar_widget
))
1632 /* Save the size of the frame because the pane widget doesn't accept
1633 to resize itself. So force it. */
1637 /* Do the voodoo which means "I'm changing lots of things, don't try
1638 to refigure sizes until I'm done." */
1639 lw_refigure_widget (x
->column_widget
, False
);
1641 /* The order in which children are managed is the top to bottom
1642 order in which they are displayed in the paned window. First,
1643 remove the text-area widget. */
1644 XtUnmanageChild (x
->edit_widget
);
1646 /* Remove the menubar that is there now, and put up the menubar that
1648 XtManageChild (x
->menubar_widget
);
1649 XtMapWidget (x
->menubar_widget
);
1650 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, NULL
);
1652 /* Re-manage the text-area widget, and then thrash the sizes. */
1653 XtManageChild (x
->edit_widget
);
1654 lw_refigure_widget (x
->column_widget
, True
);
1656 /* Force the pane widget to resize itself with the right values. */
1657 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1662 /* Set the contents of the menubar widgets of frame F.
1663 The argument FIRST_TIME is currently ignored;
1664 it is set the first time this is called, from initialize_frame_menubar. */
1667 set_frame_menubar (f
, first_time
, deep_p
)
1672 Widget menubar_widget
= f
->output_data
.x
->menubar_widget
;
1674 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1676 int *submenu_start
, *submenu_end
;
1677 int *submenu_top_level_items
;
1681 XSETFRAME (Vmenu_updating_frame
, f
);
1683 if (f
->output_data
.x
->id
== 0)
1684 f
->output_data
.x
->id
= next_menubar_widget_id
++;
1685 id
= f
->output_data
.x
->id
;
1687 if (! menubar_widget
)
1689 else if (pending_menu_activation
&& !deep_p
)
1691 /* Make the first call for any given frame always go deep. */
1692 else if (!f
->output_data
.x
->saved_menu_event
&& !deep_p
)
1695 f
->output_data
.x
->saved_menu_event
= (XEvent
*)xmalloc (sizeof (XEvent
));
1696 f
->output_data
.x
->saved_menu_event
->type
= 0;
1701 /* Make a widget-value tree representing the entire menu trees. */
1703 struct buffer
*prev
= current_buffer
;
1705 int specpdl_count
= SPECPDL_INDEX ();
1706 int previous_menu_items_used
= f
->menu_bar_items_used
;
1707 Lisp_Object
*previous_items
1708 = (Lisp_Object
*) alloca (previous_menu_items_used
1709 * sizeof (Lisp_Object
));
1711 /* If we are making a new widget, its contents are empty,
1712 do always reinitialize them. */
1713 if (! menubar_widget
)
1714 previous_menu_items_used
= 0;
1716 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1717 specbind (Qinhibit_quit
, Qt
);
1718 /* Don't let the debugger step into this code
1719 because it is not reentrant. */
1720 specbind (Qdebug_on_next_call
, Qnil
);
1722 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1723 record_unwind_protect (unuse_menu_items
, Qnil
);
1724 if (NILP (Voverriding_local_map_menu_flag
))
1726 specbind (Qoverriding_terminal_local_map
, Qnil
);
1727 specbind (Qoverriding_local_map
, Qnil
);
1730 set_buffer_internal_1 (XBUFFER (buffer
));
1732 /* Run the Lucid hook. */
1733 safe_run_hooks (Qactivate_menubar_hook
);
1735 /* If it has changed current-menubar from previous value,
1736 really recompute the menubar from the value. */
1737 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1738 call0 (Qrecompute_lucid_menubar
);
1739 safe_run_hooks (Qmenu_bar_update_hook
);
1740 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1742 items
= FRAME_MENU_BAR_ITEMS (f
);
1744 /* Save the frame's previous menu bar contents data. */
1745 if (previous_menu_items_used
)
1746 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1747 previous_menu_items_used
* sizeof (Lisp_Object
));
1749 /* Fill in menu_items with the current menu bar contents.
1750 This can evaluate Lisp code. */
1751 menu_items
= f
->menu_bar_vector
;
1752 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1753 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1754 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1755 submenu_top_level_items
1756 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1758 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1760 Lisp_Object key
, string
, maps
;
1764 key
= XVECTOR (items
)->contents
[i
];
1765 string
= XVECTOR (items
)->contents
[i
+ 1];
1766 maps
= XVECTOR (items
)->contents
[i
+ 2];
1770 submenu_start
[i
] = menu_items_used
;
1772 menu_items_n_panes
= 0;
1773 submenu_top_level_items
[i
]
1774 = parse_single_submenu (key
, string
, maps
);
1776 submenu_end
[i
] = menu_items_used
;
1779 finish_menu_items ();
1781 /* Convert menu_items into widget_value trees
1782 to display the menu. This cannot evaluate Lisp code. */
1784 wv
= xmalloc_widget_value ();
1785 wv
->name
= "menubar";
1788 wv
->button_type
= BUTTON_TYPE_NONE
;
1792 for (i
= 0; i
< last_i
; i
+= 4)
1794 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1795 submenu_top_level_items
[i
]);
1799 first_wv
->contents
= wv
;
1800 /* Don't set wv->name here; GC during the loop might relocate it. */
1802 wv
->button_type
= BUTTON_TYPE_NONE
;
1806 set_buffer_internal_1 (prev
);
1807 unbind_to (specpdl_count
, Qnil
);
1809 /* If there has been no change in the Lisp-level contents
1810 of the menu bar, skip redisplaying it. Just exit. */
1812 for (i
= 0; i
< previous_menu_items_used
; i
++)
1813 if (menu_items_used
== i
1814 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1816 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1818 free_menubar_widget_value_tree (first_wv
);
1819 discard_menu_items ();
1824 /* Now GC cannot happen during the lifetime of the widget_value,
1825 so it's safe to store data from a Lisp_String. */
1826 wv
= first_wv
->contents
;
1827 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1830 string
= XVECTOR (items
)->contents
[i
+ 1];
1833 wv
->name
= (char *) SDATA (string
);
1837 f
->menu_bar_vector
= menu_items
;
1838 f
->menu_bar_items_used
= menu_items_used
;
1839 discard_menu_items ();
1843 /* Make a widget-value tree containing
1844 just the top level menu bar strings. */
1846 wv
= xmalloc_widget_value ();
1847 wv
->name
= "menubar";
1850 wv
->button_type
= BUTTON_TYPE_NONE
;
1854 items
= FRAME_MENU_BAR_ITEMS (f
);
1855 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1859 string
= XVECTOR (items
)->contents
[i
+ 1];
1863 wv
= xmalloc_widget_value ();
1864 wv
->name
= (char *) SDATA (string
);
1867 wv
->button_type
= BUTTON_TYPE_NONE
;
1869 /* This prevents lwlib from assuming this
1870 menu item is really supposed to be empty. */
1871 /* The EMACS_INT cast avoids a warning.
1872 This value just has to be different from small integers. */
1873 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1878 first_wv
->contents
= wv
;
1882 /* Forget what we thought we knew about what is in the
1883 detailed contents of the menu bar menus.
1884 Changing the top level always destroys the contents. */
1885 f
->menu_bar_items_used
= 0;
1888 /* Create or update the menu bar widget. */
1894 /* Disable resizing (done for Motif!) */
1895 lw_allow_resizing (f
->output_data
.x
->widget
, False
);
1897 /* The third arg is DEEP_P, which says to consider the entire
1898 menu trees we supply, rather than just the menu bar item names. */
1899 lw_modify_all_widgets (id
, first_wv
, deep_p
);
1901 /* Re-enable the edit widget to resize. */
1902 lw_allow_resizing (f
->output_data
.x
->widget
, True
);
1906 menubar_widget
= lw_create_widget ("menubar", "menubar", id
, first_wv
,
1907 f
->output_data
.x
->column_widget
,
1909 popup_activate_callback
,
1910 menubar_selection_callback
,
1911 popup_deactivate_callback
,
1912 menu_highlight_callback
);
1913 f
->output_data
.x
->menubar_widget
= menubar_widget
;
1918 = (f
->output_data
.x
->menubar_widget
1919 ? (f
->output_data
.x
->menubar_widget
->core
.height
1920 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
1923 #if 0 /* Experimentally, we now get the right results
1924 for -geometry -0-0 without this. 24 Aug 96, rms. */
1926 if (FRAME_EXTERNAL_MENU_BAR (f
))
1929 XtVaGetValues (f
->output_data
.x
->column_widget
,
1930 XtNinternalBorderWidth
, &ibw
, NULL
);
1931 menubar_size
+= ibw
;
1933 #endif /* USE_LUCID */
1936 f
->output_data
.x
->menubar_height
= menubar_size
;
1939 free_menubar_widget_value_tree (first_wv
);
1940 update_frame_menubar (f
);
1945 /* Called from Fx_create_frame to create the initial menubar of a frame
1946 before it is mapped, so that the window is mapped with the menubar already
1947 there instead of us tacking it on later and thrashing the window after it
1951 initialize_frame_menubar (f
)
1954 /* This function is called before the first chance to redisplay
1955 the frame. It has to be, so the frame will have the right size. */
1956 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1957 set_frame_menubar (f
, 1, 1);
1961 /* Get rid of the menu bar of frame F, and free its storage.
1962 This is used when deleting a frame, and when turning off the menu bar. */
1965 free_frame_menubar (f
)
1968 Widget menubar_widget
;
1970 menubar_widget
= f
->output_data
.x
->menubar_widget
;
1972 f
->output_data
.x
->menubar_height
= 0;
1977 /* Removing the menu bar magically changes the shell widget's x
1978 and y position of (0, 0) which, when the menu bar is turned
1979 on again, leads to pull-down menuss appearing in strange
1980 positions near the upper-left corner of the display. This
1981 happens only with some window managers like twm and ctwm,
1982 but not with other like Motif's mwm or kwm, because the
1983 latter generate ConfigureNotify events when the menu bar
1984 is switched off, which fixes the shell position. */
1985 Position x0
, y0
, x1
, y1
;
1991 if (f
->output_data
.x
->widget
)
1992 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x0
, XtNy
, &y0
, NULL
);
1995 lw_destroy_all_widgets ((LWLIB_ID
) f
->output_data
.x
->id
);
1996 f
->output_data
.x
->menubar_widget
= NULL
;
1999 if (f
->output_data
.x
->widget
)
2001 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x1
, XtNy
, &y1
, NULL
);
2002 if (x1
== 0 && y1
== 0)
2003 XtVaSetValues (f
->output_data
.x
->widget
, XtNx
, x0
, XtNy
, y0
, NULL
);
2011 #endif /* USE_X_TOOLKIT */
2013 /* xmenu_show actually displays a menu using the panes and items in menu_items
2014 and returns the value selected from it.
2015 There are two versions of xmenu_show, one for Xt and one for Xlib.
2016 Both assume input is blocked by the caller. */
2018 /* F is the frame the menu is for.
2019 X and Y are the frame-relative specified position,
2020 relative to the inside upper left corner of the frame F.
2021 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
2022 KEYMAPS is 1 if this menu was specified with keymaps;
2023 in that case, we return a list containing the chosen item's value
2024 and perhaps also the pane's prefix.
2025 TITLE is the specified menu title.
2026 ERROR is a place to store an error message string in case of failure.
2027 (We return nil on failure, but the value doesn't actually matter.) */
2029 #ifdef USE_X_TOOLKIT
2031 /* We need a unique id for each widget handled by the Lucid Widget
2034 For the main windows, and popup menus, we use this counter,
2035 which we increment each time after use. This starts from 1<<16.
2037 For menu bars, we use numbers starting at 0, counted in
2038 next_menubar_widget_id. */
2039 LWLIB_ID widget_id_tick
;
2041 static Lisp_Object
*volatile menu_item_selection
;
2044 popup_selection_callback (widget
, id
, client_data
)
2047 XtPointer client_data
;
2049 menu_item_selection
= (Lisp_Object
*) client_data
;
2053 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2067 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
2068 widget_value
**submenu_stack
2069 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
2070 Lisp_Object
*subprefix_stack
2071 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
2072 int submenu_depth
= 0;
2073 XButtonPressedEvent dummy
;
2079 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2081 *error
= "Empty menu";
2085 /* Create a tree of widget_value objects
2086 representing the panes and their items. */
2087 wv
= xmalloc_widget_value ();
2091 wv
->button_type
= BUTTON_TYPE_NONE
;
2096 /* Loop over all panes and items, filling in the tree. */
2098 while (i
< menu_items_used
)
2100 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2102 submenu_stack
[submenu_depth
++] = save_wv
;
2108 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2111 save_wv
= submenu_stack
[--submenu_depth
];
2115 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
2116 && submenu_depth
!= 0)
2117 i
+= MENU_ITEMS_PANE_LENGTH
;
2118 /* Ignore a nil in the item list.
2119 It's meaningful only for dialog boxes. */
2120 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2122 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2124 /* Create a new pane. */
2125 Lisp_Object pane_name
, prefix
;
2128 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
2129 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2131 #ifndef HAVE_MULTILINGUAL_MENU
2132 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
2134 pane_name
= ENCODE_SYSTEM (pane_name
);
2135 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
2138 pane_string
= (NILP (pane_name
)
2139 ? "" : (char *) SDATA (pane_name
));
2140 /* If there is just one top-level pane, put all its items directly
2141 under the top-level menu. */
2142 if (menu_items_n_panes
== 1)
2145 /* If the pane has a meaningful name,
2146 make the pane a top-level menu item
2147 with its items as a submenu beneath it. */
2148 if (!keymaps
&& strcmp (pane_string
, ""))
2150 wv
= xmalloc_widget_value ();
2154 first_wv
->contents
= wv
;
2155 wv
->name
= pane_string
;
2156 if (keymaps
&& !NILP (prefix
))
2160 wv
->button_type
= BUTTON_TYPE_NONE
;
2165 else if (first_pane
)
2171 i
+= MENU_ITEMS_PANE_LENGTH
;
2175 /* Create a new item within current pane. */
2176 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
2177 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2178 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2179 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2180 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
2181 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
2182 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
2183 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2185 #ifndef HAVE_MULTILINGUAL_MENU
2186 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2188 item_name
= ENCODE_SYSTEM (item_name
);
2189 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2192 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2194 descrip
= ENCODE_SYSTEM (descrip
);
2195 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2197 #endif /* not HAVE_MULTILINGUAL_MENU */
2199 wv
= xmalloc_widget_value ();
2203 save_wv
->contents
= wv
;
2204 wv
->name
= (char *) SDATA (item_name
);
2205 if (!NILP (descrip
))
2206 wv
->key
= (char *) SDATA (descrip
);
2208 /* If this item has a null value,
2209 make the call_data null so that it won't display a box
2210 when the mouse is on it. */
2212 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
2213 wv
->enabled
= !NILP (enable
);
2216 wv
->button_type
= BUTTON_TYPE_NONE
;
2217 else if (EQ (type
, QCtoggle
))
2218 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2219 else if (EQ (type
, QCradio
))
2220 wv
->button_type
= BUTTON_TYPE_RADIO
;
2224 wv
->selected
= !NILP (selected
);
2226 if (! STRINGP (help
))
2233 i
+= MENU_ITEMS_ITEM_LENGTH
;
2237 /* Deal with the title, if it is non-nil. */
2240 widget_value
*wv_title
= xmalloc_widget_value ();
2241 widget_value
*wv_sep1
= xmalloc_widget_value ();
2242 widget_value
*wv_sep2
= xmalloc_widget_value ();
2244 wv_sep2
->name
= "--";
2245 wv_sep2
->next
= first_wv
->contents
;
2246 wv_sep2
->help
= Qnil
;
2248 wv_sep1
->name
= "--";
2249 wv_sep1
->next
= wv_sep2
;
2250 wv_sep1
->help
= Qnil
;
2252 #ifndef HAVE_MULTILINGUAL_MENU
2253 if (STRING_MULTIBYTE (title
))
2254 title
= ENCODE_SYSTEM (title
);
2257 wv_title
->name
= (char *) SDATA (title
);
2258 wv_title
->enabled
= TRUE
;
2259 wv_title
->button_type
= BUTTON_TYPE_NONE
;
2260 wv_title
->next
= wv_sep1
;
2261 wv_title
->help
= Qnil
;
2262 first_wv
->contents
= wv_title
;
2265 /* Actually create the menu. */
2266 menu_id
= widget_id_tick
++;
2267 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
2268 f
->output_data
.x
->widget
, 1, 0,
2269 popup_selection_callback
,
2270 popup_deactivate_callback
,
2271 menu_highlight_callback
);
2273 /* Adjust coordinates to relative to the outer (window manager) window. */
2276 int win_x
= 0, win_y
= 0;
2278 /* Find the position of the outside upper-left corner of
2279 the inner window, with respect to the outer window. */
2280 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2283 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2285 /* From-window, to-window. */
2286 f
->output_data
.x
->window_desc
,
2287 f
->output_data
.x
->parent_desc
,
2289 /* From-position, to-position. */
2290 0, 0, &win_x
, &win_y
,
2292 /* Child of window. */
2300 /* Adjust coordinates to be root-window-relative. */
2301 x
+= f
->output_data
.x
->left_pos
;
2302 y
+= f
->output_data
.x
->top_pos
;
2304 dummy
.type
= ButtonPress
;
2306 dummy
.send_event
= 0;
2307 dummy
.display
= FRAME_X_DISPLAY (f
);
2308 dummy
.time
= CurrentTime
;
2309 dummy
.root
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
2310 dummy
.window
= dummy
.root
;
2311 dummy
.subwindow
= dummy
.root
;
2316 dummy
.state
= (FRAME_X_DISPLAY_INFO (f
)->grabbed
>> 1) * Button1Mask
;
2318 for (i
= 0; i
< 5; i
++)
2319 if (FRAME_X_DISPLAY_INFO (f
)->grabbed
& (1 << i
))
2322 /* Don't allow any geometry request from the user. */
2323 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
2324 XtSetValues (menu
, av
, ac
);
2326 /* Free the widget_value objects we used to specify the contents. */
2327 free_menubar_widget_value_tree (first_wv
);
2329 /* No selection has been chosen yet. */
2330 menu_item_selection
= 0;
2332 /* Display the menu. */
2333 lw_popup_menu (menu
, (XEvent
*) &dummy
);
2334 popup_activated_flag
= 1;
2336 /* Process events that apply to the menu. */
2337 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), menu_id
, 0);
2339 /* fp turned off the following statement and wrote a comment
2340 that it is unnecessary--that the menu has already disappeared.
2341 Nowadays the menu disappears ok, all right, but
2342 we need to delete the widgets or multiple ones will pile up. */
2343 lw_destroy_all_widgets (menu_id
);
2345 /* Find the selected item, and its pane, to return
2346 the proper value. */
2347 if (menu_item_selection
!= 0)
2349 Lisp_Object prefix
, entry
;
2351 prefix
= entry
= Qnil
;
2353 while (i
< menu_items_used
)
2355 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2357 subprefix_stack
[submenu_depth
++] = prefix
;
2361 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2363 prefix
= subprefix_stack
[--submenu_depth
];
2366 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2369 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2370 i
+= MENU_ITEMS_PANE_LENGTH
;
2372 /* Ignore a nil in the item list.
2373 It's meaningful only for dialog boxes. */
2374 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2379 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2380 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2386 entry
= Fcons (entry
, Qnil
);
2388 entry
= Fcons (prefix
, entry
);
2389 for (j
= submenu_depth
- 1; j
>= 0; j
--)
2390 if (!NILP (subprefix_stack
[j
]))
2391 entry
= Fcons (subprefix_stack
[j
], entry
);
2395 i
+= MENU_ITEMS_ITEM_LENGTH
;
2404 dialog_selection_callback (widget
, id
, client_data
)
2407 XtPointer client_data
;
2409 /* The EMACS_INT cast avoids a warning. There's no problem
2410 as long as pointers have enough bits to hold small integers. */
2411 if ((int) (EMACS_INT
) client_data
!= -1)
2412 menu_item_selection
= (Lisp_Object
*) client_data
;
2414 lw_destroy_all_widgets (id
);
2416 popup_activated_flag
= 0;
2419 /* ARG is the LWLIB ID of the dialog box, represented
2420 as a Lisp object as (HIGHPART . LOWPART). */
2423 xdialog_show_unwind (arg
)
2426 LWLIB_ID id
= (XINT (XCAR (arg
)) << 4 * sizeof (LWLIB_ID
)
2427 | XINT (XCDR (arg
)));
2429 lw_destroy_all_widgets (id
);
2431 popup_activated_flag
= 0;
2435 static char * button_names
[] = {
2436 "button1", "button2", "button3", "button4", "button5",
2437 "button6", "button7", "button8", "button9", "button10" };
2440 xdialog_show (f
, keymaps
, title
, error
)
2446 int i
, nb_buttons
=0;
2448 char dialog_name
[6];
2450 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2452 /* Number of elements seen so far, before boundary. */
2454 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2455 int boundary_seen
= 0;
2459 if (menu_items_n_panes
> 1)
2461 *error
= "Multiple panes in dialog box";
2465 /* Create a tree of widget_value objects
2466 representing the text label and buttons. */
2468 Lisp_Object pane_name
, prefix
;
2470 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2471 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2472 pane_string
= (NILP (pane_name
)
2473 ? "" : (char *) SDATA (pane_name
));
2474 prev_wv
= xmalloc_widget_value ();
2475 prev_wv
->value
= pane_string
;
2476 if (keymaps
&& !NILP (prefix
))
2478 prev_wv
->enabled
= 1;
2479 prev_wv
->name
= "message";
2480 prev_wv
->help
= Qnil
;
2483 /* Loop over all panes and items, filling in the tree. */
2484 i
= MENU_ITEMS_PANE_LENGTH
;
2485 while (i
< menu_items_used
)
2488 /* Create a new item within current pane. */
2489 Lisp_Object item_name
, enable
, descrip
;
2490 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2491 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2493 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2495 if (NILP (item_name
))
2497 free_menubar_widget_value_tree (first_wv
);
2498 *error
= "Submenu in dialog items";
2501 if (EQ (item_name
, Qquote
))
2503 /* This is the boundary between left-side elts
2504 and right-side elts. Stop incrementing right_count. */
2509 if (nb_buttons
>= 9)
2511 free_menubar_widget_value_tree (first_wv
);
2512 *error
= "Too many dialog items";
2516 wv
= xmalloc_widget_value ();
2518 wv
->name
= (char *) button_names
[nb_buttons
];
2519 if (!NILP (descrip
))
2520 wv
->key
= (char *) SDATA (descrip
);
2521 wv
->value
= (char *) SDATA (item_name
);
2522 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
2523 wv
->enabled
= !NILP (enable
);
2527 if (! boundary_seen
)
2531 i
+= MENU_ITEMS_ITEM_LENGTH
;
2534 /* If the boundary was not specified,
2535 by default put half on the left and half on the right. */
2536 if (! boundary_seen
)
2537 left_count
= nb_buttons
- nb_buttons
/ 2;
2539 wv
= xmalloc_widget_value ();
2540 wv
->name
= dialog_name
;
2542 /* Dialog boxes use a really stupid name encoding
2543 which specifies how many buttons to use
2544 and how many buttons are on the right.
2545 The Q means something also. */
2546 dialog_name
[0] = 'Q';
2547 dialog_name
[1] = '0' + nb_buttons
;
2548 dialog_name
[2] = 'B';
2549 dialog_name
[3] = 'R';
2550 /* Number of buttons to put on the right. */
2551 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2553 wv
->contents
= first_wv
;
2557 /* Actually create the dialog. */
2558 dialog_id
= widget_id_tick
++;
2559 lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2560 f
->output_data
.x
->widget
, 1, 0,
2561 dialog_selection_callback
, 0, 0);
2562 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2563 /* Free the widget_value objects we used to specify the contents. */
2564 free_menubar_widget_value_tree (first_wv
);
2566 /* No selection has been chosen yet. */
2567 menu_item_selection
= 0;
2569 /* Display the dialog box. */
2570 lw_pop_up_all_widgets (dialog_id
);
2571 popup_activated_flag
= 1;
2573 /* Process events that apply to the dialog box.
2574 Also handle timers. */
2576 int count
= SPECPDL_INDEX ();
2578 /* xdialog_show_unwind is responsible for popping the dialog box down. */
2579 record_unwind_protect (xdialog_show_unwind
,
2580 Fcons (make_number (dialog_id
>> (4 * sizeof (LWLIB_ID
))),
2581 make_number (dialog_id
& ~(-1 << (4 * sizeof (LWLIB_ID
))))));
2583 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
, 1);
2585 unbind_to (count
, Qnil
);
2588 /* Find the selected item and pane, and return the corresponding value. */
2589 if (menu_item_selection
!= 0)
2595 while (i
< menu_items_used
)
2599 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2602 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2603 i
+= MENU_ITEMS_PANE_LENGTH
;
2605 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2607 /* This is the boundary between left-side elts and
2614 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2615 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2619 entry
= Fcons (entry
, Qnil
);
2621 entry
= Fcons (prefix
, entry
);
2625 i
+= MENU_ITEMS_ITEM_LENGTH
;
2633 #else /* not USE_X_TOOLKIT */
2635 /* The frame of the last activated non-toolkit menu bar.
2636 Used to generate menu help events. */
2638 static struct frame
*menu_help_frame
;
2641 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
2643 PANE is the pane number, and ITEM is the menu item number in
2644 the menu (currently not used).
2646 This cannot be done with generating a HELP_EVENT because
2647 XMenuActivate contains a loop that doesn't let Emacs process
2651 menu_help_callback (help_string
, pane
, item
)
2655 extern Lisp_Object Qmenu_item
;
2656 Lisp_Object
*first_item
;
2657 Lisp_Object pane_name
;
2658 Lisp_Object menu_object
;
2660 first_item
= XVECTOR (menu_items
)->contents
;
2661 if (EQ (first_item
[0], Qt
))
2662 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2663 else if (EQ (first_item
[0], Qquote
))
2664 /* This shouldn't happen, see xmenu_show. */
2665 pane_name
= empty_string
;
2667 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2669 /* (menu-item MENU-NAME PANE-NUMBER) */
2670 menu_object
= Fcons (Qmenu_item
,
2672 Fcons (make_number (pane
), Qnil
)));
2673 show_help_echo (help_string
? build_string (help_string
) : Qnil
,
2674 Qnil
, menu_object
, make_number (item
), 1);
2679 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2689 int pane
, selidx
, lpane
, status
;
2690 Lisp_Object entry
, pane_prefix
;
2692 int ulx
, uly
, width
, height
;
2693 int dispwidth
, dispheight
;
2697 unsigned int dummy_uint
;
2700 if (menu_items_n_panes
== 0)
2703 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2705 *error
= "Empty menu";
2709 /* Figure out which root window F is on. */
2710 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2711 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2712 &dummy_uint
, &dummy_uint
);
2714 /* Make the menu on that window. */
2715 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2718 *error
= "Can't create menu";
2722 #ifdef HAVE_X_WINDOWS
2723 /* Adjust coordinates to relative to the outer (window manager) window. */
2726 int win_x
= 0, win_y
= 0;
2728 /* Find the position of the outside upper-left corner of
2729 the inner window, with respect to the outer window. */
2730 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2733 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2735 /* From-window, to-window. */
2736 f
->output_data
.x
->window_desc
,
2737 f
->output_data
.x
->parent_desc
,
2739 /* From-position, to-position. */
2740 0, 0, &win_x
, &win_y
,
2742 /* Child of window. */
2749 #endif /* HAVE_X_WINDOWS */
2751 /* Adjust coordinates to be root-window-relative. */
2752 x
+= f
->output_data
.x
->left_pos
;
2753 y
+= f
->output_data
.x
->top_pos
;
2755 /* Create all the necessary panes and their items. */
2757 while (i
< menu_items_used
)
2759 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2761 /* Create a new pane. */
2762 Lisp_Object pane_name
, prefix
;
2765 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2766 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2767 pane_string
= (NILP (pane_name
)
2768 ? "" : (char *) SDATA (pane_name
));
2769 if (keymaps
&& !NILP (prefix
))
2772 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2773 if (lpane
== XM_FAILURE
)
2775 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2776 *error
= "Can't create pane";
2779 i
+= MENU_ITEMS_PANE_LENGTH
;
2781 /* Find the width of the widest item in this pane. */
2784 while (j
< menu_items_used
)
2787 item
= XVECTOR (menu_items
)->contents
[j
];
2795 width
= SBYTES (item
);
2796 if (width
> maxwidth
)
2799 j
+= MENU_ITEMS_ITEM_LENGTH
;
2802 /* Ignore a nil in the item list.
2803 It's meaningful only for dialog boxes. */
2804 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2808 /* Create a new item within current pane. */
2809 Lisp_Object item_name
, enable
, descrip
, help
;
2810 unsigned char *item_data
;
2813 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2814 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2816 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2817 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2818 help_string
= STRINGP (help
) ? SDATA (help
) : NULL
;
2820 if (!NILP (descrip
))
2822 int gap
= maxwidth
- SBYTES (item_name
);
2825 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2826 item_name
= concat2 (item_name
, spacer
);
2827 item_name
= concat2 (item_name
, descrip
);
2828 item_data
= SDATA (item_name
);
2830 /* if alloca is fast, use that to make the space,
2831 to reduce gc needs. */
2833 = (unsigned char *) alloca (maxwidth
2834 + SBYTES (descrip
) + 1);
2835 bcopy (SDATA (item_name
), item_data
,
2836 SBYTES (item_name
));
2837 for (j
= SCHARS (item_name
); j
< maxwidth
; j
++)
2839 bcopy (SDATA (descrip
), item_data
+ j
,
2841 item_data
[j
+ SBYTES (descrip
)] = 0;
2845 item_data
= SDATA (item_name
);
2847 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2848 menu
, lpane
, 0, item_data
,
2849 !NILP (enable
), help_string
)
2852 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2853 *error
= "Can't add selection to menu";
2856 i
+= MENU_ITEMS_ITEM_LENGTH
;
2860 /* All set and ready to fly. */
2861 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2862 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2863 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2864 x
= min (x
, dispwidth
);
2865 y
= min (y
, dispheight
);
2868 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2869 &ulx
, &uly
, &width
, &height
);
2870 if (ulx
+width
> dispwidth
)
2872 x
-= (ulx
+ width
) - dispwidth
;
2873 ulx
= dispwidth
- width
;
2875 if (uly
+height
> dispheight
)
2877 y
-= (uly
+ height
) - dispheight
;
2878 uly
= dispheight
- height
;
2880 if (ulx
< 0) x
-= ulx
;
2881 if (uly
< 0) y
-= uly
;
2883 XMenuSetAEQ (menu
, TRUE
);
2884 XMenuSetFreeze (menu
, TRUE
);
2887 /* Help display under X won't work because XMenuActivate contains
2888 a loop that doesn't give Emacs a chance to process it. */
2889 menu_help_frame
= f
;
2890 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2891 x
, y
, ButtonReleaseMask
, &datap
,
2892 menu_help_callback
);
2895 #ifdef HAVE_X_WINDOWS
2896 /* Assume the mouse has moved out of the X window.
2897 If it has actually moved in, we will get an EnterNotify. */
2898 x_mouse_leave (FRAME_X_DISPLAY_INFO (f
));
2905 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2908 /* Find the item number SELIDX in pane number PANE. */
2910 while (i
< menu_items_used
)
2912 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2916 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2918 i
+= MENU_ITEMS_PANE_LENGTH
;
2927 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2930 entry
= Fcons (entry
, Qnil
);
2931 if (!NILP (pane_prefix
))
2932 entry
= Fcons (pane_prefix
, entry
);
2938 i
+= MENU_ITEMS_ITEM_LENGTH
;
2944 *error
= "Can't activate menu";
2950 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2952 #ifdef HAVE_X_WINDOWS
2953 /* State that no mouse buttons are now held.
2954 (The oldXMenu code doesn't track this info for us.)
2955 That is not necessarily true, but the fiction leads to reasonable
2956 results, and it is a pain to ask which are actually held now. */
2957 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2963 #endif /* not USE_X_TOOLKIT */
2965 #endif /* HAVE_MENUS */
2970 staticpro (&menu_items
);
2972 menu_items_inuse
= Qnil
;
2974 Qdebug_on_next_call
= intern ("debug-on-next-call");
2975 staticpro (&Qdebug_on_next_call
);
2977 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2978 doc
: /* Frame for which we are updating a menu.
2979 The enable predicate for a menu command should check this variable. */);
2980 Vmenu_updating_frame
= Qnil
;
2982 #ifdef USE_X_TOOLKIT
2983 widget_id_tick
= (1<<16);
2984 next_menubar_widget_id
= 1;
2987 defsubr (&Sx_popup_menu
);
2989 defsubr (&Sx_popup_dialog
);