diff --git a/lib/chibi/show-test.sld b/lib/chibi/show-test.sld index a4a98d4d..dfbef984 100644 --- a/lib/chibi/show-test.sld +++ b/lib/chibi/show-test.sld @@ -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))) diff --git a/lib/chibi/show/show.scm b/lib/chibi/show/show.scm index d3c5e6a3..67ecfeb6 100644 --- a/lib/chibi/show/show.scm +++ b/lib/chibi/show/show.scm @@ -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) diff --git a/lib/srfi/159.sld b/lib/srfi/159.sld index ca254724..c081a46b 100644 --- a/lib/srfi/159.sld +++ b/lib/srfi/159.sld @@ -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 diff --git a/lib/srfi/159/base.sld b/lib/srfi/159/base.sld index 7121a95f..2e0838f6 100644 --- a/lib/srfi/159/base.sld +++ b/lib/srfi/159/base.sld @@ -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))