From 650df475650e27c0bf1e724400c56c5cddd66ddc Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 13 Aug 1993 23:20:57 +0000
Subject: [PATCH] Alter WITH-READ-ONLY-DEFEATED so that it defeats read-only
 intervals within the group.  Additionally, eliminate several instances of
 GROUP-INDEX: variables to make later transition away from
 DEFINE-NAMED-STRUCTURE easier.

---
 v7/src/edwin/buffer.scm | 22 ++++++--------
 v7/src/edwin/fileio.scm |  4 +--
 v7/src/edwin/grpops.scm |  6 ++--
 v7/src/edwin/regops.scm | 12 ++++----
 v7/src/edwin/rmail.scm  | 22 +++++++-------
 v7/src/edwin/struct.scm | 67 +++++++++++++++++++++++++++--------------
 v7/src/edwin/txtprp.scm |  6 ++--
 7 files changed, 79 insertions(+), 60 deletions(-)

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index d2e5f9fae..7b83193b3 100644
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: buffer.scm,v 1.162 1993/08/10 23:28:12 cph Exp $
+;;;	$Id: buffer.scm,v 1.163 1993/08/13 23:20:09 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -261,7 +261,7 @@ The buffer is guaranteed to be deselected at that time."
      (let ((group (buffer-group buffer)))
        (if (group-modified? group)
 	   (begin
-	     (set-group-modified! group false)
+	     (set-group-modified?! group false)
 	     (buffer-modeline-event! buffer 'BUFFER-MODIFIED)
 	     (vector-set! buffer buffer-index:auto-saved? false)))))))
 
