diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index d1fdff34f9..f9a0a14d0c 100755 --- a/basis/io/directories/search/search.factor +++ b/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 ; diff --git a/basis/tools/files/files-tests.factor b/basis/tools/files/files-tests.factor index 6cbc7d192c..aa4273f35f 100644 --- a/basis/tools/files/files-tests.factor +++ b/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 diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor index 9066f3a219..47c7d57c09 100755 --- a/basis/tools/files/files.factor +++ b/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 -io.directories kernel math.parser sequences system vocabs.loader -calendar math fry prettyprint ; +USING: accessors arrays calendar combinators fry io io.directories +io.files.info kernel math math.parser prettyprint sequences system +vocabs.loader sorting.slots ; IN: tools.files -SYMBOLS: permissions file-name nlinks file-size date ; - " 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 -- ) - [ (directory.) ] with-directory-files [ print ] each ; +SYMBOLS: file-name file-name/type permissions file-type nlinks file-size +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 + +: ( 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* ] } - { mount-point [ mount-point>> [ "" ] unless* ] } - { type [ type>> [ "" ] unless* ] } - { available-space [ available-space>> [ 0 ] unless* ] } - { free-space [ free-space>> [ 0 ] unless* ] } - { used-space [ used-space>> [ 0 ] unless* ] } - { total-space [ total-space>> [ 0 ] unless* ] } + { device-name [ device-name>> "" or ] } + { mount-point [ mount-point>> "" or ] } + { type [ type>> "" or ] } + { available-space [ available-space>> 0 or ] } + { free-space [ free-space>> 0 or ] } + { used-space [ used-space>> 0 or ] } + { 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,10 +111,12 @@ 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" ] } { [ os windows? ] [ "tools.files.windows" ] } -} cond require +} cond require \ No newline at end of file diff --git a/basis/tools/files/unix/unix.factor b/basis/tools/files/unix/unix.factor index 9757db171a..c6bc7fc2c1 100755 --- a/basis/tools/files/unix/unix.factor +++ b/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 > number>string 3 CHAR: \s pad-left ] - [ uid>> user-name ] - [ gid>> group-name ] - [ size>> number>string 15 CHAR: \s pad-left ] - [ modified>> ls-timestamp ] - } cleave - ] output>array swap suffix " " join - ] map - ] with-group-cache ] with-user-cache ; + + { permissions nlinks user group file-size file-datetime file-name } >>specs + { { directory-entry>> name>> <=> } } >>sort + [ [ list-files ] with-group-cache ] with-user-cache ; -PRIVATE> +M: unix file-spec>string ( file-listing spec -- string ) + { + { file-name/type [ + directory-entry>> [ name>> ] [ file-type>trailing ] bi append + ] } + { permissions [ file-info>> permissions-string ] } + { nlinks [ file-info>> nlink>> number>string ] } + { file-size [ file-info>> size>> number>string ] } + { user [ file-info>> uid>> user-name ] } + { group [ file-info>> gid>> group-name ] } + { uid [ file-info>> uid>> number>string ] } + { 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> \ No newline at end of file diff --git a/basis/tools/files/windows/windows.factor b/basis/tools/files/windows/windows.factor index 328bb8dc71..3284ec8d8b 100755 --- a/basis/tools/files/windows/windows.factor +++ b/basis/tools/files/windows/windows.factor @@ -7,19 +7,16 @@ IN: tools.files.windows " 20 CHAR: \s pad-right - ] [ - size>> number>string 20 CHAR: \s pad-left - ] if ; +M: windows file-spec>string ( file-listing spec -- string ) + { + { listing-datetime [ modified>> timestamp>ymdhms ] } + [ call-next-method ] + } case ; M: windows (directory.) ( entries -- lines ) - [ - dup file-info { - [ modified>> timestamp>ymdhms ] - [ directory-or-size ] - } cleave 2 narray swap suffix " " join - ] map ; + + { file-size file-datetime file-name } >>specs + { { directory-entry>> name>> <=> } } >>sort + list-files ; PRIVATE>