{-# LANGUAGE CPP #-}
{-# 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\/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 -> Window
win     :: !Window           -- ^ The window managed by xmonad
                , OverlayWindow -> WindowAttributes
attrs   :: !WindowAttributes -- ^ Window attributes for @win@
                , OverlayWindow -> Window
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 -> [Window]
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 -> String
txtCol      :: !String                               -- ^ Color of the text displayed
         , EasyMotionConfig -> String
bgCol       :: !String                               -- ^ Color of the window overlaid
         , EasyMotionConfig -> Position -> Rectangle -> Rectangle
overlayF    :: !(Position -> Rectangle -> Rectangle) -- ^ Function to generate overlay rectangle
         , EasyMotionConfig -> String
borderCol   :: !String                               -- ^ Color of the overlay window borders
         , EasyMotionConfig -> ChordKeys
sKeys       :: !ChordKeys                            -- ^ Keys to use for window selection
         , EasyMotionConfig -> Window
cancelKey   :: !KeySym                               -- ^ Key to use to cancel selection
         , EasyMotionConfig -> String
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 :: String
-> String
-> (Position -> Rectangle -> Rectangle)
-> String
-> ChordKeys
-> Window
-> String
-> Int
-> Int
-> EasyMotionConfig
EMConf { txtCol :: String
txtCol      = String
"#ffffff"
           , bgCol :: String
bgCol       = String
"#000000"
           , overlayF :: Position -> Rectangle -> Rectangle
overlayF    = Double -> Position -> Rectangle -> Rectangle
forall f. RealFrac f => f -> Position -> Rectangle -> Rectangle
proportional (Double
0.3::Double)
           , borderCol :: String
borderCol   = String
"#ffffff"
           , sKeys :: ChordKeys
sKeys       = [Window] -> ChordKeys
AnyKeys [Window
xK_s, Window
xK_d, Window
xK_f, Window
xK_j, Window
xK_k, Window
xK_l]
           , cancelKey :: Window
cancelKey   = Window
xK_q
           , borderPx :: Int
borderPx    = Int
1
           , maxChordLen :: Int
maxChordLen = Int
0
#ifdef XFT
           , emFont :: String
emFont      = String
"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
_ = Rectangle -> Rectangle
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 :: f -> Position -> Rectangle -> Rectangle
proportional f
f Position
th Rectangle
r = Rectangle :: Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle { rect_width :: Dimension
rect_width  = Dimension
newW
                                , rect_height :: Dimension
rect_height = Dimension
newH
                                , rect_x :: Position
rect_x      = Rectangle -> Position
rect_x Rectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
newW) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2
                                , rect_y :: Position
rect_y      = Rectangle -> Position
rect_y Rectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
newH) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2 }
 where
  newH :: Dimension
newH = Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
max (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Position
th) (f -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (f -> Dimension) -> f -> Dimension
forall a b. (a -> b) -> a -> b
$ f
f f -> f -> f
forall a. Num a => a -> a -> a
* Dimension -> f
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r))
  newW :: Dimension
newW = Dimension
newH

-- | Create fixed-size overlay windows
fixedSize :: (Integral a, Integral b) => a -> b -> Position -> Rectangle -> Rectangle
fixedSize :: a -> b -> Position -> Rectangle -> Rectangle
fixedSize a
w b
h Position
th Rectangle
r = Rectangle :: Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle { rect_width :: Dimension
rect_width  = Dimension
rw
                               , rect_height :: Dimension
rect_height = Dimension
rh
                               , rect_x :: Position
rect_x      = Rectangle -> Position
rect_x Rectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
rw) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2
                               , rect_y :: Position
rect_y      = Rectangle -> Position
rect_y Rectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
rh) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2 }
 where
  rw :: Dimension
rw = Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
max (a -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi a
w) (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Position
th)
  rh :: Dimension
