aboutsummaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-04-01 21:01:17 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-04-01 21:01:17 +0200
commit6c37a4c00cd420e50d0cd2ad088268bcbb3d9155 (patch)
treef5c0052c1cfa1c2a9019f83f7d93d04418379d7a /module
parentAdd set-config! and get-config, along with print for debug. (diff)
downloadcalp-6c37a4c00cd420e50d0cd2ad088268bcbb3d9155.tar.gz
calp-6c37a4c00cd420e50d0cd2ad088268bcbb3d9155.tar.xz
Update remaining code to use new config scheme.
Diffstat (limited to 'module')
-rw-r--r--module/datetime/util.scm5
-rw-r--r--module/entry-points/benchmark.scm5
-rw-r--r--module/entry-points/html.scm9
-rw-r--r--module/entry-points/ical.scm5
-rw-r--r--module/entry-points/server.scm28
-rw-r--r--module/entry-points/terminal.scm6
-rwxr-xr-xmodule/main.scm3
-rw-r--r--module/output/html.scm26
-rw-r--r--module/output/terminal.scm57
-rw-r--r--module/util/config/all.scm3
-rw-r--r--module/vcomponent/load.scm7
11 files changed, 71 insertions, 83 deletions
diff --git a/module/datetime/util.scm b/module/datetime/util.scm
index c567d44f..7f085bbf 100644
--- a/module/datetime/util.scm
+++ b/module/datetime/util.scm
@@ -352,7 +352,6 @@
(* (1- date-diff) 24))))
-(register-config!
- week-start
- sun
+(define-config week-start sun
+ "First day of week"
(ensure (lambda (x) (<= sun x sat))))
diff --git a/module/entry-points/benchmark.scm b/module/entry-points/benchmark.scm
index a21b4630..4843a80a 100644
--- a/module/entry-points/benchmark.scm
+++ b/module/entry-points/benchmark.scm
@@ -4,7 +4,6 @@
:use-module (ice-9 getopt-long)
:use-module (util)
:use-module (vcomponent)
- :use-module (util config all)
)
@@ -14,5 +13,5 @@
(define (main args)
(define opts (getopt-long args opt-spec))
- (load-calendars* calendar-files: (cond [(option-ref opts 'file #f) => list]
- [else (calendar-files)])))
+ (cond [(option-ref opts 'file #f) => (compose load-calendars* list)]
+ [else (load-calendars)]))
diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm
index bacc8038..34ecc2dd 100644
--- a/module/entry-points/html.scm
+++ b/module/entry-points/html.scm
@@ -7,8 +7,6 @@
:use-module (datetime)
:use-module (datetime util)
:use-module (ice-9 getopt-long)
-
- :use-module (util config all)
)
@@ -32,9 +30,8 @@
(define style (string->symbol (option-ref opts 'style "wide")))
(define-values (calendars events)
- (load-calendars
- calendar-files: (cond [(option-ref opts 'file #f) => list]
- [else (calendar-files)]) ))
+ (cond [(option-ref opts 'file #f) => (compose load-calendars list)]
+ [else (load-calendars)]))
(report-time! "Calendars loaded")
@@ -49,7 +46,7 @@
;; be a good idea to instead center it on the current week, meaning
;; that the active row is always in the center
(html-chunked-main count calendars events
- (previous-week-start start (week-start))
+ (previous-week-start start (get-config 'week-start))
(date day: 7))]
[(table)
(html-table-main count calendars events start)]
diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm
index e2ee7dcf..f2f4e0b5 100644
--- a/module/entry-points/ical.scm
+++ b/module/entry-points/ical.scm
@@ -3,7 +3,6 @@
:use-module (util)
:use-module (output ical)
:use-module ((vcomponent) :select (load-calendars*))
- :use-module ((util config all) :select (calendar-files))
:use-module (ice-9 getopt-long)
:use-module (datetime)
:use-module (datetime util)
@@ -26,8 +25,8 @@
;; TODO this contains repeated events multiple times
(define-values (calendars regular repeating)
- (load-calendars* calendar-files: (cond [(option-ref opts 'file #f) => list]
- [else (calendar-files)]) ))
+ (cond [(option-ref opts 'file #f) => (compose load-calendars* list)]
+ [else (load-calendars*)]))
(ical-main calendars regular repeating start end)
)
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
index e3ce168a..25b86735 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -2,7 +2,6 @@
:export (main)
:use-module (util)
:use-module (vcomponent)
- :use-module (util config all)
)
(use-modules* (web (server request response uri))
@@ -122,9 +121,8 @@
[else AF_INET6]))
(define-values (c e)
- (load-calendars
- calendar-files: (cond [(option-ref opts 'file #f) => list]
- [else (calendar-files)]) ))
+ (cond [(option-ref opts 'file #f) => (compose load-calendars list)]
+ [else (load-calendars)]))
@@ -134,19 +132,19 @@
;; placed after load-calendars to keep Guile 2.2 compability.
(set! addr
(if addr addr
- (if (eqv? family AF_INET6)
- "::" "0.0.0.0")))
+ (if (eqv? family AF_INET6)
+ "::" "0.0.0.0")))
;; NOTE The default make-default-socket is broken for IPv6.
;; A patch has been submitted to the mailing list. 2020-03-31
(module-set!
- (resolve-module '(web server http))
- 'make-default-socket
- (lambda (family addr port)
- (let ((sock (socket family SOCK_STREAM 0)))
- (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
- (bind sock family addr port)
- sock)))
+ (resolve-module '(web server http))
+ 'make-default-socket
+ (lambda (family addr port)
+ (let ((sock (socket family SOCK_STREAM 0)))
+ (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
+ (bind sock family addr port)
+ sock)))
;; TODO possibly test inet-pton here on address?
@@ -158,6 +156,6 @@
(run-server (make-make-routes c e)
'http
`(family: ,family
- port: ,port
- host: ,addr)
+ port: ,port
+ host: ,addr)
0))
diff --git a/module/entry-points/terminal.scm b/module/entry-points/terminal.scm
index 0f2a85f0..9f486d90 100644
--- a/module/entry-points/terminal.scm
+++ b/module/entry-points/terminal.scm
@@ -5,7 +5,6 @@
:use-module (ice-9 getopt-long)
:use-module (datetime)
:use-module (datetime util)
- :use-module (util config all)
:use-module (vulgar)
)
@@ -16,9 +15,8 @@
(define (main args)
(define opts (getopt-long args options))
(define-values (calendars events)
- (load-calendars
- calendar-files: (cond [(option-ref opts 'file #f) => list]
- [else (calendar-files)]) ))
+ (cond [(option-ref opts 'file #f) => (compose load-calendars list)]
+ [else (load-calendars)]))
(let ((date (or (and=> (option-ref opts 'date #f) parse-freeform-date)
(current-date))))
diff --git a/module/main.scm b/module/main.scm
index 011e5f63..4b47025a 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -29,7 +29,7 @@ exec guile -e main -s $0 "$@"
(statprof)
- (util config all))
+ )
(define options
'((statprof (value optional))
@@ -81,6 +81,7 @@ exec guile -e main -s $0 "$@"
(define (main args)
(report-time! "Program start")
+ ;; ((@ (util config) print-configuration-documentation))
(with-throw-handler #t
(lambda () (wrapped-main args))
(lambda (err . args)
diff --git a/module/output/html.scm b/module/output/html.scm
index 299dde3d..9cee3e26 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -21,14 +21,12 @@
;; #:use-module (module config all)
)
-(register-config!
- summary-filter
- (lambda (_ a) a)
+(define-config summary-filter (lambda (_ a) a)
+ ""
(ensure procedure?))
-(register-config!
- description-filter
- (lambda (_ a) a)
+(define-config description-filter (lambda (_ a) a)
+ ""
(ensure procedure?))
(define (date-link date)
@@ -161,7 +159,7 @@
(div (@ (class "popup"))
,(event-debug-html ev))
(div (@ (class "body"))
- ,((summary-filter) ev (attr ev 'SUMMARY))))))
+ ,((get-config 'summary-filter) ev (attr ev 'SUMMARY))))))
)
@@ -212,7 +210,7 @@
(div (@ (class "popup"))
,(event-debug-html ev))
(div (@ (class "body"))
- ,((summary-filter) ev (attr ev 'SUMMARY)))))))
+ ,((get-config 'summary-filter) ev (attr ev 'SUMMARY)))))))
;; Lay out complete day (graphical)
@@ -318,7 +316,7 @@
[(start) `(div ,start)]))
,(when (and=> (attr ev 'LOCATION) (negate string-null?))
`(div (b "Plats: ") ,(attr ev 'LOCATION)))
- ,(and=> (attr ev 'DESCRIPTION) (lambda (str) ((description-filter) ev str))))))
+ ,(and=> (attr ev 'DESCRIPTION) (lambda (str) ((get-config 'description-filter) ev str))))))
;; Single event in side bar (text objects)
(define (fmt-day day)
@@ -347,7 +345,7 @@
(div (@ (class "inline-event CAL_"
;; TODO centralize handling of unnamed calendars once again.
,(html-attr (or (attr (parent event) 'NAME) "unnamed"))))
- ,((summary-filter) event (attr event 'SUMMARY)))))
+ ,((get-config 'summary-filter) event (attr event 'SUMMARY)))))
;; (stream event-group) -> sxml
(define*-public (render-calendar-table key: events start-date end-date pre-start post-end #:allow-other-keys)
@@ -357,7 +355,7 @@
`(div (@ (class "caltable"))
,@(map (lambda (d) `(div (@ (class "thead")) ,(week-day-name d)))
- (weekday-list (week-start)))
+ (weekday-list (get-config 'week-start)))
,@(cons
;; First day is a special case, since I always want to show a full date there.
;; For all other days I'm only interested in the parts that change.
@@ -420,7 +418,7 @@
(define* (cal-table key:
start-date
end-date
- (week-start (week-start))
+ (week-start (get-config 'week-start))
next-start
prev-start)
(define (td date)
@@ -552,7 +550,7 @@
"View "
(a (@ (href "/week/" ,(date->string
(if (= 1 (day start-date))
- (start-of-week start-date (week-start))
+ (start-of-week start-date (get-config 'week-start))
start-date)
"~1")
".html"))
@@ -640,7 +638,7 @@
(lambda (start-of-month)
(let ((fname (format #f "./html/~a.html" (date->string start-of-month "~1"))))
(format (current-error-port) "Writing to [~a]~%" fname)
- (let* ((before current after (month-days start-of-month (week-start))))
+ (let* ((before current after (month-days start-of-month (get-config 'week-start))))
(with-output-to-file fname
;; TODO this produces incorrect next and prev links
;; TODO It actually produces almost all date links wrong
diff --git a/module/output/terminal.scm b/module/output/terminal.scm
index c344776f..e94d971d 100644
--- a/module/output/terminal.scm
+++ b/module/output/terminal.scm
@@ -36,34 +36,35 @@
(cur-event -1)
(summary-width 30)
(location-width 20))
- (for-each
- (lambda (ev i)
- (display
- (string-append
- (if (datetime? (attr ev 'DTSTART))
- (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S")
- ((@ (texinfo string-utils) center-string)
- (date->string (attr ev 'DTSTART))
- 19))
- ; TODO show truncated string
- " │ "
- (if (= i cur-event) "\x1b[7m" "")
- (color-escape (attr (parent ev) 'COLOR))
- ;; Summary filter is a hook for the user
- (let ((dirty (attr ev 'X-HNH-DIRTY)))
- (string-append
- (if dirty "* " "")
- (trim-to-width ((summary-filter) ev (attr ev 'SUMMARY)) (- summary-width
- (if dirty 2 0)))))
- STR-RESET
- " │ "
- (if (attr ev 'LOCATION) "" "\x1b[1;30m")
- (trim-to-width
- (or (attr ev 'LOCATION) "INGEN LOKAL") location-width)
- STR-RESET
- "\n")))
- events
- (iota (length events))))
+ (for-each
+ (lambda (ev i)
+ (display
+ (string-append
+ (if (datetime? (attr ev 'DTSTART))
+ (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S")
+ ((@ (texinfo string-utils) center-string)
+ (date->string (attr ev 'DTSTART))
+ 19))
+ ; TODO show truncated string
+ " │ "
+ (if (= i cur-event) "\x1b[7m" "")
+ (color-escape (attr (parent ev) 'COLOR))
+ ;; Summary filter is a hook for the user
+ (let ((dirty (attr ev 'X-HNH-DIRTY)))
+ (string-append
+ (if dirty "* " "")
+ ;; TODO reintroduce summary-filter
+ (trim-to-width (attr ev 'SUMMARY) (- summary-width
+ (if dirty 2 0)))))
+ STR-RESET
+ " │ "
+ (if (attr ev 'LOCATION) "" "\x1b[1;30m")
+ (trim-to-width
+ (or (attr ev 'LOCATION) "INGEN LOKAL") location-width)
+ STR-RESET
+ "\n")))
+ events
+ (iota (length events))))
(define (displayln a)
(display a) (newline))
diff --git a/module/util/config/all.scm b/module/util/config/all.scm
deleted file mode 100644
index 984b1d68..00000000
--- a/module/util/config/all.scm
+++ /dev/null
@@ -1,3 +0,0 @@
-(define-module (util config all)
- :use-module (util config))
-
diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm
index d4324437..8e11c9b2 100644
--- a/module/vcomponent/load.scm
+++ b/module/vcomponent/load.scm
@@ -2,6 +2,7 @@
:export (load-calendars load-calendars*)
:use-module (util)
:use-module (util time)
+ :use-module (util config)
:use-module (srfi srfi-1)
:use-module (datetime)
:use-module (datetime util)
@@ -14,11 +15,11 @@
:use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
:use-module ((vcomponent datetime) :select (ev-time<?)))
-(register-config! calendar-files '() (ensure list?))
+(define-config calendar-files '() "" (ensure list?))
;; Reads all calendar files from disk, generate recurence-sets for all repeating events,
;; and returns a list of calendars, and a stream of all events "ready" for display.
-(define* (load-calendars #:key (calendar-files (calendar-files)))
+(define* (load-calendars #:optional (calendar-files (get-config 'calendar-files)))
(report-time! "Parsing ~a calendars" (length calendar-files))
(let* ((calendars regular repeating (load-calendars* #:calendar-files calendar-files)))
(report-time! "Calendars loaded, interleaving and reccurring")
@@ -34,7 +35,7 @@
;; regular and repeating events separated from each other.
;;
;; (list string) → (list calendar), (list event), (list event)
-(define* (load-calendars* #:key (calendar-files (calendar-files)))
+(define* (load-calendars* #:key (calendar-files (get-config 'calendar-files)))
(define calendars (map parse-cal-path calendar-files))
(define events (concatenate