From d3426a6b42d8ddb0eba568813c8d19815df2eb8a Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Wed, 30 Jan 2008 07:46:24 +0100 Subject: Various decorations related updates * remove deprecated TConf stuff * Remove 'style' from DeConf * Change DeConf to Theme * share defaultTheme across all decorations darcs-hash:20080130064624-a5988-98fcf49dde956e318f801e934f2045cf94c951d5.gz --- XMonad/Layout/Decoration.hs | 113 +++++++++++++++++++++----------------------- 1 file changed, 53 insertions(+), 60 deletions(-) (limited to 'XMonad/Layout/Decoration.hs') diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index c830e6c..f205082 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -20,7 +20,7 @@ module XMonad.Layout.Decoration decoration , Decoration , DecorationStyle (..) - , DeConfig (..), defaultDeConfig, mkDefaultDeConfig + , Theme (..), defaultTheme , shrinkText, CustomShrink ( CustomShrink ) , Shrinker (..), DefaultShrinker , module XMonad.Layout.LayoutModifier @@ -44,42 +44,40 @@ import XMonad.Util.Font -- For usage examples you can see "XMonad.Layout.SimpleDecoration", -- "XMonad.Layout.Tabbed", "XMonad.Layout.DwmStyle", -decoration :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a +decoration :: (DecorationStyle ds a, Shrinker s) => s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a -decoration s c = ModifiedLayout (Decoration (I Nothing) s c) - -data DeConfig ds a = - DeConfig { activeColor :: String - , inactiveColor :: String - , urgentColor :: String - , activeBorderColor :: String - , inactiveBorderColor :: String - , urgentBorderColor :: String - , activeTextColor :: String - , inactiveTextColor :: String - , urgentTextColor :: String - , fontName :: String - , decoWidth :: Dimension - , decoHeight :: Dimension - , style :: ds a - } deriving (Show, Read) - -mkDefaultDeConfig :: DecorationStyle ds a => ds a -> DeConfig ds a -mkDefaultDeConfig ds = - DeConfig { activeColor = "#999999" - , inactiveColor = "#666666" - , urgentColor = "#FFFF00" - , activeBorderColor = "#FFFFFF" - , inactiveBorderColor = "#BBBBBB" - , urgentBorderColor = "##00FF00" - , activeTextColor = "#FFFFFF" - , inactiveTextColor = "#BFBFBF" - , urgentTextColor = "#FF0000" - , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , decoWidth = 200 - , decoHeight = 20 - , style = ds - } +decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds) + +data Theme = + Theme { activeColor :: String + , inactiveColor :: String + , urgentColor :: String + , activeBorderColor :: String + , inactiveBorderColor :: String + , urgentBorderColor :: String + , activeTextColor :: String + , inactiveTextColor :: String + , urgentTextColor :: String + , fontName :: String + , decoWidth :: Dimension + , decoHeight :: Dimension + } deriving (Show, Read) + +defaultTheme :: Theme +defaultTheme = + Theme { activeColor = "#999999" + , inactiveColor = "#666666" + , urgentColor = "#FFFF00" + , activeBorderColor = "#FFFFFF" + , inactiveBorderColor = "#BBBBBB" + , urgentBorderColor = "##00FF00" + , activeTextColor = "#FFFFFF" + , inactiveTextColor = "#BFBFBF" + , urgentTextColor = "#FF0000" + , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , decoWidth = 200 + , decoHeight = 20 + } type DecoWin = (Window,Maybe Rectangle) type OrigWin = (Window,Rectangle) @@ -89,7 +87,7 @@ data DecorationState = } data Decoration ds s a = - Decoration (Invisible Maybe DecorationState) s (DeConfig ds a) + Decoration (Invisible Maybe DecorationState) s Theme (ds a) deriving (Show, Read) class (Read (ds a), Show (ds a)) => DecorationStyle ds a where @@ -110,18 +108,12 @@ class (Read (ds a), Show (ds a)) => DecorationStyle ds a where -> 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 DefaultStyle a = DefaultStyle deriving (Read, Show) -instance DecorationStyle DefaultStyle a - -defaultDeConfig :: DeConfig DefaultStyle a -defaultDeConfig = mkDefaultDeConfig DefaultStyle - instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where - redoLayout (Decoration st sh c) sc stack wrs + redoLayout (Decoration st sh c ds) sc stack wrs | decorate_first = do whenIJust st $ \s -> do deleteWindows (getDWs $ decos s) releaseXMF (font s) - return (wrs, Just $ Decoration (I Nothing) sh c) + return (wrs, Just $ Decoration (I Nothing) sh c ds) | I Nothing <- st = initState c wrs >>= processState | I (Just s) <- st = do let dwrs = decos s (d,a) = curry diff (get_ws dwrs) ws @@ -141,40 +133,41 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d todel d = filter (flip elem d . get_w) toadd a = filter (flip elem a . fst ) - insert_dwr ((w,r),(dw,Just dr)) xs = (dw,dr):(w, shrink (style c) dr r):xs + insert_dwr ((w,r),(dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs insert_dwr (x ,(_ ,Nothing)) xs = x:xs resync _ [] = return [] resync d ((w,r):xs) = case w `elemIndex` get_ws d of - Just i -> do dr <- decorate (style c) (decoWidth c) (decoHeight c) sc stack wrs (w,r) + Just i -> do dr <- decorate ds (decoWidth c) (decoHeight c) sc stack wrs (w,r) dwrs <- resync d xs return $ ((w,r),(find_dw i d, dr)) : dwrs Nothing -> resync d xs - decorate_first = length wrs == 1 && (not . decorateFirst . style $ c) + decorate_first = length wrs == 1 && (not . decorateFirst $ ds) processState s = do ndwrs <- resync (decos s) wrs showWindows (getDWs ndwrs) updateDecos sh c (font s) ndwrs - return (foldr insert_dwr [] ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh c)) + return (foldr insert_dwr [] ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh c ds)) - handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh c) m + handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh c ds) m | Just e <- fromMessage m :: Maybe Event = handleEvent sh c s e >> return Nothing | Just Hide <- fromMessage m = hideWindows dws >> return Nothing | Just ReleaseResources <- fromMessage m = do deleteWindows dws releaseXMF (font s) - return $ Just $ Decoration (I Nothing) sh c + return $ Just $ Decoration (I Nothing) sh c ds where dws = getDWs dwrs handleMess _ _ = return Nothing - emptyLayoutMod (Decoration (I (Just (DS dwrs f))) sh c) _ _ = do deleteWindows (getDWs dwrs) - releaseXMF f - return ([], Just $ Decoration (I Nothing) sh c) + emptyLayoutMod (Decoration (I (Just (DS dwrs f))) sh c ds) _ _ = do + deleteWindows (getDWs dwrs) + releaseXMF f + return ([], Just $ Decoration (I Nothing) sh c ds) emptyLayoutMod _ _ _ = return ([], Nothing) - modifierDescription (Decoration _ _ c) = describeDeco $ style c + modifierDescription (Decoration _ _ _ ds) = describeDeco ds -handleEvent :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a -> DecorationState-> Event -> X () +handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X () handleEvent sh c (DS dwrs fs) e | PropertyEvent {ev_window = w} <- e, w `elem` (map (fst . fst) dwrs) = updateDecos sh c fs dwrs | ExposeEvent {ev_window = w} <- e, w `elem` (map (fst . snd) dwrs) = updateDecos sh c fs dwrs @@ -183,13 +176,13 @@ handleEvent _ _ _ _ = return () getDWs :: [(OrigWin,DecoWin)] -> [Window] getDWs = map (fst . snd) -initState :: DecorationStyle ds a => DeConfig ds a -> [(Window,Rectangle)] -> X DecorationState +initState :: Theme -> [(Window,Rectangle)] -> X DecorationState initState conf wrs = do fs <- initXMF (fontName conf) dwrs <- createDecos conf wrs return $ DS dwrs fs -createDecos :: DecorationStyle ds a => DeConfig ds a -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] +createDecos :: Theme -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] createDecos _ [] = return [] createDecos c (wr:wrs) = do let rect = Rectangle 0 0 1 1 @@ -198,10 +191,10 @@ createDecos c (wr:wrs) = do dwrs <- createDecos c wrs return ((wr,(dw,Nothing)):dwrs) -updateDecos :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a -> XMonadFont -> [(OrigWin, DecoWin)] -> X () +updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin, DecoWin)] -> X () updateDecos s c f = mapM_ $ updateDeco s c f -updateDeco :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a -> XMonadFont -> (OrigWin, DecoWin) -> X () +updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X () updateDeco sh c fs ((w,_),(dw,Just (Rectangle _ _ wh ht))) = do nw <- getName w ur <- readUrgents -- cgit v1.2.3