Move stuff from main.

5 files changed, 137 insertions, 125 deletions

diff --git a/module/main.scm b/module/main.scm
index 58ea8ae7..b20134f9 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -6,136 +6,21 @@
 
 (use-modules (srfi srfi-1)
              (srfi srfi-19)
-             (srfi srfi-19 util)
              (srfi srfi-26)
              (srfi srfi-41)
              (srfi srfi-41 util)
-             (ice-9 format)
-             (ice-9 control)            ; call-with-escape-continuation
-             (texinfo string-utils)     ; string->wrapped-lines
              (util)
              (vcomponent)
              (vcomponent recurrence)
              (vcomponent datetime)
-             (vcomponent output)
-             (terminal escape)
-             (terminal util)
 
-             (html html)
+             (output html)
+             (output terminal)
 
              (ice-9 getopt-long)
 
              (parameters)
-             )
-
-(define (ev-time<? a b)
-  (time<? (attr a 'DTSTART)
-          (attr b 'DTSTART)))
-
-
-
-#; (define pizza-event (search cal "pizza"))
-
-(define (trim-to-width str len)
-  (let ((trimmed (string-pad-right str len)))
-    (if (< (string-length trimmed)
-           (string-length str))
-        (string-append (string-drop-right trimmed 1)
-                       "…")
-        trimmed)))
-  ; TODO show truncated string
-
-(define (now)
-  (date->time-utc (current-date)))
-
-(define (box-top intersection line . lengths)
-  (reduce (lambda (str done) (string-append done (string intersection) str))
-          "" (map (cut make-string <> line) lengths)))
-
-(define (displayln a)
-  (display a) (newline))
-
-(define (display-event-table cur-event events)
- (for-each
-  (lambda (ev i)
-    (format #t "~a │ ~a~a~a~a │ ~a~a~%"
-            (time->string (attr ev 'DTSTART) "~1 ~3") ; TODO show truncated string
-            (if (= i cur-event) "\x1b[7m" "")
-            (color-escape (attr (parent ev) 'COLOR))
-            ;; Summary filter is a hook for the user
-            (trim-to-width ((summary-filter) ev (attr ev 'SUMMARY)) 30)
-            STR-RESET
-            (trim-to-width
-             (or (attr ev 'LOCATION) "\x1b[1;30mINGEN LOKAL") 20)
-            STR-RESET))
-  events
-  (iota (length events))))
-
-(define (main-loop event-stream)
-  (define time (now))
-  (define cur-event 0)
-  (while #t
-    (let ((events
-           (stream->list
-            (filter-sorted-stream
-             (cut event-in? <> time)
-             event-stream))))
-
-      (cls)
-      (display-calendar-header! (time-utc->date time))
-
-      (displayln (box-top #\┬ #\─ 20 32 10))
-      (display-event-table cur-event events)
-      (displayln (box-top #\┴ #\─ 20 32 10))
-
-      (unless (null? events)
-        (let ((ev (list-ref events cur-event)))
-          (format #t "~a~%~a~%~aStart: ~a	Slut: ~a~%~%~a~%"
-                  (attr ev 'X-HNH-FILENAME)
-                  (attr ev 'SUMMARY)
-                  (or (and=> (attr ev 'LOCATION) (cut string-append "Plats: " <> "\n")) "")
-                  (time->string (attr ev 'DTSTART) "~1 ~3")
-                  (time->string (attr ev 'DTEND) "~1 ~3")
-                  (string-join   ; TODO replace this with a better text flower
-                   (take-to      ; This one destroys newlines used for layout
-                    (string->wrapped-lines (or (attr ev 'DESCRIPTION) "")
-                                           #:line-width 60
-                                           #:collapse-whitespace? #f)
-                    10)
-                   (string #\newline))
-                  )))
-
-      (let ((char (read-char)))
-        ;; (format (current-error-port)
-        ;;         "c = ~c (~d)~%" char (char->integer char))
-        (case char
-          ((#\L #\l)
-           (set! time (add-day time)
-                 cur-event 0))
-          ((#\h #\H)
-           (set! time (remove-day time)
-                 cur-event 0))
-          ((#\t)
-           (set! time (now)
-                 cur-event 0))
-          ((#\j #\J) (unless (= cur-event (1- (length events)))
-		       (mod! cur-event 1+)))
-          ((#\k #\K) (unless (= cur-event 0)
-		       (mod! cur-event 1-)))
-          ((#\p) (print-vcomponent (list-ref events cur-event)
-                                   (current-error-port)))
-	  ((#\g) (set! cur-event 0))
-	  ((#\G) (set! cur-event (1- (length events)))))
-
-        (when (or (eof-object? char)
-                  (memv char (list #\q (ctrl #\C))))
-          (break)))
-      )))
-
-
-
-;; (load "config.scm")
-(use-modules (config))
+             (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
@@ -166,9 +51,9 @@
 (define (main args)
   (let ((opts (getopt-long args options #:stop-at-first-non-option #t)))
     (init
-     (case (string->symbol (option-ref opts 'mode "term"))
-       ((html) html-main)
-       ((term) (lambda (calendars events)
-                 (with-vulgar
-                  (lambda () (main-loop events)))))))
+     (lambda (c e)
+       ((case (string->symbol (option-ref opts 'mode "term"))
+          ((html) html-main)
+          ((term) terminal-main))
+        c e (option-ref opts '() '()))))
     (newline)))
diff --git a/module/output/general.scm b/module/output/general.scm
new file mode 100644
index 00000000..f455f18b
--- /dev/null
+++ b/module/output/general.scm
@@ -0,0 +1,10 @@
+(define-module (output general)
+  )
+
+(define-public (trim-to-width str len)
+  (let ((trimmed (string-pad-right str len)))
+    (if (< (string-length trimmed)
+           (string-length str))
+        (string-append (string-drop-right trimmed 1)
+                       "…")
+        trimmed)))
diff --git a/module/html/html.scm b/module/output/html.scm
index 3dcfdb55..3df3c713 100644
--- a/module/html/html.scm
+++ b/module/output/html.scm
@@ -1,4 +1,4 @@
-(define-module (html html)
+(define-module (output html)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-41)
   #:use-module (srfi srfi-41 util)
@@ -135,7 +135,7 @@
             (rel "stylesheet")
             (href ,path))))
 
-(define-public (html-main calendars events)
+(define-public (html-main calendars events args)
 
   (define evs
     (filter-sorted-stream
diff --git a/module/output/terminal.scm b/module/output/terminal.scm
new file mode 100644
index 00000000..1d49896c
--- /dev/null
+++ b/module/output/terminal.scm
@@ -0,0 +1,113 @@
+(define-module (output terminal)
+  #:use-module (output general)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-19 util)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-41)
+  #:use-module (srfi srfi-41 util)
+  #:use-module (util)
+  #:use-module (terminal escape)
+  #:use-module (terminal util)
+  #:use-module (vcomponent output)
+
+  #:use-module (vcomponent)
+  #:use-module (vcomponent datetime)
+
+  #:use-module (texinfo string-utils)     ; string->wrapped-lines
+  #:use-module (ice-9 format)
+  #:use-module (parameters)
+  #:use-module (config)
+
+  #:export (terminal-main))
+
+(define (box-top intersection line . lengths)
+  (reduce (lambda (str done) (string-append done (string intersection) str))
+          "" (map (cut make-string <> line) lengths)))
+
+(define (display-event-table cur-event events)
+ (for-each
+  (lambda (ev i)
+    (format #t "~a │ ~a~a~a~a │ ~a~a~%"
+            (time->string (attr ev 'DTSTART) "~1 ~3") ; TODO show truncated string
+            (if (= i cur-event) "\x1b[7m" "")
+            (color-escape (attr (parent ev) 'COLOR))
+            ;; Summary filter is a hook for the user
+            (trim-to-width ((summary-filter) ev (attr ev 'SUMMARY)) 30)
+            STR-RESET
+            (trim-to-width
+             (or (attr ev 'LOCATION) "\x1b[1;30mINGEN LOKAL") 20)
+            STR-RESET))
+  events
+  (iota (length events))))
+
+(define (now)
+  (date->time-utc (current-date)))
+
+(define (displayln a)
+  (display a) (newline))
+
+(define (main-loop event-stream)
+  (define time (now))
+  (define cur-event 0)
+  (while #t
+    (let ((events
+           (stream->list
+            (filter-sorted-stream
+             (cut event-in? <> time)
+             event-stream))))
+
+      (cls)
+      (display-calendar-header! (time-utc->date time))
+
+      (displayln (box-top #\┬ #\─ 20 32 10))
+      (display-event-table cur-event events)
+      (displayln (box-top #\┴ #\─ 20 32 10))
+
+      (unless (null? events)
+        (let ((ev (list-ref events cur-event)))
+          (format #t "~a~%~a~%~aStart: ~a	Slut: ~a~%~%~a~%"
+                  (attr ev 'X-HNH-FILENAME)
+                  (attr ev 'SUMMARY)
+                  (or (and=> (attr ev 'LOCATION) (cut string-append "Plats: " <> "\n")) "")
+                  (time->string (attr ev 'DTSTART) "~1 ~3")
+                  (time->string (attr ev 'DTEND) "~1 ~3")
+                  (string-join   ; TODO replace this with a better text flower
+                   (take-to      ; This one destroys newlines used for layout
+                    (string->wrapped-lines (or (attr ev 'DESCRIPTION) "")
+                                           #:line-width 60
+                                           #:collapse-whitespace? #f)
+                    10)
+                   (string #\newline))
+                  )))
+
+      (let ((char (read-char)))
+        ;; (format (current-error-port)
+        ;;         "c = ~c (~d)~%" char (char->integer char))
+        (case char
+          ((#\L #\l)
+           (set! time (add-day time)
+                 cur-event 0))
+          ((#\h #\H)
+           (set! time (remove-day time)
+                 cur-event 0))
+          ((#\t)
+           (set! time (now)
+                 cur-event 0))
+          ((#\j #\J) (unless (= cur-event (1- (length events)))
+		       (mod! cur-event 1+)))
+          ((#\k #\K) (unless (= cur-event 0)
+		       (mod! cur-event 1-)))
+          ((#\p) (print-vcomponent (list-ref events cur-event)
+                                   (current-error-port)))
+	  ((#\g) (set! cur-event 0))
+	  ((#\G) (set! cur-event (1- (length events)))))
+
+        (when (or (eof-object? char)
+                  (memv char (list #\q (ctrl #\C))))
+          (break)))
+      )))
+
+(define (terminal-main calendars events args)
+  (with-vulgar
+   (lambda () (main-loop events))))
diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm
index 2270d10e..e427b088 100644
--- a/module/vcomponent/datetime.scm
+++ b/module/vcomponent/datetime.scm
@@ -56,3 +56,7 @@ Event must have the DTSTART and DTEND attribute set."
   (time-difference
    (time-min (add-day start-of-day) (attr e 'DTEND))
    (time-max start-of-day (attr e 'DTSTART))))
+
+(define-public (ev-time<? a b)
+  (time<? (attr a 'DTSTART)
+          (attr b 'DTSTART)))