rh = Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
max (b -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi b
h) (Position -> Dimension
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 :: Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle { rect_width :: Dimension
rect_width  = Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Position
th
                          , rect_height :: Dimension
rect_height = Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Position
th
                          , rect_x :: Position
rect_x      = Rectangle -> Position
rect_x Rectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r) Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position -> Position
forall a b. (Integral a, Num b) => a -> b
fi Position
th) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2
                          , rect_y :: Position
rect_y      = Rectangle -> Position
rect_y Rectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r) Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position -> Position
forall a b. (Integral a, Num b) => a -> b
fi Position
th) Position -> Position -> Position
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 :: f -> Position -> Rectangle -> Rectangle
bar f
f Position
th Rectangle
r = Rectangle :: Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle { rect_width :: Dimension
rect_width  = Rectangle -> Dimension
rect_width Rectangle
r
                       , rect_height :: Dimension
rect_height = Position -> Dimension
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ f -> Position
forall a b. (RealFrac a, Integral b) => a -> b
round (f
f' f -> f -> f
forall a. Num a => a -> a -> a
* (Dimension -> f
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r) f -> f -> f
forall a. Num a => a -> a -> a
- Position -> f
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' = f -> f -> f
forall a. Ord a => a -> a -> a
min f
0.0 (f -> f) -> f -> f
forall a b. (a -> b) -> a -> b
$ f -> f -> f
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 Window)
handleSelectWindow EMConf { sKeys :: EasyMotionConfig -> ChordKeys
sKeys = AnyKeys [] } = Maybe Window -> X (Maybe Window)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Window
forall a. Maybe a
Nothing
handleSelectWindow EasyMotionConfig
c = do
  XMonadFont
f <- String -> X XMonadFont
initXMF (String -> X XMonadFont) -> String -> X XMonadFont
forall a b. (a -> b) -> a -> b
$ EasyMotionConfig -> String
emFont EasyMotionConfig
c
  Position
th <- (\(Position
asc, Position
dsc) -> Position
asc Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
dsc Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
2) ((Position, Position) -> Position)
-> X (Position, Position) -> X Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMonadFont -> String -> X (Position, Position)
forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Position, Position)
textExtentsXMF XMonadFont
f ((Window -> String) -> [Window] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Window -> String
keysymToString (ChordKeys -> [Window]
allKeys (ChordKeys -> [Window])
-> (EasyMotionConfig -> ChordKeys) -> EasyMotionConfig -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EasyMotionConfig -> ChordKeys
sKeys (EasyMotionConfig -> [Window]) -> EasyMotionConfig -> [Window]
forall a b. (a -> b) -> a -> b
$ EasyMotionConfig
c))
  XConf { theRoot :: XConf -> Window
theRoot = Window
rw, display :: XConf -> Display
display = Display
dpy } <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
  XState { mapped :: XState -> Set Window
mapped = Set Window
mappedWins, windowset :: XState -> WindowSet
windowset = WindowSet
ws } <- X XState
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 [Window]
ks -> [Window] -> [OverlayWindow] -> [Overlay]
buildOverlays [Window]
ks ([OverlayWindow] -> [Overlay]) -> X [OverlayWindow] -> X [Overlay]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [OverlayWindow]
sortedOverlayWindows
     where
      visibleWindows :: [Window]
      visibleWindows :: [Window]
visibleWindows = Set Window -> [Window]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Window
mappedWins
      sortedOverlayWindows :: X [OverlayWindow]
      sortedOverlayWindows :: X [OverlayWindow]
sortedOverlayWindows = [OverlayWindow] -> [OverlayWindow]
sortOverlayWindows ([OverlayWindow] -> [OverlayWindow])
-> X [OverlayWindow] -> X [OverlayWindow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Position -> [Window] -> X [OverlayWindow]
buildOverlayWindows Display
dpy Position
th [Window]
visibleWindows
    PerScreenKeys Map ScreenId [Window]
m ->
      ([[Overlay]] -> [Overlay]) -> X [[Overlay]] -> X [Overlay]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Overlay]] -> [Overlay]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (X [[Overlay]] -> X [Overlay]) -> X [[Overlay]] -> X [Overlay]
