diff options
| author | Hugo Hörnquist <hugo@hornquist.se> | 2019-11-03 14:46:28 +0100 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-11-03 14:46:28 +0100 |
| commit | 0f65e75ec0f56d3067a15e3671d9250fd2c1637a (patch) | |
| tree | 40ddc24f08b42c767e02b6482133e9f7efe4b524 /module/output | |
| parent | Remove 'none' output. (diff) | |
| parent | Add descirption to strbuf. (diff) | |
| download | calp-0f65e75ec0f56d3067a15e3671d9250fd2c1637a.tar.gz calp-0f65e75ec0f56d3067a15e3671d9250fd2c1637a.tar.xz | |
Merge branch 'restruct'
Diffstat (limited to 'module/output')
| -rw-r--r-- | module/output/html.scm | 1 | ||||
| -rw-r--r-- | module/output/ical.scm | 82 | ||||
| -rw-r--r-- | module/output/info.scm | 4 | ||||
| -rw-r--r-- | module/output/terminal.scm | 8 |
4 files changed, 92 insertions, 3 deletions
diff --git a/module/output/html.scm b/module/output/html.scm index e03be8d4..adbea85e 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -221,6 +221,7 @@ ;; (display "<!doctype HTML>") (newline) + ((@ (sxml simple) sxml->xml) `(html (@ (lang sv)) (head diff --git a/module/output/ical.scm b/module/output/ical.scm new file mode 100644 index 00000000..5eff7915 --- /dev/null +++ b/module/output/ical.scm @@ -0,0 +1,82 @@ +(define-module (output ical) + :use-module (ice-9 getopt-long) + :use-module (ice-9 format) + :use-module (vcomponent) + :use-module (srfi srfi-19) + :use-module (srfi srfi-19 util) + :use-module (srfi srfi-41) + :use-module (srfi srfi-41 util) + ) + +(define opt-spec + '((from (value #t) (single-char #\f)) + (to (value #t) (single-char #\t)))) + +(define (value-format key value) + ;; TODO remove once key's are normalized to symbols. + (case (string->symbol key) + ((DTSTART DTEND) + (time->string value "~Y~m~dT~H~M~SZ")) + ((DURATION) + #; (time->string value "~H~M~S") + (let ((s (time-second value))) + (format #f "~a~a~a" + (floor/ s 3600) + (floor/ (modulo s 3600) 60) + (modulo s 60)) + )) + (else value))) + +(define (escape-chars str) + (with-output-to-string + (lambda () + (string-for-each (lambda (ch) + (case ch + ((#\, #\\) => (lambda (c) (display "\\") (display c))) + (else (display ch))) + ) str)))) + +(define (component->ical-string component) + (format #t "BEGIN:~a~%" (type component)) + (for-each (lambda (kv) + (let ((key (car kv)) + (vline (cdr kv))) + ;; key;p1=v;p3=10:value + (format #t "~a~:{;~a=~@{~a~^,~}~}:~a~%" + key (properties vline) + (escape-chars (value-format key (value vline))) + ))) + (attributes component)) + (for-each component->ical-string (children component)) + (format #t "END:~a~%" (type component)) + + ) + +(define (print-header) + (format #t +"BEGIN:VCALENDAR +PRODID:~a +VERSION:2.0 +CALSCALE:GREGORIAN +" +"Hugo" +)) + + +(define (print-footer) + (format #t "END:VCALENDAR~%")) + +(define-public (ical-main calendars events args) + (define opts (getopt-long args opt-spec)) + (define start (parse-freeform-date (option-ref opts 'from "2019-04-15"))) + (define end (parse-freeform-date (option-ref opts 'to "2019-05-10"))) + + (print-header) + + (stream-for-each + component->ical-string + (filter-sorted-stream (lambda (ev) ((in-date-range? start end) + (time-utc->date (attr ev 'DTSTART)))) + events)) + + (print-footer)) diff --git a/module/output/info.scm b/module/output/info.scm index 62600472..eba0979c 100644 --- a/module/output/info.scm +++ b/module/output/info.scm @@ -11,7 +11,9 @@ (format #t "~%Found ~a calendars, named:~%~{ - [~4@a] ~a~a\x1b[m~%~}~%" (length calendars) (concatenate - (zip (map (lambda (c) (length (children c 'VEVENT))) calendars) + (zip (map (lambda (c) (length (filter (lambda (e) (eq? 'VEVENT (type e))) + (children c)))) + calendars) (map (compose color-escape (extract 'COLOR)) calendars) (map (extract 'NAME) calendars))))) diff --git a/module/output/terminal.scm b/module/output/terminal.scm index 67548537..16ba31e9 100644 --- a/module/output/terminal.scm +++ b/module/output/terminal.scm @@ -62,11 +62,14 @@ (define-values (height width) (get-terminal-size)) + (define grouped-stream (group-stream event-stream)) + (while #t ;; TODO reusing the same grouping causes it to lose events. ;; I currently have no idea why, but it's BAD. - (let ((groups (get-groups-between (group-stream event-stream) + (let ((groups (get-groups-between grouped-stream (time-utc->date time) (time-utc->date time)))) + (format (current-error-port) "len(groups) = ~a~%" (stream-length groups)) (let ((events (if (stream-null? groups) '() (group->event-list (stream-car groups))))) @@ -135,7 +138,7 @@ (let ((ev ((@ (vcomponent primitive) %vcomponent-make) fname))) (serialize-vcomponent ev (current-error-port)) - (push-child! (parent (list-ref events cur-event)) ev) + (add-child! (parent (list-ref events cur-event)) ev) (format (current-error-port) "Children: ~a~%start: ~a~%" (children ev) (attr ev 'DTSTART)) (set! event-stream (stream-insert ev-time<? ev event-stream))))))) @@ -156,5 +159,6 @@ (let ((time (date->time-utc (drop-time (or (and=> (option-ref opts 'date #f) parse-freeform-date) (current-date)))))) + ;; (format (current-error-port) "len(events) = ~a~%" (stream-length events)) (with-vulgar (lambda () (main-loop time events)))))) |