diff --git a/lib/chibi/text/base.scm b/lib/chibi/text/base.scm index 8fe93eaf..f60781bc 100644 --- a/lib/chibi/text/base.scm +++ b/lib/chibi/text/base.scm @@ -5,7 +5,7 @@ (if text (lp (text-next text) (+ sum - (string-length (utf8->string! (text-source text) + (string-length (utf8->string! (text-bytes text) (text-start text) (text-end text))))) sum))) @@ -34,19 +34,19 @@ (make-text bv start end #f #f '() #f))) (define (text-string text) - (utf8->string (text-source text) (text-start text) (text-end text))) + (utf8->string (text-bytes text) (text-start text) (text-end text))) ;;> Returns the utf8 representation of the codepoints in \var{text}. (define (text->utf8 text) (if (and (not (text-prev text)) (not (text-next text))) - (bytevector-copy (text-source text) (text-start text) (text-end text)) + (bytevector-copy (text-bytes text) (text-start text) (text-end text)) (let ((out (open-output-bytevector))) (let lp ((piece (text-first text))) (cond ((not piece) (get-output-bytevector out)) (else - (write-bytevector (text-source piece) out (text-start piece) (text-end piece)) + (write-bytevector (text-bytes piece) out (text-start piece) (text-end piece)) (lp (text-next piece)))))))) ;;> Returns a string representing the same codepoints as \var{text}. @@ -61,25 +61,25 @@ (let lp ((text (text-prev (mark-text mark)))) (and text (if (< (text-start text) (text-end text)) - (utf8-ref (text-source text) (- (text-end text) 1)) + (utf8-ref (text-bytes text) (- (text-end text) 1)) (lp (text-prev text)))))) ((>= (mark-offset mark) (text-end (mark-text mark))) (let lp ((text (text-next (mark-text mark)))) (and text (if (< (text-start text) (text-end text)) - (utf8-ref (text-source text) (text-start text)) + (utf8-ref (text-bytes text) (text-start text)) (lp (text-next text)))))) (else - (utf8-ref (text-source (mark-text mark)) (mark-offset mark))))) + (utf8-ref (text-bytes (mark-text mark)) (mark-offset mark))))) (define (text-piece-copy text) - (let ((res (make-text (bytevector-copy (text-source text)) + (let ((res (make-text (bytevector-copy (text-bytes text)) (text-start text) (text-end text) (text-prev text) (text-next text) '() - (text-data text)))) + (text-source text)))) (text-marks-set! res (map (lambda (mk) (make-mark res (mark-offset mk) (mark-data mk))) @@ -144,9 +144,9 @@ (size (max (- at-offset (text-start text)) (if (pair? o) (car o) 64))) (right (text-new-right! text size))) - (bytevector-copy! (text-source right) + (bytevector-copy! (text-bytes right) 0 - (text-source text) + (text-bytes text) at-offset (text-end text)) (text-end-set! right (- (text-end text) at-offset)) @@ -170,7 +170,7 @@ (let* ((at-offset (mark-offset at-mark)) (src (string->utf8 str)) (size (bytevector-length src)) - (dst (text-source text)) + (dst (text-bytes text)) (dst-size (bytevector-length dst))) (cond ((= at-offset (text-end text)) @@ -189,7 +189,7 @@ ;; TODO: better sizing? (let ((right (text-new-right! text (* 2 size))) (right-size (- size copy-size))) - (bytevector-copy! (text-source right) 0 src copy-size size) + (bytevector-copy! (text-bytes right) 0 src copy-size size) (text-end-set! right right-size))) text)) ;; ((= at-offset (text-start text)) @@ -244,11 +244,7 @@ (let lp ((text (text-next from-text)) (marks '())) (cond ((and text (not (eq? text to-text))) - ;; TODO: splice out the nodes themselves - (let ((new-marks (text-marks text))) - (text-start-set! text (text-end text)) - (text-marks-set! text '()) - (lp (text-next text) (cons new-marks marks)))) + (lp (text-next text) (cons (text-splice! text) marks))) (else (text-marks-set! to-text (append diff --git a/lib/chibi/text/marks.scm b/lib/chibi/text/marks.scm index 6ba3856a..7b5c9bf9 100644 --- a/lib/chibi/text/marks.scm +++ b/lib/chibi/text/marks.scm @@ -39,18 +39,18 @@ (data (and (pair? o) (pair? (cdr o)) (cadr o)))) (let lp ((n index) (text text) - (bv (text-source text)) + (bv (text-bytes text)) (sc (text-start text))) (cond ((positive? n) (if (>= sc (text-end text)) (let ((text2 (text-next text))) - (lp n text2 (text-source text2) (text-start text2))) + (lp n text2 (text-bytes text2) (text-start text2))) (lp (- n 1) text bv (utf8-next bv sc (text-end text))))) ((zero? n) (values text (make-mark text sc data))) (else (if (<= sc (text-start text)) (let ((text2 (text-prev text))) - (lp n text2 (text-source text2) (text-end text2))) + (lp n text2 (text-bytes text2) (text-end text2))) (lp (+ n 1) text bv (utf8-prev bv sc (text-start text)))))))))) diff --git a/lib/chibi/text/movement.scm b/lib/chibi/text/movement.scm index 76d8511b..0d7f56c3 100644 --- a/lib/chibi/text/movement.scm +++ b/lib/chibi/text/movement.scm @@ -7,8 +7,8 @@ (cond ((< (mark-offset mark) (text-end (mark-text mark))) ;; there was space in the current piece - (let ((ch (utf8-ref (text-source (mark-text mark)) (mark-offset mark))) - (offset2 (utf8-next (text-source (mark-text mark)) + (let ((ch (utf8-ref (text-bytes (mark-text mark)) (mark-offset mark))) + (offset2 (utf8-next (text-bytes (mark-text mark)) (mark-offset mark) (text-end (mark-text mark))))) (mark-offset-set! mark offset2) @@ -18,8 +18,8 @@ (and text (if (< (text-start text) (text-end text)) ;; advanced to a new piece, need to also move the mark - (let ((ch (utf8-ref (text-source text) (text-start text))) - (offset2 (utf8-next (text-source text) + (let ((ch (utf8-ref (text-bytes text) (text-start text))) + (offset2 (utf8-next (text-bytes text) (text-start text) (text-end text)))) (mark-offset-set! mark offset2) @@ -38,7 +38,7 @@ (cond ((> (mark-offset mark) (text-start (mark-text mark))) (cond - ((utf8-prev (text-source (mark-text mark)) + ((utf8-prev (text-bytes (mark-text mark)) (mark-offset mark) (text-start (mark-text mark))) => (lambda (offset) (mark-offset-set! mark offset) (text-ref mark))) @@ -49,7 +49,7 @@ (if (< (text-start text) (text-end text)) ;; advanced to a new piece, need to also move the mark (cond - ((utf8-prev (text-source text) (text-end text) (text-start text)) + ((utf8-prev (text-bytes text) (text-end text) (text-start text)) => (lambda (offset) (mark-offset-set! mark offset) (text-marks-set! (mark-text mark) diff --git a/lib/chibi/text/search.scm b/lib/chibi/text/search.scm index 8cb696fe..0036f79e 100644 --- a/lib/chibi/text/search.scm +++ b/lib/chibi/text/search.scm @@ -7,7 +7,7 @@ (let lp ((tx (mark-text mk))) (and tx ;; Note string size is mis-named, it's actually the end offset. - (let* ((bv (text-source tx)) + (let* ((bv (text-bytes tx)) (start (if (eqv? tx (mark-text mk)) (mark-offset mk) (text-start tx))) (end (text-end tx)) (str (utf8->string! bv start end)) diff --git a/lib/chibi/text/types.scm b/lib/chibi/text/types.scm index 3d5635c4..5bc5e1b9 100644 --- a/lib/chibi/text/types.scm +++ b/lib/chibi/text/types.scm @@ -7,15 +7,15 @@ ;; Basically implemented as a piece table with mark management. (define-record-type Text - (make-text source start end prev next marks data) + (make-text bytes start end prev next marks source) text? - (source text-source text-source-set!) + (bytes text-bytes text-bytes-set!) (start text-start text-start-set!) (end text-end text-end-set!) (prev text-prev text-prev-set!) (next text-next text-next-set!) (marks text-marks text-marks-set!) - (data text-data text-data-set!)) + (source text-source text-source-set!)) (define (text-first text) (cond ((text-prev text) => text-first) @@ -25,9 +25,37 @@ (cond ((text-next text) => text-last) (else text))) +(define (text-splice! text) + ;; TODO: splice out the nodes themselves + (let ((marks (text-marks text))) + (text-start-set! text (text-end text)) + (text-marks-set! text '()) + marks)) + (define-record-type Mark (make-mark text offset data) mark? (text mark-text mark-text-set!) (offset mark-offset mark-offset-set!) (data mark-data mark-data-set!)) + +(define-record-type Text-Source + (make-text-source loader path data) + text-source? + (loader text-source-loader text-source-loader-set!) + (path text-source-path text-source-path-set!) + (data text-source-data text-source-data-set!)) + +(define-record-type Text-Loader + (make-text-loader load reload write modified?) + text-loader? + ;; load is used on construction + (load text-loader-load text-loader-load-set!) + ;; reload updates the text to match the file (discards changes) + (reload text-loader-reload text-loader-reload-set!) + ;; write updates the file to match the text (overwrites external edits) + (write text-loader-write text-loader-write-set!) + ;; modified tells us if the file has been modified since we last synced + ;; (either write or reload) + (modified? text-loader-modified? text-loader-modified?-set!) + ) diff --git a/lib/chibi/text/types.sld b/lib/chibi/text/types.sld index ccd74d3f..c04adc72 100644 --- a/lib/chibi/text/types.sld +++ b/lib/chibi/text/types.sld @@ -3,16 +3,26 @@ (import (scheme base)) (export make-text text? - text-source text-source-set! + text-bytes text-bytes-set! text-start text-start-set! text-end text-end-set! text-prev text-prev-set! text-next text-next-set! text-marks text-marks-set! - text-data text-data-set! + text-source text-source-set! text-first text-last make-mark mark? mark-text mark-text-set! mark-offset mark-offset-set! - mark-data mark-data-set!) + mark-data mark-data-set! + ;; loading + make-text-source text-source? + text-source-loader text-source-loader-set! + text-source-path text-source-path-set! + text-source-data text-source-data-set! + make-text-loader text-loader? + text-loader-load text-loader-load-set! + text-loader-reload text-loader-reload-set! + text-loader-write text-loader-write-set! + text-loader-modified? text-loader-modified?-set!) (include "types.scm")) diff --git a/lib/srfi/231/test.sld b/lib/srfi/231/test.sld index 794b5627..c1a3638d 100644 --- a/lib/srfi/231/test.sld +++ b/lib/srfi/231/test.sld @@ -1311,14 +1311,21 @@ (test #\a (array-ref (make-specialized-array (make-interval '#()) char-storage-class #\a))) + (test-assert + (array-packed? (make-specialized-array (make-interval '#()) + f32-storage-class))) + (test-assert + (array-packed? (make-specialized-array (make-interval '#(1 2 3) + '#(1 2 3)) + f32-storage-class))) ;; all these are true, we'll have to see how to screw it up later. - ;; (do ((i 0 (+ i 1))) - ;; ((= i tests)) - ;; (let ((array - ;; (make-specialized-array (random-interval) - ;; u1-storage-class))) - ;; (test-assert (array-packed? array)))) + (do ((i 0 (+ i 1))) + ((= i tests)) + (let ((array + (make-specialized-array (random-interval) + u1-storage-class))) + (test-assert (array-packed? array)))) (let ((array (make-specialized-array (make-interval '#(0 0) '#(2 3)))))