63 lines
2.2 KiB
Scheme
63 lines
2.2 KiB
Scheme
|
(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))))))
|
||
|
|
|