aboutsummaryrefslogtreecommitdiff
path: root/module/vcomponent.scm
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-08-02 23:25:56 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-08-02 23:25:56 +0200
commit5188fb2251e02b32fd017dc7ba8cd6d0ce892c75 (patch)
treec79ed2f7b1734ebccc53fa4daee9ed1a5a2862c4 /module/vcomponent.scm
parentRepair vcomponent describe. (diff)
downloadcalp-5188fb2251e02b32fd017dc7ba8cd6d0ce892c75.tar.gz
calp-5188fb2251e02b32fd017dc7ba8cd6d0ce892c75.tar.xz
Remove (util app).
Diffstat (limited to 'module/vcomponent.scm')
-rw-r--r--module/vcomponent.scm111
1 files changed, 0 insertions, 111 deletions
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index 2e13f1c8..bcadbd97 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -1,15 +1,8 @@
(define-module (vcomponent)
:use-module (util)
- :use-module (util app)
:use-module (util config)
- :use-module (srfi srfi-1)
- :use-module (srfi srfi-41)
- :use-module (srfi srfi-41 util)
- :use-module (datetime)
:use-module (vcomponent base)
:use-module (vcomponent parse)
- :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
- :use-module ((vcomponent datetime) :select (ev-time<?))
:re-export (make-vcomponent
parse-cal-path parse-calendar))
@@ -22,107 +15,3 @@
[(string? v) ((@ (glob) glob) v)]
[else #f])))
-(define-public (load-calendars calendar-files)
- (map parse-cal-path calendar-files))
-
-
-(define-method (init-app calendar-files)
- (setf 'calendars (load-calendars calendar-files))
-
- (setf 'events
- (concatenate
- ;; TODO does this drop events?
- (map (lambda (cal) (remove
- (extract 'X-HNH-REMOVED)
- (filter (lambda (o) (eq? 'VEVENT (type o)))
- (children cal))))
- (getf 'calendars))))
-
- (let* ((repeating regular (partition repeating? (getf 'events))))
- (setf 'fixed-events (sort*! regular date/-time<? (extract 'DTSTART)))
- (setf 'repeating-events (sort*! repeating date/-time<? (extract 'DTSTART))))
-
-
- (setf 'event-set
- (interleave-streams
- ev-time<?
- (cons (list->stream (getf 'fixed-events))
- (map generate-recurrence-set (getf 'repeating-events)))))
-
- (setf 'uid-map
- (let ((ht (make-hash-table)))
- (for-each (lambda (event) (hash-set! ht (prop event 'UID) event)) (getf 'events))
- ht)))
-
-(define-method (fixed-events-in-range start end)
- (filter-sorted (lambda (ev) ((in-date-range? start end)
- (as-date (prop ev 'DTSTART))))
- (getf 'fixed-events)))
-
-(define-method (get-event-by-uid uid)
- (hash-ref (getf 'uid-map) uid))
-
-
-
-
-;;; TODO both add- and remove-event sometimes crash with
-;;;;; Warning: Unwind-only `stack-overflow' exception; skipping pre-unwind handler.
-;;; I belive this is due to how getf and setf work.
-
-
-;;; TODO what should happen when an event with that UID already exists
-;;; in the calendar? Fail? Overwrite? Currently it adds a second element
-;;; with the same UID, which is BAD.
-(define-public (add-event calendar event)
-
- (add-child! calendar event)
-
- (unless (prop event 'UID)
- (set! (prop event 'UID) (uuidgen)))
-
- (let ((events (getf 'events)))
- (setf 'events (cons event events)))
-
- (if (repeating? event)
- (let ((repeating (getf 'repeating-events)))
- (setf 'repeating-events (insert-ordered event repeating ev-time<?)))
- (let ((regular (getf 'fixed-events)))
- (setf 'fixed-events (insert-ordered event regular ev-time<?))))
-
- (let ((event-set (getf 'event-set)))
- (setf 'event-set
- (interleave-streams
- ev-time<?
- (list (if (repeating? event)
- (generate-recurrence-set event)
- (stream event))
- event-set))))
-
- (hash-set! (getf 'uid-map) (prop event 'UID)
- event)
-
- (prop event 'UID))
-
-
-(define-public (remove-event event)
- (let ((events (delete event (getf 'events))))
- (setf 'events events))
-
- (if (repeating? event)
- (let ((repeating (delete event (getf 'repeating-events))))
- (setf 'repeating-events repeating))
- (let ((regular (delete event (getf 'fixed-events))))
- (setf 'fixed-events regular)))
-
- (let ((event-set
- (stream-remove
- (lambda (ev)
- (equal? (prop ev 'UID)
- (prop event 'UID)))
- (getf 'event-set))))
- (setf 'event-set event-set))
-
- (hash-set! (getf 'uid-map) (prop event 'UID)
- #f))
-
-