From: yamaoka Date: Wed, 11 Aug 2004 03:15:30 +0000 (+0000) Subject: (smtp-progress-message-format): New user option. X-Git-Tag: flim-1_14_7~7 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=342307de334c6fe1e6b0e74861d4220e04366634;p=elisp%2Fflim.git (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 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2004-08-11 Katsumi Yamaoka + + * 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 * 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 ;; Simon Leinen (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