aboutsummaryrefslogtreecommitdiff
path: root/vcalendar.scm
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2019-03-22 20:11:11 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2019-03-22 20:17:52 +0100
commitd46183860c1f3f10095e95023adcb79b1896ab0e (patch)
treedd331a0efe9777bfe84160139da1e39df3226b71 /vcalendar.scm
parentAdd stuff to test.scm. (diff)
downloadcalp-d46183860c1f3f10095e95023adcb79b1896ab0e.tar.gz
calp-d46183860c1f3f10095e95023adcb79b1896ab0e.tar.xz
Move C and Scheme code into subdirs.
Diffstat (limited to 'vcalendar.scm')
-rw-r--r--vcalendar.scm112
1 files changed, 0 insertions, 112 deletions
diff --git a/vcalendar.scm b/vcalendar.scm
deleted file mode 100644
index 3f7ba6ba..00000000
--- a/vcalendar.scm
+++ /dev/null
@@ -1,112 +0,0 @@
-(define-module (vcalendar)
- #:use-module (vcalendar primitive)
- #:use-module (vcalendar datetime)
- #:use-module (vcalendar recur)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-26)
- #:use-module (util)
- #:re-export (repeating?))
-
-(define (parse-dates! cal)
- "Parse all start times into scheme date objects."
- (for-each-in (children cal 'VEVENT)
- (lambda (ev)
- (mod! (attr ev "DTSTART") parse-datetime)
- (mod! (attr ev "DTEND") parse-datetime)))
- cal)
-
-
-(define-public (type-filter t lst)
- (filter (lambda (e) (eqv? t (type e)))
- lst))
-
-(define* (children component #:optional only-type)
- (let ((childs (%vcomponent-children component)))
- (if only-type
- (type-filter only-type childs)
- childs)))
-(export children)
-
-(define (set-attr! component attr value)
- (%vcomponent-set-attribute!
- component
- (if (symbol? attr) (symbol->string attr) attr)
- value))
-
-(define (get-attr component attr)
- (%vcomponent-get-attribute
- component
- (if (symbol? attr) (symbol->string attr) attr)))
-
-;; Enables symmetric get and set:
-;; (set! (attr ev "KEY") 10)
-(define-public attr (make-procedure-with-setter get-attr set-attr!))
-
-(define-public type %vcomponent-type)
-(define-public parent %vcomponent-parent)
-(define-public push-child! %vcomponent-push-child!)
-(define-public (attributes component) (map string->symbol (%vcomponent-attribute-list component)))
-
-(define-public copy-vcomponent %vcomponent-shallow-copy)
-
-(define-public filter-children! %vcomponent-filter-children!)
-
-(define-public (search cal term)
- (cdr (let ((events (filter (lambda (ev) (eq? 'VEVENT (type ev)))
- (children cal))))
- (find (lambda (ev) (string-contains-ci (car ev) term))
- (map cons (map (cut get-attr <> "SUMMARY")
- events)
- events)))))
-
-(define-public (extract field)
- (cut get-attr <> field))
-
-(define-public (key=? k1 k2)
- (eq?
- (if (string? k1) (string->symbol k1) k1)
- (if (string? k2) (string->symbol k2) k2)))
-
-(define-public (make-vcomponent path)
- (let* ((root (%vcomponent-make path))
- (component
- (parse-dates!
- (case (string->symbol (or (attr root "TYPE") "no-type"))
- ;; == Single ICS file ==
- ;; Remove the abstract ROOT component,
- ;; returning the wanted VCALENDAR component
- ((file)
- (car (%vcomponent-children root)))
-
- ;; == Assume vdir ==
- ;; Also removes the abstract ROOT component, but also
- ;; merges all VCALENDAR's children into the first
- ;; VCALENDAR, and return that VCALENDAR.
- ;;
- ;; TODO the other VCALENDAR components might not get thrown away,
- ;; this since I protect them from the GC in the C code.
- ((vdir)
- (reduce (lambda (cal accum)
- (for-each (lambda (component)
- (case (type component)
- ((VTIMEZONE)
- (let ((zones (children cal 'VTIMEZONE)))
- (unless (find (lambda (z)
- (string=? (attr z "TZID")
- (attr component "TZID")))
- zones)
- (%vcomponent-push-child! accum component))))
- (else (%vcomponent-push-child! accum component))))
- (%vcomponent-children cal))
- accum)
- '() (%vcomponent-children root)))
-
- ((no-type) (throw 'no-type))
-
- (else (throw 'something))))))
-
- (set! (attr component "NAME")
- (attr root "NAME"))
- (set! (attr component "COLOR")
- (attr root "COLOR"))
- component))