Make the process-viewer react on get-focus-object and get-selection messages

This commit is contained in:
eknauel 2005-06-01 11:49:56 +00:00
parent 7a87280516
commit d34769b0e1
3 changed files with 30 additions and 5 deletions

View File

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

View File

@ -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

View File

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