Lift widget functions from C to Lisp

In the mid-1990s, these functions were moved from Lisp to C to
"improve performance".  However, Moore's Law, and perhaps other
improvements too, has made this rationale irrelevant.

On this machine, with --native-compilation=no, I observed only a
slight ~4% performance difference.  For example, displaying a buffer
full of widgets (e.g., 'M-x customize RET browse-url RET') takes 4ms
here, meaning the performance gap is under 0.1ms.  Even on less
powerful machines, this difference would remain imperceptible.  Given
this, let's lift these functions back to to Lisp, which offers the
usual benefits.

We already have solid test coverage, but let's add a more focused test
for 'widget-get' and 'widget-put' to be thorough.

* lisp/wid-edit.el (widget-put, widget-get, widget-apply): Move to
Lisp from...
* src/fns.c (Fwidget_put, Fwidget_get, Fwidget_apply): ...here.
(syms_of_fns): Remove defsubrs for the above functions.
* test/lisp/wid-edit-tests.el
(widget-test-editable-field-widget-get/put): New test.

(cherry picked from commit 8b659313b83c82cfe09af1638289fccdfc9af23d)

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 26764544532dc6d50e4cdca55e9b8bf9c3f0931a..6db00397baf1260995f4a938cfcbfd49dda801af 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -621,6 +621,28 @@ and saves that overlay under the :inactive property for WIDGET."
         (symbolp (car widget))
         (get (car widget) 'widget-type))))
 
+;;;###autoload
+(defun widget-put (widget property value)
+  "In WIDGET, set PROPERTY to VALUE.
+The value can later be retrieved with `widget-get'."
+  (setcdr widget (plist-put (cdr widget) property value)))
+
+;;;###autoload
+(defun widget-get (widget property)
+  "In WIDGET, get the value of PROPERTY.
+The value could either be specified when the widget was created, or
+later with `widget-put'."
+  (let (tmp)
+    (catch 'found
+      (while widget
+        (cond ((and (setq tmp (plist-member (cdr widget) property))
+                    (consp tmp))
+               (throw 'found (cadr tmp)))
+              ((setq tmp (widget-type widget))
+               (setq widget (get tmp 'widget-type)))
+              (t
+               (throw 'found nil)))))))
+
 (defun widget-get-indirect (widget property)
   "In WIDGET, get the value of PROPERTY.
 If the value is a symbol, return its binding.
@@ -638,6 +660,13 @@ Otherwise, just return the value."
         (widget-member (get (car widget) 'widget-type) property))
        (t nil)))
 
+;;;###autoload
+(defun widget-apply (widget property &rest args)
+  "Apply the value of WIDGET's PROPERTY to the widget itself.
+Return the result of applying the value of PROPERTY to WIDGET.
+ARGS are passed as extra arguments to the function."
+  (apply (widget-get widget property) widget args))
+
 (defun widget-value (widget)
   "Extract the current value of WIDGET."
   (widget-apply widget

diff --git a/src/fns.c b/src/fns.c
index d289af22cd8f376178c0d7ce5948ca7b6eb96a6a..46addee831295e1f80269c824ded939ac58e9c1e 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -3828,65 +3828,8 @@ FILENAME are suppressed.  */)
 
   return feature;
 }
-\f
-/* 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-put", Fwidget_put, Swidget_put, 3, 3, 0,
-       doc: /* In WIDGET, set PROPERTY to VALUE.
-The value can later be retrieved with `widget-get'.  */)
-  (Lisp_Object widget, Lisp_Object property, Lisp_Object value)
-{
-  CHECK_CONS (widget);
-  XSETCDR (widget, plist_put (XCDR (widget), property, value));
-  return value;
-}
-
-DEFUN ("widget-get", Fwidget_get, Swidget_get, 2, 2, 0,
-       doc: /* In WIDGET, get the value of PROPERTY.
-The value could either be specified when the widget was created, or
-later with `widget-put'.  */)
-  (Lisp_Object widget, Lisp_Object property)
-{
-  Lisp_Object tmp;
-
-  while (1)
-    {
-      if (NILP (widget))
-       return Qnil;
-      CHECK_CONS (widget);
-      tmp = 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,
-       doc: /* Apply the value of WIDGET's PROPERTY to the widget itself.
-Return the result of applying the value of PROPERTY to WIDGET.
-ARGS are passed as extra arguments to the function.
-usage: (widget-apply WIDGET PROPERTY &rest ARGS)  */)
-  (ptrdiff_t nargs, Lisp_Object *args)
-{
-  Lisp_Object widget = args[0];
-  Lisp_Object property = args[1];
-  Lisp_Object propval = Fwidget_get (widget, property);
-  Lisp_Object trailing_args = Flist (nargs - 2, args + 2);
-  Lisp_Object result = CALLN (Fapply, propval, widget, trailing_args);
-  return result;
-}
 
+\f
 #ifdef HAVE_LANGINFO_CODESET
 #include <langinfo.h>
 #endif
@@ -6905,9 +6848,6 @@ For best results this should end in a space.  */);
   defsubr (&Srequire);
   defsubr (&Sprovide);
   defsubr (&Splist_member);
-  defsubr (&Swidget_put);
-  defsubr (&Swidget_get);
-  defsubr (&Swidget_apply);
   defsubr (&Sbase64_encode_region);
   defsubr (&Sbase64_decode_region);
   defsubr (&Sbase64_encode_string);

diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 755bd12201f58576e7d92e04c8a61fa1d1ac3cf7..e99347f1666d15d5c713d4d5e28035e132682beb 100644 (file)
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -22,8 +22,20 @@
 (require 'ert)
 (require 'wid-edit)
 
+(ert-deftest widget-test-editable-field-widget-get/put ()
+  (with-temp-buffer
+    (let ((widget (widget-create 'editable-field
+                                 :size 13
+                                 :format "Name: %v "
+                                 "My Name")))
+      (should (eq (widget-get widget :size) 13))
+      (should (equal (widget-get widget :format) "Name: %v "))
+      (widget-put widget :size 1)
+      (widget-put widget :format "foo")
+      (should (eq (widget-get widget :size) 1))
+      (should (equal (widget-get widget :format) "foo")))))
+
 (ert-deftest widget-at ()
-  "Test `widget-at' behavior."
   (with-temp-buffer
     (should-not (widget-at))
     (let ((marco (widget-create 'link "link widget"))