Texinfo writer: Updated to use Pretty.

src/Text/Pandoc/Writers/Texinfo.hs

@@ -31,13 +31,12 @@ module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Shared
 import Text.Pandoc.Templates (renderTemplate)
-import Text.Pandoc.Readers.TeXMath
 import Text.Printf ( printf )
-import Data.List ( isSuffixOf, transpose, maximumBy )
+import Data.List ( transpose, maximumBy )
 import Data.Ord ( comparing )
 import Data.Char ( chr, ord )
 import Control.Monad.State
-import Text.PrettyPrint.HughesPJ hiding ( Str )
+import Text.Pandoc.Pretty
 
 data WriterState = 
   WriterState { stStrikeout   :: Bool  -- document contains strikeout
@@ -69,17 +68,20 @@ pandocToTexinfo options (Pandoc (Meta title authors date) blocks) = do
   let titlePage = not $ all null $ title : date : authors
   main <- blockListToTexinfo blocks
   st <- get
-  let body = render main
+  let colwidth = if writerWrapText options
+                    then Just $ writerColumns options
+                    else Nothing
+  let body = render colwidth main
   let context = writerVariables options ++
                 [ ("body", body)
-                , ("title", render titleText)
+                , ("title", render colwidth titleText)
-                , ("date", render dateText) ] ++
+                , ("date", render colwidth dateText) ] ++
                 [ ("toc", "yes") | writerTableOfContents options ] ++
                 [ ("titlepage", "yes") | titlePage ] ++
                 [ ("subscript", "yes") | stSubscript st ] ++
                 [ ("superscript", "yes") | stSuperscript st ] ++
                 [ ("strikeout", "yes") | stStrikeout st ] ++
-                [ ("author", render a) | a <- authorsText ]
+                [ ("author", render colwidth a) | a <- authorsText ]
   if writerStandalone options
      then return $ renderTemplate context $ writerTemplate options
      else return body
@@ -124,8 +126,8 @@ blockToTexinfo (BlockQuote lst) = do
 
 blockToTexinfo (CodeBlock _ str) = do
   return $ text "@verbatim" $$
-           vcat (map text (lines str)) $$
+           flush (text str) $$
-           text "@end verbatim\n"
+           text "@end verbatim" <> blankline
 
 blockToTexinfo (RawHtml _) = return empty
 
@@ -133,13 +135,13 @@ blockToTexinfo (BulletList lst) = do
   items <- mapM listItemToTexinfo lst
   return $ text "@itemize" $$
            vcat items $$
-           text "@end itemize\n"
+           text "@end itemize" <> blankline
 
 blockToTexinfo (OrderedList (start, numstyle, _) lst) = do
   items <- mapM listItemToTexinfo lst
   return $ text "@enumerate " <> exemplar $$
            vcat items $$
-           text "@end enumerate\n"
+           text "@end enumerate" <> blankline
   where
     exemplar = case numstyle of
                 DefaultStyle -> decimal
@@ -159,7 +161,7 @@ blockToTexinfo (DefinitionList lst) = do
   items <- mapM defListItemToTexinfo lst
   return $ text "@table @asis" $$
            vcat items $$
-           text "@end table\n"
+           text "@end table" <> blankline
 
 blockToTexinfo HorizontalRule =
     -- XXX can't get the equivalent from LaTeX.hs to work
@@ -175,13 +177,13 @@ blockToTexinfo (Header 0 lst) = do
             then return $ text "Top"
             else inlineListToTexinfo lst
   return $ text "@node Top" $$
-           text "@top " <> txt <> char '\n'
+           text "@top " <> txt <> blankline
 
 blockToTexinfo (Header level lst) = do
   node <- inlineListForNode lst
   txt <- inlineListToTexinfo lst
   return $ if (level > 0) && (level <= 4)
-              then text "\n@node " <> node <> char '\n' <>
+              then blankline <> text "@node " <> node <> cr <>
                    text (seccmd level) <> txt
               else txt
   where
@@ -200,8 +202,8 @@ blockToTexinfo (Table caption aligns widths heads rows) = do
   colDescriptors <-
     if all (== 0) widths
        then do -- use longest entry instead of column widths
