* 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
 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'.
 
 ;; 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:
 ;;       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.
 ;; 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:
 
 
 ;;; Code:
 


@@ -62,6 +63,27 @@
            'point-at-eol
          'line-end-position)))
 
            '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))
 (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 " "))))
              (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 "-- "))
          (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
            (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))))))))
              (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 '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
   (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))))
 
     (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."
 (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))))
            (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
       (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))))
            (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 "-=-=")
 
 (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)))
       (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")))
          (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))))))
                    (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)))
                  (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
                (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))))
                (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)))))
            (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))
 
            "")
          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
   (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
              (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 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))
       (when parameters
        (mml-insert-parameter-string
         cont mml-content-type-parameters))