diff options
Diffstat (limited to 'module/calp/html/vcomponent.scm')
| -rw-r--r-- | module/calp/html/vcomponent.scm | 37 |
1 files changed, 30 insertions, 7 deletions
diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index ffdd37e2..5c92e1e7 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -3,6 +3,7 @@ ;; TODO should we really use path-append here? Path append is ;; system-dependant, while URL-paths aren't. :use-module ((hnh util path) :select (path-append)) + :use-module ((hnh util exceptions) :select (warning)) :use-module (srfi srfi-1) :use-module (srfi srfi-41) :use-module ((rnrs io ports) :select (put-bytevector)) @@ -18,15 +19,37 @@ :use-module ((vcomponent recurrence) :select (repeating?)) :use-module ((vcomponent datetime output) :select (fmt-time-span - format-description - format-summary format-recurrence-rule )) - :use-module ((calp util config) :select (get-config)) + :use-module (calp util config) :use-module ((base64) :select (base64encode)) + :use-module (ice-9 format) :use-module (calp translation) ) +(define-config summary-filter (lambda (_ a) a) + pre: (ensure procedure?)) + +(define-config description-filter (lambda (_ a) a) + pre: (ensure procedure?)) + + +(define-public (format-summary ev str) + ((get-config 'summary-filter) ev str)) + +;; NOTE this should have information about context (html/term/...) +;; And then be moved somewhere else. +(define-public (format-description ev str) + (catch* (lambda () ((get-config 'description-filter) ev str)) + (configuration-error + (lambda (key subr msg args data) + (format (current-error-port) + "Error retrieving configuration, ~?~%" msg args))) + (#t ; for errors when running the filter + (lambda (err . args) + (warning "~a on formatting description, ~s" err args) + str)))) + ;; used by search view (define-public (compact-event-list list) @@ -222,11 +245,11 @@ (stream-map (lambda (ev) (fmt-single-event - ev `((id ,(html-id ev)) + ev `((id ,(html-id ev) "-side") (data-calendar ,(base64encode (or (prop (parent ev) 'NAME) "unknown")))) fmt-header: (lambda body - `(a (@ (href "#" ,(html-id ev) #; (date-link (as-date (prop ev 'DTSTART))) + `(a (@ (href "#" ,(html-id ev) "-block" #; (date-link (as-date (prop ev 'DTSTART))) ) (class "hidelink")) ,@body)))) @@ -259,11 +282,11 @@ ;; surrounding <a /> element which allows something to happen when an element ;; is clicked with JS turned off. Our JS disables this, and handles clicks itself. - `((a (@ (href "#" ,(html-id ev)) + `((a (@ (href "#" ,(html-id ev) "-side") (class "hidelink")) (vevent-block (@ ,@(assq-merge extra-attributes - `((id ,(html-id ev)) + `((id ,(html-id ev) "-block") (data-calendar ,(base64encode (or (prop (parent ev) 'NAME) "unknown"))) (data-uid ,(output-uid ev)) |