2001-02-20 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>

[gnus] / lisp / gnus.el

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 6aa4bf9..c5a59a1 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -1,5 +1,6 @@
 ;;; gnus.el --- a newsreader for GNU Emacs
 ;;; 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, 2001 Free Software Foundation, Inc.

 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>


@@ -31,12 +32,6 @@
 (eval-when-compile (require 'cl))
 (require 'mm-util)
 
 (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
   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
   :group 'news
 (defgroup gnus nil
   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
   :group 'news


@@ -45,6 +40,7 @@
 (defgroup gnus-charset nil
   "Group character set issues."
   :link '(custom-manual "(gnus)Charsets")
 (defgroup gnus-charset nil
   "Group character set issues."
   :link '(custom-manual "(gnus)Charsets")

+  :version "21.1"

   :group 'gnus)
 
 (defgroup gnus-cache nil
   :group 'gnus)
 
 (defgroup gnus-cache nil


@@ -260,10 +256,10 @@ 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 "0.93"
+(defconst gnus-version-number "0.01"

   "Version number for this version of Gnus.")
 
   "Version number for this version of Gnus.")
 

-(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
+(defconst gnus-version (format "Oort Gnus v%s" 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


@@ -278,27 +274,55 @@ be set in `.emacs' instead."
   :group 'gnus-start
   :type 'boolean)
 
   :group 'gnus-start
   :type 'boolean)
 

+(unless (fboundp 'gnus-group-remove-excess-properties)
+  (defalias 'gnus-group-remove-excess-properties 'ignore))
+
+(unless (fboundp 'gnus-set-text-properties)
+  (defalias 'gnus-set-text-properties 'set-text-properties))
+

 (unless (featurep 'gnus-xmas)
   (defalias 'gnus-make-overlay 'make-overlay)
   (defalias 'gnus-delete-overlay 'delete-overlay)
   (defalias 'gnus-overlay-put 'overlay-put)
   (defalias 'gnus-move-overlay 'move-overlay)
 (unless (featurep 'gnus-xmas)
   (defalias 'gnus-make-overlay 'make-overlay)
   (defalias 'gnus-delete-overlay 'delete-overlay)
   (defalias 'gnus-overlay-put 'overlay-put)
   (defalias 'gnus-move-overlay 'move-overlay)

+  (defalias 'gnus-overlay-buffer 'overlay-buffer)
+  (defalias 'gnus-overlay-start 'overlay-start)

   (defalias 'gnus-overlay-end 'overlay-end)
   (defalias 'gnus-extent-detached-p 'ignore)
   (defalias 'gnus-extent-start-open 'ignore)
   (defalias 'gnus-overlay-end 'overlay-end)
   (defalias 'gnus-extent-detached-p 'ignore)
   (defalias 'gnus-extent-start-open 'ignore)

-  (defalias 'gnus-set-text-properties 'set-text-properties)
-  (defalias 'gnus-group-remove-excess-properties 'ignore)

   (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
   (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
   (defalias 'gnus-character-to-event 'identity)
   (defalias 'gnus-add-text-properties 'add-text-properties)
   (defalias 'gnus-put-text-property 'put-text-property)
   (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
   (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
   (defalias 'gnus-character-to-event 'identity)
   (defalias 'gnus-add-text-properties 'add-text-properties)
   (defalias 'gnus-put-text-property 'put-text-property)

-  (defalias 'gnus-mode-line-buffer-identification 'identity)
+  (defvar gnus-mode-line-image-cache t)
+  (if (fboundp 'find-image)
+      (defun gnus-mode-line-buffer-identification (line)
+       (let ((str (car-safe line)))
+         (if (and (stringp str)
+                  (string-match "^Gnus:" str))
+             (progn (add-text-properties
+                     0 5
+                     (list 'display
+                           (if (eq t gnus-mode-line-image-cache)
+                               (setq gnus-mode-line-image-cache
+                                     (find-image
+                                      '((:type xpm :file "gnus-pointer.xpm"
+                                               :ascent center)
+                                        (:type xbm :file "gnus-pointer.xbm"
+                                               :ascent center))))
+                             gnus-mode-line-image-cache)
+                           'help-echo "This is Gnus")
+                     str)
+                    (list str))
+           line)))
+    (defalias 'gnus-mode-line-buffer-identification 'identity))

   (defalias 'gnus-characterp 'numberp)
   (defalias 'gnus-deactivate-mark 'deactivate-mark)
   (defalias 'gnus-window-edges 'window-edges)
   (defalias 'gnus-key-press-event-p 'numberp)
   (defalias 'gnus-characterp 'numberp)
   (defalias 'gnus-deactivate-mark 'deactivate-mark)
   (defalias 'gnus-window-edges 'window-edges)
   (defalias 'gnus-key-press-event-p 'numberp)

-  (defalias 'gnus-decode-rfc1522 'ignore))
+  ;;(defalias 'gnus-decode-rfc1522 'ignore)
+  )

 
 ;; We define these group faces here to avoid the display
 ;; update forced when creating new faces.
 
 ;; We define these group faces here to avoid the display
 ;; update forced when creating new faces.


@@ -750,8 +774,32 @@ be set in `.emacs' instead."
   "Insert startup message in current buffer."
   ;; Insert the message.
   (erase-buffer)
   "Insert startup message in current buffer."
   ;; Insert the message.
   (erase-buffer)

-  (insert
-   (format "              %s
+  (cond
+   ((and
+     (fboundp 'find-image)
+     (display-graphic-p)
+     (let ((image (find-image
+                  `((:type xpm :file "gnus.xpm")
+                    (:type pbm :file "gnus.pbm"
+                           ;; Account for the pbm's blackground.
+                           :background ,(face-foreground 'gnus-splash-face)
+                           :foreground ,(face-background 'default))
+                    (:type xbm :file "gnus.xbm"
+                           ;; Account for the xbm's blackground.
+                           :background ,(face-foreground 'gnus-splash-face)
+                           :foreground ,(face-background 'default))))))
+       (when image
+        (let ((size (image-size image)))
+          (insert-char ?\n (max 0 (round (- (window-height)
+                                            (or y (cdr size)) 1) 2)))
+          (insert-char ?\  (max 0 (round (- (window-width)
+                                            (or x (car size))) 2)))
+          (insert-image image))
+        (setq gnus-simple-splash nil)
+        t))))
+   (t
+    (insert
+     (format "              %s

           _    ___ _             _
           _ ___ __ ___  __    _ ___
           __   _     ___    __  ___
           _    ___ _             _
           _ ___ __ ___  __    _ ___
           __   _     ___    __  ___


@@ -771,21 +819,21 @@ be set in `.emacs' instead."
           __
 
 "
           __
 
 "

-           ""))
-  ;; And then hack it.
-  (gnus-indent-rigidly (point-min) (point-max)
-                      (/ (max (- (window-width) (or x 46)) 0) 2))
-  (goto-char (point-min))
-  (forward-line 1)
-  (let* ((pheight (count-lines (point-min) (point-max)))
-        (wheight (window-height))
-        (rest (- wheight pheight)))
-    (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
-  ;; Fontify some.
-  (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
+            ""))
+    ;; And then hack it.
+    (gnus-indent-rigidly (point-min) (point-max)
+                        (/ (max (- (window-width) (or x 46)) 0) 2))
+    (goto-char (point-min))
+    (forward-line 1)
+    (let* ((pheight (count-lines (point-min) (point-max)))
+          (wheight (window-height))
+          (rest (- wheight pheight)))
+      (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
+    ;; Fontify some.
+    (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
+    (setq gnus-simple-splash t)))

   (goto-char (point-min))
   (setq mode-line-buffer-identification (concat " " gnus-version))
   (goto-char (point-min))
   (setq mode-line-buffer-identification (concat " " gnus-version))

-  (setq gnus-simple-splash t)

   (set-buffer-modified-p t))
 
 (eval-when (load)
   (set-buffer-modified-p t))
 
 (eval-when (load)


@@ -797,10 +845,88 @@ be set in `.emacs' instead."
 
 ;;; Do the rest.
 
 
 ;;; Do the rest.
 

-(require 'custom)

 (require 'gnus-util)
 (require 'nnheader)
 
 (require 'gnus-util)
 (require 'nnheader)
 

+(defvar gnus-group-parameters-more nil)
+
+(defmacro gnus-define-group-parameter (param &rest rest)
+  "Define a group parameter PARAM.
+REST is a plist of following:
+:type               One of `bool', `list' or `nil'.
+:function           The name of the function.
+:function-document  The document of the function.
+:parameter-type     The type for customizing the parameter.
+:parameter-document The document for the parameter.
+:variable           The name of the variable.
+:variable-document  The document for the variable.
+:variable-group     The group for customizing the variable.
+:variable-type      The type for customizing the variable.
+:variable-default   The default value of the variable."
+  (let* ((type (plist-get rest :type))
+        (parameter-type (plist-get rest :parameter-type))
+        (parameter-document (plist-get rest :parameter-document))
+        (function (or (plist-get rest :function)
+                      (intern (format "gnus-parameter-%s" param))))
+        (function-document (or (plist-get rest :function-document) ""))
+        (variable (or (plist-get rest :variable)
+                      (intern (format "gnus-parameter-%s-alist" param))))
+        (variable-document (or (plist-get rest :variable-document) ""))
+        (variable-group (plist-get rest :variable-group))
+        (variable-type (or (plist-get rest :variable-type)
+                           `(quote (repeat (list (regexp :tag "Group")
+                                                 ,parameter-type)))))
+        (variable-default (plist-get rest :variable-default)))
+    (list
+     'progn
+     `(defcustom ,variable ,variable-default
+       ,variable-document
+       :group 'gnus-group-parameter
+       :group ',variable-group
+       :type ,variable-type)
+     `(setq gnus-group-parameters-more
+           (delq (assq ',param gnus-group-parameters-more)
+                 gnus-group-parameters-more))
+     `(add-to-list 'gnus-group-parameters-more
+                  (list ',param
+                        ,parameter-type
+                        ,parameter-document))
+     (if (eq type 'bool)
+        `(defun ,function (name)
+           ,function-document
+           (let ((params (gnus-group-find-parameter name))
+                 val)
+             (cond
+              ((memq ',param params)
+               t)
+              ((setq val (assq ',param params))
+               (cdr val))
+              ((stringp ,variable)
+               (string-match ,variable name))
+              (,variable
+               (let ((alist ,variable)
+                     elem value)
+                 (while (setq elem (pop alist))
+                   (when (and name
+                              (string-match (car elem) name))
+                     (setq alist nil
+                           value (cdr elem))))
+                 (if (consp value) (car value) value))))))
+       `(defun ,function (name)
+         ,function-document
+         (and name
+              (or (gnus-group-find-parameter name ',param ,(and type t))
+                  (let ((alist ,variable)
+                        elem value)
+                    (while (setq elem (pop alist))
+                      (when (and name
+                                 (string-match (car elem) name))
+                        (setq alist nil
+                              value (cdr elem))))
+                    ,(if type
+                         'value
+                       '(if (consp value) (car value) value))))))))))
+

 (defcustom gnus-home-directory "~/"
   "Directory variable that specifies the \"home\" directory.
 All other Gnus path variables are initialized from this variable."
 (defcustom gnus-home-directory "~/"
   "Directory variable that specifies the \"home\" directory.
 All other Gnus path variables are initialized from this variable."


@@ -866,19 +992,21 @@ used to 899, you would say something along these lines:
                 (kill-buffer (current-buffer))))))))
 
 (defcustom gnus-select-method
                 (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.
 
 This variable should be a list, where the first element is how the
 news is to be fetched, the second is the address.
 


@@ -899,17 +1027,20 @@ see the manual for details."
   :type 'gnus-select-method)
 
 (defcustom gnus-message-archive-method
   :type 'gnus-select-method)
 
 (defcustom gnus-message-archive-method

-  `(nnfolder
-    "archive"
-    (nnfolder-directory ,(nnheader-concat message-directory "archive"))
-    (nnfolder-active-file
-     ,(nnheader-concat message-directory "archive/active"))
-    (nnfolder-get-new-mail nil)
-    (nnfolder-inhibit-expiry t))
+  (progn
+    ;; Don't require it at top level to avoid circularity.
+    (require 'message)
+    `(nnfolder
+      "archive"
+      (nnfolder-directory ,(nnheader-concat message-directory "archive"))
+      (nnfolder-active-file
+       ,(nnheader-concat message-directory "archive/active"))
+      (nnfolder-get-new-mail nil)
+      (nnfolder-inhibit-expiry t)))

   "*Method used for archiving messages you've sent.
 This should be a mail method.
 
   "*Method used for archiving messages you've sent.
 This should be a mail method.
 

-It's probably not a very effective to change this variable once you've
+It's probably not very effective to change this variable once you've

 run Gnus once.  After doing that, you must edit this server from the
 server buffer."
   :group 'gnus-server
 run Gnus once.  After doing that, you must edit this server from the
 server buffer."
   :group 'gnus-server


@@ -966,8 +1097,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 \"\")))"
 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")
 
 (defvar gnus-backup-default-subscribed-newsgroups
   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")


@@ -996,10 +1127,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
 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)
   :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/"
 
 (defcustom gnus-group-faq-directory
   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"


@@ -1058,11 +1202,6 @@ newsgroups."
   :group 'gnus-summary-marks
   :type 'character)
 
   :group 'gnus-summary-marks
   :type 'character)
 

-(defcustom gnus-asynchronous nil
-  "*If non-nil, Gnus will supply backends with data needed for async article fetching."
-  :group 'gnus-asynchronous
-  :type 'boolean)
-

 (defcustom gnus-large-newsgroup 200
   "*The number of articles which indicates a large newsgroup.
 If the number of articles in a newsgroup is greater than this value,
 (defcustom gnus-large-newsgroup 200
   "*The number of articles which indicates a large newsgroup.
 If the number of articles in a newsgroup is greater than this value,


@@ -1233,8 +1372,13 @@ slower."
     ("nnfolder" mail respool address)
     ("nngateway" post-mail address prompt-address physical-address)
     ("nnweb" none)
     ("nnfolder" mail respool address)
     ("nngateway" post-mail address prompt-address physical-address)
     ("nnweb" none)

+    ("nnslashdot" post)
+    ("nnultimate" none)
+    ("nnwfm" none)
+    ("nnwarchive" none)

     ("nnlistserv" 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
   "*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


@@ -1255,18 +1399,27 @@ this variable.  I think."
                                   (const :format "%v " virtual)
                                   (const respool)))))
 
                                   (const :format "%v " virtual)
                                   (const respool)))))
 

-(define-widget 'gnus-select-method 'list
-  "Widget for entering a 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")))))
+(defun gnus-redefine-select-method-widget ()
+  "Recomputes the select-method widget based on the value of
+`gnus-valid-select-methods'."
+  (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)
+                   (symbol :tag "other"))
+           (string :tag "Address")
+           (repeat :tag "Options"
+                   :inline t
+                   (list :format "%v"
+                         variable
+                         (sexp :tag "Value"))))))
+
+(gnus-redefine-select-method-widget)

 
 (defcustom gnus-updated-mode-lines '(group article summary tree)
   "List of buffers that should update their mode lines.
 
 (defcustom gnus-updated-mode-lines '(group article summary tree)
   "List of buffers that should update their mode lines.


@@ -1290,23 +1443,91 @@ to be desirable; see the manual for further details."
   :type '(choice (const nil)
                 integer))
 
   :type '(choice (const nil)
                 integer))
 

-(defcustom gnus-auto-expirable-newsgroups nil
+(gnus-define-group-parameter
+ to-address
+ :function-document
+ "Return GROUP's to-address."
+ :variable-document
+  "*Alist of group regexps and correspondent to-addresses."
+  :parameter-type '(gnus-email-address :tag "To Address")
+  :parameter-document "\
+This will be used when doing followups and posts.
+
+This is primarily useful in mail groups that represent closed
+mailing lists--mailing lists where it's expected that everybody that
+writes to the mailing list is subscribed to it.  Since using this
+parameter ensures that the mail only goes to the mailing list itself,
+it means that members won't receive two copies of your followups.
+
+Using `to-address' will actually work whether the group is foreign or
+not.  Let's say there's a group on the server that is called
+`fa.4ad-l'.  This is a real newsgroup, but the server has gotten the
+articles from a mail-to-news gateway.  Posting directly to this group
+is therefore impossible--you have to send mail to the mailing list
+address instead.
+
+The gnus-group-split mail splitting mechanism will behave as if this
+address was listed in gnus-group-split Addresses (see below).")
+
+(gnus-define-group-parameter
+ to-list
+ :function-document
+ "Return GROUP's to-list."
+ :variable-document
+ "*Alist of group regexps and correspondent to-lists."
+ :parameter-type '(gnus-email-address :tag "To List")
+ :parameter-document "\
+This address will be used when doing a `a' in the group.
+
+It is totally ignored when doing a followup--except that if it is
+present in a news group, you'll get mail group semantics when doing
+`f'.
+
+The gnus-group-split mail splitting mechanism will behave as if this
+address was listed in gnus-group-split Addresses (see below).")
+
+(gnus-define-group-parameter
+ auto-expire
+ :type bool
+ :function gnus-group-auto-expirable-p
+ :function-document
+ "Check whether GROUP is auto-expirable or not."
+ :variable gnus-auto-expirable-newsgroups
+ :variable-default nil
+ :variable-document

   "*Groups in which to automatically mark read articles as expirable.
 If non-nil, this should be a regexp that should match all groups in
 which to perform auto-expiry.  This only makes sense for mail groups."
   "*Groups in which to automatically mark read articles as expirable.
 If non-nil, this should be a regexp that should match all groups in
 which to perform auto-expiry.  This only makes sense for mail groups."

-  :group 'nnmail-expire
-  :type '(choice (const nil)
-                regexp))
-
-(defcustom gnus-total-expirable-newsgroups nil
-  "*Groups in which to perform expiry of all read articles.
+  :variable-group nnmail-expire
+  :variable-type '(choice (const nil)
+                         regexp)
+  :parameter-type '(const :tag "Automatic Expire" t)
+  :parameter-document
+  "All articles that are read will be marked as expirable.")
+
+(gnus-define-group-parameter
+ total-expire
+ :type bool
+ :function gnus-group-total-expirable-p
+ :function-document
+ "Check whether GROUP is total-expirable or not."
+ :variable gnus-total-expirable-newsgroups
+ :variable-default nil
+ :variable-document
+ "*Groups in which to perform expiry of all read articles.

 Use with extreme caution.  All groups that match this regexp will be
 expiring - which means that all read articles will be deleted after
 \(say) one week.        (This only goes for mail groups and the like, of
 course.)"
 Use with extreme caution.  All groups that match this regexp will be
 expiring - which means that all read articles will be deleted after
 \(say) one week.        (This only goes for mail groups and the like, of
 course.)"

-  :group 'nnmail-expire
-  :type '(choice (const nil)
-                regexp))
+  :variable-group nnmail-expire
+  :variable-type '(choice (const nil)
+                         regexp)
+  :parameter-type '(const :tag "Total Expire" t)
+  :parameter-document
+  "All read articles will be put through the expiry process
+
+This happens even if they are not marked as expirable.
+Use with caution.")

 
 (defcustom gnus-group-uncollapsed-levels 1
   "Number of group name elements to leave alone when making a short group name."
 
 (defcustom gnus-group-uncollapsed-levels 1
   "Number of group name elements to leave alone when making a short group name."


@@ -1427,19 +1648,12 @@ covered by that variable."
   :type 'symbol
   :group 'gnus-charset)
 
   :type 'symbol
   :group 'gnus-charset)
 

-(defcustom gnus-default-posting-charset nil
-  "Default charset assumed to be used when posting non-ASCII characters.
-This variable is overridden on a group-to-group basis by the
-gnus-group-posting-charset-alist variable and is only used on groups not
-covered by that variable.
-If nil, no default charset is assumed when posting."
-  :type 'symbol
-  :group 'gnus-charset)
-

 \f
 ;;; Internal variables
 
 \f
 ;;; Internal variables
 

+(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")

 (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
 (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")

+(defvar gnus-draft-meta-information-header "X-Draft-From")

 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
 (defvar gnus-original-article-buffer " *Original Article*")
 (defvar gnus-newsgroup-name nil)
 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
 (defvar gnus-original-article-buffer " *Original Article*")
 (defvar gnus-newsgroup-name nil)


@@ -1448,6 +1662,9 @@ If nil, no default charset is assumed when posting."
 (defvar gnus-agent nil
   "Whether we want to use the Gnus agent or not.")
 
 (defvar gnus-agent nil
   "Whether we want to use the Gnus agent or not.")
 

+(defvar gnus-agent-fetching nil
+  "Whether Gnus agent is in fetching mode.")
+

 (defvar gnus-command-method nil
   "Dynamically bound variable that says what the current backend is.")
 
 (defvar gnus-command-method nil
   "Dynamically bound variable that says what the current backend is.")
 


@@ -1533,11 +1750,11 @@ If nil, no default charset is assumed when posting."
 
 (defvar gnus-variable-list
   '(gnus-newsrc-options gnus-newsrc-options-n
 
 (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
   "Gnus variables saved in the quick startup file.")
 
 (defvar gnus-newsrc-alist nil


@@ -1578,6 +1795,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
 
 (defvar gnus-dead-summary nil)
 
 
 (defvar gnus-dead-summary nil)
 

+(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
+  "Regexp matching invalid groups.")
+

 ;;; End of variables.
 
 ;; Define some autoload functions Gnus might use.
 ;;; End of variables.
 
 ;; Define some autoload functions Gnus might use.


@@ -1594,19 +1814,18 @@ 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)))
            (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)
        (if (eq (nth 1 package) ':interactive)

-           (cdddr package)
+           (nthcdr 3 package)

          (cdr package)))))
          (cdr package)))))

-   '(("metamail" metamail-buffer)
-     ("info" Info-goto-node)
-     ("pp" pp pp-to-string pp-eval-expression)
+   '(("info" :interactive t Info-goto-node)
+     ("pp" pp-to-string)

      ("qp" quoted-printable-decode-region quoted-printable-decode-string)
      ("ps-print" ps-print-preprint)
      ("qp" quoted-printable-decode-region quoted-printable-decode-string)
      ("ps-print" ps-print-preprint)

-     ("mail-extr" mail-extract-address-components)
-     ("browse-url" browse-url)

      ("message" :interactive t
       message-send-and-exit message-yank-original)
      ("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)
      ("nnmail" nnmail-split-fancy nnmail-article-group)
      ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
      ("rmailout" rmail-output rmail-output-to-rmail-file)


@@ -1647,26 +1866,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-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-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
      ("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


@@ -1726,9 +1947,12 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-article-delete-invisible-text gnus-treat-article)
      ("gnus-art" :interactive t
       gnus-article-hide-headers gnus-article-hide-boring-headers
       gnus-article-delete-invisible-text gnus-treat-article)
      ("gnus-art" :interactive t
       gnus-article-hide-headers gnus-article-hide-boring-headers

-      gnus-article-treat-overstrike 
+      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-remove-cr gnus-article-remove-trailing-blank-lines
       gnus-article-display-x-face gnus-article-de-quoted-unreadable

+      gnus-article-de-base64-unreadable
+      gnus-article-decode-HZ
+      gnus-article-wash-html

       gnus-article-hide-pgp
       gnus-article-hide-pem gnus-article-hide-signature
       gnus-article-strip-leading-blank-lines gnus-article-date-local
       gnus-article-hide-pgp
       gnus-article-hide-pem gnus-article-hide-signature
       gnus-article-strip-leading-blank-lines gnus-article-date-local


@@ -1761,8 +1985,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
      ("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-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-mlspl" gnus-mlsplit gnus-mlsplit-fancy)
-     ("gnus-mlspl" :interactive t gnus-mlsplit-setup gnus-mlsplit-update))))
+     ("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
 
 
 ;;; gnus-sum.el thingies
 


@@ -2193,30 +2418,6 @@ that that variable is buffer-local to the summary buffers."
   (let ((group (or group gnus-newsgroup-name)))
     (not (gnus-check-backend-function 'request-replace-article group))))
 
   (let ((group (or group gnus-newsgroup-name)))
     (not (gnus-check-backend-function 'request-replace-article group))))
 

-(defun gnus-group-total-expirable-p (group)
-  "Check whether GROUP is total-expirable or not."
-  (let ((params (gnus-group-find-parameter group))
-       val)
-    (cond
-     ((memq 'total-expire params)
-      t)
-     ((setq val (assq 'total-expire params)) ; (auto-expire . t)
-      (cdr val))
-     (gnus-total-expirable-newsgroups  ; Check var.
-      (string-match gnus-total-expirable-newsgroups group)))))
-
-(defun gnus-group-auto-expirable-p (group)
-  "Check whether GROUP is auto-expirable or not."
-  (let ((params (gnus-group-find-parameter group))
-       val)
-    (cond
-     ((memq 'auto-expire params)
-      t)
-     ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
-      (cdr val))
-     (gnus-auto-expirable-newsgroups   ; Check var.
-      (string-match gnus-auto-expirable-newsgroups group)))))
-

 (defun gnus-virtual-group-p (group)
   "Say whether GROUP is virtual or not."
   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
 (defun gnus-virtual-group-p (group)
   "Say whether GROUP is virtual or not."
   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))


@@ -2393,21 +2594,24 @@ that that variable is buffer-local to the summary buffers."
       (and active
           (file-exists-p active))))))
 
       (and active
           (file-exists-p active))))))
 

+(defsubst gnus-method-to-server-name (method)
+  (concat
+   (format "%s" (car method))
+   (when (and
+         (or (assoc (format "%s" (car method))
+                    (gnus-methods-using 'address))
+             (gnus-server-equal method gnus-message-archive-method))
+         (nth 1 method)
+         (not (string= (nth 1 method) "")))
+     (concat "+" (nth 1 method)))))
+

 (defun gnus-group-prefixed-name (group method)
   "Return the whole name from GROUP and METHOD."
   (and (stringp method) (setq method (gnus-server-to-method method)))
   (if (or (not method)
          (gnus-server-equal method "native"))
       group
 (defun gnus-group-prefixed-name (group method)
   "Return the whole name from GROUP and METHOD."
   (and (stringp method) (setq method (gnus-server-to-method method)))
   (if (or (not method)
          (gnus-server-equal method "native"))
       group

-    (concat (format "%s" (car method))
-           (when (and
-                  (or (assoc (format "%s" (car method))
-                             (gnus-methods-using 'address))
-                      (gnus-server-equal method gnus-message-archive-method))
-                  (nth 1 method)
-                  (not (string= (nth 1 method) "")))
-             (concat "+" (nth 1 method)))
-           ":" group)))
+    (concat (gnus-method-to-server-name method) ":" group)))

 
 (defun gnus-group-real-prefix (group)
   "Return the prefix of the current group name."
 
 (defun gnus-group-real-prefix (group)
   "Return the prefix of the current group name."


@@ -2449,9 +2653,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
   (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))
 
       (setq methods (cdr methods)))
     methods))
 


@@ -2580,31 +2784,45 @@ just the host name."
                         (setq skip (match-end 0)
                               depth (+ depth 1)))
                       depth))))
                         (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)))
           (server (and colon (substring group 0 colon)))

-          (plus   (and server (string-match "+" server))))
+          (plus (and server (string-match "+" server))))

       (when 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* ((slist (split-string group "/"))
+            (slen (length slist))
+            (dlist (split-string group "\\."))
+            (dlen (length dlist))
+            glist
+            glen
+            gsep
+            res)
+       (if (> slen dlen)
+           (setq glist slist
+                 glen slen
+                 gsep "/")
+         (setq glist dlist
+               glen dlen
+               gsep "."))
+       (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) gsep))))))

 
 (defun gnus-narrow-to-body ()
   "Narrow to the body of an article."
 
 (defun gnus-narrow-to-body ()
   "Narrow to the body of an article."


@@ -2682,7 +2900,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))
   (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))
                 (not (equal method (caar opened))))
        (setq method nil))
       (pop opened))


@@ -2719,6 +2937,8 @@ If NEWSGROUP is nil, return the global kill file name instead."
   (or gnus-override-method
       (and (not group)
           gnus-select-method)
   (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)
       (let ((info (or info (gnus-get-info group)))
            method)
        (if (or (not info)


@@ -2756,7 +2976,7 @@ Disallow invalid group names."
        group)
     (while (not group)
       (when (string-match
        group)
     (while (not group)
       (when (string-match

-            "[: `'\"/]\\|^$"
+            gnus-invalid-group-regexp

             (setq group (read-string (concat prefix prompt)
                                      (cons (or default "") 0)
                                      'gnus-group-history)))
             (setq group (read-string (concat prefix prompt)
                                      (cons (or default "") 0)
                                      'gnus-group-history)))


@@ -2769,6 +2989,9 @@ Disallow invalid group names."
 Allow completion over sensible values."
   (let* ((servers
          (append gnus-valid-select-methods
 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
                  gnus-predefined-server-alist
                  gnus-server-alist))
         (method


@@ -2779,11 +3002,18 @@ Allow completion over sensible values."
      ((equal method "")
       (setq method gnus-select-method))
      ((assoc method gnus-valid-select-methods)
      ((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
      ((assoc method servers)
       method)
      (t


@@ -2821,10 +3051,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)))
   (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))
 
   (gnus arg))
 

+;;(setq thing ?                                ; this is a comment
+;;      more 'yes)
+

 ;;;###autoload
 (defun gnus (&optional arg dont-connect slave)
   "Read network news.
 ;;;###autoload
 (defun gnus (&optional arg dont-connect slave)
   "Read network news.