procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add support for dealing with decoded time structures

Browse source 
* 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.
This commit is contained in:
Lars Ingebrigtsen 2019-07-29 14:15:03 +02:00
parent e4f957fb07
commit 6cfda69d72
6 changed files with 419 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
doc/lispref/os.texi
View file

@ -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

15
etc/NEWS
View file

@ -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.
+++

149
lisp/calendar/time-date.el
View file

@ -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

76
lisp/simple.el
View file

@ -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)

6
src/timefns.c
View file

@ -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

109
test/lisp/calendar/time-date-tests.el Normal file
View file

@ -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