XEmacs 21.2.28 "Hermes".
[chise/xemacs-chise.git.1] / src / menubar-msw.c
index bc47b7f..d25ccc6 100644 (file)
@@ -22,12 +22,12 @@ Boston, MA 02111-1307, USA.  */
 
 /* Synched up with: Not in FSF. */
 
-/* Autorship:
+/* Author:
    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
+/* Algorithm 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
@@ -39,37 +39,37 @@ Boston, MA 02111-1307, USA.  */
  * 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.
+ * descriptor. Each frame has an associated hash table.
  *
  * 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
+ * from this blame, another hashing 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
+ * performed in the same hash table, as the lifetime of both maps is
+ * exactly the same. This is unambigous, 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
+ * The hash table 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
+ * Popup menus are handled identically 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
+ * that to cleanup the popup menu hash table, 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
+ * hash tables to hang around, and not clear them, unless WM_COMMAND is
  * received. This is worthy some memory but more safe. Hacks welcome,
  * anyways!
  *
@@ -101,8 +101,8 @@ Boston, MA 02111-1307, USA.  */
 /* 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;
+/* Current menubar or popup hash table. gcpro'ed */
+static Lisp_Object current_hash_table;
 
 /* This is used to allocate unique ids to menu items.
    Items ids are in MENU_ITEM_ID_MIN to MENU_ITEM_ID_MAX.
@@ -116,31 +116,58 @@ static Lisp_Object current_hashtable;
 #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)
+displayable_menu_item (Lisp_Object gui_item, int bar_p)
 {
-  /* We construct the name in a static buffer. That's fine, beause
+  /* We construct the name in a static buffer. That's fine, because
      menu items longer than 128 chars are probably programming errors,
      and better be caught than displayed! */
   
   static char buf[MAX_MENUITEM_LENGTH+2];
+  char *ptr;
   unsigned int ll, lr;
 
   /* Left flush part of the string */
-  ll = gui_item_display_flush_left (pgui_item, buf, MAX_MENUITEM_LENGTH);
+  ll = gui_item_display_flush_left (gui_item, buf, MAX_MENUITEM_LENGTH);
+
+  /* Escape '&' as '&&' */
+  ptr = buf;
+  while ((ptr=memchr (ptr, '&', ll-(ptr-buf))) != NULL)
+    {
+      if (ll+2 >= MAX_MENUITEM_LENGTH)
+       signal_simple_error ("Menu item produces too long displayable string",
+                            XGUI_ITEM (gui_item)->name);
+      memmove (ptr+1, ptr, (ll-(ptr-buf))+1);
+      ll++;
+      ptr+=2;
+    }
+
+  /* Replace XEmacs accelerator '%_' with Windows accelerator '&' */
+  ptr = buf;
+  while ((ptr=memchr (ptr, '%', ll-(ptr-buf))) != NULL)
+    {
+      if (*(ptr+1) == '_')
+       {
+         *ptr = '&';
+         memmove (ptr+1, ptr+2, ll-(ptr-buf+2));
+         ll--;
+       }
+      ptr++;
+    }
 
-  /* 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';
+  /* Right flush part, unless we're at the top-level where it's not allowed */
+  if (!bar_p)
+    {
+      assert (MAX_MENUITEM_LENGTH > ll + 1);
+      lr = gui_item_display_flush_right (gui_item, buf + ll + 1,
+                                        MAX_MENUITEM_LENGTH - ll - 1);
+      if (lr)
+       buf [ll] = '\t';
+     }
 
   return buf;
 }
@@ -157,7 +184,7 @@ hmenu_to_lisp_object (HMENU 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.
+ * the hash table rather than abandon it.
  */
 static Lisp_Object
 allocate_menu_item_id (Lisp_Object path, Lisp_Object name, Lisp_Object suffix)
@@ -187,9 +214,9 @@ empty_menu (HMENU menu, int add_empty_p)
 
 /*
  * The idea of checksumming is that we must hash minimal object
- * which is neccessarily changes when the item changes. For separator
+ * which is necessarily 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
+ * of names, since submenus 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.
@@ -223,7 +250,8 @@ checksum_menu_item (Lisp_Object item)
 
 static void
 populate_menu_add_item (HMENU menu, Lisp_Object path,
-                       Lisp_Object hash_tab, Lisp_Object item, int flush_right)
+                       Lisp_Object hash_tab, Lisp_Object item,
+                       int flush_right, int bar_p)
 {
   MENUITEMINFO item_info;
 
@@ -249,21 +277,21 @@ populate_menu_add_item (HMENU menu, Lisp_Object path,
     {
       /* Submenu */
       HMENU submenu;
-      struct gui_item gui_item;
+      Lisp_Object gui_item = allocate_gui_item ();
+      Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item);
       struct gcpro gcpro1;
 
