Importing Gnus v5.8.5.
[elisp/gnus.git-] / lisp / gnus.el
index 1e3e7c5..585c338 100644 (file)
@@ -1,5 +1,7 @@
 ;;; gnus.el --- a newsreader for GNU Emacs
-;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
+;;        1997, 1998, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 (eval-when-compile (require 'cl))
 (require 'mm-util)
 
-(require 'custom)
-(eval-and-compile
-  (if (< emacs-major-version 20)
-      (require 'gnus-load)))
 (require 'message)
 
 (defgroup gnus nil
@@ -260,10 +258,10 @@ is restarted, and sometimes reloaded."
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 
-(defconst gnus-version-number "0.91"
+(defconst gnus-version-number "5.8.5"
   "Version number for this version of Gnus.")
 
-(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
+(defconst gnus-version (format "Gnus v%s" gnus-version-number)
   "Version string for this version of Gnus.")
 
 (defcustom gnus-inhibit-startup-message nil
@@ -866,19 +864,21 @@ used to 899, you would say something along these lines:
                 (kill-buffer (current-buffer))))))))
 
 (defcustom gnus-select-method
-  (ignore-errors
-    (nconc
-     (list 'nntp (or (ignore-errors
-                      (gnus-getenv-nntpserver))
-                    (when (and gnus-default-nntp-server
-                               (not (string= gnus-default-nntp-server "")))
-                      gnus-default-nntp-server)
-                    "news"))
-     (if (or (null gnus-nntp-service)
-            (equal gnus-nntp-service "nntp"))
-        nil
-       (list gnus-nntp-service))))
-  "*Default method for selecting a newsgroup.
+  (condition-case nil
+      (nconc
+       (list 'nntp (or (condition-case nil
+                          (gnus-getenv-nntpserver)
+                        (error nil))
+                      (when (and gnus-default-nntp-server
+                                 (not (string= gnus-default-nntp-server "")))
+                        gnus-default-nntp-server)
+                      "news"))
+       (if (or (null gnus-nntp-service)
+              (equal gnus-nntp-service "nntp"))
+          nil
+        (list gnus-nntp-service)))
+    (error nil))
+  "Default method for selecting a newsgroup.
 This variable should be a list, where the first element is how the
 news is to be fetched, the second is the address.
 
@@ -966,8 +966,8 @@ If, for instance, you want to read your mail with the nnml backend,
 you could set this variable:
 
 \(setq gnus-secondary-select-methods '((nnml \"\")))"
-:group 'gnus-server
-:type '(repeat gnus-select-method))
+  :group 'gnus-server
+  :type '(repeat gnus-select-method))
 
 (defvar gnus-backup-default-subscribed-newsgroups
   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
@@ -996,10 +996,23 @@ articles by Message-ID is painfully slow.  By setting this method to an
 nntp method, you might get acceptable results.
 
 The value of this variable must be a valid select method as discussed
-in the documentation of `gnus-select-method'."
+in the documentation of `gnus-select-method'.
+
+It can also be a list of select methods, as well as the special symbol
+`current', which means to use the current select method.  If it is a
+list, Gnus will try all the methods in the list until it finds a match."
   :group 'gnus-server
   :type '(choice (const :tag "default" nil)
-                gnus-select-method))
+                (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews)))
+                gnus-select-method
+                (repeat :menu-tag "Try multiple" 
+                        :tag "Multiple"
+                        :value (current (nnweb "refer" (nnweb-type dejanews)))
+                        (choice :tag "Method"
+                                (const current)
+                                (const :tag "DejaNews" 
+                                       (nnweb "refer" (nnweb-type dejanews)))
+                                gnus-select-method))))
 
 (defcustom gnus-group-faq-directory
   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
@@ -1233,8 +1246,12 @@ slower."
     ("nnfolder" mail respool address)
     ("nngateway" post-mail address prompt-address physical-address)
     ("nnweb" none)
+    ("nnslashdot" post)
+    ("nnultimate" none)
+    ("nnwarchive" none)
     ("nnlistserv" none)
-    ("nnagent" post-mail))
+    ("nnagent" post-mail)
+    ("nnimap" post-mail address prompt-address physical-address))
   "*An alist of valid select methods.
 The first element of each list lists should be a string with the name
 of the select method.  The other elements may be the category of
@@ -1257,16 +1274,19 @@ this variable.  I think."
 
 (define-widget 'gnus-select-method 'list
   "Widget for entering a select method."
+  :value '(nntp "")
+  :tag "Select Method"
   :args `((choice :tag "Method"
                  ,@(mapcar (lambda (entry)
                              (list 'const :format "%v\n"
                                    (intern (car entry))))
                            gnus-valid-select-methods))
          (string :tag "Address")
-         (editable-list  :inline t
-                         (list :format "%v"
-                               variable
-                               (sexp :tag "Value")))))
+         (repeat :tag "Options"
+                 :inline t
+                 (list :format "%v"
+                       variable
+                       (sexp :tag "Value")))))
 
 (defcustom gnus-updated-mode-lines '(group article summary tree)
   "List of buffers that should update their mode lines.
@@ -1533,11 +1553,11 @@ If nil, no default charset is assumed when posting."
 
 (defvar gnus-variable-list
   '(gnus-newsrc-options gnus-newsrc-options-n
-    gnus-newsrc-last-checked-date
-    gnus-newsrc-alist gnus-server-alist
-    gnus-killed-list gnus-zombie-list
-    gnus-topic-topology gnus-topic-alist
-    gnus-format-specs)
+                       gnus-newsrc-last-checked-date
+                       gnus-newsrc-alist gnus-server-alist
+                       gnus-killed-list gnus-zombie-list
+                       gnus-topic-topology gnus-topic-alist
+                       gnus-format-specs)
   "Gnus variables saved in the quick startup file.")
 
 (defvar gnus-newsrc-alist nil
@@ -1594,19 +1614,19 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
            (when (consp function)
              (setq keymap (car (memq 'keymap function)))
              (setq function (car function)))
-           (autoload function (car package) nil interactive keymap)))
+           (unless (fboundp function)
+             (autoload function (car package) nil interactive keymap))))
        (if (eq (nth 1 package) ':interactive)
-           (cdddr package)
+           (nthcdr 3 package)
          (cdr package)))))
