;;; -*-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
;;;
(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)))))
;;; -*-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
;;;
\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)
(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)
(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))
'()))))))))))
;;; -*-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
;;;
(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
;;; -*-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
;;;
(= (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.
(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
(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
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