-      gui_item_init (&gui_item);
-      GCPRO_GUI_ITEM (&gui_item);
+      GCPRO1 (gui_item);
 
-      menu_parse_submenu_keywords (item, &gui_item);
+      menu_parse_submenu_keywords (item, gui_item);
 
-      if (!STRINGP (gui_item.name))
+      if (!STRINGP (pgui_item->name))
        signal_simple_error ("Menu name (first element) must be a string", item);
 
-      if (!gui_item_included_p (&gui_item, Vmenubar_configuration))
+      if (!gui_item_included_p (gui_item, Vmenubar_configuration))
        return;
 
-      if (!gui_item_active_p (&gui_item))
+      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
@@ -271,7 +299,7 @@ populate_menu_add_item (HMENU menu, Lisp_Object path,
       submenu = create_empty_popup_menu();
 
       item_info.fMask |= MIIM_SUBMENU;
-      item_info.dwTypeData = displayable_menu_item (&gui_item);
+      item_info.dwTypeData = displayable_menu_item (gui_item, bar_p);
       item_info.hSubMenu = submenu;
 
       if (!(item_info.fState & MFS_GRAYED))
@@ -280,12 +308,12 @@ populate_menu_add_item (HMENU menu, Lisp_Object path,
             keyed by menu handle */
          if (NILP(path))
            /* list1 cannot GC */
-           path = list1 (gui_item.name);
+           path = list1 (pgui_item->name);
          else
            {
              Lisp_Object arg[2];
              arg[0] = path;
-             arg[1] = list1 (gui_item.name);
+             arg[1] = list1 (pgui_item->name);
              /* Fappend gcpro'es its arg */
              path = Fappend (2, arg);
            }
@@ -299,22 +327,20 @@ populate_menu_add_item (HMENU menu, Lisp_Object path,
     {
       /* An ordinary item */
       Lisp_Object style, id;
-      struct gui_item gui_item;
+      Lisp_Object gui_item = gui_parse_item_keywords (item);
+      Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item);
       struct gcpro gcpro1;
 
-      gui_item_init (&gui_item);
-      GCPRO_GUI_ITEM (&gui_item);
-
-      gui_parse_item_keywords (item, &gui_item);
+      GCPRO1 (gui_item);
 
-      if (!gui_item_included_p (&gui_item, Vmenubar_configuration))
+      if (!gui_item_included_p (gui_item, Vmenubar_configuration))
        return;
 
-      if (!gui_item_active_p (&gui_item))
+      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);
+      style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected))
+              ? Qnil : pgui_item->style);
 
       if (EQ (style, Qradio))
        {
@@ -326,19 +352,19 @@ populate_menu_add_item (HMENU menu, Lisp_Object path,
          item_info.fState |= MFS_CHECKED;
        }
 
-      id = allocate_menu_item_id (path, gui_item.name,
-                                 gui_item.suffix);
-      Fputhash (id, gui_item.callback, hash_tab);
+      id = allocate_menu_item_id (path, pgui_item->name,
+                                 pgui_item->suffix);
+      Fputhash (id, pgui_item->callback, hash_tab);
 
       item_info.wID = (UINT) XINT(id);
       item_info.fType |= MFT_STRING;
-      item_info.dwTypeData = displayable_menu_item (&gui_item);
+      item_info.dwTypeData = displayable_menu_item (gui_item, bar_p);
 
       UNGCPRO; /* gui_item */
     }
   else
     {
-      signal_simple_error ("Mailformed menu item descriptor", item);
+      signal_simple_error ("Malformed menu item descriptor", item);
     }
 
   if (flush_right)
