72 lines
2.0 KiB
Scheme
72 lines
2.0 KiB
Scheme
(define-record-type plugin-state :plugin-state
|
|
(make-plugin-state processes selection-list cursor-x)
|
|
plugin-state?
|
|
(processes plugin-state-processes)
|
|
(selection-list plugin-state-selection-list)
|
|
(cursor-x plugin-state-cursor-x))
|
|
|
|
(define-record-discloser :plugin-state
|
|
(lambda (r)
|
|
`(plugin-state ,(plugin-state-selection-list r))))
|
|
|
|
(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 width processes)
|
|
(let ((layout (lambda (p) (layout-process width p))))
|
|
(make-select-list
|
|
(zip processes (map layout processes)))))
|
|
|
|
(define (pps-receiver message)
|
|
(debug-message "pps-receiver " message)
|
|
(cond
|
|
|
|
((init-with-result-message? message)
|
|
(let ((processes (init-with-result-message-result message))
|
|
(width (init-with-result-message-width message)))
|
|
(make-plugin-state
|
|
processes (make-process-selection-list width processes) 1)))
|
|
|
|
((print-message? message)
|
|
(paint-selection-list
|
|
(plugin-state-selection-list
|
|
(message-result-object message))))
|
|
|
|
((key-pressed-message? message)
|
|
(let ((old-state (message-result-object message)))
|
|
(make-plugin-state
|
|
(plugin-state-processes old-state)
|
|
(select-list-handle-key-press
|
|
(plugin-state-selection-list old-state)
|
|
message)
|
|
(plugin-state-cursor-x old-state))))
|
|
|
|
((restore-message? message)
|
|
(values))
|
|
|
|
((selection-message? message)
|
|
"'()")))
|
|
|
|
(register-plugin!
|
|
(make-view-plugin pps-receiver list-of-processes?))
|