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
Doug Coleman 2020-01-03 16:30:00 -06:00 committed by Steve Ayerhart
parent f4a1d2869b
commit 5e9016cde9
No known key found for this signature in database
GPG Key ID: 5BFD39C5359E967D
3 changed files with 32 additions and 16 deletions

View File

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

View File

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

View File

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