-            cols <- mapM (mapM (liftM (render . hcat) . mapM blockToTexinfo)) $
+            cols <- mapM (mapM (liftM (render Nothing . hcat) . mapM blockToTexinfo)) $
-                       transpose $ heads : rows
+                        transpose $ heads : rows
             return $ concatMap ((\x -> "{"++x++"} ") .  maximumBy (comparing length)) cols
        else return $ "@columnfractions " ++ concatMap (printf "%.2f ") widths
   let tableBody = text ("@multitable " ++ colDescriptors) $$
@@ -209,7 +211,7 @@ blockToTexinfo (Table caption aligns widths heads rows) = do
                   vcat rowsText $$ 
                   text "@end multitable"
   return $ if isEmpty captionText
-              then tableBody <> char '\n'
+              then tableBody <> blankline
               else text "@float" $$
                    tableBody $$
                    inCmd "caption" captionText $$
@@ -253,7 +255,7 @@ alignedBlock _ col = blockListToTexinfo col
 -- | Convert Pandoc block elements to Texinfo.
 blockListToTexinfo :: [Block]
                    -> State WriterState Doc
-blockListToTexinfo [] = return $ empty
+blockListToTexinfo [] = return empty
 blockListToTexinfo (x:xs) = do
   x' <- blockToTexinfo x
   case x of
@@ -276,7 +278,7 @@ blockListToTexinfo (x:xs) = do
       xs' <- blockListToTexinfo xs
       case xs of
            ((CodeBlock _ _):_) -> return $ x' $$ xs'
-           _                   -> return $ x' $$ text "" $$ xs'
+           _                   -> return $ x' $+$ xs'
     _ -> do
       xs' <- blockListToTexinfo xs
       return $ x' $$ xs'
@@ -307,15 +309,23 @@ makeMenuLine _ = error "makeMenuLine called with non-Header block"
 
 listItemToTexinfo :: [Block]
                   -> State WriterState Doc
-listItemToTexinfo lst = blockListToTexinfo lst >>=
+listItemToTexinfo lst = do
-                        return . (text "@item" $$) 
+  contents <- blockListToTexinfo lst
+  let spacer = case reverse lst of
+                    (Para{}:_) -> blankline
+                    _          -> empty
+  return $ text "@item" $$ contents <> spacer
 
 defListItemToTexinfo :: ([Inline], [[Block]])
                      -> State WriterState Doc
 defListItemToTexinfo (term, defs) = do
     term' <- inlineListToTexinfo term
-    def'  <- liftM vcat $ mapM blockListToTexinfo defs
+    let defToTexinfo bs = do d <- blockListToTexinfo bs
-    return $ text "@item " <> term' <> text "\n" $$ def'
+                             case reverse bs of
+                                  (Para{}:_) -> return $ d <> blankline
+                                  _          -> return d
+    defs' <- mapM defToTexinfo defs
+    return $ text "@item " <> term' $+$ vcat defs'
 
 -- | Convert list of inline elements to Texinfo.
 inlineListToTexinfo :: [Inline]  -- ^ Inlines to convert
@@ -325,31 +335,7 @@ inlineListToTexinfo lst = mapM inlineToTexinfo lst >>= return . hcat
 -- | Convert list of inline elements to Texinfo acceptable for a node name.
 inlineListForNode :: [Inline]  -- ^ Inlines to convert
                   -> State WriterState Doc
-inlineListForNode lst = mapM inlineForNode lst >>= return . hcat
+inlineListForNode = return . text . filter (not . disallowedInNode) . stringify
-
-inlineForNode :: Inline -> State WriterState Doc
-inlineForNode (Str str) = return $ text $ filter (not.disallowedInNode) str
-inlineForNode (Emph lst) = inlineListForNode lst
-inlineForNode (Strong lst) = inlineListForNode lst
-inlineForNode (Strikeout lst) = inlineListForNode lst
-inlineForNode (Superscript lst) = inlineListForNode lst
-inlineForNode (Subscript lst) = inlineListForNode lst
-inlineForNode (SmallCaps lst) = inlineListForNode lst
-inlineForNode (Quoted _ lst) = inlineListForNode lst
-inlineForNode (Cite _ lst) = inlineListForNode lst
-inlineForNode (Code str) = inlineForNode (Str str)
-inlineForNode Space = return $ char ' '
-inlineForNode EmDash = return $ text "---"
-inlineForNode EnDash = return $ text "--"
-inlineForNode Apostrophe = return $ char '\''
-inlineForNode Ellipses = return $ text "..."
-inlineForNode LineBreak = return empty
-inlineForNode (Math _ str) = inlineListForNode $ readTeXMath str
-inlineForNode (TeX _) = return empty
-inlineForNode (HtmlInline _) = return empty
-inlineForNode (Link lst _) = inlineListForNode lst
-inlineForNode (Image lst _) = inlineListForNode lst
-inlineForNode (Note _) = return empty
 
 -- periods, commas, colons, and parentheses are disallowed in node names
 disallowedInNode :: Char -> Bool
