twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-21 15:03:48 -07:00
Code Issues Packages Projects Releases Wiki Activity

Decoratione: generate rectangles first, and create windows accordingly

Browse Source 
With this patch Decoration will first generate a rectangle and only if
there is a rectangle available a window will be created.

This makes the Decoration state a bit more difficult to process, but
should reduce resource consumption.
This commit is contained in:
Andrea Rossato
2008-02-19 12:21:15 +00:00
parent ad5b862c5a
commit 3f40309087
1 changed files with 69 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

124
XMonad/Layout/Decoration.hs
View File

@@ -1,6 +1,5 @@
{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable {-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Layout.Decoration -- Module : XMonad.Layout.Decoration
@@ -27,8 +26,7 @@ module XMonad.Layout.Decoration
, shrinkText, CustomShrink ( CustomShrink ) , shrinkText, CustomShrink ( CustomShrink )
, Shrinker (..), DefaultShrinker , Shrinker (..), DefaultShrinker
, module XMonad.Layout.LayoutModifier , module XMonad.Layout.LayoutModifier
, isInStack, isVisible, isInvisible, isWithin , isInStack, isVisible, isInvisible, isWithin, fi
, lookFor, lookFor', fi
) where ) where
import Control.Monad (when) import Control.Monad (when)
@@ -87,7 +85,7 @@ defaultTheme =
data DecorationMsg = SetTheme Theme deriving ( Typeable ) data DecorationMsg = SetTheme Theme deriving ( Typeable )
instance Message DecorationMsg instance Message DecorationMsg
type DecoWin = (Window,Maybe Rectangle) type DecoWin = (Maybe Window, Maybe Rectangle)
type OrigWin = (Window,Rectangle) type OrigWin = (Window,Rectangle)
data DecorationState = data DecorationState =
DS { decos :: [(OrigWin,DecoWin)] DS { decos :: [(OrigWin,DecoWin)]
@@ -124,7 +122,6 @@ class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where
then Just $ Rectangle x y wh ht then Just $ Rectangle x y wh ht
else Nothing else Nothing
decorate :: ds a -> Dimension -> Dimension -> Rectangle decorate :: ds a -> Dimension -> Dimension -> Rectangle
-> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> X (Maybe 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 decorate ds w h r s ars ar = return $ pureDecoration ds w h r s ars ar
@@ -136,14 +133,15 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d
redoLayout (Decoration st sh t ds) sc stack wrs redoLayout (Decoration st sh t ds) sc stack wrs
| decorate_first = do whenIJust st releaseResources | decorate_first = do whenIJust st releaseResources
return (wrs, Just $ Decoration (I Nothing) sh t ds) return (wrs, Just $ Decoration (I Nothing) sh t ds)
| I Nothing <- st = initState t wrs >>= processState | I Nothing <- st = initState t ds sc stack wrs >>= processState
| I (Just s) <- st = do let dwrs = decos s | I (Just s) <- st = do let dwrs = decos s
(d,a) = curry diff (get_ws dwrs) ws (d,a) = curry diff (get_ws dwrs) ws
toDel = todel d dwrs toDel = todel d dwrs
toAdd = toadd a wrs toAdd = toadd a wrs
deleteWindows (getDWs toDel) deleteDecos (map snd toDel)
ndwrs <- createDecos t toAdd ndwrs <- createDecos t ds sc stack wrs toAdd
processState (s {decos = ndwrs ++ del_dwrs d dwrs }) ndecos <- resync (ndwrs ++ del_dwrs d dwrs) wrs
processState (s {decos = ndecos })
| otherwise = return (wrs, Nothing) | otherwise = return (wrs, Nothing)
where where
@@ -171,13 +169,13 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d
| otherwise = (w,r) : remove_stacked (r:rs) xs | otherwise = (w,r) : remove_stacked (r:rs) xs
remove_stacked _ [] = [] remove_stacked _ [] = []
insert_dwr ((w,r),(dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs insert_dwr ((w,r),(Just dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs
insert_dwr (x ,(_ ,Nothing)) xs = x:xs insert_dwr (x ,( _ , _ )) xs = x:xs
dwrs_to_wrs = remove_stacked [] . foldr insert_dwr [] dwrs_to_wrs = remove_stacked [] . foldr insert_dwr []
processState s = do ndwrs <- resync (decos s) wrs processState s = do let ndwrs = decos s
showWindows (getDWs ndwrs) showDecos (map snd ndwrs)
updateDecos sh t (font s) ndwrs updateDecos sh t (font s) ndwrs
return (dwrs_to_wrs ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds)) return (dwrs_to_wrs ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds))
@@ -185,7 +183,7 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d
| Just e <- fromMessage m :: Maybe Event = do decorationEventHook ds s e | Just e <- fromMessage m :: Maybe Event = do decorationEventHook ds s e
handleEvent sh t s e handleEvent sh t s e
return Nothing return Nothing
| Just Hide <- fromMessage m = do hideWindows (getDWs dwrs) | Just Hide <- fromMessage m = do hideDecos (map snd dwrs)
return Nothing return Nothing
| Just (SetTheme nt) <- fromMessage m = do releaseResources s | Just (SetTheme nt) <- fromMessage m = do releaseResources s
return $ Just $ Decoration (I Nothing) sh nt ds return $ Just $ Decoration (I Nothing) sh nt ds
@@ -193,9 +191,8 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d
return $ Just $ Decoration (I Nothing) sh t ds return $ Just $ Decoration (I Nothing) sh t ds
handleMess _ _ = return Nothing handleMess _ _ = return Nothing
emptyLayoutMod (Decoration (I (Just (DS dwrs f))) sh t ds) _ _ = do emptyLayoutMod (Decoration (I (Just s)) sh t ds) _ _ = do
deleteWindows (getDWs dwrs) releaseResources s
releaseXMF f
return ([], Just $ Decoration (I Nothing) sh t ds) return ([], Just $ Decoration (I Nothing) sh t ds)
emptyLayoutMod _ _ _ = return ([], Nothing) emptyLayoutMod _ _ _ = return ([], Nothing)
@@ -203,8 +200,10 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d
handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X () handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X ()
handleEvent sh t (DS dwrs fs) e handleEvent sh t (DS dwrs fs) e
| PropertyEvent {ev_window = w} <- e, w `elem` (map (fst . fst) dwrs) = updateDecos sh t fs dwrs | PropertyEvent {ev_window = w} <- e
| ExposeEvent {ev_window = w} <- e, w `elem` (map (fst . snd) dwrs) = updateDecos sh t fs dwrs , w `elem` (map (fst . fst) dwrs) = updateDecos sh t fs dwrs
| ExposeEvent {ev_window = w} <- e
, w `elem` (catMaybes $ map (fst . snd) dwrs) = updateDecos sh t fs dwrs
handleEvent _ _ _ _ = return () handleEvent _ _ _ _ = return ()
handleMouseFocusDrag :: Bool -> DecorationState -> Event -> X () handleMouseFocusDrag :: Bool -> DecorationState -> Event -> X ()
@@ -223,44 +222,60 @@ handleMouseFocusDrag b (DS dwrs _) ButtonEvent { ev_window = ew
sendMessage (SetGeometry rect)) (return ()) sendMessage (SetGeometry rect)) (return ())
handleMouseFocusDrag _ _ _ = return () handleMouseFocusDrag _ _ _ = return ()
lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,DecoWin) lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle))
lookFor w ((wr,(dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr)) lookFor w ((wr,(Just dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr))
| otherwise = lookFor w dwrs | otherwise = lookFor w dwrs
lookFor w ((_, (Nothing, _)):dwrs) = lookFor w dwrs
lookFor _ [] = Nothing lookFor _ [] = Nothing
lookFor' :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,DecoWin) initState :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle
lookFor' w (((w',r),dwr):dwrs) | w == w' = Just ((w,r),dwr) -> W.Stack Window -> [(Window,Rectangle)] -> X DecorationState
| otherwise = lookFor' w dwrs initState t ds sc s wrs = do
lookFor' _ [] = Nothing
getDWs :: [(OrigWin,DecoWin)] -> [Window]
getDWs = map (fst . snd)
initState :: Theme -> [(Window,Rectangle)] -> X DecorationState
initState t wrs = do
fs <- initXMF (fontName t) fs <- initXMF (fontName t)
dwrs <- createDecos t wrs dwrs <- createDecos t ds sc s wrs wrs
return $ DS dwrs fs return $ DS dwrs fs
releaseResources :: DecorationState -> X () releaseResources :: DecorationState -> X ()
releaseResources s = do releaseResources s = do
deleteWindows (getDWs $ decos s) deleteDecos (map snd $ decos s)
releaseXMF (font s) releaseXMF (font s)
createDecos :: Theme -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] createDecos :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window
createDecos _ [] = return [] -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)]
createDecos t (wr:wrs) = do createDecos t ds sc s wrs ((w,r):xs) = do
let rect = Rectangle 0 0 1 1 deco <- decorate ds (decoWidth t) (decoHeight t) sc s wrs (w,r)
mask = Just (exposureMask .|. buttonPressMask) case deco of
dw <- createNewWindow rect mask (inactiveColor t) True Just dr -> do let mask = Just (exposureMask .|. buttonPressMask)
dwrs <- createDecos t wrs dw <- createNewWindow dr mask (inactiveColor t) True
return ((wr,(dw,Nothing)):dwrs) dwrs <- createDecos t ds sc s wrs xs
return $ ((w,r), (Just dw, Just dr)) : dwrs
Nothing -> do dwrs <- createDecos t ds sc s wrs xs
return $ ((w,r), (Nothing, Nothing)) : dwrs
createDecos _ _ _ _ _ [] = return []
updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin, DecoWin)] -> X () showDecos :: [DecoWin] -> X ()
showDecos (m:mwrs)
| (Just w,_) <- m = showWindow w >> showDecos mwrs
| otherwise = showDecos mwrs
showDecos [] = return ()
hideDecos :: [DecoWin] -> X ()
hideDecos (m:mwrs)
| (Just w,_) <- m = hideWindow w >> hideDecos mwrs
| otherwise = hideDecos mwrs
hideDecos [] = return ()
deleteDecos :: [DecoWin] -> X ()
deleteDecos (m:mwrs)
| (Just w,_) <- m = deleteWindow w >> deleteDecos mwrs
| otherwise = deleteDecos mwrs
deleteDecos [] = return ()
updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X ()
updateDecos s t f = mapM_ $ updateDeco s t f updateDecos s t f = mapM_ $ updateDeco s t f
updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X () updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X ()
updateDeco sh t fs ((w,_),(dw,Just (Rectangle _ _ wh ht))) = do updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do
nw <- getName w nw <- getName w
ur <- readUrgents ur <- readUrgents
dpy <- asks display dpy <- asks display
@@ -269,16 +284,15 @@ updateDeco sh t fs ((w,_),(dw,Just (Rectangle _ _ wh ht))) = do
| win `elem` ur -> uc | win `elem` ur -> uc
| otherwise -> ic) . W.peek) | otherwise -> ic) . W.peek)
`fmap` gets windowset `fmap` gets windowset
(bc,borderc,tc) <- focusColor w (bc,borderc,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveTextColor t)
(inactiveColor t, inactiveBorderColor t, inactiveTextColor t) (activeColor t, activeBorderColor t, activeTextColor t)
(activeColor t, activeBorderColor t, activeTextColor t) (urgentColor t, urgentBorderColor t, urgentTextColor t)
(urgentColor t, urgentBorderColor t, urgentTextColor t) let s = shrinkIt sh
let s = shrinkIt sh name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n
name <- shrinkWhile s (\n -> do return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
size <- io $ textWidthXMF dpy fs n
return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
paintAndWrite dw fs wh ht 1 bc borderc tc bc AlignCenter name paintAndWrite dw fs wh ht 1 bc borderc tc bc AlignCenter name
updateDeco _ _ _ (_,(w,Nothing)) = hideWindow w updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w
updateDeco _ _ _ _ = return ()
isInStack :: Eq a => W.Stack a -> a -> Bool isInStack :: Eq a => W.Stack a -> a -> Bool
isInStack s = flip elem (W.integrate s) isInStack s = flip elem (W.integrate s)