1 files changed, 44 insertions(+), 8 deletions(-)

M src/Input.hs

@@ 5,6 5,7 @@ module Input(fetchDocument, pageForText, applyCSScharset) where
 
 import           Data.Text.Lazy (fromStrict)
 import qualified Data.Text as Txt
+import qualified Data.Text.IO as Txt
 import           Data.Text.Encoding
 import qualified Data.Text.Lazy as LTxt
 import qualified Data.ByteString.Lazy as B


@@ 74,14 75,35 @@ parseDocument _ _ (uri, 't':'e':'x':'t':'/':'g':'e':'m':'i':'n':'i':';':'l':'a':
     pageForDoc uri $ parseGemini (Just lang) $ utf8' bytes
 parseDocument _ _ (uri, "text/gemini", Left text) = pageForDoc uri $ parseGemini Nothing text
 parseDocument _ _ (uri, "text/gemini", Right bytes) = pageForDoc uri $ parseGemini Nothing $ utf8' bytes
-parseDocument referer _ (uri, "text/css", Left text) = return referer {
-        Types.url = uri,
-        css = parseForURL (conditionalStyles uri "document") uri text
+parseDocument referer _ (uri, "text/css", Left text)
+  | uri'@URI {uriAuthority = Just host} <- Types.url referer = do
+    -- Save this per-domain setting
+    dir <- (</> "domain") <$> getXdgDirectory XdgConfig "rhapsode"
+    createDirectoryIfMissing True dir
+    let header = Txt.pack (uriToString id uri "") `Txt.append` "\n" 
+    Txt.writeFile (dir </> uriRegName host) $ Txt.append header text
+
+    return referer {
+        css = parseForURL (conditionalStyles uri' "document") uri text
+    }
+  | otherwise = return referer {
+        css = parseForURL (conditionalStyles (Types.url referer) "document") uri text
+    }
+parseDocument referer _ (uri, "text/css", Right bytes)
+  | uri'@URI {uriAuthority = Just host} <- Types.url referer = do
+    -- Save this per-domain setting
+    dir <- (</> "domain") <$> getXdgDirectory XdgConfig "rhapsode"
+    createDirectoryIfMissing True dir
+    let header = Txt.pack (uriToString id uri "") `Txt.append` "\n" 
+    Txt.writeFile (dir </> uriRegName host) $ Txt.append header text
+
+    return referer {
+        css = parseForURL (conditionalStyles uri' "document") uri text
     }
-parseDocument referer _ (uri, "text/css", Right bytes) = return referer {
-        Types.url = uri,
-        css = parseForURL (conditionalStyles uri "document") uri text
-    } where text = applyCSScharset (map Txt.unpack charsets) $ B.toStrict bytes
+  | otherwise = return referer {
+        css = parseForURL (conditionalStyles (Types.url referer) "document") uri text
+    }
+  where text = applyCSScharset (map Txt.unpack charsets) $ B.toStrict bytes
 
 parseDocument ref sess (uri, mime, body) | mime' /= mime = parseDocument ref sess (uri, mime', body)
     where mime' = takeWhile (/= ';') mime


@@ 111,8 133,22 @@ pageForText uri txt = pageForDoc uri XML.Document {
     }
 
 pageForDoc uri doc = do
+    -- See if the user has configured an alternate stylesheet for this domain.
+    let authorStyle = return $ html2css doc uri
+    styles <- case uriAuthority uri of
+        Nothing -> authorStyle
+        Just host -> do
+            dir <- getXdgDirectory XdgConfig "rhapsode"
+            let path = dir </> "domain" </> uriRegName host
+            hasAltStyle <- doesFileExist path
+            if not hasAltStyle then authorStyle else do
+                conf <- Txt.readFile path
+                let (uriTxt, css) = Txt.break (== '\n') conf
+                let uri' = fromMaybe nullURI $ parseAbsoluteURI $ Txt.unpack uriTxt
+                return $ parseForURL (conditionalStyles uri "document") uri' css
+
     hist <- newEmptyMVar
-    return Page {Types.url = uri, html = doc, css = html2css doc uri,
+    return Page {Types.url = uri, html = doc, css = styles,
         -- These fields are all blank, to be filled in later by logHistory & parseDocument'
         pageTitle = "", pageMIME = "", apps = [],
         backStack = [], forwardStack = [], visitedURLs = hist}