diff --git a/Manatee/Action/Basic.hs b/Manatee/Action/Basic.hs --- a/Manatee/Action/Basic.hs +++ b/Manatee/Action/Basic.hs @@ -164,13 +164,7 @@ case getNextWindow windowList of Just win -> action win - Nothing -> message env "Just current window exist." - --- | Display message. -message :: Environment -> String -> IO () -message env output = - getCurrentUIFrame env >?>= \frame -> - uiFrameShowOutputbar frame output + Nothing -> putStrLn "Just current window exist." -- | Focus current tab.. focusCurrentTab :: Environment -> IO () @@ -230,9 +224,8 @@ -- Send tab destroy signal to child process. forM_ (tabbarGetTabList windowId (Tabbar tabbar)) $ \ Tab {tabProcessId = processId - ,tabPageId = pageId ,tabPlugId = plugId} -> - mkRenderSignal client processId DestroyRenderPage (DestroyRenderPageArgs pageId plugId) + mkRenderSignal client processId DestroyRenderPage (DestroyRenderPageArgs plugId) -- Return new tabbar that remove all tabs match window id. return $ tabbarRemoveTabs windowId (Tabbar tabbar) diff --git a/Manatee/Action/Tab.hs b/Manatee/Action/Tab.hs --- a/Manatee/Action/Tab.hs +++ b/Manatee/Action/Tab.hs @@ -329,27 +329,6 @@ -- Update history list. writeTVarIO tabCloseHistoryTVar (TabCloseHistory (snd $ partition (== undoItem) history)) --- | Update output message. -tabUpdateOutput :: TVar Tabbar -> PagePlugId -> String -> IO () -tabUpdateOutput tabbar plugId output = do - tabs <- readTVarIO tabbar - tabbarGetTab plugId tabs ?>= \ tab -> - uiFrameShowOutputbar (tabUIFrame tab) output - --- | Update status message. -tabUpdateStatus :: TVar Tabbar -> PagePlugId -> String -> String -> IO () -tabUpdateStatus tabbar plugId item status = do - tabs <- readTVarIO tabbar - tabbarGetTab plugId tabs ?>= \ tab -> - uiFrameUpdateStatusbar (tabUIFrame tab) item status - --- | Update progress. -tabUpdateProgress :: TVar Tabbar -> PagePlugId -> Double -> IO () -tabUpdateProgress tabbar plugId progress = do - tabs <- readTVarIO tabbar - tabbarGetTab plugId tabs ?>= \ tab -> - uiFrameUpdateProgress (tabUIFrame tab) progress - -- | Get current page id. tabGetCurrentPageId :: Environment -> IO (Maybe PageId) tabGetCurrentPageId env = do diff --git a/Manatee/Daemon.hs b/Manatee/Daemon.hs --- a/Manatee/Daemon.hs +++ b/Manatee/Daemon.hs @@ -85,6 +85,7 @@ let frame = envFrame env anythingBox = envInitBox env anythingInteractivebar = envInitInteractivebar env + anythingWindow = pwWindow $ envAnythingPopupWindow env -- Build daemon client for listen dbus signal. mkDaemonClient env @@ -100,6 +101,13 @@ M.fromList $ map (\ (key, (pType, pPath, pOptions)) -> (T.pack key, Action (newTab pType pPath pOptions))) (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 + -- Handle key event. frame `on` keyPressEvent $ tryEvent $ do -- Remove tooltip when press key. @@ -254,32 +262,38 @@ -- | Build daemon client for listen dbus signal. mkDaemonClient :: Environment -> IO () mkDaemonClient env = do - let tabbar = envTabbar env - client = envDaemonClient env + let client = envDaemonClient env mkDaemonMatchRules client [(NewRenderPageConfirm, daemonHandleNewPageConfirm env) - ,(RenderProcessExit, daemonHandleRenderProcessExit) + ,(RenderProcessExit, daemonHandleRenderProcessExit env) + ,(RenderProcessExitConfirm, daemonHandleRenderProcessExitConfirm) ,(NewTab, daemonHandleNewTab env) ,(NewAnythingProcessConfirm, daemonHandleNewAnythingProcessConfirm env) ,(AnythingViewOutput, daemonHandleAnythingViewOutput env) ,(LocalInteractivebarExit, daemonHandleLocalInteractivebarExit env) - ,(LocalOutputbarUpdate, daemonHandleLocalOutputbarUpdate tabbar) - ,(LocalStatusbarUpdate, daemonHandleLocalStatusbarUpdate tabbar) - ,(LocalProgressUpdate, daemonHandleLocalProgressUpdate tabbar) ,(SynchronizationPathName, daemonHandleSynchronizationPathName env) ,(ChangeTabName, daemonHandleChangeTabName env) ,(SwitchBuffer, daemonHandleSwitchBuffer env) ,(ShowTooltip, daemonHandleShowTooltip env) ,(LocalInteractiveReturn, daemonHandleLocalInteractiveReturn env) ,(GlobalInteractiveReturn, daemonHandleGlobalInteractiveReturn env) + ,(Ping, daemonHandlePing env) ] -- | Handle render process exit signal. -daemonHandleRenderProcessExit :: DaemonSignalArgs -> IO () -daemonHandleRenderProcessExit (RenderProcessExitArgs pageId processId) = - debugDBusMessage $ "daemonHandleRenderProcessExit: child process " ++ show processId ++ " exit. With page id : " ++ show pageId +daemonHandleRenderProcessExit :: Environment -> DaemonSignalArgs -> IO () +daemonHandleRenderProcessExit env (RenderProcessExitArgs pageId) = + tabClose env pageId +-- | Handle render process exit confirm signal. +daemonHandleRenderProcessExitConfirm :: DaemonSignalArgs -> IO () +daemonHandleRenderProcessExitConfirm (RenderProcessExitConfirmArgs pageId processId) = + debugDBusMessage $ "daemonHandleRenderProcessExitConfirm: child process " + ++ show processId + ++ " exit. With page id : " + ++ show pageId + -- | Handle new tab signal. daemonHandleNewTab :: Environment -> DaemonSignalArgs -> IO () daemonHandleNewTab env (NewTabArgs pageType pagePath options) = @@ -348,21 +362,6 @@ unless (focusStatus == FocusInitInteractivebar) $ exitInteractivebar env --- | Handle local outputbar update. -daemonHandleLocalOutputbarUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO () -daemonHandleLocalOutputbarUpdate tabbar (LocalOutputbarUpdateArgs plugId output) = - tabUpdateOutput tabbar plugId output - --- | Handle local statusbar update. -daemonHandleLocalStatusbarUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO () -daemonHandleLocalStatusbarUpdate tabbar (LocalStatusbarUpdateArgs plugId item status) = - tabUpdateStatus tabbar plugId item status - --- | Handle local statusbar update. -daemonHandleLocalProgressUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO () -daemonHandleLocalProgressUpdate tabbar (LocalProgressUpdateArgs plugId progress) = - tabUpdateProgress tabbar plugId progress - -- | Handle synchronization tab name. daemonHandleSynchronizationPathName :: Environment -> DaemonSignalArgs -> IO () daemonHandleSynchronizationPathName env (SynchronizationPathNameArgs modeName pageId path) = do @@ -493,6 +492,11 @@ 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 @@ -515,7 +519,7 @@ -- Show tooltip when current no window exist. Nothing -> showTooltip point Just (Tab {tabPageId = tpId - ,tabUIFrame = UIFrame {uiFrameFrame = frame}}) -> do + ,tabUIFrame = UIFrame {uiFrameBox = frame}}) -> do -- Translate UIFrame coordinate to top-level coordinate. (Rectangle fx fy _ _) <- widgetGetAllocation frame let tooltipPoint = fmap ((+) fx *** (+) fy) point @@ -541,7 +545,7 @@ -- Get signal box. sbList <- readTVarIO signalBoxList - case (maybeFindMin sbList (\x -> signalBoxId x == sId)) of + case maybeFindMin sbList (\x -> signalBoxId x == sId) of Nothing -> putStrLn $ "### Impossible: daemonHandleNewPageConfirm - Can't find signal box Id " ++ show sId Just signalBox -> do -- Get window id that socket add. @@ -554,7 +558,7 @@ -- Add plug to socket. let uiFrame = signalBoxUIFrame signalBox notebookTab = uiFrameNotebookTab uiFrame - socketId <- socketFrameAdd uiFrame plugId modeName + socketId <- socketFrameAdd uiFrame plugId -- Stop spinner animation. notebookTabStop notebookTab @@ -600,15 +604,13 @@ when isFirstPage $ tabbarSyncNewTab env windowId args -- | Add socket to socket frame. -socketFrameAdd :: UIFrame -> PagePlugId -> PageModeName -> IO PageSocketId -socketFrameAdd uiFrame (GWindowId plugId) modeName = do +socketFrameAdd :: UIFrame -> PagePlugId -> IO PageSocketId +socketFrameAdd uiFrame (GWindowId plugId) = do -- Add plug in UIFrame. - let socketFrame = uiFrameFrame uiFrame + let socketFrame = uiFrameBox uiFrame socket <- socketNew_ socketFrame `containerAdd` socket socketAddId socket plugId - -- Update page mode status in UIFrame. - uiFrameUpdateStatusbar uiFrame "PageMode" ("Mode (" ++ modeName ++ ")") GWindowId <$> socketGetId socket -- | Return buffer history. diff --git a/Manatee/Types.hs b/Manatee/Types.hs --- a/Manatee/Types.hs +++ b/Manatee/Types.hs @@ -36,17 +36,13 @@ import Manatee.Toolkit.Data.SetList import Manatee.Toolkit.Widget.Interactivebar import Manatee.Toolkit.Widget.NotebookTab -import Manatee.Toolkit.Widget.Outputbar import Manatee.Toolkit.Widget.PopupWindow -import Manatee.Toolkit.Widget.Statusbar import Manatee.Toolkit.Widget.Tooltip import Manatee.UI.FocusNotifier import Manatee.UI.Frame import System.Posix.Types (ProcessID) import Text.Printf -import qualified Graphics.UI.Gtk as Gtk - -- | Environment. data Environment = Environment {envFrame :: Frame @@ -239,9 +235,6 @@ data UIFrame = UIFrame {uiFrameBox :: VBox -- box for contain `PageView' ,uiFrameInteractivebar :: Interactivebar -- interactivebar for interactive input - ,uiFrameFrame :: Gtk.Frame - ,uiFrameOutputbar :: Outputbar -- outputbar for display message - ,uiFrameStatusbar :: Statusbar -- statusbar ,uiFrameNotebookTab :: NotebookTab -- notebook tab } instance Show UIFrame where diff --git a/Manatee/UI/UIFrame.hs b/Manatee/UI/UIFrame.hs --- a/Manatee/UI/UIFrame.hs +++ b/Manatee/UI/UIFrame.hs @@ -20,12 +20,9 @@ import Graphics.UI.Gtk hiding (Statusbar, statusbarNew) import Manatee.Types -import Manatee.Toolkit.Gtk.Gtk import Manatee.Toolkit.Gtk.Notebook import Manatee.Toolkit.Widget.Interactivebar import Manatee.Toolkit.Widget.NotebookTab -import Manatee.Toolkit.Widget.Outputbar -import Manatee.Toolkit.Widget.Statusbar -- | Stick ui frame to notebook. uiFrameStick :: NotebookClass notebook => notebook -> Maybe UIFrame -> IO UIFrame @@ -52,20 +49,10 @@ -- Interactivebar. interactivebar <- interactivebarNew - -- Body frame. - frame <- frameNewWithShadowType Nothing - boxPackStart box frame PackGrow 0 - - -- Outputbar. - outputbar <- outputbarNew - - -- Statusbar. - statusbar <- statusbarNew box - -- Notebook tab. notebookTab <- notebookTabNew Nothing Nothing - return $ UIFrame box interactivebar frame outputbar statusbar notebookTab + return $ UIFrame box interactivebar notebookTab -- | Clone UIFrame. uiFrameClone :: UIFrame -> IO UIFrame @@ -76,20 +63,10 @@ -- Clone interactivebar. interactivebar <- interactivebarClone box (uiFrameInteractivebar oldUIFrame) - -- Body frame. - frame <- frameNewWithShadowType Nothing - boxPackStart box frame PackGrow 0 - - -- Outputbar. - outputbar <- outputbarNew - - -- Clone statusbar. - statusbar <- statusbarClone box (uiFrameStatusbar oldUIFrame) - -- Notebook tab. notebookTab <- notebookTabNew Nothing Nothing - return $ UIFrame box interactivebar frame outputbar statusbar notebookTab + return $ UIFrame box interactivebar notebookTab -- | UIFrame init. uiFrameInit :: UIFrame -> String -> String -> IO () @@ -115,19 +92,3 @@ uiFrameIsFocusInteractivebar :: UIFrame -> IO Bool uiFrameIsFocusInteractivebar = widgetGetIsFocus . interactivebarEntry . uiFrameInteractivebar - --- | Show outputbar. -uiFrameShowOutputbar :: UIFrame -> String -> IO () -uiFrameShowOutputbar uiFrame = - outputbarShow (uiFrameBox uiFrame) - (uiFrameOutputbar uiFrame) - --- | Update statusbar. -uiFrameUpdateStatusbar :: UIFrame -> String -> String -> IO () -uiFrameUpdateStatusbar uiFrame = - statusbarInfoItemUpdate (uiFrameStatusbar uiFrame) - --- | Update statusbar. -uiFrameUpdateProgress :: UIFrame -> Double -> IO () -uiFrameUpdateProgress uiFrame = - statusbarProgressUpdate (uiFrameStatusbar uiFrame) diff --git a/manatee.cabal b/manatee.cabal --- a/manatee.cabal +++ b/manatee.cabal @@ -1,5 +1,5 @@ name: manatee -version: 0.1.7 +version: 0.1.8 Cabal-Version: >= 1.6 license: GPL-3 license-file: LICENSE @@ -67,9 +67,7 @@ . That's all, then type command "manatee" to play it! :) . - I have test, Manatee can works well in Gnome, KDE and XFCE - . - Unfortunately, Manatee can't work in XMonad, please let me know if some XMonad hacker know how to fix it. :) + I have test, Manatee can works well in Gnome, KDE, XMonad and XFCE . Video at (Select 720p HD) at : . @@ -117,7 +115,7 @@ other-modules: executable manatee - build-depends: base >=4 && < 5, manatee-core >= 0.0.7, containers >= 0.3.0.0, unix >= 2.4.0.0, + build-depends: base >=4 && < 5, manatee-core >= 0.0.8, 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, stm, cairo >= 0.12.0, directory, dbus-core, template-haskell diff --git a/repos.sh b/repos.sh --- a/repos.sh +++ b/repos.sh @@ -35,9 +35,9 @@ ;; pull) darcs pull ;; - push) darcs push AndyStewart@patch-tag.com:/r/AndyStewart/$PKG + push) darcs push AndyStewart@patch-tag.com:/r/AndyStewart/$PKG --set-default ;; - pushall) darcs push AndyStewart@patch-tag.com:/r/AndyStewart/$PKG -a + pushall) darcs push AndyStewart@patch-tag.com:/r/AndyStewart/$PKG -a --set-default ;; record) darcs record -l --delete-logfile --skip-long-comment ;; @@ -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}; +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}; do repos_action $pkg done