steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Get io.launcher working on Windows CE

release
Slava Pestov 2007-11-17 23:06:51 -05:00
parent 5c6a7120bb
commit 4ee696882f
1 changed files with 30 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
extra/io/windows/launcher/launcher.factor
View File

@ -1,8 +1,7 @@
USING: alien alien.c-types arrays continuations USING: alien alien.c-types arrays continuations destructors io
destructors io io.windows libc io.windows libc io.nonblocking io.streams.duplex windows.types
io.nonblocking io.streams.duplex windows.types math math windows.kernel32 windows namespaces io.launcher kernel
windows.kernel32 windows namespaces io.launcher kernel sequences windows.errors assocs splitting system ;
sequences io.windows.nt.backend windows.errors assocs ;
IN: io.windows.launcher IN: io.windows.launcher
! From MSDN: "Handles in PROCESS_INFORMATION must be closed with CloseHandle when they are no longer needed." ! From MSDN: "Handles in PROCESS_INFORMATION must be closed with CloseHandle when they are no longer needed."
@ -52,19 +51,30 @@ TUPLE: CreateProcess-args
CreateProcess-args-lpProcessInformation CreateProcess-args-lpProcessInformation
} get-slots CreateProcess win32-error=0/f ; } get-slots CreateProcess win32-error=0/f ;
: fill-lpCommandLine : join-arguments ( args -- cmd-line )
[ "\"" swap "\"" 3append ] map " " join ;
: app-name/cmd-line ( -- app-name cmd-line )
+command+ get [ +command+ get [
[ " " split1
+arguments+ get [ CHAR: \s , ] [ ] [
CHAR: " , +arguments+ get unclip swap join-arguments
[ dup CHAR: " = [ CHAR: \\ , ] when , ] each ] if* ;
CHAR: " ,
] interleave : cmd-line ( -- cmd-line )
] "" make +command+ get [ +arguments+ get join-arguments ] unless* ;
] unless* over set-CreateProcess-args-lpCommandLine ;
: fill-lpApplicationName
app-name/cmd-line
pick set-CreateProcess-args-lpCommandLine
over set-CreateProcess-args-lpApplicationName ;
: fill-lpCommandLine
cmd-line over set-CreateProcess-args-lpCommandLine ;
: fill-dwCreateFlags : fill-dwCreateFlags
CREATE_UNICODE_ENVIRONMENT 0
pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when
+detached+ get [ DETACHED_PROCESS bitor ] when +detached+ get [ DETACHED_PROCESS bitor ] when
over set-CreateProcess-args-dwCreateFlags ; over set-CreateProcess-args-dwCreateFlags ;
@ -86,7 +96,11 @@ TUPLE: CreateProcess-args
M: windows-io run-process* ( desc -- ) M: windows-io run-process* ( desc -- )
[ [
default-CreateProcess-args default-CreateProcess-args
wince? [
fill-lpApplicationName
] [
fill-lpCommandLine fill-lpCommandLine
] if
fill-dwCreateFlags fill-dwCreateFlags
fill-lpEnvironment fill-lpEnvironment
dup call-CreateProcess dup call-CreateProcess