{-# LANGUAGE ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-}
module TaskMonad.ScratchPad
(
taskwarriorScratchpad
, taskwarriorScratchpads
, hideScratchpadAction
, twscratchpad
, runTmuxCommand
)
where
import Data.List
import Data.Maybe
import System.Process
import System.IO
import Control.Monad ( filterM )
import XMonad hiding ( liftX )
import XMonad.Util.Font
import qualified XMonad.StackSet as W
import XMonad.Layout.Decoration
import XMonad.Prompt
import XMonad.Prompt.Input
import XMonad.Util.Image
import XMonad.Util.NamedWindows
import XMonad.Util.XUtils
import XMonad.Util.NamedScratchpad
import XMonad.Util.Run
import XMonad.Actions.GridSelect
import qualified GridSelect.Extras
taskwarriorScratchpad :: X ()
taskwarriorScratchpad =
namedScratchpadAction taskwarriorScratchpads "taskwarrior"
taskwarriorScratchpads :: [NamedScratchpad]
taskwarriorScratchpads =
[NS "taskwarrior" spawnTaskwarrior findTerm manageTerm]
where
spawnTaskwarrior =
"xterm" ++ " -name scratchpad" ++ " -e tmux new -A -s tw-scratch"
findTerm = appName =? "scratchpad"
manageTerm = customFloating $ W.RationalRect 0.25 0 0.5 0.6
findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad
findByName c s = listToMaybe $ filter ((s ==) . name) c
runApplication :: NamedScratchpad -> X ()
runApplication = spawn . cmd
hideScratchpadAction
:: NamedScratchpads
-> String
-> X ()
hideScratchpadAction confs n
| Just conf <- findByName confs n = withWindowSet $ \s -> do
filterCurrent <- filterM
(runQuery (query conf))
((maybe [] W.integrate . W.stack . W.workspace . W.current) s)
case filterCurrent of
[] -> do
filterAll <- filterM (runQuery (query conf)) (W.allWindows s)
case filterAll of
(x : _) -> windows $ W.shiftWin (W.currentTag s) x
[] -> runApplication conf
| otherwise = return ()
twscratchpad :: String -> X ()
twscratchpad command =
runTmuxCommand ("clear && task " ++ command)
>> hideScratchpadAction taskwarriorScratchpads "taskwarrior"
runTmuxCommand :: MonadIO m => String -> m ()
runTmuxCommand command =
unsafeSpawn $ "tmux send-keys -t tw-scratch.0 '" ++ command ++ "' ENTER"