    {-# LINE 2 "./System/Glib/GObject.chs" #-}
    -- -*-haskell-*-
    -- GIMP Toolkit (GTK) GObject
    --
    -- Author : Axel Simon
    --
    -- Created: 9 April 2001
    --
    -- Copyright (C) 2001 Axel Simon
    --
    -- 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.
    --
    -- |
    -- Maintainer : gtk2hs-users@lists.sourceforge.net
    -- Stability : provisional
    -- Portability : portable (depends on GHC)
    --
    -- The base object type for all glib objects
    --
    module System.Glib.GObject (
      -- * Types
      module System.Glib.Types,

      -- * Low level binding functions

      -- | All these functions are internal and are only interesting to people
      -- writing bindings to GObject-style C libraries.
      objectNew,
      objectRef,

      objectRefSink,

      makeNewGObject,
      constructNewGObject,
      wrapNewGObject,

      -- ** GType queries
      gTypeGObject,
      isA,

      -- ** Callback support
      DestroyNotify,
      destroyFunPtr,
      destroyStablePtr,

      -- ** User-Defined Attributes
      Quark,
      quarkFromString,
      objectCreateAttribute,
      objectSetAttribute,
      objectGetAttributeUnsafe
      ) where

    import Control.Monad (liftM, when)
    import Data.IORef (newIORef, readIORef, writeIORef)
    import qualified Data.Text as T (pack)

    import System.Glib.FFI
    import System.Glib.UTFString
    import System.Glib.Types
    {-# LINE 69 "./System/Glib/GObject.chs" #-}
    import System.Glib.GValue (GValue)
    import System.Glib.GType (GType, typeInstanceIsA)
    import System.Glib.GTypeConstants ( object )
    import System.Glib.GParameter
    import System.Glib.Attributes (newNamedAttr, Attr)
    import Foreign.StablePtr
    import Control.Concurrent.MVar ( MVar, newMVar, modifyMVar )

    {-# LINE 78 "./System/Glib/GObject.chs" #-}

    type GParm = Ptr (GParameter)
    {-# LINE 80 "./System/Glib/GObject.chs" #-}

    -- | Construct a new object (should rairly be used directly)
    --
    objectNew :: GType -> [(String, GValue)] -> IO (Ptr GObject)
    objectNew :: GType -> [(String, GValue)] -> IO (Ptr GObject)
    objectNew GType
    objType [(String, GValue)]
    parameters =
      (Ptr () -> Ptr GObject) -> IO (Ptr ()) -> IO (Ptr GObject)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Ptr () -> Ptr GObject
    forall a b. Ptr a -> Ptr b
    castPtr (IO (Ptr ()) -> IO (Ptr GObject))
    -> IO (Ptr ()) -> IO (Ptr GObject)
    forall a b. (a -> b) -> a -> b
    $ --caller must makeNewGObject as we don't know
                      --if it this a GObject or a GtkObject
      [GParameter] -> (Ptr GParameter -> IO (Ptr ())) -> IO (Ptr ())
    forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
    withArray (((String, GValue) -> GParameter)
    -> [(String, GValue)] -> [GParameter]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, GValue) -> GParameter
    GParameter [(String, GValue)]
    parameters) ((Ptr GParameter -> IO (Ptr ())) -> IO (Ptr ()))
    -> (Ptr GParameter -> IO (Ptr ())) -> IO (Ptr ())
    forall a b. (a -> b) -> a -> b
    $ \Ptr GParameter
    paramArrayPtr ->
      GType -> CUInt -> Ptr GParameter -> IO (Ptr ())
    g_object_newv GType
    objType
      (Int -> CUInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> CUInt) -> Int -> CUInt
    forall a b. (a -> b) -> a -> b
    $ [(String, GValue)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(String, GValue)]
    parameters) Ptr GParameter
    paramArrayPtr

    -- | Reference and sink an object.
    objectRefSink :: GObjectClass obj => Ptr obj -> IO ()
    objectRefSink :: forall obj. GObjectClass obj => Ptr obj -> IO ()
    objectRefSink Ptr obj
    obj = do
      Ptr () -> IO (Ptr ())
    g_object_ref_sink (Ptr obj -> Ptr ()
    forall a b. Ptr a -> Ptr b
    castPtr Ptr obj
    obj)
      () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Increase the reference counter of an object
    --
    objectRef :: GObjectClass obj => Ptr obj -> IO ()
    objectRef :: forall obj. GObjectClass obj => Ptr obj -> IO ()
    objectRef Ptr obj
    obj = do
      Ptr () -> IO (Ptr ())
    g_object_ref (Ptr obj -> Ptr ()
    forall a b. Ptr a -> Ptr b
    castPtr Ptr obj
    obj)
      () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | The type constant to check if an instance is of 'GObject' type.
    gTypeGObject :: GType
    gTypeGObject :: GType
    gTypeGObject = GType
    object

    -- | This function wraps any object that does not derive from Object.
    -- It should be used whenever a function returns a pointer to an existing
    -- 'GObject' (as opposed to a function that constructs a new object).
    --
    -- * The first argument is the constructor of the specific object.
    --
    makeNewGObject ::
        GObjectClass obj
     => (ForeignPtr obj -> obj, FinalizerPtr obj)
        -- ^ constructor for the Haskell object and finalizer C function
     -> IO (Ptr obj) -- ^ action which yields a pointer to the C object
     -> IO obj
    makeNewGObject :: forall obj.
    GObjectClass obj =>
    (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
    makeNewGObject (ForeignPtr obj -> obj
    constr, FinalizerPtr obj
    objectUnref) IO (Ptr obj)
    generator = do
      objPtr <- IO (Ptr obj)
    generator
      when (objPtr == nullPtr) (fail "makeNewGObject: object is NULL")
      objectRef objPtr
      obj <- newForeignPtr objPtr objectUnref
      return $! constr obj

    type DestroyNotify = FunPtr (((Ptr ()) -> (IO ())))
    {-# LINE 130 "./System/Glib/GObject.chs" #-}

    -- | This function wraps any newly created objects that derives from
    -- GInitiallyUnowned also known as objects with
    -- \"floating-references\". The object will be refSink (for glib
    -- versions >= 2.10). On non-floating objects, this function behaves
    -- exactly the same as "makeNewGObject".
    --
    constructNewGObject :: GObjectClass obj =>
      (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
    constructNewGObject :: forall obj.
    GObjectClass obj =>
    (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
    constructNewGObject (ForeignPtr obj -> obj
    constr, FinalizerPtr obj
    objectUnref) IO (Ptr obj)
    generator = do
      objPtr <- IO (Ptr obj)
    generator

      -- change the existing floating reference into a proper reference;
      -- the name is confusing, what the function does is ref,sink,unref
      objectRefSink objPtr

      obj <- newForeignPtr objPtr objectUnref
      return $! constr obj

    -- | This function wraps any newly created object that does not derived
    -- from GInitiallyUnowned (that is a GObject with no floating
    -- reference). Since newly created 'GObject's have a reference count of
    -- one, they don't need ref'ing.
    --
    wrapNewGObject :: GObjectClass obj =>
      (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
    wrapNewGObject :: forall obj.
    GObjectClass obj =>
    (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
    wrapNewGObject (ForeignPtr obj -> obj
    constr, FinalizerPtr obj
    objectUnref) IO (Ptr obj)
    generator = do
      objPtr <- IO (Ptr obj)
    generator
      when (objPtr == nullPtr) (fail "wrapNewGObject: object is NULL")
      obj <- newForeignPtr objPtr objectUnref
      return $! constr obj

    -- | Many methods in classes derived from GObject take a callback function and
    -- a destructor function which is called to free that callback function when
    -- it is no longer required. This constants is an address of a functions in
    -- C land that will free a function pointer.
    foreign import ccall unsafe "&freeHaskellFunctionPtr" destroyFunPtr :: DestroyNotify

    type Quark = (CUInt)
    {-# LINE 169 "./System/Glib/GObject.chs" #-}

    -- | A counter for generating unique names.
    {-# NOINLINE uniqueCnt #-}
    uniqueCnt :: MVar Int
    uniqueCnt :: MVar Int
    uniqueCnt = IO (MVar Int) -> MVar Int
    forall a. IO a -> a
    unsafePerformIO (IO (MVar Int) -> MVar Int) -> IO (MVar Int) -> MVar Int
    forall a b. (a -> b) -> a -> b
    $ Int -> IO (MVar Int)
    forall a. a -> IO (MVar a)
    newMVar Int
    0

    -- | Create a unique id based on the given string.
    quarkFromString :: GlibString string => string -> IO Quark
    quarkFromString :: forall string. GlibString string => string -> IO CUInt
    quarkFromString string
    name = string -> (CString -> IO CUInt) -> IO CUInt
    forall a. string -> (CString -> IO a) -> IO a
    forall s a. GlibString s => s -> (CString -> IO a) -> IO a
    withUTFString string
    name CString -> IO CUInt
    g_quark_from_string
    {-# LINE 178 "./System/Glib/GObject.chs" #-}

    -- | Add an attribute to this object.
    --
    -- * The function returns a new attribute that can be set or retrieved from
    -- any 'GObject'. The attribute is wrapped in a 'Maybe' type to reflect
    -- the circumstance when the attribute is not set or if it should be unset.
    --
    objectCreateAttribute :: GObjectClass o => IO (Attr o (Maybe a))
    objectCreateAttribute :: forall o a. GObjectClass o => IO (Attr o (Maybe a))
    objectCreateAttribute = do
      cnt <- MVar Int -> (Int -> IO (Int, Int)) -> IO Int
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar Int
    uniqueCnt (\Int
    cnt -> (Int, Int) -> IO (Int, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    cntInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1, Int
    cnt))
      let propName = String
    "Gtk2HsAttr"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    cnt
      attr <- quarkFromString $ T.pack propName
      return (newNamedAttr propName (objectGetAttributeUnsafe attr)
                                    (objectSetAttribute attr))

    -- | The address of a function freeing a 'StablePtr'. See 'destroyFunPtr'.
    foreign import ccall unsafe "&hs_free_stable_ptr" destroyStablePtr :: DestroyNotify

    -- | Set the value of an association.
    --
    objectSetAttribute :: GObjectClass o => Quark -> o -> Maybe a -> IO ()
    objectSetAttribute :: forall o a. GObjectClass o => CUInt -> o -> Maybe a -> IO ()
    objectSetAttribute CUInt
    attr o
    obj Maybe a
    Nothing = do
      (\(GObject ForeignPtr GObject
    arg1) CUInt
    arg2 Ptr ()
    arg3 -> ForeignPtr GObject -> (Ptr GObject -> IO ()) -> IO ()
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr GObject
    arg1 ((Ptr GObject -> IO ()) -> IO ())
    -> (Ptr GObject -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr GObject
    argPtr1 ->Ptr GObject -> CUInt -> Ptr () -> IO ()
    g_object_set_qdata Ptr GObject
    argPtr1 CUInt
    arg2 Ptr ()
    arg3) (o -> GObject
    forall o. GObjectClass o => o -> GObject
    toGObject o
    obj) CUInt
    attr Ptr ()
    forall a. Ptr a
    nullPtr
    objectSetAttribute CUInt
    attr o
    obj (Just a
    val) = do
      sPtr <- a -> IO (StablePtr a)
    forall a. a -> IO (StablePtr a)
    newStablePtr a
    val
      (\(GObject ForeignPtr GObject
    arg1) CUInt
    arg2 Ptr ()
    arg3 FunPtr (Ptr () -> IO ())
    arg4 -> ForeignPtr GObject -> (Ptr GObject -> IO ()) -> IO ()
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr GObject
    arg1 ((Ptr GObject -> IO ()) -> IO ())
    -> (Ptr GObject -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr GObject
    argPtr1 ->Ptr GObject -> CUInt -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO ()
    g_object_set_qdata_full Ptr GObject
    argPtr1 CUInt
    arg2 Ptr ()
    arg3 FunPtr (Ptr () -> IO ())
    arg4) (toGObject obj) attr (castStablePtrToPtr sPtr)
                                     destroyStablePtr

    -- | Get the value of an association.
    --
    -- * Note that this function may crash the Haskell run-time since the
    -- returned type can be forced to be anything. See 'objectCreateAttribute'
    -- for a safe wrapper around this function.
    --
    objectGetAttributeUnsafe :: GObjectClass o => Quark -> o -> IO (Maybe a)
    objectGetAttributeUnsafe :: forall o a. GObjectClass o => CUInt -> o -> IO (Maybe a)
    objectGetAttributeUnsafe CUInt
    attr o
    obj = do
      sPtr <- (\(GObject ForeignPtr GObject
    arg1) CUInt
    arg2 -> ForeignPtr GObject -> (Ptr GObject -> IO (Ptr ())) -> IO (Ptr ())
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr GObject
    arg1 ((Ptr GObject -> IO (Ptr ())) -> IO (Ptr ()))
    -> (Ptr GObject -> IO (Ptr ())) -> IO (Ptr ())
    forall a b. (a -> b) -> a -> b
    $ \Ptr GObject
    argPtr1 ->Ptr GObject -> CUInt -> IO (Ptr ())
    g_object_get_qdata Ptr GObject
    argPtr1 CUInt
    arg2) (o -> GObject
    forall o. GObjectClass o => o -> GObject
    toGObject o
    obj) CUInt
    attr
      if sPtr==nullPtr then return Nothing else
        liftM Just $! deRefStablePtr (castPtrToStablePtr sPtr)

    -- | Determine if this is an instance of a particular GTK type
    --
    isA :: GObjectClass o => o -> GType -> Bool
    isA :: forall o. GObjectClass o => o -> GType -> Bool
    isA o
    obj GType
    gType =
            Ptr () -> GType -> Bool
    typeInstanceIsA ((ForeignPtr () -> Ptr ()
    forall a. ForeignPtr a -> Ptr a
    unsafeForeignPtrToPtr(ForeignPtr () -> Ptr ()) -> (o -> ForeignPtr ()) -> o -> Ptr ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .ForeignPtr GObject -> ForeignPtr ()
    forall a b. ForeignPtr a -> ForeignPtr b
    castForeignPtr(ForeignPtr GObject -> ForeignPtr ())
    -> (o -> ForeignPtr GObject) -> o -> ForeignPtr ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .GObject -> ForeignPtr GObject
    unGObject(GObject -> ForeignPtr GObject)
    -> (o -> GObject) -> o -> ForeignPtr GObject
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .o -> GObject
    forall o. GObjectClass o => o -> GObject
    toGObject) o
    obj) GType
    gType

    -- at this point we would normally implement the notify signal handler;
    -- I've moved this definition into the Object class of the gtk package
    -- since there's a quite a bit of machinery missing here (generated signal
    -- register functions and the problem of recursive modules)

    foreign import ccall safe "g_object_newv"
      g_object_newv :: (CULong -> (CUInt -> ((Ptr GParameter) -> (IO (Ptr ())))))

    foreign import ccall unsafe "g_object_ref_sink"
      g_object_ref_sink :: ((Ptr ()) -> (IO (Ptr ())))

    foreign import ccall unsafe "g_object_ref"
      g_object_ref :: ((Ptr ()) -> (IO (Ptr ())))

    foreign import ccall unsafe "g_quark_from_string"
      g_quark_from_string :: ((Ptr CChar) -> (IO CUInt))

    foreign import ccall safe "g_object_set_qdata"
      g_object_set_qdata :: ((Ptr GObject) -> (CUInt -> ((Ptr ()) -> (IO ()))))

    foreign import ccall safe "g_object_set_qdata_full"
      g_object_set_qdata_full :: ((Ptr GObject) -> (CUInt -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO ())))))

    foreign import ccall unsafe "g_object_get_qdata"
      g_object_get_qdata :: ((Ptr GObject) -> (CUInt -> (IO (Ptr ()))))