par: piece-table: add linebreak information to pieces

1 files changed, 50 insertions, 11 deletions

diff --git a/par/piece-table.scm b/par/piece-table.scm
index 6b3985b..a9c9ef7 100644
--- a/par/piece-table.scm
+++ b/par/piece-table.scm
@@ -24,13 +24,36 @@
 ;; The type defines how they should be rendered, it makes
 ;; possible to account for hyperlinks or stuff like that in the future with
 ;; ease.
+;; Linebreaks is a vector of linebreaks (easy to count length)
 (define-record-type <piece>
-  (make-piece buffer start length type)
+  (%make-piece buffer start length type linebreaks)
   piece?
   (buffer piece-buffer set-piece-buffer!)
   (start piece-start set-piece-start!)
   (length piece-length set-piece-length!)
-  (type piece-type set-piece-type!))
+  (type piece-type set-piece-type!)
+  (linebreaks piece-linebreaks set-piece-linebreaks!))
+
+(define (index-linebreaks buffer start length)
+  (define (character-newline? ch)
+    (char=? ch #\newline))
+  (define str (buffer->string buffer))
+  (define (string-foreach* str f from length)
+    (let loop ((i 0))
+      (when (not (= i length))
+        (f i (string-ref str (+ start i)))
+        (loop (+ i 1)))))
+  (define outlist (list))
+
+  (string-foreach* (buffer->string buffer)
+                   (lambda (i ch)
+                     (when (character-newline? ch)
+                       (set! outlist (cons i outlist))))
+                   start length)
+  (list->vector (reverse outlist)))
+
+(define (make-piece buffer start length type)
+  (%make-piece buffer start length type (index-linebreaks buffer start length)))
 
 (define (can-merge-pieces? a b)
   (and (eq? (piece-buffer a) (piece-buffer b))
@@ -39,18 +62,34 @@
 
 (define (merge-pieces! a b)
   (set-piece-length! a (+ (piece-length a) (piece-length b)))
+  (set-piece-linebreaks! a (vector-append (piece-linebreaks a)
+                                          (piece-linebreaks b)))
   a)
 
+(define (split-linebreaks linebreaks at)
+  (let* ((lb-l   (vector-length linebreaks))
+         (lb-at  (let loop ((i 0))
+                   (if (and (< i lb-l) (< at (vector-ref linebreaks i)))
+                     (loop (+ i 1))
+                     i))))
+    (values
+      (vector-copy linebreaks 0 lb-at)
+      (vector-map (lambda (x) (- x at))
+                  (vector-copy linebreaks lb-at lb-l)))))
+
 (define (split-piece! a at)
-  (values
-    (make-piece (piece-buffer a)
-                (piece-start a)
-                at
-                (piece-type a))
-    (make-piece (piece-buffer a)
-                (+ at (piece-start a))
-                (- (piece-length a) at)
-                (piece-type a))))
+  (let-values (((lb-a lb-b) (split-linebreaks (piece-linebreaks a) at)))
+    (values
+      (%make-piece (piece-buffer a)
+                   (piece-start a)
+                   at
+                   (piece-type a)
+                   lb-a)
+      (%make-piece (piece-buffer a)
+                   (+ at (piece-start a))
+                   (- (piece-length a) at)
+                   (piece-type a)
+                   lb-b))))