Nicer filter window
part of darcs patch Thu Sep 22 21:34:27 EEST 2005 Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
		
							parent
							
								
									89766e74db
								
							
						
					
					
						commit
						8a1cd89844
					
				| 
						 | 
					@ -55,14 +55,23 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (make-filter-window list-viewer entries
 | 
					(define (make-filter-window list-viewer entries
 | 
				
			||||||
                            compare-val select-val)
 | 
					                            compare-val select-val)
 | 
				
			||||||
 | 
					  (define header-line "Filter by")
 | 
				
			||||||
 | 
					  (define header-length (string-length header-line))
 | 
				
			||||||
  (let* ((vals
 | 
					  (let* ((vals
 | 
				
			||||||
          (delete-duplicates
 | 
					          (delete-duplicates
 | 
				
			||||||
           (map select-val entries) compare-val))
 | 
					           (map select-val entries) compare-val))
 | 
				
			||||||
         (val-strings
 | 
					         (val-strings
 | 
				
			||||||
          (map display-to-string vals))
 | 
					          (map display-to-string vals))
 | 
				
			||||||
         (max-width
 | 
					         (lines 10)
 | 
				
			||||||
          (apply max (map string-length val-strings)))
 | 
					         (inner-width
 | 
				
			||||||
         (dialog (make-app-window 10 10 (+ 2 max-width) 10)))
 | 
					          (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)
 | 
					    (app-window-init-curses-win! dialog)
 | 
				
			||||||
    (let* ((dialog-win (app-window-curses-win dialog))
 | 
					    (let* ((dialog-win (app-window-curses-win dialog))
 | 
				
			||||||
           (select-list 
 | 
					           (select-list 
 | 
				
			||||||
| 
						 | 
					@ -71,13 +80,17 @@
 | 
				
			||||||
                    (make-unmarked-text-element 
 | 
					                    (make-unmarked-text-element 
 | 
				
			||||||
                     val #f str))
 | 
					                     val #f str))
 | 
				
			||||||
                  vals val-strings)
 | 
					                  vals val-strings)
 | 
				
			||||||
             7)))
 | 
					             (- lines 3))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
      (define (paint)
 | 
					      (define (paint)
 | 
				
			||||||
        (werase dialog-win)
 | 
					        (werase dialog-win)
 | 
				
			||||||
        (box dialog-win
 | 
					        (box dialog-win
 | 
				
			||||||
             (ascii->char 0) (ascii->char 0))
 | 
					             (ascii->char 0) (ascii->char 0))
 | 
				
			||||||
        (paint-selection-list-at select-list 1 1 dialog-win max-width #t)
 | 
					        (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))
 | 
					        (wrefresh dialog-win))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
      (paint)
 | 
					      (paint)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue