diff options
| -rw-r--r-- | par/piece-table.scm | 68 |
1 files changed, 30 insertions, 38 deletions
diff --git a/par/piece-table.scm b/par/piece-table.scm index 7a1cae7..aa4993b 100644 --- a/par/piece-table.scm +++ b/par/piece-table.scm @@ -108,21 +108,20 @@ (define (piece-table-text-length piece-table) (reduce + 0 (map piece-length (piece-table-pieces piece-table)))) -(define (piece-table-insert! piece-table pos str) - - (define (pos->piece-idx-pos ps pos) - (let loop ((idx 0) - (pieces ps) - (rem pos)) - (let* ((current (car pieces)) - (len (piece-length current))) - (if (<= rem len) - (values idx rem) - (loop (+ idx 1) (cdr pieces) (- rem len)))))) +(define (piece-table-text-pos->piece-idx+remainder piece-table pos) + "Returns (values piece remainder)" + (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)))))) +(define (piece-table-insert! piece-table pos str) ;; Write to add-buffer first (let ((piece-to-insert (add-buffer-append! (piece-table-add-buffer piece-table) str))) - ;; Now assign a piece for what we wrote ;; It's probably reasonable to combine both branches in just the one in the ;; bottom @@ -137,32 +136,25 @@ (piece-to-insert #f)))) ;; not last - (call-with-values - (lambda () (pos->piece-idx-pos (piece-table-pieces piece-table) pos)) - (lambda (idx rem) - (call-with-values - (lambda () - (split-at! (piece-table-pieces piece-table) idx)) - (lambda (beg end) - (let* ((altered (car end)) - (rest (cdr end)) - (buffer (piece-buffer altered)) - (start (piece-start altered)) - (length (piece-length altered)) - (add-buffer (piece-table-add-buffer piece-table))) - (set-piece-table-pieces! - piece-table - (append beg - (list (make-piece buffer start rem #f) - (piece-to-insert #f) - (make-piece buffer - (+ start rem) - (- length rem) - #f)) - rest)))))))))) - -(define (piece-table-delete! piece-table pos) - #f) + (let*-values (((idx rem) (piece-table-text-pos->piece-idx+remainder + piece-table pos)) + ((beg end) (split-at! (piece-table-pieces piece-table) idx))) + (let* ((altered (car end)) + (rest (cdr end)) + (buffer (piece-buffer altered)) + (start (piece-start altered)) + (length (piece-length altered)) + (add-buffer (piece-table-add-buffer piece-table))) + (set-piece-table-pieces! + piece-table + (append beg + (list (make-piece buffer start rem #f) + (piece-to-insert #f) + (make-piece buffer + (+ start rem) + (- length rem) + #f)) + rest))))))) |