mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-31 20:21:51 -07:00
new contrib module from Tomas Janousek, X.A.WorkspaceNames
This commit is contained in:
155
XMonad/Actions/WorkspaceNames.hs
Normal file
155
XMonad/Actions/WorkspaceNames.hs
Normal file
@@ -0,0 +1,155 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.WorkspaceNames
|
||||
-- Copyright : (c) Tomas Janousek <tomi@nomi.cz>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Tomas Janousek <tomi@nomi.cz>
|
||||
-- Stability : experimental
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Provides bindings to rename workspaces, show these names in DynamicLog and
|
||||
-- swap workspaces along with their names. These names survive restart.
|
||||
-- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully
|
||||
-- dynamic topic space workflow.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
||||
module XMonad.Actions.WorkspaceNames (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
|
||||
-- * Workspace naming
|
||||
renameWorkspace,
|
||||
workspaceNamesPP,
|
||||
getWorkspaceNames,
|
||||
setWorkspaceName,
|
||||
setCurrentWorkspaceName,
|
||||
|
||||
-- * Workspace swapping
|
||||
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 (showXPrompt, mkXPrompt, XPrompt, XPConfig)
|
||||
import XMonad.Util.WorkspaceCompare (getSortByIndex)
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
||||
--
|
||||
-- > import XMonad.Actions.WorkspaceNames
|
||||
--
|
||||
-- Then add keybindings like the following:
|
||||
--
|
||||
-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig)
|
||||
--
|
||||
-- and apply workspaceNamesPP to your DynamicLog pretty-printer:
|
||||
--
|
||||
-- > myLogHook =
|
||||
-- > workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog
|
||||
--
|
||||
-- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s
|
||||
-- functionality, which may be used this way:
|
||||
--
|
||||
-- > , ((modMask .|. shiftMask, xK_Left ), swapTo Prev)
|
||||
-- > , ((modMask .|. shiftMask, xK_Right ), swapTo Next)
|
||||
--
|
||||
-- > [((modm .|. controlMask, k), swapWithCurrent i)
|
||||
-- > | (i, k) <- zip workspaces [xK_1 ..]]
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
|
||||
|
||||
-- | Workspace names container.
|
||||
newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
|
||||
deriving (Typeable, Read, Show)
|
||||
|
||||
instance ExtensionClass WorkspaceNames where
|
||||
initialValue = WorkspaceNames M.empty
|
||||
extensionType = PersistentExtension
|
||||
|
||||
-- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for
|
||||
-- workspaces with a name, and to @\"t\"@ otherwise.
|
||||
getWorkspaceNames :: X (WorkspaceId -> String)
|
||||
getWorkspaceNames = do
|
||||
WorkspaceNames m <- XS.get
|
||||
return $ \wks -> case M.lookup wks m of
|
||||
Nothing -> wks
|
||||
Just s -> wks ++ ":" ++ s
|
||||
|
||||
-- | Sets the name of a workspace. Empty string makes the workspace unnamed
|
||||
-- again.
|
||||
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
|
||||
|
||||
-- | Sets the name of the current workspace. See 'setWorkspaceName'.
|
||||
setCurrentWorkspaceName :: String -> X ()
|
||||
setCurrentWorkspaceName name = do
|
||||
current <- gets (W.currentTag . windowset)
|
||||
setWorkspaceName current name
|
||||
|
||||
data Wor = Wor String
|
||||
instance XPrompt Wor where
|
||||
showXPrompt (Wor x) = x
|
||||
|
||||
-- | Prompt for a new name for the current workspace and set it.
|
||||
renameWorkspace :: XPConfig -> X ()
|
||||
renameWorkspace conf = do
|
||||
mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
|
||||
where pr = Wor "Workspace name: "
|
||||
|
||||
-- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show
|
||||
-- workspace names as well.
|
||||
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
|
||||
}
|
||||
|
||||
-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
|
||||
swapTo :: Direction1D -> X ()
|
||||
swapTo dir = swapTo' dir AnyWS
|
||||
|
||||
-- | Swap with the previous or next workspace of the given type.
|
||||
swapTo' :: Direction1D -> WSType -> X ()
|
||||
swapTo' dir which = findWorkspace getSortByIndex dir which 1 >>= swapWithCurrent
|
||||
|
||||
-- | See 'XMonad.Actions.SwapWorkspaces.swapWithCurrent'. This is almost the
|
||||
-- same with names.
|
||||
swapWithCurrent :: WorkspaceId -> X ()
|
||||
swapWithCurrent t = do
|
||||
current <- gets (W.currentTag . windowset)
|
||||
swapNames t current
|
||||
windows $ Swap.swapWorkspaces t current
|
||||
|
||||
-- | Swap names of the two workspaces.
|
||||
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
|
Reference in New Issue
Block a user