From 275dfc4b4fc7bd8ad3244dbd6c9053fe1ceb7f5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 3 Nov 2019 13:39:57 +0100 Subject: Remove make-vcomponent. --- module/vcomponent.scm | 152 +++++++++++++++++++++++++------------------------- 1 file changed, 75 insertions(+), 77 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index d3e574b5..8eeeaff9 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -9,8 +9,8 @@ #:use-module (srfi srfi-19 setters) #:use-module (srfi srfi-26) #:use-module (util) - #:export (make-vcomponent) - #:re-export (repeating?)) + #:export (parse-calendar) + #:re-export (repeating? make-vcomponent)) ;; All VTIMEZONE's seem to be in "local" time in relation to ;; themselves. Therefore, a simple comparison should work, @@ -62,78 +62,76 @@ (value eptr) (date->time-utc end-date))))) -(define* (make-vcomponent #:optional path) - (if (not path) - (primitive-make-vcomponent) - (let ((root (parse-cal-path path))) - (let* ((component - (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) - ;; == Single ICS file == - ;; Remove the abstract ROOT component, - ;; returning the wanted VCALENDAR component - ((file) - ;; TODO test this when an empty file is given. - (car (children root))) - - ;; == Assume vdir == - ;; Also removes the abstract ROOT component, but also - ;; merges all VCALENDAR's children into the a newly - ;; created VCALENDAR component, and return that component. - ;; - ;; TODO the other VCALENDAR components might not get thrown away, - ;; this since I protect them from the GC in the C code. - ((vdir) - (let ((accum (primitive-make-vcomponent 'VCALENDAR)) - (ch (children root))) - - ;; Copy attributes from our parsed VCALENDAR - ;; to our newly created one. - (unless (null? ch) - (for key in (attributes (car ch)) - (set! (attr accum key) (attr (car ch) key)))) - - ;; Merge all children - (let ((tz '())) - (for cal in ch - (for component in (children cal) - (case (type component) - ((VTIMEZONE) - (set! tz (cons component tz)) - #; - (unless (find (lambda (z) - (string=? (attr z "TZID") - (attr component "TZID"))) - (filter (lambda (o) (eq? 'VTIMEZONE (type o))) - (children accum))) - (add-child! accum component))) - ((VEVENT) - (add-child! accum component) - ) - (else => (lambda (type) - (format (current-error-port) - "Got unexpected component of type ~a~%" type)) - #; (add-child! accum component) - )))) - - (unless (null? tz) - (add-child! accum (car tz))) - ) - ;; return - accum)) - - ((no-type) (error 'no-type))))) - - (parse-dates! component) - - (unless (attr component "NAME") - (set! (attr component "NAME") - (or (attr component "X-WR-CALNAME") - (attr root "NAME") - "[NAMELESS]"))) - - (unless (attr component "COLOR") - (set! (attr component "COLOR") - (attr root "COLOR"))) - - ;; return - component)))) +(define* (parse-calendar path) + (let ((root (parse-cal-path path))) + (let* ((component + (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) + ;; == Single ICS file == + ;; Remove the abstract ROOT component, + ;; returning the wanted VCALENDAR component + ((file) + ;; TODO test this when an empty file is given. + (car (children root))) + + ;; == Assume vdir == + ;; Also removes the abstract ROOT component, but also + ;; merges all VCALENDAR's children into the a newly + ;; created VCALENDAR component, and return that component. + ;; + ;; TODO the other VCALENDAR components might not get thrown away, + ;; this since I protect them from the GC in the C code. + ((vdir) + (let ((accum (make-vcomponent 'VCALENDAR)) + (ch (children root))) + + ;; Copy attributes from our parsed VCALENDAR + ;; to our newly created one. + (unless (null? ch) + (for key in (attributes (car ch)) + (set! (attr accum key) (attr (car ch) key)))) + + ;; Merge all children + (let ((tz '())) + (for cal in ch + (for component in (children cal) + (case (type component) + ((VTIMEZONE) + (set! tz (cons component tz)) + #; + (unless (find (lambda (z) + (string=? (attr z "TZID") + (attr component "TZID"))) + (filter (lambda (o) (eq? 'VTIMEZONE (type o))) + (children accum))) + (add-child! accum component))) + ((VEVENT) + (add-child! accum component) + ) + (else => (lambda (type) + (format (current-error-port) + "Got unexpected component of type ~a~%" type)) + #; (add-child! accum component) + )))) + + (unless (null? tz) + (add-child! accum (car tz))) + ) + ;; return + accum)) + + ((no-type) (error 'no-type))))) + + (parse-dates! component) + + (unless (attr component "NAME") + (set! (attr component "NAME") + (or (attr component "X-WR-CALNAME") + (attr root "NAME") + "[NAMELESS]"))) + + (unless (attr component "COLOR") + (set! (attr component "COLOR") + (attr root "COLOR"))) + + ;; return + component))) -- cgit v1.2.3