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

Display the status of foreground jobs in the result buffer (instead of 

#{Unspecific})
This commit is contained in:
eknauel 2005-08-11 09:36:10 +00:00
parent ffff7d3a60
commit e83f3e7d81
1 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
scheme/job.scm
View File

@ -281,8 +281,9 @@
(define (save-tty-excursion port thunk) (define (save-tty-excursion port thunk)
(let ((settings (tty-info port))) (let ((settings (tty-info port)))
(thunk) (let ((val (thunk)))
(set-tty-info/now port settings))) (set-tty-info/now port settings)
val)))
;; run a job by running the program form ;; run a job by running the program form
@ -305,7 +306,7 @@
(define-syntax run/console (define-syntax run/console
(syntax-rules () (syntax-rules ()
((_ pf) ((_ pf)
(run/console* (cons 'run (quote pf)))))) (run/console* `(run (quote pf))))))
;; for use in command mode (used by command-line-compiler) ;; for use in command mode (used by command-line-compiler)
(define (run/fg* s-expr) (define (run/fg* s-expr)
@ -326,11 +327,14 @@
(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))
(eval-s-expr s-expr))))) (eval-s-expr s-expr)))))
(job-status (make-job-sans-console s-expr proc)) (let ((job (make-job-sans-console s-expr proc)))
(set-tty-process-group (current-output-port) foreground-pgrp) (job-status job)
(display "Press any key to return to Commander S...") (set-tty-process-group (current-output-port) foreground-pgrp)
(wait-for-key) (newline)
(release-lock paint-lock))))) (display "Press any key to return to Commander S...")
(wait-for-key)
(release-lock paint-lock)
job)))))
(define-syntax run/fg (define-syntax run/fg
(syntax-rules () (syntax-rules ()
@ -355,7 +359,7 @@
(define-syntax run/bg (define-syntax run/bg
(syntax-rules () (syntax-rules ()
((_ pf) ((_ pf)
(run/bg* (cons 'run (quote pf)))))) (run/bg* `(run ,(quote pf))))))
(define (init-evaluation-environment package) (define (init-evaluation-environment package)
(let ((structure (reify-structure package))) (let ((structure (reify-structure package)))