summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs3
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs1
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs283
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs84
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs2
-rw-r--r--src/Text/Pandoc/Writers/Man.hs17
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs33
-rw-r--r--src/Text/Pandoc/Writers/Native.hs86
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs83
-rw-r--r--src/Text/Pandoc/Writers/RST.hs32
-rw-r--r--src/Text/Pandoc/Writers/S5.hs136
-rw-r--r--src/Text/Pandoc/Writers/Texinfo.hs1
12 files changed, 561 insertions, 200 deletions
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index 32948e292..395bc2d30 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -64,7 +64,7 @@ pandocToConTeXt options (Pandoc (Meta title authors date) blocks) = do
then return ""
else liftM render $ inlineListToConTeXt date
body <- blockListToConTeXt blocks
- let main = render body
+ let main = render $ body $$ text ""
let context = writerVariables options ++
[ ("toc", if writerTableOfContents options then "yes" else "")
, ("body", main)
@@ -153,6 +153,7 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do
let style'' = case style' of
DefaultStyle -> orderedListStyles !! level
Decimal -> "[n]"
+ Example -> "[n]"
LowerRoman -> "[r]"
UpperRoman -> "[R]"
LowerAlpha -> "[a]"
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index 3abed1610..5223259eb 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -154,6 +154,7 @@ blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) =
let attribs = case numstyle of
DefaultStyle -> []
Decimal -> [("numeration", "arabic")]
+ Example -> [("numeration", "arabic")]
UpperAlpha -> [("numeration", "upperalpha")]
LowerAlpha -> [("numeration", "loweralpha")]
UpperRoman -> [("numeration", "upperroman")]
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
new file mode 100644
index 000000000..deaa2fe33
--- /dev/null
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -0,0 +1,283 @@
+{-
+Copyright (C) 2010 John MacFarlane <jgm@berkeley.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : Text.Pandoc.Writers.EPUB
+ Copyright : Copyright (C) 2010 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <jgm@berkeley.edu>
+ Stability : alpha
+ Portability : portable
+
+Conversion of 'Pandoc' documents to EPUB.
+-}
+module Text.Pandoc.Writers.EPUB ( writeEPUB ) where
+import Data.IORef
+import Data.Maybe ( fromMaybe, isNothing )
+import Data.List ( findIndices, isPrefixOf )
+import System.Environment ( getEnv )
+import System.FilePath ( (</>), takeBaseName, takeExtension )
+import qualified Data.ByteString.Lazy as B
+import Data.ByteString.Lazy.UTF8 ( fromString )
+import Codec.Archive.Zip
+import System.Time
+import Text.Pandoc.Shared hiding ( Element )
+import Text.Pandoc.Definition
+import Control.Monad (liftM)
+import Text.XML.Light hiding (ppTopElement)
+import Text.Pandoc.UUID
+import Text.Pandoc.Writers.HTML
+import Text.Pandoc.Writers.Markdown ( writePlain )
+import Data.Char ( toLower )
+
+-- | Produce an EPUB file from a Pandoc document.
+writeEPUB :: Maybe String -- ^ EPUB stylesheet specified at command line
+ -> WriterOptions -- ^ Writer options
+ -> Pandoc -- ^ Document to convert
+ -> IO B.ByteString
+writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do
+ (TOD epochtime _) <- getClockTime
+ let mkEntry path content = toEntry path epochtime content
+ let opts' = opts{ writerEmailObfuscation = NoObfuscation
+ , writerStandalone = True
+ , writerWrapText = False }
+ let sourceDir = writerSourceDirectory opts'
+
+ -- title page
+ let vars = writerVariables opts'
+ let tpContent = fromString $ writeHtmlString
+ opts'{writerTemplate = pageTemplate
+ ,writerVariables = ("titlepage","yes"):vars}
+ (Pandoc meta [])
+ let tpEntry = mkEntry "title_page.xhtml" tpContent
+
+ -- handle pictures
+ picsRef <- newIORef []
+ Pandoc _ blocks <- liftM (processWith transformBlock) $ processWithM
+ (transformInlines (writerHTMLMathMethod opts) sourceDir picsRef) doc
+ pics <- readIORef picsRef
+ let readPicEntry (oldsrc, newsrc) = readEntry [] oldsrc >>= \e ->
+ return e{ eRelativePath = newsrc }
+ picEntries <- mapM readPicEntry pics
+
+ -- body pages
+ let isH1 (Header 1 _) = True
+ isH1 _ = False
+ let h1Indices = dropWhile (== 0) $ findIndices isH1 blocks
+ let chunks = splitByIndices h1Indices blocks
+ let titleize (Header 1 xs : ys) = Pandoc meta{docTitle = xs} ys
+ titleize xs = Pandoc meta xs
+ let chapToHtml = writeHtmlString opts'{ writerTemplate = pageTemplate
+ , writerHTMLMathMethod = PlainMath }
+ let chapters = map titleize chunks
+ let chapterToEntry :: Int -> Pandoc -> Entry
+ chapterToEntry num chap = mkEntry ("ch" ++ show num ++ ".xhtml") $
+ fromString $ chapToHtml chap
+ let chapterEntries = zipWith chapterToEntry [1..] chapters
+
+ -- contents.opf
+ lang <- catch (liftM (takeWhile (/='.')) $ getEnv "lang")
+ (\_ -> return "en-US")
+ uuid <- getRandomUUID
+ let chapterNode ent = unode "item" !
+ [("id", takeBaseName $ eRelativePath ent),
+ ("href", eRelativePath ent),
+ ("media-type", "application/xhtml+xml")] $ ()
+ let chapterRefNode ent = unode "itemref" !
+ [("idref", takeBaseName $ eRelativePath ent)] $ ()
+ let pictureNode ent = unode "item" !
+ [("id", takeBaseName $ eRelativePath ent),
+ ("href", eRelativePath ent),
+ ("media-type", fromMaybe "application/octet-stream"
+ $ imageTypeOf $ eRelativePath ent)] $ ()
+ let plainify t = removeTrailingSpace $
+ writePlain opts'{ writerStandalone = False } $
+ Pandoc meta [Plain t]
+ let plainTitle = plainify $ docTitle meta
+ let plainAuthors = map plainify $ docAuthors meta
+ let contentsData = fromString $ ppTopElement $
+ unode "package" ! [("version","2.0")
+ ,("xmlns","http://www.idpf.org/2007/opf")
+ ,("unique-identifier","BookId")] $
+ [ metadataElement (writerEPUBMetadata opts')
+ uuid lang plainTitle plainAuthors
+ , unode "manifest" $
+ [ unode "item" ! [("id","ncx"), ("href","toc.ncx")
+ ,("media-type","application/x-dtbncx+xml")] $ ()
+ , unode "item" ! [("id","style"), ("href","stylesheet.css")
+ ,("media-type","text/css")] $ ()
+ ] ++
+ map chapterNode (tpEntry : chapterEntries) ++
+ map pictureNode picEntries
+ , unode "spine" ! [("toc","ncx")] $
+ map chapterRefNode (tpEntry : chapterEntries)
+ ]
+ let contentsEntry = mkEntry "content.opf" contentsData
+
+ -- toc.ncx
+ let navPointNode ent n tit = unode "navPoint" !
+ [("id", "navPoint-" ++ show n)
+ ,("playOrder", show n)] $
+ [ unode "navLabel" $ unode "text" tit
+ , unode "content" ! [("src",
+ eRelativePath ent)] $ ()
+ ]
+ let tocData = fromString $ ppTopElement $
+ unode "ncx" ! [("version","2005-1")
+ ,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $
+ [ unode "head"
+ [ unode "meta" ! [("name","dtb:uid")
+ ,("content", show uuid)] $ ()
+ , unode "meta" ! [("name","dtb:depth")
+ ,("content", "1")] $ ()
+ , unode "meta" ! [("name","dtb:totalPageCount")
+ ,("content", "0")] $ ()
+ , unode "meta" ! [("name","dtb:maxPageNumber")
+ ,("content", "0")] $ ()
+ ]
+ , unode "docTitle" $ unode "text" $ plainTitle
+ , unode "navMap" $ zipWith3 navPointNode (tpEntry : chapterEntries)
+ [1..(length chapterEntries + 1)]
+ ("Title Page" : map (\(Pandoc m _) ->
+ plainify $ docTitle m) chapters)
+ ]
+ let tocEntry = mkEntry "toc.ncx" tocData
+
+ -- mimetype
+ let mimetypeEntry = mkEntry "mimetype" $ fromString "application/epub+zip"
+
+ -- container.xml
+ let containerData = fromString $ ppTopElement $
+ unode "container" ! [("version","1.0")
+ ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
+ unode "rootfiles" $
+ unode "rootfile" ! [("full-path","content.opf")
+ ,("media-type","application/oebps-package+xml")] $ ()
+ let containerEntry = mkEntry "META-INF/container.xml" containerData
+
+ -- stylesheet
+ stylesheet <- case mbStylesheet of
+ Just s -> return s
+ Nothing -> readDataFile (writerUserDataDir opts) "epub.css"
+ let stylesheetEntry = mkEntry "stylesheet.css" $ fromString stylesheet
+
+ -- construct archive
+ let archive = foldr addEntryToArchive emptyArchive
+ (mimetypeEntry : containerEntry : stylesheetEntry : tpEntry :
+ contentsEntry : tocEntry : (picEntries ++ chapterEntries) )
+ return $ fromArchive archive
+
+metadataElement :: String -> UUID -> String -> String -> [String] -> Element
+metadataElement metadataXML uuid lang title authors =
+ let userNodes = parseXML metadataXML
+ elt = unode "metadata" ! [("xmlns:dc","http://purl.org/dc/elements/1.1/")
+ ,("xmlns:opf","http://www.idpf.org/2007/opf")] $
+ filter isDublinCoreElement $ onlyElems userNodes
+ dublinElements = ["contributor","coverage","creator","date",
+ "description","format","identifier","language","publisher",
+ "relation","rights","source","subject","title","type"]
+ isDublinCoreElement e = qPrefix (elName e) == Just "dc" &&
+ qName (elName e) `elem` dublinElements
+ contains e n = not (null (findElements (QName n Nothing (Just "dc")) e))
+ newNodes = [ unode "dc:title" title | not (elt `contains` "title") ] ++
+ [ unode "dc:language" lang | not (elt `contains` "language") ] ++
+ [ unode "dc:identifier" ! [("id","BookId")] $ show uuid |
+ not (elt `contains` "identifier") ] ++
+ [ unode "dc:creator" ! [("opf:role","aut")] $ a | a <- authors ]
+ in elt{ elContent = elContent elt ++ map Elem newNodes }
+
+transformInlines :: HTMLMathMethod
+ -> FilePath
+ -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images
+ -> [Inline]
+ -> IO [Inline]
+transformInlines _ _ _ (Image lab (src,_) : xs) | isNothing (imageTypeOf src) =
+ return $ Emph lab : xs
+transformInlines _ sourceDir picsRef (Image lab (src,tit) : xs) = do
+ pics <- readIORef picsRef
+ let oldsrc = sourceDir </> src
+ let ext = takeExtension src
+ newsrc <- case lookup oldsrc pics of
+ Just n -> return n
+ Nothing -> do
+ let new = "images/img" ++ show (length pics) ++ ext
+ modifyIORef picsRef ( (oldsrc, new): )
+ return new
+ return $ Image lab (newsrc, tit) : xs
+transformInlines (MathML _) _ _ (x@(Math _ _) : xs) = do
+ let writeHtmlInline opts z = removeTrailingSpace $
+ writeHtmlString opts $ Pandoc (Meta [] [] []) [Plain [z]]
+ mathml = writeHtmlInline defaultWriterOptions{
+ writerHTMLMathMethod = MathML Nothing } x
+ fallback = writeHtmlInline defaultWriterOptions{
+ writerHTMLMathMethod = PlainMath } x
+ inOps = "<ops:switch xmlns:ops=\"http://www.idpf.org/2007/ops\">" ++
+ "<ops:case required-namespace=\"http://www.w3.org/1998/Math/MathML\">" ++
+ mathml ++ "</ops:case><ops:default>" ++ fallback ++ "</ops:default>" ++
+ "</ops:switch>"
+ result = if "<math" `isPrefixOf` mathml then inOps else mathml
+ return $ HtmlInline result : xs
+transformInlines _ _ _ (HtmlInline _ : xs) = return $ Str "" : xs
+transformInlines _ _ _ (Link lab (_,_) : xs) = return $ lab ++ xs
+transformInlines _ _ _ xs = return xs
+
+transformBlock :: Block -> Block
+transformBlock (RawHtml _) = Null
+transformBlock x = x
+
+(!) :: Node t => (t -> Element) -> [(String, String)] -> t -> Element
+(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)
+
+-- | Version of 'ppTopElement' that specifies UTF-8 encoding.
+ppTopElement :: Element -> String
+ppTopElement = ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++) . ppElement
+
+imageTypeOf :: FilePath -> Maybe String
+imageTypeOf x = case drop 1 (map toLower (takeExtension x)) of
+ "jpg" -> Just "image/jpeg"
+ "jpeg" -> Just "image/jpeg"
+ "jfif" -> Just "image/jpeg"
+ "png" -> Just "image/png"
+ "gif" -> Just "image/gif"
+ "svg" -> Just "image/svg+xml"
+ _ -> Nothing
+
+pageTemplate :: String
+pageTemplate = unlines
+ [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
+ , "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"
+ , "<html xmlns=\"http://www.w3.org/1999/xhtml\">"
+ , "<head>"
+ , "<title>$title$</title>"
+ , "<link href=\"stylesheet.css\" type=\"text/css\" rel=\"stylesheet\" />"
+ , "</head>"
+ , "<body>"
+ , "$if(titlepage)$"
+ , "<h1 class=\"title\">$title$</h1>"
+ , "$for(author)$"
+ , "<h2 class=\"author\">$author$</h2>"
+ , "$endfor$"
+ , "$else$"
+ , "<h1>$title$</h1>"
+ , "$body$"
+ , "$endif$"
+ , "</body>"
+ , "</html>"
+ ]
+
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 299471328..d2a400c5c 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -34,8 +34,9 @@ import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )
import Text.Pandoc.Shared
import Text.Pandoc.Templates
import Text.Pandoc.Readers.TeXMath
-import Text.Pandoc.Highlighting ( highlightHtml )
+import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss )
import Text.Pandoc.XML (stripTags, escapeStringForXML)
+import Network.HTTP ( urlEncode )
import Numeric ( showHex )
import Data.Char ( ord, toLower )
import Data.List ( isPrefixOf, intersperse )
@@ -104,7 +105,24 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
toc <- if writerTableOfContents opts
then tableOfContents opts sects
else return Nothing
- blocks' <- liftM toHtmlFromList $ mapM (elementToHtml opts) sects
+ let startSlide = RawHtml "<div class=\"slide\">\n"
+ endSlide = RawHtml "</div>\n"
+ let cutUp (HorizontalRule : Header 1 ys : xs) = cutUp (Header 1 ys : xs)
+ cutUp (HorizontalRule : xs) = [endSlide, startSlide] ++ cutUp xs
+ cutUp (Header 1 ys : xs) = [endSlide, startSlide] ++
+ (Header 1 ys : cutUp xs)
+ cutUp (x:xs) = x : cutUp xs
+ cutUp [] = []
+ let slides = case blocks of
+ (HorizontalRule : xs) -> [startSlide] ++ cutUp xs ++ [endSlide]
+ (Header 1 ys : xs) -> [startSlide, Header 1 ys] ++
+ cutUp xs ++ [endSlide]
+ _ -> [startSlide] ++ cutUp blocks ++
+ [endSlide]
+ blocks' <- liftM toHtmlFromList $
+ if writerSlideVariant opts `elem` [SlidySlides, S5Slides]
+ then mapM (blockToHtml opts) slides
+ else mapM (elementToHtml opts) sects
st <- get
let notes = reverse (stNotes st)
let thebody = blocks' +++ footnoteSection notes
@@ -125,7 +143,8 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
primHtml s
Nothing -> noHtml
else noHtml
- let newvars = [("highlighting","yes") | stHighlighting st] ++
+ let newvars = [("highlighting-css", defaultHighlightingCss) |
+ stHighlighting st] ++
[("math", renderHtmlFragment math) | stMath st]
return (tit, auths, date, toc, thebody, newvars)
@@ -197,10 +216,16 @@ elementToHtml opts (Sec level num id' title' elements) = do
innerContents <- mapM (elementToHtml opts) elements
modify $ \st -> st{stSecNum = num} -- update section number
header' <- blockToHtml opts (Header level title')
- return $ if writerS5 opts || (writerStrictMarkdown opts && not (writerTableOfContents opts))
- -- S5 gets confused by the extra divs around sections
- then toHtmlFromList (header' : innerContents)
- else thediv ! [prefixedId opts id'] << (header' : innerContents)
+ let slides = writerSlideVariant opts `elem` [SlidySlides, S5Slides]
+ let header'' = header' ! [prefixedId opts id' |
+ not (writerStrictMarkdown opts ||
+ writerSectionDivs opts || slides)]
+ let stuff = header'' : innerContents
+ return $ if slides -- S5 gets confused by the extra divs around sections
+ then toHtmlFromList stuff
+ else if writerSectionDivs opts
+ then thediv ! [prefixedId opts id'] << stuff
+ else toHtmlFromList stuff
-- | Convert list of Note blocks to a footnote <div>.
-- Assumes notes are sorted.
@@ -285,15 +310,18 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
attrs = [theclass (unwords classes') | not (null classes')] ++
[prefixedId opts id' | not (null id')] ++
map (\(x,y) -> strAttr x y) keyvals
+ addBird = if "literate" `elem` classes'
+ then unlines . map ("> " ++) . lines
+ else unlines . lines
in return $ pre ! attrs $ thecode <<
(replicate (length leadingBreaks) br +++
- [stringToHtml $ rawCode' ++ "\n"])
+ [stringToHtml $ addBird rawCode'])
Right h -> modify (\st -> st{ stHighlighting = True }) >> return h
blockToHtml opts (BlockQuote blocks) =
-- in S5, treat list in blockquote specially
-- if default is incremental, make it nonincremental;
-- otherwise incremental
- if writerS5 opts
+ if writerSlideVariant opts /= NoSlides
then let inc = not (writerIncremental opts) in
case blocks of
[BulletList lst] -> blockToHtml (opts {writerIncremental = inc})
@@ -444,16 +472,20 @@ inlineToHtml opts inline =
-- non-math elements on the page from being treated as math by
-- the javascript
return $ thespan ! [theclass "LaTeX"] $
- if t == InlineMath
- then primHtml ("$" ++ str ++ "$")
- else primHtml ("$$" ++ str ++ "$$")
- JsMath _ ->
- return $ if t == InlineMath
- then thespan ! [theclass "math"] $ primHtml str
- else thediv ! [theclass "math"] $ primHtml str
- MimeTeX url ->
- return $ image ! [src (url ++ "?" ++ str),
- alt str, title str]
+ case t of
+ InlineMath -> primHtml ("$" ++ str ++ "$")
+ DisplayMath -> primHtml ("$$" ++ str ++ "$$")
+ JsMath _ -> do
+ let m = primHtml str
+ return $ case t of
+ InlineMath -> thespan ! [theclass "math"] $ m
+ DisplayMath -> thediv ! [theclass "math"] $ m
+ WebTeX url -> do
+ let m = image ! [src (url ++ urlEncode str),
+ alt str, title str]
+ return $ case t of
+ InlineMath -> m
+ DisplayMath -> br +++ m +++ br
GladTeX ->
return $ primHtml $ "<EQ>" ++ str ++ "</EQ>"
MathML _ -> do
@@ -466,12 +498,14 @@ inlineToHtml opts inline =
Right r -> return $ primHtml $
ppcElement conf r
Left _ -> inlineListToHtml opts
- (readTeXMath str) >>=
- return . (thespan !
- [theclass "math"])
- PlainMath ->
- inlineListToHtml opts (readTeXMath str) >>=
- return . (thespan ! [theclass "math"]) )
+ (readTeXMath str) >>= return .
+ (thespan ! [theclass "math"])
+ PlainMath -> do
+ x <- inlineListToHtml opts (readTeXMath str)
+ let m = thespan ! [theclass "math"] $ x
+ return $ case t of
+ InlineMath -> m
+ DisplayMath -> br +++ m +++ br )
(TeX str) -> case writerHTMLMathMethod opts of
LaTeXMathML _ -> do modify (\st -> st {stMath = True})
return $ primHtml str
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 8aa028bd7..720c00ac8 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -338,7 +338,7 @@ inlineToLaTeX (Link txt (src, _)) =
char '}'
inlineToLaTeX (Image _ (source, _)) = do
modify $ \s -> s{ stGraphics = True }
- return $ text $ "\\includegraphics{" ++ source ++ "}"
+ return $ text $ "\\includegraphics{" ++ source ++ "}"
inlineToLaTeX (Note contents) = do
st <- get
put (st {stInNote = True})
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 77dead196..a46a18893 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -32,6 +32,7 @@ module Text.Pandoc.Writers.Man ( writeMan) where
import Text.Pandoc.Definition
import Text.Pandoc.Templates
import Text.Pandoc.Shared
+import Text.Pandoc.Readers.TeXMath
import Text.Printf ( printf )
import Data.List ( isPrefixOf, intersperse, intercalate )
import Text.PrettyPrint.HughesPJ hiding ( Str )
@@ -62,7 +63,7 @@ pandocToMan opts (Pandoc (Meta title authors date) blocks) = do
body <- blockListToMan opts blocks
notes <- liftM stNotes get
notes' <- notesToMan opts (reverse notes)
- let main = render $ body $$ notes'
+ let main = render $ body $$ notes' $$ text ""
hasTables <- liftM stHasTables get
let context = writerVariables opts ++
[ ("body", main)
@@ -150,8 +151,12 @@ blockToMan opts (Header level inlines) = do
_ -> ".SS "
return $ text heading <> contents
blockToMan _ (CodeBlock _ str) = return $
- text ".PP" $$ text "\\f[CR]" $$
- text ((unlines . map (" " ++) . lines) (escapeCode str)) <> text "\\f[]"
+ text ".IP" $$
+ text ".nf" $$
+ text "\\f[C]" $$
+ text (escapeCode str) $$
+ text "\\f[]" $$
+ text ".fi"
blockToMan opts (BlockQuote blocks) = do
contents <- blockListToMan opts blocks
return $ text ".RS" $$ contents $$ text ".RE"
@@ -299,11 +304,11 @@ inlineToMan _ EnDash = return $ text "\\[en]"
inlineToMan _ Apostrophe = return $ char '\''
inlineToMan _ Ellipses = return $ text "\\&..."
inlineToMan _ (Code str) =
- return $ text $ "\\f[B]" ++ escapeCode str ++ "\\f[]"
+ return $ text $ "\\f[C]" ++ escapeCode str ++ "\\f[]"
inlineToMan _ (Str str) = return $ text $ escapeString str
-inlineToMan opts (Math InlineMath str) = inlineToMan opts (Code str)
+inlineToMan opts (Math InlineMath str) = inlineListToMan opts $ readTeXMath str
inlineToMan opts (Math DisplayMath str) = do
- contents <- inlineToMan opts (Code str)
+ contents <- inlineListToMan opts $ readTeXMath str
return $ text ".RS" $$ contents $$ text ".RE"
inlineToMan _ (TeX _) = return empty
inlineToMan _ (HtmlInline _) = return empty
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index fe8e0c2de..1b612006b 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -32,15 +32,16 @@ Markdown: <http://daringfireball.net/projects/markdown/>
module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
import Text.Pandoc.Definition
import Text.Pandoc.Templates (renderTemplate)
-import Text.Pandoc.Shared
+import Text.Pandoc.Shared
+import Text.Pandoc.Parsing
import Text.Pandoc.Blocks
-import Text.ParserCombinators.Parsec ( parse, GenParser )
+import Text.ParserCombinators.Parsec ( runParser, GenParser )
import Data.List ( group, isPrefixOf, find, intersperse, transpose )
import Text.PrettyPrint.HughesPJ hiding ( Str )
import Control.Monad.State
type Notes = [[Block]]
-type Refs = KeyTable
+type Refs = [([Inline], Target)]
data WriterState = WriterState { stNotes :: Notes
, stRefs :: Refs
, stPlain :: Bool }
@@ -94,8 +95,8 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
st <- get
notes' <- notesToMarkdown opts (reverse $ stNotes st)
st' <- get -- note that the notes may contain refs
- refs' <- keyTableToMarkdown opts (reverse $ stRefs st')
- let main = render $ body $+$ text "" $+$ notes' $+$ text "" $+$ refs'
+ refs' <- refsToMarkdown opts (reverse $ stRefs st')
+ let main = render $ foldl ($+$) empty $ [body, notes', refs']
let context = writerVariables opts ++
[ ("toc", render toc)
, ("body", main)
@@ -109,8 +110,8 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
else return main
-- | Return markdown representation of reference key table.
-keyTableToMarkdown :: WriterOptions -> KeyTable -> State WriterState Doc
-keyTableToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
+refsToMarkdown :: WriterOptions -> Refs -> State WriterState Doc
+refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
-- | Return markdown representation of a reference key.
keyToMarkdown :: WriterOptions
@@ -158,7 +159,7 @@ elementToListItem (Sec _ _ _ headerText subsecs) = [Plain headerText] ++
else [BulletList $ map elementToListItem subsecs]
-- | Ordered list start parser for use in Para below.
-olMarker :: GenParser Char st Char
+olMarker :: GenParser Char ParserState Char
olMarker = do (start, style', delim) <- anyOrderedListMarker
if delim == Period &&
(style' == UpperAlpha || (style' == UpperRoman &&
@@ -169,7 +170,7 @@ olMarker = do (start, style', delim) <- anyOrderedListMarker
-- | True if string begins with an ordered list marker
beginsWithOrderedListMarker :: String -> Bool
beginsWithOrderedListMarker str =
- case parse olMarker "para start" str of
+ case runParser olMarker defaultParserState "para start" str of
Left _ -> False
Right _ -> True
@@ -238,7 +239,7 @@ 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')
+ else text "" $+$ (text ": " <> caption')
headers' <- mapM (blockListToMarkdown opts) headers
let alignHeader alignment = case alignment of
AlignLeft -> leftAlignBlock
@@ -372,14 +373,14 @@ inlineToMarkdown opts (Subscript lst) = do
inlineToMarkdown opts (SmallCaps lst) = inlineListToMarkdown opts lst
inlineToMarkdown opts (Quoted SingleQuote lst) = do
contents <- inlineListToMarkdown opts lst
- return $ char '\'' <> contents <> char '\''
+ return $ char '‘' <> contents <> char '’'
inlineToMarkdown opts (Quoted DoubleQuote lst) = do
contents <- inlineListToMarkdown opts lst
- return $ char '"' <> contents <> char '"'
-inlineToMarkdown _ EmDash = return $ text "--"
-inlineToMarkdown _ EnDash = return $ char '-'
-inlineToMarkdown _ Apostrophe = return $ char '\''
-inlineToMarkdown _ Ellipses = return $ text "..."
+ return $ char '“' <> contents <> char '”'
+inlineToMarkdown _ EmDash = return $ char '\8212'
+inlineToMarkdown _ EnDash = return $ char '\8211'
+inlineToMarkdown _ Apostrophe = return $ char '\8217'
+inlineToMarkdown _ Ellipses = return $ char '\8230'
inlineToMarkdown _ (Code str) =
let tickGroups = filter (\s -> '`' `elem` s) $ group str
longest = if null tickGroups
diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
new file mode 100644
index 000000000..3b5ea7481
--- /dev/null
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -0,0 +1,86 @@
+{-
+Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : Text.Pandoc.Writers.Native
+ Copyright : Copyright (C) 2006-2010 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <jgm@berkeley.edu>
+ Stability : alpha
+ Portability : portable
+
+Utility functions and definitions used by the various Pandoc modules.
+-}
+module Text.Pandoc.Writers.Native ( writeNative )
+where
+import Text.Pandoc.Shared ( WriterOptions )
+import Data.List ( intercalate )
+import Text.Pandoc.Definition
+
+-- | Indent string as a block.
+indentBy :: Int -- ^ Number of spaces to indent the block
+ -> Int -- ^ Number of spaces (rel to block) to indent first line
+ -> String -- ^ Contents of block to indent
+ -> String
+indentBy _ _ [] = ""
+indentBy num first str =
+ let (firstLine:restLines) = lines str
+ firstLineIndent = num + first
+ in (replicate firstLineIndent ' ') ++ firstLine ++ "\n" ++
+ (intercalate "\n" $ map ((replicate num ' ') ++ ) restLines)
+
+-- | Prettyprint list of Pandoc blocks elements.
+prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks
+ -> [Block] -- ^ List of blocks
+ -> String
+prettyBlockList indent [] = indentBy indent 0 "[]"
+prettyBlockList indent blocks = indentBy indent (-2) $ "[ " ++
+ (intercalate "\n, " (map prettyBlock blocks)) ++ " ]"
+
+-- | Prettyprint Pandoc block element.
+prettyBlock :: Block -> String
+prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++
+ (prettyBlockList 2 blocks)
+prettyBlock (OrderedList attribs blockLists) =
+ "OrderedList " ++ show attribs ++ "\n" ++ indentBy 2 0 ("[ " ++
+ (intercalate ", " $ map (\blocks -> prettyBlockList 2 blocks)
+ blockLists)) ++ " ]"
+prettyBlock (BulletList blockLists) = "BulletList\n" ++
+ indentBy 2 0 ("[ " ++ (intercalate ", "
+ (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
+prettyBlock (DefinitionList items) = "DefinitionList\n" ++
+ indentBy 2 0 ("[ " ++ (intercalate "\n, "
+ (map (\(term, defs) -> "(" ++ show term ++ ",\n" ++
+ indentBy 3 0 ("[ " ++ (intercalate ", "
+ (map (\blocks -> prettyBlockList 2 blocks) defs)) ++ "]") ++
+ ")") items))) ++ " ]"
+prettyBlock (Table caption aligns widths header rows) =
+ "Table " ++ show caption ++ " " ++ show aligns ++ " " ++
+ show widths ++ "\n" ++ prettyRow header ++ " [\n" ++
+ (intercalate ",\n" (map prettyRow rows)) ++ " ]"
+ where prettyRow cols = indentBy 2 0 ("[ " ++ (intercalate ", "
+ (map (\blocks -> prettyBlockList 2 blocks)
+ cols))) ++ " ]"
+prettyBlock block = show block
+
+-- | Prettyprint Pandoc document.
+writeNative :: WriterOptions -> Pandoc -> String
+writeNative _ (Pandoc meta blocks) = "Pandoc " ++ "(" ++ show meta ++
+ ")\n" ++ (prettyBlockList 0 blocks) ++ "\n"
+
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
new file mode 100644
index 000000000..5aa0fd310
--- /dev/null
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -0,0 +1,83 @@
+{-
+Copyright (C) 2008-2010 John MacFarlane <jgm@berkeley.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : Text.Pandoc.Writers.ODT
+ Copyright : Copyright (C) 2008-2010 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <jgm@berkeley.edu>
+ Stability : alpha
+ Portability : portable
+
+Conversion of 'Pandoc' documents to ODT.
+-}
+module Text.Pandoc.Writers.ODT ( writeODT ) where
+import Data.IORef
+import System.FilePath ( (</>), takeExtension )
+import qualified Data.ByteString.Lazy as B
+import Data.ByteString.Lazy.UTF8 ( fromString )
+import Codec.Archive.Zip
+import System.Time
+import Paths_pandoc ( getDataFileName )
+import Text.Pandoc.Shared ( WriterOptions(..) )
+import Text.Pandoc.Definition
+import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )
+import System.Directory
+import Control.Monad (liftM)
+
+-- | Produce an ODT file from a Pandoc document.
+writeODT :: Maybe FilePath -- ^ Path specified by --reference-odt
+ -> WriterOptions -- ^ Writer options
+ -> Pandoc -- ^ Document to convert
+ -> IO B.ByteString
+writeODT mbRefOdt opts doc = do
+ let datadir = writerUserDataDir opts
+ refArchive <- liftM toArchive $
+ case mbRefOdt of
+ Just f -> B.readFile f
+ Nothing -> do
+ let defaultODT = getDataFileName "reference.odt" >>= B.readFile
+ case datadir of
+ Nothing -> defaultODT
+ Just d -> do
+ exists <- doesFileExist (d </> "reference.odt")
+ if exists
+ then B.readFile (d </> "reference.odt")
+ else defaultODT
+ -- handle pictures
+ picEntriesRef <- newIORef ([] :: [Entry])
+ let sourceDir = writerSourceDirectory opts
+ doc' <- processWithM (transformPic sourceDir picEntriesRef) doc
+ let newContents = writeOpenDocument opts doc'
+ (TOD epochtime _) <- getClockTime
+ let contentEntry = toEntry "content.xml" epochtime $ fromString newContents
+ picEntries <- readIORef picEntriesRef
+ let archive = foldr addEntryToArchive refArchive (contentEntry : picEntries)
+ return $ fromArchive archive
+
+transformPic :: FilePath -> IORef [Entry] -> Inline -> IO Inline
+transformPic sourceDir entriesRef (Image lab (src,tit)) = do
+ entries <- readIORef entriesRef
+ let newsrc = "Pictures/" ++ show (length entries) ++ takeExtension src
+ catch (readEntry [] (sourceDir </> src) >>= \entry ->
+ modifyIORef entriesRef (entry{ eRelativePath = newsrc } :) >>
+ return (Image lab (newsrc, tit)))
+ (\_ -> return (Emph lab))
+transformPic _ _ x = return x
+
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index f4dfb2aa6..e79f97b33 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -39,10 +39,12 @@ import Text.PrettyPrint.HughesPJ hiding ( Str )
import Control.Monad.State
import Control.Applicative ( (<$>) )
+type Refs = [([Inline], Target)]
+
data WriterState =
WriterState { stNotes :: [[Block]]
- , stLinks :: KeyTable
- , stImages :: KeyTable
+ , stLinks :: Refs
+ , stImages :: Refs
, stHasMath :: Bool
, stOptions :: WriterOptions
}
@@ -65,10 +67,10 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do
body <- blockListToRST blocks
notes <- liftM (reverse . stNotes) get >>= notesToRST
-- note that the notes may contain refs, so we do them first
- refs <- liftM (reverse . stLinks) get >>= keyTableToRST
- pics <- liftM (reverse . stImages) get >>= pictTableToRST
+ refs <- liftM (reverse . stLinks) get >>= refsToRST
+ pics <- liftM (reverse . stImages) get >>= pictRefsToRST
hasMath <- liftM stHasMath get
- let main = render $ body $+$ notes $+$ text "" $+$ refs $+$ pics
+ let main = render $ foldl ($+$) empty $ [body, notes, refs, pics]
let context = writerVariables opts ++
[ ("body", main)
, ("title", render title)
@@ -80,8 +82,8 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do
else return main
-- | Return RST representation of reference key table.
-keyTableToRST :: KeyTable -> State WriterState Doc
-keyTableToRST refs = mapM keyToRST refs >>= return . vcat
+refsToRST :: Refs -> State WriterState Doc
+refsToRST refs = mapM keyToRST refs >>= return . vcat
-- | Return RST representation of a reference key.
keyToRST :: ([Inline], (String, String))
@@ -107,8 +109,8 @@ noteToRST num note = do
return $ marker $$ nest 3 contents
-- | Return RST representation of picture reference table.
-pictTableToRST :: KeyTable -> State WriterState Doc
-pictTableToRST refs = mapM pictToRST refs >>= return . vcat
+pictRefsToRST :: Refs -> State WriterState Doc
+pictRefsToRST refs = mapM pictToRST refs >>= return . vcat
-- | Return RST representation of a picture substitution reference.
pictToRST :: ([Inline], (String, String))
@@ -280,16 +282,16 @@ inlineToRST (Subscript lst) = do
inlineToRST (SmallCaps lst) = inlineListToRST lst
inlineToRST (Quoted SingleQuote lst) = do
contents <- inlineListToRST lst
- return $ char '\'' <> contents <> char '\''
+ return $ char '‘' <> contents <> char '’'
inlineToRST (Quoted DoubleQuote lst) = do
contents <- inlineListToRST lst
- return $ char '"' <> contents <> char '"'
+ return $ char '“' <> contents <> char '”'
inlineToRST (Cite _ lst) =
inlineListToRST lst
-inlineToRST EmDash = return $ text "--"
-inlineToRST EnDash = return $ char '-'
-inlineToRST Apostrophe = return $ char '\''
-inlineToRST Ellipses = return $ text "..."
+inlineToRST EmDash = return $ char '\8212'
+inlineToRST EnDash = return $ char '\8211'
+inlineToRST Apostrophe = return $ char '\8217'
+inlineToRST Ellipses = return $ char '\8230'
inlineToRST (Code str) = return $ text $ "``" ++ str ++ "``"
inlineToRST (Str str) = return $ text $ escapeString str
inlineToRST (Math t str) = do
diff --git a/src/Text/Pandoc/Writers/S5.hs b/src/Text/Pandoc/Writers/S5.hs
deleted file mode 100644
index 1a2639a50..000000000
--- a/src/Text/Pandoc/Writers/S5.hs
+++ /dev/null
@@ -1,136 +0,0 @@
-{-
-Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--}
-
-{- |
- Module : Text.Pandoc.Writers.S5
- Copyright : Copyright (C) 2006-2010 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 (
- -- * Header includes
- s5HeaderIncludes,
- s5Links,
- -- * Functions
- writeS5,
- writeS5String,
- insertS5Structure
- ) where
-import Text.Pandoc.Shared ( WriterOptions, readDataFile )
-import Text.Pandoc.Writers.HTML ( writeHtml, writeHtmlString )
-import Text.Pandoc.Definition
-import Text.XHtml.Strict
-import System.FilePath ( (</>) )
-import Data.List ( intercalate )
-
-s5HeaderIncludes :: Maybe FilePath -> IO String
-s5HeaderIncludes datadir = do
- c <- s5CSS datadir
- j <- s5Javascript datadir
- return $ s5Meta ++ c ++ j
-
-s5Meta :: String
-s5Meta = "<!-- configuration parameters -->\n<meta name=\"defaultView\" content=\"slideshow\" />\n<meta name=\"controlVis\" content=\"hidden\" />\n"
-
-s5Javascript :: Maybe FilePath -> IO String
-s5Javascript datadir = do
- jsCom <- readDataFile datadir $ "s5" </> "default" </> "slides.js.comment"
- jsPacked <- readDataFile datadir $ "s5" </> "default" </> "slides.js.packed"
- return $ "<script type=\"text/javascript\">\n" ++ jsCom ++ jsPacked ++
- "</script>\n"
-
-s5CSS :: Maybe FilePath -> IO String
-s5CSS datadir = do
- s5CoreCSS <- readDataFile datadir $ "s5" </> "default" </> "s5-core.css"
- s5FramingCSS <- readDataFile datadir $ "s5" </> "default" </> "framing.css"
- s5PrettyCSS <- readDataFile datadir $ "s5" </> "default" </> "pretty.css"
- s5OperaCSS <- readDataFile datadir $ "s5" </> "default" </> "opera.css"
- s5OutlineCSS <- readDataFile datadir $ "s5" </> "default" </> "outline.css"
- s5PrintCSS <- readDataFile datadir $ "s5" </> "default" </> "print.css"
- return $ "<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)
- -> [Inline] -- ^ 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 date), (Header 2 title'), (RawHtml "</div>\n</div>\n")]
-
-presentationStart :: Block
-presentationStart = RawHtml "<div class=\"presentation\">\n\n"
-
-presentationEnd :: Block
-presentationEnd = RawHtml "</div>\n"
-
-slideStart :: Block
-slideStart = RawHtml "<div class=\"slide\">\n"
-
-slideEnd :: Block
-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 (intercalate [LineBreak] authors)),
- (Header 4 date), slideEnd]
- else []
- newBlocks = (layoutDiv title' date) ++ presentationStart:firstSlide ++
- slides ++ [presentationEnd]
- in Pandoc (Meta title' authors date) newBlocks
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index 503222754..65e053827 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/src/Text/Pandoc/Writers/Texinfo.hs
@@ -144,6 +144,7 @@ blockToTexinfo (OrderedList (start, numstyle, _) lst) = do
exemplar = case numstyle of
DefaultStyle -> decimal
Decimal -> decimal
+ Example -> decimal
UpperRoman -> decimal -- Roman numerals not supported
LowerRoman -> decimal
UpperAlpha -> upperAlpha