From 0fb9fcc61614495c502ec6e29aed03d355ecbe66 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sun, 28 Dec 2014 08:55:41 -0500 Subject: [PATCH] Better column tracking. --- rmacs/TODO | 2 +- rmacs/buffer.rkt | 34 ++++++++++++++++++++++++++------- rmacs/mode/fundamental.rkt | 8 +++++--- rmacs/render.rkt | 39 +++++--------------------------------- 4 files changed, 38 insertions(+), 45 deletions(-) diff --git a/rmacs/TODO b/rmacs/TODO index 2729a6e..3dd9639 100644 --- a/rmacs/TODO +++ b/rmacs/TODO @@ -2,7 +2,7 @@ Make it reloadable The status line isn't cleared away when you C-x 0. -Preserve column on up/down better. This includes dealing with tab expansion +Preserve column on up/down better. Need line wrap of some kind. diff --git a/rmacs/buffer.rkt b/rmacs/buffer.rkt index 33ea204..6f3a8d9 100644 --- a/rmacs/buffer.rkt +++ b/rmacs/buffer.rkt @@ -18,7 +18,9 @@ buffer-group buffer-editor buffer-modeset + buffer-string-column-count buffer-column + buffer-closest-pos-for-column buffer-apply-modeset! buffer-add-mode! buffer-remove-mode! @@ -200,10 +202,30 @@ (define g (buffer-group b)) (and g (buffergroup-editor g))) +(define (buffer-string-column-count buf start-column str) + (for/fold [(count 0)] [(ch str)] + (match ch + [#\tab (+ count (- 8 (modulo (+ start-column count) 8)))] + [#\newline (- start-column)] + [_ (+ count 1)]))) + (define (buffer-column buf pos-or-mtype) - ;; TODO: count actual columns! (define pos (->pos buf pos-or-mtype 'buffer-column)) - (- pos (buffer-start-of-line buf pos))) + (define str (rope->string (buffer-region buf (buffer-start-of-line buf pos) pos))) + (buffer-string-column-count buf 0 str)) + +(define (buffer-closest-pos-for-column buf sol-pos column-offset column) + (define g (rope-generator (subrope (buffer-rope buf) sol-pos))) + (let loop ((column-count column-offset) (pos sol-pos)) + (cond + [(< column-count column) + (match (g) + [#\tab (loop (+ column-count (- 8 (modulo column-count 8))) (+ pos 1))] + [#\newline pos] + [(? char?) (loop (+ column-count 1) (+ pos 1))] + [_ pos])] + [(= column-count column) pos] + [(< column-count column) (- pos 1)]))) (define (buffer-apply-modeset! buf modeset) (set-buffer-modeset! buf modeset)) @@ -221,11 +243,9 @@ (define (buffer-seek! buf pos) (buffer-lift rope-seek buf (clamp pos buf))) -(define (buffer-start-of-line buf pos-or-mtype) - (buffer-findf buf pos-or-mtype (lambda (ch) (equal? ch #\newline)) #:forward? #f)) - -(define (buffer-end-of-line buf pos-or-mtype) - (buffer-findf buf pos-or-mtype (lambda (ch) (equal? ch #\newline)) #:forward? #t)) +(define (newline? ch) (equal? ch #\newline)) +(define (buffer-start-of-line buf pm) (buffer-findf buf pm newline? #:forward? #f)) +(define (buffer-end-of-line buf pm) (buffer-findf buf pm newline? #:forward? #t)) (define (->pos buf pos-or-mtype what) (clamp (if (number? pos-or-mtype) diff --git a/rmacs/mode/fundamental.rkt b/rmacs/mode/fundamental.rkt index 9e4d454..965eda5 100644 --- a/rmacs/mode/fundamental.rkt +++ b/rmacs/mode/fundamental.rkt @@ -38,9 +38,11 @@ (define (move-to-column win col) (define buf (window-buffer win)) - (define eol-pos (buffer-end-of-line buf (window-point win))) - (define sol-pos (buffer-start-of-line buf (window-point win))) - (buffer-mark! buf (window-point win) (+ sol-pos (min col (- eol-pos sol-pos))))) + (buffer-mark! buf (window-point win) + (buffer-closest-pos-for-column buf + (buffer-start-of-line buf (window-point win)) + 0 + col))) (define-command fundamental-mode (forward-char buf #:window win #:prefix-arg [count 1]) #:bind-key "C-f" diff --git a/rmacs/render.rkt b/rmacs/render.rkt index d3bf0b5..8d59f4b 100644 --- a/rmacs/render.rkt +++ b/rmacs/render.rkt @@ -71,36 +71,6 @@ (define (tty-statusline-style t is-active?) (tty-set-pen! t (pen color-black color-white #f #f))) -(define (format-line line window-width cursor-input-pos) - (let loop ((chars (string->list line)) - (remaining-width window-width) - (cursor-input-pos cursor-input-pos) - (acc-rev '()) - (cursor-offset (if (zero? cursor-input-pos) 0 #f))) - (define (finish) (values (list->string (reverse acc-rev)) - (if (zero? cursor-input-pos) (length acc-rev) cursor-offset))) - (match chars - ['() (finish)] - [(cons c rest) - (define (emit str) - (define needed (string-length str)) - (if (>= remaining-width needed) - (loop rest - (- remaining-width needed) - (- cursor-input-pos 1) - (append (reverse (string->list str)) acc-rev) - (if (zero? cursor-input-pos) - (length acc-rev) - cursor-offset)) - (finish))) - (match c - [#\tab - (emit (make-string (- 8 (modulo (length acc-rev) 8)) #\space))] - [(? char-iso-control?) - (emit (format "[~x]" (char->integer c)))] - [_ - (emit (string c))])]))) - (define (render-window! t win window-top window-width window-height is-active?) (define buf (window-buffer win)) (define available-line-count (- window-height 1)) @@ -118,15 +88,16 @@ [else (define eol-pos (buffer-findf buf sol-pos newline?)) (define line (rope->string (buffer-region buf sol-pos eol-pos))) - (define-values (formatted-line cursor-offset) - (format-line line (tty-columns t) (- cursor-pos sol-pos))) + (define formatted-line (substring line 0 (min (string-length line) window-width))) (tty-display t formatted-line) (tty-clear-to-eol t) (tty-newline t) (loop (+ line-count 1) (+ eol-pos 1) - (if cursor-offset - (list (+ line-count window-top) cursor-offset) + (if (<= sol-pos cursor-pos eol-pos) + (list (+ line-count window-top) + (let ((line-to-cursor (substring line 0 (- cursor-pos sol-pos)))) + (buffer-string-column-count buf 0 line-to-cursor))) cursor-coordinates))]))) (tty-statusline-style t is-active?) (tty-display t "-- " (buffer-title buf) " ")