Compare commits
1 Commits
Author | SHA1 | Date |
---|---|---|
|
c318ac10d0 |
|
@ -39,17 +39,16 @@ HOOK: mount-points os ( -- assoc )
|
||||||
M: object mount-points
|
M: object mount-points
|
||||||
file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ;
|
file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ;
|
||||||
|
|
||||||
: (find-mount-point) ( path assoc -- path )
|
: (find-mount-point) ( path assoc -- object )
|
||||||
[ resolve-symlinks canonicalize-path-full ] dip
|
[ resolve-symlinks canonicalize-path-full ] dip
|
||||||
2dup at* [
|
2dup at* [
|
||||||
2nip
|
2nip
|
||||||
] [
|
] [
|
||||||
drop [ parent-directory ] dip
|
drop [ parent-directory ] dip (find-mount-point)
|
||||||
(find-mount-point)
|
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: find-mount-point ( path -- path' )
|
: find-mount-point ( path -- object )
|
||||||
mount-points (find-mount-point) mount-point>> ;
|
mount-points (find-mount-point) ;
|
||||||
|
|
||||||
{
|
{
|
||||||
{ [ os unix? ] [ "io.files.info.unix" ] }
|
{ [ os unix? ] [ "io.files.info.unix" ] }
|
||||||
|
|
|
@ -68,9 +68,15 @@ frequency pass-number ;
|
||||||
CHAR: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter
|
CHAR: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter
|
||||||
[ mtab-csv>mtab-entry ] map ;
|
[ mtab-csv>mtab-entry ] map ;
|
||||||
|
|
||||||
|
: (file-system-info) ( path -- file-system-info )
|
||||||
|
[ new-file-system-info ] dip
|
||||||
|
[ file-system-statfs statfs>file-system-info ]
|
||||||
|
[ file-system-statvfs statvfs>file-system-info ] bi
|
||||||
|
file-system-calculations ; inline
|
||||||
|
|
||||||
: mtab-entry>file-system-info ( mtab-entry -- file-system-info/f )
|
: mtab-entry>file-system-info ( mtab-entry -- file-system-info/f )
|
||||||
'[
|
'[
|
||||||
_ [ mount-point>> file-system-info ] keep
|
_ [ mount-point>> (file-system-info) ] [ ] bi
|
||||||
{
|
{
|
||||||
[ file-system-name>> >>device-name ]
|
[ file-system-name>> >>device-name ]
|
||||||
[ mount-point>> >>mount-point ]
|
[ mount-point>> >>mount-point ]
|
||||||
|
@ -85,14 +91,8 @@ M: linux file-systems
|
||||||
parse-mtab [ mtab-entry>file-system-info ] map sift ;
|
parse-mtab [ mtab-entry>file-system-info ] map sift ;
|
||||||
|
|
||||||
M: linux file-system-info ( path -- file-system-info )
|
M: linux file-system-info ( path -- file-system-info )
|
||||||
normalize-path
|
normalize-path [ (file-system-info) ] [ ] bi
|
||||||
[
|
find-mount-point
|
||||||
[ new-file-system-info ] dip
|
|
||||||
[ file-system-statfs statfs>file-system-info ]
|
|
||||||
[ file-system-statvfs statvfs>file-system-info ] bi
|
|
||||||
file-system-calculations
|
|
||||||
] keep
|
|
||||||
find-mount-point-info
|
|
||||||
{
|
{
|
||||||
[ file-system-name>> >>device-name drop ]
|
[ file-system-name>> >>device-name drop ]
|
||||||
[ mount-point>> >>mount-point drop ]
|
[ mount-point>> >>mount-point drop ]
|
||||||
|
|
|
@ -7,7 +7,7 @@ IN: mason.disk
|
||||||
: Gi ( n -- gibibits ) 30 2^ * ; inline
|
: Gi ( n -- gibibits ) 30 2^ * ; inline
|
||||||
|
|
||||||
: sufficient-disk-space? ( -- ? )
|
: sufficient-disk-space? ( -- ? )
|
||||||
current-directory get find-mount-point
|
current-directory get find-mount-point mount-point>>
|
||||||
file-system-info available-space>> 1 Gi > ;
|
file-system-info available-space>> 1 Gi > ;
|
||||||
|
|
||||||
: check-disk-space ( -- )
|
: check-disk-space ( -- )
|
||||||
|
@ -18,7 +18,7 @@ IN: mason.disk
|
||||||
: Gi-str ( n -- string ) 1 Gi /f ;
|
: Gi-str ( n -- string ) 1 Gi /f ;
|
||||||
|
|
||||||
: path>disk-usage ( path -- string )
|
: path>disk-usage ( path -- string )
|
||||||
find-mount-point file-system-info
|
find-mount-point mount-point>> file-system-info
|
||||||
[ used-space>> ] [ available-space>> ] [ total-space>> ] tri
|
[ used-space>> ] [ available-space>> ] [ total-space>> ] tri
|
||||||
2dup /f 100 *
|
2dup /f 100 *
|
||||||
[ [ Gi-str ] tri@ ] dip
|
[ [ Gi-str ] tri@ ] dip
|
||||||
|
|
Loading…
Reference in New Issue