Improved syntax for markdown definition lists.

Definition lists are now more compatible with PHP Markdown Extra.
Resolves Issue #24.

+ You can have multiple definitions for a term (but still not
  multiple terms).
+ Multi-block definitions no longer need a
  column before each block (indeed, this will now cause
  multiple definitions).
+ The marker no longer needs to be flush with the left margin,
  but can be indented at or two spaces.  Also, ~ as well as :
  can be used as the marker (this suggestion due to David
  Wheeler.)
+ There can now be a blank line between the term and
  the definitions.

git-svn-id: https://pandoc.googlecode.com/svn/trunk@1656 788f1e2b-df1e-0410-8736-df70ead52e1b

1 files changed, 36 insertions, 13 deletions

diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index dc556d24f..0de700537 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -555,38 +555,61 @@ bulletList = try $ do
 
 -- definition lists
 
-definitionListItem :: GenParser Char ParserState ([Inline], [Block])
+defListMarker :: GenParser Char ParserState ()
+defListMarker = do
+  sps <- nonindentSpaces
+  char ':' <|> char '~'
+  st <- getState
+  let tabStop = stateTabStop st
+  let remaining = tabStop - (length sps + 1)
+  if remaining > 0
+     then count remaining (char ' ') <|> string "\t"
+     else pzero
+  return ()
+
+definitionListItem :: GenParser Char ParserState ([Inline], [[Block]])
 definitionListItem = try $ do
-  notFollowedBy blankline
-  notFollowedBy' indentSpaces
   -- first, see if this has any chance of being a definition list:
-  lookAhead (anyLine >> char ':')
+  lookAhead (anyLine >> optional blankline >> defListMarker)
   term <- manyTill inline newline
+  optional blankline
   raw <- many1 defRawBlock
   state <- getState
   let oldContext = stateParserContext state
   -- parse the extracted block, which may contain various block elements:
-  contents <- parseFromString parseBlocks $ concat raw
+  contents <- mapM (parseFromString parseBlocks) raw
   updateState (\st -> st {stateParserContext = oldContext})
   return ((normalizeSpaces term), contents)
 
 defRawBlock :: GenParser Char ParserState [Char]
 defRawBlock = try $ do
-  char ':'
-  state <- getState
-  let tabStop = stateTabStop state
-  try (count (tabStop - 1) (char ' ')) <|> (many (char ' ') >> string "\t")
+  defListMarker
   firstline <- anyLine
   rawlines <- many (notFollowedBy blankline >> indentSpaces >> anyLine)
   trailing <- option "" blanklines
-  return $ firstline ++ "\n" ++ unlines rawlines ++ trailing
+  cont <- liftM concat $ many $ do
+            lns <- many1 $ notFollowedBy blankline >> indentSpaces >> anyLine
+            trl <- option "" blanklines
+            return $ unlines lns ++ trl
+  return $ firstline ++ "\n" ++ unlines rawlines ++ trailing ++ cont
 
 definitionList :: GenParser Char ParserState Block
 definitionList = do
   items <- many1 definitionListItem
-  let (terms, defs) = unzip items
-  let defs' = compactify defs
-  let items' = zip terms defs'
+  -- "compactify" the definition list:
+  let defs = map snd items
+  let defBlocks = reverse $ concat $ concat defs
+  let isPara (Para _) = True
+      isPara _        = False
+  let items' = case take 1 defBlocks of
+                [Para x]   -> if not $ any isPara (drop 1 defBlocks)
+                                 then let (t,ds) = last items
+                                          lastDef = last ds
+                                          ds' = init ds ++
+                                                [init lastDef ++ [Plain x]]
+                                       in init items ++ [(t, ds')]
+                                 else items
+                _          -> items
   return $ DefinitionList items'
 
 --