2000-11-15 13:21 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / mail-source.el
index 6054c89..2729791 100644 (file)
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl)
+  (require 'imap)
+  (eval-when-compile (defvar display-time-mail-function)))
 (eval-and-compile
   (autoload 'pop3-movemail "pop3")
-  (autoload 'pop3-get-message-count "pop3"))
+  (autoload 'pop3-get-message-count "pop3")
+  (autoload 'nnheader-cancel-timer "nnheader"))
 (require 'format-spec)
+(require 'mm-util)
 
 (defgroup mail-source nil
   "The mail-fetching library."
   :group 'gnus)
 
+;; Define these at compile time to avoid dragging in imap always.
+(defconst mail-source-imap-authenticators
+  (eval-when-compile
+    (mapcar (lambda (a)
+             (list 'const (car a)))
+     imap-authenticator-alist)))
+(defconst mail-source-imap-streams
+  (eval-when-compile
+    (mapcar (lambda (a)
+             (list 'const (car a)))
+     imap-stream-alist)))
+
 (defcustom mail-sources nil
   "*Where the mail backends will look for incoming mail.
 This variable is a list of mail source specifiers.
 See Info node `(gnus)Mail Source Specifiers'."
   :group 'mail-source
-  ;; This specification should be tidied up, particularly to avoid
-  ;; constant items appearing.  (Perhaps there's scope for improvment
-  ;; in the widget code.)
   :type `(repeat
-         (choice (const :tag "Default spool file" (file))
-                 (list :tag "Specified spool file"
-                       (const file)
-                       (const :value :path)
-                       file)
+         (choice :format "%[Value Menu%] %v"
+                 :value (file)
+                 (cons :tag "Spool file"
+                       (const :format "" file)
+                       (checklist :tag "Options" :greedy t
+                                  (group :inline t
+                                         (const :format "" :value :path)
+                                         file)))
                  (cons :tag "Several files in a directory"
-                       (const directory)
-                       (choice
-                        :tag "Options"
-                        (const :tag "None" nil)
-                        (repeat
-                         (choice
-                          (list :inline t :tag "path"
-                                (const :value :path) directory)
-                          (list :inline t :tag "suffix"
-                                (const :value :suffix) string)
-                          (list :inline t :tag "predicate"
-                                (const :value :predicate) function)
-                          (list :inline t :tag "prescript"
-                                (const :value :prescript) string)
-                          (list :inline t :tag "postscript"
-                                (const :value :postscript) string)
-                          (list :inline t :tag "plugged"
-                                (const :value :plugged) boolean)))))
+                       (const :format "" directory)
+                       (checklist :tag "Options" :greedy t
+                                  (group :inline t
+                                         (const :format "" :value :path)
+                                         (directory :tag "Path"))
+                                  (group :inline t
+                                         (const :format "" :value :suffix)
+                                         (string :tag "Suffix"))
+                                  (group :inline t
+                                         (const :format "" :value :predicate)
+                                         (function :tag "Predicate"))
+                                  (group :inline t
+                                         (const :format "" :value :prescript)
+                                         (string :tag "Prescript"))
+                                  (group :inline t
+                                         (const :format "" :value :postscript)
+                                         (string :tag "Postscript"))
+                                  (group :inline t
+                                         (const :format "" :value :plugged)
+                                         (boolean :tag "Plugged"))))
                  (cons :tag "POP3 server"
-                       (const pop)
-                       (choice
-                        :tag "Options"
-                        (const :tag "None" nil)
-                        (repeat
-                         (choice
-                          (list :inline t :tag "server"
-                                (const :value :server) string)
-                          (list :inline t :tag "port"
-                                (const :value :port) (choice number string))
-                          (list :inline t :tag "user"
-                                (const :value :user) string)
-                          (list :inline t :tag "password"
-                                (const :value :password) string)
-                          (list :inline t :tag "program"
-                                (const :value :program) string)
-                          (list :inline t :tag "prescript"
-                                (const :value :prescript) string)
-                          (list :inline t :tag "postscript"
-                                (const :value :postscript) string)
-                          (list :inline t :tag "function"
-                                (const :value :function) function)
-                          (list :inline t :tag "authentication"
-                                (const :value :authentication)
-                                (choice (const password)
-                                        (const apop)))
-                          (list :inline t :tag "plugged"
-                                (const :value :plugged) boolean)))))
+                       (const :format "" pop)
+                       (checklist :tag "Options" :greedy t
+                                  (group :inline t
+                                         (const :format "" :value :server) 
+                                         (string :tag "Server"))
+                                  (group :inline t
+                                         (const :format "" :value :port) 
+                                         (choice :tag "Port"
+                                                 :value "pop3" 
+                                                 (number :format "%v")
+                                                 (string :format "%v")))
+                                  (group :inline t
+                                         (const :format "" :value :user)
+                                         (string :tag "User"))
+                                  (group :inline t
+                                         (const :format "" :value :password)
+                                         (string :tag "Password"))
+                                  (group :inline t
+                                         (const :format "" :value :program)
+                                         (string :tag "Program"))
+                                  (group :inline t
+                                         (const :format "" :value :prescript)
+                                         (string :tag "Prescript"))
+                                  (group :inline t
+                                         (const :format "" :value :postscript)
+                                         (string :tag "Postscript"))
+                                  (group :inline t
+                                         (const :format "" :value :function)
+                                         (function :tag "Function"))
+                                  (group :inline t
+                                         (const :format "" 
+                                                :value :authentication)
+                                         (choice :tag "Authentication"
+                                                 :value apop
+                                                 (const password)
+                                                 (const apop)))
+                                  (group :inline t
+                                         (const :format "" :value :plugged)
+                                         (boolean :tag "Plugged"))))
                  (cons :tag "Maildir (qmail, postfix...)"
-                       (const maildir)
-                       (choice
-                        :tag "Options"
-                        (const :tag "None" nil)
-                        (repeat
-                         (choice
-                          (list :inline t :tag "path"
-                                (const :value :path) directory)
-                          (list :inline t :tag "plugged"
-                                (const :value :plugged) boolean)))))
+                       (const :format "" maildir)
+                       (checklist :tag "Options" :greedy t
+                                  (group :inline t
+                                         (const :format "" :value :path)
+                                         (directory :tag "Path"))
+                                  (group :inline t
+                                         (const :format "" :value :plugged)
+                                         (boolean :tag "Plugged"))))
                  (cons :tag "IMAP server"
-                       (const imap)
-                       (choice
-                        :tag "Options"
-                        (const :tag "None" nil)
-                        (repeat
-                         (choice
-                          (list :inline t :tag "server"
-                                (const :value :server) string)
-                          (list :inline t :tag "port"
-                                (const :value :port)
-                                (choice number string))
-                          (list :inline t :tag "user"
-                                (const :value :user) string)
-                          (list :inline t :tag "password"
-                                (const :value :password) string)
-                          (list :inline t :tag "stream"
-                                (const :value :stream)
-                                (choice ,@(progn (require 'imap)
-                                                 (mapcar
-                                                  (lambda (a)
-                                                    (list 'const (car a)))
-                                                  imap-stream-alist))))
-                          (list :inline t :tag "authenticator"
-                                (const :value :authenticator)
-                                (choice ,@(progn (require 'imap)
-                                                 (mapcar
-                                                  (lambda (a)
-                                                    (list 'const (car a)))
-                                                  imap-authenticator-alist))))
-                          (list :inline t :tag "mailbox"
-                                (const :value :mailbox) string)
-                          (list :inline t :tag "predicate"
-                                (const :value :predicate) function)
-                          (list :inline t :tag "fetchflag"
-                                (const :value :fetchflag) string)
-                          (list :inline t :tag "dontexpunge"
-                                (const :value :dontexpunge) boolean)
-                          (list :inline t :tag "plugged"
-                                (const :value :plugged) )))))
+                       (const :format "" imap)
+                       (checklist :tag "Options" :greedy t
+                                  (group :inline t
+                                         (const :format "" :value :server)
+                                         (string :tag "Server"))
+                                  (group :inline t
+                                         (const :format "" :value :port)
+                                         (choice :tag "Port" 
+                                                 :value 143 
+                                                 number string))
+                                  (group :inline t
+                                         (const :format "" :value :user)
+                                         (string :tag "User"))
+                                  (group :inline t
+                                         (const :format "" :value :password)
+                                         (string :tag "Password"))
+                                  (group :inline t
+                                         (const :format "" :value :stream)
+                                         (choice :tag "Stream"
+                                                 :value network
+                                                 ,@mail-source-imap-streams))
+                                  (group :inline t
+                                         (const :format ""
+                                                :value :authenticator)
+                                         (choice :tag "Authenticator"
+                                                 :value login
+                                                 ,@mail-source-imap-authenticators))
+                                  (group :inline t
+                                         (const :format "" :value :mailbox)
+                                         (string :tag "Mailbox"
+                                                 :value "INBOX"))
+                                  (group :inline t
+                                         (const :format "" :value :predicate)
+                                         (string :tag "Predicate" 
+                                                 :value "UNSEEN UNDELETED"))
+                                  (group :inline t
+                                         (const :format "" :value :fetchflag)
+                                         (string :tag "Fetchflag"
+                                                 :value  "\\Deleted"))
+                                  (group :inline t
+                                         (const :format ""
+                                                :value :dontexpunge)
+                                         (boolean :tag "Dontexpunge"))
+                                  (group :inline t
+                                         (const :format "" :value :plugged)
+                                         (boolean :tag "Plugged"))))
                  (cons :tag "Webmail server"
-                       (const webmail)
-                       (choice
-                        :tag "Options"
-                        (const :tag "None" nil)
-                        (repeat
-                         (choice
-                          (list :inline t :tag "subtype"
-                                (const :value :subtype)
-                                ;; Should be generated from
-                                ;; `webmail-type-definition', but we
-                                ;; can't require webmail without W3.
-                                (choice (const hotmail) (const yahoo)
-                                        (const netaddress) (const netscape)
-                                        (const my-deja)))
-                          (list :inline t :tag "user"
-                                (const :value :user) string)
-                          (list :inline t :tag "password"
-                                (const :value :password) string)
-                          (list :inline t :tag "dontexpunge"
-                                (const :value :dontexpunge) boolean)
-                          (list :inline t :tag "plugged"
-                                (const :value :plugged) boolean))))))))
+                       (const :format "" webmail)
+                       (checklist :tag "Options" :greedy t
+                                  (group :inline t 
+                                        (const :format "" :value :subtype)
+                                        ;; Should be generated from
+                                        ;; `webmail-type-definition', but we
+                                        ;; can't require webmail without W3.
+                                        (choice :tag "Subtype"
+                                                :value hotmail
+                                                (const hotmail)
+                                                (const yahoo)
+                                                (const netaddress)
+                                                (const netscape)
+                                                (const my-deja)))
+                                  (group :inline t
+                                         (const :format "" :value :user)
+                                         (string :tag "User"))
+                                  (group :inline t
+                                         (const :format "" :value :password)
+                                         (string :tag "Password"))
+                                  (group :inline t
+                                         (const :format ""
+                                                :value :dontexpunge)
+                                         (boolean :tag "Dontexpunge"))
+                                  (group :inline t
+                                         (const :format "" :value :plugged)
+                                         (boolean :tag "Plugged")))))))
 
 (defcustom mail-source-primary-source nil
   "*Primary source for incoming mail.
@@ -233,7 +273,7 @@ Common keywords should be listed here.")
        (:prescript-delay)
        (:postscript)
        (:path (or (getenv "MAIL")
-                 (concat "/usr/spool/mail/" (user-login-name)))))
+                 (expand-file-name (user-login-name) rmail-spool-directory))))
       (directory
        (:path)
        (:suffix ".spool")
@@ -771,10 +811,10 @@ This only works when `display-time' is enabled."
 ;;;                                        (current-time-string) "\n"))
 ;;;                              (while (re-search-forward "^From " nil t)
 ;;;                                (replace-match ">From "))
+;;;                               (goto-char (point-max))
+;;;                              (insert "\n\n")
                                  ;; MMDF mail format
-                                 (insert "\001\001\001\001\n")
-                                 (goto-char (point-max))
-                                 (insert "\n\n"))
+                                 (insert "\001\001\001\001\n"))
                                (delete-file file)))))
              (incf found (mail-source-callback callback file))))))
       found)))
@@ -810,11 +850,11 @@ This only works when `display-time' is enabled."
                user (or (cdr (assoc from mail-source-password-cache))
                         password) buf)
               (imap-mailbox-select mailbox nil buf))
-         (let (str (coding-system-for-write mail-source-imap-file-coding-system))
+         (let ((coding-system-for-write mail-source-imap-file-coding-system)
+               str)
            (with-temp-file mail-source-crash-box
-             ;; In some versions of FSF Emacs, inserting unibyte
-             ;; string into multibyte buffer may convert 8-bit chars
-             ;; into latin-iso8859-1 chars, which results \201's.
+             ;; Avoid converting 8-bit chars from inserted strings to
+             ;; multibyte.
              (mm-disable-multibyte)
              ;; remember password
              (with-current-buffer buf