Mercurial > hg > xemacs-beta

comparison lisp/packages/time-stamp.el @ 4:b82b59fe008d r19-15b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents 376386a54a3c
children 131b0175ea99
comparison
equal deleted inserted replaced
3:30df88044ec6 4:b82b59fe008d
1 ;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs 1 ;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs
2 ;;; Copyright 1989, 1993 Free Software Foundation, Inc. 2
3 3 ;; Copyright 1989, 1993, 1994, 1995 Free Software Foundation, Inc.
4
5 ;; Maintainer's Time-stamp: <95/12/28 19:48:49 gildea>
4 ;; Maintainer: Stephen Gildea <gildea@lcs.mit.edu> 6 ;; Maintainer: Stephen Gildea <gildea@lcs.mit.edu>
5 ;; Time-stamp: <93/06/20 17:36:04 gildea>
6 ;; Keywords: tools 7 ;; Keywords: tools
7 8
8 ;; This file is free software; you can redistribute it and/or modify 9 ;; XEmacs is free software; you can redistribute it and/or modify it
9 ;; it under the terms of the GNU General Public License as published by 10 ;; under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option) 11 ;; the Free Software Foundation; either version 2, or (at your option)
11 ;; any later version. 12 ;; any later version.
12 13
13 ;; This file is distributed in the hope that it will be useful, 14 ;; XEmacs is distributed in the hope that it will be useful, but
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;; GNU General Public License for more details. 17 ;; General Public License for more details.
17 18
18 ;; You should have received a copy of the GNU General Public License 19 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs; see the file COPYING. If not, write to 20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
20 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
21 22 ;; 02111-1307, USA.
22 ;;; Synched up with: Not synched with FSF. 23
24 ;;; Synched up with: 19.34.
23 25
24 ;;; Commentary: 26 ;;; Commentary:
25 27
26 ;;; If you put a time stamp template anywhere in the first 8 lines of a file, 28 ;; If you put a time stamp template anywhere in the first 8 lines of a file,
27 ;;; it can be updated every time you save the file. See the top of 29 ;; it can be updated every time you save the file. See the top of
28 ;;; time-stamp.el for a sample. The template looks like one of the following: 30 ;; time-stamp.el for a sample. The template looks like one of the following:
29 ;;; Time-stamp: <> 31 ;; Time-stamp: <>
30 ;;; Time-stamp: " " 32 ;; Time-stamp: " "
31 ;;; The time stamp is written between the brackets or quotes, resulting in 33 ;; The time stamp is written between the brackets or quotes, resulting in
32 ;;; Time-stamp: <93/06/18 10:26:51 gildea> 34 ;; Time-stamp: <95/01/18 10:20:51 gildea>
33 ;;; Here is an example which puts the file name and time stamp in the binary: 35 ;; Here is an example that puts the file name and time stamp in the binary:
34 ;;; static char *time_stamp = "sdmain.c Time-stamp: <>"; 36 ;; static char *time_stamp = "sdmain.c Time-stamp: <>";
35 37
36 ;;; To activate automatic time stamping, add this code to your .emacs file: 38 ;; To activate automatic time stamping in GNU Emacs 19, add this code
37 ;;; 39 ;; to your .emacs file:
38 ;;; (autoload 'time-stamp "time-stamp" "Update the time stamp in a buffer." t) 40 ;; (add-hook 'write-file-hooks 'time-stamp)
39 ;;; (if (not (memq 'time-stamp write-file-hooks)) 41 ;;
40 ;;; (setq write-file-hooks 42 ;; In Emacs 18 you will need to do this instead:
41 ;;; (cons 'time-stamp write-file-hooks))) 43 ;; (if (not (memq 'time-stamp write-file-hooks))
44 ;; (setq write-file-hooks
45 ;; (cons 'time-stamp write-file-hooks)))
46 ;; (autoload 'time-stamp "time-stamp" "Update the time stamp in a buffer." t)
47
48 ;; See the documentation for the function `time-stamp' for more details.
42 49
43 ;;; Change Log: 50 ;;; Change Log:
44 51
45 ;;; Originally based on the 19 Dec 88 version of 52 ;; Originally based on the 19 Dec 88 version of
46 ;;; date.el by John Sturdy <mcvax!harlqn.co.uk!jcgs@uunet.uu.net> 53 ;; date.el by John Sturdy <mcvax!harlqn.co.uk!jcgs@uunet.uu.net>
54 ;; version 2, January 1995: replaced functions with %-escapes
55 ;; $Id: time-stamp.el,v 1.1.1.2 1996/12/18 03:53:21 steve Exp $
47 56
48 ;;; Code: 57 ;;; Code:
49 58
50 (defvar time-stamp-active t 59 (defvar time-stamp-active t
51 "*Non-nil to enable time-stamping of files. See the function time-stamp.") 60 "*Non-nil to enable time-stamping of buffers by \\[time-stamp].
52 61 Can be toggled by \\[time-stamp-toggle-active].
53 (defvar time-stamp-format 62 See also the variable time-stamp-warn-inactive.")
54 '(time-stamp-yy/mm/dd time-stamp-hh:mm:ss user-login-name) 63
55 "*A list of functions to call to generate the time stamp string. 64 (defvar time-stamp-warn-inactive t
56 Each element of the list is called as a function and the results are 65 "*Non-nil to have \\[time-stamp] warn if a buffer did not get time-stamped.
57 concatenated together separated by spaces. Elements may also be strings, 66 A warning is printed if time-stamp-active is nil and the buffer contains
58 which are included verbatim. Spaces are not inserted around literal strings.") 67 a time stamp template that would otherwise have been updated.")
68
69 (defvar time-stamp-format "%02y/%02m/%02d %02H:%02M:%02S %u"
70 "*Template for the string inserted by \\[time-stamp].
71 Value may be a string or a list. (Lists are supported only for
72 backward compatibility.) A string is used verbatim except
73 for character sequences beginning with %:
74
75 %a weekday name: `Monday'. %A gives uppercase: `MONDAY'
76 %b month name: `January'. %B gives uppercase: `JANUARY'
77 %d day of month
78 %H 24-hour clock hour
79 %I 12-hour clock hour
80 %m month number
81 %M minute
82 %p `am' or `pm'. %P gives uppercase: `AM' or `PM'
83 %S seconds
84 %w day number of week, Sunday is 0
85 %y year: `1995'
86 %z time zone name: `est'. %Z gives uppercase: `EST'
87
88 Non-date items:
89 %% a literal percent character: `%'
90 %f file name without directory %F gives absolute pathname
91 %s system name
92 %u user's login name
93 %h mail host name
94
95 Decimal digits between the % and the type character specify the
96 field width. Strings are truncated on the right; numbers on the left.
97 A leading zero causes numbers to be zero-filled.
98
99 For example, to get the format used by the `date' command,
100 use \"%3a %3b %2d %02H:%02M:%02S %Z %y\"")
101
59 102
60 ;;; Do not change time-stamp-line-limit, time-stamp-start, or 103 ;;; Do not change time-stamp-line-limit, time-stamp-start, or
61 ;;; time-stamp-end in your .emacs or you will be incompatible 104 ;;; time-stamp-end in your .emacs or you will be incompatible
62 ;;; with other people's files! If you must change them, 105 ;;; with other people's files! If you must change them,
63 ;;; do so only in the local variables section of the file itself. 106 ;;; do so only in the local variables section of the file itself.
64 107
65 (defvar time-stamp-line-limit 8 ;Do not change! See comment above. 108 (defvar time-stamp-line-limit 8 ;Do not change!
66 "Number of lines at the beginning of a file that are searched. 109 "Lines of a file searched; positive counts from start, negative from end.
67 The patterns time-stamp-start and time-stamp-end must be found on one 110 The patterns `time-stamp-start' and `time-stamp-end' must be found on one
68 of the first time-stamp-line-limit lines of the file for the file to 111 of the first (last) `time-stamp-line-limit' lines of the file for the
69 be time-stamped.") 112 file to be time-stamped by \\[time-stamp].
70 113
71 (defvar time-stamp-start "Time-stamp: \\\\?[\"<]+" ;Do not change! 114 Do not change `time-stamp-line-limit', `time-stamp-start', or
72 "Regexp after which the time stamp is written by \\[time-stamp]. 115 `time-stamp-end' for yourself or you will be incompatible
73 See also the variables time-stamp-end and time-stamp-line-limit.
74
75 Do not change time-stamp-line-limit, time-stamp-start, or
76 time-stamp-end for yourself or you will be incompatible
77 with other people's files! If you must change them for some application, 116 with other people's files! If you must change them for some application,
78 do so in the local variables section of the time-stamped file itself.") 117 do so in the local variables section of the time-stamped file itself.")
79 118
80 119
81 (defvar time-stamp-end "\\\\?[\">]" ;Do not change! See comment above. 120 (defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change!
121 "Regexp after which the time stamp is written by \\[time-stamp].
122 See also the variables `time-stamp-end' and `time-stamp-line-limit'.
123
124 Do not change `time-stamp-line-limit', `time-stamp-start', or
125 `time-stamp-end' for yourself or you will be incompatible
126 with other people's files! If you must change them for some application,
127 do so in the local variables section of the time-stamped file itself.")
128
129
130 (defvar time-stamp-end "\\\\?[\">]" ;Do not change!
82 "Regexp marking the text after the time stamp. 131 "Regexp marking the text after the time stamp.
83 \\[time-stamp] deletes the text between the first match of time-stamp-start 132 \\[time-stamp] deletes the text between the first match of `time-stamp-start'
84 \(which see) and the following match of time-stamp-end on the same line, 133 and the following match of `time-stamp-end' on the same line,
85 then writes the time stamp specified by time-stamp-format between them.") 134 then writes the time stamp specified by `time-stamp-format' between them.
135
136 Do not change `time-stamp-line-limit', `time-stamp-start', or
137 `time-stamp-end' for yourself or you will be incompatible
138 with other people's files! If you must change them for some application,
139 do so in the local variables section of the time-stamped file itself.")
140
86 141
87 ;;;###autoload 142 ;;;###autoload
88 (defun time-stamp () 143 (defun time-stamp ()
89 "Update the time stamp string in the buffer. 144 "Update the time stamp string in the buffer.
145 If you put a time stamp template anywhere in the first 8 lines of a file,
146 it can be updated every time you save the file. See the top of
147 `time-stamp.el' for a sample. The template looks like one of the following:
148 Time-stamp: <>
149 Time-stamp: \" \"
150 The time stamp is written between the brackets or quotes, resulting in
151 Time-stamp: <95/01/18 10:20:51 gildea>
90 Only does its thing if the variable time-stamp-active is non-nil. 152 Only does its thing if the variable time-stamp-active is non-nil.
91 Typically used on write-file-hooks for automatic time-stamping. 153 Typically used on write-file-hooks for automatic time-stamping.
92 The format of the time stamp is determined by the variable 154 The format of the time stamp is determined by the variable time-stamp-format.
93 time-stamp-format. The first time-stamp-line-limit lines of the 155 The variables time-stamp-line-limit, time-stamp-start, and time-stamp-end
94 buffer (normally 8) are searched for the time stamp template, 156 control finding the template."
95 and if it is found, a new time stamp is written into it."
96 (interactive) 157 (interactive)
97 (if time-stamp-active 158 (let ((case-fold-search nil)
98 (let ((case-fold-search nil)) 159 (need-to-warn nil)
99 (if (and (stringp time-stamp-start) 160 start search-end)
100 (stringp time-stamp-end)) 161 (if (and (stringp time-stamp-start)
101 (save-excursion 162 (stringp time-stamp-end))
102 (goto-char (point-min)) 163 (save-excursion
103 (if (re-search-forward time-stamp-start 164 (save-restriction
104 (save-excursion 165 (widen)
105 (forward-line time-stamp-line-limit) 166 (if (> time-stamp-line-limit 0)
106 (point)) 167 (progn
107 t) 168 (goto-char (setq start (point-min)))
108 (let ((start (point))) 169 (forward-line time-stamp-line-limit)
109 (if (re-search-forward time-stamp-end 170 (setq search-end (point)))
110 (save-excursion (end-of-line) (point)) 171 (goto-char (setq search-end (point-max)))
111 t) 172 (forward-line time-stamp-line-limit)
112 (let ((end (match-beginning 0))) 173 (setq start (point)))
113 (delete-region start end) 174 (goto-char start)
114 (goto-char start) 175 (while
115 (insert (time-stamp-string)) 176 (and (< (point) search-end)
116 (setq end (point)) 177 (re-search-forward time-stamp-start search-end 'move))
117 ;; remove any tabs used to format the time stamp 178 (setq start (point))
118 (goto-char start) 179 (end-of-line)
119 (if (search-forward "\t" end t) 180 (let ((line-end (point)))
120 (untabify start end))))))) 181 (goto-char start)
121 ;; don't signal an error in a write-file-hook 182 (if (re-search-forward time-stamp-end line-end 'move)
122 (message "time-stamp-start or time-stamp-end is not a string")))) 183 (progn
184 (if time-stamp-active
185 (let ((end (match-beginning 0)))
186 (delete-region start end)
187 (goto-char start)
188 (insert (time-stamp-string))
189 (setq end (point))
190 ;; remove any tabs used to format time stamp
191 (goto-char start)
192 (if (search-forward "\t" end t)
193 (untabify start end)))
194 (if time-stamp-warn-inactive
195 ;; do warning outside save-excursion
196 (setq need-to-warn t)))
197 (setq search-end (point))))))))
198 ;; don't signal an error in a write-file-hook
199 (message "time-stamp-start or time-stamp-end is not a string")
200 (sit-for 1))
201 (if need-to-warn
202 (progn
203 (message "Warning: time-stamp-active is off; did not time-stamp buffer.")
204 (sit-for 1))))
123 ;; be sure to return nil so can be used on write-file-hooks 205 ;; be sure to return nil so can be used on write-file-hooks
124 nil) 206 nil)
125 207
208 ;;;###autoload
209 (defun time-stamp-toggle-active (&optional arg)
210 "Toggle time-stamp-active, setting whether \\[time-stamp] updates a buffer.
211 With arg, turn time stamping on if and only if arg is positive."
212 (interactive "P")
213 (setq time-stamp-active
214 (if (null arg)
215 (not time-stamp-active)
216 (> (prefix-numeric-value arg) 0)))
217 (message "time-stamp is now %s." (if time-stamp-active "active" "off")))
218
219
126 (defun time-stamp-string () 220 (defun time-stamp-string ()
127 "Generate the new string to be inserted by \\[time-stamp]." 221 "Generate the new string to be inserted by \\[time-stamp]."
128 (time-stamp-fconcat time-stamp-format " ")) 222 (if (stringp time-stamp-format)
223 (time-stamp-strftime time-stamp-format)
224 (time-stamp-fconcat time-stamp-format " "))) ;version 1 compatibility
225
226 (defconst time-stamp-month-numbers
227 '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
228 ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))
229 "Alist of months and their number.")
230
231 (defconst time-stamp-month-full-names
232 ["(zero)" "January" "February" "March" "April" "May" "June"
233 "July" "August" "September" "October" "November" "December"])
234
235 (defconst time-stamp-weekday-numbers
236 '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
237 ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))
238 "Alist of weekdays and their number.")
239
240 (defconst time-stamp-weekday-full-names
241 ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"])
242
243 (defconst time-stamp-am-pm '("am" "pm")
244 "List of strings used to denote morning and afternoon.")
245
246 (defconst time-stamp-no-file "(no file)"
247 "String to use when the buffer is not associated with a file.")
248
249 (defun time-stamp-strftime (format &optional time)
250 "Uses a FORMAT to format date, time, file, and user information.
251 Optional second argument TIME will be used instead of the current time.
252 See the description of the variable `time-stamp-format' for a description
253 of the format string."
254 (let ((time-string (cond ((stringp time)
255 time)
256 (time
257 (current-time-string time))
258 (t
259 (current-time-string))))
260 (fmt-len (length format))
261 (ind 0)
262 cur-char
263 (prev-char nil)
264 (result "")
265 field-index
266 field-width
267 field-result
268 (paren-level 0))
269 (while (< ind fmt-len)
270 (setq cur-char (aref format ind))
271 (setq
272 result
273 (concat result
274 (cond
275 ((eq cur-char ?%)
276 (setq field-index (1+ ind))
277 (while (progn
278 (setq ind (1+ ind))
279 (setq cur-char (if (< ind fmt-len)
280 (aref format ind)
281 ?\0))
282 (and (<= ?0 cur-char) (>= ?9 cur-char))))
283 (setq field-width (substring format field-index ind))
284 ;; eat any additional args to allow for future expansion
285 (while (or (and (<= ?0 cur-char) (>= ?9 cur-char)) (eq ?. cur-char)
286 (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)
287 (eq ?- cur-char) (eq ?+ cur-char)
288 (eq ?\ cur-char) (eq ?# cur-char)
289 (and (eq ?\( cur-char)
290 (not (eq prev-char ?\\))
291 (setq paren-level (1+ paren-level)))
292 (if (and (eq ?\) cur-char)
293 (not (eq prev-char ?\\))
294 (> paren-level 0))
295 (setq paren-level (1- paren-level))
296 (and (> paren-level 0)
297 (< ind fmt-len))))
298 (setq ind (1+ ind))
299 (setq prev-char cur-char)
300 (setq cur-char (if (< ind fmt-len)
301 (aref format ind)
302 ?\0)))
303 (setq field-result
304 (cond
305 ((eq cur-char ?%)
306 "%")
307 ((or (eq cur-char ?a) ;weekday name
308 (eq cur-char ?A))
309 (let ((name
310 (aref time-stamp-weekday-full-names
311 (cdr (assoc (substring time-string 0 3)
312 time-stamp-weekday-numbers)))))
313 (if (eq cur-char ?a)
314 name
315 (upcase name))))
316 ((or (eq cur-char ?b) ;month name
317 (eq cur-char ?B))
318 (let ((name
319 (aref time-stamp-month-full-names
320 (cdr (assoc (substring time-string 4 7)
321 time-stamp-month-numbers)))))
322 (if (eq cur-char ?b)
323 name
324 (upcase name))))
325 ((eq cur-char ?d) ;day of month, 1-31
326 (string-to-int (substring time-string 8 10)))
327 ((eq cur-char ?H) ;hour, 0-23
328 (string-to-int (substring time-string 11 13)))
329 ((eq cur-char ?I) ;hour, 1-12
330 (let ((hour (string-to-int (substring time-string 11 13))))
331 (cond ((< hour 1)
332 (+ hour 12))
333 ((> hour 12)
334 (- hour 12))
335 (t
336 hour))))
337 ((eq cur-char ?m) ;month number, 1-12
338 (cdr (assoc (substring time-string 4 7)
339 time-stamp-month-numbers)))
340 ((eq cur-char ?M) ;minute, 0-59
341 (string-to-int (substring time-string 14 16)))
342 ((or (eq cur-char ?p) ;am or pm
343 (eq cur-char ?P))
344 (let ((name
345 (if (> 12 (string-to-int (substring time-string 11 13)))
346 (car time-stamp-am-pm)
347 (car (cdr time-stamp-am-pm)))))
348 (if (eq cur-char ?p)
349 name
350 (upcase name))))
351 ((eq cur-char ?S) ;seconds, 00-60
352 (string-to-int (substring time-string 17 19)))
353 ((eq cur-char ?w) ;weekday number, Sunday is 0
354 (cdr (assoc (substring time-string 0 3) time-stamp-weekday-numbers)))
355 ((eq cur-char ?y) ;year
356 (string-to-int (substring time-string -4)))
357 ((or (eq cur-char ?z) ;time zone
358 (eq cur-char ?Z))
359 (let ((name
360 (if (fboundp 'current-time-zone)
361 (car (cdr (current-time-zone time))))))
362 (or name (setq name ""))
363 (if (eq cur-char ?z)
364 (downcase name)
365 (upcase name))))
366 ((eq cur-char ?f) ;buffer-file-name, base name only
367 (if buffer-file-name
368 (file-name-nondirectory buffer-file-name)
369 time-stamp-no-file))
370 ((eq cur-char ?F) ;buffer-file-name, full path
371 (or buffer-file-name
372 time-stamp-no-file))
373 ((eq cur-char ?s) ;system name
374 (system-name))
375 ((eq cur-char ?u) ;user name
376 (user-login-name))
377 ((eq cur-char ?h) ;mail host name
378 (time-stamp-mail-host-name))
379 ))
380 (if (string-equal field-width "")
381 field-result
382 (let ((padded-result
383 (format (format "%%%s%c"
384 field-width
385 (if (numberp field-result) ?d ?s))
386 (or field-result ""))))
387 (let ((initial-length (length padded-result))
388 (desired-length (string-to-int field-width)))
389 (if (> initial-length desired-length)
390 ;; truncate strings on right, numbers on left
391 (if (stringp field-result)
392 (substring padded-result 0 desired-length)
393 (substring padded-result (- desired-length)))
394 padded-result)))))
395 (t
396 (char-to-string cur-char)))))
397 (setq ind (1+ ind)))
398 result))
399
400 (defun time-stamp-mail-host-name ()
401 "Return the name of the host where the user receives mail.
402 This is the value of `mail-host-address' if bound and a string,
403 otherwise the value of `time-stamp-mail-host' (for versions of Emacs
404 before 19.29) otherwise the value of the function system-name."
405 (or (and (boundp 'mail-host-address)
406 (stringp mail-host-address)
407 mail-host-address)
408 (and (boundp 'time-stamp-mail-host) ;for backward compatibility
409 (stringp time-stamp-mail-host)
410 time-stamp-mail-host)
411 (system-name)))
412
413 ;;; the rest of this file is for version 1 compatibility
129 414
130 (defun time-stamp-fconcat (list sep) 415 (defun time-stamp-fconcat (list sep)
131 "Similar to (mapconcat 'funcall LIST SEP) but LIST can have literals. 416 "Similar to (mapconcat 'funcall LIST SEP) but LIST allows literals.
132 If an element of LIST is a symbol, it is funcalled to get the string to use; 417 If an element of LIST is a symbol, it is funcalled to get the string to use;
133 the separator SEP is used between two strings obtained by funcalling a 418 the separator SEP is used between two strings obtained by funcalling a
134 symbol. Otherwise the element itself is inserted; no separator is used 419 symbol. Otherwise the element itself is inserted; no separator is used
135 around literals." 420 around literals."
136 (let ((return-string "") 421 (let ((return-string "")
146 (setq insert-sep-p nil))) 431 (setq insert-sep-p nil)))
147 (setq list (cdr list))) 432 (setq list (cdr list)))
148 return-string)) 433 return-string))
149 434
150 435
151 (defconst time-stamp-month-numbers
152 '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
153 ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))
154 "Assoc list of months and their number.")
155
156 (defconst time-stamp-month-full-names
157 ["(zero)" "January" "February" "March" "April" "May" "June"
158 "July" "August" "September" "October" "November" "December"])
159
160 (defvar time-stamp-mail-host nil
161 "Name of the host where the user receives mail.
162 See the function time-stamp-mail-host-name.")
163
164 ;;; Some useful functions to use in time-stamp-format 436 ;;; Some useful functions to use in time-stamp-format
165 437
166 ;;; Could generate most of a message-id with 438 ;;; Could generate most of a message-id with
167 ;;; '(yymmdd "" hhmm "@" mail-host-name) 439 ;;; '(time-stamp-yymmdd "" time-stamp-hhmm "@" time-stamp-mail-host-name)
168
169 (defun time-stamp-mail-host-name ()
170 "Return the name of the host where the user receives mail.
171 This is the value of time-stamp-mail-host if bound and a string,
172 otherwise the value of the function system-name."
173 (or (and (boundp 'time-stamp-mail-host)
174 (stringp time-stamp-mail-host)
175 time-stamp-mail-host)
176 (system-name)))
177
178 (defun time-stamp-current-year ()
179 "Return the current year as a four-character string."
180 (substring (current-time-string) -4))
181 440
182 ;;; pretty form, suitable for a title page 441 ;;; pretty form, suitable for a title page
183 442
184 (defun time-stamp-month-dd-yyyy () 443 (defun time-stamp-month-dd-yyyy ()
185 "Return the current date as a string in \"Month dd, yyyy\" form." 444 "Return the current date as a string in \"Month DD, YYYY\" form."
186 (let ((date (current-time-string))) 445 (let ((date (current-time-string)))
187 (format "%s %02d, %s" 446 (format "%s %d, %s"
188 (aref time-stamp-month-full-names 447 (aref time-stamp-month-full-names
189 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))) 448 (cdr (assoc (substring date 4 7) time-stamp-month-numbers)))
190 (string-to-int (substring date 8 10)) 449 (string-to-int (substring date 8 10))
191 (substring date -4)))) 450 (substring date -4))))
192 451
193 ;;; same as __DATE__ in ANSI C 452 ;;; same as __DATE__ in ANSI C
194 453
195 (defun time-stamp-mon-dd-yyyy () 454 (defun time-stamp-mon-dd-yyyy ()
196 "Return the current date as a string in \"Mon dd yyyy\" form. 455 "Return the current date as a string in \"Mon DD YYYY\" form.
197 The first character of dd is Space if the value is less than 10." 456 The first character of DD is space if the value is less than 10."
198 (let ((date (current-time-string))) 457 (let ((date (current-time-string)))
199 (format "%s %2d %s" 458 (format "%s %2d %s"
200 (substring date 4 7) 459 (substring date 4 7)
201 (string-to-int (substring date 8 10)) 460 (string-to-int (substring date 8 10))
202 (substring date -4)))) 461 (substring date -4))))
203 462
204 ;;; RFC 822 date 463 ;;; RFC 822 date
205 464
206 (defun time-stamp-dd-mon-yy () 465 (defun time-stamp-dd-mon-yy ()
207 "Return the current date as a string in \"dd Mon yy\" form." 466 "Return the current date as a string in \"DD Mon YY\" form."
208 (let ((date (current-time-string))) 467 (let ((date (current-time-string)))
209 (format "%02d %s %s" 468 (format "%02d %s %s"
210 (string-to-int (substring date 8 10)) 469 (string-to-int (substring date 8 10))
211 (substring date 4 7) 470 (substring date 4 7)
212 (substring date -2)))) 471 (substring date -2))))
213 472
214 ;;; RCS 3 date 473 ;;; RCS 3 date
215 474
216 (defun time-stamp-yy/mm/dd () 475 (defun time-stamp-yy/mm/dd ()
217 "Return the current date as a string in \"yy/mm/dd\" form." 476 "Return the current date as a string in \"YY/MM/DD\" form."
218 (let ((date (current-time-string))) 477 (let ((date (current-time-string)))
219 (format "%s/%02d/%02d" 478 (format "%s/%02d/%02d"
220 (substring date -2) 479 (substring date -2)
221 (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) 480 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
222 (string-to-int (substring date 8 10))))) 481 (string-to-int (substring date 8 10)))))
223 482
224 ;;; RCS 5 date 483 ;;; RCS 5 date
225 484
226 (defun time-stamp-yyyy/mm/dd () 485 (defun time-stamp-yyyy/mm/dd ()
227 "Return the current date as a string in \"yyyy/mm/dd\" form." 486 "Return the current date as a string in \"YYYY/MM/DD\" form."
228 (let ((date (current-time-string))) 487 (let ((date (current-time-string)))
229 (format "%s/%02d/%02d" 488 (format "%s/%02d/%02d"
230 (substring date -4) 489 (substring date -4)
231 (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) 490 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
232 (string-to-int (substring date 8 10))))) 491 (string-to-int (substring date 8 10)))))
233 492
493 ;;; ISO 8601 date
494
495 (defun time-stamp-yyyy-mm-dd ()
496 "Return the current date as a string in \"YYYY-MM-DD\" form."
497 (let ((date (current-time-string)))
498 (format "%s-%02d-%02d"
499 (substring date -4)
500 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
501 (string-to-int (substring date 8 10)))))
502
234 (defun time-stamp-yymmdd () 503 (defun time-stamp-yymmdd ()
235 "Return the current date as a string in \"yymmdd\" form." 504 "Return the current date as a string in \"YYMMDD\" form."
236 (let ((date (current-time-string))) 505 (let ((date (current-time-string)))
237 (format "%s%02d%02d" 506 (format "%s%02d%02d"
238 (substring date -2) 507 (substring date -2)
239 (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) 508 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
240 (string-to-int (substring date 8 10))))) 509 (string-to-int (substring date 8 10)))))
241 510
242 (defun time-stamp-dd/mm/yy ()
243 "Return the current date as a string in \"dd/mm/yy\" form."
244 (let ((date (current-time-string)))
245 (format "%02d/%02d/%s"
246 (string-to-int (substring date 8 10))
247 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
248 (substring date -2))))
249
250 (defun time-stamp-mm/dd/yy ()
251 "Return the current date as a string in \"mm/dd/yy\" form."
252 (let ((date (current-time-string)))
253 (format "%02d/%02d/%s"
254 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
255 (string-to-int (substring date 8 10))
256 (substring date -2))))
257
258 (defun time-stamp-hh:mm:ss () 511 (defun time-stamp-hh:mm:ss ()
259 "Return the current time as a string in \"hh:mm:ss\" form." 512 "Return the current time as a string in \"HH:MM:SS\" form."
260 (substring (current-time-string) 11 19)) 513 (substring (current-time-string) 11 19))
261 514
262 (defun time-stamp-hh:mm ()
263 "Return the current time as a string in \"hh:mm\" form."
264 (substring (current-time-string) 11 16))
265
266 (defun time-stamp-hhmm () 515 (defun time-stamp-hhmm ()
267 "Return the current time as a string in \"hhmm\" form." 516 "Return the current time as a string in \"HHMM\" form."
268 (let ((date (current-time-string))) 517 (let ((date (current-time-string)))
269 (concat (substring date 11 13) 518 (concat (substring date 11 13)
270 (substring date 14 16)))) 519 (substring date 14 16))))
271 520
272 (provide 'time-stamp) 521 (provide 'time-stamp)