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