aboutsummaryrefslogtreecommitdiff
path: root/Text/Pandoc/Writers
diff options
context:
space:
mode:
authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2007-11-28 21:01:17 +0000
committerfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2007-11-28 21:01:17 +0000
commit47a4a3ab897ab748a4b7eab2ccb95cd9cb0e3864 (patch)
treeead5f33d20aa3a88c78f11bb8e598a4f741247f1 /Text/Pandoc/Writers
parent3dfe4cb708ac14369aab19383c1008b2cf4adbc4 (diff)
downloadpandoc-47a4a3ab897ab748a4b7eab2ccb95cd9cb0e3864.tar.gz
Removed Text directory. This is a remnant of an experiment
moving the contents of src/ to the top level, and should have been deleted long ago. git-svn-id: https://pandoc.googlecode.com/svn/trunk@1097 788f1e2b-df1e-0410-8736-df70ead52e1b
Diffstat (limited to 'Text/Pandoc/Writers')
-rw-r--r--Text/Pandoc/Writers/ConTeXt.hs248
-rw-r--r--Text/Pandoc/Writers/DefaultHeaders.hs54
-rw-r--r--Text/Pandoc/Writers/Docbook.hs299
-rw-r--r--Text/Pandoc/Writers/HTML.hs462
-rw-r--r--Text/Pandoc/Writers/LaTeX.hs310
-rw-r--r--Text/Pandoc/Writers/Man.hs293
-rw-r--r--Text/Pandoc/Writers/Markdown.hs373
-rw-r--r--Text/Pandoc/Writers/RST.hs325
-rw-r--r--Text/Pandoc/Writers/RTF.hs286
-rw-r--r--Text/Pandoc/Writers/S5.hs136
10 files changed, 0 insertions, 2786 deletions
diff --git a/Text/Pandoc/Writers/ConTeXt.hs b/Text/Pandoc/Writers/ConTeXt.hs
deleted file mode 100644
index 13912a9f3..000000000
--- a/Text/Pandoc/Writers/ConTeXt.hs
+++ /dev/null
@@ -1,248 +0,0 @@
-{-
-Copyright (C) 2007 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.ConTeXt
- Copyright : Copyright (C) 2007 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Conversion of 'Pandoc' format into ConTeXt.
--}
-module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where
-import Text.Pandoc.Definition
-import Text.Pandoc.Shared
-import Text.Printf ( printf )
-import Data.List ( (\\), intersperse )
-import Control.Monad.State
-
-type WriterState = Int -- number of next URL reference
-
--- | Convert Pandoc to ConTeXt.
-writeConTeXt :: WriterOptions -> Pandoc -> String
-writeConTeXt options document = evalState (pandocToConTeXt options document) 1
-
-pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String
-pandocToConTeXt options (Pandoc meta blocks) = do
- main <- blockListToConTeXt blocks
- let body = writerIncludeBefore options ++ main ++ writerIncludeAfter options
- head <- if writerStandalone options
- then contextHeader options meta
- else return ""
- let toc = if writerTableOfContents options
- then "\\placecontent\n\n"
- else ""
- let foot = if writerStandalone options
- then "\n\\stoptext\n"
- else ""
- return $ head ++ toc ++ body ++ foot
-
--- | Insert bibliographic information into ConTeXt header.
-contextHeader :: WriterOptions -- ^ Options, including ConTeXt header
- -> Meta -- ^ Meta with bibliographic information
- -> State WriterState String
-contextHeader options (Meta title authors date) = do
- titletext <- if null title
- then return ""
- else inlineListToConTeXt title
- let authorstext = if null authors
- then ""
- else if length authors == 1
- then stringToConTeXt $ head authors
- else stringToConTeXt $ (joinWithSep ", " $
- init authors) ++ " & " ++ last authors
- let datetext = if date == ""
- then ""
- else stringToConTeXt date
- let titleblock = "\\doctitle{" ++ titletext ++ "}\n\
- \ \\author{" ++ authorstext ++ "}\n\
- \ \\date{" ++ datetext ++ "}\n\n"
- let setupheads = if (writerNumberSections options)
- then "\\setupheads[sectionnumber=yes, style=\\bf]\n"
- else "\\setupheads[sectionnumber=no, style=\\bf]\n"
- let header = writerHeader options
- return $ header ++ setupheads ++ titleblock ++ "\\starttext\n\\maketitle\n\n"
-
--- escape things as needed for ConTeXt
-
-escapeCharForConTeXt :: Char -> String
-escapeCharForConTeXt ch =
- case ch of
- '{' -> "\\letteropenbrace{}"
- '}' -> "\\letterclosebrace{}"
- '\\' -> "\\letterbackslash{}"
- '$' -> "\\$"
- '|' -> "\\letterbar{}"
- '^' -> "\\letterhat{}"
- '%' -> "\\%"
- '~' -> "\\lettertilde{}"
- '&' -> "\\&"
- '#' -> "\\#"
- '<' -> "\\letterless{}"
- '>' -> "\\lettermore{}"
- '_' -> "\\letterunderscore{}"
- x -> [x]
-
--- | Escape string for ConTeXt
-stringToConTeXt :: String -> String
-stringToConTeXt = concatMap escapeCharForConTeXt
-
--- | Convert Pandoc block element to ConTeXt.
-blockToConTeXt :: Block -> State WriterState String
-blockToConTeXt Null = return ""
-blockToConTeXt (Plain lst) = inlineListToConTeXt lst >>= return . (++ "\n")
-blockToConTeXt (Para lst) = inlineListToConTeXt lst >>= return . (++ "\n\n")
-blockToConTeXt (BlockQuote lst) = do
- contents <- blockListToConTeXt lst
- return $ "\\startblockquote\n" ++ contents ++ "\\stopblockquote\n\n"
-blockToConTeXt (CodeBlock str) =
- return $ "\\starttyping\n" ++ str ++ "\n\\stoptyping\n"
-blockToConTeXt (RawHtml str) = return ""
-blockToConTeXt (BulletList lst) = do
- contents <- mapM listItemToConTeXt lst
- return $ "\\startltxitem\n" ++ concat contents ++ "\\stopltxitem\n"
-blockToConTeXt (OrderedList attribs lst) = case attribs of
- (1, DefaultStyle, DefaultDelim) -> do
- contents <- mapM listItemToConTeXt lst
- return $ "\\startltxenum\n" ++ concat contents ++ "\\stopltxenum\n"
- _ -> do
- let markers = take (length lst) $ orderedListMarkers attribs
- contents <- zipWithM orderedListItemToConTeXt markers lst
- let markerWidth = maximum $ map length markers
- let markerWidth' = if markerWidth < 3
- then ""
- else "[width=" ++
- show ((markerWidth + 2) `div` 2) ++ "em]"
- return $ "\\startitemize" ++ markerWidth' ++ "\n" ++ concat contents ++
- "\\stopitemize\n"
-blockToConTeXt (DefinitionList lst) =
- mapM defListItemToConTeXt lst >>= return . (++ "\n") . concat
-blockToConTeXt HorizontalRule = return "\\thinrule\n\n"
-blockToConTeXt (Header level lst) = do
- contents <- inlineListToConTeXt lst
- return $ if level > 0 && level <= 3
- then "\\" ++ concat (replicate (level - 1) "sub") ++
- "section{" ++ contents ++ "}\n\n"
- else contents ++ "\n\n"
-blockToConTeXt (Table caption aligns widths heads rows) = do
- let colWidths = map printDecimal widths
- let colDescriptor colWidth alignment = (case alignment of
- AlignLeft -> 'l'
- AlignRight -> 'r'
- AlignCenter -> 'c'
- AlignDefault -> 'l'):
- "p(" ++ colWidth ++ "\\textwidth)|"
- let colDescriptors = "|" ++ (concat $
- zipWith colDescriptor colWidths aligns)
- headers <- tableRowToConTeXt heads
- captionText <- inlineListToConTeXt caption
- let captionText' = if null caption then "none" else captionText
- rows' <- mapM tableRowToConTeXt rows
- return $ "\\placetable[here]{" ++ captionText' ++ "}\n\\starttable[" ++
- colDescriptors ++ "]\n" ++ "\\HL\n" ++ headers ++ "\\HL\n" ++
- concat rows' ++ "\\HL\n\\stoptable\n\n"
-
-printDecimal :: Float -> String
-printDecimal = printf "%.2f"
-
-tableRowToConTeXt cols = do
- cols' <- mapM blockListToConTeXt cols
- return $ "\\NC " ++ (concat $ intersperse "\\NC " cols') ++ "\\NC\\AR\n"
-
-listItemToConTeXt list = do
- contents <- blockListToConTeXt list
- return $ "\\item " ++ contents
-
-orderedListItemToConTeXt marker list = do
- contents <- blockListToConTeXt list
- return $ "\\sym{" ++ marker ++ "} " ++ contents
-
-defListItemToConTeXt (term, def) = do
- term' <- inlineListToConTeXt term
- def' <- blockListToConTeXt def
- return $ "\\startdescr{" ++ term' ++ "}\n" ++
- def' ++ "\n\\stopdescr\n"
-
--- | Convert list of block elements to ConTeXt.
-blockListToConTeXt :: [Block] -> State WriterState String
-blockListToConTeXt lst = mapM blockToConTeXt lst >>= return . concat
-
--- | Convert list of inline elements to ConTeXt.
-inlineListToConTeXt :: [Inline] -- ^ Inlines to convert
- -> State WriterState String
-inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= return . concat
-
-isQuoted :: Inline -> Bool
-isQuoted (Quoted _ _) = True
-isQuoted Apostrophe = True
-isQuoted _ = False
-
--- | Convert inline element to ConTeXt
-inlineToConTeXt :: Inline -- ^ Inline to convert
- -> State WriterState String
-inlineToConTeXt (Emph lst) = do
- contents <- inlineListToConTeXt lst
- return $ "{\\em " ++ contents ++ "}"
-inlineToConTeXt (Strong lst) = do
- contents <- inlineListToConTeXt lst
- return $ "{\\bf " ++ contents ++ "}"
-inlineToConTeXt (Strikeout lst) = do
- contents <- inlineListToConTeXt lst
- return $ "\\overstrikes{" ++ contents ++ "}"
-inlineToConTeXt (Superscript lst) = do
- contents <- inlineListToConTeXt lst
- return $ "\\high{" ++ contents ++ "}"
-inlineToConTeXt (Subscript lst) = do
- contents <- inlineListToConTeXt lst
- return $ "\\low{" ++ contents ++ "}"
-inlineToConTeXt (Code str) = return $ "\\type{" ++ str ++ "}"
-inlineToConTeXt (Quoted SingleQuote lst) = do
- contents <- inlineListToConTeXt lst
- return $ "\\quote{" ++ contents ++ "}"
-inlineToConTeXt (Quoted DoubleQuote lst) = do
- contents <- inlineListToConTeXt lst
- return $ "\\quotation{" ++ contents ++ "}"
-inlineToConTeXt Apostrophe = return "'"
-inlineToConTeXt EmDash = return "---"
-inlineToConTeXt EnDash = return "--"
-inlineToConTeXt Ellipses = return "\\ldots{}"
-inlineToConTeXt (Str str) = return $ stringToConTeXt str
-inlineToConTeXt (TeX str) = return str
-inlineToConTeXt (HtmlInline str) = return ""
-inlineToConTeXt (LineBreak) = return "\\crlf\n"
-inlineToConTeXt Space = return " "
-inlineToConTeXt (Link [Code str] (src, tit)) = -- since ConTeXt has its own
- inlineToConTeXt (Link [Str str] (src, tit)) -- way of printing links...
-inlineToConTeXt (Link text (src, _)) = do
- next <- get
- put (next + 1)
- let ref = show next
- label <- inlineListToConTeXt text
- return $ "\\useurl[" ++ ref ++ "][" ++ src ++ "][][" ++ label ++
- "]\\from[" ++ ref ++ "]"
-inlineToConTeXt (Image alternate (src, tit)) = do
- alt <- inlineListToConTeXt alternate
- return $ "\\placefigure\n[]\n[fig:" ++ alt ++ "]\n{" ++
- tit ++ "}\n{\\externalfigure[" ++ src ++ "]}"
-inlineToConTeXt (Note contents) = do
- contents' <- blockListToConTeXt contents
- return $ "\\footnote{" ++ contents' ++ "}"
-
diff --git a/Text/Pandoc/Writers/DefaultHeaders.hs b/Text/Pandoc/Writers/DefaultHeaders.hs
deleted file mode 100644
index 55a189a46..000000000
--- a/Text/Pandoc/Writers/DefaultHeaders.hs
+++ /dev/null
@@ -1,54 +0,0 @@
-{-
-Copyright (C) 2006-7 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.DefaultHeaders
- Copyright : Copyright (C) 2006-7 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Default headers for Pandoc writers.
--}
-module Text.Pandoc.Writers.DefaultHeaders (
- defaultLaTeXHeader,
- defaultConTeXtHeader,
- defaultDocbookHeader,
- defaultS5Header,
- defaultRTFHeader
- ) where
-import Text.Pandoc.Writers.S5
-import Text.Pandoc.Include ( includeStrFrom, headerPath )
-
-defaultLaTeXHeader :: String
-defaultLaTeXHeader = $(includeStrFrom $ headerPath "LaTeXHeader")
-
-defaultConTeXtHeader :: String
-defaultConTeXtHeader = $(includeStrFrom $ headerPath "ConTeXtHeader")
-
-defaultDocbookHeader :: String
-defaultDocbookHeader = $(includeStrFrom $ headerPath "DocbookHeader")
-
-defaultS5Header :: String
-defaultS5Header = s5Meta ++ s5CSS ++ s5Javascript
-
-defaultRTFHeader :: String
-defaultRTFHeader = $(includeStrFrom $ headerPath "RTFHeader")
-
diff --git a/Text/Pandoc/Writers/Docbook.hs b/Text/Pandoc/Writers/Docbook.hs
deleted file mode 100644
index 13dc8585d..000000000
--- a/Text/Pandoc/Writers/Docbook.hs
+++ /dev/null
@@ -1,299 +0,0 @@
-{-
-Copyright (C) 2006-7 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.Docbook
- Copyright : Copyright (C) 2006-7 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Conversion of 'Pandoc' documents to Docbook XML.
--}
-module Text.Pandoc.Writers.Docbook ( writeDocbook) where
-import Text.Pandoc.Definition
-import Text.Pandoc.Shared
-import Data.List ( isPrefixOf, drop )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
-
---
--- code to format XML
---
-
--- | Escape one character as needed for XML.
-escapeCharForXML :: Char -> String
-escapeCharForXML x = case x of
- '&' -> "&amp;"
- '<' -> "&lt;"
- '>' -> "&gt;"
- '"' -> "&quot;"
- '\160' -> "&nbsp;"
- c -> [c]
-
--- | True if the character needs to be escaped.
-needsEscaping :: Char -> Bool
-needsEscaping c = c `elem` "&<>\"\160"
-
--- | Escape string as needed for XML. Entity references are not preserved.
-escapeStringForXML :: String -> String
-escapeStringForXML "" = ""
-escapeStringForXML str =
- case break needsEscaping str of
- (okay, "") -> okay
- (okay, (c:cs)) -> okay ++ escapeCharForXML c ++ escapeStringForXML cs
-
--- | Return a text object with a string of formatted XML attributes.
-attributeList :: [(String, String)] -> Doc
-attributeList = text . concatMap
- (\(a, b) -> " " ++ escapeStringForXML a ++ "=\"" ++
- escapeStringForXML b ++ "\"")
-
--- | Put the supplied contents between start and end tags of tagType,
--- with specified attributes and (if specified) indentation.
-inTags:: Bool -> String -> [(String, String)] -> Doc -> Doc
-inTags isIndented tagType attribs contents =
- let openTag = char '<' <> text tagType <> attributeList attribs <>
- char '>'
- closeTag = text "</" <> text tagType <> char '>'
- in if isIndented
- then openTag $$ nest 2 contents $$ closeTag
- else openTag <> contents <> closeTag
-
--- | Return a self-closing tag of tagType with specified attributes
-selfClosingTag :: String -> [(String, String)] -> Doc
-selfClosingTag tagType attribs =
- char '<' <> text tagType <> attributeList attribs <> text " />"
-
--- | Put the supplied contents between start and end tags of tagType.
-inTagsSimple :: String -> Doc -> Doc
-inTagsSimple tagType = inTags False tagType []
-
--- | Put the supplied contents in indented block btw start and end tags.
-inTagsIndented :: String -> Doc -> Doc
-inTagsIndented tagType = inTags True tagType []
-
---
--- Docbook writer
---
-
--- | Convert list of authors to a docbook <author> section
-authorToDocbook :: [Char] -> Doc
-authorToDocbook name = inTagsIndented "author" $
- if ',' `elem` name
- then -- last name first
- let (lastname, rest) = break (==',') name
- firstname = removeLeadingSpace rest in
- inTagsSimple "firstname" (text $ escapeStringForXML firstname) <>
- inTagsSimple "surname" (text $ escapeStringForXML lastname)
- else -- last name last
- let namewords = words name
- lengthname = length namewords
- (firstname, lastname) = case lengthname of
- 0 -> ("","")
- 1 -> ("", name)
- n -> (joinWithSep " " (take (n-1) namewords), last namewords)
- in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$
- inTagsSimple "surname" (text $ escapeStringForXML lastname)
-
--- | Convert Pandoc document to string in Docbook format.
-writeDocbook :: WriterOptions -> Pandoc -> String
-writeDocbook opts (Pandoc (Meta title authors date) blocks) =
- let head = if writerStandalone opts
- then text (writerHeader opts)
- else empty
- meta = if writerStandalone opts
- then inTagsIndented "articleinfo" $
- (inTagsSimple "title" (wrap opts title)) $$
- (vcat (map authorToDocbook authors)) $$
- (inTagsSimple "date" (text $ escapeStringForXML date))
- else empty
- elements = hierarchicalize blocks
- before = writerIncludeBefore opts
- after = writerIncludeAfter opts
- body = (if null before then empty else text before) $$
- vcat (map (elementToDocbook opts) elements) $$
- (if null after then empty else text after)
- body' = if writerStandalone opts
- then inTagsIndented "article" (meta $$ body)
- else body
- in render $ head $$ body' $$ text ""
-
--- | Convert an Element to Docbook.
-elementToDocbook :: WriterOptions -> Element -> Doc
-elementToDocbook opts (Blk block) = blockToDocbook opts block
-elementToDocbook opts (Sec title elements) =
- -- Docbook doesn't allow sections with no content, so insert some if needed
- let elements' = if null elements
- then [Blk (Para [])]
- else elements
- in inTagsIndented "section" $
- inTagsSimple "title" (wrap opts title) $$
- vcat (map (elementToDocbook opts) elements')
-
--- | Convert a list of Pandoc blocks to Docbook.
-blocksToDocbook :: WriterOptions -> [Block] -> Doc
-blocksToDocbook opts = vcat . map (blockToDocbook opts)
-
--- | Auxiliary function to convert Plain block to Para.
-plainToPara (Plain x) = Para x
-plainToPara x = x
-
--- | Convert a list of pairs of terms and definitions into a list of
--- Docbook varlistentrys.
-deflistItemsToDocbook :: WriterOptions -> [([Inline],[Block])] -> Doc
-deflistItemsToDocbook opts items =
- vcat $ map (\(term, def) -> deflistItemToDocbook opts term def) items
-
--- | Convert a term and a list of blocks into a Docbook varlistentry.
-deflistItemToDocbook :: WriterOptions -> [Inline] -> [Block] -> Doc
-deflistItemToDocbook opts term def =
- let def' = map plainToPara def
- in inTagsIndented "varlistentry" $
- inTagsIndented "term" (inlinesToDocbook opts term) $$
- inTagsIndented "listitem" (blocksToDocbook opts def')
-
--- | Convert a list of lists of blocks to a list of Docbook list items.
-listItemsToDocbook :: WriterOptions -> [[Block]] -> Doc
-listItemsToDocbook opts items = vcat $ map (listItemToDocbook opts) items
-
--- | Convert a list of blocks into a Docbook list item.
-listItemToDocbook :: WriterOptions -> [Block] -> Doc
-listItemToDocbook opts item =
- inTagsIndented "listitem" $ blocksToDocbook opts $ map plainToPara item
-
--- | Convert a Pandoc block element to Docbook.
-blockToDocbook :: WriterOptions -> Block -> Doc
-blockToDocbook opts Null = empty
-blockToDocbook opts (Plain lst) = wrap opts lst
-blockToDocbook opts (Para lst) = inTagsIndented "para" $ wrap opts lst
-blockToDocbook opts (BlockQuote blocks) =
- inTagsIndented "blockquote" $ blocksToDocbook opts blocks
-blockToDocbook opts (CodeBlock str) =
- text "<screen>\n" <> text (escapeStringForXML str) <> text "\n</screen>"
-blockToDocbook opts (BulletList lst) =
- inTagsIndented "itemizedlist" $ listItemsToDocbook opts lst
-blockToDocbook opts (OrderedList _ []) = empty
-blockToDocbook opts (OrderedList (start, numstyle, numdelim) (first:rest)) =
- let attribs = case numstyle of
- DefaultStyle -> []
- Decimal -> [("numeration", "arabic")]
- UpperAlpha -> [("numeration", "upperalpha")]
- LowerAlpha -> [("numeration", "loweralpha")]
- UpperRoman -> [("numeration", "upperroman")]
- LowerRoman -> [("numeration", "lowerroman")]
- items = if start == 1
- then listItemsToDocbook opts (first:rest)
- else (inTags True "listitem" [("override",show start)]
- (blocksToDocbook opts $ map plainToPara first)) $$
- listItemsToDocbook opts rest
- in inTags True "orderedlist" attribs items
-blockToDocbook opts (DefinitionList lst) =
- inTagsIndented "variablelist" $ deflistItemsToDocbook opts lst
-blockToDocbook opts (RawHtml str) = text str -- raw XML block
-blockToDocbook opts HorizontalRule = empty -- not semantic
-blockToDocbook opts (Table caption aligns widths headers rows) =
- let alignStrings = map alignmentToString aligns
- captionDoc = if null caption
- then empty
- else inTagsIndented "caption"
- (inlinesToDocbook opts caption)
- tableType = if isEmpty captionDoc then "informaltable" else "table"
- in inTagsIndented tableType $ captionDoc $$
- (colHeadsToDocbook opts alignStrings widths headers) $$
- (vcat $ map (tableRowToDocbook opts alignStrings) rows)
-
-colHeadsToDocbook opts alignStrings widths headers =
- let heads = zipWith3 (\align width item ->
- tableItemToDocbook opts "th" align width item)
- alignStrings widths headers
- in inTagsIndented "tr" $ vcat heads
-
-alignmentToString alignment = case alignment of
- AlignLeft -> "left"
- AlignRight -> "right"
- AlignCenter -> "center"
- AlignDefault -> "left"
-
-tableRowToDocbook opts aligns cols = inTagsIndented "tr" $
- vcat $ zipWith3 (tableItemToDocbook opts "td") aligns (repeat 0) cols
-
-tableItemToDocbook opts tag align width item =
- let attrib = [("align", align)] ++
- if width /= 0
- then [("style", "{width: " ++
- show (truncate (100*width)) ++ "%;}")]
- else []
- 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
-
--- | Convert an inline element to Docbook.
-inlineToDocbook :: WriterOptions -> Inline -> Doc
-inlineToDocbook opts (Str str) = text $ escapeStringForXML str
-inlineToDocbook opts (Emph lst) =
- inTagsSimple "emphasis" $ inlinesToDocbook opts lst
-inlineToDocbook opts (Strong lst) =
- inTags False "emphasis" [("role", "strong")] $ inlinesToDocbook opts lst
-inlineToDocbook opts (Strikeout lst) =
- inTags False "emphasis" [("role", "strikethrough")] $
- inlinesToDocbook opts lst
-inlineToDocbook opts (Superscript lst) =
- inTagsSimple "superscript" $ inlinesToDocbook opts lst
-inlineToDocbook opts (Subscript lst) =
- inTagsSimple "subscript" $ inlinesToDocbook opts lst
-inlineToDocbook opts (Quoted _ lst) =
- inTagsSimple "quote" $ inlinesToDocbook opts lst
-inlineToDocbook opts Apostrophe = char '\''
-inlineToDocbook opts Ellipses = text "&#8230;"
-inlineToDocbook opts EmDash = text "&#8212;"
-inlineToDocbook opts EnDash = text "&#8211;"
-inlineToDocbook opts (Code str) =
- inTagsSimple "literal" $ text (escapeStringForXML str)
-inlineToDocbook opts (TeX str) = inlineToDocbook opts (Code str)
-inlineToDocbook opts (HtmlInline str) = empty
-inlineToDocbook opts LineBreak = text $ "<literallayout></literallayout>"
-inlineToDocbook opts Space = char ' '
-inlineToDocbook opts (Link txt (src, tit)) =
- 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 ')'
- else inTags False "ulink" [("url", src)] $ inlinesToDocbook opts txt
-inlineToDocbook opts (Image alt (src, tit)) =
- let titleDoc = if null tit
- then empty
- else inTagsIndented "objectinfo" $
- inTagsIndented "title" (text $ escapeStringForXML tit)
- in inTagsIndented "inlinemediaobject" $ inTagsIndented "imageobject" $
- titleDoc $$ selfClosingTag "imagedata" [("fileref", src)]
-inlineToDocbook opts (Note contents) =
- inTagsIndented "footnote" $ blocksToDocbook opts contents
diff --git a/Text/Pandoc/Writers/HTML.hs b/Text/Pandoc/Writers/HTML.hs
deleted file mode 100644
index 41e82272d..000000000
--- a/Text/Pandoc/Writers/HTML.hs
+++ /dev/null
@@ -1,462 +0,0 @@
-{-
-Copyright (C) 2006-7 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.HTML
- Copyright : Copyright (C) 2006-7 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Conversion of 'Pandoc' documents to HTML.
--}
-module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where
-import Text.Pandoc.Definition
-import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )
-import Text.Pandoc.Shared
-import Text.Regex ( mkRegex, matchRegex )
-import Numeric ( showHex )
-import Data.Char ( ord, toLower )
-import Data.List ( isPrefixOf, intersperse )
-import qualified Data.Set as S
-import Control.Monad.State
-import Text.XHtml.Transitional
-import Text.Pandoc.Include ( includeStrFrom, asciiMathMLPath )
-
-data WriterState = WriterState
- { stNotes :: [Html] -- ^ List of notes
- , stIds :: [String] -- ^ List of header identifiers
- , stMath :: Bool -- ^ Math is used in document
- , stCSS :: S.Set String -- ^ CSS to include in header
- } deriving Show
-
-asciiMathMLScript = $(includeStrFrom asciiMathMLPath)
-
-defaultWriterState :: WriterState
-defaultWriterState = WriterState {stNotes= [], stIds = [],
- stMath = False, stCSS = S.empty}
-
--- Helpers to render HTML with the appropriate function.
-render opts = if writerWrapText opts then renderHtml else showHtml
-renderFragment opts = if writerWrapText opts
- then renderHtmlFragment
- else showHtmlFragment
-
--- | Convert Pandoc document to Html string.
-writeHtmlString :: WriterOptions -> Pandoc -> String
-writeHtmlString opts =
- if writerStandalone opts
- then render opts . writeHtml opts
- else renderFragment opts . writeHtml opts
-
--- | Convert Pandoc document to Html structure.
-writeHtml :: WriterOptions -> Pandoc -> Html
-writeHtml opts (Pandoc (Meta tit authors date) blocks) =
- let titlePrefix = writerTitlePrefix opts
- topTitle = evalState (inlineListToHtml opts tit) defaultWriterState
- topTitle' = if null titlePrefix
- then topTitle
- else titlePrefix +++ " - " +++ topTitle
- metadata = thetitle topTitle' +++
- meta ! [httpequiv "Content-Type",
- content "text/html; charset=UTF-8"] +++
- meta ! [name "generator", content "pandoc"] +++
- (toHtmlFromList $
- map (\a -> meta ! [name "author", content a]) authors) +++
- (if null date
- then noHtml
- else meta ! [name "date", content date])
- titleHeader = if writerStandalone opts && not (null tit) &&
- not (writerS5 opts)
- then h1 ! [theclass "title"] $ topTitle
- else noHtml
- headerBlocks = filter isHeaderBlock blocks
- ids = uniqueIdentifiers $
- map (\(Header _ lst) -> lst) headerBlocks
- toc = if writerTableOfContents opts
- then tableOfContents opts headerBlocks ids
- else noHtml
- (blocks', newstate) =
- runState (blockListToHtml opts blocks)
- (defaultWriterState {stIds = ids})
- cssLines = stCSS newstate
- css = if S.null cssLines
- then noHtml
- else style ! [thetype "text/css"] $ primHtml $
- '\n':(unlines $ S.toList cssLines)
- math = if stMath newstate
- then case writerASCIIMathMLURL opts of
- Just path -> script ! [src path,
- thetype "text/javascript"] $
- noHtml
- Nothing -> script !
- [thetype "text/javascript"] $
- primHtml asciiMathMLScript
- else noHtml
- head = header $ metadata +++ math +++ css +++
- primHtml (writerHeader opts)
- notes = reverse (stNotes newstate)
- before = primHtml $ writerIncludeBefore opts
- after = primHtml $ writerIncludeAfter opts
- thebody = before +++ titleHeader +++ toc +++ blocks' +++
- footnoteSection opts notes +++ after
- in if writerStandalone opts
- then head +++ body thebody
- else thebody
-
--- | Construct table of contents from list of header blocks and identifiers.
--- Assumes there are as many identifiers as header blocks.
-tableOfContents :: WriterOptions -> [Block] -> [String] -> Html
-tableOfContents _ [] _ = noHtml
-tableOfContents opts headers ids =
- let opts' = opts { writerIgnoreNotes = True }
- contentsTree = hierarchicalize headers
- contents = evalState (mapM (elementToListItem opts') contentsTree)
- (defaultWriterState {stIds = ids})
- in thediv ! [identifier "toc"] $ unordList contents
-
--- | Converts an Element to a list item for a table of contents,
--- retrieving the appropriate identifier from state.
-elementToListItem :: WriterOptions -> Element -> State WriterState Html
-elementToListItem opts (Blk _) = return noHtml
-elementToListItem opts (Sec headerText subsecs) = do
- st <- get
- let ids = stIds st
- let (id, rest) = if null ids
- then ("", [])
- else (head ids, tail ids)
- put $ st {stIds = rest}
- txt <- inlineListToHtml opts headerText
- subHeads <- mapM (elementToListItem opts) subsecs
- let subList = if null subHeads
- then noHtml
- else unordList subHeads
- return $ (anchor ! [href ("#" ++ id), identifier ("TOC-" ++ id)] $ txt) +++
- subList
-
--- | Convert list of Note blocks to a footnote <div>.
--- Assumes notes are sorted.
-footnoteSection :: WriterOptions -> [Html] -> Html
-footnoteSection opts notes =
- if null notes
- then noHtml
- else thediv ! [theclass "footnotes"] $ hr +++ (olist << notes)
-
--- | Obfuscate a "mailto:" link using Javascript.
-obfuscateLink :: WriterOptions -> String -> String -> Html
-obfuscateLink opts text src =
- let emailRegex = mkRegex "^mailto:([^@]*)@(.*)$"
- src' = map toLower src
- in case (matchRegex emailRegex src') of
- (Just [name, domain]) ->
- let domain' = substitute "." " dot " domain
- at' = obfuscateChar '@'
- (linkText, altText) =
- if text == drop 7 src' -- autolink
- then ("'<code>'+e+'</code>'", name ++ " at " ++ domain')
- else ("'" ++ text ++ "'", text ++ " (" ++ name ++ " at " ++
- domain' ++ ")")
- in if writerStrictMarkdown opts
- then -- need to use primHtml or &'s are escaped to &amp; in URL
- primHtml $ "<a href=\"" ++ (obfuscateString src')
- ++ "\">" ++ (obfuscateString text) ++ "</a>"
- else (script ! [thetype "text/javascript"] $
- primHtml ("\n<!--\nh='" ++
- obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++
- obfuscateString name ++ "';e=n+a+h;\n" ++
- "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++
- linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) +++
- noscript (primHtml $ obfuscateString altText)
- _ -> anchor ! [href src] $ primHtml text -- malformed email
-
--- | Obfuscate character as entity.
-obfuscateChar :: Char -> String
-obfuscateChar char =
- let num = ord char
- numstr = if even num then show num else "x" ++ showHex num ""
- in "&#" ++ numstr ++ ";"
-
--- | Obfuscate string using entities.
-obfuscateString :: String -> String
-obfuscateString = concatMap obfuscateChar . decodeCharacterReferences
-
--- | True if character is a punctuation character (unicode).
-isPunctuation :: Char -> Bool
-isPunctuation c =
- let c' = ord c
- in if c `elem` "!\"'()*,-./:;<>?[\\]`{|}~" || c' >= 0x2000 && c' <= 0x206F ||
- c' >= 0xE000 && c' <= 0xE0FF
- then True
- else False
-
--- | Add CSS for document header.
-addToCSS :: String -> State WriterState ()
-addToCSS item = do
- st <- get
- let current = stCSS st
- put $ st {stCSS = S.insert item current}
-
--- | Convert Pandoc inline list to plain text identifier.
-inlineListToIdentifier :: [Inline] -> String
-inlineListToIdentifier [] = ""
-inlineListToIdentifier (x:xs) =
- xAsText ++ inlineListToIdentifier xs
- where xAsText = case x of
- Str s -> filter (\c -> c == '-' || not (isPunctuation c)) $
- concat $ intersperse "-" $ words $ map toLower s
- Emph lst -> inlineListToIdentifier lst
- Strikeout lst -> inlineListToIdentifier lst
- Superscript lst -> inlineListToIdentifier lst
- Subscript lst -> inlineListToIdentifier lst
- Strong lst -> inlineListToIdentifier lst
- Quoted _ lst -> inlineListToIdentifier lst
- Code s -> s
- Space -> "-"
- EmDash -> "-"
- EnDash -> "-"
- Apostrophe -> ""
- Ellipses -> ""
- LineBreak -> "-"
- TeX _ -> ""
- HtmlInline _ -> ""
- Link lst _ -> inlineListToIdentifier lst
- Image lst _ -> inlineListToIdentifier lst
- Note _ -> ""
-
--- | Return unique identifiers for list of inline lists.
-uniqueIdentifiers :: [[Inline]] -> [String]
-uniqueIdentifiers ls =
- let addIdentifier (nonuniqueIds, uniqueIds) l =
- let new = inlineListToIdentifier l
- matches = length $ filter (== new) nonuniqueIds
- new' = new ++ if matches > 0 then ("-" ++ show matches) else ""
- in (new:nonuniqueIds, new':uniqueIds)
- in reverse $ snd $ foldl addIdentifier ([],[]) ls
-
--- | Convert Pandoc block element to HTML.
-blockToHtml :: WriterOptions -> Block -> State WriterState Html
-blockToHtml opts Null = return $ noHtml
-blockToHtml opts (Plain lst) = inlineListToHtml opts lst
-blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)
-blockToHtml opts (RawHtml str) = return $ primHtml str
-blockToHtml opts (HorizontalRule) = return $ hr
-blockToHtml opts (CodeBlock str) = return $ pre $ thecode << (str ++ "\n")
- -- the final \n for consistency with Markdown.pl
-blockToHtml opts (BlockQuote blocks) =
- -- in S5, treat list in blockquote specially
- -- if default is incremental, make it nonincremental;
- -- otherwise incremental
- if writerS5 opts
- then let inc = not (writerIncremental opts) in
- case blocks of
- [BulletList lst] -> blockToHtml (opts {writerIncremental = inc})
- (BulletList lst)
- [OrderedList attribs lst] ->
- blockToHtml (opts {writerIncremental = inc})
- (OrderedList attribs lst)
- otherwise -> blockListToHtml opts blocks >>=
- (return . blockquote)
- else blockListToHtml opts blocks >>= (return . blockquote)
-blockToHtml opts (Header level lst) = do
- contents <- inlineListToHtml opts lst
- st <- get
- let ids = stIds st
- let (id, rest) = if null ids
- then ("", [])
- else (head ids, tail ids)
- put $ st {stIds = rest}
- let attribs = if writerStrictMarkdown opts && not (writerTableOfContents opts)
- then []
- else [identifier id]
- let contents' = if writerTableOfContents opts
- then anchor ! [href ("#TOC-" ++ id)] $ contents
- else contents
- return $ case level of
- 1 -> h1 contents' ! attribs
- 2 -> h2 contents' ! attribs
- 3 -> h3 contents' ! attribs
- 4 -> h4 contents' ! attribs
- 5 -> h5 contents' ! attribs
- 6 -> h6 contents' ! attribs
- _ -> paragraph contents' ! attribs
-blockToHtml opts (BulletList lst) = do
- contents <- mapM (blockListToHtml opts) lst
- let attribs = if writerIncremental opts
- then [theclass "incremental"]
- else []
- return $ unordList ! attribs $ contents
-blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
- contents <- mapM (blockListToHtml opts) lst
- let numstyle' = camelCaseToHyphenated $ show numstyle
- let attribs = (if writerIncremental opts
- then [theclass "incremental"]
- else []) ++
- (if startnum /= 1
- then [start startnum]
- else []) ++
- (if numstyle /= DefaultStyle
- then [theclass numstyle']
- else [])
- if numstyle /= DefaultStyle
- then addToCSS $ "ol." ++ numstyle' ++
- " { list-style-type: " ++
- numstyle' ++ "; }"
- else return ()
- return $ ordList ! attribs $ contents
-blockToHtml opts (DefinitionList lst) = do
- contents <- mapM (\(term, def) -> do term' <- inlineListToHtml opts term
- def' <- blockListToHtml opts def
- return $ (term', def')) lst
- let attribs = if writerIncremental opts
- then [theclass "incremental"]
- else []
- return $ defList ! attribs $ 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
- colHeads <- colHeadsToHtml opts alignStrings
- widths headers
- rows' <- mapM (tableRowToHtml opts alignStrings) rows
- return $ table $ captionDoc +++ colHeads +++ rows'
-
-colHeadsToHtml opts alignStrings widths headers = do
- heads <- sequence $ zipWith3
- (\align width item -> tableItemToHtml opts th align width item)
- alignStrings widths headers
- return $ tr $ toHtmlFromList heads
-
-alignmentToString alignment = case alignment of
- AlignLeft -> "left"
- AlignRight -> "right"
- AlignCenter -> "center"
- AlignDefault -> "left"
-
-tableRowToHtml opts aligns cols =
- (sequence $ zipWith3 (tableItemToHtml opts td) aligns (repeat 0) cols) >>=
- return . tr . toHtmlFromList
-
-tableItemToHtml opts tag align' width item = do
- contents <- blockListToHtml opts item
- let attrib = [align align'] ++
- if width /= 0
- then [thestyle ("width: " ++ show (truncate (100*width)) ++
- "%;")]
- else []
- return $ tag ! attrib $ contents
-
-blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
-blockListToHtml opts lst =
- mapM (blockToHtml opts) lst >>= return . toHtmlFromList
-
--- | Convert list of Pandoc inline elements to HTML.
-inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html
-inlineListToHtml opts lst =
- mapM (inlineToHtml opts) lst >>= return . toHtmlFromList
-
--- | Convert Pandoc inline element to HTML.
-inlineToHtml :: WriterOptions -> Inline -> State WriterState Html
-inlineToHtml opts inline =
- case inline of
- (Str str) -> return $ stringToHtml str
- (Space) -> return $ stringToHtml " "
- (LineBreak) -> return $ br
- (EmDash) -> return $ primHtmlChar "mdash"
- (EnDash) -> return $ primHtmlChar "ndash"
- (Ellipses) -> return $ primHtmlChar "hellip"
- (Apostrophe) -> return $ primHtmlChar "rsquo"
- (Emph lst) -> inlineListToHtml opts lst >>= return . emphasize
- (Strong lst) -> inlineListToHtml opts lst >>= return . strong
- (Code str) -> return $ thecode << str
- (Strikeout lst) -> addToCSS
- ".strikeout { text-decoration: line-through; }" >>
- inlineListToHtml opts lst >>=
- return . (thespan ! [theclass "strikeout"])
- (Superscript lst) -> inlineListToHtml opts lst >>= return . sup
- (Subscript lst) -> inlineListToHtml opts lst >>= return . sub
- (Quoted quoteType lst) ->
- let (leftQuote, rightQuote) = case quoteType of
- SingleQuote -> (primHtmlChar "lsquo",
- primHtmlChar "rsquo")
- DoubleQuote -> (primHtmlChar "ldquo",
- primHtmlChar "rdquo")
- in do contents <- inlineListToHtml opts lst
- return $ leftQuote +++ contents +++ rightQuote
- (TeX str) -> (if writerUseASCIIMathML opts
- then modify (\st -> st {stMath = True})
- else return ()) >> return (stringToHtml str)
- (HtmlInline str) -> return $ primHtml str
- (Link [Code str] (src,tit)) | "mailto:" `isPrefixOf` src ->
- return $ obfuscateLink opts str src
- (Link txt (src,tit)) | "mailto:" `isPrefixOf` src -> do
- linkText <- inlineListToHtml opts txt
- return $ obfuscateLink opts (show linkText) src
- (Link txt (src,tit)) -> do
- linkText <- inlineListToHtml opts txt
- return $ anchor ! ([href src] ++
- if null tit then [] else [title tit]) $
- linkText
- (Image txt (source,tit)) -> do
- alternate <- inlineListToHtml opts txt
- let alternate' = renderFragment opts alternate
- let attributes = [src source] ++
- (if null tit
- then []
- else [title tit]) ++
- if null txt
- then []
- else [alt alternate']
- return $ image ! attributes
- -- note: null title included, as in Markdown.pl
- (Note contents) -> do
- st <- get
- let notes = stNotes st
- let number = (length notes) + 1
- let ref = show number
- htmlContents <- blockListToNote opts ref contents
- -- push contents onto front of notes
- put $ st {stNotes = (htmlContents:notes)}
- return $ anchor ! [href ("#fn" ++ ref),
- theclass "footnoteRef",
- identifier ("fnref" ++ ref)] <<
- sup << ref
-
-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=\"#fnref" ++ ref ++
- "\" class=\"footnoteBackLink\"" ++
- " title=\"Jump back to footnote " ++ ref ++ "\">&#8617;</a>"]
- blocks' = if null blocks
- then []
- else let lastBlock = last blocks
- otherBlocks = init blocks
- in case lastBlock of
- (Para lst) -> otherBlocks ++
- [Para (lst ++ backlink)]
- (Plain lst) -> otherBlocks ++
- [Plain (lst ++ backlink)]
- _ -> otherBlocks ++ [lastBlock,
- Plain backlink]
- in do contents <- blockListToHtml opts blocks'
- return $ li ! [identifier ("fn" ++ ref)] $ contents
-
diff --git a/Text/Pandoc/Writers/LaTeX.hs b/Text/Pandoc/Writers/LaTeX.hs
deleted file mode 100644
index f64e06e24..000000000
--- a/Text/Pandoc/Writers/LaTeX.hs
+++ /dev/null
@@ -1,310 +0,0 @@
-{-
-Copyright (C) 2006-7 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.LaTeX
- Copyright : Copyright (C) 2006-7 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Conversion of 'Pandoc' format into LaTeX.
--}
-module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where
-import Text.Pandoc.Definition
-import Text.Pandoc.Shared
-import Text.Printf ( printf )
-import Data.List ( (\\), isInfixOf, isSuffixOf, intersperse )
-import Data.Char ( toLower )
-import qualified Data.Set as S
-import Control.Monad.State
-import Text.PrettyPrint.HughesPJ hiding ( Str )
-
-data WriterState =
- WriterState { stIncludes :: S.Set String -- strings to include in header
- , stInNote :: Bool -- @True@ if we're in a note
- , stOLLevel :: Int } -- level of ordered list nesting
-
--- | Add line to header.
-addToHeader :: String -> State WriterState ()
-addToHeader str = do
- st <- get
- let includes = stIncludes st
- put st {stIncludes = S.insert str includes}
-
--- | Convert Pandoc to LaTeX.
-writeLaTeX :: WriterOptions -> Pandoc -> String
-writeLaTeX options document =
- render $ evalState (pandocToLaTeX options document) $
- WriterState { stIncludes = S.empty, stInNote = False, stOLLevel = 1 }
-
-pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState Doc
-pandocToLaTeX options (Pandoc meta blocks) = do
- main <- blockListToLaTeX blocks
- head <- if writerStandalone options
- then latexHeader options meta
- else return empty
- let before = if null (writerIncludeBefore options)
- then empty
- else text (writerIncludeBefore options)
- let after = if null (writerIncludeAfter options)
- then empty
- else text (writerIncludeAfter options)
- let body = before $$ main $$ after
- let toc = if writerTableOfContents options
- then text "\\tableofcontents\n"
- else empty
- let foot = if writerStandalone options
- then text "\\end{document}"
- else empty
- return $ head $$ toc $$ body $$ foot
-
--- | Insert bibliographic information into LaTeX header.
-latexHeader :: WriterOptions -- ^ Options, including LaTeX header
- -> Meta -- ^ Meta with bibliographic information
- -> State WriterState Doc
-latexHeader options (Meta title authors date) = do
- titletext <- if null title
- then return empty
- else inlineListToLaTeX title >>= return . inCmd "title"
- headerIncludes <- get >>= return . S.toList . stIncludes
- let extras = text $ unlines headerIncludes
- let verbatim = if "\\usepackage{fancyvrb}" `elem` headerIncludes
- then text "\\VerbatimFootnotes % allows verbatim text in footnotes"
- else empty
- let authorstext = text $ "\\author{" ++
- joinWithSep "\\\\" (map stringToLaTeX authors) ++ "}"
- let datetext = if date == ""
- then empty
- else text $ "\\date{" ++ stringToLaTeX date ++ "}"
- let maketitle = if null title then empty else text "\\maketitle"
- let secnumline = if (writerNumberSections options)
- then empty
- else text "\\setcounter{secnumdepth}{0}"
- let baseHeader = text $ writerHeader options
- let header = baseHeader $$ extras
- return $ header $$ secnumline $$ verbatim $$ titletext $$ authorstext $$
- datetext $$ text "\\begin{document}" $$ maketitle $$ text ""
-
--- escape things as needed for LaTeX
-
-stringToLaTeX :: String -> String
-stringToLaTeX = escapeStringUsing latexEscapes
- where latexEscapes = backslashEscapes "{}$%&_#" ++
- [ ('^', "\\^{}")
- , ('\\', "\\textbackslash{}")
- , ('~', "\\ensuremath{\\sim}")
- , ('|', "\\textbar{}")
- , ('<', "\\textless{}")
- , ('>', "\\textgreater{}")
- ]
-
--- | Puts contents into LaTeX command.
-inCmd :: String -> Doc -> Doc
-inCmd cmd contents = char '\\' <> text cmd <> braces contents
-
--- | Remove all code elements from list of inline elements
--- (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 (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) = wrapped inlineListToLaTeX lst >>= return
-blockToLaTeX (Para lst) =
- wrapped inlineListToLaTeX lst >>= return . (<> char '\n')
-blockToLaTeX (BlockQuote lst) = do
- contents <- blockListToLaTeX lst
- return $ text "\\begin{quote}" $$ contents $$ text "\\end{quote}"
-blockToLaTeX (CodeBlock str) = do
- st <- get
- env <- if stInNote st
- then do addToHeader "\\usepackage{fancyvrb}"
- return "Verbatim"
- else return "verbatim"
- return $ text ("\\begin{" ++ env ++ "}\n") <> text str <>
- text ("\n\\end{" ++ env ++ "}")
-blockToLaTeX (RawHtml str) = return empty
-blockToLaTeX (BulletList lst) = do
- items <- mapM listItemToLaTeX lst
- return $ text "\\begin{itemize}" $$ vcat items $$ text "\\end{itemize}"
-blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
- st <- get
- let oldlevel = stOLLevel st
- put $ st {stOLLevel = oldlevel + 1}
- items <- mapM listItemToLaTeX lst
- modify (\st -> st {stOLLevel = oldlevel})
- exemplar <- if numstyle /= DefaultStyle || numdelim /= DefaultDelim
- then do addToHeader "\\usepackage{enumerate}"
- return $ char '[' <>
- text (head (orderedListMarkers (1, numstyle,
- numdelim))) <> char ']'
- else return empty
- let resetcounter = if start /= 1 && oldlevel <= 4
- then text $ "\\setcounter{enum" ++
- map toLower (toRomanNumeral oldlevel) ++
- "}{" ++ show (start - 1) ++ "}"
- else empty
- return $ text "\\begin{enumerate}" <> exemplar $$ resetcounter $$
- vcat items $$ text "\\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"
-blockToLaTeX (Header level lst) = do
- txt <- inlineListToLaTeX (deVerb lst)
- return $ if (level > 0) && (level <= 3)
- then text ("\\" ++ (concat (replicate (level - 1) "sub")) ++
- "section{") <> txt <> text "}\n"
- else txt <> char '\n'
-blockToLaTeX (Table caption aligns widths heads rows) = do
- headers <- tableRowToLaTeX heads
- captionText <- inlineListToLaTeX caption
- rows' <- mapM tableRowToLaTeX rows
- let colWidths = map (printf "%.2f") widths
- let colDescriptors = concat $ zipWith
- (\width align -> ">{\\PBS" ++
- (case align of
- AlignLeft -> "\\raggedright"
- AlignRight -> "\\raggedleft"
- AlignCenter -> "\\centering"
- AlignDefault -> "\\raggedright") ++
- "\\hspace{0pt}}p{" ++ width ++
- "\\columnwidth}")
- colWidths aligns
- let tableBody = text ("\\begin{tabular}{" ++ colDescriptors ++ "}") $$
- headers $$ text "\\hline" $$ vcat rows' $$
- text "\\end{tabular}"
- let centered txt = text "\\begin{center}" $$ txt $$ text "\\end{center}"
- addToHeader "\\usepackage{array}\n\
- \% This is needed because raggedright in table elements redefines \\\\:\n\
- \\\newcommand{\\PreserveBackslash}[1]{\\let\\temp=\\\\#1\\let\\\\=\\temp}\n\
- \\\let\\PBS=\\PreserveBackslash"
- return $ if isEmpty captionText
- then centered tableBody <> char '\n'
- else text "\\begin{table}[h]" $$ centered tableBody $$
- inCmd "caption" captionText $$ text "\\end{table}\n"
-
-blockListToLaTeX lst = mapM blockToLaTeX lst >>= return . vcat
-
-tableRowToLaTeX cols = mapM blockListToLaTeX cols >>=
- return . ($$ text "\\\\") . foldl (\row item -> row $$
- (if isEmpty row then empty else text " & ") <> item) empty
-
-listItemToLaTeX lst = blockListToLaTeX lst >>= return . (text "\\item " $$) .
- (nest 2)
-
-defListItemToLaTeX (term, def) = do
- term' <- inlineListToLaTeX $ deVerb term
- def' <- blockListToLaTeX def
- return $ text "\\item[" <> term' <> text "]" $$ def'
-
--- | Convert list of inline elements to LaTeX.
-inlineListToLaTeX :: [Inline] -- ^ Inlines to convert
- -> State WriterState Doc
-inlineListToLaTeX lst = mapM inlineToLaTeX lst >>= return . hcat
-
-isQuoted :: Inline -> Bool
-isQuoted (Quoted _ _) = True
-isQuoted Apostrophe = True
-isQuoted _ = False
-
--- | Convert inline element to LaTeX
-inlineToLaTeX :: Inline -- ^ Inline to convert
- -> State WriterState Doc
-inlineToLaTeX (Emph lst) =
- inlineListToLaTeX (deVerb lst) >>= return . inCmd "emph"
-inlineToLaTeX (Strong lst) =
- inlineListToLaTeX (deVerb lst) >>= return . inCmd "textbf"
-inlineToLaTeX (Strikeout lst) = do
- contents <- inlineListToLaTeX $ deVerb lst
- addToHeader "\\usepackage[normalem]{ulem}"
- return $ inCmd "sout" contents
-inlineToLaTeX (Superscript lst) =
- inlineListToLaTeX (deVerb lst) >>= return . inCmd "textsuperscript"
-inlineToLaTeX (Subscript lst) = do
- contents <- inlineListToLaTeX $ deVerb lst
- -- oddly, latex includes \textsuperscript but not \textsubscript
- -- so we have to define it:
- addToHeader "\\newcommand{\\textsubscript}[1]{\\ensuremath{_{\\scriptsize\\textrm{#1}}}}"
- return $ inCmd "textsubscript" contents
-inlineToLaTeX (Code str) = do
- st <- get
- if stInNote st
- then do addToHeader "\\usepackage{fancyvrb}"
- else return ()
- let chr = ((enumFromTo '!' '~') \\ str) !! 0
- 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
- let s2 = if (not (null lst)) && (isQuoted (last lst))
- then text "\\,"
- 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
- let s2 = if (not (null lst)) && (isQuoted (last lst))
- then text "\\,"
- else empty
- return $ text "``" <> s1 <> contents <> s2 <> text "''"
-inlineToLaTeX Apostrophe = return $ char '\''
-inlineToLaTeX EmDash = return $ text "---"
-inlineToLaTeX EnDash = return $ text "--"
-inlineToLaTeX Ellipses = return $ text "\\ldots{}"
-inlineToLaTeX (Str str) = return $ text $ stringToLaTeX str
-inlineToLaTeX (TeX str) = return $ text str
-inlineToLaTeX (HtmlInline str) = return empty
-inlineToLaTeX (LineBreak) = return $ text "\\\\"
-inlineToLaTeX Space = return $ char ' '
-inlineToLaTeX (Link txt (src, _)) = do
- addToHeader "\\usepackage[breaklinks=true]{hyperref}"
- case txt of
- [Code x] | x == src -> -- autolink
- do addToHeader "\\usepackage{url}"
- return $ text $ "\\url{" ++ x ++ "}"
- _ -> do contents <- inlineListToLaTeX $ deVerb txt
- return $ text ("\\href{" ++ src ++ "}{") <> contents <>
- char '}'
-inlineToLaTeX (Image alternate (source, tit)) = do
- addToHeader "\\usepackage{graphicx}"
- return $ text $ "\\includegraphics{" ++ source ++ "}"
-inlineToLaTeX (Note contents) = do
- st <- get
- put (st {stInNote = True})
- contents' <- blockListToLaTeX contents
- modify (\st -> st {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 "%\n\\footnote{" <>
- text rawnote <> (if optNewline then char '\n' else empty) <> char '}'
diff --git a/Text/Pandoc/Writers/Man.hs b/Text/Pandoc/Writers/Man.hs
deleted file mode 100644
index 8e14c2bf0..000000000
--- a/Text/Pandoc/Writers/Man.hs
+++ /dev/null
@@ -1,293 +0,0 @@
-{-
-Copyright (C) 2007 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.Man
- Copyright : Copyright (C) 2007 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Conversion of 'Pandoc' documents to groff man page format.
-
--}
-module Text.Pandoc.Writers.Man ( writeMan) where
-import Text.Pandoc.Definition
-import Text.Pandoc.Shared
-import Text.Printf ( printf )
-import Data.List ( isPrefixOf, drop, nub, intersperse )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
-import Control.Monad.State
-
-type Notes = [[Block]]
-type Preprocessors = [String] -- e.g. "t" for tbl
-type WriterState = (Notes, Preprocessors)
-
--- | Convert Pandoc to Man.
-writeMan :: WriterOptions -> Pandoc -> String
-writeMan opts document = render $ evalState (pandocToMan opts document) ([],[])
-
--- | Return groff man representation of document.
-pandocToMan :: WriterOptions -> Pandoc -> State WriterState Doc
-pandocToMan opts (Pandoc meta blocks) = do
- let before = writerIncludeBefore opts
- let after = writerIncludeAfter opts
- let before' = if null before then empty else text before
- let after' = if null after then empty else text after
- (head, foot) <- metaToMan opts meta
- body <- blockListToMan opts blocks
- (notes, preprocessors) <- get
- let preamble = if null preprocessors || not (writerStandalone opts)
- then empty
- else text $ ".\\\" " ++ concat (nub preprocessors)
- notes' <- notesToMan opts (reverse notes)
- return $ preamble $$ head $$ before' $$ body $$ notes' $$ foot $$ after'
-
--- | Insert bibliographic information into Man header and footer.
-metaToMan :: WriterOptions -- ^ Options, including Man header
- -> Meta -- ^ Meta with bibliographic information
- -> State WriterState (Doc, Doc)
-metaToMan options (Meta title authors date) = do
- titleText <- inlineListToMan options title
- 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)
- let extras = map (doubleQuotes . text . removeLeadingTrailingSpace) $
- splitBy '|' rest
- let head = (text ".TH") <+> title' <+> section <+>
- doubleQuotes (text date) <+> hsep extras
- let foot = case length authors of
- 0 -> empty
- 1 -> text ".SH AUTHOR" $$ (text $ joinWithSep ", " authors)
- 2 -> text ".SH AUTHORS" $$ (text $ joinWithSep ", " authors)
- return $ if writerStandalone options
- then (head, foot)
- else (empty, empty)
-
--- | Return man representation of notes.
-notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc
-notesToMan opts notes =
- if null notes
- then return empty
- else mapM (\(num, note) -> noteToMan opts num note) (zip [1..] notes) >>=
- return . (text ".SH NOTES" $$) . vcat
-
--- | Return man representation of a note.
-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 ']'
- return $ marker $$ contents
-
--- | Association list of characters to escape.
-manEscapes :: [(Char, String)]
-manEscapes = [('\160', "\\ "), ('\'', "\\[aq]")] ++ backslashEscapes "\".@\\"
-
--- | Escape special characters for Man.
-escapeString :: String -> String
-escapeString = escapeStringUsing manEscapes
-
--- | Escape a literal (code) section for Man.
-escapeCode :: String -> String
-escapeCode = escapeStringUsing (manEscapes ++ backslashEscapes "\t ")
-
--- | Convert Pandoc block element to man.
-blockToMan :: WriterOptions -- ^ Options
- -> Block -- ^ Block element
- -> State WriterState Doc
-blockToMan opts Null = return empty
-blockToMan opts (Plain inlines) =
- wrapIfNeeded opts (inlineListToMan opts) inlines
-blockToMan opts (Para inlines) = do
- contents <- wrapIfNeeded opts (inlineListToMan opts) inlines
- return $ text ".PP" $$ contents
-blockToMan opts (RawHtml str) = return $ text str
-blockToMan opts HorizontalRule = return $ text $ ".PP\n * * * * *"
-blockToMan opts (Header level inlines) = do
- contents <- inlineListToMan opts inlines
- let heading = case level of
- 1 -> ".SH "
- _ -> ".SS "
- return $ text heading <> contents
-blockToMan opts (CodeBlock str) = return $
- text ".PP" $$ text "\\f[CR]" $$
- text ((unlines . map (" " ++) . lines) (escapeCode str)) <> text "\\f[]"
-blockToMan opts (BlockQuote blocks) = do
- contents <- blockListToMan opts blocks
- return $ text ".RS" $$ contents $$ text ".RE"
-blockToMan opts (Table caption alignments widths headers rows) =
- let aligncode AlignLeft = "l"
- aligncode AlignRight = "r"
- aligncode AlignCenter = "c"
- aligncode AlignDefault = "l"
- in do
- caption' <- inlineListToMan opts caption
- modify (\(notes, preprocessors) -> (notes, "t":preprocessors))
- let iwidths = map (printf "w(%0.2fn)" . (70 *)) widths
- -- 78n default width - 8n indent = 70n
- let coldescriptions = text $ joinWithSep " "
- (zipWith (\align width -> aligncode align ++ width)
- alignments iwidths) ++ "."
- colheadings <- mapM (blockListToMan opts) headers
- let makeRow cols = text "T{" $$
- (vcat $ intersperse (text "T}@T{") cols) $$
- text "T}"
- let colheadings' = makeRow colheadings
- body <- mapM (\row -> do
- cols <- mapM (blockListToMan opts) row
- return $ makeRow cols) rows
- return $ text ".PP" $$ caption' $$
- text ".TS" $$ text "tab(@);" $$ coldescriptions $$
- colheadings' $$ char '_' $$ vcat body $$ text ".TE"
-
-blockToMan opts (BulletList items) = do
- contents <- mapM (bulletListItemToMan opts) items
- return (vcat contents)
-blockToMan opts (OrderedList attribs items) = do
- let markers = take (length items) $ orderedListMarkers attribs
- let indent = 1 + (maximum $ map length markers)
- contents <- mapM (\(num, item) -> orderedListItemToMan opts num indent item) $
- zip markers items
- return (vcat contents)
-blockToMan opts (DefinitionList items) = do
- contents <- mapM (definitionListItemToMan opts) items
- return (vcat contents)
-
--- | Convert bullet list item (list of blocks) to man.
-bulletListItemToMan :: WriterOptions -> [Block] -> State WriterState Doc
-bulletListItemToMan opts [] = return empty
-bulletListItemToMan opts ((Para first):rest) =
- bulletListItemToMan opts ((Plain first):rest)
-bulletListItemToMan opts ((Plain first):rest) = do
- first' <- blockToMan opts (Plain first)
- rest' <- blockListToMan opts rest
- let first'' = text ".IP \\[bu] 2" $$ first'
- let rest'' = if null rest
- then empty
- else text ".RS 2" $$ rest' $$ text ".RE"
- return (first'' $$ rest'')
-bulletListItemToMan opts (first:rest) = do
- first' <- blockToMan opts first
- rest' <- blockListToMan opts rest
- return $ text "\\[bu] .RS 2" $$ first' $$ rest' $$ text ".RE"
-
--- | Convert ordered list item (a list of blocks) to man.
-orderedListItemToMan :: WriterOptions -- ^ options
- -> String -- ^ order marker for list item
- -> Int -- ^ number of spaces to indent
- -> [Block] -- ^ list item (list of blocks)
- -> State WriterState Doc
-orderedListItemToMan _ _ _ [] = return empty
-orderedListItemToMan opts num indent ((Para first):rest) =
- orderedListItemToMan opts num indent ((Plain first):rest)
-orderedListItemToMan opts num indent (first:rest) = do
- first' <- blockToMan opts first
- rest' <- blockListToMan opts rest
- let num' = printf ("%" ++ show (indent - 1) ++ "s") num
- let first'' = text (".IP \"" ++ num' ++ "\" " ++ show indent) $$ first'
- let rest'' = if null rest
- then empty
- else text ".RS 4" $$ rest' $$ text ".RE"
- return $ first'' $$ rest''
-
--- | Convert definition list item (label, list of blocks) to man.
-definitionListItemToMan :: WriterOptions
- -> ([Inline],[Block])
- -> State WriterState Doc
-definitionListItemToMan opts (label, items) = do
- labelText <- inlineListToMan opts label
- contents <- if null items
- then return empty
- else do
- let (first, rest) = case items of
- ((Para x):y) -> (Plain x,y)
- (x:y) -> (x,y)
- rest' <- mapM (\item -> blockToMan opts item)
- rest >>= (return . vcat)
- first' <- blockToMan opts first
- return $ first' $$ text ".RS" $$ rest' $$ text ".RE"
- return $ text ".TP\n.B " <> labelText $+$ contents
-
--- | Convert list of Pandoc block elements to man.
-blockListToMan :: WriterOptions -- ^ Options
- -> [Block] -- ^ List of block elements
- -> State WriterState Doc
-blockListToMan opts blocks =
- mapM (blockToMan opts) blocks >>= (return . vcat)
-
--- | Convert list of Pandoc inline elements to man.
-inlineListToMan :: WriterOptions -> [Inline] -> State WriterState Doc
-inlineListToMan opts lst = mapM (inlineToMan opts) lst >>= (return . hcat)
-
--- | Convert Pandoc inline element to man.
-inlineToMan :: WriterOptions -> Inline -> State WriterState Doc
-inlineToMan opts (Emph lst) = do
- contents <- inlineListToMan opts lst
- return $ text "\\f[I]" <> contents <> text "\\f[]"
-inlineToMan opts (Strong lst) = do
- contents <- inlineListToMan opts lst
- return $ text "\\f[B]" <> contents <> text "\\f[]"
-inlineToMan opts (Strikeout lst) = do
- contents <- inlineListToMan opts lst
- return $ text "[STRIKEOUT:" <> contents <> char ']'
-inlineToMan opts (Superscript lst) = do
- contents <- inlineListToMan opts lst
- return $ char '^' <> contents <> char '^'
-inlineToMan opts (Subscript lst) = do
- contents <- inlineListToMan opts lst
- return $ char '~' <> contents <> char '~'
-inlineToMan opts (Quoted SingleQuote lst) = do
- contents <- inlineListToMan opts lst
- return $ char '`' <> contents <> char '\''
-inlineToMan opts (Quoted DoubleQuote lst) = do
- contents <- inlineListToMan opts lst
- return $ text "\\[lq]" <> contents <> text "\\[rq]"
-inlineToMan opts EmDash = return $ text "\\[em]"
-inlineToMan opts EnDash = return $ text "\\[en]"
-inlineToMan opts Apostrophe = return $ char '\''
-inlineToMan opts Ellipses = return $ text "\\&..."
-inlineToMan opts (Code str) =
- return $ text $ "\\f[B]" ++ escapeCode str ++ "\\f[]"
-inlineToMan opts (Str str) = return $ text $ escapeString str
-inlineToMan opts (TeX str) = return $ text $ escapeCode str
-inlineToMan opts (HtmlInline str) = return $ text $ escapeCode str
-inlineToMan opts (LineBreak) = return $ text "\n.PD 0\n.P\n.PD\n"
-inlineToMan opts Space = return $ char ' '
-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 ')'
-inlineToMan 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 <- inlineToMan opts (Link txt (source, tit))
- return $ char '[' <> text "IMAGE: " <> linkPart <> char ']'
-inlineToMan opts (Note contents) = do
- modify (\(notes, prep) -> (contents:notes, prep)) -- add to notes in state
- (notes, _) <- get
- let ref = show $ (length notes)
- return $ char '[' <> text ref <> char ']'
-
diff --git a/Text/Pandoc/Writers/Markdown.hs b/Text/Pandoc/Writers/Markdown.hs
deleted file mode 100644
index 4cecaae5d..000000000
--- a/Text/Pandoc/Writers/Markdown.hs
+++ /dev/null
@@ -1,373 +0,0 @@
-{-
-Copyright (C) 2006-7 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.Markdown
- Copyright : Copyright (C) 2006-7 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Conversion of 'Pandoc' documents to markdown-formatted plain text.
-
-Markdown: <http://daringfireball.net/projects/markdown/>
--}
-module Text.Pandoc.Writers.Markdown ( writeMarkdown) where
-import Text.Pandoc.Definition
-import Text.Pandoc.Shared
-import Text.Pandoc.Blocks
-import Text.ParserCombinators.Parsec ( parse, (<|>), GenParser )
-import Data.List ( group, isPrefixOf, drop, find, intersperse )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
-import Control.Monad.State
-
-type Notes = [[Block]]
-type Refs = KeyTable
-type WriterState = (Notes, Refs)
-
--- | Convert Pandoc to Markdown.
-writeMarkdown :: WriterOptions -> Pandoc -> String
-writeMarkdown opts document =
- render $ evalState (pandocToMarkdown opts document) ([],[])
-
--- | Return markdown representation of document.
-pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState Doc
-pandocToMarkdown opts (Pandoc meta blocks) = do
- let before = writerIncludeBefore opts
- let after = writerIncludeAfter opts
- let before' = if null before then empty else text before
- let after' = if null after then empty else text after
- metaBlock <- metaToMarkdown opts meta
- let head = if writerStandalone opts
- then metaBlock $+$ text (writerHeader opts)
- else empty
- let headerBlocks = filter isHeaderBlock blocks
- let toc = if writerTableOfContents opts
- then tableOfContents opts headerBlocks
- else empty
- body <- blockListToMarkdown opts blocks
- (notes, _) <- get
- notes' <- notesToMarkdown opts (reverse notes)
- (_, refs) <- get -- note that the notes may contain refs
- refs' <- keyTableToMarkdown opts (reverse refs)
- return $ head $+$ before' $+$ toc $+$ body $+$ text "" $+$
- notes' $+$ text "" $+$ refs' $+$ after'
-
--- | Return markdown representation of reference key table.
-keyTableToMarkdown :: WriterOptions -> KeyTable -> State WriterState Doc
-keyTableToMarkdown 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'
-
--- | 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
-
--- | 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
-
--- | Escape special characters for Markdown.
-escapeString :: String -> String
-escapeString = escapeStringUsing markdownEscapes
- where markdownEscapes = ('\160', "&nbsp;"):(backslashEscapes "`<\\*_^~")
-
--- | Convert bibliographic information into Markdown header.
-metaToMarkdown :: WriterOptions -> Meta -> State WriterState Doc
-metaToMarkdown opts (Meta title authors date) = do
- title' <- titleToMarkdown opts title
- authors' <- authorsToMarkdown authors
- date' <- dateToMarkdown date
- return $ title' $+$ authors' $+$ date'
-
-titleToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
-titleToMarkdown opts [] = return empty
-titleToMarkdown opts lst = do
- contents <- inlineListToMarkdown opts lst
- return $ text "% " <> contents
-
-authorsToMarkdown :: [String] -> State WriterState Doc
-authorsToMarkdown [] = return empty
-authorsToMarkdown lst = return $
- text "% " <> text (joinWithSep ", " (map escapeString lst))
-
-dateToMarkdown :: String -> State WriterState Doc
-dateToMarkdown [] = return empty
-dateToMarkdown str = return $ text "% " <> text (escapeString str)
-
--- | Construct table of contents from list of header blocks.
-tableOfContents :: WriterOptions -> [Block] -> Doc
-tableOfContents opts headers =
- let opts' = opts { writerIgnoreNotes = True }
- contents = BulletList $ map elementToListItem $ hierarchicalize headers
- in evalState (blockToMarkdown opts' contents) ([],[])
-
--- | Converts an Element to a list item for a table of contents,
-elementToListItem :: Element -> [Block]
-elementToListItem (Blk _) = []
-elementToListItem (Sec headerText subsecs) = [Plain headerText] ++
- if null subsecs
- then []
- else [BulletList $ map elementToListItem subsecs]
-
--- | Ordered list start parser for use in Para below.
-olMarker :: GenParser Char st Char
-olMarker = do (start, style, delim) <- anyOrderedListMarker
- if delim == Period &&
- (style == UpperAlpha || (style == UpperRoman &&
- start `elem` [1, 5, 10, 50, 100, 500, 1000]))
- then spaceChar >> spaceChar
- else spaceChar
-
--- | True if string begins with an ordered list marker
-beginsWithOrderedListMarker :: String -> Bool
-beginsWithOrderedListMarker str =
- case parse olMarker "para start" 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 opts Null = return empty
-blockToMarkdown opts (Plain inlines) =
- wrappedMarkdown opts inlines
-blockToMarkdown opts (Para inlines) = do
- contents <- wrappedMarkdown 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 opts (RawHtml str) = return $ text str
-blockToMarkdown opts HorizontalRule = return $ text "\n* * * * *\n"
-blockToMarkdown opts (Header level inlines) = do
- contents <- inlineListToMarkdown opts inlines
- return $ text ((replicate level '#') ++ " ") <> contents <> text "\n"
-blockToMarkdown opts (CodeBlock str) = return $
- (nest (writerTabStop opts) $ vcat $ map text (lines str)) <> text "\n"
-blockToMarkdown opts (BlockQuote blocks) = do
- contents <- blockListToMarkdown opts blocks
- return $ (vcat $ map (text . ("> " ++)) $ lines $ render contents) <>
- text "\n"
-blockToMarkdown opts (Table caption aligns widths headers rows) = do
- caption' <- inlineListToMarkdown opts caption
- let caption'' = if null caption
- then empty
- else text "" $+$ (text "Table: " <> caption')
- headers' <- mapM (blockListToMarkdown opts) headers
- let widthsInChars = map (floor . (78 *)) widths
- let alignHeader alignment = case alignment of
- AlignLeft -> leftAlignBlock
- AlignCenter -> centerAlignBlock
- AlignRight -> rightAlignBlock
- AlignDefault -> leftAlignBlock
- let makeRow = hsepBlocks . (zipWith alignHeader aligns) .
- (zipWith docToBlock widthsInChars)
- let head = makeRow headers'
- rows' <- mapM (\row -> do cols <- mapM (blockListToMarkdown opts) row
- return $ makeRow cols) rows
- let tableWidth = sum widthsInChars
- let maxRowHeight = maximum $ map heightOfBlock (head:rows')
- let isMultilineTable = maxRowHeight > 1
- let underline = hsep $
- map (\width -> text $ replicate width '-') widthsInChars
- let border = if isMultilineTable
- then text $ replicate (sum widthsInChars + (length widthsInChars - 1)) '-'
- else empty
- let spacer = if isMultilineTable
- then text ""
- else empty
- let body = vcat $ intersperse spacer $ map blockToDoc rows'
- return $ (nest 2 $ border $+$ (blockToDoc head) $+$ underline $+$ body $+$
- border $+$ caption'') <> text "\n"
-blockToMarkdown opts (BulletList items) = do
- contents <- mapM (bulletListItemToMarkdown opts) items
- return $ (vcat contents) <> text "\n"
-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
- contents <- mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $
- zip markers' items
- return $ (vcat contents) <> text "\n"
-blockToMarkdown opts (DefinitionList items) = do
- contents <- mapM (definitionListItemToMarkdown opts) items
- return $ (vcat contents) <> text "\n"
-
--- | 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
-
--- | Convert ordered list item (a list of blocks) to markdown.
-orderedListItemToMarkdown :: WriterOptions -- ^ options
- -> String -- ^ list item marker
- -> [Block] -- ^ list item (list of blocks)
- -> State WriterState Doc
-orderedListItemToMarkdown opts marker items = do
- contents <- blockListToMarkdown opts items
- -- The complexities here are needed to ensure that if the list
- -- marker is 4 characters or longer, the second and following
- -- lines are indented 4 spaces but the list item begins after the marker.
- return $ sep [nest (min (3 - length marker) 0) (text marker),
- nest (writerTabStop opts) contents]
-
--- | Convert definition list item (label, list of blocks) to markdown.
-definitionListItemToMarkdown :: WriterOptions
- -> ([Inline],[Block])
- -> State WriterState Doc
-definitionListItemToMarkdown opts (label, items) = do
- labelText <- inlineListToMarkdown opts label
- let tabStop = writerTabStop opts
- let leader = char ':'
- contents <- mapM (\item -> blockToMarkdown opts item >>=
- (\txt -> return (leader $$ nest tabStop txt)))
- items >>= return . vcat
- return $ labelText $+$ contents
-
--- | 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
-
--- | Get reference for target; if none exists, create unique one and return.
--- Prefer label if possible; otherwise, generate a unique key.
-getReference :: [Inline] -> Target -> State WriterState [Inline]
-getReference label (src, tit) = do
- (_,refs) <- get
- case find ((== (src, tit)) . snd) refs of
- Just (ref, _) -> return ref
- Nothing -> do
- let label' = case find ((== label) . fst) refs of
- Just _ -> -- label is used; generate numerical label
- case find (\n -> not (any (== [Str (show n)])
- (map fst refs))) [1..10000] of
- Just x -> [Str (show x)]
- Nothing -> error "no unique label"
- Nothing -> label
- modify (\(notes, refs) -> (notes, (label', (src,tit)):refs))
- return label'
-
--- | Convert list of Pandoc inline elements to markdown.
-inlineListToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
-inlineListToMarkdown opts lst =
- mapM (inlineToMarkdown opts) lst >>= return . hcat
-
--- | 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 '*'
-inlineToMarkdown opts (Strong lst) = do
- contents <- inlineListToMarkdown opts lst
- return $ text "**" <> contents <> text "**"
-inlineToMarkdown opts (Strikeout lst) = do
- contents <- inlineListToMarkdown opts lst
- return $ text "~~" <> contents <> text "~~"
-inlineToMarkdown opts (Superscript lst) = do
- contents <- inlineListToMarkdown opts lst
- let contents' = text $ substitute " " "\\ " $ render contents
- return $ char '^' <> contents' <> char '^'
-inlineToMarkdown opts (Subscript lst) = do
- contents <- inlineListToMarkdown opts lst
- let contents' = text $ substitute " " "\\ " $ render contents
- return $ char '~' <> contents' <> char '~'
-inlineToMarkdown opts (Quoted SingleQuote lst) = do
- contents <- inlineListToMarkdown opts lst
- return $ char '\'' <> contents <> char '\''
-inlineToMarkdown opts (Quoted DoubleQuote lst) = do
- contents <- inlineListToMarkdown opts lst
- return $ char '"' <> contents <> char '"'
-inlineToMarkdown opts EmDash = return $ text "--"
-inlineToMarkdown opts EnDash = return $ char '-'
-inlineToMarkdown opts Apostrophe = return $ char '\''
-inlineToMarkdown opts Ellipses = return $ text "..."
-inlineToMarkdown opts (Code 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)
-inlineToMarkdown opts (Str str) = return $ text $ escapeString str
-inlineToMarkdown opts (TeX str) = return $ text str
-inlineToMarkdown opts (HtmlInline str) = return $ text str
-inlineToMarkdown opts (LineBreak) = return $ text " \n"
-inlineToMarkdown opts Space = return $ char ' '
-inlineToMarkdown opts (Link txt (src, tit)) = do
- linktext <- inlineListToMarkdown opts txt
- let linktitle = if null tit then empty else text $ " \"" ++ tit ++ "\""
- let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src
- let useRefLinks = writerReferenceLinks opts
- let useAuto = null tit && txt == [Code srcSuffix]
- ref <- if useRefLinks then getReference txt (src, tit) else return []
- reftext <- inlineListToMarkdown opts ref
- return $ if useAuto
- then char '<' <> text srcSuffix <> char '>'
- else if useRefLinks
- then let first = char '[' <> linktext <> char ']'
- second = if txt == ref
- then text "[]"
- else char '[' <> reftext <> char ']'
- in first <> second
- else char '[' <> linktext <> char ']' <>
- char '(' <> text src <> linktitle <> char ')'
-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 (source, tit))
- return $ char '!' <> linkPart
-inlineToMarkdown opts (Note contents) = do
- modify (\(notes, refs) -> (contents:notes, refs)) -- add to notes in state
- (notes, _) <- get
- let ref = show $ (length notes)
- return $ text "[^" <> text ref <> char ']'
diff --git a/Text/Pandoc/Writers/RST.hs b/Text/Pandoc/Writers/RST.hs
deleted file mode 100644
index ddcbf95c0..000000000
--- a/Text/Pandoc/Writers/RST.hs
+++ /dev/null
@@ -1,325 +0,0 @@
-{-
-Copyright (C) 2006-7 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.RST
- Copyright : Copyright (C) 2006-7 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Conversion of 'Pandoc' documents to reStructuredText.
-
-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 Data.List ( isPrefixOf, isSuffixOf, drop, intersperse )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
-import Control.Monad.State
-
-type Notes = [[Block]]
-type Refs = KeyTable
-type WriterState = (Notes, Refs, Refs) -- first Refs is links, second pictures
-
--- | Convert Pandoc to RST.
-writeRST :: WriterOptions -> Pandoc -> String
-writeRST opts document =
- render $ evalState (pandocToRST opts document) ([],[],[])
-
--- | Return RST representation of document.
-pandocToRST :: WriterOptions -> Pandoc -> State WriterState Doc
-pandocToRST opts (Pandoc meta blocks) = do
- let before = writerIncludeBefore opts
- let after = writerIncludeAfter opts
- before' = if null before then empty else text before
- after' = if null after then empty else text after
- metaBlock <- metaToRST opts meta
- let head = if (writerStandalone opts)
- then metaBlock $+$ text (writerHeader opts)
- else empty
- body <- blockListToRST opts blocks
- (notes, _, _) <- get
- notes' <- notesToRST opts (reverse notes)
- (_, refs, pics) <- get -- note that the notes may contain refs
- refs' <- keyTableToRST opts (reverse refs)
- pics' <- pictTableToRST opts (reverse pics)
- return $ head $+$ before' $+$ body $+$ notes' $+$ text "" $+$ refs' $+$
- pics' $+$ after'
-
--- | Return RST representation of reference key table.
-keyTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc
-keyTableToRST opts refs = mapM (keyToRST opts) refs >>= return . vcat
-
--- | Return RST representation of a reference key.
-keyToRST :: WriterOptions
- -> ([Inline], (String, String))
- -> State WriterState Doc
-keyToRST opts (label, (src, tit)) = do
- label' <- inlineListToRST opts label
- let label'' = if ':' `elem` (render label')
- then char '`' <> label' <> char '`'
- else label'
- return $ text ".. _" <> label'' <> text ": " <> text src
-
--- | Return RST representation of notes.
-notesToRST :: WriterOptions -> [[Block]] -> State WriterState Doc
-notesToRST opts notes =
- mapM (\(num, note) -> noteToRST opts num note) (zip [1..] notes) >>=
- return . vcat
-
--- | Return RST representation of a note.
-noteToRST :: WriterOptions -> Int -> [Block] -> State WriterState Doc
-noteToRST opts num note = do
- contents <- blockListToRST opts note
- let marker = text ".. [" <> text (show num) <> text "] "
- return $ hang marker 3 contents
-
--- | Return RST representation of picture reference table.
-pictTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc
-pictTableToRST opts refs = mapM (pictToRST opts) refs >>= return . vcat
-
--- | Return RST representation of a picture substitution reference.
-pictToRST :: WriterOptions
- -> ([Inline], (String, String))
- -> State WriterState Doc
-pictToRST opts (label, (src, _)) = do
- label' <- inlineListToRST opts 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 = mapM (wrapIfNeeded opts (inlineListToRST opts))
- (splitBy LineBreak inlines) >>= return . vcat
-
--- | Escape special characters for RST.
-escapeString :: String -> String
-escapeString = escapeStringUsing (backslashEscapes "`\\|*_")
-
--- | Convert bibliographic information into RST header.
-metaToRST :: WriterOptions -> Meta -> State WriterState Doc
-metaToRST opts (Meta title authors date) = do
- title' <- titleToRST opts title
- authors' <- authorsToRST authors
- date' <- dateToRST date
- let toc = if writerTableOfContents opts
- then text "" $+$ text ".. contents::"
- else empty
- return $ title' $+$ authors' $+$ date' $+$ toc
-
-titleToRST :: WriterOptions -> [Inline] -> State WriterState Doc
-titleToRST opts [] = return empty
-titleToRST opts lst = do
- contents <- inlineListToRST opts lst
- let titleLength = length $ render contents
- let border = text (replicate titleLength '=')
- return $ border $+$ contents $+$ border <> text "\n"
-
-authorsToRST :: [String] -> State WriterState Doc
-authorsToRST [] = return empty
-authorsToRST (first:rest) = do
- rest' <- authorsToRST rest
- return $ (text ":Author: " <> text first) $+$ rest'
-
-dateToRST :: String -> State WriterState Doc
-dateToRST [] = return empty
-dateToRST str = return $ text ":Date: " <> text (escapeString str)
-
--- | Convert Pandoc block element to RST.
-blockToRST :: WriterOptions -- ^ Options
- -> Block -- ^ Block element
- -> State WriterState Doc
-blockToRST opts Null = return empty
-blockToRST opts (Plain inlines) = wrappedRST opts inlines
-blockToRST opts (Para [TeX str]) =
- let str' = if "\n" `isSuffixOf` str then str ++ "\n" else str ++ "\n\n" in
- return $ hang (text "\n.. raw:: latex\n") 3 $ vcat $ map text (lines str')
-blockToRST opts (Para inlines) = do
- contents <- wrappedRST opts inlines
- return $ contents <> text "\n"
-blockToRST opts (RawHtml str) =
- let str' = if "\n" `isSuffixOf` str then str ++ "\n" else str ++ "\n\n" in
- return $ hang (text "\n.. raw:: html\n") 3 $ vcat $ map text (lines str')
-blockToRST opts HorizontalRule = return $ text "--------------\n"
-blockToRST opts (Header level inlines) = do
- contents <- inlineListToRST opts 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"
-blockToRST opts (CodeBlock str) = return $ (text "::\n") $+$
- (nest (writerTabStop opts) $ vcat $ map text (lines str)) <> text "\n"
-blockToRST opts (BlockQuote blocks) = do
- contents <- blockListToRST opts blocks
- return $ (nest (writerTabStop opts) contents) <> text "\n"
-blockToRST opts (Table caption aligns widths headers rows) = do
- caption' <- inlineListToRST opts caption
- let caption'' = if null caption
- then empty
- else text "" $+$ (text "Table: " <> caption')
- headers' <- mapM (blockListToRST opts) headers
- let widthsInChars = map (floor . (78 *)) widths
- let alignHeader alignment = case alignment of
- AlignLeft -> leftAlignBlock
- AlignCenter -> centerAlignBlock
- AlignRight -> rightAlignBlock
- AlignDefault -> leftAlignBlock
- 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
- let head = makeRow headers'
- rows' <- mapM (\row -> do cols <- mapM (blockListToRST opts) row
- return $ makeRow cols) rows
- let tableWidth = sum widthsInChars
- let maxRowHeight = maximum $ map heightOfBlock (head: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 $ intersperse (border '-') $ map blockToDoc rows'
- return $ border '-' $+$ blockToDoc head $+$ border '=' $+$ body $+$
- border '-' $$ caption'' $$ text ""
-blockToRST opts (BulletList items) = do
- contents <- mapM (bulletListItemToRST opts) items
- -- ensure that sublists have preceding blank line
- return $ text "" $+$ vcat contents <> text "\n"
-blockToRST opts (OrderedList (start, style, delim) items) = do
- let markers = if start == 1 && style == DefaultStyle && delim == DefaultDelim
- then take (length items) $ repeat "#."
- else take (length items) $ orderedListMarkers
- (start, style, 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) -> orderedListItemToRST opts item num) $
- zip markers' items
- -- ensure that sublists have preceding blank line
- return $ text "" $+$ vcat contents <> text "\n"
-blockToRST opts (DefinitionList items) = do
- contents <- mapM (definitionListItemToRST opts) items
- return $ (vcat contents) <> text "\n"
-
--- | Convert bullet list item (list of blocks) to RST.
-bulletListItemToRST :: WriterOptions -> [Block] -> State WriterState Doc
-bulletListItemToRST opts items = do
- contents <- blockListToRST opts items
- return $ hang (text "- ") 3 contents
-
--- | Convert ordered list item (a list of blocks) to RST.
-orderedListItemToRST :: WriterOptions -- ^ options
- -> String -- ^ marker for list item
- -> [Block] -- ^ list item (list of blocks)
- -> State WriterState Doc
-orderedListItemToRST opts marker items = do
- contents <- blockListToRST opts items
- return $ hang (text marker) (length marker + 1) contents
-
--- | Convert defintion list item (label, list of blocks) to RST.
-definitionListItemToRST :: WriterOptions -> ([Inline], [Block]) -> State WriterState Doc
-definitionListItemToRST opts (label, items) = do
- label <- inlineListToRST opts label
- contents <- blockListToRST opts items
- return $ label $+$ nest (writerTabStop opts) contents
-
--- | Convert list of Pandoc block elements to RST.
-blockListToRST :: WriterOptions -- ^ Options
- -> [Block] -- ^ List of block elements
- -> State WriterState Doc
-blockListToRST opts blocks =
- mapM (blockToRST opts) blocks >>= return . vcat
-
--- | Convert list of Pandoc inline elements to RST.
-inlineListToRST :: WriterOptions -> [Inline] -> State WriterState Doc
-inlineListToRST opts lst = mapM (inlineToRST opts) lst >>= return . hcat
-
--- | Convert Pandoc inline element to RST.
-inlineToRST :: WriterOptions -> Inline -> State WriterState Doc
-inlineToRST opts (Emph lst) = do
- contents <- inlineListToRST opts lst
- return $ char '*' <> contents <> char '*'
-inlineToRST opts (Strong lst) = do
- contents <- inlineListToRST opts lst
- return $ text "**" <> contents <> text "**"
-inlineToRST opts (Strikeout lst) = do
- contents <- inlineListToRST opts lst
- return $ text "[STRIKEOUT:" <> contents <> char ']'
-inlineToRST opts (Superscript lst) = do
- contents <- inlineListToRST opts lst
- return $ text "\\ :sup:`" <> contents <> text "`\\ "
-inlineToRST opts (Subscript lst) = do
- contents <- inlineListToRST opts lst
- return $ text "\\ :sub:`" <> contents <> text "`\\ "
-inlineToRST opts (Quoted SingleQuote lst) = do
- contents <- inlineListToRST opts lst
- return $ char '\'' <> contents <> char '\''
-inlineToRST opts (Quoted DoubleQuote lst) = do
- contents <- inlineListToRST opts lst
- return $ char '"' <> contents <> char '"'
-inlineToRST opts EmDash = return $ text "--"
-inlineToRST opts EnDash = return $ char '-'
-inlineToRST opts Apostrophe = return $ char '\''
-inlineToRST opts Ellipses = return $ text "..."
-inlineToRST opts (Code str) = return $ text $ "``" ++ str ++ "``"
-inlineToRST opts (Str str) = return $ text $ escapeString str
-inlineToRST opts (TeX str) = return $ text str
-inlineToRST opts (HtmlInline str) = return empty
-inlineToRST opts (LineBreak) = return $ char ' ' -- RST doesn't have linebreaks
-inlineToRST opts Space = return $ char ' '
-inlineToRST opts (Link [Code str] (src, tit)) | src == str ||
- src == "mailto:" ++ str = do
- let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src
- return $ text srcSuffix
-inlineToRST opts (Link txt (src, tit)) = do
- let useReferenceLinks = writerReferenceLinks opts
- linktext <- inlineListToRST opts $ normalizeSpaces txt
- if useReferenceLinks
- then do (notes, refs, pics) <- get
- let refs' = if (txt, (src, tit)) `elem` refs
- then refs
- else (txt, (src, tit)):refs
- put (notes, refs', pics)
- return $ char '`' <> linktext <> text "`_"
- else return $ char '`' <> linktext <> text " <" <> text src <> text ">`_"
-inlineToRST opts (Image alternate (source, tit)) = do
- (notes, refs, pics) <- get
- let labelsUsed = map fst pics
- let txt = if null alternate || alternate == [Str ""] ||
- alternate `elem` labelsUsed
- then [Str $ "image" ++ show (length refs)]
- else alternate
- let pics' = if (txt, (source, tit)) `elem` pics
- then pics
- else (txt, (source, tit)):pics
- put (notes, refs, pics')
- label <- inlineListToRST opts txt
- return $ char '|' <> label <> char '|'
-inlineToRST opts (Note contents) = do
- -- add to notes in state
- modify (\(notes, refs, pics) -> (contents:notes, refs, pics))
- (notes, _, _) <- get
- let ref = show $ (length notes)
- return $ text " [" <> text ref <> text "]_"
diff --git a/Text/Pandoc/Writers/RTF.hs b/Text/Pandoc/Writers/RTF.hs
deleted file mode 100644
index 3bd5c63b2..000000000
--- a/Text/Pandoc/Writers/RTF.hs
+++ /dev/null
@@ -1,286 +0,0 @@
-{-
-Copyright (C) 2006-7 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.RTF
- Copyright : Copyright (C) 2006-7 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Conversion of 'Pandoc' documents to RTF (rich text format).
--}
-module Text.Pandoc.Writers.RTF ( writeRTF ) where
-import Text.Pandoc.Definition
-import Text.Pandoc.Shared
-import Text.Regex ( matchRegexAll, mkRegex )
-import Data.List ( isSuffixOf )
-import Data.Char ( ord )
-
--- | Convert Pandoc to a string in rich text format.
-writeRTF :: WriterOptions -> Pandoc -> String
-writeRTF options (Pandoc meta blocks) =
- let head = if writerStandalone options
- then rtfHeader (writerHeader options) meta
- else ""
- toc = if writerTableOfContents options
- then tableOfContents $ filter isHeaderBlock blocks
- else ""
- foot = if writerStandalone options then "\n}\n" else ""
- body = writerIncludeBefore options ++
- concatMap (blockToRTF 0 AlignDefault) blocks ++
- writerIncludeAfter options
- in head ++ toc ++ body ++ foot
-
--- | Construct table of contents from list of header blocks.
-tableOfContents :: [Block] -> String
-tableOfContents headers =
- let contentsTree = hierarchicalize headers
- in concatMap (blockToRTF 0 AlignDefault) $
- [Header 1 [Str "Contents"],
- BulletList (map elementToListItem contentsTree)]
-
-elementToListItem :: Element -> [Block]
-elementToListItem (Blk _) = []
-elementToListItem (Sec sectext subsecs) = [Plain sectext] ++
- if null subsecs
- then []
- else [BulletList (map elementToListItem subsecs)]
-
--- | Convert unicode characters (> 127) into rich text format representation.
-handleUnicode :: String -> String
-handleUnicode [] = []
-handleUnicode (c:cs) =
- if ord c > 127
- then '\\':'u':(show (ord c)) ++ "?" ++ handleUnicode cs
- else c:(handleUnicode cs)
-
--- | Escape special characters.
-escapeSpecial :: String -> String
-escapeSpecial = escapeStringUsing (('\t',"\\tab "):(backslashEscapes "{\\}"))
-
--- | Escape strings as needed for rich text format.
-stringToRTF :: String -> String
-stringToRTF = handleUnicode . escapeSpecial
-
--- | Escape things as needed for code block in RTF.
-codeStringToRTF :: String -> String
-codeStringToRTF str = joinWithSep "\\line\n" $ lines (stringToRTF str)
-
--- | Deal with raw LaTeX.
-latexToRTF :: String -> String
-latexToRTF str = "{\\cf1 " ++ (stringToRTF str) ++ "\\cf0 } "
-
--- | Make a paragraph with first-line indent, block indent, and space after.
-rtfParSpaced :: Int -- ^ space after (in twips)
- -> Int -- ^ block indent (in twips)
- -> Int -- ^ first line indent (relative to block) (in twips)
- -> Alignment -- ^ alignment
- -> String -- ^ string with content
- -> String
-rtfParSpaced spaceAfter indent firstLineIndent alignment content =
- let alignString = case alignment of
- AlignLeft -> "\\ql "
- AlignRight -> "\\qr "
- AlignCenter -> "\\qc "
- AlignDefault -> "\\ql "
- in "{\\pard " ++ alignString ++
- "\\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++
- " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n"
-
--- | Default paragraph.
-rtfPar :: Int -- ^ block indent (in twips)
- -> Int -- ^ first line indent (relative to block) (in twips)
- -> Alignment -- ^ alignment
- -> String -- ^ string with content
- -> String
-rtfPar = rtfParSpaced 180
-
--- | Compact paragraph (e.g. for compact list items).
-rtfCompact :: Int -- ^ block indent (in twips)
- -> Int -- ^ first line indent (relative to block) (in twips)
- -> Alignment -- ^ alignment
- -> String -- ^ string with content
- -> String
-rtfCompact = rtfParSpaced 0
-
--- number of twips to indent
-indentIncrement = 720
-listIncrement = 360
-
--- | Returns appropriate bullet list marker for indent level.
-bulletMarker :: Int -> String
-bulletMarker indent = case indent `mod` 720 of
- 0 -> "\\bullet "
- otherwise -> "\\endash "
-
--- | Returns appropriate (list of) ordered list markers for indent level.
-orderedMarkers :: Int -> ListAttributes -> [String]
-orderedMarkers indent (start, style, delim) =
- if style == DefaultStyle && delim == DefaultDelim
- then case indent `mod` 720 of
- 0 -> orderedListMarkers (start, Decimal, Period)
- otherwise -> orderedListMarkers (start, LowerAlpha, Period)
- else orderedListMarkers (start, style, delim)
-
--- | Returns RTF header.
-rtfHeader :: String -- ^ header text
- -> Meta -- ^ bibliographic information
- -> String
-rtfHeader headerText (Meta title authors date) =
- let titletext = if null title
- then ""
- else rtfPar 0 0 AlignCenter $
- "\\b \\fs36 " ++ inlineListToRTF title
- authorstext = if null authors
- then ""
- else rtfPar 0 0 AlignCenter (" " ++ (joinWithSep "\\" $
- map stringToRTF authors))
- datetext = if date == ""
- then ""
- else rtfPar 0 0 AlignCenter (" " ++ stringToRTF date) in
- let spacer = if null (titletext ++ authorstext ++ datetext)
- then ""
- else rtfPar 0 0 AlignDefault "" in
- headerText ++ titletext ++ authorstext ++ datetext ++ spacer
-
--- | Convert Pandoc block element to RTF.
-blockToRTF :: Int -- ^ indent level
- -> Alignment -- ^ alignment
- -> Block -- ^ block to convert
- -> String
-blockToRTF _ _ Null = ""
-blockToRTF indent alignment (Plain lst) =
- rtfCompact indent 0 alignment $ inlineListToRTF lst
-blockToRTF indent alignment (Para lst) =
- rtfPar indent 0 alignment $ inlineListToRTF lst
-blockToRTF indent alignment (BlockQuote lst) =
- concatMap (blockToRTF (indent + indentIncrement) alignment) lst
-blockToRTF indent _ (CodeBlock str) =
- rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str))
-blockToRTF _ _ (RawHtml str) = ""
-blockToRTF indent alignment (BulletList lst) = spaceAtEnd $
- concatMap (listItemToRTF alignment indent (bulletMarker indent)) lst
-blockToRTF indent alignment (OrderedList attribs lst) = spaceAtEnd $ concat $
- zipWith (listItemToRTF alignment indent) (orderedMarkers indent attribs) lst
-blockToRTF indent alignment (DefinitionList lst) = spaceAtEnd $
- concatMap (definitionListItemToRTF alignment indent) lst
-blockToRTF indent _ HorizontalRule =
- rtfPar indent 0 AlignCenter "\\emdash\\emdash\\emdash\\emdash\\emdash"
-blockToRTF indent alignment (Header level lst) = rtfPar indent 0 alignment $
- "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ inlineListToRTF lst
-blockToRTF indent alignment (Table caption aligns sizes headers rows) =
- tableRowToRTF True indent aligns sizes headers ++
- concatMap (tableRowToRTF False indent aligns sizes) rows ++
- rtfPar indent 0 alignment (inlineListToRTF caption)
-
-tableRowToRTF :: Bool -> Int -> [Alignment] -> [Float] -> [[Block]] -> String
-tableRowToRTF header indent aligns sizes cols =
- let columns = concat $ zipWith (tableItemToRTF indent) aligns cols
- totalTwips = 6 * 1440 -- 6 inches
- rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips))
- 0 sizes
- cellDefs = map (\edge -> (if header
- then "\\clbrdrb\\brdrs"
- else "") ++ "\\cellx" ++ show edge)
- rightEdges
- start = "{\n\\trowd \\trgaph120\n" ++ concat cellDefs ++ "\n" ++
- "\\trkeep\\intbl\n{\n"
- end = "}\n\\intbl\\row}\n"
- in start ++ columns ++ end
-
-tableItemToRTF :: Int -> Alignment -> [Block] -> String
-tableItemToRTF indent alignment item =
- let contents = concatMap (blockToRTF indent alignment) item
- in "{\\intbl " ++ contents ++ "\\cell}\n"
-
--- | Ensure that there's the same amount of space after compact
--- lists as after regular lists.
-spaceAtEnd :: String -> String
-spaceAtEnd str =
- if isSuffixOf "\\par}\n" str
- then (take ((length str) - 6) str) ++ "\\sa180\\par}\n"
- else str
-
--- | Convert list item (list of blocks) to RTF.
-listItemToRTF :: Alignment -- ^ alignment
- -> Int -- ^ indent level
- -> String -- ^ list start marker
- -> [Block] -- ^ list item (list of blocks)
- -> [Char]
-listItemToRTF alignment indent marker [] =
- rtfCompact (indent + listIncrement) (0 - listIncrement) alignment
- (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ")
-listItemToRTF alignment indent marker list =
- let (first:rest) = map (blockToRTF (indent + listIncrement) alignment) list in
- -- insert the list marker into the (processed) first block
- let modFirst = case matchRegexAll (mkRegex "\\\\fi-?[0-9]+") first of
- Just (before, matched, after, _) ->
- before ++ "\\fi" ++ show (0 - listIncrement) ++
- " " ++ marker ++ "\\tx" ++
- show listIncrement ++ "\\tab" ++ after
- Nothing -> first in
- modFirst ++ concat rest
-
--- | Convert definition list item (label, list of blocks) to RTF.
-definitionListItemToRTF :: Alignment -- ^ alignment
- -> Int -- ^ indent level
- -> ([Inline],[Block]) -- ^ list item (list of blocks)
- -> [Char]
-definitionListItemToRTF alignment indent (label, items) =
- let labelText = blockToRTF indent alignment (Plain label)
- itemsText = concatMap (blockToRTF (indent + listIncrement) alignment) items
- in labelText ++ itemsText
-
--- | Convert list of inline items to RTF.
-inlineListToRTF :: [Inline] -- ^ list of inlines to convert
- -> String
-inlineListToRTF lst = concatMap inlineToRTF lst
-
--- | Convert inline item to RTF.
-inlineToRTF :: Inline -- ^ inline to convert
- -> String
-inlineToRTF (Emph lst) = "{\\i " ++ (inlineListToRTF lst) ++ "} "
-inlineToRTF (Strong lst) = "{\\b " ++ (inlineListToRTF lst) ++ "} "
-inlineToRTF (Strikeout lst) = "{\\strike " ++ (inlineListToRTF lst) ++ "} "
-inlineToRTF (Superscript lst) = "{\\super " ++ (inlineListToRTF lst) ++ "} "
-inlineToRTF (Subscript lst) = "{\\sub " ++ (inlineListToRTF lst) ++ "} "
-inlineToRTF (Quoted SingleQuote lst) =
- "\\u8216'" ++ (inlineListToRTF lst) ++ "\\u8217'"
-inlineToRTF (Quoted DoubleQuote lst) =
- "\\u8220\"" ++ (inlineListToRTF lst) ++ "\\u8221\""
-inlineToRTF Apostrophe = "\\u8217'"
-inlineToRTF Ellipses = "\\u8230?"
-inlineToRTF EmDash = "\\u8212-"
-inlineToRTF EnDash = "\\u8211-"
-inlineToRTF (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "} "
-inlineToRTF (Str str) = stringToRTF str
-inlineToRTF (TeX str) = latexToRTF str
-inlineToRTF (HtmlInline str) = ""
-inlineToRTF (LineBreak) = "\\line "
-inlineToRTF Space = " "
-inlineToRTF (Link text (src, tit)) =
- "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++
- "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF text) ++ "\n}}}\n"
-inlineToRTF (Image alternate (source, tit)) =
- "{\\cf1 [image: " ++ source ++ "]\\cf0}"
-inlineToRTF (Note contents) =
- "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++
- (concatMap (blockToRTF 0 AlignDefault) contents) ++ "}"
diff --git a/Text/Pandoc/Writers/S5.hs b/Text/Pandoc/Writers/S5.hs
deleted file mode 100644
index 3bcda60d5..000000000
--- a/Text/Pandoc/Writers/S5.hs
+++ /dev/null
@@ -1,136 +0,0 @@
-{-
-Copyright (C) 2006-7 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.S5
- Copyright : Copyright (C) 2006-7 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Definitions for creation of S5 powerpoint-like HTML.
-(See <http://meyerweb.com/eric/tools/s5/>.)
--}
-module Text.Pandoc.Writers.S5 (
- -- * Strings
- s5Meta,
- s5Javascript,
- s5CSS,
- s5Links,
- -- * Functions
- writeS5,
- writeS5String,
- insertS5Structure
- ) where
-import Text.Pandoc.Shared ( joinWithSep, WriterOptions )
-import Text.Pandoc.Writers.HTML ( writeHtml, writeHtmlString )
-import Text.Pandoc.Definition
-import Text.XHtml.Strict
-import Text.Pandoc.Include ( includeStrFrom, s5Path )
-
-s5Meta :: String
-s5Meta = "<!-- configuration parameters -->\n<meta name=\"defaultView\" content=\"slideshow\" />\n<meta name=\"controlVis\" content=\"hidden\" />\n"
-
-s5Javascript :: String
-s5Javascript = "<script type=\"text/javascript\">\n" ++
- $(includeStrFrom $ s5Path "slides.js") ++
- "</script>\n"
-
-s5CoreCSS :: String
-s5CoreCSS = $(includeStrFrom $ s5Path "s5-core.css")
-
-s5FramingCSS :: String
-s5FramingCSS = $(includeStrFrom $ s5Path "framing.css")
-
-s5PrettyCSS :: String
-s5PrettyCSS = $(includeStrFrom $ s5Path "pretty.css")
-
-s5OperaCSS :: String
-s5OperaCSS = $(includeStrFrom $ s5Path "opera.css")
-
-s5OutlineCSS :: String
-s5OutlineCSS = $(includeStrFrom $ s5Path "outline.css")
-
-s5PrintCSS :: String
-s5PrintCSS = $(includeStrFrom $ s5Path "print.css")
-
-s5CSS :: String
-s5CSS = "<style type=\"text/css\" media=\"projection\" id=\"slideProj\">\n" ++ s5CoreCSS ++ "\n" ++ s5FramingCSS ++ "\n" ++ s5PrettyCSS ++ "\n</style>\n<style type=\"text/css\" media=\"projection\" id=\"operaFix\">\n" ++ s5OperaCSS ++ "\n</style>\n<style type=\"text/css\" media=\"screen\" id=\"outlineStyle\">\n" ++ s5OutlineCSS ++ "\n</style>\n<style type=\"text/css\" media=\"print\" id=\"slidePrint\">\n" ++ s5PrintCSS ++ "\n</style>\n"
-
-s5Links :: String
-s5Links = "<!-- style sheet links -->\n<link rel=\"stylesheet\" href=\"ui/default/slides.css\" type=\"text/css\" media=\"projection\" id=\"slideProj\" />\n<link rel=\"stylesheet\" href=\"ui/default/outline.css\" type=\"text/css\" media=\"screen\" id=\"outlineStyle\" />\n<link rel=\"stylesheet\" href=\"ui/default/print.css\" type=\"text/css\" media=\"print\" id=\"slidePrint\" />\n<link rel=\"stylesheet\" href=\"ui/default/opera.css\" type=\"text/css\" media=\"projection\" id=\"operaFix\" />\n<!-- S5 JS -->\n<script src=\"ui/default/slides.js\" type=\"text/javascript\"></script>\n"
-
--- | Converts Pandoc document to an S5 HTML presentation (Html structure).
-writeS5 :: WriterOptions -> Pandoc -> Html
-writeS5 options = (writeHtml options) . insertS5Structure
-
--- | Converts Pandoc document to an S5 HTML presentation (string).
-writeS5String :: WriterOptions -> Pandoc -> String
-writeS5String options = (writeHtmlString options) . insertS5Structure
-
--- | Inserts HTML needed for an S5 presentation (e.g. around slides).
-layoutDiv :: [Inline] -- ^ Title of document (for header or footer)
- -> String -- ^ Date of document (for header or footer)
- -> [Block] -- ^ List of block elements returned
-layoutDiv title date = [(RawHtml "<div class=\"layout\">\n<div id=\"controls\"></div>\n<div id=\"currentSlide\"></div>\n<div id=\"header\"></div>\n<div id=\"footer\">\n"), (Header 1 [Str date]), (Header 2 title), (RawHtml "</div>\n</div>\n")]
-
-presentationStart = RawHtml "<div class=\"presentation\">\n\n"
-
-presentationEnd = RawHtml "</div>\n"
-
-slideStart = RawHtml "<div class=\"slide\">\n"
-
-slideEnd = RawHtml "</div>\n"
-
--- | Returns 'True' if block is a Header 1.
-isH1 :: Block -> Bool
-isH1 (Header 1 _) = True
-isH1 _ = False
-
--- | Insert HTML around sections to make individual slides.
-insertSlides :: Bool -> [Block] -> [Block]
-insertSlides beginning blocks =
- let (beforeHead, rest) = break isH1 blocks in
- if (null rest) then
- if beginning then
- beforeHead
- else
- beforeHead ++ [slideEnd]
- else
- if beginning then
- beforeHead ++
- slideStart:(head rest):(insertSlides False (tail rest))
- else
- beforeHead ++
- slideEnd:slideStart:(head rest):(insertSlides False (tail rest))
-
--- | Insert blocks into 'Pandoc' for slide structure.
-insertS5Structure :: Pandoc -> Pandoc
-insertS5Structure (Pandoc meta []) = Pandoc meta []
-insertS5Structure (Pandoc (Meta title authors date) blocks) =
- let slides = insertSlides True blocks
- firstSlide = if not (null title)
- then [slideStart, (Header 1 title),
- (Header 3 [Str (joinWithSep ", " authors)]),
- (Header 4 [Str date]), slideEnd]
- else []
- newBlocks = (layoutDiv title date) ++ presentationStart:firstSlide ++
- slides ++ [presentationEnd]
- in Pandoc (Meta title authors date) newBlocks
generated by cgit v1.2.3 (git 2.39.1) at 2025-02-17 20:22:15 +0000