/* 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 "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)"

/* Current menu (bar or popup) descriptor. gcpro'ed */
static Lisp_Object current_menudesc;

/* Current menubar or popup hashtable. gcpro'ed */
static Lisp_Object current_hashtable;

/* 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, as the range is shared with toolbars
   (If only toolbars will be implemented as common controls) */
#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;

#define MAX_MENUITEM_LENGTH 128

/*
 * This returns Windows-style menu item string:
 * "Left Flush\tRight Flush"
 */
static char*
displayable_menu_item (struct gui_item* pgui_item)
{
  /* 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+2];
  unsigned int ll, lr;

  /* Left flush part of the string */
  ll = gui_item_display_flush_left (pgui_item, buf, MAX_MENUITEM_LENGTH);

  /* Right flush part */
  assert (MAX_MENUITEM_LENGTH > ll + 1);
  lr = gui_item_display_flush_right (pgui_item, buf + ll + 1,
				     MAX_MENUITEM_LENGTH - ll - 1);
  if (lr)
    buf [ll] = '\t';

  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, Lisp_Object suffix)
{
  UINT id = MENU_ITEM_ID_BITS (HASH3 (internal_hash (path, 0),
				      internal_hash (name, 0),
				      internal_hash (suffix, 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)
{
  return CreatePopupMenu ();
}

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);
}

/*
 * The idea of checksumming is that we must hash minimal object
 * which is neccessarily changes when the item changes. For separator
 * this is a constant, for grey strings and submenus these are hashes
 * of names, since sumbenus are unpopulated until opened so always
 * equal otherwise. For items, this is a full hash value of a callback,
 * because a callback may me a form which can be changed only somewhere
 * in depth.
 */
static unsigned long
checksum_menu_item (Lisp_Object item)
{
  if (STRINGP (item))
    {
      /* Separator or unselectable text - hash as a string + 13 */
      if (separator_string_p (XSTRING_DATA (item)))
	return 13;
      else
	return internal_hash (item, 0) + 13;
    }
  else if (CONSP (item))
    {
      /* Submenu - hash by its string name + 0 */
      return internal_hash (XCAR(item), 0);
    }
  else if (VECTORP (item))
    {
      /* An ordinary item - hash its name and callback form. */
      return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0),
		    internal_hash (XVECTOR_DATA(item)[1], 0));
    }
 
  /* An error - will be caught later */
  return 0;
}

static void
populate_menu_add_item (HMENU menu, Lisp_Object path,
			Lisp_Object hash_tab, Lisp_Object item, int flush_right)
{
  MENUITEMINFO item_info;

  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 */
      HMENU submenu;
      struct gui_item gui_item;
      struct gcpro gcpro1;

      gui_item_init (&gui_item);
      GCPRO1 (gui_item);
      gcpro1.nvars = GUI_ITEM_GCPRO_COUNT;

      menu_parse_submenu_keywords (item, &gui_item);

      if (!STRINGP (gui_item.name))
	signal_simple_error ("Menu name (first element) must be a string", item);

      if (!gui_item_included_p (&gui_item, Vmenubar_configuration))
	return;

      if (!gui_item_active_p (&gui_item))
	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 = displayable_menu_item (&gui_item);
      item_info.hSubMenu = submenu;

      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))
	    /* list1 cannot GC */
	    path = list1 (gui_item.name);
	  else
	    {
	      Lisp_Object arg[2] = { path, list1 (gui_item.name) };
	      /* Fappend gcpro'es its arg */
	      path = Fappend (2, arg);
	    }

	  /* Fputhash GCPRO'es PATH */
	  Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab);
	}
      UNGCPRO; /* gui_item */
    } 
  else if (VECTORP (item))
    {
      /* An ordinary item */
      Lisp_Object style, id;
      struct gui_item gui_item;
      struct gcpro gcpro1;

      gui_item_init (&gui_item);
      GCPRO1 (gui_item);
      gcpro1.nvars = GUI_ITEM_GCPRO_COUNT;

      gui_parse_item_keywords (item, &gui_item);

      if (!gui_item_included_p (&gui_item, Vmenubar_configuration))
	return;

      if (!gui_item_active_p (&gui_item))
	item_info.fState = MFS_GRAYED;

      style = (NILP (gui_item.selected) || NILP (Feval (gui_item.selected))
	       ? Qnil : gui_item.style);

      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, gui_item.name,
				  gui_item.suffix);
      Fputhash (id, gui_item.callback, hash_tab);

      item_info.wID = (UINT) XINT(id);
      item_info.fType |= MFT_STRING;
      item_info.dwTypeData = displayable_menu_item (&gui_item);

      UNGCPRO; /* gui_item */
    }
  else
    {
      signal_simple_error ("Mailformed menu item descriptor", item);
    }

  if (flush_right)
    item_info.fType |= MFT_RIGHTJUSTIFY;

  InsertMenuItem (menu, UINT_MAX, TRUE, &item_info);
}  

