diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/output/html.scm | 82 |
1 files changed, 45 insertions, 37 deletions
diff --git a/module/output/html.scm b/module/output/html.scm index 702d229d..0da52b0b 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -103,7 +103,7 @@ -(define* (btn key: onclick href +(define* (btn key: onclick href (class '()) allow-other-keys: rest: args) (when (and onclick href) @@ -115,7 +115,7 @@ (let ((body #f)) `(,(cond [onclick 'button] [href 'a]) - (@ (class "btn") + (@ (class ,(string-join (cons "btn" class) " ")) ,(cond [onclick `(onclick ,onclick)] [href `(href ,href)]) ,@(let loop ((rem args)) @@ -131,19 +131,21 @@ (div ,body)))) -(define (popup ev) - `(div (@ (class "popup")) - (nav (@ (class "popup-control CAL_" ,(html-attr (or (attr (parent ev) 'NAME) - "unknown")))) - ,(btn "×" - title: "Stäng" - onclick: "close_popup(this)" - ) - ,(btn "📅" - title: "Ladda ner" - href: (string-append "/calendar/" (attr ev 'UID) ".ics"))) +(define (popup ev id) + `(div (@ (class "popup-container") (id ,id)) + (div (@ (class "popup")) + (nav (@ (class "popup-control CAL_" ,(html-attr (or (attr (parent ev) 'NAME) + "unknown")))) + ,(btn "×" + title: "Stäng" + onclick: "" + class: '("close-tooltip") + ) + ,(btn "📅" + title: "Ladda ner" + href: (string-append "/calendar/" (attr ev 'UID) ".ics"))) - ,(fmt-single-event ev))) + ,(fmt-single-event ev)))) (define (data-attributes event) (hash-map->list @@ -185,29 +187,29 @@ (inner x (right-subtree tree)))))) (define* (make-block ev optional: (extra-attributes '())) - `(div (@ ,@(assq-merge - extra-attributes - `((class "event CAL_" ,(html-attr (or (attr (parent ev) 'NAME) - "unknown")) - ,(when (and (attr ev 'PARTSTAT) - (string= "TENTATIVE" (attr ev 'PARTSTAT))) - " tentative")) - ;; TODO only if in debug mode? - ,@(data-attributes ev)))) - (div (@ (class "event-inner")) - ;; NOTE These popup's are far from good. Main problem being that - ;; the often render off-screen for events high up on the screen. - ,(popup ev) - (a (@ (href "#" ,(UID ev)) - (class "hidelink")) - (div (@ (class "body")) - ,(when (attr ev 'RRULE) - `(span (@ (class "repeating")) "↺")) - ,((get-config 'summary-filter) ev (attr ev 'SUMMARY)) - ,(when (attr ev 'LOCATION) - `(span (@ (class "location")) - ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) - (attr ev 'LOCATION))))))))) + + (define popup-id (symbol->string (gensym "popup"))) + + `((a (@ (href "#" ,(UID ev)) + (class "hidelink")) + (div (@ ,@(assq-merge + extra-attributes + `((class "event CAL_" ,(html-attr (or (attr (parent ev) 'NAME) + "unknown")) + ,(when (and (attr ev 'PARTSTAT) + (string= "TENTATIVE" (attr ev 'PARTSTAT))) + " tentative")) + (data-tipped-options ,(format #f "inline: '~a'" popup-id)) + ;; TODO only if in debug mode? + ,@(data-attributes ev)))) + ,(when (attr ev 'RRULE) + `(span (@ (class "repeating")) "↺")) + ,((get-config 'summary-filter) ev (attr ev 'SUMMARY)) + ,(when (attr ev 'LOCATION) + `(span (@ (class "location")) + ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) + (attr ev 'LOCATION)))))) + ,(popup ev popup-id))) ;; Format single event for graphical display (define (create-block date ev) @@ -624,9 +626,15 @@ (content ,(date->string start-date "~s")))) (meta (@ (name end-time) (content ,(date->string (date+ end-date (date day: 1)) "~s")))) + ,(include-css "/static/tipped-4.7.0/dist/css/tipped.css") + ,(include-css "/static/style.css") ,(include-alt-css "/static/dark.css" '(title "Dark")) ,(include-alt-css "/static/light.css" '(title "Light")) + + (script (@ (src "/static/jquery-3.1.1.min.js")) "") + (script (@ (src "/static/tipped-4.7.0/dist/js/tipped.min.js")) "") + (script (@ (src "/static/script.js")) "") (style ,(format #f "~:{.CAL_~a { background-color: ~a; color: ~a }~%.CAL_bg_~a { border-color: ~a }~%~}" (map (lambda (c) |