From 195cfbe77ece162f0f7e5850467b9828d469ebbb Mon Sep 17 00:00:00 2001 From: sgf Date: Thu, 15 Dec 2016 21:53:23 +0300 Subject: [PATCH 01/16] Add new module XMonad.Hooks.Focus . Extend ManageHook EDSL to work on focused windows and current workspace. --- CHANGES.md | 13 + XMonad/Hooks/Focus.hs | 599 ++++++++++++++++++++++++++++++++++++++++++ xmonad-contrib.cabal | 1 + 3 files changed, 613 insertions(+) create mode 100644 XMonad/Hooks/Focus.hs diff --git a/CHANGES.md b/CHANGES.md index 259ae8e2..19dbdef0 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -48,6 +48,19 @@ submap key press. And terminate submap at button press in the same way, as we do for wrong key press. + * `XMonad.Hooks.Focus` + + A new module extending ManageHook EDSL to work on focused windows and + current workspace. + + This module will enable window activation (`_NET_ACTIVE_WINDOW`) and apply + `manageHook` to activated window too. Thus, it may lead to unexpected + results, when `manageHook` previously working only for new windows, start + working for activated windows too. It may be solved, by adding + `not <$> activated` before those part of `manageHook`, which should not be + called for activated windows. But this lifts `manageHook` into + `FocusHook` and it needs to be converted back later using `manageFocus`. + ### Minor Changes * `XMonad.Layout.LayoutBuilder` diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs new file mode 100644 index 00000000..305234d7 --- /dev/null +++ b/XMonad/Hooks/Focus.hs @@ -0,0 +1,599 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module: XMonad.Hooks.Focus +-- Description: Extend ManageHook EDSL for working on focused window +-- Copyright: sgf-dma, 2016 +-- Maintainer: sgf.dma@gmail.com +-- + +module XMonad.Hooks.Focus + ( + -- $main + + -- * FocusQuery. + -- + -- $focusquery + Focus (..) + , FocusLock (..) + , toggleLock + , NetActivated (..) + , FocusQuery + , runFocusQuery + , FocusHook + + -- * Lifting into FocusQuery. + -- + -- $lift + , liftQuery + , new + , focused + , focused' + , focusedOn + , focusedOn' + , focusedCur + , focusedCur' + , newOn + , newOnCur + , activated + , unlessFocusLock + + -- * Commonly used actions for modifying focus. + -- + -- $common + , keepFocus + , switchFocus + , keepWorkspace + , switchWorkspace + + -- * Running FocusQuery. + -- + -- $running + , manageFocus + , activateEventHook + , activateStartupHook + , handleFocusQuery + ) + where + +import Data.Maybe +import Data.Monoid +import Control.Applicative +import Control.Monad +import Control.Monad.Reader +import Control.Arrow hiding ((<+>)) + +import XMonad +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS +import XMonad.Hooks.ManageHelpers (currentWs) +import XMonad.Hooks.SetWMName +import XMonad.Util.EZConfig + + +-- $main +-- +-- This module provides monad on top of Query monad providing additional +-- information about new window: +-- +-- - workspace, where new window will appear; +-- - focused window on workspace, where new window will appear; +-- - current workspace; +-- +-- And two properties in extensible state: +-- +-- - is focus lock enabled? Focus lock instructs all library's 'FocusHook' +-- functions to not move focus. +-- - is new window @_NET_ACTIVE_WINDOW@ activated? It is not really new in +-- that case, but i may work with it in the same way. +-- +-- Lifting operations for standard 'ManageHook' EDSL combinators into +-- 'FocusQuery' monad allowing to run these combinators on focused window and +-- common actions for keeping focus and\/or workspace, switching focus and\/or +-- workspace are also provided. +-- +-- __/WARNING!/__ 'activateEventHook' (which handles window activation) will +-- use 'manageHook' for handling activated window. That means, actions, which +-- you don't want to happen on activated windows, should be guarded by +-- +-- > not <$> activated +-- +-- predicate. This requires to lift them into 'FocusHook' and then convert +-- back into 'ManageHook' using 'manageFocus'. +-- +-- __/WARNING!/__ Since this module enables and handles window activation on +-- its own, it is /not/ compatible with 'XMonad.Hooks.EwmhDesktops.ewmh' +-- function from 'XMonad.Hooks.EwmhDesktops' module. Well, it will compile and +-- work, but window activation handling according to 'FocusHook' won't work, +-- because 'XMonad.Hooks.EwmhDesktops.ewmh' handler will overwrite it. +-- +-- I may define 'FocusHook' like: +-- +-- > activateFocusHook :: FocusHook +-- > activateFocusHook = composeAll +-- > -- If 'gmrun' is focused on workspace, on which +-- > -- activated window is, keep focus unchanged. But i +-- > -- may still switch workspace. +-- > [ focused (className =? "Gmrun") +-- > --> keepFocus +-- > -- Default behavior for activated windows: switch +-- > -- workspace and focus. +-- > , return True --> switchWorkspace <+> switchFocus +-- > ] +-- > +-- > newFocusHook :: FocusHook +-- > newFocusHook = composeOne +-- > -- Always switch focus to 'gmrun'. +-- > [ new (className =? "Gmrun") -?> switchFocus +-- > -- And always keep focus on 'gmrun'. Note, that +-- > -- another 'gmrun' will steal focus from already +-- > -- running one. +-- > , focused (className =? "Gmrun") -?> keepFocus +-- > -- If firefox dialog prompt (e.g. master password +-- > -- prompt) is focused on current workspace and new +-- > -- window appears here too, keep focus unchanged +-- > -- (note, used predicates: @newOnCur <&&> focused@ is +-- > -- the same as @newOnCur <&&> focusedCur@, but is +-- > -- /not/ the same as just 'focusedCur' ) +-- > , newOnCur <&&> focused +-- > ((className =? "Iceweasel" <||> className =? "Firefox") <&&> isDialog) +-- > -?> keepFocus +-- > -- Default behavior for new windows: switch focus. +-- > , return True -?> switchFocus +-- > ] +-- +-- And then use it (paste definition of 'FocusHook' above there too) like: +-- +-- > import XMonad +-- > +-- > import XMonad.Hooks.ManageHelpers hiding ((-?>), composeOne) +-- > import XMonad.Hooks.Focus +-- > +-- > main :: IO () +-- > main = do +-- > let xcf = handleFocusQuery (Just (mod4Mask, xK_v)) (composeOne +-- > [ activated -?> activateFocusHook +-- > , Just <$> newFocusHook +-- > ]) +-- > $ def +-- > xmonad xcf +-- > +-- > composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a +-- > composeOne [] = return mempty +-- > composeOne (mx : xs) = do +-- > x <- mx +-- > case x of +-- > Just y -> return y +-- > Nothing -> composeOne xs +-- > +-- > infixr 0 -?> +-- > (-?>) :: Monad m => m Bool -> m a -> m (Maybe a) +-- > (-?>) mb mx = do +-- > b <- mb +-- > if b +-- > then Just <$> mx +-- > else return Nothing +-- +-- +-- Note: +-- +-- - /mod4Mask+v/ key toggles focus lock (when enabled, focus will not be +-- switched to new window). +-- - 'handleFocusQuery' will enable window activation. +-- - I need more generic 'XMonad.Hooks.ManageHelpers.-?>' and +-- 'XMonad.Hooks.ManageHelpers.composeOne', than in the +-- 'XMonad.Hooks.ManageHelpers'. +-- - The order, when constructing final 'FocusHook' in 'handleFocusQuery' +-- call: 'FocusHook' without 'activated' predicate will match to activated +-- windows too, thus i should place it after one with 'activated' (so the +-- latter will have a chance to handle activated window first). +-- +-- +-- And more technical notes: +-- +-- - 'FocusHook' will run /many/ times, so it usually should not keep state +-- or save results. Precisely, it may do anything, but it must be idempotent +-- to operate properly. +-- - 'FocusHook' will see new window at workspace, where functions on the +-- /right/ from 'handleFocusQuery' in 'ManageHook' monoid place it. In other +-- words, in @(Endo WindowSet)@ monoid i may see changes only from functions +-- applied /before/ (more to the right in function composition). Thus, it's +-- better to apply 'handleFocusQuery' the last. +-- - 'FocusHook' functions won't see window shift to another workspace made +-- by function from 'FocusHook' itself: new window workspace is determined +-- /before/ running 'FocusHook' and even if later one of 'FocusHook' +-- functions moves window to another workspace, predicates ('focused', +-- 'newOn', etc) will still think new window is at workspace it was before. +-- This can be worked around by splitting 'FocusHook' into several different +-- values and evaluating each one separately, like: +-- +-- > (FH2 -- manageFocus --> MH2) <+> (FH1 -- manageFocus --> MH1) <+> .. +-- +-- E.g. +-- +-- > manageFocus FH2 <+> manageFocus FH1 <+> .. +-- +-- now @FH2@ will see window shift made by @FH1@. +-- +-- - I may define my own 'handleFocusQuery', all required functions are +-- exported. I may redefine handling of activated windows too, but note: +-- 'handleEventHook' handling window activation should correctly set\/unset +-- 'NetActivated' in extensible state, like 'activateEventHook' does, and +-- usually there should be only one 'handleEventHook' processing activated +-- windows. +-- +-- Another interesting example is moving all activated windows to current +-- workspace by default, and applying 'FocusHook' after: +-- +-- > import XMonad +-- > import qualified XMonad.StackSet as W +-- > +-- > import XMonad.Hooks.ManageHelpers hiding ((-?>), composeOne) +-- > import XMonad.Hooks.Focus +-- > +-- > main :: IO () +-- > main = do +-- > let xcf = handleFocusQuery (Just (mod4Mask, xK_v)) (composeOne +-- > [ activated -?> (newOnCur --> keepFocus) +-- > , Just <$> newFocusHook +-- > ]) +-- > $ def +-- > { manageHook = manageFocus activateOnCurrentWs +-- > } +-- > xmonad xcf +-- > +-- > activateOnCurrentWs :: FocusHook +-- > activateOnCurrentWs = activated --> asks currentWorkspace >>= +-- > new . unlessFocusLock . doShift +-- > +-- > newFocusHook :: FocusHook +-- > newFocusHook = composeOne +-- > -- Always switch focus to 'gmrun'. +-- > [ new (className =? "Gmrun") -?> switchFocus +-- > -- And always keep focus on 'gmrun'. Note, that +-- > -- another 'gmrun' will steal focus from already +-- > -- running one. +-- > , focused (className =? "Gmrun") -?> keepFocus +-- > -- If firefox dialog prompt (e.g. master password +-- > -- prompt) is focused on current workspace and new +-- > -- window appears here too, keep focus unchanged +-- > -- (note, used predicates: @newOnCur <&&> focused@ is +-- > -- the same as @newOnCur <&&> focusedCur@, but is +-- > -- /not/ the same as just 'focusedCur' ) +-- > , newOnCur <&&> focused +-- > ((className =? "Iceweasel" <||> className =? "Firefox") <&&> isDialog) +-- > -?> keepFocus +-- > -- Default behavior for new windows: switch focus. +-- > , return True -?> switchFocus +-- > ] +-- > +-- > composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a +-- > composeOne [] = return mempty +-- > composeOne (mx : xs) = do +-- > x <- mx +-- > case x of +-- > Just y -> return y +-- > Nothing -> composeOne xs +-- > +-- > infixr 0 -?> +-- > (-?>) :: Monad m => m Bool -> m a -> m (Maybe a) +-- > (-?>) mb mx = do +-- > b <- mb +-- > if b +-- > then Just <$> mx +-- > else return Nothing +-- +-- Note here: +-- +-- - i keep focus, when activated window appears on current workspace, in +-- this example. +-- - when @activated -?> (newOnCur --> keepFocus)@ runs, activated window +-- will be /already/ on current workspace, thus, if i do not want to move +-- some activated windows, i should filter them out in @activateOnCurrentWs@ +-- FocusHook. + + +-- FocusQuery. +-- $focusquery + +-- | Information about current workspace and focus. +data Focus = Focus + { -- | Workspace, where new window appears. + newWorkspace :: WorkspaceId + -- | Focused window on workspace, where new window + -- appears. + , focusedWindow :: Maybe Window + -- | Current workspace. + , currentWorkspace :: WorkspaceId + } + deriving (Show) +instance Default Focus where + def = Focus + { focusedWindow = Nothing + , newWorkspace = "" + , currentWorkspace = "" + } + +newtype FocusLock = FocusLock {getFocusLock :: Bool} + deriving (Show, Typeable) +instance ExtensionClass FocusLock where + initialValue = FocusLock False + +-- | Toggle stored focus lock state. +toggleLock :: X () +toggleLock = XS.modify (\(FocusLock b) -> FocusLock (not b)) + +-- | Whether new window _NET_ACTIVE_WINDOW activated or not. I should keep +-- this value in global state, because i use 'ManageHook' for handling +-- activated windows and i need a way to tell 'manageHook', that now a window +-- is activated. +newtype NetActivated = NetActivated {netActivated :: Bool} + deriving (Show, Typeable) +instance ExtensionClass NetActivated where + initialValue = NetActivated False + +-- | Monad on top of Query providing additional information about new window. +newtype FocusQuery a = FocusQuery (ReaderT Focus Query a) +instance Functor FocusQuery where + fmap f (FocusQuery x) = FocusQuery (fmap f x) +instance Applicative FocusQuery where + pure x = FocusQuery (pure x) + (FocusQuery f) <*> (FocusQuery mx) = FocusQuery (f <*> mx) +instance Monad FocusQuery where + return x = FocusQuery (return x) + (FocusQuery mx) >>= f = FocusQuery $ mx >>= \x -> + let FocusQuery y = f x in y +instance MonadReader Focus FocusQuery where + ask = FocusQuery ask + local f (FocusQuery mx) = FocusQuery (local f mx) +instance MonadIO FocusQuery where + liftIO mx = FocusQuery (liftIO mx) +instance Monoid a => Monoid (FocusQuery a) where + mempty = return mempty + mappend = liftM2 mappend + +runFocusQuery :: FocusQuery a -> Focus -> Query a +runFocusQuery (FocusQuery m) = runReaderT m + +type FocusHook = FocusQuery (Endo WindowSet) + + +-- Lifting into FocusQuery. +-- $lift + +-- | Lift Query into FocusQuery monad. The same as 'new'. +liftQuery :: Query a -> FocusQuery a +liftQuery = FocusQuery . lift + +-- | Run Query on new window. +new :: Query a -> FocusQuery a +new = liftQuery + +-- | Run Query on focused window on workspace, where new window appears. If +-- there is no focused window, return False. +focused :: Query Bool -> FocusQuery Bool +focused m = getAny <$> focused' (Any <$> m) +-- | More general version of 'focused'. +focused' :: Monoid a => Query a -> FocusQuery a +focused' m = do + mw <- asks focusedWindow + liftQuery (maybe mempty (flip local m . const) mw) + +-- | Run Query on window focused at particular workspace. If there is no +-- focused window, return False. +focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool +focusedOn i m = getAny <$> focusedOn' i (Any <$> m) +-- | More general version of 'focusedOn'. +focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a +focusedOn' i m = liftQuery $ do + mw <- liftX $ withWindowSet (return . W.peek . W.view i) + maybe mempty (flip local m . const) mw + +-- | Run Query on focused window on current workspace. If there is no focused +-- window, return False. Note, +-- +-- > focused <&&> newOnCur != focusedCur +-- +-- The first will affect only new or activated window appearing on current +-- workspace, while the last will affect any window: focus even for windows +-- appearing on other workpsaces will depend on focus on /current/ workspace. +focusedCur :: Query Bool -> FocusQuery Bool +focusedCur m = getAny <$> focusedCur' (Any <$> m) +-- | More general version of 'focusedCur'. +focusedCur' :: Monoid a => Query a -> FocusQuery a +focusedCur' m = asks currentWorkspace >>= \i -> focusedOn' i m + +-- | Does new window appear at particular workspace? +newOn :: WorkspaceId -> FocusQuery Bool +newOn i = (i ==) <$> asks newWorkspace +-- | Does new window appear at current workspace? +newOnCur :: FocusQuery Bool +newOnCur = asks currentWorkspace >>= newOn + +-- | Does new window @_NET_ACTIVE_WINDOW@ activated? +activated :: FocusQuery Bool +activated = fmap netActivated (liftQuery (liftX XS.get)) + +-- | Execute Query, unless focus is locked. +unlessFocusLock :: Monoid a => Query a -> Query a +unlessFocusLock m = do + FocusLock b <- liftX XS.get + when' (not b) m + + +-- Commonly used actions for modifying focus. +-- +-- $common +-- Operations in each pair 'keepFocus' and 'switchFocus', 'keepWorkspace' and +-- 'switchWorkspace' overwrite each other (the letftmost will determine what +-- happened): +-- +-- prop> keepFocus <+> switchFocus = keepFocus +-- prop> switchFocus <+> keepFocus = switchFocus +-- prop> keepWorkspace <+> switchWorkspace = keepWorkspace +-- prop> switchWorkspace <+> keepWorkspace = switchWorkspace +-- +-- and operations from different pairs are commutative: +-- +-- prop> keepFocus <+> switchWorkspace = switchWorkspace <+> keepFocus +-- prop> switchFocus <+> switchWorkspace = switchWorkspace <+> switchFocus +-- +-- etc. + +-- | Keep focus on workspace (may not be current), where new window appears. +-- Workspace will not be switched. This operation is idempotent and +-- effectively returns focus to window focused on that workspace before +-- applying (Endo WindowSet) function. +keepFocus :: FocusHook +keepFocus = focused' $ ask >>= \w -> doF $ \ws -> + W.view (W.currentTag ws) . W.focusWindow w $ ws + +-- | Switch focus to new window on workspace (may not be current), where new +-- window appears. Workspace will not be switched. This operation is +-- idempotent. +switchFocus :: FocusHook +switchFocus = do + FocusLock b <- liftQuery . liftX $ XS.get + if b + -- When focus lock is enabled, call 'keepFocus' explicitly (still no + -- 'keepWorkspace') to overwrite default behavior. + then keepFocus + else new $ ask >>= \w -> doF $ \ws -> + W.view (W.currentTag ws) . W.focusWindow w $ ws + +-- | Keep current workspace. Focus will not be changed at either current or +-- new window's workspace. This operation is idempotent and effectively +-- switches to workspace, which was current before applying (Endo WindowSet) +-- function. +keepWorkspace :: FocusHook +keepWorkspace = do + ws <- asks currentWorkspace + liftQuery . doF $ W.view ws + +-- | Switch workspace to one, where new window appears. Focus will not be +-- changed at either current or new window's workspace. This operation is +-- idempotent. +switchWorkspace :: FocusHook +switchWorkspace = do + FocusLock b <- liftQuery . liftX $ XS.get + if b + -- When focus lock is enabled, call 'keepWorkspace' explicitly (still no + -- 'keepFocus') to overwrite default behavior. + then keepWorkspace + else do + ws <- asks newWorkspace + liftQuery . doF $ W.view ws + +-- Running FocusQuery. +-- $running + +-- | I don't know at which workspace new window will appear until @(Endo +-- WindowSet)@ function from 'windows' in @XMonad.Operations@ actually run, +-- but in @(Endo WindowSet)@ function i can't already execute monadic actions, +-- because it's pure. So, i compute result for every workspace here and just +-- use it later in (Endo WindowSet) function. Note, though, that this will +-- execute monadic actions many times, and therefore assume, that result of +-- 'FocusHook' does not depend on the number of times it was executed. +manageFocus :: FocusHook -> ManageHook +manageFocus m = do + fws <- liftX . withWindowSet $ return + . map (W.tag &&& fmap W.focus . W.stack) . W.workspaces + ct <- currentWs + let r = def {currentWorkspace = ct} + hs <- forM fws $ \(i, mw) -> do + f <- runFocusQuery m (r {focusedWindow = mw, newWorkspace = i}) + return (i, f) + reader (selectHook hs) >>= doF + where + -- Select and apply (Endo WindowSet) function depending on which workspace + -- new window appeared now. + selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet + selectHook cfs nw ws = fromMaybe ws $ do + i <- W.findTag nw ws + f <- lookup i cfs + return (appEndo f ws) + +-- | 'handleEventHook' for handling activated windows according to +-- 'FocusHook'. +activateEventHook :: ManageHook -> Event -> X All +activateEventHook x ClientMessageEvent { + ev_window = w, + ev_message_type = mt + } = do + a_aw <- getAtom "_NET_ACTIVE_WINDOW" + -- 'NetActivated' state handling is done solely and completely here! + when (mt == a_aw) $ do + XS.put (NetActivated True) + runQuery x w >>= windows . appEndo + XS.put (NetActivated False) + return (All True) +activateEventHook _ _ = return (All True) + +-- | 'startupHook' for announcing @_NET_ACTIVE_WINDOW@ in @_NET_SUPPORTED@ and +-- settings @_NET_WM_NAME@. + +-- 'setWMName' creates support window (don't know why), sets its _NET_WM_NAME +-- to specified value, sets '_NET_SUPPORTING_WM_CHECK' atom of support window +-- and root window to support window id and and adds two atoms +-- '_NET_SUPPORTING_WM_CHECK' and '_NET_WM_NAME' to '_NET_SUPPORTED' atom of +-- root window (removing any duplicates). And this is required (apart from +-- adding '_NET_ACTIVE_WINDOW' to '_NET_SUPPORTED') for making +-- window activation work. Also, 'setWMName' checks window pointed by +-- '_NET_SUPPORTING_WM_CHECK' before creating support window, so it's safe to +-- call it many times - only window name in '_NET_WM_NAME' may change. +activateStartupHook :: X () +activateStartupHook = do + setWMName "xmonad" + getAtom "_NET_ACTIVE_WINDOW" >>= addNETSupported + +-- | Enable 'FocusHook' handling and set key for toggling focus lock. This is +-- recommended way for using 'FocusHook'. +handleFocusQuery :: Maybe (ButtonMask, KeySym) -- ^ Key to toggle focus lock. + -> FocusHook + -> XConfig l -> XConfig l +handleFocusQuery mt x cf = addLockKey $ cf + -- Note, the order: i want to apply FocusHook after user's changes, which + -- may change new/activated window workspace. Thus, in 'manageHook', which + -- is function composition, i should add in Monoid to the left, but in + -- 'handleEventHook', which runs actions from left to right, to the right! + { manageHook = mh + , handleEventHook = handleEventHook cf `mappend` activateEventHook mh + -- Note, the order: i make my changes after user's changes here too. + , startupHook = startupHook cf >> activateStartupHook + } + where + -- Note, 'manageHook' should /not/ touch 'NetActivated' state value at + -- all! Because 'manageHook' may be called either on its own (from + -- 'manage' in X.Operations.hs) or from 'activateEventHook' (from here), + -- the only one who knows was window activated or not is the caller. And + -- it should set and unset 'NetActivated' state properly. Here this is + -- done solely and completely by 'activateEventHook'. + mh :: ManageHook + mh = manageFocus x `mappend` manageHook cf + addLockKey :: XConfig l -> XConfig l + addLockKey = additionalKeys <*> mt `maybeKey` toggleLock + +-- $internal +-- + +addNETSupported :: Atom -> X () +addNETSupported x = withDisplay $ \dpy -> do + r <- asks theRoot + a_NET_SUPPORTED <- getAtom "_NET_SUPPORTED" + a <- getAtom "ATOM" + liftIO $ do + sup <- (join . maybeToList) <$> getWindowProperty32 dpy a_NET_SUPPORTED r + when (fromIntegral x `notElem` sup) $ + changeProperty32 dpy r a_NET_SUPPORTED a propModeAppend [fromIntegral x] + +maybeKey :: Maybe (ButtonMask, KeySym) -> X () -> XConfig l -> [((ButtonMask, KeySym), X ())] +maybeKey mk x = pure . maybeToList $ (mk >>= \k -> return (k, x)) + +when' :: (Monad m, Monoid a) => Bool -> m a -> m a +when' b mx + | b = mx + | otherwise = return mempty + diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 87e26ce5..02e2edff 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -168,6 +168,7 @@ library XMonad.Hooks.FadeInactive XMonad.Hooks.FadeWindows XMonad.Hooks.FloatNext + XMonad.Hooks.Focus XMonad.Hooks.ICCCMFocus XMonad.Hooks.InsertPosition XMonad.Hooks.ManageDebug From 2807935900a8445c122b61d79d7d88b1106bfdd8 Mon Sep 17 00:00:00 2001 From: sgf Date: Thu, 15 Dec 2016 21:56:12 +0300 Subject: [PATCH 02/16] X.H.SetWMName: Add `getWMName` function. And do not overwrite wm name in `handleFocusQuery`, if user has already set it. --- CHANGES.md | 7 +++++ XMonad/Hooks/Focus.hs | 3 +- XMonad/Hooks/SetWMName.hs | 60 +++++++++++++++++++++------------------ 3 files changed, 41 insertions(+), 29 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 19dbdef0..5c071a1c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -84,6 +84,13 @@ - Fix bug when cursor gets stuck in one of the corners. + * `XMonad.Hooks.SetWMName` + + Add function `getWMName`. + + * `XMonad.Hooks.Focus` + + Do not overwrite wm name in `handleFocusQuery`, if user has already set it. ## 0.12 (December 14, 2015) diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs index 305234d7..7559f9f1 100644 --- a/XMonad/Hooks/Focus.hs +++ b/XMonad/Hooks/Focus.hs @@ -546,7 +546,8 @@ activateEventHook _ _ = return (All True) -- call it many times - only window name in '_NET_WM_NAME' may change. activateStartupHook :: X () activateStartupHook = do - setWMName "xmonad" + wn <- getWMName + when (isNothing wn) (setWMName "xmonad") getAtom "_NET_ACTIVE_WINDOW" >>= addNETSupported -- | Enable 'FocusHook' handling and set key for toggling focus lock. This is diff --git a/XMonad/Hooks/SetWMName.hs b/XMonad/Hooks/SetWMName.hs index 86e8327a..e788e831 100644 --- a/XMonad/Hooks/SetWMName.hs +++ b/XMonad/Hooks/SetWMName.hs @@ -36,18 +36,45 @@ ----------------------------------------------------------------------------- module XMonad.Hooks.SetWMName ( - setWMName) where + setWMName + , getWMName + ) + where -import Control.Monad (join) +import Control.Monad (guard, join) import Data.Char (ord) import Data.List (nub) -import Data.Maybe (fromJust, listToMaybe, maybeToList) +import Data.Maybe (listToMaybe, maybeToList) +import qualified Data.Traversable as T import Foreign.C.Types (CChar) import Foreign.Marshal.Alloc (alloca) import XMonad +-- is there a better way to check the validity of the window? +isValidWindow :: Window -> X Bool +isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do + status <- xGetWindowAttributes dpy w p + return (status /= 0) + +netSupportingWMCheckAtom :: X Atom +netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" + +-- Return either valid support window or @Nothing@. +getSupportWindow :: X (Maybe Window) +getSupportWindow = withDisplay $ \dpy -> do + at <- netSupportingWMCheckAtom + root <- asks theRoot + mw <- fmap (fmap fromIntegral . join . fmap listToMaybe) $ liftIO + $ getWindowProperty32 dpy at root + mb <- T.mapM isValidWindow mw + return (mb >>= guard >> mw) + +-- | Get WM name. +getWMName :: X (Maybe String) +getWMName = getSupportWindow >>= T.mapM (runQuery title) + -- | sets WM name setWMName :: String -> X () setWMName name = do @@ -57,7 +84,8 @@ setWMName name = do atom_UTF8_STRING <- getAtom "UTF8_STRING" root <- asks theRoot - supportWindow <- getSupportWindow + mw <- getSupportWindow + supportWindow <- maybe createSupportWindow return mw dpy <- asks display io $ do -- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window @@ -68,33 +96,9 @@ setWMName name = do supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList) where - netSupportingWMCheckAtom :: X Atom - netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" - latin1StringToCCharList :: String -> [CChar] latin1StringToCCharList str = map (fromIntegral . ord) str - getSupportWindow :: X Window - getSupportWindow = withDisplay $ \dpy -> do - atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom - root <- asks theRoot - supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root - validateWindow (fmap fromIntegral supportWindow) - - validateWindow :: Maybe Window -> X Window - validateWindow w = do - valid <- maybe (return False) isValidWindow w - if valid then - return $ fromJust w - else - createSupportWindow - - -- is there a better way to check the validity of the window? - isValidWindow :: Window -> X Bool - isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do - status <- xGetWindowAttributes dpy w p - return (status /= 0) - -- this code was translated from C (see OpenBox WM, screen.c) createSupportWindow :: X Window createSupportWindow = withDisplay $ \dpy -> do From 8e5931272c9c606666813e46f29a0cbce13625af Mon Sep 17 00:00:00 2001 From: sgf Date: Thu, 15 Dec 2016 21:51:39 +0300 Subject: [PATCH 03/16] X.H.ManageHelpers: Make type of ManageHook combinators more general. --- CHANGES.md | 4 ++++ XMonad/Hooks/Focus.hs | 40 ++--------------------------------- XMonad/Hooks/ManageHelpers.hs | 20 +++++++++--------- 3 files changed, 16 insertions(+), 48 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 5c071a1c..56213950 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -92,6 +92,10 @@ Do not overwrite wm name in `handleFocusQuery`, if user has already set it. + * `XMonad.Hooks.ManageHelpers` + + Make type of ManageHook combinators more general. + ## 0.12 (December 14, 2015) ### Breaking Changes diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs index 7559f9f1..f20edc36 100644 --- a/XMonad/Hooks/Focus.hs +++ b/XMonad/Hooks/Focus.hs @@ -149,7 +149,7 @@ import XMonad.Util.EZConfig -- -- > import XMonad -- > --- > import XMonad.Hooks.ManageHelpers hiding ((-?>), composeOne) +-- > import XMonad.Hooks.ManageHelpers -- > import XMonad.Hooks.Focus -- > -- > main :: IO () @@ -160,32 +160,12 @@ import XMonad.Util.EZConfig -- > ]) -- > $ def -- > xmonad xcf --- > --- > composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a --- > composeOne [] = return mempty --- > composeOne (mx : xs) = do --- > x <- mx --- > case x of --- > Just y -> return y --- > Nothing -> composeOne xs --- > --- > infixr 0 -?> --- > (-?>) :: Monad m => m Bool -> m a -> m (Maybe a) --- > (-?>) mb mx = do --- > b <- mb --- > if b --- > then Just <$> mx --- > else return Nothing --- -- -- Note: -- -- - /mod4Mask+v/ key toggles focus lock (when enabled, focus will not be -- switched to new window). -- - 'handleFocusQuery' will enable window activation. --- - I need more generic 'XMonad.Hooks.ManageHelpers.-?>' and --- 'XMonad.Hooks.ManageHelpers.composeOne', than in the --- 'XMonad.Hooks.ManageHelpers'. -- - The order, when constructing final 'FocusHook' in 'handleFocusQuery' -- call: 'FocusHook' without 'activated' predicate will match to activated -- windows too, thus i should place it after one with 'activated' (so the @@ -231,7 +211,7 @@ import XMonad.Util.EZConfig -- > import XMonad -- > import qualified XMonad.StackSet as W -- > --- > import XMonad.Hooks.ManageHelpers hiding ((-?>), composeOne) +-- > import XMonad.Hooks.ManageHelpers -- > import XMonad.Hooks.Focus -- > -- > main :: IO () @@ -269,22 +249,6 @@ import XMonad.Util.EZConfig -- > -- Default behavior for new windows: switch focus. -- > , return True -?> switchFocus -- > ] --- > --- > composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a --- > composeOne [] = return mempty --- > composeOne (mx : xs) = do --- > x <- mx --- > case x of --- > Just y -> return y --- > Nothing -> composeOne xs --- > --- > infixr 0 -?> --- > (-?>) :: Monad m => m Bool -> m a -> m (Maybe a) --- > (-?>) mb mx = do --- > b <- mb --- > if b --- > then Just <$> mx --- > else return Nothing -- -- Note here: -- diff --git a/XMonad/Hooks/ManageHelpers.hs b/XMonad/Hooks/ManageHelpers.hs index de03b553..bdb2f432 100644 --- a/XMonad/Hooks/ManageHelpers.hs +++ b/XMonad/Hooks/ManageHelpers.hs @@ -73,8 +73,8 @@ data Match a = Match Bool a -- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as -- a candidate returns a 'Just' value, effectively running only the first match -- (whereas 'composeAll' continues and executes all matching rules). -composeOne :: [MaybeManageHook] -> ManageHook -composeOne = foldr try idHook +composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a +composeOne = foldr try (return mempty) where try q z = do x <- q @@ -85,17 +85,17 @@ composeOne = foldr try idHook infixr 0 -?>, -->>, -?>> -- | q \/=? x. if the result of q equals x, return False -(/=?) :: Eq a => Query a -> a -> Query Bool +(/=?) :: (Eq a, Functor m) => m a -> a -> m Bool q /=? x = fmap (/= x) q -- | q <==? x. if the result of q equals x, return True grouped with q -(<==?) :: Eq a => Query a -> a -> Query (Match a) +(<==?) :: (Eq a, Functor m) => m a -> a -> m (Match a) q <==? x = fmap (`eq` x) q where eq q' x' = Match (q' == x') q' -- | q <\/=? x. if the result of q notequals x, return True grouped with q -( Query a -> a -> Query (Match a) +( m a -> a -> m (Match a) q ) :: Query Bool -> ManageHook -> MaybeManageHook +(-?>) :: (Functor m, Monad m) => m Bool -> m a -> m (Maybe a) p -?> f = do x <- p if x then fmap Just f else return Nothing -- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action. If 'p' is true, it executes the resulting action. -(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook +(-->>) :: (Monoid b, Monad m) => m (Match a) -> (a -> m b) -> m b p -->> f = do Match b m <- p - if b then (f m) else mempty + if b then (f m) else return mempty -- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule. -(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook +(-?>>) :: (Functor m, Monad m) => m (Match a) -> (a -> m b) -> m (Maybe b) p -?>> f = do Match b m <- p if b then fmap Just (f m) else return Nothing @@ -179,7 +179,7 @@ transience' :: ManageHook transience' = maybeToDefinite transience -- | converts 'MaybeManageHook's to 'ManageHook's -maybeToDefinite :: MaybeManageHook -> ManageHook +maybeToDefinite :: (Monoid a, Functor m) => m (Maybe a) -> m a maybeToDefinite = fmap (fromMaybe mempty) From c07be09e17963144551a0c0914ca367522f6c9d4 Mon Sep 17 00:00:00 2001 From: sgf Date: Fri, 16 Dec 2016 16:02:53 +0300 Subject: [PATCH 04/16] X.H.EwmhDesktops: use `manageHook` for handling activated window. Move EWMH code from `X.H.Focus` to `X.H.EwmhDesktops`. Thus: - I'll use `manageHook` for handling activated window. - By default window activation do nothing (assuming default `ManageHook`). - I can use `activated` predicate for changing window activation behavior. - I may use additional combinators from `X.H.Focus` for more complex focus/workspace switch strategies. --- CHANGES.md | 12 +++ XMonad/Hooks/EwmhDesktops.hs | 54 +++++++++- XMonad/Hooks/Focus.hs | 193 +++++++---------------------------- 3 files changed, 103 insertions(+), 156 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 56213950..d2c07743 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,6 +11,18 @@ * New constructor `CenteredAt Rational Rational` added for `XMonad.Prompt.XPPosition`. + * `ewmh` function from `X.H.EwmhDesktops` will use `manageHook` for handling + activated window. That means, actions, which you don't want to happen on + activated windows, should be guarded by + + not <$> activated + + predicate. By default, with empty `ManageHook`, window activation will do + nothing. + + Also, you can use regular 'ManageHook' combinators for changing window + activation behavior. + ### New Modules * `XMonad.Layout.SortedLayout` diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index 2508b7ed..17ef4f82 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveDataTypeable #-} + ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.EwmhDesktops @@ -19,6 +21,8 @@ module XMonad.Hooks.EwmhDesktops ( ewmhDesktopsStartup, ewmhDesktopsLogHook, ewmhDesktopsLogHookCustom, + NetActivated (..), + activated, ewmhDesktopsEventHook, ewmhDesktopsEventHookCustom, fullscreenEventHook @@ -37,6 +41,7 @@ import XMonad.Hooks.SetWMName import XMonad.Util.XUtils (fi) import XMonad.Util.WorkspaceCompare import XMonad.Util.WindowProperties (getProp32) +import qualified XMonad.Util.ExtensibleState as XS -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: @@ -48,7 +53,36 @@ import XMonad.Util.WindowProperties (getProp32) -- > handleEventHook def <+> fullscreenEventHook } -- -- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks". - +-- +-- __/WARNING!/__ 'ewmh' function will use 'manageHook' for handling activated +-- window. That means, actions, which you don't want to happen on activated +-- windows, should be guarded by +-- +-- > not <$> activated +-- +-- predicate. +-- +-- And now by default window activation will do nothing: neither switch +-- workspace, nor focus. You can use regular 'ManageHook' combinators for +-- changing window activation behavior. Also, you may be interested in +-- "XMonad.Hooks.Focus", which provides additional predicates for using in +-- 'ManageHook'. +-- +-- To get back old 'ewmh' window activation behavior (switch workspace and +-- focus to activated window) you may use: +-- +-- > import XMonad +-- > +-- > import XMonad.Hooks.EwmhDesktops +-- > import XMonad.Hooks.ManageHelpers +-- > import XMonad.Hooks.Focus +-- > +-- > main :: IO () +-- > main = do +-- > let fh :: ManageHook +-- > fh = manageFocus (liftQuery activated --> switchWorkspace <+> switchFocus) +-- > xcf = ewmh $ def {modMask = mod4Mask, manageHook = fh} +-- > xmonad xcf -- | Add EWMH functionality to the given config. See above for an example. ewmh :: XConfig a -> XConfig a @@ -128,6 +162,19 @@ ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All ewmhDesktopsEventHookCustom f e = handle f e >> return (All True) +-- | Whether new window _NET_ACTIVE_WINDOW activated or not. I should keep +-- this value in global state, because i use 'ManageHook' for handling +-- activated windows and i need a way to tell 'manageHook', that now a window +-- is activated. +newtype NetActivated = NetActivated {netActivated :: Bool} + deriving (Show, Typeable) +instance ExtensionClass NetActivated where + initialValue = NetActivated False + +-- | Was new window @_NET_ACTIVE_WINDOW@ activated? +activated :: Query Bool +activated = fmap netActivated (liftX XS.get) + handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X () handle f (ClientMessageEvent { ev_window = w, @@ -153,7 +200,10 @@ handle f (ClientMessageEvent { windows $ W.shiftWin (W.tag (ws !! fi n)) w else trace $ "Bad _NET_DESKTOP with data[0]="++show n else if mt == a_aw then do - windows $ W.focusWindow w + mh <- asks (manageHook . config) + XS.put (NetActivated True) + runQuery mh w >>= windows . appEndo + XS.put (NetActivated False) else if mt == a_cw then do killWindow w else if mt `elem` a_ignore then do diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs index f20edc36..bf93f37f 100644 --- a/XMonad/Hooks/Focus.hs +++ b/XMonad/Hooks/Focus.hs @@ -20,7 +20,6 @@ module XMonad.Hooks.Focus Focus (..) , FocusLock (..) , toggleLock - , NetActivated (..) , FocusQuery , runFocusQuery , FocusHook @@ -38,7 +37,6 @@ module XMonad.Hooks.Focus , focusedCur' , newOn , newOnCur - , activated , unlessFocusLock -- * Commonly used actions for modifying focus. @@ -53,9 +51,6 @@ module XMonad.Hooks.Focus -- -- $running , manageFocus - , activateEventHook - , activateStartupHook - , handleFocusQuery ) where @@ -70,8 +65,6 @@ import XMonad import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Hooks.ManageHelpers (currentWs) -import XMonad.Hooks.SetWMName -import XMonad.Util.EZConfig -- $main @@ -83,33 +76,16 @@ import XMonad.Util.EZConfig -- - focused window on workspace, where new window will appear; -- - current workspace; -- --- And two properties in extensible state: +-- And a property in extensible state: -- -- - is focus lock enabled? Focus lock instructs all library's 'FocusHook' --- functions to not move focus. --- - is new window @_NET_ACTIVE_WINDOW@ activated? It is not really new in --- that case, but i may work with it in the same way. +-- functions to not move focus or switch workspace. -- -- Lifting operations for standard 'ManageHook' EDSL combinators into -- 'FocusQuery' monad allowing to run these combinators on focused window and -- common actions for keeping focus and\/or workspace, switching focus and\/or -- workspace are also provided. -- --- __/WARNING!/__ 'activateEventHook' (which handles window activation) will --- use 'manageHook' for handling activated window. That means, actions, which --- you don't want to happen on activated windows, should be guarded by --- --- > not <$> activated --- --- predicate. This requires to lift them into 'FocusHook' and then convert --- back into 'ManageHook' using 'manageFocus'. --- --- __/WARNING!/__ Since this module enables and handles window activation on --- its own, it is /not/ compatible with 'XMonad.Hooks.EwmhDesktops.ewmh' --- function from 'XMonad.Hooks.EwmhDesktops' module. Well, it will compile and --- work, but window activation handling according to 'FocusHook' won't work, --- because 'XMonad.Hooks.EwmhDesktops.ewmh' handler will overwrite it. --- -- I may define 'FocusHook' like: -- -- > activateFocusHook :: FocusHook @@ -148,29 +124,34 @@ import XMonad.Util.EZConfig -- And then use it (paste definition of 'FocusHook' above there too) like: -- -- > import XMonad +-- > import XMonad.Util.EZConfig -- > +-- > import XMonad.Hooks.EwmhDesktops -- > import XMonad.Hooks.ManageHelpers -- > import XMonad.Hooks.Focus -- > -- > main :: IO () -- > main = do --- > let xcf = handleFocusQuery (Just (mod4Mask, xK_v)) (composeOne --- > [ activated -?> activateFocusHook --- > , Just <$> newFocusHook --- > ]) --- > $ def +-- > let fh :: ManageHook +-- > fh = manageFocus $ (composeOne +-- > [ liftQuery activated -?> activateFocusHook +-- > , Just <$> newFocusHook +-- > ]) +-- > xcf = ewmh $ def {manageHook = fh} +-- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] -- > xmonad xcf -- -- Note: -- --- - /mod4Mask+v/ key toggles focus lock (when enabled, focus will not be --- switched to new window). --- - 'handleFocusQuery' will enable window activation. --- - The order, when constructing final 'FocusHook' in 'handleFocusQuery' --- call: 'FocusHook' without 'activated' predicate will match to activated --- windows too, thus i should place it after one with 'activated' (so the --- latter will have a chance to handle activated window first). --- +-- - /mod4Mask+v/ key toggles focus lock (when enabled, neither focus nor +-- workspace won't be switched). +-- - I need 'XMonad.Hooks.EwmhDesktops' module for enabling window +-- activation. It will call 'manageHook' for activated window and predicate +-- 'activated' will be 'True' in this case. +-- - The order, when constructing final 'FocusHook': 'FocusHook' without +-- 'activated' predicate will match to activated windows too, thus i should +-- place it after one with 'activated' (so the latter will have a chance to +-- handle activated window first). -- -- And more technical notes: -- @@ -178,10 +159,10 @@ import XMonad.Util.EZConfig -- or save results. Precisely, it may do anything, but it must be idempotent -- to operate properly. -- - 'FocusHook' will see new window at workspace, where functions on the --- /right/ from 'handleFocusQuery' in 'ManageHook' monoid place it. In other --- words, in @(Endo WindowSet)@ monoid i may see changes only from functions --- applied /before/ (more to the right in function composition). Thus, it's --- better to apply 'handleFocusQuery' the last. +-- /right/ from it in 'ManageHook' monoid place it. In other words, in +-- @(Endo WindowSet)@ monoid i may see changes only from functions applied +-- /before/ (more to the right in function composition). Thus, it's better to +-- add 'FocusHook' the last. -- - 'FocusHook' functions won't see window shift to another workspace made -- by function from 'FocusHook' itself: new window workspace is determined -- /before/ running 'FocusHook' and even if later one of 'FocusHook' @@ -198,36 +179,30 @@ import XMonad.Util.EZConfig -- -- now @FH2@ will see window shift made by @FH1@. -- --- - I may define my own 'handleFocusQuery', all required functions are --- exported. I may redefine handling of activated windows too, but note: --- 'handleEventHook' handling window activation should correctly set\/unset --- 'NetActivated' in extensible state, like 'activateEventHook' does, and --- usually there should be only one 'handleEventHook' processing activated --- windows. --- -- Another interesting example is moving all activated windows to current -- workspace by default, and applying 'FocusHook' after: -- -- > import XMonad +-- > import XMonad.Util.EZConfig -- > import qualified XMonad.StackSet as W -- > +-- > import XMonad.Hooks.EwmhDesktops -- > import XMonad.Hooks.ManageHelpers -- > import XMonad.Hooks.Focus -- > -- > main :: IO () -- > main = do --- > let xcf = handleFocusQuery (Just (mod4Mask, xK_v)) (composeOne --- > [ activated -?> (newOnCur --> keepFocus) --- > , Just <$> newFocusHook --- > ]) --- > $ def --- > { manageHook = manageFocus activateOnCurrentWs --- > } +-- > let fh :: ManageHook +-- > fh = manageFocus $ (composeOne +-- > [ liftQuery activated -?> (newOnCur --> keepFocus) +-- > , Just <$> newFocusHook +-- > ]) +-- > xcf = ewmh $ def {manageHook = fh <+> activateOnCurrentWs} +-- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] -- > xmonad xcf -- > --- > activateOnCurrentWs :: FocusHook --- > activateOnCurrentWs = activated --> asks currentWorkspace >>= --- > new . unlessFocusLock . doShift +-- > activateOnCurrentWs :: ManageHook +-- > activateOnCurrentWs = activated --> currentWs >>= unlessFocusLock . doShift -- > -- > newFocusHook :: FocusHook -- > newFocusHook = composeOne @@ -254,10 +229,10 @@ import XMonad.Util.EZConfig -- -- - i keep focus, when activated window appears on current workspace, in -- this example. --- - when @activated -?> (newOnCur --> keepFocus)@ runs, activated window --- will be /already/ on current workspace, thus, if i do not want to move --- some activated windows, i should filter them out in @activateOnCurrentWs@ --- FocusHook. +-- - when @liftQuery activated -?> (newOnCur --> keepFocus)@ runs, activated +-- window will be /already/ on current workspace, thus, if i do not want to +-- move some activated windows, i should filter them out in +-- @activateOnCurrentWs@ FocusHook. -- FocusQuery. @@ -290,15 +265,6 @@ instance ExtensionClass FocusLock where toggleLock :: X () toggleLock = XS.modify (\(FocusLock b) -> FocusLock (not b)) --- | Whether new window _NET_ACTIVE_WINDOW activated or not. I should keep --- this value in global state, because i use 'ManageHook' for handling --- activated windows and i need a way to tell 'manageHook', that now a window --- is activated. -newtype NetActivated = NetActivated {netActivated :: Bool} - deriving (Show, Typeable) -instance ExtensionClass NetActivated where - initialValue = NetActivated False - -- | Monad on top of Query providing additional information about new window. newtype FocusQuery a = FocusQuery (ReaderT Focus Query a) instance Functor FocusQuery where @@ -377,10 +343,6 @@ newOn i = (i ==) <$> asks newWorkspace newOnCur :: FocusQuery Bool newOnCur = asks currentWorkspace >>= newOn --- | Does new window @_NET_ACTIVE_WINDOW@ activated? -activated :: FocusQuery Bool -activated = fmap netActivated (liftQuery (liftX XS.get)) - -- | Execute Query, unless focus is locked. unlessFocusLock :: Monoid a => Query a -> Query a unlessFocusLock m = do @@ -480,83 +442,6 @@ manageFocus m = do f <- lookup i cfs return (appEndo f ws) --- | 'handleEventHook' for handling activated windows according to --- 'FocusHook'. -activateEventHook :: ManageHook -> Event -> X All -activateEventHook x ClientMessageEvent { - ev_window = w, - ev_message_type = mt - } = do - a_aw <- getAtom "_NET_ACTIVE_WINDOW" - -- 'NetActivated' state handling is done solely and completely here! - when (mt == a_aw) $ do - XS.put (NetActivated True) - runQuery x w >>= windows . appEndo - XS.put (NetActivated False) - return (All True) -activateEventHook _ _ = return (All True) - --- | 'startupHook' for announcing @_NET_ACTIVE_WINDOW@ in @_NET_SUPPORTED@ and --- settings @_NET_WM_NAME@. - --- 'setWMName' creates support window (don't know why), sets its _NET_WM_NAME --- to specified value, sets '_NET_SUPPORTING_WM_CHECK' atom of support window --- and root window to support window id and and adds two atoms --- '_NET_SUPPORTING_WM_CHECK' and '_NET_WM_NAME' to '_NET_SUPPORTED' atom of --- root window (removing any duplicates). And this is required (apart from --- adding '_NET_ACTIVE_WINDOW' to '_NET_SUPPORTED') for making --- window activation work. Also, 'setWMName' checks window pointed by --- '_NET_SUPPORTING_WM_CHECK' before creating support window, so it's safe to --- call it many times - only window name in '_NET_WM_NAME' may change. -activateStartupHook :: X () -activateStartupHook = do - wn <- getWMName - when (isNothing wn) (setWMName "xmonad") - getAtom "_NET_ACTIVE_WINDOW" >>= addNETSupported - --- | Enable 'FocusHook' handling and set key for toggling focus lock. This is --- recommended way for using 'FocusHook'. -handleFocusQuery :: Maybe (ButtonMask, KeySym) -- ^ Key to toggle focus lock. - -> FocusHook - -> XConfig l -> XConfig l -handleFocusQuery mt x cf = addLockKey $ cf - -- Note, the order: i want to apply FocusHook after user's changes, which - -- may change new/activated window workspace. Thus, in 'manageHook', which - -- is function composition, i should add in Monoid to the left, but in - -- 'handleEventHook', which runs actions from left to right, to the right! - { manageHook = mh - , handleEventHook = handleEventHook cf `mappend` activateEventHook mh - -- Note, the order: i make my changes after user's changes here too. - , startupHook = startupHook cf >> activateStartupHook - } - where - -- Note, 'manageHook' should /not/ touch 'NetActivated' state value at - -- all! Because 'manageHook' may be called either on its own (from - -- 'manage' in X.Operations.hs) or from 'activateEventHook' (from here), - -- the only one who knows was window activated or not is the caller. And - -- it should set and unset 'NetActivated' state properly. Here this is - -- done solely and completely by 'activateEventHook'. - mh :: ManageHook - mh = manageFocus x `mappend` manageHook cf - addLockKey :: XConfig l -> XConfig l - addLockKey = additionalKeys <*> mt `maybeKey` toggleLock - --- $internal --- - -addNETSupported :: Atom -> X () -addNETSupported x = withDisplay $ \dpy -> do - r <- asks theRoot - a_NET_SUPPORTED <- getAtom "_NET_SUPPORTED" - a <- getAtom "ATOM" - liftIO $ do - sup <- (join . maybeToList) <$> getWindowProperty32 dpy a_NET_SUPPORTED r - when (fromIntegral x `notElem` sup) $ - changeProperty32 dpy r a_NET_SUPPORTED a propModeAppend [fromIntegral x] - -maybeKey :: Maybe (ButtonMask, KeySym) -> X () -> XConfig l -> [((ButtonMask, KeySym), X ())] -maybeKey mk x = pure . maybeToList $ (mk >>= \k -> return (k, x)) - when' :: (Monad m, Monoid a) => Bool -> m a -> m a when' b mx | b = mx From a3593e5607cfaa4e7f1249394f4a1b08d4765bc3 Mon Sep 17 00:00:00 2001 From: sgf Date: Fri, 6 Jan 2017 17:46:11 +0300 Subject: [PATCH 05/16] Remove no longer relevant changes from CHANGES.md. Fix merge conflicts. --- CHANGES.md | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index d2c07743..706bae24 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -54,12 +54,6 @@ EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since you will usually be taken to the `NSP` workspace by them. - * `XMonad.Actions.Submap` - - Establish pointer grab to avoid freezing X, when button press occurs after - submap key press. And terminate submap at button press in the same way, - as we do for wrong key press. - * `XMonad.Hooks.Focus` A new module extending ManageHook EDSL to work on focused windows and @@ -96,14 +90,16 @@ - Fix bug when cursor gets stuck in one of the corners. + * `XMonad.Actions.Submap` + + Establish pointer grab to avoid freezing X, when button press occurs after + submap key press. And terminate submap at button press in the same way, + as we do for wrong key press. + * `XMonad.Hooks.SetWMName` Add function `getWMName`. - * `XMonad.Hooks.Focus` - - Do not overwrite wm name in `handleFocusQuery`, if user has already set it. - * `XMonad.Hooks.ManageHelpers` Make type of ManageHook combinators more general. From 6f8145a2dcf9c735375e71ef107a6a7c591790f7 Mon Sep 17 00:00:00 2001 From: sgf Date: Sun, 12 Feb 2017 20:32:00 +0300 Subject: [PATCH 06/16] X.H.Focus: Add predefined configurations and more examples. --- XMonad/Hooks/Focus.hs | 133 +++++++++++++++++++++++++++++++++++------- 1 file changed, 111 insertions(+), 22 deletions(-) diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs index bf93f37f..414f66e0 100644 --- a/XMonad/Hooks/Focus.hs +++ b/XMonad/Hooks/Focus.hs @@ -5,7 +5,6 @@ -- | -- Module: XMonad.Hooks.Focus --- Description: Extend ManageHook EDSL for working on focused window -- Copyright: sgf-dma, 2016 -- Maintainer: sgf.dma@gmail.com -- @@ -51,6 +50,13 @@ module XMonad.Hooks.Focus -- -- $running , manageFocus + + -- * Example configurations. + -- + -- $examples + , activateSwitchWs + , activateOnCurrentWs + , activateOnCurrentKeepFocus ) where @@ -65,6 +71,7 @@ import XMonad import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Hooks.ManageHelpers (currentWs) +import XMonad.Hooks.EwmhDesktops (activated) -- $main @@ -86,7 +93,63 @@ import XMonad.Hooks.ManageHelpers (currentWs) -- common actions for keeping focus and\/or workspace, switching focus and\/or -- workspace are also provided. -- --- I may define 'FocusHook' like: +-- == Quick start. +-- +-- I may use one of predefined configurations. +-- +-- 1. Default window activation behavior is switch to workspace with activated +-- window and switch focus to it: +-- +-- > import XMonad +-- > +-- > import XMonad.Hooks.EwmhDesktops +-- > import XMonad.Hooks.Focus +-- > +-- > main :: IO () +-- > main = do +-- > let mh :: ManageHook +-- > mh = activateSwitchWs +-- > xcf = ewmh $ def +-- > { modMask = mod4Mask +-- > , manageHook = mh <+> manageHook def +-- > } +-- > xmonad xcf +-- +-- 2. Or i may move activated window to current workspace and switch focus to +-- it: +-- +-- > let mh :: ManageHook +-- > mh = activateOnCurrentWs +-- +-- 3. Or move activated window to current workspace, but keep focus unchanged: +-- +-- > let mh :: ManageHook +-- > mh = activateOnCurrentKeepFocus +-- +-- 4. I may use regular 'ManageHook' combinators for filtering, which windows +-- may activate. E.g. activate all windows, except firefox: +-- +-- > let mh :: ManageHook +-- > mh = not <$> (className =? "Firefox" <||> className =? "Iceweasel") +-- > --> activateSwitchWs +-- +-- 5. Or even use 'FocusHook' combinators. E.g. activate all windows, unless +-- gnome-terminal is focused on /current/ workspace: +-- +-- > let mh :: ManageHook +-- > mh = manageFocus (not <$> focusedCur (className =? "Gnome-terminal") +-- > --> liftQuery activateSwitchWs) +-- +-- or activate all windows, unless focused window on the workspace, +-- /where activated window is/, is not a gnome-terminal: +-- +-- > let mh :: ManageHook +-- > mh = manageFocus (not <$> focused (className =? "Gnome-terminal") +-- > --> liftQuery activateSwitchWs) +-- +-- == Defining FocusHook. +-- +-- I may define my own 'FocusHook' like: -- -- > activateFocusHook :: FocusHook -- > activateFocusHook = composeAll @@ -121,7 +184,7 @@ import XMonad.Hooks.ManageHelpers (currentWs) -- > , return True -?> switchFocus -- > ] -- --- And then use it (paste definition of 'FocusHook' above there too) like: +-- And then use it: -- -- > import XMonad -- > import XMonad.Util.EZConfig @@ -232,7 +295,7 @@ import XMonad.Hooks.ManageHelpers (currentWs) -- - when @liftQuery activated -?> (newOnCur --> keepFocus)@ runs, activated -- window will be /already/ on current workspace, thus, if i do not want to -- move some activated windows, i should filter them out in --- @activateOnCurrentWs@ FocusHook. +-- @activateOnCurrentWs@ 'FocusHook'. -- FocusQuery. @@ -265,7 +328,8 @@ instance ExtensionClass FocusLock where toggleLock :: X () toggleLock = XS.modify (\(FocusLock b) -> FocusLock (not b)) --- | Monad on top of Query providing additional information about new window. +-- | Monad on top of 'Query' providing additional information about new +-- window. newtype FocusQuery a = FocusQuery (ReaderT Focus Query a) instance Functor FocusQuery where fmap f (FocusQuery x) = FocusQuery (fmap f x) @@ -291,19 +355,19 @@ runFocusQuery (FocusQuery m) = runReaderT m type FocusHook = FocusQuery (Endo WindowSet) --- Lifting into FocusQuery. +-- Lifting into 'FocusQuery'. -- $lift --- | Lift Query into FocusQuery monad. The same as 'new'. +-- | Lift 'Query' into 'FocusQuery' monad. The same as 'new'. liftQuery :: Query a -> FocusQuery a liftQuery = FocusQuery . lift --- | Run Query on new window. +-- | Run 'Query' on new window. new :: Query a -> FocusQuery a new = liftQuery --- | Run Query on focused window on workspace, where new window appears. If --- there is no focused window, return False. +-- | Run 'Query' on focused window on workspace, where new window appears. If +-- there is no focused window, return 'False'. focused :: Query Bool -> FocusQuery Bool focused m = getAny <$> focused' (Any <$> m) -- | More general version of 'focused'. @@ -312,8 +376,8 @@ focused' m = do mw <- asks focusedWindow liftQuery (maybe mempty (flip local m . const) mw) --- | Run Query on window focused at particular workspace. If there is no --- focused window, return False. +-- | Run 'Query' on window focused at particular workspace. If there is no +-- focused window, return 'False'. focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool focusedOn i m = getAny <$> focusedOn' i (Any <$> m) -- | More general version of 'focusedOn'. @@ -322,8 +386,8 @@ focusedOn' i m = liftQuery $ do mw <- liftX $ withWindowSet (return . W.peek . W.view i) maybe mempty (flip local m . const) mw --- | Run Query on focused window on current workspace. If there is no focused --- window, return False. Note, +-- | Run 'Query' on focused window on current workspace. If there is no +-- focused window, return 'False'. Note, -- -- > focused <&&> newOnCur != focusedCur -- @@ -343,13 +407,12 @@ newOn i = (i ==) <$> asks newWorkspace newOnCur :: FocusQuery Bool newOnCur = asks currentWorkspace >>= newOn --- | Execute Query, unless focus is locked. +-- | Execute 'Query', unless focus is locked. unlessFocusLock :: Monoid a => Query a -> Query a unlessFocusLock m = do FocusLock b <- liftX XS.get when' (not b) m - -- Commonly used actions for modifying focus. -- -- $common @@ -372,7 +435,7 @@ unlessFocusLock m = do -- | Keep focus on workspace (may not be current), where new window appears. -- Workspace will not be switched. This operation is idempotent and -- effectively returns focus to window focused on that workspace before --- applying (Endo WindowSet) function. +-- applying @(Endo WindowSet)@ function. keepFocus :: FocusHook keepFocus = focused' $ ask >>= \w -> doF $ \ws -> W.view (W.currentTag ws) . W.focusWindow w $ ws @@ -392,7 +455,7 @@ switchFocus = do -- | Keep current workspace. Focus will not be changed at either current or -- new window's workspace. This operation is idempotent and effectively --- switches to workspace, which was current before applying (Endo WindowSet) +-- switches to workspace, which was current before applying @(Endo WindowSet)@ -- function. keepWorkspace :: FocusHook keepWorkspace = do @@ -417,10 +480,10 @@ switchWorkspace = do -- $running -- | I don't know at which workspace new window will appear until @(Endo --- WindowSet)@ function from 'windows' in @XMonad.Operations@ actually run, +-- WindowSet)@ function from 'windows' in "XMonad.Operations" actually run, -- but in @(Endo WindowSet)@ function i can't already execute monadic actions, -- because it's pure. So, i compute result for every workspace here and just --- use it later in (Endo WindowSet) function. Note, though, that this will +-- use it later in @(Endo WindowSet)@ function. Note, though, that this will -- execute monadic actions many times, and therefore assume, that result of -- 'FocusHook' does not depend on the number of times it was executed. manageFocus :: FocusHook -> ManageHook @@ -434,8 +497,8 @@ manageFocus m = do return (i, f) reader (selectHook hs) >>= doF where - -- Select and apply (Endo WindowSet) function depending on which workspace - -- new window appeared now. + -- | Select and apply @(Endo WindowSet)@ function depending on which + -- workspace new window appeared now. selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet selectHook cfs nw ws = fromMaybe ws $ do i <- W.findTag nw ws @@ -447,3 +510,29 @@ when' b mx | b = mx | otherwise = return mempty +-- Exmaple configurations. +-- $examples + +-- | Default EWMH window activation behavior: switch to workspace with +-- activated window and switch focus to it. +activateSwitchWs :: ManageHook +activateSwitchWs = manageFocus (liftQuery activated --> + switchWorkspace <+> switchFocus) + +-- | Move activated window to current workspace. +activateOnCurrent' :: ManageHook +activateOnCurrent' = activated --> currentWs >>= unlessFocusLock . doShift + +-- | Move activated window to current workspace and switch focus to it. Note, +-- that i need to explicitly call 'switchFocus' here, because otherwise, when +-- activated window is /already/ on current workspace, focus won't be +-- switched. +activateOnCurrentWs :: ManageHook +activateOnCurrentWs = manageFocus (liftQuery activated <&&> newOnCur --> switchFocus) + <+> activateOnCurrent' + +-- | Move activated window to current workspace, but keep focus unchanged. +activateOnCurrentKeepFocus :: ManageHook +activateOnCurrentKeepFocus = manageFocus (liftQuery activated <&&> newOnCur --> keepFocus) + <+> activateOnCurrent' + From 0f9a6015e48a251c28f8bb1821f3ea420937d46b Mon Sep 17 00:00:00 2001 From: Sam Doshi Date: Wed, 15 Feb 2017 14:45:11 +0000 Subject: [PATCH 07/16] export BinarySpacePartition type --- XMonad/Layout/BinarySpacePartition.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/XMonad/Layout/BinarySpacePartition.hs b/XMonad/Layout/BinarySpacePartition.hs index 206e13a7..1fb17bec 100644 --- a/XMonad/Layout/BinarySpacePartition.hs +++ b/XMonad/Layout/BinarySpacePartition.hs @@ -20,6 +20,7 @@ module XMonad.Layout.BinarySpacePartition ( -- * Usage -- $usage emptyBSP + , BinarySpacePartition , Rotate(..) , Swap(..) , ResizeDirectional(..) From 025433c6582553aa60a14ba4e9a1bff27402f975 Mon Sep 17 00:00:00 2001 From: Peter Jones Date: Wed, 15 Feb 2017 09:36:35 -0700 Subject: [PATCH 08/16] X.U.WindowProperties: Added the ability to test if a window has a tag from `X.A.TagWindows` New data constructor `Tagged` that uses `hasTag` from `X.A.TagWindows`. This is great for building layouts based off of window tags. --- CHANGES.md | 9 +++++++++ XMonad/Util/WindowProperties.hs | 10 +++++++--- 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 942b1c66..8c4f28a5 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,14 @@ # Change Log / Release Notes +## 0.14 (Not Yet) + +### Bug Fixes and Minor Changes + + * `XMonad.Util.WindowProperties` + + - Added the ability to test if a window has a tag from + `XMonad.Actions.TagWindows` + ## 0.13 (February 10, 2017) ### Breaking Changes diff --git a/XMonad/Util/WindowProperties.hs b/XMonad/Util/WindowProperties.hs index d4fe517c..be881e35 100644 --- a/XMonad/Util/WindowProperties.hs +++ b/XMonad/Util/WindowProperties.hs @@ -21,10 +21,12 @@ module XMonad.Util.WindowProperties ( -- $helpers getProp32, getProp32s) where -import XMonad -import qualified XMonad.StackSet as W -import Foreign.C.Types (CLong) + import Control.Monad +import Foreign.C.Types (CLong) +import XMonad +import XMonad.Actions.TagWindows (hasTag) +import qualified XMonad.StackSet as W -- $edsl -- Allows to specify window properties, such as title, classname or @@ -43,6 +45,7 @@ data Property = Title String | Or Property Property | Not Property | Const Bool + | Tagged String -- ^ Tagged via 'XMonad.Actions.TagWindows' deriving (Read, Show) infixr 9 `And` infixr 8 `Or` @@ -78,6 +81,7 @@ 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 +propertyToQuery (Tagged s) = ask >>= \w -> liftX (hasTag s w) -- $helpers From b1dee9b0b4cc51896b07d36fb7e186bf426ec3b3 Mon Sep 17 00:00:00 2001 From: Sam Doshi Date: Thu, 16 Feb 2017 19:12:57 +0000 Subject: [PATCH 09/16] allow border colour to be specified in GSConfig --- CHANGES.md | 6 ++++++ XMonad/Actions/GridSelect.hs | 17 ++++++++--------- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 8c4f28a5..21d154e1 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,12 @@ ## 0.14 (Not Yet) +### Breaking Changes + + * `XMonad.Actions.GridSelect` + + - Added field `gs_bordercolor` to `GSConfig` to specify border color. + ### Bug Fixes and Minor Changes * `XMonad.Util.WindowProperties` diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index 0760dbd5..5d3c6e90 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -205,7 +205,8 @@ data GSConfig a = GSConfig { gs_navigate :: TwoD a (Maybe a), gs_rearranger :: Rearranger a, gs_originFractX :: Double, - gs_originFractY :: Double + gs_originFractY :: Double, + gs_bordercolor :: String } -- | That is 'fromClassName' if you are selecting a 'Window', or @@ -322,15 +323,15 @@ diamondRestrict x y originX originY = findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) findInElementMap pos = find ((== pos) . fst) -drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X () -drawWinBox win font (fg,bg) ch cw text x y cp = +drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X () +drawWinBox win font (fg,bg) bc ch cw text x y cp = withDisplay $ \dpy -> do gc <- liftIO $ createGC dpy win bordergc <- liftIO $ createGC dpy win liftIO $ do Just fgcolor <- initColor dpy fg Just bgcolor <- initColor dpy bg - Just bordercolor <- initColor dpy borderColor + Just bordercolor <- initColor dpy bc setForeground dpy gc fgcolor setBackground dpy gc bgcolor setForeground dpy bordergc bordercolor @@ -378,6 +379,7 @@ updateElementsWithColorizer colorizer elementmap = do colors <- colorizer element (pos == curpos) drawWinBox win font colors + (gs_bordercolor gsconfig) cellheight cellwidth text @@ -390,7 +392,7 @@ stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a) stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop | t == buttonRelease = do s @ TwoDState { td_paneX = px, td_paneY = py, - td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _) } <- get + td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get let gridX = (fi x - (px - cw) `div` 2) `div` cw gridY = (fi y - (py - ch) `div` 2) `div` ch case lookup (gridX,gridY) (td_elementmap s) of @@ -714,10 +716,7 @@ decorateName' w = do -- | Builds a default gs config from a colorizer function. buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a -buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) - -borderColor :: String -borderColor = "white" +buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white" -- | Brings selected window to the current workspace. bringSelected :: GSConfig Window -> X () From a79a116934ce64e01c727d8397f325ad546ccf54 Mon Sep 17 00:00:00 2001 From: Sam Doshi Date: Sat, 18 Feb 2017 13:46:30 +0000 Subject: [PATCH 10/16] improve the vertical centring in X.A.GridSelect --- CHANGES.md | 4 ++++ XMonad/Actions/GridSelect.hs | 5 ++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 21d154e1..b7232834 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -10,6 +10,10 @@ ### Bug Fixes and Minor Changes + * `XMonad.Actions.GridSelect` + + - The vertical centring of text in each cell has been improved. + * `XMonad.Util.WindowProperties` - Added the ability to test if a window has a tag from diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index 5d3c6e90..90eef16f 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -341,7 +341,10 @@ drawWinBox win font (fg,bg) bc ch cw text x y cp = (\n -> do size <- liftIO $ textWidthXMF dpy font n return $ size > (fromInteger (cw-(2*cp)))) text - printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext + -- calculate the offset to vertically centre the text based on the ascender and descender + (asc,desc) <- liftIO $ textExtentsXMF font stext + let offset = ((ch - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc + printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+offset)) stext liftIO $ freeGC dpy gc liftIO $ freeGC dpy bordergc From a372b455dc9adf25447fb0d6abe907d6a92dab70 Mon Sep 17 00:00:00 2001 From: geekosaur Date: Sat, 18 Feb 2017 17:19:59 -0500 Subject: [PATCH 11/16] typo in navigation2DP example The example code in the documentation uses `navigation2D` instead of `navigation2DP`, evidently a simple copy/paste error. No actual code change. --- XMonad/Actions/Navigation2D.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/XMonad/Actions/Navigation2D.hs b/XMonad/Actions/Navigation2D.hs index 42b3a53f..fa2646a7 100644 --- a/XMonad/Actions/Navigation2D.hs +++ b/XMonad/Actions/Navigation2D.hs @@ -96,11 +96,11 @@ import XMonad.Util.Types -- -- Alternatively, you can use navigation2DP: -- --- > main = xmonad $ navigation2D def --- > ("", "", "", "") --- > [("M-", windowGo ), --- > ("M-S-", windowSwap)] --- > False +-- > main = xmonad $ navigation2DP def +-- > ("", "", "", "") +-- > [("M-", windowGo ), +-- > ("M-S-", windowSwap)] +-- > False -- > $ def -- -- That's it. If instead you'd like more control, you can combine From 4c00eb58486f445addd78518f37c101efc13c574 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Sun, 19 Feb 2017 20:45:43 -0600 Subject: [PATCH 12/16] fix ThreeColMid window shuffling Fixes #137. --- XMonad/Layout/ThreeColumns.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/XMonad/Layout/ThreeColumns.hs b/XMonad/Layout/ThreeColumns.hs index 0a353f95..458f37a0 100644 --- a/XMonad/Layout/ThreeColumns.hs +++ b/XMonad/Layout/ThreeColumns.hs @@ -97,8 +97,8 @@ split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, split3HorizontallyBy middle f (Rectangle sx sy sw sh) = if middle then ( Rectangle (sx + fromIntegral r3w) sy r1w sh - , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh - , Rectangle sx sy r3w sh ) + , Rectangle sx sy r3w sh + , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh ) else ( Rectangle sx sy r1w sh , Rectangle (sx + fromIntegral r1w) sy r2w sh , Rectangle (sx + fromIntegral r1w + fromIntegral r2w) sy r3w sh ) From 1b96c646c1b36ac2f996d80f9e9c8a10297ff821 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Sat, 25 Feb 2017 09:55:31 -0500 Subject: [PATCH 13/16] Respect number of master windows in Magnify layout --- CHANGES.md | 4 +++ XMonad/Layout/Magnifier.hs | 54 ++++++++++++++++++++------------------ 2 files changed, 32 insertions(+), 26 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index b7232834..1088807c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -19,6 +19,10 @@ - Added the ability to test if a window has a tag from `XMonad.Actions.TagWindows` + * `XMonad.Layout.Magnifier` + + - Handle `IncMasterN` messages. + ## 0.13 (February 10, 2017) ### Breaking Changes diff --git a/XMonad/Layout/Magnifier.hs b/XMonad/Layout/Magnifier.hs index 90a577bd..910341cf 100644 --- a/XMonad/Layout/Magnifier.hs +++ b/XMonad/Layout/Magnifier.hs @@ -83,63 +83,65 @@ import XMonad.Util.XUtils -- | Increase the size of the window that has focus magnifier :: l a -> ModifiedLayout Magnifier l a -magnifier = ModifiedLayout (Mag (1.5,1.5) On All) +magnifier = ModifiedLayout (Mag 1 (1.5,1.5) On All) -- | Change the size of the window that has focus by a custom zoom magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a -magnifiercz cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On All) +magnifiercz cz = ModifiedLayout (Mag 1 (fromRational cz, fromRational cz) On All) --- | Increase the size of the window that has focus, unless if it is the --- master window. +-- | Increase the size of the window that has focus, unless if it is one of the +-- master windows. magnifier' :: l a -> ModifiedLayout Magnifier l a -magnifier' = ModifiedLayout (Mag (1.5,1.5) On NoMaster) +magnifier' = ModifiedLayout (Mag 1 (1.5,1.5) On NoMaster) -- | Magnifier that defaults to Off magnifierOff :: l a -> ModifiedLayout Magnifier l a -magnifierOff = ModifiedLayout (Mag (1.5,1.5) Off All) +magnifierOff = ModifiedLayout (Mag 1 (1.5,1.5) Off All) -- | Increase the size of the window that has focus by a custom zoom, --- unless if it is the master window. +-- unless if it is one of the the master windows. magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a -magnifiercz' cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On NoMaster) +magnifiercz' cz = ModifiedLayout (Mag 1 (fromRational cz, fromRational cz) On NoMaster) -- | A magnifier that greatly magnifies just the vertical direction maximizeVertical :: l a -> ModifiedLayout Magnifier l a -maximizeVertical = ModifiedLayout (Mag (1,1000) Off All) +maximizeVertical = ModifiedLayout (Mag 1 (1,1000) Off All) data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable ) instance Message MagnifyMsg -data Magnifier a = Mag (Double,Double) Toggle MagnifyMaster deriving (Read, Show) +data Magnifier a = Mag !Int (Double,Double) Toggle MagnifyMaster deriving (Read, Show) data Toggle = On | Off deriving (Read, Show) data MagnifyMaster = All | NoMaster deriving (Read, Show) instance LayoutModifier Magnifier Window where - redoLayout (Mag z On All ) r (Just s) wrs = applyMagnifier z r s wrs - redoLayout (Mag z On NoMaster) r (Just s) wrs = unlessMaster (applyMagnifier z) r s wrs + redoLayout (Mag _ z On All ) r (Just s) wrs = applyMagnifier z r s wrs + redoLayout (Mag n z On NoMaster) r (Just s) wrs = unlessMaster n (applyMagnifier z) r s wrs redoLayout _ _ _ wrs = return (wrs, Nothing) - handleMess (Mag z On t) m - | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1 ) On t) - | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` (-0.1)) On t) - | Just ToggleOff <- fromMessage m = return . Just $ (Mag (z ) Off t) - | Just Toggle <- fromMessage m = return . Just $ (Mag (z ) Off t) + handleMess (Mag n z On t) m + | Just MagnifyMore <- fromMessage m = return . Just $ Mag n (z `addto` 0.1 ) On t + | Just MagnifyLess <- fromMessage m = return . Just $ Mag n (z `addto` (-0.1)) On t + | Just ToggleOff <- fromMessage m = return . Just $ Mag n z Off t + | Just Toggle <- fromMessage m = return . Just $ Mag n z Off t + | Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z On t where addto (x,y) i = (x+i,y+i) - handleMess (Mag z Off t) m - | Just ToggleOn <- fromMessage m = return . Just $ (Mag z On t) - | Just Toggle <- fromMessage m = return . Just $ (Mag z On t) + handleMess (Mag n z Off t) m + | Just ToggleOn <- fromMessage m = return . Just $ Mag n z On t + | Just Toggle <- fromMessage m = return . Just $ Mag n z On t + | Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z Off t handleMess _ _ = return Nothing - modifierDescription (Mag _ On All ) = "Magnifier" - modifierDescription (Mag _ On NoMaster) = "Magnifier NoMaster" - modifierDescription (Mag _ Off _ ) = "Magnifier (off)" + modifierDescription (Mag _ _ On All ) = "Magnifier" + modifierDescription (Mag _ _ On NoMaster) = "Magnifier NoMaster" + modifierDescription (Mag _ _ Off _ ) = "Magnifier (off)" type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a)) -unlessMaster :: NewLayout a -> NewLayout a -unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing) - else mainmod r s wrs +unlessMaster :: Int -> NewLayout a -> NewLayout a +unlessMaster n mainmod r s wrs = if null (drop (n-1) (up s)) then return (wrs, Nothing) + else mainmod r s wrs applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a) From 057af44998f5d5d44ca0fc725f35cc01fec13181 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Sun, 26 Mar 2017 22:02:48 -0500 Subject: [PATCH 14/16] X.U.EZConfig: include Latin1 keys --- XMonad/Util/EZConfig.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs index 841b8786..fdf89901 100644 --- a/XMonad/Util/EZConfig.hs +++ b/XMonad/Util/EZConfig.hs @@ -427,7 +427,11 @@ parseKey = parseRegular +++ parseSpecial -- | Parse a regular key name (represented by itself). parseRegular :: ReadP KeySym parseRegular = choice [ char s >> return k - | (s,k) <- zip ['!'..'~'] [xK_exclam..xK_asciitilde] + | (s,k) <- zip ['!' .. '~' ] -- ASCII + [xK_exclam .. xK_asciitilde] + + ++ zip ['\xa0' .. '\xff' ] -- Latin1 + [xK_nobreakspace .. xK_ydiaeresis] ] -- | Parse a special key name (one enclosed in angle brackets). From 4ba56ee388500e8468aa778c113e9c666ef1bf65 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Sun, 26 Mar 2017 22:06:05 -0500 Subject: [PATCH 15/16] update CHANGES for EZConfig Latin1 changes --- CHANGES.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 1088807c..b23e07b2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -23,6 +23,11 @@ - Handle `IncMasterN` messages. + * `XMonad.Util.EZConfig` + + - Can now parse Latin1 keys, to better accommodate users with + non-US keyboards. + ## 0.13 (February 10, 2017) ### Breaking Changes From 3ab4a94d6fc3c5e0fc9d59867c6ae22509dd92f2 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Thu, 30 Mar 2017 16:10:21 -0500 Subject: [PATCH 16/16] clean up Hooks.Focus-related CHANGES and move to 0.14 --- CHANGES.md | 88 ++++++++++++++++++++++++++---------------------------- 1 file changed, 42 insertions(+), 46 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 9ecbfbbf..e1a79b6f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,6 +8,33 @@ - Added field `gs_bordercolor` to `GSConfig` to specify border color. + * `ewmh` function from `X.H.EwmhDesktops` will use `manageHook` for handling + activated window. That means, actions, which you don't want to happen on + activated windows, should be guarded by + + not <$> activated + + predicate. By default, with empty `ManageHook`, window activation will do + nothing. + + Also, you can use regular 'ManageHook' combinators for changing window + activation behavior. + +### New Modules + + * `XMonad.Hooks.Focus` + + A new module extending ManageHook EDSL to work on focused windows and + current workspace. + + This module will enable window activation (`_NET_ACTIVE_WINDOW`) and apply + `manageHook` to activated window too. Thus, it may lead to unexpected + results, when `manageHook` previously working only for new windows, start + working for activated windows too. It may be solved, by adding + `not <$> activated` before those part of `manageHook`, which should not be + called for activated windows. But this lifts `manageHook` into + `FocusHook` and it needs to be converted back later using `manageFocus`. + ### Bug Fixes and Minor Changes * `XMonad.Actions.GridSelect` @@ -28,6 +55,20 @@ - Can now parse Latin1 keys, to better accommodate users with non-US keyboards. + * `XMonad.Actions.Submap` + + Establish pointer grab to avoid freezing X, when button press occurs after + submap key press. And terminate submap at button press in the same way, + as we do for wrong key press. + + * `XMonad.Hooks.SetWMName` + + Add function `getWMName`. + + * `XMonad.Hooks.ManageHelpers` + + Make type of ManageHook combinators more general. + ## 0.13 (February 10, 2017) ### Breaking Changes @@ -39,18 +80,6 @@ * New constructor `CenteredAt Rational Rational` added for `XMonad.Prompt.XPPosition`. - * `ewmh` function from `X.H.EwmhDesktops` will use `manageHook` for handling - activated window. That means, actions, which you don't want to happen on - activated windows, should be guarded by - - not <$> activated - - predicate. By default, with empty `ManageHook`, window activation will do - nothing. - - Also, you can use regular 'ManageHook' combinators for changing window - activation behavior. - * `XMonad.Prompt` now stores its history file in the XMonad cache directory in a file named `prompt-history`. @@ -85,19 +114,6 @@ EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since you will usually be taken to the `NSP` workspace by them. - * `XMonad.Hooks.Focus` - - A new module extending ManageHook EDSL to work on focused windows and - current workspace. - - This module will enable window activation (`_NET_ACTIVE_WINDOW`) and apply - `manageHook` to activated window too. Thus, it may lead to unexpected - results, when `manageHook` previously working only for new windows, start - working for activated windows too. It may be solved, by adding - `not <$> activated` before those part of `manageHook`, which should not be - called for activated windows. But this lifts `manageHook` into - `FocusHook` and it needs to be converted back later using `manageFocus`. - ### Bug Fixes and Minor Changes * `XMonad.Hooks.ManageDocks`, @@ -121,12 +137,6 @@ - Fix bug when cursor gets stuck in one of the corners. - * `XMonad.Actions.Submap` - - Establish pointer grab to avoid freezing X, when button press occurs after - submap key press. And terminate submap at button press in the same way, - as we do for wrong key press. - * `XMonad.Actions.DynamicProjects` - Switching away from a dynamic project that contains no windows @@ -136,24 +146,10 @@ the workspace created for it as well. - Added function to change the working directory (`changeProjectDirPrompt`) - + - All of the prompts are now multiple mode prompts. Try using the `changeModeKey` in a prompt and see what happens! - * `XMonad.Actions.Submap` - - Establish pointer grab to avoid freezing X, when button press occurs after - submap key press. And terminate submap at button press in the same way, - as we do for wrong key press. - - * `XMonad.Hooks.SetWMName` - - Add function `getWMName`. - - * `XMonad.Hooks.ManageHelpers` - - Make type of ManageHook combinators more general. - ## 0.12 (December 14, 2015) ### Breaking Changes