scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

clean up GO and GO/BG

This commit is contained in:
eknauel 2005-06-15 11:42:29 +00:00
parent fe9bfbf1a0
commit 154db1fb92
1 changed files with 28 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
scheme/job.scm
View File

@ -93,7 +93,8 @@
(signal-process-group signal (job-proc job))) (signal-process-group signal (job-proc job)))
(define (stop-job job) (define (stop-job job)
(signal-job signal/stop job)) (signal-process-group
(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))
@ -245,6 +246,11 @@
ready stopped ready stopped
(cons job new-output) (cons job new-output)
waiting-for-input #t)) waiting-for-input #t))
((= signal signal/tstp)
(stop-job job)
(lp (delete job running)
ready (cons job stopped)
new-output waiting-for-input #t))
(else (else
(error "Unhandled signal" signal))))) (error "Unhandled signal" signal)))))
((status:term-sig status) ((status:term-sig status)
@ -292,42 +298,34 @@
(define-syntax go (define-syntax go
(syntax-rules () (syntax-rules ()
((_ epf) ((_ epf)
(save-tty-excursion (begin
(current-input-port)
(lambda ()
(def-prog-mode) (def-prog-mode)
(clear) (clear)
(endwin) (endwin)
(restore-initial-tty-info! (current-input-port))
(drain-tty (current-output-port))
(obtain-lock paint-lock) (obtain-lock paint-lock)
(let ((foreground-pgrp (tty-process-group (current-output-port))) (let ((proc
(proc
(fork (fork
(lambda () (lambda ()
(set-process-group (pid) (pid)) (set-process-group (pid) (pid))
(set-tty-process-group (current-output-port) (pid)) (set-tty-process-group
(current-output-port) (pid))
(exec-epf epf))))) (exec-epf epf)))))
(job-status (make-job-sans-console (quote epf) proc)) (job-status
(set-tty-process-group (current-output-port) foreground-pgrp) (make-job-sans-console (quote epf) proc))
(set-tty-process-group
(current-output-port) (pid))
(display "Press any key to return to Commander S...") (display "Press any key to return to Commander S...")
(wait-for-key) (wait-for-key)
(release-lock paint-lock))))))) (release-lock paint-lock))))))
(define-syntax go/bg (define-syntax go/bg
(syntax-rules () (syntax-rules ()
((_ epf) ((_ epf)
(begin
(obtain-lock paint-lock)
(drain-tty (current-output-port))
(set-tty-process-group (current-output-port) (pid))
(let ((proc (let ((proc
(fork (fork
(lambda () (lambda ()
(set-process-group (pid) (pid)) (set-process-group (pid) (pid))
(exec-epf epf))))) (exec-epf epf)))))
(let ((job (make-job-sans-console (quote epf) proc))) (make-job-sans-console (quote epf) proc)))))
(release-lock paint-lock)
job))))))
;;; EOF ;;; EOF