...
 
Commits (24)
......@@ -1568,6 +1568,16 @@ ISO 8601 string, like ``Fri, 25 Mar 2016 16:24:56 +0100'' or
less well-formed time strings as well.
@end defun
@vindex ISO 8601 date/time strings
@defun iso8601-parse string
For a more strict function (that will error out upon invalid input),
this function can be used instead. It's able to parse all variants of
the ISO 8601 standard, including things like ``1998W45-3'' (week
number) and ``1998-245'' (ordinal day number). To parse durations,
there's @code{iso8601-parse-duration}, and to parse intervals, there's
@code{iso8601-parse-interval}.
@end defun
@defun format-time-string format-string &optional time zone
This function converts @var{time} (or the current time, if
......
This diff is collapsed.
......@@ -36,6 +36,9 @@
;;; Code:
(require 'cl-lib)
(require 'subr-x)
(defmacro with-decoded-time-value (varlist &rest body)
"Decode a time value and bind it according to VARLIST, then eval BODY.
......@@ -349,6 +352,146 @@ is output until the first non-zero unit is encountered."
(<= (car here) delay)))
(concat (format "%.2f" (/ delay (car (cddr here)))) (cadr here))))))
(defun date-days-in-month (year month)
"The number of days in MONTH in YEAR."
(if (= month 2)
(if (date-leap-year-p year)
29
28)
(if (memq month '(1 3 5 7 8 10 12))
31
30)))
(defun date-ordinal-to-time (year ordinal)
"Convert a YEAR/ORDINAL to the equivalent `decoded-time' structure.
ORDINAL is the number of days since the start of the year, with
January 1st being 1."
(let ((month 1))
(while (> ordinal (date-days-in-month year month))
(setq ordinal (- ordinal (date-days-in-month year month))
month (1+ month)))
(list 0 0 0 ordinal month year nil nil nil)))
(defun decoded-time-add (time delta)
"Add DELTA to TIME, both of which are `decoded-time' structures.
TIME should represent a time, while DELTA should only have
non-nil integers for the values that should be altered.
For instance, if you want to \"add two months\" to TIME, then
leave all other fields but the month field in DELTA nil, and make
the month field 2. The values in DELTA can be negative.
If applying a month/year delta leaves the time spec invalid, it
is decreased to be valid (\"add one month\" to January 31st 2019
will yield a result of February 28th 2019 and \"add one year\" to
February 29th 2020 will result in February 28th 2021).
Fields are added in a most to least significant order, so if the
adjustment described above happens, it happens before adding
days, hours, minutes or seconds.
When changing the time bits in TIME (i.e., second/minute/hour),
changes in daylight saving time are not taken into account."
(let ((time (copy-sequence time))
seconds)
;; Years are simple.
(when (decoded-time-year delta)
(cl-incf (decoded-time-year time) (decoded-time-year delta)))
;; Months are pretty simple.
(when (decoded-time-month delta)
(let ((new (+ (decoded-time-month time) (decoded-time-month delta))))
(setf (decoded-time-month time) (mod new 12))
(cl-incf (decoded-time-year time) (/ new 12))))
;; Adjust for month length (as described in the doc string).
(setf (decoded-time-day time)
(min (date-days-in-month (decoded-time-year time)
(decoded-time-month time))
(decoded-time-day time)))
;; Days are iterative.
(when-let* ((days (decoded-time-day delta)))
(let ((increase (> days 0))
(days (abs days)))
(while (> days 0)
(decoded-time--alter-day time increase)
(cl-decf days))))
;; Do the time part, which is pretty simple (except for leap
;; seconds, I guess).
(setq seconds (+ (* (or (decoded-time-hour delta) 0) 3600)
(* (or (decoded-time-minute delta) 0) 60)
(or (decoded-time-second delta) 0)))
;; Time zone adjustments are basically the same as time adjustments.
(setq seconds (+ seconds (or (decoded-time-zone delta) 0)))
(cond
((> seconds 0)
(decoded-time--alter-second time seconds t))
((< seconds 0)
(decoded-time--alter-second time (abs seconds) nil)))
time))
(defun decoded-time--alter-month (time increase)
"Increase or decrease the month in TIME by 1."
(if increase
(progn
(cl-incf (decoded-time-month time))
(when (> (decoded-time-month time) 12)
(setf (decoded-time-month time) 1)
(cl-incf (decoded-time-year time))))
(cl-decf (decoded-time-month time))
(when (zerop (decoded-time-month time))
(setf (decoded-time-month time) 12)
(cl-decf (decoded-time-year time)))))
(defun decoded-time--alter-day (time increase)
"Increase or decrease the day in TIME by 1."
(if increase
(progn
(cl-incf (decoded-time-day time))
(when (> (decoded-time-day time)
(date-days-in-month (decoded-time-year time)
(decoded-time-month time)))
(setf (decoded-time-day time) 1)
(decoded-time--alter-month time t)))
(cl-decf (decoded-time-day time))
(when (zerop (decoded-time-day time))
(decoded-time--alter-month time nil)
(setf (decoded-time-day time)
(date-days-in-month (decoded-time-year time)
(decoded-time-month time))))))
(defun decoded-time--alter-second (time seconds increase)
"Increase or decrease the time in TIME by SECONDS."
(let ((old (+ (* (or (decoded-time-hour time) 0) 3600)
(* (or (decoded-time-minute time) 0) 60)
(or (decoded-time-second time) 0))))
(if increase
(progn
(setq old (+ old seconds))
(setf (decoded-time-second time) (% old 60)
(decoded-time-minute time) (% (/ old 60) 60)
(decoded-time-hour time) (% (/ old 3600) 24))
;; Hm... DST...
(let ((days (/ old (* 60 60 24))))
(while (> days 0)
(decoded-time--alter-day time t)
(cl-decf days))))
(setq old (abs (- old seconds)))
(setf (decoded-time-second time) (% old 60)
(decoded-time-minute time) (% (/ old 60) 60)
(decoded-time-hour time) (% (/ old 3600) 24))
;; Hm... DST...
(let ((days (/ old (* 60 60 24))))
(while (> days 0)
(decoded-time--alter-day time nil)
(cl-decf days))))))
(provide 'time-date)
;;; time-date.el ends here
......@@ -9054,6 +9054,82 @@ to capitalize ARG words."
(capitalize-region (region-beginning) (region-end))
(capitalize-word arg)))
;;; Accessors for `decode-time' values.
(defsubst decoded-time-second (time)
"The seconds in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 60 (inclusive). (60 is a leap
second, which only some operating systems support.)"
(nth 0 time))
(defsubst decoded-time-minute (time)
"The minutes in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 59 (inclusive)."
(nth 1 time))
(defsubst decoded-time-hour (time)
"The hours in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 23 (inclusive)."
(nth 2 time))
(defsubst decoded-time-day (time)
"The day-of-the-month in TIME, which is a value returned by `decode-time'.
This is an integer between 1 and 31 (inclusive)."
(nth 3 time))
(defsubst decoded-time-month (time)
"The month in TIME, which is a value returned by `decode-time'.
This is an integer between 1 and 12 (inclusive). January is 1."
(nth 4 time))
(defsubst decoded-time-year (time)
"The year in TIME, which is a value returned by `decode-time'.
This is a four digit integer."
(nth 5 time))
(defsubst decoded-time-weekday (time)
"The day-of-the-week in TIME, which is a value returned by `decode-time'.
This is a number between 0 and 6, and 0 is Sunday."
(nth 6 time))
(defsubst decoded-time-dst (time)
"The daylight saving time in TIME, which is a value returned by `decode-time'.
This is t if daylight saving time is in effect, and nil if not."
(nth 7 time))
(defsubst decoded-time-zone (time)
"The time zone in TIME, which is a value returned by `decode-time'.
This is an integer indicating the UTC offset in seconds, i.e.,
the number of seconds east of Greenwich."
(nth 8 time))
(gv-define-setter decoded-time-second (second time)
`(setf (nth 0 ,time) ,second))
(gv-define-setter decoded-time-minute (minute time)
`(setf (nth 1 ,time) ,minute))
(gv-define-setter decoded-time-hour (hour time)
`(setf (nth 2 ,time) ,hour))
(gv-define-setter decoded-time-day (day time)
`(setf (nth 3 ,time) ,day))
(gv-define-setter decoded-time-month (month time)
`(setf (nth 4 ,time) ,month))
(gv-define-setter decoded-time-year (year time)
`(setf (nth 5 ,time) ,year))
;; No setter for weekday, which is the 6th element.
(gv-define-setter decoded-time-dst (dst time)
`(setf (nth 7 ,time) ,dst))
(gv-define-setter decoded-time-zone (zone time)
`(setf (nth 8 ,time) ,zone))
(provide 'simple)
......
......@@ -1326,6 +1326,12 @@ the TZ environment variable. It can also be a list (as from
`current-time-zone') or an integer (the UTC offset in seconds) applied
without consideration for daylight saving time.
To access (or alter) the elements in the time value, the
`decoded-time-second', `decoded-time-minute', `decoded-time-hour',
`decoded-time-day', `decoded-time-month', `decoded-time-year',
`decoded-time-weekday', `decoded-time-dst' and `decoded-time-zone'
accessors can be used.
The list has the following nine members: SEC is an integer between 0
and 60; SEC is 60 for a leap second, which only some operating systems
support. MINUTE is an integer between 0 and 59. HOUR is an integer
......
This diff is collapsed.
;;; time-date-tests.el --- tests for calendar/time-date.el -*- lexical-binding:t -*-
;; Copyright (C) 2019 Free Software Foundation, Inc.
;; 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
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) 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. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(require 'time-date)
(ert-deftest test-leap-year ()
(should-not (date-leap-year-p 1999))
(should-not (date-leap-year-p 1900))
(should (date-leap-year-p 2000))
(should (date-leap-year-p 2004)))
(ert-deftest test-days-in-month ()
(should (= (date-days-in-month 2004 2) 29))
(should (= (date-days-in-month 2004 3) 31))
(should-not (= (date-days-in-month 1900 3) 28)))
(ert-deftest test-ordinal ()
(should (equal (date-ordinal-to-time 2008 271)
'(0 0 0 27 9 2008 nil nil nil)))
(should (equal (date-ordinal-to-time 2008 1)
'(0 0 0 1 1 2008 nil nil nil)))
(should (equal (date-ordinal-to-time 2008 32)
'(0 0 0 1 2 2008 nil nil nil)))
(should (equal (date-ordinal-to-time 1981 095)
'(0 0 0 5 4 1981 nil nil nil))))
(cl-defmethod mdec (&key second minute hour
day month year
dst zone)
(list second minute hour day month year nil dst zone))
(ert-deftest test-decoded-add ()
(let ((time '(12 15 16 8 7 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :year 1))
'(12 15 16 8 7 2020 1 t 7200)))
(should (equal (decoded-time-add time (mdec :year -2))
'(12 15 16 8 7 2017 1 t 7200)))
(should (equal (decoded-time-add time (mdec :month 1))
'(12 15 16 8 8 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :month 10))
'(12 15 16 8 5 2020 1 t 7200)))
(should (equal (decoded-time-add time (mdec :day 1))
'(12 15 16 9 7 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :day -1))
'(12 15 16 7 7 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :day 30))
'(12 15 16 7 8 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :day -365))
'(12 15 16 8 7 2018 1 t 7200)))
(should (equal (decoded-time-add time (mdec :day 365))
'(12 15 16 7 7 2020 1 t 7200)))
;; 2020 is a leap year.
(should (equal (decoded-time-add time (mdec :day 366))
'(12 15 16 8 7 2020 1 t 7200)))
(should (equal (decoded-time-add time (mdec :second 1))
'(13 15 16 8 7 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :second -1))
'(11 15 16 8 7 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :second 61))
'(13 16 16 8 7 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :hour 1 :minute 2 :second 3))
'(15 17 17 8 7 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :hour 24))
'(12 15 16 9 7 2019 1 t 7200)))
))
(ert-deftest test-decoded-add-zone ()
(let ((time '(12 15 16 8 7 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :zone -3600))
'(12 15 15 8 7 2019 1 t 7200)))
(should (equal (decoded-time-add time (mdec :zone -7200))
'(12 15 14 8 7 2019 1 t 7200)))))
(require 'ert)
;;; time-date-tests.el ends here