diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Ivan Perez (Keera Studios) 2010-2012
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Ivan Perez nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+import Distribution.Simple
+main = defaultMain
diff --git a/gtk-helpers.cabal b/gtk-helpers.cabal
new file mode 100644
--- /dev/null
+++ b/gtk-helpers.cabal
@@ -0,0 +1,48 @@
+Name:                gtk-helpers
+Version:             0.0.7
+Synopsis:            A collection of auxiliary operations and widgets related to Gtk
+-- Description:         
+Homepage:            http://keera.es/blog/community
+License:             BSD3
+License-file:        LICENSE
+Author:              Ivan Perez
+Maintainer:          ivan.perez@keera.es
+-- Copyright:           
+Stability:           Experimental
+Category:            Graphics
+Build-type:          Simple
+-- Extra-source-files:  
+Cabal-version:       >=1.2
+
+Library
+  Build-depends:       base >= 4 && < 5,
+                       template-haskell, process, gtk, gio, glib, mtl, array
+
+  hs-source-dirs:      src/
+
+  -- Build-tools:         
+  ghc-options: -Wall
+
+  -- Exposed-modules:     
+  exposed-modules: Data.Board.GameBoardIO
+                 , Game.Board.BasicTurnGame
+                 , Graphics.UI.Gtk.Board.TiledBoard
+                 , Graphics.UI.Gtk.Board.BoardLink
+                 , Graphics.UI.Gtk.Entry.FormatEntry
+                 , Graphics.UI.Gtk.Entry.HighlightedEntry
+                 , Graphics.UI.Gtk.Extra.Builder
+                 , Graphics.UI.Gtk.Extra.BuilderTH
+                 , Graphics.UI.Gtk.Helpers.Combo
+                 , Graphics.UI.Gtk.Helpers.FileDialog
+                 , Graphics.UI.Gtk.Helpers.MenuItem
+                 , Graphics.UI.Gtk.Helpers.MessageDialog
+                 , Graphics.UI.Gtk.Helpers.ModelViewNotebookSync
+                 , Graphics.UI.Gtk.Helpers.ModelViewPath
+                 , Graphics.UI.Gtk.Helpers.Multiline.TextBuffer
+                 , Graphics.UI.Gtk.Helpers.Pixbuf
+                 , Graphics.UI.Gtk.Helpers.TreeView
+                 , Graphics.UI.Gtk.Layout.BackgroundContainer
+                 , Graphics.UI.Gtk.Layout.DummyBin
+                 , Graphics.UI.Gtk.Layout.EitherWidget
+                 , Graphics.UI.Gtk.Layout.MaybeWidget
+                 , System.Application
diff --git a/src/Data/Board/GameBoardIO.hs b/src/Data/Board/GameBoardIO.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Board/GameBoardIO.hs
@@ -0,0 +1,89 @@
+module Data.Board.GameBoardIO where
+
+import Control.Monad
+import Data.Array.IO
+import Data.Maybe
+
+data GameBoard index e = GameBoard (IOArray (index,index) (Maybe e))
+
+gameBoardNew :: (Ix index) => [(index, index, e)] -> IO (GameBoard index e)
+gameBoardNew es = do
+    gameBoardNewWithBoundaries boundaries es
+  where indexList  = map (\(i,j,_) -> (i,j)) es
+        boundaries = listBoundaries indexList
+
+gameBoardNewWithBoundaries :: (Ix index) => ((index, index), (index, index)) -> [(index, index, e)] -> IO (GameBoard index e)
+gameBoardNewWithBoundaries boundaries es = do
+    array <- newArray boundaries Nothing
+    mapM_ (\(i,j,e) -> writeArray array (i,j) (Just e)) es
+    return $ GameBoard array
+
+gameBoardNewEmptySquare :: (Num index, Ix index) => index -> index -> IO (GameBoard index e)
+gameBoardNewEmptySquare iX jX = do
+    array <- newArray ((0,0),(iX,jX)) Nothing
+    return $ GameBoard array
+
+gameBoardNewEmpty :: Ix index => [(index, index)] -> IO (GameBoard index e)
+gameBoardNewEmpty es = do
+    array <- newArray (listBoundaries es) Nothing
+    return $ GameBoard array
+
+listBoundaries :: Ix index => [(index,index)] -> ((index,index),(index,index))
+listBoundaries ((ix,jx):es) = foldr updateBoundaries ((ix,jx),(ix,jx)) es
+  where updateBoundaries (x,y) ((minX,minY),(maxX,maxY)) = ((minX',minY'),(maxX',maxY'))
+         where minX' = if x < minX then x else minX
+               minY' = if y < minY then y else minY
+               maxX' = if x > maxX then x else maxX
+               maxY' = if y > maxY then y else maxY
+
+gameBoardSetPiece :: Ix index => (index, index) -> e -> GameBoard index e -> IO () -- GameBoard index e)
+gameBoardSetPiece pos e (GameBoard board) =
+  writeArray board pos (Just e)
+
+gameBoardGetPiece :: Ix index => (index, index) -> GameBoard index e -> IO (Maybe e)
+gameBoardGetPiece pos (GameBoard board) =
+  readArray board pos
+
+gameBoardRemovePiece :: Ix index => (index, index) -> GameBoard index e -> IO () -- GameBoard index e)
+gameBoardRemovePiece pos (GameBoard board) =
+  writeArray board pos Nothing
+
+gameBoardMovePiece :: Ix index => (index, index) -> (index, index) -> GameBoard index e -> IO () -- GameBoard index e)
+gameBoardMovePiece posO posD gb = do
+  piece <- gameBoardGetPiece posO gb
+  maybe (return ()) (\piece' -> do
+    gameBoardRemovePiece posO gb
+    gameBoardSetPiece posD piece' gb) piece
+
+gameBoardFoldM :: (Ix index) => GameBoard index a -> (b -> ((index,index), a) -> IO b) -> b -> IO b
+gameBoardFoldM (GameBoard array) f def = do
+  assocs <- getAssocs array
+  let assocs' = map (\(x,y) -> (x,fromJust y)) $ filter (isJust . snd) assocs
+  foldM f def assocs'
+
+gameBoardMapM_ :: (Ix index) => GameBoard index a -> ((index,index) -> a -> IO ()) -> IO ()
+gameBoardMapM_ (GameBoard array) f =
+  arrayMapM_ array f'
+ where f' x e = maybe (return ()) (f x) e
+
+arrayMapM_ :: (Ix index) => IOArray index a -> (index -> a -> IO ()) -> IO ()
+arrayMapM_ array f = do
+  assocs <- getAssocs array
+  mapM_ (uncurry f) assocs
+
+gameBoardClear :: (Ix index) => GameBoard index a -> IO()
+gameBoardClear board@(GameBoard array) = do
+  ((xm, ym), (xM, yM)) <- getBounds array
+  forM_ (range (xm, xM)) $ \x -> 
+    forM_ (range (ym, yM)) $ \y ->
+      gameBoardRemovePiece (x,y) board
+
+gameBoardGetBoundaries :: (Ix index) => GameBoard index a -> IO ((index,index),(index,index))
+gameBoardGetBoundaries (GameBoard array) = getBounds array
+
+gameBoardClone :: (Ix index) => GameBoard index a -> IO (GameBoard index a)
+gameBoardClone (GameBoard array) = do
+  bounds <- getBounds array
+  assocs <- getAssocs array
+  let assocs' = [(ix,iy,e) | ((ix,iy), Just e) <- assocs]
+  gameBoardNewWithBoundaries bounds assocs'
diff --git a/src/Game/Board/BasicTurnGame.hs b/src/Game/Board/BasicTurnGame.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Board/BasicTurnGame.hs
@@ -0,0 +1,61 @@
+{-# Language MultiParamTypeClasses, FunctionalDependencies #-}
+
+module Game.Board.BasicTurnGame where
+
+import Data.Ix
+import Data.Maybe
+
+data GameChange index player piece 
+  = AddPiece (index, index) player piece
+  | RemovePiece (index, index)
+  | MovePiece (index, index) (index, index)
+
+-- FIXME: Wrong data structure => use unmutable matrices
+hasPiece :: Ix index => GameState index tile player piece -> (index, index) -> Bool
+hasPiece game ix = isJust (getPieceAt game ix)
+
+getPieceAt :: Ix index => GameState index tile player piece -> (index, index) -> Maybe (player, piece)
+getPieceAt game (posX, posY) = 
+  listToMaybe [(player, piece) | (x, y, player, piece) <- boardPieces' game
+                               , x == posX
+                               , y == posY]
+  
+
+data GameState index tile player piece = GameState
+  { curPlayer'   :: player
+  , boardPos     :: [(index, index, tile)]
+  , boardPieces' :: [(index, index, player, piece)]
+  }
+
+class PlayableGame a index tile player piece | a -> index, a -> tile, a -> player, a -> piece where
+
+  curPlayer :: a -> player
+  allPieces :: a -> [(index, index, player, piece)]
+  allPos    :: a -> [(index, index, tile)]
+
+  moveEnabled     :: a -> Bool
+  moveEnabled _ = False
+
+  canMove         :: a -> player -> (index, index) -> Bool
+  canMove _ _ _ = False
+
+  canMoveTo       :: a -> player -> (index, index) -> (index, index) -> Bool
+  canMoveTo _ _ _ _ = False
+
+  move            :: a -> player -> (index, index) -> (index, index) -> [GameChange index player piece]
+  move _ _ _ _ = []
+
+  activateEnabled :: a -> Bool
+  activateEnabled _ = False
+
+  canActivate     :: a -> player -> (index, index) -> Bool
+  canActivate _ _ _ = False
+
+  activate        :: a -> player -> (index, index) -> [GameChange index player piece]
+  activate _ _ _ = []
+
+  applyChange     :: a -> GameChange index player piece -> a
+  applyChange g _ = g
+
+  applyChanges    :: a -> [GameChange index player piece] -> a
+  applyChanges a ls = foldl applyChange a ls
diff --git a/src/Graphics/UI/Gtk/Board/BoardLink.hs b/src/Graphics/UI/Gtk/Board/BoardLink.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Board/BoardLink.hs
@@ -0,0 +1,67 @@
+{-# Language MultiParamTypeClasses, FunctionalDependencies #-}
+
+module Graphics.UI.Gtk.Board.BoardLink where
+
+import Control.Monad
+import Data.IORef
+import Data.Ix
+import Data.Maybe
+import Game.Board.BasicTurnGame
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.Board.TiledBoard
+
+
+attachGameRules :: (PlayableGame pg index tile player piece, Ix index)
+                => Game pg index tile player piece -> IO (Board index tile (player, piece))
+attachGameRules game = do
+  board <- boardNew (allPos $ gameS game) (tileF $ visual game) (pieceF $ visual game)
+
+  let (r,g,b) = bgColor (visual game)
+      (r', g', b') = (fromIntegral r, fromIntegral g, fromIntegral b)
+  mapM_ (\s -> widgetModifyBg board s (Color r' g' b')) [StateNormal, StateActive, StatePrelight, StateSelected]
+  when (isJust (bg $ visual game)) $ boardSetBackground board (bg $ visual game)
+
+  vgRef <- newIORef game
+
+  -- Set the initial board state
+  mapM_ (\(x,y) -> boardSetPiece x y board) $ [((x,y),(pl,pc)) | (x,y,pl,pc) <- allPieces (gameS game)]
+
+  board `boardOnPieceDragStart` \pos -> do
+    visualGame <- readIORef vgRef
+    let game' = gameS visualGame
+    return (moveEnabled game' && canMove game' (curPlayer game') pos)
+
+  board `boardOnPieceDragOver` \posF posT -> do
+    visualGame <- readIORef vgRef
+    let game' = gameS visualGame
+    return (moveEnabled game' && canMoveTo game' (curPlayer game') posF posT)
+
+  board `boardOnPieceDragDrop` \posF posT -> do
+    visualGame <- readIORef vgRef
+    let game'  = gameS visualGame
+        moves  = move game' (curPlayer game') posF posT
+        game'' = foldl applyChange game' moves
+    writeIORef vgRef (visualGame { gameS = game'' })
+    forM_ moves (applyBoardChange board)
+    
+  when (moveEnabled (gameS game)) $ boardEnableDrag board
+
+  return board
+
+applyBoardChange :: Ix index => Board index tile (player, piece) -> GameChange index player piece -> IO ()
+applyBoardChange board (AddPiece pos player piece) = boardSetPiece pos (player, piece) board
+applyBoardChange board (RemovePiece pos)           = boardRemovePiece pos board
+applyBoardChange board (MovePiece posO posD)       = boardMovePiece posO posD board
+
+data VisualGameAspects index tile player piece = VisualGameAspects
+  { tileF   :: PixmapsFor tile
+  , pieceF  :: PixmapsFor (player, piece)
+  , bgColor :: (Int, Int, Int)
+  , bg      :: Maybe (Pixbuf, SizeAdjustment)
+  } 
+
+
+data Game pg index tile player piece = Game
+  { visual :: VisualGameAspects index tile player piece
+  , gameS  :: pg
+  }
diff --git a/src/Graphics/UI/Gtk/Board/TiledBoard.hs b/src/Graphics/UI/Gtk/Board/TiledBoard.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Board/TiledBoard.hs
@@ -0,0 +1,403 @@
+module Graphics.UI.Gtk.Board.TiledBoard where
+
+import Control.Monad (when, void)
+import Control.Monad.Trans (liftIO)
+import Data.Array.IO
+import Data.IORef
+import Data.Maybe (isJust, fromJust)
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.Gdk.GC (gcNew)
+import System.Glib.Types
+
+-- Local imports
+import Data.Board.GameBoardIO
+
+data Board index tile piece = Board
+  { boardDrawingArea  :: DrawingArea
+  , boardTiles        :: GameBoard index tile
+  , boardPieces       :: GameBoard index piece
+  , tilePixmaps       :: PixmapsFor tile
+  , piecePixmaps      :: PixmapsFor piece
+  , tileSize          :: (Int, Int)
+  , background        :: IORef (Maybe (Pixbuf, SizeAdjustment))
+  , overlay           :: IORef (Maybe (Pixbuf, SizeAdjustment))
+  , dragEnabled       :: IORef Bool
+  , draggingFrom      :: IORef (Maybe (index, index))
+  , draggingTo        :: IORef (Maybe (index, index))
+  , draggingMouseOrig :: IORef (Maybe (Int, Int))
+  , draggingMousePos  :: IORef (Maybe (Int, Int))
+  , movingStatus      :: IORef (Maybe (MovingStatus index))
+  }
+
+data MovingStatus index = MovingStatus
+  { movingFrom   :: (index, index)
+  , movingTo     :: (index, index)
+  , stepsPerUnit :: Double
+  , timePerUnit  :: Double
+  , movingStep   :: Double
+  }
+
+instance WidgetClass (Board index tile piece)
+instance ObjectClass (Board index tile piece)
+instance GObjectClass (Board index tile piece) where
+  toGObject           = toGObject . boardDrawingArea
+  unsafeCastGObject x = Board (unsafeCastGObject x) undefined undefined undefined undefined undefined undefined undefined undefined undefined undefined undefined undefined undefined
+
+type PixmapsFor a = a -> Pixbuf
+
+data SizeAdjustment = SizeAdjustment
+
+boardNew :: Ix index
+         => [(index,index,tile)] -> PixmapsFor tile -> PixmapsFor piece
+         -> IO (Board index tile piece)
+boardNew tileList tilePixs piecePixs = do
+  da <- drawingAreaNew
+
+  tb <- gameBoardNew tileList
+  pb <- gameBoardNewEmpty (map (\(x,y,_) -> (x,y)) tileList)
+
+  ts <- getTileSize tileList tilePixs
+
+  bg <- newIORef Nothing
+  ov <- newIORef Nothing
+
+  dragging  <- newIORef False
+  draggingF <- newIORef Nothing
+  draggingT <- newIORef Nothing
+  draggingO <- newIORef Nothing
+  draggingP <- newIORef Nothing
+
+  movingSt <- newIORef Nothing
+
+  let board = Board da tb pb tilePixs piecePixs ts bg ov
+                    dragging draggingF draggingT draggingO draggingP
+                    movingSt
+
+  (pixW, pixH) <- boardGetPixelSize board
+
+  da `on` realize $ widgetSetSizeRequest da pixW pixH
+  da `on` exposeEvent $ liftIO (boardRefresh board) >> return False
+
+  return board
+
+getTileSize :: [(index, index, tile)] -> PixmapsFor tile -> IO (Int, Int)
+getTileSize []          _    = return (0,0)
+getTileSize ((_,_,t):_) pixs = do
+  let pb = pixs t
+  w  <- pixbufGetWidth pb
+  h  <- pixbufGetHeight pb
+  return (w,h)
+
+boardGetPiece :: Ix index => (index, index) -> Board index tile piece -> IO (Maybe piece)
+boardGetPiece pos board = gameBoardGetPiece pos (boardPieces board)
+
+boardSetPiece :: Ix index => (index, index) -> piece -> Board index tile piece -> IO ()
+boardSetPiece pos piece board = do
+  boardSetPieceNoRefresh pos piece board
+  boardInvalidate board
+--   boardRefresh board
+
+boardSetPieceNoRefresh :: Ix index => (index, index) -> piece -> Board index tile piece -> IO ()
+boardSetPieceNoRefresh pos piece board = do
+  -- check that there's a tile there
+  posOk <- fmap isJust $ gameBoardGetPiece pos $ boardTiles board
+  when posOk $ do
+    -- if there is, place the piece on the pieces board
+    gameBoardSetPiece pos piece (boardPieces board) 
+
+boardRemovePiece :: Ix index => (index, index) -> Board index tile piece -> IO ()
+boardRemovePiece pos board = do
+  -- check that there's a tile there
+  posOk <- fmap isJust $ gameBoardGetPiece pos $ boardTiles board
+  when posOk $ do
+    -- if there is, remove the piece from the pieces board
+    gameBoardRemovePiece pos (boardPieces board) 
+    -- refresh the image
+    boardInvalidate board
+    -- boardRefresh board
+
+boardMovePiece :: Ix index => (index, index) -> (index, index) -> Board index tile piece -> IO ()
+boardMovePiece posO posD board = do
+  -- check that there's a tile there
+  posOrigOk <- fmap isJust $ gameBoardGetPiece posO $ boardTiles board
+  posDestOk <- fmap isJust $ gameBoardGetPiece posD $ boardTiles board
+  when (posOrigOk && posDestOk) $ do
+    -- Move the piece
+    gameBoardMovePiece posO posD $ boardPieces board
+    -- Refresh the UI
+    boardInvalidate board
+    -- boardRefresh board
+
+boardInvalidate :: Ix index => Board index tile piece -> IO ()
+boardInvalidate = widgetQueueDraw 
+
+boardRefresh :: Ix index => Board index tile piece -> IO ()
+boardRefresh board = do 
+  realized <- widgetGetRealized board
+  when realized $ do
+    dw <- widgetGetDrawWindow (boardDrawingArea board)
+  
+    (w,h) <- widgetGetSize (boardDrawingArea board)
+
+    bg <- readIORef (background board)
+    ov <- readIORef (overlay board)
+  
+    drawWindowBeginPaintRect dw (Rectangle 0 0 w h)
+  
+    -- Clear Drawing area
+    drawWindowClear dw
+    gc <- gcNew dw
+    when (isJust bg) $ do
+      ((posBgX, posBgY), bg') <- uncurry (adjustPixbuf (w,h)) (fromJust bg)
+      drawPixbuf dw gc bg' 0 0 posBgX posBgY (-1) (-1) RgbDitherNone (-1) (-1)
+
+    -- Dragging status (used to determine what to draw)
+    posM   <- readIORef (draggingFrom board)
+    mpOrig <- readIORef (draggingMouseOrig board)
+    mpPos  <- readIORef (draggingMousePos board)
+
+    -- Draw tiles
+    drawPixmaps dw (tileSize board) (boardTiles board) (tilePixmaps board)
+  
+    -- Draw Pieces
+    piecesBoard <- if isJust posM && isJust mpOrig && isJust mpPos
+                    then do pieces' <- gameBoardClone $ boardPieces board
+                            gameBoardRemovePiece (fromJust posM) pieces'
+                            return pieces'
+                    else return $ boardPieces board
+             
+    -- drawPixmaps dw (tileSize board) (boardPieces board) (piecePixmaps board)
+    drawPixmaps dw (tileSize board) piecesBoard (piecePixmaps board)
+
+    -- Draw moving piece
+    when (isJust posM && isJust mpOrig && isJust mpPos) $ do
+      pieceM <- boardGetPiece (fromJust posM) board
+      when (isJust pieceM) $ do
+        let pb = piecePixmaps board (fromJust pieceM)
+        let (mpPosX, mpPosY)   = fromJust mpPos
+            (mpOrigX, mpOrigY) = fromJust mpOrig
+            (x,y) = (mpPosX - mpOrigX, mpPosY - mpOrigY)
+        drawPixbuf dw gc pb 0 0 x y (-1) (-1) RgbDitherNone (-1) (-1)
+
+    when (isJust ov) $ do
+      ((posOvX, posOvY), ov') <- uncurry (adjustPixbuf (w,h)) (fromJust ov)
+      drawPixbuf dw gc ov' 0 0 posOvX posOvY (-1) (-1) RgbDitherNone (-1) (-1)
+  
+    drawWindowEndPaint dw
+
+-- FIXME: To be completed
+adjustPixbuf :: (Int, Int) -> Pixbuf -> SizeAdjustment -> IO ((Int, Int), Pixbuf)
+adjustPixbuf _ pb _ = return ((0,0), pb)
+
+mouseMotionHandler :: Ix index => Board index tile piece -> ((index, index) -> EventM EMotion Bool) -> EventM EMotion Bool
+mouseMotionHandler board p = do
+  coords <- eventCoordinates
+  pos <- liftIO $ getMouseCoordinates board coords
+  maybe (return False) p pos
+
+mouseButtonHandler :: Ix index => Board index tile piece -> ((index, index) -> EventM EButton Bool) -> EventM EButton Bool
+mouseButtonHandler board p = do
+  coords <- eventCoordinates
+  pos <- liftIO $ getMouseCoordinates board coords
+  maybe (return False) p pos
+
+getMouseCoordinates :: Ix index => Board index tile piece -> (Double, Double) -> IO (Maybe (index, index))
+getMouseCoordinates board (x,y) = do
+  let (tileW, tileH) = tileSize board
+      tileCol = round x `div` tileW
+      tileRow = round y `div` tileH
+  let (GameBoard array) = boardTiles board
+  ((xm, ym), (xM, yM)) <- getBounds $ array
+  let xs = range (xm, xM)
+      ys = range (ym, yM)
+  if (inRange (0, length xs - 1) tileCol && inRange (0, length ys - 1) tileRow)
+      then return $ Just ((head (drop tileCol xs)), (head (drop tileRow ys)))
+      else return Nothing
+
+clickHandler :: Ix index => Board index tile piece -> ((index, index) -> IO ()) -> EventM EButton Bool
+clickHandler board p = do
+  (x,y) <- eventCoordinates
+  liftIO $ do
+    let (tileW, tileH) = tileSize board
+        tileCol = round x `div` tileW
+        tileRow = round y `div` tileH
+    let (GameBoard array) = boardTiles board
+    ((xm, ym), (xM, yM)) <- getBounds $ array
+    let xs = range (xm, xM)
+        ys = range (ym, yM)
+    when (inRange (0, length xs - 1) tileCol && inRange (0, length ys - 1) tileRow) $
+      p ((head (drop tileCol xs)), (head (drop tileRow ys)))
+    return False
+    
+boardGetPixelSize :: Ix index => Board index tile piece -> IO (Int, Int)
+boardGetPixelSize board = do
+  let (GameBoard array) = boardTiles board
+
+  ((xm, ym), (xM, yM)) <- getBounds $ array
+  let htiles = rangeSize (xm, xM)
+      vtiles = rangeSize (ym, yM)
+      (tileW, tileH) = tileSize board
+
+  return (htiles * tileW, vtiles * tileH)
+
+drawPixmaps :: (Ix index, DrawableClass d) => d -> (Int, Int) -> GameBoard index e -> PixmapsFor e -> IO()
+drawPixmaps d tileSize@(tw, th) gameBoard@(GameBoard array) pixmaps = do
+  gc <- gcNew d
+  ((xm, ym), (xM, yM)) <- gameBoardGetBoundaries gameBoard
+
+  let paintPixmap (x,y) elem = do
+          let pixmap = pixmaps elem
+              ix     = index (xm, xM) x
+              iy     = index (ym, yM) y
+              posX   = ix * tw
+              posY   = iy * th
+          drawPixbuf d gc pixmap 0 0 posX posY (-1) (-1) RgbDitherNone (-1) (-1)
+      
+  gameBoardMapM_ gameBoard paintPixmap
+
+boardFoldM :: (Ix index) => Board index tile piece -> (b -> ((index,index), piece) -> IO b) -> b -> IO b
+boardFoldM board f def = gameBoardFoldM (boardPieces board) f def
+
+boardClear :: Ix index => Board index tile piece -> IO ()
+boardClear board = do
+  gameBoardClear (boardPieces board)
+  boardInvalidate board
+
+boardLoad :: Ix index => Board index tile piece -> [((index, index), piece)] -> IO()
+boardLoad board pieces = do
+  gameBoardClear (boardPieces board)
+  mapM_ (\(pos, piece) -> boardSetPieceNoRefresh pos piece board) pieces
+  boardRefresh board
+
+boardOnClick :: Ix index => Board index tile piece -> ((index, index) -> IO ()) -> IO()
+boardOnClick board p = boardOnPress board (\c -> liftIO (p c) >> return False)
+
+boardOnPress :: Ix index => Board index tile piece -> ((index, index) -> EventM EButton Bool) -> IO()
+boardOnPress board f = void $ do
+  widgetAddEvents (boardDrawingArea board) [ButtonPressMask]
+  (boardDrawingArea board) `on` buttonPressEvent $ mouseButtonHandler board f
+
+boardOnRelease :: Ix index => Board index tile piece -> ((index, index) -> EventM EButton Bool) -> IO()
+boardOnRelease board f = void $ do
+  widgetAddEvents (boardDrawingArea board) [ButtonPressMask, ButtonReleaseMask]
+  (boardDrawingArea board) `on` buttonReleaseEvent $ mouseButtonHandler board f
+
+boardOnMotion :: Ix index => Board index tile piece -> ((index, index) -> EventM EMotion Bool) -> IO()
+boardOnMotion board f =  void $ do
+  widgetAddEvents board [PointerMotionMask]
+  (boardDrawingArea board) `on` motionNotifyEvent $ mouseMotionHandler board f
+
+boardSetBackground :: Ix index => Board index tile piece -> Maybe (Pixbuf, SizeAdjustment) -> IO()
+boardSetBackground board bg = do
+  writeIORef (background board) bg
+  boardInvalidate board
+
+boardSetOverlay :: Ix index => Board index tile piece -> Maybe (Pixbuf, SizeAdjustment) -> IO()
+boardSetOverlay board bg = do
+  writeIORef (overlay board) bg
+  boardInvalidate board
+
+boardEnableDrag :: Ix index => Board index tile piece -> IO()
+boardEnableDrag board = writeIORef (dragEnabled board) True
+
+boardDisableDrag :: Ix index => Board index tile piece -> IO()
+boardDisableDrag board = do
+  writeIORef (dragEnabled board) False
+  boardInvalidate board
+
+boardStartDrag :: Ix index => Board index tile piece -> (index, index) -> IO()
+boardStartDrag board ix@(i,j) = do
+  writeIORef (draggingFrom board) (Just ix)
+  ((xm, ym), (xM, yM)) <- gameBoardGetBoundaries $ boardPieces board
+  let (w,h) = tileSize board
+      x     = round ((0.5 + fromIntegral (rangeSize (xm, i))) * fromIntegral w)
+      y     = round ((0.5 + fromIntegral (rangeSize (ym, j))) * fromIntegral h)
+  writeIORef (draggingMouseOrig board) (Just (x, y))
+
+boardStopDrag :: Ix index => Board index tile piece -> IO()
+boardStopDrag board = do
+  writeIORef (draggingFrom board) Nothing
+  writeIORef (draggingTo board) Nothing
+  boardInvalidate board
+
+boardOnPieceDragStart :: Ix index => Board index tile piece -> ((index, index) -> IO Bool) -> IO()
+boardOnPieceDragStart board f = boardOnPress board $ \ix -> do
+  (x,y) <- eventCoordinates
+  returning False $ liftIO $ do
+    drag <- readIORef (dragEnabled board)
+    when drag $ do
+      canDragThis <- f ix
+      let from = if canDragThis then Just ix else Nothing
+          orig = if canDragThis then Just (relativePos board ix (round x, round y)) else Nothing
+      writeIORef (draggingFrom board) from
+      writeIORef (draggingMouseOrig board) orig
+      boardInvalidate board
+
+boardOnPieceDragOver :: Ix index => Board index tile piece -> ((index, index) -> (index, index) -> IO Bool) -> IO()
+boardOnPieceDragOver board f = boardOnMotion board $ \ix -> do
+  (x,y) <- eventCoordinates
+  returning False $ liftIO $ do
+    drag  <- readIORef (dragEnabled board)
+    origM <- readIORef (draggingFrom board)
+    when (drag && isJust origM) $ do
+      canDropHere <- f (fromJust origM) ix
+      let newDest = if canDropHere then Just ix else Nothing
+      writeIORef (draggingTo board) newDest
+      writeIORef (draggingMousePos board) (Just (round x, round y))
+    boardInvalidate board
+
+boardOnPieceDragDrop :: Ix index => Board index tile piece -> ((index, index) -> (index, index) -> IO ()) -> IO()
+boardOnPieceDragDrop board f = void $ do
+  widgetAddEvents (boardDrawingArea board) [ButtonPressMask, ButtonReleaseMask]
+  (boardDrawingArea board) `on` buttonReleaseEvent $ returning False $ liftIO $ do
+    drag  <- readIORef (dragEnabled board)
+    origM <- readIORef (draggingFrom board)
+    destM <- readIORef (draggingTo board)
+    let notSame = origM /= destM
+    when (drag && isJust origM) $ do
+
+      -- No longer dragging
+      writeIORef (draggingFrom board)      Nothing
+      writeIORef (draggingTo board)        Nothing
+      writeIORef (draggingMouseOrig board) Nothing
+      writeIORef (draggingMousePos board)  Nothing
+
+      -- When possible, call the handler
+      when (isJust destM && notSame) $ f (fromJust origM) (fromJust destM)
+
+      -- In any case, the board must be repainted
+      boardInvalidate board
+
+boardIsDragging :: Ix index => Board index tile piece -> IO Bool
+boardIsDragging = fmap isJust . readIORef . draggingFrom
+
+relativePos :: Ix index => Board index tile piece -> (index, index) -> (Int, Int) -> (Int, Int)
+relativePos board (ix,iy) (x,y) = (x', y')
+ where (w,h) = tileSize board
+       x'    = x `mod` w
+       y'    = y `mod` h
+
+returning :: Monad m => a -> m b -> m a
+returning v f = f >> return v
+
+-- boardLiveMove :: Ix index => (index, index) -> (index, index) -> Board index tile piece -> IO ()
+-- boardLiveMove posO posD board = do
+--   evs <- widgetGetEvents board
+--   
+--   let evs' = undefined
+--   
+--   movingParams <- undefined
+-- 
+--   let timeDelay = undefined
+-- 
+--   writeIORef (movingStatus board) (Just movingParams)
+-- 
+--   -- Set delay and time handler
+--   timeoutAdd (do undefined -- advance moving one step
+--                  boardInvalidate board
+--                  -- return True if not the end, otherwise return False
+--              )
+--              timeDelay
+--              
+--      -- Time Handler includes resetting the event handers
+--   return ()
diff --git a/src/Graphics/UI/Gtk/Entry/FormatEntry.hs b/src/Graphics/UI/Gtk/Entry/FormatEntry.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Entry/FormatEntry.hs
@@ -0,0 +1,76 @@
+module Graphics.UI.Gtk.Entry.FormatEntry
+   ( FormatEntry
+   , formatEntryNew
+   , formatEntryNewWithFunction
+   , formatEntrySetColor
+   , formatEntryGetColor
+   , formatEntrySetCheckFunction
+   , formatEntryGetCheckFunction
+   , formatEntryHasCorrectFormat
+   , formatEntryColor
+   , formatEntryCheckFunction
+   )
+  where
+
+import Control.Monad.Trans (liftIO)
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.Entry.HighlightedEntry
+import System.Glib.Types
+import Data.IORef
+
+-- Higlighted Entries
+data FormatEntry = FormatEntry HighlightedEntry (IORef FormatEntryParams)
+type FormatEntryParams = String -> Bool
+
+formatEntryNew :: IO FormatEntry
+formatEntryNew = formatEntryNewWithFunction (const True)
+
+formatEntryNewWithFunction :: (String -> Bool) -> IO FormatEntry
+formatEntryNewWithFunction checkF = do
+  entry <- highlightedEntryNew
+  defaultParamsRef <- newIORef checkF
+  let formatEntry = FormatEntry entry defaultParamsRef
+  formatEntry `on` editableChanged $ refreshEntry formatEntry
+  return formatEntry
+
+instance GObjectClass FormatEntry where
+  toGObject (FormatEntry entry _) = toGObject entry
+  unsafeCastGObject o = FormatEntry (unsafeCastGObject o) undefined
+instance ObjectClass FormatEntry
+instance WidgetClass FormatEntry
+instance EntryClass FormatEntry
+instance EditableClass FormatEntry
+
+formatEntrySetColor :: FormatEntry -> Color -> IO ()
+formatEntrySetColor (FormatEntry e _) color = highlightedEntrySetColor e color
+
+formatEntryGetColor :: FormatEntry -> IO Color
+formatEntryGetColor (FormatEntry e _) = highlightedEntryGetColor e
+
+formatEntrySetCheckFunction :: FormatEntry -> (String -> Bool) -> IO ()
+formatEntrySetCheckFunction fe@(FormatEntry _ params) checkF = do
+  writeIORef params checkF
+  refreshEntry fe
+
+formatEntryGetCheckFunction :: FormatEntry -> IO (String -> Bool)
+formatEntryGetCheckFunction (FormatEntry _ params) =
+  readIORef params
+
+-- Repaints the entry using the current color, or resets the
+-- default style if no warning has to be given
+refreshEntry :: FormatEntry -> IO()
+refreshEntry f@(FormatEntry entry params) = do
+  correct <- formatEntryHasCorrectFormat f
+  highlightedEntrySetStatus entry (not correct)
+
+formatEntryColor :: Attr FormatEntry Color
+formatEntryColor = newAttr formatEntryGetColor formatEntrySetColor
+
+formatEntryCheckFunction :: Attr FormatEntry (String -> Bool)
+formatEntryCheckFunction = newAttr formatEntryGetCheckFunction formatEntrySetCheckFunction
+
+formatEntryHasCorrectFormat :: FormatEntry -> IO Bool
+formatEntryHasCorrectFormat f = do
+  text <- entryGetText f
+  func <- formatEntryGetCheckFunction f
+  return $ func text
diff --git a/src/Graphics/UI/Gtk/Entry/HighlightedEntry.hs b/src/Graphics/UI/Gtk/Entry/HighlightedEntry.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Entry/HighlightedEntry.hs
@@ -0,0 +1,71 @@
+module Graphics.UI.Gtk.Entry.HighlightedEntry
+   ( HighlightedEntry
+   , highlightedEntryNew
+   , highlightedEntrySetColor
+   , highlightedEntryGetColor
+   , highlightedEntrySetStatus
+   , highlightedEntryGetStatus
+   , highlightedEntryColor
+   , highlightedEntryStatus
+   )
+  where
+
+import Control.Monad.Trans (liftIO)
+import Graphics.UI.Gtk
+import System.Glib.Types
+import Data.IORef
+
+-- Higlighted Entries
+data HighlightedEntry = HighlightedEntry Entry (IORef HighlightedEntryParams)
+type HighlightedEntryParams = (Color, Bool)
+
+highlightedEntryNew :: IO HighlightedEntry
+highlightedEntryNew = do
+  entry <- entryNew
+  defaultParamsRef <- newIORef (Color 65000 32000 32000, False)
+  return $ HighlightedEntry entry defaultParamsRef
+
+instance GObjectClass HighlightedEntry where
+  toGObject (HighlightedEntry entry _) = toGObject entry
+  unsafeCastGObject o = HighlightedEntry (unsafeCastGObject o) undefined
+instance ObjectClass HighlightedEntry
+instance WidgetClass HighlightedEntry
+instance EntryClass HighlightedEntry
+
+highlightedEntrySetStatus :: HighlightedEntry -> Bool -> IO ()
+highlightedEntrySetStatus he@(HighlightedEntry _ params) status = do
+  modifyIORef params (\(c,_) -> (c,status))
+  refreshBaseColor he
+
+highlightedEntryGetStatus :: HighlightedEntry -> IO Bool
+highlightedEntryGetStatus (HighlightedEntry _ params) = do
+  (_,status) <- readIORef params
+  return status
+
+highlightedEntrySetColor :: HighlightedEntry -> Color -> IO ()
+highlightedEntrySetColor he@(HighlightedEntry _ params) color = do
+  modifyIORef params (\(_, s) -> (color, s))
+  refreshBaseColor he
+
+highlightedEntryGetColor :: HighlightedEntry -> IO Color
+highlightedEntryGetColor (HighlightedEntry _ params) = do
+  (color, _) <- readIORef params
+  return color
+
+-- Repaints the entry using the current color, or resets the
+-- default style if no warning has to be given
+refreshBaseColor :: HighlightedEntry -> IO()
+refreshBaseColor (HighlightedEntry entry params) = do
+  (color, status) <- readIORef params
+  if status
+   then mapM_ (\s -> widgetModifyBase entry s color) sensitiveStates
+   else mapM_ (widgetRestoreBase entry) sensitiveStates
+ where sensitiveStates = [ StateNormal, StateActive
+                         , StateSelected, StatePrelight
+                         ]
+
+highlightedEntryStatus :: Attr HighlightedEntry Bool
+highlightedEntryStatus = newAttr highlightedEntryGetStatus highlightedEntrySetStatus
+
+highlightedEntryColor :: Attr HighlightedEntry Color
+highlightedEntryColor = newAttr highlightedEntryGetColor highlightedEntrySetColor
diff --git a/src/Graphics/UI/Gtk/Extra/Builder.hs b/src/Graphics/UI/Gtk/Extra/Builder.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Extra/Builder.hs
@@ -0,0 +1,39 @@
+-- | A collection of small functions to help retrieve
+-- information from Glade files.
+
+module Graphics.UI.Gtk.Extra.Builder
+   ( fromBuilder
+   , loadInterface
+   )
+  where
+
+import Graphics.UI.Gtk
+
+-- | Graphics.UI.Gtk.builderGetObject with the arguments flipped
+-- (Builder goes last).
+fromBuilder :: (GObjectClass cls) =>
+               (GObject -> cls) -> String -> Builder -> IO cls
+fromBuilder f s b = builderGetObject b f s
+
+-- | Returns a builder from which the objects in this part of the interface
+-- can be accessed.
+loadInterface :: String -> IO Builder
+loadInterface fn = builderNew `incidentallyM` (`builderAddFromFile` fn)
+-- It can be written in point-free style, but I'm not sure it's
+-- clearer
+-- loadInterface = incidentallyM builderNew . flip builderAddFromFile
+
+-- -- | Returns a builder from which the objects in this part of the interface
+-- --
+-- -- can be accessed.
+-- loadInterface :: String -> IO Builder
+-- loadInterface builderPath = do
+--   builder <- builderNew
+--   builderAddFromFile builder builderPath
+--   return builder
+
+-- | Sequences two monadic computations and returns the
+-- result of the first.
+incidentallyM :: Monad m => m a -> (a -> m b) -> m a 
+incidentallyM op f = op >>= (\x -> (f x >> return x))
+ 
diff --git a/src/Graphics/UI/Gtk/Extra/BuilderTH.hs b/src/Graphics/UI/Gtk/Extra/BuilderTH.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Extra/BuilderTH.hs
@@ -0,0 +1,64 @@
+-- | This module allows you to access Glade objects from
+-- a Gtk Builder by providing the builder, the type of the
+-- object and the name (the cast operation is deduced
+-- automatically from the type name).
+--
+-- It uses Graphics.UI.Gtk.Builder.onBuilder to access a
+-- glade object using TH.
+
+module Graphics.UI.Gtk.Extra.BuilderTH
+  ( gtkBuilderAccessor
+  , gtkViewAccessor
+  , fromBuilder
+  )
+ where
+
+import Graphics.UI.Gtk.Extra.Builder (fromBuilder)
+import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Lib
+
+-- | Accessor for Glade objects from Gtk Builders by name and
+-- type.
+gtkBuilderAccessor :: String -> String -> Q [Dec]
+gtkBuilderAccessor name kind = sequenceQ
+  -- Declaration
+  [ sigD funcName
+         -- Builder -> IO Kind
+         (appT (appT arrowT (conT (mkName "Builder")))           
+               (appT (conT (mkName "IO")) (conT (mkName kind))))
+  -- Implementation
+  , funD funcName                                                 
+         -- castedOnBuilder objectName
+         [clause [] (normalB (appE castedAccess                   
+                                   (litE (stringL name)))) []]
+  ]
+
+  where castedAccess = appE (varE (mkName "fromBuilder")) casting
+        casting      = varE (mkName ("castTo" ++ kind))
+        funcName     = mkName name
+
+-- | Accessor for Glade objects from Gtk Builders encapsulated in
+-- Views, by name and -- type.
+gtkViewAccessor :: String -> String -> String -> String -> Q [Dec]
+gtkViewAccessor builderModule uiAccessor name kind = sequenceQ
+  -- Declaration
+  [ sigD funcName
+         -- Builder -> IO Kind
+         (appT (appT arrowT (conT (mkName "View")))           
+               (appT (conT (mkName "IO")) (conT (mkName kind))))
+  -- Implementation
+  , funD funcName                                                 
+         -- castedOnBuilder objectName
+         [clause [varP builderName]
+                 (normalB (appE (varE funcNameInBuilder)
+                                (appE (varE (mkName uiAccessor))
+                                      (varE builderName)
+                                )
+                          )) []]
+  ]
+
+  where castedAccess      = appE (varE (mkName "fromBuilder")) casting
+        casting           = varE (mkName ("castTo" ++ kind))
+        funcName          = mkName name
+        funcNameInBuilder = mkName $ builderModule ++ ('.' : name) 
+        builderName       = mkName "b"
diff --git a/src/Graphics/UI/Gtk/Helpers/Combo.hs b/src/Graphics/UI/Gtk/Helpers/Combo.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Helpers/Combo.hs
@@ -0,0 +1,44 @@
+module Graphics.UI.Gtk.Helpers.Combo where
+
+import Data.List
+import Data.Maybe
+import Graphics.UI.Gtk
+
+addTextColumn :: (TreeModelClass (model row), TypedTreeModelClass model)
+                => ComboBox -> model row -> (row -> Maybe String) -> IO()
+addTextColumn cb st f = do
+
+  comboBoxSetModel cb (Just st)
+  renderer <- cellRendererTextNew
+  cellLayoutPackStart cb renderer True
+  cellLayoutSetAttributes cb renderer st $ map (cellText :=).maybeToList.f
+  return ()
+
+type TypedComboBox a = (ComboBox, ListStore a)
+
+typedComboBoxCombo :: TypedComboBox a -> ComboBox
+typedComboBoxCombo = fst
+
+typedComboBoxStore :: TypedComboBox a -> ListStore a
+typedComboBoxStore = snd
+
+typedComboBoxGetSelected :: TypedComboBox a -> IO (Maybe a)
+typedComboBoxGetSelected (cb, ls) = do
+  sel  <- get cb comboBoxActive
+  list <- listStoreToList ls
+  if sel < 0 || length list <= sel
+   then return Nothing
+   else return $ Just $ list!!sel
+
+typedComboBoxGetSelectedUnsafe :: TypedComboBox a -> IO a
+typedComboBoxGetSelectedUnsafe (cb, ls) = do
+  sel  <- get cb comboBoxActive
+  list <- listStoreToList ls
+  return $ list!!sel
+
+typedComboBoxSetSelected :: (Eq a) => TypedComboBox a -> a -> IO ()
+typedComboBoxSetSelected (cb, ls) x = do
+  list <- listStoreToList ls
+  case elemIndex x list of
+   Nothing -> return ()
+   Just ix -> set cb [ comboBoxActive := ix ]
diff --git a/src/Graphics/UI/Gtk/Helpers/FileDialog.hs b/src/Graphics/UI/Gtk/Helpers/FileDialog.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Helpers/FileDialog.hs
@@ -0,0 +1,42 @@
+module Graphics.UI.Gtk.Helpers.FileDialog
+  ( openOpenFileDialog
+  )
+  where
+
+import Graphics.UI.Gtk
+
+type Ext = ([String], String)
+
+-- Auxiliary functions: open file dialogs
+openOpenFileDialog :: String -> [Ext] -> IO (Maybe String)
+openOpenFileDialog title exts = do
+
+  dialog <- fileChooserDialogNew
+              (Just title)           --dialog title
+              Nothing
+              FileChooserActionOpen  --the kind of dialog we want
+              [("gtk-cancel"         --The buttons to display
+               ,ResponseCancel)
+              ,("gtk-ok"
+               , ResponseAccept)]
+
+  ffs <- extsToFilters exts
+  mapM_ (fileChooserAddFilter dialog) ffs
+
+  widgetShow dialog
+  result <- dialogRun dialog
+  res <- case result of
+           ResponseAccept -> fileChooserGetFilename dialog
+           _              -> return Nothing
+  widgetDestroy dialog
+  return res
+
+extsToFilters :: [Ext] -> IO [FileFilter]
+extsToFilters = mapM extToFilter
+
+extToFilter :: Ext -> IO FileFilter
+extToFilter (pats, name) = do
+  ff <- fileFilterNew
+  fileFilterSetName ff name
+  mapM_ (fileFilterAddPattern ff) pats
+  return ff
diff --git a/src/Graphics/UI/Gtk/Helpers/MenuItem.hs b/src/Graphics/UI/Gtk/Helpers/MenuItem.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Helpers/MenuItem.hs
@@ -0,0 +1,6 @@
+module Graphics.UI.Gtk.Helpers.MenuItem where
+
+import Graphics.UI.Gtk
+
+menuItemGetLabel :: MenuItemClass self => self -> IO (Maybe Label)
+menuItemGetLabel = fmap (fmap castToLabel) . binGetChild
diff --git a/src/Graphics/UI/Gtk/Helpers/MessageDialog.hs b/src/Graphics/UI/Gtk/Helpers/MessageDialog.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Helpers/MessageDialog.hs
@@ -0,0 +1,10 @@
+module Graphics.UI.Gtk.Helpers.MessageDialog where
+
+import Graphics.UI.Gtk
+import Control.Monad
+
+popupError :: String -> String -> IO ()
+popupError t s = do
+  md <- messageDialogNew Nothing [DialogModal] MessageError ButtonsOk s
+  set md [ windowTitle := t ]
+  void $ dialogRun md >> widgetDestroy md
diff --git a/src/Graphics/UI/Gtk/Helpers/ModelViewNotebookSync.hs b/src/Graphics/UI/Gtk/Helpers/ModelViewNotebookSync.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Helpers/ModelViewNotebookSync.hs
@@ -0,0 +1,60 @@
+-- | This module provides functions to alter the view in a notebook and a
+-- maybewidget with a notebook inside based on what is selected in a model view
+-- (icon view, list view, tree view)
+--
+-- This pattern appears very often in my programs. I like to use model views to
+-- let the user choose what to see (instead of using the tab pages).
+module Graphics.UI.Gtk.Helpers.ModelViewNotebookSync where
+
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.Helpers.ModelViewPath
+import Graphics.UI.Gtk.Layout.MaybeWidget
+
+-- | Keeps the page of a notebook in sync with the selection in a model view.
+-- It uses an auxiliary function to determine which page to select.
+modelViewNotebookSync :: (ViewWithPathSelection a c, NotebookClass b)
+                            => a -> b -> (TreePath -> Int) -> IO()
+modelViewNotebookSync modelView notebook syncF = do
+  (path, _) <- modelViewGetCursor modelView
+  let page = syncF path
+  notebookSetCurrentPage notebook page
+
+-- | Keeps the page of a notebook in sync with the selection in a model view.
+-- It selects the page with the same number as the element selected in the
+-- model view. If there's more than one selection, or if the model view is not
+-- flat and the selected element is not at the first level, then it selects nothing.
+modelViewNotebookSyncId :: (ViewWithPathSelection a c, NotebookClass b) => a -> b -> IO()
+modelViewNotebookSyncId modelView notebook = do
+  (path, _) <- modelViewGetCursor modelView
+  case path of
+   [page] -> notebookSetCurrentPage notebook page
+   _      -> return ()
+
+-- | Keeps the page of a notebook inside a maybe widget in sync with the
+-- selection in a model view.
+--
+-- It uses an auxiliary function to determine which page to select. If the function
+-- returns Nothing, then the maybe widget is deactivated.
+modelViewMaybeNotebookSync :: (ViewWithPathSelection a c, NotebookClass b)
+                            => a -> MaybeWidget b -> (TreePath -> Maybe Int) -> IO()
+modelViewMaybeNotebookSync modelView maybeNotebook syncF = do
+  (path, _) <- modelViewGetCursor modelView
+  case syncF path of
+    Nothing -> set maybeNotebook [ maybeWidgetActivated := False]
+    Just p  -> do set maybeNotebook [ maybeWidgetActivated := True ]
+                  notebookSetCurrentPage (maybeWidgetGetWidget maybeNotebook) p
+
+-- | Keeps the page of a notebook inside a maybe widget in sync with the
+-- selection in a model view.
+--
+-- It selects the page with the same number as the element selected in the
+-- model view. If there's more than one selection, or if the model view is not
+-- flat and the selected element is not at the first level, then it selects nothing.
+modelViewMaybeNotebookSyncId :: (ViewWithPathSelection a c, NotebookClass b)
+                             => a -> MaybeWidget b -> IO()
+modelViewMaybeNotebookSyncId modelView maybeNotebook = do
+  (path, _) <- modelViewGetCursor modelView
+  case path of
+   [page] -> do set maybeNotebook [ maybeWidgetActivated := True ]
+                notebookSetCurrentPage (maybeWidgetGetWidget maybeNotebook) page
+   _      -> set maybeNotebook [ maybeWidgetActivated := False ]
diff --git a/src/Graphics/UI/Gtk/Helpers/ModelViewPath.hs b/src/Graphics/UI/Gtk/Helpers/ModelViewPath.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Helpers/ModelViewPath.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}
+module Graphics.UI.Gtk.Helpers.ModelViewPath where
+
+import Graphics.UI.Gtk
+
+class ViewWithPathSelection a b | a -> b where
+  modelViewGetCursor :: a -> IO (TreePath, Maybe b)
+
+instance ViewWithPathSelection IconView CellRenderer where
+  modelViewGetCursor = iconViewGetCursor
+
+instance ViewWithPathSelection TreeView TreeViewColumn where
+  modelViewGetCursor = treeViewGetCursor
+
diff --git a/src/Graphics/UI/Gtk/Helpers/Multiline/TextBuffer.hs b/src/Graphics/UI/Gtk/Helpers/Multiline/TextBuffer.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Helpers/Multiline/TextBuffer.hs
@@ -0,0 +1,19 @@
+-- | Auxiliary functions userful to manipulate TextBuffers
+module Graphics.UI.Gtk.Helpers.Multiline.TextBuffer where
+
+-- External imports
+import Control.Monad
+import Graphics.UI.Gtk
+
+-- | Updates a text buffer only if it's necessary (to avoid extra events)
+textBufferUpdateText :: TextBuffer -> String -> IO ()
+textBufferUpdateText bf s = do
+ tx <- textBufferGetAllText bf True
+ when (tx /= s) $ textBufferSetText bf s
+
+-- | Gets all the text from a text buffer
+textBufferGetAllText :: TextBuffer -> Bool -> IO String
+textBufferGetAllText bf hidden = do
+ si <- textBufferGetStartIter bf
+ ei <- textBufferGetEndIter bf
+ textBufferGetText bf si ei hidden
diff --git a/src/Graphics/UI/Gtk/Helpers/Pixbuf.hs b/src/Graphics/UI/Gtk/Helpers/Pixbuf.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Helpers/Pixbuf.hs
@@ -0,0 +1,61 @@
+module Graphics.UI.Gtk.Helpers.Pixbuf where
+
+import Graphics.UI.Gtk
+import Data.Word
+
+safePixbufComposite :: Pixbuf -> Pixbuf
+                    -> Int -> Int -- position
+                    -> Int -> Int -- something else?
+                    -> InterpType
+                    -> Word8
+                    -> IO ()
+safePixbufComposite pbO pbD x y x' y' interp alpha = do
+  w <- pixbufGetWidth pbO
+  h <- pixbufGetHeight pbO
+  w' <- pixbufGetWidth pbD
+  h' <- pixbufGetHeight pbD
+  safePixbufComposite' pbO pbD x y x' y' w h w' h' interp alpha
+
+safePixbufComposite' :: Pixbuf -> Pixbuf
+                    -> Int -> Int -- position
+                    -> Int -> Int -- something else?
+                    -> Int -> Int -- original image size
+                    -> Int -> Int -- destination image size
+                    -> InterpType
+                    -> Word8
+                    -> IO ()
+safePixbufComposite' pbO pbD x y x' y' w h w' h' interp alpha
+  | x + w < 0 || y + h < 0 || w < 0 || h < 0
+  = return ()
+  | x < 0 || y < 0
+  = do let diffX = if x > 0 then 0 else abs x
+           diffY = if y > 0 then 0 else abs y
+           newX  = if x < 0 then 0 else x
+           newY  = if y < 0 then 0 else y
+           newX' = if x < 0 then 0 else x'
+           newY' = if y < 0 then 0 else y'
+       pbO' <- pixbufNew ColorspaceRgb True 8 (w - diffX) (h - diffY)
+       pixbufCopyArea pbO diffX diffY (w - diffX) (h - diffY) pbO' 0 0
+       safePixbufComposite' pbO' pbD
+                            newX newY
+                            newX' newY'
+                            (w - diffX) (h - diffY)
+                            w' h'
+                            interp alpha
+  | otherwise
+  = do let realw = if (x + w) > w' then w' - x else w
+           realh = if (y + h) > h' then h' - y else h
+       pixbufComposite pbO pbD x y realw realh (fI x') (fI y') 1 1 interp alpha
+ where fI = fromIntegral
+
+pixbufNewEmpty :: Int -> Int -> IO Pixbuf
+pixbufNewEmpty w h = do
+  pb <- pixbufNew ColorspaceRgb True 8 w h
+  pixbufFill pb 0 0 0 1
+  return pb
+
+pixbufNewWithBGColor :: Bool -> Int -> Int -> (Word8, Word8, Word8) -> IO Pixbuf
+pixbufNewWithBGColor alpha w h (r,g,b) = do
+  pb <- pixbufNew ColorspaceRgb alpha 8 w h
+  pixbufFill pb r g b 255
+  return pb
diff --git a/src/Graphics/UI/Gtk/Helpers/TreeView.hs b/src/Graphics/UI/Gtk/Helpers/TreeView.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Helpers/TreeView.hs
@@ -0,0 +1,58 @@
+module Graphics.UI.Gtk.Helpers.TreeView where
+
+-- External imports
+import Control.Monad
+import Data.Maybe
+import Graphics.UI.Gtk
+
+type TypedTreeView a = (TreeView, ListStore a)
+
+addTextColumn :: (TreeModelClass (model row), TypedTreeModelClass model)
+                => TreeView -> model row -> (row -> Maybe String) -> IO()
+addTextColumn tv st f = void $ do
+  col <- treeViewColumnNew
+  renderer <- cellRendererTextNew
+  cellLayoutPackStart col renderer True
+  cellLayoutSetAttributes col renderer st $ map (cellText :=).maybeToList.f
+  treeViewAppendColumn tv col
+
+addPixbufColumn :: (TreeModelClass (model row), TypedTreeModelClass model)
+                => TreeView -> model row -> (row -> Maybe Pixbuf) -> IO()
+addPixbufColumn tv st f = void $ do
+  icon <- treeViewColumnNew
+  renderIcon <- cellRendererPixbufNew
+  cellLayoutPackStart icon renderIcon True
+  cellLayoutSetAttributes icon renderIcon st $ map (cellPixbuf :=).maybeToList.f
+  treeViewAppendColumn tv icon
+
+addPixbufTextDoubleColumn :: (TreeModelClass (model row), TypedTreeModelClass model)
+                          => TreeView -> model row -> (row -> (Maybe Pixbuf, Maybe String)) -> IO()
+addPixbufTextDoubleColumn tv st f = void $ do
+  col <- treeViewColumnNew
+
+  renderIcon <- cellRendererPixbufNew
+  cellLayoutPackStart col renderIcon False
+  cellLayoutSetAttributes col renderIcon st $ map (cellPixbuf :=).maybeToList.fst.f
+
+  renderer <- cellRendererTextNew
+  cellLayoutPackEnd col renderer True
+  cellLayoutSetAttributes col renderer st $ map (cellText :=).maybeToList.snd.f
+
+  treeViewAppendColumn tv col
+
+synchroniseTreeViewAndNotebook :: TreeView -> Notebook -> ([TreePath] -> Maybe Int) -> IO()
+synchroniseTreeViewAndNotebook tv nb f = do
+  tr <- treeViewGetSelectedPath tv
+  maybe (return ()) (\v -> set nb [ notebookPage := v ]) (f tr)
+
+treeViewGetSelectedPath :: TreeViewClass tv => tv -> IO [[Int]]
+treeViewGetSelectedPath =
+  treeSelectionGetSelectedRows <=< treeViewGetSelection
+
+treeViewGetSelected :: TreeViewClass tv => tv -> ListStore a -> IO (Maybe a)
+treeViewGetSelected tv ls = do
+  tr <- treeViewGetSelectedPath tv
+  case tr of
+   [[x]] -> fmap Just $ listStoreGetValue ls x
+   _     -> return Nothing
+
diff --git a/src/Graphics/UI/Gtk/Layout/BackgroundContainer.hs b/src/Graphics/UI/Gtk/Layout/BackgroundContainer.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Layout/BackgroundContainer.hs
@@ -0,0 +1,65 @@
+module Graphics.UI.Gtk.Layout.BackgroundContainer where
+
+import Control.Monad.Trans (liftIO)
+import Data.IORef
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.Gdk.GC
+import System.Glib.Types
+
+data BackgroundContainer = BackgroundContainer EventBox (IORef (Maybe Pixbuf))
+
+instance WidgetClass BackgroundContainer
+instance ObjectClass BackgroundContainer
+instance GObjectClass BackgroundContainer where
+  toGObject (BackgroundContainer ev _) = toGObject ev
+  unsafeCastGObject ev = (BackgroundContainer (unsafeCastGObject ev) undefined)
+
+instance EventBoxClass BackgroundContainer
+instance ContainerClass BackgroundContainer
+instance BinClass BackgroundContainer
+
+backgroundContainerNew :: IO BackgroundContainer
+backgroundContainerNew = do
+  ev  <- eventBoxNew
+  ref <- newIORef Nothing
+  return $ BackgroundContainer ev ref
+
+backgroundContainerNewWithPicture :: FilePath -> IO BackgroundContainer
+backgroundContainerNewWithPicture fp = do
+  ev  <- eventBoxNew
+  pb  <- pixbufNewFromFile fp
+  ref <- newIORef (Just pb)
+  let wdgt = BackgroundContainer ev ref
+  wdgt `on` exposeEvent $ liftIO (backgroundExpose wdgt) >> return False
+  return wdgt
+
+backgroundContainerNewWithPixbuf :: Pixbuf -> IO BackgroundContainer
+backgroundContainerNewWithPixbuf pb = do
+  ev  <- eventBoxNew
+  ref <- newIORef (Just pb)
+  let wdgt = BackgroundContainer ev ref
+  wdgt `on` exposeEvent $ liftIO (backgroundExpose wdgt) >> return False
+  return wdgt
+
+backgroundExpose :: BackgroundContainer -> IO ()
+backgroundExpose (BackgroundContainer ev ref) = do
+  dw <- widgetGetDrawWindow ev
+  drawWindowClear dw
+  pixbufM <- readIORef ref
+  case pixbufM of
+   Nothing -> return ()
+   Just pb -> do sz@(w,h) <- widgetGetSize ev
+                 pb' <- pixbufScaleSimple pb w h InterpBilinear
+                 drawWindowBeginPaintRect dw (Rectangle 0 0 w h)
+                 gc <- gcNew dw
+                 drawPixbuf dw gc pb' 0 0 0 0 (-1) (-1) RgbDitherNone (-1) (-1)
+                 drawWindowEndPaint dw
+
+backgroundSetPicture :: BackgroundContainer -> Maybe FilePath -> IO()
+backgroundSetPicture (BackgroundContainer ev ref) fpM = do
+  pbM <- maybe (return Nothing) (fmap Just . pixbufNewFromFile) fpM
+  writeIORef ref pbM
+
+backgroundSetPixbuf :: BackgroundContainer -> Maybe Pixbuf -> IO()
+backgroundSetPixbuf (BackgroundContainer ev ref) pbM =
+  writeIORef ref pbM
diff --git a/src/Graphics/UI/Gtk/Layout/DummyBin.hs b/src/Graphics/UI/Gtk/Layout/DummyBin.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Layout/DummyBin.hs
@@ -0,0 +1,19 @@
+module Graphics.UI.Gtk.Layout.DummyBin where
+
+import Graphics.UI.Gtk
+import System.Glib.Types
+
+data DummyBin = DummyBin EventBox
+
+instance WidgetClass DummyBin
+instance ObjectClass DummyBin
+instance GObjectClass DummyBin where
+ toGObject (DummyBin x) = toGObject x
+ unsafeCastGObject = DummyBin . unsafeCastGObject
+
+dummyBinNew :: IO DummyBin
+dummyBinNew = do
+ evbox <- eventBoxNew
+ return $ DummyBin evbox
+
+instance ContainerClass DummyBin where
diff --git a/src/Graphics/UI/Gtk/Layout/EitherWidget.hs b/src/Graphics/UI/Gtk/Layout/EitherWidget.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Layout/EitherWidget.hs
@@ -0,0 +1,41 @@
+module Graphics.UI.Gtk.Layout.EitherWidget where
+
+import Control.Monad
+import Data.IORef
+import Graphics.UI.Gtk
+import System.Glib.Types
+
+data EitherWidget a b   = EitherWidget Notebook (IORef EitherWidgetParams)
+type EitherWidgetParams = Bool
+
+instance WidgetClass (EitherWidget a b)
+instance ObjectClass (EitherWidget a b)
+instance GObjectClass (EitherWidget a b) where
+  toGObject (EitherWidget nb _) = toGObject nb
+  unsafeCastGObject o = EitherWidget (unsafeCastGObject o) undefined
+ 
+eitherWidgetNew :: (WidgetClass a, WidgetClass b) => a -> b -> IO (EitherWidget a b)
+eitherWidgetNew wL wR = do
+  nb <- notebookNew
+  _  <- notebookAppendPage nb wL ""
+  _  <- notebookAppendPage nb wR ""
+  notebookSetShowTabs nb False
+  params <- newIORef True
+  return $ EitherWidget nb params
+
+eitherWidgetLeftActivated :: Attr (EitherWidget a b) Bool
+eitherWidgetLeftActivated = newAttr getter setter
+  where getter (EitherWidget _ paramsR)    = readIORef paramsR
+        setter (EitherWidget nb paramsR) v = do
+                  params <- readIORef paramsR
+                  when (v /= params) $ do let upd = if v then 0 else 1
+                                          notebookSetCurrentPage nb upd
+                                          writeIORef paramsR v
+
+eitherWidgetRightActivated :: Attr (EitherWidget a b) Bool
+eitherWidgetRightActivated = newAttr getter setter
+  where getter w   = fmap not $ get w eitherWidgetLeftActivated
+        setter w v = set w [ eitherWidgetLeftActivated := not v ]
+
+eitherWidgetToggle :: EitherWidget a b -> IO()
+eitherWidgetToggle w = set w [ eitherWidgetLeftActivated :~ not ]
diff --git a/src/Graphics/UI/Gtk/Layout/MaybeWidget.hs b/src/Graphics/UI/Gtk/Layout/MaybeWidget.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Gtk/Layout/MaybeWidget.hs
@@ -0,0 +1,45 @@
+module Graphics.UI.Gtk.Layout.MaybeWidget where
+
+import Control.Monad
+import Data.IORef
+import Graphics.UI.Gtk
+import System.Glib.Types
+
+data MaybeWidget a     = MaybeWidget Notebook a Label (IORef MaybeWidgetParams)
+type MaybeWidgetParams = Bool
+
+instance WidgetClass (MaybeWidget a)
+instance ObjectClass (MaybeWidget a)
+instance GObjectClass (MaybeWidget a) where
+  toGObject (MaybeWidget nb _ _ _) = toGObject nb
+  unsafeCastGObject o = MaybeWidget (unsafeCastGObject o) undefined undefined undefined
+ 
+maybeWidgetNewWithLabel :: (WidgetClass a) => a -> Maybe String -> IO (MaybeWidget a)
+maybeWidgetNewWithLabel w label = do
+  lblW <- labelNew label
+  nb <- notebookNew
+  _  <- notebookAppendPage nb lblW ""
+  _  <- notebookAppendPage nb w ""
+  notebookSetShowTabs nb False
+  params <- newIORef False
+  return $ MaybeWidget nb w lblW params
+
+maybeWidgetGetWidget :: MaybeWidget a -> a
+maybeWidgetGetWidget (MaybeWidget _ a _ _) = a
+ 
+maybeWidgetLabelText :: Attr (MaybeWidget a) String
+maybeWidgetLabelText = newAttr getter setter
+  where getter (MaybeWidget _ _ lblW _)   = get lblW labelLabel
+        setter (MaybeWidget _ _ lblW _) s = set lblW [ labelLabel := s ]
+
+maybeWidgetActivated :: Attr (MaybeWidget a) Bool
+maybeWidgetActivated = newAttr getter setter
+  where getter (MaybeWidget _ _ _ paramsR)    = readIORef paramsR
+        setter (MaybeWidget nb _ _ paramsR) v = do
+                  params <- readIORef paramsR
+                  when (v /= params) $ do let upd = if v then 1 else 0
+                                          notebookSetCurrentPage nb upd
+                                          writeIORef paramsR v
+
+maybeWidgetToggle :: MaybeWidget a -> IO()
+maybeWidgetToggle w = set w [ maybeWidgetActivated :~ not ]
diff --git a/src/System/Application.hs b/src/System/Application.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Application.hs
@@ -0,0 +1,17 @@
+module System.Application where
+
+-- External imports
+import Control.Monad
+-- import Control.Monad.Extra
+import System.GIO.File.AppInfo
+import System.Process
+
+-- FIXME: This uses runProcess instead of appInfoLaunchUris because
+-- the latter segfaults in my machine
+openUrlBySystemTool :: String -> IO Bool
+openUrlBySystemTool url = do
+  infos <- appInfoGetAllForType "text/html"
+  unless (null infos) $ void $ do
+    let exe = appInfoGetExecutable $ head infos
+    runProcess exe [url] Nothing Nothing Nothing Nothing Nothing
+  return (not (null infos))