;(define-record-type element ; (make-element markable? marked? value text) ; element? ; (markable? element-markable?) ; (marked? element-marked?) ; (value element-value) ; (text element-text)) ;(define-record-discloser :element ; (lambda (r) ; `(element ,(element-marked? r) ,(element-text r)))) ;(define (make-unmarked-element value markable? text) ; (make-element markable? #f value text)) ;(define (make-marked-element value markable? text) ; (make-element markable? #t value text)) (define (element-value x) x) (define (element-text x) x) (define-record-type select-line :select-line (really-make-select-line elements cursor-index num-cols) select-line? (elements select-line-elements) (cursor-index select-line-cursor-index set-select-line-cursor-index!) (num-cols select-line-num-cols)) (define (make-select-line elements) (really-make-select-line elements 0 (length elements))) (define (select-line-handle-key-press! select-line key) (cond ((= key key-right) (move-cursor-right! select-line)) ((= key key-left) (move-cursor-left! select-line)) (else #f))) (define (move-cursor-left! select-line) (let ((old-col (select-line-cursor-index select-line))) (if (and (> old-col 0) (> (select-line-num-cols select-line) 1)) (set-select-line-cursor-index! select-line (- old-col 1))))) (define (move-cursor-right! select-line) (let ((old-col (select-line-cursor-index select-line))) (if (< old-col (- (select-line-num-cols select-line) 1)) (set-select-line-cursor-index! select-line (+ old-col 1))))) (define (paint-select-line select-line win result-buffer have-focus?) (paint-select-line-at select-line 0 0 win result-buffer have-focus?)) (define (paint-select-line-at select-line x y win result-buffer have-focus?) (let ((cursor-col (select-line-cursor-index select-line))) (let lp ((elts (select-line-elements select-line)) (i 0) (x x)) (cond ((null? elts) (values)) ((= i cursor-col) (let ((text (element-text (car elts)))) (wattron win (A-REVERSE)) (mvwaddstr win y x text) (wattrset win (A-NORMAL)) (lp (cdr elts) (+ i 1) (+ x (string-length text))))) (else (let ((text (element-text (car elts)))) (mvwaddstr win y x text) (lp (cdr elts) (+ i 1) (+ x (string-length text))))))))) (define (select-line-selected-entry select-line) (element-value (list-ref (select-line-elements select-line) (select-line-cursor-index select-line))))