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

Got Windows launcher redirection working

db4
Slava Pestov 2008-01-25 02:37:37 -04:00
parent 993684ebb0
commit 76e4702f38
2 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
extra/io/launcher/launcher-docs.factor
View File

@ -154,9 +154,14 @@ $nl
{ $subsection +detached+ } { $subsection +detached+ }
{ $subsection +environment+ } { $subsection +environment+ }
{ $subsection +environment-mode+ } { $subsection +environment-mode+ }
"Redirecting standard input and output to files:"
{ $subsection +stdin+ }
{ $subsection +stdout+ }
{ $subsection +stderr+ }
"The following words are used to launch processes:" "The following words are used to launch processes:"
{ $subsection run-process } { $subsection run-process }
{ $subsection run-detached } { $subsection run-detached }
"Redirecting standard input and output to a pipe:"
{ $subsection <process-stream> } { $subsection <process-stream> }
{ $subsection with-process-stream } { $subsection with-process-stream }
"A class representing an active or finished process:" "A class representing an active or finished process:"

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

@ -21,14 +21,12 @@ TUPLE: CreateProcess-args
stdout-pipe stdin-pipe ; stdout-pipe stdin-pipe ;
: default-CreateProcess-args ( -- obj ) : default-CreateProcess-args ( -- obj )
0
0 0
"STARTUPINFO" <c-object> "STARTUPINFO" <c-object>
"STARTUPINFO" heap-size over set-STARTUPINFO-cb "STARTUPINFO" heap-size over set-STARTUPINFO-cb
"PROCESS_INFORMATION" <c-object> "PROCESS_INFORMATION" <c-object>
TRUE TRUE
{ {
set-CreateProcess-args-bInheritHandles
set-CreateProcess-args-dwCreateFlags set-CreateProcess-args-dwCreateFlags
set-CreateProcess-args-lpStartupInfo set-CreateProcess-args-lpStartupInfo
set-CreateProcess-args-lpProcessInformation set-CreateProcess-args-lpProcessInformation
@ -103,25 +101,26 @@ TUPLE: CreateProcess-args
: redirect ( obj access-mode create-mode -- handle ) : redirect ( obj access-mode create-mode -- handle )
{ {
{ [ pick not ] [ 3drop f ] } { [ pick not ] [ 3drop f ] }
{ [ pick +closed+ eq? ] [ 3drop f ] } { [ pick +closed+ eq? ] [ 3drop t ] }
{ [ pick string? ] [ (redirect) ] } { [ pick string? ] [ (redirect) ] }
} cond ; } cond ;
: ?closed or dup t eq? [ drop f ] when ;
: inherited-stdout ( args -- handle ) : inherited-stdout ( args -- handle )
CreateProcess-args-stdout-pipe CreateProcess-args-stdout-pipe
[ pipe-out ] [ STD_OUTPUT_HANDLE GetStdHandle ] if* ; [ pipe-out ] [ STD_OUTPUT_HANDLE GetStdHandle ] if* ;
: redirect-stdout ( args -- handle ) : redirect-stdout ( args -- handle )
+stdout+ get GENERIC_WRITE CREATE_ALWAYS redirect +stdout+ get GENERIC_WRITE CREATE_ALWAYS redirect
swap inherited-stdout or ; swap inherited-stdout ?closed ;
: inherited-stderr ( args -- handle ) : inherited-stderr ( args -- handle )
CreateProcess-args-stdout-pipe drop STD_ERROR_HANDLE GetStdHandle ;
[ pipe-out ] [ STD_ERROR_HANDLE GetStdHandle ] if* ;
: redirect-stderr ( args -- handle ) : redirect-stderr ( args -- handle )
+stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect +stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect
swap inherited-stderr or ; swap inherited-stderr ?closed ;
: inherited-stdin ( args -- handle ) : inherited-stdin ( args -- handle )
CreateProcess-args-stdin-pipe CreateProcess-args-stdin-pipe
@ -129,7 +128,7 @@ TUPLE: CreateProcess-args
: redirect-stdin ( args -- handle ) : redirect-stdin ( args -- handle )
+stdin+ get GENERIC_READ OPEN_EXISTING redirect +stdin+ get GENERIC_READ OPEN_EXISTING redirect
swap inherited-stdin or ; swap inherited-stdin ?closed ;
: fill-startup-info : fill-startup-info
dup CreateProcess-args-lpStartupInfo dup CreateProcess-args-lpStartupInfo