..

original commit: 0167ef89e78a53e33270915a88985865b8da78c7
2003-01-20 18:37:27 +00:00 · 2003-01-20 18:37:27 +00:00 · 2d0003fc16
commit 2d0003fc16
parent b4f1db5997
1 changed files with 13 additions and 9 deletions
--- a/collects/framework/private/path-utils.ss
+++ b/collects/framework/private/path-utils.ss
@ -48,15 +48,19 @@
 		  (if (file-exists? new-name)
 		      (loop (add1 n))
 		      new-name)))))))
+
+      (define re:backup (regexp "(.*)\\.[^.]*"))
+      
      (define generate-backup-name
 	(lambda (name)
-	  (if (eq? (system-type) 'windows)
-	      (list->string
-	       (let loop ([list (string->list name)])
-		 (if (or (null? list)
-			 (char=? (car list) #\.))
-		     '(#\. #\b #\a #\k)
-		     (cons (car list)
-			   (loop (cdr list))))))
-	      (string-append name "~")))))))
+	  (cond
+            [(and (eq? (system-type) 'windows)
+                  (regexp-match re:backup name))
+             =>
+             (lambda (m)
+               (string-append (cadr m) ".bak"))]
+            [(eq? (system-type) 'windows)
+             (string-append name ".bak")]
+            [else
+             (string-append name "~")]))))))