aboutsummaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
Diffstat (limited to 'module')
-rw-r--r--module/calp/entry-points/server.scm2
-rw-r--r--module/calp/html/vcomponent.scm24
-rw-r--r--module/calp/html/view/calendar.scm5
-rw-r--r--module/calp/server/routes.scm11
-rw-r--r--module/datetime.scm37
-rw-r--r--module/vcomponent/control.scm1
-rw-r--r--module/vcomponent/datetime.scm7
-rw-r--r--module/vcomponent/recurrence/internal.scm4
-rw-r--r--module/vcomponent/recurrence/parse.scm2
-rw-r--r--module/vcomponent/xcal/parse.scm11
10 files changed, 75 insertions, 29 deletions
diff --git a/module/calp/entry-points/server.scm b/module/calp/entry-points/server.scm
index 55f84c1a..a456c292 100644
--- a/module/calp/entry-points/server.scm
+++ b/module/calp/entry-points/server.scm
@@ -78,7 +78,7 @@
(catch 'system-error
(lambda ()
- (start-server `(family: ,family port: ,port host: ,addr)))
+ (start-server (list family: family port: port host: addr)))
;; probably address already in use
(lambda (err proc fmt args errno)
diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm
index 5d10c996..cd8c207e 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 ((web uri-query) :select (encode-query-parameters))
:use-module (calp html util)
- :use-module ((calp html config) :select (edit-mode))
+ :use-module ((calp html config) :select (edit-mode debug))
:use-module ((calp html components) :select (btn tabset form with-label))
:use-module ((calp util color) :select (calculate-fg-color))
:use-module ((vcomponent recurrence internal) :prefix #{rrule:}#)
@@ -371,6 +371,10 @@
(define (editable-repeat-info event)
`(div (@ (class "eventtext"))
(h2 "Upprepningar")
+ ,@(when (debug)
+ '((button (@ (style "position:absolute;right:1ex;top:1ex")
+ (onclick "console.log(event_from_popup(this.closest('.popup-container')).properties.rrule.asJcal());"))
+ "js")))
(table (@ (class "recur-components bind")
(name "rrule")
(data-bindby "bind_recur"))
@@ -531,10 +535,10 @@
(list
(btn "🖊️"
title: "Redigera"
- onclick: "place_in_edit_mode(document.getElementById(this.closest('.popup-container').id.substr(5)))")
+ onclick: "place_in_edit_mode(event_from_popup(this.closest('.popup-container')))")
(btn "🗑"
title: "Ta bort"
- onclick: "remove_event(document.getElementById(this.closest('.popup-container').id.substr(5)))"))))
+ onclick: "remove_event(event_from_popup(this.closest('.popup-container')))"))))
,(tabset
`(("📅" title: "Översikt"
@@ -546,10 +550,16 @@
("⤓" 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")))))
+ (div (@ (class "side-by-side"))
+ (ul (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".ics"))
+ "som iCal"))
+ (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".xcs"))
+ "som xCal")))
+ ,@(when (debug)
+ `((ul
+ (li (button (@ (onclick "console.log(event_to_jcal(event_from_popup(this.closest('.popup-container'))));")) "js"))
+ (li (button (@ (onclick "console.log(jcal_to_xcal(event_to_jcal(event_from_popup(this.closest('.popup-container')))));")) "xml"))))))
+ ))
,@(when (prop ev 'RRULE)
`(("↺" title: "Upprepningar" class: "repeating"
diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm
index d41197b0..3f607bb7 100644
--- a/module/calp/html/view/calendar.scm
+++ b/module/calp/html/view/calendar.scm
@@ -39,7 +39,7 @@
;;; All this filtering is probably slow, and should be looked into.
;; TODO place this somewhere proper
-(define repo-url (make-parameter "https://git.hornquist.se"))
+(define repo-url (make-parameter "https://git.hornquist.se/calp"))
;; TODO document what @var{render-calendar} is supposed to take and return.
@@ -106,6 +106,7 @@
(script (@ (defer) (src "/static/types.js")))
(script (@ (defer) (src "/static/lib.js")))
+ (script (@ (defer) (src "/static/jcal.js")))
(script (@ (defer) (src "/static/dragable.js")))
(script (@ (defer) (src "/static/clock.js")))
(script (@ (defer) (src "/static/popup.js")))
@@ -141,7 +142,7 @@
(footer
(@ (style "grid-area: footer"))
(span "Page generated " ,(date->string (current-date)))
- (span (a (@ (href ,(repo-url) "/calparse"))
+ (span (a (@ (href ,(repo-url)))
"Source Code")))
;; Small calendar and navigation
diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm
index 276513f5..368c7cb0 100644
--- a/module/calp/server/routes.scm
+++ b/module/calp/server/routes.scm
@@ -85,9 +85,13 @@
(make-routes
;; Manual redirect to not reserve root.
+ ;; Also reason for really ugly frontend redirect.
(GET "/" ()
(return '((content-type text/html))
- (sxml->html-string '(a (@ (href "/today")) "Gå till idag"))))
+ (sxml->html-string
+ '(body (a (@ (href "/today")) "Gå till idag")
+ (script "window.onload = function() {
+ document.getElementsByTagName('a')[0].click();}")))))
(GET "/favicon.ico" ()
(return
@@ -185,6 +189,8 @@
;; (vcalendar
;; (vevent ...))))
;; @end example
+
+ ;; TODO
;; However, *PI* will probably be omited, and currently events
;; are sent without the vcalendar part. Earlier versions
;; Also omitted the icalendar part. And I'm not sure if the
@@ -197,7 +203,8 @@
(move-to-namespace
;; TODO Multiple event components
(car ((sxpath '(// IC:vevent))
- (xml->sxml data namespaces: '((IC . "urn:ietf:params:xml:ns:icalendar-2.0")))))
+ (xml->sxml data namespaces:
+ '((IC . "urn:ietf:params:xml:ns:icalendar-2.0")))))
#f))
(lambda (err port . args)
(return (build-response code: 400)
diff --git a/module/datetime.scm b/module/datetime.scm
index cb732ad3..9abd1307 100644
--- a/module/datetime.scm
+++ b/module/datetime.scm
@@ -37,13 +37,13 @@
(dec december ) 12)
(define-many define-public
- (sun) 0
- (mon) 1
- (tue) 2
- (wed) 3
- (thu) 4
- (fri) 5
- (sat) 6)
+ (sun sunday) 0
+ (mon monday) 1
+ (tue tuesday) 2
+ (wed wednesday) 3
+ (thu thursday) 4
+ (fri friday) 5
+ (sat saturday) 6)
;;; Configuration
@@ -717,6 +717,16 @@
(define*-public (string->date str optional: (fmt "~Y-~m-~d"))
(get-date (string->datetime str fmt)))
+;; Parse @var{string} as either a date, time, or date-time.
+;; String MUST be on iso-8601 format.
+(define-public (string->date/-time string)
+ (define (contains symb)
+ (lambda (string) (string-contains string symb)))
+
+ (cond [string (contains "T") => string->datetime]
+ [string (contains ":") => string->time]
+ [string (contains "-") => string->date]))
+
(define-public (parse-ics-date str)
(string->date str "~Y~m~d"))
@@ -757,15 +767,14 @@
time: ,(if verbose (time->sexp (get-time% dt)) (get-time% dt))
tz: ,(tz dt)))
+
(define (date-reader chr port)
+ (define (dt->sexp dt) (datetime->sexp dt #t) )
(unread-char chr port)
- (let ((line (symbol->string (read port))))
- (cond [(string-contains line "T")
- (-> line string->datetime (datetime->sexp #t))]
- [(string-contains line ":")
- (-> line string->time time->sexp)]
- [(string-contains line "-")
- (-> line string->date date->sexp)])))
+ (let ((data (string->date/-time (symbol->string (read port)))))
+ (cond [data datetime? => dt->sexp]
+ [data time? => time->sexp]
+ [data date? => date->sexp])))
(read-hash-extend #\0 date-reader)
(read-hash-extend #\1 date-reader)
diff --git a/module/vcomponent/control.scm b/module/vcomponent/control.scm
index add48c28..5fe5b8b0 100644
--- a/module/vcomponent/control.scm
+++ b/module/vcomponent/control.scm
@@ -22,6 +22,7 @@
(set! (prop component key) val))))
keys)))
+;; TODO what is this even used for?
(define-syntax with-replaced-properties
(syntax-rules ()
[(_ (component (key val) ...)
diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm
index 887ae48b..ca4f90e9 100644
--- a/module/vcomponent/datetime.scm
+++ b/module/vcomponent/datetime.scm
@@ -68,6 +68,13 @@ Event must have the DTSTART and DTEND protperty set."
date-difference datetime-difference)
(prop e 'DTEND) (prop e 'DTSTART))))
+;;
+;; |-----| extent of event
+;; |-----| time we are interested in,
+;; defined through @var{start-date} and @var{end-date}
+;; |X| part of event within that time (X)
+;;
+;; Returns the length of the interval (X).
(define-public (event-length/clamped start-date end-date e)
(let ((end (or (prop e 'DTEND)
(if (date? (prop e 'DTSTART))
diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm
index 8e84a8b6..1b9dd405 100644
--- a/module/vcomponent/recurrence/internal.scm
+++ b/module/vcomponent/recurrence/internal.scm
@@ -51,6 +51,10 @@
freq until count interval bysecond byminute byhour
byday bymonthday byyearday byweekno bymonth bysetpos
wkst)
+ ;; TODO possibly validate fields here
+ ;; to prevent creation of invalid rules.
+ ;; This was made apparent when wkst was (incorrectly) set to MO,
+ ;; which later crashed generate-recurrence-set.
(make-recur-rule% freq until count interval bysecond byminute byhour
byday bymonthday byyearday byweekno bymonth bysetpos
wkst))
diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm
index b48e88e5..ba2a5583 100644
--- a/module/vcomponent/recurrence/parse.scm
+++ b/module/vcomponent/recurrence/parse.scm
@@ -13,7 +13,7 @@
;; transform into weekday objects from
-(define (rfc->datetime-weekday symbol)
+(define-public (rfc->datetime-weekday symbol)
(case symbol
[(SU) sun]
[(MO) mon]
diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/xcal/parse.scm
index 6b877b9f..6ae8c2f9 100644
--- a/module/vcomponent/xcal/parse.scm
+++ b/module/vcomponent/xcal/parse.scm
@@ -50,8 +50,15 @@
[(recur)
(apply (@ (vcomponent recurrence internal) make-recur-rule)
- (for (k v) in value
- (list (symbol->keyword k) v)))]
+ (concatenate
+ (for (k v) in value
+ (list (symbol->keyword k)
+ (case k
+ ((wkst)
+ ((@ (vcomponent recurrence parse)
+ rfc->datetime-weekday)
+ (string->symbol v)))
+ (else v))))))]
[(time) (parse-iso-time (car value))]
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-29 02:00:09 +0200