fix accelerator key handling

This commit is contained in:
sheaf 2020-09-06 17:13:30 +02:00
parent e4779d8af2
commit 777b894c06
2 changed files with 25 additions and 33 deletions

View file

@ -674,15 +674,18 @@ instance HandleAction MouseClick where
DoubleClick -> do
tool <- STM.readTVar toolTVar
mode <- STM.readTVar modeTVar
modifs <- STM.readTVar modifiersTVar
case tool of
Selection -> do
STM.writeTVar mouseHoldTVar Nothing
let
mbSubdivide :: Maybe Document
mbSubdivide = subdivide mode pos doc
case mbSubdivide of
Nothing -> pure Don'tModifyDoc
Just newDoc -> pure ( UpdateDocTo $ Just newDoc )
Selection
| null modifs
-> do
STM.writeTVar mouseHoldTVar Nothing
let
mbSubdivide :: Maybe Document
mbSubdivide = subdivide mode pos doc
case mbSubdivide of
Nothing -> pure Don'tModifyDoc
Just newDoc -> pure ( UpdateDocTo $ Just newDoc )
-- Ignore double click event otherwise.
_ -> pure Don'tModifyDoc
@ -951,11 +954,8 @@ instance HandleAction KeyboardPress where
vars@( Variables {..} )
( KeyboardPress keyCode ) = do
modifiers <- STM.atomically do
!modifiers <- STM.readTVar modifiersTVar
for_ ( modifierKey keyCode ) \ modifier ->
( STM.writeTVar modifiersTVar ( Set.insert modifier modifiers ) )
pure modifiers
for_ ( modifierKey keyCode ) \ modifier ->
STM.atomically $ STM.modifyTVar' modifiersTVar ( Set.insert modifier )
case keyCode of
@ -981,14 +981,6 @@ instance HandleAction KeyboardPress where
GTK.widgetQueueDraw viewportDrawingArea
_ -> pure ()
-- todo: these should be handled by accelerator,
-- but those are not working currently
GDK.KEY_Delete -> handleAction uiElts vars Delete
GDK.KEY_s
| any ( \case { Control _ -> True; _ -> False } ) modifiers
-> handleAction uiElts vars Save
_ -> pure ()
----------------------

View file

@ -40,25 +40,25 @@ handleEvents :: UIElements -> Variables -> IO ()
handleEvents elts@( UIElements { viewport = Viewport {..}, .. } ) vars = do
-- Mouse events
onWidgetMouseEvent viewportDrawingArea ViewportOrigin
onWidgetMouseEvent rulerCornerDrawingArea ( RulerOrigin RulerCorner )
onWidgetMouseEvent leftRulerDrawingArea ( RulerOrigin LeftRuler )
onWidgetMouseEvent topRulerDrawingArea ( RulerOrigin TopRuler )
afterWidgetMouseEvent viewportDrawingArea ViewportOrigin
afterWidgetMouseEvent rulerCornerDrawingArea ( RulerOrigin RulerCorner )
afterWidgetMouseEvent leftRulerDrawingArea ( RulerOrigin LeftRuler )
afterWidgetMouseEvent topRulerDrawingArea ( RulerOrigin TopRuler )
-- Keyboard events
void $ GTK.onWidgetKeyPressEvent window ( handleKeyboardPressEvent elts vars )
void $ GTK.onWidgetKeyReleaseEvent window ( handleKeyboardReleaseEvent elts vars )
void $ GTK.afterWidgetKeyPressEvent window ( handleKeyboardPressEvent elts vars )
void $ GTK.afterWidgetKeyReleaseEvent window ( handleKeyboardReleaseEvent elts vars )
-- Window quit
void $ GTK.onWidgetDestroy window ( quitEverything window )
where
onWidgetMouseEvent :: GTK.DrawingArea -> ActionOrigin -> IO ()
onWidgetMouseEvent drawingArea eventOrigin = do
void $ GTK.onWidgetMotionNotifyEvent drawingArea ( handleMotionEvent elts vars eventOrigin )
void $ GTK.onWidgetScrollEvent drawingArea ( handleScrollEvent elts vars eventOrigin )
void $ GTK.onWidgetButtonPressEvent drawingArea ( handleMouseButtonEvent elts vars eventOrigin )
void $ GTK.onWidgetButtonReleaseEvent drawingArea ( handleMouseButtonRelease elts vars eventOrigin )
afterWidgetMouseEvent :: GTK.DrawingArea -> ActionOrigin -> IO ()
afterWidgetMouseEvent drawingArea eventOrigin = do
void $ GTK.afterWidgetMotionNotifyEvent drawingArea ( handleMotionEvent elts vars eventOrigin )
void $ GTK.afterWidgetScrollEvent drawingArea ( handleScrollEvent elts vars eventOrigin )
void $ GTK.afterWidgetButtonPressEvent drawingArea ( handleMouseButtonEvent elts vars eventOrigin )
void $ GTK.afterWidgetButtonReleaseEvent drawingArea ( handleMouseButtonRelease elts vars eventOrigin )
--------------------------------------------------------------------------------
-- Mouse events.