master 918669cb3d: Make list-times not include zero elements

[Lars Ingebrigtsen]

branch: master
commit 918669cb3db21eebc9fb409098a4395f131379ee
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Make list-times not include zero elements
    
    * doc/lispref/os.texi (Time Parsing): Mention %x.
    * lisp/calendar/time-date.el (format-seconds): Accept a new %x
    spec that removes trailing zeros (bug#54904).
    
    * lisp/emacs-lisp/timer-list.el (list-timers): Don't display
    trailing zero bits.
---
 doc/lispref/os.texi                   |  4 +++
 etc/NEWS                              |  5 ++++
 lisp/calendar/time-date.el            | 56 +++++++++++++++++++++++++----------
 lisp/emacs-lisp/timer-list.el         |  2 +-
 test/lisp/calendar/time-date-tests.el |  9 ++++--
 5 files changed, 57 insertions(+), 19 deletions(-)

diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 9cb9bc75d0..4ee893f860 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1961,6 +1961,10 @@ encountered.  For example, the default format used by
 @w{@code{"%Y, %D, %H, %M, %z%S"}} means that the number of seconds
 will always be produced, but years, days, hours, and minutes will only
 be shown if they are non-zero.
+@item %x
+Non-printing control flag that works along the same lines as
+@samp{%z}, but instead suppresses printing of trailing zero-value time
+elements.
 @item %%
 Produces a literal @samp{%}.
 @end table
diff --git a/etc/NEWS b/etc/NEWS
index 8665a825ce..c24f3f6ed5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1856,6 +1856,11 @@ temporary transition aid for Emacs 27, has served its 
purpose.
 month, day, or time.  For example, (date-to-time "2021-12-04") now
 assumes a time of 00:00 instead of signaling an error.
 
++++
+** 'format-seconds' now allows suppressing zero-value trailing elements.
+The new "%x" non-printing control character will suppress zero-value
+elements that appear after "%x".
+
 +++
 ** New events for taking advantage of touchscreen devices.
 The events 'touchscreen-begin, 'touchscreen-update', and
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 51cf7eb213..0db973ea16 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -287,17 +287,23 @@ use.  \"%,1s\" means \"use one decimal\".
 
 The \"%z\" specifier does not print anything.  When it is used, specifiers
 must be given in order of decreasing size.  To the left of \"%z\", nothing
-is output until the first non-zero unit is encountered."
+is output until the first non-zero unit is encountered.
+
+The \"%x\" specifier does not print anything.  When it is used,
+specifiers must be given in order of decreasing size.  To the
+right of \"%x\", trailing zero units are not output."
   (let ((start 0)
         (units '(("y" "year"   31536000)
                  ("d" "day"       86400)
                  ("h" "hour"       3600)
                  ("m" "minute"       60)
                  ("s" "second"        1)
-                 ("z")))
+                 ("z")
+                 ("x")))
         (case-fold-search t)
-        spec match usedunits zeroflag larger prev name unit num zeropos
-        fraction)
+        spec match usedunits zeroflag larger prev name unit num
+        leading-zeropos trailing-zeropos fraction
+        chop-leading chop-trailing)
     (while (string-match "%\\.?[0-9]*\\(,[0-9]\\)?\\(.\\)" string start)
       (setq start (match-end 0)
             spec (match-string 2 string))
@@ -306,15 +312,16 @@ is output until the first non-zero unit is encountered."
             (error "Bad format specifier: `%s'" spec))
         (if (assoc (downcase spec) usedunits)
             (error "Multiple instances of specifier: `%s'" spec))
-        (if (string-equal (car match) "z")
+        (if (or (string-equal (car match) "z")
+                (string-equal (car match) "x"))
             (setq zeroflag t)
           (unless larger
             (setq unit (nth 2 match)
                   larger (and prev (> unit prev))
                   prev unit)))
         (push match usedunits)))
