diff options
-rw-r--r-- | lisp/gnus/gnus-art.el | 4 | ||||
-rw-r--r-- | lisp/gnus/gnus-cache.el | 41 | ||||
-rw-r--r-- | lisp/gnus/gnus-group.el | 126 | ||||
-rw-r--r-- | lisp/gnus/gnus-msg.el | 3 | ||||
-rw-r--r-- | lisp/gnus/message.el | 19 | ||||
-rw-r--r-- | lisp/gnus/nnrss.el | 2 |
6 files changed, 70 insertions, 125 deletions
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index baa8a244c07..7a8b1b82715 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4496,9 +4496,7 @@ commands: (defun gnus-article-setup-buffer () "Initialize the article buffer." (let* ((name (if gnus-single-article-buffer "*Article*" - (concat "*Article " - (gnus-group-decoded-name gnus-newsgroup-name) - "*"))) + (concat "*Article " gnus-newsgroup-name "*"))) (original (progn (string-match "\\*Article" name) (concat " *Original Article" diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 5e6483d1053..14d5d4aaebd 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -430,41 +430,7 @@ Returns the list of articles removed." (and unread (memq 'unread class)) (and (not unread) (not ticked) (not dormant) (memq 'read class)))) -(defvar gnus-cache-decoded-group-names nil - "Alist of original group names and decoded group names. -Decoding is done according to `gnus-group-name-charset-method-alist' -or `gnus-group-name-charset-group-alist'.") - -(defvar gnus-cache-unified-group-names nil - "Alist of unified decoded group names and original group names. -A group name is decoded according to -`gnus-group-name-charset-method-alist' or -`gnus-group-name-charset-group-alist' first, and is encoded and -decoded again according to `nnmail-pathname-coding-system', -`file-name-coding-system', or `default-file-name-coding-system'. - -It is used when asking for an original group name from a cache -directory name, in which non-ASCII characters might have been unified -into the ones of a certain charset particularly if the `utf-8' coding -system for example was used.") - -(defun gnus-cache-decoded-group-name (group) - "Return a decoded group name of GROUP." - (or (cdr (assoc group gnus-cache-decoded-group-names)) - (let ((decoded (gnus-group-decoded-name group)) - (coding (or nnmail-pathname-coding-system - file-name-coding-system - default-file-name-coding-system))) - (push (cons group decoded) gnus-cache-decoded-group-names) - (push (cons (decode-coding-string - (encode-coding-string decoded coding) - coding) - group) - gnus-cache-unified-group-names) - decoded))) - (defun gnus-cache-file-name (group article) - (setq group (gnus-cache-decoded-group-name group)) (expand-file-name (if (stringp article) article (int-to-string article)) (file-name-as-directory @@ -733,12 +699,7 @@ If LOW, update the lower bound instead." (push (pop files) alphs))) ;; If we have nums, then this is probably a valid group. (when (setq nums (sort nums '<)) - ;; Use non-decoded group name. - ;; FIXME: this is kind of a workaround. The active file should - ;; be updated at the time articles are cached. It will make - ;; `gnus-cache-unified-group-names' needless. - (puthash (or (cdr (assoc group gnus-cache-unified-group-names)) - group) + (puthash group (cons (car nums) (car (last nums))) gnus-cache-active-hashtb)) ;; Go through all the other files. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 528dbce1614..7a17b16bf94 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2104,9 +2104,7 @@ be permanent." (defun gnus-group-name-at-point () "Return a group name from around point if it exists, or nil." (if (derived-mode-p 'gnus-group-mode) - (let ((group (gnus-group-group-name))) - (when group - (gnus-group-decoded-name group))) + (gnus-group-group-name) ;; FIXME: Use rx. (let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\ \\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\ @@ -2797,20 +2795,19 @@ be removed from the server, even when it's empty." (unless (gnus-check-backend-function 'request-delete-group group) (error "This back end does not support group deletion")) (prog1 - (let ((group-decoded (gnus-group-decoded-name group))) - (when (or no-prompt - (gnus-yes-or-no-p - (format - "Do you really want to delete %s%s? " - group-decoded (if force " and all its contents" "")))) - (gnus-message 6 "Deleting group %s..." group-decoded) - (if (not (gnus-request-delete-group group force)) - (gnus-error 3 "Couldn't delete group %s" group-decoded) - (gnus-message 6 "Deleting group %s...done" group-decoded) - (gnus-group-goto-group group) - (gnus-group-kill-group 1 t) - (gnus-set-active group nil) - t))) + (when (or no-prompt + (gnus-yes-or-no-p + (format + "Do you really want to delete %s%s? " + group (if force " and all its contents" "")))) + (gnus-message 6 "Deleting group %s..." group) + (if (not (gnus-request-delete-group group force)) + (gnus-error 3 "Couldn't delete group %s" group) + (gnus-message 6 "Deleting group %s...done" group) + (gnus-group-goto-group group) + (gnus-group-kill-group 1 t) + (gnus-set-active group nil) + t)) (gnus-group-position-point))) (defun gnus-group-rename-group (group new-name) @@ -2845,34 +2842,30 @@ and NEW-NAME will be prompted for." (gnus-group-real-name new-name) (gnus-info-method (gnus-get-info group))))) - (let ((decoded-group (gnus-group-decoded-name group)) - (decoded-new-name (gnus-group-decoded-name new-name))) - (when (gnus-active new-name) - (error "The group %s already exists" decoded-new-name)) + (when (gnus-active new-name) + (error "The group %s already exists" new-name)) - (gnus-message 6 "Renaming group %s to %s..." - decoded-group decoded-new-name) - (prog1 - (if (progn - (gnus-group-goto-group group) - (not (when (< (gnus-group-group-level) gnus-level-zombie) - (gnus-request-rename-group group new-name)))) - (gnus-error 3 "Couldn't rename group %s to %s" - decoded-group decoded-new-name) - ;; We rename the group internally by killing it... - (gnus-group-kill-group) - ;; ... changing its name ... - (setcar (cdar gnus-list-of-killed-groups) new-name) - ;; ... and then yanking it. Magic! - (gnus-group-yank-group) - (gnus-set-active new-name (gnus-active group)) - (gnus-message 6 "Renaming group %s to %s...done" - decoded-group decoded-new-name) - new-name) - (setq gnus-killed-list (delete group gnus-killed-list)) - (gnus-set-active group nil) - (gnus-dribble-touch) - (gnus-group-position-point)))) + (gnus-message 6 "Renaming group %s to %s..." group new-name) + (prog1 + (if (progn + (gnus-group-goto-group group) + (not (when (< (gnus-group-group-level) gnus-level-zombie) + (gnus-request-rename-group group new-name)))) + (gnus-error 3 "Couldn't rename group %s to %s" + group new-name) + ;; We rename the group internally by killing it... + (gnus-group-kill-group) + ;; ... changing its name ... + (setcar (cdar gnus-list-of-killed-groups) new-name) + ;; ... and then yanking it. Magic! + (gnus-group-yank-group) + (gnus-set-active new-name (gnus-active group)) + (gnus-message 6 "Renaming group %s to %s...done" group new-name) + new-name) + (setq gnus-killed-list (delete group gnus-killed-list)) + (gnus-set-active group nil) + (gnus-dribble-touch) + (gnus-group-position-point))) (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." @@ -2899,7 +2892,7 @@ and NEW-NAME will be prompted for." ((eq part 'method) "select method") ((eq part 'params) "group parameters") (t "group info")) - (gnus-group-decoded-name group)) + group) `(lambda (form) (gnus-group-edit-group-done ',part ,group form))) (local-set-key @@ -3534,7 +3527,7 @@ up is returned." "Do you really want to mark all articles in %s as read? " "Mark all unread articles in %s as read? ") (if (= (length groups) 1) - (gnus-group-decoded-name (car groups)) + (car groups) (format "these %d groups" (length groups))))))) n (while (setq group (pop groups)) @@ -3619,8 +3612,7 @@ Uses the process/prefix convention." (defun gnus-group-expire-articles-1 (group) (when (gnus-check-backend-function 'request-expire-articles group) - (gnus-message 6 "Expiring articles in %s..." - (gnus-group-decoded-name group)) + (gnus-message 6 "Expiring articles in %s..." group) (let* ((info (gnus-get-info group)) (expirable (if (gnus-group-total-expirable-p group) (cons nil (gnus-list-of-read-articles group)) @@ -3647,8 +3639,7 @@ Uses the process/prefix convention." ;; Just expire using the normal expiry values. (gnus-request-expire-articles articles-to-expire group)))) (gnus-close-group group)) - (gnus-message 6 "Expiring articles in %s...done" - (gnus-group-decoded-name group)) + (gnus-message 6 "Expiring articles in %s...done" group) ;; Return the list of un-expired articles. (cdr expirable)))) @@ -3685,7 +3676,7 @@ Uses the process/prefix convention." (dolist (group (gnus-group-process-prefix n)) (gnus-group-remove-mark group) (gnus-message 6 "Changed level of %s from %d to %d" - (gnus-group-decoded-name group) + group (or (gnus-group-group-level) gnus-level-killed) level) (gnus-group-change-level @@ -3832,7 +3823,7 @@ of groups killed." ;; `gnus-newsrc-hashtb', this check will always return nil. (when (numberp (gnus-group-unread group)) (gnus-request-update-group-status group 'unsubscribe)) - (message "Killed group %s" (gnus-group-decoded-name group))) + (message "Killed group %s" group)) ;; If there are lots and lots of groups to be killed, we use ;; this thing instead. (dolist (group (nreverse groups)) @@ -3970,7 +3961,7 @@ entail asking the server for the groups." (add-text-properties (point) (prog1 (1+ (point)) (insert " *: " - (gnus-group-decoded-name group) + group "\n")) (list 'gnus-group group 'gnus-unread t @@ -4694,22 +4685,21 @@ Note: currently only implemented in nnml." (error "No group to compact")) (unless (gnus-check-backend-function 'request-compact-group group) (error "This back end does not support group compaction")) - (let ((group-decoded (gnus-group-decoded-name group))) - (gnus-message 6 "\ + (gnus-message 6 "\ Compacting group %s... (this may take a long time)" - group-decoded) - (prog1 - (if (not (gnus-request-compact-group group)) - (gnus-error 3 "Couldn't compact group %s" group-decoded) - (gnus-message 6 "Compacting group %s...done" group-decoded) - t) - ;; Invalidate the "original article" buffer which might be out of date. - ;; #### NOTE: Yes, this might be a bit rude, but since compaction - ;; #### will not happen very often, I think this is acceptable. - (let ((original (get-buffer gnus-original-article-buffer))) - (and original (gnus-kill-buffer original))) - ;; Update the group line to reflect new information (art number etc). - (gnus-group-update-group-line)))) + group) + (prog1 + (if (not (gnus-request-compact-group group)) + (gnus-error 3 "Couldn't compact group %s" group) + (gnus-message 6 "Compacting group %s...done" group) + t) + ;; Invalidate the "original article" buffer which might be out of date. + ;; #### NOTE: Yes, this might be a bit rude, but since compaction + ;; #### will not happen very often, I think this is acceptable. + (let ((original (get-buffer gnus-original-article-buffer))) + (and original (gnus-kill-buffer original))) + ;; Update the group line to reflect new information (art number etc). + (gnus-group-update-group-line))) (provide 'gnus-group) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index b6d649d7603..0ac0164bb7a 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -413,7 +413,7 @@ Thank you for your help in stamping out bugs. (defun gnus-inews-make-draft (articles) `(lambda () (gnus-inews-make-draft-meta-information - ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles))) + ,gnus-newsgroup-name ',articles))) (autoload 'nnir-article-number "nnir" nil nil 'macro) (autoload 'nnir-article-group "nnir" nil nil 'macro) @@ -1722,7 +1722,6 @@ this is a reply." (defun gnus-inews-insert-gcc (&optional group) "Insert the Gcc to say where the article is to be archived." (let* ((group (or group gnus-newsgroup-name)) - (group (when group (gnus-group-decoded-name group))) (var (or gnus-outgoing-message-group gnus-message-archive-group)) (gcc-self-val (and group (not (gnus-virtual-group-p group)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c2374c70730..97b6d7e231a 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1884,7 +1884,6 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (autoload 'gnus-delay-article "gnus-delay") (autoload 'gnus-extract-address-components "gnus-util") (autoload 'gnus-find-method-for-group "gnus") -(autoload 'gnus-group-decoded-name "gnus-group") (autoload 'gnus-group-name-charset "gnus-group") (autoload 'gnus-group-name-decode "gnus-group") (autoload 'gnus-groups-from-server "gnus") @@ -7322,12 +7321,11 @@ news, Source is the list of newsgroups is was posted to." (let* ((group (message-fetch-field "newsgroups")) (from (message-fetch-field "from")) (prefix - (if group - (gnus-group-decoded-name group) - (or (and from (or - (car (gnus-extract-address-components from)) - (cadr (gnus-extract-address-components from)))) - "(nowhere)")))) + (or group + (or (and from (or + (car (gnus-extract-address-components from)) + (cadr (gnus-extract-address-components from)))) + "(nowhere)")))) (concat "[" (if message-forward-decoded-p prefix @@ -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." (let* ((group (message-fetch-field "newsgroups")) (prefix - (if group - (gnus-group-decoded-name group) - (or (message-fetch-field "from") - "(nowhere)")))) + (or group + (or (message-fetch-field "from") + "(nowhere)")))) (concat "[" (if message-forward-decoded-p prefix diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 0bfecb28e09..f4a387b2a4b 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -367,7 +367,7 @@ for decoding when the cdr that the data specify is not available.") (with-current-buffer nntp-server-buffer (erase-buffer) (dolist (group groups) - (let ((elem (assoc-string (gnus-group-decoded-name group) nnrss-server-data))) + (let ((elem (assoc-string group nnrss-server-data))) (insert (format "%S %s 1 y\n" group (or (cadr elem) 0))))) 'active)) |