Mercurial > emacs

changeset 20004:de15e679191e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(Qwidget_type): New variable. (widget-plist-member, widget-put, widget-get, widget-apply): Move here from lisp/wid-edit.el; translated into C for efficiency. (syms_of_fns): Initialize Qwidget_type; defsubr new functions.
author Karl Heuer <kwzh@gnu.org>
date Tue, 30 Sep 1997 07:15:28 +0000
parents 9bc6a4017c8c
children 148cbe18165c
files src/fns.c
diffstat 1 files changed, 109 insertions(+), 19 deletions(-) [+]
line wrap: on
line diff
--- a/src/fns.c	Tue Sep 30 01:13:53 1997 +0000
+++ b/src/fns.c	Tue Sep 30 07:15:28 1997 +0000
@@ -52,6 +52,7 @@
 Lisp_Object Qstring_lessp, Qprovide, Qrequire;
 Lisp_Object Qyes_or_no_p_history;
 Lisp_Object Qcursor_in_echo_area;
+Lisp_Object Qwidget_type;
 
 static int internal_equal ();
 
@@ -155,7 +156,7 @@
 This function never gets an error.  If LIST is not really a list,\n\
 it returns 0.  If LIST is circular, it returns a finite value\n\
 which is at least the number of distinct elements.")
- (list)
+  (list)
      Lisp_Object list;
 {
   Lisp_Object tail, halftail, length;
@@ -543,7 +544,7 @@
   if (!NILP (prev))
     XCONS (prev)->cdr = last_tail;
 
-  return val;  
+  return val;
 }
 
 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
@@ -618,7 +619,7 @@
   else
     res = Fvector (XINT (to) - XINT (from),
 		   XVECTOR (string)->contents + XINT (from));
-		   
+
   return res;
 }
 
@@ -1042,9 +1043,9 @@
 use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
 The PLIST is modified by side effects.")
   (plist, prop, val)
-    Lisp_Object plist;
-    register Lisp_Object prop;
-    Lisp_Object val;
+     Lisp_Object plist;
+     register Lisp_Object prop;
+     Lisp_Object val;
 {
   register Lisp_Object tail, prev;
   Lisp_Object newcell;
@@ -1256,7 +1257,7 @@
   (char_table)
      Lisp_Object char_table;
 {
-  CHECK_CHAR_TABLE (char_table, 0);  
+  CHECK_CHAR_TABLE (char_table, 0);
 
   return XCHAR_TABLE (char_table)->purpose;
 }
@@ -1271,7 +1272,7 @@
   (char_table)
      Lisp_Object char_table;
 {
-  CHECK_CHAR_TABLE (char_table, 0);  
+  CHECK_CHAR_TABLE (char_table, 0);
 
   return XCHAR_TABLE (char_table)->parent;
 }
@@ -1285,11 +1286,11 @@
 {
   Lisp_Object temp;
 
-  CHECK_CHAR_TABLE (char_table, 0);  
+  CHECK_CHAR_TABLE (char_table, 0);
 
   if (!NILP (parent))
     {
-      CHECK_CHAR_TABLE (parent, 0);  
+      CHECK_CHAR_TABLE (parent, 0);
 
       for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
 	if (EQ (temp, char_table))
@@ -1344,7 +1345,7 @@
   int i;
 
   CHECK_CHAR_TABLE (char_table, 0);
-  
+
   if (EQ (range, Qnil))
     return XCHAR_TABLE (char_table)->defalt;
   else if (INTEGERP (range))
@@ -1379,7 +1380,7 @@
   int i;
 
   CHECK_CHAR_TABLE (char_table, 0);
-  
+
   if (EQ (range, Qt))
     for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
       XCHAR_TABLE (char_table)->contents[i] = value;
@@ -1515,7 +1516,7 @@
 	      else
 		call2 (function, make_number (c), elt);
 	    }
-  	}	  
+  	}
     }
 }
 
@@ -1674,7 +1675,7 @@
 
   for (i = leni - 1; i >= 0; i--)
     args[i + i] = args[i];
-      
+
   for (i = 1; i < nargs; i += 2)
     args[i] = separator;
 
