diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Pandoc/Options.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 32 |
2 files changed, 22 insertions, 12 deletions
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index e64e7afda..b62187bfe 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -91,6 +91,7 @@ data Extension = | Ext_literate_haskell -- ^ Enable literate Haskell conventions | Ext_abbreviations -- ^ PHP markdown extra abbreviation definitions | Ext_auto_identifiers -- ^ Automatic identifiers for headers + | Ext_header_attributes -- ^ Explicit header attributes {#id .class k=v} | Ext_implicit_header_references -- ^ Implicit reference links for headers deriving (Show, Read, Enum, Eq, Ord, Bounded) @@ -129,6 +130,7 @@ pandocExtensions = Set.fromList , Ext_superscript , Ext_subscript , Ext_auto_identifiers + , Ext_header_attributes , Ext_implicit_header_references ] diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 5ff196571..37f12c2e0 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -373,40 +373,48 @@ header :: MarkdownParser (F Blocks) header = setextHeader <|> atxHeader <?> "header" -- returns unique identifier -addToHeaderList :: F Inlines -> MarkdownParser String -addToHeaderList text = do +addToHeaderList :: Attr -> F Inlines -> MarkdownParser Attr +addToHeaderList (ident,classes,kvs) text = do let headerList = B.toList $ runF text defaultParserState updateState $ \st -> st{ stateHeaders = headerList : stateHeaders st } (do guardEnabled Ext_auto_identifiers ids <- stateIdentifiers `fmap` getState - let id' = uniqueIdent headerList ids + let id' = if null ident + then uniqueIdent headerList ids + else ident updateState $ \st -> st{ stateIdentifiers = id' : ids } - return id') <|> return "" + return (id',classes,kvs)) <|> return ("",classes,kvs) atxHeader :: MarkdownParser (F Blocks) atxHeader = try $ do level <- many1 (char '#') >>= return . length notFollowedBy (char '.' <|> char ')') -- this would be a list skipSpaces - text <- trimInlinesF . mconcat <$> manyTill inline atxClosing - id' <- addToHeaderList text - return $ B.headerWith (id',[],[]) level <$> text + text <- trimInlinesF . mconcat <$> many (notFollowedBy atxClosing >> inline) + attr <- atxClosing + attr' <- addToHeaderList attr text + return $ B.headerWith attr' level <$> text -atxClosing :: Parser [Char] st String -atxClosing = try $ skipMany (char '#') >> blanklines +atxClosing :: Parser [Char] st Attr +atxClosing = + try $ skipMany (char '#') >> skipSpaces >> option nullAttr attributes <* blanklines + +setextHeaderEnd :: MarkdownParser Attr +setextHeaderEnd = try $ option nullAttr attributes <* blankline setextHeader :: MarkdownParser (F Blocks) setextHeader = try $ do -- This lookahead prevents us from wasting time parsing Inlines -- unless necessary -- it gives a significant performance boost. lookAhead $ anyLine >> many1 (oneOf setextHChars) >> blankline - text <- trimInlinesF . mconcat <$> many1Till inline newline + text <- trimInlinesF . mconcat <$> many1 (notFollowedBy setextHeaderEnd >> inline) + attr <- setextHeaderEnd underlineChar <- oneOf setextHChars many (char underlineChar) blanklines let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1 - id' <- addToHeaderList text - return $ B.headerWith (id',[],[]) level <$> text + attr' <- addToHeaderList attr text + return $ B.headerWith attr' level <$> text -- -- hrule block |