diff options
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/MIME.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 28 |
2 files changed, 25 insertions, 5 deletions
diff --git a/src/Text/Pandoc/MIME.hs b/src/Text/Pandoc/MIME.hs index db9263b4c..d3df2f2e1 100644 --- a/src/Text/Pandoc/MIME.hs +++ b/src/Text/Pandoc/MIME.hs @@ -295,6 +295,7 @@ getMimeType f = M.lookup (map toLower $ drop 1 $ takeExtension f) mimeTypes ,("oth","application/vnd.oasis.opendocument.text-web") ,("otp","application/vnd.oasis.opendocument.presentation-template") ,("ots","application/vnd.oasis.opendocument.spreadsheet-template") + ,("otf","application/x-font-opentype") ,("ott","application/vnd.oasis.opendocument.text-template") ,("oza","application/x-oz-application") ,("p","text/x-pascal") @@ -428,6 +429,7 @@ getMimeType f = M.lookup (map toLower $ drop 1 $ takeExtension f) mimeTypes ,("ts","text/texmacs") ,("tsp","application/dsptype") ,("tsv","text/tab-separated-values") + ,("ttf","application/x-font-truetype") ,("txt","text/plain") ,("udeb","application/x-debian-package") ,("uls","text/iuls") 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 |