diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index 917327fa43..baf41ab88c 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -35,14 +35,15 @@ HOOK: file-writable? os ( path -- ? ) HOOK: file-executable? os ( path -- ? ) : 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 ) - [ resolve-symlinks ] dip + [ resolve-symlinks canonicalize-path-full ] dip 2dup at* [ 2nip ] [ - drop [ parent-directory ] dip (find-mount-point-info) + drop [ parent-directory ] dip + (find-mount-point-info) ] if ; : find-mount-point-info ( path -- file-system-info ) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 684d8f13d7..0045e98429 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. 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 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.timeouts kernel libc literals locals math math.bitwise namespaces -sequences specialized-arrays system threads tr vectors windows +io.files.types io.pathnames io.pathnames.private io.ports io.streams.c +io.streams.null io.timeouts kernel libc literals locals math math.bitwise +namespaces sequences specialized-arrays system threads tr vectors windows windows.errors windows.handles windows.kernel32 windows.shell32 windows.time windows.types windows.winsock splitting ; SPECIALIZED-ARRAY: ushort @@ -346,6 +346,11 @@ PRIVATE> M: windows 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 relative-path remove-unicode-prefix relative-path* ; diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index d1aed3ad82..bbd9298dcd 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators io.backend kernel math math.order -namespaces sequences splitting strings system ; +USING: accessors assocs combinators io.backend kernel math +math.order namespaces sequences splitting strings system ; IN: io.pathnames SYMBOL: current-directory @@ -61,13 +61,13 @@ ERROR: no-parent-directory path ; [ nip ] } cond ; -: windows-absolute-path? ( path -- path ? ) +: windows-absolute-path? ( path -- ? ) { { [ dup "\\\\?\\" head? ] [ t ] } { [ dup length 2 < ] [ f ] } { [ dup second CHAR: : = ] [ t ] } [ f ] - } cond ; + } cond nip ; : special-path? ( path -- rest ? ) { @@ -80,12 +80,12 @@ PRIVATE> : absolute-path? ( path -- ? ) { - { [ dup empty? ] [ f ] } - { [ dup special-path? nip ] [ t ] } + { [ dup empty? ] [ drop f ] } + { [ dup special-path? nip ] [ drop t ] } { [ os windows? ] [ windows-absolute-path? ] } - { [ dup first path-separator? ] [ t ] } - [ f ] - } cond nip ; + { [ dup first path-separator? ] [ drop t ] } + [ drop f ] + } cond ; : append-relative-path ( path1 path2 -- path ) [ trim-tail-separators ] @@ -213,6 +213,16 @@ HOOK: canonicalize-path io-backend ( path -- 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 ; C: pathname