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

    (define (get-selection-as-text self for-scheme-mode? focus-object-table)
      (let* ((marked (select-list-get-selection select-list)))
	(cond
	 ((null? marked)
	  (number->string 
	   (process-info-pid
	    (select-list-selected-entry select-list))))
	 (for-scheme-mode?
	  (string-append
	   "'" (exp->string (map process-info-pid marked))))
	 (else
	  (string-join 
	   (map number->string
		(map process-info-pid marked)))))))

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

       ((get-selection-as-text) get-selection-as-text)

       ((get-selection-as-ref)
	(make-get-selection-as-ref-method select-list))
       
       (else 
	(error "pps-viewer unknown message" message))))))

(register-plugin! 
 (make-view-plugin make-pps-viewer list-of-processes?))