module Manatee.Action.Tab where
import Control.Concurrent.STM.TVar
import Control.Monad
import Data.List (partition)
import Graphics.UI.Gtk hiding (Action, Frame, Window)
import Manatee.Action.Basic
import Manatee.Action.BufferList
import Manatee.Action.Tabbar
import Manatee.Action.Window
import Manatee.Core.DBus
import Manatee.Core.PageMode
import Manatee.Core.Config
import Manatee.Core.Types
import Manatee.Toolkit.General.Basic hiding (swap)
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.Map
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.Process
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.Gtk.Notebook
import Manatee.Types
import Manatee.UI.UIFrame
import Manatee.UI.Window hiding (windowNew)
import qualified Data.Foldable as F
import qualified Data.Map as M
import qualified Data.Sequence as Seq
newTab :: PageType -> PagePath -> Environment -> IO ()
newTab pType pPath env = do
bufferList <- envGet env
modeName <- getPageModeName pType pPath
case bufferListGetBufferIndex bufferList modeName pPath of
Just i -> do
tabSwitchGroupCurrentWindow env modeName
window <- envGet env
notebookSetCurrentPage (windowNotebook window) i
Nothing -> newTabInternal pType pPath env
newTabInternal :: PageType -> PagePath -> Environment -> IO ()
newTabInternal pType pPath env = do
(PageTypeRule rule) <- readConfig pageTypeRulePath (PageTypeRule M.empty)
case findMinMatch rule (\ typ _ -> typ == pType) of
Nothing -> putStrLn $ "newTabInternal : Can't found rule for `" ++ pType ++ "`"
Just (_, binaryPath) -> do
(window, (tabbarTVar, (bufferListTVar, (signalBoxList, (pId, sId))))) <- envGet env
let notebook = windowNotebook window
pageId <- tickTVarIO pId
modeName <- getPageModeName pType pPath
tabSwitchGroupCurrentWindow env modeName
uiFrame <- uiFrameStick notebook Nothing
let windowId = windowGetId window
signalBox <- signalBoxNew uiFrame windowId sId signalBoxList
modifyTVarIO bufferListTVar (bufferListAddBuffer (modeName, 0, pageId, pType, ""))
modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId 0 0 uiFrame))
runProcess_ binaryPath [show (SpawnRenderProcessArgs pageId pType (signalBoxId signalBox) pPath)]
return ()
tabMoveToLeftWithNextWindow :: Environment -> IO ()
tabMoveToLeftWithNextWindow env =
withNextWindow env $ \win -> tabMoveToLeft (win, env)
tabMoveToRightWithNextWindow :: Environment -> IO ()
tabMoveToRightWithNextWindow env =
withNextWindow env $ \win -> tabMoveToRight (win, env)
tabMoveToBeginWithNextWindow :: Environment -> IO ()
tabMoveToBeginWithNextWindow env =
withNextWindow env $ \win -> tabMoveToBegin (win, env)
tabMoveToEndWithNextWindow :: Environment -> IO ()
tabMoveToEndWithNextWindow env =
withNextWindow env $ \win -> tabMoveToEnd (win, env)
tabMoveToLeft :: (Window, Environment) -> IO ()
tabMoveToLeft (window, env) = do
(windowList, tabbar) <- envGet env
windowListGetWindow (windowGetId window) windowList ?>= \ window -> do
let notebook = windowNotebook window
unlessM (notebookAtStart notebook) $
tabbarGetPageModeName tabbar (windowGetId window) ?>= \modeName -> do
currentPageIndex <- notebookGetCurrentPage notebook
tabMove env modeName currentPageIndex (currentPageIndex 1)
tabMoveToRight :: (Window, Environment) -> IO ()
tabMoveToRight (window, env) = do
(windowList, tabbar) <- envGet env
windowListGetWindow (windowGetId window) windowList ?>= \ window -> do
let notebook = windowNotebook window
unlessM (notebookAtEnd notebook) $
tabbarGetPageModeName tabbar (windowGetId window) ?>= \modeName -> do
currentPageIndex <- notebookGetCurrentPage notebook
tabMove env modeName currentPageIndex (currentPageIndex + 1)
tabMoveToBegin :: (Window, Environment) -> IO ()
tabMoveToBegin (window, env) = do
(windowList, tabbar) <- envGet env
windowListGetWindow (windowGetId window) windowList ?>= \ window -> do
let notebook = windowNotebook window
unlessM (notebookAtStart notebook) $
tabbarGetPageModeName tabbar (windowGetId window) ?>= \modeName -> do
currentPageIndex <- notebookGetCurrentPage notebook
firstIndex <- notebookFirstIndex notebook
tabMove env modeName currentPageIndex firstIndex
tabMoveToEnd :: (Window, Environment) -> IO ()
tabMoveToEnd (window, env) = do
(windowList, tabbar) <- envGet env
windowListGetWindow (windowGetId window) windowList ?>= \ window -> do
let notebook = windowNotebook window
unlessM (notebookAtEnd notebook) $
tabbarGetPageModeName tabbar (windowGetId window) ?>= \modeName -> do
currentPageIndex <- notebookGetCurrentPage notebook
lastIndex <- notebookLastIndex notebook
tabMove env modeName currentPageIndex lastIndex
tabMove :: Environment -> PageModeName -> Int -> Int -> IO ()
tabMove env pageModeName currentIndex targetIndex = do
(bufferListTVar, tabbarTVar) <- envGet env
modifyTVarIO bufferListTVar (bufferListSwapBuffer pageModeName currentIndex targetIndex)
windowSwapTab env pageModeName currentIndex targetIndex
modifyTVarIO tabbarTVar (tabbarSwapTab pageModeName currentIndex targetIndex)
tabSelectNext :: Window -> IO ()
tabSelectNext =
notebookSelectNextPage . windowNotebook
tabSelectPrev :: Window -> IO ()
tabSelectPrev =
notebookSelectPrevPage . windowNotebook
tabSelectFirst :: Window -> IO ()
tabSelectFirst =
notebookSelectFirstPage . windowNotebook
tabSelectLast :: Window -> IO ()
tabSelectLast =
notebookSelectLastPage . windowNotebook
tabSelectNextWithNextWindow :: Environment -> IO ()
tabSelectNextWithNextWindow env =
withNextWindow env tabSelectNext
tabSelectPrevWithNextWindow :: Environment -> IO ()
tabSelectPrevWithNextWindow env =
withNextWindow env tabSelectPrev
tabSelectFirstWithNextWindow :: Environment -> IO ()
tabSelectFirstWithNextWindow env =
withNextWindow env tabSelectFirst
tabSelectLastWithNextWindow :: Environment -> IO ()
tabSelectLastWithNextWindow env =
withNextWindow env tabSelectLast
tabClose :: Environment -> PageId -> IO ()
tabClose env tPageId = do
(client, (window, (tabbarTVar, bufferListTVar))) <- envGet env
let windowId = windowGetId window
(Tabbar tabbar) <- readTVarIO tabbarTVar
tabbarGetTabInfo (Tabbar tabbar) windowId
?>= \ (modeName, tabSeq) ->
Seq.findIndexL (\x -> tabPageId x == tPageId) tabSeq
?>= \ currentPageIndex ->
F.toList tabSeq ?! currentPageIndex
?>= \ Tab {tabProcessId = processId
,tabPageId = pageId} -> do
nextMode <-
getWindowPageModeName env window
>?>=> \currentModeName -> do
(BufferList bufferList) <- readTVarIO bufferListTVar
return $ findNextCycle (== currentModeName) (M.keys bufferList)
pushCloseTab env modeName pageId
modifyTVarIO bufferListTVar (bufferListRemoveBuffer modeName currentPageIndex)
pageModeDuplicateTabList <- getDuplicateTabList
unless (modeName `elem` pageModeDuplicateTabList) $
modifyTVarIO bufferListTVar (bufferListUniqueName modeName)
windowRemoveTab env modeName currentPageIndex nextMode
modifyTVarIO tabbarTVar (tabbarRemoveTab modeName currentPageIndex)
mkRenderSignal client processId ExitRenderProcess (ExitRenderProcessArgs pageId)
bufferList <- readTVarIO bufferListTVar
unless (bufferListHaveBufferExist bufferList) $
windowCloseAll env
pushCloseTab :: Environment -> PageModeName -> PageId -> IO ()
pushCloseTab env pageModeName pageId = do
(bufferList, tabCloseHistoryTVar) <- envGet env
bufferListGetBuffer bufferList pageModeName pageId
?>= \ Buffer {bufferPageType = pageType
,bufferPath = pagePath} ->
modifyTVarIO tabCloseHistoryTVar $ \ (TabCloseHistory historyList) ->
let newItem = (pageModeName, pageType, pagePath)
(_, list) = partition (== newItem) historyList
in TabCloseHistory (newItem : list)
tabUndoCloseGlobal :: Environment -> IO ()
tabUndoCloseGlobal env = do
tabCloseHistoryTVar <- envGet env
(TabCloseHistory history) <- readTVarIO tabCloseHistoryTVar
unless (null history) $ do
let ([(_, pageType, pagePath)], restList) = splitAt 1 history
newTab pageType pagePath env
writeTVarIO tabCloseHistoryTVar (TabCloseHistory restList)
tabUndoCloseLocal :: Environment -> IO ()
tabUndoCloseLocal env = do
focusStatus <- getFocusStatus env
case focusStatus of
FocusInitInteractivebar -> tabUndoCloseGlobal env
_ -> do
(tabCloseHistoryTVar, window) <- envGet env
(TabCloseHistory history) <- readTVarIO tabCloseHistoryTVar
getWindowPageModeName env window
>?>= \ currentModeName -> do
let filterList = filter (\ (modeName, _, _) -> modeName == currentModeName) history
unless (null filterList) $ do
let ([undoItem@(_, pageType, pagePath)], _) = splitAt 1 filterList
newTab pageType pagePath env
writeTVarIO tabCloseHistoryTVar (TabCloseHistory (snd $ partition (== undoItem) history))
tabUpdateOutput :: TVar Tabbar -> PagePlugId -> String -> IO ()
tabUpdateOutput tabbar plugId output = do
tabs <- readTVarIO tabbar
tabbarGetTab plugId tabs ?>= \ tab ->
uiFrameShowOutputbar (tabUIFrame tab) output
tabUpdateStatus :: TVar Tabbar -> PagePlugId -> String -> String -> IO ()
tabUpdateStatus tabbar plugId item status = do
tabs <- readTVarIO tabbar
tabbarGetTab plugId tabs ?>= \ tab ->
uiFrameUpdateStatusbar (tabUIFrame tab) item status
tabUpdateProgress :: TVar Tabbar -> PagePlugId -> Double -> IO ()
tabUpdateProgress tabbar plugId progress = do
tabs <- readTVarIO tabbar
tabbarGetTab plugId tabs ?>= \ tab ->
uiFrameUpdateProgress (tabUIFrame tab) progress
tabGetCurrentPageId :: Environment -> IO (Maybe PageId)
tabGetCurrentPageId env = do
(window, tabbarTVar) <- envGet env
let windowId = windowGetId window
currentPageIndex <- notebookGetCurrentPage (windowNotebook window)
(Tabbar tabbar) <- readTVarIO tabbarTVar
tabbarGetTabInfo (Tabbar tabbar) windowId
?>=> \ (_, tabSeq) ->
F.toList tabSeq ?! currentPageIndex
?>=> \ Tab {tabPageId = pageId} ->
return $ Just pageId
tabCloseCurrent :: Environment -> IO ()
tabCloseCurrent env =
tabGetCurrentPageId env
>?>= \ pageId ->
tabClose env pageId
tabCloseOthers :: Environment -> IO ()
tabCloseOthers env = do
(window, tabbarTVar) <- envGet env
tabGetCurrentPageId env
>?>= \ currentPageId -> do
let windowId = windowGetId window
(Tabbar tabbar) <- readTVarIO tabbarTVar
tabbarGetTabInfo (Tabbar tabbar) windowId
?>= \ (_, tabSeq) ->
forM_ (F.toList tabSeq) $ \ Tab {tabPageId = pageId} ->
when (pageId /= currentPageId) $
tabClose env pageId
tabForwardGroup :: (Window, Environment) -> IO ()
tabForwardGroup (window, env) =
tabForwardGroupWithWindow env window
tabBackwardGroup :: (Window, Environment) -> IO ()
tabBackwardGroup (window, env) =
tabBackwardGroupWithWindow env window
tabForwardGroupWithNextWindow :: Environment -> IO ()
tabForwardGroupWithNextWindow env =
withNextWindow env (tabForwardGroupWithWindow env)
tabBackwardGroupWithNextWindow :: Environment -> IO ()
tabBackwardGroupWithNextWindow env =
withNextWindow env (tabBackwardGroupWithWindow env)
tabBackwardGroupWithWindow :: Environment -> Window -> IO ()
tabBackwardGroupWithWindow env window = do
(BufferList bufferList) <- envGet env
getWindowPageModeName env window
>?>= \currentModeName ->
findPrevCycle (\ (modeName, _) -> modeName == currentModeName) (M.toList bufferList)
?>= \ (prevModeName, _) ->
tabSwitchGroupWithWindow env window prevModeName
tabForwardGroupWithWindow :: Environment -> Window -> IO ()
tabForwardGroupWithWindow env window = do
(BufferList bufferList) <- envGet env
getWindowPageModeName env window
>?>= \currentModeName ->
findNextCycle (\ (modeName, _) -> modeName == currentModeName) (M.toList bufferList)
?>= \ (nextModeName, _) ->
tabSwitchGroupWithWindow env window nextModeName
tabSwitchGroupCurrentWindow :: Environment -> PageModeName -> IO ()
tabSwitchGroupCurrentWindow env pageModeName = do
window <- envGet env
tabSwitchGroupWithWindow env window pageModeName
tabSwitchGroupWithWindow :: Environment -> Window -> PageModeName -> IO ()
tabSwitchGroupWithWindow env window pageModeName = do
(Tabbar tabbar, (tabbarTVar, (BufferList bufferList, (client, (signalBoxList, sId))))) <- envGet env
let windowId = windowGetId window
windowMode = findMinMatch tabbar (\ (wId, wModeName) _ -> wId == windowId && wModeName == pageModeName)
case windowMode of
Just _ -> return ()
Nothing -> do
modifyTVarIOM tabbarTVar $ \ tabs -> removeTabs tabs client window
findMinMatch bufferList (\ name _ -> name == pageModeName)
?>= \ (_, bufferSeq) -> do
let tabDataList = map (\x -> (pageModeName, bufferProcessId x, bufferPageId x)) $ F.toList bufferSeq
cloneTabs window client tabbarTVar signalBoxList sId tabDataList
windowRemoveTab :: Environment -> PageModeName -> Int -> Maybe PageModeName -> IO ()
windowRemoveTab env modeName currentPageIndex nextMode = do
(Tabbar tabbar, windowList) <- envGet env
forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), _) ->
when (pageModeName == modeName) $
windowListGetWindow windowId windowList
?>= \ window -> do
notebookRemovePage (windowNotebook window) currentPageIndex
syncTabName env windowId
number <- notebookGetNPages (windowNotebook window)
when (number == 0) $
nextMode ?>= \mode ->
tabSwitchGroupWithWindow env window mode
windowSwapTab :: Environment -> PageModeName -> Int -> Int -> IO ()
windowSwapTab env pageModeName currentIndex targetIndex = do
(Tabbar tabbar, windowList) <- envGet env
let filterMap = M.filterWithKey (\(_, modeName) _ -> modeName == pageModeName) tabbar
forM_ (M.toList filterMap) $ \ ((windowId, _), _) ->
windowListGetWindow windowId windowList ?>= \ window ->
notebookGetNthPage (windowNotebook window) currentIndex >?>= \ child ->
notebookReorderChild (windowNotebook window) child targetIndex