{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This is the t'GI.GObject.Objects.Object.Object' based object that represents a menu
-- item.  It gets created the same on both the client and
-- the server side and libdbusmenu-glib does the work of making
-- this object model appear on both sides of DBus.  Simple
-- really, though through updates and people coming on and off
-- the bus it can lead to lots of fun complex scenarios.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Dbusmenu.Objects.Menuitem
    ( 

-- * Exported types
    Menuitem(..)                            ,
    IsMenuitem                              ,
    toMenuitem                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [childAddPosition]("GI.Dbusmenu.Objects.Menuitem#g:method:childAddPosition"), [childAppend]("GI.Dbusmenu.Objects.Menuitem#g:method:childAppend"), [childDelete]("GI.Dbusmenu.Objects.Menuitem#g:method:childDelete"), [childFind]("GI.Dbusmenu.Objects.Menuitem#g:method:childFind"), [childPrepend]("GI.Dbusmenu.Objects.Menuitem#g:method:childPrepend"), [childReorder]("GI.Dbusmenu.Objects.Menuitem#g:method:childReorder"), [findId]("GI.Dbusmenu.Objects.Menuitem#g:method:findId"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreach]("GI.Dbusmenu.Objects.Menuitem#g:method:foreach"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [handleEvent]("GI.Dbusmenu.Objects.Menuitem#g:method:handleEvent"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [propertiesCopy]("GI.Dbusmenu.Objects.Menuitem#g:method:propertiesCopy"), [propertiesList]("GI.Dbusmenu.Objects.Menuitem#g:method:propertiesList"), [propertyExist]("GI.Dbusmenu.Objects.Menuitem#g:method:propertyExist"), [propertyGet]("GI.Dbusmenu.Objects.Menuitem#g:method:propertyGet"), [propertyGetBool]("GI.Dbusmenu.Objects.Menuitem#g:method:propertyGetBool"), [propertyGetByteArray]("GI.Dbusmenu.Objects.Menuitem#g:method:propertyGetByteArray"), [propertyGetInt]("GI.Dbusmenu.Objects.Menuitem#g:method:propertyGetInt"), [propertyGetVariant]("GI.Dbusmenu.Objects.Menuitem#g:method:propertyGetVariant"), [propertyRemove]("GI.Dbusmenu.Objects.Menuitem#g:method:propertyRemove"), [propertySet]("GI.Dbusmenu.Objects.Menuitem#g:method:propertySet"), [propertySetBool]("GI.Dbusmenu.Objects.Menuitem#g:method:propertySetBool"), [propertySetByteArray]("GI.Dbusmenu.Objects.Menuitem#g:method:propertySetByteArray"), [propertySetInt]("GI.Dbusmenu.Objects.Menuitem#g:method:propertySetInt"), [propertySetVariant]("GI.Dbusmenu.Objects.Menuitem#g:method:propertySetVariant"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sendAboutToShow]("GI.Dbusmenu.Objects.Menuitem#g:method:sendAboutToShow"), [showToUser]("GI.Dbusmenu.Objects.Menuitem#g:method:showToUser"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [takeChildren]("GI.Dbusmenu.Objects.Menuitem#g:method:takeChildren"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unparent]("GI.Dbusmenu.Objects.Menuitem#g:method:unparent"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getChildren]("GI.Dbusmenu.Objects.Menuitem#g:method:getChildren"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getId]("GI.Dbusmenu.Objects.Menuitem#g:method:getId"), [getParent]("GI.Dbusmenu.Objects.Menuitem#g:method:getParent"), [getPosition]("GI.Dbusmenu.Objects.Menuitem#g:method:getPosition"), [getPositionRealized]("GI.Dbusmenu.Objects.Menuitem#g:method:getPositionRealized"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRoot]("GI.Dbusmenu.Objects.Menuitem#g:method:getRoot").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setParent]("GI.Dbusmenu.Objects.Menuitem#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRoot]("GI.Dbusmenu.Objects.Menuitem#g:method:setRoot").

#if defined(ENABLE_OVERLOADING)
    ResolveMenuitemMethod                   ,
#endif

-- ** childAddPosition #method:childAddPosition#

#if defined(ENABLE_OVERLOADING)
    MenuitemChildAddPositionMethodInfo      ,
#endif
    menuitemChildAddPosition                ,


-- ** childAppend #method:childAppend#

#if defined(ENABLE_OVERLOADING)
    MenuitemChildAppendMethodInfo           ,
#endif
    menuitemChildAppend                     ,


-- ** childDelete #method:childDelete#

#if defined(ENABLE_OVERLOADING)
    MenuitemChildDeleteMethodInfo           ,
#endif
    menuitemChildDelete                     ,


-- ** childFind #method:childFind#

#if defined(ENABLE_OVERLOADING)
    MenuitemChildFindMethodInfo             ,
#endif
    menuitemChildFind                       ,


-- ** childPrepend #method:childPrepend#

#if defined(ENABLE_OVERLOADING)
    MenuitemChildPrependMethodInfo          ,
#endif
    menuitemChildPrepend                    ,


-- ** childReorder #method:childReorder#

#if defined(ENABLE_OVERLOADING)
    MenuitemChildReorderMethodInfo          ,
#endif
    menuitemChildReorder                    ,


-- ** findId #method:findId#

#if defined(ENABLE_OVERLOADING)
    MenuitemFindIdMethodInfo                ,
#endif
    menuitemFindId                          ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    MenuitemForeachMethodInfo               ,
#endif
    menuitemForeach                         ,


-- ** getChildren #method:getChildren#

#if defined(ENABLE_OVERLOADING)
    MenuitemGetChildrenMethodInfo           ,
#endif
    menuitemGetChildren                     ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    MenuitemGetIdMethodInfo                 ,
#endif
    menuitemGetId                           ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    MenuitemGetParentMethodInfo             ,
#endif
    menuitemGetParent                       ,


-- ** getPosition #method:getPosition#

#if defined(ENABLE_OVERLOADING)
    MenuitemGetPositionMethodInfo           ,
#endif
    menuitemGetPosition                     ,


-- ** getPositionRealized #method:getPositionRealized#

#if defined(ENABLE_OVERLOADING)
    MenuitemGetPositionRealizedMethodInfo   ,
#endif
    menuitemGetPositionRealized             ,


-- ** getRoot #method:getRoot#

#if defined(ENABLE_OVERLOADING)
    MenuitemGetRootMethodInfo               ,
#endif
    menuitemGetRoot                         ,


-- ** handleEvent #method:handleEvent#

#if defined(ENABLE_OVERLOADING)
    MenuitemHandleEventMethodInfo           ,
#endif
    menuitemHandleEvent                     ,


-- ** new #method:new#

    menuitemNew                             ,


-- ** newWithId #method:newWithId#

    menuitemNewWithId                       ,


-- ** propertiesCopy #method:propertiesCopy#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertiesCopyMethodInfo        ,
#endif
    menuitemPropertiesCopy                  ,


-- ** propertiesList #method:propertiesList#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertiesListMethodInfo        ,
#endif
    menuitemPropertiesList                  ,


-- ** propertyExist #method:propertyExist#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertyExistMethodInfo         ,
#endif
    menuitemPropertyExist                   ,


-- ** propertyGet #method:propertyGet#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertyGetMethodInfo           ,
#endif
    menuitemPropertyGet                     ,


-- ** propertyGetBool #method:propertyGetBool#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertyGetBoolMethodInfo       ,
#endif
    menuitemPropertyGetBool                 ,


-- ** propertyGetByteArray #method:propertyGetByteArray#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertyGetByteArrayMethodInfo  ,
#endif
    menuitemPropertyGetByteArray            ,


-- ** propertyGetInt #method:propertyGetInt#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertyGetIntMethodInfo        ,
#endif
    menuitemPropertyGetInt                  ,


-- ** propertyGetVariant #method:propertyGetVariant#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertyGetVariantMethodInfo    ,
#endif
    menuitemPropertyGetVariant              ,


-- ** propertyRemove #method:propertyRemove#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertyRemoveMethodInfo        ,
#endif
    menuitemPropertyRemove                  ,


-- ** propertySet #method:propertySet#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertySetMethodInfo           ,
#endif
    menuitemPropertySet                     ,


-- ** propertySetBool #method:propertySetBool#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertySetBoolMethodInfo       ,
#endif
    menuitemPropertySetBool                 ,


-- ** propertySetByteArray #method:propertySetByteArray#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertySetByteArrayMethodInfo  ,
#endif
    menuitemPropertySetByteArray            ,


-- ** propertySetInt #method:propertySetInt#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertySetIntMethodInfo        ,
#endif
    menuitemPropertySetInt                  ,


-- ** propertySetVariant #method:propertySetVariant#

#if defined(ENABLE_OVERLOADING)
    MenuitemPropertySetVariantMethodInfo    ,
#endif
    menuitemPropertySetVariant              ,


-- ** sendAboutToShow #method:sendAboutToShow#

#if defined(ENABLE_OVERLOADING)
    MenuitemSendAboutToShowMethodInfo       ,
#endif
    menuitemSendAboutToShow                 ,


-- ** setParent #method:setParent#

#if defined(ENABLE_OVERLOADING)
    MenuitemSetParentMethodInfo             ,
#endif
    menuitemSetParent                       ,


-- ** setRoot #method:setRoot#

#if defined(ENABLE_OVERLOADING)
    MenuitemSetRootMethodInfo               ,
#endif
    menuitemSetRoot                         ,


-- ** showToUser #method:showToUser#

#if defined(ENABLE_OVERLOADING)
    MenuitemShowToUserMethodInfo            ,
#endif
    menuitemShowToUser                      ,


-- ** takeChildren #method:takeChildren#

#if defined(ENABLE_OVERLOADING)
    MenuitemTakeChildrenMethodInfo          ,
#endif
    menuitemTakeChildren                    ,


-- ** unparent #method:unparent#

#if defined(ENABLE_OVERLOADING)
    MenuitemUnparentMethodInfo              ,
#endif
    menuitemUnparent                        ,




 -- * Properties


-- ** id #attr:id#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MenuitemIdPropertyInfo                  ,
#endif
    constructMenuitemId                     ,
    getMenuitemId                           ,
#if defined(ENABLE_OVERLOADING)
    menuitemId                              ,
#endif




 -- * Signals


-- ** aboutToShow #signal:aboutToShow#

    MenuitemAboutToShowCallback             ,
#if defined(ENABLE_OVERLOADING)
    MenuitemAboutToShowSignalInfo           ,
#endif
    afterMenuitemAboutToShow                ,
    onMenuitemAboutToShow                   ,


-- ** childAdded #signal:childAdded#

    MenuitemChildAddedCallback              ,
#if defined(ENABLE_OVERLOADING)
    MenuitemChildAddedSignalInfo            ,
#endif
    afterMenuitemChildAdded                 ,
    onMenuitemChildAdded                    ,


-- ** childMoved #signal:childMoved#

    MenuitemChildMovedCallback              ,
#if defined(ENABLE_OVERLOADING)
    MenuitemChildMovedSignalInfo            ,
#endif
    afterMenuitemChildMoved                 ,
    onMenuitemChildMoved                    ,


-- ** childRemoved #signal:childRemoved#

    MenuitemChildRemovedCallback            ,
#if defined(ENABLE_OVERLOADING)
    MenuitemChildRemovedSignalInfo          ,
#endif
    afterMenuitemChildRemoved               ,
    onMenuitemChildRemoved                  ,


-- ** event #signal:event#

    MenuitemEventCallback                   ,
#if defined(ENABLE_OVERLOADING)
    MenuitemEventSignalInfo                 ,
#endif
    afterMenuitemEvent                      ,
    onMenuitemEvent                         ,


-- ** itemActivated #signal:itemActivated#

    MenuitemItemActivatedCallback           ,
#if defined(ENABLE_OVERLOADING)
    MenuitemItemActivatedSignalInfo         ,
#endif
    afterMenuitemItemActivated              ,
    onMenuitemItemActivated                 ,


-- ** propertyChanged #signal:propertyChanged#

    MenuitemPropertyChangedCallback         ,
#if defined(ENABLE_OVERLOADING)
    MenuitemPropertyChangedSignalInfo       ,
#endif
    afterMenuitemPropertyChanged            ,
    onMenuitemPropertyChanged               ,


-- ** realized #signal:realized#

    MenuitemRealizedCallback                ,
#if defined(ENABLE_OVERLOADING)
    MenuitemRealizedSignalInfo              ,
#endif
    afterMenuitemRealized                   ,
    onMenuitemRealized                      ,


-- ** showToUser #signal:showToUser#

    MenuitemShowToUserCallback              ,
#if defined(ENABLE_OVERLOADING)
    MenuitemShowToUserSignalInfo            ,
#endif
    afterMenuitemShowToUser                 ,
    onMenuitemShowToUser                    ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object

-- | Memory-managed wrapper type.
newtype Menuitem = Menuitem (SP.ManagedPtr Menuitem)
    deriving (Menuitem -> Menuitem -> Bool
(Menuitem -> Menuitem -> Bool)
-> (Menuitem -> Menuitem -> Bool) -> Eq Menuitem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Menuitem -> Menuitem -> Bool
== :: Menuitem -> Menuitem -> Bool
$c/= :: Menuitem -> Menuitem -> Bool
/= :: Menuitem -> Menuitem -> Bool
Eq)

instance SP.ManagedPtrNewtype Menuitem where
    toManagedPtr :: Menuitem -> ManagedPtr Menuitem
toManagedPtr (Menuitem ManagedPtr Menuitem
p) = ManagedPtr Menuitem
p

foreign import ccall "dbusmenu_menuitem_get_type"
    c_dbusmenu_menuitem_get_type :: IO B.Types.GType

instance B.Types.TypedObject Menuitem where
    glibType :: IO GType
glibType = IO GType
c_dbusmenu_menuitem_get_type

instance B.Types.GObject Menuitem

-- | Type class for types which can be safely cast to `Menuitem`, for instance with `toMenuitem`.
class (SP.GObject o, O.IsDescendantOf Menuitem o) => IsMenuitem o
instance (SP.GObject o, O.IsDescendantOf Menuitem o) => IsMenuitem o

instance O.HasParentTypes Menuitem
type instance O.ParentTypes Menuitem = '[GObject.Object.Object]

-- | Cast to `Menuitem`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toMenuitem :: (MIO.MonadIO m, IsMenuitem o) => o -> m Menuitem
toMenuitem :: forall (m :: * -> *) o.
(MonadIO m, IsMenuitem o) =>
o -> m Menuitem
toMenuitem = IO Menuitem -> m Menuitem
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Menuitem -> m Menuitem)
-> (o -> IO Menuitem) -> o -> m Menuitem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Menuitem -> Menuitem) -> o -> IO Menuitem
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Menuitem -> Menuitem
Menuitem

-- | Convert 'Menuitem' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Menuitem) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dbusmenu_menuitem_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Menuitem -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Menuitem
P.Nothing = Ptr GValue -> Ptr Menuitem -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Menuitem
forall a. Ptr a
FP.nullPtr :: FP.Ptr Menuitem)
    gvalueSet_ Ptr GValue
gv (P.Just Menuitem
obj) = Menuitem -> (Ptr Menuitem -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Menuitem
obj (Ptr GValue -> Ptr Menuitem -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Menuitem)
gvalueGet_ Ptr GValue
gv = do
        Ptr Menuitem
ptr <- Ptr GValue -> IO (Ptr Menuitem)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Menuitem)
        if Ptr Menuitem
ptr Ptr Menuitem -> Ptr Menuitem -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Menuitem
forall a. Ptr a
FP.nullPtr
        then Menuitem -> Maybe Menuitem
forall a. a -> Maybe a
P.Just (Menuitem -> Maybe Menuitem) -> IO Menuitem -> IO (Maybe Menuitem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Menuitem -> Menuitem) -> Ptr Menuitem -> IO Menuitem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Menuitem -> Menuitem
Menuitem Ptr Menuitem
ptr
        else Maybe Menuitem -> IO (Maybe Menuitem)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Menuitem
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveMenuitemMethod (t :: Symbol) (o :: *) :: * where
    ResolveMenuitemMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMenuitemMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMenuitemMethod "childAddPosition" o = MenuitemChildAddPositionMethodInfo
    ResolveMenuitemMethod "childAppend" o = MenuitemChildAppendMethodInfo
    ResolveMenuitemMethod "childDelete" o = MenuitemChildDeleteMethodInfo
    ResolveMenuitemMethod "childFind" o = MenuitemChildFindMethodInfo
    ResolveMenuitemMethod "childPrepend" o = MenuitemChildPrependMethodInfo
    ResolveMenuitemMethod "childReorder" o = MenuitemChildReorderMethodInfo
    ResolveMenuitemMethod "findId" o = MenuitemFindIdMethodInfo
    ResolveMenuitemMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMenuitemMethod "foreach" o = MenuitemForeachMethodInfo
    ResolveMenuitemMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMenuitemMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMenuitemMethod "handleEvent" o = MenuitemHandleEventMethodInfo
    ResolveMenuitemMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMenuitemMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMenuitemMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMenuitemMethod "propertiesCopy" o = MenuitemPropertiesCopyMethodInfo
    ResolveMenuitemMethod "propertiesList" o = MenuitemPropertiesListMethodInfo
    ResolveMenuitemMethod "propertyExist" o = MenuitemPropertyExistMethodInfo
    ResolveMenuitemMethod "propertyGet" o = MenuitemPropertyGetMethodInfo
    ResolveMenuitemMethod "propertyGetBool" o = MenuitemPropertyGetBoolMethodInfo
    ResolveMenuitemMethod "propertyGetByteArray" o = MenuitemPropertyGetByteArrayMethodInfo
    ResolveMenuitemMethod "propertyGetInt" o = MenuitemPropertyGetIntMethodInfo
    ResolveMenuitemMethod "propertyGetVariant" o = MenuitemPropertyGetVariantMethodInfo
    ResolveMenuitemMethod "propertyRemove" o = MenuitemPropertyRemoveMethodInfo
    ResolveMenuitemMethod "propertySet" o = MenuitemPropertySetMethodInfo
    ResolveMenuitemMethod "propertySetBool" o = MenuitemPropertySetBoolMethodInfo
    ResolveMenuitemMethod "propertySetByteArray" o = MenuitemPropertySetByteArrayMethodInfo
    ResolveMenuitemMethod "propertySetInt" o = MenuitemPropertySetIntMethodInfo
    ResolveMenuitemMethod "propertySetVariant" o = MenuitemPropertySetVariantMethodInfo
    ResolveMenuitemMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMenuitemMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMenuitemMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMenuitemMethod "sendAboutToShow" o = MenuitemSendAboutToShowMethodInfo
    ResolveMenuitemMethod "showToUser" o = MenuitemShowToUserMethodInfo
    ResolveMenuitemMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMenuitemMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMenuitemMethod "takeChildren" o = MenuitemTakeChildrenMethodInfo
    ResolveMenuitemMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMenuitemMethod "unparent" o = MenuitemUnparentMethodInfo
    ResolveMenuitemMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMenuitemMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMenuitemMethod "getChildren" o = MenuitemGetChildrenMethodInfo
    ResolveMenuitemMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMenuitemMethod "getId" o = MenuitemGetIdMethodInfo
    ResolveMenuitemMethod "getParent" o = MenuitemGetParentMethodInfo
    ResolveMenuitemMethod "getPosition" o = MenuitemGetPositionMethodInfo
    ResolveMenuitemMethod "getPositionRealized" o = MenuitemGetPositionRealizedMethodInfo
    ResolveMenuitemMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMenuitemMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMenuitemMethod "getRoot" o = MenuitemGetRootMethodInfo
    ResolveMenuitemMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMenuitemMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMenuitemMethod "setParent" o = MenuitemSetParentMethodInfo
    ResolveMenuitemMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMenuitemMethod "setRoot" o = MenuitemSetRootMethodInfo
    ResolveMenuitemMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMenuitemMethod t Menuitem, O.OverloadedMethod info Menuitem p) => OL.IsLabel t (Menuitem -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveMenuitemMethod t Menuitem, O.OverloadedMethod info Menuitem p, R.HasField t Menuitem p) => R.HasField t Menuitem p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveMenuitemMethod t Menuitem, O.OverloadedMethodInfo info Menuitem) => OL.IsLabel t (O.MethodProxy info Menuitem) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal Menuitem::about-to-show
