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
);
1439 prompt
= Fkeymap_prompt (mapvec
[i
]);
1440 single_keymap_panes (mapvec
[i
],
1441 !NILP (prompt
) ? prompt
: item_name
,
1446 return top_level_items
;
1449 /* Create a tree of widget_value objects
1450 representing the panes and items
1451 in menu_items starting at index START, up to index END. */
1453 static widget_value
*
1454 digest_single_submenu (start
, end
, top_level_items
)
1455 int start
, end
, top_level_items
;
1457 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1459 int submenu_depth
= 0;
1460 widget_value
**submenu_stack
;
1463 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1464 wv
= xmalloc_widget_value ();
1468 wv
->button_type
= BUTTON_TYPE_NONE
;
1474 /* Loop over all panes and items made by the preceding call
1475 to parse_single_submenu and construct a tree of widget_value objects.
1476 Ignore the panes and items used by previous calls to
1477 digest_single_submenu, even though those are also in menu_items. */
1481 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1483 submenu_stack
[submenu_depth
++] = save_wv
;
1488 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1491 save_wv
= submenu_stack
[--submenu_depth
];
1494 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1495 && submenu_depth
!= 0)
1496 i
+= MENU_ITEMS_PANE_LENGTH
;
1497 /* Ignore a nil in the item list.
1498 It's meaningful only for dialog boxes. */
1499 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1501 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1503 /* Create a new pane. */
1504 Lisp_Object pane_name
, prefix
;
1507 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1508 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1510 #ifndef HAVE_MULTILINGUAL_MENU
1511 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1513 pane_name
= ENCODE_SYSTEM (pane_name
);
1514 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1517 pane_string
= (NILP (pane_name
)
1518 ? "" : (char *) SDATA (pane_name
));
1519 /* If there is just one top-level pane, put all its items directly
1520 under the top-level menu. */
1521 if (menu_items_n_panes
== 1)
1524 /* If the pane has a meaningful name,
1525 make the pane a top-level menu item
1526 with its items as a submenu beneath it. */
1527 if (strcmp (pane_string
, ""))
1529 wv
= xmalloc_widget_value ();
1533 first_wv
->contents
= wv
;
1534 wv
->name
= pane_string
;
1535 /* Ignore the @ that means "separate pane".
1536 This is a kludge, but this isn't worth more time. */
1537 if (!NILP (prefix
) && wv
->name
[0] == '@')
1541 wv
->button_type
= BUTTON_TYPE_NONE
;
1546 i
+= MENU_ITEMS_PANE_LENGTH
;
1550 /* Create a new item within current pane. */
1551 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1554 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1555 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1556 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1557 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1558 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1559 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1560 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1562 #ifndef HAVE_MULTILINGUAL_MENU
1563 if (STRING_MULTIBYTE (item_name
))
1565 item_name
= ENCODE_SYSTEM (item_name
);
1566 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1569 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1571 descrip
= ENCODE_SYSTEM (descrip
);
1572 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1574 #endif /* not HAVE_MULTILINGUAL_MENU */
1576 wv
= xmalloc_widget_value ();
1580 save_wv
->contents
= wv
;
1582 wv
->name
= (char *) SDATA (item_name
);
1583 if (!NILP (descrip
))
1584 wv
->key
= (char *) SDATA (descrip
);
1586 /* The EMACS_INT cast avoids a warning. There's no problem
1587 as long as pointers have enough bits to hold small integers. */
1588 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1589 wv
->enabled
= !NILP (enable
);
1592 wv
->button_type
= BUTTON_TYPE_NONE
;
1593 else if (EQ (type
, QCradio
))
1594 wv
->button_type
= BUTTON_TYPE_RADIO
;
1595 else if (EQ (type
, QCtoggle
))
1596 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1600 wv
->selected
= !NILP (selected
);
1601 if (! STRINGP (help
))
1608 i
+= MENU_ITEMS_ITEM_LENGTH
;
1612 /* If we have just one "menu item"
1613 that was originally a button, return it by itself. */
1614 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1616 wv
= first_wv
->contents
;
1617 free_widget_value (first_wv
);
1624 /* Recompute all the widgets of frame F, when the menu bar has been
1625 changed. Value is non-zero if widgets were updated. */
1628 update_frame_menubar (f
)
1631 struct x_output
*x
= f
->output_data
.x
;
1634 if (!x
->menubar_widget
|| XtIsManaged (x
->menubar_widget
))
1638 /* Save the size of the frame because the pane widget doesn't accept
1639 to resize itself. So force it. */
1643 /* Do the voodoo which means "I'm changing lots of things, don't try
1644 to refigure sizes until I'm done." */
1645 lw_refigure_widget (x
->column_widget
, False
);
1647 /* The order in which children are managed is the top to bottom
1648 order in which they are displayed in the paned window. First,
1649 remove the text-area widget. */
1650 XtUnmanageChild (x
->edit_widget
);
1652 /* Remove the menubar that is there now, and put up the menubar that
1654 XtManageChild (x
->menubar_widget
);
1655 XtMapWidget (x
->menubar_widget
);
1656 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, NULL
);
1658 /* Re-manage the text-area widget, and then thrash the sizes. */
1659 XtManageChild (x
->edit_widget
);
1660 lw_refigure_widget (x
->column_widget
, True
);
1662 /* Force the pane widget to resize itself with the right values. */
1663 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1668 /* Set the contents of the menubar widgets of frame F.
1669 The argument FIRST_TIME is currently ignored;
1670 it is set the first time this is called, from initialize_frame_menubar. */
1673 set_frame_menubar (f
, first_time
, deep_p
)
1678 Widget menubar_widget
= f
->output_data
.x
->menubar_widget
;
1680 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1682 int *submenu_start
, *submenu_end
;
1683 int *submenu_top_level_items
, *submenu_n_panes
;
1687 XSETFRAME (Vmenu_updating_frame
, f
);
1689 if (f
->output_data
.x
->id
== 0)
1690 f
->output_data
.x
->id
= next_menubar_widget_id
++;
1691 id
= f
->output_data
.x
->id
;
1693 if (! menubar_widget
)
1695 else if (pending_menu_activation
&& !deep_p
)
1697 /* Make the first call for any given frame always go deep. */
1698 else if (!f
->output_data
.x
->saved_menu_event
&& !deep_p
)
1701 f
->output_data
.x
->saved_menu_event
= (XEvent
*)xmalloc (sizeof (XEvent
));
1702 f
->output_data
.x
->saved_menu_event
->type
= 0;
1707 /* Make a widget-value tree representing the entire menu trees. */
1709 struct buffer
*prev
= current_buffer
;
1711 int specpdl_count
= SPECPDL_INDEX ();
1712 int previous_menu_items_used
= f
->menu_bar_items_used
;
1713 Lisp_Object
*previous_items
1714 = (Lisp_Object
*) alloca (previous_menu_items_used
1715 * sizeof (Lisp_Object
));
1717 /* If we are making a new widget, its contents are empty,
1718 do always reinitialize them. */
1719 if (! menubar_widget
)
1720 previous_menu_items_used
= 0;
1722 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1723 specbind (Qinhibit_quit
, Qt
);
1724 /* Don't let the debugger step into this code
1725 because it is not reentrant. */
1726 specbind (Qdebug_on_next_call
, Qnil
);
1728 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1729 record_unwind_protect (unuse_menu_items
, Qnil
);
1730 if (NILP (Voverriding_local_map_menu_flag
))
1732 specbind (Qoverriding_terminal_local_map
, Qnil
);
1733 specbind (Qoverriding_local_map
, Qnil
);
1736 set_buffer_internal_1 (XBUFFER (buffer
));
1738 /* Run the Lucid hook. */
1739 safe_run_hooks (Qactivate_menubar_hook
);
1741 /* If it has changed current-menubar from previous value,
1742 really recompute the menubar from the value. */
1743 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1744 call0 (Qrecompute_lucid_menubar
);
1745 safe_run_hooks (Qmenu_bar_update_hook
);
1746 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1748 items
= FRAME_MENU_BAR_ITEMS (f
);
1750 /* Save the frame's previous menu bar contents data. */
1751 if (previous_menu_items_used
)
1752 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1753 previous_menu_items_used
* sizeof (Lisp_Object
));
1755 /* Fill in menu_items with the current menu bar contents.
1756 This can evaluate Lisp code. */
1757 menu_items
= f
->menu_bar_vector
;
1758 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1759 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1760 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1761 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1762 submenu_top_level_items
1763 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1765 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1767 Lisp_Object key
, string
, maps
;
1771 key
= XVECTOR (items
)->contents
[i
];
1772 string
= XVECTOR (items
)->contents
[i
+ 1];
1773 maps
= XVECTOR (items
)->contents
[i
+ 2];
1777 submenu_start
[i
] = menu_items_used
;
1779 menu_items_n_panes
= 0;
1780 submenu_top_level_items
[i
]
1781 = parse_single_submenu (key
, string
, maps
);
1782 submenu_n_panes
[i
] = menu_items_n_panes
;
1784 submenu_end
[i
] = menu_items_used
;
1787 finish_menu_items ();
1789 /* Convert menu_items into widget_value trees
1790 to display the menu. This cannot evaluate Lisp code. */
1792 wv
= xmalloc_widget_value ();
1793 wv
->name
= "menubar";
1796 wv
->button_type
= BUTTON_TYPE_NONE
;
1800 for (i
= 0; i
< last_i
; i
+= 4)
1802 menu_items_n_panes
= submenu_n_panes
[i
];
1803 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1804 submenu_top_level_items
[i
]);
1808 first_wv
->contents
= wv
;
1809 /* Don't set wv->name here; GC during the loop might relocate it. */
1811 wv
->button_type
= BUTTON_TYPE_NONE
;
1815 set_buffer_internal_1 (prev
);
1816 unbind_to (specpdl_count
, Qnil
);
1818 /* If there has been no change in the Lisp-level contents
1819 of the menu bar, skip redisplaying it. Just exit. */
1821 for (i
= 0; i
< previous_menu_items_used
; i
++)
1822 if (menu_items_used
== i
1823 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1825 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1827 free_menubar_widget_value_tree (first_wv
);
1828 discard_menu_items ();
1833 /* Now GC cannot happen during the lifetime of the widget_value,
1834 so it's safe to store data from a Lisp_String. */
1835 wv
= first_wv
->contents
;
1836 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1839 string
= XVECTOR (items
)->contents
[i
+ 1];
1842 wv
->name
= (char *) SDATA (string
);
1846 f
->menu_bar_vector
= menu_items
;
1847 f
->menu_bar_items_used
= menu_items_used
;
1848 discard_menu_items ();
1852 /* Make a widget-value tree containing
1853 just the top level menu bar strings. */
1855 wv
= xmalloc_widget_value ();
1856 wv
->name
= "menubar";
1859 wv
->button_type
= BUTTON_TYPE_NONE
;
1863 items
= FRAME_MENU_BAR_ITEMS (f
);
1864 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1868 string
= XVECTOR (items
)->contents
[i
+ 1];
1872 wv
= xmalloc_widget_value ();
1873 wv
->name
= (char *) SDATA (string
);
1876 wv
->button_type
= BUTTON_TYPE_NONE
;
1878 /* This prevents lwlib from assuming this
1879 menu item is really supposed to be empty. */
1880 /* The EMACS_INT cast avoids a warning.
1881 This value just has to be different from small integers. */
1882 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1887 first_wv
->contents
= wv
;
1891 /* Forget what we thought we knew about what is in the
1892 detailed contents of the menu bar menus.
1893 Changing the top level always destroys the contents. */
1894 f
->menu_bar_items_used
= 0;
1897 /* Create or update the menu bar widget. */
1903 /* Disable resizing (done for Motif!) */
1904 lw_allow_resizing (f
->output_data
.x
->widget
, False
);
1906 /* The third arg is DEEP_P, which says to consider the entire
1907 menu trees we supply, rather than just the menu bar item names. */
1908 lw_modify_all_widgets (id
, first_wv
, deep_p
);
1910 /* Re-enable the edit widget to resize. */
1911 lw_allow_resizing (f
->output_data
.x
->widget
, True
);
1915 menubar_widget
= lw_create_widget ("menubar", "menubar", id
, first_wv
,
1916 f
->output_data
.x
->column_widget
,
1918 popup_activate_callback
,
1919 menubar_selection_callback
,
1920 popup_deactivate_callback
,
1921 menu_highlight_callback
);
1922 f
->output_data
.x
->menubar_widget
= menubar_widget
;
1927 = (f
->output_data
.x
->menubar_widget
1928 ? (f
->output_data
.x
->menubar_widget
->core
.height
1929 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
1932 #if 0 /* Experimentally, we now get the right results
1933 for -geometry -0-0 without this. 24 Aug 96, rms. */
1935 if (FRAME_EXTERNAL_MENU_BAR (f
))
1938 XtVaGetValues (f
->output_data
.x
->column_widget
,
1939 XtNinternalBorderWidth
, &ibw
, NULL
);
1940 menubar_size
+= ibw
;
1942 #endif /* USE_LUCID */
1945 f
->output_data
.x
->menubar_height
= menubar_size
;
1948 free_menubar_widget_value_tree (first_wv
);
1949 update_frame_menubar (f
);
1954 /* Called from Fx_create_frame to create the initial menubar of a frame
1955 before it is mapped, so that the window is mapped with the menubar already
1956 there instead of us tacking it on later and thrashing the window after it
1960 initialize_frame_menubar (f
)
1963 /* This function is called before the first chance to redisplay
1964 the frame. It has to be, so the frame will have the right size. */
1965 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1966 set_frame_menubar (f
, 1, 1);
1970 /* Get rid of the menu bar of frame F, and free its storage.
1971 This is used when deleting a frame, and when turning off the menu bar. */
1974 free_frame_menubar (f
)
1977 Widget menubar_widget
;
1979 menubar_widget
= f
->output_data
.x
->menubar_widget
;
1981 f
->output_data
.x
->menubar_height
= 0;
1986 /* Removing the menu bar magically changes the shell widget's x
1987 and y position of (0, 0) which, when the menu bar is turned
1988 on again, leads to pull-down menuss appearing in strange
1989 positions near the upper-left corner of the display. This
1990 happens only with some window managers like twm and ctwm,
1991 but not with other like Motif's mwm or kwm, because the
1992 latter generate ConfigureNotify events when the menu bar
1993 is switched off, which fixes the shell position. */
1994 Position x0
, y0
, x1
, y1
;
2000 if (f
->output_data
.x
->widget
)
2001 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x0
, XtNy
, &y0
, NULL
);
2004 lw_destroy_all_widgets ((LWLIB_ID
) f
->output_data
.x
->id
);
2005 f
->output_data
.x
->menubar_widget
= NULL
;
2008 if (f
->output_data
.x
->widget
)
2010 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x1
, XtNy
, &y1
, NULL
);
2011 if (x1
== 0 && y1
== 0)
2012 XtVaSetValues (f
->output_data
.x
->widget
, XtNx
, x0
, XtNy
, y0
, NULL
);
2020 #endif /* USE_X_TOOLKIT */
2022 /* xmenu_show actually displays a menu using the panes and items in menu_items
2023 and returns the value selected from it.
2024 There are two versions of xmenu_show, one for Xt and one for Xlib.
2025 Both assume input is blocked by the caller. */
2027 /* F is the frame the menu is for.
2028 X and Y are the frame-relative specified position,
2029 relative to the inside upper left corner of the frame F.
2030 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
2031 KEYMAPS is 1 if this menu was specified with keymaps;
2032 in that case, we return a list containing the chosen item's value
2033 and perhaps also the pane's prefix.
2034 TITLE is the specified menu title.
2035 ERROR is a place to store an error message string in case of failure.
2036 (We return nil on failure, but the value doesn't actually matter.) */
2038 #ifdef USE_X_TOOLKIT
2040 /* We need a unique id for each widget handled by the Lucid Widget
2043 For the main windows, and popup menus, we use this counter,
2044 which we increment each time after use. This starts from 1<<16.
2046 For menu bars, we use numbers starting at 0, counted in
2047 next_menubar_widget_id. */
2048 LWLIB_ID widget_id_tick
;
2050 static Lisp_Object
*volatile menu_item_selection
;
2053 popup_selection_callback (widget
, id
, client_data
)
2056 XtPointer client_data
;
2058 menu_item_selection
= (Lisp_Object
*) client_data
;
2062 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2076 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
2077 widget_value
**submenu_stack
2078 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
2079 Lisp_Object
*subprefix_stack
2080 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
2081 int submenu_depth
= 0;
2082 XButtonPressedEvent dummy
;
2088 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2090 *error
= "Empty menu";
2094 /* Create a tree of widget_value objects
2095 representing the panes and their items. */
2096 wv
= xmalloc_widget_value ();
2100 wv
->button_type
= BUTTON_TYPE_NONE
;
2105 /* Loop over all panes and items, filling in the tree. */
2107 while (i
< menu_items_used
)
2109 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2111 submenu_stack
[submenu_depth
++] = save_wv
;
2117 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2120 save_wv
= submenu_stack
[--submenu_depth
];
2124 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
2125 && submenu_depth
!= 0)
2126 i
+= MENU_ITEMS_PANE_LENGTH
;
2127 /* Ignore a nil in the item list.
2128 It's meaningful only for dialog boxes. */
2129 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2131 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2133 /* Create a new pane. */
2134 Lisp_Object pane_name
, prefix
;
2137 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
2138 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2140 #ifndef HAVE_MULTILINGUAL_MENU
2141 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
2143 pane_name
= ENCODE_SYSTEM (pane_name
);
2144 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
2147 pane_string
= (NILP (pane_name
)
2148 ? "" : (char *) SDATA (pane_name
));
2149 /* If there is just one top-level pane, put all its items directly
2150 under the top-level menu. */
2151 if (menu_items_n_panes
== 1)
2154 /* If the pane has a meaningful name,
2155 make the pane a top-level menu item
2156 with its items as a submenu beneath it. */
2157 if (!keymaps
&& strcmp (pane_string
, ""))
2159 wv
= xmalloc_widget_value ();
2163 first_wv
->contents
= wv
;
2164 wv
->name
= pane_string
;
2165 if (keymaps
&& !NILP (prefix
))
2169 wv
->button_type
= BUTTON_TYPE_NONE
;
2174 else if (first_pane
)
2180 i
+= MENU_ITEMS_PANE_LENGTH
;
2184 /* Create a new item within current pane. */
2185 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
2186 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2187 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2188 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2189 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
2190 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
2191 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
2192 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2194 #ifndef HAVE_MULTILINGUAL_MENU
2195 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2197 item_name
= ENCODE_SYSTEM (item_name
);
2198 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2201 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2203 descrip
= ENCODE_SYSTEM (descrip
);
2204 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2206 #endif /* not HAVE_MULTILINGUAL_MENU */
2208 wv
= xmalloc_widget_value ();
2212 save_wv
->contents
= wv
;
2213 wv
->name
= (char *) SDATA (item_name
);
2214 if (!NILP (descrip
))
2215 wv
->key
= (char *) SDATA (descrip
);
2217 /* If this item has a null value,
2218 make the call_data null so that it won't display a box
2219 when the mouse is on it. */
2221 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
2222 wv
->enabled
= !NILP (enable
);
2225 wv
->button_type
= BUTTON_TYPE_NONE
;
2226 else if (EQ (type
, QCtoggle
))
2227 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2228 else if (EQ (type
, QCradio
))
2229 wv
->button_type
= BUTTON_TYPE_RADIO
;
2233 wv
->selected
= !NILP (selected
);
2235 if (! STRINGP (help
))
2242 i
+= MENU_ITEMS_ITEM_LENGTH
;
2246 /* Deal with the title, if it is non-nil. */
2249 widget_value
*wv_title
= xmalloc_widget_value ();
2250 widget_value
*wv_sep1
= xmalloc_widget_value ();
2251 widget_value
*wv_sep2
= xmalloc_widget_value ();
2253 wv_sep2
->name
= "--";
2254 wv_sep2
->next
= first_wv
->contents
;
2255 wv_sep2
->help
= Qnil
;
2257 wv_sep1
->name
= "--";
2258 wv_sep1
->next
= wv_sep2
;
2259 wv_sep1
->help
= Qnil
;
2261 #ifndef HAVE_MULTILINGUAL_MENU
2262 if (STRING_MULTIBYTE (title
))
2263 title
= ENCODE_SYSTEM (title
);
2266 wv_title
->name
= (char *) SDATA (title
);
2267 wv_title
->enabled
= TRUE
;
2268 wv_title
->button_type
= BUTTON_TYPE_NONE
;
2269 wv_title
->next
= wv_sep1
;
2270 wv_title
->help
= Qnil
;
2271 first_wv
->contents
= wv_title
;
2274 /* Actually create the menu. */
2275 menu_id
= widget_id_tick
++;
2276 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
2277 f
->output_data
.x
->widget
, 1, 0,
2278 popup_selection_callback
,
2279 popup_deactivate_callback
,
2280 menu_highlight_callback
);
2282 /* Adjust coordinates to relative to the outer (window manager) window. */
2285 int win_x
= 0, win_y
= 0;
2287 /* Find the position of the outside upper-left corner of
2288 the inner window, with respect to the outer window. */
2289 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2292 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2294 /* From-window, to-window. */
2295 f
->output_data
.x
->window_desc
,
2296 f
->output_data
.x
->parent_desc
,
2298 /* From-position, to-position. */
2299 0, 0, &win_x
, &win_y
,
2301 /* Child of window. */
2309 /* Adjust coordinates to be root-window-relative. */
2310 x
+= f
->output_data
.x
->left_pos
;
2311 y
+= f
->output_data
.x
->top_pos
;
2313 dummy
.type
= ButtonPress
;
2315 dummy
.send_event
= 0;
2316 dummy
.display
= FRAME_X_DISPLAY (f
);
2317 dummy
.time
= CurrentTime
;
2318 dummy
.root
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
2319 dummy
.window
= dummy
.root
;
2320 dummy
.subwindow
= dummy
.root
;
2325 dummy
.state
= (FRAME_X_DISPLAY_INFO (f
)->grabbed
>> 1) * Button1Mask
;
2327 for (i
= 0; i
< 5; i
++)
2328 if (FRAME_X_DISPLAY_INFO (f
)->grabbed
& (1 << i
))
2331 /* Don't allow any geometry request from the user. */
2332 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
2333 XtSetValues (menu
, av
, ac
);
2335 /* Free the widget_value objects we used to specify the contents. */
2336 free_menubar_widget_value_tree (first_wv
);
2338 /* No selection has been chosen yet. */
2339 menu_item_selection
= 0;
2341 /* Display the menu. */
2342 lw_popup_menu (menu
, (XEvent
*) &dummy
);
2343 popup_activated_flag
= 1;
2345 /* Process events that apply to the menu. */
2346 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), menu_id
, 0);
2348 /* fp turned off the following statement and wrote a comment
2349 that it is unnecessary--that the menu has already disappeared.
2350 Nowadays the menu disappears ok, all right, but
2351 we need to delete the widgets or multiple ones will pile up. */
2352 lw_destroy_all_widgets (menu_id
);
2354 /* Find the selected item, and its pane, to return
2355 the proper value. */
2356 if (menu_item_selection
!= 0)
2358 Lisp_Object prefix
, entry
;
2360 prefix
= entry
= Qnil
;
2362 while (i
< menu_items_used
)
2364 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2366 subprefix_stack
[submenu_depth
++] = prefix
;
2370 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2372 prefix
= subprefix_stack
[--submenu_depth
];
2375 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2378 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2379 i
+= MENU_ITEMS_PANE_LENGTH
;
2381 /* Ignore a nil in the item list.
2382 It's meaningful only for dialog boxes. */
2383 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2388 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2389 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2395 entry
= Fcons (entry
, Qnil
);
2397 entry
= Fcons (prefix
, entry
);
2398 for (j
= submenu_depth
- 1; j
>= 0; j
--)
2399 if (!NILP (subprefix_stack
[j
]))
2400 entry
= Fcons (subprefix_stack
[j
], entry
);
2404 i
+= MENU_ITEMS_ITEM_LENGTH
;
2413 dialog_selection_callback (widget
, id
, client_data
)
2416 XtPointer client_data
;
2418 /* The EMACS_INT cast avoids a warning. There's no problem
2419 as long as pointers have enough bits to hold small integers. */
2420 if ((int) (EMACS_INT
) client_data
!= -1)
2421 menu_item_selection
= (Lisp_Object
*) client_data
;
2423 lw_destroy_all_widgets (id
);
2425 popup_activated_flag
= 0;
2428 /* ARG is the LWLIB ID of the dialog box, represented
2429 as a Lisp object as (HIGHPART . LOWPART). */
2432 xdialog_show_unwind (arg
)
2435 LWLIB_ID id
= (XINT (XCAR (arg
)) << 4 * sizeof (LWLIB_ID
)
2436 | XINT (XCDR (arg
)));
2438 lw_destroy_all_widgets (id
);
2440 popup_activated_flag
= 0;
2444 static char * button_names
[] = {
2445 "button1", "button2", "button3", "button4", "button5",
2446 "button6", "button7", "button8", "button9", "button10" };
2449 xdialog_show (f
, keymaps
, title
, error
)
2455 int i
, nb_buttons
=0;
2457 char dialog_name
[6];
2459 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2461 /* Number of elements seen so far, before boundary. */
2463 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2464 int boundary_seen
= 0;
2468 if (menu_items_n_panes
> 1)
2470 *error
= "Multiple panes in dialog box";
2474 /* Create a tree of widget_value objects
2475 representing the text label and buttons. */
2477 Lisp_Object pane_name
, prefix
;
2479 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2480 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2481 pane_string
= (NILP (pane_name
)
2482 ? "" : (char *) SDATA (pane_name
));
2483 prev_wv
= xmalloc_widget_value ();
2484 prev_wv
->value
= pane_string
;
2485 if (keymaps
&& !NILP (prefix
))
2487 prev_wv
->enabled
= 1;
2488 prev_wv
->name
= "message";
2489 prev_wv
->help
= Qnil
;
2492 /* Loop over all panes and items, filling in the tree. */
2493 i
= MENU_ITEMS_PANE_LENGTH
;
2494 while (i
< menu_items_used
)
2497 /* Create a new item within current pane. */
2498 Lisp_Object item_name
, enable
, descrip
;
2499 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2500 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2502 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2504 if (NILP (item_name
))
2506 free_menubar_widget_value_tree (first_wv
);
2507 *error
= "Submenu in dialog items";
2510 if (EQ (item_name
, Qquote
))
2512 /* This is the boundary between left-side elts
2513 and right-side elts. Stop incrementing right_count. */
2518 if (nb_buttons
>= 9)
2520 free_menubar_widget_value_tree (first_wv
);
2521 *error
= "Too many dialog items";
2525 wv
= xmalloc_widget_value ();
2527 wv
->name
= (char *) button_names
[nb_buttons
];
2528 if (!NILP (descrip
))
2529 wv
->key
= (char *) SDATA (descrip
);
2530 wv
->value
= (char *) SDATA (item_name
);
2531 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
2532 wv
->enabled
= !NILP (enable
);
2536 if (! boundary_seen
)
2540 i
+= MENU_ITEMS_ITEM_LENGTH
;
2543 /* If the boundary was not specified,
2544 by default put half on the left and half on the right. */
2545 if (! boundary_seen
)
2546 left_count
= nb_buttons
- nb_buttons
/ 2;
2548 wv
= xmalloc_widget_value ();
2549 wv
->name
= dialog_name
;
2551 /* Dialog boxes use a really stupid name encoding
2552 which specifies how many buttons to use
2553 and how many buttons are on the right.
2554 The Q means something also. */
2555 dialog_name
[0] = 'Q';
2556 dialog_name
[1] = '0' + nb_buttons
;
2557 dialog_name
[2] = 'B';
2558 dialog_name
[3] = 'R';
2559 /* Number of buttons to put on the right. */
2560 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2562 wv
->contents
= first_wv
;
2566 /* Actually create the dialog. */
2567 dialog_id
= widget_id_tick
++;
2568 lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2569 f
->output_data
.x
->widget
, 1, 0,
2570 dialog_selection_callback
, 0, 0);
2571 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2572 /* Free the widget_value objects we used to specify the contents. */
2573 free_menubar_widget_value_tree (first_wv
);
2575 /* No selection has been chosen yet. */
2576 menu_item_selection
= 0;
2578 /* Display the dialog box. */
2579 lw_pop_up_all_widgets (dialog_id
);
2580 popup_activated_flag
= 1;
2582 /* Process events that apply to the dialog box.
2583 Also handle timers. */
2585 int count
= SPECPDL_INDEX ();
2587 /* xdialog_show_unwind is responsible for popping the dialog box down. */
2588 record_unwind_protect (xdialog_show_unwind
,
2589 Fcons (make_number (dialog_id
>> (4 * sizeof (LWLIB_ID
))),
2590 make_number (dialog_id
& ~(-1 << (4 * sizeof (LWLIB_ID
))))));
2592 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
, 1);
2594 unbind_to (count
, Qnil
);
2597 /* Find the selected item and pane, and return the corresponding value. */
2598 if (menu_item_selection
!= 0)
2604 while (i
< menu_items_used
)
2608 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2611 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2612 i
+= MENU_ITEMS_PANE_LENGTH
;
2614 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2616 /* This is the boundary between left-side elts and
2623 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2624 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2628 entry
= Fcons (entry
, Qnil
);
2630 entry
= Fcons (prefix
, entry
);
2634 i
+= MENU_ITEMS_ITEM_LENGTH
;
2642 #else /* not USE_X_TOOLKIT */
2644 /* The frame of the last activated non-toolkit menu bar.
2645 Used to generate menu help events. */
2647 static struct frame
*menu_help_frame
;
2650 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
2652 PANE is the pane number, and ITEM is the menu item number in
2653 the menu (currently not used).
2655 This cannot be done with generating a HELP_EVENT because
2656 XMenuActivate contains a loop that doesn't let Emacs process
2660 menu_help_callback (help_string
, pane
, item
)
2664 extern Lisp_Object Qmenu_item
;
2665 Lisp_Object
*first_item
;
2666 Lisp_Object pane_name
;
2667 Lisp_Object menu_object
;
2669 first_item
= XVECTOR (menu_items
)->contents
;
2670 if (EQ (first_item
[0], Qt
))
2671 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2672 else if (EQ (first_item
[0], Qquote
))
2673 /* This shouldn't happen, see xmenu_show. */
2674 pane_name
= empty_string
;
2676 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2678 /* (menu-item MENU-NAME PANE-NUMBER) */
2679 menu_object
= Fcons (Qmenu_item
,
2681 Fcons (make_number (pane
), Qnil
)));
2682 show_help_echo (help_string
? build_string (help_string
) : Qnil
,
2683 Qnil
, menu_object
, make_number (item
), 1);
2688 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2698 int pane
, selidx
, lpane
, status
;
2699 Lisp_Object entry
, pane_prefix
;
2701 int ulx
, uly
, width
, height
;
2702 int dispwidth
, dispheight
;
2706 unsigned int dummy_uint
;
2709 if (menu_items_n_panes
== 0)
2712 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2714 *error
= "Empty menu";
2718 /* Figure out which root window F is on. */
2719 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2720 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2721 &dummy_uint
, &dummy_uint
);
2723 /* Make the menu on that window. */
2724 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2727 *error
= "Can't create menu";
2731 #ifdef HAVE_X_WINDOWS
2732 /* Adjust coordinates to relative to the outer (window manager) window. */
2735 int win_x
= 0, win_y
= 0;
2737 /* Find the position of the outside upper-left corner of
2738 the inner window, with respect to the outer window. */
2739 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2742 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2744 /* From-window, to-window. */
2745 f
->output_data
.x
->window_desc
,
2746 f
->output_data
.x
->parent_desc
,
2748 /* From-position, to-position. */
2749 0, 0, &win_x
, &win_y
,
2751 /* Child of window. */
2758 #endif /* HAVE_X_WINDOWS */
2760 /* Adjust coordinates to be root-window-relative. */
2761 x
+= f
->output_data
.x
->left_pos
;
2762 y
+= f
->output_data
.x
->top_pos
;
2764 /* Create all the necessary panes and their items. */
2766 while (i
< menu_items_used
)
2768 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2770 /* Create a new pane. */
2771 Lisp_Object pane_name
, prefix
;
2774 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2775 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2776 pane_string
= (NILP (pane_name
)
2777 ? "" : (char *) SDATA (pane_name
));
2778 if (keymaps
&& !NILP (prefix
))
2781 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2782 if (lpane
== XM_FAILURE
)
2784 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2785 *error
= "Can't create pane";
2788 i
+= MENU_ITEMS_PANE_LENGTH
;
2790 /* Find the width of the widest item in this pane. */
2793 while (j
< menu_items_used
)
2796 item
= XVECTOR (menu_items
)->contents
[j
];
2804 width
= SBYTES (item
);
2805 if (width
> maxwidth
)
2808 j
+= MENU_ITEMS_ITEM_LENGTH
;
2811 /* Ignore a nil in the item list.
2812 It's meaningful only for dialog boxes. */
2813 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2817 /* Create a new item within current pane. */
2818 Lisp_Object item_name
, enable
, descrip
, help
;
2819 unsigned char *item_data
;
2822 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2823 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2825 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2826 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2827 help_string
= STRINGP (help
) ? SDATA (help
) : NULL
;
2829 if (!NILP (descrip
))
2831 int gap
= maxwidth
- SBYTES (item_name
);
2834 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2835 item_name
= concat2 (item_name
, spacer
);
2836 item_name
= concat2 (item_name
, descrip
);
2837 item_data
= SDATA (item_name
);
2839 /* if alloca is fast, use that to make the space,
2840 to reduce gc needs. */
2842 = (unsigned char *) alloca (maxwidth
2843 + SBYTES (descrip
) + 1);
2844 bcopy (SDATA (item_name
), item_data
,
2845 SBYTES (item_name
));
2846 for (j
= SCHARS (item_name
); j
< maxwidth
; j
++)
2848 bcopy (SDATA (descrip
), item_data
+ j
,
2850 item_data
[j
+ SBYTES (descrip
)] = 0;
2854 item_data
= SDATA (item_name
);
2856 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2857 menu
, lpane
, 0, item_data
,
2858 !NILP (enable
), help_string
)
2861 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2862 *error
= "Can't add selection to menu";
2865 i
+= MENU_ITEMS_ITEM_LENGTH
;
2869 /* All set and ready to fly. */
2870 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2871 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2872 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2873 x
= min (x
, dispwidth
);
2874 y
= min (y
, dispheight
);
2877 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2878 &ulx
, &uly
, &width
, &height
);
2879 if (ulx
+width
> dispwidth
)
2881 x
-= (ulx
+ width
) - dispwidth
;
2882 ulx
= dispwidth
- width
;
2884 if (uly
+height
> dispheight
)
2886 y
-= (uly
+ height
) - dispheight
;
2887 uly
= dispheight
- height
;
2889 if (ulx
< 0) x
-= ulx
;
2890 if (uly
< 0) y
-= uly
;
2892 XMenuSetAEQ (menu
, TRUE
);
2893 XMenuSetFreeze (menu
, TRUE
);
2896 /* Help display under X won't work because XMenuActivate contains
2897 a loop that doesn't give Emacs a chance to process it. */
2898 menu_help_frame
= f
;
2899 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2900 x
, y
, ButtonReleaseMask
, &datap
,
2901 menu_help_callback
);
2904 #ifdef HAVE_X_WINDOWS
2905 /* Assume the mouse has moved out of the X window.
2906 If it has actually moved in, we will get an EnterNotify. */
2907 x_mouse_leave (FRAME_X_DISPLAY_INFO (f
));
2914 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2917 /* Find the item number SELIDX in pane number PANE. */
2919 while (i
< menu_items_used
)
2921 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2925 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2927 i
+= MENU_ITEMS_PANE_LENGTH
;
2936 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2939 entry
= Fcons (entry
, Qnil
);
2940 if (!NILP (pane_prefix
))
2941 entry
= Fcons (pane_prefix
, entry
);
2947 i
+= MENU_ITEMS_ITEM_LENGTH
;
2953 *error
= "Can't activate menu";
2959 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2961 #ifdef HAVE_X_WINDOWS
2962 /* State that no mouse buttons are now held.
2963 (The oldXMenu code doesn't track this info for us.)
2964 That is not necessarily true, but the fiction leads to reasonable
2965 results, and it is a pain to ask which are actually held now. */
2966 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2972 #endif /* not USE_X_TOOLKIT */
2974 #endif /* HAVE_MENUS */
2979 staticpro (&menu_items
);
2981 menu_items_inuse
= Qnil
;
2983 Qdebug_on_next_call
= intern ("debug-on-next-call");
2984 staticpro (&Qdebug_on_next_call
);
2986 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2987 doc
: /* Frame for which we are updating a menu.
2988 The enable predicate for a menu command should check this variable. */);
2989 Vmenu_updating_frame
= Qnil
;
2991 #ifdef USE_X_TOOLKIT
2992 widget_id_tick
= (1<<16);
2993 next_menubar_widget_id
= 1;
2996 defsubr (&Sx_popup_menu
);
2998 defsubr (&Sx_popup_dialog
);