blob: 00edc0d8d2d2add2ee2a4b010cec1645975cbfc6 (
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
|
(define-module (calp entry-points import)
:export (main)
:use-module (hnh util)
:use-module (hnh util options)
:use-module (ice-9 getopt-long)
:use-module (ice-9 rdelim)
:use-module (ice-9 format)
:use-module (srfi srfi-1)
:use-module ((vcomponent formats vdir save-delete) :select (save-event))
:use-module (vcomponent)
;; :use-module ((vcomponent formats ical parse) :select (parse-cal-path))
:use-module ((vcomponent util parse-cal-path) :select (parse-cal-path))
:use-module (calp translation)
:autoload (vcomponent util instance) (global-event-object)
)
(define options
`((calendar (value #t) (single-char #\c)
(description ,(_ "Name of calendar to import into")))
(file (value #t) (single-char #\f)
(description ,(_ "ics file to import")))
(help (single-char #\h)
(description ,(_ "Print this help.")))))
(define (main args)
(define opts (getopt-long args (getopt-opt options)))
(define cal-name (option-ref opts 'calendar #f))
(define fname (option-ref opts 'file "/dev/stdin"))
(when (option-ref opts 'help #f)
(print-arg-help options)
(throw 'return))
(let* ((calendars (get-calendars global-event-object))
(calendar
(and cal-name
(find (lambda (c) (string=? cal-name (prop c 'NAME)))
(get-calendars global-event-object)))))
(unless calendar
(format (current-error-port) (_ "No calendar named ~s~%") cal-name)
(throw 'return))
(let ((new-events (parse-cal-path fname)))
(format #t (_ "About to import the following ~a events into ~a~%")
(length (children new-events))
(prop calendar 'NAME))
(format #t "~{~a~^~%~}~%"
(map (extract 'SUMMARY) (children new-events)))
(format #t (_ "Continue? [Y/n] "))
(let loop ((line (read-line)))
(case (if (string-null? line) 'yes (yes-no-check line))
[(no) (throw 'return)]
[(yes) (map (lambda (e)
(add-event calendar e)
(save-event e))
(children new-events))]
[else (loop (read-line))])))))
|
