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.

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index d2e5f9fae723de9e70802de9f725a3cd012e3507..7b83193b3c950e12b4922c3a91fe63d2bd03d16f 100644 (file)
--- 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)))))
 \f
 ;;;; Local Bindings
 

diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index 110f2248a9b4b64b8b8d3082bc5f7ae0740bdfbc..2876e1027a94611e97607e596638c2e6f65491e3 100644 (file)
--- 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 c166ac241eddfa120e435fec0b168be0772e8d15..14d394e738d2c7fc1129e628213926f302c051b5 100644 (file)
--- 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)))
 \f
@@ -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 fe00534fb9ce6cbd62971c830a3896be6c7319f3..b1eb9c8edcb81631f1de09aa929a70de8267f41c 100644 (file)
--- 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 a4b50a7d823167110c11a71e7ceecd54cedfddc8..365af1c89abc0446a03ebdfbff8664b08e0d47aa 100644 (file)
--- 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)))))
 \f
 ;;;; Constants
 

diff --git a/v7/src/edwin/struct.scm b/v7/src/edwin/struct.scm
index 6ccfe2c0608fdfd1cb4937e67c7179f43add8c07..69236bf1a75987a511aa85cc0bb10226137ebeca 100644 (file)
--- 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))
+\f
 (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)))
 \f
-(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 d0e676127291eead567959338b6407f8731b5207..d2090fa6edb47f2df5f7e8ba3bf5410368f4519e 100644 (file)
--- 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)))