Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-08-27 20:30:15 -05:00
commit f1c971e3df
12 changed files with 167 additions and 158 deletions

View File

@ -3,7 +3,7 @@ destructors io io.backend io.ports io.timeouts io.backend.windows
io.files.windows io.files.windows.nt io.files io.pathnames io.buffers
io.streams.c io.streams.null libc kernel math namespaces sequences
threads windows windows.errors windows.kernel32 strings splitting
ascii system accessors locals ;
ascii system accessors locals classes.struct ;
QUALIFIED: windows.winsock
IN: io.backend.windows.nt

View File

@ -4,7 +4,8 @@ USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.ports io.binary io.timeouts system
strings kernel math namespaces sequences windows.errors
windows.kernel32 windows.shell32 windows.types windows.winsock
splitting continuations math.bitwise accessors init sets assocs ;
splitting continuations math.bitwise accessors init sets assocs
classes.struct classes ;
IN: io.backend.windows
TUPLE: win32-handle < disposable handle ;
@ -50,6 +51,5 @@ HOOK: add-completion io-backend ( port -- )
} flags ; foldable
: default-security-attributes ( -- obj )
"SECURITY_ATTRIBUTES" <c-object>
"SECURITY_ATTRIBUTES" heap-size
over set-SECURITY_ATTRIBUTES-nLength ;
SECURITY_ATTRIBUTES <struct>
dup class heap-size >>nLength ;

View File

@ -0,0 +1,6 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test io.files.info.windows system kernel ;
IN: io.files.info.windows.tests
[ ] [ vm file-times 3drop ] unit-test

View File

@ -5,7 +5,7 @@ io.files.windows io.files.windows.nt kernel windows.kernel32
windows.time windows accessors alien.c-types combinators
generalizations system alien.strings io.encodings.utf16n
sequences splitting windows.errors fry continuations destructors
calendar ascii combinators.short-circuit locals ;
calendar ascii combinators.short-circuit locals classes.struct ;
IN: io.files.info.windows
:: round-up-to ( n multiple -- n' )
@ -57,35 +57,26 @@ TUPLE: windows-file-info < file-info attributes ;
: BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info )
[ \ windows-file-info new ] dip
{
[ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ]
[ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes >>attributes ]
[ dwFileAttributes>> win32-file-type >>type ]
[ dwFileAttributes>> win32-file-attributes >>attributes ]
[
[ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ]
[ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size
[ nFileSizeLow>> ]
[ nFileSizeHigh>> ] bi >64bit >>size
]
[ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>permissions ]
[
BY_HANDLE_FILE_INFORMATION-ftCreationTime
FILETIME>timestamp >>created
]
[
BY_HANDLE_FILE_INFORMATION-ftLastWriteTime
FILETIME>timestamp >>modified
]
[
BY_HANDLE_FILE_INFORMATION-ftLastAccessTime
FILETIME>timestamp >>accessed
]
! [ BY_HANDLE_FILE_INFORMATION-nNumberOfLinks ]
[ dwFileAttributes>> >>permissions ]
[ ftCreationTime>> FILETIME>timestamp >>created ]
[ ftLastWriteTime>> FILETIME>timestamp >>modified ]
[ ftLastAccessTime>> FILETIME>timestamp >>accessed ]
! [ nNumberOfLinks>> ]
! [
! [ BY_HANDLE_FILE_INFORMATION-nFileIndexLow ]
! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit
! [ nFileIndexLow>> ]
! [ nFileIndexHigh>> ] bi >64bit
! ]
} cleave ;
: get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION )
[
"BY_HANDLE_FILE_INFORMATION" <c-object>
BY_HANDLE_FILE_INFORMATION <struct>
[ GetFileInformationByHandle win32-error=0/f ] keep
] keep CloseHandle win32-error=0/f ;
@ -197,10 +188,10 @@ M: winnt file-systems ( -- array )
: file-times ( path -- timestamp timestamp timestamp )
[
normalize-path open-existing &dispose handle>>
"FILETIME" <c-object>
"FILETIME" <c-object>
"FILETIME" <c-object>
normalize-path open-read &dispose handle>>
FILETIME <struct>
FILETIME <struct>
FILETIME <struct>
[ GetFileTime win32-error=0/f ] 3keep
[ FILETIME>timestamp >local-time ] tri@
] with-destructors ;

View File

