From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 24 Apr 1996 02:19:57 +0000 (+0000)
Subject: Change OS/BUFFER-BACKUP-PATHNAME to accept another argument, the
X-Git-Tag: 20090517-FFI~5581
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a5e4f27d3a096c0b2408efcec8ac094c6bd9610b;p=mit-scheme.git

Change OS/BUFFER-BACKUP-PATHNAME to accept another argument, the
buffer being backed up.  This is necessary to ensure that the backup
control variables are properly referenced; formerly local bindings of
these variables would not be referenced correctly.
---

diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm
index 4e4cca392..39a55656c 100644
--- a/v7/src/edwin/dired.scm
+++ b/v7/src/edwin/dired.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: dired.scm,v 1.162 1996/04/23 23:08:24 cph Exp $
+;;;	$Id: dired.scm,v 1.163 1996/04/24 02:19:57 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
 ;;;
@@ -613,7 +613,7 @@ When renaming multiple or marked files, you specify a directory."
 		(string-append "Make backup for existing file `"
 			       (->namestring to)
 			       "'"))))
-      (call-with-values (lambda () (os/buffer-backup-pathname to))
+      (call-with-values (lambda () (os/buffer-backup-pathname to #f))
 	(lambda (backup-pathname targets)
 	  targets
 	  (rename-file to backup-pathname)))))
diff --git a/v7/src/edwin/dosfile.scm b/v7/src/edwin/dosfile.scm
index a39d28651..d8ac432ae 100644
--- a/v7/src/edwin/dosfile.scm
+++ b/v7/src/edwin/dosfile.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: dosfile.scm,v 1.6 1996/02/29 22:16:23 cph Exp $
+;;;	$Id: dosfile.scm,v 1.7 1996/04/24 02:19:30 cph Exp $
 ;;;
 ;;;	Copyright (c) 1994-96 Massachusetts Institute of Technology
 ;;;
@@ -125,7 +125,7 @@ Includes the new backup.  Must be > 0."
 
 ;;;; Backup and Auto-Save Filenames
 
-(define (os/buffer-backup-pathname truename)
+(define (os/buffer-backup-pathname truename buffer)
   (call-with-values
       (lambda ()
 	(if (dos/fs-long-filenames? truename)
@@ -136,7 +136,7 @@ Includes the new backup.  Must be > 0."
 		  (values truename "~")))
 	    (values truename "")))
     (lambda (truename suffix)
-      (if (eq? 'NEVER (ref-variable version-control))
+      (if (eq? 'NEVER (ref-variable version-control buffer))
 	  (values (dos/make-backup-pathname truename #f suffix) '())
 	  (let ((prefix
 		 (if (dos/fs-long-filenames? truename)
@@ -163,17 +163,18 @@ Includes the new backup.  Must be > 0."
 	      (if (null? backups)
 		  (values (dos/make-backup-pathname
 			   truename
-			   (and (ref-variable version-control) 1)
+			   (and (ref-variable version-control buffer) 1)
 			   suffix)
 			  '())
 		  (values (dos/make-backup-pathname
 			   truename
 			   (+ (apply max (map cdr backups)) 1)
 			   suffix)
-			  (let ((start (ref-variable kept-old-versions))
+			  (let ((start (ref-variable kept-old-versions buffer))
 				(end
 				 (- (length backups)
-				    (- (ref-variable kept-new-versions) 1))))
+				    (- (ref-variable kept-new-versions buffer)
+				       1))))
 			    (if (< start end)
 				(map car (sublist backups start end))
 				'()))))))))))
diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index f5553ff4d..24ab2128e 100644
--- a/v7/src/edwin/fileio.scm
+++ b/v7/src/edwin/fileio.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: fileio.scm,v 1.133 1996/03/04 20:46:35 cph Exp $
+;;;	$Id: fileio.scm,v 1.134 1996/04/24 02:19:48 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
 ;;;
@@ -681,7 +681,7 @@ Otherwise, a message is written both before and after long file writes."
        (catch-file-errors
 	(lambda () false)
 	(lambda ()
-	  (with-values (lambda () (os/buffer-backup-pathname truename))
+	  (with-values (lambda () (os/buffer-backup-pathname truename buffer))
 	    (lambda (backup-pathname targets)
 	      (let ((modes
 		     (catch-file-errors
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 05717a31f..a1db764ff 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: unix.scm,v 1.65 1996/03/01 07:14:55 cph Exp $
+;;;	$Id: unix.scm,v 1.66 1996/04/24 02:18:04 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-96 Massachusetts Institute of Technology
 ;;;
@@ -189,7 +189,7 @@ Includes the new backup.  Must be > 0."
 		       (= (file-attributes/gid attributes)
 			  (unix/current-gid))))))))
 
-(define (os/buffer-backup-pathname truename)
+(define (os/buffer-backup-pathname truename buffer)
   (with-values
       (lambda ()
 	;; Handle compressed files specially.
@@ -202,7 +202,7 @@ Includes the new backup.  Must be > 0."
       (let ((no-versions
 	     (lambda ()
 	       (values (->pathname (string-append filename suffix)) '()))))
-	(if (eq? 'NEVER (ref-variable version-control))
+	(if (eq? 'NEVER (ref-variable version-control buffer))
 	    (no-versions)
 	    (let ((prefix (string-append (file-namestring filename) ".~")))
 	      (let ((filenames
@@ -238,7 +238,7 @@ Includes the new backup.  Must be > 0."
 				   (loop (cdr filenames))))))
 			<)))
 		  (let ((high-water-mark (apply max (cons 0 versions))))
-		    (if (or (ref-variable version-control)
+		    (if (or (ref-variable version-control buffer)
 			    (positive? high-water-mark))
 			(let ((version->pathname
 			       (let ((directory
@@ -251,10 +251,11 @@ Includes the new backup.  Must be > 0."
 				    directory)))))
 			  (values
 			   (version->pathname (+ high-water-mark 1))
-			   (let ((start (ref-variable kept-old-versions))
+			   (let ((start
+				  (ref-variable kept-old-versions buffer))
 				 (end
 				  (- (length versions)
-				     (- (ref-variable kept-new-versions)
+				     (- (ref-variable kept-new-versions buffer)
 					1))))
 			     (if (< start end)
 				 (map version->pathname