Sync up with Gnus 5.6.30.

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

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 2a6fd54..a25977f 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -250,11 +250,16 @@ 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 "5.6.13"
-  "Version number for this version of Gnus.")
+(defconst gnus-product-name "Shoe-gnus"
+  "Product name of this version of gnus.")

 
 

-(defconst gnus-version (format "Gnus v%s" gnus-version-number)
-  "Version string for this version of Gnus.")
+(defconst gnus-version-number "6.8.4"
+  "Version number for this version of gnus.")
+
+(defconst gnus-version
+  (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
   "If non-nil, the startup message will not be displayed.
 
 (defcustom gnus-inhibit-startup-message nil
   "If non-nil, the startup message will not be displayed.

@@ -838,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

@@ -1100,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

@@ -1340,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

@@ -1419,11 +1425,11 @@ want."
 
 (defvar gnus-predefined-server-alist
   `(("cache"
 
 (defvar gnus-predefined-server-alist
   `(("cache"

-     (nnspool "cache"
-             (nnspool-spool-directory gnus-cache-directory)
-             (nnspool-nov-directory gnus-cache-directory)
-             (nnspool-active-file
-              (nnheader-concat gnus-cache-directory "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.

@@ -1541,8 +1547,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
        (if (eq (nth 1 package) ':interactive)
            (cdddr package)
          (cdr package)))))
        (if (eq (nth 1 package) ':interactive)
            (cdddr package)
          (cdr package)))))

-   '(("metamail" metamail-buffer)
-     ("info" Info-goto-node)
+   '(("info" Info-goto-node)

      ("hexl" hexl-hex-string-to-integer)
      ("pp" pp pp-to-string pp-eval-expression)
      ("ps-print" ps-print-preprint)
      ("hexl" hexl-hex-string-to-integer)
      ("pp" pp pp-to-string pp-eval-expression)
      ("ps-print" ps-print-preprint)

@@ -1623,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

@@ -1667,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

@@ -1974,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

@@ -1989,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))))))
 

@@ -2032,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)

@@ -2173,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 ()

@@ -2461,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)

@@ -2476,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)

@@ -2673,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))

@@ -2687,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) "")))))