diff options
Diffstat (limited to 'module/html/vcomponent.scm')
-rw-r--r-- | module/html/vcomponent.scm | 229 |
1 files changed, 0 insertions, 229 deletions
diff --git a/module/html/vcomponent.scm b/module/html/vcomponent.scm deleted file mode 100644 index c0bbe8e1..00000000 --- a/module/html/vcomponent.scm +++ /dev/null @@ -1,229 +0,0 @@ -(define-module (html vcomponent) - :use-module (util) - :use-module (vcomponent) - :use-module (srfi srfi-1) - :use-module (srfi srfi-41) - :use-module (datetime) - :use-module (html util) - :use-module ((html config) :select (edit-mode)) - :use-module ((html components) :select (btn tabset)) - :use-module ((util color) :select (calculate-fg-color)) - :use-module ((vcomponent datetime output) - :select (fmt-time-span - format-description - format-summary - format-recurrence-rule - )) - ) - -(define-public (compact-event-list list) - - (define calendars - (delete-duplicates! - (filter (lambda (x) (eq? 'VCALENDAR (type x))) - (map parent list)) - eq?)) - - (define (summary event) - `(summary (div (@ (class "summary-line ")) - (span (@ (class "square CAL_" - ,(html-attr - (or (prop (parent event) - 'NAME) - "unknown"))))) - (time ,(let ((dt (prop event 'DTSTART))) - (if (datetime? dt) - (datetime->string dt "~Y-~m-~d ~H:~M") - (date->string dt "~Y-~m-~d" )))) - (span ,(prop event 'SUMMARY))))) - (cons - (calendar-styles calendars) - (for event in list - `(details - ,(summary event) - ;; TODO better format, add show in calendar button - ,(fmt-single-event event))))) - -;; Format event as text. -;; Used in -;; - sidebar -;; - popup overwiew tab -;; - search result (event details) -(define*-public (fmt-single-event ev - optional: (attributes '()) - key: (fmt-header list)) - ;; (format (current-error-port) "fmt-single-event: ~a~%" (prop ev 'X-HNH-FILENAME)) - `(div (@ ,@(assq-merge - attributes - `((class " eventtext " - ,(when (and (prop ev 'PARTSTAT) - (eq? 'TENTATIVE (prop ev 'PARTSTAT))) - " tentative "))))) - (h3 ,(fmt-header - (when (prop ev 'RRULE) - `(span (@ (class "repeating")) "↺")) - `(span (@ (class "summary")) ,(prop ev 'SUMMARY)))) - (div - ,(call-with-values (lambda () (fmt-time-span ev)) - (case-lambda [(start) - `(div (time (@ (class "dtstart") - (data-fmt ,(string-append "~L" start)) - (datetime ,(datetime->string - (as-datetime (prop ev 'DTSTART)) - "~1T~3"))) - ,(datetime->string - (as-datetime (prop ev 'DTSTART)) - start)))] - [(start end) - `(div (time (@ (class "dtstart") - (data-fmt ,(string-append "~L" start)) - (datetime ,(datetime->string - (as-datetime (prop ev 'DTSTART)) - "~1T~3"))) - ,(datetime->string (as-datetime (prop ev 'DTSTART)) - start)) - " — " - (time (@ (class "dtend") - (data-fmt ,(string-append "~L" end)) - (datetime ,(datetime->string - (as-datetime (prop ev 'DTSTART)) - "~1T~3"))) - ,(datetime->string (as-datetime (prop ev 'DTEND)) - end)))])) - ,(when (and=> (prop ev 'LOCATION) (negate string-null?)) - `(div (b "Plats: ") - (div (@ (class "location")) - ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) - (prop ev 'LOCATION))))) - ,(awhen (prop ev 'DESCRIPTION) - `(span (@ (class "description")) - ,(format-description ev it))) - ,(awhen (prop ev 'RRULE) - `(span (@ (class "rrule")) - ,@(format-recurrence-rule ev))) - ,(when (prop ev 'LAST-MODIFIED) - `(span (@ (class "last-modified")) "Senast ändrad " - ,(datetime->string (prop ev 'LAST-MODIFIED) "~1 ~H:~M"))) - - ))) - - -;; Single event in side bar (text objects) -(define-public (fmt-day day) - (let* (((date . events) day)) - `(section (@ (class "text-day")) - (header (h2 ,(let ((s (date->string date "~Y-~m-~d"))) - `(a (@ (href "#" ,s) - (class "hidelink")) ,s)))) - ,@(stream->list - (stream-map - (lambda (ev) - (fmt-single-event - ev `((id ,(html-id ev)) - (class "CAL_" ,(html-attr (or (prop (parent ev) 'NAME) "unknown")))) - fmt-header: - (lambda body - `(a (@ (href "#" ,(html-id ev) #; (date-link (as-date (prop ev 'DTSTART))) - ) - (class "hidelink")) - ,@body)))) - (stream-filter - (lambda (ev) - ;; If start was an earlier day - ;; This removes all descriptions from - ;; events for previous days, - ;; solving duplicates. - (date/-time<=? date (prop ev 'DTSTART))) - events)))))) - - -(define-public (calendar-styles calendars) - `(style - ,(format #f "~:{.CAL_~a { --color: ~a; --complement: ~a }~%~}" - (map (lambda (c) - (let* ((name (html-attr (prop c 'NAME))) - (bg-color (prop c 'COLOR)) - (fg-color (and=> (prop c 'COLOR) - calculate-fg-color))) - (list name (or bg-color 'white) (or fg-color 'black)))) - calendars)))) - -;; "Physical" block in calendar view -(define*-public (make-block ev optional: (extra-attributes '())) - - `((a (@ (href "#" ,(html-id ev)) - (class "hidelink")) - (div (@ ,@(assq-merge - extra-attributes - `((id ,(html-id ev)) - (data-calendar ,(html-attr (or (prop (parent ev) 'NAME) "unknown"))) - (class "event CAL_" ,(html-attr (or (prop (parent ev) 'NAME) - "unknown")) - ,(when (and (prop ev 'PARTSTAT) - (eq? 'TENTATIVE (prop ev 'PARTSTAT))) - " tentative") - ,(when (and (prop ev 'TRANSP) - (eq? 'TRANSPARENT (prop ev 'TRANSP))) - " transparent") - ) - (onclick "toggle_popup('popup' + this.id)") - ))) - ;; Inner div to prevent overflow. Previously "overflow: none" - ;; was set on the surounding div, but the popup /needs/ to - ;; overflow (for the tabs?). - (div (@ (class "event-body")) - ,(when (prop ev 'RRULE) - `(span (@ (class "repeating")) "↺")) - (span (@ (class "summary")) - ,(format-summary ev (prop ev 'SUMMARY))) - ,(when (prop ev 'LOCATION) - `(span (@ (class "location")) - ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) - (prop ev 'LOCATION))))) - (div (@ (style "display:none !important;")) - ,((@ (vcomponent xcal output) ns-wrap) - ((@ (vcomponent xcal output) vcomponent->sxcal) - ev))))))) - - -(define (repeat-info event) - `(div (@ (class "eventtext")) - (h2 "Upprepningar") - (pre ,(prop event 'RRULE)))) - - -(define-public (popup ev id) - `(div (@ (id ,id) (class "popup-container CAL_" - ,(html-attr (or (prop (parent ev) 'NAME) - "unknown"))) - (onclick "event.stopPropagation()")) - ;; TODO all (?) code uses .popup-container as the popup, while .popup sits and does nothing. - ;; Do something about this? - (div (@ (class "popup")) - (nav (@ (class "popup-control")) - ,(btn "×" - title: "Stäng" - onclick: "close_popup(document.getElementById(this.closest('.popup-container').id))" - class: '("close-tooltip")) - ,(when (edit-mode) - (list - (btn "🖊️" - title: "Redigera" - onclick: "place_in_edit_mode(document.getElementById(this.closest('.popup-container').id.substr(5)))") - (btn "🗑" - title: "Ta bort" - onclick: "remove_event(document.getElementById(this.closest('.popup-container').id.substr(5)))")))) - - ,(tabset - `(("📅" title: "Översikt" - ,(fmt-single-event ev)) - ("⤓" title: "Nedladdning" - (div (@ (class "eventtext") (style "font-family:sans")) - (h2 "Ladda ner") - (ul (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".ics")) - "som iCal")) - (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".xcs")) - "som xCal"))))) - ,@(when (prop ev 'RRULE) - `(("↺" title: "Upprepningar" class: "repeating" - ,(repeat-info ev))))))))) |