diff options
| -rw-r--r-- | module/main.scm | 4 | ||||
| -rw-r--r-- | module/output/ical.scm | 19 | ||||
| -rw-r--r-- | module/output/terminal.scm | 1 | ||||
| -rw-r--r-- | module/vcomponent/output.scm | 66 |
4 files changed, 11 insertions, 79 deletions
diff --git a/module/main.scm b/module/main.scm index f8dca2de..7119278e 100644 --- a/module/main.scm +++ b/module/main.scm @@ -161,9 +161,7 @@ (let ((event (and=> (frame-lookup-binding frame 'event) binding-ref))) (when event - (format (current-error-port) "event = ~a~%" event) - ((@ (vcomponent output) serialize-vcomponent) - event (current-error-port)))) + (format (current-error-port) "event = ~a~%" event))) (loop (frame-previous frame)))) (format #t "~%") diff --git a/module/output/ical.scm b/module/output/ical.scm index e289456b..1c9ce187 100644 --- a/module/output/ical.scm +++ b/module/output/ical.scm @@ -75,15 +75,16 @@ (handle-value (value vline)))) (define (escape-chars str) - (with-output-to-string - (lambda () - (string-for-each - (lambda (ch) - (case ch - ((#\, #\; #\\) => (lambda (c) (display "\\") (display c))) - ((#\newline) (display "\\n")) - (else (display ch)))) - str)))) + (define (escape char) + (string #\\ char)) + (string-concatenate + (map (lambda (c) + (case c + ((#\newline) "\\n") + ((#\, #\; #\\) => escape) + (else => string))) + (string->list str)))) + (define (generate-uuid) ((@ (rnrs io ports) call-with-port) diff --git a/module/output/terminal.scm b/module/output/terminal.scm index 02539faf..3c7c4ecd 100644 --- a/module/output/terminal.scm +++ b/module/output/terminal.scm @@ -13,7 +13,6 @@ #:use-module (vulgar info) #:use-module (vulgar color) #:use-module (vulgar components) - #:use-module (vcomponent output) #:use-module (vcomponent group) #:use-module (vcomponent) diff --git a/module/vcomponent/output.scm b/module/vcomponent/output.scm deleted file mode 100644 index 47c740e2..00000000 --- a/module/vcomponent/output.scm +++ /dev/null @@ -1,66 +0,0 @@ -(define-module (vcomponent output) - #:use-module (vcomponent) - #:use-module (vcomponent control) - #:use-module (util) - #:use-module (srfi srfi-1) - #:use-module (datetime) - #:use-module (datetime util) - #:use-module (srfi srfi-26) - #:use-module (ice-9 format) - #:export (serialize-vcomponent)) - - -;;; TODO -;; Error in CREATED /home/hugo/.calendars/b85ba2e9-18aa-4451-91bb-b52da930e977/a1a25238-d63d-46a1-87fd-d0c9334a7a30CalSync.ics: -;; Wrong type argument in position 1 (expecting string): ("20180118T124015Z" "VALARM") - -(define (string->ics-safe-string str) - "TODO wrap at 75(?) columns." - (define (escape char) - (string #\\ char)) - - (string-concatenate - (map (lambda (c) - (case c - ((#\newline) "\\n") - ((#\, #\; #\\) => escape) - (else => string))) - (string->list str)))) - -(define* (serialize-vcomponent comp #:optional (port (current-output-port))) - "Recursively write a component back to its ICS form. -Removes the X-HNH-FILENAME attribute, and sets PRODID to -\"HugoNikanor-calparse\" in the output." - (with-replaced-attrs - (comp (prodid "HugoNikanor-calparse")) - - (format port "BEGIN:~a~%" (type comp)) - - (let ((kvs (map (lambda (key) (list key (attr comp key))) - (attribute-keys comp)))) - (for kv in kvs - (let* (((key value) kv)) - (catch 'wrong-type-arg - (lambda () - (format port "~a~:{;~a=~a~}:~a~%" - key - (properties (attr* comp key)) - (string->ics-safe-string - (case key - ((DTSTART DTEND) - (cond [(string? value) value] - [(date? value) (date->string value "~Y~m~d")] - [(datetime? value) - (datetime->string value)])) - ((X-HNH-DURATION) - (format #f "~s" value)) - (else value))))) - - ;; Catch - (lambda (type proc fmt . args) - (apply format (current-error-port) "[ERR] ~a in ~a (~a) ~a:~%~?~%" - type key proc (attr comp 'X-HNH-FILENAME) - fmt args))))) - - (for-each (cut serialize-vcomponent <> port) (children comp))) - (format port "END:~a~%" (type comp)))) |