From 60d1130cf48aad6501276db0ab29dcdbdd5e0d53 Mon Sep 17 00:00:00 2001 From: mainzelm Date: Tue, 13 Sep 2005 13:20:30 +0000 Subject: [PATCH] Key bindings for fg, bg, and stop job Ignore SIGTTOU within Commander S and reset to default handler before exec --- scheme/job-viewer.scm | 42 ++++++++++++++++++++++++++++++---------- scheme/job.scm | 29 +++++++++++++++++---------- scheme/nuit-engine.scm | 1 + scheme/nuit-packages.scm | 1 + 4 files changed, 53 insertions(+), 20 deletions(-) diff --git a/scheme/job-viewer.scm b/scheme/job-viewer.scm index c50a680..c61c42f 100644 --- a/scheme/job-viewer.scm +++ b/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)) diff --git a/scheme/job.scm b/scheme/job.scm index b5610dc..4593660 100644 --- a/scheme/job.scm +++ b/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) diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm index c214736..a21e686 100644 --- a/scheme/nuit-engine.scm +++ b/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) diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index 78dcc0e..d573a71 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -591,6 +591,7 @@ jobs-waiting-for-input continue-job-in-foreground + continue-job-in-background signal-job stop-job