suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix default name in Create Executable dialog

Browse Source 
svn: r5440
This commit is contained in:
Matthew Flatt 2007-01-23 21:21:43 +00:00
parent fba4f23c3b
commit 6bf1ad9c2b
2 changed files with 6 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/drscheme/private/language.ss
View File

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

11
collects/drscheme/private/unit.ss
View File

@ -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)]