diff options
Diffstat (limited to '')
| -rw-r--r-- | XMonad/Actions/WorkspaceNames.hs | 155 |
1 files changed, 155 insertions, 0 deletions
diff --git a/XMonad/Actions/WorkspaceNames.hs b/XMonad/Actions/WorkspaceNames.hs new file mode 100644 index 0000000..c2dadd5 --- /dev/null +++ b/XMonad/Actions/WorkspaceNames.hs @@ -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 |