module Manatee.Core.PageView where
import Control.Concurrent.STM
import Control.Exception
import Control.Monad
import DBus.Client hiding (Signal)
import DBus.Message
import DBus.Types
import Manatee.Core.DBus
import Manatee.Core.Interactive
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
pageViewKeymap :: PageViewKeymap
pageViewKeymap =
M.fromList
[("M-u", pageViewScrollStepUp)
,("M-i", pageViewScrollStepDown)
,("M-U", pageViewScrollPageUp)
,("M-I", pageViewScrollPageDown)
,("C-I", pageViewScrollToTop)
,("C-U", pageViewScrollToBottom)
,("PageDown", pageViewScrollPageUp)
,("PageUp", pageViewScrollPageDown)
,("Home", pageViewScrollToTop)
,("End", pageViewScrollToBottom)
,("M-y", pageViewScrollStepRight)
,("M-o", pageViewScrollStepLeft)
,("M-Y", pageViewScrollPageRight)
,("M-O", pageViewScrollPageLeft)
,("C-Y", pageViewScrollToLeft)
,("C-O", pageViewScrollToRight)
,("M-x", pageViewCutAction)
,("M-c", pageViewCopyAction)
,("M-v", pageViewPasteAction)
]
pageViewScrollStepUp, pageViewScrollStepDown, pageViewScrollPageUp, pageViewScrollPageDown :: PageView a => a -> IO ()
pageViewScrollStepUp = pageViewScrollVerticalStep True
pageViewScrollStepDown = pageViewScrollVerticalStep False
pageViewScrollPageUp = pageViewScrollVerticalPage True
pageViewScrollPageDown = pageViewScrollVerticalPage False
pageViewScrollStepRight, pageViewScrollStepLeft, pageViewScrollPageRight, pageViewScrollPageLeft :: PageView a => a -> IO ()
pageViewScrollStepRight = pageViewScrollHorizontalStep False
pageViewScrollStepLeft = pageViewScrollHorizontalStep True
pageViewScrollPageRight = pageViewScrollHorizontalPage False
pageViewScrollPageLeft = pageViewScrollHorizontalPage True
pageViewGetPlugId :: forall a . PageView a => a -> IO PagePlugId
pageViewGetPlugId = readTVarIO . pageViewPlugId
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)
pageViewUpdateProgressStatus :: forall a . PageView a => a -> Double -> IO ()
pageViewUpdateProgressStatus view progress = do
plugId <- pageViewGetPlugId view
mkDaemonSignal (pageViewClient view)
LocalProgressUpdate
(LocalProgressUpdateArgs plugId progress)
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)
pageViewClient :: forall a . PageView a => a -> Client
pageViewClient view =
case pageViewBuffer view of
(PageBufferWrap b) -> pageBufferClient b
pageViewCutAction :: forall a . PageView a => a -> IO ()
pageViewCutAction view =
unlessM (pageViewCut view) $
pageViewUpdateOutputStatus view "Haven't implement pageViewCut" Nothing
pageViewCopyAction :: forall a . PageView a => a -> IO ()
pageViewCopyAction view =
unlessM (pageViewCopy view) $
pageViewUpdateOutputStatus view "Haven't implement pageViewCopy" Nothing
pageViewPasteAction :: forall a . PageView a => a -> IO ()
pageViewPasteAction view =
unlessM (pageViewPaste view) $
pageViewUpdateOutputStatus view "Haven't implement pageViewPaste" Nothing
localInteractive :: forall a . PageView a => a -> String -> ([String] -> IO ()) -> IO ()
localInteractive view args action =
case parseInteractiveString args of
Left err -> putStrLn $ "localInteractive : Failed with reason : " ++ show err
Right strList -> do
plugId <- pageViewGetPlugId view
callDaemonMethodAsync
(pageViewClient view)
"Interactive"
[toVariant (plugId, args)]
(\ err -> putStrLn $ "localInteractive : Failed with reason : " ++ show err)
(\ methodReturn -> do
let variants = messageBody methodReturn
unless (null variants) $
(fromVariant (head variants) :: Maybe [String])
?>= \ list ->
when (length strList == length list) $
postGUIAsync (bracketOnError
(return list)
(\ _ -> putStrLn "localInteractive: exception rasied.")
action))