lisp/time-stamp.el

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