From 23ab5ffcb0b708e4f07cafd7a877926ce0dc532b Mon Sep 17 00:00:00 2001
From: John MacFarlane <fiddlosopher@gmail.com>
Date: Thu, 10 Jan 2013 20:22:18 -0800
Subject: Implemented Ext_header_attributes.

This allows explicit attributes to be put on headers, using
a syntax like that for code blocks:

  {#id .class .class k=v k=v}
---
 src/Text/Pandoc/Readers/Markdown.hs | 32 ++++++++++++++++++++------------
 1 file changed, 20 insertions(+), 12 deletions(-)

(limited to 'src/Text/Pandoc/Readers')

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
-- 
cgit v1.2.3