Add new layout combinator: LayoutBuilderP.

Ignore-this: 377b748cb6b84ef7c9f7cde1d4ebd535

LayoutBuilderP is similar to LayoutBuilder (and is based on it), but LayoutBuilderP places windows matching given X.U.WindowProperties.Property (or any other predicate) into one rectangle, instead of fixed number of windows.

darcs-hash:20110511154010-c5067-2f813b2d31a92230d7de035602ec4e659c742abd.gz

1 files changed, 200 insertions, 0 deletions

diff --git a/XMonad/Layout/LayoutBuilderP.hs b/XMonad/Layout/LayoutBuilderP.hs
new file mode 100644
index 0000000..7702a4f
--- /dev/null
+++ b/XMonad/Layout/LayoutBuilderP.hs
@@ -0,0 +1,200 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  LayoutBuilderP
+-- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>, 2011 Ilya Portnov <portnov84@rambler.ru>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout combinator that sends windows matching given predicate to one rectangle
+-- and the rest to another.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.LayoutBuilderP (
+  LayoutP (..),
+  layoutP, layoutAll,
+  B.relBox, B.absBox,
+  PropertyRE (..)
+  ) where
+
+import Control.Monad
+import Data.Maybe (isJust)
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Util.WindowProperties
+
+import qualified XMonad.Layout.LayoutBuilder as B
+
+-- | Type class for predicates. This enables us to manage not only Windows, 
+-- but any objects, for which instance Predicate is defined.
+-- We assume that for all w checkPredicate (alwaysTrue undefined) == return True.
+class Predicate p w where
+  alwaysTrue :: w -> p               -- ^ A predicate that is always True. First argument is dummy, we always set it to undefined
+  checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate
+
+-- | A wrapper for X.U.WindowProperties.Property.
+-- Checks using regular expression.
+data PropertyRE = RE Property
+  deriving (Show,Read,Typeable)
+
+-- | Data type for our layout.
+data LayoutP p l1 l2 a =
+    LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a))
+    deriving (Show,Read)
+
+-- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain.
+--   It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout.
+layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) =>
+       p
+    -> B.SubBox                       -- ^ The box to place the windows in
+    -> Maybe B.SubBox                 -- ^ Possibly an alternative box that is used when this layout handles all windows that are left
+    -> l1 a                         -- ^ The layout to use in the specified area
+    -> LayoutP p l2 l3 a              -- ^ Where to send the remaining windows
+    -> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout
+layoutP prop box mbox sub next = LayoutP Nothing Nothing prop box mbox sub (Just next)
+
+-- | Use the specified layout in the described area for all remaining windows.
+layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) =>
+       B.SubBox             -- ^ The box to place the windows in
+    -> l1 a               -- ^ The layout to use in the specified area
+    -> LayoutP p l1 Full a  -- ^ The resulting layout
+layoutAll box sub =
+  let a = alwaysTrue (undefined :: a)
+  in  LayoutP Nothing Nothing a box Nothing sub Nothing
+
+instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) =>
+    LayoutClass (LayoutP p l1 l2) w where
+
+        -- | Update window locations.
+        runLayout (W.Workspace _ (LayoutP subf nextf prop box mbox sub next) s) rect
+            = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf
+                 let selBox = if isJust nextf'
+                                then box
+                                else maybe box id mbox
+
+                 (sublist,sub') <- handle sub subs $ calcArea selBox rect
+
+                 (nextlist,next') <- case next of Nothing -> return ([],Nothing)
+                                                  Just n -> do (res,l) <- handle n nexts rect
+                                                               return (res,Just l)
+
+                 return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' )
+              where
+                  handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r
+                                     l' <- return $ maybe l id ml
+                                     return (res,l')
+
+        -- |  Propagate messages.
+        handleMessage l m
+            | Just (IncMasterN _) <- fromMessage m = sendFocus l m
+            | Just (Shrink) <- fromMessage m = sendFocus l m
+            | Just (Expand) <- fromMessage m = sendFocus l m
+            | otherwise = sendBoth l m
+
+        -- |  Descriptive name for layout.
+        description (LayoutP _ _ _ _ _ sub (Just next)) = "layoutP "++ description sub ++" "++ description next
+        description (LayoutP _ _ _ _ _ sub Nothing)     = "layoutP "++ description sub
+
+
+sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
+        => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
+sendSub (LayoutP subf nextf prop box mbox sub next) m =
+    do sub' <- handleMessage sub m
+       return $ if isJust sub'
+                then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') next
+                else Nothing
+
+sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
+         => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
+sendBoth l@(LayoutP _ _ _ _ _ _ Nothing) m = sendSub l m
+sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m =
+    do sub' <- handleMessage sub m
+       next' <- handleMessage next m
+       return $ if isJust sub' || isJust next'
+                then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') (Just $ maybe next id next')
+                else Nothing
+
+sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
+         => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
+sendNext (LayoutP _ _ _ _ _ _ Nothing) _ = return Nothing
+sendNext (LayoutP subf nextf prop box mbox sub (Just next)) m =
+    do next' <- handleMessage next m
+       return $ if isJust next'
+                then Just $ LayoutP subf nextf prop box mbox sub next'
+                else Nothing
+
+sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
+          => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
+sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf
+                                              if foc then sendSub l m
+                                                     else sendNext l m
+
+isFocus :: (Show a) => Maybe a -> X Bool
+isFocus Nothing = return False
+isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
+                      return $ maybe False (\s -> show w == (show $ W.focus s)) ms
+
+
+-- | Split given list of objects (i.e. windows) using predicate.
+splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w])
+splitBy prop ws = foldM step ([], []) ws
+  where
+    step (good, bad) w = do
+      ok <- checkPredicate prop w
+      return $ if ok
+                then (w:good, bad)
+                else (good,   w:bad)
+
+splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w)
+splitStack Nothing _ _ _ = return (Nothing,Nothing,Nothing,Nothing)
+splitStack (Just s) prop subf nextf = do
+    let ws = W.integrate s
+    (good, other) <- splitBy prop ws
+    let subf'  = foc good subf
+        nextf' = foc other nextf
+    return ( differentiate' subf' good
+           , differentiate' nextf' other
+           , subf'
+           , nextf'
+           )
+  where
+    foc [] _ = Nothing
+    foc l f = if W.focus s `elem` l
+              then Just $ W.focus s
+              else if maybe False (`elem` l) f
+                   then f
+                   else Just $ head l
+
+calcArea :: B.SubBox -> Rectangle -> Rectangle
+calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height'
+    where
+        xpos' = calc False xpos $ rect_width rect
+        ypos' = calc False ypos $ rect_height rect
+        width' = calc True width $ rect_width rect - xpos'
+        height' = calc True height $ rect_height rect - ypos'
+
+        calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $
+            case val of B.Rel v -> floor $ v * fromIntegral tot
+                        B.Abs v -> if v<0 || (zneg && v==0)
+                                 then (fromIntegral tot)+v
+                                 else v
+
+differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)
+differentiate' _ [] = Nothing
+differentiate' Nothing w = W.differentiate w
+differentiate' (Just f) w
+    | f `elem` w = Just $ W.Stack { W.focus = f
+                                  , W.up    = reverse $ takeWhile (/=f) w
+                                  , W.down  = tail $ dropWhile (/=f) w
+                                  }
+    | otherwise = W.differentiate w
+
+instance Predicate Property Window where
+  alwaysTrue _ = Const True
+  checkPredicate = hasProperty
+