87 lines
2.9 KiB
Scheme
87 lines
2.9 KiB
Scheme
;(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))))
|
|
|
|
|