Merge remote-tracking branch 'origin/master' into custom_focus_raise_next_maybe

This commit is contained in:
Ivan Malison
2016-11-03 19:15:28 -07:00
14 changed files with 144 additions and 153 deletions

View File

@@ -33,7 +33,7 @@ import Data.Maybe (listToMaybe,fromJust,isNothing)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import qualified Data.Set as S import qualified Data.Set as S
import XMonad.Hooks.ManageDocks (calcGapForAll) import XMonad.Hooks.ManageDocks (calcGap)
import XMonad.Util.Types (Direction2D(..)) import XMonad.Util.Types (Direction2D(..))
import XMonad.Actions.AfterDrag import XMonad.Actions.AfterDrag
@@ -291,7 +291,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) $ calcGapForAll $ S.fromList [minBound .. maxBound] 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

@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Actions.WindowBringer -- Module : XMonad.Actions.WindowBringer
@@ -17,12 +18,13 @@
module XMonad.Actions.WindowBringer ( module XMonad.Actions.WindowBringer (
-- * Usage -- * Usage
-- $usage -- $usage
gotoMenu, gotoMenu', gotoMenuArgs, gotoMenuArgs', WindowBringerConfig(..),
bringMenu, bringMenu', bringMenuArgs, bringMenuArgs', gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
windowMap, bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
bringWindow windowMap, windowMap', bringWindow, actionMenu
) where ) where
import Control.Applicative((<$>))
import qualified Data.Map as M import qualified Data.Map as M
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
@@ -45,58 +47,74 @@ import XMonad.Util.NamedWindows (getName)
-- For detailed instructions on editing your key bindings, see -- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings". -- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Default menu command data WindowBringerConfig = WindowBringerConfig
defaultCmd :: String { menuCommand :: String -- ^ The shell command that will handle window selection
defaultCmd = "dmenu" , menuArgs :: [String] -- ^ Arguments to be passed to menuCommand
, windowTitler :: X.WindowSpace -> Window -> X String -- ^ A function that produces window titles given a workspace and a window
}
-- | Make dmenu case insensitive instance Default WindowBringerConfig where
defaultArgs :: [String] def = WindowBringerConfig{ menuCommand = "dmenu"
defaultArgs = ["-i"] , menuArgs = ["-i"]
, windowTitler = decorateName
}
-- | Pops open a dmenu with window titles. Choose one, and you will be -- | Pops open a dmenu with window titles. Choose one, and you will be
-- taken to the corresponding workspace. -- taken to the corresponding workspace.
gotoMenu :: X () gotoMenu :: X ()
gotoMenu = gotoMenuArgs defaultArgs gotoMenu = gotoMenuConfig def
-- | Pops open a dmenu with window titles. Choose one, and you will be
-- taken to the corresponding workspace. This version accepts a configuration
-- object.
gotoMenuConfig :: WindowBringerConfig -> X ()
gotoMenuConfig wbConfig = actionMenu wbConfig W.focusWindow
-- | Pops open a dmenu with window titles. Choose one, and you will be -- | Pops open a dmenu with window titles. Choose one, and you will be
-- taken to the corresponding workspace. This version takes a list of -- taken to the corresponding workspace. This version takes a list of
-- arguments to pass to dmenu. -- arguments to pass to dmenu.
gotoMenuArgs :: [String] -> X () gotoMenuArgs :: [String] -> X ()
gotoMenuArgs menuArgs = gotoMenuArgs' defaultCmd menuArgs gotoMenuArgs args = gotoMenuConfig def { menuArgs = args }
-- | Pops open an application with window titles given over stdin. Choose one, -- | Pops open an application with window titles given over stdin. Choose one,
-- and you will be taken to the corresponding workspace. -- and you will be taken to the corresponding workspace.
gotoMenu' :: String -> X () gotoMenu' :: String -> X ()
gotoMenu' menuCmd = gotoMenuArgs' menuCmd [] gotoMenu' cmd = gotoMenuConfig def { menuArgs = [], menuCommand = cmd }
-- | Pops open an application with window titles given over stdin. Choose one, -- | Pops open an application with window titles given over stdin. Choose one,
-- and you will be taken to the corresponding workspace. This version takes a -- and you will be taken to the corresponding workspace. This version takes a
-- list of arguments to pass to dmenu. -- list of arguments to pass to dmenu.
gotoMenuArgs' :: String -> [String] -> X () gotoMenuArgs' :: String -> [String] -> X ()
gotoMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs W.focusWindow gotoMenuArgs' cmd args = gotoMenuConfig def { menuCommand = cmd, menuArgs = args }
-- | Pops open a dmenu with window titles. Choose one, and it will be -- | Pops open a dmenu with window titles. Choose one, and it will be
-- dragged, kicking and screaming, into your current workspace. -- dragged, kicking and screaming, into your current workspace.
bringMenu :: X () bringMenu :: X ()
bringMenu = bringMenuArgs defaultArgs bringMenu = bringMenuArgs def
-- | Pops open a dmenu with window titles. Choose one, and it will be
-- dragged, kicking and screaming, into your current workspace. This version
-- accepts a configuration object.
bringMenuConfig :: WindowBringerConfig -> X ()
bringMenuConfig wbConfig = actionMenu wbConfig bringWindow
-- | Pops open a dmenu with window titles. Choose one, and it will be -- | Pops open a dmenu with window titles. Choose one, and it will be
-- dragged, kicking and screaming, into your current workspace. This version -- dragged, kicking and screaming, into your current workspace. This version
-- takes a list of arguments to pass to dmenu. -- takes a list of arguments to pass to dmenu.
bringMenuArgs :: [String] -> X () bringMenuArgs :: [String] -> X ()
bringMenuArgs menuArgs = bringMenuArgs' defaultCmd menuArgs bringMenuArgs args = bringMenuConfig def { menuArgs = args }
-- | Pops open an application with window titles given over stdin. Choose one, -- | Pops open an application with window titles given over stdin. Choose one,
-- and it will be dragged, kicking and screaming, into your current -- and it will be dragged, kicking and screaming, into your current
-- workspace. -- workspace.
bringMenu' :: String -> X () bringMenu' :: String -> X ()
bringMenu' menuCmd = bringMenuArgs' menuCmd [] bringMenu' cmd = bringMenuConfig def { menuArgs = [], menuCommand = cmd }
-- | Pops open an application with window titles given over stdin. Choose one, -- | Pops open an application with window titles given over stdin. Choose one,
-- and it will be dragged, kicking and screaming, into your current -- and it will be dragged, kicking and screaming, into your current
-- workspace. This version allows arguments to the chooser to be specified. -- workspace. This version allows arguments to the chooser to be specified.
bringMenuArgs' :: String -> [String] -> X () bringMenuArgs' :: String -> [String] -> X ()
bringMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs bringWindow bringMenuArgs' cmd args = bringMenuConfig def { menuArgs = args, menuCommand = cmd }
-- | Brings the specified window into the current workspace. -- | Brings the specified window into the current workspace.
bringWindow :: Window -> X.WindowSet -> X.WindowSet bringWindow :: Window -> X.WindowSet -> X.WindowSet
@@ -104,24 +122,33 @@ bringWindow w ws = W.shiftWin (W.currentTag ws) w ws
-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action -- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
-- if found. -- if found.
actionMenu :: String -> [String] -> (Window -> X.WindowSet -> X.WindowSet) -> X () actionMenu :: WindowBringerConfig -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
actionMenu menuCmd menuArgs action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action) actionMenu WindowBringerConfig{ menuCommand = cmd
, menuArgs = args
, windowTitler = titler
} action
= windowMap' titler >>= menuMapFunction >>= flip X.whenJust (windows . action)
where where
menuMapFunction :: M.Map String a -> X (Maybe a) menuMapFunction :: M.Map String a -> X (Maybe a)
menuMapFunction selectionMap = menuMapArgs menuCmd menuArgs selectionMap menuMapFunction = menuMapArgs cmd args
-- | A map from window names to Windows. -- | A map from window names to Windows.
windowMap :: X (M.Map String Window) windowMap :: X (M.Map String Window)
windowMap = do windowMap = windowMap' decorateName
-- | A map from window names to Windows, given a windowTitler function.
windowMap' :: (X.WindowSpace -> Window -> X String) -> X (M.Map String Window)
windowMap' titler = do
ws <- gets X.windowset ws <- gets X.windowset
M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws) M.fromList . concat <$> mapM keyValuePairs (W.workspaces ws)
where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws) where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
keyValuePair ws w = flip (,) w `fmap` decorateName ws w keyValuePair ws w = flip (,) w <$> titler ws w
-- | Returns the window name as will be listed in dmenu. -- | Returns the window name as will be listed in dmenu.
-- Tagged with the workspace ID, to guarantee uniqueness, and to let the user -- Tagged with the workspace ID, to guarantee uniqueness, and to let the user
-- know where he's going. -- know where he's going.
decorateName :: X.WindowSpace -> Window -> X String decorateName :: X.WindowSpace -> Window -> X String
decorateName ws w = do decorateName ws w = do
name <- fmap show $ getName w name <- show <$> getName w
return $ name ++ " [" ++ W.tag ws ++ "]" return $ name ++ " [" ++ W.tag ws ++ "]"

