diff options
| -rw-r--r-- | stdlib/pic.tl | 23 | ||||
| -rw-r--r-- | tests/018/format.tl | 22 |
2 files changed, 41 insertions, 4 deletions
diff --git a/stdlib/pic.tl b/stdlib/pic.tl index db9aaf80..7ca898a7 100644 --- a/stdlib/pic.tl +++ b/stdlib/pic.tl @@ -91,11 +91,24 @@ (inc j))))))) (nreverse out))) +(defun add-neg-parens (width str) + (let ((sig (pos #\- str)) + (w (len str))) + (cond + (sig + (set [str sig] #\space) + `(@[str 1..:])`) + ((> w width) str) + (t `@str `)))) + (defun expand-pic-num-commas (fmt val) (let* ((fmt-nc (remq #\, fmt)) (exp-nc (expand-pic-num fmt-nc val))) ^(insert-commas ,exp-nc ,(comma-positions fmt)))) +(defun expand-neg-parens (width exp-n) + ^(add-neg-parens ,width ,exp-n)) + (defun expand-pic-align (chr fmt val) ^(fmt ,`~@(if chr chr)@(len fmt)a` ,val)) @@ -121,13 +134,20 @@ (unless (stringp fmt) (compile-error f "~s is required to be a format string" fmt)) (cond - ([m^$ #/\~[~#<>\|\-+0.!,]/ fmt] [fmt 1..2]) + ([m^$ #/\~[~#<>\|\-+0.!,()]/ fmt] [fmt 1..2]) ([m^$ #/\~./ fmt] (compile-error f "unrecognized escape sequence ~a" fmt)) ([m^$ #/\~/ fmt] (compile-error f "incomplete ~~ escape")) ([m^$ #/[+\-]?(0,?)?#+(,#+)*([.!]#+(,#+)*|!)?/ fmt] (if (contains "," fmt) (expand-pic-num-commas fmt val) (expand-pic-num fmt val))) + ([m^$ #/\((0,?)?#+(,#+)*([.!]#+(,#+)*|!)?\)/ fmt] + (let ((fmt `-@[fmt 1..-1]`)) + (expand-neg-parens + (len fmt) + (if (contains "," fmt) + (expand-pic-num-commas fmt val) + (expand-pic-num fmt val))))) ([m^$ #/<+/ fmt] (expand-pic-align "<" fmt val)) ([m^$ #/>+/ fmt] (expand-pic-align nil fmt val)) ([m^$ #/\|+/ fmt] (expand-pic-align "^" fmt val)) @@ -135,6 +155,7 @@ (defmacro pic (:form f :env e bigfmt . args) (let* ((regex #/[+\-]?(0,?)?#+(,#+)*([.!]#+(,#+)*|!)?| \ + \((0,?)?#+(,#+)*([.!]#+(,#+)*|!)?\)| \ <+| \ >+| \ \|+| \ diff --git a/tests/018/format.tl b/tests/018/format.tl index 0758d32f..6fc27b4e 100644 --- a/tests/018/format.tl +++ b/tests/018/format.tl @@ -243,9 +243,25 @@ (pic "#,#,#!" 123) "1,2,3" (pic "#,#,#!" 1234) "#,#,#") -(test (mapcar (do pic "foo~-0##.jpg") (rlist 0..5 8 12)) - ("foo-000.jpg" "foo-001.jpg" "foo-002.jpg" "foo-003.jpg" - "foo-004.jpg" "foo-005.jpg" "foo-008.jpg" "foo-012.jpg")) +(mtest + (pic "(#,###,###.##)" 123456.56) " 123,456.56 " + (pic "(#,###,###.##)" 1234566.56) " 1,234,566.56 " + (pic "(#,###,###.##)" 12345667.56) "12,345,667.56 " + (pic "(#,###,###.##)" 123456678.56) "123,456,678.56" + (pic "(#,###,###.##)" -123456.56) "( 123,456.56)" + (pic "(#,###,###.##)" -1234566.56) "(1,234,566.56)" + (pic "(#,###,###.##)" -12345667.56) "(12,345,667.56)" + (pic "(#,###,###.##)" -123456678.56) "(123,456,678.56)") + +(mtest + (pic "(0,###,###.##)" 123456.56) " 0,123,456.56 " + (pic "(0,###,###.##)" 1234566.56) " 1,234,566.56 " + (pic "(0,###,###.##)" 12345667.56) "12,345,667.56 " + (pic "(0,###,###.##)" 123456678.56) "123,456,678.56" + (pic "(0,###,###.##)" -123456.56) "(0,123,456.56)" + (pic "(0,###,###.##)" -1234566.56) "(1,234,566.56)" + (pic "(0,###,###.##)" -12345667.56) "(12,345,667.56)" + (pic "(0,###,###.##)" -123456678.56) "(123,456,678.56)") (test (let ((a 2) (b "###") (c 13.5)) |