Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-18 18:37:32 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixing default padding/trimming to be left, matching the spec (from SRFI 13 convention)

Browse source
This commit is contained in:
Alex Shinn 2019-02-27 22:52:18 +08:00
parent a126417ebe
commit 2c3dfbd295
4 changed files with 53 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

68
lib/chibi/show-test.sld
View file

@ -278,33 +278,33 @@
;; padding/trimming
(test "abc " (show #f (padded 5 "abc")))
(test " abc" (show #f (padded/left 5 "abc")))
(test "abcdefghi" (show #f (padded/left 5 "abcdefghi")))
(test "abc " (show #f (padded/right 5 "abc")))
(test " abc" (show #f (padded 5 "abc")))
(test "abcdefghi" (show #f (padded 5 "abcdefghi")))
(test " abc " (show #f (padded/both 5 "abc")))
(test " abc " (show #f (padded/both 6 "abc")))
(test "abcde" (show #f (padded 5 "abcde")))
(test "abcdef" (show #f (padded 5 "abcdef")))
(test "abcde" (show #f (padded/right 5 "abcde")))
(test "abcdef" (show #f (padded/right 5 "abcdef")))
(test "abc" (show #f (trimmed 3 "abcde")))
(test "abc" (show #f (trimmed 3 "abcd")))
(test "abc" (show #f (trimmed 3 "abc")))
(test "ab" (show #f (trimmed 3 "ab")))
(test "a" (show #f (trimmed 3 "a")))
(test "cde" (show #f (trimmed/left 3 "abcde")))
(test "abc" (show #f (trimmed/right 3 "abcde")))
(test "abc" (show #f (trimmed/right 3 "abcd")))
(test "abc" (show #f (trimmed/right 3 "abc")))
(test "ab" (show #f (trimmed/right 3 "ab")))
(test "a" (show #f (trimmed/right 3 "a")))
(test "cde" (show #f (trimmed 3 "abcde")))
(test "bcd" (show #f (trimmed/both 3 "abcde")))
(test "bcdef" (show #f (trimmed/both 5 "abcdefgh")))
(test "abc" (show #f (trimmed/lazy 3 "abcde")))
(test "abc" (show #f (trimmed/lazy 3 "abc\nde")))
(test "prefix: abc" (show #f "prefix: " (trimmed 3 "abcde")))
(test "prefix: cde" (show #f "prefix: " (trimmed/left 3 "abcde")))
(test "prefix: abc" (show #f "prefix: " (trimmed/right 3 "abcde")))
(test "prefix: cde" (show #f "prefix: " (trimmed 3 "abcde")))
(test "prefix: bcd" (show #f "prefix: " (trimmed/both 3 "abcde")))
(test "prefix: abc" (show #f "prefix: " (trimmed/lazy 3 "abcde")))
(test "prefix: abc" (show #f "prefix: " (trimmed/lazy 3 "abc\nde")))
(test "abc :suffix" (show #f (trimmed 3 "abcde") " :suffix"))
(test "cde :suffix" (show #f (trimmed/left 3 "abcde") " :suffix"))
(test "abc :suffix" (show #f (trimmed/right 3 "abcde") " :suffix"))
(test "cde :suffix" (show #f (trimmed 3 "abcde") " :suffix"))
(test "bcd :suffix" (show #f (trimmed/both 3 "abcde") " :suffix"))
(test "abc :suffix" (show #f (trimmed/lazy 3 "abcde") " :suffix"))
(test "abc :suffix" (show #f (trimmed/lazy 3 "abc\nde") " :suffix"))
@ -313,17 +313,17 @@
(test "abc" (show #f (trimmed/lazy 3 (trimmed/lazy 10 "abcdefghijklmnopqrstuvwxyz"))))
(test "abcde"
(show #f (with ((ellipsis "...")) (trimmed 5 "abcde"))))
(show #f (with ((ellipsis "...")) (trimmed/right 5 "abcde"))))
(test "ab..."
(show #f (with ((ellipsis "...")) (trimmed 5 "abcdef"))))
(show #f (with ((ellipsis "...")) (trimmed/right 5 "abcdef"))))
(test "abc..."
(show #f (with ((ellipsis "...")) (trimmed 6 "abcdefg"))))
(show #f (with ((ellipsis "...")) (trimmed/right 6 "abcdefg"))))
(test "abcde"
(show #f (with ((ellipsis "...")) (trimmed/left 5 "abcde"))))
(show #f (with ((ellipsis "...")) (trimmed 5 "abcde"))))
(test "...ef"
(show #f (with ((ellipsis "...")) (trimmed/left 5 "abcdef"))))
(show #f (with ((ellipsis "...")) (trimmed 5 "abcdef"))))
(test "...efg"
(show #f (with ((ellipsis "...")) (trimmed/left 6 "abcdefg"))))
(show #f (with ((ellipsis "...")) (trimmed 6 "abcdefg"))))
(test "abcdefg"
(show #f (with ((ellipsis "...")) (trimmed/both 7 "abcdefg"))))
(test "...d..."
@ -331,32 +331,32 @@
(test "...e..."
(show #f (with ((ellipsis "...")) (trimmed/both 7 "abcdefghi"))))
(test "abc " (show #f (fitted 5 "abc")))
(test " abc" (show #f (fitted/left 5 "abc")))
(test "abc " (show #f (fitted/right 5 "abc")))
(test " abc" (show #f (fitted 5 "abc")))
(test " abc " (show #f (fitted/both 5 "abc")))
(test "abcde" (show #f (fitted/right 5 "abcde")))
(test "abcde" (show #f (fitted 5 "abcde")))
(test "abcde" (show #f (fitted/left 5 "abcde")))
(test "abcde" (show #f (fitted/both 5 "abcde")))
(test "abcde" (show #f (fitted 5 "abcdefgh")))
(test "defgh" (show #f (fitted/left 5 "abcdefgh")))
(test "abcde" (show #f (fitted/right 5 "abcdefgh")))
(test "defgh" (show #f (fitted 5 "abcdefgh")))
(test "bcdef" (show #f (fitted/both 5 "abcdefgh")))
(test "prefix: abc :suffix"
(show #f "prefix: " (fitted 5 "abc") " :suffix"))
(show #f "prefix: " (fitted/right 5 "abc") " :suffix"))
(test "prefix: abc :suffix"
(show #f "prefix: " (fitted/left 5 "abc") " :suffix"))
(show #f "prefix: " (fitted 5 "abc") " :suffix"))
(test "prefix: abc :suffix"
(show #f "prefix: " (fitted/both 5 "abc") " :suffix"))
(test "prefix: abcde :suffix"
(show #f "prefix: " (fitted 5 "abcde") " :suffix"))
(show #f "prefix: " (fitted/right 5 "abcde") " :suffix"))
(test "prefix: abcde :suffix"
(show #f "prefix: " (fitted/left 5 "abcde") " :suffix"))
(show #f "prefix: " (fitted 5 "abcde") " :suffix"))
(test "prefix: abcde :suffix"
(show #f "prefix: " (fitted/both 5 "abcde") " :suffix"))
(test "prefix: abcde :suffix"
(show #f "prefix: " (fitted 5 "abcdefgh") " :suffix"))
(show #f "prefix: " (fitted/right 5 "abcdefgh") " :suffix"))
(test "prefix: defgh :suffix"
(show #f "prefix: " (fitted/left 5 "abcdefgh") " :suffix"))
(show #f "prefix: " (fitted 5 "abcdefgh") " :suffix"))
(test "prefix: bcdef :suffix"
(show #f "prefix: " (fitted/both 5 "abcdefgh") " :suffix"))
@ -366,13 +366,13 @@
(test ":abc:123"
(show #f (joined/prefix
(lambda (x) (trimmed 3 x))
(lambda (x) (trimmed/right 3 x))
'("abcdef" "123456")
":")))
(test "abc\n123\n"
(show #f (joined/suffix
(lambda (x) (trimmed 3 x))
(lambda (x) (trimmed/right 3 x))
'("abcdef" "123456")
nl)))

26
lib/chibi/show/show.scm
View file

@ -119,16 +119,13 @@
(displayed str)))))))
;;> As \scheme{padded/both} but only applies padding on the right.
(define (padded width . ls)
(define (padded/right width . ls)
(fn ((col1 col))
(each (each-in-list ls)
(fn ((col2 col) pad-char)
(displayed (make-string (max 0 (- width (- col2 col1)))
pad-char))))))
;;> An alias for \scheme{padded}.
(define padded/right padded)
;;> As \scheme{padded/both} but only applies padding on the left.
(define (padded/left width . ls)
(call-with-output
@ -138,6 +135,9 @@
(let ((diff (- width (string-width str))))
(each (make-string (max 0 diff) pad-char) str))))))
;;> An alias for \scheme{padded/left}.
(define padded padded/left)
;; General buffered trim - capture the output apply a trimmer.
(define (trimmed/buffered width producer proc)
(call-with-output
@ -155,7 +155,7 @@
;;> are removed, then the value of \scheme{ellipsis} (default empty)
;;> is used in its place (trimming additional characters as needed to
;;> be sure the final output doesn't exceed \var{width}).
(define (trimmed width . ls)
(define (trimmed/right width . ls)
(trimmed/buffered
width
(each-in-list ls)
@ -169,9 +169,6 @@
(substring str 0 (- width ell-len)))
ell))))))
;;> An alias for \scheme{trimmed}.
(define trimmed/right trimmed)
;;> As \scheme{trimmed} but removes from the left.
(define (trimmed/left width . ls)
(trimmed/buffered
@ -187,6 +184,9 @@
nothing
(substring str diff))))))))
;;> An alias for \scheme{trimmed/left}.
(define trimmed trimmed/left)
;;> As \scheme{trimmed} but removes equally from both the left and the
;;> right, removing extra odd characters from the right, and inserting
;;> \scheme{ellipsis} on both sides.
@ -232,16 +232,16 @@
;;> Fits the result of \scheme{(each-in-list ls)} to exactly
;;> \var{width} characters, padding or trimming on the right as
;;> needed.
(define (fitted width . ls)
(padded width (trimmed width (each-in-list ls))))
;;> An alias for \scheme{fitted}.
(define fitted/right fitted)
(define (fitted/right width . ls)
(padded/right width (trimmed/right width (each-in-list ls))))
;;> As \scheme{fitted} but pads/trims from the left.
(define (fitted/left width . ls)
(padded/left width (trimmed/left width (each-in-list ls))))
;;> An alias for \scheme{fitted/left}.
(define fitted fitted/left)
;;> As \scheme{fitted} but pads/trims equally from both the left and
;;> the right.
(define (fitted/both width . ls)

6
lib/srfi/159.sld
View file

@ -8,9 +8,9 @@
displayed written written-shared written-simply
numeric numeric/comma numeric/si numeric/fitted
nothing nl fl space-to tab-to escaped maybe-escaped
padded padded/left padded/right padded/both
trimmed trimmed/left trimmed/right trimmed/both trimmed/lazy
fitted fitted/left fitted/right fitted/both
padded padded/right padded/both
trimmed trimmed/right trimmed/both trimmed/lazy
fitted fitted/right fitted/both
joined joined/prefix joined/suffix joined/last joined/dot joined/range
upcased downcased
;; columnar

6
lib/srfi/159/base.sld
View file

@ -6,8 +6,8 @@
displayed written written-shared written-simply
numeric numeric/comma numeric/si numeric/fitted
nothing nl fl space-to tab-to escaped maybe-escaped
padded padded/left padded/right padded/both
trimmed trimmed/left trimmed/right trimmed/both trimmed/lazy
fitted fitted/left fitted/right fitted/both
padded padded/right padded/both
trimmed trimmed/right trimmed/both trimmed/lazy
fitted fitted/right fitted/both
joined joined/prefix joined/suffix joined/last joined/dot joined/range
upcased downcased))