View File

@@ -25,6 +25,8 @@ module XMonad.Actions.WorkspaceNames (
renameWorkspace, renameWorkspace,
workspaceNamesPP, workspaceNamesPP,
getWorkspaceNames, getWorkspaceNames,
getWorkspaceName,
getCurrentWorkspaceName,
setWorkspaceName, setWorkspaceName,
setCurrentWorkspaceName, setCurrentWorkspaceName,
@@ -97,6 +99,17 @@ getWorkspaceNames = do
Nothing -> wks Nothing -> wks
Just s -> wks ++ ":" ++ s Just s -> wks ++ ":" ++ s
-- | Gets the name of a workspace, if set, otherwise returns nothing.
getWorkspaceName :: WorkspaceId -> X (Maybe String)
getWorkspaceName w = do
WorkspaceNames m <- XS.get
return $ M.lookup w m
-- | Gets the name of the current workspace. See 'getWorkspaceName'
getCurrentWorkspaceName :: X (Maybe String)
getCurrentWorkspaceName = do
getWorkspaceName =<< gets (W.currentTag . windowset)
-- | Sets the name of a workspace. Empty string makes the workspace unnamed -- | Sets the name of a workspace. Empty string makes the workspace unnamed
-- again. -- again.
setWorkspaceName :: WorkspaceId -> String -> X () setWorkspaceName :: WorkspaceId -> String -> X ()

View File

@@ -180,8 +180,7 @@ bluetileManageHook :: ManageHook
bluetileManageHook = composeAll bluetileManageHook = composeAll
[ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons) [ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons)
, className =? "MPlayer" --> doFloat , className =? "MPlayer" --> doFloat
, isFullscreen --> doFullFloat , isFullscreen --> doFullFloat]
, manageDocks]
bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ ( bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
named "Floating" floating ||| named "Floating" floating |||
@@ -199,6 +198,7 @@ bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l
bluetileConfig = bluetileConfig =
docks $
def def
{ modMask = mod4Mask, -- logo key { modMask = mod4Mask, -- logo key
manageHook = bluetileManageHook, manageHook = bluetileManageHook,

View File

@@ -164,11 +164,9 @@ import qualified Data.Map as M
-- > adjustEventInput -- > adjustEventInput
-- --
desktopConfig = ewmh def desktopConfig = docks $ ewmh def
{ startupHook = setDefaultCursor xC_left_ptr <+> docksStartupHook <+> startupHook def { startupHook = setDefaultCursor xC_left_ptr <+> startupHook def
, layoutHook = desktopLayoutModifiers $ layoutHook def , layoutHook = desktopLayoutModifiers $ layoutHook def
, manageHook = manageDocks <+> manageHook def
, handleEventHook = docksEventHook <+> handleEventHook def
, keys = desktopKeys <+> keys def } , keys = desktopKeys <+> keys def }
desktopKeys (XConfig {modMask = modm}) = M.fromList $ desktopKeys (XConfig {modMask = modm}) = M.fromList $

View File

@@ -205,7 +205,7 @@ instance PPrint ScreenId
instance (Show a, Show b) => PPrint (Map a b) instance (Show a, Show b) => PPrint (Map a b)
-- }}} -- }}}
-- main {{{ -- main {{{
dmwitConfig nScreens = def { dmwitConfig nScreens = docks $ def {
borderWidth = 2, borderWidth = 2,
workspaces = withScreens nScreens (map show [1..5]), workspaces = withScreens nScreens (map show [1..5]),
terminal = "urxvt", terminal = "urxvt",
@@ -221,7 +221,6 @@ dmwitConfig nScreens = def {
<+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169) <+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)
<+> fullscreenMPlayer <+> fullscreenMPlayer
<+> floatAll ["Gimp", "Wine"] <+> floatAll ["Gimp", "Wine"]
<+> manageDocks
<+> manageSpawn, <+> manageSpawn,
logHook = allPPs nScreens, logHook = allPPs nScreens,
startupHook = refresh startupHook = refresh

View File

@@ -42,7 +42,7 @@ import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ), import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),
Direction1D( Prev, Next) ) Direction1D( Prev, Next) )
import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks ) import XMonad.Hooks.ManageDocks ( avoidStruts, docks )
import XMonad.Hooks.EwmhDesktops ( ewmh ) import XMonad.Hooks.EwmhDesktops ( ewmh )
myXPConfig :: XPConfig myXPConfig :: XPConfig
@@ -117,7 +117,7 @@ keys x = M.fromList $
++ ++
zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
config = ewmh def config = docks $ ewmh def
{ borderWidth = 1 -- Width of the window border in pixels. { borderWidth = 1 -- Width of the window border in pixels.
, XMonad.workspaces = ["mutt","iceweasel"] , XMonad.workspaces = ["mutt","iceweasel"]
, layoutHook = showWName $ workspaceDir "~" $ , layoutHook = showWName $ workspaceDir "~" $
@@ -129,7 +129,6 @@ config = ewmh def
named "widescreen" ((mytab *||* mytab) named "widescreen" ((mytab *||* mytab)
****//* combineTwo Square mytab mytab) -- ||| ****//* combineTwo Square mytab mytab) -- |||
--mosaic 0.25 0.5 --mosaic 0.25 0.5
, manageHook = manageHook def <+> manageDocks -- add panel-handling
, terminal = "xterm" -- The preferred terminal program. , terminal = "xterm" -- The preferred terminal program.
, normalBorderColor = "#222222" -- Border color for unfocused windows. , normalBorderColor = "#222222" -- Border color for unfocused windows.
, focusedBorderColor = "#00ff00" -- Border color for focused windows. , focusedBorderColor = "#00ff00" -- Border color for focused windows.

View File

@@ -21,7 +21,7 @@ import XMonad.Layout.TwoPane
import qualified Data.Map as M import qualified Data.Map as M
sjanssenConfig = sjanssenConfig =
ewmh $ def docks $ ewmh $ def
{ terminal = "exec urxvt" { terminal = "exec urxvt"
, workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int] , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
, mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $ , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
@@ -35,7 +35,7 @@ sjanssenConfig =
| (x, w) <- [ ("Firefox", "web") | (x, w) <- [ ("Firefox", "web")
, ("Ktorrent", "7") , ("Ktorrent", "7")
, ("Amarokapp", "7")]] , ("Amarokapp", "7")]]
<+> manageHook def <+> manageDocks <+> manageSpawn <+> manageHook def <+> manageSpawn
<+> (isFullscreen --> doFullFloat) <+> (isFullscreen --> doFullFloat)
, startupHook = mapM_ spawnOnce spawns , startupHook = mapM_ spawnOnce spawns
} }

View File

@@ -199,12 +199,11 @@ statusBar :: LayoutClass l Window
-> IO (XConfig (ModifiedLayout AvoidStruts l)) -> IO (XConfig (ModifiedLayout AvoidStruts l))
statusBar cmd pp k conf = do statusBar cmd pp k conf = do
h <- spawnPipe cmd h <- spawnPipe cmd
return $ conf return $ docks $ conf
{ layoutHook = avoidStruts (layoutHook conf) { layoutHook = avoidStruts (layoutHook conf)
, logHook = do , logHook = do
logHook conf logHook conf
dynamicLogWithPP pp { ppOutput = hPutStrLn h } dynamicLogWithPP pp { ppOutput = hPutStrLn h }
, manageHook = manageHook conf <+> manageDocks
, keys = liftM2 M.union keys' (keys conf) , keys = liftM2 M.union keys' (keys conf)
} }
where where

View File

@@ -47,7 +47,7 @@ import XMonad.Util.WindowProperties (getProp32)
-- > main = xmonad $ ewmh def{ handleEventHook = -- > main = xmonad $ ewmh def{ handleEventHook =
-- > handleEventHook def <+> fullscreenEventHook } -- > handleEventHook def <+> fullscreenEventHook }
-- --
-- You may also be interested in 'avoidStruts' from "XMonad.Hooks.ManageDocks". -- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks".
-- | Add EWMH functionality to the given config. See above for an example. -- | Add EWMH functionality to the given config. See above for an example.

View File

@@ -15,7 +15,7 @@
module XMonad.Hooks.ManageDocks ( module XMonad.Hooks.ManageDocks (
-- * Usage -- * Usage
-- $usage -- $usage
manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn, docks, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
docksEventHook, docksStartupHook, docksEventHook, docksStartupHook,
ToggleStruts(..), ToggleStruts(..),
SetStruts(..), SetStruts(..),
@@ -28,7 +28,7 @@ module XMonad.Hooks.ManageDocks (
#endif #endif
-- for XMonad.Actions.FloatSnap -- for XMonad.Actions.FloatSnap
calcGap, calcGapForAll calcGap
) where ) where
@@ -39,12 +39,12 @@ import XMonad.Layout.LayoutModifier
import XMonad.Util.Types import XMonad.Util.Types
import XMonad.Util.WindowProperties (getProp32s) import XMonad.Util.WindowProperties (getProp32s)
import XMonad.Util.XUtils (fi) import XMonad.Util.XUtils (fi)
import qualified XMonad.Util.ExtensibleState as XS
import Data.Monoid (All(..), mempty) import Data.Monoid (All(..), mempty)
import Data.Functor((<$>)) import Data.Functor((<$>))
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Control.Monad (when, forM_, filterM) import Control.Monad (when, forM_, filterM)
-- $usage -- $usage
@@ -52,25 +52,16 @@ import Control.Monad (when, forM_, filterM)
-- --
-- > import XMonad.Hooks.ManageDocks -- > import XMonad.Hooks.ManageDocks
-- --
-- The first component is a 'ManageHook' which recognizes these -- Wrap your xmonad config with a call to 'docks', like so:
-- windows and de-manages them, so that xmonad does not try to tile
-- them. To enable it:
-- --
-- > manageHook = ... <+> manageDocks -- > main = xmonad $ docks def
-- --
-- The second component is a layout modifier that prevents windows -- Then add 'avoidStruts' or 'avoidStrutsOn' layout modifier to your layout
-- from overlapping these dock windows. It is intended to replace -- to prevent windows from overlapping these windows.
-- xmonad's so-called \"gap\" support. First, you must add it to your
-- list of layouts:
-- --
-- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...) -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)
-- > where tall = Tall 1 (3/100) (1/2) -- > where tall = Tall 1 (3/100) (1/2)
-- --
-- The third component is an event hook that causes new docks to appear
-- immediately, instead of waiting for the next focus change.
--
-- > handleEventHook = ... <+> docksEventHook
--
-- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding -- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding
-- similar to: -- similar to:
-- --
@@ -90,17 +81,36 @@ import Control.Monad (when, forM_, filterM)
-- --
-- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...) -- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...)
-- --
-- /Important note/: if you are switching from manual gaps
-- (defaultGaps in your config) to avoidStruts (recommended, since
-- manual gaps will probably be phased out soon), be sure to switch
-- off all your gaps (with mod-b) /before/ reloading your config with
-- avoidStruts! Toggling struts with a 'ToggleStruts' message will
-- not work unless your gaps are set to zero.
--
-- For detailed instructions on editing your key bindings, see -- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings". -- "XMonad.Doc.Extending#Editing_key_bindings".
-- --
-- | Add docks functionality to the given config. See above for an example.
docks :: XConfig a -> XConfig a
docks c = c { startupHook = docksStartupHook <+> startupHook c
, handleEventHook = docksEventHook <+> handleEventHook c
, manageHook = manageDocks <+> manageHook c }
newtype StrutCache = StrutCache { fromStrutCache :: M.Map Window [Strut] }
deriving (Eq, Typeable)
data UpdateDocks = UpdateDocks deriving Typeable
instance Message UpdateDocks
refreshDocks :: X ()
refreshDocks = sendMessage UpdateDocks
instance ExtensionClass StrutCache where
initialValue = StrutCache M.empty
updateStrutCache :: Window -> [Strut] -> X Bool
updateStrutCache w strut = do
XS.modified $ StrutCache . M.insert w strut . fromStrutCache
deleteFromStructCache :: Window -> X Bool
deleteFromStructCache w = do
XS.modified $ StrutCache . M.delete w . fromStrutCache
-- | Detects if the given window is of type DOCK and if so, reveals -- | Detects if the given window is of type DOCK and if so, reveals
-- it, but does not manage it. -- it, but does not manage it.
manageDocks :: ManageHook manageDocks :: ManageHook
@@ -125,9 +135,8 @@ checkDock = ask >>= \w -> liftX $ do
docksEventHook :: Event -> X All docksEventHook :: Event -> X All
docksEventHook (MapNotifyEvent { ev_window = w }) = do docksEventHook (MapNotifyEvent { ev_window = w }) = do
whenX (runQuery checkDock w <&&> (not <$> isClient w)) $ do whenX (runQuery checkDock w <&&> (not <$> isClient w)) $ do
strut <- getRawStrut w strut <- getStrut w
sendMessage $ UpdateDock w strut whenX (updateStrutCache w strut) refreshDocks
broadcastMessage $ UpdateDock w strut
return (All True) return (All True)
docksEventHook (PropertyEvent { ev_window = w docksEventHook (PropertyEvent { ev_window = w
, ev_atom = a }) = do , ev_atom = a }) = do
@@ -135,13 +144,11 @@ docksEventHook (PropertyEvent { ev_window = w
nws <- getAtom "_NET_WM_STRUT" nws <- getAtom "_NET_WM_STRUT"
nwsp <- getAtom "_NET_WM_STRUT_PARTIAL" nwsp <- getAtom "_NET_WM_STRUT_PARTIAL"
when (a == nws || a == nwsp) $ do when (a == nws || a == nwsp) $ do
strut <- getRawStrut w strut <- getStrut w
broadcastMessage $ UpdateDock w strut whenX (updateStrutCache w strut) refreshDocks
refresh
return (All True) return (All True)
docksEventHook (DestroyWindowEvent {ev_window = w}) = do docksEventHook (DestroyWindowEvent {ev_window = w}) = do
sendMessage (RemoveDock w) whenX (deleteFromStructCache w) refreshDocks
broadcastMessage (RemoveDock w)
return (All True) return (All True)
docksEventHook _ = return (All True) docksEventHook _ = return (All True)
@@ -151,23 +158,9 @@ docksStartupHook = withDisplay $ \dpy -> do
(_,_,wins) <- io $ queryTree dpy rootw (_,_,wins) <- io $ queryTree dpy rootw
docks <- filterM (runQuery checkDock) wins docks <- filterM (runQuery checkDock) wins
forM_ docks $ \win -> do forM_ docks $ \win -> do
strut <- getRawStrut win strut <- getStrut win
broadcastMessage (UpdateDock win strut) updateStrutCache win strut
refresh refreshDocks
getRawStrut :: Window -> X (Maybe (Either [CLong] [CLong]))
getRawStrut w = do
msp <- fromMaybe [] <$> getProp32s "_NET_WM_STRUT_PARTIAL" w
if null msp
then do
mp <- fromMaybe [] <$> getProp32s "_NET_WM_STRUT" w
if null mp then return Nothing
else return $ Just (Left mp)
else return $ Just (Right msp)
getRawStruts :: [Window] -> X (M.Map Window (Maybe (Either [CLong] [CLong])))
getRawStruts wins = M.fromList <$> zip wins <$> mapM getRawStrut wins
-- | Gets the STRUT config, if present, in xmonad gap order -- | Gets the STRUT config, if present, in xmonad gap order
getStrut :: Window -> X [Strut] getStrut :: Window -> X [Strut]
@@ -185,18 +178,12 @@ getStrut w = do
[(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)] [(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)]
parseStrutPartial _ = [] parseStrutPartial _ = []
calcGapForAll :: S.Set Direction2D -> X (Rectangle -> Rectangle)
calcGapForAll ss = withDisplay $ \dpy -> do
rootw <- asks theRoot
(_,_,wins) <- io $ queryTree dpy rootw
calcGap wins ss
-- | 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 :: [Window] -> S.Set Direction2D -> X (Rectangle -> Rectangle) calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
calcGap wins ss = withDisplay $ \dpy -> do calcGap ss = withDisplay $ \dpy -> do
rootw <- asks theRoot rootw <- asks theRoot
struts <- (filter careAbout . concat) `fmap` mapM getStrut wins struts <- (filter careAbout . concat) `fmap` XS.gets (M.elems . fromStrutCache)
-- we grab the window attributes of the root window rather than checking -- we grab the window attributes of the root window rather than checking
-- the width of the screen because xlib caches this info and it tends to -- the width of the screen because xlib caches this info and it tends to
@@ -218,13 +205,9 @@ avoidStrutsOn :: LayoutClass l a =>
[Direction2D] [Direction2D]
-> l a -> l a
-> ModifiedLayout AvoidStruts l a -> ModifiedLayout AvoidStruts l a
avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) Nothing M.empty avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss)
data AvoidStruts a = AvoidStruts { data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )
avoidStrutsDirection :: S.Set Direction2D,
avoidStrutsRectCache :: Maybe (S.Set Direction2D, Rectangle, Rectangle),
strutMap :: M.Map Window (Maybe (Either [CLong] [CLong]))
} 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.
@@ -234,15 +217,6 @@ data ToggleStruts = ToggleStruts
instance Message ToggleStruts instance Message ToggleStruts
-- | message sent to ensure that caching the gaps won't give a wrong result
-- because a new dock has been added
data DockMessage = UpdateDock Window (Maybe (Either [CLong] [CLong]))
| RemoveDock Window
deriving (Read,Show,Typeable)
instance Message DockMessage
-- | SetStruts is a message constructor used to set or unset specific struts, -- | 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 -- regardless of whether or not the struts were originally set. Here are some
-- example bindings: -- example bindings:
@@ -270,44 +244,18 @@ data SetStruts = SetStruts { addedStruts :: [Direction2D]
instance Message SetStruts instance Message SetStruts
instance LayoutModifier AvoidStruts a where instance LayoutModifier AvoidStruts a where
modifyLayoutWithUpdate as@(AvoidStruts ss cache smap) w r = do modifyLayout (AvoidStruts ss) w r = do
let dockWins = M.keys smap srect <- fmap ($ r) (calcGap ss)
(nr, nsmap) <- case cache of setWorkarea srect
Just (ss', r', nr) | ss' == ss, r' == r -> do runLayout w srect
nsmap <- getRawStruts dockWins
if nsmap /= smap
then do
wnr <- fmap ($ r) (calcGap dockWins ss)
setWorkarea wnr
return (wnr, nsmap)
else do
return (nr, smap)
_ -> do
nsset <- getRawStruts dockWins
nr <- fmap ($ r) (calcGap dockWins ss)
setWorkarea nr
return (nr, nsset)
arranged <- runLayout w nr
let newCache = Just (ss, r, nr)
return (arranged, if newCache == cache && smap == nsmap
then Nothing
else Just as { avoidStrutsRectCache = newCache
, strutMap = nsmap })
pureMess as@(AvoidStruts { avoidStrutsDirection = ss, strutMap = sm }) m pureMess as@(AvoidStruts ss) m
| Just ToggleStruts <- fromMessage m = Just $ as { avoidStrutsDirection = toggleAll ss } | Just ToggleStruts <- fromMessage m = Just $ AvoidStruts (toggleAll ss)
| Just (ToggleStrut s) <- fromMessage m = Just $ as { avoidStrutsDirection = toggleOne s ss } | Just (ToggleStrut s) <- fromMessage m = Just $ AvoidStruts (toggleOne s ss)
| Just (SetStruts n k) <- fromMessage m | Just (SetStruts n k) <- fromMessage m
, let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k) , let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k)
, newSS /= ss = Just $ as { avoidStrutsDirection = newSS } , newSS /= ss = Just $ AvoidStruts newSS
| Just (UpdateDock dock strut) <- fromMessage m = if maybe True (/= strut) (M.lookup dock sm) | Just UpdateDocks <- fromMessage m = Just as
then Just $ as { avoidStrutsRectCache = Nothing
, strutMap = M.insert dock strut sm }
else Nothing
| Just (RemoveDock dock) <- fromMessage m = if M.member dock sm
then Just $ as { avoidStrutsRectCache = Nothing
, strutMap = M.delete dock sm }
else Nothing
| otherwise = Nothing | otherwise = Nothing
where toggleAll x | S.null x = S.fromList [minBound .. maxBound] where toggleAll x | S.null x = S.fromList [minBound .. maxBound]
| otherwise = S.empty | otherwise = S.empty

