X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fflim.git;a=blobdiff_plain;f=smtp.el;h=3704d46c44009761a136bcc86a030227f7f007ac;hp=ff13f5a1cb635152d5e268e7a386d0bf52642f5a;hb=6ef1daccd72054e60d0ef6f87bb052982340f49c;hpb=7a08f28e9c937096afd0edf8311f220a2a1e74a2

diff --git a/smtp.el b/smtp.el
index ff13f5a..3704d46 100644
--- a/smtp.el
+++ b/smtp.el
@@ -1,6 +1,7 @@
 ;;; smtp.el --- basic functions to send mail with SMTP server
 
-;; Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001 ,2002, 2004
+;; Free Software Foundation, Inc.
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;;	Simon Leinen <simon@switch.ch> (ESMTP support)
@@ -22,8 +23,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; 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:
@@ -102,6 +103,14 @@ don't define this value."
   :type 'boolean
   :group 'smtp-extensions)
 
+(defcustom smtp-starttls-program "starttls"
+  "The program to run in a subprocess to open an TLSv1 connection."
+  :group 'smtp-extensions)
+
+(defcustom smtp-starttls-extra-args nil
+  "Extra arguments to `starttls-program'"
+  :group 'smtp-extensions)
+
 (defcustom smtp-use-sasl nil
   "If non-nil, use SMTP Authentication (RFC2554) if available."
   :type 'boolean
@@ -122,6 +131,23 @@ don't define this value."
   :type '(repeat string)
   :group 'smtp-extensions)
 
+(defcustom smtp-progress-message-format nil
+  "Format string used to show progress message while sending mails.
+It allows the following special format specifiers:
+
+%b means show the number of bytes which has been sent
+   and the total bytes of a mail.
+%k means show the number of kilobytes which has been sent
+   and the total kilobytes of a mail.
+%l means show the number of lines which has been sent
+   and the total lines of a mail.
+
+For instance, the value \"Sending (%k)...\" shows like
+\"Sending (45k/123k)...\" in the echo area."
+  :type '(radio (string :format "%v\n" :size 0 :value "Sending (%k)...")
+		(const :tag "Don't show progress message" nil))
+  :group 'smtp)
+
 (defvar sasl-mechanisms)
 
 ;;;###autoload
@@ -343,17 +369,19 @@ RECIPIENTS is a list of envelope recipient addresses.
 BUFFER may be a buffer or a buffer name which contains mail message."
   (if smtp-send-by-myself
       (smtp-send-buffer-by-myself sender recipients buffer)
-    (let ((server
-	   (if (functionp smtp-server)
-	       (funcall smtp-server sender recipients)
-	     (or smtp-server
-		 (error "`smtp-server' not defined"))))
-	  (package
-	   (smtp-make-package sender recipients buffer))
-	  (smtp-open-connection-function
-	   (if smtp-use-starttls
-	       #'starttls-open-stream
-	     smtp-open-connection-function)))
+    (let* ((server
+	    (if (functionp smtp-server)
+		(funcall smtp-server sender recipients)
+	      (or smtp-server
+		  (error "`smtp-server' not defined"))))
+	   (package
+	    (smtp-make-package sender recipients buffer))
+	   (starttls-program smtp-starttls-program)
+	   (starttls-extra-args smtp-starttls-extra-args)
+	   (smtp-open-connection-function
+	    (if smtp-use-starttls
+		#'starttls-open-stream
+	      smtp-open-connection-function)))
       (save-excursion
 	(set-buffer
 	 (get-buffer-create
@@ -573,18 +601,20 @@ BUFFER may be a buffer or a buffer name which contains mail message."
 (defun smtp-primitive-data (package)
   (let* ((connection
 	  (smtp-find-connection (current-buffer)))
-	 response)
+	 response def prev)
     (smtp-send-command connection "DATA")
     (setq response (smtp-read-response connection))
     (if (/= (car response) 354)
 	(smtp-response-error response))
     (save-excursion
       (set-buffer (smtp-package-buffer-internal package))
+      (setq def (smtp-parse-progress-message-format))
       (goto-char (point-min))
       (while (not (eobp))
 	(smtp-send-data
 	 connection (buffer-substring (point) (progn (end-of-line)(point))))
-	(beginning-of-line 2)))
+	(beginning-of-line 2)
+	(setq prev (smtp-show-progress-message def prev))))
     (smtp-send-command connection ".")
     (setq response (smtp-read-response connection))
     (if (/= (car response) 250)
@@ -708,9 +738,7 @@ BUFFER may be a buffer or a buffer name which contains mail message."
 			  (mail-strip-quoted-names
 			   (buffer-substring this-line this-line-end)))))
 	  (erase-buffer)
-	  (insert-string " ")
-	  (insert-string simple-address-list)
-	  (insert-string "\n")
+	  (insert " " simple-address-list "\n")
 	  ;; newline --> blank
 	  (subst-char-in-region (point-min) (point-max) 10 ?  t)
 	  ;; comma   --> blank
@@ -732,6 +760,74 @@ BUFFER may be a buffer or a buffer name which contains mail message."
 	    recipient-address-list))
       (kill-buffer smtp-address-buffer))))
 
+;;; @ functions used to show progress message
+;;;
+(defun smtp-parse-progress-message-format ()
+  "Parse the `smtp-progress-message-format' variable.
+Return nil, or a cons of an ordinary format string and a type including
+nil, the symbols `b', `k' and `l'."
+  (when smtp-progress-message-format
+    (let ((format smtp-progress-message-format)
+	  (index 0)
+	  type)
+      (while (string-match "%\\([bkl]\\)\\|%\\([^%bkl]\\|\\'\\)" format index)
+	(if (and (not type)
+		 (match-beginning 1))
+	    (setq index (match-end 0)
+		  type (intern (match-string 1 format))
+		  format (replace-match
+			  (cond ((eq type 'b)
+				 (concat "%d/"
+					 (number-to-string (buffer-size))))
+				((eq type 'k)
+				 (if (>= (buffer-size) 512)
+				     (concat "%dk/"
+					     (number-to-string
+					      (/ (+ (buffer-size) 512) 1024))
+					     "k")
+				   (setq type 'b)
+				   (concat "%d/"
+					   (number-to-string (buffer-size)))))
+				(t
+				 (concat "%d/"
+					 (number-to-string
+					  (count-lines (point-min)
+						       (point-max))))))
+			  nil nil format))
+	  (setq index (1+ (match-end 0))
+		format (replace-match "%\\&" nil nil format))))
+      (cons format type))))
+
+(defun smtp-show-progress-message (def prev)
+  "Show progress message while sending mails.
+DEF is a cons cell which is pre-computed by the
+`smtp-parse-progress-message-format' function or nil.
+PREV is a number shown last time or nil.
+Return a number computed this time."
+  (when (car def)
+    (let* ((fmt (car def))
+	   (type (cdr def))
+	   (value (cond ((eq type 'b)
+			 (- (point) (point-min)))
+			((eq type 'k)
+			 (/ (- (point) (point-min) -512) 1024))
+			((eq type 'l)
+			 (count-lines (point-min) (point)))))
+	   message-log-max)
+      (unless (and prev
+		   value
+		   (eq type 'k)
+		   (<= value prev))
+	(cond ((featurep 'xemacs)
+	       (display-message 'no-log (if value
+					    (format fmt value)
+					  fmt)))
+	      (value
+	       (message fmt value))
+	      (t
+	       (message "%s" fmt))))
+      value)))
+
 (provide 'smtp)
 
 ;;; smtp.el ends here