manatee-core 0.0.7 → 0.0.8
raw patch · 8 files changed
+217/−59 lines, 8 files
Files
- Manatee/Core/Page.hs +4/−4
- Manatee/Core/PageFrame.hs +88/−0
- Manatee/Core/PageView.hs +3/−32
- Manatee/Core/Render.hs +56/−12
- Manatee/Core/Types.hs +15/−10
- Manatee/Toolkit/Gtk/Multiline.hs +25/−0
- Manatee/Toolkit/Gtk/ScrolledWindow.hs +24/−0
- manatee-core.cabal +2/−1
Manatee/Core/Page.hs view
@@ -29,10 +29,10 @@ pageNew pId pType plug pvw = return $ Page pId pType plug pvw --- | Page scrolled window.-pageScrolledWindow :: Page -> ScrolledWindow-pageScrolledWindow page =- pageApplyViewWrap page pageViewScrolledWindow+-- | Page box.+pageBox :: Page -> VBox+pageBox page =+ pageApplyViewWrap page pageViewBox -- | Applying function with page buffer. pageApplyViewWrap :: Page -> (forall a . PageView a => a -> b) -> b
+ Manatee/Core/PageFrame.hs view
@@ -0,0 +1,88 @@+-- Author: Andy Stewart <lazycat.manatee@gmail.com>+-- Maintainer: Andy Stewart <lazycat.manatee@gmail.com>+-- +-- Copyright (C) 2010 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+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program. If not, see <http://www.gnu.org/licenses/>.++module Manatee.Core.PageFrame where++import Graphics.UI.Gtk hiding (Statusbar, statusbarNew)+import Manatee.Toolkit.General.String+import Manatee.Toolkit.Gtk.Gtk+import Manatee.Toolkit.Gtk.ScrolledWindow+import Manatee.Toolkit.Widget.Outputbar+import Manatee.Toolkit.Widget.Statusbar++data PageFrame =+ PageFrame {pageFrameBox :: VBox -- box for contain `PageView'+ ,pageFrameFrame :: Frame -- frame+ ,pageFrameScrolledWindow :: ScrolledWindow -- scrolled window+ ,pageFrameOutputbar :: Outputbar -- outputbar for display message+ ,pageFrameStatusbar :: Statusbar -- statusbar+ }++-- | Create 'PageFrame'.+pageFrameNew :: IO PageFrame+pageFrameNew = do+ -- Create box.+ box <- vBoxNew False 0++ -- Body frame.+ frame <- frameNewWithShadowType Nothing+ boxPackStart box frame PackGrow 0 ++ -- Scrolled Window.+ scrolledWindow <- scrolledWindowNew_+ frame `containerAdd` scrolledWindow++ -- Outputbar.+ outputbar <- outputbarNew+ + -- Statusbar.+ statusbar <- statusbarNew box++ return $ PageFrame box frame scrolledWindow outputbar statusbar++-- | Page frame new with mode name.+pageFrameNewWithModeName :: String -> IO PageFrame+pageFrameNewWithModeName name = do+ frame <- pageFrameNew+ pageFrameUpdateStatusbar frame "PageMode" ("Mode (" ++ name ++ ")")+ return frame++-- | Add child.+pageFrameAddChild :: WidgetClass widget => PageFrame -> widget -> IO () +pageFrameAddChild pageFrame widget =+ pageFrameScrolledWindow pageFrame `containerAdd` widget++-- | Show outputbar.+pageFrameShowOutputbar :: PageFrame -> String -> Maybe Int -> IO ()+pageFrameShowOutputbar pageFrame output limit = do+ let str = case limit of+ Just l -> stripFormat output l+ Nothing -> output+ outputbarShow (pageFrameBox pageFrame) + (pageFrameOutputbar pageFrame) + str++-- | Update statusbar.+pageFrameUpdateStatusbar :: PageFrame -> String -> String -> IO ()+pageFrameUpdateStatusbar pageFrame = + statusbarInfoItemUpdate (pageFrameStatusbar pageFrame) ++-- | Update statusbar.+pageFrameUpdateProgress :: PageFrame -> Double -> IO ()+pageFrameUpdateProgress pageFrame = + statusbarProgressUpdate (pageFrameStatusbar pageFrame)
Manatee/Core/PageView.hs view
@@ -31,7 +31,6 @@ import Manatee.Core.Types import Manatee.Toolkit.General.Basic import Manatee.Toolkit.General.Maybe-import Manatee.Toolkit.General.String import Graphics.UI.Gtk.General.General import qualified Data.Map as M@@ -78,34 +77,6 @@ pageViewGetPlugId :: forall a . PageView a => a -> IO PagePlugId pageViewGetPlugId = readTVarIO . pageViewPlugId --- | Update output.-pageViewUpdateOutputStatus :: forall a . PageView a => a -> String -> Maybe Int -> IO ()-pageViewUpdateOutputStatus view output limit = do- plugId <- pageViewGetPlugId view- let str = case limit of - Just l -> stripFormat output l- Nothing -> output- mkDaemonSignal (pageViewClient view)- LocalOutputbarUpdate - (LocalOutputbarUpdateArgs plugId str)---- | Update progress.-pageViewUpdateProgressStatus :: forall a . PageView a => a -> Double -> IO () -pageViewUpdateProgressStatus view progress = do- plugId <- pageViewGetPlugId view- mkDaemonSignal (pageViewClient view)- LocalProgressUpdate- (LocalProgressUpdateArgs plugId progress)----- | Update status.-pageViewUpdateInfoStatus :: forall a . PageView a => a -> String -> String -> IO ()-pageViewUpdateInfoStatus view item status = do- plugId <- pageViewGetPlugId view- mkDaemonSignal (pageViewClient view)- LocalStatusbarUpdate - (LocalStatusbarUpdateArgs plugId item status)- -- | Get dbus client. pageViewClient :: forall a . PageView a => a -> Client pageViewClient view = @@ -116,19 +87,19 @@ pageViewCutAction :: forall a . PageView a => a -> IO () pageViewCutAction view = unlessM (pageViewCut view) $- pageViewUpdateOutputStatus view "Haven't implement pageViewCut" Nothing+ putStrLn "pageViewCutAction : Haven't implement pageViewCut." -- | Copy action. pageViewCopyAction :: forall a . PageView a => a -> IO () pageViewCopyAction view = unlessM (pageViewCopy view) $- pageViewUpdateOutputStatus view "Haven't implement pageViewCopy" Nothing+ putStrLn "pageViewCopyAction : Haven't implement pageViewCopy." -- | Paste action. pageViewPasteAction :: forall a . PageView a => a -> IO () pageViewPasteAction view = unlessM (pageViewPaste view) $- pageViewUpdateOutputStatus view "Haven't implement pageViewPaste" Nothing+ putStrLn "pageViewPasteAction : Haven't implement pageViewPaste." -- | Call local interactive. localInteractive :: forall a . PageView a => a -> String -> ([String] -> IO ()) -> IO ()
Manatee/Core/Render.hs view
@@ -78,17 +78,28 @@ bufferWrap <- bufferNewFun pagePath options client pageId customizeWrap -- Build render client for listen dbus signal.- mkRenderClient client bufferWrap customizeWrap processId pageList pType+ pongStatusTVar <- newTVarIO GotPongMessage+ mkRenderClient client bufferWrap customizeWrap processId pageList pType pongStatusTVar -- Create first page. renderPageNew client bufferWrap pageList processId (pageId, pType, sId) True + -- Send ping signal.+ renderSendPing client pongStatusTVar+ -- Loop. mainGUI -- | Build render client for listen dbus signal.-mkRenderClient :: Client -> PageBufferWrap -> CustomizeWrap -> ProcessID -> TVar PageList -> PageType -> IO ()-mkRenderClient client bufferWrap customizeWrap processId pageList pType = +mkRenderClient :: Client + -> PageBufferWrap + -> CustomizeWrap + -> ProcessID + -> TVar PageList + -> PageType + -> TVar PongStatus+ -> IO ()+mkRenderClient client bufferWrap customizeWrap processId pageList pType pongStatusTVar = -- Build match rule. mkRenderMatchRules client [(CloneRenderPage, renderHandleClonePage client bufferWrap pageList processId pType)@@ -99,6 +110,7 @@ ,(ExitRenderProcess, renderHandleExitProcess client processId) ,(UpdateConfig, renderHandleUpdateConfig customizeWrap) ,(InstallConfig, renderHandleInstallConfig bufferWrap)+ ,(Pong, renderHandlePong pongStatusTVar) ] -- | Handle clone render page signal.@@ -129,7 +141,7 @@ -- Reparent. writeTVarIO (pageApplyViewWrap op pageViewPlugId) pId -- update new page plug id- widgetReparent (pageScrolledWindow op) (plugBody newPlug)+ widgetReparent (pageBox op) (plugBody newPlug) widgetShowAll $ plugBody newPlug -- New page.@@ -139,7 +151,7 @@ runTVarStateT pageList $ put . Set.insert page -- Destroy old plug.- renderHandleDestroyPage pageList (DestroyRenderPageArgs pageId oldPlugId)+ renderHandleDestroyPage pageList (DestroyRenderPageArgs oldPlugId) -- Send `NewRenderPageConfirm` signal. let modeName = pageModeName $ pageBufferMode buffer @@ -163,7 +175,7 @@ page <- pageNew pageId pType plug viewWrap -- Create page and pageView.- plugBody plug `containerAdd` pageScrolledWindow page+ plugBody plug `containerAdd` pageBox page widgetShowAll $ plugBody plug -- Add page to page list.@@ -197,20 +209,20 @@ -- | Handle destroy render page signal. renderHandleDestroyPage :: TVar PageList -> RenderSignalArgs -> IO ()-renderHandleDestroyPage pageList (DestroyRenderPageArgs _ plugId) = +renderHandleDestroyPage pageList (DestroyRenderPageArgs plugId) = runTVarStateT pageList $ \pl -> - maybeFindMin pl (\x -> pagePlugId x == plugId) ?>= \mp -> do+ maybeFindMin pl (\x -> pagePlugId x == plugId) ?>= \page -> do lift $ debugDBusMessage $ "renderHandleDestroyPage: Catch DestroyRenderPage signal. Plug id : " ++ show plugId -- Delete page from page list.- put (Set.delete mp pl) + put (Set.delete page pl) -- Destroy page.- lift $ plugDestroy $ pagePlug mp+ lift $ plugDestroy $ pagePlug page -- | Handle exit process signal. renderHandleExitProcess :: Client -> ProcessID -> RenderSignalArgs -> IO () renderHandleExitProcess client processId (ExitRenderProcessArgs pageId) = do- -- Send RenderProcessExit signal to daemon process.- mkDaemonSignal client RenderProcessExit (RenderProcessExitArgs pageId processId)+ -- Send RenderProcessExitConfirm signal to daemon process.+ mkDaemonSignal client RenderProcessExitConfirm (RenderProcessExitConfirmArgs pageId processId) -- Quit process. mainQuit@@ -226,3 +238,35 @@ packageName <- pageBufferPackageName buffer runCommand_ ("cabal install " ++ packageName ++ " --reinstall") +-- | Handle pong signal.+renderHandlePong :: TVar PongStatus -> RenderSignalArgs -> IO ()+renderHandlePong pongStatusTVar _ = + writeTVarIO pongStatusTVar GotPongMessage+ +-- | Send ping signal. +-- Render process will send PING message in delay time.+-- Quit current process if not receive PONG message in next delay time.+-- Use for test daemon process whether live to avoid immortal process.+renderSendPing :: Client -> TVar PongStatus -> IO ()+renderSendPing client pongStatusTVar = do+ -- Get current process id.+ processId <- getProcessID+ let sendDelay = 5000 -- delay time to send ping message++ -- Send ping message in delay time.+ timeoutAdd (do+ pongStatus <- readTVarIO pongStatusTVar+ case pongStatus of+ GotPongMessage -> do+ -- Send ping signal to test whether daemon process still live.+ mkDaemonSignal client Ping (PingArgs processId)+ -- Change pong status to WaitPongMessage. + writeTVarIO pongStatusTVar WaitPongMessage+ WaitPongMessage -> do+ -- Quit process if lost ping message.+ putStrLn $ "Lost pong message from daemon process, quit process (" ++ show processId ++ ")"+ mainQuit+ return True)+ sendDelay+ + return ()
Manatee/Core/Types.hs view
@@ -158,6 +158,8 @@ class Typeable a => PageView a where pageViewBuffer :: a -> PageBufferWrap pageViewPlugId :: a -> TVar PagePlugId+ pageViewBox :: a -> VBox+ pageViewScrolledWindow :: a -> ScrolledWindow pageViewHandleKeyAction :: a -> Text -> SerializedEvent -> IO () pageViewFocus :: a -> IO () pageViewCopy :: a -> IO Bool@@ -166,7 +168,6 @@ pageViewCut _ = return False pageViewPaste :: a -> IO Bool pageViewPaste _ = return False- pageViewScrolledWindow :: a -> ScrolledWindow pageViewScrollToTop :: a -> IO () pageViewScrollToTop = scrolledWindowScrollToTop . pageViewScrolledWindow@@ -240,38 +241,36 @@ data DaemonMember = NewRenderPageConfirm | NewAnythingProcessConfirm- | RenderProcessExit + | RenderProcessExit+ | RenderProcessExitConfirm | RenderProcessException | NewTab | AnythingViewOutput | LocalInteractivebarExit- | LocalOutputbarUpdate- | LocalStatusbarUpdate- | LocalProgressUpdate | SynchronizationPathName | ChangeTabName | SwitchBuffer | ShowTooltip | LocalInteractiveReturn | GlobalInteractiveReturn+ | Ping deriving (Show, Eq, Ord) data DaemonSignalArgs = NewRenderPageConfirmArgs PageId PageType SignalBoxId PagePlugId ProcessID PageModeName String Bool | NewAnythingProcessConfirmArgs PagePlugId ProcessID- | RenderProcessExitArgs PageId ProcessID+ | RenderProcessExitArgs PageId+ | RenderProcessExitConfirmArgs PageId ProcessID | RenderProcessExceptionArgs PageId | NewTabArgs PageType PagePath [String] | AnythingViewOutputArgs String String (Maybe Int) AnythingKeyPressId | LocalInteractivebarExitArgs- | LocalOutputbarUpdateArgs PagePlugId String- | LocalStatusbarUpdateArgs PagePlugId String String- | LocalProgressUpdateArgs PagePlugId Double | SynchronizationPathNameArgs PageModeName PageId String | ChangeTabNameArgs PageModeName PageId String | SwitchBufferArgs PageModeName PageId | ShowTooltipArgs String (Maybe Point) Int (Maybe Color) (Maybe Color) Bool (Maybe PageId) | LocalInteractiveReturnArgs [String] | GlobalInteractiveReturnArgs [String]+ | PingArgs ProcessID deriving (Show, Eq, Ord) data RenderMember = CloneRenderPage@@ -285,20 +284,26 @@ | AnythingViewChangeInteractiveType | UpdateConfig | InstallConfig+ | Pong deriving (Show, Eq, Ord) data RenderSignalArgs = CloneRenderPageArgs PageId SignalBoxId | ReparentRenderPageArgs PageId PagePlugId SignalBoxId | FocusRenderPageArgs PagePlugId | PageViewKeyPressArgs PagePlugId Text SerializedEvent- | DestroyRenderPageArgs PageId PagePlugId+ | DestroyRenderPageArgs PagePlugId | ExitRenderProcessArgs PageId | AnythingViewKeyPressArgs Text String String AnythingKeyPressId Bool | AnythingViewChangeCandidateArgs [String] | AnythingViewChangeInteractiveTypeArgs AnythingInteractiveType | UpdateConfigArgs | InstallConfigArgs+ | PongArgs deriving (Show, Eq, Ord)++data PongStatus = WaitPongMessage+ | GotPongMessage+ deriving (Show, Eq, Ord) data DaemonBroadcastMember = ExitDaemonProcess deriving (Show, Eq, Ord)
Manatee/Toolkit/Gtk/Multiline.hs view
@@ -79,6 +79,25 @@ iter <- textBufferGetInsertIter buffer textBufferGetTagByteStringWithIter buffer iter tag +-- | Selection bound with line/row.+textBufferSelectBound :: TextBufferClass self => self -> (Int, Int) -> (Int, Int) -> IO ()+textBufferSelectBound tb (insertLine, insertRow) (selectLine, selectRow) = do+ -- Get temp iter.+ iter <- textBufferGetStartIter tb++ -- Create insert iter.+ insertIter <- textIterCopy iter+ textIterSetLine insertIter insertLine+ textIterSetLineOffset insertIter insertRow++ -- Create select iter.+ selectIter <- textIterCopy iter+ textIterSetLine selectIter selectLine+ textIterSetLineOffset selectIter selectRow++ -- Select bound.+ textBufferSelectRange tb insertIter selectIter+ -- | Text buffer keep selection to execute action. textBufferKeepSelection :: TextBufferClass self => self -> Bool -> Bool -> IO () -> IO () textBufferKeepSelection tb sLeft eLeft action = do @@ -320,6 +339,12 @@ tb <- textViewGetBuffer tv iter <- textBufferGetIterAtMark tb tm textViewPlaceCursor tv iter++-- | Get line count.+textViewGetLineCount :: TextViewClass self => self -> IO Int+textViewGetLineCount tv = do+ tb <- textViewGetBuffer tv+ textBufferGetLineCount tb -- | Goto line. -- If line number not in buffer bound, goto min/max line.
Manatee/Toolkit/Gtk/ScrolledWindow.hs view
@@ -135,4 +135,28 @@ cr <- adjustmentGetValue aj return (cr >= up - ps) +-- | Get value. +scrolledWindowGetValue :: ScrolledWindowClass sw => sw -> IO (Double, Double) +scrolledWindowGetValue sw = do+ hAdj <- scrolledWindowGetHAdjustment sw+ vAdj <- scrolledWindowGetVAdjustment sw+ hValue <- adjustmentGetValue hAdj+ vValue <- adjustmentGetValue vAdj+ return (hValue, vValue)++-- | Set value.+scrolledWindowSetValue :: ScrolledWindowClass sw => sw -> (Double, Double) -> IO ()+scrolledWindowSetValue sw (x, y) = do+ hAdj <- scrolledWindowGetHAdjustment sw+ vAdj <- scrolledWindowGetVAdjustment sw+ adjustmentSetValue hAdj x+ adjustmentSetValue vAdj y +-- | Get max size. +scrolledWindowGetSize :: ScrolledWindowClass sw => sw -> IO (Double, Double) +scrolledWindowGetSize sw = do+ hAdj <- scrolledWindowGetHAdjustment sw+ vAdj <- scrolledWindowGetVAdjustment sw+ hSize <- adjustmentGetUpper hAdj+ vSize <- adjustmentGetUpper vAdj+ return (hSize, vSize)
manatee-core.cabal view
@@ -1,5 +1,5 @@ name: manatee-core-version: 0.0.7+version: 0.0.8 Cabal-Version: >= 1.6 license: GPL-3 license-file: LICENSE@@ -47,6 +47,7 @@ Manatee.Core.Interactive Manatee.Core.FileOpenRule Manatee.Core.Page+ Manatee.Core.PageFrame Manatee.Core.PageMode Manatee.Core.PageView Manatee.Core.Config