forall a b. (a -> b) -> a -> b
$ [X [Overlay]] -> X [[Overlay]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        ([X [Overlay]] -> X [[Overlay]]) -> [X [Overlay]] -> X [[Overlay]]
forall a b. (a -> b) -> a -> b
$ Map ScreenId (X [Overlay]) -> [X [Overlay]]
forall k a. Map k a -> [a]
M.elems
        (Map ScreenId (X [Overlay]) -> [X [Overlay]])
-> Map ScreenId (X [Overlay]) -> [X [Overlay]]
forall a b. (a -> b) -> a -> b
$ (ScreenId -> [Window] -> X [Overlay])
-> Map ScreenId [Window] -> Map ScreenId (X [Overlay])
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\ScreenId
sid [Window]
ks -> [Window] -> [OverlayWindow] -> [Overlay]
buildOverlays [Window]
ks ([OverlayWindow] -> [Overlay]) -> X [OverlayWindow] -> X [Overlay]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScreenId -> X [OverlayWindow]
sortedOverlayWindows ScreenId
sid) Map ScreenId [Window]
m
     where
      screenById :: ScreenId -> Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
      screenById :: ScreenId
-> Maybe
     (Screen String (Layout Window) Window ScreenId ScreenDetail)
screenById ScreenId
sid = (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Bool)
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> Maybe
     (Screen String (Layout Window) Window ScreenId ScreenDetail)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ScreenId -> ScreenId -> Bool
forall a. Eq a => a -> a -> Bool
== ScreenId
sid) (ScreenId -> Bool)
-> (Screen String (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId)
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) (WindowSet
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
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 -> [Window]
visibleWindowsOnScreen ScreenId
sid = (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set Window -> [Window]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Window
mappedWins) ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack Window) -> [Window])
-> Maybe (Stack Window) -> [Window]
forall a b. (a -> b) -> a -> b
$ ScreenId
-> Maybe
     (Screen String (Layout Window) Window ScreenId ScreenDetail)
screenById ScreenId
sid Maybe (Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window))
-> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window)
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
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 ([OverlayWindow] -> [OverlayWindow])
-> X [OverlayWindow] -> X [OverlayWindow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Position -> [Window] -> X [OverlayWindow]
buildOverlayWindows Display
dpy Position
th (ScreenId -> [Window]
visibleWindowsOnScreen ScreenId
sid)
  GrabStatus
status <- IO GrabStatus -> X GrabStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO GrabStatus -> X GrabStatus) -> IO GrabStatus -> X GrabStatus
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> Bool
-> GrabStatus
-> GrabStatus
-> Window
-> IO GrabStatus
grabKeyboard Display
dpy Window
rw Bool
True GrabStatus
grabModeAsync GrabStatus
grabModeAsync Window
currentTime
  if GrabStatus
status GrabStatus -> GrabStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GrabStatus
grabSuccess
    then do
      HandleResult
resultWin <- Display
-> (Overlay -> X ())
-> Window
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy (XMonadFont -> Overlay -> X ()
displayOverlay XMonadFont
f) (EasyMotionConfig -> Window
cancelKey EasyMotionConfig
c) [Overlay]
overlays []
      IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
ungrabKeyboard Display
dpy Window
currentTime
      (Overlay -> X ()) -> [Overlay] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Window -> X ()
deleteWindow (Window -> X ()) -> (Overlay -> Window) -> Overlay -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> Window
overlay (OverlayWindow -> Window)
-> (Overlay -> OverlayWindow) -> Overlay -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> OverlayWindow
overlayWin) [Overlay]
overlays
      IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
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 -> Maybe Window -> X (Maybe Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Window -> X (Maybe Window))
-> (Overlay -> Maybe Window) -> Overlay -> X (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Maybe Window
forall a. a -> Maybe a
Just (Window -> Maybe Window)
-> (Overlay -> Window) -> Overlay -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> Window
win (OverlayWindow -> Window)
-> (Overlay -> OverlayWindow) -> Overlay -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> OverlayWindow
overlayWin (Overlay -> X (Maybe Window)) -> Overlay -> X (Maybe Window)
forall a b. (a -> b) -> a -> b
$ Overlay
o
        -- return focus correctly
        HandleResult
_ -> Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws) ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
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) X () -> Maybe Window -> X (Maybe Window)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Window
forall a. Maybe a
Nothing
    else XMonadFont -> X ()
