From: yamaoka <yamaoka>
Date: Wed, 11 Aug 2004 03:15:34 +0000 (+0000)
Subject: Synch to flim-1_14.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=2d2b39faec925d5f3b24af33b209b03b5b2b298e;p=elisp%2Fflim.git

Synch to flim-1_14.
---

diff --git a/ChangeLog b/ChangeLog
index 5699025..3761902 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2004-08-11  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* smtp.el (smtp-progress-message-format): New user option.
+	(smtp-primitive-data): Show progress message.
+	(smtp-parse-progress-message-format): New function.
+	(smtp-show-progress-message): New function.
+	(smtp-deduce-address-list): Use insert instead of insert-string.
+
 2004-07-27  Yoichi NAKAYAMA  <yoichi@geiin.org>
 
 	* mel-g.el (gzip64-external-encoder): Change default value to
diff --git a/smtp.el b/smtp.el
index 31e393d..6e86626 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)
@@ -130,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
@@ -583,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)
@@ -718,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
@@ -742,6 +760,77 @@ 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 (concat "%%"
+					      (or (match-string 1 format)
+						  (match-string 2 format)))
+				      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