(U+6215): Apply new conventions for glyph granularity.
[chise/xemacs-chise.git.1] / src / menubar-x.c
index 4964779..207a36f 100644 (file)
@@ -1,6 +1,7 @@
 /* Implements an elisp-programmable menubar -- X interface.
    Copyright (C) 1993, 1994 Free Software Foundation, Inc.
    Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+   Copyright (C) 2000 Ben Wing.
 
 This file is part of XEmacs.
 
@@ -21,22 +22,32 @@ Boston, MA 02111-1307, USA.  */
 
 /* Synched up with: Not in FSF. */
 
-/* created 16-dec-91 by jwz */
+/* This file Mule-ized by Ben Wing, 7-8-00. */
+
+/* Authorship:
+
+   Created 16-dec-91 by Jamie Zawinski.
+   Menu filters and many other keywords added by Stig for 19.12.
+   Original device-abstraction work and GC cleanup work by Ben Wing for 19.13.
+   Menu accelerators c. 1997? by ??.  Moved here from event-stream.c.
+   Other work post-1996 by ??.
+*/
 
 #include <config.h>
 #include "lisp.h"
 
 #include "console-x.h"
-#include "EmacsManager.h"
 #include "EmacsFrame.h"
-#include "EmacsShell.h"
 #include "gui-x.h"
+#include "../lwlib/lwlib.h"
 
 #include "buffer.h"
 #include "commands.h"           /* zmacs_regions */
-#include "gui.h"
 #include "events.h"
 #include "frame.h"
+#include "gui.h"
+#include "keymap.h"
+#include "menubar.h"
 #include "opaque.h"
 #include "window.h"
 
@@ -94,43 +105,41 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
   /* This function cannot GC.
      It is only called from menu_item_descriptor_to_widget_value, which
      prohibits GC. */
-  /* !!#### This function has not been Mule-ized */
   int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0);
-  widget_value *wv;
-  Lisp_Object wv_closure;
   int count = specpdl_depth ();
   int partition_seen = 0;
+  widget_value *wv = xmalloc_widget_value ();
+  Lisp_Object wv_closure = make_opaque_ptr (wv);
 
-  wv = xmalloc_widget_value ();
-
-  wv_closure = make_opaque_ptr (wv);
   record_unwind_protect (widget_value_unwind, wv_closure);
 
   if (STRINGP (desc))
     {
-      char *string_chars = (char *) XSTRING_DATA (desc);
+      Bufbyte *string_chars = XSTRING_DATA (desc);
       wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE :
                  TEXT_TYPE);
-#if 1
-      /* #### - should internationalize with X resources instead.
-         Not so! --ben */
-      string_chars = GETTEXT (string_chars);
-#endif
       if (wv->type == SEPARATOR_TYPE)
        {
-         wv->value = menu_separator_style (string_chars);
+         wv->value = menu_separator_style_and_to_external (string_chars);
        }
       else
        {
-         wv->name = string_chars;
+         LISP_STRING_TO_EXTERNAL_MALLOC (desc, wv->name, Qlwlib_encoding);
          wv->enabled = 1;
+         /* dverna Dec. 98: command_builder_operate_menu_accelerator will
+            manipulate the accel as a Lisp_Object if the widget has a name.
+            Since simple labels have a name, but no accel, we *must* set it
+            to nil */
+         wv->accel = LISP_TO_VOID (Qnil);
        }
     }
   else if (VECTORP (desc))
     {
-      if (!button_item_to_widget_value (desc, wv, 1,
+      Lisp_Object gui_item = gui_parse_item_keywords (desc);
+      if (!button_item_to_widget_value (Qmenubar,
+                                       gui_item, wv, 1,
                                        (menu_type == MENUBAR_TYPE
-                                        && depth <= 1)))
+                                        && depth <= 1), 1, 1))
        {
          /* :included form was nil */
          wv = NULL;
@@ -152,9 +161,9 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
          int active_spec = 0;
          wv->type = CASCADE_TYPE;
          wv->enabled = 1;
-         wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc)));
+         wv->name = add_accel_and_to_external (XCAR (desc));
 
