{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.EasyMotion
-- Description :  Focus a visible window using a key chord.
-- Copyright   :  (c) Matt Kingston <mattkingston@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  mattkingston@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides functionality to use key chords to focus a visible window. Overlays a unique key chord
-- (a string) above each visible window and allows the user to select a window by typing that
-- chord.
-- Inspired by <https://github.com/easymotion/vim-easymotion vim-easymotion>.
-- Thanks to <https://github.com/larkery Tom Hinton> for some feature inspiration and window
-- sorting code.
--
-----------------------------------------------------------------------------

module XMonad.Actions.EasyMotion ( -- * Usage
                                   -- $usage
                                   selectWindow

                                   -- * Configuration
                                 , EasyMotionConfig(..)
                                 , ChordKeys(..)
                                 , def

                                   -- * Creating overlays
                                 , fullSize
                                 , fixedSize
                                 , textSize
                                 , proportional
                                 , bar
                                 ) where

import           XMonad
import           XMonad.Prelude
import qualified XMonad.StackSet          as W
import           XMonad.Util.Font         (releaseXMF, initXMF, Align(AlignCenter), XMonadFont(..), textExtentsXMF)
import           XMonad.Util.XUtils       (createNewWindow, paintAndWrite, deleteWindow, showWindow)

import           Control.Arrow            ((&&&))
import qualified Data.Map.Strict as M     (Map, elems, map, mapWithKey)

-- $usage
--
-- You can use this module's basic functionality with the following in your
-- @xmonad.hs@:
--
-- >    import XMonad.Actions.EasyMotion (selectWindow)
--
-- To customise
--
-- >    import XMonad.Actions.EasyMotion (selectWindow, EasyMotionConfig(..))
--
-- Then add a keybinding and an action to the 'selectWindow' function.
-- In this case @M-f@ to focus the selected window:
--
-- >    , ((modm, xK_f), selectWindow def >>= (`whenJust` windows . W.focusWindow))
--
-- Similarly, to kill a window with @M-f@:
--
-- >    , ((modm, xK_f), selectWindow def >>= (`whenJust` killWindow))
--
-- See 'EasyMotionConfig' for all configuration options. A short summary follows.
--
-- Default chord keys are @s,d,f,j,k,l@. To customise these and display options assign
-- different values to 'def' (the default configuration):
--
-- >    , ((modm, xK_f), (selectWindow def{sKeys = AnyKeys [xK_f, xK_d]}) >>= (`whenJust` windows . W.focusWindow))
--
-- You must supply at least two different keys in the 'sKeys' list. Keys provided earlier in the list
-- will be used preferentially—therefore, keys you would like to use more frequently should be
-- earlier in the list.
--
-- To map different sets of keys to different screens. The following configuration maps keys @fdsa@
-- to screen 0 and @hjkl@ to screen 1. Keys provided earlier in the list will be used preferentially.
-- Providing the same key for multiple screens is possible but will break down in some scenarios.
--
-- >    import qualified Data.Map.Strict as StrictMap (fromList)
-- >    emConf :: EasyMotionConfig
-- >    emConf = def { sKeys = PerScreenKeys $ StrictMap.fromList [(0, [xK_f, xK_d, xK_s, xK_a]), (1, [xK_h, xK_j, xK_k, xK_l])] }
-- >    -- key bindings
-- >    , ((modm, xK_f), selectWindow emConf >>= (`whenJust` windows . W.focusWindow))
--
-- To customise the font:
--
-- >    , ((modm, xK_f), (selectWindow def{emFont = "xft: Sans-40"}) >>= (`whenJust` windows . W.focusWindow))
--
-- The 'emFont' field provided is supplied directly to the 'initXMF' function. The default is
-- @"xft:Sans-100"@. Some example options:
--
-- >    "xft: Sans-40"
-- >    "xft: Arial-100"
-- >    "xft: Cambria-80"
--
-- Customise the overlay by supplying a function to 'overlayF'. The signature is
-- @'Position' -> 'Rectangle' -> 'Rectangle'@. The parameters are the height in pixels of
-- the selection chord and the rectangle of the window to be overlaid. Some are provided:
--
-- >    import XMonad.Actions.EasyMotion (selectWindow, EasyMotionConfig(..), proportional, bar, fullSize)
-- >    , ((modm, xK_f), (selectWindow def{ overlayF = proportional 0.3  }) >>= (`whenJust` windows . W.focusWindow))
-- >    , ((modm, xK_f), (selectWindow def{ overlayF = bar 0.5           }) >>= (`whenJust` windows . W.focusWindow))
-- >    , ((modm, xK_f), (selectWindow def{ overlayF = fullSize          }) >>= (`whenJust` windows . W.focusWindow))
-- >    , ((modm, xK_f), (selectWindow def{ overlayF = fixedSize 300 350 }) >>= (`whenJust` windows . W.focusWindow))

-- TODO:
--  - An overlay function that creates an overlay a proportion of the width XOR height of the
--    window it's over, and with a fixed w/h proportion? E.g. overlay-height = 0.3 *
--    target-window-height; overlay-width = 0.5 * overlay-height.
--  - An overlay function that creates an overlay of a fixed w,h, aligned mid,mid, or parametrised
--    alignment?
--  - Parametrise chord generation?
--  - W.shift example; bring window from other screen to current screen? Only useful if we don't
--    show chords on current workspace.
--  - Use stringToKeysym, keysymToKeycode, keycodeToKeysym, keysymToString to take a string from
--    the user?
--  - Think a bit more about improving functionality with floating windows.
--    - currently, floating window z-order is not respected
--    - could ignore floating windows
--    - may be able to calculate the visible section of a floating window, and display the chord in
--      that space
--  - Provide an option to prepend the screen key to the easymotion keys (i.e. w,e,r)?
--  - overlay alpha
--  - Delay after selection so the user can see what they've chosen? Min-delay: 0 seconds. If
--    there's a delay, perhaps keep the other windows covered briefly to naturally draw the user's
--    attention to the window they've selected? Or briefly highlight the border of the selected
--    window?
--  - Option to cover windows that will not be selected by the current chord, such that it's
--    slightly more obvious where to maintain focus.
--  - Something unpleasant happens when the user provides only two keys (let's say f, d) for
--    chords. When they have five windows open, the following chords are generated: ddd, ddf, dfd,
--    dff, fdd. When 'f' is pressed, all chords disappear unexpectedly because we know there are no
--    other valid options. The user expects to press 'fdd'. This is an optimisation in software but
--    pretty bad for usability, as the user continues firing keys into their
--    now-unexpectedly-active window. And is of course only one concrete example of a more general
--    problem.
--    Short-term solution:
--      - Keep displaying the chord until the user has fully entered it
--    Fix:
--      - Show the shortest possible chords

-- | Associates a user window, an overlay window created by this module and a rectangle
--   circumscribing these windows
data OverlayWindow =
  OverlayWindow { OverlayWindow -> EventMask
win     :: !Window           -- ^ The window managed by xmonad
                , OverlayWindow -> WindowAttributes
attrs   :: !WindowAttributes -- ^ Window attributes for @win@
                , OverlayWindow -> EventMask
overlay :: !Window           -- ^ Our window used to display the overlay
                , OverlayWindow -> Rectangle
rect    :: !Rectangle        -- ^ The rectangle of @overlay@
                }

-- | An overlay window and the chord used to select it
data Overlay =
  Overlay { Overlay -> OverlayWindow
overlayWin :: !OverlayWindow    -- ^ The window managed by xmonad
          , Overlay -> [EventMask]
chord      :: ![KeySym]         -- ^ The chord we'll display in the overlay
          }


-- | Maps keys to windows. 'AnyKeys' maps keys to windows regardless which screen they're on.
--   'PerScreenKeys' maps keys to screens to windows. See @Usage@ for more examples.
data ChordKeys = AnyKeys       ![KeySym]
               | PerScreenKeys !(M.Map ScreenId [KeySym])

-- | Configuration options for EasyMotion.
--
--   All colors are hex strings, e.g. "#000000"
--
--   If the number of windows for which chords are required exceeds 'maxChordLen', chords
--   will simply not be generated for these windows. In this way, single-key selection may be
--   preferred over the ability to select any window.
--
--   'cancelKey', @xK_BackSpace@ and any duplicates will be removed from 'sKeys' if included.
--   See @Usage@ for examples of 'sKeys'.
data EasyMotionConfig =
  EMConf { EasyMotionConfig -> WorkspaceId
txtCol      :: !String                               -- ^ Color of the text displayed
         , EasyMotionConfig -> WorkspaceId
bgCol       :: !String                               -- ^ Color of the window overlaid
         , EasyMotionConfig -> Position -> Rectangle -> Rectangle
overlayF    :: !(Position -> Rectangle -> Rectangle) -- ^ Function to generate overlay rectangle
         , EasyMotionConfig -> WorkspaceId
borderCol   :: !String                               -- ^ Color of the overlay window borders
         , EasyMotionConfig -> ChordKeys
sKeys       :: !ChordKeys                            -- ^ Keys to use for window selection
         , EasyMotionConfig -> EventMask
cancelKey   :: !KeySym                               -- ^ Key to use to cancel selection
         , EasyMotionConfig -> WorkspaceId
emFont      :: !String                               -- ^ Font for selection characters (passed to 'initXMF')
         , EasyMotionConfig -> Int
borderPx    :: !Int                                  -- ^ Width of border in pixels
         , EasyMotionConfig -> Int
maxChordLen :: !Int                                  -- ^ Maximum chord length. Use 0 for no maximum.
         }

instance Default EasyMotionConfig where
  def :: EasyMotionConfig
def =
    EMConf { txtCol :: WorkspaceId
txtCol      = WorkspaceId
"#ffffff"
           , bgCol :: WorkspaceId
bgCol       = WorkspaceId
"#000000"
           , overlayF :: Position -> Rectangle -> Rectangle
overlayF    = forall f. RealFrac f => f -> Position -> Rectangle -> Rectangle
proportional (Double
0.3::Double)
           , borderCol :: WorkspaceId
borderCol   = WorkspaceId
"#ffffff"
           , sKeys :: ChordKeys
sKeys       = [EventMask] -> ChordKeys
AnyKeys [EventMask
xK_s, EventMask
xK_d, EventMask
xK_f, EventMask
xK_j, EventMask
xK_k, EventMask
xK_l]
           , cancelKey :: EventMask
cancelKey   = EventMask
xK_q
           , borderPx :: Int
borderPx    = Int
1
           , maxChordLen :: Int
maxChordLen = Int
0
#ifdef XFT
           , emFont :: WorkspaceId
emFont      = WorkspaceId
"xft:Sans-100"
#else
           , emFont      = "-misc-fixed-*-*-*-*-200-*-*-*-*-*-*-*"
#endif
           }

-- | Create overlay windows of the same size as the window they select
fullSize :: Position -> Rectangle -> Rectangle
fullSize :: Position -> Rectangle -> Rectangle
fullSize Position
_ = forall a. a -> a
id

-- | Create overlay windows a proportion of the size of the window they select
proportional :: RealFrac f => f -> Position -> Rectangle -> Rectangle
proportional :: forall f. RealFrac f => f -> Position -> Rectangle -> Rectangle
proportional f
f Position
th Rectangle
r = Rectangle { rect_width :: EventType
rect_width  = EventType
newW
                                , rect_height :: EventType
rect_height = EventType
newH
                                , rect_x :: Position
rect_x      = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r forall a. Num a => a -> a -> a
- EventType
newW) forall a. Integral a => a -> a -> a
`div` Position
2
                                , rect_y :: Position
rect_y      = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r forall a. Num a => a -> a -> a
- EventType
newH) forall a. Integral a => a -> a -> a
`div` Position
2 }
 where
  newH :: EventType
