From 4f06e6c4455b5b6be21416e9736a70f8d2b1ff1c Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sun, 30 Oct 2016 20:23:53 +0100
Subject: Org reader: support `ATTR_HTML` for special blocks
Special blocks (i.e. blocks with unrecognized names) can be prefixed
with an `ATTR_HTML` block attribute. The attributes defined in that
meta-directive are added to the `Div` which is used to represent the
special block.
Closes: #3182
---
src/Text/Pandoc/Readers/Org/Blocks.hs | 31 ++++++++++++++++++++++---------
1 file changed, 22 insertions(+), 9 deletions(-)
(limited to 'src')
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index a5957dbc9..d42e93d78 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -294,6 +294,17 @@ data BlockAttributes = BlockAttributes
, blockAttrKeyValues :: [(String, String)]
}
+-- | Convert BlockAttributes into pandoc Attr
+attrFromBlockAttributes :: BlockAttributes -> Attr
+attrFromBlockAttributes (BlockAttributes{..}) =
+ let
+ ident = fromMaybe mempty $ lookup "id" blockAttrKeyValues
+ classes = case lookup "class" blockAttrKeyValues of
+ Nothing -> []
+ Just clsStr -> words clsStr
+ kv = filter ((`notElem` ["id", "class"]) . fst) blockAttrKeyValues
+ in (ident, classes, kv)
+
stringyMetaAttribute :: (String -> Bool) -> OrgParser (String, String)
stringyMetaAttribute attrCheck = try $ do
metaLineStart
@@ -364,23 +375,25 @@ orgBlock = try $ do
blockAttrs <- blockAttributes
blkType <- blockHeaderStart
($ blkType) $
- case blkType of
+ case (map toLower blkType) of
"export" -> exportBlock
"comment" -> rawBlockLines (const mempty)
- "html" -> rawBlockLines (return . (B.rawBlock blkType))
- "latex" -> rawBlockLines (return . (B.rawBlock blkType))
- "ascii" -> rawBlockLines (return . (B.rawBlock blkType))
+ "html" -> rawBlockLines (return . B.rawBlock (lowercase blkType))
+ "latex" -> rawBlockLines (return . B.rawBlock (lowercase blkType))
+ "ascii" -> rawBlockLines (return . B.rawBlock (lowercase blkType))
"example" -> rawBlockLines (return . exampleCode)
"quote" -> parseBlockLines (fmap B.blockQuote)
"verse" -> verseBlock
"src" -> codeBlock blockAttrs
- _ -> parseBlockLines (fmap $ B.divWith (mempty, [blkType], mempty))
+ _ -> parseBlockLines $
+ let (ident, classes, kv) = attrFromBlockAttributes blockAttrs
+ in fmap $ B.divWith (ident, classes ++ [blkType], kv)
where
blockHeaderStart :: OrgParser String
- blockHeaderStart = try $ do
- skipSpaces
- blockType <- stringAnyCase "#+begin_" *> orgArgWord
- return (map toLower blockType)
+ blockHeaderStart = try $ skipSpaces *> stringAnyCase "#+begin_" *> orgArgWord
+
+ lowercase :: String -> String
+ lowercase = map toLower
rawBlockLines :: (String -> F Blocks) -> String -> OrgParser (F Blocks)
rawBlockLines f blockType = (ignHeaders *> (f <$> rawBlockContent blockType))
--
cgit v1.2.3