mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
0f0a99e355
Many layouts are written as layout modifiers because they need to change the stack of the rectangle before executing doLayout. This is a major source of bugs. all layout modifiers should be using the LayoutModifier class. This method (modifyLayout) can be used to manipulate the rectangle and the stack before running doLayout by the layout modifier.
93 lines
3.9 KiB
Haskell
93 lines
3.9 KiB
Haskell
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
|
|
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.LayoutModifier
|
|
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
|
-- License : BSD
|
|
--
|
|
-- Maintainer : David Roundy <droundy@darcs.net>
|
|
-- Stability : unstable
|
|
-- Portability : portable
|
|
--
|
|
-- A module for writing easy Llayouts and layout modifiers
|
|
-----------------------------------------------------------------------------
|
|
|
|
module XMonad.Layout.LayoutModifier (
|
|
-- * Usage
|
|
-- $usage
|
|
LayoutModifier(..), ModifiedLayout(..)
|
|
) where
|
|
|
|
import XMonad
|
|
import XMonad.StackSet ( Stack )
|
|
|
|
-- $usage
|
|
-- Use LayoutModifier to help write easy Layouts.
|
|
--
|
|
-- LayouModifier defines a class 'LayoutModifier'. Each method as a
|
|
-- default implementation.
|
|
--
|
|
-- For usage examples you can see "XMonad.Layout.WorkspaceDir",
|
|
-- "XMonad.Layout.Magnifier", "XMonad.Layout.NoBorder",
|
|
|
|
class (Show (m a), Read (m a)) => LayoutModifier m a where
|
|
modifyLayout :: (LayoutClass l a) => m a -> l a -> Rectangle
|
|
-> Stack a -> X ([(a, Rectangle)], Maybe (l a))
|
|
modifyLayout _ l r s = doLayout l r s
|
|
handleMess :: m a -> SomeMessage -> X (Maybe (m a))
|
|
handleMess m mess | Just Hide <- fromMessage mess = doUnhook
|
|
| Just ReleaseResources <- fromMessage mess = doUnhook
|
|
| otherwise = return $ pureMess m mess
|
|
where doUnhook = do unhook m; return Nothing
|
|
handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
|
|
handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess
|
|
return (Left `fmap` mm')
|
|
pureMess :: m a -> SomeMessage -> Maybe (m a)
|
|
pureMess _ _ = Nothing
|
|
redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]
|
|
-> X ([(a, Rectangle)], Maybe (m a))
|
|
redoLayout m r s wrs = do hook m; return $ pureModifier m r s wrs
|
|
pureModifier :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]
|
|
-> ([(a, Rectangle)], Maybe (m a))
|
|
pureModifier _ _ _ wrs = (wrs, Nothing)
|
|
emptyLayoutMod :: m a -> Rectangle -> [(a, Rectangle)]
|
|
-> X ([(a, Rectangle)], Maybe (m a))
|
|
emptyLayoutMod _ _ _ = return ([], Nothing)
|
|
hook :: m a -> X ()
|
|
hook _ = return ()
|
|
unhook :: m a -> X ()
|
|
unhook _ = return ()
|
|
modifierDescription :: m a -> String
|
|
modifierDescription = const ""
|
|
|
|
instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where
|
|
doLayout (ModifiedLayout m l) r s =
|
|
do (ws, ml') <- modifyLayout m l r s
|
|
(ws', mm') <- redoLayout m r s ws
|
|
let ml'' = case mm' of
|
|
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
|
|
Nothing -> ModifiedLayout m `fmap` ml'
|
|
return (ws', ml'')
|
|
emptyLayout (ModifiedLayout m l) r =
|
|
do (ws, ml') <- emptyLayout l r
|
|
(ws',mm') <- emptyLayoutMod m r ws
|
|
let ml'' = case mm' of
|
|
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
|
|
Nothing -> ModifiedLayout m `fmap` ml'
|
|
return (ws', ml'')
|
|
handleMessage (ModifiedLayout m l) mess =
|
|
do mm' <- handleMessOrMaybeModifyIt m mess
|
|
ml' <- case mm' of
|
|
Just (Right mess') -> handleMessage l mess'
|
|
_ -> handleMessage l mess
|
|
return $ case mm' of
|
|
Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'
|
|
_ -> (ModifiedLayout m) `fmap` ml'
|
|
description (ModifiedLayout m l) = modifierDescription m <> description l
|
|
where "" <> x = x
|
|
x <> y = x ++ " " ++ y
|
|
|
|
data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )
|