@@ -37,8 +37,9 @@ import Text.Pandoc.Error
3737import Text.Pandoc.Options
3838import qualified Text.Pandoc.Parsing as P
3939import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF
40− , newline, orderedListMarker
41− , parseFromString, blanklines
40+ , anyLine, blanklines, newline
41+ , orderedListMarker
42+ , parseFromString
4243 )
4344import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)
4445import Text.Pandoc.Readers.Org.ParserState
@@ -49,10 +50,10 @@ import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap
4950import Control.Arrow (first)
5051import Control.Monad (foldM, guard, mplus, mzero, when)
5152import Control.Monad.Reader ( Reader, runReader )
52−import Data.Char (isAlphaNum, isSpace, toLower)
53−import Data.List (intersperse, isPrefixOf, isSuffixOf)
53+import Data.Char (isAlphaNum, isSpace, toLower, toUpper)
54+import Data.List ( foldl', intersperse, isPrefixOf, isSuffixOf )
5455import qualified Data.Map as M
55−import Data.Maybe (fromMaybe, isJust)
56+import Data.Maybe ( fromMaybe, isNothing )
5657import Network.HTTP (urlEncode)
5758
5859
@@ -247,6 +248,12 @@ blanklines =
247248 <* updateLastPreCharPos
248249 <* updateLastForbiddenCharPos
249250
251+anyLine :: OrgParser String
252+anyLine =
253+ P.anyLine
254+ <* updateLastPreCharPos
255+ <* updateLastForbiddenCharPos
256+
250257-- | Succeeds when we're in list context.
251258inList :: OrgParser ()
252259inList = do
@@ -273,11 +280,9 @@ parseBlocks = mconcat <$> manyTill block eof
273280
274281block :: OrgParser (F Blocks)
275282block = choice [ mempty <$ blanklines
276− , optionalAttributes $ choice
277− [ orgBlock
278− , figure
279− , table
280− ]
283+ , table
284+ , orgBlock
285+ , figure
281286 , example
282287 , drawer
283288 , specialLine
@@ -289,50 +294,73 @@ block = choice [ mempty <$ blanklines
289294 , paraOrPlain
290295 ] <?> "block"
291296
297+
292298--
293299-- Block Attributes
294300--
295301
296−-- | Parse optional block attributes (like #+TITLE or #+NAME)
297−optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks)
298−optionalAttributes parser = try $
299− resetBlockAttributes *> parseBlockAttributes *> parser
302+-- | Attributes that may be added to figures (like a name or caption).
303+data BlockAttributes = BlockAttributes
304+ { blockAttrName :: Maybe String
305+ , blockAttrCaption :: Maybe (F Inlines)
306+ , blockAttrKeyValues :: [(String, String)]
307+ }
308+
309+stringyMetaAttribute :: (String -> Bool) -> OrgParser (String, String)
310+stringyMetaAttribute attrCheck = try $ do
311+ metaLineStart
312+ attrName <- map toUpper <$> many1Till nonspaceChar (char ':')
313+ guard $ attrCheck attrName
314+ skipSpaces
315+ attrValue <- anyLine
316+ return (attrName, attrValue)
317+
318+blockAttributes :: OrgParser BlockAttributes
319+blockAttributes = try $ do
320+ kv <- many (stringyMetaAttribute attrCheck)
321+ let caption = foldl' (appendValues "CAPTION") Nothing kv
322+ let kvAttrs = foldl' (appendValues "ATTR_HTML") Nothing kv
323+ let name = lookup "NAME" kv
324+ caption' <- maybe (return Nothing)
325+ (fmap Just . parseFromString parseInlines)
326+ caption
327+ kvAttrs' <- parseFromString keyValues . (++ "\n") $ fromMaybe mempty kvAttrs
328+ return $ BlockAttributes
329+ { blockAttrName = name
330+ , blockAttrCaption = caption'
331+ , blockAttrKeyValues = kvAttrs'
332+ }
300333 where
301− resetBlockAttributes :: OrgParser ()
302− resetBlockAttributes = updateState $ \s ->
303− s{ orgStateBlockAttributes = orgStateBlockAttributes def }
304−
305−parseBlockAttributes :: OrgParser ()
306−parseBlockAttributes = do
307− attrs <- many attribute
308− mapM_ (uncurry parseAndAddAttribute) attrs
334+ attrCheck :: String -> Bool
335+ attrCheck attr =
336+ case attr of
337+ "NAME" -> True
338+ "CAPTION" -> True
339+ "ATTR_HTML" -> True
340+ _ -> False
341+
342+ appendValues :: String -> Maybe String -> (String, String) -> Maybe String
343+ appendValues attrName accValue (key, value) =
344+ if key /= attrName
345+ then accValue
346+ else case accValue of
347+ Just acc -> Just $ acc ++ ' ':value
348+ Nothing -> Just value
349+
350+keyValues :: OrgParser [(String, String)]
351+keyValues = try $
352+ manyTill ((,) <$> key <*> value) newline
309353 where
310− attribute :: OrgParser (String, String)
311− attribute = try $ do
312− key <- metaLineStart *> many1Till nonspaceChar (char ':')
313− val <- skipSpaces *> anyLine
314− return (map toLower key, val)
315−
316−parseAndAddAttribute :: String -> String -> OrgParser ()
317−parseAndAddAttribute key value = do
318− let key' = map toLower key
319− () <$ addBlockAttribute key' value
320−
321−lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines))
322−lookupInlinesAttr attr = try $ do
323− val <- lookupBlockAttribute attr
324− maybe (return Nothing)
325− (fmap Just . parseFromString parseInlines)
326− val
327−
328−addBlockAttribute :: String -> String -> OrgParser ()
329−addBlockAttribute key val = updateState $ \s ->
330− let attrs = orgStateBlockAttributes s
331− in s{ orgStateBlockAttributes = M.insert key val attrs }
332−
333−lookupBlockAttribute :: String -> OrgParser (Maybe String)
334−lookupBlockAttribute key =
335− M.lookup key . orgStateBlockAttributes <$> getState
354+ key :: OrgParser String
355+ key = try $ skipSpaces *> char ':' *> many1 nonspaceChar
356+
357+ value :: OrgParser String
358+ value = skipSpaces *> manyTill anyChar endOfValue
359+
360+ endOfValue :: OrgParser ()
361+ endOfValue =
362+ lookAhead $ (() <$ try (many1 spaceChar <* key))
363+ <|> () <$ P.newline
336364
337365
338366--
@@ -346,6 +374,7 @@ updateIndent (_, blkType) indent = (indent, blkType)
346374
347375orgBlock :: OrgParser (F Blocks)
348376orgBlock = try $ do
377+ blockAttrs <- blockAttributes
349378 blockProp@(_, blkType) <- blockHeaderStart
350379 ($ blockProp) $
351380 case blkType of
@@ -356,7 +385,7 @@ orgBlock = try $ do
356385 "example" -> withRaw' (return . exampleCode)
357386 "quote" -> withParsed (fmap B.blockQuote)
358387 "verse" -> verseBlock
359− "src" -> codeBlock
388+ "src" -> codeBlock blockAttrs
360389 _ -> withParsed (fmap $ divWithClass blkType)
361390
362391blockHeaderStart :: OrgParser (Int, String)
@@ -410,20 +439,20 @@ followingResultsBlock =
410439 *> blankline
411440 *> block)
412441
413−codeBlock :: BlockProperties -> OrgParser (F Blocks)
414−codeBlock blkProp = do
442+codeBlock :: BlockAttributes -> BlockProperties -> OrgParser (F Blocks)
443+codeBlock blockAttrs blkProp = do
415444 skipSpaces
416445 (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)
417− id' <- fromMaybe "" <$> lookupBlockAttribute "name"
418446 leadingIndent <- lookAhead indentation
419447 content <- rawBlockContent (updateIndent blkProp leadingIndent)
420448 resultsContent <- followingResultsBlock
449+ let id' = fromMaybe mempty $ blockAttrName blockAttrs
421450 let includeCode = exportsCode kv
422451 let includeResults = exportsResults kv
423452 let codeBlck = B.codeBlockWith ( id', classes, kv ) content
424− labelledBlck <- maybe (pure codeBlck)
453+ let labelledBlck = maybe (pure codeBlck)
425454 (labelDiv codeBlck)
426− <$> lookupInlinesAttr "caption"
455+ (blockAttrCaption blockAttrs)
427456 let resultBlck = fromMaybe mempty resultsContent
428457 return $ (if includeCode then labelledBlck else mempty)
429458 <> (if includeResults then resultBlck else mempty)
@@ -579,47 +608,43 @@ drawerEnd = try $
579608-- Figures
580609--
581610
582−-- Figures (Image on a line by itself, preceded by name and/or caption)
611+-- | Figures (Image on a line by itself, preceded by name and/or caption)
583612figure :: OrgParser (F Blocks)
584613figure = try $ do
585− (cap, nam) <- nameAndCaption
614+ figAttrs <- blockAttributes
586615 src <- skipSpaces *> selfTarget <* skipSpaces <* P.newline
616+ guard . not . isNothing . blockAttrCaption $ figAttrs
587617 guard (isImageFilename src)
588− return $ do
589− cap' <- cap
590− return $ B.para $ B.image src nam cap'
618+ let figName = fromMaybe mempty $ blockAttrName figAttrs
619+ let figCaption = fromMaybe mempty $ blockAttrCaption figAttrs
620+ let figKeyVals = blockAttrKeyValues figAttrs
621+ let attr = (mempty, mempty, figKeyVals)
622+ return $ (B.para . B.imageWith attr src (withFigPrefix figName) <$> figCaption)
591623 where
592− nameAndCaption =
593− do
594− maybeCap <- lookupInlinesAttr "caption"
595− maybeNam <- lookupBlockAttribute "name"
596− guard $ isJust maybeCap || isJust maybeNam
597− return ( fromMaybe mempty maybeCap
598− , withFigPrefix $ fromMaybe mempty maybeNam )
599624 withFigPrefix cs =
600− if "fig:" `isPrefixOf` cs
601− then cs
602− else "fig:" ++ cs
625+ if "fig:" `isPrefixOf` cs
626+ then cs
627+ else "fig:" ++ cs
603628
604629--
605630-- Comments, Options and Metadata
631+--
606632specialLine :: OrgParser (F Blocks)
607633specialLine = fmap return . try $ metaLine <|> commentLine
608634
609635metaLine :: OrgParser Blocks
610−metaLine = try $ mempty
611− <$ (metaLineStart *> (optionLine <|> declarationLine))
612−
613−commentLine :: OrgParser Blocks
614−commentLine = try $ commentLineStart *> anyLine *> pure mempty
636+metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
615637
616638-- The order, in which blocks are tried, makes sure that we're not looking at
617639-- the beginning of a block, so we don't need to check for it
618−metaLineStart :: OrgParser String
619−metaLineStart = try $ mappend <$> many spaceChar <*> string "#+"
640+metaLineStart :: OrgParser ()
641+metaLineStart = try $ skipSpaces <* string "#+"
642+
643+commentLine :: OrgParser Blocks
644+commentLine = commentLineStart *> anyLine *> pure mempty
620645
621−commentLineStart :: OrgParser String
622−commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
646+commentLineStart :: OrgParser ()
647+commentLineStart = try $ skipSpaces <* string "# "
623648
624649declarationLine :: OrgParser ()
625650declarationLine = try $ do
@@ -738,11 +763,12 @@ data OrgTable = OrgTable
738763
739764table :: OrgParser (F Blocks)
740765table = try $ do
766+ blockAttrs <- blockAttributes
741767 lookAhead tableStart
742768 do
743769 rows <- tableRows
744− cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption"
745− return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows
770+ let caption = fromMaybe (return mempty) $ blockAttrCaption blockAttrs
771+ return $ (<$> caption) . orgToPandocTable . normalizeTable =<< rowsToTable rows
746772
747773orgToPandocTable :: OrgTable
748774 -> Inlines