[Gtk2hs-commit] (main branch): Use simpler embbeded demo replace previous one.

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

Thu Nov 26 07:32:39 EST 2009  Andy Stewart <laz...@gm...>
  * Use simpler embbeded demo replace previous one.
  Ignore-this: 51d2f4d8a44bc9a63ed3ce6e7f2f25e6

    hunk ./demo/embbeded/Embedded.hs 2
    --- Just startup program, press 'Alt-m' to new editor, press `Alt-n` to new terminal.
    --- And those plug widget (editor, terminal) running in child-process, [_$_]
    --- so program won't crash when child-process throw un-catch exception.
    +-- 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. [_$_]
    hunk ./demo/embbeded/Embedded.hs 14
    +import Control.Concurrent
    hunk ./demo/embbeded/Embedded.hs 18
    -import Graphics.UI.Gtk.Vte.Vte
    hunk ./demo/embbeded/Embedded.hs 20
    -data PlugType = PlugEditor
    -              | PlugTerminal
    -              deriving (Eq, Ord, Show, Read)
    -
    hunk ./demo/embbeded/Embedded.hs 29
    -  case length args of
    -    -- Entry socket main when no arguments.
    -    0 -> socketMain [_$_]
    -
    +  case args of
    hunk ./demo/embbeded/Embedded.hs 31
    -    2 -> do
    -      let pType = read (head args) :: PlugType -- get Plug type
    -          id    = toNativeWindowId $ read (last args) :: NativeWindowId -- get GtkSocket id
    -
    -      plugMain id pType
    -    -- Otherwise just output error and exit.
    -    _ -> putStrLn "Wrong program arguments."
    +    [id] -> plugMain (toNativeWindowId $ read id :: NativeWindowId) -- get GtkSocket id
    +    -- Othersise entry socket main when no arguments.
    +    _ -> socketMain [_$_]
    hunk ./demo/embbeded/Embedded.hs 38
    -  -- Output message.
    -  pid <- getProcessID
    -  putStrLn $ "Running in socket process : " ++ show pid
    -
    hunk ./demo/embbeded/Embedded.hs 40
    -  windowFullscreen window
    +  windowSetPosition window WinPosCenter
    +  windowSetDefaultSize window 600 400
    +  windowSetTitle window "Press `m` to new tab, press `q` exit."
    hunk ./demo/embbeded/Embedded.hs 51
    -    keyModifier <- eventModifier
    -    keyName     <- eventKeyName
    -    liftIO $ when (keyModifier == [Alt]) $ [_$_]
    +    keyName <- eventKeyName
    +    liftIO $ [_$_]
    hunk ./demo/embbeded/Embedded.hs 54
    -        "m" -> forkPlugProcess notebook PlugEditor "Editor"     -- create editor GtkPlug
    -        "n" -> forkPlugProcess notebook PlugTerminal "Terminal" -- create terminal GtkPlug
    +        "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
    +               forkProcess (executeFile path False [show $ fromNativeWindowId id] Nothing)
    +               return ()
    +        "q" -> mainQuit          -- quit
    hunk ./demo/embbeded/Embedded.hs 72
    -plugMain :: NativeWindowId -> PlugType -> IO ()
    -plugMain id PlugEditor   = plugWrap id =<< createEditor
    -plugMain id PlugTerminal = plugWrap id =<< createTerminal
    -
    --- | Fork plug process.
    -forkPlugProcess :: Notebook -> PlugType -> String -> IO ()
    -forkPlugProcess notebook plugType tabName = do
    -  -- Create new GtkSocket.
    -  socket <- socketNew
    -  widgetShow socket                          -- must show before add GtkSocekt to container
    -  notebookAppendPage notebook socket tabName -- 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
    -  forkProcess (executeFile path False [show plugType, show $ fromNativeWindowId id] Nothing)
    -  return ()
    -
    --- | Plug wrap function.
    -plugWrap :: WidgetClass widget => NativeWindowId -> widget -> IO ()
    -plugWrap id widget = do
    -  -- Output message.
    -  pid <- getProcessID
    -  putStrLn $ "Running in plug process : " ++ show pid
    -
    -  -- Create GtkPlug with GtkSocekt id.
    +plugMain :: NativeWindowId -> IO ()
    +plugMain id = do
    hunk ./demo/embbeded/Embedded.hs 77
    -  -- Add widget to GtkPlug.
    -  scrolledWindow <- scrolledWindowNew Nothing Nothing
    -  scrolledWindow `containerAdd` widget
    -  plug `containerAdd` scrolledWindow
    -
    -  widgetShowAll plug  [_$_]
    +  button <- buttonNewWithLabel "Click me to hang."
    +  plug `containerAdd` button
    hunk ./demo/embbeded/Embedded.hs 80
    +  -- Simulate a plugin hanging to see if it blocks the outer process.
    +  button `onClicked` threadDelay 5000000
    +  [_$_]
    +  widgetShowAll plug
    +  [_$_]
    hunk ./demo/embbeded/Embedded.hs 87
    --- Create editor widget.
    -createEditor :: IO TextView
    -createEditor = textViewNew
    -  [_$_]
    --- Create terminal widget.
    -createTerminal :: IO Terminal  [_$_]
    -createTerminal = do
    -  terminal <- terminalNew
    -  terminalForkCommand terminal Nothing Nothing Nothing Nothing False False False
    -  return terminal
    hunk ./demo/embbeded/Makefile 5
    -	$(HC) --make $< -o $@ $(HCFLAGS) -XForeignFunctionInterface
    +	$(HC) --make $< -o $@ $(HCFLAGS)