1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
-----------------------------------------------------------------------------
-- |
-- 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 (mkXPrompt, XPConfig)
import XMonad.Prompt.Workspace (Wor(Wor))
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 def)
--
-- 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
-- | 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
|
