{-# Language CPP, TypeFamilies, RankNTypes, DeriveDataTypeable #-}
-----------------------------------------------------------------------------
--
-- Module      :  Graphics.Pane
-- Copyright   :  Juergen Nicklisch-Franken
-- License     :  LGPL
--
-- Maintainer  :  maintainer@leksah.org
-- Stability   :  provisional
-- Portability :  portabel
--
-- |
--
-----------------------------------------------------------------------------------

module Graphics.Pane (
    startupFrame,
    setSensitivity,
    panePluginInterface,

    module Graphics.Frame,
    module Graphics.FrameTypes,
    module Graphics.Panes,
    module Graphics.Session

) where

import Base
import Graphics.FrameTypes
import Graphics.Frame
import Graphics.Panes
import Graphics.Menu
import Graphics.Session
import Graphics.Statusbar

import Graphics.UI.Gtk
import Data.Version (Version(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Concurrent (yield)
import Control.Monad (when)
import Data.Typeable (Typeable)

-- -----------------------------------------------------------
-- * It's a plugin
--

panePluginInterface :: StateM (PluginInterface FrameEvent)
panePluginInterface = do
    fe <- makeEvent FrameEventSel
    return $ PluginInterface {
         piInit1   = frameInit1,
         piInit2   = frameInit2,
         piEvent   = fe,
         piName    = panePluginName,
         piVersion = Version [1,0,0][]}

frameInit1 :: BaseEvent -> EventChannel FrameEvent -> StateM ()
frameInit1 baseEvent myEvent = do
    message Debug ("init1 " ++ panePluginName)
    res <- registerActionState initialActionState
    case res of
        Nothing -> return ()
        Just s ->  message Error s
    return ()

frameInit2 :: BaseEvent -> EventChannel FrameEvent -> StateM ()
frameInit2 baseEvent myEvent = do
    message Debug ("init2 " ++ panePluginName)
    uiManager <- reifyState (\stateR -> do
        res <- unsafeInitGUIForThreadedRTS
--        res <- initGUI
        messageR Debug ("initGUI " ++ show res) stateR
        uiManagerNew)
    liftIO $ initGtkRc
    res <- registerFrameState (initialFrameState uiManager)
    case res of
        Nothing -> return ()
        Just s ->  message Error s
    getFrameEvent >>= \e -> registerEvent' e
        (\s -> case s of
            ActivatePane pn  -> do  setSensitivity [(PaneActiveSens, True)]
                                    setStatusText "SBActivePane" pn
            DeactivatePane _ -> do  setSensitivity [(PaneActiveSens, False)]
                                    setStatusText "SBActivePane" ""
            _ -> return ())
    return ()

data PaneActiveSens = PaneActiveSens
    deriving (Eq, Ord, Show, Typeable)

instance Selector PaneActiveSens where
    type ValueType PaneActiveSens = Bool


--
-- | The Actions that can be performed on frames
--
frameActions :: [ActionDescr]
frameActions =
    [AD "File" "_File" Nothing Nothing (return ()) Nothing ActionSubmenu
            (Just $ MPFirst []) Nothing []
    ,AD "Quit" "_Quit" Nothing (Just "gtk-quit") quit Nothing ActionNormal
            (Just $ MPFirst ["File"]) Nothing []
    ,AD "View" "_View" Nothing Nothing (return ()) Nothing ActionSubmenu
            (Just $ MPLast [] False) Nothing []
    ,AD "ViewMoveLeft" "Move _Left" Nothing Nothing
            (viewMove LeftP) (Just "<alt><shift>Left") ActionNormal
            (Just $ MPFirst ["View"]) Nothing [GS PaneActiveSens]
    ,AD "ViewMoveRight" "Move _Right" Nothing Nothing
            (viewMove RightP) (Just "<alt><shift>Right") ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]
    ,AD "ViewMoveUp" "Move _Up" Nothing Nothing
            (viewMove TopP) (Just "<alt><shift>Up") ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]
    ,AD "ViewMoveDown" "Move _Down" Nothing Nothing
            (viewMove BottomP) (Just "<alt><shift>Down") ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]
    ,AD "ViewSplitHorizontal" "Split H_orizontal" Nothing Nothing
            viewSplitHorizontal (Just "<ctrl>2") ActionNormal
            (Just $ MPAppend True) Nothing [GS PaneActiveSens]
    ,AD "ViewSplitVertical" "Split _Vertical" Nothing Nothing
            viewSplitVertical (Just "<ctrl>3") ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]
    ,AD "ViewCollapse" "_Collapse" Nothing Nothing
            viewCollapse (Just "<ctrl>1") ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]
    ,AD "ViewNest" "_Group" Nothing Nothing
            viewNewGroup Nothing ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]
    ,AD "ViewDetach" "_Detach" Nothing Nothing
            viewDetachInstrumented Nothing ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]
    ,AD "ViewTabsLeft" "Tabs Left" Nothing Nothing
            (viewTabsPos PosLeft) (Just "<alt><shift><ctrl>Left") ActionNormal
            (Just $ MPAppend True) Nothing[GS PaneActiveSens]
    ,AD "ViewTabsRight" "Tabs Right" Nothing Nothing
            (viewTabsPos PosRight) (Just "<alt><shift><ctrl>Right") ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]
    ,AD "ViewTabsUp" "Tabs Up" Nothing Nothing
        (viewTabsPos PosTop) (Just "<alt><shift><ctrl>Up") ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]
    ,AD "ViewTabsDown" "Tabs Down" Nothing Nothing
        (viewTabsPos PosBottom) (Just "<alt><shift><ctrl>Down") ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]
    ,AD "ViewSwitchTabs" "Tabs On/Off" Nothing Nothing
        viewSwitchTabs (Just "<shift><ctrl>t") ActionNormal
            (Just $ MPAppend False) Nothing [GS PaneActiveSens]

    ,AD "ViewClosePane" "Close pane" Nothing (Just "gtk-close")
        viewClosePane (Just "<ctrl><shift>q") ActionNormal
            (Just $ MPAppend True) (Just TPFirst) [GS PaneActiveSens]

    ,AD "ToolbarVisible" "Toolbar visible" Nothing Nothing
        toggleToolbar (Just "<alt><shift>t") ActionToggle (Just $ MPAppend True) Nothing []
        ]

