time-stamp.el 27.1 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2
;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1989, 1993-1995, 1997, 2000-2020 Free Software
4
;; Foundation, Inc.
Erik Naggum's avatar
Erik Naggum committed
5

6 7
;; This file is part of GNU Emacs.

Paul Eggert's avatar
Paul Eggert committed
8
;; Maintainer: Stephen Gildea <stepheng+emacs@gildea.com>
Richard M. Stallman's avatar
Richard M. Stallman committed
9 10
;; Keywords: tools

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
15

Eli Zaretskii's avatar
Eli Zaretskii committed
16
;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
17 18 19 20 21
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
23 24 25

;;; Commentary:

26 27
;; A template in a file can be updated with a new time stamp when
;; you save the file.  For example:
28
;;     static char *ts = "sdmain.c Time-stamp: <2001-08-13 10:20:51 gildea>";
29

30
;; To use time-stamping, add this line to your init file:
31
;;     (add-hook 'before-save-hook 'time-stamp)
32 33 34 35
;; Now any time-stamp templates in your files will be updated automatically.

;; See the documentation for the functions `time-stamp'
;; and `time-stamp-toggle-active' for details.
Erik Naggum's avatar
Erik Naggum committed
36

Richard M. Stallman's avatar
Richard M. Stallman committed
37 38
;;; Code:

