blob: babd42d4ed258e6c6d76dc4322002ecdf55c98d2 (
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
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
{-# LANGUAGE LambdaCase #-}
module TreeViewRaw where
import TreeView
import Data.Tree
import Trammel
import qualified Notmuch
import qualified Notmuch.Message as Notmuch
import qualified Notmuch.SearchResult as Notmuch
import qualified Data.CaseInsensitive as CI
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Text as T
-- Maybe TreeView -> Tree TreeView -> Image
--hPutTreeView h cur tv =
-- treeImage (Just $ Z.label cursor) (Z.toTree cursor)
renderTreeView :: TreeView -> Tree TreeView -> [String]
renderTreeView cur _loc@(Node label children) =
[ colorize $ renderTreeView1 hasFocus label ] ++
concatMap (map (" "++) . renderTreeView cur) children
where
hasFocus = cur == label
colorize s =
if hasFocus
then pp $ SGR [31] s
else pp s
renderTreeView1 :: Bool -> TreeView -> Trammel String
renderTreeView1 hasFocus = \case
TVSearch s ->
Plain s
TVSearchResult sr -> Plain $
(padl 11 ' ' $ T.unpack $ Notmuch.searchDateRel sr)
++ "("
++ (show $ Notmuch.searchMatched sr)
++ ") "
++ (T.unpack $ Notmuch.searchSubject sr)
-- ++ " "
-- ++ (let Notmuch.ThreadID tid = Notmuch.searchThread sr in tid)
TVMessage m -> Plain $
(Notmuch.unMessageID $ Notmuch.messageId m)
++ " "
++ T.unpack (T.intercalate (T.pack ",") $ Notmuch.messageTags m)
TVMessageHeaderField m fieldName -> Plain $
let k = T.unpack $ CI.original fieldName
v = maybe "nothing"
T.unpack
(M.lookup fieldName $ Notmuch.messageHeaders m)
in k ++ ": " ++ v
TVMessagePart _ p -> Plain $
"part#"
++ (show $ Notmuch.partID p)
++ " "
++ (T.unpack $ CI.original $ Notmuch.partContentType p)
TVMessageLine _ _ _ s ->
Plain s
-- | TVMessageLine Message MessagePart LineNr String
--TVMessage m ->
-- let col = if isOpen m then om else cm
-- in
-- string col (unMessageID $ messageId m)
-- <|>
-- translateX 1 (
-- horizCat $
-- intersperse (string col ", ") $
-- map (text' tagColor) $
-- messageTags m
-- )
s ->
Plain $ describe s
-- let col = if isOpen m then om else cm
-- in
-- string col (unMessageID $ messageId m)
-- <|>
-- translateX 1 (
-- horizCat $
-- intersperse (string col ", ") $
-- map (text' tagColor) $
-- messageTags m
-- )
--hPutTreeView h hasFocus = \case
-- TVMessage m ->
-- putStr
-- _ ->
--
--treeViewImage :: Bool -> TreeView -> Image
--treeViewImage hasFocus = \case
-- TVMessage m ->
-- let col = if isOpen m then om else cm
-- in
-- string col (unMessageID $ messageId m)
-- <|>
-- translateX 1 (
-- horizCat $
-- intersperse (string col ", ") $
-- map (text' tagColor) $
-- messageTags m
-- )
--
-- TVMessageHeaderField m fieldName ->
-- let k = string mhf $ T.unpack $ CI.original fieldName
-- v = maybe (string mhf_empty "nothing")
-- (string mhf . T.unpack)
-- (M.lookup fieldName $ messageHeaders m)
-- in k <|> string mhf ": " <|> v
--
-- TVMessagePart _ p ->
-- string mp "TVMessagePart"
-- <|> translateX 1 (string mp $ show $ partID p)
-- <|> translateX 1 (string mp $ show $ partContentType p)
--
-- TVMessageLine _ _ _ s ->
-- string ml s
--
-- TVSearch s ->
-- string sColor s
--
-- TVSearchResult sr -> do
-- --let ThreadID tid = searchThread sr
-- --string srColor tid
-- -- <|>
-- --translateX 1
-- (string srColor $ padl 11 ' ' $ T.unpack $ searchDateRel sr)
-- <|>
-- string srColor " ("
-- <|>
-- (string srColor $ show $ searchMatched sr)
-- <|>
-- string srColor ")"
-- <|>
-- string srColor " "
-- -- <|>
-- -- (string srColor $ show $ searchTime sr)
-- <|>
-- (string srColor $ T.unpack $ searchSubject sr)
-- <|>
-- --(string srColor $ T.unpack $ searchThread sr)
-- (translateX 1 $ let ThreadID tid = searchThread sr in string srColor tid)
-- --string srColor tid
-- where
-- --c1 = if hasFocus then c1_focus else c1_nofocus
-- --c1_nofocus = withForeColor def $ Color240 $ -16 + 238
-- --c1_focus = withForeColor def $ Color240 $ -16 + 244
-- --c2 = withForeColor def $ Color240 $ -16 + 106
-- --c3 = withForeColor def $ Color240 $ -16 + 199
--
-- tagColor = if hasFocus then tagColor_y else tagColor_n
-- tagColor_y = withForeColor def $ color 230
-- tagColor_n = withForeColor def $ color 200
--
-- cm = if hasFocus then cm_y else cm_n
-- cm_y = withForeColor def $ color 46
-- cm_n = withForeColor def $ color 22
--
-- om = if hasFocus then om_y else om_n
-- om_y = withForeColor def $ color 82
-- om_n = withForeColor def $ color 58
--
-- ml = if hasFocus then ml_y else ml_n
-- ml_y = withForeColor def $ color 226
-- ml_n = withForeColor def $ color 202
--
-- mhf = if hasFocus then mhf_y else mhf_n
-- mhf_y = withForeColor def $ color 248
-- mhf_n = withForeColor def $ color 244
--
-- mhf_empty = if hasFocus then mhf_empty_y else mhf_empty_n
-- mhf_empty_y = withForeColor def $ color 88
-- mhf_empty_n = withForeColor def $ color 52
--
-- --ph = if hasFocus then ph_y else ph_n
-- --ph_y = withForeColor def $ color 241
-- --ph_n = withForeColor def $ color 235
--
-- mp = if hasFocus then mp_y else mp_n
-- mp_y = withForeColor def $ color 199
-- mp_n = withForeColor def $ color 162
--
-- sColor = if hasFocus then sColor_y else sColor_n
-- sColor_y = withForeColor def $ color 196
-- sColor_n = withForeColor def $ color 88
--
-- srColor = if hasFocus then srColor_y else srColor_n
-- srColor_y = withForeColor def $ color 197
-- srColor_n = withForeColor def $ color 89
--
-- color i = Color240 $ -16 + i
|
