MOORE

6 files changed, 132 insertions, 103 deletions

diff --git a/module/html/vcomponent.scm b/module/html/vcomponent.scm
index 559b11c5..5743ff42 100644
--- a/module/html/vcomponent.scm
+++ b/module/html/vcomponent.scm
@@ -7,7 +7,7 @@
   :use-module (html util)
   :use-module ((html config) :select (edit-mode))
   :use-module ((html components) :select (btn tabset))
-  :use-module ((output general) :select (calculate-fg-color))
+  :use-module ((output color) :select (calculate-fg-color))
   :use-module ((vcomponent datetime output)
                :select (fmt-time-span
                         format-description
diff --git a/module/output/color.scm b/module/output/color.scm
new file mode 100644
index 00000000..123d0ba2
--- /dev/null
+++ b/module/output/color.scm
@@ -0,0 +1,22 @@
+(define-module (output color)
+  )
+
+;; Returns a color with good contrast to the given background color.
+;; https://stackoverflow.com/questions/1855884/determine-font-color-based-on-background-color/1855903#1855903
+(define-public (calculate-fg-color c)
+  (catch #t
+    (lambda ()
+      (define (str->num c n) (string->number (substring/shared c n (+ n 2)) 16))
+      ;; (format (current-error-port) "COLOR = ~s~%" c)
+      (let ((r (str->num c 1))
+            (g (str->num c 3))
+            (b (str->num c 5)))
+        (if (< 1/2 (/ (+ (* 0.299 r)
+                         (* 0.587 g)
+                         (* 0.114 b))
+                      #xFF))
+            "#000000" "#FFFFFF")))
+    (lambda args
+      (format (current-error-port) "Error calculating foreground color?~%~s~%" args)
+      "#FF0000"
+      )))
diff --git a/module/server/routes.scm b/module/server/routes.scm
index 142e0477..475e4c43 100644
--- a/module/server/routes.scm
+++ b/module/server/routes.scm
@@ -150,7 +150,7 @@
                 (remove-event global-event-object it)
                 (set! (prop it 'X-HNH-REMOVED) #t)
                 (set! (param (prop* it 'X-HNH-REMOVED) 'VALUE) "BOOLEAN")
-                (unless ((@ (output vdir) save-event) it)
+                (unless ((@ (vcomponent vdir save-delete) save-event) it)
                   (return (build-response code: 500)
                           "Saving event to disk failed."))
                 (return (build-response code: 204)))
@@ -249,7 +249,7 @@
                               (format (current-error-port)
                                       "Unlinking old event from ~a~%"
                                       (prop old-event '-X-HNH-FILENAME))
-                              ((@ (output vdir) remove-event) old-event)))
+                              ((@ (vcomponent vdir save-delete) remove-event) old-event)))
 
                           (parameterize ((warnings-are-errors #t))
                             (catch 'warning
@@ -261,7 +261,7 @@
 
                     ;; NOTE Posibly defer save to a later point.
                     ;; That would allow better asyncronous preformance.
-                    (unless ((@ (output vdir) save-event) event)
+                    (unless ((@ (vcomponent vdir save-delete) save-event) event)
                       (return (build-response code: 500)
                               "Saving event to disk failed."))
 
@@ -280,7 +280,7 @@
 
                ;; NOTE Posibly defer save to a later point.
                ;; That would allow better asyncronous preformance.
-               (unless ((@ (output vdir) save-event) event)
+               (unless ((@ (vcomponent vdir save-delete) save-event) event)
                  (return (build-response code: 500)
                          "Saving event to disk failed."))
 
diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm
index 67d66b02..290a8d3e 100644
--- a/module/vcomponent/parse.scm
+++ b/module/vcomponent/parse.scm
@@ -1,107 +1,13 @@
-;;; Commentary:
-;; Code for parsing vdir's and icalendar files.
-;; This module handles the finding of files, while
-;; (vcomponent parse ical) handles reading data from icalendar files.
-;;; Code:
-
 (define-module (vcomponent parse)
-  :use-module (srfi srfi-1)
-
-  :use-module ((ice-9 hash-table) :select (alist->hash-table))
-  :use-module ((ice-9 rdelim) :select (read-line))
-  :use-module ((ice-9 ftw) :select (scandir ftw))
-
   :use-module (util)
-  :use-module (util time)
-  :use-module (util exceptions)
   :use-module (vcomponent base)
+  :use-module ((vcomponent vdir parse) :select (parse-vdir))
+  :use-module ((util time) :select (report-time!))
 
   :use-module (vcomponent ical parse)
   :re-export (parse-calendar)
   )
 
-
-
-
-;; All VTIMEZONE's seem to be in "local" time in relation to
-;; themselves. Therefore, a simple comparison should work,
-;; and then the TZOFFSETTO properties can be subtd.
-(define (parse-vdir path)
-  (let ((/ (lambda args (string-join args file-name-separator-string 'infix))))
-    (let ((color
-           (catch 'system-error
-             (lambda () (call-with-input-file (/ path "color") read-line))
-             (const "#FFFFFF")))
-          (name
-           (catch 'system-error
-             (lambda () (call-with-input-file (/ path "displayname") read-line))
-             (const #f))))
-
-      (reduce (lambda (item calendar)
-
-                (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e)))
-                                                         (children item)))
-
-
-                ;; (assert (eq? 'VCALENDAR (type calendar)))
-                (assert (eq? 'VCALENDAR (type item)))
-
-                (for child in (children item)
-                     (set! (prop child '-X-HNH-FILENAME)
-                       (prop (parent child) '-X-HNH-FILENAME)))
-
-                ;; NOTE The vdir standard says that each file should contain
-                ;; EXACTLY one event. It can however contain multiple VEVENT
-                ;; components, but they are still the same event.
-                ;; In our case this means exceptions to reccurence rules, which
-                ;; is set up here, and then later handled in rrule-generate.
-                ;; NOTE These events also share UID, but are diferentiated
-                ;; by RECURRENCE-ID. As far as I can tell this goes against
-                ;; the standard. Section 3.8.4.4.
-                (case (length events)
-                  [(0) (warning "No events in component~%~a"
-                           (prop item '-X-HNH-FILENAME))]
-                  [(1)
-                   (let ((child (car events)))
-                    (assert (memv (type child) '(VTIMEZONE VEVENT)))
-                    (add-child! calendar child))]
-
-                  ;; two or more
-                  [else
-
-                   ;; Sorting on SEQUENCE here would have been nice.
-                   ;; But the patches can apparently share a sequence number
-                   ;; of 0 with the original event!
-                   ;; (╯°□°）╯ ┻━┻
-                   (let* ((head (find (negate (extract 'RECURRENCE-ID))
-                                      events))
-                          (rest (delete head events eq?)))
-
-                     (set! (prop head '-X-HNH-ALTERNATIVES)
-                       (alist->hash-table
-                        (map cons
-                             (map (extract 'RECURRENCE-ID) rest)
-                             rest))
-                       #;
-                       (sort*! rest ;; HERE
-                               date/-time< (extract 'RECURRENCE-ID)))
-                     (add-child! calendar head))])
-
-                ;; return
-                calendar)
-              (make-vcomponent)
-              (map #; (@ (ice-9 threads) par-map)
-               (lambda (fname)
-                 (let ((fullname (/ path fname)))
-                   (let ((cal (call-with-input-file fullname
-                                parse-calendar)))
-                     (set! (prop cal 'COLOR) color
-                           (prop cal 'NAME) name
-                           (prop cal '-X-HNH-FILENAME) fullname)
-                     cal)))
-               (scandir path (lambda (s) (and (not (string= "." (string-take s 1)))
-                                         (string= "ics" (string-take-right s 3))))))))))
-
 ;; Parse a vdir or ics file at the given path.
 (define-public (parse-cal-path path)
   ;; TODO check (access? path R_OK) ?
@@ -127,4 +33,3 @@
           (string-append "[" (basename path) "]"))))
 
   cal)
-
diff --git a/module/vcomponent/vdir/parse.scm b/module/vcomponent/vdir/parse.scm
new file mode 100644
index 00000000..ae4ea692
--- /dev/null
+++ b/module/vcomponent/vdir/parse.scm
@@ -0,0 +1,102 @@
+;;; Commentary:
+;; Code for parsing vdir's and icalendar files.
+;; This module handles the finding of files, while
+;; (vcomponent parse ical) handles reading data from icalendar files.
+;;; Code:
+
+(define-module (vcomponent parse)
+  :use-module (srfi srfi-1)
+
+  :use-module ((ice-9 hash-table) :select (alist->hash-table))
+  :use-module ((ice-9 rdelim) :select (read-line))
+  :use-module ((ice-9 ftw) :select (scandir ftw))
+
+  :use-module (util)
+  :use-module (util exceptions)
+  :use-module (vcomponent base)
+
+  :use-module (vcomponent ical parse)
+  )
+
+
+
+
+;; All VTIMEZONE's seem to be in "local" time in relation to
+;; themselves. Therefore, a simple comparison should work,
+;; and then the TZOFFSETTO properties can be subtd.
+(define (parse-vdir path)
+  (let ((/ (lambda args (string-join args file-name-separator-string 'infix))))
+    (let ((color
+           (catch 'system-error
+             (lambda () (call-with-input-file (/ path "color") read-line))
+             (const "#FFFFFF")))
+          (name
+           (catch 'system-error
+             (lambda () (call-with-input-file (/ path "displayname") read-line))
+             (const #f))))
+
+      (reduce (lambda (item calendar)
+
+                (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e)))
+                                                         (children item)))
+
+
+                ;; (assert (eq? 'VCALENDAR (type calendar)))
+                (assert (eq? 'VCALENDAR (type item)))
+
+                (for child in (children item)
+                     (set! (prop child '-X-HNH-FILENAME)
+                       (prop (parent child) '-X-HNH-FILENAME)))
+
+                ;; NOTE The vdir standard says that each file should contain
+                ;; EXACTLY one event. It can however contain multiple VEVENT
+                ;; components, but they are still the same event.
+                ;; In our case this means exceptions to reccurence rules, which
+                ;; is set up here, and then later handled in rrule-generate.
+                ;; NOTE These events also share UID, but are diferentiated
+                ;; by RECURRENCE-ID. As far as I can tell this goes against
+                ;; the standard. Section 3.8.4.4.
+                (case (length events)
+                  [(0) (warning "No events in component~%~a"
+                           (prop item '-X-HNH-FILENAME))]
+                  [(1)
+                   (let ((child (car events)))
+                    (assert (memv (type child) '(VTIMEZONE VEVENT)))
+                    (add-child! calendar child))]
+
+                  ;; two or more
+                  [else
+
+                   ;; Sorting on SEQUENCE here would have been nice.
+                   ;; But the patches can apparently share a sequence number
+                   ;; of 0 with the original event!
+                   ;; (╯°□°）╯ ┻━┻
+                   (let* ((head (find (negate (extract 'RECURRENCE-ID))
+                                      events))
+                          (rest (delete head events eq?)))
+
+                     (set! (prop head '-X-HNH-ALTERNATIVES)
+                       (alist->hash-table
+                        (map cons
+                             (map (extract 'RECURRENCE-ID) rest)
+                             rest))
+                       #;
+                       (sort*! rest ;; HERE
+                               date/-time< (extract 'RECURRENCE-ID)))
+                     (add-child! calendar head))])
+
+                ;; return
+                calendar)
+              (make-vcomponent)
+              (map #; (@ (ice-9 threads) par-map)
+               (lambda (fname)
+                 (let ((fullname (/ path fname)))
+                   (let ((cal (call-with-input-file fullname
+                                parse-calendar)))
+                     (set! (prop cal 'COLOR) color
+                           (prop cal 'NAME) name
+                           (prop cal '-X-HNH-FILENAME) fullname)
+                     cal)))
+               (scandir path (lambda (s) (and (not (string= "." (string-take s 1)))
+                                         (string= "ics" (string-take-right s 3))))))))))
+
diff --git a/module/output/vdir.scm b/module/vcomponent/vdir/save-delete.scm
index 2541f0f9..02db9d7a 100644
--- a/module/output/vdir.scm
+++ b/module/vcomponent/vdir/save-delete.scm
@@ -9,7 +9,7 @@
 
 ;;; Code:
 
-(define-module (output vdir)
+(define-module (vcomponent vdir save-delete)
   :use-module (util)
   :use-module (vcomponent ical output)
   :use-module (vcomponent)