@@ -271,12 +271,12 @@ The buffer is guaranteed to be deselected at that time."
      (let ((group (buffer-group buffer)))
        (if (not (group-modified? group))
 	   (begin
-	     (set-group-modified! group true)
+	     (set-group-modified?! group true)
 	     (buffer-modeline-event! buffer 'BUFFER-MODIFIED)))))))
 
 (define (set-buffer-auto-saved! buffer)
   (vector-set! buffer buffer-index:auto-saved? true)
-  (set-group-modified! (buffer-group buffer) 'AUTO-SAVED))
+  (set-group-modified?! (buffer-group buffer) 'AUTO-SAVED))
 
 (define-integrable (buffer-auto-save-modified? buffer)
   (eq? true (group-modified? (buffer-group buffer))))
@@ -303,18 +303,14 @@ The buffer is guaranteed to be deselected at that time."
 (define (with-read-only-defeated mark thunk)
   (let ((group (mark-group mark))
 	(outside)
-	(inside false))
+	(inside 'FULLY))
     (dynamic-wind (lambda ()
-		    (set! outside (group-read-only? group))
-		    (if inside
-			(set-group-read-only! group)
-			(set-group-writable! group)))
+		    (set! outside (group-writable? group))
+		    (set-group-writable?! group inside))
 		  thunk
 		  (lambda ()
-		    (set! inside (group-read-only? group))
-		    (if outside
-			(set-group-read-only! group)
-			(set-group-writable! group))))))
+		    (set! inside (group-writable? group))
+		    (set-group-writable?! group outside)))))
 
 ;;;; Local Bindings
 
diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index 110f2248a..2876e1027 100644
--- a/v7/src/edwin/fileio.scm
+++ b/v7/src/edwin/fileio.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: fileio.scm,v 1.118 1993/08/10 06:41:16 cph Exp $
+;;;	$Id: fileio.scm,v 1.119 1993/08/13 23:20:57 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-1993 Massachusetts Institute of Technology
 ;;;
@@ -53,7 +53,7 @@
   (let ((truename false)
 	(file-error false))
     ;; Set modified so that file supercession check isn't done.
-    (set-group-modified! (buffer-group buffer) true)
+    (set-group-modified?! (buffer-group buffer) true)
     (region-delete! (buffer-unclipped-region buffer))
     (call-with-current-continuation
      (lambda (continuation)
diff --git a/v7/src/edwin/grpops.scm b/v7/src/edwin/grpops.scm
index c166ac241..14d394e73 100644
--- a/v7/src/edwin/grpops.scm
+++ b/v7/src/edwin/grpops.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: grpops.scm,v 1.20 1993/08/10 23:36:03 cph Exp $
+;;;	$Id: grpops.scm,v 1.21 1993/08/13 23:20:39 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -183,7 +183,7 @@
 	       (fix:+ (group-modified-tick group) 1))
   (undo-record-insertion! group index (fix:+ index n))
   ;; The MODIFIED? bit must be set *after* the undo recording.
-  (set-group-modified! group true)
+  (set-group-modified?! group true)
   (if (group-text-properties group)
       (update-intervals-for-insertion! group index n)))
 
@@ -258,7 +258,7 @@
 	(vector-set! group group-index:modified-tick
 		     (fix:+ (group-modified-tick group) 1))
 	;; The MODIFIED? bit must be set *after* the undo recording.
-	(set-group-modified! group true)
+	(set-group-modified?! group true)
 	(if (group-text-properties group)
 	    (update-intervals-for-deletion! group start end))
 	(set-interrupt-enables! interrupt-mask)
diff --git a/v7/src/edwin/regops.scm b/v7/src/edwin/regops.scm
index fe00534fb..b1eb9c8ed 100644
--- a/v7/src/edwin/regops.scm
+++ b/v7/src/edwin/regops.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regops.scm,v 1.85 1992/02/04 04:03:52 cph Exp $
+;;;	$Id: regops.scm,v 1.86 1993/08/13 23:20:45 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -117,10 +117,10 @@
 (define (%group-narrow! group start end)
   (let ((start (make-permanent-mark group start false))
 	(end (make-permanent-mark group end true)))
-    (vector-set! group group-index:start-mark start)
-    (vector-set! group group-index:end-mark end)
-    (vector-set! group group-index:display-start start)
-    (vector-set! group group-index:display-end end)))
+    (set-group-start-mark! group start)
+    (set-group-end-mark! group end)
+    (set-group-display-start! group start)
+    (set-group-display-end! group end)))
 
 (define (group-widen! group)
   (record-clipping! group 0 (group-length group))
diff --git a/v7/src/edwin/rmail.scm b/v7/src/edwin/rmail.scm
index a4b50a7d8..365af1c89 100644
--- a/v7/src/edwin/rmail.scm
+++ b/v7/src/edwin/rmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: rmail.scm,v 1.27 1993/01/12 19:05:06 gjr Exp $
+;;;	$Id: rmail.scm,v 1.28 1993/08/13 23:20:16 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991-1993 Massachusetts Institute of Technology
 ;;;
@@ -1971,27 +1971,27 @@ Leaves original message, deleted, before the undigestified messages."
   (with-group-undo-disabled (buffer-group buffer) thunk))
 
 (define (with-group-open group thunk)
-  (let ((outside-ro)
-	(inside-ro false)
+  (let ((outside-writable)
+	(inside-writable 'FULLY)
 	(outside-start)
 	(outside-end)
 	(inside-start (mark-permanent! (group-absolute-start group)))
 	(inside-end (mark-permanent! (group-absolute-end group))))
     (unwind-protect (lambda ()
-		      (set! outside-ro (group-read-only? group))
+		      (set! outside-writable (group-writable? group))
 		      (set! outside-start (group-start-mark group))
 		      (set! outside-end (group-end-mark group))
-		      (vector-set! group group-index:read-only? inside-ro)
-		      (vector-set! group group-index:start-mark inside-start)
-		      (vector-set! group group-index:end-mark inside-end))
+		      (set-group-writable?! group inside-writable)
+		      (set-group-start-mark! group inside-start)
+		      (set-group-end-mark! group inside-end))
 		    thunk
 		    (lambda ()
-		      (set! inside-ro (group-read-only? group))
+		      (set! inside-writable (group-writable? group))
 		      (set! inside-start (group-start-mark group))
 		      (set! inside-end (group-end-mark group))
-		      (vector-set! group group-index:read-only? outside-ro)
-		      (vector-set! group group-index:start-mark outside-start)
-		      (vector-set! group group-index:end-mark outside-end)))))
+		      (set-group-writable?! group outside-writable)
+		      (set-group-start-mark! group outside-start)
+		      (set-group-end-mark! group outside-end)))))
 
 ;;;; Constants
 
diff --git a/v7/src/edwin/struct.scm b/v7/src/edwin/struct.scm
index 6ccfe2c06..69236bf1a 100644
--- a/v7/src/edwin/struct.scm
+++ b/v7/src/edwin/struct.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: struct.scm,v 1.86 1993/08/09 19:15:15 jawilson Exp $
+;;;	$Id: struct.scm,v 1.87 1993/08/13 23:19:57 cph Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -96,7 +96,7 @@
   marks
   start-mark
   end-mark
-  read-only?
+  writable?
   display-start
   display-end
   start-changes-index
@@ -110,6 +110,42 @@
   shrink-length
   text-properties)
 
