bug#63513: [PATCH] Make persist-defvar work with records and hash tables

[Joseph Turner via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 258 bytes --]

The patch should now work on Emacs versions before Emacs 30. I also
added tests for persisting records and hash tables.

Instead of copying the updated behavior of copy-tree into persist.el,
would it be more appropriate to require compat.el?

Best,

Joseph


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-test-persist-save-macro.patch --]
[-- Type: text/x-diff, Size: 3379 bytes --]

From 7907521e72e2e99b883912f250b7afb14cbf5e80 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Tue, 23 May 2023 12:57:02 -0700
Subject: [PATCH 1/5] Add test-persist-save macro

---
 test/persist-tests.el | 76 +++++++++++++++++++------------------------
 1 file changed, 33 insertions(+), 43 deletions(-)

diff --git a/test/persist-tests.el b/test/persist-tests.el
index b6645a9297..0a85b78767 100644
--- a/test/persist-tests.el
+++ b/test/persist-tests.el
@@ -25,51 +25,41 @@ (ert-deftest test-persist-save-only-persistant ()
    :type 'error
    :exclude-subtypes t))
 
-(ert-deftest test-persist-save ()
-  (with-local-temp-persist
-   (let ((sym (cl-gensym)))
-     ;; precondition
-   (should-not (file-exists-p (persist--file-location sym)))
-     (set sym 10)
-     (persist-symbol sym 10)
-     (persist-save sym)
-     (should t)
-     (should-not (file-exists-p (persist--file-location sym)))
-     (set sym 20)
-     (persist-save sym)
-     (should (file-exists-p (persist--file-location sym)))
-     (should
-      (string-match-p
-       "20"
-       (with-temp-buffer
-         (insert-file-contents (persist--file-location sym))
-         (buffer-string))))
-     (set sym 10)
-     (persist-save sym)
-     (should-not (file-exists-p (persist--file-location sym)))
-     (should-error
-      (persist-save 'fred)))))
+(defmacro test-persist-save (init default change printed-changed)
+  "Test persisting symbols.
+- symbol is not persisted when value is set to INIT and default
+  value is set to DEFAULT.
+- symbol is persisted when value is changed according to CHANGE.
+- persisted file contents match PRINTED-CHANGED.
+- symbol is not persisted after value is set back to DEFAULT."
+  `(with-local-temp-persist
+    (let ((sym (cl-gensym)))
+      (should-not (file-exists-p (persist--file-location sym)))
+      (set sym ,init)
+      (persist-symbol sym ,default)
+      (persist-save sym)
+      (should t)
+      (should-not (file-exists-p (persist--file-location sym)))
+      ,change
+      (persist-save sym)
+      (should (file-exists-p (persist--file-location sym)))
+      (should
+       (string-match-p
+        ,printed-changed
+        (with-temp-buffer
+          (insert-file-contents (persist--file-location sym))
+          (buffer-string))))
+      (set sym ,default)
+      (persist-save sym)
+      (should-not (file-exists-p (persist--file-location sym))))))
 
-(ert-deftest test-persist-save-non-number ()
-  "Test saving something that is not a number.
+(ert-deftest test-persist-save-number ()
+  "Test saving number."
+  (test-persist-save 1 1 (set sym 2) "2"))
 
-`test-persist-save' missed "
-  (with-local-temp-persist
-   (let ((sym (cl-gensym)))
-     (set sym "fred")
-     (persist-symbol sym "fred")
-     (persist-save sym)
-     (should t)
-     (should-not (file-exists-p (persist--file-location sym)))
-     (set sym "george")
-     (persist-save sym)
-     (should (file-exists-p (persist--file-location sym)))
-     (should
-      (string-match-p
-       "george"
-       (with-temp-buffer
-         (insert-file-contents (persist--file-location sym))
-         (buffer-string)))))))
+(ert-deftest test-persist-save-string ()
+  "Test saving string."
+  (test-persist-save "foo" "foo" (set sym "bar") "bar"))
 
 (ert-deftest test-persist-load ()
   (with-local-temp-persist
-- 
2.40.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Add-persist-hash-equal.patch --]
[-- Type: text/x-diff, Size: 1460 bytes --]

From 41f90ac59a26018382d1bb9153af08ce4b9423ff Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Tue, 23 May 2023 12:52:24 -0700
Subject: [PATCH 2/5] Add persist-hash-equal

See bug#63671.
---
 persist.el | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/persist.el b/persist.el
index d80943d19e..0069273ca2 100644
--- a/persist.el
+++ b/persist.el
@@ -187,5 +187,22 @@ (defun persist--save-all ()
 (add-hook 'kill-emacs-hook
           'persist--save-all)
 
+(defun persist-hash-equal (hash1 hash2)
+  "Return non-nil when the contents of HASH1 and HASH2 are equal.
+Table values are compared using `equal' unless they are both hash
+tables themselves, in which case `hash-equal' is used.
+Does not compare equality predicates."
+  (and (= (hash-table-count hash1)
+          (hash-table-count hash2))
+       (catch 'flag (maphash (lambda (key hash1-value)
+                               (let ((hash2-value (gethash key hash2)))
+                                 (or (if (and (hash-table-p hash1-value)
+                                              (hash-table-p hash2-value))
+                                         (hash-equal hash1-value hash2-value)
+                                       (equal hash1-value hash2-value))
+                                     (throw 'flag nil))))
+                             hash1)
+              t)))
+
 (provide 'persist)
 ;;; persist.el ends here
-- 
2.40.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Make-persist-defvar-work-with-hash-tables.patch --]
[-- Type: text/x-diff, Size: 2988 bytes --]

From 53e166cb0c7c2624a5a54edafe8828d7b7edc612 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Tue, 23 May 2023 13:09:29 -0700
Subject: [PATCH 3/5] Make persist-defvar work with hash tables

Previously, when persist-defvar received a hash table for an initial
value, updated values were not persisted.
---
 persist.el            | 16 +++++++++++-----
 test/persist-tests.el |  8 ++++++++
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/persist.el b/persist.el
index 0069273ca2..725f2f71cf 100644
--- a/persist.el
+++ b/persist.el
@@ -118,7 +118,9 @@ (defun persist-symbol (symbol &optional initvalue)
   (let ((initvalue (or initvalue (symbol-value symbol))))
     (add-to-list 'persist--symbols symbol)
     (put symbol 'persist t)
-    (put symbol 'persist-default initvalue)))
+    (if (hash-table-p initvalue)
+        (put symbol 'persist-default (copy-hash-table initvalue))
+      (put symbol 'persist-default initvalue))))
 
 (defun persist--persistant-p (symbol)
   "Return non-nil if SYMBOL is a persistant variable."
@@ -132,9 +134,13 @@ (defun persist-save (symbol)
   (unless (persist--persistant-p symbol)
     (error (format
             "Symbol %s is not persistant" symbol)))
-  (let ((symbol-file-loc (persist--file-location symbol)))
-    (if (equal (symbol-value symbol)
-               (persist-default symbol))
+  (let ((symbol-file-loc (persist--file-location symbol))
+        (value (symbol-value symbol))
+        (default (persist-default symbol)))
+    (if (if (and (hash-table-p value)
+                 (hash-table-p default))
+            (persist-hash-equal value default)
+          (equal value default))
         (when (file-exists-p symbol-file-loc)
           (delete-file symbol-file-loc))
       (let ((dir-loc
@@ -148,7 +154,7 @@ (defun persist-save (symbol)
                 (print-escape-control-characters t)
                 (print-escape-nonascii t)
                 (print-circle t))
-            (print (symbol-value symbol) (current-buffer)))
+            (print value (current-buffer)))
           (write-region (point-min) (point-max)
                         symbol-file-loc
                         nil 'quiet))))))
diff --git a/test/persist-tests.el b/test/persist-tests.el
index 0a85b78767..8a30a24e23 100644
--- a/test/persist-tests.el
+++ b/test/persist-tests.el
@@ -61,6 +61,14 @@ (ert-deftest test-persist-save-string ()
   "Test saving string."
   (test-persist-save "foo" "foo" (set sym "bar") "bar"))
 
+(ert-deftest test-persist-save-hash ()
+  "Test saving hash table."
+  (let* ((hash (make-hash-table))
+         (default (copy-hash-table hash)))
+    (test-persist-save hash default
+                       (puthash 'foo "bar" (symbol-value sym))
+                       "#s(hash-table size 65 test eql rehash-size 1.5 rehash-threshold 0.8125 data (foo \"bar\"))")))
+
 (ert-deftest test-persist-load ()
   (with-local-temp-persist
    (let ((sym (cl-gensym)))
-- 
2.40.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-Add-persist-copy-tree.patch --]
[-- Type: text/x-diff, Size: 1912 bytes --]

From ccc1be590b6c7b71aaa4ee3dd3bf25184ea7c122 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Tue, 23 May 2023 13:43:02 -0700
Subject: [PATCH 4/5] Add persist-copy-tree

The behavior of copy-tree was changed in Emacs 30. This function will
ensure that persist works correctly for previous Emacs versions.
---
 persist.el | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/persist.el b/persist.el
index 725f2f71cf..eb408b5dca 100644
--- a/persist.el
+++ b/persist.el
@@ -210,5 +210,34 @@ (defun persist-hash-equal (hash1 hash2)
                              hash1)
               t)))
 
+
+(defun persist-copy-tree (tree &optional vectors-and-records)
+  "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 the second argument VECTORS-AND-RECORDS non-nil, this
+traverses and 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 vectors-and-records
+                         (or (vectorp (car tree)) (recordp (car tree)))))
+		(setq newcar (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) (recordp tree)))
+                   (copy-tree tree vectors-and-records)
+                 tree)))
+    (if (and vectors-and-records (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) vectors-and-records)))
+	  tree)
+      tree)))
+
 (provide 'persist)
 ;;; persist.el ends here
-- 
2.40.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-Make-persist-defvar-work-with-records.patch --]
[-- Type: text/x-diff, Size: 1763 bytes --]

From 4658bde147253d2f070b14c6f54300f640da063e Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Tue, 23 May 2023 13:44:40 -0700
Subject: [PATCH 5/5] Make persist-defvar work with records

Previously, when persist-defvar received a record for an initial
value, updated values were not persisted.
---
 persist.el            | 2 +-
 test/persist-tests.el | 8 ++++++++
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/persist.el b/persist.el
index eb408b5dca..39ce54bbf0 100644
--- a/persist.el
+++ b/persist.el
@@ -120,7 +120,7 @@ (defun persist-symbol (symbol &optional initvalue)
     (put symbol 'persist t)
     (if (hash-table-p initvalue)
         (put symbol 'persist-default (copy-hash-table initvalue))
-      (put symbol 'persist-default initvalue))))
+      (put symbol 'persist-default (persist-copy-tree initvalue t)))))
 
 (defun persist--persistant-p (symbol)
   "Return non-nil if SYMBOL is a persistant variable."
diff --git a/test/persist-tests.el b/test/persist-tests.el
index 8a30a24e23..18b8af2b89 100644
--- a/test/persist-tests.el
+++ b/test/persist-tests.el
@@ -69,6 +69,14 @@ (ert-deftest test-persist-save-hash ()
                        (puthash 'foo "bar" (symbol-value sym))
                        "#s(hash-table size 65 test eql rehash-size 1.5 rehash-threshold 0.8125 data (foo \"bar\"))")))
 
+(ert-deftest test-persist-save-record ()
+  "Test saving record."
+  (let* ((rec (record 'foo 'a 'b))
+         (default (copy-sequence rec)))
+    (test-persist-save rec default
+                       (setf (aref (symbol-value sym) 2) 'quux)
+                       "#s(foo a quux)")))
+
 (ert-deftest test-persist-load ()
   (with-local-temp-persist
    (let ((sym (cl-gensym)))
-- 
2.40.1