steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Doug Coleman 2009-01-13 15:48:59 -06:00
parent 5a43dda03c
commit 3db9705a99
5 changed files with 108 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/io/directories/search/search.factor
View File

@ -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 ;

4
basis/tools/files/files-tests.factor
View File

@ -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

94
basis/tools/files/files.factor
View File

@ -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 ;
<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 -- )
[ (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> 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* ] }
{ 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,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" ] }

38
basis/tools/files/unix/unix.factor
View File

@ -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 )
[ [
[
dup file-info [
<listing-tool>
{ permissions nlinks user group file-size file-datetime file-name } >>specs
{ { directory-entry>> name>> <=> } } >>sort
[ [ list-files ] with-group-cache ] with-user-cache ;
M: unix file-spec>string ( file-listing spec -- string )
{
[ permissions-string ]
[ nlink>> 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 ;
{ 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>

21
basis/tools/files/windows/windows.factor
View File

@ -7,19 +7,16 @@ IN: tools.files.windows
<PRIVATE
: directory-or-size ( file-info -- str )
dup directory? [
drop "<DIR>" 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 ;
<listing-tool>
{ file-size file-datetime file-name } >>specs
{ { directory-entry>> name>> <=> } } >>sort
list-files ;
PRIVATE>