{- | 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