From 7f93d335a656611cc656ebe6fd8bf576a82453f3 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 8 Dec 2008 20:10:52 -0600
Subject: [PATCH] fix bug in io.paths, add io.paths.windows

---
 extra/io/paths/paths.factor           | 23 ++++++++++++++++-------
 extra/io/paths/windows/authors.txt    |  1 +
 extra/io/paths/windows/tags.txt       |  1 +
 extra/io/paths/windows/windows.factor | 13 +++++++++++++
 4 files changed, 31 insertions(+), 7 deletions(-)
 create mode 100644 extra/io/paths/windows/authors.txt
 create mode 100644 extra/io/paths/windows/tags.txt
 create mode 100644 extra/io/paths/windows/windows.factor

diff --git a/extra/io/paths/paths.factor b/extra/io/paths/paths.factor
index 8237e59a1b..75d08b60f8 100755
--- a/extra/io/paths/paths.factor
+++ b/extra/io/paths/paths.factor
@@ -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
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/extra/io/paths/windows/authors.txt
@@ -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
index 0000000000..6bf68304bb
--- /dev/null
+++ b/extra/io/paths/windows/tags.txt
@@ -0,0 +1 @@
+unportable
diff --git a/extra/io/paths/windows/windows.factor b/extra/io/paths/windows/windows.factor
new file mode 100644
index 0000000000..b4858aaef8
--- /dev/null
+++ b/extra/io/paths/windows/windows.factor
@@ -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