[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 6cfda69 1/2: Add support for dealing with decoded t
|
From: |
Lars Ingebrigtsen |
|
Subject: |
[Emacs-diffs] master 6cfda69 1/2: Add support for dealing with decoded time structures |
|
Date: |
Mon, 29 Jul 2019 08:22:56 -0400 (EDT) |
branch: master
commit 6cfda69d72cb9debefc48d0d95e341d389e7303a
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>
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(+)
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index fef954e..d397a12 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 c654b9b..2bdbfcb 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 2c0280c..d299dc5 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 75be4fe..8855045 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 3b7ed46..cce9dd5 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 0000000..d6cf742
--- /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