diff options
author | Spencer Janssen <sjanssen@cse.unl.edu> | 2007-11-01 21:10:59 +0100 |
---|---|---|
committer | Spencer Janssen <sjanssen@cse.unl.edu> | 2007-11-01 21:10:59 +0100 |
commit | 4866f2e367dfcf22a9591231ba40948826a1b438 (patch) | |
tree | 7a245caee3f146826b267d773b7eaa80386a818e /XMonad/Layout/LayoutModifier.hs | |
parent | 47589e1913fb9530481caedb543978a30d4323ea (diff) | |
download | XMonadContrib-4866f2e367dfcf22a9591231ba40948826a1b438.tar.gz XMonadContrib-4866f2e367dfcf22a9591231ba40948826a1b438.tar.xz XMonadContrib-4866f2e367dfcf22a9591231ba40948826a1b438.zip |
Hierarchify
darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz
Diffstat (limited to 'XMonad/Layout/LayoutModifier.hs')
-rw-r--r-- | XMonad/Layout/LayoutModifier.hs | 69 |
1 files changed, 69 insertions, 0 deletions
diff --git a/XMonad/Layout/LayoutModifier.hs b/XMonad/Layout/LayoutModifier.hs new file mode 100644 index 0000000..7d8c615 --- /dev/null +++ b/XMonad/Layout/LayoutModifier.hs @@ -0,0 +1,69 @@ +{-# 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 Layouts +----------------------------------------------------------------------------- + +module XMonad.Layout.LayoutModifier ( + -- * Usage + -- $usage + LayoutModifier(..), ModifiedLayout(..) + ) where + +import Graphics.X11.Xlib ( Rectangle ) +import XMonad +import XMonad.StackSet ( Stack ) + +-- $usage +-- Use LayoutHelpers to help write easy Layouts. + +class (Show (m a), Read (m a)) => LayoutModifier m a where + handleMess :: m a -> SomeMessage -> X (Maybe (m a)) + handleMess m mess | Just Hide <- fromMessage mess = doUnhook + | Just ReleaseResources <- fromMessage mess = doUnhook + | otherwise = return Nothing + 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') + redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)] + -> X ([(a, Rectangle)], Maybe (m a)) + redoLayout m _ _ wrs = do hook m; return (wrs, 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') <- doLayout 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'') + 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 ) |