branch: externals/compat
commit ac9d0a6e7866d17d5f71ae9c4868c6e787b9314e
Author: Joseph Turner <jos...@breatheoutbreathe.in>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Add copy-tree
---
NEWS.org | 2 ++
compat-30.el | 31 ++++++++++++++++++++++++
compat-tests.el | 75 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
compat.texi | 14 +++++++++++
4 files changed, 122 insertions(+)
diff --git a/NEWS.org b/NEWS.org
index 99dab032eb..d938a193e5 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -7,6 +7,8 @@
- compat-28: Improve =make-separator-line= visuals on graphic displays.
- compat-28: Add =native-comp-available-p=, which always returns nil.
- compat-29: Add variable =lisp-directory=.
+- compat-30: Replace ~copy-tree~ with version from Emacs 30, support
+ copying records with non-nil optional second argument.
* Release of "Compat" Version 29.1.4.1
diff --git a/compat-30.el b/compat-30.el
index fabb48b28e..879a743b72 100644
--- a/compat-30.el
+++ b/compat-30.el
@@ -28,5 +28,36 @@
;; TODO Update to 30.1 as soon as the Emacs emacs-30 branch version bumped
(compat-version "30.0.50")
+;;;; Defined in subr.el
+
+(compat-defun copy-tree (tree &optional vectors-and-records) ;;
<compat-tests:copy-tree>
+ "Handle copying records when optional arg is non-nil."
+ :extended t
+ (declare (side-effect-free error-free))
+ ;; `recordp' was not added until Emacs 26
+ (let ((compat--recordp (if (fboundp #'recordp)
+ #'recordp
+ #'always)))
+ (if (consp tree)
+ (let (result)
+ (while (consp tree)
+ (let ((newcar (car tree)))
+ (if (or (consp (car tree))
+ (and vectors-and-records
+ (or (vectorp (car tree)) (funcall compat--recordp
(car tree)))))
+ (setq newcar (compat--copy-tree (car tree)
vectors-and-records)))
+ (push newcar result))
+ (setq tree (cdr tree)))
+ (nconc (nreverse result)
+ (if (and vectors-and-records (or (vectorp tree) (funcall
compat--recordp tree)))
+ (compat--copy-tree tree vectors-and-records)
+ tree)))
+ (if (and vectors-and-records (or (vectorp tree) (funcall compat--recordp
tree)))
+ (let ((i (length (setq tree (copy-sequence tree)))))
+ (while (>= (setq i (1- i)) 0)
+ (aset tree i (compat--copy-tree (aref tree i)
vectors-and-records)))
+ tree)
+ tree))))
+
(provide 'compat-30)
;;; compat-30.el ends here
diff --git a/compat-tests.el b/compat-tests.el
index 060c9caf0c..1fa5de33a0 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -2992,5 +2992,80 @@
(with-temp-buffer
(should-equal (take 3 (widget-create 'key)) '(key :value ""))))
+(ert-deftest compat-copy-tree ()
+ ;; Adapted from Emacs /test/lisp/subr-tests.el
+ ;; Check that values other than conses, vectors and records are
+ ;; neither copied nor traversed.
+ (cl-defstruct compat-test--a foo)
+ (cl-defstruct compat-test--c foo)
+ (cl-defstruct compat-test--d)
+ (cl-defstruct compat-test--e foo)
+ (let ((s (propertize "abc" 'prop (list 11 12)))
+ (h (make-hash-table :test #'equal)))
+ (puthash (list 1 2) (list 3 4) h)
+ (dolist (x (list nil 'a "abc" s h))
+ (should (eq (compat-call copy-tree x) x))
+ (should (eq (compat-call copy-tree x t) x))))
+
+ ;; Use the printer to detect common parts of Lisp values.
+ (let ((print-circle t))
+ (cl-labels ((prn3 (x y z) (prin1-to-string (list x y z)))
+ (cat3 (x y z) (concat "(" x " " y " " z ")")))
+ (let ((x '(a (b ((c) . d) e) (f))))
+ (should (equal (prn3 x (compat-call copy-tree x) (compat-call
copy-tree x t))
+ (cat3 "(a (b ((c) . d) e) (f))"
+ "(a (b ((c) . d) e) (f))"
+ "(a (b ((c) . d) e) (f))"))))
+ (let ((x `(a [b (c d)] ,(make-compat-test--e :foo '(f [g])))))
+ (should (equal (prn3 x (compat-call copy-tree x) (compat-call
copy-tree x t))
+ (if (< emacs-major-version 26)
+ (cat3 "(a #1=[b (c d)] #2=[cl-struct-compat-test--e
(f [g])])"
+ "(a #1# #2#)"
+ "(a [b (c d)] [cl-struct-compat-test--e (f
[g])])")
+ (cat3 "(a #1=[b (c d)] #2=#s(compat-test--e (f [g])))"
+ "(a #1# #2#)"
+ "(a [b (c d)] #s(compat-test--e (f [g])))")))))
+ (let ((x (vector 'a `(b ,(make-compat-test--c :foo 'd)))))
+ (should (equal (prn3 x (compat-call copy-tree x) (compat-call
copy-tree x t))
+ (if (< emacs-major-version 26)
+ (cat3 "#1=[a (b [cl-struct-compat-test--c d])]"
+ "#1#"
+ "[a (b [cl-struct-compat-test--c d])]")
+ (cat3 "#1=[a (b #s(compat-test--c d))]"
+ "#1#"
+ "[a (b #s(compat-test--c d))]")))))
+ (let ((x (make-compat-test--a :foo '(b [c d]))))
+ (should (equal (prn3 x (compat-call copy-tree x) (compat-call
copy-tree x t))
+ (if (< emacs-major-version 26)
+ (cat3 "#1=[cl-struct-compat-test--a (b [c d])]"
+ "#1#"
+ "[cl-struct-compat-test--a (b [c d])]")
+ (cat3 "#1=#s(compat-test--a (b [c d]))"
+ "#1#"
+ "#s(compat-test--a (b [c d]))")))))
+ ;; Check cdr recursion.
+ (let ((x `(a b . ,(vector `(c . ,(make-compat-test--d))))))
+ (should (equal (prn3 x (compat-call copy-tree x) (compat-call
copy-tree x t))
+ (if (< emacs-major-version 26)
+ (cat3 "(a b . #1=[(c .
[cl-struct-compat-test--d])])"
+ "(a b . #1#)"
+ "(a b . [(c . [cl-struct-compat-test--d])])")
+ (cat3 "(a b . #1=[(c . #s(compat-test--d))])"
+ "(a b . #1#)"
+ "(a b . [(c . #s(compat-test--d))])")))))
+ ;; Check that we can copy DAGs (the result is a tree).
+ (let ((x (list '(a b) nil [c d] nil (make-compat-test--e :foo 'f) nil)))
+ (setf (nth 1 x) (nth 0 x))
+ (setf (nth 3 x) (nth 2 x))
+ (setf (nth 5 x) (nth 4 x))
+ (should (equal (prn3 x (compat-call copy-tree x) (compat-call
copy-tree x t))
+ (if (< emacs-major-version 26)
+ (cat3 "(#1=(a b) #1# #2=[c d] #2#
#3=[cl-struct-compat-test--e f] #3#)"
+ "((a b) (a b) #2# #2# #3# #3#)"
+ "((a b) (a b) [c d] [c d]
[cl-struct-compat-test--e f] [cl-struct-compat-test--e f])")
+ (cat3 "(#1=(a b) #1# #2=[c d] #2#
#3=#s(compat-test--e f) #3#)"
+ "((a b) (a b) #2# #2# #3# #3#)"
+ "((a b) (a b) [c d] [c d] #s(compat-test--e f)
#s(compat-test--e f))"))))))))
+
(provide 'compat-tests)
;;; compat-tests.el ends here
diff --git a/compat.texi b/compat.texi
index 9eefdaa377..5a7388fb1b 100644
--- a/compat.texi
+++ b/compat.texi
@@ -3333,6 +3333,20 @@ care.
These functions must be called explicitly via @code{compat-call},
since their calling convention or behavior was extended in Emacs 30.1:
+@c copied from lispref/lists.texi
+@defun copy-tree tree &optional vectors-and-records
+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{vectors-and-records} is non-@code{nil}, it copies vectors and records
+too (and operates recursively on their elements). The @var{tree}
+argument must not contain cycles.
+@end defun
+
@subsection Missing Definitions
Compat does not provide support for the following Lisp features
implemented in 30.1:
