From: Eric Abrahamsen <eric@ericabrahamsen.net>
To: 35383@debbugs.gnu.org
Subject: bug#35383: 27.0.50; Complete process of decoding Gnus group names
Date: Tue, 30 Jul 2019 16:00:30 -0700 [thread overview]
Message-ID: <87imrjm8kx.fsf@ericabrahamsen.net> (raw)
In-Reply-To: <87k1cscns2.fsf@aia00054aia.gr> (Deus Max's message of "Mon, 08 Jul 2019 22:46:37 +0300")
[-- Attachment #1: Type: text/plain, Size: 345 bytes --]
Okay, I decided to squash into two commits: the first holding the vast
majority of the changes (but still fairly atomic), and the second
holding some temporary backward compatibility tomfoolery, which should
be replaced by a proper upgrade (including an uptick to Gnus' version)
before 27 is released.
Speak now! Or... file bug reports later.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-Temporarily-preserve-encoded-Gnus-group-names-in-Gnu.patch --]
[-- Type: text/x-patch, Size: 11610 bytes --]
From 2b8ba00dc88398d44f606451980e5ceed56ddb3d Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Thu, 6 Jun 2019 20:43:27 -0700
Subject: [PATCH 2/2] 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.
---
lisp/gnus/gnus-agent.el | 102 ++++++++++++++++++++++---------------
lisp/gnus/gnus-registry.el | 59 +++++++++++++++++++--
lisp/gnus/gnus-start.el | 39 +++++++++-----
3 files changed, 144 insertions(+), 56 deletions(-)
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index d9c9e94070..dd30dda2a1 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -2693,52 +2693,74 @@ gnus-category-read
"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 e488858ebe..e949179b3c 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -264,6 +264,50 @@ gnus-registry-sort-by-creation-time
(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 @@ 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))))
+ (registry-reindex db))
+ (gnus-registry--munge-group-names db)))
db)
(defun gnus-registry-make-db (&optional file)
@@ -358,14 +403,20 @@ gnus-registry-read
(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 cb585472af..9b620edbec 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.
@@ -2871,7 +2872,12 @@ gnus-gnus-to-quick-newsrc-format
(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)
@@ -2891,18 +2897,27 @@ 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)
- ;; 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)))
--
2.22.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Remove-Gnus-group-name-encoding-decoding.patch --]
[-- Type: text/x-patch, Size: 75863 bytes --]
From f2d325fbf5634189018238e2f4b2fc4f536e6b3c Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Fri, 16 Nov 2018 12:53:56 -0800
Subject: [PATCH 1/2] Remove Gnus group name encoding/decoding
This completes the process started in c1b63af445. Gnus group names are
now fully decoded inside the Gnus system.
* lisp/gnus/gnus-agent.el (gnus-agent-file-coding-system): Change
default to utf-8-emacs.
(gnus-agent-decoded-group-names, gnus-agent-decoded-group-name):
Remove variable and function. Remove all usage in this file.
* lisp/gnus/gnus-cache.el (gnus-cache-decoded-group-names,
gnus-cache-unified-group-names, gnus-cache-decoded-group-name):
Remove these variables and function. Remove all usage in this file.
* lisp/gnus/gnus-group.el (gnus-tmp-decoded-group): Remove this
variable, gnus-tmp-group is now decoded.
(gnus-group-completing-read): Don't encode or decode group names
here.
(gnus-group-make-group): Remove ENCODED argument.
* lisp/gnus/gnus-srvr.el (gnus-browse-foreign-server): Decode group
names here.
* lisp/gnus/gnus-start.el (gnus-make-hashtable-from-newsrc-alist):
check for encoded group names and decode.
(gnus-active-to-gnus-format): Make sure incoming group names are
decoded.
(gnus-read-newsrc-el-file): Check for encoded group names in
gnus-topic-alist.
* lisp/gnus/nnagent.el: Don't use a unibyte buffer.
* lisp/gnus/nnheader.el (nnheader-file-coding-system): Switch default
from 'raw-text to 'undecided, on the assumption that 'undecided will
probably write 'utf-8-emacs unless the user has arranged things
otherwise.
* lisp/gnus/nnimap.el (nnimap-decode-gnus-group,
nnimap-encode-gnus-group): Remove functions and their use.
* lisp/gnus/nnmail.el (nnmail-parse-active): Remove encoding.
(nnmail-active-file-coding-system): Default to 'utf-8-emacs instead
of 'raw-text.
(nnmail-group-names-not-encoded-p): Obsolete this variable; stop
using it.
* lisp/gnus/gnus-art.el:
* lisp/gnus/gnus-cus.el:
* lisp/gnus/gnus-msg.el:
* lisp/gnus/gnus-start.el:
* lisp/gnus/gnus-sum.el:
* lisp/gnus/gnus.el:
* lisp/gnus/nnml.el:
* lisp/gnus/message.el:
* lisp/gnus/nnrss.el: Stop using gnus-group-decoded-name in all these
files.
---
lisp/gnus/gnus-agent.el | 58 ++++-------
lisp/gnus/gnus-art.el | 4 +-
lisp/gnus/gnus-cache.el | 41 +-------
lisp/gnus/gnus-cus.el | 5 +-
lisp/gnus/gnus-group.el | 209 +++++++++++++++-------------------------
lisp/gnus/gnus-msg.el | 3 +-
lisp/gnus/gnus-srvr.el | 45 +++++----
lisp/gnus/gnus-start.el | 43 ++++++---
lisp/gnus/gnus-sum.el | 113 +++++++++-------------
lisp/gnus/gnus-util.el | 7 --
lisp/gnus/gnus.el | 4 +-
lisp/gnus/message.el | 21 ++--
lisp/gnus/nnagent.el | 23 +++--
| 7 +-
lisp/gnus/nnimap.el | 62 +++---------
lisp/gnus/nnmail.el | 28 +++---
lisp/gnus/nnmaildir.el | 2 +-
lisp/gnus/nnml.el | 92 ++++--------------
| 2 +-
19 files changed, 276 insertions(+), 493 deletions(-)
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 40d0d24605..d9c9e94070 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -229,7 +229,7 @@ gnus-agent-spam-hashtb
"Cache of message subjects for spam messages.
Actually a hash table holding subjects mapped to t.")
(defvar gnus-agent-file-name nil)
-(defvar gnus-agent-file-coding-system 'raw-text)
+(defvar gnus-agent-file-coding-system 'utf-8-emacs)
(defvar gnus-agent-file-loading-cache nil)
(defvar gnus-agent-total-fetched-hashtb nil)
(defvar gnus-agent-inhibit-update-total-fetched-for nil)
@@ -406,8 +406,6 @@ gnus-agent-cat-make
(defun gnus-agent-read-group ()
"Read a group name in the minibuffer, with completion."
(let ((def (or (gnus-group-group-name) gnus-newsgroup-name)))
- (when def
- (setq def (gnus-group-decoded-name def)))
(gnus-group-completing-read nil nil t nil nil def)))
;;; Fetching setup functions.
@@ -1330,7 +1328,10 @@ gnus-agent-save-group-info
(gnus-make-directory (file-name-directory file))
(with-temp-file file
;; Emacs got problem to match non-ASCII group in multibyte buffer.
- (mm-disable-multibyte)
+
+ ;; FIXME: Is this still an issue now that group names are
+ ;; always strings?
+ ;(mm-disable-multibyte)
(when (file-exists-p file)
(nnheader-insert-file-contents file)
@@ -1360,7 +1361,7 @@ gnus-agent-get-group-info
(gnus-make-directory (file-name-directory file))
(with-temp-buffer
;; Emacs got problem to match non-ASCII group in multibyte buffer.
- (mm-disable-multibyte)
+ ;(mm-disable-multibyte)
(when (file-exists-p file)
(nnheader-insert-file-contents file)
@@ -1372,18 +1373,6 @@ gnus-agent-get-group-info
oactive-min (read (current-buffer))) ;; min
(cons oactive-min oactive-max))))))))
-(defvar gnus-agent-decoded-group-names nil
- "Alist of non-ASCII group names and decoded ones.")
-
-(defun gnus-agent-decoded-group-name (group)
- "Return a decoded group name of GROUP."
- (or (cdr (assoc group gnus-agent-decoded-group-names))
- (if (string-match "[^\000-\177]" group)
- (let ((decoded (gnus-group-decoded-name group)))
- (push (cons group decoded) gnus-agent-decoded-group-names)
- decoded)
- group)))
-
(defun gnus-agent-group-path (group)
"Translate GROUP into a file name."
@@ -1395,7 +1384,7 @@ gnus-agent-group-path
(nnheader-translate-file-chars
(nnheader-replace-duplicate-chars-in-string
(nnheader-replace-chars-in-string
- (gnus-group-real-name (gnus-agent-decoded-group-name group))
+ (gnus-group-real-name group)
?/ ?_)
?. ?_)))
(if (or nnmail-use-long-file-names
@@ -1409,7 +1398,7 @@ gnus-agent-group-pathname
;; unplugged. The agent must, therefore, use the same directory
;; while plugged.
(nnmail-group-pathname
- (gnus-group-real-name (gnus-agent-decoded-group-name group))
+ (gnus-group-real-name group)
(if gnus-command-method
(gnus-agent-directory)
(let ((gnus-command-method (gnus-find-method-for-group group)))
@@ -1437,7 +1426,7 @@ gnus-agent-open-history
(format " *Gnus agent %s history*"
(gnus-agent-method)))))
gnus-agent-history-buffers)
- (mm-disable-multibyte) ;; everything is binary
+ ;(mm-disable-multibyte) ;; everything is binary
(erase-buffer)
(insert "\n")
(let ((file (gnus-agent-lib-file "history")))
@@ -1525,8 +1514,7 @@ gnus-agent-fetch-articles
(setq selected-sets (nreverse selected-sets))
(gnus-make-directory dir)
- (gnus-message 7 "Fetching articles for %s..."
- (gnus-agent-decoded-group-name group))
+ (gnus-message 7 "Fetching articles for %s..." group)
(unwind-protect
(while (setq articles (pop selected-sets))
@@ -1537,8 +1525,7 @@ gnus-agent-fetch-articles
(let (article)
(while (setq article (pop articles))
(gnus-message 10 "Fetching article %s for %s..."
- article
- (gnus-agent-decoded-group-name group))
+ article group)
(when (or
(gnus-backlog-request-article group article
nntp-server-buffer)
@@ -1875,8 +1862,7 @@ gnus-agent-fetch-headers
(with-current-buffer nntp-server-buffer
(if articles
(progn
- (gnus-message 8 "Fetching headers for %s..."
- (gnus-agent-decoded-group-name group))
+ (gnus-message 8 "Fetching headers for %s..." group)
;; Fetch them.
(gnus-make-directory (nnheader-translate-file-chars
@@ -3058,8 +3044,7 @@ gnus-agent-expire-group-1
;; provided a non-nil active
(let ((dir (gnus-agent-group-pathname group))
- (file-name-coding-system nnmail-pathname-coding-system)
- (decoded (gnus-agent-decoded-group-name group)))
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-agent-with-refreshed-group
group
(when (boundp 'gnus-agent-expire-current-dirs)
@@ -3068,8 +3053,8 @@ gnus-agent-expire-group-1
(if (and (not force)
(eq 'DISABLE (gnus-agent-find-parameter group
'agent-enable-expiration)))
- (gnus-message 5 "Expiry skipping over %s" decoded)
- (gnus-message 5 "Expiring articles in %s" decoded)
+ (gnus-message 5 "Expiry skipping over %s" group)
+ (gnus-message 5 "Expiring articles in %s" group)
(gnus-agent-load-alist group)
(let* ((bytes-freed 0)
(size-files-deleted 0.0)
@@ -3293,7 +3278,7 @@ gnus-agent-expire-group-1
(keep
(gnus-agent-message 10
"gnus-agent-expire: %s:%d: Kept %s article%s."
- decoded article-number keep (if fetch-date " and file" ""))
+ group article-number keep (if fetch-date " and file" ""))
(when fetch-date
(unless (file-exists-p
(concat dir (number-to-string
@@ -3301,7 +3286,7 @@ gnus-agent-expire-group-1
(setf (nth 1 entry) nil)
(gnus-agent-message 3 "gnus-agent-expire cleared \
download flag on %s:%d as the cached article file is missing."
- decoded (caar dlist)))
+ group (caar dlist)))
(unless marker
(gnus-message 1 "gnus-agent-expire detected a \
missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
@@ -3379,12 +3364,12 @@ gnus-agent-expire-group-1
(when actions
(gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
- decoded article-number
+ group article-number
(mapconcat #'identity actions ", ")))))
(t
(gnus-agent-message
10 "gnus-agent-expire: %s:%d: Article kept as \
-expiration tests failed." decoded article-number)
+expiration tests failed." group article-number)
(gnus-agent-append-to-list
tail-alist (cons article-number fetch-date)))
)
@@ -3835,7 +3820,7 @@ gnus-agent-regenerate-group
(sit-for 1)
t)))))
(when group
- (gnus-message 5 "Regenerating in %s" (gnus-agent-decoded-group-name group))
+ (gnus-message 5 "Regenerating in %s" group)
(let* ((gnus-command-method (or gnus-command-method
(gnus-find-method-for-group group)))
(file (gnus-agent-article-name ".overview" group))
@@ -3912,8 +3897,7 @@ gnus-agent-regenerate-group
(> (car downloaded) (car nov-arts))))
;; This entry is missing from the overview file
(gnus-message 3 "Regenerating NOV %s %d..."
- (gnus-agent-decoded-group-name group)
- (car downloaded))
+ group (car downloaded))
(let ((file (concat dir (number-to-string (car downloaded)))))
(mm-with-unibyte-buffer
(nnheader-insert-file-contents file)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 8f5a313c61..af8ec68ddd 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -4506,9 +4506,7 @@ gnus-article-mode
(defun gnus-article-setup-buffer ()
"Initialize the article buffer."
(let* ((name (if gnus-single-article-buffer "*Article*"
- (concat "*Article "
- (gnus-group-decoded-name gnus-newsgroup-name)
- "*")))
+ (concat "*Article " gnus-newsgroup-name "*")))
(original
(progn (string-match "\\*Article" name)
(concat " *Original Article"
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index afe8a8a416..f43c4344dc 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -430,41 +430,7 @@ gnus-cache-member-of-class
(and unread (memq 'unread class))
(and (not unread) (not ticked) (not dormant) (memq 'read class))))
-(defvar gnus-cache-decoded-group-names nil
- "Alist of original group names and decoded group names.
-Decoding is done according to `gnus-group-name-charset-method-alist'
-or `gnus-group-name-charset-group-alist'.")
-
-(defvar gnus-cache-unified-group-names nil
- "Alist of unified decoded group names and original group names.
-A group name is decoded according to
-`gnus-group-name-charset-method-alist' or
-`gnus-group-name-charset-group-alist' first, and is encoded and
-decoded again according to `nnmail-pathname-coding-system',
-`file-name-coding-system', or `default-file-name-coding-system'.
-
-It is used when asking for an original group name from a cache
-directory name, in which non-ASCII characters might have been unified
-into the ones of a certain charset particularly if the `utf-8' coding
-system for example was used.")
-
-(defun gnus-cache-decoded-group-name (group)
- "Return a decoded group name of GROUP."
- (or (cdr (assoc group gnus-cache-decoded-group-names))
- (let ((decoded (gnus-group-decoded-name group))
- (coding (or nnmail-pathname-coding-system
- file-name-coding-system
- default-file-name-coding-system)))
- (push (cons group decoded) gnus-cache-decoded-group-names)
- (push (cons (decode-coding-string
- (encode-coding-string decoded coding)
- coding)
- group)
- gnus-cache-unified-group-names)
- decoded)))
-
(defun gnus-cache-file-name (group article)
- (setq group (gnus-cache-decoded-group-name group))
(expand-file-name
(if (stringp article) article (int-to-string article))
(file-name-as-directory
@@ -733,12 +699,7 @@ gnus-cache-generate-active
(push (pop files) alphs)))
;; If we have nums, then this is probably a valid group.
(when (setq nums (sort nums '<))
- ;; Use non-decoded group name.
- ;; FIXME: this is kind of a workaround. The active file should
- ;; be updated at the time articles are cached. It will make
- ;; `gnus-cache-unified-group-names' needless.
- (puthash (or (cdr (assoc group gnus-cache-unified-group-names))
- group)
+ (puthash group
(cons (car nums) (car (last nums)))
gnus-cache-active-hashtb))
;; Go through all the other files.
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index fb8b300e35..3598ead761 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -396,7 +396,7 @@ gnus-group-customize
:tag "topic parameters"
"(gnus)Topic Parameters"))
(widget-insert " for <")
- (widget-insert (gnus-group-decoded-name (or group topic)))
+ (widget-insert (or group topic))
(widget-insert "> and press ")
(widget-create 'push-button
:tag "done"
@@ -845,8 +845,7 @@ gnus-score-customize
This can be changed using the `\\[gnus-score-change-score-file]' command."
(interactive (list gnus-current-score-file))
(unless file
- (error "No score file for %s"
- (gnus-group-decoded-name gnus-newsgroup-name)))
+ (error "No score file for %s" gnus-newsgroup-name))
(let ((scores (gnus-score-load file))
(types (mapcar (lambda (entry)
`(group :format "%v%h\n"
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 299ebdec50..7e0ceec17b 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -479,7 +479,6 @@ gnus-group-edit-buffer
(defvar gnus-tmp-news-method)
(defvar gnus-tmp-colon)
(defvar gnus-tmp-news-server)
-(defvar gnus-tmp-decoded-group)
(defvar gnus-tmp-header)
(defvar gnus-tmp-process-marked)
(defvar gnus-tmp-summary-live)
@@ -518,14 +517,9 @@ gnus-group-line-format-alist
(?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
(?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
- (?g (if (boundp 'gnus-tmp-decoded-group)
- gnus-tmp-decoded-group
- gnus-tmp-group)
- ?s)
+ (?g gnus-tmp-group ?s)
(?G gnus-tmp-qualified-group ?s)
- (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
- gnus-tmp-decoded-group
- gnus-tmp-group))
+ (?c (gnus-short-group-name gnus-tmp-group)
?s)
(?C gnus-tmp-comment ?s)
(?D gnus-tmp-newsgroup-description ?s)
@@ -1398,8 +1392,7 @@ gnus-group-prepare-flat-list-dead
((functionp regexp) (funcall regexp group))))
(add-text-properties
(point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (gnus-group-decoded-name group)
+ (insert " " mark " *: " group
"\n"))
(list 'gnus-group group
'gnus-unread t
@@ -1508,8 +1501,6 @@ gnus-group-insert-group-line
"Insert a group line in the group buffer."
(let* ((gnus-tmp-method
(gnus-server-get-method gnus-tmp-group gnus-tmp-method))
- (group-name-charset (gnus-group-name-charset gnus-tmp-method
- gnus-tmp-group))
(gnus-tmp-active (gnus-active gnus-tmp-group))
(gnus-tmp-number-total
(if gnus-tmp-active
@@ -1528,16 +1519,13 @@ gnus-group-insert-group-line
((= gnus-tmp-level gnus-level-zombie) ?Z)
(t ?K)))
(gnus-tmp-qualified-group
- (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
- group-name-charset))
+ (gnus-group-real-name gnus-tmp-group))
(gnus-tmp-comment
(or (gnus-group-get-parameter gnus-tmp-group 'comment t)
gnus-tmp-group))
(gnus-tmp-newsgroup-description
(if gnus-description-hashtb
- (or (gnus-group-name-decode
- (gethash gnus-tmp-group gnus-description-hashtb)
- group-name-charset) "")
+ (or (gethash gnus-tmp-group gnus-description-hashtb) "")
""))
(gnus-tmp-moderated
(if (and gnus-moderated-hashtb
@@ -1574,9 +1562,7 @@ gnus-group-insert-group-line
(point)
(prog1 (1+ (point))
;; Insert the text.
- (let ((gnus-tmp-decoded-group (gnus-group-name-decode
- gnus-tmp-group group-name-charset)))
- (eval gnus-group-line-format-spec)))
+ (eval gnus-group-line-format-spec))
`(gnus-group ,gnus-tmp-group
gnus-unread ,(if (numberp number)
(string-to-number gnus-tmp-number-of-unread)
@@ -2117,9 +2103,7 @@ gnus-group-select-group-ephemerally
(defun gnus-group-name-at-point ()
"Return a group name from around point if it exists, or nil."
(if (derived-mode-p 'gnus-group-mode)
- (let ((group (gnus-group-group-name)))
- (when group
- (gnus-group-decoded-name group)))
+ (gnus-group-group-name)
;; FIXME: Use rx.
(let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\
\\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\
@@ -2160,41 +2144,25 @@ gnus-group-completing-read
require-match initial-input hist
def)
"Read a group name with completion.
-Non-ASCII group names are allowed. The arguments are the same as
-`completing-read' except that COLLECTION and HIST default to
-`gnus-active-hashtb' and `gnus-group-history' respectively if
-they are omitted. Can handle COLLECTION as a list, hash table,
-or vector."
+The arguments are the same as `completing-read' except that
+COLLECTION and HIST default to `gnus-active-hashtb' and
+`gnus-group-history' respectively if they are omitted. Can
+handle COLLECTION as a list, hash table, or vector."
+ ;; This function handles vectors for backwards compatibility. In
+ ;; theory, `collection' will only ever be a list or a hash table.
(or collection (setq collection gnus-active-hashtb))
(let* ((choices
- (mapcar
- (lambda (g)
- (if (string-match "[^\000-\177]" g)
- (gnus-group-decoded-name g)
- g))
(cond ((listp collection)
collection)
((vectorp collection)
(mapatoms #'symbol-name collection))
((hash-table-p collection)
- (hash-table-keys collection)))))
+ (hash-table-keys collection))))
(group
(gnus-completing-read (or prompt "Group") (reverse choices)
require-match initial-input
(or hist 'gnus-group-history)
def)))
- (unless (cond ((and (listp collection)
- (symbolp (car collection)))
- (member group (mapcar 'symbol-name collection)))
- ((listp collection)
- (member group collection))
- ((vectorp collection)
- (symbol-value (intern-soft group collection)))
- ((hash-table-p collection)
- (gethash group collection)))
- (setq group
- (encode-coding-string
- group (gnus-group-name-charset nil group))))
(replace-regexp-in-string "\n" "" group)))
;;;###autoload
@@ -2755,13 +2723,13 @@ gnus-group-make-group-simple
(interactive (list (gnus-group-completing-read)))
(gnus-group-make-group (gnus-group-real-name group)
(gnus-group-server group)
- nil nil t))
+ nil nil))
-(defun gnus-group-make-group (name &optional method address args encoded)
+(defun gnus-group-make-group (name &optional method address args)
"Add a new newsgroup.
The user will be prompted for a NAME, for a select METHOD, and an
ADDRESS. NAME should be a human-readable string (i.e., not be encoded
-even if it contains non-ASCII characters) unless ENCODED is non-nil.
+even if it contains non-ASCII characters).
If the backend supports it, the group will also be created on the
server."
@@ -2772,10 +2740,6 @@ gnus-group-make-group
(when (stringp method)
(setq method (or (gnus-server-to-method method) method)))
- (unless encoded
- (setq name (encode-coding-string
- name
- (gnus-group-name-charset method name))))
(let* ((meth (gnus-method-simplify
(when (and method
(not (gnus-server-equal method gnus-select-method)))
@@ -2784,7 +2748,7 @@ gnus-group-make-group
(nname (if method (gnus-group-prefixed-name name meth) name))
backend info)
(when (gnus-group-entry nname)
- (error "Group %s already exists" (gnus-group-decoded-name nname)))
+ (error "Group %s already exists" nname))
;; Subscribe to the new group.
(gnus-group-change-level
(setq info (list t nname gnus-level-default-subscribed nil nil meth))
@@ -2860,20 +2824,19 @@ gnus-group-delete-group
(unless (gnus-check-backend-function 'request-delete-group group)
(error "This back end does not support group deletion"))
(prog1
- (let ((group-decoded (gnus-group-decoded-name group)))
- (when (or no-prompt
- (gnus-yes-or-no-p
- (format
- "Do you really want to delete %s%s? "
- group-decoded (if force " and all its contents" ""))))
- (gnus-message 6 "Deleting group %s..." group-decoded)
- (if (not (gnus-request-delete-group group force))
- (gnus-error 3 "Couldn't delete group %s" group-decoded)
- (gnus-message 6 "Deleting group %s...done" group-decoded)
- (gnus-group-goto-group group)
- (gnus-group-kill-group 1 t)
- (gnus-set-active group nil)
- t)))
+ (when (or no-prompt
+ (gnus-yes-or-no-p
+ (format
+ "Do you really want to delete %s%s? "
+ group (if force " and all its contents" ""))))
+ (gnus-message 6 "Deleting group %s..." group)
+ (if (not (gnus-request-delete-group group force))
+ (gnus-error 3 "Couldn't delete group %s" group)
+ (gnus-message 6 "Deleting group %s...done" group)
+ (gnus-group-goto-group group)
+ (gnus-group-kill-group 1 t)
+ (gnus-set-active group nil)
+ t))
(gnus-group-position-point)))
(defun gnus-group-rename-group (group new-name)
@@ -2887,13 +2850,9 @@ gnus-group-rename-group
(error "This back end does not support renaming groups"))
(setq new-name (gnus-read-group
"Rename group to: "
- (gnus-group-real-name (gnus-group-decoded-name group)))
+ (gnus-group-real-name group))
method (gnus-info-method (gnus-get-info group)))
- (list group (encode-coding-string
- new-name
- (gnus-group-name-charset
- method
- (gnus-group-prefixed-name new-name method))))))
+ (list group (gnus-group-prefixed-name new-name method))))
(unless (gnus-check-backend-function 'request-rename-group group)
(error "This back end does not support renaming groups"))
@@ -2912,34 +2871,30 @@ gnus-group-rename-group
(gnus-group-real-name new-name)
(gnus-info-method (gnus-get-info group)))))
- (let ((decoded-group (gnus-group-decoded-name group))
- (decoded-new-name (gnus-group-decoded-name new-name)))
- (when (gnus-active new-name)
- (error "The group %s already exists" decoded-new-name))
+ (when (gnus-active new-name)
+ (error "The group %s already exists" new-name))
- (gnus-message 6 "Renaming group %s to %s..."
- decoded-group decoded-new-name)
- (prog1
- (if (progn
- (gnus-group-goto-group group)
- (not (when (< (gnus-group-group-level) gnus-level-zombie)
- (gnus-request-rename-group group new-name))))
- (gnus-error 3 "Couldn't rename group %s to %s"
- decoded-group decoded-new-name)
- ;; We rename the group internally by killing it...
- (gnus-group-kill-group)
- ;; ... changing its name ...
- (setcar (cdar gnus-list-of-killed-groups) new-name)
- ;; ... and then yanking it. Magic!
- (gnus-group-yank-group)
- (gnus-set-active new-name (gnus-active group))
- (gnus-message 6 "Renaming group %s to %s...done"
- decoded-group decoded-new-name)
- new-name)
- (setq gnus-killed-list (delete group gnus-killed-list))
- (gnus-set-active group nil)
- (gnus-dribble-touch)
- (gnus-group-position-point))))
+ (gnus-message 6 "Renaming group %s to %s..." group new-name)
+ (prog1
+ (if (progn
+ (gnus-group-goto-group group)
+ (not (when (< (gnus-group-group-level) gnus-level-zombie)
+ (gnus-request-rename-group group new-name))))
+ (gnus-error 3 "Couldn't rename group %s to %s"
+ group new-name)
+ ;; We rename the group internally by killing it...
+ (gnus-group-kill-group)
+ ;; ... changing its name ...
+ (setcar (cdar gnus-list-of-killed-groups) new-name)
+ ;; ... and then yanking it. Magic!
+ (gnus-group-yank-group)
+ (gnus-set-active new-name (gnus-active group))
+ (gnus-message 6 "Renaming group %s to %s...done" group new-name)
+ new-name)
+ (setq gnus-killed-list (delete group gnus-killed-list))
+ (gnus-set-active group nil)
+ (gnus-dribble-touch)
+ (gnus-group-position-point)))
(defun gnus-group-edit-group (group &optional part)
"Edit the group on the current line."
@@ -2966,7 +2921,7 @@ gnus-group-edit-group
((eq part 'method) "select method")
((eq part 'params) "group parameters")
(t "group info"))
- (gnus-group-decoded-name group))
+ group)
`(lambda (form)
(gnus-group-edit-group-done ',part ,group form)))
(local-set-key
@@ -3105,8 +3060,7 @@ gnus-group-make-doc-group
(coding (gnus-group-name-charset method name)))
(setcar (cdr method) (encode-coding-string file coding))
(gnus-group-make-group
- (encode-coding-string (gnus-group-real-name name) coding)
- method nil nil t)))
+ (gnus-group-real-name name) method nil nil)))
(defvar nnweb-type-definition)
(defvar gnus-group-web-type-history nil)
@@ -3611,7 +3565,7 @@ gnus-group-catchup-current
"Do you really want to mark all articles in %s as read? "
"Mark all unread articles in %s as read? ")
(if (= (length groups) 1)
- (gnus-group-decoded-name (car groups))
+ (car groups)
(format "these %d groups" (length groups)))))))
n
(while (setq group (pop groups))
@@ -3696,8 +3650,7 @@ gnus-group-expire-articles
(defun gnus-group-expire-articles-1 (group)
(when (gnus-check-backend-function 'request-expire-articles group)
- (gnus-message 6 "Expiring articles in %s..."
- (gnus-group-decoded-name group))
+ (gnus-message 6 "Expiring articles in %s..." group)
(let* ((info (gnus-get-info group))
(expirable (if (gnus-group-total-expirable-p group)
(cons nil (gnus-list-of-read-articles group))
@@ -3724,8 +3677,7 @@ gnus-group-expire-articles-1
;; Just expire using the normal expiry values.
(gnus-request-expire-articles articles-to-expire group))))
(gnus-close-group group))
- (gnus-message 6 "Expiring articles in %s...done"
- (gnus-group-decoded-name group))
+ (gnus-message 6 "Expiring articles in %s...done" group)
;; Return the list of un-expired articles.
(cdr expirable))))
@@ -3762,7 +3714,7 @@ gnus-group-set-current-level
(dolist (group (gnus-group-process-prefix n))
(gnus-group-remove-mark group)
(gnus-message 6 "Changed level of %s from %d to %d"
- (gnus-group-decoded-name group)
+ group
(or (gnus-group-group-level) gnus-level-killed)
level)
(gnus-group-change-level
@@ -3909,7 +3861,7 @@ gnus-group-kill-group
;; `gnus-newsrc-hashtb', this check will always return nil.
(when (numberp (gnus-group-unread group))
(gnus-request-update-group-status group 'unsubscribe))
- (message "Killed group %s" (gnus-group-decoded-name group)))
+ (message "Killed group %s" group))
;; If there are lots and lots of groups to be killed, we use
;; this thing instead.
(dolist (group (nreverse groups))
@@ -4047,7 +3999,7 @@ gnus-group-list-active
(add-text-properties
(point) (prog1 (1+ (point))
(insert " *: "
- (gnus-group-decoded-name group)
+ group
"\n"))
(list 'gnus-group group
'gnus-unread t
@@ -4494,9 +4446,9 @@ gnus-group-set-info
(prin1-to-string (car method)))
(and (consp method)
(nth 1 (gnus-info-method info)))
- nil t)
+ nil)
;; It's a native group.
- (gnus-group-make-group (gnus-info-group info) nil nil nil t)))
+ (gnus-group-make-group (gnus-info-group info) nil nil nil)))
(gnus-message 6 "Note: New group created")
(setq entry
(gnus-group-entry (gnus-group-prefixed-name
@@ -4685,7 +4637,7 @@ gnus-group-listed-groups
(while (setq point (text-property-not-all (point) (point-max)
'gnus-group nil))
(goto-char point)
- (push (symbol-name (get-text-property point 'gnus-group)) groups)
+ (push (get-text-property point 'gnus-group) groups)
(forward-char 1))
groups))
@@ -4776,21 +4728,20 @@ gnus-group-compact-group
(error "No group to compact"))
(unless (gnus-check-backend-function 'request-compact-group group)
(error "This back end does not support group compaction"))
- (let ((group-decoded (gnus-group-decoded-name group)))
- (gnus-message 6 "\
+ (gnus-message 6 "\
Compacting group %s... (this may take a long time)"
- group-decoded)
- (prog1
- (if (not (gnus-request-compact-group group))
- (gnus-error 3 "Couldn't compact group %s" group-decoded)
- (gnus-message 6 "Compacting group %s...done" group-decoded)
- t)
- ;; Invalidate the "original article" buffer which might be out of date.
- ;; #### NOTE: Yes, this might be a bit rude, but since compaction
- ;; #### will not happen very often, I think this is acceptable.
- (gnus-kill-buffer gnus-original-article-buffer)
- ;; Update the group line to reflect new information (art number etc).
- (gnus-group-update-group-line))))
+ group)
+ (prog1
+ (if (not (gnus-request-compact-group group))
+ (gnus-error 3 "Couldn't compact group %s" group)
+ (gnus-message 6 "Compacting group %s...done" group)
+ t)
+ ;; Invalidate the "original article" buffer which might be out of date.
+ ;; #### NOTE: Yes, this might be a bit rude, but since compaction
+ ;; #### will not happen very often, I think this is acceptable.
+ (gnus-kill-buffer gnus-original-article-buffer)
+ ;; Update the group line to reflect new information (art number etc).
+ (gnus-group-update-group-line)))
(provide 'gnus-group)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 819936d935..25efb8afda 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -391,7 +391,7 @@ gnus-msg-force-broken-reply-to
(defun gnus-inews-make-draft (articles)
`(lambda ()
(gnus-inews-make-draft-meta-information
- ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
+ ,gnus-newsgroup-name ',articles)))
(autoload 'nnir-article-number "nnir" nil nil 'macro)
(autoload 'nnir-article-group "nnir" nil nil 'macro)
@@ -1680,7 +1680,6 @@ gnus-inews-do-gcc
(defun gnus-inews-insert-gcc (&optional group)
"Insert the Gcc to say where the article is to be archived."
(let* ((group (or group gnus-newsgroup-name))
- (group (when group (gnus-group-decoded-name group)))
(var (or gnus-outgoing-message-group gnus-message-archive-group))
(gcc-self-val
(and group (not (gnus-virtual-group-p group))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 972ff28e63..71c7807518 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -784,11 +784,13 @@ gnus-browse-foreign-server
(while (not (eobp))
(ignore-errors
(push (cons
- (buffer-substring
- (point)
- (progn
- (skip-chars-forward "^ \t")
- (point)))
+ (decode-coding-string
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point)))
+ 'utf-8-emacs)
(let ((last (read cur)))
(cons (read cur) last)))
groups))
@@ -796,18 +798,20 @@ gnus-browse-foreign-server
(while (not (eobp))
(ignore-errors
(push (cons
- (if (eq (char-after) ?\")
- (read cur)
- (let ((p (point)) (name ""))
- (skip-chars-forward "^ \t\\\\")
- (setq name (buffer-substring p (point)))
- (while (eq (char-after) ?\\)
- (setq p (1+ (point)))
- (forward-char 2)
- (skip-chars-forward "^ \t\\\\")
- (setq name (concat name (buffer-substring
- p (point)))))
- name))
+ (decode-coding-string
+ (if (eq (char-after) ?\")
+ (read cur)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ name))
+ 'utf-8-emacs)
(let ((last (read cur)))
(cons (read cur) last)))
groups))
@@ -859,12 +863,7 @@ gnus-browse-foreign-server
((= level gnus-level-zombie) ?Z)
(t ?K)))
(max 0 (- (1+ (cddr group)) (cadr group)))
- ;; Don't decode if name is ASCII
- (if (eq (detect-coding-string name t) 'undecided)
- name
- (decode-coding-string
- name
- (inline (gnus-group-name-charset method name)))))))
+ name)))
(list 'gnus-group name)
)))
(switch-to-buffer (current-buffer)))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index d726ee5aab..cb585472af 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -35,6 +35,7 @@
(autoload 'gnus-agent-read-servers-validate "gnus-agent")
(autoload 'gnus-agent-save-local "gnus-agent")
(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
+(declare-function gnus-group-decoded-name "gnus-group" (string))
(eval-when-compile (require 'cl-lib))
@@ -1830,17 +1831,22 @@ gnus-make-hashtable-from-newsrc-alist
(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 (car info) gnus-newsrc-hashtb)
+ (if (gethash gname gnus-newsrc-hashtb)
;; Remove this entry from the alist.
(setcdr alist (cddr alist))
(puthash
- (car info)
+ gname
;; Preserve number of unread articles in groups.
- (list (and ohashtb (car (gethash (car info) ohashtb)))
+ (list (and ohashtb (car (gethash gname ohashtb)))
info)
gnus-newsrc-hashtb)
- (push (car info) gnus-group-list))
+ (push gname gnus-group-list))
(setq alist (cdr alist)))
(setq gnus-group-list (nreverse gnus-group-list))
;; Make the same select-methods in `gnus-server-alist' identical
@@ -2146,9 +2152,7 @@ gnus-active-to-gnus-format
(cond ((numberp group)
(number-to-string group))
((symbolp group)
- (encode-coding-string
- (symbol-name group)
- 'latin-1))
+ (symbol-name group))
((stringp group)
group)))))
(numberp (setq max (read cur)))
@@ -2157,7 +2161,11 @@ gnus-active-to-gnus-format
(skip-chars-forward " \t")
(memq (char-after)
'(?= ?x ?j)))))
- (progn (puthash group (cons min max) hashtb)
+ (progn (when (string-match-p "[^[:ascii:]]" group)
+ ;; NNTP servers may give us encoded group
+ ;; names.
+ (setq group (gnus-group-decoded-name group)))
+ (puthash group (cons min max) hashtb)
;; If group is moderated, stick it in the
;; moderation cache.
(when (eq (char-after) ?m)
@@ -2396,6 +2404,17 @@ 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)
@@ -2494,7 +2513,9 @@ gnus-newsrc-to-gnus-format
(read buf))
group (if (numberp group)
(number-to-string group)
- (symbol-name group)))
+ ;; newsrc files are written as 'raw-text.
+ (decode-coding-string
+ (symbol-name group) 'raw-text)))
(widen)
(cond
;; It's possible that "group" is actually an options line.
@@ -2913,10 +2934,6 @@ gnus-gnus-to-newsrc-format
(setq default-directory (file-name-directory buffer-file-name))
(buffer-disable-undo)
(erase-buffer)
- ;; Use a unibyte buffer since group names are unibyte strings;
- ;; in particular, non-ASCII group names are the ones encoded by
- ;; a certain coding system.
- (mm-disable-multibyte)
;; Write options.
(when gnus-newsrc-options
(insert gnus-newsrc-options))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 73f0eb3918..a6a0bdb228 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -3500,8 +3500,7 @@ gnus-summary-setup-buffer
Returns non-nil if the setup was successful."
(let ((buffer (gnus-summary-buffer-name group))
- (dead-name (concat "*Dead Summary "
- (gnus-group-decoded-name group) "*")))
+ (dead-name (concat "*Dead Summary " group "*")))
;; If a dead summary buffer exists, we kill it.
(gnus-kill-buffer dead-name)
(if (get-buffer buffer)
@@ -3984,8 +3983,7 @@ gnus-summary-read-group-1
;; (when (and (not (gnus-group-native-p group))
;; (not (gethash group gnus-newsrc-hashtb)))
;; (error "Dead non-native groups can't be entered"))
- (gnus-message 7 "Retrieving newsgroup: %s..."
- (gnus-group-decoded-name group))
+ (gnus-message 7 "Retrieving newsgroup: %s..." group)
(let* ((new-group (gnus-summary-setup-buffer group))
(quit-config (gnus-group-quit-config group))
(did-select (and new-group (gnus-select-newsgroup
@@ -4016,8 +4014,7 @@ gnus-summary-read-group-1
(gnus-group-next-unread-group 1))
(gnus-handle-ephemeral-exit quit-config)))
(if (null (gnus-list-of-unread-articles group))
- (gnus-message 3 "Group %s contains no messages"
- (gnus-group-decoded-name group))
+ (gnus-message 3 "Group %s contains no messages" group)
(gnus-message 3 "Can't select group"))
nil)
;; The user did a `C-g' while prompting for number of articles,
@@ -5618,25 +5615,24 @@ gnus-summary-remove-list-identifiers
(defun gnus-fetch-headers (articles &optional limit force-new dependencies)
"Fetch headers of ARTICLES."
- (let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
- (gnus-message 7 "Fetching headers for %s..." name)
- (prog1
- (if (eq 'nov
- (setq gnus-headers-retrieved-by
- (gnus-retrieve-headers
- articles gnus-newsgroup-name
- (or limit
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers)))))
- (gnus-get-newsgroup-headers-xover
- articles force-new dependencies gnus-newsgroup-name t)
- (gnus-get-newsgroup-headers dependencies force-new))
- (gnus-message 7 "Fetching headers for %s...done" name))))
+ (gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name)
+ (prog1
+ (if (eq 'nov
+ (setq gnus-headers-retrieved-by
+ (gnus-retrieve-headers
+ articles gnus-newsgroup-name
+ (or limit
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and (or (and
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))
+ gnus-fetch-old-headers)))))
+ (gnus-get-newsgroup-headers-xover
+ articles force-new dependencies gnus-newsgroup-name t)
+ (gnus-get-newsgroup-headers dependencies force-new))
+ (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
@@ -5649,13 +5645,12 @@ gnus-select-newsgroup
t
gnus-summary-ignore-duplicates))
(info (nth 1 entry))
- charset articles fetched-articles cached)
+ articles fetched-articles cached)
(unless (gnus-check-server
(set (make-local-variable 'gnus-current-select-method)
(gnus-find-method-for-group group)))
(error "Couldn't open server"))
- (setq charset (gnus-group-name-charset gnus-current-select-method group))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
(gnus-activate-group group) ; Or we can activate it...
@@ -5663,16 +5658,12 @@ gnus-select-newsgroup
(when (derived-mode-p 'gnus-summary-mode)
(gnus-kill-buffer (current-buffer)))
(error
- "Couldn't activate group %s: %s"
- (decode-coding-string group charset)
- (decode-coding-string (gnus-status-message group) charset))))
+ "Couldn't activate group %s: %s" group (gnus-status-message group))))
(unless (gnus-request-group group t nil info)
(when (derived-mode-p 'gnus-summary-mode)
(gnus-kill-buffer (current-buffer)))
- (error "Couldn't request group %s: %s"
- (decode-coding-string group charset)
- (decode-coding-string (gnus-status-message group) charset)))
+ (error "Couldn't request group %s: %s" group (gnus-status-message group)))
(when (and gnus-agent
(gnus-active group))
@@ -5938,13 +5929,11 @@ gnus-articles-to-read
(if only-read-p
(format
"How many articles from %s (available %d, default %d): "
- (gnus-group-real-name
- (gnus-group-decoded-name gnus-newsgroup-name))
+ (gnus-group-real-name gnus-newsgroup-name)
number default)
(format
"How many articles from %s (%d default): "
- (gnus-group-real-name
- (gnus-group-decoded-name gnus-newsgroup-name))
+ (gnus-group-real-name gnus-newsgroup-name)
default))
nil
nil
@@ -5956,8 +5945,7 @@ gnus-articles-to-read
(read-string
(format "%s %s (%d scored, %d total): "
"How many articles from"
- (gnus-group-decoded-name
- (gnus-group-real-name gnus-newsgroup-name))
+ (gnus-group-real-name gnus-newsgroup-name)
scored number))))
(if (string-match "^[ \t]*$" input)
number input)))
@@ -6199,8 +6187,7 @@ gnus-set-mode-line
(intern
(format "gnus-%s-mode-line-format-spec" where))))
(gnus-tmp-group-name (gnus-mode-string-quote
- (gnus-group-decoded-name
- gnus-newsgroup-name)))
+ gnus-newsgroup-name))
(gnus-tmp-article-number (or gnus-current-article 0))
(gnus-tmp-unread gnus-newsgroup-unreads)
(gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
@@ -7921,11 +7908,11 @@ gnus-summary-walk-group-buffer
(not (gnus-ephemeral-group-p gnus-newsgroup-name)))
(format " (Type %s for %s [%s])"
(single-key-description cmd)
- (gnus-group-decoded-name group)
+ group
(gnus-group-unread group))
(format " (Type %s to exit %s)"
(single-key-description cmd)
- (gnus-group-decoded-name gnus-newsgroup-name)))))
+ gnus-newsgroup-name))))
;; Confirm auto selection.
(setq key (car (setq keve (gnus-read-event-char prompt)))
ended t)
@@ -10110,7 +10097,7 @@ gnus-summary-move-article
(copy-buf (save-excursion
(nnheader-set-temp-buffer " *copy article*")))
art-group to-method new-xref article to-groups
- articles-to-update-marks encoded)
+ articles-to-update-marks)
(unless (assq action names)
(error "Unknown action %s" action))
;; Read the newsgroup name.
@@ -10132,22 +10119,12 @@ gnus-summary-move-article
(symbol-value
(intern (format "gnus-current-%s-group" action)))
articles prefix)
- encoded to-newsgroup
to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
- (set (intern (format "gnus-current-%s-group" action))
- (decode-coding-string
- to-newsgroup
- (gnus-group-name-charset to-method to-newsgroup))))
+ (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
(unless to-method
(setq to-method (or select-method
(gnus-server-to-method
(gnus-group-method to-newsgroup)))))
- (setq to-newsgroup
- (or encoded
- (and to-newsgroup
- (encode-coding-string
- to-newsgroup
- (gnus-group-name-charset to-method to-newsgroup)))))
;; Check the method we are to move this article to...
(unless (gnus-check-backend-function
'request-accept-article (car to-method))
@@ -10157,7 +10134,7 @@ gnus-summary-move-article
(gnus-message 6 "%s to %s: %s..."
(caddr (assq action names))
(or (car select-method)
- (gnus-group-decoded-name to-newsgroup))
+ to-newsgroup)
articles)
;; This `while' is not equivalent to a `dolist' (bug#33653#134).
(while articles
@@ -12469,27 +12446,23 @@ gnus-read-move-group-name
(t
(gnus-completing-read
prom (nreverse split-name) nil nil 'gnus-group-history))))
- (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
- encoded)
+ (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
(setq to-newsgroup default))
(unless to-newsgroup
- (user-error "No group name entered"))
- (setq encoded (encode-coding-string
- to-newsgroup
- (gnus-group-name-charset to-method to-newsgroup)))
- (or (gnus-active encoded)
- (gnus-activate-group encoded nil nil to-method)
+ (error "No group name entered"))
+ (or (gnus-active to-newsgroup)
+ (gnus-activate-group to-newsgroup nil nil to-method)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (or (and (gnus-request-create-group encoded to-method)
- (gnus-activate-group encoded nil nil to-method)
- (gnus-subscribe-group encoded))
+ (or (and (gnus-request-create-group to-newsgroup to-method)
+ (gnus-activate-group to-newsgroup nil nil to-method)
+ (gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup)))
- (user-error "No such group: %s" to-newsgroup))
- encoded)))
+ (error "No such group: %s" to-newsgroup))
+ to-newsgroup)))
(defvar gnus-summary-save-parts-counter)
(declare-function mm-uu-dissect "mm-uu" (&optional noheader mime-type))
@@ -13156,7 +13129,7 @@ gnus-summary-insert-old-articles
(read-string
(format
"How many articles from %s (%s %d): "
- (gnus-group-decoded-name gnus-newsgroup-name)
+ gnus-newsgroup-name
(if initial "max" "default")
len)
nil nil
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 9ccdb83865..c6be59fd19 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1173,16 +1173,9 @@ gnus-and
"Return non-nil if all ELEMENTS are non-nil."
(not (memq nil elements)))
-;; gnus.el requires mm-util.
-(declare-function mm-disable-multibyte "mm-util")
-
(defun gnus-write-active-file (file hashtb &optional full-names)
- ;; `coding-system-for-write' should be `raw-text' or equivalent.
(let ((coding-system-for-write nnmail-active-file-coding-system))
(with-temp-file file
- ;; The buffer should be in the unibyte mode because group names
- ;; are ASCII text or encoded non-ASCII text (i.e., unibyte).
- (mm-disable-multibyte)
(maphash
(lambda (group active)
(when active
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 9ee7db9e20..f990569a30 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3444,11 +3444,9 @@ gnus-group-prefixed-p
"Return the prefix of the current group name."
(< 0 (length (gnus-group-real-prefix group))))
-(declare-function gnus-group-decoded-name "gnus-group" (string))
-
(defun gnus-summary-buffer-name (group)
"Return the summary buffer name of GROUP."
- (concat "*Summary " (gnus-group-decoded-name group) "*"))
+ (concat "*Summary " group "*"))
(defun gnus-group-method (group)
"Return the server or method used for selecting GROUP.
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index ea7a282b8b..1183cd9385 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1889,7 +1889,6 @@ message-bogus-system-names
(autoload 'gnus-delay-article "gnus-delay")
(autoload 'gnus-extract-address-components "gnus-util")
(autoload 'gnus-find-method-for-group "gnus")
-(autoload 'gnus-group-decoded-name "gnus-group")
(autoload 'gnus-group-name-charset "gnus-group")
(autoload 'gnus-group-name-decode "gnus-group")
(autoload 'gnus-groups-from-server "gnus")
@@ -5626,7 +5625,7 @@ message-make-in-reply-to
(concat
msg-id (if msg-id " (")
(if (car name)
- (if (string-match "[^\000-\177]" (car name))
+ (if (string-match "[^[:ascii:]]" (car name))
;; Quote a string containing non-ASCII characters.
;; It will make the RFC2047 encoder cause an error
;; if there are special characters.
@@ -7283,12 +7282,11 @@ message-forward-subject-name-subject
(let* ((group (message-fetch-field "newsgroups"))
(from (message-fetch-field "from"))
(prefix
- (if group
- (gnus-group-decoded-name group)
- (or (and from (or
- (car (gnus-extract-address-components from))
- (cadr (gnus-extract-address-components from))))
- "(nowhere)"))))
+ (or group
+ (or (and from (or
+ (car (gnus-extract-address-components from))
+ (cadr (gnus-extract-address-components from))))
+ "(nowhere)"))))
(concat "["
(if message-forward-decoded-p
prefix
@@ -7302,10 +7300,9 @@ message-forward-subject-author-subject
the list of newsgroups is was posted to."
(let* ((group (message-fetch-field "newsgroups"))
(prefix
- (if group
- (gnus-group-decoded-name group)
- (or (message-fetch-field "from")
- "(nowhere)"))))
+ (or group
+ (or (message-fetch-field "from")
+ "(nowhere)"))))
(concat "["
(if message-forward-decoded-p
prefix
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index 64f3a86181..f0baf99bd4 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -117,18 +117,17 @@ nnagent-request-post
(gnus-request-accept-article "nndraft:queue" nil t t))
(deffoo nnagent-request-set-mark (group action server)
- (mm-with-unibyte-buffer
- (insert "(gnus-agent-synchronize-group-flags \""
- group
- "\" '")
- (gnus-pp action)
- (insert " \""
- (gnus-method-to-server gnus-command-method)
- "\"")
- (insert ")\n")
- (let ((coding-system-for-write nnheader-file-coding-system))
- (write-region (point-min) (point-max) (gnus-agent-lib-file "flags")
- t 'silent)))
+ (insert "(gnus-agent-synchronize-group-flags \""
+ group
+ "\" '")
+ (gnus-pp action)
+ (insert " \""
+ (gnus-method-to-server gnus-command-method)
+ "\"")
+ (insert ")\n")
+ (let ((coding-system-for-write nnheader-file-coding-system))
+ (write-region (point-min) (point-max) (gnus-agent-lib-file "flags")
+ t 'silent))
;; Also set the marks for the original back end that keeps marks in
;; the local system.
(let ((gnus-agent nil))
--git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 6ef324ae91..c87cfc8c7c 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -30,7 +30,6 @@
(defvar nnmail-extra-headers)
(defvar gnus-newsgroup-name)
-(defvar nnheader-file-coding-system)
(defvar jka-compr-compression-info-list)
;; Requiring `gnus-util' at compile time creates a circular
@@ -499,7 +498,8 @@ nnheader-find-nov-line
(defvar nntp-server-buffer nil)
(defvar nntp-process-response nil)
-
+(defvar nnheader-file-coding-system 'undecided
+ "Coding system used in file backends of Gnus.")
(defvar nnheader-callback-function nil)
(defun nnheader-init-server-buffer ()
@@ -871,9 +871,6 @@ nnheader-re-read-dir
(when (string-match (car ange-ftp-path-format) path)
(ange-ftp-re-read-dir path)))))
-(defvar nnheader-file-coding-system 'raw-text
- "Coding system used in file backends of Gnus.")
-
(defun nnheader-insert-file-contents (filename &optional visit beg end replace)
"Like `insert-file-contents', q.v., but only reads in the file.
A buffer may be modified in several ways after reading into the buffer due
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index c6eaa54c69..7c402e8d54 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -119,12 +119,6 @@ nnimap-current-infos
(defvoo nnimap-namespace nil)
-(defun nnimap-decode-gnus-group (group)
- (decode-coding-string group 'utf-8))
-
-(defun nnimap-encode-gnus-group (group)
- (encode-coding-string group 'utf-8))
-
(defvoo nnimap-fetch-partial-articles nil
"If non-nil, Gnus will fetch partial articles.
If t, Gnus will fetch only the first part. If a string, it
@@ -209,8 +203,6 @@ nnimap-header-parameters
(format "%s" (nreverse params))))
(deffoo nnimap-retrieve-headers (articles &optional group server _fetch-old)
- (when group
- (setq group (nnimap-decode-gnus-group group)))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(when (nnimap-change-group group server)
@@ -645,8 +637,6 @@ nnimap-status-message
nnimap-status-string)
(deffoo nnimap-request-article (article &optional group server to-buffer)
- (when group
- (setq group (nnimap-decode-gnus-group group)))
(with-current-buffer nntp-server-buffer
(let ((result (nnimap-change-group group server))
parts structure)
@@ -678,8 +668,6 @@ nnimap-request-article
(cons group article)))))))
(deffoo nnimap-request-head (article &optional group server to-buffer)
- (when group
- (setq group (nnimap-decode-gnus-group group)))
(when (nnimap-change-group group server)
(with-current-buffer (nnimap-buffer)
(when (stringp article)
@@ -697,8 +685,6 @@ nnimap-request-head
(cons group article)))))))
(deffoo nnimap-request-articles (articles &optional group server)
- (when group
- (setq group (nnimap-decode-gnus-group group)))
(with-current-buffer nntp-server-buffer
(let ((result (nnimap-change-group group server)))
(when result
@@ -848,7 +834,6 @@ nnimap-find-wanted-parts-1
(nreverse parts)))
(deffoo nnimap-request-group (group &optional server dont-check info)
- (setq group (nnimap-decode-gnus-group group))
(let ((result (nnimap-change-group
;; Don't SELECT the group if we're going to select it
;; later, anyway.
@@ -875,11 +860,10 @@ nnimap-request-group
(- (cdr active) (car active))
(car active)
(cdr active)
- (nnimap-encode-gnus-group group)))
+ group))
t))))
(deffoo nnimap-request-group-scan (group &optional server info)
- (setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(let (marks high low)
(with-current-buffer (nnimap-buffer)
@@ -911,23 +895,20 @@ nnimap-request-group-scan
(insert
(format
"211 %d %d %d %S\n" (1+ (- high low)) low high
- (nnimap-encode-gnus-group group)))
+ group))
t))))
(deffoo nnimap-request-create-group (group &optional server _args)
- (setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "CREATE %S" (nnimap-group-to-imap group))))))
(deffoo nnimap-request-delete-group (group &optional _force server)
- (setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "DELETE %S" (nnimap-group-to-imap group))))))
(deffoo nnimap-request-rename-group (group new-name &optional server)
- (setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer)
(nnimap-unselect-group)
@@ -942,7 +923,6 @@ nnimap-unselect-group
(nnimap-command "EXAMINE DOES.NOT.EXIST"))
(deffoo nnimap-request-expunge-group (group &optional server)
- (setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group group server)
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "EXPUNGE")))))
@@ -971,9 +951,6 @@ nnimap-close-group
(deffoo nnimap-request-move-article (article group server accept-form
&optional _last
internal-move-group)
- (setq group (nnimap-decode-gnus-group group))
- (when internal-move-group
- (setq internal-move-group (nnimap-decode-gnus-group internal-move-group)))
(with-temp-buffer
(mm-disable-multibyte)
(when (funcall (if internal-move-group
@@ -1007,7 +984,6 @@ nnimap-request-move-article
result))))))
(deffoo nnimap-request-expire-articles (articles group &optional server force)
- (setq group (nnimap-decode-gnus-group group))
(cond
((null articles)
nil)
@@ -1156,8 +1132,6 @@ nnimap-delete-article
"delete this article now"))))))
(deffoo nnimap-request-scan (&optional group server)
- (when group
- (setq group (nnimap-decode-gnus-group group)))
(when (and (nnimap-change-group nil server)
nnimap-inbox
nnimap-split-methods)
@@ -1176,7 +1150,6 @@ nnimap-marks-to-flags
flags))
(deffoo nnimap-request-update-group-status (group status &optional server)
- (setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(let ((command (assoc
status
@@ -1187,7 +1160,6 @@ nnimap-request-update-group-status
(nnimap-command "%s %S" (cadr command) (nnimap-group-to-imap group)))))))
(deffoo nnimap-request-set-mark (group actions &optional server)
- (setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group group server)
(let (sequence)
(with-current-buffer (nnimap-buffer)
@@ -1222,8 +1194,7 @@ nnimap-request-accept-article
;; that's determined by the IMAP server later. So just
;; return the group name.
(lambda (group)
- (list (list group)))))))
- (setq group (nnimap-decode-gnus-group group))
+ (list (list group)))))))
(when (nnimap-change-group nil server)
(nnmail-check-syntax)
(let ((message-id (message-field-value "message-id"))
@@ -1301,7 +1272,6 @@ nnimap-find-response-element
result))
(deffoo nnimap-request-replace-article (article group buffer)
- (setq group (nnimap-decode-gnus-group group))
(let (group-art)
(when (and (nnimap-change-group group)
;; Put the article into the group.
@@ -1385,8 +1355,7 @@ nnimap-request-list
(dolist (response responses)
(let* ((sequence (car response))
(response (cadr response))
- (group (cadr (assoc sequence sequences)))
- (egroup (nnimap-encode-gnus-group group)))
+ (group (cadr (assoc sequence sequences))))
(when (and group
(equal (caar response) "OK"))
(let ((uidnext (nnimap-find-parameter "UIDNEXT" response))
@@ -1398,14 +1367,14 @@ nnimap-request-list
(setq highest (1- (string-to-number (car uidnext)))))
(cond
((null highest)
- (insert (format "%S 0 1 y\n" egroup)))
+ (insert (format "%S 0 1 y\n" group)))
((zerop exists)
;; Empty group.
- (insert (format "%S %d %d y\n" egroup
+ (insert (format "%S %d %d y\n" group
highest (1+ highest))))
(t
;; Return the widest possible range.
- (insert (format "%S %d 1 y\n" egroup
+ (insert (format "%S %d 1 y\n" group
(or highest exists)))))))))
t)))))
@@ -1417,7 +1386,7 @@ nnimap-request-newgroups
(nnimap-get-groups)))
(unless (assoc group nnimap-current-infos)
;; Insert dummy numbers here -- they don't matter.
- (insert (format "%S 0 1 y\n" (nnimap-encode-gnus-group group)))))
+ (insert (format "%S 0 1 y\n" group))))
t)))
(deffoo nnimap-retrieve-group-data-early (server infos)
@@ -1434,8 +1403,7 @@ nnimap-retrieve-group-data-early
;; what and how to request the data.
(dolist (info infos)
(setq params (gnus-info-params info)
- group (nnimap-decode-gnus-group
- (gnus-group-real-name (gnus-info-group info)))
+ group (gnus-group-real-name (gnus-info-group info))
active (cdr (assq 'active params))
unexist (assq 'unexist (gnus-info-marks info))
uidvalidity (cdr (assq 'uidvalidity params))
@@ -1516,16 +1484,13 @@ nnimap-finish-retrieve-group-infos
(active (gnus-active group)))
(when active
(insert (format "%S %d %d y\n"
- (nnimap-encode-gnus-group
- (nnimap-decode-gnus-group
- (gnus-group-real-name group)))
+ (gnus-group-real-name group)
(cdr active)
(car active))))))))))))
(defun nnimap-update-infos (flags infos)
(dolist (info infos)
- (let* ((group (nnimap-decode-gnus-group
- (gnus-group-real-name (gnus-info-group info))))
+ (let* ((group (gnus-group-real-name (gnus-info-group info)))
(marks (cdr (assoc group flags))))
(when marks
(nnimap-update-info info marks)))))
@@ -1739,8 +1704,7 @@ nnimap-imap-ranges-to-gnus-ranges
(nreverse result))))
(defun nnimap-store-info (info active)
- (let* ((group (nnimap-decode-gnus-group
- (gnus-group-real-name (gnus-info-group info))))
+ (let* ((group (gnus-group-real-name (gnus-info-group info)))
(entry (assoc group nnimap-current-infos)))
(if entry
(setcdr entry (list info active))
@@ -1865,8 +1829,6 @@ gnus-refer-thread-use-nnir
(autoload 'nnir-search-thread "nnir")
(deffoo nnimap-request-thread (header &optional group server)
- (when group
- (setq group (nnimap-decode-gnus-group group)))
(if gnus-refer-thread-use-nnir
(nnir-search-thread header)
(when (nnimap-change-group group server)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 0699e81812..de6b01774d 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -665,9 +665,12 @@ nnmail-parse-active
(condition-case err
(progn
(narrow-to-region (point) (point-at-eol))
- (setq group (read buffer))
- (unless (stringp group)
- (setq group (encode-coding-string (symbol-name group) 'latin-1)))
+ (setq group (read buffer)
+ group
+ (cond ((symbolp group)
+ (symbol-name group))
+ ((numberp group)
+ (number-to-string group))))
(if (and (numberp (setq max (read buffer)))
(numberp (setq min (read buffer))))
(push (list group (cons min max))
@@ -677,7 +680,7 @@ nnmail-parse-active
(forward-line 1))
group-assoc))
-(defcustom nnmail-active-file-coding-system 'raw-text
+(defcustom nnmail-active-file-coding-system 'utf-8-emacs
"Coding system for active file."
:group 'nnmail-various
:type 'coding-system)
@@ -687,7 +690,7 @@ nnmail-save-active
(let ((coding-system-for-write nnmail-active-file-coding-system))
(when file-name
(with-temp-file file-name
- (mm-disable-multibyte)
+; (mm-disable-multibyte)
(nnmail-generate-active group-assoc)))))
(defun nnmail-generate-active (alist)
@@ -695,7 +698,7 @@ nnmail-generate-active
(erase-buffer)
(let (group)
(while (setq group (pop alist))
- (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
+ (insert (format "%s %d %d y\n" (car group) (cdadr group)
(caadr group))))
(goto-char (point-max))
(while (search-backward "\\." nil t)
@@ -1027,8 +1030,8 @@ nnmail-process-maildir-mail-format
(nnmail-check-duplication message-id func artnum-func))
1))
-(defvar nnmail-group-names-not-encoded-p nil
- "Non-nil means group names are not encoded.")
+(make-obsolete-variable 'nnmail-group-names-not-encoded-p
+ "Group names are always decoded" "27.1")
(defun nnmail-split-incoming (incoming func &optional exit-func
group artnum-func junk-func)
@@ -1036,18 +1039,21 @@ nnmail-split-incoming
FUNC will be called with the buffer narrowed to each mail.
INCOMING can also be a buffer object. In that case, the mail
will be copied over from that buffer."
- (let ( ;; If this is a group-specific split, we bind the split
+ (let (;; If this is a group-specific split, we bind the split
;; methods to just this group.
(nnmail-split-methods (if (and group
(not nnmail-resplit-incoming))
(list (list group ""))
- nnmail-split-methods))
- (nnmail-group-names-not-encoded-p t))
+ nnmail-split-methods)))
;; Insert the incoming file.
(with-current-buffer (get-buffer-create nnmail-article-buffer)
(erase-buffer)
(if (bufferp incoming)
(insert-buffer-substring incoming)
+ ;; The following coding system is set to
+ ;; `mm-text-coding-system', which is set to some flavor of
+ ;; 'raw-text "to get rid of ^Ms". But it's going to do a lot
+ ;; more than that, right? Shouldn't this also be 'undecided?
(let ((coding-system-for-read nnmail-incoming-coding-system))
(mm-insert-file-contents incoming)))
(prog1
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 246f52c8d2..d62e1e9253 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -415,7 +415,7 @@ nnmaildir--new-number
(t (signal (car err) (cdr err)))))))))
(defun nnmaildir--update-nov (server group article)
- (let ((nnheader-file-coding-system 'binary)
+ (let ((nnheader-file-coding-system 'undecided)
(srv-dir (nnmaildir--srv-dir server))
(storage-version 1) ;; [version article-number msgid [...nov...]]
dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 89c8b23b65..302589bd6d 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -111,36 +111,9 @@ nnml-file-coding-system
(nnoo-define-basics nnml)
-(eval-when-compile
- (defsubst nnml-group-name-charset (group server-or-method)
- (gnus-group-name-charset
- (if (stringp server-or-method)
- (gnus-server-to-method
- (if (string-match "\\+" server-or-method)
- (concat (substring server-or-method 0 (match-beginning 0))
- ":" (substring server-or-method (match-end 0)))
- (concat "nnml:" server-or-method)))
- (or server-or-method gnus-command-method '(nnml "")))
- group)))
-
-(defun nnml-decoded-group-name (group &optional server-or-method)
- "Return a decoded group name of GROUP on SERVER-OR-METHOD."
- (if nnmail-group-names-not-encoded-p
- group
- (decode-coding-string
- group
- (nnml-group-name-charset group server-or-method))))
-
-(defun nnml-encoded-group-name (group &optional server-or-method)
- "Return an encoded group name of GROUP on SERVER-OR-METHOD."
- (encode-coding-string
- group
- (nnml-group-name-charset group server-or-method)))
-
(defun nnml-group-pathname (group &optional file server)
"Return an absolute file name of FILE for GROUP on SERVER."
- (nnmail-group-pathname (inline (nnml-decoded-group-name group server))
- nnml-directory file))
+ (nnmail-group-pathname group nnml-directory file))
(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
(when (nnml-possibly-change-directory group server)
@@ -243,8 +216,7 @@ nnml-request-article
(string-to-number (file-name-nondirectory path)))))))
(deffoo nnml-request-group (group &optional server dont-check info)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (decoded (nnml-decoded-group-name group server)))
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
(cond
((not (nnml-possibly-change-directory group server))
(nnheader-report 'nnml "Invalid group (no such directory)"))
@@ -254,15 +226,15 @@ nnml-request-group
((not (file-directory-p nnml-current-directory))
(nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
(dont-check
- (nnheader-report 'nnml "Group %s selected" decoded)
+ (nnheader-report 'nnml "Group %s selected" group)
t)
(t
(nnheader-re-read-dir nnml-current-directory)
(nnmail-activate 'nnml)
(let ((active (nth 1 (assoc-string group nnml-group-alist))))
(if (not active)
- (nnheader-report 'nnml "No such group: %s" decoded)
- (nnheader-report 'nnml "Selected group %s" decoded)
+ (nnheader-report 'nnml "No such group: %s" group)
+ (nnheader-report 'nnml "Selected group %s" group)
(nnheader-insert "211 %d %d %d %s\n"
(max (1+ (- (cdr active) (car active))) 0)
(car active) (cdr active) group)))))))
@@ -332,7 +304,6 @@ nnml-request-expire-articles
(active-articles
(nnml-directory-articles nnml-current-directory))
(is-old t)
- (decoded (nnml-decoded-group-name group server))
article rest mod-time number target)
(nnmail-activate 'nnml)
@@ -370,7 +341,7 @@ nnml-request-expire-articles
(if target
(progn
(nnheader-message 5 "Deleting article %s in %s"
- number decoded)
+ number group)
(condition-case ()
(funcall nnmail-delete-file-function article)
(file-error
@@ -506,13 +477,12 @@ nnml-request-delete-group
nnml-current-directory t
(concat
nnheader-numerical-short-files
- "\\|" (regexp-quote nnml-nov-file-name) "$")))
- (decoded (nnml-decoded-group-name group server)))
+ "\\|" (regexp-quote nnml-nov-file-name) "$"))))
(dolist (article articles)
(when (file-writable-p article)
(nnheader-message 5 "Deleting article %s in %s..."
(file-name-nondirectory article)
- decoded)
+ group)
(funcall nnmail-delete-file-function article))))
;; Try to delete the directory itself.
(ignore-errors (delete-directory nnml-current-directory))))
@@ -687,15 +657,7 @@ nnml-save-mail
(if (stringp nnml-use-compressed-files)
nnml-use-compressed-files
".gz")))
- decoded dec file first headers)
- (when nnmail-group-names-not-encoded-p
- (dolist (ga (prog1 group-art (setq group-art nil)))
- (setq group-art (nconc group-art
- (list (cons (nnml-encoded-group-name (car ga)
- server)
- (cdr ga))))
- decoded (nconc decoded (list (car ga)))))
- (setq dec decoded))
+ file first headers)
(nnmail-insert-xref group-art)
(run-hooks 'nnmail-prepare-save-mail-hook)
(run-hooks 'nnml-prepare-save-mail-hook)
@@ -705,16 +667,10 @@ nnml-save-mail
(forward-line 1))
;; We save the article in all the groups it belongs in.
(dolist (ga group-art)
- (if nnmail-group-names-not-encoded-p
- (progn
- (nnml-possibly-create-directory (car decoded) server)
- (setq file (nnmail-group-pathname
- (pop decoded) nnml-directory
- (concat (number-to-string (cdr ga)) extension))))
- (nnml-possibly-create-directory (car ga) server)
- (setq file (nnml-group-pathname
- (car ga) (concat (number-to-string (cdr ga)) extension)
- server)))
+ (nnml-possibly-create-directory (car ga) server)
+ (setq file (nnml-group-pathname
+ (car ga) (concat (number-to-string (cdr ga)) extension)
+ server))
(if first
;; It was already saved, so we just make a hard link.
(let ((file-name-coding-system nnmail-pathname-coding-system))
@@ -731,18 +687,13 @@ nnml-save-mail
(let ((func (if full-nov
'nnml-add-nov
'nnml-add-incremental-nov)))
- (if nnmail-group-names-not-encoded-p
- (dolist (ga group-art)
- (funcall func (pop dec) (cdr ga) headers))
- (dolist (ga group-art)
- (funcall func (car ga) (cdr ga) headers)))))
+ (dolist (ga group-art)
+ (funcall func (car ga) (cdr ga) headers))))
group-art)
(defun nnml-active-number (group &optional server)
"Compute the next article number in GROUP on SERVER."
- (let* ((encoded (if nnmail-group-names-not-encoded-p
- (nnml-encoded-group-name group server)))
- (active (cadr (assoc-string (or encoded group) nnml-group-alist))))
+ (let ((active (cadr (assoc-string group nnml-group-alist))))
;; The group wasn't known to nnml, so we just create an active
;; entry for it.
(unless active
@@ -760,7 +711,7 @@ nnml-active-number
(cons (caar nnml-article-file-alist)
(caar (last nnml-article-file-alist)))
(cons 1 0)))
- (push (list (or encoded group) active) nnml-group-alist))
+ (push (list group active) nnml-group-alist))
(setcdr active (1+ (cdr active)))
(while (file-exists-p
(nnml-group-pathname group (int-to-string (cdr active)) server))
@@ -821,16 +772,15 @@ nnml-parse-head
headers))))
(defun nnml-get-nov-buffer (group &optional incrementalp)
- (let* ((decoded (nnml-decoded-group-name group))
- (buffer (get-buffer-create (format " *nnml %soverview %s*"
+ (let ((buffer (get-buffer-create (format " *nnml %soverview %s*"
(if incrementalp
"incremental "
"")
- decoded)))
+ group)))
(file-name-coding-system nnmail-pathname-coding-system))
(with-current-buffer buffer
(set (make-local-variable 'nnml-nov-buffer-file-name)
- (nnmail-group-pathname decoded nnml-directory nnml-nov-file-name))
+ (nnmail-group-pathname group nnml-directory nnml-nov-file-name))
(erase-buffer)
(when (and (not incrementalp)
(file-exists-p nnml-nov-buffer-file-name))
@@ -908,7 +858,7 @@ nnml-generate-active-info
;; Update the active info for this group.
(let ((group (directory-file-name dir))
entry last)
- (setq group (nnheader-file-to-group (nnml-encoded-group-name group)
+ (setq group (nnheader-file-to-group group
nnml-directory)
entry (assoc group nnml-group-alist)
last (or (caadr entry) 0)
--git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 0bfecb28e0..f4a387b2a4 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -367,7 +367,7 @@ nnrss-retrieve-groups
(with-current-buffer nntp-server-buffer
(erase-buffer)
(dolist (group groups)
- (let ((elem (assoc-string (gnus-group-decoded-name group) nnrss-server-data)))
+ (let ((elem (assoc-string group nnrss-server-data)))
(insert (format "%S %s 1 y\n" group (or (cadr elem) 0)))))
'active))
--
2.22.0
next prev parent reply other threads:[~2019-07-30 23:00 UTC|newest]
Thread overview: 60+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-04-22 18:39 bug#35383: 27.0.50; Complete process of decoding Gnus group names Eric Abrahamsen
2019-04-23 8:12 ` Katsumi Yamaoka
2019-04-23 19:55 ` Eric Abrahamsen
2019-04-24 8:06 ` Katsumi Yamaoka
2019-04-24 17:04 ` Eric Abrahamsen
2019-04-24 23:48 ` Katsumi Yamaoka
2019-04-25 16:10 ` Eric Abrahamsen
2019-04-26 5:21 ` Katsumi Yamaoka
2019-04-26 6:53 ` Eli Zaretskii
2019-04-26 8:08 ` Katsumi Yamaoka
2019-04-26 10:55 ` Eli Zaretskii
2019-04-29 4:05 ` Eric Abrahamsen
2019-04-29 4:07 ` Eric Abrahamsen
2019-04-29 15:41 ` Eli Zaretskii
2019-04-29 20:04 ` Eric Abrahamsen
2019-04-30 3:55 ` Eli Zaretskii
2019-04-30 17:03 ` Eric Abrahamsen
2019-04-30 17:11 ` Eli Zaretskii
2019-04-30 17:19 ` Eric Abrahamsen
2019-04-30 17:44 ` Eli Zaretskii
2019-04-30 18:17 ` Eric Abrahamsen
2019-04-29 15:38 ` Eli Zaretskii
2019-05-13 0:32 ` Katsumi Yamaoka
2019-05-13 20:14 ` Eric Abrahamsen
2019-05-18 20:25 ` Eric Abrahamsen
2019-05-18 22:12 ` Basil L. Contovounesios
2019-05-18 23:23 ` Eric Abrahamsen
2019-05-19 1:03 ` Basil L. Contovounesios
2019-05-19 2:56 ` Eric Abrahamsen
2019-05-19 17:02 ` Eric Abrahamsen
2019-06-10 23:19 ` Katsumi Yamaoka
2019-06-11 0:03 ` Eric Abrahamsen
2019-06-11 4:33 ` Eric Abrahamsen
2019-06-11 8:09 ` Katsumi Yamaoka
2019-04-23 15:42 ` Andy Moreton
2019-04-23 21:42 ` Eric Abrahamsen
2019-04-23 22:58 ` Andy Moreton
2019-06-17 6:06 ` Eric Abrahamsen
2019-06-17 12:12 ` Deus Max
2019-06-17 16:22 ` Eric Abrahamsen
2019-06-19 20:57 ` Deus Max
2019-06-19 21:02 ` Deus Max
2019-06-19 21:40 ` Eric Abrahamsen
2019-06-20 13:00 ` Deus Max
2019-06-20 16:29 ` Eric Abrahamsen
2019-06-20 19:01 ` Deus Max
2019-06-20 19:16 ` Eric Abrahamsen
2019-06-21 20:59 ` Eric Abrahamsen
2019-06-22 14:44 ` Deus Max
2019-06-22 16:09 ` Eric Abrahamsen
2019-06-23 10:27 ` Deus Max
2019-07-08 3:09 ` Eric Abrahamsen
2019-07-08 19:46 ` Deus Max
2019-07-23 23:52 ` Eric Abrahamsen
2019-07-30 23:00 ` Eric Abrahamsen [this message]
2019-08-01 12:07 ` Lars Ingebrigtsen
2019-08-01 16:22 ` Eric Abrahamsen
2019-08-03 21:53 ` Eric Abrahamsen
2019-09-27 14:58 ` Lars Ingebrigtsen
2019-06-19 21:28 ` Deus Max
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87imrjm8kx.fsf@ericabrahamsen.net \
--to=eric@ericabrahamsen.net \
--cc=35383@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.