summaryrefslogtreecommitdiff
path: root/src/Gtk
diff options
context:
space:
mode:
authorCamil Staps2019-10-22 21:57:14 +0200
committerCamil Staps2019-10-22 21:58:19 +0200
commit3502b70fde2bfe3b91e3688a52a90151f113b47c (patch)
treec7eae48cd97522ddaa437529d879c1c373766efd /src/Gtk
parentRestructure signal handling: callbacks cannot be delayed because they may hav... (diff)
Add TraverseHandler for GtkSheet
Diffstat (limited to 'src/Gtk')
-rw-r--r--src/Gtk/Widgets/Sheet.dcl2
-rw-r--r--src/Gtk/Widgets/Sheet/Signal.dcl11
-rw-r--r--src/Gtk/Widgets/Sheet/Signal.icl24
3 files changed, 37 insertions, 0 deletions
diff --git a/src/Gtk/Widgets/Sheet.dcl b/src/Gtk/Widgets/Sheet.dcl
index 37523f7..6f27ecf 100644
--- a/src/Gtk/Widgets/Sheet.dcl
+++ b/src/Gtk/Widgets/Sheet.dcl
@@ -12,6 +12,8 @@ from Gtk.Widgets import
class gtkWidget, :: GtkWidget,
class gtkContainer, :: GtkContainer
+import Gtk.Widgets.Sheet.Signal
+
:: GtkSheet
instance gtkWidget GtkSheet
diff --git a/src/Gtk/Widgets/Sheet/Signal.dcl b/src/Gtk/Widgets/Sheet/Signal.dcl
new file mode 100644
index 0000000..32f5383
--- /dev/null
+++ b/src/Gtk/Widgets/Sheet/Signal.dcl
@@ -0,0 +1,11 @@
+definition module Gtk.Widgets.Sheet.Signal
+
+from StdMaybe import :: Maybe
+
+from Gtk.Signal import class signalHandler, :: SignalHandlerInternal
+from Gtk.State import :: GtkM
+
+:: GtkSheetSignalHandler
+ = TraverseHandler !((Maybe (Int,Int)) (Int,Int) -> GtkM (Maybe (Int, Int)))
+
+instance signalHandler GtkSheetSignalHandler
diff --git a/src/Gtk/Widgets/Sheet/Signal.icl b/src/Gtk/Widgets/Sheet/Signal.icl
new file mode 100644
index 0000000..562f806
--- /dev/null
+++ b/src/Gtk/Widgets/Sheet/Signal.icl
@@ -0,0 +1,24 @@
+implementation module Gtk.Widgets.Sheet.Signal
+
+import StdEnv
+import StdMaybe
+
+import Control.Monad
+import System._Pointer
+
+import Gtk
+
+instance signalHandler GtkSheetSignalHandler
+where
+ signalName handler = case handler of
+ TraverseHandler _ -> "traverse"
+ signalHandler handler = case handler of
+ TraverseHandler f -> SHI_Int_Int_Pointer_Pointer_Bool \oldrow oldcol newrowp newcolp ->
+ let newrow = readInt4S newrowp 0; newcol = readInt4S newcolp 0 in
+ f (if (oldrow<0) Nothing (Just (oldrow,oldcol))) (newrow,newcol) >>= \r -> case r of
+ Nothing ->
+ pure False
+ Just (row,col) ->
+ appWorld (forceEval (writeInt4 newrowp 0 row)) >>|
+ appWorld (forceEval (writeInt4 newcolp 0 col)) >>|
+ pure True