Mercurial > emacs

--- a/src/xmenu.c	Sat Mar 21 05:53:36 1998 +0000
+++ b/src/xmenu.c	Sat Mar 21 06:01:22 1998 +0000
@@ -41,7 +41,6 @@
 #include "window.h"
 #include "keyboard.h"
 #include "blockinput.h"
-#include "puresize.h"
 #include "buffer.h"

 #ifdef MSDOS
@@ -90,13 +89,10 @@

 Lisp_Object Qdebug_on_next_call;

-Lisp_Object Qmenu_alias;
-
-extern Lisp_Object Qmenu_enable;
 extern Lisp_Object Qmenu_bar;
 extern Lisp_Object Qmouse_click, Qevent_kind;

-extern Lisp_Object Vdefine_key_rebound_commands;
+extern Lisp_Object QCtoggle, QCradio;

 extern Lisp_Object Voverriding_local_map;
 extern Lisp_Object Voverriding_local_map_menu_flag;
@@ -117,6 +113,7 @@
 static Lisp_Object xmenu_show ();
 static void keymap_panes ();
 static void single_keymap_panes ();
+static void single_menu_item ();
 static void list_of_panes ();
 static void list_of_items ();

@@ -339,152 +336,6 @@
   XVECTOR (menu_items)->contents[menu_items_used++] = def;
 }

-/* Figure out the current keyboard equivalent of a menu item ITEM1.
-   The item string for menu display should be ITEM_STRING.
-   Store the equivalent keyboard key sequence's
-   textual description into *DESCRIP_PTR.
-   Also cache them in the item itself.
-   Return the real definition to execute.  */
-
-static Lisp_Object
-menu_item_equiv_key (item_string, item1, descrip_ptr)
-     Lisp_Object item_string;
-     Lisp_Object item1;
-     Lisp_Object *descrip_ptr;
-{
-  /* This is the real definition--the function to run.  */
-  Lisp_Object def;
-  /* This is the sublist that records cached equiv key data
-     so we can save time.  */
-  Lisp_Object cachelist;
-  /* These are the saved equivalent keyboard key sequence
-     and its key-description.  */
-  Lisp_Object savedkey, descrip;
-  Lisp_Object def1;
-  int changed = 0;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
-  /* If a help string follows the item string, skip it.  */
-  if (CONSP (XCONS (item1)->cdr)
-      && STRINGP (XCONS (XCONS (item1)->cdr)->car))
-    item1 = XCONS (item1)->cdr;
-
-  def = Fcdr (item1);
-
-  /* Get out the saved equivalent-keyboard-key info.  */
-  cachelist = savedkey = descrip = Qnil;
-  if (CONSP (def) && CONSP (XCONS (def)->car)
-      && (NILP (XCONS (XCONS (def)->car)->car)
-	  || VECTORP (XCONS (XCONS (def)->car)->car)))
-    {
-      cachelist = XCONS (def)->car;
-      def = XCONS (def)->cdr;
-      savedkey = XCONS (cachelist)->car;
-      descrip = XCONS (cachelist)->cdr;
-    }
-
-  GCPRO4 (def, def1, savedkey, descrip);
-
-  /* Is it still valid?  */
-  def1 = Qnil;
-  if (!NILP (savedkey))
-    def1 = Fkey_binding (savedkey, Qnil);
-  /* If not, update it.  */
-  if (! EQ (def1, def)
-      /* If the command is an alias for another
-         (such as easymenu.el and lmenu.el set it up),
-         check if the original command matches the cached command.  */
-      && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
-           && EQ (def1, XSYMBOL (def)->function))
-      /* If something had no key binding before, don't recheck it
-	 because that is too slow--except if we have a list of rebound
-	 commands in Vdefine_key_rebound_commands, do recheck any command
-	 that appears in that list.  */
-      && (NILP (cachelist) || !NILP (savedkey)
-	  || (! EQ (Qt, Vdefine_key_rebound_commands)
-	      && !NILP (Fmemq (def, Vdefine_key_rebound_commands)))))
-    {
-      changed = 1;
-      descrip = Qnil;
-      /* If the command is an alias for another
-	 (such as easymenu.el and lmenu.el set it up),
-	 see if the original command name has equivalent keys.  */
-      if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
-	  && ! NILP (Fget (def, Qmenu_alias)))
-	savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
-				       Qnil, Qt, Qnil);
-      else
-	/* Otherwise look up the specified command itself.
-	   We don't try both, because that makes easymenu menus slow.  */
-	savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
-
-      if (!NILP (savedkey))
-	{
-	  descrip = Fkey_description (savedkey);
-	  descrip = concat2 (make_string ("  (", 3), descrip);
-	  descrip = concat2 (descrip, make_string (")", 1));
-	}
-    }
-
-  /* Cache the data we just got in a sublist of the menu binding.  */
-  if (NILP (cachelist))
-    {
-      CHECK_IMPURE (item1);
-      XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
-    }
-  else if (changed)
-    {
-      XCONS (cachelist)->car = savedkey;
-      XCONS (cachelist)->cdr = descrip;
-    }
-
-  UNGCPRO;
-  *descrip_ptr = descrip;
-  return def;
-}
-
-/* This is used as the handler when calling internal_condition_case_1.  */
-
-static Lisp_Object
-menu_item_enabled_p_1 (arg)
-     Lisp_Object arg;
-{
-  /* If we got a quit from within the menu computation,
-     quit all the way out of it.  This takes care of C-] in the debugger.  */
-  if (CONSP (arg) && EQ (XCONS (arg)->car, Qquit))
-    Fsignal (Qquit, Qnil);
-
-  return Qnil;
-}
-
-/* Return non-nil if the command DEF is enabled when used as a menu item.
-   This is based on looking for a menu-enable property.
-   If NOTREAL is set, don't bother really computing this.  */
-
-static Lisp_Object
-menu_item_enabled_p (def, notreal)
-     Lisp_Object def;
-     int notreal;
-{
-  Lisp_Object enabled, tem;
-
-  enabled = Qt;
-  if (notreal)
-    return enabled;
-  if (SYMBOLP (def))
-    {
-      /* No property, or nil, means enable.
-	 Otherwise, enable if value is not nil.  */
-      tem = Fget (def, Qmenu_enable);
-      if (!NILP (tem))
-	/* (condition-case nil (eval tem)
-	   (error nil))  */
-	enabled = internal_condition_case_1 (Feval, tem, Qerror,
-					     menu_item_enabled_p_1);
-    }
-  return enabled;
-}
-
 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
    and generate menu panes for them in menu_items.
    If NOTREAL is nonzero,
