From 2d0003fc16c59c1d605e11e99960257428122c99 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 20 Jan 2003 18:37:27 +0000
Subject: [PATCH] ..

original commit: 0167ef89e78a53e33270915a88985865b8da78c7
---
 collects/framework/private/path-utils.ss | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/collects/framework/private/path-utils.ss b/collects/framework/private/path-utils.ss
index 7c3337ab..cd4d2094 100644
--- 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 "~")]))))))