-         accel = menu_name_to_accelerator (wv->name);
+         accel = gui_name_accelerator (XCAR (desc));
          wv->accel = LISP_TO_VOID (accel);
 
          desc = Fcdr (desc);
@@ -164,8 +173,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
              Lisp_Object cascade = desc;
              desc = Fcdr (desc);
              if (NILP (desc))
-               signal_simple_error ("keyword in menu lacks a value",
-                                    cascade);
+               syntax_error ("Keyword in menu lacks a value", cascade);
              val = Fcar (desc);
              desc = Fcdr (desc);
              if (EQ (key, Q_included))
@@ -182,14 +190,14 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
                       || CHARP (val))
                    wv->accel = LISP_TO_VOID (val);
                  else
-                   signal_simple_error ("bad keyboard accelerator", val);
+                   syntax_error ("bad keyboard accelerator", val);
                }
              else if (EQ (key, Q_label))
                {
                  /* implement in 21.2 */
                }
              else
-               signal_simple_error ("unknown menu cascade keyword", cascade);
+               syntax_error ("Unknown menu cascade keyword", cascade);
            }
 
          if ((!NILP (config_tag)
@@ -202,7 +210,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
 
          if (active_spec)
            active_p = Feval (active_p);
-         
+
          if (!NILP (hook_fn) && !NILP (active_p))
            {
 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
@@ -222,6 +230,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
                  incr_wv->type = INCREMENTAL_TYPE;
                  incr_wv->enabled = 1;
                  incr_wv->name = wv->name;
+                 incr_wv->name = xstrdup (wv->name);
                  /* This is automatically GC protected through
                     the call to lw_map_widget_values(); no need
                     to worry. */
@@ -238,11 +247,11 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
              widget_value *title_wv = xmalloc_widget_value ();
              widget_value *sep_wv = xmalloc_widget_value ();
              title_wv->type = TEXT_TYPE;
-             title_wv->name = wv->name;
+             title_wv->name = xstrdup (wv->name);
              title_wv->enabled = 1;
              title_wv->next = sep_wv;
              sep_wv->type = SEPARATOR_TYPE;
-             sep_wv->value = menu_separator_style ("==");
+             sep_wv->value = menu_separator_style_and_to_external ((Bufbyte *) "==");
              sep_wv->next = 0;
 
              wv->contents = title_wv;
@@ -254,31 +263,30 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
              widget_value *dummy;
              /* Add a fake entry so the menus show up */
              wv->contents = dummy = xmalloc_widget_value ();
-             dummy->name = "(inactive)";
-             dummy->accel = NULL;
+             dummy->name = xstrdup ("(inactive)");
+             dummy->accel = LISP_TO_VOID (Qnil);
              dummy->enabled = 0;
              dummy->selected = 0;
              dummy->value = NULL;
              dummy->type = BUTTON_TYPE;
              dummy->call_data = NULL;
              dummy->next = NULL;
-             
+
              goto menu_item_done;
-       }
+           }
 
        }
       else if (menubar_root_p)
        {
-         wv->name = (char *) "menubar";
+         wv->name = xstrdup ("menubar");
          wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
                                      this is ignored anyway...  */
        }
       else
        {
-         signal_simple_error ("menu name (first element) must be a string",
-                               desc);
+         syntax_error ("Menu name (first element) must be a string", desc);
        }
