]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/io/launcher/windows/windows.factor
Remove Windows CE from core/ basis/ and build-support/
[factor.git] / basis / io / launcher / windows / windows.factor
index 4a84064c33b4fb3bcb140e3752b4fc845e9770e5..47aeb0c712dbedc9a8b1d60e2d7a826e2ef20595 100755 (executable)
@@ -77,27 +77,16 @@ TUPLE: CreateProcess-args
         [ 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 ;
 
@@ -114,13 +103,9 @@ TUPLE: CreateProcess-args
 : 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
@@ -137,18 +122,6 @@ M: launch-error error.
     "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 ;
 
@@ -270,9 +243,21 @@ M: windows wait-for-processes ( -- ? )
     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 ;