{-# 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\/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 :: WorkspaceId
-> WorkspaceId
-> (Position -> Rectangle -> Rectangle)
-> WorkspaceId
-> ChordKeys
-> EventMask
-> WorkspaceId
-> Int
-> Int
-> EasyMotionConfig
EMConf { txtCol :: WorkspaceId
txtCol      = WorkspaceId
"#ffffff"
           , bgCol :: WorkspaceId
bgCol       = WorkspaceId
"#000000"
           , overlayF :: Position -> Rectangle -> Rectangle
overlayF    = Double -> Position -> Rectangle -> Rectangle
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
_ = 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 :: forall f. RealFrac f => f -> Position -> Rectangle -> Rectangle
proportional f
f Position
th Rectangle
r = Rectangle :: Position -> Position -> EventType -> EventType -> Rectangle
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
- EventType
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
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
- EventType
newH) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2 }
 where
  newH :: EventType
newH = EventType -> EventType -> EventType
forall a. Ord a => a -> a -> a
max (Position -> EventType
forall a b. (Integral a, Num b) => a -> b
fi Position
th) (f -> EventType
forall a b. (RealFrac a, Integral b) => a -> b
round (f -> EventType) -> f -> EventType
forall a b. (a -> b) -> a -> b
$ f
f f -> f -> f
forall a. Num a => a -> a -> a
* EventType -> f
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 :: Position -> Position -> EventType -> EventType -> Rectangle
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
- EventType
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
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
- EventType
rh) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2 }
 where
  rw :: EventType
rw = EventType -> EventType -> EventType
forall a. Ord a => a -> a -> a
max (a -> EventType
forall a b. (Integral a, Num b) => a -> b
fi a
w) (Position -> EventType
forall a b. (Integral a, Num b) => a -> b
fi Position
th)
  rh :: EventType
