Fix types, remove key binding signals.

Fix types, remove key binding signals.

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Dialog
--
--  Author : Axel Simon, Andy Stewart
--
--  Created: 23 May 2001
--
--  Copyright (C) 1999-2005 Axel Simon
--  Copyright (C) 2009 Andy Stewart
--
--  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)
--
-- Create popup windows
--
-- NOTE:
--     Now FFI haven't support variadic function `gtk_dialog_set_alternative_button_order`
--
module Graphics.UI.Gtk.Windows.Dialog (
-- * Detail
--
-- | Dialog boxes are a convenient way to prompt the user for a small amount
-- of input, e.g. to display a message, ask a question, or anything else that
-- does not require extensive effort on the user's part.
--
-- Gtk+ treats a dialog as a window split vertically. The top section is a
-- 'VBox', and is where widgets such as a 'Label' or a 'Entry' should be
-- packed. The bottom area is known as the action_area. This is generally used
-- for packing buttons into the dialog which may perform functions such as
-- cancel, ok, or apply. The two areas are separated by a 'HSeparator'.
--
-- 'Dialog' boxes are created with a call to 'dialogNew' or
-- 'dialogNewWithButtons'. 'dialogNewWithButtons' is recommended; it allows you
-- to set the dialog title, some convenient flags, and add simple buttons.
--
-- If \'dialog\' is a newly created dialog, the two primary areas of the
-- window can be accessed using 'dialogGetUpper' and
-- 'dialogGetActionArea'.
--
-- A \'modal\' dialog (that is, one which freezes the rest of the
-- application from user input), can be created by calling 'windowSetModal' on
-- the dialog. When using 'dialogNewWithButtons' you can also
-- pass the 'DialogModal' flag to make a dialog modal.
--
-- If you add buttons to 'Dialog' using 'dialogNewWithButtons',
-- 'dialogAddButton', 'dialogAddButtons', or 'dialogAddActionWidget', clicking
-- the button will emit a signal called \"response\" with a response ID that
-- you specified. Gtk+ will never assign a meaning to positive response IDs;
-- these are entirely user-defined. But for convenience, you can use the
-- response IDs in the 'ResponseType' enumeration (these all have values less
-- than zero). If a dialog receives a delete event, the \"response\" signal
-- will be emitted with a response ID of 'ResponseNone'.
--
-- If you want to block waiting for a dialog to return before returning
-- control flow to your code, you can call 'dialogRun'. This function enters a
-- recursive main loop and waits for the user to respond to the dialog,
-- returning the response ID corresponding to the button the user clicked.
--
-- For a simple message box, you probably want to use
-- 'Graphics.UI.Gtk.Windows.MessageDialog.MessageDialog' which provides
-- convenience functions
-- for creating standard dialogs containing simple messages to inform
-- or ask the user.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----'Container'
-- |                     +----'Bin'
-- |                           +----'Window'
-- |                                 +----Dialog
-- |                                       +----'AboutDialog'
-- |                                       +----'ColorSelectionDialog'
-- |                                       +----'FileChooserDialog'
-- |                                       +----'FileSelection'
-- |                                       +----'FontSelectionDialog'
-- |                                       +----'InputDialog'
-- |                                       +----'MessageDialog'
-- @

-- * Types
  Dialog,
  DialogClass,
  castToDialog,
  toDialog,

-- * Constructors
  dialogNew,

-- * Methods
  dialogGetUpper,
  dialogGetActionArea,
  dialogRun,
  dialogResponse,
  ResponseId(..),
  dialogAddButton,
  dialogAddActionWidget,
  dialogGetHasSeparator,
  dialogSetDefaultResponse,
  dialogSetHasSeparator,
  dialogSetResponseSensitive,
  dialogGetResponseForWidget,
  dialogAlternativeDialogButtonOrder,
  dialogSetAlternativeButtonOrderFromArray,

-- * Attributes
  dialogHasSeparator,
  dialogActionAreaBorder,
  dialogButtonSpacing,
  dialogContentAreaBorder,
  dialogContentAreaSpacing,

-- * Signals
  response,

-- * Deprecated
#ifndef DISABLE_DEPRECATED
  onResponse,
  afterResponse,
#endif
  ) where

import Control.Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs	(dialogGetUpper, dialogGetActionArea,
					ResponseId(..), fromResponse, toResponse)

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

--------------------
-- Constructors

