@@ -40,20 +40,16 @@ import System.FilePath (takeExtension, takeDirectory, (</>))
4040import Data.Char (toLower, isAscii, isAlphaNum)
4141import Codec.Compression.GZip as Gzip
4242import qualified Data.ByteString.Lazy as L
43−import Text.Pandoc.Shared (renderTags', err, fetchItem')
43+import Text.Pandoc.Shared (renderTags', err, fetchItem', warn, trim)
4444import Text.Pandoc.MediaBag (MediaBag)
4545import Text.Pandoc.MIME (MimeType)
4646import Text.Pandoc.UTF8 (toString)
4747import Text.Pandoc.Options (WriterOptions(..))
4848import Data.List (isPrefixOf)
4949import Control.Applicative
50−import Text.CSS.Parse (parseNestedBlocks, NestedBlock(..))
51−import Text.CSS.Render (renderNestedBlocks)
52−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
53−import qualified Data.Text as T
54−import Data.Text (Text)
55−import Data.Text.Lazy (toStrict)
56−import Data.Text.Lazy.Builder (toLazyText)
50+import Text.Parsec (runParserT, ParsecT)
51+import qualified Text.Parsec as P
52+import Control.Monad.Trans (lift)
5753
5854isOk :: Char -> Bool
5955isOk c = isAscii c && isAlphaNum c
@@ -94,40 +90,52 @@ convertTag media sourceURL t@(TagOpen "link" as) =
9490 return $ TagOpen "link" (("href",enc) : [(x,y) | (x,y) <- as, x /= "href"])
9591convertTag _ _ t = return t
9692
97−-- NOTE: This is really crude, it doesn't respect CSS comments.
9893cssURLs :: MediaBag -> Maybe String -> FilePath -> ByteString
9994 -> IO ByteString
10095cssURLs media sourceURL d orig = do
101− case parseNestedBlocks (decodeUtf8 orig) of
102− Left _err -> return orig
103− Right bs -> (encodeUtf8 . toStrict . toLazyText . renderNestedBlocks)
104− <$> mapM (handleCSSUrls media sourceURL d) bs
105−
106−handleCSSUrls :: MediaBag -> Maybe String -> FilePath -> NestedBlock
107− -> IO NestedBlock
108−handleCSSUrls media sourceURL d (NestedBlock t bs) =
109− NestedBlock t <$> mapM (handleCSSUrls media sourceURL d) bs
110−handleCSSUrls media sourceURL d (LeafBlock (selector, attrs)) = do
111− attrs' <- mapM (handleCSSAttr media sourceURL d) attrs
112− return (LeafBlock (selector, attrs'))
113−
114−handleCSSAttr :: MediaBag -> Maybe String -> FilePath -> (Text, Text)
115− -> IO (Text, Text)
116−handleCSSAttr media sourceURL d (key, val) =
117− if "url(" `T.isPrefixOf` val
118− then do
119− let url = T.unpack $ dropParens $ T.drop 3 val
120− case url of
121− '#':_ -> return (key, val)
122− 'd':'a':'t':'a':':':_ -> return (key, val)
123− _ -> do
124− let url' = if isURI url then url else d </> url
125− enc <- getDataURI media sourceURL "" url'
126− return (key, T.pack enc)
127− else return (key, val)
128−
129−dropParens :: Text -> Text
130−dropParens = T.dropAround (`elem` ['(',')','"','\'',' ','\t','\n','\r'])
96+ res <- runParserT (parseCSSUrls media sourceURL d) () "css" orig
97+ case res of
98+ Left e -> warn ("Could not parse CSS: " ++ show e) >> return orig
99+ Right bs -> return bs
100+
101+parseCSSUrls :: MediaBag -> Maybe String -> FilePath
102+ -> ParsecT ByteString () IO ByteString
103+parseCSSUrls media sourceURL d = B.concat <$> P.many
104+ (pCSSWhite <|> pCSSComment <|> pCSSUrl media sourceURL d <|> pCSSOther)
105+
106+pCSSWhite :: ParsecT ByteString () IO ByteString
107+pCSSWhite = P.space >> P.spaces >> return B.empty
108+
109+pCSSComment :: ParsecT ByteString () IO ByteString
110+pCSSComment = P.try $ do
111+ P.string "/*"
112+ P.manyTill P.anyChar (P.try (P.string "*/"))
113+ return B.empty
114+
115+pCSSOther :: ParsecT ByteString () IO ByteString
116+pCSSOther = do
117+ (B.pack <$> P.many1 (P.noneOf "u/ \n\r\t")) <|>
118+ (B.singleton <$> P.char 'u') <|>
119+ (B.singleton <$> P.char '/')
120+
121+pCSSUrl :: MediaBag -> Maybe String -> FilePath
122+ -> ParsecT ByteString () IO ByteString
123+pCSSUrl media sourceURL d = P.try $ do
124+ P.string "url("
125+ P.spaces
126+ quote <- P.option Nothing (Just <$> P.oneOf "\"'")
127+ url <- P.manyTill P.anyChar (maybe (P.lookAhead (P.char ')')) P.char quote)
128+ P.spaces
129+ P.char ')'
130+ let fallback = B.pack ("url(" ++ maybe "" (:[]) quote ++ trim url ++
131+ maybe "" (:[]) quote ++ ")")
132+ case trim url of
133+ '#':_ -> return fallback
134+ 'd':'a':'t':'a':':':_ -> return fallback
135+ u -> do let url' = if isURI u then u else d </> u
136+ enc <- lift $ getDataURI media sourceURL "" url'
137+ return (B.pack enc)
138+
131139
132140getDataURI :: MediaBag -> Maybe String -> MimeType -> String
133141 -> IO String