From 799a2ff1e08dca4ee50b5c28927b998603ed9867 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Fri, 3 May 2019 16:33:02 +0200
Subject: Create module (vcomponent base).

---
 module/vcomponent/base.scm                | 75 +++++++++++++++++++++++++++++++
 module/vcomponent/datetime.scm            |  2 +-
 module/vcomponent/recurrence.scm          |  2 +-
 module/vcomponent/recurrence/generate.scm |  2 +-
 module/vcomponent/timezone.scm            |  2 +-
 module/vcomponent/util.scm                | 11 +++++
 6 files changed, 90 insertions(+), 4 deletions(-)
 create mode 100644 module/vcomponent/base.scm
 create mode 100644 module/vcomponent/util.scm

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
new file mode 100644
index 00000000..719fcfce
--- /dev/null
+++ b/module/vcomponent/base.scm
@@ -0,0 +1,75 @@
+(define-module (vcomponent base)
+  :use-module (util)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-17)
+  :use-module (vcomponent primitive)
+  :use-module ((ice-9 optargs) :select (define*-public)))
+
+
+(define (get-attr component attr)
+  (%vcomponent-get-attribute
+   component
+   (as-string attr)))
+
+(define (set-attr! component attr value)
+  (set! (car (get-attr component (as-string attr)))
+        value))
+
+(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 attr* get-attr)
+
+(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-public attr
+  (make-procedure-with-setter
+   get-first set-first!))
+
+
+(define-public prop
+  (make-procedure-with-setter
+   (lambda (attr-obj prop-key)
+     (hashq-ref (cdar attr-obj) prop-key))
+   (lambda (attr-obj prop-key val)
+     (hashq-set! (cdar attr-obj) prop-key val))))
+
+;; Returns the properties of attribute as an assoc list.
+;; @code{(map car <>)} leads to available properties.
+(define-public (properties attrptr)
+  (hash-map->list cons (cdar attrptr)))
+
+(define-public type (make-procedure-with-setter
+                     %vcomponent-get-type
+                     %vcomponent-set-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 (children component #:optional only-type)
+  (let ((childs (%vcomponent-children component)))
+    (if only-type
+        (filter (lambda (e) (eq? only-type (type e))) childs)
+        childs)))
+
+(define-public copy-vcomponent %vcomponent-shallow-copy)
+
+(define-public filter-children! %vcomponent-filter-children!)
+
+(define-public (extract field)
+  (lambda (e) (attr e field)))
+
+(define-public (extract* field)
+  (lambda (e) (attr* e field)))
+
+(define-public (key=? k1 k2)
+  (eq? (as-symb k1)
+       (as-symb k2)))
diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm
index 4e3cfbe6..5bf829a9 100644
--- a/module/vcomponent/datetime.scm
+++ b/module/vcomponent/datetime.scm
@@ -1,5 +1,5 @@
 (define-module (vcomponent datetime)
-  #:use-module (vcomponent)
+  #:use-module (vcomponent base)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-19 util)
   #:use-module (util)
diff --git a/module/vcomponent/recurrence.scm b/module/vcomponent/recurrence.scm
index d1113477..f941e7a8 100644
--- a/module/vcomponent/recurrence.scm
+++ b/module/vcomponent/recurrence.scm
@@ -1,5 +1,5 @@
 (define-module (vcomponent recurrence)
-  #:use-module (vcomponent)
+  #:use-module (vcomponent base)
   #:use-module (vcomponent recurrence generate)
   #:re-export (generate-recurrence-set)
   #:export (repeating?))
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index 9b611ecd..435d3009 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -7,7 +7,7 @@
   #:use-module (ice-9 match)
 
   #:use-module (util)
-  #:use-module (vcomponent)
+  #:use-module (vcomponent base)
   #:use-module (vcomponent timezone)
   #:use-module (vcomponent recurrence internal)
   #:use-module (vcomponent recurrence parse)
diff --git a/module/vcomponent/timezone.scm b/module/vcomponent/timezone.scm
index 5b262f1c..4a312288 100644
--- a/module/vcomponent/timezone.scm
+++ b/module/vcomponent/timezone.scm
@@ -1,5 +1,5 @@
 (define-module (vcomponent timezone)
-  :use-module (vcomponent)
+  :use-module (vcomponent base)
   :use-module ((srfi srfi-1) :select (find))
   :use-module (srfi srfi-19)
   :use-module (srfi srfi-19 util)
diff --git a/module/vcomponent/util.scm b/module/vcomponent/util.scm
new file mode 100644
index 00000000..81330c17
--- /dev/null
+++ b/module/vcomponent/util.scm
@@ -0,0 +1,11 @@
+(define-module (vcomponent util)
+  #:use-module (vcomponent util)
+  #:export (search))
+
+(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 (extract "SUMMARY")
+                              events)
+                    events)))))
-- 
cgit v1.2.3