diff --git a/Hbro/Core.hs b/Hbro/Core.hs --- a/Hbro/Core.hs +++ b/Hbro/Core.hs @@ -19,7 +19,7 @@ -- {{{ Imports import Hbro.Gui ---import Hbro.Keys +import Hbro.Keys import Hbro.Socket import Hbro.Types --import Hbro.Util @@ -32,7 +32,7 @@ import qualified Data.Map as M ---import Graphics.UI.Gtk.Abstract.Widget +import Graphics.UI.Gtk.Abstract.Widget import Graphics.UI.Gtk.General.General hiding(initGUI) import Graphics.UI.Gtk.Misc.Adjustment import Graphics.UI.Gtk.Scrolling.ScrolledWindow @@ -45,7 +45,7 @@ import System.Console.CmdArgs import System.Directory import System.Environment.XDG.BaseDir ---import System.Glib.Signals +import System.Glib.Signals import System.IO import System.Posix.Process import System.Posix.Signals @@ -94,6 +94,8 @@ mHomePage = "https://encrypted.google.com/", mSocketDir = mTemporary directories, mUIFile = (mConfiguration directories) ++ "/ui.xml", + mKeyEventHandler = simpleKeyEventHandler, + mKeyEventCallback = \_ -> simpleKeyEventCallback (keysListToMap []), mWebSettings = [], mSetup = const (return () :: IO ()), mCommands = [], @@ -145,14 +147,14 @@ setup = mSetup config socketDir = mSocketDir config commands = mCommands config - --keyEventHandler = mKeyEventHandler config - --keyEventCallback = (mKeyEventCallback config) environment + keyEventHandler = mKeyEventHandler config + keyEventCallback = (mKeyEventCallback config) environment in do -- Apply custom setup setup environment -- Setup key handler - --rec i <- after webView keyPressEvent $ keyEventHandler keyEventCallback i webView + rec i <- after webView keyPressEvent $ keyEventHandler keyEventCallback i webView -- Load homepage case (mURI options) of diff --git a/Hbro/Extra/StatusBar.hs b/Hbro/Extra/StatusBar.hs --- a/Hbro/Extra/StatusBar.hs +++ b/Hbro/Extra/StatusBar.hs @@ -13,7 +13,7 @@ import Graphics.Rendering.Pango.Layout import Graphics.UI.Gtk.Display.Label ---import Graphics.UI.Gtk.Gdk.EventM +import Graphics.UI.Gtk.Gdk.EventM import Graphics.UI.Gtk.Misc.Adjustment import Graphics.UI.Gtk.Scrolling.ScrolledWindow import Graphics.UI.Gtk.WebKit.WebView @@ -56,8 +56,8 @@ -- | -withFeedback :: Label -> WebView -> KeyEventCallback -> KeyEventCallback -withFeedback widget webView callback modifiers keys = do +withFeedback :: Label -> KeyEventCallback -> [Modifier] -> String -> IO Bool +withFeedback widget callback modifiers keys = do -- Trigger callback result <- callback modifiers keys diff --git a/Hbro/Keys.hs b/Hbro/Keys.hs --- a/Hbro/Keys.hs +++ b/Hbro/Keys.hs @@ -1,5 +1,15 @@ {-# LANGUAGE DoRec #-} -module Hbro.Keys where +module Hbro.Keys ( +-- * Key event callbacks + withKeys, + simpleKeyEventCallback, +-- * Key event handlers + simpleKeyEventHandler, + advancedKeyEventHandler, +-- * Util + keyToString, + keysListToMap +) where -- {{{ Imports import Hbro.Types diff --git a/Hbro/Types.hs b/Hbro/Types.hs --- a/Hbro/Types.hs +++ b/Hbro/Types.hs @@ -18,7 +18,7 @@ import System.Console.CmdArgs import System.Glib.Attributes ---import System.Glib.Signals +import System.Glib.Signals import System.ZMQ -- }}} @@ -55,8 +55,8 @@ mHomePage :: String, -- ^ Startup page mSocketDir :: FilePath, -- ^ Directory where 0MQ will be created ("/tmp" for example) mUIFile :: FilePath, -- ^ Path to XML file describing UI (used by GtkBuilder) --- mKeyEventHandler :: KeyEventCallback -> ConnectId WebView -> WebView -> EventM EKey Bool, -- ^ Key event handler, which forwards keystrokes to mKeyEventCallback --- mKeyEventCallback :: Environment -> KeyEventCallback, -- ^ Main key event callback, assumed to deal with each keystroke separately + mKeyEventHandler :: KeyEventCallback -> ConnectId WebView -> WebView -> EventM EKey Bool, -- ^ Key event handler, which forwards keystrokes to mKeyEventCallback + mKeyEventCallback :: Environment -> KeyEventCallback, -- ^ Main key event callback, assumed to deal with each keystroke separately mWebSettings :: [AttrOp WebSettings], -- ^ WebSettings' attributes to use with webkit (see Webkit.WebSettings documentation) mSetup :: Environment -> IO (), -- ^ Custom startup instructions mCommands :: CommandsList, -- ^ Custom commands to use with IPC sockets diff --git a/Hbro/Util.hs b/Hbro/Util.hs --- a/Hbro/Util.hs +++ b/Hbro/Util.hs @@ -60,13 +60,14 @@ where clear = labelSetMarkup label "" >> return False - -(>>?) :: (a -> IO ()) -> Maybe a -> IO () -(>>?) = maybe (return ()) +-- | Similar to forM_ (from Control.Monad) but for Maybe instead of List. +forMaybeM_ :: Maybe a -> (a -> IO ()) -> IO () +forMaybeM_ = flip $ maybe (return ()) - - -dmenu :: [String] -> T.Text -> IO String +-- | Open dmenu with given input and return selected entry. +dmenu :: [String] -- ^ dmenu's commandline options + -> T.Text -- ^ dmenu's input + -> IO String -- ^ Selected entry dmenu options input = do (in_, out, err, pid) <- runInteractiveProcess "dmenu" options Nothing Nothing T.hPutStr in_ input diff --git a/examples/hbro.hs b/examples/hbro.hs --- a/examples/hbro.hs +++ b/examples/hbro.hs @@ -50,11 +50,13 @@ -- use the defaults defined in Hbro.Types.Parameters. myConfig :: CommonDirectories -> Config myConfig directories = (defaultConfig directories) { - mSocketDir = mySocketDirectory, - mUIFile = myUIFile directories, - mHomePage = myHomePage, - mWebSettings = myWebSettings, - mSetup = mySetup + mSocketDir = mySocketDirectory directories, + mUIFile = myUIFile directories, + mKeyEventHandler = myKeyEventHandler, + mKeyEventCallback = myKeyEventCallback, + mHomePage = myHomePage, + mWebSettings = myWebSettings, + mSetup = mySetup } -- Various constant parameters @@ -78,7 +80,17 @@ --myDownload directories uri name = spawn "wget" [uri, "-O", (mHome directories) ++ "/" ++ name] --myDownload directories uri name = spawn "axel" [uri, "-o", (mHome directories) ++ "/" ++ name] +myKeyEventHandler :: KeyEventCallback -> ConnectId WebView -> WebView -> EventM EKey Bool +myKeyEventHandler = advancedKeyEventHandler +myKeyEventCallback :: Environment -> KeyEventCallback +myKeyEventCallback environment@Environment{ mGUI = gui } modifiers keys = do + keysLabel <- builderGetObject builder castToLabel "keys" + withFeedback keysLabel (simpleKeyEventCallback $ keysListToMap (myKeys environment)) modifiers keys + where + builder = mBuilder gui + + -- {{{ Keys -- Note that this example is suited for an azerty keyboard. myKeys :: Environment -> KeysList @@ -236,10 +248,6 @@ uriLabel <- getLabel "uri" statusBarURI uriLabel webView - -- Manage keystrokes - keysLabel <- getLabel "keys" - rec i <- after webView keyPressEvent $ advancedKeyEventHandler (withFeedback keysLabel webView (simpleKeyEventCallback $ keysListToMap (myKeys environment))) i webView - -- Session manager --setupSession browser diff --git a/hbro.cabal b/hbro.cabal --- a/hbro.cabal +++ b/hbro.cabal @@ -1,10 +1,9 @@ Name: hbro -Version: 0.7.1.0 +Version: 0.7.1.1 Synopsis: A minimal KISS compliant browser -- Description: Homepage: http://projects.haskell.org/hbro/ Category: Browser,Web -Stability: alpha License: OtherLicense License-file: LICENSE @@ -19,11 +18,10 @@ Source-repository head Type: git - Location: git@twyk.org/haskell-browser.git - + Location: git@github.com:k0ral/hbro.git Source-repository head Type: git - Location: git@github.com:k0ral/hbro.git + Location: git@twyk.org/haskell-browser.git Library Build-depends: