mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +02:00
fixing (srfi 159) after refactoring
This commit is contained in:
parent
a6e8e9d7ba
commit
f2d38e36c7
5 changed files with 30 additions and 13 deletions
|
@ -2,4 +2,7 @@
|
||||||
(define-library (chibi monad environment)
|
(define-library (chibi monad environment)
|
||||||
(export define-environment-monad)
|
(export define-environment-monad)
|
||||||
(import (scheme base))
|
(import (scheme base))
|
||||||
|
(cond-expand
|
||||||
|
(chibi (import (only (chibi) syntax-quote)))
|
||||||
|
(else (begin (define-syntax syntax-quote (syntax-rules ((_ x) 'x))))))
|
||||||
(include "environment.scm"))
|
(include "environment.scm"))
|
||||||
|
|
|
@ -5,7 +5,7 @@
|
||||||
(export
|
(export
|
||||||
;; base
|
;; base
|
||||||
show fn forked with with! each each-in-list call-with-output
|
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
|
numeric numeric/comma numeric/si numeric/fitted
|
||||||
nothing nl fl space-to tab-to escaped maybe-escaped
|
nothing nl fl space-to tab-to escaped maybe-escaped
|
||||||
padded padded/right padded/both
|
padded padded/right padded/both
|
||||||
|
@ -18,7 +18,7 @@
|
||||||
tabular columnar show-columns wrapped wrapped/list wrapped/char
|
tabular columnar show-columns wrapped wrapped/list wrapped/char
|
||||||
justified line-numbers from-file
|
justified line-numbers from-file
|
||||||
;; unicode
|
;; unicode
|
||||||
as-unicode unicode-terminal-width
|
as-unicode
|
||||||
;; color
|
;; color
|
||||||
as-red as-blue as-green as-cyan as-yellow
|
as-red as-blue as-green as-cyan as-yellow
|
||||||
as-magenta as-white as-black
|
as-magenta as-white as-black
|
||||||
|
|
|
@ -46,6 +46,13 @@
|
||||||
(end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str))))
|
(end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str))))
|
||||||
(- end start)))
|
(- 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.
|
;; Raw output. All primitive output should go through this operation.
|
||||||
;; Overridable, defaulting to output-default.
|
;; Overridable, defaulting to output-default.
|
||||||
(define (output str)
|
(define (output str)
|
||||||
|
@ -127,13 +134,13 @@
|
||||||
;;> Raw output - displays str to the formatter output port and updates
|
;;> Raw output - displays str to the formatter output port and updates
|
||||||
;;> row and col.
|
;;> row and col.
|
||||||
(define (output-default str)
|
(define (output-default str)
|
||||||
(fn (port row col string-width)
|
(fn (port (r row) (c col) string-width)
|
||||||
(display str port)
|
(let ((nl-index (string-index-right str #\newline)))
|
||||||
(let ((nl-index (string-find-right str #\newline)))
|
(write-string str port)
|
||||||
(if (string-cursor>? nl-index (string-cursor-start str))
|
(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))))
|
(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
|
;;> Captures the output of \var{producer} and formats the result with
|
||||||
;;> \var{consumer}.
|
;;> \var{consumer}.
|
||||||
|
|
|
@ -1,11 +1,17 @@
|
||||||
|
|
||||||
(define-library (srfi 159 base)
|
(define-library (srfi 159 base)
|
||||||
(export
|
(export
|
||||||
show fn forked with with! each each-in-list call-with-output
|
show displayed written written-shared written-simply
|
||||||
displayed written written-shared written-simply numeric nothing
|
escaped maybe-escaped
|
||||||
escaped maybe-escaped numeric/si numeric/fitted numeric/comma)
|
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)
|
(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))
|
(chibi show shared))
|
||||||
(cond-expand
|
(cond-expand
|
||||||
(chibi
|
(chibi
|
||||||
|
@ -25,5 +31,6 @@
|
||||||
(let-optionals* tmp2 rest . body)))
|
(let-optionals* tmp2 rest . body)))
|
||||||
((let-optionals* tmp tail . body)
|
((let-optionals* tmp tail . body)
|
||||||
(let ((tail tmp)) . body)))))))
|
(let ((tail tmp)) . body)))))))
|
||||||
(include "../166/base.scm")
|
(include "base.scm")
|
||||||
|
(include "../166/show.scm")
|
||||||
(include "../166/write.scm"))
|
(include "../166/write.scm"))
|
||||||
|
|
|
@ -5,5 +5,5 @@
|
||||||
(chibi show base)
|
(chibi show base)
|
||||||
(srfi 130)
|
(srfi 130)
|
||||||
(srfi 151))
|
(srfi 151))
|
||||||
(export as-unicode unicode-terminal-width)
|
(export (rename terminal-aware as-unicode))
|
||||||
(include "../166/width.scm" "../166/unicode.scm"))
|
(include "../166/width.scm" "../166/unicode.scm"))
|
||||||
|
|
Loading…
Add table
Reference in a new issue