Mercurial > emacs

changeset 21240:bff697e03fe0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Include puresize.h for CHECK_IMPURE. (parse_menu_item): New function. (menu_item_eval_property_1, menu_item_eval_property) New suroutines. (menu_bar_one_keymap): Moved some code to menu_bar_item. (menu_bar_item): Rewritten to use parse_menu_item. (menu_bar_item_1): Function deleted. (QCenable, QCvisible, QChelp, QCfilter, QCbutton, QCtoggle, QCradio): (Qmenu_alias): New variables. (syms_of_keyboard): Initialize them, and item_properties.
author Richard M. Stallman <rms@gnu.org>
date Sat, 21 Mar 1998 05:49:49 +0000
parents 81154898ac20
children 31bd04a792c2
files src/keyboard.c
diffstat 1 files changed, 372 insertions(+), 73 deletions(-) [+]
line wrap: on
line diff
--- a/src/keyboard.c	Sat Mar 21 05:48:03 1998 +0000
+++ b/src/keyboard.c	Sat Mar 21 05:49:49 1998 +0000
@@ -39,6 +39,7 @@
 #include "syntax.h"
 #include "intervals.h"
 #include "blockinput.h"
+#include "puresize.h"
 #include <setjmp.h>
 #include <errno.h>
 
@@ -456,7 +457,12 @@
 Lisp_Object Qevent_kind;
 Lisp_Object Qevent_symbol_elements;
 
+/* menu item parts */
+Lisp_Object Qmenu_alias;
 Lisp_Object Qmenu_enable;
+Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCbutton, QCtoggle, QCradio;
+extern Lisp_Object Vdefine_key_rebound_commands;
+extern Lisp_Object Qmenu_item;
 
 /* An event header symbol HEAD may have a property named
    Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
@@ -477,8 +483,6 @@
 Lisp_Object Qvertical_scroll_bar;
 Lisp_Object Qmenu_bar;
 
-extern Lisp_Object Qmenu_enable;
-
 Lisp_Object recursive_edit_unwind (), command_loop ();
 Lisp_Object Fthis_command_keys ();
 Lisp_Object Qextended_command_history;
@@ -3505,7 +3509,7 @@
 
     /*
      * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
-     * Used only as parameters to GetAsyncKeyState() and GetKeyState().
+     * Used only as parameters to GetAsyncKeyState and GetKeyState.
      * No other API or message will distinguish left and right keys this way.
      */
     /* 0xA0 .. 0xEF */
@@ -4114,12 +4118,12 @@
 	  portion_whole = Fcons (event->x, event->y);
 	  part = *scroll_bar_parts[(int) event->part];
 
-	  position =
-	    Fcons (window,
-		   Fcons (Qvertical_scroll_bar,
-			  Fcons (portion_whole,
-				 Fcons (make_number (event->timestamp),
-					Fcons (part, Qnil)))));
+	  position
+	    = Fcons (window,
+		     Fcons (Qvertical_scroll_bar,
+			    Fcons (portion_whole,
+				   Fcons (make_number (event->timestamp),
+					  Fcons (part, Qnil)))));
 	}
 
 	/* Always treat W32 scroll bar events as clicks. */
@@ -5084,7 +5088,7 @@
 #endif
 	  /* POSIX infers that processes which are not in the session leader's
 	     process group won't get SIGHUP's at logout time.  BSDI adheres to
-	     this part standard and returns -1 from read(0) with errno==EIO
+	     this part standard and returns -1 from read (0) with errno==EIO
 	     when the control tty is taken away.
 	     Jeffrey Honig <jch@bsdi.com> says this is generally safe.  */
 	  if (nread == -1 && errno == EIO)
@@ -5398,25 +5402,14 @@
 menu_bar_one_keymap (keymap)
      Lisp_Object keymap;
 {
-  Lisp_Object tail, item, key, binding, item_string, table;
+  Lisp_Object tail, item, table;
 
   /* Loop over all keymap entries that have menu strings.  */
   for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
     {
       item = XCONS (tail)->car;
       if (CONSP (item))
-	{
-	  key = XCONS (item)->car;
-	  binding = XCONS (item)->cdr;
-	  if (CONSP (binding))
-	    {
-	      item_string = XCONS (binding)->car;
-	      if (STRINGP (item_string))
-		menu_bar_item (key, item_string, Fcdr (binding));
-	    }
-	  else if (EQ (binding, Qundefined))
-	    menu_bar_item (key, Qnil, binding);
-	}
+	menu_bar_item (XCONS (item)->car, XCONS (item)->cdr);
       else if (VECTORP (item))
 	{
 	  /* Loop over the char values represented in the vector.  */
@@ -5426,45 +5419,25 @@
 	    {
 	      Lisp_Object character;
 	      XSETFASTINT (character, c);
-	      binding = XVECTOR (item)->contents[c];
-	      if (CONSP (binding))
-		{
-		  item_string = XCONS (binding)->car;
-		  if (STRINGP (item_string))
-		    menu_bar_item (key, item_string, Fcdr (binding));
-		}
-	      else if (EQ (binding, Qundefined))
-		menu_bar_item (key, Qnil, binding);
+	      menu_bar_item (character, XVECTOR (item)->contents[c]);
 	    }
 	}
     }
 }
 
