--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/menubar-msw.c	Mon Aug 13 10:13:48 2007 +0200
@@ -0,0 +1,1045 @@
+/* Implements an elisp-programmable menubar -- Win32
+   Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+   Copyright (C) 1997 Kirill M. Katsnelson <kkm@kis.ru>
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* Autorship:
+   Initially written by kkm 12/24/97,
+   peeking into and copying stuff from menubar-x.c
+   */
+
+/* Algotirhm for handling menus is as follows. When window's menubar
+ * is created, current-menubar is not traversed in depth. Rather, only
+ * top level items, both items and pulldowns, are added to the
+ * menubar. Each pulldown is initially empty. When a pulldown is
+ * selected and about to open, corresponding element of
+ * current-menubar is found, and the newly open pulldown is
+ * populated. This is made again in the same non-recursive manner.
+ *
+ * This algorithm uses hash tables to find out element of the menu
+ * descriptor list given menu handle. The key is an opaque ptr data
+ * type, keeping menu handle, and the value is a list of strings
+ * representing the path from the root of the menu to the item
+ * descriptor. Each frame has an associated hashtable.
+ *
+ * Leaf items are assigned a unique id based on item's hash. When an
+ * item is selected, Windows sends back the id. Unfortunately, only
+ * low 16 bit of the ID are sent, and there's no way to get the 32-bit
+ * value. Yes, Win32 is just a different set of bugs than X! Aside
+ * from this blame, another hasing mechanism is required to map menu
+ * ids to commands (which are actually Lisp_Object's). This mapping is
+ * performed in the same hashtable, as the lifetime of both maps is
+ * exactly the same. This is unabmigous, as menu handles are
+ * represented by lisp opaques, while command ids are by lisp
+ * integers. The additional advantage for this is that command forms
+ * are automatically GC-protected, which is important because these
+ * may be transient forms generated by :filter functions.
+ *
+ * The hashtable is not allowed to grow too much; it is pruned
+ * whenever this is safe to do. This is done by re-creating the menu
+ * bar, and clearing and refilling the hash table from scratch.
+ *
+ * Popup menus are handled identially to pulldowns. A static hash
+ * table is used for popup menus, and lookup is made not in
+ * current-menubar but in a lisp form supplied to the `popup'
+ * function.
+ *
+ * Another Windows weirdness is that there's no way to tell that a
+ * popup has been dismissed without making selection. We need to know
+ * that to cleanup the popup menu hashtable, but this is not honestly
+ * doable using *documented* sequence of messages. Sticking to
+ * particular knowledge is bad because this may break in Windows NT
+ * 5.0, or Windows 98, or other future version. Instead, I allow the
+ * hashtables to hang around, and not clear them, unless WM_COMMAND is
+ * received. This is worthy some memory but more safe. Hacks welcome,
+ * anyways!
+ *
+ */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "commands.h"
+#include "console-msw.h"
+#include "emacsfns.h"
+#include "elhash.h"
+#include "event-msw.h"
+#include "events.h"
+#include "frame.h"
+#include "gui.h"
+#include "lisp.h"
+#include "menubar.h"
+#include "menubar-msw.h"
+#include "opaque.h"
+#include "window.h"
+
+#define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound))
+#define EMPTY_ITEM_NAME "(empty)"
+
+/* Qnil when there's no popup being tracked, or a descriptor
+   for the popup. gcpro'ed */
+static Lisp_Object current_tracking_popup;
+
+/* Current popup has table. Qnil when no popup. gcpro'ed */
+static Lisp_Object current_popup_hash_table;
+
+/* Bound by menubar.el */
+static Lisp_Object Qfind_menu_item;
+
+/* This is used to allocate unique ids to menu items.
+   Items ids are in MENU_ITEM_ID_MIN to MENU_ITEM_ID_MAX.
+   Allocation checks that the item is not already in
+   the TOP_LEVEL_MENU */
+/* #### defines go to gui-msw.h */
+#define MENU_ITEM_ID_MIN 0x8000
+#define MENU_ITEM_ID_MAX 0xFFFF
+#define MENU_ITEM_ID_BITS(x) ((x) & 0x7FFF | 0x8000)
+static HMENU top_level_menu;
+
+/* ============= THIS STUFF MIGHT GO SOMEWHERE ELSE ================= */
+
+/* All these functions are windows sys independent, and are candidates
+   to go to lisp code instead */
+
+/*
+ * DESCRIPTOR is a list in the form ({:keyword value}+ rest...).
+ * This function extracts all the key-value pairs into the newly
+ * created plist, and returns pointer to REST. Original list is not
+ * modified (heaven save!)
+ */
+Lisp_Object
+gui_parse_menu_keywords (Lisp_Object descriptor, Lisp_Object *plist)
+{
+  Lisp_Object pair, key, val;
+  *plist = Qnil;
+  LIST_LOOP (pair, descriptor)
+    {
+      if (!CONSP(pair))
+	signal_simple_error ("Mailformed gui entity descriptor", descriptor);
+      key = XCAR(pair);
+      if (!KEYWORDP (key))
+	return pair;
+      pair = XCDR (pair);
+      if (!CONSP(pair))
+	signal_simple_error ("Mailformed gui entity descriptor", descriptor);
+      val = XCAR (pair);
+      internal_plist_put (plist, key, val);
+    }
+  return pair;
+}
+
+/*
+ * DESC is a vector describing a menu item. The function returns menu
+ * item name in NAME, callback form in CALLBACK, and all key-values
+ * pairs in PLIST. For old-style vectors, the plist is faked.
+ */
+void
+gui_parse_button_descriptor (Lisp_Object desc, Lisp_Object *name, 
+			     Lisp_Object *callback, Lisp_Object *plist)
+{
+  int length = XVECTOR_LENGTH (desc);
+  Lisp_Object *contents = XVECTOR_DATA (desc);
+  int plist_p;
+
+  *name = Qnil;
+  *callback = Qnil;
+  *plist = Qnil;
+
+  if (length < 3)
+    signal_simple_error ("button descriptors must be at least 3 long", desc);
+
+  /* length 3:		[ "name" callback active-p ]
+     length 4:		[ "name" callback active-p suffix ]
+     		   or	[ "name" callback keyword  value  ]
+     length 5+:		[ "name" callback [ keyword value ]+ ]
+   */
+  plist_p = (length >= 5 || KEYWORDP (contents [2]));
+
+  *name = contents [0];
+  *callback = contents [1];
+
+  if (!plist_p)
+    /* the old way */
+    {
+      internal_plist_put (plist, Q_active, contents [2]);
+      if (length == 4)
+	internal_plist_put (plist, Q_suffix, contents [3]);
+    }
+  else
+    /* the new way */
+    {
+      int i;
+      if (length & 1)
+	signal_simple_error (
+		"button descriptor has an odd number of keywords and values",
+			     desc);
+
+      for (i = 2; i < length;)
+	{
+	  Lisp_Object key = contents [i++];
+	  Lisp_Object val = contents [i++];
+	  if (!KEYWORDP (key))
+	    signal_simple_error_2 ("not a keyword", key, desc);
+	  internal_plist_put (plist, key, val);
+	}
+    }    
+}
+
+/*
+ * Given PLIST of key-value pairs for a menu item or button, consult
+ * :included and :config properties (the latter against
+ * CONFLIST). Return value is non-zero when item should *not* appear.
+ */
+int
+gui_plist_says_item_excluded (Lisp_Object plist, Lisp_Object conflist)
+{
+  Lisp_Object tem;
+  /* This function can call lisp */
+
+  /* Evaluate :included first */
+  tem = internal_plist_get (plist, Q_included);
+  if (!UNBOUNDP (tem))
+    {
+      tem = Feval (tem);
+      if (NILP (tem))
+	return 1;
+    }
+
+  /* Do :config if conflist is given */
+  if (!NILP (conflist))
+    {
+      tem = internal_plist_get (plist, Q_config);
+      if (!UNBOUNDP (tem))
+	{
+	  tem = Fmemq (tem, conflist);
+	  if (NILP (tem))
+	    return 1;
+	}
+    }
+
+  return 0;
+}
+    
+/*
+ * Given PLIST of key-value pairs for a menu item or button, consult
+ * :active property. Return non-zero if the item is *inactive*
+ */
+int
+gui_plist_says_item_inactive (Lisp_Object plist)
+{
+  Lisp_Object tem;
+  /* This function can call lisp */
+
+  tem = internal_plist_get (plist, Q_active);
+  if (!UNBOUNDP (tem))
+    {
+      tem = Feval (tem);
+      if (NILP (tem))
+	return 1;
+    }
+
+  return 0;
+}
+
+/*
+ * Given PLIST of key-value pairs for a menu item or button, evaluate
+ * the form which is the value of :filter property. Filter function
+ * given DESC as argument. If there's no :filter property, DESC is
+ * returned, otherwise the value returned by the filter function is
+ * returned. 
+ */
+Lisp_Object
+gui_plist_apply_filter (Lisp_Object plist, Lisp_Object desc)
+{
+  Lisp_Object tem;
+  /* This function can call lisp */
+
+  tem = internal_plist_get (plist, Q_filter);
+  if (UNBOUNDP (tem))
+    return desc;
+  else
+    return call1 (tem, desc);
+}
+
+/*
+ * This is tricky because there's no menu item styles in Windows, only
+ * states: Each item may be given no checkmark, radio or check
+ * mark. This function returns required mark style as determined by
+ * PLIST. Return value is the value of :style property if the item is
+ * :seleted, or nil otherwise
+ */
+Lisp_Object
+gui_plist_get_current_style (Lisp_Object plist)
+{
+  Lisp_Object style, selected;
+  style = internal_plist_get (plist, Q_style);
+  if (UNBOUNDP (style) || NILP(style))
+    return Qnil;
+
+  selected = internal_plist_get (plist, Q_selected);
+  if (UNBOUNDP (selected) || NILP(Feval(selected)))
+    return Qnil;
+
+  return style;
+}
+
+Lisp_Object
+current_frame_menubar (CONST struct frame* f)
+{
+  struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
+  return symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
+}
+
+/* ============ END IF STUFF THAT MIGHT GO SOMEWHERE ELSE =============== */
+
+/* Change these together */
+#define MAX_MENUITEM_LENGTH 128
+#define DISPLAYABLE_MAX_MENUITEM_LENGTH "128"
+
+static void 
+signal_item_too_long (Lisp_Object name)
+{
+    signal_simple_error ("Menu item is longer than "
+			 DISPLAYABLE_MAX_MENUITEM_LENGTH
+			 " characters", name);
+}
+
+/* #### If this function returned (FLUSHLEFT . FLUSHRIGHT) it also
+   could be moved above that line - it becomes window system
+   independant */
+/*
+ * This returns Windows-style menu item string:
+ * "Left Flush\tRight Flush"
+ */
+static CONST char*
+plist_get_menu_item_name (Lisp_Object name, Lisp_Object callback, Lisp_Object plist)
+{
+  /* We construct the name in a static buffer. That's fine, beause
+     menu items longer than 128 chars are probably programming errors,
+     and better be caught than displayed! */
+  
+  static char buf[MAX_MENUITEM_LENGTH];
+  char* p = buf;
+  int buf_left = MAX_MENUITEM_LENGTH - 1;
+  Lisp_Object tem;
+
+  /* Get name first */
+  buf_left -= XSTRING_LENGTH (name);
+  if (buf_left < 0)
+    signal_item_too_long (name);
+  strcpy (p, XSTRING_DATA (name));
+  p += XSTRING_LENGTH (name);
+
+  /* Have suffix? */
+  tem = internal_plist_get (plist, Q_suffix);
+  if (!UNBOUNDP (tem))
+    {
+      if (!STRINGP (tem))
+	signal_simple_error (":suffix must be a string", tem);
+      buf_left -= XSTRING_LENGTH (tem) + 1;
+      if (buf_left < 0)
+	signal_item_too_long (name);
+      *p++ = ' ';
+      strcpy (p, XSTRING_DATA (tem));
+      p += XSTRING_LENGTH (tem);
+    }
+
+  /* Have keys? */
+  if (menubar_show_keybindings)
+    {
+      static char buf2 [1024];
+      buf2[0] = 0;
+
+      tem = internal_plist_get (plist, Q_keys);
+      if (!UNBOUNDP (tem))
+	{
+	  if (!STRINGP (tem))
+	    signal_simple_error (":keys must be a string", tem);
+	  if (XSTRING_LENGTH (tem) > sizeof (buf2) - 1)
+	    signal_item_too_long (name);
+	  strcpy (buf2, XSTRING_DATA (tem));
+	}
+      else if (SYMBOLP (callback))
+	{
+	  /* #### Warning, dependency here on current_buffer and point */
+	  /* #### I've borrowed this warning along with this code from
+	     menubar-x.c. What does that mean? -- kkm */
+	  where_is_to_char (callback, buf2);
+	}
+
+      if (buf2 [0])
+	{
+	  int n = strlen (buf2) + 1;
+	  buf_left -= n;
+	  if (buf_left < 0)
+	    signal_item_too_long (name);
+	  *p++ = '\t';
+	  strcpy (p, buf2);
+	  p += n-1;
+	}
+    }
+  
+  *p = 0;
+  return buf;
+}
+
+/*
+ * hmenu_to_lisp_object() returns an opaque ptr given menu handle.
+ */
+static Lisp_Object
+hmenu_to_lisp_object (HMENU hmenu)
+{
+  return make_opaque_ptr (hmenu);
+}
+
+/*
+ * Allocation tries a hash based on item's path and name first. This
+ * almost guarantees that the same item will override its old value in
+ * the hashtable rather than abandon it.
+ */
+static Lisp_Object
+allocate_menu_item_id (Lisp_Object path, Lisp_Object name)
+{
+  UINT id = MENU_ITEM_ID_BITS (HASH2 (internal_hash (path, 0),
+				      internal_hash (name, 0)));
+  do {
+      id = MENU_ITEM_ID_BITS (id + 1);
+  } while (GetMenuState (top_level_menu, id, MF_BYCOMMAND) != 0xFFFFFFFF);
+  return make_int (id);
+}
+
+static HMENU
+create_empty_popup_menu (void)
+{
+  HMENU submenu = CreatePopupMenu ();
+  /* #### It seems that really we do not need "(empty)" at this stage */
+#if 0
+  AppendMenu (submenu, MF_STRING | MF_GRAYED, EMPTY_ITEM_ID, EMPTY_ITEM_NAME);
+#endif
+  return submenu;
+}
+
+static void
+empty_menu (HMENU menu, int add_empty_p)
+{
+  while (DeleteMenu (menu, 0, MF_BYPOSITION));
+  if (add_empty_p)
+    AppendMenu (menu, MF_STRING | MF_GRAYED, EMPTY_ITEM_ID, EMPTY_ITEM_NAME);
+}
+
+static void
+populate_menu_add_item (HMENU menu, Lisp_Object path,
+			Lisp_Object hash_tab, Lisp_Object item, int flush_right)
+{
+  MENUITEMINFO item_info;
+  struct gcpro gcpro1, gcpro2;
+
+  item_info.cbSize = sizeof (item_info);
+  item_info.fMask = MIIM_TYPE | MIIM_STATE | MIIM_ID;
+  item_info.fState = 0;
+  item_info.wID = 0;
+  item_info.fType = 0;
+
+  if (STRINGP (item))
+    {
+      /* Separator or unselectable text */
+      if (separator_string_p (XSTRING_DATA (item)))
+	item_info.fType = MFT_SEPARATOR;
+      else
+	{
+	  item_info.fType = MFT_STRING;
+	  item_info.fState = MFS_DISABLED;
+	  item_info.dwTypeData = XSTRING_DATA (item);
+	}
+    }
+  else if (CONSP (item))
+    {
+      /* Submenu */
+      Lisp_Object subname = XCAR (item);
+      Lisp_Object plist;
+      HMENU submenu;
+	
+      if (!STRINGP (subname))
+	signal_simple_error ("menu name (first element) must be a string", item);
+
+      item = gui_parse_menu_keywords (XCDR (item), &plist);
+      GCPRO1 (plist);
+
+      if (gui_plist_says_item_excluded (plist, Vmenubar_configuration))
+	return;
+
+      if (gui_plist_says_item_inactive (plist))
+	item_info.fState = MFS_GRAYED;
+      /* Temptation is to put 'else' right here. Although, the
+	 displayed item won't have an arrow indicating that it is a
+	 popup.  So we go ahead a little bit more and create a popup */
+      submenu = create_empty_popup_menu();
+
+      item_info.fMask |= MIIM_SUBMENU;
+      item_info.dwTypeData = plist_get_menu_item_name (subname, Qnil, plist);
+      item_info.hSubMenu = submenu;
+
+      UNGCPRO; /* plist */
+
+      if (!(item_info.fState & MFS_GRAYED))
+	{
+	  /* Now add the full submenu path as a value to the hash table,
+	     keyed by menu handle */
+	  if (NILP(path))
+	    path = list1 (subname);
+	  else {
+	    Lisp_Object arg[2];
+	    arg[0] = path;
+	    arg[1] = list1 (subname);
+	    GCPRO1 (arg[1]);
+	    path = Fappend (2, arg);
+	    UNGCPRO; /* arg[1] */
+	  }
+
+	  GCPRO1 (path);
+	  Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab);
+	  UNGCPRO; /* path */
+	}
+    } 
+  else if (VECTORP (item))
+    {
+      /* An ordinary item */
+      Lisp_Object plist, name, callback, style, id;
+      
+      gui_parse_button_descriptor (item, &name, &callback, &plist);
+      GCPRO2 (plist, callback);
+
+      if (gui_plist_says_item_excluded (plist, Vmenubar_configuration))
+	return;
+
+      if (gui_plist_says_item_inactive (plist))
+	item_info.fState |= MFS_GRAYED;
+
+      style = gui_plist_get_current_style (plist);
+      if (EQ (style, Qradio))
+	{
+	  item_info.fType |= MFT_RADIOCHECK;
+	  item_info.fState |= MFS_CHECKED;
+	}
+      else if (EQ (style, Qtoggle))
+	{
+	  item_info.fState |= MFS_CHECKED;
+	}
+
+      id = allocate_menu_item_id (path, name);
+      Fputhash (id, callback, hash_tab);
+      
+      UNGCPRO; /* plist, callback */
+
+      item_info.wID = (UINT) XINT(id);
+      item_info.fType |= MFT_STRING;
+      item_info.dwTypeData = plist_get_menu_item_name (name, callback, plist);
+    }
+  else
+    {
+      signal_simple_error ("ill-constructed menu descriptor", item);
+    }
+
+  if (flush_right)
+    item_info.fType |= MFT_RIGHTJUSTIFY;
+
+  InsertMenuItem (menu, UINT_MAX, TRUE, &item_info);
+}  
+
+static void
+populate_menu (HMENU menu, Lisp_Object path, Lisp_Object descriptor,
+	       Lisp_Object hash_tab, int bar_p)
+{
+  Lisp_Object menu_name, plist, item_desc;
+  int deep_p, flush_right;
+  struct gcpro gcpro1;
+
+  /* Will initially contain only "(empty)" */
+  empty_menu (menu, 1);
+
+  /* PATH set to nil indicates top-level popup or menubar */
+  deep_p = !NILP (path);
+
+  if (!deep_p)
+    top_level_menu = menu;
+
+  if (!CONSP(descriptor))
+    signal_simple_error ("menu descriptor must be a list", descriptor);
+
+  if (STRINGP (XCAR (descriptor)))
+    {
+      menu_name = XCAR (descriptor);
+      descriptor = XCDR (descriptor);
+    }
+  else
+    {
+      menu_name = Qnil;
+      if (deep_p) /* Not a popup or bar */
+	signal_simple_error ("menu must have a name", descriptor);
+    }
+
+  /* Fetch keywords prepending the item list */
+  descriptor = gui_parse_menu_keywords (descriptor, &plist);
+  GCPRO1 (plist);
+  descriptor = gui_plist_apply_filter (plist, descriptor);
+  UNGCPRO; /* plist */
+  
+  /* Loop thru the descriptor's CDR and add items for each entry */
+  flush_right = 0;
+  EXTERNAL_LIST_LOOP (item_desc, descriptor)
+    {
+      if (NILP (XCAR (item_desc)))
+	{
+	  if (bar_p)
+	    flush_right = 1;
+	}
+      else
+	populate_menu_add_item (menu, path, hash_tab,
+				XCAR (item_desc), flush_right);
+    }
+  
+  /* Remove the "(empty)" item, if there are other ones */
+  if (GetMenuItemCount (menu) > 1)
+    RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND);
+
+  /* Add the header to the popup, if told so. The same as in X - an
+     insensitive item, and a separator (Seems to me, there were
+     two separators in X... In Windows this looks ugly, anywats. */
+  if (!bar_p && !deep_p && popup_menu_titles && !NILP(menu_name))
+    {
+      InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
+		  0, XSTRING_DATA(menu_name));
+      InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
+      SetMenuDefaultItem (menu, 0, MF_BYPOSITION);
+    }
+}
+
+static Lisp_Object
+find_menu (Lisp_Object desc, Lisp_Object path)
+{
+  /* #### find-menu-item is not what's required here. 
+     Need to write this in C, or improve lisp */
+  if (!NILP (path))
+    {
+      desc = call2 (Qfind_menu_item, desc, path);
+      /* desc is (supposed to be) (ITEM . PARENT). Supposed
+         to signal but sometimes manages to return nil */
+      if (!NILP(desc))
+	{
+	  CHECK_CONS (desc);
+	  desc = XCAR (desc);
+	}
+    }
+  return desc;
+}
+
+static void
+update_frame_menubar_maybe (struct frame* f)
+{
+  HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f));
+  struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
+  Lisp_Object desc = (!NILP (w->menubar_visible_p)
+		      ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer)
+		      : Qnil);
+
+  if (NILP (desc) && menubar != NULL)
+    {
+      /* Menubar has gone */
+      FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Qnil;
+      DestroyMenu (menubar);
+      DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
+      return;
+    }
+
+  if (!NILP (desc) && menubar == NULL)
+    {
+      /* Menubar has appeared */
+      menubar = CreateMenu ();
+      goto populate;
+    }
+
+  if (NILP (desc))
+    {
+      /* We did not have the bar and are not going to */
+      return;
+    }
+
+  /* Now we have to check if the menubar has really changed */
+  /* #### For now we do not though */
+
+  /* We cannot re-create the menu, cause WM_INITMENU does not like that.
+     We'll clear it instead. */
+  empty_menu (menubar, 0);
+
+populate:
+  /* Come with empty hash table */
+  if (NILP (FRAME_MSWINDOWS_MENU_HASHTABLE(f)))
+    FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Fmake_hashtable (make_int (50), Qequal);
+  else
+    Fclrhash (FRAME_MSWINDOWS_MENU_HASHTABLE(f));
+
+  Fputhash (hmenu_to_lisp_object (menubar), Qnil,
+	    FRAME_MSWINDOWS_MENU_HASHTABLE(f));
+  populate_menu (menubar, Qnil, desc,
+		 FRAME_MSWINDOWS_MENU_HASHTABLE(f), 1);
+  SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar);
+  DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
+}
+
+static void
+prune_menubar (struct frame *f)
+{
+  HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f));
+  Lisp_Object desc = current_frame_menubar (f);
+  if (menubar == NULL)
+    return;
+
+  /* #### If a filter function has set desc to Qnil, this abort()
+     triggers. To resolve, we must prevent explicitely filters from
+     mangling with te active menu. In apply_filter probably?
+     Is copy-tree on the whole menu too expensive? */
+  if (NILP(desc))
+    /* abort(); */
+    return;
+
+  /* We do the trick by removing all items and re-populating top level */
+  empty_menu (menubar, 0);
+
+  assert (HASHTABLEP (FRAME_MSWINDOWS_MENU_HASHTABLE(f)));
+  Fclrhash (FRAME_MSWINDOWS_MENU_HASHTABLE(f));
+
+  Fputhash (hmenu_to_lisp_object (menubar), Qnil,
+	    FRAME_MSWINDOWS_MENU_HASHTABLE(f));
+  populate_menu (menubar, Qnil, desc, 
+		 FRAME_MSWINDOWS_MENU_HASHTABLE(f), 1);
+}
+
+/*
+ * This is called when cleanup is possible. It is better not to
+ * clean things up at all than do it too earaly!
+ */
+static void
+menu_cleanup (struct frame *f)
+{
+  /* This function can GC */
+  if (!NILP (current_tracking_popup))
+    {
+      current_tracking_popup = Qnil;
+      current_popup_hash_table = Qnil;
+    }
+  else
+    prune_menubar (f);
+}
+  
+
+/*------------------------------------------------------------------------*/
+/* Message handlers                                                       */
+/*------------------------------------------------------------------------*/
+static Lisp_Object
+unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame* f)
+{
+  /* This function can call lisp, beat dogs and stick chewing gum to
+     everything! */
+
+  Lisp_Object path, desc, hash_tab;
+  struct gcpro gcpro1;
+
+  if (!NILP (current_tracking_popup))
+    {
+      desc = current_tracking_popup;
+      hash_tab = current_popup_hash_table;
+    }
+  else
+    {
+      desc = current_frame_menubar (f);
+      hash_tab = FRAME_MSWINDOWS_MENU_HASHTABLE(f);
+    }
+
+  /* Find which guy is going to explode */
+  path = Fgethash (hmenu_to_lisp_object (menu), hash_tab, Qunbound);
+  assert (!UNBOUNDP (path));
+
+  /* Now find a desc chunk for it. If none, then probably menu open
+     hook has played too much games around stuff */
+  if (!NILP (path))
+    {
+      desc = find_menu (desc, path);
+      if (NILP (desc))
+	signal_simple_error ("this menu does not exist any more", path);
+    }
+
+  /* Now, stuff it */
+  /* DESC may be generated by filter, so we have to gcpro it */
+  GCPRO1 (desc);
+  populate_menu (menu, path, desc, hash_tab, 0);
+  UNGCPRO;
+  return Qt;
+}
+
+static Lisp_Object
+unsafe_handle_wm_initmenu_1 (struct frame* f)
+{
+  /* This function can call lisp */
+  /* #### - this menubar update mechanism is expensively anti-social and
+     the activate-menubar-hook is now mostly obsolete. */
+
+  /* We simply ignore return value. In any case, we construct the bar
+     on the fly */
+  run_hook (Vactivate_menubar_hook);
+  
+  update_frame_menubar_maybe (f);
+  return Qt;
+}
+
+
+#ifdef KKM_DOES_NOT_LIKE_UNDOCS_SOMETIMES
+
+/* #### This may become wrong in future Windows */
+
+static Lisp_Object
+unsafe_handle_wm_exitmenuloop_1 (struct frame* f)
+{
+  if (!NILP (current_tracking_popup))
+    prune_menubar (f);
+  return Qt;
+}
+
+#endif
+
+/*
+ * Return value is Qt if we have dispatched the command,
+ * or Qnil if id has not been mapped to a callback.
+ * Window procedure may try other targets to route the
+ * command if we return nil
+ */
+Lisp_Object
+mswindows_handle_wm_command (struct frame* f, WORD id)
+{
+  /* Try to map the command id through the proper hash table */
+  Lisp_Object hash_tab, command, funcsym, frame;
+  struct gcpro gcpro1;
+
+  if (!NILP (current_tracking_popup))
+    hash_tab = current_popup_hash_table;
+  else
+    hash_tab = FRAME_MSWINDOWS_MENU_HASHTABLE(f);
+
+  command = Fgethash (make_int (id), hash_tab, Qunbound);
+  if (UNBOUNDP (command))
+    {
+      menu_cleanup (f);
+      return Qnil;
+    }
+
+  /* Need to gcpro because the hashtable may get destroyed
+     by menu_cleanup(), and will not gcpro the command
+     any more */
+  GCPRO1 (command);
+  menu_cleanup (f);
+
+  /* Ok, this is our one. Enqueue it. */
+#if 0
+  if (SYMBOLP (command))
+    Fcall_interactively (command, Qnil, Qnil);
+  else if (CONSP (command))
+    Feval (command);
+  else
+    signal_simple_error ("illegal callback", command);
+#endif
+  if (SYMBOLP (command))
+      funcsym = Qcall_interactively;
+  else if (CONSP (command))
+      funcsym = Qeval;
+  else
+    signal_simple_error ("illegal callback", command);
+
+  XSETFRAME (frame, f);
+  enqueue_misc_user_event (frame, funcsym, command);
+  
+  UNGCPRO; /* command */
+  return Qt;
+}
+
+
+/*------------------------------------------------------------------------*/
+/* Message handling proxies                                               */
+/*------------------------------------------------------------------------*/
+
+static HMENU wm_initmenu_menu;
+static struct frame* wm_initmenu_frame;
+
+static Lisp_Object
+unsafe_handle_wm_initmenupopup (Lisp_Object u_n_u_s_e_d)
+{
+  return unsafe_handle_wm_initmenupopup_1 (wm_initmenu_menu, wm_initmenu_frame);
+}
+
+static Lisp_Object
+unsafe_handle_wm_initmenu (Lisp_Object u_n_u_s_e_d)
+{
+  return unsafe_handle_wm_initmenu_1 (wm_initmenu_frame);
+}
+
+#ifdef KKM_DOES_NOT_LIKE_UNDOCS_SOMETIMES
+static Lisp_Object
+unsafe_handle_wm_exitmenuloop (Lisp_Object u_n_u_s_e_d)
+{
+  return unsafe_handle_wm_exitmenuloop_1 (wm_initmenu_frame);
+}
+#endif
+
+Lisp_Object
+mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame* frm)
+{
+  /* We cannot pass hmenu as a lisp object. Use static var */
+  wm_initmenu_menu = hmenu;
+  wm_initmenu_frame = frm;
+  return mswindows_protect_modal_loop (unsafe_handle_wm_initmenupopup, Qnil);
+}
+
+Lisp_Object
+mswindows_handle_wm_initmenu (struct frame* f)
+{
+  wm_initmenu_frame = f;
+  return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil);
+}
+
+Lisp_Object
+mswindows_handle_wm_exitmenuloop (struct frame* f)
+{
+#ifdef KKM_DOES_NOT_LIKE_UNDOCS_SOMETIMES
+  wm_initmenu_frame = f;
+  return mswindows_protect_modal_loop (unsafe_handle_wm_exitmenuloop, Qnil);
+#else
+  return Qt;
+#endif
+}
+
+
+/*------------------------------------------------------------------------*/
+/* Methods                                                                */
+/*------------------------------------------------------------------------*/
+
+static void
+mswindows_update_frame_menubars (struct frame* f)
+{
+  update_frame_menubar_maybe (f);
+}
+
+static void
+mswindows_free_frame_menubars (struct frame* f)
+{
+  FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Qnil;
+}
+
+static void
+mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
+{
+  struct frame *f = selected_frame ();
+  struct Lisp_Event *eev = NULL;
+  HMENU menu;
+  POINT pt;
+  int ok;
+
+  if (!NILP (event))
+    {
+      CHECK_LIVE_EVENT (event);
+      eev = XEVENT (event);
+      if (eev->event_type != button_press_event
+	  && eev->event_type != button_release_event)
+	wrong_type_argument (Qmouse_event_p, event);
+    }
+  else if (!NILP (Vthis_command_keys))
+    {
+      /* if an event wasn't passed, use the last event of the event sequence
+	 currently being executed, if that event is a mouse event */
+      eev = XEVENT (Vthis_command_keys); /* last event first */
+      if (eev->event_type != button_press_event
+	  && eev->event_type != button_release_event)
+	eev = NULL;
+    }
+
+  /* Default is to put the menu at the point (10, 10) in frame */
+  if (eev)
+    {
+      pt.x = eev->event.button.x;
+      pt.y = eev->event.button.y;
+      ClientToScreen (FRAME_MSWINDOWS_HANDLE (f), &pt);
+    }
+  else
+    pt.x = pt.y = 10;
+
+  if (SYMBOLP (menu_desc))
+    menu_desc = Fsymbol_value (menu_desc);
+
+  current_tracking_popup = menu_desc;
+  current_popup_hash_table = Fmake_hashtable (make_int(10), Qequal);
+  menu = create_empty_popup_menu();
+  Fputhash (hmenu_to_lisp_object (menu), Qnil, current_popup_hash_table);
+  
+  ok = TrackPopupMenu (menu, TPM_LEFTALIGN | TPM_LEFTBUTTON,
+		       pt.x, pt.y, 0,
+		       FRAME_MSWINDOWS_HANDLE (f), NULL);
+
+  DestroyMenu (menu);
+
+  /* Signal a signal if caught by Track...() modal loop */
+  mswindows_unmodalize_signal_maybe ();
+
+  /* This is probably the only real reason for failure */
+  if (!ok) {
+    menu_cleanup (f);
+    signal_simple_error ("cannot track popup menu while in menu",
+			 menu_desc);
+  }
+}
+
+
+/*------------------------------------------------------------------------*/
+/* Initialization                                                         */
+/*------------------------------------------------------------------------*/
+void
+syms_of_menubar_mswindows (void)
+{
+  defsymbol (&Qfind_menu_item, "find-menu-item");
+}
+
+void
+console_type_create_menubar_mswindows (void)
+{
+  CONSOLE_HAS_METHOD (mswindows, update_frame_menubars);
+  CONSOLE_HAS_METHOD (mswindows, free_frame_menubars);
+  CONSOLE_HAS_METHOD (mswindows, popup_menu);
+}
+
+void
+vars_of_menubar_mswindows (void)
+{
+  current_tracking_popup = Qnil;
+  current_popup_hash_table = Qnil;
+
+  staticpro (&current_tracking_popup);
+  staticpro (&current_popup_hash_table);
+
+  Fprovide (intern ("mswindows-menubars"));
+}