Add kill-process and flesh out inotify

extra/io/launcher/launcher-docs.factor

@@ -116,6 +116,15 @@ HELP: run-detached
     "The output value can be passed to " { $link wait-for-process } " to get an exit code."
 } ;
 
+HELP: kill-process
+{ $values { "process" process } }
+{ $description "Kills a running process. Does nothing if the process has already exited." } ;
+
+HELP: kill-process*
+{ $values { "handle" "a process handle" } }
+{ $contract "Kills a running process." }
+{ $notes "User code should call " { $link kill-process } " intead." } ;
+
 HELP: process
 { $class-description "A class representing an active or finished process."
 $nl
@@ -166,6 +175,8 @@ $nl
 "The following words are used to launch processes:"
 { $subsection run-process }
 { $subsection run-detached }
+"Stopping processes:"
+{ $subsection kill-process }
 "Redirecting standard input and output to a pipe:"
 { $subsection <process-stream> }
 { $subsection with-process-stream }

extra/io/launcher/launcher.factor

@@ -84,6 +84,11 @@ HOOK: run-process* io-backend ( desc -- handle )
 : run-detached ( desc -- process )
     >descriptor H{ { +detached+ t } } union run-process ;
 
+HOOK: kill-process* io-backend ( handle -- )
+
+: kill-process ( process -- )
+    process-handle [ kill-process* ] when* ;
+
 HOOK: process-stream* io-backend ( desc -- stream process )
 
 TUPLE: process-stream process ;

extra/io/unix/launcher/launcher.factor

@@ -57,7 +57,8 @@ MEMO: 'arguments' ( -- parser )
 : setup-redirection ( -- )
     +stdin+ get read-flags 0 redirect
     +stdout+ get write-flags 1 redirect
-    +stderr+ get write-flags 2 redirect ;
+    +stderr+ get dup +stdout+ get eq?
+    [ 1 2 dup2 ] [ write-flags 2 redirect ] if ;
 
 : spawn-process ( -- )
     [
@@ -74,6 +75,9 @@ M: unix-io run-process* ( desc -- pid )
         [ spawn-process ] [ ] with-fork <process>
     ] with-descriptor ;
 
+M: unix-io kill-process* ( pid -- )
+    SIGTERM kill io-error ;
+
 : open-pipe ( -- pair )
     2 "int" <c-array> dup pipe zero?
     [ 2 c-int-array> ] [ drop f ] if ;

extra/io/unix/linux/linux.factor

@@ -21,8 +21,11 @@ TUPLE: linux-monitor path wd callback ;
 
 TUPLE: inotify watches ;
 
-: wd>path ( wd -- path )
-    inotify get-global inotify-watches at linux-monitor-path ;
+: watches ( -- assoc ) inotify get-global inotify-watches ;
+
+: wd>monitor ( wd -- monitor ) watches at ;
+
+: wd>path ( wd -- path ) wd>monitor linux-monitor-path ;
 
 : <inotify> ( -- port )
     H{ } clone
@@ -31,8 +34,6 @@ TUPLE: inotify watches ;
 
 : inotify-fd inotify get-global port-handle ;
 
-: watches inotify get-global inotify-watches ;
-
 : (add-watch) ( path mask -- wd )
     inotify-fd -rot inotify_add_watch dup io-error ;
 
@@ -105,9 +106,13 @@ M: linux-monitor dispose ( monitor -- )
     inotify-event-len "inotify-event" heap-size +
     swap >r + r> ;
 
+: wd>queue ( wd -- queue )
+    inotify-event-wd wd>monitor monitor-queue ;
+
 : parse-file-notifications ( i buffer -- )
     2dup events-exhausted? [ 2drop ] [
-        2dup inotify-event@ parse-file-notify changed-file
+        2dup inotify-event@ dup inotify-event-wd wd>queue
+        [ parse-file-notify changed-file ] bind
         next-event parse-file-notifications
     ] if ;
 

extra/io/windows/launcher/launcher.factor

@@ -48,10 +48,10 @@ TUPLE: CreateProcess-args
     } get-slots CreateProcess win32-error=0/f ;
 
 : escape-argument ( str -- newstr )
-    [ [ dup CHAR: " = [ CHAR: \\ , ] when , ] each ] "" make ;
+    CHAR: \s over member? [ "\"" swap "\"" 3append ] when ;
 
 : join-arguments ( args -- cmd-line )
-    " " join ;
+    [ escape-argument ] map " " join ;
 
 : app-name/cmd-line ( -- app-name cmd-line )
     +command+ get [
@@ -162,6 +162,10 @@ M: windows-io run-process* ( desc -- handle )
         ] with-descriptor
     ] with-destructors ;
 
+M: windows-io kill-process* ( handle -- )
+    PROCESS_INFORMATION-hProcess
+    255 TerminateProcess win32-error=0/f ;
+
 : dispose-process ( process-information -- )
     #! From MSDN: "Handles in PROCESS_INFORMATION must be closed
     #! with CloseHandle when they are no longer needed."

extra/unix/unix.factor

@@ -168,9 +168,10 @@ FUNCTION: time_t time ( time_t* t ) ;
 FUNCTION: int unlink ( char* path ) ;
 FUNCTION: int utimes ( char* path, timeval[2] times ) ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! wait and waitpid
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+: SIGKILL 9 ; inline
+: SIGTERM 15 ; inline
+
+FUNCTION: int kill ( pid_t pid, int sig ) ;
 
 ! Flags for waitpid
 

extra/windows/kernel32/kernel32.factor

@@ -1453,7 +1453,7 @@ FUNCTION: DWORD SleepEx ( DWORD dwMilliSeconds, BOOL bAlertable ) ;
 FUNCTION: BOOL SystemTimeToFileTime ( SYSTEMTIME* lpSystemTime, LPFILETIME lpFileTime ) ;
 ! FUNCTION: SystemTimeToTzSpecificLocalTime
 ! FUNCTION: TerminateJobObject
-! FUNCTION: TerminateProcess
+FUNCTION: BOOL TerminateProcess ( HANDLE hProcess, DWORD uExit ) ;
 ! FUNCTION: TerminateThread
 ! FUNCTION: TermsrvAppInstallMode
 ! FUNCTION: Thread32First