Complete rewrite of the paragraph parsing code. The handling of the

fill-prefix is no longer like the Emacs implementation, but rather
matches the Emacs manual: when the fill-prefix is in effect, only
lines containing the prefix are considered to be part of a paragraph
-- all other lines are ignored.

diff --git a/v7/src/edwin/fill.scm b/v7/src/edwin/fill.scm
index edd5878afac89f6c8adc80abce97b3ca87e7dea3..531c3652c8b2437ffa4a744daa39b3a662de9e7a 100644 (file)
--- a/v7/src/edwin/fill.scm
+++ b/v7/src/edwin/fill.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fill.scm,v 1.52 1992/01/01 02:18:28 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fill.scm,v 1.53 1992/02/04 03:42:15 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -89,8 +89,10 @@ and reinserts the fill prefix in each resulting line."
 Prefix arg means justify as well."
   "d\nP"
   (lambda (point justify?)
-    ((ref-command fill-region-as-paragraph) (paragraph-text-region point)
-                                           justify?)))
+    (let ((region (paragraph-text-region point)))
+      (if (not region)
+         (editor-error))
+      ((ref-command fill-region-as-paragraph) region justify?))))
 
 (define-command fill-region-as-paragraph
   "Fill region as one paragraph: break lines to fit fill-column.

diff --git a/v7/src/edwin/texcom.scm b/v7/src/edwin/texcom.scm
index e9a94ce01a545d9e0d720c307137122c85c05ff8..ae43d20ebcbe0dcb1c8157683ec6d9c79362c2ba 100644 (file)
--- a/v7/src/edwin/texcom.scm
+++ b/v7/src/edwin/texcom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/texcom.scm,v 1.34 1991/11/21 10:38:27 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/texcom.scm,v 1.35 1992/02/04 03:37:17 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -194,40 +194,40 @@ treated as a regular expression.  Also, every paragraph boundary
 terminates sentences as well."
   "p"
   (lambda (argument)
-    (move-thing forward-sentence argument 'FAILURE)))
+    (move-thing forward-sentence argument 'ERROR)))
 
 (define-command backward-sentence
   "Move backward to start of sentence.  With arg, do it arg times.
 See \\[forward-sentence] for more information."
   "p"
   (lambda (argument)
-    (move-thing backward-sentence argument 'FAILURE)))
+    (move-thing backward-sentence argument 'ERROR)))
 
 (define-command kill-sentence
   "Kill from point to end of sentence.
 With arg, repeat, or backward if negative arg."
   "p"
   (lambda (argument)
-    (kill-thing forward-sentence argument 'FAILURE)))
+    (kill-thing forward-sentence argument 'ERROR)))
 
 (define-command backward-kill-sentence
   "Kill back from point to start of sentence.
 With arg, repeat, or forward if negative arg."
   "p"
   (lambda (argument)
-    (kill-thing backward-sentence argument 'FAILURE)))
-\f
+    (kill-thing backward-sentence argument 'ERROR)))
+
 ;;;; Paragraphs
 
 (define-command forward-paragraph
   "Move forward to end of paragraph.  With arg, do it arg times.
-A line which  paragraph-start  matches either separates paragraphs
-\(if  paragraph-separate  matches it also) or is the first line of a paragraph.
+A line which `paragraph-start' matches either separates paragraphs
+\(if `paragraph-separate' matches it also) or is the first line of a paragraph.
 A paragraph end is the beginning of a line which is not part of the paragraph
 to which the end of the previous line belongs, or the end of the buffer."
   "p"
   (lambda (argument)
-    (move-thing forward-paragraph argument 'FAILURE)))
+    (move-thing forward-paragraph argument 'ERROR)))
 
 (define-command backward-paragraph
   "Move backward to start of paragraph.  With arg, do it arg times.
@@ -238,7 +238,7 @@ the paragraph starts at that blank line.
 See forward-paragraph for more information."
   "p"
   (lambda (argument)
-    (move-thing backward-paragraph argument 'FAILURE)))
+    (move-thing backward-paragraph argument 'ERROR)))
 
 (define-command mark-paragraph
   "Put point at beginning of this paragraph, mark at end."

diff --git a/v7/src/edwin/tparse.scm b/v7/src/edwin/tparse.scm
index 67d688d6448e75c4534ea8a680fae5523233e6e3..9e4aa8e074b0ebf8e7a24c3d9d32a3a77bdf79b4 100644 (file)
--- 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.66 1991/04/23 06:47:27 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tparse.scm,v 1.67 1992/02/04 03:35:39 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -97,101 +97,6 @@
 \f
 ;;;; 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)))))
-\f
-(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)))))
-\f
 (define-variable paragraph-start
   "Regexp for beginning of a line that starts OR separates paragraphs."
   "^[ \t\n\f]"
@@ -209,41 +114,54 @@ 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-integrable (mark/paragraph-start mark)
+  (mark-local-ref mark (ref-variable-object paragraph-start)))
+
+(define-integrable (mark/paragraph-separate mark)
+  (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 (mark/paragraph-fill-prefix mark)
+  (if (mark-local-ref mark (ref-variable-object paragraph-ignore-fill-prefix))
+      false
+      (mark-local-ref mark (ref-variable-object fill-prefix))))
+
+(define (forward-one-paragraph mark #!optional limit fill-prefix
+                              finish-on-separator?)
+  (%forward-paragraph mark
+                     (if (default-object? limit)
+                         (group-end mark)
+                         (begin
+                           (if (not (mark<= mark limit))
+                               (error "Marks incorrectly related:"
+                                      mark limit))
+                           limit))
+                     (if (default-object? fill-prefix)
+                         (mark/paragraph-fill-prefix mark)
+                         fill-prefix)
+                     (mark/paragraph-start mark)
+                     (mark/paragraph-separate mark)
+                     (if (default-object? finish-on-separator?)
+                         true
+                         finish-on-separator?)))
+
+(define (backward-one-paragraph mark #!optional limit fill-prefix
+                               finish-on-separator?)
+  (%backward-paragraph mark
+                      (if (default-object? limit)
+                          (group-start mark)
+                          (begin
+                            (if (not (mark<= limit mark))
+                                (error "Marks incorrectly related:"
+                                       limit mark))
+                            limit))
+                      (if (default-object? fill-prefix)
+                          (mark/paragraph-fill-prefix mark)
+                          fill-prefix)
+                      (mark/paragraph-start mark)
+                      (mark/paragraph-separate mark)
+                      (if (default-object? finish-on-separator?)
+                          true
+                          finish-on-separator?)))
 
 (define forward-paragraph)
 (define backward-paragraph)
@@ -254,41 +172,154 @@ This is desirable in modes where blank lines are the paragraph delimiters."
     unspecific))
 \f
 (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)))
+  (let ((end (paragraph-text-end mark)))
+    (and end
+        (let ((start (paragraph-text-start end)))
+          (and start
+               (make-region start end))))))
 
 (define (paragraph-text-start mark)
-  (let ((start (backward-one-paragraph mark)))
-    (and start
-        (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
-                          (mark-local-ref
-                           mark
-                           (ref-variable-object paragraph-separate))
-                          start)
-                         (line-start start 1)
-                         start)))
-                (or (skip-chars-forward " \t\n" start mark false)
-                    (if (group-start? start)
-                        start
-                        (paragraph-text-start start)))))))))
+  (%backward-paragraph mark
+                      (group-start mark)
+                      (mark/paragraph-fill-prefix mark)
+                      (mark/paragraph-start mark)
+                      (mark/paragraph-separate mark)
+                      false))
 
 (define (paragraph-text-end mark)
-  (let ((end (forward-one-paragraph mark)))
-    (and end
-        (let ((mark* (if (line-start? end) (mark-1+ end) end)))
-          (if (mark>= mark* mark)
-              mark*
-              (let ((mark* (mark1+ mark*)))
-                (if (group-end? mark*)
-                    mark*
-                    (paragraph-text-end mark*))))))))
+  (%forward-paragraph mark
+                     (group-end mark)
+                     (mark/paragraph-fill-prefix mark)
+                     (mark/paragraph-start mark)
+                     (mark/paragraph-separate mark)
+                     false))
+
+(define (%forward-paragraph mark limit fill-prefix para-start para-separate
+                           finish-on-separator?)
+  (if (not (mark<= mark limit))
+      (error "Marks incorrectly related:" mark limit))
+  (and (mark< mark limit)
+       (let ((end (group-end mark))
+            (next-ls
+             (lambda (ls)
+               (let ((le (line-end ls 0)))
+                 (if (mark< le limit)
+                     (mark1+ le)
+                     limit)))))
+        (let ((separator?
+               (if fill-prefix
+                   (lambda (ls)
+                     (let ((fp (match-forward fill-prefix ls end false)))
+                       (if fp
+                           (re-match-forward "[ \t]*$" fp end false)
+                           true)))
+                   (lambda (ls)
+                     (re-match-forward para-separate ls end false)))))
+          (letrec
+              ((skip-separators
+                (lambda (ls)
+                  (cond ((mark= ls limit)
+                         false)
+                        ((separator? ls)
+                         (skip-separators (next-ls ls)))
+                        (else
+                         (skip-body ls)))))
+               (skip-body
+                (if fill-prefix
+                    (lambda (ls)
+                      (let ((ls (next-ls ls)))
+                        (if (or (mark= ls limit)
+                                (separator? ls))
+                            (finish ls)
+                            (skip-body ls))))
+                    (lambda (ls)
+                      (let ((le (line-end ls 0)))
+                        (if (and (mark< le limit)
+                                 (re-search-forward para-start le limit
+                                                    false))
+                            (finish (re-match-start 0))
+                            limit)))))
+               (finish
+                (lambda (ls)
+                  (if (or finish-on-separator? (not (line-start? ls)))
+                      ls
+                      (let ((le (mark-1+ ls)))
+                        (if (mark< mark le)
+                            le
+                            (skip-separators ls)))))))
+            (if (or (line-end? mark) (separator? (line-start mark 0)))
+                (skip-separators (next-ls mark))
+                (skip-body mark)))))))
+\f
+(define (%backward-paragraph mark limit fill-prefix para-start para-separate
+                            finish-on-separator?)
+  (if (not (mark<= limit mark))
+      (error "Marks incorrectly related:" limit mark))
+  (and (mark< limit mark)
+       (let ((prev-ls
+             (lambda (ls)
+               (let ((ls (line-start ls -1 'LIMIT)))
+                 (if (mark< ls limit)
+                     limit
+                     ls))))
+            (end (group-end mark)))
+        (let ((separator?
+               (if fill-prefix
+                   (lambda (ls)
+                     (let ((fp (match-forward fill-prefix ls end false)))
+                       (if fp
+                           (re-match-forward "[ \t]*$" fp end false)
+                           true)))
+                   (lambda (ls)
+                     (re-match-forward para-separate ls end false)))))
+          (letrec ((skip-separators
+                    (lambda (ls)
+                      (and (mark< limit ls)
+                           (let ((ls (prev-ls ls)))
+                             (cond ((separator? ls)
+                                    (skip-separators ls))
+                                   ((mark= ls limit)
+                                    ls)
+                                   (else
+                                    (skip-body ls)))))))
+                   (skip-body
+                    (if fill-prefix
+                        (lambda (ls)
+                          (let ((ls* (prev-ls ls)))
+                            (if (separator? ls*)
+                                (if finish-on-separator?
+                                    ls*
+                                    ls)
+                                (skip-body ls*))))
+                        (lambda (ls)
+                          (let ((ps
+                                 (re-search-backward para-start
+                                                     (line-end ls 0)
+                                                     limit
+                                                     false)))
+                            (cond ((not ps)
+                                   limit)
+                                  (finish-on-separator?
+                                   (if (separator? ps)
+                                       ps
+                                       (let ((ls (prev-ls ps)))
+                                         (if (separator? ls)
+                                             ls
+                                             ps))))
+                                  (else
+                                   (if (separator? ps)
+                                       (line-start ps 1)
+                                       ps))))))))
+            (if (line-start? mark)
+                (skip-separators mark)
+                (let ((ls (line-start mark 0)))
+                  (and (mark<= limit ls)
+                       (cond ((separator? ls)
+                              (skip-separators ls))
+                             ((mark= limit ls)
+                              ls)
+                             (else
+                              (skip-body ls)))))))))))
 \f
 ;;;; Sentences
 
@@ -298,29 +329,40 @@ All paragraph boundaries also end sentences, regardless."
   "[.?!][]\"')}]*\\($\\|\t\\|  \\)[ \t\n]*"
   string?)
 
+(define-integrable (mark/sentence-end mark)
+  (mark-local-ref mark (ref-variable-object sentence-end)))
+
 (define (forward-one-sentence mark)
-  (let ((end (paragraph-text-end mark)))
-    (and 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)))))
+  (let ((para-end
+        (let loop ((mark mark))
+          (let ((end (paragraph-text-end mark)))
+            (and end
+                 (let ((end* (horizontal-space-start end)))
+                   (if (mark< mark end*)
+                       end*
+                       (loop end))))))))
+    (let ((mark
+          (re-search-forward (mark/sentence-end mark)
+                             mark
+                             (or para-end (group-end mark)))))
+      (if mark
+         (skip-chars-backward " \t\n" mark (re-match-start 0) false)
+         para-end))))
 
 (define (backward-one-sentence mark)
-  (let ((start (paragraph-text-start mark)))
-    (and 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))))
+  (let ((para-start
+        (let loop ((mark mark))
+          (let ((start (paragraph-text-start mark)))
+            (and start
+                 (let ((start* (horizontal-space-end start)))
+                   (if (mark< start* mark)
+                       start*
+                       (loop start))))))))
+    (if (re-search-backward (string-append (mark/sentence-end mark) "[^ \t\n]")
+                           mark
+                           (or para-start (group-start mark)))
+       (mark-1+ (re-match-end 0))
+       para-start)))
 
 (define forward-sentence)
 (define backward-sentence)