message.el: Sending message/partial.

mm-bodies.el: Remove blank lines.
mm-partial.el: Remove tail blank lines.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0dc16dc..fe0df8e 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2000-04-27 15:27:54  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * message.el (message-send-mail-partially-limit): New variable.
+       (message-send-mail-partially): New function.
+       (message-send-mail): Use it.
+       * mm-bodies.el (mm-decode-content-transfer-encoding): Remove 
+       all blank lines inside of base64.
+       * mm-partial.el (mm-inline-partial): Add an option. Remove tail
+       blank lines.
+
 2000-04-27 10:03:36  Shenghuo ZHU  <zsh@cs.rochester.edu>
 
        * mml.el (mml-insert-tag): Match more special characters.

diff --git a/lisp/message.el b/lisp/message.el
index 4414e43..c7dd828 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -889,6 +889,14 @@ The cdr of ech entry is a function for applying the face to a region.")
   mm-auto-save-coding-system
   "Coding system to compose mail.")
 
+(defcustom message-send-mail-partially-limit nil
+  "The limitation of messages sent as message/partial.
+The lower bound of message size in characters, beyond which the message 
+should be sent in several parts. *Nil means unlimited."
+  :group 'message-buffers
+  :type '(choice (const :tag "unlimited" nil)
+                (integer 50000)))
+
 ;;; Internal variables.
 
 (defvar message-buffer-list nil)
@@ -2146,6 +2154,70 @@ It should typically alter the sending method in some way or other."
        (eval (car actions)))))
     (pop actions)))
 
+(defun message-send-mail-partially ()
+  "Sendmail as message/partial."
+  (let ((p (goto-char (point-min)))
+       (tembuf (message-generate-new-buffer-clone-locals " message temp"))
+       (curbuf (current-buffer))
+       (id (message-make-message-id)) (n 1)
+       plist total  header required-mail-headers)
+    (while (not (eobp))
+      (if (< (point-max) (+ p message-send-mail-partially-limit))
+         (goto-char (point-max))
+       (goto-char (+ p message-send-mail-partially-limit))
+       (beginning-of-line)
+       (if (<= (point) p) (end-of-line))) ;; In case of bad message.
+      (push p plist)
+      (setq p (point)))
+    (setq total (length plist))
+    (push (point-max) plist)
+    (setq plist (nreverse plist))
+    (unwind-protect
+       (save-excursion
+         (setq p (pop plist))
+         (while plist
+           (set-buffer curbuf)
+           (copy-to-buffer tembuf p (car plist))
+           (set-buffer tembuf)
+           (goto-char (point-min))
+           (if header
+               (progn
+                 (goto-char (point-min))
+                 (narrow-to-region (point) (point))
+                 (insert header))
+             (message-goto-eoh)
+             (setq header (buffer-substring (point-min) (point)))
+             (goto-char (point-min))
+             (narrow-to-region (point) (point))
+             (insert header)
+             (message-remove-header "Mime-Version")
+             (message-remove-header "Content-Type")
+             (message-remove-header "Message-ID")
+             (message-remove-header "Lines")
+             (goto-char (point-max))
+             (insert "Mime-Version: 1.0\n")
+             (setq header (buffer-substring (point-min) (point-max))))
+           (goto-char (point-max))
+           (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n"
+                           id n total))
+           (let ((mail-header-separator ""))
+             (when (memq 'Message-ID message-required-mail-headers)
+               (insert "Message-ID: " (message-make-message-id) "\n"))
+             (when (memq 'Lines message-required-mail-headers)
+               (let ((mail-header-separator ""))
+                 (insert "Lines: " (message-make-lines) "\n")))
+             (message-goto-subject)
+             (end-of-line)
+             (insert (format " (%d/%d)" n total))
+             (goto-char (point-max))
+             (insert "\n")
+             (widen)
+             (funcall message-send-mail-function))
+           (setq n (+ n 1))
+           (setq p (pop plist))
+           (erase-buffer)))
+      (kill-buffer tembuf))))
+
 (defun message-send-mail (&optional arg)
   (require 'mail-utils)
   (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
@@ -2192,7 +2264,11 @@ It should typically alter the sending method in some way or other."
                     (or (message-fetch-field "cc")
                         (message-fetch-field "to")))
            (message-insert-courtesy-copy))
-         (funcall message-send-mail-function))
+         (if (or (not message-send-mail-partially-limit)
+                 (< (point-max) message-send-mail-partially-limit)
+                 (not (y-or-n-p "The message size is too large, should it be sent partially?")))
+             (funcall message-send-mail-function)
+           (message-send-mail-partially)))
       (kill-buffer tembuf))
     (set-buffer mailbuf)
     (push 'mail message-sent-message-via)))

diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el
index 74870e2..8c42436 100644 (file)
--- a/lisp/mm-bodies.el
+++ b/lisp/mm-bodies.el
@@ -168,12 +168,9 @@ If no encoding was done, nil is returned."
             ;; have been added by mailing list software.
             (save-excursion
               (goto-char (point-min))
-              (if (re-search-forward "^[\t ]*$" nil t)
-                  (delete-region (point) (point-max))
-                (goto-char (point-max)))
-              (skip-chars-backward "\n\t ")
-              (delete-region (point) (point-max))
-              (point))))
+              (while (re-search-forward "^[\t ]*\r?\n" nil t)
+                (delete-region (match-beginning 0) (match-end 0)))
+              (point-max))))
           ((memq encoding '(7bit 8bit binary))
            ;; Do nothing.
            )

diff --git a/lisp/mm-partial.el b/lisp/mm-partial.el
index 8f32aa9..4d60a85 100644 (file)
--- a/lisp/mm-partial.el
+++ b/lisp/mm-partial.el
@@ -55,7 +55,11 @@
     phandles))
 
 ;;;###autoload
