module IDE.Statusbar (
changeStatusbar
, buildStatusbar
) where
import IDE.Core.State
(getMainWindow,
widgetGet,
PaneMonad(..),
IDEAction(..),
StatusbarCompartment(..))
import Graphics.UI.Gtk
(windowSetTitle,
castToStatusbar,
Statusbar(..),
boxPackStart,
hBoxNew,
widgetSetSizeRequest,
widgetSetName,
statusbarSetHasResizeGrip,
statusbarNew,
HBox(..),
statusbarPush,
statusbarPop,
Packing(..),
boxPackEnd,
imageSetPixelSize,
imageNewFromStock,
IconSize(..),
Image,
castToImage,
imageSetFromStock
)
import Graphics.UI.Frame.Panes (IDEPane(..), paneName)
import Text.Printf (printf)
import Control.Monad.IO.Class (MonadIO(..))
changeStatusbar :: [StatusbarCompartment] -> IDEAction
changeStatusbar = mapM_ changeStatusbar'
where
changeStatusbar' (CompartmentCommand accStr) = do
sb <- getSBSpecialKeys
liftIO $statusbarPop sb 1
liftIO $statusbarPush sb 1 accStr
return ()
changeStatusbar' (CompartmentPane (Just (PaneC pane))) = do
sb <- getSBActivePane
liftIO $ statusbarPop sb 1
liftIO $ statusbarPush sb 1 (paneName pane)
return ()
changeStatusbar' (CompartmentPane Nothing) = do
sb <- getSBActivePane
liftIO $ statusbarPop sb 1
liftIO $ statusbarPush sb 1 ""
return ()
changeStatusbar' (CompartmentState string) = do
let realStr = if '\n' `elem` string then (head $ lines string) ++ " ..." else string
sb <- getSBErrors
liftIO $ statusbarPop sb 1
liftIO $ statusbarPush sb 1 realStr
return ()
changeStatusbar' (CompartmentPackage string) = do
sb <- getSBActivePackage
window <- getMainWindow
liftIO $ statusbarPop sb 1
liftIO $ statusbarPush sb 1 string
liftIO $ windowSetTitle window $ "Leksah: " ++ string
return ()
changeStatusbar' (CompartmentBufferPos (line,col)) = do
sb <- getStatusbarLC
liftIO $ statusbarPop sb 1
liftIO $ statusbarPush sb 1 $ printf "Ln %4d, Col %3d" (line + 1) (col + 1)
return ()
changeStatusbar' (CompartmentOverlay modi) = do
sb <- getStatusbarIO
liftIO $ statusbarPop sb 1
liftIO $ statusbarPush sb 1 $ if modi then "OVR" else "INS"
return ()
changeStatusbar' (CompartmentBuild bool) = do
im <- getImBuild
liftIO $ imageSetFromStock im (if bool then "ide_build" else "ide_empty") IconSizeMenu
return ()
changeStatusbar' (CompartmentCollect bool) = do
im <- getImCollect
liftIO $ imageSetFromStock im (if bool then "ide_rebuild_meta" else "ide_empty") IconSizeMenu
return ()
buildStatusbar :: IO HBox
buildStatusbar = do
sb <- statusbarNew
statusbarSetHasResizeGrip sb False
sblk <- statusbarNew
widgetSetName sblk "statusBarSpecialKeys"
statusbarSetHasResizeGrip sblk False
widgetSetSizeRequest sblk 150 (1)
sbap <- statusbarNew
widgetSetName sbap "statusBarActivePane"
statusbarSetHasResizeGrip sbap False
widgetSetSizeRequest sbap 150 (1)
sbapr <- statusbarNew
widgetSetName sbapr "statusBarActiveProject"
statusbarSetHasResizeGrip sbapr False
widgetSetSizeRequest sbapr 150 (1)
sbe <- statusbarNew
widgetSetName sbe "statusBarErrors"
statusbarSetHasResizeGrip sbe False
widgetSetSizeRequest sbe 150 (1)
sblc <- statusbarNew
widgetSetName sblc "statusBarLineColumn"
statusbarSetHasResizeGrip sblc True
widgetSetSizeRequest sblc 150 (1)
sbio <- statusbarNew
widgetSetName sbio "statusBarInsertOverwrite"
statusbarSetHasResizeGrip sbio False
widgetSetSizeRequest sbio 60 (1)
buildImage <- imageNewFromStock "ide_empty" IconSizeMenu
widgetSetName buildImage "buildImage"
imageSetPixelSize buildImage 16
collectImage <- imageNewFromStock "ide_empty" IconSizeMenu
widgetSetName collectImage "collectImage"
imageSetPixelSize collectImage 16
hb <- hBoxNew False 1
widgetSetName hb "statusBox"
boxPackStart hb sblk PackGrow 0
boxPackStart hb sbap PackGrow 0
boxPackStart hb sbapr 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"] castToStatusbar
getSBActivePane :: PaneMonad alpha => alpha Statusbar
getSBActivePane = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarActivePane"] castToStatusbar
getSBActivePackage :: PaneMonad alpha => alpha Statusbar
getSBActivePackage = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarActiveProject"] castToStatusbar
getSBErrors :: PaneMonad alpha => alpha Statusbar
getSBErrors = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarErrors"] castToStatusbar
getStatusbarIO :: PaneMonad alpha => alpha Statusbar
getStatusbarIO = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarInsertOverwrite"] castToStatusbar
getStatusbarLC :: PaneMonad alpha => alpha Statusbar
getStatusbarLC = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarLineColumn"] castToStatusbar
getImBuild :: PaneMonad alpha => alpha Image
getImBuild = widgetGet ["Leksah Main Window", "topBox","statusBox","buildImage"] castToImage
getImCollect :: PaneMonad alpha => alpha Image
getImCollect = widgetGet ["Leksah Main Window", "topBox","statusBox","collectImage"] castToImage