* message.el (message-send-mail-partially-limit): Change the default value.

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index f64f53c..db38623 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,5 +1,6 @@
 ;;; message.el --- composing mail and news messages
 ;;; message.el --- composing mail and news messages

-;; Copyright (C) 1996-2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news


@@ -298,6 +299,11 @@ The provided functions are:
   :group 'message-forwarding
   :type 'boolean)
 
   :group 'message-forwarding
   :type 'boolean)
 

+(defcustom message-forward-show-mml t
+  "*If non-nil, forward messages are shown as mml.  Otherwise, forward messages are unchanged."
+  :group 'message-forwarding
+  :type 'boolean)
+

 (defcustom message-forward-before-signature t
   "*If non-nil, put forwarded message before signature, else after."
   :group 'message-forwarding
 (defcustom message-forward-before-signature t
   "*If non-nil, put forwarded message before signature, else after."
   :group 'message-forwarding


@@ -843,7 +849,7 @@ Defaults to `text-mode-abbrev-table'.")
                "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
                "[:>|}].*")
        (0 'message-cited-text-face))
                "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
                "[:>|}].*")
        (0 'message-cited-text-face))

-      ("<#/?\\(multipart\\|part\\|external\\).*>"
+      ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"

        (0 'message-mml-face))))
   "Additional expressions to highlight in Message mode.")
 
        (0 'message-mml-face))))
   "Additional expressions to highlight in Message mode.")
 


@@ -888,6 +894,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.")
 
   mm-auto-save-coding-system
   "Coding system to compose mail.")
 

+(defcustom message-send-mail-partially-limit 1000000
+  "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. If it is nil, the size is unlimited."
+  :group 'message-buffers
+  :type '(choice (const :tag "unlimited" nil)
+                (integer 1000000)))
+

 ;;; Internal variables.
 
 (defvar message-buffer-list nil)
 ;;; Internal variables.
 
 (defvar message-buffer-list nil)


@@ -2145,6 +2159,70 @@ It should typically alter the sending method in some way or other."
        (eval (car actions)))))
     (pop actions)))
 
        (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"))
 (defun message-send-mail (&optional arg)
   (require 'mail-utils)
   (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))


@@ -2191,7 +2269,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))
                     (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)))
       (kill-buffer tembuf))
     (set-buffer mailbuf)
     (push 'mail message-sent-message-via)))


@@ -3920,9 +4002,12 @@ the message."
   "Forward the current message via mail.
 Optional NEWS will use news to forward instead of mail."
   (interactive "P")
   "Forward the current message via mail.
 Optional NEWS will use news to forward instead of mail."
   (interactive "P")

-  (let ((cur (current-buffer))
-       (subject (message-make-forward-subject))
-       art-beg)
+  (let* ((cur (current-buffer))
+        (subject (if message-forward-show-mml
+                     (message-make-forward-subject)
+                   (mail-decode-encoded-word-string
+                    (message-make-forward-subject))))
+        art-beg)

     (if news
        (message-news nil subject)
       (message-mail nil subject))
     (if news
        (message-news nil subject)
       (message-mail nil subject))


@@ -3932,17 +4017,27 @@ Optional NEWS will use news to forward instead of mail."
         (message-goto-body)
       (goto-char (point-max)))
     (if message-forward-as-mime
         (message-goto-body)
       (goto-char (point-max)))
     (if message-forward-as-mime

-       (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
+       (if message-forward-show-mml
+           (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
+         (insert "\n\n<#part type=message/rfc822 disposition=inline"
+                 " buffer=\"" (buffer-name cur) "\">\n"))

       (insert "\n-------------------- Start of forwarded message --------------------\n"))
     (let ((b (point))
          e)
       (insert "\n-------------------- Start of forwarded message --------------------\n"))
     (let ((b (point))
          e)

-      (mml-insert-buffer cur)
+      (if message-forward-show-mml
+         (insert-buffer-substring cur)
+       (unless message-forward-as-mime
+         (mml-insert-buffer cur)))

       (setq e (point))
       (if message-forward-as-mime
       (setq e (point))
       (if message-forward-as-mime

-         (insert "<#/part>\n")
+         (if message-forward-show-mml
+             (insert "<#/mml>\n")
+           (insert "<#/part>\n"))

        (insert "\n-------------------- End of forwarded message --------------------\n"))
        (insert "\n-------------------- End of forwarded message --------------------\n"))

-      (when (and (not current-prefix-arg)
-                message-forward-ignored-headers)
+      (when (and (or message-forward-show-mml
+                    (not message-forward-as-mime))
+            (not current-prefix-arg)
+            message-forward-ignored-headers)

        (save-restriction
          (narrow-to-region b e)
          (goto-char b)
        (save-restriction
          (narrow-to-region b e)
          (goto-char b)