Make the process-viewer react on get-focus-object and get-selection messages
This commit is contained in:
parent
7a87280516
commit
d34769b0e1
|
@ -218,10 +218,6 @@
|
||||||
prepare-selection-for-command-mode)
|
prepare-selection-for-command-mode)
|
||||||
file-names)))
|
file-names)))
|
||||||
|
|
||||||
(define (make-focus-object-reference table obj)
|
|
||||||
(let ((id (add-focus-object table obj)))
|
|
||||||
`(focus-value ,id)))
|
|
||||||
|
|
||||||
(define (get-focus-object self focus-object-table)
|
(define (get-focus-object self focus-object-table)
|
||||||
(let ((marked (select-list-get-selection select-list))
|
(let ((marked (select-list-get-selection select-list))
|
||||||
(make-reference (lambda (obj)
|
(make-reference (lambda (obj)
|
||||||
|
|
|
@ -82,6 +82,7 @@
|
||||||
formats
|
formats
|
||||||
signals
|
signals
|
||||||
|
|
||||||
|
focus-table
|
||||||
ncurses
|
ncurses
|
||||||
pps
|
pps
|
||||||
plugin
|
plugin
|
||||||
|
@ -297,7 +298,8 @@
|
||||||
(define-interface focus-table-interface
|
(define-interface focus-table-interface
|
||||||
(export make-empty-focus-table
|
(export make-empty-focus-table
|
||||||
add-focus-object
|
add-focus-object
|
||||||
get-focus-object))
|
get-focus-object
|
||||||
|
make-focus-object-reference))
|
||||||
|
|
||||||
(define-structure focus-table focus-table-interface
|
(define-structure focus-table focus-table-interface
|
||||||
(open scheme
|
(open scheme
|
||||||
|
|
|
@ -47,6 +47,29 @@
|
||||||
(- (result-buffer-num-lines buffer) 1)
|
(- (result-buffer-num-lines buffer) 1)
|
||||||
processes))
|
processes))
|
||||||
(header (make-header-line (result-buffer-num-cols buffer))))
|
(header (make-header-line (result-buffer-num-cols buffer))))
|
||||||
|
|
||||||
|
(define (get-selection self for-scheme-mode?)
|
||||||
|
(let ((marked (select-list-get-selection select-list)))
|
||||||
|
(if (null? marked)
|
||||||
|
(number->string
|
||||||
|
(process-info-pid
|
||||||
|
(select-list-selected-entry select-list)))
|
||||||
|
(string-append
|
||||||
|
"'"(exp->string (map process-info-pid marked))))))
|
||||||
|
|
||||||
|
(define (get-focus-object self focus-object-table)
|
||||||
|
(let ((marked (select-list-get-selection select-list))
|
||||||
|
(make-reference (lambda (obj)
|
||||||
|
(make-focus-object-reference
|
||||||
|
focus-object-table obj))))
|
||||||
|
(if (null? marked)
|
||||||
|
(exp->string
|
||||||
|
(make-reference (select-list-selected-entry select-list)))
|
||||||
|
(string-append
|
||||||
|
"(list "
|
||||||
|
(string-join (map exp->string (map make-reference marked)))
|
||||||
|
")"))))
|
||||||
|
|
||||||
(lambda (message)
|
(lambda (message)
|
||||||
|
|
||||||
(case message
|
(case message
|
||||||
|
@ -62,6 +85,10 @@
|
||||||
(set! select-list
|
(set! select-list
|
||||||
(select-list-handle-key-press select-list key))
|
(select-list-handle-key-press select-list key))
|
||||||
self))
|
self))
|
||||||
|
|
||||||
|
((get-selection) get-selection)
|
||||||
|
|
||||||
|
((get-focus-object) get-focus-object)
|
||||||
|
|
||||||
(else
|
(else
|
||||||
(error "pps-viewer unknown message" message))))))
|
(error "pps-viewer unknown message" message))))))
|
||||||
|
|
Loading…
Reference in New Issue