Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1
pandoc/Text/Pandoc/Writers/Texinfo.hs
fiddlosopher f53fb554fe Support for display math; changed ASCIIMathML -> LaTeXMathML: 
Resolves Issue #47.

+ Added a DisplayMath/InlineMath selector to Math inlines.
+ Markdown parser yields DisplayMath for $$...$$.
+ LaTeX parser yields DisplayMath when appropriate.  Removed
  mathBlock parsers, since the same effect is achieved by the math
  inline parsers, now that they handle display math.
+ Writers handle DisplayMath as appropriate for the format.
+ Changed -m option to use LaTeXMathML rather than ASCIIMathML.
  LaTeXMathML is closer to LaTeX in its display of math, and
  supports many non-math LaTeX environments.
+ Modified HTML writer to print raw TeX when LaTeXMathML is
  being used instead of suppressing it.
+ Removed ASCIIMathML files from data/ and added LaTeXMathML.
+ Replaced ASCIIMathML with LaTeXMathML in source files.
+ Modified README and pandoc man page source.
+ Modified web page.
+ Added --latexmathml option (kept --asciimathml as a synonym
  for backwards compatibility)
+ Modified tests accordingly; added new tests for display math.


git-svn-id: https://pandoc.googlecode.com/svn/trunk@1409 788f1e2b-df1e-0410-8736-df70ead52e1b
2008-08-13 03:02:42 +00:00

474 lines
17 KiB
Haskell
Raw Blame History