/*
 * This function is called from populate_menu and checksum_menu.
 * When called to populate, MENU is a menu handle, PATH is a
 * list of strings representing menu path from root to this submenu,
 * DESCRIPTOR is a menu descriptor, HASH_TAB is a hashtable associated
 * with root menu, BAR_P indicates whether this called for a menubar or
 * a popup, and POPULATE_P is non-zero. Return value must be ignored.
 * When called to checksum, DESCRIPTOR has the same meaning, POPULATE_P
 * is zero, PATH must be Qnil, and the rest of parameters is ignored.
 * Return value is the menu checksum.
 */
static unsigned long
populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc,
			     Lisp_Object hash_tab, int bar_p, int populate_p)
{
  Lisp_Object item_desc;
  int deep_p, flush_right;
  struct gcpro gcpro1;
  unsigned long checksum = 0;
  struct gui_item gui_item;

  gui_item_init (&gui_item);
  GCPRO1 (gui_item);
  gcpro1.nvars = GUI_ITEM_GCPRO_COUNT;

  /* Will initially contain only "(empty)" */
  if (populate_p)
    empty_menu (menu, 1);

  /* PATH set to nil indicates top-level popup or menubar */
  deep_p = !NILP (path);

  /* Fetch keywords prepending the item list */
  desc = menu_parse_submenu_keywords (desc, &gui_item);

  /* Check that menu name is specified when expected */
  if (NILP (gui_item.name) && deep_p)
    signal_simple_error ("Menu must have a name", desc);

  /* Apply filter if specified */
  if (!NILP (gui_item.filter))
    desc = call1 (gui_item.filter, desc);

  /* Loop thru the desc's CDR and add items for each entry */
  flush_right = 0;
  EXTERNAL_LIST_LOOP (item_desc, desc)
    {
      if (NILP (XCAR (item_desc)))
	{
	  if (bar_p)
	    flush_right = 1;
	  if (!populate_p)
	    checksum = HASH2 (checksum, Qnil);
	}
      else if (populate_p)
	populate_menu_add_item (menu, path, hash_tab,
				XCAR (item_desc), flush_right);
      else
	checksum = HASH2 (checksum,
			  checksum_menu_item (XCAR (item_desc)));
    }
  
  if (populate_p)
    {
      /* 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(gui_item.name))
	{
	  CHECK_STRING (gui_item.name);
	  InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
		      0, XSTRING_DATA(gui_item.name));
	  InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
	  SetMenuDefaultItem (menu, 0, MF_BYPOSITION);
	}
    }
  UNGCPRO; /* gui_item */
  return checksum;
}

static void
populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc,
			     Lisp_Object hash_tab, int bar_p)
{
  populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1);
}

