Make REGION-CLIP! guarantee that the point is in the narrowed region.
authorArthur Gleckler <edu/mit/csail/zurich/arthur>
Fri, 16 Aug 1991 20:29:22 +0000 (20:29 +0000)
committerArthur Gleckler <edu/mit/csail/zurich/arthur>
Fri, 16 Aug 1991 20:29:22 +0000 (20:29 +0000)
v7/src/edwin/regops.scm

index 40aa9d3f812ac87db61944298944dc4af9998c75..eca342793abeecab5e8c92765ede0d9bf4db1056 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regops.scm,v 1.83 1991/04/24 00:41:34 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regops.scm,v 1.84 1991/08/16 20:29:22 arthur Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
   (%group-narrow! group 0 (group-length group)))
 
 (define (region-clip! region)
-  (group-narrow! (region-group region)
-                (region-start-index region)
-                (region-end-index region)))
+  (let ((group (region-group region))
+       (start (region-start region))
+       (end (region-end region)))
+    (let ((point (group-point group)))
+      (cond ((mark< point start) (set-group-point! group start))
+           ((mark> point end) (set-group-point! group end))))
+    (let ((buffer (group-buffer group)))
+      (if buffer
+         (for-each
+          (lambda (window)
+            (let ((point (window-point window)))
+              (cond ((mark< point start) (set-window-point! window start))
+                    ((mark> point end) (set-window-point! window end)))))
+          (buffer-windows buffer))))
+    (group-narrow! group (mark-index start) (mark-index end))))
 
 (define (with-region-clipped! new-region thunk)
   (let ((group (region-group new-region))