]> gitweb.factorcode.org Git - factor.git/commitdiff
fix bug in io.paths, add io.paths.windows
authorDoug Coleman <doug.coleman@gmail.com>
Tue, 9 Dec 2008 02:10:52 +0000 (20:10 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Tue, 9 Dec 2008 02:10:52 +0000 (20:10 -0600)
extra/io/paths/paths.factor
extra/io/paths/windows/authors.txt [new file with mode: 0644]
extra/io/paths/windows/tags.txt [new file with mode: 0644]
extra/io/paths/windows/windows.factor [new file with mode: 0644]

index 8237e59a1b526436f8a7f2f1e5eb1f0a81f9b946..75d08b60f81ed0d37cf58d34532a540676a10604 100755 (executable)
@@ -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
diff --git a/extra/io/paths/windows/authors.txt b/extra/io/paths/windows/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/extra/io/paths/windows/tags.txt b/extra/io/paths/windows/tags.txt
new file mode 100644 (file)
index 0000000..6bf6830
--- /dev/null
@@ -0,0 +1 @@
+unportable
diff --git a/extra/io/paths/windows/windows.factor b/extra/io/paths/windows/windows.factor
new file mode 100644 (file)
index 0000000..b4858aa
--- /dev/null
@@ -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