commander-s/scheme/process.scm

(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?))