aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--module/calp/html/util.scm31
-rw-r--r--module/calp/html/vcomponent.scm45
-rw-r--r--module/calp/html/view/calendar.scm4
-rw-r--r--module/calp/html/view/calendar/week.scm6
-rw-r--r--module/calp/server/routes.scm7
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))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-26 14:49:06 +0200