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

module GI.Gtk.Objects.Menu
    ( 

-- * Exported types
    Menu(..)                                ,
    MenuK                                   ,
    toMenu                                  ,
    noMenu                                  ,


 -- * Methods
-- ** menuAttach
    menuAttach                              ,


-- ** menuAttachToWidget
    menuAttachToWidget                      ,


-- ** menuDetach
    menuDetach                              ,


-- ** menuGetAccelGroup
    menuGetAccelGroup                       ,


-- ** menuGetAccelPath
    menuGetAccelPath                        ,


-- ** menuGetActive
    menuGetActive                           ,


-- ** menuGetAttachWidget
    menuGetAttachWidget                     ,


-- ** menuGetForAttachWidget
    menuGetForAttachWidget                  ,


-- ** menuGetMonitor
    menuGetMonitor                          ,


-- ** menuGetReserveToggleSize
    menuGetReserveToggleSize                ,


-- ** menuGetTearoffState
    menuGetTearoffState                     ,


-- ** menuGetTitle
    menuGetTitle                            ,


-- ** menuNew
    menuNew                                 ,


-- ** menuNewFromModel
    menuNewFromModel                        ,


-- ** menuPopdown
    menuPopdown                             ,


-- ** menuPopup
    menuPopup                               ,


-- ** menuPopupForDevice
    menuPopupForDevice                      ,


-- ** menuReorderChild
    menuReorderChild                        ,


-- ** menuReposition
    menuReposition                          ,


-- ** menuSetAccelGroup
    menuSetAccelGroup                       ,


-- ** menuSetAccelPath
    menuSetAccelPath                        ,


-- ** menuSetActive
    menuSetActive                           ,


-- ** menuSetMonitor
    menuSetMonitor                          ,


-- ** menuSetReserveToggleSize
    menuSetReserveToggleSize                ,


-- ** menuSetScreen
    menuSetScreen                           ,


-- ** menuSetTearoffState
    menuSetTearoffState                     ,


-- ** menuSetTitle
    menuSetTitle                            ,




 -- * Properties
-- ** AccelGroup
    MenuAccelGroupPropertyInfo              ,
    constructMenuAccelGroup                 ,
    getMenuAccelGroup                       ,
    setMenuAccelGroup                       ,


-- ** AccelPath
    MenuAccelPathPropertyInfo               ,
    constructMenuAccelPath                  ,
    getMenuAccelPath                        ,
    setMenuAccelPath                        ,


-- ** Active
    MenuActivePropertyInfo                  ,
    constructMenuActive                     ,
    getMenuActive                           ,
    setMenuActive                           ,


-- ** AttachWidget
    MenuAttachWidgetPropertyInfo            ,
    constructMenuAttachWidget               ,
    getMenuAttachWidget                     ,
    setMenuAttachWidget                     ,


-- ** Monitor
    MenuMonitorPropertyInfo                 ,
    constructMenuMonitor                    ,
    getMenuMonitor                          ,
    setMenuMonitor                          ,


-- ** ReserveToggleSize
    MenuReserveToggleSizePropertyInfo       ,
    constructMenuReserveToggleSize          ,
    getMenuReserveToggleSize                ,
    setMenuReserveToggleSize                ,


-- ** TearoffState
    MenuTearoffStatePropertyInfo            ,
    constructMenuTearoffState               ,
    getMenuTearoffState                     ,
    setMenuTearoffState                     ,


-- ** TearoffTitle
    MenuTearoffTitlePropertyInfo            ,
    constructMenuTearoffTitle               ,
    getMenuTearoffTitle                     ,
    setMenuTearoffTitle                     ,




 -- * Signals
-- ** MoveScroll
    MenuMoveScrollCallback                  ,
    MenuMoveScrollCallbackC                 ,
    MenuMoveScrollSignalInfo                ,
    afterMenuMoveScroll                     ,
    menuMoveScrollCallbackWrapper           ,
    menuMoveScrollClosure                   ,
    mkMenuMoveScrollCallback                ,
    noMenuMoveScrollCallback                ,
    onMenuMoveScroll                        ,




    ) where

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

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

import GI.Gtk.Types
import GI.Gtk.Callbacks
import qualified GI.Atk as Atk
import qualified GI.GLib as GLib
import qualified GI.GObject as GObject
import qualified GI.Gdk as Gdk
import qualified GI.Gio as Gio

newtype Menu = Menu (ForeignPtr Menu)
foreign import ccall "gtk_menu_get_type"
    c_gtk_menu_get_type :: IO GType

type instance ParentTypes Menu = MenuParentTypes
type MenuParentTypes = '[MenuShell, Container, Widget, GObject.Object, Atk.ImplementorIface, Buildable]

instance GObject Menu where
    gobjectIsInitiallyUnowned _ = True
    gobjectType _ = c_gtk_menu_get_type
    

class GObject o => MenuK o
instance (GObject o, IsDescendantOf Menu o) => MenuK o

toMenu :: MenuK o => o -> IO Menu
toMenu = unsafeCastTo Menu

noMenu :: Maybe Menu
noMenu = Nothing

