module Manatee.Action.Window where
import Control.Monad
import GHC.Conc
import Graphics.UI.Gtk hiding (Window)
import Manatee.Action.Basic
import Manatee.Action.Tabbar
import Manatee.Core.DBus
import Manatee.Core.Types
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.STM
import Manatee.Types
import Manatee.UI.UIFrame
import Manatee.UI.Window hiding (windowNew)
import Manatee.UI.WindowNode
import qualified Manatee.Toolkit.Data.ListZipper as LZ
windowSplitVertically :: Environment -> IO ()
windowSplitVertically = windowSplit DVertical
windowSplitHortizontally :: Environment -> IO ()
windowSplitHortizontally = windowSplit DHortizontal
windowSplit :: WindowNodeDirection -> Environment -> IO ()
windowSplit direction env = do
(tabbarTVar, (tabbar, (windowParent, (container, (focusNotifierList, (windowListTVar, windowNodeListTVar)))))) <- envGet env
let winParentId = windowGetId windowParent
tabbarGetPageModeName tabbar winParentId ?>= \modeName -> do
let seqList = tabbarGetTabList winParentId tabbar
currentTabIndex <- notebookGetCurrentPage (windowNotebook windowParent)
(windowChild1, windowChild2) <- windowSplitInternal
direction
windowParent
windowListTVar
windowNodeListTVar
focusNotifierList
container
windowChildReparentTabs env windowChild1 seqList modeName
windowChildCloneTabs env windowChild2 seqList modeName
modifyTVarIO tabbarTVar (tabbarRemoveTabs winParentId)
modifyTVarIO windowListTVar (`windowListFocus` windowChild1)
notebookSetCurrentPage (windowNotebook windowChild1) currentTabIndex
notebookSetCurrentPage (windowNotebook windowChild2) currentTabIndex
windowSelectNext :: TVar WindowList -> IO ()
windowSelectNext windowList =
modifyTVarIO windowList windowListNextCircular
windowSelectPrev :: TVar WindowList -> IO ()
windowSelectPrev windowList =
modifyTVarIO windowList windowListPrevCircular
windowCloseCurrent :: Environment -> IO ()
windowCloseCurrent env = do
window <- envGet env
windowRemove env window
windowCloseOthers :: Environment -> IO ()
windowCloseOthers env = do
(currentWindow, windowList) <- envGet env
forM_ (LZ.toList windowList) $ \ window ->
when (windowGetId window /= windowGetId currentWindow) $
windowRemove env window
windowCloseAll :: Environment -> IO ()
windowCloseAll env = do
windowList <- envGet env
forM_ (LZ.toList windowList) $ \ window ->
windowRemove env window
windowRemove :: Environment -> Window -> IO ()
windowRemove env window = do
(client, (frame, (anythingBox, (anythingInteractivebar, (tabbar, args))))) <- envGet env
newTabbar <- removeTabs tabbar client window
(newWindowList, newWindowNodeList) <- windowRemoveInternal (window, args)
envPut env (newTabbar, (newWindowList, newWindowNodeList))
when (LZ.isEmpty newWindowList) $ do
popupWindowExit_ env
exitAllRenderProcess env
anythingInitStartup frame anythingBox anythingInteractivebar
windowChildReparentTabs :: Environment -> Window -> [Tab] -> PageModeName -> IO ()
windowChildReparentTabs env window seqList modeName = do
(client, (tabbarTVar, (signalBoxList, sId))) <- envGet env
let notebook = windowNotebook window
windowId = windowGetId window
forM_ seqList $ \ Tab {tabProcessId = processId
,tabPageId = pageId
,tabPlugId = oldPlugId
,tabUIFrame = oldUIFrame} -> do
uiFrame <- uiFrameStick notebook (Just oldUIFrame)
signalBox <- signalBoxNew uiFrame windowId sId signalBoxList
modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId 0 0 uiFrame))
mkRenderSignal client processId ReparentRenderPage (ReparentRenderPageArgs pageId oldPlugId (signalBoxId signalBox))
windowChildCloneTabs :: Environment -> Window -> [Tab] -> PageModeName -> IO ()
windowChildCloneTabs env window seqList modeName = do
(client, (tabbarTVar, (signalBoxList, sId))) <- envGet env
let tabDataList = map (\x -> (modeName, tabProcessId x, tabPageId x)) seqList
cloneTabs window client tabbarTVar signalBoxList sId tabDataList
windowEnlargeUp :: Environment -> IO ()
windowEnlargeUp env = do
(window, windowNodeList) <- envGet env
windowNodeZoom windowNodeList (windowNode window) ZUp True
windowEnlargeDown :: Environment -> IO ()
windowEnlargeDown env = do
(window, windowNodeList) <- envGet env
windowNodeZoom windowNodeList (windowNode window) ZDown True
windowEnlargeLeft :: Environment -> IO ()
windowEnlargeLeft env = do
(window, windowNodeList) <- envGet env
windowNodeZoom windowNodeList (windowNode window) ZLeft True
windowEnlargeRight :: Environment -> IO ()
windowEnlargeRight env = do
(window, windowNodeList) <- envGet env
windowNodeZoom windowNodeList (windowNode window) ZRight True
windowEnlarge :: Environment -> IO ()
windowEnlarge env = do
windowEnlargeUp env
windowEnlargeDown env
windowEnlargeLeft env
windowEnlargeRight env
windowShrinkUp :: Environment -> IO ()
windowShrinkUp env = do
(window, windowNodeList) <- envGet env
windowNodeZoom windowNodeList (windowNode window) ZUp False
windowShrinkDown :: Environment -> IO ()
windowShrinkDown env = do
(window, windowNodeList) <- envGet env
windowNodeZoom windowNodeList (windowNode window) ZDown False
windowShrinkLeft :: Environment -> IO ()
windowShrinkLeft env = do
(window, windowNodeList) <- envGet env
windowNodeZoom windowNodeList (windowNode window) ZLeft False
windowShrinkRight :: Environment -> IO ()
windowShrinkRight env = do
(window, windowNodeList) <- envGet env
windowNodeZoom windowNodeList (windowNode window) ZRight False
windowShrink :: Environment -> IO ()
windowShrink env = do
windowShrinkUp env
windowShrinkDown env
windowShrinkLeft env
windowShrinkRight env