-    (and zeroflag larger
-         (error "Units are not in decreasing order of size"))
+    (when (and zeroflag larger)
+      (error "Units are not in decreasing order of size"))
     (unless (numberp seconds)
       (setq seconds (float-time seconds)))
     (setq fraction (mod seconds 1)
@@ -326,18 +333,25 @@ is output until the first non-zero unit is encountered."
       (when (string-match
              (format "%%\\(\\.?[0-9]+\\)?\\(,[0-9]+\\)?\\(%s\\)" spec)
              string)
-        (if (string-equal spec "z")     ; must be last in units
-            (setq string
-                  (replace-regexp-in-string
-                   "%z" ""
-                   (substring string (min (or zeropos (match-end 0))
-                                          (match-beginning 0)))))
+        (cond
+         ((string-equal spec "z")
+          (setq chop-leading (and leading-zeropos
+                                  (min leading-zeropos (match-beginning 0)))))
+         ((string-equal spec "x")
+          (setq chop-trailing t))
+         (t
           ;; Cf article-make-date-line in gnus-art.
           (setq num (floor seconds unit)
                 seconds (- seconds (* num unit)))
           ;; Start position of the first non-zero unit.
-          (or zeropos
-              (setq zeropos (unless (zerop num) (match-beginning 0))))
+          (when (and (not leading-zeropos)
+                     (not (zerop num)))
+            (setq leading-zeropos (match-beginning 0)))
+          (unless (zerop num)
+            (setq trailing-zeropos nil))
+          (when (and (not trailing-zeropos)
+                     (zerop num))
+            (setq trailing-zeropos (match-beginning 0)))
           (setq string
                 (replace-match
                  (format (if (match-string 2 string)
@@ -360,7 +374,17 @@ is output until the first non-zero unit is encountered."
                            (format " %s%s" name
                                    (if (= num 1) "" "s"))))
                  t t string))))))
-  (string-replace "%%" "%" string))
+    (let ((pre string))
+      (when (and chop-trailing trailing-zeropos)
+        (setq string (substring string 0 trailing-zeropos)))
+      (when chop-leading
+        (setq string (substring string chop-leading)))
+      ;; If we ended up removing everything, return the formatted
+      ;; string in full.
+      (when (equal string "")
+        (setq string pre)))
+    (setq string (replace-regexp-in-string "%[zx]" "" string)))
+  (string-trim (string-replace "%%" "%" string)))
 
 (defvar seconds-to-string
   (list (list 1 "ms" 0.001)
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index c93a50cabf..aef18d0ba2 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -62,7 +62,7 @@
                   ((numberp repeat)
                    (propertize
                     (format "%12s" (format-seconds
-                                    "%dd %hh %mm %z%,1ss" repeat))
+                                    "%x%dd %hh %mm %z%,1ss" repeat))
                     'help-echo "Repeat interval"))
                   ((null repeat)
                    (propertize "           -" 'help-echo "Runs once"))
diff --git a/test/lisp/calendar/time-date-tests.el 
b/test/lisp/calendar/time-date-tests.el
index 5a37c91493..fd4d5ac8a1 100644
--- a/test/lisp/calendar/time-date-tests.el
+++ b/test/lisp/calendar/time-date-tests.el
@@ -88,14 +88,19 @@
 (ert-deftest test-format-seconds ()
   (should (equal (format-seconds "%y %d %h %m %s %%" 0) "0 0 0 0 0 %"))
   (should (equal (format-seconds "%y %d %h %m %s %%" 9999999) "0 115 17 46 39 
%"))
-  (should (equal (format-seconds "%y %d %h %m %z %s %%" 1) " 1 %"))
+  (should (equal (format-seconds "%y %d %h %m %z %s %%" 1) "1 %"))
   (should (equal (format-seconds "%mm %ss" 66) "1m 6s"))
   (should (equal (format-seconds "%mm %5ss" 66) "1m     6s"))
   (should (equal (format-seconds "%mm %.5ss" 66.4) "1m 00006s"))
 
   (should (equal (format-seconds "%mm %,1ss" 66.4) "1m 6.4s"))
   (should (equal (format-seconds "%mm %5,1ss" 66.4) "1m   6.4s"))
-  (should (equal (format-seconds "%mm %.5,1ss" 66.4) "1m 006.4s")))
+  (should (equal (format-seconds "%mm %.5,1ss" 66.4) "1m 006.4s"))
+
+  (should (equal (format-seconds "%hh %z%x%mm %ss" (* 60 2)) "2m"))
+  (should (equal (format-seconds "%hh %z%mm %ss" (* 60 2)) "2m 0s"))
+  (should (equal (format-seconds "%hh %x%mm %ss" (* 60 2)) "0h 2m"))
+  (should (equal (format-seconds "%hh %x%mm %ss" 0) "0h 0m 0s")))
 
 (ert-deftest test-ordinal ()
   (should (equal (date-ordinal-to-time 2008 271)