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

View File

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

View File

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