change up the way you read directories

core/io/files/files-docs.factor

@@ -55,8 +55,9 @@ ARTICLE: "directories" "Directories"
 "Home directory:"
 { $subsection home }
 "Directory listing:"
-{ $subsection directory }
+{ $subsection directory-entries }
-{ $subsection directory* }
+{ $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
+HELP: directory-entries
-{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
+{ $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*
+HELP: directory-files
-{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ path dir? }" } " pairs" } }
+{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } }
-{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
+{ $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: file-modified
+HELP: with-directory-files
-! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
+{ $values { "path" "a pathname string" } { "quot" quotation } }
-! { $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
+{ $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." } ;

core/io/files/files-tests.factor

@@ -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

core/io/files/files.factor

@@ -235,19 +235,22 @@ HOOK: make-directory io-backend ( path -- )
         ]
     } cond drop ;
 
-! Directory listings
+TUPLE: directory-entry name type ;
-: fixup-directory ( path seq -- newseq )
-    [
-        dup string?
-        [ tuck append-path file-info directory? 2array ] [ nip ] if
-    ] with map
-    [ first { "." ".." } member? not ] filter ;
 
-: directory ( path -- seq )
+HOOK: >directory-entry os ( byte-array -- directory-entry )
-    normalize-directory dup (directory) fixup-directory ;
 
-: directory* ( path -- seq )
+HOOK: (directory-entries) os ( path -- seq )
-    dup directory [ first2 >r append-path r> 2array ] with map ;
+
+: 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 [
+        [ [ [ delete-tree ] each ] with-directory-files ]
-            [ first delete-tree ] each
+        [ delete-directory ]
-        ] with-directory delete-directory
+        bi
-    ] [
+    ] [ delete-file ] if ;
-        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 [
+            swap [
-                [ >r first r> copy-tree-into ] curry each
+                [ swap copy-tree-into ] with each
-            ] with-directory
+            ] with-directory-files
         ] }
         [ drop copy-file ]
     } case ;