Org reader: parse parameter lists on unknown blocks.

The reader tries to parse the rest of the opening line of a block, e.g.,
`#+begin_myblock …`, as a parameters list. It first assumes that the parameters
are in lisp-style (`:key value`), then alternatively tries to read python-style
key-value pairs (`key=value`) and falls back to reading the entire remaining
line as a single `parameter` attribute.

This method is also applied to dynamic blocks.

Closes: #11188

1 files changed, 21 insertions, 8 deletions

diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 3a082dc2c..e95874ca8 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -189,7 +189,7 @@ orgBlock = try $ do
       "latex"     -> rawBlockLines (return . B.rawBlock (T.toLower blkType))
       "ascii"     -> rawBlockLines (return . B.rawBlock (T.toLower blkType))
       "example"   -> exampleBlock blockAttrs
-      "quote"     -> parseBlockLines (fmap B.blockQuote)
+      "quote"     -> \x -> ignHeaders *> parseBlockLines (fmap B.blockQuote) x
       "verse"     -> verseBlock
       "src"       -> codeBlock blockAttrs
       "note"      -> admonitionBlock "note" blockAttrs
@@ -201,9 +201,11 @@ orgBlock = try $ do
         -- case-sensitive checks
         case blkType of
           "abstract" -> metadataBlock
-          _ -> parseBlockLines $
-                   let (ident, classes, kv) = attrFromBlockAttributes blockAttrs
-                   in fmap $ B.divWith (ident, classes ++ [blkType], kv)
+          _ -> \bt -> do
+            params <- blockParameters
+            let (ident, classes, kv) = attrFromBlockAttributes blockAttrs
+                toDiv = (B.divWith (ident, classes ++ [blkType], kv <> params))
+            parseBlockLines (fmap toDiv) bt
  where
    blockHeaderStart :: Monad m => OrgParser m Text
    blockHeaderStart = try $ do
@@ -215,7 +217,7 @@ orgBlock = try $ do
 admonitionBlock :: PandocMonad m
                 => Text -> BlockAttributes -> Text -> OrgParser m (F Blocks)
 admonitionBlock blockType blockAttrs rawtext = do
-  bls <- parseBlockLines id rawtext
+  bls <- ignHeaders *> parseBlockLines id rawtext
   let id' = fromMaybe mempty $ blockAttrName blockAttrs
   pure $ fmap
     (B.divWith (id', [blockType], []) .
@@ -236,7 +238,7 @@ rawBlockLines :: Monad m => (Text   -> F Blocks) -> Text -> OrgParser m (F Block
 rawBlockLines f blockType = ignHeaders *> (f <$> rawBlockContent blockType)
 
 parseBlockLines :: PandocMonad m => (F Blocks -> F Blocks) -> Text -> OrgParser m (F Blocks)
-parseBlockLines f blockType = ignHeaders *> (f <$> parsedBlockContent)
+parseBlockLines f blockType = (f <$> parsedBlockContent)
  where
    parsedBlockContent :: PandocMonad m => OrgParser m (F Blocks)
    parsedBlockContent = try $ do
@@ -311,6 +313,7 @@ verseBlock blockType = try $ do
 -- metadata under a key of the same name.
 metadataBlock :: PandocMonad m => Text -> OrgParser m (F Blocks)
 metadataBlock blockType = try $ do
+  ignHeaders
   content <- parseBlockLines id blockType
   meta'   <- orgStateMeta <$> getState
   updateState $ \st ->
@@ -452,13 +455,23 @@ dynamicBlock :: PandocMonad m => OrgParser m (F Blocks)
 dynamicBlock = try $ do
   metaLineStart *> stringAnyCase "begin:" *> spaces
   blockname <- optionMaybe orgArgWord
-  ignHeaders
+  blockArgs <- blockParameters
   contents <- do
     raw <- rawBlockContent' $ metaLineStart *> stringAnyCase "end:"
     parseFromString blocks (raw <> "\n")
-  let attr = ("", maybe [] (:[]) blockname, [])
+  let attr = ("", maybe [] (:[]) blockname, blockArgs)
   return $ B.divWith attr <$> contents
 
+-- | Parse block arguments; in order, this tries to parse a Lisp-style
+-- argument list, a set of key-value pairs using /equals/, and as a
+-- fallback the whole line as a single /parameters/ argument.
+blockParameters :: PandocMonad m => OrgParser m [(Text, Text)]
+blockParameters = choice
+  [ try $ manyTill ((,) <$> orgArgKey <*> orgParamValue) newline
+  , try $ manyTill ((,) <$> (spaces *> orgArgWord <* char '=') <*> orgArgWord)
+                   newline
+  , (\x -> [ ("parameters", x) | not (T.null x)]) <$> (skipSpaces *> anyLine)
+  ]
 
 --
 -- Drawers