]> code.delx.au - gnu-emacs/blobdiff - lisp/time-stamp.el
(smtpmail-send-it): Add autoload cookie.
[gnu-emacs] / lisp / time-stamp.el
index 37b74b7008f938ef918a447376d309d330b6505b..b7a85400d72290b0eb4012a5f68a7f2349c8f797 100644 (file)
@@ -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 <gildea@lcs.mit.edu>
+;; Copyright 1989, 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
+
+;; Maintainer's Time-stamp: <1998-03-04 14:14:19 gildea>
+;; Maintainer: Stephen Gildea <gildea@alum.mit.edu>
 ;; Keywords: tools
 
 ;; This file is free software; you can redistribute it and/or modify
 ;; 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 <mcvax!harlqn.co.uk!jcgs@uunet.uu.net>
-;;; 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)