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
|
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.MessageControl
-- Copyright : (c) 2008 Quentin Moser
-- License : BSD3
--
-- Maintainer : <quentin.moser@unifr.ch>
-- Stability : unstable
-- Portability : unportable
--
-- Provides message \"escaping\" and filtering facilities which
-- help control complex nested layouts.
-----------------------------------------------------------------------------
module XMonad.Layout.MessageControl (
-- * Usage
-- $usage
Ignore()
, ignore
, UnEscape()
, unEscape
, EscapedMessage(Escape)
, escape
) where
import XMonad.Core (Message, SomeMessage(..)
, fromMessage, LayoutClass(..))
import XMonad.StackSet (Workspace(..))
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
import Data.Typeable (Typeable)
import Control.Applicative ((<$>))
import Control.Arrow (second)
-- $usage
-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Layout.MessageEscape
--
-- Then, if you use a modified layout where the modifier would intercept
-- a message, but you'd want to be able to send it to the inner layout
-- only, add the 'unEscape' modifier to the inner layout like so:
--
-- > import XMonad.Layout.Master (mastered)
-- > import XMonad.Layout.Tabbed (simpleTabbed)
-- > import XMonad.Layout.LayoutCombinators ((|||))
-- >
-- > myLayout = Tall ||| unEscape (mastered 0.01 0.5 $ Full ||| simpleTabbed)
--
-- you can now send a message to the inner layout with
-- @sendMessage $ escape message@, e.g.
--
-- > -- Change the inner layout
-- > ((modm .|. controlMask, xK_space), sendMessage $ escape NextLayout)
--
-- If you want unescaped messages to be handled /only/ by the enclosing
-- layout, use the 'ignore' modifier:
--
-- > myLayout = Tall ||| (ignore NextLayout $ ignore (JumpToLayout "") $
-- > unEscape $ mastered 0.01 0.5
-- > $ Full ||| simpleTabbed)
--
-- /IMPORTANT NOTE:/ The standard '(|||)' operator from "XMonad.Layout"
-- does not behave correctly with 'ignore'. Make sure you use the one
-- from "XMonad.Layout.LayoutCombinators".
-- | the Ignore layout modifier. Prevents its inner layout from receiving
-- messages of a certain type.
data Ignore m l w = I (l w)
deriving (Show, Read)
instance (Message m, LayoutClass l w) => LayoutClass (Ignore m l) w where
runLayout ws r = second (I <$>) <$> runLayout (unILayout ws) r
where unILayout :: Workspace i (Ignore m l w) w -> Workspace i (l w) w
unILayout w@(Workspace { layout = (I l) }) = w { layout = l }
handleMessage l@(I l') sm
= case fromMessageAs sm l of
Just _ -> return Nothing
Nothing -> (I <$>) <$> handleMessage l' sm
where fromMessageAs :: Message m' => SomeMessage -> Ignore m' l w -> Maybe m'
fromMessageAs a _ = fromMessage a
description (I l) = "Ignore "++description l
-- | the UnEscape layout modifier. Listens to 'EscapedMessage's and sends
-- their nested message to the inner layout.
data UnEscape w = UE
deriving (Show, Read)
instance LayoutModifier UnEscape a where
handleMessOrMaybeModifyIt _ mess
= return $ case fromMessage mess of
Just (Escape mess') -> Just $ Right mess'
Nothing -> Nothing
-- | Data type for an escaped message. Send with 'escape'.
newtype EscapedMessage = Escape SomeMessage
deriving Typeable
instance Message EscapedMessage
-- | Creates an 'EscapedMessage'.
escape :: Message m => m -> EscapedMessage
escape = Escape . SomeMessage
-- | Applies the UnEscape layout modifier to a layout.
unEscape :: LayoutClass l w => l w -> ModifiedLayout UnEscape l w
unEscape l = ModifiedLayout UE l
-- | Applies the Ignore layout modifier to a layout, blocking
-- all messages of the same type as the one passed as its first argument.
ignore :: (Message m, LayoutClass l w)
=> m -> l w -> (Ignore m l w)
ignore _ l = I l
|
