xmonad-masser/src/XMonad/TopicSpace.hs

58 lines
2.2 KiB
Haskell
Raw Normal View History

2019-03-19 10:10:18 +02:00
{-# Language RecordWildCards #-}
module XMonad.TopicSpace (topicKeys', addTopic, TopicAction(..)) where
import XMonad.Actions.TopicSpace
import XMonad
import qualified Data.Map as M
import XMonad.Actions.DynamicWorkspaces
import XMonad.TopicUtils
import XMonad.Util.EZConfig (mkNamedKeymap)
import XMonad.Util.NamedActions
import XMonad.Config.MasseR.ExtraConfig
import qualified Data.Text as T
import XMonad.Configurable
data TopicAction = TopicAction { name :: String
, action :: X ()
, home :: Maybe FilePath }
addTopic :: TopicAction -> Configurable TopicConfig
addTopic TopicAction{..} = EndoM $ \super -> let
newDirs = topicDirs super <> maybe mempty (M.singleton name) home
newActions = topicActions super <> M.singleton name action
in pure super { topicDirs = newDirs
, topicActions = newActions }
myTopicConfig :: ExtraConfig -> TopicConfig
myTopicConfig extraConfig =
let dirs = M.fromList [ (T.unpack n, T.unpack d) | TopicRule n (Just d) _ <- topics extraConfig ]
actions = M.fromList [ (T.unpack n, spawn (T.unpack a)) | TopicRule n _ (Just a) <- topics extraConfig ]
in def {
topicDirs = dirs
, defaultTopicAction = const (realTopicDir dirs >>= spawnShellIn)
, defaultTopic = "irc"
, topicActions = actions
}
topicKeys' :: ExtraConfig -> XConfig l -> [(String, NamedAction)]
topicKeys' extraConfig conf = [ ("M-y", addName "Change topic" $ visualSelect (myTopicConfig extraConfig))
, ("M-S-g", addName "Move window to topic" $ gridselectMove def)
, ("M-<Return>", addName "Open project action" $ currentTopicAction' (myTopicConfig extraConfig))
, ("M-w", modificationSubmaps' conf)]
spawnShellIn :: Dir -> X ()
spawnShellIn dir = safeRunInTerm dir Nothing
modificationSubmaps' :: XConfig l -> NamedAction
modificationSubmaps' conf =
submapName $ mkNamedKeymap conf [ ("a", addName "Add a new workspace" $ addWorkspacePrompt def)
, ("w", addName "Copy project" copyTopic)
, ("d", addName "Remove empty workspace" removeEmptyWorkspace)]