aboutsummaryrefslogtreecommitdiffstats
path: root/DynamicWorkspaces.hs
blob: 6aad4c5797aa14f53a58341a670483cb1f3ae353 (plain) (blame)
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
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonadContrib.DynamicWorkspaces
-- Copyright   :  (c) David Roundy <droundy@darcs.net>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  David Roundy <droundy@darcs.net>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides bindings to add and delete workspaces.  Note that you may only
-- delete a workspace that is already empty.
--
-----------------------------------------------------------------------------

module XMonadContrib.DynamicWorkspaces (
                                         -- * Usage
                                         -- $usage
                                         addWorkspace, removeWorkspace,
                                         selectWorkspace, renameWorkspace,
                                         toNthWorkspace, withNthWorkspace
                                       ) where

import Control.Monad.State ( gets )
import Data.List ( sort )

import XMonad ( X, XState(..), Layout, WorkspaceId, WindowSet )
import Operations
import StackSet hiding (filter, modify, delete)
import Graphics.X11.Xlib ( Window )
import XMonadContrib.WorkspacePrompt
import XMonadContrib.XPrompt ( XPConfig )

-- $usage
-- You can use this module with the following in your Config.hs file:
-- 
-- > import XMonadContrib.DynamicWorkspaces
--
-- >   , ((modMask .|. shiftMask, xK_n), selectWorkspace defaultXPConfig layoutHook)
-- >   , ((modMask .|. shiftMask, xK_BackSpace), removeWorkspace)
-- >   , ((modMask .|. shiftMask .|. controlMask, xK_r), renameWorkspace defaultXPConfig)
-- 
-- > -- mod-[1..9] %! Switch to workspace N
-- > -- mod-shift-[1..9] %! Move client to workspace N
-- >    ++
-- >    zip (zip (repeat modMask) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
-- >    ++
-- >    zip (zip (repeat (modMask .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])

allPossibleTags :: [WorkspaceId]
allPossibleTags = map (:"") ['0'..]

renameWorkspace :: XPConfig -> X ()
renameWorkspace conf = workspacePrompt conf $ \w ->
                       windows $ \s -> let sett wk = wk { tag = w }
                                           setscr scr = scr { workspace = sett $ workspace scr }
                                           sets q = q { current = setscr $ current q }
                                       in sets $ removeWorkspace' w s

toNthWorkspace :: (String -> X ()) -> Int -> X ()
toNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset)
                             case drop wnum ws of
                               (w:_) -> job w
                               [] -> return ()

withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset)
                               case drop wnum ws of
                                 (w:_) -> windows $ job w
                                 [] -> return ()

selectWorkspace :: XPConfig -> Layout Window -> X ()
selectWorkspace conf l = workspacePrompt conf $ \w ->
                         windows $ \s -> if tagMember w s
                                         then greedyView w s
                                         else addWorkspace' w l s

addWorkspace :: Layout Window -> X ()
addWorkspace l = do s <- gets windowset
                    let newtag:_ = filter (not . (`tagMember` s)) allPossibleTags
                    windows (addWorkspace' newtag l)

removeWorkspace :: X ()
removeWorkspace = do s <- gets windowset
                     case s of
                       StackSet { current = Screen { workspace = torem }
                                , hidden = (w:_) }
                           -> do windows $ view (tag w)
                                 windows (removeWorkspace' (tag torem))
                       _ -> return ()

addWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
addWorkspace' newtag l s@(StackSet { current = scr@(Screen { workspace = w })
                                   , hidden = ws })
    = s { current = scr { workspace = Workspace newtag l Nothing }
        , hidden = w:ws }

removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
                                   , hidden = (w:ws) })
    | tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } }
                         , hidden = ws }
   where meld Nothing Nothing = Nothing
         meld x Nothing = x
         meld Nothing x = x
         meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)
removeWorkspace' _ s = s