diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-04-23 19:26:54 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-04-23 19:26:54 +0200 |
commit | 34da56150cbee6449faec22faabf6b2af3c84ed9 (patch) | |
tree | c263ef8ab6e77fb822db9bac8b7d78dd683f8750 /module | |
parent | Add command line option parsing. (diff) | |
download | calp-34da56150cbee6449faec22faabf6b2af3c84ed9.tar.gz calp-34da56150cbee6449faec22faabf6b2af3c84ed9.tar.xz |
Move stuff from main.
Diffstat (limited to '')
-rwxr-xr-x | module/main.scm | 131 | ||||
-rw-r--r-- | module/output/general.scm | 10 | ||||
-rw-r--r-- | module/output/html.scm (renamed from module/html/html.scm) | 4 | ||||
-rw-r--r-- | module/output/terminal.scm | 113 | ||||
-rw-r--r-- | module/vcomponent/datetime.scm | 4 |
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))) |