(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.

diff --git a/ChangeLog b/ChangeLog
index 4448826..310e3da 100644 (file)
--- 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 (file)
--- 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