1 ! Copyright (C) 2008, 2009 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays calendar combinators fry io io.directories
4 io.files.info kernel math math.parser prettyprint sequences system
5 vocabs sorting.slots calendar.format ;
10 : dir-or-size ( file-info -- str )
12 drop "<DIR>" 20 CHAR: \s pad-tail
14 size>> number>string 20 CHAR: \s pad-head
17 : listing-time ( timestamp -- string )
18 [ hour>> ] [ minute>> ] bi
19 [ number>string 2 CHAR: 0 pad-head ] bi@ ":" glue ;
21 : listing-date ( timestamp -- string )
22 [ month>> month-abbreviation ]
23 [ day>> number>string 2 CHAR: \s pad-head ]
25 dup year>> dup now year>> =
26 [ drop listing-time ] [ nip number>string ] if
28 ] tri 3array " " join ;
30 : read>string ( ? -- string ) "r" "-" ? ; inline
32 : write>string ( ? -- string ) "w" "-" ? ; inline
34 : execute>string ( ? -- string ) "x" "-" ? ; inline
38 SYMBOLS: +file-name+ +file-name/type+ +permissions+ +file-type+
39 +nlinks+ +file-size+ +file-date+ +file-time+ +file-datetime+
40 +uid+ +gid+ +user+ +group+ +link-target+ +unix-datetime+
43 TUPLE: listing-tool path specs sort ;
45 TUPLE: file-listing directory-entry file-info ;
47 C: <file-listing> file-listing
49 : <listing-tool> ( path -- listing-tool )
52 { +file-name+ } >>specs ;
54 : list-slow? ( listing-tool -- ? )
55 specs>> { +file-name+ } sequence= not ;
57 ERROR: unknown-file-spec symbol ;
59 HOOK: file-spec>string os ( file-listing spec -- string )
61 M: object file-spec>string ( file-listing spec -- string )
63 { +file-name+ [ directory-entry>> name>> ] }
64 { +directory-or-size+ [ file-info>> dir-or-size ] }
65 { +file-size+ [ file-info>> size>> number>string ] }
66 { +file-date+ [ file-info>> modified>> listing-date ] }
67 { +file-time+ [ file-info>> modified>> listing-time ] }
68 { +file-datetime+ [ file-info>> modified>> timestamp>ymdhms ] }
72 : list-files-fast ( listing-tool -- array )
73 path>> [ [ name>> 1array ] map ] with-directory-entries ; inline
75 : list-files-slow ( listing-tool -- array )
76 [ path>> ] [ sort>> ] [ specs>> ] tri '[
77 [ dup name>> link-info file-listing boa ] map
79 [ _ [ file-spec>string ] with map ] map
80 ] with-directory-entries ; inline
82 : list-files ( listing-tool -- array )
83 dup list-slow? [ list-files-slow ] [ list-files-fast ] if ; inline
85 HOOK: (directory.) os ( path -- lines )
87 : directory. ( path -- ) (directory.) simple-table. ;
89 SYMBOLS: +device-name+ +mount-point+ +type+
90 +available-space+ +free-space+ +used-space+ +total-space+
91 +percent-used+ +percent-free+ ;
93 : percent ( real -- integer ) 100 * >integer ; inline
95 : file-system-spec ( file-system-info obj -- str )
97 { +device-name+ [ device-name>> "" or ] }
98 { +mount-point+ [ mount-point>> "" or ] }
99 { +type+ [ type>> "" or ] }
100 { +available-space+ [ available-space>> 0 or ] }
101 { +free-space+ [ free-space>> 0 or ] }
102 { +used-space+ [ used-space>> 0 or ] }
103 { +total-space+ [ total-space>> 0 or ] }
105 [ used-space>> ] [ total-space>> ] bi
107 [ 2drop 0 ] [ / percent ] if
111 : file-systems-info ( spec -- seq )
112 file-systems swap '[ _ [ file-system-spec ] with map ] map ;
114 : print-file-systems ( spec -- )
115 [ file-systems-info ]
116 [ [ unparse ] map ] bi prefix simple-table. ;
118 CONSTANT: default-file-systems-spec
120 +device-name+ +available-space+ +free-space+ +used-space+
121 +total-space+ +percent-used+ +mount-point+
124 : file-systems. ( -- )
125 default-file-systems-spec print-file-systems ;
128 { [ os unix? ] [ "tools.files.unix" ] }
129 { [ os windows? ] [ "tools.files.windows" ] }