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)
|
||||
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)
|
||||
(let ((marked (select-list-get-selection select-list))
|
||||
(make-reference (lambda (obj)
|
||||
|
|
|
@ -82,6 +82,7 @@
|
|||
formats
|
||||
signals
|
||||
|
||||
focus-table
|
||||
ncurses
|
||||
pps
|
||||
plugin
|
||||
|
@ -297,7 +298,8 @@
|
|||
(define-interface focus-table-interface
|
||||
(export make-empty-focus-table
|
||||
add-focus-object
|
||||
get-focus-object))
|
||||
get-focus-object
|
||||
make-focus-object-reference))
|
||||
|
||||
(define-structure focus-table focus-table-interface
|
||||
(open scheme
|
||||
|
|
|
@ -47,6 +47,29 @@
|
|||
(- (result-buffer-num-lines buffer) 1)
|
||||
processes))
|
||||
(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)
|
||||
|
||||
(case message
|
||||
|
@ -63,6 +86,10 @@
|
|||
(select-list-handle-key-press select-list key))
|
||||
self))
|
||||
|
||||
((get-selection) get-selection)
|
||||
|
||||
((get-focus-object) get-focus-object)
|
||||
|
||||
(else
|
||||
(error "pps-viewer unknown message" message))))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue