aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
authorAlbert Krewinkel <albert@zeitkraut.de>2016-10-30 20:23:53 +0100
committerAlbert Krewinkel <albert@zeitkraut.de>2016-10-30 20:23:53 +0100
commit4f06e6c4455b5b6be21416e9736a70f8d2b1ff1c (patch)
tree1ec45c3e3a11a67b8cd8ae35373bf3c9f6ae47e3 /src/Text/Pandoc
parent63bdc5d08f81365db15b1d9ae11c1d6af72ae35e (diff)
downloadpandoc-4f06e6c4455b5b6be21416e9736a70f8d2b1ff1c.tar.gz
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
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs31
1 files changed, 22 insertions, 9 deletions
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))