* mml.el (autoload): Autoload fill-flowed-encode.

	(mml-buffer-substring-no-properties-except-hard-newlines): New
	function.
	(mml-read-part): Use it.
	(mml-generate-mime-1): Encode format=flowed if appropriate.
	(mml-insert-mime-headers): Insert format=flowed.

	* flow-fill.el (fill-flowed-encode): New function.
	(fill-flowed): Bind fill-column to window width.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7e65548..fd9562d 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2002-01-12  Simon Josefsson  <jas@extundo.com>
+
+       * mml.el (autoload): Autoload fill-flowed-encode.
+       (mml-buffer-substring-no-properties-except-hard-newlines): New
+       function.
+       (mml-read-part): Use it.
+       (mml-generate-mime-1): Encode format=flowed if appropriate.
+       (mml-insert-mime-headers): Insert format=flowed.
+
+       * flow-fill.el (fill-flowed-encode): New function.
+       (fill-flowed): Bind fill-column to window width.
+
 2002-01-12  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * gnus-sum.el (gnus-summary-buffer-name): Return the dead name if

diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el
index de3dd4b..e627c49 100644 (file)
--- a/lisp/flow-fill.el
+++ b/lisp/flow-fill.el
@@ -35,7 +35,7 @@
 ;; paragraph and we let `fill-region' fill the long line into several
 ;; lines with the quote prefix as `fill-prefix'.
 
-;; Todo: encoding, implement basic `fill-region' (Emacs and XEmacs
+;; Todo: implement basic `fill-region' (Emacs and XEmacs
 ;;       implementations differ..)
 
 ;;; History:
@@ -46,6 +46,7 @@
 ;; 2000-03-26  commited to gnus cvs
 ;; 2000-10-23  don't flow "-- " lines, make "quote-depth wins" rule
 ;;             work when first line is at level 0.
+;; 2002-01-12  probably incomplete encoding support
 
 ;;; Code:
 
@@ -62,6 +63,27 @@
            'point-at-eol
          'line-end-position)))
 
