Add detection and handling of file supercession threats.

diff --git a/v7/src/edwin/basic.scm b/v7/src/edwin/basic.scm
index 79655ffc6d485b09716f7b34b5d79dbdb134fc9b..ee95de4c9032b7743497d8d1262e1cb44955b168 100644 (file)
--- a/v7/src/edwin/basic.scm
+++ b/v7/src/edwin/basic.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.111 1991/05/14 02:26:19 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.112 1991/05/16 21:21:07 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -212,6 +212,26 @@ For more information type the HELP key while entering the name."
 (define (barf-if-read-only)
   (editor-error "Trying to modify read only text."))
 
+(define (check-first-group-modification group)
+  (let ((buffer (group-buffer group)))
+    (if (and buffer
+            (buffer-truename buffer)
+            (buffer-modification-time buffer)
+            (not (verify-visited-file-modification-time? buffer)))
+       (ask-user-about-supercession-threat buffer))))
+
+(define (ask-user-about-supercession-threat buffer)
+  (if (not
+       (with-selected-buffer buffer
+        (lambda ()
+          (prompt-for-confirmation?
+           "File has changed on disk; really want to edit the buffer"))))
+      (editor-error "File changed on disk: "
+                   (pathname->string (buffer-pathname buffer))))
+  (message
+   "File on disk now will become a backup file if you save these changes.")
+  (set-buffer-backed-up?! buffer false))
+
 (define (editor-failure . strings)
   (cond ((not (null? strings)) (apply temporary-message strings))
        (*defining-keyboard-macro?* (clear-message)))

diff --git a/v7/src/edwin/grpops.scm b/v7/src/edwin/grpops.scm
index 7bbdf0a4019b2e119efa7d047aace501d4f95ab9..e1bb9f76531fa4bb8d0f4ad4ecd95cad46354ffc 100644 (file)
--- a/v7/src/edwin/grpops.scm
+++ b/v7/src/edwin/grpops.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/grpops.scm,v 1.13 1991/04/24 00:54:21 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/grpops.scm,v 1.14 1991/05/16 21:20:53 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -106,6 +106,7 @@
 
 (define-integrable (%group-insert-char! group index char)
   (if (group-read-only? group) (barf-if-read-only))
+  (if (not (group-modified? group)) (check-first-group-modification group))
   (move-gap-to! group index)
   (guarantee-gap-length! group 1)
   (let ((gap-start* (fix:1+ index)))
@@ -132,6 +133,7 @@
 
 (define-integrable (%group-insert-substring! group index string start end)
   (if (group-read-only? group) (barf-if-read-only))
+  (if (not (group-modified? group)) (check-first-group-modification group))
   (move-gap-to! group index)
   (let ((n (fix:- end start)))
     (guarantee-gap-length! group n)
@@ -164,6 +166,8 @@
      (if (not (fix:= start end))
         (begin
           (if (group-read-only? group) (barf-if-read-only))
+          (if (not (group-modified? group))
+              (check-first-group-modification group))
           ;; Guarantee that the gap is between START and END.
           (let ((gap-start (group-gap-start group)))
             (cond ((fix:< gap-start start) (move-gap-to-right! group start))