X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/fe8287c6fa15c482d965d4acdd1d3adeb16dc2b1..f38d351407f2c700b32fc90f9935c70507b5b14c:/lisp/time-stamp.el diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index 37b74b7008..b7a85400d7 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -1,8 +1,9 @@ ;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs -;;; Copyright 1989, 1993, 1994, 1995 Free Software Foundation, Inc. -;;; Maintainer's Time-stamp: <95/05/30 13:28:56 gildea> -;; Maintainer: Stephen Gildea +;; Copyright 1989, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. + +;; Maintainer's Time-stamp: <1998-03-04 14:14:19 gildea> +;; Maintainer: Stephen Gildea ;; Keywords: tools ;; This file is free software; you can redistribute it and/or modify @@ -16,72 +17,119 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: -;;; If you put a time stamp template anywhere in the first 8 lines of a file, -;;; it can be updated every time you save the file. See the top of -;;; time-stamp.el for a sample. The template looks like one of the following: -;;; Time-stamp: <> -;;; Time-stamp: " " -;;; The time stamp is written between the brackets or quotes, resulting in -;;; Time-stamp: <95/01/18 10:20:51 gildea> -;;; Here is an example which puts the file name and time stamp in the binary: -;;; static char *time_stamp = "sdmain.c Time-stamp: <>"; - -;;; To activate automatic time stamping in GNU Emacs 19, add this code -;;; to your .emacs file: -;;; (add-hook 'write-file-hooks 'time-stamp) -;;; -;;; In Emacs 18 you will need to do this instead: -;;; (if (not (memq 'time-stamp write-file-hooks)) -;;; (setq write-file-hooks -;;; (cons 'time-stamp write-file-hooks))) -;;; (autoload 'time-stamp "time-stamp" "Update the time stamp in a buffer." t) - -;;; See the documentation for the function `time-stamp' for more details. - -;;; Change Log: - -;;; Originally based on the 19 Dec 88 version of -;;; date.el by John Sturdy -;;; version 2, January 1995: replaced functions with %-escapes -;;; $Id: time-stamp.el,v 1.1 95/05/30 17:57:24 gildea Exp $ +;; A template in a file can be updated with a new time stamp when +;; you save the file. For example: +;; static char *ts = "sdmain.c Time-stamp: <1996-08-13 10:20:51 gildea>"; +;; See the top of `time-stamp.el' for another example. + +;; To use time-stamping, add this line to your .emacs file: +;; (add-hook 'write-file-hooks 'time-stamp) +;; Now any time-stamp templates in your files will be updated automatically. + +;; See the documentation for the functions `time-stamp' +;; and `time-stamp-toggle-active' for details. ;;; Code: -(defvar time-stamp-active t - "*Non-nil to enable time-stamping of files. -Can be toggled by \\[time-stamp-toggle-active]. -See also the variable time-stamp-warn-inactive.") +(defgroup time-stamp nil + "Maintain last change time stamps in files edited by Emacs." + :group 'data + :group 'extensions) + +(defcustom time-stamp-format "%:y-%02m-%02d %02H:%02M:%02S %u" + "*Format of the string inserted by \\[time-stamp]. +The value may be a string or a list. Lists are supported only for +backward compatibility; see variable `time-stamp-old-format-warn'. + +A string is used verbatim except for character sequences beginning with %: + +%:a weekday name: `Monday'. %#A gives uppercase: `MONDAY' +%3a abbreviated weekday: `Mon'. %3A gives uppercase: `MON' +%:b month name: `January'. %#B gives uppercase: `JANUARY' +%3b abbreviated month: `Jan'. %3B gives uppercase: `JAN' +%02d day of month +%02H 24-hour clock hour +%02I 12-hour clock hour +%02m month number +%02M minute +%#p `am' or `pm'. %P gives uppercase: `AM' or `PM' +%02S seconds +%w day number of week, Sunday is 0 +%02y 2-digit year: `97' %:y 4-digit year: `1997' +%z time zone name: `est'. %Z gives uppercase: `EST' -(defvar time-stamp-warn-inactive t - "*Non-nil to have time-stamp warn if time-stamp-active is nil.") +Non-date items: +%% a literal percent character: `%' +%f file name without directory %F gives absolute pathname +%s system name +%u user's login name +%U user's full name +%h mail host name -(defvar time-stamp-format "%02y/%02m/%02d %02H:%02M:%02S %u" - "*Template for the string inserted by the time-stamp function. -Value may be a string or a list. (Lists are supported only for -backward compatibility.) A string is used verbatim except for character -sequences beginning with %. See the documentation for the function -time-stamp-strftime for a list of %-escapes. - Each element of a list is called as a function and the results are -concatenated together separated by spaces. List elements may also be -strings, which are included verbatim. Spaces are not inserted around -literal strings.") +Decimal digits between the % and the type character specify the +field width. Strings are truncated on the right; years on the left. +A leading zero causes numbers to be zero-filled. +For example, to get the format used by the `date' command, +use \"%3a %3b %2d %02H:%02M:%02S %Z %:y\". + +In the future these formats will be aligned more with format-time-string. +Because of this transition, the default padding for numeric formats will +change in a future version. Therefore either a padding width should be +specified, or the : modifier should be used to explicitly request the +historical default." + :type 'string + :group 'time-stamp) + +(defcustom time-stamp-active t + "*Non-nil to enable time-stamping of buffers by \\[time-stamp]. +Can be toggled by \\[time-stamp-toggle-active]. +See also the variable `time-stamp-warn-inactive'." + :type 'boolean + :group 'time-stamp) + +(defcustom time-stamp-warn-inactive t + "Non-nil to have \\[time-stamp] warn if a buffer did not get time-stamped. +A warning is printed if `time-stamp-active' is nil and the buffer contains +a time stamp template that would otherwise have been updated." + :type 'boolean + :group 'time-stamp) + +(defcustom time-stamp-old-format-warn 'ask + "Action to take if `time-stamp-format' is an old-style list. +If `error', the format is not used. If `ask', the user is queried about +using the time-stamp-format. If `warn', a warning is displayed. +If nil, no notification is given." + :type '(choice (const :tag "No notification" nil) + (const :tag "Don't use the format" error) + (const ask) (const warn)) + :group 'time-stamp) + +(defcustom time-stamp-time-zone nil + "If non-nil, a string naming the timezone to be used by \\[time-stamp]. +Format is the same as that used by the environment variable TZ on your system." + :type '(choice (const nil) string) + :group 'time-stamp) + + +;;; Do not change time-stamp-line-limit, time-stamp-start, +;;; time-stamp-end, or time-stamp-pattern in your .emacs +;;; or you will be incompatible with other people's files! +;;; If you must change them, do so only in the local variables +;;; section of the file itself. -;;; Do not change time-stamp-line-limit, time-stamp-start, or -;;; time-stamp-end in your .emacs or you will be incompatible -;;; with other people's files! If you must change them, -;;; do so only in the local variables section of the file itself. (defvar time-stamp-line-limit 8 ;Do not change! - "Number of lines at the beginning of a file that are searched. + "Lines of a file searched; positive counts from start, negative from end. The patterns `time-stamp-start' and `time-stamp-end' must be found on one -of the first `time-stamp-line-limit' lines of the file for the file to -be time-stamped by \\[time-stamp]. +of the first (last) `time-stamp-line-limit' lines of the file for the +file to be time-stamped by \\[time-stamp]. Do not change `time-stamp-line-limit', `time-stamp-start', or `time-stamp-end' for yourself or you will be incompatible @@ -111,67 +159,134 @@ with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself.") +(defvar time-stamp-pattern "%%" ;Do not change! + "Convenience variable setting all time-stamp location and format variables. +This string has four parts, each of which is optional. +These four parts set time-stamp-line-limit, time-stamp-start, +time-stamp-format, and time-stamp-end. See the documentation +for each of these variables for details. + +The first part is a number followed by a slash; the number sets the number +of lines at the beginning (negative counts from end) of the file searched +for the time-stamp. The number and the slash may be omitted to use the +normal value. + +The second part is a regexp identifying the pattern preceding the time stamp. +This part may be omitted to use the normal pattern. + +The third part specifies the format of the time-stamp inserted. See +the documentation for time-stamp-format for details. Specify this +part as \"%%\" to use the normal format. + +The fourth part is a regexp identifying the pattern following the time stamp. +This part may be omitted to use the normal pattern. + +As an example, the default behavior can be specified something like this: +\"8/Time-stamp: [\\\"<]%:y-%02m-%02d %02H:%02M:%02S %u[\\\">]\" + +Do not change `time-stamp-pattern' for yourself or you will be incompatible +with other people's files! Set it only in the local variables section +of the time-stamped file itself.") + + + ;;;###autoload (defun time-stamp () "Update the time stamp string in the buffer. -If you put a time stamp template anywhere in the first 8 lines of a file, -it can be updated every time you save the file. See the top of -`time-stamp.el' for a sample. The template looks like one of the following: - Time-stamp: <> - Time-stamp: \" \" -The time stamp is written between the brackets or quotes, resulting in - Time-stamp: <95/01/18 10:20:51 gildea> -Only does its thing if the variable time-stamp-active is non-nil. -Typically used on write-file-hooks for automatic time-stamping. -The format of the time stamp is determined by the variable time-stamp-format. -The variables time-stamp-line-limit, time-stamp-start, and time-stamp-end -control finding the template." +A template in a file can be automatically updated with a new time stamp +every time you save the file. Add this line to your .emacs file: + (add-hook 'write-file-hooks 'time-stamp) +Normally the template must appear in the first 8 lines of a file and +look like one of the following: + Time-stamp: <> + Time-stamp: \" \" +The time stamp is written between the brackets or quotes: + Time-stamp: <1998-02-18 10:20:51 gildea> +The time stamp is updated only if the variable `time-stamp-active' is non-nil. +The format of the time stamp is set by the variable `time-stamp-format'. +The variables `time-stamp-line-limit', `time-stamp-start', +and `time-stamp-end' control finding the template." (interactive) (let ((case-fold-search nil) - (need-to-warn nil)) - (if (and (stringp time-stamp-start) - (stringp time-stamp-end)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (if (re-search-forward time-stamp-start - (save-excursion - (forward-line time-stamp-line-limit) - (point)) - t) - (let ((start (point))) - (if (re-search-forward time-stamp-end - (save-excursion - (end-of-line) - (point)) - t) - (if time-stamp-active - (let ((end (match-beginning 0))) - (delete-region start end) - (goto-char start) - (insert (time-stamp-string)) - (setq end (point)) - ;; remove any tabs used to format the time stamp - (goto-char start) - (if (search-forward "\t" end t) - (untabify start end))) - (if time-stamp-warn-inactive - ;; do the actual warning outside save-excursion - (setq need-to-warn t)))))))) - ;; don't signal an error in a write-file-hook - (message "time-stamp-start or time-stamp-end is not a string") - (sit-for 1)) - (if need-to-warn + (start nil) + (end nil) + search-limit + (line-limit time-stamp-line-limit) + (ts-start time-stamp-start) + (ts-format time-stamp-format) + (ts-end time-stamp-end)) + (if (stringp time-stamp-pattern) + (progn + (string-match "\\`\\(\\(-?[0-9]+\\)/\\)?\\([^%]+\\)?\\(\\(.\\|\n\\)*%[-.,:@+_ #^()0-9]*[A-Za-z%]\\)?\\([^%]+\\)?\\'" time-stamp-pattern) + (and (match-beginning 2) + (setq line-limit + (string-to-int (match-string 2 time-stamp-pattern)))) + (and (match-beginning 3) + (setq ts-start (match-string 3 time-stamp-pattern))) + (and (match-beginning 4) + (not (string-equal (match-string 4 time-stamp-pattern) "%%")) + (setq ts-format (match-string 4 time-stamp-pattern))) + (and (match-beginning 6) + (setq ts-end (match-string 6 time-stamp-pattern))))) + (cond ((not (integerp line-limit)) + (setq line-limit 8) + (message "time-stamp-line-limit is not an integer") + (sit-for 1))) + (save-excursion + (save-restriction + (widen) + (cond ((> line-limit 0) + (goto-char (setq start (point-min))) + (forward-line line-limit) + (setq search-limit (point))) + (t + (goto-char (setq search-limit (point-max))) + (forward-line line-limit) + (setq start (point)))) + (goto-char start) + (while (and (< (point) search-limit) + (not end) + (re-search-forward ts-start search-limit 'move)) + (setq start (point)) + (end-of-line) + (let ((line-end (point))) + (goto-char start) + (if (re-search-forward ts-end line-end 'move) + (setq end (match-beginning 0))))))) + (if end (progn - (message "Warning: did not time-stamp buffer.") - (sit-for 1)))) + ;; do all warnings outside save-excursion + (cond + ((not time-stamp-active) + (if time-stamp-warn-inactive + ;; don't signal an error in a write-file-hook + (progn + (message "Warning: time-stamp-active is off; did not time-stamp buffer.") + (sit-for 1)))) + ((not (and (stringp ts-start) + (stringp ts-end))) + (message "time-stamp-start or time-stamp-end is not a string") + (sit-for 1)) + (t + (let ((new-time-stamp (time-stamp-string ts-format))) + (if (stringp new-time-stamp) + (save-excursion + (save-restriction + (widen) + (delete-region start end) + (goto-char start) + (insert-and-inherit new-time-stamp) + (setq end (point)) + ;; remove any tabs used to format time stamp + (goto-char start) + (if (search-forward "\t" end t) + (untabify start end))))))))))) ;; be sure to return nil so can be used on write-file-hooks nil) ;;;###autoload (defun time-stamp-toggle-active (&optional arg) - "Toggle time-stamp-active, which enables time stamping of files. + "Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer. With arg, turn time stamping on if and only if arg is positive." (interactive "P") (setq time-stamp-active @@ -179,146 +294,160 @@ With arg, turn time stamping on if and only if arg is positive." (not time-stamp-active) (> (prefix-numeric-value arg) 0))) (message "time-stamp is now %s." (if time-stamp-active "active" "off"))) - - -(defun time-stamp-string () - "Generate the new string to be inserted by \\[time-stamp]." - (if (stringp time-stamp-format) - (time-stamp-strftime time-stamp-format) - (time-stamp-fconcat time-stamp-format " "))) ;version 1 compatibility - -(defun time-stamp-strftime (format &optional time) - "Uses a FORMAT to format date, time, file, and user information. -Optional second argument TIME will be used instead of the current time. -Characters in the format are copied literally except for %-directives: - -%a weekday name: `Monday'. %A gives uppercase: `MONDAY' -%b month name: `January'. %B gives uppercase: `JANUARY' -%d day of month -%H 24-hour clock hour -%I 12-hour clock hour -%m month number -%M minute -%p `am' or `pm'. %P gives uppercase: `AM' or `PM' -%S seconds -%w day number of week, Sunday is 0 -%y year: `1995' -%z time zone name: `est'. %Z gives uppercase: `EST' -Non-date items: -%% a literal percent character: `%' -%f file name without directory %F gives absolute pathname -%s system name -%u user's login name -%h mail host name - -Decimal digits between the % and the type character specify the -field width. Strings are truncated on the right; numbers on the left. -A leading zero causes numbers to be zero-filled. - -For example, to get the format used by the `date' command, -use \"%3a %3b %2d %02H:%02M:%02S %Z %y\"" - (let ((time-string (cond ((stringp time) - time) - (time - (current-time-string time)) - (t - (current-time-string)))) - (fmt-len (length format)) +(defconst time-stamp-no-file "(no file)" + "String to use when the buffer is not associated with a file.") + +;;; time-stamp is transitioning to using the new, expanded capabilities +;;; of format-time-string. During the process, this function implements +;;; intermediate, compatible formats and complains about old, soon to +;;; be unsupported, formats. This function will get a lot (a LOT) shorter +;;; when the transition is complete and we can just pass most things +;;; straight through to format-time-string. +;;; At all times, all the formats recommended in the doc string +;;; of time-stamp-format will work not only in the current version of +;;; Emacs, but in all versions that have been released within the past +;;; two years. +;;; The : modifier is a temporary conversion feature used to resolve +;;; ambiguous formats--formats that are changing (over time) incompatibly. +(defun time-stamp-string-preprocess (format &optional time) + ;; Uses a FORMAT to format date, time, file, and user information. + ;; Optional second argument TIME is only for testing. + ;; Implements non-time extensions to format-time-string + ;; and all time-stamp-format compatibility. + (let ((fmt-len (length format)) (ind 0) cur-char + (prev-char nil) (result "") - field-index field-width - field-result) + field-result + alt-form change-case require-padding + (paren-level 0)) (while (< ind fmt-len) (setq cur-char (aref format ind)) (setq result - (concat result + (concat result (cond - ((and (eq cur-char ?%) - (< (1+ ind) fmt-len)) - (setq field-index (1+ ind)) + ((eq cur-char ?%) + ;; eat any additional args to allow for future expansion + (setq alt-form nil change-case nil require-padding nil field-width "") (while (progn (setq ind (1+ ind)) - (setq cur-char (aref format ind)) - (and (<= ?0 cur-char) (>= ?9 cur-char)))) - (setq field-width (substring format field-index ind)) + (setq cur-char (if (< ind fmt-len) + (aref format ind) + ?\0)) + (or (eq ?. cur-char) + (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char) + (eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char) + (eq ?\ cur-char) (eq ?# cur-char) (eq ?^ cur-char) + (and (eq ?\( cur-char) + (not (eq prev-char ?\\)) + (setq paren-level (1+ paren-level))) + (if (and (eq ?\) cur-char) + (not (eq prev-char ?\\)) + (> paren-level 0)) + (setq paren-level (1- paren-level)) + (and (> paren-level 0) + (< ind fmt-len))) + (if (and (<= ?0 cur-char) (>= ?9 cur-char)) + ;; get format width + (let ((field-index ind)) + (while (progn + (setq ind (1+ ind)) + (setq cur-char (if (< ind fmt-len) + (aref format ind) + ?\0)) + (and (<= ?0 cur-char) (>= ?9 cur-char)))) + (setq field-width (substring format field-index ind)) + (setq ind (1- ind)) + t)))) + (setq prev-char cur-char) + ;; some characters we actually use + (cond ((eq cur-char ?:) + (setq alt-form t)) + ((eq cur-char ?#) + (setq change-case t)))) (setq field-result (cond ((eq cur-char ?%) "%") - ((or (eq cur-char ?a) ;weekday name - (eq cur-char ?A)) - (let ((name - (aref time-stamp-weekday-full-names - (cdr (assoc (substring time-string 0 3) - time-stamp-weekday-numbers))))) - (if (eq cur-char ?a) - name - (upcase name)))) - ((or (eq cur-char ?b) ;month name - (eq cur-char ?B)) - (let ((name - (aref time-stamp-month-full-names - (cdr (assoc (substring time-string 4 7) - time-stamp-month-numbers))))) - (if (eq cur-char ?b) - name - (upcase name)))) + ((eq cur-char ?a) ;day of week + (if change-case + (format-time-string "%#A" time) + (or alt-form (not (string-equal field-width "")) + (time-stamp-conv-warn "%a" "%:a")) + (if (and alt-form (not (string-equal field-width ""))) + "" ;discourage "%:3a" + (format-time-string "%A" time)))) + ((eq cur-char ?A) + (if alt-form + (format-time-string "%A" time) + (or change-case (not (string-equal field-width "")) + (time-stamp-conv-warn "%A" "%#A")) + (format-time-string "%#A" time))) + ((eq cur-char ?b) ;month name + (if change-case + (format-time-string "%#B" time) + (or alt-form (not (string-equal field-width "")) + (time-stamp-conv-warn "%b" "%:b")) + (if (and alt-form (not (string-equal field-width ""))) + "" ;discourage "%:3b" + (format-time-string "%B" time)))) + ((eq cur-char ?B) + (if alt-form + (format-time-string "%B" time) + (or change-case (not (string-equal field-width "")) + (time-stamp-conv-warn "%B" "%#B")) + (format-time-string "%#B" time))) ((eq cur-char ?d) ;day of month, 1-31 - (string-to-int (substring time-string 8 10))) + (time-stamp-do-number cur-char alt-form field-width time)) ((eq cur-char ?H) ;hour, 0-23 - (string-to-int (substring time-string 11 13))) + (time-stamp-do-number cur-char alt-form field-width time)) ((eq cur-char ?I) ;hour, 1-12 - (let ((hour (string-to-int (substring time-string 11 13)))) - (cond ((< hour 1) - (+ hour 12)) - ((> hour 12) - (- hour 12)) - (t - hour)))) + (time-stamp-do-number cur-char alt-form field-width time)) ((eq cur-char ?m) ;month number, 1-12 - (cdr (assoc (substring time-string 4 7) - time-stamp-month-numbers))) + (time-stamp-do-number cur-char alt-form field-width time)) ((eq cur-char ?M) ;minute, 0-59 - (string-to-int (substring time-string 14 16))) - ((or (eq cur-char ?p) ;am or pm - (eq cur-char ?P)) - (let ((name - (if (> 12 (string-to-int (substring time-string 11 13))) - "am" - "pm"))) - (if (eq cur-char ?p) - name - (upcase name)))) + (time-stamp-do-number cur-char alt-form field-width time)) + ((eq cur-char ?p) ;am or pm + (or change-case + (time-stamp-conv-warn "%p" "%#p")) + (format-time-string "%#p" time)) + ((eq cur-char ?P) ;AM or PM + (format-time-string "%p" time)) ((eq cur-char ?S) ;seconds, 00-60 - (string-to-int (substring time-string 17 19))) + (time-stamp-do-number cur-char alt-form field-width time)) ((eq cur-char ?w) ;weekday number, Sunday is 0 - (cdr (assoc (substring time-string 0 3) time-stamp-weekday-numbers))) + (format-time-string "%w" time)) ((eq cur-char ?y) ;year - (string-to-int (substring time-string -4))) - ((or (eq cur-char ?z) ;time zone - (eq cur-char ?Z)) - (let ((name - (if (fboundp 'current-time-zone) - (car (cdr (current-time-zone time)))))) - (or name (setq name "")) - (if (eq cur-char ?z) - (downcase name) - (upcase name)))) + (or alt-form (not (string-equal field-width "")) + (time-stamp-conv-warn "%y" "%:y")) + (string-to-int (format-time-string "%Y" time))) + ((eq cur-char ?Y) ;4-digit year, new style + (string-to-int (format-time-string "%Y" time))) + ((eq cur-char ?z) ;time zone lower case + (if change-case + "" ;discourage %z variations + (format-time-string "%#Z" time))) + ((eq cur-char ?Z) + (if change-case + (format-time-string "%#Z" time) + (format-time-string "%Z" time))) ((eq cur-char ?f) ;buffer-file-name, base name only (if buffer-file-name (file-name-nondirectory buffer-file-name) - "(no file)")) + time-stamp-no-file)) ((eq cur-char ?F) ;buffer-file-name, full path (or buffer-file-name - "(no file)")) + time-stamp-no-file)) ((eq cur-char ?s) ;system name (system-name)) ((eq cur-char ?u) ;user name (user-login-name)) + ((eq cur-char ?U) ;user full name + (user-full-name)) ((eq cur-char ?h) ;mail host name (time-stamp-mail-host-name)) )) @@ -332,45 +461,99 @@ use \"%3a %3b %2d %02H:%02M:%02S %Z %y\"" (let ((initial-length (length padded-result)) (desired-length (string-to-int field-width))) (if (> initial-length desired-length) - ;; truncate strings on right, numbers on left + ;; truncate strings on right, years on left (if (stringp field-result) (substring padded-result 0 desired-length) - (substring padded-result (- desired-length))) + (if (eq cur-char ?y) + (substring padded-result (- desired-length)) + padded-result)) ;non-year numbers don't truncate padded-result))))) (t (char-to-string cur-char))))) (setq ind (1+ ind))) result)) -(defconst time-stamp-month-numbers - '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6) - ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)) - "Alist of months and their number.") - -(defconst time-stamp-month-full-names - ["(zero)" "January" "February" "March" "April" "May" "June" - "July" "August" "September" "October" "November" "December"]) - -(defconst time-stamp-weekday-numbers - '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3) - ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)) - "Alist of weekdays and their number.") - -(defconst time-stamp-weekday-full-names - ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]) +(defun time-stamp-do-number (format-char alt-form field-width time) + ;; Handle a compatible FORMAT-CHAR where only + ;; the default width/padding will change. + ;; ALT-FORM is whether `#' specified. FIELD-WIDTH is the string + ;; width specification or "". TIME is the time to convert. + (let ((format-string (concat "%" (char-to-string format-char)))) + (and (not alt-form) (string-equal field-width "") + (time-stamp-conv-warn format-string + (format "%%:%c" format-char))) + (if (and alt-form (not (string-equal field-width ""))) + "" ;discourage "%:2d" and the like + (string-to-int (format-time-string format-string time))))) + +(defvar time-stamp-conversion-warn t + "Non-nil to warn about soon-to-be-unsupported forms in time-stamp-format. +In would be a bad idea to disable these warnings! +You really need to update your files instead. + +The new formats will work with old versions of Emacs. +New formats are being recommended now to allow time-stamp-format +to change in the future to be compatible with format-time-string. +The new forms being recommended now will continue to work then.") + + +(defun time-stamp-conv-warn (old-form new-form) + ;; Display a warning about a soon-to-be-obsolete format. + (cond + (time-stamp-conversion-warn + (save-excursion + (set-buffer (get-buffer-create "*Time-stamp-compatibility*")) + (goto-char (point-max)) + (if (bobp) + (progn + (insert + "The formats recognized in time-stamp-format will change in a future release\n" + "to be compatible with the new, expanded format-time-string function.\n\n" + "The following obsolescent time-stamp-format construct(s) were found:\n\n"))) + (insert "\"" old-form "\" -- use " new-form "\n")) + (display-buffer "*Time-stamp-compatibility*")))) + + + +(defun time-stamp-string (&optional ts-format) + "Generate the new string to be inserted by \\[time-stamp]. +Optionally use FORMAT." + (or ts-format + (setq ts-format time-stamp-format)) + (if (stringp ts-format) + (if (stringp time-stamp-time-zone) + (let ((real-time-zone (getenv "TZ"))) + (unwind-protect + (progn + (setenv "TZ" time-stamp-time-zone) + (format-time-string + (time-stamp-string-preprocess ts-format))) + (setenv "TZ" real-time-zone))) + (format-time-string + (time-stamp-string-preprocess ts-format))) + ;; handle version 1 compatibility + (cond ((or (eq time-stamp-old-format-warn 'error) + (and (eq time-stamp-old-format-warn 'ask) + (not (y-or-n-p "Use non-string time-stamp-format? ")))) + (message "Warning: no time-stamp: time-stamp-format not a string") + (sit-for 1) + nil) + (t + (cond ((eq time-stamp-old-format-warn 'warn) + (message "Obsolescent time-stamp-format type; should be string") + (sit-for 1))) + (time-stamp-fconcat ts-format " "))))) + +(defconst time-stamp-no-file "(no file)" + "String to use when the buffer is not associated with a file.") (defun time-stamp-mail-host-name () "Return the name of the host where the user receives mail. This is the value of `mail-host-address' if bound and a string, -otherwise the value of `time-stamp-mail-host' (for versions of Emacs -before 19.29) otherwise the value of the function system-name. -This function may be usefully referenced by `time-stamp-format'." +otherwise the value of the function system-name." (or (and (boundp 'mail-host-address) (stringp mail-host-address) mail-host-address) - (and (boundp 'time-stamp-mail-host) ;for backward compatibility - (stringp time-stamp-mail-host) - time-stamp-mail-host) (system-name))) ;;; the rest of this file is for version 1 compatibility @@ -395,8 +578,7 @@ around literals." (setq list (cdr list))) return-string)) - -;;; Some useful functions to use in time-stamp-format +;;; Some functions used in time-stamp-format ;;; Could generate most of a message-id with ;;; '(time-stamp-yymmdd "" time-stamp-hhmm "@" time-stamp-mail-host-name) @@ -405,81 +587,54 @@ around literals." (defun time-stamp-month-dd-yyyy () "Return the current date as a string in \"Month DD, YYYY\" form." - (let ((date (current-time-string))) - (format "%s %d, %s" - (aref time-stamp-month-full-names - (cdr (assoc (substring date 4 7) time-stamp-month-numbers))) - (string-to-int (substring date 8 10)) - (substring date -4)))) + (format-time-string "%B %e, %Y")) + +(defun time-stamp-dd/mm/yyyy () + "Return the current date as a string in \"DD/MM/YYYY\" form." + (format-time-string "%d/%m/%Y")) ;;; same as __DATE__ in ANSI C (defun time-stamp-mon-dd-yyyy () "Return the current date as a string in \"Mon DD YYYY\" form. The first character of DD is space if the value is less than 10." - (let ((date (current-time-string))) - (format "%s %2d %s" - (substring date 4 7) - (string-to-int (substring date 8 10)) - (substring date -4)))) + (format-time-string "%b %d %Y")) ;;; RFC 822 date (defun time-stamp-dd-mon-yy () "Return the current date as a string in \"DD Mon YY\" form." - (let ((date (current-time-string))) - (format "%02d %s %s" - (string-to-int (substring date 8 10)) - (substring date 4 7) - (substring date -2)))) + (format-time-string "%d %b %y")) ;;; RCS 3 date (defun time-stamp-yy/mm/dd () "Return the current date as a string in \"YY/MM/DD\" form." - (let ((date (current-time-string))) - (format "%s/%02d/%02d" - (substring date -2) - (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) - (string-to-int (substring date 8 10))))) + (format-time-string "%y/%m/%d")) ;;; RCS 5 date (defun time-stamp-yyyy/mm/dd () "Return the current date as a string in \"YYYY/MM/DD\" form." - (let ((date (current-time-string))) - (format "%s/%02d/%02d" - (substring date -4) - (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) - (string-to-int (substring date 8 10))))) + (format-time-string "%Y/%m/%d")) ;;; ISO 8601 date (defun time-stamp-yyyy-mm-dd () "Return the current date as a string in \"YYYY-MM-DD\" form." - (let ((date (current-time-string))) - (format "%s-%02d-%02d" - (substring date -4) - (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) - (string-to-int (substring date 8 10))))) + (format-time-string "%Y-%m-%d")) (defun time-stamp-yymmdd () "Return the current date as a string in \"YYMMDD\" form." - (let ((date (current-time-string))) - (format "%s%02d%02d" - (substring date -2) - (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) - (string-to-int (substring date 8 10))))) + (format-time-string "%y%m%d")) (defun time-stamp-hh:mm:ss () "Return the current time as a string in \"HH:MM:SS\" form." - (substring (current-time-string) 11 19)) + (format-time-string "%T")) (defun time-stamp-hhmm () "Return the current time as a string in \"HHMM\" form." - (let ((date (current-time-string))) - (concat (substring date 11 13) - (substring date 14 16)))) + (format-time-string "%H%M")) (provide 'time-stamp)