newH = forall a. Ord a => a -> a -> a
max (forall a b. (Integral a, Num b) => a -> b
fi Position
th) (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ f
f forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r))
  newW :: EventType
newW = EventType
newH

-- | Create fixed-size overlay windows
fixedSize :: (Integral a, Integral b) => a -> b -> Position -> Rectangle -> Rectangle
fixedSize :: forall a b.
(Integral a, Integral b) =>
a -> b -> Position -> Rectangle -> Rectangle
fixedSize a
w b
h Position
th Rectangle
r = Rectangle { rect_width :: EventType
rect_width  = EventType
rw
                               , rect_height :: EventType
rect_height = EventType
rh
                               , rect_x :: Position
rect_x      = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r forall a. Num a => a -> a -> a
- EventType
rw) forall a. Integral a => a -> a -> a
`div` Position
2
                               , rect_y :: Position
rect_y      = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r forall a. Num a => a -> a -> a
- EventType
rh) forall a. Integral a => a -> a -> a
`div` Position
2 }
 where
  rw :: EventType
rw = forall a. Ord a => a -> a -> a
max (forall a b. (Integral a, Num b) => a -> b
fi a
w) (forall a b. (Integral a, Num b) => a -> b
fi Position
th)
  rh :: EventType
rh = forall a. Ord a => a -> a -> a
max (forall a b. (Integral a, Num b) => a -> b
fi b
h) (forall a b. (Integral a, Num b) => a -> b
fi Position
th)

