Mercurial > hg > xemacs-beta

comparison lisp/packages/time-stamp.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents b82b59fe008d
children b9518feda344
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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 2 ;;; Copyright 1989, 1993 Free Software Foundation, Inc.
3 ;; Copyright 1989, 1993, 1994, 1995 Free Software Foundation, Inc. 3
4
5 ;; Maintainer's Time-stamp: <95/12/28 19:48:49 gildea>
6 ;; Maintainer: Stephen Gildea <gildea@lcs.mit.edu> 4 ;; Maintainer: Stephen Gildea <gildea@lcs.mit.edu>
5 ;; Time-stamp: <93/06/20 17:36:04 gildea>
7 ;; Keywords: tools 6 ;; Keywords: tools
8 7
9 ;; XEmacs is free software; you can redistribute it and/or modify it 8 ;; This file is free software; you can redistribute it and/or modify
10 ;; under the terms of the GNU General Public License as published by 9 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option) 10 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version. 11 ;; any later version.
13 12
14 ;; XEmacs is distributed in the hope that it will be useful, but 13 ;; This file is distributed in the hope that it will be useful,
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; General Public License for more details. 16 ;; GNU General Public License for more details.
18 17
19 ;; You should have received a copy of the GNU General Public License 18 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free 19 ;; along with GNU Emacs; see the file COPYING. If not, write to
21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 20 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22 ;; 02111-1307, USA. 21
23 22 ;;; Synched up with: Not synched with FSF.
24 ;;; Synched up with: 19.34.
25 23
26 ;;; Commentary: 24 ;;; Commentary:
27 25
28 ;; If you put a time stamp template anywhere in the first 8 lines of a file, 26 ;;; If you put a time stamp template anywhere in the first 8 lines of a file,
29 ;; it can be updated every time you save the file. See the top of 27 ;;; it can be updated every time you save the file. See the top of
30 ;; time-stamp.el for a sample. The template looks like one of the following: 28 ;;; time-stamp.el for a sample. The template looks like one of the following:
31 ;; Time-stamp: <> 29 ;;; Time-stamp: <>
32 ;; Time-stamp: " " 30 ;;; Time-stamp: " "
33 ;; The time stamp is written between the brackets or quotes, resulting in 31 ;;; The time stamp is written between the brackets or quotes, resulting in
34 ;; Time-stamp: <95/01/18 10:20:51 gildea> 32 ;;; Time-stamp: <93/06/18 10:26:51 gildea>
35 ;; Here is an example that puts the file name and time stamp in the binary: 33 ;;; Here is an example which puts the file name and time stamp in the binary:
36 ;; static char *time_stamp = "sdmain.c Time-stamp: <>"; 34 ;;; static char *time_stamp = "sdmain.c Time-stamp: <>";
37 35
38 ;; To activate automatic time stamping in GNU Emacs 19, add this code 36 ;;; To activate automatic time stamping, add this code to your .emacs file:
39 ;; to your .emacs file: 37 ;;;
40 ;; (add-hook 'write-file-hooks 'time-stamp) 38 ;;; (autoload 'time-stamp "time-stamp" "Update the time stamp in a buffer." t)
41 ;; 39 ;;; (if (not (memq 'time-stamp write-file-hooks))
42 ;; In Emacs 18 you will need to do this instead: 40 ;;; (setq write-file-hooks
43 ;; (if (not (memq 'time-stamp write-file-hooks)) 41 ;;; (cons '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.
49 42
50 ;;; Change Log: 43 ;;; Change Log:
51 44
52 ;; Originally based on the 19 Dec 88 version of 45 ;;; Originally based on the 19 Dec 88 version of
53 ;; date.el by John Sturdy <mcvax!harlqn.co.uk!jcgs@uunet.uu.net> 46 ;;; 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 $
56 47
57 ;;; Code: 48 ;;; Code:
58 49
59 (defvar time-stamp-active t 50 (defvar time-stamp-active t
60 "*Non-nil to enable time-stamping of buffers by \\[time-stamp]. 51 "*Non-nil to enable time-stamping of files. See the function time-stamp.")
61 Can be toggled by \\[time-stamp-toggle-active]. 52
62 See also the variable time-stamp-warn-inactive.") 53 (defvar time-stamp-format
63 54 '(time-stamp-yy/mm/dd time-stamp-hh:mm:ss user-login-name)
64 (defvar time-stamp-warn-inactive t 55 "*A list of functions to call to generate the time stamp string.
65 "*Non-nil to have \\[time-stamp] warn if a buffer did not get time-stamped. 56 Each element of the list is called as a function and the results are
66 A warning is printed if time-stamp-active is nil and the buffer contains 57 concatenated together separated by spaces. Elements may also be strings,
67 a time stamp template that would otherwise have been updated.") 58 which are included verbatim. Spaces are not inserted around literal strings.")
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
102 59
103 ;;; Do not change time-stamp-line-limit, time-stamp-start, or 60 ;;; Do not change time-stamp-line-limit, time-stamp-start, or
104 ;;; time-stamp-end in your .emacs or you will be incompatible 61 ;;; time-stamp-end in your .emacs or you will be incompatible
105 ;;; with other people's files! If you must change them, 62 ;;; with other people's files! If you must change them,
106 ;;; do so only in the local variables section of the file itself. 63 ;;; do so only in the local variables section of the file itself.
107 64
108 (defvar time-stamp-line-limit 8 ;Do not change! 65 (defvar time-stamp-line-limit 8 ;Do not change! See comment above.
109 "Lines of a file searched; positive counts from start, negative from end. 66 "Number of lines at the beginning of a file that are searched.
110 The patterns `time-stamp-start' and `time-stamp-end' must be found on one 67 The patterns time-stamp-start and time-stamp-end must be found on one
111 of the first (last) `time-stamp-line-limit' lines of the file for the 68 of the first time-stamp-line-limit lines of the file for the file to
112 file to be time-stamped by \\[time-stamp]. 69 be time-stamped.")
113 70
114 Do not change `time-stamp-line-limit', `time-stamp-start', or 71 (defvar time-stamp-start "Time-stamp: \\\\?[\"<]+" ;Do not change!
115 `time-stamp-end' for yourself or you will be incompatible 72 "Regexp after which the time stamp is written by \\[time-stamp].
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
116 with other people's files! If you must change them for some application, 77 with other people's files! If you must change them for some application,
117 do so in the local variables section of the time-stamped file itself.") 78 do so in the local variables section of the time-stamped file itself.")
118 79
119 80
120 (defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change! 81 (defvar time-stamp-end "\\\\?[\">]" ;Do not change! See comment above.
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!
131 "Regexp marking the text after the time stamp. 82 "Regexp marking the text after the time stamp.
132 \\[time-stamp] deletes the text between the first match of `time-stamp-start' 83 \\[time-stamp] deletes the text between the first match of time-stamp-start
133 and the following match of `time-stamp-end' on the same line, 84 \(which see) and the following match of time-stamp-end on the same line,
134 then writes the time stamp specified by `time-stamp-format' between them. 85 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
141 86
142 ;;;###autoload 87 ;;;###autoload
143 (defun time-stamp () 88 (defun time-stamp ()
144 "Update the time stamp string in the buffer. 89 "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>
152 Only does its thing if the variable time-stamp-active is non-nil. 90 Only does its thing if the variable time-stamp-active is non-nil.
153 Typically used on write-file-hooks for automatic time-stamping. 91 Typically used on write-file-hooks for automatic time-stamping.
154 The format of the time stamp is determined by the variable time-stamp-format. 92 The format of the time stamp is determined by the variable
155 The variables time-stamp-line-limit, time-stamp-start, and time-stamp-end 93 time-stamp-format. The first time-stamp-line-limit lines of the
156 control finding the template." 94 buffer (normally 8) are searched for the time stamp template,
95 and if it is found, a new time stamp is written into it."
157 (interactive) 96 (interactive)
158 (let ((case-fold-search nil) 97 (if time-stamp-active
159 (need-to-warn nil) 98 (let ((case-fold-search nil))
160 start search-end) 99 (if (and (stringp time-stamp-start)
161 (if (and (stringp time-stamp-start) 100 (stringp time-stamp-end))
162 (stringp time-stamp-end)) 101 (save-excursion
163 (save-excursion 102 (goto-char (point-min))
164 (save-restriction 103 (if (re-search-forward time-stamp-start
165 (widen) 104 (save-excursion
166 (if (> time-stamp-line-limit 0) 105 (forward-line time-stamp-line-limit)
167 (progn 106 (point))
168 (goto-char (setq start (point-min))) 107 t)
169 (forward-line time-stamp-line-limit) 108 (let ((start (point)))
170 (setq search-end (point))) 109 (if (re-search-forward time-stamp-end
171 (goto-char (setq search-end (point-max))) 110 (save-excursion (end-of-line) (point))
172 (forward-line time-stamp-line-limit) 111 t)
173 (setq start (point))) 112 (let ((end (match-beginning 0)))
174 (goto-char start) 113 (delete-region start end)
175 (while 114 (goto-char start)
176 (and (< (point) search-end) 115 (insert (time-stamp-string))
177 (re-search-forward time-stamp-start search-end 'move)) 116 (setq end (point))
178 (setq start (point)) 117 ;; remove any tabs used to format the time stamp
179 (end-of-line) 118 (goto-char start)
180 (let ((line-end (point))) 119 (if (search-forward "\t" end t)
181 (goto-char start) 120 (untabify start end)))))))
182 (if (re-search-forward time-stamp-end line-end 'move) 121 ;; don't signal an error in a write-file-hook
183 (progn 122 (message "time-stamp-start or time-stamp-end is not a string"))))
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))))
205 ;; be sure to return nil so can be used on write-file-hooks 123 ;; be sure to return nil so can be used on write-file-hooks
206 nil) 124 nil)
207 125
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
220 (defun time-stamp-string () 126 (defun time-stamp-string ()
221 "Generate the new string to be inserted by \\[time-stamp]." 127 "Generate the new string to be inserted by \\[time-stamp]."
222 (if (stringp time-stamp-format) 128 (time-stamp-fconcat 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
414 129
415 (defun time-stamp-fconcat (list sep) 130 (defun time-stamp-fconcat (list sep)
416 "Similar to (mapconcat 'funcall LIST SEP) but LIST allows literals. 131 "Similar to (mapconcat 'funcall LIST SEP) but LIST can have literals.
417 If an element of LIST is a symbol, it is funcalled to get the string to use; 132 If an element of LIST is a symbol, it is funcalled to get the string to use;
418 the separator SEP is used between two strings obtained by funcalling a 133 the separator SEP is used between two strings obtained by funcalling a
419 symbol. Otherwise the element itself is inserted; no separator is used 134 symbol. Otherwise the element itself is inserted; no separator is used
420 around literals." 135 around literals."
421 (let ((return-string "") 136 (let ((return-string "")
431 (setq insert-sep-p nil))) 146 (setq insert-sep-p nil)))
432 (setq list (cdr list))) 147 (setq list (cdr list)))
433 return-string)) 148 return-string))
434 149
435 150
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
436 ;;; Some useful functions to use in time-stamp-format 164 ;;; Some useful functions to use in time-stamp-format
437 165
438 ;;; Could generate most of a message-id with 166 ;;; Could generate most of a message-id with
439 ;;; '(time-stamp-yymmdd "" time-stamp-hhmm "@" time-stamp-mail-host-name) 167 ;;; '(yymmdd "" hhmm "@" 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))
440 181
441 ;;; pretty form, suitable for a title page 182 ;;; pretty form, suitable for a title page
442 183
443 (defun time-stamp-month-dd-yyyy () 184 (defun time-stamp-month-dd-yyyy ()
444 "Return the current date as a string in \"Month DD, YYYY\" form." 185 "Return the current date as a string in \"Month dd, yyyy\" form."
445 (let ((date (current-time-string))) 186 (let ((date (current-time-string)))
446 (format "%s %d, %s" 187 (format "%s %02d, %s"
447 (aref time-stamp-month-full-names 188 (aref time-stamp-month-full-names
448 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))) 189 (cdr (assoc (substring date 4 7) time-stamp-month-numbers)))
449 (string-to-int (substring date 8 10)) 190 (string-to-int (substring date 8 10))
450 (substring date -4)))) 191 (substring date -4))))
451 192
452 ;;; same as __DATE__ in ANSI C 193 ;;; same as __DATE__ in ANSI C
453 194
454 (defun time-stamp-mon-dd-yyyy () 195 (defun time-stamp-mon-dd-yyyy ()
455 "Return the current date as a string in \"Mon DD YYYY\" form. 196 "Return the current date as a string in \"Mon dd yyyy\" form.
456 The first character of DD is space if the value is less than 10." 197 The first character of dd is Space if the value is less than 10."
457 (let ((date (current-time-string))) 198 (let ((date (current-time-string)))
458 (format "%s %2d %s" 199 (format "%s %2d %s"
459 (substring date 4 7) 200 (substring date 4 7)
460 (string-to-int (substring date 8 10)) 201 (string-to-int (substring date 8 10))
461 (substring date -4)))) 202 (substring date -4))))
462 203
463 ;;; RFC 822 date 204 ;;; RFC 822 date
464 205
465 (defun time-stamp-dd-mon-yy () 206 (defun time-stamp-dd-mon-yy ()
466 "Return the current date as a string in \"DD Mon YY\" form." 207 "Return the current date as a string in \"dd Mon yy\" form."
467 (let ((date (current-time-string))) 208 (let ((date (current-time-string)))
468 (format "%02d %s %s" 209 (format "%02d %s %s"
469 (string-to-int (substring date 8 10)) 210 (string-to-int (substring date 8 10))
470 (substring date 4 7) 211 (substring date 4 7)
471 (substring date -2)))) 212 (substring date -2))))
472 213
473 ;;; RCS 3 date 214 ;;; RCS 3 date
474 215
475 (defun time-stamp-yy/mm/dd () 216 (defun time-stamp-yy/mm/dd ()
476 "Return the current date as a string in \"YY/MM/DD\" form." 217 "Return the current date as a string in \"yy/mm/dd\" form."
477 (let ((date (current-time-string))) 218 (let ((date (current-time-string)))
478 (format "%s/%02d/%02d" 219 (format "%s/%02d/%02d"
479 (substring date -2) 220 (substring date -2)
480 (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) 221 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
481 (string-to-int (substring date 8 10))))) 222 (string-to-int (substring date 8 10)))))
482 223
483 ;;; RCS 5 date 224 ;;; RCS 5 date
484 225
485 (defun time-stamp-yyyy/mm/dd () 226 (defun time-stamp-yyyy/mm/dd ()
486 "Return the current date as a string in \"YYYY/MM/DD\" form." 227 "Return the current date as a string in \"yyyy/mm/dd\" form."
487 (let ((date (current-time-string))) 228 (let ((date (current-time-string)))
488 (format "%s/%02d/%02d" 229 (format "%s/%02d/%02d"
489 (substring date -4) 230 (substring date -4)
490 (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) 231 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
491 (string-to-int (substring date 8 10))))) 232 (string-to-int (substring date 8 10)))))
492 233
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
503 (defun time-stamp-yymmdd () 234 (defun time-stamp-yymmdd ()
504 "Return the current date as a string in \"YYMMDD\" form." 235 "Return the current date as a string in \"yymmdd\" form."
505 (let ((date (current-time-string))) 236 (let ((date (current-time-string)))
506 (format "%s%02d%02d" 237 (format "%s%02d%02d"
507 (substring date -2) 238 (substring date -2)
508 (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) 239 (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
509 (string-to-int (substring date 8 10))))) 240 (string-to-int (substring date 8 10)))))
510 241
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
511 (defun time-stamp-hh:mm:ss () 258 (defun time-stamp-hh:mm:ss ()
512 "Return the current time as a string in \"HH:MM:SS\" form." 259 "Return the current time as a string in \"hh:mm:ss\" form."
513 (substring (current-time-string) 11 19)) 260 (substring (current-time-string) 11 19))
514 261
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
515 (defun time-stamp-hhmm () 266 (defun time-stamp-hhmm ()
516 "Return the current time as a string in \"HHMM\" form." 267 "Return the current time as a string in \"hhmm\" form."
517 (let ((date (current-time-string))) 268 (let ((date (current-time-string)))
518 (concat (substring date 11 13) 269 (concat (substring date 11 13)
519 (substring date 14 16)))) 270 (substring date 14 16))))
520 271
521 (provide 'time-stamp) 272 (provide 'time-stamp)