blob: 2b0fde23d80032477a8fc973424f3612d5906ff1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
#!/bin/bash
# -*- mode: scheme -*-
root=$(dirname $(dirname $(realpath $0)))
GUILE_LOAD_PATH="$root/module:$GUILE_LOAD_PATH"
GUILE_LOAD_COMPILED_PATH="$root/obj/module:$GUILE_LOAD_COMPILED_PATH"
LD_LIBRARY_PATH="$root/lib:$LD_LIBRARY_PATH"
export GUILE_LOAD_PATH GUILE_LOAD_COMPILED_PATH LD_LIBRARY_PATH
export GUILE_AUTO_COMPILE=0
exec guile -e main -s $0 "$@"
!#
(use-modules (srfi srfi-1)
(srfi srfi-19)
(srfi srfi-26)
(srfi srfi-41)
(srfi srfi-41 util)
(srfi srfi-88)
(util)
(vcomponent)
(vcomponent recurrence)
(vcomponent datetime)
(output html)
(output terminal)
(output none)
(output text)
(output import)
(output info)
(server)
(ice-9 getopt-long)
(statprof)
(parameters)
(config))
;; Reads all calendar files from disk, and creates a list of "regular" events,
;; and a stream of "repeating" events, which are passed in that order to the
;; given procedure @var{proc}.
;;
;; Given as a sepparate function from main to ease debugging.
(define* (init proc #:key (calendar-files (calendar-files)))
(define calendars (map make-vcomponent calendar-files))
(define events (concatenate (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
(children cal)))
calendars)))
(let* ((repeating regular (partition repeating? events)))
(set! repeating (sort*! repeating time<? (extract 'DTSTART))
regular (sort*! regular time<? (extract 'DTSTART)))
(proc
calendars
(interleave-streams
ev-time<?
(cons (list->stream regular)
(map generate-recurrence-set repeating))))))
(define options
'((mode (value #t) (single-char #\m))
(file (value #t) (single-char #\f))
(output (value #t) (single-char #\o))
(format (value #f))
(statprof (value optional))))
(define (ornull a b)
(if (null? a)
b a))
(define (main args)
(define opts (getopt-long args options #:stop-at-first-non-option #t))
(define stprof (option-ref opts 'statprof #f))
(when stprof
(statprof-start))
(with-output-to-port (open-output-port (option-ref opts 'output "-"))
(lambda ()
(if (option-ref opts 'format #f)
(for-each (lambda (l) (display l) (newline))
(flow-text
(with-input-from-port (open-input-port (option-ref opts 'file "-"))
(@ (ice-9 rdelim) read-string))))
(init
(lambda (c e)
(let ((ropt (ornull (option-ref opts '() '())
'("term"))))
((case (string->symbol (car ropt))
((none) none-main)
((html) html-main)
((term) terminal-main)
((import) import-main)
((info) info-main)
((server) server-main))
c e ropt)))
calendar-files: (or (and=> (option-ref opts 'file #f)
list)
(calendar-files))))
(newline)))
(when stprof
(statprof-stop)
(statprof-display (current-error-port)
style: (if (boolean? stprof)
'flat
(string->symbol stprof)))))
|
