Factor out filter-windows

part of darcs patch Sat Sep 24 23:11:09 MST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>

scheme/filter-window.scm

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

scheme/nuit-packages.scm

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

scheme/process.scm

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