module Manatee.Daemon where
import Control.Applicative hiding (empty)
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)
import Data.Text.Lazy (Text)
import GHC.Conc
import Graphics.UI.Gtk hiding (Window, windowNew, Frame, frameNew,
Signal, Variant, Action,
plugNew, plugGetId, get, Keymap)
import Graphics.UI.Gtk.Gdk.SerializedEvent
import Manatee.Action.Basic
import Manatee.Action.BufferList
import Manatee.Action.Tab
import Manatee.Action.Tabbar
import Manatee.Action.Window
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
import Manatee.Toolkit.General.Process
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.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
daemonMain :: IO ()
daemonMain = do
unsafeInitGUIForThreadedRTS
env <- mkEnvironment
let frame = envFrame env
anythingBox = envInitBox env
anythingInteractivebar = envInitInteractivebar env
mkDaemonClient env
mkDaemonMethods [("GetBufferList", callGetBufferList env)
,("Interactive", callGetInteractive env)
,("GetBufferHistory", callGetBufferHistory env)]
frame `on` keyPressEvent $ tryEvent $ do
liftIO $ do
tList <- readTVarIO $ envTooltipSet env
forM_ (Set.toList tList) (\x -> tooltipExit x (envTooltipSet env))
liftIO $ focusTab env
focusStatus <- liftIO $ getFocusStatus env
keystoke <- eventKeystoke
sEvent <- serializedEvent
liftIO $ do
case M.lookup keystoke globalKeymap of
Just action -> runAction env action
Nothing ->
case focusStatus of
FocusInitInteractivebar -> handleInteractivebarKeyPress env keystoke anythingInteractivebar
_ ->
case M.lookup keystoke localKeymap of
Just action -> runAction env action
_ -> case focusStatus of
FocusWindow -> envGet env >>= handlePageViewKeyPress keystoke sEvent
FocusLocalInteractivebar ->
getCurrentInteractivebar env >?>=
handleInteractivebarKeyPress env keystoke
focusTab env
anythingInitStartup frame anythingBox anythingInteractivebar
widgetShowAll frame
frame `onDestroy` do
client <- envGet env
mkDaemonBroadcastSignal client ExitDaemonProcess ExitDaemonProcessArgs
exitAllRenderProcess env
mainQuit
mainGUI
globalKeymap :: Keymap
globalKeymap =
M.fromList
["F2" ==> startProcessManager
,"F3" ==> startFeedReader
,"F4" ==> startFileManager
,"F5" ==> startBrowser
,"F6" ==> loginIrcDefaultChannel
,"F7" ==> startIrc
,"F11" ==> toggleFullscreen
,"F12" ==> lockScreen
,"C-'" ==> tabUndoCloseGlobal
,"C-\"" ==> tabUndoCloseLocal
]
interactiveKeymap :: EditableClass ed => Map Text (ed -> IO ())
interactiveKeymap =
M.fromList
[("Tab", editableExpandCompletion)
,("BackSpace", editableDeleteBackwardChar)
,("M-,", editableDeleteBackwardChar)
,("M-<", editableDeleteBackwardWord)
,("M-d", editableDeleteAllText)
,("M-x", editableCutClipboard)
,("M-c", editableCopyClipboard)
,("M-v", editablePasteClipboard)]
localKeymap :: Keymap
localKeymap =
M.fromList
["M-t" ==> windowSplitVertically
,"M-T" ==> windowSplitHortizontally
,"M-n" ==> windowSelectNext
,"M-p" ==> windowSelectPrev
,"M-;" ==> windowCloseCurrent
,"M-:" ==> windowCloseOthers
,"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
,"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
,"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
,"M-f" ==> focusInteractivebar
,"M-F" ==> focusCurrentTab
,"M-b" ==> focusSwitch
,"M-g" ==> exitInteractivebar
,"M-[" ==> viewBufferDirectory
]
mkDaemonClient :: Environment -> IO ()
mkDaemonClient env = do
let tabbar = envTabbar env
client = envDaemonClient env
mkDaemonMatchRules client
[(NewRenderPageConfirm, daemonHandleNewPageConfirm env)
,(RenderProcessExit, daemonHandleRenderProcessExit)
,(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)
]
daemonHandleRenderProcessExit :: DaemonSignalArgs -> IO ()
daemonHandleRenderProcessExit (RenderProcessExitArgs pageId processId) =
debugDBusMessage $ "daemonHandleRenderProcessExit: child process " ++ show processId ++ " exit. With page id : " ++ show pageId
daemonHandleNewTab :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleNewTab env (NewTabArgs pageType pagePath) =
runAction env (Action (newTab pageType pagePath))
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
daemonHandleAnythingViewOutput :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleAnythingViewOutput env (AnythingViewOutputArgs input completion outputHeight keyPressId) = do
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
editableSetCompletionText (interactivebarEntry bar) input completion
case outputHeight of
Just height -> do
let adjustHeight | height < popupWindowDefaultHeight
= height
| otherwise
= popupWindowDefaultHeight
(Rectangle x y w h) <- widgetGetAllocation (interactivebarEntry bar)
(_, screenHeight) <- widgetGetScreenSize (interactivebarEntry bar)
let adjustY | y + h + popupWindowDefaultHeight > screenHeight
= y adjustHeight
| otherwise
= y + h
popupWindowSetAllocation popupWindow (Rectangle x adjustY w adjustHeight)
popupWindowShow popupWindow
Nothing -> popupWindowHide popupWindow
daemonHandleLocalInteractivebarExit :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleLocalInteractivebarExit env LocalInteractivebarExitArgs = do
focusStatus <- getFocusStatus env
unless (focusStatus == FocusInitInteractivebar) $
exitInteractivebar env
daemonHandleLocalOutputbarUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO ()
daemonHandleLocalOutputbarUpdate tabbar (LocalOutputbarUpdateArgs plugId output) =
tabUpdateOutput tabbar plugId output
daemonHandleLocalStatusbarUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO ()
daemonHandleLocalStatusbarUpdate tabbar (LocalStatusbarUpdateArgs plugId item status) =
tabUpdateStatus tabbar plugId item status
daemonHandleLocalProgressUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO ()
daemonHandleLocalProgressUpdate tabbar (LocalProgressUpdateArgs plugId progress) =
tabUpdateProgress tabbar plugId progress
daemonHandleSynchronizationPathName :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleSynchronizationPathName env (SynchronizationPathNameArgs modeName pageId path) = do
debugDBusMessage $ "daemonHandleSynchronizationPathName: Catch SynchronizationPathName signal. Page id : " ++ show pageId
(bufferListTVar, Tabbar tabbar) <- envGet env
modifyTVarIO bufferListTVar (bufferListReplacePath modeName pageId path)
pageModeDuplicateTabList <- getDuplicateTabList
if modeName `elem` pageModeDuplicateTabList
then modifyTVarIO bufferListTVar (bufferListStripName modeName pageId path)
else modifyTVarIO bufferListTVar (bufferListUniqueName modeName)
forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), _) ->
when (pageModeName == modeName) $ syncTabName env windowId
daemonHandleChangeTabName :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleChangeTabName env (ChangeTabNameArgs modeName pageId path) = do
debugDBusMessage $ "daemonHandleChangeTabName: Catch SynchronizationPathName signal. Page id : " ++ show pageId
(bufferListTVar, Tabbar tabbar) <- envGet env
modifyTVarIO bufferListTVar (bufferListReplaceName modeName pageId path)
forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), _) ->
when (pageModeName == modeName) $ syncTabName env windowId
daemonHandleSwitchBuffer :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleSwitchBuffer env (SwitchBufferArgs modeName pageId) = do
bufferList <- envGet env
bufferListGetBufferIndexWithId bufferList modeName pageId
?>= \ i -> do
tabSwitchGroupCurrentWindow env modeName
window <- envGet env
notebookSetCurrentPage (windowNotebook window) i
daemonHandleLocalInteractiveReturn :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleLocalInteractiveReturn env (LocalInteractiveReturnArgs strList) = do
popupWindow <- envGet env
focusStatus <- getFocusStatus env
unless (focusStatus == FocusInitInteractivebar) $ do
track <- readTVarIO (envLocalInteractiveTrack env)
modifyTVarIO (envLocalInteractiveReturn env) (++ strList)
if length track <= 1
then do
returnList <- readTVarIO (envLocalInteractiveReturn env)
tryPutMVar (envLocalInteractiveLock env) (Right returnList)
exitInteractivebar env
else do
let restTrack = tail track
interactiveName = (fst . head) restTrack
interactiveTitle = (snd . head) restTrack
writeTVarIO (envLocalInteractiveTrack env) restTrack
getCurrentUIFrame env >?>= \uiFrame -> do
let interactivebar = uiFrameInteractivebar uiFrame
interactivebarSetTitle interactivebar interactiveTitle
interactivebarSetContent interactivebar ""
popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1)
processId <- readTVarIO $ envAnythingProcessId env
mkRenderSignal (envDaemonClient env) processId AnythingViewChangeCandidate
(AnythingViewChangeCandidateArgs [interactiveName])
daemonHandleGlobalInteractiveReturn :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleGlobalInteractiveReturn env (GlobalInteractiveReturnArgs strList) = do
popupWindow <- envGet env
focusStatus <- getFocusStatus env
track <- readTVarIO (envGlobalInteractiveTrack env)
modifyTVarIO (envGlobalInteractiveReturn env) (++ strList)
if length track <= 1
then do
returnList <- readTVarIO (envGlobalInteractiveReturn env)
tryPutMVar (envGlobalInteractiveLock env) (Right returnList)
unless (focusStatus == FocusInitInteractivebar) $
exitInteractivebar env
else do
let restTrack = tail track
interactiveName = (fst . head) restTrack
interactiveTitle = (snd . head) restTrack
writeTVarIO (envGlobalInteractiveTrack env) restTrack
case focusStatus of
FocusInitInteractivebar -> do
let interactivebar = envInitInteractivebar env
interactivebarSetTitle interactivebar interactiveTitle
interactivebarSetContent interactivebar ""
_ ->
getCurrentUIFrame env >?>= \uiFrame -> do
let interactivebar = uiFrameInteractivebar uiFrame
interactivebarSetTitle interactivebar interactiveTitle
interactivebarSetContent interactivebar ""
popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1)
processId <- readTVarIO $ envAnythingProcessId env
mkRenderSignal (envDaemonClient env) processId AnythingViewChangeCandidate
(AnythingViewChangeCandidateArgs [interactiveName])
daemonHandleShowTooltip :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleShowTooltip env (ShowTooltipArgs text point int foreground background hideWhenPress pageId) = do
tooltipId <- tickTVarIO (envTooltipCounter env)
let showTooltip p =
tooltipNew tooltipId (envFrame env) text p int foreground background hideWhenPress (envTooltipSet env)
>>= \tooltip -> when hideWhenPress $ modifyTVarIO (envTooltipSet env) (Set.insert tooltip)
focusStatus <- liftIO $ getFocusStatus env
currentTab <-
case focusStatus of
FocusInitInteractivebar -> return Nothing
_ -> getCurrentTab env
case currentTab of
Nothing -> showTooltip point
Just (Tab {tabPageId = tpId
,tabUIFrame = UIFrame {uiFrameFrame = frame}}) -> do
(Rectangle fx fy _ _) <- widgetGetAllocation frame
let tooltipPoint =
case point of
Just (px, py) -> Just (fx + px, fy + py)
Nothing -> Nothing
case pageId of
Nothing -> showTooltip tooltipPoint
Just pId -> when (tpId /= pId) $ showTooltip tooltipPoint
daemonHandleNewPageConfirm :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleNewPageConfirm env
args@(NewRenderPageConfirmArgs
pageId pType sId plugId processId modeName path isFirstPage) = do
(tabbarTVar, (bufferListTVar, (signalBoxList, windowList))) <- envGet env
sbList <- readTVarIO signalBoxList
case (maybeFindMin sbList (\x -> signalBoxId x == sId)) of
Nothing -> putStrLn $ "### Impossible: daemonHandleNewPageConfirm - Can't find signal box Id " ++ show sId
Just signalBox -> do
let windowId = signalBoxWindowId signalBox
debugDBusMessage $ "daemonHandleNewPageConfirm: Catch NewRenderPageConfirm signal. Box id : " ++ show sId
debugDBusMessage "------------------------------"
let uiFrame = signalBoxUIFrame signalBox
notebookTab = uiFrameNotebookTab uiFrame
socketId <- socketFrameAdd uiFrame plugId modeName
notebookTabStop notebookTab
ntCloseButton notebookTab `onToolButtonClicked` do
modifyTVarIO windowList (`windowListFocusId` windowId)
tabClose env pageId
when isFirstPage $ do
modifyTVarIO bufferListTVar (bufferListAddBuffer (modeName, processId, pageId, pType, path))
pageModeDuplicateTabList <- getDuplicateTabList
if modeName `elem` pageModeDuplicateTabList
then modifyTVarIO bufferListTVar (bufferListStripName modeName pageId path)
else modifyTVarIO bufferListTVar (bufferListUniqueName modeName)
bufferList <- readTVarIO bufferListTVar
bufferListGetBuffer bufferList modeName pageId
?>= \ Buffer {bufferPageType = pageType
,bufferPath = path} ->
modifyTVarIO (envBufferHistory env) (insertUnique (BufferHistory modeName pageType path))
modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab processId pageId socketId plugId uiFrame))
syncTabName env windowId
writeTVarIO signalBoxList (Set.delete signalBox sbList)
when isFirstPage $ tabbarSyncNewTab env windowId args
socketFrameAdd :: UIFrame -> PagePlugId -> PageModeName -> IO PageSocketId
socketFrameAdd uiFrame (GWindowId plugId) modeName = do
let socketFrame = uiFrameFrame uiFrame
socket <- socketNew_
socketFrame `containerAdd` socket
socketAddId socket plugId
uiFrameUpdateStatusbar uiFrame "PageMode" ("Mode (" ++ modeName ++ ")")
GWindowId <$> socketGetId socket
callGetBufferHistory :: Environment -> Member
callGetBufferHistory env =
Method "" "s" $ \ call -> do
history <- readTVarIO $ envBufferHistory env
replyReturn call [toVariant history]
callGetBufferList :: Environment -> Member
callGetBufferList env =
Method "" "s" $ \ call -> do
(BufferList bufferList) <- readTVarIO $ envBufferList env
let list = concatMap (\ (modeName, bufferSeq) ->
map (\ Buffer {bufferPageId = pageId
,bufferPath = path
,bufferName = name} ->
BufferInfo modeName path name pageId) $ F.toList bufferSeq)
$ M.toList bufferList
focusStatus <- liftIO $ getFocusStatus env
currentPageId <-
case focusStatus of
FocusInitInteractivebar -> return Nothing
_ -> tabGetCurrentPageId env
let bufferInfos =
case currentPageId of
Just pId -> filter (\ x -> bufferInfoId x /= pId) list
Nothing -> list
replyReturn call [toVariant bufferInfos]
callGetInteractive :: Environment -> Member
callGetInteractive env =
Method "s" "s" $ \ call -> do
(tabbar, popupWindow) <- envGet env
let Just input = fromVariant (head $ methodCallBody call)
(plugId, inputStr) = read input :: (PagePlugId, String)
case parseInteractiveString inputStr of
Left err -> replyLocalInteractiveError call err
Right list -> do
writeTVarIO (envLocalInteractiveTrack env) list
writeTVarIO (envLocalInteractiveReturn env) []
tryTakeMVar (envLocalInteractiveLock env)
postGUIAsync $
tabbarGetTab plugId tabbar
?>= \ Tab {tabUIFrame = uiFrame} -> do
let interactivebar = uiFrameInteractivebar uiFrame
interactiveName = (fst . head) list
title = (snd . head) list
interactivebarSetTitle interactivebar title
interactivebarSetContent interactivebar ""
uiFrameShowInteractivebar uiFrame
whenM (not <$> popupWindowIsVisible popupWindow)
(do
popupWindowActivate popupWindow interactivebar
startupAnything (SpawnAnythingProcessArgs
(InteractiveSearchArgs LocalInteractive [interactiveName])))
result <- takeMVar (envLocalInteractiveLock env)
case result of
Left err -> replyLocalInteractiveError call err
Right res -> replyReturn call [toVariant res]
globalInteractive :: Environment -> String -> ([String] -> IO ()) -> IO ()
globalInteractive env inputStr action =
case parseInteractiveString inputStr of
Left err -> putStrLn $ "globalInteractive : parse interactive string failed : " ++ show err
Right strList -> do
popupWindow <- envGet env
focusStatus <- getFocusStatus env
writeTVarIO (envGlobalInteractiveTrack env) strList
writeTVarIO (envGlobalInteractiveReturn env) []
tryTakeMVar (envGlobalInteractiveLock env)
let interactiveName = (fst . head) strList
interactiveTitle = (snd . head) strList
case focusStatus of
FocusInitInteractivebar -> do
let interactivebar = envInitInteractivebar env
interactivebarSetTitle interactivebar interactiveTitle
interactivebarSetContent interactivebar ""
let client = envDaemonClient env
processId <- readTVarIO $ envAnythingProcessId env
mkRenderSignal client processId AnythingViewChangeInteractiveType
(AnythingViewChangeInteractiveTypeArgs GlobalInteractive)
mkRenderSignal client processId AnythingViewChangeCandidate
(AnythingViewChangeCandidateArgs [interactiveName])
_ ->
getCurrentUIFrame env >?>= \uiFrame -> do
let interactivebar = uiFrameInteractivebar uiFrame
interactivebarSetTitle interactivebar interactiveTitle
interactivebarSetContent interactivebar ""
uiFrameShowInteractivebar uiFrame
whenM (not <$> popupWindowIsVisible popupWindow)
(do
popupWindowActivate popupWindow interactivebar
startupAnything (SpawnAnythingProcessArgs
(InteractiveSearchArgs GlobalInteractive [interactiveName])))
forkGuiIO_ (takeMVar (envGlobalInteractiveLock env))
(\ result ->
case result of
Left err -> putStrLn $ "globalInteractive : " ++ show err
Right list ->
when (length strList == length list) $
bracketOnError
(return list)
(\ _ -> putStrLn "globalInteractive: exception rasied.")
action)
replyLocalInteractiveError :: MethodCall -> Text -> IO ()
replyLocalInteractiveError call err =
replyError call (mkErrorName_ daemonInteractiveErrorName) [toVariant err]
handlePageViewKeyPress :: Text -> SerializedEvent -> (Environment, Client) -> IO ()
handlePageViewKeyPress keystoke sEvent (env, client) =
getCurrentTab env >?>= \ Tab {tabProcessId = processId
,tabPlugId = plugId} ->
mkRenderSignal client processId PageViewKeyPress (PageViewKeyPressArgs plugId keystoke sEvent)
handleInteractivebarKeyPress :: Environment -> Text -> Interactivebar -> IO ()
handleInteractivebarKeyPress env keystoke bar = do
let client = envDaemonClient env
entry = interactivebarEntry bar
editableFocus entry
isChanged <-
editableIsChanged entry $
case M.lookup keystoke interactiveKeymap of
Just action -> action entry
_ ->
when (T.length keystoke == 1) $ do
unselectText <- editableGetUnselectText entry
editableSetText entry (unselectText ++ T.unpack keystoke)
allText <- editableGetAllText entry
unselectText <- editableGetUnselectText entry
processId <- readTVarIO $ envAnythingProcessId env
keyPressId <- tickTVarIO $ envAnythingKeyPressId env
mkRenderSignal client processId AnythingViewKeyPress
(AnythingViewKeyPressArgs keystoke allText unselectText keyPressId isChanged)
viewBufferDirectory :: Environment -> IO ()
viewBufferDirectory env = do
(bufferList, (tabbar, window)) <- envGet env
getCurrentTab env
>?>= \ tab ->
tabbarGetPageModeName tabbar (windowGetId window)
?>= \modeName ->
bufferListGetBuffer bufferList modeName (tabPageId tab)
?>= \buffer -> do
let path = getUpperDirectory $ bufferPath buffer
if not (null path) && directoryDoesExist (UTF8.fromString path)
then newTab "PageFileManager" path env
else do
currentDir <- getCurrentDirectory
newTab "PageFileManager" currentDir env
lockScreen :: Environment -> IO ()
lockScreen _ = do
(runCommand_ "xset dpms force off && sleep 1")
(runCommand_ "xtrlock")
startProcessManager :: Environment -> IO ()
startProcessManager =
newTab "PageProcessManager" "ProcessManager"
startFeedReader :: Environment -> IO ()
startFeedReader =
newTab "PageReader" "Feed Reader"
startFileManager :: Environment -> IO ()
startFileManager env = do
dir <- getCurrentDirectory
newTab "PageFileManager" dir env
startBrowser :: Environment -> IO ()
startBrowser =
newTab "PageBrowser" "http://www.google.com"
loginIrcDefaultChannel :: Environment -> IO ()
loginIrcDefaultChannel =
newTab "PageIrc" "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)