bug#32931: time-stamp-format: offer numeric time zones too

[Lars Ingebrigtsen]

Below is as far as I got in rewriting to use format-spec instead....
but there are many strange things in the time-stamp gallery of format
specs:

%:a  weekday name: `Monday'.            %#A gives uppercase: `MONDAY'

OK...

%3a  abbreviated weekday: `Mon'.        %3A gives uppercase: `MON'

Well, sure.

%:b  month name: `January'.             %#B gives uppercase: `JANUARY'
%3b  abbreviated month: `Jan'.          %3B gives uppercase: `JAN'

[...]

%#p  `am' or `pm'.                      %P  gives uppercase: `AM' or `PM'

WTF!

Well, all of this can be translated into format-spec +
format-time-string things; I'll find the time some day, I guess...

diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index f423683852..8157abbb3c 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -36,6 +36,8 @@
 
 ;;; Code:
 
+(require 'format-spec)
+
 (defgroup time-stamp nil
   "Maintain last change time stamps in files edited by Emacs."
   :group 'data
@@ -413,192 +415,33 @@ time-stamp-string
 (defconst time-stamp-no-file "(no file)"
   "String to use when the buffer is not associated with a file.")
 
-;;; FIXME This comment was written in 1996!
-;;; time-stamp is transitioning to using the new, expanded capabilities
-;;; of format-time-string.  During the process, this function implements
-;;; intermediate, compatible formats and complains about old, soon to
-;;; be unsupported, formats.  This function will get a lot (a LOT) shorter
-;;; when the transition is complete and we can just pass most things
-;;; straight through to format-time-string.
-;;;      At all times, all the formats recommended in the doc string
-;;; of time-stamp-format will work not only in the current version of
-;;; Emacs, but in all versions that have been released within the past
-;;; two years.
-;;;      The : modifier is a temporary conversion feature used to resolve
-;;; ambiguous formats--formats that are changing (over time) incompatibly.
 (defun time-stamp-string-preprocess (format &optional time)
   "Use a FORMAT to format date, time, file, and user information.
 Optional second argument TIME is only for testing.
 Implements non-time extensions to `format-time-string'
 and all `time-stamp-format' compatibility."
-  (let ((fmt-len (length format))
-       (ind 0)
-       cur-char
-       (prev-char nil)
-       (result "")
-       field-width
-       field-result
-       alt-form change-case
-       (paren-level 0))
-    (while (< ind fmt-len)
-      (setq cur-char (aref format ind))
-      (setq
-       result
-       (concat result
-      (cond
-       ((eq cur-char ?%)
-       ;; eat any additional args to allow for future expansion
-       (setq alt-form nil change-case nil field-width "")
-       (while (progn
-                (setq ind (1+ ind))
-                (setq cur-char (if (< ind fmt-len)
-                                   (aref format ind)
-                                 ?\0))
-                (or (eq ?. cur-char)
-                    (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)
-                    (eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char)
-                    (eq ?\s cur-char) (eq ?# cur-char) (eq ?^ cur-char)
-                    (and (eq ?\( cur-char)
-                         (not (eq prev-char ?\\))
-                         (setq paren-level (1+ paren-level)))
-                    (if (and (eq ?\) cur-char)
-                             (not (eq prev-char ?\\))
-                             (> paren-level 0))
-                        (setq paren-level (1- paren-level))
-                      (and (> paren-level 0)
-                           (< ind fmt-len)))
-                    (if (and (<= ?0 cur-char) (>= ?9 cur-char))
-                        ;; get format width
-                        (let ((field-index ind))
-                          (while (progn
-                                   (setq ind (1+ ind))
-                                   (setq cur-char (if (< ind fmt-len)
-                                                      (aref format ind)
-                                                    ?\0))
-                                   (and (<= ?0 cur-char) (>= ?9 cur-char))))
-                          (setq field-width (substring format field-index ind))
-                          (setq ind (1- ind))
-                          t))))
-         (setq prev-char cur-char)
-         ;; some characters we actually use
-         (cond ((eq cur-char ?:)
-                (setq alt-form t))
-               ((eq cur-char ?#)
-                (setq change-case t))))
-       (setq field-result
-       (cond
-        ((eq cur-char ?%)
-         "%%")
-        ((eq cur-char ?a)              ;day of week
-         (if change-case
-             (time-stamp--format "%#a" time)
-           (or alt-form (not (string-equal field-width ""))
-               (time-stamp-conv-warn "%a" "%:a"))
-           (if (and alt-form (not (string-equal field-width "")))
-               ""                      ;discourage "%:3a"
-             (time-stamp--format "%A" time))))
-        ((eq cur-char ?A)
-         (if alt-form
-             (time-stamp--format "%A" time)
-           (or change-case (not (string-equal field-width ""))
-               (time-stamp-conv-warn "%A" "%#A"))
-           (time-stamp--format "%#A" time)))
-        ((eq cur-char ?b)              ;month name
-         (if change-case
-             (time-stamp--format "%#b" time)
-           (or alt-form (not (string-equal field-width ""))
-               (time-stamp-conv-warn "%b" "%:b"))
-           (if (and alt-form (not (string-equal field-width "")))
-               ""                      ;discourage "%:3b"
-           (time-stamp--format "%B" time))))
-        ((eq cur-char ?B)
-         (if alt-form
-             (time-stamp--format "%B" time)
-           (or change-case (not (string-equal field-width ""))
-               (time-stamp-conv-warn "%B" "%#B"))
-           (time-stamp--format "%#B" time)))
-        ((eq cur-char ?d)              ;day of month, 1-31
-         (time-stamp-do-number cur-char alt-form field-width time))
-        ((eq cur-char ?H)              ;hour, 0-23
-         (time-stamp-do-number cur-char alt-form field-width time))
-        ((eq cur-char ?I)              ;hour, 1-12
-         (time-stamp-do-number cur-char alt-form field-width time))
-        ((eq cur-char ?m)              ;month number, 1-12
-         (time-stamp-do-number cur-char alt-form field-width time))
-        ((eq cur-char ?M)              ;minute, 0-59
-         (time-stamp-do-number cur-char alt-form field-width time))
-        ((eq cur-char ?p)              ;am or pm
-         (or change-case
-             (time-stamp-conv-warn "%p" "%#p"))
-         (time-stamp--format "%#p" time))
-        ((eq cur-char ?P)              ;AM or PM
-         (time-stamp--format "%p" time))
-        ((eq cur-char ?S)              ;seconds, 00-60
-         (time-stamp-do-number cur-char alt-form field-width time))
-        ((eq cur-char ?w)              ;weekday number, Sunday is 0
-         (time-stamp--format "%w" time))
-        ((eq cur-char ?y)              ;year
-         (or alt-form (not (string-equal field-width ""))
-             (time-stamp-conv-warn "%y" "%:y"))
-         (string-to-number (time-stamp--format "%Y" time)))
-        ((eq cur-char ?Y)              ;4-digit year, new style
-         (string-to-number (time-stamp--format "%Y" time)))
-        ((eq cur-char ?z)              ;time zone lower case
-         (if change-case
-             ""                        ;discourage %z variations
-           (time-stamp--format "%#Z" time)))
-        ((eq cur-char ?Z)
-         (if change-case
-             (time-stamp--format "%#Z" time)
-           (time-stamp--format "%Z" time)))
-        ((eq cur-char ?f)              ;buffer-file-name, base name only
-         (if buffer-file-name
+  (format-spec
+   format
+   `((?f .                           ;buffer-file-name, base name only
+         ,(if buffer-file-name
              (file-name-nondirectory buffer-file-name)
            time-stamp-no-file))
-        ((eq cur-char ?F)              ;buffer-file-name, full path
-         (or buffer-file-name
+     (?F .                              ;buffer-file-name, full path
+        ,(or buffer-file-name
              time-stamp-no-file))
-        ((eq cur-char ?s)              ;system name
-         (system-name))
-        ((eq cur-char ?u)              ;user name
-         (user-login-name))
-        ((eq cur-char ?U)              ;user full name
-         (user-full-name))
-        ((eq cur-char ?l)              ;logname (undocumented user name alt)
-         (user-login-name))
-        ((eq cur-char ?L)              ;(undocumented alt user full name)
-         (user-full-name))
-        ((eq cur-char ?h)              ;mail host name
-         (or mail-host-address (system-name)))
-        ((eq cur-char ?q)              ;(undocumented unqual hostname)
-         (let ((qualname (system-name)))
+     (?s . ,(system-name))       ; system name
+     (?u . ,(user-login-name))   ;user name
+     (?U . ,(user-full-name))    ;user full name
+     (?l . ,(user-login-name))   ;logname (undocumented user name alt)
+     (?L . ,(user-full-name))    ;(undocumented alt user full name)
+     (?h . ,(or mail-host-address (system-name))) ;mail host name
+     (?q .                             ;(undocumented unqual hostname)
+         ,(let ((qualname (system-name)))
            (if (string-match "\\." qualname)
                (substring qualname 0 (match-beginning 0))
              qualname)))
-        ((eq cur-char ?Q)              ;(undocumented fully-qualified host)
-         (system-name))
-        ))
-       (let ((padded-result
-              (format (format "%%%s%c"
-                              field-width
-                              (if (numberp field-result) ?d ?s))
-                      (or field-result ""))))
-         (let* ((initial-length (length padded-result))
-                (desired-length (if (string-equal field-width "")
-                                    initial-length
-                                  (string-to-number field-width))))
-           (if (> initial-length desired-length)
-               ;; truncate strings on right, years on left
-               (if (stringp field-result)
-                   (substring padded-result 0 desired-length)
-                 (if (eq cur-char ?y)
-                     (substring padded-result (- desired-length))
-                   padded-result))     ;non-year numbers don't truncate
-             padded-result))))
-       (t
-       (char-to-string cur-char)))))
-      (setq ind (1+ ind)))
-    result))
+     (?Q , (system-name)))        ;(undocumented fully-qualified host)
+   t))
 
 (defun time-stamp-do-number (format-char alt-form field-width time)
   "Handle compatible FORMAT-CHAR where only default width/padding will change.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no