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.scm | 90 ++++-----------------------------------------------
 1 file changed, 7 insertions(+), 83 deletions(-)

(limited to 'module/vcomponent.scm')

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)
-- 
cgit v1.2.3