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

.

Browse Source 
original commit: 807126e9f7b7965c534a0517f94de49078bb1853
This commit is contained in:
Matthew Flatt 2004-10-11 16:55:37 +00:00
parent ed31184fa5
commit 7db4a6bbcb
1 changed files with 13 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/mzlib/file.ss
View File

@ -148,6 +148,8 @@
(define explode-path
(lambda (orig-path)
(unless (path-string? orig-path)
(raise-type-error 'explode-path "path or string" orig-path))
(do-explode-path 'explode-path orig-path)))
;; Arguments must be in normal form
@ -171,6 +173,8 @@
(define file-name-from-path
(lambda (name)
(unless (path-string? name)
(raise-type-error 'file-name-from-path "path or string" name))
(let-values ([(base file dir?) (split-path name)])
(if (and (not dir?) (path? file))
file
@ -178,6 +182,8 @@
(define path-only
(lambda (name)
(unless (path-string? name)
(raise-type-error 'path-only "path or string" name))
(let-values ([(base file dir?) (split-path name)])
(cond
[dir? name]
@ -187,14 +193,18 @@
;; name can be any string; we just look for a dot
(define filename-extension
(lambda (name)
(let ([name (if (string? name)
name
(path->bytes name))])
(unless (path-string? name)
(raise-type-error 'filename-extension "path or string" name))
(let ([name (if (path? name)
(path->bytes name)
name)])
(let ([m (regexp-match #rx#"[.]([^.]+)$" name)])
(and m
(cadr m))))))
(define (delete-directory/files path)
(unless (path-string? path)
(raise-type-error 'delete-directory/files "path or string" path))
(cond
[(or (link-exists? path) (file-exists? path))
(delete-file path)]