From 14383e9fe8a107f597d06ad486a441b761cc6ade Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Sun, 14 May 2023 21:02:15 -0700 Subject: [PATCH] Make copy-tree work with records --- doc/lispref/lists.texi | 9 +++++---- doc/lispref/records.texi | 12 ++++++++++++ etc/NEWS.29 | 5 +++++ lisp/emacs-lisp/shortdoc.el | 2 ++ lisp/subr.el | 14 +++++++------- test/lisp/subr-tests.el | 31 +++++++++++++++++++++++++++++++ 6 files changed, 62 insertions(+), 11 deletions(-) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 22a5f7f1239..16ed0358974 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -696,16 +696,17 @@ not a list, the sequence's elements do not become elements of the resulting list. Instead, the sequence becomes the final @sc{cdr}, like any other non-list final argument. -@defun copy-tree tree &optional vecp +@defun copy-tree tree &optional vector-like-p This function returns a copy of the tree @var{tree}. If @var{tree} is a cons cell, this makes a new cons cell with the same @sc{car} and @sc{cdr}, then recursively copies the @sc{car} and @sc{cdr} in the same way. Normally, when @var{tree} is anything other than a cons cell, -@code{copy-tree} simply returns @var{tree}. However, if @var{vecp} is -non-@code{nil}, it copies vectors too (and operates recursively on -their elements). This function cannot cope with circular lists. +@code{copy-tree} simply returns @var{tree}. However, if +@var{vector-like-p} is non-@code{nil}, it copies vectors and records +too (and operates recursively on their elements). This function +cannot cope with circular lists. @end defun @defun flatten-tree tree diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi index 26c6f30a6b5..0f44198a6b0 100644 --- a/doc/lispref/records.texi +++ b/doc/lispref/records.texi @@ -81,6 +81,18 @@ This function returns a new record with type @var{type} and @end example @end defun +@defun copy-tree tree &optional vector-like-p +This function copies a record when @var{vector-like-p} is +non-@code{nil}. + +@example +@group +(copy-tree (record 'foo "a")) + @result{} #s(foo "a") +@end group +@end example +@end defun + @node Backward Compatibility @section Backward Compatibility diff --git a/etc/NEWS.29 b/etc/NEWS.29 index fa428d9c790..ae9a89203bf 100644 --- a/etc/NEWS.29 +++ b/etc/NEWS.29 @@ -4897,6 +4897,11 @@ Instead, Emacs uses the already-existing 'make-directory' handlers. This can let a caller know whether it created DIR. Formerly, 'make-directory's return value was unspecified. ++++ +** 'copy-tree' now correctly copies records when its optional second +argument is non-nil. The second argument has been renamed from VECP +to VECTOR-LIKE-P since it now works with both vectors and records. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 9a6f5dd12ce..6580e0e4e0c 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -833,6 +833,8 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (seq-subseq :eval (seq-subseq [1 2 3 4 5] 1 3) :eval (seq-subseq [1 2 3 4 5] 1)) + (copy-tree + :eval (copy-tree [1 2 3 4])) "Mapping Over Vectors" (mapcar :eval (mapcar #'identity [1 2 3])) diff --git a/lisp/subr.el b/lisp/subr.el index 03d3324f3d8..83735933963 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -824,26 +824,26 @@ of course, also replace TO with a slightly larger value next (+ from (* n inc))))) (nreverse seq)))) -(defun copy-tree (tree &optional vecp) +(defun copy-tree (tree &optional vector-like-p) "Make a copy of TREE. If TREE is a cons cell, this recursively copies both its car and its cdr. Contrast to `copy-sequence', which copies only along the cdrs. With second -argument VECP, this copies vectors as well as conses." +argument VECTOR-LIKE-P, this copies vectors and records as well as conses." (declare (side-effect-free error-free)) (if (consp tree) (let (result) (while (consp tree) (let ((newcar (car tree))) - (if (or (consp (car tree)) (and vecp (vectorp (car tree)))) - (setq newcar (copy-tree (car tree) vecp))) + (if (or (consp (car tree)) (and vector-like-p (or (vectorp (car tree)) (recordp (car tree))))) + (setq newcar (copy-tree (car tree) vector-like-p))) (push newcar result)) (setq tree (cdr tree))) (nconc (nreverse result) - (if (and vecp (vectorp tree)) (copy-tree tree vecp) tree))) - (if (and vecp (vectorp tree)) + (if (and vector-like-p (or (vectorp tree) (recordp tree))) (copy-tree tree vector-like-p) tree))) + (if (and vector-like-p (or (vectorp tree) (recordp tree))) (let ((i (length (setq tree (copy-sequence tree))))) (while (>= (setq i (1- i)) 0) - (aset tree i (copy-tree (aref tree i) vecp))) + (aset tree i (copy-tree (aref tree i) vector-like-p))) tree) tree))) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 8f46c2af136..4ebb68556be 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1206,5 +1206,36 @@ final or penultimate step during initialization.")) (should (equal a-dedup '("a" "b" "a" "b" "c"))) (should (eq a a-dedup)))) +(ert-deftest subr--copy-tree () + (should (eq (copy-tree nil) nil)) + (let* ((a (list (list "a") "b" (list "c") "g")) + (copy1 (copy-tree a)) + (copy2 (copy-tree a t))) + (should (equal a copy1)) + (should (equal a copy2)) + (should-not (eq a copy1)) + (should-not (eq a copy2))) + (let* ((a (list (list "a") "b" (list "c" (record 'foo "d")) (list ["e" "f"]) "g")) + (copy1 (copy-tree a)) + (copy2 (copy-tree a t))) + (should (equal a copy1)) + (should (equal a copy2)) + (should-not (eq a copy1)) + (should-not (eq a copy2))) + (let* ((a (record 'foo "a" (record 'bar "b"))) + (copy1 (copy-tree a)) + (copy2 (copy-tree a t))) + (should (equal a copy1)) + (should (equal a copy2)) + (should (eq a copy1)) + (should-not (eq a copy2))) + (let* ((a ["a" "b" ["c" ["d"]]]) + (copy1 (copy-tree a)) + (copy2 (copy-tree a t))) + (should (equal a copy1)) + (should (equal a copy2)) + (should (eq a copy1)) + (should-not (eq a copy2)))) + (provide 'subr-tests) ;;; subr-tests.el ends here -- 2.40.1