releaseXMF XMonadFont
f X () -> Maybe Window -> X (Maybe Window)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Window
forall a. Maybe a
Nothing
 where
  allKeys :: ChordKeys -> [KeySym]
  allKeys :: ChordKeys -> [Window]
allKeys (AnyKeys [Window]
ks) = [Window]
ks
  allKeys (PerScreenKeys Map ScreenId [Window]
m) = [[Window]] -> [Window]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Window]] -> [Window]) -> [[Window]] -> [Window]
forall a b. (a -> b) -> a -> b
$ Map ScreenId [Window] -> [[Window]]
forall k a. Map k a -> [a]
M.elems Map ScreenId [Window]
m

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

  buildOverlayWindows :: Display -> Position -> [Window] -> X [OverlayWindow]
  buildOverlayWindows :: Display -> Position -> [Window] -> X [OverlayWindow]
buildOverlayWindows Display
dpy Position
th [Window]
ws = [X OverlayWindow] -> X [OverlayWindow]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([X OverlayWindow] -> X [OverlayWindow])
-> [X OverlayWindow] -> X [OverlayWindow]
forall a b. (a -> b) -> a -> b
$ Display -> Position -> Window -> X OverlayWindow
buildOverlayWin Display
dpy Position
th (Window -> X OverlayWindow) -> [Window] -> [X OverlayWindow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Window]
ws

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

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

  buildOverlayWin :: Display -> Position -> Window -> X OverlayWindow
  buildOverlayWin :: Display -> Position -> Window -> X OverlayWindow
buildOverlayWin Display
dpy Position
th Window
w = do
    WindowAttributes
wAttrs <- IO WindowAttributes -> X WindowAttributes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO WindowAttributes -> X WindowAttributes)
-> IO WindowAttributes -> X WindowAttributes
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
dpy Window
w
    let r :: Rectangle
r = EasyMotionConfig -> Position -> Rectangle -> Rectangle
overlayF EasyMotionConfig
c Position
th (Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> Rectangle
makeRect WindowAttributes
wAttrs
    Window
o <- Rectangle -> Maybe Window -> String -> Bool -> X Window
createNewWindow Rectangle
r Maybe Window
forall a. Maybe a
Nothing String
"" Bool
True
    OverlayWindow -> X OverlayWindow
forall (m :: * -> *) a. Monad m => a -> m a
return OverlayWindow :: Window -> WindowAttributes -> Window -> Rectangle -> OverlayWindow
OverlayWindow { rect :: Rectangle
rect=Rectangle
r, overlay :: Window
overlay=Window
o, win :: Window
win=Window
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 -> Window
overlay = Window
o }, chord :: Overlay -> [Window]
chord = [Window]
ch } = do
    Window -> X ()
showWindow Window
o
    Window
-> XMonadFont
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> String
-> String
-> [Align]
-> [String]
-> X ()
paintAndWrite Window
o XMonadFont
f (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r)) (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r)) (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (EasyMotionConfig -> Int
borderPx EasyMotionConfig
c)) (EasyMotionConfig -> String
bgCol EasyMotionConfig
c) (EasyMotionConfig -> String
borderCol EasyMotionConfig
c) (EasyMotionConfig -> String
txtCol EasyMotionConfig
c) (EasyMotionConfig -> String
bgCol EasyMotionConfig
c) [Align
AlignCenter] [(Window -> String) -> [Window] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Window -> String
keysymToString [Window]
ch]

