diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index f6b00185793..4fb28b2fd37 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -72,7 +72,7 @@ Non-date items: %h mail host name Decimal digits between the % and the type character specify the -field width. Strings are truncated on the right; years on the left. +field width. Strings are truncated on the right. A leading zero in the field width zero-fills a number. For example, to get the format used by the `date' command, @@ -420,13 +420,9 @@ normally the current time is used." (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. +;;; time-stamp is transitioning to be compatible with format-time-string. +;;; During the process, this function implements +;;; intermediate, compatible formats. ;;; 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 @@ -445,7 +441,7 @@ and all `time-stamp-format' compatibility." (result "") field-width field-result - alt-form change-case + alt-form change-case upcase (paren-level 0)) (while (< ind fmt-len) (setq cur-char (aref format ind)) @@ -455,7 +451,7 @@ and all `time-stamp-format' compatibility." (cond ((eq cur-char ?%) ;; eat any additional args to allow for future expansion - (setq alt-form nil change-case nil field-width "") + (setq alt-form nil change-case nil upcase nil field-width "") (while (progn (setq ind (1+ ind)) (setq cur-char (if (< ind fmt-len) @@ -491,39 +487,41 @@ and all `time-stamp-format' compatibility." (cond ((eq cur-char ?:) (setq alt-form t)) ((eq cur-char ?#) - (setq change-case t)))) + (setq change-case t)) + ((eq cur-char ?^) + (setq upcase t)) + ((eq cur-char ?-) + (setq field-width "1")) + ((eq cur-char ?_) + (setq field-width "2")))) (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)))) + (if alt-form + (if (string-equal field-width "") + (time-stamp--format "%A" time) + "") ;discourage "%:3a" + (if (or change-case upcase) + (time-stamp--format "%#a" time) + (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))) + (if (or change-case upcase (not (string-equal field-width ""))) + (time-stamp--format "%#A" time) + (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)))) + (if alt-form + (if (string-equal field-width "") + (time-stamp--format "%B" time) + "") ;discourage "%:3b" + (if (or change-case upcase) + (time-stamp--format "%#b" time) + (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))) + (if (or change-case upcase (not (string-equal field-width ""))) + (time-stamp--format "%#B" time) + (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 @@ -535,9 +533,9 @@ and all `time-stamp-format' compatibility." ((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)) + (if change-case + (time-stamp--format "%#p" time) + (time-stamp--format "%p" time))) ((eq cur-char ?P) ;AM or PM (time-stamp--format "%p" time)) ((eq cur-char ?S) ;seconds, 00-60 @@ -545,10 +543,10 @@ and all `time-stamp-format' compatibility." ((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 + (if alt-form + (string-to-number (time-stamp--format "%Y" time)) + (string-to-number (time-stamp--format "%y" time)))) + ((eq cur-char ?Y) ;4-digit year (string-to-number (time-stamp--format "%Y" time))) ((eq cur-char ?z) ;time zone lower case (if change-case @@ -585,6 +583,11 @@ and all `time-stamp-format' compatibility." ((eq cur-char ?Q) ;(undocumented fully-qualified host) (system-name)) )) + (and (numberp field-result) + (not alt-form) + (string-equal field-width "") + ;; no width provided; set width for default + (setq field-width "02")) (let ((padded-result (format (format "%%%s%c" field-width @@ -595,12 +598,10 @@ and all `time-stamp-format' compatibility." initial-length (string-to-number field-width)))) (if (> initial-length desired-length) - ;; truncate strings on right, years on left + ;; truncate strings on right (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) ;numbers don't truncate padded-result)))) (t (char-to-string cur-char))))) @@ -612,9 +613,6 @@ and all `time-stamp-format' compatibility." ALT-FORM is whether `#' specified. FIELD-WIDTH is the string width specification or \"\". TIME is the time to convert." (let ((format-string (concat "%" (char-to-string format-char)))) - (and (not alt-form) (string-equal field-width "") - (time-stamp-conv-warn format-string - (format "%%:%c" format-char))) (if (and alt-form (not (string-equal field-width ""))) "" ;discourage "%:2d" and the like (string-to-number (time-stamp--format format-string time))))) @@ -632,7 +630,8 @@ The new forms being recommended now will continue to work then.") (defun time-stamp-conv-warn (old-form new-form) "Display a warning about a soon-to-be-obsolete format. -Suggests replacing OLD-FORM with NEW-FORM." +Suggests replacing OLD-FORM with NEW-FORM. +In use before 2019 changes; will be used again after those changes settle." (cond (time-stamp-conversion-warn (with-current-buffer (get-buffer-create "*Time-stamp-compatibility*") diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index f13fee76f0e..d710564c36d 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -46,7 +46,8 @@ (put 'with-time-stamp-test-env 'lisp-indent-hook 'defun) (defmacro time-stamp-should-warn (form) - "Similar to `should' but verifies that a format warning is generated." + "Similar to `should' but verifies that a format warning is generated. +In use before 2019 changes; will be used again after those changes settle." `(let ((warning-count 0)) (cl-letf (((symbol-function 'time-stamp-conv-warn) (lambda (_old _new) @@ -69,13 +70,12 @@ ;; implemented since 2001, documented since 2019 (should (equal (time-stamp-string "%#a" ref-time) "MON")) (should (equal (time-stamp-string "%:A" ref-time) "Monday")) - ;; warned since 1997, will change - (time-stamp-should-warn (equal - (time-stamp-string "%a" ref-time) "Monday")) - (time-stamp-should-warn (equal - (time-stamp-string "%^a" ref-time) "Monday")) - (time-stamp-should-warn (equal - (time-stamp-string "%A" ref-time) "MONDAY")))) + ;; allowed but undocumented since 2019 (warned 1997-2019) + (should (equal (time-stamp-string "%^A" ref-time) "MONDAY")) + ;; warned 1997-2019, changed in 2019 + (should (equal (time-stamp-string "%a" ref-time) "Mon")) + (should (equal (time-stamp-string "%^a" ref-time) "MON")) + (should (equal (time-stamp-string "%A" ref-time) "Monday")))) (ert-deftest time-stamp-test-month-name () "Test time-stamp formats for month name." @@ -89,13 +89,12 @@ ;; implemented since 2001, documented since 2019 (should (equal (time-stamp-string "%#b" ref-time) "JAN")) (should (equal (time-stamp-string "%:B" ref-time) "January")) - ;; warned since 1997, will change - (time-stamp-should-warn (equal - (time-stamp-string "%b" ref-time) "January")) - (time-stamp-should-warn (equal - (time-stamp-string "%^b" ref-time) "January")) - (time-stamp-should-warn (equal - (time-stamp-string "%B" ref-time) "JANUARY")))) + ;; allowed but undocumented since 2019 (warned 1997-2019) + (should (equal (time-stamp-string "%^B" ref-time) "JANUARY")) + ;; warned 1997-2019, changed in 2019 + (should (equal (time-stamp-string "%b" ref-time) "Jan")) + (should (equal (time-stamp-string "%^b" ref-time) "JAN")) + (should (equal (time-stamp-string "%B" ref-time) "January")))) (ert-deftest time-stamp-test-day-of-month () "Test time-stamp formats for day of month." @@ -111,11 +110,14 @@ ;; implemented since 1997, documented since 2019 (should (equal (time-stamp-string "%1d" ref-time) "2")) (should (equal (time-stamp-string "%1d" ref-time2) "18")) - ;; warned since 1997, will change - (time-stamp-should-warn (equal (time-stamp-string "%_d" ref-time) "2")) - (time-stamp-should-warn (equal (time-stamp-string "%_d" ref-time2) "18")) - (time-stamp-should-warn (equal (time-stamp-string "%d" ref-time) "2")) - (time-stamp-should-warn (equal (time-stamp-string "%d" ref-time2) "18")))) + ;; allowed but undocumented since 2019 (warned 1997-2019) + (should (equal (time-stamp-string "%-d" ref-time) "2")) + (should (equal (time-stamp-string "%-d" ref-time2) "18")) + ;; warned 1997-2019, changed in 2019 + (should (equal (time-stamp-string "%_d" ref-time) " 2")) + (should (equal (time-stamp-string "%_d" ref-time2) "18")) + (should (equal (time-stamp-string "%d" ref-time) "02")) + (should (equal (time-stamp-string "%d" ref-time2) "18")))) (ert-deftest time-stamp-test-hours-24 () "Test time-stamp formats for hour on a 24-hour clock." @@ -135,13 +137,17 @@ (should (equal (time-stamp-string "%1H" ref-time) "15")) (should (equal (time-stamp-string "%1H" ref-time2) "12")) (should (equal (time-stamp-string "%1H" ref-time3) "6")) - ;; warned since 1997, will change - (time-stamp-should-warn (equal (time-stamp-string "%_H" ref-time) "15")) - (time-stamp-should-warn (equal (time-stamp-string "%_H" ref-time2) "12")) - (time-stamp-should-warn (equal (time-stamp-string "%_H" ref-time3) "6")) - (time-stamp-should-warn (equal (time-stamp-string "%H" ref-time) "15")) - (time-stamp-should-warn (equal (time-stamp-string "%H" ref-time2) "12")) - (time-stamp-should-warn (equal (time-stamp-string "%H" ref-time3) "6")))) + ;; allowed but undocumented since 2019 (warned 1997-2019) + (should (equal (time-stamp-string "%-H" ref-time) "15")) + (should (equal (time-stamp-string "%-H" ref-time2) "12")) + (should (equal (time-stamp-string "%-H" ref-time3) "6")) + ;; warned 1997-2019, changed in 2019 + (should (equal (time-stamp-string "%_H" ref-time) "15")) + (should (equal (time-stamp-string "%_H" ref-time2) "12")) + (should (equal (time-stamp-string "%_H" ref-time3) " 6")) + (should (equal (time-stamp-string "%H" ref-time) "15")) + (should (equal (time-stamp-string "%H" ref-time2) "12")) + (should (equal (time-stamp-string "%H" ref-time3) "06")))) (ert-deftest time-stamp-test-hours-12 () "Test time-stamp formats for hour on a 12-hour clock." @@ -161,13 +167,17 @@ (should (equal (time-stamp-string "%1I" ref-time) "3")) (should (equal (time-stamp-string "%1I" ref-time2) "12")) (should (equal (time-stamp-string "%1I" ref-time3) "6")) - ;; warned since 1997, will change - (time-stamp-should-warn (equal (time-stamp-string "%_I" ref-time) "3")) - (time-stamp-should-warn (equal (time-stamp-string "%_I" ref-time2) "12")) - (time-stamp-should-warn (equal (time-stamp-string "%_I" ref-time3) "6")) - (time-stamp-should-warn (equal (time-stamp-string "%I" ref-time) "3")) - (time-stamp-should-warn (equal (time-stamp-string "%I" ref-time2) "12")) - (time-stamp-should-warn (equal (time-stamp-string "%I" ref-time3) "6")))) + ;; allowed but undocumented since 2019 (warned 1997-2019) + (should (equal (time-stamp-string "%-I" ref-time) "3")) + (should (equal (time-stamp-string "%-I" ref-time2) "12")) + (should (equal (time-stamp-string "%-I" ref-time3) "6")) + ;; warned 1997-2019, changed in 2019 + (should (equal (time-stamp-string "%_I" ref-time) " 3")) + (should (equal (time-stamp-string "%_I" ref-time2) "12")) + (should (equal (time-stamp-string "%_I" ref-time3) " 6")) + (should (equal (time-stamp-string "%I" ref-time) "03")) + (should (equal (time-stamp-string "%I" ref-time2) "12")) + (should (equal (time-stamp-string "%I" ref-time3) "06")))) (ert-deftest time-stamp-test-month-number () "Test time-stamp formats for month number." @@ -183,11 +193,14 @@ ;; implemented since 1997, documented since 2019 (should (equal (time-stamp-string "%1m" ref-time) "1")) (should (equal (time-stamp-string "%1m" ref-time2) "11")) - ;; warned since 1997, will change - (time-stamp-should-warn (equal (time-stamp-string "%_m" ref-time) "1")) - (time-stamp-should-warn (equal (time-stamp-string "%_m" ref-time2) "11")) - (time-stamp-should-warn (equal (time-stamp-string "%m" ref-time) "1")) - (time-stamp-should-warn (equal (time-stamp-string "%m" ref-time2) "11")))) + ;; allowed but undocumented since 2019 (warned 1997-2019) + (should (equal (time-stamp-string "%-m" ref-time) "1")) + (should (equal (time-stamp-string "%-m" ref-time2) "11")) + ;; warned 1997-2019, changed in 2019 + (should (equal (time-stamp-string "%_m" ref-time) " 1")) + (should (equal (time-stamp-string "%_m" ref-time2) "11")) + (should (equal (time-stamp-string "%m" ref-time) "01")) + (should (equal (time-stamp-string "%m" ref-time2) "11")))) (ert-deftest time-stamp-test-minute () "Test time-stamp formats for minute." @@ -203,11 +216,14 @@ ;; implemented since 1997, documented since 2019 (should (equal (time-stamp-string "%1M" ref-time) "4")) (should (equal (time-stamp-string "%1M" ref-time2) "14")) - ;; warned since 1997, will change - (time-stamp-should-warn (equal (time-stamp-string "%_M" ref-time) "4")) - (time-stamp-should-warn (equal (time-stamp-string "%_M" ref-time2) "14")) - (time-stamp-should-warn (equal (time-stamp-string "%M" ref-time) "4")) - (time-stamp-should-warn (equal (time-stamp-string "%M" ref-time2) "14")))) + ;; allowed but undocumented since 2019 (warned 1997-2019) + (should (equal (time-stamp-string "%-M" ref-time) "4")) + (should (equal (time-stamp-string "%-M" ref-time2) "14")) + ;; warned 1997-2019, changed in 2019 + (should (equal (time-stamp-string "%_M" ref-time) " 4")) + (should (equal (time-stamp-string "%_M" ref-time2) "14")) + (should (equal (time-stamp-string "%M" ref-time) "04")) + (should (equal (time-stamp-string "%M" ref-time2) "14")))) (ert-deftest time-stamp-test-second () "Test time-stamp formats for second." @@ -223,11 +239,14 @@ ;; implemented since 1997, documented since 2019 (should (equal (time-stamp-string "%1S" ref-time) "5")) (should (equal (time-stamp-string "%1S" ref-time2) "15")) - ;; warned since 1997, will change - (time-stamp-should-warn (equal (time-stamp-string "%_S" ref-time) "5")) - (time-stamp-should-warn (equal (time-stamp-string "%_S" ref-time2) "15")) - (time-stamp-should-warn (equal (time-stamp-string "%S" ref-time) "5")) - (time-stamp-should-warn (equal (time-stamp-string "%S" ref-time2) "15")))) + ;; allowed but undocumented since 2019 (warned 1997-2019) + (should (equal (time-stamp-string "%-S" ref-time) "5")) + (should (equal (time-stamp-string "%-S" ref-time2) "15")) + ;; warned 1997-2019, changed in 2019 + (should (equal (time-stamp-string "%_S" ref-time) " 5")) + (should (equal (time-stamp-string "%_S" ref-time2) "15")) + (should (equal (time-stamp-string "%S" ref-time) "05")) + (should (equal (time-stamp-string "%S" ref-time2) "15")))) (ert-deftest time-stamp-test-am-pm () "Test time-stamp formats for AM and PM strings." @@ -237,9 +256,9 @@ (should (equal (time-stamp-string "%#p" ref-time3) "am")) (should (equal (time-stamp-string "%P" ref-time) "PM")) (should (equal (time-stamp-string "%P" ref-time3) "AM")) - ;; warned since 1997, will change - (time-stamp-should-warn (equal (time-stamp-string "%p" ref-time) "pm")) - (time-stamp-should-warn (equal (time-stamp-string "%p" ref-time3) "am")))) + ;; warned 1997-2019, changed in 2019 + (should (equal (time-stamp-string "%p" ref-time) "PM")) + (should (equal (time-stamp-string "%p" ref-time3) "AM")))) (ert-deftest time-stamp-test-day-number-in-week () "Test time-stamp formats for day number in week." @@ -257,8 +276,8 @@ (should (equal (time-stamp-string "%:y" ref-time) "2006")) ;; implemented since 1997, documented since 2019 (should (equal (time-stamp-string "%Y" ref-time) "2006")) - ;; warned since 1997, will change - (time-stamp-should-warn (equal (time-stamp-string "%y" ref-time) "2006")))) + ;; warned 1997-2019, changed in 2019 + (should (equal (time-stamp-string "%y" ref-time) "06")))) (ert-deftest time-stamp-test-time-zone () "Test time-stamp formats for time zone."