6 files changed, 419 insertions, 0 deletions

diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index fef954eb7a3..d397a125738 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1466,6 +1466,60 @@ seconds east of Greenwich.
 
 @strong{Common Lisp Note:} Common Lisp has different meanings for
 @var{dow} and @var{utcoff}.
+
+To access (or alter) the elements in the time value, the
+@code{decoded-time-second}, @code{decoded-time-minute},
+@code{decoded-time-hour}, @code{decoded-time-day},
+@code{decoded-time-month}, @code{decoded-time-year},
+@code{decoded-time-weekday}, @code{decoded-time-dst} and
+@code{decoded-time-zone} accessors can be used.
+
+For instance, to increase the year in a decoded time, you could say:
+
+@lisp
+(setf (decoded-time-year decoded-time)
+      (+ (decoded-time-year decoded-time) 4))
+@end lisp
+
+Also see the following function.
+
+@end defun
+
+@defun decoded-time-add time delta
+This function takes a decoded time structure and adds @var{delta}
+(also a decoded time structure) to it.  Elements in @var{delta} that
+are @code{nil} are ignored.
+
+For instance, if you want ``same time next month'', you
+could say:
+
+@lisp
+(let ((time (decode-time))
+      (delta (make-decoded-time :month 2)))
+   (encode-time (decoded-time-add time delta)))
+@end lisp
+
+If this date doesn't exist (if you're running this on January 31st,
+for instance), then the date will be shifted back until you get a
+valid date (which will be February 28th or 29th, depending).
+
+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.
+
+The values in @var{delta} can be negative to subtract values instead.
+
+The return value is a decoded time structure.
+@end defun
+
+@defun make-decoded-time &key second minute hour day month year dst zone
+Return a decoded time structure with only the given keywords filled
+out, leaving the rest @code{nil}.  For instance, to get a structure
+that represents ``two months'', you could say:
+
+@lisp
+(make-decoded-time :month 2)
+@end lisp
 @end defun
 
 @defun encode-time &optional time form &rest obsolescent-arguments
@@ -1867,6 +1921,16 @@ This returns the day number within the year corresponding to @var{time-value}.
 This function returns @code{t} if @var{year} is a leap year.
 @end defun
 
+@defun date-days-in-month year month
+Return the number of days in @var{month} in @var{year}.  For instance,
+there's 29 days in February 2004.
+@end defun
+
+@defun date-ordinal-to-time year ordinal
+Return the date of @var{ordinal} in @var{year} as a decoded time
+structure.  For instance, the 120th day in 2004 is April 29th.
+@end defun
+
 @node Timers
 @section Timers for Delayed Execution
 @cindex timers
diff --git a/etc/NEWS b/etc/NEWS
index c654b9ba34a..2bdbfcb8d08 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2069,6 +2069,21 @@ that acts like the '0' flag but also puts a '+' before nonnegative
 years containing more than four digits.  This is for compatibility
 with POSIX.1-2017.
 
++++
+*** To access (or alter) the elements a decoded 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 new functions `date-days-in-month' (which will say how many
+days there are in a month in a specific year), `date-ordinal-to-time'
+(that computes the date of an ordinal day), `decoded-time-add' for
+doing computations on a decoded time structure), and
+`make-decoded-time' (for making a decoded time structure with only the
+given keywords filled out) have been added.
+
 ** 'define-minor-mode' automatically documents the meaning of ARG.
 
 +++
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 2c0280ccf3b..d299dc5e7d1 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -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,152 @@ 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 nil nil nil 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))))))
+
+(cl-defun make-decoded-time (&key second minute hour
+                                  day month year
+                                  dst zone)
+  "Return a `decoded-time' structure with only the keywords given filled out."
+  (list second minute hour day month year nil dst zone))
+
 (provide 'time-date)
 
 ;;; time-date.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index 75be4fe7cb5..8855045123f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -9063,6 +9063,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)
diff --git a/src/timefns.c b/src/timefns.c
index 3b7ed460222..cce9dd51ba9 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -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
diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el
new file mode 100644
index 00000000000..d6cf742bc53
--- /dev/null
+++ b/test/lisp/calendar/time-date-tests.el
@@ -0,0 +1,109 @@
+;;; 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