[Gtk2hs-commit] gtk2hs/gtk/glib GError.chspp,NONE,1.1 GObject.chspp,NONE,1.1 GError.chs,1.4,NONE GObject.chs,1.9,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/glib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086/gtk/glib

Added Files:
	GError.chspp GObject.chspp 
Removed Files:
	GError.chs GObject.chs 
Log Message:
New build system.


--- NEW FILE: GError.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) GError API
--
--  Author : Duncan Coutts
--  Created: 2 July 2004
--
--  Copyright (c) 2004 Duncan Coutts
--  parts derived from Structs.hsc Copyright (c) 1999..2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
--  Error Reporting, glib's system for reporting errors.
--
--  'GError's are used by glib to report recoverable runtime errors.
--
--  This module provides functions for checking glib\/gtk functions that report
--  'GError's. It also provides functions for throwing and catching 'GError's as
--  Haskell exceptions.
--

module GError (

  -- * Data types
  --
  GError(..),
  GErrorDomain,
  GErrorCode,
  GErrorMessage,
  
  -- * Catching GError exceptions
  -- | To catch GError exceptions thrown by gtk2hs functions use the catchGError*
  --   or handleGError* functions. They work in a similar way to the standard
  --   'Control.Exception.catch' and 'Control.Exception.handle' functions.
  --
  --   'catchGError'\/'handleGError' catches all GError exceptions, you provide a
  --   handler function that gets given the GError if an exception was thrown. This
  --   is the most general but is probably not what you want most of the time. It
  --   just gives you the raw error code rather than a Haskell enumeration of the
  --   error codes. Most of the time you will only want to catch a specific error
  --   or any error from a specific error domain. To catch just a single specific
  --   error use 'catchGErrorJust'\/'handleGErrorJust'. To catch any error in a 
  --   particular error domain use 'catchGErrorJustDomain'\/'handleGErrorJustDomain'
  --
  catchGError,
  catchGErrorJust,
  catchGErrorJustDomain,
  
  handleGError,
  handleGErrorJust,
  handleGErrorJustDomain,
  
  failOnGError,
  throwGError,

  -- * Checking for GErrors returned by glib\/gtk functions
  -- | * Note, these functions are only useful to implementors
  --
  --   If you are wrapping a new API that reports 'GError's you should probably use
  --   'propagateGError' to convert the GError into an exception. You should also
  --   note in the documentation for the function that it throws GError exceptions
  --   and the Haskell enumeration for the expected glib GError domain(s), so that
  --   users know what exceptions they might want to catch.
  --
  --   If you think it is more appropriate to use an alternate return value (eg
  --   Either\/Maybe) then you should use 'checkGError' or 'checkGErrorWithCont'.

  GErrorClass(..),
  propagateGError,
  checkGError,
  checkGErrorWithCont
  
  ) where

import FFI
import Monad (when)

import Control.Exception
import Data.Dynamic