-- | Create overlay windows the minimum size to contain their key chord
textSize :: Position -> Rectangle -> Rectangle
textSize :: Position -> Rectangle -> Rectangle
textSize Position
th Rectangle
r = Rectangle { rect_width :: EventType
rect_width  = forall a b. (Integral a, Num b) => a -> b
fi Position
th
                          , rect_height :: EventType
rect_height = forall a b. (Integral a, Num b) => a -> b
fi Position
th
                          , rect_x :: Position
rect_x      = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
th) forall a. Integral a => a -> a -> a
`div` Position
2
                          , rect_y :: Position
rect_y      = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
th) forall a. Integral a => a -> a -> a
`div` Position
2 }

-- | Create overlay windows the full width of the window they select, the minimum height to contain
--   their chord, and a proportion of the distance from the top of the window they select
bar :: RealFrac f => f -> Position -> Rectangle -> Rectangle
bar :: forall f. RealFrac f => f -> Position -> Rectangle -> Rectangle
bar f
f Position
th Rectangle
r = Rectangle { rect_width :: EventType
rect_width  = Rectangle -> EventType
rect_width Rectangle
r
                       , rect_height :: EventType
rect_height = forall a b. (Integral a, Num b) => a -> b
fi Position
th
                       , rect_x :: Position
rect_x      = Rectangle -> Position
rect_x Rectangle
r
                       , rect_y :: Position
rect_y      = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round (f
f' forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
th)) }
 where
   -- clamp f in [0,1] as other values will appear to lock up xmonad as the overlay will be
   -- displayed off-screen
   f' :: f