-- signal Menu::move-scroll
type MenuMoveScrollCallback =
    ScrollType ->
    IO ()

noMenuMoveScrollCallback :: Maybe MenuMoveScrollCallback
noMenuMoveScrollCallback = Nothing

type MenuMoveScrollCallbackC =
    Ptr () ->                               -- object
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkMenuMoveScrollCallback :: MenuMoveScrollCallbackC -> IO (FunPtr MenuMoveScrollCallbackC)

menuMoveScrollClosure :: MenuMoveScrollCallback -> IO Closure
menuMoveScrollClosure cb = newCClosure =<< mkMenuMoveScrollCallback wrapped
    where wrapped = menuMoveScrollCallbackWrapper cb

menuMoveScrollCallbackWrapper ::
    MenuMoveScrollCallback ->
    Ptr () ->
    CUInt ->
    Ptr () ->
    IO ()
menuMoveScrollCallbackWrapper _cb _ scroll_type _ = do
    let scroll_type' = (toEnum . fromIntegral) scroll_type
    _cb  scroll_type'

onMenuMoveScroll :: (GObject a, MonadIO m) => a -> MenuMoveScrollCallback -> m SignalHandlerId
onMenuMoveScroll obj cb = liftIO $ connectMenuMoveScroll obj cb SignalConnectBefore
afterMenuMoveScroll :: (GObject a, MonadIO m) => a -> MenuMoveScrollCallback -> m SignalHandlerId
afterMenuMoveScroll obj cb = connectMenuMoveScroll obj cb SignalConnectAfter

connectMenuMoveScroll :: (GObject a, MonadIO m) =>
                         a -> MenuMoveScrollCallback -> SignalConnectMode -> m SignalHandlerId
connectMenuMoveScroll obj cb after = liftIO $ do
    cb' <- mkMenuMoveScrollCallback (menuMoveScrollCallbackWrapper cb)
    connectSignalFunPtr obj "move-scroll" cb' after

-- VVV Prop "accel-group"
   -- Type: TInterface "Gtk" "AccelGroup"
   -- Flags: [PropertyReadable,PropertyWritable]

getMenuAccelGroup :: (MonadIO m, MenuK o) => o -> m AccelGroup
getMenuAccelGroup obj = liftIO $ getObjectPropertyObject obj "accel-group" AccelGroup

setMenuAccelGroup :: (MonadIO m, MenuK o, AccelGroupK a) => o -> a -> m ()
setMenuAccelGroup obj val = liftIO $ setObjectPropertyObject obj "accel-group" val

constructMenuAccelGroup :: (AccelGroupK a) => a -> IO ([Char], GValue)
constructMenuAccelGroup val = constructObjectPropertyObject "accel-group" val

data MenuAccelGroupPropertyInfo
instance AttrInfo MenuAccelGroupPropertyInfo where
    type AttrAllowedOps MenuAccelGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint MenuAccelGroupPropertyInfo = AccelGroupK
    type AttrBaseTypeConstraint MenuAccelGroupPropertyInfo = MenuK
    type AttrGetType MenuAccelGroupPropertyInfo = AccelGroup
    type AttrLabel MenuAccelGroupPropertyInfo = "Menu::accel-group"
    attrGet _ = getMenuAccelGroup
    attrSet _ = setMenuAccelGroup
    attrConstruct _ = constructMenuAccelGroup

-- VVV Prop "accel-path"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getMenuAccelPath :: (MonadIO m, MenuK o) => o -> m T.Text
getMenuAccelPath obj = liftIO $ getObjectPropertyString obj "accel-path"

setMenuAccelPath :: (MonadIO m, MenuK o) => o -> T.Text -> m ()
setMenuAccelPath obj val = liftIO $ setObjectPropertyString obj "accel-path" val

constructMenuAccelPath :: T.Text -> IO ([Char], GValue)
constructMenuAccelPath val = constructObjectPropertyString "accel-path" val

data MenuAccelPathPropertyInfo
instance AttrInfo MenuAccelPathPropertyInfo where
    type AttrAllowedOps MenuAccelPathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint MenuAccelPathPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint MenuAccelPathPropertyInfo = MenuK
    type AttrGetType MenuAccelPathPropertyInfo = T.Text
    type AttrLabel MenuAccelPathPropertyInfo = "Menu::accel-path"
    attrGet _ = getMenuAccelPath
    attrSet _ = setMenuAccelPath
    attrConstruct _ = constructMenuAccelPath

-- VVV Prop "active"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getMenuActive :: (MonadIO m, MenuK o) => o -> m Int32
getMenuActive obj = liftIO $ getObjectPropertyCInt obj "active"

setMenuActive :: (MonadIO m, MenuK o) => o -> Int32 -> m ()
setMenuActive obj val = liftIO $ setObjectPropertyCInt obj "active" val

constructMenuActive :: Int32 -> IO ([Char], GValue)
constructMenuActive val = constructObjectPropertyCInt "active" val

