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? 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 (define-structure select-list select-list-interface
(open scheme (open scheme
@ -396,12 +398,14 @@
(subset srfi-13 (string-join)) (subset srfi-13 (string-join))
define-record-types define-record-types
signals signals
let-opt
select-element select-element
(subset focus-table (make-focus-object-reference)) (subset focus-table (make-focus-object-reference))
layout layout
tty-debug tty-debug
utils utils
configuration
ncurses) ncurses)
(files select-list)) (files select-list))

31
scheme/select-list.scm
View File

@ -12,31 +12,42 @@
(view-index ,(select-list-view-index r)) (view-index ,(select-list-view-index r))
(num-lines ,(select-list-num-lines r))))) (num-lines ,(select-list-num-lines r)))))
(define (make-select-list elements num-lines) (define (make-select-list elements num-lines . optional-args)
(really-make-select-list elements 0 0 num-lines)) (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) (define (select-list-handle-key-press select-list key)
(cond (cond
((= key key-m) ((= key (config 'select-list 'select-list-mark-key))
(mark-current-line select-list)) (mark-current-line select-list))
((= key key-u) ((= key (config 'select-list 'select-list-unmark-key))
(unmark-current-line select-list)) (unmark-current-line select-list))
((= key key-up) ((= key (config 'select-list 'select-list-move-up-key))
(move-cursor-up select-list)) (move-cursor-up select-list))
((= key key-down) ((= key (config 'select-list 'select-list-move-down-key))
(move-cursor-down select-list)) (move-cursor-down select-list))
(else (else
select-list))) select-list)))
(define (select-list-navigation-key? key) (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) (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) (define (select-list-key? key)
(or (select-list-navigation-key? key) (or (select-list-navigation-key? key)