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/main.scm | 2 +- module/vcomponent.scm | 152 ++++++++++++++++++++++----------------------- module/vcomponent/base.scm | 11 +--- 3 files changed, 79 insertions(+), 86 deletions(-) (limited to 'module') diff --git a/module/main.scm b/module/main.scm index f765496f..423daeb9 100755 --- a/module/main.scm +++ b/module/main.scm @@ -39,7 +39,7 @@ exec guile -e main -s $0 "$@" ;; ;; Given as a sepparate function from main to ease debugging. (define* (init proc #:key (calendar-files (calendar-files))) - (define calendars (map make-vcomponent calendar-files)) + (define calendars (map parse-calendar calendar-files)) (define events (concatenate ;; TODO does this drop events? (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o))) 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))) diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index 86ea40e8..60a27f94 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -2,18 +2,13 @@ :use-module (util) :use-module (srfi srfi-1) :use-module (srfi srfi-17) - :use-module ((vcomponent parse) - :renamer (lambda (symb) - (case symb - ;; [(set-attribute!) 'get-attribute] - [(make-vcomponent) 'primitive-make-vcomponent] - [else symb]))) + :use-module (vcomponent parse) :use-module (ice-9 hash-table) :use-module ((ice-9 optargs) :select (define*-public)) - :re-export (add-child! primitive-make-vcomponent)) + :re-export (add-child! make-vcomponent)) (define-public (parse-cal-path path) - (let ((parent (primitive-make-vcomponent))) + (let ((parent (make-vcomponent))) (for-each (lambda (child) (add-child! parent child)) (read-vcalendar path)) (set-attribute! -- cgit v1.2.3