io: Fix word to find disk space if a file is missing.
Add canonicalize-drive because Windows likes C: instead of c:. Add >windows-path for path string comparison. Add canonicalize-path-full for fixing the path, drive, and / to \\ on Windows.flac
parent
f4a1d2869b
commit
5e9016cde9
|
@ -35,14 +35,15 @@ HOOK: file-writable? os ( path -- ? )
|
||||||
HOOK: file-executable? os ( path -- ? )
|
HOOK: file-executable? os ( path -- ? )
|
||||||
|
|
||||||
: mount-points ( -- assoc )
|
: mount-points ( -- assoc )
|
||||||
file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ;
|
file-systems [ [ mount-point>> canonicalize-path-full ] keep ] H{ } map>assoc ;
|
||||||
|
|
||||||
: (find-mount-point-info) ( path assoc -- mtab-entry )
|
: (find-mount-point-info) ( path assoc -- mtab-entry )
|
||||||
[ resolve-symlinks ] dip
|
[ resolve-symlinks canonicalize-path-full ] dip
|
||||||
2dup at* [
|
2dup at* [
|
||||||
2nip
|
2nip
|
||||||
] [
|
] [
|
||||||
drop [ parent-directory ] dip (find-mount-point-info)
|
drop [ parent-directory ] dip
|
||||||
|
(find-mount-point-info)
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: find-mount-point-info ( path -- file-system-info )
|
: find-mount-point-info ( path -- file-system-info )
|
||||||
|
|
|
@ -1,12 +1,12 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien alien.c-types alien.data alien.strings
|
USING: accessors alien alien.c-types alien.data alien.strings
|
||||||
alien.syntax arrays assocs classes.struct combinators
|
alien.syntax arrays ascii assocs classes.struct combinators
|
||||||
combinators.short-circuit continuations destructors environment io
|
combinators.short-circuit continuations destructors environment io
|
||||||
io.backend io.binary io.buffers io.files io.files.private
|
io.backend io.binary io.buffers io.files io.files.private
|
||||||
io.files.types io.pathnames io.ports io.streams.c io.streams.null
|
io.files.types io.pathnames io.pathnames.private io.ports io.streams.c
|
||||||
io.timeouts kernel libc literals locals math math.bitwise namespaces
|
io.streams.null io.timeouts kernel libc literals locals math math.bitwise
|
||||||
sequences specialized-arrays system threads tr vectors windows
|
namespaces sequences specialized-arrays system threads tr vectors windows
|
||||||
windows.errors windows.handles windows.kernel32 windows.shell32
|
windows.errors windows.handles windows.kernel32 windows.shell32
|
||||||
windows.time windows.types windows.winsock splitting ;
|
windows.time windows.types windows.winsock splitting ;
|
||||||
SPECIALIZED-ARRAY: ushort
|
SPECIALIZED-ARRAY: ushort
|
||||||
|
@ -346,6 +346,11 @@ PRIVATE>
|
||||||
M: windows canonicalize-path
|
M: windows canonicalize-path
|
||||||
remove-unicode-prefix canonicalize-path* ;
|
remove-unicode-prefix canonicalize-path* ;
|
||||||
|
|
||||||
|
M: windows canonicalize-drive
|
||||||
|
dup windows-absolute-path? [ ":" split1 [ >upper ] dip ":" glue ] when ;
|
||||||
|
|
||||||
|
M: windows canonicalize-path-full canonicalize-path canonicalize-drive >windows-path ;
|
||||||
|
|
||||||
M: windows root-path remove-unicode-prefix root-path* ;
|
M: windows root-path remove-unicode-prefix root-path* ;
|
||||||
|
|
||||||
M: windows relative-path remove-unicode-prefix relative-path* ;
|
M: windows relative-path remove-unicode-prefix relative-path* ;
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman.
|
! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors combinators io.backend kernel math math.order
|
USING: accessors assocs combinators io.backend kernel math
|
||||||
namespaces sequences splitting strings system ;
|
math.order namespaces sequences splitting strings system ;
|
||||||
IN: io.pathnames
|
IN: io.pathnames
|
||||||
|
|
||||||
SYMBOL: current-directory
|
SYMBOL: current-directory
|
||||||
|
@ -61,13 +61,13 @@ ERROR: no-parent-directory path ;
|
||||||
[ nip ]
|
[ nip ]
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
: windows-absolute-path? ( path -- path ? )
|
: windows-absolute-path? ( path -- ? )
|
||||||
{
|
{
|
||||||
{ [ dup "\\\\?\\" head? ] [ t ] }
|
{ [ dup "\\\\?\\" head? ] [ t ] }
|
||||||
{ [ dup length 2 < ] [ f ] }
|
{ [ dup length 2 < ] [ f ] }
|
||||||
{ [ dup second CHAR: : = ] [ t ] }
|
{ [ dup second CHAR: : = ] [ t ] }
|
||||||
[ f ]
|
[ f ]
|
||||||
} cond ;
|
} cond nip ;
|
||||||
|
|
||||||
: special-path? ( path -- rest ? )
|
: special-path? ( path -- rest ? )
|
||||||
{
|
{
|
||||||
|
@ -80,12 +80,12 @@ PRIVATE>
|
||||||
|
|
||||||
: absolute-path? ( path -- ? )
|
: absolute-path? ( path -- ? )
|
||||||
{
|
{
|
||||||
{ [ dup empty? ] [ f ] }
|
{ [ dup empty? ] [ drop f ] }
|
||||||
{ [ dup special-path? nip ] [ t ] }
|
{ [ dup special-path? nip ] [ drop t ] }
|
||||||
{ [ os windows? ] [ windows-absolute-path? ] }
|
{ [ os windows? ] [ windows-absolute-path? ] }
|
||||||
{ [ dup first path-separator? ] [ t ] }
|
{ [ dup first path-separator? ] [ drop t ] }
|
||||||
[ f ]
|
[ drop f ]
|
||||||
} cond nip ;
|
} cond ;
|
||||||
|
|
||||||
: append-relative-path ( path1 path2 -- path )
|
: append-relative-path ( path1 path2 -- path )
|
||||||
[ trim-tail-separators ]
|
[ trim-tail-separators ]
|
||||||
|
@ -213,6 +213,16 @@ HOOK: canonicalize-path io-backend ( path -- path' )
|
||||||
|
|
||||||
M: object canonicalize-path canonicalize-path* ;
|
M: object canonicalize-path canonicalize-path* ;
|
||||||
|
|
||||||
|
HOOK: canonicalize-drive io-backend ( path -- path' )
|
||||||
|
|
||||||
|
M: object canonicalize-drive ;
|
||||||
|
|
||||||
|
HOOK: canonicalize-path-full io-backend ( path -- path' )
|
||||||
|
|
||||||
|
M: object canonicalize-path-full canonicalize-path canonicalize-drive ;
|
||||||
|
|
||||||
|
: >windows-path ( path -- path' ) H{ { CHAR: / CHAR: \\ } } substitute ;
|
||||||
|
|
||||||
TUPLE: pathname string ;
|
TUPLE: pathname string ;
|
||||||
|
|
||||||
C: <pathname> pathname
|
C: <pathname> pathname
|
||||||
|
|
Loading…
Reference in New Issue