diff options
| -rw-r--r-- | par/piece-table.scm | 99 | ||||
| -rw-r--r-- | par/piece-table.sld | 1 | ||||
| -rw-r--r-- | tests/piece-table.scm | 9 |
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) |