cleanup

sh/anguish.scm

@@ -145,7 +145,7 @@ copyleft.
 
 
 (define (builtin ast)
-  (format (current-error-port) "builtin: ~s\n" ast)
+  ;;(format (current-error-port) "builtin: ~s\n" ast)
   (match ast
     (('append ('glob "cd") arg) `(apply chdir ,arg))
     (('for-each rest ...) ast)

sh/pipe.scm

@@ -19,12 +19,11 @@
   (newline))
 
 (define-record-type <process>
-  (make-process pid command status state)
+  (make-process pid command status)
   process?
   (pid process-pid)
   (command process-command)
-  (status process-status set-process-status!)
-  (state process-state set-process-state!)) ;; '(running stopped completed terminated)
+  (status process-status set-process-status!))
 
 (define-record-type <job>
   (make-job id pgid processes)
@@ -36,12 +35,10 @@
 (define job-table '()) ;; list of <job>
 
 (define (status->state status)
-  (cond ((status:exit-val status)
-         'completed)
-        ((status:term-sig status)
-         'terminated)
-        ((status:stop-sig status)
-         'stopped)))
+  (cond ((status:exit-val status) 'completed)
+        ((status:term-sig status) 'terminated)
+        ((status:stop-sig status) 'stopped)
+        (#t 'running)))
 
 (define (job-status job)
   (process-status (car (job-processes job))))
@@ -49,16 +46,10 @@
 (define (job-update job pid status)
   (unless (= 0 pid)
     (let ((proc (find (compose (cute eqv? pid <>) process-pid) (job-processes job))))
-      (set-process-status! proc status)
-      (set-process-state! proc (status->state status)))))
+      (set-process-status! proc status))))
 
 (define (job-running? job)
-  (find (compose (cute eq? 'running <>) process-state) (job-processes job)))
-
-;; (define (job-at index)
-;;   (let ((len (length job-table)))
-;;     (if (or (> index len) (< index 0)) #f
-;;         (list-ref job-table (- len index)))))
+  (find (compose not process-status) (job-processes job)))
 
 (define (add-to-process-group job pid)
   (let* ((pgid (job-pgid job))
@@ -70,7 +61,7 @@
   (let ((pgid (add-to-process-group job pid)))
     (set-job-pgid! job pgid)
     (tcsetpgrp (current-error-port) pgid)
-    (set-job-processes! job (cons (make-process pid command #f 'running) (job-processes job)))))
+    (set-job-processes! job (cons (make-process pid command #f) (job-processes job)))))
 
 (define (job-control-init)
   (let* ((interactive? (isatty? (current-error-port)))
@@ -156,86 +147,8 @@
         (job-update job pid status)
         (if (job-running? job) (loop))))
     (tcsetpgrp (current-error-port) (getpid))
-    (pretty-print job-table)
+    ;;(pretty-print job-table)
     (job-status job)))
 
 ;;(pipeline (list "ls" "/")
 ;;(pipeline (list "ls" "/") (list "grep" "o") (list "tr" "o" "e"))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (define (job-launch command fg?) ;; todo: integrate into pipeline
-;;   (let* ((interactive? (isatty? (current-error-port)))
-;;          (foo (stdout "ISATTY: " interactive?))
-;;          (pgid (getpid))
-;;          (pid (primitive-fork)))
-;;     (if (= 0 pid)
-;;         (when interactive? ;; the child i.e. command
-;;           (setpgid (getpid) (getpid)) ;; put job in own process group
-;;           (if fg? (tcsetpgrp (current-error-port) (getpid))) ;; put job in foreground
-
-;;           (map (cut sigaction <> SIG_DFL)
-;;                (list SIGINT SIGQUIT SIGTSTP SIGTTIN SIGTTOU SIGCHLD))
-
-;;           (fdes->inport 0)
-;;           (map fdes->outport '(1 2))
-
-;;           (exec* command)
-;;           (exit 1))
-;;         (when interactive? ;; the parent i.e. shell
-;;           (setpgid pid pid) ;; put job in own process group
-;;           (tcsetpgrp (current-error-port) pid) ;; put job in foreground
-;;           (when fg?
-;;             (waitpid pid WUNTRACED)
-;;             (tcsetpgrp (current-error-port) (getpid))))))) ;; put shell in foreground
-
-;; (define (mark-job-status pid status)
-;;   (if (not (= 0 pid))
-;;       (cond ((status:stop-sig status)
-;;              (set-job-stopped! pid job-table))
-;;             ((status:term-sig status)
-;;              (set-job-terminated! pid job-table))
-;;             ((status:exit-val status)
-;;              (set-job-completed! pid job-table)))))
-
-;; (define (job-wait job)
-;;   (let loop ()
-;;     (let* ((status (job-status job))
-;;            (pid-status (waitpid WAIT_ANY WUNTRACED))
-;;            (pid (car pid-status))
-;;            (status (cdr pid-status)))
-;;       (mark-job-status pid status)
-;;       (if (eq? status (job-status job)) (loop)))))
-
-;; (define (set-job-stopped! job-table pid)
-;;   (set-job-status! (assoc-ref job-table pid) 'stopped))
-
-;; (define (set-job-terminated! job-table pid) ;; signal
-;;   (set-job-status! (assoc-ref job-table pid) 'terminated))
-
-;; (define (set-job-completed! job-table pid) ;; exit value
-;;   (set-job-status! (assoc-ref job-table pid) 'completed))
-
-;; (define (notify-job-status job-table) ;; call when prompting, from SIGCHLD handler or
-;;   (let* ((pid-status (waitpid WAIT_ANY (logior WUNTRACED WNOHANG)))
-;;          (pid (car pid-status))
-;;          (status (cdr pid-status)))
-;;     (mark-job-status pid status)))
-
-;; (define (job-by-id job-table id)
-;;   (if (< job-id (length job-table))
-;;       (list-ref job-table job-id)
-;;       #f))
-
-;; (define (background job-id)
-;;   (let ((job (job-by-id job-table job-id)))
-;;     (if (and job (eq? 'stopped (job-status job)))
-;;         (kill (- (job-pgid job)) SIGCONT))))
-
-;; (define (foreground job-id)
-;;   (let ((job (job-by-id job-table job-id)))
-;;     (tcsetpgrp (current-error-port) (job-pgid job))
-;;     (if (and job (eq? 'stopped (job-status job)))
-;;         (kill (- (job-pgid job)) SIGCONT))
-;;     (job-wait job)
-;;     (tcsetpgrp (current-error-port) (getpid))))