@@ -1729,7 +1730,6 @@
 
   while (1)
     {
-      
 
 #ifdef HAVE_MENUS
       if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
@@ -1851,7 +1851,7 @@
   CHECK_STRING (prompt, 0);
 
 #ifdef HAVE_MENUS
-  if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) 
+  if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
       && use_dialog_box
       && have_menus_p ())
     {
@@ -1927,7 +1927,7 @@
 absence of emacs or environment extensions.\n\
 Use `provide' to declare that a feature is available.\n\
 This function looks at the value of the variable `features'.")
-     (feature)
+  (feature)
      Lisp_Object feature;
 {
   register Lisp_Object tem;
@@ -1938,7 +1938,7 @@
 
 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
   "Announce that FEATURE is a feature of the current Emacs.")
-     (feature)
+  (feature)
      Lisp_Object feature;
 {
   register Lisp_Object tem;
@@ -1957,7 +1957,7 @@
 If FEATURE is not a member of the list `features', then the feature\n\
 is not loaded; so load the file FILENAME.\n\
 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
-     (feature, file_name)
+  (feature, file_name)
      Lisp_Object feature, file_name;
 {
   register Lisp_Object tem;
@@ -1987,6 +1987,90 @@
   return feature;
 }
 
+/* Primitives for work of the "widget" library.
+   In an ideal world, this section would not have been necessary.
+   However, lisp function calls being as slow as they are, it turns
+   out that some functions in the widget library (wid-edit.el) are the
+   bottleneck of Widget operation.  Here is their translation to C,
+   for the sole reason of efficiency.  */
+
+DEFUN ("widget-plist-member", Fwidget_plist_member, Swidget_plist_member, 2, 2, 0,
+  "Return non-nil if PLIST has the property PROP.\n\
+PLIST is a property list, which is a list of the form\n\
+\(PROP1 VALUE1 PROP2 VALUE2 ...\).  PROP is a symbol.\n\
+Unlike `plist-get', this allows you to distinguish between a missing\n\
+property and a property with the value nil.\n\
+The value is actually the tail of PLIST whose car is PROP.")
+  (plist, prop)
+     Lisp_Object plist, prop;
+{
+  while (CONSP (plist) && !EQ (XCAR (plist), prop))
+    {
+      QUIT;
+      plist = XCDR (plist);
+      plist = CDR (plist);
+    }
+  return plist;
+}
+
+DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
+  "In WIDGET, set PROPERTY to VALUE.\n\
+The value can later be retrieved with `widget-get'.")
+  (widget, property, value)
+     Lisp_Object widget, property, value;
+{
+  CHECK_CONS (widget, 1);
+  XCDR (widget) = Fplist_put (XCDR (widget), property, value);
+}
+
+DEFUN ("widget-get", Fwidget_get, Swidget_get, 2, 2, 0,
+  "In WIDGET, get the value of PROPERTY.\n\
+The value could either be specified when the widget was created, or\n\
+later with `widget-put'.")
+  (widget, property)
+     Lisp_Object widget, property;
+{
+  Lisp_Object tmp;
+
+  while (1)
+    {
+      if (NILP (widget))
+	return Qnil;
+      CHECK_CONS (widget, 1);
+      tmp = Fwidget_plist_member (XCDR (widget), property);
+      if (CONSP (tmp))
+	{
+	  tmp = XCDR (tmp);
+	  return CAR (tmp);
+	}
+      tmp = XCAR (widget);
+      if (NILP (tmp))
+	return Qnil;
+      widget = Fget (tmp, Qwidget_type);
+    }
+}
+
+DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0,
+  "Apply the value of WIDGET's PROPERTY to the widget itself.\n\
+ARGS are passed as extra arguments to the function.")
+  (nargs, args)
+     int nargs;
+     Lisp_Object *args;
+{
+  /* This function can GC. */
+  Lisp_Object newargs[3];
+  struct gcpro gcpro1, gcpro2;
+  Lisp_Object result;
+
+  newargs[0] = Fwidget_get (args[0], args[1]);
+  newargs[1] = args[0];
+  newargs[2] = Flist (nargs - 2, args + 2);
+  GCPRO2 (newargs[0], newargs[2]);
+  result = Fapply (3, newargs);
+  UNGCPRO;
+  return result;
+}
+
 syms_of_fns ()
 {
   Qstring_lessp = intern ("string-lessp");
@@ -1999,6 +2083,8 @@
   staticpro (&Qyes_or_no_p_history);
   Qcursor_in_echo_area = intern ("cursor-in-echo-area");
   staticpro (&Qcursor_in_echo_area);
+  Qwidget_type = intern ("widget-type");
+  staticpro (&Qwidget_type);
 
   Fset (Qyes_or_no_p_history, Qnil);
 
@@ -2063,4 +2149,8 @@
   defsubr (&Sfeaturep);
   defsubr (&Srequire);
   defsubr (&Sprovide);
+  defsubr (&Swidget_plist_member);
+  defsubr (&Swidget_put);
+  defsubr (&Swidget_get);
+  defsubr (&Swidget_apply);
 }