diff options
Diffstat (limited to '')
-rw-r--r-- | module/output/html.scm | 14 | ||||
-rw-r--r-- | module/output/ical.scm | 49 | ||||
-rw-r--r-- | module/output/terminal.scm | 18 |
3 files changed, 36 insertions, 45 deletions
diff --git a/module/output/html.scm b/module/output/html.scm index 1f4b8e2f..d6a9e8fa 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -28,9 +28,7 @@ ;; TODO currently not guaranteed to be unique (define (UID ev) (string-append - ;; (date/-time->string (attr ev 'DTSTART) "~s") - (date->string (as-date (attr ev 'DTSTART)) "~Y~m~d") - (time->string (as-time (attr ev 'DTSTART)) "~H~M~S") + (datetime->string (as-datetime (attr ev 'DTSTART)) "~Y~m~d~H~M~S") (html-attr (attr ev 'UID)))) ;; This should only be used on time intervals, never on absolute times. @@ -61,12 +59,10 @@ [else ; guaranteed datetime (let ((s (attr ev 'DTSTART)) (e (attr ev 'DTEND))) - (let ((s-str (time->string (get-time s) "~H:~M")) - (e-str (time->string (get-time e) "~H:~M"))) - (if (date= (get-date s) (get-date e)) - (values s-str e-str) - (values (string-append (date->string (get-date s) "~Y-~m-~d ") s-str) - (string-append (date->string (get-date e) "~Y-~m-~d ") e-str)))))])) + (let ((fmt-str (if (date= (get-date s) (get-date e)) + "~H:~M" "~Y-~m-~d ~H:~M"))) + (values (datetime->string s fmt-str) + (datetime->string e fmt-str))))])) 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) diff --git a/module/output/terminal.scm b/module/output/terminal.scm index 68e66eb9..cb18649d 100644 --- a/module/output/terminal.scm +++ b/module/output/terminal.scm @@ -41,12 +41,10 @@ (display (string-append (if (datetime? (attr ev 'DTSTART)) - (string-append (date->string (get-date (attr ev 'DTSTART))) - " " - (time->string (get-time (attr ev 'DTSTART)))) - ((@ (texinfo string-utils) center-string) - (date->string (attr ev 'DTSTART)) - 19)) + (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S") + ((@ (texinfo string-utils) center-string) + (date->string (attr ev 'DTSTART)) + 19)) ; TODO show truncated string " │ " (if (= i cur-event) "\x1b[7m" "") @@ -115,15 +113,11 @@ ;; another story. (let ((start (attr ev 'DTSTART))) (if (datetime? start) - (string-append (date->string (get-date start)) - " " - (time->string (get-time start))) + (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S") (date->string start))) (let ((end (attr ev 'DTEND))) (if (datetime? end) - (string-append (date->string (get-date end)) - " " - (time->string (get-time end))) + (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S") (date->string end))) (unlines (take-to (flow-text (or (attr ev 'DESCRIPTION) "") #:width (min 70 width)) |