checkpoint
This commit is contained in:
parent
fc8b856110
commit
628f111ced
|
@ -149,6 +149,7 @@ copyleft.
|
||||||
(match ast
|
(match ast
|
||||||
(('append ('glob "cd") arg) `(apply chdir ,arg))
|
(('append ('glob "cd") arg) `(apply chdir ,arg))
|
||||||
(('append ('glob "echo") args ...) `(apply stdout ,@args))
|
(('append ('glob "echo") args ...) `(apply stdout ,@args))
|
||||||
|
(('glob "jobs") `(jobs))
|
||||||
(('for-each rest ...) ast)
|
(('for-each rest ...) ast)
|
||||||
(('if rest ...) ast)
|
(('if rest ...) ast)
|
||||||
(_ #f)))
|
(_ #f)))
|
||||||
|
|
34
sh/pipe.scm
34
sh/pipe.scm
|
@ -8,7 +8,7 @@
|
||||||
:use-module (srfi srfi-9)
|
:use-module (srfi srfi-9)
|
||||||
:use-module (srfi srfi-26)
|
:use-module (srfi srfi-26)
|
||||||
|
|
||||||
:export (pipeline job-control-init))
|
:export (pipeline job-control-init jobs))
|
||||||
|
|
||||||
(define (stdout . o)
|
(define (stdout . o)
|
||||||
(map display o)
|
(map display o)
|
||||||
|
@ -35,10 +35,17 @@
|
||||||
(define job-table '()) ;; list of <job>
|
(define job-table '()) ;; list of <job>
|
||||||
|
|
||||||
(define (status->state status)
|
(define (status->state status)
|
||||||
(cond ((status:exit-val status) 'completed)
|
(cond ((status:exit-val status) 'Completed)
|
||||||
((status:term-sig status) 'terminated)
|
((status:term-sig status) 'Terminated)
|
||||||
((status:stop-sig status) 'stopped)
|
((status:stop-sig status) 'Stopped)
|
||||||
(#t 'running)))
|
(#t 'Running)))
|
||||||
|
|
||||||
|
(define (jobs)
|
||||||
|
(map (lambda (job number)
|
||||||
|
(stdout "[" number "]? " (status->state (job-status job)) "\t\t"
|
||||||
|
(process-command (car (job-processes job)))))
|
||||||
|
(reverse job-table)
|
||||||
|
(iota (length job-table) 1 1)))
|
||||||
|
|
||||||
(define (job-status job)
|
(define (job-status job)
|
||||||
(process-status (car (job-processes job))))
|
(process-status (car (job-processes job))))
|
||||||
|
@ -51,6 +58,9 @@
|
||||||
(define (job-running? job)
|
(define (job-running? job)
|
||||||
(find (compose not process-status) (job-processes job)))
|
(find (compose not process-status) (job-processes job)))
|
||||||
|
|
||||||
|
(define (job-stopped? job)
|
||||||
|
(find (compose status:stop-sig process-status) (job-processes job)))
|
||||||
|
|
||||||
(define (add-to-process-group job pid)
|
(define (add-to-process-group job pid)
|
||||||
(let* ((pgid (job-pgid job))
|
(let* ((pgid (job-pgid job))
|
||||||
(pgid (or pgid pid)))
|
(pgid (or pgid pid)))
|
||||||
|
@ -128,6 +138,10 @@
|
||||||
(job-add-process job pid command)
|
(job-add-process job pid command)
|
||||||
(and src (close src))))))
|
(and src (close src))))))
|
||||||
|
|
||||||
|
;; TODO:
|
||||||
|
;; report job status: before prompt or by calling jobs
|
||||||
|
;; remove reported terminated or completed jobs
|
||||||
|
|
||||||
(define (pipeline . commands)
|
(define (pipeline . commands)
|
||||||
(let ((interactive? (isatty? (current-error-port)))
|
(let ((interactive? (isatty? (current-error-port)))
|
||||||
(job (make-job (length job-table) #f '())))
|
(job (make-job (length job-table) #f '())))
|
||||||
|
@ -148,7 +162,15 @@
|
||||||
(if (job-running? job) (loop))))
|
(if (job-running? job) (loop))))
|
||||||
(tcsetpgrp (current-error-port) (getpid))
|
(tcsetpgrp (current-error-port) (getpid))
|
||||||
;;(pretty-print job-table)
|
;;(pretty-print job-table)
|
||||||
(job-status job)))
|
(job-status job)
|
||||||
|
(reap-jobs)))
|
||||||
|
|
||||||
|
(define (disjoin . predicates)
|
||||||
|
(lambda (. arguments)
|
||||||
|
(any (cut apply <> arguments) predicates)))
|
||||||
|
|
||||||
|
(define (reap-jobs)
|
||||||
|
(set! job-table (filter (disjoin job-running? job-stopped?) job-table)))
|
||||||
|
|
||||||
;;(pipeline (list "ls" "/")
|
;;(pipeline (list "ls" "/")
|
||||||
;;(pipeline (list "ls" "/") (list "grep" "o") (list "tr" "o" "e"))
|
;;(pipeline (list "ls" "/") (list "grep" "o") (list "tr" "o" "e"))
|
||||||
|
|
Loading…
Reference in New Issue