1{-# LANGUAGE CPP #-} 2-- -*-haskell-*- 3-- GIMP Toolkit (GTK) GObject 4-- 5-- Author : Axel Simon 6-- 7-- Created: 9 April 2001 8-- 9-- Copyright (C) 2001 Axel Simon 10-- 11-- This library is free software; you can redistribute it and/or 12-- modify it under the terms of the GNU Lesser General Public 13-- License as published by the Free Software Foundation; either 14-- version 2.1 of the License, or (at your option) any later version. 15-- 16-- This library is distributed in the hope that it will be useful, 17-- but WITHOUT ANY WARRANTY; without even the implied warranty of 18-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19-- Lesser General Public License for more details. 20-- 21-- | 22-- Maintainer : gtk2hs-users@lists.sourceforge.net 23-- Stability : provisional 24-- Portability : portable (depends on GHC) 25-- 26-- The base object type for all glib objects 27-- 28module System.Glib.GObject ( 29 -- * Types 30 module System.Glib.Types, 31 32 -- * Low level binding functions 33 34 -- | All these functions are internal and are only interesting to people 35 -- writing bindings to GObject-style C libraries. 36 objectNew, 37 objectRef, 38#if GLIB_CHECK_VERSION(2,10,0) 39 objectRefSink, 40#endif 41 makeNewGObject, 42 constructNewGObject, 43 wrapNewGObject, 44 45 -- ** GType queries 46 gTypeGObject, 47 isA, 48 49 -- ** Callback support 50 DestroyNotify, 51 destroyFunPtr, 52 destroyStablePtr, 53 54 -- ** User-Defined Attributes 55 Quark, 56 quarkFromString, 57 objectCreateAttribute, 58 objectSetAttribute, 59 objectGetAttributeUnsafe 60 ) where 61 62import Control.Monad (liftM, when) 63import Data.IORef (newIORef, readIORef, writeIORef) 64import qualified Data.Text as T (pack) 65 66import System.Glib.FFI 67import System.Glib.UTFString 68{#import System.Glib.Types#} 69import System.Glib.GValue (GValue) 70import System.Glib.GType (GType, typeInstanceIsA) 71import System.Glib.GTypeConstants ( object ) 72import System.Glib.GParameter 73import System.Glib.Attributes (newNamedAttr, Attr) 74import Foreign.StablePtr 75import Control.Concurrent.MVar ( MVar, newMVar, modifyMVar ) 76 77{# context lib="glib" prefix="g" #} 78 79{# pointer *GParameter as GParm -> GParameter #} 80 81-- | Construct a new object (should rairly be used directly) 82-- 83objectNew :: GType -> [(String, GValue)] -> IO (Ptr GObject) 84objectNew objType parameters = 85 liftM castPtr $ --caller must makeNewGObject as we don't know 86 --if it this a GObject or a GtkObject 87 withArray (map GParameter parameters) $ \paramArrayPtr -> 88 {# call g_object_newv #} objType 89 (fromIntegral $ length parameters) paramArrayPtr 90 91#if GLIB_CHECK_VERSION(2,10,0) 92-- | Reference and sink an object. 93objectRefSink :: GObjectClass obj => Ptr obj -> IO () 94objectRefSink obj = do 95 {#call unsafe object_ref_sink#} (castPtr obj) 96 return () 97#endif 98 99-- | Increase the reference counter of an object 100-- 101objectRef :: GObjectClass obj => Ptr obj -> IO () 102objectRef obj = do 103 {#call unsafe object_ref#} (castPtr obj) 104 return () 105 106-- | The type constant to check if an instance is of 'GObject' type. 107gTypeGObject :: GType 108gTypeGObject = object 109 110-- | This function wraps any object that does not derive from Object. 111-- It should be used whenever a function returns a pointer to an existing 112-- 'GObject' (as opposed to a function that constructs a new object). 113-- 114-- * The first argument is the contructor of the specific object. 115-- 116makeNewGObject :: 117 GObjectClass obj 118 => (ForeignPtr obj -> obj, FinalizerPtr obj) 119 -- ^ constructor for the Haskell object and finalizer C function 120 -> IO (Ptr obj) -- ^ action which yields a pointer to the C object 121 -> IO obj 122makeNewGObject (constr, objectUnref) generator = do 123 objPtr <- generator 124 when (objPtr == nullPtr) (fail "makeNewGObject: object is NULL") 125 objectRef objPtr 126 obj <- newForeignPtr objPtr objectUnref 127 return $! constr obj 128 129{#pointer GDestroyNotify as DestroyNotify#} 130 131-- | This function wraps any newly created objects that derives from 132-- GInitiallyUnowned also known as objects with 133-- \"floating-references\". The object will be refSink (for glib 134-- versions >= 2.10). On non-floating objects, this function behaves 135-- exactly the same as "makeNewGObject". 136-- 137constructNewGObject :: GObjectClass obj => 138 (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj 139constructNewGObject (constr, objectUnref) generator = do 140 objPtr <- generator 141#if GLIB_CHECK_VERSION(2,10,0) 142 -- change the exisiting floating reference into a proper reference; 143 -- the name is confusing, what the function does is ref,sink,unref 144 objectRefSink objPtr 145#endif 146 obj <- newForeignPtr objPtr objectUnref 147 return $! constr obj 148 149-- | This function wraps any newly created object that does not derived 150-- from GInitiallyUnowned (that is a GObject with no floating 151-- reference). Since newly created 'GObject's have a reference count of 152-- one, they don't need ref'ing. 153-- 154wrapNewGObject :: GObjectClass obj => 155 (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj 156wrapNewGObject (constr, objectUnref) generator = do 157 objPtr <- generator 158 when (objPtr == nullPtr) (fail "wrapNewGObject: object is NULL") 159 obj <- newForeignPtr objPtr objectUnref 160 return $! constr obj 161 162-- | Many methods in classes derived from GObject take a callback function and 163-- a destructor function which is called to free that callback function when 164-- it is no longer required. This constants is an address of a functions in 165-- C land that will free a function pointer. 166foreign import ccall unsafe "&freeHaskellFunctionPtr" destroyFunPtr :: DestroyNotify 167 168type Quark = {#type GQuark#} 169 170-- | A counter for generating unique names. 171{-# NOINLINE uniqueCnt #-} 172uniqueCnt :: MVar Int 173uniqueCnt = unsafePerformIO $ newMVar 0 174 175-- | Create a unique id based on the given string. 176quarkFromString :: GlibString string => string -> IO Quark 177quarkFromString name = withUTFString name {#call unsafe quark_from_string#} 178 179-- | Add an attribute to this object. 180-- 181-- * The function returns a new attribute that can be set or retrieved from 182-- any 'GObject'. The attribute is wrapped in a 'Maybe' type to reflect 183-- the circumstance when the attribute is not set or if it should be unset. 184-- 185objectCreateAttribute :: GObjectClass o => IO (Attr o (Maybe a)) 186objectCreateAttribute = do 187 cnt <- modifyMVar uniqueCnt (\cnt -> return (cnt+1, cnt)) 188 let propName = "Gtk2HsAttr"++show cnt 189 attr <- quarkFromString $ T.pack propName 190 return (newNamedAttr propName (objectGetAttributeUnsafe attr) 191 (objectSetAttribute attr)) 192 193-- | The address of a function freeing a 'StablePtr'. See 'destroyFunPtr'. 194foreign import ccall unsafe "&hs_free_stable_ptr" destroyStablePtr :: DestroyNotify 195 196-- | Set the value of an association. 197-- 198objectSetAttribute :: GObjectClass o => Quark -> o -> Maybe a -> IO () 199objectSetAttribute attr obj Nothing = do 200 {#call object_set_qdata#} (toGObject obj) attr nullPtr 201objectSetAttribute attr obj (Just val) = do 202 sPtr <- newStablePtr val 203 {#call object_set_qdata_full#} (toGObject obj) attr (castStablePtrToPtr sPtr) 204 destroyStablePtr 205 206-- | Get the value of an association. 207-- 208-- * Note that this function may crash the Haskell run-time since the 209-- returned type can be forced to be anything. See 'objectCreateAttribute' 210-- for a safe wrapper around this funciton. 211-- 212objectGetAttributeUnsafe :: GObjectClass o => Quark -> o -> IO (Maybe a) 213objectGetAttributeUnsafe attr obj = do 214 sPtr <- {#call unsafe object_get_qdata#} (toGObject obj) attr 215 if sPtr==nullPtr then return Nothing else 216 liftM Just $! deRefStablePtr (castPtrToStablePtr sPtr) 217 218-- | Determine if this is an instance of a particular GTK type 219-- 220isA :: GObjectClass o => o -> GType -> Bool 221isA obj gType = 222 typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr.unGObject.toGObject) obj) gType 223 224-- at this point we would normally implement the notify signal handler; 225-- I've moved this definition into the Object class of the gtk package 226-- since there's a quite a bit of machinery missing here (generated signal 227-- register functions and the problem of recursive modules) 228