1 /* Implements an elisp-programmable menubar -- X interface.
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
4 Copyright (C) 2000 Ben Wing.
6 This file is part of XEmacs.
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
23 /* Synched up with: Not in FSF. */
25 /* This file Mule-ized by Ben Wing, 7-8-00. */
29 Created 16-dec-91 by Jamie Zawinski.
30 Menu filters and many other keywords added by Stig for 19.12.
31 Original device-abstraction work and GC cleanup work by Ben Wing for 19.13.
32 Menu accelerators c. 1997? by ??. Moved here from event-stream.c.
33 Other work post-1996 by ??.
39 #include "console-x.h"
40 #include "EmacsFrame.h"
42 #include "../lwlib/lwlib.h"
45 #include "commands.h" /* zmacs_regions */
54 static int set_frame_menubar (struct frame *f,
58 #define FRAME_MENUBAR_DATA(frame) ((frame)->menubar_data)
59 #define XFRAME_MENUBAR_DATA(frame) XPOPUP_DATA ((frame)->menubar_data)
61 #define MENUBAR_TYPE 0
62 #define SUBMENU_TYPE 1
66 /* Converting Lisp menu tree descriptions to lwlib's `widget_value' form.
68 menu_item_descriptor_to_widget_value() converts a lisp description of a
69 menubar into a tree of widget_value structures. It allocates widget_values
70 with malloc_widget_value() and allocates other storage only for the `key'
71 slot. All other slots are filled with pointers to Lisp_String data. We
72 allocate a widget_value description of the menu or menubar, and hand it to
73 lwlib, which then makes a copy of it, which it manages internally. We then
74 immediately free our widget_value tree; it will not be referenced again.
76 Incremental menu construction callbacks operate just a bit differently.
77 They allocate widget_values and call replace_widget_value_tree() to tell
78 lwlib to destructively modify the incremental stub (subtree) of its
79 separate widget_value tree.
81 This function is highly recursive (it follows the menu trees) and may call
82 eval. The reason we keep pointers to lisp string data instead of copying
83 it and freeing it later is to avoid the speed penalty that would entail
84 (since this needs to be fast, in the simple cases at least). (The reason
85 we malloc/free the keys slot is because there's not a lisp string around
86 for us to use in that case.)
88 Since we keep pointers to lisp strings, and we call eval, we could lose if
89 GC relocates (or frees) those strings. It's not easy to gc protect the
90 strings because of the recursive nature of this function, and the fact that
91 it returns a data structure that gets freed later. So... we do the
92 sleaziest thing possible and inhibit GC for the duration. This is probably
95 We do not have to worry about the pointers to Lisp_String data after
96 this function successfully finishes. lwlib copies all such data with
100 menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
101 int menu_type, int deep_p,
105 /* This function cannot GC.
106 It is only called from menu_item_descriptor_to_widget_value, which
108 int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0);
109 int count = specpdl_depth ();
110 int partition_seen = 0;
111 widget_value *wv = xmalloc_widget_value ();
112 Lisp_Object wv_closure = make_opaque_ptr (wv);
114 record_unwind_protect (widget_value_unwind, wv_closure);
118 Bufbyte *string_chars = XSTRING_DATA (desc);
119 wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE :
121 if (wv->type == SEPARATOR_TYPE)
123 wv->value = menu_separator_style_and_to_external (string_chars);
127 LISP_STRING_TO_EXTERNAL_MALLOC (desc, wv->name, Qlwlib_encoding);
129 /* dverna Dec. 98: command_builder_operate_menu_accelerator will
130 manipulate the accel as a Lisp_Object if the widget has a name.
131 Since simple labels have a name, but no accel, we *must* set it
133 wv->accel = LISP_TO_VOID (Qnil);
136 else if (VECTORP (desc))
138 Lisp_Object gui_item = gui_parse_item_keywords (desc);
139 if (!button_item_to_widget_value (Qmenubar,
141 (menu_type == MENUBAR_TYPE
142 && depth <= 1), 1, 1))
144 /* :included form was nil */
149 else if (CONSP (desc))
151 Lisp_Object incremental_data = desc;
152 widget_value *prev = 0;
154 if (STRINGP (XCAR (desc)))
156 Lisp_Object key, val;
157 Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil;
158 Lisp_Object active_p = Qt;
160 int included_spec = 0;
162 wv->type = CASCADE_TYPE;
164 wv->name = add_accel_and_to_external (XCAR (desc));
166 accel = gui_name_accelerator (XCAR (desc));
167 wv->accel = LISP_TO_VOID (accel);
171 while (key = Fcar (desc), KEYWORDP (key))
173 Lisp_Object cascade = desc;
176 syntax_error ("Keyword in menu lacks a value", cascade);
179 if (EQ (key, Q_included))
180 include_p = val, included_spec = 1;
181 else if (EQ (key, Q_config))
183 else if (EQ (key, Q_filter))
185 else if (EQ (key, Q_active))
186 active_p = val, active_spec = 1;
187 else if (EQ (key, Q_accelerator))
191 wv->accel = LISP_TO_VOID (val);
193 syntax_error ("bad keyboard accelerator", val);
195 else if (EQ (key, Q_label))
197 /* implement in 21.2 */
200 syntax_error ("Unknown menu cascade keyword", cascade);
203 if ((!NILP (config_tag)
204 && NILP (Fmemq (config_tag, Vmenubar_configuration)))
205 || (included_spec && NILP (Feval (include_p))))
212 active_p = Feval (active_p);
214 if (!NILP (hook_fn) && !NILP (active_p))
216 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
217 if (filter_p || depth == 0)
220 desc = call1_trapping_errors ("Error in menubar filter",
224 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
228 widget_value *incr_wv = xmalloc_widget_value ();
229 wv->contents = incr_wv;
230 incr_wv->type = INCREMENTAL_TYPE;
231 incr_wv->enabled = 1;
232 incr_wv->name = wv->name;
233 incr_wv->name = xstrdup (wv->name);
234 /* This is automatically GC protected through
235 the call to lw_map_widget_values(); no need
237 incr_wv->call_data = LISP_TO_VOID (incremental_data);
240 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
242 if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0)
244 /* Simply prepend three more widget values to the contents of
245 the menu: a label, and two separators (to get a double
247 widget_value *title_wv = xmalloc_widget_value ();
248 widget_value *sep_wv = xmalloc_widget_value ();
249 title_wv->type = TEXT_TYPE;
250 title_wv->name = xstrdup (wv->name);
251 title_wv->enabled = 1;
252 title_wv->next = sep_wv;
253 sep_wv->type = SEPARATOR_TYPE;
254 sep_wv->value = menu_separator_style_and_to_external ((Bufbyte *) "==");
257 wv->contents = title_wv;
260 wv->enabled = ! NILP (active_p);
261 if (deep_p && !wv->enabled && !NILP (desc))
264 /* Add a fake entry so the menus show up */
265 wv->contents = dummy = xmalloc_widget_value ();
266 dummy->name = xstrdup ("(inactive)");
267 dummy->accel = LISP_TO_VOID (Qnil);
271 dummy->type = BUTTON_TYPE;
272 dummy->call_data = NULL;
279 else if (menubar_root_p)
281 wv->name = xstrdup ("menubar");
282 wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
283 this is ignored anyway... */
287 syntax_error ("Menu name (first element) must be a string", desc);
290 if (deep_p || menubar_root_p)
293 for (; !NILP (desc); desc = Fcdr (desc))
295 Lisp_Object child = Fcar (desc);
296 if (menubar_root_p && NILP (child)) /* the partition */
300 ("More than one partition (nil) in menubar description",
303 next = xmalloc_widget_value ();
304 next->type = PUSHRIGHT_TYPE;
308 next = menu_item_descriptor_to_widget_value_1
309 (child, menu_type, deep_p, filter_p, depth + 1);
320 if (deep_p && !wv->contents)
323 else if (NILP (desc))
324 syntax_error ("nil may not appear in menu descriptions", desc);
326 syntax_error ("Unrecognized menu descriptor", desc);
332 /* Completed normally. Clear out the object that widget_value_unwind()
333 will be called with to tell it not to free the wv (as we are
335 set_opaque_ptr (wv_closure, 0);
338 unbind_to (count, Qnil);
342 static widget_value *
343 menu_item_descriptor_to_widget_value (Lisp_Object desc,
344 int menu_type, /* if this is a menubar,
347 int filter_p) /* if :filter forms
351 int count = specpdl_depth ();
352 record_unwind_protect (restore_gc_inhibit,
353 make_int (gc_currently_forbidden));
354 gc_currently_forbidden = 1;
356 wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p,
358 unbind_to (count, Qnil);
363 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
364 int in_menu_callback;
367 restore_in_menu_callback (Lisp_Object val)
369 in_menu_callback = XINT (val);
372 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
375 /* #### Sort of a hack needed to process Vactivate_menubar_hook
376 correctly wrt buffer-local values. A correct solution would
377 involve adding a callback mechanism to run_hook(). This function
378 is currently unused. */
380 my_run_hook (Lisp_Object hooksym, int allow_global_p)
382 /* This function can GC */
384 Lisp_Object value = Fsymbol_value (hooksym);
387 if (!NILP (value) && (!CONSP (value) || EQ (XCAR (value), Qlambda)))
388 return !EQ (call0 (value), Qt);
390 EXTERNAL_LIST_LOOP (tail, value)
392 if (allow_global_p && EQ (XCAR (tail), Qt))
393 changes |= my_run_hook (Fdefault_value (hooksym), 0);
394 if (!EQ (call0 (XCAR (tail)), Qt))
402 /* The order in which callbacks are run is funny to say the least.
403 It's sometimes tricky to avoid running a callback twice, and to
404 avoid returning prematurely. So, this function returns true
405 if the menu's callbacks are no longer gc protected. So long
406 as we unprotect them before allowing other callbacks to run,
407 everything should be ok.
409 The pre_activate_callback() *IS* intentionally called multiple times.
410 If client_data == NULL, then it's being called before the menu is posted.
411 If client_data != NULL, then client_data is a (widget_value *) and
412 client_data->data is a Lisp_Object pointing to a lisp submenu description
413 that must be converted into widget_values. *client_data is destructively
416 #### Stig thinks that there may be a GC problem here due to the
417 fact that pre_activate_callback() is called multiple times, but I
423 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
425 /* This function can GC */
426 struct device *d = get_device_from_display (XtDisplay (widget));
427 struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
431 /* set in lwlib to the time stamp associated with the most recent menu
433 extern Time x_focus_timestamp_really_sucks_fix_me_better;
436 f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
440 /* make sure f is the selected frame */
441 XSETFRAME (frame, f);
442 Fselect_frame (frame);
446 /* this is an incremental menu construction callback */
447 widget_value *hack_wv = (widget_value *) client_data;
448 Lisp_Object submenu_desc;
451 assert (hack_wv->type == INCREMENTAL_TYPE);
452 VOID_TO_LISP (submenu_desc, hack_wv->call_data);
455 * #### Fix the menu code so this isn't necessary.
457 * Protect against reentering the menu code otherwise we will
458 * crash later when the code gets confused at the state
461 count = specpdl_depth ();
462 record_unwind_protect (restore_in_menu_callback,
463 make_int (in_menu_callback));
464 in_menu_callback = 1;
465 wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE,
467 unbind_to (count, Qnil);
471 wv = xmalloc_widget_value ();
472 wv->type = CASCADE_TYPE;
474 wv->accel = LISP_TO_VOID (Qnil);
475 wv->contents = xmalloc_widget_value ();
476 wv->contents->type = TEXT_TYPE;
477 wv->contents->name = xstrdup ("No menu");
478 wv->contents->next = NULL;
479 wv->contents->accel = LISP_TO_VOID (Qnil);
481 assert (wv && wv->type == CASCADE_TYPE && wv->contents);
482 replace_widget_value_tree (hack_wv, wv->contents);
483 free_popup_widget_value_tree (wv);
485 else if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f)))
489 #if 0 /* Unused, see comment below. */
492 /* #### - this menubar update mechanism is expensively anti-social and
493 the activate-menubar-hook is now mostly obsolete. */
494 any_changes = my_run_hook (Qactivate_menubar_hook, 1);
496 /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
497 incremental menus are implemented. If a subtree of a menu has been
498 updated incrementally (a destructive operation), then that subtree
499 must somehow be wiped.
501 It is difficult to undo the destructive operation in lwlib because
502 a pointer back to lisp data needs to be hidden away somewhere. So
503 that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */
505 !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date)
506 set_frame_menubar (f, 1, 0);
508 run_hook (Qactivate_menubar_hook);
509 set_frame_menubar (f, 1, 0);
511 DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
512 DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
513 x_focus_timestamp_really_sucks_fix_me_better;
517 static widget_value *
518 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
525 int count = specpdl_depth ();
527 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
528 Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
529 data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
531 unbind_to (count, Qnil);
538 set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
544 /* As with the toolbar, the minibuffer does not have its own menubar. */
545 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
550 /***** first compute the contents of the menubar *****/
554 /* evaluate `current-menubar' in the buffer of the selected window
555 of the frame in question. */
556 menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
560 /* That's a little tricky the first time since the frame isn't
561 fully initialized yet. */
562 menubar = Fsymbol_value (Qcurrent_menubar);
567 menubar = Vblank_menubar;
571 menubar_visible = !NILP (w->menubar_visible_p);
573 data = compute_menubar_data (f, menubar, deep_p);
574 if (!data || (!data->next && !data->contents))
577 if (NILP (FRAME_MENUBAR_DATA (f)))
579 struct popup_data *mdata =
580 alloc_lcrecord_type (struct popup_data, &lrecord_popup_data);
582 mdata->id = new_lwlib_id ();
583 mdata->last_menubar_buffer = Qnil;
584 mdata->menubar_contents_up_to_date = 0;
585 XSETPOPUP_DATA (FRAME_MENUBAR_DATA (f), mdata);
588 /***** now store into the menubar widget, creating it if necessary *****/
590 id = XFRAME_MENUBAR_DATA (f)->id;
591 if (!FRAME_X_MENUBAR_WIDGET (f))
593 Widget parent = FRAME_X_CONTAINER_WIDGET (f);
595 assert (first_time_p);
597 /* It's the first time we've mapped the menubar so compute its
598 contents completely once. This makes sure that the menubar
599 components are created with the right type. */
602 free_popup_widget_value_tree (data);
603 data = compute_menubar_data (f, menubar, 1);
607 FRAME_X_MENUBAR_WIDGET (f) =
608 lw_create_widget ("menubar", "menubar", id, data, parent,
609 0, pre_activate_callback,
610 popup_selection_callback, 0);
615 lw_modify_all_widgets (id, data, deep_p ? True : False);
617 free_popup_widget_value_tree (data);
619 XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p;
620 XFRAME_MENUBAR_DATA (f)->last_menubar_buffer =
621 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
622 return menubar_visible;
626 /* Called from x_create_widgets() to create the initial menubar of a frame
627 before it is mapped, so that the window is mapped with the menubar already
628 there instead of us tacking it on later and thrashing the window after it
631 x_initialize_frame_menubar (struct frame *f)
633 return set_frame_menubar (f, 1, 1);
637 static LWLIB_ID last_popup_menu_selection_callback_id;
640 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
641 XtPointer client_data)
643 last_popup_menu_selection_callback_id = id;
644 popup_selection_callback (widget, id, client_data);
645 /* lw_destroy_all_widgets() will be called from popup_down_callback() */
649 popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
651 if (popup_handled_p (id))
653 assert (popup_up_p != 0);
654 ungcpro_popup_callbacks (id);
656 /* if this isn't called immediately after the selection callback, then
657 there wasn't a menu selection. */
658 if (id != last_popup_menu_selection_callback_id)
659 popup_selection_callback (widget, id, (XtPointer) -1);
660 lw_destroy_all_widgets (id);
665 make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev)
666 /* NULL for eev means query pointer */
668 XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
670 btn->type = ButtonPress;
673 btn->display = XtDisplay (daddy);
674 btn->window = XtWindow (daddy);
677 Position shellx, shelly, framex, framey;
679 btn->time = eev->timestamp;
680 btn->button = eev->event.button.button;
681 btn->root = RootWindowOfScreen (XtScreen (daddy));
682 btn->subwindow = (Window) NULL;
683 btn->x = eev->event.button.x;
684 btn->y = eev->event.button.y;
686 #ifndef HAVE_WMCOMMAND
688 Widget shell = XtParent (daddy);
690 XtSetArg (al [0], XtNx, &shellx);
691 XtSetArg (al [1], XtNy, &shelly);
692 XtGetValues (shell, al, 2);
695 XtSetArg (al [0], XtNx, &framex);
696 XtSetArg (al [1], XtNy, &framey);
697 XtGetValues (daddy, al, 2);
698 btn->x_root = shellx + framex + btn->x;
699 btn->y_root = shelly + framey + btn->y;
700 btn->state = ButtonPressMask; /* all buttons pressed */
704 /* CurrentTime is just ZERO, so it's worthless for
705 determining relative click times. */
706 struct device *d = get_device_from_display (XtDisplay (daddy));
707 btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
709 XQueryPointer (btn->display, btn->window, &btn->root,
710 &btn->subwindow, &btn->x_root, &btn->y_root,
711 &btn->x, &btn->y, &btn->state);
718 x_update_frame_menubar_internal (struct frame *f)
720 /* We assume the menubar contents has changed if the global flag is set,
721 or if the current buffer has changed, or if the menubar has never
724 int menubar_contents_changed =
726 || NILP (FRAME_MENUBAR_DATA (f))
727 || (!EQ (XFRAME_MENUBAR_DATA (f)->last_menubar_buffer,
728 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
730 Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
731 Boolean menubar_will_be_visible = menubar_was_visible;
732 Boolean menubar_visibility_changed;
734 if (menubar_contents_changed)
735 menubar_will_be_visible = set_frame_menubar (f, 0, 0);
737 menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
739 if (!menubar_visibility_changed)
742 /* Set menubar visibility */
743 (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
744 (FRAME_X_MENUBAR_WIDGET (f));
746 MARK_FRAME_SIZE_SLIPPED (f);
750 x_update_frame_menubars (struct frame *f)
752 assert (FRAME_X_P (f));
754 x_update_frame_menubar_internal (f);
756 /* #### This isn't going to work right now that this function works on
757 a per-frame, not per-device basis. Guess what? I don't care. */
761 x_free_frame_menubars (struct frame *f)
763 Widget menubar_widget;
765 assert (FRAME_X_P (f));
767 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
770 LWLIB_ID id = XFRAME_MENUBAR_DATA (f)->id;
771 lw_destroy_all_widgets (id);
772 XFRAME_MENUBAR_DATA (f)->id = 0;
777 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
780 struct frame *f = selected_frame ();
784 Lisp_Event *eev = NULL;
788 XSETFRAME (frame, f);
789 CHECK_X_FRAME (frame);
790 parent = FRAME_X_SHELL_WIDGET (f);
794 CHECK_LIVE_EVENT (event);
796 if (eev->event_type != button_press_event
797 && eev->event_type != button_release_event)
798 wrong_type_argument (Qmouse_event_p, event);
800 else if (!NILP (Vthis_command_keys))
802 /* if an event wasn't passed, use the last event of the event sequence
803 currently being executed, if that event is a mouse event */
804 eev = XEVENT (Vthis_command_keys); /* last event first */
805 if (eev->event_type != button_press_event
806 && eev->event_type != button_release_event)
809 make_dummy_xbutton_event (&xev, parent, eev);
811 if (SYMBOLP (menu_desc))
812 menu_desc = Fsymbol_value (menu_desc);
813 CHECK_CONS (menu_desc);
814 CHECK_STRING (XCAR (menu_desc));
815 data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
817 if (! data) error ("no menu");
819 menu_id = new_lwlib_id ();
820 menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
822 popup_menu_selection_callback,
823 popup_menu_down_callback);
824 free_popup_widget_value_tree (data);
826 gcpro_popup_callbacks (menu_id);
828 /* Setting zmacs-region-stays is necessary here because executing a command
829 from a menu is really a two-command process: the first command (bound to
830 the button-click) simply pops up the menu, and returns. This causes a
831 sequence of magic-events (destined for the popup-menu widget) to begin.
832 Eventually, a menu item is selected, and a menu-event blip is pushed onto
833 the end of the input stream, which is then executed by the event loop.
835 So there are two command-events, with a bunch of magic-events between
836 them. We don't want the *first* command event to alter the state of the
837 region, so that the region can be available as an argument for the second
841 zmacs_region_stays = 1;
844 lw_popup_menu (menu, &xev);
845 /* this speeds up display of pop-up menus */
846 XFlush (XtDisplay (parent));
851 #if defined(LWLIB_MENUBARS_LUCID)
855 widget_value *current = lw_get_entries (False);
856 widget_value *entries = lw_get_entries (True);
857 widget_value *prev = NULL;
859 while (entries != current)
861 if (entries->name /*&& entries->enabled*/) prev = entries;
862 entries = entries->next;
867 /* move to last item */
869 while (entries->next)
871 if (entries->name /*&& entries->enabled*/) prev = entries;
872 entries = entries->next;
876 if (entries->name /*&& entries->enabled*/)
881 /* no selectable items in this menu, pop up to previous level */
890 menu_move_down (void)
892 widget_value *current = lw_get_entries (False);
893 widget_value *new = current;
898 if (new->name /*&& new->enabled*/) break;
901 if (new==current||!(new->name/*||new->enabled*/))
903 new = lw_get_entries (True);
906 if (new->name /*&& new->enabled*/) break;
909 if (new==current&&!(new->name /*|| new->enabled*/))
920 menu_move_left (void)
922 int level = lw_menu_level ();
924 widget_value *current;
930 current = lw_get_entries (False);
931 if (l > 2 && current->contents)
932 lw_push_menu (current->contents);
936 menu_move_right (void)
938 int level = lw_menu_level ();
940 widget_value *current;
946 current = lw_get_entries (False);
947 if (l > 2 && current->contents)
948 lw_push_menu (current->contents);
952 menu_select_item (widget_value *val)
955 val = lw_get_entries (False);
957 /* is match a submenu? */
961 /* enter the submenu */
964 lw_push_menu (val->contents);
968 /* Execute the menu entry by calling the menu's `select'
976 command_builder_operate_menu_accelerator (struct command_builder *builder)
978 /* this function can GC */
980 struct console *con = XCONSOLE (Vselected_console);
981 Lisp_Object evee = builder->most_current_event;
983 widget_value *entries;
985 extern int lw_menu_accelerate; /* lwlib.c */
993 t = builder->current_events;
998 sprintf (buf,"OPERATE (%d): ",i);
999 write_c_string (buf, Qexternal_debugging_output);
1000 print_internal (t, Qexternal_debugging_output, 1);
1001 write_c_string ("\n", Qexternal_debugging_output);
1002 t = XEVENT_NEXT (t);
1007 /* menu accelerator keys don't go into keyboard macros */
1008 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
1009 con->kbd_macro_ptr = con->kbd_macro_end;
1011 /* don't echo menu accelerator keys */
1012 /*reset_key_echo (builder, 1);*/
1014 if (!lw_menu_accelerate)
1016 /* `convert' mouse display to keyboard display
1017 by entering the open submenu
1019 entries = lw_get_entries (False);
1020 if (entries->contents)
1022 lw_push_menu (entries->contents);
1023 lw_display_menu (CurrentTime);
1027 /* compare event to the current menu accelerators */
1029 entries=lw_get_entries (True);
1034 VOID_TO_LISP (accel, entries->accel);
1035 if (entries->name && !NILP (accel))
1037 if (event_matches_key_specifier_p (XEVENT (evee), accel))
1041 menu_select_item (entries);
1043 if (lw_menu_active) lw_display_menu (CurrentTime);
1045 reset_this_command_keys (Vselected_console, 1);
1046 /*reset_command_builder_event_chain (builder);*/
1047 return Vmenu_accelerator_map;
1050 entries = entries->next;
1053 /* try to look up event in menu-accelerator-map */
1055 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
1059 /* beep at user for undefined key */
1064 if (EQ (binding, Qmenu_quit))
1066 /* turn off menus and set quit flag */
1067 lw_kill_menus (NULL);
1070 else if (EQ (binding, Qmenu_up))
1072 int level = lw_menu_level ();
1076 else if (EQ (binding, Qmenu_down))
1078 int level = lw_menu_level ();
1082 menu_select_item (NULL);
1084 else if (EQ (binding, Qmenu_left))
1086 int level = lw_menu_level ();
1090 lw_display_menu (CurrentTime);
1095 else if (EQ (binding, Qmenu_right))
1097 int level = lw_menu_level ();
1099 lw_get_entries (False)->contents)
1101 widget_value *current = lw_get_entries (False);
1102 if (current->contents)
1103 menu_select_item (NULL);
1108 else if (EQ (binding, Qmenu_select))
1109 menu_select_item (NULL);
1110 else if (EQ (binding, Qmenu_escape))
1112 int level = lw_menu_level ();
1117 lw_display_menu (CurrentTime);
1121 /* turn off menus quietly */
1122 lw_kill_menus (NULL);
1125 else if (KEYMAPP (binding))
1128 reset_this_command_keys (Vselected_console, 1);
1129 /*reset_command_builder_event_chain (builder);*/
1134 /* turn off menus and execute binding */
1135 lw_kill_menus (NULL);
1136 reset_this_command_keys (Vselected_console, 1);
1137 /*reset_command_builder_event_chain (builder);*/
1142 if (lw_menu_active) lw_display_menu (CurrentTime);
1144 reset_this_command_keys (Vselected_console, 1);
1145 /*reset_command_builder_event_chain (builder);*/
1147 return Vmenu_accelerator_map;
1151 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
1153 Vmenu_accelerator_prefix = Qnil;
1154 Vmenu_accelerator_modifiers = Qnil;
1155 Vmenu_accelerator_enabled = Qnil;
1156 if (!NILP (errordata))
1158 Lisp_Object args[2];
1160 args[0] = build_string ("Error in menu accelerators (setting to nil)");
1161 /* #### This should call
1162 (with-output-to-string (display-error errordata))
1163 but that stuff is all in Lisp currently. */
1164 args[1] = errordata;
1165 warn_when_safe_lispobj
1167 emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s",
1168 Qnil, -1, 2, args));
1175 menu_accelerator_safe_compare (Lisp_Object event0)
1177 if (CONSP (Vmenu_accelerator_prefix))
1180 t=Vmenu_accelerator_prefix;
1183 && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
1186 event0 = XEVENT_NEXT (event0);
1191 else if (NILP (event0))
1193 else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
1194 event0 = XEVENT_NEXT (event0);
1201 menu_accelerator_safe_mod_compare (Lisp_Object cons)
1203 return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
1209 command_builder_find_menu_accelerator (struct command_builder *builder)
1211 /* this function can GC */
1212 Lisp_Object event0 = builder->current_events;
1213 struct console *con = XCONSOLE (Vselected_console);
1214 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
1215 Widget menubar_widget;
1217 /* compare entries in event0 against the menu prefix */
1219 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
1220 XEVENT (event0)->event_type != key_press_event)
1223 if (!NILP (Vmenu_accelerator_prefix))
1225 event0 = condition_case_1 (Qerror,
1226 menu_accelerator_safe_compare,
1228 menu_accelerator_junk_on_error,
1235 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
1237 && CONSP (Vmenu_accelerator_modifiers))
1239 Lisp_Object fake = Qnil;
1240 Lisp_Object last = Qnil;
1241 struct gcpro gcpro1;
1245 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
1247 val = lw_get_all_values (id);
1250 val = val->contents;
1252 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
1255 while (!NILP (Fcdr (last)))
1258 Fsetcdr (last, Fcons (Qnil, Qnil));
1262 fake = Fcons (Qnil, fake);
1269 VOID_TO_LISP (accel, val->accel);
1270 if (val->name && !NILP (accel))
1272 Fsetcar (last, accel);
1273 Fsetcar (fake, event0);
1274 matchp = condition_case_1 (Qerror,
1275 menu_accelerator_safe_mod_compare,
1277 menu_accelerator_junk_on_error,
1283 lw_set_menu (menubar_widget, val);
1284 /* yah - yet another hack.
1285 pretend emacs timestamp is the same as an X timestamp,
1286 which for the moment it is. (read events.h)
1288 lw_map_menu (XEVENT (event0)->timestamp);
1291 lw_push_menu (val->contents);
1293 lw_display_menu (CurrentTime);
1295 /* menu accelerator keys don't go into keyboard macros */
1296 if (!NILP (con->defining_kbd_macro)
1297 && NILP (Vexecuting_macro))
1298 con->kbd_macro_ptr = con->kbd_macro_end;
1300 /* don't echo menu accelerator keys */
1301 /*reset_key_echo (builder, 1);*/
1302 reset_this_command_keys (Vselected_console, 1);
1305 return Vmenu_accelerator_map;
1318 x_kludge_lw_menu_active (void)
1320 return lw_menu_active;
1323 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
1324 Make the menubar active. Menu items can be selected using menu accelerators
1325 or by actions defined in menu-accelerator-map.
1329 struct console *con = XCONSOLE (Vselected_console);
1330 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
1334 if (NILP (f->menubar_data))
1335 error ("Frame has no menubar.");
1337 id = XPOPUP_DATA (f->menubar_data)->id;
1338 val = lw_get_all_values (id);
1339 val = val->contents;
1340 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
1341 lw_map_menu (CurrentTime);
1343 lw_display_menu (CurrentTime);
1345 /* menu accelerator keys don't go into keyboard macros */
1346 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
1347 con->kbd_macro_ptr = con->kbd_macro_end;
1351 #endif /* LWLIB_MENUBARS_LUCID */
1355 syms_of_menubar_x (void)
1357 #if defined(LWLIB_MENUBARS_LUCID)
1358 DEFSUBR (Faccelerate_menu);
1363 console_type_create_menubar_x (void)
1365 CONSOLE_HAS_METHOD (x, update_frame_menubars);
1366 CONSOLE_HAS_METHOD (x, free_frame_menubars);
1367 CONSOLE_HAS_METHOD (x, popup_menu);
1371 reinit_vars_of_menubar_x (void)
1373 last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
1377 vars_of_menubar_x (void)
1379 reinit_vars_of_menubar_x ();
1381 #if defined (LWLIB_MENUBARS_LUCID)
1382 Fprovide (intern ("lucid-menubars"));
1383 #elif defined (LWLIB_MENUBARS_MOTIF)
1384 Fprovide (intern ("motif-menubars"));
1385 #elif defined (LWLIB_MENUBARS_ATHENA)
1386 Fprovide (intern ("athena-menubars"));