39 40 41 42 43
(defgroup time-stamp nil
  "Maintain last change time stamps in files edited by Emacs."
  :group 'data
  :group 'extensions)

44
(defcustom time-stamp-format "%Y-%02m-%02d %02H:%02M:%02S %l"
Lute Kamstra's avatar
Lute Kamstra committed
45
  "Format of the string inserted by \\[time-stamp].
46
This is a string, used verbatim except for character sequences beginning
Dave Love's avatar
Dave Love committed
47
with %, as follows.  The values of non-numeric formatted items depend
48 49
on the locale setting recorded in `system-time-locale' and
`locale-coding-system'.  The examples here are for the default
50
\(`C') locale.
51

52 53 54 55
%:A  weekday name: `Monday'             %#A gives uppercase: `MONDAY'
%3a  abbreviated weekday: `Mon'         %#a gives uppercase: `MON'
%:B  month name: `January'              %#B gives uppercase: `JANUARY'
%3b  abbreviated month: `Jan'           %#b gives uppercase: `JAN'
56 57 58 59 60
%02d day of month
%02H 24-hour clock hour
%02I 12-hour clock hour
%02m month number
%02M minute
61
%#p  `am' or `pm'                       %P  gives uppercase: `AM' or `PM'
62 63
%02S seconds
%w   day number of week, Sunday is 0
64
%02y 2-digit year: `03'                 %Y  4-digit year: `2003'
65 66
%Z   time zone name: `EST'              %#Z gives lowercase: `est'
%5z  time zone offset: `-0500' (since Emacs 27; see note below)
67 68 69

Non-date items:
%%   a literal percent character: `%'
70 71 72
%f   file name without directory        %F  gives absolute pathname
%l   login name                         %L  full name of logged-in user
%q   unqualified host name              %Q  fully-qualified host name
73 74 75
%h   mail host name

Decimal digits between the % and the type character specify the
76
field width.  Strings are truncated on the right.
77
A leading zero in the field width zero-fills a number.
78 79

For example, to get the format used by the `date' command,
80
use \"%3a %3b %2d %02H:%02M:%02S %Z %Y\".
81

82 83 84
The default padding of some formats has changed to be more compatible
with format-time-string.  To be compatible with older versions of Emacs,
specify a padding width (as shown) or use the : modifier to request the
85 86 87 88
transitional behavior (again, as shown).

The behavior of `%5z' is new in Emacs 27.  If your files might be
edited by older versions of Emacs also, do not use this format yet."
89
  :type 'string
90
  :group 'time-stamp
91
  :version "27.1")
92
;;;###autoload(put 'time-stamp-format 'safe-local-variable 'stringp)
93

94
(defcustom time-stamp-active t
Lute Kamstra's avatar
Lute Kamstra committed
95
  "Non-nil to enable time-stamping of buffers by \\[time-stamp].
96
Can be toggled by \\[time-stamp-toggle-active].
97 98 99 100 101 102 103

This option does not affect when `time-stamp' is run, only what it
does when it runs.  To activate automatic time-stamping of buffers
when they are saved, either add this line to your init file:
    (add-hook \\='before-save-hook \\='time-stamp)
or customize option `before-save-hook'.

104 105 106 107 108
See also the variable `time-stamp-warn-inactive'."
  :type 'boolean
  :group 'time-stamp)

(defcustom time-stamp-warn-inactive t
109
  "Have \\[time-stamp] warn if a buffer did not get time-stamped.
110 111 112
If non-nil, a warning is displayed if `time-stamp-active' has
deactivated time stamping and the buffer contains a template that
otherwise would have been updated."
113
  :type 'boolean
114 115
  :group 'time-stamp
  :version "19.29")
116 117

(defcustom time-stamp-time-zone nil
118
  "The time zone to be used by \\[time-stamp].
119
Its format is that of the ZONE argument of the `format-time-string' function."
120 121 122
  :type '(choice (const :tag "Emacs local time" nil)
                 (const :tag "Universal Time" t)
                 (const :tag "system wall clock time" wall)
123 124 125 126 127
                 (string :tag "TZ environment variable value")
                 (list :tag "Offset and name"
                       (integer :tag "Offset (seconds east of UTC)")
                       (string :tag "Time zone abbreviation"))
                 (integer :tag "Offset (seconds east of UTC)"))
128 129
  :group 'time-stamp
  :version "20.1")
130 131 132 133 134 135 136 137 138 139 140 141 142
;;;###autoload(put 'time-stamp-time-zone 'safe-local-variable 'time-stamp-zone-type-p)

;;;###autoload
(defun time-stamp-zone-type-p (zone)
  "Return whether or not ZONE is of the correct type for a timezone rule.
Valid ZONE values are described in the documentation of `format-time-string'."
  (or (memq zone '(nil t wall))
      (stringp zone)
      (and (consp zone)
           (integerp (car zone))
           (consp (cdr zone))
           (stringp (cadr zone)))
      (integerp zone)))
143

144
;;; Do not change time-stamp-line-limit, time-stamp-start,
145 146 147 148
;;; time-stamp-end, time-stamp-pattern, time-stamp-inserts-lines,
;;; or time-stamp-count in your .emacs or you will be incompatible
;;; with other people's files!  If you must change them, do so only
;;; in the local variables section of the file itself.
Richard M. Stallman's avatar
Richard M. Stallman committed
149

150

151
(defvar time-stamp-line-limit 8	    ;Do not change!
152
  "Lines of a file searched; positive counts from start, negative from end.
153 154
The patterns `time-stamp-start' and `time-stamp-end' must be found in
the first (last) `time-stamp-line-limit' lines of the file for the
155 156
file to be time-stamped by \\[time-stamp].  A value of 0 searches the
entire buffer (use with care).
157

158 159 160 161 162 163 164
This value can also be set with the variable `time-stamp-pattern'.

Do not change `time-stamp-line-limit', `time-stamp-start',
`time-stamp-end', or `time-stamp-pattern' for yourself or you will be
incompatible with other people's files!  If you must change them for some
application, do so in the local variables section of the time-stamped file
itself.")
165
;;;###autoload(put 'time-stamp-line-limit 'safe-local-variable 'integerp)
Richard M. Stallman's avatar
Richard M. Stallman committed
166

167
(defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+"    ;Do not change!
Richard M. Stallman's avatar
Richard M. Stallman committed
168
  "Regexp after which the time stamp is written by \\[time-stamp].
169
See also the variables `time-stamp-end' and `time-stamp-line-limit'.
Richard M. Stallman's avatar
Richard M. Stallman committed
170

171 172 173 174 175 176 177
This value can also be set with the variable `time-stamp-pattern'.

Do not change `time-stamp-line-limit', `time-stamp-start',
`time-stamp-end', or `time-stamp-pattern' for yourself or you will be
incompatible with other people's files!  If you must change them for some
application, do so in the local variables section of the time-stamped file
itself.")
178
;;;###autoload(put 'time-stamp-start 'safe-local-variable 'stringp)
Richard M. Stallman's avatar
Richard M. Stallman committed
179

180
(defvar time-stamp-end "\\\\?[\">]"    ;Do not change!
Richard M. Stallman's avatar
Richard M. Stallman committed
181
  "Regexp marking the text after the time stamp.
182
\\[time-stamp] deletes the text between the first match of `time-stamp-start'
183 184
and the following match of `time-stamp-end', then writes the
time stamp specified by `time-stamp-format' between them.
185

186 187
This value can also be set with the variable `time-stamp-pattern'.

188 189 190 191 192 193
The end text normally starts on the same line as the start text ends,
but if there are any newlines in `time-stamp-format', the same number
of newlines must separate the start and end.  \\[time-stamp] tries
to not change the number of lines in the buffer.  `time-stamp-inserts-lines'
controls this behavior.

194
Do not change `time-stamp-start', `time-stamp-end', `time-stamp-pattern',
195
or `time-stamp-inserts-lines' for yourself or you will be incompatible
196 197
with other people's files!  If you must change them for some application,
do so in the local variables section of the time-stamped file itself.")
198
;;;###autoload(put 'time-stamp-end 'safe-local-variable 'stringp)
199

Richard M. Stallman's avatar
Richard M. Stallman committed
200

201
(defvar time-stamp-inserts-lines nil    ;Do not change!
202
  "Whether \\[time-stamp] can change the number of lines in a file.
203 204 205 206 207 208 209 210 211 212 213 214
If nil, \\[time-stamp] skips as many lines as there are newlines in
`time-stamp-format' before looking for the `time-stamp-end' pattern,
thus it tries not to change the number of lines in the buffer.
If non-nil, \\[time-stamp] starts looking for the end pattern
immediately after the start pattern.  This behavior can cause
unexpected changes in the buffer if used carelessly, but it is useful
for generating repeated time stamps.

Do not change `time-stamp-end' or `time-stamp-inserts-lines' for
yourself or you will be incompatible with other people's files!
If you must change them for some application, do so in the local
variables section of the time-stamped file itself.")
215
;;;###autoload(put 'time-stamp-inserts-lines 'safe-local-variable 'symbolp)
216 217 218


(defvar time-stamp-count 1		;Do not change!
219
  "How many templates \\[time-stamp] will look for in a buffer.
220
The same time stamp will be written in each case.
221 222 223 224 225

Do not change `time-stamp-count' for yourself or you will be
incompatible with other people's files!  If you must change it for
some application, do so in the local variables section of the
time-stamped file itself.")
226
;;;###autoload(put 'time-stamp-count 'safe-local-variable 'integerp)
227 228


229
(defvar time-stamp-pattern nil		;Do not change!
230
  "Convenience variable setting all `time-stamp' location and format values.
231
This string has four parts, each of which is optional.
232 233
These four parts set `time-stamp-line-limit', `time-stamp-start',
`time-stamp-format', and `time-stamp-end'.  See the documentation
234 235 236 237
for each of these variables for details.

The first part is a number followed by a slash; the number sets the number
of lines at the beginning (negative counts from end) of the file searched
238
for the time stamp.  The number and the slash may be omitted to use the
239 240 241 242 243
normal value.

The second part is a regexp identifying the pattern preceding the time stamp.
This part may be omitted to use the normal pattern.

244
The third part specifies the format of the time stamp inserted.  See
245
the documentation for `time-stamp-format' for details.  Specify this
246 247 248 249 250
part as \"%%\" to use the normal format.

The fourth part is a regexp identifying the pattern following the time stamp.
This part may be omitted to use the normal pattern.

251
Examples:
252 253 254 255

\"-10/\" (sets only `time-stamp-line-limit')

\"-9/^Last modified: %%$\" (sets `time-stamp-line-limit',
256
`time-stamp-start' and `time-stamp-end')
257

258 259
\"@set Time-stamp: %:B %1d, %Y$\" (sets `time-stamp-start',
`time-stamp-format' and `time-stamp-end')
260

261 262
\"newcommand{\\\\\\\\timestamp}{%%}\" (sets `time-stamp-start'
and `time-stamp-end')
263

264 265 266 267 268
Do not change `time-stamp-pattern' `time-stamp-line-limit',
`time-stamp-start', or `time-stamp-end' for yourself or you will be
incompatible with other people's files!  If you must change them for
some application, do so only in the local variables section of the
time-stamped file itself.")
269
;;;###autoload(put 'time-stamp-pattern 'safe-local-variable 'stringp)
270 271


272

273
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
274
(defun time-stamp ()
275
  "Update the time stamp string(s) in the buffer.
276
A template in a file can be automatically updated with a new time stamp
277
every time you save the file.  Add this line to your init file:
278
    (add-hook \\='before-save-hook \\='time-stamp)
279
or customize option `before-save-hook'.
280 281 282 283 284
Normally the template must appear in the first 8 lines of a file and
look like one of the following:
      Time-stamp: <>
      Time-stamp: \" \"
The time stamp is written between the brackets or quotes:
285
      Time-stamp: <2001-02-18 10:20:51 gildea>
286 287 288 289 290 291 292 293

The time stamp is updated only if the variable
`time-stamp-active' is non-nil.
The format of the time stamp is set by the variable
`time-stamp-pattern' or `time-stamp-format'.
The variables `time-stamp-pattern', `time-stamp-line-limit',
`time-stamp-start', `time-stamp-end', `time-stamp-count', and
`time-stamp-inserts-lines' control finding the template."
Richard M. Stallman's avatar
Richard M. Stallman committed
294
  (interactive)
295
  (let ((line-limit time-stamp-line-limit)
296 297
	(ts-start time-stamp-start)
	(ts-format time-stamp-format)
298 299 300 301 302 303
	(ts-end time-stamp-end)
	(ts-count time-stamp-count)
	(format-lines 0)
	(end-lines 1)
	(start nil)
	search-limit)
304 305
    (if (stringp time-stamp-pattern)
	(progn
306
	  (string-match "\\`\\(\\(-?[0-9]+\\)/\\)?\\([^%]+\\)?\\(\\(%[-.,:@+_ #^()0-9]*[A-Za-z%][^%]*\\)*%[-.,:@+_ #^()0-9]*[A-Za-z%]\\)?\\([^%]+\\)?\\'" time-stamp-pattern)
307 308
	  (and (match-beginning 2)
	       (setq line-limit
309
		     (string-to-number (match-string 2 time-stamp-pattern))))
310 311 312 313 314
	  (and (match-beginning 3)
	       (setq ts-start (match-string 3 time-stamp-pattern)))
	  (and (match-beginning 4)
	       (not (string-equal (match-string 4 time-stamp-pattern) "%%"))
	       (setq ts-format (match-string 4 time-stamp-pattern)))
315 316
	  (and (match-beginning 6)
	       (setq ts-end (match-string 6 time-stamp-pattern)))))
317 318
    (cond ((not (integerp line-limit))
	   (setq line-limit 8)
319
	   (message "time-stamp-line-limit is not an integer")
320
	   (sit-for 1)))
321 322 323 324 325 326 327 328 329
    (cond ((not (integerp ts-count))
	   (setq ts-count 1)
	   (message "time-stamp-count is not an integer")
	   (sit-for 1))
	  ((< ts-count 1)
	   ;; We need to call time-stamp-once at least once
	   ;; to output any warnings about time-stamp not being active.
	   (setq ts-count 1)))
    ;; Figure out what lines the end should be on.
330 331 332 333
    (if (stringp ts-format)
	(let ((nl-start 0))
	  (while (string-match "\n" ts-format nl-start)
	    (setq format-lines (1+ format-lines) nl-start (match-end 0)))))
334 335 336 337
    (let ((nl-start 0))
      (while (string-match "\n" ts-end nl-start)
	(setq end-lines (1+ end-lines) nl-start (match-end 0))))
    ;; Find overall what lines to look at
338 339 340 341 342 343 344
    (save-excursion
      (save-restriction
	(widen)
	(cond ((> line-limit 0)
	       (goto-char (setq start (point-min)))
	       (forward-line line-limit)
	       (setq search-limit (point)))
345
	      ((< line-limit 0)
346 347
	       (goto-char (setq search-limit (point-max)))
	       (forward-line line-limit)
348 349 350
	       (setq start (point)))
	      (t			;0 => no limit (use with care!)
	       (setq start (point-min))
351 352 353 354 355 356 357 358 359 360 361
	       (setq search-limit (point-max))))))
    (while (and start
		(< start search-limit)
		(> ts-count 0))
      (setq start (time-stamp-once start search-limit ts-start ts-end
				   ts-format format-lines end-lines))
      (setq ts-count (1- ts-count))))
  nil)

(defun time-stamp-once (start search-limit ts-start ts-end
			ts-format format-lines end-lines)
362
  "Update one time stamp.  Internal routine called by \\[time-stamp].
363 364 365 366 367 368 369 370 371 372
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)
373
		    (not end)
374
		    (re-search-forward ts-start search-limit 'move))
375
	  (setq start (point))
376 377 378 379 380 381 382 383 384 385 386 387 388 389
	  (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))))))))))))
