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

More fixes for the cursor positioning code, fix history

This commit is contained in:
eknauel 2005-05-19 15:16:33 +00:00
parent 0fc804b345
commit 2f57202cfe
1 changed files with 30 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
scheme/input-buffer.scm
View File

@ -179,7 +179,8 @@
((and (= ch key-up) ((and (= ch key-up)
(buffer-can-write buffer)) (buffer-can-write buffer))
(if (> (buffer-history-pos buffer) 0) (if (> (buffer-history-pos buffer) 0)
(set-buffer-history-pos! (- (buffer-history-pos 1)))) (set-buffer-history-pos! buffer
(- (buffer-history-pos buffer) 1)))
(let ((rest (sublist (buffer-text buffer) 0 (let ((rest (sublist (buffer-text buffer) 0
(- (length (buffer-text buffer)) 1))) (- (length (buffer-text buffer)) 1)))
(hist (list-ref (buffer-text buffer) (hist (list-ref (buffer-text buffer)
@ -306,7 +307,7 @@
;;Cursor ;;Cursor
;;Put Cursor to the right position ;;Put Cursor to the right position
(define (cursor-right-pos win buffer) (define (cursor-right-pos win buffer)
(let ((pos-col (buffer-pos-col buffer)) (let ((text-index (- (buffer-pos-col buffer) first-column))
(pos-fin-ln (buffer-pos-fin-ln buffer)) (pos-fin-ln (buffer-pos-fin-ln buffer))
(pos-x (buffer-pos-x buffer)) (pos-x (buffer-pos-x buffer))
(num-lines (buffer-num-lines buffer)) (num-lines (buffer-num-lines buffer))
@ -315,35 +316,38 @@
;; y position ;; y position
(let* ((item-length (string-length (buffer-text-current-line buffer))) (let* ((item-length (string-length (buffer-text-current-line buffer)))
(no-wrapped-lines (quotient item-length num-cols)) (no-wrapped-lines (quotient item-length num-cols))
(first-line-offset (quotient (- pos-col first-column) num-cols)) (first-line-offset (quotient text-index num-cols))
(new-y (- (+ (- pos-fin-ln no-wrapped-lines) (new-y (- (+ (- pos-fin-ln no-wrapped-lines)
first-line-offset) first-line-offset)
1))) 1)))
(debug-message "num-cols " ; (debug-message "num-cols "
num-cols ; num-cols
" no-wrapped-lines " ; " no-wrapped-lines "
no-wrapped-lines ; no-wrapped-lines
" first-line-offset " ; " first-line-offset "
first-line-offset ; first-line-offset
" new-y " new-y ; " new-y " new-y
" length " ; " length "
item-length ; item-length
" pos-fin-ln " ; " pos-fin-ln "
pos-fin-ln ; pos-fin-ln
" pos-col " ; " pos-col "
pos-col) ; pos-col)
(set-buffer-pos-y! buffer new-y)) (if (and (not (zero? text-index))
(zero? (remainder text-index num-cols))
(= text-index item-length))
(set-buffer-pos-y! buffer (+ new-y 1))
(set-buffer-pos-y! buffer new-y))
;; x position ;; x position
(let ((posx (modulo pos-col num-cols))) (set-buffer-pos-x! buffer (+ first-column
(if (<= posx 1) (modulo text-index num-cols)))
(set-buffer-pos-x! buffer (+ num-cols posx))
(if (and (= posx 2) ; (debug-message "num-cols " num-cols
(> pos-col num-cols)) ; " pos-col " pos-col
(set-buffer-pos-x! buffer (+ num-cols 1)) ; " text '" (buffer-text-current-line buffer) "'")
(set-buffer-pos-x! buffer posx))))
(wmove win (buffer-pos-y buffer) (buffer-pos-x buffer)))) (wmove win (buffer-pos-y buffer) (buffer-pos-x buffer)))))
(define (advance-buffer-cursor-column! buffer) (define (advance-buffer-cursor-column! buffer)
(set-buffer-pos-col! buffer (set-buffer-pos-col! buffer