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)))
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)
socketFrameNew :: IO Gtk.Frame
socketFrameNew = frameNewWithShadowType Nothing
signalBoxNew :: UIFrame -> WindowId -> TVar SignalBoxId -> TVar SignalBoxList -> IO SignalBox
signalBoxNew uiFrame windowId signalBoxCounter signalBoxList = do
signalBoxId <- tickTVarIO signalBoxCounter
let signalBox = SignalBox signalBoxId uiFrame windowId
runTVarStateT signalBoxList $ put . Set.insert signalBox
return signalBox
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)
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
uiFrame <- uiFrameStick notebook Nothing
signalBox <- signalBoxNew uiFrame windowId sId signalBoxList
modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId 0 0 uiFrame))
mkRenderSignal client processId CloneRenderPage (CloneRenderPageArgs pageId (signalBoxId signalBox))
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
getCurrentInteractivebar :: Environment -> IO (Maybe Interactivebar)
getCurrentInteractivebar env =
getCurrentUIFrame env >?>=>
(return . Just . uiFrameInteractivebar)
getCurrentUIFrame :: Environment -> IO (Maybe UIFrame)
getCurrentUIFrame env =
getCurrentTab env >?>=> \ tab -> return $ Just (tabUIFrame tab)
getWindowPageModeName :: Environment -> Window -> IO (Maybe PageModeName)
getWindowPageModeName env window = do
tabbar <- envGet env
return $ tabbarGetPageModeName tabbar (windowGetId window)
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
getNextWindow :: WindowList -> Maybe Window
getNextWindow windowList
| LZ.length windowList <= 1
= Nothing
| otherwise
= LZ.getRightCircular windowList
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."
message :: Environment -> String -> IO ()
message env output =
getCurrentUIFrame env >?>= \frame ->
uiFrameShowOutputbar frame output
focusCurrentTab :: Environment -> IO ()
focusCurrentTab env = do
client <- envGet env
popupWindowExit_ env
getCurrentTab env >?>= \ Tab {tabProcessId = processId
,tabPlugId = plugId} ->
mkRenderSignal client processId FocusRenderPage (FocusRenderPageArgs plugId)
anythingInitStartup :: Frame -> VBox -> Interactivebar -> IO ()
anythingInitStartup frame anythingBox interactivebar = do
containerRemoveAll frame
containerRemoveAll anythingBox
interactivebarSetTitle interactivebar "Search "
interactivebarSetContent interactivebar ""
interactivebarShow anythingBox interactivebar
frame `containerAdd` anythingBox
widgetShowAll anythingBox
startupAnything (SpawnAnythingProcessArgs GlobalSearchArgs)
removeTabs :: Tabbar -> Client -> Window -> IO Tabbar
removeTabs (Tabbar tabbar) client window = do
let windowId = windowGetId window
notebook = windowNotebook window
containerRemoveAll notebook
forM_ (tabbarGetTabList windowId (Tabbar tabbar)) $
\ Tab {tabProcessId = processId
,tabPageId = pageId
,tabPlugId = plugId} ->
mkRenderSignal client processId DestroyRenderPage (DestroyRenderPageArgs pageId plugId)
return $ tabbarRemoveTabs windowId (Tabbar tabbar)
exitAllRenderProcess :: Environment -> IO ()
exitAllRenderProcess env = do
(client, bufferListTVar) <- envGet env
modifyTVarIOM bufferListTVar $ \ (BufferList bufferList) -> do
forM_ (M.toList bufferList) $ \ (_, bufferSeq) ->
forM_ (F.toList bufferSeq) $ \ Buffer {bufferProcessId = processId
,bufferPageId = pageId} ->
mkRenderSignal client processId ExitRenderProcess (ExitRenderProcessArgs pageId)
return $ BufferList M.empty
focusSwitch :: Environment -> IO ()
focusSwitch env = do
focusStatus <- getFocusStatus env
case focusStatus of
FocusLocalInteractivebar -> focusCurrentTab env
FocusWindow -> envGet env >>= focusInteractivebar
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
isFocusOnInitInteractivebar :: VBox -> IO Bool
isFocusOnInitInteractivebar = widgetHasParent
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)
Just uiFrame ->
ifM (uiFrameIsFocusInteractivebar uiFrame)
(return FocusLocalInteractivebar)
(return FocusWindow))
highlightCurrentWindow :: (Window, TVar FocusNotifierList) -> IO ()
highlightCurrentWindow (window, focusNotifierList) =
focusNotifierShow (windowGetId window) focusNotifierList
focusInteractivebar :: (Environment, PopupWindow) -> IO ()
focusInteractivebar (env, popupWindow) =
getCurrentUIFrame env >?>= \uiFrame -> do
let interactivebar = uiFrameInteractivebar uiFrame
interactivebarSetTitle interactivebar "Search "
interactivebarSetContent interactivebar ""
uiFrameShowInteractivebar uiFrame
whenM (not <$> popupWindowIsVisible popupWindow)
(do
popupWindowActivate popupWindow interactivebar
startupAnything (SpawnAnythingProcessArgs GlobalSearchArgs))
startupAnything :: SpawnProcessArgs -> IO ()
startupAnything args =
runProcess_ "manatee-anything" [show args]
popupWindowActivate :: PopupWindow -> Interactivebar -> IO ()
popupWindowActivate popupWindow interactivebar = do
let entry = interactivebarEntry interactivebar
popupWindowStickParent popupWindow entry
popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1)
popupWindowShow popupWindow
exitInteractivebar :: Environment -> IO ()
exitInteractivebar env =
getCurrentUIFrame env >?>= \uiFrame -> do
interactivebarExit (uiFrameBox uiFrame) (uiFrameInteractivebar uiFrame)
popupWindowExit_ env
popupWindowExit_ :: Environment -> IO ()
popupWindowExit_ env = do
popupWindowExit (envAnythingPopupWindow env)
tryPutMVar (envLocalInteractiveLock env) (Left "Interactivebar exit.")
tryPutMVar (envGlobalInteractiveLock env) (Left "Interactivebar exit.")
return ()
tabbarSyncNewTab :: Environment -> WindowId -> DaemonSignalArgs -> IO ()
tabbarSyncNewTab env wId (NewRenderPageConfirmArgs pageId _ _ _ processId modeName _ _) = do
(tabbarTVar, (Tabbar tabbar, (windowList, (client, (signalBoxList, signalBoxId))))) <- envGet env
forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), tabSeq) ->
when (windowId /= wId && pageModeName == modeName) $
unless (any (\x -> tabProcessId x == processId) (F.toList tabSeq)) $
windowListGetWindow windowId windowList ?>= \window ->
cloneTab window client tabbarTVar signalBoxList signalBoxId (modeName, processId, pageId)
getToplevelContainer :: Environment -> Container
getToplevelContainer = toContainer . envFrame
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