(define (list-of-processes? thing) (and (proper-list? thing) (every process-info? thing))) (define (string-take-max s nchars) (if (>= nchars (string-length s)) s (string-take s nchars))) (define (layout-process width p) (string-take-max (apply format (append (list #f "~A ~A ~A ~A '~A ~A'~%") (map (lambda (s) (s p)) (list process-info-pid process-info-ppid process-info-real-uid process-info-%cpu process-info-executable process-info-command-line)))) width)) (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) processes))) (lambda (message) (cond ((eq? message 'paint) (lambda (self . args) (apply paint-selection-list (cons select-list args)))) ((eq? message '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?))