making directory listing tool configurable, use bi in io.directories.search

basis/io/directories/search/search.factor

@@ -14,7 +14,7 @@ TUPLE: directory-iterator path bfs queue ;
 
 : push-directory ( path iter -- )
     [ qualified-directory ] dip [
-        dup queue>> swap bfs>>
+        [ queue>> ] [ bfs>> ] bi
         [ push-front ] [ push-back ] if
     ] curry each ;
 

basis/tools/files/files-tests.factor

@@ -1,10 +1,8 @@
-! Copyright (C) 2008 Your name.
+! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test tools.files strings kernel ;
 IN: tools.files.tests
 
-\ directory. must-infer
-
 [ ] [ "" directory. ] unit-test
 
 [ ] [ file-systems. ] unit-test

basis/tools/files/files.factor

@@ -1,24 +1,29 @@
-! Copyright (C) 2008 Doug Coleman.
+! Copyright (C) 2008, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators io io.files io.files.info
+USING: accessors arrays calendar combinators fry io io.directories
-io.directories kernel math.parser sequences system vocabs.loader
+io.files.info kernel math math.parser prettyprint sequences system
-calendar math fry prettyprint ;
+vocabs.loader sorting.slots ;
 IN: tools.files
 
-SYMBOLS: permissions file-name nlinks file-size date ;
-
 <PRIVATE
 
-: ls-time ( timestamp -- string )
+: dir-or-size ( file-info -- str )
+    dup directory? [
+        drop "<DIR>" 20 CHAR: \s pad-right
+    ] [
+        size>> number>string 20 CHAR: \s pad-left
+    ] if ;
+
+: listing-time ( timestamp -- string )
     [ hour>> ] [ minute>> ] bi
     [ number>string 2 CHAR: 0 pad-left ] bi@ ":" glue ;
 
-: ls-timestamp ( timestamp -- string )
+: listing-timestamp ( timestamp -- string )
     [ month>> month-abbreviation ]
     [ day>> number>string 2 CHAR: \s pad-left ]
     [
         dup year>> dup now year>> =
-        [ drop ls-time ] [ nip number>string ] if
+        [ drop listing-time ] [ nip number>string ] if
         5 CHAR: \s pad-left
     ] tri 3array " " join ;
 
@@ -28,12 +33,53 @@ SYMBOLS: permissions file-name nlinks file-size date ;
 
 : execute>string ( ? -- string ) "x" "-" ? ; inline
 
-HOOK: (directory.) os ( path -- lines )
-
 PRIVATE>
 
-: directory. ( path -- )
+SYMBOLS: file-name file-name/type permissions file-type nlinks file-size
-    [ (directory.) ] with-directory-files [ print ] each ;
+file-datetime file-time uid gid user group link-target unix-datetime
+directory-or-size ;
+
+TUPLE: listing-tool path specs sort ;
+
+TUPLE: file-listing directory-entry file-info ;
+
+C: <file-listing> file-listing
+
+: <listing-tool> ( path -- listing-tool )
+    listing-tool new
+        swap >>path
+        { file-name } >>specs ;
+
+: list-slow? ( listing-tool -- ? )
+    specs>> { file-name } sequence= not ;
+
+ERROR: unknown-file-spec symbol ;
+
+HOOK: file-spec>string os ( file-listing spec -- string )
+
+M: object file-spec>string ( file-listing spec -- string )
+    {
+        { file-name [ directory-entry>> name>> ] }
+        { directory-or-size [ file-info>> dir-or-size ] }
+        [ unknown-file-spec ]
+    } case ;
+
+: list-files-fast ( listing-tool -- array )
+    path>> [ [ name>> 1array ] map ] with-directory-entries ; inline
+
+: list-files-slow ( listing-tool -- array )
+    [ path>> ] [ sort>> ] [ specs>> ] tri '[
+            [ dup name>> file-info file-listing boa ] map
+            _ [ sort-by-slots ] when*
+            [ _ [ file-spec>string ] with map ] map
+    ] with-directory-entries ; inline
+
+: list-files ( listing-tool -- array ) 
+    dup list-slow? [ list-files-slow ] [ list-files-fast ] if ; inline
+
+HOOK: (directory.) os ( path -- lines )
+
+: directory. ( path -- ) (directory.) simple-table. ;
 
 SYMBOLS: device-name mount-point type
 available-space free-space used-space total-space
