[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