frameCompartments = [
    TextCompDescr "SBActions" False 150 PackGrow CPLast,
    TextCompDescr "SBActivePane" False 150 PackGrow CPLast]

--
-- | Opens up the main window, with menu, toolbar, accelerators
--
startupFrame :: String -> (Window -> VBox -> Notebook -> StateAction) ->
    (Window -> VBox -> Notebook -> StateAction) -> StateAction
startupFrame windowName beforeWindowOpen beforeMainGUI = do
    message Debug "startupFrame"
    --    osxApp <- OSX.applicationNew
    uiManager <- getUiManagerSt
    RegisterActions allActions       <- triggerFrameEvent (RegisterActions frameActions)
    RegisterPane allPanes            <- triggerFrameEvent (RegisterPane [])
    setPaneTypes allPanes
    RegisterSessionExt sessionExt    <- triggerFrameEvent (RegisterSessionExt [])
    setSessionExt sessionExt
    (menuBar,toolbar)   <- initActions uiManager allActions
    setSensitivity [(PaneActiveSens, False)]
    tbv <- toolbarVisible
    setToolbar (Just toolbar)
    showToolbar True
    RegisterStatusbarComp allCompartments <- triggerFrameEvent (RegisterStatusbarComp frameCompartments)
    statusbar <- buildStatusbar allCompartments
    reifyState $ \ stateR -> do

        win         <-  windowNew
        accGroup <- uiManagerGetAccelGroup uiManager
        windowAddAccelGroup win accGroup
        widgetSetName win windowName
        reflectState (setWindowsSt [win]) stateR

        vb <- vBoxNew False 1  -- Top-level vbox
        widgetSetName vb "topBox"
        containerAdd win vb

        boxPackStart vb menuBar PackNatural 0

        toolbarSetIconSize toolbar IconSizeButton
        toolbarSetStyle toolbar ToolbarBothHoriz
        widgetSetSizeRequest toolbar 700 (-1)
        boxPackStart vb toolbar PackNatural 0

        nb <- reflectState (newNotebook []) stateR
        afterSwitchPage nb (\i -> reflectState (handleNotebookSwitch nb i) stateR)
        widgetSetName nb "root"
        win `onDelete` (\ _ -> do reflectState quit stateR; return True)
        boxPackStart vb nb PackGrow 0

        boxPackEnd vb statusbar PackNatural 0

        reflectState (beforeWindowOpen win vb nb) stateR
        timeoutAddFull (yield >> return True) priorityDefaultIdle 100 -- maybe switch back to

        widgetShowAll win
        reflectState (do
            toolbarIsVisible <- toolbarVisible
            showToolbar toolbarIsVisible
            beforeMainGUI win vb nb) stateR

        mainGUI
        return ()

--
-- | Set gtk style - call that function once at initialization
--
initGtkRc :: IO ()
#if MIN_VERSION_gtk(0,11,0)
initGtkRc = rcParseString ("style \"leksah-close-button-style\"\n" ++
    "{\n" ++
    "  GtkWidget::focus-padding = 0\n" ++
    "  GtkWidget::focus-line-width = 0\n" ++
    "  xthickness = 0\n" ++
    "  ythickness = 0\n" ++
    "}\n" ++
    "widget \"*.leksah-close-button\" style \"leksah-close-button-style\"")
#else
initGtkRc = return ()
#endif

viewDetachInstrumented :: StateM ()
viewDetachInstrumented = do
    mbPair <- viewDetach
    case mbPair of
        Nothing     -> return ()
        Just (win,wid) -> do
            instrumentSecWindow win
            liftIO $ widgetShowAll win

-- TODO Menu, Toolbar, Key accelerators, Statusbar ??? for other windows
instrumentSecWindow :: Window -> StateM ()
instrumentSecWindow win = return ()