projects / gnus / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Make nnir work by default.
[gnus] / lisp / gnus-group.el
diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index 12239c3..7e2ea37 100644 (file)
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -1,34 +1,37 @@
 ;;; gnus-group.el --- group mode commands for Gnus
 ;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;;; Code:
 
 
 ;;; Commentary:
 
 ;;; Code:
 
+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
 (eval-when-compile
 (eval-when-compile
-  (require 'cl)
-  (defvar tool-bar-map))
+  (require 'cl))
+(defvar tool-bar-mode)
 
 (require 'gnus)
 (require 'gnus-start)
 
 (require 'gnus)
 (require 'gnus-start)
@@ -38,24 +41,23 @@
 (require 'gnus-range)
 (require 'gnus-win)
 (require 'gnus-undo)
 (require 'gnus-range)
 (require 'gnus-win)
 (require 'gnus-undo)
+(require 'gmm-utils)
 (require 'time-date)
 (require 'gnus-ems)
 
 (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)))
 
 
-(defcustom gnus-group-archive-directory
-  "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
-  "*The address of the (ding) archives."
-  :group 'gnus-group-foreign
-  :type 'directory)
+(autoload 'gnus-agent-total-fetched-for "gnus-agent")
+(autoload 'gnus-cache-total-fetched-for "gnus-cache")
 
 
-(defcustom gnus-group-recent-archive-directory
-  "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
-  "*The address of the most recent (ding) articles."
-  :group 'gnus-group-foreign
-  :type 'directory)
+(autoload 'gnus-group-make-nnir-group "nnir")
 
 
-(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)
   "*Message displayed by Gnus when no groups are available."
   :group 'gnus-start
   :type 'string)
@@ -98,6 +100,18 @@ If nil, no groups are permanently visible."
   :group 'gnus-group-listing
   :type '(choice regexp (const nil)))
 
   :group 'gnus-group-listing
   :type '(choice regexp (const nil)))
 
+(defcustom gnus-safe-html-newsgroups "\\`nnrss[+:]"
+  "Groups in which links in html articles are considered all safe.
+The value may be a regexp matching those groups, a list of group names,
+or nil.  This overrides `mm-w3m-safe-url-regexp' (which see).  This is
+effective only when emacs-w3m renders html articles, i.e., in the case
+`mm-text-html-renderer' is set to `w3m'."
+  :version "23.2"
+  :group 'gnus-group-various
+  :type '(choice regexp
+                (repeat :tag "List of group names" (string :tag "Group"))
+                (const nil)))
+
 (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."
 (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."
@@ -125,7 +139,7 @@ for the groups to be sorted.  Pre-made functions include
 `gnus-group-sort-by-score', `gnus-group-sort-by-method',
 `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
 
 `gnus-group-sort-by-score', `gnus-group-sort-by-method',
 `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
 
-This variable can also be a list of sorting functions. In that case,
+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."
   :group 'gnus-group-listing
 the most significant sort function should be the last function in the
 list."
   :group 'gnus-group-listing
@@ -145,7 +159,7 @@ list."
                         (function-item gnus-group-sort-by-rank)
                         (function :tag "other" nil))))
 
                         (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%)\n"
   "*Format of group lines.
 It works along the same lines as a normal formatting string,
 with some simple extensions.
   "*Format of group lines.
 It works along the same lines as a normal formatting string,
 with some simple extensions.
@@ -173,11 +187,11 @@ 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, \"%\")
 %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'.
 %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
 %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
@@ -187,15 +201,15 @@ with some simple extensions.
 
 Note that this format specification is not always respected.  For
 reasons of efficiency, when listing killed groups, this specification
 
 Note that this format specification is not always respected.  For
 reasons of efficiency, when listing killed groups, this specification
-is ignored altogether. If the spec is changed considerably, your
+is ignored altogether.  If the spec is changed considerably, your
 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
 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'."
 
 General format specifiers can also be used.
 See Info node `(gnus)Formatting Variables'."
@@ -268,25 +282,22 @@ If you want to modify the group buffer, you can use this hook."
   :group 'gnus-exit
   :type 'hook)
 
   :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."
+(defcustom gnus-group-update-hook nil
+  "Hook called when a group line is changed."
   :group 'gnus-group-visual
   :group 'gnus-group-visual
+  :version "24.1"
   :type 'hook)
 
 (defcustom gnus-useful-groups
   :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-bug archive"
-     "gnus-bug"
-     (nndir "/ftp@ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/"))
-    ("Gnus help group"
+  '(("(ding) mailing list mirrored at gmane.org"
+     "gmane.emacs.gnus.general"
+     (nntp "Gmane"
+          (nntp-address "news.gmane.org")))
+    ("Gnus bug archive"
+     "gnus.gnus-bug"
+     (nntp "news.gnus.org"
+          (nntp-address "news.gnus.org")))
+    ("Local Gnus help group"
      "gnus-help"
      (nndoc "gnus-help"
            (nndoc-article-type mbox)
      "gnus-help"
      (nndoc "gnus-help"
            (nndoc-article-type mbox)
@@ -305,50 +316,50 @@ variable."
 (defcustom gnus-group-highlight
   '(;; Mail.
     ((and mailp (= unread 0) (eq level 1)) .
 (defcustom gnus-group-highlight
   '(;; Mail.
     ((and mailp (= unread 0) (eq level 1)) .
-     gnus-group-mail-1-empty-face)
+     gnus-group-mail-1-empty)
     ((and mailp (eq level 1)) .
     ((and mailp (eq level 1)) .
-     gnus-group-mail-1-face)
+     gnus-group-mail-1)
     ((and mailp (= unread 0) (eq level 2)) .
     ((and mailp (= unread 0) (eq level 2)) .
-     gnus-group-mail-2-empty-face)
+     gnus-group-mail-2-empty)
     ((and mailp (eq level 2)) .
     ((and mailp (eq level 2)) .
-     gnus-group-mail-2-face)
+     gnus-group-mail-2)
     ((and mailp (= unread 0) (eq level 3)) .
     ((and mailp (= unread 0) (eq level 3)) .
-     gnus-group-mail-3-empty-face)
+     gnus-group-mail-3-empty)
     ((and mailp (eq level 3)) .
     ((and mailp (eq level 3)) .
-     gnus-group-mail-3-face)
+     gnus-group-mail-3)
     ((and mailp (= unread 0)) .
     ((and mailp (= unread 0)) .
-     gnus-group-mail-low-empty-face)
+     gnus-group-mail-low-empty)
     ((and mailp) .
     ((and mailp) .
-     gnus-group-mail-low-face)
+     gnus-group-mail-low)
     ;; News.
     ((and (= unread 0) (eq level 1)) .
     ;; News.
     ((and (= unread 0) (eq level 1)) .
-     gnus-group-news-1-empty-face)
+     gnus-group-news-1-empty)
     ((and (eq level 1)) .
     ((and (eq level 1)) .
-     gnus-group-news-1-face)
+     gnus-group-news-1)
     ((and (= unread 0) (eq level 2)) .
     ((and (= unread 0) (eq level 2)) .
-     gnus-group-news-2-empty-face)
+     gnus-group-news-2-empty)
     ((and (eq level 2)) .
     ((and (eq level 2)) .
-     gnus-group-news-2-face)
+     gnus-group-news-2)
     ((and (= unread 0) (eq level 3)) .
     ((and (= unread 0) (eq level 3)) .
-     gnus-group-news-3-empty-face)
+     gnus-group-news-3-empty)
     ((and (eq level 3)) .
     ((and (eq level 3)) .
-     gnus-group-news-3-face)
+     gnus-group-news-3)
     ((and (= unread 0) (eq level 4)) .
     ((and (= unread 0) (eq level 4)) .
-     gnus-group-news-4-empty-face)
+     gnus-group-news-4-empty)
     ((and (eq level 4)) .
     ((and (eq level 4)) .
-     gnus-group-news-4-face)
+     gnus-group-news-4)
     ((and (= unread 0) (eq level 5)) .
     ((and (= unread 0) (eq level 5)) .
-     gnus-group-news-5-empty-face)
+     gnus-group-news-5-empty)
     ((and (eq level 5)) .
     ((and (eq level 5)) .
-     gnus-group-news-5-face)
+     gnus-group-news-5)
     ((and (= unread 0) (eq level 6)) .
     ((and (= unread 0) (eq level 6)) .
-     gnus-group-news-6-empty-face)
+     gnus-group-news-6-empty)
     ((and (eq level 6)) .
     ((and (eq level 6)) .
-     gnus-group-news-6-face)
+     gnus-group-news-6)
     ((and (= unread 0)) .
     ((and (= unread 0)) .
-     gnus-group-news-low-empty-face)
+     gnus-group-news-low-empty)
     (t .
     (t .
-     gnus-group-news-low-face))
+     gnus-group-news-low))
   "*Controls the highlighting of group buffer lines.
 
 Below is a list of `Form'/`Face' pairs.  When deciding how a a
   "*Controls the highlighting of group buffer lines.
 
 Below is a list of `Form'/`Face' pairs.  When deciding how a a
@@ -371,6 +382,7 @@ score: The score of the group.
 ticked: The number of ticked articles."
   :group 'gnus-group-visual
   :type '(repeat (cons (sexp :tag "Form") face)))
 ticked: The number of ticked articles."
   :group 'gnus-group-visual
   :type '(repeat (cons (sexp :tag "Form") face)))
+(put 'gnus-group-highlight 'risky-local-variable t)
 
 (defcustom gnus-new-mail-mark ?%
   "Mark used for groups with new mail."
 
 (defcustom gnus-new-mail-mark ?%
   "Mark used for groups with new mail."
@@ -378,7 +390,7 @@ ticked: The number of ticked articles."
   :type 'character)
 
 (defgroup gnus-group-icons nil
   :type 'character)
 
 (defgroup gnus-group-icons nil
-  "Add Icons to your group buffer.  "
+  "Add Icons to your group buffer."
   :group 'gnus-group-visual)
 
 (defcustom gnus-group-icon-list
   :group 'gnus-group-visual)
 
 (defcustom gnus-group-icon-list
@@ -402,12 +414,12 @@ 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.
 unread: The number of unread articles in the group.
 method: The select method used.
 mailp: Whether it's a mail group or not.
-newsp: Whether it's a news group or not
 level: The level of the group.
 score: The score of the group.
 ticked: The number of ticked articles."
   :group 'gnus-group-icons
   :type '(repeat (cons (sexp :tag "Form") file)))
 level: The level of the group.
 score: The score of the group.
 ticked: The number of ticked articles."
   :group 'gnus-group-icons
   :type '(repeat (cons (sexp :tag "Form") file)))
+(put 'gnus-group-icon-list 'risky-local-variable t)
 
 (defcustom gnus-group-name-charset-method-alist nil
   "Alist of method and the charset for group names.
 
 (defcustom gnus-group-name-charset-method-alist nil
   "Alist of method and the charset for group names.
@@ -432,12 +444,20 @@ For example:
 
 (defcustom gnus-group-jump-to-group-prompt nil
   "Default prompt for `gnus-group-jump-to-group'.
 
 (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")
   :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.
 
 (defvar gnus-group-listing-limit 1000
   "*A limit of the number of groups when listing.
@@ -474,31 +494,44 @@ simple manner.")
                   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
              (t number)) ?s)
     (?R gnus-tmp-number-of-read ?s)
                   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
              (t number)) ?s)
     (?R gnus-tmp-number-of-read ?s)
-    (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
+    (?U (if (gnus-active gnus-tmp-group)
+           (gnus-number-of-unseen-articles-in-group gnus-tmp-group)
+         "*")
+       ?s)
     (?t gnus-tmp-number-total ?d)
     (?y gnus-tmp-number-of-unread ?s)
     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
     (?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)
     (?t gnus-tmp-number-total ?d)
     (?y gnus-tmp-number-of-unread ?s)
     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
     (?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)
     (?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)
     (?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)
     (?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)
     (?z gnus-tmp-news-method-string ?s)
    &n