From 29c2670da2a267094148f3edacaed5fc258bcdd1 Mon Sep 17 00:00:00 2001
From: Lucas Escot <flupe@users.noreply.github.com>
Date: Thu, 13 Feb 2020 19:27:34 +0100
Subject: Add highlight directive to the rST reader (#6140)
---
src/Text/Pandoc/Parsing.hs | 2 ++
src/Text/Pandoc/Readers/RST.hs | 15 +++++++++++----
2 files changed, 13 insertions(+), 4 deletions(-)
(limited to 'src')
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 57b780e7f..87b391eda 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -1138,6 +1138,7 @@ data ParserState = ParserState
stateExamples :: M.Map Text Int, -- ^ Map from example labels to numbers
stateMacros :: M.Map Text Macro, -- ^ Table of macros defined so far
stateRstDefaultRole :: Text, -- ^ Current rST default interpreted text role
+ stateRstHighlight :: Maybe Text, -- ^ Current rST literal block language
stateRstCustomRoles :: M.Map Text (Text, Maybe Text, Attr), -- ^ Current rST custom text roles
-- Triple represents: 1) Base role, 2) Optional format (only for :raw:
-- roles), 3) Additional classes (rest of Attr is unused)).
@@ -1248,6 +1249,7 @@ defaultParserState =
stateExamples = M.empty,
stateMacros = M.empty,
stateRstDefaultRole = "title-reference",
+ stateRstHighlight = Nothing,
stateRstCustomRoles = M.empty,
stateCaption = Nothing,
stateInHtmlBlock = Nothing,
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index ba1902a6e..e6e6d56e8 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -23,7 +23,7 @@ import Control.Monad.Identity (Identity (..))
import Data.Char (isHexDigit, isSpace, toUpper, isAlphaNum)
import Data.List (deleteFirstsBy, elemIndex, nub, sort, transpose)
import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, maybeToList)
import Data.Sequence (ViewR (..), viewr)
import Data.Text (Text)
import qualified Data.Text as T
@@ -390,11 +390,13 @@ quotedBlock = try $ do
codeBlockStart :: Monad m => ParserT Text st m Char
codeBlockStart = string "::" >> blankline >> blankline
-codeBlock :: (HasReaderOptions st, Monad m) => ParserT Text st m Blocks
+codeBlock :: Monad m => ParserT Text ParserState m Blocks
codeBlock = try $ codeBlockStart >> codeBlockBody
-codeBlockBody :: (HasReaderOptions st, Monad m) => ParserT Text st m Blocks
-codeBlockBody = try $ B.codeBlock . stripTrailingNewlines <$>
+codeBlockBody :: Monad m => ParserT Text ParserState m Blocks
+codeBlockBody = do
+ lang <- stateRstHighlight <$> getState
+ try $ B.codeBlockWith ("", maybeToList lang, []) . stripTrailingNewlines <$>
(indentedBlock <|> quotedBlock)
lhsCodeBlock :: Monad m => RSTParser m Blocks
@@ -716,6 +718,11 @@ directive' = do
case trim top of
"" -> stateRstDefaultRole def
role -> role })
+ "highlight" -> mempty <$ updateState (\s ->
+ s { stateRstHighlight =
+ case trim top of
+ "" -> stateRstHighlight def
+ lang -> Just lang })
x | x == "code" || x == "code-block" || x == "sourcecode" ->
codeblock name classes
(lookup "number-lines" fields) (trim top) body True
--
cgit v1.2.3