scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Factor out filter-windows 

part of darcs patch Sat Sep 24 23:11:09 MST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
mainzelm 2005-10-11 15:54:13 +00:00
parent 5dac007070
commit 2b0b469c1d
3 changed files with 84 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
scheme/filter-window.scm Normal file
View File

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

22
scheme/nuit-packages.scm
View File

@ -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

62
scheme/process.scm
View File

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