Key bindings for fg, bg, and stop job

Ignore SIGTTOU within Commander S and reset to default handler before exec

scheme/job-viewer.scm

@@ -1,3 +1,13 @@
+(define key-f (char->ascii #\f))
+(define key-s (char->ascii #\s))
+(define key-g (char->ascii #\g))
+(define key-b (char->ascii #\b))
+
+(define fg-key key-f)
+(define bg-key key-b)
+(define stop-job-key key-s)
+(define refresh-key key-g)
+
 (define (job-name->string name)
   (let ((port (open-output-string)))
     (display name port)
@@ -89,8 +99,18 @@
 
 	((key-press)
 	 (lambda (self key control-x-pressed?)
-	   (set! select-list
-		 (select-list-handle-key-press select-list key))
+           (cond 
+            ((= key fg-key)
+             (continue-job-in-foreground (select-list-selected-entry select-list)))
+            ((= key bg-key)
+             (continue-job-in-background (select-list-selected-entry select-list)))
+            ((= key stop-job-key)
+             (stop-job (select-list-selected-entry select-list)))
+            ((= key refresh-key)
+             #f) ;; TODO
+            (else
+             (set! select-list
+                   (select-list-handle-key-press select-list key))))
 	   self))
 
 	((get-selection-as-text) get-selection-as-text)	
@@ -200,16 +220,18 @@
 
     (define (handle-key-press self key control-x-pressed?)
       (cond
-       ((= key (char->ascii #\f))
-	(continue-job-in-foreground job)
-	self)
-       ((= key (char->ascii #\g))
-	(set! select-list (make-job-select-list job))
-	self)
+       ((= key fg-key)
+	(continue-job-in-foreground job))
+       ((= key bg-key)
+        (continue-job-in-background job))
+       ((= key refresh-key)
+	(set! select-list (make-job-select-list job)))
+       ((= key stop-job-key)
+        (stop-job job))
        (else
 	(set! select-list
-	      (select-list-handle-key-press select-list key))
-	self)))
+	      (select-list-handle-key-press select-list key))))
+      self)
 
     (set! select-list (make-job-select-list job))
 

scheme/job.scm

@@ -90,11 +90,10 @@
   (eq? (job-run-status job) 'stopped))
 
 (define (signal-job signal job)
-  (signal-process-group signal (job-proc job)))
+  (signal-process-group (job-proc job) signal))
   
 (define (stop-job job)
-  (signal-process-group 
-   (proc:pid (job-proc job)) signal/stop))
+  (signal-job signal/stop job))
 
 (define (continue-job job)
   (set-job-status! job (make-placeholder))
@@ -102,7 +101,7 @@
   (signal-process-group 
    (proc:pid (job-proc job)) signal/cont)
   (spawn-job-status-surveillant job)
-  (send notify-continue/foreground-channel job))
+  (send notify-continue-channel job))
 
 (define (pause-job-output job)
   (pause-console-output (job-console job)))
@@ -128,6 +127,9 @@
 	(wait-for-key)
 	(release-lock paint-lock))))
 
+(define (continue-job-in-background job)
+  (continue-job job))
+
 ;; channels for communicating with the joblist surveillant
 
 (define add-job-channel
@@ -139,7 +141,7 @@
 (define clear-ready-jobs-channel
   (make-channel))
 
-(define notify-continue/foreground-channel
+(define notify-continue-channel
   (make-channel))
 
 (define (add-job! job)
@@ -205,7 +207,7 @@
 		      (lp (cons new-job running)
 			  ready stopped new-output waiting-for-input #t)))
 
-	      (wrap (receive-rv notify-continue/foreground-channel)
+	      (wrap (receive-rv notify-continue-channel)
 		    (lambda (job)
 		      (lp (cons job running)
 			  ready 
@@ -251,7 +253,9 @@
 					  ready stopped
 					  (cons job new-output)
 					  waiting-for-input #t))
-				     ((= signal signal/tstp)
+				     ((or (= signal signal/tstp)
+                                          (= signal signal/stop))
+                                      ;; TODO catch any other signal here
 				      (stop-job job)
 				      (lp (delete job running)
 					  ready (cons job stopped)
@@ -294,6 +298,7 @@
       (lambda ()
 	(fork-pty-session
 	 (lambda () 
+           (handle-signal-default signal/ttou)
 	   (eval-s-expr s-expr))))
     (lambda (proc pty-in pty-out tty-name)
       (make-job-with-console
@@ -324,9 +329,12 @@
 	   (proc
 	    (fork
 	     (lambda ()
-	       (set-process-group (pid) (pid))
-	       (set-tty-process-group (current-output-port) (pid))
-	       (eval-s-expr s-expr)))))
+               (let ((child-pid (pid)))
+                 (set-process-group child-pid)
+                 (set-tty-process-group (current-output-port) child-pid)
+                 (handle-signal-default signal/ttou)
+                 (eval-s-expr s-expr))))))
+       (sleep 1000)
        (let* ((job (make-job-sans-console s-expr proc))
 	      (status (job-status job)))
 	 (set-tty-process-group (current-output-port) foreground-pgrp)
@@ -350,6 +358,7 @@
 	 (fork
 	  (lambda ()
 	    (set-process-group (pid) (pid))
+            (handle-signal-default signal/ttou)
 	    (eval-s-expr s-expr)))))
     (let ((job (make-job-sans-console s-expr proc)))
       (release-lock paint-lock)

scheme/nuit-engine.scm

@@ -299,6 +299,7 @@
 
 ;; handle input
 (define (run)
+  (ignore-signal signal/ttou)
   (save-initial-tty-info! (current-input-port))
 
   (autoreap-policy #f)

scheme/nuit-packages.scm

@@ -591,6 +591,7 @@
 	  jobs-waiting-for-input
 
 	  continue-job-in-foreground
+          continue-job-in-background
 
 	  signal-job
 	  stop-job