summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--par/piece-table.scm99
-rw-r--r--par/piece-table.sld1
-rw-r--r--tests/piece-table.scm9
3 files changed, 14 insertions, 95 deletions
diff --git a/par/piece-table.scm b/par/piece-table.scm
index 8e6fa82..5012a94 100644
--- a/par/piece-table.scm
+++ b/par/piece-table.scm
@@ -1,24 +1,16 @@
-;; Utils
-(define (character-newline? ch)
- (char=? ch #\newline))
-
-
-
;; Pieces themselves: the buffer is a reference to the buffer they take their
;; data from.
;; Start and end are numbers.
;; 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 linebreaks next prev)
+ (%make-piece buffer start length type next prev)
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!)
- (linebreaks piece-linebreaks set-piece-linebreaks!)
(next %piece-next %set-piece-next!)
(prev %piece-prev %set-piece-prev!))
@@ -48,24 +40,8 @@
(cond
((sentinel-piece? p) (%set-sentinel-piece-next! p next))
((piece? p) (%set-piece-next! p next))))
-;;
-(define (index-linebreaks buffer start length)
- (define str (buffer->string buffer))
- (define (string-foreach* str f from length)
- (let loop ((i 0))
- (unless (= 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 (can-merge-pieces? a b)
;; Maybe simplify the and/or/not magic?
@@ -80,26 +56,14 @@
(when (= 0 (piece-length a)) ;; First is empty, so we eat it
(set-piece-start! a (piece-start b)))
(set-piece-length! a (+ (piece-length a) (piece-length b)))
- (set-piece-linebreaks! a (vector-append (piece-linebreaks a)
- (piece-linebreaks b)))
(set-piece-next! a (piece-next b))
(unless (sentinel-piece? (piece-next b)) (set-piece-prev! (piece-next 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)))))
+
;; Piece API
(define (make-piece buffer start length type prev next)
- (%make-piece buffer start length type (index-linebreaks buffer start length)
- prev next))
+ (%make-piece buffer start length type prev next))
(define (connect-pieces! a b)
(begin
@@ -110,20 +74,17 @@
(if (and (= at 0) (sentinel-piece? a))
(values a a) ;; Just return the sentinel twice, as this is only used to
;; take one of them
- (let-values (((lb-a lb-b) (split-linebreaks (piece-linebreaks a) at)))
- (letrec* ((b (%make-piece (piece-buffer a)
- (+ at (piece-start a))
- (- (piece-length a) at)
- (piece-type a)
- lb-b
- (piece-next a)
- a)))
- (unless (sentinel-piece? (piece-next a))
- (set-piece-prev! (piece-next a) b))
- (set-piece-length! a at)
- (set-piece-linebreaks! a lb-a)
- (set-piece-next! a b)
- (values a b)))))
+ (letrec* ((b (%make-piece (piece-buffer a)
+ (+ at (piece-start a))
+ (- (piece-length a) at)
+ (piece-type a)
+ (piece-next a)
+ a)))
+ (unless (sentinel-piece? (piece-next a))
+ (set-piece-prev! (piece-next a) b))
+ (set-piece-length! a at)
+ (set-piece-next! a b)
+ (values a b))))
@@ -280,24 +241,6 @@
(connect-pieces! first fourth))))
;; Finding:
-;; NOTE: Line breaks are optimized.
-
-(define (piece-table-find-line-break piece-table idx)
- (let loop ((idx 0)
- (piece (piece-table-piece piece-table))
- (rem idx))
- (let* ((len (piece-length piece))
- (lines (piece-linebreaks piece))
- (lc (vector-length lines)))
- (cond
- ((< rem lc)
- (+ idx (vector-ref lines rem)))
- ;; TODO: No more pieces, return the end or eof?
- ((sentinel-piece? (piece-next piece))
- (eof-object))
- (else
- (loop (+ idx len) (piece-next piece) (- rem lc)))))))
-
(define (piece-table-find piece-table char from)
;; TODO: generalize the from
;; TODO: Implement the backwards one too
@@ -344,17 +287,3 @@
(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
- (let ((line (piece-table-find-line-break piece-table
- (- line-number 1))))
- (if (eof-object? line) line (+ 1 line)))))
- (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 18556d2..cdef979 100644
--- a/par/piece-table.sld
+++ b/par/piece-table.sld
@@ -11,7 +11,6 @@
piece-table-substring
string->piece-table
add-buffer-length
- piece-table-line
piece-table-for-each
piece-table-find)
(include "piece-table.scm"))
diff --git a/tests/piece-table.scm b/tests/piece-table.scm
index 62ff11d..c8d1280 100644
--- a/tests/piece-table.scm
+++ b/tests/piece-table.scm
@@ -38,15 +38,6 @@
(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"))
- ;; TODO: test line iteration functions
-(test-end "insert-newlines")
-
(test-begin "delete")
(define table (make-piece-table "HOLA SOY EKAITZ"))
(piece-table-delete! table 4 1)