io.files.info.windows: Fix file-systems word in two ways. First, don't
allocate 32k on the local alloc stack (which causes a 'double fault.') Second, if the volume doesnt look up to a real path, don't make a dummy object for that. volume Use alien>native-string and native-string>alien wherever possible instead of utf16n for Windows.
parent
47a977277a
commit
bbf5cfbc4d
|
|
@ -12,7 +12,7 @@ M: windows os-env ( key -- value )
|
|||
[ dup length GetEnvironmentVariable ] keep over 0 = [
|
||||
2drop f
|
||||
] [
|
||||
nip utf16n alien>string
|
||||
nip alien>native-string
|
||||
] if ;
|
||||
|
||||
M: windows set-os-env ( value key -- )
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: accessors alien alien.c-types alien.data alien.strings
|
||||
arrays assocs byte-arrays combinators combinators.short-circuit
|
||||
continuations game.input game.input.dinput.keys-array
|
||||
io.encodings.utf16 io.encodings.utf16n kernel locals math
|
||||
io.encodings.utf16n kernel locals math
|
||||
math.bitwise math.rectangles namespaces parser sequences shuffle
|
||||
specialized-arrays ui.backend.windows vectors windows.com
|
||||
windows.directx.dinput windows.directx.dinput.constants
|
||||
|
|
@ -259,7 +259,7 @@ M: dinput-game-input-backend get-controllers
|
|||
|
||||
M: dinput-game-input-backend product-string
|
||||
handle>> device-info tszProductName>>
|
||||
utf16n alien>string ;
|
||||
alien>native-string ;
|
||||
|
||||
M: dinput-game-input-backend product-id
|
||||
handle>> device-info guidProduct>> ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: game.input math math.order kernel macros fry sequences quotations
|
||||
arrays windows.directx.xinput combinators accessors windows.types
|
||||
game.input.dinput sequences.private namespaces classes.struct
|
||||
windows.errors windows.com.syntax io.encodings.utf16n alien.strings ;
|
||||
windows.errors windows.com.syntax alien.strings ;
|
||||
IN: game.input.xinput
|
||||
|
||||
SINGLETON: xinput-game-input-backend
|
||||
|
|
@ -98,7 +98,7 @@ M: xinput-game-input-backend get-controllers
|
|||
M: xinput-game-input-backend product-string
|
||||
dup number?
|
||||
[ drop "Controller (Xbox 360 Wireless Receiver for Windows)" ]
|
||||
[ handle>> device-info tszProductName>> utf16n alien>string ]
|
||||
[ handle>> device-info tszProductName>> alien>native-string ]
|
||||
if ;
|
||||
|
||||
M: xinput-game-input-backend product-id
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: system io.directories io.encodings.utf16n alien.strings
|
||||
USING: system io.directories alien.strings
|
||||
io.pathnames io.backend io.files.windows destructors
|
||||
kernel accessors calendar windows windows.errors
|
||||
windows.kernel32 alien.c-types sequences splitting
|
||||
|
|
@ -64,7 +64,7 @@ M: windows delete-directory ( path -- )
|
|||
TUPLE: windows-directory-entry < directory-entry attributes ;
|
||||
|
||||
M: windows >directory-entry ( byte-array -- directory-entry )
|
||||
[ cFileName>> utf16n alien>string ]
|
||||
[ cFileName>> alien>native-string ]
|
||||
[
|
||||
dwFileAttributes>>
|
||||
[ win32-file-type ] [ win32-file-attributes ] bi
|
||||
|
|
|
|||
|
|
@ -4,11 +4,12 @@ USING: byte-arrays math io.backend io.files.info
|
|||
io.files.windows kernel windows.kernel32
|
||||
windows.time windows.types windows accessors alien.c-types
|
||||
combinators generalizations system alien.strings
|
||||
io.encodings.utf16n sequences splitting windows.errors fry
|
||||
sequences splitting windows.errors fry
|
||||
continuations destructors calendar ascii
|
||||
combinators.short-circuit literals locals classes.struct
|
||||
specialized-arrays alien.data ;
|
||||
specialized-arrays alien.data libc ;
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
QUALIFIED: sequences
|
||||
IN: io.files.info.windows
|
||||
|
||||
:: round-up-to ( n multiple -- n' )
|
||||
|
|
@ -101,7 +102,7 @@ CONSTANT: path-length $[ MAX_PATH 1 + ]
|
|||
{ { ushort path-length } DWORD DWORD DWORD { ushort path-length } }
|
||||
[ [ path-length ] 4dip path-length GetVolumeInformation win32-error=0/f ]
|
||||
with-out-parameters
|
||||
[ utf16n alien>string ] 4dip utf16n alien>string ;
|
||||
[ alien>native-string ] 4dip alien>native-string ;
|
||||
|
||||
: file-system-space ( normalized-path -- available-space total-space free-space )
|
||||
{ ULARGE_INTEGER ULARGE_INTEGER ULARGE_INTEGER }
|
||||
|
|
@ -146,16 +147,10 @@ M: windows file-system-info ( path -- file-system-info )
|
|||
|
||||
CONSTANT: names-buf-length 16384
|
||||
|
||||
: volume>paths ( string -- array )
|
||||
{ { ushort names-buf-length } uint }
|
||||
[ [ names-buf-length ] dip GetVolumePathNamesForVolumeName win32-error=0/f ]
|
||||
with-out-parameters
|
||||
head utf16n alien>string { CHAR: \0 } split ;
|
||||
|
||||
: find-first-volume ( -- string handle )
|
||||
{ { ushort path-length } }
|
||||
[ path-length FindFirstVolume dup win32-error=0/f ]
|
||||
with-out-parameters utf16n alien>string swap ;
|
||||
with-out-parameters alien>native-string swap ;
|
||||
|
||||
: find-next-volume ( handle -- string/f )
|
||||
{ { ushort path-length } }
|
||||
|
|
@ -163,7 +158,7 @@ CONSTANT: names-buf-length 16384
|
|||
swap 0 = [
|
||||
GetLastError ERROR_NO_MORE_FILES =
|
||||
[ drop f ] [ win32-error-string throw ] if
|
||||
] [ utf16n alien>string ] if ;
|
||||
] [ alien>native-string ] if ;
|
||||
|
||||
: find-volumes ( -- array )
|
||||
find-first-volume
|
||||
|
|
@ -174,11 +169,22 @@ CONSTANT: names-buf-length 16384
|
|||
]
|
||||
] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ;
|
||||
|
||||
! Windows may return a volume which looks up to path ""
|
||||
! For now, treat it like there is not a volume here
|
||||
: volume>paths ( string -- array )
|
||||
[
|
||||
names-buf-length
|
||||
[ ushort malloc-array &free ] keep
|
||||
0 uint <ref>
|
||||
[ GetVolumePathNamesForVolumeName win32-error=0/f ] 3keep nip
|
||||
uint deref head but-last-slice
|
||||
{ 0 } split*
|
||||
[ { } ] [ [ alien>native-string ] map ] if-empty
|
||||
] with-destructors ;
|
||||
|
||||
M: windows file-systems ( -- array )
|
||||
find-volumes [ volume>paths ] map
|
||||
concat [
|
||||
[ (file-system-info) ]
|
||||
[ drop \ file-system-info new swap >>mount-point ] recover
|
||||
find-volumes [ volume>paths ] map concat [
|
||||
(file-system-info)
|
||||
] map ;
|
||||
|
||||
: file-times ( path -- timestamp timestamp timestamp )
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! (c)2012 Joe Groff bsd license
|
||||
USING: alien.data alien.strings io.directories
|
||||
io.encodings.utf16n io.files.temp io.pathnames kernel math
|
||||
io.files.temp io.pathnames kernel math
|
||||
memoize specialized-arrays system windows.errors
|
||||
windows.kernel32 windows.ole32 windows.shell32
|
||||
windows.types ;
|
||||
|
|
@ -12,7 +12,7 @@ IN: io.files.temp.windows
|
|||
: (get-temp-directory) ( -- path )
|
||||
MAX_PATH 1 + dup WCHAR <c-array> [ GetTempPath ] keep
|
||||
swap win32-error=0/f
|
||||
utf16n alien>string ;
|
||||
alien>native-string ;
|
||||
|
||||
: (get-appdata-directory) ( -- path )
|
||||
f
|
||||
|
|
@ -22,7 +22,7 @@ IN: io.files.temp.windows
|
|||
MAX_PATH 1 + WCHAR <c-array>
|
||||
[ SHGetFolderPath ] keep
|
||||
swap ole32-error
|
||||
utf16n alien>string ;
|
||||
alien>native-string ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -327,8 +327,7 @@ SLOT: attributes
|
|||
|
||||
M: windows cwd
|
||||
MAX_UNICODE_PATH dup ushort <c-array>
|
||||
[ GetCurrentDirectory win32-error=0/f ] keep
|
||||
utf16n alien>string ;
|
||||
[ GetCurrentDirectory win32-error=0/f ] keep alien>native-string ;
|
||||
|
||||
M: windows cd
|
||||
SetCurrentDirectory win32-error=0/f ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
! (c)2010 Joe Groff bsd license
|
||||
USING: alien.data alien.strings byte-arrays io.encodings.utf16n
|
||||
USING: alien.data alien.strings byte-arrays
|
||||
kernel specialized-arrays system tools.deploy.libraries
|
||||
windows.kernel32 windows.types ;
|
||||
FROM: alien.c-types => ushort ;
|
||||
|
|
@ -10,7 +10,7 @@ M: windows find-library-file
|
|||
f DONT_RESOLVE_DLL_REFERENCES LoadLibraryEx [
|
||||
[
|
||||
32768 ushort (c-array) [ 32768 GetModuleFileName drop ] keep
|
||||
utf16n alien>string
|
||||
alien>native-string
|
||||
] [ FreeLibrary drop ] bi
|
||||
] [ f ] if* ;
|
||||
|
||||
|
|
|
|||
|
|
@ -201,14 +201,14 @@ PRIVATE>
|
|||
CF_UNICODETEXT GetClipboardData dup win32-error=0/f
|
||||
dup GlobalLock dup win32-error=0/f
|
||||
GlobalUnlock win32-error=0/f
|
||||
utf16n alien>string
|
||||
alien>native-string
|
||||
] if
|
||||
] with-clipboard
|
||||
crlf>lf ;
|
||||
|
||||
: copy ( str -- )
|
||||
lf>crlf [
|
||||
utf16n string>alien
|
||||
native-string>alien
|
||||
EmptyClipboard win32-error=0/f
|
||||
GMEM_MOVEABLE over length 1 + GlobalAlloc
|
||||
dup win32-error=0/f
|
||||
|
|
@ -642,7 +642,7 @@ M: windows-ui-backend do-events
|
|||
0 >>cbClsExtra
|
||||
0 >>cbWndExtra
|
||||
f GetModuleHandle >>hInstance
|
||||
f GetModuleHandle "APPICON" utf16n string>alien LoadIcon >>hIcon
|
||||
f GetModuleHandle "APPICON" native-string>alien LoadIcon >>hIcon
|
||||
f IDC_ARROW LoadCursor >>hCursor
|
||||
|
||||
class-name-ptr >>lpszClassName
|
||||
|
|
|
|||
|
|
@ -1,8 +1,7 @@
|
|||
USING: alien.data kernel locals math math.bitwise
|
||||
windows.kernel32 sequences byte-arrays unicode.categories
|
||||
io.encodings.string io.encodings.utf16n alien.strings
|
||||
arrays literals windows.types specialized-arrays
|
||||
math.parser ;
|
||||
io.encodings.string alien.strings arrays literals
|
||||
windows.types specialized-arrays math.parser ;
|
||||
SPECIALIZED-ARRAY: TCHAR
|
||||
IN: windows.errors
|
||||
|
||||
|
|
@ -716,7 +715,7 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK 0x000000FF
|
|||
f pick [ FormatMessage ] dip
|
||||
swap zero?
|
||||
[ drop "Unknown error 0x" id 0xffff,ffff bitand >hex append ]
|
||||
[ utf16n alien>string [ blank? ] trim ] if ;
|
||||
[ alien>native-string [ blank? ] trim ] if ;
|
||||
|
||||
: win32-error-string ( -- str )
|
||||
GetLastError n>win32-error-string ;
|
||||
|
|
|
|||
|
|
@ -1,10 +1,9 @@
|
|||
! Copyright (C) 2006, 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.data alien.strings alien.syntax
|
||||
classes.struct combinators io.encodings.utf16n io.files
|
||||
io.pathnames kernel windows.errors windows.com
|
||||
windows.com.syntax windows.types windows.user32
|
||||
windows.ole32 windows specialized-arrays ;
|
||||
classes.struct combinators io.files io.pathnames kernel
|
||||
windows.errors windows.com windows.com.syntax windows.types
|
||||
windows.user32 windows.ole32 windows specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
IN: windows.shell32
|
||||
|
||||
|
|
@ -90,7 +89,7 @@ ALIAS: ShellExecute ShellExecuteW
|
|||
: shell32-directory ( n -- str )
|
||||
f swap f SHGFP_TYPE_DEFAULT
|
||||
MAX_UNICODE_PATH ushort <c-array>
|
||||
[ SHGetFolderPath drop ] keep utf16n alien>string ;
|
||||
[ SHGetFolderPath drop ] keep alien>native-string ;
|
||||
|
||||
: desktop ( -- str )
|
||||
CSIDL_DESKTOPDIRECTORY shell32-directory ;
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@ PRIVATE>
|
|||
|
||||
M: windows send-to-trash ( path -- )
|
||||
[
|
||||
utf16n string>alien B{ 0 0 } append
|
||||
native-string>alien B{ 0 0 } append
|
||||
malloc-byte-array &free
|
||||
|
||||
SHFILEOPSTRUCTW <struct>
|
||||
|
|
|
|||
Loading…
Reference in New Issue