;;; mail-source.el --- functions for fetching mail
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
(eval-and-compile
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
- (autoload 'nnheader-cancel-timer "nnheader"))
+ (autoload 'nnheader-cancel-timer "nnheader")
+ (autoload 'nnheader-run-at-time "nnheader"))
(require 'format-spec)
(require 'mm-util)
+(require 'message) ;; for `message-directory'
(defgroup mail-source nil
"The mail-fetching library."
+ :version "21.1"
:group 'gnus)
;; Define these at compile time to avoid dragging in imap always.
(const :format "" pop)
(checklist :tag "Options" :greedy t
(group :inline t
- (const :format "" :value :server)
+ (const :format "" :value :server)
(string :tag "Server"))
(group :inline t
- (const :format "" :value :port)
+ (const :format "" :value :port)
(choice :tag "Port"
- :value "pop3"
+ :value "pop3"
(number :format "%v")
(string :format "%v")))
(group :inline t
(const :format "" :value :function)
(function :tag "Function"))
(group :inline t
- (const :format ""
+ (const :format ""
:value :authentication)
(choice :tag "Authentication"
:value apop
(string :tag "Server"))
(group :inline t
(const :format "" :value :port)
- (choice :tag "Port"
- :value 143
+ (choice :tag "Port"
+ :value 143
number string))
(group :inline t
(const :format "" :value :user)
(choice :tag "Stream"
:value network
,@mail-source-imap-streams))
+ (group :inline t
+ (const :format "" :value :program)
+ (string :tag "Program"))
(group :inline t
(const :format ""
:value :authenticator)
:value "INBOX"))
(group :inline t
(const :format "" :value :predicate)
- (string :tag "Predicate"
+ (string :tag "Predicate"
:value "UNSEEN UNDELETED"))
(group :inline t
(const :format "" :value :fetchflag)
(cons :tag "Webmail server"
(const :format "" webmail)
(checklist :tag "Options" :greedy t
- (group :inline t
+ (group :inline t
(const :format "" :value :subtype)
;; Should be generated from
;; `webmail-type-definition', but we
:group 'mail-source
:type 'sexp)
+(defcustom mail-source-flash t
+ "*If non-nil, flash periodically when mail is available."
+ :group 'mail-source
+ :type 'boolean)
+
(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
"File where mail will be stored while processing it."
:group 'mail-source
:type 'file)
-(defcustom mail-source-directory "~/Mail/"
+(defcustom mail-source-directory message-directory
"Directory where files (if any) will be stored."
:group 'mail-source
:type 'directory)
:group 'mail-source
:type 'number)
+(defcustom mail-source-movemail-program nil
+ "If non-nil, name of program for fetching new mail."
+ :group 'mail-source
+ :type '(choice (const nil) string))
+
;;; Internal variables.
(defvar mail-source-string ""
(:server (getenv "MAILHOST"))
(:port)
(:stream)
+ (:program)
(:authentication)
(:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
(:password)
(setq found (mail-source-callback
callback mail-source-crash-box)))
(+ found
- (condition-case err
+ (if (or debug-on-quit debug-on-error)
(funcall function source callback)
- (error
- (unless (yes-or-no-p
- (format "Mail source error (%s). Continue? " err))
- (error "Cannot get new mail."))
- 0))))))))
+ (condition-case err
+ (funcall function source callback)
+ (error
+ (unless (yes-or-no-p
+ (format "Mail source error (%s). Continue? " err))
+ (error "Cannot get new mail"))
+ 0)))))))))
(defun mail-source-make-complex-temp-name (prefix)
(let ((newname (make-temp-name prefix))
'call-process
(append
(list
- (expand-file-name "movemail" exec-directory)
+ (or mail-source-movemail-program
+ (expand-file-name "movemail" exec-directory))
nil errors nil from to)))))
(when (file-exists-p to)
(set-file-modes to mail-source-default-file-modes))
- (if (and (not (buffer-modified-p errors))
+ (if (and (or (not (buffer-modified-p errors))
+ (zerop (buffer-size errors)))
(zerop result))
;; No output => movemail won.
t
(goto-char (point-min))
(when (looking-at "movemail: ")
(delete-region (point-min) (match-end 0)))
+ ;; Result may be a signal description string.
(unless (yes-or-no-p
- (format "movemail: %s (%d return). Continue? "
+ (format "movemail: %s (%s return). Continue? "
(buffer-string) result))
(error "%s" (buffer-string)))
(setq to nil)))))))
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass)))
- (save-excursion (pop3-movemail mail-source-crash-box))))))
+ (if (or debug-on-quit debug-on-error)
+ (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))))))
+ (if (or debug-on-quit debug-on-error)
+ (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))
(defun mail-source-new-mail-p ()
"Handler for `display-time' to indicate when new mail is available."
+ ;; Flash (ie. ring the visible bell) if mail is available.
+ (if (and mail-source-flash mail-source-new-mail-available)
+ (let ((visible-bell t))
+ (ding)))
;; Only report flag setting; flag is updated on a different schedule.
mail-source-new-mail-available)
(defvar mail-source-report-new-mail-timer nil)
(defvar mail-source-report-new-mail-idle-timer nil)
-(eval-when-compile
+(eval-when-compile
(if (featurep 'xemacs)
(require 'itimer)
(require 'timer)))
mail-source-idle-time-delay
nil
(lambda ()
- (setq mail-source-report-new-mail-idle-timer nil)
- (mail-source-check-pop mail-source-primary-source))))
+ (unwind-protect
+ (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
This only works when `display-time' is enabled."
(interactive "P")
(if (not mail-source-primary-source)
- (error "Need to set `mail-source-primary-source' to check for new mail."))
+ (error "Need to set `mail-source-primary-source' to check for new mail"))
(let ((on (if (null arg)
(not mail-source-report-new-mail)
(> (prefix-numeric-value arg) 0))))
(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)
(when (and (not (file-directory-p file))
(not (if function
(funcall function file mail-source-crash-box)
- (let ((coding-system-for-write
+ (let ((coding-system-for-write
mm-text-coding-system)
- (coding-system-for-read
+ (coding-system-for-read
mm-text-coding-system))
(with-temp-file mail-source-crash-box
(insert-file-contents file)
(goto-char (point-min))
;;; ;; Unix mail format
;;; (unless (looking-at "\n*From ")
-;;; (insert "From maildir "
+;;; (insert "From maildir "
;;; (current-time-string) "\n"))
;;; (while (re-search-forward "^From " nil t)
;;; (replace-match ">From "))
(found 0)
(buf (get-buffer-create (generate-new-buffer-name " *imap source*")))
(mail-source-string (format "imap:%s:%s" server mailbox))
+ (imap-shell-program (or (list program) imap-shell-program))
remove)
(if (and (imap-open server port stream authentication buf)
(imap-authenticate
(push (cons from imap-password) mail-source-password-cache)))
;; if predicate is nil, use all uids
(dolist (uid (imap-search (or predicate "1:*") buf))
- (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))
+ (when (setq str
+ (if (imap-capability 'IMAP4rev1 buf)
+ (caddar (imap-fetch uid "BODY.PEEK[]"
+ 'BODYDETAIL nil buf))
+ (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
(push uid remove)
(insert "From imap " (current-time-string) "\n")
(save-excursion
fetchflag nil buf))
(if dontexpunge
(imap-mailbox-unselect buf)
- (imap-mailbox-close buf))
+ (imap-mailbox-close nil buf))
(imap-close buf))
(imap-close buf)
;; We nix out the password in case the error
(when (eq authentication 'password)
(setq password
(or password
- (cdr (assoc (format "webmail:%s:%s" subtype user)
+ (cdr (assoc (format "webmail:%s:%s" subtype user)
mail-source-password-cache))
(mail-source-read-passwd
(format "Password for %s at %s: " user subtype))))
(when (and password
- (not (assoc (format "webmail:%s:%s" subtype user)
+ (not (assoc (format "webmail:%s:%s" subtype user)
mail-source-password-cache)))
- (push (cons (format "webmail:%s:%s" subtype user) password)
+ (push (cons (format "webmail:%s:%s" subtype user) password)
mail-source-password-cache)))
(webmail-fetch mail-source-crash-box subtype user password)
(mail-source-callback callback (symbol-name subtype)))))
projects / gnus / blobdiff