{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
module XMonad.Actions.EasyMotion (
selectWindow
, EasyMotionConfig(..)
, ChordKeys(..)
, def
, 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)
data OverlayWindow =
OverlayWindow { OverlayWindow -> EventMask
win :: !Window
, OverlayWindow -> WindowAttributes
attrs :: !WindowAttributes
, OverlayWindow -> EventMask
overlay :: !Window
, OverlayWindow -> Rectangle
rect :: !Rectangle
}
data Overlay =
Overlay { Overlay -> OverlayWindow
overlayWin :: !OverlayWindow
, Overlay -> [EventMask]
chord :: ![KeySym]
}
data ChordKeys = AnyKeys ![KeySym]
| PerScreenKeys !(M.Map ScreenId [KeySym])
data EasyMotionConfig =
EMConf { EasyMotionConfig -> WorkspaceId
txtCol :: !String
, EasyMotionConfig -> WorkspaceId
bgCol :: !String
, EasyMotionConfig -> Position -> Rectangle -> Rectangle
overlayF :: !(Position -> Rectangle -> Rectangle)
, EasyMotionConfig -> WorkspaceId
borderCol :: !String
, EasyMotionConfig -> ChordKeys
sKeys :: !ChordKeys
, EasyMotionConfig -> EventMask
cancelKey :: !KeySym
, EasyMotionConfig -> WorkspaceId
emFont :: !String
, EasyMotionConfig -> Int
borderPx :: !Int
, EasyMotionConfig -> Int
maxChordLen :: !Int
}
instance Default EasyMotionConfig where
def :: EasyMotionConfig
def =
EMConf { txtCol :: WorkspaceId
txtCol = WorkspaceId
"#ffffff"
, bgCol :: WorkspaceId
bgCol = WorkspaceId
"#000000"
, overlayF :: Position -> Rectangle -> Rectangle
overlayF = forall f. RealFrac f => f -> Position -> Rectangle -> Rectangle
proportional (Double
0.3::Double)
, borderCol :: WorkspaceId
borderCol = WorkspaceId
"#ffffff"
, sKeys :: ChordKeys
sKeys = [EventMask] -> ChordKeys
AnyKeys [EventMask
xK_s, EventMask
xK_d, EventMask
xK_f, EventMask
xK_j, EventMask
xK_k, EventMask
xK_l]
, cancelKey :: EventMask
cancelKey = EventMask
xK_q
, borderPx :: Int
borderPx = Int
1
, maxChordLen :: Int
maxChordLen = Int
0
#ifdef XFT
, emFont :: WorkspaceId
emFont = WorkspaceId
"xft:Sans-100"
#else
, emFont = "-misc-fixed-*-*-*-*-200-*-*-*-*-*-*-*"
#endif
}
fullSize :: Position -> Rectangle -> Rectangle
fullSize :: Position -> Rectangle -> Rectangle
fullSize Position
_ = forall a. a -> a
id
proportional :: RealFrac f => f -> Position -> Rectangle -> Rectangle
proportional :: forall f. RealFrac f => f -> Position -> Rectangle -> Rectangle
proportional f
f Position
th Rectangle
r = Rectangle { rect_width :: EventType
rect_width = EventType
newW
, rect_height :: EventType
rect_height = EventType
newH
, rect_x :: Position
rect_x = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r forall a. Num a => a -> a -> a
- EventType
newW) forall a. Integral a => a -> a -> a
`div` Position
2
, rect_y :: Position
rect_y = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r forall a. Num a => a -> a -> a
- EventType
newH) forall a. Integral a => a -> a -> a
`div` Position
2 }
where
newH :: EventType
newH = forall a. Ord a => a -> a -> a
max (forall a b. (Integral a, Num b) => a -> b
fi Position
th) (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ f
f forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r))
newW :: EventType
newW = EventType
newH
fixedSize :: (Integral a, Integral b) => a -> b -> Position -> Rectangle -> Rectangle
fixedSize :: forall a b.
(Integral a, Integral b) =>
a -> b -> Position -> Rectangle -> Rectangle
fixedSize a
w b
h Position
th Rectangle
r = Rectangle { rect_width :: EventType
rect_width = EventType
rw
, rect_height :: EventType
rect_height = EventType
rh
, rect_x :: Position
rect_x = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r forall a. Num a => a -> a -> a
- EventType
rw) forall a. Integral a => a -> a -> a
`div` Position
2
, rect_y :: Position
rect_y = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r forall a. Num a => a -> a -> a
- EventType
rh) forall a. Integral a => a -> a -> a
`div` Position
2 }
where
rw :: EventType
rw = forall a. Ord a => a -> a -> a
max (forall a b. (Integral a, Num b) => a -> b
fi a
w) (forall a b. (Integral a, Num b) => a -> b
fi Position
th)
rh :: EventType
rh = forall a. Ord a => a -> a -> a
max (forall a b. (Integral a, Num b) => a -> b
fi b
h) (forall a b. (Integral a, Num b) => a -> b
fi Position
th)
textSize :: Position -> Rectangle -> Rectangle
textSize :: Position -> Rectangle -> Rectangle
textSize Position
th Rectangle
r = Rectangle { rect_width :: EventType
rect_width = forall a b. (Integral a, Num b) => a -> b
fi Position
th
, rect_height :: EventType
rect_height = forall a b. (Integral a, Num b) => a -> b
fi Position
th
, rect_x :: Position
rect_x = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
th) forall a. Integral a => a -> a -> a
`div` Position
2
, rect_y :: Position
rect_y = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
th) forall a. Integral a => a -> a -> a
`div` Position
2 }
bar :: RealFrac f => f -> Position -> Rectangle -> Rectangle
bar :: forall f. RealFrac f => f -> Position -> Rectangle -> Rectangle
bar f
f Position
th Rectangle
r = Rectangle { rect_width :: EventType
rect_width = Rectangle -> EventType
rect_width Rectangle
r
, rect_height :: EventType
rect_height = forall a b. (Integral a, Num b) => a -> b
fi Position
th
, rect_x :: Position
rect_x = Rectangle -> Position
rect_x Rectangle
r
, rect_y :: Position
rect_y = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round (f
f' forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
th)) }
where
f' :: f
f' = forall a. Ord a => a -> a -> a
min f
0.0 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max f
f f
1.0
handleSelectWindow :: EasyMotionConfig -> X (Maybe Window)
handleSelectWindow :: EasyMotionConfig -> X (Maybe EventMask)
handleSelectWindow EMConf { sKeys :: EasyMotionConfig -> ChordKeys
sKeys = AnyKeys [] } = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
handleSelectWindow EasyMotionConfig
c = do
XMonadFont
f <- WorkspaceId -> X XMonadFont
initXMF forall a b. (a -> b) -> a -> b
$ EasyMotionConfig -> WorkspaceId
emFont EasyMotionConfig
c
Position
th <- (\(Position
asc, Position
dsc) -> Position
asc forall a. Num a => a -> a -> a
+ Position
dsc forall a. Num a => a -> a -> a
+ Position
2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
XMonadFont -> WorkspaceId -> m (Position, Position)
textExtentsXMF XMonadFont
f (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventMask -> WorkspaceId
keysymToString (ChordKeys -> [EventMask]
allKeys forall b c a. (b -> c) -> (a -> b) -> a -> c
. EasyMotionConfig -> ChordKeys
sKeys forall a b. (a -> b) -> a -> b
$ EasyMotionConfig
c))
XConf { theRoot :: XConf -> EventMask
theRoot = EventMask
rw, display :: XConf -> Display
display = Display
dpy } <- forall r (m :: * -> *). MonadReader r m => m r
ask
XState { mapped :: XState -> Set EventMask
mapped = Set EventMask
mappedWins, windowset :: XState -> WindowSet
windowset = WindowSet
ws } <- forall s (m :: * -> *). MonadState s m => m s
get
[Overlay]
overlays :: [Overlay] <- case EasyMotionConfig -> ChordKeys
sKeys EasyMotionConfig
c of
AnyKeys [EventMask]
ks -> [EventMask] -> [OverlayWindow] -> [Overlay]
buildOverlays [EventMask]
ks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [OverlayWindow]
sortedOverlayWindows
where
visibleWindows :: [Window]
visibleWindows :: [EventMask]
visibleWindows = forall l. IsList l => l -> [Item l]
toList Set EventMask
mappedWins
sortedOverlayWindows :: X [OverlayWindow]
sortedOverlayWindows :: X [OverlayWindow]
sortedOverlayWindows = [OverlayWindow] -> [OverlayWindow]
sortOverlayWindows forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> [EventMask] -> X [OverlayWindow]
buildOverlayWindows Position
th [EventMask]
visibleWindows
PerScreenKeys Map ScreenId [EventMask]
m ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems
forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\ScreenId
sid [EventMask]
ks -> [EventMask] -> [OverlayWindow] -> [Overlay]
buildOverlays [EventMask]
ks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScreenId -> X [OverlayWindow]
sortedOverlayWindows ScreenId
sid) Map ScreenId [EventMask]
m
where
screenById :: ScreenId -> Maybe WindowScreen
screenById :: ScreenId -> Maybe WindowScreen
screenById ScreenId
sid = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== ScreenId
sid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) (forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens WindowSet
ws)
visibleWindowsOnScreen :: ScreenId -> [Window]
visibleWindowsOnScreen :: ScreenId -> [EventMask]
visibleWindowsOnScreen ScreenId
sid = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall l. IsList l => l -> [Item l]
toList Set EventMask
mappedWins) forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Stack a) -> [a]
W.integrate' forall a b. (a -> b) -> a -> b
$ ScreenId -> Maybe WindowScreen
screenById ScreenId
sid forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace
sortedOverlayWindows :: ScreenId -> X [OverlayWindow]
sortedOverlayWindows :: ScreenId -> X [OverlayWindow]
sortedOverlayWindows ScreenId
sid = [OverlayWindow] -> [OverlayWindow]
sortOverlayWindows forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> [EventMask] -> X [OverlayWindow]
buildOverlayWindows Position
th (ScreenId -> [EventMask]
visibleWindowsOnScreen ScreenId
sid)
CInt
status <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> EventMask -> Bool -> CInt -> CInt -> EventMask -> IO CInt
grabKeyboard Display
dpy EventMask
rw Bool
True CInt
grabModeAsync CInt
grabModeAsync EventMask
currentTime
if CInt
status forall a. Eq a => a -> a -> Bool
== CInt
grabSuccess
then do
HandleResult
resultWin <- Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy (XMonadFont -> Overlay -> X ()
displayOverlay XMonadFont
f) (EasyMotionConfig -> EventMask
cancelKey EasyMotionConfig
c) [Overlay]
overlays []
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> IO ()
ungrabKeyboard Display
dpy EventMask
currentTime
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (EventMask -> X ()
deleteWindow forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> EventMask
overlay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> OverlayWindow
overlayWin) [Overlay]
overlays
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Bool -> IO ()
sync Display
dpy Bool
False
XMonadFont -> X ()
releaseXMF XMonadFont
f
case HandleResult
resultWin of
Selected Overlay
o -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> EventMask
win forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> OverlayWindow
overlayWin forall a b. (a -> b) -> a -> b
$ Overlay
o
HandleResult
_ -> forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws) ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Maybe a
Nothing
else XMonadFont -> X ()
releaseXMF XMonadFont
f forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Maybe a
Nothing
where
allKeys :: ChordKeys -> [KeySym]
allKeys :: ChordKeys -> [EventMask]
allKeys (AnyKeys [EventMask]
ks) = [EventMask]
ks
allKeys (PerScreenKeys Map ScreenId [EventMask]
m) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map ScreenId [EventMask]
m
buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay]
buildOverlays :: [EventMask] -> [OverlayWindow] -> [Overlay]
buildOverlays = Int -> [EventMask] -> [OverlayWindow] -> [Overlay]
appendChords (EasyMotionConfig -> Int
maxChordLen EasyMotionConfig
c)
buildOverlayWindows :: Position -> [Window] -> X [OverlayWindow]
buildOverlayWindows :: Position -> [EventMask] -> X [OverlayWindow]
buildOverlayWindows Position
th = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Position -> EventMask -> X (Maybe OverlayWindow)
buildOverlayWin Position
th)
sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]
sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]
sortOverlayWindows = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((WindowAttributes -> CInt
wa_x forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& WindowAttributes -> CInt
wa_y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayWindow -> WindowAttributes
attrs)
makeRect :: WindowAttributes -> Rectangle
makeRect :: WindowAttributes -> Rectangle
makeRect WindowAttributes
wa = Position -> Position -> EventType -> EventType -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_x WindowAttributes
wa)) (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_y WindowAttributes
wa)) (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_width WindowAttributes
wa)) (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_height WindowAttributes
wa))
buildOverlayWin :: Position -> Window -> X (Maybe OverlayWindow)
buildOverlayWin :: Position -> EventMask -> X (Maybe OverlayWindow)
buildOverlayWin Position
th EventMask
w = EventMask -> X (Maybe WindowAttributes)
safeGetWindowAttributes EventMask
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe WindowAttributes
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just WindowAttributes
wAttrs -> do
let r :: Rectangle
r = EasyMotionConfig -> Position -> Rectangle -> Rectangle
overlayF EasyMotionConfig
c Position
th forall a b. (a -> b) -> a -> b
$ WindowAttributes -> Rectangle
makeRect WindowAttributes
wAttrs
EventMask
o <- Rectangle -> Maybe EventMask -> WorkspaceId -> Bool -> X EventMask
createNewWindow Rectangle
r forall a. Maybe a
Nothing WorkspaceId
"" Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OverlayWindow { rect :: Rectangle
rect=Rectangle
r, overlay :: EventMask
overlay=EventMask
o, win :: EventMask
win=EventMask
w, attrs :: WindowAttributes
attrs=WindowAttributes
wAttrs }
displayOverlay :: XMonadFont -> Overlay -> X ()
displayOverlay :: XMonadFont -> Overlay -> X ()
displayOverlay XMonadFont
f Overlay { overlayWin :: Overlay -> OverlayWindow
overlayWin = OverlayWindow { rect :: OverlayWindow -> Rectangle
rect = Rectangle
r, overlay :: OverlayWindow -> EventMask
overlay = EventMask
o }, chord :: Overlay -> [EventMask]
chord = [EventMask]
ch } = do
EventMask -> X ()
showWindow EventMask
o
EventMask
-> XMonadFont
-> EventType
-> EventType
-> EventType
-> WorkspaceId
-> WorkspaceId
-> WorkspaceId
-> WorkspaceId
-> [Align]
-> [WorkspaceId]
-> X ()
paintAndWrite EventMask
o XMonadFont
f (forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_width Rectangle
r)) (forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> EventType
rect_height Rectangle
r)) (forall a b. (Integral a, Num b) => a -> b
fi (EasyMotionConfig -> Int
borderPx EasyMotionConfig
c)) (EasyMotionConfig -> WorkspaceId
bgCol EasyMotionConfig
c) (EasyMotionConfig -> WorkspaceId
borderCol EasyMotionConfig
c) (EasyMotionConfig -> WorkspaceId
txtCol EasyMotionConfig
c) (EasyMotionConfig -> WorkspaceId
bgCol EasyMotionConfig
c) [Align
AlignCenter] [forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventMask -> WorkspaceId
keysymToString [EventMask]
ch]
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
sanitise :: [KeySym] -> [KeySym]
sanitise :: [EventMask] -> [EventMask]
sanitise = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [EventMask
xK_BackSpace, EasyMotionConfig -> EventMask
cancelKey EasyMotionConfig
conf])
sanitiseKeys :: ChordKeys -> ChordKeys
sanitiseKeys :: ChordKeys -> ChordKeys
sanitiseKeys ChordKeys
cKeys =
case ChordKeys
cKeys of
AnyKeys [EventMask]
ks -> [EventMask] -> ChordKeys
AnyKeys forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EventMask] -> [EventMask]
sanitise forall a b. (a -> b) -> a -> b
$ [EventMask]
ks
PerScreenKeys Map ScreenId [EventMask]
m -> Map ScreenId [EventMask] -> ChordKeys
PerScreenKeys forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map [EventMask] -> [EventMask]
sanitise Map ScreenId [EventMask]
m
appendChords :: Int -> [KeySym] -> [OverlayWindow] -> [Overlay]
appendChords :: Int -> [EventMask] -> [OverlayWindow] -> [Overlay]
appendChords Int
_ [] [OverlayWindow]
_ = []
appendChords Int
maxUserSelectedLen [EventMask]
ks [OverlayWindow]
overlayWins =
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith OverlayWindow -> [EventMask] -> Overlay
Overlay [OverlayWindow]
overlayWins [[EventMask]]
chords
where
chords :: [[EventMask]]
chords = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
chordLen [EventMask]
ks
minCoverLen :: Int
minCoverLen = -((-(forall (t :: * -> *) a. Foldable t => t a -> Int
length [OverlayWindow]
overlayWins)) forall a. Integral a => a -> a -> a
`div` forall (t :: * -> *) a. Foldable t => t a -> Int
length [EventMask]
ks)
chordLen :: Int
chordLen = if Int
maxUserSelectedLen forall a. Ord a => a -> a -> Bool
<= Int
0 then Int
minCoverLen else forall a. Ord a => a -> a -> a
min Int
minCoverLen Int
maxUserSelectedLen
data HandleResult = Exit | Selected Overlay | Backspace
handleKeyboard :: Display -> (Overlay -> X()) -> KeySym -> [Overlay] -> [Overlay] -> X HandleResult
handleKeyboard :: Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
_ Overlay -> X ()
_ EventMask
_ [] [Overlay]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
Exit
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected = do
X [()]
redraw
Event
ev <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
Display -> EventMask -> XEventPtr -> IO ()
maskEvent Display
dpy (EventMask
keyPressMask forall a. Bits a => a -> a -> a
.|. EventMask
keyReleaseMask forall a. Bits a => a -> a -> a
.|. EventMask
buttonPressMask) XEventPtr
e
XEventPtr -> IO Event
getEvent XEventPtr
e
if | Event -> EventType
ev_event_type Event
ev forall a. Eq a => a -> a -> Bool
== EventType
keyPress -> do
EventMask
s <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> KeyCode -> CInt -> IO EventMask
keycodeToKeysym Display
dpy (Event -> KeyCode
ev_keycode Event
ev) CInt
0
if | EventMask
s forall a. Eq a => a -> a -> Bool
== EventMask
cancel -> forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
Exit
| EventMask
s forall a. Eq a => a -> a -> Bool
== EventMask
xK_BackSpace -> forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
Backspace
| EventMask -> Bool
isNextOverlayKey EventMask
s -> EventMask -> X HandleResult
handleNextOverlayKey EventMask
s
| Bool
otherwise -> Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected
| Event -> EventType
ev_event_type Event
ev forall a. Eq a => a -> a -> Bool
== EventType
buttonPress -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> CInt -> EventMask -> IO ()
allowEvents Display
dpy CInt
replayPointer EventMask
currentTime
Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected
| Bool
otherwise -> Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected
where
redraw :: X [()]
redraw = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Overlay -> X ()
drawFn) [[Overlay]
selected, [Overlay]
deselected]
retryBackspace :: HandleResult -> X HandleResult
retryBackspace HandleResult
x =
case HandleResult
x of
HandleResult
Backspace -> X [()]
redraw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel [Overlay]
selected [Overlay]
deselected
HandleResult
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return HandleResult
x
isNextOverlayKey :: EventMask -> Bool
isNextOverlayKey EventMask
keySym = forall a. Maybe a -> Bool
isJust (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just EventMask
keySym) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
.Overlay -> [EventMask]
chord) [Overlay]
selected)
handleNextOverlayKey :: EventMask -> X HandleResult
handleNextOverlayKey EventMask
keySym =
case [Overlay]
fg of
[Overlay
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Overlay -> HandleResult
Selected Overlay
x
[Overlay]
_ -> Display
-> (Overlay -> X ())
-> EventMask
-> [Overlay]
-> [Overlay]
-> X HandleResult
handleKeyboard Display
dpy Overlay -> X ()
drawFn EventMask
cancel ([Overlay] -> [Overlay]
trim [Overlay]
fg) ([Overlay] -> [Overlay]
clear [Overlay]
bg) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HandleResult -> X HandleResult
retryBackspace
where
([Overlay]
fg, [Overlay]
bg) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just EventMask
keySym) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> [EventMask]
chord) [Overlay]
selected
trim :: [Overlay] -> [Overlay]
trim = forall a b. (a -> b) -> [a] -> [b]
map (\Overlay
o -> Overlay
o { chord :: [EventMask]
chord = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ Overlay -> [EventMask]
chord Overlay
o })
clear :: [Overlay] -> [Overlay]
clear = forall a b. (a -> b) -> [a] -> [b]
map (\Overlay
o -> Overlay
o { chord :: [EventMask]
chord = [] })