From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 12 Apr 1991 23:28:31 +0000 (+0000)
Subject: Add third argument to `read-buffer?', which prevents updating the
X-Git-Tag: 20090517-FFI~10752
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=84d98ab01f90947e7250fa007ad3bac6d74f1dfe;p=mit-scheme.git

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 7779a7ca0..ffe4bf758 100644
--- 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 @@
 
 ;;;; 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 01e4b1e64..0fc8ec41d 100644
--- 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 f0208f20c..4f3fea64c 100644
--- 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)