f' = forall a. Ord a => a -> a -> a
min f
0.0 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max f
f f
1.0

-- | Handles overlay display and window selection. Called after config has been sanitised.
handleSelectWindow :: EasyMotionConfig -> X (Maybe Window)
handleSelectWindow :: EasyMotionConfig -> X (Maybe EventMask)
handleSelectWindow EMConf { sKeys :: EasyMotionConfig -> ChordKeys
sKeys = AnyKeys [] } = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
handleSelectWindow EasyMotionConfig
c = do
  XMonadFont
f <- WorkspaceId -> X XMonadFont
initXMF forall a b. (a -> b) -> a -> b
$ EasyMotionConfig -> WorkspaceId
emFont EasyMotionConfig
c
  Position
th <- (\(Position
asc, Position
dsc) -> Position
asc forall a. Num a => a -> a -> a
+ Position
dsc forall a. Num a => a -> a -> a
+ Position
2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
XMonadFont -> WorkspaceId -> m (Position, Position)
textExtentsXMF XMonadFont
f (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventMask -> WorkspaceId
keysymToString (ChordKeys -> [EventMask]
allKeys forall b c a. (b -> c) -> (a -> b) -> a -> c
. EasyMotionConfig -> ChordKeys
sKeys forall a b. (a -> b) -> a -> b
$ EasyMotionConfig
c))
  XConf { theRoot :: XConf -> EventMask
theRoot = EventMask
rw, display :: XConf -> Display
display = Display
dpy } <- forall r (m :: * -> *). MonadReader r m => m r
ask
  XState { mapped :: XState -> Set EventMask
mapped = Set EventMask
mappedWins, windowset :: XState -> WindowSet
windowset = WindowSet
ws } <- forall s (m :: * -> *). MonadState s m => m s
get
  -- build overlays depending on key configuration
  [Overlay]
overlays :: [Overlay] <- case EasyMotionConfig -> ChordKeys
sKeys EasyMotionConfig
c of
    AnyKeys [EventMask]
ks -> [EventMask] -> [OverlayWindow] -> [Overlay]
buildOverlays [EventMask]
ks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [OverlayWindow]
sortedOverlayWindows
     where
      visibleWindows :: [Window]
      visibleWindows :: [EventMask]
visibleWindows = forall l. IsList l => l -> [Item l]
toList Set EventMask
mappedWins
      sortedOverlayWindows :: X [OverlayWindow]
      sortedOverlayWindows :: X [OverlayWindow]
sortedOverlayWindows = [OverlayWindow] -> [OverlayWindow]
sortOverlayWindows forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> [EventMask] -> X [OverlayWindow]
buildOverlayWindows Position
th [EventMask]
visibleWindows
    PerScreenKeys Map ScreenId [EventMask]
m ->
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems
        forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\ScreenId
sid [EventMask]
ks -> [EventMask] -> [OverlayWindow] -> [Overlay]
buildOverlays [EventMask]
ks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScreenId -> X [OverlayWindow]
sortedOverlayWindows ScreenId
sid) Map ScreenId [EventMask]
m
     where
      screenById :: ScreenId -> Maybe WindowScreen
      screenById :: ScreenId -> Maybe WindowScreen
