Texinfo writer: Updated to use Pretty.

This commit is contained in:
John MacFarlane 2010-12-22 11:43:43 -08:00
parent f15d479fc2
commit 8e9c490b0a
3 changed files with 38 additions and 72 deletions

View file

@ -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)
, ("date", render dateText) ] ++
, ("title", render colwidth titleText)
, ("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)) $$
text "@end verbatim\n"
flush (text str) $$
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)) $
transpose $ heads : rows
cols <- mapM (mapM (liftM (render Nothing . hcat) . mapM blockToTexinfo)) $
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 >>=
return . (text "@item" $$)
listItemToTexinfo lst = do
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
return $ text "@item " <> term' <> text "\n" $$ def'
let defToTexinfo bs = do d <- blockListToTexinfo bs
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
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
inlineListForNode = return . text . filter (not . disallowedInNode) . stringify
-- 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'
let optNewline = "@end verbatim" `isSuffixOf` rawnote
return $ text "@footnote{" <>
text rawnote <>
(if optNewline then char '\n' else empty) <>
char '}'
return $ text "@footnote" <> braces contents'

View file

@ -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