From 2b0b469c1d24ef29da20fb1fcbf1bb8e3d52e6e8 Mon Sep 17 00:00:00 2001 From: mainzelm Date: Tue, 11 Oct 2005 15:54:13 +0000 Subject: [PATCH] Factor out filter-windows part of darcs patch Sat Sep 24 23:11:09 MST 2005 Martin Gasbichler --- scheme/filter-window.scm | 62 ++++++++++++++++++++++++++++++++++++++++ scheme/nuit-packages.scm | 22 ++++++++++++++ scheme/process.scm | 62 ---------------------------------------- 3 files changed, 84 insertions(+), 62 deletions(-) create mode 100644 scheme/filter-window.scm diff --git a/scheme/filter-window.scm b/scheme/filter-window.scm new file mode 100644 index 0000000..72d2326 --- /dev/null +++ b/scheme/filter-window.scm @@ -0,0 +1,62 @@ +(define (make-filter-window list-viewer entries + compare-val select-val) + (define header-line "Filter by") + (define header-length (string-length header-line)) + (let* ((vals + (delete-duplicates + (map select-val entries) compare-val)) + (val-strings + (map display-to-string vals)) + (lines 10) + (inner-width + (min (apply max header-length + (map string-length val-strings)) + (COLS))) + (dialog (make-app-window (- (quotient (COLS) 2) + (quotient inner-width 2)) + 5 + (+ 4 inner-width) + lines))) + (app-window-init-curses-win! dialog) + (let* ((dialog-win (app-window-curses-win dialog)) + (select-list + (make-select-list + (map (lambda (val str) + (make-unmarked-text-element + val #f str)) + vals val-strings) + (- lines 3)))) + + (define (paint) + (werase dialog-win) + (box dialog-win + (ascii->char 0) (ascii->char 0)) + (mvwaddstr dialog-win + 0 + (+ 1 (quotient (- inner-width header-length) 2)) + header-line) + (paint-selection-list-at select-list 2 1 dialog-win inner-width #t) + (wrefresh dialog-win)) + + (paint) + (lambda (key) + (cond ((= key 27) + (delete-app-window! dialog) + (close-modal-window!) + #t) + ((select-list-key? key) + (set! select-list + (select-list-handle-key-press select-list key)) + (paint) + #f) + ((= key 10) + (let* ((val (select-list-selected-entry select-list)) + (new-entries + (filter (lambda (entry) + (compare-val (select-val entry) + val)) entries))) + (send list-viewer 'set-entries! new-entries)) + (delete-app-window! dialog) + #t) + (else #f)))))) + diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index bfbb206..9b9104c 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -162,6 +162,7 @@ srfi-8 srfi-26 + filter-window modal-window app-windows objects @@ -413,6 +414,26 @@ ncurses) (files select-element)) +;;; (modal) filter window + +(define-interface filter-window-interface + (export + make-filter-window)) + +(define-structure filter-window filter-window-interface + (open scheme + (subset srfi-1 (delete-duplicates filter)) + ascii + + utils + app-windows + modal-window + objects + select-list + select-element + (modify ncurses (hide filter))) + (files filter-window)) + ;;; joblist viewer (define-structure joblist-viewer @@ -423,6 +444,7 @@ (subset srfi-13 (string-join)) signals + configuration objects console jobs diff --git a/scheme/process.scm b/scheme/process.scm index 8741599..b2f6abf 100644 --- a/scheme/process.scm +++ b/scheme/process.scm @@ -53,68 +53,6 @@ processes) num-lines))) -(define (make-filter-window list-viewer entries - compare-val select-val) - (define header-line "Filter by") - (define header-length (string-length header-line)) - (let* ((vals - (delete-duplicates - (map select-val entries) compare-val)) - (val-strings - (map display-to-string vals)) - (lines 10) - (inner-width - (min (apply max header-length - (map string-length val-strings)) - (COLS))) - (dialog (make-app-window (- (quotient (COLS) 2) - (quotient inner-width 2)) - 5 - (+ 4 inner-width) - lines))) - (app-window-init-curses-win! dialog) - (let* ((dialog-win (app-window-curses-win dialog)) - (select-list - (make-select-list - (map (lambda (val str) - (make-unmarked-text-element - val #f str)) - vals val-strings) - (- lines 3)))) - - (define (paint) - (werase dialog-win) - (box dialog-win - (ascii->char 0) (ascii->char 0)) - (mvwaddstr dialog-win - 0 - (+ 1 (quotient (- inner-width header-length) 2)) - header-line) - (paint-selection-list-at select-list 2 1 dialog-win inner-width #t) - (wrefresh dialog-win)) - - (paint) - (lambda (key) - (cond ((= key 27) - (delete-app-window! dialog) - (close-modal-window!) - #t) - ((select-list-key? key) - (set! select-list - (select-list-handle-key-press select-list key)) - (paint) - #f) - ((= key 10) - (let* ((val (select-list-selected-entry select-list)) - (new-entries - (filter (lambda (entry) - (compare-val (select-val entry) - val)) entries))) - (send list-viewer 'set-entries! new-entries)) - (delete-app-window! dialog) - #t) - (else #f)))))) - (define-option 'ps 'kill-key (char->ascii #\k)) (define-option 'ps 'refresh-key (char->ascii #\g)) (define-option 'ps 'sort-up-key (char->ascii #\s))