178 lines
6.1 KiB
Scheme
178 lines
6.1 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))))))
|
|
|
|
(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))))))
|
|
|