+(define-integrable (set-group-marks! group marks)
+  (vector-set! group group-index:marks marks))
+
+(define-integrable (set-group-start-mark! group start)
+  (vector-set! group group-index:start-mark start))
+
+(define-integrable (set-group-end-mark! group end)
+  (vector-set! group group-index:end-mark end))
+
+(define-integrable (set-group-writable?! group writable?)
+  (vector-set! group group-index:writable? writable?))
+
+(define-integrable (set-group-display-start! group start)
+  (vector-set! group group-index:display-start start))
+
+(define-integrable (set-group-display-end! group end)
+  (vector-set! group group-index:display-end end))
+
+(define-integrable (set-group-start-changes-index! group start)
+  (vector-set! group group-index:start-changes-index start))
+
+(define-integrable (set-group-end-changes-index! group end)
+  (vector-set! group group-index:end-changes-index end))
+
+(define-integrable (set-group-modified-tick! group tick)
+  (vector-set! group group-index:modified-tick tick))
+
+(define-integrable (set-group-undo-data! group undo-data)
+  (vector-set! group group-index:undo-data undo-data))
+
+(define-integrable (set-group-modified?! group sense)
+  (vector-set! group group-index:modified? sense))
+
+(define-integrable (set-group-text-properties! group properties)
+  (vector-set! group group-index:text-properties properties))
+
 (define (make-group buffer)
   (let ((group (%make-group)))
     (vector-set! group group-index:text (string-allocate 0))
@@ -123,7 +159,7 @@
     (let ((end (make-permanent-mark group 0 true)))
       (vector-set! group group-index:end-mark end)
       (vector-set! group group-index:display-end end))
-    (vector-set! group group-index:read-only? false)
+    (vector-set! group group-index:writable? false)
     (vector-set! group group-index:start-changes-index false)
     (vector-set! group group-index:end-changes-index false)
     (vector-set! group group-index:modified-tick 0)
@@ -163,23 +199,14 @@
 (define-integrable (group-display-end-index? group index)
   (fix:>= index (group-display-end-index group)))
 
-(define-integrable (set-group-read-only! group)
-  (vector-set! group group-index:read-only? true))
-
 (define-integrable (set-group-writable! group)
-  (vector-set! group group-index:read-only? false))
-
-(define-integrable (set-group-start-changes-index! group start)
-  (vector-set! group group-index:start-changes-index start))
-
-(define-integrable (set-group-end-changes-index! group end)
-  (vector-set! group group-index:end-changes-index end))
+  (set-group-writable?! group #t))
 
-(define-integrable (set-group-marks! group marks)
-  (vector-set! group group-index:marks marks))
+(define-integrable (set-group-read-only! group)
+  (set-group-writable?! group #f))
 
-(define-integrable (set-group-text-properties! group properties)
-  (vector-set! group group-index:text-properties properties))
+(define-integrable (group-read-only? group)
+  (not (group-writable? group)))
 
 (define (group-region group)
   (%make-region (group-start-mark group) (group-end-mark group)))
@@ -209,12 +236,6 @@
 	(else
 	 (group-gap-start group))))
 
-(define-integrable (set-group-undo-data! group undo-data)
-  (vector-set! group group-index:undo-data undo-data))
-
-(define-integrable (set-group-modified! group sense)
-  (vector-set! group group-index:modified? sense))
-
 (define-integrable (set-group-point! group point)
   (vector-set! group group-index:point (mark-left-inserting-copy point)))
 
diff --git a/v7/src/edwin/txtprp.scm b/v7/src/edwin/txtprp.scm
index d0e676127..d2090fa6e 100644
--- a/v7/src/edwin/txtprp.scm
+++ b/v7/src/edwin/txtprp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: txtprp.scm,v 1.4 1993/08/13 11:17:59 jawilson Exp $
+;;;	$Id: txtprp.scm,v 1.5 1993/08/13 23:20:31 cph Exp $
 ;;;
 ;;;	Copyright (c) 1993 Massachusetts Institute of Technology
 ;;;
@@ -108,7 +108,7 @@
   (if p
       (begin
 	(undo-record-property-changes! group p)
-	(set-group-modified! group true)
+	(set-group-modified?! group true)
 	(vector-set! group group-index:modified-tick
 		     (fix:+ (group-modified-tick group) 1))
 	true)
@@ -209,6 +209,7 @@
 	      (or (not root)
 		  (fix:= start 0)
 		  (fix:= start (interval-total-length root)))))
+       (not (eq? 'FULLY (group-writable? group)))
        (let ((interval (find-interval group start)))
 	 (let ((datum (interval-property interval 'READ-ONLY)))
 	   (and datum
@@ -249,6 +250,7 @@
 ;; export
 (define (text-not-deleteable? group start end)
   (and (group-text-properties group)
+       (not (eq? 'FULLY (group-writable? group)))
        (let loop ((interval (find-interval group start)))
 	 (or (interval-property interval 'READ-ONLY)
 	     (let ((next (next-interval interval)))
-- 
2.25.1