X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=e7bbf93ffa5d769807f5b0259a6576ba00d47441;hb=0d4863330c658e6ec43d6606e5bd0c33707a99de;hp=bd28d45ec9bbbbd136b7c0ac365f52cac228721e;hpb=8ab047431fe3e70c1e7669186cc5f6c14b5ca14a;p=gnus diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index bd28d45ec..e7bbf93ff 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1,5 +1,5 @@ ;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -26,7 +26,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (defvar tool-bar-map)) (require 'gnus) (require 'gnus-start) @@ -39,21 +41,29 @@ (require 'time-date) (require 'gnus-ems) -(eval-when-compile (require 'mm-url)) +(eval-when-compile + (require 'mm-url) + (let ((features (cons 'gnus-group features))) + (require 'gnus-sum)) + (unless (boundp 'gnus-cache-active-hashtb) + (defvar gnus-cache-active-hashtb nil))) + +(autoload 'gnus-agent-total-fetched-for "gnus-agent") +(autoload 'gnus-cache-total-fetched-for "gnus-cache") (defcustom gnus-group-archive-directory - "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" + "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" "*The address of the (ding) archives." :group 'gnus-group-foreign :type 'directory) (defcustom gnus-group-recent-archive-directory - "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" + "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" "*The address of the most recent (ding) articles." :group 'gnus-group-foreign :type 'directory) -(defcustom gnus-no-groups-message "No gnus is bad news" +(defcustom gnus-no-groups-message "No Gnus is good news" "*Message displayed by Gnus when no groups are available." :group 'gnus-start :type 'string) @@ -143,7 +153,7 @@ list." (function-item gnus-group-sort-by-rank) (function :tag "other" nil)))) -(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n" +(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%O\n" "*Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -171,15 +181,15 @@ with some simple extensions. %O Moderated group (string, \"(m)\" or \"\") %P Topic indentation (string) %m Whether there is new(ish) mail in the group (char, \"%\") -%l Whether there are GroupLens predictions for this group (string) %n Select from where (string) %z A string that look like `<%s:%n>' if a foreign select method is used %d The date the group was last entered. %E Icon as defined by `gnus-group-icon-list'. +%F The disk space used by the articles fetched by both the cache and agent. %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed a - single dummy parameter as argument.. The function should return a + where X is the letter following %u. The function will be passed a + single dummy parameter as argument. The function should return a string, which will be inserted into the buffer just like information from any other group specifier. @@ -190,10 +200,10 @@ output may end up looking strange when listing both alive and killed groups. If you use %o or %O, reading the active file will be slower and quite -a bit of extra memory will be used. %D will also worsen performance. -Also note that if you change the format specification to include any -of these specs, you must probably re-start Gnus to see them go into -effect. +a bit of extra memory will be used. %D and %F will also worsen +performance. Also note that if you change the format specification to +include any of these specs, you must probably re-start Gnus to see +them go into effect. General format specifiers can also be used. See Info node `(gnus)Formatting Variables'." @@ -418,7 +428,7 @@ For example: (defcustom gnus-group-name-charset-group-alist (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8)) - (and (fboundp 'coding-system-p) (coding-system-p 'utf-8))) + (mm-coding-system-p 'utf-8)) '((".*" . utf-8)) nil) "Alist of group regexp and the charset for group names. @@ -430,12 +440,20 @@ For example: (defcustom gnus-group-jump-to-group-prompt nil "Default prompt for `gnus-group-jump-to-group'. -If non-nil, the value should be a string, e.g. \"nnml:\", -in which case `gnus-group-jump-to-group' offers \"Group: nnml:\" -in the minibuffer prompt." + +If non-nil, the value should be a string or an alist. If it is a string, +e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group: +nnml:\" in the minibuffer prompt. + +If it is an alist, it must consist of \(NUMBER . PROMPT\) pairs, for example: +\((1 . \"\") (2 . \"nnfolder+archive:\")). The element with number 0 is +used when no prefix argument is given to `gnus-group-jump-to-group'." + :version "22.1" :group 'gnus-group-various :type '(choice (string :tag "Prompt string") - (const :tag "Empty" nil))) + (const :tag "Empty" nil) + (repeat (cons (integer :tag "Argument") + (string :tag "Prompt string"))))) (defvar gnus-group-listing-limit 1000 "*A limit of the number of groups when listing. @@ -479,24 +497,34 @@ simple manner.") (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) - (?g gnus-tmp-group ?s) + (?g (if (boundp 'gnus-tmp-decoded-group) + gnus-tmp-decoded-group + gnus-tmp-group) + ?s) (?G gnus-tmp-qualified-group ?s) - (?c (gnus-short-group-name gnus-tmp-group) ?s) + (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group) + gnus-tmp-decoded-group + gnus-tmp-group)) + ?s) (?C gnus-tmp-comment ?s) (?D gnus-tmp-newsgroup-description ?s) (?o gnus-tmp-moderated ?c) (?O gnus-tmp-moderated-string ?s) (?p gnus-tmp-process-marked ?c) (?s gnus-tmp-news-server ?s) - (?n gnus-tmp-news-method ?s) + (?n ,(if (featurep 'xemacs) + '(symbol-name gnus-tmp-news-method) + 'gnus-tmp-news-method) + ?s) (?P gnus-group-indentation ?s) (?E gnus-tmp-group-icon ?s) (?B gnus-tmp-summary-live ?c) - (?l gnus-tmp-grouplens ?s) (?z gnus-tmp-news-method-string ?s) (?m (gnus-group-new-mail gnus-tmp-group) ?c) (?d (gnus-group-timestamp-string gnus-tmp-group) ?s) - (?u gnus-tmp-user-defined ?s))) + (?u gnus-tmp-user-defined ?s) + (?F (gnus-total-fetched-for gnus-tmp-group) ?s) + )) (defvar gnus-group-mode-line-format-alist `((?S gnus-tmp-news-server ?s) @@ -526,211 +554,214 @@ simple manner.") (put 'gnus-group-mode 'mode-class 'special) -(when t - (gnus-define-keys gnus-group-mode-map - " " gnus-group-read-group - "=" gnus-group-select-group - "\r" gnus-group-select-group - "\M-\r" gnus-group-quick-select-group - "\M- " gnus-group-visible-select-group - [(meta control return)] gnus-group-select-group-ephemerally - "j" gnus-group-jump-to-group - "n" gnus-group-next-unread-group - "p" gnus-group-prev-unread-group - "\177" gnus-group-prev-unread-group - [delete] gnus-group-prev-unread-group - [backspace] gnus-group-prev-unread-group - "N" gnus-group-next-group - "P" gnus-group-prev-group - "\M-n" gnus-group-next-unread-group-same-level - "\M-p" gnus-group-prev-unread-group-same-level - "," gnus-group-best-unread-group - "." gnus-group-first-unread-group - "u" gnus-group-unsubscribe-current-group - "U" gnus-group-unsubscribe-group - "c" gnus-group-catchup-current - "C" gnus-group-catchup-current-all - "\M-c" gnus-group-clear-data - "l" gnus-group-list-groups - "L" gnus-group-list-all-groups - "m" gnus-group-mail - "i" gnus-group-news - "g" gnus-group-get-new-news - "\M-g" gnus-group-get-new-news-this-group - "R" gnus-group-restart - "r" gnus-group-read-init-file - "B" gnus-group-browse-foreign-server - "b" gnus-group-check-bogus-groups - "F" gnus-group-find-new-groups - "\C-c\C-d" gnus-group-describe-group - "\M-d" gnus-group-describe-all-groups - "\C-c\C-a" gnus-group-apropos - "\C-c\M-\C-a" gnus-group-description-apropos - "a" gnus-group-post-news - "\ek" gnus-group-edit-local-kill - "\eK" gnus-group-edit-global-kill - "\C-k" gnus-group-kill-group - "\C-y" gnus-group-yank-group - "\C-w" gnus-group-kill-region - "\C-x\C-t" gnus-group-transpose-groups - "\C-c\C-l" gnus-group-list-killed - "\C-c\C-x" gnus-group-expire-articles - "\C-c\M-\C-x" gnus-group-expire-all-groups - "V" gnus-version - "s" gnus-group-save-newsrc - "z" gnus-group-suspend - "q" gnus-group-exit - "Q" gnus-group-quit - "?" gnus-group-describe-briefly - "\C-c\C-i" gnus-info-find-node - "\M-e" gnus-group-edit-group-method - "^" gnus-group-enter-server-mode - gnus-mouse-2 gnus-mouse-pick-group - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-b" gnus-bug - "\C-c\C-s" gnus-group-sort-groups - "t" gnus-topic-mode - "\C-c\M-g" gnus-activate-all-groups - "\M-&" gnus-group-universal-argument - "#" gnus-group-mark-group - "\M-#" gnus-group-unmark-group) - - (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) - "m" gnus-group-mark-group - "u" gnus-group-unmark-group - "w" gnus-group-mark-region - "b" gnus-group-mark-buffer - "r" gnus-group-mark-regexp - "U" gnus-group-unmark-all-groups) - - (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map) - "u" gnus-sieve-update - "g" gnus-sieve-generate) - - (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) - "d" gnus-group-make-directory-group - "h" gnus-group-make-help-group - "u" gnus-group-make-useful-group - "a" gnus-group-make-archive-group - "k" gnus-group-make-kiboze-group - "l" gnus-group-nnimap-edit-acl - "m" gnus-group-make-group - "E" gnus-group-edit-group - "e" gnus-group-edit-group-method - "p" gnus-group-edit-group-parameters - "v" gnus-group-add-to-virtual - "V" gnus-group-make-empty-virtual - "D" gnus-group-enter-directory - "f" gnus-group-make-doc-group - "w" gnus-group-make-web-group - "r" gnus-group-rename-group - "c" gnus-group-customize - "x" gnus-group-nnimap-expunge - "\177" gnus-group-delete-group - [delete] gnus-group-delete-group) - - (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) - "b" gnus-group-brew-soup - "w" gnus-soup-save-areas - "s" gnus-soup-send-replies - "p" gnus-soup-pack-packet - "r" nnsoup-pack-replies) - - (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) - "s" gnus-group-sort-groups - "a" gnus-group-sort-groups-by-alphabet - "u" gnus-group-sort-groups-by-unread - "l" gnus-group-sort-groups-by-level - "v" gnus-group-sort-groups-by-score - "r" gnus-group-sort-groups-by-rank - "m" gnus-group-sort-groups-by-method - "n" gnus-group-sort-groups-by-real-name) - - (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) - "s" gnus-group-sort-selected-groups - "a" gnus-group-sort-selected-groups-by-alphabet - "u" gnus-group-sort-selected-groups-by-unread - "l" gnus-group-sort-selected-groups-by-level - "v" gnus-group-sort-selected-groups-by-score - "r" gnus-group-sort-selected-groups-by-rank - "m" gnus-group-sort-selected-groups-by-method - "n" gnus-group-sort-selected-groups-by-real-name) - - (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) - "k" gnus-group-list-killed - "z" gnus-group-list-zombies - "s" gnus-group-list-groups - "u" gnus-group-list-all-groups - "A" gnus-group-list-active - "a" gnus-group-apropos - "d" gnus-group-description-apropos - "m" gnus-group-list-matching - "M" gnus-group-list-all-matching - "l" gnus-group-list-level - "c" gnus-group-list-cached - "?" gnus-group-list-dormant) - - (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) - "k" gnus-group-list-limit - "z" gnus-group-list-limit - "s" gnus-group-list-limit - "u" gnus-group-list-limit - "A" gnus-group-list-limit - "m" gnus-group-list-limit - "M" gnus-group-list-limit - "l" gnus-group-list-limit - "c" gnus-group-list-limit - "?" gnus-group-list-limit) - - (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map) - "k" gnus-group-list-flush - "z" gnus-group-list-flush - "s" gnus-group-list-flush - "u" gnus-group-list-flush - "A" gnus-group-list-flush - "m" gnus-group-list-flush - "M" gnus-group-list-flush - "l" gnus-group-list-flush - "c" gnus-group-list-flush - "?" gnus-group-list-flush) - - (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map) - "k" gnus-group-list-plus - "z" gnus-group-list-plus - "s" gnus-group-list-plus - "u" gnus-group-list-plus - "A" gnus-group-list-plus - "m" gnus-group-list-plus - "M" gnus-group-list-plus - "l" gnus-group-list-plus - "c" gnus-group-list-plus - "?" gnus-group-list-plus) - - (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) - "f" gnus-score-flush-cache) - - (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "c" gnus-group-fetch-charter - "C" gnus-group-fetch-control - "d" gnus-group-describe-group - "f" gnus-group-fetch-faq - "v" gnus-version) - - (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) - "l" gnus-group-set-current-level - "t" gnus-group-unsubscribe-current-group - "s" gnus-group-unsubscribe-group - "k" gnus-group-kill-group - "y" gnus-group-yank-group - "w" gnus-group-kill-region - "\C-k" gnus-group-kill-level - "z" gnus-group-kill-all-zombies)) +(gnus-define-keys gnus-group-mode-map + " " gnus-group-read-group + "=" gnus-group-select-group + "\r" gnus-group-select-group + "\M-\r" gnus-group-quick-select-group + "\M- " gnus-group-visible-select-group + [(meta control return)] gnus-group-select-group-ephemerally + "j" gnus-group-jump-to-group + "n" gnus-group-next-unread-group + "p" gnus-group-prev-unread-group + "\177" gnus-group-prev-unread-group + [delete] gnus-group-prev-unread-group + [backspace] gnus-group-prev-unread-group + "N" gnus-group-next-group + "P" gnus-group-prev-group + "\M-n" gnus-group-next-unread-group-same-level + "\M-p" gnus-group-prev-unread-group-same-level + "," gnus-group-best-unread-group + "." gnus-group-first-unread-group + "u" gnus-group-unsubscribe-current-group + "U" gnus-group-unsubscribe-group + "c" gnus-group-catchup-current + "C" gnus-group-catchup-current-all + "\M-c" gnus-group-clear-data + "l" gnus-group-list-groups + "L" gnus-group-list-all-groups + "m" gnus-group-mail + "i" gnus-group-news + "g" gnus-group-get-new-news + "\M-g" gnus-group-get-new-news-this-group + "R" gnus-group-restart + "r" gnus-group-read-init-file + "B" gnus-group-browse-foreign-server + "b" gnus-group-check-bogus-groups + "F" gnus-group-find-new-groups + "\C-c\C-d" gnus-group-describe-group + "\M-d" gnus-group-describe-all-groups + "\C-c\C-a" gnus-group-apropos + "\C-c\M-\C-a" gnus-group-description-apropos + "a" gnus-group-post-news + "\ek" gnus-group-edit-local-kill + "\eK" gnus-group-edit-global-kill + "\C-k" gnus-group-kill-group + "\C-y" gnus-group-yank-group + "\C-w" gnus-group-kill-region + "\C-x\C-t" gnus-group-transpose-groups + "\C-c\C-l" gnus-group-list-killed + "\C-c\C-x" gnus-group-expire-articles + "\C-c\M-\C-x" gnus-group-expire-all-groups + "V" gnus-version + "s" gnus-group-save-newsrc + "z" gnus-group-suspend + "q" gnus-group-exit + "Q" gnus-group-quit + "?" gnus-group-describe-briefly + "\C-c\C-i" gnus-info-find-node + "\M-e" gnus-group-edit-group-method + "^" gnus-group-enter-server-mode + gnus-mouse-2 gnus-mouse-pick-group + [follow-link] mouse-face + "<" beginning-of-buffer + ">" end-of-buffer + "\C-c\C-b" gnus-bug + "\C-c\C-s" gnus-group-sort-groups + "t" gnus-topic-mode + "\C-c\M-g" gnus-activate-all-groups + "\M-&" gnus-group-universal-argument + "#" gnus-group-mark-group + "\M-#" gnus-group-unmark-group) + +(gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) + "m" gnus-group-mark-group + "u" gnus-group-unmark-group + "w" gnus-group-mark-region + "b" gnus-group-mark-buffer + "r" gnus-group-mark-regexp + "U" gnus-group-unmark-all-groups) + +(gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map) + "u" gnus-sieve-update + "g" gnus-sieve-generate) + +(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) + "d" gnus-group-make-directory-group + "h" gnus-group-make-help-group + "u" gnus-group-make-useful-group + "a" gnus-group-make-archive-group + "k" gnus-group-make-kiboze-group + "l" gnus-group-nnimap-edit-acl + "m" gnus-group-make-group + "E" gnus-group-edit-group + "e" gnus-group-edit-group-method + "p" gnus-group-edit-group-parameters + "v" gnus-group-add-to-virtual + "V" gnus-group-make-empty-virtual + "D" gnus-group-enter-directory + "f" gnus-group-make-doc-group + "w" gnus-group-make-web-group + "M" gnus-group-read-ephemeral-group + "r" gnus-group-rename-group + "R" gnus-group-make-rss-group + "c" gnus-group-customize + "x" gnus-group-nnimap-expunge + "\177" gnus-group-delete-group + [delete] gnus-group-delete-group) + +(gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) + "b" gnus-group-brew-soup + "w" gnus-soup-save-areas + "s" gnus-soup-send-replies + "p" gnus-soup-pack-packet + "r" nnsoup-pack-replies) + +(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) + "s" gnus-group-sort-groups + "a" gnus-group-sort-groups-by-alphabet + "u" gnus-group-sort-groups-by-unread + "l" gnus-group-sort-groups-by-level + "v" gnus-group-sort-groups-by-score + "r" gnus-group-sort-groups-by-rank + "m" gnus-group-sort-groups-by-method + "n" gnus-group-sort-groups-by-real-name) + +(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) + "s" gnus-group-sort-selected-groups + "a" gnus-group-sort-selected-groups-by-alphabet + "u" gnus-group-sort-selected-groups-by-unread + "l" gnus-group-sort-selected-groups-by-level + "v" gnus-group-sort-selected-groups-by-score + "r" gnus-group-sort-selected-groups-by-rank + "m" gnus-group-sort-selected-groups-by-method + "n" gnus-group-sort-selected-groups-by-real-name) + +(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) + "k" gnus-group-list-killed + "z" gnus-group-list-zombies + "s" gnus-group-list-groups + "u" gnus-group-list-all-groups + "A" gnus-group-list-active + "a" gnus-group-apropos + "d" gnus-group-description-apropos + "m" gnus-group-list-matching + "M" gnus-group-list-all-matching + "l" gnus-group-list-level + "c" gnus-group-list-cached + "?" gnus-group-list-dormant) + +(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) + "k" gnus-group-list-limit + "z" gnus-group-list-limit + "s" gnus-group-list-limit + "u" gnus-group-list-limit + "A" gnus-group-list-limit + "m" gnus-group-list-limit + "M" gnus-group-list-limit + "l" gnus-group-list-limit + "c" gnus-group-list-limit + "?" gnus-group-list-limit) + +(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map) + "k" gnus-group-list-flush + "z" gnus-group-list-flush + "s" gnus-group-list-flush + "u" gnus-group-list-flush + "A" gnus-group-list-flush + "m" gnus-group-list-flush + "M" gnus-group-list-flush + "l" gnus-group-list-flush + "c" gnus-group-list-flush + "?" gnus-group-list-flush) + +(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map) + "k" gnus-group-list-plus + "z" gnus-group-list-plus + "s" gnus-group-list-plus + "u" gnus-group-list-plus + "A" gnus-group-list-plus + "m" gnus-group-list-plus + "M" gnus-group-list-plus + "l" gnus-group-list-plus + "c" gnus-group-list-plus + "?" gnus-group-list-plus) + +(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) + "f" gnus-score-flush-cache + "e" gnus-score-edit-all-score) + +(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) + "c" gnus-group-fetch-charter + "C" gnus-group-fetch-control + "d" gnus-group-describe-group + "f" gnus-group-fetch-faq + "v" gnus-version) + +(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) + "l" gnus-group-set-current-level + "t" gnus-group-unsubscribe-current-group + "s" gnus-group-unsubscribe-group + "k" gnus-group-kill-group + "y" gnus-group-yank-group + "w" gnus-group-kill-region + "\C-k" gnus-group-kill-level + "z" gnus-group-kill-all-zombies) (defun gnus-topic-mode-p () "Return non-nil in `gnus-topic-mode'." - (and (boundp 'gnus-topic-mode) - gnus-topic-mode)) + (and (boundp 'gnus-topic-mode) + (symbol-value 'gnus-topic-mode))) (defun gnus-group-make-menu-bar () (gnus-turn-off-edit-menu 'group) @@ -747,7 +778,7 @@ simple manner.") ["Select" gnus-group-select-group :included (not (gnus-topic-mode-p)) :active (gnus-group-group-name)] - ["Select " gnus-topic-select-group + ["Select " gnus-topic-select-group :included (gnus-topic-mode-p)] ["See old articles" (gnus-group-select-group 'all) :keys "C-u SPC" :active (gnus-group-group-name)] @@ -756,7 +787,7 @@ simple manner.") :active (gnus-group-group-name) ,@(if (featurep 'xemacs) nil '(:help "Mark unread articles in the current group as read"))] - ["Catch up " gnus-topic-catchup-articles + ["Catch up " gnus-topic-catchup-articles :included (gnus-topic-mode-p) ,@(if (featurep 'xemacs) nil '(:help "Mark unread articles in the current group or topic as read"))] @@ -791,13 +822,13 @@ simple manner.") '(:help "Display the archived control message for the current group"))] ;; Actually one should check, if any of the marked groups gives t for ;; (gnus-check-backend-function 'request-expire-articles ...) - ["Expire articles" gnus-group-expire-articles + ["Expire articles" gnus-group-expire-articles :included (not (gnus-topic-mode-p)) :active (or (and (gnus-group-group-name) (gnus-check-backend-function 'request-expire-articles (gnus-group-group-name))) gnus-group-marked)] - ["Expire articles " gnus-topic-expire-articles + ["Expire articles " gnus-topic-expire-articles :included (gnus-topic-mode-p)] ["Set group level..." gnus-group-set-current-level (gnus-group-group-name)] @@ -888,6 +919,8 @@ simple manner.") ["Make a kiboze group..." gnus-group-make-kiboze-group t] ["Make a virtual group..." gnus-group-make-empty-virtual t] ["Add a group to a virtual..." gnus-group-add-to-virtual t] + ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] + ["Make an RSS group..." gnus-group-make-rss-group t] ["Rename group..." gnus-group-rename-group (gnus-check-backend-function 'request-rename-group (gnus-group-group-name))] @@ -1018,7 +1051,8 @@ The following commands are available: (use-local-map gnus-group-mode-map) (buffer-disable-undo) (setq truncate-lines t) - (setq buffer-read-only t) + (setq buffer-read-only t + show-trailing-whitespace nil) (gnus-set-default-directory) (gnus-update-format-specifications nil 'group 'group-mode) (gnus-update-group-mark-positions) @@ -1040,7 +1074,8 @@ The following commands are available: (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) (goto-char (point-min)) (setq gnus-group-mark-positions - (list (cons 'process (and (search-forward "\200" nil t) + (list (cons 'process (and (search-forward + (mm-string-as-multibyte "\200") nil t) (- (point) 2)))))))) (defun gnus-mouse-pick-group (e) @@ -1088,6 +1123,7 @@ The following commands are available: result))) (defun gnus-group-name-decode (string charset) + ;; Fixme: Don't decode in unibyte mode. (if (and string charset (featurep 'mule)) (mm-decode-coding-string string charset) string)) @@ -1117,7 +1153,7 @@ Also see the `gnus-group-use-permanent-levels' variable." (gnus-group-setup-buffer) (gnus-update-format-specifications nil 'group 'group-mode) (let ((case-fold-search nil) - (props (text-properties-at (gnus-point-at-bol))) + (props (text-properties-at (point-at-bol))) (empty (= (point-min) (point-max))) (group (gnus-group-group-name)) number) @@ -1149,7 +1185,7 @@ Also see the `gnus-group-use-permanent-levels' variable." (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) - (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) + (let ((newsrc (cdddr (gnus-group-entry group)))) (while (and newsrc (not (gnus-goto-char (text-property-any @@ -1204,7 +1240,7 @@ if it is a string, only list groups matching REGEXP." group (gnus-info-group info) params (gnus-info-params info) newsrc (cdr newsrc) - unread (car (gnus-gethash group gnus-newsrc-hashtb))) + unread (gnus-group-unread group)) (when not-in-list (setq not-in-list (delete group not-in-list))) (when (gnus-group-prepare-logic @@ -1304,7 +1340,7 @@ if it is a string, only list groups matching REGEXP." "Update the current line in the group buffer." (let* ((buffer-read-only nil) (group (gnus-group-group-name)) - (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) + (entry (and group (gnus-group-entry group))) gnus-group-indentation) (when group (and entry @@ -1321,7 +1357,7 @@ if it is a string, only list groups matching REGEXP." (defun gnus-group-insert-group-line-info (group) "Insert GROUP on the current line." - (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) + (let ((entry (gnus-group-entry group)) (gnus-group-indentation (gnus-group-group-indentation)) active info) (if entry @@ -1383,7 +1419,7 @@ if it is a string, only list groups matching REGEXP." (gnus-tmp-qualified-group (gnus-group-name-decode (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) gnus-tmp-group)) (gnus-tmp-newsgroup-description @@ -1418,10 +1454,6 @@ if it is a string, only list groups matching REGEXP." (gnus-tmp-process-marked (if (member gnus-tmp-group gnus-group-marked) gnus-process-mark ? )) - (gnus-tmp-grouplens - (or (and gnus-use-grouplens - (bbb-grouplens-group-p gnus-tmp-group)) - "")) (buffer-read-only nil) header gnus-tmp-header) ; passed as parameter to user-funcs. (beginning-of-line) @@ -1429,8 +1461,8 @@ if it is a string, only list groups matching REGEXP." (point) (prog1 (1+ (point)) ;; Insert the text. - (let ((gnus-tmp-group (gnus-group-name-decode - gnus-tmp-group group-name-charset))) + (let ((gnus-tmp-decoded-group (gnus-group-name-decode + gnus-tmp-group group-name-charset))) (eval gnus-group-line-format-spec))) `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) gnus-unread ,(if (numberp number) @@ -1450,7 +1482,7 @@ if it is a string, only list groups matching REGEXP." "Highlight the current line according to `gnus-group-highlight'." (let* ((list gnus-group-highlight) (p (point)) - (end (progn (end-of-line) (point))) + (end (point-at-eol)) ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point))) (group (gnus-group-group-name)) @@ -1459,7 +1491,7 @@ if it is a string, only list groups matching REGEXP." (active (gnus-active group)) (total (if active (1+ (- (cdr active) (car active))) 0)) (info (nth 2 entry)) - (method (gnus-server-get-method group (gnus-info-method info))) + (method (inline (gnus-server-get-method group (gnus-info-method info)))) (marked (gnus-info-marks info)) (mailp (apply 'append (mapcar @@ -1501,7 +1533,7 @@ already." (loc (point-min)) found buffer-read-only) ;; Enter the current status into the dribble buffer. - (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) + (let ((entry (gnus-group-entry group))) (when (and entry (not (gnus-ephemeral-group-p group))) (gnus-dribble-enter @@ -1526,7 +1558,7 @@ already." ;; go, and insert it there (or at the end of the buffer). (if gnus-goto-missing-group-function (funcall gnus-goto-missing-group-function group) - (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) + (let ((entry (cddr (gnus-group-entry group)))) (while (and entry (car entry) (not (gnus-goto-char @@ -1586,24 +1618,24 @@ already." (defun gnus-group-group-name () "Get the name of the newsgroup on the current line." - (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) + (let ((group (get-text-property (point-at-bol) 'gnus-group))) (when group (symbol-name group)))) (defun gnus-group-group-level () "Get the level of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-level)) + (get-text-property (point-at-bol) 'gnus-level)) (defun gnus-group-group-indentation () "Get the indentation of the newsgroup on the current line." - (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) + (or (get-text-property (point-at-bol) 'gnus-indentation) (and gnus-group-indentation-function (funcall gnus-group-indentation-function)) "")) (defun gnus-group-group-unread () "Get the number of unread articles of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-unread)) + (get-text-property (point-at-bol) 'gnus-unread)) (defun gnus-group-new-mail (group) (if (nnmail-new-mail-p (gnus-group-real-name group)) @@ -1661,6 +1693,18 @@ If FIRST-TOO, the current line is also eligible as a target." (goto-char (or pos beg)) (and pos t)))) +(defun gnus-total-fetched-for (group) + (let* ((size-in-cache (or (gnus-cache-total-fetched-for group) 0)) + (size-in-agent (or (gnus-agent-total-fetched-for group) 0)) + (size (+ size-in-cache size-in-agent)) + (suffix '("B" "K" "M" "G")) + (scale 1024.0) + (cutoff (* 10 scale))) + (while (> size cutoff) + (setq size (/ size scale) + suffix (cdr suffix))) + (format "%5.1f%s" size (car suffix)))) + ;;; Gnus group mode commands ;; Group marking. @@ -1682,15 +1726,14 @@ If FIRST-TOO, the current line is also eligible as a target." ;; Go to the mark position. (beginning-of-line) (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) - (subst-char-in-region - (point) (1+ (point)) (char-after) - (if unmark - (progn - (setq gnus-group-marked (delete group gnus-group-marked)) - ? ) + (delete-char 1) + (if unmark + (progn + (setq gnus-group-marked (delete group gnus-group-marked)) + (insert-char ? 1 t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))) - gnus-process-mark))) + (insert-char gnus-process-mark 1 t))) (unless no-advance (gnus-group-next-group 1)) (decf n)) @@ -1706,10 +1749,8 @@ If FIRST-TOO, the current line is also eligible as a target." (defun gnus-group-unmark-all-groups () "Unmark all groups." (interactive) - (let ((groups gnus-group-marked)) - (save-excursion - (while groups - (gnus-group-remove-mark (pop groups))))) + (save-excursion + (mapc 'gnus-group-remove-mark gnus-group-marked)) (gnus-group-position-point)) (defun gnus-group-mark-region (unmark beg end) @@ -1732,9 +1773,11 @@ If UNMARK, remove the mark instead." (interactive "sMark (regexp): ") (let ((alist (cdr gnus-newsrc-alist)) group) - (while alist - (when (string-match regexp (setq group (gnus-info-group (pop alist)))) - (gnus-group-set-mark group)))) + (save-excursion + (while alist + (when (string-match regexp (setq group (gnus-info-group (pop alist)))) + (gnus-group-jump-to-group group) + (gnus-group-set-mark group))))) (gnus-group-position-point)) (defun gnus-group-remove-mark (group &optional test-marked) @@ -1853,8 +1896,7 @@ group." (unless group (error "No group on current line")) (setq marked (gnus-info-marks - (nth 2 (setq entry (gnus-gethash - group gnus-newsrc-hashtb))))) + (nth 2 (setq entry (gnus-group-entry group))))) ;; This group might be a dead group. In that case we have to get ;; the number of unread articles from `gnus-active-hashtb'. (setq number @@ -1875,7 +1917,10 @@ group." No article is selected automatically. If the group is opened, just switch the summary buffer. If ALL is non-nil, already read articles become readable. -If ALL is a number, fetch this number of articles." +If ALL is a positive number, fetch this number of the latest +articles in the group. +If ALL is a negative number, fetch this number of the earliest +articles in the group." (interactive "P") (when (and (eobp) (not (gnus-group-group-name))) (forward-line -1)) @@ -1944,6 +1989,27 @@ Returns whether the fetching was successful or not." (defvar gnus-ephemeral-group-server 0) +(defcustom gnus-large-ephemeral-newsgroup 200 + "The number of articles which indicates a large ephemeral newsgroup. +Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups. + +If the number of articles in a newsgroup is greater than this value, +confirmation is required for selecting the newsgroup. If it is nil, no +confirmation is required." + :version "22.1" + :group 'gnus-group-select + :type '(choice (const :tag "No limit" nil) + integer)) + +(defcustom gnus-fetch-old-ephemeral-headers nil + "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups." + :version "22.1" + :group 'gnus-thread + :type '(choice (const :tag "off" nil) + (const some) + number + (sexp :menu-tag "other" t))) + ;; Enter a group that is not in the group buffer. Non-nil is returned ;; if selection was successful. (defun gnus-group-read-ephemeral-group (group method &optional activate @@ -1959,6 +2025,14 @@ If SELECT-ARTICLES, only select those articles. If PARAMETERS, use those as the group parameters. Return the name of the group if selection was successful." + (interactive + (list + ;; (gnus-read-group "Group name: ") + (completing-read + "Group: " gnus-active-hashtb + nil nil nil + 'gnus-group-history) + (gnus-read-method "From method: "))) ;; Transform the select method into a unique server. (when (stringp method) (setq method (gnus-server-to-method method))) @@ -1993,21 +2067,32 @@ Return the name of the group if selection was successful." (if request-only group (condition-case () - (when (gnus-group-read-group t t group select-articles) + (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup) + (gnus-fetch-old-headers + gnus-fetch-old-ephemeral-headers)) + (gnus-group-read-group t t group select-articles)) group) ;;(error nil) (quit (message "Quit reading the ephemeral group") nil))))) -(defun gnus-group-jump-to-group (group) - "Jump to newsgroup GROUP." +(defun gnus-group-jump-to-group (group &optional prompt) + "Jump to newsgroup GROUP. + +If PROMPT (the prefix) is a number, use the prompt specified in +`gnus-group-jump-to-group-prompt'." (interactive (list (mm-string-make-unibyte (completing-read "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) - gnus-group-jump-to-group-prompt + (if current-prefix-arg + (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt)) + (or (and (stringp gnus-group-jump-to-group-prompt) + gnus-group-jump-to-group-prompt) + (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt)))) + (and (stringp p) p)))) 'gnus-group-history)))) (when (equal group "") @@ -2177,6 +2262,16 @@ If EXCLUDE-GROUP, do not go to that group." (interactive) (gnus-enter-server-buffer)) +(defun gnus-group-make-group-simple (&optional group) + "Add a new newsgroup. +The user will be prompted for GROUP." + (interactive + (list (completing-read "Group: " gnus-active-hashtb + nil nil nil 'gnus-group-history))) + (gnus-group-make-group + (gnus-group-real-name group) + (gnus-group-server group))) + (defun gnus-group-make-group (name &optional method address args) "Add a new newsgroup. The user will be prompted for a NAME, for a select METHOD, and an @@ -2195,15 +2290,14 @@ ADDRESS." method)))) (nname (if method (gnus-group-prefixed-name name meth) name)) backend info) - (when (gnus-gethash nname gnus-newsrc-hashtb) - (error "Group %s already exists" nname)) + (when (gnus-group-entry nname) + (error "Group %s already exists" (gnus-group-decoded-name nname))) ;; Subscribe to the new group. (gnus-group-change-level (setq info (list t nname gnus-level-default-subscribed nil nil meth)) gnus-level-default-subscribed gnus-level-killed (and (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) - gnus-newsrc-hashtb)) + (gnus-group-entry (gnus-group-group-name))) t) ;; Make it active. (gnus-set-active nname (cons 1 0)) @@ -2216,7 +2310,7 @@ ADDRESS." (forward-line -1) (gnus-group-position-point) - ;; Load the backend and try to make the backend create + ;; Load the back end and try to make the back end create ;; the group as well. (when (assoc (symbol-name (setq backend (car (gnus-server-get-method nil meth)))) @@ -2245,34 +2339,33 @@ ADDRESS." "Delete the current group. Only meaningful with editable groups. If FORCE (the prefix) is non-nil, all the articles in the group will be deleted. This is \"deleted\" as in \"removed forever from the face -of the Earth\". There is no undo. The user will be prompted before -doing the deletion." +of the Earth\". There is no undo. The user will be prompted before +doing the deletion. +Note that you also have to specify FORCE if you want the group to +be removed from the server, even when it's empty." (interactive (list (gnus-group-group-name) current-prefix-arg)) (unless group (error "No group to delete")) (unless (gnus-check-backend-function 'request-delete-group group) - (error "This backend does not support group deletion")) + (error "This back end does not support group deletion")) (prog1 - (if (and (not no-prompt) - (not (gnus-yes-or-no-p - (format - "Do you really want to delete %s%s? " - group (if force " and all its contents" ""))))) - () ; Whew! - (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-sethash group nil gnus-active-hashtb) - (when (and (boundp 'gnus-cache-active-hashtb) - gnus-cache-active-hashtb) - (gnus-sethash group nil gnus-cache-active-hashtb) - (setq gnus-cache-active-altered t)) - t)) + (let ((group-decoded (gnus-group-decoded-name group))) + (if (and (not no-prompt) + (not (gnus-yes-or-no-p + (format + "Do you really want to delete %s%s? " + group-decoded (if force " and all its contents" ""))))) + () ; Whew! + (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))) (gnus-group-position-point))) (defun gnus-group-rename-group (group new-name) @@ -2285,12 +2378,12 @@ and NEW-NAME will be prompted for." (progn (unless (gnus-check-backend-function 'request-rename-group (gnus-group-group-name)) - (error "This backend does not support renaming groups")) + (error "This back end does not support renaming groups")) (gnus-read-group "Rename group to: " (gnus-group-real-name (gnus-group-group-name)))))) (unless (gnus-check-backend-function 'request-rename-group group) - (error "This backend does not support renaming groups")) + (error "This back end does not support renaming groups")) (unless group (error "No group to rename")) (when (equal (gnus-group-real-name group) new-name) @@ -2306,6 +2399,9 @@ and NEW-NAME will be prompted for." (gnus-group-real-name new-name) (gnus-info-method (gnus-get-info group))))) + (when (gnus-active new-name) + (error "The group %s already exists" new-name)) + (gnus-message 6 "Renaming group %s to %s..." group new-name) (prog1 (if (progn @@ -2435,7 +2531,7 @@ group already exists: (interactive) (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) (file (nnheader-find-etc-directory "gnus-tut.txt" t))) - (if (gnus-gethash name gnus-newsrc-hashtb) + (if (gnus-group-entry name) (cond ((eq noerror nil) (error "Documentation group already exists")) ((eq noerror t) @@ -2455,7 +2551,9 @@ group already exists: (gnus-group-position-point)) (defun gnus-group-make-doc-group (file type) - "Create a group that uses a single file as the source." + "Create a group that uses a single file as the source. + +If called with a prefix argument, ask for the file type." (interactive (list (read-file-name "File name: ") (and current-prefix-arg 'ask))) @@ -2464,7 +2562,7 @@ group already exists: char found) (while (not found) (message - "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: " + "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: " err) (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) ((= char ?b) 'babyl) @@ -2524,6 +2622,42 @@ If SOLID (the prefix), create a solid group." (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) +(eval-when-compile + (defvar nnrss-group-alist) + (defun nnrss-discover-feed (arg)) + (defun nnrss-save-server-data (arg))) +(defun gnus-group-make-rss-group (&optional url) + "Given a URL, discover if there is an RSS feed. +If there is, use Gnus to create an nnrss group" + (interactive) + (require 'nnrss) + (if (not url) + (setq url (read-from-minibuffer "URL to Search for RSS: "))) + (let ((feedinfo (nnrss-discover-feed url))) + (if feedinfo + (let ((title (gnus-newsgroup-savable-name + (read-from-minibuffer "Title: " + (gnus-newsgroup-savable-name + (or (cdr (assoc 'title + feedinfo)) + ""))))) + (desc (read-from-minibuffer "Description: " + (cdr (assoc 'description + feedinfo)))) + (href (cdr (assoc 'href feedinfo))) + (encodable (mm-coding-system-p 'utf-8))) + (when encodable + ;; Unify non-ASCII text. + (setq title (mm-decode-coding-string + (mm-encode-coding-string title 'utf-8) 'utf-8))) + (gnus-group-make-group (if encodable + (mm-encode-coding-string title 'utf-8) + title) + '(nnrss "")) + (push (list title href desc) nnrss-group-alist) + (nnrss-save-server-data nil)) + (error "No feeds found for %s" url)))) + (defvar nnwarchive-type-definition) (defvar gnus-group-warchive-type-history nil) (defvar gnus-group-warchive-login-history nil) @@ -2566,7 +2700,7 @@ Given a prefix, create a full group." (interactive "P") (let ((group (gnus-group-prefixed-name (if all "ding.archives" "ding.recent") '(nndir "")))) - (when (gnus-gethash group gnus-newsrc-hashtb) + (when (gnus-group-entry group) (error "Archive group already exists")) (gnus-group-make-group (gnus-group-real-name group) @@ -2590,7 +2724,7 @@ mail messages or news articles in files that have numeric names." (let ((ext "") (i 0) group) - (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) + (while (or (not group) (gnus-group-entry group)) (setq group (gnus-group-prefixed-name (expand-file-name ext dir) @@ -2600,7 +2734,7 @@ mail messages or news articles in files that have numeric names." (gnus-group-real-name group) (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) -(eval-when-compile (defvar nnkiboze-score-file)) +(defvar nnkiboze-score-file) (defun gnus-group-make-kiboze-group (group address scores) "Create an nnkiboze group. The user will be prompted for a name, a regexp to match groups, and @@ -2609,7 +2743,7 @@ score file entries for articles to include in the group." (list (read-string "nnkiboze group name: ") (read-string "Source groups (regexp): ") - (let ((headers (mapcar (lambda (group) (list group)) + (let ((headers (mapcar 'list '("subject" "from" "number" "date" "message-id" "references" "chars" "lines" "xref" "followup" "all" "body" "head"))) @@ -2631,7 +2765,7 @@ score file entries for articles to include in the group." (make-directory score-dir)) (with-temp-file score-file (let (emacs-lisp-mode-hook) - (pp scores (current-buffer)))))) + (gnus-pp scores))))) (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." @@ -2660,7 +2794,7 @@ score file entries for articles to include in the group." (let* ((method (list 'nnvirtual "^$")) (pgroup (gnus-group-prefixed-name group method))) ;; Check whether it exists already. - (when (gnus-gethash pgroup gnus-newsrc-hashtb) + (when (gnus-group-entry pgroup) (error "Group %s already exists" pgroup)) ;; Subscribe the new group after the group on the current line. (gnus-subscribe-group pgroup (gnus-group-group-name) method) @@ -2805,7 +2939,7 @@ If REVERSE, sort in reverse order." (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) (defun gnus-group-sort-groups-by-method (&optional reverse) - "Sort the group buffer alphabetically by backend name. + "Sort the group buffer alphabetically by back end name. If REVERSE, sort in reverse order." (interactive "P") (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) @@ -2832,7 +2966,7 @@ If REVERSE, sort in reverse order." (let (entries infos) ;; First find all the group entries for these groups. (while groups - (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb)) + (push (nthcdr 2 (gnus-group-entry (pop groups))) entries)) ;; Then sort the infos. (setq infos @@ -2894,7 +3028,7 @@ sort in reverse order." (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse)) (defun gnus-group-sort-selected-groups-by-method (&optional n reverse) - "Sort the group buffer alphabetically by backend name. + "Sort the group buffer alphabetically by back end name. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." (interactive (gnus-interactive "P\ny")) @@ -2913,8 +3047,8 @@ sort in reverse order." (defun gnus-group-sort-by-unread (info1 info2) "Sort by number of unread articles." - (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) - (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) + (let ((n1 (gnus-group-unread (gnus-info-group info1))) + (n2 (gnus-group-unread (gnus-info-group info1)))) (< (or (and (numberp n1) n1) 0) (or (and (numberp n2) n2) 0)))) @@ -2923,7 +3057,7 @@ sort in reverse order." (< (gnus-info-level info1) (gnus-info-level info2))) (defun gnus-group-sort-by-method (info1 info2) - "Sort alphabetically by backend name." + "Sort alphabetically by back end name." (string< (car (gnus-find-method-for-group (gnus-info-group info1) info1)) (car (gnus-find-method-for-group @@ -3023,7 +3157,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) - (car groups) + (gnus-group-decoded-name (car groups)) (format "these %d groups" (length groups))))))) n (while (setq group (pop groups)) @@ -3054,10 +3188,10 @@ Cross references (Xref: header) of articles are ignored." If ALL is non-nil, all articles are marked as read. The return value is the number of articles that were marked as read, or nil if no action could be taken." - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) + (let* ((entry (gnus-group-entry group)) (num (car entry)) - (marks (nth 3 (nth 2 entry))) - (unread (gnus-list-of-unread-articles group))) + (marks (gnus-info-marks (nth 2 entry))) + (unread (gnus-sequence-of-unread-articles group))) ;; Remove entries for this group. (nnmail-purge-split-history (gnus-group-real-name group)) ;; Do the updating only if the newsgroup isn't killed. @@ -3070,16 +3204,17 @@ or nil if no action could be taken." 'del '(tick)) (list (cdr (assq 'dormant marks)) 'del '(dormant)))) - (setq unread (gnus-uncompress-range - (gnus-range-add (gnus-range-add - unread (cdr (assq 'dormant marks))) - (cdr (assq 'tick marks))))) + (setq unread (gnus-range-add (gnus-range-add + unread (cdr (assq 'dormant marks))) + (cdr (assq 'tick marks)))) (gnus-add-marked-articles group 'tick nil nil 'force) (gnus-add-marked-articles group 'dormant nil nil 'force)) ;; Do auto-expirable marks if that's required. (when (gnus-group-auto-expirable-p group) - (gnus-add-marked-articles group 'expire unread) - (gnus-request-set-mark group (list (list unread 'add '(expire))))) + (gnus-range-map (lambda (article) + (gnus-add-marked-articles group 'expire (list article)) + (gnus-request-set-mark group (list (list (list article) 'add '(expire))))) + unread)) (let ((gnus-newsgroup-name group)) (gnus-run-hooks 'gnus-group-catchup-group-hook)) num))) @@ -3100,7 +3235,8 @@ 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..." group) + (gnus-message 6 "Expiring articles in %s..." + (gnus-group-decoded-name group)) (let* ((info (gnus-get-info group)) (expirable (if (gnus-group-total-expirable-p group) (cons nil (gnus-list-of-read-articles group)) @@ -3125,7 +3261,8 @@ Uses the process/prefix convention." (gnus-request-expire-articles (gnus-uncompress-sequence (cdr expirable)) group)))) (gnus-close-group group)) - (gnus-message 6 "Expiring articles in %s...done" group) + (gnus-message 6 "Expiring articles in %s...done" + (gnus-group-decoded-name group)) ;; Return the list of un-expired articles. (cdr expirable)))) @@ -3145,27 +3282,29 @@ Uses the process/prefix convention." (interactive (list current-prefix-arg - (string-to-int - (let ((s (read-string - (format "Level (default %s): " - (or (gnus-group-group-level) - gnus-level-default-subscribed))))) - (if (string-match "^\\s-*$" s) - (int-to-string (or (gnus-group-group-level) - gnus-level-default-subscribed)) - s))))) + (progn + (unless (gnus-group-process-prefix current-prefix-arg) + (error "No group on the current line")) + (string-to-int + (let ((s (read-string + (format "Level (default %s): " + (or (gnus-group-group-level) + gnus-level-default-subscribed))))) + (if (string-match "^\\s-*$" s) + (int-to-string (or (gnus-group-group-level) + gnus-level-default-subscribed)) + s)))))) (unless (and (>= level 1) (<= level gnus-level-killed)) (error "Invalid level: %d" level)) - (let ((groups (gnus-group-process-prefix n)) - group) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (gnus-message 6 "Changed level of %s from %d to %d" - group (or (gnus-group-group-level) gnus-level-killed) - level) - (gnus-group-change-level - group level (or (gnus-group-group-level) gnus-level-killed)) - (gnus-group-update-group-line))) + (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) + (or (gnus-group-group-level) gnus-level-killed) + level) + (gnus-group-change-level + group level (or (gnus-group-group-level) gnus-level-killed)) + (gnus-group-update-group-line)) (gnus-group-position-point)) (defun gnus-group-unsubscribe (&optional n) @@ -3182,26 +3321,22 @@ Uses the process/prefix convention." "Toggle subscription of the current group. If given numerical prefix, toggle the N next groups." (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group) - (while groups - (setq group (car groups) - groups (cdr groups)) - (gnus-group-remove-mark group) - (gnus-group-unsubscribe-group - group - (cond - ((eq do-sub 'unsubscribe) - gnus-level-default-unsubscribed) - ((eq do-sub 'subscribe) - gnus-level-default-subscribed) - ((<= (gnus-group-group-level) gnus-level-subscribed) - gnus-level-default-unsubscribed) - (t - gnus-level-default-subscribed)) - t) - (gnus-group-update-group-line)) - (gnus-group-next-group 1))) + (dolist (group (gnus-group-process-prefix n)) + (gnus-group-remove-mark group) + (gnus-group-unsubscribe-group + group + (cond + ((eq do-sub 'unsubscribe) + gnus-level-default-unsubscribed) + ((eq do-sub 'subscribe) + gnus-level-default-subscribed) + ((<= (gnus-group-group-level) gnus-level-subscribed) + gnus-level-default-unsubscribed) + (t + gnus-level-default-subscribed)) + t) + (gnus-group-update-group-line)) + (gnus-group-next-group 1)) (defun gnus-group-unsubscribe-group (group &optional level silent) "Toggle subscription to GROUP. @@ -3213,7 +3348,7 @@ group line." (gnus-read-active-file-p) nil 'gnus-group-history))) - (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) + (let ((newsrc (gnus-group-entry group))) (cond ((string-match "^[ \t]*$" group) (error "Empty group name")) @@ -3237,7 +3372,7 @@ group line." gnus-level-zombie) gnus-level-killed) (when (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) + (gnus-group-entry (gnus-group-group-name)))) (unless silent (gnus-group-update-group group))) (t (error "No such newsgroup: %s" group))) @@ -3276,12 +3411,10 @@ The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." (count-lines (progn (goto-char begin) - (beginning-of-line) - (point)) + (point-at-bol)) (progn (goto-char end) - (beginning-of-line) - (point)))))) + (point-at-bol)))))) (goto-char begin) (beginning-of-line) ;Important when LINES < 1 (gnus-group-kill-group lines))) @@ -3305,7 +3438,7 @@ of groups killed." (setq level (gnus-group-group-level)) (gnus-delete-line) (when (and (not discard) - (setq entry (gnus-gethash group gnus-newsrc-hashtb))) + (setq entry (gnus-group-entry group))) (gnus-undo-register `(progn (gnus-group-goto-group ,(gnus-group-group-name)) @@ -3314,32 +3447,30 @@ of groups killed." gnus-list-of-killed-groups)) (gnus-group-change-level (if entry entry group) gnus-level-killed (if entry nil level)) - (message "Killed group %s" group)) + (message "Killed group %s" (gnus-group-decoded-name group))) ;; If there are lots and lots of groups to be killed, we use ;; this thing instead. - (let (entry) - (setq groups (nreverse groups)) - (while groups - (gnus-group-remove-mark (setq group (pop groups))) - (gnus-delete-line) - (push group gnus-killed-list) - (setq gnus-newsrc-alist - (delq (assoc group gnus-newsrc-alist) - gnus-newsrc-alist)) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function - group gnus-level-killed 3)) - (cond - ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (push (cons (car entry) (nth 2 entry)) - gnus-list-of-killed-groups) - (setcdr (cdr entry) (cdddr entry))) - ((member group gnus-zombie-list) - (setq gnus-zombie-list (delete group gnus-zombie-list)))) - ;; There may be more than one instance displayed. - (while (gnus-group-goto-group group) - (gnus-delete-line))) - (gnus-make-hashtable-from-newsrc-alist))) + (dolist (group (nreverse groups)) + (gnus-group-remove-mark group) + (gnus-delete-line) + (push group gnus-killed-list) + (setq gnus-newsrc-alist + (delq (assoc group gnus-newsrc-alist) + gnus-newsrc-alist)) + (when gnus-group-change-level-function + (funcall gnus-group-change-level-function + group gnus-level-killed 3)) + (cond + ((setq entry (gnus-group-entry group)) + (push (cons (car entry) (nth 2 entry)) + gnus-list-of-killed-groups) + (setcdr (cdr entry) (cdddr entry))) + ((member group gnus-zombie-list) + (setq gnus-zombie-list (delete group gnus-zombie-list)))) + ;; There may be more than one instance displayed. + (while (gnus-group-goto-group group) + (gnus-delete-line))) + (gnus-make-hashtable-from-newsrc-alist)) (gnus-group-position-point) (if (< (length out) 2) (car out) (nreverse out)))) @@ -3363,7 +3494,7 @@ yanked) a list of yanked groups is returned." (setq prev (gnus-group-group-name)) (gnus-group-change-level info (gnus-info-level (cdr info)) gnus-level-killed - (and prev (gnus-gethash prev gnus-newsrc-hashtb)) + (and prev (gnus-group-entry prev)) t) (gnus-group-insert-group-line-info group) (gnus-undo-register @@ -3404,7 +3535,7 @@ yanked) a list of yanked groups is returned." (defun gnus-group-list-all-groups (&optional arg) "List all newsgroups with level ARG or lower. -Default is gnus-level-unsubscribed, which lists all subscribed and most +Default is `gnus-level-unsubscribed', which lists all subscribed and most unsubscribed groups." (interactive "P") (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) @@ -3444,7 +3575,7 @@ entail asking the server for the groups." ;; First we make sure that we have really read the active file. (unless (gnus-read-active-file-p) (let ((gnus-read-active-file t) - (gnus-agent nil)) ; Trick the agent into ignoring the active file. + (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent. (gnus-read-active-file))) ;; Find all groups and sort them. (let ((groups @@ -3491,6 +3622,7 @@ re-scanning. If ARG is non-nil and not a number, this will force ;; Binding this variable will inhibit multiple fetchings ;; of the same mail source. (nnmail-fetched-sources (list t))) + (gnus-run-hooks 'gnus-get-top-new-news-hook) (gnus-run-hooks 'gnus-get-new-news-hook) ;; Read any slave files. @@ -3518,6 +3650,7 @@ re-scanning. If ARG is non-nil and not a number, this will force (gnus-get-unread-articles arg)) (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) (gnus-get-unread-articles arg))) + (gnus-check-reasonable-setup) (gnus-run-hooks 'gnus-after-getting-new-news-hook) (gnus-group-list-groups (and (numberp arg) (max (car gnus-group-list-mode) arg))))) @@ -3525,7 +3658,8 @@ re-scanning. If ARG is non-nil and not a number, this will force (defun gnus-group-get-new-news-this-group (&optional n dont-scan) "Check for newly arrived news in the current group (and the N-1 next groups). The difference between N and the number of newsgroup checked is returned. -If N is negative, this group and the N-1 previous groups will be checked." +If N is negative, this group and the N-1 previous groups will be checked. +If DONT-SCAN is non-nil, scan non-activated groups as well." (interactive "P") (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) @@ -3541,15 +3675,17 @@ If N is negative, this group and the N-1 previous groups will be checked." (gnus-group-remove-mark group) ;; Bypass any previous denials from the server. (gnus-remove-denial (setq method (gnus-find-method-for-group group))) - (if (gnus-activate-group group (if dont-scan nil 'scan)) - (progn - (gnus-get-unread-articles-in-group - (gnus-get-info group) (gnus-active group) t) + (if (gnus-activate-group group (if dont-scan nil 'scan) nil method) + (let ((info (gnus-get-info group)) + (active (gnus-active group))) + (when info + (gnus-request-update-info info method)) + (gnus-get-unread-articles-in-group info active) (unless (gnus-virtual-group-p group) (gnus-close-group group)) (when gnus-agent (gnus-agent-save-group-info - method (gnus-group-real-name group) (gnus-active group))) + method (gnus-group-real-name group) active)) (gnus-group-update-group group)) (if (eq (gnus-server-status (gnus-find-method-for-group group)) 'denied) @@ -3613,7 +3749,7 @@ If given a prefix argument, prompt for a group." (browse-url (eval url)) (setq url (concat "http://" hierarchy ".news-admin.org/charters/" name)) - (if (and (fboundp 'url-http-file-exists-p) + (if (and (fboundp 'url-http-file-exists-p) (url-http-file-exists-p url)) (browse-url url) (gnus-group-fetch-control group)))))) @@ -3634,14 +3770,14 @@ If given a prefix argument, prompt for a group." (setq hierarchy (match-string 1 name)) (if gnus-group-fetch-control-use-browse-url (browse-url (concat "ftp://ftp.isc.org/usenet/control/" - hierarchy "/" name ".Z")) + hierarchy "/" name ".gz")) (let ((enable-local-variables nil)) (gnus-group-read-ephemeral-group group - `(nndoc ,group (nndoc-address + `(nndoc ,group (nndoc-address ,(find-file-noselect - (concat "/ftp@ftp.isc.org:/usenet/control/" - hierarchy "/" name ".Z"))) + (concat "/ftp@ftp.isc.org:/usenet/control/" + hierarchy "/" name ".gz"))) (nndoc-article-type mbox)) t nil nil)))))) (defun gnus-group-describe-group (force &optional group) @@ -3739,7 +3875,7 @@ If given a prefix argument, prompt for a group." (pop-to-buffer obuf))) (defun gnus-group-description-apropos (regexp) - "List all newsgroups that have names or descriptions that match a regexp." + "List all newsgroups that have names or descriptions that match REGEXP." (interactive "sGnus description apropos (regexp): ") (when (not (or gnus-description-hashtb (gnus-read-all-descriptions-files))) @@ -3838,10 +3974,12 @@ If GROUP, edit that local kill file instead." (interactive) (gnus-save-newsrc-file)) +(defvar gnus-backlog-articles) + (defun gnus-group-suspend () "Suspend the current Gnus session. In fact, cleanup buffers except for group mode buffer. -The hook gnus-suspend-gnus-hook is called before actually suspending." +The hook `gnus-suspend-gnus-hook' is called before actually suspending." (interactive) (gnus-run-hooks 'gnus-suspend-gnus-hook) (gnus-offer-save-summaries) @@ -3849,12 +3987,11 @@ The hook gnus-suspend-gnus-hook is called before actually suspending." (let ((group-buf (get-buffer gnus-group-buffer))) (mapcar (lambda (buf) (unless (or (member buf (list group-buf gnus-dribble-buffer)) - (progn - (save-excursion - (set-buffer buf) - (eq major-mode 'message-mode)))) + (with-current-buffer buf + (eq major-mode 'message-mode))) (gnus-kill-buffer buf))) (gnus-buffers)) + (setq gnus-backlog-articles nil) (gnus-kill-gnus-frames) (when group-buf (bury-buffer group-buf) @@ -3927,27 +4064,25 @@ If not, METHOD should be a list where the first element is the method and the second element is the address." (interactive (list (let ((how (completing-read - "Which backend: " + "Which back end: " (append gnus-valid-select-methods gnus-server-alist) nil t (cons "nntp" 0) 'gnus-method-history))) - ;; We either got a backend name or a virtual server name. + ;; We either got a back end name or a virtual server name. ;; If the first, we also need an address. (if (assoc how gnus-valid-select-methods) (list (intern how) ;; Suggested by mapjph@bath.ac.uk. (completing-read "Address: " - (mapcar (lambda (server) (list server)) - gnus-secondary-servers))) + (mapcar 'list gnus-secondary-servers))) ;; We got a server name. how)))) (gnus-browse-foreign-server method)) (defun gnus-group-set-info (info &optional method-only-group part) (when (or info part) - (let* ((entry (gnus-gethash - (or method-only-group (gnus-info-group info)) - gnus-newsrc-hashtb)) + (let* ((entry (gnus-group-entry + (or method-only-group (gnus-info-group info)))) (part-info info) (info (if method-only-group (nth 2 entry) info)) method) @@ -3985,10 +4120,9 @@ and the second element is the address." (gnus-group-make-group (gnus-info-group info)))) (gnus-message 6 "Note: New group created") (setq entry - (gnus-gethash (gnus-group-prefixed-name - (gnus-group-real-name (gnus-info-group info)) - (or (gnus-info-method info) gnus-select-method)) - gnus-newsrc-hashtb)))) + (gnus-group-entry (gnus-group-prefixed-name + (gnus-group-real-name (gnus-info-group info)) + (or (gnus-info-method info) gnus-select-method)))))) ;; Whether it was a new group or not, we now have the entry, so we ;; can do the update. (if entry @@ -4203,4 +4337,5 @@ This command may read the active file." (provide 'gnus-group) +;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6 ;;; gnus-group.el ends here