blob: 20740cac661ac4899b0f8482e5207d0a9f76c1f3 (
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
(define-module (output terminal)
#:use-module (output general)
#:use-module (srfi srfi-1)
#:use-module (datetime)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-41)
#:use-module (srfi srfi-41 util)
#:use-module (util)
#:use-module (util app)
#:use-module (vulgar)
#:use-module (vulgar info)
#:use-module (vulgar color)
#:use-module (vulgar components)
#:use-module (vcomponent group)
#:use-module (vcomponent)
#:use-module (vcomponent datetime)
#:use-module (text util)
#:use-module (text flow)
#:use-module (ice-9 format)
#:export (main-loop))
(define (open-in-editor fname)
(system (string-append (getenv "EDITOR") " " fname)))
(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 events #:key
(cur-event -1)
(summary-width 30)
(location-width 20))
(for-each
(lambda (ev i)
(display
(string-append
(if (datetime? (prop ev 'DTSTART))
(datetime->string (prop ev 'DTSTART) "~Y-~m-~d ~H:~M:~S")
((@ (texinfo string-utils) center-string)
(date->string (prop ev 'DTSTART))
19))
" │ "
(if (= i cur-event) "\x1b[7m" "")
(color-escape (prop (parent ev) 'COLOR))
;; Summary filter is a hook for the user
(let ((dirty (prop ev '-X-HNH-DIRTY)))
(string-append
(if dirty "* " "")
;; TODO reintroduce summary-filter
(trim-to-width (prop ev 'SUMMARY) (- summary-width
(if dirty 2 0)))))
STR-RESET
" │ "
(if (prop ev 'LOCATION) "" "\x1b[1;30m")
(trim-to-width
(or (prop ev 'LOCATION) "INGEN LOKAL") location-width)
STR-RESET
"\n")))
events
(iota (length events))))
(define (displayln a)
(display a) (newline))
(define-method (main-loop date)
(define event-stream (getf 'event-set))
(define cur-event 0)
(define-values (height width) (get-terminal-size))
(define grouped-stream (group-stream event-stream))
(while #t
;; TODO reusing the same grouping causes it to lose events.
;; I currently have no idea why, but it's BAD.
(let ((groups (get-groups-between grouped-stream
date date)))
(format (current-error-port) "len(groups) = ~a~%" (stream-length groups))
(let ((events
(if (stream-null? groups)
'() (group->event-list (stream-car groups)))))
(cls)
(display-calendar-header! date)
(let* ((date-width 20)
(location-width 15)
(summary-width (- width date-width location-width 6)))
(displayln
(box-top #\┬ #\─ date-width (+ summary-width 2) (1+ location-width)))
(display-event-table
events
#:cur-event cur-event
#:location-width location-width
#:summary-width summary-width)
(displayln
(box-top #\┴ #\─ date-width (+ summary-width 2) (1+ location-width))))
(unless (null? events)
(let ((ev (list-ref events cur-event)))
(format #t "~a~%~% ~a~%~%~a\x1b[1mStart:\x1b[m ~a \x1b[1mSlut:\x1b[m ~a~%~%~a~%"
(prop ev '-X-HNH-FILENAME)
(prop ev 'SUMMARY)
(or (and=> (prop ev 'LOCATION)
(cut string-append "\x1b[1mPlats:\x1b[m " <> "\n")) "")
;; NOTE RFC 5545 says that DTSTART and DTEND MUST
;; have the same type. However we believe that is
;; another story.
(let ((start (prop ev 'DTSTART)))
(if (datetime? start)
(datetime->string (prop ev 'DTSTART) "~Y-~m-~d ~H:~M:~S")
(date->string start)))
(let ((end (prop ev 'DTEND)))
(if (datetime? end)
(datetime->string (prop ev 'DTEND) "~Y-~m-~d ~H:~M:~S")
(date->string end)))
(unlines (take-to (flow-text (or (prop ev 'DESCRIPTION) "")
#:width (min 70 width))
(- height 8 5 (length events) 5))))))
(let ((char (read-char)))
;; (format (current-error-port)
;; "c = ~c (~d)~%" char (char->integer char))
(case char
((#\L #\l)
(set! date (add-day date)
cur-event 0))
((#\h #\H)
(set! date (remove-day date)
cur-event 0))
((#\t)
;; TODO this should be local time
;; currently it's UTC (maybe?)
(set! date (current-date)
cur-event 0))
((#\j #\J) (unless (= cur-event (1- (length events)))
(set! cur-event = (+ 1))))
((#\k #\K) (unless (= cur-event 0)
(set! cur-event = (- 1))))
((#\g) (set! cur-event 0))
((#\G) (set! cur-event (1- (length events))))
((#\() (set-cursor-pos 0 (1- height))
(let* ((attr (make-termios)))
(tcgetattr! attr)
(set! (lflag attr) (logior ECHO (lflag attr)))
(tcsetattr! attr)
(display (readline ">")
(current-error-port))
(set! (lflag attr) (logand (lognot ECHO) (lflag attr)))
(tcsetattr! attr))))
(when (or (eof-object? char)
(memv char '(#\q)))
(break)))
))))
|
