From 868fcec0dc3f9df0aca3c8876179c73cb5ede44f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 23 Apr 2019 21:21:15 +0200 Subject: Add ability to set start-date of term mode. --- module/main.scm | 13 ++++++------- module/output/terminal.scm | 25 +++++++++++++++++-------- 2 files changed, 23 insertions(+), 15 deletions(-) (limited to 'module') diff --git a/module/main.scm b/module/main.scm index b20134f9..d0ddac48 100755 --- a/module/main.scm +++ b/module/main.scm @@ -44,16 +44,15 @@ (map generate-recurrence-set repeating)))))) (define options - '((mode (value #t) (single-char #\m)) - (date (value #t) (single-char #\d)) - )) + '((mode (value #t) (single-char #\m)))) (define (main args) (let ((opts (getopt-long args options #:stop-at-first-non-option #t))) (init (lambda (c e) - ((case (string->symbol (option-ref opts 'mode "term")) - ((html) html-main) - ((term) terminal-main)) - c e (option-ref opts '() '())))) + (let ((ropt (option-ref opts '() '("term")))) + ((case (string->symbol (car ropt)) + ((html) html-main) + ((term) terminal-main)) + c e ropt)))) (newline))) diff --git a/module/output/terminal.scm b/module/output/terminal.scm index 1d49896c..6779ee5b 100644 --- a/module/output/terminal.scm +++ b/module/output/terminal.scm @@ -16,6 +16,7 @@ #:use-module (texinfo string-utils) ; string->wrapped-lines #:use-module (ice-9 format) + #:use-module (ice-9 getopt-long) #:use-module (parameters) #:use-module (config) @@ -41,15 +42,13 @@ 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 (main-loop time event-stream) (define cur-event 0) + + (while #t (let ((events (stream->list @@ -92,7 +91,7 @@ (set! time (remove-day time) cur-event 0)) ((#\t) - (set! time (now) + (set! time (date->time-utc (current-date)) cur-event 0)) ((#\j #\J) (unless (= cur-event (1- (length events))) (mod! cur-event 1+))) @@ -108,6 +107,16 @@ (break))) ))) +(define options + '((date (value #t) (single-char #\d)))) + +(define (parse-freeform-date str) + (string->date str "~Y-~m-~d")) + (define (terminal-main calendars events args) - (with-vulgar - (lambda () (main-loop events)))) + (let ((opts (getopt-long args options))) + (let ((time (date->time-utc + (or (and=> (option-ref opts 'date #f) parse-freeform-date) + (current-date))))) + (with-vulgar + (lambda () (main-loop time events)))))) -- cgit v1.2.3