Change `find-file' and friends to check file-modification-time when a

buffer already exists for that file, and offer to revert the buffer if
the time is not consistent.

diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index 678601c22a003285bfa7776b5017430abdd2424e..ad68aa19c79cffd1de786b6b59635b798c86f547 100644 (file)
--- a/v7/src/edwin/filcom.scm
+++ b/v7/src/edwin/filcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.134 1989/04/20 08:14:57 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.135 1989/04/26 18:49:35 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -42,17 +42,32 @@
 (declare (usual-integrations))
 \f
 (define (find-file filename)
-  (select-buffer (find-file-noselect filename)))
+  (select-buffer (find-file-noselect filename true)))
 
 (define (find-file-other-window filename)
-  (select-buffer-other-window (find-file-noselect filename)))
+  (select-buffer-other-window (find-file-noselect filename true)))
 
-(define (find-file-noselect filename)
+(define (find-file-noselect filename warn?)
   (let ((pathname (pathname->absolute-pathname (->pathname filename))))
     (if (file-directory? pathname)
        (make-dired-buffer (pathname-as-directory pathname))
        (let ((buffer (pathname->buffer pathname)))
-         (or buffer
+         (if buffer
+             (begin
+               (if (and warn?
+                        (not (verify-visited-file-modification-time? buffer)))
+                   (cond ((not (file-exists? pathname))
+                          (editor-error "File "
+                                        (pathname->string pathname)
+                                        " no longer exists!"))
+                         ((prompt-for-yes-or-no?
+                           (string-append
+                            "File has changed since last visited or saved.  "
+                            (if (buffer-modified? buffer)
+                                "Flush your changes"
+                                "Read from disk")))
+                          (revert-buffer buffer true true))))
+               buffer)
              (let ((buffer (new-buffer (pathname->buffer-name pathname))))
                (after-find-file
                 buffer
@@ -152,9 +167,9 @@ Like \\[kill-buffer] followed by \\[find-file]."
            (save-buffer-prepare-version buffer)
            (set-visited-pathname buffer
                                  (prompt-for-pathname
-                                  (string-append "Write buffer '"
+                                  (string-append "Write buffer "
                                                  (buffer-name buffer)
-                                                 "' to file")
+                                                 " to file")
                                   false)))
        (if (memv exponent '(2 3)) (set-buffer-backed-up?! buffer false))
        (write-buffer-interactive buffer)
@@ -326,12 +341,12 @@ If a file with the new name already exists, confirmation is requested first."
   (lambda (old new)
     (if (or (not (file-exists? new))
            (prompt-for-yes-or-no?
-            (string-append "File '"
+            (string-append "File "
                            (pathname->string new)
-                           "' already exists; copy anyway")))
+                           " already exists; copy anyway")))
        (begin (copy-file old new)
-              (message "Copied '" (pathname->string old)
-                       "' => '" (pathname->string new) "'")))))
+              (message "Copied " (pathname->string old)
+                       " => " (pathname->string new))))))
 
 (define-command rename-file
   "Rename a file; the old and new names are read in the typein window.
@@ -345,13 +360,13 @@ If a file with the new name already exists, confirmation is requested first."
     (let ((do-it
           (lambda ()
             (rename-file old new)
-            (message "Renamed '" (pathname->string old)
-                     "' => '" (pathname->string new) "'"))))
+            (message "Renamed " (pathname->string old)
+                     " => " (pathname->string new)))))
       (if (file-exists? new)
          (if (prompt-for-yes-or-no?
-              (string-append "File '"
+              (string-append "File "
                              (pathname->string new)
-                             "' already exists; rename anyway"))
+                             " already exists; rename anyway"))
              (begin (delete-file new) (do-it)))
          (do-it)))))
 

diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index 41079b9d35974d40d14d484e4bee354c9cdf6e94..23147a8b23c12af182957b35203e095cc8fdc4ab 100644 (file)
--- a/v7/src/edwin/fileio.scm
+++ b/v7/src/edwin/fileio.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.89 1989/04/15 00:49:27 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.90 1989/04/26 18:49:53 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -289,18 +289,17 @@ Otherwise asks confirmation."
   false)
 \f
 (define (write-buffer-interactive buffer)
-  ;; Need to check for correct modification time here.
   (let ((truename (pathname->output-truename (buffer-pathname buffer))))
     (let ((writable? (file-writable? truename)))
       (if (or writable?
              (prompt-for-yes-or-no?
-              (string-append "File \""
+              (string-append "File "
                              (pathname-name-string truename)
-                             "\" is write-protected; try to save anyway"))
+                             " is write-protected; try to save anyway"))
              (editor-error
               "Attempt to save to a file which you aren't allowed to write"))
          (begin
-          (if (not (or (verify-visited-file-modification-time buffer)
+          (if (not (or (verify-visited-file-modification-time? buffer)
                        (not (file-exists? truename))
                        (prompt-for-yes-or-no?
                         "Disk file has changed since visited or saved.  Save anyway")))
@@ -323,17 +322,14 @@ Otherwise asks confirmation."
                   (lambda ()
                     (set-file-modes! truename modes))))))))))
 
-(define (verify-visited-file-modification-time buffer)
+(define (verify-visited-file-modification-time? buffer)
   (let ((truename (buffer-truename buffer))
-       (modification-time (buffer-modification-time buffer)))
+       (buffer-time (buffer-modification-time buffer)))
     (or (not truename)
-       (not modification-time)
-       (let ((new-time (file-modification-time truename)))
-         (and new-time
-              (or (= modification-time new-time)
-                  (and (positive? modification-time)
-                       (positive? new-time)
-                       (= 1 (abs (- modification-time new-time))))))))))
+       (not buffer-time)
+       (let ((file-time (file-modification-time truename)))
+         (and file-time
+              (< (abs (- buffer-time file-time)) 2))))))
 
 (define (write-buffer buffer)
   (let ((truename
@@ -393,9 +389,8 @@ Otherwise asks confirmation."
                        (lambda ()
                          (let ((filename (os/default-backup-filename)))
                            (temporary-message
-                            "Cannot write backup file; backing up in \""
-                            filename
-                            "\"")
+                            "Cannot write backup file; backing up in "
+                            filename)
                            (copy-file truename
                                       (string->pathname filename))
                            false))

diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm
index bd52e47ff1e1964d144e90631051cc81aaf60212..0982f34ab67164d2125ab90e3c5c204b471bde77 100644 (file)
--- a/v7/src/edwin/make.scm
+++ b/v7/src/edwin/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.7 1989/04/25 02:08:46 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.8 1989/04/26 18:50:31 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -37,4 +37,4 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (package/system-loader "edwin" '() 'QUERY)
-(add-system! (make-system "Edwin" 3 7 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 8 '()))
\ No newline at end of file

diff --git a/v7/src/edwin/tagutl.scm b/v7/src/edwin/tagutl.scm
index 4e133809b3676231d7a357853e61c233c7eb698f..2d8697bb3dc87aec837fd0e6fecf095cb068a347 100644 (file)
--- a/v7/src/edwin/tagutl.scm
+++ b/v7/src/edwin/tagutl.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tagutl.scm,v 1.32 1989/04/15 00:53:18 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tagutl.scm,v 1.33 1989/04/26 18:50:06 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -248,11 +248,11 @@ See documentation of variable tags-file-name."
   (if (not (ref-variable tags-table-pathname))
       (dispatch-on-command (ref-command-object visit-tags-table)))
   (let ((pathname (ref-variable tags-table-pathname)))
-    (let ((buffer (find-file-noselect pathname)))
-      (if (and (not (verify-visited-file-modification-time buffer))
+    (let ((buffer (find-file-noselect pathname false)))
+      (if (and (not (verify-visited-file-modification-time? buffer))
               (prompt-for-yes-or-no?
                "Tags file has changed, read new contents"))
-         (revert-buffer true true))
+         (revert-buffer buffer true true))
       (if (not (eqv? (extract-right-char (buffer-start buffer)) #\Page))
          (editor-error "File "
                        (pathname->string pathname)