From 8ccef02233a4101d33667f8a7328917b3c845463 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 20 Oct 2006 17:19:54 +0000 Subject: [PATCH] now using path-element functions in some places svn: r4662 --- collects/drscheme/private/language.ss | 42 +++++++++++++----------- collects/drscheme/private/rep.ss | 2 +- collects/framework/private/path-utils.ss | 18 +++++----- 3 files changed, 33 insertions(+), 29 deletions(-) diff --git a/collects/drscheme/private/language.ss b/collects/drscheme/private/language.ss index 7338f794f8..26e0efc04e 100644 --- a/collects/drscheme/private/language.ss +++ b/collects/drscheme/private/language.ss @@ -825,25 +825,29 @@ ;; default-executable-filename : path symbol boolean -> path (define (default-executable-filename program-filename mode mred?) - (let* ([ext (filename-extension program-filename)] - [program-bytename (path->bytes program-filename)] - ;; 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))))]) - (bytes->path - (if ext - (bytes-append ext-less ext) - ext-less))))) + (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)))))) (define (mode->put-file-extension+style+filters mode mred?) (case mode diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index aa53b569a2..e60dd4fa2f 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -284,7 +284,7 @@ TODO [(null? pieces) #t] [else (let-values ([(base name dir?) (split-path path)]) - (and (equal? (path->bytes name) (car pieces)) + (and (equal? (path-element->bytes name) (car pieces)) (loop base (cdr pieces))))])))))) ;; drscheme-error-value->string-handler : TST number -> string diff --git a/collects/framework/private/path-utils.ss b/collects/framework/private/path-utils.ss index aef071191d..f81b52a79e 100644 --- a/collects/framework/private/path-utils.ss +++ b/collects/framework/private/path-utils.ss @@ -14,7 +14,7 @@ (if name (split-path name) (values (find-system-path 'doc-dir) - (bytes->path #"mredauto") + (bytes->path-element #"mredauto") #f))]) (let* ([base (if (path? base) base @@ -27,15 +27,15 @@ [new-name (build-path path (if (eq? (system-type) 'windows) - (bytes->path + (bytes->path-element (bytes-append (regexp-replace #rx#"\\..*$" - (path->bytes name) + (path-element->bytes name) #"") #"." numb)) - (bytes->path + (bytes->path-element (bytes-append #"#" - (path->bytes name) + (path-element->bytes name) #"#" numb #"#"))))]) @@ -48,15 +48,15 @@ (let ([base (if (path? pre-base) pre-base (current-directory))]) - (let ([name-bytes (path->bytes name)]) + (let ([name-bytes (path-element->bytes name)]) (cond [(and (eq? (system-type) 'windows) (regexp-match #rx#"(.*)\\.[^.]*" name-bytes)) => (λ (m) - (build-path base (bytes->path (bytes-append (cadr m) #".bak"))))] + (build-path base (bytes->path-element (bytes-append (cadr m) #".bak"))))] [(eq? (system-type) 'windows) - (build-path base (bytes->path (bytes-append name-bytes #".bak")))] + (build-path base (bytes->path-element (bytes-append name-bytes #".bak")))] [else - (build-path base (bytes->path (bytes-append name-bytes #"~")))])))))))) + (build-path base (bytes->path-element (bytes-append name-bytes #"~")))]))))))))