+ (if (stringp time-stamp-format)
+ (time-stamp-strftime time-stamp-format)
+ (time-stamp-fconcat time-stamp-format " "))) ;version 1 compatibility
+
+(defconst time-stamp-month-numbers
+ '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
+ ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))
+ "Alist of months and their number.")
+
+(defconst time-stamp-month-full-names
+ ["(zero)" "January" "February" "March" "April" "May" "June"
+ "July" "August" "September" "October" "November" "December"])
+
+(defconst time-stamp-weekday-numbers
+ '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
+ ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))
+ "Alist of weekdays and their number.")
+
+(defconst time-stamp-weekday-full-names
+ ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"])
+
+(defun time-stamp-strftime (format &optional time)
+ "Uses a FORMAT to format date, time, file, and user information.
+Optional second argument TIME will be used instead of the current time.
+See the description of the variable `time-stamp-format' for a description
+of the format string."
+ (let ((time-string (cond ((stringp time)
+ time)
+ (time
+ (current-time-string time))
+ (t
+ (current-time-string))))
+ (fmt-len (length format))
+ (ind 0)
+ cur-char
+ (prev-char nil)
+ (result "")
+ field-index
+ field-width
+ field-result
+ (paren-level 0))
+ (while (< ind fmt-len)
+ (setq cur-char (aref format ind))
+ (setq
+ result
+ (concat result
+ (cond
+ ((eq cur-char ?%)
+ (setq field-index (1+ 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))
+ ;; eat any additional args to allow for future expansion
+ (while (or (and (<= ?0 cur-char) (>= ?9 cur-char)) (eq ?. cur-char)
+ (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)
+ (eq ?- cur-char) (eq ?+ 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))))
+ (setq ind (1+ ind))
+ (setq prev-char cur-char)
+ (setq cur-char (if (< ind fmt-len)
+ (aref format ind)
+ ?\0)))
+ (setq field-result
+ (cond
+ ((eq cur-char ?%)
+ "%")
+ ((or (eq cur-char ?a) ;weekday name
+ (eq cur-char ?A))
+ (let ((name
+ (aref time-stamp-weekday-full-names
+ (cdr (assoc (substring time-string 0 3)
+ time-stamp-weekday-numbers)))))
+ (if (eq cur-char ?a)
+ name
+ (upcase name))))
+ ((or (eq cur-char ?b) ;month name
+ (eq cur-char ?B))
+ (let ((name
+ (aref time-stamp-month-full-names
+ (cdr (assoc (substring time-string 4 7)
+ time-stamp-month-numbers)))))
+ (if (eq cur-char ?b)
+ name
+ (upcase name))))
+ ((eq cur-char ?d) ;day of month, 1-31
+ (string-to-int (substring time-string 8 10)))
+ ((eq cur-char ?H) ;hour, 0-23
+ (string-to-int (substring time-string 11 13)))
+ ((eq cur-char ?I) ;hour, 1-12
+ (let ((hour (string-to-int (substring time-string 11 13))))
+ (cond ((< hour 1)
+ (+ hour 12))
+ ((> hour 12)
+ (- hour 12))
+ (t
+ hour))))
+ ((eq cur-char ?m) ;month number, 1-12
+ (cdr (assoc (substring time-string 4 7)
+ time-stamp-month-numbers)))
+ ((eq cur-char ?M) ;minute, 0-59
+ (string-to-int (substring time-string 14 16)))
+ ((or (eq cur-char ?p) ;am or pm
+ (eq cur-char ?P))
+ (let ((name
+ (if (> 12 (string-to-int (substring time-string 11 13)))
+ "am"
+ "pm")))
+ (if (eq cur-char ?p)
+ name
+ (upcase name))))
+ ((eq cur-char ?S) ;seconds, 00-60
+ (string-to-int (substring time-string 17 19)))
+ ((eq cur-char ?w) ;weekday number, Sunday is 0
+ (cdr (assoc (substring time-string 0 3) time-stamp-weekday-numbers)))
+ ((eq cur-char ?y) ;year
+ (string-to-int (substring time-string -4)))
+ ((or (eq cur-char ?z) ;time zone
+ (eq cur-char ?Z))
+ (let ((name
+ (if (fboundp 'current-time-zone)
+ (car (cdr (current-time-zone time))))))
+ (or name (setq name ""))
+ (if (eq cur-char ?z)
+ (downcase name)
+ (upcase name))))
+ ((eq cur-char ?f) ;buffer-file-name, base name only
+ (if buffer-file-name
+ (file-name-nondirectory buffer-file-name)
+ "(no file)"))
+ ((eq cur-char ?F) ;buffer-file-name, full path
+ (or buffer-file-name
+ "(no file)"))
+ ((eq cur-char ?s) ;system name
+ (system-name))
+ ((eq cur-char ?u) ;user name
+ (user-login-name))
+ ((eq cur-char ?h) ;mail host name
+ (time-stamp-mail-host-name))
+ ))
+ (if (string-equal field-width "")
+ field-result
+ (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 (string-to-int field-width)))
+ (if (> initial-length desired-length)
+ ;; truncate strings on right, numbers on left
+ (if (stringp field-result)
+ (substring padded-result 0 desired-length)
+ (substring padded-result (- desired-length)))
+ padded-result)))))
+ (t
+ (char-to-string cur-char)))))
+ (setq ind (1+ ind)))
+ result))
+
+(defun time-stamp-mail-host-name ()
+ "Return the name of the host where the user receives mail.
+This is the value of `mail-host-address' if bound and a string,
+otherwise the value of `time-stamp-mail-host' (for versions of Emacs
+before 19.29) otherwise the value of the function system-name.
+This function may be usefully referenced by `time-stamp-format'."
+ (or (and (boundp 'mail-host-address)
+ (stringp mail-host-address)
+ mail-host-address)
+ (and (boundp 'time-stamp-mail-host) ;for backward compatibility
+ (stringp time-stamp-mail-host)
+ time-stamp-mail-host)
+ (system-name)))
+
+;;; the rest of this file is for version 1 compatibility