-- | Emitted when the submenu for this item
-- 		is about to be shown
type MenuitemAboutToShowCallback =
    IO Bool

type C_MenuitemAboutToShowCallback =
    Ptr Menuitem ->                         -- object
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_MenuitemAboutToShowCallback`.
foreign import ccall "wrapper"
    mk_MenuitemAboutToShowCallback :: C_MenuitemAboutToShowCallback -> IO (FunPtr C_MenuitemAboutToShowCallback)

wrap_MenuitemAboutToShowCallback :: 
    GObject a => (a -> MenuitemAboutToShowCallback) ->
    C_MenuitemAboutToShowCallback
wrap_MenuitemAboutToShowCallback :: forall a.
GObject a =>
(a -> MenuitemAboutToShowCallback) -> C_MenuitemAboutToShowCallback
wrap_MenuitemAboutToShowCallback a -> MenuitemAboutToShowCallback
gi'cb Ptr Menuitem
gi'selfPtr Ptr ()
_ = do
    Bool
result <- Ptr Menuitem
-> (Menuitem -> MenuitemAboutToShowCallback)
-> MenuitemAboutToShowCallback
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Menuitem
gi'selfPtr ((Menuitem -> MenuitemAboutToShowCallback)
 -> MenuitemAboutToShowCallback)
-> (Menuitem -> MenuitemAboutToShowCallback)
-> MenuitemAboutToShowCallback
forall a b. (a -> b) -> a -> b
$ \Menuitem
gi'self -> a -> MenuitemAboutToShowCallback
gi'cb (Menuitem -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Menuitem
gi'self) 
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [aboutToShow](#signal:aboutToShow) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menuitem #aboutToShow callback
-- @
-- 
-- 
onMenuitemAboutToShow :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemAboutToShowCallback) -> m SignalHandlerId
onMenuitemAboutToShow :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemAboutToShowCallback) -> m SignalHandlerId
onMenuitemAboutToShow a
obj (?self::a) => MenuitemAboutToShowCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemAboutToShowCallback
wrapped a
self = let ?self = a
?self::a
self in MenuitemAboutToShowCallback
(?self::a) => MenuitemAboutToShowCallback
cb
    let wrapped' :: C_MenuitemAboutToShowCallback
wrapped' = (a -> MenuitemAboutToShowCallback) -> C_MenuitemAboutToShowCallback
forall a.
GObject a =>
(a -> MenuitemAboutToShowCallback) -> C_MenuitemAboutToShowCallback
wrap_MenuitemAboutToShowCallback a -> MenuitemAboutToShowCallback
wrapped
    FunPtr C_MenuitemAboutToShowCallback
wrapped'' <- C_MenuitemAboutToShowCallback
-> IO (FunPtr C_MenuitemAboutToShowCallback)
mk_MenuitemAboutToShowCallback C_MenuitemAboutToShowCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemAboutToShowCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"about-to-show" FunPtr C_MenuitemAboutToShowCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [aboutToShow](#signal:aboutToShow) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menuitem #aboutToShow callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMenuitemAboutToShow :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemAboutToShowCallback) -> m SignalHandlerId
afterMenuitemAboutToShow :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemAboutToShowCallback) -> m SignalHandlerId
afterMenuitemAboutToShow a
obj (?self::a) => MenuitemAboutToShowCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemAboutToShowCallback
wrapped a
self = let ?self = a
?self::a
self in MenuitemAboutToShowCallback
(?self::a) => MenuitemAboutToShowCallback
cb
    let wrapped' :: C_MenuitemAboutToShowCallback
wrapped' = (a -> MenuitemAboutToShowCallback) -> C_MenuitemAboutToShowCallback
forall a.
GObject a =>
(a -> MenuitemAboutToShowCallback) -> C_MenuitemAboutToShowCallback
wrap_MenuitemAboutToShowCallback a -> MenuitemAboutToShowCallback
wrapped
    FunPtr C_MenuitemAboutToShowCallback
wrapped'' <- C_MenuitemAboutToShowCallback
-> IO (FunPtr C_MenuitemAboutToShowCallback)
mk_MenuitemAboutToShowCallback C_MenuitemAboutToShowCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemAboutToShowCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"about-to-show" FunPtr C_MenuitemAboutToShowCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MenuitemAboutToShowSignalInfo
instance SignalInfo MenuitemAboutToShowSignalInfo where
    type HaskellCallbackType MenuitemAboutToShowSignalInfo = MenuitemAboutToShowCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuitemAboutToShowCallback cb
        cb'' <- mk_MenuitemAboutToShowCallback cb'
        connectSignalFunPtr obj "about-to-show" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem::about-to-show"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#g:signal:aboutToShow"})

#endif

-- signal Menuitem::child-added
-- | Signaled when the child menuitem has been added to
-- 		the parent.
type MenuitemChildAddedCallback =
    GObject.Object.Object
    -- ^ /@arg1@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' which is the child.
    -> Word32
    -- ^ /@arg2@/: The position that the child is being added in.
    -> IO ()

type C_MenuitemChildAddedCallback =
    Ptr Menuitem ->                         -- object
    Ptr GObject.Object.Object ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_MenuitemChildAddedCallback`.
foreign import ccall "wrapper"
    mk_MenuitemChildAddedCallback :: C_MenuitemChildAddedCallback -> IO (FunPtr C_MenuitemChildAddedCallback)

wrap_MenuitemChildAddedCallback :: 
    GObject a => (a -> MenuitemChildAddedCallback) ->
    C_MenuitemChildAddedCallback
wrap_MenuitemChildAddedCallback :: forall a.
GObject a =>
(a -> MenuitemChildAddedCallback) -> C_MenuitemChildAddedCallback
wrap_MenuitemChildAddedCallback a -> MenuitemChildAddedCallback
gi'cb Ptr Menuitem
gi'selfPtr Ptr Object
arg1 Word32
arg2 Ptr ()
_ = do
    Object
arg1' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
arg1
    Ptr Menuitem -> (Menuitem -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Menuitem
gi'selfPtr ((Menuitem -> IO ()) -> IO ()) -> (Menuitem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Menuitem
gi'self -> a -> MenuitemChildAddedCallback
gi'cb (Menuitem -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Menuitem
gi'self)  Object
arg1' Word32
arg2


-- | Connect a signal handler for the [childAdded](#signal:childAdded) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menuitem #childAdded callback
-- @
-- 
-- 
onMenuitemChildAdded :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemChildAddedCallback) -> m SignalHandlerId
onMenuitemChildAdded :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemChildAddedCallback) -> m SignalHandlerId
onMenuitemChildAdded a
obj (?self::a) => MenuitemChildAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemChildAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemChildAddedCallback
MenuitemChildAddedCallback
cb
    let wrapped' :: C_MenuitemChildAddedCallback
wrapped' = (a -> MenuitemChildAddedCallback) -> C_MenuitemChildAddedCallback
forall a.
GObject a =>
(a -> MenuitemChildAddedCallback) -> C_MenuitemChildAddedCallback
wrap_MenuitemChildAddedCallback a -> MenuitemChildAddedCallback
wrapped
    FunPtr C_MenuitemChildAddedCallback
wrapped'' <- C_MenuitemChildAddedCallback
-> IO (FunPtr C_MenuitemChildAddedCallback)
mk_MenuitemChildAddedCallback C_MenuitemChildAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemChildAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"child-added" FunPtr C_MenuitemChildAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [childAdded](#signal:childAdded) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menuitem #childAdded callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMenuitemChildAdded :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemChildAddedCallback) -> m SignalHandlerId
afterMenuitemChildAdded :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemChildAddedCallback) -> m SignalHandlerId
afterMenuitemChildAdded a
obj (?self::a) => MenuitemChildAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemChildAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemChildAddedCallback
MenuitemChildAddedCallback
cb
    let wrapped' :: C_MenuitemChildAddedCallback
wrapped' = (a -> MenuitemChildAddedCallback) -> C_MenuitemChildAddedCallback
forall a.
GObject a =>
(a -> MenuitemChildAddedCallback) -> C_MenuitemChildAddedCallback
wrap_MenuitemChildAddedCallback a -> MenuitemChildAddedCallback
wrapped
    FunPtr C_MenuitemChildAddedCallback
