1 files changed, 61 insertions, 0 deletions
diff --git a/module/calp/entry-points/import.scm b/module/calp/entry-points/import.scm
new file mode 100644
index 00000000..b13832cc
--- /dev/null
+++ b/module/calp/entry-points/import.scm
@@ -0,0 +1,61 @@
+(define-module (calp entry-points import)
+  :export (main)
+  :use-module (util)
+  :use-module (util options)
+  :use-module (ice-9 getopt-long)
+  :use-module (ice-9 rdelim)
+  :use-module (srfi srfi-1)
+  :use-module (output vdir)
+  :use-module (vcomponent)
+  :autoload (vcomponent 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 the following ~a events into ~a~%~{~a~^~%~}~%"
+              (length (children new-events))
+              (prop calendar 'NAME)
+              (map (extract 'SUMMARY) (children new-events)))
+
+      (format #t "Continue? [Y/n] ")
+
+      (let loop ((c #\space))
+        (case c
+          [(#\n #\N) (throw 'return)]
+          [(#\y #\Y) (map (lambda (e)
+                            (add-event calendar e)
+                            (save-event e))
+                          (children new-events))]
+          [else
+           (let ((line (read-line)))
+             (loop (if (string-null? line)
+                       #\Y (string-ref line 0))))]))
+      )))