;;; mail-source.el --- functions for fetching mail
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
(eval-when-compile
(require 'cl)
(require 'imap)
- (defvar display-time-mail-function)
- (autoload 'pop3-movemail "pop3")
- (autoload 'pop3-get-message-count "pop3"))
+ (defvar display-time-mail-function))
(eval-and-compile
- (autoload 'nnheader-cancel-timer "nnheader")
- (autoload 'nnheader-run-at-time "nnheader"))
+ (autoload 'pop3-movemail "pop3")
+ (autoload 'pop3-get-message-count "pop3")
+ (autoload 'nnheader-cancel-timer "nnheader"))
(require 'format-spec)
(require 'message) ;; for `message-directory'
(:leave))
(maildir
(:path (or (getenv "MAILDIR") "~/Maildir/"))
- (:subdirs ("new" "cur"))
+ (:subdirs ("cur" "new"))
(:function))
(imap
(:server (getenv "MAILHOST"))
(:mailbox "INBOX")
(:predicate "UNSEEN UNDELETED")
(:fetchflag "\\Deleted")
+ (:prescript)
+ (:prescript-delay)
+ (:postscript)
(:dontexpunge))
(webmail
(:subtype hotmail)
(error "Cannot get new mail"))
0)))))))))
-(eval-and-compile
- (if (fboundp 'make-temp-file)
- (defalias 'mail-source-make-complex-temp-name 'make-temp-file)
- (defun mail-source-make-complex-temp-name (prefix)
- (let ((newname (make-temp-name prefix))
- (newprefix prefix))
- (while (file-exists-p newname)
- (setq newprefix (concat newprefix "x"))
- (setq newname (make-temp-name newprefix)))
- newname))))
-
(defun mail-source-delete-old-incoming (&optional age confirm)
"Remove incoming files older than AGE days.
If CONFIRM is non-nil, ask for confirmation before removing a file."
(if (eq mail-source-delete-incoming t)
(delete-file mail-source-crash-box)
(let ((incoming
- (mail-source-make-complex-temp-name
+ (mm-make-temp-file
(expand-file-name
mail-source-incoming-file-prefix
mail-source-directory))))
(set-file-modes to mail-source-default-file-modes))
(if (and (or (not (buffer-modified-p errors))
(zerop (buffer-size errors)))
- (zerop result))
+ (and (numberp result)
+ (zerop result)))
;; No output => movemail won.
t
(set-buffer errors)
(delete-file from)))
(defun mail-source-fetch-with-program (program)
- (zerop (call-process shell-file-name nil nil nil
- shell-command-switch program)))
+ (eq 0 (call-process shell-file-name nil nil nil
+ shell-command-switch program)))
(defun mail-source-run-script (script spec &optional delay)
(when script
"Open and close a POP connection shortly.
POP server should be defined in `mail-source-primary-source' (which is
preferred) or `mail-sources'. You may use it for the POP-before-SMTP
-authentication. To do that, you need to set the option
-`message-send-mail-function' to `message-send-mail-with-smtp' or
-`message-smtpmail-send-it' and put the following line in .gnus file:
+authentication. To do that, you need to set the
+`message-send-mail-function' variable as `message-send-mail-with-smtp'
+or `message-smtpmail-send-it' and put the following line in your
+~/.gnus.el file:
\(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
-"
+
+See the Gnus manual for details."
(let ((sources (if mail-source-primary-source
(list mail-source-primary-source)
mail-sources)))
(setq display-time-mail-function #'mail-source-new-mail-p)
;; Set up the main timer.
(setq mail-source-report-new-mail-timer
- (nnheader-run-at-time
+ (run-at-time
(* 60 mail-source-report-new-mail-interval)
(* 60 mail-source-report-new-mail-interval)
#'mail-source-start-idle-timer))
(let ((coding-system-for-write
nnheader-text-coding-system)
(coding-system-for-read
- nnheader-text-coding-system)
- (output-coding-system
- nnheader-text-coding-system)
- (input-coding-system
nnheader-text-coding-system))
(with-temp-file mail-source-crash-box
(insert-file-contents file)
(defun mail-source-fetch-imap (source callback)
"Fetcher for imap sources."
(mail-source-bind (imap source)
- (let* ((from (format "%s:%s:%s" server user port))
- (found 0)
- (buffer-name " *imap source*")
- (buf (get-buffer-create (generate-new-buffer-name buffer-name)))
- (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 buffer-name)
+ (mail-source-run-script
+ prescript (format-spec-make ?p password ?t mail-source-crash-box
+ ?s server ?P port ?u user)
+ prescript-delay)
+ (let ((from (format "%s:%s:%s" server user port))
+ (found 0)
+ (buf (generate-new-buffer " *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
user (or (cdr (assoc from mail-source-password-cache))
password) buf)
(imap-mailbox-select mailbox nil buf))
(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
;; Avoid converting 8-bit chars from inserted strings to
(set-buffer-multibyte nil)
;; remember password
(with-current-buffer buf
- (when (or imap-password
- (assoc from mail-source-password-cache))
+ (when (and imap-password
+ (not (assoc from mail-source-password-cache)))
(push (cons from imap-password) mail-source-password-cache)))
;; if predicate is nil, use all uids
(dolist (uid (imap-search (or predicate "1:*") buf))
(nnheader-ms-strip-cr))
(incf found (mail-source-callback callback server))
(when (and remove fetchflag)
+ (setq remove (nreverse remove))
(imap-message-flags-add
(imap-range-to-message-set (gnus-compress-sequence remove))
fetchflag nil buf))
(setq mail-source-password-cache
(delq (assoc from mail-source-password-cache)
mail-source-password-cache))
- (error (imap-error-text buf)))
+ (error "IMAP error: %s" (imap-error-text buf)))
(kill-buffer buf)
+ (mail-source-run-script
+ postscript
+ (format-spec-make ?p password ?t mail-source-crash-box
+ ?s server ?P port ?u user))
found)))
(eval-and-compile