-/* This is used as the handler when calling internal_condition_case_1.  */
-
-static Lisp_Object
-menu_bar_item_1 (arg)
-     Lisp_Object arg;
-{
-  return Qnil;
-}
-
 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
    If there's already an item for KEY, add this DEF to it.  */
 
+Lisp_Object item_properties;
+
 static void
-menu_bar_item (key, item_string, def)
-     Lisp_Object key, item_string, def;
-{
-  Lisp_Object tem;
-  Lisp_Object enabled;
+menu_bar_item (key, item)
+     Lisp_Object key, item;
+{
+  struct gcpro gcpro1;
   int i;
 
-  /* Skip menu-bar equiv keys data.  */
-  if (CONSP (def) && CONSP (XCONS (def)->car))
-    def = XCONS (def)->cdr;
-
-  if (EQ (def, Qundefined))
+  if (EQ (item, Qundefined))
     {
       /* If a map has an explicit `undefined' as definition,
 	 discard any previously made menu bar item.  */
@@ -5485,25 +5458,14 @@
       return;
     }
 
-  /* See if this entry is enabled.  */
-  enabled = Qt;
-
-  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_bar_item_1);
-    }
-
-  /* Ignore this item if it's not enabled.  */
-  if (NILP (enabled))
+  GCPRO1 (key);			/* Is this necessary? */
+  i = parse_menu_item (item, 0, 1);
+  UNGCPRO;
+  if (!i)
     return;
 
+  item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
+
   /* Find any existing item for this KEY.  */
   for (i = 0; i < menu_bar_items_index; i += 4)
     if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
@@ -5522,20 +5484,340 @@
 		 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
 	  menu_bar_items_vector = tem;
 	}
+
       /* Add this item.  */
       XVECTOR (menu_bar_items_vector)->contents[i++] = key;
-      XVECTOR (menu_bar_items_vector)->contents[i++] = item_string;
-      XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (def, Qnil);
+      XVECTOR (menu_bar_items_vector)->contents[i++]
+	= XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
+      XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
       XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
       menu_bar_items_index = i;
     }
