From cf804c86724248fc68c3adf74cad56c590e56194 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Fri, 21 Jun 2019 12:56:38 -0700 Subject: [PATCH] Temporarily preserve encoded group names in Gnus category file * lisp/gnus/gnus-agent.el (gnus-category-read): Decode on read. (gnus-category-write): Encode on write. --- lisp/gnus/gnus-agent.el | 102 ++++++++++++++++++++++++---------------- 1 file changed, 62 insertions(+), 40 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index b932fb5d347..6f750e05246 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2703,52 +2703,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." -- 2.39.5