screenById ScreenId
sid = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== ScreenId
sid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) (forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens WindowSet
ws)
      visibleWindowsOnScreen :: ScreenId -> [Window]
      visibleWindowsOnScreen :: ScreenId -> [EventMask]
visibleWindowsOnScreen ScreenId
sid = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall l. IsList l => l -> [Item l]
toList Set EventMask
mappedWins) forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Stack a) -> [a]
W.integrate' forall a b. (a -> b) -> a -> b
$ ScreenId -> Maybe WindowScreen
screenById ScreenId
sid forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace
      sortedOverlayWindows :: ScreenId -> X [OverlayWindow]
      sortedOverlayWindows :: ScreenId -> X [OverlayWindow]
sortedOverlayWindows ScreenId
sid = [OverlayWindow] -> [OverlayWindow]
sortOverlayWindows forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> [EventMask] -> X [OverlayWindow]
buildOverlayWindows Position
th (ScreenId -> [EventMask]
visibleWindowsOnScreen ScreenId
sid)
  CInt
status <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> EventMask -> Bool -> CInt -> CInt -> EventMask -> IO CInt
grabKeyboard Display
dpy EventMask
rw Bool
True CInt
grabModeAsync CInt
grabModeAsync EventMask
currentTime
  if CInt
status forall a. Eq a => a -> a -> Bool
== CInt
grabSuccess
    then do
      HandleResult
