From aba1216900645932e08ab39accf7479ab623e625 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 28 Feb 2025 18:28:58 +0100 Subject: [PATCH] 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) --- lisp/wid-edit.el | 29 +++++++++++++++++ src/fns.c | 62 +------------------------------------ test/lisp/wid-edit-tests.el | 14 ++++++++- 3 files changed, 43 insertions(+), 62 deletions(-) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 26764544532..6db00397baf 100644 --- 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 d289af22cd8..46addee8312 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3828,65 +3828,8 @@ FILENAME are suppressed. */) 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-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; -} + #ifdef HAVE_LANGINFO_CODESET #include #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 755bd12201f..e99347f1666 100644 --- 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")) -- 2.39.5