diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-12 19:06:31 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-12 19:06:31 +0100 |
commit | 49f309563596c65bd65cf49928ae70bc242626ac (patch) | |
tree | 54b01b464332736d3884fb59e45b13130b48e280 /srfi | |
parent | Update vcalendar to utilize TYPE field. (diff) | |
download | calp-49f309563596c65bd65cf49928ae70bc242626ac.tar.gz calp-49f309563596c65bd65cf49928ae70bc242626ac.tar.xz |
Add some more time utils.
Diffstat (limited to '')
-rw-r--r-- | srfi/srfi-19/util.scm | 18 |
1 files changed, 14 insertions, 4 deletions
diff --git a/srfi/srfi-19/util.scm b/srfi/srfi-19/util.scm index c0a7fd5e..2ec7140d 100644 --- a/srfi/srfi-19/util.scm +++ b/srfi/srfi-19/util.scm @@ -4,11 +4,12 @@ #:use-module (srfi srfi-19 setters) #:export (copy-date drop-time! drop-time - today? + in-day? today? ;; seconds minutes hours days weeks ;; time-add make-duration - time->string)) + time->string + add-day remove-day)) #; (define (copy-date date) @@ -37,12 +38,21 @@ attribute set to 0. Can also be seen as \"Start of day\"" (define (make-duration s) (make-time time-duration 0 s)) -(define (today? time) - (let* ((now (date->time-utc (drop-time (current-date)))) +(define (in-day? day-date time) + (let* ((now (date->time-utc (drop-time day-date))) (then (add-duration now (make-duration (* 60 60 24))))) (and (time<=? now time) (time<=? time then)))) +(define (today? time) + (in-day? (current-date) time)) + (define* (time->string time #:optional (format "~c")) (date->string (time-utc->date time) format)) + +(define (add-day time) + (add-duration time (make-time time-duration 0 (* 60 60 24)))) + +(define (remove-day time) + (add-duration time (make-time time-duration 0 (- (* 60 60 24))))) |