From 73e28d46fd5aeb71677eec8e785029b26f6385ef Mon Sep 17 00:00:00 2001 From: Ekaitz Zarraga Date: Thu, 18 Jan 2024 22:25:34 +0100 Subject: par: piece-table: add line accessor function --- par/piece-table.scm | 35 +++++++++++++++++++++++++++++++---- par/piece-table.sld | 3 ++- tests/piece-table.scm | 8 ++++++++ 3 files changed, 41 insertions(+), 5 deletions(-) diff --git a/par/piece-table.scm b/par/piece-table.scm index 0191a1c..24608e3 100644 --- a/par/piece-table.scm +++ b/par/piece-table.scm @@ -185,16 +185,30 @@ (define (piece-table-text-length piece-table) (reduce + 0 (map piece-length (piece-table-pieces piece-table)))) +(define (piece-table-find-line-break piece-table idx) + (let loop ((idx 0) + (ps (piece-table-pieces piece-table)) + (rem idx)) + (let* ((current (car ps)) + (len (piece-length current)) + (lines (piece-linebreaks current)) + (lc (vector-length lines))) + (cond + ((< rem lc) (+ idx (vector-ref lines rem))) + ((null? (cdr ps)) (eof-object)) ;; TODO: No more pieces, return the end or eof? + (else (loop (+ idx len) (cdr ps) (- rem lc))))))) + (define (piece-table-text-pos->piece-idx+remainder piece-table pos) - "Returns (values piece remainder)" + "Returns (values piece remainder) or eof-object" (let loop ((idx 0) (ps (piece-table-pieces piece-table)) (rem pos)) (let* ((current (car ps)) (len (piece-length current))) - (if (<= rem len) - (values idx rem) - (loop (+ idx 1) (cdr ps) (- rem len)))))) + (cond + ((<= rem len) (values idx rem)) + ((null? (cdr ps)) (eof-object)) ;; TODO: No more pieces, return the end or eof? + (else (loop (+ idx 1) (cdr ps) (- rem len))))))) (define (list-ref-with-context l i) (let ((len (length l))) @@ -282,3 +296,16 @@ (define (piece-table->string piece-table) (piece-table-substring piece-table 0 (piece-table-text-length piece-table))) + +;; Interact with lines: interesting for the UI +(define (piece-table-line piece-table line-number) + (let ((start (if (= line-number 0) 0 + (+ 1 (piece-table-find-line-break piece-table + (- line-number 1))))) + (end (piece-table-find-line-break piece-table line-number))) + (cond + ((eof-object? start) start) + ((eof-object? end) (piece-table-substring + piece-table start + (piece-table-text-length piece-table))) + (else (piece-table-substring piece-table start end))))) diff --git a/par/piece-table.sld b/par/piece-table.sld index 4650cb7..f867612 100644 --- a/par/piece-table.sld +++ b/par/piece-table.sld @@ -9,5 +9,6 @@ piece-table->string piece-table-substring string->piece-table - add-buffer-length) + add-buffer-length + piece-table-line) (include "piece-table.scm")) diff --git a/tests/piece-table.scm b/tests/piece-table.scm index 317286c..19bd107 100644 --- a/tests/piece-table.scm +++ b/tests/piece-table.scm @@ -30,6 +30,14 @@ (test-equal "6X78" (piece-table-substring table 5 9))) (test-end "substring") +(test-begin "insert-newlines") + (parameterize ((add-buffer-length 10)) + (define table (make-piece-table "HOLA\nADIOS")) + (piece-table-insert! table 4 "\nHABLAMOS" 'normal) + (test-equal "HOLA\nHABLAMOS\nADIOS" (piece-table->string table)) + (test-equal (piece-table-line table 1) "HABLAMOS")) +(test-end "insert-newlines") + (test-begin "delete") (define table (make-piece-table "HOLA SOY EKAITZ")) (piece-table-delete! table 4 1) -- cgit v1.2.3