resultWin <- Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy (XMonadFont -> Overlay -> X ()
displayOverlay XMonadFont
f) (EasyMotionConfig -> EventMask
cancelKey EasyMotionConfig
c) [Overlay]
overlays []
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> IO ()
ungrabKeyboard Display
dpy EventMask
currentTime
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (EventMask -> X ()
deleteWindow forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> EventMask
overlay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> OverlayWindow
overlayWin) [Overlay]
overlays
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Bool -> IO ()
sync Display
dpy Bool
False
      XMonadFont -> X ()
releaseXMF XMonadFont
f
      case HandleResult
resultWin of
        -- focus the selected window
        Selected Overlay
o -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> EventMask
win forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> OverlayWindow
overlayWin forall a b. (a -> b) -> a -> b
$ Overlay
o
        -- return focus correctly
        HandleResult
_ -> forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws) ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Maybe a
Nothing
    else XMonadFont -> X ()
releaseXMF XMonadFont
f forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Maybe a
Nothing
 where
  allKeys :: ChordKeys -> [KeySym]
  allKeys :: ChordKeys -> [EventMask]
allKeys (AnyKeys [EventMask]
ks) = [EventMask]
ks
  allKeys (PerScreenKeys Map ScreenId [EventMask]
m) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map ScreenId [EventMask]
m

  buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay]
  buildOverlays :: [EventMask] -> [OverlayWindow] -> [Overlay]
buildOverlays = Int -> [EventMask] -> [OverlayWindow] -> [Overlay]
appendChords (EasyMotionConfig -> Int
maxChordLen EasyMotionConfig
c)

  buildOverlayWindows :: Position -> [Window] -> X [OverlayWindow]
  buildOverlayWindows :: Position -> [EventMask] -> X [OverlayWindow]
buildOverlayWindows Position
th = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA)
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Position -> EventMask -> X (Maybe OverlayWindow)
buildOverlayWin Position
th)

  sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]
  sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]
sortOverlayWindows = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((WindowAttributes -> CInt
wa_x forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& WindowAttributes -> CInt
wa_y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> WindowAttributes
attrs)

  makeRect :: WindowAttributes -> Rectangle
  makeRect :: WindowAttributes -> Rectangle
makeRect WindowAttributes
wa = Position -> Position -> EventType -> EventType -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_x WindowAttributes
wa)) (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_y WindowAttributes
wa)) (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_width WindowAttributes
wa)) (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_height WindowAttributes
wa))

  buildOverlayWin :: Position -> Window -> X (Maybe OverlayWindow)
  buildOverlayWin :: Position -> EventMask -> X (Maybe OverlayWindow)
buildOverlayWin Position
th EventMask
w = EventMask -> X (Maybe WindowAttributes)
safeGetWindowAttributes EventMask
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe WindowAttributes
Nothing     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just WindowAttributes
wAttrs -> do
      let r :: Rectangle
r = EasyMotionConfig -> Position -> Rectangle -> Rectangle
overlayF EasyMotionConfig
c Position
th forall a b. (a -> b) -> a -> b
$ WindowAttributes -> Rectangle
makeRect WindowAttributes
wAttrs
      EventMask
o <- Rectangle -> Maybe EventMask -> WorkspaceId -> Bool -> X EventMask
createNewWindow Rectangle
r forall a. Maybe a
Nothing WorkspaceId
"" Bool
True
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OverlayWindow { rect :: Rectangle
rect=Rectangle
r, overlay :: EventMask
overlay=EventMask
o, win :: EventMask
win=EventMask
w, attrs :: WindowAttributes
attrs=WindowAttributes
wAttrs }

  -- | Display an overlay with the provided formatting
  displayOverlay :: XMonadFont -> Overlay -> X ()
  displayOverlay :: XMonadFont -> Overlay -> X ()
displayOverlay XMonadFont
f Overlay { overlayWin :: Overlay -> OverlayWindow
overlayWin = OverlayWindow { rect :: OverlayWindow -> Rectangle
rect = Rectangle
r, overlay :: OverlayWindow -> EventMask
overlay = EventMask
o }, chord :: Overlay -> [EventMask]
chord = [EventMask]
ch } = do
    EventMask -> X ()
