From 84d98ab01f90947e7250fa007ad3bac6d74f1dfe Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 12 Apr 1991 23:28:31 +0000
Subject: [PATCH] Add third argument to `read-buffer?', which prevents updating
the buffer's pathname and modification flags if it is false.
---
v7/src/edwin/fileio.scm | 51 +++++++++++++++++++++++------------------
v7/src/edwin/hlpcom.scm | 6 ++---
v7/src/edwin/info.scm | 6 ++---
3 files changed, 35 insertions(+), 28 deletions(-)
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)
--
2.25.1