rh = EventType -> EventType -> EventType
forall a. Ord a => a -> a -> a
max (b -> EventType
forall a b. (Integral a, Num b) => a -> b
fi b
h) (Position -> EventType
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 -> EventType -> EventType -> Rectangle
Rectangle { rect_width :: EventType
rect_width  = Position -> EventType
forall a b. (Integral a, Num b) => a -> b
fi Position
th
                          , rect_height :: EventType
rect_height = Position -> EventType
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
+ (EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
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
+ (EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
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 :: forall f. RealFrac f => f -> Position -> Rectangle -> Rectangle
bar f
f Position
th Rectangle
r = Rectangle :: Position -> Position -> EventType -> EventType -> Rectangle
Rectangle { rect_width :: EventType
rect_width  = Rectangle -> EventType
rect_width Rectangle
r
                       , rect_height :: EventType
rect_height = Position -> EventType
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
* (EventType -> f
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
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 EventMask)
handleSelectWindow EMConf { sKeys :: EasyMotionConfig -> ChordKeys
sKeys = AnyKeys [] } = Maybe EventMask -> X (Maybe EventMask)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EventMask
forall a. Maybe a
Nothing
handleSelectWindow EasyMotionConfig
c = do
  XMonadFont
f <- WorkspaceId -> X XMonadFont
initXMF (WorkspaceId -> X XMonadFont) -> WorkspaceId -> X XMonadFont
forall a b. (a -> b) -> a -> b
$ EasyMotionConfig -> WorkspaceId
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 -> WorkspaceId -> X (Position, Position)
forall (m :: * -> *).
MonadIO m =>
XMonadFont -> WorkspaceId -> m (Position, Position)
textExtentsXMF XMonadFont
f ((EventMask -> WorkspaceId) -> [EventMask] -> WorkspaceId
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventMask -> WorkspaceId
keysymToString (ChordKeys -> [EventMask]
allKeys (ChordKeys -> [EventMask])
-> (EasyMotionConfig -> ChordKeys)
-> EasyMotionConfig
-> [EventMask]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EasyMotionConfig -> ChordKeys
sKeys (EasyMotionConfig -> [EventMask])
-> EasyMotionConfig -> [EventMask]
forall a b. (a -> b) -> a -> b
$ EasyMotionConfig
c))
  XConf { theRoot :: XConf -> EventMask
theRoot = EventMask
rw, display :: XConf -> Display
display = Display
dpy } <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
  XState { mapped :: XState -> Set EventMask
mapped = Set EventMask
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 [EventMask]
ks -> [EventMask] -> [OverlayWindow] -> [Overlay]
buildOverlays [EventMask]
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 :: [EventMask]
visibleWindows = Set EventMask -> [EventMask]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set EventMask
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
<$> Position -> [EventMask] -> X [OverlayWindow]
buildOverlayWindows Position
th [EventMask]
visibleWindows
    PerScreenKeys Map ScreenId [EventMask]
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 -> [EventMask] -> X [Overlay])
-> Map ScreenId [EventMask] -> Map ScreenId (X [Overlay])
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 ([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 [EventMask]
m
     where
      screenById :: ScreenId -> Maybe WindowScreen
      screenById :: ScreenId -> Maybe WindowScreen
screenById ScreenId
sid = (WindowScreen -> Bool) -> [WindowScreen] -> Maybe WindowScreen
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)
-> (WindowScreen -> ScreenId) -> WindowScreen -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowScreen -> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) (WindowSet -> [WindowScreen]
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 = (EventMask -> Bool) -> [EventMask] -> [EventMask]
forall a. (a -> Bool) -> [a] -> [a]
filter (EventMask -> [EventMask] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set EventMask -> [EventMask]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set EventMask
mappedWins) ([EventMask] -> [EventMask]) -> [EventMask] -> [EventMask]
forall a b. (a -> b) -> a -> b
$ Maybe (Stack EventMask) -> [EventMask]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack EventMask) -> [EventMask])
-> Maybe (Stack EventMask) -> [EventMask]
forall a b. (a -> b) -> a -> b
$ ScreenId -> Maybe WindowScreen
screenById ScreenId
sid Maybe WindowScreen
-> (WindowScreen -> Maybe (Stack EventMask))
-> Maybe (Stack EventMask)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Workspace WorkspaceId (Layout EventMask) EventMask
-> Maybe (Stack EventMask)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace WorkspaceId (Layout EventMask) EventMask
 -> Maybe (Stack EventMask))
-> (WindowScreen
    -> Workspace WorkspaceId (Layout EventMask) EventMask)
-> WindowScreen
-> Maybe (Stack EventMask)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowScreen -> Workspace WorkspaceId (Layout EventMask) EventMask
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
<$> Position -> [EventMask] -> X [OverlayWindow]
buildOverlayWindows Position
th (ScreenId -> [EventMask]
visibleWindowsOnScreen ScreenId
sid)
  CInt
status <- IO CInt -> X CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO CInt -> X CInt) -> IO CInt -> X CInt
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 CInt -> CInt -> Bool
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 []
      IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> IO ()
ungrabKeyboard Display
dpy EventMask
currentTime
      (Overlay -> X ()) -> [Overlay] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (EventMask -> X ()
deleteWindow (EventMask -> X ()) -> (Overlay -> EventMask) -> Overlay -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> EventMask
overlay (OverlayWindow -> EventMask)
-> (Overlay -> OverlayWindow) -> Overlay -> EventMask
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 EventMask -> X (Maybe EventMask)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EventMask -> X (Maybe EventMask))
-> (Overlay -> Maybe EventMask) -> Overlay -> X (Maybe EventMask)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventMask -> Maybe EventMask
forall a. a -> Maybe a
Just (EventMask -> Maybe EventMask)
-> (Overlay -> EventMask) -> Overlay -> Maybe EventMask
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> EventMask
win (OverlayWindow -> EventMask)
-> (Overlay -> OverlayWindow) -> Overlay -> EventMask
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> OverlayWindow
overlayWin (Overlay -> X (Maybe EventMask)) -> Overlay -> X (Maybe EventMask)
forall a b. (a -> b) -> a -> b
$ Overlay
o
        -- return focus correctly
        HandleResult
_ -> Maybe EventMask -> (EventMask -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (WindowSet -> Maybe EventMask
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 ())
-> (EventMask -> WindowSet -> WindowSet) -> EventMask -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventMask -> 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 EventMask -> X (Maybe EventMask)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe EventMask
forall a. Maybe a
Nothing
    else XMonadFont -> X ()
releaseXMF XMonadFont
f X () -> Maybe EventMask -> X (Maybe EventMask)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe EventMask
forall a. Maybe a
Nothing
 where
  allKeys :: ChordKeys -> [KeySym]
  allKeys :: ChordKeys -> [EventMask]
allKeys (AnyKeys [EventMask]
ks) = [EventMask]
ks
  allKeys (PerScreenKeys Map ScreenId [EventMask]
m) = [[EventMask]] -> [EventMask]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[EventMask]] -> [EventMask]) -> [[EventMask]] -> [EventMask]
forall a b. (a -> b) -> a -> b
$ Map ScreenId [EventMask] -> [[EventMask]]
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 = ([Maybe OverlayWindow] -> [OverlayWindow])
-> X [Maybe OverlayWindow] -> X [OverlayWindow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([OverlayWindow] -> Maybe [OverlayWindow] -> [OverlayWindow]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [OverlayWindow] -> [OverlayWindow])
-> ([Maybe OverlayWindow] -> Maybe [OverlayWindow])
-> [Maybe OverlayWindow]
-> [OverlayWindow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe OverlayWindow] -> Maybe [OverlayWindow]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA)
                         (X [Maybe OverlayWindow] -> X [OverlayWindow])
-> ([EventMask] -> X [Maybe OverlayWindow])
-> [EventMask]
-> X [OverlayWindow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventMask -> X (Maybe OverlayWindow))
-> [EventMask] -> X [Maybe OverlayWindow]
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 = (OverlayWindow -> (CInt, CInt))
-> [OverlayWindow] -> [OverlayWindow]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((WindowAttributes -> CInt
wa_x (WindowAttributes -> CInt)
-> (WindowAttributes -> CInt) -> WindowAttributes -> (CInt, CInt)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& WindowAttributes -> CInt
wa_y) (WindowAttributes -> (CInt, CInt))
-> (OverlayWindow -> WindowAttributes)
-> OverlayWindow
-> (CInt, CInt)
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 (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_x WindowAttributes
wa)) (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_y WindowAttributes
wa)) (CInt -> EventType
forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_width WindowAttributes
wa)) (CInt -> EventType
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 X (Maybe WindowAttributes)
-> (Maybe WindowAttributes -> X (Maybe OverlayWindow))
-> X (Maybe OverlayWindow)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe WindowAttributes
Nothing     -> Maybe OverlayWindow -> X (Maybe OverlayWindow)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OverlayWindow
forall a. Maybe a
Nothing
    Just WindowAttributes
wAttrs -> do
      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
      EventMask
o <- Rectangle -> Maybe EventMask -> WorkspaceId -> Bool -> X EventMask
createNewWindow Rectangle
r Maybe EventMask
forall a. Maybe a
Nothing WorkspaceId
"" Bool
True
      Maybe OverlayWindow -> X (Maybe OverlayWindow)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe OverlayWindow -> X (Maybe OverlayWindow))
