diff --git a/Makefile b/Makefile index 511c191711..9be68fea81 100644 --- a/Makefile +++ b/Makefile @@ -7,7 +7,6 @@ CONSOLE_EXECUTABLE = factor-console TEST_LIBRARY = factor-ffi-test VERSION = 0.92 -IMAGE = factor.image BUNDLE = Factor.app LIBPATH = -L/usr/X11R6/lib CFLAGS = -Wall @@ -152,17 +151,17 @@ macosx.app: factor @executable_path/../Frameworks/libfactor.dylib \ Factor.app/Contents/MacOS/factor -factor: $(DLL_OBJS) $(EXE_OBJS) +$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS) $(LINKER) $(ENGINE) $(DLL_OBJS) $(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ $(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS) -factor-console: $(DLL_OBJS) $(EXE_OBJS) +$(CONSOLE_EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS) $(LINKER) $(ENGINE) $(DLL_OBJS) $(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ $(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS) -factor-ffi-test: vm/ffi_test.o +$(TEST_LIBRARY): vm/ffi_test.o $(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS) clean: diff --git a/basis/io/directories/search/search-docs.factor b/basis/io/directories/search/search-docs.factor index 818899606d..a6c82a1bff 100644 --- a/basis/io/directories/search/search-docs.factor +++ b/basis/io/directories/search/search-docs.factor @@ -15,13 +15,20 @@ HELP: each-file } } ; -HELP: recursive-directory +HELP: recursive-directory-files { $values { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "paths" "a sequence of pathname strings" } } { $description "Traverses a directory path recursively and returns a sequence of files in a breadth-first or depth-first manner." } ; +HELP: recursive-directory-entries +{ $values + { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } + { "directory-entries" "a sequence of directory-entries" } +} +{ $description "Traverses a directory path recursively and returns a sequence of directory-entries in a breadth-first or depth-first manner." } ; + HELP: find-file { $values { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } @@ -41,11 +48,11 @@ HELP: find-all-files { "path" "a pathname string" } { "quot" quotation } { "paths/f" "a sequence of pathname strings or f" } } -{ $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ; +{ $description "Recursively finds all files in the input directory matching the predicate quotation." } ; HELP: find-all-in-directories { $values - { "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } + { "directories" "a sequence of directory paths" } { "quot" quotation } { "paths/f" "a sequence of pathname strings or f" } } { $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ; @@ -55,7 +62,8 @@ HELP: find-all-in-directories 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:" -{ $subsection recursive-directory } +{ $subsection recursive-directory-files } +{ $subsection recursive-directory-entries } { $subsection each-file } "Finding files:" { $subsection find-file } diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor index 5281ca9c2b..db4b58c4fd 100644 --- a/basis/io/directories/search/search-tests.factor +++ b/basis/io/directories/search/search-tests.factor @@ -1,12 +1,14 @@ -USING: io.directories.search io.files io.files.unique -io.pathnames kernel namespaces sequences sorting tools.test ; +USING: combinators.smart io.directories +io.directories.hierarchy io.directories.search io.files +io.files.unique io.pathnames kernel namespaces sequences +sorting strings tools.test ; IN: io.directories.search.tests [ t ] [ [ 10 [ "io.paths.test" "gogogo" make-unique-file ] replicate current-temporary-directory get [ ] find-all-files - ] with-unique-directory drop [ natural-sort ] bi@ = + ] cleanup-unique-directory [ natural-sort ] bi@ = ] unit-test [ f ] [ @@ -18,3 +20,18 @@ IN: io.directories.search.tests [ f ] [ { } t [ "asdfasdfasdfasdfasdf" tail? ] find-in-directories ] unit-test + +[ t ] [ + [ + current-temporary-directory get + "the-head" unique-file drop t + [ file-name "the-head" head? ] find-file string? + ] cleanup-unique-directory +] unit-test + +[ t ] [ + [ unique-directory unique-directory ] output>array + [ [ "abcd" append-path touch-file ] each ] + [ [ file-name "abcd" = ] find-all-in-directories length 2 = ] + [ [ delete-tree ] each ] tri +] unit-test diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 87fbf67110..2202f7aa08 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -3,7 +3,7 @@ USING: accessors arrays continuations deques dlists fry io.directories io.files io.files.info io.pathnames kernel sequences system vocabs.loader locals math namespaces -sorting assocs calendar threads ; +sorting assocs calendar threads io math.parser ; IN: io.directories.search : qualified-directory-entries ( path -- seq ) @@ -13,90 +13,97 @@ IN: io.directories.search : qualified-directory-files ( path -- seq ) dup directory-files [ append-path ] with map ; -> ] when ] dip - [ qualified-directory-entries ] dip '[ - _ [ queue>> ] [ bfs>> ] bi - [ push-front ] [ push-back ] if - ] each ; - -: ( path bfs? -- iterator ) - directory-iterator boa - dup path>> over push-directory ; - -: next-file ( iter -- file/f ) - dup queue>> deque-empty? [ drop f ] [ - dup queue>> pop-back dup directory? - [ over push-directory next-file ] - [ nip name>> ] if - ] if ; - -:: iterate-directory ( iter quot: ( obj -- ? ) -- obj ) - iter next-file [ - quot call [ iter quot iterate-directory ] unless* - ] [ - f - ] if* ; inline recursive - -PRIVATE> - -: each-file ( path bfs? quot: ( obj -- ) -- ) - [ ] dip - [ f ] compose iterate-directory drop ; inline - -: recursive-directory ( path bfs? -- paths ) - [ ] accumulator [ each-file ] dip ; - -: find-file ( path bfs? quot: ( obj -- ? ) -- path/f ) - '[ - _ _ _ [ ] dip - [ keep and ] curry iterate-directory - ] [ drop f ] recover ; inline - -: find-all-files ( path quot: ( obj -- ? ) -- paths/f ) - f swap - '[ - _ _ _ [ ] dip - pusher [ [ f ] compose iterate-directory drop ] dip - ] [ drop f ] recover ; inline - -ERROR: file-not-found ; - -: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f ) - '[ - _ [ _ _ find-file [ file-not-found ] unless* ] attempt-all - ] [ - drop f - ] recover ; inline - -: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f ) - '[ _ _ find-all-files ] map concat ; inline - : with-qualified-directory-files ( path quot -- ) '[ "" qualified-directory-files @ ] with-directory ; inline : with-qualified-directory-entries ( path quot -- ) '[ "" qualified-directory-entries @ ] with-directory ; inline +> ] [ bfs>> ] bi + [ push-front ] [ push-back ] if + ] each ; + +: ( path bfs? -- iterator ) + directory-iterator boa + dup path>> over push-directory-entries ; + +: next-directory-entry ( iter -- directory-entry/f ) + dup queue>> deque-empty? [ drop f ] [ + dup queue>> pop-back + dup directory? + [ name>> over push-directory-entries next-directory-entry ] + [ nip ] if + ] if ; recursive + +:: iterate-directory-entries ( iter quot -- directory-entry/f ) + iter next-directory-entry [ + quot call( obj -- obj ) + [ iter quot iterate-directory-entries ] unless* + ] [ + f + ] if* ; inline recursive + +: iterate-directory ( iter quot -- path/f ) + [ name>> ] prepose iterate-directory-entries ; + +: setup-traversal ( path bfs quot -- iterator quot' ) + [ ] dip [ f ] compose ; + +PRIVATE> + +: each-file ( path bfs? quot -- ) + setup-traversal iterate-directory drop ; + +: each-directory-entry ( path bfs? quot -- ) + setup-traversal iterate-directory-entries drop ; + +: recursive-directory-files ( path bfs? -- paths ) + [ ] accumulator [ each-file ] dip ; + +: recursive-directory-entries ( path bfs? -- paths ) + [ ] accumulator [ each-directory-entry ] dip ; + +: find-file ( path bfs? quot -- path/f ) + [ ] dip + [ keep and ] curry iterate-directory ; + +: find-all-files ( path quot -- paths/f ) + [ f ] dip pusher + [ [ f ] compose iterate-directory drop ] dip ; + +ERROR: file-not-found path bfs? quot ; + +: find-file-throws ( path bfs? quot -- path ) + 3dup find-file dup [ 2nip nip ] [ drop file-not-found ] if ; + +: find-in-directories ( directories bfs? quot -- path'/f ) + '[ _ [ _ _ find-file-throws ] attempt-all ] + [ drop f ] recover ; + +: find-all-in-directories ( directories quot -- paths/f ) + '[ _ find-all-files ] map concat ; + +: link-size/0 ( path -- n ) + [ link-info size-on-disk>> ] [ 2drop 0 ] recover ; + : directory-size ( path -- n ) - 0 swap t [ - [ link-info size-on-disk>> + ] [ 2drop ] recover - ] each-file ; + 0 swap t [ link-size/0 + ] each-file ; : path>usage ( directory-entry -- name size ) - [ name>> dup ] [ directory? ] bi [ - directory-size - ] [ - [ link-info size-on-disk>> ] [ 2drop 0 ] recover - ] if ; + [ name>> dup ] [ directory? ] bi + [ directory-size ] [ link-size/0 ] if ; : directory-usage ( path -- assoc ) [ - [ [ path>usage ] [ drop name>> 0 ] recover ] { } map>assoc + [ + [ path>usage ] [ drop name>> 0 ] recover + ] { } map>assoc ] with-qualified-directory-entries sort-values ; os windows? [ "io.directories.search.windows" require ] when