Add a SetStruts message to H.ManageDocks.

This patch also uses Data.Set instead of [] for the AvoidStruts
constructor to simplify the SetStruts implementation.
This commit is contained in:
Adam Vogt
2009-10-05 16:42:21 +00:00
parent 1ef2eb63b9
commit 63b6d7c225
2 changed files with 46 additions and 14 deletions

View File

@@ -32,6 +32,8 @@ import qualified XMonad.StackSet as W
import XMonad.Hooks.ManageDocks (calcGap) import XMonad.Hooks.ManageDocks (calcGap)
import XMonad.Util.Types (Direction2D(..)) import XMonad.Util.Types (Direction2D(..))
import qualified Data.Set as S
-- $usage -- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
-- --
@@ -279,7 +281,7 @@ getSnap horiz collidedist d w = do
screen <- W.current <$> gets windowset screen <- W.current <$> gets windowset
let sr = screenRect $ W.screenDetail screen let sr = screenRect $ W.screenDetail screen
wl = W.integrate' . W.stack $ W.workspace screen wl = W.integrate' . W.stack $ W.workspace screen
gr <- fmap ($sr) $ calcGap [L,R,U,D] gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound]
wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl) wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
return ( neighbours (back wa sr gr wla) (wpos wa) return ( neighbours (back wa sr gr wla) (wpos wa)

View File

@@ -19,6 +19,7 @@ module XMonad.Hooks.ManageDocks (
-- $usage -- $usage
manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
ToggleStruts(..), ToggleStruts(..),
SetStruts(..),
module XMonad.Util.Types, module XMonad.Util.Types,
-- for XMonad.Actions.FloatSnap -- for XMonad.Actions.FloatSnap
@@ -34,7 +35,7 @@ import XMonad.Layout.LayoutModifier
import XMonad.Util.Types import XMonad.Util.Types
import XMonad.Util.WindowProperties (getProp32s) import XMonad.Util.WindowProperties (getProp32s)
import Data.List (delete) import qualified Data.Set as S
-- $usage -- $usage
-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
@@ -119,7 +120,7 @@ getStrut w = do
-- | Goes through the list of windows and find the gap so that all -- | Goes through the list of windows and find the gap so that all
-- STRUT settings are satisfied. -- STRUT settings are satisfied.
calcGap :: [Direction2D] -> X (Rectangle -> Rectangle) calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
calcGap ss = withDisplay $ \dpy -> do calcGap ss = withDisplay $ \dpy -> do
rootw <- asks theRoot rootw <- asks theRoot
-- We don't keep track of dock like windows, so we find all of them here -- We don't keep track of dock like windows, so we find all of them here
@@ -132,7 +133,7 @@ calcGap ss = withDisplay $ \dpy -> do
wa <- io $ getWindowAttributes dpy rootw wa <- io $ getWindowAttributes dpy rootw
let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa) let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)
return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts
where careAbout (s,_,_,_) = s `elem` ss where careAbout (s,_,_,_) = s `S.member` ss
-- | Adjust layout automagically: don't cover up any docks, status -- | Adjust layout automagically: don't cover up any docks, status
-- bars, etc. -- bars, etc.
@@ -146,9 +147,9 @@ avoidStrutsOn :: LayoutClass l a =>
[Direction2D] [Direction2D]
-> l a -> l a
-> ModifiedLayout AvoidStruts l a -> ModifiedLayout AvoidStruts l a
avoidStrutsOn ss = ModifiedLayout (AvoidStruts ss) avoidStrutsOn ss = ModifiedLayout $ AvoidStruts $ S.fromList ss
data AvoidStruts a = AvoidStruts [Direction2D] deriving ( Read, Show ) data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )
-- | Message type which can be sent to an 'AvoidStruts' layout -- | Message type which can be sent to an 'AvoidStruts' layout
-- modifier to alter its behavior. -- modifier to alter its behavior.
@@ -158,19 +159,48 @@ data ToggleStruts = ToggleStruts
instance Message ToggleStruts instance Message ToggleStruts
-- | SetStruts is a message constructor used to set or unset specific struts,
-- regardless of whether or not the struts were originally set. Here are some
-- example bindings:
--
-- Show all gaps:
--
-- > ,((modMask x .|. shiftMask ,xK_b),sendMessage $ SetStruts [minBound .. maxBound] [])
--
-- Hide all gaps:
--
-- > ,((modMask x .|. controlMask,xK_b),sendMessage $ SetStruts [] [minBound .. maxBound])
--
-- Show only upper and left gaps:
--
-- > ,((modMask x .|. controlMask .|. shiftMask,xK_b),sendMessage $ SetStruts [U,L] [minBound .. maxBound])
--
-- Hide the bottom keeping whatever the other values were:
--
-- > ,((modMask x .|. controlMask .|. shiftMask,xK_g),sendMessage $ SetStruts [] [D])
data SetStruts = SetStruts { addedStruts :: [Direction2D]
, removedStruts :: [Direction2D] -- ^ These are removed from
}
deriving (Read,Show,Typeable)
instance Message SetStruts
instance LayoutModifier AvoidStruts a where instance LayoutModifier AvoidStruts a where
modifyLayout (AvoidStruts ss) w r = do modifyLayout (AvoidStruts ss) w r = do
nr <- fmap ($ r) (calcGap ss) nr <- fmap ($ r) (calcGap ss)
runLayout w nr runLayout w nr
handleMess (AvoidStruts ss) m pureMess (AvoidStruts ss) m
| Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (toggleAll ss) | Just ToggleStruts <- fromMessage m = Just $ AvoidStruts (toggleAll ss)
| Just (ToggleStrut s) <- fromMessage m = return $ Just $ AvoidStruts (toggleOne s ss) | Just (ToggleStrut s) <- fromMessage m = Just $ AvoidStruts (toggleOne s ss)
| otherwise = return Nothing | Just (SetStruts n k) <- fromMessage m
where toggleAll [] = [U,D,L,R] , let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k)
toggleAll _ = [] , newSS /= ss = Just $ AvoidStruts newSS
toggleOne x xs | x `elem` xs = delete x xs | otherwise = Nothing
| otherwise = x : xs where toggleAll x | S.null x = S.fromList [minBound .. maxBound]
| otherwise = S.empty
toggleOne x xs | x `S.member` xs = S.delete x xs
| otherwise = x `S.insert` xs
-- | (Direction, height\/width, initial pixel, final pixel). -- | (Direction, height\/width, initial pixel, final pixel).