@@ -513,8 +364,8 @@
    It handles one keymap, KEYMAP.
    The other arguments are passed along
    or point to local variables of the previous function.
-   If NOTREAL is nonzero,
-   don't bother really computing whether an item is enabled.
+   If NOTREAL is nonzero, only check for equivalent key bindings, don't
+   evaluate expressions in menu items and don't make any menu.

    If we encounter submenus deeper than MAXDEPTH levels, ignore them.  */

@@ -526,88 +377,33 @@
      int notreal;
      int maxdepth;
 {
-  Lisp_Object pending_maps;
-  Lisp_Object tail, item, item1, item_string, table;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+  Lisp_Object pending_maps = Qnil;
+  Lisp_Object tail, item;
+  struct gcpro gcpro1, gcpro2;
+  int notbuttons = 0;

   if (maxdepth <= 0)
     return;

-  pending_maps = Qnil;
+  push_menu_pane (pane_name, prefix);

-  push_menu_pane (pane_name, prefix);
+#ifndef HAVE_BOXES
+  /* Remember index for first item in this pane so we can go back and
+     add a prefix when (if) we see the first button.  After that, notbuttons
+     is set to 0, to mark that we have seen a button and all non button
+     items need a prefix.  */
+  notbuttons = menu_items_used;
+#endif

   for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
     {
-      /* Look at each key binding, and if it has a menu string,
-	 make a menu item from it.  */
+      GCPRO2 (keymap, pending_maps);
+      /* Look at each key binding, and if it is a menu item add it
+	 to this menu.  */
       item = XCONS (tail)->car;
       if (CONSP (item))
-	{
-	  item1 = XCONS (item)->cdr;
-	  if (CONSP (item1))
-	    {
-	      item_string = XCONS (item1)->car;
-	      if (STRINGP (item_string))
-		{
-		  /* This is the real definition--the function to run.  */
-		  Lisp_Object def;
-		  /* These are the saved equivalent keyboard key sequence
-		     and its key-description.  */
-		  Lisp_Object descrip;
-		  Lisp_Object tem, enabled;
-
-		  /* GCPRO because ...enabled_p will call eval
-		     and ..._equiv_key may autoload something.
-		     Protecting KEYMAP preserves everything we use;
-		     aside from that, must protect whatever might be
-		     a string.  Since there's no GCPRO5, we refetch
-		     item_string instead of protecting it.  */
-		  descrip = def = Qnil;
-		  GCPRO4 (keymap, pending_maps, def, descrip);
-
-		  def = menu_item_equiv_key (item_string, item1, &descrip);
-		  enabled = menu_item_enabled_p (def, notreal);
-
-		  UNGCPRO;
-
-		  item_string = XCONS (item1)->car;
-
-		  tem = Fkeymapp (def);
-		  if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
-		    pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)),
-					  pending_maps);
-		  else
-		    {
-		      Lisp_Object submap;
-		      GCPRO4 (keymap, pending_maps, descrip, item_string);
-		      submap = get_keymap_1 (def, 0, 1);
-		      UNGCPRO;
-#ifndef USE_X_TOOLKIT
-		      /* Indicate visually that this is a submenu.  */
-		      if (!NILP (submap))
-			item_string = concat2 (item_string,
-					       build_string (" >"));
-#endif
-		      /* If definition is nil, pass nil as the key.  */
-		      push_menu_item (item_string, enabled,
-				      XCONS (item)->car, def,
-				      descrip);
-#ifdef USE_X_TOOLKIT
-		      /* Display a submenu using the toolkit.  */
-		      if (! NILP (submap))
-			{
-			  push_submenu_start ();
-			  single_keymap_panes (submap, Qnil,
-					       XCONS (item)->car, notreal,
-					       maxdepth - 1);
-			  push_submenu_end ();
-			}
-#endif
-		    }
-		}
-	    }
-	}
+	single_menu_item (XCONS (item)->car, XCONS (item)->cdr,
+			  &pending_maps, notreal, maxdepth, &notbuttons);
       else if (VECTORP (item))
 	{
 	  /* Loop over the char values represented in the vector.  */
@@ -617,68 +413,11 @@
 	    {
 	      Lisp_Object character;
 	      XSETFASTINT (character, c);
-	      item1 = XVECTOR (item)->contents[c];
-	      if (CONSP (item1))
-		{
-		  item_string = XCONS (item1)->car;
-		  if (STRINGP (item_string))
-		    {
-		      Lisp_Object def;
-
-		      /* These are the saved equivalent keyboard key sequence
-			 and its key-description.  */
-		      Lisp_Object descrip;
-		      Lisp_Object tem, enabled;
-
-		      /* GCPRO because ...enabled_p will call eval
-			 and ..._equiv_key may autoload something.
-			 Protecting KEYMAP preserves everything we use;
-			 aside from that, must protect whatever might be
-			 a string.  Since there's no GCPRO5, we refetch
-			 item_string instead of protecting it.  */
-		      GCPRO4 (keymap, pending_maps, def, descrip);
-		      descrip = def = Qnil;
-
-		      def = menu_item_equiv_key (item_string, item1, &descrip);
-		      enabled = menu_item_enabled_p (def, notreal);
-
-		      UNGCPRO;
-
-		      item_string = XCONS (item1)->car;
-
-		      tem = Fkeymapp (def);
-		      if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
-			pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
-					      pending_maps);
-		      else
-			{
-			  Lisp_Object submap;
-			  GCPRO4 (keymap, pending_maps, descrip, item_string);
-			  submap = get_keymap_1 (def, 0, 1);
-			  UNGCPRO;
-#ifndef USE_X_TOOLKIT
-			  if (!NILP (submap))
-			    item_string = concat2 (item_string,
-						   build_string (" >"));
-#endif
-			  /* If definition is nil, pass nil as the key.  */
-			  push_menu_item (item_string, enabled, character,
-					  def, descrip);
-#ifdef USE_X_TOOLKIT
-			  if (! NILP (submap))
-			    {
-			      push_submenu_start ();
-			      single_keymap_panes (submap, Qnil,
-						   character, notreal,
-						   maxdepth - 1);
-			      push_submenu_end ();
-			    }
-#endif
-			}
-		    }
-		}
+	      single_menu_item (character, XVECTOR (item)->contents[c],
+				&pending_maps, notreal, maxdepth, &notbuttons);
 	    }
 	}
