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.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
26 Created 16-dec-91 by Jamie Zawinski.
27 Menu filters and many other keywords added by Stig for 19.12.
28 Original device-abstraction work and GC cleanup work by Ben Wing for 19.13.
29 Menu accelerators c. 1997? by ??. Moved here from event-stream.c.
30 Other work post-1996 by ??.
36 #include "console-x.h"
37 #include "EmacsFrame.h"
39 #include "../lwlib/lwlib.h"
42 #include "commands.h" /* zmacs_regions */
51 static int set_frame_menubar (struct frame *f,
55 #define FRAME_MENUBAR_DATA(frame) ((frame)->menubar_data)
56 #define XFRAME_MENUBAR_DATA(frame) XPOPUP_DATA ((frame)->menubar_data)
58 #define MENUBAR_TYPE 0
59 #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
97 menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
98 int menu_type, int deep_p,
102 /* This function cannot GC.
103 It is only called from menu_item_descriptor_to_widget_value, which
105 /* !!#### This function has not been Mule-ized */
106 int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0);
107 int count = specpdl_depth ();
108 int partition_seen = 0;
109 widget_value *wv = xmalloc_widget_value ();
110 Lisp_Object wv_closure = make_opaque_ptr (wv);
112 record_unwind_protect (widget_value_unwind, wv_closure);
116 char *string_chars = (char *) XSTRING_DATA (desc);
117 wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE :
120 /* #### - should internationalize with X resources instead.
122 string_chars = GETTEXT (string_chars);
124 if (wv->type == SEPARATOR_TYPE)
126 wv->value = menu_separator_style (string_chars);
130 wv->name = xstrdup (string_chars);
132 /* dverna Dec. 98: command_builder_operate_menu_accelerator will
133 manipulate the accel as a Lisp_Object if the widget has a name.
134 Since simple labels have a name, but no accel, we *must* set it
136 wv->accel = LISP_TO_VOID (Qnil);
139 else if (VECTORP (desc))
141 Lisp_Object gui_item = gui_parse_item_keywords (desc);
142 if (!button_item_to_widget_value (gui_item, wv, 1,
143 (menu_type == MENUBAR_TYPE
146 /* :included form was nil */
151 else if (CONSP (desc))
153 Lisp_Object incremental_data = desc;
154 widget_value *prev = 0;
156 if (STRINGP (XCAR (desc)))
158 Lisp_Object key, val;
159 Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil;
160 Lisp_Object active_p = Qt;
162 int included_spec = 0;
164 wv->type = CASCADE_TYPE;
166 wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc)));
167 wv->name = strdup_and_add_accel (wv->name);
169 accel = gui_name_accelerator (LISP_GETTEXT (XCAR (desc)));
170 wv->accel = LISP_TO_VOID (accel);
174 while (key = Fcar (desc), KEYWORDP (key))
176 Lisp_Object cascade = desc;
179 signal_simple_error ("Keyword in menu lacks a value",
183 if (EQ (key, Q_included))
184 include_p = val, included_spec = 1;
185 else if (EQ (key, Q_config))
187 else if (EQ (key, Q_filter))
189 else if (EQ (key, Q_active))
190 active_p = val, active_spec = 1;
191 else if (EQ (key, Q_accelerator))
195 wv->accel = LISP_TO_VOID (val);
197 signal_simple_error ("bad keyboard accelerator", val);
199 else if (EQ (key, Q_label))
201 /* implement in 21.2 */
204 signal_simple_error ("Unknown menu cascade keyword", cascade);
207 if ((!NILP (config_tag)
208 && NILP (Fmemq (config_tag, Vmenubar_configuration)))
209 || (included_spec && NILP (Feval (include_p))))
216 active_p = Feval (active_p);
218 if (!NILP (hook_fn) && !NILP (active_p))
220 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
221 if (filter_p || depth == 0)
224 desc = call1_trapping_errors ("Error in menubar filter",
228 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
232 widget_value *incr_wv = xmalloc_widget_value ();
233 wv->contents = incr_wv;
234 incr_wv->type = INCREMENTAL_TYPE;
235 incr_wv->enabled = 1;
236 incr_wv->name = wv->name;
237 incr_wv->name = xstrdup (wv->name);
238 /* This is automatically GC protected through
239 the call to lw_map_widget_values(); no need
241 incr_wv->call_data = LISP_TO_VOID (incremental_data);
244 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
246 if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0)
248 /* Simply prepend three more widget values to the contents of
249 the menu: a label, and two separators (to get a double
251 widget_value *title_wv = xmalloc_widget_value ();
252 widget_value *sep_wv = xmalloc_widget_value ();
253 title_wv->type = TEXT_TYPE;
254 title_wv->name = xstrdup (wv->name);
255 title_wv->enabled = 1;
256 title_wv->next = sep_wv;
257 sep_wv->type = SEPARATOR_TYPE;
258 sep_wv->value = menu_separator_style ("==");
261 wv->contents = title_wv;
264 wv->enabled = ! NILP (active_p);
265 if (deep_p && !wv->enabled && !NILP (desc))
268 /* Add a fake entry so the menus show up */
269 wv->contents = dummy = xmalloc_widget_value ();
270 dummy->name = xstrdup ("(inactive)");
271 dummy->accel = LISP_TO_VOID (Qnil);
275 dummy->type = BUTTON_TYPE;
276 dummy->call_data = NULL;
283 else if (menubar_root_p)
285 wv->name = xstrdup ("menubar");
286 wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
287 this is ignored anyway... */
291 signal_simple_error ("Menu name (first element) must be a string",
295 if (deep_p || menubar_root_p)
298 for (; !NILP (desc); desc = Fcdr (desc))
300 Lisp_Object child = Fcar (desc);
301 if (menubar_root_p && NILP (child)) /* the partition */
305 "More than one partition (nil) in menubar description");
307 next = xmalloc_widget_value ();
308 next->type = PUSHRIGHT_TYPE;
312 next = menu_item_descriptor_to_widget_value_1
313 (child, menu_type, deep_p, filter_p, depth + 1);
324 if (deep_p && !wv->contents)
327 else if (NILP (desc))
328 error ("nil may not appear in menu descriptions");
330 signal_simple_error ("Unrecognized menu descriptor", desc);
336 /* Completed normally. Clear out the object that widget_value_unwind()
337 will be called with to tell it not to free the wv (as we are
339 set_opaque_ptr (wv_closure, 0);
342 unbind_to (count, Qnil);
346 static widget_value *
347 menu_item_descriptor_to_widget_value (Lisp_Object desc,
348 int menu_type, /* if this is a menubar,
351 int filter_p) /* if :filter forms
355 int count = specpdl_depth ();
356 record_unwind_protect (restore_gc_inhibit,
357 make_int (gc_currently_forbidden));
358 gc_currently_forbidden = 1;
360 wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p,
362 unbind_to (count, Qnil);
367 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
368 int in_menu_callback;
371 restore_in_menu_callback (Lisp_Object val)
373 in_menu_callback = XINT (val);
376 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
379 /* #### Sort of a hack needed to process Vactivate_menubar_hook
380 correctly wrt buffer-local values. A correct solution would
381 involve adding a callback mechanism to run_hook(). This function
382 is currently unused. */
384 my_run_hook (Lisp_Object hooksym, int allow_global_p)
386 /* This function can GC */
388 Lisp_Object value = Fsymbol_value (hooksym);
391 if (!NILP (value) && (!CONSP (value) || EQ (XCAR (value), Qlambda)))
392 return !EQ (call0 (value), Qt);
394 EXTERNAL_LIST_LOOP (tail, value)
396 if (allow_global_p && EQ (XCAR (tail), Qt))
397 changes |= my_run_hook (Fdefault_value (hooksym), 0);
398 if (!EQ (call0 (XCAR (tail)), Qt))
406 /* The order in which callbacks are run is funny to say the least.
407 It's sometimes tricky to avoid running a callback twice, and to
408 avoid returning prematurely. So, this function returns true
409 if the menu's callbacks are no longer gc protected. So long
410 as we unprotect them before allowing other callbacks to run,
411 everything should be ok.
413 The pre_activate_callback() *IS* intentionally called multiple times.
414 If client_data == NULL, then it's being called before the menu is posted.
415 If client_data != NULL, then client_data is a (widget_value *) and
416 client_data->data is a Lisp_Object pointing to a lisp submenu description
417 that must be converted into widget_values. *client_data is destructively
420 #### Stig thinks that there may be a GC problem here due to the
421 fact that pre_activate_callback() is called multiple times, but I
427 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
429 /* This function can GC */
430 struct device *d = get_device_from_display (XtDisplay (widget));
431 struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
435 /* set in lwlib to the time stamp associated with the most recent menu
437 extern Time x_focus_timestamp_really_sucks_fix_me_better;
440 f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
444 /* make sure f is the selected frame */
445 XSETFRAME (frame, f);
446 Fselect_frame (frame);
450 /* this is an incremental menu construction callback */
451 widget_value *hack_wv = (widget_value *) client_data;
452 Lisp_Object submenu_desc;
455 assert (hack_wv->type == INCREMENTAL_TYPE);
456 VOID_TO_LISP (submenu_desc, hack_wv->call_data);
459 * #### Fix the menu code so this isn't necessary.
461 * Protect against reentering the menu code otherwise we will
462 * crash later when the code gets confused at the state
465 count = specpdl_depth ();
466 record_unwind_protect (restore_in_menu_callback,
467 make_int (in_menu_callback));
468 in_menu_callback = 1;
469 wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE,
471 unbind_to (count, Qnil);
475 wv = xmalloc_widget_value ();
476 wv->type = CASCADE_TYPE;
478 wv->accel = LISP_TO_VOID (Qnil);
479 wv->contents = xmalloc_widget_value ();
480 wv->contents->type = TEXT_TYPE;
481 wv->contents->name = xstrdup ("No menu");
482 wv->contents->next = NULL;
483 wv->contents->accel = LISP_TO_VOID (Qnil);
485 assert (wv && wv->type == CASCADE_TYPE && wv->contents);
486 replace_widget_value_tree (hack_wv, wv->contents);
487 free_popup_widget_value_tree (wv);
489 else if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f)))
493 #if 0 /* Unused, see comment below. */
496 /* #### - this menubar update mechanism is expensively anti-social and
497 the activate-menubar-hook is now mostly obsolete. */
498 any_changes = my_run_hook (Qactivate_menubar_hook, 1);
500 /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
501 incremental menus are implemented. If a subtree of a menu has been
502 updated incrementally (a destructive operation), then that subtree
503 must somehow be wiped.
505 It is difficult to undo the destructive operation in lwlib because
506 a pointer back to lisp data needs to be hidden away somewhere. So
507 that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */
509 !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date)
510 set_frame_menubar (f, 1, 0);
512 run_hook (Qactivate_menubar_hook);
513 set_frame_menubar (f, 1, 0);
515 DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
516 DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
517 x_focus_timestamp_really_sucks_fix_me_better;
521 static widget_value *
522 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
529 int count = specpdl_depth ();
531 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
532 Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
533 data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
535 unbind_to (count, Qnil);
542 set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
548 /* As with the toolbar, the minibuffer does not have its own menubar. */
549 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
554 /***** first compute the contents of the menubar *****/
558 /* evaluate `current-menubar' in the buffer of the selected window
559 of the frame in question. */
560 menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
564 /* That's a little tricky the first time since the frame isn't
565 fully initialized yet. */
566 menubar = Fsymbol_value (Qcurrent_menubar);
571 menubar = Vblank_menubar;
575 menubar_visible = !NILP (w->menubar_visible_p);
577 data = compute_menubar_data (f, menubar, deep_p);
578 if (!data || (!data->next && !data->contents))
581 if (NILP (FRAME_MENUBAR_DATA (f)))
583 struct popup_data *mdata =
584 alloc_lcrecord_type (struct popup_data, &lrecord_popup_data);
586 mdata->id = new_lwlib_id ();
587 mdata->last_menubar_buffer = Qnil;
588 mdata->menubar_contents_up_to_date = 0;
589 XSETPOPUP_DATA (FRAME_MENUBAR_DATA (f), mdata);
592 /***** now store into the menubar widget, creating it if necessary *****/
594 id = XFRAME_MENUBAR_DATA (f)->id;
595 if (!FRAME_X_MENUBAR_WIDGET (f))
597 Widget parent = FRAME_X_CONTAINER_WIDGET (f);
599 assert (first_time_p);
601 /* It's the first time we've mapped the menubar so compute its
602 contents completely once. This makes sure that the menubar
603 components are created with the right type. */
606 free_popup_widget_value_tree (data);
607 data = compute_menubar_data (f, menubar, 1);
611 FRAME_X_MENUBAR_WIDGET (f) =
612 lw_create_widget ("menubar", "menubar", id, data, parent,
613 0, pre_activate_callback,
614 popup_selection_callback, 0);
619 lw_modify_all_widgets (id, data, deep_p ? True : False);
621 free_popup_widget_value_tree (data);
623 XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p;
624 XFRAME_MENUBAR_DATA (f)->last_menubar_buffer =
625 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
626 return menubar_visible;
630 /* Called from x_create_widgets() to create the initial menubar of a frame
631 before it is mapped, so that the window is mapped with the menubar already
632 there instead of us tacking it on later and thrashing the window after it
635 x_initialize_frame_menubar (struct frame *f)
637 return set_frame_menubar (f, 1, 1);
641 static LWLIB_ID last_popup_menu_selection_callback_id;
644 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
645 XtPointer client_data)
647 last_popup_menu_selection_callback_id = id;
648 popup_selection_callback (widget, id, client_data);
649 /* lw_destroy_all_widgets() will be called from popup_down_callback() */
653 popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
655 if (popup_handled_p (id))
657 assert (popup_up_p != 0);
658 ungcpro_popup_callbacks (id);
660 /* if this isn't called immediately after the selection callback, then
661 there wasn't a menu selection. */
662 if (id != last_popup_menu_selection_callback_id)
663 popup_selection_callback (widget, id, (XtPointer) -1);
664 lw_destroy_all_widgets (id);
669 make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev)
670 /* NULL for eev means query pointer */
672 XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
674 btn->type = ButtonPress;
677 btn->display = XtDisplay (daddy);
678 btn->window = XtWindow (daddy);
681 Position shellx, shelly, framex, framey;
683 btn->time = eev->timestamp;
684 btn->button = eev->event.button.button;
685 btn->root = RootWindowOfScreen (XtScreen (daddy));
686 btn->subwindow = (Window) NULL;
687 btn->x = eev->event.button.x;
688 btn->y = eev->event.button.y;
690 #ifndef HAVE_WMCOMMAND
692 Widget shell = XtParent (daddy);
694 XtSetArg (al [0], XtNx, &shellx);
695 XtSetArg (al [1], XtNy, &shelly);
696 XtGetValues (shell, al, 2);
699 XtSetArg (al [0], XtNx, &framex);
700 XtSetArg (al [1], XtNy, &framey);
701 XtGetValues (daddy, al, 2);
702 btn->x_root = shellx + framex + btn->x;
703 btn->y_root = shelly + framey + btn->y;
704 btn->state = ButtonPressMask; /* all buttons pressed */
708 /* CurrentTime is just ZERO, so it's worthless for
709 determining relative click times. */
710 struct device *d = get_device_from_display (XtDisplay (daddy));
711 btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
713 XQueryPointer (btn->display, btn->window, &btn->root,
714 &btn->subwindow, &btn->x_root, &btn->y_root,
715 &btn->x, &btn->y, &btn->state);
722 x_update_frame_menubar_internal (struct frame *f)
724 /* We assume the menubar contents has changed if the global flag is set,
725 or if the current buffer has changed, or if the menubar has never
728 int menubar_contents_changed =
730 || NILP (FRAME_MENUBAR_DATA (f))
731 || (!EQ (XFRAME_MENUBAR_DATA (f)->last_menubar_buffer,
732 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
734 Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
735 Boolean menubar_will_be_visible = menubar_was_visible;
736 Boolean menubar_visibility_changed;
738 if (menubar_contents_changed)
739 menubar_will_be_visible = set_frame_menubar (f, 0, 0);
741 menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
743 if (!menubar_visibility_changed)
746 /* Set menubar visibility */
747 (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
748 (FRAME_X_MENUBAR_WIDGET (f));
750 MARK_FRAME_SIZE_SLIPPED (f);
754 x_update_frame_menubars (struct frame *f)
756 assert (FRAME_X_P (f));
758 x_update_frame_menubar_internal (f);
760 /* #### This isn't going to work right now that this function works on
761 a per-frame, not per-device basis. Guess what? I don't care. */
765 x_free_frame_menubars (struct frame *f)
767 Widget menubar_widget;
769 assert (FRAME_X_P (f));
771 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
774 LWLIB_ID id = XFRAME_MENUBAR_DATA (f)->id;
775 lw_destroy_all_widgets (id);
776 XFRAME_MENUBAR_DATA (f)->id = 0;
781 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
784 struct frame *f = selected_frame ();
788 Lisp_Event *eev = NULL;
792 XSETFRAME (frame, f);
793 CHECK_X_FRAME (frame);
794 parent = FRAME_X_SHELL_WIDGET (f);
798 CHECK_LIVE_EVENT (event);
800 if (eev->event_type != button_press_event
801 && eev->event_type != button_release_event)
802 wrong_type_argument (Qmouse_event_p, event);
804 else if (!NILP (Vthis_command_keys))
806 /* if an event wasn't passed, use the last event of the event sequence
807 currently being executed, if that event is a mouse event */
808 eev = XEVENT (Vthis_command_keys); /* last event first */
809 if (eev->event_type != button_press_event
810 && eev->event_type != button_release_event)
813 make_dummy_xbutton_event (&xev, parent, eev);
815 if (SYMBOLP (menu_desc))
816 menu_desc = Fsymbol_value (menu_desc);
817 CHECK_CONS (menu_desc);
818 CHECK_STRING (XCAR (menu_desc));
819 data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
821 if (! data) error ("no menu");
823 menu_id = new_lwlib_id ();
824 menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
826 popup_menu_selection_callback,
827 popup_menu_down_callback);
828 free_popup_widget_value_tree (data);
830 gcpro_popup_callbacks (menu_id);
832 /* Setting zmacs-region-stays is necessary here because executing a command
833 from a menu is really a two-command process: the first command (bound to
834 the button-click) simply pops up the menu, and returns. This causes a
835 sequence of magic-events (destined for the popup-menu widget) to begin.
836 Eventually, a menu item is selected, and a menu-event blip is pushed onto
837 the end of the input stream, which is then executed by the event loop.
839 So there are two command-events, with a bunch of magic-events between
840 them. We don't want the *first* command event to alter the state of the
841 region, so that the region can be available as an argument for the second
845 zmacs_region_stays = 1;
848 lw_popup_menu (menu, &xev);
849 /* this speeds up display of pop-up menus */
850 XFlush (XtDisplay (parent));
855 #if defined(LWLIB_MENUBARS_LUCID)
859 widget_value *current = lw_get_entries (False);
860 widget_value *entries = lw_get_entries (True);
861 widget_value *prev = NULL;
863 while (entries != current)
865 if (entries->name /*&& entries->enabled*/) prev = entries;
866 entries = entries->next;
871 /* move to last item */
873 while (entries->next)
875 if (entries->name /*&& entries->enabled*/) prev = entries;
876 entries = entries->next;
880 if (entries->name /*&& entries->enabled*/)
885 /* no selectable items in this menu, pop up to previous level */
894 menu_move_down (void)
896 widget_value *current = lw_get_entries (False);
897 widget_value *new = current;
902 if (new->name /*&& new->enabled*/) break;
905 if (new==current||!(new->name/*||new->enabled*/))
907 new = lw_get_entries (True);
910 if (new->name /*&& new->enabled*/) break;
913 if (new==current&&!(new->name /*|| new->enabled*/))
924 menu_move_left (void)
926 int level = lw_menu_level ();
928 widget_value *current;
934 current = lw_get_entries (False);
935 if (l > 2 && current->contents)
936 lw_push_menu (current->contents);
940 menu_move_right (void)
942 int level = lw_menu_level ();
944 widget_value *current;
950 current = lw_get_entries (False);
951 if (l > 2 && current->contents)
952 lw_push_menu (current->contents);
956 menu_select_item (widget_value *val)
959 val = lw_get_entries (False);
961 /* is match a submenu? */
965 /* enter the submenu */
968 lw_push_menu (val->contents);
972 /* Execute the menu entry by calling the menu's `select'
980 command_builder_operate_menu_accelerator (struct command_builder *builder)
982 /* this function can GC */
984 struct console *con = XCONSOLE (Vselected_console);
985 Lisp_Object evee = builder->most_current_event;
987 widget_value *entries;
989 extern int lw_menu_accelerate; /* lwlib.c */
997 t = builder->current_events;
1002 sprintf (buf,"OPERATE (%d): ",i);
1003 write_c_string (buf, Qexternal_debugging_output);
1004 print_internal (t, Qexternal_debugging_output, 1);
1005 write_c_string ("\n", Qexternal_debugging_output);
1006 t = XEVENT_NEXT (t);
1011 /* menu accelerator keys don't go into keyboard macros */
1012 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
1013 con->kbd_macro_ptr = con->kbd_macro_end;
1015 /* don't echo menu accelerator keys */
1016 /*reset_key_echo (builder, 1);*/
1018 if (!lw_menu_accelerate)
1020 /* `convert' mouse display to keyboard display
1021 by entering the open submenu
1023 entries = lw_get_entries (False);
1024 if (entries->contents)
1026 lw_push_menu (entries->contents);
1027 lw_display_menu (CurrentTime);
1031 /* compare event to the current menu accelerators */
1033 entries=lw_get_entries (True);
1038 VOID_TO_LISP (accel, entries->accel);
1039 if (entries->name && !NILP (accel))
1041 if (event_matches_key_specifier_p (XEVENT (evee), accel))
1045 menu_select_item (entries);
1047 if (lw_menu_active) lw_display_menu (CurrentTime);
1049 reset_this_command_keys (Vselected_console, 1);
1050 /*reset_command_builder_event_chain (builder);*/
1051 return Vmenu_accelerator_map;
1054 entries = entries->next;
1057 /* try to look up event in menu-accelerator-map */
1059 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
1063 /* beep at user for undefined key */
1068 if (EQ (binding, Qmenu_quit))
1070 /* turn off menus and set quit flag */
1071 lw_kill_menus (NULL);
1074 else if (EQ (binding, Qmenu_up))
1076 int level = lw_menu_level ();
1080 else if (EQ (binding, Qmenu_down))
1082 int level = lw_menu_level ();
1086 menu_select_item (NULL);
1088 else if (EQ (binding, Qmenu_left))
1090 int level = lw_menu_level ();
1094 lw_display_menu (CurrentTime);
1099 else if (EQ (binding, Qmenu_right))
1101 int level = lw_menu_level ();
1103 lw_get_entries (False)->contents)
1105 widget_value *current = lw_get_entries (False);
1106 if (current->contents)
1107 menu_select_item (NULL);
1112 else if (EQ (binding, Qmenu_select))
1113 menu_select_item (NULL);
1114 else if (EQ (binding, Qmenu_escape))
1116 int level = lw_menu_level ();
1121 lw_display_menu (CurrentTime);
1125 /* turn off menus quietly */
1126 lw_kill_menus (NULL);
1129 else if (KEYMAPP (binding))
1132 reset_this_command_keys (Vselected_console, 1);
1133 /*reset_command_builder_event_chain (builder);*/
1138 /* turn off menus and execute binding */
1139 lw_kill_menus (NULL);
1140 reset_this_command_keys (Vselected_console, 1);
1141 /*reset_command_builder_event_chain (builder);*/
1146 if (lw_menu_active) lw_display_menu (CurrentTime);
1148 reset_this_command_keys (Vselected_console, 1);
1149 /*reset_command_builder_event_chain (builder);*/
1151 return Vmenu_accelerator_map;
1155 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
1157 Vmenu_accelerator_prefix = Qnil;
1158 Vmenu_accelerator_modifiers = Qnil;
1159 Vmenu_accelerator_enabled = Qnil;
1160 if (!NILP (errordata))
1162 Lisp_Object args[2];
1164 args[0] = build_string ("Error in menu accelerators (setting to nil)");
1165 /* #### This should call
1166 (with-output-to-string (display-error errordata))
1167 but that stuff is all in Lisp currently. */
1168 args[1] = errordata;
1169 warn_when_safe_lispobj
1171 emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s",
1172 Qnil, -1, 2, args));
1179 menu_accelerator_safe_compare (Lisp_Object event0)
1181 if (CONSP (Vmenu_accelerator_prefix))
1184 t=Vmenu_accelerator_prefix;
1187 && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
1190 event0 = XEVENT_NEXT (event0);
1195 else if (NILP (event0))
1197 else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
1198 event0 = XEVENT_NEXT (event0);
1205 menu_accelerator_safe_mod_compare (Lisp_Object cons)
1207 return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
1213 command_builder_find_menu_accelerator (struct command_builder *builder)
1215 /* this function can GC */
1216 Lisp_Object event0 = builder->current_events;
1217 struct console *con = XCONSOLE (Vselected_console);
1218 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
1219 Widget menubar_widget;
1221 /* compare entries in event0 against the menu prefix */
1223 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
1224 XEVENT (event0)->event_type != key_press_event)
1227 if (!NILP (Vmenu_accelerator_prefix))
1229 event0 = condition_case_1 (Qerror,
1230 menu_accelerator_safe_compare,
1232 menu_accelerator_junk_on_error,
1239 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
1241 && CONSP (Vmenu_accelerator_modifiers))
1244 Lisp_Object last = Qnil;
1245 struct gcpro gcpro1;
1249 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
1251 val = lw_get_all_values (id);
1254 val = val->contents;
1256 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
1259 while (!NILP (Fcdr (last)))
1262 Fsetcdr (last, Fcons (Qnil, Qnil));
1266 fake = Fcons (Qnil, fake);
1273 VOID_TO_LISP (accel, val->accel);
1274 if (val->name && !NILP (accel))
1276 Fsetcar (last, accel);
1277 Fsetcar (fake, event0);
1278 matchp = condition_case_1 (Qerror,
1279 menu_accelerator_safe_mod_compare,
1281 menu_accelerator_junk_on_error,
1287 lw_set_menu (menubar_widget, val);
1288 /* yah - yet another hack.
1289 pretend emacs timestamp is the same as an X timestamp,
1290 which for the moment it is. (read events.h)
1292 lw_map_menu (XEVENT (event0)->timestamp);
1295 lw_push_menu (val->contents);
1297 lw_display_menu (CurrentTime);
1299 /* menu accelerator keys don't go into keyboard macros */
1300 if (!NILP (con->defining_kbd_macro)
1301 && NILP (Vexecuting_macro))
1302 con->kbd_macro_ptr = con->kbd_macro_end;
1304 /* don't echo menu accelerator keys */
1305 /*reset_key_echo (builder, 1);*/
1306 reset_this_command_keys (Vselected_console, 1);
1309 return Vmenu_accelerator_map;
1322 x_kludge_lw_menu_active (void)
1324 return lw_menu_active;
1327 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
1328 Make the menubar active. Menu items can be selected using menu accelerators
1329 or by actions defined in menu-accelerator-map.
1333 struct console *con = XCONSOLE (Vselected_console);
1334 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
1338 if (NILP (f->menubar_data))
1339 error ("Frame has no menubar.");
1341 id = XPOPUP_DATA (f->menubar_data)->id;
1342 val = lw_get_all_values (id);
1343 val = val->contents;
1344 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
1345 lw_map_menu (CurrentTime);
1347 lw_display_menu (CurrentTime);
1349 /* menu accelerator keys don't go into keyboard macros */
1350 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
1351 con->kbd_macro_ptr = con->kbd_macro_end;
1355 #endif /* LWLIB_MENUBARS_LUCID */
1359 syms_of_menubar_x (void)
1361 #if defined(LWLIB_MENUBARS_LUCID)
1362 DEFSUBR (Faccelerate_menu);
1367 console_type_create_menubar_x (void)
1369 CONSOLE_HAS_METHOD (x, update_frame_menubars);
1370 CONSOLE_HAS_METHOD (x, free_frame_menubars);
1371 CONSOLE_HAS_METHOD (x, popup_menu);
1375 reinit_vars_of_menubar_x (void)
1377 last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
1381 vars_of_menubar_x (void)
1383 reinit_vars_of_menubar_x ();
1385 #if defined (LWLIB_MENUBARS_LUCID)
1386 Fprovide (intern ("lucid-menubars"));
1387 #elif defined (LWLIB_MENUBARS_MOTIF)
1388 Fprovide (intern ("motif-menubars"));
1389 #elif defined (LWLIB_MENUBARS_ATHENA)
1390 Fprovide (intern ("athena-menubars"));