From e2d152e63227560562577deace08c2455d7ede02 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 6 Sep 2000 15:21:39 +0000
Subject: [PATCH] Extensive redesign of OPERATE-ON-INDIVIDUAL-PARAGRAPHS, to
 treat regions with different fill prefixes as separate paragraphs.  This is
 similar to what Emacs does but not exactly the same: we are more strict about
 noticing prefix changes.

---
 v7/src/edwin/fill.scm   | 85 +++++++++++++++++++++++------------------
 v7/src/edwin/tparse.scm |  6 ++-
 2 files changed, 53 insertions(+), 38 deletions(-)

diff --git a/v7/src/edwin/fill.scm b/v7/src/edwin/fill.scm
index 0dfb33e04..f004250c2 100644
--- a/v7/src/edwin/fill.scm
+++ b/v7/src/edwin/fill.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: fill.scm,v 1.69 2000/09/06 04:01:05 cph Exp $
+;;; $Id: fill.scm,v 1.70 2000/09/06 15:21:28 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -296,47 +296,58 @@ the distance between the end of the text and `fill-column'."
     (lambda (p-start p-end fill-prefix)
       (fill-region-as-paragraph p-start p-end fill-prefix
 				fill-column justify?))))
-
+
 (define (operate-on-individual-paragraphs start end mail? operator)
-  (let ((start (mark-right-inserting-copy start))
+  (let ((point (mark-left-inserting-copy start))
+	(pend (mark-left-inserting-copy start))
 	(end (mark-left-inserting-copy end))
-	(point (mark-left-inserting-copy start))
-	(pend (mark-left-inserting-copy start)))
+	(paragraph-separate (ref-variable paragraph-separate start))
+	(compute-prefix
+	 (lambda (point)
+	   (let ((ls (line-start point 0)))
+	     (or (and (ref-variable adaptive-fill-mode point)
+		      (fill-context-prefix ls (line-end point 0) ""))
+		 (extract-string ls point))))))
+    (if (and mail? (re-search-forward "^[ \t]*[^ \t\n]*:" point end #f))
+	(move-mark-to! point (or (search-forward "\n\n" point end #f) end)))
     (let loop ()
-      (move-mark-to! point (skip-chars-forward " \t\n" point end))
+      (move-mark-to!
+       point
+       (let skip-separators ((mark point))
+	 (cond ((mark>= mark end) end)
+	       ((let* ((ls (skip-chars-forward " \t" mark end))
+		       (fill-prefix
+			(and (ref-variable adaptive-fill-mode ls)
+			     (fill-context-prefix ls (line-end ls 0) ""))))
+		  (if fill-prefix
+		      (let ((fp (match-forward fill-prefix ls end #f)))
+			(or (not fp)
+			    (re-match-forward paragraph-separate fp end #f)))
+		      (re-match-forward paragraph-separate ls end #f)))
+		(skip-separators (line-start mark 1 'LIMIT)))
+	       (else mark))))
+      (move-mark-to! point (skip-chars-forward " \t" point end))
       (if (mark< point end)
-	  (let ((fill-prefix
-		 (let ((ls (line-start point 0)))
-		   (or (and (ref-variable adaptive-fill-mode point)
-			    (or (let ((le (line-end point 1 #f)))
-				  (and le
-				       (fill-context-prefix ls le "")))
-				(fill-context-prefix ls (line-end point 0)
-						     "")))
-		       (extract-string ls point)))))
-	    (move-mark-to! pend
-			   (or (forward-one-paragraph point end fill-prefix)
-			       end))
-	    (let ((m
-		   (if mail?
-		       (let loop ((m point))
-			 (let ((m*
-				(re-search-forward "^[ \t]*[^ \t\n]*:" m pend
-						   #f)))
-			   (if m*
-			       (let ((m* (line-end m* 0)))
-				 (if (mark< m* pend)
-				     (loop (mark1+ m*))
-				     pend))
-			       m)))
-		       point)))
-	      (if (mark= m point)
+	  (let ((fill-prefix (compute-prefix point)))
+	    (let find-end ((le (line-end point 0 'ERROR)))
+	      (let ((ls
+		     (and (mark< le end)
+			  (skip-chars-forward " \t"
+					      (line-start le 1 'ERROR)
+					      end))))
+		(if (and ls
+			 (mark< ls end)
+			 (let ((m (match-forward fill-prefix ls)))
+			   (and m
+				(not (paragraph-start? m end))))
+			 (string=? (compute-prefix ls) fill-prefix))
+		    (find-end (line-end ls 0 'ERROR))
+		    (move-mark-to! pend le))))
+	    (operator point pend fill-prefix)
+	    (let ((ls (line-start pend 1 #f)))
+	      (if (and ls (mark< ls end))
 		  (begin
-		    (operator point pend fill-prefix)
-		    (move-mark-to! point pend)
-		    (loop))
-		  (begin
-		    (move-mark-to! point m)
+		    (move-mark-to! point ls)
 		    (loop)))))))
     (mark-temporary! pend)
     (mark-temporary! point)
diff --git a/v7/src/edwin/tparse.scm b/v7/src/edwin/tparse.scm
index 710a82c87..2679ec873 100644
--- a/v7/src/edwin/tparse.scm
+++ b/v7/src/edwin/tparse.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: tparse.scm,v 1.73 2000/09/06 15:15:42 cph Exp $
+;;; $Id: tparse.scm,v 1.74 2000/09/06 15:21:39 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -105,6 +105,10 @@ This is desirable in modes where blank lines are the paragraph delimiters."
   (let ((regexp "[ \t\f]*$"))
     (local-set-variable! paragraph-start regexp buffer)
     (local-set-variable! paragraph-separate regexp buffer)))
+
+(define (paragraph-start? start end)
+  (or (re-match-forward (ref-variable paragraph-start start) start end #f)
+      (re-match-forward (ref-variable paragraph-separate start) start end #f)))
 
 (define (forward-one-paragraph mark #!optional limit fill-prefix)
   (let ((limit
-- 
2.25.1