-- | Display overlay windows and chords for window selection
selectWindow :: EasyMotionConfig -> X (Maybe Window)
selectWindow :: EasyMotionConfig -> X (Maybe Window)
selectWindow EasyMotionConfig
conf =
  EasyMotionConfig -> X (Maybe Window)
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 :: [Window] -> [Window]
sanitise = [Window] -> [Window]
forall a. Eq a => [a] -> [a]
nub ([Window] -> [Window])
-> ([Window] -> [Window]) -> [Window] -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window
xK_BackSpace, EasyMotionConfig -> Window
cancelKey EasyMotionConfig
conf])
  sanitiseKeys :: ChordKeys -> ChordKeys
  sanitiseKeys :: ChordKeys -> ChordKeys
sanitiseKeys ChordKeys
cKeys =
    case ChordKeys
cKeys of
      AnyKeys [Window]
ks -> [Window] -> ChordKeys
AnyKeys ([Window] -> ChordKeys)
-> ([Window] -> [Window]) -> [Window] -> ChordKeys
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> [Window]
sanitise ([Window] -> ChordKeys) -> [Window] -> ChordKeys
forall a b. (a -> b) -> a -> b
$ [Window]
ks
      PerScreenKeys Map ScreenId [Window]
m -> Map ScreenId [Window] -> ChordKeys
PerScreenKeys (Map ScreenId [Window] -> ChordKeys)
-> Map ScreenId [Window] -> ChordKeys
forall a b. (a -> b) -> a -> b
$ ([Window] -> [Window])
-> Map ScreenId [Window] -> Map ScreenId [Window]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map [Window] -> [Window]
sanitise Map ScreenId [Window]
m

-- | Take a list of overlays lacking chords, return a list of overlays with key chords
appendChords :: Int -> [KeySym] -> [OverlayWindow] -> [Overlay]
appendChords :: Int -> [Window] -> [OverlayWindow] -> [Overlay]
appendChords Int
_ [] [OverlayWindow]
_ = []
appendChords Int
maxUserSelectedLen [Window]
ks [OverlayWindow]
overlayWins =
  (OverlayWindow -> [Window] -> Overlay)
-> [OverlayWindow] -> [[Window]] -> [Overlay]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith OverlayWindow -> [Window] -> Overlay
Overlay [OverlayWindow]
overlayWins [[Window]]
chords
 where
  chords :: [[Window]]
chords = Int -> [Window] -> [[Window]]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
chordLen [Window]
ks
  -- the minimum necessary chord length to assign a unique chord to each visible window
  minCoverLen :: Int
minCoverLen = -((-([OverlayWindow] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OverlayWindow]
overlayWins)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Int
minCoverLen else Int -> Int -> Int
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 ())
-> Window
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
_ Overlay -> X ()
_ Window
_ [] [Overlay]
_ = HandleResult -> X HandleResult
forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
Exit
handleKeyboard Display
dpy Overlay -> X ()
drawFn Window
cancel [Overlay]
selected [Overlay]
deselected = do
  X [()]
redraw
  Event
ev <- IO Event -> X Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Event -> X Event) -> IO Event -> X Event
forall a b. (a -> b) -> a -> b
$ (XEventPtr -> IO Event) -> IO Event
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO Event) -> IO Event)
-> (XEventPtr -> IO Event) -> IO Event
forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
    Display -> Window -> XEventPtr -> IO ()
maskEvent Display
dpy (Window
keyPressMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
keyReleaseMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
buttonPressMask) XEventPtr
e
    XEventPtr -> IO Event
getEvent XEventPtr
e
  if | Event -> Dimension
ev_event_type Event
ev Dimension -> Dimension -> Bool
forall a. Eq a => a -> a -> Bool
== Dimension
keyPress -> do
         Window
s <- IO Window -> X Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Window -> X Window) -> IO Window -> X Window
forall a b. (a -> b) -> a -> b
$ Display -> KeyCode -> GrabStatus -> IO Window
keycodeToKeysym Display
dpy (Event -> KeyCode
ev_keycode Event
ev) GrabStatus
0
         if | Window
s Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
cancel -> HandleResult -> X HandleResult
forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
Exit
            | Window
s Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
xK_BackSpace -> HandleResult -> X HandleResult
forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
Backspace
            | Window -> Bool
