gstreamer: fix marshaling on Structure where GValues weren't initialized properly

reported/fixed by Oleg Belozeorov <upwawet@gmail.com>

darcs-hash:20090112044035-21862-398d7782fb1c6a0905290a285c9dfcbe05f9a966.gz

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 1-Apr-2007
--
--  Copyright (c) 2007 Peter Gavin
--
--  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 3 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.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--
--  GStreamer, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GStreamer documentation.
--
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module Media.Streaming.GStreamer.Core.Structure (
  Structure,
  structureEmpty,
  structureToString,
  structureFromString,
  structureName,
  structureHasName,
  structureGetBool,
  structureGetInt,
  structureGetFourCC,
  structureGetDouble,
  structureGetString,
  structureGetDate,
  structureGetClockTime,
  structureGetFraction,

  StructureM,
  structureCreate,
  structureModify,
  structureSetNameM,
  structureRemoveFieldM,
  structureSetBoolM,
  structureSetIntM,
  structureSetFourCCM,
  structureSetDoubleM,
  structureSetStringM,
  structureSetDateM,
  structureSetClockTimeM,
  structureSetFractionM,
  structureFixateFieldNearestIntM,
  structureFixateFieldNearestDoubleM,
  structureFixateFieldNearestFractionM,
  structureFixateFieldBoolM
  ) where

import Data.Ratio ( (%)
                  , numerator
                  , denominator )