showWindow EventMask
o
    EventMask
-> XMonadFont
-> EventType
-> EventType
-> EventType
-> WorkspaceId
-> WorkspaceId
-> WorkspaceId
-> WorkspaceId
-> [Align]
-> [WorkspaceId]
-> X ()
paintAndWrite EventMask
o XMonadFont
f (forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r)) (forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r)) (forall a b. (Integral a, Num b) => a -> b
fi (EasyMotionConfig -> Int
borderPx EasyMotionConfig
c)) (EasyMotionConfig -> WorkspaceId
bgCol EasyMotionConfig
c) (EasyMotionConfig -> WorkspaceId
borderCol EasyMotionConfig
c) (EasyMotionConfig -> WorkspaceId
txtCol EasyMotionConfig
c) (EasyMotionConfig -> WorkspaceId
bgCol EasyMotionConfig
c) [Align
AlignCenter] [forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventMask -> WorkspaceId
keysymToString [EventMask]
ch]

-- | Display overlay windows and chords for window selection
selectWindow :: EasyMotionConfig -> X (Maybe Window)
selectWindow :: EasyMotionConfig -> X (Maybe EventMask)
selectWindow EasyMotionConfig
conf =
  EasyMotionConfig -> X (Maybe EventMask)
handleSelectWindow EasyMotionConfig
conf { sKeys :: ChordKeys
sKeys = ChordKeys -> ChordKeys
sanitiseKeys (EasyMotionConfig -> ChordKeys
sKeys EasyMotionConfig
conf) }
 where
  -- make sure the key lists don't contain: backspace, our cancel key, or duplicates
  sanitise :: [KeySym] -> [KeySym]
  sanitise :: [EventMask] -> [EventMask]
sanitise = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [EventMask
xK_BackSpace, EasyMotionConfig -> EventMask
cancelKey EasyMotionConfig
conf])
  sanitiseKeys :: ChordKeys -> ChordKeys
  sanitiseKeys :: ChordKeys -> ChordKeys
sanitiseKeys ChordKeys
cKeys =
    case ChordKeys
cKeys of
      AnyKeys [EventMask]
ks -> [EventMask] -> ChordKeys
AnyKeys forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EventMask] -> [EventMask]
sanitise forall a b. (a -> b) -> a -> b
$ [EventMask]
ks
      PerScreenKeys Map ScreenId [EventMask]
m -> Map ScreenId [EventMask] -> ChordKeys
PerScreenKeys forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map [EventMask] -> [EventMask]
sanitise Map ScreenId [EventMask]
m

-- | Take a list of overlays lacking chords, return a list of overlays with key chords
appendChords :: Int -> [KeySym] -> [OverlayWindow] -> [Overlay]
appendChords :: Int -> [EventMask] -> [OverlayWindow] -> [Overlay]
appendChords Int
_ [] [OverlayWindow]
_ = []
appendChords Int
maxUserSelectedLen [EventMask]
ks [OverlayWindow]
overlayWins =
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith OverlayWindow -> [EventMask] -> Overlay
Overlay [OverlayWindow]
overlayWins [[EventMask]]
chords
 where
  chords :: [[EventMask]]
chords = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
chordLen [EventMask]
ks
  -- the minimum necessary chord length to assign a unique chord to each visible window
  minCoverLen :: Int
minCoverLen = -((-(forall (t :: * -> *) a. Foldable t => t a -> Int
length [OverlayWindow]
overlayWins)) forall a. Integral a => a -> a -> a
`div` forall (t :: * -> *) a. Foldable t => t a -> Int
length [EventMask]
ks)
  -- if the user has specified a max chord length we use this even if it will not cover all
  -- windows, as they may prefer to focus windows with fewer keys over the ability to focus any
  -- window
  chordLen :: Int
