From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 23 Apr 1991 06:50:04 +0000 (+0000)
Subject: * Change arguments to string and regexp search procedures.  New
X-Git-Tag: 20090517-FFI~10731
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=57b9465953ae2b22e9a95d30a8457c904e754787;p=mit-scheme.git

* Change arguments to string and regexp search procedures.  New
  arguments are (PATTERN MARK END #!OPTIONAL CASE-FOLD-SEARCH).

* Reimplement paragraph and region filling commands, to fix bugs and
  create new functionality.  Default region filling is now done by
  paragraphs rather than treating the entire region as a single
  paragraph.

* Implement M-x mail-fill-yanked-message.
---

diff --git a/v7/src/edwin/fill.scm b/v7/src/edwin/fill.scm
index e6dee0a23..afaa9c739 100644
--- a/v7/src/edwin/fill.scm
+++ b/v7/src/edwin/fill.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fill.scm,v 1.47 1991/04/21 00:50:39 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fill.scm,v 1.48 1991/04/23 06:46:56 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -46,27 +46,11 @@
 
 (declare (usual-integrations))
 
-(define-command fill-paragraph
-  "Fill this (or next) paragraph.
-Point stays the same."
-  ()
-  (lambda ()
-    (fill-region (paragraph-text-region (current-point))
-		 (ref-variable fill-prefix)
-		 (ref-variable fill-column))))
-
-(define-command fill-region
-  "Fill text from point to mark."
-  "r"
-  (lambda (region)
-    (fill-region region
-		 (ref-variable fill-prefix)
-		 (ref-variable fill-column))))
-
 (define-variable-per-buffer fill-column
-  "*Column beyond which automatic line-wrapping should happen.
+  "Column beyond which automatic line-wrapping should happen.
 Automatically becomes local when set in any fashion."
-  70)
+  70
+  exact-nonnegative-integer?)
 
 (define-command set-fill-column
   "Set fill column to argument or current column.
@@ -75,82 +59,277 @@ Otherwise the current position of the cursor is used."
   "P"
   (lambda (argument)
     (let ((column (or argument (current-column))))
-      (local-set-variable! fill-column column)
-      (temporary-message "Fill column set to " (write-to-string column)))))
+      (set-variable! fill-column column)
+      (temporary-message "Fill column set to " (number->string column)))))
 
-(define-variable fill-prefix
+(define-variable-per-buffer fill-prefix
   "String for auto-fill to insert at start of new line, or #F."
-  false)
+  false
+  string-or-false?)
 
 (define-command set-fill-prefix
-  "Set fill-prefix to text between point and start of line."
-  ()
-  (lambda ()
-    (if (line-start? (current-point))
-	(begin
-	  (local-set-variable! fill-prefix false)
-	  (message "Fill prefix cancelled"))
-	(let ((string (extract-string (line-start (current-point) 0))))
-	  (local-set-variable! fill-prefix string)
-	  (message "Fill prefix now \"" (ref-variable fill-prefix) "\"")))))
+  "Set the fill-prefix to the current line up to point.
+Filling expects lines to start with the fill prefix
+and reinserts the fill prefix in each resulting line."
+  "d"
+  (lambda (point)
+    (let ((string (extract-string (line-start point 0) point)))
+      (if (string-null? string)
+	  (begin
+	    (set-variable! fill-prefix false)
+	    (message "fill-prefix cancelled"))
+	  (begin
+	    (set-variable! fill-prefix string)
+	    (message "fill-prefix: \"" string "\""))))))
 
