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

now using path-element functions in some places

Browse Source 
svn: r4662
This commit is contained in:
Robby Findler 2006-10-20 17:19:54 +00:00
parent 85cf61a95f
commit 8ccef02233
3 changed files with 33 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

2
collects/drscheme/private/rep.ss
View File

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

18
collects/framework/private/path-utils.ss
View File

@ -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 #"~")))]))))))))