-      
+
       if (deep_p || menubar_root_p)
        {
          widget_value *next;
@@ -288,8 +296,9 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
              if (menubar_root_p && NILP (child))       /* the partition */
                {
                  if (partition_seen)
-                   error (
-                    "more than one partition (nil) in menubar description");
+                   syntax_error
+                     ("More than one partition (nil) in menubar description",
+                      desc);
                  partition_seen = 1;
                  next = xmalloc_widget_value ();
                  next->type = PUSHRIGHT_TYPE;
@@ -312,11 +321,11 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
        wv = NULL;
     }
   else if (NILP (desc))
-    error ("nil may not appear in menu descriptions");
+    syntax_error ("nil may not appear in menu descriptions", desc);
   else
-    signal_simple_error ("unrecognized menu descriptor", desc);
+    syntax_error ("Unrecognized menu descriptor", desc);
 
-menu_item_done:
+ menu_item_done:
 
   if (wv)
     {
@@ -333,7 +342,7 @@ menu_item_done:
 static widget_value *
 menu_item_descriptor_to_widget_value (Lisp_Object desc,
                                      int menu_type, /* if this is a menubar,
-                                                    popup or sub menu */
+                                                       popup or sub menu */
                                      int deep_p,    /*  */
                                      int filter_p)  /* if :filter forms
                                                        should run now */
@@ -357,8 +366,8 @@ int in_menu_callback;
 static Lisp_Object
 restore_in_menu_callback (Lisp_Object val)
 {
-    in_menu_callback = XINT(val);
-    return Qnil;
+  in_menu_callback = XINT (val);
+  return Qnil;
 }
 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
 
@@ -462,10 +471,12 @@ pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
          wv = xmalloc_widget_value ();
          wv->type = CASCADE_TYPE;
          wv->next = NULL;
+         wv->accel = LISP_TO_VOID (Qnil);
          wv->contents = xmalloc_widget_value ();
          wv->contents->type = TEXT_TYPE;
-         wv->contents->name = (char *) "No menu";
+         wv->contents->name = xstrdup ("No menu");
          wv->contents->next = NULL;
+         wv->contents->accel = LISP_TO_VOID (Qnil);
        }
       assert (wv && wv->type == CASCADE_TYPE && wv->contents);
       replace_widget_value_tree (hack_wv, wv->contents);
@@ -506,24 +517,21 @@ pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
 static widget_value *
 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
 {
-  widget_value *data;
-
   if (NILP (menubar))
-    data = 0;
+    return 0;
   else
     {
-      Lisp_Object old_buffer;
+      widget_value *data;
       int count = specpdl_depth ();
 
-      old_buffer = Fcurrent_buffer ();
-      record_unwind_protect (Fset_buffer, old_buffer);
-      Fset_buffer ( XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
+      record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+      Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
       data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
                                                   deep_p, 0);
-      Fset_buffer (old_buffer);
       unbind_to (count, Qnil);
+
+      return data;
     }
-  return data;
 }
 
 static int
@@ -533,7 +541,7 @@ set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
   Lisp_Object menubar;
   int menubar_visible;
   long id;
-  /* As for the toolbar, the minibuffer does not have its own menubar. */
+  /* As with the toolbar, the minibuffer does not have its own menubar. */
   struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
 
   if (! FRAME_X_P (f))
@@ -564,12 +572,12 @@ set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
 
   data = compute_menubar_data (f, menubar, deep_p);
   if (!data || (!data->next && !data->contents))
-    abort ();
+    ABORT ();
 
   if (NILP (FRAME_MENUBAR_DATA (f)))
     {
       struct popup_data *mdata =
-       alloc_lcrecord_type (struct popup_data, lrecord_popup_data);
+       alloc_lcrecord_type (struct popup_data, &lrecord_popup_data);
 
       mdata->id = new_lwlib_id ();
       mdata->last_menubar_buffer = Qnil;
@@ -615,7 +623,7 @@ set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
 }
 
 
-/* Called from x_create_widgets() to create the inital menubar of a frame
+/* Called from x_create_widgets() to create the initial menubar of a frame
    before it is mapped, so that the window is mapped with the menubar already
    there instead of us tacking it on later and thrashing the window after it
    is visible. */
@@ -654,9 +662,7 @@ popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
 
 \f
 static void
-make_dummy_xbutton_event (XEvent *dummy,
-                         Widget daddy,
-                         struct Lisp_Event *eev)
+make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev)
      /* NULL for eev means query pointer */
 {
   XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
@@ -669,7 +675,6 @@ make_dummy_xbutton_event (XEvent *dummy,
   if (eev)
     {
       Position shellx, shelly, framex, framey;
-      Widget shell = XtParent (daddy);
       Arg al [2];
       btn->time = eev->timestamp;
       btn->button = eev->event.button.button;
@@ -677,14 +682,21 @@ make_dummy_xbutton_event (XEvent *dummy,
       btn->subwindow = (Window) NULL;
       btn->x = eev->event.button.x;
       btn->y = eev->event.button.y;
-      XtSetArg (al [0], XtNx, &shellx);
-      XtSetArg (al [1], XtNy, &shelly);
-      XtGetValues (shell, al, 2);
+      shellx = shelly = 0;
+#ifndef HAVE_WMCOMMAND
+      {
+       Widget shell = XtParent (daddy);
+
+       XtSetArg (al [0], XtNx, &shellx);
+       XtSetArg (al [1], XtNy, &shelly);
+       XtGetValues (shell, al, 2);
+      }
+#endif
       XtSetArg (al [0], XtNx, &framex);
       XtSetArg (al [1], XtNy, &framey);
       XtGetValues (daddy, al, 2);
       btn->x_root = shellx + framex + btn->x;
-      btn->y_root = shelly + framey + btn->y;;
+      btn->y_root = shelly + framey + btn->y;
       btn->state = ButtonPressMask; /* all buttons pressed */
     }
   else
@@ -769,7 +781,7 @@ x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
   widget_value *data;
   Widget parent;
   Widget menu;
-  struct Lisp_Event *eev = NULL;
+  Lisp_Event *eev = NULL;
   XEvent xev;
   Lisp_Object frame;
 
@@ -824,7 +836,7 @@ x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
      them.  We don't want the *first* command event to alter the state of the
      region, so that the region can be available as an argument for the second
      command.
-   */
+  */
   if (zmacs_regions)
     zmacs_region_stays = 1;
 
@@ -835,9 +847,516 @@ x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
 }
 
 \f
+
+#if defined(LWLIB_MENUBARS_LUCID)
+static void
+menu_move_up (void)
+{
+  widget_value *current = lw_get_entries (False);
+  widget_value *entries = lw_get_entries (True);
+  widget_value *prev    = NULL;
+
+  while (entries != current)
+    {
+      if (entries->name /*&& entries->enabled*/) prev = entries;
+      entries = entries->next;
+      assert (entries);
+    }
+
+  if (!prev)
+    /* move to last item */
+    {
+      while (entries->next)
+       {
+         if (entries->name /*&& entries->enabled*/) prev = entries;
+         entries = entries->next;
+       }
+      if (prev)
+       {
+         if (entries->name /*&& entries->enabled*/)
+           prev = entries;
+       }
+      else
+       {
+         /* no selectable items in this menu, pop up to previous level */
+         lw_pop_menu ();
+         return;
+       }
+    }
+  lw_set_item (prev);
+}
+
+static void
+menu_move_down (void)
+{
+  widget_value *current = lw_get_entries (False);
+  widget_value *new = current;
+
+  while (new->next)
+    {
+      new = new->next;
+      if (new->name /*&& new->enabled*/) break;
+    }
+
+  if (new==current||!(new->name/*||new->enabled*/))
+    {
+      new = lw_get_entries (True);
+      while (new!=current)
+       {
+         if (new->name /*&& new->enabled*/) break;
+         new = new->next;
+       }
+      if (new==current&&!(new->name /*|| new->enabled*/))
+       {
+         lw_pop_menu ();
+         return;
+       }
+    }
+
+  lw_set_item (new);
+}
+
+static void
+menu_move_left (void)
+{
+  int level = lw_menu_level ();
+  int l = level;
+  widget_value *current;
+
+  while (level-- >= 3)
+    lw_pop_menu ();
+
+  menu_move_up ();
+  current = lw_get_entries (False);
+  if (l > 2 && current->contents)
+    lw_push_menu (current->contents);
+}
+
+static void
+menu_move_right (void)
+{
+  int level = lw_menu_level ();
+  int l = level;
+  widget_value *current;
+
+  while (level-- >= 3)
+    lw_pop_menu ();
+
+  menu_move_down ();
+  current = lw_get_entries (False);
+  if (l > 2 && current->contents)
+    lw_push_menu (current->contents);
+}
+
+static void
+menu_select_item (widget_value *val)
+{
+  if (val == NULL)
+    val = lw_get_entries (False);
+
+  /* is match a submenu? */
+
+  if (val->contents)
+    {
+      /* enter the submenu */
+
+      lw_set_item (val);
+      lw_push_menu (val->contents);
+    }
+  else
+    {
+      /* Execute the menu entry by calling the menu's `select'
+        callback function
+      */
+      lw_kill_menus (val);
+    }
+}
+
+Lisp_Object
+command_builder_operate_menu_accelerator (struct command_builder *builder)
+{
+  /* this function can GC */
+
+  struct console *con = XCONSOLE (Vselected_console);
+  Lisp_Object evee = builder->most_current_event;
+  Lisp_Object binding;
+  widget_value *entries;
+
+  extern int lw_menu_accelerate; /* lwlib.c */
+
+#if 0
+  {
+    int i;
+    Lisp_Object t;
+    char buf[50];
+
+    t = builder->current_events;
+    i = 0;
+    while (!NILP (t))
+      {
+       i++;
+       sprintf (buf,"OPERATE (%d): ",i);
+       write_c_string (buf, Qexternal_debugging_output);
+       print_internal (t, Qexternal_debugging_output, 1);
+       write_c_string ("\n", Qexternal_debugging_output);
+       t = XEVENT_NEXT (t);
+      }
+  }
+#endif /* 0 */
+
+  /* menu accelerator keys don't go into keyboard macros */
+  if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
+    con->kbd_macro_ptr = con->kbd_macro_end;
+
+  /* don't echo menu accelerator keys */
+  /*reset_key_echo (builder, 1);*/
+
+  if (!lw_menu_accelerate)
+    {
+      /* `convert' mouse display to keyboard display
+        by entering the open submenu
+      */
+      entries = lw_get_entries (False);
+      if (entries->contents)
+       {
+         lw_push_menu (entries->contents);
+         lw_display_menu (CurrentTime);
+       }
+    }
+
+  /* compare event to the current menu accelerators */
+
+  entries=lw_get_entries (True);
+
+  while (entries)
+    {
+      Lisp_Object accel;
+      VOID_TO_LISP (accel, entries->accel);
+      if (entries->name && !NILP (accel))
+       {
+         if (event_matches_key_specifier_p (XEVENT (evee), accel))
+           {
+             /* a match! */
+
+             menu_select_item (entries);
+
+             if (lw_menu_active) lw_display_menu (CurrentTime);
+
+             reset_this_command_keys (Vselected_console, 1);
+             /*reset_command_builder_event_chain (builder);*/
+             return Vmenu_accelerator_map;
+           }
+       }
+      entries = entries->next;
+    }
+
+  /* try to look up event in menu-accelerator-map */
+
+  binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
+
+  if (NILP (binding))
+    {
+      /* beep at user for undefined key */
+      return Qnil;
+    }
+  else
+    {
+      if (EQ (binding, Qmenu_quit))
+       {
+         /* turn off menus and set quit flag */
+         lw_kill_menus (NULL);
+         Vquit_flag = Qt;
+       }
+      else if (EQ (binding, Qmenu_up))
+       {
+         int level = lw_menu_level ();
+         if (level > 2)
+           menu_move_up ();
+       }
+      else if (EQ (binding, Qmenu_down))
+       {
+         int level = lw_menu_level ();
+         if (level > 2)
+           menu_move_down ();
+         else
+           menu_select_item (NULL);
+       }
+      else if (EQ (binding, Qmenu_left))
+       {
+         int level = lw_menu_level ();
+         if (level > 3)
+           {
+             lw_pop_menu ();
+             lw_display_menu (CurrentTime);
+           }
+         else
+           menu_move_left ();
+       }
+      else if (EQ (binding, Qmenu_right))
+       {
+         int level = lw_menu_level ();
+         if (level > 2 &&
+             lw_get_entries (False)->contents)
+           {
+             widget_value *current = lw_get_entries (False);
+             if (current->contents)
+               menu_select_item (NULL);
+           }
+         else
+           menu_move_right ();
+       }
+      else if (EQ (binding, Qmenu_select))
+       menu_select_item (NULL);
+      else if (EQ (binding, Qmenu_escape))
+       {
+         int level = lw_menu_level ();
+
+         if (level > 2)
+           {
+             lw_pop_menu ();
+             lw_display_menu (CurrentTime);
+           }
+         else
+           {
+             /* turn off menus quietly */
+             lw_kill_menus (NULL);
+           }
+       }
+      else if (KEYMAPP (binding))
+       {
+         /* prefix key */
+         reset_this_command_keys (Vselected_console, 1);
+         /*reset_command_builder_event_chain (builder);*/
+         return binding;
+       }
+      else
+       {
+         /* turn off menus and execute binding */
+         lw_kill_menus (NULL);
+         reset_this_command_keys (Vselected_console, 1);
+         /*reset_command_builder_event_chain (builder);*/
+         return binding;
+       }
+    }
+
+  if (lw_menu_active) lw_display_menu (CurrentTime);
+
+  reset_this_command_keys (Vselected_console, 1);
+  /*reset_command_builder_event_chain (builder);*/
+
+  return Vmenu_accelerator_map;
+}
+
+static Lisp_Object
+menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
+{
+  Vmenu_accelerator_prefix    = Qnil;
+  Vmenu_accelerator_modifiers = Qnil;
+  Vmenu_accelerator_enabled   = Qnil;
+  if (!NILP (errordata))
+    {
+      Lisp_Object args[2];
+
+      args[0] = build_string ("Error in menu accelerators (setting to nil)");
+      /* #### This should call
+        (with-output-to-string (display-error errordata))
+        but that stuff is all in Lisp currently. */
+      args[1] = errordata;
+      warn_when_safe_lispobj
+       (Qerror, Qwarning,
+        emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s",
+                                  Qnil, -1, 2, args));
+    }
+
+  return Qnil;
+}
+
+static Lisp_Object
+menu_accelerator_safe_compare (Lisp_Object event0)
+{
+  if (CONSP (Vmenu_accelerator_prefix))
+    {
+      Lisp_Object t;
+      t=Vmenu_accelerator_prefix;
+      while (!NILP (t)
+            && !NILP (event0)
+            && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
+       {
+         t = Fcdr (t);
+         event0 = XEVENT_NEXT (event0);
+       }
+      if (!NILP (t))
+       return Qnil;
+    }
+  else if (NILP (event0))
+    return Qnil;
+  else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
+    event0 = XEVENT_NEXT (event0);
+  else
+    return Qnil;
+  return event0;
+}
+
+static Lisp_Object
+menu_accelerator_safe_mod_compare (Lisp_Object cons)
+{
+  return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
+         ? Qt
+         : Qnil);
+}
+
+Lisp_Object
+command_builder_find_menu_accelerator (struct command_builder *builder)
+{
+  /* this function can GC */
+  Lisp_Object event0 = builder->current_events;
+  struct console *con = XCONSOLE (Vselected_console);
+  struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
+  Widget menubar_widget;
+
+  /* compare entries in event0 against the menu prefix */
+
+  if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
+      XEVENT (event0)->event_type != key_press_event)
+    return Qnil;
+
+  if (!NILP (Vmenu_accelerator_prefix))
+    {
+      event0 = condition_case_1 (Qerror,
+                                menu_accelerator_safe_compare,
+                                event0,
+                                menu_accelerator_junk_on_error,
+                                Qnil);
+    }
+
+  if (NILP (event0))
+    return Qnil;
+
+  menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
+  if (menubar_widget
+      && CONSP (Vmenu_accelerator_modifiers))
+    {
+      Lisp_Object fake = Qnil;
+      Lisp_Object last = Qnil;
+      struct gcpro gcpro1;
+      Lisp_Object matchp;
+
+      widget_value *val;
+      LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
+
+      val = lw_get_all_values (id);
+      if (val)
+       {
+         val = val->contents;
+
+         fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
+         last = fake;
+
+         while (!NILP (Fcdr (last)))
+           last = Fcdr (last);
+
+         Fsetcdr (last, Fcons (Qnil, Qnil));
+         last = Fcdr (last);
+       }
+
+      fake = Fcons (Qnil, fake);
+
+      GCPRO1 (fake);
+
+      while (val)
+       {
+         Lisp_Object accel;
+         VOID_TO_LISP (accel, val->accel);
+         if (val->name && !NILP (accel))
+           {
+             Fsetcar (last, accel);
+             Fsetcar (fake, event0);
+             matchp = condition_case_1 (Qerror,
+                                        menu_accelerator_safe_mod_compare,
+                                        fake,
+                                        menu_accelerator_junk_on_error,
+                                        Qnil);
+             if (!NILP (matchp))
+               {
+                 /* we found one! */
+
+                 lw_set_menu (menubar_widget, val);
+                 /* yah - yet another hack.
+                    pretend emacs timestamp is the same as an X timestamp,
+                    which for the moment it is.  (read events.h)
+                    */
+                 lw_map_menu (XEVENT (event0)->timestamp);
+
+                 if (val->contents)
+                   lw_push_menu (val->contents);
+
+                 lw_display_menu (CurrentTime);
+
+                 /* menu accelerator keys don't go into keyboard macros */
+                 if (!NILP (con->defining_kbd_macro)
+                     && NILP (Vexecuting_macro))
+                   con->kbd_macro_ptr = con->kbd_macro_end;
+
+                 /* don't echo menu accelerator keys */
+                 /*reset_key_echo (builder, 1);*/
+                 reset_this_command_keys (Vselected_console, 1);
+                 UNGCPRO;
+
+                 return Vmenu_accelerator_map;
+               }
+           }
+
+         val = val->next;
+       }
+
+      UNGCPRO;
+    }
+  return Qnil;
+}
+
+int
+x_kludge_lw_menu_active (void)
+{
+  return lw_menu_active;
+}
+
+DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
+Make the menubar active.  Menu items can be selected using menu accelerators
+or by actions defined in menu-accelerator-map.
+*/
+       ())
+{
+  struct console *con = XCONSOLE (Vselected_console);
+  struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
+  LWLIB_ID id;
+  widget_value *val;
+
+  if (NILP (f->menubar_data))
+    error ("Frame has no menubar.");
+
+  id = XPOPUP_DATA (f->menubar_data)->id;
+  val = lw_get_all_values (id);
+  val = val->contents;
+  lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
+  lw_map_menu (CurrentTime);
+
+  lw_display_menu (CurrentTime);
+
+  /* menu accelerator keys don't go into keyboard macros */
+  if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
+    con->kbd_macro_ptr = con->kbd_macro_end;
+
+  return Qnil;
+}
+#endif /* LWLIB_MENUBARS_LUCID */
+
+\f
 void
 syms_of_menubar_x (void)
 {
+#if defined(LWLIB_MENUBARS_LUCID)
+  DEFSUBR (Faccelerate_menu);
+#endif
 }
 
 void
@@ -849,9 +1368,15 @@ console_type_create_menubar_x (void)
 }
 
 void
-vars_of_menubar_x (void)
+reinit_vars_of_menubar_x (void)
 {
   last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
+}
+
+void
+vars_of_menubar_x (void)
+{
+  reinit_vars_of_menubar_x ();
 
 #if defined (LWLIB_MENUBARS_LUCID)
   Fprovide (intern ("lucid-menubars"));