Move priority code to io.launcher

extra/io/launcher/launcher-docs.factor

@@ -33,6 +33,17 @@ $nl
     { "a file stream or a socket - the stream is connected to the given Factor stream, which cannot be used again from within Factor and must be closed after the process has been started" }
 } ;
 
+ARTICLE: "io.launcher.priority" "Setting process priority"
+"The priority of the child process can be set by storing one of the below symbols in the " { $snippet "priority" } " slot of a " { $link process } " tuple:"
+{ $list
+    { $link +lowest-priority+ }
+    { $link +low-priority+ }
+    { $link +normal-priority+ }
+    { $link +high-priority+ }
+    { $link +highest-priority+ }
+}
+"The default value is " { $link f } ", which denotes that the child process should inherit the current process priority." ;
+
 HELP: +closed+
 { $description "Possible value for the " { $snippet "stdin" } ", " { $snippet "stdout" } ", and " { $snippet "stderr" } " slots of a " { $link process } "." } ;
 

extra/io/launcher/launcher.factor

@@ -6,7 +6,6 @@ init threads continuations math io.encodings io.streams.duplex
 io.nonblocking accessors ;
 IN: io.launcher
 
-
 TUPLE: process
 
 command
@@ -19,6 +18,8 @@ stdin
 stdout
 stderr
 
+priority
+
 timeout
 
 handle status
@@ -32,6 +33,12 @@ SYMBOL: +prepend-environment+
 SYMBOL: +replace-environment+
 SYMBOL: +append-environment+
 
+SYMBOL: +lowest-priority+
+SYMBOL: +low-priority+
+SYMBOL: +normal-priority+
+SYMBOL: +high-priority+
+SYMBOL: +highest-priority+
+
 : <process> ( -- process )
     process construct-empty
     H{ } clone >>environment

extra/io/process/process.factor

@@ -1,17 +0,0 @@
-USING: io.backend kernel ;
-IN: io.priority
-
-SYMBOL: +lowest-priority+
-SYMBOL: +low-priority+
-SYMBOL: +normal-priority+
-SYMBOL: +high-priority+
-SYMBOL: +highest-priority+
-
-HOOK: current-priority io-backend ( -- symbol )
-HOOK: set-current-priority io-backend ( symbol -- )
-HOOK: priority-values ( -- assoc )
-
-: lookup-priority ( symbol -- n )
-    priority-values at ;
-
-HOOK: get-process-list io-backend ( -- assoc )

extra/io/unix/launcher/launcher.factor

@@ -16,6 +16,17 @@ USE: unix
 : assoc>env ( assoc -- env )
     [ "=" swap 3append ] { } assoc>map ;
 
+: setup-priority ( process -- process )
+    dup priority>> [
+        H{
+            { +lowest-priority+ 20 }
+            { +low-priority+ 10 }
+            { +normal-priority+ 0 }
+            { +high-priority+ -10 }
+            { +highest-priority+ -20 }
+        } at set-priority
+    ] when* ;
+
 : redirect-fd ( oldfd fd -- )
     2dup = [ 2drop ] [ dupd dup2 io-error close ] if ;
 
@@ -47,11 +58,15 @@ USE: unix
 : setup-redirection ( process -- process )
     dup stdin>> ?closed read-flags 0 redirect
     dup stdout>> ?closed write-flags 1 redirect
-    dup stderr>> dup +stdout+ eq?
+    dup stderr>> dup +stdout+ eq? [
-    [ drop 1 2 dup2 io-error ] [ ?closed write-flags 2 redirect ] if ;
+        drop 1 2 dup2 io-error
+    ] [
+        ?closed write-flags 2 redirect
+    ] if ;
 
 : spawn-process ( process -- * )
     [
+        setup-priority
         setup-redirection
         dup pass-environment? [
             dup get-environment set-os-envs

extra/io/unix/process/process.factor

@@ -1,19 +0,0 @@
-USING: alien.syntax kernel io.process io.unix.backend
-unix ;
-IN: io.unix.process
-
-M: unix-io current-priority ( -- n )
-    clear_err_no
-    0 0 getpriority dup -1 = [ check-errno ] when ;
-
-M: unix-io set-current-priority ( n -- )
-    0 0 rot setpriority io-error ;
-
-M: unix-io priority-values ( -- assoc )
-    {
-        { +lowest-priority+ 20 }
-        { +low-priority+ 10 }
-        { +normal-priority+ 0 }
-        { +high-priority+ -10 }
-        { +highest-priority+ -20 }
-    } ;

extra/io/windows/process/process.factor

@@ -1,8 +0,0 @@
-USING: kernel ;
-IN: io.windows.process
-
-M: windows-io current-priority ( -- n )
-    ;
-
-M: windows-io set-current-priority ( n -- )
-    ;

extra/unix/process/process.factor

@@ -33,4 +33,7 @@ IN: unix.process
     fork dup io-error dup zero? -roll swap curry if ; inline
 
 : wait-for-pid ( pid -- status )
-    0 <int> [ 0 waitpid drop ] keep *int WEXITSTATUS ;
+    0 <int> [ 0 waitpid drop ] keep *int WEXITSTATUS ;
+
+: set-priority ( n -- )
+    0 0 rot setpriority io-error ;