diff --git a/src/Termonad/Keys.hs b/src/Termonad/Keys.hs index 54a28e3..2073e72 100644 --- a/src/Termonad/Keys.hs +++ b/src/Termonad/Keys.hs @@ -3,23 +3,11 @@ module Termonad.Keys where import Termonad.Prelude -import Control.Lens (imap) -import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Set (Set) import qualified Data.Set as Set import GI.Gdk ( EventKey - , pattern KEY_0 - , pattern KEY_1 - , pattern KEY_2 - , pattern KEY_3 - , pattern KEY_4 - , pattern KEY_5 - , pattern KEY_6 - , pattern KEY_7 - , pattern KEY_8 - , pattern KEY_9 , ModifierType(..) , getEventKeyHardwareKeycode , getEventKeyIsModifier @@ -30,9 +18,14 @@ import GI.Gdk , getEventKeyType ) -import Termonad.Term (altNumSwitchTerm) -import Termonad.Types (TMState, TMWindowId) - +import Termonad.Types + ( Key(..) + , TMState + , TMState'(tmStateConfig) + , TMWindowId + , TMConfig(keys) + , toKey + ) showKeys :: EventKey -> IO Bool showKeys eventKey = do @@ -56,42 +49,6 @@ showKeys eventKey = do pure True -data Key = Key - { keyVal :: !Word32 - , keyMods :: !(Set ModifierType) - } deriving (Eq, Ord, Show) - -toKey :: Word32 -> Set ModifierType -> Key -toKey = Key - -keyMap :: Map Key (TMState -> TMWindowId -> IO Bool) -keyMap = - let numKeys :: [Word32] - numKeys = - [ KEY_1 - , KEY_2 - , KEY_3 - , KEY_4 - , KEY_5 - , KEY_6 - , KEY_7 - , KEY_8 - , KEY_9 - , KEY_0 - ] - altNumKeys :: [(Key, TMState -> TMWindowId -> IO Bool)] - altNumKeys = - imap - (\i k -> - (toKey k [ModifierTypeMod1Mask], stopProp (altNumSwitchTerm i)) - ) - numKeys - in - Map.fromList altNumKeys - -stopProp :: (TMState -> TMWindowId -> IO a) -> TMState -> TMWindowId -> IO Bool -stopProp callback terState tmWinId = callback terState tmWinId $> True - removeStrangeModifiers :: Key -> Key removeStrangeModifiers Key{keyVal, keyMods} = let reservedModifiers :: Set ModifierType @@ -121,7 +78,7 @@ handleKeyPress terState tmWindowId eventKey = do modifiers <- getEventKeyState eventKey let oldKey = toKey keyval (Set.fromList modifiers) newKey = removeStrangeModifiers oldKey - maybeAction = Map.lookup newKey keyMap + maybeAction <- Map.lookup newKey . keys . tmStateConfig <$> readMVar terState case maybeAction of Just action -> action terState tmWindowId Nothing -> pure False diff --git a/src/Termonad/Preferences/File.hs b/src/Termonad/Preferences/File.hs index 0724787..4c3ff24 100644 --- a/src/Termonad/Preferences/File.hs +++ b/src/Termonad/Preferences/File.hs @@ -36,9 +36,10 @@ import System.Directory import System.FilePath (()) import Termonad.Types ( ConfigOptions - , TMConfig(TMConfig, hooks, options) + , TMConfig(TMConfig, hooks, options, keys) , defaultConfigHooks , defaultConfigOptions + , defaultConfigKeys ) -- $setup @@ -74,7 +75,10 @@ tmConfigFromPreferencesFile = do hPutStrLn stderr $ "Error parsing file " <> pack confFile <> ": " <> err pure defaultConfigOptions Right options -> pure options - pure TMConfig { options = options, hooks = defaultConfigHooks } + pure TMConfig { options = options + , hooks = defaultConfigHooks + , keys = defaultConfigKeys + } -- | Read the 'ConfigOptions' out of a configuration file. -- diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs index e062922..26f6dfb 100644 --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -159,14 +159,6 @@ import Termonad.Types , tmWindowNotebook ) -focusTerm :: Int -> TMState -> TMWindowId -> IO () -focusTerm i mvarTMState tmWinId = do - note <- getNotebookFromTMState mvarTMState tmWinId - notebookSetCurrentPage note (fromIntegral i) - -altNumSwitchTerm :: Int -> TMState -> TMWindowId -> IO () -altNumSwitchTerm = focusTerm - -- | Change focus to the next tab. termNextPage :: TMState -> TMWindowId -> IO () termNextPage mvarTMState tmWinId = do diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index 155e9a0..cedca77 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -4,9 +4,12 @@ module Termonad.Types where import Termonad.Prelude -import Control.Lens (ifoldMap) +import Control.Lens (ifoldMap, imap) import Data.FocusList (FocusList, emptyFL, getFocusItemFL, lengthFL) import Data.Foldable (toList) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Set (Set) import Data.Unique (Unique, hashUnique, newUnique) import Data.Yaml ( FromJSON(parseJSON) @@ -14,6 +17,19 @@ import Data.Yaml , Value(String) , withText ) +import GI.Gdk + ( pattern KEY_0 + , pattern KEY_1 + , pattern KEY_2 + , pattern KEY_3 + , pattern KEY_4 + , pattern KEY_5 + , pattern KEY_6 + , pattern KEY_7 + , pattern KEY_8 + , pattern KEY_9 + , ModifierType(..) + ) import GI.Gtk ( Application , ApplicationWindow @@ -25,6 +41,7 @@ import GI.Gtk , notebookGetCurrentPage , notebookGetNthPage , notebookGetNPages + , notebookSetCurrentPage ) import GI.Pango (FontDescription, fontDescriptionGetSize, fontDescriptionGetSizeIsAbsolute, pattern SCALE, fontDescriptionGetFamily, fontDescriptionNew, fontDescriptionSetFamily, fontDescriptionSetSize, fontDescriptionSetAbsoluteSize) import GI.Vte (Terminal, CursorBlinkMode(..)) @@ -595,7 +612,11 @@ defaultConfigOptions = data TMConfig = TMConfig { options :: !ConfigOptions , hooks :: !ConfigHooks - } deriving Show + , keys :: !(Map Key (TMState -> TMWindowId -> IO Bool)) + } + +instance Show TMConfig where + show cfg = (show . options) cfg <> (show . hooks) cfg -- | The default 'TMConfig'. -- @@ -605,8 +626,53 @@ defaultTMConfig = TMConfig { options = defaultConfigOptions , hooks = defaultConfigHooks + , keys = defaultConfigKeys } +data Key = Key + { keyVal :: !Word32 + , keyMods :: !(Set ModifierType) + } deriving (Eq, Ord, Show) + +toKey :: Word32 -> Set ModifierType -> Key +toKey = Key + +defaultConfigKeys :: Map Key (TMState -> TMWindowId -> IO Bool) +defaultConfigKeys = + let numKeys :: [Word32] + numKeys = + [ KEY_1 + , KEY_2 + , KEY_3 + , KEY_4 + , KEY_5 + , KEY_6 + , KEY_7 + , KEY_8 + , KEY_9 + , KEY_0 + ] + altNumKeys :: [(Key, TMState -> TMWindowId -> IO Bool)] + altNumKeys = + imap + (\i k -> + (toKey k [ModifierTypeMod1Mask], stopProp (altNumSwitchTerm i)) + ) + numKeys + in + Map.fromList altNumKeys + +stopProp :: (TMState -> TMWindowId -> IO a) -> TMState -> TMWindowId -> IO Bool +stopProp callback terState tmWinId = callback terState tmWinId $> True + +focusTerm :: Int -> TMState -> TMWindowId -> IO () +focusTerm i mvarTMState tmWinId = do + note <- getNotebookFromTMState mvarTMState tmWinId + notebookSetCurrentPage note (fromIntegral i) + +altNumSwitchTerm :: Int -> TMState -> TMWindowId -> IO () +altNumSwitchTerm = focusTerm + --------------------- -- ConfigHooks -- ---------------------