{-
Copyright (C) 2008 John MacFarlane and Peter Wang
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- |
Module : Text.Pandoc.Writers.Texinfo
Copyright : Copyright (C) 2008 John MacFarlane and Peter Wang
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Conversion of 'Pandoc' format into Texinfo.
-}
module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.Readers.TeXMath
import Text.Printf ( printf )
import Data.List ( isSuffixOf )
import Data.Char ( chr, ord )
import qualified Data.Set as S
import Control.Monad.State
import Text.PrettyPrint.HughesPJ hiding ( Str )
data WriterState =
WriterState { stIncludes :: S.Set String -- strings to include in header
}
{- TODO:
- internal cross references a la HTML
- generated .texi files don't work when run through texi2dvi
-}
-- | Add line to header.
addToHeader :: String -> State WriterState ()
addToHeader str = do
st <- get
let includes = stIncludes st
put st {stIncludes = S.insert str includes}
-- | Convert Pandoc to Texinfo.
writeTexinfo :: WriterOptions -> Pandoc -> String
writeTexinfo options document =
render $ evalState (pandocToTexinfo options $ wrapTop document) $
WriterState { stIncludes = S.empty }
-- | Add a "Top" node around the document, needed by Texinfo.
wrapTop :: Pandoc -> Pandoc
wrapTop (Pandoc (Meta title authors date) blocks) =
Pandoc (Meta title authors date) (Header 0 title : blocks)
pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState Doc
pandocToTexinfo options (Pandoc meta blocks) = do
main <- blockListToTexinfo blocks
head' <- if writerStandalone options
then texinfoHeader options meta
else return empty
let before = if null (writerIncludeBefore options)
then empty
else text (writerIncludeBefore options)
let after = if null (writerIncludeAfter options)
then empty
else text (writerIncludeAfter options)
let body = before $$ main $$ after
-- XXX toc untested
let toc = if writerTableOfContents options
then text "@contents"
else empty
let foot = if writerStandalone options
then text "@bye"
else empty
return $ head' $$ toc $$ body $$ foot
-- | Insert bibliographic information into Texinfo header.
texinfoHeader :: WriterOptions -- ^ Options, including Texinfo header
-> Meta -- ^ Meta with bibliographic information
-> State WriterState Doc
texinfoHeader options (Meta title authors date) = do
titletext <- if null title
then return empty
else do
t <- inlineListToTexinfo title
return $ text "@title " <> t
headerIncludes <- get >>= return . S.toList . stIncludes
let extras = text $ unlines headerIncludes
let authorstext = map makeAuthor authors
let datetext = if date == ""
then empty
else text $ stringToTexinfo date
let baseHeader = text $ writerHeader options
let header = baseHeader $$ extras
return $ text "\\input texinfo" $$
header $$
text "@ifnottex" $$
text "@paragraphindent 0" $$
text "@end ifnottex" $$
text "@titlepage" $$
titletext $$ vcat authorstext $$
datetext $$
text "@end titlepage"
makeAuthor :: String -> Doc
makeAuthor author = text $ "@author " ++ (stringToTexinfo author)
-- | Escape things as needed for Texinfo.
stringToTexinfo :: String -> String
stringToTexinfo = escapeStringUsing texinfoEscapes
where texinfoEscapes = [ ('{', "@{")
, ('}', "@}")
, ('@', "@@")
, (',', "@comma{}") -- only needed in argument lists
, ('\160', "@ ")
]
-- | Puts contents into Texinfo command.
inCmd :: String -> Doc -> Doc
inCmd cmd contents = char '@' <> text cmd <> braces contents
-- | Convert Pandoc block element to Texinfo.
blockToTexinfo :: Block -- ^ Block to convert
-> State WriterState Doc
blockToTexinfo Null = return empty
blockToTexinfo (Plain lst) =
inlineListToTexinfo lst
blockToTexinfo (Para lst) =
inlineListToTexinfo lst -- this is handled differently from Plain in blockListToTexinfo
blockToTexinfo (BlockQuote lst) = do
contents <- blockListToTexinfo lst
return $ text "@quotation" $$
contents $$
text "@end quotation"
blockToTexinfo (CodeBlock _ str) = do
return $ text "@verbatim" $$
vcat (map text (lines str)) $$
text "@end verbatim\n"
blockToTexinfo (RawHtml _) = return empty
blockToTexinfo (BulletList lst) = do
items <- mapM listItemToTexinfo lst
return $ text "@itemize" $$
vcat items $$
text "@end itemize\n"
blockToTexinfo (OrderedList (start, numstyle, _) lst) = do
items <- mapM listItemToTexinfo lst
return $ text "@enumerate " <> exemplar $$
vcat items $$
text "@end enumerate\n"
where
exemplar = case numstyle of
DefaultStyle -> decimal
Decimal -> decimal
UpperRoman -> decimal -- Roman numerals not supported
LowerRoman -> decimal
UpperAlpha -> upperAlpha
LowerAlpha -> lowerAlpha
decimal = if start == 1
then empty
else text (show start)
upperAlpha = text [chr $ ord 'A' + start - 1]
lowerAlpha = text [chr $ ord 'a' + start - 1]
blockToTexinfo (DefinitionList lst) = do
items <- mapM defListItemToTexinfo lst
return $ text "@table @asis" $$
vcat items $$
text "@end table\n"
blockToTexinfo HorizontalRule =
-- XXX can't get the equivalent from LaTeX.hs to work
return $ text "@iftex" $$
text "@bigskip@hrule@bigskip" $$
text "@end iftex" $$
text "@ifnottex" $$
text (take 72 $ repeat '-') $$
text "@end ifnottex"
blockToTexinfo (Header 0 lst) = do
txt <- if null lst
then return $ text "Top"
else inlineListToTexinfo lst
return $ text "@node Top" $$
text "@top " <> txt <> char '\n'
blockToTexinfo (Header level lst) = do
node <- inlineListForNode lst
txt <- inlineListToTexinfo lst
return $ if (level > 0) && (level <= 4)
then text "\n@node " <> node <> char '\n' <>
text (seccmd level) <> txt
else txt
where
seccmd 1 = "@chapter "
seccmd 2 = "@section "
seccmd 3 = "@subsection "
seccmd 4 = "@subsubsection "
seccmd _ = error "illegal seccmd level"
blockToTexinfo (Table caption aligns widths heads rows) = do
headers <- tableHeadToTexinfo aligns heads
captionText <- inlineListToTexinfo caption
rowsText <- mapM (tableRowToTexinfo aligns) rows
let colWidths = map (printf "%.2f ") widths
let colDescriptors = concat colWidths
let tableBody = text ("@multitable @columnfractions " ++ colDescriptors) $$
headers $$
vcat rowsText $$
text "@end multitable"
return $ if isEmpty captionText
then tableBody <> char '\n'
else text "@float" $$
tableBody $$
inCmd "caption" captionText $$
text "@end float"
tableHeadToTexinfo :: [Alignment]
-> [[Block]]
-> State WriterState Doc
tableHeadToTexinfo = tableAnyRowToTexinfo "@headitem "
tableRowToTexinfo :: [Alignment]
-> [[Block]]
-> State WriterState Doc
tableRowToTexinfo = tableAnyRowToTexinfo "@item "
tableAnyRowToTexinfo :: String
-> [Alignment]
-> [[Block]]
-> State WriterState Doc
tableAnyRowToTexinfo itemtype aligns cols =
zipWithM alignedBlock aligns cols >>=
return . (text itemtype $$) . foldl (\row item -> row $$
(if isEmpty row then empty else text " @tab ") <> item) empty
alignedBlock :: Alignment
-> [Block]
-> State WriterState Doc
-- XXX @flushleft and @flushright text won't get word wrapped. Since word
-- wrapping is more important than alignment, we ignore the alignment.
alignedBlock _ = blockListToTexinfo
{-
alignedBlock AlignLeft col = do
b <- blockListToTexinfo col
return $ text "@flushleft" $$ b $$ text "@end flushleft"
alignedBlock AlignRight col = do
b <- blockListToTexinfo col
return $ text "@flushright" $$ b $$ text "@end flushright"
alignedBlock _ col = blockListToTexinfo col
-}
-- | Convert Pandoc block elements to Texinfo.
blockListToTexinfo :: [Block]
-> State WriterState Doc
blockListToTexinfo [] = return $ empty
blockListToTexinfo (x:xs) = do
x' <- blockToTexinfo x
case x of
Header level _ -> do
-- We need need to insert a menu for this node.
let (before, after) = break isHeader xs
before' <- blockListToTexinfo before
let menu = if level < 4
then collectNodes (level + 1) after
else []
lines' <- mapM makeMenuLine menu
let menu' = if null lines'
then empty
else text "@menu" $$
vcat lines' $$
text "@end menu"
after' <- blockListToTexinfo after
return $ x' $$ before' $$ menu' $$ after'
Para _ -> do
xs' <- blockListToTexinfo xs
case xs of
((CodeBlock _ _):_) -> return $ x' $$ xs'
_ -> return $ x' $$ text "" $$ xs'
_ -> do
xs' <- blockListToTexinfo xs
return $ x' $$ xs'
isHeader :: Block -> Bool
isHeader (Header _ _) = True
isHeader _ = False
collectNodes :: Int -> [Block] -> [Block]
collectNodes _ [] = []
collectNodes level (x:xs) =
case x of
(Header hl _) ->
if hl < level
then []
else if hl == level
then x : collectNodes level xs
else collectNodes level xs
_ ->
collectNodes level xs
makeMenuLine :: Block
-> State WriterState Doc
makeMenuLine (Header _ lst) = do
txt <- inlineListForNode lst
return $ text "* " <> txt <> text "::"
makeMenuLine _ = error "makeMenuLine called with non-Header block"
listItemToTexinfo :: [Block]
-> State WriterState Doc
listItemToTexinfo lst = blockListToTexinfo lst >>=
return . (text "@item" $$)
defListItemToTexinfo :: ([Inline], [Block])
-> State WriterState Doc
defListItemToTexinfo (term, def) = do
term' <- inlineListToTexinfo term
def' <- blockListToTexinfo def
return $ text "@item " <> term' <> text "\n" $$ def'
-- | Convert list of inline elements to Texinfo.
inlineListToTexinfo :: [Inline] -- ^ Inlines to convert
-> State WriterState Doc
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
-- periods, commas, colons, and parentheses are disallowed in node names
disallowedInNode :: Char -> Bool
disallowedInNode c = c `elem` ".,:()"
-- | Convert inline element to Texinfo
inlineToTexinfo :: Inline -- ^ Inline to convert
-> State WriterState Doc
inlineToTexinfo (Emph lst) =
inlineListToTexinfo lst >>= return . inCmd "emph"
inlineToTexinfo (Strong lst) =
inlineListToTexinfo lst >>= return . inCmd "strong"
inlineToTexinfo (Strikeout lst) = do
addToHeader $ "@macro textstrikeout{text}\n" ++
"~~\\text\\~~\n" ++
"@end macro\n"
contents <- inlineListToTexinfo lst
return $ text "@textstrikeout{" <> contents <> text "}"
inlineToTexinfo (Superscript lst) = do
addToHeader $ "@macro textsuperscript{text}\n" ++
"@iftex\n" ++
"@textsuperscript{\\text\\}\n" ++
"@end iftex\n" ++
"@ifnottex\n" ++
"^@{\\text\\@}\n" ++
"@end ifnottex\n" ++
"@end macro\n"
contents <- inlineListToTexinfo lst
return $ text "@textsuperscript{" <> contents <> char '}'
inlineToTexinfo (Subscript lst) = do
addToHeader $ "@macro textsubscript{text}\n" ++
"@iftex\n" ++
"@textsubscript{\\text\\}\n" ++
"@end iftex\n" ++
"@ifnottex\n" ++
"_@{\\text\\@}\n" ++
"@end ifnottex\n" ++
"@end macro\n"
contents <- inlineListToTexinfo lst
return $ text "@textsubscript{" <> contents <> char '}'
inlineToTexinfo (SmallCaps lst) =
inlineListToTexinfo lst >>= return . inCmd "sc"
inlineToTexinfo (Code str) = do
return $ text $ "@code{" ++ stringToTexinfo str ++ "}"
inlineToTexinfo (Quoted SingleQuote lst) = do
contents <- inlineListToTexinfo lst
return $ char '`' <> contents <> char '\''
inlineToTexinfo (Quoted DoubleQuote lst) = do
contents <- inlineListToTexinfo lst
return $ text "``" <> contents <> text "''"
inlineToTexinfo (Cite _ lst) =
inlineListToTexinfo lst
inlineToTexinfo Apostrophe = return $ char '\''
inlineToTexinfo EmDash = return $ text "---"
inlineToTexinfo EnDash = return $ text "--"
inlineToTexinfo Ellipses = return $ text "@dots{}"
inlineToTexinfo (Str str) = return $ text (stringToTexinfo str)
inlineToTexinfo (Math _ str) = return $ inCmd "math" $ text str
inlineToTexinfo (TeX str) = return $ text "@tex" $$ text str $$ text "@end tex"
inlineToTexinfo (HtmlInline _) = return empty
inlineToTexinfo (LineBreak) = return $ text "@*"
inlineToTexinfo Space = return $ char ' '
inlineToTexinfo (Link txt (src, _)) = do
case txt of
[Code x] | x == src -> -- autolink
do return $ text $ "@url{" ++ x ++ "}"
_ -> do contents <- inlineListToTexinfo txt
let src1 = stringToTexinfo src
return $ text ("@uref{" ++ src1 ++ ",") <> contents <>
char '}'
inlineToTexinfo (Image alternate (source, _)) = do
content <- inlineListToTexinfo alternate
return $ text ("@image{" ++ base ++ ",,,") <> content <> text "," <>
text (ext ++ "}")
where
(revext, revbase) = break (=='.') (reverse source)
ext = reverse revext
base = case revbase of
('.' : rest) -> reverse rest
_ -> reverse revbase
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 '}'
Reference in a new issue View git blame Copy permalink