new XMonad.Layout.MessageControl module

Ignore-this: cc28e0def6c797f6d1da8f23469a4f8

darcs-hash:20090128013917-5ccef-3b5fbfbb147d935e15f43e741e975fa3f92f6ce8.gz

1 files changed, 126 insertions, 0 deletions

diff --git a/XMonad/Layout/MessageControl.hs b/XMonad/Layout/MessageControl.hs
new file mode 100644
index 0000000..2b62339
--- /dev/null
+++ b/XMonad/Layout/MessageControl.hs
@@ -0,0 +1,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
+-- > ((modMask .|. 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
\ No newline at end of file