module XMonad.Actions.WorkspaceNames (
renameWorkspace,
getWorkspaceNames',
getWorkspaceNames,
getWorkspaceName,
getCurrentWorkspaceName,
setWorkspaceName,
setCurrentWorkspaceName,
swapTo,
swapTo',
swapWithCurrent,
workspaceNamePrompt,
workspaceNamesPP,
workspaceNamesEwmh,
) where
import XMonad
import XMonad.Prelude (fromMaybe, isInfixOf, (<&>), (>=>))
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), anyWS)
import qualified XMonad.Actions.SwapWorkspaces as Swap
import XMonad.Hooks.StatusBar.PP (PP(..))
import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename)
import XMonad.Prompt (mkXPrompt, XPConfig, historyCompletionP)
import XMonad.Prompt.Workspace (Wor(Wor))
import XMonad.Util.WorkspaceCompare (getSortByIndex)
import qualified Data.Map as M
newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
deriving (ReadPrec [WorkspaceNames]
ReadPrec WorkspaceNames
Int -> ReadS WorkspaceNames
ReadS [WorkspaceNames]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceNames]
$creadListPrec :: ReadPrec [WorkspaceNames]
readPrec :: ReadPrec WorkspaceNames
$creadPrec :: ReadPrec WorkspaceNames
readList :: ReadS [WorkspaceNames]
$creadList :: ReadS [WorkspaceNames]
readsPrec :: Int -> ReadS WorkspaceNames
$creadsPrec :: Int -> ReadS WorkspaceNames
Read, Int -> WorkspaceNames -> ShowS
[WorkspaceNames] -> ShowS
WorkspaceNames -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceNames] -> ShowS
$cshowList :: [WorkspaceNames] -> ShowS
show :: WorkspaceNames -> WorkspaceId
$cshow :: WorkspaceNames -> WorkspaceId
showsPrec :: Int -> WorkspaceNames -> ShowS
$cshowsPrec :: Int -> WorkspaceNames -> ShowS
Show)
instance ExtensionClass WorkspaceNames where
initialValue :: WorkspaceNames
initialValue = Map WorkspaceId WorkspaceId -> WorkspaceNames
WorkspaceNames forall k a. Map k a
M.empty
extensionType :: WorkspaceNames -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
getWorkspaceNames' :: X (WorkspaceId -> Maybe String)
getWorkspaceNames' :: X (WorkspaceId -> Maybe WorkspaceId)
getWorkspaceNames' = do
WorkspaceNames Map WorkspaceId WorkspaceId
m <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map WorkspaceId WorkspaceId
m)
getWorkspaceNames :: String -> X (String -> WindowSpace -> String)
getWorkspaceNames :: WorkspaceId -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
getWorkspaceNames WorkspaceId
sep = forall {t} {l} {a}.
(t -> Maybe WorkspaceId)
-> WorkspaceId -> Workspace t l a -> WorkspaceId
ren forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (WorkspaceId -> Maybe WorkspaceId)
getWorkspaceNames'
where
ren :: (t -> Maybe WorkspaceId)
-> WorkspaceId -> Workspace t l a -> WorkspaceId
ren t -> Maybe WorkspaceId
name WorkspaceId
s Workspace t l a
w = WorkspaceId
s forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe WorkspaceId
"" (WorkspaceId
sep forall a. [a] -> [a] -> [a]
++) (t -> Maybe WorkspaceId
name (forall i l a. Workspace i l a -> i
W.tag Workspace t l a
w))
getWorkspaceName :: WorkspaceId -> X (Maybe String)
getWorkspaceName :: WorkspaceId -> X (Maybe WorkspaceId)
getWorkspaceName WorkspaceId
w = (forall a b. (a -> b) -> a -> b
$ WorkspaceId
w) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (WorkspaceId -> Maybe WorkspaceId)
getWorkspaceNames'
getCurrentWorkspaceName :: X (Maybe String)
getCurrentWorkspaceName :: X (Maybe WorkspaceId)
getCurrentWorkspaceName = WorkspaceId -> X (Maybe WorkspaceId)
getWorkspaceName forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
setWorkspaceName :: WorkspaceId -> String -> X ()
setWorkspaceName :: WorkspaceId -> WorkspaceId -> X ()
setWorkspaceName WorkspaceId
w WorkspaceId
name = do
WorkspaceNames Map WorkspaceId WorkspaceId
m <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall a b. (a -> b) -> a -> b
$ Map WorkspaceId WorkspaceId -> WorkspaceNames
WorkspaceNames forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null WorkspaceId
name then forall k a. Ord k => k -> Map k a -> Map k a
M.delete WorkspaceId
w Map WorkspaceId WorkspaceId
m else forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
w WorkspaceId
name Map WorkspaceId WorkspaceId
m
X ()
refresh
setCurrentWorkspaceName :: String -> X ()
setCurrentWorkspaceName :: WorkspaceId -> X ()
setCurrentWorkspaceName WorkspaceId
name = do
WorkspaceId
current <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
WorkspaceId -> WorkspaceId -> X ()
setWorkspaceName WorkspaceId
current WorkspaceId
name
renameWorkspace :: XPConfig -> X ()
renameWorkspace :: XPConfig -> X ()
renameWorkspace XPConfig
conf = do
ComplFunction
completion <- XPConfig -> (WorkspaceId -> Bool) -> X ComplFunction
historyCompletionP XPConfig
conf (WorkspaceId
prompt forall a. Eq a => a -> a -> Bool
==)
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> Wor
Wor WorkspaceId
prompt) XPConfig
conf ComplFunction
completion WorkspaceId -> X ()
setCurrentWorkspaceName
where
prompt :: WorkspaceId
prompt = WorkspaceId
"Workspace name: "
swapTo :: Direction1D -> X ()
swapTo :: Direction1D -> X ()
swapTo Direction1D
dir = Direction1D -> WSType -> X ()
swapTo' Direction1D
dir WSType
anyWS
swapTo' :: Direction1D -> WSType -> X ()
swapTo' :: Direction1D -> WSType -> X ()
swapTo' Direction1D
dir WSType
which = X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceId
findWorkspace X WorkspaceSort
getSortByIndex Direction1D
dir WSType
which Int
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
swapWithCurrent
swapWithCurrent :: WorkspaceId -> X ()
swapWithCurrent :: WorkspaceId -> X ()
swapWithCurrent WorkspaceId
t = do
WorkspaceId
current <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
WorkspaceId -> WorkspaceId -> X ()
swapNames WorkspaceId
t WorkspaceId
current
(WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall i l a s sd.
Eq i =>
i -> i -> StackSet i l a s sd -> StackSet i l a s sd
Swap.swapWorkspaces WorkspaceId
t WorkspaceId
current
swapNames :: WorkspaceId -> WorkspaceId -> X ()
swapNames :: WorkspaceId -> WorkspaceId -> X ()
swapNames WorkspaceId
w1 WorkspaceId
w2 = do
WorkspaceNames Map WorkspaceId WorkspaceId
m <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
let getname :: ShowS
getname WorkspaceId
w = forall a. a -> Maybe a -> a
fromMaybe WorkspaceId
"" forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
w Map WorkspaceId WorkspaceId
m
set :: k -> t a -> Map k (t a) -> Map k (t a)
set k
w t a
name Map k (t a)
m' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
name then forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
w Map k (t a)
m' else forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
w t a
name Map k (t a)
m'
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall a b. (a -> b) -> a -> b
$ Map WorkspaceId WorkspaceId -> WorkspaceNames
WorkspaceNames forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {k} {a}.
(Foldable t, Ord k) =>
k -> t a -> Map k (t a) -> Map k (t a)
set WorkspaceId
w1 (ShowS
getname WorkspaceId
w2) forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {k} {a}.
(Foldable t, Ord k) =>
k -> t a -> Map k (t a) -> Map k (t a)
set WorkspaceId
w2 (ShowS
getname WorkspaceId
w1) Map WorkspaceId WorkspaceId
m
workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X ()
workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X ()
workspaceNamePrompt XPConfig
conf WorkspaceId -> X ()
job = do
[WindowSpace]
myWorkspaces <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
[WorkspaceId]
myWorkspacesName <- WorkspaceId -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
getWorkspaceNames WorkspaceId
":" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \WorkspaceId -> WindowSpace -> WorkspaceId
n -> [WorkspaceId -> WindowSpace -> WorkspaceId
n (forall i l a. Workspace i l a -> i
W.tag WindowSpace
w) WindowSpace
w | WindowSpace
w <- [WindowSpace]
myWorkspaces]
let pairs :: [(WorkspaceId, WorkspaceId)]
pairs = forall a b. [a] -> [b] -> [(a, b)]
zip [WorkspaceId]
myWorkspacesName (forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
W.tag [WindowSpace]
myWorkspaces)
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> Wor
Wor WorkspaceId
"Select workspace: ") XPConfig
conf
(forall {m :: * -> *} {a}.
(Monad m, Eq a) =>
[[a]] -> [a] -> m [[a]]
contains [WorkspaceId]
myWorkspacesName)
(WorkspaceId -> X ()
job forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Eq a => [(a, WorkspaceId)] -> a -> WorkspaceId
toWsId [(WorkspaceId, WorkspaceId)]
pairs)
where toWsId :: [(a, WorkspaceId)] -> a -> WorkspaceId
toWsId [(a, WorkspaceId)]
pairs a
name = forall a. a -> Maybe a -> a
fromMaybe WorkspaceId
"" (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
name [(a, WorkspaceId)]
pairs)
contains :: [[a]] -> [a] -> m [[a]]
contains [[a]]
completions [a]
input =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
input) [[a]]
completions
workspaceNamesPP :: PP -> X PP
workspaceNamesPP :: PP -> X PP
workspaceNamesPP PP
pp = WorkspaceId -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
getWorkspaceNames WorkspaceId
":" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \WorkspaceId -> WindowSpace -> WorkspaceId
ren -> PP
pp{ ppRename :: WorkspaceId -> WindowSpace -> WorkspaceId
ppRename = PP -> WorkspaceId -> WindowSpace -> WorkspaceId
ppRename PP
pp forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> WorkspaceId -> WindowSpace -> WorkspaceId
ren }
workspaceNamesEwmh :: XConfig l -> XConfig l
workspaceNamesEwmh :: forall (l :: * -> *). XConfig l -> XConfig l
workspaceNamesEwmh = forall (l :: * -> *).
X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> XConfig l -> XConfig l
addEwmhWorkspaceRename forall a b. (a -> b) -> a -> b
$ WorkspaceId -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
getWorkspaceNames WorkspaceId
":"