wrapped'' <- C_MenuitemChildAddedCallback
-> IO (FunPtr C_MenuitemChildAddedCallback)
mk_MenuitemChildAddedCallback C_MenuitemChildAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemChildAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"child-added" FunPtr C_MenuitemChildAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MenuitemChildAddedSignalInfo
instance SignalInfo MenuitemChildAddedSignalInfo where
    type HaskellCallbackType MenuitemChildAddedSignalInfo = MenuitemChildAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuitemChildAddedCallback cb
        cb'' <- mk_MenuitemChildAddedCallback cb'
        connectSignalFunPtr obj "child-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem::child-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#g:signal:childAdded"})

#endif

-- signal Menuitem::child-moved
-- | Signaled when the child menuitem has had its location
-- 		in the list change.
type MenuitemChildMovedCallback =
    GObject.Object.Object
    -- ^ /@arg1@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' which is the child.
    -> Word32
    -- ^ /@arg2@/: The position that the child is being moved to.
    -> Word32
    -- ^ /@arg3@/: The position that the child is was in.
    -> IO ()

type C_MenuitemChildMovedCallback =
    Ptr Menuitem ->                         -- object
    Ptr GObject.Object.Object ->
    Word32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_MenuitemChildMovedCallback`.
foreign import ccall "wrapper"
    mk_MenuitemChildMovedCallback :: C_MenuitemChildMovedCallback -> IO (FunPtr C_MenuitemChildMovedCallback)

wrap_MenuitemChildMovedCallback :: 
    GObject a => (a -> MenuitemChildMovedCallback) ->
    C_MenuitemChildMovedCallback
wrap_MenuitemChildMovedCallback :: forall a.
GObject a =>
(a -> MenuitemChildMovedCallback) -> C_MenuitemChildMovedCallback
wrap_MenuitemChildMovedCallback a -> MenuitemChildMovedCallback
gi'cb Ptr Menuitem
gi'selfPtr Ptr Object
arg1 Word32
arg2 Word32
arg3 Ptr ()
_ = do
    Object
arg1' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
arg1
    Ptr Menuitem -> (Menuitem -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Menuitem
gi'selfPtr ((Menuitem -> IO ()) -> IO ()) -> (Menuitem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Menuitem
gi'self -> a -> MenuitemChildMovedCallback
gi'cb (Menuitem -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Menuitem
gi'self)  Object
arg1' Word32
arg2 Word32
arg3


-- | Connect a signal handler for the [childMoved](#signal:childMoved) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menuitem #childMoved callback
-- @
-- 
-- 
onMenuitemChildMoved :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemChildMovedCallback) -> m SignalHandlerId
onMenuitemChildMoved :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemChildMovedCallback) -> m SignalHandlerId
onMenuitemChildMoved a
obj (?self::a) => MenuitemChildMovedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemChildMovedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemChildMovedCallback
MenuitemChildMovedCallback
cb
    let wrapped' :: C_MenuitemChildMovedCallback
wrapped' = (a -> MenuitemChildMovedCallback) -> C_MenuitemChildMovedCallback
forall a.
GObject a =>
(a -> MenuitemChildMovedCallback) -> C_MenuitemChildMovedCallback
wrap_MenuitemChildMovedCallback a -> MenuitemChildMovedCallback
wrapped
    FunPtr C_MenuitemChildMovedCallback
wrapped'' <- C_MenuitemChildMovedCallback
-> IO (FunPtr C_MenuitemChildMovedCallback)
mk_MenuitemChildMovedCallback C_MenuitemChildMovedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemChildMovedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"child-moved" FunPtr C_MenuitemChildMovedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [childMoved](#signal:childMoved) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menuitem #childMoved callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMenuitemChildMoved :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemChildMovedCallback) -> m SignalHandlerId
afterMenuitemChildMoved :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemChildMovedCallback) -> m SignalHandlerId
afterMenuitemChildMoved a
obj (?self::a) => MenuitemChildMovedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemChildMovedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemChildMovedCallback
MenuitemChildMovedCallback
cb
    let wrapped' :: C_MenuitemChildMovedCallback
wrapped' = (a -> MenuitemChildMovedCallback) -> C_MenuitemChildMovedCallback
forall a.
GObject a =>
(a -> MenuitemChildMovedCallback) -> C_MenuitemChildMovedCallback
wrap_MenuitemChildMovedCallback a -> MenuitemChildMovedCallback
wrapped
    FunPtr C_MenuitemChildMovedCallback
wrapped'' <- C_MenuitemChildMovedCallback
-> IO (FunPtr C_MenuitemChildMovedCallback)
mk_MenuitemChildMovedCallback C_MenuitemChildMovedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemChildMovedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"child-moved" FunPtr C_MenuitemChildMovedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MenuitemChildMovedSignalInfo
instance SignalInfo MenuitemChildMovedSignalInfo where
    type HaskellCallbackType MenuitemChildMovedSignalInfo = MenuitemChildMovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuitemChildMovedCallback cb
        cb'' <- mk_MenuitemChildMovedCallback cb'
        connectSignalFunPtr obj "child-moved" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem::child-moved"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#g:signal:childMoved"})

#endif

-- signal Menuitem::child-removed
-- | Signaled when the child menuitem has been requested to
-- 		be removed from the parent.  This signal is called when
-- 		it has been removed from the list but not yet had
-- 		@/g_object_unref/@ called on it.
type MenuitemChildRemovedCallback =
    GObject.Object.Object
    -- ^ /@arg1@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' which was the child.
    -> IO ()

type C_MenuitemChildRemovedCallback =
    Ptr Menuitem ->                         -- object
    Ptr GObject.Object.Object ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_MenuitemChildRemovedCallback`.
foreign import ccall "wrapper"
    mk_MenuitemChildRemovedCallback :: C_MenuitemChildRemovedCallback -> IO (FunPtr C_MenuitemChildRemovedCallback)

wrap_MenuitemChildRemovedCallback :: 
    GObject a => (a -> MenuitemChildRemovedCallback) ->
    C_MenuitemChildRemovedCallback
wrap_MenuitemChildRemovedCallback :: forall a.
GObject a =>
(a -> MenuitemChildRemovedCallback)
-> C_MenuitemChildRemovedCallback
wrap_MenuitemChildRemovedCallback a -> MenuitemChildRemovedCallback
gi'cb Ptr Menuitem
gi'selfPtr Ptr Object
arg1 Ptr ()
_ = do
    Object
arg1' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
arg1
    Ptr Menuitem -> (Menuitem -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Menuitem
gi'selfPtr ((Menuitem -> IO ()) -> IO ()) -> (Menuitem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Menuitem
gi'self -> a -> MenuitemChildRemovedCallback
gi'cb (Menuitem -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Menuitem
gi'self)  Object
arg1'


-- | Connect a signal handler for the [childRemoved](#signal:childRemoved) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menuitem #childRemoved callback
-- @
-- 
-- 
onMenuitemChildRemoved :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemChildRemovedCallback) -> m SignalHandlerId
onMenuitemChildRemoved :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemChildRemovedCallback)
-> m SignalHandlerId
onMenuitemChildRemoved a
obj (?self::a) => MenuitemChildRemovedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemChildRemovedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemChildRemovedCallback
MenuitemChildRemovedCallback
cb
    let wrapped' :: C_MenuitemChildRemovedCallback
wrapped' = (a -> MenuitemChildRemovedCallback)
-> C_MenuitemChildRemovedCallback
forall a.
GObject a =>
(a -> MenuitemChildRemovedCallback)
-> C_MenuitemChildRemovedCallback
wrap_MenuitemChildRemovedCallback a -> MenuitemChildRemovedCallback
wrapped
    FunPtr C_MenuitemChildRemovedCallback
wrapped'' <- C_MenuitemChildRemovedCallback
-> IO (FunPtr C_MenuitemChildRemovedCallback)
mk_MenuitemChildRemovedCallback C_MenuitemChildRemovedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemChildRemovedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"child-removed" FunPtr C_MenuitemChildRemovedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [childRemoved](#signal:childRemoved) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menuitem #childRemoved callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMenuitemChildRemoved :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemChildRemovedCallback) -> m SignalHandlerId
afterMenuitemChildRemoved :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemChildRemovedCallback)
-> m SignalHandlerId
afterMenuitemChildRemoved a
obj (?self::a) => MenuitemChildRemovedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemChildRemovedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemChildRemovedCallback
MenuitemChildRemovedCallback
cb
    let wrapped' :: C_MenuitemChildRemovedCallback
wrapped' = (a -> MenuitemChildRemovedCallback)
-> C_MenuitemChildRemovedCallback
forall a.
GObject a =>
(a -> MenuitemChildRemovedCallback)
-> C_MenuitemChildRemovedCallback
wrap_MenuitemChildRemovedCallback a -> MenuitemChildRemovedCallback
wrapped
    FunPtr C_MenuitemChildRemovedCallback
wrapped'' <- C_MenuitemChildRemovedCallback
-> IO (FunPtr C_MenuitemChildRemovedCallback)
mk_MenuitemChildRemovedCallback C_MenuitemChildRemovedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemChildRemovedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"child-removed" FunPtr C_MenuitemChildRemovedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MenuitemChildRemovedSignalInfo
instance SignalInfo MenuitemChildRemovedSignalInfo where
    type HaskellCallbackType MenuitemChildRemovedSignalInfo = MenuitemChildRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuitemChildRemovedCallback cb
        cb'' <- mk_MenuitemChildRemovedCallback cb'
        connectSignalFunPtr obj "child-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem::child-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#g:signal:childRemoved"})

#endif

-- signal Menuitem::event
-- | Emitted when an event is passed through.  The event is signalled
-- 		after handle_event is called.
type MenuitemEventCallback =
    T.Text
    -- ^ /@arg1@/: Name of the event
    -> GVariant
    -- ^ /@arg2@/: Information passed along with the event
    -> Word32
    -- ^ /@arg3@/: X11 timestamp of when the event happened
    -> IO Bool

type C_MenuitemEventCallback =
    Ptr Menuitem ->                         -- object
    CString ->
    Ptr GVariant ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_MenuitemEventCallback`.
foreign import ccall "wrapper"
    mk_MenuitemEventCallback :: C_MenuitemEventCallback -> IO (FunPtr C_MenuitemEventCallback)

wrap_MenuitemEventCallback :: 
    GObject a => (a -> MenuitemEventCallback) ->
    C_MenuitemEventCallback
wrap_MenuitemEventCallback :: forall a.
GObject a =>
(a -> MenuitemEventCallback) -> C_MenuitemEventCallback
wrap_MenuitemEventCallback a -> MenuitemEventCallback
gi'cb Ptr Menuitem
gi'selfPtr CString
arg1 Ptr GVariant
arg2 Word32
arg3 Ptr ()
_ = do
    Text
arg1' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
arg1
    GVariant
arg2' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
arg2
    Bool
result <- Ptr Menuitem
-> (Menuitem -> MenuitemAboutToShowCallback)
-> MenuitemAboutToShowCallback
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Menuitem
gi'selfPtr ((Menuitem -> MenuitemAboutToShowCallback)
 -> MenuitemAboutToShowCallback)
-> (Menuitem -> MenuitemAboutToShowCallback)
-> MenuitemAboutToShowCallback
forall a b. (a -> b) -> a -> b
$ \Menuitem
gi'self -> a -> MenuitemEventCallback
gi'cb (Menuitem -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Menuitem
gi'self)  Text
arg1' GVariant
arg2' Word32
arg3
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [event](#signal:event) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menuitem #event callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@event::detail@” instead.
-- 
onMenuitemEvent :: (IsMenuitem a, MonadIO m) => a -> P.Maybe T.Text -> ((?self :: a) => MenuitemEventCallback) -> m SignalHandlerId
onMenuitemEvent :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> Maybe Text
-> ((?self::a) => MenuitemEventCallback)
-> m SignalHandlerId
onMenuitemEvent a
obj Maybe Text
detail (?self::a) => MenuitemEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemEventCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemEventCallback
MenuitemEventCallback
cb
    let wrapped' :: C_MenuitemEventCallback
wrapped' = (a -> MenuitemEventCallback) -> C_MenuitemEventCallback
forall a.
GObject a =>
(a -> MenuitemEventCallback) -> C_MenuitemEventCallback
wrap_MenuitemEventCallback a -> MenuitemEventCallback
wrapped
    FunPtr C_MenuitemEventCallback
wrapped'' <- C_MenuitemEventCallback -> IO (FunPtr C_MenuitemEventCallback)
mk_MenuitemEventCallback C_MenuitemEventCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"event" FunPtr C_MenuitemEventCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
detail

-- | Connect a signal handler for the [event](#signal:event) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menuitem #event callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@event::detail@” instead.
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMenuitemEvent :: (IsMenuitem a, MonadIO m) => a -> P.Maybe T.Text -> ((?self :: a) => MenuitemEventCallback) -> m SignalHandlerId
afterMenuitemEvent :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> Maybe Text
-> ((?self::a) => MenuitemEventCallback)
-> m SignalHandlerId
afterMenuitemEvent a
obj Maybe Text
detail (?self::a) => MenuitemEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemEventCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemEventCallback
MenuitemEventCallback
cb
    let wrapped' :: C_MenuitemEventCallback
wrapped' = (a -> MenuitemEventCallback) -> C_MenuitemEventCallback
forall a.
GObject a =>
(a -> MenuitemEventCallback) -> C_MenuitemEventCallback
wrap_MenuitemEventCallback a -> MenuitemEventCallback
wrapped
    FunPtr C_MenuitemEventCallback
wrapped'' <- C_MenuitemEventCallback -> IO (FunPtr C_MenuitemEventCallback)
mk_MenuitemEventCallback C_MenuitemEventCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"event" FunPtr C_MenuitemEventCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
detail


#if defined(ENABLE_OVERLOADING)
data MenuitemEventSignalInfo
instance SignalInfo MenuitemEventSignalInfo where
    type HaskellCallbackType MenuitemEventSignalInfo = MenuitemEventCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuitemEventCallback cb
        cb'' <- mk_MenuitemEventCallback cb'
        connectSignalFunPtr obj "event" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem::event"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#g:signal:event"})

#endif

-- signal Menuitem::item-activated
-- | Emitted on the objects on the server side when
-- 		they are signaled on the client side.
type MenuitemItemActivatedCallback =
    Word32
    -- ^ /@arg1@/: The timestamp of when it was activated
    -> IO ()

type C_MenuitemItemActivatedCallback =
    Ptr Menuitem ->                         -- object
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_MenuitemItemActivatedCallback`.
foreign import ccall "wrapper"
    mk_MenuitemItemActivatedCallback :: C_MenuitemItemActivatedCallback -> IO (FunPtr C_MenuitemItemActivatedCallback)

