From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 16 May 1991 21:21:07 +0000 (+0000)
Subject: Add detection and handling of file supercession threats.
X-Git-Tag: 20090517-FFI~10568
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f356cd7a5914f409d9671510b939983327716d81;p=mit-scheme.git

Add detection and handling of file supercession threats.
---

diff --git a/v7/src/edwin/basic.scm b/v7/src/edwin/basic.scm
index 79655ffc6..ee95de4c9 100644
--- 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 7bbdf0a40..e1bb9f765 100644
--- 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))