Key bindings for fg, bg, and stop job

Ignore SIGTTOU within Commander S and reset to default handler before exec
This commit is contained in:
mainzelm 2005-09-13 13:20:30 +00:00
parent 0f45f80db0
commit 60d1130cf4
4 changed files with 53 additions and 20 deletions

View File

@ -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) (define (job-name->string name)
(let ((port (open-output-string))) (let ((port (open-output-string)))
(display name port) (display name port)
@ -89,8 +99,18 @@
((key-press) ((key-press)
(lambda (self key control-x-pressed?) (lambda (self key control-x-pressed?)
(set! select-list (cond
(select-list-handle-key-press select-list key)) ((= 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)) self))
((get-selection-as-text) get-selection-as-text) ((get-selection-as-text) get-selection-as-text)
@ -200,16 +220,18 @@
(define (handle-key-press self key control-x-pressed?) (define (handle-key-press self key control-x-pressed?)
(cond (cond
((= key (char->ascii #\f)) ((= key fg-key)
(continue-job-in-foreground job) (continue-job-in-foreground job))
self) ((= key bg-key)
((= key (char->ascii #\g)) (continue-job-in-background job))
(set! select-list (make-job-select-list job)) ((= key refresh-key)
self) (set! select-list (make-job-select-list job)))
((= key stop-job-key)
(stop-job job))
(else (else
(set! select-list (set! select-list
(select-list-handle-key-press select-list key)) (select-list-handle-key-press select-list key))))
self))) self)
(set! select-list (make-job-select-list job)) (set! select-list (make-job-select-list job))

View File

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

View File

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

View File

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