{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.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,
-- * Overloading ways to select windows
-- $selectWin
Predicate (..), Proxy(..),
) 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
-- $selectWin
--
-- 'Predicate' exists because layouts are required to be serializable, and
-- "XMonad.Util.WindowProperties" is not sufficient (for example it does not
-- allow using regular expressions).
--
-- compare "XMonad.Util.Invisible"
-- | Type class for predicates. This enables us to manage not only Windows,
-- but any objects, for which instance Predicate is defined.
--
-- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras
class Predicate p w where
alwaysTrue :: Proxy w -> p -- ^ A predicate that is always True.
checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate
-- | Contains no actual data, but is needed to help select the correct instance
-- of 'Predicate'
data Proxy a = Proxy
-- | 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 (Proxy :: Proxy 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
