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
|
module Rahm.Desktop.StackSet (
masterWindow,
findWorkspace,
ensureWorkspace,
swapWorkspaces,
greedyView,
shiftWin,
screenRotateBackward,
screenRotateForward,
module W) where
import Prelude hiding (head)
import Data.List.Safe (head)
import Data.List (find)
import XMonad.StackSet as W hiding (greedyView, shiftWin)
import qualified XMonad.StackSet
import Data.Default
import Data.Maybe (fromMaybe)
masterWindow :: StackSet i l a s sd -> Maybe a
masterWindow = head . integrate' . stack . workspace . current
findWorkspace :: (Eq i) =>
i -> StackSet i l a s sd -> Maybe (Workspace i l a)
findWorkspace wid = find ((==wid) . tag) . workspaces
ensureWorkspace :: (Eq i) =>
i -> StackSet i l a s sd -> (StackSet i l a s sd, Workspace i l a)
ensureWorkspace t ss =
case findWorkspace t ss of
Nothing ->
let ws = Workspace t (layout . workspace . current $ ss) Nothing in
(ss { hidden = ws : hidden ss }, ws)
Just ws -> (ss, ws)
swapWorkspaces ::
(Eq i) =>
i -> i -> StackSet i l a s sd -> StackSet i l a s sd
swapWorkspaces wid1 wid2 ss =
let (ss', workspace1) = ensureWorkspace wid1 ss
(ss'', workspace2) = ensureWorkspace wid2 ss'
in
mapWorkspace (\w ->
case () of
_ | tag w == wid1 -> workspace2
_ | tag w == wid2 -> workspace1
_ -> w) ss''
greedyView :: (Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView wid ss = swapWorkspaces (tag . workspace . current $ ss) wid ss
shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftWin wid a = XMonad.StackSet.shiftWin wid a . fst . ensureWorkspace wid
screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
screenRotateBackward (W.StackSet current visible others floating) = do
let screens = current : visible
workspaces = tail $ cycle $ map W.workspace screens
(current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
in W.StackSet current' visible' others floating
screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
screenRotateForward (W.StackSet current visible others floating) = do
let screens = current : visible
workspaces = rcycle $ map W.workspace screens
(current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
in W.StackSet current' visible' others floating
where rcycle l = last l : l
|
