Add cl-with-accessors

* lisp/emacs-lisp/cl-macs.el (cl-with-accessors): New macro.
* doc/misc/cl.texi (Structures): Mention the new macro.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-lib-struct-with-accessors):
New Test.
* 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.  It
is similar to 'with-slots' from EIEIO, but uses accessor functions
instead of slot names.

(cherry picked from commit e04d1dafc700813c835ae4e45af4e104c49e8875)

diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index e51e245c736b2d983a0ebc8f7ef1e66b7a06a185..7219494391b0d0204401c9281ef751c45ebd8544 100644 (file)
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -4066,6 +4066,55 @@ A documentation string describing the slot.
 
 Other slot options are currently ignored.
 
+@defmac cl-with-accessors name bindings body@dot{}
+You can use @code{cl-with-accessors} to lexically define symbols as
+expressions calling the given accessor functions on a single instance of
+a structure or class defined by @code{cl-defstruct} or @code{defclass}
+(@pxref{eieio}).  This can simplify code that repeatedly accesses slots.
+With it, you can use @code{setf} and @code{setq} on the symbols like
+normal variables, modifying the values in the structure.  Unlike the
+macro @code{with-slots} (@pxref{Accessing Slots,,,eieio,EIEIO}), because
+the symbol expands to a function call, @code{cl-with-accessors} can be
+used with any generalized variable that can take a single argument, such
+as @code{cl-first} and @code{cl-rest}.
+@end defmac
+
+@example
+;; Using accessors with long, clear names without the macro:
+(defun internal-normalization (person)
+  "Correct the values of the slots in PERSON to be as expected."
+  ;; Check the values of the structure:
+  (when (equal (person-optional-secondary-data person) "")
+    (setf (person-optional-secondary-data person) nil))
+  (when (null (person-access-settings person))
+    (setf (person-access-settings person) 'default))
+  (when (< (long-accessor-name-that-can-become-unreadable-when-repeated
+            person)
+           9)
+    (cl-incf (long-accessor-name-that-can-become-unreadable-when-repeated
+              person)
+             100))
+  ;; And so on before returning the structure:
+  person)
+
+;; Using accessors with long, clear names with the macro:
+(defun internal-normalization (person)
+  "Correct the values of the slots in PERSON to be as expected."
+  (cl-with-accessors ((secondary-data person-optional-secondary-data)
+                      (access-settings person-access-settings)
+                      (short-name person-much-longer-accessor-name))
+      person
+    ;; Check the values of the structure:
+    (when (equal secondary-data "")
+      (setf secondary-data nil))
+    (when (null access-settings)
+      (setf access-settings 'default))
+    (when (< short-name 9)
+      (cl-incf short-name 100))
+    ;; And so on before returning the structure:
+    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/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 847a6454b1cb3fc71ad4f821985fce1f5d1fafa7..e83dd2fe828865f64bf58cdf4f9c3c35a38ea919 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2526,6 +2526,50 @@ See also `macroexp-let2'."
                           collect `(,(car name) ,gensym))
              ,@body)))))
 
+;;;###autoload
+(defmacro cl-with-accessors (bindings instance &rest body)
+  "Use BINDINGS as function calls on 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'.
+
+BINDINGS is a list of (NAME ACCESSOR) pairs.  Inside BODY, NAME is
+treated as the function call (ACCESSOR INSTANCE) using
+`cl-symbol-macrolet'.  NAME can be used with `setf' and `setq' as a
+generalized variable.  Because of how the accessor is used,
+`cl-with-accessors' can be used with any generalized variable that can
+take a single argument, such as `car' and `cdr'.
+
+See also the macro `with-slots' described in the Info
+node `(eieio)Accessing Slots', which is similar, but uses slot names
+instead of accessor functions.
+
+\(fn ((NAME ACCESSOR) ...) INSTANCE &rest BODY)"
+  (declare (debug [(&rest (symbolp symbolp)) form body])
+           (indent 2))
+  (cond ((null body)
+         (macroexp-warn-and-return "`cl-with-accessors' used with empty body"
+                                   nil 'empty-body))
+        ((null bindings)
+         (macroexp-warn-and-return "`cl-with-accessors' used without accessors"
+                                   (macroexp-progn body)
+                                   'suspicious))
+        (t
+         (cl-once-only (instance)
+           (let ((symbol-macros))
+             (dolist (b bindings)
+               (pcase b
+                 (`(,(and (pred symbolp) var)
+                    ,(and (pred symbolp) accessor))
+                  (push `(,var (,accessor ,instance))
+                        symbol-macros))
+                 (_
+                  (error "Malformed `cl-with-accessors' binding: %S" b))))
+             `(cl-symbol-macrolet
+                  ,symbol-macros
+                ,@body))))))
+
 ;;; Multiple values.
 
 ;;;###autoload

diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 64ccdd2d1cedc2f2e7ecca31ee59b8d1138426ec..df612c11a096a927666cbbe01ab09a5a1bf9a9f0 100644 (file)
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -541,6 +541,21 @@ collection clause."
   (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-error (setf abc 99))
+      (should (= def 2))
+      (setf def 3)
+      (should (= def 3))
+      (setq def 4)
+      (should (= def 4)))
+    (should (= 4 (mystruct-def x)))
+    (should (= 1 (mystruct-abc x)))))
+ 
 (ert-deftest cl-lib-arglist-performance ()
   ;; An `&aux' should not cause lambda's arglist to be turned into an &rest
   ;; that's parsed by hand.