From: Arthur Gleckler <edu/mit/csail/zurich/arthur>
Date: Fri, 16 Aug 1991 20:29:22 +0000 (+0000)
Subject: Make REGION-CLIP! guarantee that the point is in the narrowed region.
X-Git-Tag: 20090517-FFI~10351
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b33474ac99fd1293bfdb7a56a14ac1689646758c;p=mit-scheme.git

Make REGION-CLIP! guarantee that the point is in the narrowed region.
---

diff --git a/v7/src/edwin/regops.scm b/v7/src/edwin/regops.scm
index 40aa9d3f8..eca342793 100644
--- a/v7/src/edwin/regops.scm
+++ b/v7/src/edwin/regops.scm
@@ -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
 ;;;
@@ -130,9 +130,21 @@
   (%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))