From 6bf1ad9c2b028a816aecf30ce8ccada93c64b3d2 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 23 Jan 2007 21:21:43 +0000
Subject: [PATCH] fix default name in Create Executable dialog

svn: r5440
---
 collects/drscheme/private/language.ss | 29 ++++++---------------------
 collects/drscheme/private/unit.ss     | 11 ----------
 2 files changed, 6 insertions(+), 34 deletions(-)

diff --git a/collects/drscheme/private/language.ss b/collects/drscheme/private/language.ss
index a502de3a55..70f51bed3c 100644
--- a/collects/drscheme/private/language.ss
+++ b/collects/drscheme/private/language.ss
@@ -821,29 +821,12 @@
       
       ;; default-executable-filename : path symbol boolean -> path
       (define (default-executable-filename program-filename mode mred?)
-        (let-values ([(base name dir) (split-path program-filename)])
-          (let* ([ext (filename-extension name)]
-                 [program-bytename (path-element->bytes name)]
-                 ;; ext-less : bytes
-                 [ext-less (if ext
-                               (subbytes program-bytename
-                                         0
-                                         (- (bytes-length program-bytename)
-                                            (bytes-length ext)
-                                            1 ;; sub1 for the period in the extension
-                                            ))
-                               program-bytename)])
-            (let ([ext (let-values ([(extension style filters)
-                                     (mode->put-file-extension+style+filters mode mred?)])
-                         (and extension
-                              (string->bytes/utf-8 (string-append "." extension))))])
-              (if ext
-                  (if (path? base)
-                      (build-path base (bytes->path-element (bytes-append ext-less ext)))
-                      (bytes->path-element (bytes-append ext-less ext)))
-                  (if (path? base)
-                      (build-path base name)
-                      name))))))
+        (let ([ext (let-values ([(extension style filters)
+                                 (mode->put-file-extension+style+filters mode mred?)])
+                     (if extension
+                         (string->bytes/utf-8 (string-append "." extension))
+                         #""))])
+          (path-replace-suffix program-filename ext)))
       
       (define (mode->put-file-extension+style+filters mode mred?)
         (case mode
diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss
index 5f3edbbb66..62f1efda19 100644
--- a/collects/drscheme/private/unit.ss
+++ b/collects/drscheme/private/unit.ss
@@ -245,17 +245,6 @@ module browser threading seems wrong.
             (send dlg show #t)
             (and ok? (validate-number)))))
       
-      (define (basename fn)
-        (if fn
-            (let* ([file-name (mzlib:file:file-name-from-path fn)]
-                   [ext (mzlib:file:filename-extension file-name)])
-              (if ext
-                  (substring file-name 0 (- (string-length file-name)
-                                            (string-length ext)
-                                            1))
-                  file-name))
-            #f))
-      
       ;; create-executable : (instanceof drscheme:unit:frame<%>) -> void
       (define (create-executable frame)
         (let* ([definitions-text (send frame get-definitions-text)]