wrap_MenuitemItemActivatedCallback :: 
    GObject a => (a -> MenuitemItemActivatedCallback) ->
    C_MenuitemItemActivatedCallback
wrap_MenuitemItemActivatedCallback :: forall a.
GObject a =>
(a -> MenuitemItemActivatedCallback)
-> C_MenuitemItemActivatedCallback
wrap_MenuitemItemActivatedCallback a -> MenuitemItemActivatedCallback
gi'cb Ptr Menuitem
gi'selfPtr Word32
arg1 Ptr ()
_ = do
    Ptr Menuitem -> (Menuitem -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Menuitem
gi'selfPtr ((Menuitem -> IO ()) -> IO ()) -> (Menuitem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Menuitem
gi'self -> a -> MenuitemItemActivatedCallback
gi'cb (Menuitem -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Menuitem
gi'self)  Word32
arg1


-- | Connect a signal handler for the [itemActivated](#signal:itemActivated) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menuitem #itemActivated callback
-- @
-- 
-- 
onMenuitemItemActivated :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemItemActivatedCallback) -> m SignalHandlerId
onMenuitemItemActivated :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemItemActivatedCallback)
-> m SignalHandlerId
onMenuitemItemActivated a
obj (?self::a) => MenuitemItemActivatedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemItemActivatedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemItemActivatedCallback
MenuitemItemActivatedCallback
cb
    let wrapped' :: C_MenuitemItemActivatedCallback
wrapped' = (a -> MenuitemItemActivatedCallback)
-> C_MenuitemItemActivatedCallback
forall a.
GObject a =>
(a -> MenuitemItemActivatedCallback)
-> C_MenuitemItemActivatedCallback
wrap_MenuitemItemActivatedCallback a -> MenuitemItemActivatedCallback
wrapped
    FunPtr C_MenuitemItemActivatedCallback
wrapped'' <- C_MenuitemItemActivatedCallback
-> IO (FunPtr C_MenuitemItemActivatedCallback)
mk_MenuitemItemActivatedCallback C_MenuitemItemActivatedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemItemActivatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"item-activated" FunPtr C_MenuitemItemActivatedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [itemActivated](#signal:itemActivated) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menuitem #itemActivated callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMenuitemItemActivated :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemItemActivatedCallback) -> m SignalHandlerId
afterMenuitemItemActivated :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemItemActivatedCallback)
-> m SignalHandlerId
afterMenuitemItemActivated a
obj (?self::a) => MenuitemItemActivatedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemItemActivatedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemItemActivatedCallback
MenuitemItemActivatedCallback
cb
    let wrapped' :: C_MenuitemItemActivatedCallback
wrapped' = (a -> MenuitemItemActivatedCallback)
-> C_MenuitemItemActivatedCallback
forall a.
GObject a =>
(a -> MenuitemItemActivatedCallback)
-> C_MenuitemItemActivatedCallback
wrap_MenuitemItemActivatedCallback a -> MenuitemItemActivatedCallback
wrapped
    FunPtr C_MenuitemItemActivatedCallback
wrapped'' <- C_MenuitemItemActivatedCallback
-> IO (FunPtr C_MenuitemItemActivatedCallback)
mk_MenuitemItemActivatedCallback C_MenuitemItemActivatedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemItemActivatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"item-activated" FunPtr C_MenuitemItemActivatedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MenuitemItemActivatedSignalInfo
instance SignalInfo MenuitemItemActivatedSignalInfo where
    type HaskellCallbackType MenuitemItemActivatedSignalInfo = MenuitemItemActivatedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuitemItemActivatedCallback cb
        cb'' <- mk_MenuitemItemActivatedCallback cb'
        connectSignalFunPtr obj "item-activated" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem::item-activated"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#g:signal:itemActivated"})

#endif

-- signal Menuitem::property-changed
-- | Emitted everytime a property on a menuitem is either
-- 		updated or added.
type MenuitemPropertyChangedCallback =
    T.Text
    -- ^ /@arg1@/: The name of the property that changed
    -> GVariant
    -- ^ /@arg2@/: The new value of the property
    -> IO ()

type C_MenuitemPropertyChangedCallback =
    Ptr Menuitem ->                         -- object
    CString ->
    Ptr GVariant ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_MenuitemPropertyChangedCallback`.
foreign import ccall "wrapper"
    mk_MenuitemPropertyChangedCallback :: C_MenuitemPropertyChangedCallback -> IO (FunPtr C_MenuitemPropertyChangedCallback)

wrap_MenuitemPropertyChangedCallback :: 
    GObject a => (a -> MenuitemPropertyChangedCallback) ->
    C_MenuitemPropertyChangedCallback
wrap_MenuitemPropertyChangedCallback :: forall a.
GObject a =>
(a -> MenuitemPropertyChangedCallback)
-> C_MenuitemPropertyChangedCallback
wrap_MenuitemPropertyChangedCallback a -> MenuitemPropertyChangedCallback
gi'cb Ptr Menuitem
gi'selfPtr CString
arg1 Ptr GVariant
arg2 Ptr ()
_ = do
    Text
arg1' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
arg1
    GVariant
arg2' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
arg2
    Ptr Menuitem -> (Menuitem -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Menuitem
gi'selfPtr ((Menuitem -> IO ()) -> IO ()) -> (Menuitem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Menuitem
gi'self -> a -> MenuitemPropertyChangedCallback
gi'cb (Menuitem -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Menuitem
gi'self)  Text
arg1' GVariant
arg2'


-- | Connect a signal handler for the [propertyChanged](#signal:propertyChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menuitem #propertyChanged callback
-- @
-- 
-- 
onMenuitemPropertyChanged :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemPropertyChangedCallback) -> m SignalHandlerId
onMenuitemPropertyChanged :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemPropertyChangedCallback)
-> m SignalHandlerId
onMenuitemPropertyChanged a
obj (?self::a) => MenuitemPropertyChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemPropertyChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemPropertyChangedCallback
MenuitemPropertyChangedCallback
cb
    let wrapped' :: C_MenuitemPropertyChangedCallback
wrapped' = (a -> MenuitemPropertyChangedCallback)
-> C_MenuitemPropertyChangedCallback
forall a.
GObject a =>
(a -> MenuitemPropertyChangedCallback)
-> C_MenuitemPropertyChangedCallback
wrap_MenuitemPropertyChangedCallback a -> MenuitemPropertyChangedCallback
wrapped
    FunPtr C_MenuitemPropertyChangedCallback
wrapped'' <- C_MenuitemPropertyChangedCallback
-> IO (FunPtr C_MenuitemPropertyChangedCallback)
mk_MenuitemPropertyChangedCallback C_MenuitemPropertyChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemPropertyChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"property-changed" FunPtr C_MenuitemPropertyChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [propertyChanged](#signal:propertyChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menuitem #propertyChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMenuitemPropertyChanged :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemPropertyChangedCallback) -> m SignalHandlerId
afterMenuitemPropertyChanged :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemPropertyChangedCallback)
-> m SignalHandlerId
afterMenuitemPropertyChanged a
obj (?self::a) => MenuitemPropertyChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemPropertyChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemPropertyChangedCallback
MenuitemPropertyChangedCallback
cb
    let wrapped' :: C_MenuitemPropertyChangedCallback
wrapped' = (a -> MenuitemPropertyChangedCallback)
-> C_MenuitemPropertyChangedCallback
forall a.
GObject a =>
(a -> MenuitemPropertyChangedCallback)
-> C_MenuitemPropertyChangedCallback
wrap_MenuitemPropertyChangedCallback a -> MenuitemPropertyChangedCallback
wrapped
    FunPtr C_MenuitemPropertyChangedCallback
wrapped'' <- C_MenuitemPropertyChangedCallback
-> IO (FunPtr C_MenuitemPropertyChangedCallback)
mk_MenuitemPropertyChangedCallback C_MenuitemPropertyChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemPropertyChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"property-changed" FunPtr C_MenuitemPropertyChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MenuitemPropertyChangedSignalInfo
instance SignalInfo MenuitemPropertyChangedSignalInfo where
    type HaskellCallbackType MenuitemPropertyChangedSignalInfo = MenuitemPropertyChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuitemPropertyChangedCallback cb
        cb'' <- mk_MenuitemPropertyChangedCallback cb'
        connectSignalFunPtr obj "property-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem::property-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#g:signal:propertyChanged"})

#endif

-- signal Menuitem::realized
-- | Emitted when the initial request for properties
-- 		is complete on the item.  If there is a type
-- 		handler configured for the \"type\" parameter
-- 		that will be executed before this is signaled.
type MenuitemRealizedCallback =
    IO ()

type C_MenuitemRealizedCallback =
    Ptr Menuitem ->                         -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_MenuitemRealizedCallback`.
foreign import ccall "wrapper"
    mk_MenuitemRealizedCallback :: C_MenuitemRealizedCallback -> IO (FunPtr C_MenuitemRealizedCallback)

wrap_MenuitemRealizedCallback :: 
    GObject a => (a -> MenuitemRealizedCallback) ->
    C_MenuitemRealizedCallback
wrap_MenuitemRealizedCallback :: forall a. GObject a => (a -> IO ()) -> C_MenuitemRealizedCallback
wrap_MenuitemRealizedCallback a -> IO ()
gi'cb Ptr Menuitem
gi'selfPtr Ptr ()
_ = do
    Ptr Menuitem -> (Menuitem -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Menuitem
gi'selfPtr ((Menuitem -> IO ()) -> IO ()) -> (Menuitem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Menuitem
gi'self -> a -> IO ()
gi'cb (Menuitem -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Menuitem
gi'self) 


-- | Connect a signal handler for the [realized](#signal:realized) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menuitem #realized callback
-- @
-- 
-- 
onMenuitemRealized :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemRealizedCallback) -> m SignalHandlerId
onMenuitemRealized :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMenuitemRealized a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MenuitemRealizedCallback
wrapped' = (a -> IO ()) -> C_MenuitemRealizedCallback
forall a. GObject a => (a -> IO ()) -> C_MenuitemRealizedCallback
wrap_MenuitemRealizedCallback a -> IO ()
wrapped
    FunPtr C_MenuitemRealizedCallback
wrapped'' <- C_MenuitemRealizedCallback
-> IO (FunPtr C_MenuitemRealizedCallback)
mk_MenuitemRealizedCallback C_MenuitemRealizedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemRealizedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"realized" FunPtr C_MenuitemRealizedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [realized](#signal:realized) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menuitem #realized callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMenuitemRealized :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemRealizedCallback) -> m SignalHandlerId
afterMenuitemRealized :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterMenuitemRealized a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MenuitemRealizedCallback
wrapped' = (a -> IO ()) -> C_MenuitemRealizedCallback
forall a. GObject a => (a -> IO ()) -> C_MenuitemRealizedCallback
wrap_MenuitemRealizedCallback a -> IO ()
wrapped
    FunPtr C_MenuitemRealizedCallback
wrapped'' <- C_MenuitemRealizedCallback
-> IO (FunPtr C_MenuitemRealizedCallback)
mk_MenuitemRealizedCallback C_MenuitemRealizedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemRealizedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"realized" FunPtr C_MenuitemRealizedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MenuitemRealizedSignalInfo
instance SignalInfo MenuitemRealizedSignalInfo where
    type HaskellCallbackType MenuitemRealizedSignalInfo = MenuitemRealizedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuitemRealizedCallback cb
        cb'' <- mk_MenuitemRealizedCallback cb'
        connectSignalFunPtr obj "realized" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem::realized"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#g:signal:realized"})

#endif

-- signal Menuitem::show-to-user
-- | Signaled when the application would like the visualization
-- 		of this menu item shown to the user.  This usually requires
-- 		going over the bus to get it done.
type MenuitemShowToUserCallback =
    Word32
    -- ^ /@arg1@/: Timestamp the event happened at
    -> IO ()

