From e133b26e62a2a8d02ba9bc59d38b133528be13d3 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Tue, 12 Sep 2017 11:45:32 +0200 Subject: [PATCH] fixed figure-attributes --- TODO.md | 1 + src/Text/Pandoc/Util/Filter.hs | 23 ++++++++- src/Text/Pandoc/Util/Filter/Media.hs | 72 +++++++++++++++------------- 3 files changed, 62 insertions(+), 34 deletions(-) diff --git a/TODO.md b/TODO.md index c701049..da2b1f4 100644 --- a/TODO.md +++ b/TODO.md @@ -1,5 +1,6 @@ - fragments in figure-Umgebung + - done - svg per default als img - done - reveal hat speziell html-attribute => herausfinden und in direct-controls rein diff --git a/src/Text/Pandoc/Util/Filter.hs b/src/Text/Pandoc/Util/Filter.hs index 5d8275b..a8f26db 100644 --- a/src/Text/Pandoc/Util/Filter.hs +++ b/src/Text/Pandoc/Util/Filter.hs @@ -1,6 +1,8 @@ module Text.Pandoc.Util.Filter ( attToString + , convertToStyle , revealjsSpecialAttrs + , revealjsRewriteAttr , classToRevealAttr , toHtml , toBlockHtml @@ -45,14 +47,16 @@ attToString (id', classes, kvpairs) = "id=\"" <> id' <> "\" class=\"" <> unword where kvpairs' = convertToStyle ["width","height","transform"] kvpairs +-- | helper function for 'attToString', but can also be used +-- if you want to extract styles from kv-pair convertToStyle :: [String] -> [(String,String)] -> [(String,String)] convertToStyle keys kvpairs = ("style", newstyle):rest where oldstyle = case filter (\(k,_) -> k == "style") kvpairs of [(_,st)] -> st _ -> "" - stylesToAdd = filter (\(k,_) -> k `elem` keys) kvpairs - rest = filter (\(k,_) -> k `notElem` keys) kvpairs + stylesToAdd = filter (\(k,_) -> k `elem` keys) kvpairs + rest = filter (\(k,_) -> k `notElem` ("style":keys)) kvpairs newstyle = concat ((\(k,v) -> k <> ":" <> v <> ";") <$> stylesToAdd) <> oldstyle -- | revealjs has some special attributes that has to be @@ -88,6 +92,21 @@ revealjsSpecialAttrs = classToRevealAttr :: [String] -> ([String],[String]) classToRevealAttr = partition (`elem` revealjsSpecialAttrs) +-- | HTML allows for some attributes (i.e. autoplay) +-- for which revealjs offers a special version +-- (i.e. only autoplaying on active slide). +-- These are the things that get rewritten +revealjsRewriteAttr :: [String] -> [String] +revealjsRewriteAttr = fmap replace + where + replace :: String -> String + replace a = case filter ((==a) . fst) replacements of + [(_,b)] -> b + _ -> a + replacements :: [(String, String)] + replacements = [ ("autoplay", "data-autoplay") + ] + -- | small wrapper around @RawInline (Format "html")@ -- as this is less line-noise in the filters and the -- intent is more clear. diff --git a/src/Text/Pandoc/Util/Filter/Media.hs b/src/Text/Pandoc/Util/Filter/Media.hs index 0865b8f..61ff7c6 100644 --- a/src/Text/Pandoc/Util/Filter/Media.hs +++ b/src/Text/Pandoc/Util/Filter/Media.hs @@ -4,11 +4,12 @@ module Text.Pandoc.Util.Filter.Media (media) where -import Text.Pandoc.JSON import Control.Exception -import Data.Monoid ((<>)) import Data.Char (toLower) +import Data.List (intercalate) +import Data.Monoid ((<>)) import System.FilePath +import Text.Pandoc.JSON import Text.Pandoc.Util.Filter @@ -66,47 +67,31 @@ media (Image (id',att,att') [] (filename,_)) | id' == "audio" || checkExtension filename audioExt = return $ [toHtml $ ""] where - (direct, css) = classToRevealAttr att + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att media (Image (id',att,att') alt (filename,_)) | id' == "audio" || checkExtension filename audioExt - = return $ [toHtml $ "
"] + = return $ [toHtml $ "
attToString(idFilter "audio" id', css, att') <> ">"] <> [toHtml $ "
"] <> alt <> [toHtml $ "
"] where - (direct, css) = classToRevealAttr att + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att --videos media (Image (id', att, att') [] (filename,_)) | id' == "video" || checkExtension filename videoExt = return $ [toHtml $ ""] where - (direct, css) = classToRevealAttr att + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att media (Image (id', att, att') alt (filename,_)) | id' == "video" || checkExtension filename videoExt - = return $ [toHtml $ "
"] - <> [toHtml $ ""] + = return $ [toHtml $ "
attToString (idFilter "video" id',css,att') <> ">"] + <> [toHtml $ ""] <> [toHtml $ "
"] <> alt <> [toHtml $ "
"] where - (direct, css) = classToRevealAttr att ---images -media (Image (id', att, att') [] (filename,_)) - | id' == "img" || checkExtension filename imgExt - = return $ [toHtml $ "
"] - <> [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> ">"] - <> [toHtml $ "
"] - where - (direct, css) = classToRevealAttr att -media (Image (id', att, att') alt (filename,_)) - | id' == "img" || checkExtension filename imgExt - = return $ [toHtml $ "
"] - <> [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> ">"] - <> [toHtml $ "
"] - <> alt - <> [toHtml $ "
"] - where - (direct, css) = classToRevealAttr att + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att + style = filterStyle att' --load svg and dump it in media (Image (id', att, att') [] (filename,_)) | id' == "svg" @@ -117,7 +102,7 @@ media (Image (id', att, att') [] (filename,_)) <> [toHtml $ svg] <> [toHtml $ "
"] where - (direct, css) = classToRevealAttr att + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att media (Image (id', att, att') alt (filename,_)) | id' == "svg" = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "
" <> show fileerror]) $ @@ -129,22 +114,41 @@ media (Image (id', att, att') alt (filename,_)) <> alt <> [toHtml $ "
"] where - (direct, css) = classToRevealAttr att + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att +--images +media (Image (id', att, att') [] (filename,_)) + | id' == "img" || checkExtension filename imgExt + = return $ [toHtml $ "
attToString (idFilter "img" id',css,att') <> ">"] + <> [toHtml $ " unwords direct <> " src=\"" <> filename <> "\" style=\"" <> style <> "\">"] + <> [toHtml $ "
"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att + style = filterStyle att' +media (Image (id', att, att') alt (filename,_)) + | id' == "img" || checkExtension filename imgExt + = return $ [toHtml $ "
attToString (idFilter "img" id',css,att') <> ">"] + <> [toHtml $ " unwords direct <> " src=\"" <> filename <> "\" style=\"" <> style <> "\">"] + <> [toHtml $ "
"] + <> alt + <> [toHtml $ "
"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att + style = filterStyle att' --html-demos etc. as IFrames media (Image (id', att, att') [] (filename,_)) | id' == "demo" || checkExtension filename demoExt = return [toHtml $ ""] where - (direct, css) = classToRevealAttr att + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att media (Image (id', att, att') alt (filename,_)) | id' == "demo" || checkExtension filename demoExt - = return $ [toHtml $ "
"] - <> [toHtml $ ""] + = return $ [toHtml $ "
attToString (idFilter "demo" id', css, att') <> ">"] + <> [toHtml $ ""] <> [toHtml $ "
"] <> alt <> [toHtml $ "
"] where - (direct, css) = classToRevealAttr att + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att -- if not matched media x = return [x] @@ -156,3 +160,7 @@ idFilter a b | a == b = "" | otherwise = b +filterStyle :: [(String,String)] -> String +filterStyle kvpairs = case filter ((== "style") . fst) (convertToStyle ["width","height"] kvpairs) of + [] -> "" + as -> intercalate ";" $ snd <$> as