diff options
| -rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 55 |
1 files changed, 28 insertions, 27 deletions
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index d4044d475..75aae55c1 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -342,15 +342,15 @@ writeEPUB opts doc@(Pandoc meta _) = do let tpEntry = mkEntry "title_page.xhtml" tpContent -- handle pictures - picsRef <- newIORef [] - Pandoc _ blocks <- walkM (transformInline opts' picsRef) doc >>= - walkM (transformBlock opts' picsRef) - pics <- readIORef picsRef + mediaRef <- newIORef [] + Pandoc _ blocks <- walkM (transformInline opts' mediaRef) doc >>= + walkM (transformBlock opts' mediaRef) + pics <- readIORef mediaRef let readPicEntry entries (oldsrc, newsrc) = do res <- fetchItem (writerSourceURL opts') oldsrc case res of Left _ -> do - warn $ "Could not find image `" ++ oldsrc ++ "', skipping..." + warn $ "Could not find media `" ++ oldsrc ++ "', skipping..." return entries Right (img,_) -> return $ (toEntry newsrc epochtime $ B.fromChunks . (:[]) $ img) : entries @@ -440,7 +440,7 @@ writeEPUB opts doc@(Pandoc meta _) = do [("id", takeBaseName $ eRelativePath ent), ("href", eRelativePath ent), ("media-type", fromMaybe "application/octet-stream" - $ imageTypeOf $ eRelativePath ent)] $ () + $ mediaTypeOf $ eRelativePath ent)] $ () let fontNode ent = unode "item" ! [("id", takeBaseName $ eRelativePath ent), ("href", eRelativePath ent), @@ -717,54 +717,54 @@ showDateTimeISO8601 :: UTCTime -> String showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ" transformTag :: WriterOptions - -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images + -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media -> Tag String -> IO (Tag String) -transformTag opts picsRef tag@(TagOpen "video" attr) = do +transformTag opts mediaRef tag@(TagOpen name attr) + | name == "video" || name == "source" = do let src = fromAttrib "src" tag let poster = fromAttrib "poster" tag let oldsrc = maybe src (</> src) $ writerSourceURL opts let oldposter = maybe poster (</> poster) $ writerSourceURL opts - newsrc <- modifyPicsRef picsRef oldsrc - newposter <- modifyPicsRef picsRef oldposter + newsrc <- modifyMediaRef mediaRef oldsrc + newposter <- modifyMediaRef mediaRef oldposter let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++ [("src", newsrc) | not (null newsrc)] ++ [("poster", newposter) | not (null newposter)] - return $ TagOpen "video" attr' + return $ TagOpen name attr' transformTag _ _ tag = return tag -modifyPicsRef :: IORef [(FilePath, FilePath)] -> FilePath -> IO FilePath -modifyPicsRef _ "" = return "" -modifyPicsRef picsRef oldsrc = do - pics <- readIORef picsRef - case lookup oldsrc pics of +modifyMediaRef :: IORef [(FilePath, FilePath)] -> FilePath -> IO FilePath +modifyMediaRef _ "" = return "" +modifyMediaRef mediaRef oldsrc = do + media <- readIORef mediaRef + case lookup oldsrc media of Just n -> return n Nothing -> do - let new = "images/img" ++ show (length pics) ++ + let new = "media/file" ++ show (length media) ++ takeExtension oldsrc - modifyIORef picsRef ( (oldsrc, new): ) + modifyIORef mediaRef ( (oldsrc, new): ) return new transformBlock :: WriterOptions - -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images + -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media -> Block -> IO Block -transformBlock opts picsRef (RawBlock fmt raw) +transformBlock opts mediaRef (RawBlock fmt raw) | fmt == Format "html" = do let tags = parseTags raw - -- look for video tags and add poster and src to images - tags' <- mapM (transformTag opts picsRef) tags + tags' <- mapM (transformTag opts mediaRef) tags return $ RawBlock fmt (renderTags tags') transformBlock _ _ b = return b transformInline :: WriterOptions - -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images + -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media -> Inline -> IO Inline -transformInline opts picsRef (Image lab (src,tit)) = do +transformInline opts mediaRef (Image lab (src,tit)) = do let src' = unEscapeString src let oldsrc = maybe src' (</> src) $ writerSourceURL opts - newsrc <- modifyPicsRef picsRef oldsrc + newsrc <- modifyMediaRef mediaRef oldsrc return $ Image lab (newsrc, tit) transformInline opts _ (x@(Math _ _)) | WebTeX _ <- writerHTMLMathMethod opts = do @@ -794,10 +794,11 @@ ppTopElement = ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++) . unEntity . Nothing -> '&':'#':unEntity xs unEntity (x:xs) = x : unEntity xs -imageTypeOf :: FilePath -> Maybe String -imageTypeOf x = case getMimeType x of +mediaTypeOf :: FilePath -> Maybe String +mediaTypeOf x = case getMimeType x of Just y@('i':'m':'a':'g':'e':_) -> Just y Just y@('v':'i':'d':'e':'o':_) -> Just y + Just y@('a':'u':'d':'i':'o':_) -> Just y _ -> Nothing data IdentState = IdentState{ |