type C_MenuitemShowToUserCallback =
    Ptr Menuitem ->                         -- object
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_MenuitemShowToUserCallback`.
foreign import ccall "wrapper"
    mk_MenuitemShowToUserCallback :: C_MenuitemShowToUserCallback -> IO (FunPtr C_MenuitemShowToUserCallback)

wrap_MenuitemShowToUserCallback :: 
    GObject a => (a -> MenuitemShowToUserCallback) ->
    C_MenuitemShowToUserCallback
wrap_MenuitemShowToUserCallback :: forall a.
GObject a =>
(a -> MenuitemItemActivatedCallback)
-> C_MenuitemItemActivatedCallback
wrap_MenuitemShowToUserCallback a -> MenuitemItemActivatedCallback
gi'cb Ptr Menuitem
gi'selfPtr Word32
arg1 Ptr ()
_ = do
    Ptr Menuitem -> (Menuitem -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Menuitem
gi'selfPtr ((Menuitem -> IO ()) -> IO ()) -> (Menuitem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Menuitem
gi'self -> a -> MenuitemItemActivatedCallback
gi'cb (Menuitem -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Menuitem
gi'self)  Word32
arg1


-- | Connect a signal handler for the [showToUser](#signal:showToUser) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menuitem #showToUser callback
-- @
-- 
-- 
onMenuitemShowToUser :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemShowToUserCallback) -> m SignalHandlerId
onMenuitemShowToUser :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemItemActivatedCallback)
-> m SignalHandlerId
onMenuitemShowToUser a
obj (?self::a) => MenuitemItemActivatedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemItemActivatedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemItemActivatedCallback
MenuitemItemActivatedCallback
cb
    let wrapped' :: C_MenuitemItemActivatedCallback
wrapped' = (a -> MenuitemItemActivatedCallback)
-> C_MenuitemItemActivatedCallback
forall a.
GObject a =>
(a -> MenuitemItemActivatedCallback)
-> C_MenuitemItemActivatedCallback
wrap_MenuitemShowToUserCallback a -> MenuitemItemActivatedCallback
wrapped
    FunPtr C_MenuitemItemActivatedCallback
wrapped'' <- C_MenuitemItemActivatedCallback
-> IO (FunPtr C_MenuitemItemActivatedCallback)
mk_MenuitemShowToUserCallback C_MenuitemItemActivatedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemItemActivatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"show-to-user" FunPtr C_MenuitemItemActivatedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [showToUser](#signal:showToUser) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menuitem #showToUser callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMenuitemShowToUser :: (IsMenuitem a, MonadIO m) => a -> ((?self :: a) => MenuitemShowToUserCallback) -> m SignalHandlerId
afterMenuitemShowToUser :: forall a (m :: * -> *).
(IsMenuitem a, MonadIO m) =>
a
-> ((?self::a) => MenuitemItemActivatedCallback)
-> m SignalHandlerId
afterMenuitemShowToUser a
obj (?self::a) => MenuitemItemActivatedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MenuitemItemActivatedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MenuitemItemActivatedCallback
MenuitemItemActivatedCallback
cb
    let wrapped' :: C_MenuitemItemActivatedCallback
wrapped' = (a -> MenuitemItemActivatedCallback)
-> C_MenuitemItemActivatedCallback
forall a.
GObject a =>
(a -> MenuitemItemActivatedCallback)
-> C_MenuitemItemActivatedCallback
wrap_MenuitemShowToUserCallback a -> MenuitemItemActivatedCallback
wrapped
    FunPtr C_MenuitemItemActivatedCallback
wrapped'' <- C_MenuitemItemActivatedCallback
-> IO (FunPtr C_MenuitemItemActivatedCallback)
mk_MenuitemShowToUserCallback C_MenuitemItemActivatedCallback
wrapped'
    a
-> Text
-> FunPtr C_MenuitemItemActivatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"show-to-user" FunPtr C_MenuitemItemActivatedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MenuitemShowToUserSignalInfo
instance SignalInfo MenuitemShowToUserSignalInfo where
    type HaskellCallbackType MenuitemShowToUserSignalInfo = MenuitemShowToUserCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuitemShowToUserCallback cb
        cb'' <- mk_MenuitemShowToUserCallback cb'
        connectSignalFunPtr obj "show-to-user" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem::show-to-user"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#g:signal:showToUser"})

#endif

-- VVV Prop "id"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' menuitem #id
-- @
getMenuitemId :: (MonadIO m, IsMenuitem o) => o -> m Int32
getMenuitemId :: forall (m :: * -> *) o. (MonadIO m, IsMenuitem o) => o -> m Int32
getMenuitemId o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"id"

-- | Construct a `GValueConstruct` with valid value for the “@id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuitemId :: (IsMenuitem o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructMenuitemId :: forall o (m :: * -> *).
(IsMenuitem o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructMenuitemId Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"id" Int32
val

#if defined(ENABLE_OVERLOADING)
data MenuitemIdPropertyInfo
instance AttrInfo MenuitemIdPropertyInfo where
    type AttrAllowedOps MenuitemIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MenuitemIdPropertyInfo = IsMenuitem
    type AttrSetTypeConstraint MenuitemIdPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint MenuitemIdPropertyInfo = (~) Int32
    type AttrTransferType MenuitemIdPropertyInfo = Int32
    type AttrGetType MenuitemIdPropertyInfo = Int32
    type AttrLabel MenuitemIdPropertyInfo = "id"
    type AttrOrigin MenuitemIdPropertyInfo = Menuitem
    attrGet = getMenuitemId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuitemId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.id"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#g:attr:id"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Menuitem
type instance O.AttributeList Menuitem = MenuitemAttributeList
type MenuitemAttributeList = ('[ '("id", MenuitemIdPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
menuitemId :: AttrLabelProxy "id"
menuitemId = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Menuitem = MenuitemSignalList
type MenuitemSignalList = ('[ '("aboutToShow", MenuitemAboutToShowSignalInfo), '("childAdded", MenuitemChildAddedSignalInfo), '("childMoved", MenuitemChildMovedSignalInfo), '("childRemoved", MenuitemChildRemovedSignalInfo), '("event", MenuitemEventSignalInfo), '("itemActivated", MenuitemItemActivatedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("propertyChanged", MenuitemPropertyChangedSignalInfo), '("realized", MenuitemRealizedSignalInfo), '("showToUser", MenuitemShowToUserSignalInfo)] :: [(Symbol, *)])

#endif

-- method Menuitem::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" })
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_new" dbusmenu_menuitem_new :: 
    IO (Ptr Menuitem)

-- | Create a new t'GI.Dbusmenu.Objects.Menuitem.Menuitem' with all default values.
menuitemNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Menuitem
    -- ^ __Returns:__ A newly allocated t'GI.Dbusmenu.Objects.Menuitem.Menuitem'.
menuitemNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Menuitem
menuitemNew  = IO Menuitem -> m Menuitem
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Menuitem -> m Menuitem) -> IO Menuitem -> m Menuitem
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
result <- IO (Ptr Menuitem)
dbusmenu_menuitem_new
    Text -> Ptr Menuitem -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"menuitemNew" Ptr Menuitem
result
    Menuitem
result' <- ((ManagedPtr Menuitem -> Menuitem) -> Ptr Menuitem -> IO Menuitem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Menuitem -> Menuitem
Menuitem) Ptr Menuitem
result
    Menuitem -> IO Menuitem
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Menuitem
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Menuitem::new_with_id
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ID to use for this menuitem"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" })
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_new_with_id" dbusmenu_menuitem_new_with_id :: 
    Int32 ->                                -- id : TBasicType TInt
    IO (Ptr Menuitem)

-- | This creates a blank t'GI.Dbusmenu.Objects.Menuitem.Menuitem' with a specific ID.
menuitemNewWithId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@id@/: ID to use for this menuitem
    -> m Menuitem
    -- ^ __Returns:__ A newly allocated t'GI.Dbusmenu.Objects.Menuitem.Menuitem'.
menuitemNewWithId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> m Menuitem
menuitemNewWithId Int32
id = IO Menuitem -> m Menuitem
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Menuitem -> m Menuitem) -> IO Menuitem -> m Menuitem
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
result <- Int32 -> IO (Ptr Menuitem)
dbusmenu_menuitem_new_with_id Int32
id
    Text -> Ptr Menuitem -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"menuitemNewWithId" Ptr Menuitem
result
    Menuitem
result' <- ((ManagedPtr Menuitem -> Menuitem) -> Ptr Menuitem -> IO Menuitem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Menuitem -> Menuitem
Menuitem) Ptr Menuitem
result
    Menuitem -> IO Menuitem
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Menuitem
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Menuitem::child_add_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem that we're adding the child @child to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to make a child of @mi."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Where in @mi object's list of chidren @child should be placed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_child_add_position" dbusmenu_menuitem_child_add_position :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Ptr Menuitem ->                         -- child : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Word32 ->                               -- position : TBasicType TUInt
    IO CInt

-- | Puts /@child@/ in the list of children for /@mi@/ at the location
-- specified in /@position@/.  If there is not enough entires available
-- then /@child@/ will be placed at the end of the list.
menuitemChildAddPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' that we\'re adding the child /@child@/ to.
    -> b
    -- ^ /@child@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to make a child of /@mi@/.
    -> Word32
    -- ^ /@position@/: Where in /@mi@/ object\'s list of chidren /@child@/ should be placed.
    -> m Bool
    -- ^ __Returns:__ Whether /@child@/ was added successfully.
menuitemChildAddPosition :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
a -> b -> Word32 -> m Bool
menuitemChildAddPosition a
mi b
child Word32
position = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
child' <- b -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    CInt
result <- Ptr Menuitem -> Ptr Menuitem -> Word32 -> IO CInt
dbusmenu_menuitem_child_add_position Ptr Menuitem
mi' Ptr Menuitem
child' Word32
position
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemChildAddPositionMethodInfo
instance (signature ~ (b -> Word32 -> m Bool), MonadIO m, IsMenuitem a, IsMenuitem b) => O.OverloadedMethod MenuitemChildAddPositionMethodInfo a signature where
    overloadedMethod = menuitemChildAddPosition

instance O.OverloadedMethodInfo MenuitemChildAddPositionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemChildAddPosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemChildAddPosition"
        })


#endif

-- method Menuitem::child_append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem which will become a new parent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenMenuitem that will be a child"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_child_append" dbusmenu_menuitem_child_append :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Ptr Menuitem ->                         -- child : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO CInt

-- | This function adds /@child@/ to the list of children on /@mi@/ at
-- the end of that list.
menuitemChildAppend ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' which will become a new parent
    -> b
    -- ^ /@child@/: The @/DbusmenMenuitem/@ that will be a child
    -> m Bool
    -- ^ __Returns:__ Whether the child has been added successfully.
menuitemChildAppend :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
a -> b -> m Bool
menuitemChildAppend a
mi b
child = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
child' <- b -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    CInt
result <- Ptr Menuitem -> Ptr Menuitem -> IO CInt
dbusmenu_menuitem_child_append Ptr Menuitem
mi' Ptr Menuitem
child'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemChildAppendMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsMenuitem a, IsMenuitem b) => O.OverloadedMethod MenuitemChildAppendMethodInfo a signature where
    overloadedMethod = menuitemChildAppend

instance O.OverloadedMethodInfo MenuitemChildAppendMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemChildAppend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemChildAppend"
        })


#endif

-- method Menuitem::child_delete
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem which has @child as a child"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The child #DbusmenuMenuitem that you want to no longer\n    be a child of @mi."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_child_delete" dbusmenu_menuitem_child_delete :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Ptr Menuitem ->                         -- child : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO CInt

-- | This function removes /@child@/ from the children list of /@mi@/.  It does
-- not call @/g_object_unref/@ on /@child@/.
menuitemChildDelete ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' which has /@child@/ as a child
    -> b
    -- ^ /@child@/: The child t'GI.Dbusmenu.Objects.Menuitem.Menuitem' that you want to no longer
    --     be a child of /@mi@/.
    -> m Bool
    -- ^ __Returns:__ If we were able to delete /@child@/.
menuitemChildDelete :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
a -> b -> m Bool
menuitemChildDelete a
mi b
child = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
child' <- b -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    CInt
result <- Ptr Menuitem -> Ptr Menuitem -> IO CInt
dbusmenu_menuitem_child_delete Ptr Menuitem
mi' Ptr Menuitem
child'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemChildDeleteMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsMenuitem a, IsMenuitem b) => O.OverloadedMethod MenuitemChildDeleteMethodInfo a signature where
    overloadedMethod = menuitemChildDelete

instance O.OverloadedMethodInfo MenuitemChildDeleteMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemChildDelete",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemChildDelete"
        })


#endif

-- method Menuitem::child_find
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem who's children to look on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The ID of the child that we're looking for."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" })
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_child_find" dbusmenu_menuitem_child_find :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Int32 ->                                -- id : TBasicType TInt
    IO (Ptr Menuitem)

-- | Search the children of /@mi@/ to find one with the ID of /@id@/.
-- If it doesn\'t exist then we return @/NULL/@.
menuitemChildFind ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' who\'s children to look on
    -> Int32
    -- ^ /@id@/: The ID of the child that we\'re looking for.
    -> m (Maybe Menuitem)
    -- ^ __Returns:__ The menu item with the ID /@id@/ or @/NULL/@ if it
    --    can\'t be found.
menuitemChildFind :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Int32 -> m (Maybe Menuitem)
menuitemChildFind a
mi Int32
id = IO (Maybe Menuitem) -> m (Maybe Menuitem)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Menuitem) -> m (Maybe Menuitem))
-> IO (Maybe Menuitem) -> m (Maybe Menuitem)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
result <- Ptr Menuitem -> Int32 -> IO (Ptr Menuitem)
dbusmenu_menuitem_child_find Ptr Menuitem
mi' Int32
id
    Maybe Menuitem
maybeResult <- Ptr Menuitem
-> (Ptr Menuitem -> IO Menuitem) -> IO (Maybe Menuitem)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Menuitem
result ((Ptr Menuitem -> IO Menuitem) -> IO (Maybe Menuitem))
-> (Ptr Menuitem -> IO Menuitem) -> IO (Maybe Menuitem)
forall a b. (a -> b) -> a -> b
$ \Ptr Menuitem
result' -> do
        Menuitem
result'' <- ((ManagedPtr Menuitem -> Menuitem) -> Ptr Menuitem -> IO Menuitem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Menuitem -> Menuitem
Menuitem) Ptr Menuitem
result'
        Menuitem -> IO Menuitem
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Menuitem
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    Maybe Menuitem -> IO (Maybe Menuitem)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Menuitem
maybeResult

#if defined(ENABLE_OVERLOADING)
data MenuitemChildFindMethodInfo
instance (signature ~ (Int32 -> m (Maybe Menuitem)), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemChildFindMethodInfo a signature where
    overloadedMethod = menuitemChildFind

instance O.OverloadedMethodInfo MenuitemChildFindMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemChildFind",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemChildFind"
        })


#endif

-- method Menuitem::child_prepend
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem which will become a new parent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenMenuitem that will be a child"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_child_prepend" dbusmenu_menuitem_child_prepend :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Ptr Menuitem ->                         -- child : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO CInt

-- | This function adds /@child@/ to the list of children on /@mi@/ at
-- the beginning of that list.
menuitemChildPrepend ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' which will become a new parent
    -> b
    -- ^ /@child@/: The @/DbusmenMenuitem/@ that will be a child
    -> m Bool
    -- ^ __Returns:__ Whether the child has been added successfully.
menuitemChildPrepend :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
a -> b -> m Bool
menuitemChildPrepend a
mi b
child = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
child' <- b -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    CInt
result <- Ptr Menuitem -> Ptr Menuitem -> IO CInt
dbusmenu_menuitem_child_prepend Ptr Menuitem
mi' Ptr Menuitem
child'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemChildPrependMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsMenuitem a, IsMenuitem b) => O.OverloadedMethod MenuitemChildPrependMethodInfo a signature where
    overloadedMethod = menuitemChildPrepend

instance O.OverloadedMethodInfo MenuitemChildPrependMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemChildPrepend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemChildPrepend"
        })


#endif

-- method Menuitem::child_reorder
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem that has children needing realignment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem that is a child needing to be moved"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The position in the list to place it in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_child_reorder" dbusmenu_menuitem_child_reorder :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Ptr Menuitem ->                         -- child : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Word32 ->                               -- position : TBasicType TUInt
    IO CInt

-- | This function moves a child on the list of children.  It is
-- for a child that is already in the list, but simply needs a
-- new location.
menuitemChildReorder ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' that has children needing realignment
    -> b
    -- ^ /@child@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' that is a child needing to be moved
    -> Word32
    -- ^ /@position@/: The position in the list to place it in
    -> m Bool
    -- ^ __Returns:__ Whether the move was successful.
menuitemChildReorder :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
a -> b -> Word32 -> m Bool
menuitemChildReorder a
mi b
child Word32
position = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
child' <- b -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    CInt
result <- Ptr Menuitem -> Ptr Menuitem -> Word32 -> IO CInt
dbusmenu_menuitem_child_reorder Ptr Menuitem
mi' Ptr Menuitem
child' Word32
position
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemChildReorderMethodInfo
instance (signature ~ (b -> Word32 -> m Bool), MonadIO m, IsMenuitem a, IsMenuitem b) => O.OverloadedMethod MenuitemChildReorderMethodInfo a signature where
    overloadedMethod = menuitemChildReorder

instance O.OverloadedMethodInfo MenuitemChildReorderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemChildReorder",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemChildReorder"
        })


#endif

-- method Menuitem::find_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#DbusmenuMenuitem at the top of the tree to search"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ID of the #DbusmenuMenuitem to search for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" })
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_find_id" dbusmenu_menuitem_find_id :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Int32 ->                                -- id : TBasicType TInt
    IO (Ptr Menuitem)

-- | This function searchs the whole tree of children that
-- are attached to /@mi@/.  This could be quite a few nodes, all
-- the way down the tree.  It is a depth first search.
menuitemFindId ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: t'GI.Dbusmenu.Objects.Menuitem.Menuitem' at the top of the tree to search
    -> Int32
    -- ^ /@id@/: ID of the t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to search for
    -> m (Maybe Menuitem)
    -- ^ __Returns:__ The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' with the ID of /@id@/
    -- 	or @/NULL/@ if there isn\'t such a menu item in the tree
    -- 	represented by /@mi@/.
menuitemFindId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Int32 -> m (Maybe Menuitem)
menuitemFindId a
mi Int32
id = IO (Maybe Menuitem) -> m (Maybe Menuitem)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Menuitem) -> m (Maybe Menuitem))
-> IO (Maybe Menuitem) -> m (Maybe Menuitem)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
result <- Ptr Menuitem -> Int32 -> IO (Ptr Menuitem)
dbusmenu_menuitem_find_id Ptr Menuitem
mi' Int32
id
    Maybe Menuitem
maybeResult <- Ptr Menuitem
-> (Ptr Menuitem -> IO Menuitem) -> IO (Maybe Menuitem)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Menuitem
result ((Ptr Menuitem -> IO Menuitem) -> IO (Maybe Menuitem))
-> (Ptr Menuitem -> IO Menuitem) -> IO (Maybe Menuitem)
forall a b. (a -> b) -> a -> b
$ \Ptr Menuitem
result' -> do
        Menuitem
result'' <- ((ManagedPtr Menuitem -> Menuitem) -> Ptr Menuitem -> IO Menuitem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Menuitem -> Menuitem
Menuitem) Ptr Menuitem
result'
        Menuitem -> IO Menuitem
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Menuitem
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    Maybe Menuitem -> IO (Maybe Menuitem)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Menuitem
maybeResult

#if defined(ENABLE_OVERLOADING)
data MenuitemFindIdMethodInfo
instance (signature ~ (Int32 -> m (Maybe Menuitem)), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemFindIdMethodInfo a signature where
    overloadedMethod = menuitemFindId

instance O.OverloadedMethodInfo MenuitemFindIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemFindId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemFindId"
        })


#endif

-- method Menuitem::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenItem to start from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Function to call on every node in the tree"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "User data to pass to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_foreach" dbusmenu_menuitem_foreach :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Ptr () ->                               -- func : TBasicType TPtr
    Ptr () ->                               -- data : TBasicType TPtr
    IO ()

-- | This calls the function /@func@/ on this menu item and all
-- of the children of this item.  And their children.  And
-- their children.  And... you get the point.  It will get
-- called on the whole tree.
menuitemForeach ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The @/DbusmenItem/@ to start from
    -> Ptr ()
    -- ^ /@func@/: Function to call on every node in the tree
    -> Ptr ()
    -- ^ /@data@/: User data to pass to the function
    -> m ()
menuitemForeach :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Ptr () -> Ptr () -> m ()
menuitemForeach a
mi Ptr ()
func Ptr ()
data_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem -> Ptr () -> Ptr () -> IO ()
dbusmenu_menuitem_foreach Ptr Menuitem
mi' Ptr ()
func Ptr ()
data_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuitemForeachMethodInfo
instance (signature ~ (Ptr () -> Ptr () -> m ()), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemForeachMethodInfo a signature where
    overloadedMethod = menuitemForeach

instance O.OverloadedMethodInfo MenuitemForeachMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemForeach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemForeach"
        })


#endif

-- method Menuitem::get_children
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to query."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }))
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_get_children" dbusmenu_menuitem_get_children :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO (Ptr (GList (Ptr Menuitem)))

-- | Returns simply the list of children that this menu item
-- has.  The list is valid until another child related function
-- is called, where it might be changed.
menuitemGetChildren ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to query.
    -> m [Menuitem]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of pointers to t'GI.Dbusmenu.Objects.Menuitem.Menuitem' objects.
menuitemGetChildren :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> m [Menuitem]
menuitemGetChildren a
mi = IO [Menuitem] -> m [Menuitem]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Menuitem] -> m [Menuitem]) -> IO [Menuitem] -> m [Menuitem]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr (GList (Ptr Menuitem))
result <- Ptr Menuitem -> IO (Ptr (GList (Ptr Menuitem)))
dbusmenu_menuitem_get_children Ptr Menuitem
mi'
    [Ptr Menuitem]
result' <- Ptr (GList (Ptr Menuitem)) -> IO [Ptr Menuitem]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Menuitem))
result
    [Menuitem]
result'' <- (Ptr Menuitem -> IO Menuitem) -> [Ptr Menuitem] -> IO [Menuitem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Menuitem -> Menuitem) -> Ptr Menuitem -> IO Menuitem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Menuitem -> Menuitem
Menuitem) [Ptr Menuitem]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    [Menuitem] -> IO [Menuitem]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Menuitem]
result''

#if defined(ENABLE_OVERLOADING)
data MenuitemGetChildrenMethodInfo
instance (signature ~ (m [Menuitem]), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemGetChildrenMethodInfo a signature where
    overloadedMethod = menuitemGetChildren

instance O.OverloadedMethodInfo MenuitemGetChildrenMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemGetChildren",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemGetChildren"
        })


#endif

-- method Menuitem::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to query."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_get_id" dbusmenu_menuitem_get_id :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO Int32

-- | Gets the unique ID for /@mi@/.
menuitemGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to query.
    -> m Int32
    -- ^ __Returns:__ The ID of the /@mi@/.
menuitemGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> m Int32
menuitemGetId a
mi = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Int32
result <- Ptr Menuitem -> IO Int32
dbusmenu_menuitem_get_id Ptr Menuitem
mi'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MenuitemGetIdMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemGetIdMethodInfo a signature where
    overloadedMethod = menuitemGetId

instance O.OverloadedMethodInfo MenuitemGetIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemGetId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemGetId"
        })


#endif

-- method Menuitem::get_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem for which to inspect the parent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" })
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_get_parent" dbusmenu_menuitem_get_parent :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO (Ptr Menuitem)

-- | This function looks up the parent of /@mi@/
menuitemGetParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' for which to inspect the parent
    -> m Menuitem
    -- ^ __Returns:__ The parent of this menu item
menuitemGetParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> m Menuitem
menuitemGetParent a
mi = IO Menuitem -> m Menuitem
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Menuitem -> m Menuitem) -> IO Menuitem -> m Menuitem
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
result <- Ptr Menuitem -> IO (Ptr Menuitem)
dbusmenu_menuitem_get_parent Ptr Menuitem
mi'
    Text -> Ptr Menuitem -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"menuitemGetParent" Ptr Menuitem
result
    Menuitem
result' <- ((ManagedPtr Menuitem -> Menuitem) -> Ptr Menuitem -> IO Menuitem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Menuitem -> Menuitem
Menuitem) Ptr Menuitem
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    Menuitem -> IO Menuitem
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Menuitem
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemGetParentMethodInfo
instance (signature ~ (m Menuitem), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemGetParentMethodInfo a signature where
    overloadedMethod = menuitemGetParent

instance O.OverloadedMethodInfo MenuitemGetParentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemGetParent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemGetParent"
        })


#endif

-- method Menuitem::get_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to find the position of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem who's children contain @mi"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_get_position" dbusmenu_menuitem_get_position :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Ptr Menuitem ->                         -- parent : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO Word32

-- | This function returns the position of the menu item /@mi@/
-- in the children of /@parent@/.  It will return zero if the
-- menu item can\'t be found.
menuitemGetPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to find the position of
    -> b
    -- ^ /@parent@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' who\'s children contain /@mi@/
    -> m Word32
    -- ^ __Returns:__ The position of /@mi@/ in the children of /@parent@/.
menuitemGetPosition :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
a -> b -> m Word32
menuitemGetPosition a
mi b
parent = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
parent' <- b -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
parent
    Word32
result <- Ptr Menuitem -> Ptr Menuitem -> IO Word32
dbusmenu_menuitem_get_position Ptr Menuitem
mi' Ptr Menuitem
parent'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
parent
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data MenuitemGetPositionMethodInfo
instance (signature ~ (b -> m Word32), MonadIO m, IsMenuitem a, IsMenuitem b) => O.OverloadedMethod MenuitemGetPositionMethodInfo a signature where
    overloadedMethod = menuitemGetPosition

instance O.OverloadedMethodInfo MenuitemGetPositionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemGetPosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemGetPosition"
        })


#endif

-- method Menuitem::get_position_realized
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to find the position of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem who's children contain @mi"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_get_position_realized" dbusmenu_menuitem_get_position_realized :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Ptr Menuitem ->                         -- parent : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO Word32

-- | This function is very similar to @/dbusmenu_menuitem_get_position/@
-- except that it only counts in the children that have been realized.
menuitemGetPositionRealized ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to find the position of
    -> b
    -- ^ /@parent@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' who\'s children contain /@mi@/
    -> m Word32
    -- ^ __Returns:__ The position of /@mi@/ in the realized children of /@parent@/.
menuitemGetPositionRealized :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
a -> b -> m Word32
menuitemGetPositionRealized a
mi b
parent = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
parent' <- b -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
parent
    Word32
result <- Ptr Menuitem -> Ptr Menuitem -> IO Word32
dbusmenu_menuitem_get_position_realized Ptr Menuitem
mi' Ptr Menuitem
parent'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
parent
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data MenuitemGetPositionRealizedMethodInfo
instance (signature ~ (b -> m Word32), MonadIO m, IsMenuitem a, IsMenuitem b) => O.OverloadedMethod MenuitemGetPositionRealizedMethodInfo a signature where
    overloadedMethod = menuitemGetPositionRealized

instance O.OverloadedMethodInfo MenuitemGetPositionRealizedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemGetPositionRealized",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemGetPositionRealized"
        })


#endif

-- method Menuitem::get_root
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#DbusmenuMenuitem to see whether it's root"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_get_root" dbusmenu_menuitem_get_root :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO CInt

-- | This function returns the internal value of whether this is a
-- root node or not.
menuitemGetRoot ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to see whether it\'s root
    -> m Bool
    -- ^ __Returns:__ @/TRUE/@ if this is a root node
menuitemGetRoot :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> m Bool
menuitemGetRoot a
mi = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CInt
result <- Ptr Menuitem -> IO CInt
dbusmenu_menuitem_get_root Ptr Menuitem
mi'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemGetRootMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemGetRootMethodInfo a signature where
    overloadedMethod = menuitemGetRoot

instance O.OverloadedMethodInfo MenuitemGetRootMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemGetRoot",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemGetRoot"
        })


#endif

-- method Menuitem::handle_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to send the signal on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The name of the signal"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "variant"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A value that could be set for the event"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The timestamp of when the event happened"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_handle_event" dbusmenu_menuitem_handle_event :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- variant : TVariant
    Word32 ->                               -- timestamp : TBasicType TUInt
    IO ()

-- | This function is called to create an event.  It is likely
-- to be overrided by subclasses.  The default menu item
-- will respond to the activate signal and do:
-- 
-- Emits the t'GI.Dbusmenu.Objects.Menuitem.Menuitem'::@/item-activate/@ signal on this
-- menu item.  Called by server objects when they get the
-- appropriate DBus signals from the client.
-- 
-- If you subclass this function you should really think
-- about calling the parent function unless you have a good
-- reason not to.
menuitemHandleEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to send the signal on.
    -> T.Text
    -- ^ /@name@/: The name of the signal
    -> GVariant
    -- ^ /@variant@/: A value that could be set for the event
    -> Word32
    -- ^ /@timestamp@/: The timestamp of when the event happened
    -> m ()
menuitemHandleEvent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> GVariant -> Word32 -> m ()
menuitemHandleEvent a
mi Text
name GVariant
variant Word32
timestamp = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
variant' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
variant
    Ptr Menuitem
-> CString -> Ptr GVariant -> MenuitemItemActivatedCallback
dbusmenu_menuitem_handle_event Ptr Menuitem
mi' CString
name' Ptr GVariant
variant' Word32
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
variant
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuitemHandleEventMethodInfo
instance (signature ~ (T.Text -> GVariant -> Word32 -> m ()), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemHandleEventMethodInfo a signature where
    overloadedMethod = menuitemHandleEvent

instance O.OverloadedMethodInfo MenuitemHandleEventMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemHandleEvent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemHandleEvent"
        })


#endif

-- method Menuitem::properties_copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#DbusmenuMenuitem that we're interested in the properties of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGHash (TBasicType TPtr) (TBasicType TPtr))
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_properties_copy" dbusmenu_menuitem_properties_copy :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO (Ptr (GHashTable (Ptr ()) (Ptr ())))

-- | This function takes the properties of a t'GI.Dbusmenu.Objects.Menuitem.Menuitem'
-- and puts them into a t'GI.GLib.Structs.HashTable.HashTable' that is referenced by the
-- key of a string and has the value of a string.  The hash
-- table may not have any entries if there aren\'t any or there
-- is an error in processing.  It is the caller\'s responsibility
-- to destroy the created t'GI.GLib.Structs.HashTable.HashTable'.
menuitemPropertiesCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: t'GI.Dbusmenu.Objects.Menuitem.Menuitem' that we\'re interested in the properties of
    -> m (Map.Map (Ptr ()) (Ptr ()))
    -- ^ __Returns:__ A brand new t'GI.GLib.Structs.HashTable.HashTable' that contains all of
    --    theroperties that are on this t'GI.Dbusmenu.Objects.Menuitem.Menuitem' /@mi@/.
menuitemPropertiesCopy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> m (Map (Ptr ()) (Ptr ()))
menuitemPropertiesCopy a
mi = IO (Map (Ptr ()) (Ptr ())) -> m (Map (Ptr ()) (Ptr ()))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map (Ptr ()) (Ptr ())) -> m (Map (Ptr ()) (Ptr ())))
-> IO (Map (Ptr ()) (Ptr ())) -> m (Map (Ptr ()) (Ptr ()))
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr (GHashTable (Ptr ()) (Ptr ()))
result <- Ptr Menuitem -> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
dbusmenu_menuitem_properties_copy Ptr Menuitem
mi'
    Text -> Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"menuitemPropertiesCopy" Ptr (GHashTable (Ptr ()) (Ptr ()))
result
    [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
result' <- Ptr (GHashTable (Ptr ()) (Ptr ()))
-> IO [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
result
    let result'' :: [(Ptr (), PtrWrapped (Ptr ()))]
result'' = (PtrWrapped (Ptr ()) -> Ptr ())
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> [(Ptr (), PtrWrapped (Ptr ()))]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst PtrWrapped (Ptr ()) -> Ptr ()
forall a. PtrWrapped (Ptr a) -> Ptr a
B.GHT.ptrUnpackPtr [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
result'
    let result''' :: [(Ptr (), Ptr ())]
result''' = (PtrWrapped (Ptr ()) -> Ptr ())
-> [(Ptr (), PtrWrapped (Ptr ()))] -> [(Ptr (), Ptr ())]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond PtrWrapped (Ptr ()) -> Ptr ()
forall a. PtrWrapped (Ptr a) -> Ptr a
B.GHT.ptrUnpackPtr [(Ptr (), PtrWrapped (Ptr ()))]
result''
    let result'''' :: Map (Ptr ()) (Ptr ())
result'''' = [(Ptr (), Ptr ())] -> Map (Ptr ()) (Ptr ())
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Ptr (), Ptr ())]
result'''
    Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    Map (Ptr ()) (Ptr ()) -> IO (Map (Ptr ()) (Ptr ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Map (Ptr ()) (Ptr ())
result''''

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertiesCopyMethodInfo
instance (signature ~ (m (Map.Map (Ptr ()) (Ptr ()))), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertiesCopyMethodInfo a signature where
    overloadedMethod = menuitemPropertiesCopy

instance O.OverloadedMethodInfo MenuitemPropertiesCopyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertiesCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertiesCopy"
        })


#endif

-- method Menuitem::properties_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#DbusmenuMenuitem to list the properties on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGList (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_properties_list" dbusmenu_menuitem_properties_list :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO (Ptr (GList CString))

-- | This functiong gets a list of the names of all the properties
-- that are set on this menu item.  This data on the list is owned
-- by the menuitem but the list is not and should be freed using
-- @/g_list_free()/@ when the calling function is done with it.
menuitemPropertiesList ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to list the properties on
    -> m [T.Text]
    -- ^ __Returns:__ A list of
    -- strings or NULL if there are none.
menuitemPropertiesList :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> m [Text]
menuitemPropertiesList a
mi = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr (GList CString)
result <- Ptr Menuitem -> IO (Ptr (GList CString))
dbusmenu_menuitem_properties_list Ptr Menuitem
mi'
    [CString]
result' <- Ptr (GList CString) -> IO [CString]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertiesListMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertiesListMethodInfo a signature where
    overloadedMethod = menuitemPropertiesList

instance O.OverloadedMethodInfo MenuitemPropertiesListMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertiesList",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertiesList"
        })


#endif

-- method Menuitem::property_exist
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem to look for the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The property to look for."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_exist" dbusmenu_menuitem_property_exist :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    IO CInt

-- | Checkes to see if a particular property exists on /@mi@/ and
-- returns @/TRUE/@ if so.
menuitemPropertyExist ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to look for the property on.
    -> T.Text
    -- ^ /@property@/: The property to look for.
    -> m Bool
    -- ^ __Returns:__ A boolean checking to see if the property is available
menuitemPropertyExist :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> m Bool
menuitemPropertyExist a
mi Text
property = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    CInt
result <- Ptr Menuitem -> CString -> IO CInt
dbusmenu_menuitem_property_exist Ptr Menuitem
mi' CString
property'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertyExistMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertyExistMethodInfo a signature where
    overloadedMethod = menuitemPropertyExist

instance O.OverloadedMethodInfo MenuitemPropertyExistMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertyExist",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertyExist"
        })


#endif

-- method Menuitem::property_get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem to look for the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The property to grab."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_get" dbusmenu_menuitem_property_get :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    IO CString

-- | Look up a property on /@mi@/ and return the value of it if
-- it exits.  @/NULL/@ will be returned if the property doesn\'t
-- exist.
menuitemPropertyGet ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to look for the property on.
    -> T.Text
    -- ^ /@property@/: The property to grab.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ A string with the value of the property
    -- 	that shouldn\'t be free\'d.  Or @/NULL/@ if the property
    -- 	is not set or is not a string.
menuitemPropertyGet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> m (Maybe Text)
menuitemPropertyGet a
mi Text
property = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    CString
result <- Ptr Menuitem -> CString -> IO CString
dbusmenu_menuitem_property_get Ptr Menuitem
mi' CString
property'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertyGetMethodInfo
instance (signature ~ (T.Text -> m (Maybe T.Text)), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertyGetMethodInfo a signature where
    overloadedMethod = menuitemPropertyGet

instance O.OverloadedMethodInfo MenuitemPropertyGetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertyGet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertyGet"
        })


#endif

-- method Menuitem::property_get_bool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem to look for the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The property to grab."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_get_bool" dbusmenu_menuitem_property_get_bool :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    IO CInt

-- | Look up a property on /@mi@/ and return the value of it if
-- it exits.  Returns @/FALSE/@ if the property doesn\'t exist.
menuitemPropertyGetBool ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to look for the property on.
    -> T.Text
    -- ^ /@property@/: The property to grab.
    -> m Bool
    -- ^ __Returns:__ The value of the property or @/FALSE/@.
menuitemPropertyGetBool :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> m Bool
menuitemPropertyGetBool a
mi Text
property = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    CInt
result <- Ptr Menuitem -> CString -> IO CInt
dbusmenu_menuitem_property_get_bool Ptr Menuitem
mi' CString
property'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertyGetBoolMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertyGetBoolMethodInfo a signature where
    overloadedMethod = menuitemPropertyGetBool

instance O.OverloadedMethodInfo MenuitemPropertyGetBoolMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertyGetBool",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertyGetBool"
        })


#endif

-- method Menuitem::property_get_byte_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem to look for the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The property to grab."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nelements"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A pointer to the location to store the number of items (out)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "nelements"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "A pointer to the location to store the number of items (out)"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 2 (TBasicType TUInt8))
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_get_byte_array" dbusmenu_menuitem_property_get_byte_array :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    Ptr Word64 ->                           -- nelements : TBasicType TUInt64
    IO (Ptr Word8)

-- | Look up a property on /@mi@/ and return the value of it if
-- it exits.  @/NULL/@ will be returned if the property doesn\'t
-- exist.
menuitemPropertyGetByteArray ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to look for the property on.
    -> T.Text
    -- ^ /@property@/: The property to grab.
    -> m (Maybe ByteString)
    -- ^ __Returns:__ A byte array with the
    -- 	value of the property that shouldn\'t be free\'d.  Or @/NULL/@ if the property
    -- 	is not set or is not a byte array.
menuitemPropertyGetByteArray :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> m (Maybe ByteString)
menuitemPropertyGetByteArray a
mi Text
property = IO (Maybe ByteString) -> m (Maybe ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    Ptr Word64
nelements <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word8
result <- Ptr Menuitem -> CString -> Ptr Word64 -> IO (Ptr Word8)
dbusmenu_menuitem_property_get_byte_array Ptr Menuitem
mi' CString
property' Ptr Word64
nelements
    Word64
nelements' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
nelements
    Maybe ByteString
maybeResult <- Ptr Word8 -> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Word8
result ((Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString))
-> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
result' -> do
        ByteString
result'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
nelements') Ptr Word8
result'
        ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
nelements
    Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
maybeResult

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertyGetByteArrayMethodInfo
instance (signature ~ (T.Text -> m (Maybe ByteString)), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertyGetByteArrayMethodInfo a signature where
    overloadedMethod = menuitemPropertyGetByteArray

instance O.OverloadedMethodInfo MenuitemPropertyGetByteArrayMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertyGetByteArray",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertyGetByteArray"
        })


#endif

-- method Menuitem::property_get_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem to look for the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The property to grab."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_get_int" dbusmenu_menuitem_property_get_int :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    IO Int32

-- | Look up a property on /@mi@/ and return the value of it if
-- it exits.  Returns zero if the property doesn\'t exist.
menuitemPropertyGetInt ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to look for the property on.
    -> T.Text
    -- ^ /@property@/: The property to grab.
    -> m Int32
    -- ^ __Returns:__ The value of the property or zero.
menuitemPropertyGetInt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> m Int32
menuitemPropertyGetInt a
mi Text
property = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    Int32
result <- Ptr Menuitem -> CString -> IO Int32
dbusmenu_menuitem_property_get_int Ptr Menuitem
mi' CString
property'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertyGetIntMethodInfo
instance (signature ~ (T.Text -> m Int32), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertyGetIntMethodInfo a signature where
    overloadedMethod = menuitemPropertyGetInt

instance O.OverloadedMethodInfo MenuitemPropertyGetIntMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertyGetInt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertyGetInt"
        })


#endif

-- method Menuitem::property_get_variant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem to look for the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The property to grab."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_get_variant" dbusmenu_menuitem_property_get_variant :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    IO (Ptr GVariant)

-- | Look up a property on /@mi@/ and return the value of it if
-- it exits.  @/NULL/@ will be returned if the property doesn\'t
-- exist.
menuitemPropertyGetVariant ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to look for the property on.
    -> T.Text
    -- ^ /@property@/: The property to grab.
    -> m (Maybe GVariant)
    -- ^ __Returns:__ A GVariant for the property.
menuitemPropertyGetVariant :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> m (Maybe GVariant)
menuitemPropertyGetVariant a
mi Text
property = IO (Maybe GVariant) -> m (Maybe GVariant)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GVariant) -> m (Maybe GVariant))
-> IO (Maybe GVariant) -> m (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    Ptr GVariant
result <- Ptr Menuitem -> CString -> IO (Ptr GVariant)
dbusmenu_menuitem_property_get_variant Ptr Menuitem
mi' CString
property'
    Maybe GVariant
maybeResult <- Ptr GVariant
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GVariant
result ((Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant))
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ \Ptr GVariant
result' -> do
        GVariant
result'' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result'
        GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    Maybe GVariant -> IO (Maybe GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GVariant
maybeResult

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertyGetVariantMethodInfo
instance (signature ~ (T.Text -> m (Maybe GVariant)), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertyGetVariantMethodInfo a signature where
    overloadedMethod = menuitemPropertyGetVariant

instance O.OverloadedMethodInfo MenuitemPropertyGetVariantMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertyGetVariant",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertyGetVariant"
        })


#endif

-- method Menuitem::property_remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem to remove the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The property to look for."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_remove" dbusmenu_menuitem_property_remove :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    IO ()

-- | Removes a property from the menuitem.
menuitemPropertyRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to remove the property on.
    -> T.Text
    -- ^ /@property@/: The property to look for.
    -> m ()
menuitemPropertyRemove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> m ()
menuitemPropertyRemove a
mi Text
property = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    Ptr Menuitem -> CString -> IO ()
dbusmenu_menuitem_property_remove Ptr Menuitem
mi' CString
property'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertyRemoveMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertyRemoveMethodInfo a signature where
    overloadedMethod = menuitemPropertyRemove

instance O.OverloadedMethodInfo MenuitemPropertyRemoveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertyRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertyRemove"
        })


#endif

-- method Menuitem::property_set
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to set the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of the property to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value of the property."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_set" dbusmenu_menuitem_property_set :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO CInt

-- | Takes the pair of /@property@/ and /@value@/ and places them as a
-- property on /@mi@/.  If a property already exists by that name,
-- then the value is set to the new value.  If not, the property
-- is added.  If the value is changed or the property was previously
-- unset then the signal t'GI.Dbusmenu.Objects.Menuitem.Menuitem'::@/prop-changed/@ will be
-- emitted by this function.
menuitemPropertySet ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to set the property on.
    -> T.Text
    -- ^ /@property@/: Name of the property to set.
    -> T.Text
    -- ^ /@value@/: The value of the property.
    -> m Bool
    -- ^ __Returns:__ A boolean representing if the property value was set.
menuitemPropertySet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> Text -> m Bool
menuitemPropertySet a
mi Text
property Text
value = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    CString
value' <- Text -> IO CString
textToCString Text
value
    CInt
result <- Ptr Menuitem -> CString -> CString -> IO CInt
dbusmenu_menuitem_property_set Ptr Menuitem
mi' CString
property' CString
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertySetMethodInfo
instance (signature ~ (T.Text -> T.Text -> m Bool), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertySetMethodInfo a signature where
    overloadedMethod = menuitemPropertySet

instance O.OverloadedMethodInfo MenuitemPropertySetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertySet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertySet"
        })


#endif

-- method Menuitem::property_set_bool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to set the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of the property to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value of the property."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_set_bool" dbusmenu_menuitem_property_set_bool :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    CInt ->                                 -- value : TBasicType TBoolean
    IO CInt

-- | Takes a boolean /@value@/ and sets it on /@property@/ as a
-- property on /@mi@/.  If a property already exists by that name,
-- then the value is set to the new value.  If not, the property
-- is added.  If the value is changed or the property was previously
-- unset then the signal t'GI.Dbusmenu.Objects.Menuitem.Menuitem'::@/prop-changed/@ will be
-- emitted by this function.
menuitemPropertySetBool ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to set the property on.
    -> T.Text
    -- ^ /@property@/: Name of the property to set.
    -> Bool
    -- ^ /@value@/: The value of the property.
    -> m Bool
    -- ^ __Returns:__ A boolean representing if the property value was set.
menuitemPropertySetBool :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> Bool -> m Bool
menuitemPropertySetBool a
mi Text
property Bool
value = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    let value' :: CInt
value' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
value
    CInt
result <- Ptr Menuitem -> CString -> CInt -> IO CInt
dbusmenu_menuitem_property_set_bool Ptr Menuitem
mi' CString
property' CInt
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertySetBoolMethodInfo
instance (signature ~ (T.Text -> Bool -> m Bool), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertySetBoolMethodInfo a signature where
    overloadedMethod = menuitemPropertySetBool

instance O.OverloadedMethodInfo MenuitemPropertySetBoolMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertySetBool",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertySetBool"
        })


#endif

-- method Menuitem::property_set_byte_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to set the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of the property to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The byte array." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nelements"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of elements in the byte array."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_set_byte_array" dbusmenu_menuitem_property_set_byte_array :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    Word8 ->                                -- value : TBasicType TUInt8
    Word64 ->                               -- nelements : TBasicType TUInt64
    IO CInt

-- | Takes a byte array /@value@/ and sets it on /@property@/ as a
-- property on /@mi@/.  If a property already exists by that name,
-- then the value is set to the new value.  If not, the property
-- is added.  If the value is changed or the property was previously
-- unset then the signal t'GI.Dbusmenu.Objects.Menuitem.Menuitem'::@/prop-changed/@ will be
-- emitted by this function.
menuitemPropertySetByteArray ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to set the property on.
    -> T.Text
    -- ^ /@property@/: Name of the property to set.
    -> Word8
    -- ^ /@value@/: The byte array.
    -> Word64
    -- ^ /@nelements@/: The number of elements in the byte array.
    -> m Bool
    -- ^ __Returns:__ A boolean representing if the property value was set.
menuitemPropertySetByteArray :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> Word8 -> Word64 -> m Bool
menuitemPropertySetByteArray a
mi Text
property Word8
value Word64
nelements = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    CInt
result <- Ptr Menuitem -> CString -> Word8 -> Word64 -> IO CInt
dbusmenu_menuitem_property_set_byte_array Ptr Menuitem
mi' CString
property' Word8
value Word64
nelements
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertySetByteArrayMethodInfo
instance (signature ~ (T.Text -> Word8 -> Word64 -> m Bool), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertySetByteArrayMethodInfo a signature where
    overloadedMethod = menuitemPropertySetByteArray

instance O.OverloadedMethodInfo MenuitemPropertySetByteArrayMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertySetByteArray",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertySetByteArray"
        })


#endif

-- method Menuitem::property_set_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to set the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of the property to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value of the property."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_set_int" dbusmenu_menuitem_property_set_int :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    Int32 ->                                -- value : TBasicType TInt
    IO CInt

-- | Takes a boolean /@value@/ and sets it on /@property@/ as a
-- property on /@mi@/.  If a property already exists by that name,
-- then the value is set to the new value.  If not, the property
-- is added.  If the value is changed or the property was previously
-- unset then the signal t'GI.Dbusmenu.Objects.Menuitem.Menuitem'::@/prop-changed/@ will be
-- emitted by this function.
menuitemPropertySetInt ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to set the property on.
    -> T.Text
    -- ^ /@property@/: Name of the property to set.
    -> Int32
    -- ^ /@value@/: The value of the property.
    -> m Bool
    -- ^ __Returns:__ A boolean representing if the property value was set.
menuitemPropertySetInt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> Int32 -> m Bool
menuitemPropertySetInt a
mi Text
property Int32
value = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    CInt
result <- Ptr Menuitem -> CString -> Int32 -> IO CInt
dbusmenu_menuitem_property_set_int Ptr Menuitem
mi' CString
property' Int32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertySetIntMethodInfo
instance (signature ~ (T.Text -> Int32 -> m Bool), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertySetIntMethodInfo a signature where
    overloadedMethod = menuitemPropertySetInt

instance O.OverloadedMethodInfo MenuitemPropertySetIntMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertySetInt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertySetInt"
        })


#endif

-- method Menuitem::property_set_variant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to set the property on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of the property to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value of the property."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_property_set_variant" dbusmenu_menuitem_property_set_variant :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CString ->                              -- property : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    IO CInt

-- | Takes the pair of /@property@/ and /@value@/ and places them as a
-- property on /@mi@/.  If a property already exists by that name,
-- then the value is set to the new value.  If not, the property
-- is added.  If the value is changed or the property was previously
-- unset then the signal t'GI.Dbusmenu.Objects.Menuitem.Menuitem'::@/prop-changed/@ will be
-- emitted by this function.
menuitemPropertySetVariant ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to set the property on.
    -> T.Text
    -- ^ /@property@/: Name of the property to set.
    -> GVariant
    -- ^ /@value@/: The value of the property.
    -> m Bool
    -- ^ __Returns:__ A boolean representing if the property value was set.
menuitemPropertySetVariant :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Text -> GVariant -> m Bool
menuitemPropertySetVariant a
mi Text
property GVariant
value = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CString
property' <- Text -> IO CString
textToCString Text
property
    Ptr GVariant
value' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
value
    CInt
result <- Ptr Menuitem -> CString -> Ptr GVariant -> IO CInt
dbusmenu_menuitem_property_set_variant Ptr Menuitem
mi' CString
property' Ptr GVariant
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemPropertySetVariantMethodInfo
instance (signature ~ (T.Text -> GVariant -> m Bool), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemPropertySetVariantMethodInfo a signature where
    overloadedMethod = menuitemPropertySetVariant

instance O.OverloadedMethodInfo MenuitemPropertySetVariantMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemPropertySetVariant",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemPropertySetVariant"
        })


#endif

-- method Menuitem::send_about_to_show
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to send the signal on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cb"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Callback to call when the call has returned."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cb_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Data to pass to the callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_send_about_to_show" dbusmenu_menuitem_send_about_to_show :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Ptr () ->                               -- cb : TBasicType TPtr
    Ptr () ->                               -- cb_data : TBasicType TPtr
    IO ()

-- | This function is used to send the even that the submenu
-- of this item is about to be shown.  Callers to this event
-- should delay showing the menu until their callback is
-- called if possible.
menuitemSendAboutToShow ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to send the signal on.
    -> Ptr ()
    -- ^ /@cb@/: Callback to call when the call has returned.
    -> Ptr ()
    -- ^ /@cbData@/: Data to pass to the callback.
    -> m ()
menuitemSendAboutToShow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Ptr () -> Ptr () -> m ()
menuitemSendAboutToShow a
mi Ptr ()
cb Ptr ()
cbData = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem -> Ptr () -> Ptr () -> IO ()
dbusmenu_menuitem_send_about_to_show Ptr Menuitem
mi' Ptr ()
cb Ptr ()
cbData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuitemSendAboutToShowMethodInfo
instance (signature ~ (Ptr () -> Ptr () -> m ()), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemSendAboutToShowMethodInfo a signature where
    overloadedMethod = menuitemSendAboutToShow

instance O.OverloadedMethodInfo MenuitemSendAboutToShowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemSendAboutToShow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemSendAboutToShow"
        })


#endif

-- method Menuitem::set_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuMenuitem for which to set the parent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new parent #DbusmenuMenuitem"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_set_parent" dbusmenu_menuitem_set_parent :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Ptr Menuitem ->                         -- parent : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO CInt

-- | Sets the parent of /@mi@/ to /@parent@/. If /@mi@/ already
-- has a parent, then this call will fail. The parent will
-- be set automatically when using the usual methods to add a
-- child menuitem, so this function should not normally be
-- called directly
menuitemSetParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' for which to set the parent
    -> b
    -- ^ /@parent@/: The new parent t'GI.Dbusmenu.Objects.Menuitem.Menuitem'
    -> m Bool
    -- ^ __Returns:__ Whether the parent was set successfully
menuitemSetParent :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuitem a, IsMenuitem b) =>
a -> b -> m Bool
menuitemSetParent a
mi b
parent = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem
parent' <- b -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
parent
    CInt
result <- Ptr Menuitem -> Ptr Menuitem -> IO CInt
dbusmenu_menuitem_set_parent Ptr Menuitem
mi' Ptr Menuitem
parent'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
parent
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemSetParentMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsMenuitem a, IsMenuitem b) => O.OverloadedMethod MenuitemSetParentMethodInfo a signature where
    overloadedMethod = menuitemSetParent

instance O.OverloadedMethodInfo MenuitemSetParentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemSetParent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemSetParent"
        })


#endif

-- method Menuitem::set_root
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#DbusmenuMenuitem to set whether it's root"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "root"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether @mi is a root node or not"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_set_root" dbusmenu_menuitem_set_root :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    CInt ->                                 -- root : TBasicType TBoolean
    IO ()

-- | This function sets the internal value of whether this is a
-- root node or not.
menuitemSetRoot ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to set whether it\'s root
    -> Bool
    -- ^ /@root@/: Whether /@mi@/ is a root node or not
    -> m ()
menuitemSetRoot :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Bool -> m ()
menuitemSetRoot a
mi Bool
root = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    let root' :: CInt
root' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
root
    Ptr Menuitem -> CInt -> IO ()
dbusmenu_menuitem_set_root Ptr Menuitem
mi' CInt
root'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuitemSetRootMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemSetRootMethodInfo a signature where
    overloadedMethod = menuitemSetRoot

instance O.OverloadedMethodInfo MenuitemSetRootMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemSetRoot",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemSetRoot"
        })


#endif

-- method Menuitem::show_to_user
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#DbusmenuMenuitem to show"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The time that the user requested it to be shown"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_show_to_user" dbusmenu_menuitem_show_to_user :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    Word32 ->                               -- timestamp : TBasicType TUInt
    IO ()

-- | Signals that this menu item should be shown to the user.  If this is
-- server side the server will then take it and send it over the
-- bus.
menuitemShowToUser ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to show
    -> Word32
    -- ^ /@timestamp@/: The time that the user requested it to be shown
    -> m ()
menuitemShowToUser :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> Word32 -> m ()
menuitemShowToUser a
mi Word32
timestamp = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr Menuitem -> MenuitemItemActivatedCallback
dbusmenu_menuitem_show_to_user Ptr Menuitem
mi' Word32
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuitemShowToUserMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemShowToUserMethodInfo a signature where
    overloadedMethod = menuitemShowToUser

instance O.OverloadedMethodInfo MenuitemShowToUserMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemShowToUser",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemShowToUser"
        })


#endif

-- method Menuitem::take_children
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenMenuitem to take the children from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }))
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_take_children" dbusmenu_menuitem_take_children :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO (Ptr (GList (Ptr Menuitem)))

-- | While the name sounds devious that\'s exactly what this function
-- does.  It takes the list of children from the /@mi@/ and clears the
-- internal list.  The calling function is now in charge of the ref\'s
-- on the children it has taken.  A lot of responsibility involved
-- in taking children.
menuitemTakeChildren ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The @/DbusmenMenuitem/@ to take the children from.
    -> m [Menuitem]
    -- ^ __Returns:__ 
    --    A t'GI.GLib.Structs.List.List' of pointers to t'GI.Dbusmenu.Objects.Menuitem.Menuitem' objects.
menuitemTakeChildren :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> m [Menuitem]
menuitemTakeChildren a
mi = IO [Menuitem] -> m [Menuitem]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Menuitem] -> m [Menuitem]) -> IO [Menuitem] -> m [Menuitem]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    Ptr (GList (Ptr Menuitem))
result <- Ptr Menuitem -> IO (Ptr (GList (Ptr Menuitem)))
dbusmenu_menuitem_take_children Ptr Menuitem
mi'
    [Ptr Menuitem]
result' <- Ptr (GList (Ptr Menuitem)) -> IO [Ptr Menuitem]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Menuitem))
result
    [Menuitem]
result'' <- (Ptr Menuitem -> IO Menuitem) -> [Ptr Menuitem] -> IO [Menuitem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Menuitem -> Menuitem) -> Ptr Menuitem -> IO Menuitem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Menuitem -> Menuitem
Menuitem) [Ptr Menuitem]
result'
    Ptr (GList (Ptr Menuitem)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Menuitem))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    [Menuitem] -> IO [Menuitem]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Menuitem]
result''

#if defined(ENABLE_OVERLOADING)
data MenuitemTakeChildrenMethodInfo
instance (signature ~ (m [Menuitem]), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemTakeChildrenMethodInfo a signature where
    overloadedMethod = menuitemTakeChildren

instance O.OverloadedMethodInfo MenuitemTakeChildrenMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemTakeChildren",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemTakeChildren"
        })


#endif

-- method Menuitem::unparent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mi"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuMenuitem to unparent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_menuitem_unparent" dbusmenu_menuitem_unparent :: 
    Ptr Menuitem ->                         -- mi : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO CInt

-- | Unparents the menu item /@mi@/. If /@mi@/ doesn\'t have a
-- parent, then this call will fail. The menuitem will
-- be unparented automatically when using the usual methods
-- to delete a child menuitem, so this function should not
-- normally be called directly
menuitemUnparent ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuitem a) =>
    a
    -- ^ /@mi@/: The t'GI.Dbusmenu.Objects.Menuitem.Menuitem' to unparent
    -> m Bool
    -- ^ __Returns:__ Whether the menu item was unparented successfully
menuitemUnparent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuitem a) =>
a -> m Bool
menuitemUnparent a
mi = MenuitemAboutToShowCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MenuitemAboutToShowCallback -> m Bool)
-> MenuitemAboutToShowCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menuitem
mi' <- a -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mi
    CInt
result <- Ptr Menuitem -> IO CInt
dbusmenu_menuitem_unparent Ptr Menuitem
mi'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mi
    Bool -> MenuitemAboutToShowCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuitemUnparentMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMenuitem a) => O.OverloadedMethod MenuitemUnparentMethodInfo a signature where
    overloadedMethod = menuitemUnparent

instance O.OverloadedMethodInfo MenuitemUnparentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Menuitem.menuitemUnparent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Menuitem.html#v:menuitemUnparent"
        })


#endif