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.

1 files changed, 41 insertions, 13 deletions

diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs
index c0a12adf2..e9a91b690 100644
--- a/src/Text/Pandoc/SelfContained.hs
+++ b/src/Text/Pandoc/SelfContained.hs
@@ -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)