58 lines
2.2 KiB
Haskell
58 lines
2.2 KiB
Haskell
|
{-# 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)]
|
||
|
|
|