From 7c7884a5d86cffaf306fde89d9d4d3a85d160d5c Mon Sep 17 00:00:00 2001 From: Andrea Rossato Date: Mon, 18 Feb 2008 14:13:20 +0100 Subject: add Eq superclass to DecorationStyle and change styles in order not to decorate non managed windows darcs-hash:20080218131320-32816-44ecfbd0dca9eb353a569898deefebef9f7088ed.gz --- XMonad/Layout/Decoration.hs | 9 ++++++--- XMonad/Layout/DecorationMadness.hs | 12 +++++++----- XMonad/Layout/DwmStyle.hs | 4 ++-- XMonad/Layout/SimpleDecoration.hs | 12 ++++++++---- XMonad/Layout/SimpleFloat.hs | 4 ++-- 5 files changed, 25 insertions(+), 16 deletions(-) (limited to 'XMonad') diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index e18a6d1..1e6bf0e 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -98,7 +98,7 @@ data Decoration ds s a = Decoration (Invisible Maybe DecorationState) s Theme (ds a) deriving (Show, Read) -class (Read (ds a), Show (ds a)) => DecorationStyle ds a where +class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where describeDeco :: ds a -> String describeDeco ds = show ds @@ -120,14 +120,17 @@ class (Read (ds a), Show (ds a)) => DecorationStyle ds a where pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle - pureDecoration _ _ h _ _ _ (_,Rectangle x y w _) = Just $ Rectangle x y w h + pureDecoration _ _ ht _ s _ (w,Rectangle x y wh _) = if isInStack s w + then Just $ Rectangle x y wh ht + else Nothing + decorate :: ds a -> Dimension -> Dimension -> Rectangle -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> X (Maybe Rectangle) decorate ds w h r s ars ar = return $ pureDecoration ds w h r s ars ar data DefaultDecoration a = DefaultDecoration deriving ( Read, Show ) -instance DecorationStyle DefaultDecoration a +instance Eq a => DecorationStyle DefaultDecoration a instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where redoLayout (Decoration st sh t ds) sc stack wrs diff --git a/XMonad/Layout/DecorationMadness.hs b/XMonad/Layout/DecorationMadness.hs index e4a771c..7c4c23b 100644 --- a/XMonad/Layout/DecorationMadness.hs +++ b/XMonad/Layout/DecorationMadness.hs @@ -84,6 +84,7 @@ module XMonad.Layout.DecorationMadness , floatSimpleTabbed , floatTabbed , defaultTheme, shrinkText + , SimpleTabbedDecoration (..) ) where import Data.List @@ -146,7 +147,8 @@ instance Eq a => DecorationStyle SimpleTabbedDecoration a where decorateFirst _ = True shrink _ _ r = r decorationMouseDragHook _ _ _ = return () - pureDecoration _ _ ht (Rectangle x y wh _) s wrs (w,_) = Just $ Rectangle nx y nwh (fi ht) + pureDecoration _ _ ht (Rectangle x y wh _) s wrs (w,_) = + if isInStack s w then Just $ Rectangle nx y nwh (fi ht) else Nothing where nwh = wh `div` max 1 (fi $ length wrs) nx = case w `elemIndex` (S.integrate s) of Just i -> x + (fi nwh * fi i) @@ -561,11 +563,11 @@ mirrorTallTabbed s t = decoration s t SimpleTabbed (resizeVertical (fi $ decoHei -- Here you can find a screen shot: -- -- -floatSimpleSimple :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) +floatSimpleSimple :: Eq a => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimpleSimple = simpleFloat -floatSimple :: Shrinker s => s -> Theme -> +floatSimple :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimple = simpleFloat' @@ -575,13 +577,13 @@ floatSimple = simpleFloat' -- Here you can find a screen shot: -- -- -floatSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) +floatSimpleDefault :: Eq a => ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'floatSimpleDefault', but with the possibility of setting a -- custom shrinker and a custom theme. -floatDefault :: Shrinker s => s -> Theme -> +floatDefault :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatDefault s c = decoration s c DefaultDecoration (mouseResize $ windowArrangeAll $ SF (decoHeight c)) diff --git a/XMonad/Layout/DwmStyle.hs b/XMonad/Layout/DwmStyle.hs index 623db56..448889f 100644 --- a/XMonad/Layout/DwmStyle.hs +++ b/XMonad/Layout/DwmStyle.hs @@ -62,7 +62,7 @@ data DwmStyle a = Dwm deriving (Show, Read) instance Eq a => DecorationStyle DwmStyle a where describeDeco _ = "DwmStyle" shrink _ _ r = r - pureDecoration _ wh ht _ (Stack fw _ _) _ (win,Rectangle x y wid _) = - if win == fw then Nothing else Just $ Rectangle (fi nx) y nwh (fi ht) + pureDecoration _ wh ht _ s@(Stack fw _ _) _ (w,Rectangle x y wid _) = + if w == fw || not (isInStack s w) then Nothing else Just $ Rectangle (fi nx) y nwh (fi ht) where nwh = min wid $ fi wh nx = fi x + wid - nwh diff --git a/XMonad/Layout/SimpleDecoration.hs b/XMonad/Layout/SimpleDecoration.hs index 09527ed..aa5d500 100644 --- a/XMonad/Layout/SimpleDecoration.hs +++ b/XMonad/Layout/SimpleDecoration.hs @@ -53,16 +53,20 @@ import XMonad.Layout.Decoration -- > myL = dwmStyle shrinkText mySDConfig (layoutHook defaultTheme) -- | Add simple decorations to windows of a layout. -simpleDeco :: Shrinker s => s -> Theme +simpleDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration SimpleDecoration s) l a simpleDeco s c = decoration s c $ Simple True data SimpleDecoration a = Simple Bool deriving (Show, Read) -instance DecorationStyle SimpleDecoration a where +instance Eq a => DecorationStyle SimpleDecoration a where describeDeco _ = "Simple" shrink (Simple b) (Rectangle _ _ _ dh) r@(Rectangle x y w h) = if b then Rectangle x (y + fi dh) w (h - dh) else r - pureDecoration (Simple b) wh ht _ _ _ (_,Rectangle x y wid _) = - if b then Just $ Rectangle x y nwh ht else Just $ Rectangle x (y - fi ht) nwh ht + pureDecoration (Simple b) wh ht _ s _ (w,Rectangle x y wid _) = + if isInStack s w + then if b + then Just $ Rectangle x y nwh ht + else Just $ Rectangle x (y - fi ht) nwh ht + else Nothing where nwh = min wid wh diff --git a/XMonad/Layout/SimpleFloat.hs b/XMonad/Layout/SimpleFloat.hs index 8256444..acf355d 100644 --- a/XMonad/Layout/SimpleFloat.hs +++ b/XMonad/Layout/SimpleFloat.hs @@ -49,13 +49,13 @@ import XMonad.Layout.WindowArranger -- to the window's initial attributes. -- -- This version is decorated with the 'SimpleDecoration' style. -simpleFloat :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) +simpleFloat :: Eq a => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a simpleFloat = decoration shrinkText defaultTheme (Simple False) (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'simpleFloat', but with the possibility of setting a -- custom shrinker and a custom theme. -simpleFloat' :: Shrinker s => s -> Theme -> +simpleFloat' :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a simpleFloat' s c = decoration s c (Simple False) (mouseResize $ windowArrangeAll $ SF (decoHeight c)) -- cgit v1.2.3