procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove Gnus group name encoding/decoding

Browse source 
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.
This commit is contained in:
Eric Abrahamsen 2018-11-16 12:53:56 -08:00
parent c6b4eed80a
commit cb12a84f2c
19 changed files with 276 additions and 493 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -229,7 +229,7 @@ NOTES:
"Cache of message subjects for spam messages. "Cache of message subjects for spam messages.
Actually a hash table holding subjects mapped to t.") Actually a hash table holding subjects mapped to t.")
(defvar gnus-agent-file-name nil) (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-file-loading-cache nil)
(defvar gnus-agent-total-fetched-hashtb nil) (defvar gnus-agent-total-fetched-hashtb nil)
(defvar gnus-agent-inhibit-update-total-fetched-for nil) (defvar gnus-agent-inhibit-update-total-fetched-for nil)
@ -406,8 +406,6 @@ manipulated as follows:
(defun gnus-agent-read-group () (defun gnus-agent-read-group ()
"Read a group name in the minibuffer, with completion." "Read a group name in the minibuffer, with completion."
(let ((def (or (gnus-group-group-name) gnus-newsgroup-name))) (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))) (gnus-group-completing-read nil nil t nil nil def)))
;;; Fetching setup functions. ;;; Fetching setup functions.
@ -1330,7 +1328,10 @@ downloaded into the agent."
(gnus-make-directory (file-name-directory file)) (gnus-make-directory (file-name-directory file))
(with-temp-file file (with-temp-file file
;; Emacs got problem to match non-ASCII group in multibyte buffer. ;; 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) (when (file-exists-p file)
(nnheader-insert-file-contents file) (nnheader-insert-file-contents file)
@ -1360,7 +1361,7 @@ downloaded into the agent."
(gnus-make-directory (file-name-directory file)) (gnus-make-directory (file-name-directory file))
(with-temp-buffer (with-temp-buffer
;; Emacs got problem to match non-ASCII group in multibyte buffer. ;; Emacs got problem to match non-ASCII group in multibyte buffer.
(mm-disable-multibyte) ;(mm-disable-multibyte)
(when (file-exists-p file) (when (file-exists-p file)
(nnheader-insert-file-contents file) (nnheader-insert-file-contents file)
@ -1372,18 +1373,6 @@ downloaded into the agent."
oactive-min (read (current-buffer))) ;; min oactive-min (read (current-buffer))) ;; min
(cons oactive-min oactive-max)))))))) (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) (defun gnus-agent-group-path (group)
"Translate GROUP into a file name." "Translate GROUP into a file name."
@ -1395,7 +1384,7 @@ downloaded into the agent."
(nnheader-translate-file-chars (nnheader-translate-file-chars
(nnheader-replace-duplicate-chars-in-string (nnheader-replace-duplicate-chars-in-string
(nnheader-replace-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 (if (or nnmail-use-long-file-names
@ -1409,7 +1398,7 @@ downloaded into the agent."
;; unplugged. The agent must, therefore, use the same directory ;; unplugged. The agent must, therefore, use the same directory
;; while plugged. ;; while plugged.
(nnmail-group-pathname (nnmail-group-pathname
(gnus-group-real-name (gnus-agent-decoded-group-name group)) (gnus-group-real-name group)
(if gnus-command-method (if gnus-command-method
(gnus-agent-directory) (gnus-agent-directory)
(let ((gnus-command-method (gnus-find-method-for-group group))) (let ((gnus-command-method (gnus-find-method-for-group group)))
@ -1437,7 +1426,7 @@ downloaded into the agent."
(format " *Gnus agent %s history*" (format " *Gnus agent %s history*"
(gnus-agent-method))))) (gnus-agent-method)))))
gnus-agent-history-buffers) gnus-agent-history-buffers)
(mm-disable-multibyte) ;; everything is binary ;(mm-disable-multibyte) ;; everything is binary
(erase-buffer) (erase-buffer)
(insert "\n") (insert "\n")
(let ((file (gnus-agent-lib-file "history"))) (let ((file (gnus-agent-lib-file "history")))
@ -1525,8 +1514,7 @@ downloaded into the agent."
(setq selected-sets (nreverse selected-sets)) (setq selected-sets (nreverse selected-sets))
(gnus-make-directory dir) (gnus-make-directory dir)
(gnus-message 7 "Fetching articles for %s..." (gnus-message 7 "Fetching articles for %s..." group)
(gnus-agent-decoded-group-name group))
(unwind-protect (unwind-protect
(while (setq articles (pop selected-sets)) (while (setq articles (pop selected-sets))
@ -1537,8 +1525,7 @@ downloaded into the agent."
(let (article) (let (article)
(while (setq article (pop articles)) (while (setq article (pop articles))
(gnus-message 10 "Fetching article %s for %s..." (gnus-message 10 "Fetching article %s for %s..."
article article group)
(gnus-agent-decoded-group-name group))
(when (or (when (or
(gnus-backlog-request-article group article (gnus-backlog-request-article group article
nntp-server-buffer) nntp-server-buffer)
@ -1875,8 +1862,7 @@ article numbers will be returned."
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(if articles (if articles
(progn (progn
(gnus-message 8 "Fetching headers for %s..." (gnus-message 8 "Fetching headers for %s..." group)
(gnus-agent-decoded-group-name group))
;; Fetch them. ;; Fetch them.
(gnus-make-directory (nnheader-translate-file-chars (gnus-make-directory (nnheader-translate-file-chars
@ -3058,8 +3044,7 @@ FORCE is equivalent to setting the expiration predicates to true."
;; provided a non-nil active ;; provided a non-nil active
(let ((dir (gnus-agent-group-pathname group)) (let ((dir (gnus-agent-group-pathname group))
(file-name-coding-system nnmail-pathname-coding-system) (file-name-coding-system nnmail-pathname-coding-system))
(decoded (gnus-agent-decoded-group-name group)))
(gnus-agent-with-refreshed-group (gnus-agent-with-refreshed-group
group group
(when (boundp 'gnus-agent-expire-current-dirs) (when (boundp 'gnus-agent-expire-current-dirs)
@ -3068,8 +3053,8 @@ FORCE is equivalent to setting the expiration predicates to true."
(if (and (not force) (if (and (not force)
(eq 'DISABLE (gnus-agent-find-parameter group (eq 'DISABLE (gnus-agent-find-parameter group
'agent-enable-expiration))) 'agent-enable-expiration)))
(gnus-message 5 "Expiry skipping over %s" decoded) (gnus-message 5 "Expiry skipping over %s" group)
(gnus-message 5 "Expiring articles in %s" decoded) (gnus-message 5 "Expiring articles in %s" group)
(gnus-agent-load-alist group) (gnus-agent-load-alist group)
(let* ((bytes-freed 0) (let* ((bytes-freed 0)
(size-files-deleted 0.0) (size-files-deleted 0.0)
@ -3293,7 +3278,7 @@ line." (point) nov-file)))
(keep (keep
(gnus-agent-message 10 (gnus-agent-message 10
"gnus-agent-expire: %s:%d: Kept %s article%s." "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 (when fetch-date
(unless (file-exists-p (unless (file-exists-p
(concat dir (number-to-string (concat dir (number-to-string
@ -3301,7 +3286,7 @@ line." (point) nov-file)))
(setf (nth 1 entry) nil) (setf (nth 1 entry) nil)
(gnus-agent-message 3 "gnus-agent-expire cleared \ (gnus-agent-message 3 "gnus-agent-expire cleared \
download flag on %s:%d as the cached article file is missing." download flag on %s:%d as the cached article file is missing."
decoded (caar dlist))) group (caar dlist)))
(unless marker (unless marker
(gnus-message 1 "gnus-agent-expire detected a \ (gnus-message 1 "gnus-agent-expire detected a \
missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
@ -3379,12 +3364,12 @@ article alist" type) actions))
(when actions (when actions
(gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
decoded article-number group article-number
(mapconcat #'identity actions ", "))))) (mapconcat #'identity actions ", ")))))
(t (t
(gnus-agent-message (gnus-agent-message
10 "gnus-agent-expire: %s:%d: Article kept as \ 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 (gnus-agent-append-to-list
tail-alist (cons article-number fetch-date))) tail-alist (cons article-number fetch-date)))
) )
@ -3835,7 +3820,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
(sit-for 1) (sit-for 1)
t))))) t)))))
(when group (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 (let* ((gnus-command-method (or gnus-command-method
(gnus-find-method-for-group group))) (gnus-find-method-for-group group)))
(file (gnus-agent-article-name ".overview" group)) (file (gnus-agent-article-name ".overview" group))
@ -3912,8 +3897,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
(> (car downloaded) (car nov-arts)))) (> (car downloaded) (car nov-arts))))
;; This entry is missing from the overview file ;; This entry is missing from the overview file
(gnus-message 3 "Regenerating NOV %s %d..." (gnus-message 3 "Regenerating NOV %s %d..."
(gnus-agent-decoded-group-name group) group (car downloaded))
(car downloaded))
(let ((file (concat dir (number-to-string (car downloaded))))) (let ((file (concat dir (number-to-string (car downloaded)))))
(mm-with-unibyte-buffer (mm-with-unibyte-buffer
(nnheader-insert-file-contents file) (nnheader-insert-file-contents file)

4
lisp/gnus/gnus-art.el
View file

@ -4506,9 +4506,7 @@ commands:
(defun gnus-article-setup-buffer () (defun gnus-article-setup-buffer ()
"Initialize the article buffer." "Initialize the article buffer."
(let* ((name (if gnus-single-article-buffer "*Article*" (let* ((name (if gnus-single-article-buffer "*Article*"
(concat "*Article " (concat "*Article " gnus-newsgroup-name "*")))
(gnus-group-decoded-name gnus-newsgroup-name)
"*")))
(original (original
(progn (string-match "\\*Article" name) (progn (string-match "\\*Article" name)
(concat " *Original Article" (concat " *Original Article"

41
lisp/gnus/gnus-cache.el
View file

@ -430,41 +430,7 @@ Returns the list of articles removed."
(and unread (memq 'unread class)) (and unread (memq 'unread class))
(and (not unread) (not ticked) (not dormant) (memq 'read 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) (defun gnus-cache-file-name (group article)
(setq group (gnus-cache-decoded-group-name group))
(expand-file-name (expand-file-name
(if (stringp article) article (int-to-string article)) (if (stringp article) article (int-to-string article))
(file-name-as-directory (file-name-as-directory
@ -733,12 +699,7 @@ If LOW, update the lower bound instead."
(push (pop files) alphs))) (push (pop files) alphs)))
;; If we have nums, then this is probably a valid group. ;; If we have nums, then this is probably a valid group.
(when (setq nums (sort nums '<)) (when (setq nums (sort nums '<))
;; Use non-decoded group name. (puthash group
;; 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)
(cons (car nums) (car (last nums))) (cons (car nums) (car (last nums)))
gnus-cache-active-hashtb)) gnus-cache-active-hashtb))
;; Go through all the other files. ;; Go through all the other files.

5
lisp/gnus/gnus-cus.el
View file

@ -396,7 +396,7 @@ category."))
:tag "topic parameters" :tag "topic parameters"
"(gnus)Topic Parameters")) "(gnus)Topic Parameters"))
(widget-insert " for <") (widget-insert " for <")
(widget-insert (gnus-group-decoded-name (or group topic))) (widget-insert (or group topic))
(widget-insert "> and press ") (widget-insert "> and press ")
(widget-create 'push-button (widget-create 'push-button
:tag "done" :tag "done"
@ -845,8 +845,7 @@ When called interactively, FILE defaults to the current score file.
This can be changed using the `\\[gnus-score-change-score-file]' command." This can be changed using the `\\[gnus-score-change-score-file]' command."
(interactive (list gnus-current-score-file)) (interactive (list gnus-current-score-file))
(unless file (unless file
(error "No score file for %s" (error "No score file for %s" gnus-newsgroup-name))
(gnus-group-decoded-name gnus-newsgroup-name)))
(let ((scores (gnus-score-load file)) (let ((scores (gnus-score-load file))
(types (mapcar (lambda (entry) (types (mapcar (lambda (entry)
`(group :format "%v%h\n" `(group :format "%v%h\n"

209
lisp/gnus/gnus-group.el
View file

@ -479,7 +479,6 @@ simple manner."
(defvar gnus-tmp-news-method) (defvar gnus-tmp-news-method)
(defvar gnus-tmp-colon) (defvar gnus-tmp-colon)
(defvar gnus-tmp-news-server) (defvar gnus-tmp-news-server)
(defvar gnus-tmp-decoded-group)
(defvar gnus-tmp-header) (defvar gnus-tmp-header)
(defvar gnus-tmp-process-marked) (defvar gnus-tmp-process-marked)
(defvar gnus-tmp-summary-live) (defvar gnus-tmp-summary-live)
@ -518,14 +517,9 @@ simple manner."
(?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
(?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
(?g (if (boundp 'gnus-tmp-decoded-group) (?g gnus-tmp-group ?s)
gnus-tmp-decoded-group
gnus-tmp-group)
?s)
(?G gnus-tmp-qualified-group ?s) (?G gnus-tmp-qualified-group ?s)
(?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group) (?c (gnus-short-group-name gnus-tmp-group)
gnus-tmp-decoded-group
gnus-tmp-group))
?s) ?s)
(?C gnus-tmp-comment ?s) (?C gnus-tmp-comment ?s)
(?D gnus-tmp-newsgroup-description ?s) (?D gnus-tmp-newsgroup-description ?s)
@ -1398,8 +1392,7 @@ if it is a string, only list groups matching REGEXP."
((functionp regexp) (funcall regexp group)))) ((functionp regexp) (funcall regexp group))))
(add-text-properties (add-text-properties
(point) (prog1 (1+ (point)) (point) (prog1 (1+ (point))
(insert " " mark " *: " (insert " " mark " *: " group
(gnus-group-decoded-name group)
"\n")) "\n"))
(list 'gnus-group group (list 'gnus-group group
'gnus-unread t 'gnus-unread t
@ -1508,8 +1501,6 @@ if it is a string, only list groups matching REGEXP."
"Insert a group line in the group buffer." "Insert a group line in the group buffer."
(let* ((gnus-tmp-method (let* ((gnus-tmp-method
(gnus-server-get-method gnus-tmp-group 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-active (gnus-active gnus-tmp-group))
(gnus-tmp-number-total (gnus-tmp-number-total
(if gnus-tmp-active (if gnus-tmp-active
@ -1528,16 +1519,13 @@ if it is a string, only list groups matching REGEXP."
((= gnus-tmp-level gnus-level-zombie) ?Z) ((= gnus-tmp-level gnus-level-zombie) ?Z)
(t ?K))) (t ?K)))
(gnus-tmp-qualified-group (gnus-tmp-qualified-group
(gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) (gnus-group-real-name gnus-tmp-group))
group-name-charset))
(gnus-tmp-comment (gnus-tmp-comment
(or (gnus-group-get-parameter gnus-tmp-group 'comment t) (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
gnus-tmp-group)) gnus-tmp-group))
(gnus-tmp-newsgroup-description (gnus-tmp-newsgroup-description
(if gnus-description-hashtb (if gnus-description-hashtb
(or (gnus-group-name-decode (or (gethash gnus-tmp-group gnus-description-hashtb) "")
(gethash gnus-tmp-group gnus-description-hashtb)
group-name-charset) "")
"")) ""))
(gnus-tmp-moderated (gnus-tmp-moderated
(if (and gnus-moderated-hashtb (if (and gnus-moderated-hashtb
@ -1574,9 +1562,7 @@ if it is a string, only list groups matching REGEXP."
(point) (point)
(prog1 (1+ (point)) (prog1 (1+ (point))
;; Insert the text. ;; Insert the text.
(let ((gnus-tmp-decoded-group (gnus-group-name-decode (eval gnus-group-line-format-spec))
gnus-tmp-group group-name-charset)))
(eval gnus-group-line-format-spec)))
`(gnus-group ,gnus-tmp-group `(gnus-group ,gnus-tmp-group
gnus-unread ,(if (numberp number) gnus-unread ,(if (numberp number)
(string-to-number gnus-tmp-number-of-unread) (string-to-number gnus-tmp-number-of-unread)
@ -2117,9 +2103,7 @@ be permanent."
(defun gnus-group-name-at-point () (defun gnus-group-name-at-point ()
"Return a group name from around point if it exists, or nil." "Return a group name from around point if it exists, or nil."
(if (derived-mode-p 'gnus-group-mode) (if (derived-mode-p 'gnus-group-mode)
(let ((group (gnus-group-group-name))) (gnus-group-group-name)
(when group
(gnus-group-decoded-name group)))
;; FIXME: Use rx. ;; FIXME: Use rx.
(let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\ (let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\
\\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\ \\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\
@ -2160,41 +2144,25 @@ be permanent."
require-match initial-input hist require-match initial-input hist
def) def)
"Read a group name with completion. "Read a group name with completion.
Non-ASCII group names are allowed. The arguments are the same as The arguments are the same as `completing-read' except that
`completing-read' except that COLLECTION and HIST default to COLLECTION and HIST default to `gnus-active-hashtb' and
`gnus-active-hashtb' and `gnus-group-history' respectively if `gnus-group-history' respectively if they are omitted. Can
they are omitted. Can handle COLLECTION as a list, hash table, handle COLLECTION as a list, hash table, or vector."
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)) (or collection (setq collection gnus-active-hashtb))
(let* ((choices (let* ((choices
(mapcar
(lambda (g)
(if (string-match "[^\000-\177]" g)
(gnus-group-decoded-name g)
g))
(cond ((listp collection) (cond ((listp collection)
collection) collection)
((vectorp collection) ((vectorp collection)
(mapatoms #'symbol-name collection)) (mapatoms #'symbol-name collection))
((hash-table-p collection) ((hash-table-p collection)
(hash-table-keys collection))))) (hash-table-keys collection))))
(group (group
(gnus-completing-read (or prompt "Group") (reverse choices) (gnus-completing-read (or prompt "Group") (reverse choices)
require-match initial-input require-match initial-input
(or hist 'gnus-group-history) (or hist 'gnus-group-history)
def))) 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))) (replace-regexp-in-string "\n" "" group)))
;;;###autoload ;;;###autoload
@ -2755,13 +2723,13 @@ The user will be prompted for GROUP."
(interactive (list (gnus-group-completing-read))) (interactive (list (gnus-group-completing-read)))
(gnus-group-make-group (gnus-group-real-name group) (gnus-group-make-group (gnus-group-real-name group)
(gnus-group-server 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. "Add a new newsgroup.
The user will be prompted for a NAME, for a select METHOD, and an 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 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 If the backend supports it, the group will also be created on the
server." server."
@ -2772,10 +2740,6 @@ server."
(when (stringp method) (when (stringp method)
(setq method (or (gnus-server-to-method method) 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 (let* ((meth (gnus-method-simplify
(when (and method (when (and method
(not (gnus-server-equal method gnus-select-method))) (not (gnus-server-equal method gnus-select-method)))
@ -2784,7 +2748,7 @@ server."
(nname (if method (gnus-group-prefixed-name name meth) name)) (nname (if method (gnus-group-prefixed-name name meth) name))
backend info) backend info)
(when (gnus-group-entry nname) (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. ;; Subscribe to the new group.
(gnus-group-change-level (gnus-group-change-level
(setq info (list t nname gnus-level-default-subscribed nil nil meth)) (setq info (list t nname gnus-level-default-subscribed nil nil meth))
@ -2860,20 +2824,19 @@ be removed from the server, even when it's empty."
(unless (gnus-check-backend-function 'request-delete-group group) (unless (gnus-check-backend-function 'request-delete-group group)
(error "This back end does not support group deletion")) (error "This back end does not support group deletion"))
(prog1 (prog1
(let ((group-decoded (gnus-group-decoded-name group))) (when (or no-prompt
(when (or no-prompt (gnus-yes-or-no-p
(gnus-yes-or-no-p (format
(format "Do you really want to delete %s%s? "
"Do you really want to delete %s%s? " group (if force " and all its contents" ""))))
group-decoded (if force " and all its contents" "")))) (gnus-message 6 "Deleting group %s..." group)
(gnus-message 6 "Deleting group %s..." group-decoded) (if (not (gnus-request-delete-group group force))
(if (not (gnus-request-delete-group group force)) (gnus-error 3 "Couldn't delete group %s" group)
(gnus-error 3 "Couldn't delete group %s" group-decoded) (gnus-message 6 "Deleting group %s...done" group)
(gnus-message 6 "Deleting group %s...done" group-decoded) (gnus-group-goto-group group)
(gnus-group-goto-group group) (gnus-group-kill-group 1 t)
(gnus-group-kill-group 1 t) (gnus-set-active group nil)
(gnus-set-active group nil) t))
t)))
(gnus-group-position-point))) (gnus-group-position-point)))
(defun gnus-group-rename-group (group new-name) (defun gnus-group-rename-group (group new-name)
@ -2887,13 +2850,9 @@ and NEW-NAME will be prompted for."
(error "This back end does not support renaming groups")) (error "This back end does not support renaming groups"))
(setq new-name (gnus-read-group (setq new-name (gnus-read-group
"Rename group to: " "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))) method (gnus-info-method (gnus-get-info group)))
(list group (encode-coding-string (list group (gnus-group-prefixed-name new-name method))))
new-name
(gnus-group-name-charset
method
(gnus-group-prefixed-name new-name method))))))
(unless (gnus-check-backend-function 'request-rename-group group) (unless (gnus-check-backend-function 'request-rename-group group)
(error "This back end does not support renaming groups")) (error "This back end does not support renaming groups"))
@ -2912,34 +2871,30 @@ and NEW-NAME will be prompted for."
(gnus-group-real-name new-name) (gnus-group-real-name new-name)
(gnus-info-method (gnus-get-info group))))) (gnus-info-method (gnus-get-info group)))))
(let ((decoded-group (gnus-group-decoded-name group)) (when (gnus-active new-name)
(decoded-new-name (gnus-group-decoded-name new-name))) (error "The group %s already exists" new-name))
(when (gnus-active new-name)
(error "The group %s already exists" decoded-new-name))
(gnus-message 6 "Renaming group %s to %s..." (gnus-message 6 "Renaming group %s to %s..." group new-name)
decoded-group decoded-new-name) (prog1
(prog1 (if (progn
(if (progn (gnus-group-goto-group group)
(gnus-group-goto-group group) (not (when (< (gnus-group-group-level) gnus-level-zombie)
(not (when (< (gnus-group-group-level) gnus-level-zombie) (gnus-request-rename-group group new-name))))
(gnus-request-rename-group group new-name)))) (gnus-error 3 "Couldn't rename group %s to %s"
(gnus-error 3 "Couldn't rename group %s to %s" group new-name)
decoded-group decoded-new-name) ;; We rename the group internally by killing it...
;; We rename the group internally by killing it... (gnus-group-kill-group)
(gnus-group-kill-group) ;; ... changing its name ...
;; ... changing its name ... (setcar (cdar gnus-list-of-killed-groups) new-name)
(setcar (cdar gnus-list-of-killed-groups) new-name) ;; ... and then yanking it. Magic!
;; ... and then yanking it. Magic! (gnus-group-yank-group)
(gnus-group-yank-group) (gnus-set-active new-name (gnus-active group))
(gnus-set-active new-name (gnus-active group)) (gnus-message 6 "Renaming group %s to %s...done" group new-name)
(gnus-message 6 "Renaming group %s to %s...done" new-name)
decoded-group decoded-new-name) (setq gnus-killed-list (delete group gnus-killed-list))
new-name) (gnus-set-active group nil)
(setq gnus-killed-list (delete group gnus-killed-list)) (gnus-dribble-touch)
(gnus-set-active group nil) (gnus-group-position-point)))
(gnus-dribble-touch)
(gnus-group-position-point))))
(defun gnus-group-edit-group (group &optional part) (defun gnus-group-edit-group (group &optional part)
"Edit the group on the current line." "Edit the group on the current line."
@ -2966,7 +2921,7 @@ and NEW-NAME will be prompted for."
((eq part 'method) "select method") ((eq part 'method) "select method")
((eq part 'params) "group parameters") ((eq part 'params) "group parameters")
(t "group info")) (t "group info"))
(gnus-group-decoded-name group)) group)
`(lambda (form) `(lambda (form)
(gnus-group-edit-group-done ',part ,group form))) (gnus-group-edit-group-done ',part ,group form)))
(local-set-key (local-set-key
@ -3105,8 +3060,7 @@ If called with a prefix argument, ask for the file type."
(coding (gnus-group-name-charset method name))) (coding (gnus-group-name-charset method name)))
(setcar (cdr method) (encode-coding-string file coding)) (setcar (cdr method) (encode-coding-string file coding))
(gnus-group-make-group (gnus-group-make-group
(encode-coding-string (gnus-group-real-name name) coding) (gnus-group-real-name name) method nil nil)))
method nil nil t)))
(defvar nnweb-type-definition) (defvar nnweb-type-definition)
(defvar gnus-group-web-type-history nil) (defvar gnus-group-web-type-history nil)
@ -3611,7 +3565,7 @@ up is returned."
"Do you really want to mark all articles in %s as read? " "Do you really want to mark all articles in %s as read? "
"Mark all unread articles in %s as read? ") "Mark all unread articles in %s as read? ")
(if (= (length groups) 1) (if (= (length groups) 1)
(gnus-group-decoded-name (car groups)) (car groups)
(format "these %d groups" (length groups))))))) (format "these %d groups" (length groups)))))))
n n
(while (setq group (pop groups)) (while (setq group (pop groups))
@ -3696,8 +3650,7 @@ Uses the process/prefix convention."
(defun gnus-group-expire-articles-1 (group) (defun gnus-group-expire-articles-1 (group)
(when (gnus-check-backend-function 'request-expire-articles group) (when (gnus-check-backend-function 'request-expire-articles group)
(gnus-message 6 "Expiring articles in %s..." (gnus-message 6 "Expiring articles in %s..." group)
(gnus-group-decoded-name group))
(let* ((info (gnus-get-info group)) (let* ((info (gnus-get-info group))
(expirable (if (gnus-group-total-expirable-p group) (expirable (if (gnus-group-total-expirable-p group)
(cons nil (gnus-list-of-read-articles group)) (cons nil (gnus-list-of-read-articles group))
@ -3724,8 +3677,7 @@ Uses the process/prefix convention."
;; Just expire using the normal expiry values. ;; Just expire using the normal expiry values.
(gnus-request-expire-articles articles-to-expire group)))) (gnus-request-expire-articles articles-to-expire group))))
(gnus-close-group group)) (gnus-close-group group))
(gnus-message 6 "Expiring articles in %s...done" (gnus-message 6 "Expiring articles in %s...done" group)
(gnus-group-decoded-name group))
;; Return the list of un-expired articles. ;; Return the list of un-expired articles.
(cdr expirable)))) (cdr expirable))))
@ -3762,7 +3714,7 @@ Uses the process/prefix convention."
(dolist (group (gnus-group-process-prefix n)) (dolist (group (gnus-group-process-prefix n))
(gnus-group-remove-mark group) (gnus-group-remove-mark group)
(gnus-message 6 "Changed level of %s from %d to %d" (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) (or (gnus-group-group-level) gnus-level-killed)
level) level)
(gnus-group-change-level (gnus-group-change-level
@ -3909,7 +3861,7 @@ of groups killed."
;; `gnus-newsrc-hashtb', this check will always return nil. ;; `gnus-newsrc-hashtb', this check will always return nil.
(when (numberp (gnus-group-unread group)) (when (numberp (gnus-group-unread group))
(gnus-request-update-group-status group 'unsubscribe)) (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 ;; If there are lots and lots of groups to be killed, we use
;; this thing instead. ;; this thing instead.
(dolist (group (nreverse groups)) (dolist (group (nreverse groups))
@ -4047,7 +3999,7 @@ entail asking the server for the groups."
(add-text-properties (add-text-properties
(point) (prog1 (1+ (point)) (point) (prog1 (1+ (point))
(insert " *: " (insert " *: "
(gnus-group-decoded-name group) group
"\n")) "\n"))
(list 'gnus-group group (list 'gnus-group group
'gnus-unread t 'gnus-unread t
@ -4494,9 +4446,9 @@ and the second element is the address."
(prin1-to-string (car method))) (prin1-to-string (car method)))
(and (consp method) (and (consp method)
(nth 1 (gnus-info-method info))) (nth 1 (gnus-info-method info)))
nil t) nil)
;; It's a native group. ;; 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") (gnus-message 6 "Note: New group created")
(setq entry (setq entry
(gnus-group-entry (gnus-group-prefixed-name (gnus-group-entry (gnus-group-prefixed-name
@ -4685,7 +4637,7 @@ This command may read the active file."
(while (setq point (text-property-not-all (point) (point-max) (while (setq point (text-property-not-all (point) (point-max)
'gnus-group nil)) 'gnus-group nil))
(goto-char point) (goto-char point)
(push (symbol-name (get-text-property point 'gnus-group)) groups) (push (get-text-property point 'gnus-group) groups)
(forward-char 1)) (forward-char 1))
groups)) groups))
@ -4776,21 +4728,20 @@ Note: currently only implemented in nnml."
(error "No group to compact")) (error "No group to compact"))
(unless (gnus-check-backend-function 'request-compact-group group) (unless (gnus-check-backend-function 'request-compact-group group)
(error "This back end does not support group compaction")) (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)" Compacting group %s... (this may take a long time)"
group-decoded) group)
(prog1 (prog1
(if (not (gnus-request-compact-group group)) (if (not (gnus-request-compact-group group))
(gnus-error 3 "Couldn't compact group %s" group-decoded) (gnus-error 3 "Couldn't compact group %s" group)
(gnus-message 6 "Compacting group %s...done" group-decoded) (gnus-message 6 "Compacting group %s...done" group)
t) t)
;; Invalidate the "original article" buffer which might be out of date. ;; Invalidate the "original article" buffer which might be out of date.
;; #### NOTE: Yes, this might be a bit rude, but since compaction ;; #### NOTE: Yes, this might be a bit rude, but since compaction
;; #### will not happen very often, I think this is acceptable. ;; #### will not happen very often, I think this is acceptable.
(gnus-kill-buffer gnus-original-article-buffer) (gnus-kill-buffer gnus-original-article-buffer)
;; Update the group line to reflect new information (art number etc). ;; Update the group line to reflect new information (art number etc).
(gnus-group-update-group-line)))) (gnus-group-update-group-line)))
(provide 'gnus-group) (provide 'gnus-group)

3
lisp/gnus/gnus-msg.el
View file

@ -391,7 +391,7 @@ only affect the Gcc copy, but not the original message."
(defun gnus-inews-make-draft (articles) (defun gnus-inews-make-draft (articles)
`(lambda () `(lambda ()
(gnus-inews-make-draft-meta-information (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-number "nnir" nil nil 'macro)
(autoload 'nnir-article-group "nnir" nil nil 'macro) (autoload 'nnir-article-group "nnir" nil nil 'macro)
@ -1680,7 +1680,6 @@ this is a reply."
(defun gnus-inews-insert-gcc (&optional group) (defun gnus-inews-insert-gcc (&optional group)
"Insert the Gcc to say where the article is to be archived." "Insert the Gcc to say where the article is to be archived."
(let* ((group (or group gnus-newsgroup-name)) (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)) (var (or gnus-outgoing-message-group gnus-message-archive-group))
(gcc-self-val (gcc-self-val
(and group (not (gnus-virtual-group-p group)) (and group (not (gnus-virtual-group-p group))

45
lisp/gnus/gnus-srvr.el
View file

@ -784,11 +784,13 @@ claim them."
(while (not (eobp)) (while (not (eobp))
(ignore-errors (ignore-errors
(push (cons (push (cons
(buffer-substring (decode-coding-string
(point) (buffer-substring
(progn (point)
(skip-chars-forward "^ \t") (progn
(point))) (skip-chars-forward "^ \t")
(point)))
'utf-8-emacs)
(let ((last (read cur))) (let ((last (read cur)))
(cons (read cur) last))) (cons (read cur) last)))
groups)) groups))
@ -796,18 +798,20 @@ claim them."
(while (not (eobp)) (while (not (eobp))
(ignore-errors (ignore-errors
(push (cons (push (cons
(if (eq (char-after) ?\") (decode-coding-string
(read cur) (if (eq (char-after) ?\")
(let ((p (point)) (name "")) (read cur)
(skip-chars-forward "^ \t\\\\") (let ((p (point)) (name ""))
(setq name (buffer-substring p (point))) (skip-chars-forward "^ \t\\\\")
(while (eq (char-after) ?\\) (setq name (buffer-substring p (point)))
(setq p (1+ (point))) (while (eq (char-after) ?\\)
(forward-char 2) (setq p (1+ (point)))
(skip-chars-forward "^ \t\\\\") (forward-char 2)
(setq name (concat name (buffer-substring (skip-chars-forward "^ \t\\\\")
p (point))))) (setq name (concat name (buffer-substring
name)) p (point)))))
name))
'utf-8-emacs)
(let ((last (read cur))) (let ((last (read cur)))
(cons (read cur) last))) (cons (read cur) last)))
groups)) groups))
@ -859,12 +863,7 @@ claim them."
((= level gnus-level-zombie) ?Z) ((= level gnus-level-zombie) ?Z)
(t ?K))) (t ?K)))
(max 0 (- (1+ (cddr group)) (cadr group))) (max 0 (- (1+ (cddr group)) (cadr group)))
;; Don't decode if name is ASCII name)))
(if (eq (detect-coding-string name t) 'undecided)
name
(decode-coding-string
name
(inline (gnus-group-name-charset method name)))))))
(list 'gnus-group name) (list 'gnus-group name)
))) )))
(switch-to-buffer (current-buffer))) (switch-to-buffer (current-buffer)))

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

@ -35,6 +35,7 @@
(autoload 'gnus-agent-read-servers-validate "gnus-agent") (autoload 'gnus-agent-read-servers-validate "gnus-agent")
(autoload 'gnus-agent-save-local "gnus-agent") (autoload 'gnus-agent-save-local "gnus-agent")
(autoload 'gnus-agent-possibly-alter-active "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)) (eval-when-compile (require 'cl-lib))
@ -1828,17 +1829,22 @@ The info element is shared with the same element of
(if (setq rest (member method methods)) (if (setq rest (member method methods))
(gnus-info-set-method info (car rest)) (gnus-info-set-method info (car rest))
(push method methods))) (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. ;; Check for duplicates.
(if (gethash (car info) gnus-newsrc-hashtb) (if (gethash gname gnus-newsrc-hashtb)
;; Remove this entry from the alist. ;; Remove this entry from the alist.
(setcdr alist (cddr alist)) (setcdr alist (cddr alist))
(puthash (puthash
(car info) gname
;; Preserve number of unread articles in groups. ;; Preserve number of unread articles in groups.
(list (and ohashtb (car (gethash (car info) ohashtb))) (list (and ohashtb (car (gethash gname ohashtb)))
info) info)
gnus-newsrc-hashtb) gnus-newsrc-hashtb)
(push (car info) gnus-group-list)) (push gname gnus-group-list))
(setq alist (cdr alist))) (setq alist (cdr alist)))
(setq gnus-group-list (nreverse gnus-group-list)) (setq gnus-group-list (nreverse gnus-group-list))
;; Make the same select-methods in `gnus-server-alist' identical ;; Make the same select-methods in `gnus-server-alist' identical
@ -2144,9 +2150,7 @@ The info element is shared with the same element of
(cond ((numberp group) (cond ((numberp group)
(number-to-string group)) (number-to-string group))
((symbolp group) ((symbolp group)
(encode-coding-string (symbol-name group))
(symbol-name group)
'latin-1))
((stringp group) ((stringp group)
group))))) group)))))
(numberp (setq max (read cur))) (numberp (setq max (read cur)))
@ -2155,7 +2159,11 @@ The info element is shared with the same element of
(skip-chars-forward " \t") (skip-chars-forward " \t")
(memq (char-after) (memq (char-after)
'(?= ?x ?j))))) '(?= ?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 ;; If group is moderated, stick it in the
;; moderation cache. ;; moderation cache.
(when (eq (char-after) ?m) (when (eq (char-after) ?m)
@ -2394,6 +2402,17 @@ If FORCE is non-nil, the .newsrc file is read."
(when gnus-newsrc-assoc (when gnus-newsrc-assoc
(setq gnus-newsrc-alist gnus-newsrc-assoc)))) (setq gnus-newsrc-alist gnus-newsrc-assoc))))
(gnus-make-hashtable-from-newsrc-alist) (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) (when (file-newer-than-file-p file ding-file)
;; Old format quick file ;; Old format quick file
(gnus-message 5 "Reading %s..." file) (gnus-message 5 "Reading %s..." file)
@ -2492,7 +2511,9 @@ If FORCE is non-nil, the .newsrc file is read."
(read buf)) (read buf))
group (if (numberp group) group (if (numberp group)
(number-to-string group) (number-to-string group)
(symbol-name group))) ;; newsrc files are written as 'raw-text.
(decode-coding-string
(symbol-name group) 'raw-text)))
(widen) (widen)
(cond (cond
;; It's possible that "group" is actually an options line. ;; It's possible that "group" is actually an options line.
@ -2911,10 +2932,6 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
(setq default-directory (file-name-directory buffer-file-name)) (setq default-directory (file-name-directory buffer-file-name))
(buffer-disable-undo) (buffer-disable-undo)
(erase-buffer) (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. ;; Write options.
(when gnus-newsrc-options (when gnus-newsrc-options
(insert gnus-newsrc-options)) (insert gnus-newsrc-options))

113
lisp/gnus/gnus-sum.el
View file

@ -3500,8 +3500,7 @@ value of GROUP, and puts the buffer in `gnus-summary-mode'.
Returns non-nil if the setup was successful." Returns non-nil if the setup was successful."
(let ((buffer (gnus-summary-buffer-name group)) (let ((buffer (gnus-summary-buffer-name group))
(dead-name (concat "*Dead Summary " (dead-name (concat "*Dead Summary " group "*")))
(gnus-group-decoded-name group) "*")))
;; If a dead summary buffer exists, we kill it. ;; If a dead summary buffer exists, we kill it.
(gnus-kill-buffer dead-name) (gnus-kill-buffer dead-name)
(if (get-buffer buffer) (if (get-buffer buffer)
@ -3984,8 +3983,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; (when (and (not (gnus-group-native-p group)) ;; (when (and (not (gnus-group-native-p group))
;; (not (gethash group gnus-newsrc-hashtb))) ;; (not (gethash group gnus-newsrc-hashtb)))
;; (error "Dead non-native groups can't be entered")) ;; (error "Dead non-native groups can't be entered"))
(gnus-message 7 "Retrieving newsgroup: %s..." (gnus-message 7 "Retrieving newsgroup: %s..." group)
(gnus-group-decoded-name group))
(let* ((new-group (gnus-summary-setup-buffer group)) (let* ((new-group (gnus-summary-setup-buffer group))
(quit-config (gnus-group-quit-config group)) (quit-config (gnus-group-quit-config group))
(did-select (and new-group (gnus-select-newsgroup (did-select (and new-group (gnus-select-newsgroup
@ -4016,8 +4014,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(gnus-group-next-unread-group 1)) (gnus-group-next-unread-group 1))
(gnus-handle-ephemeral-exit quit-config))) (gnus-handle-ephemeral-exit quit-config)))
(if (null (gnus-list-of-unread-articles group)) (if (null (gnus-list-of-unread-articles group))
(gnus-message 3 "Group %s contains no messages" (gnus-message 3 "Group %s contains no messages" group)
(gnus-group-decoded-name group))
(gnus-message 3 "Can't select group")) (gnus-message 3 "Can't select group"))
nil) nil)
;; The user did a `C-g' while prompting for number of articles, ;; The user did a `C-g' while prompting for number of articles,
@ -5618,25 +5615,24 @@ or a straight list of headers."
(defun gnus-fetch-headers (articles &optional limit force-new dependencies) (defun gnus-fetch-headers (articles &optional limit force-new dependencies)
"Fetch headers of ARTICLES." "Fetch headers of ARTICLES."
(let ((name (gnus-group-decoded-name gnus-newsgroup-name))) (gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name)
(gnus-message 7 "Fetching headers for %s..." name) (prog1
(prog1 (if (eq 'nov
(if (eq 'nov (setq gnus-headers-retrieved-by
(setq gnus-headers-retrieved-by (gnus-retrieve-headers
(gnus-retrieve-headers articles gnus-newsgroup-name
articles gnus-newsgroup-name (or limit
(or limit ;; We might want to fetch old headers, but
;; We might want to fetch old headers, but ;; not if there is only 1 article.
;; not if there is only 1 article. (and (or (and
(and (or (and (not (eq gnus-fetch-old-headers 'some))
(not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers)))
(not (numberp gnus-fetch-old-headers))) (> (length articles) 1))
(> (length articles) 1)) gnus-fetch-old-headers)))))
gnus-fetch-old-headers))))) (gnus-get-newsgroup-headers-xover
(gnus-get-newsgroup-headers-xover articles force-new dependencies gnus-newsgroup-name t)
articles force-new dependencies gnus-newsgroup-name t) (gnus-get-newsgroup-headers dependencies force-new))
(gnus-get-newsgroup-headers dependencies force-new)) (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
(gnus-message 7 "Fetching headers for %s...done" name))))
(defun gnus-select-newsgroup (group &optional read-all select-articles) (defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP. "Select newsgroup GROUP.
@ -5649,13 +5645,12 @@ If SELECT-ARTICLES, only select those articles from GROUP."
t t
gnus-summary-ignore-duplicates)) gnus-summary-ignore-duplicates))
(info (nth 1 entry)) (info (nth 1 entry))
charset articles fetched-articles cached) articles fetched-articles cached)
(unless (gnus-check-server (unless (gnus-check-server
(set (make-local-variable 'gnus-current-select-method) (set (make-local-variable 'gnus-current-select-method)
(gnus-find-method-for-group group))) (gnus-find-method-for-group group)))
(error "Couldn't open server")) (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... (or (and entry (not (eq (car entry) t))) ; Either it's active...
(gnus-activate-group group) ; Or we can activate it... (gnus-activate-group group) ; Or we can activate it...
@ -5663,16 +5658,12 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(when (derived-mode-p 'gnus-summary-mode) (when (derived-mode-p 'gnus-summary-mode)
(gnus-kill-buffer (current-buffer))) (gnus-kill-buffer (current-buffer)))
(error (error
"Couldn't activate group %s: %s" "Couldn't activate group %s: %s" group (gnus-status-message group))))
(decode-coding-string group charset)
(decode-coding-string (gnus-status-message group) charset))))
(unless (gnus-request-group group t nil info) (unless (gnus-request-group group t nil info)
(when (derived-mode-p 'gnus-summary-mode) (when (derived-mode-p 'gnus-summary-mode)
(gnus-kill-buffer (current-buffer))) (gnus-kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s" (error "Couldn't request group %s: %s" group (gnus-status-message group)))
(decode-coding-string group charset)
(decode-coding-string (gnus-status-message group) charset)))
(when (and gnus-agent (when (and gnus-agent
(gnus-active group)) (gnus-active group))
@ -5938,13 +5929,11 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(if only-read-p (if only-read-p
(format (format
"How many articles from %s (available %d, default %d): " "How many articles from %s (available %d, default %d): "
(gnus-group-real-name (gnus-group-real-name gnus-newsgroup-name)
(gnus-group-decoded-name gnus-newsgroup-name))
number default) number default)
(format (format
"How many articles from %s (%d default): " "How many articles from %s (%d default): "
(gnus-group-real-name (gnus-group-real-name gnus-newsgroup-name)
(gnus-group-decoded-name gnus-newsgroup-name))
default)) default))
nil nil
nil nil
@ -5956,8 +5945,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(read-string (read-string
(format "%s %s (%d scored, %d total): " (format "%s %s (%d scored, %d total): "
"How many articles from" "How many articles from"
(gnus-group-decoded-name (gnus-group-real-name gnus-newsgroup-name)
(gnus-group-real-name gnus-newsgroup-name))
scored number)))) scored number))))
(if (string-match "^[ \t]*$" input) (if (string-match "^[ \t]*$" input)
number input))) number input)))
@ -6199,8 +6187,7 @@ If WHERE is `summary', the summary mode line format will be used."
(intern (intern
(format "gnus-%s-mode-line-format-spec" where)))) (format "gnus-%s-mode-line-format-spec" where))))
(gnus-tmp-group-name (gnus-mode-string-quote (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-article-number (or gnus-current-article 0))
(gnus-tmp-unread gnus-newsgroup-unreads) (gnus-tmp-unread gnus-newsgroup-unreads)
(gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
@ -7921,11 +7908,11 @@ If BACKWARD, the previous article is selected instead of the next."
(not (gnus-ephemeral-group-p gnus-newsgroup-name))) (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
(format " (Type %s for %s [%s])" (format " (Type %s for %s [%s])"
(single-key-description cmd) (single-key-description cmd)
(gnus-group-decoded-name group) group
(gnus-group-unread group)) (gnus-group-unread group))
(format " (Type %s to exit %s)" (format " (Type %s to exit %s)"
(single-key-description cmd) (single-key-description cmd)
(gnus-group-decoded-name gnus-newsgroup-name))))) gnus-newsgroup-name))))
;; Confirm auto selection. ;; Confirm auto selection.
(setq key (car (setq keve (gnus-read-event-char prompt))) (setq key (car (setq keve (gnus-read-event-char prompt)))
ended t) ended t)
@ -10110,7 +10097,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(copy-buf (save-excursion (copy-buf (save-excursion
(nnheader-set-temp-buffer " *copy article*"))) (nnheader-set-temp-buffer " *copy article*")))
art-group to-method new-xref article to-groups art-group to-method new-xref article to-groups
articles-to-update-marks encoded) articles-to-update-marks)
(unless (assq action names) (unless (assq action names)
(error "Unknown action %s" action)) (error "Unknown action %s" action))
;; Read the newsgroup name. ;; Read the newsgroup name.
@ -10132,22 +10119,12 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(symbol-value (symbol-value
(intern (format "gnus-current-%s-group" action))) (intern (format "gnus-current-%s-group" action)))
articles prefix) articles prefix)
encoded to-newsgroup
to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
(set (intern (format "gnus-current-%s-group" action)) (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
(decode-coding-string
to-newsgroup
(gnus-group-name-charset to-method to-newsgroup))))
(unless to-method (unless to-method
(setq to-method (or select-method (setq to-method (or select-method
(gnus-server-to-method (gnus-server-to-method
(gnus-group-method to-newsgroup))))) (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... ;; Check the method we are to move this article to...
(unless (gnus-check-backend-function (unless (gnus-check-backend-function
'request-accept-article (car to-method)) 'request-accept-article (car to-method))
@ -10157,7 +10134,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(gnus-message 6 "%s to %s: %s..." (gnus-message 6 "%s to %s: %s..."
(caddr (assq action names)) (caddr (assq action names))
(or (car select-method) (or (car select-method)
(gnus-group-decoded-name to-newsgroup)) to-newsgroup)
articles) articles)
;; This `while' is not equivalent to a `dolist' (bug#33653#134). ;; This `while' is not equivalent to a `dolist' (bug#33653#134).
(while articles (while articles
@ -12469,27 +12446,23 @@ save those articles instead."
(t (t
(gnus-completing-read (gnus-completing-read
prom (nreverse split-name) nil nil 'gnus-group-history)))) prom (nreverse split-name) nil nil 'gnus-group-history))))
(to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
encoded)
(when to-newsgroup (when to-newsgroup
(if (or (string= to-newsgroup "") (if (or (string= to-newsgroup "")
(string= to-newsgroup prefix)) (string= to-newsgroup prefix))
(setq to-newsgroup default)) (setq to-newsgroup default))
(unless to-newsgroup (unless to-newsgroup
(user-error "No group name entered")) (error "No group name entered"))
(setq encoded (encode-coding-string (or (gnus-active to-newsgroup)
to-newsgroup (gnus-activate-group to-newsgroup nil nil to-method)
(gnus-group-name-charset to-method to-newsgroup)))
(or (gnus-active encoded)
(gnus-activate-group encoded nil nil to-method)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? " (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup)) to-newsgroup))
(or (and (gnus-request-create-group encoded to-method) (or (and (gnus-request-create-group to-newsgroup to-method)
(gnus-activate-group encoded nil nil to-method) (gnus-activate-group to-newsgroup nil nil to-method)
(gnus-subscribe-group encoded)) (gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup))) (error "Couldn't create group %s" to-newsgroup)))
(user-error "No such group: %s" to-newsgroup)) (error "No such group: %s" to-newsgroup))
encoded))) to-newsgroup)))
(defvar gnus-summary-save-parts-counter) (defvar gnus-summary-save-parts-counter)
(declare-function mm-uu-dissect "mm-uu" (&optional noheader mime-type)) (declare-function mm-uu-dissect "mm-uu" (&optional noheader mime-type))
@ -13156,7 +13129,7 @@ If ALL is a number, fetch this number of articles."
(read-string (read-string
(format (format
"How many articles from %s (%s %d): " "How many articles from %s (%s %d): "
(gnus-group-decoded-name gnus-newsgroup-name) gnus-newsgroup-name
(if initial "max" "default") (if initial "max" "default")
len) len)
nil nil nil nil

7
lisp/gnus/gnus-util.el
View file

@ -1173,16 +1173,9 @@ ARG is passed to the first function."
"Return non-nil if all ELEMENTS are non-nil." "Return non-nil if all ELEMENTS are non-nil."
(not (memq nil elements))) (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) (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)) (let ((coding-system-for-write nnmail-active-file-coding-system))
(with-temp-file file (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 (maphash
(lambda (group active) (lambda (group active)
(when active (when active

4
lisp/gnus/gnus.el
View file

@ -3444,11 +3444,9 @@ server is native)."
"Return the prefix of the current group name." "Return the prefix of the current group name."
(< 0 (length (gnus-group-real-prefix group)))) (< 0 (length (gnus-group-real-prefix group))))
(declare-function gnus-group-decoded-name "gnus-group" (string))
(defun gnus-summary-buffer-name (group) (defun gnus-summary-buffer-name (group)
"Return the summary buffer name of GROUP." "Return the summary buffer name of GROUP."
(concat "*Summary " (gnus-group-decoded-name group) "*")) (concat "*Summary " group "*"))
(defun gnus-group-method (group) (defun gnus-group-method (group)
"Return the server or method used for selecting GROUP. "Return the server or method used for selecting GROUP.

21
lisp/gnus/message.el
View file

@ -1894,7 +1894,6 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
(autoload 'gnus-delay-article "gnus-delay") (autoload 'gnus-delay-article "gnus-delay")
(autoload 'gnus-extract-address-components "gnus-util") (autoload 'gnus-extract-address-components "gnus-util")
(autoload 'gnus-find-method-for-group "gnus") (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-charset "gnus-group")
(autoload 'gnus-group-name-decode "gnus-group") (autoload 'gnus-group-name-decode "gnus-group")
(autoload 'gnus-groups-from-server "gnus") (autoload 'gnus-groups-from-server "gnus")
@ -5628,7 +5627,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
(concat (concat
msg-id (if msg-id " (") msg-id (if msg-id " (")
(if (car name) (if (car name)
(if (string-match "[^\000-\177]" (car name)) (if (string-match "[^[:ascii:]]" (car name))
;; Quote a string containing non-ASCII characters. ;; Quote a string containing non-ASCII characters.
;; It will make the RFC2047 encoder cause an error ;; It will make the RFC2047 encoder cause an error
;; if there are special characters. ;; if there are special characters.
@ -7285,12 +7284,11 @@ news, Source is the list of newsgroups is was posted to."
(let* ((group (message-fetch-field "newsgroups")) (let* ((group (message-fetch-field "newsgroups"))
(from (message-fetch-field "from")) (from (message-fetch-field "from"))
(prefix (prefix
(if group (or group
(gnus-group-decoded-name group) (or (and from (or
(or (and from (or (car (gnus-extract-address-components from))
(car (gnus-extract-address-components from)) (cadr (gnus-extract-address-components from))))
(cadr (gnus-extract-address-components from)))) "(nowhere)"))))
"(nowhere)"))))
(concat "[" (concat "["
(if message-forward-decoded-p (if message-forward-decoded-p
prefix prefix
@ -7304,10 +7302,9 @@ Source is the sender, and if the original message was news, Source is
the list of newsgroups is was posted to." the list of newsgroups is was posted to."
(let* ((group (message-fetch-field "newsgroups")) (let* ((group (message-fetch-field "newsgroups"))
(prefix (prefix
(if group (or group
(gnus-group-decoded-name group) (or (message-fetch-field "from")
(or (message-fetch-field "from") "(nowhere)"))))
"(nowhere)"))))
(concat "[" (concat "["
(if message-forward-decoded-p (if message-forward-decoded-p
prefix prefix

23
lisp/gnus/nnagent.el
View file

@ -117,18 +117,17 @@
(gnus-request-accept-article "nndraft:queue" nil t t)) (gnus-request-accept-article "nndraft:queue" nil t t))
(deffoo nnagent-request-set-mark (group action server) (deffoo nnagent-request-set-mark (group action server)
(mm-with-unibyte-buffer (insert "(gnus-agent-synchronize-group-flags \""
(insert "(gnus-agent-synchronize-group-flags \"" group
group "\" '")
"\" '") (gnus-pp action)
(gnus-pp action) (insert " \""
(insert " \"" (gnus-method-to-server gnus-command-method)
(gnus-method-to-server gnus-command-method) "\"")
"\"") (insert ")\n")
(insert ")\n") (let ((coding-system-for-write nnheader-file-coding-system))
(let ((coding-system-for-write nnheader-file-coding-system)) (write-region (point-min) (point-max) (gnus-agent-lib-file "flags")
(write-region (point-min) (point-max) (gnus-agent-lib-file "flags") t 'silent))
t 'silent)))
;; Also set the marks for the original back end that keeps marks in ;; Also set the marks for the original back end that keeps marks in
;; the local system. ;; the local system.
(let ((gnus-agent nil)) (let ((gnus-agent nil))

7
lisp/gnus/nnheader.el
View file

@ -30,7 +30,6 @@
(defvar nnmail-extra-headers) (defvar nnmail-extra-headers)
(defvar gnus-newsgroup-name) (defvar gnus-newsgroup-name)
(defvar nnheader-file-coding-system)
(defvar jka-compr-compression-info-list) (defvar jka-compr-compression-info-list)
;; Requiring `gnus-util' at compile time creates a circular ;; Requiring `gnus-util' at compile time creates a circular
@ -499,7 +498,8 @@ the line could be found."
(defvar nntp-server-buffer nil) (defvar nntp-server-buffer nil)
(defvar nntp-process-response 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) (defvar nnheader-callback-function nil)
(defun nnheader-init-server-buffer () (defun nnheader-init-server-buffer ()
@ -871,9 +871,6 @@ first. Otherwise, find the newest one, though it may take a time."
(when (string-match (car ange-ftp-path-format) path) (when (string-match (car ange-ftp-path-format) path)
(ange-ftp-re-read-dir 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) (defun nnheader-insert-file-contents (filename &optional visit beg end replace)
"Like `insert-file-contents', q.v., but only reads in the file. "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 A buffer may be modified in several ways after reading into the buffer due

62
lisp/gnus/nnimap.el
View file

@ -118,12 +118,6 @@ some servers.")
(defvoo nnimap-namespace nil) (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 (defvoo nnimap-fetch-partial-articles nil
"If non-nil, Gnus will fetch partial articles. "If non-nil, Gnus will fetch partial articles.
If t, Gnus will fetch only the first part. If a string, it If t, Gnus will fetch only the first part. If a string, it
@ -208,8 +202,6 @@ textual parts.")
(format "%s" (nreverse params)))) (format "%s" (nreverse params))))
(deffoo nnimap-retrieve-headers (articles &optional group server _fetch-old) (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 (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
(when (nnimap-change-group group server) (when (nnimap-change-group group server)
@ -644,8 +636,6 @@ textual parts.")
nnimap-status-string) nnimap-status-string)
(deffoo nnimap-request-article (article &optional group server to-buffer) (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 (with-current-buffer nntp-server-buffer
(let ((result (nnimap-change-group group server)) (let ((result (nnimap-change-group group server))
parts structure) parts structure)
@ -677,8 +667,6 @@ textual parts.")
(cons group article))))))) (cons group article)))))))
(deffoo nnimap-request-head (article &optional group server to-buffer) (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) (when (nnimap-change-group group server)
(with-current-buffer (nnimap-buffer) (with-current-buffer (nnimap-buffer)
(when (stringp article) (when (stringp article)
@ -696,8 +684,6 @@ textual parts.")
(cons group article))))))) (cons group article)))))))
(deffoo nnimap-request-articles (articles &optional group server) (deffoo nnimap-request-articles (articles &optional group server)
(when group
(setq group (nnimap-decode-gnus-group group)))
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(let ((result (nnimap-change-group group server))) (let ((result (nnimap-change-group group server)))
(when result (when result
@ -847,7 +833,6 @@ textual parts.")
(nreverse parts))) (nreverse parts)))
(deffoo nnimap-request-group (group &optional server dont-check info) (deffoo nnimap-request-group (group &optional server dont-check info)
(setq group (nnimap-decode-gnus-group group))
(let ((result (nnimap-change-group (let ((result (nnimap-change-group
;; Don't SELECT the group if we're going to select it ;; Don't SELECT the group if we're going to select it
;; later, anyway. ;; later, anyway.
@ -874,11 +859,10 @@ textual parts.")
(- (cdr active) (car active)) (- (cdr active) (car active))
(car active) (car active)
(cdr active) (cdr active)
(nnimap-encode-gnus-group group))) group))
t)))) t))))
(deffoo nnimap-request-group-scan (group &optional server info) (deffoo nnimap-request-group-scan (group &optional server info)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server) (when (nnimap-change-group nil server)
(let (marks high low) (let (marks high low)
(with-current-buffer (nnimap-buffer) (with-current-buffer (nnimap-buffer)
@ -910,23 +894,20 @@ textual parts.")
(insert (insert
(format (format
"211 %d %d %d %S\n" (1+ (- high low)) low high "211 %d %d %d %S\n" (1+ (- high low)) low high
(nnimap-encode-gnus-group group))) group))
t)))) t))))
(deffoo nnimap-request-create-group (group &optional server _args) (deffoo nnimap-request-create-group (group &optional server _args)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server) (when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer) (with-current-buffer (nnimap-buffer)
(car (nnimap-command "CREATE %S" (nnimap-group-to-imap group)))))) (car (nnimap-command "CREATE %S" (nnimap-group-to-imap group))))))
(deffoo nnimap-request-delete-group (group &optional _force server) (deffoo nnimap-request-delete-group (group &optional _force server)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server) (when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer) (with-current-buffer (nnimap-buffer)
(car (nnimap-command "DELETE %S" (nnimap-group-to-imap group)))))) (car (nnimap-command "DELETE %S" (nnimap-group-to-imap group))))))
(deffoo nnimap-request-rename-group (group new-name &optional server) (deffoo nnimap-request-rename-group (group new-name &optional server)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server) (when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer) (with-current-buffer (nnimap-buffer)
(nnimap-unselect-group) (nnimap-unselect-group)
@ -941,7 +922,6 @@ textual parts.")
(nnimap-command "EXAMINE DOES.NOT.EXIST")) (nnimap-command "EXAMINE DOES.NOT.EXIST"))
(deffoo nnimap-request-expunge-group (group &optional server) (deffoo nnimap-request-expunge-group (group &optional server)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group group server) (when (nnimap-change-group group server)
(with-current-buffer (nnimap-buffer) (with-current-buffer (nnimap-buffer)
(car (nnimap-command "EXPUNGE"))))) (car (nnimap-command "EXPUNGE")))))
@ -970,9 +950,6 @@ textual parts.")
(deffoo nnimap-request-move-article (article group server accept-form (deffoo nnimap-request-move-article (article group server accept-form
&optional _last &optional _last
internal-move-group) 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 (with-temp-buffer
(mm-disable-multibyte) (mm-disable-multibyte)
(when (funcall (if internal-move-group (when (funcall (if internal-move-group
@ -1006,7 +983,6 @@ textual parts.")
result)))))) result))))))
(deffoo nnimap-request-expire-articles (articles group &optional server force) (deffoo nnimap-request-expire-articles (articles group &optional server force)
(setq group (nnimap-decode-gnus-group group))
(cond (cond
((null articles) ((null articles)
nil) nil)
@ -1151,8 +1127,6 @@ If LIMIT, first try to limit the search to the N last articles."
"delete this article now")))))) "delete this article now"))))))
(deffoo nnimap-request-scan (&optional group server) (deffoo nnimap-request-scan (&optional group server)
(when group
(setq group (nnimap-decode-gnus-group group)))
(when (and (nnimap-change-group nil server) (when (and (nnimap-change-group nil server)
nnimap-inbox nnimap-inbox
nnimap-split-methods) nnimap-split-methods)
@ -1171,7 +1145,6 @@ If LIMIT, first try to limit the search to the N last articles."
flags)) flags))
(deffoo nnimap-request-update-group-status (group status &optional server) (deffoo nnimap-request-update-group-status (group status &optional server)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server) (when (nnimap-change-group nil server)
(let ((command (assoc (let ((command (assoc
status status
@ -1182,7 +1155,6 @@ If LIMIT, first try to limit the search to the N last articles."
(nnimap-command "%s %S" (cadr command) (nnimap-group-to-imap group))))))) (nnimap-command "%s %S" (cadr command) (nnimap-group-to-imap group)))))))
(deffoo nnimap-request-set-mark (group actions &optional server) (deffoo nnimap-request-set-mark (group actions &optional server)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group group server) (when (nnimap-change-group group server)
(let (sequence) (let (sequence)
(with-current-buffer (nnimap-buffer) (with-current-buffer (nnimap-buffer)
@ -1217,8 +1189,7 @@ If LIMIT, first try to limit the search to the N last articles."
;; that's determined by the IMAP server later. So just ;; that's determined by the IMAP server later. So just
;; return the group name. ;; return the group name.
(lambda (group) (lambda (group)
(list (list group))))))) (list (list group)))))))
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server) (when (nnimap-change-group nil server)
(nnmail-check-syntax) (nnmail-check-syntax)
(let ((message-id (message-field-value "message-id")) (let ((message-id (message-field-value "message-id"))
@ -1296,7 +1267,6 @@ If LIMIT, first try to limit the search to the N last articles."
result)) result))
(deffoo nnimap-request-replace-article (article group buffer) (deffoo nnimap-request-replace-article (article group buffer)
(setq group (nnimap-decode-gnus-group group))
(let (group-art) (let (group-art)
(when (and (nnimap-change-group group) (when (and (nnimap-change-group group)
;; Put the article into the group. ;; Put the article into the group.
@ -1380,8 +1350,7 @@ If LIMIT, first try to limit the search to the N last articles."
(dolist (response responses) (dolist (response responses)
(let* ((sequence (car response)) (let* ((sequence (car response))
(response (cadr response)) (response (cadr response))
(group (cadr (assoc sequence sequences))) (group (cadr (assoc sequence sequences))))
(egroup (nnimap-encode-gnus-group group)))
(when (and group (when (and group
(equal (caar response) "OK")) (equal (caar response) "OK"))
(let ((uidnext (nnimap-find-parameter "UIDNEXT" response)) (let ((uidnext (nnimap-find-parameter "UIDNEXT" response))
@ -1393,14 +1362,14 @@ If LIMIT, first try to limit the search to the N last articles."
(setq highest (1- (string-to-number (car uidnext))))) (setq highest (1- (string-to-number (car uidnext)))))
(cond (cond
((null highest) ((null highest)
(insert (format "%S 0 1 y\n" egroup))) (insert (format "%S 0 1 y\n" group)))
((zerop exists) ((zerop exists)
;; Empty group. ;; Empty group.
(insert (format "%S %d %d y\n" egroup (insert (format "%S %d %d y\n" group
highest (1+ highest)))) highest (1+ highest))))
(t (t
;; Return the widest possible range. ;; Return the widest possible range.
(insert (format "%S %d 1 y\n" egroup (insert (format "%S %d 1 y\n" group
(or highest exists))))))))) (or highest exists)))))))))
t))))) t)))))
@ -1412,7 +1381,7 @@ If LIMIT, first try to limit the search to the N last articles."
(nnimap-get-groups))) (nnimap-get-groups)))
(unless (assoc group nnimap-current-infos) (unless (assoc group nnimap-current-infos)
;; Insert dummy numbers here -- they don't matter. ;; 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))) t)))
(deffoo nnimap-retrieve-group-data-early (server infos) (deffoo nnimap-retrieve-group-data-early (server infos)
@ -1429,8 +1398,7 @@ If LIMIT, first try to limit the search to the N last articles."
;; what and how to request the data. ;; what and how to request the data.
(dolist (info infos) (dolist (info infos)
(setq params (gnus-info-params info) (setq params (gnus-info-params info)
group (nnimap-decode-gnus-group group (gnus-group-real-name (gnus-info-group info))
(gnus-group-real-name (gnus-info-group info)))
active (cdr (assq 'active params)) active (cdr (assq 'active params))
unexist (assq 'unexist (gnus-info-marks info)) unexist (assq 'unexist (gnus-info-marks info))
uidvalidity (cdr (assq 'uidvalidity params)) uidvalidity (cdr (assq 'uidvalidity params))
@ -1511,16 +1479,13 @@ If LIMIT, first try to limit the search to the N last articles."
(active (gnus-active group))) (active (gnus-active group)))
(when active (when active
(insert (format "%S %d %d y\n" (insert (format "%S %d %d y\n"
(nnimap-encode-gnus-group (gnus-group-real-name group)
(nnimap-decode-gnus-group
(gnus-group-real-name group)))
(cdr active) (cdr active)
(car active)))))))))))) (car active))))))))))))
(defun nnimap-update-infos (flags infos) (defun nnimap-update-infos (flags infos)
(dolist (info infos) (dolist (info infos)
(let* ((group (nnimap-decode-gnus-group (let* ((group (gnus-group-real-name (gnus-info-group info)))
(gnus-group-real-name (gnus-info-group info))))
(marks (cdr (assoc group flags)))) (marks (cdr (assoc group flags))))
(when marks (when marks
(nnimap-update-info info marks))))) (nnimap-update-info info marks)))))
@ -1734,8 +1699,7 @@ If LIMIT, first try to limit the search to the N last articles."
(nreverse result)))) (nreverse result))))
(defun nnimap-store-info (info active) (defun nnimap-store-info (info active)
(let* ((group (nnimap-decode-gnus-group (let* ((group (gnus-group-real-name (gnus-info-group info)))
(gnus-group-real-name (gnus-info-group info))))
(entry (assoc group nnimap-current-infos))) (entry (assoc group nnimap-current-infos)))
(if entry (if entry
(setcdr entry (list info active)) (setcdr entry (list info active))
@ -1860,8 +1824,6 @@ If LIMIT, first try to limit the search to the N last articles."
(autoload 'nnir-search-thread "nnir") (autoload 'nnir-search-thread "nnir")
(deffoo nnimap-request-thread (header &optional group server) (deffoo nnimap-request-thread (header &optional group server)
(when group
(setq group (nnimap-decode-gnus-group group)))
(if gnus-refer-thread-use-nnir (if gnus-refer-thread-use-nnir
(nnir-search-thread header) (nnir-search-thread header)
(when (nnimap-change-group group server) (when (nnimap-change-group group server)

28
lisp/gnus/nnmail.el
View file

@ -665,9 +665,12 @@ nn*-request-list should have been called before calling this function."
(condition-case err (condition-case err
(progn (progn
(narrow-to-region (point) (point-at-eol)) (narrow-to-region (point) (point-at-eol))
(setq group (read buffer)) (setq group (read buffer)
(unless (stringp group) group
(setq group (encode-coding-string (symbol-name group) 'latin-1))) (cond ((symbolp group)
(symbol-name group))
((numberp group)
(number-to-string group))))
(if (and (numberp (setq max (read buffer))) (if (and (numberp (setq max (read buffer)))
(numberp (setq min (read buffer)))) (numberp (setq min (read buffer))))
(push (list group (cons min max)) (push (list group (cons min max))
@ -677,7 +680,7 @@ nn*-request-list should have been called before calling this function."
(forward-line 1)) (forward-line 1))
group-assoc)) group-assoc))
(defcustom nnmail-active-file-coding-system 'raw-text (defcustom nnmail-active-file-coding-system 'utf-8-emacs
"Coding system for active file." "Coding system for active file."
:group 'nnmail-various :group 'nnmail-various
:type 'coding-system) :type 'coding-system)
@ -687,7 +690,7 @@ nn*-request-list should have been called before calling this function."
(let ((coding-system-for-write nnmail-active-file-coding-system)) (let ((coding-system-for-write nnmail-active-file-coding-system))
(when file-name (when file-name
(with-temp-file file-name (with-temp-file file-name
(mm-disable-multibyte) ; (mm-disable-multibyte)
(nnmail-generate-active group-assoc))))) (nnmail-generate-active group-assoc)))))
(defun nnmail-generate-active (alist) (defun nnmail-generate-active (alist)
@ -695,7 +698,7 @@ nn*-request-list should have been called before calling this function."
(erase-buffer) (erase-buffer)
(let (group) (let (group)
(while (setq group (pop alist)) (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)))) (caadr group))))
(goto-char (point-max)) (goto-char (point-max))
(while (search-backward "\\." nil t) (while (search-backward "\\." nil t)
@ -1027,8 +1030,8 @@ If SOURCE is a directory spec, try to return the group name component."
(nnmail-check-duplication message-id func artnum-func)) (nnmail-check-duplication message-id func artnum-func))
1)) 1))
(defvar nnmail-group-names-not-encoded-p nil (make-obsolete-variable 'nnmail-group-names-not-encoded-p
"Non-nil means group names are not encoded.") "Group names are always decoded" "27.1")
(defun nnmail-split-incoming (incoming func &optional exit-func (defun nnmail-split-incoming (incoming func &optional exit-func
group artnum-func junk-func) group artnum-func junk-func)
@ -1036,18 +1039,21 @@ If SOURCE is a directory spec, try to return the group name component."
FUNC will be called with the buffer narrowed to each mail. FUNC will be called with the buffer narrowed to each mail.
INCOMING can also be a buffer object. In that case, the mail INCOMING can also be a buffer object. In that case, the mail
will be copied over from that buffer." 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. ;; methods to just this group.
(nnmail-split-methods (if (and group (nnmail-split-methods (if (and group
(not nnmail-resplit-incoming)) (not nnmail-resplit-incoming))
(list (list group "")) (list (list group ""))
nnmail-split-methods)) nnmail-split-methods)))
(nnmail-group-names-not-encoded-p t))
;; Insert the incoming file. ;; Insert the incoming file.
(with-current-buffer (get-buffer-create nnmail-article-buffer) (with-current-buffer (get-buffer-create nnmail-article-buffer)
(erase-buffer) (erase-buffer)
(if (bufferp incoming) (if (bufferp incoming)
(insert-buffer-substring 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)) (let ((coding-system-for-read nnmail-incoming-coding-system))
(mm-insert-file-contents incoming))) (mm-insert-file-contents incoming)))
(prog1 (prog1

2
lisp/gnus/nnmaildir.el
View file

@ -415,7 +415,7 @@ This variable is set by `nnmaildir-request-article'.")
(t (signal (car err) (cdr err))))))))) (t (signal (car err) (cdr err)))))))))
(defun nnmaildir--update-nov (server group article) (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)) (srv-dir (nnmaildir--srv-dir server))
(storage-version 1) ;; [version article-number msgid [...nov...]] (storage-version 1) ;; [version article-number msgid [...nov...]]
dir gname pgname msgdir prefix suffix file attr mtime novdir novfile dir gname pgname msgdir prefix suffix file attr mtime novdir novfile

92
lisp/gnus/nnml.el
View file

@ -111,36 +111,9 @@ non-nil.")
(nnoo-define-basics nnml) (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) (defun nnml-group-pathname (group &optional file server)
"Return an absolute file name of FILE for GROUP on SERVER." "Return an absolute file name of FILE for GROUP on SERVER."
(nnmail-group-pathname (inline (nnml-decoded-group-name group server)) (nnmail-group-pathname group nnml-directory file))
nnml-directory file))
(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old) (deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
(when (nnml-possibly-change-directory group server) (when (nnml-possibly-change-directory group server)
@ -243,8 +216,7 @@ non-nil.")
(string-to-number (file-name-nondirectory path))))))) (string-to-number (file-name-nondirectory path)))))))
(deffoo nnml-request-group (group &optional server dont-check info) (deffoo nnml-request-group (group &optional server dont-check info)
(let ((file-name-coding-system nnmail-pathname-coding-system) (let ((file-name-coding-system nnmail-pathname-coding-system))
(decoded (nnml-decoded-group-name group server)))
(cond (cond
((not (nnml-possibly-change-directory group server)) ((not (nnml-possibly-change-directory group server))
(nnheader-report 'nnml "Invalid group (no such directory)")) (nnheader-report 'nnml "Invalid group (no such directory)"))
@ -254,15 +226,15 @@ non-nil.")
((not (file-directory-p nnml-current-directory)) ((not (file-directory-p nnml-current-directory))
(nnheader-report 'nnml "%s is not a directory" nnml-current-directory)) (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
(dont-check (dont-check
(nnheader-report 'nnml "Group %s selected" decoded) (nnheader-report 'nnml "Group %s selected" group)
t) t)
(t (t
(nnheader-re-read-dir nnml-current-directory) (nnheader-re-read-dir nnml-current-directory)
(nnmail-activate 'nnml) (nnmail-activate 'nnml)
(let ((active (nth 1 (assoc-string group nnml-group-alist)))) (let ((active (nth 1 (assoc-string group nnml-group-alist))))
(if (not active) (if (not active)
(nnheader-report 'nnml "No such group: %s" decoded) (nnheader-report 'nnml "No such group: %s" group)
(nnheader-report 'nnml "Selected group %s" decoded) (nnheader-report 'nnml "Selected group %s" group)
(nnheader-insert "211 %d %d %d %s\n" (nnheader-insert "211 %d %d %d %s\n"
(max (1+ (- (cdr active) (car active))) 0) (max (1+ (- (cdr active) (car active))) 0)
(car active) (cdr active) group))))))) (car active) (cdr active) group)))))))
@ -332,7 +304,6 @@ non-nil.")
(active-articles (active-articles
(nnml-directory-articles nnml-current-directory)) (nnml-directory-articles nnml-current-directory))
(is-old t) (is-old t)
(decoded (nnml-decoded-group-name group server))
article rest mod-time number target) article rest mod-time number target)
(nnmail-activate 'nnml) (nnmail-activate 'nnml)
@ -370,7 +341,7 @@ non-nil.")
(if target (if target
(progn (progn
(nnheader-message 5 "Deleting article %s in %s" (nnheader-message 5 "Deleting article %s in %s"
number decoded) number group)
(condition-case () (condition-case ()
(funcall nnmail-delete-file-function article) (funcall nnmail-delete-file-function article)
(file-error (file-error
@ -506,13 +477,12 @@ non-nil.")
nnml-current-directory t nnml-current-directory t
(concat (concat
nnheader-numerical-short-files nnheader-numerical-short-files
"\\|" (regexp-quote nnml-nov-file-name) "$"))) "\\|" (regexp-quote nnml-nov-file-name) "$"))))
(decoded (nnml-decoded-group-name group server)))
(dolist (article articles) (dolist (article articles)
(when (file-writable-p article) (when (file-writable-p article)
(nnheader-message 5 "Deleting article %s in %s..." (nnheader-message 5 "Deleting article %s in %s..."
(file-name-nondirectory article) (file-name-nondirectory article)
decoded) group)
(funcall nnmail-delete-file-function article)))) (funcall nnmail-delete-file-function article))))
;; Try to delete the directory itself. ;; Try to delete the directory itself.
(ignore-errors (delete-directory nnml-current-directory)))) (ignore-errors (delete-directory nnml-current-directory))))
@ -687,15 +657,7 @@ article number. This function is called narrowed to an article."
(if (stringp nnml-use-compressed-files) (if (stringp nnml-use-compressed-files)
nnml-use-compressed-files nnml-use-compressed-files
".gz"))) ".gz")))
decoded dec file first headers) 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))
(nnmail-insert-xref group-art) (nnmail-insert-xref group-art)
(run-hooks 'nnmail-prepare-save-mail-hook) (run-hooks 'nnmail-prepare-save-mail-hook)
(run-hooks 'nnml-prepare-save-mail-hook) (run-hooks 'nnml-prepare-save-mail-hook)
@ -705,16 +667,10 @@ article number. This function is called narrowed to an article."
(forward-line 1)) (forward-line 1))
;; We save the article in all the groups it belongs in. ;; We save the article in all the groups it belongs in.
(dolist (ga group-art) (dolist (ga group-art)
(if nnmail-group-names-not-encoded-p (nnml-possibly-create-directory (car ga) server)
(progn (setq file (nnml-group-pathname
(nnml-possibly-create-directory (car decoded) server) (car ga) (concat (number-to-string (cdr ga)) extension)
(setq file (nnmail-group-pathname server))
(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)))
(if first (if first
;; It was already saved, so we just make a hard link. ;; It was already saved, so we just make a hard link.
(let ((file-name-coding-system nnmail-pathname-coding-system)) (let ((file-name-coding-system nnmail-pathname-coding-system))
@ -731,18 +687,13 @@ article number. This function is called narrowed to an article."
(let ((func (if full-nov (let ((func (if full-nov
'nnml-add-nov 'nnml-add-nov
'nnml-add-incremental-nov))) 'nnml-add-incremental-nov)))
(if nnmail-group-names-not-encoded-p (dolist (ga group-art)
(dolist (ga group-art) (funcall func (car ga) (cdr ga) headers))))
(funcall func (pop dec) (cdr ga) headers))
(dolist (ga group-art)
(funcall func (car ga) (cdr ga) headers)))))
group-art) group-art)
(defun nnml-active-number (group &optional server) (defun nnml-active-number (group &optional server)
"Compute the next article number in GROUP on SERVER." "Compute the next article number in GROUP on SERVER."
(let* ((encoded (if nnmail-group-names-not-encoded-p (let ((active (cadr (assoc-string group nnml-group-alist))))
(nnml-encoded-group-name group server)))
(active (cadr (assoc-string (or encoded group) nnml-group-alist))))
;; The group wasn't known to nnml, so we just create an active ;; The group wasn't known to nnml, so we just create an active
;; entry for it. ;; entry for it.
(unless active (unless active
@ -760,7 +711,7 @@ article number. This function is called narrowed to an article."
(cons (caar nnml-article-file-alist) (cons (caar nnml-article-file-alist)
(caar (last nnml-article-file-alist))) (caar (last nnml-article-file-alist)))
(cons 1 0))) (cons 1 0)))
(push (list (or encoded group) active) nnml-group-alist)) (push (list group active) nnml-group-alist))
(setcdr active (1+ (cdr active))) (setcdr active (1+ (cdr active)))
(while (file-exists-p (while (file-exists-p
(nnml-group-pathname group (int-to-string (cdr active)) server)) (nnml-group-pathname group (int-to-string (cdr active)) server))
@ -821,16 +772,15 @@ article number. This function is called narrowed to an article."
headers)))) headers))))
(defun nnml-get-nov-buffer (group &optional incrementalp) (defun nnml-get-nov-buffer (group &optional incrementalp)
(let* ((decoded (nnml-decoded-group-name group)) (let ((buffer (get-buffer-create (format " *nnml %soverview %s*"
(buffer (get-buffer-create (format " *nnml %soverview %s*"
(if incrementalp (if incrementalp
"incremental " "incremental "
"") "")
decoded))) group)))
(file-name-coding-system nnmail-pathname-coding-system)) (file-name-coding-system nnmail-pathname-coding-system))
(with-current-buffer buffer (with-current-buffer buffer
(set (make-local-variable 'nnml-nov-buffer-file-name) (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) (erase-buffer)
(when (and (not incrementalp) (when (and (not incrementalp)
(file-exists-p nnml-nov-buffer-file-name)) (file-exists-p nnml-nov-buffer-file-name))
@ -908,7 +858,7 @@ Unless no-active is non-nil, update the active file too."
;; Update the active info for this group. ;; Update the active info for this group.
(let ((group (directory-file-name dir)) (let ((group (directory-file-name dir))
entry last) entry last)
(setq group (nnheader-file-to-group (nnml-encoded-group-name group) (setq group (nnheader-file-to-group group
nnml-directory) nnml-directory)
entry (assoc group nnml-group-alist) entry (assoc group nnml-group-alist)
last (or (caadr entry) 0) last (or (caadr entry) 0)

2
lisp/gnus/nnrss.el
View file

@ -368,7 +368,7 @@ for decoding when the cdr that the data specify is not available.")
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
(dolist (group groups) (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))))) (insert (format "%S %s 1 y\n" group (or (cadr elem) 0)))))
'active)) 'active))