From d14f7f51dfbe752371e06776c5105c26b4b145c2 Mon Sep 17 00:00:00 2001 From: "Taylor R. Campbell" Date: Mon, 15 May 2006 01:50:40 +0000 Subject: [PATCH] Implement OS/NEWEST-BACKUP for Unix. This should probably be implemented for DOS some day, but I'm not a DOS hacker, and I need this only for a diff front end, which won't run on DOS anyway. --- v7/src/edwin/unix.scm | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm index 666998686..cdbe7e22e 100644 --- a/v7/src/edwin/unix.scm +++ b/v7/src/edwin/unix.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: unix.scm,v 1.118 2004/02/16 05:44:05 cph Exp $ +$Id: unix.scm,v 1.119 2006/05/15 01:50:40 riastradh Exp $ Copyright 1989,1991,1992,1993,1994,1995 Massachusetts Institute of Technology Copyright 1996,1997,1999,2000,2002,2003 Massachusetts Institute of Technology @@ -165,6 +165,39 @@ Includes the new backup. Must be > 0." (unix/current-uid)) (= (file-attributes/gid attributes) (unix/current-gid)))))))) + +(define (os/newest-numeric-backup pathname) + (define (first-loop filenames) + (if (null? filenames) + #f + (cond ((os/numeric-backup-filename? (car filenames)) + => (lambda (root.version) + (max-loop (cdr filenames) + (car filenames) + (cdr root.version)))) + (else (first-loop (cdr filenames)))))) + (define (max-loop filenames filename version) + (if (null? filenames) + filename + (cond ((os/numeric-backup-filename? (car filenames)) + => (lambda (root.version) + (if (> (cdr root.version) version) + (max-loop (cdr filenames) + (car filenames) + (cdr root.version)) + (max-loop (cdr filenames) filename version)))) + (else (max-loop (cdr filenames) filename version))))) + (first-loop (os/directory-list-completions + (directory-namestring pathname) + (string-append (file-namestring pathname) ".~")))) + +(define (os/newest-backup pathname) + (or (os/newest-numeric-backup pathname) + (find-matching-item + (os/directory-list-completions + (directory-namestring pathname) + (string-append (file-namestring pathname) "~")) + os/backup-filename?))) (define (os/buffer-backup-pathname truename buffer) (call-with-values -- 2.25.1