Fix up comment convention on the arch-tag lines.
[bpt/emacs.git] / lisp / time-stamp.el
CommitLineData
9565745a 1;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs
9565745a 2
0d30b337 3;; Copyright (C) 1989, 1993, 1994, 1995, 1997, 2000, 2001, 2002, 2003,
409cc4a3 4;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
b578f267 5
e8af40ee
PJ
6;; This file is part of GNU Emacs.
7
97ee303a 8;; Maintainer's Time-stamp: <2006-04-12 20:30:56 rms>
e602e779 9;; Maintainer: Stephen Gildea <gildea@stop.mail-abuse.org>
9565745a
RS
10;; Keywords: tools
11
12b309f1 12;; GNU Emacs is free software; you can redistribute it and/or modify
9565745a 13;; it under the terms of the GNU General Public License as published by
b4aa6026 14;; the Free Software Foundation; either version 3, or (at your option)
9565745a
RS
15;; any later version.
16
7490a1e4 17;; GNU Emacs is distributed in the hope that it will be useful,
9565745a
RS
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
b578f267 23;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
9565745a
RS
26
27;;; Commentary:
28
03d7856a
KH
29;; A template in a file can be updated with a new time stamp when
30;; you save the file. For example:
33128c29 31;; static char *ts = "sdmain.c Time-stamp: <2001-08-13 10:20:51 gildea>";
03d7856a
KH
32;; See the top of `time-stamp.el' for another example.
33
34;; To use time-stamping, add this line to your .emacs file:
66c6d25e 35;; (add-hook 'before-save-hook 'time-stamp)
03d7856a
KH
36;; Now any time-stamp templates in your files will be updated automatically.
37
38;; See the documentation for the functions `time-stamp'
39;; and `time-stamp-toggle-active' for details.
b578f267 40
9565745a
RS
41;;; Code:
42
cb35a83c
RS
43(defgroup time-stamp nil
44 "Maintain last change time stamps in files edited by Emacs."
45 :group 'data
46 :group 'extensions)
47
fd72ddf6 48(defcustom time-stamp-format "%:y-%02m-%02d %02H:%02M:%02S %u"
03d7856a 49 "*Format of the string inserted by \\[time-stamp].
c9c0e4bb
RS
50The value may be a string or a list. Lists are supported only for
51backward compatibility; see variable `time-stamp-old-format-warn'.
f8d35bf3 52
22453b51
DL
53A string is used verbatim except for character sequences beginning
54with %, as follows. The values of non-numeric formatted items depend
ef080b16
EZ
55on the locale setting recorded in `system-time-locale' and
56`locale-coding-system'. The examples here are for the default
4b70b30b 57\(`C') locale.
fd72ddf6
RS
58
59%:a weekday name: `Monday'. %#A gives uppercase: `MONDAY'
60%3a abbreviated weekday: `Mon'. %3A gives uppercase: `MON'
61%:b month name: `January'. %#B gives uppercase: `JANUARY'
62%3b abbreviated month: `Jan'. %3B gives uppercase: `JAN'
63%02d day of month
64%02H 24-hour clock hour
65%02I 12-hour clock hour
66%02m month number
67%02M minute
68%#p `am' or `pm'. %P gives uppercase: `AM' or `PM'
69%02S seconds
70%w day number of week, Sunday is 0
33128c29 71%02y 2-digit year: `03' %:y 4-digit year: `2003'
fd72ddf6
RS
72%z time zone name: `est'. %Z gives uppercase: `EST'
73
74Non-date items:
75%% a literal percent character: `%'
76%f file name without directory %F gives absolute pathname
77%s system name
f7769aa5 78%u user's login name %U user's full name
fd72ddf6
RS
79%h mail host name
80
81Decimal digits between the % and the type character specify the
82field width. Strings are truncated on the right; years on the left.
55ac4d11 83A leading zero in the field width zero-fills a number.
622b7ede
RS
84
85For example, to get the format used by the `date' command,
fd72ddf6
RS
86use \"%3a %3b %2d %02H:%02M:%02S %Z %:y\".
87
55ac4d11 88In the future these formats will be aligned more with `format-time-string'.
fd72ddf6
RS
89Because of this transition, the default padding for numeric formats will
90change in a future version. Therefore either a padding width should be
91specified, or the : modifier should be used to explicitly request the
92historical default."
cb35a83c 93 :type 'string
33128c29
SG
94 :group 'time-stamp
95 :version "20.1")
97ee303a 96;;;###autoload(put 'time-stamp-format 'safe-local-variable 'stringp)
03d7856a 97
95772e85
RS
98(defcustom time-stamp-active t
99 "*Non-nil to enable time-stamping of buffers by \\[time-stamp].
100Can be toggled by \\[time-stamp-toggle-active].
101See also the variable `time-stamp-warn-inactive'."
102 :type 'boolean
103 :group 'time-stamp)
104
105(defcustom time-stamp-warn-inactive t
3b5e21df 106 "Have \\[time-stamp] warn if a buffer did not get time-stamped.
33128c29
SG
107If non-nil, a warning is displayed if `time-stamp-active' has
108deactivated time stamping and the buffer contains a template that
109otherwise would have been updated."
95772e85 110 :type 'boolean
33128c29
SG
111 :group 'time-stamp
112 :version "19.29")
95772e85
RS
113
114(defcustom time-stamp-old-format-warn 'ask
3b5e21df 115 "Action if `time-stamp-format' is an old-style list.
95772e85
RS
116If `error', the format is not used. If `ask', the user is queried about
117using the time-stamp-format. If `warn', a warning is displayed.
118If nil, no notification is given."
0a8052bd
GM
119 :type '(choice (const :tag "Don't use the format" error)
120 (const ask)
121 (const warn)
122 (const :tag "No notification" nil))
95772e85
RS
123 :group 'time-stamp)
124
125(defcustom time-stamp-time-zone nil
126 "If non-nil, a string naming the timezone to be used by \\[time-stamp].
127Format is the same as that used by the environment variable TZ on your system."
7967f8ab 128 :type '(choice (const nil) string)
33128c29
SG
129 :group 'time-stamp
130 :version "20.1")
65b332b1 131;;;###autoload(put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p)
622b7ede 132
b4b33e01 133;;; Do not change time-stamp-line-limit, time-stamp-start,
55ac4d11
KH
134;;; time-stamp-end, time-stamp-pattern, time-stamp-inserts-lines,
135;;; or time-stamp-count in your .emacs or you will be incompatible
136;;; with other people's files! If you must change them, do so only
137;;; in the local variables section of the file itself.
9565745a 138
03d7856a 139
e1f40b28 140(defvar time-stamp-line-limit 8 ;Do not change!
c7c4ddd4 141 "Lines of a file searched; positive counts from start, negative from end.
55ac4d11
KH
142The patterns `time-stamp-start' and `time-stamp-end' must be found in
143the first (last) `time-stamp-line-limit' lines of the file for the
f7769aa5
RS
144file to be time-stamped by \\[time-stamp]. A value of 0 searches the
145entire buffer (use with care).
e1f40b28 146
0ec63318
SG
147This value can also be set with the variable `time-stamp-pattern'.
148
149Do not change `time-stamp-line-limit', `time-stamp-start',
150`time-stamp-end', or `time-stamp-pattern' for yourself or you will be
151incompatible with other people's files! If you must change them for some
152application, do so in the local variables section of the time-stamped file
153itself.")
97ee303a 154;;;###autoload(put 'time-stamp-line-limit 'safe-local-variable 'integerp)
9565745a 155
36081614 156(defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change!
9565745a 157 "Regexp after which the time stamp is written by \\[time-stamp].
e1f40b28 158See also the variables `time-stamp-end' and `time-stamp-line-limit'.
9565745a 159
0ec63318
SG
160This value can also be set with the variable `time-stamp-pattern'.
161
162Do not change `time-stamp-line-limit', `time-stamp-start',
163`time-stamp-end', or `time-stamp-pattern' for yourself or you will be
164incompatible with other people's files! If you must change them for some
165application, do so in the local variables section of the time-stamped file
166itself.")
72c0b9b8 167;;;###autoload(put 'time-stamp-start 'safe-local-variable 'stringp)
9565745a 168
e1f40b28 169(defvar time-stamp-end "\\\\?[\">]" ;Do not change!
9565745a 170 "Regexp marking the text after the time stamp.
e1f40b28 171\\[time-stamp] deletes the text between the first match of `time-stamp-start'
55ac4d11
KH
172and the following match of `time-stamp-end', then writes the
173time stamp specified by `time-stamp-format' between them.
e1f40b28 174
0ec63318
SG
175This value can also be set with the variable `time-stamp-pattern'.
176
55ac4d11
KH
177The end text normally starts on the same line as the start text ends,
178but if there are any newlines in `time-stamp-format', the same number
179of newlines must separate the start and end. \\[time-stamp] tries
180to not change the number of lines in the buffer. `time-stamp-inserts-lines'
181controls this behavior.
182
0ec63318 183Do not change `time-stamp-start', `time-stamp-end', `time-stamp-pattern',
55ac4d11 184or `time-stamp-inserts-lines' for yourself or you will be incompatible
e1f40b28
RS
185with other people's files! If you must change them for some application,
186do so in the local variables section of the time-stamped file itself.")
72c0b9b8 187;;;###autoload(put 'time-stamp-end 'safe-local-variable 'stringp)
e1f40b28 188
9565745a 189
55ac4d11 190(defvar time-stamp-inserts-lines nil ;Do not change!
33128c29 191 "Whether \\[time-stamp] can change the number of lines in a file.
55ac4d11
KH
192If nil, \\[time-stamp] skips as many lines as there are newlines in
193`time-stamp-format' before looking for the `time-stamp-end' pattern,
194thus it tries not to change the number of lines in the buffer.
195If non-nil, \\[time-stamp] starts looking for the end pattern
196immediately after the start pattern. This behavior can cause
197unexpected changes in the buffer if used carelessly, but it is useful
198for generating repeated time stamps.
199
200Do not change `time-stamp-end' or `time-stamp-inserts-lines' for
201yourself or you will be incompatible with other people's files!
202If you must change them for some application, do so in the local
203variables section of the time-stamped file itself.")
72c0b9b8 204;;;###autoload(put 'time-stamp-inserts-lines 'safe-local-variable 'symbolp)
55ac4d11
KH
205
206
207(defvar time-stamp-count 1 ;Do not change!
3b5e21df 208 "How many templates \\[time-stamp] will look for in a buffer.
33128c29 209The same time stamp will be written in each case.
55ac4d11
KH
210
211Do not change `time-stamp-count' for yourself or you will be
212incompatible with other people's files! If you must change it for
213some application, do so in the local variables section of the
214time-stamped file itself.")
97ee303a 215;;;###autoload(put 'time-stamp-count 'safe-local-variable 'integerp)
55ac4d11
KH
216
217
33128c29 218(defvar time-stamp-pattern nil ;Do not change!
55ac4d11 219 "Convenience variable setting all `time-stamp' location and format values.
b4b33e01 220This string has four parts, each of which is optional.
55ac4d11
KH
221These four parts set `time-stamp-line-limit', `time-stamp-start',
222`time-stamp-format', and `time-stamp-end'. See the documentation
b4b33e01
RS
223for each of these variables for details.
224
225The first part is a number followed by a slash; the number sets the number
226of lines at the beginning (negative counts from end) of the file searched
33128c29 227for the time stamp. The number and the slash may be omitted to use the
b4b33e01
RS
228normal value.
229
230The second part is a regexp identifying the pattern preceding the time stamp.
231This part may be omitted to use the normal pattern.
232
33128c29 233The third part specifies the format of the time stamp inserted. See
55ac4d11 234the documentation for `time-stamp-format' for details. Specify this
b4b33e01
RS
235part as \"%%\" to use the normal format.
236
237The fourth part is a regexp identifying the pattern following the time stamp.
238This part may be omitted to use the normal pattern.
239
33128c29
SG
240Examples:
241\"-10/\"
242\"-9/^Last modified: %%$\"
243\"@set Time-stamp: %:b %:d, %:y$\"
244\"newcommand{\\\\\\\\timestamp}{%%}\"
b4b33e01 245
0ec63318
SG
246Do not change `time-stamp-pattern' `time-stamp-line-limit',
247`time-stamp-start', or `time-stamp-end' for yourself or you will be
248incompatible with other people's files! If you must change them for
249some application, do so only in the local variables section of the
250time-stamped file itself.")
97ee303a 251;;;###autoload(put 'time-stamp-pattern 'safe-local-variable 'stringp)
b4b33e01
RS
252
253
03d7856a 254
59b644e8 255;;;###autoload
9565745a 256(defun time-stamp ()
55ac4d11 257 "Update the time stamp string(s) in the buffer.
03d7856a
KH
258A template in a file can be automatically updated with a new time stamp
259every time you save the file. Add this line to your .emacs file:
66c6d25e 260 (add-hook 'before-save-hook 'time-stamp)
26f643c2 261or customize `before-save-hook' through Custom.
03d7856a
KH
262Normally the template must appear in the first 8 lines of a file and
263look like one of the following:
264 Time-stamp: <>
265 Time-stamp: \" \"
266The time stamp is written between the brackets or quotes:
33128c29 267 Time-stamp: <2001-02-18 10:20:51 gildea>
622b7ede 268The time stamp is updated only if the variable `time-stamp-active' is non-nil.
0ec63318
SG
269The format of the time stamp is set by the variable `time-stamp-pattern' or
270`time-stamp-format'. The variables `time-stamp-pattern',
271`time-stamp-line-limit', `time-stamp-start', `time-stamp-end',
272`time-stamp-count', and `time-stamp-inserts-lines' control finding
273the template."
9565745a 274 (interactive)
55ac4d11 275 (let ((line-limit time-stamp-line-limit)
b4b33e01
RS
276 (ts-start time-stamp-start)
277 (ts-format time-stamp-format)
55ac4d11
KH
278 (ts-end time-stamp-end)
279 (ts-count time-stamp-count)
280 (format-lines 0)
281 (end-lines 1)
282 (start nil)
283 search-limit)
b4b33e01
RS
284 (if (stringp time-stamp-pattern)
285 (progn
33128c29 286 (string-match "\\`\\(\\(-?[0-9]+\\)/\\)?\\([^%]+\\)?\\(\\(%[-.,:@+_ #^()0-9]*[A-Za-z%][^%]*\\)*%[-.,:@+_ #^()0-9]*[A-Za-z%]\\)?\\([^%]+\\)?\\'" time-stamp-pattern)
b4b33e01
RS
287 (and (match-beginning 2)
288 (setq line-limit
027a4b6b 289 (string-to-number (match-string 2 time-stamp-pattern))))
b4b33e01
RS
290 (and (match-beginning 3)
291 (setq ts-start (match-string 3 time-stamp-pattern)))
292 (and (match-beginning 4)
293 (not (string-equal (match-string 4 time-stamp-pattern) "%%"))
294 (setq ts-format (match-string 4 time-stamp-pattern)))
15ceaba4
KH
295 (and (match-beginning 6)
296 (setq ts-end (match-string 6 time-stamp-pattern)))))
622b7ede
RS
297 (cond ((not (integerp line-limit))
298 (setq line-limit 8)
b4b33e01 299 (message "time-stamp-line-limit is not an integer")
622b7ede 300 (sit-for 1)))
55ac4d11
KH
301 (cond ((not (integerp ts-count))
302 (setq ts-count 1)
303 (message "time-stamp-count is not an integer")
304 (sit-for 1))
305 ((< ts-count 1)
306 ;; We need to call time-stamp-once at least once
307 ;; to output any warnings about time-stamp not being active.
308 (setq ts-count 1)))
309 ;; Figure out what lines the end should be on.
3b5e21df
GM
310 (if (stringp ts-format)
311 (let ((nl-start 0))
312 (while (string-match "\n" ts-format nl-start)
313 (setq format-lines (1+ format-lines) nl-start (match-end 0)))))
55ac4d11
KH
314 (let ((nl-start 0))
315 (while (string-match "\n" ts-end nl-start)
316 (setq end-lines (1+ end-lines) nl-start (match-end 0))))
317 ;; Find overall what lines to look at
622b7ede
RS
318 (save-excursion
319 (save-restriction
320 (widen)
321 (cond ((> line-limit 0)
322 (goto-char (setq start (point-min)))
323 (forward-line line-limit)
324 (setq search-limit (point)))
f7769aa5 325 ((< line-limit 0)
622b7ede
RS
326 (goto-char (setq search-limit (point-max)))
327 (forward-line line-limit)
f7769aa5
RS
328 (setq start (point)))
329 (t ;0 => no limit (use with care!)
330 (setq start (point-min))
55ac4d11
KH
331 (setq search-limit (point-max))))))
332 (while (and start
333 (< start search-limit)
334 (> ts-count 0))
335 (setq start (time-stamp-once start search-limit ts-start ts-end
336 ts-format format-lines end-lines))
337 (setq ts-count (1- ts-count))))
55ac4d11
KH
338 nil)
339
340(defun time-stamp-once (start search-limit ts-start ts-end
341 ts-format format-lines end-lines)
33128c29 342 "Update one time stamp. Internal routine called by \\[time-stamp].
55ac4d11
KH
343Returns the end point, which is where `time-stamp' begins the next search."
344 (let ((case-fold-search nil)
345 (end nil)
346 end-search-start
347 (end-length nil))
348 (save-excursion
349 (save-restriction
350 (widen)
351 ;; Find the location of the time stamp.
352 (while (and (< (goto-char start) search-limit)
622b7ede 353 (not end)
b4b33e01 354 (re-search-forward ts-start search-limit 'move))
622b7ede 355 (setq start (point))
55ac4d11
KH
356 (if (not time-stamp-inserts-lines)
357 (forward-line format-lines))
358 (setq end-search-start (max start (point)))
359 (if (= (forward-line end-lines) 0)
360 (progn
361 (and (bolp) (backward-char))
362 (let ((line-end (min (point) search-limit)))
363 (if (>= line-end end-search-start)
364 (progn
365 (goto-char end-search-start)
366 (if (re-search-forward ts-end line-end t)
367 (progn
368 (setq end (match-beginning 0))
369 (setq end-length (- (match-end 0) end))))))))))))
b4b33e01
RS
370 (if end
371 (progn
372 ;; do all warnings outside save-excursion
373 (cond
374 ((not time-stamp-active)
375 (if time-stamp-warn-inactive
376 ;; don't signal an error in a write-file-hook
377 (progn
378 (message "Warning: time-stamp-active is off; did not time-stamp buffer.")
379 (sit-for 1))))
380 ((not (and (stringp ts-start)
381 (stringp ts-end)))
382 (message "time-stamp-start or time-stamp-end is not a string")
383 (sit-for 1))
384 (t
385 (let ((new-time-stamp (time-stamp-string ts-format)))
f7769aa5
RS
386 (if (and (stringp new-time-stamp)
387 (not (string-equal (buffer-substring start end)
388 new-time-stamp)))
b4b33e01
RS
389 (save-excursion
390 (save-restriction
391 (widen)
392 (delete-region start end)
393 (goto-char start)
394 (insert-and-inherit new-time-stamp)
395 (setq end (point))
396 ;; remove any tabs used to format time stamp
55ac4d11
KH
397 (if (search-backward "\t" start t)
398 (progn
399 (untabify start end)
400 (setq end (point))))))))))))
401 ;; return the location after this time stamp, if there was one
402 (and end end-length
403 (+ end end-length))))
404
9565745a 405
b1defad2
RS
406;;;###autoload
407(defun time-stamp-toggle-active (&optional arg)
03d7856a 408 "Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer.
33128c29 409With ARG, turn time stamping on if and only if arg is positive."
b1defad2
RS
410 (interactive "P")
411 (setq time-stamp-active
412 (if (null arg)
413 (not time-stamp-active)
414 (> (prefix-numeric-value arg) 0)))
55ac4d11
KH
415 (message "time-stamp is now %s." (if time-stamp-active "active" "off")))
416
417
418(defun time-stamp-string (&optional ts-format)
419 "Generate the new string to be inserted by \\[time-stamp].
e7b0deaf
EZ
420Optionally use format TS-FORMAT instead of `time-stamp-format' to
421format the string."
55ac4d11
KH
422 (or ts-format
423 (setq ts-format time-stamp-format))
424 (if (stringp ts-format)
425 (if (stringp time-stamp-time-zone)
426 (let ((ts-real-time-zone (getenv "TZ")))
427 (unwind-protect
428 (progn
33128c29 429 (set-time-zone-rule time-stamp-time-zone)
55ac4d11
KH
430 (format-time-string
431 (time-stamp-string-preprocess ts-format)))
33128c29 432 (set-time-zone-rule ts-real-time-zone)))
55ac4d11
KH
433 (format-time-string
434 (time-stamp-string-preprocess ts-format)))
435 ;; handle version 1 compatibility
436 (cond ((or (eq time-stamp-old-format-warn 'error)
437 (and (eq time-stamp-old-format-warn 'ask)
438 (not (y-or-n-p "Use non-string time-stamp-format? "))))
439 (message "Warning: no time-stamp: time-stamp-format not a string")
440 (sit-for 1)
441 nil)
442 (t
443 (cond ((eq time-stamp-old-format-warn 'warn)
444 (message "Obsolescent time-stamp-format type; should be string")
445 (sit-for 1)))
446 (time-stamp-fconcat ts-format " ")))))
03d7856a 447
6946129c
RS
448(defconst time-stamp-no-file "(no file)"
449 "String to use when the buffer is not associated with a file.")
450
fd72ddf6
RS
451;;; time-stamp is transitioning to using the new, expanded capabilities
452;;; of format-time-string. During the process, this function implements
453;;; intermediate, compatible formats and complains about old, soon to
454;;; be unsupported, formats. This function will get a lot (a LOT) shorter
455;;; when the transition is complete and we can just pass most things
456;;; straight through to format-time-string.
457;;; At all times, all the formats recommended in the doc string
458;;; of time-stamp-format will work not only in the current version of
459;;; Emacs, but in all versions that have been released within the past
460;;; two years.
461;;; The : modifier is a temporary conversion feature used to resolve
462;;; ambiguous formats--formats that are changing (over time) incompatibly.
463(defun time-stamp-string-preprocess (format &optional time)
22453b51
DL
464 "Use a FORMAT to format date, time, file, and user information.
465Optional second argument TIME is only for testing.
466Implements non-time extensions to `format-time-string'
33128c29 467and all `time-stamp-format' compatibility."
fd72ddf6
RS
468 (let ((fmt-len (length format))
469 (ind 0)
470 cur-char
471 (prev-char nil)
472 (result "")
fd72ddf6
RS
473 field-width
474 field-result
475 alt-form change-case require-padding
476 (paren-level 0))
477 (while (< ind fmt-len)
478 (setq cur-char (aref format ind))
479 (setq
480 result
481 (concat result
482 (cond
483 ((eq cur-char ?%)
484 ;; eat any additional args to allow for future expansion
15ceaba4 485 (setq alt-form nil change-case nil require-padding nil field-width "")
fd72ddf6
RS
486 (while (progn
487 (setq ind (1+ ind))
488 (setq cur-char (if (< ind fmt-len)
489 (aref format ind)
490 ?\0))
491 (or (eq ?. cur-char)
492 (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)
22453b51 493 (eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char)
fe15c2c6 494 (eq ?\s cur-char) (eq ?# cur-char) (eq ?^ cur-char)
fd72ddf6
RS
495 (and (eq ?\( cur-char)
496 (not (eq prev-char ?\\))
497 (setq paren-level (1+ paren-level)))
498 (if (and (eq ?\) cur-char)
499 (not (eq prev-char ?\\))
500 (> paren-level 0))
501 (setq paren-level (1- paren-level))
502 (and (> paren-level 0)
15ceaba4
KH
503 (< ind fmt-len)))
504 (if (and (<= ?0 cur-char) (>= ?9 cur-char))
505 ;; get format width
506 (let ((field-index ind))
507 (while (progn
508 (setq ind (1+ ind))
509 (setq cur-char (if (< ind fmt-len)
510 (aref format ind)
511 ?\0))
512 (and (<= ?0 cur-char) (>= ?9 cur-char))))
513 (setq field-width (substring format field-index ind))
514 (setq ind (1- ind))
515 t))))
fd72ddf6
RS
516 (setq prev-char cur-char)
517 ;; some characters we actually use
518 (cond ((eq cur-char ?:)
519 (setq alt-form t))
520 ((eq cur-char ?#)
521 (setq change-case t))))
fd72ddf6
RS
522 (setq field-result
523 (cond
524 ((eq cur-char ?%)
55ac4d11 525 "%%")
fd72ddf6
RS
526 ((eq cur-char ?a) ;day of week
527 (if change-case
0c68e5de 528 (format-time-string "%#a" time)
fd72ddf6
RS
529 (or alt-form (not (string-equal field-width ""))
530 (time-stamp-conv-warn "%a" "%:a"))
531 (if (and alt-form (not (string-equal field-width "")))
532 "" ;discourage "%:3a"
533 (format-time-string "%A" time))))
534 ((eq cur-char ?A)
535 (if alt-form
536 (format-time-string "%A" time)
537 (or change-case (not (string-equal field-width ""))
538 (time-stamp-conv-warn "%A" "%#A"))
539 (format-time-string "%#A" time)))
540 ((eq cur-char ?b) ;month name
541 (if change-case
0c68e5de 542 (format-time-string "%#b" time)
fd72ddf6
RS
543 (or alt-form (not (string-equal field-width ""))
544 (time-stamp-conv-warn "%b" "%:b"))
545 (if (and alt-form (not (string-equal field-width "")))
546 "" ;discourage "%:3b"
547 (format-time-string "%B" time))))
548 ((eq cur-char ?B)
549 (if alt-form
550 (format-time-string "%B" time)
551 (or change-case (not (string-equal field-width ""))
552 (time-stamp-conv-warn "%B" "%#B"))
553 (format-time-string "%#B" time)))
554 ((eq cur-char ?d) ;day of month, 1-31
fdac7fba 555 (time-stamp-do-number cur-char alt-form field-width time))
fd72ddf6 556 ((eq cur-char ?H) ;hour, 0-23
fdac7fba 557 (time-stamp-do-number cur-char alt-form field-width time))
fd72ddf6 558 ((eq cur-char ?I) ;hour, 1-12
fdac7fba 559 (time-stamp-do-number cur-char alt-form field-width time))
fd72ddf6 560 ((eq cur-char ?m) ;month number, 1-12
fdac7fba 561 (time-stamp-do-number cur-char alt-form field-width time))
fd72ddf6 562 ((eq cur-char ?M) ;minute, 0-59
fdac7fba 563 (time-stamp-do-number cur-char alt-form field-width time))
fd72ddf6
RS
564 ((eq cur-char ?p) ;am or pm
565 (or change-case
566 (time-stamp-conv-warn "%p" "%#p"))
567 (format-time-string "%#p" time))
568 ((eq cur-char ?P) ;AM or PM
569 (format-time-string "%p" time))
570 ((eq cur-char ?S) ;seconds, 00-60
fdac7fba 571 (time-stamp-do-number cur-char alt-form field-width time))
fd72ddf6
RS
572 ((eq cur-char ?w) ;weekday number, Sunday is 0
573 (format-time-string "%w" time))
574 ((eq cur-char ?y) ;year
575 (or alt-form (not (string-equal field-width ""))
576 (time-stamp-conv-warn "%y" "%:y"))
027a4b6b 577 (string-to-number (format-time-string "%Y" time)))
fd72ddf6 578 ((eq cur-char ?Y) ;4-digit year, new style
027a4b6b 579 (string-to-number (format-time-string "%Y" time)))
fd72ddf6
RS
580 ((eq cur-char ?z) ;time zone lower case
581 (if change-case
582 "" ;discourage %z variations
583 (format-time-string "%#Z" time)))
584 ((eq cur-char ?Z)
585 (if change-case
586 (format-time-string "%#Z" time)
587 (format-time-string "%Z" time)))
588 ((eq cur-char ?f) ;buffer-file-name, base name only
589 (if buffer-file-name
590 (file-name-nondirectory buffer-file-name)
591 time-stamp-no-file))
592 ((eq cur-char ?F) ;buffer-file-name, full path
593 (or buffer-file-name
594 time-stamp-no-file))
595 ((eq cur-char ?s) ;system name
596 (system-name))
597 ((eq cur-char ?u) ;user name
598 (user-login-name))
2c8d5749
RS
599 ((eq cur-char ?U) ;user full name
600 (user-full-name))
55ac4d11
KH
601 ((eq cur-char ?l) ;logname (undocumented user name alt)
602 (user-login-name))
603 ((eq cur-char ?L) ;(undocumented alt user full name)
604 (user-full-name))
fd72ddf6
RS
605 ((eq cur-char ?h) ;mail host name
606 (time-stamp-mail-host-name))
0ec63318
SG
607 ((eq cur-char ?q) ;(undocumented unqual hostname)
608 (let ((qualname (system-name)))
609 (if (string-match "\\." qualname)
610 (substring qualname 0 (match-beginning 0))
611 qualname)))
612 ((eq cur-char ?Q) ;(undocumented fully-qualified host)
613 (system-name))
fd72ddf6 614 ))
b6735035
GM
615 (let ((padded-result
616 (format (format "%%%s%c"
617 field-width
618 (if (numberp field-result) ?d ?s))
619 (or field-result ""))))
620 (let* ((initial-length (length padded-result))
621 (desired-length (if (string-equal field-width "")
622 initial-length
027a4b6b 623 (string-to-number field-width))))
b6735035
GM
624 (if (> initial-length desired-length)
625 ;; truncate strings on right, years on left
626 (if (stringp field-result)
627 (substring padded-result 0 desired-length)
628 (if (eq cur-char ?y)
629 (substring padded-result (- desired-length))
630 padded-result)) ;non-year numbers don't truncate
631 padded-result))))
fd72ddf6
RS
632 (t
633 (char-to-string cur-char)))))
634 (setq ind (1+ ind)))
635 result))
636
fdac7fba 637(defun time-stamp-do-number (format-char alt-form field-width time)
22453b51
DL
638 "Handle compatible FORMAT-CHAR where only default width/padding will change.
639ALT-FORM is whether `#' specified. FIELD-WIDTH is the string
640width specification or \"\". TIME is the time to convert."
fd72ddf6
RS
641 (let ((format-string (concat "%" (char-to-string format-char))))
642 (and (not alt-form) (string-equal field-width "")
643 (time-stamp-conv-warn format-string
644 (format "%%:%c" format-char)))
645 (if (and alt-form (not (string-equal field-width "")))
646 "" ;discourage "%:2d" and the like
027a4b6b 647 (string-to-number (format-time-string format-string time)))))
fd72ddf6
RS
648
649(defvar time-stamp-conversion-warn t
3b5e21df
GM
650 "Warn about soon-to-be-unsupported forms in `time-stamp-format'.
651If nil, these warnings are disabled, which would be a bad idea!
fd72ddf6
RS
652You really need to update your files instead.
653
654The new formats will work with old versions of Emacs.
55ac4d11
KH
655New formats are being recommended now to allow `time-stamp-format'
656to change in the future to be compatible with `format-time-string'.
fd72ddf6
RS
657The new forms being recommended now will continue to work then.")
658
659
660(defun time-stamp-conv-warn (old-form new-form)
33128c29
SG
661 "Display a warning about a soon-to-be-obsolete format.
662Suggests replacing OLD-FORM with NEW-FORM."
fd72ddf6
RS
663 (cond
664 (time-stamp-conversion-warn
665 (save-excursion
666 (set-buffer (get-buffer-create "*Time-stamp-compatibility*"))
667 (goto-char (point-max))
668 (if (bobp)
669 (progn
670 (insert
671 "The formats recognized in time-stamp-format will change in a future release\n"
672 "to be compatible with the new, expanded format-time-string function.\n\n"
673 "The following obsolescent time-stamp-format construct(s) were found:\n\n")))
674 (insert "\"" old-form "\" -- use " new-form "\n"))
675 (display-buffer "*Time-stamp-compatibility*"))))
95772e85 676
fd72ddf6 677
b1defad2 678
b1defad2
RS
679(defun time-stamp-mail-host-name ()
680 "Return the name of the host where the user receives mail.
681This is the value of `mail-host-address' if bound and a string,
55ac4d11 682otherwise the value of the function `system-name'."
b1defad2
RS
683 (or (and (boundp 'mail-host-address)
684 (stringp mail-host-address)
685 mail-host-address)
b1defad2
RS
686 (system-name)))
687
688;;; the rest of this file is for version 1 compatibility
9565745a
RS
689
690(defun time-stamp-fconcat (list sep)
e1f40b28 691 "Similar to (mapconcat 'funcall LIST SEP) but LIST allows literals.
9565745a
RS
692If an element of LIST is a symbol, it is funcalled to get the string to use;
693the separator SEP is used between two strings obtained by funcalling a
694symbol. Otherwise the element itself is inserted; no separator is used
695around literals."
696 (let ((return-string "")
697 (insert-sep-p nil))
698 (while list
699 (cond ((symbolp (car list))
700 (if insert-sep-p
701 (setq return-string (concat return-string sep)))
702 (setq return-string (concat return-string (funcall (car list))))
703 (setq insert-sep-p t))
704 (t
705 (setq return-string (concat return-string (car list)))
706 (setq insert-sep-p nil)))
707 (setq list (cdr list)))
708 return-string))
709
03d7856a 710;;; Some functions used in time-stamp-format
9565745a 711
33128c29 712;;; These functions have been obsolete since 1995
8589dc17 713;;; and will be removed in Emacs 23.
33128c29 714;;; Meanwhile, discourage other packages from using them.
8d4bf0e5
JB
715(dolist (function '(time-stamp-month-dd-yyyy time-stamp-dd/mm/yyyy
716 time-stamp-mon-dd-yyyy time-stamp-dd-mon-yy
717 time-stamp-yy/mm/dd time-stamp-yyyy/mm/dd
718 time-stamp-yyyy-mm-dd time-stamp-yymmdd
719 time-stamp-hh:mm:ss time-stamp-hhmm))
720 (make-obsolete function
721 "use `time-stamp-string' or `format-time-string' instead."
722 "20.1"))
9565745a 723
9565745a
RS
724;;; pretty form, suitable for a title page
725
726(defun time-stamp-month-dd-yyyy ()
e1f40b28 727 "Return the current date as a string in \"Month DD, YYYY\" form."
b8944601 728 (format-time-string "%B %e, %Y"))
9565745a 729
b24173f7
RS
730(defun time-stamp-dd/mm/yyyy ()
731 "Return the current date as a string in \"DD/MM/YYYY\" form."
b8944601 732 (format-time-string "%d/%m/%Y"))
b24173f7 733
9565745a
RS
734;;; same as __DATE__ in ANSI C
735
736(defun time-stamp-mon-dd-yyyy ()
e1f40b28
RS
737 "Return the current date as a string in \"Mon DD YYYY\" form.
738The first character of DD is space if the value is less than 10."
b8944601 739 (format-time-string "%b %d %Y"))
9565745a
RS
740
741;;; RFC 822 date
742
743(defun time-stamp-dd-mon-yy ()
e1f40b28 744 "Return the current date as a string in \"DD Mon YY\" form."
b8944601 745 (format-time-string "%d %b %y"))
9565745a
RS
746
747;;; RCS 3 date
748
749(defun time-stamp-yy/mm/dd ()
e1f40b28 750 "Return the current date as a string in \"YY/MM/DD\" form."
b8944601 751 (format-time-string "%y/%m/%d"))
9565745a
RS
752
753;;; RCS 5 date
754
755(defun time-stamp-yyyy/mm/dd ()
e1f40b28 756 "Return the current date as a string in \"YYYY/MM/DD\" form."
b8944601 757 (format-time-string "%Y/%m/%d"))
9565745a 758
e1f40b28 759;;; ISO 8601 date
9565745a 760
e1f40b28
RS
761(defun time-stamp-yyyy-mm-dd ()
762 "Return the current date as a string in \"YYYY-MM-DD\" form."
b8944601 763 (format-time-string "%Y-%m-%d"))
9565745a 764
e1f40b28
RS
765(defun time-stamp-yymmdd ()
766 "Return the current date as a string in \"YYMMDD\" form."
b8944601 767 (format-time-string "%y%m%d"))
9565745a
RS
768
769(defun time-stamp-hh:mm:ss ()
e1f40b28 770 "Return the current time as a string in \"HH:MM:SS\" form."
b8944601 771 (format-time-string "%T"))
9565745a 772
9565745a 773(defun time-stamp-hhmm ()
e1f40b28 774 "Return the current time as a string in \"HHMM\" form."
b8944601 775 (format-time-string "%H%M"))
9565745a
RS
776
777(provide 'time-stamp)
778
cbee283d 779;; arch-tag: 8a12c5c3-25d6-4a71-adc5-24b0e025a1e7
9565745a 780;;; time-stamp.el ends here