Sat Mar 20 11:17:26 EDT 2010 Andy Stewart <laz...@gm...>
* Add WebKit demo.
Ignore-this: cddf99434ea4b04a41e1f13c3b91d177
adddir ./demo/webkit
addfile ./demo/webkit/Makefile
hunk ./demo/webkit/Makefile 1
+
+PROGS = webkit
+SOURCES = Webkit.hs
+
+all : $(PROGS)
+
+webkit : Webkit.hs
+ $(HC) --make $< -o $@ $(HCFLAGS)
+
+clean:
+ rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS)
+
+HC=ghc
addfile ./demo/webkit/Webkit.hs
hunk ./demo/webkit/Webkit.hs 1
+-- | WebKit browser demo.
+-- Author : Andy Stewart
+-- Copyright : (c) 2010 Andy Stewart <laz...@gm...>
+
+-- | This simple browser base on WebKit API.
+-- For simple, i just make all link open in current window.
+-- Of course, you can integrate signal `createWebView` with `notebook`
+-- to build multi-tab browser.
+--
+-- You can click right-button for forward or backward page.
+--
+-- Usage:
+-- webkit [uri]
+--
+module Main where
+
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.General.Structs
+import Graphics.UI.Gtk.WebKit.WebView
+import Graphics.UI.Gtk.WebKit.WebFrame
+
+import System.Process
+import System.Environment [_$_]
+
+-- | Main entry.
+main :: IO ()
+main = do
+ -- Get program arguments.
+ args <- getArgs
+ case args of
+ -- Display help
+ ["--help"] -> do
+ putStrLn $ "Welcome to Gtk2hs WebKit demo. :)\n\n" ++ [_$_]
+ "Usage: webkit [uri]\n\n" ++
+ " -- Gtk2hs Team"
+ -- Start program.
+ [arg] -> browser arg -- entry user input url
+ _ -> browser "http://www.google.com" -- entry default url
+
+-- | Internal browser fucntion.
+browser :: String -> IO ()
+browser url = do
+ -- Init.
+ initGUI
+ [_$_]
+ -- Create window.
+ window <- windowNew
+ windowSetDefaultSize window 900 600
+ windowSetPosition window WinPosCenter
+ windowSetOpacity window 0.8 -- this function need window-manager support Alpha channel in X11
+
+ -- Create WebKit view.
+ webView <- webViewNew
+ [_$_]
+ -- Create window box.
+ winBox <- vBoxNew False 0
+ [_$_]
+ -- Create address bar.
+ addressBar <- entryNew
+
+ -- Create scroll window.
+ scrollWin <- scrolledWindowNew Nothing Nothing
+
+ -- Load uri.
+ webViewLoadUri webView url
+ entrySetText addressBar url
+
+ -- Open uri when user press `return` at address bar.
+ onEntryActivate addressBar $ do
+ uri <- entryGetText addressBar -- get uri from address bar
+ webViewLoadUri webView uri -- load new uri
+
+ -- Add current uri to address bar when load start.
+ webView `on` loadStarted $ \frame -> do
+ currentUri <- webFrameGetUri frame
+ case currentUri of
+ Just uri -> entrySetText addressBar uri
+ Nothing -> return ()
+
+ -- Open all link in current window.
+ webView `on` createWebView $ \frame -> do
+ newUri <- webFrameGetUri frame
+ case newUri of
+ Just uri -> webViewLoadUri webView uri
+ Nothing -> return ()
+ return webView
+
+ -- Connect and show.
+ boxPackStart winBox addressBar PackNatural 0
+ boxPackStart winBox scrollWin PackGrow 0
+ window `containerAdd` winBox
+ scrollWin `containerAdd` webView
+ window `onDestroy` mainQuit
+ widgetShowAll window
+
+ mainGUI
|
