pandoc: Fix textile writer for Redmine.

pandoc-fix-textile-writer-for-redmine.patch

diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs
index 98f9157..8e086e1 100644
--- a/src/Text/Pandoc/Writers/Textile.hs
+++ b/src/Text/Pandoc/Writers/Textile.hs
@@ -40,13 +40,13 @@ import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.XML ( escapeStringForXML )
 import Data.List ( intercalate )
 import Control.Monad.State
-import Data.Char ( isSpace )
 
 data WriterState = WriterState {
-    stNotes     :: [String]        -- Footnotes
-  , stListLevel :: [Char]          -- String at beginning of list items, e.g. "**"
-  , stStartNum  :: Maybe Int       -- Start number if first list item
-  , stUseTags   :: Bool            -- True if we should use HTML tags because we're in a complex list
+    stNotes          :: [String]        -- Footnotes
+  , stListLevel      :: [Char]          -- String at beginning of list items, e.g. "**"
+  , stStartNum       :: Maybe Int       -- Start number if first list item
+  , stUseTags        :: Bool            -- True if we should use HTML tags because we're in a complex list
+  , stIsInBlockQuote :: Bool            -- True if in a blockquote
   }
 
 -- | Convert Pandoc to Textile.
@@ -54,7 +54,7 @@ writeTextile :: WriterOptions -> Pandoc -> String
 writeTextile opts document =
   evalState (pandocToTextile opts document)
             WriterState { stNotes = [], stListLevel = [], stStartNum = Nothing,
-                          stUseTags = False }
+                          stUseTags = False, stIsInBlockQuote = False }
 
 -- | Return Textile representation of document.
 pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String
@@ -77,6 +77,14 @@ withUseTags action = do
   modify $ \s -> s { stUseTags = oldUseTags }
   return result
 
+withInBlockQuote :: State WriterState a -> State WriterState a
+withInBlockQuote action = do
+  oldIsInBlockQuote <- liftM stIsInBlockQuote get
+  modify $ \s -> s { stIsInBlockQuote = True }
+  result <- action
+  modify $ \s -> s { stIsInBlockQuote = oldIsInBlockQuote }
+  return result
+
 -- | Escape one character as needed for Textile.
 escapeCharForTextile :: Char -> String
 escapeCharForTextile x = case x of
@@ -125,16 +133,18 @@ blockToTextile opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
 blockToTextile opts (Para inlines) = do
   useTags <- liftM stUseTags get
   listLevel <- liftM stListLevel get
+  isInBlockQuote <- liftM stIsInBlockQuote get
   contents <- inlineListToTextile opts inlines
+  let newline = if isInBlockQuote then "\n" else ""
   return $ if useTags
               then "<p>" ++ contents ++ "</p>"
-              else contents ++ if null listLevel then "\n" else ""
+              else contents ++ if null listLevel then "\n" else newline
 
 blockToTextile _ (RawBlock f str)
   | f == Format "html" || f == Format "textile" = return str
   | otherwise                                   = return ""
 
-blockToTextile _ HorizontalRule = return "<hr />\n"
+blockToTextile _ HorizontalRule = return "---\n"
 
 blockToTextile opts (Header level (ident,classes,keyvals) inlines) = do
   contents <- inlineListToTextile opts inlines
@@ -147,31 +157,29 @@ blockToTextile opts (Header level (ident,classes,keyvals) inlines) = do
   let prefix = 'h' : show level ++ attribs ++ styles ++ lang ++ ". "
   return $ prefix ++ contents ++ "\n"
 
-blockToTextile _ (CodeBlock (_,classes,_) str) | any (all isSpace) (lines str) =
-  return $ "<pre"  ++ classes' ++ ">\n" ++ escapeStringForXML str ++
-           "\n</pre>\n"
-    where classes' = if null classes
-                        then ""
-                        else " class=\"" ++ unwords classes ++ "\""
-
-blockToTextile _ (CodeBlock (_,classes,_) str) =
-  return $ "bc" ++ classes' ++ ". " ++ str ++ "\n\n"
-    where classes' = if null classes
-                        then ""
-                        else "(" ++ unwords classes ++ ")"
-
-blockToTextile opts (BlockQuote bs@[Para _]) = do
-  contents <- blockListToTextile opts bs
-  return $ "bq. " ++ contents ++ "\n\n"
+blockToTextile _ (CodeBlock (_,classes,_) str) = do
+  marker <- gets stListLevel
+  let classes' = if null classes
+                    then ""
+                    else " class=\"" ++ unwords classes ++ "\""
+  return $ "<pre><code"  ++ classes' ++ ">\n" ++ str ++
+           "\n</code></pre>" ++ (if null marker then "\n" else "")
 
 blockToTextile opts (BlockQuote blocks) = do
