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

[Sandra Snan via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

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