BindingSet.hs


{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

A binding set maintains a list of activatable key bindings.
A single binding set can match multiple types of widgets.
Similar to style contexts, can be matched by any information contained
in a widgets #GtkWidgetPath. When a binding within a set is matched upon
activation, an action signal is emitted on the target widget to carry out
the actual activation.
-}

module GI.Gtk.Structs.BindingSet
    ( 

-- * Exported types
    BindingSet(..)                          ,
    newZeroBindingSet                       ,
    noBindingSet                            ,


 -- * Methods
-- ** bindingSetActivate
    BindingSetActivateMethodInfo            ,
    bindingSetActivate                      ,


-- ** bindingSetAddPath
    BindingSetAddPathMethodInfo             ,
    bindingSetAddPath                       ,


-- ** bindingSetFind
    bindingSetFind                          ,




 -- * Properties
-- ** ClassBranchPspecs
    bindingSetReadClassBranchPspecs         ,


-- ** Current
    bindingSetReadCurrent                   ,


-- ** Entries
    bindingSetReadEntries                   ,


-- ** Parsed
    bindingSetReadParsed                    ,


-- ** Priority
    bindingSetReadPriority                  ,


-- ** SetName
    bindingSetReadSetName                   ,


-- ** WidgetClassPspecs
    bindingSetReadWidgetClassPspecs         ,


-- ** WidgetPathPspecs
    bindingSetReadWidgetPathPspecs          ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gtk.Types
import GI.Gtk.Callbacks
import qualified GI.GObject as GObject
import qualified GI.Gdk as Gdk

newtype BindingSet = BindingSet (ForeignPtr BindingSet)
-- | Construct a `BindingSet` struct initialized to zero.
newZeroBindingSet :: MonadIO m => m BindingSet
newZeroBindingSet = liftIO $ callocBytes 64 >>= wrapPtr BindingSet

noBindingSet :: Maybe BindingSet
noBindingSet = Nothing

bindingSetReadSetName :: BindingSet -> IO T.Text
bindingSetReadSetName s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CString
    val' <- cstringToText val
    return val'

bindingSetReadPriority :: BindingSet -> IO Int32
bindingSetReadPriority s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO Int32
    return val

bindingSetReadWidgetPathPspecs :: BindingSet -> IO ([Ptr ()])
bindingSetReadWidgetPathPspecs s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO (Ptr (GSList (Ptr ())))
    val' <- unpackGSList val
    return val'

bindingSetReadWidgetClassPspecs :: BindingSet -> IO ([Ptr ()])
bindingSetReadWidgetClassPspecs s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO (Ptr (GSList (Ptr ())))
    val' <- unpackGSList val
    return val'

bindingSetReadClassBranchPspecs :: BindingSet -> IO ([Ptr ()])
bindingSetReadClassBranchPspecs s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO (Ptr (GSList (Ptr ())))
    val' <- unpackGSList val
    return val'

bindingSetReadEntries :: BindingSet -> IO BindingEntry
bindingSetReadEntries s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 40) :: IO (Ptr BindingEntry)
    val' <- (newPtr 56 BindingEntry) val
    return val'

bindingSetReadCurrent :: BindingSet -> IO BindingEntry
bindingSetReadCurrent s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 48) :: IO (Ptr BindingEntry)
    val' <- (newPtr 56 BindingEntry) val
    return val'

bindingSetReadParsed :: BindingSet -> IO Word32
bindingSetReadParsed s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 56) :: IO Word32
    return val

-- method BindingSet::activate
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Gtk" "BindingSet", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "keyval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "modifiers", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_binding_set_activate" gtk_binding_set_activate :: 
    Ptr BindingSet ->                       -- _obj : TInterface "Gtk" "BindingSet"
    Word32 ->                               -- keyval : TBasicType TUInt32
    CUInt ->                                -- modifiers : TInterface "Gdk" "ModifierType"
    Ptr GObject.Object ->                   -- object : TInterface "GObject" "Object"
    IO CInt


