steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix finding files

db4
Doug Coleman 2009-01-16 12:34:59 -06:00
parent d8b8c82a56
commit 4e7298cfa4
3 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/io/directories/search/search-docs.factor
View File

@ -32,21 +32,21 @@ HELP: find-file
HELP: find-in-directories HELP: find-in-directories
{ $values { $values
{ "directories" "a sequence of pathnames" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } { "directories" "a sequence of pathnames" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
{ "path'" "a pathname string" } { "path'/f" "a pathname string or f" }
} }
{ $description "Finds the first file in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ; { $description "Finds the first file in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;
HELP: find-all-files HELP: find-all-files
{ $values { $values
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
{ "paths" "a sequence of pathname strings" } { "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 "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ;
HELP: find-all-in-directories HELP: find-all-in-directories
{ $values { $values
{ "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } { "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
{ "paths" "a sequence of pathname strings" } { "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." } ; { $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;

18
basis/io/directories/search/search.factor
View File

@ -46,17 +46,21 @@ PRIVATE>
[ ] accumulator [ each-file ] dip ; [ ] accumulator [ each-file ] dip ;
: find-file ( path bfs? quot: ( obj -- ? ) -- path/f ) : find-file ( path bfs? quot: ( obj -- ? ) -- path/f )
[ <directory-iterator> ] dip '[
[ keep and ] curry iterate-directory ; inline _ _ _ [ <directory-iterator> ] dip
[ keep and ] curry iterate-directory
] [ drop f ] recover ; inline
: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths ) : find-all-files ( path bfs? quot: ( obj -- ? ) -- paths/f )
[ <directory-iterator> ] dip '[
pusher [ [ f ] compose iterate-directory drop ] dip ; inline _ _ _ [ <directory-iterator> ] dip
pusher [ [ f ] compose iterate-directory drop ] dip
] [ drop f ] recover ; inline
: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path' ) : find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f )
'[ _ _ find-file ] attempt-all ; '[ _ _ find-file ] attempt-all ;
: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths ) : find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
'[ _ _ find-all-files ] map concat ; '[ _ _ find-all-files ] map concat ;
os windows? [ "io.directories.search.windows" require ] when os windows? [ "io.directories.search.windows" require ] when

2
basis/windows/shell32/shell32.factor
View File

@ -94,7 +94,7 @@ ALIAS: ShellExecute ShellExecuteW
: shell32-directory ( n -- str ) : shell32-directory ( n -- str )
f swap f SHGFP_TYPE_DEFAULT f swap f SHGFP_TYPE_DEFAULT
MAX_UNICODE_PATH "ushort" <c-array> MAX_UNICODE_PATH "ushort" <c-array>
[ SHGetFolderPath shell32-error ] keep utf16n alien>string ; [ SHGetFolderPath drop ] keep utf16n alien>string ;
: desktop ( -- str ) : desktop ( -- str )
CSIDL_DESKTOPDIRECTORY shell32-directory ; CSIDL_DESKTOPDIRECTORY shell32-directory ;