Create module (vcomponent base).

7 files changed, 97 insertions, 87 deletions

diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index 4ef8f794..b628c11a 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -1,15 +1,14 @@
 (define-module (vcomponent)
-  #:use-module (vcomponent primitive)
+  #:use-module ((vcomponent primitive) :select (%vcomponent-make))
   #:use-module (vcomponent datetime)
   #:use-module (vcomponent recurrence)
   #:use-module (vcomponent timezone)
+  #:use-module (vcomponent base)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-17)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-19 util)
   #:use-module (srfi srfi-19 setters)
   #:use-module (srfi srfi-26)
-  #:use-module ((ice-9 optargs) #:select (define*-public))
   #:use-module (util)
   #:export (make-vcomponent)
   #:re-export (repeating?))
@@ -19,6 +18,8 @@
 ;; and then the TZOFFSETTO attribute can be subtracted from
 ;; the event DTSTART to get UTC time.
 
+(re-export-modules (vcomponent base))
+
 (define string->time-utc
   (compose date->time-utc parse-datetime))
 
@@ -50,98 +51,21 @@
                (attr ev 'DTEND) (date->time-utc end-date)))))
 
 
-(define-public (type-filter t lst)
-  (filter (lambda (e) (eqv? t (type e)))
-          lst))
-
-(define*-public (children component #:optional only-type)
-  (let ((childs (%vcomponent-children component)))
-    (if only-type
-        (type-filter only-type childs)
-        childs)))
-
-(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 value caar)
-(define-public next cdr)
+;; (define-public value caar)
+;; (define-public next cdr)
 ;; (define-public next! pop!)
 
-(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 (reset! attr-list)
 ;;   (while (not (car attr-list))
 ;;     (next! attr-list))
 ;;   (next! 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!))
-
 ;; value
 ;; (define-public v
 ;;   (make-procedure-with-setter car set-car!))
 
-(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 %vcomponent-get-type)
-(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 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 (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)))))
-
-(define-public (key=? k1 k2)
-  (eq? (as-symb k1)
-       (as-symb k2)))
+
 
 (define* (make-vcomponent #:optional path)
   (if (not path)
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)))))