blob: 675485374e5e0788fb4da849628f8732921af764 (
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
|
(define-module (output terminal)
#:use-module (output general)
#:use-module (output text)
#: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 (vulgar)
#:use-module (vulgar info)
#:use-module (vulgar color)
#:use-module (vulgar components)
#:use-module (vcomponent output)
#:use-module (vcomponent group)
#:use-module (vcomponent)
#:use-module (vcomponent datetime)
#:use-module (ice-9 format)
#:use-module (ice-9 getopt-long)
#:use-module (parameters)
#:use-module (config)
#:export (terminal-main))
(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)
(format #t "~a │ ~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)) summary-width)
STR-RESET
(if (attr ev 'LOCATION) "" "\x1b[1;30m")
(trim-to-width
(or (attr ev 'LOCATION) "INGEN LOKAL") location-width)
STR-RESET))
events
(iota (length events))))
(define (displayln a)
(display a) (newline))
(define (main-loop time event-stream)
(define cur-event 0)
(define-values (height width) (get-terminal-size))
(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 (group-stream event-stream)
(time-utc->date time) (time-utc->date time))))
(let ((events
(if (stream-null? groups)
'() (group->event-list (stream-car groups)))))
(cls)
(display-calendar-header! (time-utc->date time))
(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~%"
(attr ev 'X-HNH-FILENAME)
(attr ev 'SUMMARY)
(or (and=> (attr ev 'LOCATION)
(cut string-append "\x1b[1mPlats:\x1b[m " <> "\n")) "")
(time->string (attr ev 'DTSTART) "~1 ~3")
(time->string (attr ev 'DTEND) "~1 ~3")
(unlines (take-to (flow-text (or (attr 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! time (add-day time)
cur-event 0))
((#\h #\H)
(set! time (remove-day time)
cur-event 0))
((#\t)
(set! time (date->time-utc (drop-time (current-date)))
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)))
((#\E) (serialize-vcomponent (list-ref events cur-event) (open-output-file "/tmp/event.ics")))
((#\e)
(let ((fname (tmpnam)))
(with-output-to-file fname
(lambda () (serialize-vcomponent (list-ref events cur-event))))
(open-in-editor fname)
(with-input-from-file fname
(lambda ()
;; TODO readinig back this partal vcomponent somehow fails.
;; TODO Create a "display-in-parent" procedure, which takes a vcomponent
;; and displays it within the context of it's parents, N steps up.
;; This is different that display on parent since that would also
;; display all our siblings, which is not always wanted.
(let ((ev ((@ (vcomponent primitive) %vcomponent-make) fname)))
(serialize-vcomponent ev (current-error-port))
(push-child! (parent (list-ref events cur-event)) ev)
(format (current-error-port) "Children: ~a~%start: ~a~%" (children ev)
(attr ev 'DTSTART))
(set! event-stream (stream-insert ev-time<? ev event-stream)))))))
((#\g) (set! cur-event 0))
((#\G) (set! cur-event (1- (length events)))))
(when (or (eof-object? char)
(memv char '(#\q)))
(break)))
))))
(define options
'((date (value #t) (single-char #\d))))
(define (terminal-main calendars events args)
(let ((opts (getopt-long args options)))
(let ((time (date->time-utc
(drop-time (or (and=> (option-ref opts 'date #f) parse-freeform-date)
(current-date))))))
(with-vulgar
(lambda () (main-loop time events))))))
|
