manatee 0.1.7 → 0.1.8
raw patch · 7 files changed
+44/−118 lines, 7 filesdep ~manatee-core
Dependency ranges changed: manatee-core
Files
- Manatee/Action/Basic.hs +2/−9
- Manatee/Action/Tab.hs +0/−21
- Manatee/Daemon.hs +34/−32
- Manatee/Types.hs +0/−7
- Manatee/UI/UIFrame.hs +2/−41
- manatee.cabal +3/−5
- repos.sh +3/−3
Manatee/Action/Basic.hs view
@@ -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)
Manatee/Action/Tab.hs view
@@ -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
Manatee/Daemon.hs view
@@ -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.
Manatee/Types.hs view
@@ -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
Manatee/UI/UIFrame.hs view
@@ -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)
manatee.cabal view
@@ -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 : <http://www.youtube.com/watch?v=weS6zys3U8k> <http://www.youtube.com/watch?v=A3DgKDVkyeM> <http://v.youku.com/v_show/id_XMjI2MDMzODI4.html> .@@ -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
repos.sh view
@@ -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