diff options
| -rw-r--r-- | code.scm | 5 | ||||
| -rwxr-xr-x | main.scm | 6 | ||||
| -rw-r--r-- | srfi/srfi-19/util.scm | 29 |
3 files changed, 21 insertions, 19 deletions
@@ -1,12 +1,13 @@ (define-module (code) #:export (extract sort* color-if - for-each-in STR-YELLOW STR-RESET + STR-YELLOW STR-RESET print-vcomponent)) (use-modules (srfi srfi-19) (srfi srfi-19 util) (srfi srfi-26) - (vcalendar)) + (vcalendar) + (util)) (define (extract field) (cut get-attr <> field)) @@ -27,7 +27,7 @@ (define (main args) (define path (if (null? (cdr (command-line))) - "testcal/d1-b.ics" + "testcal/repeating-event.ics" (cadr (command-line)))) (define cal (make-vcomponent path)) @@ -38,8 +38,8 @@ time<? (extract "DTSTART")) (lambda (ev) (format #t "~a | ~a~%" (let ((start (get-attr ev "DTSTART"))) - (color-if (date-today? start) STR-YELLOW - (date->string (time-utc->date start) "~1 ~H:~M"))) + (color-if (today? start) STR-YELLOW + (time->string start "~1 ~H:~M"))) (get-attr ev "SUMMARY"))))) diff --git a/srfi/srfi-19/util.scm b/srfi/srfi-19/util.scm index ab951ea4..05deb39b 100644 --- a/srfi/srfi-19/util.scm +++ b/srfi/srfi-19/util.scm @@ -5,7 +5,8 @@ #:export (copy-date drop-time! drop-time localize-date - date-today? + ;; date-today? + today? seconds minutes hours days weeks date-add time-add @@ -52,11 +53,20 @@ transposed to the current timezone. Current timezone gotten from (time-utc->date (date->time-utc date) (date-zone-offset (current-date)))) +(define seconds 1) +(define minutes 60) +(define hours (* 60 minutes)) +(define days (* 24 hours)) +(define weeks (* 7 days)) + +(define (time-add time amount unit) + (add-duration time (make-time time-duration 0 (* amount unit)))) + (define (today? time) - (let* ((now (current-date)) - (then (add-duration time (make-time time-difference 0 (* 24 3600))))) - (and (time<=? time now) - (time<=? now then)))) + (let* ((now (date->time-utc (current-date))) + (then (time-add now 1 days))) + (and (time<=? now time) + (time<=? time then)))) #; (define (date-today? input-date) @@ -68,15 +78,6 @@ transposed to the current timezone. Current timezone gotten from (and (%date<=? now input-date) (%date<=? input-date then)))) -(define seconds 1) -(define minutes 60) -(define hours (* 60 minutes)) -(define days (* 24 hours)) -(define weeks (* 7 days)) - -(define (time-add time amount unit) - (add-duration time (make-time time-duration 0 (* amount unit)))) - #; (define (date-add date amount unit) (time-utc->date (add-duration (date->time-utc date) |