-  contents <- blockListToTextile opts blocks
-  return $ "<blockquote>\n\n" ++ contents ++ "\n</blockquote>\n"
+  contents <- withInBlockQuote $ blockListToTextile opts blocks
+  marker <- gets stListLevel
+  let keepEmptyLine s = if null s then "&nbsp;" else s
+  let contents' = unlines $ map keepEmptyLine $ lines contents
+  return $ if marker /= ""
+              then "\n bq. " ++ init contents'
+              else "bq. " ++ contents'
 
 blockToTextile opts (Table [] aligns widths headers rows') |
          all (==0) widths = do
   hs <- mapM (liftM (("_. " ++) . stripTrailingNewlines) . blockListToTextile opts) headers
-  let cellsToRow cells = "|" ++ intercalate "|" cells ++ "|"
+  marker <- gets stListLevel
+  let isInList = marker /= ""
+  let cellsToRow cells = (if isInList then " " else "") ++ "|" ++ intercalate "|" cells ++ "|"
   let header = if all null headers then "" else cellsToRow hs ++ "\n"
   let blocksToCell (align, bs) = do
         contents <- stripTrailingNewlines <$> blockListToTextile opts bs
@@ -184,7 +192,9 @@ blockToTextile opts (Table [] aligns widths headers rows') |
   let rowToCells = mapM blocksToCell . zip aligns
   bs <- mapM rowToCells rows'
   let body = unlines $ map cellsToRow bs
-  return $ header ++ body
+  return $ if isInList
+              then init $ "\n" ++ header ++ body
+              else header ++ body
 
 blockToTextile opts (Table capt aligns widths headers rows') = do
   let alignStrings = map alignmentToString aligns
@@ -207,38 +217,23 @@ blockToTextile opts (Table capt aligns widths headers rows') = do
   return $ "<table>\n" ++ captionDoc ++ coltags ++ head' ++
             "<tbody>\n" ++ unlines body' ++ "</tbody>\n</table>\n"
 
-blockToTextile opts x@(BulletList items) = do
-  oldUseTags <- liftM stUseTags get
-  let useTags = oldUseTags || not (isSimpleList x)
-  if useTags
-     then do
-        contents <- withUseTags $ mapM (listItemToTextile opts) items
-        return $ "<ul>\n" ++ vcat contents ++ "\n</ul>\n"
-     else do
-        modify $ \s -> s { stListLevel = stListLevel s ++ "*" }
-        level <- get >>= return . length . stListLevel
-        contents <- mapM (listItemToTextile opts) items
-        modify $ \s -> s { stListLevel = init (stListLevel s) }
-        return $ vcat contents ++ (if level > 1 then "" else "\n")
-
-blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do
-  oldUseTags <- liftM stUseTags get
-  let useTags = oldUseTags || not (isSimpleList x)
-  if useTags
-     then do
-        contents <- withUseTags $ mapM (listItemToTextile opts) items
-        return $ "<ol" ++ listAttribsToString attribs ++ ">\n" ++ vcat contents ++
-                   "\n</ol>\n"
-     else do
-        modify $ \s -> s { stListLevel = stListLevel s ++ "#"
-                         , stStartNum = if start > 1
-                                           then Just start
-                                           else Nothing }
-        level <- get >>= return . length . stListLevel
-        contents <- mapM (listItemToTextile opts) items
-        modify $ \s -> s { stListLevel = init (stListLevel s),
-                           stStartNum = Nothing }
-        return $ vcat contents ++ (if level > 1 then "" else "\n")
+blockToTextile opts (BulletList items) = do
+  modify $ \s -> s { stListLevel = stListLevel s ++ "*" }
+  level <- get >>= return . length . stListLevel
+  contents <- mapM (listItemToTextile opts) items
+  modify $ \s -> s { stListLevel = init (stListLevel s) }
+  return $ vcat contents ++ (if level > 1 then "" else "\n")
+
+blockToTextile opts (OrderedList (start, _, _) items) = do
+  modify $ \s -> s { stListLevel = stListLevel s ++ "#"
+                   , stStartNum = if start > 1
+                                     then Just start
+                                     else Nothing }
+  level <- get >>= return . length . stListLevel
+  contents <- mapM (listItemToTextile opts) items
+  modify $ \s -> s { stListLevel = init (stListLevel s),
+                     stStartNum = Nothing }
+  return $ vcat contents ++ (if level > 1 then "" else "\n")
 
 blockToTextile opts (DefinitionList items) = do
   contents <- withUseTags $ mapM (definitionListItemToTextile opts) items
@@ -246,32 +241,17 @@ blockToTextile opts (DefinitionList items) = do
 
 -- Auxiliary functions for lists:
 
--- | Convert ordered list attributes to HTML attribute string
-listAttribsToString :: ListAttributes -> String
-listAttribsToString (startnum, numstyle, _) =
-  let numstyle' = camelCaseToHyphenated $ show numstyle
-  in  (if startnum /= 1
-          then " start=\"" ++ show startnum ++ "\""
-          else "") ++
-      (if numstyle /= DefaultStyle
-          then " style=\"list-style-type: " ++ numstyle' ++ ";\""
-          else "")
-
 -- | Convert bullet or ordered list item (list of blocks) to Textile.
 listItemToTextile :: WriterOptions -> [Block] -> State WriterState String
 listItemToTextile opts items = do
   contents <- blockListToTextile opts items
-  useTags <- get >>= return . stUseTags
-  if useTags
-     then return $ "<li>" ++ contents ++ "</li>"
-     else do
-       marker <- gets stListLevel
-       mbstart <- gets stStartNum
-       case mbstart of
-            Just n -> do
-              modify $ \s -> s{ stStartNum = Nothing }
-              return $ marker ++ show n ++ " " ++ contents
-            Nothing -> return $ marker ++ " " ++ contents
+  marker <- gets stListLevel
+  mbstart <- gets stStartNum
+  case mbstart of
+       Just n -> do
+         modify $ \s -> s{ stStartNum = Nothing }
+         return $ marker ++ show n ++ " " ++ contents
+       Nothing -> return $ marker ++ " " ++ contents
 
 -- | Convert definition list item (label, list of blocks) to Textile.
 definitionListItemToTextile :: WriterOptions
@@ -283,38 +263,6 @@ definitionListItemToTextile opts (label, items) = do
   return $ "<dt>" ++ labelText ++ "</dt>\n" ++
           (intercalate "\n" $ map (\d -> "<dd>" ++ d ++ "</dd>") contents)
 
--- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed.
-isSimpleList :: Block -> Bool
-isSimpleList x =
-  case x of
-       BulletList items                 -> all isSimpleListItem items
-       OrderedList (_, sty, _) items    -> all isSimpleListItem items &&
-                                            sty `elem` [DefaultStyle, Decimal]
-       _                                -> False
-
--- | True if list item can be handled with the simple wiki syntax.  False if
---   HTML tags will be needed.
-isSimpleListItem :: [Block] -> Bool
-isSimpleListItem []  = True
-isSimpleListItem [x] =
-  case x of
-       Plain _           -> True
-       Para  _           -> True
-       BulletList _      -> isSimpleList x
-       OrderedList _ _   -> isSimpleList x
-       _                 -> False
-isSimpleListItem [x, y] | isPlainOrPara x =
-  case y of
-       BulletList _      -> isSimpleList y
-       OrderedList _ _   -> isSimpleList y
-       _                 -> False
-isSimpleListItem _ = False
-
-isPlainOrPara :: Block -> Bool
-isPlainOrPara (Plain _) = True
-isPlainOrPara (Para  _) = True
-isPlainOrPara _         = False
-
 -- | Concatenates strings with line breaks between them.
 vcat :: [String] -> String
 vcat = intercalate "\n"
@@ -418,7 +366,7 @@ inlineToTextile opts (Cite _  lst) = inlineListToTextile opts lst
 
 inlineToTextile _ (Code _ str) =
   return $ if '@' `elem` str
-           then "<tt>" ++ escapeStringForXML str ++ "</tt>"
+           then "%{font-family: monospace}" ++ escapeStringForXML str ++ "%"
            else "@" ++ str ++ "@"
 
 inlineToTextile _ (Str str) = return $ escapeStringForTextile str
@@ -444,9 +392,9 @@ inlineToTextile opts (Link (_, cls, _) txt (src, _)) = do
                    else "(" ++ unwords cls ++ ")"
   label <- case txt of
                 [Code _ s]
-                 | s == src -> return "$"
+                 | s == src -> return src
                 [Str s]
-                 | s == src -> return "$"
+                 | s == src -> return src
                 _           -> inlineListToTextile opts txt
   return $ "\"" ++ classes ++ label ++ "\":" ++ src