From afb4a432c9169f81a7f9422312895a75e3ea666c Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 18 Jun 2020 00:00:45 +0900 Subject: [PATCH] replace (chibi string) with (srfi 130) in (srfi 166) --- lib/srfi/166/base.scm | 11 +++++++++-- lib/srfi/166/base.sld | 7 +++---- lib/srfi/166/columnar.sld | 7 ++++--- lib/srfi/166/pretty.scm | 9 ++++++++- lib/srfi/166/pretty.sld | 2 +- lib/srfi/166/write.scm | 28 ++++++++++++++-------------- 6 files changed, 39 insertions(+), 25 deletions(-) diff --git a/lib/srfi/166/base.scm b/lib/srfi/166/base.scm index 2ae9857b..0010d012 100644 --- a/lib/srfi/166/base.scm +++ b/lib/srfi/166/base.scm @@ -17,14 +17,21 @@ (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str)))) (- end start))) +(define (call-with-output-string proc) + (let ((out (open-output-string))) + (proc out) + (let ((res (get-output-string out))) + (close-output-port out) + res))) + ;;> Raw output - displays str to the formatter output port and updates ;;> row and col. (define (output-default str) (fn (port (r row) (c col) string-width) - (let ((nl-index (string-find-right str #\newline))) + (let ((nl-index (string-index-right str #\newline))) (write-string str port) (if (string-cursor>? nl-index (string-cursor-start str)) - (with! (row (+ r (string-count str #\newline))) + (with! (row (+ r (string-count str (lambda (ch) (eqv? ch #\newline))))) (col (string-width str (string-cursor->index str nl-index)))) (with! (col (+ c (string-width str)))))))) diff --git a/lib/srfi/166/base.sld b/lib/srfi/166/base.sld index b74d7859..85d3c910 100644 --- a/lib/srfi/166/base.sld +++ b/lib/srfi/166/base.sld @@ -7,13 +7,12 @@ (scheme inexact) (srfi 1) (srfi 69) - (chibi show shared) - (chibi string) + (srfi 130) (rename (srfi 165) (computation-each sequence) (computation-with! with!) - (computation-forked forked) - )) + (computation-forked forked)) + (chibi show shared)) (cond-expand (chibi (import (only (chibi) let-optionals*))) diff --git a/lib/srfi/166/columnar.sld b/lib/srfi/166/columnar.sld index af507952..4cdec7d2 100644 --- a/lib/srfi/166/columnar.sld +++ b/lib/srfi/166/columnar.sld @@ -7,7 +7,8 @@ (srfi 117) (srfi 130) (srfi 166 base) - (chibi optional) - ) - (export-all) + (chibi optional)) + (export + columnar tabular wrapped wrapped/list wrapped/char + justified from-file line-numbers show-columns) (include "column.scm")) diff --git a/lib/srfi/166/pretty.scm b/lib/srfi/166/pretty.scm index 44939b99..52c22f56 100644 --- a/lib/srfi/166/pretty.scm +++ b/lib/srfi/166/pretty.scm @@ -18,6 +18,13 @@ (define (make-space n) (make-string n #\space)) (define (make-nl-space n) (string-append "\n" (make-string n #\space))) +(define (call-with-output-string proc) + (let ((out (open-output-string))) + (proc out) + (let ((res (get-output-string out))) + (close-output-port out) + res))) + (define (joined/shares fmt ls shares . o) (let ((sep (displayed (if (pair? o) (car o) " ")))) (fn () @@ -40,7 +47,7 @@ (define (string-find/index str pred i) (string-cursor->index str - (string-find str pred (string-index->cursor str i)))) + (string-index str pred (string-index->cursor str i)))) (define (write-to-string x) (call-with-output-string (lambda (out) (write x out)))) diff --git a/lib/srfi/166/pretty.sld b/lib/srfi/166/pretty.sld index d5667b1f..23c8f53e 100644 --- a/lib/srfi/166/pretty.sld +++ b/lib/srfi/166/pretty.sld @@ -4,9 +4,9 @@ (scheme char) (scheme write) (chibi show shared) - (chibi string) (srfi 1) (srfi 69) + (srfi 130) (srfi 166 base)) (export pretty pretty-shared pretty-simply pretty-color) (include "pretty.scm")) diff --git a/lib/srfi/166/write.scm b/lib/srfi/166/write.scm index 6dd55afd..dd4956bf 100644 --- a/lib/srfi/166/write.scm +++ b/lib/srfi/166/write.scm @@ -24,10 +24,10 @@ (let* ((offset (if (pair? rule) (car rule) rule)) (i2 (if offset (string-cursor-back str i offset) start))) (if (string-cursor<=? i2 start) - (apply string-append (cons (substring-cursor str start i) res)) + (apply string-append (cons (substring/cursors str start i) res)) (lp i2 (if (and (pair? rule) (not (null? (cdr rule)))) (cdr rule) rule) - (cons sep (cons (substring-cursor str i2 i) res)))))))) + (cons sep (cons (substring/cursors str i2 i) res)))))))) ;;> Outputs the string str, escaping any quote or escape characters. ;;> If esc-ch, which defaults to #\\, is #f, escapes only the @@ -49,10 +49,10 @@ (end (string-cursor-end str))) (let lp ((i start) (j start)) (define (collect) - (if (eq? i j) "" (substring-cursor str i j))) + (if (eq? i j) "" (substring/cursors str i j))) (if (string-cursor>=? j end) (orig-output (collect)) - (let ((c (string-cursor-ref str j)) + (let ((c (string-ref/cursor str j)) (j2 (string-cursor-next str j))) (cond ((or (eqv? c quot) (eqv? c esc)) @@ -84,7 +84,7 @@ (call-with-output fmt (lambda (str) - (if (string-cursorstring n)) (end (string-cursor-end s)) - (dec (string-find s #\.)) + (dec (string-index s #\.)) (digits (- (string-cursor->index s end) (string-cursor->index s dec)))) (cond - ((string-cursor next 5) (and (= next 5) (string-cursor>? last (string-cursor-start s)) (memv (digit-value - (string-cursor-ref + (string-ref/cursor s (string-cursor-prev s last))) '(1 3 5 7 9)))))) (list->string @@ -262,9 +262,9 @@ (let* ((dec-pos (if (string? dec-sep) (or (string-contains str dec-sep) (string-cursor-end str)) - (string-find str dec-sep))) - (left (substring-cursor str (string-cursor-start str) dec-pos)) - (right (substring-cursor str dec-pos)) + (string-index str dec-sep))) + (left (substring/cursors str (string-cursor-start str) dec-pos)) + (right (string-copy/cursors str dec-pos)) (sep (cond ((char? comma-sep) (string comma-sep)) ((string? comma-sep) comma-sep) ((eqv? #\, dec-sep) ".") @@ -326,7 +326,7 @@ (string-cursor->index s (if (char? dec-sep) - (string-find s dec-sep) + (string-index s dec-sep) (or (string-contains s dec-sep) (string-cursor-end s)))) 0))