[xmonad] better combineTwoP and Property
proxym
wproxym at gmail.com
Thu Apr 7 22:15:15 CEST 2011
I modified combineTwoP and Property.
http://hpaste.org/45435/combinetwoqb
New name is combineTwoQB
Now windows use full screen space always! (It was bug in combineTwoP,
when all windows are in one pane only)
Now you can use IsDialog property to detect dialog windows.
Version with simplified config: http://hpaste.org/45439/combinetwoqb
data Property = Title String
| ClassName String
| Resource String
| Role String -- ^ WM_WINDOW_ROLE property
| Machine String -- ^ WM_CLIENT_MACHINE property
| And Property Property
| Or Property Property
| Not Property
| IsDialog -- ^^^^^ _NET_WM_WINDOW_TYPE _NET_WM_WINDOW_TYPE_DIALOG
| AtomProperty String String
| Const Bool
deriving (Read, Show)
infixr 9 `And`
infixr 8 `Or`
-- | Does given window have this property?
hasProperty :: Property -> Window -> X Bool
hasProperty (Title s) w = withDisplay $ \d -> fmap (Just s ==) $ io $ fetchName d w
hasProperty (Resource s) w = withDisplay $ \d -> fmap ((==) s . resName ) $ io $ getClassHint d w
hasProperty (ClassName s) w = withDisplay $ \d -> fmap ((==) s . resClass) $ io $ getClassHint d w
hasProperty (Role s) w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_WINDOW_ROLE"
hasProperty (Machine s) w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_CLIENT_MACHINE"
hasProperty (IsDialog) w = hasProperty (AtomProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG") w
hasProperty (AtomProperty sKey sValue) w = withDisplay $ \d -> checkAtomProperty d w sKey sValue
hasProperty (And p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 && r2 }
hasProperty (Or p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 || r2 }
hasProperty (Not p1) w = do { r1 <- hasProperty p1 w; return $ not r1 }
hasProperty (Const b) _ = return b
-- | Does the focused window have this property?
focusedHasProperty :: Property -> X Bool
focusedHasProperty p = do
ws <- gets windowset
let ms = W.stack $ W.workspace $ W.current ws
case ms of
Just s -> hasProperty p $ W.focus s
Nothing -> return False
-- | Find all existing windows with specified property
allWithProperty :: Property -> X [Window]
allWithProperty prop = withDisplay $ \dpy -> do
rootw <- asks theRoot
(_,_,wins) <- io $ queryTree dpy rootw
hasProperty prop `filterM` wins
-- | Convert property to 'Query' 'Bool' (see "XMonad.ManageHook")
propertyToQuery :: Property -> Query Bool
propertyToQuery (Title s) = title =? s
propertyToQuery (Resource s) = resource =? s
propertyToQuery (ClassName s) = className =? s
propertyToQuery (Role s) = stringProperty "WM_WINDOW_ROLE" =? s
propertyToQuery (Machine s) = stringProperty "WM_CLIENT_MACHINE" =? s
propertyToQuery (IsDialog) = propertyToQuery (AtomProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG")
propertyToQuery (AtomProperty k v) = (ask >>= (\w -> liftX $ withDisplay $ \d -> checkAtomProperty d w k v)) =? True
propertyToQuery (And p1 p2) = propertyToQuery p1 <&&> propertyToQuery p2
propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2
propertyToQuery (Not p) = not `fmap` propertyToQuery p
propertyToQuery (Const b) = return b
-- $helpers
-- | Get a window property from atom
getProp32 :: Atom -> Window -> X (Maybe [CLong])
getProp32 a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w
-- | Get a window property from string
getProp32s :: String -> Window -> X (Maybe [CLong])
getProp32s str w = do { a <- getAtom str; getProp32 a w }
checkAtomProperty d w sKey sValue = do
sk <- getAtom sKey
sv <- getAtom sValue
md <- io $ getWindowProperty32 d sk w
case md of
Just mm -> if (fromIntegral sv `elem` mm)
then
return True
else
return False
_ ->return False
data SwapWindow = SwapWindow -- ^ Swap window between panes
| SwapWindowN Int -- ^ Swap window between panes in the N-th nested ComboP. @SwapWindowN 0@ equals to SwapWindow
deriving (Read, Show, Typeable)
instance Message SwapWindow
data CombineTwoQB l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property
deriving (Read, Show)
combineTwoQB :: (LayoutClass super(), LayoutClass l1 Window, LayoutClass l2 Window) =>
super () -> l1 Window -> l2 Window -> Property -> CombineTwoQB (super ()) l1 l2 Window
combineTwoQB = C2P [] [] []
instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
LayoutClass (CombineTwoQB (l ()) l1 l2) Window where
doLayout (C2P f w1 w2 super l1 l2 prop) rinput s =
let origws = W.integrate s -- passed in windows
w1c = origws `intersect` w1 -- current windows in the first pane
w2c = origws `intersect` w2 -- current windows in the second pane
new = origws \\ (w1c ++ w2c) -- new windows
superstack = Just Stack { W.focus=(), up=[], down=[()] }
f' = W.focus s:delete (W.focus s) f -- list of focused windows, contains 2 elements at most
in do
matching <- (hasProperty prop) `filterM` new -- new windows matching predecate
let w1' = w1c ++ (new \\ matching) -- updated first pane windows
w2' = w2c ++ matching -- updated second pane windows
s1 = differentiate f' w1' -- first pane stack
s2 = differentiate f' w2' -- second pane stack
if not (null w1' || null w2')
then do
([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput
(wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
(wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
(return (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2') prop))
else case (w1' ++ w2') of
[] -> do
l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id `fmap` handleMessage super (SomeMessage ReleaseResources)
(return ([], Just $ C2P [] [] [] super' l1' l2' prop))
[w] -> do
l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id `fmap` handleMessage super (SomeMessage ReleaseResources)
(return ([(w,rinput)], Just $ C2P [w] [w] [] super' l1' l2' prop))
ww -> do
([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput
(wrs1, ml1') <- runLayout (Workspace "" l1 s1) rinput
(wrs2, ml2') <- runLayout (Workspace "" l2 s2) rinput
(return (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2') prop))
handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m
| Just SwapWindow <- fromMessage m = swap us
| Just (SwapWindowN 0) <- fromMessage m = swap us
| Just (SwapWindowN n) <- fromMessage m = forwardToFocused us $ SomeMessage $ SwapWindowN $ n-1
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `elem` ws1,
w2 `elem` ws2 = return $ Just $ C2P f (delete w1 ws1) (w1:ws2) super l1 l2 prop
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `elem` ws2,
w2 `elem` ws1 = return $ Just $ C2P f (w1:ws1) (delete w1 ws2) super l1 l2 prop
| otherwise = do ml1' <- handleMessage l1 m
ml2' <- handleMessage l2 m
msuper' <- handleMessage super m
if isJust msuper' || isJust ml1' || isJust ml2'
then return $ Just $ C2P f ws1 ws2
(maybe super id msuper')
(maybe l1 id ml1')
(maybe l2 id ml2') prop
else return Nothing
description (C2P _ _ _ super l1 l2 prop) = "CC0" --"combining " ++ description l1 ++ " and " ++ description l2 ++ " with " ++ description super ++ " using "++ (show prop)
-- send focused window to the other pane. Does nothing if we don't
-- own the focused window
swap :: (LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) =>
CombineTwoQB (s a) l1 l2 Window -> X (Maybe (CombineTwoQB (s a) l1 l2 Window))
swap (C2P f ws1 ws2 super l1 l2 prop) = do
mst <- gets (W.stack . W.workspace . W.current . windowset)
let (ws1', ws2') = case mst of
Nothing -> (ws1, ws2)
Just st -> if foc `elem` ws1
then (foc `delete` ws1, foc:ws2)
else if foc `elem` ws2
then (foc:ws1, foc `delete` ws2)
else (ws1, ws2)
where foc = W.focus st
if (ws1,ws2) == (ws1',ws2')
then return Nothing
else return $ Just $ C2P f ws1' ws2' super l1 l2 prop
-- forwards the message to the sublayout which contains the focused window
forwardToFocused :: (LayoutClass l1 Window, LayoutClass l2 Window, LayoutClass s a) =>
CombineTwoQB (s a) l1 l2 Window -> SomeMessage -> X (Maybe (CombineTwoQB (s a) l1 l2 Window))
forwardToFocused (C2P f ws1 ws2 super l1 l2 prop) m = do
ml1 <- forwardIfFocused l1 ws1 m
ml2 <- forwardIfFocused l2 ws2 m
ms <- if isJust ml1 || isJust ml2
then return Nothing
else handleMessage super m
if isJust ml1 || isJust ml2 || isJust ms
then return $ Just $ C2P f ws1 ws2 (maybe super id ms) (maybe l1 id ml1) (maybe l2 id ml2) prop
else return Nothing
-- forwards message m to layout l if focused window is among w
forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessage -> X (Maybe (l Window))
forwardIfFocused l w m = do
mst <- gets (W.stack . W.workspace . W.current . windowset)
maybe (return Nothing) send mst where
send st = if (W.focus st) `elem` w
then handleMessage l m
else return Nothing
-- code from CombineTwo
-- given two sets of zs and xs takes the first z from zs that also belongs to xs
-- and turns xs into a stack with z being current element. Acts as
-- StackSet.differentiate if zs and xs don't intersect
differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate (z:zs) xs | z `elem` xs = Just $ Stack { W.focus=z
, up = reverse $ takeWhile (/=z) xs
, down = tail $ dropWhile (/=z) xs }
| otherwise = differentiate zs xs
differentiate [] xs = W.differentiate xs
myManageHook0 = composeAll
-- help1: run: xprop | grep WM_CLASS
-- help2: run: xprop | egrep "CLASS|NAME"
[ -- manage hooks
appName =? "gimp" --> doFloat
, isFullscreen --> doFullFloat -------for flash in ff
-------, isDialog --> doCenterFloat
------------, isDialog --> doSink ---------------------------------------------------------------
-----, propertyToQuery (IsDialog) --> doSink
, propertyToQuery (myDialogs) --> doSink
]
--where moveTo = doF . W.shift
--where moveTo = doShift
where moveTo = doF . liftM2 (.) W.greedyView W.shift
--myManageHook = myManageHook0 <+> manageDocks <+> manageHook gnomeConfig
myManageHook = myManageHook0 <+> manageDocks <+> manageHook defaultConfig
doSink :: ManageHook
doSink = ask >>= \w -> liftX (reveal w) >> doF (W.sink w)
myTabbed0 = tabbed shrinkText defaultTheme
myTabbed = combineTwoQB (Mirror (Tall 1 (3/100) (3/5))) (myTabbed0) (myTabbed0) (myDialogs)
myDialogs = (IsDialog) `Or` (ClassName "Dialog") `Or` (ClassName "dialog") `Or` (ClassName "Toplevel") `Or` (ClassName "Chat") `Or` (ClassName "Message")
--myTabber is resulted layout. you must not import standard Property
-- to use my combineTwoQB
-- (i use xmonad 0.9)
--
Best regards, Michael
More information about the xmonad
mailing list