@@ -32,7 +32,7 @@ import Data.IORef
3232import Data.Maybe ( fromMaybe, isNothing )
3333import Data.List ( findIndices, isPrefixOf )
3434import System.Environment ( getEnv )
35−import System.FilePath ( (</>), (<.>), takeBaseName, takeExtension )
35+import System.FilePath ( (</>), (<.>), takeBaseName, takeExtension, takeFileName )
3636import qualified Data.ByteString.Lazy as B
3737import Data.ByteString.Lazy.UTF8 ( fromString )
3838import Codec.Archive.Zip
@@ -47,13 +47,15 @@ import Text.Pandoc.Writers.HTML
4747import Text.Pandoc.Writers.Markdown ( writePlain )
4848import Data.Char ( toLower )
4949import Network.URI ( unEscapeString )
50+import Text.Pandoc.MIME (getMimeType)
5051
5152-- | Produce an EPUB file from a Pandoc document.
5253writeEPUB :: Maybe String -- ^ EPUB stylesheet specified at command line
54+ -> [FilePath] -- ^ Paths to fonts to embed
5355 -> WriterOptions -- ^ Writer options
5456 -> Pandoc -- ^ Document to convert
5557 -> IO B.ByteString
56−writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do
58+writeEPUB mbStylesheet fonts opts doc@(Pandoc meta _) = do
5759 epochtime <- floor `fmap` getPOSIXTime
5860 let mkEntry path content = toEntry path epochtime content
5961 let opts' = opts{ writerEmailObfuscation = NoObfuscation
@@ -101,6 +103,10 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do
101103 return e{ eRelativePath = newsrc }
102104 picEntries <- mapM readPicEntry pics
103105
106+ -- handle fonts
107+ let mkFontEntry f = mkEntry (takeFileName f) `fmap` B.readFile f
108+ fontEntries <- mapM mkFontEntry fonts
109+
104110 -- body pages
105111 let isH1 (Header 1 _) = True
106112 isH1 _ = False
@@ -137,6 +143,10 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do
137143 ("href", eRelativePath ent),
138144 ("media-type", fromMaybe "application/octet-stream"
139145 $ imageTypeOf $ eRelativePath ent)] $ ()
146+ let fontNode ent = unode "item" !
147+ [("id", takeBaseName $ eRelativePath ent),
148+ ("href", eRelativePath ent),
149+ ("media-type", maybe "" id $ getMimeType $ eRelativePath ent)] $ ()
140150 let plainify t = removeTrailingSpace $
141151 writePlain opts'{ writerStandalone = False } $
142152 Pandoc meta [Plain t]
@@ -156,7 +166,8 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do
156166 ,("media-type","text/css")] $ ()
157167 ] ++
158168 map chapterNode (cpgEntry ++ (tpEntry : chapterEntries)) ++
159− map pictureNode (cpicEntry ++ picEntries)
169+ map pictureNode (cpicEntry ++ picEntries) ++
170+ map fontNode fontEntries
160171 , unode "spine" ! [("toc","ncx")] $
161172 case mbCoverImage of
162173 Nothing -> []
@@ -210,6 +221,13 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do
210221 ,("media-type","application/oebps-package+xml")] $ ()
211222 let containerEntry = mkEntry "META-INF/container.xml" containerData
212223
224+ -- com.apple.ibooks.display-options.xml
225+ let apple = fromString $ ppTopElement $
226+ unode "display_options" $
227+ unode "platform" ! [("name","*")] $
228+ unode "option" ! [("name","specified-fonts")] $ "true"
229+ let appleEntry = mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple
230+
213231 -- stylesheet
214232 stylesheet <- case mbStylesheet of
215233 Just s -> return s
@@ -218,9 +236,9 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do
218236
219237 -- construct archive
220238 let archive = foldr addEntryToArchive emptyArchive
221− (mimetypeEntry : containerEntry : stylesheetEntry : tpEntry :
239+ (mimetypeEntry : containerEntry : appleEntry : stylesheetEntry : tpEntry :
222240 contentsEntry : tocEntry :
223− (picEntries ++ cpicEntry ++ cpgEntry ++ chapterEntries) )
241+ (picEntries ++ cpicEntry ++ cpgEntry ++ chapterEntries ++ fontEntries) )
224242 return $ fromArchive archive
225243
226244metadataElement :: String -> UUID -> String -> String -> [String] -> String -> Maybe a -> Element