aboutsummaryrefslogtreecommitdiff
path: root/module/vcomponent/instance/methods.scm
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2021-12-21 16:17:28 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2021-12-22 22:58:30 +0100
commitd00fea566004e67161ee45246b239fff5d416b0e (patch)
tree5641c0c0d0e78b046b6045ed2440512f12259560 /module/vcomponent/instance/methods.scm
parentComplete rewrite of use2dot (diff)
downloadcalp-d00fea566004e67161ee45246b239fff5d416b0e.tar.gz
calp-d00fea566004e67161ee45246b239fff5d416b0e.tar.xz
Cleanup modules.
Primarly this moves all vcompenent input and output code to clearly labeled modules, instead of being spread out. At the same time it also removes a handfull of unused procedures.
Diffstat (limited to 'module/vcomponent/instance/methods.scm')
-rw-r--r--module/vcomponent/instance/methods.scm138
1 files changed, 0 insertions, 138 deletions
diff --git a/module/vcomponent/instance/methods.scm b/module/vcomponent/instance/methods.scm
deleted file mode 100644
index 414587a9..00000000
--- a/module/vcomponent/instance/methods.scm
+++ /dev/null
@@ -1,138 +0,0 @@
-(define-module (vcomponent instance methods)
- :use-module (calp util)
- :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<?))
- :use-module (oop goops)
-
- :export (add-event
- remove-event
-
- get-event-by-uid
- fixed-events-in-range
-
- get-event-set get-calendars
- get-fixed-events get-repeating-events
- ))
-
-(define-public (load-calendars calendar-files)
- (map parse-cal-path calendar-files))
-
-
-(define-class <events> ()
- (calendar-files init-keyword: calendar-files:)
- (calendars getter: get-calendars)
- (events getter: get-events)
- (repeating-events getter: get-repeating-events)
- (fixed-events getter: get-fixed-events)
- (event-set getter: get-event-set)
- uid-map
- )
-
-
-(define-method (get-event-by-uid (this <events>) uid)
- (hash-ref (slot-ref this 'uid-map) uid))
-
-
-
-(define-method (fixed-events-in-range (this <events>) start end)
- (filter-sorted (lambda (ev) ((in-date-range? start end)
- (as-date (prop ev 'DTSTART))))
- (slot-ref this 'fixed-events)))
-
-
-(define-method (initialize (this <events>) args)
- (next-method)
-
- (format (current-error-port) "Building <events> from~%")
- (for calendar in (slot-ref this 'calendar-files)
- (format (current-error-port) " - ~a~%" calendar))
-
- (slot-set! this 'calendars (load-calendars (slot-ref this 'calendar-files)))
-
-
- (let* ((groups
- (group-by
- type (concatenate
- (map children (slot-ref this 'calendars)))))
- (events (awhen (assoc-ref groups 'VEVENT)
- (car it)))
- (removed remaining (partition (extract 'X-HNH-REMOVED) events)))
-
- ;; TODO figure out what to do with removed events
-
- (slot-set! this 'events (append #|removed|# remaining)))
-
- (let* ((repeating regular (partition repeating? (slot-ref this 'events))))
- (slot-set! this 'fixed-events (sort*! regular date/-time<? (extract 'DTSTART)))
- (slot-set! this 'repeating-events (sort*! repeating date/-time<? (extract 'DTSTART))))
-
-
- (slot-set! this 'event-set
- (interleave-streams
- ev-time<?
- (cons (list->stream (slot-ref this 'fixed-events))
- (map generate-recurrence-set (slot-ref this 'repeating-events)))))
-
- (slot-set! this 'uid-map
- (let ((ht (make-hash-table)))
- (for-each (lambda (event) (hash-set! ht (prop event 'UID) event))
- (slot-ref this 'events))
- ht)))
-
-;;; 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-method (add-event (this <events>) calendar event)
-
- (add-child! calendar event)
- (unless (prop event 'UID)
- (set! (prop event 'UID) (uuidgen)))
-
-
-
-
- (slot-set! this 'events
- (cons event (slot-ref this 'events)))
-
- (let* ((slot-name (if (repeating? event) 'repeating-events 'fixed-events))
- (events (slot-ref this slot-name)))
- (slot-set! this slot-name (insert-ordered event events ev-time<?)))
-
- (slot-set! this 'event-set
- (interleave-streams
- ev-time<?
- (list (if (repeating? event)
- (generate-recurrence-set event)
- (stream event))
- (slot-ref this 'event-set))))
-
- (hash-set! (slot-ref this 'uid-map) (prop event 'UID)
- event)
-
- (prop event 'UID))
-
-
-(define-method (remove-event (this <events>) event)
- ;; cons #f so delq1! can delete the first element
-
- (delq1! event (cons #f (slot-ref this 'events)))
-
- (let ((slot-name (if (repeating? event) 'repeating-events 'fixed-events)))
- (delq1! event (cons #f (slot-ref this slot-name))))
-
- (slot-set! this 'event-set
- (stream-remove
- (lambda (ev)
- (equal? (prop ev 'UID)
- (prop event 'UID)))
- (slot-ref this 'event-set)))
-
- (hash-set! (slot-ref this 'uid-map) (prop event 'UID)
- #f))
-