diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 283 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 5 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Man.hs | 5 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 25 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Native.hs | 86 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/ODT.hs | 83 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 30 |
8 files changed, 489 insertions, 30 deletions
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..08cd18ad0 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -285,9 +285,12 @@ 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 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..c74cd81f9 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 ) @@ -301,9 +302,9 @@ inlineToMan _ Ellipses = return $ text "\\&..." inlineToMan _ (Code str) = return $ text $ "\\f[B]" ++ 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 29253ec8e..d6cd2a296 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -32,7 +32,8 @@ 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 ( runParser, GenParser ) import Data.List ( group, isPrefixOf, find, intersperse, transpose ) @@ -40,7 +41,7 @@ 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,7 +95,7 @@ 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') + refs' <- refsToMarkdown opts (reverse $ stRefs st') let main = render $ body $+$ text "" $+$ notes' $+$ text "" $+$ refs' let context = writerVariables opts ++ [ ("toc", render toc) @@ -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 @@ -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..14566252c 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,8 +67,8 @@ 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 context = writerVariables opts ++ @@ -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 |