@@ -43,16 +89,16 @@ percent-used percent-free ;
 
 : file-system-spec ( file-system-info obj -- str )
     {
-        { device-name [ device-name>> [ "" ] unless* ] }
+        { device-name [ device-name>> "" or ] }
-        { mount-point [ mount-point>> [ "" ] unless* ] }
+        { mount-point [ mount-point>> "" or ] }
-        { type [ type>> [ "" ] unless* ] }
+        { type [ type>> "" or ] }
-        { available-space [ available-space>> [ 0 ] unless* ] }
+        { available-space [ available-space>> 0 or ] }
-        { free-space [ free-space>> [ 0 ] unless* ] }
+        { free-space [ free-space>> 0 or ] }
-        { used-space [ used-space>> [ 0 ] unless* ] }
+        { used-space [ used-space>> 0 or ] }
-        { total-space [ total-space>> [ 0 ] unless* ] }
+        { total-space [ total-space>> 0 or ] }
         { percent-used [
             [ used-space>> ] [ total-space>> ] bi
-            [ [ 0 ] unless* ] bi@ dup 0 =
+            [ 0 or ] bi@ dup 0 =
             [ 2drop 0 ] [ / percent ] if
         ] }
     } case ;
@@ -65,8 +111,10 @@ percent-used percent-free ;
     [ [ unparse ] map ] bi prefix simple-table. ;
 
 : file-systems. ( -- )
-    { device-name available-space free-space used-space total-space percent-used mount-point }
+    {
-    print-file-systems ;
+        device-name available-space free-space used-space
+        total-space percent-used mount-point
+    } print-file-systems ;
 
 {
     { [ os unix? ] [ "tools.files.unix" ] }

basis/tools/files/unix/unix.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators kernel system unicode.case io.files
-io.files.info io.files.info.unix tools.files generalizations
+io.files.info io.files.info.unix generalizations
 strings arrays sequences math.parser unix.groups unix.users
-tools.files.private unix.stat math fry macros combinators.smart ;
+tools.files.private unix.stat math fry macros combinators.smart
+io.files.info.unix io tools.files math.order prettyprint ;
 IN: tools.files.unix
 
 <PRIVATE
@@ -45,19 +46,26 @@ IN: tools.files.unix
     } cond ;
 
 M: unix (directory.) ( path -- lines )
-    [ [
+    <listing-tool>
-        [
+        { permissions nlinks user group file-size file-datetime file-name } >>specs
-            dup file-info [
+        { { directory-entry>> name>> <=> } } >>sort
+    [ [ list-files ] with-group-cache ] with-user-cache ;
+
+M: unix file-spec>string ( file-listing spec -- string )
     {
-                    [ permissions-string ]
+        { file-name/type [
-                    [ nlink>> number>string 3 CHAR: \s pad-left ]
+            directory-entry>> [ name>> ] [ file-type>trailing ] bi append
-                    [ uid>> user-name ]
+        ] }
-                    [ gid>> group-name ]
+        { permissions [ file-info>> permissions-string ] }
-                    [ size>> number>string 15 CHAR: \s pad-left ]
+        { nlinks [ file-info>> nlink>> number>string ] }
-                    [ modified>> ls-timestamp ]
+        { file-size [ file-info>> size>> number>string ] }
-                } cleave
+        { user [ file-info>> uid>> user-name ] }
-            ] output>array swap suffix " " join
+        { group [ file-info>> gid>> group-name ] }
-        ] map
+        { uid [ file-info>> uid>> number>string ] }
-    ] with-group-cache ] with-user-cache ;
+        { gid [ file-info>> gid>> number>string ] }
+        { file-datetime [ file-info>> modified>> listing-timestamp ] }
+        { file-time [ file-info>> modified>> listing-time ] }
+        [ call-next-method ]
+    } case ;
 
 PRIVATE>

basis/tools/files/windows/windows.factor

@@ -7,19 +7,16 @@ IN: tools.files.windows
 
 <PRIVATE
 
-: directory-or-size ( file-info -- str )
+M: windows file-spec>string ( file-listing spec -- string )
-    dup directory? [
+    {
-        drop "<DIR>" 20 CHAR: \s pad-right
+        { listing-datetime [ modified>> timestamp>ymdhms ] }
-    ] [
+        [ call-next-method ]
-        size>> number>string 20 CHAR: \s pad-left
+    } case ;
-    ] if ;
 
 M: windows (directory.) ( entries -- lines )
-    [
+    <listing-tool>
-        dup file-info {
+        { file-size file-datetime file-name } >>specs
-            [ modified>> timestamp>ymdhms ]
+        { { directory-entry>> name>> <=> } } >>sort
-            [ directory-or-size ]
+    list-files ;
-        } cleave 2 narray swap suffix " " join
-    ] map ;
 
 PRIVATE>