Sync up with Gnus 5.6.30.

[elisp/gnus.git-] / lisp / gnus.el

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 994b68e..a25977f 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -2,7 +2,7 @@
 ;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>

-;;     Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;;     Lars Magne Ingebrigtsen <larsi@gnus.org>

 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.

@@ -41,6 +41,10 @@
   :group 'news
   :group 'mail)
 
   :group 'news
   :group 'mail)
 

+(defgroup gnus-cache nil
+  "Cache interface."
+  :group 'gnus)
+

 (defgroup gnus-start nil
   "Starting your favorite newsreader."
   :group 'gnus)
 (defgroup gnus-start nil
   "Starting your favorite newsreader."
   :group 'gnus)

@@ -246,11 +250,15 @@ is restarted, and sometimes reloaded."
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 

-(defconst gnus-version-number "6.0.5"
+(defconst gnus-product-name "Shoe-gnus"
+  "Product name of this version of gnus.")
+
+(defconst gnus-version-number "6.8.4"

   "Version number for this version of gnus.")
 
 (defconst gnus-version
   "Version number for this version of gnus.")
 
 (defconst gnus-version

-  (format "Semi-gnus %s (based on Quassia Gnus v0.31)" gnus-version-number)
+  (format "%s %s (based on Gnus 5.6.30; for SEMI 1.8, FLIM 1.8/1.9)"
+          gnus-product-name gnus-version-number)

   "Version string for this version of gnus.")
 
 (defcustom gnus-inhibit-startup-message nil
   "Version string for this version of gnus.")
 
 (defcustom gnus-inhibit-startup-message nil

@@ -702,8 +710,13 @@ All other Gnus path variables are initialized from this variable."
   :type 'directory)
 
 (defcustom gnus-directory (or (getenv "SAVEDIR")
   :type 'directory)
 
 (defcustom gnus-directory (or (getenv "SAVEDIR")

-                     (nnheader-concat gnus-home-directory "News/"))
-  "*Directory variable from which all other Gnus file variables are derived."
+                             (nnheader-concat gnus-home-directory "News/"))
+  "*Directory variable from which all other Gnus file variables are derived.
+
+Note that Gnus is mostly loaded when the `.gnus.el' file is read.
+This means that other directory variables that are initialized from
+this variable won't be set properly if you set this variable in `.gnus.el'.
+Set this variable in `.emacs' instead."

   :group 'gnus-files
   :type 'directory)
 
   :group 'gnus-files
   :type 'directory)
 

@@ -830,6 +843,7 @@ that case, just return a fully prefixed name of the group --
 \"nnml+private:mail.misc\", for instance."
   :group 'gnus-message
   :type '(choice (const :tag "none" nil)
 \"nnml+private:mail.misc\", for instance."
   :group 'gnus-message
   :type '(choice (const :tag "none" nil)

+                sexp

                 string))
 
 (defcustom gnus-secondary-servers nil
                 string))
 
 (defcustom gnus-secondary-servers nil

@@ -1092,13 +1106,14 @@ commands will still require prompting."
 
 (defcustom gnus-extract-address-components 'gnus-extract-address-components
   "*Function for extracting address components from a From header.
 
 (defcustom gnus-extract-address-components 'gnus-extract-address-components
   "*Function for extracting address components from a From header.

-Two pre-defined function exist: `gnus-extract-address-components',
-which is the default, quite fast, and too simplistic solution, and
-`mail-extract-address-components', which works much better, but is
-slower."
+
+`gnus-extract-address-components' is a quite fast, and too simplistic.
+`mail-extract-address-components' works much better, but is slower.
+`std11-extract-address-components' also works better, and less slower."

   :group 'gnus-summary-format
   :type '(radio (function-item gnus-extract-address-components)
                (function-item mail-extract-address-components)
   :group 'gnus-summary-format
   :type '(radio (function-item gnus-extract-address-components)
                (function-item mail-extract-address-components)

+               (function-item std11-extract-address-components)

                (function :tag "Other")))
 
 (defcustom gnus-carpal nil
                (function :tag "Other")))
 
 (defcustom gnus-carpal nil

@@ -1126,8 +1141,9 @@ slower."
     ("nnsoup" post-mail address)
     ("nndraft" post-mail)
     ("nnfolder" mail respool address)
     ("nnsoup" post-mail address)
     ("nndraft" post-mail)
     ("nnfolder" mail respool address)

-    ("nngateway" none address prompt-address physical-address)
+    ("nngateway" post-mail address prompt-address physical-address)

     ("nnweb" none)
     ("nnweb" none)

+    ("nnlistserv" none)

     ("nnagent" post-mail))
   "*An alist of valid select methods.
 The first element of each list lists should be a string with the name
     ("nnagent" post-mail))
   "*An alist of valid select methods.
 The first element of each list lists should be a string with the name

@@ -1331,7 +1347,6 @@ want."
             gnus-article-emphasize
             gnus-article-fill-cited-article
             gnus-article-remove-cr
             gnus-article-emphasize
             gnus-article-fill-cited-article
             gnus-article-remove-cr

-            gnus-article-de-quoted-unreadable

             gnus-summary-stop-page-breaking
             ;; gnus-summary-caesar-message
             ;; gnus-summary-verbose-headers
             gnus-summary-stop-page-breaking
             ;; gnus-summary-caesar-message
             ;; gnus-summary-verbose-headers

@@ -1402,12 +1417,19 @@ want."
 (defvar gnus-server-alist nil
   "List of available servers.")
 
 (defvar gnus-server-alist nil
   "List of available servers.")
 

+(defcustom gnus-cache-directory
+  (nnheader-concat gnus-directory "cache/")
+  "*The directory where cached articles will be stored."
+  :group 'gnus-cache
+  :type 'directory)
+

 (defvar gnus-predefined-server-alist
   `(("cache"
 (defvar gnus-predefined-server-alist
   `(("cache"

-     (nnspool "cache"
-             (nnspool-spool-directory "~/News/cache/")
-             (nnspool-nov-directory "~/News/cache/")
-             (nnspool-active-file "~/News/cache/active"))))
+     nnspool "cache"
+     (nnspool-spool-directory gnus-cache-directory)
+     (nnspool-nov-directory gnus-cache-directory)
+     (nnspool-active-file
+      (nnheader-concat gnus-cache-directory "active"))))

   "List of predefined (convenience) servers.")
 
 (defvar gnus-topic-indentation "") ;; Obsolete variable.
   "List of predefined (convenience) servers.")
 
 (defvar gnus-topic-indentation "") ;; Obsolete variable.

@@ -1606,8 +1628,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-uu-decode-binhex gnus-uu-decode-uu-view
       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
       gnus-uu-decode-binhex gnus-uu-decode-uu-view
       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view

-      gnus-uu-decode-binhex-view)
-     ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh)
+      gnus-uu-decode-binhex-view gnus-uu-unmark-thread)
+     ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh
+      gnus-uu-unmark-thread)

      ("gnus-msg" (gnus-summary-send-map keymap)
       gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
      ("gnus-msg" :interactive t
      ("gnus-msg" (gnus-summary-send-map keymap)
       gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
      ("gnus-msg" :interactive t

@@ -1628,12 +1651,16 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
      ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
       gnus-list-of-unread-articles gnus-list-of-read-articles
       gnus-offer-save-summaries gnus-make-thread-indent-array
      ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
       gnus-list-of-unread-articles gnus-list-of-read-articles
       gnus-offer-save-summaries gnus-make-thread-indent-array

-      gnus-summary-exit gnus-update-read-articles)
+      gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject
+      gnus-summary-skip-intangible gnus-summary-article-number
+      gnus-data-header gnus-data-find)

      ("gnus-group" gnus-group-insert-group-line gnus-group-quit
       gnus-group-list-groups gnus-group-first-unread-group
       gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
       gnus-group-setup-buffer gnus-group-get-new-news
      ("gnus-group" gnus-group-insert-group-line gnus-group-quit
       gnus-group-list-groups gnus-group-first-unread-group
       gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
       gnus-group-setup-buffer gnus-group-get-new-news

-      gnus-group-make-help-group gnus-group-update-group)
+      gnus-group-make-help-group gnus-group-update-group
+      gnus-clear-inboxes-moved gnus-group-iterate
+      gnus-group-group-name)

      ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
       gnus-backlog-remove-article)
      ("gnus-art" gnus-article-read-summary-keys gnus-article-save
      ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
       gnus-backlog-remove-article)
      ("gnus-art" gnus-article-read-summary-keys gnus-article-save

@@ -1646,7 +1673,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-article-hide-headers gnus-article-hide-boring-headers
       gnus-article-treat-overstrike gnus-article-word-wrap
       gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
       gnus-article-hide-headers gnus-article-hide-boring-headers
       gnus-article-treat-overstrike gnus-article-word-wrap
       gnus-article-remove-cr gnus-article-remove-trailing-blank-lines

-      gnus-article-display-x-face gnus-article-de-quoted-unreadable
+      gnus-article-display-x-face

       gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp
       gnus-article-hide-pem gnus-article-hide-signature
       gnus-article-strip-leading-blank-lines gnus-article-date-local
       gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp
       gnus-article-hide-pem gnus-article-hide-signature
       gnus-article-strip-leading-blank-lines gnus-article-date-local

@@ -1671,7 +1698,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-async-halt-prefetch)
      ("gnus-agent" gnus-open-agent gnus-agent-get-function
       gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p
       gnus-async-halt-prefetch)
      ("gnus-agent" gnus-open-agent gnus-agent-get-function
       gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p

-      gnus-agent-get-undownloaded-list gnus-agent-fetch-session)
+      gnus-agent-get-undownloaded-list gnus-agent-fetch-session
+      gnus-summary-set-agent-mark gnus-agent-save-group-info)

      ("gnus-agent" :interactive t
       gnus-unplugged gnus-agentize gnus-agent-batch)
      ("gnus-vm" :interactive t gnus-summary-save-in-vm
      ("gnus-agent" :interactive t
       gnus-unplugged gnus-agentize gnus-agent-batch)
      ("gnus-vm" :interactive t gnus-summary-save-in-vm

@@ -1804,14 +1832,6 @@ This restriction may disappear in later versions of Gnus."
   "Set GROUP's active info."
   `(gnus-sethash ,group ,active gnus-active-hashtb))
 
   "Set GROUP's active info."
   `(gnus-sethash ,group ,active gnus-active-hashtb))
 

-(defun gnus-alive-p ()
-  "Say whether Gnus is running or not."
-  (and gnus-group-buffer
-       (get-buffer gnus-group-buffer)
-       (save-excursion
-        (set-buffer gnus-group-buffer)
-        (eq major-mode 'gnus-group-mode))))
-

 ;; Info access macros.
 
 (defmacro gnus-info-group (info)
 ;; Info access macros.
 
 (defmacro gnus-info-group (info)

@@ -1960,13 +1980,15 @@ If ARG, insert string at point."
   "Return VERSION as a floating point number."
   (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
            (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
   "Return VERSION as a floating point number."
   (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
            (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))

-    (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
-          (number (match-string 2 version))
-          major minor least)
-      (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
-      (setq major (string-to-number (match-string 1 number)))
-      (setq minor (string-to-number (match-string 2 number)))
-      (setq least (if (match-beginning 3)
+    (let ((alpha (and (match-beginning 1) (match-string 1 version)))
+         (number (match-string 2 version))
+         major minor least)
+      (unless (string-match
+              "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
+       (error "Invalid version string: %s" version))
+      (setq major (string-to-number (match-string 1 number))
+           minor (string-to-number (match-string 2 number))
+           least (if (match-beginning 3)

                      (string-to-number (match-string 3 number))
                    0))
       (string-to-number
                      (string-to-number (match-string 3 number))
                    0))
       (string-to-number

@@ -1975,7 +1997,11 @@ If ARG, insert string at point."
                   (cond
                    ((member alpha '("(ding)" "d")) "4.99")
                    ((member alpha '("September" "s")) "5.01")
                   (cond
                    ((member alpha '("(ding)" "d")) "4.99")
                    ((member alpha '("September" "s")) "5.01")

-                   ((member alpha '("Red" "r")) "5.03"))
+                   ((member alpha '("Red" "r")) "5.03")
+                   ((member alpha '("Quassia" "q")) "5.05")
+                   ((member alpha '("p")) "5.07")
+                   ((member alpha '("o")) "5.09")
+                   ((member alpha '("n")) "5.11"))

                   minor least)
         (format "%d.%02d%02d" major minor least))))))
 
                   minor least)
         (format "%d.%02d%02d" major minor least))))))
 

@@ -2018,7 +2044,7 @@ g -- Group name."
        (setq prompt (match-string 1 string)))
       (setq i (match-end 0))
       ;; We basically emulate just about everything that
        (setq prompt (match-string 1 string)))
       (setq i (match-end 0))
       ;; We basically emulate just about everything that

-      ;; `interactive' does, but adds the "g" and "G" specs.
+      ;; `interactive' does, but add the specs listed above.

       (push
        (cond
        ((= c ?a)
       (push
        (cond
        ((= c ?a)

@@ -2075,11 +2101,13 @@ g -- Group name."
        ((= c ?g)
         (gnus-group-group-name))
        ((= c ?A)
        ((= c ?g)
         (gnus-group-group-name))
        ((= c ?A)

-        (gnus-summary-article-number))
+        (gnus-summary-skip-intangible)
+        (or (get-text-property (point) 'gnus-number)
+            (gnus-summary-last-subject)))

        ((= c ?H)
        ((= c ?H)

-        (gnus-summary-article-header))
+        (gnus-data-header (gnus-data-find (gnus-summary-article-number))))

        (t
        (t

-        (error "Not implemented spec")))
+        (error "Non-implemented spec")))

        out)
       (cond
        ((= c ?r)
        out)
       (cond
        ((= c ?r)

@@ -2157,7 +2185,14 @@ that that variable is buffer-local to the summary buffers."
   "Return non-nil if GROUP (and ARTICLE) come from a news server."
   (or (gnus-member-of-valid 'post group) ; Ordinary news group.
       (and (gnus-member-of-valid 'post-mail group) ; Combined group.
   "Return non-nil if GROUP (and ARTICLE) come from a news server."
   (or (gnus-member-of-valid 'post group) ; Ordinary news group.
       (and (gnus-member-of-valid 'post-mail group) ; Combined group.

-          (eq (gnus-request-type group article) 'news))))
+          (if (or (null article)
+                  (not (< article 0)))
+              (eq (gnus-request-type group article) 'news)
+            (if (not (vectorp article))
+                nil
+              ;; It's a real article.
+              (eq (gnus-request-type group (mail-header-id article))
+                  'news))))))

 
 ;; Returns a list of writable groups.
 (defun gnus-writable-groups ()
 
 ;; Returns a list of writable groups.
 (defun gnus-writable-groups ()

@@ -2188,11 +2223,11 @@ that that variable is buffer-local to the summary buffers."
 
 (defun gnus-ephemeral-group-p (group)
   "Say whether GROUP is ephemeral or not."
 
 (defun gnus-ephemeral-group-p (group)
   "Say whether GROUP is ephemeral or not."

-  (gnus-group-get-parameter group 'quit-config))
+  (gnus-group-get-parameter group 'quit-config t))

 
 (defun gnus-group-quit-config (group)
   "Return the quit-config of GROUP."
 
 (defun gnus-group-quit-config (group)
   "Return the quit-config of GROUP."

-  (gnus-group-get-parameter group 'quit-config))
+  (gnus-group-get-parameter group 'quit-config t))

 
 (defun gnus-kill-ephemeral-group (group)
   "Remove ephemeral GROUP from relevant structures."
 
 (defun gnus-kill-ephemeral-group (group)
   "Remove ephemeral GROUP from relevant structures."

@@ -2378,30 +2413,41 @@ You should probably use `gnus-find-method-for-group' instead."
   "Say whether the group is secondary or not."
   (gnus-secondary-method-p (gnus-find-method-for-group group)))
 
   "Say whether the group is secondary or not."
   (gnus-secondary-method-p (gnus-find-method-for-group group)))
 

-(defun gnus-group-find-parameter (group &optional symbol)
+(defun gnus-group-find-parameter (group &optional symbol allow-list)

   "Return the group parameters for GROUP.
 If SYMBOL, return the value of that symbol in the group parameters."
   (save-excursion
     (set-buffer gnus-group-buffer)
     (let ((parameters (funcall gnus-group-get-parameter-function group)))
       (if symbol
   "Return the group parameters for GROUP.
 If SYMBOL, return the value of that symbol in the group parameters."
   (save-excursion
     (set-buffer gnus-group-buffer)
     (let ((parameters (funcall gnus-group-get-parameter-function group)))
       (if symbol

-         (gnus-group-parameter-value parameters symbol)
+         (gnus-group-parameter-value parameters symbol allow-list)

        parameters))))
 
        parameters))))
 

-(defun gnus-group-get-parameter (group &optional symbol)
+(defun gnus-group-get-parameter (group &optional symbol allow-list)

   "Return the group parameters for GROUP.
 If SYMBOL, return the value of that symbol in the group parameters.
 Most functions should use `gnus-group-find-parameter', which
 also examines the topic parameters."
   (let ((params (gnus-info-params (gnus-get-info group))))
     (if symbol
   "Return the group parameters for GROUP.
 If SYMBOL, return the value of that symbol in the group parameters.
 Most functions should use `gnus-group-find-parameter', which
 also examines the topic parameters."
   (let ((params (gnus-info-params (gnus-get-info group))))
     (if symbol

-       (gnus-group-parameter-value params symbol)
+       (gnus-group-parameter-value params symbol allow-list)

       params)))
 
       params)))
 

-(defun gnus-group-parameter-value (params symbol)
+(defun gnus-group-parameter-value (params symbol &optional allow-list)

   "Return the value of SYMBOL in group PARAMS."
   "Return the value of SYMBOL in group PARAMS."

-  (or (car (memq symbol params))       ; It's either a simple symbol
-      (cdr (assq symbol params))))     ; or a cons.
+  ;; We only wish to return group parameters (dotted lists) and
+  ;; not local variables, which may have the same names.
+  ;; But first we handle single elements...
+  (or (car (memq symbol params))
+      ;; Handle alist.
+      (let (elem)
+       (catch 'found
+         (while (setq elem (pop params))
+           (when (and (consp elem)
+                      (eq (car elem) symbol)
+                      (or allow-list
+                          (atom (cdr elem))))
+             (throw 'found (cdr elem))))))))

 
 (defun gnus-group-add-parameter (group param)
   "Add parameter PARAM to GROUP."
 
 (defun gnus-group-add-parameter (group param)
   "Add parameter PARAM to GROUP."

@@ -2434,7 +2480,7 @@ also examines the topic parameters."
        (when params
          (setq params (delq name params))
          (while (assq name params)
        (when params
          (setq params (delq name params))
          (while (assq name params)

-           (setq params (delq (assq name params) params)))
+           (gnus-pull name params))

          (gnus-info-set-params info params))))))
 
 (defun gnus-group-add-score (group &optional score)
          (gnus-info-set-params info params))))))
 
 (defun gnus-group-add-score (group &optional score)

@@ -2449,7 +2495,10 @@ If SCORE is nil, add 1 to the score of GROUP."
   "Collapse GROUP name LEVELS.
 Select methods are stripped and any remote host name is stripped down to
 just the host name."
   "Collapse GROUP name LEVELS.
 Select methods are stripped and any remote host name is stripped down to
 just the host name."

-  (let* ((name "") (foreign "") (depth -1) (skip 1)
+  (let* ((name "")
+        (foreign "")
+        (depth 0)
+        (skip 1)

         (levels (or levels
                     (progn
                       (while (string-match "\\." group skip)
         (levels (or levels
                     (progn
                       (while (string-match "\\." group skip)

@@ -2646,11 +2695,14 @@ Disallow illegal group names."
 (defun gnus-read-method (prompt)
   "Prompt the user for a method.
 Allow completion over sensible values."
 (defun gnus-read-method (prompt)
   "Prompt the user for a method.
 Allow completion over sensible values."

-  (let ((method
-        (completing-read
-         prompt (append gnus-valid-select-methods gnus-predefined-server-alist
-                        gnus-server-alist)
-         nil t nil 'gnus-method-history)))
+  (let* ((servers
+         (append gnus-valid-select-methods
+                 gnus-predefined-server-alist
+                 gnus-server-alist))
+        (method
+         (completing-read
+          prompt servers
+          nil t nil 'gnus-method-history)))

     (cond
      ((equal method "")
       (setq method gnus-select-method))
     (cond
      ((equal method "")
       (setq method gnus-select-method))

@@ -2660,7 +2712,7 @@ Allow completion over sensible values."
                      (assoc method gnus-valid-select-methods))
                (read-string "Address: ")
              "")))
                      (assoc method gnus-valid-select-methods))
                (read-string "Address: ")
              "")))

-     ((assoc method gnus-server-alist)
+     ((assoc method servers)

       method)
      (t
       (list (intern method) "")))))
       method)
      (t
       (list (intern method) "")))))

@@ -2669,7 +2721,7 @@ Allow completion over sensible values."
 
 ;;;###autoload
 (defun gnus-slave-no-server (&optional arg)
 
 ;;;###autoload
 (defun gnus-slave-no-server (&optional arg)

-  "Read network news as a slave, without connecting to local server"
+  "Read network news as a slave, without connecting to local server."

   (interactive "P")
   (gnus-no-server arg t))
 
   (interactive "P")
   (gnus-no-server arg t))