[Emacs-diffs] scratch/gnus-decoded 40ad1c0 2/2: Ensure that group names are encoded in the Gnus registry file

[Eric Abrahamsen]

branch: scratch/gnus-decoded
commit 40ad1c0d63804d8d0c30d994907b330ccb952793
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Ensure that group names are encoded in the Gnus registry file
    
    * lisp/gnus/gnus-registry.el (gnus-registry--munge-group-names): New
      function for either encoding names (while saving) or decoding
      them (while reading).
      (gnus-registry-fixup-registry, gnus-registry-read): Use in these two
      locations.
---
 lisp/gnus/gnus-registry.el | 59 ++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 55 insertions(+), 4 deletions(-)

diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 634cf92..8f3c11b 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -264,6 +264,50 @@ This can slow pruning down.  Set to nil to perform no 
sorting."
    (cadr (assq 'creation-time r))
    (cadr (assq 'creation-time l))))
 
+;; Remove this from the save routine (and fix it to only decode) at
+;; next Gnus version bump.
+(defun gnus-registry--munge-group-names (db &optional encode)
+  "Encode/decode group names in DB, before saving or after loading.
+Encode names if ENCODE is non-nil, otherwise decode."
+  (let ((datahash (slot-value db 'data))
+       (grouphash (registry-lookup-secondary db 'group))
+       reset-pairs)
+    (when (hash-table-p grouphash)
+      (maphash
+       (lambda (group-name val)
+        (if encode
+            (when (multibyte-string-p group-name)
+              (remhash group-name grouphash)
+              (puthash (encode-coding-string group-name 'utf-8-emacs)
+                       val grouphash))
+          (when (string-match-p "[^\000-\177]" group-name)
+            (remhash group-name grouphash)
+            (puthash (decode-coding-string group-name 'utf-8-emacs) val 
grouphash))))
+       grouphash))
+    (maphash
+     (lambda (id data)
+       (let ((groups (cdr-safe (assq 'group data))))
+        (when (seq-some (lambda (g)
+                          (if encode
+                              (multibyte-string-p g)
+                            (string-match-p "[^\000-\177]" g)))
+                        groups)
+          ;; Create a replacement DATA.
+          (push (list id (cons (cons 'group (mapcar
+                          (lambda (g)
+                            (funcall
+                             (if encode
+                                 #'encode-coding-string
+                               #'decode-coding-string)
+                             g 'utf-8-emacs))
+                          groups))
+                               (assq-delete-all 'group data)))
+                reset-pairs))))
+     datahash)
+    (pcase-dolist (`(,id ,data) reset-pairs)
+      (registry-delete db (list id) nil)
+      (registry-insert db id data))))
+
 (defun gnus-registry-fixup-registry (db)
   (when db
     (let ((old (oref db tracked)))
@@ -281,7 +325,8 @@ This can slow pruning down.  Set to nil to perform no 
sorting."
                     '(mark group keyword)))
       (when (not (equal old (oref db tracked)))
         (gnus-message 9 "Reindexing the Gnus registry (tracked change)")
-        (registry-reindex db))))
+        (registry-reindex db))
+      (gnus-registry--munge-group-names db)))
   db)
 
 (defun gnus-registry-make-db (&optional file)
@@ -351,14 +396,20 @@ This is not required after changing 
`gnus-registry-cache-file'."
 (defun gnus-registry-save (&optional file db)
   "Save the registry cache file."
   (interactive)
-  (let ((file (or file gnus-registry-cache-file))
-        (db (or db gnus-registry-db)))
+  (let* ((file (or file gnus-registry-cache-file))
+         (db (or db gnus-registry-db))
+        (clone (clone db)))
     (gnus-message 5 "Saving Gnus registry (%d entries) to %s..."
                   (registry-size db) file)
     (registry-prune
      db gnus-registry-default-sort-function)
+    ;; Write a clone of the database with non-ascii group names
+    ;; encoded as 'utf-8.  Let-bind `gnus-registry-db' so that
+    ;; functions in the munging process work on our clone.
+    (let ((gnus-registry-db clone))
+     (gnus-registry--munge-group-names clone 'encode))
     ;; TODO: call (gnus-string-remove-all-properties v) on all elements?
-    (eieio-persistent-save db file)
+    (eieio-persistent-save clone file)
     (gnus-message 5 "Saving Gnus registry (size %d) to %s...done"
                   (registry-size db) file)))