fix bug in io.paths, add io.paths.windows

db4
Doug Coleman 2008-12-08 20:10:52 -06:00
parent 65c54b7220
commit 7f93d335a6
4 changed files with 31 additions and 7 deletions

View File

@ -1,11 +1,13 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: io.files kernel sequences accessors
dlists deques arrays ;
USING: accessors arrays deques dlists io.files io.paths.private
kernel sequences system vocabs.loader fry continuations ;
IN: io.paths
TUPLE: directory-iterator path bfs queue ;
<PRIVATE
: qualified-directory ( path -- seq )
dup directory-files [ append-path ] with map ;
@ -25,25 +27,32 @@ TUPLE: directory-iterator path bfs queue ;
[ over push-directory next-file ] [ nip ] if
] if ;
: iterate-directory ( iter quot -- obj )
: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
over next-file [
over call
[ 2drop ] [ iterate-directory ] if
[ 2nip ] [ iterate-directory ] if*
] [
2drop f
] if* ; inline recursive
: find-file ( path bfs? quot -- path/f )
PRIVATE>
: find-file ( path bfs? quot: ( obj -- ? ) -- path/f )
[ <directory-iterator> ] dip
[ keep and ] curry iterate-directory ; inline
: each-file ( path bfs? quot -- )
: each-file ( path bfs? quot: ( obj -- ? ) -- )
[ <directory-iterator> ] dip
[ f ] compose iterate-directory drop ; inline
: find-all-files ( path bfs? quot -- paths )
: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths )
[ <directory-iterator> ] dip
pusher [ [ f ] compose iterate-directory drop ] dip ; inline
: recursive-directory ( path bfs? -- paths )
[ ] accumulator [ each-file ] dip ;
: find-in-directories ( directories bfs? quot -- path' )
'[ _ _ find-file ] attempt-all ; inline
os windows? [ "io.paths.windows" require ] when

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1 @@
unportable

View File

@ -0,0 +1,13 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays continuations fry io.files io.paths
kernel windows.shell32 sequences ;
IN: io.paths.windows
: program-files-directories ( -- array )
program-files program-files-x86 2array ; inline
: find-in-program-files ( base-directory bfs? quot -- path )
[
[ program-files-directories ] dip '[ _ append-path ] map
] 2dip find-in-directories ; inline