Copyright | sgf-dma 2016 |
---|---|
Maintainer | sgf.dma@gmail.com |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Extensions |
|
Extends XMonad.ManageHook EDSL to work on focused windows and current workspace.
Synopsis
- data Focus = Focus {}
- newtype FocusLock = FocusLock {
- getFocusLock :: Bool
- toggleLock :: X ()
- focusLockOn :: X ()
- focusLockOff :: X ()
- data FocusQuery a
- runFocusQuery :: FocusQuery a -> Focus -> Query a
- type FocusHook = FocusQuery (Endo WindowSet)
- liftQuery :: Query a -> FocusQuery a
- new :: Query a -> FocusQuery a
- focused :: Query Bool -> FocusQuery Bool
- focused' :: Monoid a => Query a -> FocusQuery a
- focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool
- focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a
- focusedCur :: Query Bool -> FocusQuery Bool
- focusedCur' :: Monoid a => Query a -> FocusQuery a
- newOn :: WorkspaceId -> FocusQuery Bool
- newOnCur :: FocusQuery Bool
- unlessFocusLock :: Monoid a => Query a -> Query a
- keepFocus :: FocusHook
- switchFocus :: FocusHook
- keepWorkspace :: FocusHook
- switchWorkspace :: FocusHook
- manageFocus :: FocusHook -> ManageHook
- activateSwitchWs :: ManageHook
- activateOnCurrentWs :: ManageHook
- activateOnCurrentKeepFocus :: ManageHook
Documentation
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 a property in extensible state:
- is focus lock enabled? Focus lock instructs all library's
FocusHook
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.
Quick start.
I may use one of predefined configurations.
The default window activation behavior (switch to workspace with activated window and switch focus to it) expressed using this module:
import XMonad import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.Focus main :: IO () main = do let ah :: ManageHook ah = activateSwitchWs xcf = setEwmhActivateHook ah . ewmh $ def{ modMask = mod4Mask } xmonad xcf
Or i may move activated window to current workspace and switch focus to it:
let ah :: ManageHook ah = activateOnCurrentWs
Or move activated window to current workspace, but keep focus unchanged:
let ah :: ManageHook ah = activateOnCurrentKeepFocus
I may use regular
ManageHook
combinators for filtering, which windows may activate. E.g. activate all windows, except firefox:let ah :: ManageHook ah = not <$> (className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") --> activateSwitchWs
Or even use
FocusHook
combinators. E.g. activate all windows, unless xterm is focused on current workspace:let ah :: ManageHook ah = manageFocus (not <$> focusedCur (className =? "XTerm") --> liftQuery activateSwitchWs)
or activate all windows, unless focused window on the workspace, where activated window is, is not a xterm:
let ah :: ManageHook ah = manageFocus (not <$> focused (className =? "XTerm") --> liftQuery activateSwitchWs)
Defining FocusHook.
I may define my own 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 (thus, i use 'composeAll'). -- See 'keepFocus' properties in the docs below. [ 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 =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog) -?> keepFocus -- Default behavior for new windows: switch focus. , return True -?> switchFocus ]
And then use it:
import XMonad import XMonad.Util.EZConfig import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageHelpers import XMonad.Hooks.Focus main :: IO () main = do let newFh :: ManageHook newFh = manageFocus newFocusHook acFh :: ManageHook acFh = manageFocus activateFocusHook xcf = setEwmhActivateHook acFh . ewmh $ def { manageHook = newFh <> manageHook def , modMask = mod4Mask } `additionalKeys` [((mod4Mask, xK_v), toggleLock)] xmonad xcf
Note:
- 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.
FocusHook
inmanageHook
will be called only for new windows.FocusHook
insetEwmhActivateHook
will be called only for activated windows.
Alternatively, i may construct a single FocusHook
for both new and
activated windows and then just add it to both manageHook
and setEwmhActivateHook
:
let fh :: Bool -> ManageHook fh activated = manageFocus $ composeOne [ pure activated -?> activateFocusHook , pure True -?> newFocusHook ] xcf = setEwmhActivateHook (fh True) . ewmh $ def { manageHook = fh False <> manageHook def , modMask = mod4Mask } `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
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 it inManageHook
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 addFocusHook
the last.FocusHook
functions won't see window shift to another workspace made by function fromFocusHook
itself: new window workspace is determined before runningFocusHook
and even if later one ofFocusHook
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 splittingFocusHook
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 byFH1
.
Another interesting example is moving all activated windows to current
workspace by default, and applying FocusHook
after:
import XMonad import XMonad.Util.EZConfig import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageHelpers import XMonad.Hooks.Focus main :: IO () main = do let fh :: Bool -> ManageHook fh activated = manageFocus $ composeOne [ pure activated -?> (newOnCur --> keepFocus) , pure True -?> newFocusHook ] xcf = setEwmhActivateHook (fh True <> activateOnCurrentWs) . ewmh $ def { manageHook = fh False <> manageHook def , modMask = mod4Mask } `additionalKeys` [((mod4Mask, xK_v), toggleLock)] xmonad xcf 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 =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog) -?> keepFocus -- Default behavior for new windows: switch focus. , return True -?> switchFocus ]
Note here:
- i keep focus, when activated window appears on current workspace, in this example.
- when
pure 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 before applyingactivateOnCurrentWs
FocusHook
.
FocusQuery.
Information about current workspace and focus.
Focus | |
|
Instances
Show Focus Source # | |
Default Focus Source # | |
Defined in XMonad.Hooks.Focus | |
MonadReader Focus FocusQuery Source # | |
Defined in XMonad.Hooks.Focus ask :: FocusQuery Focus # local :: (Focus -> Focus) -> FocusQuery a -> FocusQuery a # reader :: (Focus -> a) -> FocusQuery a # |
Instances
Show FocusLock Source # | |
ExtensionClass FocusLock Source # | |
Defined in XMonad.Hooks.Focus |
toggleLock :: X () Source #
Toggle stored focus lock state.
focusLockOn :: X () Source #
Lock focus.
focusLockOff :: X () Source #
Unlock focus.
data FocusQuery a Source #
Monad on top of Query
providing additional information about new
window.
Instances
runFocusQuery :: FocusQuery a -> Focus -> Query a Source #
Lifting into FocusQuery.
liftQuery :: Query a -> FocusQuery a Source #
Lift Query
into FocusQuery
monad. The same as new
.
focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool Source #
focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a Source #
More general version of focusedOn
.
focusedCur :: Query Bool -> FocusQuery Bool Source #
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' :: Monoid a => Query a -> FocusQuery a Source #
More general version of focusedCur
.
newOn :: WorkspaceId -> FocusQuery Bool Source #
Does new window appear at particular workspace?
newOnCur :: FocusQuery Bool Source #
Does new window appear at current workspace?
Commonly used actions for modifying focus.
Operations in each pair keepFocus
and switchFocus
, keepWorkspace
and
switchWorkspace
overwrite each other (the letftmost will determine what
happened):
keepFocus <> switchFocus = keepFocus
switchFocus <> keepFocus = switchFocus
keepWorkspace <> switchWorkspace = keepWorkspace
switchWorkspace <> keepWorkspace = switchWorkspace
and operations from different pairs are commutative:
keepFocus <> switchWorkspace = switchWorkspace <> keepFocus
switchFocus <> switchWorkspace = switchWorkspace <> switchFocus
etc.
keepFocus :: FocusHook Source #
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.
switchFocus :: FocusHook Source #
Switch focus to new window on workspace (may not be current), where new window appears. Workspace will not be switched. This operation is idempotent.
keepWorkspace :: FocusHook Source #
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.
switchWorkspace :: FocusHook Source #
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.
Running FocusQuery.
manageFocus :: FocusHook -> ManageHook Source #
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.
Example configurations.
activateSwitchWs :: ManageHook Source #
Default EWMH window activation behavior: switch to workspace with
activated window and switch focus to it. Not to be used in a manageHook
.
activateOnCurrentWs :: ManageHook Source #
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. Not to be used in a manageHook
.
activateOnCurrentKeepFocus :: ManageHook Source #
Move activated window to current workspace, but keep focus unchanged.
Not to be used in a manageHook
.