bug#71017: [PATCH] Flow single-paragraph messages

[Sandra Snan]

See discussion in #71017.

In short:

if mml-flowed-enable is nil: no change to behavior

if mml-flowed-enable is t and use-hard-newlines is on: several bugs
fixed, some (multi-paragraph messages) of which were counter to
documentation and some (single-paragraph messages) that were
along documentation lines but which messed up messages royally.

if mml-flowed-enable is t but use-hard-newlines was accidentally
forgotten by user: new behavior; reflow but don't reflow together
separate paragraphs nor reflow across lines that markdown would've
considered hard.
---
 doc/misc/emacs-mime.texi |  7 +--
 lisp/gnus/mml.el         | 29 ++++++-------
 lisp/mail/flow-fill.el   | 93 ++++++++++++++++++++++++----------------
 3 files changed, 69 insertions(+), 60 deletions(-)

diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index ef7ea61..7621a9a 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -1087,13 +1087,10 @@ terminated by soft newline characters are filled 
together and wrapped
 after the column decided by @code{fill-flowed-encode-column}.
 Quotation marks (matching @samp{^>* ?}) are respected.  The variable
 controls how the text will look in a client that does not support
-flowed text, the default is to wrap after 66 characters.  If hard
-newline characters are not present in the buffer, no flow encoding
-occurs.
+flowed text, the default is to wrap after 66 characters.
 
 You can customize the value of the @code{mml-enable-flowed} variable
-to enable or disable the flowed encoding usage when newline
-characters are present in the buffer.
+to enable or disable the flowed encoding usage.
 
 On decoding flowed text, lines with soft newline characters are filled
 together and wrapped after the column decided by
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index e3bc393..2db39dc 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -691,23 +691,18 @@ type detected."
                   (t
                    ;; 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 mml-enable-flowed
-                                (string= type "text/plain")
-                                (not (string= (cdr (assq 'sign cont)) "pgp"))
-                                (or (null (assq 'format cont))
-                                    (string= (cdr (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)))))
+                   ;; in the mml tag or it says "flowed".
+                   (when (and mml-enable-flowed
+                              (string= type "text/plain")
+                              (not (string= (cdr (assq 'sign cont)) "pgp"))
+                              (or (null (assq 'format cont))
+                                  (string= (cdr (assq 'format cont))
+                                           "flowed")))
+                     (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))))
                    ;; Prefer `utf-8' for text/calendar parts.
                    (if (or charset
                            (not (string= type "text/calendar")))
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index 919490e..793088a 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -73,50 +73,67 @@ RFC 2646 suggests 66 characters for readability."
 ;;;###autoload
 (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))
-         (save-restriction
-           (narrow-to-region start end)
-           (let ((fill-column (eval fill-flowed-encode-column t)))
-             (fill-flowed-fill-buffer))
-           (goto-char (point-min))
-           (while (re-search-forward "\n" nil t)
-             (replace-match " \n" t t))
-           (goto-char (setq start (1+ (point-max)))))))
-      t)))
-
-(defun fill-flowed-fill-buffer ()
-  (let ((prefix nil)
-       (prev-prefix nil)
-       (start (point-min)))
-    (goto-char (point-min))
-    (while (not (eobp))
-      (setq prefix (and (looking-at "[> ]+")
-                       (match-string 0)))
-      (if (equal prefix prev-prefix)
-         (forward-line 1)
+    (let ((fill-column (eval fill-flowed-encode-column t))
+         (start (point-min))
+         (end (point-max)))
+      ;; Only when we've been called to reflow a buffer that doesn't
+      ;; have any hard newlines:
+      (unless (text-property-any start end 'hard 't)
+       (save-excursion
+         ;; Harden between paras:
+         (goto-char start)
+         (while (re-search-forward "\n[> ]*\n" end t)
+           (set-hard-newline-properties
+            (match-beginning 0) (point))
+           (backward-char))
+         ;; Harden before a quote starts:
+         (goto-char start)
+         (while (re-search-forward "\n[^>][^\n]*\n>" end t)
+           (backward-char)
+           (set-hard-newline-properties
+            (1- (point)) (point)))
+         ;; Harden "  $"
+         (goto-char start)
+         (while (search-forward "  \n" end t)
+           (backward-char)
+           (backward-delete-char 2)
+           (set-hard-newline-properties
+            (point) (1+ (point))))
+         ;; Harden "^    "
+         (goto-char start)
+         (while (search-forward "\n    " end t)
+           (set-hard-newline-properties
+            (- (point) 5) (- (point) 4)))))
+      ;; Go through each paragraph, filling it and adding SPC
+      ;; as the last character on each line.
+      (while (and (< start (point-max))
+                 (setq end (or (text-property-any start (point-max) 'hard 't)
+                               (point-max))))
        (save-restriction
-         (narrow-to-region start (point))
-         (let ((fill-prefix prev-prefix))
-           (fill-region (point-min) (point-max) t 'nosqueeze 'to-eop))
-         (goto-char (point-max)))
-       (setq prev-prefix prefix
-             start (point))))
-    (save-restriction
-      (narrow-to-region start (point))
-      (let ((fill-prefix prev-prefix))
-       (fill-region (point-min) (point-max) t 'nosqueeze 'to-eop)))))
+         (narrow-to-region start end)
+         (let ((prefix
+                (concat "\n"
+                        (or (and (looking-at ">[> ]*")
+                                 (match-string 0)) ""))))
+           (goto-char start)
+           (while (search-forward prefix nil t)
+             (replace-match " " t t))
+           (goto-char start)
+           (while (< (+ (point) fill-column) (point-max))
+             (let ((start (point)))
+               (forward-char fill-column)
+               (when (search-backward " " start t)
+                 (forward-char)
+                 (insert prefix)))))
+         (setq start (1+ (point-max))))))
+    t))
 
 ;;;###autoload
 (defun fill-flowed (&optional buffer delete-space)
   "Apply RFC2646 decoding to BUFFER.
 If BUFFER is nil, default to the current buffer.
 
-If DELETE-SPACE, delete RFC2646 spaces padding at the end of
+If DELETE-SPACE, delete RFC3676 spaces padding at the end of
 lines."
   (with-current-buffer (or buffer (current-buffer))
     (let ((fill-column  (eval fill-flowed-display-column t)))
@@ -154,7 +171,7 @@ lines."
           ;; Delete the newline.
           (when (eq (following-char) ?\s)
             (delete-char 1))
-          ;; Hack: Don't do the flowing on the signature line.
+          ;; As per RFC3767: Don't do the flowing on the signature line.
           (when (and (not (looking-at "-- $"))
                      (eq (char-before (line-end-position)) ?\s))
             (while (and (not (eobp))
-- 
2.39.2