From 6cfda69d72cb9debefc48d0d95e341d389e7303a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 29 Jul 2019 14:15:03 +0200 Subject: [PATCH] Add support for dealing with decoded time structures * doc/lispref/os.texi (Time Conversion): Document the new functions that work on decoded time. (Time Calculations): Document new date/time functions. * lisp/simple.el (decoded-time-second, decoded-time-minute) (decoded-time-hour, decoded-time-day, decoded-time-month) (decoded-time-year, decoded-time-weekday, decoded-time-dst) (decoded-time-zone): New accessor functions for decoded time values. * lisp/calendar/time-date.el (date-days-in-month) (date-ordinal-to-time): New functions. (decoded-time--alter-month, decoded-time--alter-day) (decoded-time--alter-second, make-decoded-time): New functions added to manipulate decoded time structures. * src/timefns.c (Fdecode_time): Mention the new accessors. * test/lisp/calendar/time-date-tests.el: New file to test the decoded time functions and the other new functions. --- doc/lispref/os.texi | 64 +++++++++++ etc/NEWS | 15 +++ lisp/calendar/time-date.el | 149 ++++++++++++++++++++++++++ lisp/simple.el | 76 +++++++++++++ src/timefns.c | 6 ++ test/lisp/calendar/time-date-tests.el | 109 +++++++++++++++++++ 6 files changed, 419 insertions(+) create mode 100644 test/lisp/calendar/time-date-tests.el 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 . + +;;; 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 -- 2.39.2