cgit.sxemacs.org Git - gnus/blob - lisp/mail-source.el

   1 ;;; mail-source.el --- functions for fetching mail
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: news, mail
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 ;; For Emacs < 22.2.
  29 (eval-and-compile
  30   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  31
  32 (require 'format-spec)
  33 (eval-when-compile
  34   (require 'cl)
  35   (require 'imap))
  36 (autoload 'auth-source-user-or-password "auth-source")
  37 (autoload 'pop3-movemail "pop3")
  38 (autoload 'pop3-get-message-count "pop3")
  39 (autoload 'nnheader-cancel-timer "nnheader")
  40 (require 'mm-util)
  41 (require 'message) ;; for `message-directory'
  42
  43 (defvar display-time-mail-function)
  44
  45 (defgroup mail-source nil
  46   "The mail-fetching library."
  47   :version "21.1"
  48   :group 'gnus)
  49
  50 ;; Define these at compile time to avoid dragging in imap always.
  51 (defconst mail-source-imap-authenticators
  52   (eval-when-compile
  53     (mapcar (lambda (a)
  54               (list 'const (car a)))
  55      imap-authenticator-alist)))
  56 (defconst mail-source-imap-streams
  57   (eval-when-compile
  58     (mapcar (lambda (a)
  59               (list 'const (car a)))
  60      imap-stream-alist)))
  61
  62 (defcustom mail-sources '((file))
  63   "Where the mail backends will look for incoming mail.
  64 This variable is a list of mail source specifiers.
  65 See Info node `(gnus)Mail Source Specifiers'."
  66   :group 'mail-source
  67   :version "23.1" ;; No Gnus
  68   :link '(custom-manual "(gnus)Mail Source Specifiers")
  69   :type `(choice
  70           (const :tag "None" nil)
  71           (repeat :tag "List"
  72            (choice :format "%[Value Menu%] %v"
  73                    :value (file)
  74                    (cons :tag "Group parameter `mail-source'"
  75                          (const :format "" group))
  76                    (cons :tag "Spool file"
  77                          (const :format "" file)
  78                          (checklist :tag "Options" :greedy t
  79                                     (group :inline t
  80                                            (const :format "" :value :path)
  81                                            file)))
  82                    (cons :tag "Several files in a directory"
  83                          (const :format "" directory)
  84                          (checklist :tag "Options" :greedy t
  85                                     (group :inline t
  86                                            (const :format "" :value :path)
  87                                            (directory :tag "Path"))
  88                                     (group :inline t
  89                                            (const :format "" :value :suffix)
  90                                            (string :tag "Suffix"))
  91                                     (group :inline t
  92                                            (const :format "" :value :predicate)
  93                                            (function :tag "Predicate"))
  94                                     (group :inline t
  95                                            (const :format "" :value :prescript)
  96                                            (choice :tag "Prescript"
  97                                                    :value nil
  98                                                    (string :format "%v")
  99                                                    (function :format "%v")))
 100                                     (group :inline t
 101                                            (const :format "" :value :postscript)
 102                                            (choice :tag "Postscript"
 103                                                    :value nil
 104                                                    (string :format "%v")
 105                                                    (function :format "%v")))
 106                                     (group :inline t
 107                                            (const :format "" :value :plugged)
 108                                            (boolean :tag "Plugged"))))
 109                    (cons :tag "POP3 server"
 110                          (const :format "" pop)
 111                          (checklist :tag "Options" :greedy t
 112                                     (group :inline t
 113                                            (const :format "" :value :server)
 114                                            (string :tag "Server"))
 115                                     (group :inline t
 116                                            (const :format "" :value :port)
 117                                            (choice :tag "Port"
 118                                                    :value "pop3"
 119                                                    (integer :format "%v")
 120                                                    (string :format "%v")))
 121                                     (group :inline t
 122                                            (const :format "" :value :user)
 123                                            (string :tag "User"))
 124                                     (group :inline t
 125                                            (const :format "" :value :password)
 126                                            (string :tag "Password"))
 127                                     (group :inline t
 128                                            (const :format "" :value :program)
 129                                            (string :tag "Program"))
 130                                     (group :inline t
 131                                            (const :format "" :value :prescript)
 132                                            (choice :tag "Prescript"
 133                                                    :value nil
 134                                                    (string :format "%v")
 135                                                    (function :format "%v")
 136                                                    (const :tag "None" nil)))
 137                                     (group :inline t
 138                                            (const :format "" :value :postscript)
 139                                            (choice :tag "Postscript"
 140                                                    :value nil
 141                                                    (string :format "%v")
 142                                                    (function :format "%v")
 143                                                    (const :tag "None" nil)))
 144                                     (group :inline t
 145                                            (const :format "" :value :function)
 146                                            (function :tag "Function"))
 147                                     (group :inline t
 148                                            (const :format ""
 149                                                   :value :authentication)
 150                                            (choice :tag "Authentication"
 151                                                    :value apop
 152                                                    (const password)
 153                                                    (const apop)))
 154                                     (group :inline t
 155                                            (const :format "" :value :plugged)
 156                                            (boolean :tag "Plugged"))
 157                                     (group :inline t
 158                                            (const :format "" :value :stream)
 159                                            (choice :tag "Stream"
 160                                                    :value nil
 161                                                    (const :tag "Clear" nil)
 162                                                    (const starttls)
 163                                                    (const :tag "SSL/TLS" ssl)))))
 164                    (cons :tag "Maildir (qmail, postfix...)"
 165                          (const :format "" maildir)
 166                          (checklist :tag "Options" :greedy t
 167                                     (group :inline t
 168                                            (const :format "" :value :path)
 169                                            (directory :tag "Path"))
 170                                     (group :inline t
 171                                            (const :format "" :value :plugged)
 172                                            (boolean :tag "Plugged"))))
 173                    (cons :tag "IMAP server"
 174                          (const :format "" imap)
 175                          (checklist :tag "Options" :greedy t
 176                                     (group :inline t
 177                                            (const :format "" :value :server)
 178                                            (string :tag "Server"))
 179                                     (group :inline t
 180                                            (const :format "" :value :port)
 181                                            (choice :tag "Port"
 182                                                    :value 143
 183                                                    integer string))
 184                                     (group :inline t
 185                                            (const :format "" :value :user)
 186                                            (string :tag "User"))
 187                                     (group :inline t
 188                                            (const :format "" :value :password)
 189                                            (string :tag "Password"))
 190                                     (group :inline t
 191                                            (const :format "" :value :stream)
 192                                            (choice :tag "Stream"
 193                                                    :value network
 194                                                    ,@mail-source-imap-streams))
 195                                     (group :inline t
 196                                            (const :format "" :value :program)
 197                                            (string :tag "Program"))
 198                                     (group :inline t
 199                                            (const :format ""
 200                                                   :value :authenticator)
 201                                            (choice :tag "Authenticator"
 202                                                    :value login
 203                                                    ,@mail-source-imap-authenticators))
 204                                     (group :inline t
 205                                            (const :format "" :value :mailbox)
 206                                            (string :tag "Mailbox"
 207                                                    :value "INBOX"))
 208                                     (group :inline t
 209                                            (const :format "" :value :predicate)
 210                                            (string :tag "Predicate"
 211                                                    :value "UNSEEN UNDELETED"))
 212                                     (group :inline t
 213                                            (const :format "" :value :fetchflag)
 214                                            (string :tag "Fetchflag"
 215                                                    :value  "\\Deleted"))
 216                                     (group :inline t
 217                                            (const :format ""
 218                                                   :value :dontexpunge)
 219                                            (boolean :tag "Dontexpunge"))
 220                                     (group :inline t
 221                                            (const :format "" :value :plugged)
 222                                            (boolean :tag "Plugged"))))
 223                    (cons :tag "Webmail server"
 224                          (const :format "" webmail)
 225                          (checklist :tag "Options" :greedy t
 226                                     (group :inline t
 227                                           (const :format "" :value :subtype)
 228                                           ;; Should be generated from
 229                                           ;; `webmail-type-definition', but we
 230                                           ;; can't require webmail without W3.
 231                                           (choice :tag "Subtype"
 232                                                   :value hotmail
 233                                                   (const hotmail)
 234                                                   (const yahoo)
 235                                                   (const netaddress)
 236                                                   (const netscape)
 237                                                   (const my-deja)))
 238                                     (group :inline t
 239                                            (const :format "" :value :user)
 240                                            (string :tag "User"))
 241                                     (group :inline t
 242                                            (const :format "" :value :password)
 243                                            (string :tag "Password"))
 244                                     (group :inline t
 245                                            (const :format ""
 246                                                   :value :dontexpunge)
 247                                            (boolean :tag "Dontexpunge"))
 248                                     (group :inline t
 249                                            (const :format "" :value :plugged)
 250                                            (boolean :tag "Plugged"))))))))
 251
 252 (defcustom mail-source-ignore-errors nil
 253   "*Ignore errors when querying mail sources.
 254 If nil, the user will be prompted when an error occurs.  If non-nil,
 255 the error will be ignored."
 256   :version "22.1"
 257   :group 'mail-source
 258   :type 'boolean)
 259
 260 (defcustom mail-source-primary-source nil
 261   "*Primary source for incoming mail.
 262 If non-nil, this maildrop will be checked periodically for new mail."
 263   :group 'mail-source
 264   :type 'sexp)
 265
 266 (defcustom mail-source-flash t
 267   "*If non-nil, flash periodically when mail is available."
 268   :group 'mail-source
 269   :type 'boolean)
 270
 271 (defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
 272   "File where mail will be stored while processing it."
 273   :group 'mail-source
 274   :type 'file)
 275
 276 (defcustom mail-source-directory message-directory
 277   "Directory where incoming mail source files (if any) will be stored."
 278   :group 'mail-source
 279   :type 'directory)
 280
 281 (defcustom mail-source-default-file-modes 384
 282   "Set the mode bits of all new mail files to this integer."
 283   :group 'mail-source
 284   :type 'integer)
 285
 286 (defcustom mail-source-delete-incoming
 287   10 ;; development versions
 288   ;; 2 ;; released versions
 289   "If non-nil, delete incoming files after handling.
 290 If t, delete immediately, if nil, never delete.  If a positive number, delete
 291 files older than number of days.
 292
 293 Removing of old files happens in `mail-source-callback', i.e. no
 294 old incoming files will be deleted unless you receive new mail.
 295 You may also set this variable to nil and call
 296 `mail-source-delete-old-incoming' interactively."
 297   :group 'mail-source
 298   :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
 299   :type '(choice (const :tag "immediately" t)
 300                  (const :tag "never" nil)
 301                  (integer :tag "days")))
 302
 303 (defcustom mail-source-delete-old-incoming-confirm nil
 304   "If non-nil, ask for confirmation before deleting old incoming files.
 305 This variable only applies when `mail-source-delete-incoming' is a positive
 306 number."
 307   :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
 308   :group 'mail-source
 309   :type 'boolean)
 310
 311 (defcustom mail-source-incoming-file-prefix "Incoming"
 312   "Prefix for file name for storing incoming mail"
 313   :group 'mail-source
 314   :type 'string)
 315
 316 (defcustom mail-source-report-new-mail-interval 5
 317   "Interval in minutes between checks for new mail."
 318   :group 'mail-source
 319   :type 'number)
 320
 321 (defcustom mail-source-idle-time-delay 5
 322   "Number of idle seconds to wait before checking for new mail."
 323   :group 'mail-source
 324   :type 'number)
 325
 326 (defcustom mail-source-movemail-program nil
 327   "If non-nil, name of program for fetching new mail."
 328   :version "22.1"
 329   :group 'mail-source
 330   :type '(choice (const nil) string))
 331
 332 ;;; Internal variables.
 333
 334 (defvar mail-source-string ""
 335   "A dynamically bound string that says what the current mail source is.")
 336
 337 (defvar mail-source-new-mail-available nil
 338   "Flag indicating when new mail is available.")
 339
 340 (eval-and-compile
 341   (defvar mail-source-common-keyword-map
 342     '((:plugged))
 343     "Mapping from keywords to default values.
 344 Common keywords should be listed here.")
 345
 346   (defvar mail-source-keyword-map
 347     '((file
 348