commander-s/scheme/filter-window.scm

(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))))))