-> (OverlayWindow -> Maybe OverlayWindow)
-> OverlayWindow
-> X (Maybe OverlayWindow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> Maybe OverlayWindow
forall a. a -> Maybe a
Just (OverlayWindow -> X (Maybe OverlayWindow))
-> OverlayWindow -> X (Maybe OverlayWindow)
forall a b. (a -> b) -> a -> b
$ OverlayWindow :: EventMask
-> WindowAttributes -> EventMask -> Rectangle -> OverlayWindow
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 (EventType -> EventType
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r)) (EventType -> EventType
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r)) (Int -> EventType
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] [(EventMask -> WorkspaceId) -> [EventMask] -> WorkspaceId
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 = [EventMask] -> [EventMask]
forall a. Eq a => [a] -> [a]
nub ([EventMask] -> [EventMask])
-> ([EventMask] -> [EventMask]) -> [EventMask] -> [EventMask]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventMask -> Bool) -> [EventMask] -> [EventMask]
forall a. (a -> Bool) -> [a] -> [a]
filter (EventMask -> [EventMask] -> Bool
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 ([EventMask] -> ChordKeys)
-> ([EventMask] -> [EventMask]) -> [EventMask] -> ChordKeys
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EventMask] -> [EventMask]
sanitise ([EventMask] -> ChordKeys) -> [EventMask] -> ChordKeys
forall a b. (a -> b) -> a -> b
$ [EventMask]
ks
      PerScreenKeys Map ScreenId [EventMask]