-   '(("metamail" metamail-buffer)
-     ("info" Info-goto-node)
+   '(("info" :interactive t Info-goto-node)
      ("pp" pp pp-to-string pp-eval-expression)
      ("qp" quoted-printable-decode-region quoted-printable-decode-string)
      ("ps-print" ps-print-preprint)
-     ("mail-extr" mail-extract-address-components)
-     ("browse-url" browse-url)
+     ("browse-url" :interactive t browse-url)
      ("message" :interactive t
       message-send-and-exit message-yank-original)
+     ("babel" babel-as-string)
      ("nnmail" nnmail-split-fancy nnmail-article-group)
      ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
      ("rmailout" rmail-output rmail-output-to-rmail-file)
@@ -1647,26 +1667,28 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-cache-possibly-remove-articles gnus-cache-request-article
       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
       gnus-cache-enter-remove-article gnus-cached-article-p
-      gnus-cache-open gnus-cache-close gnus-cache-update-article)
-      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
-       gnus-cache-remove-article gnus-summary-insert-cached-articles)
-      ("gnus-score" :interactive t
-       gnus-summary-increase-score gnus-summary-set-score
-       gnus-summary-raise-thread gnus-summary-raise-same-subject
-       gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
-       gnus-summary-lower-thread gnus-summary-lower-same-subject
-       gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
-       gnus-summary-current-score gnus-score-default
-       gnus-score-flush-cache gnus-score-close
-       gnus-possibly-score-headers gnus-score-followup-article
-       gnus-score-followup-thread)
-      ("gnus-score"
-       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
+      gnus-cache-open gnus-cache-close gnus-cache-update-article
+      gnus-cache-articles-in-group)
+     ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
+      gnus-cache-remove-article gnus-summary-insert-cached-articles)
+     ("gnus-score" :interactive t
+      gnus-summary-increase-score gnus-summary-set-score
+      gnus-summary-raise-thread gnus-summary-raise-same-subject
+      gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
+      gnus-summary-lower-thread gnus-summary-lower-same-subject
+      gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
+      gnus-summary-current-score gnus-score-delta-default
+      gnus-score-flush-cache gnus-score-close
+      gnus-possibly-score-headers gnus-score-followup-article
+      gnus-score-followup-thread)
+     ("gnus-score"
+      (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
       gnus-current-score-file-nondirectory gnus-score-adaptive
       gnus-score-find-trace gnus-score-file-name)
      ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
      ("gnus-topic" :interactive t gnus-topic-mode)
-     ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters)
+     ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters
+      gnus-subscribe-topics)
      ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
      ("gnus-uu" :interactive t
@@ -1729,6 +1751,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-article-treat-overstrike 
       gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
       gnus-article-display-x-face gnus-article-de-quoted-unreadable
+      gnus-article-decode-HZ
       gnus-article-hide-pgp
       gnus-article-hide-pem gnus-article-hide-signature
       gnus-article-strip-leading-blank-lines gnus-article-date-local
@@ -1760,7 +1783,10 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-unplugged gnus-agentize gnus-agent-batch)
      ("gnus-vm" :interactive t gnus-summary-save-in-vm
       gnus-summary-save-article-vm)
-     ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts))))
+     ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts)
+     ("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
+     ("gnus-mlspl" :interactive t gnus-group-split-setup
+      gnus-group-split-update))))
 
 ;;; gnus-sum.el thingies
 