+(defun fill-flowed-encode (&optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    ;; No point in doing this unless hard newlines is used.
+    (when use-hard-newlines
+      (let ((start (point-min)) end)
+       ;; Go through each paragraph, filling it and adding SPC
+       ;; as the last character on each line.
+       (while (setq end (text-property-any start (point-max) 'hard 't))
+         (let ((fill-column 66))
+           (fill-region start end t 'nosqueeze 'to-eop))
+         (goto-char start)
+         ;; `fill-region' probably distorted end.
+         (setq end (text-property-any start (point-max) 'hard 't))
+         (while (and (< (point) end)
+                     (re-search-forward "$" (1- end) t))
+           (insert " ")
+           (setq end (1+ end))
+           (forward-char))
+         (goto-char (setq start (1+ end)))))
+      t)))
+
 (defun fill-flowed (&optional buffer)
   (save-excursion
     (set-buffer (or (current-buffer) buffer))
@@ -79,6 +101,7 @@
              (beginning-of-line)
              (when (> (skip-chars-forward ">") 0)
                (insert " "))))
+         ;; XXX slightly buggy handling of "-- "
          (while (and (save-excursion
                        (ignore-errors (backward-char 3))
                        (setq sig (looking-at "-- "))
@@ -93,7 +116,8 @@
            (backward-delete-char -1)
            (end-of-line))
          (unless sig
-           (let ((fill-prefix (when quote (concat quote " "))))
+           (let ((fill-prefix (when quote (concat quote " ")))
+                 (fill-column (1- (window-width))))
              (fill-region (fill-flowed-point-at-bol)
                           (min (1+ (fill-flowed-point-at-eol)) (point-max))
                           'left 'nosqueeze))))))))

diff --git a/lisp/mml.el b/lisp/mml.el
index 4813ab6..eb43ea2 100644 (file)
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -35,6 +35,7 @@
   (autoload 'gnus-setup-posting-charset "gnus-msg")
   (autoload 'gnus-add-minor-mode "gnus-ems")
   (autoload 'message-fetch-field "message")
+  (autoload 'fill-flowed-encode "flow-fill")
   (autoload 'message-posting-charset "message"))
 
 (defcustom mml-content-type-parameters
@@ -286,6 +287,15 @@ A message part needs to be split into %d charset parts.  Really send? "
     (setq contents (append (list (cons 'tag-location orig-point)) contents))
     (cons (intern name) (nreverse contents))))
 
+(defun mml-buffer-substring-no-properties-except-hard-newlines (start end)
+  (let ((str (buffer-substring-no-properties start end))
+       (bufstart start) tmp)
+    (while (setq tmp (text-property-any start end 'hard 't))
+      (set-text-properties (- tmp bufstart) (- tmp bufstart -1)
+                          '(hard t) str)
+      (setq start (1+ tmp)))
+    str))
+
 (defun mml-read-part (&optional mml)
   "Return the buffer up till the next part, multipart or closing part or multipart.
 If MML is non-nil, return the buffer up till the correspondent mml tag."
@@ -299,19 +309,22 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
            (if (re-search-forward "<#\\(/\\)?mml." nil t)
                (setq count (+ count (if (match-beginning 1) -1 1)))
              (goto-char (point-max))))
-         (buffer-substring-no-properties beg (if (> count 0)
-                                                 (point)
-                                               (match-beginning 0))))
+         (mml-buffer-substring-no-properties-except-hard-newlines
+          beg (if (> count 0)
+                  (point)
+                (match-beginning 0))))
       (if (re-search-forward
           "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
          (prog1
-             (buffer-substring-no-properties beg (match-beginning 0))
+             (mml-buffer-substring-no-properties-except-hard-newlines
+              beg (match-beginning 0))
            (if (or (not (match-beginning 1))
                    (equal (match-string 2) "multipart"))
                (goto-char (match-beginning 0))
              (when (looking-at "[ \t]*\n")
                (forward-line 1))))
-       (buffer-substring-no-properties beg (goto-char (point-max)))))))
+       (mml-buffer-substring-no-properties-except-hard-newlines
+        beg (goto-char (point-max)))))))
 
 (defvar mml-boundary nil)
 (defvar mml-base-boundary "-=-=")
@@ -340,7 +353,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
       (cond
        ((or (eq (car cont) 'part) (eq (car cont) 'mml))
        (let ((raw (cdr (assq 'raw cont)))
-             coded encoding charset filename type)
+             coded encoding charset filename type flowed)
          (setq type (or (cdr (assq 'type cont)) "text/plain"))
          (if (and (not raw)
                   (member (car (split-string type "/")) '("text" "message")))
@@ -387,8 +400,24 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
                    (setq charset (mm-encode-body charset))
                    (setq encoding (mm-body-encoding
                                    charset (cdr (assq 'encoding cont))))))
+                 ;; Only perform format=flowed filling on text/plain
+                 ;; parts where there either isn't a format parameter
+                 ;; in the mml tag or it says "flowed" and there
+                 ;; actually are hard newlines in the text.
+                 (let (use-hard-newlines)
+                   (when (and (string= type "text/plain")
+                              (or (null (assq 'format cont))
+                                  (string= (assq 'format cont) "flowed"))
+                              (setq use-hard-newlines
+                                    (text-property-any
+                                     (point-min) (point-max) 'hard 't)))
+                     (fill-flowed-encode)
+                     ;; Indicate that `mml-insert-mime-headers' should
+                     ;; insert a "; format=flowed" string unless the
+                     ;; user has already specified it.
+                     (setq flowed (null (assq 'format cont)))))
                  (setq coded (buffer-string)))
-               (mml-insert-mime-headers cont type charset encoding)
+               (mml-insert-mime-headers cont type charset encoding flowed)
                (insert "\n")
                (insert coded))
            (mm-with-unibyte-buffer
@@ -403,7 +432,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
                (insert (cdr (assq 'contents cont)))))
              (setq encoding (mm-encode-buffer type)
                    coded (mm-string-as-multibyte (buffer-string))))
-           (mml-insert-mime-headers cont type charset encoding)
+           (mml-insert-mime-headers cont type charset encoding nil)
            (insert "\n")
            (mm-with-unibyte-current-buffer
              (insert coded)))))
@@ -523,13 +552,14 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
            "")
          mml-base-boundary))
 
-(defun mml-insert-mime-headers (cont type charset encoding)
+(defun mml-insert-mime-headers (cont type charset encoding flowed)
   (let (parameters disposition description)
     (setq parameters
          (mml-parameter-string
           cont mml-content-type-parameters))
     (when (or charset
              parameters
+             flowed
              (not (equal type mml-generate-default-type)))
       (when (consp charset)
        (error
@@ -538,6 +568,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
       (when charset
        (insert "; " (mail-header-encode-parameter
                      "charset" (symbol-name charset))))
+      (when flowed
+       (insert "; format=flowed"))
       (when parameters
        (mml-insert-parameter-string
         cont mml-content-type-parameters))