time-stamp: refactor time-stamp-string-preprocess

* lisp/time-stamp.el (time-stamp-string-preprocess): Reduce lifetime of some loop-local variables to be less error-prone.
author: Stephen Gildea 2021-05-30 09:08:08 -0700
committer: Stephen Gildea 2021-05-30 09:11:03 -0700
commit: d6dc66053d846b6fc041889b4d0f383c8dac4da3 (patch)
tree: 2204368aad0541f366d364a467ee0bb1ac01aa47
parent: 15f46b9669fe93c62b5749e3326d4124188f54cd (diff)
download: emacs-d6dc66053d846b6fc041889b4d0f383c8dac4da3.tar.gz
emacs-d6dc66053d846b6fc041889b4d0f383c8dac4da3.zip
1 files changed, 190 insertions, 184 deletions
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index b9eab95b232..42455ddfe33 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -462,195 +462,201 @@ and all `time-stamp-format' compatibility."
  (let ((fmt-len (length format))
        (ind 0)
        cur-char
-        (prev-char nil)
+        (result ""))
-        (result "")
-        field-width
-        field-result
-        alt-form change-case upcase
-        (paren-level 0))
    (while (< ind fmt-len)
      (setq cur-char (aref format ind))
      (setq
       result
-       (concat result
+       (concat
-      (cond
+        result
-       ((eq cur-char ?%)
+        (cond
-        ;; eat any additional args to allow for future expansion
+         ((eq cur-char ?%)
-        (setq alt-form 0 change-case nil upcase nil field-width "")
+          (let ((prev-char nil)
-        (while (progn
+                (field-width "")
-                 (setq ind (1+ ind))
+                field-result
-                 (setq cur-char (if (< ind fmt-len)
+                (alt-form 0)
-                                    (aref format ind)
+                (change-case nil)
-                                  ?\0))
+                (upcase nil)
-                 (or (eq ?. cur-char)
+                (paren-level 0))
-                     (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)
+            ;; eat any additional args to allow for future expansion
-                     (eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char)
+            (while (progn
-                     (eq ?\s cur-char) (eq ?# cur-char) (eq ?^ cur-char)
+                     (setq ind (1+ ind))
-                     (and (eq ?\( cur-char)
+                     (setq cur-char (if (< ind fmt-len)
-                          (not (eq prev-char ?\\))
+                                        (aref format ind)
-                          (setq paren-level (1+ paren-level)))
+                                      ?\0))
-                     (if (and (eq ?\) cur-char)
+                     (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 ?\\))
-                              (> paren-level 0))
+                              (setq paren-level (1+ paren-level)))
-                         (setq paren-level (1- paren-level))
+                         (if (and (eq ?\) cur-char)
-                       (and (> paren-level 0)
+                                  (not (eq prev-char ?\\))
-                            (< ind fmt-len)))
+                                  (> paren-level 0))
-                     (if (and (<= ?0 cur-char) (>= ?9 cur-char))
+                             (setq paren-level (1- paren-level))
-                         ;; get format width
+                           (and (> paren-level 0)
-                         (let ((field-index ind))
+                                (< ind fmt-len)))
-                           (while (progn
+                         (if (and (<= ?0 cur-char) (>= ?9 cur-char))
-                                    (setq ind (1+ ind))
+                             ;; get format width
-                                    (setq cur-char (if (< ind fmt-len)
+                             (let ((field-index ind))
-                                                       (aref format ind)
+                               (while (progn
-                                                     ?\0))
+                                        (setq ind (1+ ind))
-                                    (and (<= ?0 cur-char) (>= ?9 cur-char))))
+                                        (setq cur-char (if (< ind fmt-len)
-                           (setq field-width (substring format field-index ind))
+                                                           (aref format ind)
-                           (setq ind (1- ind))
+                                                         ?\0))
-                           t))))
+                                        (and (<= ?0 cur-char)
-          (setq prev-char cur-char)
+                                             (>= ?9 cur-char))))
-          ;; some characters we actually use
+                               (setq field-width
-          (cond ((eq cur-char ?:)
+                                     (substring format field-index ind))
-                 (setq alt-form (1+ alt-form)))
+                               (setq ind (1- ind))
-                ((eq cur-char ?#)
+                               t))))
-                 (setq change-case t))
+              (setq prev-char cur-char)
-                ((eq cur-char ?^)
+              ;; some characters we actually use
-                 (setq upcase t))
+              (cond ((eq cur-char ?:)
-                ((eq cur-char ?-)
+                     (setq alt-form (1+ alt-form)))
-                 (setq field-width "1"))
+                    ((eq cur-char ?#)
-                ((eq cur-char ?_)
+                     (setq change-case t))
-                 (setq field-width "2"))))
+                    ((eq cur-char ?^)
-        (setq field-result
+                     (setq upcase t))
-        (cond
+                    ((eq cur-char ?-)
-         ((eq cur-char ?%)
+                     (setq field-width "1"))
-          "%")
+                    ((eq cur-char ?_)
-         ((eq cur-char ?a)              ;day of week
+                     (setq field-width "2"))))
-          (if (> alt-form 0)
+            (setq field-result
-               (if (string-equal field-width "")
+                  (cond
-                   (time-stamp--format "%A" time)
+                   ((eq cur-char ?%)
-                 "")                    ;discourage "%:3a"
+                    "%")
-            (if (or change-case upcase)
+                   ((eq cur-char ?a)    ;day of week
-                (time-stamp--format "%#a" time)
+                    (if (> alt-form 0)
-              (time-stamp--format "%a" time))))
+                        (if (string-equal field-width "")
-         ((eq cur-char ?A)
+                            (time-stamp--format "%A" time)
-          (if (or change-case upcase (not (string-equal field-width "")))
+                          "")           ;discourage "%:3a"
-              (time-stamp--format "%#A" time)
+                      (if (or change-case upcase)
-            (time-stamp--format "%A" time)))
+                          (time-stamp--format "%#a" time)
-         ((eq cur-char ?b)              ;month name
+                        (time-stamp--format "%a" time))))
-          (if (> alt-form 0)
+                   ((eq cur-char ?A)
-               (if (string-equal field-width "")
+                    (if (or change-case upcase (not (string-equal field-width
-                   (time-stamp--format "%B" time)
+                                                                  "")))
-                 "")                    ;discourage "%:3b"
+                        (time-stamp--format "%#A" time)
-            (if (or change-case upcase)
+                      (time-stamp--format "%A" time)))
-                (time-stamp--format "%#b" time)
+                   ((eq cur-char ?b)    ;month name
-              (time-stamp--format "%b" time))))
+                    (if (> alt-form 0)
-         ((eq cur-char ?B)
+                        (if (string-equal field-width "")
-          (if (or change-case upcase (not (string-equal field-width "")))
+                            (time-stamp--format "%B" time)
-              (time-stamp--format "%#B" time)
+                          "")           ;discourage "%:3b"
-            (time-stamp--format "%B" time)))
+                      (if (or change-case upcase)
-         ((eq cur-char ?d)              ;day of month, 1-31
+                          (time-stamp--format "%#b" time)
-          (time-stamp-do-number cur-char alt-form field-width time))
+                        (time-stamp--format "%b" time))))
-         ((eq cur-char ?H)              ;hour, 0-23
+                   ((eq cur-char ?B)
-          (time-stamp-do-number cur-char alt-form field-width time))
+                    (if (or change-case upcase (not (string-equal field-width
-         ((eq cur-char ?I)              ;hour, 1-12
+                                                                  "")))
-          (time-stamp-do-number cur-char alt-form field-width time))
+                        (time-stamp--format "%#B" time)
-         ((eq cur-char ?m)              ;month number, 1-12
+                      (time-stamp--format "%B" time)))
-          (time-stamp-do-number cur-char alt-form field-width time))
+                   ((eq cur-char ?d)    ;day of month, 1-31
-         ((eq cur-char ?M)              ;minute, 0-59
+                    (time-stamp-do-number cur-char alt-form field-width time))
-          (time-stamp-do-number cur-char alt-form field-width time))
+                   ((eq cur-char ?H)    ;hour, 0-23
-         ((eq cur-char ?p)              ;am or pm
+                    (time-stamp-do-number cur-char alt-form field-width time))
-          (if change-case
+                   ((eq cur-char ?I)    ;hour, 1-12
-              (time-stamp--format "%#p" time)
+                    (time-stamp-do-number cur-char alt-form field-width time))
-            (time-stamp--format "%p" time)))
+                   ((eq cur-char ?m)    ;month number, 1-12
-         ((eq cur-char ?P)              ;AM or PM
+                    (time-stamp-do-number cur-char alt-form field-width time))
-          (time-stamp--format "%p" time))
+                   ((eq cur-char ?M)    ;minute, 0-59
-         ((eq cur-char ?S)              ;seconds, 00-60
+                    (time-stamp-do-number cur-char alt-form field-width time))
-          (time-stamp-do-number cur-char alt-form field-width time))
+                   ((eq cur-char ?p)    ;am or pm
-         ((eq cur-char ?w)              ;weekday number, Sunday is 0
+                    (if change-case
-          (time-stamp--format "%w" time))
+                        (time-stamp--format "%#p" time)
-         ((eq cur-char ?y)              ;year
+                      (time-stamp--format "%p" time)))
-          (if (> alt-form 0)
+                   ((eq cur-char ?P)    ;AM or PM
-              (string-to-number (time-stamp--format "%Y" time))
+                    (time-stamp--format "%p" time))
-            (if (or (string-equal field-width "")
+                   ((eq cur-char ?S)    ;seconds, 00-60
-                    (<= (string-to-number field-width) 2))
+                    (time-stamp-do-number cur-char alt-form field-width time))
-                (string-to-number (time-stamp--format "%y" time))
+                   ((eq cur-char ?w)    ;weekday number, Sunday is 0
-              (time-stamp-conv-warn (format "%%%sy" field-width) "%Y")
+                    (time-stamp--format "%w" time))
-              (string-to-number (time-stamp--format "%Y" time)))))
+                   ((eq cur-char ?y)    ;year
-         ((eq cur-char ?Y)              ;4-digit year
+                    (if (> alt-form 0)
-          (string-to-number (time-stamp--format "%Y" time)))
+                        (string-to-number (time-stamp--format "%Y" time))
-         ((eq cur-char ?z)              ;time zone offset
+                      (if (or (string-equal field-width "")
-          (if change-case
+                              (<= (string-to-number field-width) 2))
-              ""                        ;discourage %z variations
+                          (string-to-number (time-stamp--format "%y" time))
-            (cond ((= alt-form 0)
+                        (time-stamp-conv-warn (format "%%%sy" field-width) "%Y")
-                   (if (string-equal field-width "")
+                        (string-to-number (time-stamp--format "%Y" time)))))
-                       (progn
+                   ((eq cur-char ?Y)    ;4-digit year
-                         (time-stamp-conv-warn "%z" "%#Z")
+                    (string-to-number (time-stamp--format "%Y" time)))
-                         (time-stamp--format "%#Z" time))
+                   ((eq cur-char ?z)    ;time zone offset
-                     (cond ((string-equal field-width "1")
+                    (if change-case
-                            (setq field-width "3")) ;%-z -> "+00"
+                        ""              ;discourage %z variations
-                           ((string-equal field-width "2")
+                      (cond ((= alt-form 0)
-                            (setq field-width "5")) ;%_z -> "+0000"
+                             (if (string-equal field-width "")
-                           ((string-equal field-width "4")
+                                 (progn
-                            (setq field-width "0"))) ;discourage %4z
+                                   (time-stamp-conv-warn "%z" "%#Z")
-                     (time-stamp--format "%z" time)))
+                                   (time-stamp--format "%#Z" time))
-                  ((= alt-form 1)
+                               (cond ((string-equal field-width "1")
-                   (time-stamp--format "%:z" time))
+                                      (setq field-width "3")) ;%-z -> "+00"
-                  ((= alt-form 2)
+                                     ((string-equal field-width "2")
-                   (time-stamp--format "%::z" time))
+                                      (setq field-width "5")) ;%_z -> "+0000"
-                  ((= alt-form 3)
+                                     ((string-equal field-width "4")
-                   (time-stamp--format "%:::z" time)))))
+                                      (setq field-width "0"))) ;discourage %4z
-         ((eq cur-char ?Z)              ;time zone name
+                               (time-stamp--format "%z" time)))
-          (if change-case
+                            ((= alt-form 1)
-              (time-stamp--format "%#Z" time)
+                             (time-stamp--format "%:z" time))
-            (time-stamp--format "%Z" time)))
+                            ((= alt-form 2)
-         ((eq cur-char ?f)              ;buffer-file-name, base name only
+                             (time-stamp--format "%::z" time))
-          (if buffer-file-name
+                            ((= alt-form 3)
-              (file-name-nondirectory buffer-file-name)
+                             (time-stamp--format "%:::z" time)))))
-            time-stamp-no-file))
+                   ((eq cur-char ?Z)    ;time zone name
-         ((eq cur-char ?F)              ;buffer-file-name, full path
+                    (if change-case
-          (or buffer-file-name
+                        (time-stamp--format "%#Z" time)
-              time-stamp-no-file))
+                      (time-stamp--format "%Z" time)))
-         ((eq cur-char ?s)              ;system name, legacy
+                   ((eq cur-char ?f)    ;buffer-file-name, base name only
-          (system-name))
+                    (if buffer-file-name
-         ((eq cur-char ?u)              ;user name, legacy
+                        (file-name-nondirectory buffer-file-name)
-          (user-login-name))
+                      time-stamp-no-file))
-         ((eq cur-char ?U)              ;user full name, legacy
+                   ((eq cur-char ?F)    ;buffer-file-name, full path
-          (user-full-name))
+                    (or buffer-file-name
-         ((eq cur-char ?l)              ;login name
+                        time-stamp-no-file))
-          (user-login-name))
+                   ((eq cur-char ?s)    ;system name, legacy
-         ((eq cur-char ?L)              ;full name of logged-in user
+                    (system-name))
-          (user-full-name))
+                   ((eq cur-char ?u)    ;user name, legacy
-         ((eq cur-char ?h)              ;mail host name
+                    (user-login-name))
-          (or mail-host-address (system-name)))
+                   ((eq cur-char ?U)    ;user full name, legacy
-         ((eq cur-char ?q)              ;unqualified host name
+                    (user-full-name))
-          (let ((qualname (system-name)))
+                   ((eq cur-char ?l)    ;login name
-            (if (string-match "\\." qualname)
+                    (user-login-name))
-                (substring qualname 0 (match-beginning 0))
+                   ((eq cur-char ?L)    ;full name of logged-in user
-              qualname)))
+                    (user-full-name))
-         ((eq cur-char ?Q)              ;fully-qualified host name
+                   ((eq cur-char ?h)    ;mail host name
-          (system-name))
+                    (or mail-host-address (system-name)))
-         ))
+                   ((eq cur-char ?q)    ;unqualified host name
-        (and (numberp field-result)
+                    (let ((qualname (system-name)))
-             (= alt-form 0)
+                      (if (string-match "\\." qualname)
-             (string-equal field-width "")
+                          (substring qualname 0 (match-beginning 0))
-             ;; no width provided; set width for default
+                        qualname)))
-             (setq field-width "02"))
+                   ((eq cur-char ?Q)    ;fully-qualified host name
-        (let ((padded-result
+                    (system-name))
-               (format (format "%%%s%c"
+                   ))
-                               field-width
+            (and (numberp field-result)
-                               (if (numberp field-result) ?d ?s))
+                 (= alt-form 0)
-                       (or field-result ""))))
+                 (string-equal field-width "")
-          (let* ((initial-length (length padded-result))
+                 ;; no width provided; set width for default
-                 (desired-length (if (string-equal field-width "")
+                 (setq field-width "02"))
-                                     initial-length
+            (let ((padded-result
-                                   (string-to-number field-width))))
+                   (format (format "%%%s%c"
-            (if (> initial-length desired-length)
+                                   field-width
-                ;; truncate strings on right
+                                   (if (numberp field-result) ?d ?s))
-                (if (stringp field-result)
+                           (or field-result ""))))
-                    (substring padded-result 0 desired-length)
+              (let* ((initial-length (length padded-result))
-                  padded-result)        ;numbers don't truncate
+                     (desired-length (if (string-equal field-width "")
-              padded-result))))
+                                         initial-length
-       (t
+                                       (string-to-number field-width))))
-        (char-to-string cur-char)))))
+                (if (> initial-length desired-length)
+                    ;; truncate strings on right
+                    (if (stringp field-result)
+                        (substring padded-result 0 desired-length)
+                      padded-result)    ;numbers don't truncate
+                  padded-result)))))
+         (t
+          (char-to-string cur-char)))))
      (setq ind (1+ ind)))
    result))
author	Stephen Gildea	2021-05-30 09:08:08 -0700
committer	Stephen Gildea	2021-05-30 09:11:03 -0700
commit	d6dc66053d846b6fc041889b4d0f383c8dac4da3 (patch)
tree	2204368aad0541f366d364a467ee0bb1ac01aa47
parent	15f46b9669fe93c62b5749e3326d4124188f54cd (diff)
download	emacs-d6dc66053d846b6fc041889b4d0f383c8dac4da3.tar.gz emacs-d6dc66053d846b6fc041889b4d0f383c8dac4da3.zip

diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index b9eab95b232..42455ddfe33 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el
@@ -462,195 +462,201 @@ and all `time-stamp-format' compatibility."
462	(let ((fmt-len (length format))	462	(let ((fmt-len (length format))
463	(ind 0)	463	(ind 0)
464	cur-char	464	cur-char
465	(prev-char nil)	465	(result ""))
466	(result "")
467	field-width
468	field-result
469	alt-form change-case upcase
470	(paren-level 0))
471	(while (< ind fmt-len)	466	(while (< ind fmt-len)
472	(setq cur-char (aref format ind))	467	(setq cur-char (aref format ind))
473	(setq	468	(setq
474	result	469	result
475	(concat result	470	(concat
476	(cond	471	result
477	((eq cur-char ?%)	472	(cond
478	;; eat any additional args to allow for future expansion	473	((eq cur-char ?%)
479	(setq alt-form 0 change-case nil upcase nil field-width "")	474	(let ((prev-char nil)
480	(while (progn	475	(field-width "")
481	(setq ind (1+ ind))	476	field-result
482	(setq cur-char (if (< ind fmt-len)	477	(alt-form 0)
483	(aref format ind)	478	(change-case nil)
484	?\0))	479	(upcase nil)
485	(or (eq ?. cur-char)	480	(paren-level 0))
486	(eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)	481	;; eat any additional args to allow for future expansion
487	(eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char)	482	(while (progn
488	(eq ?\s cur-char) (eq ?# cur-char) (eq ?^ cur-char)	483	(setq ind (1+ ind))
489	(and (eq ?\( cur-char)	484	(setq cur-char (if (< ind fmt-len)
490	(not (eq prev-char ?\\))	485	(aref format ind)
491	(setq paren-level (1+ paren-level)))	486	?\0))
492	(if (and (eq ?\) cur-char)	487	(or (eq ?. cur-char)
		488	(eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)
		489	(eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char)
		490	(eq ?\s cur-char) (eq ?# cur-char) (eq ?^ cur-char)
		491	(and (eq ?\( cur-char)
493	(not (eq prev-char ?\\))	492	(not (eq prev-char ?\\))
494	(> paren-level 0))	493	(setq paren-level (1+ paren-level)))
495	(setq paren-level (1- paren-level))	494	(if (and (eq ?\) cur-char)
496	(and (> paren-level 0)	495	(not (eq prev-char ?\\))
497	(< ind fmt-len)))	496	(> paren-level 0))
498	(if (and (<= ?0 cur-char) (>= ?9 cur-char))	497	(setq paren-level (1- paren-level))
499	;; get format width	498	(and (> paren-level 0)
500	(let ((field-index ind))	499	(< ind fmt-len)))
501	(while (progn	500	(if (and (<= ?0 cur-char) (>= ?9 cur-char))
502	(setq ind (1+ ind))	501	;; get format width
503	(setq cur-char (if (< ind fmt-len)	502	(let ((field-index ind))
504	(aref format ind)	503	(while (progn
505	?\0))	504	(setq ind (1+ ind))
506	(and (<= ?0 cur-char) (>= ?9 cur-char))))	505	(setq cur-char (if (< ind fmt-len)
507	(setq field-width (substring format field-index ind))	506	(aref format ind)
508	(setq ind (1- ind))	507	?\0))
509	t))))	508	(and (<= ?0 cur-char)
510	(setq prev-char cur-char)	509	(>= ?9 cur-char))))
511	;; some characters we actually use	510	(setq field-width
512	(cond ((eq cur-char ?:)	511	(substring format field-index ind))
513	(setq alt-form (1+ alt-form)))	512	(setq ind (1- ind))
514	((eq cur-char ?#)	513	t))))
515	(setq change-case t))	514	(setq prev-char cur-char)
516	((eq cur-char ?^)	515	;; some characters we actually use
517	(setq upcase t))	516	(cond ((eq cur-char ?:)
518	((eq cur-char ?-)	517	(setq alt-form (1+ alt-form)))
519	(setq field-width "1"))	518	((eq cur-char ?#)
520	((eq cur-char ?_)	519	(setq change-case t))
521	(setq field-width "2"))))	520	((eq cur-char ?^)
522	(setq field-result	521	(setq upcase t))
523	(cond	522	((eq cur-char ?-)
524	((eq cur-char ?%)	523	(setq field-width "1"))
525	"%")	524	((eq cur-char ?_)
526	((eq cur-char ?a) ;day of week	525	(setq field-width "2"))))
527	(if (> alt-form 0)	526	(setq field-result
528	(if (string-equal field-width "")	527	(cond
529	(time-stamp--format "%A" time)	528	((eq cur-char ?%)
530	"") ;discourage "%:3a"	529	"%")
531	(if (or change-case upcase)	530	((eq cur-char ?a) ;day of week
532	(time-stamp--format "%#a" time)	531	(if (> alt-form 0)
533	(time-stamp--format "%a" time))))	532	(if (string-equal field-width "")
534	((eq cur-char ?A)	533	(time-stamp--format "%A" time)
535	(if (or change-case upcase (not (string-equal field-width "")))	534	"") ;discourage "%:3a"
536	(time-stamp--format "%#A" time)	535	(if (or change-case upcase)
537	(time-stamp--format "%A" time)))	536	(time-stamp--format "%#a" time)
538	((eq cur-char ?b) ;month name	537	(time-stamp--format "%a" time))))
539	(if (> alt-form 0)	538	((eq cur-char ?A)
540	(if (string-equal field-width "")	539	(if (or change-case upcase (not (string-equal field-width
541	(time-stamp--format "%B" time)	540	"")))
542	"") ;discourage "%:3b"	541	(time-stamp--format "%#A" time)
543	(if (or change-case upcase)	542	(time-stamp--format "%A" time)))
544	(time-stamp--format "%#b" time)	543	((eq cur-char ?b) ;month name
545	(time-stamp--format "%b" time))))	544	(if (> alt-form 0)
546	((eq cur-char ?B)	545	(if (string-equal field-width "")
547	(if (or change-case upcase (not (string-equal field-width "")))	546	(time-stamp--format "%B" time)
548	(time-stamp--format "%#B" time)	547	"") ;discourage "%:3b"
549	(time-stamp--format "%B" time)))	548	(if (or change-case upcase)
550	((eq cur-char ?d) ;day of month, 1-31	549	(time-stamp--format "%#b" time)
551	(time-stamp-do-number cur-char alt-form field-width time))	550	(time-stamp--format "%b" time))))
552	((eq cur-char ?H) ;hour, 0-23	551	((eq cur-char ?B)
553	(time-stamp-do-number cur-char alt-form field-width time))	552	(if (or change-case upcase (not (string-equal field-width
554	((eq cur-char ?I) ;hour, 1-12	553	"")))
555	(time-stamp-do-number cur-char alt-form field-width time))	554	(time-stamp--format "%#B" time)
556	((eq cur-char ?m) ;month number, 1-12	555	(time-stamp--format "%B" time)))
557	(time-stamp-do-number cur-char alt-form field-width time))	556	((eq cur-char ?d) ;day of month, 1-31
558	((eq cur-char ?M) ;minute, 0-59	557	(time-stamp-do-number cur-char alt-form field-width time))
559	(time-stamp-do-number cur-char alt-form field-width time))	558	((eq cur-char ?H) ;hour, 0-23
560	((eq cur-char ?p) ;am or pm	559	(time-stamp-do-number cur-char alt-form field-width time))
561	(if change-case	560	((eq cur-char ?I) ;hour, 1-12
562	(time-stamp--format "%#p" time)	561	(time-stamp-do-number cur-char alt-form field-width time))
563	(time-stamp--format "%p" time)))	562	((eq cur-char ?m) ;month number, 1-12
564	((eq cur-char ?P) ;AM or PM	563	(time-stamp-do-number cur-char alt-form field-width time))
565	(time-stamp--format "%p" time))	564	((eq cur-char ?M) ;minute, 0-59
566	((eq cur-char ?S) ;seconds, 00-60	565	(time-stamp-do-number cur-char alt-form field-width time))
567	(time-stamp-do-number cur-char alt-form field-width time))	566	((eq cur-char ?p) ;am or pm
568	((eq cur-char ?w) ;weekday number, Sunday is 0	567	(if change-case
569	(time-stamp--format "%w" time))	568	(time-stamp--format "%#p" time)
570	((eq cur-char ?y) ;year	569	(time-stamp--format "%p" time)))
571	(if (> alt-form 0)	570	((eq cur-char ?P) ;AM or PM
572	(string-to-number (time-stamp--format "%Y" time))	571	(time-stamp--format "%p" time))
573	(if (or (string-equal field-width "")	572	((eq cur-char ?S) ;seconds, 00-60
574	(<= (string-to-number field-width) 2))	573	(time-stamp-do-number cur-char alt-form field-width time))
575	(string-to-number (time-stamp--format "%y" time))	574	((eq cur-char ?w) ;weekday number, Sunday is 0
576	(time-stamp-conv-warn (format "%%%sy" field-width) "%Y")	575	(time-stamp--format "%w" time))
577	(string-to-number (time-stamp--format "%Y" time)))))	576	((eq cur-char ?y) ;year
578	((eq cur-char ?Y) ;4-digit year	577	(if (> alt-form 0)
579	(string-to-number (time-stamp--format "%Y" time)))	578	(string-to-number (time-stamp--format "%Y" time))
580	((eq cur-char ?z) ;time zone offset	579	(if (or (string-equal field-width "")
581	(if change-case	580	(<= (string-to-number field-width) 2))
582	"" ;discourage %z variations	581	(string-to-number (time-stamp--format "%y" time))
583	(cond ((= alt-form 0)	582	(time-stamp-conv-warn (format "%%%sy" field-width) "%Y")
584	(if (string-equal field-width "")	583	(string-to-number (time-stamp--format "%Y" time)))))
585	(progn	584	((eq cur-char ?Y) ;4-digit year
586	(time-stamp-conv-warn "%z" "%#Z")	585	(string-to-number (time-stamp--format "%Y" time)))
587	(time-stamp--format "%#Z" time))	586	((eq cur-char ?z) ;time zone offset
588	(cond ((string-equal field-width "1")	587	(if change-case
589	(setq field-width "3")) ;%-z -> "+00"	588	"" ;discourage %z variations
590	((string-equal field-width "2")	589	(cond ((= alt-form 0)
591	(setq field-width "5")) ;%_z -> "+0000"	590	(if (string-equal field-width "")
592	((string-equal field-width "4")	591	(progn
593	(setq field-width "0"))) ;discourage %4z	592	(time-stamp-conv-warn "%z" "%#Z")
594	(time-stamp--format "%z" time)))	593	(time-stamp--format "%#Z" time))
595	((= alt-form 1)	594	(cond ((string-equal field-width "1")
596	(time-stamp--format "%:z" time))	595	(setq field-width "3")) ;%-z -> "+00"
597	((= alt-form 2)	596	((string-equal field-width "2")
598	(time-stamp--format "%::z" time))	597	(setq field-width "5")) ;%_z -> "+0000"
599	((= alt-form 3)	598	((string-equal field-width "4")
600	(time-stamp--format "%:::z" time)))))	599	(setq field-width "0"))) ;discourage %4z
601	((eq cur-char ?Z) ;time zone name	600	(time-stamp--format "%z" time)))
602	(if change-case	601	((= alt-form 1)
603	(time-stamp--format "%#Z" time)	602	(time-stamp--format "%:z" time))
604	(time-stamp--format "%Z" time)))	603	((= alt-form 2)
605	((eq cur-char ?f) ;buffer-file-name, base name only	604	(time-stamp--format "%::z" time))
606	(if buffer-file-name	605	((= alt-form 3)
607	(file-name-nondirectory buffer-file-name)	606	(time-stamp--format "%:::z" time)))))
608	time-stamp-no-file))	607	((eq cur-char ?Z) ;time zone name
609	((eq cur-char ?F) ;buffer-file-name, full path	608	(if change-case
610	(or buffer-file-name	609	(time-stamp--format "%#Z" time)
611	time-stamp-no-file))	610	(time-stamp--format "%Z" time)))
612	((eq cur-char ?s) ;system name, legacy	611	((eq cur-char ?f) ;buffer-file-name, base name only
613	(system-name))	612	(if buffer-file-name
614	((eq cur-char ?u) ;user name, legacy	613	(file-name-nondirectory buffer-file-name)
615	(user-login-name))	614	time-stamp-no-file))
616	((eq cur-char ?U) ;user full name, legacy	615	((eq cur-char ?F) ;buffer-file-name, full path
617	(user-full-name))	616	(or buffer-file-name
618	((eq cur-char ?l) ;login name	617	time-stamp-no-file))
619	(user-login-name))	618	((eq cur-char ?s) ;system name, legacy
620	((eq cur-char ?L) ;full name of logged-in user	619	(system-name))
621	(user-full-name))	620	((eq cur-char ?u) ;user name, legacy
622	((eq cur-char ?h) ;mail host name	621	(user-login-name))
623	(or mail-host-address (system-name)))	622	((eq cur-char ?U) ;user full name, legacy
624	((eq cur-char ?q) ;unqualified host name	623	(user-full-name))
625	(let ((qualname (system-name)))	624	((eq cur-char ?l) ;login name
626	(if (string-match "\\." qualname)	625	(user-login-name))
627	(substring qualname 0 (match-beginning 0))	626	((eq cur-char ?L) ;full name of logged-in user
628	qualname)))	627	(user-full-name))
629	((eq cur-char ?Q) ;fully-qualified host name	628	((eq cur-char ?h) ;mail host name
630	(system-name))	629	(or mail-host-address (system-name)))
631	))	630	((eq cur-char ?q) ;unqualified host name
632	(and (numberp field-result)	631	(let ((qualname (system-name)))
633	(= alt-form 0)	632	(if (string-match "\\." qualname)
634	(string-equal field-width "")	633	(substring qualname 0 (match-beginning 0))
635	;; no width provided; set width for default	634	qualname)))
636	(setq field-width "02"))	635	((eq cur-char ?Q) ;fully-qualified host name
637	(let ((padded-result	636	(system-name))
638	(format (format "%%%s%c"	637	))
639	field-width	638	(and (numberp field-result)
640	(if (numberp field-result) ?d ?s))	639	(= alt-form 0)
641	(or field-result ""))))	640	(string-equal field-width "")
642	(let* ((initial-length (length padded-result))	641	;; no width provided; set width for default
643	(desired-length (if (string-equal field-width "")	642	(setq field-width "02"))
644	initial-length	643	(let ((padded-result
645	(string-to-number field-width))))	644	(format (format "%%%s%c"
646	(if (> initial-length desired-length)	645	field-width
647	;; truncate strings on right	646	(if (numberp field-result) ?d ?s))
648	(if (stringp field-result)	647	(or field-result ""))))
649	(substring padded-result 0 desired-length)	648	(let* ((initial-length (length padded-result))
650	padded-result) ;numbers don't truncate	649	(desired-length (if (string-equal field-width "")
651	padded-result))))	650	initial-length
652	(t	651	(string-to-number field-width))))
653	(char-to-string cur-char)))))	652	(if (> initial-length desired-length)
		653	;; truncate strings on right
		654	(if (stringp field-result)
		655	(substring padded-result 0 desired-length)
		656	padded-result) ;numbers don't truncate
		657	padded-result)))))
		658	(t
		659	(char-to-string cur-char)))))
654	(setq ind (1+ ind)))	660	(setq ind (1+ ind)))
655	result))	661	result))
656		662