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 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 /* This holds a Lisp vector that holds the results of decoding
137 the keymaps or alist-of-alists that specify a menu.
139 It describes the panes and items within the panes.
141 Each pane is described by 3 elements in the vector:
142 t, the pane name, the pane's prefix key.
143 Then follow the pane's items, with 5 elements per item:
144 the item string, the enable flag, the item's value,
145 the definition, and the equivalent keyboard key's description string.
147 In some cases, multiple levels of menus may be described.
148 A single vector slot containing nil indicates the start of a submenu.
149 A single vector slot containing lambda indicates the end of a submenu.
150 The submenu follows a menu item which is the way to reach the submenu.
152 A single vector slot containing quote indicates that the
153 following items should appear on the right of a dialog box.
155 Using a Lisp vector to hold this information while we decode it
156 takes care of protecting all the data from GC. */
158 #define MENU_ITEMS_PANE_NAME 1
159 #define MENU_ITEMS_PANE_PREFIX 2
160 #define MENU_ITEMS_PANE_LENGTH 3
164 MENU_ITEMS_ITEM_NAME
= 0,
165 MENU_ITEMS_ITEM_ENABLE
,
166 MENU_ITEMS_ITEM_VALUE
,
167 MENU_ITEMS_ITEM_EQUIV_KEY
,
168 MENU_ITEMS_ITEM_DEFINITION
,
169 MENU_ITEMS_ITEM_TYPE
,
170 MENU_ITEMS_ITEM_SELECTED
,
171 MENU_ITEMS_ITEM_HELP
,
172 MENU_ITEMS_ITEM_LENGTH
175 static Lisp_Object menu_items
;
177 /* If non-nil, means that the global vars defined here are already in use.
178 Used to detect cases where we try to re-enter this non-reentrant code. */
179 static Lisp_Object menu_items_inuse
;
181 /* Number of slots currently allocated in menu_items. */
182 static int menu_items_allocated
;
184 /* This is the index in menu_items of the first empty slot. */
185 static int menu_items_used
;
187 /* The number of panes currently recorded in menu_items,
188 excluding those within submenus. */
189 static int menu_items_n_panes
;
191 /* Current depth within submenus. */
192 static int menu_items_submenu_depth
;
194 /* Flag which when set indicates a dialog or menu has been posted by
195 Xt on behalf of one of the widget sets. */
196 int popup_activated_flag
;
198 static int next_menubar_widget_id
;
200 /* This is set nonzero after the user activates the menu bar, and set
201 to zero again after the menu bars are redisplayed by prepare_menu_bar.
202 While it is nonzero, all calls to set_frame_menubar go deep.
204 I don't understand why this is needed, but it does seem to be
205 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
207 int pending_menu_activation
;
211 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
213 static struct frame
*
214 menubar_id_to_frame (id
)
217 Lisp_Object tail
, frame
;
220 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
223 if (!GC_FRAMEP (frame
))
226 if (!FRAME_WINDOW_P (f
))
228 if (f
->output_data
.x
->id
== id
)
236 /* Initialize the menu_items structure if we haven't already done so.
237 Also mark it as currently empty. */
242 if (NILP (menu_items
))
244 menu_items_allocated
= 60;
245 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
248 if (!NILP (menu_items_inuse
))
249 error ("Trying to use a menu from within a menu-entry");
250 menu_items_inuse
= Qt
;
252 menu_items_n_panes
= 0;
253 menu_items_submenu_depth
= 0;
256 /* Call at the end of generating the data in menu_items. */
264 unuse_menu_items (dummy
)
267 return menu_items_inuse
= Qnil
;
270 /* Call when finished using the data for the current menu
274 discard_menu_items ()
276 /* Free the structure if it is especially large.
277 Otherwise, hold on to it, to save time. */
278 if (menu_items_allocated
> 200)
281 menu_items_allocated
= 0;
283 xassert (NILP (menu_items_inuse
));
286 /* Make the menu_items vector twice as large. */
292 int old_size
= menu_items_allocated
;
295 menu_items_allocated
*= 2;
296 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
297 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
298 old_size
* sizeof (Lisp_Object
));
301 /* Begin a submenu. */
304 push_submenu_start ()
306 if (menu_items_used
+ 1 > menu_items_allocated
)
309 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
310 menu_items_submenu_depth
++;
318 if (menu_items_used
+ 1 > menu_items_allocated
)
321 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
322 menu_items_submenu_depth
--;
325 /* Indicate boundary between left and right. */
328 push_left_right_boundary ()
330 if (menu_items_used
+ 1 > menu_items_allocated
)
333 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
336 /* Start a new menu pane in menu_items.
337 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
340 push_menu_pane (name
, prefix_vec
)
341 Lisp_Object name
, prefix_vec
;
343 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
346 if (menu_items_submenu_depth
== 0)
347 menu_items_n_panes
++;
348 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
349 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
350 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
353 /* Push one menu item into the current pane. NAME is the string to
354 display. ENABLE if non-nil means this item can be selected. KEY
355 is the key generated by choosing this item, or nil if this item
356 doesn't really have a definition. DEF is the definition of this
357 item. EQUIV is the textual description of the keyboard equivalent
358 for this item (or nil if none). TYPE is the type of this menu
359 item, one of nil, `toggle' or `radio'. */
362 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
363 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
365 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
368 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
369 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
370 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
371 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
372 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
373 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
374 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
375 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
378 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
379 and generate menu panes for them in menu_items.
380 If NOTREAL is nonzero,
381 don't bother really computing whether an item is enabled. */
384 keymap_panes (keymaps
, nmaps
, notreal
)
385 Lisp_Object
*keymaps
;
393 /* Loop over the given keymaps, making a pane for each map.
394 But don't make a pane that is empty--ignore that map instead.
395 P is the number of panes we have made so far. */
396 for (mapno
= 0; mapno
< nmaps
; mapno
++)
397 single_keymap_panes (keymaps
[mapno
],
398 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
400 finish_menu_items ();
403 /* This is a recursive subroutine of keymap_panes.
404 It handles one keymap, KEYMAP.
405 The other arguments are passed along
406 or point to local variables of the previous function.
407 If NOTREAL is nonzero, only check for equivalent key bindings, don't
408 evaluate expressions in menu items and don't make any menu.
410 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
413 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
415 Lisp_Object pane_name
;
420 Lisp_Object pending_maps
= Qnil
;
421 Lisp_Object tail
, item
;
422 struct gcpro gcpro1
, gcpro2
;
428 push_menu_pane (pane_name
, prefix
);
431 /* Remember index for first item in this pane so we can go back and
432 add a prefix when (if) we see the first button. After that, notbuttons
433 is set to 0, to mark that we have seen a button and all non button
434 items need a prefix. */
435 notbuttons
= menu_items_used
;
438 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
440 GCPRO2 (keymap
, pending_maps
);
441 /* Look at each key binding, and if it is a menu item add it
445 single_menu_item (XCAR (item
), XCDR (item
),
446 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
447 else if (VECTORP (item
))
449 /* Loop over the char values represented in the vector. */
450 int len
= XVECTOR (item
)->size
;
452 for (c
= 0; c
< len
; c
++)
454 Lisp_Object character
;
455 XSETFASTINT (character
, c
);
456 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
457 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
463 /* Process now any submenus which want to be panes at this level. */
464 while (!NILP (pending_maps
))
466 Lisp_Object elt
, eltcdr
, string
;
467 elt
= Fcar (pending_maps
);
469 string
= XCAR (eltcdr
);
470 /* We no longer discard the @ from the beginning of the string here.
471 Instead, we do this in xmenu_show. */
472 single_keymap_panes (Fcar (elt
), string
,
473 XCDR (eltcdr
), notreal
, maxdepth
- 1);
474 pending_maps
= Fcdr (pending_maps
);
478 /* This is a subroutine of single_keymap_panes that handles one
480 KEY is a key in a keymap and ITEM is its binding.
481 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
483 If NOTREAL is nonzero, only check for equivalent key bindings, don't
484 evaluate expressions in menu items and don't make any menu.
485 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
486 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
487 buttons. It points to variable notbuttons in single_keymap_panes,
488 which keeps track of if we have seen a button in this menu or not. */
491 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
,
493 Lisp_Object key
, item
;
494 Lisp_Object
*pending_maps_ptr
;
495 int maxdepth
, notreal
;
498 Lisp_Object map
, item_string
, enabled
;
499 struct gcpro gcpro1
, gcpro2
;
502 /* Parse the menu item and leave the result in item_properties. */
504 res
= parse_menu_item (item
, notreal
, 0);
507 return; /* Not a menu item. */
509 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
513 /* We don't want to make a menu, just traverse the keymaps to
514 precompute equivalent key bindings. */
516 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
520 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
521 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
523 if (!NILP (map
) && SREF (item_string
, 0) == '@')
526 /* An enabled separate pane. Remember this to handle it later. */
527 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
533 /* Simulate radio buttons and toggle boxes by putting a prefix in
536 Lisp_Object prefix
= Qnil
;
537 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
541 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
544 /* The first button. Line up previous items in this menu. */
546 int index
= *notbuttons_ptr
; /* Index for first item this menu. */
549 while (index
< menu_items_used
)
552 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
556 submenu
++; /* Skip sub menu. */
558 else if (EQ (tem
, Qlambda
))
561 submenu
--; /* End sub menu. */
563 else if (EQ (tem
, Qt
))
564 index
+= 3; /* Skip new pane marker. */
565 else if (EQ (tem
, Qquote
))
566 index
++; /* Skip a left, right divider. */
569 if (!submenu
&& SREF (tem
, 0) != '\0'
570 && SREF (tem
, 0) != '-')
571 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
572 = concat2 (build_string (" "), tem
);
573 index
+= MENU_ITEMS_ITEM_LENGTH
;
579 /* Calculate prefix, if any, for this item. */
580 if (EQ (type
, QCtoggle
))
581 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
582 else if (EQ (type
, QCradio
))
583 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
585 /* Not a button. If we have earlier buttons, then we need a prefix. */
586 else if (!*notbuttons_ptr
&& SREF (item_string
, 0) != '\0'
587 && SREF (item_string
, 0) != '-')
588 prefix
= build_string (" ");
591 item_string
= concat2 (prefix
, item_string
);
593 #endif /* not HAVE_BOXES */
595 #ifndef USE_X_TOOLKIT
597 /* Indicate visually that this is a submenu. */
598 item_string
= concat2 (item_string
, build_string (" >"));
601 push_menu_item (item_string
, enabled
, key
,
602 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
603 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
604 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
605 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
606 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
609 /* Display a submenu using the toolkit. */
610 if (! (NILP (map
) || NILP (enabled
)))
612 push_submenu_start ();
613 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
619 /* Push all the panes and items of a menu described by the
620 alist-of-alists MENU.
621 This handles old-fashioned calls to x-popup-menu. */
631 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
633 Lisp_Object elt
, pane_name
, pane_data
;
635 pane_name
= Fcar (elt
);
636 CHECK_STRING (pane_name
);
637 push_menu_pane (pane_name
, Qnil
);
638 pane_data
= Fcdr (elt
);
639 CHECK_CONS (pane_data
);
640 list_of_items (pane_data
);
643 finish_menu_items ();
646 /* Push the items in a single pane defined by the alist PANE. */
652 Lisp_Object tail
, item
, item1
;
654 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
658 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
659 else if (NILP (item
))
660 push_left_right_boundary ();
665 CHECK_STRING (item1
);
666 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
671 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
672 doc
: /* Pop up a deck-of-cards menu and return user's selection.
673 POSITION is a position specification. This is either a mouse button event
674 or a list ((XOFFSET YOFFSET) WINDOW)
675 where XOFFSET and YOFFSET are positions in pixels from the top left
676 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)
677 This controls the position of the center of the first line
678 in the first pane of the menu, not the top left of the menu as a whole.
679 If POSITION is t, it means to use the current mouse position.
681 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
682 The menu items come from key bindings that have a menu string as well as
683 a definition; actually, the "definition" in such a key binding looks like
684 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
685 the keymap as a top-level element.
687 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
688 Otherwise, REAL-DEFINITION should be a valid key binding definition.
690 You can also use a list of keymaps as MENU.
691 Then each keymap makes a separate pane.
692 When MENU is a keymap or a list of keymaps, the return value
695 Alternatively, you can specify a menu of multiple panes
696 with a list of the form (TITLE PANE1 PANE2...),
697 where each pane is a list of form (TITLE ITEM1 ITEM2...).
698 Each ITEM is normally a cons cell (STRING . VALUE);
699 but a string can appear as an item--that makes a nonselectable line
701 With this form of menu, the return value is VALUE from the chosen item.
703 If POSITION is nil, don't display the menu at all, just precalculate the
704 cached information about equivalent key sequences. */)
706 Lisp_Object position
, menu
;
708 Lisp_Object keymap
, tem
;
709 int xpos
= 0, ypos
= 0;
712 Lisp_Object selection
;
714 Lisp_Object x
, y
, window
;
717 int specpdl_count
= SPECPDL_INDEX ();
721 if (! NILP (position
))
725 /* Decode the first argument: find the window and the coordinates. */
726 if (EQ (position
, Qt
)
727 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
728 || EQ (XCAR (position
), Qtool_bar
))))
730 /* Use the mouse's current position. */
731 FRAME_PTR new_f
= SELECTED_FRAME ();
732 Lisp_Object bar_window
;
733 enum scroll_bar_part part
;
736 if (mouse_position_hook
)
737 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
738 &part
, &x
, &y
, &time
);
740 XSETFRAME (window
, new_f
);
743 window
= selected_window
;
750 tem
= Fcar (position
);
753 window
= Fcar (Fcdr (position
));
755 y
= Fcar (Fcdr (tem
));
760 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
761 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
762 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
771 /* Decode where to put the menu. */
779 else if (WINDOWP (window
))
781 CHECK_LIVE_WINDOW (window
);
782 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
784 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
785 * XFASTINT (XWINDOW (window
)->left
));
786 ypos
= (FRAME_LINE_HEIGHT (f
)
787 * XFASTINT (XWINDOW (window
)->top
));
790 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
791 but I don't want to make one now. */
792 CHECK_WINDOW (window
);
797 Vmenu_updating_frame
= Qnil
;
798 #endif /* HAVE_MENUS */
800 record_unwind_protect (unuse_menu_items
, Qnil
);
804 /* Decode the menu items from what was specified. */
806 keymap
= get_keymap (menu
, 0, 0);
809 /* We were given a keymap. Extract menu info from the keymap. */
812 /* Extract the detailed info to make one pane. */
813 keymap_panes (&menu
, 1, NILP (position
));
815 /* Search for a string appearing directly as an element of the keymap.
816 That string is the title of the menu. */
817 prompt
= Fkeymap_prompt (keymap
);
818 if (NILP (title
) && !NILP (prompt
))
821 /* Make that be the pane title of the first pane. */
822 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
823 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
827 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
829 /* We were given a list of keymaps. */
830 int nmaps
= XFASTINT (Flength (menu
));
832 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
837 /* The first keymap that has a prompt string
838 supplies the menu title. */
839 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
843 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
845 prompt
= Fkeymap_prompt (keymap
);
846 if (NILP (title
) && !NILP (prompt
))
850 /* Extract the detailed info to make one pane. */
851 keymap_panes (maps
, nmaps
, NILP (position
));
853 /* Make the title be the pane title of the first pane. */
854 if (!NILP (title
) && menu_items_n_panes
>= 0)
855 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
861 /* We were given an old-fashioned menu. */
863 CHECK_STRING (title
);
865 list_of_panes (Fcdr (menu
));
870 unbind_to (specpdl_count
, Qnil
);
874 discard_menu_items ();
880 /* Display them in a menu. */
883 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
884 keymaps
, title
, &error_name
);
887 discard_menu_items ();
890 #endif /* HAVE_MENUS */
892 if (error_name
) error (error_name
);
898 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
899 doc
: /* Pop up a dialog box and return user's selection.
900 POSITION specifies which frame to use.
901 This is normally a mouse button event or a window or frame.
902 If POSITION is t, it means to use the frame the mouse is on.
903 The dialog box appears in the middle of the specified frame.
905 CONTENTS specifies the alternatives to display in the dialog box.
906 It is a list of the form (TITLE ITEM1 ITEM2...).
907 Each ITEM is a cons cell (STRING . VALUE).
908 The return value is VALUE from the chosen item.
910 An ITEM may also be just a string--that makes a nonselectable item.
911 An ITEM may also be nil--that means to put all preceding items
912 on the left of the dialog box and all following items on the right.
913 \(By default, approximately half appear on each side.) */)
915 Lisp_Object position
, contents
;
922 /* Decode the first argument: find the window or frame to use. */
923 if (EQ (position
, Qt
)
924 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
925 || EQ (XCAR (position
), Qtool_bar
))))
927 #if 0 /* Using the frame the mouse is on may not be right. */
928 /* Use the mouse's current position. */
929 FRAME_PTR new_f
= SELECTED_FRAME ();
930 Lisp_Object bar_window
;
931 enum scroll_bar_part part
;
935 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
938 XSETFRAME (window
, new_f
);
940 window
= selected_window
;
942 window
= selected_window
;
944 else if (CONSP (position
))
947 tem
= Fcar (position
);
949 window
= Fcar (Fcdr (position
));
952 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
953 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
956 else if (WINDOWP (position
) || FRAMEP (position
))
961 /* Decode where to put the menu. */
965 else if (WINDOWP (window
))
967 CHECK_LIVE_WINDOW (window
);
968 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
971 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
972 but I don't want to make one now. */
973 CHECK_WINDOW (window
);
975 #ifndef USE_X_TOOLKIT
976 /* Display a menu with these alternatives
977 in the middle of frame F. */
979 Lisp_Object x
, y
, frame
, newpos
;
980 XSETFRAME (frame
, f
);
981 XSETINT (x
, x_pixel_width (f
) / 2);
982 XSETINT (y
, x_pixel_height (f
) / 2);
983 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
985 return Fx_popup_menu (newpos
,
986 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
992 Lisp_Object selection
;
993 int specpdl_count
= SPECPDL_INDEX ();
995 /* Decode the dialog items from what was specified. */
996 title
= Fcar (contents
);
997 CHECK_STRING (title
);
998 record_unwind_protect (unuse_menu_items
, Qnil
);
1000 list_of_panes (Fcons (contents
, Qnil
));
1002 /* Display them in a dialog box. */
1004 selection
= xdialog_show (f
, 0, title
, &error_name
);
1007 unbind_to (specpdl_count
, Qnil
);
1008 discard_menu_items ();
1010 if (error_name
) error (error_name
);
1016 #ifdef USE_X_TOOLKIT
1018 /* Loop in Xt until the menu pulldown or dialog popup has been
1019 popped down (deactivated). This is used for x-popup-menu
1020 and x-popup-dialog; it is not used for the menu bar any more.
1022 NOTE: All calls to popup_get_selection should be protected
1023 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1026 popup_get_selection (initial_event
, dpyinfo
, id
)
1027 XEvent
*initial_event
;
1028 struct x_display_info
*dpyinfo
;
1033 /* Define a queue to save up for later unreading
1034 all X events that don't pertain to the menu. */
1038 struct event_queue
*next
;
1041 struct event_queue
*queue
= NULL
;
1042 struct event_queue
*queue_tmp
;
1045 event
= *initial_event
;
1047 XtAppNextEvent (Xt_app_con
, &event
);
1051 /* Handle expose events for editor frames right away. */
1052 if (event
.type
== Expose
)
1053 process_expose_from_menu (event
);
1054 /* Make sure we don't consider buttons grabbed after menu goes.
1055 And make sure to deactivate for any ButtonRelease,
1056 even if XtDispatchEvent doesn't do that. */
1057 else if (event
.type
== ButtonRelease
1058 && dpyinfo
->display
== event
.xbutton
.display
)
1060 dpyinfo
->grabbed
&= ~(1 << event
.xbutton
.button
);
1061 popup_activated_flag
= 0;
1062 #ifdef USE_MOTIF /* Pretending that the event came from a
1063 Btn1Down seems the only way to convince Motif to
1064 activate its callbacks; setting the XmNmenuPost
1065 isn't working. --marcus@sysc.pdx.edu. */
1066 event
.xbutton
.button
= 1;
1069 /* If the user presses a key, deactivate the menu.
1070 The user is likely to do that if we get wedged. */
1071 else if (event
.type
== KeyPress
1072 && dpyinfo
->display
== event
.xbutton
.display
)
1074 KeySym keysym
= XLookupKeysym (&event
.xkey
, 0);
1075 if (!IsModifierKey (keysym
))
1077 popup_activated_flag
= 0;
1081 /* Button presses outside the menu also pop it down. */
1082 else if (event
.type
== ButtonPress
1083 && event
.xany
.display
== dpyinfo
->display
1084 && x_any_window_to_frame (dpyinfo
, event
.xany
.window
))
1086 popup_activated_flag
= 0;
1090 /* Queue all events not for this popup,
1091 except for Expose, which we've already handled, and ButtonRelease.
1092 Note that the X window is associated with the frame if this
1093 is a menu bar popup, but not if it's a dialog box. So we use
1094 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1095 if (event
.type
!= Expose
1096 && !(event
.type
== ButtonRelease
1097 && dpyinfo
->display
== event
.xbutton
.display
)
1098 && (event
.xany
.display
!= dpyinfo
->display
1099 || x_non_menubar_window_to_frame (dpyinfo
, event
.xany
.window
)))
1101 queue_tmp
= (struct event_queue
*) xmalloc (sizeof *queue_tmp
);
1102 queue_tmp
->event
= event
;
1103 queue_tmp
->next
= queue
;
1107 XtDispatchEvent (&event
);
1109 if (!popup_activated ())
1111 XtAppNextEvent (Xt_app_con
, &event
);
1114 /* Unread any events that we got but did not handle. */
1115 while (queue
!= NULL
)
1118 XPutBackEvent (queue_tmp
->event
.xany
.display
, &queue_tmp
->event
);
1119 queue
= queue_tmp
->next
;
1120 xfree ((char *)queue_tmp
);
1121 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1122 interrupt_input_pending
= 1;
1126 /* Activate the menu bar of frame F.
1127 This is called from keyboard.c when it gets the
1128 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1130 To activate the menu bar, we use the X button-press event
1131 that was saved in saved_menu_event.
1132 That makes the toolkit do its thing.
1134 But first we recompute the menu bar contents (the whole tree).
1136 The reason for saving the button event until here, instead of
1137 passing it to the toolkit right away, is that we can safely
1138 execute Lisp code. */
1141 x_activate_menubar (f
)
1144 if (!f
->output_data
.x
->saved_menu_event
->type
)
1147 set_frame_menubar (f
, 0, 1);
1149 XtDispatchEvent (f
->output_data
.x
->saved_menu_event
);
1152 if (f
->output_data
.x
->saved_menu_event
->type
== ButtonRelease
)
1153 pending_menu_activation
= 1;
1156 /* Ignore this if we get it a second time. */
1157 f
->output_data
.x
->saved_menu_event
->type
= 0;
1160 /* Detect if a dialog or menu has been posted. */
1165 return popup_activated_flag
;
1168 /* This callback is invoked when the user selects a menubar cascade
1169 pushbutton, but before the pulldown menu is posted. */
1172 popup_activate_callback (widget
, id
, client_data
)
1175 XtPointer client_data
;
1177 popup_activated_flag
= 1;
1180 /* This callback is invoked when a dialog or menu is finished being
1181 used and has been unposted. */
1184 popup_deactivate_callback (widget
, id
, client_data
)
1187 XtPointer client_data
;
1189 popup_activated_flag
= 0;
1192 /* Lwlib callback called when menu items are highlighted/unhighlighted
1193 while moving the mouse over them. WIDGET is the menu bar or menu
1194 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1195 the widget_value structure for the menu item, or null in case of
1199 menu_highlight_callback (widget
, id
, call_data
)
1204 widget_value
*wv
= (widget_value
*) call_data
;
1206 Lisp_Object frame
, help
;
1208 help
= wv
? wv
->help
: Qnil
;
1210 /* Determine the frame for the help event. */
1211 f
= menubar_id_to_frame (id
);
1214 XSETFRAME (frame
, f
);
1215 kbd_buffer_store_help_event (frame
, help
);
1219 /* WIDGET is the popup menu. It's parent is the frame's
1220 widget. See which frame that is. */
1221 Widget frame_widget
= XtParent (widget
);
1224 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
1226 frame
= XCAR (tail
);
1227 if (GC_FRAMEP (frame
)
1228 && (f
= XFRAME (frame
),
1229 FRAME_X_P (f
) && f
->output_data
.x
->widget
== frame_widget
))
1233 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
1237 /* This callback is called from the menu bar pulldown menu
1238 when the user makes a selection.
1239 Figure out what the user chose
1240 and put the appropriate events into the keyboard buffer. */
1243 menubar_selection_callback (widget
, id
, client_data
)
1246 XtPointer client_data
;
1248 Lisp_Object prefix
, entry
;
1249 FRAME_PTR f
= menubar_id_to_frame (id
);
1251 Lisp_Object
*subprefix_stack
;
1252 int submenu_depth
= 0;
1258 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1259 vector
= f
->menu_bar_vector
;
1262 while (i
< f
->menu_bar_items_used
)
1264 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1266 subprefix_stack
[submenu_depth
++] = prefix
;
1270 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1272 prefix
= subprefix_stack
[--submenu_depth
];
1275 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1277 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1278 i
+= MENU_ITEMS_PANE_LENGTH
;
1282 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1283 /* The EMACS_INT cast avoids a warning. There's no problem
1284 as long as pointers have enough bits to hold small integers. */
1285 if ((int) (EMACS_INT
) client_data
== i
)
1288 struct input_event buf
;
1291 XSETFRAME (frame
, f
);
1292 buf
.kind
= MENU_BAR_EVENT
;
1293 buf
.frame_or_window
= frame
;
1295 kbd_buffer_store_event (&buf
);
1297 for (j
= 0; j
< submenu_depth
; j
++)
1298 if (!NILP (subprefix_stack
[j
]))
1300 buf
.kind
= MENU_BAR_EVENT
;
1301 buf
.frame_or_window
= frame
;
1302 buf
.arg
= subprefix_stack
[j
];
1303 kbd_buffer_store_event (&buf
);
1308 buf
.kind
= MENU_BAR_EVENT
;
1309 buf
.frame_or_window
= frame
;
1311 kbd_buffer_store_event (&buf
);
1314 buf
.kind
= MENU_BAR_EVENT
;
1315 buf
.frame_or_window
= frame
;
1317 kbd_buffer_store_event (&buf
);
1321 i
+= MENU_ITEMS_ITEM_LENGTH
;
1326 /* Allocate a widget_value, blocking input. */
1329 xmalloc_widget_value ()
1331 widget_value
*value
;
1334 value
= malloc_widget_value ();
1340 /* This recursively calls free_widget_value on the tree of widgets.
1341 It must free all data that was malloc'ed for these widget_values.
1342 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1343 must be left alone. */
1346 free_menubar_widget_value_tree (wv
)
1351 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1353 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1355 free_menubar_widget_value_tree (wv
->contents
);
1356 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1360 free_menubar_widget_value_tree (wv
->next
);
1361 wv
->next
= (widget_value
*) 0xDEADBEEF;
1364 free_widget_value (wv
);
1368 /* Set up data in menu_items for a menu bar item
1369 whose event type is ITEM_KEY (with string ITEM_NAME)
1370 and whose contents come from the list of keymaps MAPS. */
1373 parse_single_submenu (item_key
, item_name
, maps
)
1374 Lisp_Object item_key
, item_name
, maps
;
1378 Lisp_Object
*mapvec
;
1380 int top_level_items
= 0;
1382 length
= Flength (maps
);
1383 len
= XINT (length
);
1385 /* Convert the list MAPS into a vector MAPVEC. */
1386 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1387 for (i
= 0; i
< len
; i
++)
1389 mapvec
[i
] = Fcar (maps
);
1393 /* Loop over the given keymaps, making a pane for each map.
1394 But don't make a pane that is empty--ignore that map instead. */
1395 for (i
= 0; i
< len
; i
++)
1397 if (!KEYMAPP (mapvec
[i
]))
1399 /* Here we have a command at top level in the menu bar
1400 as opposed to a submenu. */
1401 top_level_items
= 1;
1402 push_menu_pane (Qnil
, Qnil
);
1403 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1404 Qnil
, Qnil
, Qnil
, Qnil
);
1407 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1410 return top_level_items
;
1413 /* Create a tree of widget_value objects
1414 representing the panes and items
1415 in menu_items starting at index START, up to index END. */
1417 static widget_value
*
1418 digest_single_submenu (start
, end
, top_level_items
)
1419 int start
, end
, top_level_items
;
1421 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1423 int submenu_depth
= 0;
1424 widget_value
**submenu_stack
;
1427 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1428 wv
= xmalloc_widget_value ();
1432 wv
->button_type
= BUTTON_TYPE_NONE
;
1438 /* Loop over all panes and items made during this call
1439 and construct a tree of widget_value objects.
1440 Ignore the panes and items made by previous calls to
1441 single_submenu, even though those are also in menu_items. */
1445 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1447 submenu_stack
[submenu_depth
++] = save_wv
;
1452 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1455 save_wv
= submenu_stack
[--submenu_depth
];
1458 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1459 && submenu_depth
!= 0)
1460 i
+= MENU_ITEMS_PANE_LENGTH
;
1461 /* Ignore a nil in the item list.
1462 It's meaningful only for dialog boxes. */
1463 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1465 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1467 /* Create a new pane. */
1468 Lisp_Object pane_name
, prefix
;
1471 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1472 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1474 #ifndef HAVE_MULTILINGUAL_MENU
1475 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1477 pane_name
= ENCODE_SYSTEM (pane_name
);
1478 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1481 pane_string
= (NILP (pane_name
)
1482 ? "" : (char *) SDATA (pane_name
));
1483 /* If there is just one top-level pane, put all its items directly
1484 under the top-level menu. */
1485 if (menu_items_n_panes
== 1)
1488 /* If the pane has a meaningful name,
1489 make the pane a top-level menu item
1490 with its items as a submenu beneath it. */
1491 if (strcmp (pane_string
, ""))
1493 wv
= xmalloc_widget_value ();
1497 first_wv
->contents
= wv
;
1498 wv
->name
= pane_string
;
1499 /* Ignore the @ that means "separate pane".
1500 This is a kludge, but this isn't worth more time. */
1501 if (!NILP (prefix
) && wv
->name
[0] == '@')
1505 wv
->button_type
= BUTTON_TYPE_NONE
;
1510 i
+= MENU_ITEMS_PANE_LENGTH
;
1514 /* Create a new item within current pane. */
1515 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1518 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1519 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1520 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1521 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1522 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1523 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1524 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1526 #ifndef HAVE_MULTILINGUAL_MENU
1527 if (STRING_MULTIBYTE (item_name
))
1529 item_name
= ENCODE_SYSTEM (item_name
);
1530 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1533 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1535 descrip
= ENCODE_SYSTEM (descrip
);
1536 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1538 #endif /* not HAVE_MULTILINGUAL_MENU */
1540 wv
= xmalloc_widget_value ();
1544 save_wv
->contents
= wv
;
1546 wv
->name
= (char *) SDATA (item_name
);
1547 if (!NILP (descrip
))
1548 wv
->key
= (char *) SDATA (descrip
);
1550 /* The EMACS_INT cast avoids a warning. There's no problem
1551 as long as pointers have enough bits to hold small integers. */
1552 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1553 wv
->enabled
= !NILP (enable
);
1556 wv
->button_type
= BUTTON_TYPE_NONE
;
1557 else if (EQ (type
, QCradio
))
1558 wv
->button_type
= BUTTON_TYPE_RADIO
;
1559 else if (EQ (type
, QCtoggle
))
1560 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1564 wv
->selected
= !NILP (selected
);
1565 if (! STRINGP (help
))
1572 i
+= MENU_ITEMS_ITEM_LENGTH
;
1576 /* If we have just one "menu item"
1577 that was originally a button, return it by itself. */
1578 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1580 wv
= first_wv
->contents
;
1581 free_widget_value (first_wv
);
1588 /* Recompute all the widgets of frame F, when the menu bar has been
1589 changed. Value is non-zero if widgets were updated. */
1592 update_frame_menubar (f
)
1595 struct x_output
*x
= f
->output_data
.x
;
1598 if (!x
->menubar_widget
|| XtIsManaged (x
->menubar_widget
))
1602 /* Save the size of the frame because the pane widget doesn't accept
1603 to resize itself. So force it. */
1607 /* Do the voodoo which means "I'm changing lots of things, don't try
1608 to refigure sizes until I'm done." */
1609 lw_refigure_widget (x
->column_widget
, False
);
1611 /* The order in which children are managed is the top to bottom
1612 order in which they are displayed in the paned window. First,
1613 remove the text-area widget. */
1614 XtUnmanageChild (x
->edit_widget
);
1616 /* Remove the menubar that is there now, and put up the menubar that
1618 XtManageChild (x
->menubar_widget
);
1619 XtMapWidget (x
->menubar_widget
);
1620 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, NULL
);
1622 /* Re-manage the text-area widget, and then thrash the sizes. */
1623 XtManageChild (x
->edit_widget
);
1624 lw_refigure_widget (x
->column_widget
, True
);
1626 /* Force the pane widget to resize itself with the right values. */
1627 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1632 /* Set the contents of the menubar widgets of frame F.
1633 The argument FIRST_TIME is currently ignored;
1634 it is set the first time this is called, from initialize_frame_menubar. */
1637 set_frame_menubar (f
, first_time
, deep_p
)
1642 Widget menubar_widget
= f
->output_data
.x
->menubar_widget
;
1644 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1646 int *submenu_start
, *submenu_end
;
1647 int *submenu_top_level_items
;
1651 XSETFRAME (Vmenu_updating_frame
, f
);
1653 if (f
->output_data
.x
->id
== 0)
1654 f
->output_data
.x
->id
= next_menubar_widget_id
++;
1655 id
= f
->output_data
.x
->id
;
1657 if (! menubar_widget
)
1659 else if (pending_menu_activation
&& !deep_p
)
1661 /* Make the first call for any given frame always go deep. */
1662 else if (!f
->output_data
.x
->saved_menu_event
&& !deep_p
)
1665 f
->output_data
.x
->saved_menu_event
= (XEvent
*)xmalloc (sizeof (XEvent
));
1666 f
->output_data
.x
->saved_menu_event
->type
= 0;
1671 /* Make a widget-value tree representing the entire menu trees. */
1673 struct buffer
*prev
= current_buffer
;
1675 int specpdl_count
= SPECPDL_INDEX ();
1676 int previous_menu_items_used
= f
->menu_bar_items_used
;
1677 Lisp_Object
*previous_items
1678 = (Lisp_Object
*) alloca (previous_menu_items_used
1679 * sizeof (Lisp_Object
));
1681 /* If we are making a new widget, its contents are empty,
1682 do always reinitialize them. */
1683 if (! menubar_widget
)
1684 previous_menu_items_used
= 0;
1686 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1687 specbind (Qinhibit_quit
, Qt
);
1688 /* Don't let the debugger step into this code
1689 because it is not reentrant. */
1690 specbind (Qdebug_on_next_call
, Qnil
);
1692 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1693 record_unwind_protect (unuse_menu_items
, Qnil
);
1694 if (NILP (Voverriding_local_map_menu_flag
))
1696 specbind (Qoverriding_terminal_local_map
, Qnil
);
1697 specbind (Qoverriding_local_map
, Qnil
);
1700 set_buffer_internal_1 (XBUFFER (buffer
));
1702 /* Run the Lucid hook. */
1703 safe_run_hooks (Qactivate_menubar_hook
);
1705 /* If it has changed current-menubar from previous value,
1706 really recompute the menubar from the value. */
1707 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1708 call0 (Qrecompute_lucid_menubar
);
1709 safe_run_hooks (Qmenu_bar_update_hook
);
1710 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1712 items
= FRAME_MENU_BAR_ITEMS (f
);
1714 /* Save the frame's previous menu bar contents data. */
1715 if (previous_menu_items_used
)
1716 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1717 previous_menu_items_used
* sizeof (Lisp_Object
));
1719 /* Fill in menu_items with the current menu bar contents.
1720 This can evaluate Lisp code. */
1721 menu_items
= f
->menu_bar_vector
;
1722 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1723 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1724 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1725 submenu_top_level_items
1726 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1728 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1730 Lisp_Object key
, string
, maps
;
1734 key
= XVECTOR (items
)->contents
[i
];
1735 string
= XVECTOR (items
)->contents
[i
+ 1];
1736 maps
= XVECTOR (items
)->contents
[i
+ 2];
1740 submenu_start
[i
] = menu_items_used
;
1742 menu_items_n_panes
= 0;
1743 submenu_top_level_items
[i
]
1744 = parse_single_submenu (key
, string
, maps
);
1746 submenu_end
[i
] = menu_items_used
;
1749 finish_menu_items ();
1751 /* Convert menu_items into widget_value trees
1752 to display the menu. This cannot evaluate Lisp code. */
1754 wv
= xmalloc_widget_value ();
1755 wv
->name
= "menubar";
1758 wv
->button_type
= BUTTON_TYPE_NONE
;
1762 for (i
= 0; i
< last_i
; i
+= 4)
1764 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1765 submenu_top_level_items
[i
]);
1769 first_wv
->contents
= wv
;
1770 /* Don't set wv->name here; GC during the loop might relocate it. */
1772 wv
->button_type
= BUTTON_TYPE_NONE
;
1776 set_buffer_internal_1 (prev
);
1777 unbind_to (specpdl_count
, Qnil
);
1779 /* If there has been no change in the Lisp-level contents
1780 of the menu bar, skip redisplaying it. Just exit. */
1782 for (i
= 0; i
< previous_menu_items_used
; i
++)
1783 if (menu_items_used
== i
1784 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1786 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1788 free_menubar_widget_value_tree (first_wv
);
1789 discard_menu_items ();
1794 /* Now GC cannot happen during the lifetime of the widget_value,
1795 so it's safe to store data from a Lisp_String. */
1796 wv
= first_wv
->contents
;
1797 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1800 string
= XVECTOR (items
)->contents
[i
+ 1];
1803 wv
->name
= (char *) SDATA (string
);
1807 f
->menu_bar_vector
= menu_items
;
1808 f
->menu_bar_items_used
= menu_items_used
;
1809 discard_menu_items ();
1813 /* Make a widget-value tree containing
1814 just the top level menu bar strings. */
1816 wv
= xmalloc_widget_value ();
1817 wv
->name
= "menubar";
1820 wv
->button_type
= BUTTON_TYPE_NONE
;
1824 items
= FRAME_MENU_BAR_ITEMS (f
);
1825 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1829 string
= XVECTOR (items
)->contents
[i
+ 1];
1833 wv
= xmalloc_widget_value ();
1834 wv
->name
= (char *) SDATA (string
);
1837 wv
->button_type
= BUTTON_TYPE_NONE
;
1839 /* This prevents lwlib from assuming this
1840 menu item is really supposed to be empty. */
1841 /* The EMACS_INT cast avoids a warning.
1842 This value just has to be different from small integers. */
1843 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1848 first_wv
->contents
= wv
;
1852 /* Forget what we thought we knew about what is in the
1853 detailed contents of the menu bar menus.
1854 Changing the top level always destroys the contents. */
1855 f
->menu_bar_items_used
= 0;
1858 /* Create or update the menu bar widget. */
1864 /* Disable resizing (done for Motif!) */
1865 lw_allow_resizing (f
->output_data
.x
->widget
, False
);
1867 /* The third arg is DEEP_P, which says to consider the entire
1868 menu trees we supply, rather than just the menu bar item names. */
1869 lw_modify_all_widgets (id
, first_wv
, deep_p
);
1871 /* Re-enable the edit widget to resize. */
1872 lw_allow_resizing (f
->output_data
.x
->widget
, True
);
1876 menubar_widget
= lw_create_widget ("menubar", "menubar", id
, first_wv
,
1877 f
->output_data
.x
->column_widget
,
1879 popup_activate_callback
,
1880 menubar_selection_callback
,
1881 popup_deactivate_callback
,
1882 menu_highlight_callback
);
1883 f
->output_data
.x
->menubar_widget
= menubar_widget
;
1888 = (f
->output_data
.x
->menubar_widget
1889 ? (f
->output_data
.x
->menubar_widget
->core
.height
1890 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
1893 #if 0 /* Experimentally, we now get the right results
1894 for -geometry -0-0 without this. 24 Aug 96, rms. */
1896 if (FRAME_EXTERNAL_MENU_BAR (f
))
1899 XtVaGetValues (f
->output_data
.x
->column_widget
,
1900 XtNinternalBorderWidth
, &ibw
, NULL
);
1901 menubar_size
+= ibw
;
1903 #endif /* USE_LUCID */
1906 f
->output_data
.x
->menubar_height
= menubar_size
;
1909 free_menubar_widget_value_tree (first_wv
);
1910 update_frame_menubar (f
);
1915 /* Called from Fx_create_frame to create the initial menubar of a frame
1916 before it is mapped, so that the window is mapped with the menubar already
1917 there instead of us tacking it on later and thrashing the window after it
1921 initialize_frame_menubar (f
)
1924 /* This function is called before the first chance to redisplay
1925 the frame. It has to be, so the frame will have the right size. */
1926 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1927 set_frame_menubar (f
, 1, 1);
1931 /* Get rid of the menu bar of frame F, and free its storage.
1932 This is used when deleting a frame, and when turning off the menu bar. */
1935 free_frame_menubar (f
)
1938 Widget menubar_widget
;
1940 menubar_widget
= f
->output_data
.x
->menubar_widget
;
1942 f
->output_data
.x
->menubar_height
= 0;
1947 /* Removing the menu bar magically changes the shell widget's x
1948 and y position of (0, 0) which, when the menu bar is turned
1949 on again, leads to pull-down menuss appearing in strange
1950 positions near the upper-left corner of the display. This
1951 happens only with some window managers like twm and ctwm,
1952 but not with other like Motif's mwm or kwm, because the
1953 latter generate ConfigureNotify events when the menu bar
1954 is switched off, which fixes the shell position. */
1955 Position x0
, y0
, x1
, y1
;
1961 if (f
->output_data
.x
->widget
)
1962 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x0
, XtNy
, &y0
, NULL
);
1965 lw_destroy_all_widgets ((LWLIB_ID
) f
->output_data
.x
->id
);
1966 f
->output_data
.x
->menubar_widget
= NULL
;
1969 if (f
->output_data
.x
->widget
)
1971 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x1
, XtNy
, &y1
, NULL
);
1972 if (x1
== 0 && y1
== 0)
1973 XtVaSetValues (f
->output_data
.x
->widget
, XtNx
, x0
, XtNy
, y0
, NULL
);
1981 #endif /* USE_X_TOOLKIT */
1983 /* xmenu_show actually displays a menu using the panes and items in menu_items
1984 and returns the value selected from it.
1985 There are two versions of xmenu_show, one for Xt and one for Xlib.
1986 Both assume input is blocked by the caller. */
1988 /* F is the frame the menu is for.
1989 X and Y are the frame-relative specified position,
1990 relative to the inside upper left corner of the frame F.
1991 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1992 KEYMAPS is 1 if this menu was specified with keymaps;
1993 in that case, we return a list containing the chosen item's value
1994 and perhaps also the pane's prefix.
1995 TITLE is the specified menu title.
1996 ERROR is a place to store an error message string in case of failure.
1997 (We return nil on failure, but the value doesn't actually matter.) */
1999 #ifdef USE_X_TOOLKIT
2001 /* We need a unique id for each widget handled by the Lucid Widget
2004 For the main windows, and popup menus, we use this counter,
2005 which we increment each time after use. This starts from 1<<16.
2007 For menu bars, we use numbers starting at 0, counted in
2008 next_menubar_widget_id. */
2009 LWLIB_ID widget_id_tick
;
2011 static Lisp_Object
*volatile menu_item_selection
;
2014 popup_selection_callback (widget
, id
, client_data
)
2017 XtPointer client_data
;
2019 menu_item_selection
= (Lisp_Object
*) client_data
;
2023 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2037 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
2038 widget_value
**submenu_stack
2039 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
2040 Lisp_Object
*subprefix_stack
2041 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
2042 int submenu_depth
= 0;
2043 XButtonPressedEvent dummy
;
2049 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2051 *error
= "Empty menu";
2055 /* Create a tree of widget_value objects
2056 representing the panes and their items. */
2057 wv
= xmalloc_widget_value ();
2061 wv
->button_type
= BUTTON_TYPE_NONE
;
2066 /* Loop over all panes and items, filling in the tree. */
2068 while (i
< menu_items_used
)
2070 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2072 submenu_stack
[submenu_depth
++] = save_wv
;
2078 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2081 save_wv
= submenu_stack
[--submenu_depth
];
2085 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
2086 && submenu_depth
!= 0)
2087 i
+= MENU_ITEMS_PANE_LENGTH
;
2088 /* Ignore a nil in the item list.
2089 It's meaningful only for dialog boxes. */
2090 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2092 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2094 /* Create a new pane. */
2095 Lisp_Object pane_name
, prefix
;
2098 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
2099 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2101 #ifndef HAVE_MULTILINGUAL_MENU
2102 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
2104 pane_name
= ENCODE_SYSTEM (pane_name
);
2105 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
2108 pane_string
= (NILP (pane_name
)
2109 ? "" : (char *) SDATA (pane_name
));
2110 /* If there is just one top-level pane, put all its items directly
2111 under the top-level menu. */
2112 if (menu_items_n_panes
== 1)
2115 /* If the pane has a meaningful name,
2116 make the pane a top-level menu item
2117 with its items as a submenu beneath it. */
2118 if (!keymaps
&& strcmp (pane_string
, ""))
2120 wv
= xmalloc_widget_value ();
2124 first_wv
->contents
= wv
;
2125 wv
->name
= pane_string
;
2126 if (keymaps
&& !NILP (prefix
))
2130 wv
->button_type
= BUTTON_TYPE_NONE
;
2135 else if (first_pane
)
2141 i
+= MENU_ITEMS_PANE_LENGTH
;
2145 /* Create a new item within current pane. */
2146 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
2147 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2148 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2149 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2150 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
2151 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
2152 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
2153 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2155 #ifndef HAVE_MULTILINGUAL_MENU
2156 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2158 item_name
= ENCODE_SYSTEM (item_name
);
2159 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2162 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2164 descrip
= ENCODE_SYSTEM (descrip
);
2165 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2167 #endif /* not HAVE_MULTILINGUAL_MENU */
2169 wv
= xmalloc_widget_value ();
2173 save_wv
->contents
= wv
;
2174 wv
->name
= (char *) SDATA (item_name
);
2175 if (!NILP (descrip
))
2176 wv
->key
= (char *) SDATA (descrip
);
2178 /* If this item has a null value,
2179 make the call_data null so that it won't display a box
2180 when the mouse is on it. */
2182 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
2183 wv
->enabled
= !NILP (enable
);
2186 wv
->button_type
= BUTTON_TYPE_NONE
;
2187 else if (EQ (type
, QCtoggle
))
2188 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2189 else if (EQ (type
, QCradio
))
2190 wv
->button_type
= BUTTON_TYPE_RADIO
;
2194 wv
->selected
= !NILP (selected
);
2196 if (! STRINGP (help
))
2203 i
+= MENU_ITEMS_ITEM_LENGTH
;
2207 /* Deal with the title, if it is non-nil. */
2210 widget_value
*wv_title
= xmalloc_widget_value ();
2211 widget_value
*wv_sep1
= xmalloc_widget_value ();
2212 widget_value
*wv_sep2
= xmalloc_widget_value ();
2214 wv_sep2
->name
= "--";
2215 wv_sep2
->next
= first_wv
->contents
;
2216 wv_sep2
->help
= Qnil
;
2218 wv_sep1
->name
= "--";
2219 wv_sep1
->next
= wv_sep2
;
2220 wv_sep1
->help
= Qnil
;
2222 #ifndef HAVE_MULTILINGUAL_MENU
2223 if (STRING_MULTIBYTE (title
))
2224 title
= ENCODE_SYSTEM (title
);
2227 wv_title
->name
= (char *) SDATA (title
);
2228 wv_title
->enabled
= TRUE
;
2229 wv_title
->button_type
= BUTTON_TYPE_NONE
;
2230 wv_title
->next
= wv_sep1
;
2231 wv_title
->help
= Qnil
;
2232 first_wv
->contents
= wv_title
;
2235 /* Actually create the menu. */
2236 menu_id
= widget_id_tick
++;
2237 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
2238 f
->output_data
.x
->widget
, 1, 0,
2239 popup_selection_callback
,
2240 popup_deactivate_callback
,
2241 menu_highlight_callback
);
2243 /* Adjust coordinates to relative to the outer (window manager) window. */
2246 int win_x
= 0, win_y
= 0;
2248 /* Find the position of the outside upper-left corner of
2249 the inner window, with respect to the outer window. */
2250 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2253 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2255 /* From-window, to-window. */
2256 f
->output_data
.x
->window_desc
,
2257 f
->output_data
.x
->parent_desc
,
2259 /* From-position, to-position. */
2260 0, 0, &win_x
, &win_y
,
2262 /* Child of window. */
2270 /* Adjust coordinates to be root-window-relative. */
2271 x
+= f
->output_data
.x
->left_pos
;
2272 y
+= f
->output_data
.x
->top_pos
;
2274 dummy
.type
= ButtonPress
;
2276 dummy
.send_event
= 0;
2277 dummy
.display
= FRAME_X_DISPLAY (f
);
2278 dummy
.time
= CurrentTime
;
2279 dummy
.root
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
2280 dummy
.window
= dummy
.root
;
2281 dummy
.subwindow
= dummy
.root
;
2286 dummy
.state
= (FRAME_X_DISPLAY_INFO (f
)->grabbed
>> 1) * Button1Mask
;
2288 for (i
= 0; i
< 5; i
++)
2289 if (FRAME_X_DISPLAY_INFO (f
)->grabbed
& (1 << i
))
2292 /* Don't allow any geometry request from the user. */
2293 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
2294 XtSetValues (menu
, av
, ac
);
2296 /* Free the widget_value objects we used to specify the contents. */
2297 free_menubar_widget_value_tree (first_wv
);
2299 /* No selection has been chosen yet. */
2300 menu_item_selection
= 0;
2302 /* Display the menu. */
2303 lw_popup_menu (menu
, (XEvent
*) &dummy
);
2304 popup_activated_flag
= 1;
2306 /* Process events that apply to the menu. */
2307 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), menu_id
);
2309 /* fp turned off the following statement and wrote a comment
2310 that it is unnecessary--that the menu has already disappeared.
2311 Nowadays the menu disappears ok, all right, but
2312 we need to delete the widgets or multiple ones will pile up. */
2313 lw_destroy_all_widgets (menu_id
);
2315 /* Find the selected item, and its pane, to return
2316 the proper value. */
2317 if (menu_item_selection
!= 0)
2319 Lisp_Object prefix
, entry
;
2321 prefix
= entry
= Qnil
;
2323 while (i
< menu_items_used
)
2325 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2327 subprefix_stack
[submenu_depth
++] = prefix
;
2331 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2333 prefix
= subprefix_stack
[--submenu_depth
];
2336 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2339 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2340 i
+= MENU_ITEMS_PANE_LENGTH
;
2342 /* Ignore a nil in the item list.
2343 It's meaningful only for dialog boxes. */
2344 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2349 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2350 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2356 entry
= Fcons (entry
, Qnil
);
2358 entry
= Fcons (prefix
, entry
);
2359 for (j
= submenu_depth
- 1; j
>= 0; j
--)
2360 if (!NILP (subprefix_stack
[j
]))
2361 entry
= Fcons (subprefix_stack
[j
], entry
);
2365 i
+= MENU_ITEMS_ITEM_LENGTH
;
2374 dialog_selection_callback (widget
, id
, client_data
)
2377 XtPointer client_data
;
2379 /* The EMACS_INT cast avoids a warning. There's no problem
2380 as long as pointers have enough bits to hold small integers. */
2381 if ((int) (EMACS_INT
) client_data
!= -1)
2382 menu_item_selection
= (Lisp_Object
*) client_data
;
2384 lw_destroy_all_widgets (id
);
2386 popup_activated_flag
= 0;
2389 static char * button_names
[] = {
2390 "button1", "button2", "button3", "button4", "button5",
2391 "button6", "button7", "button8", "button9", "button10" };
2394 xdialog_show (f
, keymaps
, title
, error
)
2400 int i
, nb_buttons
=0;
2403 char dialog_name
[6];
2405 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2407 /* Number of elements seen so far, before boundary. */
2409 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2410 int boundary_seen
= 0;
2414 if (menu_items_n_panes
> 1)
2416 *error
= "Multiple panes in dialog box";
2420 /* Create a tree of widget_value objects
2421 representing the text label and buttons. */
2423 Lisp_Object pane_name
, prefix
;
2425 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2426 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2427 pane_string
= (NILP (pane_name
)
2428 ? "" : (char *) SDATA (pane_name
));
2429 prev_wv
= xmalloc_widget_value ();
2430 prev_wv
->value
= pane_string
;
2431 if (keymaps
&& !NILP (prefix
))
2433 prev_wv
->enabled
= 1;
2434 prev_wv
->name
= "message";
2435 prev_wv
->help
= Qnil
;
2438 /* Loop over all panes and items, filling in the tree. */
2439 i
= MENU_ITEMS_PANE_LENGTH
;
2440 while (i
< menu_items_used
)
2443 /* Create a new item within current pane. */
2444 Lisp_Object item_name
, enable
, descrip
;
2445 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2446 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2448 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2450 if (NILP (item_name
))
2452 free_menubar_widget_value_tree (first_wv
);
2453 *error
= "Submenu in dialog items";
2456 if (EQ (item_name
, Qquote
))
2458 /* This is the boundary between left-side elts
2459 and right-side elts. Stop incrementing right_count. */
2464 if (nb_buttons
>= 9)
2466 free_menubar_widget_value_tree (first_wv
);
2467 *error
= "Too many dialog items";
2471 wv
= xmalloc_widget_value ();
2473 wv
->name
= (char *) button_names
[nb_buttons
];
2474 if (!NILP (descrip
))
2475 wv
->key
= (char *) SDATA (descrip
);
2476 wv
->value
= (char *) SDATA (item_name
);
2477 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
2478 wv
->enabled
= !NILP (enable
);
2482 if (! boundary_seen
)
2486 i
+= MENU_ITEMS_ITEM_LENGTH
;
2489 /* If the boundary was not specified,
2490 by default put half on the left and half on the right. */
2491 if (! boundary_seen
)
2492 left_count
= nb_buttons
- nb_buttons
/ 2;
2494 wv
= xmalloc_widget_value ();
2495 wv
->name
= dialog_name
;
2497 /* Dialog boxes use a really stupid name encoding
2498 which specifies how many buttons to use
2499 and how many buttons are on the right.
2500 The Q means something also. */
2501 dialog_name
[0] = 'Q';
2502 dialog_name
[1] = '0' + nb_buttons
;
2503 dialog_name
[2] = 'B';
2504 dialog_name
[3] = 'R';
2505 /* Number of buttons to put on the right. */
2506 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2508 wv
->contents
= first_wv
;
2512 /* Actually create the dialog. */
2513 dialog_id
= widget_id_tick
++;
2514 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2515 f
->output_data
.x
->widget
, 1, 0,
2516 dialog_selection_callback
, 0, 0);
2517 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2518 /* Free the widget_value objects we used to specify the contents. */
2519 free_menubar_widget_value_tree (first_wv
);
2521 /* No selection has been chosen yet. */
2522 menu_item_selection
= 0;
2524 /* Display the menu. */
2525 lw_pop_up_all_widgets (dialog_id
);
2526 popup_activated_flag
= 1;
2528 /* Process events that apply to the menu. */
2529 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2531 lw_destroy_all_widgets (dialog_id
);
2533 /* Find the selected item, and its pane, to return
2534 the proper value. */
2535 if (menu_item_selection
!= 0)
2541 while (i
< menu_items_used
)
2545 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2548 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2549 i
+= MENU_ITEMS_PANE_LENGTH
;
2551 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2553 /* This is the boundary between left-side elts and
2560 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2561 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2565 entry
= Fcons (entry
, Qnil
);
2567 entry
= Fcons (prefix
, entry
);
2571 i
+= MENU_ITEMS_ITEM_LENGTH
;
2579 #else /* not USE_X_TOOLKIT */
2581 /* The frame of the last activated non-toolkit menu bar.
2582 Used to generate menu help events. */
2584 static struct frame
*menu_help_frame
;
2587 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
2589 PANE is the pane number, and ITEM is the menu item number in
2590 the menu (currently not used).
2592 This cannot be done with generating a HELP_EVENT because
2593 XMenuActivate contains a loop that doesn't let Emacs process
2597 menu_help_callback (help_string
, pane
, item
)
2601 extern Lisp_Object Qmenu_item
;
2602 Lisp_Object
*first_item
;
2603 Lisp_Object pane_name
;
2604 Lisp_Object menu_object
;
2606 first_item
= XVECTOR (menu_items
)->contents
;
2607 if (EQ (first_item
[0], Qt
))
2608 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2609 else if (EQ (first_item
[0], Qquote
))
2610 /* This shouldn't happen, see xmenu_show. */
2611 pane_name
= empty_string
;
2613 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2615 /* (menu-item MENU-NAME PANE-NUMBER) */
2616 menu_object
= Fcons (Qmenu_item
,
2618 Fcons (make_number (pane
), Qnil
)));
2619 show_help_echo (help_string
? build_string (help_string
) : Qnil
,
2620 Qnil
, menu_object
, make_number (item
), 1);
2625 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2635 int pane
, selidx
, lpane
, status
;
2636 Lisp_Object entry
, pane_prefix
;
2638 int ulx
, uly
, width
, height
;
2639 int dispwidth
, dispheight
;
2643 unsigned int dummy_uint
;
2646 if (menu_items_n_panes
== 0)
2649 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2651 *error
= "Empty menu";
2655 /* Figure out which root window F is on. */
2656 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2657 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2658 &dummy_uint
, &dummy_uint
);
2660 /* Make the menu on that window. */
2661 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2664 *error
= "Can't create menu";
2668 #ifdef HAVE_X_WINDOWS
2669 /* Adjust coordinates to relative to the outer (window manager) window. */
2672 int win_x
= 0, win_y
= 0;
2674 /* Find the position of the outside upper-left corner of
2675 the inner window, with respect to the outer window. */
2676 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2679 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2681 /* From-window, to-window. */
2682 f
->output_data
.x
->window_desc
,
2683 f
->output_data
.x
->parent_desc
,
2685 /* From-position, to-position. */
2686 0, 0, &win_x
, &win_y
,
2688 /* Child of window. */
2695 #endif /* HAVE_X_WINDOWS */
2697 /* Adjust coordinates to be root-window-relative. */
2698 x
+= f
->output_data
.x
->left_pos
;
2699 y
+= f
->output_data
.x
->top_pos
;
2701 /* Create all the necessary panes and their items. */
2703 while (i
< menu_items_used
)
2705 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2707 /* Create a new pane. */
2708 Lisp_Object pane_name
, prefix
;
2711 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2712 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2713 pane_string
= (NILP (pane_name
)
2714 ? "" : (char *) SDATA (pane_name
));
2715 if (keymaps
&& !NILP (prefix
))
2718 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2719 if (lpane
== XM_FAILURE
)
2721 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2722 *error
= "Can't create pane";
2725 i
+= MENU_ITEMS_PANE_LENGTH
;
2727 /* Find the width of the widest item in this pane. */
2730 while (j
< menu_items_used
)
2733 item
= XVECTOR (menu_items
)->contents
[j
];
2741 width
= SBYTES (item
);
2742 if (width
> maxwidth
)
2745 j
+= MENU_ITEMS_ITEM_LENGTH
;
2748 /* Ignore a nil in the item list.
2749 It's meaningful only for dialog boxes. */
2750 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2754 /* Create a new item within current pane. */
2755 Lisp_Object item_name
, enable
, descrip
, help
;
2756 unsigned char *item_data
;
2759 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2760 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2762 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2763 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2764 help_string
= STRINGP (help
) ? SDATA (help
) : NULL
;
2766 if (!NILP (descrip
))
2768 int gap
= maxwidth
- SBYTES (item_name
);
2771 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2772 item_name
= concat2 (item_name
, spacer
);
2773 item_name
= concat2 (item_name
, descrip
);
2774 item_data
= SDATA (item_name
);
2776 /* if alloca is fast, use that to make the space,
2777 to reduce gc needs. */
2779 = (unsigned char *) alloca (maxwidth
2780 + SBYTES (descrip
) + 1);
2781 bcopy (SDATA (item_name
), item_data
,
2782 SBYTES (item_name
));
2783 for (j
= SCHARS (item_name
); j
< maxwidth
; j
++)
2785 bcopy (SDATA (descrip
), item_data
+ j
,
2787 item_data
[j
+ SBYTES (descrip
)] = 0;
2791 item_data
= SDATA (item_name
);
2793 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2794 menu
, lpane
, 0, item_data
,
2795 !NILP (enable
), help_string
)
2798 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2799 *error
= "Can't add selection to menu";
2802 i
+= MENU_ITEMS_ITEM_LENGTH
;
2806 /* All set and ready to fly. */
2807 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2808 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2809 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2810 x
= min (x
, dispwidth
);
2811 y
= min (y
, dispheight
);
2814 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2815 &ulx
, &uly
, &width
, &height
);
2816 if (ulx
+width
> dispwidth
)
2818 x
-= (ulx
+ width
) - dispwidth
;
2819 ulx
= dispwidth
- width
;
2821 if (uly
+height
> dispheight
)
2823 y
-= (uly
+ height
) - dispheight
;
2824 uly
= dispheight
- height
;
2826 if (ulx
< 0) x
-= ulx
;
2827 if (uly
< 0) y
-= uly
;
2829 XMenuSetAEQ (menu
, TRUE
);
2830 XMenuSetFreeze (menu
, TRUE
);
2833 /* Help display under X won't work because XMenuActivate contains
2834 a loop that doesn't give Emacs a chance to process it. */
2835 menu_help_frame
= f
;
2836 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2837 x
, y
, ButtonReleaseMask
, &datap
,
2838 menu_help_callback
);
2841 #ifdef HAVE_X_WINDOWS
2842 /* Assume the mouse has moved out of the X window.
2843 If it has actually moved in, we will get an EnterNotify. */
2844 x_mouse_leave (FRAME_X_DISPLAY_INFO (f
));
2851 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2854 /* Find the item number SELIDX in pane number PANE. */
2856 while (i
< menu_items_used
)
2858 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2862 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2864 i
+= MENU_ITEMS_PANE_LENGTH
;
2873 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2876 entry
= Fcons (entry
, Qnil
);
2877 if (!NILP (pane_prefix
))
2878 entry
= Fcons (pane_prefix
, entry
);
2884 i
+= MENU_ITEMS_ITEM_LENGTH
;
2890 *error
= "Can't activate menu";
2896 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2898 #ifdef HAVE_X_WINDOWS
2899 /* State that no mouse buttons are now held.
2900 (The oldXMenu code doesn't track this info for us.)
2901 That is not necessarily true, but the fiction leads to reasonable
2902 results, and it is a pain to ask which are actually held now. */
2903 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2909 #endif /* not USE_X_TOOLKIT */
2911 #endif /* HAVE_MENUS */
2916 staticpro (&menu_items
);
2918 menu_items_inuse
= Qnil
;
2920 Qdebug_on_next_call
= intern ("debug-on-next-call");
2921 staticpro (&Qdebug_on_next_call
);
2923 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2924 doc
: /* Frame for which we are updating a menu.
2925 The enable predicate for a menu command should check this variable. */);
2926 Vmenu_updating_frame
= Qnil
;
2928 #ifdef USE_X_TOOLKIT
2929 widget_id_tick
= (1<<16);
2930 next_menubar_widget_id
= 1;
2933 defsubr (&Sx_popup_menu
);
2935 defsubr (&Sx_popup_dialog
);