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"
55 /* This may include sys/types.h, and that somehow loses
56 if this is not done before the other system files. */
60 /* Load sys/types.h if not already loaded.
61 In some systems loading it twice is suicidal. */
63 #include <sys/types.h>
66 #include "dispextern.h"
69 #undef HAVE_MULTILINGUAL_MENU
73 #include <X11/IntrinsicP.h>
74 #include <X11/CoreP.h>
75 #include <X11/StringDefs.h>
76 #include <X11/Shell.h>
78 #include <X11/Xaw/Paned.h>
79 #endif /* USE_LUCID */
80 #include "../lwlib/lwlib.h"
81 #else /* not USE_X_TOOLKIT */
82 #include "../oldXMenu/XMenu.h"
83 #endif /* not USE_X_TOOLKIT */
84 #endif /* HAVE_X_WINDOWS */
91 Lisp_Object Vmenu_updating_frame
;
93 Lisp_Object Qdebug_on_next_call
;
95 extern Lisp_Object Qmenu_bar
;
96 extern Lisp_Object Qmouse_click
, Qevent_kind
;
98 extern Lisp_Object QCtoggle
, QCradio
;
100 extern Lisp_Object Voverriding_local_map
;
101 extern Lisp_Object Voverriding_local_map_menu_flag
;
103 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
105 extern Lisp_Object Qmenu_bar_update_hook
;
108 extern void set_frame_menubar ();
109 extern void process_expose_from_menu ();
110 extern XtAppContext Xt_app_con
;
112 static Lisp_Object
xdialog_show ();
113 void popup_get_selection ();
118 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
123 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
124 Lisp_Object
, Lisp_Object
, Lisp_Object
,
125 Lisp_Object
, Lisp_Object
));
126 static int update_frame_menubar
P_ ((struct frame
*));
127 static Lisp_Object xmenu_show
P_ ((struct frame
*, int, int, int, int,
128 Lisp_Object
, char **));
129 static void keymap_panes
P_ ((Lisp_Object
*, int, int));
130 static void single_keymap_panes
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
132 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
*,
134 static void list_of_panes
P_ ((Lisp_Object
));
135 static void list_of_items
P_ ((Lisp_Object
));
137 /* This holds a Lisp vector that holds the results of decoding
138 the keymaps or alist-of-alists that specify a menu.
140 It describes the panes and items within the panes.
142 Each pane is described by 3 elements in the vector:
143 t, the pane name, the pane's prefix key.
144 Then follow the pane's items, with 5 elements per item:
145 the item string, the enable flag, the item's value,
146 the definition, and the equivalent keyboard key's description string.
148 In some cases, multiple levels of menus may be described.
149 A single vector slot containing nil indicates the start of a submenu.
150 A single vector slot containing lambda indicates the end of a submenu.
151 The submenu follows a menu item which is the way to reach the submenu.
153 A single vector slot containing quote indicates that the
154 following items should appear on the right of a dialog box.
156 Using a Lisp vector to hold this information while we decode it
157 takes care of protecting all the data from GC. */
159 #define MENU_ITEMS_PANE_NAME 1
160 #define MENU_ITEMS_PANE_PREFIX 2
161 #define MENU_ITEMS_PANE_LENGTH 3
165 MENU_ITEMS_ITEM_NAME
= 0,
166 MENU_ITEMS_ITEM_ENABLE
,
167 MENU_ITEMS_ITEM_VALUE
,
168 MENU_ITEMS_ITEM_EQUIV_KEY
,
169 MENU_ITEMS_ITEM_DEFINITION
,
170 MENU_ITEMS_ITEM_TYPE
,
171 MENU_ITEMS_ITEM_SELECTED
,
172 MENU_ITEMS_ITEM_HELP
,
173 MENU_ITEMS_ITEM_LENGTH
176 static Lisp_Object menu_items
;
178 /* Number of slots currently allocated in menu_items. */
179 static int menu_items_allocated
;
181 /* This is the index in menu_items of the first empty slot. */
182 static int menu_items_used
;
184 /* The number of panes currently recorded in menu_items,
185 excluding those within submenus. */
186 static int menu_items_n_panes
;
188 /* Current depth within submenus. */
189 static int menu_items_submenu_depth
;
191 /* Flag which when set indicates a dialog or menu has been posted by
192 Xt on behalf of one of the widget sets. */
193 int popup_activated_flag
;
195 static int next_menubar_widget_id
;
197 /* This is set nonzero after the user activates the menu bar, and set
198 to zero again after the menu bars are redisplayed by prepare_menu_bar.
199 While it is nonzero, all calls to set_frame_menubar go deep.
201 I don't understand why this is needed, but it does seem to be
202 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
204 int pending_menu_activation
;
208 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
210 static struct frame
*
211 menubar_id_to_frame (id
)
214 Lisp_Object tail
, frame
;
217 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
220 if (!GC_FRAMEP (frame
))
223 if (!FRAME_WINDOW_P (f
))
225 if (f
->output_data
.x
->id
== id
)
233 /* Initialize the menu_items structure if we haven't already done so.
234 Also mark it as currently empty. */
239 if (NILP (menu_items
))
241 menu_items_allocated
= 60;
242 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
246 menu_items_n_panes
= 0;
247 menu_items_submenu_depth
= 0;
250 /* Call at the end of generating the data in menu_items.
251 This fills in the number of items in the last pane. */
258 /* Call when finished using the data for the current menu
262 discard_menu_items ()
264 /* Free the structure if it is especially large.
265 Otherwise, hold on to it, to save time. */
266 if (menu_items_allocated
> 200)
269 menu_items_allocated
= 0;
273 /* Make the menu_items vector twice as large. */
279 int old_size
= menu_items_allocated
;
282 menu_items_allocated
*= 2;
283 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
284 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
285 old_size
* sizeof (Lisp_Object
));
288 /* Begin a submenu. */
291 push_submenu_start ()
293 if (menu_items_used
+ 1 > menu_items_allocated
)
296 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
297 menu_items_submenu_depth
++;
305 if (menu_items_used
+ 1 > menu_items_allocated
)
308 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
309 menu_items_submenu_depth
--;
312 /* Indicate boundary between left and right. */
315 push_left_right_boundary ()
317 if (menu_items_used
+ 1 > menu_items_allocated
)
320 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
323 /* Start a new menu pane in menu_items.
324 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
327 push_menu_pane (name
, prefix_vec
)
328 Lisp_Object name
, prefix_vec
;
330 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
333 if (menu_items_submenu_depth
== 0)
334 menu_items_n_panes
++;
335 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
336 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
337 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
340 /* Push one menu item into the current pane. NAME is the string to
341 display. ENABLE if non-nil means this item can be selected. KEY
342 is the key generated by choosing this item, or nil if this item
343 doesn't really have a definition. DEF is the definition of this
344 item. EQUIV is the textual description of the keyboard equivalent
345 for this item (or nil if none). TYPE is the type of this menu
346 item, one of nil, `toggle' or `radio'. */
349 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
350 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
352 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
355 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
356 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
357 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
358 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
359 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
360 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
361 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
362 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
365 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
366 and generate menu panes for them in menu_items.
367 If NOTREAL is nonzero,
368 don't bother really computing whether an item is enabled. */
371 keymap_panes (keymaps
, nmaps
, notreal
)
372 Lisp_Object
*keymaps
;
380 /* Loop over the given keymaps, making a pane for each map.
381 But don't make a pane that is empty--ignore that map instead.
382 P is the number of panes we have made so far. */
383 for (mapno
= 0; mapno
< nmaps
; mapno
++)
384 single_keymap_panes (keymaps
[mapno
],
385 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
387 finish_menu_items ();
390 /* This is a recursive subroutine of keymap_panes.
391 It handles one keymap, KEYMAP.
392 The other arguments are passed along
393 or point to local variables of the previous function.
394 If NOTREAL is nonzero, only check for equivalent key bindings, don't
395 evaluate expressions in menu items and don't make any menu.
397 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
400 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
402 Lisp_Object pane_name
;
407 Lisp_Object pending_maps
= Qnil
;
408 Lisp_Object tail
, item
;
409 struct gcpro gcpro1
, gcpro2
;
415 push_menu_pane (pane_name
, prefix
);
418 /* Remember index for first item in this pane so we can go back and
419 add a prefix when (if) we see the first button. After that, notbuttons
420 is set to 0, to mark that we have seen a button and all non button
421 items need a prefix. */
422 notbuttons
= menu_items_used
;
425 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
427 GCPRO2 (keymap
, pending_maps
);
428 /* Look at each key binding, and if it is a menu item add it
432 single_menu_item (XCAR (item
), XCDR (item
),
433 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
434 else if (VECTORP (item
))
436 /* Loop over the char values represented in the vector. */
437 int len
= XVECTOR (item
)->size
;
439 for (c
= 0; c
< len
; c
++)
441 Lisp_Object character
;
442 XSETFASTINT (character
, c
);
443 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
444 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
450 /* Process now any submenus which want to be panes at this level. */
451 while (!NILP (pending_maps
))
453 Lisp_Object elt
, eltcdr
, string
;
454 elt
= Fcar (pending_maps
);
456 string
= XCAR (eltcdr
);
457 /* We no longer discard the @ from the beginning of the string here.
458 Instead, we do this in xmenu_show. */
459 single_keymap_panes (Fcar (elt
), string
,
460 XCDR (eltcdr
), notreal
, maxdepth
- 1);
461 pending_maps
= Fcdr (pending_maps
);
465 /* This is a subroutine of single_keymap_panes that handles one
467 KEY is a key in a keymap and ITEM is its binding.
468 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
470 If NOTREAL is nonzero, only check for equivalent key bindings, don't
471 evaluate expressions in menu items and don't make any menu.
472 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
473 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
474 buttons. It points to variable notbuttons in single_keymap_panes,
475 which keeps track of if we have seen a button in this menu or not. */
478 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
,
480 Lisp_Object key
, item
;
481 Lisp_Object
*pending_maps_ptr
;
482 int maxdepth
, notreal
;
485 Lisp_Object map
, item_string
, enabled
;
486 struct gcpro gcpro1
, gcpro2
;
489 /* Parse the menu item and leave the result in item_properties. */
491 res
= parse_menu_item (item
, notreal
, 0);
494 return; /* Not a menu item. */
496 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
500 /* We don't want to make a menu, just traverse the keymaps to
501 precompute equivalent key bindings. */
503 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
507 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
508 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
510 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
513 /* An enabled separate pane. Remember this to handle it later. */
514 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
520 /* Simulate radio buttons and toggle boxes by putting a prefix in
523 Lisp_Object prefix
= Qnil
;
524 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
528 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
531 /* The first button. Line up previous items in this menu. */
533 int index
= *notbuttons_ptr
; /* Index for first item this menu. */
536 while (index
< menu_items_used
)
539 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
543 submenu
++; /* Skip sub menu. */
545 else if (EQ (tem
, Qlambda
))
548 submenu
--; /* End sub menu. */
550 else if (EQ (tem
, Qt
))
551 index
+= 3; /* Skip new pane marker. */
552 else if (EQ (tem
, Qquote
))
553 index
++; /* Skip a left, right divider. */
556 if (!submenu
&& XSTRING (tem
)->data
[0] != '\0'
557 && XSTRING (tem
)->data
[0] != '-')
558 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
559 = concat2 (build_string (" "), tem
);
560 index
+= MENU_ITEMS_ITEM_LENGTH
;
566 /* Calculate prefix, if any, for this item. */
567 if (EQ (type
, QCtoggle
))
568 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
569 else if (EQ (type
, QCradio
))
570 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
572 /* Not a button. If we have earlier buttons, then we need a prefix. */
573 else if (!*notbuttons_ptr
&& XSTRING (item_string
)->data
[0] != '\0'
574 && XSTRING (item_string
)->data
[0] != '-')
575 prefix
= build_string (" ");
578 item_string
= concat2 (prefix
, item_string
);
580 #endif /* not HAVE_BOXES */
582 #ifndef USE_X_TOOLKIT
584 /* Indicate visually that this is a submenu. */
585 item_string
= concat2 (item_string
, build_string (" >"));
588 push_menu_item (item_string
, enabled
, key
,
589 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
590 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
591 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
592 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
593 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
596 /* Display a submenu using the toolkit. */
597 if (! (NILP (map
) || NILP (enabled
)))
599 push_submenu_start ();
600 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
606 /* Push all the panes and items of a menu described by the
607 alist-of-alists MENU.
608 This handles old-fashioned calls to x-popup-menu. */
618 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
620 Lisp_Object elt
, pane_name
, pane_data
;
622 pane_name
= Fcar (elt
);
623 CHECK_STRING (pane_name
, 0);
624 push_menu_pane (pane_name
, Qnil
);
625 pane_data
= Fcdr (elt
);
626 CHECK_CONS (pane_data
, 0);
627 list_of_items (pane_data
);
630 finish_menu_items ();
633 /* Push the items in a single pane defined by the alist PANE. */
639 Lisp_Object tail
, item
, item1
;
641 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
645 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
646 else if (NILP (item
))
647 push_left_right_boundary ();
650 CHECK_CONS (item
, 0);
652 CHECK_STRING (item1
, 1);
653 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
658 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
659 doc
: /* Pop up a deck-of-cards menu and return user's selection.
660 POSITION is a position specification. This is either a mouse button event
661 or a list ((XOFFSET YOFFSET) WINDOW)
662 where XOFFSET and YOFFSET are positions in pixels from the top left
663 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)
664 This controls the position of the center of the first line
665 in the first pane of the menu, not the top left of the menu as a whole.
666 If POSITION is t, it means to use the current mouse position.
668 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
669 The menu items come from key bindings that have a menu string as well as
670 a definition; actually, the "definition" in such a key binding looks like
671 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
672 the keymap as a top-level element.
674 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
675 Otherwise, REAL-DEFINITION should be a valid key binding definition.
677 You can also use a list of keymaps as MENU.
678 Then each keymap makes a separate pane.
679 When MENU is a keymap or a list of keymaps, the return value
682 Alternatively, you can specify a menu of multiple panes
683 with a list of the form (TITLE PANE1 PANE2...),
684 where each pane is a list of form (TITLE ITEM1 ITEM2...).
685 Each ITEM is normally a cons cell (STRING . VALUE);
686 but a string can appear as an item--that makes a nonselectable line
688 With this form of menu, the return value is VALUE from the chosen item.
690 If POSITION is nil, don't display the menu at all, just precalculate the
691 cached information about equivalent key sequences. */)
693 Lisp_Object position
, menu
;
695 Lisp_Object keymap
, tem
;
696 int xpos
= 0, ypos
= 0;
699 Lisp_Object selection
;
700 struct frame
*f
= NULL
;
701 Lisp_Object x
, y
, window
;
707 if (! NILP (position
))
711 /* Decode the first argument: find the window and the coordinates. */
712 if (EQ (position
, Qt
)
713 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
714 || EQ (XCAR (position
), Qtool_bar
))))
716 /* Use the mouse's current position. */
717 FRAME_PTR new_f
= SELECTED_FRAME ();
718 Lisp_Object bar_window
;
719 enum scroll_bar_part part
;
722 if (mouse_position_hook
)
723 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
724 &part
, &x
, &y
, &time
);
726 XSETFRAME (window
, new_f
);
729 window
= selected_window
;
736 tem
= Fcar (position
);
739 window
= Fcar (Fcdr (position
));
741 y
= Fcar (Fcdr (tem
));
746 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
747 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
748 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
757 /* Decode where to put the menu. */
765 else if (WINDOWP (window
))
767 CHECK_LIVE_WINDOW (window
, 0);
768 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
770 xpos
= (FONT_WIDTH (f
->output_data
.x
->font
)
771 * XFASTINT (XWINDOW (window
)->left
));
772 ypos
= (f
->output_data
.x
->line_height
773 * XFASTINT (XWINDOW (window
)->top
));
776 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
777 but I don't want to make one now. */
778 CHECK_WINDOW (window
, 0);
783 XSETFRAME (Vmenu_updating_frame
, f
);
785 Vmenu_updating_frame
= Qnil
;
786 #endif /* HAVE_MENUS */
791 /* Decode the menu items from what was specified. */
793 keymap
= get_keymap (menu
, 0, 0);
796 /* We were given a keymap. Extract menu info from the keymap. */
799 /* Extract the detailed info to make one pane. */
800 keymap_panes (&menu
, 1, NILP (position
));
802 /* Search for a string appearing directly as an element of the keymap.
803 That string is the title of the menu. */
804 prompt
= Fkeymap_prompt (keymap
);
805 if (NILP (title
) && !NILP (prompt
))
808 /* Make that be the pane title of the first pane. */
809 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
810 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
814 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
816 /* We were given a list of keymaps. */
817 int nmaps
= XFASTINT (Flength (menu
));
819 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
824 /* The first keymap that has a prompt string
825 supplies the menu title. */
826 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
830 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
832 prompt
= Fkeymap_prompt (keymap
);
833 if (NILP (title
) && !NILP (prompt
))
837 /* Extract the detailed info to make one pane. */
838 keymap_panes (maps
, nmaps
, NILP (position
));
840 /* Make the title be the pane title of the first pane. */
841 if (!NILP (title
) && menu_items_n_panes
>= 0)
842 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
848 /* We were given an old-fashioned menu. */
850 CHECK_STRING (title
, 1);
852 list_of_panes (Fcdr (menu
));
859 discard_menu_items ();
865 /* Display them in a menu. */
868 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
869 keymaps
, title
, &error_name
);
872 discard_menu_items ();
875 #endif /* HAVE_MENUS */
877 if (error_name
) error (error_name
);
883 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
884 doc
: /* Pop up a dialog box and return user's selection.
885 POSITION specifies which frame to use.
886 This is normally a mouse button event or a window or frame.
887 If POSITION is t, it means to use the frame the mouse is on.
888 The dialog box appears in the middle of the specified frame.
890 CONTENTS specifies the alternatives to display in the dialog box.
891 It is a list of the form (TITLE ITEM1 ITEM2...).
892 Each ITEM is a cons cell (STRING . VALUE).
893 The return value is VALUE from the chosen item.
895 An ITEM may also be just a string--that makes a nonselectable item.
896 An ITEM may also be nil--that means to put all preceding items
897 on the left of the dialog box and all following items on the right.
898 \(By default, approximately half appear on each side.) */)
900 Lisp_Object position
, contents
;
902 struct frame
* f
= NULL
;
907 /* Decode the first argument: find the window or frame to use. */
908 if (EQ (position
, Qt
)
909 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
910 || EQ (XCAR (position
), Qtool_bar
))))
912 #if 0 /* Using the frame the mouse is on may not be right. */
913 /* Use the mouse's current position. */
914 FRAME_PTR new_f
= SELECTED_FRAME ();
915 Lisp_Object bar_window
;
920 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
923 XSETFRAME (window
, new_f
);
925 window
= selected_window
;
927 window
= selected_window
;
929 else if (CONSP (position
))
932 tem
= Fcar (position
);
934 window
= Fcar (Fcdr (position
));
937 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
938 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
941 else if (WINDOWP (position
) || FRAMEP (position
))
946 /* Decode where to put the menu. */
950 else if (WINDOWP (window
))
952 CHECK_LIVE_WINDOW (window
, 0);
953 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
956 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
957 but I don't want to make one now. */
958 CHECK_WINDOW (window
, 0);
960 #ifndef USE_X_TOOLKIT
961 /* Display a menu with these alternatives
962 in the middle of frame F. */
964 Lisp_Object x
, y
, frame
, newpos
;
965 XSETFRAME (frame
, f
);
966 XSETINT (x
, x_pixel_width (f
) / 2);
967 XSETINT (y
, x_pixel_height (f
) / 2);
968 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
970 return Fx_popup_menu (newpos
,
971 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
977 Lisp_Object selection
;
979 /* Decode the dialog items from what was specified. */
980 title
= Fcar (contents
);
981 CHECK_STRING (title
, 1);
983 list_of_panes (Fcons (contents
, Qnil
));
985 /* Display them in a dialog box. */
987 selection
= xdialog_show (f
, 0, title
, &error_name
);
990 discard_menu_items ();
992 if (error_name
) error (error_name
);
1000 /* Loop in Xt until the menu pulldown or dialog popup has been
1001 popped down (deactivated). This is used for x-popup-menu
1002 and x-popup-dialog; it is not used for the menu bar any more.
1004 NOTE: All calls to popup_get_selection should be protected
1005 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1008 popup_get_selection (initial_event
, dpyinfo
, id
)
1009 XEvent
*initial_event
;
1010 struct x_display_info
*dpyinfo
;
1015 /* Define a queue to save up for later unreading
1016 all X events that don't pertain to the menu. */
1020 struct event_queue
*next
;
1023 struct event_queue
*queue
= NULL
;
1024 struct event_queue
*queue_tmp
;
1027 event
= *initial_event
;
1029 XtAppNextEvent (Xt_app_con
, &event
);
1033 /* Handle expose events for editor frames right away. */
1034 if (event
.type
== Expose
)
1035 process_expose_from_menu (event
);
1036 /* Make sure we don't consider buttons grabbed after menu goes.
1037 And make sure to deactivate for any ButtonRelease,
1038 even if XtDispatchEvent doesn't do that. */
1039 else if (event
.type
== ButtonRelease
1040 && dpyinfo
->display
== event
.xbutton
.display
)
1042 dpyinfo
->grabbed
&= ~(1 << event
.xbutton
.button
);
1043 popup_activated_flag
= 0;
1044 #ifdef USE_MOTIF /* Pretending that the event came from a
1045 Btn1Down seems the only way to convince Motif to
1046 activate its callbacks; setting the XmNmenuPost
1047 isn't working. --marcus@sysc.pdx.edu. */
1048 event
.xbutton
.button
= 1;
1051 /* If the user presses a key, deactivate the menu.
1052 The user is likely to do that if we get wedged. */
1053 else if (event
.type
== KeyPress
1054 && dpyinfo
->display
== event
.xbutton
.display
)
1056 KeySym keysym
= XLookupKeysym (&event
.xkey
, 0);
1057 if (!IsModifierKey (keysym
))
1059 popup_activated_flag
= 0;
1063 /* Button presses outside the menu also pop it down. */
1064 else if (event
.type
== ButtonPress
1065 && event
.xany
.display
== dpyinfo
->display
1066 && x_any_window_to_frame (dpyinfo
, event
.xany
.window
))
1068 popup_activated_flag
= 0;
1072 /* Queue all events not for this popup,
1073 except for Expose, which we've already handled, and ButtonRelease.
1074 Note that the X window is associated with the frame if this
1075 is a menu bar popup, but not if it's a dialog box. So we use
1076 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1077 if (event
.type
!= Expose
1078 && !(event
.type
== ButtonRelease
1079 && dpyinfo
->display
== event
.xbutton
.display
)
1080 && (event
.xany
.display
!= dpyinfo
->display
1081 || x_non_menubar_window_to_frame (dpyinfo
, event
.xany
.window
)))
1083 queue_tmp
= (struct event_queue
*) xmalloc (sizeof *queue_tmp
);
1084 queue_tmp
->event
= event
;
1085 queue_tmp
->next
= queue
;
1089 XtDispatchEvent (&event
);
1091 if (!popup_activated ())
1093 XtAppNextEvent (Xt_app_con
, &event
);
1096 /* Unread any events that we got but did not handle. */
1097 while (queue
!= NULL
)
1100 XPutBackEvent (queue_tmp
->event
.xany
.display
, &queue_tmp
->event
);
1101 queue
= queue_tmp
->next
;
1102 xfree ((char *)queue_tmp
);
1103 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1104 interrupt_input_pending
= 1;
1108 /* Activate the menu bar of frame F.
1109 This is called from keyboard.c when it gets the
1110 menu_bar_activate_event out of the Emacs event queue.
1112 To activate the menu bar, we use the X button-press event
1113 that was saved in saved_menu_event.
1114 That makes the toolkit do its thing.
1116 But first we recompute the menu bar contents (the whole tree).
1118 The reason for saving the button event until here, instead of
1119 passing it to the toolkit right away, is that we can safely
1120 execute Lisp code. */
1123 x_activate_menubar (f
)
1126 if (!f
->output_data
.x
->saved_menu_event
->type
)
1129 set_frame_menubar (f
, 0, 1);
1131 XtDispatchEvent ((XEvent
*) f
->output_data
.x
->saved_menu_event
);
1134 if (f
->output_data
.x
->saved_menu_event
->type
== ButtonRelease
)
1135 pending_menu_activation
= 1;
1138 /* Ignore this if we get it a second time. */
1139 f
->output_data
.x
->saved_menu_event
->type
= 0;
1142 /* Detect if a dialog or menu has been posted. */
1147 return popup_activated_flag
;
1150 /* This callback is invoked when the user selects a menubar cascade
1151 pushbutton, but before the pulldown menu is posted. */
1154 popup_activate_callback (widget
, id
, client_data
)
1157 XtPointer client_data
;
1159 popup_activated_flag
= 1;
1162 /* This callback is invoked when a dialog or menu is finished being
1163 used and has been unposted. */
1166 popup_deactivate_callback (widget
, id
, client_data
)
1169 XtPointer client_data
;
1171 popup_activated_flag
= 0;
1174 /* Lwlib callback called when menu items are highlighted/unhighlighted
1175 while moving the mouse over them. WIDGET is the menu bar or menu
1176 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1177 the widget_value structure for the menu item, or null in case of
1181 menu_highlight_callback (widget
, id
, call_data
)
1186 widget_value
*wv
= (widget_value
*) call_data
;
1188 Lisp_Object frame
, help
;
1190 help
= wv
&& wv
->help
? build_string (wv
->help
) : Qnil
;
1192 /* Determine the frame for the help event. */
1193 f
= menubar_id_to_frame (id
);
1196 XSETFRAME (frame
, f
);
1197 kbd_buffer_store_help_event (frame
, help
);
1201 /* WIDGET is the popup menu. It's parent is the frame's
1202 widget. See which frame that is. */
1203 Widget frame_widget
= XtParent (widget
);
1206 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
1208 frame
= XCAR (tail
);
1209 if (GC_FRAMEP (frame
)
1210 && (f
= XFRAME (frame
),
1211 FRAME_X_P (f
) && f
->output_data
.x
->widget
== frame_widget
))
1215 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
1219 /* This callback is called from the menu bar pulldown menu
1220 when the user makes a selection.
1221 Figure out what the user chose
1222 and put the appropriate events into the keyboard buffer. */
1225 menubar_selection_callback (widget
, id
, client_data
)
1228 XtPointer client_data
;
1230 Lisp_Object prefix
, entry
;
1231 FRAME_PTR f
= menubar_id_to_frame (id
);
1233 Lisp_Object
*subprefix_stack
;
1234 int submenu_depth
= 0;
1240 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1241 vector
= f
->menu_bar_vector
;
1244 while (i
< f
->menu_bar_items_used
)
1246 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1248 subprefix_stack
[submenu_depth
++] = prefix
;
1252 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1254 prefix
= subprefix_stack
[--submenu_depth
];
1257 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1259 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1260 i
+= MENU_ITEMS_PANE_LENGTH
;
1264 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1265 /* The EMACS_INT cast avoids a warning. There's no problem
1266 as long as pointers have enough bits to hold small integers. */
1267 if ((int) (EMACS_INT
) client_data
== i
)
1270 struct input_event buf
;
1273 XSETFRAME (frame
, f
);
1274 buf
.kind
= MENU_BAR_EVENT
;
1275 buf
.frame_or_window
= frame
;
1277 kbd_buffer_store_event (&buf
);
1279 for (j
= 0; j
< submenu_depth
; j
++)
1280 if (!NILP (subprefix_stack
[j
]))
1282 buf
.kind
= MENU_BAR_EVENT
;
1283 buf
.frame_or_window
= frame
;
1284 buf
.arg
= subprefix_stack
[j
];
1285 kbd_buffer_store_event (&buf
);
1290 buf
.kind
= MENU_BAR_EVENT
;
1291 buf
.frame_or_window
= frame
;
1293 kbd_buffer_store_event (&buf
);
1296 buf
.kind
= MENU_BAR_EVENT
;
1297 buf
.frame_or_window
= frame
;
1299 kbd_buffer_store_event (&buf
);
1303 i
+= MENU_ITEMS_ITEM_LENGTH
;
1308 /* Allocate a widget_value, blocking input. */
1311 xmalloc_widget_value ()
1313 widget_value
*value
;
1316 value
= malloc_widget_value ();
1322 /* This recursively calls free_widget_value on the tree of widgets.
1323 It must free all data that was malloc'ed for these widget_values.
1324 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1325 must be left alone. */
1328 free_menubar_widget_value_tree (wv
)
1333 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1335 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1337 free_menubar_widget_value_tree (wv
->contents
);
1338 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1342 free_menubar_widget_value_tree (wv
->next
);
1343 wv
->next
= (widget_value
*) 0xDEADBEEF;
1346 free_widget_value (wv
);
1350 /* Return a tree of widget_value structures for a menu bar item
1351 whose event type is ITEM_KEY (with string ITEM_NAME)
1352 and whose contents come from the list of keymaps MAPS. */
1354 static widget_value
*
1355 single_submenu (item_key
, item_name
, maps
)
1356 Lisp_Object item_key
, item_name
, maps
;
1358 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1360 int submenu_depth
= 0;
1363 Lisp_Object
*mapvec
;
1364 widget_value
**submenu_stack
;
1365 int previous_items
= menu_items_used
;
1366 int top_level_items
= 0;
1368 length
= Flength (maps
);
1369 len
= XINT (length
);
1371 /* Convert the list MAPS into a vector MAPVEC. */
1372 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1373 for (i
= 0; i
< len
; i
++)
1375 mapvec
[i
] = Fcar (maps
);
1379 menu_items_n_panes
= 0;
1381 /* Loop over the given keymaps, making a pane for each map.
1382 But don't make a pane that is empty--ignore that map instead. */
1383 for (i
= 0; i
< len
; i
++)
1385 if (SYMBOLP (mapvec
[i
])
1386 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1388 /* Here we have a command at top level in the menu bar
1389 as opposed to a submenu. */
1390 top_level_items
= 1;
1391 push_menu_pane (Qnil
, Qnil
);
1392 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1393 Qnil
, Qnil
, Qnil
, Qnil
);
1396 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1399 /* Create a tree of widget_value objects
1400 representing the panes and their items. */
1403 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1404 wv
= xmalloc_widget_value ();
1408 wv
->button_type
= BUTTON_TYPE_NONE
;
1413 /* Loop over all panes and items made during this call
1414 and construct a tree of widget_value objects.
1415 Ignore the panes and items made by previous calls to
1416 single_submenu, even though those are also in menu_items. */
1418 while (i
< menu_items_used
)
1420 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1422 submenu_stack
[submenu_depth
++] = save_wv
;
1427 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1430 save_wv
= submenu_stack
[--submenu_depth
];
1433 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1434 && submenu_depth
!= 0)
1435 i
+= MENU_ITEMS_PANE_LENGTH
;
1436 /* Ignore a nil in the item list.
1437 It's meaningful only for dialog boxes. */
1438 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1440 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1442 /* Create a new pane. */
1443 Lisp_Object pane_name
, prefix
;
1446 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1447 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1449 #ifndef HAVE_MULTILINGUAL_MENU
1450 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1452 pane_name
= string_make_unibyte (pane_name
);
1453 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1456 pane_string
= (NILP (pane_name
)
1457 ? "" : (char *) XSTRING (pane_name
)->data
);
1458 /* If there is just one top-level pane, put all its items directly
1459 under the top-level menu. */
1460 if (menu_items_n_panes
== 1)
1463 /* If the pane has a meaningful name,
1464 make the pane a top-level menu item
1465 with its items as a submenu beneath it. */
1466 if (strcmp (pane_string
, ""))
1468 wv
= xmalloc_widget_value ();
1472 first_wv
->contents
= wv
;
1473 wv
->name
= pane_string
;
1474 /* Ignore the @ that means "separate pane".
1475 This is a kludge, but this isn't worth more time. */
1476 if (!NILP (prefix
) && wv
->name
[0] == '@')
1480 wv
->button_type
= BUTTON_TYPE_NONE
;
1484 i
+= MENU_ITEMS_PANE_LENGTH
;
1488 /* Create a new item within current pane. */
1489 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1492 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1493 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1494 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1495 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1496 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1497 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1498 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1500 #ifndef HAVE_MULTILINGUAL_MENU
1501 if (STRING_MULTIBYTE (item_name
))
1503 item_name
= string_make_unibyte (item_name
);
1504 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1507 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1509 descrip
= string_make_unibyte (descrip
);
1510 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1512 #endif /* not HAVE_MULTILINGUAL_MENU */
1514 wv
= xmalloc_widget_value ();
1518 save_wv
->contents
= wv
;
1520 wv
->name
= (char *) XSTRING (item_name
)->data
;
1521 if (!NILP (descrip
))
1522 wv
->key
= (char *) XSTRING (descrip
)->data
;
1524 /* The EMACS_INT cast avoids a warning. There's no problem
1525 as long as pointers have enough bits to hold small integers. */
1526 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1527 wv
->enabled
= !NILP (enable
);
1530 wv
->button_type
= BUTTON_TYPE_NONE
;
1531 else if (EQ (type
, QCradio
))
1532 wv
->button_type
= BUTTON_TYPE_RADIO
;
1533 else if (EQ (type
, QCtoggle
))
1534 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1538 wv
->selected
= !NILP (selected
);
1540 wv
->help
= XSTRING (help
)->data
;
1544 i
+= MENU_ITEMS_ITEM_LENGTH
;
1548 /* If we have just one "menu item"
1549 that was originally a button, return it by itself. */
1550 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1552 wv
= first_wv
->contents
;
1553 free_widget_value (first_wv
);
1562 /* Recompute all the widgets of frame F, when the menu bar has been
1563 changed. Value is non-zero if widgets were updated. */
1566 update_frame_menubar (f
)
1569 struct x_output
*x
= f
->output_data
.x
;
1572 if (!x
->menubar_widget
|| XtIsManaged (x
->menubar_widget
))
1576 /* Save the size of the frame because the pane widget doesn't accept
1577 to resize itself. So force it. */
1581 /* Do the voodoo which means "I'm changing lots of things, don't try
1582 to refigure sizes until I'm done." */
1583 lw_refigure_widget (x
->column_widget
, False
);
1585 /* The order in which children are managed is the top to bottom
1586 order in which they are displayed in the paned window. First,
1587 remove the text-area widget. */
1588 XtUnmanageChild (x
->edit_widget
);
1590 /* Remove the menubar that is there now, and put up the menubar that
1592 XtManageChild (x
->menubar_widget
);
1593 XtMapWidget (x
->menubar_widget
);
1594 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, NULL
);
1596 /* Re-manage the text-area widget, and then thrash the sizes. */
1597 XtManageChild (x
->edit_widget
);
1598 lw_refigure_widget (x
->column_widget
, True
);
1600 /* Force the pane widget to resize itself with the right values. */
1601 EmacsFrameSetCharSize (x
->edit_widget
, columns
, rows
);
1606 /* Set the contents of the menubar widgets of frame F.
1607 The argument FIRST_TIME is currently ignored;
1608 it is set the first time this is called, from initialize_frame_menubar. */
1611 set_frame_menubar (f
, first_time
, deep_p
)
1616 Widget menubar_widget
= f
->output_data
.x
->menubar_widget
;
1618 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1622 XSETFRAME (Vmenu_updating_frame
, f
);
1624 if (f
->output_data
.x
->id
== 0)
1625 f
->output_data
.x
->id
= next_menubar_widget_id
++;
1626 id
= f
->output_data
.x
->id
;
1628 if (! menubar_widget
)
1630 else if (pending_menu_activation
&& !deep_p
)
1632 /* Make the first call for any given frame always go deep. */
1633 else if (!f
->output_data
.x
->saved_menu_event
&& !deep_p
)
1636 f
->output_data
.x
->saved_menu_event
= (XEvent
*)xmalloc (sizeof (XEvent
));
1637 f
->output_data
.x
->saved_menu_event
->type
= 0;
1640 wv
= xmalloc_widget_value ();
1641 wv
->name
= "menubar";
1644 wv
->button_type
= BUTTON_TYPE_NONE
;
1649 /* Make a widget-value tree representing the entire menu trees. */
1651 struct buffer
*prev
= current_buffer
;
1653 int specpdl_count
= specpdl_ptr
- specpdl
;
1654 int previous_menu_items_used
= f
->menu_bar_items_used
;
1655 Lisp_Object
*previous_items
1656 = (Lisp_Object
*) alloca (previous_menu_items_used
1657 * sizeof (Lisp_Object
));
1659 /* If we are making a new widget, its contents are empty,
1660 do always reinitialize them. */
1661 if (! menubar_widget
)
1662 previous_menu_items_used
= 0;
1664 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1665 specbind (Qinhibit_quit
, Qt
);
1666 /* Don't let the debugger step into this code
1667 because it is not reentrant. */
1668 specbind (Qdebug_on_next_call
, Qnil
);
1670 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1671 if (NILP (Voverriding_local_map_menu_flag
))
1673 specbind (Qoverriding_terminal_local_map
, Qnil
);
1674 specbind (Qoverriding_local_map
, Qnil
);
1677 set_buffer_internal_1 (XBUFFER (buffer
));
1679 /* Run the Lucid hook. */
1680 safe_run_hooks (Qactivate_menubar_hook
);
1682 /* If it has changed current-menubar from previous value,
1683 really recompute the menubar from the value. */
1684 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1685 call0 (Qrecompute_lucid_menubar
);
1686 safe_run_hooks (Qmenu_bar_update_hook
);
1687 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1689 items
= FRAME_MENU_BAR_ITEMS (f
);
1691 inhibit_garbage_collection ();
1693 /* Save the frame's previous menu bar contents data. */
1694 if (previous_menu_items_used
)
1695 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1696 previous_menu_items_used
* sizeof (Lisp_Object
));
1698 /* Fill in the current menu bar contents. */
1699 menu_items
= f
->menu_bar_vector
;
1700 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1702 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1704 Lisp_Object key
, string
, maps
;
1706 key
= XVECTOR (items
)->contents
[i
];
1707 string
= XVECTOR (items
)->contents
[i
+ 1];
1708 maps
= XVECTOR (items
)->contents
[i
+ 2];
1712 wv
= single_submenu (key
, string
, maps
);
1716 first_wv
->contents
= wv
;
1717 /* Don't set wv->name here; GC during the loop might relocate it. */
1719 wv
->button_type
= BUTTON_TYPE_NONE
;
1723 finish_menu_items ();
1725 set_buffer_internal_1 (prev
);
1726 unbind_to (specpdl_count
, Qnil
);
1728 /* If there has been no change in the Lisp-level contents
1729 of the menu bar, skip redisplaying it. Just exit. */
1731 for (i
= 0; i
< previous_menu_items_used
; i
++)
1732 if (menu_items_used
== i
1733 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1735 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1737 free_menubar_widget_value_tree (first_wv
);
1743 /* Now GC cannot happen during the lifetime of the widget_value,
1744 so it's safe to store data from a Lisp_String. */
1745 wv
= first_wv
->contents
;
1746 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1749 string
= XVECTOR (items
)->contents
[i
+ 1];
1752 wv
->name
= (char *) XSTRING (string
)->data
;
1756 f
->menu_bar_vector
= menu_items
;
1757 f
->menu_bar_items_used
= menu_items_used
;
1762 /* Make a widget-value tree containing
1763 just the top level menu bar strings. */
1765 items
= FRAME_MENU_BAR_ITEMS (f
);
1766 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1770 string
= XVECTOR (items
)->contents
[i
+ 1];
1774 wv
= xmalloc_widget_value ();
1775 wv
->name
= (char *) XSTRING (string
)->data
;
1778 wv
->button_type
= BUTTON_TYPE_NONE
;
1779 /* This prevents lwlib from assuming this
1780 menu item is really supposed to be empty. */
1781 /* The EMACS_INT cast avoids a warning.
1782 This value just has to be different from small integers. */
1783 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1788 first_wv
->contents
= wv
;
1792 /* Forget what we thought we knew about what is in the
1793 detailed contents of the menu bar menus.
1794 Changing the top level always destroys the contents. */
1795 f
->menu_bar_items_used
= 0;
1798 /* Create or update the menu bar widget. */
1804 /* Disable resizing (done for Motif!) */
1805 lw_allow_resizing (f
->output_data
.x
->widget
, False
);
1807 /* The third arg is DEEP_P, which says to consider the entire
1808 menu trees we supply, rather than just the menu bar item names. */
1809 lw_modify_all_widgets (id
, first_wv
, deep_p
);
1811 /* Re-enable the edit widget to resize. */
1812 lw_allow_resizing (f
->output_data
.x
->widget
, True
);
1816 menubar_widget
= lw_create_widget ("menubar", "menubar", id
, first_wv
,
1817 f
->output_data
.x
->column_widget
,
1819 popup_activate_callback
,
1820 menubar_selection_callback
,
1821 popup_deactivate_callback
,
1822 menu_highlight_callback
);
1823 f
->output_data
.x
->menubar_widget
= menubar_widget
;
1828 = (f
->output_data
.x
->menubar_widget
1829 ? (f
->output_data
.x
->menubar_widget
->core
.height
1830 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
1833 #if 0 /* Experimentally, we now get the right results
1834 for -geometry -0-0 without this. 24 Aug 96, rms. */
1836 if (FRAME_EXTERNAL_MENU_BAR (f
))
1839 XtVaGetValues (f
->output_data
.x
->column_widget
,
1840 XtNinternalBorderWidth
, &ibw
, NULL
);
1841 menubar_size
+= ibw
;
1843 #endif /* USE_LUCID */
1846 f
->output_data
.x
->menubar_height
= menubar_size
;
1849 free_menubar_widget_value_tree (first_wv
);
1850 update_frame_menubar (f
);
1855 /* Called from Fx_create_frame to create the initial menubar of a frame
1856 before it is mapped, so that the window is mapped with the menubar already
1857 there instead of us tacking it on later and thrashing the window after it
1861 initialize_frame_menubar (f
)
1864 /* This function is called before the first chance to redisplay
1865 the frame. It has to be, so the frame will have the right size. */
1866 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1867 set_frame_menubar (f
, 1, 1);
1871 /* Get rid of the menu bar of frame F, and free its storage.
1872 This is used when deleting a frame, and when turning off the menu bar. */
1875 free_frame_menubar (f
)
1878 Widget menubar_widget
;
1880 menubar_widget
= f
->output_data
.x
->menubar_widget
;
1882 f
->output_data
.x
->menubar_height
= 0;
1887 /* Removing the menu bar magically changes the shell widget's x
1888 and y position of (0, 0) which, when the menu bar is turned
1889 on again, leads to pull-down menuss appearing in strange
1890 positions near the upper-left corner of the display. This
1891 happens only with some window managers like twm and ctwm,
1892 but not with other like Motif's mwm or kwm, because the
1893 latter generate ConfigureNotify events when the menu bar
1894 is switched off, which fixes the shell position. */
1895 Position x0
, y0
, x1
, y1
;
1901 if (f
->output_data
.x
->widget
)
1902 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x0
, XtNy
, &y0
, NULL
);
1905 lw_destroy_all_widgets ((LWLIB_ID
) f
->output_data
.x
->id
);
1906 f
->output_data
.x
->menubar_widget
= NULL
;
1909 if (f
->output_data
.x
->widget
)
1911 XtVaGetValues (f
->output_data
.x
->widget
, XtNx
, &x1
, XtNy
, &y1
, NULL
);
1912 if (x1
== 0 && y1
== 0)
1913 XtVaSetValues (f
->output_data
.x
->widget
, XtNx
, x0
, XtNy
, y0
, NULL
);
1921 #endif /* USE_X_TOOLKIT */
1923 /* xmenu_show actually displays a menu using the panes and items in menu_items
1924 and returns the value selected from it.
1925 There are two versions of xmenu_show, one for Xt and one for Xlib.
1926 Both assume input is blocked by the caller. */
1928 /* F is the frame the menu is for.
1929 X and Y are the frame-relative specified position,
1930 relative to the inside upper left corner of the frame F.
1931 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1932 KEYMAPS is 1 if this menu was specified with keymaps;
1933 in that case, we return a list containing the chosen item's value
1934 and perhaps also the pane's prefix.
1935 TITLE is the specified menu title.
1936 ERROR is a place to store an error message string in case of failure.
1937 (We return nil on failure, but the value doesn't actually matter.) */
1939 #ifdef USE_X_TOOLKIT
1941 /* We need a unique id for each widget handled by the Lucid Widget
1944 For the main windows, and popup menus, we use this counter,
1945 which we increment each time after use. This starts from 1<<16.
1947 For menu bars, we use numbers starting at 0, counted in
1948 next_menubar_widget_id. */
1949 LWLIB_ID widget_id_tick
;
1951 static Lisp_Object
*volatile menu_item_selection
;
1954 popup_selection_callback (widget
, id
, client_data
)
1957 XtPointer client_data
;
1959 menu_item_selection
= (Lisp_Object
*) client_data
;
1963 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1977 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1978 widget_value
**submenu_stack
1979 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1980 Lisp_Object
*subprefix_stack
1981 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1982 int submenu_depth
= 0;
1983 XButtonPressedEvent dummy
;
1989 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1991 *error
= "Empty menu";
1995 /* Create a tree of widget_value objects
1996 representing the panes and their items. */
1997 wv
= xmalloc_widget_value ();
2001 wv
->button_type
= BUTTON_TYPE_NONE
;
2005 /* Loop over all panes and items, filling in the tree. */
2007 while (i
< menu_items_used
)
2009 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2011 submenu_stack
[submenu_depth
++] = save_wv
;
2017 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2020 save_wv
= submenu_stack
[--submenu_depth
];
2024 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
2025 && submenu_depth
!= 0)
2026 i
+= MENU_ITEMS_PANE_LENGTH
;
2027 /* Ignore a nil in the item list.
2028 It's meaningful only for dialog boxes. */
2029 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2031 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2033 /* Create a new pane. */
2034 Lisp_Object pane_name
, prefix
;
2037 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
2038 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2040 #ifndef HAVE_MULTILINGUAL_MENU
2041 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
2043 pane_name
= string_make_unibyte (pane_name
);
2044 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
2047 pane_string
= (NILP (pane_name
)
2048 ? "" : (char *) XSTRING (pane_name
)->data
);
2049 /* If there is just one top-level pane, put all its items directly
2050 under the top-level menu. */
2051 if (menu_items_n_panes
== 1)
2054 /* If the pane has a meaningful name,
2055 make the pane a top-level menu item
2056 with its items as a submenu beneath it. */
2057 if (!keymaps
&& strcmp (pane_string
, ""))
2059 wv
= xmalloc_widget_value ();
2063 first_wv
->contents
= wv
;
2064 wv
->name
= pane_string
;
2065 if (keymaps
&& !NILP (prefix
))
2069 wv
->button_type
= BUTTON_TYPE_NONE
;
2073 else if (first_pane
)
2079 i
+= MENU_ITEMS_PANE_LENGTH
;
2083 /* Create a new item within current pane. */
2084 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
2085 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2086 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2087 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2088 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
2089 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
2090 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
2091 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2093 #ifndef HAVE_MULTILINGUAL_MENU
2094 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2096 item_name
= string_make_unibyte (item_name
);
2097 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2100 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2102 descrip
= string_make_unibyte (descrip
);
2103 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2105 #endif /* not HAVE_MULTILINGUAL_MENU */
2107 wv
= xmalloc_widget_value ();
2111 save_wv
->contents
= wv
;
2112 wv
->name
= (char *) XSTRING (item_name
)->data
;
2113 if (!NILP (descrip
))
2114 wv
->key
= (char *) XSTRING (descrip
)->data
;
2116 /* If this item has a null value,
2117 make the call_data null so that it won't display a box
2118 when the mouse is on it. */
2120 = (!NILP (def
) ? (void *) &XVECTOR (menu_items
)->contents
[i
] : 0);
2121 wv
->enabled
= !NILP (enable
);
2124 wv
->button_type
= BUTTON_TYPE_NONE
;
2125 else if (EQ (type
, QCtoggle
))
2126 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2127 else if (EQ (type
, QCradio
))
2128 wv
->button_type
= BUTTON_TYPE_RADIO
;
2132 wv
->selected
= !NILP (selected
);
2134 wv
->help
= XSTRING (help
)->data
;
2138 i
+= MENU_ITEMS_ITEM_LENGTH
;
2142 /* Deal with the title, if it is non-nil. */
2145 widget_value
*wv_title
= xmalloc_widget_value ();
2146 widget_value
*wv_sep1
= xmalloc_widget_value ();
2147 widget_value
*wv_sep2
= xmalloc_widget_value ();
2149 wv_sep2
->name
= "--";
2150 wv_sep2
->next
= first_wv
->contents
;
2152 wv_sep1
->name
= "--";
2153 wv_sep1
->next
= wv_sep2
;
2155 #ifndef HAVE_MULTILINGUAL_MENU
2156 if (STRING_MULTIBYTE (title
))
2157 title
= string_make_unibyte (title
);
2160 wv_title
->name
= (char *) XSTRING (title
)->data
;
2161 wv_title
->enabled
= True
;
2162 wv_title
->button_type
= BUTTON_TYPE_NONE
;
2163 wv_title
->next
= wv_sep1
;
2164 first_wv
->contents
= wv_title
;
2167 /* Actually create the menu. */
2168 menu_id
= widget_id_tick
++;
2169 menu
= lw_create_widget ("popup", first_wv
->name
, menu_id
, first_wv
,
2170 f
->output_data
.x
->widget
, 1, 0,
2171 popup_selection_callback
,
2172 popup_deactivate_callback
,
2173 menu_highlight_callback
);
2175 /* Adjust coordinates to relative to the outer (window manager) window. */
2178 int win_x
= 0, win_y
= 0;
2180 /* Find the position of the outside upper-left corner of
2181 the inner window, with respect to the outer window. */
2182 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2185 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2187 /* From-window, to-window. */
2188 f
->output_data
.x
->window_desc
,
2189 f
->output_data
.x
->parent_desc
,
2191 /* From-position, to-position. */
2192 0, 0, &win_x
, &win_y
,
2194 /* Child of window. */
2202 /* Adjust coordinates to be root-window-relative. */
2203 x
+= f
->output_data
.x
->left_pos
;
2204 y
+= f
->output_data
.x
->top_pos
;
2206 dummy
.type
= ButtonPress
;
2208 dummy
.send_event
= 0;
2209 dummy
.display
= FRAME_X_DISPLAY (f
);
2210 dummy
.time
= CurrentTime
;
2211 dummy
.root
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
2212 dummy
.window
= dummy
.root
;
2213 dummy
.subwindow
= dummy
.root
;
2218 dummy
.state
= (FRAME_X_DISPLAY_INFO (f
)->grabbed
>> 1) * Button1Mask
;
2220 for (i
= 0; i
< 5; i
++)
2221 if (FRAME_X_DISPLAY_INFO (f
)->grabbed
& (1 << i
))
2224 /* Don't allow any geometry request from the user. */
2225 XtSetArg (av
[ac
], XtNgeometry
, 0); ac
++;
2226 XtSetValues (menu
, av
, ac
);
2228 /* Free the widget_value objects we used to specify the contents. */
2229 free_menubar_widget_value_tree (first_wv
);
2231 /* No selection has been chosen yet. */
2232 menu_item_selection
= 0;
2234 /* Display the menu. */
2235 lw_popup_menu (menu
, (XEvent
*) &dummy
);
2236 popup_activated_flag
= 1;
2238 /* Process events that apply to the menu. */
2239 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), menu_id
);
2241 /* fp turned off the following statement and wrote a comment
2242 that it is unnecessary--that the menu has already disappeared.
2243 Nowadays the menu disappears ok, all right, but
2244 we need to delete the widgets or multiple ones will pile up. */
2245 lw_destroy_all_widgets (menu_id
);
2247 /* Find the selected item, and its pane, to return
2248 the proper value. */
2249 if (menu_item_selection
!= 0)
2251 Lisp_Object prefix
, entry
;
2253 prefix
= entry
= Qnil
;
2255 while (i
< menu_items_used
)
2257 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2259 subprefix_stack
[submenu_depth
++] = prefix
;
2263 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2265 prefix
= subprefix_stack
[--submenu_depth
];
2268 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2271 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2272 i
+= MENU_ITEMS_PANE_LENGTH
;
2274 /* Ignore a nil in the item list.
2275 It's meaningful only for dialog boxes. */
2276 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2281 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2282 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2288 entry
= Fcons (entry
, Qnil
);
2290 entry
= Fcons (prefix
, entry
);
2291 for (j
= submenu_depth
- 1; j
>= 0; j
--)
2292 if (!NILP (subprefix_stack
[j
]))
2293 entry
= Fcons (subprefix_stack
[j
], entry
);
2297 i
+= MENU_ITEMS_ITEM_LENGTH
;
2306 dialog_selection_callback (widget
, id
, client_data
)
2309 XtPointer client_data
;
2311 /* The EMACS_INT cast avoids a warning. There's no problem
2312 as long as pointers have enough bits to hold small integers. */
2313 if ((int) (EMACS_INT
) client_data
!= -1)
2314 menu_item_selection
= (Lisp_Object
*) client_data
;
2316 lw_destroy_all_widgets (id
);
2318 popup_activated_flag
= 0;
2321 static char * button_names
[] = {
2322 "button1", "button2", "button3", "button4", "button5",
2323 "button6", "button7", "button8", "button9", "button10" };
2326 xdialog_show (f
, keymaps
, title
, error
)
2332 int i
, nb_buttons
=0;
2335 char dialog_name
[6];
2337 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2339 /* Number of elements seen so far, before boundary. */
2341 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2342 int boundary_seen
= 0;
2346 if (menu_items_n_panes
> 1)
2348 *error
= "Multiple panes in dialog box";
2352 /* Create a tree of widget_value objects
2353 representing the text label and buttons. */
2355 Lisp_Object pane_name
, prefix
;
2357 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2358 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2359 pane_string
= (NILP (pane_name
)
2360 ? "" : (char *) XSTRING (pane_name
)->data
);
2361 prev_wv
= xmalloc_widget_value ();
2362 prev_wv
->value
= pane_string
;
2363 if (keymaps
&& !NILP (prefix
))
2365 prev_wv
->enabled
= 1;
2366 prev_wv
->name
= "message";
2369 /* Loop over all panes and items, filling in the tree. */
2370 i
= MENU_ITEMS_PANE_LENGTH
;
2371 while (i
< menu_items_used
)
2374 /* Create a new item within current pane. */
2375 Lisp_Object item_name
, enable
, descrip
;
2376 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2377 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2379 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2381 if (NILP (item_name
))
2383 free_menubar_widget_value_tree (first_wv
);
2384 *error
= "Submenu in dialog items";
2387 if (EQ (item_name
, Qquote
))
2389 /* This is the boundary between left-side elts
2390 and right-side elts. Stop incrementing right_count. */
2395 if (nb_buttons
>= 9)
2397 free_menubar_widget_value_tree (first_wv
);
2398 *error
= "Too many dialog items";
2402 wv
= xmalloc_widget_value ();
2404 wv
->name
= (char *) button_names
[nb_buttons
];
2405 if (!NILP (descrip
))
2406 wv
->key
= (char *) XSTRING (descrip
)->data
;
2407 wv
->value
= (char *) XSTRING (item_name
)->data
;
2408 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
2409 wv
->enabled
= !NILP (enable
);
2412 if (! boundary_seen
)
2416 i
+= MENU_ITEMS_ITEM_LENGTH
;
2419 /* If the boundary was not specified,
2420 by default put half on the left and half on the right. */
2421 if (! boundary_seen
)
2422 left_count
= nb_buttons
- nb_buttons
/ 2;
2424 wv
= xmalloc_widget_value ();
2425 wv
->name
= dialog_name
;
2427 /* Dialog boxes use a really stupid name encoding
2428 which specifies how many buttons to use
2429 and how many buttons are on the right.
2430 The Q means something also. */
2431 dialog_name
[0] = 'Q';
2432 dialog_name
[1] = '0' + nb_buttons
;
2433 dialog_name
[2] = 'B';
2434 dialog_name
[3] = 'R';
2435 /* Number of buttons to put on the right. */
2436 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2438 wv
->contents
= first_wv
;
2442 /* Actually create the dialog. */
2443 dialog_id
= widget_id_tick
++;
2444 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2445 f
->output_data
.x
->widget
, 1, 0,
2446 dialog_selection_callback
, 0, 0);
2447 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2448 /* Free the widget_value objects we used to specify the contents. */
2449 free_menubar_widget_value_tree (first_wv
);
2451 /* No selection has been chosen yet. */
2452 menu_item_selection
= 0;
2454 /* Display the menu. */
2455 lw_pop_up_all_widgets (dialog_id
);
2456 popup_activated_flag
= 1;
2458 /* Process events that apply to the menu. */
2459 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2461 lw_destroy_all_widgets (dialog_id
);
2463 /* Find the selected item, and its pane, to return
2464 the proper value. */
2465 if (menu_item_selection
!= 0)
2471 while (i
< menu_items_used
)
2475 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2478 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2479 i
+= MENU_ITEMS_PANE_LENGTH
;
2481 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2483 /* This is the boundary between left-side elts and
2490 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2491 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2495 entry
= Fcons (entry
, Qnil
);
2497 entry
= Fcons (prefix
, entry
);
2501 i
+= MENU_ITEMS_ITEM_LENGTH
;
2509 #else /* not USE_X_TOOLKIT */
2511 /* The frame of the last activated non-toolkit menu bar.
2512 Used to generate menu help events. */
2514 static struct frame
*menu_help_frame
;
2517 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
2519 PANE is the pane number, and ITEM is the menu item number in
2520 the menu (currently not used).
2522 This cannot be done with generating a HELP_EVENT because
2523 XMenuActivate contains a loop that doesn't let Emacs process
2527 menu_help_callback (help_string
, pane
, item
)
2531 extern Lisp_Object Qmenu_item
;
2532 Lisp_Object
*first_item
;
2533 Lisp_Object pane_name
;
2534 Lisp_Object menu_object
;
2536 first_item
= XVECTOR (menu_items
)->contents
;
2537 if (EQ (first_item
[0], Qt
))
2538 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2539 else if (EQ (first_item
[0], Qquote
))
2540 /* This shouldn't happen, see xmenu_show. */
2541 pane_name
= build_string ("");
2543 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2545 /* (menu-item MENU-NAME PANE-NUMBER) */
2546 menu_object
= Fcons (Qmenu_item
,
2548 Fcons (make_number (pane
), Qnil
)));
2549 show_help_echo (help_string
? build_string (help_string
) : Qnil
,
2550 Qnil
, menu_object
, make_number (item
), 1);
2555 xmenu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2565 int pane
, selidx
, lpane
, status
;
2566 Lisp_Object entry
, pane_prefix
;
2568 int ulx
, uly
, width
, height
;
2569 int dispwidth
, dispheight
;
2573 unsigned int dummy_uint
;
2576 if (menu_items_n_panes
== 0)
2579 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2581 *error
= "Empty menu";
2585 /* Figure out which root window F is on. */
2586 XGetGeometry (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &root
,
2587 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
2588 &dummy_uint
, &dummy_uint
);
2590 /* Make the menu on that window. */
2591 menu
= XMenuCreate (FRAME_X_DISPLAY (f
), root
, "emacs");
2594 *error
= "Can't create menu";
2598 #ifdef HAVE_X_WINDOWS
2599 /* Adjust coordinates to relative to the outer (window manager) window. */
2602 int win_x
= 0, win_y
= 0;
2604 /* Find the position of the outside upper-left corner of
2605 the inner window, with respect to the outer window. */
2606 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
2609 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
2611 /* From-window, to-window. */
2612 f
->output_data
.x
->window_desc
,
2613 f
->output_data
.x
->parent_desc
,
2615 /* From-position, to-position. */
2616 0, 0, &win_x
, &win_y
,
2618 /* Child of window. */
2625 #endif /* HAVE_X_WINDOWS */
2627 /* Adjust coordinates to be root-window-relative. */
2628 x
+= f
->output_data
.x
->left_pos
;
2629 y
+= f
->output_data
.x
->top_pos
;
2631 /* Create all the necessary panes and their items. */
2633 while (i
< menu_items_used
)
2635 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2637 /* Create a new pane. */
2638 Lisp_Object pane_name
, prefix
;
2641 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
2642 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2643 pane_string
= (NILP (pane_name
)
2644 ? "" : (char *) XSTRING (pane_name
)->data
);
2645 if (keymaps
&& !NILP (prefix
))
2648 lpane
= XMenuAddPane (FRAME_X_DISPLAY (f
), menu
, pane_string
, TRUE
);
2649 if (lpane
== XM_FAILURE
)
2651 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2652 *error
= "Can't create pane";
2655 i
+= MENU_ITEMS_PANE_LENGTH
;
2657 /* Find the width of the widest item in this pane. */
2660 while (j
< menu_items_used
)
2663 item
= XVECTOR (menu_items
)->contents
[j
];
2671 width
= STRING_BYTES (XSTRING (item
));
2672 if (width
> maxwidth
)
2675 j
+= MENU_ITEMS_ITEM_LENGTH
;
2678 /* Ignore a nil in the item list.
2679 It's meaningful only for dialog boxes. */
2680 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2684 /* Create a new item within current pane. */
2685 Lisp_Object item_name
, enable
, descrip
, help
;
2686 unsigned char *item_data
;
2689 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2690 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2692 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2693 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2694 help_string
= STRINGP (help
) ? XSTRING (help
)->data
: NULL
;
2696 if (!NILP (descrip
))
2698 int gap
= maxwidth
- STRING_BYTES (XSTRING (item_name
));
2701 spacer
= Fmake_string (make_number (gap
), make_number (' '));
2702 item_name
= concat2 (item_name
, spacer
);
2703 item_name
= concat2 (item_name
, descrip
);
2704 item_data
= XSTRING (item_name
)->data
;
2706 /* if alloca is fast, use that to make the space,
2707 to reduce gc needs. */
2709 = (unsigned char *) alloca (maxwidth
2710 + STRING_BYTES (XSTRING (descrip
)) + 1);
2711 bcopy (XSTRING (item_name
)->data
, item_data
,
2712 STRING_BYTES (XSTRING (item_name
)));
2713 for (j
= XSTRING (item_name
)->size
; j
< maxwidth
; j
++)
2715 bcopy (XSTRING (descrip
)->data
, item_data
+ j
,
2716 STRING_BYTES (XSTRING (descrip
)));
2717 item_data
[j
+ STRING_BYTES (XSTRING (descrip
))] = 0;
2721 item_data
= XSTRING (item_name
)->data
;
2723 if (XMenuAddSelection (FRAME_X_DISPLAY (f
),
2724 menu
, lpane
, 0, item_data
,
2725 !NILP (enable
), help_string
)
2728 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2729 *error
= "Can't add selection to menu";
2732 i
+= MENU_ITEMS_ITEM_LENGTH
;
2736 /* All set and ready to fly. */
2737 XMenuRecompute (FRAME_X_DISPLAY (f
), menu
);
2738 dispwidth
= DisplayWidth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2739 dispheight
= DisplayHeight (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
));
2740 x
= min (x
, dispwidth
);
2741 y
= min (y
, dispheight
);
2744 XMenuLocate (FRAME_X_DISPLAY (f
), menu
, 0, 0, x
, y
,
2745 &ulx
, &uly
, &width
, &height
);
2746 if (ulx
+width
> dispwidth
)
2748 x
-= (ulx
+ width
) - dispwidth
;
2749 ulx
= dispwidth
- width
;
2751 if (uly
+height
> dispheight
)
2753 y
-= (uly
+ height
) - dispheight
;
2754 uly
= dispheight
- height
;
2756 if (ulx
< 0) x
-= ulx
;
2757 if (uly
< 0) y
-= uly
;
2759 XMenuSetAEQ (menu
, TRUE
);
2760 XMenuSetFreeze (menu
, TRUE
);
2763 /* Help display under X won't work because XMenuActivate contains
2764 a loop that doesn't give Emacs a chance to process it. */
2765 menu_help_frame
= f
;
2766 status
= XMenuActivate (FRAME_X_DISPLAY (f
), menu
, &pane
, &selidx
,
2767 x
, y
, ButtonReleaseMask
, &datap
,
2768 menu_help_callback
);
2771 #ifdef HAVE_X_WINDOWS
2772 /* Assume the mouse has moved out of the X window.
2773 If it has actually moved in, we will get an EnterNotify. */
2774 x_mouse_leave (FRAME_X_DISPLAY_INFO (f
));
2781 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
2784 /* Find the item number SELIDX in pane number PANE. */
2786 while (i
< menu_items_used
)
2788 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2792 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2794 i
+= MENU_ITEMS_PANE_LENGTH
;
2803 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2806 entry
= Fcons (entry
, Qnil
);
2807 if (!NILP (pane_prefix
))
2808 entry
= Fcons (pane_prefix
, entry
);
2814 i
+= MENU_ITEMS_ITEM_LENGTH
;
2820 *error
= "Can't activate menu";
2826 XMenuDestroy (FRAME_X_DISPLAY (f
), menu
);
2828 #ifdef HAVE_X_WINDOWS
2829 /* State that no mouse buttons are now held.
2830 (The oldXMenu code doesn't track this info for us.)
2831 That is not necessarily true, but the fiction leads to reasonable
2832 results, and it is a pain to ask which are actually held now. */
2833 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
2839 #endif /* not USE_X_TOOLKIT */
2841 #endif /* HAVE_MENUS */
2846 staticpro (&menu_items
);
2849 Qdebug_on_next_call
= intern ("debug-on-next-call");
2850 staticpro (&Qdebug_on_next_call
);
2852 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2853 doc
: /* Frame for which we are updating a menu.
2854 The enable predicate for a menu command should check this variable. */);
2855 Vmenu_updating_frame
= Qnil
;
2857 #ifdef USE_X_TOOLKIT
2858 widget_id_tick
= (1<<16);
2859 next_menubar_widget_id
= 1;
2862 defsubr (&Sx_popup_menu
);
2864 defsubr (&Sx_popup_dialog
);