diff --git a/scheme/browse-directory-list.scm b/scheme/browse-directory-list.scm index 156648b..6f4c34d 100644 --- a/scheme/browse-directory-list.scm +++ b/scheme/browse-directory-list.scm @@ -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) diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index 3d5513c..d305095 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -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 diff --git a/scheme/process.scm b/scheme/process.scm index a86c1bf..c70a22e 100644 --- a/scheme/process.scm +++ b/scheme/process.scm @@ -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 @@ -62,6 +85,10 @@ (set! select-list (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))))))