36 lines
832 B
Scheme
36 lines
832 B
Scheme
|
(define (print-processes processes)
|
||
|
|
(map (lambda (pi)
|
||
|
|
(apply format
|
||
|
|
(append
|
||
|
|
(list #f
|
||
|
|
"~A ~A ~A ~A '~A ~A'~%")
|
||
|
|
(map (lambda (s) (s pi))
|
||
|
|
(list process-info-pid
|
||
|
|
process-info-ppid
|
||
|
|
process-info-real-uid
|
||
|
|
process-info-%cpu
|
||
|
|
process-info-executable
|
||
|
|
process-info-command-line)))))
|
||
|
|
processes))
|
||
|
|
|
||
|
|
(define (pps-receiver message)
|
||
|
|
(cond
|
||
|
|
((next-command-message? message)
|
||
|
|
(pps))
|
||
|
|
((print-message? message)
|
||
|
|
(let ((processes (message-result-object message)))
|
||
|
|
(make-print-object 1 1 (print-processes processes)
|
||
|
|
'() '())))
|
||
|
|
((key-pressed-message? message)
|
||
|
|
(pps))
|
||
|
|
((restore-message? message)
|
||
|
|
(values))
|
||
|
|
((selection-message? message)
|
||
|
|
"'()")))
|
||
|
|
|
||
|
|
(set! receivers (cons (make-receiver "ps" pps-receiver)
|
||
|
|
receivers))
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|