Native keystrokes #47

Dhek/GUI.hs

@@ -80,6 +80,7 @@ data GUI =
     , guiContextId :: Gtk.ContextId
     , guiDrawPopup :: Gtk.Window
     , guiBlankDocumentWidget :: Widget BlankDocumentEvent
+    , guiDrawingAreaViewport :: Gtk.Viewport
     }
 
 --------------------------------------------------------------------------------
@@ -453,6 +454,7 @@ makeGUI = do
                 , guiStatusBar = sbar
                 , guiDrawPopup = drawpop
                 , guiBlankDocumentWidget = bdw
+                , guiDrawingAreaViewport = viewport
                 }
 
 --------------------------------------------------------------------------------

Dhek/Mode/DuplicateKey.hs

@@ -39,7 +39,9 @@ instance ModeMonad DuplicateKeyMode where
         = DuplicateKeyMode $
               do mMove opts
                  gui <- ask
-                 liftIO $ updatePopupPos gui
+                 liftIO $
+                     do Gtk.widgetShowAll $ guiDrawPopup gui
+                        updatePopupPos gui
 
     mPress opts
         = DuplicateKeyMode $ dupStart opts

Dhek/Mode/Normal.hs

@@ -79,11 +79,14 @@ instance ModeMonad NormalMode where
                  _ -> when (statusNamePressed $ kbKeyName kb) $ liftIO $
                           do mgr <- duplicateKeyModeManager g
                              writeIORef ref $ Just mgr
-                             Gtk.statusbarPush (guiStatusBar g) (guiContextId g)
-                                 (guiTranslate g MsgDupHelp)
-                             Gtk.widgetShowAll $ guiDrawPopup g
-                             updatePopupPos g
-                             gtkSetDhekCursor g (Just $ DhekCursor CursorDup)
+                             overDrawingArea <- overDrawingArea g
+                             when overDrawingArea $
+                                 do Gtk.statusbarPush (guiStatusBar g)
+                                        (guiContextId g)
+                                        (guiTranslate g MsgDupHelp)
+                                    Gtk.widgetShowAll $ guiDrawPopup g
+                                    updatePopupPos g
+                                    gtkSetDhekCursor g (Just $ DhekCursor CursorDup)
 
     mKeyRelease kb
         = do input <- ask
@@ -453,3 +456,22 @@ statusNamePressed n
     | "Alt_L" <- n = True
     | "Alt_R" <- n = True
     | otherwise    = False
+
+--------------------------------------------------------------------------------
+isOverGtkRect :: (Int, Int) -> Gtk.Rectangle -> Bool
+isOverGtkRect (x,y) (Gtk.Rectangle rx ry rw rh)
+    = rx <= x && x <= rx + rw &&
+      ry <= y && y <= ry + rh
+
+--------------------------------------------------------------------------------
+overDrawingArea :: GUI -> IO Bool
+overDrawingArea g
+    = do pos    <- Gtk.widgetGetPointer $ guiWindow g
+         size   <- Gtk.widgetGetSize $ guiDrawingAreaViewport g
+         mcoord <- Gtk.widgetTranslateCoordinates
+                   (guiDrawingArea g) (guiWindow g) 0 0
+
+         return $ maybe False (calculate pos size) mcoord
+  where
+    calculate pos (rw, rh) (x,y)
+        = isOverGtkRect pos (Gtk.Rectangle x y rw rh)

Dhek/Signal.hs

@@ -19,6 +19,7 @@ import qualified Graphics.UI.Gtk as Gtk
 import           System.FilePath (takeFileName)
 
 --------------------------------------------------------------------------------
+import Dhek.AppUtil (closeKeystrokes)
 import Dhek.Action (onNext, onPrev, onMinus, onPlus, onRem, onApplidok)
 import Dhek.Engine.Instr
 import Dhek.GUI
@@ -36,18 +37,7 @@ import Dhek.Widget.Type
 --------------------------------------------------------------------------------
 connectSignals :: GUI -> RuntimeEnv -> IO ()
 connectSignals g i = do
-    Gtk.onDelete (guiWindow g) $ \_ ->
-        do hasEvent <- engineHasEvents i
-           case () of
-               _ | hasEvent ->
-                   do resp <- gtkShowConfirm g (guiTranslate g $ MsgConfirmQuit)
-                      case resp of
-                          DhekSave ->
-                              do r <- runProgram i onJsonSave
-                                 return $ not r
-                          DhekDontSave -> return False
-                          DhekCancel   -> return True
-                 | otherwise -> return False
+    Gtk.on (guiWindow g) Gtk.deleteEvent $ liftIO $ closeConfirmation i g
 
     Gtk.on (guiPdfOpenMenuItem g) Gtk.menuItemActivate $ dhekOpenPdf g i
 