m -> Map ScreenId [EventMask] -> ChordKeys
PerScreenKeys (Map ScreenId [EventMask] -> ChordKeys)
-> Map ScreenId [EventMask] -> ChordKeys
forall a b. (a -> b) -> a -> b
$ ([EventMask] -> [EventMask])
-> Map ScreenId [EventMask] -> Map ScreenId [EventMask]
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 =
  (OverlayWindow -> [EventMask] -> Overlay)
-> [OverlayWindow] -> [[EventMask]] -> [Overlay]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith OverlayWindow -> [EventMask] -> Overlay
Overlay [OverlayWindow]
overlayWins [[EventMask]]
chords
 where
  chords :: [[EventMask]]
chords = Int -> [EventMask] -> [[EventMask]]
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 = -((-([OverlayWindow] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OverlayWindow]
overlayWins)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [EventMask] -> Int
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 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 ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
_ Overlay -> X ()
_ EventMask
_ [] [Overlay]
_ = HandleResult -> X HandleResult
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 <- 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 -> EventMask -> XEventPtr -> IO ()
maskEvent Display
dpy (EventMask
keyPressMask EventMask -> EventMask -> EventMask
forall a. Bits a => a -> a -> a
.|. EventMask
keyReleaseMask EventMask -> EventMask -> EventMask
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 EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
keyPress -> do
         EventMask
s <- IO EventMask -> X EventMask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO EventMask -> X EventMask) -> IO EventMask -> X EventMask
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 EventMask -> EventMask -> Bool
forall a. Eq a => a -> a -> Bool
== EventMask
cancel -> HandleResult -> X HandleResult
forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
Exit
            | EventMask
s EventMask -> EventMask -> Bool
forall a. Eq a => a -> a -> Bool
== EventMask
xK_BackSpace -> HandleResult -> X HandleResult
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 EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
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 -> 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 = ([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 ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected
      HandleResult
_ -> HandleResult -> X HandleResult
forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
x
  isNextOverlayKey :: EventMask -> Bool
isNextOverlayKey EventMask
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 EventMask -> Maybe EventMask -> Bool
forall a. Eq a => a -> a -> Bool
== EventMask -> Maybe EventMask
forall a. a -> Maybe a
Just EventMask
keySym) (Maybe EventMask -> Bool)
-> (Overlay -> Maybe EventMask) -> Overlay -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EventMask] -> Maybe EventMask
forall a. [a] -> Maybe a
listToMaybe ([EventMask] -> Maybe EventMask)
-> (Overlay -> [EventMask]) -> Overlay -> Maybe EventMask
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] -> 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 ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
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 EventMask -> Maybe EventMask -> Bool
forall a. Eq a => a -> a -> Bool
== EventMask -> Maybe EventMask
forall a. a -> Maybe a
Just EventMask
keySym) (Maybe EventMask -> Bool)
-> (Overlay -> Maybe EventMask) -> Overlay -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EventMask] -> Maybe EventMask
forall a. [a] -> Maybe a
listToMaybe ([EventMask] -> Maybe EventMask)
-> (Overlay -> [EventMask]) -> Overlay -> Maybe EventMask
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> [EventMask]
chord) [Overlay]
selected
    trim :: [Overlay] -> [Overlay]
trim = (Overlay -> Overlay) -> [Overlay] -> [Overlay]
forall a b. (a -> b) -> [a] -> [b]
map (\Overlay
o -> Overlay
o { chord :: [EventMask]
chord = [EventMask] -> [EventMask]
forall a. [a] -> [a]
tail ([EventMask] -> [EventMask]) -> [EventMask] -> [EventMask]
forall a b. (a -> b) -> a -> b
$ Overlay -> [EventMask]
chord Overlay
o })
    clear :: [Overlay] -> [Overlay]
clear = (Overlay -> Overlay) -> [Overlay] -> [Overlay]
forall a b. (a -> b) -> [a] -> [b]
map (\Overlay
o -> Overlay
o { chord :: [EventMask]
chord = [] })