(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
(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.
(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-?]+\\)?:\
(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)
(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."
((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
"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))
(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))
;; 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))))
(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
;; `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))
(add-text-properties
(point) (prog1 (1+ (point))
(insert " *: "
- (gnus-group-decoded-name group)
+ group
"\n"))
(list 'gnus-group group
'gnus-unread t
(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)
projects / emacs.git / commitdiff