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