io.directories: add "directory-tree-files" and "with-directory-tree-files" words

diff --git a/basis/io/directories/directories-docs.factor b/basis/io/directories/directories-docs.factor
index 4af5ee45927c80410ce094fae6ce331a80245632..a9dcea8a8f5c64baec5457ea681f4d7fbdedfb65 100644 (file)
--- 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 b703421b45b471d854db36a4283f436b10ca09ca..92e35557e24af091a9c07f6086124ec5ff4c36f8 100644 (file)
--- 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 05243983041c35c4f8bd650fac1c30e7858dbc53..3158f6ca4191d5d4dc345bbd9fec42f7c95366fa 100644 (file)
--- 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 -- )