    {-# 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 System.Glib.FFI
    import System.Glib.UTFString
    import System.Glib.Types
    {-# LINE 68 "./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 77 "./System/Glib/GObject.chs" #-}

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

    -- | Construct a new object (should rairly be used directly)
    --
    objectNew :: GType -> [(String, GValue)] -> IO (Ptr GObject)
    objectNew objType parameters =
      liftM castPtr $ --caller must makeNewGObject as we don't know
                      --if it this a GObject or a GtkObject
      withArray (map GParameter parameters) $ \paramArrayPtr ->
      g_object_newv objType
      (fromIntegral $ length parameters) paramArrayPtr

    -- | Reference and sink an object.
    objectRefSink :: GObjectClass obj => Ptr obj -> IO ()
    objectRefSink obj = do
      g_object_ref_sink (castPtr obj)
      return ()

    -- | Increase the reference counter of an object
    --
    objectRef :: GObjectClass obj => Ptr obj -> IO ()
    objectRef obj = do
      g_object_ref (castPtr obj)
      return ()

    -- | The type constant to check if an instance is of 'GObject' type.
    gTypeGObject :: GType
    gTypeGObject = 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 contructor 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 (constr, objectUnref) generator = do
      objPtr <- generator
      when (objPtr == nullPtr) (fail "makeNewGObject: object is NULL")
      objectRef objPtr
      obj <- newForeignPtr objPtr objectUnref
      return $! constr obj

    type DestroyNotify = FunPtr (((Ptr ()) -> (IO ())))
    {-# LINE 129 "./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 (constr, objectUnref) generator = do
      objPtr <- generator

      -- change the exisiting 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 (constr, objectUnref) generator = do
      objPtr <- 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 168 "./System/Glib/GObject.chs" #-}

    -- | A counter for generating unique names.
    {-# NOINLINE uniqueCnt #-}
    uniqueCnt :: MVar Int
    uniqueCnt = unsafePerformIO $ newMVar 0

    -- | Create a unique id based on the given string.
    quarkFromString :: String -> IO Quark
    quarkFromString name = withUTFString name g_quark_from_string
    {-# LINE 177 "./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 = do
      cnt <- modifyMVar uniqueCnt (\cnt -> return (cnt+1, cnt))
      let propName = "Gtk2HsAttr"++show cnt
      attr <- quarkFromString 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 attr obj Nothing = do
      (\(GObject arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->g_object_set_qdata argPtr1 arg2 arg3) (toGObject obj) attr nullPtr
    objectSetAttribute attr obj (Just val) = do
      sPtr <- newStablePtr val
      (\(GObject arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->g_object_set_qdata_full argPtr1 arg2 arg3 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 funciton.
    --
    objectGetAttributeUnsafe :: GObjectClass o => Quark -> o -> IO (Maybe a)
    objectGetAttributeUnsafe attr obj = do
      sPtr <- (\(GObject arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->g_object_get_qdata argPtr1 arg2) (toGObject obj) 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 obj gType =
     typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr.unGObject.toGObject) obj) 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 :: (CUInt -> (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 ()))))