Temporarily preserve encoded Gnus group names in Gnus files

Non-ascii Gnus groups should be written to files in their encoded
version until we're ready to bump Gnus' version and add an upgrade
routine.

* lisp/gnus/gnus-start.el (gnus-gnus-to-quick-newsrc-format):
* lisp/gnus/gnus-agent.el (gnus-category-read):
  (gnus-category-write): Handle non-ascii group names appropriately.
* lisp/gnus/gnus-registry.el (gnus-registry--munge-group-names): New
  function to encode/decode group names.
  (gnus-registry-fixup-registry):
  (gnus-registry-save): Use function.

3 files changed, 144 insertions, 56 deletions

diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index d9c9e940700..dd30dda2a10 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -2693,52 +2693,74 @@ The following commands are available:
   "Read the category alist."
   (setq gnus-category-alist
         (or
-         (with-temp-buffer
-           (ignore-errors
-            (nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories"))
-            (goto-char (point-min))
-            ;; This code isn't temp, it will be needed so long as
-            ;; anyone may be migrating from an older version.
-
-            ;; Once we're certain that people will not revert to an
-            ;; earlier version, we can take out the old-list code in
-            ;; gnus-category-write.
-            (let* ((old-list (read (current-buffer)))
-                   (new-list (ignore-errors (read (current-buffer)))))
-              (if new-list
-                  new-list
-                ;; Convert from a positional list to an alist.
-                (mapcar
-                 (lambda (c)
-                   (setcdr c
-                           (delq nil
-                                 (gnus-mapcar
-                                  (lambda (valu symb)
-                                    (if valu
-                                        (cons symb valu)))
-                                  (cdr c)
-                                  '(agent-predicate agent-score-file agent-groups))))
-                   c)
-                 old-list)))))
+         (let ((list
+                (with-temp-buffer
+                  (ignore-errors
+                    (nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories"))
+                    (goto-char (point-min))
+                    ;; This code isn't temp, it will be needed so long as
+                    ;; anyone may be migrating from an older version.
+
+                    ;; Once we're certain that people will not revert to an
+                    ;; earlier version, we can take out the old-list code in
+                    ;; gnus-category-write.
+                    (let* ((old-list (read (current-buffer)))
+                           (new-list (ignore-errors (read (current-buffer)))))
+                      (if new-list
+                          new-list
+                        ;; Convert from a positional list to an alist.
+                        (mapcar
+                         (lambda (c)
+                           (setcdr c
+                                   (delq nil
+                                         (gnus-mapcar
+                                          (lambda (valu symb)
+                                            (if valu
+                                                (cons symb valu)))
+                                          (cdr c)
+                                          '(agent-predicate agent-score-file agent-groups))))
+                           c)
+                         old-list)))))))
+           ;; Possibly decode group names.
+           (dolist (cat list)
+             (setf (alist-get 'agent-groups cat)
+                   (mapcar (lambda (g)
+                             (if (string-match-p "[^[:ascii:]]" g)
+                                 (decode-coding-string g 'utf-8-emacs)
+                               g))
+                           (alist-get 'agent-groups cat))))
+           list)
          (list (gnus-agent-cat-make 'default 'short)))))
 
 (defun gnus-category-write ()
   "Write the category alist."
   (setq gnus-category-predicate-cache nil
         gnus-category-group-cache nil)
-  (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
-  (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
-    ;; This prin1 is temporary.  It exists so that people can revert
-    ;; to an earlier version of gnus-agent.
-    (prin1 (mapcar (lambda (c)
-              (list (car c)
-                    (cdr (assoc 'agent-predicate c))
-                    (cdr (assoc 'agent-score-file c))
-                    (cdr (assoc 'agent-groups c))))
-                   gnus-category-alist)
-           (current-buffer))
-    (newline)
-    (prin1 gnus-category-alist (current-buffer))))
+  ;; Temporarily encode non-ascii group names when saving to file,
+  ;; pending an upgrade of Gnus' file formats.
+  (let ((gnus-category-alist
+         (mapcar (lambda (cat)
+                   (setf (alist-get 'agent-groups cat)
+                         (mapcar (lambda (g)
+                                   (if (multibyte-string-p g)
+                                       (encode-coding-string g 'utf-8-emacs)
+                                     g))
+                                 (alist-get 'agent-groups cat)))
+                   cat)
+                 (copy-tree gnus-category-alist))))
+   (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
+   (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
+     ;; This prin1 is temporary.  It exists so that people can revert
+     ;; to an earlier version of gnus-agent.
+     (prin1 (mapcar (lambda (c)
+                      (list (car c)
+                            (cdr (assoc 'agent-predicate c))
+                            (cdr (assoc 'agent-score-file c))
+                            (cdr (assoc 'agent-groups c))))
+                    gnus-category-alist)
+            (current-buffer))
+     (newline)
+     (prin1 gnus-category-alist (current-buffer)))))
 
 (defun gnus-category-edit-predicate (category)
   "Edit the predicate for CATEGORY."
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index e488858ebe0..e949179b3cc 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 "[^[:ascii:]]" 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 "[^[:ascii:]]" 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)
+      (remhash id datahash)
+      (puthash id data datahash))))
+
 (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)
@@ -358,14 +403,20 @@ non-nil."
 (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)))
 
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index f7ede54b105..930d522c41b 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -42,6 +42,7 @@
 (defvar gnus-agent-covered-methods)
 (defvar gnus-agent-file-loading-local)
 (defvar gnus-agent-file-loading-cache)
+(defvar gnus-topic-alist)
 
 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
   "Your `.newsrc' file.
@@ -2869,7 +2870,12 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
       (princ "(setq gnus-newsrc-file-version ")
       (princ (gnus-prin1-to-string gnus-version))
       (princ ")\n"))
-
+    ;; Sort `gnus-newsrc-alist' according to order in
+    ;; `gnus-group-list'.
+    (setq gnus-newsrc-alist
+          (mapcar (lambda (g)
+                    (nth 1 (gethash g gnus-newsrc-hashtb)))
+                  (delete "dummy.group" gnus-group-list)))
     (let* ((print-quoted t)
            (print-readably t)
            (print-escape-multibyte nil)
@@ -2889,18 +2895,27 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
                   ;; Remove the `gnus-killed-list' from the list of variables
                   ;; to be saved, if required.
                   (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
+           ;; Encode group names in `gnus-newsrc-alist' and
+           ;; `gnus-topic-alist' in order to keep newsrc.eld files
+           ;; compatible with older versions of Gnus.  At some point,
+           ;; if/when a new version of Gnus is released, stop doing
+           ;; this and move the corresponding decode in
+           ;; `gnus-read-newsrc-el-file' into a conversion routine.
+           (gnus-newsrc-alist
+            (mapcar (lambda (info)
+                      (cons (encode-coding-string (car info) 'utf-8-emacs)
+                            (cdr info)))
+                    gnus-newsrc-alist))
+           (gnus-topic-alist
+            (when (memq 'gnus-topic-alist variables)
+             (mapcar (lambda (elt)
+                       (cons (car elt) ; Topic name
+                             (mapcar (lambda (g)
+                                       (encode-coding-string
+                                        g 'utf-8-emacs))
+                                     (cdr elt))))
+                     gnus-topic-alist)))
            variable)
-      ;; A bit of a fake-out here: the original value of
-      ;; `gnus-newsrc-alist' isn't written to file, instead it is
-      ;; constructed at the last minute by combining the group
-      ;; ordering in `gnus-group-list' with the group infos from
-      ;; `gnus-newsrc-hashtb'.
-      (set (nth (seq-position gnus-variable-list 'gnus-newsrc-alist)
-                gnus-variable-list)
-           (mapcar (lambda (g)
-                     (nth 1 (gethash g gnus-newsrc-hashtb)))
-                   (delete "dummy.group" gnus-group-list)))
-
       ;; Insert the variables into the file.
       (while variables
         (when (and (boundp (setq variable (pop variables)))