Factor out select-elements
part of darcs patch Sun Sep 18 20:32:09 EEST 2005 Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
		
							parent
							
								
									21d45c8b56
								
							
						
					
					
						commit
						83ec071269
					
				|  | @ -162,6 +162,7 @@ | ||||||
|         utils |         utils | ||||||
| 	select-list | 	select-list | ||||||
|         select-line |         select-line | ||||||
|  |         select-element | ||||||
| 	tty-debug) | 	tty-debug) | ||||||
|   (files process)) |   (files process)) | ||||||
| 
 | 
 | ||||||
|  | @ -181,6 +182,7 @@ | ||||||
|         utils |         utils | ||||||
|         layout |         layout | ||||||
|         select-list |         select-list | ||||||
|  |         select-element | ||||||
|         (subset focus-table (make-focus-object-reference)) |         (subset focus-table (make-focus-object-reference)) | ||||||
|         tty-debug) |         tty-debug) | ||||||
|   (files user-group-info)) |   (files user-group-info)) | ||||||
|  | @ -197,6 +199,7 @@ | ||||||
| 
 | 
 | ||||||
|         ncurses |         ncurses | ||||||
|         select-list |         select-list | ||||||
|  |         select-element | ||||||
| 	completion-sets | 	completion-sets | ||||||
| 	run-jobs | 	run-jobs | ||||||
|         plugin |         plugin | ||||||
|  | @ -221,6 +224,7 @@ | ||||||
|         utils |         utils | ||||||
| 	fs-object | 	fs-object | ||||||
| 	select-list | 	select-list | ||||||
|  |         select-element | ||||||
| 	plugin | 	plugin | ||||||
| 	ncurses | 	ncurses | ||||||
| 	tty-debug) | 	tty-debug) | ||||||
|  | @ -321,12 +325,6 @@ | ||||||
|   (export make-select-list |   (export make-select-list | ||||||
| 	  select-list? | 	  select-list? | ||||||
| 	   | 	   | ||||||
|           make-unmarked-element |  | ||||||
|           make-marked-element |  | ||||||
| 	  make-unmarked-text-element |  | ||||||
| 	  make-marked-text-element |  | ||||||
| 	  element? |  | ||||||
| 
 |  | ||||||
| 	  select-list-handle-key-press | 	  select-list-handle-key-press | ||||||
| 	  unmark-current-line | 	  unmark-current-line | ||||||
| 	  mark-current-line | 	  mark-current-line | ||||||
|  | @ -349,6 +347,7 @@ | ||||||
| 	define-record-types | 	define-record-types | ||||||
| 	signals | 	signals | ||||||
| 
 | 
 | ||||||
|  |         select-element | ||||||
| 	(subset focus-table (make-focus-object-reference)) | 	(subset focus-table (make-focus-object-reference)) | ||||||
| 	tty-debug | 	tty-debug | ||||||
|         utils |         utils | ||||||
|  | @ -368,11 +367,29 @@ | ||||||
| 	define-record-types | 	define-record-types | ||||||
| 	signals | 	signals | ||||||
|          |          | ||||||
|  |         select-element | ||||||
|         layout |         layout | ||||||
| 	tty-debug | 	tty-debug | ||||||
| 	ncurses) | 	ncurses) | ||||||
|   (files select-line)) |   (files select-line)) | ||||||
| 
 | 
 | ||||||
|  | (define-interface select-element-interface | ||||||
|  |   (export | ||||||
|  |    make-element | ||||||
|  |    make-unmarked-element | ||||||
|  |    make-marked-element | ||||||
|  |    make-unmarked-text-element | ||||||
|  |    make-marked-text-element | ||||||
|  |    element? element-markable? element-marked? | ||||||
|  |    element-value element-painter)) | ||||||
|  | 
 | ||||||
|  | (define-structure select-element select-element-interface | ||||||
|  |   (open scheme | ||||||
|  |         define-record-types | ||||||
|  |          | ||||||
|  |         ncurses) | ||||||
|  |   (files select-element)) | ||||||
|  | 
 | ||||||
| ;;; joblist viewer | ;;; joblist viewer | ||||||
| 
 | 
 | ||||||
