diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-03-22 20:14:47 +0100 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-03-22 20:14:47 +0100 |
| commit | 7c183a5814058e8c20a14308eca9620988cb9ae5 (patch) | |
| tree | 56c60a8ab68fd9b9a345d49b8cfeafcc5188275f /module/datetime/util.scm | |
| parent | HTML small cal table now works with better intervals. (diff) | |
| download | calp-7c183a5814058e8c20a14308eca9620988cb9ae5.tar.gz calp-7c183a5814058e8c20a14308eca9620988cb9ae5.tar.xz | |
Add previous-week-start procedure.
Diffstat (limited to '')
| -rw-r--r-- | module/datetime/util.scm | 11 |
1 files changed, 11 insertions, 0 deletions
diff --git a/module/datetime/util.scm b/module/datetime/util.scm index 50c7c725..ff75e86d 100644 --- a/module/datetime/util.scm +++ b/module/datetime/util.scm @@ -70,6 +70,17 @@ (zeller J (1- K) (+ m 12) (day date)) (zeller J K (month date) (day date))))) +;; Given a date, returns the earliest start of week going backwards from that date. +;; sön 22 mar 2020 20:09:57 CET +;; @example +;; (previous-week-start #2020-03-22 mon) +;; => 2020-03-16 +(define-public (previous-week-start date* week-start) + ((@ (srfi srfi-41 util) stream-find) + (lambda (d) (= week-start (week-day d))) + ((@ (srfi srfi-41) stream-iterate) (cut date- <> (date day: 1)) + date*))) + (define-many define-public (sun) 0 (mon) 1 |