manatee 0.1.8 → 0.2.0
raw patch · 17 files changed
+689/−845 lines, 17 filesdep +binarydep +derivedep +filepathdep ~manatee-coresetup-changed
Dependencies added: binary, derive, filepath
Dependency ranges changed: manatee-core
Files
- Main.hs +24/−2
- Manatee/Action/Basic.hs +276/−142
- Manatee/Action/BufferList.hs +1/−1
- Manatee/Action/Tab.hs +27/−18
- Manatee/Action/Tabbar.hs +1/−1
- Manatee/Action/Window.hs +13/−22
- Manatee/Daemon.hs +221/−525
- Manatee/Environment.hs +2/−18
- Manatee/Types.hs +72/−28
- Manatee/UI/FocusNotifier.hs +1/−1
- Manatee/UI/Frame.hs +1/−1
- Manatee/UI/UIFrame.hs +5/−50
- Manatee/UI/Window.hs +30/−21
- Manatee/UI/WindowNode.hs +1/−1
- Setup.hs +1/−1
- manatee.cabal +12/−12
- repos.sh +1/−1
Main.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> ----- 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
Manatee/Action/Basic.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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
Manatee/Action/BufferList.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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
Manatee/Action/Tab.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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 ()
Manatee/Action/Tabbar.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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
Manatee/Action/Window.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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 ()
Manatee/Daemon.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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 [])
Manatee/Environment.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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 []
Manatee/Types.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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)
Manatee/UI/FocusNotifier.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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
Manatee/UI/Frame.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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
Manatee/UI/UIFrame.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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
Manatee/UI/Window.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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
Manatee/UI/WindowNode.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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
Setup.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- 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
manatee.cabal view
@@ -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 : <http://www.youtube.com/watch?v=weS6zys3U8k> or <http://www.youtube.com/watch?v=A3DgKDVkyeM>+ Video (Select 720p HD) at : <http://www.youtube.com/watch?v=weS6zys3U8k> or <http://www.youtube.com/watch?v=A3DgKDVkyeM> . You can find screenshots at : <http://goo.gl/MkVw> .@@ -32,7 +32,7 @@ . This step is optional, it's okay use ld link program, just much slow. :) . - 2) Install GHC compiler <http://www.haskell.org/ghc/download_ghc_6_12_3.html>:+ 2) Install GHC compiler <http://www.haskell.org/ghc/download_ghc_7_0_3>: . Download ghc package for your system, then do below command : .@@ -45,11 +45,11 @@ . 4) Install cabal: .- Download <http://hackage.haskell.org/packages/archive/cabal-install/0.8.2/cabal-install-0.8.2.tar.gz>+ Download <http://hackage.haskell.org/packages/archive/cabal-install/0.10.2/cabal-install-0.10.2.tar.gz> .- 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 : <http://www.youtube.com/watch?v=weS6zys3U8k> <http://www.youtube.com/watch?v=A3DgKDVkyeM> <http://v.youku.com/v_show/id_XMjI2MDMzODI4.html>+ Video (Select 720p HD) at : <http://www.youtube.com/watch?v=weS6zys3U8k> <http://www.youtube.com/watch?v=A3DgKDVkyeM> <http://v.youku.com/v_show/id_XMjI2MDMzODI4.html> . Screenshots at : <http://goo.gl/MkVw> .@@ -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 <lazycat.manatee@gmail.com>@@ -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
repos.sh view
@@ -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