{-# LINE 2 "./System/Glib/Signals.chs" #-}
{-# CFILES hsgclosure.c #-}
-- -*-haskell-*-
-- Callback installers for the GIMP Toolkit (GTK) Binding for Haskell
--
-- Author : Axel Simon
--
-- Created: 1 July 2000
--
-- Copyright (C) 2000-2005 Axel Simon, Duncan Coutts
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- #prune

-- The object system in the second version of GTK is based on GObject from
-- GLIB. This base class is rather primitive in that it only implements
-- ref and unref methods (and others that are not interesting to us). If
-- the marshall list mentions OBJECT it refers to an instance of this
-- GObject which is automatically wrapped with a ref and unref call.
-- Structures which are not derived from GObject have to be passed as
-- BOXED which gives the signal connect function a possibility to do the
-- conversion into a proper ForeignPtr type. In special cases the signal
-- connect function use a PTR type which will then be mangled in the
-- user function directly. The latter is needed if a signal delivers a
-- pointer to a string and its length in a separate integer.
--
module System.Glib.Signals (
  Signal(Signal),
  on, after,
  SignalName,
  GSignalMatchType(..),
  ConnectAfter,
  ConnectId(ConnectId),
  signalDisconnect,
  signalBlock,
  signalBlockMatched,
  signalUnblock,
  signalStopEmission,
  disconnect,
  GClosure,

  connectGeneric,




  ) where

import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.GType
import System.Glib.Flags
import System.Glib.GObject
{-# LINE 63 "./System/Glib/Signals.chs" #-}





{-# LINE 68 "./System/Glib/Signals.chs" #-}

newtype Signal object handler =
  Signal (Bool -> object -> handler -> IO (ConnectId object))

-- | Perform an action in response to a signal.
--
-- Use it like this:
--
-- > on obj sig $ do
-- > ...
--
-- or if the signal handler takes any arguments:
--
-- > on obj sig $ \args -> do
-- > ...
--
on ::
    object
 -> Signal object callback
 -> callback
 -> IO (ConnectId object)
on :: forall object callback.
object
-> Signal object callback -> callback -> IO (ConnectId object)
on object
object (Signal Bool -> object -> callback -> IO (ConnectId object)
connect) callback
handler = Bool -> object -> callback -> IO (ConnectId object)
connect Bool
False object
object callback
handler

-- | Perform an action in response to a signal.
--
-- * Like 'on' but the signal is executed after Gtk's default handler has
-- run.
--
after ::
    object
 -> Signal object callback
 -> callback
 -> IO (ConnectId object)
after :: forall object callback.
object
-> Signal object callback -> callback -> IO (ConnectId object)
after object
object (Signal Bool -> object -> callback -> IO (ConnectId object)
connect) callback
handler = Bool -> object -> callback -> IO (ConnectId object)
connect Bool
True object
object callback
handler

-- Specify if the handler is to run before (False) or after (True) the
-- default handler.

type ConnectAfter = Bool

type SignalName = String

-- | The type of signal handler ids. If you ever need to use
-- 'signalDisconnect' to disconnect a signal handler then you will
-- need to retain the 'ConnectId' you got when you registered it.
--
data GObjectClass o => ConnectId o = ConnectId (CULong) o

-- old name for backwards compatibility
disconnect :: GObjectClass obj => ConnectId obj -> IO ()
disconnect :: forall obj. GObjectClass obj => ConnectId obj -> IO ()
disconnect = ConnectId obj -> IO ()
forall obj. GObjectClass obj => ConnectId obj -> IO ()
signalDisconnect
{-# DEPRECATED disconnect "use signalDisconnect instead" #-}

-- | Disconnect a signal handler. After disconnecting the handler will no
-- longer be invoked when the event occurs.
--
signalDisconnect :: GObjectClass obj => ConnectId obj -> IO ()
signalDisconnect :: forall obj. GObjectClass obj => ConnectId obj -> IO ()
signalDisconnect (ConnectId CULong
handler obj
obj) =
  ForeignPtr GObject -> (Ptr GObject -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ((GObject -> ForeignPtr GObject
unGObject(GObject -> ForeignPtr GObject)
-> (obj -> GObject) -> obj -> ForeignPtr GObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
.obj -> GObject
forall o. GObjectClass o => o -> GObject
toGObject) obj
obj) ((Ptr GObject -> IO ()) -> IO ())
-> (Ptr GObject -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GObject
objPtr ->
  Ptr () -> CULong -> IO ()
g_signal_handler_disconnect (Ptr GObject -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr GObject
objPtr) CULong
handler

-- | Block a specific signal handler.
--
-- * Blocks a handler of an instance so it will not be called during any
-- signal emissions unless it is unblocked again. Thus \"blocking\" a signal
-- handler means to temporarily deactivate it, a signal handler has to be
-- unblocked exactly the same amount of times it has been blocked before
-- to become active again.
--
signalBlock :: GObjectClass obj => ConnectId obj -> IO ()
signalBlock :: forall obj. GObjectClass obj => ConnectId obj -> IO ()
signalBlock (ConnectId CULong
handler obj
obj) =
  ForeignPtr GObject -> (Ptr GObject -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ((GObject -> ForeignPtr GObject
unGObject(GObject -> ForeignPtr GObject)
-> (obj -> GObject) -> obj -> ForeignPtr GObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
.obj -> GObject
forall o. GObjectClass o => o -> GObject
toGObject) obj
obj) ((Ptr GObject -> IO ()) -> IO ())
-> (Ptr GObject -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GObject
objPtr ->
  Ptr () -> CULong -> IO ()
g_signal_handler_block (Ptr GObject -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr GObject
objPtr) CULong
handler

data GSignalMatchType = SignalMatchId
                      | SignalMatchDetail
                      | SignalMatchClosure
                      | SignalMatchFunc
                      | SignalMatchData
                      | SignalMatchUnblocked
                      deriving (GSignalMatchType -> GSignalMatchType -> Bool
(GSignalMatchType -> GSignalMatchType -> Bool)
-> (GSignalMatchType -> GSignalMatchType -> Bool)
-> Eq GSignalMatchType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GSignalMatchType -> GSignalMatchType -> Bool
== :: GSignalMatchType -> GSignalMatchType -> Bool
$c/= :: GSignalMatchType -> GSignalMatchType -> Bool
/= :: GSignalMatchType -> GSignalMatchType -> Bool
Eq,Eq GSignalMatchType
Eq GSignalMatchType =>
(GSignalMatchType -> GSignalMatchType -> Ordering)
-> (GSignalMatchType -> GSignalMatchType -> Bool)
-> (GSignalMatchType -> GSignalMatchType -> Bool)
-> (GSignalMatchType -> GSignalMatchType -> Bool)
-> (GSignalMatchType -> GSignalMatchType -> Bool)
-> (GSignalMatchType -> GSignalMatchType -> GSignalMatchType)
-> (GSignalMatchType -> GSignalMatchType -> GSignalMatchType)
-> Ord GSignalMatchType
GSignalMatchType -> GSignalMatchType -> Bool
GSignalMatchType -> GSignalMatchType -> Ordering
GSignalMatchType -> GSignalMatchType -> GSignalMatchType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GSignalMatchType -> GSignalMatchType -> Ordering
compare :: GSignalMatchType -> GSignalMatchType -> Ordering
$c< :: GSignalMatchType -> GSignalMatchType -> Bool
< :: GSignalMatchType -> GSignalMatchType -> Bool
$c<= :: GSignalMatchType -> GSignalMatchType -> Bool
<= :: GSignalMatchType -> GSignalMatchType -> Bool
$c> :: GSignalMatchType -> GSignalMatchType -> Bool
> :: GSignalMatchType -> GSignalMatchType -> Bool
$c>= :: GSignalMatchType -> GSignalMatchType -> Bool
>= :: GSignalMatchType -> GSignalMatchType -> Bool
$cmax :: GSignalMatchType -> GSignalMatchType -> GSignalMatchType
max :: GSignalMatchType -> GSignalMatchType -> GSignalMatchType
$cmin :: GSignalMatchType -> GSignalMatchType -> GSignalMatchType
min :: GSignalMatchType -> GSignalMatchType -> GSignalMatchType
Ord,GSignalMatchType
GSignalMatchType -> GSignalMatchType -> Bounded GSignalMatchType
forall a. a -> a -> Bounded a
$cminBound :: GSignalMatchType
minBound :: GSignalMatchType
$cmaxBound :: GSignalMatchType
maxBound :: GSignalMatchType
Bounded)
instance Enum GSignalMatchType where
  fromEnum :: GSignalMatchType -> Int
fromEnum GSignalMatchType
SignalMatchId = Int
1
  fromEnum GSignalMatchType
SignalMatchDetail = Int
2
  fromEnum GSignalMatchType
SignalMatchClosure = Int
4
  fromEnum GSignalMatchType
SignalMatchFunc = Int
8
  fromEnum GSignalMatchType
SignalMatchData = Int
16
  fromEnum GSignalMatchType
SignalMatchUnblocked = Int
32

  toEnum :: Int -> GSignalMatchType
toEnum Int
1 = GSignalMatchType
SignalMatchId
  toEnum Int
2 = GSignalMatchType
SignalMatchDetail
  toEnum Int
4 = GSignalMatchType
SignalMatchClosure
  toEnum Int
8 = GSignalMatchType
SignalMatchFunc
  toEnum Int
16 = GSignalMatchType
SignalMatchData
  toEnum Int
32 = GSignalMatchType
SignalMatchUnblocked
  toEnum Int
unmatched = [Char] -> GSignalMatchType
forall a. HasCallStack => [Char] -> a
error ([Char]
"GSignalMatchType.toEnum: Cannot match " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
unmatched)

  succ :: GSignalMatchType -> GSignalMatchType
succ GSignalMatchType
SignalMatchId = GSignalMatchType
SignalMatchDetail
  succ GSignalMatchType
SignalMatchDetail = GSignalMatchType
SignalMatchClosure
  succ GSignalMatchType
SignalMatchClosure = GSignalMatchType
SignalMatchFunc
  succ GSignalMatchType
SignalMatchFunc = GSignalMatchType
SignalMatchData
  succ GSignalMatchType
SignalMatchData = GSignalMatchType
SignalMatchUnblocked
  succ GSignalMatchType
_ = GSignalMatchType
forall a. HasCallStack => a
undefined

  pred :: GSignalMatchType -> GSignalMatchType
pred GSignalMatchType
SignalMatchDetail = GSignalMatchType
SignalMatchId
  pred GSignalMatchType
SignalMatchClosure = GSignalMatchType
SignalMatchDetail
  pred GSignalMatchType
SignalMatchFunc = GSignalMatchType
SignalMatchClosure
  pred GSignalMatchType
SignalMatchData = GSignalMatchType
SignalMatchFunc
  pred GSignalMatchType
SignalMatchUnblocked = GSignalMatchType
SignalMatchData
  pred GSignalMatchType
_ = GSignalMatchType
forall a. HasCallStack => a
undefined

  enumFromTo :: GSignalMatchType -> GSignalMatchType -> [GSignalMatchType]
enumFromTo GSignalMatchType
x GSignalMatchType
y | GSignalMatchType -> Int
forall a. Enum a => a -> Int
fromEnum GSignalMatchType
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== GSignalMatchType -> Int
forall a. Enum a => a -> Int
fromEnum GSignalMatchType
y = [ GSignalMatchType
y ]
                 | Bool
otherwise = GSignalMatchType
x GSignalMatchType -> [GSignalMatchType] -> [GSignalMatchType]
forall a. a -> [a] -> [a]
: GSignalMatchType -> GSignalMatchType -> [GSignalMatchType]
forall a. Enum a => a -> a -> [a]
enumFromTo (GSignalMatchType -> GSignalMatchType
forall a. Enum a => a -> a
succ GSignalMatchType
x) GSignalMatchType
y
  enumFrom :: GSignalMatchType -> [GSignalMatchType]
enumFrom GSignalMatchType
x = GSignalMatchType -> GSignalMatchType -> [GSignalMatchType]
forall a. Enum a => a -> a -> [a]
enumFromTo GSignalMatchType
x GSignalMatchType
SignalMatchUnblocked
  enumFromThen :: GSignalMatchType -> GSignalMatchType -> [GSignalMatchType]
enumFromThen GSignalMatchType
_ GSignalMatchType
_ =     [Char] -> [GSignalMatchType]
forall a. HasCallStack => [Char] -> a
error [Char]
"Enum GSignalMatchType: enumFromThen not implemented"
  enumFromThenTo :: GSignalMatchType
-> GSignalMatchType -> GSignalMatchType -> [GSignalMatchType]
enumFromThenTo GSignalMatchType
_ GSignalMatchType
_ GSignalMatchType
_ =     [Char] -> [GSignalMatchType]
forall a. HasCallStack => [Char] -> a
error [Char]
"Enum GSignalMatchType: enumFromThenTo not implemented"

{-# LINE 143 "./System/Glib/Signals.chs" #-}
instance Flags GSignalMatchType

-- | Blocks all handlers on an instance that match a certain selection
-- criteria. The criteria mask is passed as a list of `GSignalMatchType` flags,
-- and the criteria values are passed as arguments. Passing at least one of
-- the `SignalMatchClosure`, `SignalMatchFunc` or `SignalMatchData` match flags
-- is required for successful matches. If no handlers were found, 0 is returned,
-- the number of blocked handlers otherwise.
signalBlockMatched :: GObjectClass obj
                   => obj
                   -> [GSignalMatchType]
                   -> SignalName
                   -> GType
                   -> Quark
                   -> Maybe GClosure
                   -> Maybe (Ptr ())
                   -> Maybe (Ptr ())
                   -> IO Int
signalBlockMatched obj mask sigName gType quark closure func userData = do
  sigId <- withCString sigName $ \strPtr ->
                g_signal_lookup strPtr gType
  liftM fromIntegral $ withForeignPtr (unGObject $ toGObject obj) $ \objPtr ->
    g_signal_handlers_block_matched
{-# LINE 166 "./System/Glib/Signals.chs" #-}
        (castPtr objPtr)
        (fromIntegral $ fromFlags mask)
        sigId
        quark
        (maybe nullPtr (\(GClosure p) -> castPtr p) closure)
        (maybe nullPtr id func)
        (maybe nullPtr id userData)

-- | Unblock a specific signal handler.
--
-- * Undoes the effect of a previous 'signalBlock' call. A blocked handler
-- is skipped during signal emissions and will not be invoked, unblocking
-- it (for exactly the amount of times it has been blocked before) reverts
-- its \"blocked\" state, so the handler will be recognized by the signal
-- system and is called upon future or currently ongoing signal emissions
-- (since the order in which handlers are called during signal emissions
-- is deterministic, whether the unblocked handler in question is called
-- as part of a currently ongoing emission depends on how far that
-- emission has proceeded yet).
--
signalUnblock :: GObjectClass obj => ConnectId obj -> IO ()
signalUnblock :: forall obj. GObjectClass obj => ConnectId obj -> IO ()
signalUnblock (ConnectId CULong
handler obj
obj) =
  ForeignPtr GObject -> (Ptr GObject -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ((GObject -> ForeignPtr GObject
unGObject(GObject -> ForeignPtr GObject)
-> (obj -> GObject) -> obj -> ForeignPtr GObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
.obj -> GObject
forall o. GObjectClass o => o -> GObject
toGObject) obj
obj) ((Ptr GObject -> IO ()) -> IO ())
-> (Ptr GObject -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GObject
objPtr ->
  Ptr () -> CULong -> IO ()
g_signal_handler_unblock (Ptr GObject -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr GObject
objPtr) CULong
handler

-- | Stops a signal's current emission.
--
-- * This will prevent the default method from running. The sequence in which
-- handlers are run is \"first\", \"on\", \"last\" then \"after\" where
-- Gtk-internal
-- signals are connected either at \"first\" or at \"last\". Hence this
-- function can only stop the signal processing if it is called from within
-- a handler that is connected with an \"on\" signal and if the Gtk-internal
-- handler is connected as \"last\". Gtk prints a warning if this function
-- is used on a signal which isn't being emitted.
--
signalStopEmission :: GObjectClass obj => obj -> SignalName -> IO ()
signalStopEmission :: forall obj. GObjectClass obj => obj -> [Char] -> IO ()
signalStopEmission obj
obj [Char]
sigName =
  ForeignPtr GObject -> (Ptr GObject -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ((GObject -> ForeignPtr GObject
unGObject(GObject -> ForeignPtr GObject)
-> (obj -> GObject) -> obj -> ForeignPtr GObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
.obj -> GObject
forall o. GObjectClass o => o -> GObject
toGObject) obj
obj) ((Ptr GObject -> IO ()) -> IO ())
-> (Ptr GObject -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GObject
objPtr ->
  [Char] -> (CString -> IO ()) -> IO ()
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
sigName ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->
  Ptr () -> CString -> IO ()
g_signal_stop_emission_by_name (Ptr GObject -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr GObject
objPtr) CString
strPtr

newtype GClosure = GClosure (Ptr (GClosure))
{-# LINE 209 "./System/Glib/Signals.chs" #-}



connectGeneric :: GObjectClass obj =>
    SignalName
 -> ConnectAfter
 -> obj
 -> handler
 -> IO (ConnectId obj)
connectGeneric :: forall obj handler.
GObjectClass obj =>
[Char] -> Bool -> obj -> handler -> IO (ConnectId obj)
connectGeneric [Char]
signal Bool
after obj
obj handler
user = do
  StablePtr handler
sptr <- handler -> IO (StablePtr handler)
forall a. a -> IO (StablePtr a)
newStablePtr handler
user
  Ptr GClosure
gclosurePtr <- StablePtr handler -> IO (Ptr GClosure)
forall a. StablePtr a -> IO (Ptr GClosure)
gtk2hs_closure_new StablePtr handler
sptr
  CULong
sigId <-
    [Char] -> (CString -> IO CULong) -> IO CULong
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
signal ((CString -> IO CULong) -> IO CULong)
-> (CString -> IO CULong) -> IO CULong
forall a b. (a -> b) -> a -> b
$ \CString
signalPtr ->
    ForeignPtr GObject -> (Ptr GObject -> IO CULong) -> IO CULong
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ((GObject -> ForeignPtr GObject
unGObject(GObject -> ForeignPtr GObject)
-> (obj -> GObject) -> obj -> ForeignPtr GObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
.obj -> GObject
forall o. GObjectClass o => o -> GObject
toGObject) obj
obj) ((Ptr GObject -> IO CULong) -> IO CULong)
-> (Ptr GObject -> IO CULong) -> IO CULong
forall a b. (a -> b) -> a -> b
$ \Ptr GObject
objPtr ->
    (\Ptr ()
arg1 CString
arg2 (GClosure Ptr GClosure
arg3) CInt
arg4 -> Ptr () -> CString -> Ptr GClosure -> CInt -> IO CULong
g_signal_connect_closure Ptr ()
arg1 CString
arg2 Ptr GClosure
arg3 CInt
arg4)
{-# LINE 225 "./System/Glib/Signals.chs" #-}
      (castPtr objPtr)
      CString
signalPtr
      (Ptr GClosure -> GClosure
GClosure Ptr GClosure
gclosurePtr)
      (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
after)
  ConnectId obj -> IO (ConnectId obj)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectId obj -> IO (ConnectId obj))
-> ConnectId obj -> IO (ConnectId obj)
forall a b. (a -> b) -> a -> b
$ CULong -> obj -> ConnectId obj
forall o. GObjectClass o => CULong -> o -> ConnectId o
ConnectId CULong
sigId obj
obj

foreign import ccall unsafe "gtk2hs_closure_new"
  gtk2hs_closure_new :: StablePtr a -> IO (Ptr GClosure)

foreign import ccall safe "g_signal_handler_disconnect"
  g_signal_handler_disconnect :: ((Ptr ()) -> (CULong -> (IO ())))

foreign import ccall safe "g_signal_handler_block"
  g_signal_handler_block :: ((Ptr ()) -> (CULong -> (IO ())))

foreign import ccall safe "g_signal_lookup"
  g_signal_lookup :: ((Ptr CChar) -> (CULong -> (IO CUInt)))

foreign import ccall safe "g_signal_handlers_block_matched"
  g_signal_handlers_block_matched :: ((Ptr ()) -> (CInt -> (CUInt -> (CUInt -> ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO CUInt))))))))

foreign import ccall safe "g_signal_handler_unblock"
  g_signal_handler_unblock :: ((Ptr ()) -> (CULong -> (IO ())))

foreign import ccall safe "g_signal_stop_emission_by_name"
  g_signal_stop_emission_by_name :: ((Ptr ()) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "g_signal_connect_closure"
  g_signal_connect_closure :: ((Ptr ()) -> ((Ptr CChar) -> ((Ptr GClosure) -> (CInt -> (IO CULong)))))