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)
(buffer-can-write buffer))
(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
(- (length (buffer-text buffer)) 1)))
(hist (list-ref (buffer-text buffer)
@ -306,7 +307,7 @@
;;Cursor
;;Put Cursor to the right position
(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-x (buffer-pos-x buffer))
(num-lines (buffer-num-lines buffer))
@ -315,35 +316,38 @@
;; y position
(let* ((item-length (string-length (buffer-text-current-line buffer)))
(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)
first-line-offset)
1)))
(debug-message "num-cols "
num-cols
" no-wrapped-lines "
no-wrapped-lines
" first-line-offset "
first-line-offset
" new-y " new-y
" length "
item-length
" pos-fin-ln "
pos-fin-ln
" pos-col "
pos-col)
(set-buffer-pos-y! buffer new-y))
; (debug-message "num-cols "
; num-cols
; " no-wrapped-lines "
; no-wrapped-lines
; " first-line-offset "
; first-line-offset
; " new-y " new-y
; " length "
; item-length
; " pos-fin-ln "
; pos-fin-ln
; " pos-col "
; pos-col)
(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
(let ((posx (modulo pos-col num-cols)))
(if (<= posx 1)
(set-buffer-pos-x! buffer (+ num-cols posx))
(if (and (= posx 2)
(> pos-col num-cols))
(set-buffer-pos-x! buffer (+ num-cols 1))
(set-buffer-pos-x! buffer posx))))
;; x position
(set-buffer-pos-x! buffer (+ first-column
(modulo text-index num-cols)))
; (debug-message "num-cols " num-cols
; " pos-col " pos-col
; " text '" (buffer-text-current-line buffer) "'")
(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)
(set-buffer-pos-col! buffer