static unsigned long
checksum_menu (Lisp_Object desc)
{
  return populate_or_checksum_helper (NULL, Qnil, desc, Qunbound, 0, 0);
}

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);

  top_level_menu = menubar;

  if (NILP (desc) && menubar != NULL)
    {
      /* Menubar has gone */
      FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Qnil;
      SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL);
      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 bail out if the menubar has not changed */
  if (FRAME_MSWINDOWS_MENU_CHECKSUM(f) == checksum_menu (desc))
    return;

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));

  FRAME_MSWINDOWS_MENU_CHECKSUM(f) = checksum_menu (desc);
}

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 filters explicitely from
     mangling with the 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 */
  current_menudesc = Qnil;
  current_hashtable = Qnil;
  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;
  struct gcpro gcpro1;

  /* Find which guy is going to explode */
  path = Fgethash (hmenu_to_lisp_object (menu), current_hashtable, Qunbound);
  assert (!UNBOUNDP (path));
#ifdef DEBUG_XEMACS
  /* Allow to continue in a debugger after assert - not so fatal */
  if (UNBOUNDP (path))
    error ("internal menu error");
#endif

  /* Now find a desc chunk for it. If none, then probably menu open
     hook has played too much games around stuff */
  desc = Fmenu_find_real_submenu (current_menudesc, 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, current_hashtable, 0);
  UNGCPRO;
  return Qt;
}

static Lisp_Object
unsafe_handle_wm_initmenu_1 (struct frame* f)
{
  /* This function can call lisp */

  /* NOTE: This is called for the bar only, WM_INITMENU
     for popups is filtered out */

  /* #### - 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);

  current_menudesc = current_frame_menubar (f);
  current_hashtable = FRAME_MSWINDOWS_MENU_HASHTABLE(f);
  assert (HASHTABLEP (current_hashtable));

  return Qt;
}

/*
 * 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 command, funcsym, frame;
  struct gcpro gcpro1;

  command = Fgethash (make_int (id), current_hashtable, 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 (SYMBOLP (command))
      funcsym = Qcall_interactively;
  else if (CONSP (command))
      funcsym = Qeval;
  else
    signal_simple_error ("Callback must be either evallable form or a symbol",
			 command);

  XSETFRAME (frame, f);
  enqueue_misc_user_event (frame, funcsym, command);

  /* Needs good bump also, for WM_COMMAND may have been dispatched from
     mswindows_need_event, which will block again despite new command
     event has arrived */
  mswindows_enqueue_magic_event (FRAME_MSWINDOWS_HANDLE(f),
				 XM_BUMPQUEUE);
  
  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);
}

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 (HMENU hmenu, struct frame* f)
{
  /* Handle only frame menubar, ignore if from popup or system menu */
  if (GetMenu (FRAME_MSWINDOWS_HANDLE(f)) == hmenu)
    {
      wm_initmenu_frame = f;
      return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil);
    }
  return Qt;
}

/* #### This function goes away. Removing it now may
   interfere with pending patch 980128-jhar */
Lisp_Object
mswindows_handle_wm_exitmenuloop (struct frame* f)
{
  return Qt;
}


/*------------------------------------------------------------------------*/
/* Methods                                                                */
/*------------------------------------------------------------------------*/

static void
mswindows_update_frame_menubars (struct frame* f)
{
  /* #### KLUDGE. menubar.c calls us when the following
     condition is true:
	(f->menubar_changed || f->windows_changed)
     Is that much really necessary?
     */
  if (f->menubar_changed)
    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_menudesc = menu_desc;
  current_hashtable = Fmake_hashtable (make_int(10), Qequal);
  menu = create_empty_popup_menu();
  Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hashtable);
  top_level_menu = menu;
  
  ok = TrackPopupMenu (menu,
		       TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON,
		       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)
{
}

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_menudesc = Qnil;
  current_hashtable = Qnil;

  staticpro (&current_menudesc);
  staticpro (&current_hashtable);

  Fprovide (intern ("mswindows-menubars"));
}