Merge git://spitspat.com/git/factor

release
Doug Coleman 2007-12-05 09:50:12 -06:00
commit 8843843e3c
6 changed files with 18 additions and 29 deletions

View File

@ -7,7 +7,8 @@ IN: windows.ce.files
! M: windows-ce-io normalize-pathname ( string -- string ) ! M: windows-ce-io normalize-pathname ( string -- string )
! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ; ! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ;
M: windows-ce-io CreateFile-flags ( -- DWORD ) FILE_ATTRIBUTE_NORMAL ; M: windows-ce-io CreateFile-flags ( DWORD -- DWORD )
FILE_ATTRIBUTE_NORMAL bitor ;
M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ; M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ;
: finish-read ( port status bytes-ret -- ) : finish-read ( port status bytes-ret -- )

View File

@ -62,7 +62,7 @@ M: windows-ce-io with-privileges
: mmap-open ( path access-mode create-mode flProtect access -- handle handle address ) : mmap-open ( path access-mode create-mode flProtect access -- handle handle address )
{ "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [ { "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [
>r >r open-file dup f r> 0 0 f >r >r 0 open-file dup f r> 0 0 f
CreateFileMapping [ win32-error=0/f ] keep CreateFileMapping [ win32-error=0/f ] keep
dup close-later dup close-later
dup dup

View File

@ -3,8 +3,8 @@ io.windows.nt io.windows.nt.backend kernel libc math
threads windows windows.kernel32 ; threads windows windows.kernel32 ;
IN: io.windows.nt.files IN: io.windows.nt.files
M: windows-nt-io CreateFile-flags ( -- DWORD ) M: windows-nt-io CreateFile-flags ( DWORD -- DWORD )
FILE_FLAG_OVERLAPPED ; FILE_FLAG_OVERLAPPED bitor ;
M: windows-nt-io FileArgs-overlapped ( port -- overlapped ) M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
make-overlapped ; make-overlapped ;

View File

@ -23,7 +23,7 @@ TUPLE: win32-file handle ptr overlapped ;
: <win32-duplex-stream> ( in out -- stream ) : <win32-duplex-stream> ( in out -- stream )
>r f <win32-file> r> f <win32-file> handle>duplex-stream ; >r f <win32-file> r> f <win32-file> handle>duplex-stream ;
HOOK: CreateFile-flags io-backend ( -- DWORD ) HOOK: CreateFile-flags io-backend ( DWORD -- DWORD )
HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
HOOK: add-completion io-backend ( port -- ) HOOK: add-completion io-backend ( port -- )
@ -31,7 +31,8 @@ M: windows-io normalize-directory ( string -- string )
"\\" ?tail drop "\\*" append ; "\\" ?tail drop "\\*" append ;
: share-mode ( -- fixnum ) : share-mode ( -- fixnum )
FILE_SHARE_READ FILE_SHARE_WRITE bitor ; inline FILE_SHARE_READ FILE_SHARE_WRITE bitor
FILE_SHARE_DELETE bitor ; foldable
M: win32-file init-handle ( handle -- ) M: win32-file init-handle ( handle -- )
drop ; drop ;
@ -40,24 +41,25 @@ M: win32-file close-handle ( handle -- )
win32-file-handle CloseHandle drop ; win32-file-handle CloseHandle drop ;
! Clean up resources (open handle) if add-completion fails ! Clean up resources (open handle) if add-completion fails
: open-file ( path access-mode create-mode -- handle ) : open-file ( path access-mode create-mode flags -- handle )
[ [
>r share-mode f r> CreateFile-flags f CreateFile >r >r >r normalize-pathname r>
share-mode f r> r> CreateFile-flags f CreateFile
dup invalid-handle? dup close-later dup invalid-handle? dup close-later
dup add-completion dup add-completion
] with-destructors ; ] with-destructors ;
: open-pipe-r/w ( path -- handle ) : open-pipe-r/w ( path -- handle )
GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING open-file ; GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING 0 open-file ;
: open-read ( path -- handle length ) : open-read ( path -- handle length )
normalize-pathname GENERIC_READ OPEN_EXISTING open-file 0 ; GENERIC_READ OPEN_EXISTING 0 open-file 0 ;
: open-write ( path -- handle length ) : open-write ( path -- handle length )
normalize-pathname GENERIC_WRITE CREATE_ALWAYS open-file 0 ; GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 ;
: (open-append) ( path -- handle ) : (open-append) ( path -- handle )
normalize-pathname GENERIC_WRITE OPEN_ALWAYS open-file ; GENERIC_WRITE OPEN_ALWAYS 0 open-file ;
: set-file-pointer ( handle length -- ) : set-file-pointer ( handle length -- )
dupd d>w/w <uint> FILE_BEGIN SetFilePointer dupd d>w/w <uint> FILE_BEGIN SetFilePointer

View File

@ -4,8 +4,8 @@ USING: alien alien.c-types arrays assocs ui ui.gadgets
ui.backend ui.clipboards ui.gadgets.worlds ui.gestures io kernel ui.backend ui.clipboards ui.gadgets.worlds ui.gestures io kernel
math math.vectors namespaces prettyprint sequences strings math math.vectors namespaces prettyprint sequences strings
vectors words windows.kernel32 windows.gdi32 windows.user32 vectors words windows.kernel32 windows.gdi32 windows.user32
windows.opengl32 windows.messages windows.types windows.nt windows.shell32 windows.opengl32 windows.messages windows.types
windows threads timers libc combinators continuations windows.nt windows threads timers libc combinators continuations
command-line shuffle opengl ui.render ; command-line shuffle opengl ui.render ;
IN: ui.windows IN: ui.windows

View File

@ -1,5 +1,5 @@
USING: alien alien.c-types alien.syntax combinators USING: alien alien.c-types alien.syntax combinators
kernel windows ; kernel windows windows.user32 ;
IN: windows.shell32 IN: windows.shell32
: CSIDL_DESKTOP HEX: 00 ; inline : CSIDL_DESKTOP HEX: 00 ; inline
@ -67,20 +67,6 @@ IN: windows.shell32
: CSIDL_FLAG_CREATE HEX: 8000 ; inline : CSIDL_FLAG_CREATE HEX: 8000 ; inline
: CSIDL_FLAG_MASK HEX: ff00 ; inline : CSIDL_FLAG_MASK HEX: ff00 ; inline
: SW_HIDE 0 ; inline
: SW_SHOWNORMAL 1 ; inline
: SW_NORMAL 1 ; inline
: SW_SHOWMINIMIZED 2 ; inline
: SW_SHOWMAXIMIZED 3 ; inline
: SW_MAXIMIZE 3 ; inline
: SW_SHOWNOACTIVATE 4 ; inline
: SW_SHOW 5 ; inline
: SW_MINIMIZE 6 ; inline
: SW_SHOWMINNOACTIVE 7 ; inline
: SW_SHOWNA 8 ; inline
: SW_RESTORE 9 ; inline
: SW_SHOWDEFAULT 10 ; inline
: SW_MAX 10 ; inline
: S_OK 0 ; inline : S_OK 0 ; inline
: S_FALSE 1 ; inline : S_FALSE 1 ; inline