job: disable backgrounding

This commit is contained in:
Jan Nieuwenhuizen 2018-07-15 16:30:54 +02:00
parent e6e03c6da2
commit 85b90e8537
1 changed files with 7 additions and 3 deletions

View File

@ -102,13 +102,15 @@
(let ((pgid (add-to-process-group job pid))) (let ((pgid (add-to-process-group job pid)))
(set-job-pgid! job pgid) (set-job-pgid! job pgid)
(stderr "job-add-process fg?=~a\n" fg?) (stderr "job-add-process fg?=~a\n" fg?)
(when (and #f fg?) ;; FIXME (when (and (isatty? (current-error-port))
fg?)
(tcsetpgrp (current-error-port) pgid)) (tcsetpgrp (current-error-port) pgid))
(set-job-processes! job (cons (make-process pid command #f) (job-processes job))))) (set-job-processes! job (cons (make-process pid command #f) (job-processes job)))))
(define (job-setup-process fg? job) (define (job-setup-process fg? job)
(when (isatty? (current-error-port)) (when (isatty? (current-error-port))
(when (and #f fg?) (when (and (isatty? (current-error-port))
fg?)
(tcsetpgrp (current-error-port) (add-to-process-group job (getpid)))) (tcsetpgrp (current-error-port) (add-to-process-group job (getpid))))
(map (cut sigaction <> SIG_DFL) (map (cut sigaction <> SIG_DFL)
(list SIGINT SIGQUIT SIGTSTP SIGTTIN SIGTTOU SIGCHLD)))) (list SIGINT SIGQUIT SIGTSTP SIGTTIN SIGTTOU SIGCHLD))))
@ -116,7 +118,9 @@
(define (job-control-init) (define (job-control-init)
(when (isatty? (current-error-port)) (when (isatty? (current-error-port))
(let ((pgid (getpgrp))) (let ((pgid (getpgrp)))
(while (not (eqv? (tcgetpgrp (current-error-port)) pgid)) (while (and #f ;; FIXME: make check backgrouds our tests
(isatty? (current-error-port))
(not (eqv? (tcgetpgrp (current-error-port)) pgid)))
(kill (- pgid) SIGTTIN))) ;; oops we are not in the foreground (kill (- pgid) SIGTTIN))) ;; oops we are not in the foreground
(map (cut sigaction <> SIG_IGN) (list SIGINT SIGQUIT SIGTSTP SIGTTIN SIGTTOU)) (map (cut sigaction <> SIG_IGN) (list SIGINT SIGQUIT SIGTSTP SIGTTIN SIGTTOU))
(sigaction SIGCHLD SIG_DFL) (sigaction SIGCHLD SIG_DFL)