diff --git a/lib/chibi/monad/environment.sld b/lib/chibi/monad/environment.sld index d8674453..9fe2e5f1 100644 --- a/lib/chibi/monad/environment.sld +++ b/lib/chibi/monad/environment.sld @@ -2,4 +2,7 @@ (define-library (chibi monad environment) (export define-environment-monad) (import (scheme base)) + (cond-expand + (chibi (import (only (chibi) syntax-quote))) + (else (begin (define-syntax syntax-quote (syntax-rules ((_ x) 'x)))))) (include "environment.scm")) diff --git a/lib/srfi/159.sld b/lib/srfi/159.sld index 44a763d9..1d173322 100644 --- a/lib/srfi/159.sld +++ b/lib/srfi/159.sld @@ -5,7 +5,7 @@ (export ;; base show fn forked with with! each each-in-list call-with-output - displayed written written-simply pretty pretty-simply + displayed written written-simply numeric numeric/comma numeric/si numeric/fitted nothing nl fl space-to tab-to escaped maybe-escaped padded padded/right padded/both @@ -18,7 +18,7 @@ tabular columnar show-columns wrapped wrapped/list wrapped/char justified line-numbers from-file ;; unicode - as-unicode unicode-terminal-width + as-unicode ;; color as-red as-blue as-green as-cyan as-yellow as-magenta as-white as-black diff --git a/lib/srfi/159/base.scm b/lib/srfi/159/base.scm index 091d25b1..30e39b6a 100644 --- a/lib/srfi/159/base.scm +++ b/lib/srfi/159/base.scm @@ -46,6 +46,13 @@ (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. All primitive output should go through this operation. ;; Overridable, defaulting to output-default. (define (output str) @@ -127,13 +134,13 @@ ;;> Raw output - displays str to the formatter output port and updates ;;> row and col. (define (output-default str) - (fn (port row col string-width) - (display str port) - (let ((nl-index (string-find-right str #\newline))) + (fn (port (r row) (c col) string-width) + (let ((nl-index (string-index-right str #\newline))) + (write-string str port) (if (string-cursor>? nl-index (string-cursor-start str)) - (with! (row (+ row (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 (+ col (string-width str)))))))) + (with! (col (+ c (string-width str)))))))) ;;> Captures the output of \var{producer} and formats the result with ;;> \var{consumer}. diff --git a/lib/srfi/159/base.sld b/lib/srfi/159/base.sld index d5677ee2..fbf02a73 100644 --- a/lib/srfi/159/base.sld +++ b/lib/srfi/159/base.sld @@ -1,11 +1,17 @@ (define-library (srfi 159 base) (export - show fn forked with with! each each-in-list call-with-output - displayed written written-shared written-simply numeric nothing - escaped maybe-escaped numeric/si numeric/fitted numeric/comma) + show displayed written written-shared written-simply + escaped maybe-escaped + numeric numeric/comma numeric/si numeric/fitted + nl fl space-to tab-to nothing each each-in-list + joined joined/prefix joined/suffix joined/last joined/dot + joined/range padded padded/right padded/both + trimmed trimmed/right trimmed/both trimmed/lazy + fitted fitted/right fitted/both output-default + fn with with! forked call-with-output) (import (scheme base) (scheme write) (scheme complex) (scheme inexact) - (srfi 1) (srfi 69) (chibi string) (chibi monad environment) + (srfi 1) (srfi 69) (srfi 130) (chibi monad environment) (chibi show shared)) (cond-expand (chibi @@ -25,5 +31,6 @@ (let-optionals* tmp2 rest . body))) ((let-optionals* tmp tail . body) (let ((tail tmp)) . body))))))) - (include "../166/base.scm") + (include "base.scm") + (include "../166/show.scm") (include "../166/write.scm")) diff --git a/lib/srfi/159/unicode.sld b/lib/srfi/159/unicode.sld index fec02052..62f75fa9 100644 --- a/lib/srfi/159/unicode.sld +++ b/lib/srfi/159/unicode.sld @@ -5,5 +5,5 @@ (chibi show base) (srfi 130) (srfi 151)) - (export as-unicode unicode-terminal-width) + (export (rename terminal-aware as-unicode)) (include "../166/width.scm" "../166/unicode.scm"))