-  /* We did find an item for this KEY.  Add DEF to its list of maps.  */
+  /* We did find an item for this KEY.  Add ITEM to its list of maps.  */
   else
     {
       Lisp_Object old;
       old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
-      XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (def, old);
-    }
+      XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (item, old);
+    }
+}
+
+ /* This is used as the handler when calling menu_item_eval_property.  */
+static Lisp_Object
+menu_item_eval_property_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;
+}
+
+/* Evaluate an expression and return the result (or nil if something 
+   went wrong).  Used to evaluate dynamic parts of menu items.  */
+static Lisp_Object
+menu_item_eval_property (sexpr)
+     Lisp_Object sexpr;
+{
+  Lisp_Object val;
+  val = internal_condition_case_1 (Feval, sexpr, Qerror,
+				   menu_item_eval_property_1);
+  return val;
+}
+
+/* This function parses a menu item and leaves the result in the
+   vector item_properties.
+   ITEM is a key binding, a possible menu item.
+   If NOTREAL is nonzero, only check for equivalent key bindings, don't
+   evaluate dynamic expressions in the menu item.
+   INMENUBAR is true when this is considered for an entry in a menu bar
+   top level.
+   parse_menu_item returns true if the item is a menu item and false
+   otherwise.  */
+
+int
+parse_menu_item (item, notreal, inmenubar)
+     Lisp_Object item;
+     int notreal, inmenubar;
+{
+  Lisp_Object def, tem;
+
+  Lisp_Object type = Qnil;
+  Lisp_Object cachelist = Qnil;
+  Lisp_Object filter = Qnil;
+  Lisp_Object item_string, start;
+  int i;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+
+#define RET0					\
+  if (1)					\
+    {						\
+      UNGCPRO;					\
+      return 0;					\
+    }						\
+  else
+
+  if (!CONSP (item))
+    return 0;
+
+  GCPRO3 (item, notreal, inmenubar);
+
+  /* Create item_properties vector if necessary.  */
+  if (NILP (item_properties))
+    item_properties
+      = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
+
+  /* Initialize optional entries.  */
+  for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
+    XVECTOR (item_properties)->contents[i] = Qnil;
+  XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = Qt;
+	 
+  /* Save the item here to protect it from GC.  */
+  XVECTOR (item_properties)->contents[ITEM_PROPERTY_ITEM] = item;
+
+  item_string = XCONS (item)->car;
+
+  start = item;
+  item = XCONS (item)->cdr;
+  if (STRINGP (item_string))
+    {
+      /* Old format menu item.  */
+      XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] = item_string;
+
+      /* Maybe help string.  */
+      if (CONSP (item) && STRINGP (XCONS (item)->car))
+	{
+	  XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]
+	    = XCONS (item)->car;
+	  start = item;
+	  item = XCONS (item)->cdr;
+	}
+	  
+      /* Maybee key binding cache.  */
+      if (CONSP (item) && CONSP (XCONS (item)->car)
+	  && (NILP (XCONS (XCONS (item)->car)->car)
+	      || VECTORP (XCONS (XCONS (item)->car)->car)))
+	{
+	  cachelist = XCONS (item)->car;
+	  item = XCONS (item)->cdr;
+	}
+      
+      /* This is the real definition--the function to run.  */
+      XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = item;
+
+      /* Get enable property, if any.  */
+      if (SYMBOLP (item))
+	{
+	  tem = Fget (item, Qmenu_enable);
+	  if (!NILP (tem))
+	    XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = tem;
+	}
+    }
+  else if (EQ (item_string, Qmenu_item) && CONSP (item))
+    {
+      /* New format menu item.  */
+      XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME]
+	= XCONS (item)->car;
+      start = XCONS (item)->cdr;
+      if (CONSP (start))
+	{
+	  /* We have a real binding.  */
+	  XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]
+	    = XCONS (start)->car;
+
+	  item = XCONS (start)->cdr;
+	  /* Is there a cache list with key equivalences. */
+	  if (CONSP (item) && CONSP (XCONS (item)->car))
+	    {
+	      cachelist = XCONS (item)->car;
+	      item = XCONS (item)->cdr;
+	    }
+
+	  /* Parse properties.  */
+	  while (CONSP (item) && CONSP (XCONS (item)->cdr))
+	    {
+	      tem = XCONS (item)->car;
+	      item = XCONS (item)->cdr;
+
+	      if (EQ (tem, QCenable))
+		XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE]
+		  = XCONS (item)->car;
+	      else if (EQ (tem, QCvisible) && !notreal)
+		{
+		  /* If got a visible property and that evaluates to nil
+		     then ignore this item.  */
+		  tem = menu_item_eval_property (XCONS (item)->car);
+		  if (NILP (tem))
+		    RET0;
+	 	}
+	      else if (EQ (tem, QChelp))
+		XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]
+		  = XCONS (item)->car;
+	      else if (EQ (tem, QCfilter))
+		filter = XCONS (item)->car;
+	      else if (EQ (tem, QCbutton) && CONSP (XCONS (item)->car))
+		{
+		  tem = XCONS (item)->car;
+		  type = XCONS (tem)->car;
+		  if (EQ (type, QCtoggle) || EQ (type, QCradio))
+		    {
+		      XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]
+			= XCONS (tem)->cdr;
+		      XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE]
+			= type;
+		    }
+		}
+	      item = XCONS (item)->cdr;
+	    }
+	}
+      else if (inmenubar || !NILP (start))
+	RET0;
+    }
+  else
+    RET0;
+
+  /* If item string is not a string, evaluate it to get string.
+     If we don't get a string, skip this item.  */
+  item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
+  if (!(STRINGP (item_string) || notreal))
+    {
+      item_string = menu_item_eval_property (item_string);
+      if (!STRINGP (item_string))
+	RET0;
+      XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] = item_string;
+    }
+     
+  /* If got a filter apply it on definition.  */
+  def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
+  if (!NILP (filter))
+    {
+      def = menu_item_eval_property (Fcons (filter, Fcons (def, Qnil)));
+      XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = def;
+    }
+
+  /* If we got no definition, this item is just unselectable text which
+     is ok when in a submenu and if there is an item string.  */
+  item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
+  if (NILP (def))
+    {
+      UNGCPRO;
+      return (!inmenubar && STRINGP (item_string) ? 1 : 0);
+    }
+ 
+  /* Enable or disable selection of item.  */
+  tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
+  if (!EQ (tem, Qt))
+    {
+      if (notreal)
+	tem = Qt;
+      else
+	tem = menu_item_eval_property (tem);
+      if (inmenubar && NILP (tem))
+	RET0;		/* Ignore disabled items in menu bar.  */
+      XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = tem;
+    }
+
+  /* See if this is a separate pane or a submenu.  */
+  tem = get_keymap_1 (def, 0, 1);
+  if (!NILP (tem))
+    {
+      XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP] = tem;
+      XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = tem;
+      UNGCPRO;
+      return 1;
+    }
+  else if (inmenubar)
+    RET0;		/* Entries in menu bar must be submenus.  */
+
+  /* This is a command.  See if there is an equivalent key binding. */
+  if (NILP (cachelist))
+    {
+      /* We have to create a cachelist. */
+      CHECK_IMPURE (start);
+      XCONS (start)->cdr = Fcons (Fcons (Qnil, Qnil), XCONS (start)->cdr);
+      cachelist = XCONS (XCONS (start)->cdr)->car;
+      /* We have not checked this before so check it now.  */
+      tem = def;
+    }
+  else if (VECTORP (XCONS (cachelist)->car)) /* Saved key */
+    {
+      tem = Fkey_binding (XCONS (cachelist)->car, Qnil);
+      if (EQ (tem, 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) && EQ (tem, XSYMBOL (def)->function)))
+	tem = Qnil;		/* Don't need to recompute key binding.  */
+      else
+	tem = def;
+    }
+  /* 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. */
+  else if (!NILP (XCONS (cachelist)->car))
+    tem = def;			/* Should signal an error here.  */
+  else if (
+	   /* Should we check everything when precomputing key bindings?  */
+	   /* notreal || */
+	   CONSP (Vdefine_key_rebound_commands)
+	   && !NILP (Fmemq (def, Vdefine_key_rebound_commands)))
+    tem = def;
+  else
+    tem = Qnil;
+  
+  if (!NILP (tem))
+    {
+      /* Recompute equivalent key binding.
+         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.
+	 Otherwise look up the specified command itself.
+	 We don't try both, because that makes easymenu menus slow.  */
+      if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
+	  && ! NILP (Fget (def, Qmenu_alias)))
+	tem = XSYMBOL (def)->function;
+      tem = Fwhere_is_internal (tem, Qnil, Qt, Qnil);
+      XCONS (cachelist)->car = tem;
+      XCONS (cachelist)->cdr
+	= (NILP (tem) ? Qnil
+	   :
+	   concat2 (build_string ("  ("),
+		    concat2 (Fkey_description (tem), build_string (")"))));
+    }
+
+  /* If we only want to precompute equivalent key bindings, stop here. */
+  if (notreal)
+    {
+      UNGCPRO;
+      return 1;
+    }
+
+  /* If we have an equivalent key binding, use that.  */
+  XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]
+    = XCONS (cachelist)->cdr;
+
+  /* Include this when menu help is implemented. 
+     tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
+     if (!(NILP (tem) || STRINGP (tem)))
+     {
+     tem = menu_item_eval_property (tem);
+     if (!STRINGP (tem))
+     tem = Qnil;
+     XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
+     }
+  */
+
+  /* Handle radio buttons or toggle boxes.  */ 
+  tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
+  if (!NILP (tem))
+    XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]
+      = menu_item_eval_property (tem);
+
+  UNGCPRO;
+  return 1;
 }
 
 /* Read a character using menus based on maps in the array MAPS.
@@ -8124,6 +8406,9 @@
 
 syms_of_keyboard ()
 {
+  staticpro (&item_properties);
+  item_properties = Qnil;
+
   Qtimer_event_handler = intern ("timer-event-handler");
   staticpro (&Qtimer_event_handler);
 
@@ -8171,6 +8456,20 @@
 
   Qmenu_enable = intern ("menu-enable");
   staticpro (&Qmenu_enable);
+  Qmenu_alias = intern ("menu-alias");
+  staticpro (&Qmenu_alias);
+  QCenable = intern (":enable");
+  staticpro (&QCenable);
+  QCvisible = intern (":visible");
+  staticpro (&QCvisible);
+  QCfilter = intern (":filter");
+  staticpro (&QCfilter);
+  QCbutton = intern (":button");
+  staticpro (&QCbutton);
+  QCtoggle = intern (":toggle");
+  staticpro (&QCtoggle);
+  QCradio = intern (":radio");
+  staticpro (&QCradio);
 
   Qmode_line = intern ("mode-line");
   staticpro (&Qmode_line);