blob: 0c83a4a88986cffb56e71b0a6cf6f45c3502c564 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
#!/usr/bin/guile \
-e main -s
!#
(add-to-load-path (dirname (current-filename)))
(use-modules (srfi srfi-1)
(srfi srfi-19)
(srfi srfi-19 util)
(srfi srfi-26)
(ice-9 format)
(texinfo string-utils) ; string->wrapped-lines
(util)
(vcalendar)
(vcalendar datetime)
(vcalendar output)
(terminal escape)
(terminal util))
(define (take-to lst i)
(if (> i (length lst))
lst (take lst i)))
;;; ------------------------------------------------------------
#; (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 (main-loop regular-events repeating-events)
(define time (date->time-utc (current-date)))
(define cur-event 0)
(let loop ((char #\nul))
(let ((events
(filter (cut event-in? <> time)
regular-events)))
(case char
;; TODO The explicit loop call is a hack to rerender the display
;; It's REALLY ugly.
((#\L #\l) (set! time (add-day time)) (set! cur-event 0) (loop #\nul))
((#\h #\H) (set! time (remove-day time)) (set! cur-event 0) (loop #\nul))
((#\j #\J) (unless (= cur-event (1- (length events)))
(set! cur-event (1+ cur-event))))
((#\k #\K) (unless (= cur-event 0)
(set! cur-event (1- cur-event)))))
(cls)
(display-calendar-header! (time-utc->date time))
;; (line)
(format #t "~a┬~a┬~a~%"
(make-string 20 #\─)
(make-string 32 #\─)
(make-string 10 #\─))
(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))
(trim-to-width (attr ev 'SUMMARY) 30)
STR-RESET
(trim-to-width
(or (attr ev 'LOCATION) "\x1b[1;30mINGEN LOKAL") 20)
STR-RESET))
events
(iota (length events)))
(format #t "~a┴~a┴~a~%"
(make-string 20 #\─)
(make-string 32 #\─)
(make-string 10 #\─))
(unless (null? events)
(let ((ev (list-ref events cur-event)))
(format #t "~a~%~aStart: ~a Slut: ~a~%~%~a~%"
(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))
)))
;; (format #t "c = ~c (~d)~%" char (char->integer char))
(unless (or (eof-object? char)
;; TODO this requires that `q' is pressed as many
;; times as other inputs where pressed to actually
;; quit.
;; ^C only works because it force closes the
;; program.
(memv char (list #\q (ctrl #\C))))
(loop (read-char (current-input-port)))))))
(load "config.scm")
(define (main args)
(define calendars (map make-vcomponent calendar-files))
(define events (concatenate (map (cut children <> 'VEVENT) calendars)))
(let* ((repeating regular (partition repeating? events)))
(sort*! repeating time<? (extract 'DTSTART))
(sort*! regular time<? (extract 'DTSTART))
(with-vulgar
(lambda () (main-loop regular repeating)))))
|
