scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add optional start cursor position argument to select list constructor 

Use configuration for select list key bindings
This commit is contained in:
mainzelm 2006-04-07 06:56:19 +00:00
parent b5d7756adf
commit ef642752af
2 changed files with 26 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
scheme/nuit-packages.scm
View File

@ -388,7 +388,9 @@
select-list-key?
make-get-selection-as-ref-method))
make-get-selection-as-ref-method
select-list-key-help))
(define-structure select-list select-list-interface
(open scheme
@ -396,12 +398,14 @@
(subset srfi-13 (string-join))
define-record-types
signals
let-opt
select-element
(subset focus-table (make-focus-object-reference))
layout
tty-debug
utils
configuration
ncurses)
(files select-list))

31
scheme/select-list.scm
View File

@ -12,31 +12,42 @@
(view-index ,(select-list-view-index r))
(num-lines ,(select-list-num-lines r)))))
(define (make-select-list elements num-lines)
(really-make-select-list elements 0 0 num-lines))
(define (make-select-list elements num-lines . optional-args)
(let-optionals optional-args
((cursor-start 0))
(really-make-select-list elements 0 cursor-start num-lines)))
(define key-m 109)
(define-option 'select-list 'select-list-mark-key (char->ascii #\m))
(define-option 'select-list 'select-list-unmark-key (char->ascii #\u))
(define-option 'select-list 'select-list-move-up-key key-up)
(define-option 'select-list 'select-list-move-down-key key-down)
(define key-u 117)
(define select-list-key-help
'(select-list (select-list-mark-key
select-list-unmark-key
select-list-move-up-key
select-list-move-down-key)))
(define (select-list-handle-key-press select-list key)
(cond
((= key key-m)
((= key (config 'select-list 'select-list-mark-key))
(mark-current-line select-list))
((= key key-u)
((= key (config 'select-list 'select-list-unmark-key))
(unmark-current-line select-list))
((= key key-up)
((= key (config 'select-list 'select-list-move-up-key))
(move-cursor-up select-list))
((= key key-down)
((= key (config 'select-list 'select-list-move-down-key))
(move-cursor-down select-list))
(else
select-list)))
(define (select-list-navigation-key? key)
(or (= key key-up) (= key key-down)))
(or (= key (config 'select-list 'select-list-move-up-key))
(= key (config 'select-list 'select-list-move-down-key))))
(define (select-list-marking-key? key)
(or (= key key-m) (= key key-u)))
(or (= key (config 'select-list 'select-list-mark-key))
(= key (config 'select-list 'select-list-unmark-key))))
(define (select-list-key? key)
(or (select-list-navigation-key? key)