xemacs-beta: src/menubar-msw.c comparison

comparison src/menubar-msw.c @ 233:52952cbfc5b5 r20-5b15

Import from CVS: tag r20-5b15

author	cvs
date	Mon, 13 Aug 2007 10:14:14 +0200
parents	557eaa0339bf
children	83b3d10dcba9

comparison

equal deleted inserted replaced

-:aa6545ea0638
+:52952cbfc5b5
 #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
+/* Current menu (bar or popup) descriptor. gcpro'ed */
-for the popup. gcpro'ed */
+static Lisp_Object current_menudesc;
-static Lisp_Object current_tracking_popup;
+/* Current menubar or popup hashtable. gcpro'ed */
-/* Current popup has table. Qnil when no popup. gcpro'ed */
+static Lisp_Object current_hashtable;
-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.
 *name = Qnil;
 *callback = Qnil;
 *plist = Qnil;
 if (length < 3)
-signal_simple_error ("button descriptors must be at least 3 long", desc);
+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 ]+ ]
 /* the new way */
 {
 int i;
 if (length & 1)
 	signal_simple_error (
-		"button descriptor has an odd number of keywords and values",
+		"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);
+	    signal_simple_error_2 ("Not a keyword", key, desc);
 	  internal_plist_put (plist, key, val);
 	}
 }
 }
 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. */
+Lisp_Object plist, name, callback;
+gui_parse_button_descriptor (item, &name, &callback, &plist);
+return HASH2 (internal_hash (name, 0),
+		    internal_hash (callback, 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;
 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);
+	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))
 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);
+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,
+* This function is called from populate_menu and checksum_menu.
-	       Lisp_Object hash_tab, int bar_p)
+* 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 descriptor,
+			     Lisp_Object hash_tab, int bar_p, int populate_p)
 {
 Lisp_Object menu_name, plist, item_desc;
 int deep_p, flush_right;
 struct gcpro gcpro1;
+unsigned long checksum = 0;
 /* Will initially contain only "(empty)" */
-empty_menu (menu, 1);
+if (populate_p)
+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);
+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);
+	signal_simple_error ("Menu must have a name", descriptor);
 }
 /* Fetch keywords prepending the item list */
 descriptor = gui_parse_menu_keywords (descriptor, &plist);
 GCPRO1 (plist);
 {
 if (NILP (XCAR (item_desc)))
 	{
 	  if (bar_p)
 	    flush_right = 1;
+	  if (!populate_p)
+	    checksum = HASH2 (checksum, Qnil);
 	}
-else
+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)));
 }
-/* Remove the "(empty)" item, if there are other ones */
+if (populate_p)
-if (GetMenuItemCount (menu) > 1)
+{
-RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND);
+/* Remove the "(empty)" item, if there are other ones */
+if (GetMenuItemCount (menu) > 1)
-/* Add the header to the popup, if told so. The same as in X - an
+	RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND);
-insensitive item, and a separator (Seems to me, there were
-two separators in X... In Windows this looks ugly, anywats. */
+/* Add the header to the popup, if told so. The same as in X - an
-if (!bar_p && !deep_p && popup_menu_titles && !NILP(menu_name))
+	 insensitive item, and a separator (Seems to me, there were
-{
+	 two separators in X... In Windows this looks ugly, anywats. */
-InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
+if (!bar_p && !deep_p && popup_menu_titles && !NILP(menu_name))
-		  0, XSTRING_DATA(menu_name));
+	{
-InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
+	  InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
-SetMenuDefaultItem (menu, 0, MF_BYPOSITION);
+		      0, XSTRING_DATA(menu_name));
-}
+	  InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
+	  SetMenuDefaultItem (menu, 0, MF_BYPOSITION);
+	}
+}
+return checksum;
+}
+static void
+populate_menu (HMENU menu, Lisp_Object path, Lisp_Object descriptor,
+			     Lisp_Object hash_tab, int bar_p)
+{
+populate_or_checksum_helper (menu, path, descriptor, hash_tab, bar_p, 1);
+}
+static unsigned long
+checksum_menu (Lisp_Object descriptor)
+{
+return populate_or_checksum_helper (NULL, Qnil, descriptor, Qunbound, 0, 0);
 }
 static Lisp_Object
 find_menu (Lisp_Object desc, Lisp_Object path)
 {
 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;
 }
 {
 /* We did not have the bar and are not going to */
 return;
 }