bindingSetActivate ::
    (MonadIO m, GObject.ObjectK a) =>
    BindingSet                              -- _obj
    -> Word32                               -- keyval
    -> [Gdk.ModifierType]                   -- modifiers
    -> a                                    -- object
    -> m Bool                               -- result
bindingSetActivate _obj keyval modifiers object = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    let modifiers' = gflagsToWord modifiers
    let object' = unsafeManagedPtrCastPtr object
    result <- gtk_binding_set_activate _obj' keyval modifiers' object'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr object
    return result'

data BindingSetActivateMethodInfo
instance (signature ~ (Word32 -> [Gdk.ModifierType] -> a -> m Bool), MonadIO m, GObject.ObjectK a) => MethodInfo BindingSetActivateMethodInfo BindingSet signature where
    overloadedMethod _ = bindingSetActivate

-- method BindingSet::add_path
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Gtk" "BindingSet", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "path_type", argType = TInterface "Gtk" "PathType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "path_pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "priority", argType = TInterface "Gtk" "PathPriorityType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_binding_set_add_path" gtk_binding_set_add_path :: 
    Ptr BindingSet ->                       -- _obj : TInterface "Gtk" "BindingSet"
    CUInt ->                                -- path_type : TInterface "Gtk" "PathType"
    CString ->                              -- path_pattern : TBasicType TUTF8
    CUInt ->                                -- priority : TInterface "Gtk" "PathPriorityType"
    IO ()

{-# DEPRECATED bindingSetAddPath ["(Since version 3.0)"]#-}
bindingSetAddPath ::
    (MonadIO m) =>
    BindingSet                              -- _obj
    -> PathType                             -- pathType
    -> T.Text                               -- pathPattern
    -> PathPriorityType                     -- priority
    -> m ()                                 -- result
bindingSetAddPath _obj pathType pathPattern priority = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    let pathType' = (fromIntegral . fromEnum) pathType
    pathPattern' <- textToCString pathPattern
    let priority' = (fromIntegral . fromEnum) priority
    gtk_binding_set_add_path _obj' pathType' pathPattern' priority'
    touchManagedPtr _obj
    freeMem pathPattern'
    return ()

data BindingSetAddPathMethodInfo
instance (signature ~ (PathType -> T.Text -> PathPriorityType -> m ()), MonadIO m) => MethodInfo BindingSetAddPathMethodInfo BindingSet signature where
    overloadedMethod _ = bindingSetAddPath

-- method BindingSet::find
-- method type : MemberFunction
-- Args : [Arg {argCName = "set_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TInterface "Gtk" "BindingSet"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_binding_set_find" gtk_binding_set_find :: 
    CString ->                              -- set_name : TBasicType TUTF8
    IO (Ptr BindingSet)


bindingSetFind ::
    (MonadIO m) =>
    T.Text                                  -- setName
    -> m BindingSet                         -- result
bindingSetFind setName = liftIO $ do
    setName' <- textToCString setName
    result <- gtk_binding_set_find setName'
    checkUnexpectedReturnNULL "gtk_binding_set_find" result
    result' <- (newPtr 64 BindingSet) result
    freeMem setName'
    return result'

type family ResolveBindingSetMethod (t :: Symbol) (o :: *) :: * where
    ResolveBindingSetMethod "activate" o = BindingSetActivateMethodInfo
    ResolveBindingSetMethod "addPath" o = BindingSetAddPathMethodInfo
    ResolveBindingSetMethod l o = MethodResolutionFailed l o

instance (info ~ ResolveBindingSetMethod t BindingSet, MethodInfo info BindingSet p) => IsLabelProxy t (BindingSet -> p) where
    fromLabelProxy _ = overloadedMethod (MethodProxy :: MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveBindingSetMethod t BindingSet, MethodInfo info BindingSet p) => IsLabel t (BindingSet -> p) where
    fromLabel _ = overloadedMethod (MethodProxy :: MethodProxy info)
#endif