(define (list-of-processes? thing) (and (proper-list? thing) (every process-info? thing))) (define (make-header-line width) (cut-to-size width (string-append (fill-up-string 5 "PID") " " (fill-up-string 5 "PPID") " " (fill-up-string 5 "TIME") " " (fill-up-string 40 "COMMAND")))) (define (layout-process width p) (cut-to-size width (string-append (fill-up-string 5 (number->string (process-info-pid p))) " " (fill-up-string 5 (number->string (process-info-ppid p))) " " (fill-up-string 5 (number->string (process-info-time p))) " " (fill-up-string 40 (string-append (process-info-executable p) " " (string-join (process-info-command-line p))))))) (define (make-process-selection-list num-cols num-lines processes) (let ((layout (lambda (p) (layout-process num-cols p)))) (make-select-list (map (lambda (p) (make-unmarked-element p #t (layout-process num-cols p))) processes) num-lines))) (define (make-pps-viewer processes buffer) (let ((processes processes) (select-list (make-process-selection-list (result-buffer-num-cols buffer) (- (result-buffer-num-lines buffer) 1) processes)) (header (make-header-line (result-buffer-num-cols buffer)))) (lambda (message) (case message ((paint) (lambda (self win buffer have-focus?) (mvwaddstr win 0 0 header) (paint-selection-list-at select-list 0 1 win buffer have-focus?))) ((key-press) (lambda (self key control-x-pressed?) (set! select-list (select-list-handle-key-press select-list key)) self)) (else (error "pps-viewer unknown message" message)))))) (register-plugin! (make-view-plugin make-pps-viewer list-of-processes?))