X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmail-source.el;h=6cc9e78f03481dec90aac327fd95bdbc4c43336c;hb=72d4e01800a11f08c04173e1868a8683070e0463;hp=618d02ec3ef67b873cba94de00f1879445848c5d;hpb=104a4dfd02fa25e48924ef8ea1365279f636c6d6;p=elisp%2Fgnus.git- diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 618d02e..6cc9e78 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -30,12 +30,13 @@ (require 'imap) (eval-when-compile (defvar display-time-mail-function))) (eval-and-compile + (defvar pop3-leave-mail-on-server) (autoload 'pop3-movemail "pop3") (autoload 'pop3-get-message-count "pop3") (autoload 'nnheader-cancel-timer "nnheader") (autoload 'nnheader-run-at-time "nnheader")) (require 'format-spec) -(require 'mm-util) +(require 'message) ;; for `message-directory' (defgroup mail-source nil "The mail-fetching library." @@ -47,12 +48,12 @@ (eval-when-compile (mapcar (lambda (a) (list 'const (car a))) - imap-authenticator-alist))) + imap-authenticator-alist))) (defconst mail-source-imap-streams (eval-when-compile (mapcar (lambda (a) (list 'const (car a))) - imap-stream-alist))) + imap-stream-alist))) (defcustom mail-sources nil "*Where the mail backends will look for incoming mail. @@ -192,17 +193,17 @@ See Info node `(gnus)Mail Source Specifiers'." (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))) + (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")) @@ -223,12 +224,17 @@ If non-nil, this maildrop will be checked periodically for new mail." :group 'mail-source :type 'sexp) +(defcustom mail-source-flash t + "*If non-nil, flash periodically when mail is available." + :group 'mail-source + :type 'boolean) + (defcustom mail-source-crash-box "~/.emacs-mail-crash-box" "File where mail will be stored while processing it." :group 'mail-source :type 'file) -(defcustom mail-source-directory "~/Mail/" +(defcustom mail-source-directory message-directory "Directory where files (if any) will be stored." :group 'mail-source :type 'directory) @@ -258,6 +264,11 @@ If non-nil, this maildrop will be checked periodically for new mail." :group 'mail-source :type 'number) +(defcustom mail-source-movemail-program nil + "If non-nil, name of program for fetching new mail." + :group 'mail-source + :type '(choice (const nil) string)) + ;;; Internal variables. (defvar mail-source-string "" @@ -293,7 +304,9 @@ Common keywords should be listed here.") (:program) (:function) (:password) - (:authentication password)) + (:connection) + (:authentication password) + (:leave)) (maildir (:path (or (getenv "MAILDIR") "~/Maildir/")) (:subdirs ("new" "cur")) @@ -444,13 +457,15 @@ Return the number of files that were found." (setq found (mail-source-callback callback mail-source-crash-box))) (+ found - (condition-case err + (if (or debug-on-quit debug-on-error) (funcall function source callback) - (error - (unless (yes-or-no-p - (format "Mail source error (%s). Continue? " err)) - (error "Cannot get new mail.")) - 0)))))))) + (condition-case err + (funcall function source callback) + (error + (unless (yes-or-no-p + (format "Mail source error (%s). Continue? " err)) + (error "Cannot get new mail")) + 0))))))))) (defun mail-source-make-complex-temp-name (prefix) (let ((newname (make-temp-name prefix)) @@ -517,11 +532,13 @@ Pass INFO on to CALLBACK." 'call-process (append (list - (expand-file-name "movemail" exec-directory) + (or mail-source-movemail-program + (expand-file-name "movemail" exec-directory)) nil errors nil from to))))) (when (file-exists-p to) (set-file-modes to mail-source-default-file-modes)) - (if (and (not (buffer-modified-p errors)) + (if (and (or (not (buffer-modified-p errors)) + (zerop (buffer-size errors))) (zerop result)) ;; No output => movemail won. t @@ -575,7 +592,7 @@ If ARGS, PROMPT is used as an argument to `format'." (defun mail-source-fetch-with-program (program) (zerop (call-process shell-file-name nil nil nil - shell-command-switch program))) + shell-command-switch program))) (defun mail-source-run-script (script spec &optional delay) (when script @@ -661,16 +678,23 @@ If ARGS, PROMPT is used as an argument to `format'." (pop3-mailhost server) (pop3-port port) (pop3-authentication-scheme - (if (eq authentication 'apop) 'apop 'pass))) - (condition-case err + (if (eq authentication 'apop) 'apop 'pass)) + (pop3-connection-type connection) + (pop3-leave-mail-on-server + (or leave + (and (boundp 'pop3-leave-mail-on-server) + pop3-leave-mail-on-server)))) + (if (or debug-on-quit debug-on-error) (save-excursion (pop3-movemail mail-source-crash-box)) - (error - ;; We nix out the password in case the error - ;; was because of a wrong password being given. - (setq mail-source-password-cache - (delq (assoc from mail-source-password-cache) - mail-source-password-cache)) - (signal (car err) (cdr err)))))))) + (condition-case err + (save-excursion (pop3-movemail mail-source-crash-box)) + (error + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq mail-source-password-cache + (delq (assoc from mail-source-password-cache) + mail-source-password-cache)) + (signal (car err) (cdr err))))))))) (if result (progn (when (eq authentication 'password) @@ -721,15 +745,17 @@ If ARGS, PROMPT is used as an argument to `format'." (pop3-port port) (pop3-authentication-scheme (if (eq authentication 'apop) 'apop 'pass))) - (condition-case err + (if (or debug-on-quit debug-on-error) (save-excursion (pop3-get-message-count)) - (error - ;; We nix out the password in case the error - ;; was because of a wrong password being given. - (setq mail-source-password-cache - (delq (assoc from mail-source-password-cache) - mail-source-password-cache)) - (signal (car err) (cdr err)))))))) + (condition-case err + (save-excursion (pop3-get-message-count)) + (error + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq mail-source-password-cache + (delq (assoc from mail-source-password-cache) + mail-source-password-cache)) + (signal (car err) (cdr err))))))))) (if result ;; Inform display-time that we have new mail. (setq mail-source-new-mail-available (> result 0)) @@ -742,6 +768,10 @@ If ARGS, PROMPT is used as an argument to `format'." (defun mail-source-new-mail-p () "Handler for `display-time' to indicate when new mail is available." + ;; Flash (ie. ring the visible bell) if mail is available. + (if (and mail-source-flash mail-source-new-mail-available) + (let ((visible-bell t)) + (ding))) ;; Only report flag setting; flag is updated on a different schedule. mail-source-new-mail-available) @@ -764,8 +794,9 @@ If ARGS, PROMPT is used as an argument to `format'." mail-source-idle-time-delay nil (lambda () - (mail-source-check-pop mail-source-primary-source) - (setq mail-source-report-new-mail-idle-timer nil)))) + (unwind-protect + (mail-source-check-pop mail-source-primary-source) + (setq mail-source-report-new-mail-idle-timer nil))))) ;; Since idle timers created when Emacs is already in the idle ;; state don't get activated until Emacs _next_ becomes idle, we ;; need to force our timer to be considered active now. We do @@ -778,7 +809,7 @@ If ARGS, PROMPT is used as an argument to `format'." This only works when `display-time' is enabled." (interactive "P") (if (not mail-source-primary-source) - (error "Need to set `mail-source-primary-source' to check for new mail.")) + (error "Need to set `mail-source-primary-source' to check for new mail")) (let ((on (if (null arg) (not mail-source-report-new-mail) (> (prefix-numeric-value arg) 0)))) @@ -824,19 +855,23 @@ This only works when `display-time' is enabled." (not (if function (funcall function file mail-source-crash-box) (let ((coding-system-for-write - mm-text-coding-system) + nnheader-text-coding-system) (coding-system-for-read - mm-text-coding-system)) + 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) (goto-char (point-min)) -;;; ;; Unix mail format -;;; (unless (looking-at "\n*From ") -;;; (insert "From maildir " -;;; (current-time-string) "\n")) -;;; (while (re-search-forward "^From " nil t) -;;; (replace-match ">From ")) -;;; (goto-char (point-max)) +;;; ;; Unix mail format +;;; (unless (looking-at "\n*From ") +;;; (insert "From maildir " +;;; (current-time-string) "\n")) +;;; (while (re-search-forward "^From " nil t) +;;; (replace-match ">From ")) +;;; (goto-char (point-max)) ;;; (insert "\n\n") ;; MMDF mail format (insert "\001\001\001\001\n")) @@ -856,8 +891,7 @@ This only works when `display-time' is enabled." (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-range-to-message-set "imap")) (defvar mail-source-imap-file-coding-system 'binary "Coding system for the crashbox made by `mail-source-fetch-imap'.") @@ -867,7 +901,8 @@ This only works when `display-time' is enabled." (mail-source-bind (imap source) (let ((from (format "%s:%s:%s" server user port)) (found 0) - (buf (get-buffer-create (generate-new-buffer-name " *imap source*"))) + (buf (get-buffer-create + (format " *imap source %s:%s:%s *" server user mailbox))) (mail-source-string (format "imap:%s:%s" server mailbox)) (imap-shell-program (or (list program) imap-shell-program)) remove) @@ -877,11 +912,12 @@ This only works when `display-time' is enabled." 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 ;; multibyte. - (mm-disable-multibyte) + (set-buffer-multibyte nil) ;; remember password (with-current-buffer buf (when (or imap-password @@ -889,7 +925,11 @@ This only works when `display-time' is enabled." (push (cons from imap-password) mail-source-password-cache))) ;; if predicate is nil, use all uids (dolist (uid (imap-search (or predicate "1:*") buf)) - (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)) + (when (setq str + (if (imap-capability 'IMAP4rev1 buf) + (caddar (imap-fetch uid "BODY.PEEK[]" + 'BODYDETAIL nil buf)) + (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))) (push uid remove) (insert "From imap " (current-time-string) "\n") (save-excursion @@ -905,7 +945,7 @@ This only works when `display-time' is enabled." fetchflag nil buf)) (if dontexpunge (imap-mailbox-unselect buf) - (imap-mailbox-close buf)) + (imap-mailbox-close nil buf)) (imap-close buf)) (imap-close buf) ;; We nix out the password in case the error