IM layout converted to LayoutModifier, which can be applied to any layout

XMonad/Layout/IM.hs

@@ -3,15 +3,15 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.IM
--- Copyright   :  (c) Roman Cheplyaka
+-- Copyright   :  (c) Roman Cheplyaka, Ivan N. Veselov <veselov@gmail.com>
 -- License     :  BSD-style (see LICENSE)
 --
 -- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- Layout suitable for workspace with multi-windowed instant messanger (like
+-- Layout modfier suitable for workspace with multi-windowed instant messanger
--- Psi or Tkabber).
+-- (like Psi or Tkabber).
 --
 -----------------------------------------------------------------------------
 
@@ -24,14 +24,15 @@ module XMonad.Layout.IM (
 
     -- * TODO
     -- $todo
-        Property(..), IM(..)
+        Property(..), IM(..), withIM, gridIM,
 ) where
 
 import XMonad
 import qualified XMonad.StackSet as S
 import Data.List
 import XMonad.Layout (splitHorizontallyBy)
-import XMonad.Layout.Grid (arrange)
+import XMonad.Layout.Grid
+import XMonad.Layout.LayoutModifier
 import XMonad.Util.WindowProperties
 
 -- $usage
@@ -40,9 +41,11 @@ import XMonad.Util.WindowProperties
 -- > import XMonad.Layout.IM
 -- > import Data.Ratio ((%))
 --
--- Then edit your @layoutHook@ by adding the IM layout:
+-- Then edit your @layoutHook@ by adding IM modifier to layout which you prefer
+-- for managing your chat windows (Grid in this example, another useful choice
+-- to consider is Tabbed layout).
 --
--- > myLayouts = IM (1%7) (ClassName "Tkabber") ||| Full ||| etc..
+-- > myLayouts = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc..
 -- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
 -- Here @1%7@ is the part of the screen which your roster will occupy,
@@ -63,14 +66,54 @@ import XMonad.Util.WindowProperties
 -- "XMonad.Layout.Reflect" module.
 
 -- $todo
--- All these items are questionable. Please let me know if you find them useful.
+-- This item are questionable. Please let me know if you find them useful.
 --
 -- * shrink\/expand
 --
--- * use arbitrary layout instead of grid
 
+-- | Data type for LayoutModifier which converts given layout to IM-layout
+-- (with dedicated space for the roster and original layout for chat windows)
+data AddRoster a = AddRoster Rational Property deriving (Read, Show)
+
+instance LayoutModifier AddRoster Window where
+  modifyLayout (AddRoster ratio prop) = applyIM ratio prop
+  modifierDescription _                = "IM"
+
+-- | Modifier which converts given layout to IM-layout (with dedicated
+-- space for roster and original layout for chat windows)
+withIM :: LayoutClass l a => Rational -> Property -> l a -> ModifiedLayout AddRoster l a
+withIM ratio prop = ModifiedLayout $ AddRoster ratio prop
+
+-- | IM layout modifier applied to the Grid layout
+gridIM :: Rational -> Property -> ModifiedLayout AddRoster Grid a
+gridIM ratio prop = withIM ratio prop Grid
+
+-- | Internal function for adding space for the roster specified by
+-- the property and running original layout for all chat windows
+applyIM :: (LayoutClass l Window) =>
+               Rational
+            -> Property
+            -> S.Workspace WorkspaceId (l Window) Window
+            -> Rectangle
+            -> X ([(Window, Rectangle)], Maybe (l Window))
+applyIM ratio prop wksp rect = do
+    let ws = S.integrate' $ S.stack wksp
+    let (masterRect, slaveRect) = splitHorizontallyBy ratio rect
+    master <- findM (hasProperty prop) ws
+    case master of
+        Just w -> do
+            let filteredStack = S.differentiate $ filter (w /=) ws
+            wrs <- runLayout (wksp {S.stack = filteredStack}) slaveRect
+            return ((w, masterRect) : fst wrs, snd wrs)
+        Nothing -> runLayout wksp rect
+
+-- | Like find, but works with monadic computation instead of pure function.
+findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
+findM _ [] = return Nothing
+findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs }
+
+-- | This is for compatibility with old configs only and will be removed in future versions!
 data IM a = IM Rational Property deriving (Read, Show)
-
 instance LayoutClass IM Window where
     description _ = "IM"
     doLayout (IM r prop) rect stack = do
@@ -81,8 +124,3 @@ instance LayoutClass IM Window where
                 Just w -> (w, masterRect) : arrange slaveRect (filter (w /=) ws)
                 Nothing -> arrange rect ws
         return (positions, Nothing)
-
--- | Like find, but works with monadic computation instead of pure function.
-findM :: Monad m => (a-> m Bool) -> [a] -> m (Maybe a)
-findM _ [] = return Nothing
-findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs }