steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

change up the way you read directories

db4
Doug Coleman 2008-10-19 12:55:48 -05:00
parent ef6debeced
commit 83638c35da
3 changed files with 44 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
core/io/files/files-docs.factor
View File

@ -55,8 +55,9 @@ ARTICLE: "directories" "Directories"
"Home directory:"
{ $subsection home }
"Directory listing:"
{ $subsection directory }
{ $subsection directory* }
{ $subsection directory-entries }
{ $subsection directory-files }
{ $subsection with-directory-files }
"Creating directories:"
{ $subsection make-directory }
{ $subsection make-directories }
@ -304,23 +305,22 @@ HELP: directory?
{ $values { "file-info" file-info } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "file-info" } " is a directory." } ;
HELP: (directory)
HELP: (directory-entries)
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
{ $notes "This is a low-level word, and user code should call " { $link directory } " instead." } ;
{ $notes "This is a low-level word, and user code should call one of the related words instead." } ;
HELP: directory
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
HELP: directory-entries
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $link directory-entry } " objects" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
HELP: directory*
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ path dir? }" } " pairs" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
{ $notes "Unlike " { $link directory } ", this word prepends the directory's path to all file names in the list." } ;
HELP: directory-files
{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
! HELP: file-modified
! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
! { $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
HELP: with-directory-files
{ $values { "path" "a pathname string" } { "quot" quotation } }
{ $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ;
HELP: resource-path
{ $values { "path" "a pathname string" } { "newpath" "a pathname string" } }
@ -329,10 +329,6 @@ HELP: resource-path
HELP: pathname
{ $class-description "Class of path name objects. Path name objects can be created by calling " { $link <pathname> } "." } ;
HELP: normalize-directory
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
{ $description "Called by the " { $link directory } " word to prepare a pathname before passing it to the " { $link (directory) } " primitive." } ;
HELP: normalize-path
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
{ $description "Called by words such as " { $link <file-reader> } " and " { $link <file-writer> } " to prepare a pathname before passing it to underlying code." } ;

14
core/io/files/files-tests.factor
View File

@ -151,18 +151,24 @@ USE: debugger.threads
"delete-tree-test" temp-file delete-tree
] unit-test
[ { { "kernel" t } } ] [
[ { "kernel" } ] [
"core" resource-path [
"." directory [ first "kernel" = ] filter
"." directory-files [ "kernel" = ] filter
] with-directory
] unit-test
[ { { "kernel" t } } ] [
[ { "kernel" } ] [
"resource:core" [
"." directory [ first "kernel" = ] filter
"." directory-files [ "kernel" = ] filter
] with-directory
] unit-test
[ { "kernel" } ] [
"resource:core" [
[ "kernel" = ] filter
] with-directory-files
] unit-test
[ ] [
"copy-tree-test/a/b/c" temp-file make-directories
] unit-test

41
core/io/files/files.factor
View File

@ -235,19 +235,22 @@ HOOK: make-directory io-backend ( path -- )
]
} cond drop ;
! Directory listings
: fixup-directory ( path seq -- newseq )
[
dup string?
[ tuck append-path file-info directory? 2array ] [ nip ] if
] with map
[ first { "." ".." } member? not ] filter ;
TUPLE: directory-entry name type ;
: directory ( path -- seq )
normalize-directory dup (directory) fixup-directory ;
HOOK: >directory-entry os ( byte-array -- directory-entry )
: directory* ( path -- seq )
dup directory [ first2 >r append-path r> 2array ] with map ;
HOOK: (directory-entries) os ( path -- seq )
: directory-entries ( path -- seq )
normalize-path
(directory-entries)
[ name>> { "." ".." } member? not ] filter ;
: directory-files ( path -- seq )
directory-entries [ name>> ] map ;
: with-directory-files ( path quot -- )
[ "" directory-files ] prepose with-directory ; inline
! Touching files
HOOK: touch-file io-backend ( path -- )
@ -259,12 +262,10 @@ HOOK: delete-directory io-backend ( path -- )
: delete-tree ( path -- )
dup link-info type>> +directory+ = [
dup directory over [
[ first delete-tree ] each
] with-directory delete-directory
] [
delete-file
] if ;
[ [ [ delete-tree ] each ] with-directory-files ]
[ delete-directory ]
bi
] [ delete-file ] if ;
: to-directory ( from to -- from to' )
over file-name append-path ;
@ -303,9 +304,9 @@ DEFER: copy-tree-into
{
{ +symbolic-link+ [ copy-link ] }
{ +directory+ [
>r dup directory r> rot [
[ >r first r> copy-tree-into ] curry each
] with-directory
swap [
[ swap copy-tree-into ] with each
] with-directory-files
] }
[ drop copy-file ]
} case ;