data MenuActivePropertyInfo
instance AttrInfo MenuActivePropertyInfo where
    type AttrAllowedOps MenuActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint MenuActivePropertyInfo = (~) Int32
    type AttrBaseTypeConstraint MenuActivePropertyInfo = MenuK
    type AttrGetType MenuActivePropertyInfo = Int32
    type AttrLabel MenuActivePropertyInfo = "Menu::active"
    attrGet _ = getMenuActive
    attrSet _ = setMenuActive
    attrConstruct _ = constructMenuActive

-- VVV Prop "attach-widget"
   -- Type: TInterface "Gtk" "Widget"
   -- Flags: [PropertyReadable,PropertyWritable]

getMenuAttachWidget :: (MonadIO m, MenuK o) => o -> m Widget
getMenuAttachWidget obj = liftIO $ getObjectPropertyObject obj "attach-widget" Widget

setMenuAttachWidget :: (MonadIO m, MenuK o, WidgetK a) => o -> a -> m ()
setMenuAttachWidget obj val = liftIO $ setObjectPropertyObject obj "attach-widget" val

constructMenuAttachWidget :: (WidgetK a) => a -> IO ([Char], GValue)
constructMenuAttachWidget val = constructObjectPropertyObject "attach-widget" val

data MenuAttachWidgetPropertyInfo
instance AttrInfo MenuAttachWidgetPropertyInfo where
    type AttrAllowedOps MenuAttachWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint MenuAttachWidgetPropertyInfo = WidgetK
    type AttrBaseTypeConstraint MenuAttachWidgetPropertyInfo = MenuK
    type AttrGetType MenuAttachWidgetPropertyInfo = Widget
    type AttrLabel MenuAttachWidgetPropertyInfo = "Menu::attach-widget"
    attrGet _ = getMenuAttachWidget
    attrSet _ = setMenuAttachWidget
    attrConstruct _ = constructMenuAttachWidget

-- VVV Prop "monitor"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getMenuMonitor :: (MonadIO m, MenuK o) => o -> m Int32
getMenuMonitor obj = liftIO $ getObjectPropertyCInt obj "monitor"

setMenuMonitor :: (MonadIO m, MenuK o) => o -> Int32 -> m ()
setMenuMonitor obj val = liftIO $ setObjectPropertyCInt obj "monitor" val

constructMenuMonitor :: Int32 -> IO ([Char], GValue)
constructMenuMonitor val = constructObjectPropertyCInt "monitor" val

data MenuMonitorPropertyInfo
instance AttrInfo MenuMonitorPropertyInfo where
    type AttrAllowedOps MenuMonitorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint MenuMonitorPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint MenuMonitorPropertyInfo = MenuK
    type AttrGetType MenuMonitorPropertyInfo = Int32
    type AttrLabel MenuMonitorPropertyInfo = "Menu::monitor"
    attrGet _ = getMenuMonitor
    attrSet _ = setMenuMonitor
    attrConstruct _ = constructMenuMonitor

-- VVV Prop "reserve-toggle-size"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getMenuReserveToggleSize :: (MonadIO m, MenuK o) => o -> m Bool
getMenuReserveToggleSize obj = liftIO $ getObjectPropertyBool obj "reserve-toggle-size"

setMenuReserveToggleSize :: (MonadIO m, MenuK o) => o -> Bool -> m ()
setMenuReserveToggleSize obj val = liftIO $ setObjectPropertyBool obj "reserve-toggle-size" val

constructMenuReserveToggleSize :: Bool -> IO ([Char], GValue)
constructMenuReserveToggleSize val = constructObjectPropertyBool "reserve-toggle-size" val

data MenuReserveToggleSizePropertyInfo
instance AttrInfo MenuReserveToggleSizePropertyInfo where
    type AttrAllowedOps MenuReserveToggleSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint MenuReserveToggleSizePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint MenuReserveToggleSizePropertyInfo = MenuK
    type AttrGetType MenuReserveToggleSizePropertyInfo = Bool
    type AttrLabel MenuReserveToggleSizePropertyInfo = "Menu::reserve-toggle-size"
    attrGet _ = getMenuReserveToggleSize
    attrSet _ = setMenuReserveToggleSize
    attrConstruct _ = constructMenuReserveToggleSize

-- VVV Prop "tearoff-state"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getMenuTearoffState :: (MonadIO m, MenuK o) => o -> m Bool
getMenuTearoffState obj = liftIO $ getObjectPropertyBool obj "tearoff-state"

setMenuTearoffState :: (MonadIO m, MenuK o) => o -> Bool -> m ()
setMenuTearoffState obj val = liftIO $ setObjectPropertyBool obj "tearoff-state" val

constructMenuTearoffState :: Bool -> IO ([Char], GValue)
constructMenuTearoffState val = constructObjectPropertyBool "tearoff-state" val

data MenuTearoffStatePropertyInfo
instance AttrInfo MenuTearoffStatePropertyInfo where
    type AttrAllowedOps MenuTearoffStatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint MenuTearoffStatePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint MenuTearoffStatePropertyInfo = MenuK
    type AttrGetType MenuTearoffStatePropertyInfo = Bool
    type AttrLabel MenuTearoffStatePropertyInfo = "Menu::tearoff-state"
    attrGet _ = getMenuTearoffState
    attrSet _ = setMenuTearoffState
    attrConstruct _ = constructMenuTearoffState