{# context lib="gtk" prefix ="gtk" #}

-- | A GError consists of a domain, code and a human readable message.
data GError = GError !GErrorDomain !GErrorCode !GErrorMessage
# if __GLASGOW_HASKELL__>=600
  deriving Typeable
#else
{-# NOINLINE gerrorTypeRep #-}
gerrorTypeRep :: TypeRep
gerrorTypeRep = mkAppTy (mkTyCon "Graphics.UI.Gtk.GError.GError") []
instance Typeable GError where
  typeOf _ = gerrorTypeRep
#endif

type GQuark = {#type GQuark #}

-- | A code used to identify the \'namespace\' of the error. Within each error
--   domain all the error codes are defined in an enumeration. Each gtk\/gnome
--   module that uses GErrors has its own error domain. The rationale behind
--   using error domains is so that each module can organise its own error codes
--   without having to coordinate on a global error code list.
type GErrorDomain  = GQuark

-- | A code to identify a specific error within a given 'GErrorDomain'. Most of
--   time you will not need to deal with this raw code since there is an
--   enumeration type for each error domain. Of course which enumeraton to use
--   depends on the error domain, but if you use 'catchGErrorJustDomain' or
--   'handleGErrorJustDomain', this is worked out for you automatically.
type GErrorCode = Int

-- | A human readable error message.
type GErrorMessage = String
                                                                                           
instance Storable GError where
  sizeOf _ = {#sizeof GError #}
  alignment _ = alignment (undefined:: GQuark)
  peek ptr = do
    (domain  :: GQuark)         <- {#get GError->domain  #} ptr
    (code    :: {#type gint #}) <- {#get GError->code    #} ptr
    (msgPtr  :: CString)        <- {#get GError->message #} ptr
    msg <- peekUTFString msgPtr
    return $ GError (fromIntegral domain) (fromIntegral code) msg
  poke _ = error "GError::poke: not implemented"

-- | Each error domain's error enumeration type should be an instance of this
--   class. This class helps to hide the raw error and domain codes from the
--   user. This interface should be implemented by calling the approrpiate
--   @{error_domain}_error_quark@. It is safe to use 'unsafePerformIO' for this.
--
-- Example for 'PixbufError':
--
-- > instance GErrorClass PixbufError where
-- >   gerrorDomain _ = unsafePerformIO {#call unsafe pixbuf_error_quark#}
--
class Enum err => GErrorClass err where
  gerrorDomain :: err -> GErrorDomain -- ^ This must not use the value of its parameter
                                      --   so that it is safe to pass 'undefined'.

-- | Glib functions which report 'GError's take as a parameter a @GError **error@.
--   Use this function to supply such a parameter. It checks if an error was
--   reported and if so throws it as a Haskell exception.
--   
-- Example of use:
--
-- > propagateGError $ \gerrorPtr ->
-- > {# call g_some_function_that_might_return_an_error #} a b gerrorPtr
--
propagateGError :: (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError action = checkGError action throwGError

-- | Like 'propagateGError' but instead of throwing the GError as an exception
--   handles the error immediately using the supplied error handler.
--
-- Example of use:
--
-- > checkGError
-- >   (\gerrorPtr -> {# call g_some_function_that_might_return_an_error #} a b gerrorPtr)
-- >   (\(GError domain code msg) -> ...)
--
checkGError :: (Ptr (Ptr ()) -> IO a) -> (GError -> IO a) -> IO a
checkGError action handler =
  alloca $ \(errPtrPtr  :: Ptr (Ptr GError)) -> do
  poke errPtrPtr nullPtr
  result <- action (castPtr errPtrPtr)
  errPtr <- peek errPtrPtr
  if errPtr == nullPtr
    then return result
    else do gerror <- peek errPtr
            {# call unsafe g_error_free #} (castPtr errPtr)
            handler gerror

-- | Like 'checkGError' but with an extra continuation applied to the result.
--   This can be useful when something needs to be done after making the call
--   to the function that can raise an error but is should only be done if there
--   was no error.
--
-- Example of use:
--
-- > checkGErrorWithCont (\gerrorPtr ->
-- >   {# call g_some_function_that_might_return_an_error #} a b gerrorPtr)
-- > (\(GError domain code msg) -> ...) -- what to do in case of error
-- > (\result -> ...)                   -- what to do after if no error
--
checkGErrorWithCont :: (Ptr (Ptr ()) -> IO b) -> (GError -> IO a) -> (b -> IO a) -> IO a
checkGErrorWithCont action handler cont =
  alloca $ \(errPtrPtr  :: Ptr (Ptr GError)) -> do
  poke errPtrPtr nullPtr
  result <- action (castPtr errPtrPtr)
  errPtr <- peek errPtrPtr
  if errPtr == nullPtr
    then cont result
    else do gerror <- peek errPtr
            {# call unsafe g_error_free #} (castPtr errPtr)
            handler gerror

-- | Use this if you need to explicitly throw a GError or re-throw an existing
--   GError that you do not wish to handle.
throwGError :: GError -> IO a
throwGError gerror = evaluate (throwDyn gerror)

-- | This will catch any GError exception. The handler function will receive the
--   raw GError. This is probably only useful when you want to take some action
--   that does not depend on which GError exception has occured, otherwise it
--   would be better to use either 'catchGErrorJust' or 'catchGErrorJustDomain'.
--   For example:
--
-- > catchGError
-- >   (do ...
-- >       ...)
-- >   (\(GError dom code msg) -> fail msg)
--   
catchGError :: IO a            -- ^ The computation to run
            -> (GError -> IO a) -- ^ Handler to invoke if an exception is raised
            -> IO a
catchGError action handler = catchDyn action handler

-- | This will catch just a specific GError exception. If you need to catch a
--   range of related errors, 'catchGErrorJustDomain' is probably more
--   appropriate. Example:
--
-- > do image <- catchGErrorJust PixbufErrorCorruptImage
-- >               loadImage
-- >               (\errorMessage -> do log errorMessage
-- >                                    return mssingImagePlaceholder)
--
catchGErrorJust :: GErrorClass err => err  -- ^ The error to catch
                -> IO a                    -- ^ The computation to run
                -> (GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised
                -> IO a
catchGErrorJust code action handler = catchGError action handler'
  where handler' gerror@(GError domain code' msg)
          | fromIntegral domain == gerrorDomain code
           && code' == fromEnum code   = handler msg
          | otherwise                  = throwGError gerror

-- | Catch all GErrors from a particular error domain. The handler function
--   should just deal with one error enumeration type. If you need to catch
--   errors from more than one error domain, use this function twice with an
--   appropriate handler functions for each.
--
-- > catchGErrorJustDomain
-- >   loadImage
-- >   (\err message -> case err of
-- >       PixbufErrorCorruptImage -> ...
-- >       PixbufErrorInsufficientMemory -> ...
-- >       PixbufErrorUnknownType -> ...
-- >       _ -> ...)
--
catchGErrorJustDomain :: GErrorClass err => IO a        -- ^ The computation to run
                      -> (err -> GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised
                      -> IO a
catchGErrorJustDomain action (handler :: err -> GErrorMessage -> IO a) =
    catchGError action handler'
  where handler' gerror@(GError domain code msg)
          | fromIntegral domain == gerrorDomain (undefined::err) = handler (toEnum code) msg
          | otherwise                                            = throwGError gerror

-- | A verson of 'catchGError' with the arguments swapped around.
--
-- > handleGError (\(GError dom code msg) -> ...) $
-- >   ...
--   
handleGError :: (GError -> IO a) -> IO a -> IO a
handleGError = flip catchGError

-- | A verson of 'handleGErrorJust' with the arguments swapped around.
handleGErrorJust :: GErrorClass err => err -> (GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJust code = flip (catchGErrorJust code)

-- | A verson of 'handleGErrorJustDomain' with the arguments swapped around.
handleGErrorJustDomain :: GErrorClass err => (err -> GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJustDomain = flip catchGErrorJustDomain

-- | Catch all GError exceptions and convert them into a general failure.
failOnGError :: IO a -> IO a
failOnGError action = catchGError action (\(GError dom code msg) -> fail msg)

--- NEW FILE: GObject.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget GObject
--
--  Author : Axel Simon
--          
--  Created: 9 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:21 $
--
--  Copyright (c) 2001 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- |
--
-- Implements the base GObject class to satisfy the type checker.
--
module GObject(
  objectNew,
  objectRef,
  objectUnref,
  makeNewGObject,
  GWeakNotify,
  mkDestructor,
  objectWeakref,
  objectWeakunref
  ) where


import Monad (liftM)
import FFI
import LocalData (newIORef, readIORef, writeIORef)
import Hierarchy (GObjectClass, GObject(..),
                  mkGObject, toGObject, unGObject)
import GValue (GValue)
import GType  (GType)
import GParameter

{# context lib="glib" prefix="g" #}

{# pointer *GParameter as GParm -> GParameter #}

-- 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 ->
  {# call g_object_newv #} objType
  (fromIntegral $ length parameters) paramArrayPtr

-- increase the reference counter of an object
--
objectRef :: GObjectClass obj => Ptr obj -> IO ()
objectRef obj = do
  {#call unsafe object_ref#} (castPtr obj)
  return ()

-- decrease the reference counter of an object
--
#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&g_object_unref"
  object_unref' :: FinalizerPtr a

objectUnref :: Ptr a -> FinalizerPtr a
objectUnref _ = object_unref'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "g_object_unref"
  objectUnref :: Ptr a -> IO ()

#else

foreign import ccall "g_object_unref" unsafe
  objectUnref :: Ptr a -> IO ()

#endif


-- This is a convenience function to generate an object that does not
-- derive from Object. It adds objectUnref as finalizer.
--
-- * The constr argument is the contructor of the specific object.
--
makeNewGObject :: GObjectClass obj => 
  (ForeignPtr obj -> obj) -> IO (Ptr obj) -> IO obj
makeNewGObject constr generator = do
  objPtr <- generator
  objectRef objPtr
  obj <- newForeignPtr objPtr (objectUnref objPtr)
  return $ constr obj

{#pointer GWeakNotify#}

foreign import ccall "wrapper" mkDestructor :: IO () -> IO GWeakNotify

-- | attach a callback that will be called after the
-- destroy hooks have been called
--
objectWeakref :: GObjectClass o => o -> IO () -> IO GWeakNotify
objectWeakref obj uFun = do
  funPtrContainer <- newIORef nullFunPtr
  uFunPtr <- mkDestructor $ do
    uFun
    funPtr <- readIORef funPtrContainer
    freeHaskellFunPtr funPtr
  writeIORef funPtrContainer uFunPtr
  withForeignPtr ((castForeignPtr.unGObject.toGObject) obj) $ \objPtr ->
    {#call unsafe object_weak_ref#} objPtr uFunPtr nullPtr
  return uFunPtr

-- | detach a weak destroy callback function
--
objectWeakunref :: GObjectClass o => o -> GWeakNotify -> IO ()
objectWeakunref obj fun = 
  withForeignPtr ((castForeignPtr.unGObject.toGObject) obj) $ \objPtr ->
    {#call unsafe object_weak_unref#} objPtr fun nullPtr
  


  

--- GError.chs DELETED ---

--- GObject.chs DELETED ---