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
|
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.BoringWindows
-- Copyright : (c) 2008 David Roundy <droundy@darcs.net>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : none
-- Stability : unstable
-- Portability : unportable
--
-- BoringWindows is an extension to allow windows to be marked boring
--
-----------------------------------------------------------------------------
module XMonad.Layout.BoringWindows (
-- * Usage
-- $usage
boringWindows,
markBoring, clearBoring,
focusUp, focusDown
) where
import XMonad hiding (Point)
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier
import XMonad.Util.Invisible
data BoringMessage = FocusUp | FocusDown | IsBoring Window | ClearBoring
deriving ( Read, Show, Typeable )
instance Message BoringMessage
markBoring, clearBoring, focusUp, focusDown :: X ()
markBoring = withFocused (sendMessage . IsBoring)
clearBoring = sendMessage ClearBoring
focusUp = sendMessage FocusUp
focusDown = sendMessage FocusDown
data BoringWindows a = BoringWindows (Invisible [] a) deriving ( Show, Read, Typeable )
boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
boringWindows = ModifiedLayout (BoringWindows (I []))
instance LayoutModifier BoringWindows Window where
handleMessOrMaybeModifyIt (BoringWindows (I bs)) m
| Just (IsBoring b) <- fromMessage m = return $ Just $ Left $ BoringWindows (I (b:bs))
| Just ClearBoring <- fromMessage m = return $ Just $ Left $ BoringWindows (I [])
| Just FocusUp <- fromMessage m = do windows $ W.modify' $ focusUp'
return Nothing
| Just FocusDown <- fromMessage m =
do windows $ W.modify' (reverseStack . focusUp' . reverseStack)
return Nothing
where focusUp' (W.Stack t ls rs)
| (a,l:ls') <- skipBoring ls = W.Stack l ls' (a++t:rs)
| otherwise = case skipBoring (reverse (t:rs)++ls) of
(a,x:xs) -> W.Stack x xs a
_ -> W.Stack t ls rs
skipBoring [] = ([],[])
skipBoring (x:xs) | x `elem` bs = case skipBoring xs of
(a,b) -> (x:a,b)
| otherwise = ([],x:xs)
handleMessOrMaybeModifyIt _ _ = return Nothing
-- | reverse a stack: up becomes down and down becomes up.
reverseStack :: W.Stack a -> W.Stack a
reverseStack (W.Stack t ls rs) = W.Stack t rs ls
|
