[ drop f ]
} case ;
-: app-name/cmd-line ( process -- app-name cmd-line )
- command>> dup string? [
- " " split1
- ] [
- unclip swap join-arguments
- ] if ;
-
: cmd-line ( process -- cmd-line )
command>> dup string? [ join-arguments ] unless ;
-: fill-lpApplicationName ( process args -- process args )
- over app-name/cmd-line
- [ >>lpApplicationName ] [ >>lpCommandLine ] bi* ;
-
: fill-lpCommandLine ( process args -- process args )
over cmd-line >>lpCommandLine ;
: fill-dwCreateFlags ( process args -- process args )
0
pick pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when
- pick detached>> os winnt? and [ DETACHED_PROCESS bitor ] when
+ pick detached>> os windows? and [ DETACHED_PROCESS bitor ] when
pick lookup-priority [ bitor ] when*
>>dwCreateFlags ;
: fill-startup-info ( process args -- process args )
dup lpStartupInfo>> STARTF_USESTDHANDLES >>dwFlags drop ;
-HOOK: fill-redirection io-backend ( process args -- )
-
-M: wince fill-redirection 2drop ;
-
: make-CreateProcess-args ( process -- args )
default-CreateProcess-args
- os wince? [ fill-lpApplicationName ] [ fill-lpCommandLine ] if
+ fill-lpCommandLine
fill-dwCreateFlags
fill-lpEnvironment
fill-startup-info
"Launch descriptor:" print nl
process>> . ;
-M: windows run-process* ( process -- handle )
- [
- [
- current-directory get absolute-path cd
-
- dup make-CreateProcess-args
- [ fill-redirection ] keep
- dup call-CreateProcess
- lpProcessInformation>>
- ] with-destructors
- ] [ launch-error ] recover ;
-
M: windows kill-process* ( handle -- )
hProcess>> 255 TerminateProcess win32-error=0/f ;
OPEN_EXISTING
redirect
STD_INPUT_HANDLE GetStdHandle or ;
-
-M: winnt fill-redirection ( process args -- )
+
+: fill-redirection ( process args -- )
dup lpStartupInfo>>
[ [ redirect-stdout ] dip hStdOutput<< ]
[ [ redirect-stderr ] dip hStdError<< ]
[ [ redirect-stdin ] dip hStdInput<< ] 3tri ;
+
+M: windows run-process* ( process -- handle )
+ [
+ [
+ current-directory get absolute-path cd
+
+ dup make-CreateProcess-args
+ [ fill-redirection ] keep
+ dup call-CreateProcess
+ lpProcessInformation>>
+ ] with-destructors
+ ] [ launch-error ] recover ;