390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405
    (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)))
406 407 408
	      (if (and (stringp new-time-stamp)
		       (not (string-equal (buffer-substring start end)
					  new-time-stamp)))
409 410 411 412 413 414 415 416
		  (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
417 418 419 420 421 422 423 424
		      (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))))

Richard M. Stallman's avatar
Richard M. Stallman committed
425

426 427
;;;###autoload
(defun time-stamp-toggle-active (&optional arg)
428
  "Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer.
429
With ARG, turn time stamping on if and only if arg is positive."
430 431 432 433 434
  (interactive "P")
  (setq time-stamp-active
	(if (null arg)
	    (not time-stamp-active)
	  (> (prefix-numeric-value arg) 0)))
435 436
  (message "time-stamp is now %s." (if time-stamp-active "active" "off")))

437 438
(defun time-stamp--format (format time)
  (format-time-string format time time-stamp-time-zone))
439

440
(defun time-stamp-string (&optional ts-format time)
441
  "Generate the new string to be inserted by \\[time-stamp].
Eli Zaretskii's avatar
Eli Zaretskii committed
442
Optionally use format TS-FORMAT instead of `time-stamp-format' to
443 444
format the string.  Optional second argument TIME is only for testing;
normally the current time is used."
445
  (if (stringp (or ts-format (setq ts-format time-stamp-format)))
446
      (time-stamp-string-preprocess ts-format time)))
447

448

449 450 451
(defconst time-stamp-no-file "(no file)"
  "String to use when the buffer is not associated with a file.")

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

661
(defun time-stamp-do-number (format-char alt-form field-width time)
Dave Love's avatar
Dave Love committed
662 663 664
  "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."
665
  (let ((format-string (concat "%" (char-to-string format-char))))
666
    (if (and (> alt-form 0) (not (string-equal field-width "")))
667
	""				;discourage "%:2d" and the like
668
      (string-to-number (time-stamp--format format-string time)))))
669 670

(defvar time-stamp-conversion-warn t
671 672
  "Warn about soon-to-be-unsupported forms in `time-stamp-format'.
If nil, these warnings are disabled, which would be a bad idea!
673 674 675
You really need to update your files instead.

The new formats will work with old versions of Emacs.
676 677
New formats are being recommended now to allow `time-stamp-format'
to change in the future to be compatible with `format-time-string'.
678 679 680 681
The new forms being recommended now will continue to work then.")


(defun time-stamp-conv-warn (old-form new-form)
682
  "Display a warning about a soon-to-be-obsolete format.
683
Suggests replacing OLD-FORM with NEW-FORM."
684 685
  (cond
   (time-stamp-conversion-warn
686
    (with-current-buffer (get-buffer-create "*Time-stamp-compatibility*")
687 688 689 690 691
      (goto-char (point-max))
      (if (bobp)
	  (progn
	    (insert
	     "The formats recognized in time-stamp-format will change in a future release\n"
692
	     "to be more compatible with the format-time-string function.\n\n"
693 694 695
	     "The following obsolescent time-stamp-format construct(s) were found:\n\n")))
      (insert "\"" old-form "\" -- use " new-form "\n"))
    (display-buffer "*Time-stamp-compatibility*"))))
696

Richard M. Stallman's avatar
Richard M. Stallman committed
697 698 699
(provide 'time-stamp)

;;; time-stamp.el ends here