module XMonad.Actions.WorkspaceNames (
renameWorkspace,
workspaceNamesPP,
getWorkspaceNames,
setWorkspaceName,
setCurrentWorkspaceName,
swapTo,
swapTo',
swapWithCurrent,
) where
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..))
import qualified XMonad.Actions.SwapWorkspaces as Swap
import XMonad.Hooks.DynamicLog (PP(..))
import XMonad.Prompt (mkXPrompt, XPConfig)
import XMonad.Prompt.Workspace (Wor(Wor))
import XMonad.Util.WorkspaceCompare (getSortByIndex)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
deriving (Typeable, Read, Show)
instance ExtensionClass WorkspaceNames where
initialValue = WorkspaceNames M.empty
extensionType = PersistentExtension
getWorkspaceNames :: X (WorkspaceId -> String)
getWorkspaceNames = do
WorkspaceNames m <- XS.get
return $ \wks -> case M.lookup wks m of
Nothing -> wks
Just s -> wks ++ ":" ++ s
setWorkspaceName :: WorkspaceId -> String -> X ()
setWorkspaceName w name = do
WorkspaceNames m <- XS.get
XS.put $ WorkspaceNames $ if null name then M.delete w m else M.insert w name m
refresh
setCurrentWorkspaceName :: String -> X ()
setCurrentWorkspaceName name = do
current <- gets (W.currentTag . windowset)
setWorkspaceName current name
renameWorkspace :: XPConfig -> X ()
renameWorkspace conf = do
mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
where pr = Wor "Workspace name: "
workspaceNamesPP :: PP -> X PP
workspaceNamesPP pp = do
names <- getWorkspaceNames
return $
pp {
ppCurrent = ppCurrent pp . names,
ppVisible = ppVisible pp . names,
ppHidden = ppHidden pp . names,
ppHiddenNoWindows = ppHiddenNoWindows pp . names,
ppUrgent = ppUrgent pp . names
}
swapTo :: Direction1D -> X ()
swapTo dir = swapTo' dir AnyWS
swapTo' :: Direction1D -> WSType -> X ()
swapTo' dir which = findWorkspace getSortByIndex dir which 1 >>= swapWithCurrent
swapWithCurrent :: WorkspaceId -> X ()
swapWithCurrent t = do
current <- gets (W.currentTag . windowset)
swapNames t current
windows $ Swap.swapWorkspaces t current
swapNames :: WorkspaceId -> WorkspaceId -> X ()
swapNames w1 w2 = do
WorkspaceNames m <- XS.get
let getname w = fromMaybe "" $ M.lookup w m
set w name m' = if null name then M.delete w m' else M.insert w name m'
XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m