summaryrefslogtreecommitdiffstats
path: root/src/Much
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2020-09-30 11:45:41 +0200
committertv <tv@krebsco.de>2020-09-30 15:39:23 +0200
commit63bf1907d3e6629ac21da87b9e45303bcec2bdf9 (patch)
treeeebf73eec52795524f7cdcba6cc32272521565a0 /src/Much
parentf8b93d1f7150f6122ecf145936b9ac1abf413e2b (diff)
render non-text parts
Diffstat (limited to 'src/Much')
-rw-r--r--src/Much/API.hs1
-rw-r--r--src/Much/Core.hs4
-rw-r--r--src/Much/RenderTreeView.hs24
-rw-r--r--src/Much/State.hs2
-rw-r--r--src/Much/TreeView.hs9
-rw-r--r--src/Much/TreeView/Types.hs4
6 files changed, 44 insertions, 0 deletions
diff --git a/src/Much/API.hs b/src/Much/API.hs
index 0c1bf8d..a9999ef 100644
--- a/src/Much/API.hs
+++ b/src/Much/API.hs
@@ -84,6 +84,7 @@ main Config{socketPath} putEvent = do
TVMessageHeaderField m _ -> notmuchId m
TVMessagePart m _ -> notmuchId m
TVMessageQuoteLine m _ _ _ -> notmuchId m
+ TVMessageRawLine m _ _ _ -> notmuchId m
TVMessageLine m _ _ _ -> notmuchId m
TVSearch s -> s
TVSearchResult r -> notmuchId r
diff --git a/src/Much/Core.hs b/src/Much/Core.hs
index b0f9a51..47d6706 100644
--- a/src/Much/Core.hs
+++ b/src/Much/Core.hs
@@ -60,6 +60,8 @@ emptyState = State
, alt = SGR [38,5,182]
, search = SGR [38,5,162]
, focus = SGR [38,5,160]
+ , unprintableFocus = SGR [38,5,204]
+ , unprintableNormal = SGR [35]
, quote = SGR [38,5,242]
, boring = SGR [38,5,240]
, prefix = SGR [38,5,235]
@@ -95,6 +97,8 @@ importConfig config state = state
, search = fromColorConfig search search
, focus = fromColorConfig focus focus
, quote = fromColorConfig quote quote
+ , unprintableFocus = fromColorConfig unprintableFocus unprintableFocus
+ , unprintableNormal = fromColorConfig unprintableNormal unprintableNormal
, boring = fromColorConfig boring boring
, prefix = fromColorConfig prefix prefix
, date = fromColorConfig date date
diff --git a/src/Much/RenderTreeView.hs b/src/Much/RenderTreeView.hs
index d5999b2..d16a75c 100644
--- a/src/Much/RenderTreeView.hs
+++ b/src/Much/RenderTreeView.hs
@@ -13,7 +13,9 @@ import qualified Data.Text as T
import qualified Data.Tree.Zipper as Z
import qualified Much.TreeZipperUtils as Z
import Blessings
+import Control.Arrow
import Data.Char
+import Data.Function
import Data.Maybe
import Data.Time
import Data.Time.Format.Human
@@ -166,6 +168,28 @@ renderTreeView1 q@State{..} hasFocus x = case x of
then focus colorConfig $ Plain s
else quote colorConfig $ Plain s
+ TVMessageRawLine _ _ _ s ->
+ mconcat . map (uncurry renderClassifiedString) $ classifiedGroupBy isPrint s
+ where
+ renderClassifiedString :: Bool -> String -> Blessings String
+ renderClassifiedString = \case
+ True -> printableColor . Plain
+ False -> unprintableColor . Plain . showLitChar'
+
+ (printableColor, unprintableColor) =
+ if hasFocus
+ then (focus colorConfig, unprintableFocus colorConfig)
+ else (quote colorConfig, unprintableNormal colorConfig)
+
+ showLitChar' :: String -> String
+ showLitChar' = (>>= f)
+ where f '\ESC' = "^["
+ f c = showLitChar c ""
+
+ classifiedGroupBy :: Eq b => (a -> b) -> [a] -> [(b, [a])]
+ classifiedGroupBy f =
+ map (f . head &&& id) . L.groupBy ((==) `on` f)
+
TVMessageLine _ _ _ s ->
if hasFocus
then focus colorConfig $ Plain s
diff --git a/src/Much/State.hs b/src/Much/State.hs
index b7b01e6..8bc2de9 100644
--- a/src/Much/State.hs
+++ b/src/Much/State.hs
@@ -49,6 +49,8 @@ data ColorConfig a = ColorConfig
, unreadMessage :: a
, boringMessage :: a
, tagMap :: M.Map T.Text a
+ , unprintableFocus :: a
+ , unprintableNormal :: a
} deriving (Generic, Show)
instance FromJSON a => FromJSON (ColorConfig a)
diff --git a/src/Much/TreeView.hs b/src/Much/TreeView.hs
index 9487f74..e963497 100644
--- a/src/Much/TreeView.hs
+++ b/src/Much/TreeView.hs
@@ -18,6 +18,7 @@ module Much.TreeView
) where
+import qualified Data.ByteString.Lazy.Char8 as LBS8
import qualified Data.Text as T
import Data.Tree
import Notmuch
@@ -94,6 +95,8 @@ xconvPart m p =
contents = case partContent p of
ContentText t ->
zipWith (curry $ xconvLine m p) [0..] (T.lines t)
+ ContentRaw raw _ ->
+ zipWith (xconvRawLine m p) [0..] (lines . LBS8.unpack $ raw)
ContentMultipart parts ->
map (xconvPart m) parts
ContentMsgRFC822 _ ->
@@ -111,6 +114,12 @@ xconvLine m p (i, s) =
else TVMessageLine
+xconvRawLine
+ :: Message -> MessagePart -> LineNr -> String -> Tree TreeView
+xconvRawLine m p i s =
+ Node (TVMessageRawLine m p i s) []
+
+
isQuoteLine :: T.Text -> Bool
isQuoteLine s0 = do
let s = T.stripStart s0
diff --git a/src/Much/TreeView/Types.hs b/src/Much/TreeView/Types.hs
index 6e4ac6b..f30b0bc 100644
--- a/src/Much/TreeView/Types.hs
+++ b/src/Much/TreeView/Types.hs
@@ -16,6 +16,7 @@ data TreeView
| TVMessageHeaderField Message (CI.CI T.Text)
| TVMessagePart Message MessagePart
| TVMessageQuoteLine Message MessagePart LineNr String
+ | TVMessageRawLine Message MessagePart LineNr String
| TVMessageLine Message MessagePart LineNr String
| TVSearch String
| TVSearchResult SearchResult
@@ -53,6 +54,9 @@ treeViewId = \case
TVMessageQuoteLine m mp lineNr _ ->
TVIDMessageLine (fromMessage m) (partID mp) lineNr
+ TVMessageRawLine m mp lineNr _ ->
+ TVIDMessageLine (fromMessage m) (partID mp) lineNr
+
TVSearch s ->
TVIDSearch (T.pack s)