(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 (make-subset-window set-viewer method-name set current) (define header-line "Please select") (define header-length (string-length header-line)) (let* ((set-strings (map display-to-string set)) (lines 10) (inner-width (min (apply max header-length (map string-length set-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 (elem elem-str) (if (member elem current) (make-marked-text-element elem #t elem-str) (make-unmarked-text-element elem #t elem-str))) set set-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 ((new-set (select-list-get-marked select-list))) (send set-viewer method-name new-set) (delete-app-window! dialog) #t)) (else #f)))))) (define (make-help-window module . keys) (define header-line "Key bindings") (define header-length (string-length header-line)) (define help-strings (map (lambda (key) (string-append (symbol->string key) " -> " (make-string 1 (ascii->char (config module key))))) keys)) (let* ((lines 10) (inner-width (min (apply max header-length (map string-length help-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 (str) (make-unmarked-text-element str #f str)) help-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 (config 'main 'quit-help-key)) (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) (else #f))))))