aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs38
-rw-r--r--src/Text/Pandoc/Readers/Org/Meta.hs6
-rw-r--r--test/command/3706.md44
3 files changed, 66 insertions, 22 deletions
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 88ecbacd3..b650721b3 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -122,18 +122,18 @@ attrFromBlockAttributes (BlockAttributes{..}) =
kv = filter ((`notElem` ["id", "class"]) . fst) blockAttrKeyValues
in (ident, classes, kv)
-stringyMetaAttribute :: Monad m => (String -> Bool) -> OrgParser m (String, String)
-stringyMetaAttribute attrCheck = try $ do
+stringyMetaAttribute :: Monad m => OrgParser m (String, String)
+stringyMetaAttribute = try $ do
metaLineStart
attrName <- map toUpper <$> many1Till nonspaceChar (char ':')
- guard $ attrCheck attrName
skipSpaces
- attrValue <- anyLine
+ attrValue <- anyLine <|> ("" <$ newline)
return (attrName, attrValue)
blockAttributes :: PandocMonad m => OrgParser m BlockAttributes
blockAttributes = try $ do
- kv <- many (stringyMetaAttribute attrCheck)
+ kv <- many stringyMetaAttribute
+ guard $ all (attrCheck . fst) kv
let caption = foldl' (appendValues "CAPTION") Nothing kv
let kvAttrs = foldl' (appendValues "ATTR_HTML") Nothing kv
let name = lookup "NAME" kv
@@ -150,13 +150,7 @@ blockAttributes = try $ do
}
where
attrCheck :: String -> Bool
- attrCheck attr =
- case attr of
- "NAME" -> True
- "LABEL" -> True
- "CAPTION" -> True
- "ATTR_HTML" -> True
- _ -> False
+ attrCheck x = x `elem` ["NAME", "LABEL", "CAPTION", "ATTR_HTML", "RESULTS"]
appendValues :: String -> Maybe String -> (String, String) -> Maybe String
appendValues attrName accValue (key, value) =
@@ -166,6 +160,7 @@ blockAttributes = try $ do
Just acc -> Just $ acc ++ ' ':value
Nothing -> Just value
+-- | Parse key-value pairs for HTML attributes
keyValues :: Monad m => OrgParser m [(String, String)]
keyValues = try $
manyTill ((,) <$> key <*> value) newline
@@ -301,16 +296,15 @@ codeBlock blockAttrs blockType = do
skipSpaces
(classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)
content <- rawBlockContent blockType
- resultsContent <- trailingResultsBlock
+ resultsContent <- option mempty babelResultsBlock
let id' = fromMaybe mempty $ blockAttrName blockAttrs
let codeBlck = B.codeBlockWith ( id', classes, kv ) content
let labelledBlck = maybe (pure codeBlck)
(labelDiv codeBlck)
(blockAttrCaption blockAttrs)
- let resultBlck = fromMaybe mempty resultsContent
return $
- (if exportsCode kv then labelledBlck else mempty) <>
- (if exportsResults kv then resultBlck else mempty)
+ (if exportsCode kv then labelledBlck else mempty) <>
+ (if exportsResults kv then resultsContent else mempty)
where
labelDiv :: Blocks -> F Inlines -> F Blocks
labelDiv blk value =
@@ -325,12 +319,16 @@ codeBlock blockAttrs blockType = do
exportsResults :: [(String, String)] -> Bool
exportsResults = maybe False (`elem` ["results", "both"]) . lookup "exports"
-trailingResultsBlock :: PandocMonad m => OrgParser m (Maybe (F Blocks))
-trailingResultsBlock = optionMaybe . try $ do
+-- | Parse the result of an evaluated babel code block.
+babelResultsBlock :: PandocMonad m => OrgParser m (F Blocks)
+babelResultsBlock = try $ do
blanklines
- stringAnyCase "#+RESULTS:"
- blankline
+ resultsMarker <|>
+ (lookAhead . void . try $
+ manyTill (metaLineStart *> anyLineNewline) resultsMarker)
block
+ where
+ resultsMarker = try . void $ stringAnyCase "#+RESULTS:" *> blankline
-- | Parse code block arguments
codeHeaderArgs :: Monad m => OrgParser m ([String], [(String, String)])
diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs
index 5dc742403..33c212bca 100644
--- a/src/Text/Pandoc/Readers/Org/Meta.hs
+++ b/src/Text/Pandoc/Readers/Org/Meta.hs
@@ -44,7 +44,7 @@ import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Definition
-import Control.Monad (mzero, void)
+import Control.Monad (mzero, void, when)
import Data.Char (toLower)
import Data.List (intersperse)
import qualified Data.Map as M
@@ -75,7 +75,9 @@ declarationLine :: PandocMonad m => OrgParser m ()
declarationLine = try $ do
key <- map toLower <$> metaKey
(key', value) <- metaValue key
- updateState $ \st -> st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
+ when (key' /= "results") $
+ updateState $ \st ->
+ st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
metaKey :: Monad m => OrgParser m String
metaKey = map toLower <$> many1 (noneOf ": \n\r")
diff --git a/test/command/3706.md b/test/command/3706.md
new file mode 100644
index 000000000..00f53279e
--- /dev/null
+++ b/test/command/3706.md
@@ -0,0 +1,44 @@
+Results marker can be hidden in block attributes (#3706)
+
+```
+pandoc -f org -t native
+#+BEGIN_SRC R :exports results :colnames yes
+ data.frame(Id = 1:3, Desc = rep("La",3))
+#+END_SRC
+
+#+CAPTION: Lalelu.
+#+LABEL: tab
+#+RESULTS:
+| Id | Desc |
+|----+------|
+| 1 | La |
+| 2 | La |
+| 3 | La |
+^D
+[Table [Str "Lalelu."] [AlignDefault,AlignDefault] [0.0,0.0]
+ [[Plain [Str "Id"]]
+ ,[Plain [Str "Desc"]]]
+ [[[Plain [Str "1"]]
+ ,[Plain [Str "La"]]]
+ ,[[Plain [Str "2"]]
+ ,[Plain [Str "La"]]]
+ ,[[Plain [Str "3"]]
+ ,[Plain [Str "La"]]]]]
+```
+
+```
+pandoc -f org -t native
+#+BEGIN_SRC R :exports none :colnames yes
+ data.frame(Id = 1:2, Desc = rep("La",2))
+#+END_SRC
+
+#+CAPTION: Lalelu.
+#+LABEL: tab
+#+RESULTS:
+| Id | Desc |
+|----+------|
+| 1 | La |
+| 2 | La |
+^D
+[]
+```