isNextOverlayKey Window
s -> Window -> X HandleResult
handleNextOverlayKey Window
s
            | Bool
otherwise -> Display
-> (Overlay -> X ())
-> Window
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn Window
cancel [Overlay]
selected [Overlay]
deselected
     | Event -> Dimension
ev_event_type Event
ev Dimension -> Dimension -> Bool
forall a. Eq a => a -> a -> Bool
== Dimension
buttonPress -> do
         -- See XMonad.Prompt Note [Allow ButtonEvents]
         IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> GrabStatus -> Window -> IO ()
allowEvents Display
dpy GrabStatus
replayPointer Window
currentTime
         Display
-> (Overlay -> X ())
-> Window
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn Window
cancel [Overlay]
selected [Overlay]
deselected
     | Bool
otherwise -> Display
-> (Overlay -> X ())
-> Window
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn Window
cancel [Overlay]
selected [Overlay]
deselected
 where
  redraw :: X [()]
redraw = ([Overlay] -> X ()) -> [[Overlay]] -> X [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Overlay -> X ()) -> [Overlay] -> X ()
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 X [()] -> X HandleResult -> X HandleResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Display
-> (Overlay -> X ())
-> Window
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn Window
cancel [Overlay]
selected [Overlay]
deselected
      HandleResult
_ -> HandleResult -> X HandleResult
forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
x
  isNextOverlayKey :: Window -> Bool
isNextOverlayKey Window
keySym = Maybe Overlay -> Bool
forall a. Maybe a -> Bool
isJust ((Overlay -> Bool) -> [Overlay] -> Maybe Overlay
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window -> Maybe Window
forall a. a -> Maybe a
Just Window
keySym) (Maybe Window -> Bool)
-> (Overlay -> Maybe Window) -> Overlay -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> Maybe Window
forall a. [a] -> Maybe a
listToMaybe ([Window] -> Maybe Window)
-> (Overlay -> [Window]) -> Overlay -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Overlay -> [Window]
chord) [Overlay]
selected)
  handleNextOverlayKey :: Window -> X HandleResult
handleNextOverlayKey Window
keySym =
    case [Overlay]
fg of
      [Overlay
x] -> HandleResult -> X HandleResult
forall (m :: * -> *) a. Monad m => a -> m a
return (HandleResult -> X HandleResult) -> HandleResult -> X HandleResult
forall a b. (a -> b) -> a -> b
$ Overlay -> HandleResult
Selected Overlay
x
      [Overlay]
_   -> Display
-> (Overlay -> X ())
-> Window
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn Window
cancel ([Overlay] -> [Overlay]
trim [Overlay]
fg) ([Overlay] -> [Overlay]
clear [Overlay]
bg) X HandleResult
-> (HandleResult -> X HandleResult) -> X HandleResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HandleResult -> X HandleResult
retryBackspace
   where
    ([Overlay]
fg, [Overlay]
bg) = (Overlay -> Bool) -> [Overlay] -> ([Overlay], [Overlay])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window -> Maybe Window
forall a. a -> Maybe a
Just Window
keySym) (Maybe Window -> Bool)
-> (Overlay -> Maybe Window) -> Overlay -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> Maybe Window
forall a. [a] -> Maybe a
listToMaybe ([Window] -> Maybe Window)
-> (Overlay -> [Window]) -> Overlay -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> [Window]
chord) [Overlay]
selected
    trim :: [Overlay] -> [Overlay]
trim = (Overlay -> Overlay) -> [Overlay] -> [Overlay]
forall a b. (a -> b) -> [a] -> [b]
map (\Overlay
o -> Overlay
o { chord :: [Window]
chord = [Window] -> [Window]
forall a. [a] -> [a]
tail ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Overlay -> [Window]
chord Overlay
o })
    clear :: [Overlay] -> [Overlay]
clear = (Overlay -> Overlay) -> [Overlay] -> [Overlay]
forall a b. (a -> b) -> [a] -> [b]
map (\Overlay
o -> Overlay
o { chord :: [Window]
chord = [] })