@@ -351,7 +377,7 @@ populate_menu_add_item (HMENU menu, Lisp_Object path,
  * 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
+ * DESCRIPTOR is a menu descriptor, HASH_TAB is a hash table 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
@@ -366,13 +392,12 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc,
   int deep_p, flush_right;
   struct gcpro gcpro1;
   unsigned long checksum;
-  struct gui_item gui_item;
-
-  gui_item_init (&gui_item);
-  GCPRO_GUI_ITEM (&gui_item);
+  Lisp_Object gui_item = allocate_gui_item ();
+  Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item);
+  GCPRO1 (gui_item);
 
   /* We are sometimes called with the menubar unchanged, and with changed
-     right flush. We have to update the menubar in ths case,
+     right flush. We have to update the menubar in this case,
      so account for the compliance setting in the hash value */
   checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH;
 
@@ -384,15 +409,15 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc,
   deep_p = !NILP (path);
 
   /* Fetch keywords prepending the item list */
-  desc = menu_parse_submenu_keywords (desc, &gui_item);
+  desc = menu_parse_submenu_keywords (desc, gui_item);
 
   /* Check that menu name is specified when expected */
-  if (NILP (gui_item.name) && deep_p)
+  if (NILP (pgui_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);
+  if (!NILP (pgui_item->filter))
+    desc = call1 (pgui_item->filter, desc);
 
   /* Loop thru the desc's CDR and add items for each entry */
   flush_right = 0;
@@ -400,7 +425,7 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc,
     {
       if (NILP (XCAR (item_desc)))
        {
-         /* Do not flush right menubar items when MS style compiant */
+         /* Do not flush right menubar items when MS style compliant */
          if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH)
            flush_right = 1;
          if (!populate_p)
@@ -408,7 +433,7 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc,
        }
       else if (populate_p)
        populate_menu_add_item (menu, path, hash_tab,
-                               XCAR (item_desc), flush_right);
+                               XCAR (item_desc), flush_right, bar_p);
       else
        checksum = HASH2 (checksum,
                          checksum_menu_item (XCAR (item_desc)));
@@ -422,12 +447,12 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc,
 
       /* 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))
+        two separators in X... In Windows this looks ugly, anyways. */
+      if (!bar_p && !deep_p && popup_menu_titles && !NILP(pgui_item->name))
        {
-         CHECK_STRING (gui_item.name);
+         CHECK_STRING (pgui_item->name);
          InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
-                     0, XSTRING_DATA(gui_item.name));
+                     0, XSTRING_DATA(pgui_item->name));
          InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
          SetMenuDefaultItem (menu, 0, MF_BYPOSITION);
        }
@@ -463,7 +488,7 @@ update_frame_menubar_maybe (struct frame* f)
   if (NILP (desc) && menubar != NULL)
     {
       /* Menubar has gone */
-      FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Qnil;
+      FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = Qnil;
       SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL);
       DestroyMenu (menubar);
       DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
@@ -489,15 +514,16 @@ update_frame_menubar_maybe (struct frame* f)
 
 populate:
   /* Come with empty hash table */
-  if (NILP (FRAME_MSWINDOWS_MENU_HASHTABLE(f)))
-    FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Fmake_hashtable (make_int (50), Qequal);
+  if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE(f)))
+    FRAME_MSWINDOWS_MENU_HASH_TABLE(f) =
+      make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
   else
-    Fclrhash (FRAME_MSWINDOWS_MENU_HASHTABLE(f));
+    Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE(f));
 
   Fputhash (hmenu_to_lisp_object (menubar), Qnil,
-           FRAME_MSWINDOWS_MENU_HASHTABLE(f));
+           FRAME_MSWINDOWS_MENU_HASH_TABLE(f));
   populate_menu (menubar, Qnil, desc,
-                FRAME_MSWINDOWS_MENU_HASHTABLE(f), 1);
+                FRAME_MSWINDOWS_MENU_HASH_TABLE(f), 1);
   SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar);
   DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
 
@@ -513,7 +539,7 @@ prune_menubar (struct frame *f)
     return;
 
   /* #### If a filter function has set desc to Qnil, this abort()
-     triggers. To resolve, we must prevent filters explicitely from
+     triggers. To resolve, we must prevent filters explicitly from
      mangling with the active menu. In apply_filter probably?
      Is copy-tree on the whole menu too expensive? */
   if (NILP(desc))
