hbro 0.5.2 → 0.5.3
raw patch · 5 files changed
+91/−77 lines, 5 files
Files
- Hbro/Core.hs +9/−57
- Hbro/Gui.hs +70/−13
- Hbro/Types.hs +2/−0
- examples/Main.hs +9/−6
- hbro.cabal +1/−1
Hbro/Core.hs view
@@ -14,14 +14,12 @@ import qualified Data.Map as Map import qualified Data.Set as Set -import Graphics.UI.Gtk.Abstract.Container --import Graphics.UI.Gtk.Abstract.IMContext import Graphics.UI.Gtk.Abstract.Widget import Graphics.UI.Gtk.General.General import Graphics.UI.Gtk.Gdk.EventM import Graphics.UI.Gtk.WebKit.WebView import Graphics.UI.Gtk.WebKit.WebFrame-import Graphics.UI.Gtk.WebKit.WebInspector --import Graphics.UI.Gtk.Windows.Window import Network.URL@@ -50,10 +48,16 @@ -- {{{ Entry point -- | Entry point of the application.--- | Parse arguments and step down in favour of initBrowser.+-- Parse arguments and step down in favour of initBrowser.+-- Print configuration error, if any. realMain :: Configuration -> IO () realMain configuration = do options <- getOptions++ case (mError configuration) of+ Just e -> putStrLn e+ _ -> return ()+ initBrowser configuration options -- }}} @@ -62,11 +66,6 @@ -- Create browser and load homepage. initBrowser :: Configuration -> CliOptions -> IO () initBrowser configuration options = do- -- Print configuration error, if any- case (mError configuration) of- Just e -> putStrLn e- _ -> return ()- -- Initialize browser _ <- initGUI gui <- loadGUI (mUIFile configuration)@@ -100,11 +99,11 @@ -- Load key bindings let keyBindings = importKeyBindings (mKeyBindings configuration) - -- On new window request --newWindowWebView <- webViewNew _ <- on webView createWebView $ \frame -> do newUri <- webFrameGetUri frame+ putStrLn "NEW WINDOW" case newUri of Just uri -> webViewLoadUri webView uri --Just uri -> runExternalCommand $ "hbro " ++ uri@@ -119,43 +118,6 @@ -- _ -> return () - -- Web inspector- inspector <- webViewGetInspector webView- _ <- on inspector inspectWebView $ \_ -> do- inspectorWebView <- webViewNew- containerAdd (mInspectorWindow gui) inspectorWebView- return inspectorWebView- - _ <- on inspector showWindow $ do- widgetShowAll (mInspectorWindow gui)- return True-- -- TODO: when does this signal happen ?!- --_ <- on inspector finished $ return ()---- _ <- on inspector attachWindow $ do--- getWebView <- webInspectorGetWebView inspector--- case getWebView of--- Just webView -> do widgetHide (mInspectorWindow gui)--- containerRemove (mInspectorWindow gui) webView--- widgetSetSizeRequest webView (-1) 250--- boxPackEnd (mWindowBox gui) webView PackNatural 0--- widgetShow webView--- return True--- _ -> return False---- _ <- on inspector detachWindow $ do--- getWebView <- webInspectorGetWebView inspector--- _ <- case getWebView of--- Just webView -> do containerRemove (mWindowBox gui) webView--- containerAdd (mInspectorWindow gui) webView--- widgetShowAll (mInspectorWindow gui)--- return True--- _ -> return False- --- widgetShowAll (mInspectorWindow gui)--- return True- -- Key bindings -- imContext <- get webView webViewImContext -- _ <- on webView keyPressEvent $ do@@ -240,25 +202,14 @@ printPage browser = do frame <- webViewGetMainFrame (mWebView $ mGUI browser) webFramePrint frame--- }}} ---- | Show web inspector for current webpage.-showWebInspector :: Browser -> IO ()-showWebInspector browser = do- inspector <- webViewGetInspector (mWebView $ mGUI browser)- webInspectorInspectCoordinates inspector 0 0-- -- | Load given URL in the browser. loadURL :: String -> Browser -> IO () loadURL url browser = case importURL url of Just url' -> loadURL' url' browser _ -> return ()--- }}} - -- | Backend function for loadURL. loadURL' :: URL -> Browser -> IO () loadURL' url@URL {url_type = Absolute _} browser =@@ -267,6 +218,7 @@ webViewLoadUri (mWebView $ mGUI browser) ("file://" ++ exportURL url) >> putStrLn (show url) loadURL' url@URL {url_type = _} browser = webViewLoadUri (mWebView $ mGUI browser) ("http://" ++ exportURL url) >> print url+-- }}} -- {{{ Dyre showError :: Configuration -> String -> Configuration
Hbro/Gui.hs view
@@ -15,7 +15,9 @@ import Graphics.UI.Gtk.Entry.Entry import Graphics.UI.Gtk.General.General import Graphics.UI.Gtk.Gdk.EventM+import Graphics.UI.Gtk.Layout.HBox import Graphics.UI.Gtk.Scrolling.ScrolledWindow+import Graphics.UI.Gtk.WebKit.WebInspector import Graphics.UI.Gtk.WebKit.WebView import Graphics.UI.Gtk.Windows.Window @@ -29,33 +31,88 @@ builder <- builderNew builderAddFromFile builder xmlPath + -- Init main web view+ webView <- webViewNew+ set webView [ widgetCanDefault := True ]+ _ <- on webView closeWebView $ do+ mainQuit+ return True+ -- Load main window window <- builderGetObject builder castToWindow "mainWindow"- scrollWindow <- builderGetObject builder castToScrolledWindow "webViewParent"- promptLabel <- builderGetObject builder castToLabel "promptDescription"- promptEntry <- builderGetObject builder castToEntry "promptEntry"-- inspectorWindow <- windowNew-+ windowSetDefault window (Just webView) --windowSetDefaultSize window 1024 768 --windowSetPosition window WinPosCenter --windowSetIconFromFile window "/path/to/icon" set window [ windowTitle := "hbro" ] - webView <- webViewNew+ scrollWindow <- builderGetObject builder castToScrolledWindow "webViewParent" containerAdd scrollWindow webView -- set webView [ widgetCanDefault := True ]- windowSetDefault window (Just webView) set scrollWindow [ scrolledWindowHscrollbarPolicy := PolicyNever, scrolledWindowVscrollbarPolicy := PolicyNever ] - _ <- on webView closeWebView $ do- mainQuit+ promptLabel <- builderGetObject builder castToLabel "promptDescription"+ promptEntry <- builderGetObject builder castToEntry "promptEntry"+ statusBox <- builderGetObject builder castToHBox "statusBox"++ -- Create web inspector's window+ inspector <- webViewGetInspector webView+ inspectorWindow <- initWebInspector inspector++ return $ GUI window inspectorWindow scrollWindow webView promptLabel promptEntry statusBox builder++-- {{{ Web inspector+initWebInspector :: WebInspector -> IO (Window)+initWebInspector inspector = do + inspectorWindow <- windowNew+ set inspectorWindow [ windowTitle := "hbro | Web inspector" ]++ _ <- on inspector inspectWebView $ \_ -> do+ webView <- webViewNew+ containerAdd inspectorWindow webView+ return webView+ + _ <- on inspector showWindow $ do+ widgetShowAll inspectorWindow return True - return $ GUI window inspectorWindow scrollWindow webView promptLabel promptEntry builder+ -- TODO: when does this signal happen ?!+ --_ <- on inspector finished $ return ()++-- _ <- on inspector attachWindow $ do+-- getWebView <- webInspectorGetWebView inspector+-- case getWebView of+-- Just webView -> do widgetHide (mInspectorWindow gui)+-- containerRemove (mInspectorWindow gui) webView+-- widgetSetSizeRequest webView (-1) 250+-- boxPackEnd (mWindowBox gui) webView PackNatural 0+-- widgetShow webView+-- return True+-- _ -> return False++-- _ <- on inspector detachWindow $ do+-- getWebView <- webInspectorGetWebView inspector+-- _ <- case getWebView of+-- Just webView -> do containerRemove (mWindowBox gui) webView+-- containerAdd (mInspectorWindow gui) webView+-- widgetShowAll (mInspectorWindow gui)+-- return True+-- _ -> return False+ +-- widgetShowAll (mInspectorWindow gui)+-- return True++ return inspectorWindow+++-- | Show web inspector for current webpage.+showWebInspector :: Browser -> IO ()+showWebInspector browser = do+ inspector <- webViewGetInspector (mWebView $ mGUI browser)+ webInspectorInspectCoordinates inspector 0 0++-- }}} -- {{{ Prompt -- | Show or hide the prompt bar (label + entry).
Hbro/Types.hs view
@@ -5,6 +5,7 @@ import Graphics.UI.Gtk.Builder import Graphics.UI.Gtk.Display.Label 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.WebSettings@@ -44,6 +45,7 @@ mWebView :: WebView, -- ^ Browser's webview mPromptLabel :: Label, -- ^ Description of current prompt mPromptEntry :: Entry, -- ^ Prompt entry+ mStatusBox :: HBox, -- ^ Status bar's horizontal box mBuilder :: Builder -- ^ Builder object created from XML file }
examples/Main.hs view
@@ -89,7 +89,7 @@ (([Control], "-"), zoomOut), (([], "<F11>"), fullscreen), (([], "<Escape>"), unfullscreen),- (([], "t"), toggleStatusBar),+ (([Control], "t"), toggleStatusBar), (([Control], "u"), toggleSourceMode), -- Prompt@@ -287,7 +287,7 @@ _ <- on webView newWindowPolicyDecisionRequested $ \_ request action policyDecision -> do getUri <- networkRequestGetUri request case getUri of- Just uri -> runExternalCommand $ "hbro " ++ uri+ Just uri -> runExternalCommand $ "hbro -u " ++ uri _ -> putStrLn "ERROR: wrong URI given, unable to open window." return True@@ -314,14 +314,17 @@ scriptsDir = "~/.config/hbro/scripts/" socketDir = "/tmp" - toggleSourceMode :: Browser -> IO()+ toggleSourceMode :: Browser -> IO () toggleSourceMode browser = do currentMode <- webViewGetViewSourceMode (mWebView $ mGUI browser) webViewSetViewSourceMode (mWebView $ mGUI browser) (not currentMode) - -- TODO- toggleStatusBar :: Browser -> IO()- toggleStatusBar browser = return()+ toggleStatusBar :: Browser -> IO ()+ toggleStatusBar browser = do+ visibility <- get (mStatusBox $ mGUI browser) widgetVisible+ case visibility of+ False -> widgetShow (mStatusBox $ mGUI browser)+ _ -> widgetHide (mStatusBox $ mGUI browser) promptURL :: Bool -> Browser -> IO()
hbro.cabal view
@@ -1,5 +1,5 @@ Name: hbro-Version: 0.5.2+Version: 0.5.3 Synopsis: A suckless minimal KISSy browser -- Description: Homepage: http://projects.haskell.org/hbro/