summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--par/piece-table.scm68
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)))))))