-- 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 . {-# LANGUAGE ExistentialQuantification, DeriveDataTypeable, TypeSynonymInstances, RankNTypes, FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} module Manatee.Action.Basic where import Control.Applicative hiding (empty) import Control.Concurrent.MVar import Control.Concurrent.STM.TVar import Control.Monad.State import DBus.Client hiding (Signal) import Data.Text.Lazy (Text) import Graphics.UI.Gtk hiding (Action, Frame, Window) import Manatee.Action.Tabbar import Manatee.Core.DBus import Manatee.Core.Types import Manatee.Toolkit.General.Basic import Manatee.Toolkit.General.List import Manatee.Toolkit.General.Maybe import Manatee.Toolkit.General.Process import Manatee.Toolkit.General.STM import Manatee.Toolkit.General.Seq import Manatee.Toolkit.General.State import Manatee.Toolkit.Gtk.Container import Manatee.Toolkit.Gtk.Editable import Manatee.Toolkit.Gtk.Gtk import Manatee.Toolkit.Widget.Interactivebar import Manatee.Toolkit.Widget.NotebookTab import Manatee.Toolkit.Widget.PopupWindow import Manatee.Types import Manatee.UI.FocusNotifier import Manatee.UI.Frame import Manatee.UI.UIFrame import Manatee.UI.Window hiding (windowNew) import System.Posix.Types (ProcessID) import qualified Data.Foldable as F import qualified Data.Map as M import qualified Data.Set as Set import qualified Graphics.UI.Gtk as Gtk import qualified Manatee.Toolkit.Data.ListZipper as LZ type PageActionInputArgs = (Window, (TVar SignalBoxList, (TVar PageId, TVar SignalBoxId))) -- | Run action. runAction :: Environment -> Action -> IO () runAction env (Action {actionFun = fun}) = envGet env >>= fun >>= envPut env (==>) :: forall a b . (ActionInputArgs a, ActionOutputArgs b) => Text -> (a -> IO b) -> (Text, Action) key ==> command = (key, Action command) -- | Build socket frame. socketFrameNew :: IO Gtk.Frame socketFrameNew = frameNewWithShadowType Nothing -- | Create new signal box. signalBoxNew :: UIFrame -> WindowId -> TVar SignalBoxId -> TVar SignalBoxList -> IO SignalBox signalBoxNew uiFrame windowId signalBoxCounter signalBoxList = do -- Ticker signal box counter. signalBoxId <- tickTVarIO signalBoxCounter -- Create signal box. let signalBox = SignalBox signalBoxId uiFrame windowId -- Add new SignalBox to list. runTVarStateT signalBoxList $ put . Set.insert signalBox return signalBox -- | Clone tabs. cloneTabs :: Window -> Client -> TVar Tabbar -> TVar SignalBoxList -> TVar SignalBoxId -> [(PageModeName, ProcessID, PageId)] -> IO () cloneTabs window client tabbarTVar signalBoxList sId = mapM_ (cloneTab window client tabbarTVar signalBoxList sId) -- | Clone tab. cloneTab :: Window -> Client -> TVar Tabbar -> TVar SignalBoxList -> TVar SignalBoxId -> (PageModeName, ProcessID, PageId) -> IO () cloneTab window client tabbarTVar signalBoxList sId (modeName, processId, pageId) = do let windowId = windowGetId window notebook = windowNotebook window -- Create new socket frame. uiFrame <- uiFrameStick notebook Nothing -- 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 CloneRenderPage (CloneRenderPageArgs pageId (signalBoxId signalBox)) -- | Synchronization tab name. syncTabName :: Environment -> WindowId -> IO () syncTabName env windowId = do (tabbar, (BufferList bufferList)) <- envGet env tabbarGetTabInfo tabbar windowId ?>= \ (modeName, tabSeq) -> M.lookup modeName bufferList ?>= \ seqBuffer -> do let nameList = map bufferName $ F.toList seqBuffer zipWithIndexM_ nameList $ \name index -> do maybeIndex tabSeq index ?>= \tab -> notebookTabSetName (uiFrameNotebookTab $ tabUIFrame tab) name -- | Get current interactivebar. getCurrentInteractivebar :: Environment -> IO (Maybe Interactivebar) getCurrentInteractivebar env = getCurrentUIFrame env >?>=> (return . Just . uiFrameInteractivebar) -- | Get current uiFrame. getCurrentUIFrame :: Environment -> IO (Maybe UIFrame) getCurrentUIFrame env = getCurrentTab env >?>=> \ tab -> return $ Just (tabUIFrame tab) -- | Get page mode name of specify window. getWindowPageModeName :: Environment -> Window -> IO (Maybe PageModeName) getWindowPageModeName env window = do tabbar <- envGet env return $ tabbarGetPageModeName tabbar (windowGetId window) -- | Get current tab. getCurrentTab :: Environment -> IO (Maybe Tab) getCurrentTab env = do (tabbar, window) <- envGet env tabbarGetTabSeq tabbar (windowGetId window) ?>=> \ tabSeq -> do currentPageIndex <- notebookGetCurrentPage (windowNotebook window) return $ maybeIndex tabSeq currentPageIndex -- | Get next window. getNextWindow :: WindowList -> Maybe Window getNextWindow windowList | LZ.length windowList <= 1 = Nothing | otherwise = LZ.getRightCircular windowList -- | Action in next window. withNextWindow :: Environment -> (Window -> IO ()) -> IO () withNextWindow env action = do windowList <- envGet env case getNextWindow windowList of Just win -> action win Nothing -> message env "Just current window exist." -- | Display message. message :: Environment -> String -> IO () message env output = getCurrentUIFrame env >?>= \frame -> uiFrameShowOutputbar frame output -- | Focus current tab.. focusCurrentTab :: Environment -> IO () focusCurrentTab env = do client <- envGet env -- Exit popup window. popupWindowExit_ env -- Send `FocusRenderPage` signal to focus page. getCurrentTab env >?>= \ Tab {tabProcessId = processId ,tabPlugId = plugId} -> mkRenderSignal client processId FocusRenderPage (FocusRenderPageArgs plugId) -- | Init anything view. anythingInitStartup :: Frame -> VBox -> Interactivebar -> IO () anythingInitStartup frame anythingBox interactivebar = do -- Clean first. containerRemoveAll frame containerRemoveAll anythingBox -- Add box and interactivebar. interactivebarInit interactivebar anythingBox "Search " "" frame `containerAdd` anythingBox widgetShowAll anythingBox -- Start anything process. startupAnything (SpawnAnythingProcessArgs GlobalSearchArgs) -- | Remove tabs match window id. removeTabs :: Tabbar -> Client -> Window -> IO Tabbar removeTabs (Tabbar tabbar) client window = do let windowId = windowGetId window notebook = windowNotebook window -- Remove all tab widget from notebook. containerRemoveAll notebook -- Send tab destroy signal to child process. forM_ (tabbarGetTabList windowId (Tabbar tabbar)) $ \ Tab {tabProcessId = processId ,tabPageId = pageId ,tabPlugId = plugId} -> mkRenderSignal client processId DestroyRenderPage (DestroyRenderPageArgs pageId plugId) -- Return new tabbar that remove all tabs match window id. return $ tabbarRemoveTabs windowId (Tabbar tabbar) -- | Exit all render processes. exitAllRenderProcess :: Environment -> IO () exitAllRenderProcess env = do (client, bufferListTVar) <- envGet env modifyTVarIOM bufferListTVar $ \ (BufferList bufferList) -> do -- Send dbus signal `ExitRenderProcess` to all render processes. forM_ (M.toList bufferList) $ \ (_, bufferSeq) -> forM_ (F.toList bufferSeq) $ \ Buffer {bufferProcessId = processId ,bufferPageId = pageId} -> mkRenderSignal client processId ExitRenderProcess (ExitRenderProcessArgs pageId) -- Clean up buffer list. return $ BufferList M.empty -- | Switch focus. focusSwitch :: Environment -> IO () focusSwitch env = do focusStatus <- getFocusStatus env case focusStatus of FocusLocalInteractivebar -> focusCurrentTab env FocusWindow -> envGet env >>= focusInteractivebar -- | Focus tab. focusTab :: Environment -> IO () focusTab env = do focusStatus <- getFocusStatus env case focusStatus of FocusWindow -> do focusCurrentTab env envGet env >>= highlightCurrentWindow FocusLocalInteractivebar -> envGet env >>= highlightCurrentWindow FocusInitInteractivebar -> editableFocus $interactivebarEntry $ envInitInteractivebar env -- | Is focus on init interactivebar. isFocusOnInitInteractivebar :: VBox -> IO Bool isFocusOnInitInteractivebar = widgetHasParent -- | Get focus status. getFocusStatus :: Environment -> IO FocusStatus getFocusStatus env = do let initBox = envInitBox env ifM (isFocusOnInitInteractivebar initBox) (return FocusInitInteractivebar) (do currentUIFrame <- getCurrentUIFrame env case currentUIFrame of Nothing -> (return FocusWindow) -- focus window when can't found page Just uiFrame -> ifM (uiFrameIsFocusInteractivebar uiFrame) (return FocusLocalInteractivebar) (return FocusWindow)) -- | Highlight window. highlightCurrentWindow :: (Window, TVar FocusNotifierList) -> IO () highlightCurrentWindow (window, focusNotifierList) = focusNotifierShow (windowGetId window) focusNotifierList -- | Focus input. focusInteractivebar :: (Environment, PopupWindow) -> IO () focusInteractivebar (env, popupWindow) = getCurrentUIFrame env >?>= \uiFrame -> do let interactivebar = uiFrameInteractivebar uiFrame -- Show interactivebar. uiFrameInit uiFrame "Search " "" -- When PopupWindow is invisible startup anythingView process. whenM (not <$> popupWindowIsVisible popupWindow) (do -- Activate popup window. popupWindowActivate popupWindow interactivebar -- Start anything process. startupAnything (SpawnAnythingProcessArgs GlobalSearchArgs)) -- | Startup anything. startupAnything :: SpawnProcessArgs -> IO () startupAnything args = runProcess_ "manatee-anything" [show args] -- | Activate popup window. popupWindowActivate :: PopupWindow -> Interactivebar -> IO () popupWindowActivate popupWindow interactivebar = do let entry = interactivebarEntry interactivebar -- Stick entry. popupWindowStickParent popupWindow entry -- Set minimize size hide popupwindow. popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1) -- Show popup window. popupWindowShow popupWindow -- | Exit input. exitInteractivebar :: Environment -> IO () exitInteractivebar env = getCurrentUIFrame env >?>= \uiFrame -> do interactivebarExit (uiFrameBox uiFrame) (uiFrameInteractivebar uiFrame) popupWindowExit_ env -- | Exit popup window and fill envLocalInteractiveLock. popupWindowExit_ :: Environment -> IO () popupWindowExit_ env = do popupWindowExit (envAnythingPopupWindow env) tryPutMVar (envLocalInteractiveLock env) (Left "Interactivebar exit.") tryPutMVar (envGlobalInteractiveLock env) (Left "Interactivebar exit.") return () -- | Synchronization new tab in window. tabbarSyncNewTab :: Environment -> WindowId -> DaemonSignalArgs -> IO () tabbarSyncNewTab env wId (NewRenderPageConfirmArgs pageId _ _ _ processId modeName _ _) = do (tabbarTVar, (Tabbar tabbar, (windowList, (client, (signalBoxList, signalBoxId))))) <- envGet env -- Synchronization tab in all same mode window. forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), tabSeq) -> -- When window mode same as tab mode and not current window. when (windowId /= wId && pageModeName == modeName) $ -- And tab haven't exist in current window. unless (any (\x -> tabProcessId x == processId) (F.toList tabSeq)) $ -- Then clone tab in current window. windowListGetWindow windowId windowList ?>= \window -> cloneTab window client tabbarTVar signalBoxList signalBoxId (modeName, processId, pageId) -- | Get top-level container. getToplevelContainer :: Environment -> Container getToplevelContainer = toContainer . envFrame -- | Get focus window. getFocusWindow :: Environment -> IO Window getFocusWindow env = do let container = getToplevelContainer env focusNotifierList = envFocusNotifierList env windowList = envWindowList env windowNodeList = envWindowNodeList env focusWindow <- windowListGetFocusWindow windowList windowNodeList focusNotifierList container case focusWindow of Just window -> return window Nothing -> error "getFocusWindow: can't found any window." instance ActionInputArgs Frame where envGet = return . envFrame instance ActionInputArgs Client where envGet = return . envDaemonClient instance ActionInputArgs Environment where envGet = return instance ActionInputArgs Window where envGet = getFocusWindow instance ActionInputArgs Container where envGet = return . getToplevelContainer instance ActionInputArgs VBox where envGet = return . envInitBox instance ActionInputArgs Interactivebar where envGet = return . envInitInteractivebar instance ActionInputArgs WindowList where envGet = readTVarIO . envWindowList instance ActionInputArgs WindowNodeList where envGet = readTVarIO . envWindowNodeList instance ActionInputArgs FocusNotifierList where envGet = readTVarIO . envFocusNotifierList instance ActionInputArgs Tabbar where envGet = readTVarIO . envTabbar instance ActionInputArgs BufferList where envGet = readTVarIO . envBufferList instance ActionInputArgs (TVar WindowList) where envGet = return . envWindowList instance ActionInputArgs (TVar WindowNodeList) where envGet = return . envWindowNodeList instance ActionInputArgs (TVar FocusNotifierList) where envGet = return . envFocusNotifierList instance ActionInputArgs (TVar SignalBoxList) where envGet = return . envSignalBoxList instance ActionInputArgs (TVar SignalBoxId) where envGet = return . envSignalBoxIdCounter instance ActionInputArgs (TVar ProcessID) where envGet = return . envAnythingProcessId instance ActionInputArgs (TVar Tabbar) where envGet = return . envTabbar instance ActionInputArgs (TVar BufferList) where envGet = return . envBufferList instance ActionInputArgs (TVar TabCloseHistory) where envGet = return . envTabCloseHistory instance ActionInputArgs ProcessID where envGet = readTVarIO . envAnythingProcessId instance ActionInputArgs PopupWindow where envGet = return . envAnythingPopupWindow instance ActionOutputArgs WindowList where envPut = writeTVarIO . envWindowList instance ActionOutputArgs WindowNodeList where envPut = writeTVarIO . envWindowNodeList instance ActionOutputArgs Tabbar where envPut = writeTVarIO . envTabbar instance ActionOutputArgs BufferList where envPut = writeTVarIO . envBufferList