aboutsummaryrefslogtreecommitdiff
path: root/module/entry-points
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-08-02 23:25:56 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-08-02 23:25:56 +0200
commit5188fb2251e02b32fd017dc7ba8cd6d0ce892c75 (patch)
treec79ed2f7b1734ebccc53fa4daee9ed1a5a2862c4 /module/entry-points
parentRepair vcomponent describe. (diff)
downloadcalp-5188fb2251e02b32fd017dc7ba8cd6d0ce892c75.tar.gz
calp-5188fb2251e02b32fd017dc7ba8cd6d0ce892c75.tar.xz
Remove (util app).
Diffstat (limited to 'module/entry-points')
-rw-r--r--module/entry-points/benchmark.scm10
-rw-r--r--module/entry-points/import.scm9
-rw-r--r--module/entry-points/server.scm15
3 files changed, 19 insertions, 15 deletions
diff --git a/module/entry-points/benchmark.scm b/module/entry-points/benchmark.scm
index ae55aa26..a8507fb9 100644
--- a/module/entry-points/benchmark.scm
+++ b/module/entry-points/benchmark.scm
@@ -4,7 +4,7 @@
:use-module (ice-9 getopt-long)
:use-module (util options)
:use-module (util)
- :use-module (util app)
+ :use-module (srfi srfi-41)
)
@@ -32,6 +32,8 @@
(unless field
(throw 'argument-error "Field `field' required."))
- (aif (option-ref opts 'enable-output #f)
- (write (getf field app: (current-app)))
- (getf field app: (current-app))))
+ (let ((strm ((@ (vcomponent instance) get-event-set)
+ (@ (vcomponent instance) global-event-object))))
+ (if (option-ref opts 'enable-output #f)
+ (write (stream->list 1000 strm))
+ (stream->list 1000 strm))))
diff --git a/module/entry-points/import.scm b/module/entry-points/import.scm
index 8b2c9008..9e8e3d7b 100644
--- a/module/entry-points/import.scm
+++ b/module/entry-points/import.scm
@@ -1,13 +1,14 @@
(define-module (entry-points import)
:export (main)
:use-module (util)
- :use-module (util app)
:use-module (util options)
:use-module (ice-9 getopt-long)
:use-module (ice-9 rdelim)
:use-module (vcomponent)
:use-module (srfi srfi-1)
- :use-module (output vdir))
+ :use-module (output vdir)
+ :autoload (vcomponent instance) (get-calendars global-event-object)
+ )
(define options
'((calendar (value #t) (single-char #\c)
@@ -27,11 +28,11 @@
(print-arg-help options)
(throw 'return))
- (let* ((calendars (getf 'calendars))
+ (let* ((calendars (get-calendars global-event-object))
(calendar
(and cal-name
(find (lambda (c) (string=? cal-name (prop c 'NAME)))
- (getf 'calendars)))))
+ (get-calendars global-event-object)))))
(unless calendar
(format (current-error-port) "No calendar named ~s~%" cal-name)
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
index 5c3108cc..fd322c7d 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -1,6 +1,5 @@
(define-module (entry-points server)
:use-module (util)
- :use-module (util app)
:use-module (util config)
:use-module (util options)
:use-module (util exceptions)
@@ -34,6 +33,8 @@
:use-module (output html)
:use-module (output ical)
+ :autoload (vcomponent instance) (get-calendars global-event-object)
+
:export (main)
)
@@ -59,7 +60,7 @@
(cdr (scandir dir))))))
-(define-method (make-make-routes)
+(define (make-make-routes)
(make-routes
;; Manual redirect to not reserve root.
@@ -77,8 +78,8 @@
(return `((content-type application/xhtml+xml))
(with-output-to-string
(lambda ()
- (html-generate calendars: (getf 'calendars)
- events: (getf 'event-set)
+ (html-generate calendars: (get-calendars global-event-object)
+ events: (get-event-set global-event-object)
start-date: start-date
end-date: (date+ start-date (date day: 6))
next-start: (lambda (d) (date+ d (date day: 7)))
@@ -93,8 +94,8 @@
(return '((content-type application/xhtml+xml))
(with-output-to-string
(lambda ()
- (html-generate calendars: (getf 'calendars)
- events: (getf 'event-set)
+ (html-generate calendars: (get-calendars global-event-object)
+ events: (get-event-set global-event-object)
start-date: start-date
end-date: (date- (month+ start-date)
(date day: 1))
@@ -144,7 +145,7 @@
;; also, the default output gives everything.
(let ((calendar
(find (lambda (c) (string=? cal (prop c 'NAME)))
- (getf 'calendars))))
+ (get-calendars global-event-object))))
(unless calendar
(return (build-response code: 400)