+(defun time-stamp-once (start search-limit ts-start ts-end
+ ts-format format-lines end-lines)
+ "Update one time stamp. Internal routine called by \\[time-stamp].
+Returns the end point, which is where `time-stamp' begins the next search."
+ (let ((case-fold-search nil)
+ (end nil)
+ end-search-start
+ (end-length nil))
+ (save-excursion
+ (save-restriction
+ (widen)
+ ;; Find the location of the time stamp.
+ (while (and (< (goto-char start) search-limit)
+ (not end)
+ (re-search-forward ts-start search-limit 'move))
+ (setq start (point))
+ (if (not time-stamp-inserts-lines)
+ (forward-line format-lines))
+ (setq end-search-start (max start (point)))
+ (if (= (forward-line end-lines) 0)
+ (progn
+ (and (bolp) (backward-char))
+ (let ((line-end (min (point) search-limit)))
+ (if (>= line-end end-search-start)
+ (progn
+ (goto-char end-search-start)
+ (if (re-search-forward ts-end line-end t)
+ (progn
+ (setq end (match-beginning 0))
+ (setq end-length (- (match-end 0) end))))))))))))
+ (if end
+ (progn
+ ;; do all warnings outside save-excursion
+ (cond
+ ((not time-stamp-active)
+ (if time-stamp-warn-inactive
+ ;; don't signal an error in a write-file-hook
+ (progn
+ (message "Warning: time-stamp-active is off; did not time-stamp buffer.")
+ (sit-for 1))))
+ ((not (and (stringp ts-start)
+ (stringp ts-end)))
+ (message "time-stamp-start or time-stamp-end is not a string")
+ (sit-for 1))
+ (t
+ (let ((new-time-stamp (time-stamp-string ts-format)))
+ (if (and (stringp new-time-stamp)
+ (not (string-equal (buffer-substring start end)
+ new-time-stamp)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (delete-region start end)
+ (goto-char start)
+ (insert-and-inherit new-time-stamp)
+ (setq end (point))
+ ;; remove any tabs used to format time stamp
+ (if (search-backward "\t" start t)
+ (progn
+ (untabify start end)
+ (setq end (point))))))))))))
+ ;; return the location after this time stamp, if there was one
+ (and end end-length
+ (+ end end-length))))
+
+
+;;;###autoload
+(defun time-stamp-toggle-active (&optional arg)
+ "Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer.
+With ARG, turn time stamping on if and only if arg is positive."
+ (interactive "P")
+ (setq time-stamp-active
+ (if (null arg)
+ (not time-stamp-active)
+ (> (prefix-numeric-value arg) 0)))
+ (message "time-stamp is now %s." (if time-stamp-active "active" "off")))
+
+
+(defun time-stamp-string (&optional ts-format)
+ "Generate the new string to be inserted by \\[time-stamp].
+Optionally use format TS-FORMAT instead of `time-stamp-format' to
+format the string."
+ (or ts-format
+ (setq ts-format time-stamp-format))
+ (if (stringp ts-format)
+ (if (stringp time-stamp-time-zone)
+ (let ((ts-real-time-zone (getenv "TZ")))
+ (unwind-protect
+ (progn
+ (set-time-zone-rule time-stamp-time-zone)
+ (format-time-string
+ (time-stamp-string-preprocess ts-format)))
+ (set-time-zone-rule ts-real-time-zone)))
+ (format-time-string
+ (time-stamp-string-preprocess ts-format)))
+ ;; handle version 1 compatibility
+ (cond ((or (eq time-stamp-old-format-warn 'error)
+ (and (eq time-stamp-old-format-warn 'ask)
+ (not (y-or-n-p "Use non-string time-stamp-format? "))))
+ (message "Warning: no time-stamp: time-stamp-format not a string")
+ (sit-for 1)
+ nil)
+ (t
+ (cond ((eq time-stamp-old-format-warn 'warn)
+ (message "Obsolescent time-stamp-format type; should be string")
+ (sit-for 1)))
+ (time-stamp-fconcat ts-format " ")))))
+
+(defconst time-stamp-no-file "(no file)"
+ "String to use when the buffer is not associated with a file.")
+
+;;; 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 require-padding
+ (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 require-padding 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 ?\ 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
+ (format-time-string "%#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"
+ (format-time-string "%A" time))))
+ ((eq cur-char ?A)
+ (if alt-form
+ (format-time-string "%A" time)
+ (or change-case (not (string-equal field-width ""))
+ (time-stamp-conv-warn "%A" "%#A"))
+ (format-time-string "%#A" time)))
+ ((eq cur-char ?b) ;month name
+ (if change-case
+ (format-time-string "%#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"
+ (format-time-string "%B" time))))
+ ((eq cur-char ?B)
+ (if alt-form
+ (format-time-string "%B" time)
+ (or change-case (not (string-equal field-width ""))
+ (time-stamp-conv-warn "%B" "%#B"))
+ (format-time-string "%#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"))
+ (format-time-string "%#p" time))
+ ((eq cur-char ?P) ;AM or PM
+ (format-time-string "%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
+ (format-time-string "%w" time))
+ ((eq cur-char ?y) ;year
+ (or alt-form (not (string-equal field-width ""))
+ (time-stamp-conv-warn "%y" "%:y"))
+ (string-to-int (format-time-string "%Y" time)))
+ ((eq cur-char ?Y) ;4-digit year, new style
+ (string-to-int (format-time-string "%Y" time)))
+ ((eq cur-char ?z) ;time zone lower case
+ (if change-case
+ "" ;discourage %z variations
+ (format-time-string "%#Z" time)))
+ ((eq cur-char ?Z)
+ (if change-case
+ (format-time-string "%#Z" time)
+ (format-time-string "%Z" time)))
+ ((eq cur-char ?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
+ 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
+ (time-stamp-mail-host-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-int 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))
+
+(defun time-stamp-do-number (format-char alt-form field-width time)
+ "Handle compatible FORMAT-CHAR where only default width/padding will change.
+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-int (format-time-string format-string time)))))
+
+(defvar time-stamp-conversion-warn t
+ "Warn about soon-to-be-unsupported forms in `time-stamp-format'.
+If nil, these warnings are disabled, which would be a bad idea!
+You really need to update your files instead.
+
+The new formats will work with old versions of Emacs.
+New formats are being recommended now to allow `time-stamp-format'
+to change in the future to be compatible with `format-time-string'.
+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."
+ (cond
+ (time-stamp-conversion-warn
+ (save-excursion
+ (set-buffer (get-buffer-create "*Time-stamp-compatibility*"))
+ (goto-char (point-max))
+ (if (bobp)
+ (progn
+ (insert
+ "The formats recognized in time-stamp-format will change in a future release\n"
+ "to be compatible with the new, expanded format-time-string function.\n\n"
+ "The following obsolescent time-stamp-format construct(s) were found:\n\n")))
+ (insert "\"" old-form "\" -- use " new-form "\n"))
+ (display-buffer "*Time-stamp-compatibility*"))))
+
+
+
+(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 the function `system-name'."
+ (or (and (boundp 'mail-host-address)
+ (stringp mail-host-address)
+ mail-host-address)
+ (system-name)))
+
+;;; the rest of this file is for version 1 compatibility