change windows file-system-info implementation
							parent
							
								
									c9167e2ab2
								
							
						
					
					
						commit
						f5f6c400db
					
				| 
						 | 
				
			
			@ -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" <c-object>
 | 
			
		||||
    "ULARGE_INTEGER" <c-object>
 | 
			
		||||
    "ULARGE_INTEGER" <c-object>
 | 
			
		||||
| 
						 | 
				
			
			@ -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 )
 | 
			
		||||
    [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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? [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue