content: {-# LANGUAGE OverloadedStrings #-}
  -----------------------------------------------------------------------------
  --
  -- Module      :  IDE.Statusbar
  -- Copyright   :  2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie
  -- License     :  GPL
  --
  -- Maintainer  :  maintainer@leksah.org
  -- Stability   :  provisional
  -- Portability :
  --
  -- | Builds and updates the Statusbar, To update the bar triiger the Statusbar changed event.
  --
  -----------------------------------------------------------------------------
  
  module IDE.Statusbar (
      changeStatusbar
  ,   buildStatusbar
  ) where
  
  import Prelude ()
  import Prelude.Compat
  import Control.Monad (void)
  import IDE.Core.State
         (IDEAction, StatusbarCompartment(..))
  import IDE.Gtk.State
         (getMainWindow, widgetGet, PaneMonad(..),
          postAsyncIDE)
  import Text.Printf (printf)
  import Control.Monad.IO.Class (MonadIO(..))
  import qualified Data.Text as T (pack, lines, unpack)
  import GI.Gtk.Objects.Statusbar
         (Statusbar(..), statusbarNew, statusbarPush, statusbarPop)
  import GI.Gtk.Objects.Window (setWindowTitle)
  import GI.Gtk.Objects.Image
         (Image(..), imageSetPixelSize, imageNewFromIconName,
          imageSetFromIconName)
  import GI.Gtk.Enums (IconSize(..), Orientation(..))
  import GI.Gtk.Objects.Box (boxNew, Box(..))
  import GI.Gtk.Objects.Widget (widgetSetSizeRequest, widgetSetName)
  import Graphics.UI.Editor.Parameters
         (Packing(..), boxPackEnd', boxPackStart')
  import Data.GI.Base.ManagedPtr (unsafeCastTo)
  import Data.Maybe (listToMaybe, fromMaybe)
  
  changeStatusbar :: [StatusbarCompartment] -> IDEAction
  changeStatusbar = postAsyncIDE . mapM_ changeStatusbar'
      where
      changeStatusbar' (CompartmentCommand accStr) =  do
          sb <- getSBSpecialKeys
          statusbarPop sb 1
          void $ statusbarPush sb 1 accStr
      changeStatusbar' (CompartmentPane s) =  do
          sb <- getSBActivePane
          statusbarPop sb 1
          void $ statusbarPush sb 1 s
      changeStatusbar' (CompartmentState string) =  do
          let realStr = if '\n' `elem` T.unpack string then fromMaybe "" (listToMaybe $ T.lines string) <> " ..." else string
          sb <- getSBErrors
          statusbarPop sb 1
          void $ statusbarPush sb 1 realStr
      changeStatusbar' (CompartmentPackage string) =  do
          sb <- getSBActivePackage
          window <- getMainWindow
          statusbarPop sb 1
          void $ statusbarPush sb 1 string
          setWindowTitle window $ "Leksah: " <> string
      changeStatusbar' (CompartmentBufferPos (line,col)) =  do
          sb <- getStatusbarLC
          statusbarPop sb 1
          void $ statusbarPush sb 1 (T.pack $ printf "Ln %4d, Col %3d" (line + 1) (col + 1))
      changeStatusbar' (CompartmentOverlay modi) =  do
          sb <- getStatusbarIO
          statusbarPop sb 1
          void $ statusbarPush sb 1 $ if modi then "OVR" else "INS"
      changeStatusbar' (CompartmentBuild bool) =  do
          im <- getImBuild
          imageSetFromIconName im (Just $ if bool then "ide_build" else "ide_empty") (fromIntegral . fromEnum $ IconSizeMenu)
          return ()
      changeStatusbar' (CompartmentCollect bool) =  do
          im <- getImCollect
          imageSetFromIconName im (Just $ if bool then "ide_rebuild_meta" else "ide_empty") (fromIntegral . fromEnum $ IconSizeMenu)
          return ()
  
  
  buildStatusbar :: MonadIO m => m Box
  buildStatusbar = do
      sblk <- statusbarNew
      widgetSetName sblk "statusBarSpecialKeys"
      widgetSetSizeRequest sblk 150 (-1)
  
      sbap <- statusbarNew
      widgetSetName sbap "statusBarActivePane"
      widgetSetSizeRequest sbap 150 (-1)
  
      sbapr <- statusbarNew
      widgetSetName sbapr "statusBarActiveProject"
      widgetSetSizeRequest sbapr 150 (-1)
  
      sbe <- statusbarNew
      widgetSetName sbe "statusBarErrors"
      widgetSetSizeRequest sbe 150 (-1)
  
      sblc <- statusbarNew
      widgetSetName sblc "statusBarLineColumn"
      widgetSetSizeRequest sblc 150 (-1)
  
      sbio <- statusbarNew
      widgetSetName sbio "statusBarInsertOverwrite"
      widgetSetSizeRequest sbio 60 (-1)
  
      buildImage <- imageNewFromIconName (Just "ide_empty") (fromIntegral $ fromEnum IconSizeMenu)
      widgetSetName buildImage "buildImage"
      imageSetPixelSize buildImage 16
  
      collectImage <- imageNewFromIconName (Just "ide_empty") (fromIntegral $ fromEnum IconSizeMenu)
      widgetSetName collectImage "collectImage"
      imageSetPixelSize collectImage 16
  
      hb <- boxNew OrientationHorizontal 1
      widgetSetName hb "statusBox"
      boxPackStart' hb sblk PackGrow 0
      boxPackStart' hb sbap PackGrow 0
      boxPackStart' hb sbapr PackGrow 0
      --boxPackStart' hb dummy PackGrow 0
      boxPackEnd' hb sblc PackNatural 0
      boxPackEnd' hb sbio PackNatural 0
      boxPackEnd' hb collectImage PackNatural 0
      boxPackEnd' hb buildImage PackNatural 0
      boxPackEnd' hb sbe PackNatural 0
  
      return hb
  
  getSBSpecialKeys :: PaneMonad alpha => alpha Statusbar
  getSBSpecialKeys   = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarSpecialKeys"] (unsafeCastTo Statusbar)
  
  getSBActivePane :: PaneMonad alpha => alpha Statusbar
  getSBActivePane    = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarActivePane"] (unsafeCastTo Statusbar)
  
  getSBActivePackage :: PaneMonad alpha => alpha Statusbar
  getSBActivePackage = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarActiveProject"] (unsafeCastTo Statusbar)
  
  getSBErrors :: PaneMonad alpha => alpha Statusbar
  getSBErrors        = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarErrors"] (unsafeCastTo Statusbar)
  
  getStatusbarIO :: PaneMonad alpha => alpha Statusbar
  getStatusbarIO     =  widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarInsertOverwrite"] (unsafeCastTo Statusbar)
  
  getStatusbarLC :: PaneMonad alpha => alpha Statusbar
  getStatusbarLC     = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarLineColumn"] (unsafeCastTo Statusbar)
  
  getImBuild :: PaneMonad alpha => alpha Image
  getImBuild        = widgetGet ["Leksah Main Window", "topBox","statusBox","buildImage"] (unsafeCastTo Image)
  
  getImCollect :: PaneMonad alpha => alpha Image
  getImCollect        = widgetGet ["Leksah Main Window", "topBox","statusBox","collectImage"] (unsafeCastTo Image)
  