suzanne.soy/gui
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

original commit: 8ccef02233a4101d33667f8a7328917b3c845463
This commit is contained in:
Robby Findler 2006-10-20 17:19:54 +00:00
parent bcf2f3f04f
commit 9450d0ec45
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -14,7 +14,7 @@
(if name (if name
(split-path name) (split-path name)
(values (find-system-path 'doc-dir) (values (find-system-path 'doc-dir)
(bytes->path #"mredauto") (bytes->path-element #"mredauto")
#f))]) #f))])
(let* ([base (if (path? base) (let* ([base (if (path? base)
base base
@ -27,15 +27,15 @@
[new-name [new-name
(build-path path (build-path path
(if (eq? (system-type) 'windows) (if (eq? (system-type) 'windows)
(bytes->path (bytes->path-element
(bytes-append (regexp-replace #rx#"\\..*$" (bytes-append (regexp-replace #rx#"\\..*$"
(path->bytes name) (path-element->bytes name)
#"") #"")
#"." #"."
numb)) numb))
(bytes->path (bytes->path-element
(bytes-append #"#" (bytes-append #"#"
(path->bytes name) (path-element->bytes name)
#"#" #"#"
numb numb
#"#"))))]) #"#"))))])
@ -48,15 +48,15 @@
(let ([base (if (path? pre-base) (let ([base (if (path? pre-base)
pre-base pre-base
(current-directory))]) (current-directory))])
(let ([name-bytes (path->bytes name)]) (let ([name-bytes (path-element->bytes name)])
(cond (cond
[(and (eq? (system-type) 'windows) [(and (eq? (system-type) 'windows)
(regexp-match #rx#"(.*)\\.[^.]*" name-bytes)) (regexp-match #rx#"(.*)\\.[^.]*" name-bytes))
=> =>
(λ (m) (λ (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) [(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 [else
(build-path base (bytes->path (bytes-append name-bytes #"~")))])))))))) (build-path base (bytes->path-element (bytes-append name-bytes #"~")))]))))))))