aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-04-27 17:06:31 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-04-27 17:06:31 +0200
commit3f2ad7c6a7ff95693c0cf64f72ed95bb6adb3521 (patch)
tree275075cf53c975163540363b608b6fb674489883
parentChange scroll behaviour in popups. (diff)
downloadcalp-3f2ad7c6a7ff95693c0cf64f72ed95bb6adb3521.tar.gz
calp-3f2ad7c6a7ff95693c0cf64f72ed95bb6adb3521.tar.xz
Minor updates.
-rw-r--r--TODO3
-rw-r--r--module/output/html.scm135
-rw-r--r--static/style.css5
-rwxr-xr-xtests/run-tests.scm10
4 files changed, 82 insertions, 71 deletions
diff --git a/TODO b/TODO
index c0d8f5a1..b98964e1 100644
--- a/TODO
+++ b/TODO
@@ -44,9 +44,6 @@ Handle systems with bad `cal' programs
HTML
====
-Popups i månadsvy
------------------
-
Placering av popups
-------------------
diff --git a/module/output/html.scm b/module/output/html.scm
index 1a60549a..45666ae8 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -393,11 +393,15 @@
(match-lambda* [(start end) `(div ,start " — " ,end)]
[(start) `(div ,start)]))
,(when (and=> (attr ev 'LOCATION) (negate string-null?))
- `(div (b "Plats: ") (div (@ (class "location")),(string-map (lambda (c) (if (char=? c #\,) #\newline c)) (attr ev 'LOCATION)))))
- ,(and=> (attr ev 'DESCRIPTION) (lambda (str) (catch #t (lambda () ((get-config 'description-filter) ev str))
- (lambda (err . args)
- (warning "~a on formatting description, ~s" err args)
- str))))
+ `(div (b "Plats: ")
+ (div (@ (class "location"))
+ ,(string-map (lambda (c) (if (char=? c #\,) #\newline c))
+ (attr ev 'LOCATION)))))
+ ,(and=> (attr ev 'DESCRIPTION)
+ (lambda (str) (catch #t (lambda () ((get-config 'description-filter) ev str))
+ (lambda (err . args)
+ (warning "~a on formatting description, ~s" err args)
+ str))))
,(awhen (attr ev 'RRULE)
(format-recurrence-rule ev))
,(when (attr ev 'LAST-MODIFIED)
@@ -517,9 +521,11 @@
next-start
prev-start)
(define (td date)
+ ;; TODO make entrire cell clickable
`(td (@ (class
,(when (date< date start-date) "prev ")
,(when (date< end-date date) "next "))
+ ;; TODO <time> tag here instead
(id ,(date->string date "td-~Y-~m-~d"))
)
(a (@ (href ,(cond
@@ -676,64 +682,67 @@
(details (@ (open) (style "grid-area: cal"))
(summary "Month overwiew")
(div (@ (class "smallcall-head")) ,(string-titlecase (date->string start-date "~B ~Y")))
- (div (@ (class "smallcal"))
- ;; prev button
- ,(nav-link "«" (prev-start start-date))
-
- ;; calendar table
- ;; TODO
- (div ,(cal-table start-date: start-date end-date: end-date
- next-start: next-start
- prev-start: prev-start
- ))
-
- ;; next button
- ,(nav-link "»" (next-start start-date))))
-
-
- (div (@ (style "grid-area: details"))
- ;; TODO only include these sliders in debug builds
- (details (@ (class "sliders"))
- (summary "Option sliders")
- (label "Event blankspace")
- ,(slider-input
- variable: "editmode"
- min: 0
- max: 1
- step: 0.01
- value: 1)
-
- (label "Fontsize")
- ,(slider-input
- unit: "pt"
- min: 1
- max: 20
- step: 1
- value: 8
- variable: "event-font-size"))
-
- ;; List of calendars
- (details (@ (class "calendarlist")
- #; (style "grid-area: details")
- )
- (summary "Calendar list")
- (ul ,@(map (lambda (calendar)
- `(li (@ (class "CAL_bg_" ,(html-attr (attr calendar 'NAME))))
- ,(attr calendar 'NAME)))
- calendars))))
-
- ;; List of events
- (div (@ (class "eventlist")
- (style "grid-area: events"))
- ;; Events which started before our start point, but "spill" into our time span.
- (section (@ (class "text-day"))
- (header (h2 "Tidigare"))
- ,@(stream->list
- (stream-map fmt-single-event
- (stream-take-while (compose (cut date/-time<? <> start-date)
- (extract 'DTSTART))
- (cdr (stream-car evs))))))
- ,@(stream->list (stream-map fmt-day evs))))))))
+ ;; NOTE it might be a good idea to put the navigation buttons
+ ;; earlier in the DOM-tree/tag order. At least Vimium's
+ ;; @key{[[} keybind sometimes finds parts of events instead.
+ (div (@ (class "smallcal"))
+ ;; prev button
+ ,(nav-link "«" (prev-start start-date))
+
+ ;; calendar table
+ ;; TODO
+ (div ,(cal-table start-date: start-date end-date: end-date
+ next-start: next-start
+ prev-start: prev-start
+ ))
+
+ ;; next button
+ ,(nav-link "»" (next-start start-date))))
+
+
+ (div (@ (style "grid-area: details"))
+ ;; TODO only include these sliders in debug builds
+ (details (@ (class "sliders"))
+ (summary "Option sliders")
+ (label "Event blankspace")
+ ,(slider-input
+ variable: "editmode"
+ min: 0
+ max: 1
+ step: 0.01
+ value: 1)
+
+ (label "Fontsize")
+ ,(slider-input
+ unit: "pt"
+ min: 1
+ max: 20
+ step: 1
+ value: 8
+ variable: "event-font-size"))
+
+ ;; List of calendars
+ (details (@ (class "calendarlist")
+ #; (style "grid-area: details")
+ )
+ (summary "Calendar list")
+ (ul ,@(map (lambda (calendar)
+ `(li (@ (class "CAL_bg_" ,(html-attr (attr calendar 'NAME))))
+ ,(attr calendar 'NAME)))
+ calendars))))
+
+ ;; List of events
+ (div (@ (class "eventlist")
+ (style "grid-area: events"))
+ ;; Events which started before our start point, but "spill" into our time span.
+ (section (@ (class "text-day"))
+ (header (h2 "Tidigare"))
+ ,@(stream->list
+ (stream-map fmt-single-event
+ (stream-take-while (compose (cut date/-time<? <> start-date)
+ (extract 'DTSTART))
+ (cdr (stream-car evs))))))
+ ,@(stream->list (stream-map fmt-day evs))))))))
(define-public (html-chunked-main count calendars events start-date chunk-length)
diff --git a/static/style.css b/static/style.css
index 2cfa5f8a..fb2759df 100644
--- a/static/style.css
+++ b/static/style.css
@@ -615,6 +615,11 @@ along with their colors.
overflow-y: auto;
}
+.event-inner .popup .location {
+ font-style: initial;
+ /* font-size: initial; */
+}
+
.popup .popup-control {
display: flex;
flex-direction: column;
diff --git a/tests/run-tests.scm b/tests/run-tests.scm
index ded94cc5..e01fcb0b 100755
--- a/tests/run-tests.scm
+++ b/tests/run-tests.scm
@@ -33,11 +33,11 @@
;; Load tests
(define (read-multiple)
-(let loop ((done '()))
- (let ((sexp (read)))
- (if (eof-object? sexp)
- (reverse done)
- (loop (cons sexp done))))))
+ (let loop ((done '()))
+ (let ((sexp (read)))
+ (if (eof-object? sexp)
+ (reverse done)
+ (loop (cons sexp done))))))
;; TODO test-group fails if called before any test begin, since