-(define (fill-region region fill-prefix fill-column)
-  (let ((start (region-start region))
-	(end (region-end region)))
-    (let ((start (mark-right-inserting (skip-chars-forward "\n" start end)))
-	  (end (mark-left-inserting (skip-chars-backward "\n" end start))))
-      (with-narrowed-region! (make-region start end)
-	(lambda ()
-	  (let ((point (mark-left-inserting-copy start)))
-	    (let loop ()
-	      (let ((ending (forward-sentence point 1 false)))
-		(if (and ending (not (group-end? ending)))
-		    (begin
-		      (move-mark-to! point ending)
-		      (if (char=? #\newline (mark-right-char point))
-			  (insert-char #\space point))
-		      (loop)))))
-	    (move-mark-to! point start)
+(define-command fill-paragraph
+  "Fill paragraph at or after point.
+Prefix arg means justify as well."
+  "d\nP"
+  (lambda (point justify?)
+    ((ref-command fill-region-as-paragraph) (paragraph-text-region point)
+					    justify?)))
+
+(define-command fill-region-as-paragraph
+  "Fill region as one paragraph: break lines to fit fill-column.
+Prefix arg means justify too."
+  "r\nP"
+  (lambda (region justify?)
+    (let ((start (region-start region)))
+      (fill-region-as-paragraph
+       start
+       (region-end region)
+       (mark-local-ref start (ref-variable-object fill-prefix))
+       (mark-local-ref start (ref-variable-object fill-column))
+       justify?))))
+
+(define-command fill-individual-paragraphs
+  "Fill each paragraph in region according to its individual fill prefix."
+  "r\nP"
+  (lambda (region justify?)
+    (let ((start (region-start region)))
+      (fill-individual-paragraphs
+       start
+       (region-end region)
+       (mark-local-ref start (ref-variable-object fill-column))
+       justify?
+       false))))
+
+(define-command fill-region
+  "Fill each of the paragraphs in the region.
+Prefix arg means justify as well."
+  "r\nP"
+  (lambda (region justify?)
+    (let ((start (region-start region)))
+      (fill-region start
+		   (region-end region)
+		   (mark-local-ref start (ref-variable-object fill-prefix))
+		   (mark-local-ref start (ref-variable-object fill-column))
+		   justify?))))
+
+(define-command justify-current-line
+  "Add spaces to line point is in, so it ends at fill-column."
+  "d"
+  (lambda (point)
+    (justify-line point
+		  (mark-local-ref point (ref-variable-object fill-prefix))
+		  (mark-local-ref point (ref-variable-object fill-column)))))
+
+(define (fill-region-as-paragraph start end fill-prefix fill-column justify?)
+  (let ((start (mark-right-inserting-copy (skip-chars-forward "\n" start end)))
+	(end (mark-left-inserting-copy (skip-chars-backward "\n" end start))))
+    (let ((point (mark-left-inserting-copy start)))
+      ;; Delete the fill prefix from every line except the first.
+      (if fill-prefix
+	  (begin
+	    (if (>= (string-length fill-prefix) fill-column)
+		(editor-error "fill-prefix too long for specified width"))
+	    (let ((m (match-forward fill-prefix start end false)))
+	      (if m
+		  (begin
+		    (move-mark-to! point m)
+		    (move-mark-to! start m))))
 	    (let loop ()
-	      (if fill-prefix
-		  (let ((end (match-forward fill-prefix point)))
-		    (if end
-			(delete-string point end))))
 	      (let ((m (char-search-forward #\newline point end)))
 		(if m
 		    (begin
 		      (move-mark-to! point m)
-		      (delete-left-char point)
-		      (insert-char #\space point)
+		      (let ((m (match-forward fill-prefix point end false)))
+			(if m
+			    (delete-string point m)))
 		      (loop)))))
-	    (delete-horizontal-space end)
-	    (move-mark-to! point start)
-	    (let loop ()
-	      (if (not (group-end? point))
+	    (move-mark-to! point start)))
+      ;; Make sure sentences ending at end of line get an extra space.
+      (let loop ()
+	(let ((m (re-search-forward "[.?!][])\"']*$" point end false)))
+	  (if m
+	      (begin
+		(move-mark-to! point m)
+		(insert-char #\space point)
+		(loop)))))
+      ;; Change all newlines to spaces.
+      (move-mark-to! point start)
+      (let loop ()
+	(let ((m (char-search-forward #\newline point end)))
+	  (if m
+	      (begin
+		(move-mark-to! point m)
+		(delete-left-char point)
+		(insert-char #\space point)
+		(loop)))))
+      ;; Flush excess spaces, except in the paragraph indentation.
+      (move-mark-to! point (skip-chars-forward " \t" start end))
+      (let loop ()
+	(if (re-search-forward "   *" point end false)
+	    (begin
+	      (move-mark-to! point (delete-match))
+	      (insert-string (if (fill:sentence-end? point start) "  " " ")
+			     point)
+	      (loop))))
+      (delete-string (horizontal-space-start end) end)
+      (insert-string "  " end)
+      (move-mark-to! point start)
+      (let loop ()
+	(let ((target (move-to-column point fill-column)))
+	  (if (mark>= target end)
+	      (delete-string (horizontal-space-start end) end)
+	      (begin
+		(move-mark-to!
+		 point
+		 (let ((m (skip-chars-backward "^ \n" target point)))
+		   (if (mark> m point)
+		       m
+		       (skip-chars-forward "^ \n" target end))))
+		(if (mark< point end)
+		    (begin
+		      (delete-horizontal-space point)
+		      (insert-newline point)
+		      (if justify?
+			  (fill:call-with-line-marks (mark-1+ point)
+						     fill-prefix
+			    (lambda (start end)
+			      (fill:justify-line start end fill-column))))
+		      (if fill-prefix (insert-string fill-prefix point))))
+		(loop)))))
+      (mark-temporary! point)
+      (mark-temporary! end)
+      (mark-temporary! start))))
+
+(define (fill-region start end fill-prefix fill-column justify?)
+  (let ((start (mark-right-inserting-copy start))
+	(end (mark-left-inserting-copy end))
+	(point (mark-left-inserting-copy start))
+	(pend (mark-left-inserting-copy start)))
+    (let loop ()
+      (if (mark< point end)
+	  (begin
+	    (move-mark-to! pend
+			   (or (forward-one-paragraph point end fill-prefix)
+			       end))
+	    (if (mark>= (or (backward-one-paragraph pend start fill-prefix)
+			    start)
+			point)
+		(fill-region-as-paragraph point
+					  pend
+					  fill-prefix
+					  fill-column
+					  justify?))
+	    (move-mark-to! point pend)
+	    (loop))))
+    (mark-temporary! pend)
+    (mark-temporary! point)
+    (mark-temporary! end)
+    (mark-temporary! start)))
+
+(define (fill-individual-paragraphs start end fill-column justify? mail?)
+  (let ((start (mark-right-inserting-copy start))
+	(end (mark-left-inserting-copy end))
+	(point (mark-left-inserting-copy start))
+	(pend (mark-left-inserting-copy start)))
+    (let loop ()
+      (move-mark-to! point (skip-chars-forward " \t\n" point end))
+      (if (mark< point end)
+	  (let ((fill-prefix (extract-string (line-start point 0) 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
+						   false)))
+			   (if m*
+			       (let ((m* (line-end m* 0)))
+				 (if (mark< m* pend)
+				     (loop (mark1+ m*))
+				     pend))
+			       m)))
+		       point)))
+	      (if (mark= m point)
 		  (begin
-		    (if fill-prefix
-			(insert-string fill-prefix point))
-		    (let ((target (move-to-column point fill-column)))
-		      (if (not (group-end? target))
-			  (let ((end
-				 (let ((end
-					(char-search-backward #\space
-							      (mark1+ target)
-							      point)))
-				   (if end
-				       (mark1+ end)
-				       (let ((m
-					      (char-search-forward #\space
-								   target
-								   end)))
-					 (and m
-					      (mark-1+ m)))))))
-			    (if end
-				(begin
-				  (move-mark-to! point end)
-				  (delete-horizontal-space point)
-				  (insert-newline point)
-				  (loop)))))))))))))))
+		    (fill-region-as-paragraph point pend
+					      fill-prefix fill-column
+					      justify?)
+		    (move-mark-to! point pend)
+		    (loop))
+		  (begin
+		    (move-mark-to! point m)
+		    (loop)))))))
+    (mark-temporary! pend)
+    (mark-temporary! point)
+    (mark-temporary! end)
+    (mark-temporary! start)))
+
+(define (justify-line mark fill-prefix fill-column)
+  (fill:call-with-line-marks mark fill-prefix
+    (lambda (start end)
+      (let ((point (mark-left-inserting-copy start)))
+	(let loop ()
+	  (if (re-search-forward "   *" point end false)
+	      (begin
+		(move-mark-to! point (delete-match))
+		(insert-string (if (fill:sentence-end? point start) "  " " ")
+			       point)
+		(loop))))
+	(mark-temporary! point))
+      (fill:justify-line start end fill-column))))
+
+(define (fill:call-with-line-marks mark fill-prefix procedure)
+  (let ((end (mark-left-inserting-copy (line-end mark 0))))
+    (let ((start
+	   (mark-right-inserting-copy
+	    (skip-chars-forward
+	     " \t"
+	     (let ((start (line-start end 0)))
+	       (or (and fill-prefix
+			(match-forward fill-prefix start end false))
+		   start))
+	     end))))
+      (procedure start end)
+      (mark-temporary! start)
+      (mark-temporary! end))))
+
+(define (fill:justify-line start end fill-column)
+  (let ((point (mark-right-inserting-copy end)))
+    (do ((ncols (- fill-column (mark-column end)) (- ncols 1)))
+	((<= ncols 0))
+      (do ((i (+ 3 (random 3)) (- i 1)))
+	  ((= i 0))
+	(move-mark-to!
+	 point
+	 (skip-chars-backward " "
+			      (or (char-search-backward #\space point start)
+				  (char-search-backward #\space end start)
+				  start)
+			      start)))
+      (insert-char #\space point))
+    (mark-temporary! point)))
+
+(define (fill:sentence-end? point start)
+  (let ((m (skip-chars-backward "])\"'" point start)))
+    (and (not (group-start? m))
+	 (memv (extract-left-char m) '(#\. #\? #\!)))))
 
 (define-command auto-fill-mode
   "Toggle auto-fill mode.
@@ -169,7 +348,7 @@ With argument, turn auto-fill mode on iff argument is positive."
   "Breaks the line if it exceeds the fill column, then inserts a space."
   "p"
   (lambda (argument)
-    (insert-chars #\Space argument)
+    (insert-chars #\space argument)
     (auto-fill-break)))
 
 (define-command auto-fill-newline
@@ -180,7 +359,6 @@ With argument, turn auto-fill mode on iff argument is positive."
     ((ref-command newline) argument)))
 
 (define-minor-mode auto-fill "Fill" "")
-
 (define-key 'auto-fill #\space 'auto-fill-space)
 (define-key 'auto-fill #\return 'auto-fill-newline)
 
@@ -200,10 +378,11 @@ With argument, turn auto-fill mode on iff argument is positive."
        (line-end? (horizontal-space-end point))))
 
 (define-variable-per-buffer left-margin
-  "*Column for the default indent-line-function to indent to.
+  "Column for the default indent-line-function to indent to.
 Linefeed indents to this column in Fundamental mode.
 Automatically becomes local when set in any fashion."
-  0)
+  0
+  exact-nonnegative-integer?)
 
 (define (center-line mark)
   (let ((mark (mark-permanent! mark)))
diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm
index 5d0c7ecce..cad60d303 100644
--- a/v7/src/edwin/make.scm
+++ b/v7/src/edwin/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.35 1991/04/21 00:51:24 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.36 1991/04/23 06:50:04 cph Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -37,4 +37,4 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (package/system-loader "edwin" '() 'QUERY)
-(add-system! (make-system "Edwin" 3 35 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 36 '()))
\ No newline at end of file
diff --git a/v7/src/edwin/regexp.scm b/v7/src/edwin/regexp.scm
index 8131e45bb..1df53577b 100644
--- a/v7/src/edwin/regexp.scm
+++ b/v7/src/edwin/regexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regexp.scm,v 1.50 1991/04/21 00:51:43 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regexp.scm,v 1.51 1991/04/23 06:47:00 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -77,7 +77,7 @@
 (define (replace-match replacement)
   (let ((m (mark-left-inserting-copy (re-match-start 0))))
     (delete-string m (re-match-end 0))
-    (insert-string m replacement)
+    (insert-string replacement m)
     (mark-temporary! m)
     m))
 
@@ -169,53 +169,51 @@
    registers
    string start end))
 
-(define-macro (define-search name key-name searcher compile-key
-		mark-limit mark-compare)
-  `(DEFINE (,name ,key-name #!OPTIONAL START END LIMIT?)
-     (LET ((START (IF (DEFAULT-OBJECT? START) (CURRENT-POINT) START)))
-       (LET ((END (IF (DEFAULT-OBJECT? END) (,mark-limit START) END)))
-	 (LET ((LIMIT? (AND (NOT (DEFAULT-OBJECT? LIMIT?)) LIMIT?)))
-	   (IF (NOT (,mark-compare START END))
-	       (ERROR ,(string-append (symbol->string name)
-				      ": Marks incorrectly related")
-		      START END))
-	   (OR (LET ((GROUP (MARK-GROUP START)))
-		 (,searcher GROUP
-			    (MARK-INDEX START)
-			    (MARK-INDEX END)
-			    (,compile-key ,key-name
-					  (GROUP-CASE-FOLD-SEARCH GROUP))))
-	       (LIMIT-MARK-MOTION LIMIT? END)))))))
-
-(define-search search-forward string
-  %re-search-forward re-compile-string group-end mark<=)
-
-(define-search re-search-forward regexp
-  %re-search-forward re-compile-pattern group-end mark<=)
-
-(define (%re-search-forward group start end pattern)
-  (let ((index
-	 (re-search-buffer-forward pattern
-				   (group-case-fold-search group)
-				   (group-syntax-table group)
-				   group start end)))
-    (and index
-	 (make-mark group index))))
-
-(define-search search-backward string
-  %re-search-backward re-compile-string group-start mark>=)
-
-(define-search re-search-backward regexp
-  %re-search-backward re-compile-pattern group-start mark>=)
-
-(define (%re-search-backward group start end pattern)
-  (let ((index
-	 (re-search-buffer-backward pattern
-				    (group-case-fold-search group)
-				    (group-syntax-table group)
-				    group end start)))
-    (and index
-	 (make-mark group index))))
+(define (search-forward string start end #!optional case-fold-search)
+  (%re-search string start end
+	      (if (default-object? case-fold-search)
+		  (group-case-fold-search (mark-group start))
+		  case-fold-search)
+	      re-compile-string
+	      re-search-buffer-forward))
+
+(define (search-backward string end start #!optional case-fold-search)
+  (%re-search string start end
+	      (if (default-object? case-fold-search)
+		  (group-case-fold-search (mark-group start))
+		  case-fold-search)
+	      re-compile-string
+	      re-search-buffer-backward))
+
+(define (re-search-forward regexp start end #!optional case-fold-search)
+  (%re-search regexp start end
+	      (if (default-object? case-fold-search)
+		  (group-case-fold-search (mark-group start))
+		  case-fold-search)
+	      re-compile-pattern
+	      re-search-buffer-forward))
+
+(define (re-search-backward regexp end start #!optional case-fold-search)
+  (%re-search regexp start end
+	      (if (default-object? case-fold-search)
+		  (group-case-fold-search (mark-group start))
+		  case-fold-search)
+	      re-compile-pattern
+	      re-search-buffer-backward))
+
+(define (%re-search string start end case-fold-search compile-string search)
+  (if (not (mark<= start end))
+      (error "Marks incorrectly related:" start end))
+  (let ((group (mark-group start)))
+    (let ((index
+	   (search (compile-string string case-fold-search)
+		   case-fold-search
+		   (group-syntax-table group)
+		   group
+		   (mark-index start)
+		   (mark-index end))))
+      (and index
+	   (make-mark group index)))))
 
 (define (re-match-forward regexp start #!optional end case-fold-search)
   (let ((group (mark-group start)))
@@ -230,13 +228,12 @@
 	      (group-syntax-table group)
 	      group
 	      (mark-index start)
-	      (if (default-object? end)
-		  (group-end-index group)
-		  (begin
-		    (if (not (and (eq? group (mark-group end))
-				  (fix:<= (mark-index start)
-					  (mark-index end))))
-			(error "Marks incorrectly related:" start end))
-		    (mark-index end))))))
+	      (mark-index
+	       (if (default-object? end)
+		   (group-end-mark group)
+		   (begin
+		     (if (not (mark<= start end))
+			 (error "Marks incorrectly related:" start end))
+		     end))))))
 	(and index
 	     (make-mark group index))))))
\ No newline at end of file
diff --git a/v7/src/edwin/schmod.scm b/v7/src/edwin/schmod.scm
index b40292441..115361546 100644
--- a/v7/src/edwin/schmod.scm
+++ b/v7/src/edwin/schmod.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.14 1990/10/03 04:55:57 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.15 1991/04/23 06:47:05 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -75,8 +75,10 @@ normally they record the associated output in a transcript buffer:
   (local-set-variable! comment-indent-hook lisp-comment-indentation)
   (local-set-variable! comment-start ";")
   (local-set-variable! comment-end "")
-  (local-set-variable! paragraph-start "^$")
-  (local-set-variable! paragraph-separate (ref-variable paragraph-start))
+  (let ((separate (string-append "^$\\|" (ref-variable page-delimiter))))
+    (local-set-variable! paragraph-start separate)
+    (local-set-variable! paragraph-separate separate))
+  (local-set-variable! paragraph-ignore-fill-prefix true)
   (local-set-variable! indent-line-procedure (ref-command lisp-indent-line))
   (event-distributor/invoke! (ref-variable scheme-mode-hook)))
 
diff --git a/v7/src/edwin/search.scm b/v7/src/edwin/search.scm
index 9b0913cb8..1df0cd04c 100644
--- a/v7/src/edwin/search.scm
+++ b/v7/src/edwin/search.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/search.scm,v 1.148 1991/04/21 00:51:57 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/search.scm,v 1.149 1991/04/23 06:47:09 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -46,8 +46,6 @@
 
 (declare (usual-integrations))
 
-;;;; Character Search and Match
-
 (let-syntax
     ((define-forward-search
        (macro (name find-next)
@@ -126,92 +124,6 @@
     (and index
 	 (fix:+ index 1))))
 
-(define (char-search-forward char start end #!optional case-fold-search)
-  (let ((group (mark-group start))
-	(start-index (mark-index start))
-	(end-index (mark-index end)))
-    (if (not (and (eq? group (mark-group end))
-		  (fix:<= start-index end-index)))
-	(error "Marks incorrectly related:" start end))
-    (let ((index
-	   (if (if (default-object? case-fold-search)
-		   (group-case-fold-search group)
-		   case-fold-search)
-	       (group-find-next-char-ci group start-index end-index char)
-	       (group-find-next-char group start-index end-index char))))
-      (and index
-	   (make-mark group (fix:+ index 1))))))
-
-(define (char-search-backward char start end #!optional case-fold-search)
-  (let ((group (mark-group start))
-	(start-index (mark-index start))
-	(end-index (mark-index end)))
-    (if (not (and (eq? group (mark-group end))
-		  (fix:>= start-index end-index)))
-	(error "Marks incorrectly related:" start end))
-    (let ((index
-	   (if (if (default-object? case-fold-search)
-		   (group-case-fold-search group)
-		   case-fold-search)
-	       (group-find-next-char-ci group end-index start-index char)
-	       (group-find-next-char group end-index start-index char))))
-      (and index
-	   (make-mark group index)))))
-
-(define (char-match-forward char mark #!optional case-fold-search)
-  (let ((group (mark-group mark))
-	(index (mark-index mark)))
-    (and (not (group-end-index? group index))
-	 (if (if (default-object? case-fold-search)
-		 (group-case-fold-search group)
-		 case-fold-search)
-	     (char-ci=? char (group-right-char group index))
-	     (char=? char (group-right-char group index))))))
-
-(define (char-match-backward char mark #!optional case-fold-search)
-  (let ((group (mark-group mark))
-	(index (mark-index mark)))
-    (and (not (group-start-index? group index))
-	 (if (if (default-object? case-fold-search)
-		 (group-case-fold-search group)
-		 case-fold-search)
-	     (char-ci=? char (group-left-char group index))
-	     (char=? char (group-left-char group index))))))
-
-(define (skip-chars-forward pattern #!optional start end limit?)
-  (let ((start (if (default-object? start) (current-point) start)))
-    (let ((end (if (default-object? end) (group-end start) end)))
-      (let ((limit? (if (default-object? limit?) 'LIMIT limit?)))
-	(if (not (mark<= start end))
-	    (error "SKIP-CHARS-FORWARD: Marks incorrectly related" start end))
-	(let ((index
-	       (group-find-next-char-in-set (mark-group start)
-					    (mark-index start)
-					    (mark-index end)
-					    (re-compile-char-set pattern
-								 true))))
-	  (if index
-	      (make-mark (mark-group start) index)
-	      (limit-mark-motion limit? end)))))))
-
-(define (skip-chars-backward pattern #!optional start end limit?)
-  (let ((start (if (default-object? start) (current-point) start)))
-    (let ((end (if (default-object? end) (group-start start) end)))
-      (let ((limit? (if (default-object? limit?) 'LIMIT limit?)))
-	(if (not (mark>= start end))
-	    (error "SKIP-CHARS-BACKWARD: Marks incorrectly related" start end))
-	(let ((index
-	       (group-find-previous-char-in-set (mark-group start)
-						(mark-index end)
-						(mark-index start)
-						(re-compile-char-set pattern
-								     true))))
-	  (if index
-	      (make-mark (mark-group start) (fix:+ index 1))
-	      (limit-mark-motion limit? end)))))))
-
-;;;; String Search and Match
-
 (define (group-match-substring-forward group start end
 				       string string-start string-end)
   (let ((text (group-text group))
@@ -344,34 +256,129 @@
 			  (fix:- string-end (fix:- end gap-start)))
 		   index)))))))
 
-(define (match-forward string mark #!optional case-fold-search)
-  (let ((group (mark-group mark))
-	(start (mark-index mark))
+(define (char-search-forward char start end #!optional case-fold-search)
+  (let ((group (mark-group start))
+	(start-index (mark-index start))
+	(end-index (mark-index end)))
+    (if (not (and (eq? group (mark-group end))
+		  (fix:<= start-index end-index)))
+	(error "Marks incorrectly related:" start end))
+    (let ((index
+	   (if (if (default-object? case-fold-search)
+		   (group-case-fold-search group)
+		   case-fold-search)
+	       (group-find-next-char-ci group start-index end-index char)
+	       (group-find-next-char group start-index end-index char))))
+      (and index
+	   (make-mark group (fix:+ index 1))))))
+
+(define (char-search-backward char start end #!optional case-fold-search)
+  (let ((group (mark-group start))
+	(start-index (mark-index start))
+	(end-index (mark-index end)))
+    (if (not (and (eq? group (mark-group end))
+		  (fix:>= start-index end-index)))
+	(error "Marks incorrectly related:" start end))
+    (let ((index
+	   (if (if (default-object? case-fold-search)
+		   (group-case-fold-search group)
+		   case-fold-search)
+	       (group-find-previous-char-ci group end-index start-index char)
+	       (group-find-previous-char group end-index start-index char))))
+      (and index
+	   (make-mark group index)))))
+
+(define-macro (default-end-mark start end)
+  `(IF (DEFAULT-OBJECT? ,end)
+       (GROUP-END ,start)
+       (BEGIN
+	 (IF (NOT (MARK<= ,start ,end))
+	     (ERROR "Marks incorrectly related:" ,start ,end))
+	 ,end)))
+
+(define-macro (default-start-mark start end)
+  `(IF (DEFAULT-OBJECT? ,start)
+       (GROUP-START ,end)
+       (BEGIN
+	 (IF (NOT (MARK<= ,start ,end))
+	     (ERROR "Marks incorrectly related:" ,start ,end))
+	 ,start)))
+
+(define (char-match-forward char start #!optional end case-fold-search)
+  (and (mark< start (default-end-mark start end))
+       (let ((group (mark-group start)))
+	 (if (if (default-object? case-fold-search)
+		 (group-case-fold-search group)
+		 case-fold-search)
+	     (char-ci=? char (group-right-char group (mark-index start)))
+	     (char=? char (group-right-char group (mark-index start)))))))
+
+(define (char-match-backward char end #!optional start case-fold-search)
+  (and (mark< (default-start-mark start end) end)
+       (let ((group (mark-group end)))
+	 (if (if (default-object? case-fold-search)
+		 (group-case-fold-search group)
+		 case-fold-search)
+	     (char-ci=? char (group-left-char group (mark-index end)))
+	     (char=? char (group-left-char group (mark-index end)))))))
+
+(define (skip-chars-forward pattern #!optional start end limit?)
+  (let ((start (if (default-object? start) (current-point) start))
+	(limit? (if (default-object? limit?) 'LIMIT limit?)))
+    (let ((end (default-end-mark start end)))
+      (let ((index
+	     (group-find-next-char-in-set (mark-group start)
+					  (mark-index start)
+					  (mark-index end)
+					  (re-compile-char-set pattern true))))
+	(if index
+	    (make-mark (mark-group start) index)
+	    (limit-mark-motion limit? end))))))
+
+(define (skip-chars-backward pattern #!optional end start limit?)
+  (let ((end (if (default-object? end) (current-point) end))
+	(limit? (if (default-object? limit?) 'LIMIT limit?)))
+    (let ((start (default-start-mark start end)))
+      (let ((index
+	     (group-find-previous-char-in-set (mark-group start)
+					      (mark-index start)
+					      (mark-index end)
+					      (re-compile-char-set pattern
+								   true))))
+	(if index
+	    (make-mark (mark-group start) (fix:+ index 1))
+	    (limit-mark-motion limit? start))))))
+
+(define (match-forward string start #!optional end case-fold-search)
+  (let ((end (default-end-mark start end))
+	(group (mark-group start))
+	(start-index (mark-index start))
 	(length (string-length string)))
-    (let ((end (fix:+ start length)))
-      (and (fix:<= end (group-end-index group))
+    (let ((i (fix:+ start-index length)))
+      (and (fix:<= i (mark-index end))
 	   (fix:= (if (if (default-object? case-fold-search)
 			  (group-case-fold-search group)
 			  case-fold-search)
-		      (group-match-substring-forward-ci group start end
+		      (group-match-substring-forward-ci group start-index i
 							string 0 length)
-		      (group-match-substring-forward group start end
+		      (group-match-substring-forward group start-index i
 						     string 0 length))
-		  end)
-	   (make-mark group end)))))
+		  i)
+	   (make-mark group i)))))
 
-(define (match-backward string mark #!optional case-fold-search)
-  (let ((group (mark-group mark))
-	(end (mark-index mark))
+(define (match-backward string end #!optional start case-fold-search)
+  (let ((start (default-start-mark start end))
+	(group (mark-group end))
+	(end-index (mark-index end))
 	(length (string-length string)))
-    (let ((start (fix:- end length)))
-      (and (fix:>= start (group-start-index group))
+    (let ((i (fix:- end-index length)))
+      (and (fix:>= i (mark-index start))
 	   (fix:= (if (if (default-object? case-fold-search)
 			  (group-case-fold-search group)
 			  case-fold-search)
-		      (group-match-substring-backward-ci group start end
+		      (group-match-substring-backward-ci group i end-index
 							 string 0 length)
-		      (group-match-substring-backward group start end
+		      (group-match-substring-backward group i end-index
 						      string 0 length))
-		  start)
-	   (make-mark group start)))))
\ No newline at end of file
+		  i)
+	   (make-mark group i)))))
\ No newline at end of file
diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm
index 4e7921b65..9c0398b9e 100644
--- a/v7/src/edwin/sendmail.scm
+++ b/v7/src/edwin/sendmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sendmail.scm,v 1.1 1991/04/21 01:49:14 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sendmail.scm,v 1.2 1991/04/23 06:47:14 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991 Massachusetts Institute of Technology
 ;;;
@@ -147,9 +147,9 @@ is inserted."
   (let ((point (mark-left-inserting-copy (buffer-start buffer)))
 	(fill
 	 (lambda (start end)
-	   (fill-region (make-region start end)
-			"\t"
-			(ref-variable fill-column)))))
+	   (fill-region-as-paragraph start end
+				     "\t" (ref-variable fill-column)
+				     false))))
     (insert-string "To: " point)
     (if to
 	(begin
@@ -249,10 +249,13 @@ Prefix arg means don't delete this window."
   (lambda (argument)
     ((ref-command mail-send))
     (bury-buffer (current-buffer))
-    (if (and (not argument)
+    (if #|
+	(and (not argument)
 	     (not (window-has-no-neighbors? (current-window)))
 	     (eq? (ref-mode-object rmail)
 		  (buffer-major-mode (window-buffer (other-window)))))
+	|#
+	false
 	(window-delete! (current-window))
 	(select-buffer (previous-buffer)))))
 
@@ -309,11 +312,10 @@ the user from the mailer."
   (skip-chars-backward "\n" (re-match-start 0) start))
 
 (define (mail-match-header-separator start end)
-  (if (not (re-search (string-append
-		       "^"
-		       (re-quote-string (ref-variable mail-header-separator))
-		       "$")
-		      false start end))
+  (if (not (re-search-forward
+	    (string-append
+	     "^" (re-quote-string (ref-variable mail-header-separator)) "$")
+	    start end false))
       (editor-error "Can't find mail-header-separator")))
 
 (define (mail-field-end! start end field)
@@ -321,9 +323,9 @@ the user from the mailer."
       (mail-insert-field end field)))
 
 (define (mail-field-end start end field)
-  (and (re-search (string-append "^" field ":[ \t]*") true start end)
+  (and (re-search-forward (string-append "^" field ":[ \t]*") start end true)
        (let ((field-start (re-match-end 0)))
-	 (if (re-search "^[^ \t]" false field-start end)
+	 (if (re-search-forward "^[^ \t]" field-start end false)
 	     (skip-chars-backward "\n" (re-match-start 0) field-start)
 	     end))))
 
@@ -382,19 +384,33 @@ and don't delete any header fields."
   (let ((start (mark-left-inserting-copy start))
 	(end
 	 (mark-left-inserting-copy
-	  (if (re-search "\n\n" false start end)
+	  (if (re-search-forward "\n\n" start end false)
 	      (mark1+ (re-match-start 0))
 	      end)))
 	(mail-yank-ignored-headers (ref-variable mail-yank-ignored-headers)))
     (do ()
-	((not (re-search mail-yank-ignored-headers true start end)))
+	((not (re-search-forward mail-yank-ignored-headers start end true)))
       (move-mark-to! start (re-match-start 0))
-      (delete-string start
-		     (if (re-search "^[^ \t]" false (line-end start 0) end)
-			 (re-match-start 0)
-			 end)))
+      (delete-string
+       start
+       (if (re-search-forward "^[^ \t]" (line-end start 0) end false)
+	   (re-match-start 0)
+	   end)))
     (mark-temporary! start)
     (mark-temporary! end)))
+
+(define-command mail-fill-yanked-message
+  "Fill the paragraphs of a message yanked into this one.
+Numeric argument means justify as well."
+  "P"
+  (lambda (justify?)
+    (let ((buffer (current-buffer)))
+      (mail-match-header-separator (buffer-start buffer) (buffer-end-buffer))
+      (fill-individual-paragraphs (re-match-end 0)
+				  (buffer-end-buffer)
+				  (ref-variable fill-column)
+				  justify?
+				  true))))
 
 (define (sendmail-send-it)
   (let ((error-buffer
@@ -416,18 +432,19 @@ and don't delete any header fields."
 	  (let ((header-end (mark-left-inserting-copy (delete-match))))
 	    ;; Delete any blank lines in the header.
 	    (do ((start start (replace-match "\n")))
-		((not (re-search "\n\n+" false start header-end))))
+		((not (re-search-forward "\n\n+" start header-end false))))
 	    (expand-mail-aliases start header-end)
-	    (if (re-search "^FCC:" true start header-end)
+	    (if (re-search-forward "^FCC:" start header-end true)
 		(mail-do-fcc temp-buffer header-end))
 	    ;; If there is a From and no Sender, put in a Sender.
-	    (if (and (re-search "^From:" true start header-end)
-		     (not (re-search "^Sender:" true start header-end)))
+	    (if (and (re-search-forward "^From:" start header-end true)
+		     (not
+		      (re-search-forward "^Sender:" start header-end true)))
 		(begin
 		  (insert-string "\nSender: " header-end)
 		  (insert-string user-name header-end)))
 	    ;; Don't send out a blank subject line.
-	    (if (re-search "^Subject:[ \t]*\n" true start header-end)
+	    (if (re-search-forward "^Subject:[ \t]*\n" start header-end true)
 		(delete-match)))
 	  (apply run-synchronous-process
 		 (make-region start end)
@@ -445,7 +462,7 @@ and don't delete any header fields."
 	  (if error-buffer
 	      (let ((end (buffer-end error-buffer)))
 		(do ((start (buffer-start error-buffer) (replace-match "; ")))
-		    ((not (re-search "\n+ *" false start end)))))))))
+		    ((not (re-search-forward "\n+ *" start end false)))))))))
     (kill-buffer temp-buffer)
     (if error-buffer
 	(let ((errors
@@ -475,7 +492,7 @@ and don't delete any header fields."
       ;;   that "^[>]+From " be quoted in the same transparent way.)
       (let ((m (mark-right-inserting-copy (mark+ start 2))))
 	(do ()
-	    ((not (re-search "^From " false m end)))
+	    ((not (re-search-forward "^From " m end false)))
 	  (move-mark-to! m (re-match-end 0))
 	  (insert-string ">" (re-match-start 0)))
 	(mark-temporary! m))
@@ -492,7 +509,7 @@ and don't delete any header fields."
 (define (digest-fcc-headers start header-end)
   (let ((m (mark-right-inserting-copy start)))
     (let loop ((pathnames '()))
-      (if (re-search "^FCC:[ \t]*\\([^ \t\n]+\\)" true m header-end)
+      (if (re-search-forward "^FCC:[ \t]*\\([^ \t\n]+\\)" m header-end true)
 	  (let ((filename
 		 (extract-string (re-match-start 1) (re-match-end 1))))
 	    (move-mark-to! m (line-start (re-match-start 0) 0))
@@ -502,14 +519,6 @@ and don't delete any header fields."
 	    (mark-temporary! m)
 	    pathnames)))))
 
-(define-integrable (re-search regexp case-fold-search start end)
-  (re-search-buffer-forward (re-compile-pattern regexp case-fold-search)
-			    case-fold-search
-			    false
-			    (mark-group start)
-			    (mark-index start)
-			    (mark-index end)))
-
 (define (guarantee-mail-aliases)
   unspecific)
 
diff --git a/v7/src/edwin/tparse.scm b/v7/src/edwin/tparse.scm
index 18032c8af..67d688d64 100644
--- a/v7/src/edwin/tparse.scm
+++ b/v7/src/edwin/tparse.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tparse.scm,v 1.65 1989/04/28 22:54:02 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tparse.scm,v 1.66 1991/04/23 06:47:27 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -48,27 +48,44 @@
 
 ;;;; Pages
 
+(define (%forward-page start end page-delimiter)
+  (if (not (mark<= start end))
+      (error "Marks incorrectly related:" start end))
+  (and (mark< start end)
+       (or (re-search-forward page-delimiter start end)
+	   end)))
+
+(define (%backward-page end start page-delimiter)
+  (if (not (mark<= start end))
+      (error "Marks incorrectly related:" start end))
+  (and (mark< start end)
+       (if (re-search-backward page-delimiter (mark-1+ end) start)
+	   (re-match-end 0)
+	   start)))
+
+(define (%at-page-delimiter? mark page-delimiter)
+  (re-match-forward page-delimiter (line-start mark 0) mark))
+
 (define-variable page-delimiter
   "Regexp describing line-beginnings that separate pages."
-  "^\f")
+  "^\f"
+  string?)
 
 (define (forward-one-page mark)
-  (and (not (group-end? mark))
-       (or (re-search-forward (ref-variable page-delimiter) mark)
-	   (group-end mark))))
+  (%forward-page mark
+		 (group-end mark)
+		 (mark-local-ref mark (ref-variable-object page-delimiter))))
 
 (define (backward-one-page mark)
-  (and (not (group-start? mark))
-       (if (re-search-backward (ref-variable page-delimiter) (mark-1+ mark))
-	   (re-match-end 0)
-	   (group-start mark))))
+  (%backward-page mark
+		  (group-start mark)
+		  (mark-local-ref mark (ref-variable-object page-delimiter))))
 
 (define (page-start mark)
-  (let ((page-delimiter (ref-variable page-delimiter)))
-    (or (re-match-forward page-delimiter (line-start mark 0))
-	(if (re-search-backward page-delimiter (mark-1+ mark))
-	    (re-match-end 0)
-	    (group-start mark)))))
+  (let ((page-delimiter
+	 (mark-local-ref mark (ref-variable-object page-delimiter))))
+    (or (%at-page-delimiter? mark page-delimiter)
+	(%backward-page mark (group-start mark) page-delimiter))))
 
 (define forward-page)
 (define backward-page)
@@ -80,125 +97,154 @@
 
 ;;;; Paragraphs
 
+(define (%forward-paragraph mark end
+			    fill-prefix paragraph-start paragraph-separate)
+  (if (not (mark<= mark end))
+      (error "Marks incorrectly related:" mark end))
+  (and (mark< mark end)
+       (let ((paragraph-separate
+	      (if fill-prefix
+		  (string-append paragraph-separate "\\|^"
+				 (re-quote-string fill-prefix) "[ \t]*$")
+		  paragraph-separate)))
+
+	 (define (skip-separators m)
+	   (cond ((mark= m end)
+		  false)
+		 ((re-match-forward paragraph-separate m end false)
+		  (let ((m (line-end m 0)))
+		    (and (mark< m end)
+			 (skip-separators (mark1+ m)))))
+		 (else
+		  (let ((m (line-end m 0)))
+		    (cond ((mark>= m end) end)
+			  (fill-prefix (skip-body-prefix m))
+			  (else (skip-body-no-prefix m)))))))
+
+	 (define (skip-body-prefix m)
+	   (if (mark< m end)
+	       (let ((m (mark1+ m)))
+		 (if (or (re-match-forward paragraph-separate m end false)
+			 (not (match-forward fill-prefix m end false)))
+		     m
+		     (skip-body-prefix (line-end m 0))))
+	       end))
+
+	 (define (skip-body-no-prefix m)
+	   (if (re-search-forward paragraph-start m end false)
+	       (re-match-start 0)
+	       end))
+
+	 (skip-separators (line-start mark 0)))))
+
+(define (%backward-paragraph mark start
+			     fill-prefix paragraph-start paragraph-separate)
+  (if (not (mark<= start mark))
+      (error "Marks incorrectly related:" start mark))
+  (and (mark< start mark)
+       (let ((end (group-end mark))
+	     (paragraph-separate
+	      (if fill-prefix
+		  (string-append paragraph-separate "\\|"
+				 (re-quote-string fill-prefix) "[ \t]*$")
+		  paragraph-separate)))
+
+	 (define (skip-separators m)
+	   (cond ((mark> start m)
+		  false)
+		 ((re-match-forward paragraph-separate m end false)
+		  (and (mark< start m)
+		       (skip-separators (line-start (mark-1+ m) 0))))
+		 ((mark= start m)
+		  start)
+		 (fill-prefix
+		  (skip-body-prefix m))
+		 (else
+		  (skip-body-no-prefix m))))
+
+	 (define (skip-body-prefix m)
+	   (if (or (re-match-forward paragraph-separate m end false)
+		   (not (match-forward fill-prefix m end false)))
+	       (adjust-final-position m)
+	       (let ((m (line-start (mark-1+ m) 0)))
+		 (if (mark< start m)
+		     (skip-body-prefix m)
+		     start))))
+
+	 (define (skip-body-no-prefix m)
+	   (let ((m
+		  (re-search-backward paragraph-start (line-end m 0) start 
+				      false)))
+	     (if (not m)
+		 start
+		 (adjust-final-position m))))
+
+	 (define (adjust-final-position m)
+	   (let ((m
+		  (if (re-match-forward paragraph-separate m end false)
+		      (mark1+ (line-end m 0))
+		      m)))
+	     (or (and (mark< start m)
+		      (let ((m (mark-1+ m)))
+			(and (line-start? m)
+			     m)))
+		 m)))
+
+	 (skip-separators (line-start (mark-1+ mark) 0)))))
+
 (define-variable paragraph-start
   "Regexp for beginning of a line that starts OR separates paragraphs."
-  "^[ \t\n]")
+  "^[ \t\n\f]"
+  string?)
 
 (define-variable paragraph-separate
   "Regexp for beginning of a line that separates paragraphs.
-If you change this, you may have to change Paragraph Start also."
-  "^[ \t]*$")
+If you change this, you may have to change paragraph-start also."
+  "^[ \t\f]*$"
+  string?)
 
+(define-variable paragraph-ignore-fill-prefix
+  "True means the paragraph commands are not affected by fill-prefix.
+This is desirable in modes where blank lines are the paragraph delimiters."
+  false
+  boolean?)
+
+(define (forward-one-paragraph mark #!optional end fill-prefix)
+  (%forward-paragraph
+   mark
+   (if (default-object? end)
+       (group-end mark)
+       (begin
+	 (if (not (mark<= mark end))
+	     (error "Marks incorrectly related:" mark end))
+	 end))
+   (if (default-object? fill-prefix)
+       (and (not (mark-local-ref
+		  mark
+		  (ref-variable-object paragraph-ignore-fill-prefix)))
+	    (mark-local-ref mark (ref-variable-object fill-prefix)))
+       fill-prefix)
+   (mark-local-ref mark (ref-variable-object paragraph-start))
+   (mark-local-ref mark (ref-variable-object paragraph-separate))))
+
+(define (backward-one-paragraph mark #!optional start fill-prefix)
+  (%backward-paragraph
+   mark
+   (if (default-object? start)
+       (group-start mark)
+       (begin
+	 (if (not (mark<= start mark))
+	     (error "Marks incorrectly related:" start mark))
+	 start))
+   (if (default-object? fill-prefix)
+       (and (not (mark-local-ref
+		  mark
+		  (ref-variable-object paragraph-ignore-fill-prefix)))
+	    (mark-local-ref mark (ref-variable-object fill-prefix)))
+       fill-prefix)
+   (mark-local-ref mark (ref-variable-object paragraph-start))
+   (mark-local-ref mark (ref-variable-object paragraph-separate))))
 
-(define (forward-one-paragraph mark)
-  (and (not (group-end? mark))
-       (let ((end (group-end mark))
-	     (fill-prefix (ref-variable fill-prefix))
-	     (page-delimiter (ref-variable page-delimiter))
-	     (forward-kernel
-	      (lambda (mark separator? skip-body)
-		(if (separator? (line-start mark 0))
-		    (let ((para-start
-			   (let skip-separators ((mark mark))
-			     (let ((lstart (line-start mark 1)))
-			       (and lstart
-				    (if (separator? lstart)
-					(skip-separators lstart)
-					lstart))))))
-		      (and para-start
-			   (skip-body para-start)))
-		    (skip-body mark)))))
-	 (if (and fill-prefix
-		  (not (string-null? fill-prefix)))
-	     (let ((fill-prefix (re-quote-string fill-prefix)))
-	       (let ((prefix
-		      (string-append page-delimiter "\\|^" fill-prefix)))
-		 (let ((start (string-append prefix "[ \t\n]"))
-		       (separate (string-append prefix "[ \t]*$")))
-		   (forward-kernel mark
-		     (lambda (lstart)
-		       (or (not (re-match-forward fill-prefix lstart))
-			   (re-match-forward separate lstart)))
-		     (letrec ((skip-body
-			       (lambda (mark)
-				 (let ((lstart (line-start mark 1)))
-				   (cond ((not lstart) end)
-					 ((or (not
-					       (re-match-forward fill-prefix
-								 lstart))
-					      (re-match-forward start lstart))
-					  lstart)
-					 (else (skip-body lstart)))))))
-		       skip-body)))))
-	     (let ((prefix (string-append page-delimiter "\\|")))
-	       (let ((start
-		      (string-append prefix (ref-variable paragraph-start)))
-		     (separate
-		      (string-append prefix
-				     (ref-variable paragraph-separate))))
-		 (forward-kernel mark
-		   (lambda (mark)
-		     (re-match-forward separate mark))
-		   (lambda (mark)
-		     (if (re-search-forward start (line-end mark 0) end)
-			 (re-match-start 0)
-			 end)))))))))
-
-(define (backward-one-paragraph mark)
-  (and (not (group-start? mark))
-       (let ((start (group-start mark))
-	     (fill-prefix (ref-variable fill-prefix))
-	     (page-delimiter (ref-variable page-delimiter))
-	     (backward-kernel
-	      (lambda (mark separator? skip-body)
-		(if (separator? (line-start mark 0))
-		    (let ((para-start
-			   (let skip-separators ((mark mark))
-			     (let ((lstart (line-start mark -1)))
-			       (and lstart
-				    (if (separator? lstart)
-					(skip-separators lstart)
-					lstart))))))
-		      (and para-start
-			   (skip-body para-start)))
-		    (skip-body mark)))))
-	 (if (and fill-prefix
-		  (not (string-null? fill-prefix)))
-	     (let ((fill-prefix (re-quote-string fill-prefix)))
-	       (let ((prefix
-		      (string-append page-delimiter "\\|^" fill-prefix)))
-		 (let ((starter (string-append prefix "[ \t\n]"))
-		       (separator (string-append prefix "[ \t]*$")))
-		   (backward-kernel mark
-		     (lambda (lstart)
-		       (or (not (re-match-forward fill-prefix lstart))
-			   (re-match-forward separator lstart)))
-		     (letrec ((skip-body
-			       (lambda (mark)
-				 (let ((lstart (line-start mark -1)))
-				   (cond ((not lstart) start)
-					 ((or (not
-					       (re-match-forward fill-prefix
-								 lstart))
-					      (re-match-forward starter
-								lstart))
-					  lstart)
-					 (else (skip-body lstart)))))))
-		       skip-body)))))
-	     (let ((prefix (string-append page-delimiter "\\|")))
-	       (let ((starter
-		      (string-append prefix (ref-variable paragraph-start)))
-		     (separator
-		      (string-append prefix
-				     (ref-variable paragraph-separate))))
-		 (backward-kernel mark
-		   (lambda (mark)
-		     (re-match-forward separator mark))
-		   (lambda (mark)
-		     (if (re-search-backward starter mark start)
-			 (re-match-start 0)
-			 start)))))))))
-
 (define forward-paragraph)
 (define backward-paragraph)
 (make-motion-pair forward-one-paragraph backward-one-paragraph
@@ -206,7 +252,7 @@ If you change this, you may have to change Paragraph Start also."
     (set! forward-paragraph f)
     (set! backward-paragraph b)
     unspecific))
-
+
 (define (paragraph-text-region mark)
   (let ((end (or (paragraph-text-end mark) (group-end mark))))
     (make-region (or (paragraph-text-start end) (group-start mark)) end)))
@@ -214,15 +260,18 @@ If you change this, you may have to change Paragraph Start also."
 (define (paragraph-text-start mark)
   (let ((start (backward-one-paragraph mark)))
     (and start
-	 (let ((fill-prefix (ref-variable fill-prefix)))
-	   (if (and fill-prefix
-		    (not (string-null? fill-prefix)))
+	 (let ((fill-prefix
+		(mark-local-ref mark (ref-variable-object fill-prefix))))
+	   (if fill-prefix
 	       (if (match-forward fill-prefix start)
 		   start
 		   (line-start start 1))
 	       (let ((start
-		      (if (re-match-forward (ref-variable paragraph-separate)
-					    start)
+		      (if (re-match-forward
+			   (mark-local-ref
+			    mark
+			    (ref-variable-object paragraph-separate))
+			   start)
 			  (line-start start 1)
 			  start)))
 		 (or (skip-chars-forward " \t\n" start mark false)
@@ -246,13 +295,17 @@ If you change this, you may have to change Paragraph Start also."
 (define-variable sentence-end
   "Regexp describing the end of a sentence.
 All paragraph boundaries also end sentences, regardless."
-  "[.?!][]\")]*\\($\\|\t\\|  \\)[ \t\n]*")
+  "[.?!][]\"')}]*\\($\\|\t\\|  \\)[ \t\n]*"
+  string?)
 
 (define (forward-one-sentence mark)
   (let ((end (paragraph-text-end mark)))
     (and end
-	 (let ((mark (re-search-forward (ref-variable sentence-end)
-					mark end)))
+	 (let ((mark
+		(re-search-forward
+		 (mark-local-ref mark (ref-variable-object sentence-end))
+		 mark
+		 end)))
 	   (if mark
 	       (skip-chars-backward " \t\n" mark (re-match-start 0) false)
 	       end)))))
@@ -260,9 +313,12 @@ All paragraph boundaries also end sentences, regardless."
 (define (backward-one-sentence mark)
   (let ((start (paragraph-text-start mark)))
     (and start
-	 (if (re-search-backward (string-append (ref-variable sentence-end)
-						"[^ \t\n]")
-				 mark start)
+	 (if (re-search-backward
+	      (string-append
+	       (mark-local-ref mark (ref-variable-object sentence-end))
+	       "[^ \t\n]")
+	      mark
+	      start)
 	     (mark-1+ (re-match-end 0))
 	     start))))