* lisp/minibuffer.el (completion--twq-all): Disable too-strict assertions.
[emacs.git] / src / xmenu.c
blob01d932cf8d85452507034a24aaaed76c269659c4
1 /* X Communication module for terminals which understand the X protocol.
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2012
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* X pop-up deck-of-cards menu facility for GNU Emacs.
23 * Written by Jon Arnold and Roman Budzianowski
24 * Mods and rewrite by Robert Krawitz
28 /* Modified by Fred Pierresteguy on December 93
29 to make the popup menus and menubar use the Xt. */
31 /* Rewritten for clarity and GC protection by rms in Feb 94. */
33 #include <config.h>
35 #include <stdio.h>
37 #include "lisp.h"
38 #include "keyboard.h"
39 #include "keymap.h"
40 #include "frame.h"
41 #include "termhooks.h"
42 #include "window.h"
43 #include "blockinput.h"
44 #include "character.h"
45 #include "buffer.h"
46 #include "charset.h"
47 #include "coding.h"
48 #include "sysselect.h"
50 #ifdef MSDOS
51 #include "msdos.h"
52 #endif
54 #ifdef HAVE_X_WINDOWS
55 /* This may include sys/types.h, and that somehow loses
56 if this is not done before the other system files. */
57 #include "xterm.h"
58 #endif
60 /* Load sys/types.h if not already loaded.
61 In some systems loading it twice is suicidal. */
62 #ifndef makedev
63 #include <sys/types.h>
64 #endif
66 #include "dispextern.h"
68 #ifdef HAVE_X_WINDOWS
69 /* Defining HAVE_MULTILINGUAL_MENU would mean that the toolkit menu
70 code accepts the Emacs internal encoding. */
71 #undef HAVE_MULTILINGUAL_MENU
72 #ifdef USE_X_TOOLKIT
73 #include "widget.h"
74 #include <X11/Xlib.h>
75 #include <X11/IntrinsicP.h>
76 #include <X11/CoreP.h>
77 #include <X11/StringDefs.h>
78 #include <X11/Shell.h>
79 #ifdef USE_LUCID
80 #include "xsettings.h"
81 #include "../lwlib/xlwmenu.h"
82 #ifdef HAVE_XAW3D
83 #include <X11/Xaw3d/Paned.h>
84 #else /* !HAVE_XAW3D */
85 #include <X11/Xaw/Paned.h>
86 #endif /* HAVE_XAW3D */
87 #endif /* USE_LUCID */
88 #ifdef USE_MOTIF
89 #include "../lwlib/lwlib.h"
90 #endif
91 #else /* not USE_X_TOOLKIT */
92 #ifndef USE_GTK
93 #include "../oldXMenu/XMenu.h"
94 #endif
95 #endif /* not USE_X_TOOLKIT */
96 #endif /* HAVE_X_WINDOWS */
98 #ifdef USE_GTK
99 #include "gtkutil.h"
100 #ifdef HAVE_GTK3
101 #include "xgselect.h"
102 #endif
103 #endif
105 #include "menu.h"
107 #ifndef TRUE
108 #define TRUE 1
109 #endif /* no TRUE */
111 static Lisp_Object Qdebug_on_next_call;
113 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
114 static Lisp_Object xdialog_show (FRAME_PTR, bool, Lisp_Object, Lisp_Object,
115 const char **);
116 #endif
118 /* Flag which when set indicates a dialog or menu has been posted by
119 Xt on behalf of one of the widget sets. */
120 static int popup_activated_flag;
123 #ifdef USE_X_TOOLKIT
125 static int next_menubar_widget_id;
127 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
129 static struct frame *
130 menubar_id_to_frame (LWLIB_ID id)
132 Lisp_Object tail, frame;
133 FRAME_PTR f;
135 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
137 frame = XCAR (tail);
138 if (!FRAMEP (frame))
139 continue;
140 f = XFRAME (frame);
141 if (!FRAME_WINDOW_P (f))
142 continue;
143 if (f->output_data.x->id == id)
144 return f;
146 return 0;
149 #endif
151 #ifdef HAVE_X_WINDOWS
152 /* Return the mouse position in *X and *Y. The coordinates are window
153 relative for the edit window in frame F.
154 This is for Fx_popup_menu. The mouse_position_hook can not
155 be used for X, as it returns window relative coordinates
156 for the window where the mouse is in. This could be the menu bar,
157 the scroll bar or the edit window. Fx_popup_menu needs to be
158 sure it is the edit window. */
159 void
160 mouse_position_for_popup (FRAME_PTR f, int *x, int *y)
162 Window root, dummy_window;
163 int dummy;
165 if (! FRAME_X_P (f))
166 emacs_abort ();
168 block_input ();
170 XQueryPointer (FRAME_X_DISPLAY (f),
171 DefaultRootWindow (FRAME_X_DISPLAY (f)),
173 /* The root window which contains the pointer. */
174 &root,
176 /* Window pointer is on, not used */
177 &dummy_window,
179 /* The position on that root window. */
180 x, y,
182 /* x/y in dummy_window coordinates, not used. */
183 &dummy, &dummy,
185 /* Modifier keys and pointer buttons, about which
186 we don't care. */
187 (unsigned int *) &dummy);
189 unblock_input ();
191 /* xmenu_show expects window coordinates, not root window
192 coordinates. Translate. */
193 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
194 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
197 #endif /* HAVE_X_WINDOWS */
199 #ifdef HAVE_MENUS
201 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
202 doc: /* Pop up a dialog box and return user's selection.
203 POSITION specifies which frame to use.
204 This is normally a mouse button event or a window or frame.
205 If POSITION is t, it means to use the frame the mouse is on.
206 The dialog box appears in the middle of the specified frame.
208 CONTENTS specifies the alternatives to display in the dialog box.
209 It is a list of the form (DIALOG ITEM1 ITEM2...).
210 Each ITEM is a cons cell (STRING . VALUE).
211 The return value is VALUE from the chosen item.
213 An ITEM may also be just a string--that makes a nonselectable item.
214 An ITEM may also be nil--that means to put all preceding items
215 on the left of the dialog box and all following items on the right.
216 \(By default, approximately half appear on each side.)
218 If HEADER is non-nil, the frame title for the box is "Information",
219 otherwise it is "Question".
221 If the user gets rid of the dialog box without making a valid choice,
222 for instance using the window manager, then this produces a quit and
223 `x-popup-dialog' does not return. */)
224 (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
226 FRAME_PTR f = NULL;
227 Lisp_Object window;
229 check_x ();
231 /* Decode the first argument: find the window or frame to use. */
232 if (EQ (position, Qt)
233 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
234 || EQ (XCAR (position), Qtool_bar))))
236 #if 0 /* Using the frame the mouse is on may not be right. */
237 /* Use the mouse's current position. */
238 FRAME_PTR new_f = SELECTED_FRAME ();
239 Lisp_Object bar_window;
240 enum scroll_bar_part part;
241 Time time;
242 Lisp_Object x, y;
244 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
246 if (new_f != 0)
247 XSETFRAME (window, new_f);
248 else
249 window = selected_window;
250 #endif
251 window = selected_window;
253 else if (CONSP (position))
255 Lisp_Object tem = XCAR (position);
256 if (CONSP (tem))
257 window = Fcar (XCDR (position));
258 else
260 tem = Fcar (XCDR (position)); /* EVENT_START (position) */
261 window = Fcar (tem); /* POSN_WINDOW (tem) */
264 else if (WINDOWP (position) || FRAMEP (position))
265 window = position;
266 else
267 window = Qnil;
269 /* Decode where to put the menu. */
271 if (FRAMEP (window))
272 f = XFRAME (window);
273 else if (WINDOWP (window))
275 CHECK_LIVE_WINDOW (window);
276 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
278 else
279 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
280 but I don't want to make one now. */
281 CHECK_WINDOW (window);
283 if (! FRAME_X_P (f) && ! FRAME_MSDOS_P (f))
284 error ("Can not put X dialog on this terminal");
286 /* Force a redisplay before showing the dialog. If a frame is created
287 just before showing the dialog, its contents may not have been fully
288 drawn, as this depends on timing of events from the X server. Redisplay
289 is not done when a dialog is shown. If redisplay could be done in the
290 X event loop (i.e. the X event loop does not run in a signal handler)
291 this would not be needed.
293 Do this before creating the widget value that points to Lisp
294 string contents, because Fredisplay may GC and relocate them. */
295 Fredisplay (Qt);
297 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
298 /* Display a menu with these alternatives
299 in the middle of frame F. */
301 Lisp_Object x, y, frame, newpos;
302 XSETFRAME (frame, f);
303 XSETINT (x, x_pixel_width (f) / 2);
304 XSETINT (y, x_pixel_height (f) / 2);
305 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
307 return Fx_popup_menu (newpos,
308 Fcons (Fcar (contents), Fcons (contents, Qnil)));
310 #else
312 Lisp_Object title;
313 const char *error_name;
314 Lisp_Object selection;
315 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
317 /* Decode the dialog items from what was specified. */
318 title = Fcar (contents);
319 CHECK_STRING (title);
320 record_unwind_protect (unuse_menu_items, Qnil);
322 if (NILP (Fcar (Fcdr (contents))))
323 /* No buttons specified, add an "Ok" button so users can pop down
324 the dialog. Also, the lesstif/motif version crashes if there are
325 no buttons. */
326 contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil));
328 list_of_panes (Fcons (contents, Qnil));
330 /* Display them in a dialog box. */
331 block_input ();
332 selection = xdialog_show (f, 0, title, header, &error_name);
333 unblock_input ();
335 unbind_to (specpdl_count, Qnil);
336 discard_menu_items ();
338 if (error_name) error ("%s", error_name);
339 return selection;
341 #endif
345 #ifndef MSDOS
347 #if defined USE_GTK || defined USE_MOTIF
349 /* Set menu_items_inuse so no other popup menu or dialog is created. */
351 void
352 x_menu_set_in_use (int in_use)
354 menu_items_inuse = in_use ? Qt : Qnil;
355 popup_activated_flag = in_use;
356 #ifdef USE_X_TOOLKIT
357 if (popup_activated_flag)
358 x_activate_timeout_atimer ();
359 #endif
362 #endif
364 /* Wait for an X event to arrive or for a timer to expire. */
366 #ifndef USE_MOTIF
367 static
368 #endif
369 void
370 x_menu_wait_for_event (void *data)
372 /* Another way to do this is to register a timer callback, that can be
373 done in GTK and Xt. But we have to do it like this when using only X
374 anyway, and with callbacks we would have three variants for timer handling
375 instead of the small ifdefs below. */
377 while (
378 #ifdef USE_X_TOOLKIT
379 ! XtAppPending (Xt_app_con)
380 #elif defined USE_GTK
381 ! gtk_events_pending ()
382 #else
383 ! XPending ((Display*) data)
384 #endif
387 EMACS_TIME next_time = timer_check (), *ntp;
388 SELECT_TYPE read_fds;
389 struct x_display_info *dpyinfo;
390 int n = 0;
392 FD_ZERO (&read_fds);
393 for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
395 int fd = ConnectionNumber (dpyinfo->display);
396 FD_SET (fd, &read_fds);
397 if (fd > n) n = fd;
398 XFlush (dpyinfo->display);
401 if (! EMACS_TIME_VALID_P (next_time))
402 ntp = 0;
403 else
404 ntp = &next_time;
406 #ifdef HAVE_GTK3
407 /* Gtk3 have arrows on menus when they don't fit. When the
408 pointer is over an arrow, a timeout scrolls it a bit. Use
409 xg_select so that timeout gets triggered. */
410 xg_select (n + 1, &read_fds, NULL, NULL, ntp, NULL);
411 #else
412 pselect (n + 1, &read_fds, NULL, NULL, ntp, NULL);
413 #endif
416 #endif /* ! MSDOS */
419 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
421 #ifdef USE_X_TOOLKIT
423 /* Loop in Xt until the menu pulldown or dialog popup has been
424 popped down (deactivated). This is used for x-popup-menu
425 and x-popup-dialog; it is not used for the menu bar.
427 NOTE: All calls to popup_get_selection should be protected
428 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
430 static void
431 popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, LWLIB_ID id, int do_timers)
433 XEvent event;
435 while (popup_activated_flag)
437 if (initial_event)
439 event = *initial_event;
440 initial_event = 0;
442 else
444 if (do_timers) x_menu_wait_for_event (0);
445 XtAppNextEvent (Xt_app_con, &event);
448 /* Make sure we don't consider buttons grabbed after menu goes.
449 And make sure to deactivate for any ButtonRelease,
450 even if XtDispatchEvent doesn't do that. */
451 if (event.type == ButtonRelease
452 && dpyinfo->display == event.xbutton.display)
454 dpyinfo->grabbed &= ~(1 << event.xbutton.button);
455 #ifdef USE_MOTIF /* Pretending that the event came from a
456 Btn1Down seems the only way to convince Motif to
457 activate its callbacks; setting the XmNmenuPost
458 isn't working. --marcus@sysc.pdx.edu. */
459 event.xbutton.button = 1;
460 /* Motif only pops down menus when no Ctrl, Alt or Mod
461 key is pressed and the button is released. So reset key state
462 so Motif thinks this is the case. */
463 event.xbutton.state = 0;
464 #endif
466 /* Pop down on C-g and Escape. */
467 else if (event.type == KeyPress
468 && dpyinfo->display == event.xbutton.display)
470 KeySym keysym = XLookupKeysym (&event.xkey, 0);
472 if ((keysym == XK_g && (event.xkey.state & ControlMask) != 0)
473 || keysym == XK_Escape) /* Any escape, ignore modifiers. */
474 popup_activated_flag = 0;
477 x_dispatch_event (&event, event.xany.display);
481 DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_internal, 0, 1, "i",
482 doc: /* Start key navigation of the menu bar in FRAME.
483 This initially opens the first menu bar item and you can then navigate with the
484 arrow keys, select a menu entry with the return key or cancel with the
485 escape key. If FRAME has no menu bar this function does nothing.
487 If FRAME is nil or not given, use the selected frame. */)
488 (Lisp_Object frame)
490 XEvent ev;
491 FRAME_PTR f = check_x_frame (frame);
492 Widget menubar;
493 block_input ();
495 if (FRAME_EXTERNAL_MENU_BAR (f))
496 set_frame_menubar (f, 0, 1);
498 menubar = FRAME_X_OUTPUT (f)->menubar_widget;
499 if (menubar)
501 Window child;
502 int error_p = 0;
504 x_catch_errors (FRAME_X_DISPLAY (f));
505 memset (&ev, 0, sizeof ev);
506 ev.xbutton.display = FRAME_X_DISPLAY (f);
507 ev.xbutton.window = XtWindow (menubar);
508 ev.xbutton.root = FRAME_X_DISPLAY_INFO (f)->root_window;
509 ev.xbutton.time = XtLastTimestampProcessed (FRAME_X_DISPLAY (f));
510 ev.xbutton.button = Button1;
511 ev.xbutton.x = ev.xbutton.y = FRAME_MENUBAR_HEIGHT (f) / 2;
512 ev.xbutton.same_screen = True;
514 #ifdef USE_MOTIF
516 Arg al[2];
517 WidgetList list;
518 Cardinal nr;
519 XtSetArg (al[0], XtNchildren, &list);
520 XtSetArg (al[1], XtNnumChildren, &nr);
521 XtGetValues (menubar, al, 2);
522 ev.xbutton.window = XtWindow (list[0]);
524 #endif
526 XTranslateCoordinates (FRAME_X_DISPLAY (f),
527 /* From-window, to-window. */
528 ev.xbutton.window, ev.xbutton.root,
530 /* From-position, to-position. */
531 ev.xbutton.x, ev.xbutton.y,
532 &ev.xbutton.x_root, &ev.xbutton.y_root,
534 /* Child of win. */
535 &child);
536 error_p = x_had_errors_p (FRAME_X_DISPLAY (f));
537 x_uncatch_errors ();
539 if (! error_p)
541 ev.type = ButtonPress;
542 ev.xbutton.state = 0;
544 XtDispatchEvent (&ev);
545 ev.xbutton.type = ButtonRelease;
546 ev.xbutton.state = Button1Mask;
547 XtDispatchEvent (&ev);
551 unblock_input ();
553 return Qnil;
555 #endif /* USE_X_TOOLKIT */
558 #ifdef USE_GTK
559 DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_internal, 0, 1, "i",
560 doc: /* Start key navigation of the menu bar in FRAME.
561 This initially opens the first menu bar item and you can then navigate with the
562 arrow keys, select a menu entry with the return key or cancel with the
563 escape key. If FRAME has no menu bar this function does nothing.
565 If FRAME is nil or not given, use the selected frame. */)
566 (Lisp_Object frame)
568 GtkWidget *menubar;
569 FRAME_PTR f;
571 /* gcc 2.95 doesn't accept the FRAME_PTR declaration after
572 block_input (). */
574 block_input ();
575 f = check_x_frame (frame);
577 if (FRAME_EXTERNAL_MENU_BAR (f))
578 set_frame_menubar (f, 0, 1);
580 menubar = FRAME_X_OUTPUT (f)->menubar_widget;
581 if (menubar)
583 /* Activate the first menu. */
584 GList *children = gtk_container_get_children (GTK_CONTAINER (menubar));
586 if (children)
588 g_signal_emit_by_name (children->data, "activate_item");
589 popup_activated_flag = 1;
590 g_list_free (children);
593 unblock_input ();
595 return Qnil;
598 /* Loop util popup_activated_flag is set to zero in a callback.
599 Used for popup menus and dialogs. */
601 static void
602 popup_widget_loop (int do_timers, GtkWidget *widget)
604 ++popup_activated_flag;
606 /* Process events in the Gtk event loop until done. */
607 while (popup_activated_flag)
609 if (do_timers) x_menu_wait_for_event (0);
610 gtk_main_iteration ();
613 #endif
615 /* Activate the menu bar of frame F.
616 This is called from keyboard.c when it gets the
617 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
619 To activate the menu bar, we use the X button-press event
620 that was saved in saved_menu_event.
621 That makes the toolkit do its thing.
623 But first we recompute the menu bar contents (the whole tree).
625 The reason for saving the button event until here, instead of
626 passing it to the toolkit right away, is that we can safely
627 execute Lisp code. */
629 void
630 x_activate_menubar (FRAME_PTR f)
632 if (! FRAME_X_P (f))
633 emacs_abort ();
635 if (!f->output_data.x->saved_menu_event->type)
636 return;
638 #ifdef USE_GTK
639 if (! xg_win_to_widget (FRAME_X_DISPLAY (f),
640 f->output_data.x->saved_menu_event->xany.window))
641 return;
642 #endif
644 set_frame_menubar (f, 0, 1);
645 block_input ();
646 popup_activated_flag = 1;
647 #ifdef USE_GTK
648 XPutBackEvent (f->output_data.x->display_info->display,
649 f->output_data.x->saved_menu_event);
650 #else
651 XtDispatchEvent (f->output_data.x->saved_menu_event);
652 #endif
653 unblock_input ();
655 /* Ignore this if we get it a second time. */
656 f->output_data.x->saved_menu_event->type = 0;
659 /* This callback is invoked when the user selects a menubar cascade
660 pushbutton, but before the pulldown menu is posted. */
662 #ifndef USE_GTK
663 static void
664 popup_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
666 popup_activated_flag = 1;
667 #ifdef USE_X_TOOLKIT
668 x_activate_timeout_atimer ();
669 #endif
671 #endif
673 /* This callback is invoked when a dialog or menu is finished being
674 used and has been unposted. */
676 static void
677 popup_deactivate_callback (
678 #ifdef USE_GTK
679 GtkWidget *widget, gpointer client_data
680 #else
681 Widget widget, LWLIB_ID id, XtPointer client_data
682 #endif
685 popup_activated_flag = 0;
689 /* Function that finds the frame for WIDGET and shows the HELP text
690 for that widget.
691 F is the frame if known, or NULL if not known. */
692 static void
693 show_help_event (FRAME_PTR f, xt_or_gtk_widget widget, Lisp_Object help)
695 Lisp_Object frame;
697 if (f)
699 XSETFRAME (frame, f);
700 kbd_buffer_store_help_event (frame, help);
702 else
704 #if 0 /* This code doesn't do anything useful. ++kfs */
705 /* WIDGET is the popup menu. It's parent is the frame's
706 widget. See which frame that is. */
707 xt_or_gtk_widget frame_widget = XtParent (widget);
708 Lisp_Object tail;
710 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
712 frame = XCAR (tail);
713 if (FRAMEP (frame)
714 && (f = XFRAME (frame),
715 FRAME_X_P (f) && f->output_data.x->widget == frame_widget))
716 break;
718 #endif
719 show_help_echo (help, Qnil, Qnil, Qnil);
723 /* Callback called when menu items are highlighted/unhighlighted
724 while moving the mouse over them. WIDGET is the menu bar or menu
725 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
726 the data structure for the menu item, or null in case of
727 unhighlighting. */
729 #ifdef USE_GTK
730 static void
731 menu_highlight_callback (GtkWidget *widget, gpointer call_data)
733 xg_menu_item_cb_data *cb_data;
734 Lisp_Object help;
736 cb_data = (xg_menu_item_cb_data*) g_object_get_data (G_OBJECT (widget),
737 XG_ITEM_DATA);
738 if (! cb_data) return;
740 help = call_data ? cb_data->help : Qnil;
742 /* If popup_activated_flag is greater than 1 we are in a popup menu.
743 Don't pass the frame to show_help_event for those.
744 Passing frame creates an Emacs event. As we are looping in
745 popup_widget_loop, it won't be handled. Passing NULL shows the tip
746 directly without using an Emacs event. This is what the Lucid code
747 does below. */
748 show_help_event (popup_activated_flag <= 1 ? cb_data->cl_data->f : NULL,
749 widget, help);
751 #else
752 static void
753 menu_highlight_callback (Widget widget, LWLIB_ID id, void *call_data)
755 struct frame *f;
756 Lisp_Object help;
758 widget_value *wv = (widget_value *) call_data;
760 help = wv ? wv->help : Qnil;
762 /* Determine the frame for the help event. */
763 f = menubar_id_to_frame (id);
765 show_help_event (f, widget, help);
767 #endif
769 #ifdef USE_GTK
770 /* Gtk calls callbacks just because we tell it what item should be
771 selected in a radio group. If this variable is set to a non-zero
772 value, we are creating menus and don't want callbacks right now.
774 static int xg_crazy_callback_abort;
776 /* This callback is called from the menu bar pulldown menu
777 when the user makes a selection.
778 Figure out what the user chose
779 and put the appropriate events into the keyboard buffer. */
780 static void
781 menubar_selection_callback (GtkWidget *widget, gpointer client_data)
783 xg_menu_item_cb_data *cb_data = (xg_menu_item_cb_data*) client_data;
785 if (xg_crazy_callback_abort)
786 return;
788 if (! cb_data || ! cb_data->cl_data || ! cb_data->cl_data->f)
789 return;
791 /* For a group of radio buttons, GTK calls the selection callback first
792 for the item that was active before the selection and then for the one that
793 is active after the selection. For C-h k this means we get the help on
794 the deselected item and then the selected item is executed. Prevent that
795 by ignoring the non-active item. */
796 if (GTK_IS_RADIO_MENU_ITEM (widget)
797 && ! gtk_check_menu_item_get_active (GTK_CHECK_MENU_ITEM (widget)))
798 return;
800 /* When a menu is popped down, X generates a focus event (i.e. focus
801 goes back to the frame below the menu). Since GTK buffers events,
802 we force it out here before the menu selection event. Otherwise
803 sit-for will exit at once if the focus event follows the menu selection
804 event. */
806 block_input ();
807 while (gtk_events_pending ())
808 gtk_main_iteration ();
809 unblock_input ();
811 find_and_call_menu_selection (cb_data->cl_data->f,
812 cb_data->cl_data->menu_bar_items_used,
813 cb_data->cl_data->menu_bar_vector,
814 cb_data->call_data);
817 #else /* not USE_GTK */
819 /* This callback is called from the menu bar pulldown menu
820 when the user makes a selection.
821 Figure out what the user chose
822 and put the appropriate events into the keyboard buffer. */
823 static void
824 menubar_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
826 FRAME_PTR f;
828 f = menubar_id_to_frame (id);
829 if (!f)
830 return;
831 find_and_call_menu_selection (f, f->menu_bar_items_used,
832 f->menu_bar_vector, client_data);
834 #endif /* not USE_GTK */
836 /* Recompute all the widgets of frame F, when the menu bar has been
837 changed. */
839 static void
840 update_frame_menubar (FRAME_PTR f)
842 #ifdef USE_GTK
843 xg_update_frame_menubar (f);
844 #else
845 struct x_output *x;
846 int columns, rows;
848 if (! FRAME_X_P (f))
849 emacs_abort ();
851 x = f->output_data.x;
853 if (!x->menubar_widget || XtIsManaged (x->menubar_widget))
854 return;
856 block_input ();
857 /* Save the size of the frame because the pane widget doesn't accept
858 to resize itself. So force it. */
859 columns = FRAME_COLS (f);
860 rows = FRAME_LINES (f);
862 /* Do the voodoo which means "I'm changing lots of things, don't try
863 to refigure sizes until I'm done." */
864 lw_refigure_widget (x->column_widget, False);
866 /* The order in which children are managed is the top to bottom
867 order in which they are displayed in the paned window. First,
868 remove the text-area widget. */
869 XtUnmanageChild (x->edit_widget);
871 /* Remove the menubar that is there now, and put up the menubar that
872 should be there. */
873 XtManageChild (x->menubar_widget);
874 XtMapWidget (x->menubar_widget);
875 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, NULL);
877 /* Re-manage the text-area widget, and then thrash the sizes. */
878 XtManageChild (x->edit_widget);
879 lw_refigure_widget (x->column_widget, True);
881 /* Force the pane widget to resize itself with the right values. */
882 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
883 unblock_input ();
884 #endif
887 #ifdef USE_LUCID
888 static void
889 apply_systemfont_to_dialog (Widget w)
891 const char *fn = xsettings_get_system_normal_font ();
892 if (fn)
894 XrmDatabase db = XtDatabase (XtDisplay (w));
895 if (db)
896 XrmPutStringResource (&db, "*dialog.font", fn);
900 static void
901 apply_systemfont_to_menu (struct frame *f, Widget w)
903 const char *fn = xsettings_get_system_normal_font ();
905 if (fn)
907 XrmDatabase db = XtDatabase (XtDisplay (w));
908 if (db)
910 XrmPutStringResource (&db, "*menubar*font", fn);
911 XrmPutStringResource (&db, "*popup*font", fn);
916 #endif
918 /* Set the contents of the menubar widgets of frame F.
919 The argument FIRST_TIME is currently ignored;
920 it is set the first time this is called, from initialize_frame_menubar. */
922 void
923 set_frame_menubar (FRAME_PTR f, bool first_time, bool deep_p)
925 xt_or_gtk_widget menubar_widget;
926 #ifdef USE_X_TOOLKIT
927 LWLIB_ID id;
928 #endif
929 Lisp_Object items;
930 widget_value *wv, *first_wv, *prev_wv = 0;
931 int i;
932 int *submenu_start, *submenu_end;
933 bool *submenu_top_level_items;
934 int *submenu_n_panes;
936 if (! FRAME_X_P (f))
937 emacs_abort ();
939 menubar_widget = f->output_data.x->menubar_widget;
941 XSETFRAME (Vmenu_updating_frame, f);
943 #ifdef USE_X_TOOLKIT
944 if (f->output_data.x->id == 0)
945 f->output_data.x->id = next_menubar_widget_id++;
946 id = f->output_data.x->id;
947 #endif
949 if (! menubar_widget)
950 deep_p = 1;
951 /* Make the first call for any given frame always go deep. */
952 else if (!f->output_data.x->saved_menu_event && !deep_p)
954 deep_p = 1;
955 f->output_data.x->saved_menu_event = xmalloc (sizeof (XEvent));
956 f->output_data.x->saved_menu_event->type = 0;
959 #ifdef USE_GTK
960 /* If we have detached menus, we must update deep so detached menus
961 also gets updated. */
962 deep_p = deep_p || xg_have_tear_offs ();
963 #endif
965 if (deep_p)
967 /* Make a widget-value tree representing the entire menu trees. */
969 struct buffer *prev = current_buffer;
970 Lisp_Object buffer;
971 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
972 int previous_menu_items_used = f->menu_bar_items_used;
973 Lisp_Object *previous_items
974 = alloca (previous_menu_items_used * sizeof *previous_items);
975 int subitems;
977 /* If we are making a new widget, its contents are empty,
978 do always reinitialize them. */
979 if (! menubar_widget)
980 previous_menu_items_used = 0;
982 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
983 specbind (Qinhibit_quit, Qt);
984 /* Don't let the debugger step into this code
985 because it is not reentrant. */
986 specbind (Qdebug_on_next_call, Qnil);
988 record_unwind_save_match_data ();
989 if (NILP (Voverriding_local_map_menu_flag))
991 specbind (Qoverriding_terminal_local_map, Qnil);
992 specbind (Qoverriding_local_map, Qnil);
995 set_buffer_internal_1 (XBUFFER (buffer));
997 /* Run the Lucid hook. */
998 safe_run_hooks (Qactivate_menubar_hook);
1000 /* If it has changed current-menubar from previous value,
1001 really recompute the menubar from the value. */
1002 if (! NILP (Vlucid_menu_bar_dirty_flag))
1003 call0 (Qrecompute_lucid_menubar);
1004 safe_run_hooks (Qmenu_bar_update_hook);
1005 fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
1007 items = FRAME_MENU_BAR_ITEMS (f);
1009 /* Save the frame's previous menu bar contents data. */
1010 if (previous_menu_items_used)
1011 memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents,
1012 previous_menu_items_used * word_size);
1014 /* Fill in menu_items with the current menu bar contents.
1015 This can evaluate Lisp code. */
1016 save_menu_items ();
1018 menu_items = f->menu_bar_vector;
1019 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1020 subitems = ASIZE (items) / 4;
1021 submenu_start = alloca ((subitems + 1) * sizeof *submenu_start);
1022 submenu_end = alloca (subitems * sizeof *submenu_end);
1023 submenu_n_panes = alloca (subitems * sizeof *submenu_n_panes);
1024 submenu_top_level_items = alloca (subitems
1025 * sizeof *submenu_top_level_items);
1026 init_menu_items ();
1027 for (i = 0; i < subitems; i++)
1029 Lisp_Object key, string, maps;
1031 key = AREF (items, 4 * i);
1032 string = AREF (items, 4 * i + 1);
1033 maps = AREF (items, 4 * i + 2);
1034 if (NILP (string))
1035 break;
1037 submenu_start[i] = menu_items_used;
1039 menu_items_n_panes = 0;
1040 submenu_top_level_items[i]
1041 = parse_single_submenu (key, string, maps);
1042 submenu_n_panes[i] = menu_items_n_panes;
1044 submenu_end[i] = menu_items_used;
1047 submenu_start[i] = -1;
1048 finish_menu_items ();
1050 /* Convert menu_items into widget_value trees
1051 to display the menu. This cannot evaluate Lisp code. */
1053 wv = xmalloc_widget_value ();
1054 wv->name = "menubar";
1055 wv->value = 0;
1056 wv->enabled = 1;
1057 wv->button_type = BUTTON_TYPE_NONE;
1058 wv->help = Qnil;
1059 first_wv = wv;
1061 for (i = 0; 0 <= submenu_start[i]; i++)
1063 menu_items_n_panes = submenu_n_panes[i];
1064 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1065 submenu_top_level_items[i]);
1066 if (prev_wv)
1067 prev_wv->next = wv;
1068 else
1069 first_wv->contents = wv;
1070 /* Don't set wv->name here; GC during the loop might relocate it. */
1071 wv->enabled = 1;
1072 wv->button_type = BUTTON_TYPE_NONE;
1073 prev_wv = wv;
1076 set_buffer_internal_1 (prev);
1078 /* If there has been no change in the Lisp-level contents
1079 of the menu bar, skip redisplaying it. Just exit. */
1081 /* Compare the new menu items with the ones computed last time. */
1082 for (i = 0; i < previous_menu_items_used; i++)
1083 if (menu_items_used == i
1084 || (!EQ (previous_items[i], AREF (menu_items, i))))
1085 break;
1086 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1088 /* The menu items have not changed. Don't bother updating
1089 the menus in any form, since it would be a no-op. */
1090 free_menubar_widget_value_tree (first_wv);
1091 discard_menu_items ();
1092 unbind_to (specpdl_count, Qnil);
1093 return;
1096 /* The menu items are different, so store them in the frame. */
1097 fset_menu_bar_vector (f, menu_items);
1098 f->menu_bar_items_used = menu_items_used;
1100 /* This undoes save_menu_items. */
1101 unbind_to (specpdl_count, Qnil);
1103 /* Now GC cannot happen during the lifetime of the widget_value,
1104 so it's safe to store data from a Lisp_String. */
1105 wv = first_wv->contents;
1106 for (i = 0; i < ASIZE (items); i += 4)
1108 Lisp_Object string;
1109 string = AREF (items, i + 1);
1110 if (NILP (string))
1111 break;
1112 wv->name = SSDATA (string);
1113 update_submenu_strings (wv->contents);
1114 wv = wv->next;
1118 else
1120 /* Make a widget-value tree containing
1121 just the top level menu bar strings. */
1123 wv = xmalloc_widget_value ();
1124 wv->name = "menubar";
1125 wv->value = 0;
1126 wv->enabled = 1;
1127 wv->button_type = BUTTON_TYPE_NONE;
1128 wv->help = Qnil;
1129 first_wv = wv;
1131 items = FRAME_MENU_BAR_ITEMS (f);
1132 for (i = 0; i < ASIZE (items); i += 4)
1134 Lisp_Object string;
1136 string = AREF (items, i + 1);
1137 if (NILP (string))
1138 break;
1140 wv = xmalloc_widget_value ();
1141 wv->name = SSDATA (string);
1142 wv->value = 0;
1143 wv->enabled = 1;
1144 wv->button_type = BUTTON_TYPE_NONE;
1145 wv->help = Qnil;
1146 /* This prevents lwlib from assuming this
1147 menu item is really supposed to be empty. */
1148 /* The intptr_t cast avoids a warning.
1149 This value just has to be different from small integers. */
1150 wv->call_data = (void *) (intptr_t) (-1);
1152 if (prev_wv)
1153 prev_wv->next = wv;
1154 else
1155 first_wv->contents = wv;
1156 prev_wv = wv;
1159 /* Forget what we thought we knew about what is in the
1160 detailed contents of the menu bar menus.
1161 Changing the top level always destroys the contents. */
1162 f->menu_bar_items_used = 0;
1165 /* Create or update the menu bar widget. */
1167 block_input ();
1169 #ifdef USE_GTK
1170 xg_crazy_callback_abort = 1;
1171 if (menubar_widget)
1173 /* The fourth arg is DEEP_P, which says to consider the entire
1174 menu trees we supply, rather than just the menu bar item names. */
1175 xg_modify_menubar_widgets (menubar_widget,
1177 first_wv,
1178 deep_p,
1179 G_CALLBACK (menubar_selection_callback),
1180 G_CALLBACK (popup_deactivate_callback),
1181 G_CALLBACK (menu_highlight_callback));
1183 else
1185 menubar_widget
1186 = xg_create_widget ("menubar", "menubar", f, first_wv,
1187 G_CALLBACK (menubar_selection_callback),
1188 G_CALLBACK (popup_deactivate_callback),
1189 G_CALLBACK (menu_highlight_callback));
1191 f->output_data.x->menubar_widget = menubar_widget;
1195 #else /* not USE_GTK */
1196 if (menubar_widget)
1198 /* Disable resizing (done for Motif!) */
1199 lw_allow_resizing (f->output_data.x->widget, False);
1201 /* The third arg is DEEP_P, which says to consider the entire
1202 menu trees we supply, rather than just the menu bar item names. */
1203 lw_modify_all_widgets (id, first_wv, deep_p);
1205 /* Re-enable the edit widget to resize. */
1206 lw_allow_resizing (f->output_data.x->widget, True);
1208 else
1210 char menuOverride[] = "Ctrl<KeyPress>g: MenuGadgetEscape()";
1211 XtTranslations override = XtParseTranslationTable (menuOverride);
1213 #ifdef USE_LUCID
1214 apply_systemfont_to_menu (f, f->output_data.x->column_widget);
1215 #endif
1216 menubar_widget = lw_create_widget ("menubar", "menubar", id,
1217 first_wv,
1218 f->output_data.x->column_widget,
1220 popup_activate_callback,
1221 menubar_selection_callback,
1222 popup_deactivate_callback,
1223 menu_highlight_callback);
1224 f->output_data.x->menubar_widget = menubar_widget;
1226 /* Make menu pop down on C-g. */
1227 XtOverrideTranslations (menubar_widget, override);
1231 int menubar_size;
1232 if (f->output_data.x->menubar_widget)
1233 XtRealizeWidget (f->output_data.x->menubar_widget);
1235 menubar_size
1236 = (f->output_data.x->menubar_widget
1237 ? (f->output_data.x->menubar_widget->core.height
1238 + f->output_data.x->menubar_widget->core.border_width)
1239 : 0);
1241 #if 1 /* Experimentally, we now get the right results
1242 for -geometry -0-0 without this. 24 Aug 96, rms.
1243 Maybe so, but the menu bar size is missing the pixels so the
1244 WM size hints are off by these pixels. Jan D, oct 2009. */
1245 #ifdef USE_LUCID
1246 if (FRAME_EXTERNAL_MENU_BAR (f))
1248 Dimension ibw = 0;
1249 XtVaGetValues (f->output_data.x->column_widget,
1250 XtNinternalBorderWidth, &ibw, NULL);
1251 menubar_size += ibw;
1253 #endif /* USE_LUCID */
1254 #endif /* 1 */
1256 f->output_data.x->menubar_height = menubar_size;
1258 #endif /* not USE_GTK */
1260 free_menubar_widget_value_tree (first_wv);
1261 update_frame_menubar (f);
1263 #ifdef USE_GTK
1264 xg_crazy_callback_abort = 0;
1265 #endif
1267 unblock_input ();
1270 /* Called from Fx_create_frame to create the initial menubar of a frame
1271 before it is mapped, so that the window is mapped with the menubar already
1272 there instead of us tacking it on later and thrashing the window after it
1273 is visible. */
1275 void
1276 initialize_frame_menubar (FRAME_PTR f)
1278 /* This function is called before the first chance to redisplay
1279 the frame. It has to be, so the frame will have the right size. */
1280 fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
1281 set_frame_menubar (f, 1, 1);
1285 /* Get rid of the menu bar of frame F, and free its storage.
1286 This is used when deleting a frame, and when turning off the menu bar.
1287 For GTK this function is in gtkutil.c. */
1289 #ifndef USE_GTK
1290 void
1291 free_frame_menubar (FRAME_PTR f)
1293 Widget menubar_widget;
1295 if (! FRAME_X_P (f))
1296 emacs_abort ();
1298 menubar_widget = f->output_data.x->menubar_widget;
1300 f->output_data.x->menubar_height = 0;
1302 if (menubar_widget)
1304 #ifdef USE_MOTIF
1305 /* Removing the menu bar magically changes the shell widget's x
1306 and y position of (0, 0) which, when the menu bar is turned
1307 on again, leads to pull-down menus appearing in strange
1308 positions near the upper-left corner of the display. This
1309 happens only with some window managers like twm and ctwm,
1310 but not with other like Motif's mwm or kwm, because the
1311 latter generate ConfigureNotify events when the menu bar
1312 is switched off, which fixes the shell position. */
1313 Position x0, y0, x1, y1;
1314 #endif
1316 block_input ();
1318 #ifdef USE_MOTIF
1319 if (f->output_data.x->widget)
1320 XtVaGetValues (f->output_data.x->widget, XtNx, &x0, XtNy, &y0, NULL);
1321 #endif
1323 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
1324 f->output_data.x->menubar_widget = NULL;
1326 if (f->output_data.x->widget)
1328 #ifdef USE_MOTIF
1329 XtVaGetValues (f->output_data.x->widget, XtNx, &x1, XtNy, &y1, NULL);
1330 if (x1 == 0 && y1 == 0)
1331 XtVaSetValues (f->output_data.x->widget, XtNx, x0, XtNy, y0, NULL);
1332 #endif
1333 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1335 unblock_input ();
1338 #endif /* not USE_GTK */
1340 #endif /* USE_X_TOOLKIT || USE_GTK */
1342 /* xmenu_show actually displays a menu using the panes and items in menu_items
1343 and returns the value selected from it.
1344 There are two versions of xmenu_show, one for Xt and one for Xlib.
1345 Both assume input is blocked by the caller. */
1347 /* F is the frame the menu is for.
1348 X and Y are the frame-relative specified position,
1349 relative to the inside upper left corner of the frame F.
1350 FOR_CLICK is true if this menu was invoked for a mouse click.
1351 KEYMAPS is true if this menu was specified with keymaps;
1352 in that case, we return a list containing the chosen item's value
1353 and perhaps also the pane's prefix.
1354 TITLE is the specified menu title.
1355 ERROR is a place to store an error message string in case of failure.
1356 (We return nil on failure, but the value doesn't actually matter.) */
1358 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1360 /* The item selected in the popup menu. */
1361 static Lisp_Object *volatile menu_item_selection;
1363 #ifdef USE_GTK
1365 /* Used when position a popup menu. See menu_position_func and
1366 create_and_show_popup_menu below. */
1367 struct next_popup_x_y
1369 FRAME_PTR f;
1370 int x;
1371 int y;
1374 /* The menu position function to use if we are not putting a popup
1375 menu where the pointer is.
1376 MENU is the menu to pop up.
1377 X and Y shall on exit contain x/y where the menu shall pop up.
1378 PUSH_IN is not documented in the GTK manual.
1379 USER_DATA is any data passed in when calling gtk_menu_popup.
1380 Here it points to a struct next_popup_x_y where the coordinates
1381 to store in *X and *Y are as well as the frame for the popup.
1383 Here only X and Y are used. */
1384 static void
1385 menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer user_data)
1387 struct next_popup_x_y* data = (struct next_popup_x_y*)user_data;
1388 GtkRequisition req;
1389 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (data->f);
1390 int disp_width = x_display_pixel_width (dpyinfo);
1391 int disp_height = x_display_pixel_height (dpyinfo);
1393 *x = data->x;
1394 *y = data->y;
1396 /* Check if there is room for the menu. If not, adjust x/y so that
1397 the menu is fully visible. */
1398 gtk_widget_get_preferred_size (GTK_WIDGET (menu), NULL, &req);
1399 if (data->x + req.width > disp_width)
1400 *x -= data->x + req.width - disp_width;
1401 if (data->y + req.height > disp_height)
1402 *y -= data->y + req.height - disp_height;
1405 static void
1406 popup_selection_callback (GtkWidget *widget, gpointer client_data)
1408 xg_menu_item_cb_data *cb_data = (xg_menu_item_cb_data*) client_data;
1410 if (xg_crazy_callback_abort) return;
1411 if (cb_data) menu_item_selection = (Lisp_Object *) cb_data->call_data;
1414 static Lisp_Object
1415 pop_down_menu (Lisp_Object arg)
1417 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
1419 popup_activated_flag = 0;
1420 block_input ();
1421 gtk_widget_destroy (GTK_WIDGET (p->pointer));
1422 unblock_input ();
1423 return Qnil;
1426 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
1427 menu pops down.
1428 menu_item_selection will be set to the selection. */
1429 static void
1430 create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, int x, int y,
1431 bool for_click, Time timestamp)
1433 int i;
1434 GtkWidget *menu;
1435 GtkMenuPositionFunc pos_func = 0; /* Pop up at pointer. */
1436 struct next_popup_x_y popup_x_y;
1437 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1438 bool use_pos_func = ! for_click;
1440 #ifdef HAVE_GTK3
1441 /* Always use position function for Gtk3. Otherwise menus may become
1442 too small to show anything. */
1443 use_pos_func = 1;
1444 #endif
1446 if (! FRAME_X_P (f))
1447 emacs_abort ();
1449 xg_crazy_callback_abort = 1;
1450 menu = xg_create_widget ("popup", first_wv->name, f, first_wv,
1451 G_CALLBACK (popup_selection_callback),
1452 G_CALLBACK (popup_deactivate_callback),
1453 G_CALLBACK (menu_highlight_callback));
1454 xg_crazy_callback_abort = 0;
1456 if (use_pos_func)
1458 /* Not invoked by a click. pop up at x/y. */
1459 pos_func = menu_position_func;
1461 /* Adjust coordinates to be root-window-relative. */
1462 x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
1463 y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
1465 popup_x_y.x = x;
1466 popup_x_y.y = y;
1467 popup_x_y.f = f;
1469 i = 0; /* gtk_menu_popup needs this to be 0 for a non-button popup. */
1472 if (for_click)
1474 for (i = 0; i < 5; i++)
1475 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
1476 break;
1479 /* Display the menu. */
1480 gtk_widget_show_all (menu);
1482 gtk_menu_popup (GTK_MENU (menu), 0, 0, pos_func, &popup_x_y, i,
1483 timestamp ? timestamp : gtk_get_current_event_time ());
1485 record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
1487 if (gtk_widget_get_mapped (menu))
1489 /* Set this to one. popup_widget_loop increases it by one, so it becomes
1490 two. show_help_echo uses this to detect popup menus. */
1491 popup_activated_flag = 1;
1492 /* Process events that apply to the menu. */
1493 popup_widget_loop (1, menu);
1496 unbind_to (specpdl_count, Qnil);
1498 /* Must reset this manually because the button release event is not passed
1499 to Emacs event loop. */
1500 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1503 #else /* not USE_GTK */
1505 /* We need a unique id for each widget handled by the Lucid Widget
1506 library.
1508 For the main windows, and popup menus, we use this counter,
1509 which we increment each time after use. This starts from 1<<16.
1511 For menu bars, we use numbers starting at 0, counted in
1512 next_menubar_widget_id. */
1513 LWLIB_ID widget_id_tick;
1515 static void
1516 popup_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
1518 menu_item_selection = (Lisp_Object *) client_data;
1521 /* ARG is the LWLIB ID of the dialog box, represented
1522 as a Lisp object as (HIGHPART . LOWPART). */
1524 static Lisp_Object
1525 pop_down_menu (Lisp_Object arg)
1527 LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID)
1528 | XINT (XCDR (arg)));
1530 block_input ();
1531 lw_destroy_all_widgets (id);
1532 unblock_input ();
1533 popup_activated_flag = 0;
1535 return Qnil;
1538 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
1539 menu pops down.
1540 menu_item_selection will be set to the selection. */
1541 static void
1542 create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv,
1543 int x, int y, bool for_click, Time timestamp)
1545 int i;
1546 Arg av[2];
1547 int ac = 0;
1548 XEvent dummy;
1549 XButtonPressedEvent *event = &(dummy.xbutton);
1550 LWLIB_ID menu_id;
1551 Widget menu;
1553 if (! FRAME_X_P (f))
1554 emacs_abort ();
1556 #ifdef USE_LUCID
1557 apply_systemfont_to_menu (f, f->output_data.x->widget);
1558 #endif
1560 menu_id = widget_id_tick++;
1561 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
1562 f->output_data.x->widget, 1, 0,
1563 popup_selection_callback,
1564 popup_deactivate_callback,
1565 menu_highlight_callback);
1567 event->type = ButtonPress;
1568 event->serial = 0;
1569 event->send_event = 0;
1570 event->display = FRAME_X_DISPLAY (f);
1571 event->time = CurrentTime;
1572 event->root = FRAME_X_DISPLAY_INFO (f)->root_window;
1573 event->window = event->subwindow = event->root;
1574 event->x = x;
1575 event->y = y;
1577 /* Adjust coordinates to be root-window-relative. */
1578 x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
1579 y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
1581 event->x_root = x;
1582 event->y_root = y;
1584 event->state = 0;
1585 event->button = 0;
1586 for (i = 0; i < 5; i++)
1587 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
1588 event->button = i;
1590 /* Don't allow any geometry request from the user. */
1591 XtSetArg (av[ac], XtNgeometry, 0); ac++;
1592 XtSetValues (menu, av, ac);
1594 /* Display the menu. */
1595 lw_popup_menu (menu, &dummy);
1596 popup_activated_flag = 1;
1597 x_activate_timeout_atimer ();
1600 int fact = 4 * sizeof (LWLIB_ID);
1601 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1602 record_unwind_protect (pop_down_menu,
1603 Fcons (make_number (menu_id >> (fact)),
1604 make_number (menu_id & ~(-1 << (fact)))));
1606 /* Process events that apply to the menu. */
1607 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 1);
1609 unbind_to (specpdl_count, Qnil);
1613 #endif /* not USE_GTK */
1615 static Lisp_Object
1616 cleanup_widget_value_tree (Lisp_Object arg)
1618 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
1619 widget_value *wv = p->pointer;
1621 free_menubar_widget_value_tree (wv);
1623 return Qnil;
1626 Lisp_Object
1627 xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
1628 Lisp_Object title, const char **error_name, Time timestamp)
1630 int i;
1631 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1632 widget_value **submenu_stack
1633 = alloca (menu_items_used * sizeof *submenu_stack);
1634 Lisp_Object *subprefix_stack
1635 = alloca (menu_items_used * sizeof *subprefix_stack);
1636 int submenu_depth = 0;
1638 int first_pane;
1640 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1642 if (! FRAME_X_P (f))
1643 emacs_abort ();
1645 *error_name = NULL;
1647 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1649 *error_name = "Empty menu";
1650 return Qnil;
1653 /* Create a tree of widget_value objects
1654 representing the panes and their items. */
1655 wv = xmalloc_widget_value ();
1656 wv->name = "menu";
1657 wv->value = 0;
1658 wv->enabled = 1;
1659 wv->button_type = BUTTON_TYPE_NONE;
1660 wv->help =Qnil;
1661 first_wv = wv;
1662 first_pane = 1;
1664 /* Loop over all panes and items, filling in the tree. */
1665 i = 0;
1666 while (i < menu_items_used)
1668 if (EQ (AREF (menu_items, i), Qnil))
1670 submenu_stack[submenu_depth++] = save_wv;
1671 save_wv = prev_wv;
1672 prev_wv = 0;
1673 first_pane = 1;
1674 i++;
1676 else if (EQ (AREF (menu_items, i), Qlambda))
1678 prev_wv = save_wv;
1679 save_wv = submenu_stack[--submenu_depth];
1680 first_pane = 0;
1681 i++;
1683 else if (EQ (AREF (menu_items, i), Qt)
1684 && submenu_depth != 0)
1685 i += MENU_ITEMS_PANE_LENGTH;
1686 /* Ignore a nil in the item list.
1687 It's meaningful only for dialog boxes. */
1688 else if (EQ (AREF (menu_items, i), Qquote))
1689 i += 1;
1690 else if (EQ (AREF (menu_items, i), Qt))
1692 /* Create a new pane. */
1693 Lisp_Object pane_name, prefix;
1694 const char *pane_string;
1696 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1697 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1699 #ifndef HAVE_MULTILINGUAL_MENU
1700 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1702 pane_name = ENCODE_MENU_STRING (pane_name);
1703 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1705 #endif
1706 pane_string = (NILP (pane_name)
1707 ? "" : SSDATA (pane_name));
1708 /* If there is just one top-level pane, put all its items directly
1709 under the top-level menu. */
1710 if (menu_items_n_panes == 1)
1711 pane_string = "";
1713 /* If the pane has a meaningful name,
1714 make the pane a top-level menu item
1715 with its items as a submenu beneath it. */
1716 if (!keymaps && strcmp (pane_string, ""))
1718 wv = xmalloc_widget_value ();
1719 if (save_wv)
1720 save_wv->next = wv;
1721 else
1722 first_wv->contents = wv;
1723 wv->name = (char *) pane_string;
1724 if (keymaps && !NILP (prefix))
1725 wv->name++;
1726 wv->value = 0;
1727 wv->enabled = 1;
1728 wv->button_type = BUTTON_TYPE_NONE;
1729 wv->help = Qnil;
1730 save_wv = wv;
1731 prev_wv = 0;
1733 else if (first_pane)
1735 save_wv = wv;
1736 prev_wv = 0;
1738 first_pane = 0;
1739 i += MENU_ITEMS_PANE_LENGTH;
1741 else
1743 /* Create a new item within current pane. */
1744 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1745 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1746 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1747 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1748 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1749 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1750 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1751 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1753 #ifndef HAVE_MULTILINGUAL_MENU
1754 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1756 item_name = ENCODE_MENU_STRING (item_name);
1757 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1760 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1762 descrip = ENCODE_MENU_STRING (descrip);
1763 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1765 #endif /* not HAVE_MULTILINGUAL_MENU */
1767 wv = xmalloc_widget_value ();
1768 if (prev_wv)
1769 prev_wv->next = wv;
1770 else
1771 save_wv->contents = wv;
1772 wv->name = SSDATA (item_name);
1773 if (!NILP (descrip))
1774 wv->key = SSDATA (descrip);
1775 wv->value = 0;
1776 /* If this item has a null value,
1777 make the call_data null so that it won't display a box
1778 when the mouse is on it. */
1779 wv->call_data = !NILP (def) ? aref_addr (menu_items, i) : 0;
1780 wv->enabled = !NILP (enable);
1782 if (NILP (type))
1783 wv->button_type = BUTTON_TYPE_NONE;
1784 else if (EQ (type, QCtoggle))
1785 wv->button_type = BUTTON_TYPE_TOGGLE;
1786 else if (EQ (type, QCradio))
1787 wv->button_type = BUTTON_TYPE_RADIO;
1788 else
1789 emacs_abort ();
1791 wv->selected = !NILP (selected);
1793 if (! STRINGP (help))
1794 help = Qnil;
1796 wv->help = help;
1798 prev_wv = wv;
1800 i += MENU_ITEMS_ITEM_LENGTH;
1804 /* Deal with the title, if it is non-nil. */
1805 if (!NILP (title))
1807 widget_value *wv_title = xmalloc_widget_value ();
1808 widget_value *wv_sep1 = xmalloc_widget_value ();
1809 widget_value *wv_sep2 = xmalloc_widget_value ();
1811 wv_sep2->name = "--";
1812 wv_sep2->next = first_wv->contents;
1813 wv_sep2->help = Qnil;
1815 wv_sep1->name = "--";
1816 wv_sep1->next = wv_sep2;
1817 wv_sep1->help = Qnil;
1819 #ifndef HAVE_MULTILINGUAL_MENU
1820 if (STRING_MULTIBYTE (title))
1821 title = ENCODE_MENU_STRING (title);
1822 #endif
1824 wv_title->name = SSDATA (title);
1825 wv_title->enabled = TRUE;
1826 wv_title->button_type = BUTTON_TYPE_NONE;
1827 wv_title->help = Qnil;
1828 wv_title->next = wv_sep1;
1829 first_wv->contents = wv_title;
1832 /* No selection has been chosen yet. */
1833 menu_item_selection = 0;
1835 /* Make sure to free the widget_value objects we used to specify the
1836 contents even with longjmp. */
1837 record_unwind_protect (cleanup_widget_value_tree,
1838 make_save_value (first_wv, 0));
1840 /* Actually create and show the menu until popped down. */
1841 create_and_show_popup_menu (f, first_wv, x, y, for_click, timestamp);
1843 unbind_to (specpdl_count, Qnil);
1845 /* Find the selected item, and its pane, to return
1846 the proper value. */
1847 if (menu_item_selection != 0)
1849 Lisp_Object prefix, entry;
1851 prefix = entry = Qnil;
1852 i = 0;
1853 while (i < menu_items_used)
1855 if (EQ (AREF (menu_items, i), Qnil))
1857 subprefix_stack[submenu_depth++] = prefix;
1858 prefix = entry;
1859 i++;
1861 else if (EQ (AREF (menu_items, i), Qlambda))
1863 prefix = subprefix_stack[--submenu_depth];
1864 i++;
1866 else if (EQ (AREF (menu_items, i), Qt))
1868 prefix
1869 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1870 i += MENU_ITEMS_PANE_LENGTH;
1872 /* Ignore a nil in the item list.
1873 It's meaningful only for dialog boxes. */
1874 else if (EQ (AREF (menu_items, i), Qquote))
1875 i += 1;
1876 else
1878 entry
1879 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1880 if (menu_item_selection == aref_addr (menu_items, i))
1882 if (keymaps)
1884 int j;
1886 entry = Fcons (entry, Qnil);
1887 if (!NILP (prefix))
1888 entry = Fcons (prefix, entry);
1889 for (j = submenu_depth - 1; j >= 0; j--)
1890 if (!NILP (subprefix_stack[j]))
1891 entry = Fcons (subprefix_stack[j], entry);
1893 return entry;
1895 i += MENU_ITEMS_ITEM_LENGTH;
1899 else if (!for_click)
1900 /* Make "Cancel" equivalent to C-g. */
1901 Fsignal (Qquit, Qnil);
1903 return Qnil;
1906 #ifdef USE_GTK
1907 static void
1908 dialog_selection_callback (GtkWidget *widget, gpointer client_data)
1910 /* Treat the pointer as an integer. There's no problem
1911 as long as pointers have enough bits to hold small integers. */
1912 if ((intptr_t) client_data != -1)
1913 menu_item_selection = (Lisp_Object *) client_data;
1915 popup_activated_flag = 0;
1918 /* Pop up the dialog for frame F defined by FIRST_WV and loop until the
1919 dialog pops down.
1920 menu_item_selection will be set to the selection. */
1921 static void
1922 create_and_show_dialog (FRAME_PTR f, widget_value *first_wv)
1924 GtkWidget *menu;
1926 if (! FRAME_X_P (f))
1927 emacs_abort ();
1929 menu = xg_create_widget ("dialog", first_wv->name, f, first_wv,
1930 G_CALLBACK (dialog_selection_callback),
1931 G_CALLBACK (popup_deactivate_callback),
1934 if (menu)
1936 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1937 record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
1939 /* Display the menu. */
1940 gtk_widget_show_all (menu);
1942 /* Process events that apply to the menu. */
1943 popup_widget_loop (1, menu);
1945 unbind_to (specpdl_count, Qnil);
1949 #else /* not USE_GTK */
1950 static void
1951 dialog_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
1953 /* Treat the pointer as an integer. There's no problem
1954 as long as pointers have enough bits to hold small integers. */
1955 if ((intptr_t) client_data != -1)
1956 menu_item_selection = (Lisp_Object *) client_data;
1958 block_input ();
1959 lw_destroy_all_widgets (id);
1960 unblock_input ();
1961 popup_activated_flag = 0;
1965 /* Pop up the dialog for frame F defined by FIRST_WV and loop until the
1966 dialog pops down.
1967 menu_item_selection will be set to the selection. */
1968 static void
1969 create_and_show_dialog (FRAME_PTR f, widget_value *first_wv)
1971 LWLIB_ID dialog_id;
1973 if (!FRAME_X_P (f))
1974 emacs_abort ();
1976 dialog_id = widget_id_tick++;
1977 #ifdef USE_LUCID
1978 apply_systemfont_to_dialog (f->output_data.x->widget);
1979 #endif
1980 lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1981 f->output_data.x->widget, 1, 0,
1982 dialog_selection_callback, 0, 0);
1983 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1984 /* Display the dialog box. */
1985 lw_pop_up_all_widgets (dialog_id);
1986 popup_activated_flag = 1;
1987 x_activate_timeout_atimer ();
1989 /* Process events that apply to the dialog box.
1990 Also handle timers. */
1992 ptrdiff_t count = SPECPDL_INDEX ();
1993 int fact = 4 * sizeof (LWLIB_ID);
1995 /* xdialog_show_unwind is responsible for popping the dialog box down. */
1996 record_unwind_protect (pop_down_menu,
1997 Fcons (make_number (dialog_id >> (fact)),
1998 make_number (dialog_id & ~(-1 << (fact)))));
2000 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f),
2001 dialog_id, 1);
2003 unbind_to (count, Qnil);
2007 #endif /* not USE_GTK */
2009 static const char * button_names [] = {
2010 "button1", "button2", "button3", "button4", "button5",
2011 "button6", "button7", "button8", "button9", "button10" };
2013 static Lisp_Object
2014 xdialog_show (FRAME_PTR f,
2015 bool keymaps,
2016 Lisp_Object title,
2017 Lisp_Object header,
2018 const char **error_name)
2020 int i, nb_buttons=0;
2021 char dialog_name[6];
2023 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2025 /* Number of elements seen so far, before boundary. */
2026 int left_count = 0;
2027 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2028 int boundary_seen = 0;
2030 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
2032 if (! FRAME_X_P (f))
2033 emacs_abort ();
2035 *error_name = NULL;
2037 if (menu_items_n_panes > 1)
2039 *error_name = "Multiple panes in dialog box";
2040 return Qnil;
2043 /* Create a tree of widget_value objects
2044 representing the text label and buttons. */
2046 Lisp_Object pane_name, prefix;
2047 const char *pane_string;
2048 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2049 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2050 pane_string = (NILP (pane_name)
2051 ? "" : SSDATA (pane_name));
2052 prev_wv = xmalloc_widget_value ();
2053 prev_wv->value = (char *) pane_string;
2054 if (keymaps && !NILP (prefix))
2055 prev_wv->name++;
2056 prev_wv->enabled = 1;
2057 prev_wv->name = "message";
2058 prev_wv->help = Qnil;
2059 first_wv = prev_wv;
2061 /* Loop over all panes and items, filling in the tree. */
2062 i = MENU_ITEMS_PANE_LENGTH;
2063 while (i < menu_items_used)
2066 /* Create a new item within current pane. */
2067 Lisp_Object item_name, enable, descrip;
2068 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2069 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2070 descrip
2071 = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2073 if (NILP (item_name))
2075 free_menubar_widget_value_tree (first_wv);
2076 *error_name = "Submenu in dialog items";
2077 return Qnil;
2079 if (EQ (item_name, Qquote))
2081 /* This is the boundary between left-side elts
2082 and right-side elts. Stop incrementing right_count. */
2083 boundary_seen = 1;
2084 i++;
2085 continue;
2087 if (nb_buttons >= 9)
2089 free_menubar_widget_value_tree (first_wv);
2090 *error_name = "Too many dialog items";
2091 return Qnil;
2094 wv = xmalloc_widget_value ();
2095 prev_wv->next = wv;
2096 wv->name = (char *) button_names[nb_buttons];
2097 if (!NILP (descrip))
2098 wv->key = SSDATA (descrip);
2099 wv->value = SSDATA (item_name);
2100 wv->call_data = aref_addr (menu_items, i);
2101 wv->enabled = !NILP (enable);
2102 wv->help = Qnil;
2103 prev_wv = wv;
2105 if (! boundary_seen)
2106 left_count++;
2108 nb_buttons++;
2109 i += MENU_ITEMS_ITEM_LENGTH;
2112 /* If the boundary was not specified,
2113 by default put half on the left and half on the right. */
2114 if (! boundary_seen)
2115 left_count = nb_buttons - nb_buttons / 2;
2117 wv = xmalloc_widget_value ();
2118 wv->name = dialog_name;
2119 wv->help = Qnil;
2121 /* Frame title: 'Q' = Question, 'I' = Information.
2122 Can also have 'E' = Error if, one day, we want
2123 a popup for errors. */
2124 if (NILP (header))
2125 dialog_name[0] = 'Q';
2126 else
2127 dialog_name[0] = 'I';
2129 /* Dialog boxes use a really stupid name encoding
2130 which specifies how many buttons to use
2131 and how many buttons are on the right. */
2132 dialog_name[1] = '0' + nb_buttons;
2133 dialog_name[2] = 'B';
2134 dialog_name[3] = 'R';
2135 /* Number of buttons to put on the right. */
2136 dialog_name[4] = '0' + nb_buttons - left_count;
2137 dialog_name[5] = 0;
2138 wv->contents = first_wv;
2139 first_wv = wv;
2142 /* No selection has been chosen yet. */
2143 menu_item_selection = 0;
2145 /* Make sure to free the widget_value objects we used to specify the
2146 contents even with longjmp. */
2147 record_unwind_protect (cleanup_widget_value_tree,
2148 make_save_value (first_wv, 0));
2150 /* Actually create and show the dialog. */
2151 create_and_show_dialog (f, first_wv);
2153 unbind_to (specpdl_count, Qnil);
2155 /* Find the selected item, and its pane, to return
2156 the proper value. */
2157 if (menu_item_selection != 0)
2159 Lisp_Object prefix;
2161 prefix = Qnil;
2162 i = 0;
2163 while (i < menu_items_used)
2165 Lisp_Object entry;
2167 if (EQ (AREF (menu_items, i), Qt))
2169 prefix
2170 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2171 i += MENU_ITEMS_PANE_LENGTH;
2173 else if (EQ (AREF (menu_items, i), Qquote))
2175 /* This is the boundary between left-side elts and
2176 right-side elts. */
2177 ++i;
2179 else
2181 entry
2182 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2183 if (menu_item_selection == aref_addr (menu_items, i))
2185 if (keymaps != 0)
2187 entry = Fcons (entry, Qnil);
2188 if (!NILP (prefix))
2189 entry = Fcons (prefix, entry);
2191 return entry;
2193 i += MENU_ITEMS_ITEM_LENGTH;
2197 else
2198 /* Make "Cancel" equivalent to C-g. */
2199 Fsignal (Qquit, Qnil);
2201 return Qnil;
2204 #else /* not USE_X_TOOLKIT && not USE_GTK */
2206 /* The frame of the last activated non-toolkit menu bar.
2207 Used to generate menu help events. */
2209 static struct frame *menu_help_frame;
2212 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
2214 PANE is the pane number, and ITEM is the menu item number in
2215 the menu (currently not used).
2217 This cannot be done with generating a HELP_EVENT because
2218 XMenuActivate contains a loop that doesn't let Emacs process
2219 keyboard events. */
2221 static void
2222 menu_help_callback (char const *help_string, int pane, int item)
2224 Lisp_Object *first_item;
2225 Lisp_Object pane_name;
2226 Lisp_Object menu_object;
2228 first_item = XVECTOR (menu_items)->contents;
2229 if (EQ (first_item[0], Qt))
2230 pane_name = first_item[MENU_ITEMS_PANE_NAME];
2231 else if (EQ (first_item[0], Qquote))
2232 /* This shouldn't happen, see xmenu_show. */
2233 pane_name = empty_unibyte_string;
2234 else
2235 pane_name = first_item[MENU_ITEMS_ITEM_NAME];
2237 /* (menu-item MENU-NAME PANE-NUMBER) */
2238 menu_object = Fcons (Qmenu_item,
2239 Fcons (pane_name,
2240 Fcons (make_number (pane), Qnil)));
2241 show_help_echo (help_string ? build_string (help_string) : Qnil,
2242 Qnil, menu_object, make_number (item));
2245 static Lisp_Object
2246 pop_down_menu (Lisp_Object arg)
2248 struct Lisp_Save_Value *p1 = XSAVE_VALUE (Fcar (arg));
2249 struct Lisp_Save_Value *p2 = XSAVE_VALUE (Fcdr (arg));
2251 FRAME_PTR f = p1->pointer;
2252 XMenu *menu = p2->pointer;
2254 block_input ();
2255 #ifndef MSDOS
2256 XUngrabPointer (FRAME_X_DISPLAY (f), CurrentTime);
2257 XUngrabKeyboard (FRAME_X_DISPLAY (f), CurrentTime);
2258 #endif
2259 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2261 #ifdef HAVE_X_WINDOWS
2262 /* Assume the mouse has moved out of the X window.
2263 If it has actually moved in, we will get an EnterNotify. */
2264 x_mouse_leave (FRAME_X_DISPLAY_INFO (f));
2266 /* State that no mouse buttons are now held.
2267 (The oldXMenu code doesn't track this info for us.)
2268 That is not necessarily true, but the fiction leads to reasonable
2269 results, and it is a pain to ask which are actually held now. */
2270 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
2272 #endif /* HAVE_X_WINDOWS */
2274 unblock_input ();
2276 return Qnil;
2280 Lisp_Object
2281 xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
2282 Lisp_Object title, const char **error_name, Time timestamp)
2284 Window root;
2285 XMenu *menu;
2286 int pane, selidx, lpane, status;
2287 Lisp_Object entry, pane_prefix;
2288 char *datap;
2289 int ulx, uly, width, height;
2290 int dispwidth, dispheight;
2291 int i, j, lines, maxlines;
2292 int maxwidth;
2293 int dummy_int;
2294 unsigned int dummy_uint;
2295 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
2297 if (! FRAME_X_P (f) && ! FRAME_MSDOS_P (f))
2298 emacs_abort ();
2300 *error_name = 0;
2301 if (menu_items_n_panes == 0)
2302 return Qnil;
2304 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2306 *error_name = "Empty menu";
2307 return Qnil;
2310 /* Figure out which root window F is on. */
2311 XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root,
2312 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
2313 &dummy_uint, &dummy_uint);
2315 /* Make the menu on that window. */
2316 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
2317 if (menu == NULL)
2319 *error_name = "Can't create menu";
2320 return Qnil;
2323 /* Don't GC while we prepare and show the menu,
2324 because we give the oldxmenu library pointers to the
2325 contents of strings. */
2326 inhibit_garbage_collection ();
2328 #ifdef HAVE_X_WINDOWS
2329 /* Adjust coordinates to relative to the outer (window manager) window. */
2330 x += FRAME_OUTER_TO_INNER_DIFF_X (f);
2331 y += FRAME_OUTER_TO_INNER_DIFF_Y (f);
2332 #endif /* HAVE_X_WINDOWS */
2334 /* Adjust coordinates to be root-window-relative. */
2335 x += f->left_pos;
2336 y += f->top_pos;
2338 /* Create all the necessary panes and their items. */
2339 maxwidth = maxlines = lines = i = 0;
2340 lpane = XM_FAILURE;
2341 while (i < menu_items_used)
2343 if (EQ (AREF (menu_items, i), Qt))
2345 /* Create a new pane. */
2346 Lisp_Object pane_name, prefix;
2347 const char *pane_string;
2349 maxlines = max (maxlines, lines);
2350 lines = 0;
2351 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2352 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2353 pane_string = (NILP (pane_name)
2354 ? "" : SSDATA (pane_name));
2355 if (keymaps && !NILP (prefix))
2356 pane_string++;
2358 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
2359 if (lpane == XM_FAILURE)
2361 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2362 *error_name = "Can't create pane";
2363 return Qnil;
2365 i += MENU_ITEMS_PANE_LENGTH;
2367 /* Find the width of the widest item in this pane. */
2368 j = i;
2369 while (j < menu_items_used)
2371 Lisp_Object item;
2372 item = AREF (menu_items, j);
2373 if (EQ (item, Qt))
2374 break;
2375 if (NILP (item))
2377 j++;
2378 continue;
2380 width = SBYTES (item);
2381 if (width > maxwidth)
2382 maxwidth = width;
2384 j += MENU_ITEMS_ITEM_LENGTH;
2387 /* Ignore a nil in the item list.
2388 It's meaningful only for dialog boxes. */
2389 else if (EQ (AREF (menu_items, i), Qquote))
2390 i += 1;
2391 else
2393 /* Create a new item within current pane. */
2394 Lisp_Object item_name, enable, descrip, help;
2395 char *item_data;
2396 char const *help_string;
2398 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2399 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2400 descrip
2401 = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2402 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2403 help_string = STRINGP (help) ? SSDATA (help) : NULL;
2405 if (!NILP (descrip))
2407 /* if alloca is fast, use that to make the space,
2408 to reduce gc needs. */
2409 item_data = alloca (maxwidth + SBYTES (descrip) + 1);
2410 memcpy (item_data, SSDATA (item_name), SBYTES (item_name));
2411 for (j = SCHARS (item_name); j < maxwidth; j++)
2412 item_data[j] = ' ';
2413 memcpy (item_data + j, SSDATA (descrip), SBYTES (descrip));
2414 item_data[j + SBYTES (descrip)] = 0;
2416 else
2417 item_data = SSDATA (item_name);
2419 if (lpane == XM_FAILURE
2420 || (XMenuAddSelection (FRAME_X_DISPLAY (f),
2421 menu, lpane, 0, item_data,
2422 !NILP (enable), help_string)
2423 == XM_FAILURE))
2425 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2426 *error_name = "Can't add selection to menu";
2427 return Qnil;
2429 i += MENU_ITEMS_ITEM_LENGTH;
2430 lines++;
2434 maxlines = max (maxlines, lines);
2436 /* All set and ready to fly. */
2437 XMenuRecompute (FRAME_X_DISPLAY (f), menu);
2438 dispwidth = DisplayWidth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
2439 dispheight = DisplayHeight (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
2440 x = min (x, dispwidth);
2441 y = min (y, dispheight);
2442 x = max (x, 1);
2443 y = max (y, 1);
2444 XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y,
2445 &ulx, &uly, &width, &height);
2446 if (ulx+width > dispwidth)
2448 x -= (ulx + width) - dispwidth;
2449 ulx = dispwidth - width;
2451 if (uly+height > dispheight)
2453 y -= (uly + height) - dispheight;
2454 uly = dispheight - height;
2456 #ifndef HAVE_X_WINDOWS
2457 if (FRAME_HAS_MINIBUF_P (f) && uly+height > dispheight - 1)
2459 /* Move the menu away of the echo area, to avoid overwriting the
2460 menu with help echo messages or vice versa. */
2461 if (BUFFERP (echo_area_buffer[0]) && WINDOWP (echo_area_window))
2463 y -= WINDOW_TOTAL_LINES (XWINDOW (echo_area_window));
2464 uly -= WINDOW_TOTAL_LINES (XWINDOW (echo_area_window));
2466 else
2468 y--;
2469 uly--;
2472 #endif
2473 if (ulx < 0) x -= ulx;
2474 if (uly < 0) y -= uly;
2476 if (! for_click)
2478 /* If position was not given by a mouse click, adjust so upper left
2479 corner of the menu as a whole ends up at given coordinates. This
2480 is what x-popup-menu says in its documentation. */
2481 x += width/2;
2482 y += 1.5*height/(maxlines+2);
2485 XMenuSetAEQ (menu, TRUE);
2486 XMenuSetFreeze (menu, TRUE);
2487 pane = selidx = 0;
2489 #ifndef MSDOS
2490 XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f));
2491 #endif
2493 record_unwind_protect (pop_down_menu,
2494 Fcons (make_save_value (f, 0),
2495 make_save_value (menu, 0)));
2497 /* Help display under X won't work because XMenuActivate contains
2498 a loop that doesn't give Emacs a chance to process it. */
2499 menu_help_frame = f;
2500 status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
2501 x, y, ButtonReleaseMask, &datap,
2502 menu_help_callback);
2503 entry = pane_prefix = Qnil;
2505 switch (status)
2507 case XM_SUCCESS:
2508 #ifdef XDEBUG
2509 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
2510 #endif
2512 /* Find the item number SELIDX in pane number PANE. */
2513 i = 0;
2514 while (i < menu_items_used)
2516 if (EQ (AREF (menu_items, i), Qt))
2518 if (pane == 0)
2519 pane_prefix
2520 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2521 pane--;
2522 i += MENU_ITEMS_PANE_LENGTH;
2524 else
2526 if (pane == -1)
2528 if (selidx == 0)
2530 entry
2531 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2532 if (keymaps)
2534 entry = Fcons (entry, Qnil);
2535 if (!NILP (pane_prefix))
2536 entry = Fcons (pane_prefix, entry);
2538 break;
2540 selidx--;
2542 i += MENU_ITEMS_ITEM_LENGTH;
2545 break;
2547 case XM_FAILURE:
2548 *error_name = "Can't activate menu";
2549 case XM_IA_SELECT:
2550 break;
2551 case XM_NO_SELECT:
2552 /* Make "Cancel" equivalent to C-g unless FOR_CLICK (which means
2553 the menu was invoked with a mouse event as POSITION). */
2554 if (! for_click)
2555 Fsignal (Qquit, Qnil);
2556 break;
2559 unbind_to (specpdl_count, Qnil);
2561 return entry;
2564 #endif /* not USE_X_TOOLKIT */
2566 #endif /* HAVE_MENUS */
2568 #ifndef MSDOS
2569 /* Detect if a dialog or menu has been posted. MSDOS has its own
2570 implementation on msdos.c. */
2572 int ATTRIBUTE_CONST
2573 popup_activated (void)
2575 return popup_activated_flag;
2577 #endif /* not MSDOS */
2579 /* The following is used by delayed window autoselection. */
2581 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2582 doc: /* Return t if a menu or popup dialog is active. */)
2583 (void)
2585 #ifdef HAVE_MENUS
2586 return (popup_activated ()) ? Qt : Qnil;
2587 #else
2588 return Qnil;
2589 #endif /* HAVE_MENUS */
2592 void
2593 syms_of_xmenu (void)
2595 DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
2597 #ifdef USE_X_TOOLKIT
2598 widget_id_tick = (1<<16);
2599 next_menubar_widget_id = 1;
2600 #endif
2602 defsubr (&Smenu_or_popup_active_p);
2604 #if defined (USE_GTK) || defined (USE_X_TOOLKIT)
2605 defsubr (&Sx_menu_bar_open_internal);
2606 Ffset (intern_c_string ("accelerate-menu"),
2607 intern_c_string (Sx_menu_bar_open_internal.symbol_name));
2608 #endif
2610 #ifdef HAVE_MENUS
2611 defsubr (&Sx_popup_dialog);
2612 #endif