diff --git a/src/IDE/Command.hs b/src/IDE/Command.hs index aaa2c4bb..604c3899 100644 --- a/src/IDE/Command.hs +++ b/src/IDE/Command.hs @@ -34,7 +34,8 @@ module IDE.Command ( ) where import Graphics.UI.Gtk - (containerAdd, windowAddAccelGroup, onKeyPress, boxPackEnd, + (keyToChar, eventKeyVal, eventModifier, eventKeyName, EKey, + containerAdd, windowAddAccelGroup, onKeyPress, boxPackEnd, boxPackStart, widgetSetName, vBoxNew, windowSetIconFromFile, Widget, Window, actionGroupGetAction, uiManagerGetActionGroups, Action, actionSetSensitive, iconFactoryAdd, iconSetNewFromPixbuf, @@ -42,18 +43,18 @@ import Graphics.UI.Gtk dialogRun, aboutDialogSetAuthors, aboutDialogSetWebsite, aboutDialogSetLicense, aboutDialogSetComments, aboutDialogSetCopyright, aboutDialogSetVersion, aboutDialogSetName, - aboutDialogNew, mainQuit, widgetHide, widgetShow, - castToWidget, separatorMenuItemNew, - containerGetChildren, Menu, widgetSetSizeRequest, toolbarSetStyle, - toolbarSetIconSize, castToToolbar, castToMenuBar, - uiManagerGetWidget, uiManagerGetAccelGroup, onActionActivate, - actionNew, actionGroupAddActionWithAccel, actionToggled, - toggleActionNew, uiManagerAddUiFromString, - uiManagerInsertActionGroup, actionGroupNew, UIManager, - widgetShowAll, menuItemSetSubmenu, widgetDestroy, widgetHide, - menuItemGetSubmenu, menuShellAppend, menuItemActivate, - menuItemNewWithLabel, menuNew, Packing(..), ToolbarStyle(..), - PositionType(..), on, IconSize(..)) + aboutDialogNew, mainQuit, widgetHide, widgetShow, castToWidget, + separatorMenuItemNew, containerGetChildren, Menu, + widgetSetSizeRequest, toolbarSetStyle, toolbarSetIconSize, + castToToolbar, castToMenuBar, uiManagerGetWidget, + uiManagerGetAccelGroup, onActionActivate, actionNew, + actionGroupAddActionWithAccel, actionToggled, toggleActionNew, + uiManagerAddUiFromString, uiManagerInsertActionGroup, + actionGroupNew, UIManager, widgetShowAll, menuItemSetSubmenu, + widgetDestroy, menuItemGetSubmenu, menuShellAppend, + menuItemActivate, menuItemNewWithLabel, menuNew, Packing(..), + ToolbarStyle(..), PositionType(..), on, IconSize(..), + keyPressEvent, Modifier(..)) import System.FilePath import Data.Version import Prelude hiding (catch) @@ -86,10 +87,7 @@ import IDE.ImportTool (resolveErrors) import IDE.LogRef import IDE.Debug import System.Directory (doesFileExist) -import qualified Graphics.UI.Gtk.Gdk.Events as GdkEvents -import Graphics.UI.Gtk.Gdk.Events - (Modifier(..), - Event(..)) +import Graphics.UI.Gtk.Gdk.EventM (EventM) import qualified Data.Map as Map (lookup) import Data.List (sort) import Control.Event (registerEvent) @@ -720,7 +718,7 @@ instrumentWindow win prefs topWidget = do boxPackStart vb findbar PackNatural 0 statusBar <- buildStatusbar boxPackEnd vb statusBar PackNatural 0 - win `onKeyPress` (\ e -> reflectIDE (handleSpecialKeystrokes e) ideR) + win `on` keyPressEvent $ handleSpecialKeystrokes ideR windowAddAccelGroup win acc containerAdd win vb reflectIDE (do @@ -742,15 +740,19 @@ instrumentSecWindow win = do (acc,_,_) <- getMenuAndToolbars uiManager' windowAddAccelGroup win acc - win `onKeyPress` (\ e -> reflectIDE (handleSpecialKeystrokes e) ideR) + win `on` keyPressEvent $ handleSpecialKeystrokes ideR return () -- -- | Callback function for onKeyPress of the main window, so 'preprocess' any key -- -handleSpecialKeystrokes :: GdkEvents.Event -> IDEM Bool -handleSpecialKeystrokes (Key { eventKeyName = name, eventModifier = mods, - eventKeyVal = keyVal, eventKeyChar = mbChar}) = do +handleSpecialKeystrokes :: IDERef -> EventM EKey Bool +handleSpecialKeystrokes ideR = do + name <- eventKeyName + mods <- eventModifier + keyVal <- eventKeyVal + let mbChar = keyToChar keyVal + liftIO $ (`reflectIDE` ideR) $ do prefs' <- readIDE prefs case (name, mods) of (tab, [Control]) | (tab == "Tab" || tab == "ISO_Left_Tab") @@ -793,7 +795,6 @@ handleSpecialKeystrokes (Key { eventKeyName = name, eventModifier = mods, printMods :: [Modifier] -> String printMods [] = "" printMods (m:r) = show m ++ printMods r -handleSpecialKeystrokes _ = return True setSymbol :: String -> Bool -> IDEAction setSymbol symbol openSource = do diff --git a/src/IDE/Pane/WebKit/Documentation.hs b/src/IDE/Pane/WebKit/Documentation.hs index 44303014..25e43072 100644 --- a/src/IDE/Pane/WebKit/Documentation.hs +++ b/src/IDE/Pane/WebKit/Documentation.hs @@ -119,7 +119,6 @@ instance RecoverablePane IDEDocumentation DocumentationState IDEM where cid2 <- webView `on` keyPressEvent $ do key <- eventKeyName mod <- eventModifier - liftIO $ print (key, mod) liftIO $ case (key, mod) of ("plus", [Shift,Control]) -> webViewZoomIn webView >> return True ("minus",[Control]) -> webViewZoomOut webView >> return True