Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Add extensible key map to configuration #248

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Add extensible key map to configuration #248

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
9f91e87
Add extensible key map to configuration
dopamane Oct 13, 2024
aacf633
Fixup
dopamane Oct 13, 2024
f462250
Fixup naming
dopamane Oct 13, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
61 changes: 9 additions & 52 deletions src/Termonad/Keys.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
8 changes: 6 additions & 2 deletions src/Termonad/Preferences/File.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
--
Expand Down
8 changes: 0 additions & 8 deletions src/Termonad/Term.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
70 changes: 68 additions & 2 deletions src/Termonad/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,16 +4,32 @@ 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)
, ToJSON(toJSON)
, 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
Expand All @@ -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(..))
Expand Down Expand Up @@ -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
Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@cdepillabout Not sure about this. Let me know what you think. Is show used?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's used in the Show instance of TMState'.


-- | The default 'TMConfig'.
--
Expand All @@ -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 --
---------------------
Expand Down