From: Taylor R. Campbell <net/mumble/campbell>
Date: Mon, 15 May 2006 01:50:40 +0000 (+0000)
Subject: Implement OS/NEWEST-BACKUP for Unix.
X-Git-Tag: 20090517-FFI~1054
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d14f7f51dfbe752371e06776c5105c26b4b145c2;p=mit-scheme.git

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.
---

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