diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-10-19 06:46:10 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-10-19 06:46:10 -0700 |
| commit | b946f2c2dfa53016ce1b30c568fa8f1f61f9bae9 (patch) | |
| tree | 22291ccd27390b8b0cdfbeb390fdd3bc4ea37170 /stdlib | |
| parent | 6ee766e631b512f63a444a28e67fc79b69a0e5a6 (diff) | |
| download | txr-b946f2c2dfa53016ce1b30c568fa8f1f61f9bae9.tar.gz txr-b946f2c2dfa53016ce1b30c568fa8f1f61f9bae9.tar.bz2 txr-b946f2c2dfa53016ce1b30c568fa8f1f61f9bae9.zip | |
pic: support parenthesis negative notation.
* pic.tl (add-neg-parens): New system function.
(expand-neg-parens): New macro.
(expand-pic): New numeric pattern with parentheses.
Also suport escaping of parentheses.
(pic): Recognize parenthesized numeric pattern here also.
* tests/018/format.tl: New tests.
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/pic.tl | 23 |
1 files changed, 22 insertions, 1 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,?)?#+(,#+)*([.!]#+(,#+)*|!)?\)| \ <+| \ >+| \ \|+| \ |