(mail-source-call-script): Message the error

[gnus] / lisp / mail-source.el

diff --git a/lisp/mail-source.el b/lisp/mail-source.el
index e0607b1..911caef 100644 (file)
--- a/lisp/mail-source.el
+++ b/lisp/mail-source.el
@@ -1,6 +1,7 @@
 ;;; mail-source.el --- functions for fetching mail
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news, mail
@@ -19,8 +20,8 @@
 
 ;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -107,7 +108,7 @@ See Info node `(gnus)Mail Source Specifiers'."
                                          (const :format "" :value :port)
                                          (choice :tag "Port"
                                                  :value "pop3"
-                                                 (number :format "%v")
+                                                 (integer :format "%v")
                                                  (string :format "%v")))
                                   (group :inline t
                                          (const :format "" :value :user)
@@ -123,13 +124,15 @@ See Info node `(gnus)Mail Source Specifiers'."
                                          (choice :tag "Prescript"
                                                  :value nil
                                                  (string :format "%v")
-                                                 (function :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")))
+                                                 (function :format "%v")
+                                                 (const :tag "None" nil)))
                                   (group :inline t
                                          (const :format "" :value :function)
                                          (function :tag "Function"))
@@ -142,7 +145,14 @@ See Info node `(gnus)Mail Source Specifiers'."
                                                  (const apop)))
                                   (group :inline t
                                          (const :format "" :value :plugged)
-                                         (boolean :tag "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
@@ -162,7 +172,7 @@ See Info node `(gnus)Mail Source Specifiers'."
                                          (const :format "" :value :port)
                                          (choice :tag "Port"
                                                  :value 143
-                                                 number string))
+                                                 integer string))
                                   (group :inline t
                                          (const :format "" :value :user)
                                          (string :tag "User"))
@@ -234,7 +244,10 @@ See Info node `(gnus)Mail Source Specifiers'."
 (defcustom mail-source-ignore-errors nil
   "*Ignore errors when querying mail sources.
 If nil, the user will be prompted when an error occurs.  If non-nil,
-the error will be ignored.")
+the error will be ignored."
+  :version "22.1"
+  :group 'mail-source
+  :type 'boolean)
 
 (defcustom mail-source-primary-source nil
   "*Primary source for incoming mail.
@@ -253,7 +266,7 @@ If non-nil, this maildrop will be checked periodically for new mail."
   :type 'file)
 
 (defcustom mail-source-directory message-directory
-  "Directory where files (if any) will be stored."
+  "Directory where incoming mail source files (if any) will be stored."
   :group 'mail-source
   :type 'directory)
 
@@ -280,6 +293,7 @@ files older than number of days."
   "*If non-nil, ask for for confirmation before deleting old incoming files.
 This variable only applies when `mail-source-delete-incoming' is a positive
 number."
+  :version "22.1"
   :group 'mail-source
   :type 'boolean)
 
@@ -300,6 +314,7 @@ number."
 
 (defcustom mail-source-movemail-program nil
   "If non-nil, name of program for fetching new mail."
+  :version "22.1"
   :group 'mail-source
   :type '(choice (const nil) string))
 
@@ -341,7 +356,8 @@ Common keywords should be listed here.")
        (:program)
        (:function)
        (:password)
-       (:authentication password))
+       (:authentication password)
+       (:stream nil))
       (maildir
        (:path (or (getenv "MAILDIR") "~/Maildir/"))
        (:subdirs ("cur" "new"))
@@ -507,7 +523,7 @@ Return the number of files that were found."
                               (format "Mail source %s error (%s).  Continue? "
                                       (if (memq ':password source)
                                           (let ((s (copy-sequence source)))
-                                            (setcar (cdr (memq ':password s)) 
+                                            (setcar (cdr (memq ':password s))
                                                     "********")
                                             s)
                                         source)
@@ -662,12 +678,20 @@ If CONFIRM is non-nil, ask for confirmation before removing a file."
     (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
@@ -708,6 +732,7 @@ If CONFIRM is non-nil, ask for confirmation before removing a file."
 (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
@@ -736,12 +761,14 @@ If CONFIRM is non-nil, ask for confirmation before removing a file."
              (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
@@ -798,6 +825,7 @@ If CONFIRM is non-nil, ask for confirmation before removing a file."
             (function)
             ;; The default is to use pop3.el.
             (t
+             (require 'pop3)
              (let ((pop3-password password)
                    (pop3-maildrop user)
                    (pop3-mailhost server)
@@ -860,7 +888,7 @@ See the Gnus manual for details."
 
 (eval-when-compile
   (if (featurep 'xemacs)
-      (require 'itimer)
+      (require 'timer-funcs)
     (require 'timer)))
 
 (defun mail-source-start-idle-timer ()
@@ -1012,7 +1040,8 @@ This only works when `display-time' is enabled."
                  (insert "From imap " (current-time-string) "\n")
                  (save-excursion
                    (insert str "\n\n"))
-                 (while (re-search-forward "^From " nil t)
+                 (while (let ((case-fold-search nil))
+                          (re-search-forward "^From " nil t))
                    (replace-match ">From "))
                  (goto-char (point-max))))
              (nnheader-ms-strip-cr))
@@ -1068,4 +1097,5 @@ This only works when `display-time' is enabled."
 
 (provide 'mail-source)
 
+;;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd
 ;;; mail-source.el ends here