diff --git a/basis/io/directories/directories-docs.factor b/basis/io/directories/directories-docs.factor index 4af5ee4592..a9dcea8a8f 100644 --- a/basis/io/directories/directories-docs.factor +++ b/basis/io/directories/directories-docs.factor @@ -46,10 +46,18 @@ 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: directory-tree-files +{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } } +{ $description "Outputs a sequence of all non-directory files inside the directory named by " { $snippet "path" } " and its subdirectories." } ; + 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: with-directory-tree-files +{ $values { "path" "a pathname string" } { "quot" quotation } } +{ $description "Calls the quotation with the recursive 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: with-directory-entries { $values { "path" "a pathname string" } { "quot" quotation } } { $description "Calls the quotation with the directory entries on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ; diff --git a/basis/io/directories/directories-tests.factor b/basis/io/directories/directories-tests.factor index b703421b45..92e35557e2 100644 --- a/basis/io/directories/directories-tests.factor +++ b/basis/io/directories/directories-tests.factor @@ -22,6 +22,18 @@ IN: io.directories.tests ] with-directory-files ] unit-test +[ { "classes/tuple/tuple.factor" } ] [ + "resource:core" [ + "." directory-tree-files [ "classes/tuple/tuple.factor" = ] filter + ] with-directory +] unit-test + +[ { "classes/tuple/tuple.factor" } ] [ + "resource:core" [ + [ "classes/tuple/tuple.factor" = ] filter + ] with-directory-tree-files +] unit-test + [ ] [ "blahblah" temp-file dup exists? [ delete-directory ] [ drop ] if ] unit-test [ ] [ "blahblah" temp-file make-directory ] unit-test [ t ] [ "blahblah" temp-file file-info directory? ] unit-test diff --git a/basis/io/directories/directories.factor b/basis/io/directories/directories.factor index 0524398304..3158f6ca41 100644 --- a/basis/io/directories/directories.factor +++ b/basis/io/directories/directories.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators destructors io io.backend -io.encodings.binary io.files io.pathnames kernel namespaces -sequences system vocabs.loader fry ; +USING: accessors arrays combinators destructors io io.backend +io.encodings.binary io.files io.files.types io.pathnames +kernel namespaces sequences system vocabs.loader fry ; IN: io.directories : set-current-directory ( path -- ) @@ -41,12 +41,23 @@ HOOK: (directory-entries) os ( path -- seq ) : directory-files ( path -- seq ) directory-entries [ name>> ] map ; +: directory-tree-files ( path -- seq ) + dup directory-entries + [ + dup type>> +directory+ = + [ name>> [ append-path directory-tree-files ] [ [ prepend-path ] curry map ] bi ] + [ nip name>> 1array ] if + ] with map concat ; + : with-directory-entries ( path quot -- ) '[ "" directory-entries @ ] with-directory ; inline : with-directory-files ( path quot -- ) '[ "" directory-files @ ] with-directory ; inline +: with-directory-tree-files ( path quot -- ) + '[ "" directory-tree-files @ ] with-directory ; inline + ! Touching files HOOK: touch-file io-backend ( path -- )