module Hbro.Keys (
defaultKeyHandler,
emacsKeyHandler,
stringify,
keyToString,
) where
import Hbro.Core
import Hbro.Types
import Hbro.Util
import Control.Monad hiding(forM_)
import Data.IORef
import qualified Data.Map as M
import Graphics.UI.Gtk.Abstract.Widget
import Graphics.UI.Gtk.Gdk.EventM
import Graphics.UI.Gtk.Gdk.Keys
import Prelude hiding(mapM_)
defaultKeyHandler :: KeysList -> String -> K (String, Bool)
defaultKeyHandler keysList keystrokes = case M.lookup keystrokes (M.fromList keysList) of
Just callback -> callback >> return (keystrokes, True)
_ -> return (keystrokes, False)
emacsKeyHandler :: KeysList
-> [String]
-> String
-> K (String, Bool)
emacsKeyHandler keysList prefixes keystrokes = do
keysRef <- getState "Hbro.Keys.manageSequentialKeys" ""
io $ modifyIORef keysRef (++ keystrokes)
chainedKeys <- io $ readIORef keysRef
case elem chainedKeys prefixes of
True -> do
io $ modifyIORef keysRef (++ " ")
return (chainedKeys ++ " ", False)
_ -> do
io $ writeIORef keysRef []
defaultKeyHandler keysList chainedKeys
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 ++ ">")
stringify :: Modifier -> String
stringify Control = "C-"
stringify Alt = "M-"
stringify _ = []