[xmonad] better combineTwoP and Property
proxym
wproxym at gmail.com
Thu Apr 7 22:29:33 CEST 2011
В Fri, 8 Apr 2011 00:15:15 +0400
proxym <wproxym at gmail.com> пишет:
> 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")
>
>
> --myTabbed is resulted layout. you must not import standard Property
> -- to use my combineTwoQB
> -- (i use xmonad 0.9)
>
http://postimage.org/image/j1991vr8/
http://postimage.org/image/j230q4n8/
http://postimage.org/image/1k3loxi78/
http://postimage.org/image/1k3yx8a5g/
http://postimage.org/image/j3ytrcw4/
--
Best regards, Michael
More information about the xmonad
mailing list