Rework program initialization.

Old init setup had the fancy idea to parse all files before anything
could be done with them. This however led to problems when a part of the
program which didn't care for the calendar files (such as text
formatting).

It also made testing performance almost impossible since to much code
was run before I had a chance to init statprof.

5 files changed, 19 insertions, 117 deletions

diff --git a/module/output/html.scm b/module/output/html.scm
index a9643fc3..21713455 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -11,8 +11,6 @@
   #:use-module (srfi srfi-19 util)
   #:use-module (output general)
 
-  #:use-module (ice-9 getopt-long)
-
   #:use-module (git)
   #:use-module (parameters)
   #:use-module (config))
@@ -297,39 +295,18 @@
                        (div (@ (class "eventlist"))
                             ,@(stream->list (stream-map fmt-day evs)))))))))
 
-(define opt-spec
-  '((from (value #t) (single-char #\f))
-    (to (value #t) (single-char #\t))
-    (chunked)
-    )
-  )
-
-(define-public (html-main calendars events args)
-  (define opts (getopt-long args opt-spec))
-
-  (cond [(option-ref opts 'chunked #f)
-         (let* ((start (cond [(option-ref opts 'from #f) => parse-freeform-date]
-                             [else (start-of-month (current-date))])))
-
-           (stream-for-each (lambda (pair)
-                              (format (current-error-port) "d = ~a~%u = ~a~%" (car pair) (cadr pair))
-                              (let ((fname (format #f "./html/~a.html" (date->string (car pair) "~1"))))
-                                (format (current-error-port) "Writing to [~a]~%" fname)
-                                (with-output-to-file fname
-                                  (lambda () (apply html-generate calendars events pair)))))
-                            (let ((ms (month-stream start)))
-                              (stream-take
-                               12 (stream-zip
-                                   ms (stream-map (lambda (d) (normalize-date
-                                                          (set (date-day d) = (- 1))))
-                                                  (stream-cdr ms))))
-                              )))
-
-
-         ]
-        [else
-         (let* ((start (cond [(option-ref opts 'from #f) => parse-freeform-date]
-                            [else (start-of-month (current-date))]))
-                (end (cond [(option-ref opts 'to  #f) => parse-freeform-date]
-                           [else (normalize-date* (set (date-month start) = (+ 1)))])))
-           (html-generate calendars events start end))]))
+
+(define-public (html-chunked-main calendars events start)
+  (stream-for-each (lambda (pair)
+                     (format (current-error-port) "d = ~a~%u = ~a~%" (car pair) (cadr pair))
+                     (let ((fname (format #f "./html/~a.html" (date->string (car pair) "~1"))))
+                       (format (current-error-port) "Writing to [~a]~%" fname)
+                       (with-output-to-file fname
+                         (lambda () (apply html-generate calendars events pair)))))
+                   (let ((ms (month-stream start)))
+                     (stream-take
+                      12 (stream-zip
+                          ms (stream-map (lambda (d) (normalize-date
+                                                 (set (date-day d) = (- 1))))
+                                         (stream-cdr ms))))
+                     )))
diff --git a/module/output/ical.scm b/module/output/ical.scm
index fcb75526..3dbc74b8 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -1,5 +1,4 @@
 (define-module (output ical)
-  :use-module (ice-9 getopt-long)
   :use-module (ice-9 format)
   :use-module (ice-9 match)
   :use-module (util)
@@ -11,14 +10,11 @@
   :use-module (srfi srfi-41 util)
   )
 
-(define opt-spec
-  '((from (value #t) (single-char #\f))
-    (to (value #t) (single-char #\t))))
 
 ;; Format value depending on key type.
 ;; Should NOT emit the key.
 (define (value-format key vline)
-  (catch 'wrong-type-arg
+  (with-throw-handler 'wrong-type-arg
     (lambda ()
      (case key
        ((DTSTART DTEND)
@@ -38,7 +34,7 @@
        (else (escape-chars (value vline)))))
     (lambda (err caller fmt args call-args)
       (format (current-error-port)
-              "WARNING: ~k~%" fmt args)
+              "WARNING: key = ~a, caller = ~s, call-args = ~s~%~k~%" key caller call-args fmt args)
       (with-output-to-string (lambda () (display (value vline))))
       )))
 
@@ -101,14 +97,7 @@ CALSCALE:GREGORIAN\r
 (define (print-footer)
   (format #t "END:VCALENDAR\r\n"))
 
-(define-public (ical-main calendars events args)
-  (define opts (getopt-long args opt-spec))
-
-  (define start (cond [(option-ref opts 'from #f) => parse-freeform-date]
-                      [else (start-of-month (current-date))]))
-  (define end   (cond [(option-ref opts 'to  #f) => parse-freeform-date]
-                      [else (normalize-date* (set (date-month start) = (+ 1)))]))
-
+(define-public (ical-main calendars events start end)
   (print-header)
 
   (let ((tzs (make-hash-table)))
diff --git a/module/output/import.scm b/module/output/import.scm
deleted file mode 100644
index 47f4fd47..00000000
--- a/module/output/import.scm
+++ /dev/null
@@ -1,31 +0,0 @@
-(define-module (output import)
-  :use-module (util))
-
-(define options
-  '((calendar (value #t) (single-char #\c))
-    (source (value #t) (single-char #\f))
-    ))
-
-(define (import-main calenadrs events args)
-  (define opts (getopt-long args options))
-
-  (define calendar (option-ref opts 'calendar #f))
-
-  (unless calendar
-    (format (current-error-port)
-            "Everything wroong~%"))
-
-
-  ;; TODO save sourcetype and dir for vdir calendars
-
-  #;
-  (let ((component (make-vcomponent (option-ref args 'source "/dev/stdin")))) ;
-                                        ;
-    ;; Check UID                        ;
-    ;; Add to calendar                  ;
-    ;; Allocate file, save there        ;
-                                        ;
-  )
-
-
-  )
diff --git a/module/output/info.scm b/module/output/info.scm
deleted file mode 100644
index eba0979c..00000000
--- a/module/output/info.scm
+++ /dev/null
@@ -1,20 +0,0 @@
-(define-module (output info)
-  :use-module (util))
-
-(use-modules (ice-9 getopt-long)
-             (vcomponent)
-             (vcomponent output)
-             (vulgar color)
-             (srfi srfi-1))
-
-(define-public (info-main calendars events args)
-  (format #t "~%Found ~a calendars, named:~%~{ - [~4@a] ~a~a\x1b[m~%~}~%"
-          (length calendars)
-          (concatenate
-           (zip (map (lambda (c) (length (filter (lambda (e) (eq? 'VEVENT (type e)))
-                                            (children c))))
-                     calendars)
-                (map (compose color-escape (extract 'COLOR)) calendars)
-                (map (extract 'NAME) calendars)))))
-
-
diff --git a/module/output/terminal.scm b/module/output/terminal.scm
index 16ba31e9..5d8a5a24 100644
--- a/module/output/terminal.scm
+++ b/module/output/terminal.scm
@@ -19,11 +19,10 @@
   #:use-module (vcomponent datetime)
 
   #:use-module (ice-9 format)
-  #:use-module (ice-9 getopt-long)
   #:use-module (parameters)
   #:use-module (config)
 
-  #:export (terminal-main))
+  #:export (main-loop))
 
 
 (define (open-in-editor fname)
@@ -150,15 +149,3 @@
                     (memv char '(#\q)))
             (break)))
         ))))
-
-(define options
-  '((date (value #t) (single-char #\d))))
-
-(define (terminal-main calendars events args)
-  (let ((opts (getopt-long args options)))
-    (let ((time (date->time-utc
-                 (drop-time (or (and=> (option-ref opts 'date #f) parse-freeform-date)
-                                (current-date))))))
-      ;; (format (current-error-port) "len(events) = ~a~%" (stream-length events))
-      (with-vulgar
-       (lambda () (main-loop time events))))))