>From 7a5194edff2d69cfcd8f5ee2bdec61bc12c1a11b Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sun, 24 Nov 2019 16:34:00 -0800 Subject: [PATCH] Encode Gnus group names properly on disk, bump Gnus version to 5.14 * lisp/gnus/gnus.el (gnus-version-number): Bump to 5.14 to trigger upgrade routines. * lisp/gnus/gnus-start.el (gnus-convert-old-newsrc): Check for new version. (gnus-convert-encoded-group-names, gnus-convert-encoded-category-group-names, gnus-convert-encoded-registry-group-names): Do a one-time conversion of encoded group names read from various persistence files. (gnus-read-newsrc-el-file, gnus-gnus-to-quick-newsrc-format): Stop doing the work here. * lisp/gnus/gnus-agent.el (gnus-category-read, gnus-category-write): Don't check group names. * lisp/gnus/gnus-registry.el (gnus-registry--munge-group-names): Remove function. (gnus-registry-save, gnus-registry-fixup-registry): Don't call it. --- lisp/gnus/gnus-agent.el | 46 ++++---------- lisp/gnus/gnus-registry.el | 50 +-------------- lisp/gnus/gnus-start.el | 124 +++++++++++++++++++++++++------------ lisp/gnus/gnus.el | 4 +- 4 files changed, 101 insertions(+), 123 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 1f25255278..768b3beaa6 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2721,14 +2721,6 @@ gnus-category-read '(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))))) @@ -2736,31 +2728,19 @@ gnus-category-write "Write the category alist." (setq gnus-category-predicate-cache nil gnus-category-group-cache nil) - ;; 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))))) + (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 e6fb382c2f..7691e3e916 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -266,47 +266,7 @@ gnus-registry-sort-by-creation-time ;; 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 @@ -325,8 +285,7 @@ gnus-registry-fixup-registry '(mark group keyword))) (when (not (equal old (oref db tracked))) (gnus-message 9 "Reindexing the Gnus registry (tracked change)") - (registry-reindex db)) - (gnus-registry--munge-group-names db))) + (registry-reindex db)))) db) (defun gnus-registry-make-db (&optional file) @@ -410,11 +369,6 @@ gnus-registry-save (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 clone file) (gnus-message 5 "Saving Gnus registry (size %d) to %s...done" diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index e142c438ee..776f60f972 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -36,6 +36,10 @@ (autoload 'gnus-agent-save-local "gnus-agent") (autoload 'gnus-agent-possibly-alter-active "gnus-agent") (declare-function gnus-group-decoded-name "gnus-group" (string)) +(declare-function eieio-object-p "eieio-core" (obj)) +(declare-function slot-value "eieio" (obj slot)) +(declare-function registry-lookup-secondary "registry" + (db tracksym &optional create)) (eval-when-compile (require 'cl-lib)) @@ -43,6 +47,9 @@ gnus-agent-covered-methods (defvar gnus-agent-file-loading-local) (defvar gnus-agent-file-loading-cache) (defvar gnus-topic-alist) +(defvar gnus-category-alist) +(defvar gnus-registry-enabled) +(defvar gnus-registry-db) (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") "Your `.newsrc' file. @@ -1824,17 +1831,13 @@ gnus-make-hashtable-from-newsrc-alist gnus-newsrc-alist (cons (list "dummy.group" 0 nil) alist)))) (while alist - (setq info (car alist)) + (setq info (car alist) + gname (car info)) ;; Make the same select-methods identical Lisp objects. (when (setq method (gnus-info-method info)) (if (setq rest (member method methods)) (gnus-info-set-method info (car rest)) (push method methods))) - ;; Check for encoded group names and decode them. - (when (string-match-p "[^[:ascii:]]" (setq gname (car info))) - (let ((decoded (gnus-group-decoded-name gname))) - (setf gname decoded - (car info) decoded))) ;; Check for duplicates. (if (gethash gname gnus-newsrc-hashtb) ;; Remove this entry from the alist. @@ -2295,7 +2298,9 @@ gnus-convert-old-newsrc ("Gnus v5.10.7" "legacy-gnus-agent" gnus-agent-unlist-expire-days) ("Gnus v5.10.7" "legacy-gnus-agent" - gnus-agent-unhook-expire-days))) + gnus-agent-unhook-expire-days) + ("Gnus v5.14" nil + gnus-convert-encoded-group-names))) #'car-less-than-car))) ;; Skip converters older than the file version (while (and converters (>= fcv (caar converters))) @@ -2369,6 +2374,78 @@ gnus-convert-old-ticks (nconc (gnus-uncompress-range dormant) (gnus-uncompress-range ticked))))))))) +(defun gnus-convert-encoded-group-names (_converting-to) + "Decode encoded group names. +Non-ascii group names were previously stored on disk as encoded +bytes. This conversion makes sure names are encoded/decoded +properly." + (setq gnus-group-list + ;; Edit group names in `gnus-group-list', and incidentally + ;; edit them in `gnus-newsrc-hashtb' and `gnus-newsrc-alist', + ;; as well. + (mapcar + (lambda (gname) + (if (string-match-p "[^[:ascii:]]" gname) + (let ((decoded (gnus-group-decoded-name gname)) + (entry (gethash gname gnus-newsrc-hashtb))) + ;; First doctor the entry -- this will also touch + ;; `gnus-newsrc-alist'. + (setcar (nth 1 entry) decoded) + ;; Then re-hash. + (remhash gname gnus-newsrc-hashtb) + (puthash decoded entry gnus-newsrc-hashtb) + decoded) + gname)) + gnus-group-list)) + (add-hook 'gnus-agent-mode-hook #'gnus-convert-encoded-category-group-names) + (add-hook 'gnus-started-hook #'gnus-convert-encoded-registry-group-names)) + +(defun gnus-convert-encoded-category-group-names () + "Possibly decode group names stored in the agent category." + (when gnus-category-alist + (mapc (lambda (category) + (setf (alist-get 'agent-groups category) + (mapcar (lambda (g) + (if (string-match-p "[^[:ascii:]]" g) + (decode-coding-string g 'utf-8-emacs) + g)) + (alist-get 'agent-groups category)))) + gnus-category-alist))) + +(defun gnus-convert-encoded-registry-group-names () + "Possibly decode group names in the Gnus registry file." + (when (and (featurep 'gnus-registry) + gnus-registry-enabled + (eieio-object-p gnus-registry-db)) + (let ((datahash (slot-value gnus-registry-db 'data)) + (grouphash (registry-lookup-secondary gnus-registry-db 'group)) + reset-pairs) + (when (hash-table-p grouphash) + (maphash + (lambda (group-name val) + (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) + (string-match-p "[^[:ascii:]]" g)) + groups) + ;; Create a replacement DATA. + (push (list id (cons (cons 'group (mapcar + (lambda (g) + (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-load (file) "Load FILE, but in such a way that read errors can be reported." (with-temp-buffer @@ -2403,17 +2480,6 @@ gnus-read-newsrc-el-file (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))) (gnus-make-hashtable-from-newsrc-alist) - (when gnus-topic-alist - (setq gnus-topic-alist - (mapcar - (lambda (elt) - (cons (car elt) - (mapcar (lambda (g) - (if (string-match-p "[^[:ascii:]]" g) - (gnus-group-decoded-name g) - g)) - (cdr elt)))) - gnus-topic-alist))) (when (file-newer-than-file-p file ding-file) ;; Old format quick file (gnus-message 5 "Reading %s..." file) @@ -2878,8 +2944,6 @@ gnus-gnus-to-quick-newsrc-format (delete "dummy.group" gnus-group-list))) (let* ((print-quoted t) (print-readably t) - (print-escape-multibyte nil) - (print-escape-nonascii t) (print-length nil) (print-level nil) (print-circle nil) @@ -2895,26 +2959,6 @@ gnus-gnus-to-quick-newsrc-format ;; 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) ;; Insert the variables into the file. (while variables diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 0673ac15f6..90b70e0923 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -6,7 +6,7 @@ ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen ;; Keywords: news, mail -;; Version: 5.13 +;; Version: 5.14 ;; This file is part of GNU Emacs. @@ -292,7 +292,7 @@ gnus-fun :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.13" +(defconst gnus-version-number "5.14" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) -- 2.24.0