diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 @@ -21,7 +21,29 @@ module Main where import Manatee.Daemon +import System.Environment +-- | Help string. +helpString :: String +helpString = + "Welcome to Manatee (The Haskell/Gtk+ Integrated Live Environment)\n\n" + ++ "Options:\n" + ++ " --no-restate, -nr don't restore state\n" + ++ " --help display this help and exit\n\n" + ++ "Please report bug to lazycat.manatee@gmail.com if you found any problem, thanks!" + -- | main entry. main :: IO () -main = daemonMain +main = do + -- Get program arguments. + args <- getArgs + + case args of + [] -> + daemonMain True + ["--no-restore"] -> + daemonMain False + ["-nr"] -> + daemonMain False + _ -> + putStrLn helpString diff --git a/Manatee/Action/Basic.hs b/Manatee/Action/Basic.hs --- a/Manatee/Action/Basic.hs +++ b/Manatee/Action/Basic.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 @@ -18,36 +18,42 @@ {-# LANGUAGE ExistentialQuantification, DeriveDataTypeable, TypeSynonymInstances, RankNTypes, FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module Manatee.Action.Basic where import Control.Applicative hiding (empty) -import Control.Concurrent.MVar import Control.Concurrent.STM.TVar -import Control.Monad.State +import Control.Monad.State hiding (get) import DBus.Client hiding (Signal) +import Data.List (partition) import Data.Text.Lazy (Text) -import Graphics.UI.Gtk hiding (Action, Frame, Window) +import Graphics.UI.Gtk hiding (Action, Frame, Window, layoutPath) +import Manatee.Action.BufferList import Manatee.Action.Tabbar +import Manatee.Core.Config import Manatee.Core.DBus import Manatee.Core.Types -import Manatee.Toolkit.General.Basic +import Manatee.Toolkit.Data.ListZipper hiding (length, delete, get) +import Manatee.Toolkit.Data.SetList +import Manatee.Toolkit.General.FilePath 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.Set hiding (mapM) 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 Manatee.UI.WindowNode +import System.Directory +import System.FilePath import System.Posix.Types (ProcessID) import qualified Data.Foldable as F @@ -85,50 +91,49 @@ return signalBox -- | Clone tabs. -cloneTabs :: Window -> Client -> TVar Tabbar -> TVar SignalBoxList -> TVar SignalBoxId -> [(PageModeName, ProcessID, PageId)] -> IO () +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 + -> 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 + uiFrame <- uiFrameStick notebook -- Create signal box. signalBox <- signalBoxNew uiFrame windowId sId signalBoxList + let sId = signalBoxId signalBox -- 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)) + modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId sId 0 0 uiFrame)) - -- Send `ReparentRenderPage` signal. - mkRenderSignal client processId CloneRenderPage (CloneRenderPageArgs pageId (signalBoxId signalBox)) + -- Send `CloneRenderPage` signal. + mkRenderSignal client processId CloneRenderPage (CloneRenderPageArgs pageId sId) -- | Synchronization tab name. syncTabName :: Environment -> WindowId -> IO () syncTabName env windowId = do - (tabbar, (BufferList bufferList)) <- envGet env + (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 + zipWithIndexM_ nameList $ \name index -> 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 = @@ -171,12 +176,9 @@ focusCurrentTab env = do client <- envGet env - -- Exit popup window. - popupWindowExit_ env - -- Send `FocusRenderPage` signal to focus page. getCurrentTab env >?>= \ Tab {tabProcessId = processId - ,tabPlugId = plugId} -> + ,tabPlugId = plugId} -> mkRenderSignal client processId FocusRenderPage (FocusRenderPageArgs plugId) -- | Update current tab. @@ -197,21 +199,6 @@ getCurrentTab env >?>= \ Tab {tabProcessId = processId} -> mkRenderSignal client processId InstallConfig InstallConfigArgs --- | 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 @@ -240,106 +227,26 @@ forM_ (M.toList bufferList) $ \ (_, bufferSeq) -> forM_ (F.toList bufferSeq) $ \ Buffer {bufferProcessId = processId ,bufferPageId = pageId} -> - mkRenderSignal client processId ExitRenderProcess (ExitRenderProcessArgs pageId) + mkRenderSignal client processId ExitRenderProcess (ExitRenderProcessArgs pageId True) -- 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)) +-- | Focus window. +focusWindow :: Environment -> IO () +focusWindow env = do + focusCurrentTab env + envGet env >>= highlightCurrentWindow -- | 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 +tabbarSyncNewTab env wId (NewRenderPageConfirmArgs pageId _ _ _ processId modeName _ _ _) = do + (tabbarTVar, (Tabbar tabbar, (windowList, (client, signalBoxList)))) <- envGet env -- Synchronization tab in all same mode window. forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), tabSeq) -> @@ -349,7 +256,7 @@ 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) + cloneTab window client tabbarTVar signalBoxList (envSignalBoxIdCounter env) (modeName, processId, pageId) -- | Get top-level container. getToplevelContainer :: Environment -> Container @@ -369,6 +276,239 @@ Just window -> return window Nothing -> error "getFocusWindow: can't found any window." +-- | Exit program. +exit :: Environment -> Bool -> IO () +exit env saveState = do + -- Clean old status first. + cleanOldLayoutState + -- Save layout state. + when saveState $ saveLayoutState env + -- Send broadcast quit signal, other process can listen this signal when daemon process quit. + client <- envGet env + mkDaemonBroadcastSignal client ExitDaemonProcess ExitDaemonProcessArgs + -- Need exit all render processes before exit daemon process. + exitAllRenderProcess env + -- Exit daemon process. + mainQuit + +-- | Clean old yout state. +cleanOldLayoutState :: IO () +cleanOldLayoutState = do + configDir <- getConfigDirectory + let stateDir = configDir statePath + isExist <- doesDirectoryExist stateDir + when isExist $ do + removeDirectoryRecursive stateDir + createDirectoryIfMissing True stateDir + +-- | Save layout state. +saveLayoutState :: Environment -> IO () +saveLayoutState env = do + -- Init. + (BufferList bufferList, (Tabbar tabbar, (windowList, (ListZipper windowLeftList windowRightList, windowNodeList)))) <- envGet env + + -- Get window node state. + let windowNodeStateCounter = listCounter windowNodeList + windowNodeStateList <- + fmap Set.fromList $ + mapM (\ node -> + WindowNodeState <$> pure (windowNodeId node) + <*> readTVarIO (windowNodeParentId node) + <*> readTVarIO (windowNodeChildLeftId node) + <*> readTVarIO (windowNodeChildRightId node) + <*> readTVarIO (windowNodeType node) + <*> pure (windowNodeDirection node)) + (setListGetList windowNodeList) + + -- Get window state. + let getWindowStateList = + mapM (\ Window {windowNode = node} -> do + let winId = windowNodeId node + (Rectangle _ _ w h) <- widgetGetAllocation $ windowNodePaned node + return $ WindowState winId (w, h)) + leftList <- getWindowStateList windowLeftList + rightList <- getWindowStateList windowRightList + + -- Get tabbar state. + pageIdCounter <- readTVarIO (envPageIdCounter env) + signalBoxIdCounter <- readTVarIO (envSignalBoxIdCounter env) + + tabPages <- newTVarIO Set.empty + tStateMap <- + forM (M.toList tabbar) $ \ ((windowId, pageModeName), tabSeq) -> do + tabbarStateSeq <- + mapM (\tab -> do + let pageId = tabPageId tab + modifyTVarIO tabPages (Set.insert pageId) + return $ TabState pageId (tabSignalBoxId tab)) + $ F.toList tabSeq + selectIndex <- + case windowListGetWindow windowId windowList of + Nothing -> do + putStrLn $ "saveLayoutState(): Impossible that can't found window " + ++ show windowId + ++ " to save state." + return 0 + Just w -> notebookGetCurrentPage (windowNotebook w) + return ((windowId, pageModeName), tabbarStateSeq, selectIndex) + + -- Get buffer list state. + tPages <- readTVarIO tabPages + let (foregroundPages, backgroundPages) = + unzip $ map (\ (pageModeName, bufferSeq) -> + let bufferList = map bufferPageId $ F.toList bufferSeq + (fList, bList) = partition (`Set.member` tPages) bufferList + in ((pageModeName, fList), (pageModeName, bList)) + ) $ M.toList bufferList + + -- Save layout state. + writeConfig layoutPath + (Just + (EnvironmentState + (WindowNodeStateList windowNodeStateCounter windowNodeStateList) + (WindowStateList leftList rightList) + (TabbarState tStateMap pageIdCounter signalBoxIdCounter) + (BufferListState foregroundPages backgroundPages) + )) + +-- | Restore layout. +restoreLayoutState :: Environment -> EnvironmentState -> IO () +restoreLayoutState env + EnvironmentState + {envStateWindowNodeList = + WindowNodeStateList {wnslCounter = nodeCounter + ,wnslSet = nodeSet} + ,envStateWindowList = + WindowStateList {wslLeft = winLeftList + ,wslRight = winRightList} + ,envStateTabbar = + TabbarState {tabbarStateList = tStates + ,tabbarStatePageIdCounter = pageIdCounter + ,tabbarStateSignalBoxIdCounter = signalBoxIdCounter} + ,envStateBufferList = + BufferListState {bufferListStateForegroundPages = fPages + ,bufferListStateBackgroundPages = bPages} + } = do + -- Init. + (tabbarTVar, (bufferListTVar, (signalBoxList, (focusNotifierListTVar, (windowNodeListTVar, windowListTVar))))) <- envGet env + + -- Restore window node. + modifyTVarIO windowNodeListTVar (`setListSetCounter` nodeCounter) + + let nodeStateList = Set.toList nodeSet + if null nodeStateList + then putStrLn "Got empty window node list in restoreLayoutState(), it shouldn't happend." + else do + let rootNode = head nodeStateList + restoreWindowNodeState + WindowNodeState {windowNodeStateId = nId + ,windowNodeStateParentId = pId + ,windowNodeStateChildLeftId = clId + ,windowNodeStateChildRightId = crId + ,windowNodeStateType = nType + ,windowNodeStateDirection = nDirection} = do + -- Init. + (windowNodeList, container) <- envGet env + + -- Get new window node. + (newNode, newNodeList) <- + windowNodeNewInternal (Just nId, pId, clId, crId, nType, nDirection) + (windowNodeList, container) + + -- Show window node. + widgetShowAll (windowNodePaned newNode) + + -- Update window node list. + writeTVarIO windowNodeListTVar newNodeList + + -- Restore child node. + let restoreChild childId = + childId ?>= \ matchId -> + maybeFindMin nodeSet (\x -> windowNodeStateId x == matchId) + ?>= restoreWindowNodeState + + restoreChild clId + restoreChild crId + + -- Restore all window node. + restoreWindowNodeState rootNode + + -- Restore window state. + windowNodeList <- readTVarIO windowNodeListTVar + let getWindows winList = + forM winList $ \ WindowState {windowStateId = wId + ,windowStateSize = (width, height)} -> + case windowNodeListGetNode windowNodeList wId of + Just wNode -> do + -- Restore window size. + window <- windowNewWithNode wNode focusNotifierListTVar + widgetSetSizeRequest (windowNodePaned $ windowNode window) width height + return [window] + Nothing -> do + putStrLn $ "Create window " ++ show wId ++ " failed." + return [] + + leftWindows <- fmap concat (getWindows winLeftList) + rightWindows <- fmap concat (getWindows winRightList) + + -- Update window list. + writeTVarIO windowListTVar (ListZipper leftWindows rightWindows) + + -- Restore tabbar state. + writeTVarIO (envPageIdCounter env) pageIdCounter -- restore page id counter + writeTVarIO (envSignalBoxIdCounter env) signalBoxIdCounter -- restore signal box id counter + + windowList <- readTVarIO windowListTVar + forM_ tStates $ \ ((windowId, modeName), tabStateList, tabSelectIndex) -> + case windowListGetWindow windowId windowList of + Nothing -> putStrLn $ "restoreLayoutState(), can't restore tabs in window " ++ show windowId + Just window -> do + let notebook = windowNotebook window + forM_ tabStateList $ \ TabState {tabStatePageId = pageId + ,tabStateSignalBoxId = signalBoxId} -> do + -- Init. + uiFrame <- uiFrameStick notebook + + -- New signal box list. + let signalBox = SignalBox signalBoxId uiFrame windowId + modifyTVarIO signalBoxList (Set.insert signalBox) + + -- Update tabbar. + modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId signalBoxId 0 0 uiFrame)) + + -- Restore focus tab. + notebookSetCurrentPage notebook tabSelectIndex + + -- Startup sub-process. + let startupRenderProcess pages = + forM_ pages $ \ (modeName, pageIds) -> + forM_ pageIds $ \ pageId -> do + -- Get startup path. + configDir <- getConfigDirectory + startupPath <- expandFilePath $ configDir statePath show pageId subprocessStartupPath + + isExist <- doesFileExist startupPath + if isExist + then do + content <- readFile startupPath + case (read content :: (String, SpawnProcessArgs)) of + (binaryPath, startupArgs) -> do + -- Update buffer list. + modifyTVarIO bufferListTVar (bufferListAddBuffer (modeName, 0, pageId, "", "")) + + -- Startup sub process. + runProcess_ binaryPath [show startupArgs] + else + putStrLn $ "Can't found startup file " ++ startupPath ++ " restore sub-process failed." + + startupRenderProcess fPages -- restore foreground sub-process + startupRenderProcess bPages -- restore background sub-process + + -- Focus current window. + focusWindow env + + return () + instance ActionInputArgs Frame where envGet = return . envFrame instance ActionInputArgs Client where @@ -379,10 +519,6 @@ 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 @@ -391,6 +527,8 @@ envGet = readTVarIO . envFocusNotifierList instance ActionInputArgs Tabbar where envGet = readTVarIO . envTabbar +instance ActionInputArgs TabbarSelect where + envGet = readTVarIO . envTabbarSelect instance ActionInputArgs BufferList where envGet = readTVarIO . envBufferList instance ActionInputArgs (TVar WindowList) where @@ -401,25 +539,21 @@ 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 TabbarSelect) where + envGet = return . envTabbarSelect 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 TabbarSelect where + envPut = writeTVarIO . envTabbarSelect instance ActionOutputArgs BufferList where envPut = writeTVarIO . envBufferList diff --git a/Manatee/Action/BufferList.hs b/Manatee/Action/BufferList.hs --- a/Manatee/Action/BufferList.hs +++ b/Manatee/Action/BufferList.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 diff --git a/Manatee/Action/Tab.hs b/Manatee/Action/Tab.hs --- a/Manatee/Action/Tab.hs +++ b/Manatee/Action/Tab.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 @@ -69,11 +69,11 @@ 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 + (window, (tabbarTVar, (bufferListTVar, signalBoxList))) <- envGet env -- Create socket with current window. let notebook = windowNotebook window - pageId <- tickTVarIO pId + pageId <- tickTVarIO (envPageIdCounter env) -- Switch mode before add new tab. modeName <- getPageModeName pType pPath @@ -84,20 +84,21 @@ -- if haven't any plug add in socket. -- So we use frame as socket container, we add socket in -- frame after plug create complete and return plug id. - uiFrame <- uiFrameStick notebook Nothing + uiFrame <- uiFrameStick notebook -- Build signal box. let windowId = windowGetId window - signalBox <- signalBoxNew uiFrame windowId sId signalBoxList + signalBox <- signalBoxNew uiFrame windowId (envSignalBoxIdCounter env) signalBoxList + let sId = signalBoxId signalBox -- Add page id information to buffer list and tabbar, -- then will replace other information after render page create. -- And make sure render page will insert at correct place when call 'daemonHandleNewPageConfirm'. modifyTVarIO bufferListTVar (bufferListAddBuffer (modeName, 0, pageId, pType, "")) - modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId 0 0 uiFrame)) + modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId sId 0 0 uiFrame)) -- Spawn render process. - runProcess_ binaryPath [show (SpawnRenderProcessArgs pageId pType (signalBoxId signalBox) pPath options)] + runProcess_ binaryPath [show (SpawnRenderProcessArgs pageId pType pPath options [sId] False)] return () @@ -267,12 +268,11 @@ modifyTVarIO tabbarTVar (tabbarRemoveTab modeName currentPageIndex) -- Send `ExitRenderProcess` signal to exit render process. - mkRenderSignal client processId ExitRenderProcess (ExitRenderProcessArgs pageId) + mkRenderSignal client processId ExitRenderProcess (ExitRenderProcessArgs pageId False) - -- Switch to global input interactivebar if haven't any buffer exist. + -- Close all window if haven't any buffer exist. bufferList <- readTVarIO bufferListTVar unless (bufferListHaveBufferExist bufferList) $ - -- Will popup global input interactivebar after close all windows. windowCloseAll env -- | Push to tab close history. @@ -307,12 +307,6 @@ -- | Undo close tab that same mode as current mode. tabUndoCloseLocal :: Environment -> IO () tabUndoCloseLocal env = do - focusStatus <- getFocusStatus env - case focusStatus of - -- If focus init interactivebar, same as 'tabUndoCloseGlobal'. - FocusInitInteractivebar -> tabUndoCloseGlobal env - -- Otherwise just undo tab that same as current mode. - _ -> do (tabCloseHistoryTVar, window) <- envGet env (TabCloseHistory history) <- readTVarIO tabCloseHistoryTVar getWindowPageModeName env window @@ -420,21 +414,36 @@ -- | Switch mode with window. tabSwitchGroupWithWindow :: Environment -> Window -> PageModeName -> IO () tabSwitchGroupWithWindow env window pageModeName = do - (Tabbar tabbar, (tabbarTVar, (BufferList bufferList, (client, (signalBoxList, sId))))) <- envGet env + (Tabbar tabbar, (tabbarTVar, (tabbarSelectTVar, (BufferList bufferList, (client, signalBoxList))))) <- envGet env let windowId = windowGetId window windowMode = findMinMatch tabbar (\ (wId, wModeName) _ -> wId == windowId && wModeName == pageModeName) case windowMode of + -- Don't switch if current mode same as request one. Just _ -> return () Nothing -> do + -- Save tab index status that match current mode. + tabbarGetPageModeName (Tabbar tabbar) (windowGetId window) + ?>= \ currentPageMode -> do + currentTabIndex <- notebookGetCurrentPage (windowNotebook window) + modifyTVarIO tabbarSelectTVar $ \ (TabbarSelect oldMap) -> + TabbarSelect (M.insert currentPageMode currentTabIndex oldMap) + -- Remove all tabs match window id. modifyTVarIOM tabbarTVar $ \ tabs -> removeTabs tabs client window -- Rebuild all tabs match target mode if can found same mode in buffer list. findMinMatch bufferList (\ name _ -> name == pageModeName) ?>= \ (_, bufferSeq) -> do + -- Clone tabs. let tabDataList = map (\x -> (pageModeName, bufferProcessId x, bufferPageId x)) $ F.toList bufferSeq - cloneTabs window client tabbarTVar signalBoxList sId tabDataList + cloneTabs window client tabbarTVar signalBoxList (envSignalBoxIdCounter env) tabDataList + + -- Restore tab index status that match current mode. + TabbarSelect tabbarSelect <- readTVarIO tabbarSelectTVar + findMinMatch tabbarSelect (\ n _ -> n == pageModeName) + ?>= \ (_, tabIndex) -> + notebookSetCurrentPage (windowNotebook window) tabIndex -- | Remove tab from window. windowRemoveTab :: Environment -> PageModeName -> Int -> Maybe PageModeName -> IO () diff --git a/Manatee/Action/Tabbar.hs b/Manatee/Action/Tabbar.hs --- a/Manatee/Action/Tabbar.hs +++ b/Manatee/Action/Tabbar.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 diff --git a/Manatee/Action/Window.hs b/Manatee/Action/Window.hs --- a/Manatee/Action/Window.hs +++ b/Manatee/Action/Window.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 @@ -106,7 +106,6 @@ windowRemove env window -- | Close all windows. --- Will popup global input interactivebar after close all windows. windowCloseAll :: Environment -> IO () windowCloseAll env = do windowList <- envGet env @@ -117,7 +116,7 @@ windowRemove :: Environment -> Window -> IO () windowRemove env window = do -- Get args. - (client, (frame, (anythingBox, (anythingInteractivebar, (tabbar, args))))) <- envGet env + (client, (tabbar, args)) <- envGet env -- Remove all tabs match window id. newTabbar <- removeTabs tabbar client window @@ -128,49 +127,41 @@ -- 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 + -- Exit programe if no window exist. + when (LZ.isEmpty newWindowList) (exit env False) -- | 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 + (client, (tabbarTVar, signalBoxList)) <- envGet env let notebook = windowNotebook window windowId = windowGetId window forM_ seqList $ \ Tab {tabProcessId = processId ,tabPageId = pageId - ,tabPlugId = oldPlugId - ,tabUIFrame = oldUIFrame} -> do + ,tabPlugId = oldPlugId} -> do -- Create new socket frame. - uiFrame <- uiFrameStick notebook (Just oldUIFrame) -- keep same UIFrame status with old one + uiFrame <- uiFrameStick notebook -- Create signal box. - signalBox <- signalBoxNew uiFrame windowId sId signalBoxList + signalBox <- signalBoxNew uiFrame windowId (envSignalBoxIdCounter env) signalBoxList + let sId = signalBoxId signalBox -- 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)) + modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId sId 0 0 uiFrame)) -- Send `ReparentRenderPage` signal. - mkRenderSignal client processId ReparentRenderPage (ReparentRenderPageArgs pageId oldPlugId (signalBoxId signalBox)) + mkRenderSignal client processId ReparentRenderPage (ReparentRenderPageArgs pageId oldPlugId sId) -- | 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 + (client, (tabbarTVar, signalBoxList)) <- envGet env let tabDataList = map (\x -> (modeName, tabProcessId x, tabPageId x)) seqList - cloneTabs window client tabbarTVar signalBoxList sId tabDataList + cloneTabs window client tabbarTVar signalBoxList (envSignalBoxIdCounter env) tabDataList -- | Enlarge window up. windowEnlargeUp :: Environment -> IO () diff --git a/Manatee/Daemon.hs b/Manatee/Daemon.hs --- a/Manatee/Daemon.hs +++ b/Manatee/Daemon.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 @@ -20,18 +20,15 @@ module Manatee.Daemon where import Control.Applicative hiding (empty) -import Control.Arrow -import Control.Concurrent.MVar -import Control.Exception import Control.Monad import Control.Monad.Trans import DBus.Client hiding (Signal) import DBus.Types -import Data.Map (Map, union) +import Data.Map (Map) import Data.Text.Lazy (Text) import GHC.Conc import Graphics.UI.Gtk hiding (Window, windowNew, Frame, frameNew, - Signal, Variant, Action, + Signal, Variant, Action, layoutPath, plugNew, plugGetId, get, Keymap) import Graphics.UI.Gtk.Gdk.SerializedEvent import Manatee.Action.Basic @@ -43,10 +40,8 @@ import Manatee.Core.DBus import Manatee.Core.Debug import Manatee.Core.PageMode -import Manatee.Core.Interactive import Manatee.Core.Types import Manatee.Environment -import Manatee.Toolkit.General.Basic import Manatee.Toolkit.General.FilePath import Manatee.Toolkit.General.List import Manatee.Toolkit.General.Maybe @@ -54,210 +49,207 @@ import Manatee.Toolkit.General.STM import Manatee.Toolkit.General.Set hiding (mapM) import Manatee.Toolkit.Gio.Gio -import Manatee.Toolkit.Gtk.Concurrent -import Manatee.Toolkit.Gtk.Editable import Manatee.Toolkit.Gtk.Event import Manatee.Toolkit.Gtk.Gtk import Manatee.Toolkit.Gtk.Struct -import Manatee.Toolkit.Widget.Interactivebar import Manatee.Toolkit.Widget.NotebookTab -import Manatee.Toolkit.Widget.PopupWindow -import Manatee.Toolkit.Widget.Tooltip import Manatee.Types import Manatee.UI.Frame -import Manatee.UI.UIFrame import Manatee.UI.Window import System.Directory +import qualified Data.ByteString.UTF8 as UTF8 +import qualified Data.Foldable as F import qualified Data.Map as M import qualified Data.Set as Set import qualified Data.Text.Lazy as T -import qualified Data.Foldable as F -import qualified Data.ByteString.UTF8 as UTF8 -- | Daemon process main entry. -daemonMain :: IO () -daemonMain = do +daemonMain :: Bool -> IO () +daemonMain restoreState = do -- Init. unsafeInitGUIForThreadedRTS env <- mkEnvironment let frame = envFrame env - anythingBox = envInitBox env - anythingInteractivebar = envInitInteractivebar env - anythingWindow = pwWindow $ envAnythingPopupWindow env -- Build daemon client for listen dbus signal. mkDaemonClient env - -- Build local object. - mkDaemonMethods [("GetBufferList", callGetBufferList env) - ,("Interactive", callGetInteractive env) - ,("GetBufferHistory", callGetBufferHistory env)] - -- Read extension global keymap. (ExtensionGloalKeymap keymap) <- readConfig extensionGlobalKeymapPath (ExtensionGloalKeymap M.empty) let extensionGlobalKeymap = - M.fromList $ map (\ (key, (pType, pPath, pOptions)) -> + M.fromList $ map (\ (key, (_, (pType, pPath, pOptions))) -> (T.pack key, Action (newTab pType pPath pOptions))) (M.toList keymap) + extensionKeymap = + map (\ (key, (extensionCommand, _)) -> + (T.pack key, T.pack extensionCommand)) (M.toList keymap) - -- Propagate event to main window. - -- Some window manager, like XMonad, will forcely focus on popup window, - -- Those code to fix this problem, make Manatee can works in XMonad. - anythingWindow `on` keyPressEvent $ tryEvent $ do - sEvent <- serializedEvent - liftIO $ widgetPropagateEvent frame sEvent + -- Build local object. + mkDaemonMethods [("GetBufferList", callGetBufferList env) + ,("GetBufferHistory", callGetBufferHistory env) + ,("GetWindowAllocation", callGetWindowAllocation env) + ,("GetGlobalKeymap", callGetGlobalKeymap env extensionKeymap) + ] -- Handle key event. frame `on` keyPressEvent $ tryEvent $ do - -- Remove tooltip when press key. - liftIO $ do - tList <- readTVarIO $ envTooltipSet env - forM_ (Set.toList tList) (\x -> tooltipExit x (envTooltipSet env)) - -- Focus tab when press key. - liftIO $ focusTab env + liftIO $ focusWindow env + -- Get event status. - focusStatus <- liftIO $ getFocusStatus env keystoke <- eventKeystoke sEvent <- serializedEvent - -- liftIO $ do - -- ((tabbar, bufferList) :: (Tabbar, BufferList)) <- envGet env - -- putStrLn $ "-------------------------------" - -- putStrLn $ "daemonMain bufferlist: " ++ groom bufferList - -- putStrLn $ "daemonMain tabbar: " ++ groom tabbar - - -- liftIO $ do - -- (windowList, tabbar) :: (WindowList, Tabbar) <- envGet env - -- putStrLn $ "---------------------------" - -- putStrLn $ "daemonMain WindowList : " ++ groom windowList - -- putStrLn $ "daemonMain tabbar: " ++ groom tabbar - -- liftIO $ putStrLn $ "Debug keystoke : " ++ show keystoke -- Handle key press event. liftIO $ do - -- Handle global keymap first. - case M.lookup keystoke (globalKeymap `union` extensionGlobalKeymap) of - -- Execute global command. + case M.lookup keystoke extensionGlobalKeymap of Just action -> runAction env action - Nothing -> - case focusStatus of - -- Ignore localKeymap when handle init interactivebar. - FocusInitInteractivebar -> handleInteractivebarKeyPress env keystoke anythingInteractivebar - _ -> - case M.lookup keystoke localKeymap of - -- Execute local command. + _ -> + case M.lookup keystoke globalKeymap of + Just key -> + case M.lookup key globalCommandMap of Just action -> runAction env action - _ -> case focusStatus of - -- Handle PageView keymap. - FocusWindow -> envGet env >>= handlePageViewKeyPress keystoke sEvent - -- Handle local interactivebar. - FocusLocalInteractivebar -> - getCurrentInteractivebar env >?>= - handleInteractivebarKeyPress env keystoke + _ -> envGet env >>= handlePageViewKeyPress keystoke sEvent + _ -> envGet env >>= handlePageViewKeyPress keystoke sEvent -- Focus tab after handle event. - focusTab env - - -- Init commander. - anythingInitStartup frame anythingBox anythingInteractivebar + focusWindow env -- Show. widgetShowAll frame - frame `onDestroy` do - -- Send broadcast quit signal, other process can listen this signal when daemon process quit. - client <- envGet env - mkDaemonBroadcastSignal client ExitDaemonProcess ExitDaemonProcessArgs - -- Need exit all render processes before exit daemon process. - exitAllRenderProcess env - -- Exit daemon process. - mainQuit + frame `onDestroy` exit env True + -- Restore layout state. + if restoreState + then do + state <- readConfig layoutPath Nothing + case state of + -- Show welcome view if haven't any state. + Nothing -> newTab "PageWelcome" "Welcome" [] env + -- Otherwise restore layout state. + Just state -> restoreLayoutState env state + else + -- Show welcome view if don't need restore state. + newTab "PageWelcome" "Welcome" [] env + -- Loop. mainGUI -- | Global keymap. -globalKeymap :: Keymap +globalKeymap :: Map Text Text globalKeymap = M.fromList - ["F7" ==> startIrc - ,"F11" ==> toggleFullscreen - ,"F12" ==> lockScreen - ,"C-'" ==> tabUndoCloseGlobal - ,"C-\"" ==> tabUndoCloseLocal - ,"M-A" ==> pausePlay + [("M-t", "Split window vertically") + ,("M-T", "Split window hortizontally") + ,("M-n", "Select next window") + ,("M-p", "Select previous window") + ,("M-;", "Close current window") + ,("M-:", "Window other windows") + -- Window zoom keymap. + ,("P-.", "Window enlarge") + ,("P-,", "Window shrink") + ,("P-j", "Window enlarge down") + ,("P-k", "Window enlarge up") + ,("P-h", "Window enlarge left") + ,("P-l", "Window enlarge right") + ,("P-J", "Window shrink down") + ,("P-K", "Window shrink up") + ,("P-H", "Window shrink left") + ,("P-L", "Window shrink right") + -- Tab keymap in current window. + ,("M-9", "Select previous tab group") + ,("M-0", "Select next tab group") + ,("M-7", "Select previous tab") + ,("M-8", "Select next tab") + ,("M-&", "Select first tab") + ,("M-*", "Select last tab") + ,("C-7", "Move tab to left") + ,("C-8", "Move tab to right") + ,("C-&", "Move tab to begin") + ,("C-*", "Move tab to end") + ,("M-'", "Close current tab") + ,("M-\"", "Close other tabs") + -- Tab keymap with next window. + ,("P-7", "Select previous tab with next window") + ,("P-8", "Select next tab with next window") + ,("P-&", "Select first tab with next window") + ,("P-*", "Select last tab with next window") + ,("P-9", "Select previous tab group with next window") + ,("P-0", "Select next tab group with next window") + ,("C-P-7", "Move tab to left with next window") + ,("C-P-8", "Move tab to right with next window") + ,("C-P-&", "Move tab to begin with next window") + ,("C-P-*", "Move tab to end with next window") + -- Other keymap. + ,("M-F", "Focus current tab") + ,("M-[", "View directory of buffer") + ,("C-u", "Update configuration") + ,("C-i", "Install configuration") + ,("F11", "Toggle fullscreen") + ,("F12", "Lock screen") + ,("C-'", "Undo tab close (global)") + ,("C-\"", "Undo tab close (local)") + ,("M-A", "Toggle play") ] --- | Interactivebar keymap. -interactiveKeymap :: Map Text (Environment -> Entry -> IO ()) -interactiveKeymap = +-- | Global keymap. +globalCommandMap :: Keymap +globalCommandMap = M.fromList - [("Tab", \ _ ed -> editableExpandCompletion ed) - ,("BackSpace", \ _ ed -> editableDeleteBackwardChar ed) - ,("M-,", \ _ ed -> editableDeleteBackwardChar ed) - ,("M-<", \ _ ed -> editableDeleteBackwardWord ed) - ,("M-d", \ _ ed -> editableDeleteAllText ed) - ,("M-x", \ _ ed -> editableCutClipboard ed) - ,("M-c", \ _ ed -> editableCopyClipboard ed) - ,("M-v", interactivebarPasteClipboard) - ] - --- | Local keymap for extension. -localKeymap :: Keymap -localKeymap = - M.fromList - -- Window keymap. - ["M-t" ==> windowSplitVertically - ,"M-T" ==> windowSplitHortizontally - ,"M-n" ==> windowSelectNext - ,"M-p" ==> windowSelectPrev - ,"M-;" ==> windowCloseCurrent - ,"M-:" ==> windowCloseOthers - -- Window zoom keymap. - ,"P-." ==> windowEnlarge - ,"P-," ==> windowShrink - ,"P-j" ==> windowEnlargeDown - ,"P-k" ==> windowEnlargeUp - ,"P-h" ==> windowEnlargeLeft - ,"P-l" ==> windowEnlargeRight - ,"P-J" ==> windowShrinkDown - ,"P-K" ==> windowShrinkUp - ,"P-H" ==> windowShrinkLeft - ,"P-L" ==> windowShrinkRight - -- Tab keymap in current window. - ,"M-9" ==> tabForwardGroup - ,"M-0" ==> tabBackwardGroup - ,"M-7" ==> tabSelectPrev - ,"M-8" ==> tabSelectNext - ,"M-&" ==> tabSelectFirst - ,"M-*" ==> tabSelectLast - ,"C-7" ==> tabMoveToLeft - ,"C-8" ==> tabMoveToRight - ,"C-&" ==> tabMoveToBegin - ,"C-*" ==> tabMoveToEnd - ,"M-'" ==> tabCloseCurrent - ,"M-\"" ==> tabCloseOthers - -- Tab keymap with next window. - ,"P-7" ==> tabSelectPrevWithNextWindow - ,"P-8" ==> tabSelectNextWithNextWindow - ,"P-&" ==> tabSelectFirstWithNextWindow - ,"P-*" ==> tabSelectLastWithNextWindow - ,"P-9" ==> tabForwardGroupWithNextWindow - ,"P-0" ==> tabBackwardGroupWithNextWindow - ,"C-P-7" ==> tabMoveToLeftWithNextWindow - ,"C-P-8" ==> tabMoveToRightWithNextWindow - ,"C-P-&" ==> tabMoveToBeginWithNextWindow - ,"C-P-*" ==> tabMoveToEndWithNextWindow - -- Other keymap. - ,"M-f" ==> focusInteractivebar - ,"M-F" ==> focusCurrentTab - ,"M-b" ==> focusSwitch - ,"M-g" ==> exitInteractivebar - ,"M-[" ==> viewBufferDirectory - ,"C-u" ==> updateConfigure - ,"C-i" ==> installConfigure - ] + ["Split window vertically" ==> windowSplitVertically + ,"Split window hortizontally" ==> windowSplitHortizontally + ,"Select next window" ==> windowSelectNext + ,"Select previous window" ==> windowSelectPrev + ,"Close current window" ==> windowCloseCurrent + ,"Window other windows" ==> windowCloseOthers + -- Window zoom keymap. + ,"Window enlarge" ==> windowEnlarge + ,"Window shrink" ==> windowShrink + ,"Window enlarge down" ==> windowEnlargeDown + ,"Window enlarge up" ==> windowEnlargeUp + ,"Window enlarge left" ==> windowEnlargeLeft + ,"Window enlarge right" ==> windowEnlargeRight + ,"Window shrink down" ==> windowShrinkDown + ,"Window shrink up" ==> windowShrinkUp + ,"Window shrink left" ==> windowShrinkLeft + ,"Window shrink right" ==> windowShrinkRight + -- Tab keymap in current window. + ,"Select previous tab group" ==> tabForwardGroup + ,"Select next tab group" ==> tabBackwardGroup + ,"Select previous tab" ==> tabSelectPrev + ,"Select next tab" ==> tabSelectNext + ,"Select first tab" ==> tabSelectFirst + ,"Select last tab" ==> tabSelectLast + ,"Move tab to left" ==> tabMoveToLeft + ,"Move tab to right" ==> tabMoveToRight + ,"Move tab to begin" ==> tabMoveToBegin + ,"Move tab to end" ==> tabMoveToEnd + ,"Close current tab" ==> tabCloseCurrent + ,"Close other tabs" ==> tabCloseOthers + -- Tab keymap with next window. + ,"Select previous tab with next window" ==> tabSelectPrevWithNextWindow + ,"Select next tab with next window" ==> tabSelectNextWithNextWindow + ,"Select first tab with next window" ==> tabSelectFirstWithNextWindow + ,"Select last tab with next window" ==> tabSelectLastWithNextWindow + ,"Select previous tab group with next window" ==> tabForwardGroupWithNextWindow + ,"Select next tab group with next window" ==> tabBackwardGroupWithNextWindow + ,"Move tab to left with next window" ==> tabMoveToLeftWithNextWindow + ,"Move tab to right with next window" ==> tabMoveToRightWithNextWindow + ,"Move tab to begin with next window" ==> tabMoveToBeginWithNextWindow + ,"Move tab to end with next window" ==> tabMoveToEndWithNextWindow + -- Other keymap. + ,"Focus current tab" ==> focusCurrentTab + ,"View directory of buffer" ==> viewBufferDirectory + ,"Update configuration" ==> updateConfigure + ,"Install configuration" ==> installConfigure + ,"Toggle fullscreen" ==> toggleFullscreen + ,"Lock screen" ==> lockScreen + ,"Undo tab close (global)" ==> tabUndoCloseGlobal + ,"Undo tab close (local)" ==> tabUndoCloseLocal + ,"Toggle play" ==> togglePlay + ] -- | Build daemon client for listen dbus signal. mkDaemonClient :: Environment -> IO () @@ -266,18 +258,13 @@ mkDaemonMatchRules client [(NewRenderPageConfirm, daemonHandleNewPageConfirm env) + ,(NewRenderProcessConfirm, daemonHandleNewProcessConfirm env) ,(RenderProcessExit, daemonHandleRenderProcessExit env) ,(RenderProcessExitConfirm, daemonHandleRenderProcessExitConfirm) ,(NewTab, daemonHandleNewTab env) - ,(NewAnythingProcessConfirm, daemonHandleNewAnythingProcessConfirm env) - ,(AnythingViewOutput, daemonHandleAnythingViewOutput env) - ,(LocalInteractivebarExit, daemonHandleLocalInteractivebarExit env) ,(SynchronizationPathName, daemonHandleSynchronizationPathName env) ,(ChangeTabName, daemonHandleChangeTabName env) ,(SwitchBuffer, daemonHandleSwitchBuffer env) - ,(ShowTooltip, daemonHandleShowTooltip env) - ,(LocalInteractiveReturn, daemonHandleLocalInteractiveReturn env) - ,(GlobalInteractiveReturn, daemonHandleGlobalInteractiveReturn env) ,(Ping, daemonHandlePing env) ] @@ -299,69 +286,6 @@ daemonHandleNewTab env (NewTabArgs pageType pagePath options) = runAction env (Action (newTab pageType pagePath options)) --- | Handle new anything process confirm signal. -daemonHandleNewAnythingProcessConfirm :: Environment -> DaemonSignalArgs -> IO () -daemonHandleNewAnythingProcessConfirm env (NewAnythingProcessConfirmArgs (GWindowId plugId) processId) = do - let popupWindow = envAnythingPopupWindow env - anythingBox = envInitBox env - anythingProcessId = envAnythingProcessId env - - socket <- socketNew_ - focusStatus <- getFocusStatus env - case focusStatus of - FocusInitInteractivebar -> anythingBox `containerAdd` socket - _ -> popupWindowAdd popupWindow socket - socketAddId socket plugId - - writeTVarIO anythingProcessId processId - --- | Handle interactivebar input. -daemonHandleAnythingViewOutput :: Environment -> DaemonSignalArgs -> IO () -daemonHandleAnythingViewOutput env (AnythingViewOutputArgs input completion outputHeight keyPressId) = do - -- Just update anything input entry status when - -- return return keyPressId is same current one. - -- Otherwise drop *old* calculation result. - currentKeyPressId <- readTVarIO $ envAnythingKeyPressId env - when (currentKeyPressId == keyPressId) $ do - let interactivebar = envInitInteractivebar env - popupWindow = envAnythingPopupWindow env - focusStatus <- getFocusStatus env - case focusStatus of - FocusInitInteractivebar -> - editableSetCompletionText (interactivebarEntry interactivebar) input completion - _ -> - getCurrentInteractivebar env >?>= \ bar -> do - -- Set entry. - editableSetCompletionText (interactivebarEntry bar) input completion - case outputHeight of - -- Adjust popup window with special size and position. - Just height -> do - let adjustHeight | height < popupWindowDefaultHeight - = height - | otherwise - = popupWindowDefaultHeight - -- Get size of interactivebar. - (Rectangle x y w h) <- widgetGetAllocation (interactivebarEntry bar) - -- Get size of screen. - (_, screenHeight) <- widgetGetScreenSize (interactivebarEntry bar) - -- If interactivebar's position too low, display popup window at above of interactivebar. - -- Otherwise, at below of interactivebar. - let adjustY | y + h + popupWindowDefaultHeight > screenHeight - = y - adjustHeight - | otherwise - = y + h - popupWindowSetAllocation popupWindow (Rectangle x adjustY w adjustHeight) - popupWindowShow popupWindow - -- Hide popup window when no output need to display. - Nothing -> popupWindowHide popupWindow - --- | Handle local interactivebar exit. -daemonHandleLocalInteractivebarExit :: Environment -> DaemonSignalArgs -> IO () -daemonHandleLocalInteractivebarExit env LocalInteractivebarExitArgs = do - focusStatus <- getFocusStatus env - unless (focusStatus == FocusInitInteractivebar) $ - exitInteractivebar env - -- | Handle synchronization tab name. daemonHandleSynchronizationPathName :: Environment -> DaemonSignalArgs -> IO () daemonHandleSynchronizationPathName env (SynchronizationPathNameArgs modeName pageId path) = do @@ -410,139 +334,18 @@ window <- envGet env notebookSetCurrentPage (windowNotebook window) i --- | Handle InteractiveReturn return. -daemonHandleLocalInteractiveReturn :: Environment -> DaemonSignalArgs -> IO () -daemonHandleLocalInteractiveReturn env (LocalInteractiveReturnArgs strList) = do - popupWindow <- envGet env - focusStatus <- getFocusStatus env - unless (focusStatus == FocusInitInteractivebar) $ do - -- Get track value. - track <- readTVarIO (envLocalInteractiveTrack env) - -- Update return value. - modifyTVarIO (envLocalInteractiveReturn env) (++ strList) - if length track <= 1 - -- Exit interactivebar when user input complete. - then do - returnList <- readTVarIO (envLocalInteractiveReturn env) - tryPutMVar (envLocalInteractiveLock env) (Right returnList) - exitInteractivebar env - -- Or update track value and input next. - else do - let restTrack = tail track - (interactiveName, interactiveTitle) = head restTrack - -- Update track value. - writeTVarIO (envLocalInteractiveTrack env) restTrack - - -- Reset interactivebar and popup window. - getCurrentUIFrame env >?>= \uiFrame -> do - let interactivebar = uiFrameInteractivebar uiFrame - interactivebarSetTitle interactivebar interactiveTitle - interactivebarSetContent interactivebar "" - -- Hide popup window. - popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1) - - -- Change anything view candidate. - processId <- readTVarIO $ envAnythingProcessId env - mkRenderSignal (envDaemonClient env) processId AnythingViewChangeCandidate - (AnythingViewChangeCandidateArgs [interactiveName]) - --- | Handle InteractiveReturn return. -daemonHandleGlobalInteractiveReturn :: Environment -> DaemonSignalArgs -> IO () -daemonHandleGlobalInteractiveReturn env (GlobalInteractiveReturnArgs strList) = do - -- Get popup window and focus status. - popupWindow <- envGet env - focusStatus <- getFocusStatus env - -- Get track value. - track <- readTVarIO (envGlobalInteractiveTrack env) - -- Update return value. - modifyTVarIO (envGlobalInteractiveReturn env) (++ strList) - if length track <= 1 - -- Exit interactivebar when user input complete. - then do - returnList <- readTVarIO (envGlobalInteractiveReturn env) - tryPutMVar (envGlobalInteractiveLock env) (Right returnList) - unless (focusStatus == FocusInitInteractivebar) $ - exitInteractivebar env - -- Or update track value and input next. - else do - -- Get interactive name and title. - let restTrack = tail track - (interactiveName, interactiveTitle) = head restTrack - -- Update track value. - writeTVarIO (envGlobalInteractiveTrack env) restTrack - - -- Reset interactivebar and popup window. - case focusStatus of - FocusInitInteractivebar -> do - -- Show init interactivebar. - let interactivebar = envInitInteractivebar env - interactivebarSetTitle interactivebar interactiveTitle - interactivebarSetContent interactivebar "" - _ -> - getCurrentUIFrame env >?>= \uiFrame -> do - -- Show local interactivebar. - let interactivebar = uiFrameInteractivebar uiFrame - interactivebarSetTitle interactivebar interactiveTitle - interactivebarSetContent interactivebar "" - -- Hide popup window. - popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1) - - -- Change anything view candidate. - processId <- readTVarIO $ envAnythingProcessId env - mkRenderSignal (envDaemonClient env) processId AnythingViewChangeCandidate - (AnythingViewChangeCandidateArgs [interactiveName]) - -- | Handle ping message. daemonHandlePing :: Environment -> DaemonSignalArgs -> IO () daemonHandlePing env (PingArgs processId) = mkRenderSignal (envDaemonClient env) processId Pong PongArgs --- | Handle switch buffer. -daemonHandleShowTooltip :: Environment -> DaemonSignalArgs -> IO () -daemonHandleShowTooltip env (ShowTooltipArgs text point int foreground background hideWhenPress pageId) = do - -- Init. - tooltipId <- tickTVarIO (envTooltipCounter env) - let showTooltip p = - tooltipNew tooltipId (envFrame env) text p int foreground background hideWhenPress (envTooltipSet env) - -- Just add in set when tooltip will hide after press key. - >>= \tooltip -> when hideWhenPress $ modifyTVarIO (envTooltipSet env) (Set.insert tooltip) - - -- Get current tab. - focusStatus <- liftIO $ getFocusStatus env - currentTab <- - case focusStatus of - FocusInitInteractivebar -> return Nothing - _ -> getCurrentTab env - - -- Show tooltip. - case currentTab of - -- Show tooltip when current no window exist. - Nothing -> showTooltip point - Just (Tab {tabPageId = tpId - ,tabUIFrame = UIFrame {uiFrameBox = frame}}) -> do - -- Translate UIFrame coordinate to top-level coordinate. - (Rectangle fx fy _ _) <- widgetGetAllocation frame - let tooltipPoint = fmap ((+) fx *** (+) fy) point - case pageId of - -- Show tooltip directly when no pageId information in DBus signal. - Nothing -> showTooltip tooltipPoint - -- Or just show tooltip when user not at same page as signal from. - Just pId -> when (tpId /= pId) $ showTooltip tooltipPoint - -- | Handle new page confirm signal. daemonHandleNewPageConfirm :: Environment -> DaemonSignalArgs -> IO () daemonHandleNewPageConfirm env args@(NewRenderPageConfirmArgs - pageId pType sId plugId processId modeName path isFirstPage) = do + pageId pType sId plugId processId modeName path isFirstPage isRestore) = do (tabbarTVar, (bufferListTVar, (signalBoxList, windowList))) <- envGet env - -- Debug. - -- putStrLn $ "Page id : " ++ show pageId ++ - -- "\nPage plug id : " ++ show plugId ++ - -- "\nProcess id : " ++ show processId ++ - -- "\nMode name : " ++ modeName ++ - -- "\nPath : " ++ path - -- Get signal box. sbList <- readTVarIO signalBoxList case maybeFindMin sbList (\x -> signalBoxId x == sId) of @@ -592,7 +395,7 @@ modifyTVarIO (envBufferHistory env) (insertUnique (BufferHistory modeName pageType path)) -- Update tabbar. - modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab processId pageId socketId plugId uiFrame)) + modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab processId pageId sId socketId plugId uiFrame)) -- Synchronization tab name. syncTabName env windowId @@ -601,8 +404,40 @@ writeTVarIO signalBoxList (Set.delete signalBox sbList) -- Synchronization tab in all window when first page create. - when isFirstPage $ tabbarSyncNewTab env windowId args + when (not isRestore && isFirstPage) $ tabbarSyncNewTab env windowId args + -- Restore page state. + mkRenderSignal (envDaemonClient env) processId RestoreRenderPageState (RestoreRenderPageStateArgs plugId isRestore) + +-- | Handle new process confirm signal. +daemonHandleNewProcessConfirm :: Environment -> DaemonSignalArgs -> IO () +daemonHandleNewProcessConfirm env + (NewRenderProcessConfirmArgs pageId pType processId modeName path) = do + (bufferListTVar) <- envGet env + + -- Debug. + debugDBusMessage $ "daemonHandleNewProcessConfirm: Catch NewRenderProcessConfirm signal. Process id : " ++ show processId + debugDBusMessage "------------------------------" + + -- Add new buffer. + modifyTVarIO bufferListTVar (bufferListAddBuffer (modeName, processId, pageId, pType, path)) + + -- Adjust tab name. + pageModeDuplicateTabList <- getDuplicateTabList + modifyTVarIO bufferListTVar + (if modeName `elem` pageModeDuplicateTabList + -- Just strip tab name when current page mode in 'pageModeDuplicateTabList' + then bufferListStripName modeName pageId path + -- Otherwise unique all tab names. + else bufferListUniqueName modeName) + + -- Update buffer history. + bufferList <- readTVarIO bufferListTVar + bufferListGetBuffer bufferList modeName pageId + ?>= \ Buffer {bufferPageType = pageType + ,bufferPath = path} -> + modifyTVarIO (envBufferHistory env) (insertUnique (BufferHistory modeName pageType path)) + -- | Add socket to socket frame. socketFrameAdd :: UIFrame -> PagePlugId -> IO PageSocketId socketFrameAdd uiFrame (GWindowId plugId) = do @@ -619,6 +454,40 @@ Method "" "s" $ \ call -> do history <- readTVarIO $ envBufferHistory env replyReturn call [toVariant history] + +-- | Return render window allocation. +callGetWindowAllocation :: Environment -> Member +callGetWindowAllocation env = + Method "s" "s" $ \ call -> do + -- Read input args. + let Just input = fromVariant (head $ methodCallBody call) + pagePlugId = read input :: PagePlugId + + tabbar <- envGet env + case tabbarGetTab pagePlugId tabbar of + -- Return render window's coordinate. + Just tab -> do + allocation <- widgetGetAllocation (uiFrameBox $ tabUIFrame tab) + replyReturn call [toVariant allocation] + -- Or return default value. + Nothing -> replyReturn call [] + +-- | Get global keymap. +callGetGlobalKeymap :: Environment -> [(Text, Text)] -> Member +callGetGlobalKeymap env extensionKeymap = + Method "s" "s" $ \ call -> do + -- Read input args. + let Just input = fromVariant (head $ methodCallBody call) + pagePlugId = read input :: PagePlugId + + tabbar <- envGet env + case tabbarGetTab pagePlugId tabbar of + -- Return render window's coordinate. + Just tab -> do + allocation <- widgetGetAllocation (uiFrameBox $ tabUIFrame tab) + replyReturn call [toVariant (allocation, M.toList globalKeymap ++ extensionKeymap)] + -- Or return default value. + Nothing -> replyReturn call [] -- | Return buffer list. callGetBufferList :: Environment -> Member @@ -632,126 +501,13 @@ BufferInfo modeName path name pageId) $ F.toList bufferSeq) $ M.toList bufferList -- Don't return current buffer. - focusStatus <- liftIO $ getFocusStatus env - currentPageId <- - case focusStatus of - FocusInitInteractivebar -> return Nothing - _ -> tabGetCurrentPageId env + currentPageId <- tabGetCurrentPageId env let bufferInfos = case currentPageId of Just pId -> filter (\ x -> bufferInfoId x /= pId) list Nothing -> list replyReturn call [toVariant bufferInfos] --- | Return interactive [String]. -callGetInteractive :: Environment -> Member -callGetInteractive env = - Method "s" "s" $ \ call -> do - -- Get input arguments. - (tabbar, popupWindow) <- envGet env - let Just input = fromVariant (head $ methodCallBody call) - (plugId, inputStr) = read input :: (PagePlugId, String) - - case parseInteractiveString inputStr of - -- Return error if parse interactive string failed. - Left err -> replyLocalInteractiveError call err - Right list -> do - -- Init track and return value. - writeTVarIO (envLocalInteractiveTrack env) list - writeTVarIO (envLocalInteractiveReturn env) [] - - -- Empty interactive lock first. - tryTakeMVar (envLocalInteractiveLock env) - - postGUIAsync $ - tabbarGetTab plugId tabbar - ?>= \ Tab {tabUIFrame = uiFrame} -> do - let interactivebar = uiFrameInteractivebar uiFrame - interactiveName = (fst . head) list - title = (snd . head) list - -- Show interactivebar. - uiFrameInit uiFrame title "" - -- When PopupWindow is invisible startup anythingView process. - whenM (not <$> popupWindowIsVisible popupWindow) - (do - -- Activate popup window. - popupWindowActivate popupWindow interactivebar - -- Start anything process. - startupAnything (SpawnAnythingProcessArgs - (InteractiveSearchArgs LocalInteractive [interactiveName]))) - - -- Wait interactive result. - result <- takeMVar (envLocalInteractiveLock env) - - -- Return. - case result of - Left err -> replyLocalInteractiveError call err - Right res -> replyReturn call [toVariant res] - --- | Global interactive. -globalInteractive :: Environment -> String -> ([String] -> IO ()) -> IO () -globalInteractive env inputStr action = - case parseInteractiveString inputStr of - -- Return error if parse interactive string failed. - Left err -> putStrLn $ "globalInteractive : parse interactive string failed : " ++ show err - Right strList -> do - -- Get popup window and focus status. - popupWindow <- envGet env - focusStatus <- getFocusStatus env - - -- Init track and return value. - writeTVarIO (envGlobalInteractiveTrack env) strList - writeTVarIO (envGlobalInteractiveReturn env) [] - - -- Empty interactive lock first. - tryTakeMVar (envGlobalInteractiveLock env) - - -- Get interactive name and title. - let (interactiveName, interactiveTitle) = head strList - - case focusStatus of - FocusInitInteractivebar -> do - -- Show interactivebar. - let interactivebar = envInitInteractivebar env - interactivebarSetTitle interactivebar interactiveTitle - interactivebarSetContent interactivebar "" - - -- Change interactive type. - let client = envDaemonClient env - processId <- readTVarIO $ envAnythingProcessId env - mkRenderSignal client processId AnythingViewChangeInteractiveType - (AnythingViewChangeInteractiveTypeArgs GlobalInteractive) - -- Change candidate. - mkRenderSignal client processId AnythingViewChangeCandidate - (AnythingViewChangeCandidateArgs [interactiveName]) - _ -> - getCurrentUIFrame env >?>= \uiFrame -> do - -- Show interactivebar. - let interactivebar = uiFrameInteractivebar uiFrame - uiFrameInit uiFrame interactiveTitle "" - -- When PopupWindow is invisible startup anythingView process. - whenM (not <$> popupWindowIsVisible popupWindow) - (do - -- Activate popup window. - popupWindowActivate popupWindow interactivebar - -- Start anything process. - startupAnything (SpawnAnythingProcessArgs - (InteractiveSearchArgs GlobalInteractive [interactiveName]))) - - -- Wait interactive result. - forkGuiIO_ (takeMVar (envGlobalInteractiveLock env)) - (\ result -> - case result of - Left err -> putStrLn $ "globalInteractive : " ++ show err - Right list -> - -- Just do action if return list match. - when (length strList == length list) $ - bracketOnError - (return list) - -- Print error message if exception rasied when do action. - (\ _ -> putStrLn "globalInteractive: exception rasied.") - action) - -- | Reply interactive error. replyLocalInteractiveError :: MethodCall -> Text -> IO () replyLocalInteractiveError call err = @@ -764,56 +520,6 @@ ,tabPlugId = plugId} -> mkRenderSignal client processId PageViewKeyPress (PageViewKeyPressArgs plugId keystoke sEvent) --- | Handle interactivebar key press event. -handleInteractivebarKeyPress :: Environment -> Text -> Interactivebar -> IO () -handleInteractivebarKeyPress env keystoke bar = do - -- Get entry. - let entry = interactivebarEntry bar - -- Focus anything input entry. - editableFocus entry - -- Do action. - isChanged <- - editableIsChanged entry $ - case M.lookup keystoke interactiveKeymap of - Just action -> action env entry - _ -> - -- Insert character. - when (T.length keystoke == 1) $ do - unselectText <- editableGetUnselectText entry - editableSetText entry (unselectText ++ T.unpack keystoke) - -- Send key press signal. - sendAnythingViewKeyPress env entry keystoke isChanged - --- | Paste clipboard to interactivebar. -interactivebarPasteClipboard :: Environment -> Entry -> IO () -interactivebarPasteClipboard env ed = do - clipboard <- widgetGetClipboard ed selectionClipboard - clipboardRequestText clipboard $ \ text -> - text ?>= \ content -> do - -- Paste data from clipboard. - pos <- editableGetPosition ed - editableInsertText ed content pos - editableSetPosition ed (pos + length content) - - -- Send key press signal. - sendAnythingViewKeyPress env ed "" True - --- | Send anything key press. -sendAnythingViewKeyPress :: EditableClass ed => Environment -> ed -> Text -> Bool -> IO () -sendAnythingViewKeyPress env entry keystoke isChanged = do - -- Get client. - let client = envDaemonClient env - -- Get input string. - allText <- editableGetAllText entry - unselectText <- editableGetUnselectText entry - -- Get anything process. - processId <- readTVarIO $ envAnythingProcessId env - -- Get keyPressId for identify anything process. - keyPressId <- tickTVarIO $ envAnythingKeyPressId env - -- Send signal to anything process. - mkRenderSignal client processId AnythingViewKeyPress - (AnythingViewKeyPressArgs keystoke allText unselectText keyPressId isChanged) - -- | View buffer directory. -- If buffer path is not directory, view current directory. viewBufferDirectory :: Environment -> IO () @@ -841,17 +547,7 @@ (runCommand_ "xtrlock") -- | Play/Pause mplayer. -pausePlay :: Environment -> IO () -pausePlay env = +togglePlay :: Environment -> IO () +togglePlay env = mkGenericDaemonSignal (envDaemonClient env) "mplayer" Generic (GenericArgs "Pause" []) - --- | Start irc. -startIrc :: Environment -> IO () -startIrc env = - globalInteractive - env - "sServer : \nnPort : \nsChannel : \nsUserName : \n" - $ \ [server, port, channel, user] -> do - let info = "irc://" ++ user ++ "@" ++ server ++ ":" ++ port ++ "/" ++ channel - mkDaemonSignal (envDaemonClient env) NewTab (NewTabArgs "PageIrc" info []) diff --git a/Manatee/Environment.hs b/Manatee/Environment.hs --- a/Manatee/Environment.hs +++ b/Manatee/Environment.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 @@ -21,14 +21,10 @@ module Manatee.Environment where import Control.Applicative -import Control.Concurrent.MVar import Control.Concurrent.STM -import Graphics.UI.Gtk hiding (Frame, Window, frameNew) import Manatee.Core.DBus import Manatee.Core.Types import Manatee.Toolkit.General.DBus -import Manatee.Toolkit.Widget.Interactivebar -import Manatee.Toolkit.Widget.PopupWindow import Manatee.Types import Manatee.UI.FocusNotifier import Manatee.UI.Frame @@ -47,23 +43,11 @@ <*> newTVarIO windowListNew <*> newTVarIO windowNodeListNew <*> newTVarIO (Tabbar M.empty) + <*> newTVarIO (TabbarSelect M.empty) <*> newTVarIO (BufferList M.empty) <*> newTVarIO Set.empty <*> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO (FocusNotifierList Set.empty Nothing) - <*> vBoxNew False 0 - <*> interactivebarNew - <*> popupWindowNew - <*> newTVarIO 0 - <*> newTVarIO 0 - <*> newTVarIO 0 - <*> newTVarIO Set.empty - <*> newMVar (Right []) - <*> newTVarIO [] - <*> newTVarIO [] - <*> newMVar (Right []) - <*> newTVarIO [] - <*> newTVarIO [] <*> newTVarIO (TabCloseHistory []) <*> newTVarIO [] diff --git a/Manatee/Types.hs b/Manatee/Types.hs --- a/Manatee/Types.hs +++ b/Manatee/Types.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 @@ -21,23 +21,21 @@ module Manatee.Types where import Control.Applicative hiding (empty) -import Control.Concurrent.MVar import Control.Concurrent.STM import DBus.Client hiding (Signal) +import Data.Binary +import Data.DeriveTH import Data.Function import Data.Map (Map) import Data.Ord import Data.Sequence (Seq) import Data.Set import Data.Text.Lazy (Text) -import Graphics.UI.Gtk hiding (on, get, Action, Statusbar, statusbarNew, Window, Frame, frameNew, Plug, Tooltip) +import Graphics.UI.Gtk hiding (on, get, Action, Statusbar, statusbarNew, Window, Frame, frameNew, Plug, Tooltip, WindowState) import Manatee.Core.Types -import Manatee.Toolkit.Data.ListZipper +import Manatee.Toolkit.Data.ListZipper hiding (length, delete, get) import Manatee.Toolkit.Data.SetList -import Manatee.Toolkit.Widget.Interactivebar import Manatee.Toolkit.Widget.NotebookTab -import Manatee.Toolkit.Widget.PopupWindow -import Manatee.Toolkit.Widget.Tooltip import Manatee.UI.FocusNotifier import Manatee.UI.Frame import System.Posix.Types (ProcessID) @@ -50,24 +48,12 @@ ,envWindowList :: TVar WindowList ,envWindowNodeList :: TVar WindowNodeList ,envTabbar :: TVar Tabbar + ,envTabbarSelect :: TVar TabbarSelect ,envBufferList :: TVar BufferList ,envSignalBoxList :: TVar SignalBoxList ,envPageIdCounter :: TVar PageId ,envSignalBoxIdCounter :: TVar SignalBoxId ,envFocusNotifierList :: TVar FocusNotifierList - ,envInitBox :: VBox - ,envInitInteractivebar :: Interactivebar - ,envAnythingPopupWindow :: PopupWindow - ,envAnythingProcessId :: TVar ProcessID - ,envAnythingKeyPressId :: TVar AnythingKeyPressId - ,envTooltipCounter :: TVar Int - ,envTooltipSet :: TVar (Set Tooltip) - ,envLocalInteractiveLock :: MVar (Either Text [String]) - ,envLocalInteractiveTrack :: TVar [(String, String)] - ,envLocalInteractiveReturn :: TVar [String] - ,envGlobalInteractiveLock :: MVar (Either Text [String]) - ,envGlobalInteractiveTrack :: TVar [(String, String)] - ,envGlobalInteractiveReturn:: TVar [String] ,envTabCloseHistory :: TVar TabCloseHistory ,envBufferHistory :: TVar [BufferHistory] } @@ -226,26 +212,84 @@ data Tab = Tab {tabProcessId :: ProcessID ,tabPageId :: PageId + ,tabSignalBoxId :: SignalBoxId ,tabSocketId :: PageSocketId ,tabPlugId :: PagePlugId ,tabUIFrame :: UIFrame} deriving Show +-- | Select tab. +data TabbarSelect = + TabbarSelect (Map PageModeName Int) + deriving Show + -- | UIFrame. data UIFrame = UIFrame {uiFrameBox :: VBox -- box for contain `PageView' - ,uiFrameInteractivebar :: Interactivebar -- interactivebar for interactive input ,uiFrameNotebookTab :: NotebookTab -- notebook tab } instance Show UIFrame where show _ = "UIFrame" --- | Focus status. -data FocusStatus = FocusInitInteractivebar - | FocusLocalInteractivebar - | FocusWindow - deriving (Eq, Show, Read, Ord) +data EnvironmentState = + EnvironmentState {envStateWindowNodeList :: WindowNodeStateList + ,envStateWindowList :: WindowStateList + ,envStateTabbar :: TabbarState + ,envStateBufferList :: BufferListState + } --- | Anything startup function. -data AnythingStartupFun = AnythingStartupFun (IO ()) +data WindowNodeStateList = + WindowNodeStateList {wnslCounter :: Int + ,wnslSet :: Set WindowNodeState} +data WindowStateList = + WindowStateList {wslLeft :: [WindowState] + ,wslRight :: [WindowState]} + +data WindowNodeState = + WindowNodeState {windowNodeStateId :: WindowNodeId + ,windowNodeStateParentId :: Maybe WindowNodeId + ,windowNodeStateChildLeftId :: Maybe WindowNodeId + ,windowNodeStateChildRightId:: Maybe WindowNodeId + ,windowNodeStateType :: WindowNodeType + ,windowNodeStateDirection :: WindowNodeDirection + } + +instance Eq WindowNodeState where + (==) = (==) `on` windowNodeStateId + +instance Ord WindowNodeState where + compare = comparing windowNodeStateId + +data WindowState = + WindowState {windowStateId :: WindowId + ,windowStateSize :: (Int, Int) + } + +type TabSelectIndex = Int + +data TabbarState = + TabbarState {tabbarStateList :: [((WindowId, PageModeName), [TabState], TabSelectIndex)] + ,tabbarStatePageIdCounter :: Int + ,tabbarStateSignalBoxIdCounter :: Int + } + +data TabState = + TabState {tabStatePageId :: PageId + ,tabStateSignalBoxId :: SignalBoxId + } + +data BufferListState = + BufferListState {bufferListStateForegroundPages :: [(PageModeName, [PageId])] + ,bufferListStateBackgroundPages :: [(PageModeName, [PageId])]} + +$(derive makeBinary ''EnvironmentState) +$(derive makeBinary ''WindowNodeState) +$(derive makeBinary ''WindowNodeStateList) +$(derive makeBinary ''WindowState) +$(derive makeBinary ''WindowNodeType) +$(derive makeBinary ''WindowNodeDirection) +$(derive makeBinary ''WindowStateList) +$(derive makeBinary ''BufferListState) +$(derive makeBinary ''TabState) +$(derive makeBinary ''TabbarState) diff --git a/Manatee/UI/FocusNotifier.hs b/Manatee/UI/FocusNotifier.hs --- a/Manatee/UI/FocusNotifier.hs +++ b/Manatee/UI/FocusNotifier.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 diff --git a/Manatee/UI/Frame.hs b/Manatee/UI/Frame.hs --- a/Manatee/UI/Frame.hs +++ b/Manatee/UI/Frame.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 diff --git a/Manatee/UI/UIFrame.hs b/Manatee/UI/UIFrame.hs --- a/Manatee/UI/UIFrame.hs +++ b/Manatee/UI/UIFrame.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 @@ -21,16 +21,13 @@ import Graphics.UI.Gtk hiding (Statusbar, statusbarNew) import Manatee.Types import Manatee.Toolkit.Gtk.Notebook -import Manatee.Toolkit.Widget.Interactivebar import Manatee.Toolkit.Widget.NotebookTab -- | Stick ui frame to notebook. -uiFrameStick :: NotebookClass notebook => notebook -> Maybe UIFrame -> IO UIFrame -uiFrameStick notebook frame = do +uiFrameStick :: NotebookClass notebook => notebook -> IO UIFrame +uiFrameStick notebook = do -- Create or clone ui frame. - uiFrame <- case frame of - Just f -> uiFrameClone f - Nothing -> uiFrameNew + uiFrame <- uiFrameNew -- Stick uiFrame in notebook. let notebookTab = uiFrameNotebookTab uiFrame @@ -46,49 +43,7 @@ -- Create box. box <- vBoxNew False 0 - -- Interactivebar. - interactivebar <- interactivebarNew - -- Notebook tab. notebookTab <- notebookTabNew Nothing Nothing - return $ UIFrame box interactivebar notebookTab - --- | Clone UIFrame. -uiFrameClone :: UIFrame -> IO UIFrame -uiFrameClone oldUIFrame = do - -- Create box. - box <- vBoxNew False 0 - - -- Clone interactivebar. - interactivebar <- interactivebarClone box (uiFrameInteractivebar oldUIFrame) - - -- Notebook tab. - notebookTab <- notebookTabNew Nothing Nothing - - return $ UIFrame box interactivebar notebookTab - --- | UIFrame init. -uiFrameInit :: UIFrame -> String -> String -> IO () -uiFrameInit uiFrame title content = - interactivebarInit (uiFrameInteractivebar uiFrame) - (uiFrameBox uiFrame) - title - content - --- | Show interactivebar. -uiFrameShowInteractivebar :: UIFrame -> IO () -uiFrameShowInteractivebar uiFrame = - interactivebarShow (uiFrameBox uiFrame) - (uiFrameInteractivebar uiFrame) - --- | Hide interactivebar. -uiFrameHideInteractivebar :: UIFrame -> IO () -uiFrameHideInteractivebar uiFrame = - interactivebarExit (uiFrameBox uiFrame) - (uiFrameInteractivebar uiFrame) - --- | Is focus on interactivebar. -uiFrameIsFocusInteractivebar :: UIFrame -> IO Bool -uiFrameIsFocusInteractivebar = - widgetGetIsFocus . interactivebarEntry . uiFrameInteractivebar + return $ UIFrame box notebookTab diff --git a/Manatee/UI/Window.hs b/Manatee/UI/Window.hs --- a/Manatee/UI/Window.hs +++ b/Manatee/UI/Window.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 @@ -37,33 +37,42 @@ import qualified Manatee.Toolkit.Data.ListZipper as LZ -- | Create new window. -windowNew :: WindowNodeType -> WindowNodeDirection -> Maybe WindowNode -> Container -> TVar FocusNotifierList -> WindowListTuple -> IO (Window, WindowListTuple) -windowNew vnType direction parentNode container focusNotifierList (windowList, windowNodeList) = - runStateT_ (windowList, windowNodeList) $ do +windowNew :: WindowNodeType -> WindowNodeDirection -> Maybe WindowNode + -> Container + -> TVar FocusNotifierList + -> WindowListTuple + -> IO (Window, WindowListTuple) +windowNew vnType direction parentNode container focusNotifierList (windowList, windowNodeList) = do -- New window node. - node <- modifyM_ (\(wList, nList) -> do - (node, nnList) <- windowNodeNew parentNode vnType direction (nList, container) - return (node, (wList, nnList))) snd fst + (node, newWindowNodeList) <- windowNodeNew parentNode vnType direction (windowNodeList, container) -- New window. - notebook <- lift notebookNew + window <- windowNewWithNode node focusNotifierList + + -- Add window to window list. + vnType <- windowNodeGetType node + let newWindowList = windowListAddWindow windowList window vnType + + return (window, (newWindowList, newWindowNodeList)) + +-- | New window with give node. +windowNewWithNode :: WindowNode -> TVar FocusNotifierList -> IO Window +windowNewWithNode node focusNotifierList = do + -- New window. + notebook <- notebookNew let window = Window node notebook - lift $ do - -- Set notebook attributes. - set notebook [notebookScrollable := True] -- enable scrolling arrow when too many tabs fit the notebook - -- Add notify frame. - notifierFrame <- frameNewWithShadowType Nothing - windowGetContainer window `containerAdd` notifierFrame - notifierFrame `containerAdd` notebook - focusNotifierNew (windowGetId window) notifierFrame focusNotifierList + -- Set notebook attributes. + set notebook [notebookScrollable := True] -- enable scrolling arrow when too many tabs fit the notebook - -- Show current window. - widgetShowAll (windowNodePaned node) + -- Add notify frame. + notifierFrame <- frameNewWithShadowType Nothing + windowGetContainer window `containerAdd` notifierFrame + notifierFrame `containerAdd` notebook + focusNotifierNew (windowGetId window) notifierFrame focusNotifierList - -- Add window to window list. - vnType <- lift $ windowNodeGetType node - modifyFst (\(wList, _) -> windowListAddWindow wList window vnType) + -- Show current window. + widgetShowAll (windowNodePaned node) return window diff --git a/Manatee/UI/WindowNode.hs b/Manatee/UI/WindowNode.hs --- a/Manatee/UI/WindowNode.hs +++ b/Manatee/UI/WindowNode.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- Copyright (C) 2010 ~ 2011 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 diff --git a/manatee.cabal b/manatee.cabal --- a/manatee.cabal +++ b/manatee.cabal @@ -1,9 +1,9 @@ name: manatee -version: 0.1.8 +version: 0.2.0 Cabal-Version: >= 1.6 license: GPL-3 license-file: LICENSE -copyright: (c) 2009 ~ 2010 Andy Stewart +copyright: (c) 2010 ~ 2011 Andy Stewart synopsis: The Haskell/Gtk+ Integrated Live Environment description: Manatee is Haskell integrated environment written in Haskell. . @@ -16,7 +16,7 @@ Manatee use multi-processes framework, any sub-module running in separate process to protected core won't crash. So it minimize your losses when some unexpected exception throw in extension. . - Video at (Select 720p HD) at : or + Video (Select 720p HD) at : or . You can find screenshots at : . @@ -32,7 +32,7 @@ . This step is optional, it's okay use ld link program, just much slow. :) . - 2) Install GHC compiler : + 2) Install GHC compiler : . Download ghc package for your system, then do below command : . @@ -45,11 +45,11 @@ . 4) Install cabal: . - Download + Download . - Decompress cabal-install-0.8.2.tar.gz and do below command: + Decompress cabal-install-0.10.2.tar.gz and do below command: . - > cd ./cabal-install-0.8.2 && sudo chmod +x ./bootstrap.sh && ./bootstrap.sh + > cd ./cabal-install-0.10.2 && sudo chmod +x ./bootstrap.sh && ./bootstrap.sh . 5) Install dependent Haskell library: . @@ -63,13 +63,13 @@ . 6) Install Manatee (same, don't use root permission): . - > cabal install manatee-core manatee-anything manatee-browser manatee-editor manatee-filemanager manatee-imageviewer manatee-ircclient manatee-mplayer manatee-pdfviewer manatee-processmanager manatee-reader manatee-curl manatee-terminal manatee + > cabal install manatee-core manatee-browser manatee-editor manatee-filemanager manatee-imageviewer manatee-ircclient manatee-mplayer manatee-pdfviewer manatee-processmanager manatee-reader manatee-curl manatee-terminal manatee . That's all, then type command "manatee" to play it! :) . I have test, Manatee can works well in Gnome, KDE, XMonad and XFCE . - Video at (Select 720p HD) at : + Video (Select 720p HD) at : . Screenshots at : . @@ -79,7 +79,7 @@ . Mailing-List: manatee-user\@googlegroups.com manatee-develop\@googlegroups.com . - Manatee is distributed framework, it allowed you install extension don't need depend each other, but it's easy to break if some package is older than core packages (manatee-core, manatee-anything, manatee). So please make sure *all* packages has update to newest version before you report bug to manatee-user\@googlegroups.com . Thanks! :) + Manatee is distributed framework, it allowed you install extension don't need depend each other, but it's easy to break if some package is older than core packages (manatee-core, manatee). So please make sure *all* packages has update to newest version before you report bug to manatee-user\@googlegroups.com . Thanks! :) . author: Andy Stewart maintainer: Andy Stewart @@ -115,9 +115,9 @@ other-modules: executable manatee - build-depends: base >=4 && < 5, manatee-core >= 0.0.8, containers >= 0.3.0.0, unix >= 2.4.0.0, + build-depends: base >=4 && < 5, manatee-core >= 0.1.0, containers >= 0.3.0.0, unix >= 2.4.0.0, mtl >= 1.1.0.2, gtk-serialized-event >= 0.12.0, text >= 0.7.1.0, utf8-string, - gtk >= 0.12.0, dbus-client >= 0.3 && < 0.4, + gtk >= 0.12.0, dbus-client >= 0.3 && < 0.4, derive, binary, filepath >= 1.1.0.3, stm, cairo >= 0.12.0, directory, dbus-core, template-haskell main-is: Main.hs ghc-options: -fwarn-unused-matches -fwarn-unused-binds -fwarn-unused-imports -fwarn-overlapping-patterns -fwarn-duplicate-exports -threaded -fwarn-unrecognised-pragmas -fwarn-hi-shadowing diff --git a/repos.sh b/repos.sh --- a/repos.sh +++ b/repos.sh @@ -60,7 +60,7 @@ esac } -for pkg in ${*:-manatee-core manatee-anything manatee-browser manatee-editor manatee-filemanager manatee-pdfviewer manatee-mplayer manatee-ircclient manatee-processmanager manatee-imageviewer manatee-reader manatee-curl manatee-terminal manatee-template manatee}; +for pkg in ${*:-manatee-core manatee-browser manatee-editor manatee-filemanager manatee-pdfviewer manatee-mplayer manatee-processmanager manatee-imageviewer manatee-terminal manatee-template manatee-ircclient manatee-reader manatee-curl manatee-welcome manatee}; do repos_action $pkg done