@@ -65,6 +65,7 @@ import Prelude hiding (catch)
6565#endif
6666import Control.Exception (catch, SomeException)
6767import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
68+import Text.HTML.TagSoup
6869
6970-- A Chapter includes a list of blocks and maybe a section
7071-- number offset. Note, some chapters are unnumbered. The section
@@ -342,8 +343,8 @@ writeEPUB opts doc@(Pandoc meta _) = do
342343
343344 -- handle pictures
344345 picsRef <- newIORef []
345− Pandoc _ blocks <- walkM
346− (transformInline opts' picsRef) doc
346+ Pandoc _ blocks <- walkM (transformInline opts' picsRef) doc >>=
347+ walkM (transformBlock opts' picsRef)
347348 pics <- readIORef picsRef
348349 let readPicEntry entries (oldsrc, newsrc) = do
349350 res <- fetchItem (writerSourceURL opts') oldsrc
@@ -715,21 +716,55 @@ metadataElement version md currentTime =
715716showDateTimeISO8601 :: UTCTime -> String
716717showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
717718
719+transformTag :: WriterOptions
720+ -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images
721+ -> Tag String
722+ -> IO (Tag String)
723+transformTag opts picsRef tag@(TagOpen "video" attr) = do
724+ let src = fromAttrib "src" tag
725+ let poster = fromAttrib "poster" tag
726+ let oldsrc = maybe src (</> src) $ writerSourceURL opts
727+ let oldposter = maybe poster (</> poster) $ writerSourceURL opts
728+ newsrc <- modifyPicsRef picsRef oldsrc
729+ newposter <- modifyPicsRef picsRef oldposter
730+ let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
731+ [("src", newsrc) | not (null newsrc)] ++
732+ [("poster", newposter) | not (null newposter)]
733+ return $ TagOpen "video" attr'
734+transformTag _ _ tag = return tag
735+
736+modifyPicsRef :: IORef [(FilePath, FilePath)] -> FilePath -> IO FilePath
737+modifyPicsRef _ "" = return ""
738+modifyPicsRef picsRef oldsrc = do
739+ pics <- readIORef picsRef
740+ case lookup oldsrc pics of
741+ Just n -> return n
742+ Nothing -> do
743+ let new = "images/img" ++ show (length pics) ++
744+ takeExtension oldsrc
745+ modifyIORef picsRef ( (oldsrc, new): )
746+ return new
747+
748+transformBlock :: WriterOptions
749+ -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images
750+ -> Block
751+ -> IO Block
752+transformBlock opts picsRef (RawBlock fmt raw)
753+ | fmt == Format "html" = do
754+ let tags = parseTags raw
755+ -- look for video tags and add poster and src to images
756+ tags' <- mapM (transformTag opts picsRef) tags
757+ return $ RawBlock fmt (renderTags tags')
758+transformBlock _ _ b = return b
759+
718760transformInline :: WriterOptions
719761 -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images
720762 -> Inline
721763 -> IO Inline
722764transformInline opts picsRef (Image lab (src,tit)) = do
723765 let src' = unEscapeString src
724− pics <- readIORef picsRef
725766 let oldsrc = maybe src' (</> src) $ writerSourceURL opts
726− let ext = takeExtension src'
727− newsrc <- case lookup oldsrc pics of
728− Just n -> return n
729− Nothing -> do
730− let new = "images/img" ++ show (length pics) ++ ext
731− modifyIORef picsRef ( (oldsrc, new): )
732− return new
767+ newsrc <- modifyPicsRef picsRef oldsrc
733768 return $ Image lab (newsrc, tit)
734769transformInline opts _ (x@(Math _ _))
735770 | WebTeX _ <- writerHTMLMathMethod opts = do
@@ -762,6 +797,7 @@ ppTopElement = ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++) . unEntity .
762797imageTypeOf :: FilePath -> Maybe String
763798imageTypeOf x = case getMimeType x of
764799 Just y@('i':'m':'a':'g':'e':_) -> Just y
800+ Just y@('v':'i':'d':'e':'o':_) -> Just y
765801 _ -> Nothing
766802
767803data IdentState = IdentState{