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 (Qmenubar,
144 (menu_type == MENUBAR_TYPE
147 /* :included form was nil */
152 else if (CONSP (desc))
154 Lisp_Object incremental_data = desc;
155 widget_value *prev = 0;
157 if (STRINGP (XCAR (desc)))
159 Lisp_Object key, val;
160 Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil;
161 Lisp_Object active_p = Qt;
163 int included_spec = 0;
165 wv->type = CASCADE_TYPE;
167 wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc)));
168 wv->name = strdup_and_add_accel (wv->name);
170 accel = gui_name_accelerator (LISP_GETTEXT (XCAR (desc)));
171 wv->accel = LISP_TO_VOID (accel);
175 while (key = Fcar (desc), KEYWORDP (key))
177 Lisp_Object cascade = desc;
180 signal_simple_error ("Keyword in menu lacks a value",
184 if (EQ (key, Q_included))
185 include_p = val, included_spec = 1;
186 else if (EQ (key, Q_config))
188 else if (EQ (key, Q_filter))
190 else if (EQ (key, Q_active))
191 active_p = val, active_spec = 1;
192 else if (EQ (key, Q_accelerator))
196 wv->accel = LISP_TO_VOID (val);
198 signal_simple_error ("bad keyboard accelerator", val);
200 else if (EQ (key, Q_label))
202 /* implement in 21.2 */
205 signal_simple_error ("Unknown menu cascade keyword", cascade);
208 if ((!NILP (config_tag)
209 && NILP (Fmemq (config_tag, Vmenubar_configuration)))
210 || (included_spec && NILP (Feval (include_p))))
217 active_p = Feval (active_p);
219 if (!NILP (hook_fn) && !NILP (active_p))
221 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
222 if (filter_p || depth == 0)
225 desc = call1_trapping_errors ("Error in menubar filter",
229 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
233 widget_value *incr_wv = xmalloc_widget_value ();
234 wv->contents = incr_wv;
235 incr_wv->type = INCREMENTAL_TYPE;
236 incr_wv->enabled = 1;
237 incr_wv->name = wv->name;
238 incr_wv->name = xstrdup (wv->name);
239 /* This is automatically GC protected through
240 the call to lw_map_widget_values(); no need
242 incr_wv->call_data = LISP_TO_VOID (incremental_data);
245 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
247 if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0)
249 /* Simply prepend three more widget values to the contents of
250 the menu: a label, and two separators (to get a double
252 widget_value *title_wv = xmalloc_widget_value ();
253 widget_value *sep_wv = xmalloc_widget_value ();
254 title_wv->type = TEXT_TYPE;
255 title_wv->name = xstrdup (wv->name);
256 title_wv->enabled = 1;
257 title_wv->next = sep_wv;
258 sep_wv->type = SEPARATOR_TYPE;
259 sep_wv->value = menu_separator_style ("==");
262 wv->contents = title_wv;
265 wv->enabled = ! NILP (active_p);
266 if (deep_p && !wv->enabled && !NILP (desc))
269 /* Add a fake entry so the menus show up */
270 wv->contents = dummy = xmalloc_widget_value ();
271 dummy->name = xstrdup ("(inactive)");
272 dummy->accel = LISP_TO_VOID (Qnil);
276 dummy->type = BUTTON_TYPE;
277 dummy->call_data = NULL;
284 else if (menubar_root_p)
286 wv->name = xstrdup ("menubar");
287 wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
288 this is ignored anyway... */
292 signal_simple_error ("Menu name (first element) must be a string",
296 if (deep_p || menubar_root_p)
299 for (; !NILP (desc); desc = Fcdr (desc))
301 Lisp_Object child = Fcar (desc);
302 if (menubar_root_p && NILP (child)) /* the partition */
306 "More than one partition (nil) in menubar description");
308 next = xmalloc_widget_value ();
309 next->type = PUSHRIGHT_TYPE;
313 next = menu_item_descriptor_to_widget_value_1
314 (child, menu_type, deep_p, filter_p, depth + 1);
325 if (deep_p && !wv->contents)
328 else if (NILP (desc))
329 error ("nil may not appear in menu descriptions");
331 signal_simple_error ("Unrecognized menu descriptor", desc);
337 /* Completed normally. Clear out the object that widget_value_unwind()
338 will be called with to tell it not to free the wv (as we are
340 set_opaque_ptr (wv_closure, 0);
343 unbind_to (count, Qnil);
347 static widget_value *
348 menu_item_descriptor_to_widget_value (Lisp_Object desc,
349 int menu_type, /* if this is a menubar,
352 int filter_p) /* if :filter forms
356 int count = specpdl_depth ();
357 record_unwind_protect (restore_gc_inhibit,
358 make_int (gc_currently_forbidden));
359 gc_currently_forbidden = 1;
361 wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p,
363 unbind_to (count, Qnil);
368 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
369 int in_menu_callback;
372 restore_in_menu_callback (Lisp_Object val)
374 in_menu_callback = XINT (val);
377 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
380 /* #### Sort of a hack needed to process Vactivate_menubar_hook
381 correctly wrt buffer-local values. A correct solution would
382 involve adding a callback mechanism to run_hook(). This function
383 is currently unused. */
385 my_run_hook (Lisp_Object hooksym, int allow_global_p)
387 /* This function can GC */
389 Lisp_Object value = Fsymbol_value (hooksym);
392 if (!NILP (value) && (!CONSP (value) || EQ (XCAR (value), Qlambda)))
393 return !EQ (call0 (value), Qt);
395 EXTERNAL_LIST_LOOP (tail, value)
397 if (allow_global_p && EQ (XCAR (tail), Qt))
398 changes |= my_run_hook (Fdefault_value (hooksym), 0);
399 if (!EQ (call0 (XCAR (tail)), Qt))
407 /* The order in which callbacks are run is funny to say the least.
408 It's sometimes tricky to avoid running a callback twice, and to
409 avoid returning prematurely. So, this function returns true
410 if the menu's callbacks are no longer gc protected. So long
411 as we unprotect them before allowing other callbacks to run,
412 everything should be ok.
414 The pre_activate_callback() *IS* intentionally called multiple times.
415 If client_data == NULL, then it's being called before the menu is posted.
416 If client_data != NULL, then client_data is a (widget_value *) and
417 client_data->data is a Lisp_Object pointing to a lisp submenu description
418 that must be converted into widget_values. *client_data is destructively
421 #### Stig thinks that there may be a GC problem here due to the
422 fact that pre_activate_callback() is called multiple times, but I
428 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
430 /* This function can GC */
431 struct device *d = get_device_from_display (XtDisplay (widget));
432 struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
436 /* set in lwlib to the time stamp associated with the most recent menu
438 extern Time x_focus_timestamp_really_sucks_fix_me_better;
441 f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
445 /* make sure f is the selected frame */
446 XSETFRAME (frame, f);
447 Fselect_frame (frame);
451 /* this is an incremental menu construction callback */
452 widget_value *hack_wv = (widget_value *) client_data;
453 Lisp_Object submenu_desc;
456 assert (hack_wv->type == INCREMENTAL_TYPE);
457 VOID_TO_LISP (submenu_desc, hack_wv->call_data);
460 * #### Fix the menu code so this isn't necessary.
462 * Protect against reentering the menu code otherwise we will
463 * crash later when the code gets confused at the state
466 count = specpdl_depth ();
467 record_unwind_protect (restore_in_menu_callback,
468 make_int (in_menu_callback));
469 in_menu_callback = 1;
470 wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE,
472 unbind_to (count, Qnil);
476 wv = xmalloc_widget_value ();
477 wv->type = CASCADE_TYPE;
479 wv->accel = LISP_TO_VOID (Qnil);
480 wv->contents = xmalloc_widget_value ();
481 wv->contents->type = TEXT_TYPE;
482 wv->contents->name = xstrdup ("No menu");
483 wv->contents->next = NULL;
484 wv->contents->accel = LISP_TO_VOID (Qnil);
486 assert (wv && wv->type == CASCADE_TYPE && wv->contents);
487 replace_widget_value_tree (hack_wv, wv->contents);
488 free_popup_widget_value_tree (wv);
490 else if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f)))
494 #if 0 /* Unused, see comment below. */
497 /* #### - this menubar update mechanism is expensively anti-social and
498 the activate-menubar-hook is now mostly obsolete. */
499 any_changes = my_run_hook (Qactivate_menubar_hook, 1);
501 /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
502 incremental menus are implemented. If a subtree of a menu has been
503 updated incrementally (a destructive operation), then that subtree
504 must somehow be wiped.
506 It is difficult to undo the destructive operation in lwlib because
507 a pointer back to lisp data needs to be hidden away somewhere. So
508 that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */
510 !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date)
511 set_frame_menubar (f, 1, 0);
513 run_hook (Qactivate_menubar_hook);
514 set_frame_menubar (f, 1, 0);
516 DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
517 DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
518 x_focus_timestamp_really_sucks_fix_me_better;
522 static widget_value *
523 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
530 int count = specpdl_depth ();
532 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
533 Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
534 data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
536 unbind_to (count, Qnil);
543 set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
549 /* As with the toolbar, the minibuffer does not have its own menubar. */
550 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
555 /***** first compute the contents of the menubar *****/
559 /* evaluate `current-menubar' in the buffer of the selected window
560 of the frame in question. */
561 menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
565 /* That's a little tricky the first time since the frame isn't
566 fully initialized yet. */
567 menubar = Fsymbol_value (Qcurrent_menubar);
572 menubar = Vblank_menubar;
576 menubar_visible = !NILP (w->menubar_visible_p);
578 data = compute_menubar_data (f, menubar, deep_p);
579 if (!data || (!data->next && !data->contents))
582 if (NILP (FRAME_MENUBAR_DATA (f)))
584 struct popup_data *mdata =
585 alloc_lcrecord_type (struct popup_data, &lrecord_popup_data);
587 mdata->id = new_lwlib_id ();
588 mdata->last_menubar_buffer = Qnil;
589 mdata->menubar_contents_up_to_date = 0;
590 XSETPOPUP_DATA (FRAME_MENUBAR_DATA (f), mdata);
593 /***** now store into the menubar widget, creating it if necessary *****/
595 id = XFRAME_MENUBAR_DATA (f)->id;
596 if (!FRAME_X_MENUBAR_WIDGET (f))
598 Widget parent = FRAME_X_CONTAINER_WIDGET (f);
600 assert (first_time_p);
602 /* It's the first time we've mapped the menubar so compute its
603 contents completely once. This makes sure that the menubar
604 components are created with the right type. */
607 free_popup_widget_value_tree (data);
608 data = compute_menubar_data (f, menubar, 1);
612 FRAME_X_MENUBAR_WIDGET (f) =
613 lw_create_widget ("menubar", "menubar", id, data, parent,
614 0, pre_activate_callback,
615 popup_selection_callback, 0);
620 lw_modify_all_widgets (id, data, deep_p ? True : False);
622 free_popup_widget_value_tree (data);
624 XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p;
625 XFRAME_MENUBAR_DATA (f)->last_menubar_buffer =
626 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
627 return menubar_visible;
631 /* Called from x_create_widgets() to create the initial menubar of a frame
632 before it is mapped, so that the window is mapped with the menubar already
633 there instead of us tacking it on later and thrashing the window after it
636 x_initialize_frame_menubar (struct frame *f)
638 return set_frame_menubar (f, 1, 1);
642 static LWLIB_ID last_popup_menu_selection_callback_id;
645 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
646 XtPointer client_data)
648 last_popup_menu_selection_callback_id = id;
649 popup_selection_callback (widget, id, client_data);
650 /* lw_destroy_all_widgets() will be called from popup_down_callback() */
654 popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
656 if (popup_handled_p (id))
658 assert (popup_up_p != 0);
659 ungcpro_popup_callbacks (id);
661 /* if this isn't called immediately after the selection callback, then
662 there wasn't a menu selection. */
663 if (id != last_popup_menu_selection_callback_id)
664 popup_selection_callback (widget, id, (XtPointer) -1);
665 lw_destroy_all_widgets (id);
670 make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev)
671 /* NULL for eev means query pointer */
673 XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
675 btn->type = ButtonPress;
678 btn->display = XtDisplay (daddy);
679 btn->window = XtWindow (daddy);
682 Position shellx, shelly, framex, framey;
684 btn->time = eev->timestamp;
685 btn->button = eev->event.button.button;
686 btn->root = RootWindowOfScreen (XtScreen (daddy));
687 btn->subwindow = (Window) NULL;
688 btn->x = eev->event.button.x;
689 btn->y = eev->event.button.y;
691 #ifndef HAVE_WMCOMMAND
693 Widget shell = XtParent (daddy);
695 XtSetArg (al [0], XtNx, &shellx);
696 XtSetArg (al [1], XtNy, &shelly);
697 XtGetValues (shell, al, 2);
700 XtSetArg (al [0], XtNx, &framex);
701 XtSetArg (al [1], XtNy, &framey);
702 XtGetValues (daddy, al, 2);
703 btn->x_root = shellx + framex + btn->x;
704 btn->y_root = shelly + framey + btn->y;
705 btn->state = ButtonPressMask; /* all buttons pressed */
709 /* CurrentTime is just ZERO, so it's worthless for
710 determining relative click times. */
711 struct device *d = get_device_from_display (XtDisplay (daddy));
712 btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
714 XQueryPointer (btn->display, btn->window, &btn->root,
715 &btn->subwindow, &btn->x_root, &btn->y_root,
716 &btn->x, &btn->y, &btn->state);
723 x_update_frame_menubar_internal (struct frame *f)
725 /* We assume the menubar contents has changed if the global flag is set,
726 or if the current buffer has changed, or if the menubar has never
729 int menubar_contents_changed =
731 || NILP (FRAME_MENUBAR_DATA (f))
732 || (!EQ (XFRAME_MENUBAR_DATA (f)->last_menubar_buffer,
733 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
735 Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
736 Boolean menubar_will_be_visible = menubar_was_visible;
737 Boolean menubar_visibility_changed;
739 if (menubar_contents_changed)
740 menubar_will_be_visible = set_frame_menubar (f, 0, 0);
742 menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
744 if (!menubar_visibility_changed)
747 /* Set menubar visibility */
748 (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
749 (FRAME_X_MENUBAR_WIDGET (f));
751 MARK_FRAME_SIZE_SLIPPED (f);
755 x_update_frame_menubars (struct frame *f)
757 assert (FRAME_X_P (f));
759 x_update_frame_menubar_internal (f);
761 /* #### This isn't going to work right now that this function works on
762 a per-frame, not per-device basis. Guess what? I don't care. */
766 x_free_frame_menubars (struct frame *f)
768 Widget menubar_widget;
770 assert (FRAME_X_P (f));
772 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
775 LWLIB_ID id = XFRAME_MENUBAR_DATA (f)->id;
776 lw_destroy_all_widgets (id);
777 XFRAME_MENUBAR_DATA (f)->id = 0;
782 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
785 struct frame *f = selected_frame ();
789 Lisp_Event *eev = NULL;
793 XSETFRAME (frame, f);
794 CHECK_X_FRAME (frame);
795 parent = FRAME_X_SHELL_WIDGET (f);
799 CHECK_LIVE_EVENT (event);
801 if (eev->event_type != button_press_event
802 && eev->event_type != button_release_event)
803 wrong_type_argument (Qmouse_event_p, event);
805 else if (!NILP (Vthis_command_keys))
807 /* if an event wasn't passed, use the last event of the event sequence
808 currently being executed, if that event is a mouse event */
809 eev = XEVENT (Vthis_command_keys); /* last event first */
810 if (eev->event_type != button_press_event
811 && eev->event_type != button_release_event)
814 make_dummy_xbutton_event (&xev, parent, eev);
816 if (SYMBOLP (menu_desc))
817 menu_desc = Fsymbol_value (menu_desc);
818 CHECK_CONS (menu_desc);
819 CHECK_STRING (XCAR (menu_desc));
820 data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
822 if (! data) error ("no menu");
824 menu_id = new_lwlib_id ();
825 menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
827 popup_menu_selection_callback,
828 popup_menu_down_callback);
829 free_popup_widget_value_tree (data);
831 gcpro_popup_callbacks (menu_id);
833 /* Setting zmacs-region-stays is necessary here because executing a command
834 from a menu is really a two-command process: the first command (bound to
835 the button-click) simply pops up the menu, and returns. This causes a
836 sequence of magic-events (destined for the popup-menu widget) to begin.
837 Eventually, a menu item is selected, and a menu-event blip is pushed onto
838 the end of the input stream, which is then executed by the event loop.
840 So there are two command-events, with a bunch of magic-events between
841 them. We don't want the *first* command event to alter the state of the
842 region, so that the region can be available as an argument for the second
846 zmacs_region_stays = 1;
849 lw_popup_menu (menu, &xev);
850 /* this speeds up display of pop-up menus */
851 XFlush (XtDisplay (parent));
856 #if defined(LWLIB_MENUBARS_LUCID)
860 widget_value *current = lw_get_entries (False);
861 widget_value *entries = lw_get_entries (True);
862 widget_value *prev = NULL;
864 while (entries != current)
866 if (entries->name /*&& entries->enabled*/) prev = entries;
867 entries = entries->next;
872 /* move to last item */
874 while (entries->next)
876 if (entries->name /*&& entries->enabled*/) prev = entries;
877 entries = entries->next;
881 if (entries->name /*&& entries->enabled*/)
886 /* no selectable items in this menu, pop up to previous level */
895 menu_move_down (void)
897 widget_value *current = lw_get_entries (False);
898 widget_value *new = current;
903 if (new->name /*&& new->enabled*/) break;
906 if (new==current||!(new->name/*||new->enabled*/))
908 new = lw_get_entries (True);
911 if (new->name /*&& new->enabled*/) break;
914 if (new==current&&!(new->name /*|| new->enabled*/))
925 menu_move_left (void)
927 int level = lw_menu_level ();
929 widget_value *current;
935 current = lw_get_entries (False);
936 if (l > 2 && current->contents)
937 lw_push_menu (current->contents);
941 menu_move_right (void)
943 int level = lw_menu_level ();
945 widget_value *current;
951 current = lw_get_entries (False);
952 if (l > 2 && current->contents)
953 lw_push_menu (current->contents);
957 menu_select_item (widget_value *val)
960 val = lw_get_entries (False);
962 /* is match a submenu? */
966 /* enter the submenu */
969 lw_push_menu (val->contents);
973 /* Execute the menu entry by calling the menu's `select'
981 command_builder_operate_menu_accelerator (struct command_builder *builder)
983 /* this function can GC */
985 struct console *con = XCONSOLE (Vselected_console);
986 Lisp_Object evee = builder->most_current_event;
988 widget_value *entries;
990 extern int lw_menu_accelerate; /* lwlib.c */
998 t = builder->current_events;
1003 sprintf (buf,"OPERATE (%d): ",i);
1004 write_c_string (buf, Qexternal_debugging_output);
1005 print_internal (t, Qexternal_debugging_output, 1);
1006 write_c_string ("\n", Qexternal_debugging_output);
1007 t = XEVENT_NEXT (t);
1012 /* menu accelerator keys don't go into keyboard macros */
1013 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
1014 con->kbd_macro_ptr = con->kbd_macro_end;
1016 /* don't echo menu accelerator keys */
1017 /*reset_key_echo (builder, 1);*/
1019 if (!lw_menu_accelerate)
1021 /* `convert' mouse display to keyboard display
1022 by entering the open submenu
1024 entries = lw_get_entries (False);
1025 if (entries->contents)
1027 lw_push_menu (entries->contents);
1028 lw_display_menu (CurrentTime);
1032 /* compare event to the current menu accelerators */
1034 entries=lw_get_entries (True);
1039 VOID_TO_LISP (accel, entries->accel);
1040 if (entries->name && !NILP (accel))
1042 if (event_matches_key_specifier_p (XEVENT (evee), accel))
1046 menu_select_item (entries);
1048 if (lw_menu_active) lw_display_menu (CurrentTime);
1050 reset_this_command_keys (Vselected_console, 1);
1051 /*reset_command_builder_event_chain (builder);*/
1052 return Vmenu_accelerator_map;
1055 entries = entries->next;
1058 /* try to look up event in menu-accelerator-map */
1060 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
1064 /* beep at user for undefined key */
1069 if (EQ (binding, Qmenu_quit))
1071 /* turn off menus and set quit flag */
1072 lw_kill_menus (NULL);
1075 else if (EQ (binding, Qmenu_up))
1077 int level = lw_menu_level ();
1081 else if (EQ (binding, Qmenu_down))
1083 int level = lw_menu_level ();
1087 menu_select_item (NULL);
1089 else if (EQ (binding, Qmenu_left))
1091 int level = lw_menu_level ();
1095 lw_display_menu (CurrentTime);
1100 else if (EQ (binding, Qmenu_right))
1102 int level = lw_menu_level ();
1104 lw_get_entries (False)->contents)
1106 widget_value *current = lw_get_entries (False);
1107 if (current->contents)
1108 menu_select_item (NULL);
1113 else if (EQ (binding, Qmenu_select))
1114 menu_select_item (NULL);
1115 else if (EQ (binding, Qmenu_escape))
1117 int level = lw_menu_level ();
1122 lw_display_menu (CurrentTime);
1126 /* turn off menus quietly */
1127 lw_kill_menus (NULL);
1130 else if (KEYMAPP (binding))
1133 reset_this_command_keys (Vselected_console, 1);
1134 /*reset_command_builder_event_chain (builder);*/
1139 /* turn off menus and execute binding */
1140 lw_kill_menus (NULL);
1141 reset_this_command_keys (Vselected_console, 1);
1142 /*reset_command_builder_event_chain (builder);*/
1147 if (lw_menu_active) lw_display_menu (CurrentTime);
1149 reset_this_command_keys (Vselected_console, 1);
1150 /*reset_command_builder_event_chain (builder);*/
1152 return Vmenu_accelerator_map;
1156 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
1158 Vmenu_accelerator_prefix = Qnil;
1159 Vmenu_accelerator_modifiers = Qnil;
1160 Vmenu_accelerator_enabled = Qnil;
1161 if (!NILP (errordata))
1163 Lisp_Object args[2];
1165 args[0] = build_string ("Error in menu accelerators (setting to nil)");
1166 /* #### This should call
1167 (with-output-to-string (display-error errordata))
1168 but that stuff is all in Lisp currently. */
1169 args[1] = errordata;
1170 warn_when_safe_lispobj
1172 emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s",
1173 Qnil, -1, 2, args));
1180 menu_accelerator_safe_compare (Lisp_Object event0)
1182 if (CONSP (Vmenu_accelerator_prefix))
1185 t=Vmenu_accelerator_prefix;
1188 && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
1191 event0 = XEVENT_NEXT (event0);
1196 else if (NILP (event0))
1198 else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
1199 event0 = XEVENT_NEXT (event0);
1206 menu_accelerator_safe_mod_compare (Lisp_Object cons)
1208 return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
1214 command_builder_find_menu_accelerator (struct command_builder *builder)
1216 /* this function can GC */
1217 Lisp_Object event0 = builder->current_events;
1218 struct console *con = XCONSOLE (Vselected_console);
1219 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
1220 Widget menubar_widget;
1222 /* compare entries in event0 against the menu prefix */
1224 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
1225 XEVENT (event0)->event_type != key_press_event)
1228 if (!NILP (Vmenu_accelerator_prefix))
1230 event0 = condition_case_1 (Qerror,
1231 menu_accelerator_safe_compare,
1233 menu_accelerator_junk_on_error,
1240 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
1242 && CONSP (Vmenu_accelerator_modifiers))
1245 Lisp_Object last = Qnil;
1246 struct gcpro gcpro1;
1250 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
1252 val = lw_get_all_values (id);
1255 val = val->contents;
1257 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
1260 while (!NILP (Fcdr (last)))
1263 Fsetcdr (last, Fcons (Qnil, Qnil));
1267 fake = Fcons (Qnil, fake);
1274 VOID_TO_LISP (accel, val->accel);
1275 if (val->name && !NILP (accel))
1277 Fsetcar (last, accel);
1278 Fsetcar (fake, event0);
1279 matchp = condition_case_1 (Qerror,
1280 menu_accelerator_safe_mod_compare,
1282 menu_accelerator_junk_on_error,
1288 lw_set_menu (menubar_widget, val);
1289 /* yah - yet another hack.
1290 pretend emacs timestamp is the same as an X timestamp,
1291 which for the moment it is. (read events.h)
1293 lw_map_menu (XEVENT (event0)->timestamp);
1296 lw_push_menu (val->contents);
1298 lw_display_menu (CurrentTime);
1300 /* menu accelerator keys don't go into keyboard macros */
1301 if (!NILP (con->defining_kbd_macro)
1302 && NILP (Vexecuting_macro))
1303 con->kbd_macro_ptr = con->kbd_macro_end;
1305 /* don't echo menu accelerator keys */
1306 /*reset_key_echo (builder, 1);*/
1307 reset_this_command_keys (Vselected_console, 1);
1310 return Vmenu_accelerator_map;
1323 x_kludge_lw_menu_active (void)
1325 return lw_menu_active;
1328 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
1329 Make the menubar active. Menu items can be selected using menu accelerators
1330 or by actions defined in menu-accelerator-map.
1334 struct console *con = XCONSOLE (Vselected_console);
1335 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
1339 if (NILP (f->menubar_data))
1340 error ("Frame has no menubar.");
1342 id = XPOPUP_DATA (f->menubar_data)->id;
1343 val = lw_get_all_values (id);
1344 val = val->contents;
1345 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
1346 lw_map_menu (CurrentTime);
1348 lw_display_menu (CurrentTime);
1350 /* menu accelerator keys don't go into keyboard macros */
1351 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
1352 con->kbd_macro_ptr = con->kbd_macro_end;
1356 #endif /* LWLIB_MENUBARS_LUCID */
1360 syms_of_menubar_x (void)
1362 #if defined(LWLIB_MENUBARS_LUCID)
1363 DEFSUBR (Faccelerate_menu);
1368 console_type_create_menubar_x (void)
1370 CONSOLE_HAS_METHOD (x, update_frame_menubars);
1371 CONSOLE_HAS_METHOD (x, free_frame_menubars);
1372 CONSOLE_HAS_METHOD (x, popup_menu);
1376 reinit_vars_of_menubar_x (void)
1378 last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
1382 vars_of_menubar_x (void)
1384 reinit_vars_of_menubar_x ();
1386 #if defined (LWLIB_MENUBARS_LUCID)
1387 Fprovide (intern ("lucid-menubars"));
1388 #elif defined (LWLIB_MENUBARS_MOTIF)
1389 Fprovide (intern ("motif-menubars"));
1390 #elif defined (LWLIB_MENUBARS_ATHENA)
1391 Fprovide (intern ("athena-menubars"));