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)
  (let ((processes #f)
	(select-list #f))
    (lambda (message)
      (cond

       ((eq? message 'init)
	(lambda (self process-list buffer)
	  (let ((num-cols (result-buffer-num-cols buffer))
		(num-lines (result-buffer-num-lines buffer)))
	    (set! processes process-list)
	    (set! select-list
		  (make-process-selection-list 
		   num-cols num-lines processes))
	    self)))

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