HTML writer: output video and audio elements

depending on file extension of the image path
This commit is contained in:
mb21 2019-05-11 18:54:43 +02:00
parent 47249b05c4
commit a58304e00e
8 changed files with 52 additions and 37 deletions

View file

@ -55,9 +55,13 @@ reverseMimeTypes = M.fromList $ map (\(k,v) -> (v,k)) mimeTypesList
mimeTypes :: M.Map String MimeType
mimeTypes = M.fromList mimeTypesList
-- | Collection of common mime types.
-- Except for first entry, list borrowed from
-- <https://github.com/Happstack/happstack-server/blob/master/src/Happstack/Server/FileServe/BuildingBlocks.hs happstack-server>
mimeTypesList :: [(String, MimeType)]
mimeTypesList = -- List borrowed from happstack-server.
[("gz","application/x-gzip")
mimeTypesList =
[("cpt","image/x-corelphotopaint")
,("gz","application/x-gzip")
,("cabal","application/x-cabal")
,("%","application/x-trash")
,("323","text/h323")

View file

@ -65,18 +65,21 @@ import Text.Blaze.Internal (preEscapedString, preEscapedText)
#endif
#if MIN_VERSION_blaze_html(0,5,1)
import qualified Text.Blaze.XHtml5 as H5
import qualified Text.Blaze.XHtml5.Attributes as A5
#else
import qualified Text.Blaze.Html5 as H5
import qualified Text.Blaze.Html5.Attributes as A5
#endif
import Control.Monad.Except (throwError)
import Data.Aeson (Value)
import System.FilePath (takeBaseName, takeExtension)
import System.FilePath (takeBaseName)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Text.Blaze.XHtml1.Transitional as H
import qualified Text.Blaze.XHtml1.Transitional.Attributes as A
import Text.Pandoc.Class (PandocMonad, report, runPure)
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.MIME (mediaCategory)
import Text.TeXMath
import Text.XML.Light (elChildren, unode, unqual)
import qualified Text.XML.Light as XML
@ -665,18 +668,6 @@ dimensionsToAttrList attr = consolidateStyles $ go Width ++ go Height
(Just x) -> [("style", show dir ++ ":" ++ show x)]
Nothing -> []
imageExts :: [String]
imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf",
"gif", "ico", "ief", "jng", "jpg", "jpeg", "nef", "orf", "pat", "pbm",
"pcx", "pgm", "png", "pnm", "ppm", "psd", "ras", "rgb", "svg", "tiff",
"wbmp", "xbm", "xpm", "xwd" ]
treatAsImage :: FilePath -> Bool
treatAsImage fp =
let path = maybe fp uriPath (parseURIReference fp)
ext = map toLower $ drop 1 $ takeExtension path
in null ext || ext `elem` imageExts
figure :: PandocMonad m
=> WriterOptions -> Attr -> [Inline] -> (String, String)
-> StateT WriterState m Html
@ -1135,8 +1126,8 @@ inlineToHtml opts inline = do
return $ if null tit
then link'
else link' ! A.title (toValue tit)
(Image attr txt (s,tit)) | treatAsImage s -> do
let alternate' = stringify txt
(Image attr txt (s,tit)) -> do
let alternate = stringify txt
slideVariant <- gets stSlideVariant
let isReveal = slideVariant == RevealJsSlides
attrs <- imgAttrsToHtml opts attr
@ -1146,22 +1137,23 @@ inlineToHtml opts inline = do
then customAttribute "data-src" $ toValue s
else A.src $ toValue s) :
[A.title $ toValue tit | not (null tit)] ++
[A.alt $ toValue alternate' | not (null txt)] ++
attrs
let tag = if html5 then H5.img else H.img
return $ foldl (!) tag attributes
-- note: null title included, as in Markdown.pl
(Image attr _ (s,tit)) -> do
slideVariant <- gets stSlideVariant
let isReveal = slideVariant == RevealJsSlides
attrs <- imgAttrsToHtml opts attr
let attributes =
(if isReveal
then customAttribute "data-src" $ toValue s
else A.src $ toValue s) :
[A.title $ toValue tit | not (null tit)] ++
attrs
return $ foldl (!) H5.embed attributes
imageTag = (if html5 then H5.img else H.img
, [A.alt $ toValue alternate | not (null txt)] )
mediaTag tg fallbackTxt =
let linkTxt = if null txt
then fallbackTxt
else alternate
in (tg $ H.a ! A.href (toValue s) $ toHtml linkTxt
, [A5.controls ""] )
normSrc = maybe s uriPath (parseURIReference s)
(tag, specAttrs) = case mediaCategory normSrc of
Just "image" -> imageTag
Just "video" -> mediaTag H5.video "Video"
Just "audio" -> mediaTag H5.audio "Audio"
Just _ -> (H5.embed, [])
_ -> imageTag
return $ foldl (!) tag $ attributes ++ specAttrs
-- note: null title included, as in Markdown.pl
(Note contents) -> do
notes <- gets stNotes

View file

@ -7,5 +7,5 @@
:scale: 300 %
:alt: alternate text
^D
<p><img src="http://url.to.image/foo.png" alt="alternate text" class="align-left" width="600" height="300" /></p>
<p><img src="http://url.to.image/foo.png" class="align-left" width="600" height="300" alt="alternate text" /></p>
```

View file

@ -2,7 +2,7 @@
% pandoc -fmarkdown-implicit_figures
![image](lalune.jpg){height=2em}
^D
<p><img src="lalune.jpg" alt="image" style="height:2em" /></p>
<p><img src="lalune.jpg" style="height:2em" alt="image" /></p>
```
```
% pandoc -fmarkdown-implicit_figures -t latex

View file

@ -4,5 +4,5 @@ pandoc -f markdown-implicit_figures
[image]: http://example.com/image.jpg {height=35mm}
^D
<p><img src="http://example.com/image.jpg" alt="image" style="height:35mm" /></p>
<p><img src="http://example.com/image.jpg" style="height:35mm" alt="image" /></p>
```

View file

@ -3,6 +3,6 @@
![Caption](img.png){#img:1}
^D
<figure>
<img src="img.png" alt="" id="img:1" /><figcaption>Caption</figcaption>
<img src="img.png" id="img:1" alt="" /><figcaption>Caption</figcaption>
</figure>
```

View file

@ -5,7 +5,7 @@
## Header 2
^D
<figure>
<img src="./my-figure.jpg" alt="" width="500" /><figcaption>My caption</figcaption>
<img src="./my-figure.jpg" width="500" alt="" /><figcaption>My caption</figcaption>
</figure>
Header 2

View file

@ -0,0 +1,19 @@
```
% pandoc -f markdown-implicit_figures -t html
![](./test.mp4)
![Your browser does not support video.](foo/test.webm){width=300}
![](test.mp3)
![](./test.pdf)
![](./test.jpg)
^D
<p><video src="./test.mp4" controls=""><a href="./test.mp4">Video</a></video></p>
<p><video src="foo/test.webm" width="300" controls=""><a href="foo/test.webm">Your browser does not support video.</a></video></p>
<p><audio src="test.mp3" controls=""><a href="test.mp3">Audio</a></audio></p>
<p><embed src="./test.pdf" /></p>
<p><img src="./test.jpg" /></p>
```