;;; mail-source.el --- functions for fetching mail
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
+(require 'format-spec)
(eval-when-compile
(require 'cl)
- (require 'imap)
- (eval-when-compile (defvar display-time-mail-function)))
+ (require 'imap))
(eval-and-compile
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
(autoload 'nnheader-cancel-timer "nnheader"))
-(require 'format-spec)
(require 'mm-util)
(require 'message) ;; for `message-directory'
+(defvar display-time-mail-function)
+
+
(defgroup mail-source nil
"The mail-fetching library."
:version "21.1"
(list 'const (car a)))
imap-stream-alist)))
-(defcustom mail-sources nil
- "*Where the mail backends will look for incoming mail.
+(defcustom mail-sources '((file))
+ "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
+ :version "23.1" ;; No Gnus
:link '(custom-manual "(gnus)Mail Source Specifiers")
- :type `(repeat
- (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 :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)
- (choice :tag "Prescript"
- :value nil
- (string :format "%v")
- (function :format "%v")))
- (group :inline t
- (const :format "" :value :postscript)
- (choice :tag "Postscript"
- :value nil
- (string :format "%v")
- (function :format "%v")))
- (group :inline t
- (const :format "" :value :plugged)
- (boolean :tag "Plugged"))))
- (cons :tag "POP3 server"
- (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)
- (choice :tag "Prescript"
- :value nil
- (string :format "%v")
- (function :format "%v")))
- (group :inline t
- (const :format "" :value :postscript)
- (choice :tag "Postscript"
- :value nil
- (string :format "%v")
- (function :format "%v")))
- (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 :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 :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 :program)
- (string :tag "Program"))
- (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 :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")))))))
+ :type `(choice
+ (const :tag "None" nil)
+ (repeat :tag "List"
+ (choice :format "%[Value Menu%] %v"
+ :value (file)
+ (cons :tag "Group parameter `mail-source'"
+ (const :format "" group))
+ (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 :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)
+ (choice :tag "Prescript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
+ (group :inline t
+ (const :format "" :value :postscript)
+ (choice :tag "Postscript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
+ (group :inline t
+ (const :format "" :value :plugged)
+ (boolean :tag "Plugged"))))
+ (cons :tag "POP3 server"
+ (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"
+ (integer :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)
+ (choice :tag "Prescript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")
+ (const :tag "None" nil)))
+ (group :inline t
+ (const :format "" :value :postscript)
+ (choice :tag "Postscript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")
+ (const :tag "None" nil)))
+ (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"))
+ (group :inline t
+ (const :format "" :value :stream)
+ (choice :tag "Stream"
+ :value nil
+ (const :tag "Clear" nil)
+ (const starttls)
+ (const :tag "SSL/TLS" ssl)))))
+ (cons :tag "Maildir (qmail, postfix...)"
+ (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 :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
+ integer 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 :program)
+ (string :tag "Program"))
+ (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 :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-ignore-errors nil
"*Ignore errors when querying mail sources.
:group 'mail-source
:type 'integer)
-(defcustom mail-source-delete-incoming nil
- "*If non-nil, delete incoming files after handling.
+(defcustom mail-source-delete-incoming
+ 10 ;; development versions
+ ;; 2 ;; released versions
+ "If non-nil, delete incoming files after handling.
If t, delete immediately, if nil, never delete. If a positive number, delete
-files older than number of days."
- ;; Note: The removing happens in `mail-source-callback', i.e. no old
- ;; incoming files will be deleted, unless you receive new mail.
- ;;
- ;; You may also set this to `nil' and call `mail-source-delete-old-incoming'
- ;; from a hook or interactively.
+files older than number of days.
+
+Removing of old files happens in `mail-source-callback', i.e. no
+old incoming files will be deleted unless you receive new mail.
+You may also set this variable to nil and call
+`mail-source-delete-old-incoming' interactively."
:group 'mail-source
+ :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
:type '(choice (const :tag "immediately" t)
(const :tag "never" nil)
(integer :tag "days")))
-(defcustom mail-source-delete-old-incoming-confirm t
- "*If non-nil, ask for for confirmation before deleting old incoming files.
+(defcustom mail-source-delete-old-incoming-confirm nil
+ "If non-nil, ask for confirmation before deleting old incoming files.
This variable only applies when `mail-source-delete-incoming' is a positive
number."
- :version "22.1"
+ :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
:group 'mail-source
:type 'boolean)
(:program)
(:function)
(:password)
- (:authentication password))
+ (:authentication password)
+ (:stream nil))
(maildir
(:path (or (getenv "MAILDIR") "~/Maildir/"))
(:subdirs ("cur" "new"))
(fileday (+ fileday (* low2days (nth 1 filetime)))))
(setq files (cdr files))
(when (and (> (- currday fileday) diff)
- (gnus-message 8 "File `%s' is older than %s day(s)"
- bfile diff)
- (or (not confirm)
- (y-or-n-p (concat "Remove file `" bfile "'? "))))
+ (if confirm
+ (y-or-n-p
+ (format "\
+Delete old (> %s day(s)) incoming mail file `%s'? " diff bfile))
+ (gnus-message 8 "\
+Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
+ t))
(delete-file ffile))))))
(defun mail-source-callback (callback info)
(sleep-for delay)))
(defun mail-source-call-script (script)
- (let ((background nil))
+ (let ((background nil)
+ (stderr (get-buffer-create " *mail-source-stderr*"))
+ result)
(when (string-match "& *$" script)
(setq script (substring script 0 (match-beginning 0))
background 0))
- (call-process shell-file-name nil background nil
- shell-command-switch script)))
+ (setq result
+ (call-process shell-file-name nil background nil
+ shell-command-switch script))
+ (when (and result
+ (not (zerop result)))
+ (set-buffer stderr)
+ (message "Mail source error: %s" (buffer-string)))
+ (kill-buffer stderr)))
;;;
;;; Different fetchers
(defun mail-source-fetch-pop (source callback)
"Fetcher for single-file sources."
(mail-source-bind (pop source)
+ ;; fixme: deal with stream type in format specs
(mail-source-run-script
prescript
(format-spec-make ?p password ?t mail-source-crash-box
(funcall function mail-source-crash-box))
;; The default is to use pop3.el.
(t
+ (require 'pop3)
(let ((pop3-password password)
(pop3-maildrop user)
(pop3-mailhost server)
(pop3-port port)
(pop3-authentication-scheme
- (if (eq authentication 'apop) 'apop 'pass)))
+ (if (eq authentication 'apop) 'apop 'pass))
+ (pop3-stream-type stream))
(if (or debug-on-quit debug-on-error)
(save-excursion (pop3-movemail mail-source-crash-box))
(condition-case err
(function)
;; The default is to use pop3.el.
(t
+ (require 'pop3)
(let ((pop3-password password)
(pop3-maildrop user)
(pop3-mailhost server)
(defvar mail-source-report-new-mail-timer nil)
(defvar mail-source-report-new-mail-idle-timer nil)
-(eval-when-compile
- (if (featurep 'xemacs)
- (require 'timer-funcs)
- (require 'timer)))
-
(defun mail-source-start-idle-timer ()
;; Start our idle timer if necessary, so we delay the check until the
;; user isn't typing.
(autoload 'imap-range-to-message-set "imap")
(autoload 'nnheader-ms-strip-cr "nnheader"))
+(autoload 'gnus-compress-sequence "gnus-range")
+
(defvar mail-source-imap-file-coding-system 'binary
"Coding system for the crashbox made by `mail-source-fetch-imap'.")
+;; Autoloads will bring in imap before this is called.
+(declare-function imap-capability "imap" (&optional identifier buffer))
+
(defun mail-source-fetch-imap (source callback)
"Fetcher for imap sources."
(mail-source-bind (imap source)