chordLen = if Int
maxUserSelectedLen forall a. Ord a => a -> a -> Bool
<= Int
0 then Int
minCoverLen else forall a. Ord a => a -> a -> a
min Int
minCoverLen Int
maxUserSelectedLen

-- | A three-state result for handling user-initiated selection cancellation, successful selection,
--   or backspace.
data HandleResult = Exit | Selected Overlay | Backspace

-- | Handle key press events for window selection.
handleKeyboard :: Display -> (Overlay -> X()) -> KeySym -> [Overlay] -> [Overlay] -> X HandleResult
handleKeyboard :: Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
_ Overlay -> X ()
_ EventMask
_ [] [Overlay]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
Exit
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected = do
  X [()]
redraw
  Event
ev <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
    Display -> EventMask -> XEventPtr -> IO ()
maskEvent Display
dpy (EventMask
keyPressMask forall a. Bits a => a -> a -> a
.|. EventMask
keyReleaseMask forall a. Bits a => a -> a -> a
.|. EventMask
buttonPressMask) XEventPtr
e
    XEventPtr -> IO Event
getEvent XEventPtr
e
  if | Event -> EventType
ev_event_type Event
ev forall a. Eq a => a -> a -> Bool
== EventType
keyPress -> do
         EventMask
s <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> KeyCode -> CInt -> IO EventMask
keycodeToKeysym Display
dpy (Event -> KeyCode
ev_keycode Event
ev) CInt
0
         if | EventMask
s forall a. Eq a => a -> a -> Bool
== EventMask
cancel -> forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
Exit
            | EventMask
s forall a. Eq a => a -> a -> Bool
== EventMask
xK_BackSpace -> forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
Backspace
            | EventMask -> Bool
isNextOverlayKey EventMask
s -> EventMask -> X HandleResult
handleNextOverlayKey EventMask
s
            | Bool
otherwise -> Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected
     | Event -> EventType
ev_event_type Event
ev forall a. Eq a => a -> a -> Bool
== EventType
buttonPress -> do
         -- See XMonad.Prompt Note [Allow ButtonEvents]
         forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> CInt -> EventMask -> IO ()
allowEvents Display
dpy CInt
replayPointer EventMask
currentTime
         Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected
     | Bool
otherwise -> Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected
 where
  redraw :: X [()]
redraw = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Overlay -> X ()
drawFn) [[Overlay]
selected, [Overlay]
deselected]
  retryBackspace :: HandleResult -> X HandleResult
retryBackspace HandleResult
x =
    case HandleResult
x of
      HandleResult
Backspace -> X [()]
redraw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected
      HandleResult
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
x
  isNextOverlayKey :: EventMask -> Bool
isNextOverlayKey EventMask
keySym = forall a. Maybe a -> Bool
isJust (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just EventMask
keySym) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
.Overlay -> [EventMask]
chord) [Overlay]
selected)
  handleNextOverlayKey :: EventMask -> X HandleResult
handleNextOverlayKey EventMask
keySym =
    case [Overlay]
fg of
      [Overlay
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Overlay -> HandleResult
Selected Overlay
x
      [Overlay]
_   -> Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel ([Overlay] -> [Overlay]
trim [Overlay]
fg) ([Overlay] -> [Overlay]
clear [Overlay]
bg) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HandleResult -> X HandleResult
retryBackspace
   where
    ([Overlay]
fg, [Overlay]
bg) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just EventMask
keySym) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> [EventMask]
chord) [Overlay]
selected
    trim :: [Overlay] -> [Overlay]
trim = forall a b. (a -> b) -> [a] -> [b]
map (\Overlay
o -> Overlay
o { chord :: [EventMask]
chord = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ Overlay -> [EventMask]
chord Overlay
o })
    clear :: [Overlay] -> [Overlay]
clear = forall a b. (a -> b) -> [a] -> [b]
map (\Overlay
o -> Overlay
o { chord :: [EventMask]
chord = [] })