Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-17 05:51:24 +00:00
Code Issues Projects Releases Packages Wiki Activity

Temporarily preserve encoded Gnus group names in Gnus files

Browse source 
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.
This commit is contained in:
Eric Abrahamsen 2019-06-06 20:43:27 -07:00
parent cb12a84f2c
commit 727e0eab0a
3 changed files with 143 additions and 55 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

100
lisp/gnus/gnus-agent.el
View file

@ -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.
(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)))))
;; 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."

59
lisp/gnus/gnus-registry.el
View file

@ -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)))

39
lisp/gnus/gnus-start.el
View file

@ -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)))