@@ -523,25 +549,25 @@ prune_menubar (struct frame *f)
   /* 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));
+  assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE(f)));
+  Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE(f));
 
   Fputhash (hmenu_to_lisp_object (menubar), Qnil,
-           FRAME_MSWINDOWS_MENU_HASHTABLE(f));
+           FRAME_MSWINDOWS_MENU_HASH_TABLE(f));
   populate_menu (menubar, Qnil, desc, 
-                FRAME_MSWINDOWS_MENU_HASHTABLE(f), 1);
+                FRAME_MSWINDOWS_MENU_HASH_TABLE(f), 1);
 }
 
 /*
  * This is called when cleanup is possible. It is better not to
- * clean things up at all than do it too earaly!
+ * clean things up at all than do it too early!
  */
 static void
 menu_cleanup (struct frame *f)
 {
   /* This function can GC */
   current_menudesc = Qnil;
-  current_hashtable = Qnil;
+  current_hash_table = Qnil;
   prune_menubar (f);
 }
   
@@ -559,7 +585,7 @@ unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame* f)
   struct gcpro gcpro1;
 
   /* Find which guy is going to explode */
-  path = Fgethash (hmenu_to_lisp_object (menu), current_hashtable, Qunbound);
+  path = Fgethash (hmenu_to_lisp_object (menu), current_hash_table, Qunbound);
   assert (!UNBOUNDP (path));
 #ifdef DEBUG_XEMACS
   /* Allow to continue in a debugger after assert - not so fatal */
@@ -576,7 +602,7 @@ unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame* f)
   /* 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);
+  populate_menu (menu, path, desc, current_hash_table, 0);
   UNGCPRO;
   return Qt;
 }
@@ -599,8 +625,8 @@ unsafe_handle_wm_initmenu_1 (struct frame* f)
   update_frame_menubar_maybe (f);
 
   current_menudesc = current_frame_menubar (f);
-  current_hashtable = FRAME_MSWINDOWS_MENU_HASHTABLE(f);
-  assert (HASHTABLEP (current_hashtable));
+  current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE(f);
+  assert (HASH_TABLEP (current_hash_table));
 
   return Qt;
 }
@@ -618,14 +644,18 @@ mswindows_handle_wm_command (struct frame* f, WORD id)
   Lisp_Object data, fn, arg, frame;
   struct gcpro gcpro1;
 
-  data = Fgethash (make_int (id), current_hashtable, Qunbound);
+  if (NILP (current_hash_table))
+    return Qnil;
+
+  data = Fgethash (make_int (id), current_hash_table, Qunbound);
+
   if (UNBOUNDP (data))
     {
       menu_cleanup (f);
       return Qnil;
     }
 
-  /* Need to gcpro because the hashtable may get destroyed by
+  /* Need to gcpro because the hash table may get destroyed by
      menu_cleanup(), and will not gcpro the data any more */
   GCPRO1 (data);
   menu_cleanup (f);
@@ -699,14 +729,14 @@ mswindows_update_frame_menubars (struct frame* f)
 static void
 mswindows_free_frame_menubars (struct frame* f)
 {
-  FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Qnil;
+  FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = Qnil;
 }
 
 static void
 mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
 {
   struct frame *f = selected_frame ();
-  struct Lisp_Event *eev = NULL;
+  Lisp_Event *eev = NULL;
   HMENU menu;
   POINT pt;
   int ok;
@@ -745,9 +775,10 @@ mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
   CHECK_STRING (XCAR (menu_desc));
 
   current_menudesc = menu_desc;
-  current_hashtable = Fmake_hashtable (make_int(10), Qequal);
+  current_hash_table =
+    make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
   menu = create_empty_popup_menu();
-  Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hashtable);
+  Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table);
   top_level_menu = menu;
   
   /* see comments in menubar-x.c */
@@ -793,8 +824,8 @@ void
 vars_of_menubar_mswindows (void)
 {
   current_menudesc = Qnil;
-  current_hashtable = Qnil;
+  current_hash_table = Qnil;
 
   staticpro (&current_menudesc);
-  staticpro (&current_hashtable);
+  staticpro (&current_hash_table);
 }