time-date.el 12.3 KB
Newer Older
1
;;; time-date.el --- Date and time handling functions
2

Glenn Morris's avatar
Glenn Morris committed
3 4
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;;   2007, 2008  Free Software Foundation, Inc.
Gerd Moellmann's avatar
Gerd Moellmann committed
5 6 7 8 9 10 11 12 13

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;;	Masanobu Umeda <umerin@mse.kyutech.ac.jp>
;; Keywords: mail news util

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
14
;; the Free Software Foundation; either version 3, or (at your option)
Gerd Moellmann's avatar
Gerd Moellmann committed
15 16 17 18 19 20 21 22 23
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; 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
Lute Kamstra's avatar
Lute Kamstra committed
24 25
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Gerd Moellmann's avatar
Gerd Moellmann committed
26 27 28

;;; Commentary:

29 30 31 32 33 34 35 36 37 38 39 40 41
;; Time values come in three formats.  The oldest format is a cons
;; cell of the form (HIGH . LOW).  This format is obsolete, but still
;; supported.  The two other formats are the lists (HIGH LOW) and
;; (HIGH LOW MICRO).  The first two formats specify HIGH * 2^16 + LOW
;; seconds; the third format specifies HIGH * 2^16 + LOW + MICRO /
;; 1000000 seconds.  We should have 0 <= MICRO < 1000000 and 0 <= LOW
;; < 2^16.  If the time value represents a point in time, then HIGH is
;; nonnegative.  If the time value is a time difference, then HIGH can
;; be negative as well.  The macro `with-decoded-time-value' and the
;; function `encode-time-value' make it easier to deal with these
;; three formats.  See `time-subtract' for an example of how to use
;; them.

Gerd Moellmann's avatar
Gerd Moellmann committed
42 43
;;; Code:

44 45 46 47 48 49 50 51 52 53 54 55
(defmacro with-decoded-time-value (varlist &rest body)
  "Decode a time value and bind it according to VARLIST, then eval BODY.

The value of the last form in BODY is returned.

Each element of the list VARLIST is a list of the form
\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [TYPE-SYMBOL] TIME-VALUE).
The time value TIME-VALUE is decoded and the result it bound to
the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL.

The optional TYPE-SYMBOL is bound to the type of the time value.
Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH
56
LOW), and type 2 is the list (HIGH LOW MICRO)."
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
  (declare (indent 1)
	   (debug ((&rest (symbolp symbolp symbolp &or [symbolp form] form))
		   body)))
  (if varlist
      (let* ((elt (pop varlist))
	     (high (pop elt))
	     (low (pop elt))
	     (micro (pop elt))
	     (type (unless (eq (length elt) 1)
		     (pop elt)))
	     (time-value (car elt))
	     (gensym (make-symbol "time")))
	`(let* ,(append `((,gensym ,time-value)
			  (,high (pop ,gensym))
			  ,low ,micro)
			(when type `(,type)))
	   (if (consp ,gensym)
	       (progn
		 (setq ,low (pop ,gensym))
		 (if ,gensym
		     ,(append `(setq ,micro (car ,gensym))
			      (when type `(,type 2)))
		   ,(append `(setq ,micro 0)
			    (when type `(,type 1)))))
	     ,(append `(setq ,low ,gensym ,micro 0)
		      (when type `(,type 0))))
	   (with-decoded-time-value ,varlist ,@body)))
    `(progn ,@body)))

(defun encode-time-value (high low micro type)
  "Encode HIGH, LOW, and MICRO into a time value of type TYPE.
Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH LOW),
89
and type 2 is the list (HIGH LOW MICRO)."
90 91 92 93
  (cond
   ((eq type 0) (cons high low))
   ((eq type 1) (list high low))
   ((eq type 2) (list high low micro))))
Gerd Moellmann's avatar
Gerd Moellmann committed
94

95
(autoload 'parse-time-string "parse-time")
96 97
(autoload 'timezone-make-date-arpa-standard "timezone")

Gerd Moellmann's avatar
Gerd Moellmann committed
98 99
;;;###autoload
(defun date-to-time (date)
100
  "Parse a string that represents a date-time and return a time value."
Gerd Moellmann's avatar
Gerd Moellmann committed
101
  (condition-case ()
102 103 104 105
      (apply 'encode-time
	     (parse-time-string
	      ;; `parse-time-string' isn't sufficiently general or
	      ;; robust.  It fails to grok some of the formats that