| (define-structure joblist-viewer | (define-structure joblist-viewer | ||||||
|  | @ -389,6 +406,7 @@ | ||||||
| 	ncurses | 	ncurses | ||||||
| 	focus-table | 	focus-table | ||||||
| 	select-list | 	select-list | ||||||
|  |         select-element | ||||||
| 	tty-debug | 	tty-debug | ||||||
| 	plugin | 	plugin | ||||||
| 	layout) | 	layout) | ||||||
|  | @ -418,6 +436,7 @@ | ||||||
|         layout |         layout | ||||||
|         utils |         utils | ||||||
|         select-list |         select-list | ||||||
|  |         select-element | ||||||
|         tty-debug |         tty-debug | ||||||
|         plugin) |         plugin) | ||||||
|   (files inspector)) |   (files inspector)) | ||||||
|  | @ -890,6 +909,7 @@ | ||||||
| 	completion-sets | 	completion-sets | ||||||
| 	completer | 	completer | ||||||
| 	select-list | 	select-list | ||||||
|  |         select-element | ||||||
| 	jobs | 	jobs | ||||||
| 	run-jobs | 	run-jobs | ||||||
| 	run-jobs-internals | 	run-jobs-internals | ||||||
|  |  | ||||||
|  | @ -1,27 +1,3 @@ | ||||||
| (define-record-type element :element |  | ||||||
|   (make-element markable? marked? value painter) |  | ||||||
|   element? |  | ||||||
|   (markable? element-markable?) |  | ||||||
|   (marked? element-marked?) |  | ||||||
|   (value element-value) |  | ||||||
|   (painter element-painter)) |  | ||||||
| 
 |  | ||||||
| (define-record-discloser :element |  | ||||||
|   (lambda (r) |  | ||||||
|     `(element ,(element-marked? r) ,(element-value r)))) |  | ||||||
| 
 |  | ||||||
| (define (make-unmarked-element value markable? painter) |  | ||||||
|   (make-element markable? #f value painter)) |  | ||||||
| 
 |  | ||||||
| (define (make-marked-element value markable? painter) |  | ||||||
|   (make-element markable? #t value painter)) |  | ||||||
| 
 |  | ||||||
| (define (make-unmarked-text-element value markable? text) |  | ||||||
|   (make-unmarked-element value markable? (make-text-painter text))) |  | ||||||
| 
 |  | ||||||
| (define (make-marked-text-element value markable? text) |  | ||||||
|   (make-marked-element value markable? (make-text-painter text))) |  | ||||||
| 
 |  | ||||||
| (define-record-type select-list :select-list | (define-record-type select-list :select-list | ||||||
|   (really-make-select-list elements view-index cursor-index num-lines) |   (really-make-select-list elements view-index cursor-index num-lines) | ||||||
|   select-list? |   select-list? | ||||||
|  | @ -149,16 +125,6 @@ | ||||||
| 		  (select-list-view-index select-list)) | 		  (select-list-view-index select-list)) | ||||||
| 	    (+ 1 num-lines))) | 	    (+ 1 num-lines))) | ||||||
| 
 | 
 | ||||||
| (define (make-text-painter text) |  | ||||||
|   (lambda (win x y at-cursor? marked?) |  | ||||||
|     (if at-cursor? |  | ||||||
|         (wattron win (A-REVERSE))) |  | ||||||
|     (if marked? |  | ||||||
| 	(wattron win (A-BOLD))) |  | ||||||
|     (mvwaddstr win y x text) |  | ||||||
|     (if (or at-cursor? marked?) |  | ||||||
|         (wattrset win (A-NORMAL))))) |  | ||||||
| 
 |  | ||||||
| (define (paint-selection-list select-list win result-buffer have-focus?) | (define (paint-selection-list select-list win result-buffer have-focus?) | ||||||
|   (paint-selection-list-at select-list 0 0  win result-buffer have-focus?)) |   (paint-selection-list-at select-list 0 0  win result-buffer have-focus?)) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
		Loading…
	
		Reference in New Issue
	
	 eknauel
						eknauel