View File

@@ -88,7 +88,7 @@ positionStoreInit mDecoTheme w = withDisplay $ \d -> do
else do else do
sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
let sr = screenRect . W.screenDetail $ sc let sr = screenRect . W.screenDetail $ sc
sr' <- fmap ($ sr) (calcGapForAll $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting
-- a somewhat unfortunate inter-dependency -- a somewhat unfortunate inter-dependency
-- with 'XMonad.Hooks.ManageDocks' -- with 'XMonad.Hooks.ManageDocks'
modifyPosStore (\ps -> posStoreInsert ps w modifyPosStore (\ps -> posStoreInsert ps w

View File

@@ -106,8 +106,8 @@ handleScreenCrossing w decoWin = withDisplay $ \d -> do
{-- somewhat ugly hack to get proper ScreenRect, {-- somewhat ugly hack to get proper ScreenRect,
creates unwanted inter-dependencies creates unwanted inter-dependencies
TODO: get ScreenRects in a proper way --} TODO: get ScreenRects in a proper way --}
oldScreenRect' <- fmap ($ oldScreenRect) (calcGapForAll $ S.fromList [minBound .. maxBound]) oldScreenRect' <- fmap ($ oldScreenRect) (calcGap $ S.fromList [minBound .. maxBound])
newScreenRect' <- fmap ($ newScreenRect) (calcGapForAll $ S.fromList [minBound .. maxBound]) newScreenRect' <- fmap ($ newScreenRect) (calcGap $ S.fromList [minBound .. maxBound])
wa <- io $ getWindowAttributes d decoWin wa <- io $ getWindowAttributes d decoWin
modifyPosStore (\ps -> modifyPosStore (\ps ->
posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa) posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa)

View File

@@ -21,6 +21,7 @@ module XMonad.Util.ExtensibleState (
, remove , remove
, get , get
, gets , gets
, modified
) where ) where
import Data.Typeable (typeOf,cast) import Data.Typeable (typeOf,cast)
@@ -115,3 +116,10 @@ gets = flip fmap get
-- | Remove the value from the extensible state field that has the same type as the supplied argument -- | Remove the value from the extensible state field that has the same type as the supplied argument
remove :: ExtensionClass a => a -> X () remove :: ExtensionClass a => a -> X ()
remove wit = modifyStateExts $ M.delete (show . typeOf $ wit) remove wit = modifyStateExts $ M.delete (show . typeOf $ wit)
modified :: (ExtensionClass a, Eq a) => (a -> a) -> X Bool
modified f = do
v <- get
case f v of
v' | v' == v -> return False
| otherwise -> put v' >> return True