]> gitweb.factorcode.org Git - factor.git/commitdiff
io: Fix word to find disk space if a file is missing.
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 3 Jan 2020 22:30:00 +0000 (16:30 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Fri, 3 Jan 2020 22:30:00 +0000 (16:30 -0600)
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.

basis/io/files/info/info.factor
basis/io/files/windows/windows.factor
core/io/pathnames/pathnames.factor

index 917327fa4343feb756b6747f3169ef7cff911898..baf41ab88c3d1af9836dc169abf02b53699e7b14 100644 (file)
@@ -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 )
index 684d8f13d7613d27cec83b39fa773b83c72ccd91..0045e984297c795357bf4324ef64ea499cbfa699 100644 (file)
@@ -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* ;
index d1aed3ad82f6992d5093af669c87511280739020..bbd9298dcd09e51be415103ff1f664f35ae1b503 100644 (file)
@@ -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> pathname