module WebBrowser.Browser ( runBrowser ) where import Graphics.UI.Gtk import Data.Char (toUpper) import Data.IORef import Graphics.UI.Gtk.WebKit.WebView import Graphics.UI.Gtk.WebKit.WebFrame import Graphics.UI.Gtk.WebKit.WebDataSource import Graphics.UI.Gtk.WebKit.WebSettings runBrowser :: IO () runBrowser = do initGUI window <- windowNew set window [windowTitle := "Akash's Web Browser", windowDefaultWidth :=300, windowDefaultHeight := 200 ] windowMaximize window widgetModifyBg window StateNormal (Color 6851 48114 6851) ntbk <- notebookNew containerAdd window ntbk set ntbk [notebookScrollable := True, notebookTabPos := PosTop] stls <- stockListIds tab <- tableNew 1 10 True button <- buttonNew buttonSetFocusOnClick button False buttonSetRelief button ReliefNone im <- imageNewFromStock stockClose (IconSizeUser 3) buttonSetImage button im label <- labelNew (Just "label") label1 <- labelNew (Just "label1") a <- labelNew (Just "New Tab") tableAttachDefaults tab a 0 1 0 1 tableAttachDefaults tab button 4 5 0 1 img <- imageNewFromStock stockAdd (IconSizeUser 1) widgetShowAll tab newButton <- buttonNew buttonSetFocusOnClick newButton False buttonSetRelief newButton ReliefNone im1 <- imageNewFromStock stockAdd (IconSizeUser 1) buttonSetImage newButton im1 lb1 <- labelNew (Just "Web Browser") lb2 <- labelNew (Just "In") lb3 <- labelNew (Just "Haskell") srcfont <- fontDescriptionFromString "Courier Bold 60" widgetModifyFont lb1 (Just srcfont) widgetModifyFont lb2 (Just srcfont) widgetModifyFont lb3 (Just srcfont) tableForMessage <- tableNew 3 1 True tableAttachDefaults tableForMessage lb1 0 1 0 1 tableAttachDefaults tableForMessage lb2 0 1 1 2 tableAttachDefaults tableForMessage lb3 0 1 2 3 pagenum2 <- notebookAppendPageMenu ntbk tableForMessage newButton label1 widgetModifyBg ntbk StateNormal (Color 6851 48114 48114) widgetModifyFg ntbk StateNormal (Color 48114 48114 6851) widgetModifyBase ntbk StateNormal (Color 48114 48114 6851) notebookSetShowBorder ntbk True widgetShowAll ntbk cnt <- newIORef 1 onClicked newButton $ do wv <- repeating ntbk cnt print "opened new tab" --onSwitchPage ntbk (putStrLn . ((++)"Page: ") . show) widgetShowAll window onDestroy window mainQuit mainGUI where fun a = a + 1 but = do button <- buttonNew buttonSetFocusOnClick button False buttonSetRelief button ReliefNone im <- imageNewFromStock stockClose (IconSizeUser 3) buttonSetImage button im return button --repeating :: Notebook -> (IORef Int) -> IO () repeating ntbk cnt = do --putStrLn "new button clicked" widgetShowAll ntbk tab2 <- tableNew 1 5 False button2 <- buttonNew buttonSetFocusOnClick button2 False buttonSetRelief button2 ReliefNone im2 <- imageNewFromStock stockClose (IconSizeUser 1) buttonSetImage button2 im2 label2 <- labelNew (Just "label2") pageName <- labelNew (Just "New Tab") tableAttachDefaults tab2 pageName 0 1 0 1 tableAttachDefaults tab2 button2 4 5 0 1 pageIcon <- imageNew v <- vBoxNew False 2 tool <- toolbarNew table <- tableNew 1 20 True h <- hBoxNew False 0 go_back <- buttonNew img1 <- imageNewFromStock stockGoBack (IconSizeUser 2) buttonSetImage go_back img1 buttonSetFocusOnClick go_back False buttonSetRelief go_back ReliefNone go_forward <- buttonNew img2 <- imageNewFromStock stockGoForward (IconSizeUser 2) buttonSetImage go_forward img2 buttonSetFocusOnClick go_forward False buttonSetRelief go_forward ReliefNone refresh <- buttonNew img3 <- imageNewFromStock stockRefresh (IconSizeUser 2) buttonSetImage refresh img3 buttonSetFocusOnClick refresh False buttonSetRelief refresh ReliefNone address_bar <- entryNew sw <- scrolledWindowNew Nothing Nothing wv <- webViewNew entrySetWidthChars address_bar 125 boxPackStartDefaults h go_back boxPackStart h go_forward PackNatural 0 boxPackStart h refresh PackNatural 0 boxPackStart h address_bar PackNatural 0 widgetShowAll address_bar widgetShowAll h toolbarAppendNewWidget tool h Nothing boxPackStart v tool PackNatural 0 boxPackStart v sw PackGrow 0 set sw [ containerChild := wv ] onClicked go_back $ do webViewGoBack wv onClicked go_forward $ do webViewGoForward wv onClicked refresh $ do webViewReload wv onEntryActivate address_bar $ do text <- entryGetText address_bar let url = checkVal text webViewLoadUri wv url wv `on` createWebView $ browserViewNewTab ntbk cnt wv `on` loadFinished $ \ frame -> do webFrameGetUri frame >>= \uri -> do ch <- webViewGetTitle wv let (Just a) = if(ch == Nothing) then (Just "") else ch labelSetText pageName (take 8 a) --print a wv `on` loadCommitted $ \ frame -> do -- Intercept new uri. webFrameGetUri frame >>= \uri -> do let (Just aa) = uri --print uri if(uri == Nothing) then (putStrLn "nothing") else (if(take 7 aa == "http://") then (entrySetText address_bar (drop 7 aa)) else (if(take 7 aa == "file://") then (print "file") else (entrySetText address_bar aa))) back <- webViewCanGoBack wv forward <- webViewCanGoForward wv widgetSetSensitive go_back back widgetSetSensitive go_forward forward widgetShowAll v cn <- readIORef cnt disp <- labelNew (Just (show cn)) widgetShowAll tab2 n <- notebookGetNPages ntbk pagenum3 <- notebookInsertPageMenu ntbk v tab2 label2 (n-1) widgetShowAll ntbk notebookSetCurrentPage ntbk pagenum3 number <- notebookGetNPages ntbk --print number widgetShowAll ntbk ab <- onClicked button2 $ do --putStrLn "clicked" (Just pg) <- notebookPageNum ntbk v --print pg notebookRemovePage ntbk pg --putStrLn "new start" return wv browserViewNewTab ntbk cnt _ = do webView <- repeating ntbk cnt return webView checkVal str = if(isHttp || isHttps || isFile) then str else ("http://" ++ str) where isHttp = take 7 str == "http://" isHttps = take 8 str == "https://" isFile = take 7 str == "file://"