src/Gtk/Widgets/Sheet/Signal.icl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

implementation module Gtk.Widgets.Sheet.Signal

import StdEnv
import StdMaybe

import Control.Monad
import Data.Functor
import System._Pointer

import Gtk

instance signalHandler GtkSheetSignalHandler
where
	signalName handler = case handler of
		DeactivateHandler _    -> "deactivate"
		EnterPressedHandler _  -> "enter-pressed"
		SheetActivateHandler _ -> "activate"
		TraverseHandler _      -> "traverse"
	signalHandler handler = case handler of
		DeactivateHandler f -> SHI_Int_Int_Bool f
		EnterPressedHandler f -> SHI_Pointer_Bool \_ -> (\p -> p=:StopPropagation) <$> f
		SheetActivateHandler f -> SHI_Int_Int_Bool \r c -> f r c >>| pure True
		TraverseHandler f -> SHI_Int_Int_Pointer_Pointer_Bool \oldrow oldcol newrowp newcolp ->
			let newrow = readInt4S newrowp 0; newcol = readInt4S newcolp 0 in
			// NB, possible bug in GtkSheet: when a cell is selected and the
			// user then presses enter, this emits a traverse signal with new
			// location (-1,0), and selects the entire first column. This seems
			// undesirable, so we prevent it.
			if (newrow < 0 || newcol < 0)
				(pure False)
				(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)

instance tune w GtkSheetSignalHandler | gtkWidget w
where
	tune handler widget = installSignalHandler handler widget