diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-12 21:09:35 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-13 04:11:35 +0200 |
commit | 73a4bfc3d8e9bb5365e33a11a6ad3b8340d5195b (patch) | |
tree | e52324edc63a240e5c0b88081c325f789168a4c5 /module/calp/html | |
parent | Document timespec and zic. (diff) | |
download | calp-73a4bfc3d8e9bb5365e33a11a6ad3b8340d5195b.tar.gz calp-73a4bfc3d8e9bb5365e33a11a6ad3b8340d5195b.tar.xz |
Remove custom let*.
While it was nice, the most important part was the multi-valued let from
srfi-71 (which is implemented in srfi-71)). The minor pattern matching
structures could often be replaced with car+cdr, or a propper match.
Diffstat (limited to 'module/calp/html')
-rw-r--r-- | module/calp/html/vcomponent.scm | 11 | ||||
-rw-r--r-- | module/calp/html/view/calendar.scm | 1 | ||||
-rw-r--r-- | module/calp/html/view/calendar/month.scm | 19 | ||||
-rw-r--r-- | module/calp/html/view/calendar/week.scm | 3 |
4 files changed, 19 insertions, 15 deletions
diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 9e70f910..27a1f994 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -229,7 +229,8 @@ ;; Single event in side bar (text objects) (define-public (fmt-day day) - (let* (((date . events) day)) + (let ((date (car day)) + (events (cdr day))) `(section (@ (class "text-day")) (header (h2 ,(let ((s (date->string date ;; Header for sidebar day @@ -265,10 +266,10 @@ `(style ,(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))) + (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))))) diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index dd94dc16..a6ebdfba 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -22,6 +22,7 @@ :use-module (srfi srfi-26) :use-module (srfi srfi-41) :use-module (srfi srfi-41 util) + :use-module (srfi srfi-71) :use-module ((vcomponent recurrence) :select (repeating? generate-recurrence-set)) :use-module ((vcomponent util group) diff --git a/module/calp/html/view/calendar/month.scm b/module/calp/html/view/calendar/month.scm index 205d6049..1c162aaa 100644 --- a/module/calp/html/view/calendar/month.scm +++ b/module/calp/html/view/calendar/month.scm @@ -7,6 +7,7 @@ :use-module (calp html view calendar shared) :use-module (calp html config) :use-module (vcomponent) + :use-module (ice-9 match) :use-module ((vcomponent datetime) :select (really-long-event? events-between)) @@ -47,15 +48,15 @@ long-event-groups)))) ,@(map (lambda (d) `(div (@ (class "thead")) ,(string-titlecase (week-day-name d)))) (weekday-list)) - ,@(map (lambda (group i) - (let* (((s e . events) group)) - `(div (@ (class "cal-cell longevents event-container") - (style "grid-area: long " ,i ";" - "grid-column: 1 / span 7;") - (data-start ,(date->string s)) - (data-end ,(date->string (add-day e)))) - ,@(lay-out-long-events - s e events)))) + ,@(map (match-lambda* + (((s e events ...) i) + `(div (@ (class "cal-cell longevents event-container") + (style "grid-area: long " ,i ";" + "grid-column: 1 / span 7;") + (data-start ,(date->string s)) + (data-end ,(date->string (add-day e)))) + ,@(lay-out-long-events + s e events)))) long-event-groups (iota (length long-event-groups) 1)) diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm index b68184f9..ed3f00ec 100644 --- a/module/calp/html/view/calendar/week.scm +++ b/module/calp/html/view/calendar/week.scm @@ -2,6 +2,7 @@ :use-module (hnh util) :use-module (srfi srfi-1) :use-module (srfi srfi-41) + :use-module (srfi srfi-71) :use-module (rnrs records syntactic) :use-module (datetime) :use-module (calp html view calendar shared) @@ -122,7 +123,7 @@ ;; Lay out complete day (graphical) ;; (date . (events)) -> sxml (define (lay-out-day day) - (let* (((day-date . events) day) + (let* ((day-date events (car+cdr day)) (time-obj (datetime date: day-date)) (short-events (stream->list events)) #; |