commander-s/scheme/select-line.scm

;(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 width)
  select-line?
  (elements select-line-elements)
  (cursor-index select-line-cursor-index set-select-line-cursor-index!)
  (num-cols select-line-num-cols)
  (width select-line-width))

(define (make-select-line elements width)
  (really-make-select-line elements 0 (length elements) width))

(define (select-line-key? key)
  (or (= key key-right)
      (= key key-left)))

(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)
  (paint-select-line-at select-line 0 0 win))

(define (paint-select-line-at select-line x y win)
  (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 (cut-to-size (- (select-line-width select-line)
                                         x)
                                      (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 (cut-to-size (- (select-line-width select-line)
                                         x)
                                      (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))))