+      UNGCPRO;
     }

   /* Process now any submenus which want to be panes at this level.  */
@@ -696,6 +435,144 @@
     }
 }

+/* This is a subroutine of single_keymap_panes that handles one
+   keymap entry.
+   KEY is a key in a keymap and ITEM is its binding.
+   PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
+   separate panes.
+   If NOTREAL is nonzero, only check for equivalent key bindings, don't
+   evaluate expressions in menu items and don't make any menu.
+   If we encounter submenus deeper than MAXDEPTH levels, ignore them.
+   NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
+   buttons.  It points to variable notbuttons in single_keymap_panes,
+   which keeps track of if we have seen a button in this menu or not.  */
+
+static void
+single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth,
+		  notbuttons_ptr)
+     Lisp_Object key, item;
+     Lisp_Object *pending_maps_ptr;
+     int maxdepth, notreal;
+     int *notbuttons_ptr;
+{
+  Lisp_Object def, map, item_string, enabled;
+  struct gcpro gcpro1, gcpro2;
+  int res;
+
+  /* Parse the menu item and leave the result in item_properties.  */
+  GCPRO2 (key, item);
+  res = parse_menu_item (item, notreal, 0);
+  UNGCPRO;
+  if (!res)
+    return;			/* Not a menu item.  */
+
+  map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
+
+  if (notreal)
+    {
+      /* We don't want to make a menu, just traverse the keymaps to
+	 precompute equivalent key bindings.  */
+      if (!NILP (map))
+	single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
+      return;
+    }
+
+  enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
+  item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
+
+  if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
+    {
+      if (!NILP (enabled))
+	/* An enabled separate pane. Remember this to handle it later.  */
+	*pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
+				   *pending_maps_ptr);
+      return;
+    }
+
+#ifndef HAVE_BOXES
+  /* Simulate radio buttons and toggle boxes by putting a prefix in
+     front of them.  */
+  {
+    Lisp_Object prefix = Qnil;
+    Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
+    if (!NILP (type))
+      {
+	Lisp_Object selected
+	  = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
+
+	if (*notbuttons_ptr)
+	  /* The first button. Line up previous items in this menu.  */
+	  {
+	    int index = *notbuttons_ptr; /* Index for first item this menu.  */
+	    int submenu = 0;
+	    Lisp_Object tem;
+	    while (index < menu_items_used)
+	      {
+		tem
+		  = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
+		if (NILP (tem))
+		  {
+		    index++;
+		    submenu++;		/* Skip sub menu.  */
+		  }
+		else if (EQ (tem, Qlambda))
+		  {
+		    index++;
+		    submenu--;		/* End sub menu.  */
+		  }
+		else if (EQ (tem, Qt))
+		  index += 3;		/* Skip new pane marker. */
+		else if (EQ (tem, Qquote))
+		  index++;		/* Skip a left, right divider. */
+		else
+		  {
+		    if (!submenu && XSTRING (tem)->data[0] != '\0'
+			&& XSTRING (tem)->data[0] != '-')
+		      XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
+			= concat2 (build_string ("    "), tem);
+		    index += MENU_ITEMS_ITEM_LENGTH;
+		  }
+	      }
+	    *notbuttons_ptr = 0;
+	  }
+
+	/* Calculate prefix, if any, for this item.  */
+	if (EQ (type, QCtoggle))
+	  prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
+	else if (EQ (type, QCradio))
+	  prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
+      }
+    /* Not a button. If we have earlier buttons, then we need a prefix.  */
+    else if (!*notbuttons_ptr && XSTRING (item_string)->data[0] != '\0'
+	     && XSTRING (item_string)->data[0] != '-')
+      prefix = build_string ("    ");
+
+    if (!NILP (prefix))
+      item_string = concat2 (prefix, item_string);
+  }
+#endif /* not HAVE_BOXES */
+
+#ifndef USE_X_TOOLKIT
+  if (!NILP(map))
+    /* Indicate visually that this is a submenu.  */
+    item_string = concat2 (item_string, build_string (" >"));
+#endif
+
+  push_menu_item (item_string, enabled, key,
+		  XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
+		  XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]);
+
+#ifdef USE_X_TOOLKIT
+  /* Display a submenu using the toolkit.  */
+  if (! (NILP (map) || NILP (enabled)))
+    {
+      push_submenu_start ();
+      single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
+      push_submenu_end ();
+    }
+#endif
+}
+
 /* Push all the panes and items of a menu described by the
    alist-of-alists MENU.
    This handles old-fashioned calls to x-popup-menu.  */
@@ -2730,9 +2607,6 @@
   staticpro (&menu_items);
   menu_items = Qnil;

-  Qmenu_alias = intern ("menu-alias");
-  staticpro (&Qmenu_alias);
-
   Qdebug_on_next_call = intern ("debug-on-next-call");
   staticpro (&Qdebug_on_next_call);