-- Author: Andy Stewart -- Maintainer: Andy Stewart -- -- Copyright (C) 2010 Andy Stewart, all rights reserved. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . 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 -- | Split window vertically. windowSplitVertically :: Environment -> IO () windowSplitVertically = windowSplit DVertical -- | Split window horizontally. windowSplitHortizontally :: Environment -> IO () windowSplitHortizontally = windowSplit DHortizontal -- | Spit window with specify direction. 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 -- Get data before split parent window. let seqList = tabbarGetTabList winParentId tabbar currentTabIndex <- notebookGetCurrentPage (windowNotebook windowParent) -- Split window. (windowChild1, windowChild2) <- windowSplitInternal direction windowParent windowListTVar windowNodeListTVar focusNotifierList container -- Build re-parent sockets for new child window. windowChildReparentTabs env windowChild1 seqList modeName -- Build clone sockets for new child window. windowChildCloneTabs env windowChild2 seqList modeName -- Update state. modifyTVarIO tabbarTVar (tabbarRemoveTabs winParentId) modifyTVarIO windowListTVar (`windowListFocus` windowChild1) -- Store tab index with window children. notebookSetCurrentPage (windowNotebook windowChild1) currentTabIndex notebookSetCurrentPage (windowNotebook windowChild2) currentTabIndex -- | Select next window and focus page. windowSelectNext :: TVar WindowList -> IO () windowSelectNext windowList = modifyTVarIO windowList windowListNextCircular -- | Select previous window and focus page. windowSelectPrev :: TVar WindowList -> IO () windowSelectPrev windowList = modifyTVarIO windowList windowListPrevCircular -- | Close current window. windowCloseCurrent :: Environment -> IO () windowCloseCurrent env = do -- Get current window and close it. window <- envGet env windowRemove env window -- | Close all windows except current one. windowCloseOthers :: Environment -> IO () windowCloseOthers env = do -- Get current window and window list. (currentWindow, windowList) <- envGet env -- Loop window list to close windows. forM_ (LZ.toList windowList) $ \ window -> -- Close window that not match current window id. when (windowGetId window /= windowGetId currentWindow) $ windowRemove env window -- | Close all windows. -- Will popup global input interactivebar after close all windows. windowCloseAll :: Environment -> IO () windowCloseAll env = do windowList <- envGet env forM_ (LZ.toList windowList) $ \ window -> windowRemove env window -- | Remove window. windowRemove :: Environment -> Window -> IO () windowRemove env window = do -- Get args. (client, (frame, (anythingBox, (anythingInteractivebar, (tabbar, args))))) <- envGet env -- Remove all tabs match window id. newTabbar <- removeTabs tabbar client window -- Remove window from window list. (newWindowList, newWindowNodeList) <- windowRemoveInternal (window, args) -- Feed environment back. envPut env (newTabbar, (newWindowList, newWindowNodeList)) -- Show anything input interface if no window exist. when (LZ.isEmpty newWindowList) $ do -- Hide local popup window. popupWindowExit_ env -- Exit all render processes. exitAllRenderProcess env -- Init anything view when no window exist. anythingInitStartup frame anythingBox anythingInteractivebar -- | Re-parent tabs of parent in child window. 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 -- Create new socket frame. uiFrame <- uiFrameStick notebook (Just oldUIFrame) -- keep same UIFrame status with old one -- Create signal box. signalBox <- signalBoxNew uiFrame windowId sId signalBoxList -- Add page id information to tabbar, -- then will replace other information after render page create. -- And make sure render page will insert at correct place when call 'daemonHandleNewPageConfirm'. modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId 0 0 uiFrame)) -- Send `ReparentRenderPage` signal. mkRenderSignal client processId ReparentRenderPage (ReparentRenderPageArgs pageId oldPlugId (signalBoxId signalBox)) -- | Clone tabs of parent in child window. 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 -- | Enlarge window up. windowEnlargeUp :: Environment -> IO () windowEnlargeUp env = do (window, windowNodeList) <- envGet env windowNodeZoom windowNodeList (windowNode window) ZUp True -- | Enlarge window down. windowEnlargeDown :: Environment -> IO () windowEnlargeDown env = do (window, windowNodeList) <- envGet env windowNodeZoom windowNodeList (windowNode window) ZDown True -- | Enlarge window left. windowEnlargeLeft :: Environment -> IO () windowEnlargeLeft env = do (window, windowNodeList) <- envGet env windowNodeZoom windowNodeList (windowNode window) ZLeft True -- | Enlarge window right. windowEnlargeRight :: Environment -> IO () windowEnlargeRight env = do (window, windowNodeList) <- envGet env windowNodeZoom windowNodeList (windowNode window) ZRight True -- | Enlarge window. windowEnlarge :: Environment -> IO () windowEnlarge env = do windowEnlargeUp env windowEnlargeDown env windowEnlargeLeft env windowEnlargeRight env -- | Shrink window up. windowShrinkUp :: Environment -> IO () windowShrinkUp env = do (window, windowNodeList) <- envGet env windowNodeZoom windowNodeList (windowNode window) ZUp False -- | Shrink window down. windowShrinkDown :: Environment -> IO () windowShrinkDown env = do (window, windowNodeList) <- envGet env windowNodeZoom windowNodeList (windowNode window) ZDown False -- | Shrink window left. windowShrinkLeft :: Environment -> IO () windowShrinkLeft env = do (window, windowNodeList) <- envGet env windowNodeZoom windowNodeList (windowNode window) ZLeft False -- | Shrink window right. windowShrinkRight :: Environment -> IO () windowShrinkRight env = do (window, windowNodeList) <- envGet env windowNodeZoom windowNodeList (windowNode window) ZRight False -- | Shrink window. windowShrink :: Environment -> IO () windowShrink env = do windowShrinkUp env windowShrinkDown env windowShrinkLeft env windowShrinkRight env