X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmail-source.el;h=816177bec9b31fcb297c63dd84523f0ef0337159;hb=aac9e24b0dbbc6df67061d352c12ef309926048f;hp=70c3ff792a79d39f810a62de47fadf13d5be7b1d;hpb=31ac812d0664c72238c6c2266c35d478474c7697;p=elisp%2Fgnus.git- diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 70c3ff7..816177b 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -25,154 +25,192 @@ ;;; Code: -(eval-when-compile (require 'cl)) -(require 'nnheader) +(eval-when-compile + (require 'cl) + (require 'imap) + (eval-when-compile (defvar display-time-mail-function))) (eval-and-compile (defvar pop3-leave-mail-on-server) (autoload 'pop3-movemail "pop3") - (autoload 'pop3-get-message-count "pop3")) + (autoload 'pop3-get-message-count "pop3") + (autoload 'nnheader-cancel-timer "nnheader")) (require 'format-spec) (defgroup mail-source nil "The mail-fetching library." :group 'gnus) -(defcustom mail-sources '((file)) +;; 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. @@ -235,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") @@ -730,9 +768,9 @@ This only works when `display-time' is enabled." (> (prefix-numeric-value arg) 0)))) (setq mail-source-report-new-mail on) (and mail-source-report-new-mail-timer - (cancel-timer mail-source-report-new-mail-timer)) + (nnheader-cancel-timer mail-source-report-new-mail-timer)) (and mail-source-report-new-mail-idle-timer - (cancel-timer mail-source-report-new-mail-idle-timer)) + (nnheader-cancel-timer mail-source-report-new-mail-idle-timer)) (setq mail-source-report-new-mail-timer nil) (setq mail-source-report-new-mail-idle-timer nil) (if on @@ -784,10 +822,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))) @@ -823,13 +861,12 @@ 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) - (output-coding-system mail-source-imap-file-coding-system)) + (let ((coding-system-for-write mail-source-imap-file-coding-system) + (output-coding-system 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. (set-buffer-multibyte nil) ;; remember password (with-current-buffer buf