Add third argument to `read-buffer?', which prevents updating the

buffer's pathname and modification flags if it is false.

diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index 7779a7ca0413586d41187fed02a179279bf8bd0f..ffe4bf758374ca9f5a2b13495dda6db870980869 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.94 1991/04/02 19:55:39 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.95 1991/04/12 23:28:01 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -48,22 +48,26 @@
 \f
 ;;;; Input
 
-(define (read-buffer buffer pathname)
+(define (read-buffer buffer pathname visit?)
   (set-buffer-writeable! buffer)
-  (set-buffer-pathname! buffer pathname)
   (let ((truename (pathname->input-truename pathname)))
     (if truename
        (begin
          (region-delete! (buffer-unclipped-region buffer))
          (%insert-file (buffer-start buffer) truename)
-         (set-buffer-point! buffer (buffer-start buffer))
-         (set-buffer-modification-time! buffer
-                                        (file-modification-time truename))))
-    (set-buffer-truename! buffer truename))
-  (set-buffer-save-length! buffer)
-  (buffer-not-modified! buffer)
-  (undo-done! (buffer-point buffer))
-  (buffer-truename buffer))
+         (set-buffer-point! buffer (buffer-start buffer))))
+    (if visit?
+       (begin
+         (if truename
+             (set-buffer-modification-time!
+              buffer
+              (file-modification-time truename)))
+         (set-buffer-pathname! buffer pathname)
+         (set-buffer-truename! buffer truename)
+         (set-buffer-save-length! buffer)
+         (buffer-not-modified! buffer)
+         (undo-done! (buffer-point buffer))))
+    truename))
 
 (define (initialize-buffer! buffer)
   (initialize-buffer-modes! buffer)
@@ -107,19 +111,19 @@
                           (+ index length))))
        (without-interrupts
         (lambda ()
-          (for-each-mark group
-            (lambda (mark)
-              (let ((index* (mark-index mark)))
-                (if (or (fix:> index* index)
-                        (and (fix:= index* index)
-                             (mark-left-inserting? mark)))
-                    (set-mark-index! mark (fix:+ index* n))))))
-          (vector-set! group
-                       group-index:gap-length
-                       (fix:- (group-gap-length group) n))
           (let ((gap-start* (fix:+ index n)))
-            (vector-set! group group-index:gap-start gap-start*)
             (undo-record-insertion! group index gap-start*)
+            (vector-set! group
+                         group-index:gap-length
+                         (fix:- (group-gap-length group) n))
+            (vector-set! group group-index:gap-start gap-start*)
+            (for-each-mark group
+              (lambda (mark)
+                (let ((index* (mark-index mark)))
+                  (if (or (fix:> index* index)
+                          (and (fix:= index* index)
+                               (mark-left-inserting? mark)))
+                      (set-mark-index! mark (fix:+ index* n))))))
             (record-insertion! group index gap-start*))))
        (channel-close channel)
        n))))
@@ -360,6 +364,9 @@ Otherwise asks confirmation."
          (and file-time
               (< (abs (- buffer-time file-time)) 2))))))
 
+(define (clear-visited-file-modification-time! buffer)
+  (set-buffer-modification-time! buffer false))
+
 (define (write-buffer buffer)
   (let ((truename
         (write-region (buffer-unclipped-region buffer)

diff --git a/v7/src/edwin/hlpcom.scm b/v7/src/edwin/hlpcom.scm
index 01e4b1e649ea5e91f4e83d215ea50b933165a522..0fc8ec41d022070ced1dc8a924039d013e08fb43 100644 (file)
--- a/v7/src/edwin/hlpcom.scm
+++ b/v7/src/edwin/hlpcom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/hlpcom.scm,v 1.94 1990/11/21 23:18:24 cph Rel $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/hlpcom.scm,v 1.95 1991/04/12 23:28:16 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -273,7 +273,7 @@ If you want VALUE to be a string, you must surround it with doublequotes."
        (if buffer
            (select-buffer buffer)
            (let ((buffer (new-buffer (pathname->buffer-name pathname))))
-             (read-buffer buffer (edwin-tutorial-pathname))
+             (read-buffer buffer (edwin-tutorial-pathname) true)
              (set-buffer-pathname! buffer pathname)
              (set-buffer-truename! buffer false)
              (select-buffer buffer)

diff --git a/v7/src/edwin/info.scm b/v7/src/edwin/info.scm
index f0208f20c3ad40af7e165340f2a3945f2e52a46b..4f3fea64cf640d831731472049d0bb86e592dc3d 100644 (file)
--- a/v7/src/edwin/info.scm
+++ b/v7/src/edwin/info.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/info.scm,v 1.97 1991/03/15 23:39:31 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/info.scm,v 1.98 1991/04/12 23:28:31 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -641,7 +641,7 @@ The name may be an abbreviation of the reference name."
               (let ((pathname* (ref-variable info-current-file)))
                 (not (and pathname* (pathname=? pathname pathname*)))))
          (begin
-           (read-buffer buffer pathname)
+           (read-buffer buffer pathname true)
            (if (not (eq? (buffer-major-mode buffer) (ref-mode-object info)))
                (set-buffer-major-mode! buffer (ref-mode-object info)))
            (find-tag-table buffer)
@@ -869,7 +869,7 @@ The name may be an abbreviation of the reference name."
     (if (or (not subfile)
            (not (pathname=? subfile pathname)))
        (begin
-         (read-buffer (current-buffer) pathname)
+         (read-buffer (current-buffer) pathname true)
          (set-variable! info-current-subfile pathname)))))
 
 (define-integrable subfile-filename car)