diff options
Diffstat (limited to 'module')
| -rw-r--r-- | module/calp/html/vcomponent.scm | 27 | ||||
| -rw-r--r-- | module/calp/html/view/calendar.scm | 65 | ||||
| -rw-r--r-- | module/calp/html/view/calendar/week.scm | 11 |
3 files changed, 67 insertions, 36 deletions
diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index bff219aa..4c42d597 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -15,6 +15,7 @@ :use-module ((calp util color) :select (calculate-fg-color)) :use-module ((crypto) :select (sha256 checksum->string)) :use-module ((xdg basedir) :prefix xdg-) + :use-module ((vcomponent recurrence) :select (repeating?)) :use-module ((vcomponent recurrence internal) :prefix #{rrule:}#) :use-module ((vcomponent datetime output) :select (fmt-time-span @@ -414,7 +415,7 @@ extra-attributes `((id ,(html-id ev)) (data-calendar ,(base64encode (or (prop (parent ev) 'NAME) "unknown"))) - (data-uid ,(prop ev 'UID)) + (data-uid ,(output-uid ev)) (class "vevent event" ,(when (and (prop ev 'PARTSTAT) @@ -470,6 +471,30 @@ (else (->string value)))))) (prop event 'RRULE))))) + +;; Return a unique identifier for a specific instance of an event. +;; Allows us to reference each instance of a repeating event separately +;; from any other +(define-public (output-uid event) + (string-concatenate + (cons + (prop event 'UID) + (when (repeating? event) + ;; TODO this will break if a UID already looks like this... + ;; Just using a pre-generated unique string would solve it, + ;; until someone wants to break us. Therefore, we just give + ;; up for now, until a proper solution can be devised. + (list "---" + ;; TODO Will this give us a unique identifier? + ;; Or can two events share UID along with start time + (datetime->string + (as-datetime (or + ;; TODO What happens if the parameter RANGE=THISANDFUTURE is set? + (prop event 'RECURRENCE-ID) + (prop event 'DTSTART))) + "~Y-~m-~dT~H:~M:~S")))))) + + ;; TODO bind this into the xcal (define (editable-repeat-info event) (warning "editable-repeat-info is deprecated") diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index 45309856..b5319ea7 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -13,6 +13,7 @@ fmt-day make-block fmt-single-event + output-uid )) :use-module (calp html config) :use-module (calp html util) @@ -25,6 +26,7 @@ :use-module (srfi srfi-41) :use-module (srfi srfi-41 util) + :use-module ((vcomponent recurrence) :select (repeating? generate-recurrence-set)) :use-module ((vcomponent group) :select (group-stream get-groups-between)) :use-module ((base64) :select (base64encode)) @@ -361,26 +363,37 @@ window.default_calendar='~a';" SEQUENCE REQUEST-STATUS ))) - ;; (div (@ (style "display:none !important;")) - ;; ,(map (lambda (calendar) - ;; (prop calendar 'NAME)) - ;; calendars)) - - ,@(let ((flat-events - ;; A simple filter-sorted-stream on event-overlaps? here fails. - ;; See tests/annoying-events.scm - (stream->list - (stream-filter - (lambda (ev) - ((@ (vcomponent datetime) event-overlaps?) - ev start-date - (date+ end-date (date day: 1)))) - (stream-take-while (lambda (ev) (date< - (as-date (prop ev 'DTSTART)) - (date+ end-date (date day: 1)))) - events))))) - - `((div (@ (style "display:none !important;") + ,@(let* ( + (flat-events + ;; A simple filter-sorted-stream on event-overlaps? here fails. + ;; See tests/annoying-events.scm + (stream->list + (stream-filter + (lambda (ev) + ((@ (vcomponent datetime) event-overlaps?) + ev start-date + (date+ end-date (date day: 1)))) + (stream-take-while (lambda (ev) (date< + (as-date (prop ev 'DTSTART)) + (date+ end-date (date day: 1)))) + events)))) + (repeating% regular (partition repeating? flat-events)) + (repeating + (for ev in repeating% + (define instance (copy-vcomponent ev)) + + (set! (prop instance 'UID) (output-uid instance)) + (delete-parameter! (prop* instance 'DTSTART) '-X-HNH-ORIGINAL) + (delete-parameter! (prop* instance 'DTEND) '-X-HNH-ORIGINAL) + + instance))) + + `( + ;; Mapping showing which events belongs to which calendar, + ;; on the form + ;; (calendar (@ (key ,(base64-encode calendar-name))) + ;; (li ,event-uid) ...) + (div (@ (style "display:none !important;") (id "calendar-event-mapping")) ,(let ((ht (make-hash-table))) (for-each (lambda (event) @@ -388,7 +401,8 @@ window.default_calendar='~a';" (hash-set! ht name (cons (prop event 'UID) (hash-ref ht name '())))) - flat-events) + (append regular repeating)) + (hash-map->list (lambda (key values) `(calendar (@ (key ,(base64encode key))) @@ -399,8 +413,7 @@ window.default_calendar='~a';" ;; Calendar data for all events in current interval, ;; rendered as xcal. (div (@ (style "display:none !important;") - (id "xcal-data")) - ,((@ (vcomponent xcal output) ns-wrap) - (map (@ (vcomponent xcal output) vcomponent->sxcal) - flat-events - )))))))) + (id "xcal-data")) + ,((@ (vcomponent xcal output) ns-wrap) + (map (@ (vcomponent xcal output) vcomponent->sxcal) + (append regular repeating))))))))) diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm index 6df51da2..d6f35ad8 100644 --- a/module/calp/html/view/calendar/week.scm +++ b/module/calp/html/view/calendar/week.scm @@ -14,7 +14,7 @@ event-zero-length? events-between)) :use-module ((calp html vcomponent) - :select (make-block) ) + :select (make-block output-uid) ) ;; :use-module ((calp html components) ;; :select ()) :use-module ((vcomponent group) @@ -56,15 +56,8 @@ ,@(for event in (stream->list (events-between start-date end-date events)) `(popup-element - ;; TODO (@ (class "vevent") - (data-uid ,(prop event 'UID))) - ) - #; - ((@ (calp html vcomponent ) popup) ; - event (string-append "popup" (html-id event)))) - - )) + (data-uid ,(output-uid event))))))) ;; description in sidebar / tab of popup (template (@ (id "vevent-description")) |