Remove make-vcomponent.

1 files changed, 75 insertions, 77 deletions

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)))