diff options
Diffstat (limited to '')
-rw-r--r-- | module/calp/html/util.scm | 31 | ||||
-rw-r--r-- | module/calp/html/vcomponent.scm | 45 | ||||
-rw-r--r-- | module/calp/html/view/calendar.scm | 4 | ||||
-rw-r--r-- | module/calp/html/view/calendar/week.scm | 6 | ||||
-rw-r--r-- | module/calp/server/routes.scm | 7 |
5 files changed, 31 insertions, 62 deletions
diff --git a/module/calp/html/util.scm b/module/calp/html/util.scm index cd5aaeab..40852279 100644 --- a/module/calp/html/util.scm +++ b/module/calp/html/util.scm @@ -1,42 +1,11 @@ (define-module (calp html util) - :use-module ((base64) :select (base64encode base64decode)) :use-module (calp util)) -;;; @var{html-attr} & @var{html-unattr} used to just strip any -;;; attributes not valid in css. That allowed a human reader to -;;; quickly see what data it was. The downside was that it was one -;;; way. The new base64 based system supports both an encode and a -;;; decode without problem. -;;; -;;; The encoded string substitutes { + => å, / => ä, = => ö } to be -;;; valid CSS selector names. - -;; Retuns an HTML-safe version of @var{str}. -(define-public (html-attr str) - (string-map (lambda (c) - (case c - ((#\+) #\å) - ((#\/) #\ä) - ((#\=) #\ö) - (else c))) - (base64encode str))) - -(define-public (html-unattr str) - (base64decode - (string-map (lambda (c) - (case c - ((#\å) #\+) - ((#\ä) #\/) - ((#\ö) #\=) - (else c))) - str))) - (define-public (date-link date) ((@ (datetime) date->string) date "~Y-~m-~d")) - ;; Generate an html id for an event. ;; TODO? same event placed multiple times, when spanning multiple cells (define-public html-id diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index d1cd4886..b2959df5 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -23,6 +23,7 @@ format-recurrence-rule )) :use-module ((calp util config) :select (get-config)) + :use-module ((base64) :select (base64encode)) ) (define-public (compact-event-list list) @@ -35,11 +36,12 @@ (define (summary event) `(summary (div (@ (class "summary-line ")) - (span (@ (class "square CAL_" - ,(html-attr - (or (prop (parent event) - 'NAME) - "unknown"))))) + (span (@ (class "square") + (data-calendar + ,(base64encode + (or (prop (parent event) + 'NAME) + "unknown"))))) (time ,(let ((dt (prop event 'DTSTART))) (if (datetime? dt) (datetime->string dt "~Y-~m-~d ~H:~M") @@ -212,7 +214,7 @@ ,@(let ((dflt (get-config 'default-calendar))) (map (lambda (calendar) (define name (prop calendar 'NAME)) - `(option (@ (value ,(html-attr name)) + `(option (@ (value ,(base64encode name)) ,@(when (string=? name dflt) '((selected)))) ,name)) @@ -363,7 +365,7 @@ (lambda (ev) (fmt-single-event ev `((id ,(html-id ev)) - (class "CAL_" ,(html-attr (or (prop (parent ev) 'NAME) "unknown")))) + (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))) @@ -382,14 +384,14 @@ (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)))) + ,(lambda () (format #t "~:{ [data-calendar=\"~a\"] { --color: ~a; --complement: ~a }~%~}" + (map (lambda (c) + (let* ((name (base64encode (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 '())) @@ -399,10 +401,9 @@ (vevent-block (@ ,@(assq-merge extra-attributes `((id ,(html-id ev)) - (data-calendar ,(html-attr (or (prop (parent ev) 'NAME) "unknown"))) + (data-calendar ,(base64encode (or (prop (parent ev) 'NAME) "unknown"))) ;; (data-bindon "bind_view") - (class "vevent event CAL_" ,(html-attr (or (prop (parent ev) 'NAME) - "unknown")) + (class "vevent event" ,(when (and (prop ev 'PARTSTAT) (eq? 'TENTATIVE (prop ev 'PARTSTAT))) " tentative") @@ -619,9 +620,11 @@ (define-public (popup ev id) (warning "popup is deprecated") - `(div (@ (id ,id) (class "popup-container CAL_" - ,(html-attr (or (prop (parent ev) 'NAME) - "unknown"))) + `(div (@ (id ,id) + (class "popup-container") + (data-calendar + ,(base64encode (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? diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index 82cccdf3..634f6a69 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -27,6 +27,7 @@ :use-module ((vcomponent group) :select (group-stream get-groups-between)) + :use-module ((base64) :select (base64encode)) ) @@ -260,8 +261,7 @@ (summary "Calendar list") (ul ,@(map (lambda (calendar) - `(li (@ (class "CAL_" - ,(html-attr (prop calendar 'NAME)))) + `(li (@ (data-calendar ,(base64encode (prop calendar 'NAME)))) (a (@ (href "/search?" ,((@ (web uri-query) encode-query-parameters) `((q . (and (date/-time<=? diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm index cc89d77b..f6461f2f 100644 --- a/module/calp/html/view/calendar/week.scm +++ b/module/calp/html/view/calendar/week.scm @@ -86,10 +86,7 @@ (template (@ (id "popup-template")) (div (@ ; (id ,id) - (class "popup-container CAL_" - #; - ,(html-attr (or (prop (parent ev) 'NAME) ; - "unknown"))) + (class "popup-container") (onclick "event.stopPropagation()")) (div (@ (class "popup")) (nav (@ (class "popup-control")) @@ -203,6 +200,7 @@ (define (block-template) `(div (@ ; (id ,(html-id ev)) (data-calendar "unknown") + #; (class " CAL_unknown" ;; ,(when (and (prop ev 'PARTSTAT) ;; (eq? 'TENTATIVE (prop ev 'PARTSTAT))) diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm index b024ed4f..0bbd1579 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -20,7 +20,7 @@ :use-module ((rnrs io ports) :select (get-bytevector-all)) :use-module ((xdg basedir) :prefix xdg-) - :use-module ((calp html util) :select (html-unattr)) + :use-module ((base64) :select (base64decode)) :use-module (web http make-routes) @@ -162,8 +162,7 @@ (format #f "No event with UID '~a'" uid)))) ;; TODO this fails when dtstart is <date>. - ;; @var{cal} should be the name of the calendar encoded with - ;; modified base64. See (calp html util). + ;; @var{cal} should be the name of the calendar encoded in base64. (POST "/insert" (cal data) (unless (and cal data) @@ -174,7 +173,7 @@ ;; NOTE that this leaks which calendar exists, ;; but you can only query for existance. ;; also, the calendar view already show all calendars. - (let* ((calendar-name (html-unattr cal)) + (let* ((calendar-name (base64decode cal)) (calendar (find (lambda (c) (string=? calendar-name (prop c 'NAME))) (get-calendars global-event-object)))) |