Change OS/BUFFER-BACKUP-PATHNAME to accept another argument, the
authorChris Hanson <org/chris-hanson/cph>
Wed, 24 Apr 1996 02:19:57 +0000 (02:19 +0000)
committerChris Hanson <org/chris-hanson/cph>
Wed, 24 Apr 1996 02:19:57 +0000 (02:19 +0000)
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
v7/src/edwin/dosfile.scm
v7/src/edwin/fileio.scm
v7/src/edwin/unix.scm

index 4e4cca39272dbd02e80d857ac3b1cd178ea87acf..39a55656ceb090e6d50ba2ec5bb4329c1063d4cf 100644 (file)
@@ -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)))))
index a39d286516668952fbffc435ea0735812f660feb..d8ac432ae9cd60ba174e26943ac981f0beaa670d 100644 (file)
@@ -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."
 \f
 ;;;; 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))
                                '()))))))))))
index f5553ff4da755fe35e5a3a763b18d4444f4cc766..24ab2128e76b715e4bb38e5686626ef8a67f6ffd 100644 (file)
@@ -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
index 05717a31f740c5343d52264bc86708c9a83d6a2a..a1db764ff52e89775be3cb542a384e97dad4ea1e 100644 (file)
@@ -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))))))))
 \f
-(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