-- | Creates a new dialog box. Widgets should not be packed into this 'Window'
-- directly, but into the \"upper\" and \"action area\", which are obtained
-- using 'dialogGetUpper' and 'dialogGetActionArea'.
--
dialogNew :: IO Dialog
dialogNew =
  makeNewObject mkDialog $
  liftM (castPtr :: Ptr Widget -> Ptr Dialog) $
  {# call unsafe dialog_new #}

--------------------
-- Methods

-- | Blocks in a recursive main loop until the dialog either emits the
-- response signal, or is destroyed. If the dialog is destroyed during the call
-- to 'dialogRun', it returns 'ResponseNone'. Otherwise, it returns the
-- response ID from the \"response\" signal emission. Before entering the
-- recursive main loop, 'dialogRun' calls 'widgetShow' on the dialog for you.
-- Note that you still need to show any children of the dialog yourself.
--
-- During 'dialogRun', the default behavior of \"delete_event\" is disabled;
-- if the dialog receives \"delete_event\", it will not be destroyed as windows
-- usually are, and 'dialogRun' will return 'ResponseDeleteEvent'. Also, during
-- 'dialogRun' the dialog will be modal. You can force 'dialogRun' to return at
-- any time by calling 'dialogResponse' to emit the \"response\" signal.
-- Destroying the dialog during 'dialogRun' is a very bad idea, because your
-- post-run code won't know whether the dialog was destroyed or not.
-- Hence, you should not call 'Graphics.UI.Gtk.Abstract.widgetDestroy'
-- before 'dialogRun' has returned.
--
-- After 'dialogRun' returns, you are responsible for hiding or destroying
-- the dialog if you wish to do so.
--
-- Note that even though the recursive main loop gives the effect of a modal
-- dialog (it prevents the user from interacting with other windows while the
-- dialog is run), callbacks such as timeouts, IO channel watches, DND drops,
-- etc, /will/ be triggered during a 'dialogRun' call.
--
dialogRun :: DialogClass self => self
 -> IO ResponseId
dialogRun self =
  liftM toResponse $
  {# call dialog_run #}
    (toDialog self)

-- | Emits the \"response\" signal with the given response ID. Used to
-- indicate that the user has responded to the dialog in some way; typically
-- either you or 'dialogRun' will be monitoring the \"response\" signal and
-- take appropriate action.
--
-- This function can be used to add a custom widget to the action area that
-- should close the dialog when activated or to close the dialog otherwise.
--
dialogResponse :: DialogClass self => self
 -> ResponseId
 -> IO ()
dialogResponse self responseId =
  {# call dialog_response #}
    (toDialog self)
    (fromResponse responseId)

-- | Adds a button with the given text (or a stock button, if @buttonText@ is
-- a stock ID) and sets things up so that clicking the button will emit the
-- \"response\" signal with the given @responseId@. The button is appended to
-- the end of the dialog's action area. The button widget is returned, but
-- usually you don't need it.
--
dialogAddButton :: DialogClass self => self
 -> String     -- ^ @buttonText@ - text of button, or stock ID
 -> ResponseId -- ^ @responseId@ - response ID for the button
 -> IO Button  -- ^ returns the button widget that was added
dialogAddButton self buttonText responseId =
  makeNewObject mkButton $ liftM castPtr $
  withUTFString buttonText $ \buttonTextPtr ->
  {# call dialog_add_button #}
    (toDialog self)
    buttonTextPtr
    (fromResponse responseId)

-- | Adds an activatable widget to the action area of a 'Dialog', connecting a
-- signal handler that will emit the \"response\" signal on the dialog when the
-- widget is activated. The widget is appended to the end of the dialog's
-- action area. If you want to add a non-activatable widget, simply pack it
-- into the action area.
--
dialogAddActionWidget :: (DialogClass self, WidgetClass child) => self
 -> child      -- ^ @child@ - an activatable widget
 -> ResponseId -- ^ @responseId@ - response ID for @child@
 -> IO ()
dialogAddActionWidget self child responseId =
  {# call dialog_add_action_widget #}
    (toDialog self)
    (toWidget child)
    (fromResponse responseId)

-- | Query if the dialog has a visible horizontal separator.
--
dialogGetHasSeparator :: DialogClass self => self -> IO Bool
dialogGetHasSeparator self =
  liftM toBool $
  {# call unsafe dialog_get_has_separator #}
    (toDialog self)

-- | Sets the last widget in the dialog's action area with the given
-- 'ResponseId' as the default widget for the dialog. Pressing \"Enter\"
-- normally activates the default widget.
--
-- * The default response is reset once it is triggered. Hence, if you
--   hide the dialog (rather than closing it) and re-display it later,
--   you need to call this function again.
--
dialogSetDefaultResponse :: DialogClass self => self
 -> ResponseId
 -> IO ()
dialogSetDefaultResponse self responseId =
  {# call dialog_set_default_response #}
    (toDialog self)
    (fromResponse responseId)

-- | Sets whether the dialog has a separator above the buttons. @True@ by
-- default.
--
dialogSetHasSeparator :: DialogClass self => self -> Bool -> IO ()
dialogSetHasSeparator self setting =
  {# call dialog_set_has_separator #}
    (toDialog self)
    (fromBool setting)

-- | Calls @'widgetSetSensitive' widget setting@ for each widget in the
-- dialog's action area with the given @responseId@. A convenient way to
-- sensitize\/desensitize dialog buttons.
--
dialogSetResponseSensitive :: DialogClass self => self
 -> ResponseId -- ^ @responseId@ - a response ID
 -> Bool       -- ^ @setting@ - @True@ for sensitive
 -> IO ()
dialogSetResponseSensitive self responseId setting =
  {# call dialog_set_response_sensitive #}
    (toDialog self)
    (fromResponse responseId)
    (fromBool setting)

-- | Gets the response id of a widget in the action area of a dialog.
dialogGetResponseForWidget :: (DialogClass self, WidgetClass widget) => self
 -> widget  -- ^ @widget@ - a widget in the action area of dialog
 -> IO ResponseId  -- ^ return the response id of widget, or 'ResponseNone' if widget doesn't have a response id set.
dialogGetResponseForWidget self widget = liftM toResponse $
  {# call dialog_get_response_for_widget #}
    (toDialog self)
    (toWidget widget)

-- | Returns @True@ if dialogs are expected to use an alternative button order on the screen screen.
-- See 'dialogSetAlternativeButtonOrder' for more details about alternative button order.
--
-- If you need to use this function, you should probably connect to the 'alternativeButtonOrder' signal on the GtkSettings object associated to  screen, in order to be notified if the button order setting changes.
--
-- * Available since Gtk+ version 2.6
--
dialogAlternativeDialogButtonOrder ::
   Maybe Screen  -- ^ @screen@ - a 'Screen', or @Nothing@ to use the default screen
 -> IO Bool   -- ^ returns whether the alternative button order should be used
dialogAlternativeDialogButtonOrder (Just screen) = liftM toBool $
  {# call alternative_dialog_button_order #} screen
dialogAlternativeDialogButtonOrder Nothing = liftM toBool $
  {# call alternative_dialog_button_order #} (Screen nullForeignPtr)

-- | Sets an alternative button order.
--
-- If the 'alternativeButtonOrder' setting is set to @True@, the dialog
-- buttons are reordered according to the order of the response ids in
-- @newOrder@.
--
-- See 'dialogSetAlternativeButtonOrder' for more information.
--
-- This function is for use by language bindings.
--
-- * Available since Gtk+ version 2.6
--
dialogSetAlternativeButtonOrderFromArray :: DialogClass self => self
 -> [ResponseId]  -- ^ @newOrder@ - an array of response ids of dialog's buttons
 -> IO ()
dialogSetAlternativeButtonOrderFromArray self newOrder =
  withArray (map fromResponse newOrder) $ \newOrderPtr ->
  {# call dialog_set_alternative_button_order_from_array #}
    (toDialog self)
    (fromIntegral (length newOrder))
    newOrderPtr

--------------------
-- Attributes

-- | The dialog has a separator bar above its buttons.
--
-- Default value: @True@
--
dialogHasSeparator :: DialogClass self => Attr self Bool
dialogHasSeparator = newAttr
  dialogGetHasSeparator
  dialogSetHasSeparator

-- | Width of border around the button area at the bottom of the dialog.
--
-- Allowed values: >= 0
--
-- Default value: 5
--
dialogActionAreaBorder :: DialogClass self => ReadAttr self Int
dialogActionAreaBorder = readAttrFromIntProperty "action-area-border"

-- | Spacing between buttons.
--
-- Allowed values: >= 0
--
-- Default value: 6
--
dialogButtonSpacing :: DialogClass self => ReadAttr self Int
dialogButtonSpacing = readAttrFromIntProperty "button-spacing"

-- | Width of border around the main dialog area.
--
-- Allowed values: >= 0
--
-- Default value: 2
--
dialogContentAreaBorder :: DialogClass self => ReadAttr self Int
dialogContentAreaBorder = readAttrFromIntProperty "content-area-border"

-- | The default spacing used between elements of the content area of the dialog,
-- as returned by 'dialogSetContentArea', unless 'boxSetSpacing' was called on that widget directly.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
-- * Available since Gtk+ version 2.16
--
dialogContentAreaSpacing :: DialogClass self => ReadAttr self Int
dialogContentAreaSpacing = readAttrFromIntProperty "content-area-spacing"

--------------------
-- Signals

-- | Emitted when an action widget is clicked, the dialog receives a delete
-- event, or the application programmer calls 'dialogResponse'. On a delete
-- event, the response ID is 'ResponseNone'. Otherwise, it depends on which
-- action widget was clicked.
--
response :: DialogClass self => Signal self (ResponseId -> IO ())
response = Signal (\after obj fun ->
                   connect_INT__NONE "response" after obj (\i -> fun (toResponse i)))

-- * Deprecated
#ifndef DISABLE_DEPRECATED
-- | Emitted when an action widget is clicked, the dialog receives a delete
-- event, or the application programmer calls 'dialogResponse'. On a delete
-- event, the response ID is 'ResponseNone'. Otherwise, it depends on which
-- action widget was clicked.
--
onResponse, afterResponse :: DialogClass self => self
 -> (ResponseId -> IO ())
 -> IO (ConnectId self)
onResponse dia act = connect_INT__NONE "response" False dia (act . toResponse)
afterResponse dia act = connect_INT__NONE "response" True dia (act . toResponse)
#endif

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Dialog
--
--  Author : Axel Simon, Andy Stewart
--
--  Created: 23 May 2001
--
--  Copyright (C) 1999-2005 Axel Simon
--  Copyright (C) 2009 Andy Stewart
--
--  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)
--
-- Create popup windows
--
-- NOTE:
--     Now FFI haven't support variadic function `gtk_dialog_set_alternative_button_order`
--
module Graphics.UI.Gtk.Windows.Dialog (
-- * Detail
--
-- | Dialog boxes are a convenient way to prompt the user for a small amount
-- of input, e.g. to display a message, ask a question, or anything else that
-- does not require extensive effort on the user's part.
--
-- Gtk+ treats a dialog as a window split vertically. The top section is a
-- 'VBox', and is where widgets such as a 'Label' or a 'Entry' should be
-- packed. The bottom area is known as the action_area. This is generally used
-- for packing buttons into the dialog which may perform functions such as
-- cancel, ok, or apply. The two areas are separated by a 'HSeparator'.
--
-- 'Dialog' boxes are created with a call to 'dialogNew' or
-- 'dialogNewWithButtons'. 'dialogNewWithButtons' is recommended; it allows you
-- to set the dialog title, some convenient flags, and add simple buttons.
--
-- If \'dialog\' is a newly created dialog, the two primary areas of the
-- window can be accessed using 'dialogGetUpper' and
-- 'dialogGetActionArea'.
--
-- A \'modal\' dialog (that is, one which freezes the rest of the
-- application from user input), can be created by calling 'windowSetModal' on
-- the dialog. When using 'dialogNewWithButtons' you can also
-- pass the 'DialogModal' flag to make a dialog modal.
--
-- If you add buttons to 'Dialog' using 'dialogNewWithButtons',
-- 'dialogAddButton', 'dialogAddButtons', or 'dialogAddActionWidget', clicking
-- the button will emit a signal called \"response\" with a response ID that
-- you specified. Gtk+ will never assign a meaning to positive response IDs;
-- these are entirely user-defined. But for convenience, you can use the
-- response IDs in the 'ResponseType' enumeration (these all have values less
-- than zero). If a dialog receives a delete event, the \"response\" signal
-- will be emitted with a response ID of 'ResponseNone'.
--
-- If you want to block waiting for a dialog to return before returning
-- control flow to your code, you can call 'dialogRun'. This function enters a
-- recursive main loop and waits for the user to respond to the dialog,
-- returning the response ID corresponding to the button the user clicked.
--
-- For a simple message box, you probably want to use
-- 'Graphics.UI.Gtk.Windows.MessageDialog.MessageDialog' which provides
-- convenience functions
-- for creating standard dialogs containing simple messages to inform
-- or ask the user.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----'Container'
-- |                     +----'Bin'
-- |                           +----'Window'
-- |                                 +----Dialog
-- |                                       +----'AboutDialog'
-- |                                       +----'ColorSelectionDialog'
-- |                                       +----'FileChooserDialog'
-- |                                       +----'FileSelection'
-- |                                       +----'FontSelectionDialog'
-- |                                       +----'InputDialog'
-- |                                       +----'MessageDialog'
-- @

-- * Types
  Dialog,
  DialogClass,
  castToDialog,
  toDialog,

-- * Constructors
  dialogNew,

-- * Methods
  dialogGetUpper,
  dialogGetActionArea,
  dialogRun,
  dialogResponse,
  ResponseId(..),
  dialogAddButton,
  dialogAddActionWidget,
  dialogGetHasSeparator,
  dialogSetDefaultResponse,
  dialogSetHasSeparator,
  dialogSetResponseSensitive,
  dialogGetResponseForWidget,
  alternativeDialogButtonOrder,
  dialogSetAlternativeButtonOrderFromArray,

-- * Attributes
  dialogHasSeparator,
  dialogActionAreaBorder,
  dialogButtonSpacing,
  dialogContentAreaBorder,
  dialogContentAreaSpacing,

-- * Signals
  close,
  response,

-- * Deprecated
#ifndef DISABLE_DEPRECATED
  onResponse,
  afterResponse,
#endif
  ) where

import Control.Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs	(dialogGetUpper, dialogGetActionArea,
					ResponseId(..), fromResponse, toResponse)

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

--------------------
-- Constructors

-- | Creates a new dialog box. Widgets should not be packed into this 'Window'
-- directly, but into the \"upper\" and \"action area\", which are obtained
-- using 'dialogGetUpper' and 'dialogGetActionArea'.
--
dialogNew :: IO Dialog
dialogNew =
  makeNewObject mkDialog $
  liftM (castPtr :: Ptr Widget -> Ptr Dialog) $
  {# call unsafe dialog_new #}

--------------------
-- Methods

-- | Blocks in a recursive main loop until the dialog either emits the
-- response signal, or is destroyed. If the dialog is destroyed during the call
-- to 'dialogRun', it returns 'ResponseNone'. Otherwise, it returns the
-- response ID from the \"response\" signal emission. Before entering the
-- recursive main loop, 'dialogRun' calls 'widgetShow' on the dialog for you.
-- Note that you still need to show any children of the dialog yourself.
--
-- During 'dialogRun', the default behavior of \"delete_event\" is disabled;
-- if the dialog receives \"delete_event\", it will not be destroyed as windows
-- usually are, and 'dialogRun' will return 'ResponseDeleteEvent'. Also, during
-- 'dialogRun' the dialog will be modal. You can force 'dialogRun' to return at
-- any time by calling 'dialogResponse' to emit the \"response\" signal.
-- Destroying the dialog during 'dialogRun' is a very bad idea, because your
-- post-run code won't know whether the dialog was destroyed or not.
-- Hence, you should not call 'Graphics.UI.Gtk.Abstract.widgetDestroy'
-- before 'dialogRun' has returned.
--
-- After 'dialogRun' returns, you are responsible for hiding or destroying
-- the dialog if you wish to do so.
--
-- Note that even though the recursive main loop gives the effect of a modal
-- dialog (it prevents the user from interacting with other windows while the
-- dialog is run), callbacks such as timeouts, IO channel watches, DND drops,
-- etc, /will/ be triggered during a 'dialogRun' call.
--
dialogRun :: DialogClass self => self
 -> IO ResponseId
dialogRun self =
  liftM toResponse $
  {# call dialog_run #}
    (toDialog self)

-- | Emits the \"response\" signal with the given response ID. Used to
-- indicate that the user has responded to the dialog in some way; typically
-- either you or 'dialogRun' will be monitoring the \"response\" signal and
-- take appropriate action.
--
-- This function can be used to add a custom widget to the action area that
-- should close the dialog when activated or to close the dialog otherwise.
--
dialogResponse :: DialogClass self => self
 -> ResponseId
 -> IO ()
dialogResponse self responseId =
  {# call dialog_response #}
    (toDialog self)
    (fromResponse responseId)

-- | Adds a button with the given text (or a stock button, if @buttonText@ is
-- a stock ID) and sets things up so that clicking the button will emit the
-- \"response\" signal with the given @responseId@. The button is appended to
-- the end of the dialog's action area. The button widget is returned, but
-- usually you don't need it.
--
dialogAddButton :: DialogClass self => self
 -> String     -- ^ @buttonText@ - text of button, or stock ID
 -> ResponseId -- ^ @responseId@ - response ID for the button
 -> IO Button  -- ^ returns the button widget that was added
dialogAddButton self buttonText responseId =
  makeNewObject mkButton $ liftM castPtr $
  withUTFString buttonText $ \buttonTextPtr ->
  {# call dialog_add_button #}
    (toDialog self)
    buttonTextPtr
    (fromResponse responseId)

-- | Adds an activatable widget to the action area of a 'Dialog', connecting a
-- signal handler that will emit the \"response\" signal on the dialog when the
-- widget is activated. The widget is appended to the end of the dialog's
-- action area. If you want to add a non-activatable widget, simply pack it
-- into the action area.
--
dialogAddActionWidget :: (DialogClass self, WidgetClass child) => self
 -> child      -- ^ @child@ - an activatable widget
 -> ResponseId -- ^ @responseId@ - response ID for @child@
 -> IO ()
dialogAddActionWidget self child responseId =
  {# call dialog_add_action_widget #}
    (toDialog self)
    (toWidget child)
    (fromResponse responseId)

-- | Query if the dialog has a visible horizontal separator.
--
dialogGetHasSeparator :: DialogClass self => self -> IO Bool
dialogGetHasSeparator self =
  liftM toBool $
  {# call unsafe dialog_get_has_separator #}
    (toDialog self)

-- | Sets the last widget in the dialog's action area with the given
-- 'ResponseId' as the default widget for the dialog. Pressing \"Enter\"
-- normally activates the default widget.
--
-- * The default response is reset once it is triggered. Hence, if you
--   hide the dialog (rather than closing it) and re-display it later,
--   you need to call this function again.
--
dialogSetDefaultResponse :: DialogClass self => self
 -> ResponseId
 -> IO ()
dialogSetDefaultResponse self responseId =
  {# call dialog_set_default_response #}
    (toDialog self)
    (fromResponse responseId)

-- | Sets whether the dialog has a separator above the buttons. @True@ by
-- default.
--
dialogSetHasSeparator :: DialogClass self => self -> Bool -> IO ()
dialogSetHasSeparator self setting =
  {# call dialog_set_has_separator #}
    (toDialog self)
    (fromBool setting)

-- | Calls @'widgetSetSensitive' widget setting@ for each widget in the
-- dialog's action area with the given @responseId@. A convenient way to
-- sensitize\/desensitize dialog buttons.
--
dialogSetResponseSensitive :: DialogClass self => self
 -> ResponseId -- ^ @responseId@ - a response ID
 -> Bool       -- ^ @setting@ - @True@ for sensitive
 -> IO ()
dialogSetResponseSensitive self responseId setting =
  {# call dialog_set_response_sensitive #}
    (toDialog self)
    (fromResponse responseId)
    (fromBool setting)

-- | Gets the response id of a widget in the action area of a dialog.
dialogGetResponseForWidget :: (DialogClass self, WidgetClass widget) => self
 -> widget  -- ^ @widget@ - a widget in the action area of dialog
 -> IO Int  -- ^ return the response id of widget, or 'ResponseNone' if widget doesn't have a response id set.
dialogGetResponseForWidget self widget = liftM fromIntegral $
  {# call dialog_get_response_for_widget #}
    (toDialog self)
    (toWidget widget)

-- | Returns @True@ if dialogs are expected to use an alternative button order on the screen screen.
-- See 'dialogSetAlternativeButtonOrder' for more details about alternative button order.
--
-- If you need to use this function, you should probably connect to the 'alternativeButtonOrder' signal on the GtkSettings object associated to  screen, in order to be notified if the button order setting changes.
--
-- * Available since Gtk+ version 2.6
--
alternativeDialogButtonOrder ::
   Maybe Screen  -- ^ @screen@ - a 'Screen', or @Nothing@ to use the default screen
 -> IO Bool   -- ^ return Whether the alternative button order should be used
alternativeDialogButtonOrder (Just screen) = liftM toBool $
  {# call alternative_dialog_button_order #} screen
alternativeDialogButtonOrder Nothing = liftM toBool $
  {# call alternative_dialog_button_order #} (Screen nullForeignPtr)

-- | Sets an alternative button order.
-- If the 'alternativeButtonOrder' setting is set to @True@, the dialog buttons are reordered according to the order of the response ids in new_order.
--
-- See 'dialogSetAlternativeButtonOrder' for more information.
--
-- This function is for use by language bindings.
--
-- * Available since Gtk+ version 2.6
--
dialogSetAlternativeButtonOrderFromArray :: DialogClass self => self
 -> Int  -- ^ @nParams@ - the number of response ids in new_order
 -> [Int]  -- ^ @newOrder@ - an array of response ids of dialog's buttons
 -> IO ()
dialogSetAlternativeButtonOrderFromArray self nParams newOrder =
  withArray (map fromIntegral newOrder) $ \newOrderPtr ->
  {# call dialog_set_alternative_button_order_from_array #}
    (toDialog self)
    (fromIntegral nParams)
    newOrderPtr

--------------------
-- Attributes

-- | The dialog has a separator bar above its buttons.
--
-- Default value: @True@
--
dialogHasSeparator :: DialogClass self => Attr self Bool
dialogHasSeparator = newAttr
  dialogGetHasSeparator
  dialogSetHasSeparator

-- | Width of border around the button area at the bottom of the dialog.
--
-- Allowed values: >= 0
--
-- Default value: 5
--
dialogActionAreaBorder :: DialogClass self => ReadAttr self Int
dialogActionAreaBorder = readAttrFromIntProperty "action-area-border"

-- | Spacing between buttons.
--
-- Allowed values: >= 0
--
-- Default value: 6
--
dialogButtonSpacing :: DialogClass self => ReadAttr self Int
dialogButtonSpacing = readAttrFromIntProperty "button-spacing"

-- | Width of border around the main dialog area.
--
-- Allowed values: >= 0
--
-- Default value: 2
--
dialogContentAreaBorder :: DialogClass self => ReadAttr self Int
dialogContentAreaBorder = readAttrFromIntProperty "content-area-border"

-- | The default spacing used between elements of the content area of the dialog,
-- as returned by 'dialogSetContentArea', unless 'boxSetSpacing' was called on that widget directly.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
-- * Available since Gtk+ version 2.16
--
dialogContentAreaSpacing :: DialogClass self => ReadAttr self Int
dialogContentAreaSpacing = readAttrFromIntProperty "content-area-spacing"

--------------------
-- Signals
close :: DialogClass self => Signal self (IO ())
close = Signal (connect_NONE__NONE "close")

response :: DialogClass self => Signal self (Int -> IO ())
response = Signal (connect_INT__NONE "response")

-- * Deprecated
#ifndef DISABLE_DEPRECATED
-- | Emitted when an action widget is clicked, the dialog receives a delete
-- event, or the application programmer calls 'dialogResponse'. On a delete
-- event, the response ID is 'ResponseNone'. Otherwise, it depends on which
-- action widget was clicked.
--
onResponse, afterResponse :: DialogClass self => self
 -> (ResponseId -> IO ())
 -> IO (ConnectId self)
onResponse dia act = connect_INT__NONE "response" False dia (act . toResponse)
afterResponse dia act = connect_INT__NONE "response" True dia (act . toResponse)
#endif


fix up gc hooks

fix up gc hooks

{-#LANGUAGE ForeignFunctionInterface #-}

module CuddGC (
    cuddEnableGarbageCollection,
    cuddDisableGarbageCollection,
    cuddGarbageCollectionEnabled,
    c_PreGCHook,
    c_PostGCHook,
    regPreGCHook,
    regPostGCHook
    ) where

import System.IO
import Foreign
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Control.Monad
import Control.Monad.ST

import CuddInternal
import CuddHook

#include <stdio.h>
#include <cudd.h>

foreign import ccall safe "cudd.h Cudd_EnableGarbageCollection"
	c_cuddEnableGarbageCollection :: Ptr CDdManager -> IO ()

cuddEnableGarbageCollection :: STDdManager s u -> ST s ()
cuddEnableGarbageCollection (STDdManager m) = unsafeIOToST $ c_cuddEnableGarbageCollection m

foreign import ccall safe "cudd.h Cudd_DisableGarbageCollection"
	c_cuddDisableGarbageCollection :: Ptr CDdManager -> IO ()

cuddDisableGarbageCollection :: STDdManager s u -> ST s ()
cuddDisableGarbageCollection (STDdManager m) = unsafeIOToST $ c_cuddDisableGarbageCollection m

foreign import ccall safe "cudd.h Cudd_GarbageCollectionEnabled"
	c_cuddGarbageCollectionEnabled :: Ptr CDdManager -> IO (CInt)

cuddGarbageCollectionEnabled :: STDdManager s u -> ST s Int
cuddGarbageCollectionEnabled (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ c_cuddGarbageCollectionEnabled m

foreign import ccall safe "cuddwrap.h &PreGCHook"
	c_PreGCHook :: HookFP

foreign import ccall safe "cuddwrap.h &PostGCHook"
	c_PostGCHook :: HookFP

regPreGCHook :: STDdManager s u -> HookFP -> ST s Int
regPreGCHook m func = cuddAddHook m func CuddPreGcHook

regPostGCHook :: STDdManager s u -> HookFP -> ST s Int
regPostGCHook m func = cuddAddHook m func CuddPostGcHook

{-#LANGUAGE ForeignFunctionInterface #-}

module CuddGC (
    cuddEnableGarbageCollection,
    cuddDisableGarbageCollection,
    cuddGarbageCollectionEnabled,
    regPreGCHook,
    regPostGCHook
    ) where

import System.IO
import Foreign
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Control.Monad
import Control.Monad.ST

import CuddInternal
import CuddHook

#include <stdio.h>
#include <cudd.h>

foreign import ccall safe "cudd.h Cudd_EnableGarbageCollection"
	c_cuddEnableGarbageCollection :: Ptr CDdManager -> IO ()

cuddEnableGarbageCollection :: STDdManager s u -> ST s ()
cuddEnableGarbageCollection (STDdManager m) = unsafeIOToST $ c_cuddEnableGarbageCollection m

foreign import ccall safe "cudd.h Cudd_DisableGarbageCollection"
	c_cuddDisableGarbageCollection :: Ptr CDdManager -> IO ()

cuddDisableGarbageCollection :: STDdManager s u -> ST s ()
cuddDisableGarbageCollection (STDdManager m) = unsafeIOToST $ c_cuddDisableGarbageCollection m

foreign import ccall safe "cudd.h Cudd_GarbageCollectionEnabled"
	c_cuddGarbageCollectionEnabled :: Ptr CDdManager -> IO (CInt)

cuddGarbageCollectionEnabled :: STDdManager s u -> ST s Int
cuddGarbageCollectionEnabled (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ c_cuddGarbageCollectionEnabled m

foreign import ccall safe "cuddwrap.h &PreGCHook"
	c_PreGCHook :: HookFP

foreign import ccall safe "cuddwrap.h &PostGCHook"
	c_PostGCHook :: HookFP

regPreGCHook :: STDdManager s u -> ST s Int
regPreGCHook m = cuddAddHook m c_PreGCHook CuddPreGcHook

regPostGCHook :: STDdManager s u -> ST s Int
regPostGCHook m = cuddAddHook m c_PostGCHook CuddPostGcHook


Added iSend.

Added iSend.

{-# LANGUAGE ForeignFunctionInterface #-}

#include <mpi.h>
#include "init_wrapper.h"

module Bindings.MPI.Internal
   ( init, finalize, send, recv, commRank, probe, commSize,
     iSend, iRecv
   ) where

import Prelude hiding (init, error)
import C2HS
import Control.Applicative ((<$>))
import Bindings.MPI.Comm (Comm)
import Bindings.MPI.Request (Request)
import Bindings.MPI.Status (Status, StatusPtr)
import Bindings.MPI.MarshalUtils (enumToCInt)
import Bindings.MPI.ErrorClasses (ErrorClass)
import Bindings.MPI.MarshalUtils (enumFromCInt)
import Bindings.MPI.Utils (checkError)

{# context prefix = "MPI" #}

init = {# call unsafe init_wrapper as init_wrapper_ #}
finalize = {# call unsafe Finalize as finalize_ #}
commSize = {# call unsafe Comm_size as commSize_ #}
commRank = {# call unsafe Comm_rank as commRank_ #}
probe = {# call unsafe Probe as probe_ #}
send = {# call unsafe Send as send_ #}
recv = {# call unsafe Recv as recv_ #}
iSend = {# call unsafe Isend as iSend_ #}
iRecv = {# call unsafe Irecv as iRecv_ #}

{-# LANGUAGE ForeignFunctionInterface #-}

#include <mpi.h>
#include "init_wrapper.h"

module Bindings.MPI.Internal
   (init, finalize, send, recv, commRank, probe) where

import Prelude hiding (init, error)
import C2HS
import Control.Applicative ((<$>))
import Bindings.MPI.Comm (Comm)
import Bindings.MPI.Status (Status, StatusPtr)
import Bindings.MPI.MarshalUtils (enumToCInt)
import Bindings.MPI.ErrorClasses (ErrorClass)
import Bindings.MPI.MarshalUtils (enumFromCInt)
import Bindings.MPI.Utils (checkError)

{# context prefix = "MPI" #}

-- {# fun unsafe init_wrapper as init {} -> `ErrorClass' enumFromCInt #}
init = {# call unsafe init_wrapper as init_wrapper_ #}

-- {# fun unsafe Finalize as finalize {} -> `ErrorClass' enumFromCInt #}
finalize = {# call unsafe Finalize as finalize_ #}

commRank = {# call unsafe Comm_rank as commRank_ #}

send = {# call unsafe Send as send_ #}

recv = {# call unsafe Recv as recv_ #}

probe = {# call unsafe Probe as probe_ #}


add buffer queue ops

add buffer queue ops

-- -----------------------------------------------------------------------------
-- This file is part of Haskell-Opencl.

-- Haskell-Opencl 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 3 of the License, or
-- (at your option) any later version.

-- Haskell-Opencl 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.

-- You should have received a copy of the GNU General Public License
-- along with Haskell-Opencl.  If not, see <http://www.gnu.org/licenses/>.
-- -----------------------------------------------------------------------------
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
module System.GPU.OpenCL.CommandQueue(
  -- * Types
  CLCommandQueue, CLCommandQueueProperty(..),
  -- * Command Queue Functions
  clCreateCommandQueue, clRetainCommandQueue, clReleaseCommandQueue,
  clGetCommandQueueContext, clGetCommandQueueDevice,
  clGetCommandQueueReferenceCount, clGetCommandQueueProperties,
  clSetCommandQueueProperty,
  -- * Memory Commands
  clEnqueueReadBuffer, clEnqueueWriteBuffer,
  -- * Executing Kernels
  -- * Flush and Finish
  clFlush, clFinish
  ) where

-- -----------------------------------------------------------------------------
import Foreign
import Foreign.C.Types
import System.GPU.OpenCL.Types(
  CLint, CLbool, CLuint, CLCommandQueueProperty_, CLCommandQueueInfo_,
  CLError(..), CLCommandQueue, CLDeviceID, CLContext, CLCommandQueueProperty(..),
  CLEvent, CLMem, ErrorCode(..),
  wrapCheckSuccess, wrapPError, wrapGetInfo, getCLValue,
  bitmaskToCommandQueueProperties, bitmaskFromFlags, clSuccess )

#include <CL/cl.h>

-- -----------------------------------------------------------------------------
foreign import ccall "clCreateCommandQueue" raw_clCreateCommandQueue ::
  CLContext -> CLDeviceID -> CLCommandQueueProperty_ -> Ptr CLint -> IO CLCommandQueue
foreign import ccall "clRetainCommandQueue" raw_clRetainCommandQueue ::
  CLCommandQueue -> IO CLint
foreign import ccall "clReleaseCommandQueue" raw_clReleaseCommandQueue ::
  CLCommandQueue -> IO CLint
foreign import ccall "clGetCommandQueueInfo" raw_clGetCommandQueueInfo ::
  CLCommandQueue -> CLCommandQueueInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint
foreign import ccall "clSetCommandQueueProperty" raw_clSetCommandQueueProperty ::
  CLCommandQueue -> CLCommandQueueProperty_ -> CLbool -> Ptr CLCommandQueueProperty_ -> IO CLint
foreign import ccall "clEnqueueReadBuffer" raw_clEnqueueReadBuffer ::
  CLCommandQueue -> CLMem -> CLbool -> CSize -> CSize -> Ptr () -> CLuint -> Ptr CLEvent -> Ptr CLEvent -> IO CLint
foreign import ccall "clEnqueueWriteBuffer" raw_clEnqueueWriteBuffer ::
  CLCommandQueue -> CLMem -> CLbool -> CSize -> CSize -> Ptr () -> CLuint -> Ptr CLEvent -> Ptr CLEvent -> IO CLint
foreign import ccall "clFlush" raw_clFlush ::
  CLCommandQueue -> IO CLint
foreign import ccall "clFinish" raw_clFinish ::
  CLCommandQueue -> IO CLint

-- -----------------------------------------------------------------------------
{-| Create a command-queue on a specific device.

The OpenCL functions that are submitted to a command-queue are enqueued in the
order the calls are made but can be configured to execute in-order or
out-of-order. The properties argument in clCreateCommandQueue can be used to
specify the execution order.

If the 'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' property of a command-queue is
not set, the commands enqueued to a command-queue execute in order. For example,
if an application calls 'clEnqueueNDRangeKernel' to execute kernel A followed by
a 'clEnqueueNDRangeKernel' to execute kernel B, the application can assume that
kernel A finishes first and then kernel B is executed. If the memory objects
output by kernel A are inputs to kernel B then kernel B will see the correct
data in memory objects produced by execution of kernel A. If the
'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' property of a commandqueue is set, then
there is no guarantee that kernel A will finish before kernel B starts execution.

Applications can configure the commands enqueued to a command-queue to execute
out-of-order by setting the 'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' property of
the command-queue. This can be specified when the command-queue is created or
can be changed dynamically using 'clCreateCommandQueue'. In out-of-order
execution mode there is no guarantee that the enqueued commands will finish
execution in the order they were queued. As there is no guarantee that kernels
will be executed in order, i.e. based on when the 'clEnqueueNDRangeKernel' calls
are made within a command-queue, it is therefore possible that an earlier
'clEnqueueNDRangeKernel' call to execute kernel A identified by event A may
execute and/or finish later than a 'clEnqueueNDRangeKernel' call to execute
kernel B which was called by the application at a later point in time. To
guarantee a specific order of execution of kernels, a wait on a particular event
(in this case event A) can be used. The wait for event A can be specified in the
event_wait_list argument to 'clEnqueueNDRangeKernel' for kernel B.

In addition, a wait for events or a barrier command can be enqueued to the
command-queue. The wait for events command ensures that previously enqueued
commands identified by the list of events to wait for have finished before the
next batch of commands is executed. The barrier command ensures that all
previously enqueued commands in a command-queue have finished execution before
the next batch of commands is executed.

Similarly, commands to read, write, copy or map memory objects that are enqueued
after 'clEnqueueNDRangeKernel', 'clEnqueueTask' or 'clEnqueueNativeKernel'
commands are not guaranteed to wait for kernels scheduled for execution to have
completed (if the 'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' property is set). To
ensure correct ordering of commands, the event object returned by
'clEnqueueNDRangeKernel', 'clEnqueueTask' or 'clEnqueueNativeKernel' can be
used to enqueue a wait for event or a barrier command can be enqueued that must
complete before reads or writes to the memory object(s) occur.
-}
clCreateCommandQueue :: CLContext -> CLDeviceID -> [CLCommandQueueProperty]
                     -> IO (Either CLError CLCommandQueue)
clCreateCommandQueue ctx did xs = wrapPError $ \perr -> do
  raw_clCreateCommandQueue ctx did props perr
    where
      props = bitmaskFromFlags xs

-- | Increments the command_queue reference count.
-- 'clCreateCommandQueue' performs an implicit retain. This is very helpful for
-- 3rd party libraries, which typically get a command-queue passed to them by
-- the application. However, it is possible that the application may delete the
-- command-queue without informing the library. Allowing functions to attach to
-- (i.e. retain) and release a command-queue solves the problem of a
-- command-queue being used by a library no longer being valid.
-- Returns 'True' if the function is executed successfully. It returns 'False'
-- if command_queue is not a valid command-queue.
clRetainCommandQueue :: CLCommandQueue -> IO Bool
clRetainCommandQueue = wrapCheckSuccess . raw_clRetainCommandQueue

-- | Decrements the command_queue reference count.
-- After the command_queue reference count becomes zero and all commands queued
-- to command_queue have finished (e.g., kernel executions, memory object
-- updates, etc.), the command-queue is deleted.
-- Returns 'True' if the function is executed successfully. It returns 'False'
-- if command_queue is not a valid command-queue.
clReleaseCommandQueue :: CLCommandQueue -> IO Bool
clReleaseCommandQueue = wrapCheckSuccess . raw_clReleaseCommandQueue

#c
enum CLCommandQueueInfo {
  cL_QUEUE_CONTEXT=CL_QUEUE_CONTEXT,
  cL_QUEUE_DEVICE=CL_QUEUE_DEVICE,
  cL_QUEUE_REFERENCE_COUNT=CL_QUEUE_REFERENCE_COUNT,
  cL_QUEUE_PROPERTIES=CL_QUEUE_PROPERTIES,
  };
#endc
{#enum CLCommandQueueInfo {upcaseFirstLetter} #}

-- | Return the context specified when the command-queue is created.
clGetCommandQueueContext :: CLCommandQueue -> IO (Either CLError CLContext)
clGetCommandQueueContext cq = wrapGetInfo (\(dat :: Ptr CLContext)
                                           -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_QUEUE_CONTEXT
      size = fromIntegral $ sizeOf (nullPtr::CLContext)

-- | Return the device specified when the command-queue is created.
clGetCommandQueueDevice :: CLCommandQueue -> IO (Either CLError CLDeviceID)
clGetCommandQueueDevice cq = wrapGetInfo (\(dat :: Ptr CLDeviceID)
                                           -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_QUEUE_DEVICE
      size = fromIntegral $ sizeOf (nullPtr::CLDeviceID)

-- | Return the command-queue reference count.
-- The reference count returned should be considered immediately stale. It is
-- unsuitable for general use in applications. This feature is provided for
-- identifying memory leaks.
clGetCommandQueueReferenceCount :: CLCommandQueue -> IO (Either CLError CLuint)
clGetCommandQueueReferenceCount cq = wrapGetInfo (\(dat :: Ptr CLuint)
                                           -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_QUEUE_REFERENCE_COUNT
      size = fromIntegral $ sizeOf (0::CLuint)

-- | Return the currently specified properties for the command-queue. These
-- properties are specified by the properties argument in 'clCreateCommandQueue'
-- , and can be changed by 'clSetCommandQueueProperty'.
clGetCommandQueueProperties :: CLCommandQueue -> IO (Either CLError [CLCommandQueueProperty])
clGetCommandQueueProperties cq = wrapGetInfo (\(dat :: Ptr CLCommandQueueProperty_)
                                           -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) bitmaskToCommandQueueProperties
    where
      infoid = getCLValue CL_QUEUE_PROPERTIES
      size = fromIntegral $ sizeOf (0::CLCommandQueueProperty_)

-- | Enable or disable the properties of a command-queue.
-- Returns the command-queue properties before they were changed by
-- 'clSetCommandQueueProperty'.
-- As specified for 'clCreateCommandQueue', the
-- 'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' command-queue property determines
-- whether the commands in a command-queue are executed in-order or
-- out-of-order. Changing this command-queue property will cause the OpenCL
-- implementation to block until all previously queued commands in command_queue
-- have completed. This can be an expensive operation and therefore changes to
-- the 'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' property should be only done
-- when absolutely necessary.
--
-- It is possible that a device(s) becomes unavailable after a context and
-- command-queues that use this device(s) have been created and commands have
-- been queued to command-queues. In this case the behavior of OpenCL API calls
-- that use this context (and command-queues) are considered to be
-- implementation-defined. The user callback function, if specified when the
-- context is created, can be used to record appropriate information
-- when the device becomes unavailable.
clSetCommandQueueProperty :: CLCommandQueue -> [CLCommandQueueProperty] -> Bool
                          -> IO [CLCommandQueueProperty]
clSetCommandQueueProperty cq xs val = alloca $ \(dat :: Ptr CLCommandQueueProperty_) -> do
  errcode <- fmap ErrorCode $ raw_clSetCommandQueueProperty cq props (fromBool val) dat
  if errcode == clSuccess
    then fmap bitmaskToCommandQueueProperties $ peek dat
    else return []
    where
      props = bitmaskFromFlags xs

-- -----------------------------------------------------------------------------
{-| Enqueue commands to read from a buffer object to host memory. Calling
clEnqueueReadBuffer to read a region of the buffer object with the ptr argument
value set to host_ptr + offset, where host_ptr is a pointer to the memory region
specified when the buffer object being read is created with
'CL_MEM_USE_HOST_PTR', must meet the following requirements in order to avoid
undefined behavior:

 * All commands that use this buffer object have finished execution before the
read command begins execution

 * The buffer object is not mapped

 * The buffer object is not used by any command-queue until the read command has
finished execution Errors

'clEnqueueReadBuffer' returns the event if the function is executed
successfully. Otherwise, it returns one of the following errors:

 * 'CL_INVALID_COMMAND_QUEUE' if command_queue is not a valid command-queue.

 * 'CL_INVALID_CONTEXT' if the context associated with command_queue and buffer
are not the same or if the context associated with command_queue and events in
event_wait_list are not the same.

 * 'CL_INVALID_MEM_OBJECT' if buffer is not a valid buffer object.

 * 'CL_INVALID_VALUE' if the region being read specified by (offset, cb) is out
of bounds or if ptr is a NULL value.

 * 'CL_INVALID_EVENT_WAIT_LIST' if event_wait_list is NULL and
num_events_in_wait_list greater than 0, or event_wait_list is not NULL and
num_events_in_wait_list is 0, or if event objects in event_wait_list are not
valid events.

 * 'CL_MEM_OBJECT_ALLOCATION_FAILURE' if there is a failure to allocate memory
for data store associated with buffer.

 * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required
by the OpenCL implementation on the host.
-}
clEnqueueReadBuffer :: CLCommandQueue -> CLMem -> Bool -> CSize -> CSize
                       -> Ptr () -> [CLEvent] -> IO (Either CLError CLEvent)
clEnqueueReadBuffer cq mem check off size dat [] = alloca $ \event -> do
  errcode <- raw_clEnqueueReadBuffer cq mem (fromBool check) off size dat 0 nullPtr event
  if errcode == (fromIntegral . fromEnum $ CL_SUCCESS )
    then fmap Right $ peek event
    else return . Left . toEnum . fromIntegral $ errcode
clEnqueueReadBuffer cq mem check off size dat events = allocaArray nevents $ \pevents -> do
  pokeArray pevents events
  alloca $ \event -> do
    errcode <- raw_clEnqueueReadBuffer cq mem (fromBool check) off size dat cnevents pevents event
    if errcode == (fromIntegral . fromEnum $ CL_SUCCESS )
      then fmap Right $ peek event
      else return . Left . toEnum . fromIntegral $ errcode
    where
      nevents = length events
      cnevents = fromIntegral nevents

{-| Enqueue commands to write to a buffer object from host memory.Calling
clEnqueueWriteBuffer to update the latest bits in a region of the buffer object
with the ptr argument value set to host_ptr + offset, where host_ptr is a
pointer to the memory region specified when the buffer object being written is
created with 'CL_MEM_USE_HOST_PTR', must meet the following requirements in
order to avoid undefined behavior:

 * The host memory region given by (host_ptr + offset, cb) contains the latest
bits when the enqueued write command begins execution.

 * The buffer object is not mapped.

 * The buffer object is not used by any command-queue until the write command
has finished execution.

'clEnqueueWriteBuffer' returns the Event if the function is executed
successfully. Otherwise, it returns one of the following errors:

 * 'CL_INVALID_COMMAND_QUEUE' if command_queue is not a valid command-queue.

 * 'CL_INVALID_CONTEXT' if the context associated with command_queue and buffer
are not the same or if the context associated with command_queue and events in
event_wait_list are not the same.

 * 'CL_INVALID_MEM_OBJECT' if buffer is not a valid buffer object.

 * 'CL_INVALID_VALUE' if the region being written specified by (offset, cb) is
out of bounds or if ptr is a NULL value.

 * 'CL_INVALID_EVENT_WAIT_LIST' if event_wait_list is NULL and
num_events_in_wait_list greater than 0, or event_wait_list is not NULL and
num_events_in_wait_list is 0, or if event objects in event_wait_list are not
valid events.

 * 'CL_MEM_OBJECT_ALLOCATION_FAILURE' if there is a failure to allocate memory
for data store associated with buffer.

 * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required
by the OpenCL implementation on the host.
-}
clEnqueueWriteBuffer :: CLCommandQueue -> CLMem -> Bool -> CSize -> CSize
                       -> Ptr () -> [CLEvent] -> IO (Either CLError CLEvent)
clEnqueueWriteBuffer cq mem check off size dat [] = alloca $ \event -> do
  errcode <- raw_clEnqueueWriteBuffer cq mem (fromBool check) off size dat 0 nullPtr event
  if errcode == (fromIntegral . fromEnum $ CL_SUCCESS )
    then fmap Right $ peek event
    else return . Left . toEnum . fromIntegral $ errcode
clEnqueueWriteBuffer cq mem check off size dat events = allocaArray nevents $ \pevents -> do
  pokeArray pevents events
  alloca $ \event -> do
    errcode <- raw_clEnqueueWriteBuffer cq mem (fromBool check) off size dat cnevents pevents event
    if errcode == (fromIntegral . fromEnum $ CL_SUCCESS )
      then fmap Right $ peek event
      else return . Left . toEnum . fromIntegral $ errcode
    where
      nevents = length events
      cnevents = fromIntegral nevents

-- -----------------------------------------------------------------------------
-- | Issues all previously queued OpenCL commands in a command-queue to the
-- device associated with the command-queue.
-- 'clFlush' only guarantees that all queued commands to command_queue get
-- issued to the appropriate device. There is no guarantee that they will be
-- complete after 'clFlush' returns.
--
-- 'clFlush' returns 'True' if the function call was executed successfully. It
-- returns 'False' if command_queue is not a valid command-queue or if there is
-- a failure to allocate resources required by the OpenCL implementation on the
-- host.
--
-- Any blocking commands queued in a command-queue such as 'clEnqueueReadImage'
-- or 'clEnqueueReadBuffer' with blocking_read set to 'True',
-- 'clEnqueueWriteImage' or 'clEnqueueWriteBuffer' with blocking_write set to
-- 'True', 'clEnqueueMapImage' or 'clEnqueueMapBuffer' with blocking_map set to
-- 'True' or 'clWaitForEvents' perform an implicit flush of the command-queue.
--
-- To use event objects that refer to commands enqueued in a command-queue as
-- event objects to wait on by commands enqueued in a different command-queue,
-- the application must call a 'clFlush' or any blocking commands that perform
-- an implicit flush of the command-queue where the commands that refer to these
-- event objects are enqueued.
clFlush :: CLCommandQueue -> IO Bool
clFlush = wrapCheckSuccess . raw_clFlush

-- | Blocks until all previously queued OpenCL commands in a command-queue are
-- issued to the associated device and have completed.
-- 'clFinish' does not return until all queued commands in command_queue have
-- been processed and completed. 'clFinish' is also a synchronization point.
--
-- 'clFinish' returns 'True' if the function call was executed successfully. It
-- returns 'False' if command_queue is not a valid command-queue or if there is
-- a failure to allocate resources required by the OpenCL implementation on the
-- host.
clFinish :: CLCommandQueue -> IO Bool
clFinish = wrapCheckSuccess . raw_clFinish

-- -----------------------------------------------------------------------------

-- -----------------------------------------------------------------------------
-- This file is part of Haskell-Opencl.

-- Haskell-Opencl 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 3 of the License, or
-- (at your option) any later version.

-- Haskell-Opencl 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.

-- You should have received a copy of the GNU General Public License
-- along with Haskell-Opencl.  If not, see <http://www.gnu.org/licenses/>.
-- -----------------------------------------------------------------------------
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
module System.GPU.OpenCL.CommandQueue(
  -- * Types
  CLCommandQueue, CLCommandQueueProperty(..),
  -- * Command Queue Functions
  clCreateCommandQueue, clRetainCommandQueue, clReleaseCommandQueue,
  clGetCommandQueueContext, clGetCommandQueueDevice,
  clGetCommandQueueReferenceCount, clGetCommandQueueProperties,
  clSetCommandQueueProperty,
  -- * Memory Commands
  -- * Executing Kernels
  -- * Flush and Finish
  clFlush, clFinish
  ) where

-- -----------------------------------------------------------------------------
import Foreign
import Foreign.C.Types
import System.GPU.OpenCL.Types(
  CLint, CLbool, CLuint, CLCommandQueueProperty_, CLCommandQueueInfo_, CLError,
  CLCommandQueue, CLDeviceID, CLContext, CLCommandQueueProperty(..), ErrorCode(..),
  wrapCheckSuccess, wrapPError, wrapGetInfo, getCLValue,
  bitmaskToCommandQueueProperties, bitmaskFromFlags, clSuccess )

#include <CL/cl.h>

-- -----------------------------------------------------------------------------
foreign import ccall "clCreateCommandQueue" raw_clCreateCommandQueue ::
  CLContext -> CLDeviceID -> CLCommandQueueProperty_ -> Ptr CLint -> IO CLCommandQueue
foreign import ccall "clRetainCommandQueue" raw_clRetainCommandQueue ::
  CLCommandQueue -> IO CLint
foreign import ccall "clReleaseCommandQueue" raw_clReleaseCommandQueue ::
  CLCommandQueue -> IO CLint
foreign import ccall "clGetCommandQueueInfo" raw_clGetCommandQueueInfo ::
  CLCommandQueue -> CLCommandQueueInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint
foreign import ccall "clSetCommandQueueProperty" raw_clSetCommandQueueProperty ::
  CLCommandQueue -> CLCommandQueueProperty_ -> CLbool -> Ptr CLCommandQueueProperty_ -> IO CLint
foreign import ccall "clFlush" raw_clFlush ::
  CLCommandQueue -> IO CLint
foreign import ccall "clFinish" raw_clFinish ::
  CLCommandQueue -> IO CLint

-- -----------------------------------------------------------------------------
{-| Create a command-queue on a specific device.

The OpenCL functions that are submitted to a command-queue are enqueued in the
order the calls are made but can be configured to execute in-order or
out-of-order. The properties argument in clCreateCommandQueue can be used to
specify the execution order.

If the 'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' property of a command-queue is
not set, the commands enqueued to a command-queue execute in order. For example,
if an application calls 'clEnqueueNDRangeKernel' to execute kernel A followed by
a 'clEnqueueNDRangeKernel' to execute kernel B, the application can assume that
kernel A finishes first and then kernel B is executed. If the memory objects
output by kernel A are inputs to kernel B then kernel B will see the correct
data in memory objects produced by execution of kernel A. If the
'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' property of a commandqueue is set, then
there is no guarantee that kernel A will finish before kernel B starts execution.

Applications can configure the commands enqueued to a command-queue to execute
out-of-order by setting the 'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' property of
the command-queue. This can be specified when the command-queue is created or
can be changed dynamically using 'clCreateCommandQueue'. In out-of-order
execution mode there is no guarantee that the enqueued commands will finish
execution in the order they were queued. As there is no guarantee that kernels
will be executed in order, i.e. based on when the 'clEnqueueNDRangeKernel' calls
are made within a command-queue, it is therefore possible that an earlier
'clEnqueueNDRangeKernel' call to execute kernel A identified by event A may
execute and/or finish later than a 'clEnqueueNDRangeKernel' call to execute
kernel B which was called by the application at a later point in time. To
guarantee a specific order of execution of kernels, a wait on a particular event
(in this case event A) can be used. The wait for event A can be specified in the
event_wait_list argument to 'clEnqueueNDRangeKernel' for kernel B.

In addition, a wait for events or a barrier command can be enqueued to the
command-queue. The wait for events command ensures that previously enqueued
commands identified by the list of events to wait for have finished before the
next batch of commands is executed. The barrier command ensures that all
previously enqueued commands in a command-queue have finished execution before
the next batch of commands is executed.

Similarly, commands to read, write, copy or map memory objects that are enqueued
after 'clEnqueueNDRangeKernel', 'clEnqueueTask' or 'clEnqueueNativeKernel'
commands are not guaranteed to wait for kernels scheduled for execution to have
completed (if the 'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' property is set). To
ensure correct ordering of commands, the event object returned by
'clEnqueueNDRangeKernel', 'clEnqueueTask' or 'clEnqueueNativeKernel' can be
used to enqueue a wait for event or a barrier command can be enqueued that must
complete before reads or writes to the memory object(s) occur.
-}
clCreateCommandQueue :: CLContext -> CLDeviceID -> [CLCommandQueueProperty]
                     -> IO (Either CLError CLCommandQueue)
clCreateCommandQueue ctx did xs = wrapPError $ \perr -> do
  raw_clCreateCommandQueue ctx did props perr
    where
      props = bitmaskFromFlags xs

-- | Increments the command_queue reference count.
-- 'clCreateCommandQueue' performs an implicit retain. This is very helpful for
-- 3rd party libraries, which typically get a command-queue passed to them by
-- the application. However, it is possible that the application may delete the
-- command-queue without informing the library. Allowing functions to attach to
-- (i.e. retain) and release a command-queue solves the problem of a
-- command-queue being used by a library no longer being valid.
-- Returns 'True' if the function is executed successfully. It returns 'False'
-- if command_queue is not a valid command-queue.
clRetainCommandQueue :: CLCommandQueue -> IO Bool
clRetainCommandQueue = wrapCheckSuccess . raw_clRetainCommandQueue

-- | Decrements the command_queue reference count.
-- After the command_queue reference count becomes zero and all commands queued
-- to command_queue have finished (e.g., kernel executions, memory object
-- updates, etc.), the command-queue is deleted.
-- Returns 'True' if the function is executed successfully. It returns 'False'
-- if command_queue is not a valid command-queue.
clReleaseCommandQueue :: CLCommandQueue -> IO Bool
clReleaseCommandQueue = wrapCheckSuccess . raw_clReleaseCommandQueue

#c
enum CLCommandQueueInfo {
  cL_QUEUE_CONTEXT=CL_QUEUE_CONTEXT,
  cL_QUEUE_DEVICE=CL_QUEUE_DEVICE,
  cL_QUEUE_REFERENCE_COUNT=CL_QUEUE_REFERENCE_COUNT,
  cL_QUEUE_PROPERTIES=CL_QUEUE_PROPERTIES,
  };
#endc
{#enum CLCommandQueueInfo {upcaseFirstLetter} #}

-- | Return the context specified when the command-queue is created.
clGetCommandQueueContext :: CLCommandQueue -> IO (Either CLError CLContext)
clGetCommandQueueContext cq = wrapGetInfo (\(dat :: Ptr CLContext)
                                           -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_QUEUE_CONTEXT
      size = fromIntegral $ sizeOf (nullPtr::CLContext)

-- | Return the device specified when the command-queue is created.
clGetCommandQueueDevice :: CLCommandQueue -> IO (Either CLError CLDeviceID)
clGetCommandQueueDevice cq = wrapGetInfo (\(dat :: Ptr CLDeviceID)
                                           -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_QUEUE_DEVICE
      size = fromIntegral $ sizeOf (nullPtr::CLDeviceID)

-- | Return the command-queue reference count.
-- The reference count returned should be considered immediately stale. It is
-- unsuitable for general use in applications. This feature is provided for
-- identifying memory leaks.
clGetCommandQueueReferenceCount :: CLCommandQueue -> IO (Either CLError CLuint)
clGetCommandQueueReferenceCount cq = wrapGetInfo (\(dat :: Ptr CLuint)
                                           -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_QUEUE_REFERENCE_COUNT
      size = fromIntegral $ sizeOf (0::CLuint)

-- | Return the currently specified properties for the command-queue. These
-- properties are specified by the properties argument in 'clCreateCommandQueue'
-- , and can be changed by 'clSetCommandQueueProperty'.
clGetCommandQueueProperties :: CLCommandQueue -> IO (Either CLError [CLCommandQueueProperty])
clGetCommandQueueProperties cq = wrapGetInfo (\(dat :: Ptr CLCommandQueueProperty_)
                                           -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) bitmaskToCommandQueueProperties
    where
      infoid = getCLValue CL_QUEUE_PROPERTIES
      size = fromIntegral $ sizeOf (0::CLCommandQueueProperty_)

-- | Enable or disable the properties of a command-queue.
-- Returns the command-queue properties before they were changed by
-- 'clSetCommandQueueProperty'.
-- As specified for 'clCreateCommandQueue', the
-- 'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' command-queue property determines
-- whether the commands in a command-queue are executed in-order or
-- out-of-order. Changing this command-queue property will cause the OpenCL
-- implementation to block until all previously queued commands in command_queue
-- have completed. This can be an expensive operation and therefore changes to
-- the 'CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE' property should be only done
-- when absolutely necessary.
--
-- It is possible that a device(s) becomes unavailable after a context and
-- command-queues that use this device(s) have been created and commands have
-- been queued to command-queues. In this case the behavior of OpenCL API calls
-- that use this context (and command-queues) are considered to be
-- implementation-defined. The user callback function, if specified when the
-- context is created, can be used to record appropriate information
-- when the device becomes unavailable.
clSetCommandQueueProperty :: CLCommandQueue -> [CLCommandQueueProperty] -> Bool
                          -> IO [CLCommandQueueProperty]
clSetCommandQueueProperty cq xs val = alloca $ \(dat :: Ptr CLCommandQueueProperty_) -> do
  errcode <- fmap ErrorCode $ raw_clSetCommandQueueProperty cq props (fromBool val) dat
  if errcode == clSuccess
    then fmap bitmaskToCommandQueueProperties $ peek dat
    else return []
    where
      props = bitmaskFromFlags xs

-- -----------------------------------------------------------------------------
-- | Issues all previously queued OpenCL commands in a command-queue to the
-- device associated with the command-queue.
-- 'clFlush' only guarantees that all queued commands to command_queue get
-- issued to the appropriate device. There is no guarantee that they will be
-- complete after 'clFlush' returns.
--
-- 'clFlush' returns 'True' if the function call was executed successfully. It
-- returns 'False' if command_queue is not a valid command-queue or if there is
-- a failure to allocate resources required by the OpenCL implementation on the
-- host.
--
-- Any blocking commands queued in a command-queue such as 'clEnqueueReadImage'
-- or 'clEnqueueReadBuffer' with blocking_read set to 'True',
-- 'clEnqueueWriteImage' or 'clEnqueueWriteBuffer' with blocking_write set to
-- 'True', 'clEnqueueMapImage' or 'clEnqueueMapBuffer' with blocking_map set to
-- 'True' or 'clWaitForEvents' perform an implicit flush of the command-queue.
--
-- To use event objects that refer to commands enqueued in a command-queue as
-- event objects to wait on by commands enqueued in a different command-queue,
-- the application must call a 'clFlush' or any blocking commands that perform
-- an implicit flush of the command-queue where the commands that refer to these
-- event objects are enqueued.
clFlush :: CLCommandQueue -> IO Bool
clFlush = wrapCheckSuccess . raw_clFlush

-- | Blocks until all previously queued OpenCL commands in a command-queue are
-- issued to the associated device and have completed.
-- 'clFinish' does not return until all queued commands in command_queue have
-- been processed and completed. 'clFinish' is also a synchronization point.
--
-- 'clFinish' returns 'True' if the function call was executed successfully. It
-- returns 'False' if command_queue is not a valid command-queue or if there is
-- a failure to allocate resources required by the OpenCL implementation on the
-- host.
clFinish :: CLCommandQueue -> IO Bool
clFinish = wrapCheckSuccess . raw_clFinish

-- -----------------------------------------------------------------------------


glade: remove glade/Glade.chs (not sure why this file is here...)

-- GIMP Toolkit (GTK) Binding for Haskell: binding to Libglade   -*-haskell-*-
--    for loading XML widget specifications
--
--  Author : Manuel M T Chakravarty
--  Created: 13 March 2002
--
--  Copyright (c) 2002 Manuel M T Chakravarty
--  Modified 2003 by Duncan Coutts (gtk2hs port)
--
--  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.
--
-- |
--
--  Libglade facilitates loading of XML specifications of whole widget trees
--  that have been interactively designed with the GUI builder Glade.  The
--  present module exports operations for manipulating 'GladeXML' objects.
--
--  @glade_xml_signal_autoconnect()@ is not supported. The C variant is not
--  suitable for Haskell as @-rdynamic@ leads to huge executable and we
--  usually don't want to connect staticly named functions, but closures.
--
-- * @glade_xml_construct()@ is not bound, as it doesn't seem to be useful
--   in Haskell.  As usual, the @signal_connect_data@ variant for
--   registering signal handlers isn't bound either.  Moreover, the
--   @connect_full@ functions are not bound.
--
-- * This binding does not support Libglade functionality that is
--   exclusively meant for extending Libglade with new widgets.  Like new
--   widgets, such functionality is currently expected to be implemented in
--   C.
--

module Glade (

  -- * Data types
  --
  GladeXMLClass, GladeXML,

  -- * Creation operations
  --
  xmlNew, xmlNewWithRootAndDomain,

  -- * Obtaining widget handles
  --
  xmlGetWidget, xmlGetWidgetRaw

) where

import Monad	(liftM)
import FFI
import GType
import Object   (makeNewObject)
import GObject  (makeNewGObject)
{#import Hierarchy#}
{#import GladeType#}
import GList

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

-- | Create a new XML object (and the corresponding
-- widgets) from the given XML file; corresponds to
-- 'xmlNewWithRootAndDomain', but without the ability to specify a root
-- widget or translation domain.
--
xmlNew :: FilePath -> IO (Maybe GladeXML)
xmlNew file =
  withCString file                $ \strPtr1 -> do
  xmlPtr <- {#call unsafe xml_new#} strPtr1 nullPtr nullPtr
  if xmlPtr==nullPtr then return Nothing
                     else liftM Just $ makeNewGObject mkGladeXML (return xmlPtr)

-- | Create a new GladeXML object (and
-- the corresponding widgets) from the given XML file with an optional
-- root widget and translation domain.
--
-- * If the second argument is not @Nothing@, the interface will only be built
--   from the widget whose name is given.  This feature is useful if you only
--   want to build say a toolbar or menu from the XML file, but not the window
--   it is embedded in.  Note also that the XML parse tree is cached to speed
--   up creating another \'XML\' object for the same file.
--
xmlNewWithRootAndDomain :: FilePath -> Maybe String -> Maybe String -> IO (Maybe GladeXML)
xmlNewWithRootAndDomain file rootWidgetName domain =
  withCString file                $ \strPtr1 ->
  withMaybeCString rootWidgetName $ \strPtr2 ->
  withMaybeCString domain         $ \strPtr3 -> do
  xmlPtr <- {#call unsafe xml_new#} strPtr1 strPtr2 strPtr3
  if xmlPtr==nullPtr then return Nothing
                     else liftM Just $ makeNewGObject mkGladeXML (return xmlPtr)

-- | Get the widget that has the given name in
-- the interface description. If the named widget cannot be found
-- or is of the wrong type the result is an error.
--
-- * the second parameter should be a dynamic cast function that
--   returns the type of object that you expect, eg castToButton
--
-- * the third parameter is the ID of the widget in the glade xml
--   file, eg \"button1\".
--
xmlGetWidget :: (WidgetClass widget) => GladeXML -> (GObject -> widget) -> String -> IO widget
xmlGetWidget xml cast name = do
  maybeWidget <- xmlGetWidgetRaw xml name
  return $ case maybeWidget of
    Just widget -> cast (toGObject widget) --the cast will return an error if the object is of the wrong type
    Nothing -> error $ "glade.xmlGetWidget: no object named " ++ show name ++ " in the glade file"

xmlGetWidgetRaw :: GladeXML -> String -> IO (Maybe Widget)
xmlGetWidgetRaw xml name =
  withCString name $ \strPtr1 -> do
  widgetPtr <- {#call unsafe xml_get_widget#} xml strPtr1
  if widgetPtr==nullPtr then return Nothing
                        else liftM Just $ makeNewObject mkWidget (return widgetPtr)

-- Auxilliary routines
-- -------------------

-- Marshall an optional string
--
withMaybeCString :: Maybe String -> (Ptr CChar -> IO a) -> IO a
withMaybeCString  = maybeWith withCString