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:
eknauel 2005-09-27 16:30:40 +00:00
parent 21d45c8b56
commit 83ec071269
2 changed files with 26 additions and 40 deletions

View File

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

View File

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