(fill-individual-paragraphs-prefix): New

subroutine taken from fill-individual-paragraphs.  Really check that
JUST-ONE-LINE-PREFIX is longer than TWO-LINES-PREFIX in its whitespace.
(fill-individual-paragraphs-citation): New subroutine.
(fill-nonuniform-paragraphs): Arg MAILP renamed.
(fill-individual-paragraphs): Arg MAILP renamed.

1 files changed, 69 insertions, 45 deletions

diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 18f06a7e8d5..0886ecfb152 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -947,7 +947,7 @@ Arguments BEGIN and END are optional; default is the whole buffer."
 	(forward-line 1)))))
 
 
-(defun fill-nonuniform-paragraphs (min max &optional justifyp mailp)
+(defun fill-nonuniform-paragraphs (min max &optional justifyp citation-regexp)
   "Fill paragraphs within the region, allowing varying indentation within each.
 This command divides the region into \"paragraphs\",
 only at paragraph-separator lines, then fills each paragraph
@@ -958,13 +958,16 @@ When calling from a program, pass range to fill as first two arguments.
 
 Optional third and fourth arguments JUSTIFY and MAIL-FLAG:
 JUSTIFY to justify paragraphs (prefix arg),
-MAIL-FLAG for a mail message, i. e. don't fill header lines."
+When filling a mail message, pass a regexp for CITATION-REGEXP
+which will match the prefix of a line which is a citation marker
+plus whitespace, but no other kind of prefix.
+Also, if CITATION-REGEXP is non-nil,  don't fill header lines."
   (interactive (list (region-beginning) (region-end)
 		     (if current-prefix-arg 'full)))
   (let ((fill-individual-varying-indent t))
-    (fill-individual-paragraphs min max justifyp mailp)))
+    (fill-individual-paragraphs min max justifyp citation-regexp)))
 
-(defun fill-individual-paragraphs (min max &optional justify mailp)
+(defun fill-individual-paragraphs (min max &optional justify citation-regexp)
   "Fill paragraphs of uniform indentation within the region.
 This command divides the region into \"paragraphs\", 
 treating every change in indentation level or prefix as a paragraph boundary,
@@ -983,7 +986,10 @@ as the first two arguments.
 
 Optional third and fourth arguments JUSTIFY and MAIL-FLAG:
 JUSTIFY to justify paragraphs (prefix arg),
-MAIL-FLAG for a mail message, i. e. don't fill header lines."
+When filling a mail message, pass a regexp for CITATION-REGEXP
+which will match the prefix of a line which is a citation marker
+plus whitespace, but no other kind of prefix.
+Also, if CITATION-REGEXP is non-nil,  don't fill header lines."
   (interactive (list (region-beginning) (region-end)
 		     (if current-prefix-arg 'full)))
   (save-restriction
@@ -991,7 +997,7 @@ MAIL-FLAG for a mail message, i. e. don't fill header lines."
       (goto-char min)
       (beginning-of-line)
       (narrow-to-region (point) max)
-      (if mailp 
+      (if citation-regexp
 	  (while (and (not (eobp))
 		      (or (looking-at "[ \t]*[^ \t\n]+:")
 			  (looking-at "[ \t]*$")))
@@ -1020,45 +1026,7 @@ MAIL-FLAG for a mail message, i. e. don't fill header lines."
 		   (if (not (and fill-prefix
 				 (looking-at fill-prefix-regexp)))
 		       (setq fill-prefix
-			     ;; Get the prefix from just the first line
-			     ;; ordinarily.
-			     ;; But if using two lines gives us a shorter
-			     ;; result, lacking some whitespace at the end,
-			     ;; use that.
-			     (or (let ((adaptive-fill-first-line-regexp "")
-				       just-one-line-prefix
-				       two-lines-prefix
-				       adjusted-two-lines-prefix)
-				   (setq just-one-line-prefix
-					 (fill-context-prefix
-					  (point)
-					  (save-excursion (forward-line 1)
-							  (point))))
-				   (setq two-lines-prefix
-					 (fill-context-prefix
-					  (point)
-					  (save-excursion (forward-line 2)
-							  (point))))
-				   (when two-lines-prefix
-				     (setq adjusted-two-lines-prefix
-					   (substring two-lines-prefix 0
-						      (string-match "[ \t]*\\'"
-								    two-lines-prefix))))
-				   ;; See if JUST-ONE-LINE-PREFIX
-				   ;; is the same as TWO-LINES-PREFIX
-				   ;; except perhaps with longer whitespace.
-				   (if (and just-one-line-prefix
-					    two-lines-prefix
-					    (string-match (concat "\\`"
-								  (regexp-quote adjusted-two-lines-prefix)
-								  "[ \t]*\\'")
-							  just-one-line-prefix))
-				       two-lines-prefix
-				     just-one-line-prefix))
-				 (buffer-substring 
-				  (point)
-				  (save-excursion (skip-chars-forward " \t")
-						  (point))))
+			     (fill-individual-paragraphs-prefix citation-regexp)
 			     fill-prefix-regexp (regexp-quote fill-prefix)))
 		   (forward-line 1)
 		   (if (bolp)
@@ -1089,4 +1057,60 @@ MAIL-FLAG for a mail message, i. e. don't fill header lines."
 	    (fill-region-as-paragraph start (point) justify)
 	    (or had-newline (delete-char -1))))))))
 
+(defun fill-individual-paragraphs-prefix (citation-regexp)
+  (or (let ((adaptive-fill-first-line-regexp "")
+	    just-one-line-prefix
+	    two-lines-prefix
+	    one-line-citation-part
+	    two-lines-citation-part
+	    adjusted-two-lines-citation-part)
+	(setq just-one-line-prefix
+	      (fill-context-prefix
+	       (point)
+	       (save-excursion (forward-line 1)
+			       (point))))
+	(setq two-lines-prefix
+	      (fill-context-prefix
+	       (point)
+	       (save-excursion (forward-line 2)
+			       (point))))
+	(when just-one-line-prefix
+	  (setq one-line-citation-part
+		(if citation-regexp
+		    (fill-individual-paragraphs-citation just-one-line-prefix
+							 citation-regexp)
+		  just-one-line-prefix)))
+	(when two-lines-prefix
+	  (setq two-lines-citation-part
+		(if citation-regexp
+		    (fill-individual-paragraphs-citation two-lines-prefix
+							 citation-regexp)
+		  just-one-line-prefix))
+	  (setq adjusted-two-lines-citation-part
+		(substring two-lines-citation-part 0
+			   (string-match "[ \t]*\\'"
+					 two-lines-citation-part))))
+	;; See if the citation part of JUST-ONE-LINE-PREFIX
+	;; is the same as that of TWO-LINES-PREFIX,
+	;; except perhaps with longer whitespace.
+	(if (and just-one-line-prefix
+		 two-lines-prefix
+		 (string-match (concat "\\`"
+				       (regexp-quote adjusted-two-lines-citation-part)
+				       "[ \t]*\\'")
+			       one-line-citation-part)
+		 (>= (string-width one-line-citation-part)
+		     (string-width two-lines-citation-part)))
+	    two-lines-prefix
+	  just-one-line-prefix))
+      (buffer-substring 
+       (point)
+       (save-excursion (skip-chars-forward " \t")
+		       (point)))))
+
+(defun fill-individual-paragraphs-citation (string citation-regexp)
+  (string-match citation-regexp
+		string)
+  (match-string 0 string))  
+
 ;;; fill.el ends here