[Gtk2hs-commit] (main branch): Update embedded demo (looks uzbl demo lost when merge patchs).

[Andy S. <And...@co...>]

Sat Mar 13 08:10:51 EST 2010  Andy Stewart <laz...@gm...>
  * Update embedded demo (looks uzbl demo lost when merge patchs).
  Ignore-this: ff89b127ee7e9a526d4c3a252bbca9bb

    hunk ./demo/embbeded/Embedded.hs 1
    --- |Use GtkSocket and GtkPlug for cross-process embedded.
    --- Just startup program, press 'm' to create tab with new button.
    --- Click button for hang to simulate plug hanging process, [_$_]
    --- but socket process still running, can switch to other tab. [_$_]
    ---
    --- Note:
    ---
    --- Don't use `forkProcess` in gtk2hs!
    --- Because `forkProcess` haven't any protect when spawn process, [_$_]
    --- so you will got two processes *race condition*, when those two
    --- process access same resource will crash your program.
    --- Solution is use `runProcess` or `runCommand` instead, [_$_]
    --- Because those functions add MVar to make sure two processes won't
    --- get *race condition* problem.
    ---
    -
    -module Main where
    -
    -import System.Process
    -import System.Environment
    -import System.Directory
    -import System.FilePath ((</>))
    -import Control.Monad
    -import Control.Monad.Trans
    -import Control.Concurrent
    -
    -import Graphics.UI.Gtk
    -import Graphics.UI.Gtk.General.Structs
    -import Graphics.UI.Gtk.Gdk.EventM
    -
    --- | Main.
    -main :: IO ()
    -main = do
    -  -- Init main.
    -  initGUI
    -
    -  -- Get program arguments.
    -  args <- getArgs
    -
    -  case args of
    -    -- Entry plug main when have two arguments.
    -    [id] -> plugMain (toNativeWindowId $ read id :: NativeWindowId) -- get GtkSocket id
    -    -- Othersise entry socket main when no arguments.
    -    _ -> socketMain [_$_]
    -  [_$_]
    --- | GtkSocekt main.
    -socketMain :: IO ()  [_$_]
    -socketMain = do
    -  -- Create top-level window.
    -  window <- windowNew
    -  windowSetPosition window WinPosCenter
    -  windowSetDefaultSize window 600 400
    -  windowSetTitle window "Press `m` to new tab, press `q` exit."
    -  window `onDestroy` mainQuit
    -
    -  -- Create notebook to contain GtkSocekt.
    -  notebook <- notebookNew
    -  window `containerAdd` notebook
    -
    -  -- Handle key press.
    -  window `on` keyPressEvent $ tryEvent $ do
    -    keyName <- eventKeyName
    -    liftIO $ [_$_]
    -      case keyName of
    -        "m" -> do
    -               -- Create new GtkSocket.
    -               socket <- socketNew
    -               widgetShow socket                          -- must show before add GtkSocekt to container
    -               notebookAppendPage notebook socket "Tab"   -- add to GtkSocekt notebook
    -               id <- socketGetId socket                    -- get GtkSocket id
    -
    -               -- Fork process to add GtkPlug into GtkSocekt. [_$_]
    -               path <- liftM2 (</>) getCurrentDirectory getProgName -- get program full path
    -               runCommand $ path ++ " " ++ (show $ fromNativeWindowId id) -- don't use `forkProcess` !
    -               return ()
    -        "q" -> mainQuit          -- quit
    -
    -  widgetShowAll window
    -
    -  mainGUI
    -
    --- | GtkPlug main.
    -plugMain :: NativeWindowId -> IO ()
    -plugMain id = do
    -  plug <- plugNew $ Just id
    -  plug `onDestroy` mainQuit
    -  [_$_]
    -  button <- buttonNewWithLabel "Click me to hang."
    -  plug `containerAdd` button
    -
    -  -- Simulate a plugin hanging to see if it blocks the outer process.
    -  button `onClicked` threadDelay 5000000
    -  [_$_]
    -  widgetShowAll plug
    -  [_$_]
    -  mainGUI
    rmfile ./demo/embbeded/Embedded.hs
    hunk ./demo/embbeded/Makefile 1
    -PROGS  = Embedded Uzbl
    -SOURCES = Embedded.hs Uzbl.hs
    -
    -all : $(PROGS)
    -
    -Embedded : Embedded.hs
    -	$(HC_RULE)
    -
    -Uzbl : Uzbl.hs
    -	$(HC_RULE)
    -
    -HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS)
    -
    -clean:
    -	rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS)
    -
    -HC=ghc
    rmfile ./demo/embbeded/Makefile
    rmdir ./demo/embbeded