Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Added a MIME-disposition configuration.

  • Loading branch information...
commit 0e1dee459943809825fa56330ab6517e8992c425 1 parent 6afd900
koral authored
View
15 Hbro/Config.hs
@@ -17,6 +17,8 @@ import Data.ByteString.Char8 (pack)
import Data.Foldable
import Graphics.UI.Gtk.General.General
+import Graphics.UI.Gtk.WebKit.NetworkRequest
+import Graphics.UI.Gtk.WebKit.WebPolicyDecision
import Graphics.UI.Gtk.WebKit.WebView hiding(webViewGetUri, webViewLoadUri)
import Prelude hiding(mapM_)
@@ -43,12 +45,23 @@ defaultConfig directories = Config {
mSetup = const (return () :: IO ()),
mCommands = defaultCommandsList,
mHooks = defaultHooks,
+ mMIMEDisposition = defaultMIMEDisposition,
mError = Nothing
}
+-- | Display content if webview can show the given MIME type, otherwise download it.
+-- /!\ NetworkRequest's Haskell binding is missing the function "webkit_network_request_get_message", which makes it rather useless...
+defaultMIMEDisposition :: Environment -> NetworkRequest -> String -> WebPolicyDecision -> IO ()
+defaultMIMEDisposition env _request mimetype policyDecision = do
+ canShow <- webViewCanShowMimeType ((mWebView . mGUI) env) mimetype
+
+ case (canShow, mimetype) of
+ (True, _) -> webPolicyDecisionUse policyDecision
+ _ -> webPolicyDecisionDownload policyDecision
+
-- | Pack of default hooks
defaultHooks :: Hooks
-defaultHooks = Hooks defaultNewWindowHook (\_ _ _ _ -> return ())
+defaultHooks = Hooks (\_ _ _ _ -> return ()) defaultNewWindowHook
-- | Default behavior when a new window is requested: load URI in current window.
defaultNewWindowHook :: Environment -> URI -> IO WebView
View
2  Hbro/Core.hs
@@ -32,7 +32,7 @@ import System.Console.CmdArgs
-- {{{ Browsing
-- | Load homepage (set from configuration file).
goHome :: WebView -> Config -> IO ()
-goHome webView config@Config{ mHomePage = homeURI } = forM_ (parseURIReference homeURI) $ webViewLoadUri webView
+goHome webView _config@Config{ mHomePage = homeURI } = forM_ (parseURIReference homeURI) $ webViewLoadUri webView
-- }}}
-- {{{ Scrolling
View
9 Hbro/Hbro.hs
@@ -130,7 +130,7 @@ realMain (config, options) = do
ZMQ.withContext 1 $ realMain' config options gui
realMain' :: Config -> CliOptions -> GUI -> ZMQ.Context -> IO ()
-realMain' config options gui@GUI {mWebView = webView, mWindow = window} context = let
+realMain' config options gui@GUI {mWebView = webView} context = let
environment = Environment options config gui context
setup = mSetup config
socketDir = mSocketDir config
@@ -160,9 +160,14 @@ realMain' config options gui@GUI {mWebView = webView, mWindow = window} context
_ -> return ()
return False
--- Setup key handler
+-- Bind key hook
rec i <- after webView keyPressEvent $ keyEventHandler keyEventCallback i webView
+-- Setup MIME disposition
+ void $ on webView mimeTypePolicyDecisionRequested $ \_frame request mimetype decision -> do
+ (mMIMEDisposition config) environment request mimetype decision
+ return True
+
-- Load homepage
startURI <- case (mURI options) of
Just uri -> do
View
2  Hbro/Keys.hs
@@ -28,7 +28,7 @@ import Graphics.UI.Gtk.WebKit.WebView
import Prelude hiding(mapM_)
-import System.Console.CmdArgs (whenLoud, whenNormal)
+import System.Console.CmdArgs (whenLoud)
import System.Glib.Signals
-- }}}
View
3  Hbro/Prompt.hs
@@ -21,7 +21,7 @@ import Graphics.UI.Gtk.WebKit.WebView hiding(webViewLoadUri)
import Prelude hiding(mapM_)
-import System.Console.CmdArgs (whenNormal)
+import System.Console.CmdArgs (whenLoud)
import System.Glib.Signals
-- }}}
@@ -60,6 +60,7 @@ init builder webView = do
open :: PromptBar -> String -> String -> IO ()
open _promptBar@PromptBar {mBox = promptBox, mDescription = description, mEntry = entry} newDescription defaultText = do
+ whenLoud $ putStrLn "Opening prompt."
labelSetText description newDescription
entrySetText entry defaultText
View
7 Hbro/Types.hs
@@ -13,6 +13,8 @@ import Graphics.UI.Gtk.Entry.Entry
import Graphics.UI.Gtk.Layout.HBox
import Graphics.UI.Gtk.Gdk.EventM
import Graphics.UI.Gtk.Scrolling.ScrolledWindow
+import Graphics.UI.Gtk.WebKit.NetworkRequest
+import Graphics.UI.Gtk.WebKit.WebPolicyDecision
import Graphics.UI.Gtk.WebKit.WebSettings
import Graphics.UI.Gtk.WebKit.WebView
import Graphics.UI.Gtk.Windows.Window
@@ -57,6 +59,7 @@ data Config = {-forall a.-} Config {
mSetup :: Environment -> IO (), -- ^ Custom startup instructions
mCommands :: CommandsList, -- ^ Custom commands to use with IPC sockets
mHooks :: Hooks,
+ mMIMEDisposition :: Environment -> NetworkRequest -> String -> WebPolicyDecision -> IO (),
mError :: Maybe String -- ^ Error
--mCustom :: a
}
@@ -71,8 +74,8 @@ data CommonDirectories = CommonDirectories {
-- | Set of functions to be triggered when some events occur
data Hooks = Hooks {
- mNewWindow :: Environment -> URI -> IO WebView, -- ^ On a new window request
- mDownload :: Environment -> URI -> String -> Int -> IO () -- ^ On a download request
+ mDownload :: Environment -> URI -> String -> Int -> IO (), -- ^ On a download request
+ mNewWindow :: Environment -> URI -> IO WebView -- ^ On a new window request
}
-- | Graphical elements
Please sign in to comment.
Something went wrong with that request. Please try again.