SelfContained: fixed problem with embedded fonts.
Closes #3629. However, there is still room for improvement. `@import` with following media declaration is not handled. Also `@import` with a simple filename (rather than `url(...)` is not handled.
This commit is contained in:
parent
ca77f0a95e
commit
8d4fbe6a2a
1 changed files with 41 additions and 13 deletions
|
@ -35,6 +35,7 @@ import Codec.Compression.GZip as Gzip
|
|||
import Control.Applicative ((<|>))
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.Trans (lift)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.ByteString.Base64
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
|
@ -95,9 +96,9 @@ convertTags sourceURL (t@(TagOpen "script" as):TagClose "script":ts) =
|
|||
(("src",dataUri) : [(x,y) | (x,y) <- as, x /= "src"]) :
|
||||
TagClose "script" : rest
|
||||
Right (mime, bs)
|
||||
| (mime == "text/javascript" ||
|
||||
mime == "application/javascript" ||
|
||||
mime == "application/x-javascript") &&
|
||||
| ("text/javascript" `isPrefixOf` mime ||
|
||||
"application/javascript" `isPrefixOf` mime ||
|
||||
"application/x-javascript" `isPrefixOf` mime) &&
|
||||
not ("</script" `B.isInfixOf` bs) ->
|
||||
return $
|
||||
TagOpen "script" [("type", typeAttr)|not (null typeAttr)]
|
||||
|
@ -121,11 +122,12 @@ convertTags sourceURL (t@(TagOpen "link" as):ts) =
|
|||
(("href",dataUri) : [(x,y) | (x,y) <- as, x /= "href"]) :
|
||||
rest
|
||||
Right (mime, bs)
|
||||
| mime == "text/css" && not ("</" `B.isInfixOf` bs) -> do
|
||||
| "text/css" `isPrefixOf` mime
|
||||
&& not ("</" `B.isInfixOf` bs) -> do
|
||||
rest <- convertTags sourceURL $
|
||||
dropWhile (==TagClose "link") ts
|
||||
return $
|
||||
TagOpen "style" [("type", "text/css")]
|
||||
TagOpen "style" [("type", mime)]
|
||||
: TagText (toString bs)
|
||||
: TagClose "style"
|
||||
: rest
|
||||
|
@ -149,7 +151,20 @@ cssURLs sourceURL d orig = do
|
|||
parseCSSUrls :: PandocMonad m
|
||||
=> Maybe String -> FilePath -> ParsecT ByteString () m ByteString
|
||||
parseCSSUrls sourceURL d = B.concat <$> P.many
|
||||
(pCSSWhite <|> pCSSComment <|> pCSSUrl sourceURL d <|> pCSSOther)
|
||||
(pCSSWhite <|> pCSSComment <|> pCSSImport sourceURL d <|>
|
||||
pCSSUrl sourceURL d <|> pCSSOther)
|
||||
|
||||
pCSSImport :: PandocMonad m => Maybe String -> FilePath
|
||||
-> ParsecT ByteString () m ByteString
|
||||
pCSSImport sourceURL d = P.try $ do
|
||||
P.string "@import"
|
||||
P.spaces
|
||||
res <- pCSSUrl' sourceURL d
|
||||
P.spaces
|
||||
P.optional $ P.char ';' >> P.spaces
|
||||
case res of
|
||||
Left b -> return $ B.pack "@import " <> b
|
||||
Right (_, b) -> return b
|
||||
|
||||
-- Note: some whitespace in CSS is significant, so we can't collapse it!
|
||||
pCSSWhite :: PandocMonad m => ParsecT ByteString () m ByteString
|
||||
|
@ -170,13 +185,25 @@ pCSSOther = do
|
|||
pCSSUrl :: PandocMonad m
|
||||
=> Maybe String -> FilePath -> ParsecT ByteString () m ByteString
|
||||
pCSSUrl sourceURL d = P.try $ do
|
||||
res <- pCSSUrl' sourceURL d
|
||||
case res of
|
||||
Left b -> return b
|
||||
Right (mt,b) -> do
|
||||
let enc = makeDataURI (mt, b)
|
||||
return (B.pack $ "url(" ++ enc ++ ")")
|
||||
|
||||
pCSSUrl' :: PandocMonad m
|
||||
=> Maybe String -> FilePath
|
||||
-> ParsecT ByteString () m (Either ByteString (MimeType, ByteString))
|
||||
pCSSUrl' sourceURL d = P.try $ do
|
||||
P.string "url("
|
||||
P.spaces
|
||||
quote <- P.option Nothing (Just <$> P.oneOf "\"'")
|
||||
url <- P.manyTill P.anyChar (maybe (P.lookAhead (P.char ')')) P.char quote)
|
||||
P.spaces
|
||||
P.char ')'
|
||||
let fallback = B.pack ("url(" ++ maybe "" (:[]) quote ++ trim url ++
|
||||
let fallback = Left $
|
||||
B.pack ("url(" ++ maybe "" (:[]) quote ++ trim url ++
|
||||
maybe "" (:[]) quote ++ ")")
|
||||
-- pipes are used in URLs provided by Google Code fonts
|
||||
-- but parseURI doesn't like them, so we escape them:
|
||||
|
@ -186,13 +213,14 @@ pCSSUrl sourceURL d = P.try $ do
|
|||
u -> do let url' = if isURI u then u else d </> u
|
||||
res <- lift $ getData sourceURL "" url'
|
||||
case res of
|
||||
Left uri -> return (B.pack $ "url(" ++ uri ++ ")")
|
||||
Left uri -> return $ Left (B.pack $ "url(" ++ uri ++ ")")
|
||||
Right (mt, raw) -> do
|
||||
-- note that the downloaded content may
|
||||
-- note that the downloaded CSS may
|
||||
-- itself contain url(...).
|
||||
raw' <- cssURLs sourceURL d raw
|
||||
let enc = makeDataURI (mt, raw')
|
||||
return (B.pack $ "url(" ++ enc ++ ")")
|
||||
b <- if "text/css" `isPrefixOf` mt
|
||||
then cssURLs sourceURL d raw
|
||||
else return raw
|
||||
return $ Right (mt, b)
|
||||
|
||||
getDataURI :: PandocMonad m => Maybe String -> MimeType -> String -> m String
|
||||
getDataURI sourceURL mimetype src = do
|
||||
|
@ -224,7 +252,7 @@ getData sourceURL mimetype src = do
|
|||
uriQuery = "",
|
||||
uriFragment = "" }
|
||||
_ -> Nothing
|
||||
result <- if mime == "text/css"
|
||||
result <- if "text/css" `isPrefixOf` mime
|
||||
then cssURLs cssSourceURL (takeDirectory src) raw'
|
||||
else return raw'
|
||||
return $ Right (mime, result)
|
||||
|
|
Loading…
Reference in a new issue