From a5e4f27d3a096c0b2408efcec8ac094c6bd9610b Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 24 Apr 1996 02:19:57 +0000 Subject: [PATCH] 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. --- v7/src/edwin/dired.scm | 4 ++-- v7/src/edwin/dosfile.scm | 13 +++++++------ v7/src/edwin/fileio.scm | 4 ++-- v7/src/edwin/unix.scm | 13 +++++++------ 4 files changed, 18 insertions(+), 16 deletions(-) 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 -- 2.25.1