X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmail-source.el;h=7dbe30b91d8626d67f5cfa541f472929736f22dc;hb=726ad6774aae82f5141acc37726511b75dc7e2be;hp=3a90990d5d8c389d97bf0b712952be1b57ba9bd8;hpb=68cbd76313413f5892235325908567c67d9374a7;p=gnus diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 3a90990d5..7dbe30b91 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -1,17 +1,17 @@ ;;; mail-source.el --- functions for fetching mail ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -35,16 +33,15 @@ (eval-when-compile (require 'cl) (require 'imap)) -(eval-and-compile - (autoload 'pop3-movemail "pop3") - (autoload 'pop3-get-message-count "pop3") - (autoload 'nnheader-cancel-timer "nnheader")) +(autoload 'auth-source-user-or-password "auth-source") +(autoload 'pop3-movemail "pop3") +(autoload 'pop3-get-message-count "pop3") +(autoload 'nnheader-cancel-timer "nnheader") (require 'mm-util) (require 'message) ;; for `message-directory' (defvar display-time-mail-function) - (defgroup mail-source nil "The mail-fetching library." :version "21.1" @@ -420,6 +417,8 @@ All keywords that can be used must be listed here.")) "Strip the leading colon off the KEYWORD." (intern (substring (symbol-name keyword) 1)))) +;; generate a list of variable names paired with nil values +;; suitable for usage in a `let' form (eval-and-compile (defun mail-source-bind-1 (type) (let* ((defaults (cdr (assq type mail-source-keyword-map))) @@ -438,27 +437,58 @@ At run time, the mail source specifier SOURCE will be inspected, and the variables will be set according to it. Variables not specified will be given default values. +The user and password will be loaded from the auth-source values +if those are available. They override the original user and +password in a second `let' form. + After this is done, BODY will be executed in the scope -of the `let' form. +of the second `let' form. The variables bound and their default values are described by the `mail-source-keyword-map' variable." - `(let ,(mail-source-bind-1 (car type-source)) + `(let* ,(mail-source-bind-1 (car type-source)) (mail-source-set-1 ,(cadr type-source)) ,@body)) (put 'mail-source-bind 'lisp-indent-function 1) (put 'mail-source-bind 'edebug-form-spec '(sexp body)) +;; TODO: use the list format for auth-source-user-or-password modes (defun mail-source-set-1 (source) (let* ((type (pop source)) (defaults (cdr (assq type mail-source-keyword-map))) - default value keyword) + default value keyword auth-info user-auth pass-auth) (while (setq default (pop defaults)) + ;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL + ;; using `mail-source-value' to evaluate the plist value (set (mail-source-strip-keyword (setq keyword (car default))) - (if (setq value (plist-get source keyword)) - (mail-source-value value) - (mail-source-value (cadr default))))))) + ;; note the following reasons for this structure: + ;; 1) the auth-sources user and password override everything + ;; 2) it avoids macros, so it's cleaner + ;; 3) it falls through to the mail-sources and then default values + (cond + ((and + (eq keyword :user) + (setq user-auth + (nth 0 (auth-source-user-or-password + '("login" "password") + ;; this is "host" in auth-sources + (if (boundp 'server) (symbol-value 'server) "") + type)))) + user-auth) + ((and + (eq keyword :password) + (setq pass-auth + (nth 1 + (auth-source-user-or-password + '("login" "password") + ;; this is "host" in auth-sources + (if (boundp 'server) (symbol-value 'server) "") + type)))) + pass-auth) + (t (if (setq value (plist-get source keyword)) + (mail-source-value value) + (mail-source-value (cadr default))))))))) (eval-and-compile (defun mail-source-bind-common-1 () @@ -500,8 +530,7 @@ See `mail-source-bind'." ((stringp value) value) ;; Function - ((and (listp value) - (functionp (car value))) + ((and (listp value) (symbolp (car value)) (fboundp (car value))) (eval value)) ;; Just return the value. (t @@ -555,7 +584,8 @@ If CONFIRM is non-nil, ask for confirmation before removing a file." currday files) (setq files (directory-files mail-source-directory t - (concat mail-source-incoming-file-prefix "*")) + (concat "\\`" + (regexp-quote mail-source-incoming-file-prefix))) currday (* (car (current-time)) high2days) currday (+ currday (* low2days (nth 1 (current-time))))) (while files @@ -994,20 +1024,19 @@ This only works when `display-time' is enabled." (mail-source-delete-crash-box))))) found))) -(eval-and-compile - (autoload 'imap-open "imap") - (autoload 'imap-authenticate "imap") - (autoload 'imap-mailbox-select "imap") - (autoload 'imap-mailbox-unselect "imap") - (autoload 'imap-mailbox-close "imap") - (autoload 'imap-search "imap") - (autoload 'imap-fetch "imap") - (autoload 'imap-close "imap") - (autoload 'imap-error-text "imap") - (autoload 'imap-message-flags-add "imap") - (autoload 'imap-list-to-message-set "imap") - (autoload 'imap-range-to-message-set "imap") - (autoload 'nnheader-ms-strip-cr "nnheader")) +(autoload 'imap-open "imap") +(autoload 'imap-authenticate "imap") +(autoload 'imap-mailbox-select "imap") +(autoload 'imap-mailbox-unselect "imap") +(autoload 'imap-mailbox-close "imap") +(autoload 'imap-search "imap") +(autoload 'imap-fetch "imap") +(autoload 'imap-close "imap") +(autoload 'imap-error-text "imap") +(autoload 'imap-message-flags-add "imap") +(autoload 'imap-list-to-message-set "imap") +(autoload 'imap-range-to-message-set "imap") +(autoload 'nnheader-ms-strip-cr "nnheader") (autoload 'gnus-compress-sequence "gnus-range") @@ -1087,8 +1116,7 @@ This only works when `display-time' is enabled." ?s server ?P port ?u user)) found))) -(eval-and-compile - (autoload 'webmail-fetch "webmail")) +(autoload 'webmail-fetch "webmail") (defun mail-source-fetch-webmail (source callback) "Fetch for webmail source." @@ -1114,5 +1142,5 @@ This only works when `display-time' is enabled." (provide 'mail-source) -;;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd +;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd ;;; mail-source.el ends here