diff options
Diffstat (limited to 'XMonad/Layout/LayoutBuilderP.hs')
| -rw-r--r-- | XMonad/Layout/LayoutBuilderP.hs | 200 |
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 + |