M: netbsd file-systems ( -- array )
f 0 0 getvfsstat dup io-error
-- \ statvfs <c-type-array> dup dup length 0 getvfsstat io-error
++ \ statvfs <c-array> dup dup length 0 getvfsstat io-error
\ statvfs heap-size group
[ f_mntonname>> utf8 alien>string file-system-info ] map ;
M: openbsd file-systems ( -- seq )
f 0 0 getfsstat dup io-error
-- \ statfs <c-type-array> dup dup length 0 getfsstat io-error
++ \ statfs <c-array> dup dup length 0 getfsstat io-error
\ statfs heap-size group
[ f_mntonname>> alien>native-string file-system-info ] map ;
: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
[ \ windows-file-info new ] dip
{
- [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ]
- [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes >>attributes ]
- [
- [ WIN32_FIND_DATA-nFileSizeLow ]
- [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size
- ]
- [ WIN32_FIND_DATA-dwFileAttributes >>permissions ]
- [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ]
- [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ]
- [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ]
+ [ dwFileAttributes>> win32-file-type >>type ]
+ [ dwFileAttributes>> win32-file-attributes >>attributes ]
+ [ [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit >>size ]
+ [ dwFileAttributes>> >>permissions ]
+ [ ftCreationTime>> FILETIME>timestamp >>created ]
+ [ ftLastWriteTime>> FILETIME>timestamp >>modified ]
+ [ ftLastAccessTime>> FILETIME>timestamp >>accessed ]
} cleave ;
: find-first-file-stat ( path -- WIN32_FIND_DATA )
- "WIN32_FIND_DATA" <c-object> [
+ WIN32_FIND_DATA <struct> [
FindFirstFile
[ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
FindClose win32-error=0/f
file-info ;
: volume-information ( normalized-path -- volume-name volume-serial max-component flags type )
- MAX_PATH 1 + [ <byte-array> ] keep
+ MAX_PATH 1 + [ <ushort-array> ] keep
"DWORD" <c-object>
"DWORD" <c-object>
"DWORD" <c-object>
- MAX_PATH 1 + [ <byte-array> ] keep
+ MAX_PATH 1 + [ <ushort-array> ] keep
[ GetVolumeInformation win32-error=0/f ] 7 nkeep
drop 5 nrot drop
[ utf16n alien>string ] 4 ndip
] if ;
: find-first-volume ( -- string handle )
- MAX_PATH 1 + [ <byte-array> ] keep
+ MAX_PATH 1 + [ <ushort-array> ] keep
dupd
FindFirstVolume dup win32-error=0/f
[ utf16n alien>string ] dip ;
: find-next-volume ( handle -- string/f )
- MAX_PATH 1 + [ <byte-array> tuck ] keep
+ MAX_PATH 1 + [ <ushort-array> tuck ] keep
FindNextVolume 0 = [
GetLastError ERROR_NO_MORE_FILES =
[ drop f ] [ win32-error-string throw ] if
arrays literals ;
IN: windows.errors
+<< "TCHAR" require-c-arrays >>
+
CONSTANT: ERROR_SUCCESS 0
CONSTANT: ERROR_INVALID_FUNCTION 1
CONSTANT: ERROR_FILE_NOT_FOUND 2
: make-lang-id ( lang1 lang2 -- n )
10 shift bitor ; inline
-<< "TCHAR" require-c-type-arrays >>
++<< "TCHAR" require-c-arrays >>
+
ERROR: error-message-failed id ;
:: n>win32-error-string ( id -- string )
{
f
id
LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id
- 32768 [ "TCHAR" <c-array> ] keep
- 32768 [ "TCHAR" <c-type-array> ] [ ] bi
++ 32768 [ "TCHAR" <c-array> ] [ ] bi
f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip
utf16n alien>string [ blank? ] trim ;
! Copyright (C) 2006, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax
-combinators io.encodings.utf16n io.files io.pathnames kernel
-windows.errors windows.com windows.com.syntax windows.user32
-windows.ole32 windows specialized-arrays.ushort classes.struct ;
+classes.struct combinators io.encodings.utf16n io.files
+io.pathnames kernel windows.errors windows.com
+windows.com.syntax windows.user32 windows.ole32 windows
+specialized-arrays.ushort ;
IN: windows.shell32
CONSTANT: CSIDL_DESKTOP HEX: 00
TYPEDEF: ULONG SFGAOF
- C-STRUCT: DROPFILES
- { "DWORD" "pFiles" }
- { "POINT" "pt" }
- { "BOOL" "fNC" }
- { "BOOL" "fWide" } ;
+ STRUCT: DROPFILES
+ { pFiles DWORD }
+ { pt POINT }
+ { fNC BOOL }
+ { fWide BOOL } ;
TYPEDEF: DROPFILES* LPDROPFILES
TYPEDEF: DROPFILES* LPCDROPFILES
TYPEDEF: HANDLE HDROP
- C-STRUCT: SHITEMID
- { "USHORT" "cb" }
- { "BYTE[1]" "abID" } ;
+ STRUCT: SHITEMID
+ { cb USHORT }
+ { abID BYTE[1] } ;
TYPEDEF: SHITEMID* LPSHITEMID
TYPEDEF: SHITEMID* LPCSHITEMID
- C-STRUCT: ITEMIDLIST
- { "SHITEMID" "mkid" } ;
+ STRUCT: ITEMIDLIST
+ { mkid SHITEMID } ;
TYPEDEF: ITEMIDLIST* LPITEMIDLIST
TYPEDEF: ITEMIDLIST* LPCITEMIDLIST
TYPEDEF: ITEMIDLIST ITEMID_CHILD
CONSTANT: STRRET_OFFSET 1
CONSTANT: STRRET_CSTR 2
-C-UNION: STRRET-union "LPWSTR" "LPSTR" "UINT" "char[260]" ;
+UNION-STRUCT: STRRET-union
+ { pOleStr LPWSTR }
+ { uOffset UINT }
+ { cStr char[260] } ;
STRUCT: STRRET
{ uType int }
- { union STRRET-union } ;
+ { value STRRET-union } ;
COM-INTERFACE: IEnumIDList IUnknown {000214F2-0000-0000-C000-000000000046}
HRESULT Next ( ULONG celt, LPITEMIDLIST* rgelt, ULONG* pceltFetched )
USING: alien alien.c-types classes.struct accessors kernel
math namespaces windows windows.kernel32 windows.advapi32 words
combinators vocabs.loader system-info.backend system
-alien.strings windows.errors ;
+alien.strings windows.errors specialized-arrays.ushort ;
IN: system-info.windows
: system-info ( -- SYSTEM_INFO )
system-info dwOemId>> HEX: ffff0000 bitand ;
: os-version ( -- os-version )
- "OSVERSIONINFO" <c-object>
- "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
+ OSVERSIONINFO <struct>
+ OSVERSIONINFO heap-size >>dwOSVersionInfoSize
dup GetVersionEx win32-error=0/f ;
: windows-major ( -- n )
- os-version OSVERSIONINFO-dwMajorVersion ;
+ os-version dwMajorVersion>> ;
: windows-minor ( -- n )
- os-version OSVERSIONINFO-dwMinorVersion ;
+ os-version dwMinorVersion>> ;
: windows-build# ( -- n )
- os-version OSVERSIONINFO-dwBuildNumber ;
+ os-version dwBuildNumber>> ;
: windows-platform-id ( -- n )
- os-version OSVERSIONINFO-dwPlatformId ;
+ os-version dwPlatformId>> ;
: windows-service-pack ( -- string )
- os-version OSVERSIONINFO-szCSDVersion alien>native-string ;
+ os-version szCSDVersion>> alien>native-string ;
: feature-present? ( n -- ? )
IsProcessorFeaturePresent zero? not ;
: sse3? ( -- ? )
PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ;
-: <u16-string-object> ( n -- obj )
- "ushort" <c-array> ;
-
: get-directory ( word -- str )
- [ MAX_UNICODE_PATH [ <u16-string-object> ] keep dupd ] dip
+ [ MAX_UNICODE_PATH [ <ushort-array> ] keep dupd ] dip
execute win32-error=0/f alien>native-string ; inline
: windows-directory ( -- str )
projects / factor.git / commitdiff