summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Core.hs10
-rw-r--r--RenderTreeView.hs41
-rw-r--r--State.hs3
3 files changed, 26 insertions, 28 deletions
diff --git a/Core.hs b/Core.hs
index 53f619c..bc54927 100644
--- a/Core.hs
+++ b/Core.hs
@@ -42,6 +42,11 @@ emptyState = State
, signalHandlers = []
, keymap = displayKey
, mousemap = displayMouse
+ , tagVisuals =
+ [ ("killed", SGR [38,5,088])
+ , ("star", SGR [38,5,226])
+ , ("draft", SGR [38,5,202])
+ ]
}
withQuery :: String -> State -> IO State
@@ -165,7 +170,7 @@ render q@State{..} =
, headBuffer = newHeadBuf
}
where
- newTreeBuf = renderTreeView now cursor (Z.root cursor)
+ newTreeBuf = renderTreeView q (Z.root cursor)
newHeadBuf =
[ Plain (show screenWidth) <> "x" <> Plain (show screenHeight)
<> " " <> Plain (show $ linearPos cursor - yoffset)
@@ -194,6 +199,3 @@ redraw q@State{..} = do
if Blessings.length s < screenWidth
then s <> "\ESC[K"
else s
-
-
-
diff --git a/RenderTreeView.hs b/RenderTreeView.hs
index cf8e6f3..569c46b 100644
--- a/RenderTreeView.hs
+++ b/RenderTreeView.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
module RenderTreeView (renderTreeView) where
@@ -16,6 +17,7 @@ import Data.Char
import Data.Time
import Data.Time.Format.Human
import Data.Tree
+import State
import TagUtils (Tag)
import TreeView
@@ -43,14 +45,13 @@ humanTimeLocale = defaultHumanTimeLocale
renderTreeView
- :: UTCTime
- -> Z.TreePos Z.Full TreeView
+ :: State
-> Z.TreePos Z.Full TreeView
-> [Blessings String]
-renderTreeView now cur =
+renderTreeView q@State{..} =
renderNode
where
- isFocus = (Z.label cur==) . Z.label
+ isFocus = (Z.label cursor==) . Z.label
renderNode loc =
renderRootLabel loc :
@@ -58,7 +59,7 @@ renderTreeView now cur =
renderRootLabel loc =
renderPrefix loc <>
- renderTreeView1 now (isFocus loc) (Z.label loc)
+ renderTreeView1 q (isFocus loc) (Z.label loc)
renderSubForest loc =
renderNode loc ++
@@ -115,9 +116,6 @@ searchSGR
, boringMessageSGR
, unreadMessageSGR
, unreadSearchSGR
- , killedTagSGR
- , starTagSGR
- , draftTagSGR
:: Blessings String -> Blessings String
altSGR = SGR [38,5,182]
@@ -128,17 +126,14 @@ boringSGR = SGR [38,5,240]
prefixSGR = SGR [38,5,235]
dateSGR = SGR [38,5,071]
tagsSGR = SGR [38,5,036]
-killedTagSGR = SGR [38,5,088]
-starTagSGR = SGR [38,5,226]
-draftTagSGR = SGR [38,5,202]
boringMessageSGR = SGR [38,5,023]
unreadMessageSGR = SGR [38,5,117]
unreadSearchSGR = SGR [38,5,250]
-renderTreeView1 :: UTCTime -> Bool -> TreeView -> Blessings String
-renderTreeView1 now hasFocus x = case x of
+renderTreeView1 :: State -> Bool -> TreeView -> Blessings String
+renderTreeView1 q@State{..} hasFocus x = case x of
TVSearch s ->
let c = if hasFocus then focusSGR else searchSGR
@@ -159,7 +154,7 @@ renderTreeView1 now hasFocus x = case x of
authors = Plain $ T.unpack $ Notmuch.searchAuthors sr
date = dateSGR $ renderDate now x
subject = Plain $ T.unpack $ Notmuch.searchSubject sr
- tags = tagsSGR $ renderTags (Notmuch.searchTags sr)
+ tags = tagsSGR $ renderTags q (Notmuch.searchTags sr)
title = if subject /= "" then subject else c_authors authors
in
c $ title <> " " <> date <> " " <> tags
@@ -171,7 +166,7 @@ renderTreeView1 now hasFocus x = case x of
| otherwise = boringMessageSGR
from = fromSGR $ renderFrom (M.lookup "from" $ Notmuch.messageHeaders m)
date = dateSGR $ renderDate now x
- tags = tagsSGR $ renderTags (Notmuch.messageTags m) -- TODO filter common tags
+ tags = tagsSGR $ renderTags q (Notmuch.messageTags m) -- TODO filter common tags
in from <> " " <> date <> " " <> tags
TVMessageHeaderField m fieldName ->
@@ -219,18 +214,16 @@ renderFrom = \case
Nothing -> SGR [35,1] "Anonymous"
-renderTags :: [Tag] -> Blessings String
-renderTags =
+renderTags :: State -> [Tag] -> Blessings String
+renderTags state =
-- TODO sort somewhere else
- mconcat . L.intersperse " " . map renderTag . L.sort
+ mconcat . L.intersperse " " . map (renderTag state) . L.sort
-renderTag :: Tag -> Blessings String
-renderTag tag = case tag of
- "draft" -> draftTagSGR plain
- "killed" -> killedTagSGR plain
- "star" -> starTagSGR plain
- _ -> plain
+renderTag :: State -> Tag -> Blessings String
+renderTag state tag = case lookup tag (tagVisuals state) of
+ Just visual -> visual plain
+ Nothing -> plain
where
plain = Plain $ T.unpack tag
diff --git a/State.hs b/State.hs
index 917b4c4..d333f95 100644
--- a/State.hs
+++ b/State.hs
@@ -1,6 +1,8 @@
module State where
import Blessings.String (Blessings)
+import qualified Data.Map as M
+import qualified Data.Text as T
import Data.Time
import qualified Data.Tree.Zipper as Z
import Scanner
@@ -20,4 +22,5 @@ data State = State
, signalHandlers :: [(Signal, IO ())]
, keymap :: String -> State -> IO State
, mousemap :: Scan -> State -> IO State
+ , tagVisuals :: [(T.Text, Blessings String -> Blessings String)]
}