hbro 0.4.4 → 0.4.5
raw patch · 4 files changed
+75/−26 lines, 4 filesdep +glibdep +pango
Dependencies added: glib, pango
Files
- Hbro/Core.hs +33/−10
- Hbro/Gui.hs +8/−5
- examples/Main.hs +30/−10
- hbro.cabal +4/−1
Hbro/Core.hs view
@@ -9,16 +9,26 @@ import qualified Config.Dyre as Dyre import Control.Concurrent import Control.Monad.Trans(liftIO)+ import qualified Data.Map as Map import qualified Data.Set as Set-import Graphics.UI.Gtk ++import Graphics.UI.Gtk.Abstract.Box+import Graphics.UI.Gtk.Abstract.Container+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.WebKit.WebSettings+ import Network.URL import Prelude+ import System.Environment+import System.Glib.Attributes+import System.Glib.Signals import System.Posix.Process -- }}} @@ -79,14 +89,24 @@ -- Load key bindings let keyBindings = importKeyBindings (mKeyBindings configuration) - -- Open all link in current window.+ + newWindowWebView <- webViewNew _ <- on (mWebView gui) createWebView $ \frame -> do- newUri <- webFrameGetUri frame- case newUri of- Just uri -> webViewLoadUri (mWebView gui) uri- Nothing -> return ()- return (mWebView gui)+ --newUri <- webFrameGetUri frame+-- case newUri of+-- Just uri -> webViewLoadUri (mWebView gui) uri+-- --Just uri -> runExternalCommand $ "hbro " ++ uri+-- Nothing -> return ()+ --return (mWebView gui)+ return newWindowWebView + _ <- on newWindowWebView loadCommitted $ \frame -> do+ getUri <- (webViewGetUri newWindowWebView)+ case getUri of + Just uri -> runExternalCommand $ "hbro " ++ uri+ _ -> return ()++ -- Web inspector inspector <- webViewGetInspector (mWebView gui) _ <- on inspector inspectWebView $ \_ -> do@@ -125,11 +145,14 @@ return True -- Key bindings+-- _ <- on (mWebView gui) keyPressEvent $ do+-- return True+ _ <- after (mWebView gui) keyPressEvent $ do- keyVal <- eventKeyVal- modifiers <- eventModifier+ value <- eventKeyVal+ modifiers <- eventModifier - let keyString = keyToString keyVal+ let keyString = keyToString value case keyString of Just string -> do
Hbro/Gui.hs view
@@ -5,6 +5,7 @@ import Control.Monad.Trans(liftIO) import Graphics.UI.Gtk+--import Graphics.UI.Gtk.Abstract.Misc import Graphics.UI.Gtk.WebKit.WebView -- }}} @@ -39,7 +40,7 @@ window <- windowNew inspectorWindow <- windowNew - windowSetDefaultSize window 1024 768+ --windowSetDefaultSize window 1024 768 windowSetPosition window WinPosCenter --windowSetIconFromFile window "/path/to/icon" set window [ windowTitle := "hbro" ]@@ -61,18 +62,20 @@ boxPackStart promptBox promptLabel PackNatural 0 boxPackStart promptBox promptEntry PackGrow 0 boxPackStart statusBox progressLabel PackNatural 0- boxPackStart statusBox urlLabel PackNatural 0+ boxPackStart statusBox urlLabel PackGrow 0 boxPackEnd statusBox scrollLabel PackNatural 0 -- window `containerAdd` winBox- scrollWindow `containerAdd` webView+ containerAdd window winBox+ containerAdd scrollWindow webView set webView [ widgetCanDefault := True ] windowSetDefault window (Just webView) set scrollWindow [ scrolledWindowHscrollbarPolicy := PolicyNever, scrolledWindowVscrollbarPolicy := PolicyNever ]++ labelSetEllipsize urlLabel EllipsizeEnd+ miscSetAlignment urlLabel 0 0 _ <- on webView closeWebView $ do mainQuit
examples/Main.hs view
@@ -1,19 +1,30 @@ module Main where -- {{{ Imports-import Hbro.Core-import Hbro.Gui-import Hbro.Util+import Hbro.Core +import Hbro.Gui +import Hbro.Util -import Control.Concurrent-import Graphics.UI.Gtk+import Graphics.Rendering.Pango.Layout++import Graphics.UI.Gtk.Abstract.Widget+import Graphics.UI.Gtk.Display.Label+import Graphics.UI.Gtk.Entry.Entry+import Graphics.UI.Gtk.Gdk.EventM+import Graphics.UI.Gtk.Gdk.GC+import Graphics.UI.Gtk.Misc.Adjustment+import Graphics.UI.Gtk.Scrolling.ScrolledWindow import Graphics.UI.Gtk.WebKit.Download import Graphics.UI.Gtk.WebKit.NetworkRequest import Graphics.UI.Gtk.WebKit.WebFrame import Graphics.UI.Gtk.WebKit.WebNavigationAction import Graphics.UI.Gtk.WebKit.WebView import Graphics.UI.Gtk.WebKit.WebSettings-import System.Process+import Graphics.UI.Gtk.Windows.Window++import System.Glib.Attributes+import System.Glib.Signals+import System.Process (runCommand) -- }}} main :: IO ()@@ -119,15 +130,17 @@ max <- adjustmentGetUpper adjustment page <- adjustmentGetPageSize adjustment - labelSetMarkup scrollLabel $ (show (round $ current/(max-min-page)*100)) ++ "%"+ case (max-min-page) of+ 0 -> labelSetMarkup scrollLabel "ALL"+ x -> labelSetMarkup scrollLabel $ (show (round $ current/x*100)) ++ "%" _ <- on webView loadStarted $ \_ -> do labelSetMarkup progressLabel "<span foreground=\"red\">0%</span>" _ <- on webView loadCommitted $ \_ -> do- getUrl <- (webViewGetUri webView)- case getUrl of - Just url -> labelSetMarkup urlLabel $ "<span weight=\"bold\" foreground=\"white\">" ++ url ++ "</span>"+ getUri <- (webViewGetUri webView)+ case getUri of + Just uri -> labelSetMarkup urlLabel $ "<span weight=\"bold\" foreground=\"white\">" ++ (escapeMarkup uri) ++ "</span>" _ -> labelSetMarkup urlLabel "" _ <- on webView progressChanged $ \progress' ->@@ -194,6 +207,13 @@ _ -> putStrLn "ERROR: wrong URI given, unable to open window." return True++ _ <- on webView hoveringOverLink $ \title hoveredUri -> do+ getUri <- (webViewGetUri webView)+ case (hoveredUri, getUri) of+ (Just u, _) -> labelSetMarkup urlLabel $ "<span foreground=\"#5555ff\">" ++ (escapeMarkup u) ++ "</span>"+ (_, Just u) -> labelSetMarkup urlLabel $ "<span foreground=\"white\" weight=\"bold\">" ++ (escapeMarkup u) ++ "</span>"+ _ -> putStrLn "FIXME" return () )}
hbro.cabal view
@@ -1,5 +1,5 @@ Name: hbro-Version: 0.4.4+Version: 0.4.5 Synopsis: A suckless minimal KISSy browser -- Description: -- Homepage:@@ -29,6 +29,7 @@ Build-depends: base == 4.*, webkit,+ glib, gtk, glade, mtl,@@ -50,7 +51,9 @@ Build-depends: hbro, base == 4.*,+ glib, gtk,+ pango, process, webkit Main-is: Main.hs