@@ -2447,9 +2473,9 @@ You should probably use `gnus-find-method-for-group' instead."
   (let ((methods gnus-secondary-select-methods)
        (gmethod (gnus-server-get-method nil method)))
     (while (and methods
-               (not (gnus-method-equal
-                     (gnus-server-get-method nil (car methods))
-                     gmethod)))
+               (not (gnus-method-equal
+                     (gnus-server-get-method nil (car methods))
+                     gmethod)))
       (setq methods (cdr methods)))
     methods))
 
@@ -2578,31 +2604,33 @@ just the host name."
                         (setq skip (match-end 0)
                               depth (+ depth 1)))
                       depth))))
-    ;; separate foreign select method from group name and collapse.
-    ;; if method contains a server, collapse to non-domain server name,
-    ;; otherwise collapse to select method
-    (let* ((colon  (string-match ":" group))
+    ;; Separate foreign select method from group name and collapse.
+    ;; If method contains a server, collapse to non-domain server name,
+    ;; otherwise collapse to select method.
+    (let* ((colon (string-match ":" group))
           (server (and colon (substring group 0 colon)))
-          (plus   (and server (string-match "+" server))))
+          (plus (and server (string-match "+" server))))
       (when server
-       (cond (plus
-              (setq foreign (substring server (+ 1 plus)
-                                       (string-match "\\." server))
-                    group (substring group (+ 1 colon))))
-              (t
-               (setq foreign server
-                     group (substring group (+ 1 colon)))))
-       (setq foreign (concat foreign ":"))))
-    ;; collapse group name leaving LEVELS uncollapsed elements
-    (while group
-      (if (and (string-match "\\." group) (> levels 0))
-         (setq name (concat name (substring group 0 1))
-               group (substring group (match-end 0))
-               levels (- levels 1)
-               name (concat name "."))
-       (setq name (concat foreign name group)
-             group nil)))
-    name))
+       (if plus
+           (setq foreign (substring server (+ 1 plus)
+                                    (string-match "\\." server))
+                 group (substring group (+ 1 colon)))
+         (setq foreign server
+               group (substring group (+ 1 colon))))
+       (setq foreign (concat foreign ":")))
+      ;; Collapse group name leaving LEVELS uncollapsed elements
+      (let* ((glist (split-string group "\\."))
+            (glen (length glist))
+            res)
+       (setq levels (- glen levels))
+       (dolist (g glist)
+         (push (if (>= (decf levels) 0)
+                   (if (zerop (length g))
+                       ""
+                     (substring g 0 1))
+                 g)
+               res))
+       (concat foreign (mapconcat 'identity (nreverse res) "."))))))
 
 (defun gnus-narrow-to-body ()
   "Narrow to the body of an article."
@@ -2680,7 +2708,7 @@ If NEWSGROUP is nil, return the global kill file name instead."
   (let ((opened gnus-opened-servers))
     (while (and method opened)
       (when (and (equal (cadr method) (cadaar opened))
-                (equal (car method) (caaar opened))
+                (equal (car method) (caaar opened))
                 (not (equal method (caar opened))))
        (setq method nil))
       (pop opened))
@@ -2717,6 +2745,8 @@ If NEWSGROUP is nil, return the global kill file name instead."
   (or gnus-override-method
       (and (not group)
           gnus-select-method)
+      (and (not (gnus-group-entry group));; a new group
+          (gnus-group-name-to-method group))
       (let ((info (or info (gnus-get-info group)))
            method)
        (if (or (not info)
@@ -2767,6 +2797,9 @@ Disallow invalid group names."
 Allow completion over sensible values."
   (let* ((servers
          (append gnus-valid-select-methods
+                 (mapcar (lambda (i) (list (format "%s:%s" (caar i)
+                                                   (cadar i))))
+                         gnus-opened-servers)
                  gnus-predefined-server-alist
                  gnus-server-alist))
         (method
@@ -2777,11 +2810,18 @@ Allow completion over sensible values."
      ((equal method "")
       (setq method gnus-select-method))
      ((assoc method gnus-valid-select-methods)
-      (list (intern method)
-           (if (memq 'prompt-address
-                     (assoc method gnus-valid-select-methods))
-               (read-string "Address: ")
-             "")))
+      (let ((address (if (memq 'prompt-address
+                              (assoc method gnus-valid-select-methods))
+                        (read-string "Address: ")
+                      "")))
+       (or (let ((opened gnus-opened-servers))
+             (while (and opened
+                         (not (equal (format "%s:%s" method address)
+                                     (format "%s:%s" (caaar opened) 
+                                             (cadaar opened)))))
+               (pop opened))
+             (caar opened))
+           (list (intern method) address))))
      ((assoc method servers)
       method)
      (t
@@ -2819,10 +2859,13 @@ As opposed to `gnus', this command will not connect to the local server."
   (let ((window (get-buffer-window gnus-group-buffer)))
     (cond (window
           (select-frame (window-frame window)))
-         (t
-          (other-frame 1))))
+         (t
+          (select-frame (make-frame)))))
   (gnus arg))
 
+;;(setq thing ?                                ; this is a comment
+;;      more 'yes)
+    
 ;;;###autoload
 (defun gnus (&optional arg dont-connect slave)
   "Read network news.