56 lines
1.6 KiB
Factor
56 lines
1.6 KiB
Factor
|
USING: alien calendar io io-internals kernel libs-io math
|
||
|
|
namespaces prettyprint sequences windows-api ;
|
||
|
|
IN: shell
|
||
|
|
|
||
|
|
TUPLE: winnt-shell ;
|
||
|
|
|
||
|
|
T{ winnt-shell } \ shell set-global
|
||
|
|
|
||
|
|
TUPLE: file name size mtime attributes ;
|
||
|
|
|
||
|
|
: ((directory*)) ( handle -- )
|
||
|
|
"WIN32_FIND_DATA" <c-object> [ FindNextFile ] 2keep
|
||
|
|
rot zero? [ 2drop ] [ , ((directory*)) ] if ;
|
||
|
|
|
||
|
|
: (directory*) ( path -- )
|
||
|
|
"WIN32_FIND_DATA" <c-object> [
|
||
|
|
FindFirstFile dup INVALID_HANDLE_VALUE = [
|
||
|
|
win32-error
|
||
|
|
] when
|
||
|
|
] keep ,
|
||
|
|
[ ((directory*)) ] keep FindClose win32-error=0/f ;
|
||
|
|
|
||
|
|
: append-star ( path -- path )
|
||
|
|
dup peek CHAR: \\ = "*" "\\*" ? append ;
|
||
|
|
|
||
|
|
M: winnt-shell directory* ( path -- seq )
|
||
|
|
normalize-pathname append-star [ (directory*) ] { } make ;
|
||
|
|
|
||
|
|
: WIN32_FIND_DATA>file-size ( WIN32_FILE_ATTRIBUTE_DATA -- n )
|
||
|
|
[ WIN32_FIND_DATA-nFileSizeLow ] keep
|
||
|
|
WIN32_FIND_DATA-nFileSizeHigh 32 shift + ;
|
||
|
|
|
||
|
|
M: winnt-shell make-file ( WIN32_FIND_DATA -- file )
|
||
|
|
[ WIN32_FIND_DATA-cFileName alien>u16-string ] keep
|
||
|
|
[ WIN32_FIND_DATA>file-size ] keep
|
||
|
|
[
|
||
|
|
WIN32_FIND_DATA-ftCreationTime
|
||
|
|
FILETIME>timestamp >local-time
|
||
|
|
] keep
|
||
|
|
WIN32_FIND_DATA-dwFileAttributes <file> ;
|
||
|
|
|
||
|
|
M: winnt-shell file. ( file -- )
|
||
|
|
[ [ file-attributes >oct write ] keep ] with-cell
|
||
|
|
[ bl ] with-cell
|
||
|
|
[ [ file-size unparse write ] keep ] with-cell
|
||
|
|
[ bl ] with-cell
|
||
|
|
[ [ file-mtime file-time-string write ] keep ] with-cell
|
||
|
|
[ bl ] with-cell
|
||
|
|
[ file-name write ] with-cell ;
|
||
|
|
|
||
|
|
M: winnt-shell touch-file ( path -- )
|
||
|
|
#! Set the file write time to 'now'
|
||
|
|
normalize-pathname
|
||
|
|
dup maybe-create-file [ drop ] [ now set-file-write-time ] if ;
|
||
|
|
|