@ -85,7 +85,7 @@ IN: io.launcher.windows.nt
: redirect-stderr ( process args -- handle )
over stderr>> +stdout+ eq? [
nip
lpStartupInfo>> STARTUPINFO-hStdOutput
lpStartupInfo>> hStdOutput>>
] [
drop
stderr>>
@ -104,7 +104,7 @@ IN: io.launcher.windows.nt
STD_INPUT_HANDLE GetStdHandle or ;
M: winnt fill-redirection ( process args -- )
[ 2dup redirect-stdout ] keep lpStartupInfo>> set-STARTUPINFO-hStdOutput
[ 2dup redirect-stderr ] keep lpStartupInfo>> set-STARTUPINFO-hStdError
[ 2dup redirect-stdin ] keep lpStartupInfo>> set-STARTUPINFO-hStdInput
2drop ;
dup lpStartupInfo>>
[ [ redirect-stdout ] dip (>>hStdOutput) ]
[ [ redirect-stderr ] dip (>>hStdError) ]
[ [ redirect-stdin ] dip (>>hStdInput) ] 3tri ;

View File

@ -7,7 +7,7 @@ namespaces make io.launcher kernel sequences windows.errors
splitting system threads init strings combinators
io.backend accessors concurrency.flags io.files assocs
io.files.private windows destructors specialized-arrays.ushort
specialized-arrays.alien ;
specialized-arrays.alien classes classes.struct ;
IN: io.launcher.windows
TUPLE: CreateProcess-args
@ -24,9 +24,10 @@ TUPLE: CreateProcess-args
: default-CreateProcess-args ( -- obj )
CreateProcess-args new
"STARTUPINFO" <c-object>
"STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo
"PROCESS_INFORMATION" <c-object> >>lpProcessInformation
STARTUPINFO <struct>
dup class heap-size >>cb
>>lpStartupInfo
PROCESS_INFORMATION <struct> >>lpProcessInformation
TRUE >>bInheritHandles
0 >>dwCreateFlags ;
@ -108,7 +109,7 @@ TUPLE: CreateProcess-args
] when ;
: fill-startup-info ( process args -- process args )
STARTF_USESTDHANDLES over lpStartupInfo>> set-STARTUPINFO-dwFlags ;
dup lpStartupInfo>> STARTF_USESTDHANDLES >>dwFlags drop ;
HOOK: fill-redirection io-backend ( process args -- )
@ -136,17 +137,16 @@ M: windows run-process* ( process -- handle )
] with-destructors ;
M: windows kill-process* ( handle -- )
PROCESS_INFORMATION-hProcess
255 TerminateProcess win32-error=0/f ;
hProcess>> 255 TerminateProcess win32-error=0/f ;
: dispose-process ( process-information -- )
#! From MSDN: "Handles in PROCESS_INFORMATION must be closed
#! with CloseHandle when they are no longer needed."
dup PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when*
PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ;
[ hProcess>> [ CloseHandle drop ] when* ]
[ hThread>> [ CloseHandle drop ] when* ] bi ;
: exit-code ( process -- n )
PROCESS_INFORMATION-hProcess
hProcess>>
0 <ulong> [ GetExitCodeProcess ] keep *ulong
swap win32-error=0/f ;
@ -157,7 +157,7 @@ M: windows kill-process* ( handle -- )
M: windows wait-for-processes ( -- ? )
processes get keys dup
[ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as
[ handle>> hProcess>> ] void*-array{ } map-as
[ length ] keep 0 0
WaitForMultipleObjects
dup HEX: ffffffff = [ win32-error ] when

View File

@ -149,7 +149,7 @@ CLASS: {
! Rendering
{ "drawRect:" "void" { "id" "SEL" "NSRect" }
[ 2drop window relayout-1 ]
[ 2drop window relayout-1 yield ]
}
! Events

View File

@ -1,6 +1,7 @@
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax kernel windows.types multiline ;
USING: alien alien.syntax kernel windows.types multiline
classes.struct ;
IN: windows.kernel32
CONSTANT: MAX_PATH 260
@ -215,15 +216,15 @@ C-STRUCT: OVERLAPPED
{ "DWORD" "offset-high" }
{ "HANDLE" "event" } ;
C-STRUCT: SYSTEMTIME
{ "WORD" "wYear" }
{ "WORD" "wMonth" }
{ "WORD" "wDayOfWeek" }
{ "WORD" "wDay" }
{ "WORD" "wHour" }
{ "WORD" "wMinute" }
{ "WORD" "wSecond" }
{ "WORD" "wMilliseconds" } ;
STRUCT: SYSTEMTIME
{ wYear WORD }
{ wMonth WORD }
{ wDayOfWeek WORD }
{ wDay WORD }
{ wHour WORD }
{ wMinute WORD }
{ wSecond WORD }
{ wMilliseconds WORD } ;
C-STRUCT: TIME_ZONE_INFORMATION
{ "LONG" "Bias" }
@ -234,74 +235,74 @@ C-STRUCT: TIME_ZONE_INFORMATION
{ "SYSTEMTIME" "DaylightDate" }
{ "LONG" "DaylightBias" } ;
C-STRUCT: FILETIME
{ "DWORD" "dwLowDateTime" }
{ "DWORD" "dwHighDateTime" } ;
STRUCT: FILETIME
{ dwLowDateTime DWORD }
{ dwHighDateTime DWORD } ;
C-STRUCT: STARTUPINFO
{ "DWORD" "cb" }
{ "LPTSTR" "lpReserved" }
{ "LPTSTR" "lpDesktop" }
{ "LPTSTR" "lpTitle" }
{ "DWORD" "dwX" }
{ "DWORD" "dwY" }
{ "DWORD" "dwXSize" }
{ "DWORD" "dwYSize" }
{ "DWORD" "dwXCountChars" }
{ "DWORD" "dwYCountChars" }
{ "DWORD" "dwFillAttribute" }
{ "DWORD" "dwFlags" }
{ "WORD" "wShowWindow" }
{ "WORD" "cbReserved2" }
{ "LPBYTE" "lpReserved2" }
{ "HANDLE" "hStdInput" }
{ "HANDLE" "hStdOutput" }
{ "HANDLE" "hStdError" } ;
STRUCT: STARTUPINFO
{ cb DWORD }
{ lpReserved LPTSTR }
{ lpDesktop LPTSTR }
{ lpTitle LPTSTR }
{ dwX DWORD }
{ dwY DWORD }
{ dwXSize DWORD }
{ dwYSize DWORD }
{ dwXCountChars DWORD }
{ dwYCountChars DWORD }
{ dwFillAttribute DWORD }
{ dwFlags DWORD }
{ wShowWindow WORD }
{ cbReserved2 WORD }
{ lpReserved2 LPBYTE }
{ hStdInput HANDLE }
{ hStdOutput HANDLE }
{ hStdError HANDLE } ;
TYPEDEF: void* LPSTARTUPINFO
C-STRUCT: PROCESS_INFORMATION
{ "HANDLE" "hProcess" }
{ "HANDLE" "hThread" }
{ "DWORD" "dwProcessId" }
{ "DWORD" "dwThreadId" } ;
STRUCT: PROCESS_INFORMATION
{ hProcess HANDLE }
{ hThread HANDLE }
{ dwProcessId DWORD }
{ dwThreadId DWORD } ;
C-STRUCT: SYSTEM_INFO
{ "DWORD" "dwOemId" }
{ "DWORD" "dwPageSize" }
{ "LPVOID" "lpMinimumApplicationAddress" }
{ "LPVOID" "lpMaximumApplicationAddress" }
{ "DWORD_PTR" "dwActiveProcessorMask" }
{ "DWORD" "dwNumberOfProcessors" }
{ "DWORD" "dwProcessorType" }
{ "DWORD" "dwAllocationGranularity" }
{ "WORD" "wProcessorLevel" }
{ "WORD" "wProcessorRevision" } ;
STRUCT: SYSTEM_INFO
{ dwOemId DWORD }
{ dwPageSize DWORD }
{ lpMinimumApplicationAddress LPVOID }
{ lpMaximumApplicationAddress LPVOID }
{ dwActiveProcessorMask DWORD_PTR }
{ dwNumberOfProcessors DWORD }
{ dwProcessorType DWORD }
{ dwAllocationGranularity DWORD }
{ wProcessorLevel WORD }
{ wProcessorRevision WORD } ;
TYPEDEF: void* LPSYSTEM_INFO
C-STRUCT: MEMORYSTATUS
{ "DWORD" "dwLength" }
{ "DWORD" "dwMemoryLoad" }
{ "SIZE_T" "dwTotalPhys" }
{ "SIZE_T" "dwAvailPhys" }
{ "SIZE_T" "dwTotalPageFile" }
{ "SIZE_T" "dwAvailPageFile" }
{ "SIZE_T" "dwTotalVirtual" }
{ "SIZE_T" "dwAvailVirtual" } ;
STRUCT: MEMORYSTATUS
{ dwLength DWORD }
{ dwMemoryLoad DWORD }
{ dwTotalPhys SIZE_T }
{ dwAvailPhys SIZE_T }
{ dwTotalPageFile SIZE_T }
{ dwAvailPageFile SIZE_T }
{ dwTotalVirtual SIZE_T }
{ dwAvailVirtual SIZE_T } ;
TYPEDEF: void* LPMEMORYSTATUS
C-STRUCT: MEMORYSTATUSEX
{ "DWORD" "dwLength" }
{ "DWORD" "dwMemoryLoad" }
{ "DWORDLONG" "ullTotalPhys" }
{ "DWORDLONG" "ullAvailPhys" }
{ "DWORDLONG" "ullTotalPageFile" }
{ "DWORDLONG" "ullAvailPageFile" }
{ "DWORDLONG" "ullTotalVirtual" }
{ "DWORDLONG" "ullAvailVirtual" }
{ "DWORDLONG" "ullAvailExtendedVirtual" } ;
STRUCT: MEMORYSTATUSEX
{ dwLength DWORD }
{ dwMemoryLoad DWORD }
{ ullTotalPhys DWORDLONG }
{ ullAvailPhys DWORDLONG }
{ ullTotalPageFile DWORDLONG }
{ ullAvailPageFile DWORDLONG }
{ ullTotalVirtual DWORDLONG }
{ ullAvailVirtual DWORDLONG }
{ ullAvailExtendedVirtual DWORDLONG } ;
TYPEDEF: void* LPMEMORYSTATUSEX
@ -707,17 +708,17 @@ C-STRUCT: WIN32_FIND_DATA
{ { "TCHAR" 260 } "cFileName" }
{ { "TCHAR" 14 } "cAlternateFileName" } ;
C-STRUCT: BY_HANDLE_FILE_INFORMATION
{ "DWORD" "dwFileAttributes" }
{ "FILETIME" "ftCreationTime" }
{ "FILETIME" "ftLastAccessTime" }
{ "FILETIME" "ftLastWriteTime" }
{ "DWORD" "dwVolumeSerialNumber" }
{ "DWORD" "nFileSizeHigh" }
{ "DWORD" "nFileSizeLow" }
{ "DWORD" "nNumberOfLinks" }
{ "DWORD" "nFileIndexHigh" }
{ "DWORD" "nFileIndexLow" } ;
STRUCT: BY_HANDLE_FILE_INFORMATION
{ dwFileAttributes DWORD }
{ ftCreationTime FILETIME }
{ ftLastAccessTime FILETIME }
{ ftLastWriteTime FILETIME }
{ dwVolumeSerialNumber DWORD }
{ nFileSizeHigh DWORD }
{ nFileSizeLow DWORD }
{ nNumberOfLinks DWORD }
{ nFileIndexHigh DWORD }
{ nFileIndexLow DWORD } ;
TYPEDEF: WIN32_FIND_DATA* PWIN32_FIND_DATA
TYPEDEF: WIN32_FIND_DATA* LPWIN32_FIND_DATA
@ -737,10 +738,10 @@ TYPEDEF: PFILETIME LPFILETIME
TYPEDEF: int GET_FILEEX_INFO_LEVELS
C-STRUCT: SECURITY_ATTRIBUTES
{ "DWORD" "nLength" }
{ "LPVOID" "lpSecurityDescriptor" }
{ "BOOL" "bInheritHandle" } ;
STRUCT: SECURITY_ATTRIBUTES
{ nLength DWORD }
{ lpSecurityDescriptor LPVOID }
{ bInheritHandle BOOL } ;
CONSTANT: HANDLE_FLAG_INHERIT 1
CONSTANT: HANDLE_FLAG_PROTECT_FROM_CLOSE 2

View File

@ -1,7 +1,8 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types kernel math windows.errors
windows.kernel32 namespaces calendar math.bitwise ;
windows.kernel32 namespaces calendar math.bitwise accessors
classes.struct ;
IN: windows.time
: >64bit ( lo hi -- n )
@ -11,15 +12,13 @@ IN: windows.time
1601 1 1 0 0 0 instant <timestamp> ;
: FILETIME>windows-time ( FILETIME -- n )
[ FILETIME-dwLowDateTime ]
[ FILETIME-dwHighDateTime ]
bi >64bit ;
[ dwLowDateTime>> ] [ dwHighDateTime>> ] bi >64bit ;
: windows-time>timestamp ( n -- timestamp )
10000000 /i seconds windows-1601 swap time+ ;
: windows-time ( -- n )
"FILETIME" <c-object> [ GetSystemTimeAsFileTime ] keep
FILETIME <struct> [ GetSystemTimeAsFileTime ] keep
FILETIME>windows-time ;
: timestamp>windows-time ( timestamp -- n )
@ -27,11 +26,8 @@ IN: windows.time
>gmt windows-1601 (time-) 10000000 * >integer ;
: windows-time>FILETIME ( n -- FILETIME )
"FILETIME" <c-object>
[
[ [ 32 bits ] dip set-FILETIME-dwLowDateTime ]
[ [ -32 shift ] dip set-FILETIME-dwHighDateTime ] 2bi
] keep ;
[ FILETIME <struct> ] dip
[ 32 bits >>dwLowDateTime ] [ -32 shift >>dwHighDateTime ] bi ;
: timestamp>FILETIME ( timestamp -- FILETIME/f )
dup [ >gmt timestamp>windows-time windows-time>FILETIME ] when ;

View File

@ -1,8 +1,9 @@
! Copyright (C) 2007, 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors images images.loader io.pathnames kernel namespaces
opengl opengl.gl opengl.textures sequences strings ui ui.gadgets
ui.gadgets.panes ui.render ui.images ;
USING: accessors images images.loader io.pathnames kernel
models namespaces opengl opengl.gl opengl.textures sequences
strings ui ui.gadgets ui.gadgets.panes ui.images ui.render
constructors ;
IN: images.viewer
TUPLE: image-gadget < gadget image texture ;
@ -13,7 +14,20 @@ M: image-gadget pref-dim* image>> dim>> ;
dup texture>> [ ] [ dup image>> { 0 0 } <texture> >>texture texture>> ] ?if ;
M: image-gadget draw-gadget* ( gadget -- )
[ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture ;
dup image>> [
[ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture
] [
drop
] if ;
TUPLE: image-control < image-gadget ;
CONSTRUCTOR: image-control ( model -- image-control ) ;
M: image-control pref-dim* image>> [ dim>> ] [ { 640 480 } ] if* ;
M: image-control model-changed
swap value>> >>image relayout ;
! Todo: delete texture on ungraft

View File

@ -3,37 +3,38 @@
USING: alien alien.c-types alien.strings
kernel libc math namespaces system-info.backend
system-info.windows windows windows.advapi32
windows.kernel32 system byte-arrays windows.errors ;
windows.kernel32 system byte-arrays windows.errors
classes classes.struct ;
IN: system-info.windows.nt
M: winnt cpus ( -- n )
system-info SYSTEM_INFO-dwNumberOfProcessors ;
: memory-status ( -- MEMORYSTATUSEX )
"MEMORYSTATUSEX" <c-object>
"MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength
"MEMORYSTATUSEX" <struct>
dup class heap-size >>dwLength
dup GlobalMemoryStatusEx win32-error=0/f ;
M: winnt memory-load ( -- n )
memory-status MEMORYSTATUSEX-dwMemoryLoad ;
memory-status dwMemoryLoad>> ;
M: winnt physical-mem ( -- n )
memory-status MEMORYSTATUSEX-ullTotalPhys ;
memory-status ullTotalPhys>> ;
M: winnt available-mem ( -- n )
memory-status MEMORYSTATUSEX-ullAvailPhys ;
memory-status ullAvailPhys>> ;
M: winnt total-page-file ( -- n )
memory-status MEMORYSTATUSEX-ullTotalPageFile ;
memory-status ullTotalPageFile>> ;
M: winnt available-page-file ( -- n )
memory-status MEMORYSTATUSEX-ullAvailPageFile ;
memory-status ullAvailPageFile>> ;
M: winnt total-virtual-mem ( -- n )
memory-status MEMORYSTATUSEX-ullTotalVirtual ;
memory-status ullTotalVirtual>> ;
M: winnt available-virtual-mem ( -- n )
memory-status MEMORYSTATUSEX-ullAvailVirtual ;
memory-status ullAvailVirtual>> ;
: computer-name ( -- string )
MAX_COMPUTERNAME_LENGTH 1 +

View File

@ -7,18 +7,18 @@ system alien.strings windows.errors ;
IN: system-info.windows
: system-info ( -- SYSTEM_INFO )
"SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ;
SYSTEM_INFO <struct> [ GetSystemInfo ] keep ;
: page-size ( -- n )
system-info SYSTEM_INFO-dwPageSize ;
system-info dwPageSize>> ;
! 386, 486, 586, 2200 (IA64), 8664 (AMD_X8664)
: processor-type ( -- n )
system-info SYSTEM_INFO-dwProcessorType ;
system-info dwProcessorType>> ;
! 0 = x86, 6 = Intel Itanium, 9 = x64 (AMD or Intel), 10 = WOW64, 0xffff = Unk
: processor-architecture ( -- n )
system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ;
system-info dwOemId>> HEX: ffff0000 bitand ;
: os-version ( -- os-version )
"OSVERSIONINFO" <c-object>