@@ -138,19 +128,23 @@ connectSignals g i = do
                       Gtk.set (guiHRuler g) [Gtk.rulerPosition Gtk.:= x/r]
                       Gtk.set (guiVRuler g) [Gtk.rulerPosition Gtk.:= y/r]
 
-    Gtk.on (guiDrawingArea g) Gtk.keyPressEvent $ Gtk.tryEvent $
+    Gtk.after (guiWindow g) Gtk.keyPressEvent $ Gtk.tryEvent $
         do name <- Gtk.eventKeyName
            mod  <- Gtk.eventModifier
-           liftIO $ engineModeKeyPress mod name i
-
-    Gtk.on (guiDrawingArea g) Gtk.keyReleaseEvent $ Gtk.tryEvent $
+           if closeKeystrokes name mod
+               then liftIO $
+                        do stay <- closeConfirmation i g
+                           when (not stay) $
+                               Gtk.widgetDestroy $ guiWindow g
+               else liftIO $ engineModeKeyPress mod name i
+
+    Gtk.after (guiWindow g) Gtk.keyReleaseEvent $ Gtk.tryEvent $
         do name <- Gtk.eventKeyName
            mod  <- Gtk.eventModifier
            liftIO $ engineModeKeyRelease mod name i
 
     Gtk.on (guiDrawingArea g) Gtk.enterNotifyEvent $ Gtk.tryEvent $ liftIO $
-        do Gtk.widgetGrabFocus $ guiDrawingArea g
-           engineModeEnter i
+        engineModeEnter i
 
     Gtk.on (guiDrawingArea g) Gtk.leaveNotifyEvent $ Gtk.tryEvent $ liftIO $
         engineModeLeave i
@@ -301,3 +295,18 @@ statusNamePressed n
     | "Alt_L" <- n = True
     | "Alt_R" <- n = True
     | otherwise    = False
+
+--------------------------------------------------------------------------------
+closeConfirmation :: RuntimeEnv -> GUI -> IO Bool
+closeConfirmation i g
+    = do hasEvent <- engineHasEvents i
+         case () of
+             _ | hasEvent ->
+                 do resp <- gtkShowConfirm g (guiTranslate g $ MsgConfirmQuit)
+                    case resp of
+                        DhekSave
+                            -> do r <- runProgram i onJsonSave
+                                  return $ not r
+                        DhekDontSave -> return False
+                        DhekCancel   -> return True
+               | otherwise -> return False

darwin/Dhek/AppUtil.hs

@@ -13,6 +13,9 @@ module Dhek.AppUtil where
 import Foreign.C
 import System.Exit (exitSuccess)
 
+--------------------------------------------------------------------------------
+import qualified Graphics.UI.Gtk as Gtk
+
 --------------------------------------------------------------------------------
 foreign import ccall "util.h nsappTerminate" nsappTerminate :: IO ()
 foreign import ccall "util.h nsbrowserOpen" nsbrowserOpen :: CString -> IO ()
@@ -39,3 +42,8 @@ isKeyModifier _        = False
 --------------------------------------------------------------------------------
 keyModifierName :: String
 keyModifierName = "CMD"
+
+--------------------------------------------------------------------------------
+closeKeystrokes :: String -> [Gtk.Modifier] -> Bool
+closeKeystrokes "q" [Gtk.Meta] = True
+closeKeystrokes _ _            = False

unix/Dhek/AppUtil.hs

@@ -8,6 +8,9 @@
 --------------------------------------------------------------------------------
 module Dhek.AppUtil where
 
+--------------------------------------------------------------------------------
+import qualified Graphics.UI.Gtk as Gtk
+
 --------------------------------------------------------------------------------
 appTerminate :: IO ()
 appTerminate = return ()
@@ -26,3 +29,7 @@ isKeyModifier _           = False
 --------------------------------------------------------------------------------
 keyModifierName :: String
 keyModifierName = "CTRL"
+
+--------------------------------------------------------------------------------
+closeKeystrokes :: String -> [Gtk.Modifier] -> Bool
+closeKeystrokes _ _ = False

win/dhek/AppUtil.hs

@@ -13,6 +13,9 @@ module Dhek.AppUtil where
 import Foreign.C
 import Foreign.C.String
 
+--------------------------------------------------------------------------------
+import qualified Graphics.UI.Gtk as Gtk
+
 --------------------------------------------------------------------------------
 foreign import ccall "util.h browser_open" browser_open :: CString -> IO ()
 
@@ -36,3 +39,8 @@ isKeyModifier _           = False
 --------------------------------------------------------------------------------
 keyModifierName :: String
 keyModifierName = "CTRL"
+
+--------------------------------------------------------------------------------
+closeKeystrokes :: String -> [Gtk.Modifier] -> Bool
+closeKeystrokes "F4" [Gtk.Alt] = True
+closeKeystrokes _ _            = False