;;; 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")
+ (autoload 'nnheader-run-at-time "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.
(: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")
(or leave
(and (boundp 'pop3-leave-mail-on-server)
pop3-leave-mail-on-server))))
- (save-excursion (pop3-movemail mail-source-crash-box))))))
+ (condition-case err
+ (save-excursion (pop3-movemail mail-source-crash-box))
+ (error
+ ;; We nix out the password in case the error
+ ;; was because of a wrong password being given.
+ (setq mail-source-password-cache
+ (delq (assoc from mail-source-password-cache)
+ mail-source-password-cache))
+ (signal (car err) (cdr err))))))))
(if result
(progn
(when (eq authentication 'password)
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass)))
- (save-excursion (pop3-get-message-count))))))
+ (condition-case err
+ (save-excursion (pop3-get-message-count))
+ (error
+ ;; We nix out the password in case the error
+ ;; was because of a wrong password being given.
+ (setq mail-source-password-cache
+ (delq (assoc from mail-source-password-cache)
+ mail-source-password-cache))
+ (signal (car err) (cdr err))))))))
(if result
;; Inform display-time that we have new mail.
(setq mail-source-new-mail-available (> result 0))
mail-source-idle-time-delay
nil
(lambda ()
- (setq mail-source-report-new-mail-idle-timer nil)
- (mail-source-check-pop mail-source-primary-source))))
+ (mail-source-check-pop mail-source-primary-source)
+ (setq mail-source-report-new-mail-idle-timer nil))))
;; Since idle timers created when Emacs is already in the idle
;; state don't get activated until Emacs _next_ becomes idle, we
;; need to force our timer to be considered active now. We do
(> (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
(setq display-time-mail-function #'mail-source-new-mail-p)
;; Set up the main timer.
(setq mail-source-report-new-mail-timer
- (run-at-time t (* 60 mail-source-report-new-mail-interval)
- #'mail-source-start-idle-timer))
+ (nnheader-run-at-time
+ (* 60 mail-source-report-new-mail-interval)
+ (* 60 mail-source-report-new-mail-interval)
+ #'mail-source-start-idle-timer))
;; When you get new mail, clear "Mail" from the mode line.
(add-hook 'nnmail-post-get-new-mail-hook
'display-time-event-handler)
;;; (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)))
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
projects / elisp / gnus.git- / blobdiff