Subject: bug#77058: [PATCH] Add cl-with-accessors

From: Okamsn <[email-masked]>
Date: Sun, 16 Mar 2025 18:23:25 +0000

Hello,

The attached patch adds the macro `cl-with-accessors'.  This macro uses 
`cl-symbol-macrolet' to treat a symbol like a use of an accessor 
function, such as those made by `cl-defstruct' and `cl-defclass'. This 
can be helpful when using repeated calls to read and write with the 
functions.

It is based on the description at
https://www.lispworks.com/documentation/HyperSpec/Body/m_w_acce.htm

Also, in the test `cl-lib-struct-accessors' in 
test/lisp/emacs-lisp/cl-lib-tests.el, it checks for the keyword 
`:readonly', but the documented keyword is `:read-only'.  Is this a 
typo, or was this intentional?

Thank you.

From 12f18b8222c943ec90669efd4256cf3aae8f0bb8 Mon Sep 17 00:00:00 2001
From: Earl Hyatt <[email-masked]>
Date: Wed, 12 Mar 2025 23:01:49 -0400
Subject: [PATCH] Add cl-with-accessors

* doc/misc/cl.texi (Structures): Mention the new macro.
* lisp/emacs-lisp/cl-macs.el (cl-with-accessors): Add the macro.
* test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-struct-with-accessors):
Test the macro.
* etc/NEWS (New macro 'cl-with-accessors'): Mention the macro.

This macro is useful when making repeated use of a structures accessor
functions, such as reading from a slot and then writing to a slot.
---
 doc/misc/cl.texi                     | 13 +++++++++++++
 etc/NEWS                             |  7 +++++++
 lisp/emacs-lisp/cl-macs.el           | 27 +++++++++++++++++++++++++++
 test/lisp/emacs-lisp/cl-lib-tests.el | 12 ++++++++++++
 4 files changed, 59 insertions(+)

diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 48b8ea09c65..ae1073e9032 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -4225,6 +4225,19 @@ Structures
 
 Other slot options are currently ignored.
 
+The macro @code{cl-with-accessors} can simplify code that repeatedly
+accesses slots.
+
+@example
+(defun add-one-year (person)
+  (cl-with-accessors ((age person-age))
+      person
+    (if (null age)
+        (error "Age is missing")
+      (cl-incf age)))
+  person)
+@end example
+
 For obscure historical reasons, structure options take a different
 form than slot options.  A structure option is either a keyword
 symbol, or a list beginning with a keyword symbol possibly followed
diff --git a/etc/NEWS b/etc/NEWS
index 31a0c4938ad..d4855a0bccd 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2496,6 +2496,13 @@ This function is like 'type-of' except that it sometimes returns
 a more precise type.  For example, for nil and t it returns 'null'
 and 'boolean' respectively, instead of just 'symbol'.
 
+** New macro 'cl-with-accessors'
+This macro is similar to 'map-let', but works with structures and their
+accessors functions.  It is useful when slots' accessor functions are
+use repeatedly, such as reading from a slot and then writing to that
+slot.  Symbol macros are created for the accessor functions using
+'cl-symbol-macrolet', so that they can be used with 'setq' and 'setf'.
+
 +++
 ** New functions 'primitive-function-p' and 'cl-functionp'.
 'primitive-function-p' is like 'subr-primitive-p' except that it returns
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index b07a881ba48..2e132775b9e 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2544,6 +2544,33 @@ cl-once-only
                           collect `(,(car name) ,gensym))
              ,@body)))))
 
+;;;###autoload
+(defmacro cl-with-accessors (bindings instance &rest body)
+  "Generate code using symbols as accessing expressions for INSTANCE inside BODY.
+
+This macro helps when writing code that makes repeated use of the
+accessor functions of a structure or object instance, such as those
+created by `cl-defstruct' and `defclass'.
+
+Inside BODY, SYMBOL-NAME is treated as the function call (ACCESSOR-NAME
+INSTANCE) using `cl-symbol-macrolet'.  SYMBOL-NAME can be used with
+`setf' and `setq' as a generalized variable.
+
+\(fn ((SYMBOL-NAME ACCESSOR-NAME) ...) INSTANCE &REST BODY)"
+  (declare (debug [(&rest (symbolp place)) form body])
+           (indent 2))
+  (cond ((null body)
+         (macroexp-warn-and-return "No body given" nil 'empty-body))
+        ((null bindings)
+         (macroexp-warn-and-return "No bindings given"
+                                   (macroexp-progn body)
+                                   'suspicious))
+        (t
+         (cl-once-only (instance)
+           `(cl-symbol-macrolet ,(cl-loop for (var place) in bindings
+                                          collect `(,var (,place ,instance)))
+              ,@body)))))
+
 ;;; Multiple values.
 
 ;;;###autoload
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
index a9c71fa5808..4db684b4db7 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -227,6 +227,18 @@ cl-lib-struct-constructors
                         (documentation 'cl-lib--con-2 t)))
   (should (mystruct-p (cl-lib--con-1)))
   (should (mystruct-p (cl-lib--con-2))))
+(ert-deftest cl-lib-struct-with-accessors ()
+  (let ((x (make-mystruct :abc 1 :def 2)))
+    (cl-with-accessors ((abc mystruct-abc)
+                        (def mystruct-def))
+        x
+      (should (= abc 1))
+      (should (= def 2))
+      (setf def 3)
+      (should (= def 3))
+      (setq def 4)
+      (should (= def 4)))
+    (should (= 4 (mystruct-def x)))))
 
 (ert-deftest cl-lib-arglist-performance ()
   ;; An `&aux' should not cause lambda's arglist to be turned into an &rest
-- 
2.43.0