-(defun mm-inline-partial (handle)
+(defun mm-inline-partial (handle &optional no-display)
+  "Show the partial part of HANDLE.
+This function replaces the buffer of HANDLE with a buffer contains 
+the entire message.
+If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
   (let ((id (cdr (assq 'id (cdr (mm-handle-type handle))))) 
        phandles
        (b (point)) (n 1) total
@@ -103,6 +107,11 @@
              (error "Missing part %d" n))
            (mm-insert-part phandle)
            (goto-char (point-max))
+           (when (not (eq 0 (skip-chars-backward "\r\n")))
+             ;; remove tail blank spaces except one
+             (if (looking-at "\r?\n")
+                 (goto-char (match-end 0)))
+             (delete-region (point) (point-max)))
            (setq n (+ n 1))))
        (unless total
          (error "Don't known the total number of"))
@@ -111,33 +120,34 @@
        (kill-buffer (mm-handle-buffer handle))
        (setcar handle (current-buffer))
        (mm-handle-set-cache handle t)))
-    (save-excursion
-      (save-restriction
-       (narrow-to-region b b)
-       (mm-insert-part handle)
-       (let (gnus-article-mime-handles)
-         (run-hooks 'gnus-article-decode-hook)
-         (gnus-article-prepare-display)
-         (setq handles gnus-article-mime-handles))
-       (when handles
-         ;; It is in article buffer.
-         (setq gnus-article-mime-handles
-               (nconc (if (listp (car gnus-article-mime-handles))
+    (unless no-display
+      (save-excursion
+       (save-restriction
+         (narrow-to-region b b)
+         (mm-insert-part handle)
+         (let (gnus-article-mime-handles)
+           (run-hooks 'gnus-article-decode-hook)
+           (gnus-article-prepare-display)
+           (setq handles gnus-article-mime-handles))
+         (when handles
+           ;; It is in article buffer.
+           (setq gnus-article-mime-handles
+                 (nconc (if (listp (car gnus-article-mime-handles))
                           gnus-article-mime-handles
-                        (list gnus-article-mime-handles))
-                      (if (listp (car handles)) 
-                          handles (list handles)))))
-       (mm-handle-set-undisplayer
-        handle
-        `(lambda ()
-           (let (buffer-read-only)
-             (condition-case nil
-                 ;; This is only valid on XEmacs.
-                 (mapcar (lambda (prop)
+                          (list gnus-article-mime-handles))
+                        (if (listp (car handles)) 
+                            handles (list handles)))))
+         (mm-handle-set-undisplayer
+          handle
+          `(lambda ()
+             (let (buffer-read-only)
+               (condition-case nil
+                   ;; This is only valid on XEmacs.
+                   (mapcar (lambda (prop)
                            (remove-specifier
                             (face-property 'default prop) (current-buffer)))
-                         '(background background-pixmap foreground))
-               (error nil))
-             (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
+                           '(background background-pixmap foreground))
+                 (error nil))
+               (delete-region ,(point-min-marker) ,(point-max-marker))))))))))
 
 ;; mm-partial.el ends here