Function: time-stamp-string-preprocess
time-stamp-string-preprocess is a byte-compiled function defined in
time-stamp.el.gz.
Signature
(time-stamp-string-preprocess FORMAT &optional TIME)
Documentation
Use a FORMAT to format date, time, file, and user information.
Optional second argument TIME is only for testing.
This is an internal routine implementing extensions to format-time-string
and all time-stamp-format compatibility.
Source Code
;; Defined in /usr/src/emacs/lisp/time-stamp.el.gz
;;; time-stamp is transitioning to be more compatible with format-time-string.
;;; This function implements the differences.
;;; 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
;;; five 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.
This is an internal routine implementing extensions to `format-time-string'
and all `time-stamp-format' compatibility."
(let*
((fmt-len (length format))
(ind 0)
cur-char
(result nil)
(handle-one-conversion
(lambda ()
(let ((prev-char nil)
(field-width "")
field-result
(colon-cnt 0)
(change-case nil)
(title-case nil)
(upcase nil)
(flag-pad-with-spaces nil)
(flag-pad-with-zeros nil)
(flag-minimize nil)
(paren-level 0))
;; eat any additional args to allow for future expansion
(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 ?E cur-char) (eq ?O 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)
(first-digit cur-char))
(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))
(setq cur-char first-digit)
t))))
(setq prev-char cur-char)
;; some characters we actually use
(cond ((eq cur-char ?:)
(setq colon-cnt (1+ colon-cnt)))
((eq cur-char ?#)
(setq change-case t))
((eq cur-char ?^)
(setq upcase t title-case nil change-case nil))
((eq cur-char ?*)
(setq title-case t upcase nil change-case nil))
((eq cur-char ?0)
(setq flag-pad-with-zeros t))
((eq cur-char ?-)
(setq field-width "1" flag-minimize t))
((eq cur-char ?_)
(setq field-width "2" flag-pad-with-spaces t))))
(if (> (string-to-number field-width) 99)
(setq field-width (if flag-pad-with-zeros "099" "99")))
(setq field-result
(cond
((eq cur-char ?%)
"%")
((eq cur-char ?a) ;day of week
(time-stamp-do-letter-case
nil upcase title-case change-case
(if (> colon-cnt 0)
(if (string-equal field-width "")
(time-stamp--format "%A" time)
"") ;discourage "%:3a"
(time-stamp--format "%a" time))))
((eq cur-char ?A)
(cond
((and (>= (string-to-number field-width) 1)
(<= (string-to-number field-width) 3)
(not flag-minimize)
(not flag-pad-with-spaces))
(time-stamp-conv-warn "%3A" "%#a")
(time-stamp--format "%#a" time))
((or (> colon-cnt 0)
change-case upcase title-case
flag-minimize flag-pad-with-spaces
(string-equal field-width ""))
(time-stamp-do-letter-case
nil upcase title-case change-case
(time-stamp--format "%A" time)))
(t (time-stamp-conv-warn (format "%%%sA" field-width)
(format "%%#%sA" field-width)
(format "%%:%sA" field-width))
(time-stamp--format "%#A" time))))
((eq cur-char ?b) ;month name
(time-stamp-do-letter-case
nil upcase title-case change-case
(if (> colon-cnt 0)
(if (string-equal field-width "")
(time-stamp--format "%B" time)
"") ;discourage "%:3b"
(time-stamp--format "%b" time))))
((eq cur-char ?B)
(cond
((and (>= (string-to-number field-width) 1)
(<= (string-to-number field-width) 3)
(not flag-minimize)
(not flag-pad-with-spaces))
(time-stamp-conv-warn "%3B" "%#b")
(time-stamp--format "%#b" time))
((or (> colon-cnt 0)
change-case upcase title-case
flag-minimize flag-pad-with-spaces
(string-equal field-width ""))
(time-stamp-do-letter-case
nil upcase title-case change-case
(time-stamp--format "%B" time)))
(t (time-stamp-conv-warn (format "%%%sB" field-width)
(format "%%#%sB" field-width)
(format "%%:%sB" field-width))
(time-stamp--format "%#B" time))))
((eq cur-char ?d) ;day of month, 1-31
(time-stamp-do-number cur-char colon-cnt field-width time))
((eq cur-char ?H) ;hour, 0-23
(time-stamp-do-number cur-char colon-cnt field-width time))
((eq cur-char ?I) ;hour, 1-12
(time-stamp-do-number cur-char colon-cnt field-width time))
((eq cur-char ?m) ;month number, 1-12
(time-stamp-do-number cur-char colon-cnt field-width time))
((eq cur-char ?M) ;minute, 0-59
(time-stamp-do-number cur-char colon-cnt field-width time))
((eq cur-char ?p) ;AM or PM
(time-stamp-do-letter-case
t upcase title-case change-case
(time-stamp--format "%p" time)))
((eq cur-char ?P) ;AM or PM
(if (and upcase (not change-case))
"" ;discourage inconsistent "%^P"
(time-stamp-do-letter-case
t upcase title-case change-case
(time-stamp--format "%p" time))))
((eq cur-char ?S) ;seconds, 00-60
(time-stamp-do-number cur-char colon-cnt field-width time))
((eq cur-char ?w) ;weekday number, Sunday is 0
(time-stamp--format "%w" time))
((eq cur-char ?y) ;year
(if (= colon-cnt 0)
(if (or (string-equal field-width "")
(<= (string-to-number field-width) 2))
(string-to-number (time-stamp--format "%y" time))
(time-stamp-conv-warn
(format "%%%sy" field-width) "%Y")
(string-to-number (time-stamp--format "%Y" time)))
(time-stamp-conv-warn "%:y" "%Y")
(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 offset
(let ((field-width-num (string-to-number field-width))
;; Handle numeric time zone ourselves, because
;; current-time-zone cannot handle offsets
;; greater than 24 hours.
(offset-secs
(cond ((numberp time-stamp-time-zone)
time-stamp-time-zone)
((and (consp time-stamp-time-zone)
(numberp (car time-stamp-time-zone)))
(car time-stamp-time-zone))
;; interpret text time zone
(t (car (current-time-zone
time time-stamp-time-zone))))))
;; we do our own padding; do not let it be updated further
(setq field-width "")
(cond (change-case
"") ;discourage %z variations
((and (= colon-cnt 0)
(not flag-minimize)
(not flag-pad-with-spaces)
(not flag-pad-with-zeros)
(= field-width-num 0))
(time-stamp-conv-warn "%z" "%#Z" "%5z")
(time-stamp--format "%#Z" time))
(t (time-stamp-formatz-from-parsed-options
flag-minimize
flag-pad-with-spaces
flag-pad-with-zeros
colon-cnt
field-width-num
offset-secs)))))
((eq cur-char ?Z) ;time zone name
(time-stamp-do-letter-case
t upcase title-case change-case
(time-stamp--format "%Z" time)))
((eq cur-char ?f) ;buffer-file-name, base name only
(if buffer-file-name
(time-stamp-filtered-buffer-file-name :nondirectory)
time-stamp-no-file))
((eq cur-char ?F) ;buffer-file-name, absolute name
(if buffer-file-name
(time-stamp-filtered-buffer-file-name :absolute)
time-stamp-no-file))
((eq cur-char ?s) ;system name, legacy
(time-stamp-conv-warn "%s" "%Q")
(time-stamp--system-name :full))
((eq cur-char ?u) ;user name, legacy
(time-stamp-conv-warn "%u" "%l")
(user-login-name))
((eq cur-char ?U) ;user full name, legacy
(time-stamp-conv-warn "%U" "%L")
(user-full-name))
((eq cur-char ?l) ;login name
(user-login-name))
((eq cur-char ?L) ;full name of logged-in user
(user-full-name))
((eq cur-char ?h) ;mail host name
(or mail-host-address (time-stamp--system-name :full)))
((or (eq cur-char ?q) ;unqualified host name
(eq cur-char ?x)) ;short system name, experimental
(time-stamp--system-name :short))
((or (eq cur-char ?Q) ;fully-qualified host name
(eq cur-char ?X)) ;full system name, experimental
(time-stamp--system-name :full))
))
(if (numberp field-result)
(progn
(and (= colon-cnt 0)
(or (string-equal field-width "")
(string-equal field-width "0"))
;; no width provided; set width for default
(setq field-width "02"))
(format (format "%%%sd" field-width)
(or field-result "")))
(let* ((field-width-num (string-to-number field-width))
(needed-padding (- field-width-num
(string-width (or field-result "")))))
(if (> needed-padding 0)
(concat (make-string needed-padding ?\s) field-result)
field-result)))
)))) ;end of handle-one-conversion
;; iterate over the format string
(while (< ind fmt-len)
(setq cur-char (aref format ind))
(push (cond ((eq cur-char ?%)
(funcall handle-one-conversion))
(t
(char-to-string cur-char)))
result)
(setq ind (1+ ind)))
(apply #'concat (nreverse result))))