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