-- VVV Prop "tearoff-title"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getMenuTearoffTitle :: (MonadIO m, MenuK o) => o -> m T.Text
getMenuTearoffTitle obj = liftIO $ getObjectPropertyString obj "tearoff-title"

setMenuTearoffTitle :: (MonadIO m, MenuK o) => o -> T.Text -> m ()
setMenuTearoffTitle obj val = liftIO $ setObjectPropertyString obj "tearoff-title" val

constructMenuTearoffTitle :: T.Text -> IO ([Char], GValue)
constructMenuTearoffTitle val = constructObjectPropertyString "tearoff-title" val

data MenuTearoffTitlePropertyInfo
instance AttrInfo MenuTearoffTitlePropertyInfo where
    type AttrAllowedOps MenuTearoffTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint MenuTearoffTitlePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint MenuTearoffTitlePropertyInfo = MenuK
    type AttrGetType MenuTearoffTitlePropertyInfo = T.Text
    type AttrLabel MenuTearoffTitlePropertyInfo = "Menu::tearoff-title"
    attrGet _ = getMenuTearoffTitle
    attrSet _ = setMenuTearoffTitle
    attrConstruct _ = constructMenuTearoffTitle

type instance AttributeList Menu = MenuAttributeList
type MenuAttributeList = ('[ '("accel-group", MenuAccelGroupPropertyInfo), '("accel-path", MenuAccelPathPropertyInfo), '("active", MenuActivePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("attach-widget", MenuAttachWidgetPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("monitor", MenuMonitorPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("reserve-toggle-size", MenuReserveToggleSizePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("take-focus", MenuShellTakeFocusPropertyInfo), '("tearoff-state", MenuTearoffStatePropertyInfo), '("tearoff-title", MenuTearoffTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] :: [(Symbol, *)])

data MenuMoveScrollSignalInfo
instance SignalInfo MenuMoveScrollSignalInfo where
    type HaskellCallbackType MenuMoveScrollSignalInfo = MenuMoveScrollCallback
    connectSignal _ = connectMenuMoveScroll

type instance SignalList Menu = MenuSignalList
type MenuSignalList = ('[ '("accel-closures-changed", WidgetAccelClosuresChangedSignalInfo), '("activate-current", MenuShellActivateCurrentSignalInfo), '("add", ContainerAddSignalInfo), '("button-press-event", WidgetButtonPressEventSignalInfo), '("button-release-event", WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", WidgetCanActivateAccelSignalInfo), '("cancel", MenuShellCancelSignalInfo), '("check-resize", ContainerCheckResizeSignalInfo), '("child-notify", WidgetChildNotifySignalInfo), '("composited-changed", WidgetCompositedChangedSignalInfo), '("configure-event", WidgetConfigureEventSignalInfo), '("cycle-focus", MenuShellCycleFocusSignalInfo), '("damage-event", WidgetDamageEventSignalInfo), '("deactivate", MenuShellDeactivateSignalInfo), '("delete-event", WidgetDeleteEventSignalInfo), '("destroy", WidgetDestroySignalInfo), '("destroy-event", WidgetDestroyEventSignalInfo), '("direction-changed", WidgetDirectionChangedSignalInfo), '("drag-begin", WidgetDragBeginSignalInfo), '("drag-data-delete", WidgetDragDataDeleteSignalInfo), '("drag-data-get", WidgetDragDataGetSignalInfo), '("drag-data-received", WidgetDragDataReceivedSignalInfo), '("drag-drop", WidgetDragDropSignalInfo), '("drag-end", WidgetDragEndSignalInfo), '("drag-failed", WidgetDragFailedSignalInfo), '("drag-leave", WidgetDragLeaveSignalInfo), '("drag-motion", WidgetDragMotionSignalInfo), '("draw", WidgetDrawSignalInfo), '("enter-notify-event", WidgetEnterNotifyEventSignalInfo), '("event", WidgetEventSignalInfo), '("event-after", WidgetEventAfterSignalInfo), '("focus", WidgetFocusSignalInfo), '("focus-in-event", WidgetFocusInEventSignalInfo), '("focus-out-event", WidgetFocusOutEventSignalInfo), '("grab-broken-event", WidgetGrabBrokenEventSignalInfo), '("grab-focus", WidgetGrabFocusSignalInfo), '("grab-notify", WidgetGrabNotifySignalInfo), '("hide", WidgetHideSignalInfo), '("hierarchy-changed", WidgetHierarchyChangedSignalInfo), '("insert", MenuShellInsertSignalInfo), '("key-press-event", WidgetKeyPressEventSignalInfo), '("key-release-event", WidgetKeyReleaseEventSignalInfo), '("keynav-failed", WidgetKeynavFailedSignalInfo), '("leave-notify-event", WidgetLeaveNotifyEventSignalInfo), '("map", WidgetMapSignalInfo), '("map-event", WidgetMapEventSignalInfo), '("mnemonic-activate", WidgetMnemonicActivateSignalInfo), '("motion-notify-event", WidgetMotionNotifyEventSignalInfo), '("move-current", MenuShellMoveCurrentSignalInfo), '("move-focus", WidgetMoveFocusSignalInfo), '("move-scroll", MenuMoveScrollSignalInfo), '("move-selected", MenuShellMoveSelectedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("parent-set", WidgetParentSetSignalInfo), '("popup-menu", WidgetPopupMenuSignalInfo), '("property-notify-event", WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", WidgetProximityInEventSignalInfo), '("proximity-out-event", WidgetProximityOutEventSignalInfo), '("query-tooltip", WidgetQueryTooltipSignalInfo), '("realize", WidgetRealizeSignalInfo), '("remove", ContainerRemoveSignalInfo), '("screen-changed", WidgetScreenChangedSignalInfo), '("scroll-event", WidgetScrollEventSignalInfo), '("selection-clear-event", WidgetSelectionClearEventSignalInfo), '("selection-done", MenuShellSelectionDoneSignalInfo), '("selection-get", WidgetSelectionGetSignalInfo), '("selection-notify-event", WidgetSelectionNotifyEventSignalInfo), '("selection-received", WidgetSelectionReceivedSignalInfo), '("selection-request-event", WidgetSelectionRequestEventSignalInfo), '("set-focus-child", ContainerSetFocusChildSignalInfo), '("show", WidgetShowSignalInfo), '("show-help", WidgetShowHelpSignalInfo), '("size-allocate", WidgetSizeAllocateSignalInfo), '("state-changed", WidgetStateChangedSignalInfo), '("state-flags-changed", WidgetStateFlagsChangedSignalInfo), '("style-set", WidgetStyleSetSignalInfo), '("style-updated", WidgetStyleUpdatedSignalInfo), '("touch-event", WidgetTouchEventSignalInfo), '("unmap", WidgetUnmapSignalInfo), '("unmap-event", WidgetUnmapEventSignalInfo), '("unrealize", WidgetUnrealizeSignalInfo), '("visibility-notify-event", WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", WidgetWindowStateEventSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method Menu::new
-- method type : Constructor
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "Gtk" "Menu"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_new" gtk_menu_new :: 
    IO (Ptr Menu)


menuNew ::
    (MonadIO m) =>
    m Menu
menuNew  = liftIO $ do
    result <- gtk_menu_new
    checkUnexpectedReturnNULL "gtk_menu_new" result
    result' <- (newObject Menu) result
    return result'

-- method Menu::new_from_model
-- method type : Constructor
-- Args : [Arg {argName = "model", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "model", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Menu"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_new_from_model" gtk_menu_new_from_model :: 
    Ptr Gio.MenuModel ->                    -- model : TInterface "Gio" "MenuModel"
    IO (Ptr Menu)


menuNewFromModel ::
    (MonadIO m, Gio.MenuModelK a) =>
    a ->                                    -- model
    m Menu
menuNewFromModel model = liftIO $ do
    let model' = unsafeManagedPtrCastPtr model
    result <- gtk_menu_new_from_model model'
    checkUnexpectedReturnNULL "gtk_menu_new_from_model" result
    result' <- (newObject Menu) result
    touchManagedPtr model
    return result'

-- method Menu::attach
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "left_attach", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "right_attach", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "top_attach", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bottom_attach", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "left_attach", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "right_attach", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "top_attach", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bottom_attach", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_attach" gtk_menu_attach :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    Ptr Widget ->                           -- child : TInterface "Gtk" "Widget"
    Word32 ->                               -- left_attach : TBasicType TUInt32
    Word32 ->                               -- right_attach : TBasicType TUInt32
    Word32 ->                               -- top_attach : TBasicType TUInt32
    Word32 ->                               -- bottom_attach : TBasicType TUInt32
    IO ()


menuAttach ::
    (MonadIO m, MenuK a, WidgetK b) =>
    a ->                                    -- _obj
    b ->                                    -- child
    Word32 ->                               -- left_attach
    Word32 ->                               -- right_attach
    Word32 ->                               -- top_attach
    Word32 ->                               -- bottom_attach
    m ()
menuAttach _obj child left_attach right_attach top_attach bottom_attach = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let child' = unsafeManagedPtrCastPtr child
    gtk_menu_attach _obj' child' left_attach right_attach top_attach bottom_attach
    touchManagedPtr _obj
    touchManagedPtr child
    return ()

-- method Menu::attach_to_widget
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attach_widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detacher", argType = TInterface "Gtk" "MenuDetachFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attach_widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detacher", argType = TInterface "Gtk" "MenuDetachFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_attach_to_widget" gtk_menu_attach_to_widget :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    Ptr Widget ->                           -- attach_widget : TInterface "Gtk" "Widget"
    FunPtr MenuDetachFuncC ->               -- detacher : TInterface "Gtk" "MenuDetachFunc"
    IO ()


menuAttachToWidget ::
    (MonadIO m, MenuK a, WidgetK b) =>
    a ->                                    -- _obj
    b ->                                    -- attach_widget
    Maybe (MenuDetachFunc) ->               -- detacher
    m ()
menuAttachToWidget _obj attach_widget detacher = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let attach_widget' = unsafeManagedPtrCastPtr attach_widget
    ptrdetacher <- callocMem :: IO (Ptr (FunPtr MenuDetachFuncC))
    maybeDetacher <- case detacher of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jDetacher -> do
            jDetacher' <- mkMenuDetachFunc (menuDetachFuncWrapper (Just ptrdetacher) jDetacher)
            poke ptrdetacher jDetacher'
            return jDetacher'
    gtk_menu_attach_to_widget _obj' attach_widget' maybeDetacher
    touchManagedPtr _obj
    touchManagedPtr attach_widget
    return ()

-- method Menu::detach
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_detach" gtk_menu_detach :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO ()


menuDetach ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m ()
menuDetach _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_menu_detach _obj'
    touchManagedPtr _obj
    return ()

-- method Menu::get_accel_group
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "AccelGroup"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_get_accel_group" gtk_menu_get_accel_group :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO (Ptr AccelGroup)


menuGetAccelGroup ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m AccelGroup
menuGetAccelGroup _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_menu_get_accel_group _obj'
    checkUnexpectedReturnNULL "gtk_menu_get_accel_group" result
    result' <- (newObject AccelGroup) result
    touchManagedPtr _obj
    return result'

-- method Menu::get_accel_path
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_get_accel_path" gtk_menu_get_accel_path :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO CString


menuGetAccelPath ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m T.Text
menuGetAccelPath _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_menu_get_accel_path _obj'
    checkUnexpectedReturnNULL "gtk_menu_get_accel_path" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

-- method Menu::get_active
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Widget"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_get_active" gtk_menu_get_active :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO (Ptr Widget)


menuGetActive ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m Widget
menuGetActive _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_menu_get_active _obj'
    checkUnexpectedReturnNULL "gtk_menu_get_active" result
    result' <- (newObject Widget) result
    touchManagedPtr _obj
    return result'

-- method Menu::get_attach_widget
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Widget"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_get_attach_widget" gtk_menu_get_attach_widget :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO (Ptr Widget)


menuGetAttachWidget ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m Widget
menuGetAttachWidget _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_menu_get_attach_widget _obj'
    checkUnexpectedReturnNULL "gtk_menu_get_attach_widget" result
    result' <- (newObject Widget) result
    touchManagedPtr _obj
    return result'

-- method Menu::get_monitor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_get_monitor" gtk_menu_get_monitor :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO Int32


menuGetMonitor ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m Int32
menuGetMonitor _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_menu_get_monitor _obj'
    touchManagedPtr _obj
    return result

-- method Menu::get_reserve_toggle_size
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_get_reserve_toggle_size" gtk_menu_get_reserve_toggle_size :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO CInt


menuGetReserveToggleSize ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m Bool
menuGetReserveToggleSize _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_menu_get_reserve_toggle_size _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Menu::get_tearoff_state
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_get_tearoff_state" gtk_menu_get_tearoff_state :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO CInt

{-# DEPRECATED menuGetTearoffState ["(Since version 3.10)"]#-}
menuGetTearoffState ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m Bool
menuGetTearoffState _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_menu_get_tearoff_state _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Menu::get_title
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_get_title" gtk_menu_get_title :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO CString

{-# DEPRECATED menuGetTitle ["(Since version 3.10)"]#-}
menuGetTitle ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m T.Text
menuGetTitle _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_menu_get_title _obj'
    checkUnexpectedReturnNULL "gtk_menu_get_title" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

-- method Menu::popdown
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_popdown" gtk_menu_popdown :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO ()


menuPopdown ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m ()
menuPopdown _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_menu_popdown _obj'
    touchManagedPtr _obj
    return ()

-- method Menu::popup
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_menu_shell", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_menu_item", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Gtk" "MenuPositionFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "activate_time", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_menu_shell", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_menu_item", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Gtk" "MenuPositionFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "activate_time", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_popup" gtk_menu_popup :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    Ptr Widget ->                           -- parent_menu_shell : TInterface "Gtk" "Widget"
    Ptr Widget ->                           -- parent_menu_item : TInterface "Gtk" "Widget"
    FunPtr MenuPositionFuncC ->             -- func : TInterface "Gtk" "MenuPositionFunc"
    Ptr () ->                               -- data : TBasicType TVoid
    Word32 ->                               -- button : TBasicType TUInt32
    Word32 ->                               -- activate_time : TBasicType TUInt32
    IO ()


menuPopup ::
    (MonadIO m, MenuK a, WidgetK b, WidgetK c) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- parent_menu_shell
    Maybe (c) ->                            -- parent_menu_item
    Maybe (MenuPositionFunc) ->             -- func
    Word32 ->                               -- button
    Word32 ->                               -- activate_time
    m ()
menuPopup _obj parent_menu_shell parent_menu_item func button activate_time = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeParent_menu_shell <- case parent_menu_shell of
        Nothing -> return nullPtr
        Just jParent_menu_shell -> do
            let jParent_menu_shell' = unsafeManagedPtrCastPtr jParent_menu_shell
            return jParent_menu_shell'
    maybeParent_menu_item <- case parent_menu_item of
        Nothing -> return nullPtr
        Just jParent_menu_item -> do
            let jParent_menu_item' = unsafeManagedPtrCastPtr jParent_menu_item
            return jParent_menu_item'
    ptrfunc <- callocMem :: IO (Ptr (FunPtr MenuPositionFuncC))
    maybeFunc <- case func of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jFunc -> do
            jFunc' <- mkMenuPositionFunc (menuPositionFuncWrapper (Just ptrfunc) jFunc)
            poke ptrfunc jFunc'
            return jFunc'
    let data_ = nullPtr
    gtk_menu_popup _obj' maybeParent_menu_shell maybeParent_menu_item maybeFunc data_ button activate_time
    touchManagedPtr _obj
    whenJust parent_menu_shell touchManagedPtr
    whenJust parent_menu_item touchManagedPtr
    return ()

-- method Menu::popup_for_device
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_menu_shell", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_menu_item", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Gtk" "MenuPositionFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "activate_time", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_menu_shell", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_menu_item", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Gtk" "MenuPositionFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "activate_time", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_popup_for_device" gtk_menu_popup_for_device :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    Ptr Gdk.Device ->                       -- device : TInterface "Gdk" "Device"
    Ptr Widget ->                           -- parent_menu_shell : TInterface "Gtk" "Widget"
    Ptr Widget ->                           -- parent_menu_item : TInterface "Gtk" "Widget"
    FunPtr MenuPositionFuncC ->             -- func : TInterface "Gtk" "MenuPositionFunc"
    Ptr () ->                               -- data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- destroy : TInterface "GLib" "DestroyNotify"
    Word32 ->                               -- button : TBasicType TUInt32
    Word32 ->                               -- activate_time : TBasicType TUInt32
    IO ()


menuPopupForDevice ::
    (MonadIO m, MenuK a, Gdk.DeviceK b, WidgetK c, WidgetK d) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- device
    Maybe (c) ->                            -- parent_menu_shell
    Maybe (d) ->                            -- parent_menu_item
    Maybe (MenuPositionFunc) ->             -- func
    Word32 ->                               -- button
    Word32 ->                               -- activate_time
    m ()
menuPopupForDevice _obj device parent_menu_shell parent_menu_item func button activate_time = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeDevice <- case device of
        Nothing -> return nullPtr
        Just jDevice -> do
            let jDevice' = unsafeManagedPtrCastPtr jDevice
            return jDevice'
    maybeParent_menu_shell <- case parent_menu_shell of
        Nothing -> return nullPtr
        Just jParent_menu_shell -> do
            let jParent_menu_shell' = unsafeManagedPtrCastPtr jParent_menu_shell
            return jParent_menu_shell'
    maybeParent_menu_item <- case parent_menu_item of
        Nothing -> return nullPtr
        Just jParent_menu_item -> do
            let jParent_menu_item' = unsafeManagedPtrCastPtr jParent_menu_item
            return jParent_menu_item'
    maybeFunc <- case func of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jFunc -> do
            jFunc' <- mkMenuPositionFunc (menuPositionFuncWrapper Nothing jFunc)
            return jFunc'
    let data_ = castFunPtrToPtr maybeFunc
    let destroy = safeFreeFunPtrPtr
    gtk_menu_popup_for_device _obj' maybeDevice maybeParent_menu_shell maybeParent_menu_item maybeFunc data_ destroy button activate_time
    touchManagedPtr _obj
    whenJust device touchManagedPtr
    whenJust parent_menu_shell touchManagedPtr
    whenJust parent_menu_item touchManagedPtr
    return ()

-- method Menu::reorder_child
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_reorder_child" gtk_menu_reorder_child :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    Ptr Widget ->                           -- child : TInterface "Gtk" "Widget"
    Int32 ->                                -- position : TBasicType TInt32
    IO ()


menuReorderChild ::
    (MonadIO m, MenuK a, WidgetK b) =>
    a ->                                    -- _obj
    b ->                                    -- child
    Int32 ->                                -- position
    m ()
menuReorderChild _obj child position = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let child' = unsafeManagedPtrCastPtr child
    gtk_menu_reorder_child _obj' child' position
    touchManagedPtr _obj
    touchManagedPtr child
    return ()

-- method Menu::reposition
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_reposition" gtk_menu_reposition :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    IO ()


menuReposition ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    m ()
menuReposition _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_menu_reposition _obj'
    touchManagedPtr _obj
    return ()

-- method Menu::set_accel_group
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_group", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_group", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_set_accel_group" gtk_menu_set_accel_group :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    Ptr AccelGroup ->                       -- accel_group : TInterface "Gtk" "AccelGroup"
    IO ()


menuSetAccelGroup ::
    (MonadIO m, MenuK a, AccelGroupK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- accel_group
    m ()
menuSetAccelGroup _obj accel_group = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeAccel_group <- case accel_group of
        Nothing -> return nullPtr
        Just jAccel_group -> do
            let jAccel_group' = unsafeManagedPtrCastPtr jAccel_group
            return jAccel_group'
    gtk_menu_set_accel_group _obj' maybeAccel_group
    touchManagedPtr _obj
    whenJust accel_group touchManagedPtr
    return ()

-- method Menu::set_accel_path
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_set_accel_path" gtk_menu_set_accel_path :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    CString ->                              -- accel_path : TBasicType TUTF8
    IO ()


menuSetAccelPath ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    Maybe (T.Text) ->                       -- accel_path
    m ()
menuSetAccelPath _obj accel_path = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeAccel_path <- case accel_path of
        Nothing -> return nullPtr
        Just jAccel_path -> do
            jAccel_path' <- textToCString jAccel_path
            return jAccel_path'
    gtk_menu_set_accel_path _obj' maybeAccel_path
    touchManagedPtr _obj
    freeMem maybeAccel_path
    return ()

-- method Menu::set_active
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_set_active" gtk_menu_set_active :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    Word32 ->                               -- index : TBasicType TUInt32
    IO ()


menuSetActive ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    Word32 ->                               -- index
    m ()
menuSetActive _obj index = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_menu_set_active _obj' index
    touchManagedPtr _obj
    return ()

-- method Menu::set_monitor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_set_monitor" gtk_menu_set_monitor :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    Int32 ->                                -- monitor_num : TBasicType TInt32
    IO ()


menuSetMonitor ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- monitor_num
    m ()
menuSetMonitor _obj monitor_num = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_menu_set_monitor _obj' monitor_num
    touchManagedPtr _obj
    return ()

-- method Menu::set_reserve_toggle_size
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reserve_toggle_size", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reserve_toggle_size", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_set_reserve_toggle_size" gtk_menu_set_reserve_toggle_size :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    CInt ->                                 -- reserve_toggle_size : TBasicType TBoolean
    IO ()


menuSetReserveToggleSize ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- reserve_toggle_size
    m ()
menuSetReserveToggleSize _obj reserve_toggle_size = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let reserve_toggle_size' = (fromIntegral . fromEnum) reserve_toggle_size
    gtk_menu_set_reserve_toggle_size _obj' reserve_toggle_size'
    touchManagedPtr _obj
    return ()

-- method Menu::set_screen
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "screen", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "screen", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_set_screen" gtk_menu_set_screen :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    Ptr Gdk.Screen ->                       -- screen : TInterface "Gdk" "Screen"
    IO ()


menuSetScreen ::
    (MonadIO m, MenuK a, Gdk.ScreenK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- screen
    m ()
menuSetScreen _obj screen = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeScreen <- case screen of
        Nothing -> return nullPtr
        Just jScreen -> do
            let jScreen' = unsafeManagedPtrCastPtr jScreen
            return jScreen'
    gtk_menu_set_screen _obj' maybeScreen
    touchManagedPtr _obj
    whenJust screen touchManagedPtr
    return ()

-- method Menu::set_tearoff_state
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "torn_off", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "torn_off", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_set_tearoff_state" gtk_menu_set_tearoff_state :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    CInt ->                                 -- torn_off : TBasicType TBoolean
    IO ()

{-# DEPRECATED menuSetTearoffState ["(Since version 3.10)"]#-}
menuSetTearoffState ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- torn_off
    m ()
menuSetTearoffState _obj torn_off = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let torn_off' = (fromIntegral . fromEnum) torn_off
    gtk_menu_set_tearoff_state _obj' torn_off'
    touchManagedPtr _obj
    return ()

-- method Menu::set_title
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "title", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "title", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_set_title" gtk_menu_set_title :: 
    Ptr Menu ->                             -- _obj : TInterface "Gtk" "Menu"
    CString ->                              -- title : TBasicType TUTF8
    IO ()

{-# DEPRECATED menuSetTitle ["(Since version 3.10)"]#-}
menuSetTitle ::
    (MonadIO m, MenuK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- title
    m ()
menuSetTitle _obj title = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    title' <- textToCString title
    gtk_menu_set_title _obj' title'
    touchManagedPtr _obj
    freeMem title'
    return ()

-- method Menu::get_for_attach_widget
-- method type : MemberFunction
-- Args : [Arg {argName = "widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGList (TInterface "Gtk" "Widget")
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_get_for_attach_widget" gtk_menu_get_for_attach_widget :: 
    Ptr Widget ->                           -- widget : TInterface "Gtk" "Widget"
    IO (Ptr (GList (Ptr Widget)))


menuGetForAttachWidget ::
    (MonadIO m, WidgetK a) =>
    a ->                                    -- widget
    m [Widget]
menuGetForAttachWidget widget = liftIO $ do
    let widget' = unsafeManagedPtrCastPtr widget
    result <- gtk_menu_get_for_attach_widget widget'
    checkUnexpectedReturnNULL "gtk_menu_get_for_attach_widget" result
    result' <- unpackGList result
    result'' <- mapM (newObject Widget) result'
    touchManagedPtr widget
    return result''