Better column tracking.

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.
 

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)
+(define (newline? ch) (equal? ch #\newline))
-  (buffer-findf buf pos-or-mtype (lambda (ch) (equal? ch #\newline)) #:forward? #f))
+(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 (buffer-end-of-line buf pos-or-mtype)
-  (buffer-findf buf pos-or-mtype (lambda (ch) (equal? ch #\newline)) #:forward? #t))
 
 (define (->pos buf pos-or-mtype what)
   (clamp (if (number? pos-or-mtype)

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)))
+  (buffer-mark! buf (window-point win)
-  (define sol-pos (buffer-start-of-line buf (window-point win)))
+                (buffer-closest-pos-for-column buf
-  (buffer-mark! buf (window-point win) (+ sol-pos (min col (- eol-pos sol-pos)))))
+                                               (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"

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)
+        (define formatted-line (substring line 0 (min (string-length line) window-width)))
-          (format-line line (tty-columns t) (- cursor-pos sol-pos)))
         (tty-display t formatted-line)
         (tty-clear-to-eol t)
         (tty-newline t)
         (loop (+ line-count 1)
               (+ eol-pos 1)
-              (if cursor-offset
+              (if (<= sol-pos cursor-pos eol-pos)
-                  (list (+ line-count window-top) cursor-offset)
+                  (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) " ")