57 lines
1.7 KiB
Factor
57 lines
1.7 KiB
Factor
|
! Copyright (C) 2008 Doug Coleman.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
IN: io.directories.windows
|
||
|
|
|
||
|
|
M: windows move-file ( from to -- )
|
||
|
|
[ normalize-path ] bi@ MoveFile win32-error=0/f ;
|
||
|
|
|
||
|
|
M: windows delete-file ( path -- )
|
||
|
|
normalize-path DeleteFile win32-error=0/f ;
|
||
|
|
|
||
|
|
M: windows copy-file ( from to -- )
|
||
|
|
dup parent-directory make-directories
|
||
|
|
[ normalize-path ] bi@ 0 CopyFile win32-error=0/f ;
|
||
|
|
|
||
|
|
M: windows make-directory ( path -- )
|
||
|
|
normalize-path
|
||
|
|
f CreateDirectory win32-error=0/f ;
|
||
|
|
|
||
|
|
M: windows delete-directory ( path -- )
|
||
|
|
normalize-path
|
||
|
|
RemoveDirectory win32-error=0/f ;
|
||
|
|
|
||
|
|
: find-first-file ( path -- WIN32_FIND_DATA handle )
|
||
|
|
"WIN32_FIND_DATA" <c-object> tuck
|
||
|
|
FindFirstFile
|
||
|
|
[ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ;
|
||
|
|
|
||
|
|
: find-next-file ( path -- WIN32_FIND_DATA/f )
|
||
|
|
"WIN32_FIND_DATA" <c-object> tuck
|
||
|
|
FindNextFile 0 = [
|
||
|
|
GetLastError ERROR_NO_MORE_FILES = [
|
||
|
|
win32-error
|
||
|
|
] unless drop f
|
||
|
|
] when ;
|
||
|
|
|
||
|
|
TUPLE: windows-directory-entry < directory-entry attributes ;
|
||
|
|
|
||
|
|
M: windows >directory-entry ( byte-array -- directory-entry )
|
||
|
|
[ WIN32_FIND_DATA-cFileName utf16n alien>string ]
|
||
|
|
[ WIN32_FIND_DATA-dwFileAttributes win32-file-type ]
|
||
|
|
[ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ]
|
||
|
|
tri
|
||
|
|
dupd remove windows-directory-entry boa ;
|
||
|
|
|
||
|
|
M: windows (directory-entries) ( path -- seq )
|
||
|
|
"\\" ?tail drop "\\*" append
|
||
|
|
find-first-file [ >directory-entry ] dip
|
||
|
|
[
|
||
|
|
'[
|
||
|
|
[ _ find-next-file dup ]
|
||
|
|
[ >directory-entry ]
|
||
|
|
[ drop ] produce
|
||
|
|
over name>> "." = [ nip ] [ swap prefix ] if
|
||
|
|
]
|
||
|
|
] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ;
|
||
|
|
|