From f7c05ba9ec1634ec6d127e8e5b3edafc834ab2f0 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 11 Jun 2021 07:36:02 -0700
Subject: pic: allow trailing exclamation.

* share/txr/stdlib/pic.tl (expand-pic-num, expand-pic, pic):
Allow ### to be followed by a single !. This is not counted
toward the field width.

* tests/018/format.tl: Cover with some tests.

* txr.1: Doc updated.
---
 share/txr/stdlib/pic.tl |  5 +++--
 tests/018/format.tl     |  5 +++++
 txr.1                   | 37 +++++++++++++++++++++++--------------
 3 files changed, 31 insertions(+), 16 deletions(-)

diff --git a/share/txr/stdlib/pic.tl b/share/txr/stdlib/pic.tl
index 25a9c70b..a6228334 100644
--- a/share/txr/stdlib/pic.tl
+++ b/share/txr/stdlib/pic.tl
@@ -32,6 +32,7 @@
          (minus (eql [fmt 0] #\-))
          (exc (pos #\! fmt))
          (dot (or exc (pos #\. fmt)))
+         (fmt (if (and exc (eq #\! [fmt -1])) [fmt 0..-1] fmt))
          (int (if dot [fmt 0..dot] fmt))
          (fra (if dot [fmt (succ dot)..:] "")))
     (let ((code (if (or minus plus (not zero))
@@ -80,7 +81,7 @@
     ([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] (expand-pic-num fmt val))
+    ([m^$ #/[+\-]?0?#+([.!]#+|!)?/ fmt] (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))
@@ -89,7 +90,7 @@
 (defmacro pic (:form f :env e bigfmt . args)
   (unless (stringp bigfmt)
     (compile-error f "~s is required to be a format string" bigfmt))
-  (let* ((regex #/[+\-]?0?#+([.!]#+)?| \
+  (let* ((regex #/[+\-]?0?#+([.!]#+|!)?| \
                   <+| \
                   >+| \
                   \|+| \
diff --git a/tests/018/format.tl b/tests/018/format.tl
index 23f4cc63..2e7f8b26 100644
--- a/tests/018/format.tl
+++ b/tests/018/format.tl
@@ -114,6 +114,11 @@
   (pic "-##!#" -123)  "#####"
   (pic "+##!#"  123)  "#####")
 
+(mtest
+  (pic "###!" 123) "123"
+  (pic "###." 123) "123."
+  (pic "###!" 1234) "###")
+
 (mtest
   (pic "X##.#Y<<<Z>>>W" 1 2 3) "X 1.0Y2  Z  3W"
   (pic "~###.#~#<<<~#>>>~#" 1 2 3) "# 1.0#2  #  3#")
diff --git a/txr.1 b/txr.1
index a37342fe..6d89ea01 100644
--- a/txr.1
+++ b/txr.1
@@ -54889,7 +54889,7 @@ The numeric patterns are more complex. They conform to one of the two
 following syntactic rule:
 
 .mono
-.mets <> [ sign ]  [0] {#}+ >> [ point {#}+]
+.mets <> [ sign ]  [0] {#}+ >> [ point {#}+ | !]
 .onom
 
 The pattern consists of an optional
@@ -54902,27 +54902,32 @@ which is one of the characters
 After this comes a sequence of one or more
 .code #
 (hash) characters, which may contain exactly one
-.metn point .
-This
-.meta point
-element may appear at most once, and must not be the first or
-last character. The
 .meta point
-element is defined as one of the characters
+element, which is defined as one of the characters
 .code .
 (period)
 or
 .code !
-(exclamation mark). The entire numeric pattern contains no whitespace.
+(exclamation mark).
+This
+.meta point
+element may appear at most once, and must not be the first or
+last character, unless is is the exclamation mark,
+in which case it may appear last.
 
-A numeric pattern specifies a field width which is equal to the number
-of characters occurring in the pattern itself.
+Except if ending in the exclamation mark, a numeric pattern specifies a field
+width which is equal to the number of characters occurring in the pattern
+itself.
 For instance, the patterns
 .codn #### ,
 .code +###
 and
 .code 0#.#
-all specify a field width of four.
+all specify a field width of four. If the numeric pattern ends in an exclamation
+mark, that character is not counted toward the field width that it specifies.
+Thus the pattern
+.code ###!
+specifies a field width of three.
 
 If the leading sign is present, it has the following meanings:
 .RS
@@ -54959,9 +54964,13 @@ The number is rounded to that many fractional digits, which are all rendered,
 even if there are trailing zeros.
 If no
 .meta point
-is not specified, then the number of fractional digits is zero. The
-numeric argument is rounded to integer, and rendered without any decimal
-point or fractional part.
+is not specified, then the number of fractional digits is zero. The same is
+true if
+.meta point
+is specified as
+.code !
+as the last character. In both cases, the numeric argument is rounded to
+integer, and rendered without any decimal point or fractional part.
 
 Finally, there is a difference between
 .meta point
-- 
cgit v1.2.3