@@ -429,9 +415,4 @@ inlineToTexinfo (Image alternate (source, _)) = do
 
 inlineToTexinfo (Note contents) = do
   contents' <- blockListToTexinfo contents
-  let rawnote = stripTrailingNewlines $ render contents'
+  return $ text "@footnote" <> braces contents'
-  let optNewline = "@end verbatim" `isSuffixOf` rawnote
-  return $ text "@footnote{" <>
-           text rawnote <>
-           (if optNewline then char '\n' else empty) <>
-           char '}'

tests/writer.texinfo

@@ -101,7 +101,6 @@ Level 5
 @subsection Level 3
 with no blank line
 
-
 @node Level 2
 @section Level 2
 with no blank line
@@ -136,7 +135,6 @@ E-mail style:
 
 @quotation
 This is a block quote. It is pretty short.
-
 @end quotation
 @quotation
 Code in a block quote:
@@ -159,11 +157,9 @@ Nested block quotes:
 
 @quotation
 nested
-
 @end quotation
 @quotation
 nested
-
 @end quotation
 @end quotation
 This should not be a block quote: 2 > 1.
@@ -291,7 +287,6 @@ Minus 3
 
 @end itemize
 
-
 @node Ordered
 @section Ordered
 Tight:
@@ -360,7 +355,6 @@ Item 3.
 
 @end enumerate
 
-
 @node Nested
 @section Nested
 @itemize
@@ -421,7 +415,6 @@ Third
 
 @end enumerate
 
-
 @node Tabs and spaces
 @section Tabs and spaces
 @itemize
@@ -442,7 +435,6 @@ this is an example list item indented with spaces
 
 @end itemize
 
-
 @node Fancy list markers
 @section Fancy list markers
 @enumerate 2
@@ -583,7 +575,6 @@ orange fruit
 
 @quotation
 orange block quote
-
 @end quotation
 @end table
 
@@ -639,7 +630,6 @@ sublist
 
 @end table
 
-
 @node HTML Blocks
 @chapter HTML Blocks
 Simple block on one line:
@@ -902,7 +892,6 @@ Just a @uref{/url/,URL}.
 
 @uref{,Empty}.
 
-
 @node Reference
 @section Reference
 Foo @uref{/url/,bar}.
@@ -930,7 +919,6 @@ Foo @uref{/url/,bar}.
 
 Foo @uref{/url/,biz}.
 
-
 @node With ampersands
 @section With ampersands
 Here's a @uref{http://example.com/?foo=1&bar=2,link with an ampersand in the URL}.
@@ -941,7 +929,6 @@ Here's an @uref{/script?foo=1&bar=2,inline link}.
 
 Here's an @uref{/script?foo=1&bar=2,inline link in pointy braces}.
 
-
 @node Autolinks
 @section Autolinks
 With an ampersand: @url{http://example.com/?foo=1&bar=2}
@@ -959,7 +946,6 @@ An e-mail address: @uref{mailto:nobody@@nowhere.net,@code{nobody@@nowhere.net}}
 
 @quotation
 Blockquoted: @url{http://example.com/}
-
 @end quotation
 Auto-links should not occur here: @code{<http://example.com/>}
 @verbatim
@@ -1004,7 +990,6 @@ If you want@comma{} you can indent every line@comma{} but you can also be lazy a
 
 @quotation
 Notes can go in quotes.@footnote{In quote.}
-
 @end quotation
 @enumerate 
 @item