diff options
Diffstat (limited to 'src/Much')
-rw-r--r-- | src/Much/API.hs | 1 | ||||
-rw-r--r-- | src/Much/Core.hs | 4 | ||||
-rw-r--r-- | src/Much/RenderTreeView.hs | 24 | ||||
-rw-r--r-- | src/Much/State.hs | 2 | ||||
-rw-r--r-- | src/Much/TreeView.hs | 9 | ||||
-rw-r--r-- | src/Much/TreeView/Types.hs | 4 |
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) |