import Control.Monad (liftM)
{#import Media.Streaming.GStreamer.Core.Types#}
import System.Glib.UTFString
import System.Glib.FFI
import System.Glib.GTypeConstants
{#import System.Glib.GDateTime#}
{#import System.Glib.GType#}
{#import System.Glib.GValue#}
{#import System.Glib.GValueTypes#}

{# context lib = "gstreamer" prefix = "gst" #}

structureEmpty :: String
               -> Structure
structureEmpty name =
    unsafePerformIO $
        withUTFString name {# call structure_empty_new #} >>=
            takeStructure

structureToString :: Structure
                  -> String
structureToString structure =
    unsafePerformIO $
        {# call structure_to_string #} structure >>=
            readUTFString

structureFromString :: String
                    -> (Maybe Structure, Int)
structureFromString string =
    unsafePerformIO $
        withUTFString string $ \cString ->
            alloca $ \endPtr ->
                do structure <- {# call structure_from_string #} cString endPtr >>=
                                    maybePeek takeStructure
                   end <- peek endPtr
                   offset <- {# call g_utf8_pointer_to_offset #} cString end
                   return (structure, fromIntegral offset)

structureName :: Structure
              -> String
structureName structure =
    unsafePerformIO $
        {# call structure_get_name #} structure >>=
            peekUTFString

structureHasName :: Structure
                 -> String
                 -> Bool
structureHasName structure name =
    toBool $ unsafePerformIO $
        withUTFString name $
             {# call structure_has_name #} structure

marshalStructureGet :: Storable a
                    => (Structure -> CString -> Ptr a -> IO {# type gboolean #})
                    -> (a -> IO b)
                    -> Structure
                    -> String
                    -> Maybe b
marshalStructureGet getAction convert structure fieldname =
    unsafePerformIO $
        alloca $ \ptr ->
            withUTFString fieldname $ \cFieldname ->
                do result <- getAction structure cFieldname ptr
                   if toBool result
                       then liftM Just $ peek (castPtr ptr) >>= convert
                       else return Nothing

structureGetBool :: Structure
                 -> String
                 -> Maybe Bool
structureGetBool =
    marshalStructureGet {# call structure_get_boolean #} $
        return . toBool

structureGetInt :: Structure
                -> String
                -> Maybe Int
structureGetInt =
    marshalStructureGet {# call structure_get_int #} $
        return . fromIntegral

structureGetFourCC :: Structure
                   -> String
                   -> Maybe FourCC
structureGetFourCC =
    marshalStructureGet {# call structure_get_fourcc #} $
        return . fromIntegral

structureGetDouble :: Structure
                   -> String
                   -> Maybe Double
structureGetDouble =
    marshalStructureGet {# call structure_get_double #} $
        return . realToFrac

structureGetString :: Structure
                   -> String
                   -> Maybe String
structureGetString structure fieldname =
    unsafePerformIO $
        (withUTFString fieldname $ {# call structure_get_string #} structure) >>=
            maybePeek peekUTFString

structureGetDate :: Structure
                 -> String
                 -> Maybe GDate
structureGetDate =
    marshalStructureGet {# call structure_get_date #} $
        peek . castPtr

structureGetClockTime :: Structure
                      -> String
                      -> Maybe ClockTime
structureGetClockTime =
    marshalStructureGet {# call structure_get_clock_time #} $
        return . fromIntegral

structureGetFraction :: Structure
                     -> String
                     -> Maybe Fraction
structureGetFraction structure fieldname =
    unsafePerformIO $
        alloca $ \numPtr -> alloca $ \denPtr ->
            withUTFString fieldname $ \cFieldname ->
                do result <- {# call structure_get_fraction #} structure cFieldname numPtr denPtr
                   if toBool result
                       then do num <- peek numPtr
                               den <- peek denPtr
                               return $ Just $ (fromIntegral num) % (fromIntegral den)
                       else return Nothing

marshalStructureModify :: IO (Ptr Structure)
                       -> StructureM a
                       -> (Structure, a)
marshalStructureModify mkStructure (StructureM action) =
    unsafePerformIO $
        do ptr <- mkStructure
           structure <- liftM Structure $ newForeignPtr_ ptr
           result <- action structure
           structure' <- takeStructure ptr
           return (structure', result)

structureCreate :: String
                -> StructureM a
                -> (Structure, a)
structureCreate name action =
    marshalStructureModify
        (withUTFString name {# call structure_empty_new #})
        action

structureModify :: Structure
                -> StructureM a
                -> (Structure, a)
structureModify structure action =
    marshalStructureModify
        ({# call structure_copy #} structure)
        action

structureSetNameM :: String
                  -> StructureM ()
structureSetNameM name =
    StructureM $ \structure ->
        withUTFString name $ {# call structure_set_name #} structure

structureRemoveFieldM :: String
                      -> StructureM ()
structureRemoveFieldM name =
    StructureM $ \structure ->
        withUTFString name $ {# call structure_remove_field #} structure

marshalStructureSetM :: GType
                     -> (GValue -> a -> IO ())
                     -> String
                     -> a
                     -> StructureM ()
marshalStructureSetM valueType setGValue fieldname value =
    StructureM $ \structure ->
        withUTFString fieldname $ \cFieldname ->
        allocaGValue $ \gValue ->
            do valueInit gValue valueType
               setGValue gValue value
               {# call structure_set_value #} structure cFieldname gValue

structureSetBoolM :: String
                  -> Bool
                  -> StructureM ()
structureSetBoolM =
    marshalStructureSetM bool valueSetBool

structureSetIntM :: String
                 -> Int
                 -> StructureM ()
structureSetIntM =
    marshalStructureSetM int valueSetInt

structureSetFourCCM :: String
                    -> FourCC
                    -> StructureM ()
structureSetFourCCM =
    marshalStructureSetM fourcc $ \gValue fourcc ->
        {# call value_set_fourcc #} gValue $ fromIntegral fourcc

structureSetDoubleM :: String
                    -> Double
                    -> StructureM ()
structureSetDoubleM =
    marshalStructureSetM double valueSetDouble

structureSetStringM :: String
                    -> String
                    -> StructureM ()
structureSetStringM =
    marshalStructureSetM string valueSetString

structureSetDateM :: String
                  -> GDate
                  -> StructureM ()
structureSetDateM =
    marshalStructureSetM date $ \gValue date ->
        with date $ ({# call value_set_date #} gValue) . castPtr

structureSetClockTimeM :: String
                       -> ClockTime
                       -> StructureM ()
structureSetClockTimeM =
    marshalStructureSetM uint64 $ \gValue clockTime ->
        {# call g_value_set_uint64 #} gValue $ fromIntegral clockTime

structureSetFractionM :: String
                      -> Fraction
                      -> StructureM ()
structureSetFractionM =
    marshalStructureSetM fraction $ \gValue fraction ->
        {# call value_set_fraction #} gValue
                                      (fromIntegral $ numerator fraction)
                                      (fromIntegral $ denominator fraction)

marshalStructureFixateM :: (Structure -> CString -> a -> IO {# type gboolean #})
                        -> String
                        -> a
                        -> StructureM Bool
marshalStructureFixateM fixate fieldname target =
    StructureM $ \structure ->
        withUTFString fieldname $ \cFieldname ->
            liftM toBool $
                fixate structure cFieldname target

structureFixateFieldNearestIntM :: String
                                -> Int
                                -> StructureM Bool
structureFixateFieldNearestIntM =
    marshalStructureFixateM $ \structure cFieldname target ->
        {# call structure_fixate_field_nearest_int #}
            structure
            cFieldname
            (fromIntegral target)

structureFixateFieldNearestDoubleM :: String
                                   -> Double
                                   -> StructureM Bool
structureFixateFieldNearestDoubleM =
    marshalStructureFixateM $ \structure cFieldname target ->
        {# call structure_fixate_field_nearest_double #}
            structure
            cFieldname
            (realToFrac target)

structureFixateFieldNearestFractionM :: String
                                     -> Fraction
                                     -> StructureM Bool
structureFixateFieldNearestFractionM =
    marshalStructureFixateM $ \structure cFieldname target ->
                {# call structure_fixate_field_nearest_fraction #}
                    structure
                    cFieldname
                    (fromIntegral $ numerator target)
                    (fromIntegral $ denominator target)

structureFixateFieldBoolM :: String
                          -> Bool
                          -> StructureM Bool
structureFixateFieldBoolM =
    marshalStructureFixateM $ \structure cFieldname target ->
                {# call structure_fixate_field_boolean #}
                    structure
                    cFieldname
                    (fromBool target)

fourcc = {# call fun fourcc_get_type #}
date = {# call fun date_get_type #}
fraction = {# call fun fraction_get_type #}

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 1-Apr-2007
--
--  Copyright (c) 2007 Peter Gavin
--
--  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 3 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.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--
--  GStreamer, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GStreamer documentation.
--
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module Media.Streaming.GStreamer.Core.Structure (
  Structure,
  structureEmpty,
  structureToString,
  structureFromString,
  structureName,
  structureHasName,
  structureGetBool,
  structureGetInt,
  structureGetFourCC,
  structureGetDouble,
  structureGetString,
  structureGetDate,
  structureGetClockTime,
  structureGetFraction,

  StructureM,
  structureCreate,
  structureModify,
  structureSetNameM,
  structureRemoveFieldM,
  structureSetBoolM,
  structureSetIntM,
  structureSetFourCCM,
  structureSetDoubleM,
  structureSetStringM,
  structureSetDateM,
  structureSetClockTimeM,
  structureSetFractionM,
  structureFixateFieldNearestIntM,
  structureFixateFieldNearestDoubleM,
  structureFixateFieldNearestFractionM,
  structureFixateFieldBoolM
  ) where

import Data.Ratio ( (%)
                  , numerator
                  , denominator )
import Control.Monad (liftM)
{#import Media.Streaming.GStreamer.Core.Types#}
import System.Glib.UTFString
import System.Glib.FFI
{#import System.Glib.GDateTime#}
{#import System.Glib.GValue#}
{#import System.Glib.GValueTypes#}

{# context lib = "gstreamer" prefix = "gst" #}

structureEmpty :: String
               -> Structure
structureEmpty name =
    unsafePerformIO $
        withUTFString name {# call structure_empty_new #} >>=
            takeStructure

structureToString :: Structure
                  -> String
structureToString structure =
    unsafePerformIO $
        {# call structure_to_string #} structure >>=
            readUTFString

structureFromString :: String
                    -> (Maybe Structure, Int)
structureFromString string =
    unsafePerformIO $
        withUTFString string $ \cString ->
            alloca $ \endPtr ->
                do structure <- {# call structure_from_string #} cString endPtr >>=
                                    maybePeek takeStructure
                   end <- peek endPtr
                   offset <- {# call g_utf8_pointer_to_offset #} cString end
                   return (structure, fromIntegral offset)

structureName :: Structure
              -> String
structureName structure =
    unsafePerformIO $
        {# call structure_get_name #} structure >>=
            peekUTFString

structureHasName :: Structure
                 -> String
                 -> Bool
structureHasName structure name =
    toBool $ unsafePerformIO $
        withUTFString name $
             {# call structure_has_name #} structure

marshalStructureGet :: Storable a
                    => (Structure -> CString -> Ptr a -> IO {# type gboolean #})
                    -> (a -> IO b)
                    -> Structure
                    -> String
                    -> Maybe b
marshalStructureGet getAction convert structure fieldname =
    unsafePerformIO $
        alloca $ \ptr ->
            withUTFString fieldname $ \cFieldname ->
                do result <- getAction structure cFieldname ptr
                   if toBool result
                       then liftM Just $ peek (castPtr ptr) >>= convert
                       else return Nothing

structureGetBool :: Structure
                 -> String
                 -> Maybe Bool
structureGetBool =
    marshalStructureGet {# call structure_get_boolean #} $
        return . toBool

structureGetInt :: Structure
                -> String
                -> Maybe Int
structureGetInt =
    marshalStructureGet {# call structure_get_int #} $
        return . fromIntegral

structureGetFourCC :: Structure
                   -> String
                   -> Maybe FourCC
structureGetFourCC =
    marshalStructureGet {# call structure_get_fourcc #} $
        return . fromIntegral

structureGetDouble :: Structure
                   -> String
                   -> Maybe Double
structureGetDouble =
    marshalStructureGet {# call structure_get_double #} $
        return . realToFrac

structureGetString :: Structure
                   -> String
                   -> Maybe String
structureGetString structure fieldname =
    unsafePerformIO $
        (withUTFString fieldname $ {# call structure_get_string #} structure) >>=
            maybePeek peekUTFString

structureGetDate :: Structure
                 -> String
                 -> Maybe GDate
structureGetDate =
    marshalStructureGet {# call structure_get_date #} $
        peek . castPtr

structureGetClockTime :: Structure
                      -> String
                      -> Maybe ClockTime
structureGetClockTime =
    marshalStructureGet {# call structure_get_clock_time #} $
        return . fromIntegral

structureGetFraction :: Structure
                     -> String
                     -> Maybe Fraction
structureGetFraction structure fieldname =
    unsafePerformIO $
        alloca $ \numPtr -> alloca $ \denPtr ->
            withUTFString fieldname $ \cFieldname ->
                do result <- {# call structure_get_fraction #} structure cFieldname numPtr denPtr
                   if toBool result
                       then do num <- peek numPtr
                               den <- peek denPtr
                               return $ Just $ (fromIntegral num) % (fromIntegral den)
                       else return Nothing

marshalStructureModify :: IO (Ptr Structure)
                       -> StructureM a
                       -> (Structure, a)
marshalStructureModify mkStructure (StructureM action) =
    unsafePerformIO $
        do ptr <- mkStructure
           structure <- liftM Structure $ newForeignPtr_ ptr
           result <- action structure
           structure' <- takeStructure ptr
           return (structure', result)

structureCreate :: String
                -> StructureM a
                -> (Structure, a)
structureCreate name action =
    marshalStructureModify
        (withUTFString name {# call structure_empty_new #})
        action

structureModify :: Structure
                -> StructureM a
                -> (Structure, a)
structureModify structure action =
    marshalStructureModify
        ({# call structure_copy #} structure)
        action

structureSetNameM :: String
                  -> StructureM ()
structureSetNameM name =
    StructureM $ \structure ->
        withUTFString name $ {# call structure_set_name #} structure

structureRemoveFieldM :: String
                      -> StructureM ()
structureRemoveFieldM name =
    StructureM $ \structure ->
        withUTFString name $ {# call structure_remove_field #} structure

marshalStructureSetM :: (GValue -> a -> IO ())
                     -> String
                     -> a
                     -> StructureM ()
marshalStructureSetM setGValue fieldname value =
    StructureM $ \structure ->
        withUTFString fieldname $ \cFieldname ->
        allocaGValue $ \gValue ->
            do setGValue gValue value
               {# call structure_set_value #} structure cFieldname gValue

structureSetBoolM :: String
                  -> Bool
                  -> StructureM ()
structureSetBoolM =
    marshalStructureSetM valueSetBool

structureSetIntM :: String
                 -> Int
                 -> StructureM ()
structureSetIntM =
    marshalStructureSetM valueSetInt

structureSetFourCCM :: String
                    -> FourCC
                    -> StructureM ()
structureSetFourCCM =
    marshalStructureSetM $ \gValue fourcc ->
        {# call value_set_fourcc #} gValue $ fromIntegral fourcc

structureSetDoubleM :: String
                    -> Double
                    -> StructureM ()
structureSetDoubleM =
    marshalStructureSetM valueSetDouble

structureSetStringM :: String
                    -> String
                    -> StructureM ()
structureSetStringM =
    marshalStructureSetM valueSetString

structureSetDateM :: String
                  -> GDate
                  -> StructureM ()
structureSetDateM =
    marshalStructureSetM $ \gValue date ->
        with date $ ({# call value_set_date #} gValue) . castPtr

structureSetClockTimeM :: String
                       -> ClockTime
                       -> StructureM ()
structureSetClockTimeM =
    marshalStructureSetM $ \gValue clockTime ->
        {# call g_value_set_uint64 #} gValue $ fromIntegral clockTime

structureSetFractionM :: String
                      -> Fraction
                      -> StructureM ()
structureSetFractionM =
    marshalStructureSetM $ \gValue fraction ->
        {# call value_set_fraction #} gValue
                                      (fromIntegral $ numerator fraction)
                                      (fromIntegral $ denominator fraction)

marshalStructureFixateM :: (Structure -> CString -> a -> IO {# type gboolean #})
                        -> String
                        -> a
                        -> StructureM Bool
marshalStructureFixateM fixate fieldname target =
    StructureM $ \structure ->
        withUTFString fieldname $ \cFieldname ->
            liftM toBool $
                fixate structure cFieldname target

structureFixateFieldNearestIntM :: String
                                -> Int
                                -> StructureM Bool
structureFixateFieldNearestIntM =
    marshalStructureFixateM $ \structure cFieldname target ->
        {# call structure_fixate_field_nearest_int #}
            structure
            cFieldname
            (fromIntegral target)

structureFixateFieldNearestDoubleM :: String
                                   -> Double
                                   -> StructureM Bool
structureFixateFieldNearestDoubleM =
    marshalStructureFixateM $ \structure cFieldname target ->
        {# call structure_fixate_field_nearest_double #}
            structure
            cFieldname
            (realToFrac target)

structureFixateFieldNearestFractionM :: String
                                     -> Fraction
                                     -> StructureM Bool
structureFixateFieldNearestFractionM =
    marshalStructureFixateM $ \structure cFieldname target ->
                {# call structure_fixate_field_nearest_fraction #}
                    structure
                    cFieldname
                    (fromIntegral $ numerator target)
                    (fromIntegral $ denominator target)

structureFixateFieldBoolM :: String
                          -> Bool
                          -> StructureM Bool
structureFixateFieldBoolM =
    marshalStructureFixateM $ \structure cFieldname target ->
                {# call structure_fixate_field_boolean #}
                    structure
                    cFieldname
                    (fromBool target)


Adjust webResourceGetMimeType.

Adjust webResourceGetMimeType.

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
-----------------------------------------------------------------------------
--  Module      :  Graphics.UI.Gtk.WebKit.WebResource
--  Author      :  Andy Stewart
--  Copyright   :  (c) 2010 Andy Stewart <lazycat.manatee@gmail.com>
--
--  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)
--
-- Note:
--
-- Function `webkit_web_resource_get_data` haven't binding
-- no idea how to handle `GString`.
--
-- Access to the WebKit Web Resource
-----------------------------------------------------------------------------

module Graphics.UI.Gtk.WebKit.WebResource (
-- * Description
-- | A web resource encapsulates the data of the download as well as the URI, MIME type and frame name of
-- the resource.

-- * Types
  WebResource,
  WebResourceClass,

-- * Constructors
  webResourceNew,

-- * Methods
  webResourceGetEncoding,
  webResourceGetFrameName,
  webResourceGetMimeType,
  webResourceGetUri,
) where

import Control.Monad		(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.GError
import Graphics.UI.Gtk.Gdk.Events

{#import Graphics.UI.Gtk.Abstract.Object#}	(makeNewObject)
{#import Graphics.UI.Gtk.WebKit.Types#}
{#import System.Glib.GObject#}

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

-- | Returns a new WebKitWebResource.
-- The @encoding@ can be empty.
-- The @frameName@ can be used if the resource represents contents of an
-- entire HTML frame, otherwise pass empty.
webResourceNew :: String -> Int -> String -> String -> String -> String -> IO WebResource
webResourceNew resData size uri mimeType encoding frameName =
   withCString resData $ \dataPtr ->
   withCString uri $ \uriPtr ->
   withCString mimeType $ \mimePtr ->
   withCString encoding $ \encodingPtr ->
   withCString frameName $ \framePtr ->
   wrapNewGObject mkWebResource $
     {#call web_resource_new#} dataPtr (fromIntegral size) uriPtr mimePtr encodingPtr framePtr

-- | Get encoding.
webResourceGetEncoding ::
   WebResourceClass self => self
 -> IO (Maybe String)
webResourceGetEncoding wr =
  {#call web_resource_get_encoding#} (toWebResource wr) >>= maybePeek peekCString

-- | Get frame name.
webResourceGetFrameName ::
   WebResourceClass self => self
 -> IO (Maybe String)
webResourceGetFrameName wr =
  {#call web_resource_get_frame_name#} (toWebResource wr) >>= maybePeek peekCString

-- | Get mime type.
webResourceGetMimeType ::
   WebResourceClass self => self
 -> IO (Maybe String)
webResourceGetMimeType wr =
  {#call web_resource_get_mime_type#} (toWebResource wr) >>= maybePeek peekCString

-- | Get uri.
webResourceGetUri ::
   WebResourceClass self => self
 -> IO String
webResourceGetUri wr =
  {#call web_resource_get_uri#} (toWebResource wr) >>= peekCString

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
-----------------------------------------------------------------------------
--  Module      :  Graphics.UI.Gtk.WebKit.WebResource
--  Author      :  Andy Stewart
--  Copyright   :  (c) 2010 Andy Stewart <lazycat.manatee@gmail.com>
--
--  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)
--
-- Note:
--
-- Function `webkit_web_resource_get_data` haven't binding
-- no idea how to handle `GString`.
--
-- Access to the WebKit Web Resource
-----------------------------------------------------------------------------

module Graphics.UI.Gtk.WebKit.WebResource (
-- * Description
-- | A web resource encapsulates the data of the download as well as the URI, MIME type and frame name of
-- the resource.

-- * Types
  WebResource,
  WebResourceClass,

-- * Constructors
  webResourceNew,

-- * Methods
  webResourceGetEncoding,
  webResourceGetFrameName,
  webResourceGetMimeType,
  webResourceGetUri,
) where

import Control.Monad		(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.GError
import Graphics.UI.Gtk.Gdk.Events

{#import Graphics.UI.Gtk.Abstract.Object#}	(makeNewObject)
{#import Graphics.UI.Gtk.WebKit.Types#}
{#import System.Glib.GObject#}

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

-- | Returns a new WebKitWebResource.
-- The @encoding@ can be empty.
-- The @frameName@ can be used if the resource represents contents of an
-- entire HTML frame, otherwise pass empty.
webResourceNew :: String -> Int -> String -> String -> String -> String -> IO WebResource
webResourceNew resData size uri mimeType encoding frameName =
   withCString resData $ \dataPtr ->
   withCString uri $ \uriPtr ->
   withCString mimeType $ \mimePtr ->
   withCString encoding $ \encodingPtr ->
   withCString frameName $ \framePtr ->
   wrapNewGObject mkWebResource $
     {#call web_resource_new#} dataPtr (fromIntegral size) uriPtr mimePtr encodingPtr framePtr

-- | Get encoding.
webResourceGetEncoding ::
   WebResourceClass self => self
 -> IO (Maybe String)
webResourceGetEncoding wr =
  {#call web_resource_get_encoding#} (toWebResource wr) >>= maybePeek peekCString

-- | Get frame name.
webResourceGetFrameName ::
   WebResourceClass self => self
 -> IO (Maybe String)
webResourceGetFrameName wr =
  {#call web_resource_get_frame_name#} (toWebResource wr) >>= maybePeek peekCString

-- | Get mime type.
webResourceGetMimeType ::
   WebResourceClass self => self
 -> IO String
webResourceGetMimeType wr =
  {#call web_resource_get_mime_type#} (toWebResource wr) >>= peekCString

-- | Get uri.
webResourceGetUri ::
   WebResourceClass self => self
 -> IO String
webResourceGetUri wr =
  {#call web_resource_get_uri#} (toWebResource wr) >>= peekCString


Rename signal.

Rename signal.

The onValueChanged signal in Range was not exported since it clashed with
a different signal of the same name. Since it cannot be used anyway (since
it wasn't exported), I renamed it to onRangeValueChanged and exported it.

darcs-hash:20061202190149-91c87-330932442cafed83db0dbea0c9cb0e6538d145e4.gz

-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Range
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.11 $ from $Date: 2005/10/19 12:57:36 $
--
--  Copyright (C) 1999-2005 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Base class for widgets which visualize an adjustment
--
module Graphics.UI.Gtk.Abstract.Range (
-- * Description
--
-- | For signals regarding a change in the range or increments, refer to
-- 'Adjustment' which is contained in the 'Range' object.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----Range
-- |                     +----'Scale'
-- |                     +----'Scrollbar'
-- @

-- * Types
  Range,
  RangeClass,
  castToRange,
  toRange,

-- * Methods
  rangeGetAdjustment,
  rangeSetAdjustment,
  UpdateType(..),
  rangeGetUpdatePolicy,
  rangeSetUpdatePolicy,
  rangeGetInverted,
  rangeSetInverted,
  rangeGetValue,
  rangeSetValue,
  rangeSetIncrements,
  rangeSetRange,
  ScrollType(..),

-- * Attributes
  rangeUpdatePolicy,
  rangeAdjustment,
  rangeInverted,
  rangeValue,

-- * Signals
  onMoveSlider,
  afterMoveSlider,
  onAdjustBounds,
  afterAdjustBounds,
  onRangeValueChanged,
  afterRangeValueChanged
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums	(UpdateType(..), ScrollType(..))

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

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

-- | Get the 'Adjustment' which is the \"model\" object for 'Range'. See
-- 'rangeSetAdjustment' for details.
--
rangeGetAdjustment :: RangeClass self => self
 -> IO Adjustment -- ^ returns a 'Adjustment'
rangeGetAdjustment self =
  makeNewObject mkAdjustment $
  {# call unsafe range_get_adjustment #}
    (toRange self)

-- | Sets the adjustment to be used as the \"model\" object for this range
-- widget. The adjustment indicates the current range value, the minimum and
-- maximum range values, the step\/page increments used for keybindings and
-- scrolling, and the page size. The page size is normally 0 for 'Scale' and
-- nonzero for 'Scrollbar', and indicates the size of the visible area of the
-- widget being scrolled. The page size affects the size of the scrollbar
-- slider.
--
rangeSetAdjustment :: RangeClass self => self
 -> Adjustment -- ^ @adjustment@ - a 'Adjustment'
 -> IO ()
rangeSetAdjustment self adjustment =
  {# call range_set_adjustment #}
    (toRange self)
    adjustment

-- | Gets the update policy of @range@. See 'rangeSetUpdatePolicy'.
--
rangeGetUpdatePolicy :: RangeClass self => self
 -> IO UpdateType -- ^ returns the current update policy
rangeGetUpdatePolicy self =
  liftM (toEnum . fromIntegral) $
  {# call unsafe range_get_update_policy #}
    (toRange self)

-- | Sets the update policy for the range. 'UpdateContinuous' means that
-- anytime the range slider is moved, the range value will change and the
-- value_changed signal will be emitted. 'UpdateDelayed' means that the value
-- will be updated after a brief timeout where no slider motion occurs, so
-- updates are spaced by a short time rather than continuous.
-- 'UpdateDiscontinuous' means that the value will only be updated when the
-- user releases the button and ends the slider drag operation.
--
rangeSetUpdatePolicy :: RangeClass self => self
 -> UpdateType -- ^ @policy@ - update policy
 -> IO ()
rangeSetUpdatePolicy self policy =
  {# call range_set_update_policy #}
    (toRange self)
    ((fromIntegral . fromEnum) policy)

-- | Gets the value set by 'rangeSetInverted'.
--
rangeGetInverted :: RangeClass self => self
 -> IO Bool -- ^ returns @True@ if the range is inverted
rangeGetInverted self =
  liftM toBool $
  {# call unsafe range_get_inverted #}
    (toRange self)

-- | Ranges normally move from lower to higher values as the slider moves from
-- top to bottom or left to right. Inverted ranges have higher values at the
-- top or on the right rather than on the bottom or left.
--
rangeSetInverted :: RangeClass self => self
 -> Bool  -- ^ @setting@ - @True@ to invert the range
 -> IO ()
rangeSetInverted self setting =
  {# call range_set_inverted #}
    (toRange self)
    (fromBool setting)

-- | Gets the current value of the range.
--
rangeGetValue :: RangeClass self => self
 -> IO Double -- ^ returns current value of the range.
rangeGetValue self =
  liftM realToFrac $
  {# call unsafe range_get_value #}
    (toRange self)

-- | Sets the current value of the range; if the value is outside the minimum
-- or maximum range values, it will be clamped to fit inside them. The range
-- emits the \"value_changed\" signal if the value changes.
--
rangeSetValue :: RangeClass self => self
 -> Double -- ^ @value@ - new value of the range
 -> IO ()
rangeSetValue self value =
  {# call range_set_value #}
    (toRange self)
    (realToFrac value)

-- | Sets the step and page sizes for the range. The step size is used when
-- the user clicks the 'Scrollbar' arrows or moves 'Scale' via arrow keys. The
-- page size is used for example when moving via Page Up or Page Down keys.
--
rangeSetIncrements :: RangeClass self => self
 -> Double -- ^ @step@ - step size
 -> Double -- ^ @page@ - page size
 -> IO ()
rangeSetIncrements self step page =
  {# call range_set_increments #}
    (toRange self)
    (realToFrac step)
    (realToFrac page)

-- | Sets the allowable values in the 'Range', and clamps the range value to
-- be between @min@ and @max@. (If the range has a non-zero page size, it is
-- clamped between @min@ and @max@ - page-size.)
--
rangeSetRange :: RangeClass self => self
 -> Double -- ^ @min@ - minimum range value
 -> Double -- ^ @max@ - maximum range value
 -> IO ()
rangeSetRange self min max =
  {# call range_set_range #}
    (toRange self)
    (realToFrac min)
    (realToFrac max)

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

-- | How the range should be updated on the screen.
--
-- Default value: 'UpdateContinuous'
--
rangeUpdatePolicy :: RangeClass self => Attr self UpdateType
rangeUpdatePolicy = newAttr
  rangeGetUpdatePolicy
  rangeSetUpdatePolicy

-- | The 'Adjustment' that contains the current value of this range object.
--
rangeAdjustment :: RangeClass self => Attr self Adjustment
rangeAdjustment = newAttr
  rangeGetAdjustment
  rangeSetAdjustment

-- | Invert direction slider moves to increase range value.
--
-- Default value: @False@
--
rangeInverted :: RangeClass self => Attr self Bool
rangeInverted = newAttr
  rangeGetInverted
  rangeSetInverted

-- | \'value\' property. See 'rangeGetValue' and 'rangeSetValue'
--
rangeValue :: RangeClass self => Attr self Double
rangeValue = newAttr
  rangeGetValue
  rangeSetValue

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

-- | Emitted when the range value is changed either programmatically or by
-- user action.
--
onRangeValueChanged, afterRangeValueChanged :: RangeClass self => self
 -> IO ()
 -> IO (ConnectId self)
onRangeValueChanged = connect_NONE__NONE "value_changed" False
afterRangeValueChanged = connect_NONE__NONE "value_changed" True

-- | Emitted when the range is adjusted by user action. Note the value can be
-- outside the bounds of the range since it depends on the mouse position.
--
-- Usually you should use 'onRangeValueChanged' \/ 'afterRangeValueChanged'
-- instead.
--
onAdjustBounds, afterAdjustBounds :: RangeClass self => self
 -> (Double -> IO ())
 -> IO (ConnectId self)
onAdjustBounds = connect_DOUBLE__NONE "adjust_bounds" False
afterAdjustBounds = connect_DOUBLE__NONE "adjust_bounds" True

-- | Emitted when the user presses a key (e.g. Page Up, Home, Right Arrow) to
-- move the slider. The 'ScrollType' parameter gives the key that was pressed.
--
-- Usually you should use 'onRangeValueChanged' \/
-- 'afterRangeValueChanged' instead.
--
onMoveSlider, afterMoveSlider :: RangeClass self => self
 -> (ScrollType -> IO ())
 -> IO (ConnectId self)
onMoveSlider = connect_ENUM__NONE "move_slider" False
afterMoveSlider = connect_ENUM__NONE "move_slider" True

-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Range
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.11 $ from $Date: 2005/10/19 12:57:36 $
--
--  Copyright (C) 1999-2005 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Base class for widgets which visualize an adjustment
--
module Graphics.UI.Gtk.Abstract.Range (
-- * Description
--
-- | For signals regarding a change in the range or increments, refer to
-- 'Adjustment' which is contained in the 'Range' object.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----Range
-- |                     +----'Scale'
-- |                     +----'Scrollbar'
-- @

-- * Types
  Range,
  RangeClass,
  castToRange,
  toRange,

-- * Methods
  rangeGetAdjustment,
  rangeSetAdjustment,
  UpdateType(..),
  rangeGetUpdatePolicy,
  rangeSetUpdatePolicy,
  rangeGetInverted,
  rangeSetInverted,
  rangeGetValue,
  rangeSetValue,
  rangeSetIncrements,
  rangeSetRange,
  ScrollType(..),

-- * Attributes
  rangeUpdatePolicy,
  rangeAdjustment,
  rangeInverted,
  rangeValue,

-- * Signals
  onMoveSlider,
  afterMoveSlider,
  onAdjustBounds,
  afterAdjustBounds,
--  onValueChanged,
--  afterValueChanged,
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums	(UpdateType(..), ScrollType(..))

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

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

-- | Get the 'Adjustment' which is the \"model\" object for 'Range'. See
-- 'rangeSetAdjustment' for details.
--
rangeGetAdjustment :: RangeClass self => self
 -> IO Adjustment -- ^ returns a 'Adjustment'
rangeGetAdjustment self =
  makeNewObject mkAdjustment $
  {# call unsafe range_get_adjustment #}
    (toRange self)

-- | Sets the adjustment to be used as the \"model\" object for this range
-- widget. The adjustment indicates the current range value, the minimum and
-- maximum range values, the step\/page increments used for keybindings and
-- scrolling, and the page size. The page size is normally 0 for 'Scale' and
-- nonzero for 'Scrollbar', and indicates the size of the visible area of the
-- widget being scrolled. The page size affects the size of the scrollbar
-- slider.
--
rangeSetAdjustment :: RangeClass self => self
 -> Adjustment -- ^ @adjustment@ - a 'Adjustment'
 -> IO ()
rangeSetAdjustment self adjustment =
  {# call range_set_adjustment #}
    (toRange self)
    adjustment

-- | Gets the update policy of @range@. See 'rangeSetUpdatePolicy'.
--
rangeGetUpdatePolicy :: RangeClass self => self
 -> IO UpdateType -- ^ returns the current update policy
rangeGetUpdatePolicy self =
  liftM (toEnum . fromIntegral) $
  {# call unsafe range_get_update_policy #}
    (toRange self)

-- | Sets the update policy for the range. 'UpdateContinuous' means that
-- anytime the range slider is moved, the range value will change and the
-- value_changed signal will be emitted. 'UpdateDelayed' means that the value
-- will be updated after a brief timeout where no slider motion occurs, so
-- updates are spaced by a short time rather than continuous.
-- 'UpdateDiscontinuous' means that the value will only be updated when the
-- user releases the button and ends the slider drag operation.
--
rangeSetUpdatePolicy :: RangeClass self => self
 -> UpdateType -- ^ @policy@ - update policy
 -> IO ()
rangeSetUpdatePolicy self policy =
  {# call range_set_update_policy #}
    (toRange self)
    ((fromIntegral . fromEnum) policy)

-- | Gets the value set by 'rangeSetInverted'.
--
rangeGetInverted :: RangeClass self => self
 -> IO Bool -- ^ returns @True@ if the range is inverted
rangeGetInverted self =
  liftM toBool $
  {# call unsafe range_get_inverted #}
    (toRange self)

-- | Ranges normally move from lower to higher values as the slider moves from
-- top to bottom or left to right. Inverted ranges have higher values at the
-- top or on the right rather than on the bottom or left.
--
rangeSetInverted :: RangeClass self => self
 -> Bool  -- ^ @setting@ - @True@ to invert the range
 -> IO ()
rangeSetInverted self setting =
  {# call range_set_inverted #}
    (toRange self)
    (fromBool setting)

-- | Gets the current value of the range.
--
rangeGetValue :: RangeClass self => self
 -> IO Double -- ^ returns current value of the range.
rangeGetValue self =
  liftM realToFrac $
  {# call unsafe range_get_value #}
    (toRange self)

-- | Sets the current value of the range; if the value is outside the minimum
-- or maximum range values, it will be clamped to fit inside them. The range
-- emits the \"value_changed\" signal if the value changes.
--
rangeSetValue :: RangeClass self => self
 -> Double -- ^ @value@ - new value of the range
 -> IO ()
rangeSetValue self value =
  {# call range_set_value #}
    (toRange self)
    (realToFrac value)

-- | Sets the step and page sizes for the range. The step size is used when
-- the user clicks the 'Scrollbar' arrows or moves 'Scale' via arrow keys. The
-- page size is used for example when moving via Page Up or Page Down keys.
--
rangeSetIncrements :: RangeClass self => self
 -> Double -- ^ @step@ - step size
 -> Double -- ^ @page@ - page size
 -> IO ()
rangeSetIncrements self step page =
  {# call range_set_increments #}
    (toRange self)
    (realToFrac step)
    (realToFrac page)

-- | Sets the allowable values in the 'Range', and clamps the range value to
-- be between @min@ and @max@. (If the range has a non-zero page size, it is
-- clamped between @min@ and @max@ - page-size.)
--
rangeSetRange :: RangeClass self => self
 -> Double -- ^ @min@ - minimum range value
 -> Double -- ^ @max@ - maximum range value
 -> IO ()
rangeSetRange self min max =
  {# call range_set_range #}
    (toRange self)
    (realToFrac min)
    (realToFrac max)

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

-- | How the range should be updated on the screen.
--
-- Default value: 'UpdateContinuous'
--
rangeUpdatePolicy :: RangeClass self => Attr self UpdateType
rangeUpdatePolicy = newAttr
  rangeGetUpdatePolicy
  rangeSetUpdatePolicy

-- | The 'Adjustment' that contains the current value of this range object.
--
rangeAdjustment :: RangeClass self => Attr self Adjustment
rangeAdjustment = newAttr
  rangeGetAdjustment
  rangeSetAdjustment

-- | Invert direction slider moves to increase range value.
--
-- Default value: @False@
--
rangeInverted :: RangeClass self => Attr self Bool
rangeInverted = newAttr
  rangeGetInverted
  rangeSetInverted

-- | \'value\' property. See 'rangeGetValue' and 'rangeSetValue'
--
rangeValue :: RangeClass self => Attr self Double
rangeValue = newAttr
  rangeGetValue
  rangeSetValue

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

-- | Emitted when the range value is changed either programmatically or by
-- user action.
--
onValueChanged, afterValueChanged :: RangeClass self => self
 -> IO ()
 -> IO (ConnectId self)
onValueChanged = connect_NONE__NONE "value_changed" False
afterValueChanged = connect_NONE__NONE "value_changed" True

-- | Emitted when the range is adjusted by user action. Note the value can be
-- outside the bounds of the range since it depends on the mouse position.
--
-- Usually you should use 'onValueChanged' \/ 'afterValueChanged' instead.
--
onAdjustBounds, afterAdjustBounds :: RangeClass self => self
 -> (Double -> IO ())
 -> IO (ConnectId self)
onAdjustBounds = connect_DOUBLE__NONE "adjust_bounds" False
afterAdjustBounds = connect_DOUBLE__NONE "adjust_bounds" True

-- | Emitted when the user presses a key (e.g. Page Up, Home, Right Arrow) to
-- move the slider. The 'ScrollType' parameter gives the key that was pressed.
--
-- Usually you should use 'onValueChanged' \/ 'afterValueChanged' instead.
--
onMoveSlider, afterMoveSlider :: RangeClass self => self
 -> (ScrollType -> IO ())
 -> IO (ConnectId self)
onMoveSlider = connect_ENUM__NONE "move_slider" False
afterMoveSlider = connect_ENUM__NONE "move_slider" True


Correct arguments of a finally statement. This code has obviously never been tested. Thanks to Bertram Felgenhauer to spot this.

{-# OPTIONS_HADDOCK hide #-}
--  GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 1-Apr-2007
--
--  Copyright (c) 2007 Peter Gavin
--
--  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 3 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.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--
--  GnomeVFS, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GnomeVFS documentation,
--  Copyright (c) 2001 Seth Nickell <snickell@stanford.edu>. The
--  documentation is covered by the GNU Free Documentation License,
--  version 1.2.

-- #hide

-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module System.Gnome.VFS.Marshal (

  cToEnum,
  cFromEnum,
  cToBool,
  cFromBool,
  cToFlags,
  cFromFlags,
  genericResultMarshal,
  voidResultMarshal,
  newObjectResultMarshal,
  volumeOpCallbackMarshal

  ) where

import Control.Exception
import Control.Monad (liftM)
import Data.Dynamic
import System.Glib.FFI
import System.Glib.Flags (Flags, toFlags, fromFlags)
import System.Glib.UTFString (peekUTFString)
{#import System.Gnome.VFS.Types#}
import System.Gnome.VFS.Error
import Prelude hiding (error)

cToEnum :: (Integral a, Enum b) => a -> b
cToEnum = toEnum . fromIntegral

cFromEnum :: (Enum a, Integral b) => a -> b
cFromEnum = fromIntegral . fromEnum

cToBool :: Integral a => a -> Bool
cToBool  = toBool . fromIntegral

cFromBool :: Integral a => Bool -> a
cFromBool = fromIntegral . fromBool

cToFlags :: (Integral a, Flags b) => a -> [b]
cToFlags = toFlags . fromIntegral

cFromFlags :: (Flags a, Integral b) => [a] -> b
cFromFlags = fromIntegral . fromFlags

genericResultMarshal :: IO {# type GnomeVFSResult #}
                     -> IO a
                     -> IO b
                     -> IO a
genericResultMarshal cAction cSuccessAction cFailureAction =
    do result <- liftM cToEnum $ cAction
       case result of
         Ok        -> cSuccessAction
         errorCode -> do cFailureAction
                         error result

voidResultMarshal :: IO {# type GnomeVFSResult #}
                  -> IO ()
voidResultMarshal cAction =
    genericResultMarshal cAction (return ()) (return ())

newObjectResultMarshal :: (ForeignPtr obj -> obj)
                       -> (Ptr (Ptr obj) -> IO {# type GnomeVFSResult #})
                       -> IO obj
newObjectResultMarshal objConstructor cNewObj =
    alloca $ \cObjPtr ->
        do poke cObjPtr nullPtr
           genericResultMarshal (cNewObj cObjPtr)
                                 (do cObj <- peek cObjPtr
                                     assert (cObj /= nullPtr) $ return ()
                                     newObj <- newForeignPtr_ cObj
                                     return $ objConstructor newObj)
                                 (do cObj <- peek cObjPtr
                                     assert (cObj == nullPtr) $ return ())

volumeOpCallbackMarshal :: VolumeOpSuccessCallback
                        -> VolumeOpFailureCallback
                        -> IO {# type GnomeVFSVolumeOpCallback #}
volumeOpCallbackMarshal successCallback failureCallback =
    let cCallback :: CVolumeOpCallback
        cCallback cSucceeded cError cDetailedError cUserData =
            let succeeded = cToBool cSucceeded
                cCallbackFunPtr = castPtrToFunPtr cUserData
            in (flip finally) (freeHaskellFunPtr cCallbackFunPtr) $
                   if succeeded
                      then assert (and [cError == nullPtr, cDetailedError == nullPtr]) $
                                  successCallback
                      else assert (and [cError /= nullPtr, cDetailedError /= nullPtr]) $
                               do error <- peekUTFString cError
                                  detailedError <- peekUTFString cDetailedError
                                  failureCallback error detailedError
    in makeVolumeOpCallback cCallback
foreign import ccall safe "wrapper"
  makeVolumeOpCallback :: CVolumeOpCallback
                       -> IO {# type GnomeVFSVolumeOpCallback #}

{-# OPTIONS_HADDOCK hide #-}
--  GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 1-Apr-2007
--
--  Copyright (c) 2007 Peter Gavin
--
--  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 3 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.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--
--  GnomeVFS, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GnomeVFS documentation,
--  Copyright (c) 2001 Seth Nickell <snickell@stanford.edu>. The
--  documentation is covered by the GNU Free Documentation License,
--  version 1.2.

-- #hide

-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module System.Gnome.VFS.Marshal (

  cToEnum,
  cFromEnum,
  cToBool,
  cFromBool,
  cToFlags,
  cFromFlags,
  genericResultMarshal,
  voidResultMarshal,
  newObjectResultMarshal,
  volumeOpCallbackMarshal

  ) where

import Control.Exception
import Control.Monad (liftM)
import Data.Dynamic
import System.Glib.FFI
import System.Glib.Flags (Flags, toFlags, fromFlags)
import System.Glib.UTFString (peekUTFString)
{#import System.Gnome.VFS.Types#}
import System.Gnome.VFS.Error
import Prelude hiding (error)

cToEnum :: (Integral a, Enum b) => a -> b
cToEnum = toEnum . fromIntegral

cFromEnum :: (Enum a, Integral b) => a -> b
cFromEnum = fromIntegral . fromEnum

cToBool :: Integral a => a -> Bool
cToBool  = toBool . fromIntegral

cFromBool :: Integral a => Bool -> a
cFromBool = fromIntegral . fromBool

cToFlags :: (Integral a, Flags b) => a -> [b]
cToFlags = toFlags . fromIntegral

cFromFlags :: (Flags a, Integral b) => [a] -> b
cFromFlags = fromIntegral . fromFlags

genericResultMarshal :: IO {# type GnomeVFSResult #}
                     -> IO a
                     -> IO b
                     -> IO a
genericResultMarshal cAction cSuccessAction cFailureAction =
    do result <- liftM cToEnum $ cAction
       case result of
         Ok        -> cSuccessAction
         errorCode -> do cFailureAction
                         error result

voidResultMarshal :: IO {# type GnomeVFSResult #}
                  -> IO ()
voidResultMarshal cAction =
    genericResultMarshal cAction (return ()) (return ())

newObjectResultMarshal :: (ForeignPtr obj -> obj)
                       -> (Ptr (Ptr obj) -> IO {# type GnomeVFSResult #})
                       -> IO obj
newObjectResultMarshal objConstructor cNewObj =
    alloca $ \cObjPtr ->
        do poke cObjPtr nullPtr
           genericResultMarshal (cNewObj cObjPtr)
                                 (do cObj <- peek cObjPtr
                                     assert (cObj /= nullPtr) $ return ()
                                     newObj <- newForeignPtr_ cObj
                                     return $ objConstructor newObj)
                                 (do cObj <- peek cObjPtr
                                     assert (cObj == nullPtr) $ return ())

volumeOpCallbackMarshal :: VolumeOpSuccessCallback
                        -> VolumeOpFailureCallback
                        -> IO {# type GnomeVFSVolumeOpCallback #}
volumeOpCallbackMarshal successCallback failureCallback =
    let cCallback :: CVolumeOpCallback
        cCallback cSucceeded cError cDetailedError cUserData =
            let succeeded = cToBool cSucceeded
                cCallbackFunPtr = castPtrToFunPtr cUserData
            in finally (freeHaskellFunPtr cCallbackFunPtr) $
                   if succeeded
                      then assert (and [cError == nullPtr, cDetailedError == nullPtr]) $
                                  successCallback
                      else assert (and [cError /= nullPtr, cDetailedError /= nullPtr]) $
                               do error <- peekUTFString cError
                                  detailedError <- peekUTFString cDetailedError
                                  failureCallback error detailedError
    in makeVolumeOpCallback cCallback
foreign import ccall safe "wrapper"
  makeVolumeOpCallback :: CVolumeOpCallback
                       -> IO {# type GnomeVFSVolumeOpCallback #}


Use 'SourceGutterClass sg => sg' replace SourceGutter as function argument.

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget SourceGutter
--
--  Author : Andy Stewart
--
--  Created: 08 Aug 2010
--
--  Copyright (C) 2010 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)
--
module Graphics.UI.Gtk.SourceView.SourceGutter (
-- * Description
-- | The 'SourceGutter' object represents the left and right gutters of the text view. It is used by
-- 'SourceView' to draw the line numbers and category marks that might be present on a line. By
-- packing additional 'CellRenderer' objects in the gutter, you can extend the gutter with your own
-- custom drawings.
--
-- The gutter works very much the same way as cells rendered in a 'TreeView'. The concept is similar,
-- with the exception that the gutter does not have an underlying 'TreeModel'. Instead, you should use
-- 'sourceGutterSetCellDataFunc' to set a callback to fill in any of the cell renderers
-- properties, given the line for which the cell is to be rendered. Renderers are inserted into the
-- gutter at a certain position.
-- The builtin line number renderer is at position
-- 'SourceViewGutterPositionLines (-30)' and the marks renderer is at
-- 'SourceViewGutterPositionMarks (-20)'. You can use these values to position custom renderers
-- accordingly. The width of a cell renderer can be specified as either fixed (using
-- 'cellRendererSetFixedSize') or dynamic, in which case you must set
-- 'sourceGutterSetCellSizeFunc'. This callback is used to set the properties of the renderer
-- such that @gtkCellRendererGetSize@ yields the maximum width of the cell.

-- * Types
    SourceGutter,
    SourceGutterClass,

-- * Methods
    sourceGutterGetWindow,
    sourceGutterInsert,
    sourceGutterReorder,
    sourceGutterRemove,
    sourceGutterQueueDraw,

-- * Attributes
    sourceGutterView,
    sourceGutterWindowType,

-- * Signals
    sourceGutterCellActivated,
    sourceGutterQueryTooltip,
) where

import Control.Monad	(liftM)
import Control.Monad.Reader ( runReaderT )

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject	(makeNewGObject)
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Multiline.TextView (TextWindowType (..))
import Graphics.UI.GtkInternals  ( TextIter, mkTextIterCopy )
import Graphics.UI.Gtk.Gdk.EventM (EventM, EAny)
{#import Graphics.UI.Gtk.SourceView.Signals#}
{#import Graphics.UI.Gtk.SourceView.Types#}

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

-- | Get the 'Window' of the gutter. The window will only be available when the gutter has at least one,
-- non-zero width, cell renderer packed.
sourceGutterGetWindow :: SourceGutterClass sg => sg -> IO (Maybe DrawWindow)
sourceGutterGetWindow sb =
    maybeNull (makeNewGObject mkDrawWindow) $
    {#call gtk_source_gutter_get_window #} (toSourceGutter sb)

-- | Inserts renderer into gutter at position.
sourceGutterInsert :: (CellRendererClass cell, SourceGutterClass sg) => sg
                   -> cell -- ^ @renderer@ a 'CellRenderer'
                   -> Int -- ^ @position@ the renderers position
                   -> IO ()
sourceGutterInsert gutter renderer position =
  {#call gtk_source_gutter_insert #}
     (toSourceGutter gutter)
     (toCellRenderer renderer)
     (fromIntegral position)

-- | Reorders renderer in gutter to new position.
sourceGutterReorder :: (CellRendererClass cell, SourceGutterClass sg) => sg
                    -> cell -- ^ @renderer@ a 'CellRenderer'
                    -> Int -- ^ @position@ the new renderer position
                    -> IO ()
sourceGutterReorder gutter renderer position =
  {#call gtk_source_gutter_reorder #}
     (toSourceGutter gutter)
     (toCellRenderer renderer)
     (fromIntegral position)

-- | Removes renderer from gutter.
sourceGutterRemove :: (CellRendererClass cell, SourceGutterClass sg) => sg
                   -> cell -- ^ @renderer@ a 'CellRenderer'
                   -> IO ()
sourceGutterRemove gutter renderer =
  {#call gtk_source_gutter_remove #}
     (toSourceGutter gutter)
     (toCellRenderer renderer)

-- | Invalidates the drawable area of the gutter. You can use this to force a redraw of the gutter if
-- something has changed and needs to be redrawn.
sourceGutterQueueDraw :: SourceGutterClass sg => sg -> IO ()
sourceGutterQueueDraw sb =
  {#call gtk_source_gutter_queue_draw #} (toSourceGutter sb)

-- | The 'SourceView' of the gutter
sourceGutterView :: SourceGutterClass sg => Attr sg SourceView
sourceGutterView = newAttrFromObjectProperty "view"
                   {#call pure unsafe gtk_source_view_get_type #}

-- | The text window type on which the window is placed
--
-- Default value: 'TextWindowPrivate'
sourceGutterWindowType :: SourceGutterClass sg => Attr sg TextWindowType
sourceGutterWindowType = newAttrFromEnumProperty "window-type"
                         {#call pure unsafe gtk_text_window_type_get_type #}

-- | Emitted when a cell has been activated (for instance when there was a button press on the cell). The
-- signal is only emitted for cells that have the activatable property set to 'True'.
sourceGutterCellActivated :: SourceGutterClass sg => Signal sg (CellRenderer -> TextIter -> EventM EAny ())
sourceGutterCellActivated =
  Signal (\after obj fun ->
           connect_OBJECT_PTR_BOXED__NONE "cell-activated" mkTextIterCopy after obj
                                   (\cr eventPtr iter -> runReaderT (fun cr iter) eventPtr)
         )

-- | Emitted when a tooltip is requested for a specific cell. Signal handlers can return 'True' to notify
-- the tooltip has been handled.
sourceGutterQueryTooltip :: SourceGutterClass sg => Signal sg (CellRenderer -> TextIter -> Tooltip -> IO Bool)
sourceGutterQueryTooltip =
    Signal $ connect_OBJECT_BOXED_OBJECT__BOOL "query-tooltip" mkTextIterCopy

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget SourceGutter
--
--  Author : Andy Stewart
--
--  Created: 08 Aug 2010
--
--  Copyright (C) 2010 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)
--
module Graphics.UI.Gtk.SourceView.SourceGutter (
-- * Description
-- | The 'SourceGutter' object represents the left and right gutters of the text view. It is used by
-- 'SourceView' to draw the line numbers and category marks that might be present on a line. By
-- packing additional 'CellRenderer' objects in the gutter, you can extend the gutter with your own
-- custom drawings.
--
-- The gutter works very much the same way as cells rendered in a 'TreeView'. The concept is similar,
-- with the exception that the gutter does not have an underlying 'TreeModel'. Instead, you should use
-- 'sourceGutterSetCellDataFunc' to set a callback to fill in any of the cell renderers
-- properties, given the line for which the cell is to be rendered. Renderers are inserted into the
-- gutter at a certain position.
-- The builtin line number renderer is at position
-- 'SourceViewGutterPositionLines (-30)' and the marks renderer is at
-- 'SourceViewGutterPositionMarks (-20)'. You can use these values to position custom renderers
-- accordingly. The width of a cell renderer can be specified as either fixed (using
-- 'cellRendererSetFixedSize') or dynamic, in which case you must set
-- 'sourceGutterSetCellSizeFunc'. This callback is used to set the properties of the renderer
-- such that @gtkCellRendererGetSize@ yields the maximum width of the cell.

-- * Types
    SourceGutter,

-- * Methods
    sourceGutterGetWindow,
    sourceGutterInsert,
    sourceGutterReorder,
    sourceGutterRemove,
    sourceGutterQueueDraw,

-- * Attributes
    sourceGutterView,
    sourceGutterWindowType,

-- * Signals
    sourceGutterCellActivated,
    sourceGutterQueryTooltip,
) where

import Control.Monad	(liftM)
import Control.Monad.Reader ( runReaderT )

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject	(makeNewGObject)
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Multiline.TextView (TextWindowType (..))
import Graphics.UI.GtkInternals  ( TextIter, mkTextIterCopy )
import Graphics.UI.Gtk.Gdk.EventM (EventM, EAny)
{#import Graphics.UI.Gtk.SourceView.Signals#}
{#import Graphics.UI.Gtk.SourceView.Types#}

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

-- | Get the 'Window' of the gutter. The window will only be available when the gutter has at least one,
-- non-zero width, cell renderer packed.
sourceGutterGetWindow :: SourceGutter -> IO (Maybe DrawWindow)
sourceGutterGetWindow sb =
    maybeNull (makeNewGObject mkDrawWindow) $
    {#call gtk_source_gutter_get_window #} sb

-- | Inserts renderer into gutter at position.
sourceGutterInsert :: CellRendererClass cell => SourceGutter
                   -> cell -- ^ @renderer@ a 'CellRenderer'
                   -> Int -- ^ @position@ the renderers position
                   -> IO ()
sourceGutterInsert gutter renderer position =
  {#call gtk_source_gutter_insert #}
     gutter
     (toCellRenderer renderer)
     (fromIntegral position)

-- | Reorders renderer in gutter to new position.
sourceGutterReorder :: CellRendererClass cell => SourceGutter
                    -> cell -- ^ @renderer@ a 'CellRenderer'
                    -> Int -- ^ @position@ the new renderer position
                    -> IO ()
sourceGutterReorder gutter renderer position =
  {#call gtk_source_gutter_reorder #}
     gutter
     (toCellRenderer renderer)
     (fromIntegral position)

-- | Removes renderer from gutter.
sourceGutterRemove :: CellRendererClass cell => SourceGutter
                   -> cell -- ^ @renderer@ a 'CellRenderer'
                   -> IO ()
sourceGutterRemove gutter renderer =
  {#call gtk_source_gutter_remove #}
     gutter
     (toCellRenderer renderer)

-- | Invalidates the drawable area of the gutter. You can use this to force a redraw of the gutter if
-- something has changed and needs to be redrawn.
sourceGutterQueueDraw :: SourceGutter -> IO ()
sourceGutterQueueDraw sb =
  {#call gtk_source_gutter_queue_draw #} sb

-- | The 'SourceView' of the gutter
sourceGutterView :: Attr SourceGutter SourceView
sourceGutterView = newAttrFromObjectProperty "view"
                   {#call pure unsafe gtk_source_view_get_type #}

-- | The text window type on which the window is placed
--
-- Default value: 'TextWindowPrivate'
sourceGutterWindowType :: Attr SourceGutter TextWindowType
sourceGutterWindowType = newAttrFromEnumProperty "window-type"
                         {#call pure unsafe gtk_text_window_type_get_type #}

-- | Emitted when a cell has been activated (for instance when there was a button press on the cell). The
-- signal is only emitted for cells that have the activatable property set to 'True'.
sourceGutterCellActivated :: Signal SourceGutter (CellRenderer -> TextIter -> EventM EAny ())
sourceGutterCellActivated =
  Signal (\after obj fun ->
           connect_OBJECT_PTR_BOXED__NONE "cell-activated" mkTextIterCopy after obj
                                   (\cr eventPtr iter -> runReaderT (fun cr iter) eventPtr)
         )

-- | Emitted when a tooltip is requested for a specific cell. Signal handlers can return 'True' to notify
-- the tooltip has been handled.
sourceGutterQueryTooltip :: Signal SourceGutter (CellRenderer -> TextIter -> Tooltip -> IO Bool)
sourceGutterQueryTooltip =
    Signal $ connect_OBJECT_BOXED_OBJECT__BOOL "query-tooltip" mkTextIterCopy