diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index e4fe0fbc63..80caf5222f 100644 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -246,12 +246,14 @@ M: winnt file-info ( path -- info ) M: winnt link-info ( path -- info ) file-info ; +HOOK: root-directory os ( string -- string' ) + TUPLE: winnt-file-system-info < file-system-info total-bytes total-free-bytes ; M: winnt file-system-info ( path -- file-system-info ) - normalize-path - dup file-info directory? [ parent-directory ] unless + normalize-path root-directory + dup "ULARGE_INTEGER" "ULARGE_INTEGER" "ULARGE_INTEGER" @@ -259,7 +261,8 @@ M: winnt file-system-info ( path -- file-system-info ) \ winnt-file-system-info new swap *ulonglong >>total-free-bytes swap *ulonglong >>total-bytes - swap *ulonglong >>free-space ; + swap *ulonglong >>free-space + swap "\\\\?\\" ?head drop root-directory >>name ; : file-times ( path -- timestamp timestamp timestamp ) [ diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor index 9b77a9f128..2fbc809263 100644 --- a/basis/io/windows/nt/files/files.factor +++ b/basis/io/windows/nt/files/files.factor @@ -31,12 +31,13 @@ M: winnt root-directory? ( path -- ? ) ERROR: not-absolute-path ; -: root-directory ( string -- string' ) +M: winnt root-directory ( string -- string' ) + unicode-prefix ?head drop dup { [ length 2 >= ] [ second CHAR: : = ] [ first Letter? ] - } 1&& [ 2 head ] [ not-absolute-path ] if ; + } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ; : prepend-prefix ( string -- string' ) dup unicode-prefix head? [