aboutsummaryrefslogtreecommitdiff
path: root/module/output/ical.scm
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-03-23 00:34:28 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2020-03-23 00:36:21 +0100
commitae47899079a448b2d71101d4b21c8e9409d82e34 (patch)
tree73fa1ec4d618d2a66650fee59b1e377cd7b3e40a /module/output/ical.scm
parentRemove unused datetime->decimal-hour. (diff)
downloadcalp-ae47899079a448b2d71101d4b21c8e9409d82e34.tar.gz
calp-ae47899079a448b2d71101d4b21c8e9409d82e34.tar.xz
Remove deprecated get-time.
Diffstat (limited to 'module/output/ical.scm')
-rw-r--r--module/output/ical.scm49
1 files changed, 25 insertions, 24 deletions
diff --git a/module/output/ical.scm b/module/output/ical.scm
index c18a203a..0252320b 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -16,30 +16,31 @@
(define (value-format key vline)
(with-throw-handler 'wrong-type-arg
(lambda ()
- (case key
- ((DTSTART DTEND RECURRENCE-ID)
- (with-output-to-string
- (lambda ()
- (display (date->string (as-date (value vline))
- "~Y~m~d"))
- (when (eq? 'DATE-TIME (and=> (prop vline 'VALUE) car))
- (display (time->string (get-time (value vline))
- "T~H~M~S"))
- (let ((tz (and=> (prop vline 'TZID) car)))
- (when (and tz (string= tz "UTC"))
- (display #\Z))))))
- )
- ((DURATION X-HNH-DURATION)
- #; (time->string value "~H~M~S")
- (let ((s (second (value vline))))
- (format #f "~a~a~a"
- (floor/ s 3600)
- (floor/ (modulo s 3600) 60)
- (modulo s 60))
- ))
- ((RRULE) (value vline))
-
- (else (escape-chars (value vline)))))
+ (case key
+ ((DTSTART DTEND RECURRENCE-ID)
+ (with-output-to-string
+ (lambda ()
+ (case (and=> (prop vline 'VALUE) car)
+ [(DATE) (display (date->string (as-date (value vline))
+ "~Y~m~d"))]
+ [(DATE-TIME)
+ (display (datetime->string (value vline) "~Y~m~dT~H~M~S"))
+ (let ((tz (and=> (prop vline 'TZID) car)))
+ (when (and tz (string= tz "UTC"))
+ (display #\Z)))]
+ [else
+ (error "Unknown VALUE type")]))))
+ ((DURATION X-HNH-DURATION)
+ #; (time->string value "~H~M~S")
+ (let ((s (second (value vline))))
+ (format #f "~a~a~a"
+ (floor/ s 3600)
+ (floor/ (modulo s 3600) 60)
+ (modulo s 60))
+ ))
+ ((RRULE) (value vline))
+
+ (else (escape-chars (value vline)))))
(lambda (err caller fmt args call-args)
(format (current-error-port)
"WARNING: key = ~a, caller = ~s, call-args = ~s~%~k~%" key caller call-args fmt args)