106
	      ;; timezone does (e.g. dodgy post-2000 stuff from some
107 108 109 110
	      ;; Elms) and either fails or returns bogus values.  Lars
	      ;; reverted this change, but that loses non-trivially
	      ;; often for me.  -- fx
	      (timezone-make-date-arpa-standard date)))
Gerd Moellmann's avatar
Gerd Moellmann committed
111 112
    (error (error "Invalid date: %s" date))))

113
;;;###autoload
Gerd Moellmann's avatar
Gerd Moellmann committed
114
(defun time-to-seconds (time)
115 116
  "Convert time value TIME to a floating point number.
You can use `float-time' instead."
117
  (with-decoded-time-value ((high low micro time))
118
    (+ (* 1.0 high 65536)
119 120
       low
       (/ micro 1000000.0))))
Gerd Moellmann's avatar
Gerd Moellmann committed
121

122
;;;###autoload
Gerd Moellmann's avatar
Gerd Moellmann committed
123
(defun seconds-to-time (seconds)
124
  "Convert SECONDS (a floating point number) to a time value."
125 126
  (list (floor seconds 65536)
	(floor (mod seconds 65536))
Gerd Moellmann's avatar
Gerd Moellmann committed
127 128
	(floor (* (- seconds (ffloor seconds)) 1000000))))

129
;;;###autoload
Gerd Moellmann's avatar
Gerd Moellmann committed
130
(defun time-less-p (t1 t2)
131
  "Say whether time value T1 is less than time value T2."
132 133 134 135 136 137 138
  (with-decoded-time-value ((high1 low1 micro1 t1)
			    (high2 low2 micro2 t2))
    (or (< high1 high2)
	(and (= high1 high2)
	     (or (< low1 low2)
		 (and (= low1 low2)
		      (< micro1 micro2)))))))
Gerd Moellmann's avatar
Gerd Moellmann committed
139

140
;;;###autoload
Gerd Moellmann's avatar
Gerd Moellmann committed
141
(defun days-to-time (days)
142
  "Convert DAYS into a time value."
Gerd Moellmann's avatar
Gerd Moellmann committed
143
  (let* ((seconds (* 1.0 days 60 60 24))
144
	 (high (condition-case nil (floor (/ seconds 65536))
145
		 (range-error most-positive-fixnum))))
146 147
    (list high (condition-case nil (floor (- seconds (* 1.0 high 65536)))
		 (range-error 65535)))))
Gerd Moellmann's avatar
Gerd Moellmann committed
148

149
;;;###autoload
Gerd Moellmann's avatar
Gerd Moellmann committed
150
(defun time-since (time)
151 152
  "Return the time elapsed since TIME.
TIME should be either a time value or a date-time string."
Gerd Moellmann's avatar
Gerd Moellmann committed
153 154 155
  (when (stringp time)
    ;; Convert date strings to internal time.
    (setq time (date-to-time time)))
156
  (time-subtract (current-time) time))
Gerd Moellmann's avatar
Gerd Moellmann committed
157

158 159 160 161 162 163 164
;;;###autoload
(defalias 'subtract-time 'time-subtract)

;;;###autoload
(defun time-subtract (t1 t2)
  "Subtract two time values.
Return the difference in the format of a time value."
165 166 167 168 169 170 171 172 173 174 175
  (with-decoded-time-value ((high low micro type t1)
			    (high2 low2 micro2 type2 t2))
    (setq high (- high high2)
	  low (- low low2)
	  micro (- micro micro2)
	  type (max type type2))
    (when (< micro 0)
      (setq low (1- low)
	    micro (+ micro 1000000)))
    (when (< low 0)
      (setq high (1- high)
176
	    low (+ low 65536)))
177
    (encode-time-value high low micro type)))
Gerd Moellmann's avatar
Gerd Moellmann committed
178

179 180 181
;;;###autoload
(defun time-add (t1 t2)
  "Add two time values.  One should represent a time difference."
182 183 184 185 186 187 188 189 190
  (with-decoded-time-value ((high low micro type t1)
			    (high2 low2 micro2 type2 t2))
    (setq high (+ high high2)
	  low (+ low low2)
	  micro (+ micro micro2)
	  type (max type type2))
    (when (>= micro 1000000)
      (setq low (1+ low)
	    micro (- micro 1000000)))
191
    (when (>= low 65536)
192
      (setq high (1+ high)
193
	    low (- low 65536)))
194
    (encode-time-value high low micro type)))
195 196

;;;###autoload
Gerd Moellmann's avatar
Gerd Moellmann committed
197
(defun date-to-day (date)
198 199
  "Return the number of days between year 1 and DATE.
DATE should be a date-time string."
Gerd Moellmann's avatar
Gerd Moellmann committed
200 201
  (time-to-days (date-to-time date)))

202
;;;###autoload
Gerd Moellmann's avatar
Gerd Moellmann committed
203
(defun days-between (date1 date2)
204 205
  "Return the number of days between DATE1 and DATE2.
DATE1 and DATE2 should be date-time strings."
Gerd Moellmann's avatar
Gerd Moellmann committed
206 207
  (- (date-to-day date1) (date-to-day date2)))

208
;;;###autoload
Gerd Moellmann's avatar
Gerd Moellmann committed
209 210 211 212 213 214
(defun date-leap-year-p (year)
  "Return t if YEAR is a leap year."
  (or (and (zerop (% year 4))
	   (not (zerop (% year 100))))
      (zerop (% year 400))))

215
;;;###autoload
Gerd Moellmann's avatar
Gerd Moellmann committed
216
(defun time-to-day-in-year (time)
217
  "Return the day number within the year corresponding to TIME."
Gerd Moellmann's avatar
Gerd Moellmann committed
218 219 220 221 222 223 224 225 226 227 228
  (let* ((tim (decode-time time))
	 (month (nth 4 tim))
	 (day (nth 3 tim))
	 (year (nth 5 tim))
	 (day-of-year (+ day (* 31 (1- month)))))
    (when (> month 2)
      (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
      (when (date-leap-year-p year)
	(setq day-of-year (1+ day-of-year))))
    day-of-year))

229
;;;###autoload
Gerd Moellmann's avatar
Gerd Moellmann committed
230 231
(defun time-to-days (time)
  "The number of days between the Gregorian date 0001-12-31bce and TIME.
232
TIME should be a time value.
Gerd Moellmann's avatar
Gerd Moellmann committed
233 234 235 236 237 238 239 240 241 242 243
The Gregorian date Sunday, December 31, 1bce is imaginary."
  (let* ((tim (decode-time time))
	 (month (nth 4 tim))
	 (day (nth 3 tim))
	 (year (nth 5 tim)))
    (+ (time-to-day-in-year time)	; 	Days this year
       (* 365 (1- year))		;	+ Days in prior years
       (/ (1- year) 4)			;	+ Julian leap years
       (- (/ (1- year) 100))		;	- century years
       (/ (1- year) 400))))		;	+ Gregorian leap years

244 245 246
(defun time-to-number-of-days (time)
  "Return the number of days represented by TIME.
The number of days will be returned as a floating point number."
247
  (/ (time-to-seconds time) (* 60 60 24)))
248

Gerd Moellmann's avatar
Gerd Moellmann committed
249 250
;;;###autoload
(defun safe-date-to-time (date)
251 252
  "Parse a string that represents a date-time and return a time value.
If DATE is malformed, return a time value of zeros."
Gerd Moellmann's avatar
Gerd Moellmann committed
253 254 255 256
  (condition-case ()
      (date-to-time date)
    (error '(0 0))))

Glenn Morris's avatar
Glenn Morris committed
257 258

;;;###autoload
Glenn Morris's avatar
Glenn Morris committed
259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287
(defun format-seconds (string seconds &optional nonzero)
  "Use format control STRING to format the number SECONDS.
The valid format specifiers are:
%y is the number of (365-day) years.
%d is the number of days.
%h is the number of hours.
%m is the number of minutes.
%s is the number of seconds.
%% is a literal \"%\".

Upper-case specifiers are followed by the unit-name (e.g. \"years\").
Lower-case specifiers return only the unit.

\"%\" may be followed by a number specifying a width, with an
optional leading \".\" for zero-padding.  For example, \"%.3Y\" will
return something of the form \"001 year\".

If the optional argument NONZERO is non-nil, then nothing is output until
the first non-zero unit (or the last unit) is encountered.  In this case,
specifiers must be used in order of decreasing size.

This does not work for input SECONDS greater than `most-positive-fixnum'."
  (let ((start 0)
        (units '(("y" "year"   31536000)
                 ("d" "day"       86400)
                 ("h" "hour"       3600)
                 ("m" "minute"       60)
                 ("s" "second"        1)))
        (case-fold-search t)
288
        spec match outunits unit prev name num next)
Glenn Morris's avatar
Glenn Morris committed
289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337
    (setq nonzero (not nonzero))
    (while (string-match "%\\.?[0-9]*\\(.\\)" string start)
      (setq start (match-end 0)
            spec (match-string 1 string))
      (unless (string-equal spec "%")
        (or (setq match (assoc-string spec units t))
            (error "Bad format specifier: `%s'" spec))
        (if (assoc-string spec outunits t)
            (error "Multiple instances of specifier: `%s'" spec))
        (unless nonzero
          (setq unit (nth 2 match))
          (and prev (> unit prev)
               (error "Units are not in decreasing order of size"))
          (setq prev unit))
        (push match outunits)))
    ;; Cf article-make-date-line in gnus-art.
    (dolist (ulist units)
      (setq spec (car ulist)
            name (cadr ulist)
            unit (nth 2 ulist))
      (when (string-match (format "%%\\(\\.?[0-9]+\\)?\\(%s\\)" spec) string)
        (setq num (floor seconds unit)
              seconds (- seconds (* num unit)))
        (or nonzero
            (setq nonzero (not (zerop num)))
            ;; Start of the next unit specifier, if there is one.
            (setq next (save-match-data
                         (string-match "%\\.?[0-9]*[a-z]"
                                       string (match-end 0)))))
        ;; If there are no more specifiers, we have to print this one,
        ;; even if it is zero.
        (or nonzero (setq nonzero (not next)))
        (setq string
              (if nonzero
                  (replace-match
                   (format (concat "%" (match-string 1 string) "d%s") num
                           (if (string-equal (match-string 2 string) spec)
                               ""       ; lower-case, no unit-name
                             (format " %s%s" name
                                     (if (= num 1) "" "s"))))
                   t t string)
                ;; If we haven't found a non-zero unit yet, delete
                ;; everything up to the next format specifier.
                (substring string next))))))
  (replace-regexp-in-string "%%" "%" string))


;; This doesn't really belong here - perhaps in time.el?
;;;###autoload
Glenn Morris's avatar
Glenn Morris committed
338 339 340
(defun emacs-uptime ()
  "Return a string giving the uptime of this instance of Emacs."
  (interactive)
Glenn Morris's avatar
Glenn Morris committed
341 342 343 344 345
  (let ((str
         (format-seconds "%Y, %D, %H, %M, %S"
                         (time-to-seconds
                          (time-subtract (current-time) emacs-startup-time))
                         t)))
Glenn Morris's avatar
Glenn Morris committed
346 347 348 349
    (if (interactive-p)
        (message "%s" str)
      str)))

Gerd Moellmann's avatar
Gerd Moellmann committed
350 351
(provide 'time-date)

Miles Bader's avatar
Miles Bader committed
352
;;; arch-tag: addcf07b-b20a-465b-af72-550b8ac5190f
Gerd Moellmann's avatar
Gerd Moellmann committed
353
;;; time-date.el ends here