module Hbro.Keys where
import Hbro.Types
import Hbro.Util
import Control.Monad hiding(forM_)
import Control.Monad.Error hiding(forM_)
import Control.Monad.Reader hiding(forM_)
import Control.Monad.Trans.Control
import Data.Functor
import Data.IORef
import qualified Data.Map as M
import Graphics.UI.Gtk.Abstract.Widget
import Graphics.UI.Gtk.Gdk.Keys
import Prelude hiding(mapM_)
keyToString :: KeyVal -> Maybe String
keyToString keyVal = case keyToChar keyVal of
Just ' ' -> Just "<Space>"
Just char -> Just [char]
_ -> case keyName keyVal of
"Caps_Lock" -> Nothing
"Shift_L" -> Nothing
"Shift_R" -> Nothing
"Control_L" -> Nothing
"Control_R" -> Nothing
"Alt_L" -> Nothing
"Alt_R" -> Nothing
"Super_L" -> Nothing
"Super_R" -> Nothing
"Menu" -> Nothing
"ISO_Level3_Shift" -> Nothing
"dead_circumflex" -> Just "^"
"dead_diaeresis" -> Just "ยจ"
x -> Just ('<':x ++ ">")
defaultKeyHandler :: KeysList -> KeyHook
defaultKeyHandler (KeysList keysList) keystrokes = case M.lookup keystrokes (M.fromList keysList) of
Just callback -> callback
_ -> return ()
emacsKeyHandler :: (MonadIO m, MonadReader r m, HasConfig r, HasOptions r, HasGUI r, HasPromptBar r, HasZMQContext r, HasHooks r, HasKeys r, MonadError HError m, MonadBaseControl IO m)
=> KeysList
-> [String]
-> String
-> m ()
emacsKeyHandler keysList prefixes keystrokes = do
keys <- asks _keys
chainedKeys <- (++ keystrokes) <$> io (readIORef keys)
case elem chainedKeys prefixes of
True -> do
io $ writeIORef keys $ chainedKeys ++ " "
_ -> do
io $ writeIORef keys ""
defaultKeyHandler keysList chainedKeys