X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=ae849e05742216385a61ce0f469afb7e6e97b32a;hb=b28454eed83f245c4160228b076134ce930b320a;hp=33c020603ad2e2c2f198d2c7d75bcd292bf9e8bb;hpb=1866e8307d0f95ac3fa5fefaa6dba11852474ac7;p=gnus diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 33c020603..ae849e057 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 Free Software Foundation, Inc. +;; Copyright (C) 1996,97 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -25,7 +25,7 @@ ;;; Code: -(require 'gnus-load) +(require 'gnus) (require 'gnus-start) (require 'nnmail) (require 'gnus-spec) @@ -34,19 +34,24 @@ (require 'gnus-win) (require 'gnus-undo) -(defvar gnus-group-archive-directory +(defcustom gnus-group-archive-directory "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" - "*The address of the (ding) archives.") + "*The address of the (ding) archives." + :group 'gnus-group-foreign + :type 'directory) -(defvar gnus-group-recent-archive-directory +(defcustom gnus-group-recent-archive-directory "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" - "*The address of the most recent (ding) articles.") + "*The address of the most recent (ding) articles." + :group 'gnus-group-foreign + :type 'directory) -;; Suggested by Andrew Eskilsson . -(defvar gnus-no-groups-message "No news is horrible news" - "*Message displayed by Gnus when no groups are available.") +(defcustom gnus-no-groups-message "No news is no news" + "*Message displayed by Gnus when no groups are available." + :group 'gnus-start + :type 'string) -(defvar gnus-keep-same-level nil +(defcustom gnus-keep-same-level nil "*Non-nil means that the next newsgroup after the current will be on the same level. When you type, for instance, `n' after reading the last article in the current newsgroup, you will go to the next newsgroup. If this variable @@ -57,31 +62,50 @@ next newsgroup with the same level, or, if no such newsgroup is available, the next newsgroup with the lowest possible level higher than the current level. If this variable is `best', Gnus will make the next newsgroup the one -with the best level.") - -(defvar gnus-group-goto-unread t - "*If non-nil, movement commands will go to the next unread and subscribed group.") - -(defvar gnus-goto-next-group-when-activating t - "*If non-nil, the \\\\[gnus-group-get-new-news-this-group] command will advance point to the next group.") - -(defvar gnus-permanently-visible-groups nil +with the best level." + :group 'gnus-group-levels + :type '(choice (const nil) + (const best) + (sexp :tag "other" t))) + +(defcustom gnus-group-goto-unread t + "*If non-nil, movement commands will go to the next unread and subscribed group." + :link '(custom-manual "(gnus)Group Maneuvering") + :group 'gnus-group-various + :type 'boolean) + +(defcustom gnus-goto-next-group-when-activating t + "*If non-nil, the \\\\[gnus-group-get-new-news-this-group] command will advance point to the next group." + :link '(custom-manual "(gnus)Scanning New Messages") + :group 'gnus-group-various + :type 'boolean) + +(defcustom gnus-permanently-visible-groups nil "*Regexp to match groups that should always be listed in the group buffer. This means that they will still be listed when there are no unread -articles in the groups.") +articles in the groups." + :group 'gnus-group-listing + :type 'regexp) -(defvar gnus-list-groups-with-ticked-articles t +(defcustom gnus-list-groups-with-ticked-articles t "*If non-nil, list groups that have only ticked articles. -If nil, only list groups that have unread articles.") +If nil, only list groups that have unread articles." + :group 'gnus-group-listing + :type 'boolean) -(defvar gnus-group-default-list-level gnus-level-subscribed +(defcustom gnus-group-default-list-level gnus-level-subscribed "*Default listing level. -Ignored if `gnus-group-use-permanent-levels' is non-nil.") +Ignored if `gnus-group-use-permanent-levels' is non-nil." + :group 'gnus-group-listing + :type 'integer) -(defvar gnus-group-list-inactive-groups t - "*If non-nil, inactive groups will be listed.") +(defcustom gnus-group-list-inactive-groups t + "*If non-nil, inactive groups will be listed." + :group 'gnus-group-listing + :group 'gnus-group-levels + :type 'boolean) -(defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet +(defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet "*Function used for sorting the group buffer. This function will be called with group info entries as the arguments for the groups to be sorted. Pre-made functions include @@ -92,9 +116,19 @@ for the groups to be sorted. Pre-made functions include This variable can also be a list of sorting functions. In that case, the most significant sort function should be the last function in the -list.") - -(defvar gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n" +list." + :group 'gnus-group-listing + :link '(custom-manual "(gnus)Sorting Groups") + :type '(radio (function-item gnus-group-sort-by-alphabet) + (function-item gnus-group-sort-by-real-name) + (function-item gnus-group-sort-by-unread) + (function-item gnus-group-sort-by-level) + (function-item gnus-group-sort-by-score) + (function-item gnus-group-sort-by-method) + (function-item gnus-group-sort-by-rank) + (function :tag "other" nil))) + +(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n" "*Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -117,9 +151,11 @@ with some simple extensions. %p Process mark (char) %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. %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 the @@ -137,33 +173,47 @@ 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. +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.") +effect." + :group 'gnus-group-visual + :type 'string) -(defvar gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}" +(defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}" "*The format specification for the group mode line. It works along the same lines as a normal formatting string, with some simple extensions: %S The native news server. %M The native select method. -%: \":\" if %S isn't \"\".") - -(defvar gnus-group-mode-hook nil - "*A hook for Gnus group mode.") - -(defvar gnus-group-menu-hook nil - "*Hook run after the creation of the group mode menu.") - -(defvar gnus-group-catchup-group-hook nil - "*A hook run when catching up a group from the group buffer.") - -(defvar gnus-group-update-group-hook nil - "*A hook called when updating group lines.") - -(defvar gnus-group-prepare-function 'gnus-group-prepare-flat +%: \":\" if %S isn't \"\"." + :group 'gnus-group-visual + :type 'string) + +(defcustom gnus-group-mode-hook nil + "Hook for Gnus group mode." + :group 'gnus-group-various + :options '(gnus-topic-mode) + :type 'hook) + +(defcustom gnus-group-menu-hook nil + "Hook run after the creation of the group mode menu." + :group 'gnus-group-various + :type 'hook) + +(defcustom gnus-group-catchup-group-hook nil + "Hook run when catching up a group from the group buffer." + :group 'gnus-group-various + :link '(custom-manual "(gnus)Group Data") + :type 'hook) + +(defcustom gnus-group-update-group-hook nil + "Hook called when updating group lines." + :group 'gnus-group-visual + :type 'hook) + +(defcustom gnus-group-prepare-function 'gnus-group-prepare-flat "*A function that is called to generate the group buffer. The function is called with three arguments: The first is a number; all group with a level less or equal to that number should be listed, @@ -171,35 +221,136 @@ if the second is non-nil, empty groups should also be displayed. If the third is non-nil, it is a number. No groups with a level lower than this number should be displayed. -The only current function implemented is `gnus-group-prepare-flat'.") - -(defvar gnus-group-prepare-hook nil - "*A hook called after the group buffer has been generated. -If you want to modify the group buffer, you can use this hook.") - -(defvar gnus-suspend-gnus-hook nil - "*A hook called when suspending (not exiting) Gnus.") - -(defvar gnus-exit-gnus-hook nil - "*A hook called when exiting Gnus.") - -(defvar gnus-after-exiting-gnus-hook nil - "*A hook called after exiting Gnus.") - -(defvar gnus-group-update-hook '(gnus-group-highlight-line) - "*A hook called when a group line is changed. +The only current function implemented is `gnus-group-prepare-flat'." + :group 'gnus-group-listing + :type 'function) + +(defcustom gnus-group-prepare-hook nil + "Hook called after the group buffer has been generated. +If you want to modify the group buffer, you can use this hook." + :group 'gnus-group-listing + :type 'hook) + +(defcustom gnus-suspend-gnus-hook nil + "Hook called when suspending (not exiting) Gnus." + :group 'gnus-exit + :type 'hook) + +(defcustom gnus-exit-gnus-hook nil + "Hook called when exiting Gnus." + :group 'gnus-exit + :type 'hook) + +(defcustom gnus-after-exiting-gnus-hook nil + "Hook called after exiting Gnus." + :group 'gnus-exit + :type 'hook) + +(defcustom gnus-group-update-hook '(gnus-group-highlight-line) + "Hook called when a group line is changed. The hook will not be called if `gnus-visual' is nil. The default function `gnus-group-highlight-line' will highlight the line according to the `gnus-group-highlight' -variable.") +variable." + :group 'gnus-group-visual + :type 'hook) + +(defcustom gnus-useful-groups + `(("(ding) mailing list mirrored at sunsite.auc.dk" + "emacs.ding" + (nntp "sunsite.auc.dk" + (nntp-address "sunsite.auc.dk"))) + ("Gnus help group" + "gnus-help" + (nndoc "gnus-help" + (nndoc-article-type mbox) + (eval `(nndoc-address + ,(let ((file (nnheader-find-etc-directory + "gnus-tut.txt" t))) + (unless file + (error "Couldn't find doc group")) + file)))))) + "Alist of useful group-server pairs." + :group 'gnus-group-listing + :type '(repeat (list (string :tag "Description") + (string :tag "Name") + (sexp :tag "Method")))) + +(defcustom gnus-group-highlight + '(;; News. + ((and (= unread 0) (not mailp) (eq level 1)) . + gnus-group-news-1-empty-face) + ((and (not mailp) (eq level 1)) . + gnus-group-news-1-face) + ((and (= unread 0) (not mailp) (eq level 2)) . + gnus-group-news-2-empty-face) + ((and (not mailp) (eq level 2)) . + gnus-group-news-2-face) + ((and (= unread 0) (not mailp) (eq level 3)) . + gnus-group-news-3-empty-face) + ((and (not mailp) (eq level 3)) . + gnus-group-news-3-face) + ((and (= unread 0) (not mailp)) . + gnus-group-news-low-empty-face) + ((and (not mailp)) . + gnus-group-news-low-face) + ;; Mail. + ((and (= unread 0) (eq level 1)) . + gnus-group-mail-1-empty-face) + ((eq level 1) . + gnus-group-mail-1-face) + ((and (= unread 0) (eq level 2)) . + gnus-group-mail-2-empty-face) + ((eq level 2) . + gnus-group-mail-2-face) + ((and (= unread 0) (eq level 3)) . + gnus-group-mail-3-empty-face) + ((eq level 3) . + gnus-group-mail-3-face) + ((= unread 0) . + gnus-group-mail-low-empty-face) + (t . + gnus-group-mail-low-face)) + "Controls the highlighting of group buffer lines. + +Below is a list of `Form'/`Face' pairs. When deciding how a a +particular group line should be displayed, each form is +evaluated. The content of the face field after the first true form is +used. You can change how those group lines are displayed by +editing the face field. + +It is also possible to change and add form fields, but currently that +requires an understanding of Lisp expressions. Hopefully this will +change in a future release. For now, you can use the following +variables in the Lisp expression: + +group: The name of the group. +unread: The number of unread articles in the group. +method: The select method used. +mailp: Whether it's a mail group or not. +level: The level of the group. +score: The score of the group. +ticked: The number of ticked articles." + :group 'gnus-group-visual + :type '(repeat (cons (sexp :tag "Form") face))) + +(defcustom gnus-new-mail-mark ?% + "Mark used for groups with new mail." + :group 'gnus-group-visual + :type 'character) ;;; Internal variables +(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat + "Function for sorting the group buffer.") + +(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat + "Function for sorting the selected groups in the group buffer.") + (defvar gnus-group-indentation-function nil) (defvar gnus-goto-missing-group-function nil) (defvar gnus-group-update-group-function nil) -(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) (defvar gnus-group-goto-next-group-function nil "Function to override finding the next group after listing groups.") @@ -210,7 +361,7 @@ variable.") (?S gnus-tmp-subscribed ?c) (?L gnus-tmp-level ?d) (?N (cond ((eq number t) "*" ) - ((numberp number) + ((numberp number) (int-to-string (+ number (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) @@ -235,6 +386,8 @@ variable.") (?P gnus-group-indentation ?s) (?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))) (defvar gnus-group-mode-line-format-alist @@ -265,6 +418,7 @@ variable.") "=" gnus-group-select-group "\r" gnus-group-select-group "\M-\r" gnus-group-quick-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 @@ -336,6 +490,7 @@ variable.") (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 "m" gnus-group-make-group @@ -348,6 +503,7 @@ variable.") "f" gnus-group-make-doc-group "w" gnus-group-make-web-group "r" gnus-group-rename-group + "c" gnus-group-customize "\177" gnus-group-delete-group [delete] gnus-group-delete-group) @@ -367,6 +523,15 @@ variable.") "r" gnus-group-sort-groups-by-rank "m" gnus-group-sort-groups-by-method) + (gnus-define-keys (gnus-group-sort-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) + (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) "k" gnus-group-list-killed "z" gnus-group-list-zombies @@ -383,6 +548,7 @@ variable.") "f" gnus-score-flush-cache) (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) + "d" gnus-group-describe-group "f" gnus-group-fetch-faq) (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) @@ -417,8 +583,6 @@ variable.") ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] ["Describe" gnus-group-describe-group (gnus-group-group-name)] ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] - ["Edit kill file" gnus-group-edit-local-kill - (gnus-group-group-name)] ;; 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 @@ -429,8 +593,17 @@ variable.") ["Set group level" gnus-group-set-current-level (gnus-group-group-name)] ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] + ["Customize" gnus-group-customize (gnus-group-group-name)] + ("Edit" + ["Parameters" gnus-group-edit-group-parameters + (gnus-group-group-name)] + ["Select method" gnus-group-edit-group-method + (gnus-group-group-name)] + ["Info" gnus-group-edit-group (gnus-group-group-name)] + ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] + ["Global kill file" gnus-group-edit-global-kill t]) )) - + (easy-menu-define gnus-group-group-menu gnus-group-mode-map "" '("Groups" @@ -447,19 +620,27 @@ variable.") ["List all groups matching..." gnus-group-list-all-matching t] ["List active file" gnus-group-list-active t]) ("Sort" - ["Default sort" gnus-group-sort-groups + ["Default sort" gnus-group-sort-groups t] + ["Sort by method" gnus-group-sort-groups-by-method t] + ["Sort by rank" gnus-group-sort-groups-by-rank t] + ["Sort by score" gnus-group-sort-groups-by-score t] + ["Sort by level" gnus-group-sort-groups-by-level t] + ["Sort by unread" gnus-group-sort-groups-by-unread t] + ["Sort by name" gnus-group-sort-groups-by-alphabet t]) + ("Sort process/prefixed" + ["Default sort" gnus-group-sort-selected-groups (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by method" gnus-group-sort-groups-by-method + ["Sort by method" gnus-group-sort-selected-groups-by-method (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by rank" gnus-group-sort-groups-by-rank + ["Sort by rank" gnus-group-sort-selected-groups-by-rank (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by score" gnus-group-sort-groups-by-score + ["Sort by score" gnus-group-sort-selected-groups-by-score (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by level" gnus-group-sort-groups-by-level + ["Sort by level" gnus-group-sort-selected-groups-by-level (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by unread" gnus-group-sort-groups-by-unread + ["Sort by unread" gnus-group-sort-selected-groups-by-unread (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by name" gnus-group-sort-groups-by-alphabet + ["Sort by name" gnus-group-sort-selected-groups-by-alphabet (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]) ("Mark" ["Mark group" gnus-group-mark-group @@ -486,6 +667,7 @@ variable.") ["Add the help group" gnus-group-make-help-group t] ["Add the archive group" gnus-group-make-archive-group t] ["Make a doc group" gnus-group-make-doc-group t] + ["Make a web group" gnus-group-make-web-group t] ["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] @@ -495,14 +677,6 @@ variable.") ["Delete group" gnus-group-delete-group (gnus-check-backend-function 'request-delete-group (gnus-group-group-name))]) - ("Editing groups" - ["Parameters" gnus-group-edit-group-parameters - (gnus-group-group-name)] - ["Select method" gnus-group-edit-group-method - (gnus-group-group-name)] - ["Info" gnus-group-edit-group (gnus-group-group-name)]) - ("Score file" - ["Flush cache" gnus-score-flush-cache t]) ("Move" ["Next" gnus-group-next-group t] ["Previous" gnus-group-prev-group t] @@ -510,10 +684,12 @@ variable.") ["Previous unread" gnus-group-prev-unread-group t] ["Next unread same level" gnus-group-next-unread-group-same-level t] ["Previous unread same level" - gnus-group-previous-unread-group-same-level t] + gnus-group-prev-unread-group-same-level t] ["Jump to group" gnus-group-jump-to-group t] ["First unread group" gnus-group-first-unread-group t] ["Best unread group" gnus-group-best-unread-group t]) + ["Delete bogus groups" gnus-group-check-bogus-groups t] + ["Find new newsgroups" gnus-find-new-newsgroups t] ["Transpose" gnus-group-transpose-groups (gnus-group-group-name)] ["Read a directory as a group..." gnus-group-enter-directory t] @@ -522,14 +698,18 @@ variable.") (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" '("Misc" + ("SOUP" + ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] + ["Send replies" gnus-soup-send-replies + (fboundp 'gnus-soup-pack-packet)] + ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] + ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] + ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)]) ["Send a bug report" gnus-bug t] ["Send a mail" gnus-group-mail t] ["Post an article..." gnus-group-post-news t] - ["Customize score file" gnus-score-customize t] - ["Check for new news" gnus-group-get-new-news t] + ["Check for new news" gnus-group-get-new-news t] ["Activate all groups" gnus-activate-all-groups t] - ["Delete bogus groups" gnus-group-check-bogus-groups t] - ["Find new newsgroups" gnus-find-new-newsgroups t] ["Restart Gnus" gnus-group-restart t] ["Read init file" gnus-group-read-init-file t] ["Browse foreign server" gnus-group-browse-foreign-server t] @@ -540,22 +720,14 @@ variable.") ["Save .newsrc files" gnus-group-save-newsrc t] ["Suspend Gnus" gnus-group-suspend t] ["Clear dribble buffer" gnus-group-clear-dribble t] - ["Edit global kill file" gnus-group-edit-global-kill t] ["Read manual" gnus-info-find-node t] + ["Flush score cache" gnus-score-flush-cache t] ["Toggle topics" gnus-topic-mode t] - ("SOUP" - ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] - ["Send replies" gnus-soup-send-replies - (fboundp 'gnus-soup-pack-packet)] - ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] - ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] - ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)]) ["Exit from Gnus" gnus-group-exit t] ["Exit without saving" gnus-group-quit t] )) - (run-hooks 'gnus-group-menu-hook) - )) + (run-hooks 'gnus-group-menu-hook))) (defun gnus-group-mode () "Major mode for reading news. @@ -575,8 +747,7 @@ The following commands are available: \\{gnus-group-mode-map}" (interactive) - (when (and menu-bar-mode - (gnus-visual-p 'group-menu 'menu)) + (when (gnus-visual-p 'group-menu 'menu) (gnus-group-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) @@ -591,7 +762,7 @@ The following commands are available: (gnus-set-default-directory) (gnus-update-format-specifications nil 'group 'group-mode) (gnus-update-group-mark-positions) - (gnus-make-local-hook 'post-command-hook) + (make-local-hook 'post-command-hook) (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) (when gnus-use-undo (gnus-undo-mode 1)) @@ -656,48 +827,60 @@ listed." (gnus-group-default-level nil t) gnus-group-default-list-level gnus-level-subscribed)))) + ;; Just do this here, for no particular good reason. + (gnus-clear-inboxes-moved) (unless level (setq level (car gnus-group-list-mode) unread (cdr gnus-group-list-mode))) (setq level (gnus-group-default-level level)) - (gnus-group-setup-buffer) ;May call from out of group buffer - (gnus-update-format-specifications) + (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))) - (group (gnus-group-group-name))) + (empty (= (point-min) (point-max))) + (group (gnus-group-group-name)) + number) (set-buffer gnus-group-buffer) - (funcall gnus-group-prepare-function level unread lowest) - (if (zerop (buffer-size)) - (gnus-message 5 gnus-no-groups-message) - (goto-char (point-max)) - (when (or (not gnus-group-goto-next-group-function) - (not (funcall gnus-group-goto-next-group-function - group props))) - (if (not group) - ;; Go to the first group with unread articles. - (gnus-group-search-forward t) - ;; Find the right group to put point on. If the current group - ;; has disappeared in the new listing, try to find the next - ;; one. If no next one can be found, just leave point at the - ;; first newsgroup in the buffer. - (when (not (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - group gnus-active-hashtb)))) - (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) - (while (and newsrc - (not (gnus-goto-char - (text-property-any - (point-min) (point-max) 'gnus-group - (gnus-intern-safe - (caar newsrc) gnus-active-hashtb))))) - (setq newsrc (cdr newsrc))) - (unless newsrc - (goto-char (point-max)) - (forward-line -1)))))) - ;; Adjust cursor point. - (gnus-group-position-point)))) + (setq number (funcall gnus-group-prepare-function level unread lowest)) + (when (or (and (numberp number) + (zerop number)) + (zerop (buffer-size))) + ;; No groups in the buffer. + (gnus-message 5 gnus-no-groups-message)) + ;; We have some groups displayed. + (goto-char (point-max)) + (when (or (not gnus-group-goto-next-group-function) + (not (funcall gnus-group-goto-next-group-function + group props))) + (cond + (empty + (goto-char (point-min))) + ((not group) + ;; Go to the first group with unread articles. + (gnus-group-search-forward t)) + (t + ;; Find the right group to put point on. If the current group + ;; has disappeared in the new listing, try to find the next + ;; one. If no next one can be found, just leave point at the + ;; first newsgroup in the buffer. + (when (not (gnus-goto-char + (text-property-any + (point-min) (point-max) + 'gnus-group (gnus-intern-safe + group gnus-active-hashtb)))) + (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) + (while (and newsrc + (not (gnus-goto-char + (text-property-any + (point-min) (point-max) 'gnus-group + (gnus-intern-safe + (caar newsrc) gnus-active-hashtb))))) + (setq newsrc (cdr newsrc))) + (unless newsrc + (goto-char (point-max)) + (forward-line -1))))))) + ;; Adjust cursor point. + (gnus-group-position-point))) (defun gnus-group-list-level (level &optional all) "List groups on LEVEL. @@ -716,35 +899,35 @@ If REGEXP, only list groups matching REGEXP." (lowest (or lowest 1)) info clevel unread group params) (erase-buffer) - (if (< lowest gnus-level-zombie) - ;; List living groups. - (while newsrc - (setq info (car newsrc) - group (gnus-info-group info) - params (gnus-info-params info) - newsrc (cdr newsrc) - unread (car (gnus-gethash group gnus-newsrc-hashtb))) - (and unread ; This group might be bogus - (or (not regexp) - (string-match regexp group)) - (<= (setq clevel (gnus-info-level info)) level) - (>= clevel lowest) - (or all ; We list all groups? - (if (eq unread t) ; Unactivated? - gnus-group-list-inactive-groups ; We list unactivated - (> unread 0)) ; We list groups with unread articles - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) + (when (< lowest gnus-level-zombie) + ;; List living groups. + (while newsrc + (setq info (car newsrc) + group (gnus-info-group info) + params (gnus-info-params info) + newsrc (cdr newsrc) + unread (car (gnus-gethash group gnus-newsrc-hashtb))) + (and unread ; This group might be bogus + (or (not regexp) + (string-match regexp group)) + (<= (setq clevel (gnus-info-level info)) level) + (>= clevel lowest) + (or all ; We list all groups? + (if (eq unread t) ; Unactivated? + gnus-group-list-inactive-groups ; We list unactivated + (> unread 0)) ; We list groups with unread articles + (and gnus-list-groups-with-ticked-articles + (cdr (assq 'tick (gnus-info-marks info)))) ; And groups with tickeds - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups - group)) - (memq 'visible params) - (cdr (assq 'visible params))) - (gnus-group-insert-group-line - group (gnus-info-level info) - (gnus-info-marks info) unread (gnus-info-method info))))) + ;; Check for permanent visibility. + (and gnus-permanently-visible-groups + (string-match gnus-permanently-visible-groups + group)) + (memq 'visible params) + (cdr (assq 'visible params))) + (gnus-group-insert-group-line + group (gnus-info-level info) + (gnus-info-marks info) unread (gnus-info-method info))))) ;; List dead groups. (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) @@ -759,7 +942,8 @@ If REGEXP, only list groups matching REGEXP." (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level all)) - (run-hooks 'gnus-group-prepare-hook))) + (run-hooks 'gnus-group-prepare-hook) + t)) (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) ;; List zombies and killed lists somewhat faster, which was @@ -799,7 +983,8 @@ If REGEXP, only list groups matching REGEXP." (not (gnus-ephemeral-group-p group)) (gnus-dribble-enter (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) ")"))) + (gnus-prin1-to-string (nth 2 entry)) + ")"))) (setq gnus-group-indentation (gnus-group-group-indentation)) (gnus-delete-line) (gnus-group-insert-group-line-info group) @@ -809,6 +994,7 @@ If REGEXP, 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)) + (gnus-group-indentation (gnus-group-group-indentation)) active info) (if entry (progn @@ -823,10 +1009,13 @@ If REGEXP, only list groups matching REGEXP." (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) nil (if (setq active (gnus-active group)) - (- (1+ (cdr active)) (car active)) 0) + (if (zerop (cdr active)) + 0 + (- (1+ (cdr active)) (car active))) + nil) nil)))) -(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level +(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number gnus-tmp-method) "Insert a group line in the group buffer." @@ -853,7 +1042,9 @@ If REGEXP, only list groups matching REGEXP." (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") "")) (gnus-tmp-moderated - (if (member gnus-tmp-group gnus-moderated-list) ?m ? )) + (if (and gnus-moderated-hashtb + (gnus-gethash gnus-tmp-group gnus-moderated-hashtb)) + ?m ? )) (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) (gnus-tmp-method @@ -885,12 +1076,12 @@ If REGEXP, only list groups matching REGEXP." ;; Insert the text. (eval gnus-group-line-format-spec)) `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) - gnus-unread ,(if (numberp number) - (string-to-int gnus-tmp-number-of-unread) - t) - gnus-marked ,gnus-tmp-marked-mark - gnus-indentation ,gnus-group-indentation - gnus-level ,gnus-tmp-level)) + gnus-unread ,(if (numberp number) + (string-to-int gnus-tmp-number-of-unread) + t) + gnus-marked ,gnus-tmp-marked-mark + gnus-indentation ,gnus-group-indentation + gnus-level ,gnus-tmp-level)) (when (inline (gnus-visual-p 'group-highlight 'highlight)) (forward-line -1) (run-hooks 'gnus-group-update-hook) @@ -919,6 +1110,7 @@ If REGEXP, only list groups matching REGEXP." (level (or (gnus-info-level info) 9)) (score (or (gnus-info-score info) 0)) (ticked (gnus-range-length (cdr (assq 'tick marked)))) + (group-age (gnus-group-timestamp-delta group)) (inhibit-read-only t)) ;; Eval the cars of the lists until we find a match. (while (and list @@ -926,8 +1118,8 @@ If REGEXP, only list groups matching REGEXP." (setq list (cdr list))) (let ((face (cdar list))) (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face + (gnus-put-text-property + beg end 'face (setq face (if (boundp face) (symbol-value face) face))) (gnus-extent-start-open beg))) (goto-char p))) @@ -936,8 +1128,11 @@ If REGEXP, only list groups matching REGEXP." "Update all lines where GROUP appear. If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already." - (save-excursion + ;; Can't use `save-excursion' here, so we do it manually. + (let ((buf (current-buffer)) + mark) (set-buffer gnus-group-buffer) + (setq mark (point-marker)) ;; The buffer may be narrowed. (save-restriction (widen) @@ -946,11 +1141,11 @@ already." found buffer-read-only) ;; Enter the current status into the dribble buffer. (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) - (if (and entry (not (gnus-ephemeral-group-p group))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) - ")")))) + (when (and entry (not (gnus-ephemeral-group-p group))) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string (nth 2 entry)) + ")")))) ;; Find all group instances. If topics are in use, each group ;; may be listed in more than once. (while (setq loc (text-property-any @@ -987,7 +1182,10 @@ already." (run-hooks 'gnus-group-update-group-hook)))) (when gnus-group-update-group-function (funcall gnus-group-update-group-function group)) - (gnus-group-set-mode-line))))) + (gnus-group-set-mode-line))) + (goto-char mark) + (set-marker mark nil) + (set-buffer buf))) (defun gnus-group-set-mode-line () "Update the mode line in the group buffer." @@ -1006,7 +1204,7 @@ already." (max-len 60) gnus-tmp-header ;Dummy binding for user-defined formats ;; Get the resulting string. - (modified + (modified (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer) (buffer-modified-p gnus-dribble-buffer) @@ -1016,12 +1214,12 @@ already." (mode-string (eval gformat))) ;; Say whether the dribble buffer has been modified. (setq mode-line-modified - (if modified "---*- " "----- ")) + (if modified "--**- " "----- ")) ;; If the line is too long, we chop it off. (when (> (length mode-string) max-len) (setq mode-string (substring mode-string 0 (- max-len 4)))) (prog1 - (setq mode-line-buffer-identification + (setq mode-line-buffer-identification (gnus-mode-line-buffer-identification (list mode-string))) (set-buffer-modified-p modified)))))) @@ -1046,6 +1244,17 @@ already." "Get the number of unread articles of the newsgroup on the current line." (get-text-property (gnus-point-at-bol) 'gnus-unread)) +(defun gnus-group-new-mail (group) + (if (nnmail-new-mail-p (gnus-group-real-name group)) + gnus-new-mail-mark + ? )) + +(defun gnus-group-level (group) + "Return the estimated level of GROUP." + (or (gnus-info-level (gnus-get-info group)) + (and (member group gnus-zombie-list) 8) + 9)) + (defun gnus-group-search-forward (&optional backward all level first-too) "Find the next newsgroup with unread articles. If BACKWARD is non-nil, find the previous newsgroup instead. @@ -1059,7 +1268,8 @@ If FIRST-TOO, the current line is also eligible as a target." pos found lev) (if (and backward (progn (beginning-of-line)) (bobp)) nil - (or first-too (forward-line way)) + (unless first-too + (forward-line way)) (while (and (not (eobp)) (not (setq @@ -1104,7 +1314,7 @@ If FIRST-TOO, the current line is also eligible as a target." (beginning-of-line) (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (subst-char-in-region - (point) (1+ (point)) (following-char) + (point) (1+ (point)) (following-char) (if unmark (progn (setq gnus-group-marked (delete group gnus-group-marked)) @@ -1171,25 +1381,23 @@ Return nil if the group isn't displayed." (defun gnus-group-set-mark (group) "Set the process mark on GROUP." - (if (gnus-group-goto-group group) + (if (gnus-group-goto-group group) (save-excursion (gnus-group-mark-group 1 nil t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) (defun gnus-group-universal-argument (arg &optional groups func) - "Perform any command on all groups accoring to the process/prefix convention." + "Perform any command on all groups according to the process/prefix convention." (interactive "P") - (let ((groups (or groups (gnus-group-process-prefix arg))) - group func) - (if (eq (setq func (or func - (key-binding - (read-key-sequence - (substitute-command-keys - "\\\\[gnus-group-universal-argument]"))))) - 'undefined) - (gnus-error 1 "Undefined key") - (while groups - (gnus-group-remove-mark (setq group (pop groups))) + (if (eq (setq func (or func + (key-binding + (read-key-sequence + (substitute-command-keys + "\\\\[gnus-group-universal-argument]"))))) + 'undefined) + (gnus-error 1 "Undefined key") + (gnus-group-iterate arg + (lambda (group) (command-execute func)))) (gnus-group-position-point)) @@ -1207,14 +1415,11 @@ Take into consideration N (the prefix) and the list of marked groups." (save-excursion (while (and (> n 0) (setq group (gnus-group-group-name))) - (setq groups (cons group groups)) + (push group groups) (setq n (1- n)) (gnus-group-next-group way))) (nreverse groups))) - ((and (boundp 'transient-mark-mode) - transient-mark-mode - (boundp 'mark-active) - mark-active) + ((gnus-region-active-p) ;; Work on the region between point and mark. (let ((max (max (point) (mark))) groups) @@ -1235,6 +1440,18 @@ Take into consideration N (the prefix) and the list of marked groups." (let ((group (gnus-group-group-name))) (and group (list group)))))) +(defun gnus-group-iterate (arg function) + "Iterate FUNCTION over all process/prefixed groups. +FUNCTION will be called with the group name as the paremeter +and with point over the group in question." + (let ((groups (gnus-group-process-prefix arg)) + group) + (while (setq group (pop groups)) + (gnus-group-remove-mark group) + (funcall function group)))) + +(put 'gnus-group-iterate 'lisp-indent-function 1) + ;; Selecting groups. (defun gnus-group-read-group (&optional all no-article group) @@ -1264,7 +1481,7 @@ group." (- (1+ (cdr active)) (car active))))) (gnus-summary-read-group group (or all (and (numberp number) - (zerop (+ number (gnus-range-length + (zerop (+ number (gnus-range-length (cdr (assq 'tick marked))) (gnus-range-length (cdr (assq 'dormant marked))))))) @@ -1284,8 +1501,10 @@ This means that no highlighting or scoring will be performed. If ALL (the prefix argument) is 0, don't even generate the summary buffer." (interactive "P") + (require 'gnus-score) (let (gnus-visual gnus-score-find-score-files-function + gnus-home-score-file gnus-apply-kill-hook gnus-summary-expunge-below) (gnus-group-read-group all t))) @@ -1296,18 +1515,40 @@ buffer." (let ((gnus-inhibit-limiting t)) (gnus-group-read-group all t))) +(defun gnus-group-select-group-ephemerally () + "Select the current group without doing any processing whatsoever. +You will actually be entered into a group that's a copy of +the current group; no changes you make while in this group will +be permanent." + (interactive) + (require 'gnus-score) + (let* (gnus-visual + gnus-score-find-score-files-function gnus-apply-kill-hook + gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates + gnus-summary-mode-hook gnus-select-group-hook + (group (gnus-group-group-name)) + (method (gnus-find-method-for-group group))) + (setq method + `(,(car method) ,(concat (cadr method) "-ephemeral") + (,(intern (format "%s-address" (car method))) ,(cadr method)) + ,@(cddr method))) + (gnus-group-read-ephemeral-group + (gnus-group-prefixed-name group method) method))) + ;;;###autoload (defun gnus-fetch-group (group) "Start Gnus if necessary and enter GROUP. Returns whether the fetching was successful or not." (interactive "sGroup name: ") - (or (get-buffer gnus-group-buffer) - (gnus)) + (unless (get-buffer gnus-group-buffer) + (gnus)) (gnus-group-read-group nil nil group)) +(defvar gnus-ephemeral-group-server 0) + ;; 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 +(defun gnus-group-read-ephemeral-group (group method &optional activate quit-config request-only) "Read GROUP from METHOD as an ephemeral group. If ACTIVATE, request the group first. @@ -1316,22 +1557,32 @@ ephemeral group. If REQUEST-ONLY, don't actually read the group; just request it. Return the name of the group is selection was successful." + ;; Transform the select method into a unique server. + (let ((saddr (intern (format "%s-address" (car method))))) + (setq method (gnus-copy-sequence method)) + (unless (assq saddr method) + (nconc method `((,saddr ,(cadr method))))) + (setf (cadr method) (format "%s-%d" (cadr method) + (incf gnus-ephemeral-group-server)))) (let ((group (if (gnus-group-foreign-p group) group (gnus-group-prefixed-name group method)))) (gnus-sethash group - `(-1 nil (,group ,gnus-level-default-subscribed nil nil ,method - ((quit-config . ,(if quit-config quit-config - (cons (current-buffer) 'summary)))))) + `(-1 nil (,group + ,gnus-level-default-subscribed nil nil ,method + ((quit-config . + ,(if quit-config quit-config + (cons gnus-summary-buffer + gnus-current-window-configuration)))))) gnus-newsrc-hashtb) (set-buffer gnus-group-buffer) (unless (gnus-check-server method) (error "Unable to contact server: %s" (gnus-status-message method))) (when activate + (gnus-activate-group group 'scan) (unless (gnus-request-group group) - (error "Couldn't request group: %s" - (nnheader-get-report (car method)))) - (gnus-activate-group group nil t)) + (error "Couldn't request group: %s" + (nnheader-get-report (car method))))) (if request-only group (condition-case () @@ -1352,29 +1603,14 @@ Return the name of the group is selection was successful." (when (equal group "") (error "Empty group name")) - (when (string-match "[\000-\032]" group) - (error "Control characters in group: %s" group)) - - (let ((b (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) - (unless (gnus-ephemeral-group-p group) - (if b - ;; Either go to the line in the group buffer... - (goto-char b) - ;; ... or insert the line. - (or - t ;; Don't activate group. - (gnus-active group) - (gnus-activate-group group) - (error "%s error: %s" group (gnus-status-message group))) - - (gnus-group-update-group group) - (goto-char (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))) - ;; Adjust cursor point. - (gnus-group-position-point))) + (unless (gnus-ephemeral-group-p group) + ;; Either go to the line in the group buffer... + (unless (gnus-group-goto-group group) + ;; ... or insert the line. + (gnus-group-update-group group) + (gnus-group-goto-group group))) + ;; Adjust cursor point. + (gnus-group-position-point)) (defun gnus-group-goto-group (group &optional far) "Goto to newsgroup GROUP. @@ -1382,7 +1618,7 @@ If FAR, it is likely that the group is not on the current line." (when group (if far (gnus-goto-char - (text-property-any + (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) (beginning-of-line) @@ -1408,7 +1644,7 @@ If FAR, it is likely that the group is not on the current line." (t ;; Search through the entire buffer. (gnus-goto-char - (text-property-any + (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))) @@ -1482,17 +1718,16 @@ If EXCLUDE-GROUP, do not go to that group." unread best-point) (while (not (eobp)) (setq unread (get-text-property (point) 'gnus-unread)) - (if (and (numberp unread) (> unread 0)) - (progn - (if (and (get-text-property (point) 'gnus-level) - (< (get-text-property (point) 'gnus-level) best) - (or (not exclude-group) - (not (equal exclude-group (gnus-group-group-name))))) - (progn - (setq best (get-text-property (point) 'gnus-level)) - (setq best-point (point)))))) + (when (and (numberp unread) (> unread 0)) + (when (and (get-text-property (point) 'gnus-level) + (< (get-text-property (point) 'gnus-level) best) + (or (not exclude-group) + (not (equal exclude-group (gnus-group-group-name))))) + (setq best (get-text-property (point) 'gnus-level)) + (setq best-point (point)))) (forward-line 1)) - (if best-point (goto-char best-point)) + (when best-point + (goto-char best-point)) (gnus-summary-position-point) (and best-point (gnus-group-group-name)))) @@ -1517,13 +1752,13 @@ If EXCLUDE-GROUP, do not go to that group." (interactive) (gnus-enter-server-buffer)) -(defun gnus-group-make-group (name &optional method address) +(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 ADDRESS." (interactive (list - (read-string "Group name: ") + (gnus-read-group "Group name: ") (gnus-read-method "From method: "))) (let* ((meth (when (and method @@ -1544,10 +1779,10 @@ ADDRESS." t) ;; Make it active. (gnus-set-active nname (cons 1 0)) - (or (gnus-ephemeral-group-p name) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (cdr info)) ")"))) + (unless (gnus-ephemeral-group-p name) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string (cdr info)) ")"))) ;; Insert the line. (gnus-group-insert-group-line-info nname) (forward-line -1) @@ -1560,8 +1795,8 @@ ADDRESS." gnus-valid-select-methods) (require backend)) (gnus-check-server meth) - (and (gnus-check-backend-function 'request-create-group nname) - (gnus-request-create-group nname)) + (when (gnus-check-backend-function 'request-create-group nname) + (gnus-request-create-group nname nil args)) t)) (defun gnus-group-delete-group (group &optional force) @@ -1573,15 +1808,16 @@ doing the deletion." (interactive (list (gnus-group-group-name) current-prefix-arg)) - (or group (error "No group to rename")) - (or (gnus-check-backend-function 'request-delete-group group) - (error "This backend does not support group deletion")) + (unless group + (error "No group to rename")) + (unless (gnus-check-backend-function 'request-delete-group group) + (error "This backend does not support group deletion")) (prog1 (if (not (gnus-yes-or-no-p (format "Do you really want to delete %s%s? " group (if force " and all its contents" "")))) - () ; Whew! + () ; 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) @@ -1603,20 +1839,19 @@ and NEW-NAME will be prompted for." (unless (gnus-check-backend-function 'request-rename-group (gnus-group-group-name)) (error "This backend does not support renaming groups")) - (read-string "New group name: " (gnus-group-group-name))))) + (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")) - (unless group + (unless group (error "No group to rename")) - (when (string-match "^[ \t]*$" new-name) - (error "Not a valid group name")) - (when (equal group new-name) + (when (equal (gnus-group-real-name group) new-name) (error "Can't rename to the same name")) ;; We find the proper prefixed name. (setq new-name - (if (equal (gnus-group-real-name new-name) new-name) + (if (gnus-group-native-p group) ;; Native group. new-name ;; Foreign group. @@ -1649,6 +1884,8 @@ and NEW-NAME will be prompted for." (error "No group on current line")) (unless (setq info (gnus-get-info group)) (error "Killed group; can't be edited")) + (ignore-errors + (gnus-close-group group)) (gnus-edit-form ;; Find the proper form to edit. (cond ((eq part 'method) @@ -1658,11 +1895,12 @@ and NEW-NAME will be prompted for." (t info)) ;; The proper documentation. (format - "Editing the %s." + "Editing the %s for `%s'." (cond ((eq part 'method) "select method") ((eq part 'params) "group parameters") - (t "group info"))) + (t "group info")) + group) `(lambda (form) (gnus-group-edit-group-done ',part ,group form))))) @@ -1712,23 +1950,26 @@ and NEW-NAME will be prompted for." (gnus-group-update-group (or new-group group)) (gnus-group-position-point))) +(defun gnus-group-make-useful-group (group method) + (interactive + (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups + nil t) + gnus-useful-groups))) + (list (cadr entry) (caddr entry)))) + (setq method (gnus-copy-sequence method)) + (let (entry) + (while (setq entry (memq (assq 'eval method) method)) + (setcar entry (eval (cadar entry))))) + (gnus-group-make-group group method)) + (defun gnus-group-make-help-group () "Create the Gnus documentation group." (interactive) - (let ((path load-path) - (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) - file dir) - (and (gnus-gethash name gnus-newsrc-hashtb) - (error "Documentation group already exists")) - (while path - (setq dir (file-name-as-directory (expand-file-name (pop path))) - file nil) - (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt"))) - (file-exists-p - (setq file (concat (file-name-directory - (directory-file-name dir)) - "etc/gnus-tut.txt")))) - (setq path nil))) + (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) + (file (nnheader-find-etc-directory "gnus-tut.txt" t)) + dir) + (when (gnus-gethash name gnus-newsrc-hashtb) + (error "Documentation group already exists")) (if (not file) (gnus-message 1 "Couldn't find doc group") (gnus-group-make-group @@ -1748,7 +1989,7 @@ and NEW-NAME will be prompted for." char found) (while (not found) (message - "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: " + "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: " err) (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) ((= char ?b) 'babyl) @@ -1777,7 +2018,8 @@ If SOLID (the prefix), create a solid group." (interactive "P") (require 'nnweb) (let* ((group - (if solid (read-string "Group name: ") (message-unique-id))) + (if solid (gnus-read-group "Group name: ") + (message-unique-id))) (type (completing-read "Search engine type: " @@ -1788,15 +2030,16 @@ If SOLID (the prefix), create a solid group." 0) 'gnus-group-web-type-history)) (search - (read-string - "Search string: " + (read-string + "Search string: " (cons (or (car gnus-group-web-search-history) "") 0) 'gnus-group-web-search-history)) (method `(nnweb ,group (nnweb-search ,search) - (nnweb-type ,(intern type))))) + (nnweb-type ,(intern type)) + (nnweb-ephemeral-p t)))) (if solid - (gnus-group-make-group group method) + (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search)) (gnus-group-read-ephemeral-group group method t (cons (current-buffer) @@ -1825,8 +2068,10 @@ directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names." (interactive (list (read-file-name "Create group from directory: "))) - (or (file-exists-p dir) (error "No such directory")) - (or (file-directory-p dir) (error "Not a directory")) + (unless (file-exists-p dir) + (error "No such directory")) + (unless (file-directory-p dir) + (error "Not a directory")) (let ((ext "") (i 0) group) @@ -1860,8 +2105,8 @@ score file entries for articles to include in the group." (while (not (equal "" (setq regexp (read-string (format "Match on %s (string): " header))))) - (setq regexps (cons (list regexp nil nil 'r) regexps))) - (setq scores (cons (cons header regexps) scores))) + (push (list regexp nil nil 'r) regexps)) + (push (cons header regexps) scores)) scores))) (gnus-group-make-group group "nnkiboze" address) (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) @@ -1874,8 +2119,9 @@ score file entries for articles to include in the group." (list current-prefix-arg (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t "nnvirtual:"))) - (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) - (error "%s is not an nnvirtual group" vgroup)) + (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) + (error "%s is not an nnvirtual group" vgroup)) + (gnus-close-group vgroup) (let* ((groups (gnus-group-process-prefix n)) (method (gnus-info-method (gnus-get-info vgroup)))) (setcar (cdr method) @@ -1894,8 +2140,8 @@ 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. - (and (gnus-gethash pgroup gnus-newsrc-hashtb) - (error "Group %s already exists." pgroup)) + (when (gnus-gethash pgroup gnus-newsrc-hashtb) + (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) (gnus-group-update-group pgroup) @@ -1922,28 +2168,26 @@ score file entries for articles to include in the group." (defun gnus-group-sort-groups (func &optional reverse) "Sort the group buffer according to FUNC. -If REVERSE, reverse the sorting order." - (interactive (list gnus-group-sort-function - current-prefix-arg)) - (let ((func (cond - ((not (listp func)) func) - ((null func) func) - ((= 1 (length func)) (car func)) - (t `(lambda (t1 t2) - ,(gnus-make-sort-function - (reverse func))))))) - ;; We peel off the dummy group from the alist. - (when func - (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group") - (pop gnus-newsrc-alist)) - ;; Do the sorting. - (setq gnus-newsrc-alist - (sort gnus-newsrc-alist func)) - (when reverse - (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) - ;; Regenerate the hash table. - (gnus-make-hashtable-from-newsrc-alist) - (gnus-group-list-groups)))) +When used interactively, the sorting function used will be +determined by the `gnus-group-sort-function' variable. +If REVERSE (the prefix), reverse the sorting order." + (interactive (list gnus-group-sort-function current-prefix-arg)) + (funcall gnus-group-sort-alist-function + (gnus-make-sort-function func) reverse) + (gnus-group-list-groups)) + +(defun gnus-group-sort-flat (func reverse) + ;; We peel off the dummy group from the alist. + (when func + (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group") + (pop gnus-newsrc-alist)) + ;; Do the sorting. + (setq gnus-newsrc-alist + (sort gnus-newsrc-alist func)) + (when reverse + (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) + ;; Regenerate the hash table. + (gnus-make-hashtable-from-newsrc-alist))) (defun gnus-group-sort-groups-by-alphabet (&optional reverse) "Sort the group buffer alphabetically by group name. @@ -1981,6 +2225,77 @@ If REVERSE, sort in reverse order." (interactive "P") (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) +;;; Selected group sorting. + +(defun gnus-group-sort-selected-groups (n func &optional reverse) + "Sort the process/prefixed groups." + (interactive (list current-prefix-arg gnus-group-sort-function)) + (let ((groups (gnus-group-process-prefix n))) + (funcall gnus-group-sort-selected-function + groups (gnus-make-sort-function func) reverse) + (gnus-group-list-groups))) + +(defun gnus-group-sort-selected-flat (groups func reverse) + (let (entries infos) + ;; First find all the group entries for these groups. + (while groups + (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb)) + entries)) + ;; Then sort the infos. + (setq infos + (sort + (mapcar + (lambda (entry) (car entry)) + (setq entries (nreverse entries))) + func)) + (when reverse + (setq infos (nreverse infos))) + ;; Go through all the infos and replace the old entries + ;; with the new infos. + (while infos + (setcar entries (pop infos)) + (pop entries)) + ;; Update the hashtable. + (gnus-make-hashtable-from-newsrc-alist))) + +(defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse) + "Sort the group buffer alphabetically by group name. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse)) + +(defun gnus-group-sort-selected-groups-by-unread (&optional reverse) + "Sort the group buffer by number of unread articles. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse)) + +(defun gnus-group-sort-selected-groups-by-level (&optional reverse) + "Sort the group buffer by group level. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse)) + +(defun gnus-group-sort-selected-groups-by-score (&optional reverse) + "Sort the group buffer by group score. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse)) + +(defun gnus-group-sort-selected-groups-by-rank (&optional reverse) + "Sort the group buffer by group rank. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse)) + +(defun gnus-group-sort-selected-groups-by-method (&optional reverse) + "Sort the group buffer alphabetically by backend name. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse)) + +;;; Sorting predicates. + (defun gnus-group-sort-by-alphabet (info1 info2) "Sort alphabetically." (string< (gnus-info-group info1) (gnus-info-group info2))) @@ -2022,17 +2337,16 @@ If REVERSE, sort in reverse order." ;;; Clearing data -(defun gnus-group-clear-data (n) +(defun gnus-group-clear-data (&optional arg) "Clear all marks and read ranges from the current group." (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group info) - (while (setq group (pop groups)) - (gnus-info-clear-data (setq info (gnus-get-info group))) - (gnus-get-unread-articles-in-group info (gnus-active group) t) - (when (gnus-group-goto-group group) - (gnus-group-remove-mark group) - (gnus-group-update-group-line))))) + (gnus-group-iterate arg + (lambda (group) + (let (info) + (gnus-info-clear-data (setq info (gnus-get-info group))) + (gnus-get-unread-articles-in-group info (gnus-active group) t) + (when (gnus-group-goto-group group) + (gnus-group-update-group-line)))))) (defun gnus-group-clear-data-on-native-groups () "Clear all marks and read ranges from all native groups." @@ -2041,16 +2355,21 @@ If REVERSE, sort in reverse order." (let ((alist (cdr gnus-newsrc-alist)) info) (while (setq info (pop alist)) - (gnus-info-clear-data info)) - (gnus-get-unread-articles)))) + (when (gnus-group-native-p (gnus-info-group info)) + (gnus-info-clear-data info))) + (gnus-get-unread-articles) + (gnus-dribble-enter "") + (when (gnus-y-or-n-p + "Move the cache away to avoid problems in the future? ") + (call-interactively 'gnus-cache-move-cache))))) (defun gnus-info-clear-data (info) "Clear all marks and read ranges from INFO." (let ((group (gnus-info-group info))) (gnus-undo-register `(progn - (gnus-info-set-marks ,info ,(gnus-info-marks info)) - (gnus-info-set-read ,info ,(gnus-info-read info)) + (gnus-info-set-marks ',info ',(gnus-info-marks info) t) + (gnus-info-set-read ',info ',(gnus-info-read info)) (when (gnus-group-goto-group ,group) (gnus-group-update-group-line)))) (gnus-info-set-read info nil) @@ -2069,21 +2388,26 @@ caught up is returned." (interactive "P") (unless (gnus-group-group-name) (error "No group on the current line")) - (if (not (or (not gnus-interactive-catchup) ;Without confirmation? - gnus-expert-user - (gnus-y-or-n-p - (if all - "Do you really want to mark all articles as read? " - "Mark all unread articles as read? ")))) - n - (let ((groups (gnus-group-process-prefix n)) - (ret 0)) + (let ((groups (gnus-group-process-prefix n)) + (ret 0)) + (if (not + (or (not gnus-interactive-catchup) ;Without confirmation? + gnus-expert-user + (gnus-y-or-n-p + (format + (if all + "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) + (format "these %d groups" (length groups))))))) + n (while groups ;; Virtual groups have to be given special treatment. (let ((method (gnus-find-method-for-group (car groups)))) - (if (eq 'nnvirtual (car method)) - (nnvirtual-catchup-group - (gnus-group-real-name (car groups)) (nth 1 method) all))) + (when (eq 'nnvirtual (car method)) + (nnvirtual-catchup-group + (gnus-group-real-name (car groups)) (nth 1 method) all))) (gnus-group-remove-mark (car groups)) (if (>= (gnus-group-group-level) gnus-level-zombie) (gnus-message 2 "Dead groups can't be caught up") @@ -2111,7 +2435,7 @@ or nil if no action could be taken." (num (car entry))) ;; Do the updating only if the newsgroup isn't killed. (if (not (numberp (car entry))) - (gnus-message 1 "Can't catch up; non-active group") + (gnus-message 1 "Can't catch up %s; non-active group" group) ;; Do auto-expirable marks if that's required. (when (gnus-group-auto-expirable-p group) (gnus-add-marked-articles @@ -2128,7 +2452,8 @@ or nil if no action could be taken." (when all (gnus-add-marked-articles group 'tick nil nil 'force) (gnus-add-marked-articles group 'dormant nil nil 'force)) - (run-hooks 'gnus-group-catchup-group-hook) + (let ((gnus-newsgroup-name group)) + (run-hooks 'gnus-group-catchup-group-hook)) num)))) (defun gnus-group-expire-articles (&optional n) @@ -2152,8 +2477,8 @@ or nil if no action could be taken." expirable (gnus-compress-sequence (if expiry-wait - ;; We set the expiry variables to the groupp - ;; parameter. + ;; We set the expiry variables to the group + ;; parameter. (let ((nnmail-expiry-wait-function nil) (nnmail-expiry-wait expiry-wait)) (gnus-request-expire-articles @@ -2184,14 +2509,14 @@ or nil if no action could be taken." (string-to-int (let ((s (read-string (format "Level (default %s): " - (or (gnus-group-group-level) + (or (gnus-group-group-level) gnus-level-default-subscribed))))) (if (string-match "^\\s-*$" s) - (int-to-string (or (gnus-group-group-level) + (int-to-string (or (gnus-group-group-level) gnus-level-default-subscribed)) s))))) - (or (and (>= level 1) (<= level gnus-level-killed)) - (error "Illegal level: %d" level)) + (unless (and (>= level 1) (<= level gnus-level-killed)) + (error "Illegal level: %d" level)) (let ((groups (gnus-group-process-prefix n)) group) (while (setq group (pop groups)) @@ -2204,7 +2529,17 @@ or nil if no action could be taken." (gnus-group-update-group-line))) (gnus-group-position-point)) -(defun gnus-group-unsubscribe-current-group (&optional n) +(defun gnus-group-unsubscribe (&optional n) + "Unsubscribe the current group." + (interactive "P") + (gnus-group-unsubscribe-current-group n 'unsubscribe)) + +(defun gnus-group-subscribe (&optional n) + "Unsubscribe the current group." + (interactive "P") + (gnus-group-unsubscribe-current-group n 'subscribe)) + +(defun gnus-group-unsubscribe-current-group (&optional n do-sub) "Toggle subscription of the current group. If given numerical prefix, toggle the N next groups." (interactive "P") @@ -2215,9 +2550,17 @@ If given numerical prefix, toggle the N next groups." groups (cdr groups)) (gnus-group-remove-mark group) (gnus-group-unsubscribe-group - group (if (<= (gnus-group-group-level) gnus-level-subscribed) - gnus-level-default-unsubscribed - gnus-level-default-subscribed) t) + 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))) @@ -2229,7 +2572,7 @@ group line." (list (completing-read "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) - nil + nil 'gnus-group-history))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond @@ -2238,7 +2581,7 @@ group line." (newsrc ;; Toggle subscription flag. (gnus-group-change-level - newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) + newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc)) gnus-level-subscribed) (1+ gnus-level-subscribed) gnus-level-default-subscribed))) @@ -2254,8 +2597,8 @@ group line." (or (and (member group gnus-zombie-list) gnus-level-zombie) gnus-level-killed) - (and (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) + (when (gnus-group-group-name) + (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) (unless silent (gnus-group-update-group group))) (t (error "No such newsgroup: %s" group))) @@ -2266,8 +2609,8 @@ group line." If given a negative prefix, move down instead. The difference between N and the number of steps taken is returned." (interactive "p") - (or (gnus-group-group-name) - (error "No group on current line")) + (unless (gnus-group-group-name) + (error "No group on current line")) (gnus-group-kill-group 1) (prog1 (forward-line (- n)) @@ -2323,8 +2666,8 @@ of groups killed." (setq entry (gnus-gethash group gnus-newsrc-hashtb))) (gnus-undo-register `(progn - (gnus-group-goto-group ,(gnus-group-group-name)) - (gnus-group-yank-group))) + (gnus-group-goto-group ,(gnus-group-group-name)) + (gnus-group-yank-group))) (push (cons (car entry) (nth 2 entry)) gnus-list-of-killed-groups)) (gnus-group-change-level @@ -2364,8 +2707,8 @@ is returned." (setq arg (or arg 1)) (let (info group prev out) (while (>= (decf arg) 0) - (if (not (setq info (pop gnus-list-of-killed-groups))) - (error "No more newsgroups to yank")) + (when (not (setq info (pop gnus-list-of-killed-groups))) + (error "No more newsgroups to yank")) (push (setq group (nth 1 info)) out) ;; Find which newsgroup to insert this one before - search ;; backward until something suitable is found. If there are no @@ -2379,7 +2722,7 @@ is returned." (gnus-group-insert-group-line-info group) (gnus-undo-register `(when (gnus-group-goto-group ,group) - (gnus-group-kill-group 1)))) + (gnus-group-kill-group 1)))) (forward-line -1) (gnus-group-position-point) (if (< (length out) 2) (car out) (nreverse out)))) @@ -2464,14 +2807,21 @@ entail asking the server for the groups." (lambda (sym) (and (boundp sym) (symbol-value sym) - (setq list (cons (symbol-name sym) list)))) + (push (symbol-name sym) list))) gnus-active-hashtb) list) 'string<)) - (buffer-read-only nil)) + (buffer-read-only nil) + group) (erase-buffer) (while groups - (gnus-group-insert-group-line-info (pop groups))) + (gnus-add-text-properties + (point) (prog1 (1+ (point)) + (insert " *: " + (setq group (pop groups)) "\n")) + (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) + 'gnus-unread t + 'gnus-level (inline (gnus-group-level group))))) (goto-char (point-min)))) (defun gnus-activate-all-groups (level) @@ -2488,15 +2838,24 @@ re-scanning. If ARG is non-nil and not a number, this will force \"hard\" re-reading of the active files from all servers." (interactive "P") (run-hooks 'gnus-get-new-news-hook) + + ;; Read any slave files. + (unless gnus-slave + (gnus-master-read-slave-newsrc)) + ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem + (when (and gnus-use-nocem (null arg)) (gnus-nocem-scan-groups)) ;; If ARG is not a number, then we read the active file. (when (and arg (not (numberp arg))) (let ((gnus-read-active-file t)) (gnus-read-active-file)) - (setq arg nil)) + (setq arg nil) + + ;; If the user wants it, we scan for new groups. + (when (eq gnus-check-new-newsgroups 'always) + (gnus-find-new-newsgroups))) (setq arg (gnus-group-default-level arg t)) (if (and gnus-read-active-file (not arg)) @@ -2506,7 +2865,8 @@ re-scanning. If ARG is non-nil and not a number, this will force (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) (gnus-get-unread-articles arg))) (run-hooks 'gnus-after-getting-new-news-hook) - (gnus-group-list-groups)) + (gnus-group-list-groups (and (numberp arg) + (max (car gnus-group-list-mode) arg)))) (defun gnus-group-get-new-news-this-group (&optional n) "Check for newly arrived news in the current group (and the N-1 next groups). @@ -2515,7 +2875,8 @@ If N is negative, this group and the N-1 previous groups will be checked." (interactive "P") (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) - (beg (unless n (point))) + (beg (unless n + (point))) group) (while (setq group (pop groups)) (gnus-group-remove-mark group) @@ -2532,7 +2893,8 @@ If N is negative, this group and the N-1 previous groups will be checked." 'denied) (gnus-error 3 "Server denied access") (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) - (when beg (goto-char beg)) + (when beg + (goto-char beg)) (when gnus-goto-next-group-when-activating (gnus-group-next-unread-group 1 t)) (gnus-summary-position-point) @@ -2562,8 +2924,9 @@ to use." (gnus-group-real-name group))) (if (not (file-exists-p file)) (gnus-message 1 "No such file: %s" file) - (find-file file) - (setq found t))))) + (let ((enable-local-variables nil)) + (find-file file) + (setq found t)))))) (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." @@ -2574,25 +2937,27 @@ to use." (when (and force gnus-description-hashtb) (gnus-sethash mname nil gnus-description-hashtb)) - (or group (error "No group name given")) - (and (or (and gnus-description-hashtb - ;; We check whether this group's method has been - ;; queried for a description file. - (gnus-gethash mname gnus-description-hashtb)) - (setq desc (gnus-group-get-description group)) - (gnus-read-descriptions-file method)) - (gnus-message 1 - (or desc (gnus-gethash group gnus-description-hashtb) - "No description available"))))) + (unless group + (error "No group name given")) + (when (or (and gnus-description-hashtb + ;; We check whether this group's method has been + ;; queried for a description file. + (gnus-gethash mname gnus-description-hashtb)) + (setq desc (gnus-group-get-description group)) + (gnus-read-descriptions-file method)) + (gnus-message 1 + (or desc (gnus-gethash group gnus-description-hashtb) + "No description available"))))) ;; Suggested by Per Abrahamsen . (defun gnus-group-describe-all-groups (&optional force) "Pop up a buffer with descriptions of all newsgroups." (interactive "P") - (and force (setq gnus-description-hashtb nil)) - (if (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) + (when force + (setq gnus-description-hashtb nil)) + (when (not (or gnus-description-hashtb + (gnus-read-all-descriptions-files))) + (error "Couldn't request descriptions file")) (let ((buffer-read-only nil) b) (erase-buffer) @@ -2621,7 +2986,7 @@ to use." (lambda (group) (and (symbol-name group) (string-match regexp (symbol-name group)) - (setq groups (cons (symbol-name group) groups)))) + (push (symbol-name group) groups))) gnus-active-hashtb) ;; Also go through all descriptions that are known to Gnus. (when search-description @@ -2629,7 +2994,7 @@ to use." (lambda (group) (and (string-match regexp (symbol-value group)) (gnus-active (symbol-name group)) - (setq groups (cons (symbol-name group) groups)))) + (push (symbol-name group) groups))) gnus-description-hashtb)) (if (not groups) (gnus-message 3 "No groups matched \"%s\"." regexp) @@ -2641,13 +3006,12 @@ to use." (setq groups (sort groups 'string<)) (while groups ;; Groups may be entered twice into the list of groups. - (if (not (string= (car groups) prev)) - (progn - (insert (setq prev (car groups)) "\n") - (if (and gnus-description-hashtb - (setq des (gnus-gethash (car groups) - gnus-description-hashtb))) - (insert " " des "\n")))) + (when (not (string= (car groups) prev)) + (insert (setq prev (car groups)) "\n") + (when (and gnus-description-hashtb + (setq des (gnus-gethash (car groups) + gnus-description-hashtb))) + (insert " " des "\n"))) (setq groups (cdr groups))) (goto-char (point-min)))) (pop-to-buffer obuf))) @@ -2655,9 +3019,9 @@ to use." (defun gnus-group-description-apropos (regexp) "List all newsgroups that have names or descriptions that match a regexp." (interactive "sGnus description apropos (regexp): ") - (if (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) + (when (not (or gnus-description-hashtb + (gnus-read-all-descriptions-files))) + (error "Couldn't request descriptions file")) (gnus-group-apropos regexp t)) ;; Suggested by Per Abrahamsen . @@ -2674,8 +3038,8 @@ This command may read the active file." (when (and level (> (prefix-numeric-value level) gnus-level-killed)) (gnus-get-killed-groups)) - (gnus-group-prepare-flat (or level gnus-level-subscribed) - all (or lowest 1) regexp) + (gnus-group-prepare-flat + (or level gnus-level-subscribed) all (or lowest 1) regexp) (goto-char (point-min)) (gnus-group-position-point)) @@ -2685,6 +3049,8 @@ If the prefix LEVEL is non-nil, it should be a number that says which level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") + (when level + (setq level (prefix-numeric-value level))) (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) ;; Suggested by Jack Vinson . @@ -2700,8 +3066,8 @@ If FORCE, force saving whether it is necessary or not." (when (gnus-yes-or-no-p (format "Are you sure you want to restart Gnus? ")) (gnus-save-newsrc-file) - (gnus-setup-news 'force) - (gnus-group-list-groups arg))) + (gnus-clear-system) + (gnus))) (defun gnus-group-read-init-file () "Read the Gnus elisp init file." @@ -2768,7 +3134,7 @@ The hook gnus-suspend-gnus-hook is called before actually suspending." "Quit reading news after updating .newsrc.eld and .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting." (interactive) - (when + (when (or noninteractive ;For gnus-batch-kill (not gnus-interactive-exit) ;Without confirmation gnus-expert-user @@ -2923,48 +3289,37 @@ and the second element is the address." (sort (nconc (gnus-uncompress-range (cdr m)) (copy-sequence articles)) '<) t)))))) -(defun gnus-update-read-articles (group unread) - "Update the list of read articles in GROUP." - (let* ((active (or gnus-newsgroup-active (gnus-active group))) - (entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (prev 1) - (unread (sort (copy-sequence unread) '<)) - read) - (if (or (not info) (not active)) - ;; There is no info on this group if it was, in fact, - ;; killed. Gnus stores no information on killed groups, so - ;; there's nothing to be done. - ;; One could store the information somewhere temporarily, - ;; perhaps... Hmmm... - () - ;; Remove any negative articles numbers. - (while (and unread (< (car unread) 0)) - (setq unread (cdr unread))) - ;; Remove any expired article numbers - (while (and unread (< (car unread) (car active))) - (setq unread (cdr unread))) - ;; Compute the ranges of read articles by looking at the list of - ;; unread articles. - (while unread - (if (/= (car unread) prev) - (setq read (cons (if (= prev (1- (car unread))) prev - (cons prev (1- (car unread)))) read))) - (setq prev (1+ (car unread))) - (setq unread (cdr unread))) - (when (<= prev (cdr active)) - (setq read (cons (cons prev (cdr active)) read))) - (gnus-undo-register - `(progn - (gnus-info-set-marks ,info ,(gnus-info-marks info)) - (gnus-info-set-read ,info ,(gnus-info-read info)) - (gnus-get-unread-articles-in-group ,info (gnus-active ,group)))) - ;; Enter this list into the group info. - (gnus-info-set-read - info (if (> (length read) 1) (nreverse read) read)) - ;; Set the number of unread articles in gnus-newsrc-hashtb. - (gnus-get-unread-articles-in-group info (gnus-active group)) - t))) +;;; +;;; Group timestamps +;;; + +(defun gnus-group-set-timestamp () + "Change the timestamp of the current group to the current time. +This function can be used in hooks like `gnus-select-group-hook' +or `gnus-group-catchup-group-hook'." + (when gnus-newsgroup-name + (let ((time (current-time))) + (setcdr (cdr time) nil) + (gnus-group-set-parameter gnus-newsgroup-name 'timestamp time)))) + +(defsubst gnus-group-timestamp (group) + "Return the timestamp for GROUP." + (gnus-group-get-parameter group 'timestamp)) + +(defun gnus-group-timestamp-delta (group) + "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." + (let* ((time (or (gnus-group-timestamp group) + (list 0 0))) + (delta (gnus-time-minus (current-time) time))) + (+ (* (nth 0 delta) 65536.0) + (nth 1 delta)))) + +(defun gnus-group-timestamp-string (group) + "Return a string of the timestamp for GROUP." + (let ((time (gnus-group-timestamp group))) + (if (not time) + "" + (gnus-time-iso8601 time)))) (provide 'gnus-group)