{-# LANGUAGE CPP, BangPatterns, ExistentialQuantification, RecursiveDo,
    ParallelListComp #-}

-- Copyright (c) 2007, 2008 Jean-Philippe Bernardy

-- | This module defines a user interface implemented using gtk2hs and
-- pango for direct text rendering.

module Yi.UI.Pango (start) where

import Prelude (filter, map, round, FilePath, (/))

import Control.Concurrent (yield)
import Control.Monad (ap)
import Control.Monad.Reader (liftIO, when, MonadIO)
import Data.Prototype
import Data.IORef
import Data.List (drop, intercalate, nub, zip)
import qualified Data.List.PointedList.Circular as PL
import Data.Maybe
import qualified Data.Map as M
import System.IO.Unsafe

import Graphics.UI.Gtk hiding (on, Region, Window, Action, Point, Style)
import qualified Graphics.UI.Gtk.Gdk.Events as Gdk.Events
import qualified Graphics.UI.Gtk as Gtk
import System.Glib.GError

import Yi.Prelude 

import Yi.Buffer
import Yi.Config
import qualified Yi.Editor as Editor
import Yi.Editor hiding (windows)
import Yi.Event
import Yi.Keymap
import Yi.Monad
import Yi.Style
import Yi.Window

import qualified Yi.UI.Common as Common
import Yi.UI.Pango.Utils
import Yi.UI.Utils

#ifdef GNOME_ENABLED
import Yi.UI.Pango.Gnome(watchSystemFont)
#endif

data UI = UI
    { uiWindow   :: Gtk.Window
    , uiNotebook :: Notebook
    , uiCmdLine  :: Label
    , tabCache   :: IORef [TabInfo]
    , uiActionCh :: Action -> IO ()
    , uiConfig   :: UIConfig
    , uiFont     :: IORef FontDescription
    }

data TabInfo = TabInfo
    { coreTab     :: PL.PointedList Window
    , page        :: VBox
    , windowCache :: IORef [WinInfo]
    }

instance Show TabInfo where
    show t = show (coreTab t)

data WinInfo = WinInfo
    { coreWin         :: Window
    , shownTos        :: IORef Point
    , renderer        :: IORef (ConnectId DrawingArea)
    , winMotionSignal :: IORef (Maybe (ConnectId DrawingArea))
    , winLayout       :: PangoLayout
    , winMetrics      :: FontMetrics
    , textview        :: DrawingArea
    , modeline        :: Label
    , widget          :: Box -- ^ Top-level widget for this window.
    }

instance Show WinInfo where
    show w = show (coreWin w)

mkUI :: UI -> Common.UI
mkUI ui = Common.dummyUI
    { Common.main          = main ui
    , Common.end           = const end
    , Common.suspend       = windowIconify (uiWindow ui)
    , Common.refresh       = refresh ui
    , Common.layout        = doLayout ui
    , Common.reloadProject = reloadProject ui
    }

updateFont :: UIConfig -> IORef FontDescription -> IORef [TabInfo] -> Label
                  -> FontDescription -> IO ()
updateFont cfg fontRef tc cmd font = do
    maybe (return ()) (fontDescriptionSetFamily font) (configFontName cfg)
    maybe (return ()) (fontDescriptionSetSize font . fromIntegral) (configFontSize cfg)
    writeIORef fontRef font
    widgetModifyFont cmd (Just font)
    tcs <- readIORef tc
    forM_ tcs $ \tabinfo -> do
    wcs <- readIORef $ windowCache tabinfo
    forM_ wcs $ \wininfo -> do
        layoutSetFontDescription (winLayout wininfo) (Just font)
        -- This will cause the textview to redraw
        widgetModifyFont (textview wininfo) (Just font)
        widgetModifyFont (modeline wininfo) (Just font)

askBuffer :: Window -> FBuffer -> BufferM a -> a
askBuffer w b f = fst $ runBuffer w b f

-- | Initialise the ui
start :: UIBoot
start cfg ch outCh ed = catchGError (startNoMsg cfg ch outCh ed) (\(GError _dom _code msg) -> fail msg)

startNoMsg :: UIBoot
startNoMsg cfg ch outCh _ed = do
  logPutStrLn "startNoMsg"
  unsafeInitGUIForThreadedRTS

  win <- windowNew
  windowSetDefaultSize win 900 700
  windowSetTitle win "Yi"
  ico <- loadIcon "yi+lambda-fat.32.png"
  windowSetIcon win ico

  onKeyPress win (processEvent ch)

  paned <- hPanedNew

  vb <- vBoxNew False 1  -- Top-level vbox

  -- Disable the left pane (file/module browser) until Shim/Scion discussion has
  -- concluded. Shim causes crashes, but it's not worth fixing if we'll soon
  -- replace it.

  tabs' <- notebookNew
  widgetSetSizeRequest tabs' 200 (-1)
  notebookSetTabPos tabs' PosBottom
  panedAdd1 paned tabs'

  {-
  -- Create the tree views for files and modules
  (filesProject, modulesProject) <- loadProject =<< getCurrentDirectory

  filesStore   <- treeStoreNew [filesProject]
  modulesStore <- treeStoreNew [modulesProject]

  filesTree   <- projectTreeNew (outCh . singleton) filesStore
  modulesTree <- projectTreeNew (outCh . singleton) modulesStore

  scrlProject <- scrolledWindowNew Nothing Nothing
  scrolledWindowAddWithViewport scrlProject filesTree
  scrolledWindowSetPolicy scrlProject PolicyAutomatic PolicyAutomatic
  notebookAppendPage tabs scrlProject "Project"

  scrlModules <- scrolledWindowNew Nothing Nothing
  scrolledWindowAddWithViewport scrlModules modulesTree
  scrolledWindowSetPolicy scrlModules PolicyAutomatic PolicyAutomatic
  notebookAppendPage tabs scrlModules "Modules"
  -}

  tabs <- notebookNew
  panedAdd2 paned tabs

  set win [ containerChild := vb ]
  onDestroy win mainQuit

  cmd <- labelNew Nothing
  set cmd [ miscXalign := 0 ]

  set vb [ containerChild := paned,
           containerChild := cmd,
           boxChildPacking cmd  := PackNatural ]

  fontRef <- newIORef undefined
  tc <- newIORef []

#ifdef GNOME_ENABLED
  let watchFont = watchSystemFont
#else
  let watchFont = (fontDescriptionFromString "Monospace 10" >>=)
#endif
  watchFont $ updateFont (configUI cfg) fontRef tc cmd

  -- use our magic threads thingy (http://haskell.org/gtk2hs/archives/2005/07/24/writing-multi-threaded-guis/)
  timeoutAddFull (yield >> return True) priorityDefaultIdle 50

  widgetShowAll win

  let ui = UI win tabs cmd tc (outCh . singleton) (configUI cfg) fontRef

  return (mkUI ui)

main :: UI -> IO ()
main _ui =
    do logPutStrLn "GTK main loop running"
       mainGUI

processEvent :: (Event -> IO ()) -> Gdk.Events.Event -> IO Bool
processEvent ch ev = do
  -- logPutStrLn $ "Gtk.Event: " ++ show ev
  -- logPutStrLn $ "Event: " ++ show (gtkToYiEvent ev)
  case gtkToYiEvent ev of
    Nothing -> logPutStrLn $ "Event not translatable: " ++ show ev
    Just e -> ch e
  return True

gtkToYiEvent :: Gdk.Events.Event -> Maybe Event
gtkToYiEvent (Gdk.Events.Key {Gdk.Events.eventKeyName = key, Gdk.Events.eventModifier = evModifier, Gdk.Events.eventKeyChar = char})
    = fmap (\k -> Event k $ (nub $ (if isShift then filter (/= MShift) else id) $ concatMap modif evModifier)) key'
      where (key',isShift) =
                case char of
                  Just c -> (Just $ KASCII c, True)
                  Nothing -> (M.lookup key keyTable, False)
            modif Gdk.Events.Control = [MCtrl]
            modif Gdk.Events.Alt = [MMeta]
            modif Gdk.Events.Shift = [MShift]
            modif _ = []
gtkToYiEvent _ = Nothing

-- | Map GTK long names to Keys
keyTable :: M.Map String Key
keyTable = M.fromList
    [("Down",       KDown)
    ,("Up",         KUp)
    ,("Left",       KLeft)
    ,("Right",      KRight)
    ,("Home",       KHome)
    ,("End",        KEnd)
    ,("BackSpace",  KBS)
    ,("Delete",     KDel)
    ,("Page_Up",    KPageUp)
    ,("Page_Down",  KPageDown)
    ,("Insert",     KIns)
    ,("Escape",     KEsc)
    ,("Return",     KEnter)
    ,("Tab",        KTab)
    ,("ISO_Left_Tab", KTab)
    ]

-- | Clean up and go home
end :: IO ()
end = mainQuit

syncTabs :: Editor -> UI -> [(PL.PointedList Window, Bool)] -> [TabInfo] -> IO [TabInfo]
syncTabs e ui (tfocused@(t,focused):ts) (c:cs)
    | t == coreTab c =
        do when focused $ setTabFocus ui c
           wCache <- readRef $ windowCache c
           (:) <$> syncTab e ui c t wCache <*> syncTabs e ui ts cs
    | t `elem` map coreTab cs =
        do removeTab ui c
           syncTabs e ui (tfocused:ts) cs
    | otherwise =
        do c' <- insertTabBefore e ui t c
           when focused $ setTabFocus ui c'
           return (c':) `ap` syncTabs e ui ts (c:cs)
syncTabs e ui ts [] = mapM (insertTab e ui) (map fst ts)
syncTabs _ ui [] cs = mapM_ (removeTab ui) cs >> return []

syncTab :: Editor -> UI -> TabInfo -> PL.PointedList Window -> [WinInfo] -> IO TabInfo
syncTab e ui tab ws cache = do
    wCache <- syncWindows e ui tab (toList $ PL.withFocus ws) cache
    writeRef (windowCache tab) wCache
    return tab

-- | Synchronize the windows displayed by GTK with the status of windows in the Core.
syncWindows :: Editor -> UI -> TabInfo -> [(Window, Bool)] -- ^ windows paired with their "isFocused" state.
            -> [WinInfo] -> IO [WinInfo]
syncWindows e ui tab (wfocused@(w,focused):ws) (c:cs)
    | w == coreWin c =
        do when focused $ setWindowFocus e ui tab c
           (:) <$> syncWin e w c <*> syncWindows e ui tab ws cs
    | w `elem` map coreWin cs =
        removeWindow ui tab c >> syncWindows e ui tab (wfocused:ws) cs
    | otherwise = do
        c' <- insertWindowBefore e ui tab w c
        when focused (setWindowFocus e ui tab c')
        return (c':) `ap` syncWindows e ui tab ws (c:cs)
syncWindows e ui tab ws [] = mapM (insertWindowAtEnd e ui tab) (map fst ws)
syncWindows _ ui tab [] cs = mapM_ (removeWindow ui tab) cs >> return []

syncWin :: Editor -> Window -> WinInfo -> IO WinInfo
syncWin _ w wi = do
  return (wi {coreWin = w})

setTabFocus :: UI -> TabInfo -> IO ()
setTabFocus ui t = do
  p <- notebookPageNum (uiNotebook ui) (page t)
  case p of
    Just n  -> notebookSetCurrentPage (uiNotebook ui) n
    Nothing -> return ()

setWindowFocus :: Editor -> UI -> TabInfo -> WinInfo -> IO ()
setWindowFocus e ui t w = do
  let bufferName = shortIdentString (commonNamePrefix e) $ findBufferWith (bufkey $ coreWin w) e

  hasFocus <- get (textview w) widgetIsFocus
  when (not hasFocus) $ widgetGrabFocus (textview w)

  windowSetTitle (uiWindow ui) $ bufferName ++ " - Yi"
  notebookSetTabLabelText (uiNotebook ui) (page t) bufferName

removeTab :: UI -> TabInfo -> IO ()
removeTab ui  t = do
    p <- notebookPageNum (uiNotebook ui) (page t)
    case p of
        Just n  -> notebookRemovePage (uiNotebook ui) n
        Nothing -> return ()

removeWindow :: UI -> TabInfo -> WinInfo -> IO ()
removeWindow _ tab win = do
    containerRemove (page tab) (widget win)

handleClick :: UI -> WinInfo -> Gdk.Events.Event -> IO Bool
handleClick ui w event = do
  -- logPutStrLn $ "Click: " ++ show (eventX e, eventY e, eventClick e)

  -- retrieve the clicked offset.
  (_,layoutIndex,_) <- io $ layoutXYToIndex (winLayout w) (Gdk.Events.eventX event) (Gdk.Events.eventY event)
  tos <- readRef (shownTos w)
  let p1 = tos + fromIntegral layoutIndex

  -- maybe focus the window
  logPutStrLn $ "Clicked inside window: " ++ show w
  tCache <- readRef $ tabCache ui
  {-
  ((w:_):_) <- forM tCache $ \tabinfo -> do
    wCache <- readIORef $ windowCache tabinfo
    return $ head $ forM wCache $ \wininfo -> do
      if (winkey $ coreWin w) == (winkey $ coreWin wininfo)
        then return w
        else []
  -}
  let focusWindow = undefined
  -- let Just idx = findIndex (((==) `on` (winkey . coreWin)) w) wCache
  --    focusWindow = modA windowsA (fromJust . PL.move idx)

  case (Gdk.Events.eventClick event, Gdk.Events.eventButton event) of
     (Gdk.Events.SingleClick, Gdk.Events.LeftButton) -> do
       writeRef (winMotionSignal w) =<< Just <$> onMotionNotify (textview w) False (handleMove ui w p1)

     _ -> do maybe (return ()) signalDisconnect =<< readRef (winMotionSignal w)
             writeRef (winMotionSignal w) Nothing
             

  let runAction = uiActionCh ui . makeAction
  case (Gdk.Events.eventClick event, Gdk.Events.eventButton event) of
    (Gdk.Events.SingleClick, Gdk.Events.LeftButton) -> runAction $ do
        b <- gets $ (bkey . findBufferWith (bufkey $ coreWin w))
        focusWindow
        withGivenBufferAndWindow0 (coreWin w) b $ moveTo p1
    (Gdk.Events.SingleClick, _) -> runAction focusWindow
    (Gdk.Events.ReleaseClick, Gdk.Events.MiddleButton) -> do
        disp <- widgetGetDisplay (textview w)
        cb <- clipboardGetForDisplay disp selectionPrimary
        let cbHandler Nothing = return ()
            cbHandler (Just txt) = runAction $ do
                b <- gets $ (bkey . findBufferWith (bufkey $ coreWin w))
                withGivenBufferAndWindow0 (coreWin w) b $ do
                pointB >>= setSelectionMarkPointB
                moveTo p1
                insertN txt
        clipboardRequestText cb cbHandler
    _ -> return ()

  return True

handleScroll :: UI -> WinInfo -> Gdk.Events.Event -> IO Bool
handleScroll ui _ event = do
  let editorAction = do 
        withBuffer0 $ vimScrollB $ case Gdk.Events.eventDirection event of
                        Gdk.Events.ScrollUp   -> (-1)
                        Gdk.Events.ScrollDown -> 1
                        _ -> 0 -- Left/right scrolling not supported

  uiActionCh ui (makeAction editorAction)
  return True

handleMove :: UI -> WinInfo -> Point -> Gdk.Events.Event -> IO Bool
handleMove ui w p0 event = do
  logPutStrLn $ "Motion: " ++ show (Gdk.Events.eventX event, Gdk.Events.eventY event)

  -- retrieve the clicked offset.
  (_,layoutIndex,_) <- layoutXYToIndex (winLayout w) (Gdk.Events.eventX event) (Gdk.Events.eventY event)
  tos <- readRef (shownTos w)
  let p1 = tos + fromIntegral layoutIndex


  let editorAction = do
        txt <- withBuffer0 $ do
           if p0 /= p1 
            then Just <$> do
              m <- selMark <$> askMarks
              setMarkPointB m p0
              moveTo p1
              setVisibleSelection True
              readRegionB =<< getSelectRegionB
            else return Nothing
        maybe (return ()) setRegE txt

  uiActionCh ui (makeAction editorAction)
  -- drawWindowGetPointer (textview w) -- be ready for next message.

  -- Relies on uiActionCh being synchronous
  selection <- newIORef ""
  let yiAction = do
      txt <- withEditor (withBuffer0 (readRegionB =<< getSelectRegionB))
             :: YiM String
      liftIO $ writeIORef selection txt
  uiActionCh ui (makeAction yiAction)
  txt <- readIORef selection

  disp <- widgetGetDisplay (textview w)
  cb <- clipboardGetForDisplay disp selectionPrimary
  clipboardSetWithData cb [(targetString,0)]
      (\0 -> selectionDataSetText txt >> return ()) (return ())

  return True

-- | Make a new tab.
newTab :: Editor -> UI -> PL.PointedList Window -> IO TabInfo
newTab _ _ ws = do
    vb <- vBoxNew False 1
    wc <- newIORef []
    return $ TabInfo { coreTab = ws
                     , page    = vb
                     , windowCache = wc
                     }

-- | Make a new window.
newWindow :: Editor -> UI -> Window -> FBuffer -> IO WinInfo
newWindow e ui w b = mdo
    f <- readIORef (uiFont ui)

    ml <- labelNew Nothing
    widgetModifyFont ml (Just f)
    set ml [ miscXalign := 0.01 ] -- so the text is left-justified.

    v <- drawingAreaNew
    widgetModifyFont v (Just f)
    widgetAddEvents v [Button1MotionMask]
    widgetModifyBg v StateNormal $ mkCol False $ Yi.Style.background $ baseAttributes $ configStyle $ uiConfig ui

    box <- if isMini w
     then do
      widgetSetSizeRequest v (-1) 1

      prompt <- labelNew (Just $ identString b)
      widgetModifyFont prompt (Just f)

      hb <- hBoxNew False 1
      set hb [ containerChild := prompt,
               containerChild := v,
               boxChildPacking prompt := PackNatural,
               boxChildPacking v := PackGrow]

      return (castToBox hb)
     else do
      vb <- vBoxNew False 1
      set vb [ containerChild := v,
               containerChild := ml,
               boxChildPacking ml := PackNatural]
      return (castToBox vb)

    sig       <- newIORef =<< (v `onExpose` render e ui b win)
    tosRef    <- newIORef (askBuffer w b (getMarkPointB =<< fromMark <$> askMarks))
    context   <- widgetCreatePangoContext v
    layout    <- layoutEmpty context
    language  <- contextGetLanguage context
    metrics   <- contextGetMetrics context f language
    motionSig <- newIORef Nothing

    layoutSetWrap layout WrapAnywhere
    layoutSetFontDescription layout (Just f)

    let win = WinInfo { coreWin   = w
                      , winLayout = layout
                      , winMetrics = metrics
                      , winMotionSignal = motionSig
                      , textview  = v
                      , modeline  = ml
                      , widget    = box
                      , renderer  = sig
                      , shownTos  = tosRef
                      }

    return win

insertTabBefore :: Editor -> UI -> PL.PointedList Window -> TabInfo -> IO TabInfo
insertTabBefore e ui t _c = insertTab e ui t

insertTab :: Editor -> UI -> PL.PointedList Window -> IO TabInfo
insertTab e ui ws = do
    t <- newTab e ui ws
    notebookAppendPage (uiNotebook ui) (page t) "Title"
    widgetShowAll $ page t
    return t

insertWindowBefore :: Editor -> UI -> TabInfo -> Window -> WinInfo -> IO WinInfo
insertWindowBefore e ui tab w _c = insertWindow e ui tab w

insertWindowAtEnd :: Editor -> UI -> TabInfo -> Window -> IO WinInfo
insertWindowAtEnd e ui tab w = insertWindow e ui tab w

insertWindow :: Editor -> UI -> TabInfo -> Window -> IO WinInfo
insertWindow e ui tab win = do
  let buf = findBufferWith (bufkey win) e
  liftIO $ do w <- newWindow e ui win buf

              set (page tab) $ 
                [ containerChild := widget w
                , boxChildPacking (widget w) :=
                    if isMini (coreWin w)
                        then PackNatural
                        else PackGrow
                ]

              textview w `onButtonRelease` handleClick ui w
              textview w `onButtonPress` handleClick ui w
              textview w `onScroll` handleScroll ui w
              widgetShowAll (widget w)

              setWindowFocus e ui tab w

              return w

updateCache :: UI -> Editor -> IO ()
updateCache ui e = do
    let tabs = e ^. tabsA
    cache <- readRef $ tabCache ui
    cache' <- syncTabs e ui (toList $ PL.withFocus tabs) cache
    writeRef (tabCache ui) cache'

refresh :: UI -> Editor -> IO ()
refresh ui e = do
    set (uiCmdLine ui) [labelText := intercalate "  " $ statusLine e,
                        labelEllipsize := EllipsizeEnd]
    updateCache ui e
    cache <- readRef $ tabCache ui
    forM_ cache $ \t -> do
        wins <- readRef $ windowCache t
        forM_ wins $ \w -> do
            let b = findBufferWith (bufkey (coreWin w)) e
            -- when (not $ null $ b ^. pendingUpdatesA) $
            do
                sig <- readIORef (renderer w)
                signalDisconnect sig
                writeRef (renderer w) =<< (textview w `onExpose` render e ui b w)
                widgetQueueDraw (textview w)

winEls :: Point -> Int -> BufferM Yi.Buffer.Size
winEls tospnt h = savingPointB $ do
             moveTo tospnt
             gotoLnFrom (h-1)
             moveToEol
             p <- pointB
             return (p ~- tospnt)

render :: Editor -> UI -> FBuffer -> WinInfo -> t -> IO Bool
render e ui b w _ev = do
  (tos,cur,bos) <- updatePango w b (winLayout w)
  writeRef (shownTos w) tos
  drawWindow    <- widgetGetDrawWindow $ textview w

  -- add color attributes.
  let picture = askBuffer (coreWin w) b $ attributesPictureAndSelB sty (currentRegex e) (mkRegion tos bos)
      sty = extractValue $ configTheme (uiConfig ui)
      strokes = [(start',s,end') | ((start', s), end') <- zip picture (drop 1 (map fst picture) ++ [bos]),
                  s /= emptyAttributes]
      rel p = fromIntegral (p - tos)
      allAttrs = concat $ do
        (p1, Attributes fg bg _rv bd itlc udrl, p2) <- strokes
        return $ [ AttrForeground (rel p1) (rel p2) (mkCol True fg)
                 , AttrBackground (rel p1) (rel p2) (mkCol False bg)
                 , AttrStyle      (rel p1) (rel p2) (if itlc then StyleItalic     else StyleNormal)
                 , AttrUnderline  (rel p1) (rel p2) (if udrl then UnderlineSingle else UnderlineNone)
                 , AttrWeight     (rel p1) (rel p2) (if bd   then WeightBold      else WeightNormal)
                 ]
      layout = winLayout w

  layoutSetAttributes layout allAttrs

  (PangoRectangle curx cury curw curh, _) <- layoutGetCursorPos layout (rel cur)

  gc <- gcNew drawWindow
  drawLayout drawWindow gc 0 0 layout

  -- paint the cursor   
  gcSetValues gc (newGCValues { Gtk.foreground = mkCol True $ Yi.Style.foreground $ baseAttributes $ configStyle $ uiConfig ui })
  drawLine drawWindow gc (round curx, round cury) (round $ curx + curw, round $ cury + curh) 
  return True

doLayout :: UI -> Editor -> IO Editor
doLayout ui ePrev = do
    tabs <- readRef $ tabCache ui
    handleTabs tabs ePrev
  where handleTabs :: [TabInfo] -> Editor -> IO Editor
        handleTabs [] e = return e
        handleTabs (t:ts) e = do
          visible <- get (page t) widgetVisible
          e' <- if visible then handleTab t e
                           else return e
          handleTabs ts e'

        handleTab :: TabInfo -> Editor -> IO Editor
        handleTab tab e = mdo
          logPutStrLn $ "Updating tab: " ++ show tab
          let updateWin w = w { height = height' w, getRegion = getRegion' w }
              e' = (windowsA ^: fmap updateWin) e

          -- This gets called here, but also in refresh; are both necessary?
          io $ updateCache ui e'
          wins <- io $ readRef (windowCache tab)
          heights <- io $ forM wins $ \w -> do
                (_, h) <- widgetGetSize $ textview w
                let metrics = winMetrics w
                return (w, round ((fromIntegral h) / (ascent metrics + descent metrics)))

          f <- readRef (uiFont ui)
          let height' w = case find ((w ==) . coreWin . fst) heights of
                                Nothing -> 0
                                Just (_,h) -> h
              getRegion' w = case find ((w ==) . coreWin) wins of
                                   Nothing -> const emptyRegion
                                   Just win -> shownRegion f win
          logPutStrLn $ "heights: " ++ show heights
          return e'

shownRegion :: FontDescription -> WinInfo -> FBuffer -> Region
shownRegion f w b =
  -- PangoLayout operations should be functional
  unsafePerformIO $ do
  -- Don't use layoutCopy, it just segfaults (as of gtk2hs 0.10.1)
  context <- widgetCreatePangoContext (textview w)
  layout <- layoutEmpty context
  layoutSetWrap layout WrapAnywhere
  layoutSetFontDescription layout (Just f)
  (tos, _, bos) <- updatePango w b layout
  return $ mkRegion tos bos

updatePango :: WinInfo -> FBuffer -> PangoLayout -> IO (Point, Point, Point)
updatePango w b layout = do
  (width', height') <- widgetGetSize $ textview w

  let win                 = coreWin w
      [width'', height''] = map fromIntegral [width', height']
      metrics             = winMetrics w
      winh                = round (height'' / (ascent metrics + descent metrics))

      (tos, point, text)  = askBuffer win b $ do
                              from     <- getMarkPointB =<< fromMark <$> askMarks
                              numChars <- winEls from winh
                              p        <- pointB
                              content  <- nelemsB (fromIntegral numChars) from
                              return (from, p, content)

  layoutSetWidth layout (Just width'')
  layoutSetText layout text
  (_, bosOffset, _) <- layoutXYToIndex layout width'' height''
  return (tos, point, tos + fromIntegral bosOffset + 1)

reloadProject :: UI -> FilePath -> IO ()
reloadProject _ _ = return ()

mkCol :: Bool -- ^ is foreground?
      -> Yi.Style.Color -> Gtk.Color
mkCol True  Default = Color 0 0 0
mkCol False Default = Color maxBound maxBound maxBound
mkCol _ (RGB x y z) = Color (fromIntegral x * 256)
                            (fromIntegral y * 256)
                            (fromIntegral z * 256)