! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays editors io.directories.search kernel namespaces
+USING: arrays editors io.directories kernel namespaces
sequences windows.shell32 ;
IN: editors.notepad
! Copyright (C) 2017 Alexander Ilin.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators.short-circuit formatting io
-io.directories.search io.encodings.utf8 io.files io.pathnames
+io.directories io.encodings.utf8 io.files io.pathnames
kernel math namespaces prettyprint sequences ui.gadgets.panes
vocabs.loader ;
USING: help.markup help.syntax io.files.private io.pathnames
-quotations ;
+quotations sequences ;
IN: io.directories
HELP: cwd
}
"On most operating systems, files can only be moved within the same file system. To move files between file systems, use " { $link copy-file } " followed by " { $link delete-file } " on the old name." ;
+HELP: +depth-first+
+{ $description "Method of directory traversal that fully recurses as far as possible before backtracking." } ;
+
+HELP: +breadth-first+
+{ $description "Method of directory traversal that explores each level of graph fully before moving to the next level." } ;
+
+HELP: traversal-method
+{ $var-description "Determines directory traversal method, either " { $link +depth-first+ } " or " { $link +breadth-first+ } "." } ;
+
+HELP: each-file
+{ $values
+ { "path" "a pathname string" } { "quot" quotation }
+}
+{ $description "Traverses a directory path recursively and calls the quotation on the full pathname of each file, in a breadth-first or depth-first " { $link traversal-method } "." }
+{ $examples
+ { $unchecked-example "USING: sequences io.directories ;"
+ "\"resource:misc\" [ . ] each-file"
+ "! Recursive directory listing prints here"
+ }
+} ;
+
+HELP: recursive-directory-files
+{ $values
+ { "path" "a pathname string" }
+ { "paths" { $sequence "pathname strings" } }
+}
+{ $description "Traverses a directory path recursively and returns a sequence of files, in a breadth-first or depth-first " { $link traversal-method } "." } ;
+
+HELP: recursive-directory-entries
+{ $values
+ { "path" "a pathname string" }
+ { "directory-entries" { $sequence directory-entry } }
+}
+{ $description "Traverses a directory path recursively and returns a sequence of directory-entries, in a breadth-first or depth-first " { $link traversal-method } "." } ;
+
+HELP: find-file
+{ $values
+ { "path" "a pathname string" } { "quot" quotation }
+ { "path/f" { $maybe "pathname string" } }
+}
+{ $description "Finds the first file in the input directory matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
+
+HELP: find-file-in-directories
+{ $values
+ { "directories" "a sequence of pathnames" } { "quot" quotation }
+ { "path'/f" { $maybe "pathname string" } }
+}
+{ $description "Finds the first file in the input directories matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
+
+HELP: find-files
+{ $values
+ { "path" "a pathname string" } { "quot" quotation }
+ { "paths" { $sequence "pathname strings" } }
+}
+{ $description "Recursively finds all files in the input directory matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
+
+HELP: find-files-in-directories
+{ $values
+ { "directories" { $sequence "directory paths" } } { "quot" quotation }
+ { "paths/f" { $maybe "a sequence of pathname strings" } }
+}
+{ $description "Finds all files in the input directories matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
+
+HELP: find-files-by-extension
+{ $values
+ { "path" "a pathname string" } { "extension" "a file extension" }
+ { "seq" sequence }
+}
+{ $description "Searches a directory for all files with the given extension. File extension and filenames are converted to lower-case and compared using the " { $link tail? } " word. The file extension should contain the period." }
+{ $examples
+ { $code
+ "USING: io.directories ;"
+ "\"/\" \".mp3\" find-by-extension"
+ }
+} ;
+
+HELP: find-files-by-extensions
+{ $values
+ { "path" "a pathname string" } { "extensions" { $sequence "file extensions" } }
+ { "seq" sequence }
+}
+{ $description "Searches a directory for all files in the given list of extensions. File extensions and filenames are converted to lower-case and compared using the " { $link tail? } " word. File extensions should contain the period." }
+{ $examples
+ { $code
+ "USING: io.directories ;"
+ "\"/\" { \".jpg\" \".gif\" \".tiff\" \".png\" \".bmp\" } find-files-by-extensions"
+ }
+} ;
+
+{ find-file find-files find-file-in-directories find-files-in-directories } related-words
+
+ARTICLE: "io.directories.search" "Searching directories"
+"Traversing directories:"
+{ $subsections
+ recursive-directory-files
+ recursive-directory-entries
+ each-file
+ each-directory-entry
+}
+"Finding files by name:"
+{ $subsections
+ find-file
+ find-files
+ find-file-in-directories
+ find-files-in-directories
+}
+"Finding files by extension:"
+{ $subsections
+ find-files-by-extension
+ find-files-by-extensions
+} ;
+HELP: directory-tree-files
+{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } }
+{ $description "Outputs a sequence of all files and subdirectories inside the directory named by " { $snippet "path" } " or recursively inside its subdirectories." } ;
+
+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: delete-tree
+{ $values { "path" "a pathname string" } }
+{ $description "Deletes a file or directory, recursing into subdirectories." }
+{ $errors "Throws an error if the deletion fails." }
+{ $warning "Misuse of this word can lead to catastrophic data loss." } ;
+
+HELP: copy-tree
+{ $values { "from" "a pathname string" } { "to" "a pathname string" } }
+{ $description "Copies a directory tree recursively." }
+{ $notes "This operation attempts to preserve original file attributes, however not all attributes may be preserved." }
+{ $errors "Throws an error if the copy operation fails." } ;
+
+HELP: copy-tree-into
+{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } }
+{ $description "Copies a directory tree to another directory, recursively." }
+{ $errors "Throws an error if the copy operation fails." } ;
+
+HELP: copy-trees-into
+{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } }
+{ $description "Copies a set of directory trees to another directory, recursively." }
+{ $errors "Throws an error if the copy operation fails." } ;
+
+ARTICLE: "io.directories.hierarchy" "Directory hierarchy manipulation"
+"There is a naming scheme used by " { $vocab-link "io.directories" } ". Operations for deleting and copying files come in two forms:"
+{ $list
+ { "Words named " { $snippet { $emphasis "operation" } "-file" } " which work on regular files only." }
+ { "Words named " { $snippet { $emphasis "operation" } "-tree" } " works on directory trees recursively, and also accepts regular files." }
+}
+"Listing directory trees recursively:"
+{ $subsections
+ directory-tree-files
+ with-directory-tree-files
+}
+"Deleting directory trees recursively:"
+{ $subsections delete-tree }
+"Copying directory trees recursively:"
+{ $subsections
+ copy-tree
+ copy-tree-into
+ copy-trees-into
+} ;
+
ARTICLE: "io.directories" "Directory manipulation"
"The " { $vocab-link "io.directories" } " vocabulary defines words for inspecting and manipulating directories."
{ $subsections
"io.directories.create"
"delete-move-copy"
"io.directories.hierarchy"
+ "io.directories.search"
} ;
+
ABOUT: "io.directories"
-USING: arrays destructors io io.directories
-io.directories.hierarchy io.encodings.ascii io.encodings.utf8
+USING: arrays destructors io io.directories io.encodings.ascii io.encodings.utf8
io.files io.files.info io.launcher io.pathnames kernel sequences
system tools.test ;
] unit-test
] with-test-directory
+
+{ t } [
+ [
+ 10 [ "io.paths.test" "gogogo" unique-file ] replicate
+ "." [ ] find-files [ natural-sort ] same?
+ ] with-test-directory
+] unit-test
+
+{ f } [
+ { "omg you shoudnt have a directory called this" "or this" }
+ [ "asdfasdfasdfasdfasdf" tail? ] find-file-in-directories
+] unit-test
+
+{ f } [
+ { } [ "asdfasdfasdfasdfasdf" tail? ] find-file-in-directories
+] unit-test
+
+{ t } [
+ [
+ "the-head" "" unique-file drop
+ "." [ file-name "the-head" head? ] find-file string?
+ ] with-test-directory
+] unit-test
+
+{ t } [
+ [
+ { "foo" "bar" } {
+ [ [ make-directory ] each ]
+ [ [ "abcd" append-path touch-file ] each ]
+ [ [ file-name "abcd" = ] find-files-in-directories length 2 = ]
+ [ [ delete-tree ] each ]
+ } cleave
+ ] with-test-directory
+] unit-test
+
+{ t } [
+ "resource:core/math/integers/integers.factor"
+ [ "math.factor" tail? ] find-up-to-root >boolean
+] unit-test
+
+{ f } [
+ "resource:core/math/integers/integers.factor"
+ [ drop f ] find-up-to-root
+] unit-test
+
+[
+ {
+ "/a"
+ "/a/a"
+ "/a/a/a"
+ "/a/b"
+ "/a/b/a"
+ "/b"
+ "/b/a"
+ "/b/a/a"
+ "/b/b"
+ "/b/b/a"
+ "/c"
+ "/c/a"
+ "/c/a/a"
+ "/c/b"
+ "/c/b/a"
+ }
+ {
+ "/a"
+ "/b"
+ "/c"
+ "/a/a"
+ "/a/b"
+ "/b/a"
+ "/b/b"
+ "/c/a"
+ "/c/b"
+ "/a/a/a"
+ "/a/b/a"
+ "/b/a/a"
+ "/b/b/a"
+ "/c/a/a"
+ "/c/b/a"
+ }
+] [
+ [
+ "a" make-directory
+ "a/a" make-directory
+ "a/a/a" touch-file
+ "a/b" make-directory
+ "a/b/a" touch-file
+ "b" make-directory
+ "b/a" make-directory
+ "b/a/a" touch-file
+ "b/b" make-directory
+ "b/b/a" touch-file
+ "c" make-directory
+ "c/a" make-directory
+ "c/a/a" touch-file
+ "c/b" make-directory
+ "c/b/a" touch-file
+
+ +depth-first+ traversal-method [
+ "." recursive-directory-files
+ current-directory get '[ _ ?head drop ] map
+
+ ! preserve file traversal order, but sort
+ ! alphabetically for cross-platform testing
+ dup length 3 / group natural-sort
+ [ natural-sort ] map concat
+ ] with-variable
+
+ +breadth-first+ traversal-method [
+ "." recursive-directory-files
+ current-directory get '[ _ ?head drop ] map
+
+ ! preserve file traversal order, but sort
+ ! alphabetically for cross-platform testing
+ [ [ length ] bi@ = ] monotonic-split
+ [ natural-sort ] map concat
+ ] with-variable
+ ] with-test-directory
+] unit-test
+
+{ { "classes/tuple/tuple.factor" } } [
+ "resource:core" [
+ "." directory-tree-files [ "classes/tuple/tuple.factor" = ] filter
+ ] with-directory
+] unit-test
+
+{ { "classes/tuple" } } [
+ "resource:core" [
+ "." directory-tree-files [ "classes/tuple" = ] filter
+ ] with-directory
+] unit-test
+
+{ { "classes/tuple/tuple.factor" } } [
+ "resource:core" [
+ [ "classes/tuple/tuple.factor" = ] filter
+ ] with-directory-tree-files
+] unit-test
! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators combinators.short-circuit
-continuations destructors fry io io.backend io.encodings.binary
-io.files io.pathnames kernel namespaces sequences system vocabs ;
+USING: accessors arrays assocs combinators
+combinators.short-circuit continuations deques destructors
+dlists fry io io.backend io.encodings.binary io.files
+io.files.info io.files.links io.files.types io.pathnames kernel
+kernel.private make math namespaces sequences sorting strings
+system unicode vocabs ;
IN: io.directories
: set-current-directory ( path -- )
: with-directory-files ( path quot -- )
'[ "" directory-files @ ] with-directory ; inline
+! Finding directories
+
: qualified-directory-entries ( path -- seq )
absolute-path
dup directory-entries [ [ append-path ] change-name ] with map! ;
: with-qualified-directory-entries ( path quot -- )
'[ "" qualified-directory-entries @ ] with-directory ; inline
+SYMBOL: traversal-method
+
+SYMBOLS: +depth-first+ +breadth-first+ ;
+
+traversal-method [ +depth-first+ ] initialize
+
+<PRIVATE
+
+TUPLE: directory-iterator
+{ path string }
+{ bfs boolean }
+{ queue dlist } ;
+
+: push-directory-entries ( path iter -- )
+ { directory-iterator } declare
+ [ [ qualified-directory-entries ] [ 2drop f ] recover ] dip
+ [ bfs>> [ [ <reversed> ] unless ] keep ]
+ [ queue>> swap '[ _ _ [ push-front ] [ push-back ] if ] each ] bi ;
+
+: <directory-iterator> ( path bfs? -- iter )
+ <dlist> directory-iterator boa
+ dup path>> over push-directory-entries ;
+
+: next-directory-entry ( iter -- directory-entry/f )
+ { directory-iterator } declare
+ dup queue>> deque-empty? [ drop f ] [
+ dup queue>> pop-back
+ dup directory?
+ [ [ name>> swap push-directory-entries ] keep ]
+ [ nip ] if
+ ] if ;
+
+:: iterate-directory-entries ( ... iter quot: ( ... obj -- ... obj ) -- ... directory-entry/f )
+ iter next-directory-entry [
+ quot call
+ [ iter quot iterate-directory-entries ] unless*
+ ] [
+ f
+ ] if* ; inline recursive
+
+: iterate-directory ( iter quot -- path/f )
+ [ name>> ] prepose iterate-directory-entries ; inline
+
+: bfs? ( -- bfs? )
+ traversal-method get {
+ { +breadth-first+ [ t ] }
+ { +depth-first+ [ f ] }
+ } case ; inline
+
+: setup-traversal ( path quot -- iter quot' )
+ [ bfs? <directory-iterator> ] dip [ f ] compose ; inline
+
+PRIVATE>
+
+: each-file ( ... path quot: ( ... name -- ... ) -- ... )
+ setup-traversal iterate-directory drop ; inline
+
+: each-directory-entry ( path quot: ( ... entry -- ... ) -- )
+ setup-traversal iterate-directory-entries drop ; inline
+
+: recursive-directory-files ( path -- paths )
+ [ ] collector [ each-file ] dip ;
+
+: recursive-directory-entries ( path -- directory-entries )
+ [ ] collector [ each-directory-entry ] dip ;
+
+: find-file ( path quot: ( ... name -- ... ? ) -- path/f )
+ [ bfs? <directory-iterator> ] dip
+ '[ _ keep and ] iterate-directory ; inline
+
+: find-files ( path quot: ( ... name -- ... ? ) -- paths )
+ selector [ each-file ] dip ; inline
+
+ERROR: sequence-expected obj ;
+
+: ensure-sequence-of-directories ( obj -- seq )
+ dup string? [ 1array ] when
+ dup sequence? [ sequence-expected ] unless ;
+
+: find-file-in-directories ( directories quot: ( ... name -- ... ? ) -- path'/f )
+ [ ensure-sequence-of-directories ] dip
+ '[ _ find-file ] map-find drop ; inline
+
+: find-files-in-directories ( directories quot: ( ... name -- ... ? ) -- paths/f )
+ [ ensure-sequence-of-directories ] dip
+ '[ _ find-files ] map concat ; inline
+
+: ?parent-directory ( path -- path'/f )
+ dup parent-directory 2dup = [ 2drop f ] [ nip ] if ;
+
+: containing-directory ( path -- path' )
+ dup file-info directory? [ parent-directory ] unless ;
+
+: ?qualified-directory-files ( path -- seq )
+ [ qualified-directory-files ]
+ [ drop ?parent-directory [ ?qualified-directory-files ] [ f ] if* ] recover ;
+
+: (find-up-to-root) ( path quot: ( path -- ? ) -- obj )
+ [ [ ?qualified-directory-files ] dip find swap ] 2keep rot [
+ 2drop
+ ] [
+ [ nip ?parent-directory ] dip over
+ [ (find-up-to-root) ] [ 2drop f ] if
+ ] if ; inline recursive
+
+: find-up-to-root ( path quot: ( path -- ? ) -- obj )
+ [ normalize-path containing-directory ] dip (find-up-to-root) ; inline
+
+: link-size/0 ( path -- n )
+ [ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
+
+: directory-size ( path -- n )
+ 0 swap [ link-size/0 + ] each-file ;
+
+: directory-usage ( path -- assoc )
+ [
+ [
+ [ name>> dup ] [ directory? ] bi
+ [ directory-size ] [ link-size/0 ] if
+ ] { } map>assoc
+ ] with-qualified-directory-entries sort-values ;
+
+: find-files-by-extensions ( path extensions -- seq )
+ [ >lower ] map
+ '[ >lower _ [ tail? ] with any? ] find-files ;
+
+: find-files-by-extension ( path extension -- seq )
+ 1array find-files-by-extensions ;
+
+: find-files-larger-than ( path size -- seq )
+ '[ link-info size>> _ > ] find-files ;
+
! Touching files
HOOK: touch-file io-backend ( path -- )
: copy-files-into ( files to -- )
'[ _ copy-file-into ] each ;
+<PRIVATE
+
+: directory-tree-files% ( path prefix -- )
+ [ dup directory-entries ] dip '[
+ [ name>> [ append-path ] [ _ prepend-path ] bi ]
+ [ directory? ] bi over ,
+ [ directory-tree-files% ] [ 2drop ] if
+ ] with each ;
+
+PRIVATE>
+
+: directory-tree-files ( path -- seq )
+ [ "" directory-tree-files% ] { } make ;
+
+: with-directory-tree-files ( path quot -- )
+ '[ "" directory-tree-files @ ] with-directory ; inline
+
+: delete-tree ( path -- )
+ dup link-info directory? [
+ [ [ [ delete-tree ] each ] with-directory-files ]
+ [ delete-directory ]
+ bi
+ ] [ delete-file ] if ;
+
+DEFER: copy-trees-into
+
+: copy-tree ( from to -- )
+ normalize-path
+ over link-info type>>
+ {
+ { +symbolic-link+ [ copy-link ] }
+ { +directory+ [ '[ _ copy-trees-into ] with-directory-files ] }
+ [ drop copy-file ]
+ } case ;
+
+: copy-tree-into ( from to -- )
+ to-directory copy-tree ;
+
+: copy-trees-into ( files to -- )
+ '[ _ copy-tree-into ] each ;
+
{
{ [ os unix? ] [ "io.directories.unix" require ] }
{ [ os windows? ] [ "io.directories.windows" require ] }
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: help.markup help.syntax quotations io.pathnames ;
-IN: io.directories.hierarchy
-
-HELP: directory-tree-files
-{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } }
-{ $description "Outputs a sequence of all files and subdirectories inside the directory named by " { $snippet "path" } " or recursively inside its subdirectories." } ;
-
-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: delete-tree
-{ $values { "path" "a pathname string" } }
-{ $description "Deletes a file or directory, recursing into subdirectories." }
-{ $errors "Throws an error if the deletion fails." }
-{ $warning "Misuse of this word can lead to catastrophic data loss." } ;
-
-HELP: copy-tree
-{ $values { "from" "a pathname string" } { "to" "a pathname string" } }
-{ $description "Copies a directory tree recursively." }
-{ $notes "This operation attempts to preserve original file attributes, however not all attributes may be preserved." }
-{ $errors "Throws an error if the copy operation fails." } ;
-
-HELP: copy-tree-into
-{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } }
-{ $description "Copies a directory tree to another directory, recursively." }
-{ $errors "Throws an error if the copy operation fails." } ;
-
-HELP: copy-trees-into
-{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } }
-{ $description "Copies a set of directory trees to another directory, recursively." }
-{ $errors "Throws an error if the copy operation fails." } ;
-
-ARTICLE: "io.directories.hierarchy" "Directory hierarchy manipulation"
-"The " { $vocab-link "io.directories.hierarchy" } " vocabulary defines words for operating on directory hierarchies recursively."
-$nl
-"There is a naming scheme used by " { $vocab-link "io.directories" } " and " { $vocab-link "io.directories.hierarchy" } ". Operations for deleting and copying files come in two forms:"
-{ $list
- { "Words named " { $snippet { $emphasis "operation" } "-file" } " which work on regular files only." }
- { "Words named " { $snippet { $emphasis "operation" } "-tree" } " works on directory trees recursively, and also accepts regular files." }
-}
-"Listing directory trees recursively:"
-{ $subsections
- directory-tree-files
- with-directory-tree-files
-}
-"Deleting directory trees recursively:"
-{ $subsections delete-tree }
-"Copying directory trees recursively:"
-{ $subsections
- copy-tree
- copy-tree-into
- copy-trees-into
-} ;
-
-ABOUT: "io.directories.hierarchy"
+++ /dev/null
-USING: io.directories io.directories.hierarchy kernel
-sequences tools.test ;
-
-{ { "classes/tuple/tuple.factor" } } [
- "resource:core" [
- "." directory-tree-files [ "classes/tuple/tuple.factor" = ] filter
- ] with-directory
-] unit-test
-
-{ { "classes/tuple" } } [
- "resource:core" [
- "." directory-tree-files [ "classes/tuple" = ] filter
- ] with-directory
-] unit-test
-
-{ { "classes/tuple/tuple.factor" } } [
- "resource:core" [
- [ "classes/tuple/tuple.factor" = ] filter
- ] with-directory-tree-files
-] unit-test
+++ /dev/null
-! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel sequences combinators fry
-io.directories io.pathnames io.files.info io.files.types
-io.files.links io.backend make ;
-IN: io.directories.hierarchy
-
-<PRIVATE
-
-: directory-tree-files% ( path prefix -- )
- [ dup directory-entries ] dip '[
- [ name>> [ append-path ] [ _ prepend-path ] bi ]
- [ directory? ] bi over ,
- [ directory-tree-files% ] [ 2drop ] if
- ] with each ;
-
-PRIVATE>
-
-: directory-tree-files ( path -- seq )
- [ "" directory-tree-files% ] { } make ;
-
-: with-directory-tree-files ( path quot -- )
- '[ "" directory-tree-files @ ] with-directory ; inline
-
-: delete-tree ( path -- )
- dup link-info directory? [
- [ [ [ delete-tree ] each ] with-directory-files ]
- [ delete-directory ]
- bi
- ] [ delete-file ] if ;
-
-DEFER: copy-trees-into
-
-: copy-tree ( from to -- )
- normalize-path
- over link-info type>>
- {
- { +symbolic-link+ [ copy-link ] }
- { +directory+ [ '[ _ copy-trees-into ] with-directory-files ] }
- [ drop copy-file ]
- } case ;
-
-: copy-tree-into ( from to -- )
- to-directory copy-tree ;
-
-: copy-trees-into ( files to -- )
- '[ _ copy-tree-into ] each ;
+++ /dev/null
-Deleting and copying directory hierarchies
+++ /dev/null
-Doug Coleman
+++ /dev/null
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax io.directories kernel quotations
-sequences ;
-IN: io.directories.search
-
-HELP: +depth-first+
-{ $description "Method of directory traversal that fully recurses as far as possible before backtracking." } ;
-
-HELP: +breadth-first+
-{ $description "Method of directory traversal that explores each level of graph fully before moving to the next level." } ;
-
-HELP: traversal-method
-{ $var-description "Determines directory traversal method, either " { $link +depth-first+ } " or " { $link +breadth-first+ } "." } ;
-
-HELP: each-file
-{ $values
- { "path" "a pathname string" } { "quot" quotation }
-}
-{ $description "Traverses a directory path recursively and calls the quotation on the full pathname of each file, in a breadth-first or depth-first " { $link traversal-method } "." }
-{ $examples
- { $unchecked-example "USING: sequences io.directories.search ;"
- "\"resource:misc\" [ . ] each-file"
- "! Recursive directory listing prints here"
- }
-} ;
-
-HELP: recursive-directory-files
-{ $values
- { "path" "a pathname string" }
- { "paths" { $sequence "pathname strings" } }
-}
-{ $description "Traverses a directory path recursively and returns a sequence of files, in a breadth-first or depth-first " { $link traversal-method } "." } ;
-
-HELP: recursive-directory-entries
-{ $values
- { "path" "a pathname string" }
- { "directory-entries" { $sequence directory-entry } }
-}
-{ $description "Traverses a directory path recursively and returns a sequence of directory-entries, in a breadth-first or depth-first " { $link traversal-method } "." } ;
-
-HELP: find-file
-{ $values
- { "path" "a pathname string" } { "quot" quotation }
- { "path/f" { $maybe "pathname string" } }
-}
-{ $description "Finds the first file in the input directory matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
-
-HELP: find-file-in-directories
-{ $values
- { "directories" "a sequence of pathnames" } { "quot" quotation }
- { "path'/f" { $maybe "pathname string" } }
-}
-{ $description "Finds the first file in the input directories matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
-
-HELP: find-files
-{ $values
- { "path" "a pathname string" } { "quot" quotation }
- { "paths" { $sequence "pathname strings" } }
-}
-{ $description "Recursively finds all files in the input directory matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
-
-HELP: find-files-in-directories
-{ $values
- { "directories" { $sequence "directory paths" } } { "quot" quotation }
- { "paths/f" { $maybe "a sequence of pathname strings" } }
-}
-{ $description "Finds all files in the input directories matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
-
-HELP: find-files-by-extension
-{ $values
- { "path" "a pathname string" } { "extension" "a file extension" }
- { "seq" sequence }
-}
-{ $description "Searches a directory for all files with the given extension. File extension and filenames are converted to lower-case and compared using the " { $link tail? } " word. The file extension should contain the period." }
-{ $examples
- { $code
- "USING: io.directories.search ;"
- "\"/\" \".mp3\" find-by-extension"
- }
-} ;
-
-HELP: find-files-by-extensions
-{ $values
- { "path" "a pathname string" } { "extensions" { $sequence "file extensions" } }
- { "seq" sequence }
-}
-{ $description "Searches a directory for all files in the given list of extensions. File extensions and filenames are converted to lower-case and compared using the " { $link tail? } " word. File extensions should contain the period." }
-{ $examples
- { $code
- "USING: io.directories.search ;"
- "\"/\" { \".jpg\" \".gif\" \".tiff\" \".png\" \".bmp\" } find-files-by-extensions"
- }
-} ;
-
-{ find-file find-files find-file-in-directories find-files-in-directories } related-words
-
-ARTICLE: "io.directories.search" "Searching directories"
-"The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl
-"Traversing directories:"
-{ $subsections
- recursive-directory-files
- recursive-directory-entries
- each-file
- each-directory-entry
-}
-"Finding files by name:"
-{ $subsections
- find-file
- find-files
- find-file-in-directories
- find-files-in-directories
-}
-"Finding files by extension:"
-{ $subsections
- find-files-by-extension
- find-files-by-extensions
-} ;
-
-ABOUT: "io.directories.search"
+++ /dev/null
-USING: combinators fry grouping io.directories
-io.directories.hierarchy io.directories.search io.files.unique
-io.pathnames kernel math namespaces sequences sorting splitting
-splitting.monotonic strings tools.test ;
-
-{ t } [
- [
- 10 [ "io.paths.test" "gogogo" unique-file ] replicate
- "." [ ] find-files [ natural-sort ] same?
- ] with-test-directory
-] unit-test
-
-{ f } [
- { "omg you shoudnt have a directory called this" "or this" }
- [ "asdfasdfasdfasdfasdf" tail? ] find-file-in-directories
-] unit-test
-
-{ f } [
- { } [ "asdfasdfasdfasdfasdf" tail? ] find-file-in-directories
-] unit-test
-
-{ t } [
- [
- "the-head" "" unique-file drop
- "." [ file-name "the-head" head? ] find-file string?
- ] with-test-directory
-] unit-test
-
-{ t } [
- [
- { "foo" "bar" } {
- [ [ make-directory ] each ]
- [ [ "abcd" append-path touch-file ] each ]
- [ [ file-name "abcd" = ] find-files-in-directories length 2 = ]
- [ [ delete-tree ] each ]
- } cleave
- ] with-test-directory
-] unit-test
-
-{ t } [
- "resource:core/math/integers/integers.factor"
- [ "math.factor" tail? ] find-up-to-root >boolean
-] unit-test
-
-{ f } [
- "resource:core/math/integers/integers.factor"
- [ drop f ] find-up-to-root
-] unit-test
-
-[
- {
- "/a"
- "/a/a"
- "/a/a/a"
- "/a/b"
- "/a/b/a"
- "/b"
- "/b/a"
- "/b/a/a"
- "/b/b"
- "/b/b/a"
- "/c"
- "/c/a"
- "/c/a/a"
- "/c/b"
- "/c/b/a"
- }
- {
- "/a"
- "/b"
- "/c"
- "/a/a"
- "/a/b"
- "/b/a"
- "/b/b"
- "/c/a"
- "/c/b"
- "/a/a/a"
- "/a/b/a"
- "/b/a/a"
- "/b/b/a"
- "/c/a/a"
- "/c/b/a"
- }
-] [
- [
- "a" make-directory
- "a/a" make-directory
- "a/a/a" touch-file
- "a/b" make-directory
- "a/b/a" touch-file
- "b" make-directory
- "b/a" make-directory
- "b/a/a" touch-file
- "b/b" make-directory
- "b/b/a" touch-file
- "c" make-directory
- "c/a" make-directory
- "c/a/a" touch-file
- "c/b" make-directory
- "c/b/a" touch-file
-
- +depth-first+ traversal-method [
- "." recursive-directory-files
- current-directory get '[ _ ?head drop ] map
-
- ! preserve file traversal order, but sort
- ! alphabetically for cross-platform testing
- dup length 3 / group natural-sort
- [ natural-sort ] map concat
- ] with-variable
-
- +breadth-first+ traversal-method [
- "." recursive-directory-files
- current-directory get '[ _ ?head drop ] map
-
- ! preserve file traversal order, but sort
- ! alphabetically for cross-platform testing
- [ [ length ] bi@ = ] monotonic-split
- [ natural-sort ] map concat
- ] with-variable
- ] with-test-directory
-] unit-test
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators continuations deques
-dlists fry io.backend io.directories io.files.info io.pathnames
-kernel kernel.private locals math namespaces sequences sorting
-strings system unicode vocabs ;
-IN: io.directories.search
-
-SYMBOL: traversal-method
-
-SYMBOLS: +depth-first+ +breadth-first+ ;
-
-traversal-method [ +depth-first+ ] initialize
-
-<PRIVATE
-
-TUPLE: directory-iterator
-{ path string }
-{ bfs boolean }
-{ queue dlist } ;
-
-: push-directory-entries ( path iter -- )
- { directory-iterator } declare
- [ [ qualified-directory-entries ] [ 2drop f ] recover ] dip
- [ bfs>> [ [ <reversed> ] unless ] keep ]
- [ queue>> swap '[ _ _ [ push-front ] [ push-back ] if ] each ] bi ;
-
-: <directory-iterator> ( path bfs? -- iter )
- <dlist> directory-iterator boa
- dup path>> over push-directory-entries ;
-
-: next-directory-entry ( iter -- directory-entry/f )
- { directory-iterator } declare
- dup queue>> deque-empty? [ drop f ] [
- dup queue>> pop-back
- dup directory?
- [ [ name>> swap push-directory-entries ] keep ]
- [ nip ] if
- ] if ;
-
-:: iterate-directory-entries ( ... iter quot: ( ... obj -- ... obj ) -- ... directory-entry/f )
- iter next-directory-entry [
- quot call
- [ iter quot iterate-directory-entries ] unless*
- ] [
- f
- ] if* ; inline recursive
-
-: iterate-directory ( iter quot -- path/f )
- [ name>> ] prepose iterate-directory-entries ; inline
-
-: bfs? ( -- bfs? )
- traversal-method get {
- { +breadth-first+ [ t ] }
- { +depth-first+ [ f ] }
- } case ; inline
-
-: setup-traversal ( path quot -- iter quot' )
- [ bfs? <directory-iterator> ] dip [ f ] compose ; inline
-
-PRIVATE>
-
-: each-file ( ... path quot: ( ... name -- ... ) -- ... )
- setup-traversal iterate-directory drop ; inline
-
-: each-directory-entry ( path quot: ( ... entry -- ... ) -- )
- setup-traversal iterate-directory-entries drop ; inline
-
-: recursive-directory-files ( path -- paths )
- [ ] collector [ each-file ] dip ;
-
-: recursive-directory-entries ( path -- directory-entries )
- [ ] collector [ each-directory-entry ] dip ;
-
-: find-file ( path quot: ( ... name -- ... ? ) -- path/f )
- [ bfs? <directory-iterator> ] dip
- '[ _ keep and ] iterate-directory ; inline
-
-: find-files ( path quot: ( ... name -- ... ? ) -- paths )
- selector [ each-file ] dip ; inline
-
-ERROR: sequence-expected obj ;
-
-: ensure-sequence-of-directories ( obj -- seq )
- dup string? [ 1array ] when
- dup sequence? [ sequence-expected ] unless ;
-
-: find-file-in-directories ( directories quot: ( ... name -- ... ? ) -- path'/f )
- [ ensure-sequence-of-directories ] dip
- '[ _ find-file ] map-find drop ; inline
-
-: find-files-in-directories ( directories quot: ( ... name -- ... ? ) -- paths/f )
- [ ensure-sequence-of-directories ] dip
- '[ _ find-files ] map concat ; inline
-
-: ?parent-directory ( path -- path'/f )
- dup parent-directory 2dup = [ 2drop f ] [ nip ] if ;
-
-: containing-directory ( path -- path' )
- dup file-info directory? [ parent-directory ] unless ;
-
-: ?qualified-directory-files ( path -- seq )
- [ qualified-directory-files ]
- [ drop ?parent-directory [ ?qualified-directory-files ] [ f ] if* ] recover ;
-
-: (find-up-to-root) ( path quot: ( path -- ? ) -- obj )
- [ [ ?qualified-directory-files ] dip find swap ] 2keep rot [
- 2drop
- ] [
- [ nip ?parent-directory ] dip over
- [ (find-up-to-root) ] [ 2drop f ] if
- ] if ; inline recursive
-
-: find-up-to-root ( path quot: ( path -- ? ) -- obj )
- [ normalize-path containing-directory ] dip (find-up-to-root) ; inline
-
-: link-size/0 ( path -- n )
- [ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
-
-: directory-size ( path -- n )
- 0 swap [ link-size/0 + ] each-file ;
-
-: directory-usage ( path -- assoc )
- [
- [
- [ name>> dup ] [ directory? ] bi
- [ directory-size ] [ link-size/0 ] if
- ] { } map>assoc
- ] with-qualified-directory-entries sort-values ;
-
-: find-files-by-extensions ( path extensions -- seq )
- [ >lower ] map
- '[ >lower _ [ tail? ] with any? ] find-files ;
-
-: find-files-by-extension ( path extension -- seq )
- 1array find-files-by-extensions ;
-
-: find-files-larger-than ( path size -- seq )
- '[ link-info size>> _ > ] find-files ;
+++ /dev/null
-Recursive directory traversal
-USING: accessors continuations io.directories
-io.directories.hierarchy io.encodings.ascii io.files
-io.files.info io.files.temp io.files.unique io.pathnames kernel
-namespaces sequences strings tools.test ;
+USING: accessors continuations io.directories io.encodings.ascii
+io.files io.files.info io.files.temp io.files.unique
+io.pathnames kernel namespaces sequences strings tools.test ;
{ 123 } [
[
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators continuations fry io.backend io.directories
-io.directories.hierarchy io.pathnames kernel locals namespaces
-random.data sequences system vocabs ;
+io.pathnames kernel locals namespaces random.data sequences
+system vocabs ;
IN: io.files.unique
<PRIVATE
USING: accessors math kernel namespaces continuations
io.files io.monitors io.monitors.recursive io.backend
concurrency.mailboxes tools.test destructors io.files.info
-io.pathnames io.files.temp io.directories.hierarchy fry ;
+io.pathnames io.files.temp io.directories fry ;
IN: io.monitors.recursive.tests
SINGLETON: mock-io-backend
! Copyright (C) 2011 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators.smart environment fry
-io.directories.search io.files io.pathnames io.standard-paths
+io.directories io.files io.pathnames io.standard-paths
kernel sequences sets splitting system unicode windows.shell32 ;
IN: io.standard-paths.windows
-USING: continuations io io.directories.hierarchy io.files.temp
-logging logging.analysis logging.server math tools.test ;
+USING: continuations io io.files.temp logging logging.analysis
+logging.server math tools.test ;
IN: logging.tests
: input-logging-test ( a b -- c ) + ;
! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.files io.files.info.unix io.pathnames
-io.directories io.directories.hierarchy kernel namespaces make
+io.directories kernel namespaces make
sequences system tools.deploy.backend tools.deploy.config
tools.deploy.config.editor assocs hashtables prettyprint
io.backend.unix cocoa io.encodings.utf8 io.backend
! Copyright (C) 2010 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
-USING: globs io.directories io.directories.hierarchy
-io.files.info io.pathnames kernel regexp sequences sets
-vocabs.loader vocabs.metadata ;
+USING: globs io.directories io.files.info io.pathnames kernel
+regexp sequences sets vocabs.loader vocabs.metadata ;
IN: vocabs.metadata.resources
<PRIVATE
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs calendar calendar.format
combinators combinators.short-circuit fry io io.backend
-io.directories io.directories.hierarchy io.encodings.binary
-io.encodings.detect io.encodings.utf8 io.files io.files.info
-io.files.temp io.files.types io.files.unique io.launcher
-io.pathnames kernel locals math math.parser namespaces sequences
-sorting strings system unicode xml.syntax xml.writer
-xmode.catalog xmode.marker xmode.tokens ;
+io.directories io.encodings.binary io.encodings.detect
+io.encodings.utf8 io.files io.files.info io.files.temp
+io.files.types io.files.unique io.launcher io.pathnames kernel
+locals math math.parser namespaces sequences sorting strings
+system unicode xml.syntax xml.writer xmode.catalog xmode.marker
+xmode.tokens ;
IN: codebook
! Usage: "my/source/tree" codebook
USING: accessors arrays assocs assocs.extras calendar
calendar.format checksums checksums.sha combinators
combinators.smart compression.zlib constructors fry grouping io
-io.binary io.directories io.directories.search
-io.encodings.binary io.encodings.string io.encodings.utf8
-io.files io.files.info io.pathnames io.streams.byte-array
-io.streams.peek kernel math math.bitwise math.parser
-math.statistics memoize namespaces random sequences
+io.binary io.directories io.encodings.binary io.encodings.string
+io.encodings.utf8 io.files io.files.info io.pathnames
+io.streams.byte-array io.streams.peek kernel math math.bitwise
+math.parser math.statistics memoize namespaces random sequences
sequences.extras splitting strings ;
IN: git
unicode byte-arrays io.encodings.string
io.encodings.utf16 assocs math.parser combinators.short-circuit
fry namespaces combinators.smart splitting io.encodings.ascii
-arrays io.files.info io.directories.search literals
+arrays io.files.info io.directories literals
math.functions continuations ;
FROM: alien.c-types => uchar ;
IN: id3
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays io.directories io.directories.hierarchy io.files
-kernel mason.common mason.config mason.platform namespaces ;
+USING: arrays io.directories io.files kernel mason.common
+mason.config mason.platform namespaces ;
IN: mason.cleanup
: compress ( filename -- )
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors continuations debugger io io.directories
-io.directories.hierarchy io.encodings.utf8 io.files io.launcher
-io.sockets io.streams.string kernel mason.common mason.email sequences
+io.encodings.utf8 io.files io.launcher io.sockets
+io.streams.string kernel mason.common mason.email sequences
splitting ;
IN: mason.git
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators io.directories
-io.directories.hierarchy io.files io.pathnames kernel literals
-locals make mason.common mason.config mason.platform namespaces
-sequences system words ;
+io.files io.pathnames kernel literals locals make mason.common
+mason.config mason.platform namespaces sequences system words ;
IN: mason.release.archive
: base-name ( -- string )
! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image io.directories io.directories.hierarchy
-io.files kernel namespaces sequences system ;
+USING: bootstrap.image io.directories io.files kernel namespaces
+sequences system ;
FROM: mason.config => target-os ;
IN: mason.release.tidy
-USING: io.directories io.directories.hierarchy io.files
-io.files.temp kernel mason.common mason.config mason.report
-namespaces tools.test xml xml.writer ;
+USING: io.directories io.files io.files.temp kernel mason.common
+mason.config mason.report namespaces tools.test xml xml.writer ;
IN: mason.report.tests
{ 0 0 } [ [ ] with-report ] must-infer-as
! Copyright (C) 2018 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: base91 combinators command-line escape-strings fry
-io.backend io.directories io.directories.search
-io.encodings.binary io.encodings.utf8 io.files io.files.info
-io.pathnames kernel locals math namespaces sequences
-sequences.extras splitting ;
+io.backend io.directories io.encodings.binary io.encodings.utf8
+io.files io.files.info io.pathnames kernel locals math
+namespaces sequences sequences.extras splitting ;
IN: tools.directory-to-file
: file-is-text? ( path -- ? )
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors furnace.actions help.html
-http.server.responses io.directories io.directories.hierarchy
-io.files io.launcher io.pathnames kernel mason.config memoize
-namespaces sequences threads webapps.mason.utils ;
+USING: accessors furnace.actions help.html http.server.responses
+io.directories io.files io.launcher io.pathnames kernel
+mason.config memoize namespaces sequences threads
+webapps.mason.utils ;
IN: webapps.mason.docs-update
: docs-path ( -- path )
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image bootstrap.image.download io
-io.directories io.directories.hierarchy io.files.temp
-io.files.unique io.launcher io.pathnames kernel namespaces
-sequences mason.common mason.config webapps.mason.version.files ;
+io.directories io.files.temp io.files.unique io.launcher
+io.pathnames kernel namespaces sequences mason.common
+mason.config webapps.mason.version.files ;
IN: webapps.mason.version.source
: clone-factor ( -- )
projects / factor.git / commitdiff