aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2019-10-04 21:02:17 +0200
committerHugo Hörnquist <hugo@hornquist.se>2019-10-04 21:02:17 +0200
commit77791305d6e1483fa5ae46f26616242c00f99989 (patch)
treef71b777988f47f36cc46c724b9efdd090566f278
parentComments in parser. (diff)
downloadcalp-77791305d6e1483fa5ae46f26616242c00f99989.tar.gz
calp-77791305d6e1483fa5ae46f26616242c00f99989.tar.xz
HTML output seems to work in full now.
-rwxr-xr-xmodule/main.scm8
-rw-r--r--module/output/terminal.scm1
-rw-r--r--module/vcomponent/base.scm11
-rw-r--r--module/vcomponent/group.scm1
-rw-r--r--module/vcomponent/recurrence/generate.scm3
-rw-r--r--src/parse.c3
6 files changed, 20 insertions, 7 deletions
diff --git a/module/main.scm b/module/main.scm
index 2b0fde23..ce327f39 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -46,9 +46,11 @@ exec guile -e main -s $0 "$@"
;; Given as a sepparate function from main to ease debugging.
(define* (init proc #:key (calendar-files (calendar-files)))
(define calendars (map make-vcomponent calendar-files))
- (define events (concatenate (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
- (children cal)))
- calendars)))
+ (define events (concatenate
+ ;; TODO does this drop events?
+ (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
+ (children cal)))
+ calendars)))
(let* ((repeating regular (partition repeating? events)))
diff --git a/module/output/terminal.scm b/module/output/terminal.scm
index 67548537..a2c5486e 100644
--- a/module/output/terminal.scm
+++ b/module/output/terminal.scm
@@ -67,6 +67,7 @@
;; I currently have no idea why, but it's BAD.
(let ((groups (get-groups-between (group-stream event-stream)
(time-utc->date time) (time-utc->date time))))
+ (format (current-error-port) "len(groups) = ~a~%" (stream-length groups))
(let ((events
(if (stream-null? groups)
'() (group->event-list (stream-car groups)))))
diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 3bd58c21..246566ee 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -3,6 +3,7 @@
:use-module (srfi srfi-1)
:use-module (srfi srfi-17)
:use-module (vcomponent primitive)
+ :use-module (ice-9 hash-table)
:use-module ((ice-9 optargs) :select (define*-public)))
;; vline → value
@@ -76,12 +77,20 @@
(define*-public (children component)
(struct-ref component 1))
+(define (copy-vline vline)
+ (make-struct/no-tail (struct-vtable vline)
+ (struct-ref vline 0)
+ ;; TODO deep-copy on properties?
+ (struct-ref vline 1)))
+
(define-public (copy-vcomponent component)
(make-struct/no-tail (struct-vtable component)
(struct-ref component 0)
(struct-ref component 1)
(struct-ref component 2)
- (struct-ref component 3)))
+ (alist->hash-table
+ (hash-map->list (lambda (key value) (cons key (copy-vline value)))
+ (struct-ref component 3)))))
;; (define-public filter-children! %vcomponent-filter-children!)
diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm
index c5b6948e..41123126 100644
--- a/module/vcomponent/group.scm
+++ b/module/vcomponent/group.scm
@@ -7,6 +7,7 @@
#:use-module (srfi srfi-41 util)
#:export (group-stream))
+;; TODO templetize this
(define-stream (group-stream in-stream)
(define (ein? day) (lambda (e) (event-contains? e (date->time-utc day))))
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index c2863954..3f4cb869 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -51,6 +51,9 @@
(get-tz-offset e)
0))))
+ (set! (attr ev 'DTSTART)
+ (copy-time (attr ev 'DTSTART)))
+
(let ((i (interval r)))
(case (freq r)
((SECONDLY) (mod! (second d) = (+ i)))
diff --git a/src/parse.c b/src/parse.c
index 81312967..3a5907c8 100644
--- a/src/parse.c
+++ b/src/parse.c
@@ -91,9 +91,6 @@ int parse_file(char* filename, FILE* f, SCM root) {
SCM child = scm_make_vcomponent(scm_string_to_symbol(scm_from_strbuf(&str)));
scm_add_child_x (component, child);
- /* TODO it should be possible to create this object once
- at the top of this function
- */
scm_add_line_x(child, filename_key, scm_make_vline(scm_filename));
component = child;