diff --git a/Hbro/Core.hs b/Hbro/Core.hs --- a/Hbro/Core.hs +++ b/Hbro/Core.hs @@ -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 diff --git a/Hbro/Gui.hs b/Hbro/Gui.hs --- a/Hbro/Gui.hs +++ b/Hbro/Gui.hs @@ -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). diff --git a/Hbro/Types.hs b/Hbro/Types.hs --- a/Hbro/Types.hs +++ b/Hbro/Types.hs @@ -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 } diff --git a/examples/Main.hs b/examples/Main.hs --- a/examples/Main.hs +++ b/examples/Main.hs @@ -89,7 +89,7 @@ (([Control], "-"), zoomOut), (([], ""), fullscreen), (([], ""), 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() diff --git a/hbro.cabal b/hbro.cabal --- a/hbro.cabal +++ b/hbro.cabal @@ -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/