EPUB writer: Incorporate files linked in <video> tags.
src and poster will both be incorporated into content.opf and the epub container. This partially address #1170. Still need to do something similar for <audio>.
This commit is contained in:
parent
814af2002e
commit
f6141aa241
2 changed files with 47 additions and 10 deletions
|
@ -246,6 +246,7 @@ mimeTypesList = -- List borrowed from happstack-server.
|
|||
,("lzx","application/x-lzx")
|
||||
,("m3u","audio/mpegurl")
|
||||
,("m4a","audio/mpeg")
|
||||
,("m4v","video/x-m4v")
|
||||
,("maker","application/x-maker")
|
||||
,("man","application/x-troff-man")
|
||||
,("mcif","chemical/x-mmcif")
|
||||
|
|
|
@ -65,6 +65,7 @@ import Prelude hiding (catch)
|
|||
#endif
|
||||
import Control.Exception (catch, SomeException)
|
||||
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
|
||||
import Text.HTML.TagSoup
|
||||
|
||||
-- A Chapter includes a list of blocks and maybe a section
|
||||
-- number offset. Note, some chapters are unnumbered. The section
|
||||
|
@ -342,8 +343,8 @@ writeEPUB opts doc@(Pandoc meta _) = do
|
|||
|
||||
-- handle pictures
|
||||
picsRef <- newIORef []
|
||||
Pandoc _ blocks <- walkM
|
||||
(transformInline opts' picsRef) doc
|
||||
Pandoc _ blocks <- walkM (transformInline opts' picsRef) doc >>=
|
||||
walkM (transformBlock opts' picsRef)
|
||||
pics <- readIORef picsRef
|
||||
let readPicEntry entries (oldsrc, newsrc) = do
|
||||
res <- fetchItem (writerSourceURL opts') oldsrc
|
||||
|
@ -715,21 +716,55 @@ metadataElement version md currentTime =
|
|||
showDateTimeISO8601 :: UTCTime -> String
|
||||
showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
|
||||
|
||||
transformTag :: WriterOptions
|
||||
-> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images
|
||||
-> Tag String
|
||||
-> IO (Tag String)
|
||||
transformTag opts picsRef tag@(TagOpen "video" attr) = 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
|
||||
let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
|
||||
[("src", newsrc) | not (null newsrc)] ++
|
||||
[("poster", newposter) | not (null newposter)]
|
||||
return $ TagOpen "video" 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
|
||||
Just n -> return n
|
||||
Nothing -> do
|
||||
let new = "images/img" ++ show (length pics) ++
|
||||
takeExtension oldsrc
|
||||
modifyIORef picsRef ( (oldsrc, new): )
|
||||
return new
|
||||
|
||||
transformBlock :: WriterOptions
|
||||
-> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images
|
||||
-> Block
|
||||
-> IO Block
|
||||
transformBlock opts picsRef (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
|
||||
return $ RawBlock fmt (renderTags tags')
|
||||
transformBlock _ _ b = return b
|
||||
|
||||
transformInline :: WriterOptions
|
||||
-> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images
|
||||
-> Inline
|
||||
-> IO Inline
|
||||
transformInline opts picsRef (Image lab (src,tit)) = do
|
||||
let src' = unEscapeString src
|
||||
pics <- readIORef picsRef
|
||||
let oldsrc = maybe src' (</> src) $ writerSourceURL opts
|
||||
let ext = takeExtension src'
|
||||
newsrc <- case lookup oldsrc pics of
|
||||
Just n -> return n
|
||||
Nothing -> do
|
||||
let new = "images/img" ++ show (length pics) ++ ext
|
||||
modifyIORef picsRef ( (oldsrc, new): )
|
||||
return new
|
||||
newsrc <- modifyPicsRef picsRef oldsrc
|
||||
return $ Image lab (newsrc, tit)
|
||||
transformInline opts _ (x@(Math _ _))
|
||||
| WebTeX _ <- writerHTMLMathMethod opts = do
|
||||
|
@ -762,6 +797,7 @@ ppTopElement = ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++) . unEntity .
|
|||
imageTypeOf :: FilePath -> Maybe String
|
||||
imageTypeOf x = case getMimeType x of
|
||||
Just y@('i':'m':'a':'g':'e':_) -> Just y
|
||||
Just y@('v':'i':'d':'e':'o':_) -> Just y
|
||||
_ -> Nothing
|
||||
|
||||
data IdentState = IdentState{
|
||||
|
|
Loading…
Reference in a new issue