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 SXEmacs
8 SXEmacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 SXEmacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
22 /* Synched up with: Not in FSF. */
24 /* This file Mule-ized by Ben Wing, 7-8-00. */
28 Created 16-dec-91 by Jamie Zawinski.
29 Menu filters and many other keywords added by Stig for 19.12.
30 Original device-abstraction work and GC cleanup work by Ben Wing for 19.13.
31 Menu accelerators c. 1997? by ??. Moved here from event-stream.c.
32 Other work post-1996 by ??.
38 #include "console-x.h"
39 #include "EmacsFrame.h"
41 #include "ui/lwlib/lwlib.h"
44 #include "commands.h" /* zmacs_regions */
45 #define INCLUDE_EVENTS_H_PRIVATE_SPHERE
46 #include "events/events.h"
49 #include "ui/keymap.h"
50 #include "ui/menubar.h"
52 #include "ui/window.h"
54 static int set_frame_menubar(struct frame *f, int deep_p, int first_time_p);
56 #define FRAME_MENUBAR_DATA(frame) ((frame)->menubar_data)
57 #define XFRAME_MENUBAR_DATA(frame) XPOPUP_DATA ((frame)->menubar_data)
59 #define MENUBAR_TYPE 0
60 #define SUBMENU_TYPE 1
63 /* Converting Lisp menu tree descriptions to lwlib's `widget_value' form.
65 menu_item_descriptor_to_widget_value() converts a lisp description of a
66 menubar into a tree of widget_value structures. It allocates widget_values
67 with malloc_widget_value() and allocates other storage only for the `key'
68 slot. All other slots are filled with pointers to Lisp_String data. We
69 allocate a widget_value description of the menu or menubar, and hand it to
70 lwlib, which then makes a copy of it, which it manages internally. We then
71 immediately free our widget_value tree; it will not be referenced again.
73 Incremental menu construction callbacks operate just a bit differently.
74 They allocate widget_values and call replace_widget_value_tree() to tell
75 lwlib to destructively modify the incremental stub (subtree) of its
76 separate widget_value tree.
78 This function is highly recursive (it follows the menu trees) and may call
79 eval. The reason we keep pointers to lisp string data instead of copying
80 it and freeing it later is to avoid the speed penalty that would entail
81 (since this needs to be fast, in the simple cases at least). (The reason
82 we malloc/free the keys slot is because there's not a lisp string around
83 for us to use in that case.)
85 Since we keep pointers to lisp strings, and we call eval, we could lose if
86 GC relocates (or frees) those strings. It's not easy to gc protect the
87 strings because of the recursive nature of this function, and the fact that
88 it returns a data structure that gets freed later. So... we do the
89 sleaziest thing possible and inhibit GC for the duration. This is probably
92 We do not have to worry about the pointers to Lisp_String data after
93 this function successfully finishes. lwlib copies all such data with
96 static widget_value *menu_item_descriptor_to_widget_value_1(Lisp_Object desc,
102 /* This function cannot GC.
103 It is only called from menu_item_descriptor_to_widget_value, which
105 int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0);
106 int count = specpdl_depth();
107 int partition_seen = 0;
108 widget_value *wv = xmalloc_widget_value();
109 Lisp_Object wv_closure = make_opaque_ptr(wv);
111 record_unwind_protect(widget_value_unwind, wv_closure);
114 Bufbyte *string_chars = XSTRING_DATA(desc);
115 wv->type = (separator_string_p(string_chars) ? SEPARATOR_TYPE :
117 if (wv->type == SEPARATOR_TYPE) {
119 menu_separator_style_and_to_external(string_chars);
121 LISP_STRING_TO_EXTERNAL_MALLOC(desc, wv->name,
124 /* dverna Dec. 98: command_builder_operate_menu_accelerator will
125 manipulate the accel as a Lisp_Object if the widget has a name.
126 Since simple labels have a name, but no accel, we *must* set it
128 wv->accel = LISP_TO_VOID(Qnil);
130 } else if (VECTORP(desc)) {
131 Lisp_Object gui_item = gui_parse_item_keywords(desc);
132 if (!button_item_to_widget_value(Qmenubar,
134 (menu_type == MENUBAR_TYPE
135 && depth <= 1), 1, 1)) {
136 /* :included form was nil */
140 } else if (CONSP(desc)) {
141 Lisp_Object incremental_data = desc;
142 widget_value *prev = 0;
144 if (STRINGP(XCAR(desc))) {
145 Lisp_Object key, val;
146 Lisp_Object include_p = Qnil, hook_fn =
147 Qnil, config_tag = Qnil;
148 Lisp_Object active_p = Qt;
150 int included_spec = 0;
152 wv->type = CASCADE_TYPE;
154 wv->name = add_accel_and_to_external(XCAR(desc));
156 accel = gui_name_accelerator(XCAR(desc));
157 wv->accel = LISP_TO_VOID(accel);
161 while (key = Fcar(desc), KEYWORDP(key)) {
162 Lisp_Object cascade = desc;
166 ("Keyword in menu lacks a value",
170 if (EQ(key, Q_included))
171 include_p = val, included_spec = 1;
172 else if (EQ(key, Q_config))
174 else if (EQ(key, Q_filter))
176 else if (EQ(key, Q_active))
177 active_p = val, active_spec = 1;
178 else if (EQ(key, Q_accelerator)) {
181 wv->accel = LISP_TO_VOID(val);
184 ("bad keyboard accelerator",
186 } else if (EQ(key, Q_label)) {
187 /* implement in 21.2 */
190 ("Unknown menu cascade keyword",
194 if ((!NILP(config_tag)
195 && NILP(Fmemq(config_tag, Vmenubar_configuration)))
196 || (included_spec && NILP(Feval(include_p)))) {
202 active_p = Feval(active_p);
204 if (!NILP(hook_fn) && !NILP(active_p)) {
205 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
206 if (filter_p || depth == 0) {
209 call1_trapping_errors
210 ("Error in menubar filter", hook_fn,
214 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
216 widget_value *incr_wv =
217 xmalloc_widget_value();
218 wv->contents = incr_wv;
219 incr_wv->type = INCREMENTAL_TYPE;
220 incr_wv->enabled = 1;
221 incr_wv->name = wv->name;
222 incr_wv->name = xstrdup(wv->name);
223 /* This is automatically GC protected through
224 the call to lw_map_widget_values(); no need
227 LISP_TO_VOID(incremental_data);
230 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
232 if (menu_type == POPUP_TYPE && popup_menu_titles
234 /* Simply prepend three more widget values to the contents of
235 the menu: a label, and two separators (to get a double
237 widget_value *title_wv = xmalloc_widget_value();
238 widget_value *sep_wv = xmalloc_widget_value();
239 title_wv->type = TEXT_TYPE;
240 title_wv->name = xstrdup(wv->name);
241 title_wv->enabled = 1;
242 title_wv->next = sep_wv;
243 sep_wv->type = SEPARATOR_TYPE;
245 menu_separator_style_and_to_external((Bufbyte *) "==");
248 wv->contents = title_wv;
251 wv->enabled = !NILP(active_p);
252 if (deep_p && !wv->enabled && !NILP(desc)) {
254 /* Add a fake entry so the menus show up */
255 wv->contents = dummy = xmalloc_widget_value();
256 dummy->name = xstrdup("(inactive)");
257 dummy->accel = LISP_TO_VOID(Qnil);
261 dummy->type = BUTTON_TYPE;
262 dummy->call_data = NULL;
268 } else if (menubar_root_p) {
269 wv->name = xstrdup("menubar");
270 wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
271 this is ignored anyway... */
274 ("Menu name (first element) must be a string",
278 if (deep_p || menubar_root_p) {
280 for (; !NILP(desc); desc = Fcdr(desc)) {
281 Lisp_Object child = Fcar(desc);
282 if (menubar_root_p && NILP(child)) { /* the partition */
285 ("More than one partition (nil) in menubar description",
288 next = xmalloc_widget_value();
289 next->type = PUSHRIGHT_TYPE;
292 menu_item_descriptor_to_widget_value_1
293 (child, menu_type, deep_p, filter_p,
305 if (deep_p && !wv->contents)
307 } else if (NILP(desc))
308 syntax_error("nil may not appear in menu descriptions", desc);
310 syntax_error("Unrecognized menu descriptor", desc);
315 /* Completed normally. Clear out the object that widget_value_unwind()
316 will be called with to tell it not to free the wv (as we are
318 set_opaque_ptr(wv_closure, 0);
321 unbind_to(count, Qnil);
325 static widget_value *menu_item_descriptor_to_widget_value(Lisp_Object desc, int menu_type, /* if this is a menubar,
329 { /* if :filter forms
332 int count = specpdl_depth();
333 record_unwind_protect(restore_gc_inhibit,
334 make_int(gc_currently_forbidden));
335 gc_currently_forbidden = 1;
337 wv = menu_item_descriptor_to_widget_value_1(desc, menu_type, deep_p,
339 unbind_to(count, Qnil);
343 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
344 int in_menu_callback;
346 static Lisp_Object restore_in_menu_callback(Lisp_Object val)
348 in_menu_callback = XINT(val);
351 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
354 /* #### Sort of a hack needed to process Vactivate_menubar_hook
355 correctly wrt buffer-local values. A correct solution would
356 involve adding a callback mechanism to run_hook(). This function
357 is currently unused. */
358 static int my_run_hook(Lisp_Object hooksym, int allow_global_p)
360 /* This function can GC */
362 Lisp_Object value = Fsymbol_value(hooksym);
365 if (!NILP(value) && (!CONSP(value) || EQ(XCAR(value), Qlambda)))
366 return !EQ(call0(value), Qt);
368 EXTERNAL_LIST_LOOP(tail, value) {
369 if (allow_global_p && EQ(XCAR(tail), Qt))
370 changes |= my_run_hook(Fdefault_value(hooksym), 0);
371 if (!EQ(call0(XCAR(tail)), Qt))
378 /* The order in which callbacks are run is funny to say the least.
379 It's sometimes tricky to avoid running a callback twice, and to
380 avoid returning prematurely. So, this function returns true
381 if the menu's callbacks are no longer gc protected. So long
382 as we unprotect them before allowing other callbacks to run,
383 everything should be ok.
385 The pre_activate_callback() *IS* intentionally called multiple times.
386 If client_data == NULL, then it's being called before the menu is posted.
387 If client_data != NULL, then client_data is a (widget_value *) and
388 client_data->data is a Lisp_Object pointing to a lisp submenu description
389 that must be converted into widget_values. *client_data is destructively
392 #### Stig thinks that there may be a GC problem here due to the
393 fact that pre_activate_callback() is called multiple times, but I
399 pre_activate_callback(Widget widget, LWLIB_ID id, XtPointer client_data)
401 /* This function can GC */
402 struct device *d = get_device_from_display(XtDisplay(widget));
403 struct frame *f = x_any_window_to_frame(d, XtWindow(widget));
407 /* set in lwlib to the time stamp associated with the most recent menu
409 extern Time x_focus_timestamp_really_sucks_fix_me_better;
412 f = x_any_window_to_frame(d, XtWindow(XtParent(widget)));
416 /* make sure f is the selected frame */
418 Fselect_frame(frame);
421 /* this is an incremental menu construction callback */
422 widget_value *hack_wv = (widget_value *) client_data;
423 Lisp_Object submenu_desc;
426 assert(hack_wv->type == INCREMENTAL_TYPE);
427 VOID_TO_LISP(submenu_desc, hack_wv->call_data);
430 * #### Fix the menu code so this isn't necessary.
432 * Protect against reentering the menu code otherwise we will
433 * crash later when the code gets confused at the state
436 count = specpdl_depth();
437 record_unwind_protect(restore_in_menu_callback,
438 make_int(in_menu_callback));
439 in_menu_callback = 1;
440 wv = menu_item_descriptor_to_widget_value(submenu_desc,
442 unbind_to(count, Qnil);
445 wv = xmalloc_widget_value();
446 wv->type = CASCADE_TYPE;
448 wv->accel = LISP_TO_VOID(Qnil);
449 wv->contents = xmalloc_widget_value();
450 wv->contents->type = TEXT_TYPE;
451 wv->contents->name = xstrdup("No menu");
452 wv->contents->next = NULL;
453 wv->contents->accel = LISP_TO_VOID(Qnil);
455 assert(wv && wv->type == CASCADE_TYPE && wv->contents);
456 replace_widget_value_tree(hack_wv, wv->contents);
457 free_popup_widget_value_tree(wv);
458 } else if (!POPUP_DATAP(FRAME_MENUBAR_DATA(f)))
461 #if 0 /* Unused, see comment below. */
464 /* #### - this menubar update mechanism is expensively anti-social and
465 the activate-menubar-hook is now mostly obsolete. */
466 any_changes = my_run_hook(Qactivate_menubar_hook, 1);
468 /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
469 incremental menus are implemented. If a subtree of a menu has been
470 updated incrementally (a destructive operation), then that subtree
471 must somehow be wiped.
473 It is difficult to undo the destructive operation in lwlib because
474 a pointer back to lisp data needs to be hidden away somewhere. So
475 that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */
477 !XFRAME_MENUBAR_DATA(f)->menubar_contents_up_to_date)
478 set_frame_menubar(f, 1, 0);
480 run_hook(Qactivate_menubar_hook);
481 set_frame_menubar(f, 1, 0);
483 DEVICE_X_MOUSE_TIMESTAMP(XDEVICE(FRAME_DEVICE(f))) =
484 DEVICE_X_GLOBAL_MOUSE_TIMESTAMP(XDEVICE(FRAME_DEVICE(f))) =
485 x_focus_timestamp_really_sucks_fix_me_better;
489 static widget_value *compute_menubar_data(struct frame *f, Lisp_Object menubar,
496 int count = specpdl_depth();
498 record_unwind_protect(Fset_buffer, Fcurrent_buffer());
499 Fset_buffer(XWINDOW(FRAME_SELECTED_WINDOW(f))->buffer);
501 menu_item_descriptor_to_widget_value(menubar, MENUBAR_TYPE,
503 unbind_to(count, Qnil);
509 static int set_frame_menubar(struct frame *f, int deep_p, int first_time_p)
515 /* As with the toolbar, the minibuffer does not have its own menubar. */
516 struct window *w = XWINDOW(FRAME_LAST_NONMINIBUF_WINDOW(f));
521 /***** first compute the contents of the menubar *****/
524 /* evaluate `current-menubar' in the buffer of the selected window
525 of the frame in question. */
526 menubar = symbol_value_in_buffer(Qcurrent_menubar, w->buffer);
528 /* That's a little tricky the first time since the frame isn't
529 fully initialized yet. */
530 menubar = Fsymbol_value(Qcurrent_menubar);
534 menubar = Vblank_menubar;
537 menubar_visible = !NILP(w->menubar_visible_p);
539 data = compute_menubar_data(f, menubar, deep_p);
540 if (!data || (!data->next && !data->contents))
543 if (NILP(FRAME_MENUBAR_DATA(f))) {
544 struct popup_data *mdata =
545 alloc_lcrecord_type(struct popup_data, &lrecord_popup_data);
547 mdata->id = new_lwlib_id();
548 mdata->last_menubar_buffer = Qnil;
549 mdata->menubar_contents_up_to_date = 0;
550 XSETPOPUP_DATA(FRAME_MENUBAR_DATA(f), mdata);
553 /***** now store into the menubar widget, creating it if necessary *****/
555 id = XFRAME_MENUBAR_DATA(f)->id;
556 if (!FRAME_X_MENUBAR_WIDGET(f)) {
557 Widget parent = FRAME_X_CONTAINER_WIDGET(f);
559 assert(first_time_p);
561 /* It's the first time we've mapped the menubar so compute its
562 contents completely once. This makes sure that the menubar
563 components are created with the right type. */
565 free_popup_widget_value_tree(data);
566 data = compute_menubar_data(f, menubar, 1);
569 FRAME_X_MENUBAR_WIDGET(f) =
570 lw_create_widget("menubar", "menubar", id, data, parent,
571 0, pre_activate_callback,
572 popup_selection_callback, 0);
575 lw_modify_all_widgets(id, data, deep_p ? True : False);
577 free_popup_widget_value_tree(data);
579 XFRAME_MENUBAR_DATA(f)->menubar_contents_up_to_date = deep_p;
580 XFRAME_MENUBAR_DATA(f)->last_menubar_buffer =
581 XWINDOW(FRAME_LAST_NONMINIBUF_WINDOW(f))->buffer;
582 return menubar_visible;
585 /* Called from x_create_widgets() to create the initial menubar of a frame
586 before it is mapped, so that the window is mapped with the menubar already
587 there instead of us tacking it on later and thrashing the window after it
589 int x_initialize_frame_menubar(struct frame *f)
591 return set_frame_menubar(f, 1, 1);
594 static LWLIB_ID last_popup_menu_selection_callback_id;
597 popup_menu_selection_callback(Widget widget, LWLIB_ID id, XtPointer client_data)
599 last_popup_menu_selection_callback_id = id;
600 popup_selection_callback(widget, id, client_data);
601 /* lw_destroy_all_widgets() will be called from popup_down_callback() */
605 popup_menu_down_callback(Widget widget, LWLIB_ID id, XtPointer client_data)
607 if (popup_handled_p(id))
609 assert(popup_up_p != 0);
610 ungcpro_popup_callbacks(id);
612 /* if this isn't called immediately after the selection callback, then
613 there wasn't a menu selection. */
614 if (id != last_popup_menu_selection_callback_id)
615 popup_selection_callback(widget, id, (XtPointer) - 1);
616 lw_destroy_all_widgets(id);
620 make_dummy_xbutton_event(XEvent * dummy, Widget daddy, Lisp_Event * eev)
621 /* NULL for eev means query pointer */
623 XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
625 btn->type = ButtonPress;
628 btn->display = XtDisplay(daddy);
629 btn->window = XtWindow(daddy);
631 Position shellx, shelly, framex, framey;
633 btn->time = eev->timestamp;
634 btn->button = eev->event.button.button;
635 btn->root = RootWindowOfScreen(XtScreen(daddy));
636 btn->subwindow = (Window) NULL;
637 btn->x = eev->event.button.x;
638 btn->y = eev->event.button.y;
640 #ifndef HAVE_WMCOMMAND
642 Widget shell = XtParent(daddy);
644 XtSetArg(al[0], XtNx, &shellx);
645 XtSetArg(al[1], XtNy, &shelly);
646 XtGetValues(shell, al, 2);
649 XtSetArg(al[0], XtNx, &framex);
650 XtSetArg(al[1], XtNy, &framey);
651 XtGetValues(daddy, al, 2);
652 btn->x_root = shellx + framex + btn->x;
653 btn->y_root = shelly + framey + btn->y;
654 btn->state = ButtonPressMask; /* all buttons pressed */
656 /* CurrentTime is just ZERO, so it's worthless for
657 determining relative click times. */
658 struct device *d = get_device_from_display(XtDisplay(daddy));
659 btn->time = DEVICE_X_MOUSE_TIMESTAMP(d); /* event-Xt maintains this */
661 XQueryPointer(btn->display, btn->window, &btn->root,
662 &btn->subwindow, &btn->x_root, &btn->y_root,
663 &btn->x, &btn->y, &btn->state);
667 static void x_update_frame_menubar_internal(struct frame *f)
669 /* We assume the menubar contents has changed if the global flag is set,
670 or if the current buffer has changed, or if the menubar has never
673 int menubar_contents_changed =
674 (f->menubar_changed || NILP(FRAME_MENUBAR_DATA(f))
675 || (!EQ(XFRAME_MENUBAR_DATA(f)->last_menubar_buffer,
676 XWINDOW(FRAME_LAST_NONMINIBUF_WINDOW(f))->buffer)));
678 Boolean menubar_was_visible = XtIsManaged(FRAME_X_MENUBAR_WIDGET(f));
679 Boolean menubar_will_be_visible = menubar_was_visible;
680 Boolean menubar_visibility_changed;
682 if (menubar_contents_changed)
683 menubar_will_be_visible = set_frame_menubar(f, 0, 0);
685 menubar_visibility_changed =
686 menubar_was_visible != menubar_will_be_visible;
688 if (!menubar_visibility_changed)
691 /* Set menubar visibility */
692 (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
693 (FRAME_X_MENUBAR_WIDGET(f));
695 MARK_FRAME_SIZE_SLIPPED(f);
698 static void x_update_frame_menubars(struct frame *f)
700 assert(FRAME_X_P(f));
702 x_update_frame_menubar_internal(f);
704 /* #### This isn't going to work right now that this function works on
705 a per-frame, not per-device basis. Guess what? I don't care. */
708 static void x_free_frame_menubars(struct frame *f)
710 Widget menubar_widget;
712 assert(FRAME_X_P(f));
714 menubar_widget = FRAME_X_MENUBAR_WIDGET(f);
715 if (menubar_widget) {
716 LWLIB_ID id = XFRAME_MENUBAR_DATA(f)->id;
717 lw_destroy_all_widgets(id);
718 XFRAME_MENUBAR_DATA(f)->id = 0;
722 static void x_popup_menu(Lisp_Object menu_desc, Lisp_Object event)
725 struct frame *f = selected_frame();
729 Lisp_Event *eev = NULL;
734 CHECK_X_FRAME(frame);
735 parent = FRAME_X_SHELL_WIDGET(f);
738 CHECK_LIVE_EVENT(event);
740 if (eev->event_type != button_press_event
741 && eev->event_type != button_release_event)
742 wrong_type_argument(Qmouse_event_p, event);
743 } else if (!NILP(Vthis_command_keys)) {
744 /* if an event wasn't passed, use the last event of the event sequence
745 currently being executed, if that event is a mouse event */
746 eev = XEVENT(Vthis_command_keys); /* last event first */
747 if (eev->event_type != button_press_event
748 && eev->event_type != button_release_event)
751 make_dummy_xbutton_event(&xev, parent, eev);
753 if (SYMBOLP(menu_desc))
754 menu_desc = Fsymbol_value(menu_desc);
755 CHECK_CONS(menu_desc);
756 CHECK_STRING(XCAR(menu_desc));
758 menu_item_descriptor_to_widget_value(menu_desc, POPUP_TYPE, 1, 1);
763 menu_id = new_lwlib_id();
765 lw_create_widget("popup", "popup" /* data->name */ , menu_id, data,
766 parent, 1, 0, popup_menu_selection_callback,
767 popup_menu_down_callback);
768 free_popup_widget_value_tree(data);
770 gcpro_popup_callbacks(menu_id);
772 /* Setting zmacs-region-stays is necessary here because executing a command
773 from a menu is really a two-command process: the first command (bound to
774 the button-click) simply pops up the menu, and returns. This causes a
775 sequence of magic-events (destined for the popup-menu widget) to begin.
776 Eventually, a menu item is selected, and a menu-event blip is pushed onto
777 the end of the input stream, which is then executed by the event loop.
779 So there are two command-events, with a bunch of magic-events between
780 them. We don't want the *first* command event to alter the state of the
781 region, so that the region can be available as an argument for the second
785 zmacs_region_stays = 1;
788 lw_popup_menu(menu, &xev);
789 /* this speeds up display of pop-up menus */
790 XFlush(XtDisplay(parent));
793 #if defined(LWLIB_MENUBARS_LUCID)
794 static void menu_move_up(void)
796 widget_value *current = lw_get_entries(False);
797 widget_value *entries = lw_get_entries(True);
798 widget_value *prev = NULL;
800 while (entries != current) {
801 if (entries->name /*&& entries->enabled */ )
803 entries = entries->next;
808 /* move to last item */
810 while (entries->next) {
811 if (entries->name /*&& entries->enabled */ )
813 entries = entries->next;
816 if (entries->name /*&& entries->enabled */ )
819 /* no selectable items in this menu, pop up to previous level */
827 static void menu_move_down(void)
829 widget_value *current = lw_get_entries(False);
830 widget_value *new = current;
834 if (new->name /*&& new->enabled */ )
838 if (new == current || !(new->name /*||new->enabled */ )) {
839 new = lw_get_entries(True);
840 while (new != current) {
841 if (new->name /*&& new->enabled */ )
845 if (new == current && !(new->name /*|| new->enabled */ )) {
854 static void menu_move_left(void)
856 int level = lw_menu_level();
858 widget_value *current;
864 current = lw_get_entries(False);
865 if (l > 2 && current->contents)
866 lw_push_menu(current->contents);
869 static void menu_move_right(void)
871 int level = lw_menu_level();
873 widget_value *current;
879 current = lw_get_entries(False);
880 if (l > 2 && current->contents)
881 lw_push_menu(current->contents);
884 static void menu_select_item(widget_value * val)
887 val = lw_get_entries(False);
889 /* is match a submenu? */
892 /* enter the submenu */
895 lw_push_menu(val->contents);
897 /* Execute the menu entry by calling the menu's `select'
905 command_builder_operate_menu_accelerator(struct command_builder *builder)
907 /* this function can GC */
909 struct console *con = XCONSOLE(Vselected_console);
910 Lisp_Object evee = builder->most_current_event;
912 widget_value *entries;
914 extern int lw_menu_accelerate; /* lwlib.c */
922 t = builder->current_events;
926 sprintf(buf, "OPERATE (%d): ", i);
927 write_c_string(buf, Qexternal_debugging_output);
928 print_internal(t, Qexternal_debugging_output, 1);
929 write_c_string("\n", Qexternal_debugging_output);
935 /* menu accelerator keys don't go into keyboard macros */
936 if (!NILP(con->defining_kbd_macro) && NILP(Vexecuting_macro))
937 con->kbd_macro_ptr = con->kbd_macro_end;
939 /* don't echo menu accelerator keys */
940 /*reset_key_echo (builder, 1); */
942 if (!lw_menu_accelerate) {
943 /* `convert' mouse display to keyboard display
944 by entering the open submenu
946 entries = lw_get_entries(False);
947 if (entries->contents) {
948 lw_push_menu(entries->contents);
949 lw_display_menu(CurrentTime);
953 /* compare event to the current menu accelerators */
955 entries = lw_get_entries(True);
959 VOID_TO_LISP(accel, entries->accel);
960 if (entries->name && !NILP(accel)) {
961 if (event_matches_key_specifier_p(XEVENT(evee), accel)) {
964 menu_select_item(entries);
967 lw_display_menu(CurrentTime);
969 reset_this_command_keys(Vselected_console, 1);
970 /*reset_command_builder_event_chain (builder); */
971 return Vmenu_accelerator_map;
974 entries = entries->next;
977 /* try to look up event in menu-accelerator-map */
979 binding = event_binding_in(evee, Vmenu_accelerator_map, 1);
982 /* beep at user for undefined key */
985 if (EQ(binding, Qmenu_quit)) {
986 /* turn off menus and set quit flag */
989 } else if (EQ(binding, Qmenu_up)) {
990 int level = lw_menu_level();
993 } else if (EQ(binding, Qmenu_down)) {
994 int level = lw_menu_level();
998 menu_select_item(NULL);
999 } else if (EQ(binding, Qmenu_left)) {
1000 int level = lw_menu_level();
1003 lw_display_menu(CurrentTime);
1006 } else if (EQ(binding, Qmenu_right)) {
1007 int level = lw_menu_level();
1008 if (level > 2 && lw_get_entries(False)->contents) {
1009 widget_value *current = lw_get_entries(False);
1010 if (current->contents)
1011 menu_select_item(NULL);
1014 } else if (EQ(binding, Qmenu_select))
1015 menu_select_item(NULL);
1016 else if (EQ(binding, Qmenu_escape)) {
1017 int level = lw_menu_level();
1021 lw_display_menu(CurrentTime);
1023 /* turn off menus quietly */
1024 lw_kill_menus(NULL);
1026 } else if (KEYMAPP(binding)) {
1028 reset_this_command_keys(Vselected_console, 1);
1029 /*reset_command_builder_event_chain (builder); */
1032 /* turn off menus and execute binding */
1033 lw_kill_menus(NULL);
1034 reset_this_command_keys(Vselected_console, 1);
1035 /*reset_command_builder_event_chain (builder); */
1041 lw_display_menu(CurrentTime);
1043 reset_this_command_keys(Vselected_console, 1);
1044 /*reset_command_builder_event_chain (builder); */
1046 return Vmenu_accelerator_map;
1050 menu_accelerator_junk_on_error(Lisp_Object errordata, Lisp_Object ignored)
1052 Vmenu_accelerator_prefix = Qnil;
1053 Vmenu_accelerator_modifiers = Qnil;
1054 Vmenu_accelerator_enabled = Qnil;
1055 if (!NILP(errordata)) {
1056 Lisp_Object args[2];
1059 build_string("Error in menu accelerators (setting to nil)");
1060 /* #### This should call
1061 (with-output-to-string (display-error errordata))
1062 but that stuff is all in Lisp currently. */
1063 args[1] = errordata;
1064 warn_when_safe_lispobj
1066 emacs_doprnt_string_lisp((const Bufbyte *)"%s: %s",
1067 Qnil, -1, 2, args));
1073 static Lisp_Object menu_accelerator_safe_compare(Lisp_Object event0)
1075 if (CONSP(Vmenu_accelerator_prefix)) {
1077 t = Vmenu_accelerator_prefix;
1080 && event_matches_key_specifier_p(XEVENT(event0),
1083 event0 = XEVENT_NEXT(event0);
1087 } else if (NILP(event0))
1089 else if (event_matches_key_specifier_p
1090 (XEVENT(event0), Vmenu_accelerator_prefix))
1091 event0 = XEVENT_NEXT(event0);
1097 static Lisp_Object menu_accelerator_safe_mod_compare(Lisp_Object cons)
1099 return (event_matches_key_specifier_p(XEVENT(XCAR(cons)), XCDR(cons))
1104 command_builder_find_menu_accelerator(struct command_builder * builder)
1106 /* this function can GC */
1107 Lisp_Object event0 = builder->current_events;
1108 struct console *con = XCONSOLE(Vselected_console);
1109 struct frame *f = XFRAME(CONSOLE_SELECTED_FRAME(con));
1110 Widget menubar_widget;
1112 /* compare entries in event0 against the menu prefix */
1114 if ((!CONSOLE_X_P(XCONSOLE(builder->console))) || NILP(event0) ||
1115 XEVENT(event0)->event_type != key_press_event)
1118 if (!NILP(Vmenu_accelerator_prefix)) {
1119 event0 = condition_case_1(Qerror,
1120 menu_accelerator_safe_compare,
1122 menu_accelerator_junk_on_error, Qnil);
1128 menubar_widget = FRAME_X_MENUBAR_WIDGET(f);
1129 if (menubar_widget && CONSP(Vmenu_accelerator_modifiers)) {
1130 Lisp_Object fake = Qnil;
1131 Lisp_Object last = Qnil;
1132 struct gcpro gcpro1;
1136 LWLIB_ID id = XPOPUP_DATA(f->menubar_data)->id;
1138 val = lw_get_all_values(id);
1140 val = val->contents;
1142 fake = Fcopy_sequence(Vmenu_accelerator_modifiers);
1145 while (!NILP(Fcdr(last)))
1148 Fsetcdr(last, Fcons(Qnil, Qnil));
1152 fake = Fcons(Qnil, fake);
1158 VOID_TO_LISP(accel, val->accel);
1159 if (val->name && !NILP(accel)) {
1160 Fsetcar(last, accel);
1161 Fsetcar(fake, event0);
1162 matchp = condition_case_1(Qerror,
1163 menu_accelerator_safe_mod_compare,
1165 menu_accelerator_junk_on_error,
1167 if (!NILP(matchp)) {
1170 lw_set_menu(menubar_widget, val);
1171 /* yah - yet another hack.
1172 pretend emacs timestamp is the same as an X timestamp,
1173 which for the moment it is. (read events.h)
1175 lw_map_menu(XEVENT(event0)->timestamp);
1178 lw_push_menu(val->contents);
1180 lw_display_menu(CurrentTime);
1182 /* menu accelerator keys don't go into keyboard macros */
1183 if (!NILP(con->defining_kbd_macro)
1184 && NILP(Vexecuting_macro))
1185 con->kbd_macro_ptr =
1188 /* don't echo menu accelerator keys */
1189 /*reset_key_echo (builder, 1); */
1190 reset_this_command_keys
1191 (Vselected_console, 1);
1194 return Vmenu_accelerator_map;
1206 int x_kludge_lw_menu_active(void)
1208 return lw_menu_active;
1211 DEFUN("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
1212 Make the menubar active. Menu items can be selected using menu accelerators
1213 or by actions defined in menu-accelerator-map.
1217 struct console *con = XCONSOLE(Vselected_console);
1218 struct frame *f = XFRAME(CONSOLE_SELECTED_FRAME(con));
1222 if (NILP(f->menubar_data))
1223 error("Frame has no menubar.");
1225 id = XPOPUP_DATA(f->menubar_data)->id;
1226 val = lw_get_all_values(id);
1227 val = val->contents;
1228 lw_set_menu(FRAME_X_MENUBAR_WIDGET(f), val);
1229 lw_map_menu(CurrentTime);
1231 lw_display_menu(CurrentTime);
1233 /* menu accelerator keys don't go into keyboard macros */
1234 if (!NILP(con->defining_kbd_macro) && NILP(Vexecuting_macro))
1235 con->kbd_macro_ptr = con->kbd_macro_end;
1239 #endif /* LWLIB_MENUBARS_LUCID */
1241 void syms_of_menubar_x(void)
1243 #if defined(LWLIB_MENUBARS_LUCID)
1244 DEFSUBR(Faccelerate_menu);
1248 void console_type_create_menubar_x(void)
1250 CONSOLE_HAS_METHOD(x, update_frame_menubars);
1251 CONSOLE_HAS_METHOD(x, free_frame_menubars);
1252 CONSOLE_HAS_METHOD(x, popup_menu);
1255 void reinit_vars_of_menubar_x(void)
1257 last_popup_menu_selection_callback_id = (LWLIB_ID) - 1;
1260 void vars_of_menubar_x(void)
1262 reinit_vars_of_menubar_x();
1264 #if defined (LWLIB_MENUBARS_LUCID)
1265 Fprovide(intern("lucid-menubars"));
1266 #elif defined (LWLIB_MENUBARS_MOTIF)
1267 Fprovide(intern("motif-menubars"));