;;; mail-source.el --- functions for fetching mail
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
This variable is a list of mail source specifiers.
See Info node `(gnus)Mail Source Specifiers'."
:group 'mail-source
- :version "23.1" ;; No Gnus
+ :version "24.4"
:link '(custom-manual "(gnus)Mail Source Specifiers")
:type `(choice
(const :tag "None" nil)
:value nil
(const :tag "Clear" nil)
(const starttls)
- (const :tag "SSL/TLS" ssl)))))
+ (const :tag "SSL/TLS" ssl)))
+ (group :inline t
+ (const :format "" :value :leave)
+ (choice :format "\
+%{Leave mail on server%}:\n\t\t%[Value Menu%] %v"
+ :value nil
+ (const :tag "\
+Don't leave mails" nil)
+ (const :tag "\
+Leave all mails" t)
+ (number :tag "\
+Leave mails for this many days" :value 14)))))
(cons :tag "Maildir (qmail, postfix...)"
(const :format "" maildir)
(checklist :tag "Options" :greedy t
(:function)
(:password)
(:authentication password)
- (:stream nil))
+ (:stream nil)
+ (:leave))
(maildir
(:path (or (getenv "MAILDIR") "~/Maildir/"))
(:subdirs ("cur" "new"))
;; Return whether we moved successfully or not.
to)))
-(defun mail-source-movemail-and-remove (from to)
- "Move FROM to TO using movemail, then remove FROM if empty."
- (or (not (mail-source-movemail from to))
- (not (zerop (nth 7 (file-attributes from))))
- (delete-file from)))
-
(defun mail-source-fetch-with-program (program)
(eq 0 (call-process shell-file-name nil nil nil
shell-command-switch program)))
prescript-delay)
(let ((from (format "%s:%s:%s" server user port))
(mail-source-string (format "pop:%s@%s" user server))
+ (process-environment (if server
+ (cons (concat "MAILHOST=" server)
+ process-environment)
+ process-environment))
result)
(when (eq authentication 'password)
(setq password
(cdr (assoc from mail-source-password-cache))
(read-passwd
(format "Password for %s at %s: " user server)))))
- (when server
- (setenv "MAILHOST" server))
(setq result
(cond
(program
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass))
- (pop3-stream-type stream))
+ (pop3-stream-type stream)
+ (pop3-leave-mail-on-server leave))
(if (or debug-on-quit debug-on-error)
(save-excursion (pop3-movemail mail-source-crash-box))
(condition-case err
(mail-source-bind (pop source)
(let ((from (format "%s:%s:%s" server user port))
(mail-source-string (format "pop:%s@%s" user server))
+ (process-environment (if server
+ (cons (concat "MAILHOST=" server)
+ process-environment)
+ process-environment))
result)
(when (eq authentication 'password)
(setq password
(format "Password for %s at %s: " user server))))
(unless (assoc from mail-source-password-cache)
(push (cons from password) mail-source-password-cache)))
- (when server
- (setenv "MAILHOST" server))
(setq result
(cond
;; No easy way to check whether mail is waiting for these.
(dolist (file (directory-files (concat path subdir) t))
(when (and (not (file-directory-p file))
(not (if function
+ ;; `function' should return nil if successful.
(funcall function file mail-source-crash-box)
(let ((coding-system-for-write
mm-text-coding-system)
;;; (insert "\n\n")
;; MMDF mail format
(insert "\001\001\001\001\n"))
- (delete-file file)))))
+ (delete-file file)
+ nil))))
(incf found (mail-source-callback callback file))
(mail-source-delete-crash-box)))))
found)))