hbro 0.4.2 → 0.4.3

raw patch · 4 files changed

+43/−22 lines, 4 files

Files

• Hbro/Core.hs +14/−14
• Hbro/Util.hs +20/−0
• examples/Main.hs +8/−7
• hbro.cabal +1/−1

@@ -9,14 +9,15 @@ import qualified Config.Dyre as Dyre import Control.Concurrent import Control.Monad.Trans(liftIO)-import Data.Map+import qualified Data.Map as Map+import qualified Data.Set as Set import Graphics.UI.Gtk  import Graphics.UI.Gtk.WebKit.WebView import Graphics.UI.Gtk.WebKit.WebFrame import Graphics.UI.Gtk.WebKit.WebInspector import Graphics.UI.Gtk.WebKit.WebSettings import Network.URL-import Prelude hiding (lookup)+import Prelude import System.Environment import System.Posix.Process -- }}}@@ -26,17 +27,16 @@     mGUI            :: GUI } +type KeyBindingsList = [(([Modifier], String), (GUI -> IO ()))]+ data Configuration = Configuration {-    mHomePage       :: String,                                  -- ^ Startup page -    mSocketDir      :: String,                                  -- ^ Path to socket directory (/tmp for example)-    mKeyBindings    :: [(([Modifier], String), GUI -> IO ())],  -- ^ List of keybindings-    mWebSettings    :: IO WebSettings,                          -- ^ Web settings-    mCustomizations :: GUI -> IO (),                            -- ^ Custom callbacks-    mError          :: Maybe String                             -- ^ Error+    mHomePage       :: String,          -- ^ Startup page +    mSocketDir      :: String,          -- ^ Path to socket directory (/tmp for example)+    mKeyBindings    :: KeyBindingsList, -- ^ List of keybindings+    mWebSettings    :: IO WebSettings,  -- ^ Web settings+    mCustomizations :: GUI -> IO (),    -- ^ Custom callbacks+    mError          :: Maybe String     -- ^ Error }--instance Ord Modifier where-    m <= m' =  fromEnum m <= fromEnum m' -- }}}  -- {{{ Entry point@@ -74,10 +74,10 @@                 [arg] -> arg                 _     -> mHomePage configuration -    webViewLoadUri (mWebView gui) url+    loadURL url gui      -- Load key bindings-    let keyBindings = fromList (mKeyBindings configuration)+    let keyBindings = importKeyBindings (mKeyBindings configuration)      -- Open all link in current window.     _ <- on (mWebView gui) createWebView $ \frame -> do@@ -133,7 +133,7 @@          case keyString of              Just string -> do -                case lookup (modifiers, string) keyBindings of+                case Map.lookup (Set.fromList modifiers, string) keyBindings of                     Just callback   -> liftIO $ callback gui                     _               -> liftIO $ putStrLn string              _ -> return ()

@@ -1,8 +1,16 @@ module Hbro.Util where +import Hbro.Gui (GUI)++import qualified Data.Set as Set+import qualified Data.Map as Map import Graphics.UI.Gtk import System.Process ++instance Ord Modifier where+    m <= m' =  fromEnum m <= fromEnum m'+ -- | Converts a keyVal to a String. -- For printable characters, the corresponding String is returned, except for the space character for which "<Space>" is returned. -- For non-printable characters, the corresponding keyName between <> is returned.@@ -24,6 +32,18 @@         "Menu"      -> Nothing         "ISO_Level3_Shift" -> Nothing         x           -> Just ('<':x ++ ">")++-- | Converts key bindings list to a map.+-- | Calls importKeyBindings'.+importKeyBindings :: [(([Modifier], String), (GUI -> IO ()))] -> Map.Map (Set.Set Modifier, String) (GUI -> IO ()) +importKeyBindings list = Map.fromList $ importKeyBindings' list++-- | Converts modifiers list to modifiers sets.+-- The order of modifiers in key bindings don't matter.+-- Called by importKeyBindings.+importKeyBindings' :: [(([Modifier], String), (GUI -> IO ()))] -> [((Set.Set Modifier, String), (GUI -> IO ()))]+importKeyBindings' (((a, b), c):t) = ((Set.fromList a, b), c):(importKeyBindings' t)+importKeyBindings' _ = []   -- | Like run `runCommand`, but return IO ()

@@ -23,7 +23,7 @@     mHomePage    = "https://www.google.com",      mKeyBindings = [---      ((Mod,          Key),       Callback)+--      ((Modifiers,    Key),       Callback)         -- Browsing         (([],           "<"),       goBack),         (([Shift],      ">"),       goForward),@@ -119,9 +119,10 @@             _ <- on webView progressChanged $ \progress' ->                 labelSetMarkup progressLabel $ "<span foreground=\"yellow\">" ++ show progress' ++ "%</span>" -            _ <- on webView loadFinished $ \_ -> +            _ <- on webView loadFinished $ \_ -> do                 labelSetMarkup progressLabel "<span foreground=\"green\">100%</span>" +             _ <- on webView loadError $ \_ _ _ -> do                 labelSetMarkup progressLabel "<span foreground=\"red\">ERROR</span>"                 return False@@ -165,12 +166,12 @@                   -+            -- On requesting new window             _ <- on webView newWindowPolicyDecisionRequested $ \_ request action policyDecision -> do-                getUrl <- networkRequestGetUri request-                case getUrl of-                    Just url -> putStrLn ("New Window: " ++ url)-                    _        -> putStrLn "ERROR"+                getUri <- networkRequestGetUri request+                case getUri of+                    Just uri -> runExternalCommand $ "hbro " ++ uri+                    _        -> putStrLn "ERROR: wrong URI given, unable to open window."                  return True 

@@ -1,5 +1,5 @@ Name:                hbro-Version:             0.4.2+Version:             0.4.3 Synopsis:            A suckless minimal KISSy browser -- Description:          -- Homepage: