diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/EPUB.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 28 |
1 files changed, 23 insertions, 5 deletions
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index d509c6842..1242b948f 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -32,7 +32,7 @@ import Data.IORef import Data.Maybe ( fromMaybe, isNothing ) import Data.List ( findIndices, isPrefixOf ) import System.Environment ( getEnv ) -import System.FilePath ( (</>), (<.>), takeBaseName, takeExtension ) +import System.FilePath ( (</>), (<.>), takeBaseName, takeExtension, takeFileName ) import qualified Data.ByteString.Lazy as B import Data.ByteString.Lazy.UTF8 ( fromString ) import Codec.Archive.Zip @@ -47,13 +47,15 @@ import Text.Pandoc.Writers.HTML import Text.Pandoc.Writers.Markdown ( writePlain ) import Data.Char ( toLower ) import Network.URI ( unEscapeString ) +import Text.Pandoc.MIME (getMimeType) -- | Produce an EPUB file from a Pandoc document. writeEPUB :: Maybe String -- ^ EPUB stylesheet specified at command line + -> [FilePath] -- ^ Paths to fonts to embed -> WriterOptions -- ^ Writer options -> Pandoc -- ^ Document to convert -> IO B.ByteString -writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do +writeEPUB mbStylesheet fonts opts doc@(Pandoc meta _) = do epochtime <- floor `fmap` getPOSIXTime let mkEntry path content = toEntry path epochtime content let opts' = opts{ writerEmailObfuscation = NoObfuscation @@ -101,6 +103,10 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do return e{ eRelativePath = newsrc } picEntries <- mapM readPicEntry pics + -- handle fonts + let mkFontEntry f = mkEntry (takeFileName f) `fmap` B.readFile f + fontEntries <- mapM mkFontEntry fonts + -- body pages let isH1 (Header 1 _) = True isH1 _ = False @@ -137,6 +143,10 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do ("href", eRelativePath ent), ("media-type", fromMaybe "application/octet-stream" $ imageTypeOf $ eRelativePath ent)] $ () + let fontNode ent = unode "item" ! + [("id", takeBaseName $ eRelativePath ent), + ("href", eRelativePath ent), + ("media-type", maybe "" id $ getMimeType $ eRelativePath ent)] $ () let plainify t = removeTrailingSpace $ writePlain opts'{ writerStandalone = False } $ Pandoc meta [Plain t] @@ -156,7 +166,8 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do ,("media-type","text/css")] $ () ] ++ map chapterNode (cpgEntry ++ (tpEntry : chapterEntries)) ++ - map pictureNode (cpicEntry ++ picEntries) + map pictureNode (cpicEntry ++ picEntries) ++ + map fontNode fontEntries , unode "spine" ! [("toc","ncx")] $ case mbCoverImage of Nothing -> [] @@ -210,6 +221,13 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do ,("media-type","application/oebps-package+xml")] $ () let containerEntry = mkEntry "META-INF/container.xml" containerData + -- com.apple.ibooks.display-options.xml + let apple = fromString $ ppTopElement $ + unode "display_options" $ + unode "platform" ! [("name","*")] $ + unode "option" ! [("name","specified-fonts")] $ "true" + let appleEntry = mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple + -- stylesheet stylesheet <- case mbStylesheet of Just s -> return s @@ -218,9 +236,9 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do -- construct archive let archive = foldr addEntryToArchive emptyArchive - (mimetypeEntry : containerEntry : stylesheetEntry : tpEntry : + (mimetypeEntry : containerEntry : appleEntry : stylesheetEntry : tpEntry : contentsEntry : tocEntry : - (picEntries ++ cpicEntry ++ cpgEntry ++ chapterEntries) ) + (picEntries ++ cpicEntry ++ cpgEntry ++ chapterEntries ++ fontEntries) ) return $ fromArchive archive metadataElement :: String -> UUID -> String -> String -> [String] -> String -> Maybe a -> Element |