From 228c86f792dcb487c923e173c90c995acc09efbf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 27 Sep 2020 17:17:55 +0200 Subject: Add new edit tab. --- module/calp/html/vcomponent.scm | 72 ++++++++++++++++++++++++++++++++++++++--- 1 file changed, 67 insertions(+), 5 deletions(-) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index c4e15374..8e52ed7c 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -98,17 +98,74 @@ ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) (prop ev 'LOCATION))))) ,(awhen (prop ev 'DESCRIPTION) - `(span (@ (class "description")) + `(div (@ (class "description")) ,(format-description ev it))) + + ,(awhen (prop ev 'CATEGORIES) + `(div (@ (class "categories")) + ,@(map (lambda (c) + `(a (@ (class "category") + ;; TODO centralize search terms + ;; TODO propper stringifycation of sexp + (href ,(format #f "/search/?q=%28member+%22~a%22%0D%0A++%28or+%28prop+event+%27CATEGORIES%29+%27%28%29%29%0D%0A" + c))) + ,c)) + it))) ,(awhen (prop ev 'RRULE) - `(span (@ (class "rrule")) - ,@(format-recurrence-rule ev))) + `(div (@ (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")))) + `(div (@ (class "last-modified")) "Senast ändrad " + ,(datetime->string (prop ev 'LAST-MODIFIED) "~1 ~H:~M")))) ))) +(define*-public (fmt-for-edit ev + optional: (attributes '()) + key: (fmt-header list)) + `(div (@ (class " eventtext ")) + (h3 (input (@ (type "text") (class "summary") + (placeholder "Sammanfattning") + (name "summary") (required) + (value ,(prop ev 'SUMMARY))))) + (div + ,(let ((start (prop ev 'DTSTART)) + (end (prop ev 'DTEND))) + `(table + (tr (td "Heldag?") + (td (input (@ (type "checkbox") + ,@(when (date? start) '((checked))))))) + (tr (td "Start") + (td (input (@ (type "date") (value ,(date->string (as-date start)))))) + (td + (input (@ ,@(when (date? start) + '((style "display:none"))) + (type "time") + (value ,(time->string (as-time start))))))) + (tr (td "Slut") + (td (input (@ (type "date") + ,@(when end `((value ,(date->string (as-date end)))))))) + (td (input (@ ,@(when (date? start) + '((style "display:none"))) + (type "time") + ,@(when end `((value ,(time->string (as-time end))))) + ))))))) + + (div (b "Plats: ") + (input (@ (name "location") + (value ,(or (prop ev 'LOCATION) ""))))) + + (div (@ (class "description")) + (textarea ,(prop ev 'DESCRIPTION))) + + (div (@ (class "categories")) + ,@(awhen (prop ev 'CATEGORIES) + (map (lambda (c) `(button (@ (class "category")) ,c)) + it)) + + (input (@ (class "category") (type "text") (placeholder "category")))))) + ;; Single event in side bar (text objects) (define-public (fmt-day day) @@ -238,6 +295,10 @@ ,(tabset `(("📅" title: "Översikt" ,(fmt-single-event ev)) + + ("📅" title: "Redigera" + ,(fmt-for-edit ev)) + ("⤓" title: "Nedladdning" (div (@ (class "eventtext") (style "font-family:sans")) (h2 "Ladda ner") @@ -245,6 +306,7 @@ "som iCal")) (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".xcs")) "som xCal"))))) + ,@(when (prop ev 'RRULE) `(("↺" title: "Upprepningar" class: "repeating" ,(repeat-info ev))))))))) -- cgit v1.2.3 From 7c4dda4f90a1929dde13b254ae6f1e5a766cc7f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 27 Sep 2020 20:53:35 +0200 Subject: Input cleaned up. --- module/calp/html/components.scm | 50 +++++++++++++++++++++++ module/calp/html/vcomponent.scm | 87 +++++++++++++++++++++++------------------ 2 files changed, 100 insertions(+), 37 deletions(-) (limited to 'module') diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm index ebc359b8..03e1cef1 100644 --- a/module/calp/html/components.scm +++ b/module/calp/html/components.scm @@ -1,6 +1,8 @@ (define-module (calp html components) :use-module (calp util) :use-module (calp util exceptions) + :use-module (ice-9 curried-definitions) + :use-module (ice-9 match) :export (xhtml-doc) ) @@ -112,6 +114,54 @@ ,key) (div (@ (class "content")) ,body))))) +(define ((set-attribute attr) el) + (match el + [(tagname ('@ params ...) inner-body ...) + `(,tagname (@ ,@(assq-merge params attr)) + ,@inner-body)] + [(tagname inner-body ...) + `(,tagname (@ ,attr) + ,@inner-body)])) + + +(define-public (with-label lbl . forms) + + (define id (gensym "label")) + + (cons `(label (@ (for ,id)) ,lbl) + (let recurse ((forms forms)) + (map (lambda (form) + (cond [(not (list? form)) form] + [(null? form) '()] + [(eq? 'input (car form)) + ((set-attribute `((id ,id))) form)] + [(list? (car form)) + (cons (recurse (car form)) + (recurse (cdr form)))] + [else + (cons (car form) + (recurse (cdr form)))])) + forms)))) + + +(define-public (form elements) + `(form + ,@(map (label self + (lambda (el) + (match el + ((name ('@ tags ...) body ...) + (let ((id (gensym "formelement"))) + (cons + `(label (@ (for ,id)) ,name) + (map + (set-attribute `((name ,name))) + (cons + ((set-attribute `((id ,id))) (car body)) + (cdr body)))))) + ((name body ...) + (self `(,name (@) ,@body)))))) + elements))) + (define-public (include-css path . extra-attributes) `(link (@ (type "text/css") diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 8e52ed7c..89020bd8 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -7,7 +7,7 @@ :use-module ((text util) :select (add-enumeration-punctuation)) :use-module (calp html util) :use-module ((calp html config) :select (edit-mode)) - :use-module ((calp html components) :select (btn tabset)) + :use-module ((calp html components) :select (btn tabset form with-label)) :use-module ((calp util color) :select (calculate-fg-color)) :use-module ((vcomponent datetime output) :select (fmt-time-span @@ -125,46 +125,59 @@ optional: (attributes '()) key: (fmt-header list)) `(div (@ (class " eventtext ")) - (h3 (input (@ (type "text") (class "summary") - (placeholder "Sammanfattning") - (name "summary") (required) - (value ,(prop ev 'SUMMARY))))) - (div - ,(let ((start (prop ev 'DTSTART)) - (end (prop ev 'DTEND))) - `(table - (tr (td "Heldag?") - (td (input (@ (type "checkbox") - ,@(when (date? start) '((checked))))))) - (tr (td "Start") - (td (input (@ (type "date") (value ,(date->string (as-date start)))))) - (td - (input (@ ,@(when (date? start) - '((style "display:none"))) - (type "time") - (value ,(time->string (as-time start))))))) - (tr (td "Slut") - (td (input (@ (type "date") - ,@(when end `((value ,(date->string (as-date end)))))))) - (td (input (@ ,@(when (date? start) - '((style "display:none"))) - (type "time") - ,@(when end `((value ,(time->string (as-time end))))) - ))))))) + (div (@ (class "edit-form")) + (h3 (input (@ (type "text") (class "summary") + (placeholder "Sammanfattning") + (name "summary") (required) + (value ,(prop ev 'SUMMARY))))) + + ,@(with-label "Heldag" `(input (@ (name "wholeday") (type "checkbox")))) + + ,@(let ((start (prop ev 'DTSTART))) + (with-label "Start" + `(div (input (@ (type "date") + (name "dtstart-date") + (value ,(date->string (as-date start))))) + (input (@ ,@(when (date? start) + '((style "display:none"))) + (type "time") + (name "dtstart-end") + (value ,(time->string (as-time start)))))))) + ,@(let ((end (prop ev 'DTEND))) + (with-label "Slut" + `(div (input (@ (type "date") + (name "dtend-date") + ,@(when end `((value ,(date->string (as-date end))))))) + (input (@ ,@(when (date? end) + '((style "display:none"))) + (type "time") + (name "dtend-time") + ,@(when end `((value ,(time->string (as-time end))))) + ))))) - (div (b "Plats: ") - (input (@ (name "location") - (value ,(or (prop ev 'LOCATION) ""))))) + ,@(with-label + "Plats" + `(input (@ (placeholder "Plats") + (name "location") + (type "text") + (value ,(or (prop ev 'LOCATION) ""))))) - (div (@ (class "description")) - (textarea ,(prop ev 'DESCRIPTION))) + ,@(with-label + "Beskrivning" + `(textarea (@ (placeholder "Beskrivning") + (name "description")) + ,(prop ev 'DESCRIPTION))) - (div (@ (class "categories")) - ,@(awhen (prop ev 'CATEGORIES) - (map (lambda (c) `(button (@ (class "category")) ,c)) - it)) + ,@(with-label + "Kategorier" + (awhen (prop ev 'CATEGORIES) + (map (lambda (c) `(button (@ (class "category")) ,c)) + it)) - (input (@ (class "category") (type "text") (placeholder "category")))))) + `(input (@ (class "category") + (type "text") + (placeholder "category")))) + ))) ;; Single event in side bar (text objects) -- cgit v1.2.3 From b3250ac8289e4f4154682680d89c417f9a115e18 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 27 Sep 2020 23:17:01 +0200 Subject: Add fancy editing of tag list. --- module/calp/html/vcomponent.scm | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 89020bd8..67634492 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -131,7 +131,7 @@ (name "summary") (required) (value ,(prop ev 'SUMMARY))))) - ,@(with-label "Heldag" `(input (@ (name "wholeday") (type "checkbox")))) + ,@(with-label "Heldag?" `(input (@ (name "wholeday") (type "checkbox")))) ,@(let ((start (prop ev 'DTSTART))) (with-label "Start" @@ -170,13 +170,19 @@ ,@(with-label "Kategorier" - (awhen (prop ev 'CATEGORIES) - (map (lambda (c) `(button (@ (class "category")) ,c)) - it)) + `(div (@ (class "inline-edit")) + ,@(awhen (prop ev 'CATEGORIES) + (map (lambda (c) + `(input (@ (size 2) + (value ,c)))) + it)) - `(input (@ (class "category") - (type "text") - (placeholder "category")))) + (input (@ (class "final") + (size 2) + (type "text") + )))) + + (input (@ (type "submit"))) ))) -- cgit v1.2.3 From 6ad74ec3383b7a8d8403cdf185caabd4332109a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 28 Sep 2020 01:01:45 +0200 Subject: Made timeinput checkbox needlesly fancy. --- module/calp/html/vcomponent.scm | 134 ++++++++++++++++++++++------------------ 1 file changed, 75 insertions(+), 59 deletions(-) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 67634492..54bfb9e8 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -125,65 +125,81 @@ optional: (attributes '()) key: (fmt-header list)) `(div (@ (class " eventtext ")) - (div (@ (class "edit-form")) - (h3 (input (@ (type "text") (class "summary") - (placeholder "Sammanfattning") - (name "summary") (required) - (value ,(prop ev 'SUMMARY))))) - - ,@(with-label "Heldag?" `(input (@ (name "wholeday") (type "checkbox")))) - - ,@(let ((start (prop ev 'DTSTART))) - (with-label "Start" - `(div (input (@ (type "date") - (name "dtstart-date") - (value ,(date->string (as-date start))))) - (input (@ ,@(when (date? start) - '((style "display:none"))) - (type "time") - (name "dtstart-end") - (value ,(time->string (as-time start)))))))) - ,@(let ((end (prop ev 'DTEND))) - (with-label "Slut" - `(div (input (@ (type "date") - (name "dtend-date") - ,@(when end `((value ,(date->string (as-date end))))))) - (input (@ ,@(when (date? end) - '((style "display:none"))) - (type "time") - (name "dtend-time") - ,@(when end `((value ,(time->string (as-time end))))) - ))))) - - ,@(with-label - "Plats" - `(input (@ (placeholder "Plats") - (name "location") - (type "text") - (value ,(or (prop ev 'LOCATION) ""))))) - - ,@(with-label - "Beskrivning" - `(textarea (@ (placeholder "Beskrivning") - (name "description")) - ,(prop ev 'DESCRIPTION))) - - ,@(with-label - "Kategorier" - `(div (@ (class "inline-edit")) - ,@(awhen (prop ev 'CATEGORIES) - (map (lambda (c) - `(input (@ (size 2) - (value ,c)))) - it)) - - (input (@ (class "final") - (size 2) - (type "text") - )))) - - (input (@ (type "submit"))) - ))) + (form (@ (class "edit-form")) + (h3 (input (@ (type "text") + (placeholder "Sammanfattning") + (name "summary") (required) + (value ,(prop ev 'SUMMARY))))) + + ,(let ((start (prop ev 'DTSTART)) + (end (prop ev 'DTEND))) + `(div (@ (class "timeinput")) + + (input (@ (type "date") + (name "dtstart-date") + (style "grid-column:1;grid-row:2") + (value ,(date->string (as-date start))))) + + (input (@ (type "date") + (name "dtend-date") + (style "grid-column:1;grid-row:3") + ,@(when end `((value ,(date->string (as-date end))))))) + + ,@(with-label + "Heldag?" + `(input (@ (type "checkbox") (style "display:none") + (name "wholeday")))) + + (input (@ ,@(when (date? start) + '((style "display:none"))) + (type "time") + (name "dtstart-end") + (style "grid-column:3;grid-row:2") + (value ,(time->string (as-time start))))) + + (input (@ ,@(when (date? end) + '((style "display:none"))) + (type "time") + (name "dtend-time") + (style "grid-column:3;grid-row:3") + ,@(when end `((value ,(time->string (as-time end))))) + )))) + + ,@(with-label + "Plats" + `(input (@ (placeholder "Plats") + (name "location") + (type "text") + (value ,(or (prop ev 'LOCATION) ""))))) + + ,@(with-label + "Beskrivning" + `(textarea (@ (placeholder "Beskrivning") + (name "description")) + ,(prop ev 'DESCRIPTION))) + + ,@(with-label + "Kategorier" + `(div (@ (class "inline-edit")) + ,@(awhen (prop ev 'CATEGORIES) + (map (lambda (c) + `(input (@ (size 2) + (value ,c)))) + it)) + + (input (@ (class "final") + (size 2) + (type "text") + )))) + + #; + (input (@ (type "text") + (list "known-fields") + (placeholder "Nytt fält"))) + + + (input (@ (type "submit"))) + ))) ;; Single event in side bar (text objects) -- cgit v1.2.3 From 04dcab7a429d9b034d41b5aca8bd715c4826de32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 28 Sep 2020 03:10:54 +0200 Subject: Groundwork for adding new fields from frontend. --- module/calp/html/vcomponent.scm | 17 +++++++++++++---- module/calp/html/view/calendar.scm | 25 ++++++++++++++++++++++++- 2 files changed, 37 insertions(+), 5 deletions(-) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 54bfb9e8..2497aa04 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -192,10 +192,19 @@ (type "text") )))) - #; - (input (@ (type "text") - (list "known-fields") - (placeholder "Nytt fält"))) + (hr) + + (div (@ (class "newfield")) + (input (@ (type "text") + (list "known-fields") + (placeholder "Nytt fält"))) + (select (@ (name "TYPE")) + (option (@ (value "TEXT")) "Text")) + (span + (input (@ (type "text") + (placeholder "Värde"))))) + + (hr) (input (@ (type "submit"))) diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index a583d82b..64986b5c 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -296,4 +296,27 @@ ;; TODO merge this into the event-set, add attribute ;; for non-displaying elements. (div (@ (class "template") (id "popup-template")) - ,(popup event (string-append "popup" (html-id event))))))))) + ,(popup event (string-append "popup" (html-id event)))))) + + ;; Auto-complets when adding new fields to a component + ;; Any string is however still valid. + (datalist (@ (id "known-fields")) + ,@(map (lambda (f) + `(option (@ (value ,f)))) + '(CALSCALE + METHOD PRODID VERSION ATTACH + CATEGORIES CLASS COMMENT + DESCRIPTION GEO LOCATION + PERCENT-COMPLETE PRIORITY + RESOURCES STATUS SUMMARY + COMPLETED DTEND DUE DTSTART + DURATION FREEBUSY + TRANSP TZID TZNAME + TZOFFSETFROM TZOFFSETTO + TZURL ATTENDEE CONTACT + ORGANIZER RECURRENCE-ID + RELATED-TO URL EXDATE + RDATE RRULE ACTION REPEAT + TRIGGER CREATED DTSTAMP LAST-MODIFIED + SEQUENCE REQUEST-STATUS + )))))) -- cgit v1.2.3 From 0e6050122d78ce427715deb0b08ed26fc4af1c5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 2 Oct 2020 00:35:20 +0200 Subject: Fix XML double attribute error. --- module/calp/html/vcomponent.scm | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 2497aa04..7a4de873 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -150,18 +150,16 @@ `(input (@ (type "checkbox") (style "display:none") (name "wholeday")))) - (input (@ ,@(when (date? start) - '((style "display:none"))) - (type "time") + (input (@ (type "time") (name "dtstart-end") - (style "grid-column:3;grid-row:2") + (style "grid-column:3;grid-row:2;" + ,(when (date? start) "display:none")) (value ,(time->string (as-time start))))) - (input (@ ,@(when (date? end) - '((style "display:none"))) - (type "time") + (input (@ (type "time") (name "dtend-time") - (style "grid-column:3;grid-row:3") + (style "grid-column:3;grid-row:3;" + ,(when (date? end) "display:none")) ,@(when end `((value ,(time->string (as-time end))))) )))) -- cgit v1.2.3 From f533f5050bb4899e18dc1656458697b1d277dd56 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 2 Oct 2020 16:49:43 +0200 Subject: Binding of fields in edit tab work. --- module/calp/html/vcomponent.scm | 50 ++++++++++++++++++++++++++++++++--------- 1 file changed, 39 insertions(+), 11 deletions(-) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 7a4de873..0f8014db 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -56,18 +56,21 @@ ;; (format (current-error-port) "fmt-single-event: ~a~%" (prop ev 'X-HNH-FILENAME)) `(div (@ ,@(assq-merge attributes - `((class " eventtext " + `((class " eventtext summary-tab " ,(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)))) + `(span (@ (class "bind summary") + (data-property "summary")) + ,(prop ev 'SUMMARY)))) (div ,(call-with-values (lambda () (fmt-time-span ev)) (case-lambda [(start) - `(div (time (@ (class "dtstart") + `(div (time (@ (class "bind dtstart") + (data-property "dtstart") (data-fmt ,(string-append "~L" start)) (datetime ,(datetime->string (as-datetime (prop ev 'DTSTART)) @@ -76,7 +79,8 @@ (as-datetime (prop ev 'DTSTART)) start)))] [(start end) - `(div (time (@ (class "dtstart") + `(div (time (@ (class "bind dtstart") + (data-property "dtstart") (data-fmt ,(string-append "~L" start)) (datetime ,(datetime->string (as-datetime (prop ev 'DTSTART)) @@ -84,23 +88,30 @@ ,(datetime->string (as-datetime (prop ev 'DTSTART)) start)) " — " - (time (@ (class "dtend") + (time (@ (class "bind dtend") + (data-property "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)))])) + + ;; TODO add optional fields when added in frontend + ;; Possibly by always having them here, just hidden. + (div (@ (class "fields")) ,(when (and=> (prop ev 'LOCATION) (negate string-null?)) `(div (b "Plats: ") - (div (@ (class "location")) + (div (@ (class "bind location") (data-property "location")) ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) (prop ev 'LOCATION))))) ,(awhen (prop ev 'DESCRIPTION) - `(div (@ (class "description")) + `(div (@ (class "bind description") + (data-property "description")) ,(format-description ev it))) + ;; TODO add bind once I figure out how to bind lists ,(awhen (prop ev 'CATEGORIES) `(div (@ (class "categories")) ,@(map (lambda (c) @@ -111,6 +122,8 @@ c))) ,c)) it))) + + ;; TODO bind ,(awhen (prop ev 'RRULE) `(div (@ (class "rrule")) ,@(format-recurrence-rule ev))) @@ -124,11 +137,12 @@ (define*-public (fmt-for-edit ev optional: (attributes '()) key: (fmt-header list)) - `(div (@ (class " eventtext ")) + `(div (@ (class " eventtext edit-tab ")) (form (@ (class "edit-form")) (h3 (input (@ (type "text") (placeholder "Sammanfattning") (name "summary") (required) + (class "bind") (data-property "summary") (value ,(prop ev 'SUMMARY))))) ,(let ((start (prop ev 'DTSTART)) @@ -138,11 +152,15 @@ (input (@ (type "date") (name "dtstart-date") (style "grid-column:1;grid-row:2") + (class "bind") + (data-property "--dtstart-date") (value ,(date->string (as-date start))))) (input (@ (type "date") (name "dtend-date") (style "grid-column:1;grid-row:3") + (class "bind") + (data-property "--dtend-date") ,@(when end `((value ,(date->string (as-date end))))))) ,@(with-label @@ -151,13 +169,17 @@ (name "wholeday")))) (input (@ (type "time") - (name "dtstart-end") + (name "dtstart-time") + (class "bind") + (data-property "--dtstart-time") (style "grid-column:3;grid-row:2;" ,(when (date? start) "display:none")) (value ,(time->string (as-time start))))) (input (@ (type "time") (name "dtend-time") + (class "bind") + (data-property "--dtend-time") (style "grid-column:3;grid-row:3;" ,(when (date? end) "display:none")) ,@(when end `((value ,(time->string (as-time end))))) @@ -168,11 +190,13 @@ `(input (@ (placeholder "Plats") (name "location") (type "text") + (class "bind") (data-property "location") (value ,(or (prop ev 'LOCATION) ""))))) ,@(with-label "Beskrivning" `(textarea (@ (placeholder "Beskrivning") + (class "bind") (data-property "description") (name "description")) ,(prop ev 'DESCRIPTION))) @@ -190,6 +214,8 @@ (type "text") )))) + ;; TODO extra fields + (hr) (div (@ (class "newfield")) @@ -275,10 +301,12 @@ (div (@ (class "event-body")) ,(when (prop ev 'RRULE) `(span (@ (class "repeating")) "↺")) - (span (@ (class "summary")) + (span (@ (class "bind summary") + (data-property "summary")) ,(format-summary ev (prop ev 'SUMMARY))) ,(when (prop ev 'LOCATION) - `(span (@ (class "location")) + `(span (@ (class "bind location") + (data-property "location")) ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) (prop ev 'LOCATION))))) (div (@ (style "display:none !important;")) -- cgit v1.2.3 From a73c338fd87f78b872386d2b04152fa9a1ec05a1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 2 Oct 2020 16:58:51 +0200 Subject: Move JS type info into own file. --- module/calp/html/view/calendar.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'module') diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index 64986b5c..abf43118 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -104,6 +104,7 @@ ,(include-alt-css "/static/dark.css" '(title "Dark")) ,(include-alt-css "/static/light.css" '(title "Light")) + (script (@ (defer) (src "/static/types.js"))) (script (@ (defer) (src "/static/lib.js"))) (script (@ (defer) (src "/static/script.js"))) ,(calendar-styles calendars)) -- cgit v1.2.3 From 6e240ba91752990c6cb087e576432ce9b6a8ad44 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 5 Oct 2020 02:17:09 +0200 Subject: Simplify /insert endpoint. --- module/calp/server/routes.scm | 66 ++++++++++++++++++------------------------- module/vcomponent/base.scm | 8 ------ 2 files changed, 27 insertions(+), 47 deletions(-) (limited to 'module') diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm index 184b4481..276513f5 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -218,55 +218,43 @@ [(get-event-by-uid global-event-object (prop event 'UID)) => (lambda (old-event) - ;; procedure to run after save. - ;; used as hook to remove old event from disk below - (define after-save (const #f)) - - (if (eq? calendar (parent old-event)) - (begin (vcomponent-update! old-event event) - ;; for save below - (set! event old-event)) - - ;; change calendar - (begin - - (format (current-error-port) - "Calendar change~%") - - ;; remove from runtime - ((@ (vcomponent instance methods) remove-event) - global-event-object old-event) - - ;; Actually puring the old event should be safe, - ;; since we first make sure we write the new event to disk. - ;; Currently the whole transaction isn't atomic, so a duplicate - ;; event can still be created. - (set! after-save - ;; remove from disk - (lambda () - (format (current-error-port) - "Unlinking old event from ~a~%" - (prop old-event '-X-HNH-FILENAME)) - ((@ (vcomponent vdir save-delete) remove-event) old-event))) - - (parameterize ((warnings-are-errors #t)) - (catch 'warning - (lambda () (add-event global-event-object calendar event)) - (lambda (err fmt args) - (return (build-response code: 400) - (format #f "~?~%" fmt args))))))) + ;; remove old instance of event from runtime + ((@ (vcomponent instance methods) remove-event) + global-event-object old-event) + + ;; Add new event to runtime, + ;; MUST be done after since the two events SHOULD share UID. + (parameterize ((warnings-are-errors #t)) + (catch 'warning + (lambda () (add-event global-event-object calendar event)) + (lambda (err fmt args) + (return (build-response code: 400) + (format #f "~?~%" fmt args))))) (set! (prop event 'LAST-MODIFIED) (current-datetime)) - ;; NOTE Posibly defer save to a later point. ;; That would allow better asyncronous preformance. + + ;; save-event sets -X-HNH-FILENAME from the UID. This is fine + ;; since the two events are guaranteed to have the same UID. (unless ((@ (vcomponent vdir save-delete) save-event) event) (return (build-response code: 500) "Saving event to disk failed.")) - (after-save) + + (unless (eq? calendar (parent old-event)) + ;; change to a new calendar + (format (current-error-port) + "Unlinking old event from ~a~%" + (prop old-event '-X-HNH-FILENAME)) + ;; NOTE that this may fail, leading to a duplicate event being + ;; created (since we save beforehand). This is just a minor problem + ;; which either a better atomic model, or a propper error + ;; recovery log would solve. + ((@ (vcomponent vdir save-delete) remove-event) old-event)) + (format (current-error-port) "Event updated ~a~%" (prop event 'UID)))] diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index ae10fe01..34d4416b 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -169,14 +169,6 @@ (copy-vline value)))) (get-component-properties component))))) -;; updates target with all fields from source. -;; fields in target but not in source left unchanged. -;; parent and children unchanged -(define-public (vcomponent-update! target source) - (for key in (property-keys source) - (set! (prop* target key) - (prop* source key)))) - (define-public (extract field) (lambda (e) (prop e field))) -- cgit v1.2.3 From 7fd091319ee3cca1abea5e7bfcd3e6271f452015 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 5 Oct 2020 02:44:28 +0200 Subject: Remove old edit mode. --- module/calp/html/vcomponent.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 0f8014db..7414654b 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -139,6 +139,7 @@ key: (fmt-header list)) `(div (@ (class " eventtext edit-tab ")) (form (@ (class "edit-form")) + (div (@ (class "dropdown-goes-here"))) (h3 (input (@ (type "text") (placeholder "Sammanfattning") (name "summary") (required) -- cgit v1.2.3 From c6ecb5325a8afdbb39b0bc90e85fdec04c61330d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 13 Oct 2020 16:40:51 +0200 Subject: Config loading now in 'sandbox'. --- module/calp/main.scm | 64 ++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 52 insertions(+), 12 deletions(-) (limited to 'module') diff --git a/module/calp/main.scm b/module/calp/main.scm index 407f7b81..2eb1ee05 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -15,6 +15,8 @@ :use-module (ice-9 getopt-long) :use-module (ice-9 regex) :use-module ((ice-9 popen) :select (open-input-pipe)) + :use-module ((ice-9 sandbox) :select + (make-sandbox-module all-pure-and-impure-bindings)) :use-module (statprof) :use-module (calp repl) @@ -99,6 +101,11 @@ (if (null? a) b a)) +(define (bindings-for module-name) + ;; Wrapping list so we can later export sub-modules. + (list (cons module-name + (module-map (lambda (a . _) a) + (resolve-interface module-name))))) (define (wrapped-main args) (define opts (getopt-long args (getopt-opt options) #:stop-at-first-non-option #t)) @@ -106,6 +113,20 @@ (define repl (option-ref opts 'repl #f)) (define altconfig (option-ref opts 'config #f)) + (define config-file + (cond [altconfig + (if (file-exists? altconfig) + altconfig + (throw 'option-error + "Configuration file ~a missing" altconfig))] + ;; altconfig could be placed in the list below. But I want to raise an error + ;; if an explicitly given config is missing. + [(find file-exists? + (list + (path-append (xdg-config-home) "/calp/config.scm") + (path-append (xdg-sysconfdir) "/calp/config.scm"))) + => identity])) + (when stprof (statprof-start)) (cond [(eqv? #t repl) (repl-start (format #f "~a/calp-~a" @@ -113,18 +134,37 @@ (getpid)))] [repl => repl-start]) - (if altconfig - (begin - (if (file-exists? altconfig) - (primitive-load altconfig) - (throw 'option-error "Configuration file ~a missing" altconfig))) - ;; if not altconfig, then regular config - - (awhen (find file-exists? - (list - (path-append (xdg-config-home) "/calp/config.scm") - (path-append (xdg-sysconfdir) "/calp/config.scm"))) - (primitive-load it))) + + ;; load config + (catch #t + (lambda () + (eval + `(begin + (use-modules (srfi srfi-1) + (srfi srfi-88) + (datetime) + (vcomponent) + (calp util config) + (glob)) + ,@(with-input-from-file config-file + (lambda () + (let loop ((done '())) + (let ((form (read))) + (if (eof-object? form) + (reverse done) + (loop (cons form done)))))))) + (make-sandbox-module + `(((guile) use-modules) + ,@all-pure-and-impure-bindings + )) + )) + (lambda args + (format (current-error-port) + "Failed loading config file ~a~%~s~%" + config-file + args + ))) + ;; NOTE this doesn't stop at first non-option, meaning that -o flags -- cgit v1.2.3 From 5714f53e6c038598c7ae17cfc9b359fff2fa698f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 15 Oct 2020 00:12:04 +0200 Subject: Clarify use of sandbox. --- module/calp/main.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'module') diff --git a/module/calp/main.scm b/module/calp/main.scm index 2eb1ee05..92f33280 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -135,7 +135,10 @@ [repl => repl-start]) - ;; load config + ;; Load config + ;; Sandbox and "stuff" not for security from the user. The config script is + ;; assumed to be "safe". Instead it's so we can control the environment in + ;; which it is executed. (catch #t (lambda () (eval -- cgit v1.2.3 From 99120bc1b7920261e1020d501de139c71a381492 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 15 Oct 2020 00:12:20 +0200 Subject: Datetime bindings for search. --- module/calp/main.scm | 6 ------ module/vcomponent/search.scm | 9 ++++++++- 2 files changed, 8 insertions(+), 7 deletions(-) (limited to 'module') diff --git a/module/calp/main.scm b/module/calp/main.scm index 92f33280..e296632a 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -101,12 +101,6 @@ (if (null? a) b a)) -(define (bindings-for module-name) - ;; Wrapping list so we can later export sub-modules. - (list (cons module-name - (module-map (lambda (a . _) a) - (resolve-interface module-name))))) - (define (wrapped-main args) (define opts (getopt-long args (getopt-opt options) #:stop-at-first-non-option #t)) (define stprof (option-ref opts 'statprof #f)) diff --git a/module/vcomponent/search.scm b/module/vcomponent/search.scm index 7d039a24..fef0b100 100644 --- a/module/vcomponent/search.scm +++ b/module/vcomponent/search.scm @@ -52,6 +52,13 @@ (define-public (prepare-string str) (call-with-input-string (close-parenthese str) read)) +;; TODO place this in a proper module +(define (bindings-for module-name) + ;; Wrapping list so we can later export sub-modules. + (list (cons module-name + (module-map (lambda (a . _) a) + (resolve-interface module-name))))) + ;; Evaluates the given expression in a sandbox. ;; NOTE Should maybe be merged inte prepare-query. The argument against is that ;; eval-in-sandbox is possibly slow, and that would prevent easy caching by the @@ -65,7 +72,7 @@ `( ((vcomponent base) prop param children type) ((ice-9 regex) string-match) - ;; TODO datetime + ,@(bindings-for '(datetime)) ,@all-pure-bindings) ))) -- cgit v1.2.3 From 8cced0532ab69a2346654540a4d01bc64392c359 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 15 Oct 2020 00:30:15 +0200 Subject: Fix error propagation for some search queries. --- module/vcomponent/search.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'module') diff --git a/module/vcomponent/search.scm b/module/vcomponent/search.scm index fef0b100..27483720 100644 --- a/module/vcomponent/search.scm +++ b/module/vcomponent/search.scm @@ -162,8 +162,11 @@ (set-max-page! paginator (max page (get-max-page paginator))) result)))) (lambda (err proc fmt args data) - ;; TODO ensure the error actually is index out of range. - ;; (format (current-error-port) "~?~%" fmt args) + ;; NOTE This is mostly a hack to see that we + ;; actually check for the correct error. + (unless (string=? fmt "beyond end of stream") + (scm-error err proc fmt args data)) + (set-max-page! paginator (get-max-page paginator)) (set-true-max-page! paginator) (throw 'max-page (get-max-page paginator)) -- cgit v1.2.3 From 5635b5993744731f9456c671490a4702c45cd5d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 15 Oct 2020 00:31:51 +0200 Subject: Add rudementary server logging. --- module/web/http/make-routes.scm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'module') diff --git a/module/web/http/make-routes.scm b/module/web/http/make-routes.scm index ab5f88a7..4fb5397a 100644 --- a/module/web/http/make-routes.scm +++ b/module/web/http/make-routes.scm @@ -71,6 +71,8 @@ (r:port ((@ (web request) request-port) request))) (let ((r:scheme ((@ (web uri) uri-scheme) r:uri)) (r:userinfo ((@ (web uri) uri-userinfo) r:uri)) + ;; TODO can sometimes be a pair of host and port + ;; '("localhost" . 8080). It shouldn't... (r:host (or ((@ (web uri) uri-host) r:uri) ((@ (web request) request-host) request))) @@ -80,6 +82,11 @@ (r:path ((@ (web uri) uri-path) r:uri)) (r:query ((@ (web uri) uri-query) r:uri)) (r:fragment ((@ (web uri) uri-fragment) r:uri))) + ;; TODO propper logging + (display (format #f "[~a] ~a ~a/~a?~a~%" + (datetime->string (current-datetime)) + r:method r:host r:path (or r:query "")) + (current-error-port)) (call-with-values (lambda () ((@ (ice-9 control) call/ec) -- cgit v1.2.3 From 5986d8022fe2a58df6bc7054ef9499961fb776b1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 16 Oct 2020 21:42:41 +0200 Subject: HTML add toggle for whole-day. --- module/vcomponent/xcal/parse.scm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'module') diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/xcal/parse.scm index 17c684fc..c97bc492 100644 --- a/module/vcomponent/xcal/parse.scm +++ b/module/vcomponent/xcal/parse.scm @@ -25,7 +25,10 @@ ;; TODO possibly trim whitespace on text fields [(cal-address uri text unknown) (car value)] - [(date) (parse-iso-date (car value))] + [(date) + ;; TODO this is correct, but ensure remaining types + (hashq-set! props 'VALUE "DATE") + (parse-iso-date (car value))] [(date-time) (parse-iso-datetime (car value))] @@ -108,6 +111,12 @@ data '(AUDIO DISPLAY EMAIL NONE))) [else data])) +;; Note +;; This doesn't verify the inter-field validity of the object, +;; meaning that value(DTSTART) == DATE and value(DTEND) == DATE-TIME +;; are possibilities, which other parts of the code will crash on. +;; TODO +;; since we are feeding user input into this it really should be fixed. (define-public (sxcal->vcomponent sxcal) (define type (symbol-upcase (car sxcal))) (define component (make-vcomponent type)) -- cgit v1.2.3 From 81740400f9bcf10a384f3f143a02b3bdeba0c2fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 16 Oct 2020 23:09:11 +0200 Subject: s/inline-edit/input-list/ --- module/calp/html/vcomponent.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 7414654b..cf8f3a9d 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -203,7 +203,7 @@ ,@(with-label "Kategorier" - `(div (@ (class "inline-edit")) + `(div (@ (class "input-list")) ,@(awhen (prop ev 'CATEGORIES) (map (lambda (c) `(input (@ (size 2) -- cgit v1.2.3 From 28c560c4c11f51b2dfffc77a286ad03057e4a13b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 23 Oct 2020 00:14:17 +0200 Subject: Work on generalizing multi-input lists. --- module/calp/html/vcomponent.scm | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index cf8f3a9d..208b66f7 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -207,27 +207,28 @@ ,@(awhen (prop ev 'CATEGORIES) (map (lambda (c) `(input (@ (size 2) + (class "unit") (value ,c)))) it)) - (input (@ (class "final") + (input (@ (class "unit final") (size 2) (type "text") )))) - ;; TODO extra fields - (hr) - (div (@ (class "newfield")) - (input (@ (type "text") - (list "known-fields") - (placeholder "Nytt fält"))) - (select (@ (name "TYPE")) - (option (@ (value "TEXT")) "Text")) - (span + ;; For custom user fields + (div (@ (class "input-list")) + (div (@ (class "unit final newfield")) (input (@ (type "text") - (placeholder "Värde"))))) + (list "known-fields") + (placeholder "Nytt fält"))) + (select (@ (name "TYPE")) + (option (@ (value "TEXT")) "Text")) + (span + (input (@ (type "text") + (placeholder "Värde")))))) (hr) -- cgit v1.2.3 From ffca898a875caa66156b8525d517b87c9b9f5327 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 26 Oct 2020 18:14:42 +0100 Subject: Cleanup and move input_list to own file. --- module/calp/html/view/calendar.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'module') diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index abf43118..0e90e5d4 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -106,6 +106,7 @@ (script (@ (defer) (src "/static/types.js"))) (script (@ (defer) (src "/static/lib.js"))) + (script (@ (defer) (src "/static/input_list.js"))) (script (@ (defer) (src "/static/script.js"))) ,(calendar-styles calendars)) -- cgit v1.2.3 From 2ee958354c18d91a8bd44028042bb4a4a10c423a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 26 Oct 2020 20:30:22 +0100 Subject: HTML Prettyify code for following tags. --- module/calp/html/vcomponent.scm | 11 ++++++++--- module/calp/util/config.scm | 4 ---- module/vcomponent/search.scm | 2 +- 3 files changed, 9 insertions(+), 8 deletions(-) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 208b66f7..6b9a48e9 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -5,6 +5,7 @@ :use-module (srfi srfi-41) :use-module (datetime) :use-module ((text util) :select (add-enumeration-punctuation)) + :use-module ((web uri-query) :select (encode-query-parameters)) :use-module (calp html util) :use-module ((calp html config) :select (edit-mode)) :use-module ((calp html components) :select (btn tabset form with-label)) @@ -117,9 +118,13 @@ ,@(map (lambda (c) `(a (@ (class "category") ;; TODO centralize search terms - ;; TODO propper stringifycation of sexp - (href ,(format #f "/search/?q=%28member+%22~a%22%0D%0A++%28or+%28prop+event+%27CATEGORIES%29+%27%28%29%29%0D%0A" - c))) + (href + "/search/?" + ,(encode-query-parameters + `((q . (member + ,(->quoted-string c) + (or (prop event 'CATEGORIES) + '()))))))) ,c)) it))) diff --git a/module/calp/util/config.scm b/module/calp/util/config.scm index 32dabb69..fbe35d59 100644 --- a/module/calp/util/config.scm +++ b/module/calp/util/config.scm @@ -106,10 +106,6 @@ (export format-procedure) -(define (->str any) - (with-output-to-string - (lambda () (display any)))) - (define-public (get-configuration-documentation) (define groups (group-by (compose source-module car) diff --git a/module/vcomponent/search.scm b/module/vcomponent/search.scm index 27483720..39a3847a 100644 --- a/module/vcomponent/search.scm +++ b/module/vcomponent/search.scm @@ -70,7 +70,7 @@ (eval `(lambda (event) ,@expressions) (make-sandbox-module `( - ((vcomponent base) prop param children type) + ((vcomponent base) prop param children type parent) ((ice-9 regex) string-match) ,@(bindings-for '(datetime)) ,@all-pure-bindings) -- cgit v1.2.3 From 7a82321d5b3dcceab12d62aa9c78e3618cff4f94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 5 Nov 2020 23:25:43 +0100 Subject: Change recovery on unexpected ',' in TEXT field. --- module/vcomponent/ical/parse.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'module') diff --git a/module/vcomponent/ical/parse.scm b/module/vcomponent/ical/parse.scm index 9c555bca..8499d289 100644 --- a/module/vcomponent/ical/parse.scm +++ b/module/vcomponent/ical/parse.scm @@ -135,7 +135,7 @@ (let ((v ((get-parser 'TEXT) params value))) (unless (= 1 (length v)) (warning "List in non-list field: ~s" v)) - (car v)))] + (string-join v ",")))] ;; TEXT, but allow a list [(memv key '(CATEGORIES RESOURCES)) -- cgit v1.2.3 From bded975370dc24734af8e820aca416162de7a92c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 5 Nov 2020 23:35:36 +0100 Subject: CATEGORIES (and RESOURCES) join list ical on output. --- module/vcomponent/ical/output.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'module') diff --git a/module/vcomponent/ical/output.scm b/module/vcomponent/ical/output.scm index a0816679..bcc6bb1d 100644 --- a/module/vcomponent/ical/output.scm +++ b/module/vcomponent/ical/output.scm @@ -44,12 +44,16 @@ [(memv key '(FREEBUSY)) (get-writer 'PERIOD)] + [(memv key '(CATEGORIES RESOURCES)) + (lambda (p v) + (string-join (map (lambda (v) ((get-writer 'TEXT) p v)) + v) + ","))] + [(memv key '(CALSCALE METHOD PRODID COMMENT DESCRIPTION LOCATION SUMMARY TZID TZNAME CONTACT RELATED-TO UID - CATEGORIES RESOURCES - VERSION)) (get-writer 'TEXT)] -- cgit v1.2.3 From e469bf6c2b219f7acd08e93adf7e0244b6b3c2c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 5 Nov 2020 23:43:35 +0100 Subject: Xcal input split CATEGORIES. --- module/vcomponent/xcal/parse.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'module') diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/xcal/parse.scm index c97bc492..6b877b9f 100644 --- a/module/vcomponent/xcal/parse.scm +++ b/module/vcomponent/xcal/parse.scm @@ -156,7 +156,11 @@ (set! (prop* component tag*) (make-vline tag* (handle-tag - tag (handle-value type params value)) + tag (let ((v (handle-value type params value))) + ;; TODO possibly more list fields + (if (eq? tag 'categories) + (string-split v #\,) + v))) params)))))]))) ;; children -- cgit v1.2.3 From 25eda56e1bccf772c333ee1f649f2627a197cee7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 5 Nov 2020 23:43:56 +0100 Subject: Bound CATEGORIES input. --- module/calp/html/vcomponent.scm | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 6b9a48e9..a32899b1 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -208,7 +208,14 @@ ,@(with-label "Kategorier" - `(div (@ (class "input-list")) + ;; It would be better if these input-list's worked on the same + ;; class=bind system as the fields above. The problem with that + ;; is however that each input-list requires different search + ;; and join procedures. Currently this is bound in the JS, see + ;; [CATEGORIES_BIND]. + ;; It matches on ".input-list[data-property='categories']". + `(div (@ (class "input-list") + (data-property "categories")) ,@(awhen (prop ev 'CATEGORIES) (map (lambda (c) `(input (@ (size 2) -- cgit v1.2.3 From 3ce851f22bf5a13366e7496971602dff00ca0f01 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 5 Nov 2020 23:45:33 +0100 Subject: Add comment about freeform fields. --- module/calp/html/vcomponent.scm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'module') diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index a32899b1..fbf344b0 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -231,6 +231,11 @@ (hr) ;; For custom user fields + ;; TODO these are currently not bound to anything, so entering data + ;; here does nothing. Bigest hurdle to overcome is supporting arbitrary + ;; fields which will come and go in the JavaScript. + ;; TODO also, all (most? maybe not LAST-MODIFIED) remaining properties + ;; should be exposed here. (div (@ (class "input-list")) (div (@ (class "unit final newfield")) (input (@ (type "text") -- cgit v1.2.3