summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs159
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs72
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs9
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs108
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs349
-rw-r--r--src/Text/Pandoc/Writers/Man.hs58
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs382
-rw-r--r--src/Text/Pandoc/Writers/MediaWiki.hs24
-rw-r--r--src/Text/Pandoc/Writers/Native.hs86
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs5
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs33
-rw-r--r--src/Text/Pandoc/Writers/Org.hs284
-rw-r--r--src/Text/Pandoc/Writers/RST.hs177
-rw-r--r--src/Text/Pandoc/Writers/RTF.hs34
-rw-r--r--src/Text/Pandoc/Writers/Texinfo.hs108
-rw-r--r--src/Text/Pandoc/Writers/Textile.hs422
16 files changed, 1665 insertions, 645 deletions
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index 395bc2d30..0f6e00a3b 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2007-2010 John MacFarlane <jgm@berkeley.edu>
@@ -31,9 +32,9 @@ module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Printf ( printf )
-import Data.List ( isSuffixOf, intercalate, intersperse )
+import Data.List ( intercalate )
import Control.Monad.State
-import Text.PrettyPrint.HughesPJ hiding ( Str )
+import Text.Pandoc.Pretty
import Text.Pandoc.Templates ( renderTemplate )
data WriterState =
@@ -56,15 +57,18 @@ writeConTeXt options document =
pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String
pandocToConTeXt options (Pandoc (Meta title authors date) blocks) = do
+ let colwidth = if writerWrapText options
+ then Just $ writerColumns options
+ else Nothing
titletext <- if null title
then return ""
- else liftM render $ inlineListToConTeXt title
- authorstext <- mapM (liftM render . inlineListToConTeXt) authors
+ else liftM (render colwidth) $ inlineListToConTeXt title
+ authorstext <- mapM (liftM (render colwidth) . inlineListToConTeXt) authors
datetext <- if null date
then return ""
- else liftM render $ inlineListToConTeXt date
- body <- blockListToConTeXt blocks
- let main = render $ body $$ text ""
+ else liftM (render colwidth) $ inlineListToConTeXt date
+ body <- blockListToConTeXt blocks
+ let main = render colwidth $ body
let context = writerVariables options ++
[ ("toc", if writerTableOfContents options then "yes" else "")
, ("body", main)
@@ -92,6 +96,8 @@ escapeCharForConTeXt ch =
'#' -> "\\#"
'<' -> "\\letterless{}"
'>' -> "\\lettermore{}"
+ '[' -> "{[}"
+ ']' -> "{]}"
'_' -> "\\letterunderscore{}"
'\160' -> "~"
x -> [x]
@@ -102,32 +108,27 @@ stringToConTeXt = concatMap escapeCharForConTeXt
-- | Convert Pandoc block element to ConTeXt.
blockToConTeXt :: Block
- -> State WriterState BlockWrapper
-blockToConTeXt Null = return $ Reg empty
-blockToConTeXt (Plain lst) = do
- st <- get
- let options = stOptions st
- contents <- wrapTeXIfNeeded options False inlineListToConTeXt lst
- return $ Reg contents
+ -> State WriterState Doc
+blockToConTeXt Null = return empty
+blockToConTeXt (Plain lst) = inlineListToConTeXt lst
blockToConTeXt (Para [Image txt (src,_)]) = do
capt <- inlineListToConTeXt txt
- return $ Pad $ text "\\placefigure[here,nonumber]{" <> capt <>
- text "}{\\externalfigure[" <> text src <> text "]}"
+ return $ blankline $$ "\\placefigure[here,nonumber]" <> braces capt <>
+ braces ("\\externalfigure" <> brackets (text src)) <> blankline
blockToConTeXt (Para lst) = do
- st <- get
- let options = stOptions st
- contents <- wrapTeXIfNeeded options False inlineListToConTeXt lst
- return $ Pad contents
+ contents <- inlineListToConTeXt lst
+ return $ contents <> blankline
blockToConTeXt (BlockQuote lst) = do
contents <- blockListToConTeXt lst
- return $ Pad $ text "\\startblockquote" $$ contents $$ text "\\stopblockquote"
-blockToConTeXt (CodeBlock _ str) =
- return $ Reg $ text $ "\\starttyping\n" ++ str ++ "\n\\stoptyping\n"
- -- \n because \stoptyping can't have anything after it, inc. }
-blockToConTeXt (RawHtml _) = return $ Reg empty
-blockToConTeXt (BulletList lst) = do
+ return $ "\\startblockquote" $$ nest 0 contents $$ "\\stopblockquote" <> blankline
+blockToConTeXt (CodeBlock _ str) =
+ return $ "\\starttyping" <> cr <> flush (text str) <> cr <> "\\stoptyping" $$ blankline
+ -- blankline because \stoptyping can't have anything after it, inc. '}'
+blockToConTeXt (RawBlock "context" str) = return $ text str <> blankline
+blockToConTeXt (RawBlock _ _ ) = return empty
+blockToConTeXt (BulletList lst) = do
contents <- mapM listItemToConTeXt lst
- return $ Pad $ text "\\startitemize" $$ vcat contents $$ text "\\stopitemize"
+ return $ "\\startitemize" $$ vcat contents $$ text "\\stopitemize" <> blankline
blockToConTeXt (OrderedList (start, style', delim) lst) = do
st <- get
let level = stOrderedListLevel st
@@ -159,20 +160,23 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do
LowerAlpha -> "[a]"
UpperAlpha -> "[A]"
let specs = style'' ++ specs2
- return $ Pad $ text ("\\startitemize" ++ specs) $$ vcat contents $$
- text "\\stopitemize"
+ return $ "\\startitemize" <> text specs $$ vcat contents $$
+ "\\stopitemize" <> blankline
blockToConTeXt (DefinitionList lst) =
- mapM defListItemToConTeXt lst >>= return . Pad . wrappedBlocksToDoc
-blockToConTeXt HorizontalRule = return $ Pad $ text "\\thinrule"
+ liftM vcat $ mapM defListItemToConTeXt lst
+blockToConTeXt HorizontalRule = return $ "\\thinrule" <> blankline
blockToConTeXt (Header level lst) = do
contents <- inlineListToConTeXt lst
st <- get
let opts = stOptions st
let base = if writerNumberSections opts then "section" else "subject"
- return $ Pad $ if level >= 1 && level <= 5
- then char '\\' <> text (concat (replicate (level - 1) "sub")) <>
- text base <> char '{' <> contents <> char '}'
- else contents
+ let level' = if writerChapters opts then level - 1 else level
+ return $ if level' >= 1 && level' <= 5
+ then char '\\' <> text (concat (replicate (level' - 1) "sub")) <>
+ text base <> char '{' <> contents <> char '}' <> blankline
+ else if level' == 0
+ then "\\chapter{" <> contents <> "}"
+ else contents <> blankline
blockToConTeXt (Table caption aligns widths heads rows) = do
let colDescriptor colWidth alignment = (case alignment of
AlignLeft -> 'l'
@@ -186,81 +190,87 @@ blockToConTeXt (Table caption aligns widths heads rows) = do
zipWith colDescriptor widths aligns)
headers <- if all null heads
then return empty
- else liftM ($$ text "\\HL") $ tableRowToConTeXt heads
+ else liftM ($$ "\\HL") $ tableRowToConTeXt heads
captionText <- inlineListToConTeXt caption
let captionText' = if null caption then text "none" else captionText
rows' <- mapM tableRowToConTeXt rows
- return $ Pad $ text "\\placetable[here]{" <> captionText' <> char '}' $$
- text "\\starttable[" <> text colDescriptors <> char ']' $$
- text "\\HL" $$ headers $$
- vcat rows' $$ text "\\HL\n\\stoptable"
+ return $ "\\placetable[here]" <> braces captionText' $$
+ "\\starttable" <> brackets (text colDescriptors) $$
+ "\\HL" $$ headers $$
+ vcat rows' $$ "\\HL" $$ "\\stoptable" <> blankline
tableRowToConTeXt :: [[Block]] -> State WriterState Doc
tableRowToConTeXt cols = do
cols' <- mapM blockListToConTeXt cols
- return $ (vcat (map (text "\\NC " <>) cols')) $$
- text "\\NC\\AR"
+ return $ (vcat (map ("\\NC " <>) cols')) $$ "\\NC\\AR"
listItemToConTeXt :: [Block] -> State WriterState Doc
listItemToConTeXt list = blockListToConTeXt list >>=
- return . (text "\\item" $$) . (nest 2)
+ return . ("\\item" $$) . (nest 2)
-defListItemToConTeXt :: ([Inline], [[Block]]) -> State WriterState BlockWrapper
+defListItemToConTeXt :: ([Inline], [[Block]]) -> State WriterState Doc
defListItemToConTeXt (term, defs) = do
term' <- inlineListToConTeXt term
- def' <- liftM (vcat . intersperse (text "")) $ mapM blockListToConTeXt defs
- return $ Pad $ text "\\startdescr{" <> term' <> char '}' $$ def' $$ text "\\stopdescr"
+ def' <- liftM vsep $ mapM blockListToConTeXt defs
+ return $ "\\startdescr" <> braces term' $$ nest 2 def' $$
+ "\\stopdescr" <> blankline
-- | Convert list of block elements to ConTeXt.
blockListToConTeXt :: [Block] -> State WriterState Doc
-blockListToConTeXt lst = mapM blockToConTeXt lst >>= return . wrappedBlocksToDoc
+blockListToConTeXt lst = liftM vcat $ mapM blockToConTeXt lst
-- | Convert list of inline elements to ConTeXt.
inlineListToConTeXt :: [Inline] -- ^ Inlines to convert
-> State WriterState Doc
-inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= return . hcat
+inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt lst
-- | Convert inline element to ConTeXt
inlineToConTeXt :: Inline -- ^ Inline to convert
-> State WriterState Doc
inlineToConTeXt (Emph lst) = do
contents <- inlineListToConTeXt lst
- return $ text "{\\em " <> contents <> char '}'
+ return $ braces $ "\\em " <> contents
inlineToConTeXt (Strong lst) = do
contents <- inlineListToConTeXt lst
- return $ text "{\\bf " <> contents <> char '}'
+ return $ braces $ "\\bf " <> contents
inlineToConTeXt (Strikeout lst) = do
contents <- inlineListToConTeXt lst
- return $ text "\\overstrikes{" <> contents <> char '}'
+ return $ "\\overstrikes" <> braces contents
inlineToConTeXt (Superscript lst) = do
contents <- inlineListToConTeXt lst
- return $ text "\\high{" <> contents <> char '}'
+ return $ "\\high" <> braces contents
inlineToConTeXt (Subscript lst) = do
contents <- inlineListToConTeXt lst
- return $ text "\\low{" <> contents <> char '}'
+ return $ "\\low" <> braces contents
inlineToConTeXt (SmallCaps lst) = do
contents <- inlineListToConTeXt lst
- return $ text "{\\sc " <> contents <> char '}'
-inlineToConTeXt (Code str) = return $ text $ "\\type{" ++ str ++ "}"
+ return $ braces $ "\\sc " <> contents
+inlineToConTeXt (Code _ str) | not ('{' `elem` str || '}' `elem` str) =
+ return $ "\\type" <> braces (text str)
+inlineToConTeXt (Code _ str) =
+ return $ "\\mono" <> braces (text $ stringToConTeXt str)
inlineToConTeXt (Quoted SingleQuote lst) = do
contents <- inlineListToConTeXt lst
- return $ text "\\quote{" <> contents <> char '}'
+ return $ "\\quote" <> braces contents
inlineToConTeXt (Quoted DoubleQuote lst) = do
contents <- inlineListToConTeXt lst
- return $ text "\\quotation{" <> contents <> char '}'
+ return $ "\\quotation" <> braces contents
inlineToConTeXt (Cite _ lst) = inlineListToConTeXt lst
inlineToConTeXt Apostrophe = return $ char '\''
-inlineToConTeXt EmDash = return $ text "---"
-inlineToConTeXt EnDash = return $ text "--"
-inlineToConTeXt Ellipses = return $ text "\\ldots{}"
+inlineToConTeXt EmDash = return "---"
+inlineToConTeXt EnDash = return "--"
+inlineToConTeXt Ellipses = return "\\ldots{}"
inlineToConTeXt (Str str) = return $ text $ stringToConTeXt str
-inlineToConTeXt (Math InlineMath str) = return $ char '$' <> text str <> char '$'
-inlineToConTeXt (Math DisplayMath str) = return $ text "\\startformula " <> text str <> text " \\stopformula"
-inlineToConTeXt (TeX str) = return $ text str
-inlineToConTeXt (HtmlInline _) = return empty
-inlineToConTeXt (LineBreak) = return $ text "\\crlf\n"
-inlineToConTeXt Space = return $ char ' '
-inlineToConTeXt (Link [Code str] (src, tit)) = -- since ConTeXt has its own
+inlineToConTeXt (Math InlineMath str) =
+ return $ char '$' <> text str <> char '$'
+inlineToConTeXt (Math DisplayMath str) =
+ return $ text "\\startformula " <> text str <> text " \\stopformula"
+inlineToConTeXt (RawInline "context" str) = return $ text str
+inlineToConTeXt (RawInline "tex" str) = return $ text str
+inlineToConTeXt (RawInline _ _) = return empty
+inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr
+inlineToConTeXt Space = return space
+inlineToConTeXt (Link [Code _ str] (src, tit)) = -- since ConTeXt has its own
inlineToConTeXt (Link [Str str] (src, tit)) -- way of printing links...
inlineToConTeXt (Link txt (src, _)) = do
st <- get
@@ -268,15 +278,12 @@ inlineToConTeXt (Link txt (src, _)) = do
put $ st {stNextRef = next + 1}
let ref = show next
label <- inlineListToConTeXt txt
- return $ text "\\useURL[" <> text ref <> text "][" <> text src <>
- text "][][" <> label <> text "]\\from[" <> text ref <> char ']'
+ return $ "\\useURL" <> brackets (text ref) <> brackets (text src) <>
+ brackets empty <> brackets label <>
+ "\\from" <> brackets (text ref)
inlineToConTeXt (Image _ (src, _)) = do
- return $ text "{\\externalfigure[" <> text src <> text "]}"
+ return $ braces $ "\\externalfigure" <> brackets (text src)
inlineToConTeXt (Note contents) = do
contents' <- blockListToConTeXt contents
- let rawnote = stripTrailingNewlines $ render contents'
- -- note: a \n before } is needed when note ends with a \stoptyping
- let optNewline = "\\stoptyping" `isSuffixOf` rawnote
- return $ text "\\footnote{" <>
- text rawnote <> (if optNewline then char '\n' else empty) <> char '}'
-
+ return $ text "\\footnote{" <>
+ nest 2 contents' <> char '}'
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index 5223259eb..9d09d46e3 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -33,15 +33,15 @@ import Text.Pandoc.XML
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Readers.TeXMath
-import Data.List ( isPrefixOf, intercalate )
+import Data.List ( isPrefixOf, intercalate, isSuffixOf )
import Data.Char ( toLower )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
import Text.Pandoc.Highlighting (languages, languagesByExtension)
+import Text.Pandoc.Pretty
-- | Convert list of authors to a docbook <author> section
authorToDocbook :: WriterOptions -> [Inline] -> Doc
authorToDocbook opts name' =
- let name = render $ inlinesToDocbook opts name'
+ let name = render Nothing $ inlinesToDocbook opts name'
in if ',' `elem` name
then -- last name first
let (lastname, rest) = break (==',') name
@@ -61,16 +61,24 @@ authorToDocbook opts name' =
-- | Convert Pandoc document to string in Docbook format.
writeDocbook :: WriterOptions -> Pandoc -> String
writeDocbook opts (Pandoc (Meta tit auths dat) blocks) =
- let title = wrap opts tit
+ let title = inlinesToDocbook opts tit
authors = map (authorToDocbook opts) auths
date = inlinesToDocbook opts dat
elements = hierarchicalize blocks
- main = render $ vcat (map (elementToDocbook opts) elements)
+ colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ render' = render colwidth
+ opts' = if "</book>" `isSuffixOf`
+ (removeTrailingSpace $ writerTemplate opts)
+ then opts{ writerChapters = True }
+ else opts
+ main = render' $ vcat (map (elementToDocbook opts') elements)
context = writerVariables opts ++
[ ("body", main)
- , ("title", render title)
- , ("date", render date) ] ++
- [ ("author", render a) | a <- authors ]
+ , ("title", render' title)
+ , ("date", render' date) ] ++
+ [ ("author", render' a) | a <- authors ]
in if writerStandalone opts
then renderTemplate context $ writerTemplate opts
else main
@@ -83,9 +91,12 @@ elementToDocbook opts (Sec _ _num id' title elements) =
let elements' = if null elements
then [Blk (Para [])]
else elements
- in inTags True "section" [("id",id')] $
- inTagsSimple "title" (wrap opts title) $$
- vcat (map (elementToDocbook opts) elements')
+ tag = if writerChapters opts
+ then "chapter"
+ else "section"
+ in inTags True tag [("id",id')] $
+ inTagsSimple "title" (inlinesToDocbook opts title) $$
+ vcat (map (elementToDocbook opts{ writerChapters = False }) elements')
-- | Convert a list of Pandoc blocks to Docbook.
blocksToDocbook :: WriterOptions -> [Block] -> Doc
@@ -123,7 +134,7 @@ listItemToDocbook opts item =
blockToDocbook :: WriterOptions -> Block -> Doc
blockToDocbook _ Null = empty
blockToDocbook _ (Header _ _) = empty -- should not occur after hierarchicalize
-blockToDocbook opts (Plain lst) = wrap opts lst
+blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst
blockToDocbook opts (Para [Image txt (src,_)]) =
let capt = inlinesToDocbook opts txt
in inTagsIndented "figure" $
@@ -132,12 +143,13 @@ blockToDocbook opts (Para [Image txt (src,_)]) =
(inTagsIndented "imageobject"
(selfClosingTag "imagedata" [("fileref",src)])) $$
inTagsSimple "textobject" (inTagsSimple "phrase" capt))
-blockToDocbook opts (Para lst) = inTagsIndented "para" $ wrap opts lst
+blockToDocbook opts (Para lst) =
+ inTagsIndented "para" $ inlinesToDocbook opts lst
blockToDocbook opts (BlockQuote blocks) =
inTagsIndented "blockquote" $ blocksToDocbook opts blocks
blockToDocbook _ (CodeBlock (_,classes,_) str) =
- text ("<screen" ++ lang ++ ">\n") <>
- text (escapeStringForXML str) <> text "\n</screen>"
+ text ("<screen" ++ lang ++ ">") <> cr <>
+ flush (text (escapeStringForXML str) <> cr <> text "</screen>")
where lang = if null langs
then ""
else " language=\"" ++ escapeStringForXML (head langs) ++
@@ -167,7 +179,10 @@ blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) =
in inTags True "orderedlist" attribs items
blockToDocbook opts (DefinitionList lst) =
inTagsIndented "variablelist" $ deflistItemsToDocbook opts lst
-blockToDocbook _ (RawHtml str) = text str -- raw XML block
+blockToDocbook _ (RawBlock "docbook" str) = text str -- raw XML block
+-- we allow html for compatibility with earlier versions of pandoc
+blockToDocbook _ (RawBlock "html" str) = text str -- raw XML block
+blockToDocbook _ (RawBlock _ _) = empty
blockToDocbook _ HorizontalRule = empty -- not semantic
blockToDocbook opts (Table caption aligns widths headers rows) =
let alignStrings = map alignmentToString aligns
@@ -214,12 +229,6 @@ tableItemToDocbook opts tag align item =
let attrib = [("align", align)]
in inTags True tag attrib $ vcat $ map (blockToDocbook opts) item
--- | Take list of inline elements and return wrapped doc.
-wrap :: WriterOptions -> [Inline] -> Doc
-wrap opts lst = if writerWrapText opts
- then fsep $ map (inlinesToDocbook opts) (splitBy Space lst)
- else inlinesToDocbook opts lst
-
-- | Convert a list of inline elements to Docbook.
inlinesToDocbook :: WriterOptions -> [Inline] -> Doc
inlinesToDocbook opts lst = hcat $ map (inlineToDocbook opts) lst
@@ -249,22 +258,21 @@ inlineToDocbook _ Apostrophe = char '\''
inlineToDocbook _ Ellipses = text "…"
inlineToDocbook _ EmDash = text "—"
inlineToDocbook _ EnDash = text "–"
-inlineToDocbook _ (Code str) =
+inlineToDocbook _ (Code _ str) =
inTagsSimple "literal" $ text (escapeStringForXML str)
inlineToDocbook opts (Math _ str) = inlinesToDocbook opts $ readTeXMath str
-inlineToDocbook _ (TeX _) = empty
-inlineToDocbook _ (HtmlInline _) = empty
-inlineToDocbook _ LineBreak = text $ "<literallayout></literallayout>"
-inlineToDocbook _ Space = char ' '
+inlineToDocbook _ (RawInline _ _) = empty
+inlineToDocbook _ LineBreak = inTagsSimple "literallayout" empty
+inlineToDocbook _ Space = space
inlineToDocbook opts (Link txt (src, _)) =
if isPrefixOf "mailto:" src
then let src' = drop 7 src
emailLink = inTagsSimple "email" $ text $
escapeStringForXML $ src'
- in if txt == [Code src']
- then emailLink
- else inlinesToDocbook opts txt <+> char '(' <> emailLink <>
- char ')'
+ in case txt of
+ [Code _ s] | s == src' -> emailLink
+ _ -> inlinesToDocbook opts txt <+>
+ char '(' <> emailLink <> char ')'
else (if isPrefixOf "#" src
then inTags False "link" [("linkend", drop 1 src)]
else inTags False "ulink" [("url", src)]) $
@@ -275,6 +283,6 @@ inlineToDocbook _ (Image _ (src, tit)) =
else inTagsIndented "objectinfo" $
inTagsIndented "title" (text $ escapeStringForXML tit)
in inTagsIndented "inlinemediaobject" $ inTagsIndented "imageobject" $
- titleDoc $$ selfClosingTag "imagedata" [("fileref", src)]
+ titleDoc $$ selfClosingTag "imagedata" [("fileref", src)]
inlineToDocbook opts (Note contents) =
inTagsIndented "footnote" $ blocksToDocbook opts contents
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index deaa2fe33..33b8aa76a 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -39,6 +39,7 @@ import Codec.Archive.Zip
import System.Time
import Text.Pandoc.Shared hiding ( Element )
import Text.Pandoc.Definition
+import Text.Pandoc.Generic
import Control.Monad (liftM)
import Text.XML.Light hiding (ppTopElement)
import Text.Pandoc.UUID
@@ -69,7 +70,7 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do
-- handle pictures
picsRef <- newIORef []
- Pandoc _ blocks <- liftM (processWith transformBlock) $ processWithM
+ Pandoc _ blocks <- liftM (bottomUp transformBlock) $ bottomUpM
(transformInlines (writerHTMLMathMethod opts) sourceDir picsRef) doc
pics <- readIORef picsRef
let readPicEntry (oldsrc, newsrc) = readEntry [] oldsrc >>= \e ->
@@ -232,13 +233,13 @@ transformInlines (MathML _) _ _ (x@(Math _ _) : xs) = do
mathml ++ "</ops:case><ops:default>" ++ fallback ++ "</ops:default>" ++
"</ops:switch>"
result = if "<math" `isPrefixOf` mathml then inOps else mathml
- return $ HtmlInline result : xs
-transformInlines _ _ _ (HtmlInline _ : xs) = return $ Str "" : xs
+ return $ RawInline "html" result : xs
+transformInlines _ _ _ (RawInline _ _ : xs) = return $ Str "" : xs
transformInlines _ _ _ (Link lab (_,_) : xs) = return $ lab ++ xs
transformInlines _ _ _ xs = return xs
transformBlock :: Block -> Block
-transformBlock (RawHtml _) = Null
+transformBlock (RawBlock _ _) = Null
transformBlock x = x
(!) :: Node t => (t -> Element) -> [(String, String)] -> t -> Element
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index d2a400c5c..ef14b6809 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -105,8 +105,8 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
toc <- if writerTableOfContents opts
then tableOfContents opts sects
else return Nothing
- let startSlide = RawHtml "<div class=\"slide\">\n"
- endSlide = RawHtml "</div>\n"
+ let startSlide = RawBlock "html" "<div class=\"slide\">\n"
+ endSlide = RawBlock "html" "</div>\n"
let cutUp (HorizontalRule : Header 1 ys : xs) = cutUp (Header 1 ys : xs)
cutUp (HorizontalRule : xs) = [endSlide, startSlide] ++ cutUp xs
cutUp (Header 1 ys : xs) = [endSlide, startSlide] ++
@@ -134,6 +134,8 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
MathML (Just url) ->
script !
[src url, thetype "text/javascript"] $ noHtml
+ MathJax url ->
+ script ! [src url, thetype "text/javascript"] $ noHtml
JsMath (Just url) ->
script !
[src url, thetype "text/javascript"] $ noHtml
@@ -168,6 +170,7 @@ inTemplate opts tit auths date toc body' newvars =
, ("pagetitle", topTitle')
, ("title", renderHtmlFragment tit)
, ("date", date') ] ++
+ [ ("html5","true") | writerHtml5 opts ] ++
(case toc of
Just t -> [ ("toc", renderHtmlFragment t)]
Nothing -> []) ++
@@ -187,7 +190,12 @@ tableOfContents opts sects = do
let tocList = catMaybes contents
return $ if null tocList
then Nothing
- else Just $ thediv ! [prefixedId opts' "TOC"] $ unordList tocList
+ else Just $
+ if writerHtml5 opts
+ then tag "nav" ! [prefixedId opts' "TOC"] $
+ unordList tocList
+ else thediv ! [prefixedId opts' "TOC"] $
+ unordList tocList
-- | Convert section number to string
showSecNum :: [Int] -> String
@@ -224,7 +232,10 @@ elementToHtml opts (Sec level num id' title' elements) = do
return $ if slides -- S5 gets confused by the extra divs around sections
then toHtmlFromList stuff
else if writerSectionDivs opts
- then thediv ! [prefixedId opts id'] << stuff
+ then if writerHtml5 opts
+ then tag "section" ! [prefixedId opts id']
+ << stuff
+ else thediv ! [prefixedId opts id'] << stuff
else toHtmlFromList stuff
-- | Convert list of Note blocks to a footnote <div>.
@@ -287,6 +298,12 @@ obfuscateChar char =
obfuscateString :: String -> String
obfuscateString = concatMap obfuscateChar . decodeCharacterReferences
+attrsToHtml :: WriterOptions -> Attr -> [HtmlAttr]
+attrsToHtml opts (id',classes',keyvals) =
+ [theclass (unwords classes') | not (null classes')] ++
+ [prefixedId opts id' | not (null id')] ++
+ map (\(x,y) -> strAttr x y) keyvals
+
-- | Convert Pandoc block element to HTML.
blockToHtml :: WriterOptions -> Block -> State WriterState Html
blockToHtml _ Null = return $ noHtml
@@ -294,22 +311,24 @@ blockToHtml opts (Plain lst) = inlineListToHtml opts lst
blockToHtml opts (Para [Image txt (s,tit)]) = do
img <- inlineToHtml opts (Image txt (s,tit))
capt <- inlineListToHtml opts txt
- return $ thediv ! [theclass "figure"] <<
- [img, paragraph ! [theclass "caption"] << capt]
+ return $ if writerHtml5 opts
+ then tag "figure" <<
+ [img, tag "figcaption" << capt]
+ else thediv ! [theclass "figure"] <<
+ [img, paragraph ! [theclass "caption"] << capt]
blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)
-blockToHtml _ (RawHtml str) = return $ primHtml str
+blockToHtml _ (RawBlock "html" str) = return $ primHtml str
+blockToHtml _ (RawBlock _ _) = return noHtml
blockToHtml _ (HorizontalRule) = return $ hr
blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
let classes' = if writerLiterateHaskell opts
then classes
else filter (/= "literate") classes
- case highlightHtml (id',classes',keyvals) rawCode of
+ case highlightHtml False (id',classes',keyvals) rawCode of
Left _ -> -- change leading newlines into <br /> tags, because some
-- browsers ignore leading newlines in pre blocks
let (leadingBreaks, rawCode') = span (=='\n') rawCode
- attrs = [theclass (unwords classes') | not (null classes')] ++
- [prefixedId opts id' | not (null id')] ++
- map (\(x,y) -> strAttr x y) keyvals
+ attrs = attrsToHtml opts (id', classes', keyvals)
addBird = if "literate" `elem` classes'
then unlines . map ("> " ++) . lines
else unlines . lines
@@ -366,7 +385,17 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
then [start startnum]
else []) ++
(if numstyle /= DefaultStyle
- then [thestyle $ "list-style-type: " ++ numstyle' ++ ";"]
+ then if writerHtml5 opts
+ then [strAttr "type" $
+ case numstyle of
+ Decimal -> "1"
+ LowerAlpha -> "a"
+ UpperAlpha -> "A"
+ LowerRoman -> "i"
+ UpperRoman -> "I"
+ _ -> "1"]
+ else [thestyle $ "list-style-type: " ++
+ numstyle']
else [])
return $ ordList ! attribs $ contents
blockToHtml opts (DefinitionList lst) = do
@@ -379,28 +408,30 @@ blockToHtml opts (DefinitionList lst) = do
else []
return $ dlist ! attribs << concat contents
blockToHtml opts (Table capt aligns widths headers rows') = do
- let alignStrings = map alignmentToString aligns
captionDoc <- if null capt
then return noHtml
else inlineListToHtml opts capt >>= return . caption
let percent w = show (truncate (100*w) :: Integer) ++ "%"
+ let widthAttrs w = if writerHtml5 opts
+ then [thestyle $ "width: " ++ percent w]
+ else [width $ percent w]
let coltags = if all (== 0.0) widths
then noHtml
else concatHtml $ map
- (\w -> col ! [width $ percent w] $ noHtml) widths
+ (\w -> col ! (widthAttrs w) $ noHtml) widths
head' <- if all null headers
then return noHtml
- else liftM (thead <<) $ tableRowToHtml opts alignStrings 0 headers
+ else liftM (thead <<) $ tableRowToHtml opts aligns 0 headers
body' <- liftM (tbody <<) $
- zipWithM (tableRowToHtml opts alignStrings) [1..] rows'
+ zipWithM (tableRowToHtml opts aligns) [1..] rows'
return $ table $ captionDoc +++ coltags +++ head' +++ body'
tableRowToHtml :: WriterOptions
- -> [String]
+ -> [Alignment]
-> Int
-> [[Block]]
-> State WriterState Html
-tableRowToHtml opts alignStrings rownum cols' = do
+tableRowToHtml opts aligns rownum cols' = do
let mkcell = if rownum == 0 then th else td
let rowclass = case rownum of
0 -> "header"
@@ -408,7 +439,7 @@ tableRowToHtml opts alignStrings rownum cols' = do
_ -> "even"
cols'' <- sequence $ zipWith
(\alignment item -> tableItemToHtml opts mkcell alignment item)
- alignStrings cols'
+ aligns cols'
return $ tr ! [theclass rowclass] $ toHtmlFromList cols''
alignmentToString :: Alignment -> [Char]
@@ -420,12 +451,15 @@ alignmentToString alignment = case alignment of
tableItemToHtml :: WriterOptions
-> (Html -> Html)
- -> [Char]
+ -> Alignment
-> [Block]
-> State WriterState Html
tableItemToHtml opts tag' align' item = do
contents <- blockListToHtml opts item
- return $ tag' ! [align align'] $ contents
+ let alignAttrs = if writerHtml5 opts
+ then [thestyle $ "align: " ++ alignmentToString align']
+ else [align $ alignmentToString align']
+ return $ tag' ! alignAttrs $ contents
blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
blockListToHtml opts lst =
@@ -449,7 +483,11 @@ inlineToHtml opts inline =
(Apostrophe) -> return $ stringToHtml "’"
(Emph lst) -> inlineListToHtml opts lst >>= return . emphasize
(Strong lst) -> inlineListToHtml opts lst >>= return . strong
- (Code str) -> return $ thecode << str
+ (Code attr str) -> case highlightHtml True attr str of
+ Left _ -> return
+ $ thecode ! (attrsToHtml opts attr)
+ $ stringToHtml str
+ Right h -> return h
(Strikeout lst) -> inlineListToHtml opts lst >>=
return . (thespan ! [thestyle "text-decoration: line-through;"])
(SmallCaps lst) -> inlineListToHtml opts lst >>=
@@ -464,8 +502,7 @@ inlineToHtml opts inline =
stringToHtml "”")
in do contents <- inlineListToHtml opts lst
return $ leftQuote +++ contents +++ rightQuote
- (Math t str) ->
- modify (\st -> st {stMath = True}) >>
+ (Math t str) -> modify (\st -> st {stMath = True}) >>
(case writerHTMLMathMethod opts of
LaTeXMathML _ ->
-- putting LaTeXMathML in container with class "LaTeX" prevents
@@ -487,7 +524,9 @@ inlineToHtml opts inline =
InlineMath -> m
DisplayMath -> br +++ m +++ br
GladTeX ->
- return $ primHtml $ "<EQ>" ++ str ++ "</EQ>"
+ return $ case t of
+ InlineMath -> primHtml $ "<EQ ENV=\"math\">" ++ str ++ "</EQ>"
+ DisplayMath -> primHtml $ "<EQ ENV=\"displaymath\">" ++ str ++ "</EQ>"
MathML _ -> do
let dt = if t == InlineMath
then DisplayInline
@@ -500,18 +539,23 @@ inlineToHtml opts inline =
Left _ -> inlineListToHtml opts
(readTeXMath str) >>= return .
(thespan ! [theclass "math"])
+ MathJax _ -> return $ primHtml $
+ case t of
+ InlineMath -> "\\(" ++ str ++ "\\)"
+ DisplayMath -> "\\[" ++ str ++ "\\]"
PlainMath -> do
x <- inlineListToHtml opts (readTeXMath str)
let m = thespan ! [theclass "math"] $ x
return $ case t of
InlineMath -> m
DisplayMath -> br +++ m +++ br )
- (TeX str) -> case writerHTMLMathMethod opts of
- LaTeXMathML _ -> do modify (\st -> st {stMath = True})
- return $ primHtml str
- _ -> return noHtml
- (HtmlInline str) -> return $ primHtml str
- (Link [Code str] (s,_)) | "mailto:" `isPrefixOf` s ->
+ (RawInline "latex" str) -> case writerHTMLMathMethod opts of
+ LaTeXMathML _ -> do modify (\st -> st {stMath = True})
+ return $ primHtml str
+ _ -> return noHtml
+ (RawInline "html" str) -> return $ primHtml str
+ (RawInline _ _) -> return noHtml
+ (Link [Code _ str] (s,_)) | "mailto:" `isPrefixOf` s ->
return $ obfuscateLink opts str s
(Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do
linkText <- inlineListToHtml opts txt
@@ -551,7 +595,7 @@ blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html
blockListToNote opts ref blocks =
-- If last block is Para or Plain, include the backlink at the end of
-- that block. Otherwise, insert a new Plain block with the backlink.
- let backlink = [HtmlInline $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++
+ let backlink = [RawInline "html" $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++
"\" class=\"footnoteBackLink\"" ++
" title=\"Jump back to footnote " ++ ref ++ "\">↩</a>"]
blocks' = if null blocks
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 720c00ac8..28a1e7174 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@@ -29,13 +30,15 @@ Conversion of 'Pandoc' format into LaTeX.
-}
module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where
import Text.Pandoc.Definition
+import Text.Pandoc.Generic
import Text.Pandoc.Shared
import Text.Pandoc.Templates
import Text.Printf ( printf )
-import Data.List ( (\\), isSuffixOf, isPrefixOf, intersperse )
-import Data.Char ( toLower )
+import Data.List ( (\\), isSuffixOf, isPrefixOf, intercalate, intersperse )
+import Data.Char ( toLower, isPunctuation )
import Control.Monad.State
-import Text.PrettyPrint.HughesPJ hiding ( Str )
+import Text.Pandoc.Pretty
+import System.FilePath (dropExtension)
data WriterState =
WriterState { stInNote :: Bool -- @True@ if we're in a note
@@ -60,7 +63,7 @@ writeLaTeX options document =
stVerbInNote = False, stEnumerate = False,
stTable = False, stStrikeout = False, stSubscript = False,
stUrl = False, stGraphics = False,
- stLHS = False, stBook = False }
+ stLHS = False, stBook = writerChapters options }
pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState String
pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do
@@ -70,13 +73,34 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do
"{report}" `isSuffixOf` x)
when (any usesBookClass (lines template)) $
modify $ \s -> s{stBook = True}
- titletext <- liftM render $ inlineListToLaTeX title
- authorsText <- mapM (liftM render . inlineListToLaTeX) authors
- dateText <- liftM render $ inlineListToLaTeX date
- body <- blockListToLaTeX blocks
- let main = render body
+ opts <- liftM stOptions get
+ let colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ titletext <- liftM (render colwidth) $ inlineListToLaTeX title
+ authorsText <- mapM (liftM (render colwidth) . inlineListToLaTeX) authors
+ dateText <- liftM (render colwidth) $ inlineListToLaTeX date
+ let (blocks', lastHeader) = if writerCiteMethod options == Citeproc then
+ (blocks, [])
+ else case last blocks of
+ Header 1 il -> (init blocks, il)
+ _ -> (blocks, [])
+ body <- blockListToLaTeX blocks'
+ biblioTitle <- liftM (render colwidth) $ inlineListToLaTeX lastHeader
+ let main = render colwidth body
st <- get
- let context = writerVariables options ++
+ let biblioFiles = intercalate "," $ map dropExtension $ writerBiblioFiles options
+ citecontext = case writerCiteMethod options of
+ Natbib -> [ ("biblio-files", biblioFiles)
+ , ("biblio-title", biblioTitle)
+ , ("natbib", "yes")
+ ]
+ Biblatex -> [ ("biblio-files", biblioFiles)
+ , ("biblio-title", biblioTitle)
+ , ("biblatex", "yes")
+ ]
+ _ -> []
+ context = writerVariables options ++
[ ("toc", if writerTableOfContents options then "yes" else "")
, ("body", main)
, ("title", titletext)
@@ -91,7 +115,10 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do
[ ("url", "yes") | stUrl st ] ++
[ ("numbersections", "yes") | writerNumberSections options ] ++
[ ("lhs", "yes") | stLHS st ] ++
- [ ("graphics", "yes") | stGraphics st ]
+ [ ("graphics", "yes") | stGraphics st ] ++
+ [ ("book-class", "yes") | stBook st] ++
+ [ ("listings", "yes") | writerListings options ] ++
+ citecontext
return $ if writerStandalone options
then renderTemplate context template
else main
@@ -107,7 +134,13 @@ stringToLaTeX = escapeStringUsing latexEscapes
, ('|', "\\textbar{}")
, ('<', "\\textless{}")
, ('>', "\\textgreater{}")
+ , ('[', "{[}") -- to avoid interpretation as
+ , (']', "{]}") -- optional arguments
, ('\160', "~")
+ , ('\x2018', "`")
+ , ('\x2019', "'")
+ , ('\x201C', "``")
+ , ('\x201D', "''")
]
-- | Puts contents into LaTeX command.
@@ -118,49 +151,73 @@ inCmd cmd contents = char '\\' <> text cmd <> braces contents
-- (because it's illegal to have verbatim inside some command arguments)
deVerb :: [Inline] -> [Inline]
deVerb [] = []
-deVerb ((Code str):rest) =
- (TeX $ "\\texttt{" ++ stringToLaTeX str ++ "}"):(deVerb rest)
+deVerb ((Code _ str):rest) =
+ (RawInline "latex" $ "\\texttt{" ++ stringToLaTeX str ++ "}"):(deVerb rest)
deVerb (other:rest) = other:(deVerb rest)
-- | Convert Pandoc block element to LaTeX.
blockToLaTeX :: Block -- ^ Block to convert
-> State WriterState Doc
blockToLaTeX Null = return empty
-blockToLaTeX (Plain lst) = do
- st <- get
- let opts = stOptions st
- wrapTeXIfNeeded opts True inlineListToLaTeX lst
+blockToLaTeX (Plain lst) = inlineListToLaTeX lst
blockToLaTeX (Para [Image txt (src,tit)]) = do
capt <- inlineListToLaTeX txt
img <- inlineToLaTeX (Image txt (src,tit))
- return $ text "\\begin{figure}[htb]" $$ text "\\centering" $$ img $$
- (text "\\caption{" <> capt <> char '}') $$ text "\\end{figure}\n"
+ return $ "\\begin{figure}[htb]" $$ "\\centering" $$ img $$
+ ("\\caption{" <> capt <> char '}') $$ "\\end{figure}" $$ blankline
blockToLaTeX (Para lst) = do
- st <- get
- let opts = stOptions st
- result <- wrapTeXIfNeeded opts True inlineListToLaTeX lst
- return $ result <> char '\n'
+ result <- inlineListToLaTeX lst
+ return $ result <> blankline
blockToLaTeX (BlockQuote lst) = do
contents <- blockListToLaTeX lst
- return $ text "\\begin{quote}" $$ contents $$ text "\\end{quote}"
-blockToLaTeX (CodeBlock (_,classes,_) str) = do
+ return $ "\\begin{quote}" $$ contents $$ "\\end{quote}"
+blockToLaTeX (CodeBlock (_,classes,keyvalAttr) str) = do
st <- get
env <- if writerLiterateHaskell (stOptions st) && "haskell" `elem` classes &&
"literate" `elem` classes
then do
modify $ \s -> s{ stLHS = True }
return "code"
- else if stInNote st
- then do
- modify $ \s -> s{ stVerbInNote = True }
- return "Verbatim"
- else return "verbatim"
- return $ text ("\\begin{" ++ env ++ "}\n") <> text str <>
- text ("\n\\end{" ++ env ++ "}")
-blockToLaTeX (RawHtml _) = return empty
+ else if writerListings (stOptions st)
+ then return "lstlisting"
+ else if stInNote st
+ then do
+ modify $ \s -> s{ stVerbInNote = True }
+ return "Verbatim"
+ else return "verbatim"
+ let params = if writerListings (stOptions st)
+ then take 1
+ [ "language=" ++ lang | lang <- classes
+ , lang `elem` ["ABAP","IDL","Plasm","ACSL","inform"
+ ,"POV","Ada","Java","Prolog","Algol"
+ ,"JVMIS","Promela","Ant","ksh","Python"
+ ,"Assembler","Lisp","R","Awk","Logo"
+ ,"Reduce","bash","make","Rexx","Basic"
+ ,"Mathematica","RSL","C","Matlab","Ruby"
+ ,"C++","Mercury","S","Caml","MetaPost"
+ ,"SAS","Clean","Miranda","Scilab","Cobol"
+ ,"Mizar","sh","Comal","ML","SHELXL","csh"
+ ,"Modula-2","Simula","Delphi","MuPAD"
+ ,"SQL","Eiffel","NASTRAN","tcl","Elan"
+ ,"Oberon-2","TeX","erlang","OCL"
+ ,"VBScript","Euphoria","Octave","Verilog"
+ ,"Fortran","Oz","VHDL","GCL","Pascal"
+ ,"VRML","Gnuplot","Perl","XML","Haskell"
+ ,"PHP","XSLT","HTML","PL/I"]
+ ] ++
+ [ key ++ "=" ++ attr | (key,attr) <- keyvalAttr ]
+ else []
+ printParams
+ | null params = empty
+ | otherwise = "[" <> hsep (intersperse "," (map text params)) <>
+ "]"
+ return $ "\\begin{" <> text env <> "}" <> printParams $$ flush (text str) $$
+ "\\end{" <> text env <> "}" $$ cr -- final cr needed because of footnotes
+blockToLaTeX (RawBlock "latex" x) = return $ text x <> blankline
+blockToLaTeX (RawBlock _ _) = return empty
blockToLaTeX (BulletList lst) = do
items <- mapM listItemToLaTeX lst
- return $ text "\\begin{itemize}" $$ vcat items $$ text "\\end{itemize}"
+ return $ "\\begin{itemize}" $$ vcat items $$ "\\end{itemize}"
blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
st <- get
let oldlevel = stOLLevel st
@@ -179,20 +236,19 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
map toLower (toRomanNumeral oldlevel) ++
"}{" ++ show (start - 1) ++ "}"
else empty
- return $ text "\\begin{enumerate}" <> exemplar $$ resetcounter $$
- vcat items $$ text "\\end{enumerate}"
+ return $ "\\begin{enumerate}" <> exemplar $$ resetcounter $$
+ vcat items $$ "\\end{enumerate}"
blockToLaTeX (DefinitionList lst) = do
items <- mapM defListItemToLaTeX lst
- return $ text "\\begin{description}" $$ vcat items $$
- text "\\end{description}"
-blockToLaTeX HorizontalRule = return $ text $
- "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n"
+ return $ "\\begin{description}" $$ vcat items $$ "\\end{description}"
+blockToLaTeX HorizontalRule = return $
+ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}" $$ blankline
blockToLaTeX (Header level lst) = do
let lst' = deVerb lst
txt <- inlineListToLaTeX lst'
let noNote (Note _) = Str ""
noNote x = x
- let lstNoNotes = processWith noNote lst'
+ let lstNoNotes = bottomUp noNote lst'
-- footnotes in sections don't work unless you specify an optional
-- argument: \section[mysec]{mysec\footnote{blah}}
optional <- if lstNoNotes == lst'
@@ -202,30 +258,31 @@ blockToLaTeX (Header level lst) = do
return $ char '[' <> res <> char ']'
let stuffing = optional <> char '{' <> txt <> char '}'
book <- liftM stBook get
- return $ case (book, level) of
- (True, 1) -> text "\\chapter" <> stuffing <> char '\n'
- (True, 2) -> text "\\section" <> stuffing <> char '\n'
- (True, 3) -> text "\\subsection" <> stuffing <> char '\n'
- (True, 4) -> text "\\subsubsection" <> stuffing <> char '\n'
- (False, 1) -> text "\\section" <> stuffing <> char '\n'
- (False, 2) -> text "\\subsection" <> stuffing <> char '\n'
- (False, 3) -> text "\\subsubsection" <> stuffing <> char '\n'
- _ -> txt <> char '\n'
+ let level' = if book then level - 1 else level
+ let headerWith x y = text x <> y $$ blankline
+ return $ case level' of
+ 0 -> headerWith "\\chapter" stuffing
+ 1 -> headerWith "\\section" stuffing
+ 2 -> headerWith "\\subsection" stuffing
+ 3 -> headerWith "\\subsubsection" stuffing
+ 4 -> headerWith "\\paragraph" stuffing
+ 5 -> headerWith "\\subparagraph" stuffing
+ _ -> txt $$ blankline
blockToLaTeX (Table caption aligns widths heads rows) = do
headers <- if all null heads
then return empty
- else liftM ($$ text "\\hline") $ tableRowToLaTeX heads
+ else liftM ($$ "\\hline") $ (tableRowToLaTeX widths) heads
captionText <- inlineListToLaTeX caption
- rows' <- mapM tableRowToLaTeX rows
+ rows' <- mapM (tableRowToLaTeX widths) rows
let colDescriptors = concat $ zipWith toColDescriptor widths aligns
let tableBody = text ("\\begin{tabular}{" ++ colDescriptors ++ "}") $$
- headers $$ vcat rows' $$ text "\\end{tabular}"
- let centered txt = text "\\begin{center}" $$ txt $$ text "\\end{center}"
+ headers $$ vcat rows' $$ "\\end{tabular}"
+ let centered txt = "\\begin{center}" $$ txt $$ "\\end{center}"
modify $ \s -> s{ stTable = True }
return $ if isEmpty captionText
- then centered tableBody <> char '\n'
- else text "\\begin{table}[h]" $$ centered tableBody $$
- inCmd "caption" captionText $$ text "\\end{table}\n"
+ then centered tableBody $$ blankline
+ else "\\begin{table}[h]" $$ centered tableBody $$
+ inCmd "caption" captionText $$ "\\end{table}" $$ blankline
toColDescriptor :: Double -> Alignment -> String
toColDescriptor 0 align =
@@ -240,16 +297,19 @@ toColDescriptor width align = ">{\\PBS" ++
AlignRight -> "\\raggedleft"
AlignCenter -> "\\centering"
AlignDefault -> "\\raggedright") ++
- "\\hspace{0pt}}p{" ++ printf "%.2f" width ++
- "\\columnwidth}"
+ "\\hspace{0pt}}p{" ++ printf "%.2f" width ++ "\\columnwidth}"
blockListToLaTeX :: [Block] -> State WriterState Doc
blockListToLaTeX lst = mapM blockToLaTeX lst >>= return . vcat
-tableRowToLaTeX :: [[Block]] -> State WriterState Doc
-tableRowToLaTeX cols = mapM blockListToLaTeX cols >>=
- return . ($$ text "\\\\") . foldl (\row item -> row $$
- (if isEmpty row then text "" else text " & ") <> item) empty
+tableRowToLaTeX :: [Double] -> [[Block]] -> State WriterState Doc
+tableRowToLaTeX widths cols = do
+ renderedCells <- mapM blockListToLaTeX cols
+ let toCell 0 c = c
+ toCell w c = "\\parbox{" <> text (printf "%.2f" w) <>
+ "\\columnwidth}{" <> c <> cr <> "}"
+ let cells = zipWith toCell widths renderedCells
+ return $ (hcat $ intersperse (" & ") cells) <> "\\\\"
listItemToLaTeX :: [Block] -> State WriterState Doc
listItemToLaTeX lst = blockListToLaTeX lst >>= return . (text "\\item" $$) .
@@ -258,8 +318,8 @@ listItemToLaTeX lst = blockListToLaTeX lst >>= return . (text "\\item" $$) .
defListItemToLaTeX :: ([Inline], [[Block]]) -> State WriterState Doc
defListItemToLaTeX (term, defs) = do
term' <- inlineListToLaTeX $ deVerb term
- def' <- liftM (vcat . intersperse (text "")) $ mapM blockListToLaTeX defs
- return $ text "\\item[" <> term' <> text "]" $$ def'
+ def' <- liftM vsep $ mapM blockListToLaTeX defs
+ return $ "\\item" <> brackets term' $$ def'
-- | Convert list of inline elements to LaTeX.
inlineListToLaTeX :: [Inline] -- ^ Inlines to convert
@@ -292,60 +352,161 @@ inlineToLaTeX (Subscript lst) = do
return $ inCmd "textsubscr" contents
inlineToLaTeX (SmallCaps lst) =
inlineListToLaTeX (deVerb lst) >>= return . inCmd "textsc"
-inlineToLaTeX (Cite _ lst) =
- inlineListToLaTeX lst
-inlineToLaTeX (Code str) = do
+inlineToLaTeX (Cite cits lst) = do
+ st <- get
+ let opts = stOptions st
+ case writerCiteMethod opts of
+ Natbib -> citationsToNatbib cits
+ Biblatex -> citationsToBiblatex cits
+ _ -> inlineListToLaTeX lst
+
+inlineToLaTeX (Code _ str) = do
st <- get
when (stInNote st) $ modify $ \s -> s{ stVerbInNote = True }
let chr = ((enumFromTo '!' '~') \\ str) !! 0
- return $ text $ "\\verb" ++ [chr] ++ str ++ [chr]
+ if writerListings (stOptions st)
+ then return $ text $ "\\lstinline" ++ [chr] ++ str ++ [chr]
+ else return $ text $ "\\verb" ++ [chr] ++ str ++ [chr]
inlineToLaTeX (Quoted SingleQuote lst) = do
contents <- inlineListToLaTeX lst
let s1 = if (not (null lst)) && (isQuoted (head lst))
- then text "\\,"
- else empty
+ then "\\,"
+ else empty
let s2 = if (not (null lst)) && (isQuoted (last lst))
- then text "\\,"
+ then "\\,"
else empty
return $ char '`' <> s1 <> contents <> s2 <> char '\''
inlineToLaTeX (Quoted DoubleQuote lst) = do
contents <- inlineListToLaTeX lst
let s1 = if (not (null lst)) && (isQuoted (head lst))
- then text "\\,"
- else empty
+ then "\\,"
+ else empty
let s2 = if (not (null lst)) && (isQuoted (last lst))
- then text "\\,"
+ then "\\,"
else empty
- return $ text "``" <> s1 <> contents <> s2 <> text "''"
+ return $ "``" <> s1 <> contents <> s2 <> "''"
inlineToLaTeX Apostrophe = return $ char '\''
-inlineToLaTeX EmDash = return $ text "---"
-inlineToLaTeX EnDash = return $ text "--"
-inlineToLaTeX Ellipses = return $ text "\\ldots{}"
+inlineToLaTeX EmDash = return "---"
+inlineToLaTeX EnDash = return "--"
+inlineToLaTeX Ellipses = return "\\ldots{}"
inlineToLaTeX (Str str) = return $ text $ stringToLaTeX str
inlineToLaTeX (Math InlineMath str) = return $ char '$' <> text str <> char '$'
-inlineToLaTeX (Math DisplayMath str) = return $ text "\\[" <> text str <> text "\\]"
-inlineToLaTeX (TeX str) = return $ text str
-inlineToLaTeX (HtmlInline _) = return empty
-inlineToLaTeX (LineBreak) = return $ text "\\\\"
-inlineToLaTeX Space = return $ char ' '
+inlineToLaTeX (Math DisplayMath str) = return $ "\\[" <> text str <> "\\]"
+inlineToLaTeX (RawInline "latex" str) = return $ text str
+inlineToLaTeX (RawInline "tex" str) = return $ text str
+inlineToLaTeX (RawInline _ _) = return empty
+inlineToLaTeX (LineBreak) = return "\\\\"
+inlineToLaTeX Space = return space
inlineToLaTeX (Link txt (src, _)) =
case txt of
- [Code x] | x == src -> -- autolink
+ [Code _ x] | x == src -> -- autolink
do modify $ \s -> s{ stUrl = True }
return $ text $ "\\url{" ++ x ++ "}"
_ -> do contents <- inlineListToLaTeX $ deVerb txt
- return $ text ("\\href{" ++ src ++ "}{") <> contents <>
- char '}'
+ return $ text ("\\href{" ++ stringToLaTeX src ++ "}{") <>
+ contents <> char '}'
inlineToLaTeX (Image _ (source, _)) = do
modify $ \s -> s{ stGraphics = True }
- return $ text $ "\\includegraphics{" ++ source ++ "}"
+ return $ "\\includegraphics" <> braces (text source)
inlineToLaTeX (Note contents) = do
- st <- get
- put (st {stInNote = True})
+ modify (\s -> s{stInNote = True})
contents' <- blockListToLaTeX contents
modify (\s -> s {stInNote = False})
- let rawnote = stripTrailingNewlines $ render contents'
-- note: a \n before } is needed when note ends with a Verbatim environment
- let optNewline = "\\end{Verbatim}" `isSuffixOf` rawnote
- return $ text "\\footnote{" <>
- text rawnote <> (if optNewline then char '\n' else empty) <> char '}'
+ return $ "\\footnote" <> braces (nest 2 contents')
+
+
+citationsToNatbib :: [Citation] -> State WriterState Doc
+citationsToNatbib (one:[])
+ = citeCommand c p s k
+ where
+ Citation { citationId = k
+ , citationPrefix = p
+ , citationSuffix = s
+ , citationMode = m
+ }
+ = one
+ c = case m of
+ AuthorInText -> "citet"
+ SuppressAuthor -> "citeyearpar"
+ NormalCitation -> "citep"
+
+citationsToNatbib cits
+ | noPrefix (tail cits) && noSuffix (init cits) && ismode NormalCitation cits
+ = citeCommand "citep" p s ks
+ where
+ noPrefix = and . map (null . citationPrefix)
+ noSuffix = and . map (null . citationSuffix)
+ ismode m = and . map (((==) m) . citationMode)
+ p = citationPrefix $ head $ cits
+ s = citationSuffix $ last $ cits
+ ks = intercalate ", " $ map citationId cits
+
+citationsToNatbib (c:cs) | citationMode c == AuthorInText = do
+ author <- citeCommand "citeauthor" [] [] (citationId c)
+ cits <- citationsToNatbib (c { citationMode = SuppressAuthor } : cs)
+ return $ author <+> cits
+
+citationsToNatbib cits = do
+ cits' <- mapM convertOne cits
+ return $ text "\\citetext{" <> foldl combineTwo empty cits' <> text "}"
+ where
+ combineTwo a b | isEmpty a = b
+ | otherwise = a <> text "; " <> b
+ convertOne Citation { citationId = k
+ , citationPrefix = p
+ , citationSuffix = s
+ , citationMode = m
+ }
+ = case m of
+ AuthorInText -> citeCommand "citealt" p s k
+ SuppressAuthor -> citeCommand "citeyear" p s k
+ NormalCitation -> citeCommand "citealp" p s k
+
+citeCommand :: String -> [Inline] -> [Inline] -> String -> State WriterState Doc
+citeCommand c p s k = do
+ args <- citeArguments p s k
+ return $ text ("\\" ++ c) <> args
+
+citeArguments :: [Inline] -> [Inline] -> String -> State WriterState Doc
+citeArguments p s k = do
+ let s' = case s of
+ (Str (x:[]) : r) | isPunctuation x -> dropWhile (== Space) r
+ (Str (x:xs) : r) | isPunctuation x -> Str xs : r
+ _ -> s
+ pdoc <- inlineListToLaTeX p
+ sdoc <- inlineListToLaTeX s'
+ let optargs = case (isEmpty pdoc, isEmpty sdoc) of
+ (True, True ) -> empty
+ (True, False) -> brackets sdoc
+ (_ , _ ) -> brackets pdoc <> brackets sdoc
+ return $ optargs <> braces (text k)
+
+citationsToBiblatex :: [Citation] -> State WriterState Doc
+citationsToBiblatex (one:[])
+ = citeCommand cmd p s k
+ where
+ Citation { citationId = k
+ , citationPrefix = p
+ , citationSuffix = s
+ , citationMode = m
+ } = one
+ cmd = case m of
+ SuppressAuthor -> "autocite*"
+ AuthorInText -> "textcite"
+ NormalCitation -> "autocite"
+
+citationsToBiblatex (c:cs) = do
+ args <- mapM convertOne (c:cs)
+ return $ text cmd <> foldl (<>) empty args
+ where
+ cmd = case citationMode c of
+ AuthorInText -> "\\textcites"
+ _ -> "\\autocites"
+ convertOne Citation { citationId = k
+ , citationPrefix = p
+ , citationSuffix = s
+ }
+ = citeArguments p s k
+
+citationsToBiblatex _ = return empty
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index a46a18893..78b9274d6 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -35,7 +35,7 @@ import Text.Pandoc.Shared
import Text.Pandoc.Readers.TeXMath
import Text.Printf ( printf )
import Data.List ( isPrefixOf, intersperse, intercalate )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
+import Text.Pandoc.Pretty
import Control.Monad.State
type Notes = [[Block]]
@@ -52,27 +52,31 @@ pandocToMan opts (Pandoc (Meta title authors date) blocks) = do
titleText <- inlineListToMan opts title
authors' <- mapM (inlineListToMan opts) authors
date' <- inlineListToMan opts date
- let (cmdName, rest) = break (== ' ') $ render titleText
+ let colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ let render' = render colwidth
+ let (cmdName, rest) = break (== ' ') $ render' titleText
let (title', section) = case reverse cmdName of
(')':d:'(':xs) | d `elem` ['0'..'9'] ->
(text (reverse xs), char d)
- xs -> (text (reverse xs), doubleQuotes empty)
+ xs -> (text (reverse xs), doubleQuotes empty)
let description = hsep $
map (doubleQuotes . text . removeLeadingTrailingSpace) $
- splitBy '|' rest
+ splitBy (== '|') rest
body <- blockListToMan opts blocks
notes <- liftM stNotes get
notes' <- notesToMan opts (reverse notes)
- let main = render $ body $$ notes' $$ text ""
+ let main = render' $ body $$ notes' $$ text ""
hasTables <- liftM stHasTables get
let context = writerVariables opts ++
[ ("body", main)
- , ("title", render title')
- , ("section", render section)
- , ("date", render date')
- , ("description", render description) ] ++
+ , ("title", render' title')
+ , ("section", render' section)
+ , ("date", render' date')
+ , ("description", render' description) ] ++
[ ("has-tables", "yes") | hasTables ] ++
- [ ("author", render a) | a <- authors' ]
+ [ ("author", render' a) | a <- authors' ]
if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts
else return main
@@ -89,7 +93,7 @@ notesToMan opts notes =
noteToMan :: WriterOptions -> Int -> [Block] -> State WriterState Doc
noteToMan opts num note = do
contents <- blockListToMan opts note
- let marker = text "\n.SS [" <> text (show num) <> char ']'
+ let marker = cr <> text ".SS " <> brackets (text (show num))
return $ marker $$ contents
-- | Association list of characters to escape.
@@ -136,14 +140,14 @@ blockToMan :: WriterOptions -- ^ Options
-> State WriterState Doc
blockToMan _ Null = return empty
blockToMan opts (Plain inlines) =
- liftM vcat $ mapM (wrapIfNeeded opts (inlineListToMan opts)) $
- splitSentences inlines
+ liftM vcat $ mapM (inlineListToMan opts) $ splitSentences inlines
blockToMan opts (Para inlines) = do
- contents <- liftM vcat $ mapM (wrapIfNeeded opts (inlineListToMan opts)) $
+ contents <- liftM vcat $ mapM (inlineListToMan opts) $
splitSentences inlines
return $ text ".PP" $$ contents
-blockToMan _ (RawHtml _) = return empty
-blockToMan _ HorizontalRule = return $ text $ ".PP\n * * * * *"
+blockToMan _ (RawBlock "man" str) = return $ text str
+blockToMan _ (RawBlock _ _) = return empty
+blockToMan _ HorizontalRule = return $ text ".PP" $$ text " * * * * *"
blockToMan opts (Header level inlines) = do
contents <- inlineListToMan opts inlines
let heading = case level of
@@ -256,7 +260,7 @@ definitionListItemToMan opts (label, defs) = do
mapM (\item -> blockToMan opts item) rest
first' <- blockToMan opts first
return $ first' $$ text ".RS" $$ rest' $$ text ".RE"
- return $ text ".TP\n.B " <> labelText $+$ contents
+ return $ text ".TP" $$ text ".B " <> labelText $$ contents
-- | Convert list of Pandoc block elements to man.
blockListToMan :: WriterOptions -- ^ Options
@@ -303,23 +307,25 @@ inlineToMan _ EmDash = return $ text "\\[em]"
inlineToMan _ EnDash = return $ text "\\[en]"
inlineToMan _ Apostrophe = return $ char '\''
inlineToMan _ Ellipses = return $ text "\\&..."
-inlineToMan _ (Code str) =
+inlineToMan _ (Code _ str) =
return $ text $ "\\f[C]" ++ escapeCode str ++ "\\f[]"
inlineToMan _ (Str str) = return $ text $ escapeString str
inlineToMan opts (Math InlineMath str) = inlineListToMan opts $ readTeXMath str
inlineToMan opts (Math DisplayMath str) = do
contents <- inlineListToMan opts $ readTeXMath str
- return $ text ".RS" $$ contents $$ text ".RE"
-inlineToMan _ (TeX _) = return empty
-inlineToMan _ (HtmlInline _) = return empty
-inlineToMan _ (LineBreak) = return $ text "\n.PD 0\n.P\n.PD\n"
-inlineToMan _ Space = return $ char ' '
+ return $ cr <> text ".RS" $$ contents $$ text ".RE"
+inlineToMan _ (RawInline "man" str) = return $ text str
+inlineToMan _ (RawInline _ _) = return empty
+inlineToMan _ (LineBreak) = return $
+ cr <> text ".PD 0" $$ text ".P" $$ text ".PD" <> cr
+inlineToMan _ Space = return space
inlineToMan opts (Link txt (src, _)) = do
linktext <- inlineListToMan opts txt
let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src
- return $ if txt == [Code srcSuffix]
- then char '<' <> text srcSuffix <> char '>'
- else linktext <> text " (" <> text src <> char ')'
+ return $ case txt of
+ [Code _ s]
+ | s == srcSuffix -> char '<' <> text srcSuffix <> char '>'
+ _ -> linktext <> text " (" <> text src <> char ')'
inlineToMan opts (Image alternate (source, tit)) = do
let txt = if (null alternate) || (alternate == [Str ""]) ||
(alternate == [Str source]) -- to prevent autolinks
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 1b612006b..5e12c4aca 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@@ -31,13 +32,13 @@ Markdown: <http://daringfireball.net/projects/markdown/>
-}
module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
import Text.Pandoc.Definition
+import Text.Pandoc.Generic
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Shared
-import Text.Pandoc.Parsing
-import Text.Pandoc.Blocks
+import Text.Pandoc.Parsing hiding (blankline)
import Text.ParserCombinators.Parsec ( runParser, GenParser )
import Data.List ( group, isPrefixOf, find, intersperse, transpose )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
+import Text.Pandoc.Pretty
import Control.Monad.State
type Notes = [[Block]]
@@ -57,28 +58,28 @@ writeMarkdown opts document =
-- pictures, or inline formatting).
writePlain :: WriterOptions -> Pandoc -> String
writePlain opts document =
- evalState (pandocToMarkdown opts document') WriterState{ stNotes = []
- , stRefs = []
- , stPlain = True }
+ evalState (pandocToMarkdown opts{writerStrictMarkdown = True}
+ document') WriterState{ stNotes = []
+ , stRefs = []
+ , stPlain = True }
where document' = plainify document
plainify :: Pandoc -> Pandoc
-plainify = processWith go
- where go :: [Inline] -> [Inline]
- go (Emph xs : ys) = go xs ++ go ys
- go (Strong xs : ys) = go xs ++ go ys
- go (Strikeout xs : ys) = go xs ++ go ys
- go (Superscript xs : ys) = go xs ++ go ys
- go (Subscript xs : ys) = go xs ++ go ys
- go (SmallCaps xs : ys) = go xs ++ go ys
- go (Code s : ys) = Str s : go ys
- go (Math _ s : ys) = Str s : go ys
- go (TeX _ : ys) = Str "" : go ys
- go (HtmlInline _ : ys) = Str "" : go ys
- go (Link xs _ : ys) = go xs ++ go ys
- go (Image _ _ : ys) = go ys
- go (x : ys) = x : go ys
- go [] = []
+plainify = bottomUp go
+ where go :: Inline -> Inline
+ go (Emph xs) = SmallCaps xs
+ go (Strong xs) = SmallCaps xs
+ go (Strikeout xs) = SmallCaps xs
+ go (Superscript xs) = SmallCaps xs
+ go (Subscript xs) = SmallCaps xs
+ go (SmallCaps xs) = SmallCaps xs
+ go (Code _ s) = Str s
+ go (Math _ s) = Str s
+ go (RawInline _ _) = Str ""
+ go (Link xs _) = SmallCaps xs
+ go (Image xs _) = SmallCaps $ [Str "["] ++ xs ++ [Str "]"]
+ go (Cite _ cits) = SmallCaps cits
+ go x = x
-- | Return markdown representation of document.
pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
@@ -96,15 +97,20 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
notes' <- notesToMarkdown opts (reverse $ stNotes st)
st' <- get -- note that the notes may contain refs
refs' <- refsToMarkdown opts (reverse $ stRefs st')
- let main = render $ foldl ($+$) empty $ [body, notes', refs']
+ let colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ let main = render colwidth $ body <>
+ (if isEmpty notes' then empty else blankline <> notes') <>
+ (if isEmpty refs' then empty else blankline <> refs')
let context = writerVariables opts ++
- [ ("toc", render toc)
+ [ ("toc", render colwidth toc)
, ("body", main)
- , ("title", render title')
- , ("date", render date')
+ , ("title", render colwidth title')
+ , ("date", render colwidth date')
] ++
[ ("titleblock", "yes") | titleblock ] ++
- [ ("author", render a) | a <- authors' ]
+ [ ("author", render colwidth a) | a <- authors' ]
if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts
else return main
@@ -112,29 +118,36 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
-- | Return markdown representation of reference key table.
refsToMarkdown :: WriterOptions -> Refs -> State WriterState Doc
refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
-
+
-- | Return markdown representation of a reference key.
keyToMarkdown :: WriterOptions
-> ([Inline], (String, String))
-> State WriterState Doc
keyToMarkdown opts (label, (src, tit)) = do
label' <- inlineListToMarkdown opts label
- let tit' = if null tit then empty else text $ " \"" ++ tit ++ "\""
- return $ text " " <> char '[' <> label' <> char ']' <> text ": " <>
- text src <> tit'
+ let tit' = if null tit
+ then empty
+ else space <> "\"" <> text tit <> "\""
+ return $ nest 2 $ hang 2
+ ("[" <> label' <> "]:" <> space) (text src <> tit')
-- | Return markdown representation of notes.
notesToMarkdown :: WriterOptions -> [[Block]] -> State WriterState Doc
notesToMarkdown opts notes =
- mapM (\(num, note) -> noteToMarkdown opts num note) (zip [1..] notes) >>=
- return . vcat
+ mapM (\(num, note) -> noteToMarkdown opts num note) (zip [1..] notes) >>=
+ return . vsep
-- | Return markdown representation of a note.
noteToMarkdown :: WriterOptions -> Int -> [Block] -> State WriterState Doc
noteToMarkdown opts num blocks = do
contents <- blockListToMarkdown opts blocks
- let marker = text "[^" <> text (show num) <> text "]:"
- return $ hang' marker (writerTabStop opts) contents
+ let num' = text $ show num
+ let marker = text "[^" <> num' <> text "]:"
+ let markerSize = 4 + offset num'
+ let spacer = case writerTabStop opts - markerSize of
+ n | n > 0 -> text $ replicate n ' '
+ _ -> text " "
+ return $ hang (writerTabStop opts) (marker <> spacer) contents
-- | Escape special characters for Markdown.
escapeString :: String -> String
@@ -158,6 +171,22 @@ elementToListItem (Sec _ _ _ headerText subsecs) = [Plain headerText] ++
then []
else [BulletList $ map elementToListItem subsecs]
+attrsToMarkdown :: Attr -> Doc
+attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys]
+ where attribId = case attribs of
+ ([],_,_) -> empty
+ (i,_,_) -> "#" <> text i
+ attribClasses = case attribs of
+ (_,[],_) -> empty
+ (_,cs,_) -> hsep $
+ map (text . ('.':))
+ cs
+ attribKeys = case attribs of
+ (_,_,[]) -> empty
+ (_,_,ks) -> hsep $
+ map (\(k,v) -> text k
+ <> "=\"" <> text v <> "\"") ks
+
-- | Ordered list start parser for use in Para below.
olMarker :: GenParser Char ParserState Char
olMarker = do (start, style', delim) <- anyOrderedListMarker
@@ -169,134 +198,139 @@ olMarker = do (start, style', delim) <- anyOrderedListMarker
-- | True if string begins with an ordered list marker
beginsWithOrderedListMarker :: String -> Bool
-beginsWithOrderedListMarker str =
- case runParser olMarker defaultParserState "para start" str of
- Left _ -> False
+beginsWithOrderedListMarker str =
+ case runParser olMarker defaultParserState "para start" (take 10 str) of
+ Left _ -> False
Right _ -> True
-wrappedMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
-wrappedMarkdown opts inlines = do
- let chunks = splitBy LineBreak inlines
- let chunks' = if null chunks
- then []
- else (map (++ [Str " "]) $ init chunks) ++ [last chunks]
- lns <- mapM (wrapIfNeeded opts (inlineListToMarkdown opts)) chunks'
- return $ vcat lns
-
-- | Convert Pandoc block element to markdown.
blockToMarkdown :: WriterOptions -- ^ Options
-> Block -- ^ Block element
-> State WriterState Doc
blockToMarkdown _ Null = return empty
-blockToMarkdown opts (Plain inlines) =
- wrappedMarkdown opts inlines
+blockToMarkdown opts (Plain inlines) = do
+ contents <- inlineListToMarkdown opts inlines
+ return $ contents <> cr
blockToMarkdown opts (Para inlines) = do
- contents <- wrappedMarkdown opts inlines
+ contents <- inlineListToMarkdown opts inlines
-- escape if para starts with ordered list marker
- let esc = if (not (writerStrictMarkdown opts)) &&
- beginsWithOrderedListMarker (render contents)
- then char '\\'
- else empty
- return $ esc <> contents <> text "\n"
-blockToMarkdown _ (RawHtml str) = do
st <- get
- if stPlain st
- then return empty
- else return $ text str
-blockToMarkdown _ HorizontalRule = return $ text "\n* * * * *\n"
+ let esc = if (not (writerStrictMarkdown opts)) &&
+ not (stPlain st) &&
+ beginsWithOrderedListMarker (render Nothing contents)
+ then text "\\"
+ else empty
+ return $ esc <> contents <> blankline
+blockToMarkdown _ (RawBlock f str)
+ | f == "html" || f == "latex" || f == "tex" || f == "markdown" = do
+ st <- get
+ if stPlain st
+ then return empty
+ else return $ text str <> text "\n"
+blockToMarkdown _ (RawBlock _ _) = return empty
+blockToMarkdown _ HorizontalRule =
+ return $ blankline <> text "* * * * *" <> blankline
blockToMarkdown opts (Header level inlines) = do
contents <- inlineListToMarkdown opts inlines
st <- get
-- use setext style headers if in literate haskell mode.
-- ghc interprets '#' characters in column 1 as line number specifiers.
if writerLiterateHaskell opts || stPlain st
- then let len = length $ render contents
- in return $ contents <> text "\n" <>
- case level of
- 1 -> text $ replicate len '=' ++ "\n"
- 2 -> text $ replicate len '-' ++ "\n"
- _ -> empty
- else return $ text ((replicate level '#') ++ " ") <> contents <> text "\n"
-blockToMarkdown opts (CodeBlock (_,classes,_) str) | "haskell" `elem` classes &&
- "literate" `elem` classes &&
- writerLiterateHaskell opts =
- return $ (vcat $ map (text "> " <>) $ map text (lines str)) <> text "\n"
-blockToMarkdown opts (CodeBlock _ str) = return $
- (nest (writerTabStop opts) $ vcat $ map text (lines str)) <> text "\n"
+ then let len = offset contents
+ in return $ contents <> cr <>
+ (case level of
+ 1 -> text $ replicate len '='
+ 2 -> text $ replicate len '-'
+ _ -> empty) <> blankline
+ else return $
+ text ((replicate level '#') ++ " ") <> contents <> blankline
+blockToMarkdown opts (CodeBlock (_,classes,_) str)
+ | "haskell" `elem` classes && "literate" `elem` classes &&
+ writerLiterateHaskell opts =
+ return $ prefixed "> " (text str) <> blankline
+blockToMarkdown opts (CodeBlock attribs str) = return $
+ if writerStrictMarkdown opts || attribs == nullAttr
+ then nest (writerTabStop opts) (text str) <> blankline
+ else -- use delimited code block
+ flush (tildes <> space <> attrs <> cr <> text str <>
+ cr <> tildes) <> blankline
+ where tildes = text "~~~~"
+ attrs = attrsToMarkdown attribs
blockToMarkdown opts (BlockQuote blocks) = do
st <- get
-- if we're writing literate haskell, put a space before the bird tracks
-- so they won't be interpreted as lhs...
let leader = if writerLiterateHaskell opts
- then text . (" > " ++)
+ then " > "
else if stPlain st
- then text . (" " ++)
- else text . ("> " ++)
+ then " "
+ else "> "
contents <- blockListToMarkdown opts blocks
- return $ (vcat $ map leader $ lines $ render contents) <>
- text "\n"
+ return $ (prefixed leader contents) <> blankline
blockToMarkdown opts (Table caption aligns widths headers rows) = do
caption' <- inlineListToMarkdown opts caption
let caption'' = if null caption
then empty
- else text "" $+$ (text ": " <> caption')
+ else blankline <> ": " <> caption' <> blankline
headers' <- mapM (blockListToMarkdown opts) headers
let alignHeader alignment = case alignment of
- AlignLeft -> leftAlignBlock
- AlignCenter -> centerAlignBlock
- AlignRight -> rightAlignBlock
- AlignDefault -> leftAlignBlock
+ AlignLeft -> lblock
+ AlignCenter -> cblock
+ AlignRight -> rblock
+ AlignDefault -> lblock
rawRows <- mapM (mapM (blockListToMarkdown opts)) rows
let isSimple = all (==0) widths
- let numChars = maximum . map (length . render)
+ let numChars = maximum . map offset
let widthsInChars =
if isSimple
then map ((+2) . numChars) $ transpose (headers' : rawRows)
- else map (floor . (78 *)) widths
- let makeRow = hsepBlocks . (zipWith alignHeader aligns) .
- (zipWith docToBlock widthsInChars)
+ else map (floor . (fromIntegral (writerColumns opts) *)) widths
+ let makeRow = hcat . intersperse (lblock 1 (text " ")) .
+ (zipWith3 alignHeader aligns widthsInChars)
let rows' = map makeRow rawRows
let head' = makeRow headers'
- let maxRowHeight = maximum $ map heightOfBlock (head':rows')
- let underline = hsep $
- map (\width -> text $ replicate width '-') widthsInChars
+ let maxRowHeight = maximum $ map height (head':rows')
+ let underline = cat $ intersperse (text " ") $
+ map (\width -> text (replicate width '-')) widthsInChars
let border = if maxRowHeight > 1
- then text $ replicate (sum widthsInChars + (length widthsInChars - 1)) '-'
+ then text (replicate (sum widthsInChars +
+ length widthsInChars - 1) '-')
else if all null headers
then underline
else empty
let head'' = if all null headers
then empty
- else border $+$ blockToDoc head'
- let spacer = if maxRowHeight > 1
- then text ""
- else empty
- let body = vcat $ intersperse spacer $ map blockToDoc rows'
+ else border <> cr <> head'
+ let body = if maxRowHeight > 1
+ then vsep rows'
+ else vcat rows'
let bottom = if all null headers
then underline
else border
- return $ (nest 2 $ head'' $+$ underline $+$ body $+$
- bottom $+$ caption'') <> text "\n"
+ return $ nest 2 $ head'' $$ underline $$ body $$
+ bottom $$ blankline $$ caption'' $$ blankline
blockToMarkdown opts (BulletList items) = do
contents <- mapM (bulletListItemToMarkdown opts) items
- return $ (vcat contents) <> text "\n"
+ return $ cat contents <> blankline
blockToMarkdown opts (OrderedList attribs items) = do
let markers = orderedListMarkers attribs
let markers' = map (\m -> if length m < 3
then m ++ replicate (3 - length m) ' '
- else m) markers
+ else m) markers
contents <- mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $
- zip markers' items
- return $ (vcat contents) <> text "\n"
+ zip markers' items
+ return $ cat contents <> blankline
blockToMarkdown opts (DefinitionList items) = do
contents <- mapM (definitionListItemToMarkdown opts) items
- return $ (vcat contents) <> text "\n"
+ return $ cat contents <> blankline
-- | Convert bullet list item (list of blocks) to markdown.
bulletListItemToMarkdown :: WriterOptions -> [Block] -> State WriterState Doc
bulletListItemToMarkdown opts items = do
contents <- blockListToMarkdown opts items
- return $ hang' (text "- ") (writerTabStop opts) contents
+ let sps = replicate (writerTabStop opts - 2) ' '
+ let start = text ('-' : ' ' : sps)
+ return $ hang (writerTabStop opts) start $ contents <> cr
-- | Convert ordered list item (a list of blocks) to markdown.
orderedListItemToMarkdown :: WriterOptions -- ^ options
@@ -305,8 +339,11 @@ orderedListItemToMarkdown :: WriterOptions -- ^ options
-> State WriterState Doc
orderedListItemToMarkdown opts marker items = do
contents <- blockListToMarkdown opts items
- return $ hsep [nest (min (3 - length marker) 0) (text marker),
- nest (writerTabStop opts) contents]
+ let sps = case length marker - writerTabStop opts of
+ n | n > 0 -> text $ replicate n ' '
+ _ -> text " "
+ let start = text marker <> sps
+ return $ hang (writerTabStop opts) start $ contents <> cr
-- | Convert definition list item (label, list of blocks) to markdown.
definitionListItemToMarkdown :: WriterOptions
@@ -316,17 +353,20 @@ definitionListItemToMarkdown opts (label, defs) = do
labelText <- inlineListToMarkdown opts label
let tabStop = writerTabStop opts
st <- get
- let leader = if stPlain st then empty else text " ~"
- contents <- liftM vcat $
- mapM (liftM ((leader $$) . nest tabStop . vcat) . mapM (blockToMarkdown opts)) defs
- return $ labelText $+$ contents
+ let leader = if stPlain st then " " else " ~"
+ let sps = case writerTabStop opts - 3 of
+ n | n > 0 -> text $ replicate n ' '
+ _ -> text " "
+ defs' <- mapM (mapM (blockToMarkdown opts)) defs
+ let contents = vcat $ map (\d -> hang tabStop (leader <> sps) $ vcat d <> cr) defs'
+ return $ labelText <> cr <> contents <> cr
-- | Convert list of Pandoc block elements to markdown.
blockListToMarkdown :: WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
-> State WriterState Doc
blockListToMarkdown opts blocks =
- mapM (blockToMarkdown opts) blocks >>= return . vcat
+ mapM (blockToMarkdown opts) blocks >>= return . cat
-- | Get reference for target; if none exists, create unique one and return.
-- Prefer label if possible; otherwise, generate a unique key.
@@ -349,86 +389,132 @@ getReference label (src, tit) = do
-- | Convert list of Pandoc inline elements to markdown.
inlineListToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
inlineListToMarkdown opts lst =
- mapM (inlineToMarkdown opts) lst >>= return . hcat
+ mapM (inlineToMarkdown opts) lst >>= return . cat
+
+escapeSpaces :: Inline -> Inline
+escapeSpaces (Str s) = Str $ substitute " " "\\ " s
+escapeSpaces Space = Str "\\ "
+escapeSpaces x = x
-- | Convert Pandoc inline element to markdown.
inlineToMarkdown :: WriterOptions -> Inline -> State WriterState Doc
inlineToMarkdown opts (Emph lst) = do
contents <- inlineListToMarkdown opts lst
- return $ char '*' <> contents <> char '*'
+ return $ "*" <> contents <> "*"
inlineToMarkdown opts (Strong lst) = do
contents <- inlineListToMarkdown opts lst
- return $ text "**" <> contents <> text "**"
+ return $ "**" <> contents <> "**"
inlineToMarkdown opts (Strikeout lst) = do
contents <- inlineListToMarkdown opts lst
- return $ text "~~" <> contents <> text "~~"
+ return $ "~~" <> contents <> "~~"
inlineToMarkdown opts (Superscript lst) = do
- contents <- inlineListToMarkdown opts lst
- let contents' = text $ substitute " " "\\ " $ render contents
- return $ char '^' <> contents' <> char '^'
+ let lst' = bottomUp escapeSpaces lst
+ contents <- inlineListToMarkdown opts lst'
+ return $ "^" <> contents <> "^"
inlineToMarkdown opts (Subscript lst) = do
- contents <- inlineListToMarkdown opts lst
- let contents' = text $ substitute " " "\\ " $ render contents
- return $ char '~' <> contents' <> char '~'
+ let lst' = bottomUp escapeSpaces lst
+ contents <- inlineListToMarkdown opts lst'
+ return $ "~" <> contents <> "~"
inlineToMarkdown opts (SmallCaps lst) = inlineListToMarkdown opts lst
inlineToMarkdown opts (Quoted SingleQuote lst) = do
contents <- inlineListToMarkdown opts lst
- return $ char '‘' <> contents <> char '’'
+ return $ "‘" <> contents <> "’"
inlineToMarkdown opts (Quoted DoubleQuote lst) = do
contents <- inlineListToMarkdown opts lst
- return $ char '“' <> contents <> char '”'
-inlineToMarkdown _ EmDash = return $ char '\8212'
-inlineToMarkdown _ EnDash = return $ char '\8211'
-inlineToMarkdown _ Apostrophe = return $ char '\8217'
-inlineToMarkdown _ Ellipses = return $ char '\8230'
-inlineToMarkdown _ (Code str) =
+ return $ "“" <> contents <> "”"
+inlineToMarkdown _ EmDash = return "\8212"
+inlineToMarkdown _ EnDash = return "\8211"
+inlineToMarkdown _ Apostrophe = return "\8217"
+inlineToMarkdown _ Ellipses = return "\8230"
+inlineToMarkdown opts (Code attr str) =
let tickGroups = filter (\s -> '`' `elem` s) $ group str
longest = if null tickGroups
then 0
else maximum $ map length tickGroups
marker = replicate (longest + 1) '`'
- spacer = if (longest == 0) then "" else " " in
- return $ text (marker ++ spacer ++ str ++ spacer ++ marker)
+ spacer = if (longest == 0) then "" else " "
+ attrs = if writerStrictMarkdown opts || attr == nullAttr
+ then empty
+ else attrsToMarkdown attr
+ in return $ text (marker ++ spacer ++ str ++ spacer ++ marker) <> attrs
inlineToMarkdown _ (Str str) = do
st <- get
if stPlain st
then return $ text str
else return $ text $ escapeString str
-inlineToMarkdown _ (Math InlineMath str) = return $ char '$' <> text str <> char '$'
-inlineToMarkdown _ (Math DisplayMath str) = return $ text "$$" <> text str <> text "$$"
-inlineToMarkdown _ (TeX str) = return $ text str
-inlineToMarkdown _ (HtmlInline str) = return $ text str
-inlineToMarkdown _ (LineBreak) = return $ text " \n"
-inlineToMarkdown _ Space = return $ char ' '
-inlineToMarkdown opts (Cite _ cits) = inlineListToMarkdown opts cits
+inlineToMarkdown _ (Math InlineMath str) =
+ return $ "$" <> text str <> "$"
+inlineToMarkdown _ (Math DisplayMath str) =
+ return $ "$$" <> text str <> "$$"
+inlineToMarkdown _ (RawInline f str)
+ | f == "html" || f == "latex" || f == "tex" || f == "markdown" =
+ return $ text str
+inlineToMarkdown _ (RawInline _ _) = return empty
+inlineToMarkdown opts (LineBreak) = return $
+ if writerStrictMarkdown opts
+ then " " <> cr
+ else "\\" <> cr
+inlineToMarkdown _ Space = return space
+inlineToMarkdown opts (Cite (c:cs) lst)
+ | writerCiteMethod opts == Citeproc = inlineListToMarkdown opts lst
+ | citationMode c == AuthorInText = do
+ suffs <- inlineListToMarkdown opts $ citationSuffix c
+ rest <- mapM convertOne cs
+ let inbr = suffs <+> joincits rest
+ br = if isEmpty inbr then empty else char '[' <> inbr <> char ']'
+ return $ text ("@" ++ citationId c) <+> br
+ | otherwise = do
+ cits <- mapM convertOne (c:cs)
+ return $ text "[" <> joincits cits <> text "]"
+ where
+ joincits = hcat . intersperse (text "; ") . filter (not . isEmpty)
+ convertOne Citation { citationId = k
+ , citationPrefix = pinlines
+ , citationSuffix = sinlines
+ , citationMode = m }
+ = do
+ pdoc <- inlineListToMarkdown opts pinlines
+ sdoc <- inlineListToMarkdown opts sinlines
+ let k' = text (modekey m ++ "@" ++ k)
+ r = case sinlines of
+ Str (y:_):_ | y `elem` ",;]@" -> k' <> sdoc
+ _ -> k' <+> sdoc
+ return $ pdoc <+> r
+ modekey SuppressAuthor = "-"
+ modekey _ = ""
+inlineToMarkdown _ (Cite _ _) = return $ text ""
inlineToMarkdown opts (Link txt (src', tit)) = do
linktext <- inlineListToMarkdown opts txt
- let linktitle = if null tit then empty else text $ " \"" ++ tit ++ "\""
+ let linktitle = if null tit
+ then empty
+ else text $ " \"" ++ tit ++ "\""
let src = unescapeURI src'
let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src
let useRefLinks = writerReferenceLinks opts
- let useAuto = null tit && txt == [Code srcSuffix]
+ let useAuto = case (tit,txt) of
+ ("", [Code _ s]) | s == srcSuffix -> True
+ _ -> False
ref <- if useRefLinks then getReference txt (src, tit) else return []
reftext <- inlineListToMarkdown opts ref
return $ if useAuto
- then char '<' <> text srcSuffix <> char '>'
+ then "<" <> text srcSuffix <> ">"
else if useRefLinks
- then let first = char '[' <> linktext <> char ']'
+ then let first = "[" <> linktext <> "]"
second = if txt == ref
- then text "[]"
- else char '[' <> reftext <> char ']'
+ then "[]"
+ else "[" <> reftext <> "]"
in first <> second
- else char '[' <> linktext <> char ']' <>
- char '(' <> text src <> linktitle <> char ')'
+ else "[" <> linktext <> "](" <>
+ text src <> linktitle <> ")"
inlineToMarkdown opts (Image alternate (source, tit)) = do
let txt = if (null alternate) || (alternate == [Str ""]) ||
(alternate == [Str source]) -- to prevent autolinks
then [Str "image"]
else alternate
- linkPart <- inlineToMarkdown opts (Link txt (unescapeURI source, tit))
- return $ char '!' <> linkPart
+ linkPart <- inlineToMarkdown opts (Link txt (source, tit))
+ return $ "!" <> linkPart
inlineToMarkdown _ (Note contents) = do
modify (\st -> st{ stNotes = contents : stNotes st })
st <- get
let ref = show $ (length $ stNotes st)
- return $ text "[^" <> text ref <> char ']'
+ return $ "[^" <> text ref <> "]"
diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs
index e8cb33caf..a7c7fc482 100644
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/src/Text/Pandoc/Writers/MediaWiki.hs
@@ -96,7 +96,9 @@ blockToMediaWiki opts (Para inlines) = do
then "<p>" ++ contents ++ "</p>"
else contents ++ if null listLevel then "\n" else ""
-blockToMediaWiki _ (RawHtml str) = return str
+blockToMediaWiki _ (RawBlock "mediawiki" str) = return str
+blockToMediaWiki _ (RawBlock "html" str) = return str
+blockToMediaWiki _ (RawBlock _ _) = return ""
blockToMediaWiki _ HorizontalRule = return "\n-----\n"
@@ -360,7 +362,7 @@ inlineToMediaWiki _ Apostrophe = return "&rsquo;"
inlineToMediaWiki _ Ellipses = return "&hellip;"
-inlineToMediaWiki _ (Code str) =
+inlineToMediaWiki _ (Code _ str) =
return $ "<tt>" ++ (escapeString str) ++ "</tt>"
inlineToMediaWiki _ (Str str) = return $ escapeString str
@@ -368,9 +370,9 @@ inlineToMediaWiki _ (Str str) = return $ escapeString str
inlineToMediaWiki _ (Math _ str) = return $ "<math>" ++ str ++ "</math>"
-- note: str should NOT be escaped
-inlineToMediaWiki _ (TeX _) = return ""
-
-inlineToMediaWiki _ (HtmlInline str) = return str
+inlineToMediaWiki _ (RawInline "mediawiki" str) = return str
+inlineToMediaWiki _ (RawInline "html" str) = return str
+inlineToMediaWiki _ (RawInline _ _) = return ""
inlineToMediaWiki _ (LineBreak) = return "<br />\n"
@@ -378,12 +380,12 @@ inlineToMediaWiki _ Space = return " "
inlineToMediaWiki opts (Link txt (src, _)) = do
label <- inlineListToMediaWiki opts txt
- if txt == [Code src] -- autolink
- then return src
- else if isURI src
- then return $ "[" ++ src ++ " " ++ label ++ "]"
- else return $ "[[" ++ src' ++ "|" ++ label ++ "]]"
- where src' = case src of
+ case txt of
+ [Code _ s] | s == src -> return src
+ _ -> if isURI src
+ then return $ "[" ++ src ++ " " ++ label ++ "]"
+ else return $ "[[" ++ src' ++ "|" ++ label ++ "]]"
+ where src' = case src of
'/':xs -> xs -- with leading / it's a
_ -> src -- link to a help page
inlineToMediaWiki opts (Image alt (source, tit)) = do
diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
index 3b5ea7481..d2b56cd17 100644
--- a/src/Text/Pandoc/Writers/Native.hs
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@@ -25,62 +26,53 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Stability : alpha
Portability : portable
-Utility functions and definitions used by the various Pandoc modules.
+Conversion of a 'Pandoc' document to a string representation.
+
+Note: If @writerStandalone@ is @False@, only the document body
+is represented; otherwise, the full 'Pandoc' document, including the
+metadata.
-}
module Text.Pandoc.Writers.Native ( writeNative )
where
-import Text.Pandoc.Shared ( WriterOptions )
-import Data.List ( intercalate )
+import Text.Pandoc.Shared ( WriterOptions(..) )
+import Data.List ( intersperse )
import Text.Pandoc.Definition
+import Text.Pandoc.Pretty
--- | Indent string as a block.
-indentBy :: Int -- ^ Number of spaces to indent the block
- -> Int -- ^ Number of spaces (rel to block) to indent first line
- -> String -- ^ Contents of block to indent
- -> String
-indentBy _ _ [] = ""
-indentBy num first str =
- let (firstLine:restLines) = lines str
- firstLineIndent = num + first
- in (replicate firstLineIndent ' ') ++ firstLine ++ "\n" ++
- (intercalate "\n" $ map ((replicate num ' ') ++ ) restLines)
-
--- | Prettyprint list of Pandoc blocks elements.
-prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks
- -> [Block] -- ^ List of blocks
- -> String
-prettyBlockList indent [] = indentBy indent 0 "[]"
-prettyBlockList indent blocks = indentBy indent (-2) $ "[ " ++
- (intercalate "\n, " (map prettyBlock blocks)) ++ " ]"
+prettyList :: [Doc] -> Doc
+prettyList ds =
+ "[" <> (cat $ intersperse (cr <> ",") $ map (nest 1) ds) <> "]"
-- | Prettyprint Pandoc block element.
-prettyBlock :: Block -> String
-prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++
- (prettyBlockList 2 blocks)
+prettyBlock :: Block -> Doc
+prettyBlock (BlockQuote blocks) =
+ "BlockQuote" $$ prettyList (map prettyBlock blocks)
prettyBlock (OrderedList attribs blockLists) =
- "OrderedList " ++ show attribs ++ "\n" ++ indentBy 2 0 ("[ " ++
- (intercalate ", " $ map (\blocks -> prettyBlockList 2 blocks)
- blockLists)) ++ " ]"
-prettyBlock (BulletList blockLists) = "BulletList\n" ++
- indentBy 2 0 ("[ " ++ (intercalate ", "
- (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
-prettyBlock (DefinitionList items) = "DefinitionList\n" ++
- indentBy 2 0 ("[ " ++ (intercalate "\n, "
- (map (\(term, defs) -> "(" ++ show term ++ ",\n" ++
- indentBy 3 0 ("[ " ++ (intercalate ", "
- (map (\blocks -> prettyBlockList 2 blocks) defs)) ++ "]") ++
- ")") items))) ++ " ]"
+ "OrderedList" <> space <> text (show attribs) $$
+ (prettyList $ map (prettyList . map prettyBlock) blockLists)
+prettyBlock (BulletList blockLists) =
+ "BulletList" $$
+ (prettyList $ map (prettyList . map prettyBlock) blockLists)
+prettyBlock (DefinitionList items) = "DefinitionList" $$
+ (prettyList $ map deflistitem items)
+ where deflistitem (term, defs) = "(" <> text (show term) <> "," <> cr <>
+ nest 1 (prettyList $ map (prettyList . map prettyBlock) defs) <> ")"
prettyBlock (Table caption aligns widths header rows) =
- "Table " ++ show caption ++ " " ++ show aligns ++ " " ++
- show widths ++ "\n" ++ prettyRow header ++ " [\n" ++
- (intercalate ",\n" (map prettyRow rows)) ++ " ]"
- where prettyRow cols = indentBy 2 0 ("[ " ++ (intercalate ", "
- (map (\blocks -> prettyBlockList 2 blocks)
- cols))) ++ " ]"
-prettyBlock block = show block
+ "Table " <> text (show caption) <> " " <> text (show aligns) <> " " <>
+ text (show widths) $$
+ prettyRow header $$
+ prettyList (map prettyRow rows)
+ where prettyRow cols = prettyList (map (prettyList . map prettyBlock) cols)
+prettyBlock block = text $ show block
-- | Prettyprint Pandoc document.
writeNative :: WriterOptions -> Pandoc -> String
-writeNative _ (Pandoc meta blocks) = "Pandoc " ++ "(" ++ show meta ++
- ")\n" ++ (prettyBlockList 0 blocks) ++ "\n"
-
+writeNative opts (Pandoc meta blocks) =
+ let colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ withHead = if writerStandalone opts
+ then \bs -> text ("Pandoc " ++ "(" ++ show meta ++ ")") $$
+ bs $$ cr
+ else id
+ in render colwidth $ withHead $ prettyList $ map prettyBlock blocks
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index 5aa0fd310..cf1be8755 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -37,6 +37,7 @@ import System.Time
import Paths_pandoc ( getDataFileName )
import Text.Pandoc.Shared ( WriterOptions(..) )
import Text.Pandoc.Definition
+import Text.Pandoc.Generic
import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )
import System.Directory
import Control.Monad (liftM)
@@ -63,8 +64,8 @@ writeODT mbRefOdt opts doc = do
-- handle pictures
picEntriesRef <- newIORef ([] :: [Entry])
let sourceDir = writerSourceDirectory opts
- doc' <- processWithM (transformPic sourceDir picEntriesRef) doc
- let newContents = writeOpenDocument opts doc'
+ doc' <- bottomUpM (transformPic sourceDir picEntriesRef) doc
+ let newContents = writeOpenDocument opts{writerWrapText = False} doc'
(TOD epochtime _) <- getClockTime
let contentEntry = toEntry "content.xml" epochtime $ fromString newContents
picEntries <- readIORef picEntriesRef
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index 4e3979c07..b9444aac7 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -35,7 +35,7 @@ import Text.Pandoc.Shared
import Text.Pandoc.XML
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Readers.TeXMath
-import Text.PrettyPrint.HughesPJ hiding ( Str )
+import Text.Pandoc.Pretty
import Text.Printf ( printf )
import Control.Applicative ( (<$>) )
import Control.Arrow ( (***), (>>>) )
@@ -112,7 +112,9 @@ setInDefinitionList :: Bool -> State WriterState ()
setInDefinitionList b = modify $ \s -> s { stInDefinition = b }
inParagraphTags :: Doc -> Doc
-inParagraphTags = inTags False "text:p" [("text:style-name", "Text_20_body")]
+inParagraphTags d | isEmpty d = empty
+inParagraphTags d =
+ inTags False "text:p" [("text:style-name", "Text_20_body")] d
inParagraphTagsWithStyle :: String -> Doc -> Doc
inParagraphTagsWithStyle sty = inTags False "text:p" [("text:style-name", sty)]
@@ -167,7 +169,11 @@ writeOpenDocument opts (Pandoc (Meta title authors date) blocks) =
date'' <- inlinesToOpenDocument opts date
doc'' <- blocksToOpenDocument opts blocks
return (doc'', title'', authors'', date'')
- body' = render doc
+ colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ render' = render colwidth
+ body' = render' doc
styles = stTableStyles s ++ stParaStyles s ++ stTextStyles s
listStyle (n,l) = inTags True "text:list-style"
[("style:name", "L" ++ show n)] (vcat l)
@@ -176,10 +182,10 @@ writeOpenDocument opts (Pandoc (Meta title authors date) blocks) =
reverse $ styles ++ listStyles
context = writerVariables opts ++
[ ("body", body')
- , ("automatic-styles", render automaticStyles)
- , ("title", render title')
- , ("date", render date') ] ++
- [ ("author", render a) | a <- authors' ]
+ , ("automatic-styles", render' automaticStyles)
+ , ("title", render' title')
+ , ("date", render' date') ] ++
+ [ ("author", render' a) | a <- authors' ]
in if writerStandalone opts
then renderTemplate context $ writerTemplate opts
else body'
@@ -273,7 +279,7 @@ blockToOpenDocument o bs
| Header i b <- bs = inHeaderTags i <$> inlinesToOpenDocument o b
| BlockQuote b <- bs = mkBlockQuote b
| CodeBlock _ s <- bs = preformatted s
- | RawHtml _ <- bs = return empty
+ | RawBlock _ _ <- bs = return empty
| DefinitionList b <- bs = defList b
| BulletList b <- bs = bulletListToOpenDocument o b
| OrderedList a b <- bs = orderedList a b
@@ -286,7 +292,7 @@ blockToOpenDocument o bs
r <- vcat <$> mapM (deflistItemToOpenDocument o) b
setInDefinitionList False
return r
- preformatted s = vcat <$> mapM (inPreformattedTags . escapeStringForXML) (lines s)
+ preformatted s = (flush . vcat) <$> mapM (inPreformattedTags . escapeStringForXML) (lines s)
mkBlockQuote b = do increaseIndent
i <- paraStyle "Quotations" []
inBlockQuote o i (map plainToPara b)
@@ -346,7 +352,7 @@ inlineToOpenDocument o ils
| EmDash <- ils = inTextStyle $ text "&#8212;"
| EnDash <- ils = inTextStyle $ text "&#8211;"
| Apostrophe <- ils = inTextStyle $ text "&#8217;"
- | Space <- ils = inTextStyle $ char ' '
+ | Space <- ils = inTextStyle space
| LineBreak <- ils = return $ selfClosingTag "text:line-break" []
| Str s <- ils = inTextStyle $ handleSpaces $ escapeStringForXML s
| Emph l <- ils = withTextStyle Italic $ inlinesToOpenDocument o l
@@ -356,11 +362,12 @@ inlineToOpenDocument o ils
| Subscript l <- ils = withTextStyle Sub $ inlinesToOpenDocument o l
| SmallCaps l <- ils = withTextStyle SmallC $ inlinesToOpenDocument o l
| Quoted t l <- ils = inQuotes t <$> inlinesToOpenDocument o l
- | Code s <- ils = preformatted s
+ | Code _ s <- ils = preformatted s
| Math _ s <- ils = inlinesToOpenDocument o (readTeXMath s)
| Cite _ l <- ils = inlinesToOpenDocument o l
- | TeX s <- ils = preformatted s
- | HtmlInline s <- ils = preformatted s
+ | RawInline "opendocument" s <- ils = preformatted s
+ | RawInline "html" s <- ils = preformatted s -- for backwards compat.
+ | RawInline _ _ <- ils = return empty
| Link l (s,t) <- ils = mkLink s t <$> inlinesToOpenDocument o l
| Image _ (s,_) <- ils = return $ mkImg s
| Note l <- ils = mkNote l
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
new file mode 100644
index 000000000..f7f314428
--- /dev/null
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -0,0 +1,284 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-
+Copyright (C) 2006-2010 Puneeth Chaganti <punchagan@gmail.com>
+
+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.Org
+ Copyright : Copyright (C) 2010 Puneeth Chaganti
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Puneeth Chaganti <punchagan@gmail.com>
+ Stability : alpha
+ Portability : portable
+
+Conversion of 'Pandoc' documents to Emacs Org-Mode.
+
+Org-Mode: <http://orgmode.org>
+-}
+module Text.Pandoc.Writers.Org ( writeOrg) where
+import Text.Pandoc.Definition
+import Text.Pandoc.Shared
+import Text.Pandoc.Pretty
+import Text.Pandoc.Templates (renderTemplate)
+import Data.List ( intersect, intersperse, transpose )
+import Control.Monad.State
+import Control.Applicative ( (<$>) )
+
+data WriterState =
+ WriterState { stNotes :: [[Block]]
+ , stLinks :: Bool
+ , stImages :: Bool
+ , stHasMath :: Bool
+ , stOptions :: WriterOptions
+ }
+
+-- | Convert Pandoc to Org.
+writeOrg :: WriterOptions -> Pandoc -> String
+writeOrg opts document =
+ let st = WriterState { stNotes = [], stLinks = False,
+ stImages = False, stHasMath = False,
+ stOptions = opts }
+ in evalState (pandocToOrg document) st
+
+-- | Return Org representation of document.
+pandocToOrg :: Pandoc -> State WriterState String
+pandocToOrg (Pandoc (Meta tit auth dat) blocks) = do
+ opts <- liftM stOptions get
+ title <- titleToOrg tit
+ authors <- mapM inlineListToOrg auth
+ date <- inlineListToOrg dat
+ body <- blockListToOrg blocks
+ notes <- liftM (reverse . stNotes) get >>= notesToOrg
+ -- note that the notes may contain refs, so we do them first
+ hasMath <- liftM stHasMath get
+ let colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ let main = render colwidth $ foldl ($+$) empty $ [body, notes]
+ let context = writerVariables opts ++
+ [ ("body", main)
+ , ("title", render Nothing title)
+ , ("date", render Nothing date) ] ++
+ [ ("math", "yes") | hasMath ] ++
+ [ ("author", render Nothing a) | a <- authors ]
+ if writerStandalone opts
+ then return $ renderTemplate context $ writerTemplate opts
+ else return main
+
+-- | Return Org representation of notes.
+notesToOrg :: [[Block]] -> State WriterState Doc
+notesToOrg notes =
+ mapM (\(num, note) -> noteToOrg num note) (zip [1..] notes) >>=
+ return . vsep
+
+-- | Return Org representation of a note.
+noteToOrg :: Int -> [Block] -> State WriterState Doc
+noteToOrg num note = do
+ contents <- blockListToOrg note
+ let marker = "[" ++ show num ++ "] "
+ return $ hang (length marker) (text marker) contents
+
+-- | Escape special characters for Org.
+escapeString :: String -> String
+escapeString = escapeStringUsing (backslashEscapes "^_")
+
+titleToOrg :: [Inline] -> State WriterState Doc
+titleToOrg [] = return empty
+titleToOrg lst = do
+ contents <- inlineListToOrg lst
+ return $ "#+TITLE: " <> contents
+
+-- | Convert Pandoc block element to Org.
+blockToOrg :: Block -- ^ Block element
+ -> State WriterState Doc
+blockToOrg Null = return empty
+blockToOrg (Plain inlines) = inlineListToOrg inlines
+blockToOrg (Para [Image txt (src,tit)]) = do
+ capt <- inlineListToOrg txt
+ img <- inlineToOrg (Image txt (src,tit))
+ return $ "#+CAPTION: " <> capt <> blankline <> img
+blockToOrg (Para inlines) = do
+ contents <- inlineListToOrg inlines
+ return $ contents <> blankline
+blockToOrg (RawBlock "html" str) =
+ return $ blankline $$ "#+BEGIN_HTML" $$
+ nest 2 (text str) $$ "#+END_HTML" $$ blankline
+blockToOrg (RawBlock f str) | f == "org" || f == "latex" || f == "tex" =
+ return $ text str
+blockToOrg (RawBlock _ _) = return empty
+blockToOrg HorizontalRule = return $ blankline $$ "--------------" $$ blankline
+blockToOrg (Header level inlines) = do
+ contents <- inlineListToOrg inlines
+ let headerStr = text $ if level > 999 then " " else replicate level '*'
+ return $ headerStr <> " " <> contents <> blankline
+blockToOrg (CodeBlock (_,classes,_) str) = do
+ opts <- stOptions <$> get
+ let tabstop = writerTabStop opts
+ let at = classes `intersect` ["asymptote", "C", "clojure", "css", "ditaa",
+ "dot", "emacs-lisp", "gnuplot", "haskell", "js", "latex",
+ "ledger", "lisp", "matlab", "mscgen", "ocaml", "octave",
+ "oz", "perl", "plantuml", "python", "R", "ruby", "sass",
+ "scheme", "screen", "sh", "sql", "sqlite"]
+ let (beg, end) = if null at
+ then ("#+BEGIN_EXAMPLE", "#+END_EXAMPLE")
+ else ("#+BEGIN_SRC" ++ head at, "#+END_SRC")
+ return $ text beg $$ nest tabstop (text str) $$ text end $$ blankline
+blockToOrg (BlockQuote blocks) = do
+ contents <- blockListToOrg blocks
+ return $ blankline $$ "#+BEGIN_QUOTE" $$
+ nest 2 contents $$ "#+END_QUOTE" $$ blankline
+blockToOrg (Table caption' _ _ headers rows) = do
+ caption'' <- inlineListToOrg caption'
+ let caption = if null caption'
+ then empty
+ else ("#+CAPTION: " <> caption'')
+ headers' <- mapM blockListToOrg headers
+ rawRows <- mapM (mapM blockListToOrg) rows
+ let numChars = maximum . map offset
+ -- FIXME: width is not being used.
+ let widthsInChars =
+ map ((+2) . numChars) $ transpose (headers' : rawRows)
+ -- FIXME: Org doesn't allow blocks with height more than 1.
+ let hpipeBlocks blocks = hcat [beg, middle, end]
+ where h = maximum (map height blocks)
+ sep' = lblock 3 $ vcat (map text $ replicate h " | ")
+ beg = lblock 2 $ vcat (map text $ replicate h "| ")
+ end = lblock 2 $ vcat (map text $ replicate h " |")
+ middle = hcat $ intersperse sep' blocks
+ let makeRow = hpipeBlocks . zipWith lblock widthsInChars
+ let head' = makeRow headers'
+ rows' <- mapM (\row -> do cols <- mapM blockListToOrg row
+ return $ makeRow cols) rows
+ let border ch = char '|' <> char ch <>
+ (hcat $ intersperse (char ch <> char '+' <> char ch) $
+ map (\l -> text $ replicate l ch) widthsInChars) <>
+ char ch <> char '|'
+ let body = vcat rows'
+ let head'' = if all null headers
+ then empty
+ else head' $$ border '-'
+ return $ head'' $$ body $$ caption $$ blankline
+blockToOrg (BulletList items) = do
+ contents <- mapM bulletListItemToOrg items
+ -- ensure that sublists have preceding blank line
+ return $ blankline $+$ vcat contents $$ blankline
+blockToOrg (OrderedList (start, _, delim) items) = do
+ let delim' = case delim of
+ TwoParens -> OneParen
+ x -> x
+ let markers = take (length items) $ orderedListMarkers
+ (start, Decimal, delim')
+ let maxMarkerLength = maximum $ map length markers
+ let markers' = map (\m -> let s = maxMarkerLength - length m
+ in m ++ replicate s ' ') markers
+ contents <- mapM (\(item, num) -> orderedListItemToOrg item num) $
+ zip markers' items
+ -- ensure that sublists have preceding blank line
+ return $ blankline $$ vcat contents $$ blankline
+blockToOrg (DefinitionList items) = do
+ contents <- mapM definitionListItemToOrg items
+ return $ vcat contents $$ blankline
+
+-- | Convert bullet list item (list of blocks) to Org.
+bulletListItemToOrg :: [Block] -> State WriterState Doc
+bulletListItemToOrg items = do
+ contents <- blockListToOrg items
+ return $ hang 3 "- " (contents <> cr)
+
+-- | Convert ordered list item (a list of blocks) to Org.
+orderedListItemToOrg :: String -- ^ marker for list item
+ -> [Block] -- ^ list item (list of blocks)
+ -> State WriterState Doc
+orderedListItemToOrg marker items = do
+ contents <- blockListToOrg items
+ return $ hang (length marker + 1) (text marker <> space) (contents <> cr)
+
+-- | Convert defintion list item (label, list of blocks) to Org.
+definitionListItemToOrg :: ([Inline], [[Block]]) -> State WriterState Doc
+definitionListItemToOrg (label, defs) = do
+ label' <- inlineListToOrg label
+ contents <- liftM vcat $ mapM blockListToOrg defs
+ return $ hang 3 "- " $ label' <> " :: " <> (contents <> cr)
+
+-- | Convert list of Pandoc block elements to Org.
+blockListToOrg :: [Block] -- ^ List of block elements
+ -> State WriterState Doc
+blockListToOrg blocks = mapM blockToOrg blocks >>= return . vcat
+
+-- | Convert list of Pandoc inline elements to Org.
+inlineListToOrg :: [Inline] -> State WriterState Doc
+inlineListToOrg lst = mapM inlineToOrg lst >>= return . hcat
+
+-- | Convert Pandoc inline element to Org.
+inlineToOrg :: Inline -> State WriterState Doc
+inlineToOrg (Emph lst) = do
+ contents <- inlineListToOrg lst
+ return $ "/" <> contents <> "/"
+inlineToOrg (Strong lst) = do
+ contents <- inlineListToOrg lst
+ return $ "*" <> contents <> "*"
+inlineToOrg (Strikeout lst) = do
+ contents <- inlineListToOrg lst
+ return $ "+" <> contents <> "+"
+inlineToOrg (Superscript lst) = do
+ contents <- inlineListToOrg lst
+ return $ "^{" <> contents <> "}"
+inlineToOrg (Subscript lst) = do
+ contents <- inlineListToOrg lst
+ return $ "_{" <> contents <> "}"
+inlineToOrg (SmallCaps lst) = inlineListToOrg lst
+inlineToOrg (Quoted SingleQuote lst) = do
+ contents <- inlineListToOrg lst
+ return $ "'" <> contents <> "'"
+inlineToOrg (Quoted DoubleQuote lst) = do
+ contents <- inlineListToOrg lst
+ return $ "\"" <> contents <> "\""
+inlineToOrg (Cite _ lst) = inlineListToOrg lst
+inlineToOrg EmDash = return "---"
+inlineToOrg EnDash = return "--"
+inlineToOrg Apostrophe = return "'"
+inlineToOrg Ellipses = return "..."
+inlineToOrg (Code _ str) = return $ "=" <> text str <> "="
+inlineToOrg (Str str) = return $ text $ escapeString str
+inlineToOrg (Math t str) = do
+ modify $ \st -> st{ stHasMath = True }
+ return $ if t == InlineMath
+ then "$" <> text str <> "$"
+ else "$$" <> text str <> "$$"
+inlineToOrg (RawInline f str) | f == "tex" || f == "latex" = return $ text str
+inlineToOrg (RawInline _ _) = return empty
+inlineToOrg (LineBreak) = return cr -- there's no line break in Org
+inlineToOrg Space = return space
+inlineToOrg (Link txt (src, _)) = do
+ case txt of
+ [Code _ x] | x == src -> -- autolink
+ do modify $ \s -> s{ stLinks = True }
+ return $ "[[" <> text x <> "]]"
+ _ -> do contents <- inlineListToOrg txt
+ modify $ \s -> s{ stLinks = True }
+ return $ "[[" <> text src <> "][" <> contents <> "]]"
+inlineToOrg (Image _ (source', _)) = do
+ let source = unescapeURI source'
+ modify $ \s -> s{ stImages = True }
+ return $ "[[" <> text source <> "]]"
+inlineToOrg (Note contents) = do
+ -- add to notes in state
+ notes <- get >>= (return . stNotes)
+ modify $ \st -> st { stNotes = contents:notes }
+ let ref = show $ (length notes) + 1
+ return $ " [" <> text ref <> "]"
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index e79f97b33..d4adaa929 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@@ -32,10 +33,9 @@ reStructuredText: <http://docutils.sourceforge.net/rst.html>
module Text.Pandoc.Writers.RST ( writeRST) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
-import Text.Pandoc.Blocks
import Text.Pandoc.Templates (renderTemplate)
-import Data.List ( isPrefixOf, isSuffixOf, intersperse, transpose )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
+import Data.List ( isPrefixOf, intersperse, transpose )
+import Text.Pandoc.Pretty
import Control.Monad.State
import Control.Applicative ( (<$>) )
@@ -70,13 +70,16 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do
refs <- liftM (reverse . stLinks) get >>= refsToRST
pics <- liftM (reverse . stImages) get >>= pictRefsToRST
hasMath <- liftM stHasMath get
- let main = render $ foldl ($+$) empty $ [body, notes, refs, pics]
+ let colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ let main = render colwidth $ foldl ($+$) empty $ [body, notes, refs, pics]
let context = writerVariables opts ++
[ ("body", main)
- , ("title", render title)
- , ("date", render date) ] ++
+ , ("title", render Nothing title)
+ , ("date", render colwidth date) ] ++
[ ("math", "yes") | hasMath ] ++
- [ ("author", render a) | a <- authors ]
+ [ ("author", render colwidth a) | a <- authors ]
if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts
else return main
@@ -84,49 +87,40 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do
-- | Return RST representation of reference key table.
refsToRST :: Refs -> State WriterState Doc
refsToRST refs = mapM keyToRST refs >>= return . vcat
-
+
-- | Return RST representation of a reference key.
keyToRST :: ([Inline], (String, String))
-> State WriterState Doc
keyToRST (label, (src, _)) = do
label' <- inlineListToRST label
- let label'' = if ':' `elem` (render label')
+ let label'' = if ':' `elem` (render Nothing label')
then char '`' <> label' <> char '`'
else label'
- return $ text ".. _" <> label'' <> text ": " <> text src
+ return $ ".. _" <> label'' <> ": " <> text src
-- | Return RST representation of notes.
notesToRST :: [[Block]] -> State WriterState Doc
notesToRST notes =
- mapM (\(num, note) -> noteToRST num note) (zip [1..] notes) >>=
- return . vcat
+ mapM (\(num, note) -> noteToRST num note) (zip [1..] notes) >>=
+ return . vsep
-- | Return RST representation of a note.
noteToRST :: Int -> [Block] -> State WriterState Doc
noteToRST num note = do
contents <- blockListToRST note
- let marker = text ".. [" <> text (show num) <> text "]"
+ let marker = ".. [" <> text (show num) <> "]"
return $ marker $$ nest 3 contents
-- | Return RST representation of picture reference table.
pictRefsToRST :: Refs -> State WriterState Doc
pictRefsToRST refs = mapM pictToRST refs >>= return . vcat
-
+
-- | Return RST representation of a picture substitution reference.
pictToRST :: ([Inline], (String, String))
-> State WriterState Doc
pictToRST (label, (src, _)) = do
label' <- inlineListToRST label
- return $ text ".. " <> char '|' <> label' <> char '|' <> text " image:: " <>
- text src
-
--- | Take list of inline elements and return wrapped doc.
-wrappedRST :: WriterOptions -> [Inline] -> State WriterState Doc
-wrappedRST opts inlines = do
- lineBreakDoc <- inlineToRST LineBreak
- chunks <- mapM (wrapIfNeeded opts inlineListToRST)
- (splitBy LineBreak inlines)
- return $ vcat $ intersperse lineBreakDoc chunks
+ return $ ".. |" <> label' <> "| image:: " <> text src
-- | Escape special characters for RST.
escapeString :: String -> String
@@ -136,69 +130,66 @@ titleToRST :: [Inline] -> State WriterState Doc
titleToRST [] = return empty
titleToRST lst = do
contents <- inlineListToRST lst
- let titleLength = length $ render contents
+ let titleLength = length $ (render Nothing contents :: String)
let border = text (replicate titleLength '=')
- return $ border $+$ contents $+$ border
+ return $ border $$ contents $$ border
-- | Convert Pandoc block element to RST.
blockToRST :: Block -- ^ Block element
-> State WriterState Doc
blockToRST Null = return empty
-blockToRST (Plain inlines) = do
- opts <- get >>= (return . stOptions)
- wrappedRST opts inlines
+blockToRST (Plain inlines) = inlineListToRST inlines
blockToRST (Para [Image txt (src,tit)]) = do
capt <- inlineListToRST txt
- let fig = text "figure:: " <> text src
- let align = text ":align: center"
- let alt = text ":alt: " <> if null tit then capt else text tit
- return $ (text ".. " <> (fig $$ align $$ alt $$ text "" $$ capt)) $$ text ""
+ let fig = "figure:: " <> text src
+ let align = ":align: center"
+ let alt = ":alt: " <> if null tit then capt else text tit
+ return $ hang 3 ".. " $ fig $$ align $$ alt $+$ capt $$ blankline
blockToRST (Para inlines) = do
- opts <- get >>= (return . stOptions)
- contents <- wrappedRST opts inlines
- return $ contents <> text "\n"
-blockToRST (RawHtml str) =
- let str' = if "\n" `isSuffixOf` str then str ++ "\n" else str ++ "\n\n" in
- return $ (text "\n.. raw:: html\n") $$ (nest 3 $ vcat $ map text (lines str'))
-blockToRST HorizontalRule = return $ text "--------------\n"
+ contents <- inlineListToRST inlines
+ return $ contents <> blankline
+blockToRST (RawBlock f str) =
+ return $ blankline <> ".. raw:: " <> text f $+$
+ (nest 3 $ text str) $$ blankline
+blockToRST HorizontalRule =
+ return $ blankline $$ "--------------" $$ blankline
blockToRST (Header level inlines) = do
contents <- inlineListToRST inlines
- let headerLength = length $ render contents
let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1)
- let border = text $ replicate headerLength headerChar
- return $ contents $+$ border <> text "\n"
+ let border = text $ replicate (offset contents) headerChar
+ return $ contents $$ border $$ blankline
blockToRST (CodeBlock (_,classes,_) str) = do
opts <- stOptions <$> get
let tabstop = writerTabStop opts
if "haskell" `elem` classes && "literate" `elem` classes &&
writerLiterateHaskell opts
- then return $ (vcat $ map (text "> " <>) $ map text (lines str)) <> text "\n"
- else return $ (text "::\n") $+$
- (nest tabstop $ vcat $ map text (lines str)) <> text "\n"
+ then return $ prefixed "> " (text str) $$ blankline
+ else return $ "::" $+$ nest tabstop (text str) $$ blankline
blockToRST (BlockQuote blocks) = do
tabstop <- get >>= (return . writerTabStop . stOptions)
contents <- blockListToRST blocks
- return $ (nest tabstop contents) <> text "\n"
+ return $ (nest tabstop contents) <> blankline
blockToRST (Table caption _ widths headers rows) = do
caption' <- inlineListToRST caption
let caption'' = if null caption
then empty
- else text "" $+$ (text "Table: " <> caption')
+ else blankline <> text "Table: " <> caption'
headers' <- mapM blockListToRST headers
rawRows <- mapM (mapM blockListToRST) rows
let isSimple = all (==0) widths && all (all (\bs -> length bs == 1)) rows
- let numChars = maximum . map (length . render)
+ let numChars = maximum . map offset
+ opts <- get >>= return . stOptions
let widthsInChars =
if isSimple
then map ((+2) . numChars) $ transpose (headers' : rawRows)
- else map (floor . (78 *)) widths
- let hpipeBlocks blocks = hcatBlocks [beg, middle, end]
- where height = maximum (map heightOfBlock blocks)
- sep' = TextBlock 3 height (replicate height " | ")
- beg = TextBlock 2 height (replicate height "| ")
- end = TextBlock 2 height (replicate height " |")
- middle = hcatBlocks $ intersperse sep' blocks
- let makeRow = hpipeBlocks . zipWith docToBlock widthsInChars
+ else map (floor . (fromIntegral (writerColumns opts) *)) widths
+ let hpipeBlocks blocks = hcat [beg, middle, end]
+ where h = maximum (map height blocks)
+ sep' = lblock 3 $ vcat (map text $ replicate h " | ")
+ beg = lblock 2 $ vcat (map text $ replicate h "| ")
+ end = lblock 2 $ vcat (map text $ replicate h " |")
+ middle = hcat $ intersperse sep' blocks
+ let makeRow = hpipeBlocks . zipWith lblock widthsInChars
let head' = makeRow headers'
rows' <- mapM (\row -> do cols <- mapM blockListToRST row
return $ makeRow cols) rows
@@ -206,15 +197,15 @@ blockToRST (Table caption _ widths headers rows) = do
(hcat $ intersperse (char ch <> char '+' <> char ch) $
map (\l -> text $ replicate l ch) widthsInChars) <>
char ch <> char '+'
- let body = vcat $ intersperse (border '-') $ map blockToDoc rows'
+ let body = vcat $ intersperse (border '-') rows'
let head'' = if all null headers
then empty
- else blockToDoc head' $+$ border '='
- return $ border '-' $+$ head'' $+$ body $+$ border '-' $$ caption'' $$ text ""
+ else head' $$ border '='
+ return $ border '-' $$ head'' $$ body $$ border '-' $$ caption'' $$ blankline
blockToRST (BulletList items) = do
contents <- mapM bulletListItemToRST items
-- ensure that sublists have preceding blank line
- return $ text "" $+$ vcat contents <> text "\n"
+ return $ blankline $$ vcat contents $$ blankline
blockToRST (OrderedList (start, style', delim) items) = do
let markers = if start == 1 && style' == DefaultStyle && delim == DefaultDelim
then take (length items) $ repeat "#."
@@ -224,18 +215,19 @@ blockToRST (OrderedList (start, style', delim) items) = do
let markers' = map (\m -> let s = maxMarkerLength - length m
in m ++ replicate s ' ') markers
contents <- mapM (\(item, num) -> orderedListItemToRST item num) $
- zip markers' items
+ zip markers' items
-- ensure that sublists have preceding blank line
- return $ text "" $+$ vcat contents <> text "\n"
+ return $ blankline $$ vcat contents $$ blankline
blockToRST (DefinitionList items) = do
contents <- mapM definitionListItemToRST items
- return $ (vcat contents) <> text "\n"
+ -- ensure that sublists have preceding blank line
+ return $ blankline $$ vcat contents $$ blankline
-- | Convert bullet list item (list of blocks) to RST.
bulletListItemToRST :: [Block] -> State WriterState Doc
bulletListItemToRST items = do
contents <- blockListToRST items
- return $ (text "- ") <> contents
+ return $ hang 3 "- " $ contents <> cr
-- | Convert ordered list item (a list of blocks) to RST.
orderedListItemToRST :: String -- ^ marker for list item
@@ -243,7 +235,8 @@ orderedListItemToRST :: String -- ^ marker for list item
-> State WriterState Doc
orderedListItemToRST marker items = do
contents <- blockListToRST items
- return $ (text marker <> char ' ') <> contents
+ let marker' = marker ++ " "
+ return $ hang (length marker') (text marker') $ contents <> cr
-- | Convert defintion list item (label, list of blocks) to RST.
definitionListItemToRST :: ([Inline], [[Block]]) -> State WriterState Doc
@@ -251,7 +244,7 @@ definitionListItemToRST (label, defs) = do
label' <- inlineListToRST label
contents <- liftM vcat $ mapM blockListToRST defs
tabstop <- get >>= (return . writerTabStop . stOptions)
- return $ label' $+$ nest tabstop contents
+ return $ label' $$ nest tabstop (contents <> cr)
-- | Convert list of Pandoc block elements to RST.
blockListToRST :: [Block] -- ^ List of block elements
@@ -266,65 +259,63 @@ inlineListToRST lst = mapM inlineToRST lst >>= return . hcat
inlineToRST :: Inline -> State WriterState Doc
inlineToRST (Emph lst) = do
contents <- inlineListToRST lst
- return $ char '*' <> contents <> char '*'
+ return $ "*" <> contents <> "*"
inlineToRST (Strong lst) = do
contents <- inlineListToRST lst
- return $ text "**" <> contents <> text "**"
+ return $ "**" <> contents <> "**"
inlineToRST (Strikeout lst) = do
contents <- inlineListToRST lst
- return $ text "[STRIKEOUT:" <> contents <> char ']'
+ return $ "[STRIKEOUT:" <> contents <> "]"
inlineToRST (Superscript lst) = do
contents <- inlineListToRST lst
- return $ text "\\ :sup:`" <> contents <> text "`\\ "
+ return $ "\\ :sup:`" <> contents <> "`\\ "
inlineToRST (Subscript lst) = do
contents <- inlineListToRST lst
- return $ text "\\ :sub:`" <> contents <> text "`\\ "
+ return $ "\\ :sub:`" <> contents <> "`\\ "
inlineToRST (SmallCaps lst) = inlineListToRST lst
inlineToRST (Quoted SingleQuote lst) = do
contents <- inlineListToRST lst
- return $ char '‘' <> contents <> char '’'
+ return $ "‘" <> contents <> "’"
inlineToRST (Quoted DoubleQuote lst) = do
contents <- inlineListToRST lst
- return $ char '“' <> contents <> char '”'
+ return $ "“" <> contents <> "”"
inlineToRST (Cite _ lst) =
inlineListToRST lst
inlineToRST EmDash = return $ char '\8212'
inlineToRST EnDash = return $ char '\8211'
inlineToRST Apostrophe = return $ char '\8217'
inlineToRST Ellipses = return $ char '\8230'
-inlineToRST (Code str) = return $ text $ "``" ++ str ++ "``"
+inlineToRST (Code _ str) = return $ "``" <> text str <> "``"
inlineToRST (Str str) = return $ text $ escapeString str
inlineToRST (Math t str) = do
modify $ \st -> st{ stHasMath = True }
return $ if t == InlineMath
- then text $ ":math:`$" ++ str ++ "$`"
- else text $ ":math:`$$" ++ str ++ "$$`"
-inlineToRST (TeX _) = return empty
-inlineToRST (HtmlInline _) = return empty
-inlineToRST (LineBreak) = do
- return $ empty -- there's no line break in RST
-inlineToRST Space = return $ char ' '
-inlineToRST (Link [Code str] (src, _)) | src == str ||
- src == "mailto:" ++ str = do
+ then ":math:`$" <> text str <> "$`"
+ else ":math:`$$" <> text str <> "$$`"
+inlineToRST (RawInline _ _) = return empty
+inlineToRST (LineBreak) = return cr -- there's no line break in RST
+inlineToRST Space = return space
+inlineToRST (Link [Code _ str] (src, _)) | src == str ||
+ src == "mailto:" ++ str = do
let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src
return $ text $ unescapeURI srcSuffix
inlineToRST (Link txt (src', tit)) = do
let src = unescapeURI src'
- useReferenceLinks <- get >>= (return . writerReferenceLinks . stOptions)
+ useReferenceLinks <- get >>= return . writerReferenceLinks . stOptions
linktext <- inlineListToRST $ normalizeSpaces txt
if useReferenceLinks
- then do refs <- get >>= (return . stLinks)
+ then do refs <- get >>= return . stLinks
let refs' = if (txt, (src, tit)) `elem` refs
then refs
else (txt, (src, tit)):refs
modify $ \st -> st { stLinks = refs' }
- return $ char '`' <> linktext <> text "`_"
- else return $ char '`' <> linktext <> text " <" <> text src <> text ">`_"
+ return $ "`" <> linktext <> "`_"
+ else return $ "`" <> linktext <> " <" <> text src <> ">`_"
inlineToRST (Image alternate (source', tit)) = do
let source = unescapeURI source'
- pics <- get >>= (return . stImages)
+ pics <- get >>= return . stImages
let labelsUsed = map fst pics
- let txt = if null alternate || alternate == [Str ""] ||
+ let txt = if null alternate || alternate == [Str ""] ||
alternate `elem` labelsUsed
then [Str $ "image" ++ show (length pics)]
else alternate
@@ -333,10 +324,10 @@ inlineToRST (Image alternate (source', tit)) = do
else (txt, (source, tit)):pics
modify $ \st -> st { stImages = pics' }
label <- inlineListToRST txt
- return $ char '|' <> label <> char '|'
+ return $ "|" <> label <> "|"
inlineToRST (Note contents) = do
-- add to notes in state
- notes <- get >>= (return . stNotes)
+ notes <- get >>= return . stNotes
modify $ \st -> st { stNotes = contents:notes }
let ref = show $ (length notes) + 1
- return $ text " [" <> text ref <> text "]_"
+ return $ " [" <> text ref <> "]_"
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index ae71e1307..605e4162b 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -27,13 +27,34 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion of 'Pandoc' documents to RTF (rich text format).
-}
-module Text.Pandoc.Writers.RTF ( writeRTF ) where
+module Text.Pandoc.Writers.RTF ( writeRTF, rtfEmbedImage ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Templates (renderTemplate)
import Data.List ( isSuffixOf, intercalate )
-import Data.Char ( ord, isDigit )
+import Data.Char ( ord, isDigit, toLower )
+import System.FilePath ( takeExtension )
+import qualified Data.ByteString as B
+import Text.Printf ( printf )
+
+-- | Convert Image inlines into a raw RTF embedded image, read from a file.
+-- If file not found or filetype not jpeg or png, leave the inline unchanged.
+rtfEmbedImage :: Inline -> IO Inline
+rtfEmbedImage x@(Image _ (src,_))
+ | map toLower (takeExtension src) `elem` [".jpg",".jpeg",".png"] = do
+ imgdata <- catch (B.readFile src) (\_ -> return B.empty)
+ let bytes = map (printf "%02x") $ B.unpack imgdata
+ let filetype = case map toLower (takeExtension src) of
+ ".jpg" -> "\\jpegblip"
+ ".jpeg" -> "\\jpegblip"
+ ".png" -> "\\pngblip"
+ _ -> error "Unknown file type"
+ let raw = "{\\pict" ++ filetype ++ " " ++ concat bytes ++ "}"
+ return $ if B.null imgdata
+ then x
+ else RawInline "rtf" raw
+rtfEmbedImage x = return x
-- | Convert Pandoc to a string in rich text format.
writeRTF :: WriterOptions -> Pandoc -> String
@@ -159,7 +180,8 @@ blockToRTF indent alignment (BlockQuote lst) =
concatMap (blockToRTF (indent + indentIncrement) alignment) lst
blockToRTF indent _ (CodeBlock _ str) =
rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str))
-blockToRTF _ _ (RawHtml _) = ""
+blockToRTF _ _ (RawBlock "rtf" str) = str
+blockToRTF _ _ (RawBlock _ _) = ""
blockToRTF indent alignment (BulletList lst) = spaceAtEnd $
concatMap (listItemToRTF alignment indent (bulletMarker indent)) lst
blockToRTF indent alignment (OrderedList attribs lst) = spaceAtEnd $ concat $
@@ -264,12 +286,12 @@ inlineToRTF Apostrophe = "\\u8217'"
inlineToRTF Ellipses = "\\u8230?"
inlineToRTF EmDash = "\\u8212-"
inlineToRTF EnDash = "\\u8211-"
-inlineToRTF (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "}"
+inlineToRTF (Code _ str) = "{\\f1 " ++ (codeStringToRTF str) ++ "}"
inlineToRTF (Str str) = stringToRTF str
inlineToRTF (Math _ str) = inlineListToRTF $ readTeXMath str
inlineToRTF (Cite _ lst) = inlineListToRTF lst
-inlineToRTF (TeX _) = ""
-inlineToRTF (HtmlInline _) = ""
+inlineToRTF (RawInline "rtf" str) = str
+inlineToRTF (RawInline _ _) = ""
inlineToRTF (LineBreak) = "\\line "
inlineToRTF Space = " "
inlineToRTF (Link text (src, _)) =
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index 65e053827..c8638cdd7 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/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)
- , ("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,22 +126,25 @@ 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
+blockToTexinfo (RawBlock "texinfo" str) = return $ text str
+blockToTexinfo (RawBlock "latex" str) =
+ return $ text "@tex" $$ text str $$ text "@end tex"
+blockToTexinfo (RawBlock _ _) = return empty
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 +164,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 +180,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,18 +205,18 @@ 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) $$
headers $$
vcat rowsText $$
- text "@end multitable"
+ text "@end multitable"
return $ if isEmpty captionText
- then tableBody <> char '\n'
+ then tableBody <> blankline
else text "@float" $$
- tableBody $$
+ tableBody $$
inCmd "caption" captionText $$
text "@end float"
@@ -253,7 +258,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 +281,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 +312,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 +338,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
@@ -383,7 +372,7 @@ inlineToTexinfo (Subscript lst) = do
inlineToTexinfo (SmallCaps lst) =
inlineListToTexinfo lst >>= return . inCmd "sc"
-inlineToTexinfo (Code str) = do
+inlineToTexinfo (Code _ str) = do
return $ text $ "@code{" ++ stringToTexinfo str ++ "}"
inlineToTexinfo (Quoted SingleQuote lst) = do
@@ -402,14 +391,16 @@ 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 (RawInline f str) | f == "latex" || f == "tex" =
+ return $ text "@tex" $$ text str $$ text "@end tex"
+inlineToTexinfo (RawInline "texinfo" str) = return $ text str
+inlineToTexinfo (RawInline _ _) = return empty
inlineToTexinfo (LineBreak) = return $ text "@*"
inlineToTexinfo Space = return $ char ' '
inlineToTexinfo (Link txt (src, _)) = do
case txt of
- [Code x] | x == src -> -- autolink
+ [Code _ x] | x == src -> -- autolink
do return $ text $ "@url{" ++ x ++ "}"
_ -> do contents <- inlineListToTexinfo txt
let src1 = stringToTexinfo src
@@ -429,9 +420,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'
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs
new file mode 100644
index 000000000..6614ec28e
--- /dev/null
+++ b/src/Text/Pandoc/Writers/Textile.hs
@@ -0,0 +1,422 @@
+{-
+Copyright (C) 2010 John MacFarlane <jgm@berkeley.edu>
+
+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.Textile
+ Copyright : Copyright (C) 2010 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <jgm@berkeley.edu>
+ Stability : alpha
+ Portability : portable
+
+Conversion of 'Pandoc' documents to Textile markup.
+
+Textile: <http://thresholdstate.com/articles/4312/the-textile-reference-manual>
+-}
+module Text.Pandoc.Writers.Textile ( writeTextile ) where
+import Text.Pandoc.Definition
+import Text.Pandoc.Shared
+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. "**"
+ , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list
+ }
+
+-- | Convert Pandoc to Textile.
+writeTextile :: WriterOptions -> Pandoc -> String
+writeTextile opts document =
+ evalState (pandocToTextile opts document)
+ (WriterState { stNotes = [], stListLevel = [], stUseTags = False })
+
+-- | Return Textile representation of document.
+pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String
+pandocToTextile opts (Pandoc _ blocks) = do
+ body <- blockListToTextile opts blocks
+ notes <- liftM (unlines . reverse . stNotes) get
+ let main = body ++ if null notes then "" else ("\n\n" ++ notes)
+ let context = writerVariables opts ++ [ ("body", main) ]
+ if writerStandalone opts
+ then return $ renderTemplate context $ writerTemplate opts
+ else return main
+
+withUseTags :: State WriterState a -> State WriterState a
+withUseTags action = do
+ oldUseTags <- liftM stUseTags get
+ modify $ \s -> s { stUseTags = True }
+ result <- action
+ modify $ \s -> s { stUseTags = oldUseTags }
+ return result
+
+-- | Escape one character as needed for Textile.
+escapeCharForTextile :: Char -> String
+escapeCharForTextile x = case x of
+ '&' -> "&amp;"
+ '<' -> "&lt;"
+ '>' -> "&gt;"
+ '"' -> "&quot;"
+ '*' -> "&#42;"
+ '_' -> "&#95;"
+ '@' -> "&#64;"
+ '|' -> "&#124;"
+ c -> [c]
+
+-- | Escape string as needed for Textile.
+escapeStringForTextile :: String -> String
+escapeStringForTextile = concatMap escapeCharForTextile
+
+-- | Convert Pandoc block element to Textile.
+blockToTextile :: WriterOptions -- ^ Options
+ -> Block -- ^ Block element
+ -> State WriterState String
+
+blockToTextile _ Null = return ""
+
+blockToTextile opts (Plain inlines) =
+ inlineListToTextile opts inlines
+
+blockToTextile opts (Para [Image txt (src,tit)]) = do
+ capt <- blockToTextile opts (Para txt)
+ im <- inlineToTextile opts (Image txt (src,tit))
+ return $ im ++ "\n" ++ capt
+
+blockToTextile opts (Para inlines) = do
+ useTags <- liftM stUseTags get
+ listLevel <- liftM stListLevel get
+ contents <- inlineListToTextile opts inlines
+ return $ if useTags
+ then "<p>" ++ contents ++ "</p>"
+ else contents ++ if null listLevel then "\n" else ""
+
+blockToTextile _ (RawBlock f str) =
+ if f == "html" || f == "textile"
+ then return str
+ else return ""
+
+blockToTextile _ HorizontalRule = return "<hr />\n"
+
+blockToTextile opts (Header level inlines) = do
+ contents <- inlineListToTextile opts inlines
+ let prefix = 'h' : (show level ++ ". ")
+ 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 opts (BlockQuote blocks) = do
+ contents <- blockListToTextile opts blocks
+ return $ "<blockquote>\n\n" ++ contents ++ "\n</blockquote>\n"
+
+blockToTextile opts (Table [] aligns widths headers rows') |
+ all (==0) widths && all (`elem` [AlignLeft,AlignDefault]) aligns = do
+ hs <- mapM (liftM (("_. " ++) . stripTrailingNewlines) . blockListToTextile opts) headers
+ let cellsToRow cells = "|" ++ intercalate "|" cells ++ "|"
+ let header = if all null headers then "" else cellsToRow hs
+ let rowToCells = mapM (liftM stripTrailingNewlines . blockListToTextile opts)
+ bs <- mapM rowToCells rows'
+ let body = unlines $ map cellsToRow bs
+ return $ header ++ "\n" ++ body ++ "\n"
+
+blockToTextile opts (Table capt aligns widths headers rows') = do
+ let alignStrings = map alignmentToString aligns
+ captionDoc <- if null capt
+ then return ""
+ else do
+ c <- inlineListToTextile opts capt
+ return $ "<caption>" ++ c ++ "</caption>\n"
+ let percent w = show (truncate (100*w) :: Integer) ++ "%"
+ let coltags = if all (== 0.0) widths
+ then ""
+ else unlines $ map
+ (\w -> "<col width=\"" ++ percent w ++ "\" />") widths
+ head' <- if all null headers
+ then return ""
+ else do
+ hs <- tableRowToTextile opts alignStrings 0 headers
+ return $ "<thead>\n" ++ hs ++ "\n</thead>\n"
+ body' <- zipWithM (tableRowToTextile opts alignStrings) [1..] rows'
+ 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 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 ++ "#" }
+ 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 (DefinitionList items) = do
+ contents <- withUseTags $ mapM (definitionListItemToTextile opts) items
+ return $ "<dl>\n" ++ vcat contents ++ "\n</dl>\n"
+
+-- 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 <- get >>= return . stListLevel
+ return $ marker ++ " " ++ contents
+
+-- | Convert definition list item (label, list of blocks) to Textile.
+definitionListItemToTextile :: WriterOptions
+ -> ([Inline],[[Block]])
+ -> State WriterState String
+definitionListItemToTextile opts (label, items) = do
+ labelText <- inlineListToTextile opts label
+ contents <- mapM (blockListToTextile opts) items
+ 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 (num, sty, _) items -> all isSimpleListItem items &&
+ num == 1 && 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"
+
+-- Auxiliary functions for tables. (TODO: these are common to HTML, MediaWiki,
+-- and Textile writers, and should be abstracted out.)
+
+tableRowToTextile :: WriterOptions
+ -> [String]
+ -> Int
+ -> [[Block]]
+ -> State WriterState String
+tableRowToTextile opts alignStrings rownum cols' = do
+ let celltype = if rownum == 0 then "th" else "td"
+ let rowclass = case rownum of
+ 0 -> "header"
+ x | x `rem` 2 == 1 -> "odd"
+ _ -> "even"
+ cols'' <- sequence $ zipWith
+ (\alignment item -> tableItemToTextile opts celltype alignment item)
+ alignStrings cols'
+ return $ "<tr class=\"" ++ rowclass ++ "\">\n" ++ unlines cols'' ++ "</tr>"
+
+alignmentToString :: Alignment -> [Char]
+alignmentToString alignment = case alignment of
+ AlignLeft -> "left"
+ AlignRight -> "right"
+ AlignCenter -> "center"
+ AlignDefault -> "left"
+
+tableItemToTextile :: WriterOptions
+ -> String
+ -> String
+ -> [Block]
+ -> State WriterState String
+tableItemToTextile opts celltype align' item = do
+ let mkcell x = "<" ++ celltype ++ " align=\"" ++ align' ++ "\">" ++
+ x ++ "</" ++ celltype ++ ">"
+ contents <- blockListToTextile opts item
+ return $ mkcell contents
+
+-- | Convert list of Pandoc block elements to Textile.
+blockListToTextile :: WriterOptions -- ^ Options
+ -> [Block] -- ^ List of block elements
+ -> State WriterState String
+blockListToTextile opts blocks =
+ mapM (blockToTextile opts) blocks >>= return . vcat
+
+-- | Convert list of Pandoc inline elements to Textile.
+inlineListToTextile :: WriterOptions -> [Inline] -> State WriterState String
+inlineListToTextile opts lst =
+ mapM (inlineToTextile opts) lst >>= return . concat
+
+-- | Convert Pandoc inline element to Textile.
+inlineToTextile :: WriterOptions -> Inline -> State WriterState String
+
+inlineToTextile opts (Emph lst) = do
+ contents <- inlineListToTextile opts lst
+ return $ if '_' `elem` contents
+ then "<em>" ++ contents ++ "</em>"
+ else "_" ++ contents ++ "_"
+
+inlineToTextile opts (Strong lst) = do
+ contents <- inlineListToTextile opts lst
+ return $ if '*' `elem` contents
+ then "<strong>" ++ contents ++ "</strong>"
+ else "*" ++ contents ++ "*"
+
+inlineToTextile opts (Strikeout lst) = do
+ contents <- inlineListToTextile opts lst
+ return $ if '-' `elem` contents
+ then "<del>" ++ contents ++ "</del>"
+ else "-" ++ contents ++ "-"
+
+inlineToTextile opts (Superscript lst) = do
+ contents <- inlineListToTextile opts lst
+ return $ if '^' `elem` contents
+ then "<sup>" ++ contents ++ "</sup>"
+ else "[^" ++ contents ++ "^]"
+
+inlineToTextile opts (Subscript lst) = do
+ contents <- inlineListToTextile opts lst
+ return $ if '~' `elem` contents
+ then "<sub>" ++ contents ++ "</sub>"
+ else "[~" ++ contents ++ "~]"
+
+inlineToTextile opts (SmallCaps lst) = inlineListToTextile opts lst
+
+inlineToTextile opts (Quoted SingleQuote lst) = do
+ contents <- inlineListToTextile opts lst
+ return $ "'" ++ contents ++ "'"
+
+inlineToTextile opts (Quoted DoubleQuote lst) = do
+ contents <- inlineListToTextile opts lst
+ return $ "\"" ++ contents ++ "\""
+
+inlineToTextile opts (Cite _ lst) = inlineListToTextile opts lst
+
+inlineToTextile _ EmDash = return " -- "
+
+inlineToTextile _ EnDash = return " - "
+
+inlineToTextile _ Apostrophe = return "'"
+
+inlineToTextile _ Ellipses = return "..."
+
+inlineToTextile _ (Code _ str) =
+ return $ if '@' `elem` str
+ then "<tt>" ++ escapeStringForXML str ++ "</tt>"
+ else "@" ++ str ++ "@"
+
+inlineToTextile _ (Str str) = return $ escapeStringForTextile str
+
+inlineToTextile _ (Math _ str) =
+ return $ "<span class=\"math\">" ++ escapeStringForXML str ++ "</math>"
+
+inlineToTextile _ (RawInline f str) =
+ if f == "html" || f == "textile"
+ then return str
+ else return ""
+
+inlineToTextile _ (LineBreak) = return "\n"
+
+inlineToTextile _ Space = return " "
+
+inlineToTextile opts (Link txt (src, _)) = do
+ label <- case txt of
+ [Code _ s] -> return s
+ _ -> inlineListToTextile opts txt
+ return $ "\"" ++ label ++ "\":" ++ src
+
+inlineToTextile opts (Image alt (source, tit)) = do
+ alt' <- inlineListToTextile opts alt
+ let txt = if null tit
+ then if null alt'
+ then ""
+ else "(" ++ alt' ++ ")"
+ else "(" ++ tit ++ ")"
+ return $ "!" ++ source ++ txt ++ "!"
+
+inlineToTextile opts (Note contents) = do
+ curNotes <- liftM stNotes get
+ let newnum = length curNotes + 1
+ contents' <- blockListToTextile opts contents
+ let thisnote = "fn" ++ show newnum ++ ". " ++ contents' ++ "\n"
+ modify $ \s -> s { stNotes = thisnote : curNotes }
+ return $ "[" ++ show newnum ++ "]"
+ -- note - may not work for notes with multiple blocks
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-01 05:28:49 +0000