mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-08-16 19:30:21 +03:00
Keybindings: normalize parsed and constructed key bindings with modifiers to lowercase
This change fixes a bug where it was possible to parse and construct key bindings for capitalized characters with modifiers, thus leading to unusable bindings in terminal applications. This is because a binding like Ctrl-X can never be generated by a terminal because it always arrives as Ctrl-x Prior to this patch, if a user wrote "Ctrl-X" in a keybinding configuration file or used the library API to construct such a binding, it would be accepted but would lead to a binding that was never usable at runtime for the reason explained above. This patch updates the library API to always normalize constructed and parsed key bindings to lowercase when modifiers are present.
This commit is contained in:
parent
79c9317b43
commit
6929129e9c
@ -77,6 +77,7 @@ library
|
|||||||
Brick.Keybindings.KeyConfig
|
Brick.Keybindings.KeyConfig
|
||||||
Brick.Keybindings.KeyEvents
|
Brick.Keybindings.KeyEvents
|
||||||
Brick.Keybindings.KeyDispatcher
|
Brick.Keybindings.KeyDispatcher
|
||||||
|
Brick.Keybindings.Normalize
|
||||||
Brick.Keybindings.Parse
|
Brick.Keybindings.Parse
|
||||||
Brick.Keybindings.Pretty
|
Brick.Keybindings.Pretty
|
||||||
Brick.Focus
|
Brick.Focus
|
||||||
|
@ -47,6 +47,7 @@ import Data.Maybe (fromMaybe, listToMaybe, catMaybes)
|
|||||||
import qualified Graphics.Vty as Vty
|
import qualified Graphics.Vty as Vty
|
||||||
|
|
||||||
import Brick.Keybindings.KeyEvents
|
import Brick.Keybindings.KeyEvents
|
||||||
|
import Brick.Keybindings.Normalize
|
||||||
|
|
||||||
-- | A key binding.
|
-- | A key binding.
|
||||||
--
|
--
|
||||||
@ -67,10 +68,12 @@ data Binding =
|
|||||||
-- ^ The set of modifiers.
|
-- ^ The set of modifiers.
|
||||||
} deriving (Eq, Show, Ord)
|
} deriving (Eq, Show, Ord)
|
||||||
|
|
||||||
-- | Construct a 'Binding'. Modifier order is ignored.
|
-- | Construct a 'Binding'. Modifier order is ignored. If modifiers
|
||||||
|
-- are given and the binding is for a character key, it is forced to
|
||||||
|
-- lowercase.
|
||||||
binding :: Vty.Key -> [Vty.Modifier] -> Binding
|
binding :: Vty.Key -> [Vty.Modifier] -> Binding
|
||||||
binding k mods =
|
binding k mods =
|
||||||
Binding { kbKey = k
|
Binding { kbKey = normalizeKey mods k
|
||||||
, kbMods = S.fromList mods
|
, kbMods = S.fromList mods
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -230,17 +233,23 @@ instance ToBinding Binding where
|
|||||||
addModifier :: (ToBinding a) => Vty.Modifier -> a -> Binding
|
addModifier :: (ToBinding a) => Vty.Modifier -> a -> Binding
|
||||||
addModifier m val =
|
addModifier m val =
|
||||||
let b = bind val
|
let b = bind val
|
||||||
in b { kbMods = S.insert m (kbMods b) }
|
newMods = S.insert m $ kbMods b
|
||||||
|
in b { kbMods = newMods
|
||||||
|
, kbKey = normalizeKey (S.toList newMods) $ kbKey b
|
||||||
|
}
|
||||||
|
|
||||||
-- | Add Meta to a binding.
|
-- | Add Meta to a binding. If the binding is for a character key, force
|
||||||
|
-- it to lowercase.
|
||||||
meta :: (ToBinding a) => a -> Binding
|
meta :: (ToBinding a) => a -> Binding
|
||||||
meta = addModifier Vty.MMeta
|
meta = addModifier Vty.MMeta
|
||||||
|
|
||||||
-- | Add Ctrl to a binding.
|
-- | Add Ctrl to a binding. If the binding is for a character key, force
|
||||||
|
-- it to lowercase.
|
||||||
ctrl :: (ToBinding a) => a -> Binding
|
ctrl :: (ToBinding a) => a -> Binding
|
||||||
ctrl = addModifier Vty.MCtrl
|
ctrl = addModifier Vty.MCtrl
|
||||||
|
|
||||||
-- | Add Shift to a binding.
|
-- | Add Shift to a binding. If the binding is for a character key, force
|
||||||
|
-- it to lowercase.
|
||||||
shift :: (ToBinding a) => a -> Binding
|
shift :: (ToBinding a) => a -> Binding
|
||||||
shift = addModifier Vty.MShift
|
shift = addModifier Vty.MShift
|
||||||
|
|
||||||
|
14
src/Brick/Keybindings/Normalize.hs
Normal file
14
src/Brick/Keybindings/Normalize.hs
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
module Brick.Keybindings.Normalize
|
||||||
|
( normalizeKey
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Char (toLower)
|
||||||
|
import qualified Graphics.Vty as Vty
|
||||||
|
|
||||||
|
-- | A keybinding involving modifiers should have its key character
|
||||||
|
-- normalized to lowercase since it's impossible to get uppercase keys
|
||||||
|
-- from the terminal when modifiers are present.
|
||||||
|
normalizeKey :: [Vty.Modifier] -> Vty.Key -> Vty.Key
|
||||||
|
normalizeKey (_:_) (Vty.KChar c) = Vty.KChar $ toLower c
|
||||||
|
normalizeKey _ k = k
|
@ -5,6 +5,7 @@
|
|||||||
module Brick.Keybindings.Parse
|
module Brick.Keybindings.Parse
|
||||||
( parseBinding
|
( parseBinding
|
||||||
, parseBindingList
|
, parseBindingList
|
||||||
|
, normalizeKey
|
||||||
|
|
||||||
, keybindingsFromIni
|
, keybindingsFromIni
|
||||||
, keybindingsFromFile
|
, keybindingsFromFile
|
||||||
@ -14,7 +15,6 @@ where
|
|||||||
|
|
||||||
import Control.Monad (forM)
|
import Control.Monad (forM)
|
||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (catMaybes)
|
||||||
import qualified Data.Set as S
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Graphics.Vty as Vty
|
import qualified Graphics.Vty as Vty
|
||||||
@ -23,6 +23,7 @@ import qualified Data.Ini.Config as Ini
|
|||||||
|
|
||||||
import Brick.Keybindings.KeyEvents
|
import Brick.Keybindings.KeyEvents
|
||||||
import Brick.Keybindings.KeyConfig
|
import Brick.Keybindings.KeyConfig
|
||||||
|
import Brick.Keybindings.Normalize
|
||||||
|
|
||||||
-- | Parse a key binding list into a 'BindingState'.
|
-- | Parse a key binding list into a 'BindingState'.
|
||||||
--
|
--
|
||||||
@ -83,7 +84,7 @@ parseBinding :: T.Text -> Either String Binding
|
|||||||
parseBinding s = go (T.splitOn "-" $ T.toLower s) []
|
parseBinding s = go (T.splitOn "-" $ T.toLower s) []
|
||||||
where go [k] mods = do
|
where go [k] mods = do
|
||||||
k' <- pKey k
|
k' <- pKey k
|
||||||
return Binding { kbMods = S.fromList mods, kbKey = k' }
|
return $ binding k' mods
|
||||||
go (k:ks) mods = do
|
go (k:ks) mods = do
|
||||||
m <- case k of
|
m <- case k of
|
||||||
"s" -> return Vty.MShift
|
"s" -> return Vty.MShift
|
||||||
|
Loading…
Reference in New Issue
Block a user