-/* Now we have to check if the menubar has really changed */
+/* Now we bail out if the menubar has not changed */
-/* #### For now we do not though */
+if (FRAME_MSWINDOWS_MENU_CHECKSUM(f) == checksum_menu (desc))
+return;
-/* 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);
 	    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)
 {
 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
+triggers. To resolve, we must prevent filters explicitely from
-mangling with te active menu. In apply_filter probably?
+mangling with the active menu. In apply_filter probably?
 Is copy-tree on the whole menu too expensive? */
 if (NILP(desc))
 /* abort(); */
 return;
 */
 static void
 menu_cleanup (struct frame *f)
 {
 /* This function can GC */
-if (!NILP (current_tracking_popup))
+current_menudesc = Qnil;
-{
+current_hashtable = Qnil;
-current_tracking_popup = Qnil;
+prune_menubar (f);
-current_popup_hash_table = Qnil;
-}
-else
-prune_menubar (f);
 }
 /*------------------------------------------------------------------------*/
 /* Message handlers                                                       */
 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;
+Lisp_Object path, desc;
 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);
+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 = current_menudesc;
 if (!NILP (path))
 {
 desc = find_menu (desc, path);
 if (NILP (desc))
-	signal_simple_error ("this menu does not exist any more", path);
+	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);
+populate_menu (menu, path, desc, current_hashtable, 0);
 UNGCPRO;
 return Qt;
 }
 static Lisp_Object
 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;
 }
 #ifdef KKM_DOES_NOT_LIKE_UNDOCS_SOMETIMES
 /* #### This may become wrong in future Windows */
 */
 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;
+Lisp_Object command, funcsym, frame;
 struct gcpro gcpro1;
-if (!NILP (current_tracking_popup))
+command = Fgethash (make_int (id), current_hashtable, Qunbound);
-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;
 }
 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);
+signal_simple_error ("Illegal callback", 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;
 }
 wm_initmenu_frame = frm;
 return mswindows_protect_modal_loop (unsafe_handle_wm_initmenupopup, Qnil);
 }
 Lisp_Object
-mswindows_handle_wm_initmenu (struct frame* f)
+mswindows_handle_wm_initmenu (HMENU hmenu, struct frame* f)
 {
-wm_initmenu_frame = f;
+/* Handle only frame menubar, ignore if from popup or system menu */
-return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil);
+if (GetMenu (FRAME_MSWINDOWS_HANDLE(f)) == hmenu)
+{
+wm_initmenu_frame = f;
+return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil);
+}
+return Qt;
 }
 Lisp_Object
 mswindows_handle_wm_exitmenuloop (struct frame* f)
 {
 pt.x = pt.y = 10;
 if (SYMBOLP (menu_desc))
 menu_desc = Fsymbol_value (menu_desc);
-current_tracking_popup = menu_desc;
+current_menudesc = menu_desc;
-current_popup_hash_table = Fmake_hashtable (make_int(10), Qequal);
+current_hashtable = Fmake_hashtable (make_int(10), Qequal);
 menu = create_empty_popup_menu();
-Fputhash (hmenu_to_lisp_object (menu), Qnil, current_popup_hash_table);
+Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hashtable);
-ok = TrackPopupMenu (menu, TPM_LEFTALIGN | TPM_LEFTBUTTON,
+ok = TrackPopupMenu (menu,
+		       TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON,
 		       pt.x, pt.y, 0,
 		       FRAME_MSWINDOWS_HANDLE (f), NULL);
 DestroyMenu (menu);
 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",
+signal_simple_error ("Cannot track popup menu while in menu",
 			 menu_desc);
 }
 }
 }
 void
 vars_of_menubar_mswindows (void)
 {
-current_tracking_popup = Qnil;
+current_menudesc = Qnil;
-current_popup_hash_table = Qnil;
+current_hashtable = Qnil;
-staticpro (&current_tracking_popup);
+staticpro (&current_menudesc);
-staticpro (&current_popup_hash_table);
+staticpro (&current_hashtable);
 Fprovide (intern ("mswindows-menubars"));
 }

Mercurial > hg > xemacs-beta

comparison src/menubar-msw.c @ 233:52952cbfc5b5 r20-5b15