From e13f6bb201dff690208b9cc951b5c098b0d63356 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 3 Oct 2019 00:46:01 +0200 Subject: Slowly going through and fixing everything. --- module/vcomponent.scm | 113 +++++++++++++++++++++++---------------------- module/vcomponent/base.scm | 32 +++++++------ 2 files changed, 75 insertions(+), 70 deletions(-) (limited to 'module') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index a106d993..93449c4b 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -82,59 +82,60 @@ (define* (make-vcomponent #:optional path) (if (not path) (make-vcomponent) - (let* ((root (parse-cal-path path)) - (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)) - (ch (children root))) - (set! (type accum) "VCALENDAR") - - (unless (null? ch) - (for key in (attributes (car ch)) - (set! (attr accum key) (attr (car ch) key)))) - - (for cal in ch - (for component in (children cal) - (case (type component) - ((VTIMEZONE) - (unless (find (lambda (z) - (string=? (attr z "TZID") - (attr component "TZID"))) - (children accum 'VTIMEZONE)) - (push-child! accum component))) - (else (push-child! accum component))))) - ;; return - accum)) - - ((no-type) (throw 'no-type)) - - (else (throw 'something))))) - - (parse-dates! component) - - (unless (attr component "NAME") - (set! (attr component "NAME") - (or (attr component "X-WR-CALNAME") - (attr root "NAME")))) - - (unless (attr component "COLOR") - (set! (attr component "COLOR") - (attr root "COLOR"))) - - ;; return - component))) + (let ((root (parse-cal-path path))) + (format #t "root = ~a~%" root ) + (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. + (display "Hello\n") + (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)) + (ch (children root))) + (set! (type accum) "VCALENDAR") + + (unless (null? ch) + (for key in (attributes (car ch)) + (set! (attr accum key) (attr (car ch) key)))) + + (for cal in ch + (for component in (children cal) + (case (type component) + ((VTIMEZONE) + (unless (find (lambda (z) + (string=? (attr z "TZID") + (attr component "TZID"))) + (children accum 'VTIMEZONE)) + (push-child! accum component))) + (else (push-child! accum component))))) + ;; return + accum)) + + ((no-type) (throw 'no-type))))) + + (display "Here?\n") + (parse-dates! component) + + (unless (attr component "NAME") + (set! (attr component "NAME") + (or (attr component "X-WR-CALNAME") + (attr root "NAME")))) + + (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 4b49ba66..395c2d9c 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -6,8 +6,9 @@ :use-module ((ice-9 optargs) :select (define*-public))) (define (get-attr component attr) - (hash-ref (struct-ref component 3) - (as-string attr)) + (and=> (hash-ref (struct-ref component 3) + (as-string attr)) + (lambda (l) (struct-ref l 0))) #; (%vcomponent-get-attribute component @@ -19,26 +20,29 @@ (set! (car (get-attr component (as-string attr))) value)) -(define-public value caar) +;; (define-public value caar) -(define-public (values-left-count attr-list) - (length (take-while identity attr-list))) +;; (define-public (values-left-count attr-list) +;; (length (take-while identity attr-list))) -(define-public (value-count attr-list) - (length (take-while identity (cdr (drop-while identity attr-list))))) +;; (define-public (value-count attr-list) +;; (length (take-while identity (cdr (drop-while identity attr-list))))) (define-public attr* get-attr) -(define (get-first c a) - (and=> (car (get-attr c a)) car)) +;; (define (get-first c a) +;; (and=> (car (get-attr c a)) car)) -(define (set-first! c a v) - (and=> (car (get-attr c a)) - (lambda (f) (set! (car f) v)))) +;; (define (set-first! c a v) +;; (and=> (car (get-attr c a)) +;; (lambda (f) (set! (car f) v)))) (define-public attr (make-procedure-with-setter - get-first set-first!)) +; get-first set-first! + get-attr + set-attr! + )) (define-public prop @@ -64,7 +68,7 @@ ) (define*-public (children component #:optional only-type) - (let ((childs (slot-ref component 1))) + (let ((childs (struct-ref component 1))) (if only-type (filter (lambda (e) (eq? only-type (type e))) childs) childs))) -- cgit v1.2.3