(define-record-type job :job
  (make-job name pty-in pty-out proc status)
  job?
  (name job-name)
  (pty-in job-pty-in)
  (pty-out job-pty-out)
  (proc job-proc)
  (status really-job-status))

(define (make-job name pty-in pty-out proc)
  (let ((job (make-job name pty-in pty-out proc
		       (make-placeholder))))
    (spawn-job-status-surveillant job)
    (add-job! job)
    job))

(define (job-status-rv job)
  (placeholder-value-rv (really-job-status job)))

(define (job-status job)
  (sync (job-status-rv job)))

(define (spawn-job-status-surveillant job)
  (let ((channel (make-channel)))
    (spawn
     (lambda ()
       (placeholder-set! 
	(really-job-status job) (wait (job-proc)))))))

(define (signal-job signal job)
  (signal-process-group signal (job-proc job)))
  
(define (stop-job job)
  (signal-job signal/stop job))

(define (continue-job job)
  (signal-process-group signal/cont job))

;; channels for communicating with the joblist surveillant

(define add-job-channel
  (make-channel))

(define get-job-list-channel
  (make-channel))

(define (add-job! job)
  (send add-job-channel job))

(define (running-jobs)
  (let ((answer-channel (make-channel)))
    (send get-job-list-channel (cons 'running answer-channel))
    (receive answer-channel)))

(define (ready-jobs)
  (let ((answer-channel (make-channel)))
    (send get-job-list-channel (cons 'ready answer-channel))
    (receive answer-channel)))

(define (jobs-with-new-output)
  (let ((answer-channel (make-channel)))
    (send get-job-list-channel (cons 'new-output answer-channel))
    (receive answer-channel)))

(define (jobs-waiting-for-input)
  (let ((answer-channel (make-channel)))
    (send get-job-list-channel (cons 'waiting-for-input answer-channel))
    (receive answer-channel)))

(define (spawn-joblist-surveillant)
  (let ((statistics-channel (make-channel)))
    (spawn 
     (lambda ()
       (let lp ((running '()) 
		(ready '())
		(new-output '())
		(waiting-for-input '())
		(notify? #f))
	 (cond
	  (notify?
	   (send statistics-channel
		 (list (cons 'running (length running))
		       (cons 'ready (length ready))
		       (cons 'new-output (length new-output))
		       (cons 'waiting-for-input (length waiting-for-input))))
	   (lp running ready new-output waiting-for-input #f))
	  (else
	   (apply
	    select
	    (append
	     (list
	      (wrap (receive-rv add-job-channel)
		    (lambda (new-job)
		      (lp (cons new-job running) 
			  ready new-output waiting-for-input #t)))
      
	      (wrap (receive-rv get-job-list-channel)
		    (lambda (state.channel)
		      (send (cdr state.channel)
			    (case (car state.channel)
			      ((running) running)
			      ((ready) ready)
			      ((new-output) new-output)
			      ((waiting-for-input) waiting-for-input)
			      (else
			       (error "joblist-surveillant" state.channel))))
		      (lp running ready new-output waiting-for-input #f))))

	     (map (lambda (job)
		    (wrap (job-status-rv job)
			  (lambda (ignore)
			    (lp (delete job running)
				(cons job ready)
				new-output
				waiting-for-input #t))))
		  running))))))))
    statistics-channel))

(define (initial-job-statistics)
  (list (cons 'running 0) 
	(cons 'ready 0)
	(cons 'new-output 0)
	(cons 'waiting-for-input 0)))

;; #### unfinished
(define (install-terminal/stop-handler)
  (set-interrupt-handler 
   interrupt/tstp
   (lambda args
     (display args))))     

(define-syntax run-as-background-job
  (syntax-rules ()
    ((_ epf)
     (call-with-values
	 (lambda ()
	   (fork-pty-session
	    (lambda ()
	      (exec-epf epf))))
       (lambda (proc pty-in pty-out tty-name)
	 (make-job (quote epf) pty-in pty-out proc))))))