Commit 5563d1cd authored by Eric Abrahamsen's avatar Eric Abrahamsen

Remove all remaining uses of gnus-group-decoded-name

* lisp/gnus/gnus-art.el (gnus-article-setup-buffer):
* lisp/gnus/nnrss.el (nnrss-retrieve-groups):
* lisp/gnus/message.el (message-forward-subject-author-subject):
  (message-forward-subject-name-subject):
* lisp/gnus/gnus-msg.el (gnus-inews-insert-gcc):
  (gnus-inews-make-draft):
* lisp/gnus/gnus-group.el (gnus-group-compact-group):
  (gnus-group-list-active):
  (gnus-group-kill-group):
  (gnus-group-set-current-level):
  (gnus-group-expire-articles-1):
  (gnus-group-catchup-current):
  (gnus-group-edit-group):
  (gnus-group-rename-group):
  (gnus-group-delete-group):
  (gnus-group-name-at-point): Remove calls in all these places, group
  names are always decoded.
* lisp/gnus/gnus-cache.el: Remove variables
  gnus-cache-unified-group-names and gnus-cache-decoded-group-names,
  and function gnus-cache-decoded-group-name.
  (gnus-cache-generate-active): Do not access
  gnus-cache-unified-group-names.
  (gnus-cache-file-name): Don't decode.
parent cf804c86
Pipeline #2198 passed with stage
in 51 minutes and 37 seconds
...@@ -4496,9 +4496,7 @@ commands: ...@@ -4496,9 +4496,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"
......
...@@ -430,41 +430,7 @@ Returns the list of articles removed." ...@@ -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." ...@@ -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.
......
...@@ -2104,9 +2104,7 @@ be permanent." ...@@ -2104,9 +2104,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-?]+\\)?:\
...@@ -2797,20 +2795,19 @@ be removed from the server, even when it's empty." ...@@ -2797,20 +2795,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)
...@@ -2845,34 +2842,30 @@ and NEW-NAME will be prompted for." ...@@ -2845,34 +2842,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."
...@@ -2899,7 +2892,7 @@ and NEW-NAME will be prompted for." ...@@ -2899,7 +2892,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
...@@ -3534,7 +3527,7 @@ up is returned." ...@@ -3534,7 +3527,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))
...@@ -3619,8 +3612,7 @@ Uses the process/prefix convention." ...@@ -3619,8 +3612,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))
...@@ -3647,8 +3639,7 @@ Uses the process/prefix convention." ...@@ -3647,8 +3639,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))))
...@@ -3685,7 +3676,7 @@ Uses the process/prefix convention." ...@@ -3685,7 +3676,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
...@@ -3832,7 +3823,7 @@ of groups killed." ...@@ -3832,7 +3823,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))
...@@ -3970,7 +3961,7 @@ entail asking the server for the groups." ...@@ -3970,7 +3961,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
...@@ -4694,22 +4685,21 @@ Note: currently only implemented in nnml." ...@@ -4694,22 +4685,21 @@ 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.
(let ((original (get-buffer gnus-original-article-buffer))) (let ((original (get-buffer gnus-original-article-buffer)))
(and original (gnus-kill-buffer original))) (and original (gnus-kill-buffer original)))
;; 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)
......
...@@ -413,7 +413,7 @@ Thank you for your help in stamping out bugs. ...@@ -413,7 +413,7 @@ Thank you for your help in stamping out bugs.
(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)
...@@ -1722,7 +1722,6 @@ this is a reply." ...@@ -1722,7 +1722,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))
......
...@@ -1884,7 +1884,6 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." ...@@ -1884,7 +1884,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")
...@@ -7322,12 +7321,11 @@ news, Source is the list of newsgroups is was posted to." ...@@ -7322,12 +7321,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
...@@ -7341,10 +7339,9 @@ Source is the sender, and if the original message was news, Source is ...@@ -7341,10 +7339,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
......
...@@ -367,7 +367,7 @@ for decoding when the cdr that the data specify is not available.") ...@@ -367,7 +367,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))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment