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

58
scheme/job.scm
View File

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