diff options
-rw-r--r-- | src/Text/Pandoc/Readers/Org/Blocks.hs | 31 | ||||
-rw-r--r-- | tests/Tests/Readers/Org.hs | 9 |
2 files changed, 31 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)) diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 3aa38ff0c..1b536551c 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -1625,6 +1625,15 @@ tests = ] =?> rawBlock "html" "\n<span>boring</span>\n\n" + , "Accept `ATTR_HTML` attributes for generic block" =: + unlines [ "#+ATTR_HTML: :title hello, world :id test :class fun code" + , "#+BEGIN_TEST" + , "nonsense" + , "#+END_TEST" + ] =?> + let attr = ("test", ["fun", "code", "TEST"], [("title", "hello, world")]) + in divWith attr (para "nonsense") + , "Non-letter chars in source block parameters" =: unlines [ "#+BEGIN_SRC C :tangle xxxx.c :city Zürich" , "code body" |