{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gtk.Objects.MenuButton.MenuButton' widget is used to display a popup when clicked on.
-- This popup can be provided either as a t'GI.Gtk.Objects.Menu.Menu', a t'GI.Gtk.Objects.Popover.Popover' or an
-- abstract t'GI.Gio.Objects.MenuModel.MenuModel'.
-- 
-- The t'GI.Gtk.Objects.MenuButton.MenuButton' widget can hold any valid child widget. That is, it
-- can hold almost any other standard t'GI.Gtk.Objects.Widget.Widget'. The most commonly used
-- child is t'GI.Gtk.Objects.Image.Image'. If no widget is explicitely added to the t'GI.Gtk.Objects.MenuButton.MenuButton',
-- a t'GI.Gtk.Objects.Image.Image' is automatically created, using an arrow image oriented
-- according to t'GI.Gtk.Objects.MenuButton.MenuButton':@/direction/@ or the generic “open-menu-symbolic”
-- icon if the direction is not set.
-- 
-- The positioning of the popup is determined by the t'GI.Gtk.Objects.MenuButton.MenuButton':@/direction/@
-- property of the menu button.
-- 
-- For menus, the t'GI.Gtk.Objects.Widget.Widget':@/halign/@ and t'GI.Gtk.Objects.Widget.Widget':@/valign/@ properties of the
-- menu are also taken into account. For example, when the direction is
-- 'GI.Gtk.Enums.ArrowTypeDown' and the horizontal alignment is 'GI.Gtk.Enums.AlignStart', the
-- menu will be positioned below the button, with the starting edge
-- (depending on the text direction) of the menu aligned with the starting
-- edge of the button. If there is not enough space below the button, the
-- menu is popped up above the button instead. If the alignment would move
-- part of the menu offscreen, it is “pushed in”.
-- 
-- == Direction = Down
-- 
-- 
-- * halign = start
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/down-start.png>>
-- 
-- * halign = center
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/down-center.png>>
-- 
-- * halign = end
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/down-end.png>>
-- 
-- == Direction = Up
-- 
-- 
-- * halign = start
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/up-start.png>>
-- 
-- * halign = center
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/up-center.png>>
-- 
-- * halign = end
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/up-end.png>>
-- 
-- == Direction = Left
-- 
-- 
-- * valign = start
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/left-start.png>>
-- 
-- * valign = center
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/left-center.png>>
-- 
-- * valign = end
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/left-end.png>>
-- 
-- == Direction = Right
-- 
-- 
-- * valign = start
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/right-start.png>>
-- 
-- * valign = center
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/right-center.png>>
-- 
-- * valign = end
-- 
-- 
--     <<https://developer.gnome.org/gtk4/stable/right-end.png>>
-- 
-- = CSS nodes
-- 
-- GtkMenuButton has a single CSS node with name button. To differentiate
-- it from a plain t'GI.Gtk.Objects.Button.Button', it gets the .popup style class.

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

module GI.Gtk.Objects.MenuButton
    ( 

-- * Exported types
    MenuButton(..)                          ,
    IsMenuButton                            ,
    toMenuButton                            ,
    noMenuButton                            ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveMenuButtonMethod                 ,
#endif


-- ** getAlignWidget #method:getAlignWidget#

#if defined(ENABLE_OVERLOADING)
    MenuButtonGetAlignWidgetMethodInfo      ,
#endif
    menuButtonGetAlignWidget                ,


-- ** getDirection #method:getDirection#

#if defined(ENABLE_OVERLOADING)
    MenuButtonGetDirectionMethodInfo        ,
#endif
    menuButtonGetDirection                  ,


-- ** getMenuModel #method:getMenuModel#

#if defined(ENABLE_OVERLOADING)
    MenuButtonGetMenuModelMethodInfo        ,
#endif
    menuButtonGetMenuModel                  ,


-- ** getPopover #method:getPopover#

#if defined(ENABLE_OVERLOADING)
    MenuButtonGetPopoverMethodInfo          ,
#endif
    menuButtonGetPopover                    ,


-- ** getPopup #method:getPopup#

#if defined(ENABLE_OVERLOADING)
    MenuButtonGetPopupMethodInfo            ,
#endif
    menuButtonGetPopup                      ,


-- ** getUsePopover #method:getUsePopover#

#if defined(ENABLE_OVERLOADING)
    MenuButtonGetUsePopoverMethodInfo       ,
#endif
    menuButtonGetUsePopover                 ,


-- ** new #method:new#

    menuButtonNew                           ,


-- ** setAlignWidget #method:setAlignWidget#

#if defined(ENABLE_OVERLOADING)
    MenuButtonSetAlignWidgetMethodInfo      ,
#endif
    menuButtonSetAlignWidget                ,


-- ** setDirection #method:setDirection#

#if defined(ENABLE_OVERLOADING)
    MenuButtonSetDirectionMethodInfo        ,
#endif
    menuButtonSetDirection                  ,


-- ** setMenuModel #method:setMenuModel#

#if defined(ENABLE_OVERLOADING)
    MenuButtonSetMenuModelMethodInfo        ,
#endif
    menuButtonSetMenuModel                  ,


-- ** setPopover #method:setPopover#

#if defined(ENABLE_OVERLOADING)
    MenuButtonSetPopoverMethodInfo          ,
#endif
    menuButtonSetPopover                    ,


-- ** setPopup #method:setPopup#

#if defined(ENABLE_OVERLOADING)
    MenuButtonSetPopupMethodInfo            ,
#endif
    menuButtonSetPopup                      ,


-- ** setUsePopover #method:setUsePopover#

#if defined(ENABLE_OVERLOADING)
    MenuButtonSetUsePopoverMethodInfo       ,
#endif
    menuButtonSetUsePopover                 ,




 -- * Properties
-- ** alignWidget #attr:alignWidget#
-- | The t'GI.Gtk.Objects.Widget.Widget' to use to align the menu with.

#if defined(ENABLE_OVERLOADING)
    MenuButtonAlignWidgetPropertyInfo       ,
#endif
    clearMenuButtonAlignWidget              ,
    constructMenuButtonAlignWidget          ,
    getMenuButtonAlignWidget                ,
#if defined(ENABLE_OVERLOADING)
    menuButtonAlignWidget                   ,
#endif
    setMenuButtonAlignWidget                ,


-- ** direction #attr:direction#
-- | The t'GI.Gtk.Enums.ArrowType' representing the direction in which the
-- menu or popover will be popped out.

#if defined(ENABLE_OVERLOADING)
    MenuButtonDirectionPropertyInfo         ,
#endif
    constructMenuButtonDirection            ,
    getMenuButtonDirection                  ,
#if defined(ENABLE_OVERLOADING)
    menuButtonDirection                     ,
#endif
    setMenuButtonDirection                  ,


-- ** menuModel #attr:menuModel#
-- | The t'GI.Gio.Objects.MenuModel.MenuModel' from which the popup will be created.
-- Depending on the t'GI.Gtk.Objects.MenuButton.MenuButton':@/use-popover/@ property, that may
-- be a menu or a popover.
-- 
-- See 'GI.Gtk.Objects.MenuButton.menuButtonSetMenuModel' for the interaction with the
-- t'GI.Gtk.Objects.MenuButton.MenuButton':@/popup/@ property.

#if defined(ENABLE_OVERLOADING)
    MenuButtonMenuModelPropertyInfo         ,
#endif
    clearMenuButtonMenuModel                ,
    constructMenuButtonMenuModel            ,
    getMenuButtonMenuModel                  ,
#if defined(ENABLE_OVERLOADING)
    menuButtonMenuModel                     ,
#endif
    setMenuButtonMenuModel                  ,


-- ** popover #attr:popover#
-- | The t'GI.Gtk.Objects.Popover.Popover' that will be popped up when the button is clicked.

#if defined(ENABLE_OVERLOADING)
    MenuButtonPopoverPropertyInfo           ,
#endif
    clearMenuButtonPopover                  ,
    constructMenuButtonPopover              ,
    getMenuButtonPopover                    ,
#if defined(ENABLE_OVERLOADING)
    menuButtonPopover                       ,
#endif
    setMenuButtonPopover                    ,


-- ** popup #attr:popup#
-- | The t'GI.Gtk.Objects.Menu.Menu' that will be popped up when the button is clicked.

#if defined(ENABLE_OVERLOADING)
    MenuButtonPopupPropertyInfo             ,
#endif
    clearMenuButtonPopup                    ,
    constructMenuButtonPopup                ,
    getMenuButtonPopup                      ,
#if defined(ENABLE_OVERLOADING)
    menuButtonPopup                         ,
#endif
    setMenuButtonPopup                      ,


-- ** usePopover #attr:usePopover#
-- | Whether to construct a t'GI.Gtk.Objects.Popover.Popover' from the menu model,
-- or a t'GI.Gtk.Objects.Menu.Menu'.

#if defined(ENABLE_OVERLOADING)
    MenuButtonUsePopoverPropertyInfo        ,
#endif
    constructMenuButtonUsePopover           ,
    getMenuButtonUsePopover                 ,
#if defined(ENABLE_OVERLOADING)
    menuButtonUsePopover                    ,
#endif
    setMenuButtonUsePopover                 ,




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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 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 GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Actionable as Gtk.Actionable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Bin as Gtk.Bin
import {-# SOURCE #-} qualified GI.Gtk.Objects.Button as Gtk.Button
import {-# SOURCE #-} qualified GI.Gtk.Objects.Container as Gtk.Container
import {-# SOURCE #-} qualified GI.Gtk.Objects.Menu as Gtk.Menu
import {-# SOURCE #-} qualified GI.Gtk.Objects.Popover as Gtk.Popover
import {-# SOURCE #-} qualified GI.Gtk.Objects.ToggleButton as Gtk.ToggleButton
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

-- | Memory-managed wrapper type.
newtype MenuButton = MenuButton (ManagedPtr MenuButton)
    deriving (MenuButton -> MenuButton -> Bool
(MenuButton -> MenuButton -> Bool)
-> (MenuButton -> MenuButton -> Bool) -> Eq MenuButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MenuButton -> MenuButton -> Bool
$c/= :: MenuButton -> MenuButton -> Bool
== :: MenuButton -> MenuButton -> Bool
$c== :: MenuButton -> MenuButton -> Bool
Eq)
foreign import ccall "gtk_menu_button_get_type"
    c_gtk_menu_button_get_type :: IO GType

instance GObject MenuButton where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_menu_button_get_type
    

-- | Convert 'MenuButton' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue MenuButton where
    toGValue :: MenuButton -> IO GValue
toGValue o :: MenuButton
o = do
        GType
gtype <- IO GType
c_gtk_menu_button_get_type
        MenuButton -> (Ptr MenuButton -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr MenuButton
o (GType
-> (GValue -> Ptr MenuButton -> IO ())
-> Ptr MenuButton
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr MenuButton -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO MenuButton
fromGValue gv :: GValue
gv = do
        Ptr MenuButton
ptr <- GValue -> IO (Ptr MenuButton)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr MenuButton)
        (ManagedPtr MenuButton -> MenuButton)
-> Ptr MenuButton -> IO MenuButton
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr MenuButton -> MenuButton
MenuButton Ptr MenuButton
ptr
        
    

-- | Type class for types which can be safely cast to `MenuButton`, for instance with `toMenuButton`.
class (GObject o, O.IsDescendantOf MenuButton o) => IsMenuButton o
instance (GObject o, O.IsDescendantOf MenuButton o) => IsMenuButton o

instance O.HasParentTypes MenuButton
type instance O.ParentTypes MenuButton = '[Gtk.ToggleButton.ToggleButton, Gtk.Button.Button, Gtk.Bin.Bin, Gtk.Container.Container, Gtk.Widget.Widget, GObject.Object.Object, Atk.ImplementorIface.ImplementorIface, Gtk.Actionable.Actionable, Gtk.Buildable.Buildable]

-- | Cast to `MenuButton`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toMenuButton :: (MonadIO m, IsMenuButton o) => o -> m MenuButton
toMenuButton :: o -> m MenuButton
toMenuButton = IO MenuButton -> m MenuButton
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MenuButton -> m MenuButton)
-> (o -> IO MenuButton) -> o -> m MenuButton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr MenuButton -> MenuButton) -> o -> IO MenuButton
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr MenuButton -> MenuButton
MenuButton

-- | A convenience alias for `Nothing` :: `Maybe` `MenuButton`.
noMenuButton :: Maybe MenuButton
noMenuButton :: Maybe MenuButton
noMenuButton = Maybe MenuButton
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveMenuButtonMethod (t :: Symbol) (o :: *) :: * where
    ResolveMenuButtonMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveMenuButtonMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveMenuButtonMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveMenuButtonMethod "add" o = Gtk.Container.ContainerAddMethodInfo
    ResolveMenuButtonMethod "addAccelerator" o = Gtk.Widget.WidgetAddAcceleratorMethodInfo
    ResolveMenuButtonMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveMenuButtonMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveMenuButtonMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveMenuButtonMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveMenuButtonMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveMenuButtonMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMenuButtonMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMenuButtonMethod "canActivateAccel" o = Gtk.Widget.WidgetCanActivateAccelMethodInfo
    ResolveMenuButtonMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveMenuButtonMethod "childType" o = Gtk.Container.ContainerChildTypeMethodInfo
    ResolveMenuButtonMethod "clicked" o = Gtk.Button.ButtonClickedMethodInfo
    ResolveMenuButtonMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveMenuButtonMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveMenuButtonMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveMenuButtonMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveMenuButtonMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveMenuButtonMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveMenuButtonMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveMenuButtonMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveMenuButtonMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveMenuButtonMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveMenuButtonMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveMenuButtonMethod "destroy" o = Gtk.Widget.WidgetDestroyMethodInfo
    ResolveMenuButtonMethod "destroyed" o = Gtk.Widget.WidgetDestroyedMethodInfo
    ResolveMenuButtonMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveMenuButtonMethod "dragBegin" o = Gtk.Widget.WidgetDragBeginMethodInfo
    ResolveMenuButtonMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveMenuButtonMethod "dragDestAddImageTargets" o = Gtk.Widget.WidgetDragDestAddImageTargetsMethodInfo
    ResolveMenuButtonMethod "dragDestAddTextTargets" o = Gtk.Widget.WidgetDragDestAddTextTargetsMethodInfo
    ResolveMenuButtonMethod "dragDestAddUriTargets" o = Gtk.Widget.WidgetDragDestAddUriTargetsMethodInfo
    ResolveMenuButtonMethod "dragDestFindTarget" o = Gtk.Widget.WidgetDragDestFindTargetMethodInfo
    ResolveMenuButtonMethod "dragDestGetTargetList" o = Gtk.Widget.WidgetDragDestGetTargetListMethodInfo
    ResolveMenuButtonMethod "dragDestGetTrackMotion" o = Gtk.Widget.WidgetDragDestGetTrackMotionMethodInfo
    ResolveMenuButtonMethod "dragDestSet" o = Gtk.Widget.WidgetDragDestSetMethodInfo
    ResolveMenuButtonMethod "dragDestSetTargetList" o = Gtk.Widget.WidgetDragDestSetTargetListMethodInfo
    ResolveMenuButtonMethod "dragDestSetTrackMotion" o = Gtk.Widget.WidgetDragDestSetTrackMotionMethodInfo
    ResolveMenuButtonMethod "dragDestUnset" o = Gtk.Widget.WidgetDragDestUnsetMethodInfo
    ResolveMenuButtonMethod "dragGetData" o = Gtk.Widget.WidgetDragGetDataMethodInfo
    ResolveMenuButtonMethod "dragHighlight" o = Gtk.Widget.WidgetDragHighlightMethodInfo
    ResolveMenuButtonMethod "dragSourceAddImageTargets" o = Gtk.Widget.WidgetDragSourceAddImageTargetsMethodInfo
    ResolveMenuButtonMethod "dragSourceAddTextTargets" o = Gtk.Widget.WidgetDragSourceAddTextTargetsMethodInfo
    ResolveMenuButtonMethod "dragSourceAddUriTargets" o = Gtk.Widget.WidgetDragSourceAddUriTargetsMethodInfo
    ResolveMenuButtonMethod "dragSourceGetTargetList" o = Gtk.Widget.WidgetDragSourceGetTargetListMethodInfo
    ResolveMenuButtonMethod "dragSourceSet" o = Gtk.Widget.WidgetDragSourceSetMethodInfo
    ResolveMenuButtonMethod "dragSourceSetIconGicon" o = Gtk.Widget.WidgetDragSourceSetIconGiconMethodInfo
    ResolveMenuButtonMethod "dragSourceSetIconName" o = Gtk.Widget.WidgetDragSourceSetIconNameMethodInfo
    ResolveMenuButtonMethod "dragSourceSetIconPaintable" o = Gtk.Widget.WidgetDragSourceSetIconPaintableMethodInfo
    ResolveMenuButtonMethod "dragSourceSetTargetList" o = Gtk.Widget.WidgetDragSourceSetTargetListMethodInfo
    ResolveMenuButtonMethod "dragSourceUnset" o = Gtk.Widget.WidgetDragSourceUnsetMethodInfo
    ResolveMenuButtonMethod "dragUnhighlight" o = Gtk.Widget.WidgetDragUnhighlightMethodInfo
    ResolveMenuButtonMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveMenuButtonMethod "event" o = Gtk.Widget.WidgetEventMethodInfo
    ResolveMenuButtonMethod "forall" o = Gtk.Container.ContainerForallMethodInfo
    ResolveMenuButtonMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMenuButtonMethod "foreach" o = Gtk.Container.ContainerForeachMethodInfo
    ResolveMenuButtonMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMenuButtonMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMenuButtonMethod "grabAdd" o = Gtk.Widget.WidgetGrabAddMethodInfo
    ResolveMenuButtonMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveMenuButtonMethod "grabRemove" o = Gtk.Widget.WidgetGrabRemoveMethodInfo
    ResolveMenuButtonMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveMenuButtonMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveMenuButtonMethod "hasGrab" o = Gtk.Widget.WidgetHasGrabMethodInfo
    ResolveMenuButtonMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveMenuButtonMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveMenuButtonMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveMenuButtonMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveMenuButtonMethod "inputShapeCombineRegion" o = Gtk.Widget.WidgetInputShapeCombineRegionMethodInfo
    ResolveMenuButtonMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveMenuButtonMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveMenuButtonMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveMenuButtonMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveMenuButtonMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveMenuButtonMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMenuButtonMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveMenuButtonMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveMenuButtonMethod "isToplevel" o = Gtk.Widget.WidgetIsToplevelMethodInfo
    ResolveMenuButtonMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveMenuButtonMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveMenuButtonMethod "listAccelClosures" o = Gtk.Widget.WidgetListAccelClosuresMethodInfo
    ResolveMenuButtonMethod "listActionPrefixes" o = Gtk.Widget.WidgetListActionPrefixesMethodInfo
    ResolveMenuButtonMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveMenuButtonMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveMenuButtonMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveMenuButtonMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveMenuButtonMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMenuButtonMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMenuButtonMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveMenuButtonMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveMenuButtonMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveMenuButtonMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveMenuButtonMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveMenuButtonMethod "queueComputeExpand" o = Gtk.Widget.WidgetQueueComputeExpandMethodInfo
    ResolveMenuButtonMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveMenuButtonMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveMenuButtonMethod "queueResizeNoRedraw" o = Gtk.Widget.WidgetQueueResizeNoRedrawMethodInfo
    ResolveMenuButtonMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveMenuButtonMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMenuButtonMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMenuButtonMethod "registerSurface" o = Gtk.Widget.WidgetRegisterSurfaceMethodInfo
    ResolveMenuButtonMethod "remove" o = Gtk.Container.ContainerRemoveMethodInfo
    ResolveMenuButtonMethod "removeAccelerator" o = Gtk.Widget.WidgetRemoveAcceleratorMethodInfo
    ResolveMenuButtonMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveMenuButtonMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveMenuButtonMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveMenuButtonMethod "resetStyle" o = Gtk.Widget.WidgetResetStyleMethodInfo
    ResolveMenuButtonMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMenuButtonMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveMenuButtonMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveMenuButtonMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveMenuButtonMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMenuButtonMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMenuButtonMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMenuButtonMethod "toggled" o = Gtk.ToggleButton.ToggleButtonToggledMethodInfo
    ResolveMenuButtonMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveMenuButtonMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveMenuButtonMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveMenuButtonMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveMenuButtonMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveMenuButtonMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMenuButtonMethod "unregisterSurface" o = Gtk.Widget.WidgetUnregisterSurfaceMethodInfo
    ResolveMenuButtonMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveMenuButtonMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMenuButtonMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveMenuButtonMethod "getActionGroup" o = Gtk.Widget.WidgetGetActionGroupMethodInfo
    ResolveMenuButtonMethod "getActionName" o = Gtk.Actionable.ActionableGetActionNameMethodInfo
    ResolveMenuButtonMethod "getActionTargetValue" o = Gtk.Actionable.ActionableGetActionTargetValueMethodInfo
    ResolveMenuButtonMethod "getActive" o = Gtk.ToggleButton.ToggleButtonGetActiveMethodInfo
    ResolveMenuButtonMethod "getAlignWidget" o = MenuButtonGetAlignWidgetMethodInfo
    ResolveMenuButtonMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveMenuButtonMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveMenuButtonMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveMenuButtonMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveMenuButtonMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveMenuButtonMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveMenuButtonMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveMenuButtonMethod "getChild" o = Gtk.Bin.BinGetChildMethodInfo
    ResolveMenuButtonMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveMenuButtonMethod "getChildren" o = Gtk.Container.ContainerGetChildrenMethodInfo
    ResolveMenuButtonMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveMenuButtonMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveMenuButtonMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMenuButtonMethod "getDirection" o = MenuButtonGetDirectionMethodInfo
    ResolveMenuButtonMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveMenuButtonMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveMenuButtonMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveMenuButtonMethod "getFocusHadjustment" o = Gtk.Container.ContainerGetFocusHadjustmentMethodInfo
    ResolveMenuButtonMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveMenuButtonMethod "getFocusVadjustment" o = Gtk.Container.ContainerGetFocusVadjustmentMethodInfo
    ResolveMenuButtonMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveMenuButtonMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveMenuButtonMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveMenuButtonMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveMenuButtonMethod "getHasSurface" o = Gtk.Widget.WidgetGetHasSurfaceMethodInfo
    ResolveMenuButtonMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveMenuButtonMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveMenuButtonMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveMenuButtonMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveMenuButtonMethod "getIconName" o = Gtk.Button.ButtonGetIconNameMethodInfo
    ResolveMenuButtonMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveMenuButtonMethod "getLabel" o = Gtk.Button.ButtonGetLabelMethodInfo
    ResolveMenuButtonMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveMenuButtonMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveMenuButtonMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveMenuButtonMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveMenuButtonMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveMenuButtonMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveMenuButtonMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveMenuButtonMethod "getMenuModel" o = MenuButtonGetMenuModelMethodInfo
    ResolveMenuButtonMethod "getModifierMask" o = Gtk.Widget.WidgetGetModifierMaskMethodInfo
    ResolveMenuButtonMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveMenuButtonMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveMenuButtonMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveMenuButtonMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveMenuButtonMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveMenuButtonMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveMenuButtonMethod "getPath" o = Gtk.Widget.WidgetGetPathMethodInfo
    ResolveMenuButtonMethod "getPathForChild" o = Gtk.Container.ContainerGetPathForChildMethodInfo
    ResolveMenuButtonMethod "getPopover" o = MenuButtonGetPopoverMethodInfo
    ResolveMenuButtonMethod "getPopup" o = MenuButtonGetPopupMethodInfo
    ResolveMenuButtonMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveMenuButtonMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveMenuButtonMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveMenuButtonMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMenuButtonMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMenuButtonMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveMenuButtonMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveMenuButtonMethod "getRelief" o = Gtk.Button.ButtonGetReliefMethodInfo
    ResolveMenuButtonMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveMenuButtonMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveMenuButtonMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveMenuButtonMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveMenuButtonMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveMenuButtonMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveMenuButtonMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveMenuButtonMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveMenuButtonMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveMenuButtonMethod "getSurface" o = Gtk.Widget.WidgetGetSurfaceMethodInfo
    ResolveMenuButtonMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveMenuButtonMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveMenuButtonMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveMenuButtonMethod "getTooltipWindow" o = Gtk.Widget.WidgetGetTooltipWindowMethodInfo
    ResolveMenuButtonMethod "getToplevel" o = Gtk.Widget.WidgetGetToplevelMethodInfo
    ResolveMenuButtonMethod "getUsePopover" o = MenuButtonGetUsePopoverMethodInfo
    ResolveMenuButtonMethod "getUseUnderline" o = Gtk.Button.ButtonGetUseUnderlineMethodInfo
    ResolveMenuButtonMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveMenuButtonMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveMenuButtonMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveMenuButtonMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveMenuButtonMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveMenuButtonMethod "setAccelPath" o = Gtk.Widget.WidgetSetAccelPathMethodInfo
    ResolveMenuButtonMethod "setActionName" o = Gtk.Actionable.ActionableSetActionNameMethodInfo
    ResolveMenuButtonMethod "setActionTargetValue" o = Gtk.Actionable.ActionableSetActionTargetValueMethodInfo
    ResolveMenuButtonMethod "setActive" o = Gtk.ToggleButton.ToggleButtonSetActiveMethodInfo
    ResolveMenuButtonMethod "setAlignWidget" o = MenuButtonSetAlignWidgetMethodInfo
    ResolveMenuButtonMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveMenuButtonMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveMenuButtonMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveMenuButtonMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveMenuButtonMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveMenuButtonMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveMenuButtonMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMenuButtonMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMenuButtonMethod "setDetailedActionName" o = Gtk.Actionable.ActionableSetDetailedActionNameMethodInfo
    ResolveMenuButtonMethod "setDirection" o = MenuButtonSetDirectionMethodInfo
    ResolveMenuButtonMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveMenuButtonMethod "setFocusHadjustment" o = Gtk.Container.ContainerSetFocusHadjustmentMethodInfo
    ResolveMenuButtonMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveMenuButtonMethod "setFocusVadjustment" o = Gtk.Container.ContainerSetFocusVadjustmentMethodInfo
    ResolveMenuButtonMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveMenuButtonMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveMenuButtonMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveMenuButtonMethod "setHasSurface" o = Gtk.Widget.WidgetSetHasSurfaceMethodInfo
    ResolveMenuButtonMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveMenuButtonMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveMenuButtonMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveMenuButtonMethod "setIconName" o = Gtk.Button.ButtonSetIconNameMethodInfo
    ResolveMenuButtonMethod "setLabel" o = Gtk.Button.ButtonSetLabelMethodInfo
    ResolveMenuButtonMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveMenuButtonMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveMenuButtonMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveMenuButtonMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveMenuButtonMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveMenuButtonMethod "setMenuModel" o = MenuButtonSetMenuModelMethodInfo
    ResolveMenuButtonMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveMenuButtonMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveMenuButtonMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveMenuButtonMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveMenuButtonMethod "setPopover" o = MenuButtonSetPopoverMethodInfo
    ResolveMenuButtonMethod "setPopup" o = MenuButtonSetPopupMethodInfo
    ResolveMenuButtonMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMenuButtonMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveMenuButtonMethod "setRelief" o = Gtk.Button.ButtonSetReliefMethodInfo
    ResolveMenuButtonMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveMenuButtonMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveMenuButtonMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveMenuButtonMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveMenuButtonMethod "setSurface" o = Gtk.Widget.WidgetSetSurfaceMethodInfo
    ResolveMenuButtonMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveMenuButtonMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveMenuButtonMethod "setTooltipWindow" o = Gtk.Widget.WidgetSetTooltipWindowMethodInfo
    ResolveMenuButtonMethod "setUsePopover" o = MenuButtonSetUsePopoverMethodInfo
    ResolveMenuButtonMethod "setUseUnderline" o = Gtk.Button.ButtonSetUseUnderlineMethodInfo
    ResolveMenuButtonMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveMenuButtonMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveMenuButtonMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveMenuButtonMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveMenuButtonMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "align-widget"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Container"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@align-widget@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' menuButton #alignWidget
-- @
getMenuButtonAlignWidget :: (MonadIO m, IsMenuButton o) => o -> m (Maybe Gtk.Container.Container)
getMenuButtonAlignWidget :: o -> m (Maybe Container)
getMenuButtonAlignWidget obj :: o
obj = IO (Maybe Container) -> m (Maybe Container)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Container) -> m (Maybe Container))
-> IO (Maybe Container) -> m (Maybe Container)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr Container -> Container)
-> IO (Maybe Container)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "align-widget" ManagedPtr Container -> Container
Gtk.Container.Container

-- | Set the value of the “@align-widget@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menuButton [ #alignWidget 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuButtonAlignWidget :: (MonadIO m, IsMenuButton o, Gtk.Container.IsContainer a) => o -> a -> m ()
setMenuButtonAlignWidget :: o -> a -> m ()
setMenuButtonAlignWidget obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "align-widget" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@align-widget@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuButtonAlignWidget :: (IsMenuButton o, Gtk.Container.IsContainer a) => a -> IO (GValueConstruct o)
constructMenuButtonAlignWidget :: a -> IO (GValueConstruct o)
constructMenuButtonAlignWidget val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "align-widget" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Set the value of the “@align-widget@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #alignWidget
-- @
clearMenuButtonAlignWidget :: (MonadIO m, IsMenuButton o) => o -> m ()
clearMenuButtonAlignWidget :: o -> m ()
clearMenuButtonAlignWidget obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Container -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "align-widget" (Maybe Container
forall a. Maybe a
Nothing :: Maybe Gtk.Container.Container)

#if defined(ENABLE_OVERLOADING)
data MenuButtonAlignWidgetPropertyInfo
instance AttrInfo MenuButtonAlignWidgetPropertyInfo where
    type AttrAllowedOps MenuButtonAlignWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MenuButtonAlignWidgetPropertyInfo = IsMenuButton
    type AttrSetTypeConstraint MenuButtonAlignWidgetPropertyInfo = Gtk.Container.IsContainer
    type AttrTransferTypeConstraint MenuButtonAlignWidgetPropertyInfo = Gtk.Container.IsContainer
    type AttrTransferType MenuButtonAlignWidgetPropertyInfo = Gtk.Container.Container
    type AttrGetType MenuButtonAlignWidgetPropertyInfo = (Maybe Gtk.Container.Container)
    type AttrLabel MenuButtonAlignWidgetPropertyInfo = "align-widget"
    type AttrOrigin MenuButtonAlignWidgetPropertyInfo = MenuButton
    attrGet = getMenuButtonAlignWidget
    attrSet = setMenuButtonAlignWidget
    attrTransfer _ v = do
        unsafeCastTo Gtk.Container.Container v
    attrConstruct = constructMenuButtonAlignWidget
    attrClear = clearMenuButtonAlignWidget
#endif

-- VVV Prop "direction"
   -- Type: TInterface (Name {namespace = "Gtk", name = "ArrowType"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@direction@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' menuButton #direction
-- @
getMenuButtonDirection :: (MonadIO m, IsMenuButton o) => o -> m Gtk.Enums.ArrowType
getMenuButtonDirection :: o -> m ArrowType
getMenuButtonDirection obj :: o
obj = IO ArrowType -> m ArrowType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArrowType -> m ArrowType) -> IO ArrowType -> m ArrowType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ArrowType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "direction"

-- | Set the value of the “@direction@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menuButton [ #direction 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuButtonDirection :: (MonadIO m, IsMenuButton o) => o -> Gtk.Enums.ArrowType -> m ()
setMenuButtonDirection :: o -> ArrowType -> m ()
setMenuButtonDirection obj :: o
obj val :: ArrowType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> ArrowType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj "direction" ArrowType
val

-- | Construct a `GValueConstruct` with valid value for the “@direction@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuButtonDirection :: (IsMenuButton o) => Gtk.Enums.ArrowType -> IO (GValueConstruct o)
constructMenuButtonDirection :: ArrowType -> IO (GValueConstruct o)
constructMenuButtonDirection val :: ArrowType
val = String -> ArrowType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "direction" ArrowType
val

#if defined(ENABLE_OVERLOADING)
data MenuButtonDirectionPropertyInfo
instance AttrInfo MenuButtonDirectionPropertyInfo where
    type AttrAllowedOps MenuButtonDirectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MenuButtonDirectionPropertyInfo = IsMenuButton
    type AttrSetTypeConstraint MenuButtonDirectionPropertyInfo = (~) Gtk.Enums.ArrowType
    type AttrTransferTypeConstraint MenuButtonDirectionPropertyInfo = (~) Gtk.Enums.ArrowType
    type AttrTransferType MenuButtonDirectionPropertyInfo = Gtk.Enums.ArrowType
    type AttrGetType MenuButtonDirectionPropertyInfo = Gtk.Enums.ArrowType
    type AttrLabel MenuButtonDirectionPropertyInfo = "direction"
    type AttrOrigin MenuButtonDirectionPropertyInfo = MenuButton
    attrGet = getMenuButtonDirection
    attrSet = setMenuButtonDirection
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuButtonDirection
    attrClear = undefined
#endif

-- VVV Prop "menu-model"
   -- Type: TInterface (Name {namespace = "Gio", name = "MenuModel"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@menu-model@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' menuButton #menuModel
-- @
getMenuButtonMenuModel :: (MonadIO m, IsMenuButton o) => o -> m (Maybe Gio.MenuModel.MenuModel)
getMenuButtonMenuModel :: o -> m (Maybe MenuModel)
getMenuButtonMenuModel obj :: o
obj = IO (Maybe MenuModel) -> m (Maybe MenuModel)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MenuModel) -> m (Maybe MenuModel))
-> IO (Maybe MenuModel) -> m (Maybe MenuModel)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr MenuModel -> MenuModel)
-> IO (Maybe MenuModel)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "menu-model" ManagedPtr MenuModel -> MenuModel
Gio.MenuModel.MenuModel

-- | Set the value of the “@menu-model@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menuButton [ #menuModel 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuButtonMenuModel :: (MonadIO m, IsMenuButton o, Gio.MenuModel.IsMenuModel a) => o -> a -> m ()
setMenuButtonMenuModel :: o -> a -> m ()
setMenuButtonMenuModel obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "menu-model" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@menu-model@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuButtonMenuModel :: (IsMenuButton o, Gio.MenuModel.IsMenuModel a) => a -> IO (GValueConstruct o)
constructMenuButtonMenuModel :: a -> IO (GValueConstruct o)
constructMenuButtonMenuModel val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "menu-model" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Set the value of the “@menu-model@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #menuModel
-- @
clearMenuButtonMenuModel :: (MonadIO m, IsMenuButton o) => o -> m ()
clearMenuButtonMenuModel :: o -> m ()
clearMenuButtonMenuModel obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe MenuModel -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "menu-model" (Maybe MenuModel
forall a. Maybe a
Nothing :: Maybe Gio.MenuModel.MenuModel)

#if defined(ENABLE_OVERLOADING)
data MenuButtonMenuModelPropertyInfo
instance AttrInfo MenuButtonMenuModelPropertyInfo where
    type AttrAllowedOps MenuButtonMenuModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MenuButtonMenuModelPropertyInfo = IsMenuButton
    type AttrSetTypeConstraint MenuButtonMenuModelPropertyInfo = Gio.MenuModel.IsMenuModel
    type AttrTransferTypeConstraint MenuButtonMenuModelPropertyInfo = Gio.MenuModel.IsMenuModel
    type AttrTransferType MenuButtonMenuModelPropertyInfo = Gio.MenuModel.MenuModel
    type AttrGetType MenuButtonMenuModelPropertyInfo = (Maybe Gio.MenuModel.MenuModel)
    type AttrLabel MenuButtonMenuModelPropertyInfo = "menu-model"
    type AttrOrigin MenuButtonMenuModelPropertyInfo = MenuButton
    attrGet = getMenuButtonMenuModel
    attrSet = setMenuButtonMenuModel
    attrTransfer _ v = do
        unsafeCastTo Gio.MenuModel.MenuModel v
    attrConstruct = constructMenuButtonMenuModel
    attrClear = clearMenuButtonMenuModel
#endif

-- VVV Prop "popover"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Popover"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@popover@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' menuButton #popover
-- @
getMenuButtonPopover :: (MonadIO m, IsMenuButton o) => o -> m (Maybe Gtk.Popover.Popover)
getMenuButtonPopover :: o -> m (Maybe Popover)
getMenuButtonPopover obj :: o
obj = IO (Maybe Popover) -> m (Maybe Popover)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Popover) -> m (Maybe Popover))
-> IO (Maybe Popover) -> m (Maybe Popover)
forall a b. (a -> b) -> a -> b
$ o
-> String -> (ManagedPtr Popover -> Popover) -> IO (Maybe Popover)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "popover" ManagedPtr Popover -> Popover
Gtk.Popover.Popover

-- | Set the value of the “@popover@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menuButton [ #popover 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuButtonPopover :: (MonadIO m, IsMenuButton o, Gtk.Popover.IsPopover a) => o -> a -> m ()
setMenuButtonPopover :: o -> a -> m ()
setMenuButtonPopover obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "popover" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@popover@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuButtonPopover :: (IsMenuButton o, Gtk.Popover.IsPopover a) => a -> IO (GValueConstruct o)
constructMenuButtonPopover :: a -> IO (GValueConstruct o)
constructMenuButtonPopover val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "popover" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Set the value of the “@popover@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #popover
-- @
clearMenuButtonPopover :: (MonadIO m, IsMenuButton o) => o -> m ()
clearMenuButtonPopover :: o -> m ()
clearMenuButtonPopover obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Popover -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "popover" (Maybe Popover
forall a. Maybe a
Nothing :: Maybe Gtk.Popover.Popover)

#if defined(ENABLE_OVERLOADING)
data MenuButtonPopoverPropertyInfo
instance AttrInfo MenuButtonPopoverPropertyInfo where
    type AttrAllowedOps MenuButtonPopoverPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MenuButtonPopoverPropertyInfo = IsMenuButton
    type AttrSetTypeConstraint MenuButtonPopoverPropertyInfo = Gtk.Popover.IsPopover
    type AttrTransferTypeConstraint MenuButtonPopoverPropertyInfo = Gtk.Popover.IsPopover
    type AttrTransferType MenuButtonPopoverPropertyInfo = Gtk.Popover.Popover
    type AttrGetType MenuButtonPopoverPropertyInfo = (Maybe Gtk.Popover.Popover)
    type AttrLabel MenuButtonPopoverPropertyInfo = "popover"
    type AttrOrigin MenuButtonPopoverPropertyInfo = MenuButton
    attrGet = getMenuButtonPopover
    attrSet = setMenuButtonPopover
    attrTransfer _ v = do
        unsafeCastTo Gtk.Popover.Popover v
    attrConstruct = constructMenuButtonPopover
    attrClear = clearMenuButtonPopover
#endif

-- VVV Prop "popup"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Menu"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@popup@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' menuButton #popup
-- @
getMenuButtonPopup :: (MonadIO m, IsMenuButton o) => o -> m (Maybe Gtk.Menu.Menu)
getMenuButtonPopup :: o -> m (Maybe Menu)
getMenuButtonPopup obj :: o
obj = IO (Maybe Menu) -> m (Maybe Menu)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Menu) -> m (Maybe Menu))
-> IO (Maybe Menu) -> m (Maybe Menu)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Menu -> Menu) -> IO (Maybe Menu)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "popup" ManagedPtr Menu -> Menu
Gtk.Menu.Menu

-- | Set the value of the “@popup@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menuButton [ #popup 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuButtonPopup :: (MonadIO m, IsMenuButton o, Gtk.Menu.IsMenu a) => o -> a -> m ()
setMenuButtonPopup :: o -> a -> m ()
setMenuButtonPopup obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "popup" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@popup@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuButtonPopup :: (IsMenuButton o, Gtk.Menu.IsMenu a) => a -> IO (GValueConstruct o)
constructMenuButtonPopup :: a -> IO (GValueConstruct o)
constructMenuButtonPopup val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "popup" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Set the value of the “@popup@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #popup
-- @
clearMenuButtonPopup :: (MonadIO m, IsMenuButton o) => o -> m ()
clearMenuButtonPopup :: o -> m ()
clearMenuButtonPopup obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Menu -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "popup" (Maybe Menu
forall a. Maybe a
Nothing :: Maybe Gtk.Menu.Menu)

#if defined(ENABLE_OVERLOADING)
data MenuButtonPopupPropertyInfo
instance AttrInfo MenuButtonPopupPropertyInfo where
    type AttrAllowedOps MenuButtonPopupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MenuButtonPopupPropertyInfo = IsMenuButton
    type AttrSetTypeConstraint MenuButtonPopupPropertyInfo = Gtk.Menu.IsMenu
    type AttrTransferTypeConstraint MenuButtonPopupPropertyInfo = Gtk.Menu.IsMenu
    type AttrTransferType MenuButtonPopupPropertyInfo = Gtk.Menu.Menu
    type AttrGetType MenuButtonPopupPropertyInfo = (Maybe Gtk.Menu.Menu)
    type AttrLabel MenuButtonPopupPropertyInfo = "popup"
    type AttrOrigin MenuButtonPopupPropertyInfo = MenuButton
    attrGet = getMenuButtonPopup
    attrSet = setMenuButtonPopup
    attrTransfer _ v = do
        unsafeCastTo Gtk.Menu.Menu v
    attrConstruct = constructMenuButtonPopup
    attrClear = clearMenuButtonPopup
#endif

-- VVV Prop "use-popover"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@use-popover@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' menuButton #usePopover
-- @
getMenuButtonUsePopover :: (MonadIO m, IsMenuButton o) => o -> m Bool
getMenuButtonUsePopover :: o -> m Bool
getMenuButtonUsePopover obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "use-popover"

-- | Set the value of the “@use-popover@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menuButton [ #usePopover 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuButtonUsePopover :: (MonadIO m, IsMenuButton o) => o -> Bool -> m ()
setMenuButtonUsePopover :: o -> Bool -> m ()
setMenuButtonUsePopover obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "use-popover" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@use-popover@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuButtonUsePopover :: (IsMenuButton o) => Bool -> IO (GValueConstruct o)
constructMenuButtonUsePopover :: Bool -> IO (GValueConstruct o)
constructMenuButtonUsePopover val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "use-popover" Bool
val

#if defined(ENABLE_OVERLOADING)
data MenuButtonUsePopoverPropertyInfo
instance AttrInfo MenuButtonUsePopoverPropertyInfo where
    type AttrAllowedOps MenuButtonUsePopoverPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MenuButtonUsePopoverPropertyInfo = IsMenuButton
    type AttrSetTypeConstraint MenuButtonUsePopoverPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MenuButtonUsePopoverPropertyInfo = (~) Bool
    type AttrTransferType MenuButtonUsePopoverPropertyInfo = Bool
    type AttrGetType MenuButtonUsePopoverPropertyInfo = Bool
    type AttrLabel MenuButtonUsePopoverPropertyInfo = "use-popover"
    type AttrOrigin MenuButtonUsePopoverPropertyInfo = MenuButton
    attrGet = getMenuButtonUsePopover
    attrSet = setMenuButtonUsePopover
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuButtonUsePopover
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MenuButton
type instance O.AttributeList MenuButton = MenuButtonAttributeList
type MenuButtonAttributeList = ('[ '("actionName", Gtk.Actionable.ActionableActionNamePropertyInfo), '("actionTarget", Gtk.Actionable.ActionableActionTargetPropertyInfo), '("active", Gtk.ToggleButton.ToggleButtonActivePropertyInfo), '("alignWidget", MenuButtonAlignWidgetPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("direction", MenuButtonDirectionPropertyInfo), '("expand", Gtk.Widget.WidgetExpandPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("iconName", Gtk.Button.ButtonIconNamePropertyInfo), '("isFocus", Gtk.Widget.WidgetIsFocusPropertyInfo), '("label", Gtk.Button.ButtonLabelPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("margin", Gtk.Widget.WidgetMarginPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("menuModel", MenuButtonMenuModelPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("popover", MenuButtonPopoverPropertyInfo), '("popup", MenuButtonPopupPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("relief", Gtk.Button.ButtonReliefPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("surface", Gtk.Widget.WidgetSurfacePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("usePopover", MenuButtonUsePopoverPropertyInfo), '("useUnderline", Gtk.Button.ButtonUseUnderlinePropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
menuButtonAlignWidget :: AttrLabelProxy "alignWidget"
menuButtonAlignWidget = AttrLabelProxy

menuButtonDirection :: AttrLabelProxy "direction"
menuButtonDirection = AttrLabelProxy

menuButtonMenuModel :: AttrLabelProxy "menuModel"
menuButtonMenuModel = AttrLabelProxy

menuButtonPopover :: AttrLabelProxy "popover"
menuButtonPopover = AttrLabelProxy

menuButtonPopup :: AttrLabelProxy "popup"
menuButtonPopup = AttrLabelProxy

menuButtonUsePopover :: AttrLabelProxy "usePopover"
menuButtonUsePopover = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList MenuButton = MenuButtonSignalList
type MenuButtonSignalList = ('[ '("accelClosuresChanged", Gtk.Widget.WidgetAccelClosuresChangedSignalInfo), '("activate", Gtk.Button.ButtonActivateSignalInfo), '("add", Gtk.Container.ContainerAddSignalInfo), '("canActivateAccel", Gtk.Widget.WidgetCanActivateAccelSignalInfo), '("clicked", Gtk.Button.ButtonClickedSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("dragBegin", Gtk.Widget.WidgetDragBeginSignalInfo), '("dragDataDelete", Gtk.Widget.WidgetDragDataDeleteSignalInfo), '("dragDataGet", Gtk.Widget.WidgetDragDataGetSignalInfo), '("dragDataReceived", Gtk.Widget.WidgetDragDataReceivedSignalInfo), '("dragDrop", Gtk.Widget.WidgetDragDropSignalInfo), '("dragEnd", Gtk.Widget.WidgetDragEndSignalInfo), '("dragFailed", Gtk.Widget.WidgetDragFailedSignalInfo), '("dragLeave", Gtk.Widget.WidgetDragLeaveSignalInfo), '("dragMotion", Gtk.Widget.WidgetDragMotionSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("popupMenu", Gtk.Widget.WidgetPopupMenuSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("remove", Gtk.Container.ContainerRemoveSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("sizeAllocate", Gtk.Widget.WidgetSizeAllocateSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("styleUpdated", Gtk.Widget.WidgetStyleUpdatedSignalInfo), '("toggled", Gtk.ToggleButton.ToggleButtonToggledSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_menu_button_new" gtk_menu_button_new :: 
    IO (Ptr MenuButton)

-- | Creates a new t'GI.Gtk.Objects.MenuButton.MenuButton' widget with downwards-pointing
-- arrow as the only child. You can replace the child widget
-- with another t'GI.Gtk.Objects.Widget.Widget' should you wish to.
menuButtonNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m MenuButton
    -- ^ __Returns:__ The newly created t'GI.Gtk.Objects.MenuButton.MenuButton' widget
menuButtonNew :: m MenuButton
menuButtonNew  = IO MenuButton -> m MenuButton
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MenuButton -> m MenuButton) -> IO MenuButton -> m MenuButton
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
result <- IO (Ptr MenuButton)
gtk_menu_button_new
    Text -> Ptr MenuButton -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "menuButtonNew" Ptr MenuButton
result
    MenuButton
result' <- ((ManagedPtr MenuButton -> MenuButton)
-> Ptr MenuButton -> IO MenuButton
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr MenuButton -> MenuButton
MenuButton) Ptr MenuButton
result
    MenuButton -> IO MenuButton
forall (m :: * -> *) a. Monad m => a -> m a
return MenuButton
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method MenuButton::get_align_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Widget" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_get_align_widget" gtk_menu_button_get_align_widget :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    IO (Ptr Gtk.Widget.Widget)

-- | Returns the parent t'GI.Gtk.Objects.Widget.Widget' to use to line up with menu.
menuButtonGetAlignWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ a t'GI.Gtk.Objects.Widget.Widget' value or 'P.Nothing'
menuButtonGetAlignWidget :: a -> m (Maybe Widget)
menuButtonGetAlignWidget menuButton :: a
menuButton = IO (Maybe Widget) -> m (Maybe Widget)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    Ptr Widget
result <- Ptr MenuButton -> IO (Ptr Widget)
gtk_menu_button_get_align_widget Ptr MenuButton
menuButton'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    Maybe Widget -> IO (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data MenuButtonGetAlignWidgetMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsMenuButton a) => O.MethodInfo MenuButtonGetAlignWidgetMethodInfo a signature where
    overloadedMethod = menuButtonGetAlignWidget

#endif

-- method MenuButton::get_direction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "ArrowType" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_get_direction" gtk_menu_button_get_direction :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    IO CUInt

-- | Returns the direction the popup will be pointing at when popped up.
menuButtonGetDirection ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> m Gtk.Enums.ArrowType
    -- ^ __Returns:__ a t'GI.Gtk.Enums.ArrowType' value
menuButtonGetDirection :: a -> m ArrowType
menuButtonGetDirection menuButton :: a
menuButton = IO ArrowType -> m ArrowType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArrowType -> m ArrowType) -> IO ArrowType -> m ArrowType
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    CUInt
result <- Ptr MenuButton -> IO CUInt
gtk_menu_button_get_direction Ptr MenuButton
menuButton'
    let result' :: ArrowType
result' = (Int -> ArrowType
forall a. Enum a => Int -> a
toEnum (Int -> ArrowType) -> (CUInt -> Int) -> CUInt -> ArrowType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    ArrowType -> IO ArrowType
forall (m :: * -> *) a. Monad m => a -> m a
return ArrowType
result'

#if defined(ENABLE_OVERLOADING)
data MenuButtonGetDirectionMethodInfo
instance (signature ~ (m Gtk.Enums.ArrowType), MonadIO m, IsMenuButton a) => O.MethodInfo MenuButtonGetDirectionMethodInfo a signature where
    overloadedMethod = menuButtonGetDirection

#endif

-- method MenuButton::get_menu_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "MenuModel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_get_menu_model" gtk_menu_button_get_menu_model :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    IO (Ptr Gio.MenuModel.MenuModel)

-- | Returns the t'GI.Gio.Objects.MenuModel.MenuModel' used to generate the popup.
menuButtonGetMenuModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> m (Maybe Gio.MenuModel.MenuModel)
    -- ^ __Returns:__ a t'GI.Gio.Objects.MenuModel.MenuModel' or 'P.Nothing'
menuButtonGetMenuModel :: a -> m (Maybe MenuModel)
menuButtonGetMenuModel menuButton :: a
menuButton = IO (Maybe MenuModel) -> m (Maybe MenuModel)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MenuModel) -> m (Maybe MenuModel))
-> IO (Maybe MenuModel) -> m (Maybe MenuModel)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    Ptr MenuModel
result <- Ptr MenuButton -> IO (Ptr MenuModel)
gtk_menu_button_get_menu_model Ptr MenuButton
menuButton'
    Maybe MenuModel
maybeResult <- Ptr MenuModel
-> (Ptr MenuModel -> IO MenuModel) -> IO (Maybe MenuModel)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr MenuModel
result ((Ptr MenuModel -> IO MenuModel) -> IO (Maybe MenuModel))
-> (Ptr MenuModel -> IO MenuModel) -> IO (Maybe MenuModel)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr MenuModel
result' -> do
        MenuModel
result'' <- ((ManagedPtr MenuModel -> MenuModel)
-> Ptr MenuModel -> IO MenuModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr MenuModel -> MenuModel
Gio.MenuModel.MenuModel) Ptr MenuModel
result'
        MenuModel -> IO MenuModel
forall (m :: * -> *) a. Monad m => a -> m a
return MenuModel
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    Maybe MenuModel -> IO (Maybe MenuModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MenuModel
maybeResult

#if defined(ENABLE_OVERLOADING)
data MenuButtonGetMenuModelMethodInfo
instance (signature ~ (m (Maybe Gio.MenuModel.MenuModel)), MonadIO m, IsMenuButton a) => O.MethodInfo MenuButtonGetMenuModelMethodInfo a signature where
    overloadedMethod = menuButtonGetMenuModel

#endif

-- method MenuButton::get_popover
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Popover" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_get_popover" gtk_menu_button_get_popover :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    IO (Ptr Gtk.Popover.Popover)

-- | Returns the t'GI.Gtk.Objects.Popover.Popover' that pops out of the button.
-- If the button is not using a t'GI.Gtk.Objects.Popover.Popover', this function
-- returns 'P.Nothing'.
menuButtonGetPopover ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> m (Maybe Gtk.Popover.Popover)
    -- ^ __Returns:__ a t'GI.Gtk.Objects.Popover.Popover' or 'P.Nothing'
menuButtonGetPopover :: a -> m (Maybe Popover)
menuButtonGetPopover menuButton :: a
menuButton = IO (Maybe Popover) -> m (Maybe Popover)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Popover) -> m (Maybe Popover))
-> IO (Maybe Popover) -> m (Maybe Popover)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    Ptr Popover
result <- Ptr MenuButton -> IO (Ptr Popover)
gtk_menu_button_get_popover Ptr MenuButton
menuButton'
    Maybe Popover
maybeResult <- Ptr Popover -> (Ptr Popover -> IO Popover) -> IO (Maybe Popover)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Popover
result ((Ptr Popover -> IO Popover) -> IO (Maybe Popover))
-> (Ptr Popover -> IO Popover) -> IO (Maybe Popover)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Popover
result' -> do
        Popover
result'' <- ((ManagedPtr Popover -> Popover) -> Ptr Popover -> IO Popover
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Popover -> Popover
Gtk.Popover.Popover) Ptr Popover
result'
        Popover -> IO Popover
forall (m :: * -> *) a. Monad m => a -> m a
return Popover
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    Maybe Popover -> IO (Maybe Popover)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Popover
maybeResult

#if defined(ENABLE_OVERLOADING)
data MenuButtonGetPopoverMethodInfo
instance (signature ~ (m (Maybe Gtk.Popover.Popover)), MonadIO m, IsMenuButton a) => O.MethodInfo MenuButtonGetPopoverMethodInfo a signature where
    overloadedMethod = menuButtonGetPopover

#endif

-- method MenuButton::get_popup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Menu" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_get_popup" gtk_menu_button_get_popup :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    IO (Ptr Gtk.Menu.Menu)

-- | Returns the t'GI.Gtk.Objects.Menu.Menu' that pops out of the button.
-- If the button does not use a t'GI.Gtk.Objects.Menu.Menu', this function
-- returns 'P.Nothing'.
menuButtonGetPopup ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> m (Maybe Gtk.Menu.Menu)
    -- ^ __Returns:__ a t'GI.Gtk.Objects.Menu.Menu' or 'P.Nothing'
menuButtonGetPopup :: a -> m (Maybe Menu)
menuButtonGetPopup menuButton :: a
menuButton = IO (Maybe Menu) -> m (Maybe Menu)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Menu) -> m (Maybe Menu))
-> IO (Maybe Menu) -> m (Maybe Menu)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    Ptr Menu
result <- Ptr MenuButton -> IO (Ptr Menu)
gtk_menu_button_get_popup Ptr MenuButton
menuButton'
    Maybe Menu
maybeResult <- Ptr Menu -> (Ptr Menu -> IO Menu) -> IO (Maybe Menu)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Menu
result ((Ptr Menu -> IO Menu) -> IO (Maybe Menu))
-> (Ptr Menu -> IO Menu) -> IO (Maybe Menu)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Menu
result' -> do
        Menu
result'' <- ((ManagedPtr Menu -> Menu) -> Ptr Menu -> IO Menu
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Menu -> Menu
Gtk.Menu.Menu) Ptr Menu
result'
        Menu -> IO Menu
forall (m :: * -> *) a. Monad m => a -> m a
return Menu
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    Maybe Menu -> IO (Maybe Menu)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Menu
maybeResult

#if defined(ENABLE_OVERLOADING)
data MenuButtonGetPopupMethodInfo
instance (signature ~ (m (Maybe Gtk.Menu.Menu)), MonadIO m, IsMenuButton a) => O.MethodInfo MenuButtonGetPopupMethodInfo a signature where
    overloadedMethod = menuButtonGetPopup

#endif

-- method MenuButton::get_use_popover
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , 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 "gtk_menu_button_get_use_popover" gtk_menu_button_get_use_popover :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    IO CInt

-- | Returns whether a t'GI.Gtk.Objects.Popover.Popover' or a t'GI.Gtk.Objects.Menu.Menu' will be constructed
-- from the menu model.
menuButtonGetUsePopover ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if using a t'GI.Gtk.Objects.Popover.Popover'
menuButtonGetUsePopover :: a -> m Bool
menuButtonGetUsePopover menuButton :: a
menuButton = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    CInt
result <- Ptr MenuButton -> IO CInt
gtk_menu_button_get_use_popover Ptr MenuButton
menuButton'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuButtonGetUsePopoverMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMenuButton a) => O.MethodInfo MenuButtonGetUsePopoverMethodInfo a signature where
    overloadedMethod = menuButtonGetUsePopover

#endif

-- method MenuButton::set_align_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "align_widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkWidget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_set_align_widget" gtk_menu_button_set_align_widget :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    Ptr Gtk.Widget.Widget ->                -- align_widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Sets the t'GI.Gtk.Objects.Widget.Widget' to use to line the menu with when popped up.
-- Note that the /@alignWidget@/ must contain the t'GI.Gtk.Objects.MenuButton.MenuButton' itself.
-- 
-- Setting it to 'P.Nothing' means that the menu will be aligned with the
-- button itself.
-- 
-- Note that this property is only used with menus currently,
-- and not for popovers.
menuButtonSetAlignWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> Maybe (b)
    -- ^ /@alignWidget@/: a t'GI.Gtk.Objects.Widget.Widget'
    -> m ()
menuButtonSetAlignWidget :: a -> Maybe b -> m ()
menuButtonSetAlignWidget menuButton :: a
menuButton alignWidget :: Maybe b
alignWidget = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    Ptr Widget
maybeAlignWidget <- case Maybe b
alignWidget of
        Nothing -> Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just jAlignWidget :: b
jAlignWidget -> do
            Ptr Widget
jAlignWidget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jAlignWidget
            Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jAlignWidget'
    Ptr MenuButton -> Ptr Widget -> IO ()
gtk_menu_button_set_align_widget Ptr MenuButton
menuButton' Ptr Widget
maybeAlignWidget
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
alignWidget b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuButtonSetAlignWidgetMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsMenuButton a, Gtk.Widget.IsWidget b) => O.MethodInfo MenuButtonSetAlignWidgetMethodInfo a signature where
    overloadedMethod = menuButtonSetAlignWidget

#endif

-- method MenuButton::set_direction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ArrowType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkArrowType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_set_direction" gtk_menu_button_set_direction :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    CUInt ->                                -- direction : TInterface (Name {namespace = "Gtk", name = "ArrowType"})
    IO ()

-- | Sets the direction in which the popup will be popped up, as
-- well as changing the arrow’s direction. The child will not
-- be changed to an arrow if it was customized.
-- 
-- If the does not fit in the available space in the given direction,
-- GTK+ will its best to keep it inside the screen and fully visible.
-- 
-- If you pass 'GI.Gtk.Enums.ArrowTypeNone' for a /@direction@/, the popup will behave
-- as if you passed 'GI.Gtk.Enums.ArrowTypeDown' (although you won’t see any arrows).
menuButtonSetDirection ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> Gtk.Enums.ArrowType
    -- ^ /@direction@/: a t'GI.Gtk.Enums.ArrowType'
    -> m ()
menuButtonSetDirection :: a -> ArrowType -> m ()
menuButtonSetDirection menuButton :: a
menuButton direction :: ArrowType
direction = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ArrowType -> Int) -> ArrowType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrowType -> Int
forall a. Enum a => a -> Int
fromEnum) ArrowType
direction
    Ptr MenuButton -> CUInt -> IO ()
gtk_menu_button_set_direction Ptr MenuButton
menuButton' CUInt
direction'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuButtonSetDirectionMethodInfo
instance (signature ~ (Gtk.Enums.ArrowType -> m ()), MonadIO m, IsMenuButton a) => O.MethodInfo MenuButtonSetDirectionMethodInfo a signature where
    overloadedMethod = menuButtonSetDirection

#endif

-- method MenuButton::set_menu_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu_model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GMenuModel, or %NULL to unset and disable the\n  button"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_set_menu_model" gtk_menu_button_set_menu_model :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    Ptr Gio.MenuModel.MenuModel ->          -- menu_model : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Sets the t'GI.Gio.Objects.MenuModel.MenuModel' from which the popup will be constructed,
-- or 'P.Nothing' to dissociate any existing menu model and disable the button.
-- 
-- Depending on the value of t'GI.Gtk.Objects.MenuButton.MenuButton':@/use-popover/@, either a
-- t'GI.Gtk.Objects.Menu.Menu' will be created with 'GI.Gtk.Objects.Menu.menuNewFromModel', or a
-- t'GI.Gtk.Objects.Popover.Popover' with 'GI.Gtk.Objects.Popover.popoverNewFromModel'. In either case,
-- actions will be connected as documented for these functions.
-- 
-- If t'GI.Gtk.Objects.MenuButton.MenuButton':@/popup/@ or t'GI.Gtk.Objects.MenuButton.MenuButton':@/popover/@ are already set, those
-- widgets are dissociated from the /@menuButton@/, and those properties are set
-- to 'P.Nothing'.
menuButtonSetMenuModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> Maybe (b)
    -- ^ /@menuModel@/: a t'GI.Gio.Objects.MenuModel.MenuModel', or 'P.Nothing' to unset and disable the
    --   button
    -> m ()
menuButtonSetMenuModel :: a -> Maybe b -> m ()
menuButtonSetMenuModel menuButton :: a
menuButton menuModel :: Maybe b
menuModel = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    Ptr MenuModel
maybeMenuModel <- case Maybe b
menuModel of
        Nothing -> Ptr MenuModel -> IO (Ptr MenuModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MenuModel
forall a. Ptr a
nullPtr
        Just jMenuModel :: b
jMenuModel -> do
            Ptr MenuModel
jMenuModel' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMenuModel
            Ptr MenuModel -> IO (Ptr MenuModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MenuModel
jMenuModel'
    Ptr MenuButton -> Ptr MenuModel -> IO ()
gtk_menu_button_set_menu_model Ptr MenuButton
menuButton' Ptr MenuModel
maybeMenuModel
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
menuModel b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuButtonSetMenuModelMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsMenuButton a, Gio.MenuModel.IsMenuModel b) => O.MethodInfo MenuButtonSetMenuModelMethodInfo a signature where
    overloadedMethod = menuButtonSetMenuModel

#endif

-- method MenuButton::set_popover
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "popover"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GtkPopover, or %NULL to unset and disable the button"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_set_popover" gtk_menu_button_set_popover :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    Ptr Gtk.Widget.Widget ->                -- popover : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Sets the t'GI.Gtk.Objects.Popover.Popover' that will be popped up when the /@menuButton@/ is clicked,
-- or 'P.Nothing' to dissociate any existing popover and disable the button.
-- 
-- If t'GI.Gtk.Objects.MenuButton.MenuButton':@/menu-model/@ or t'GI.Gtk.Objects.MenuButton.MenuButton':@/popup/@ are set, those objects
-- are dissociated from the /@menuButton@/, and those properties are set to 'P.Nothing'.
menuButtonSetPopover ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> Maybe (b)
    -- ^ /@popover@/: a t'GI.Gtk.Objects.Popover.Popover', or 'P.Nothing' to unset and disable the button
    -> m ()
menuButtonSetPopover :: a -> Maybe b -> m ()
menuButtonSetPopover menuButton :: a
menuButton popover :: Maybe b
popover = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    Ptr Widget
maybePopover <- case Maybe b
popover of
        Nothing -> Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just jPopover :: b
jPopover -> do
            Ptr Widget
jPopover' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPopover
            Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jPopover'
    Ptr MenuButton -> Ptr Widget -> IO ()
gtk_menu_button_set_popover Ptr MenuButton
menuButton' Ptr Widget
maybePopover
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
popover b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuButtonSetPopoverMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsMenuButton a, Gtk.Widget.IsWidget b) => O.MethodInfo MenuButtonSetPopoverMethodInfo a signature where
    overloadedMethod = menuButtonSetPopover

#endif

-- method MenuButton::set_popup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GtkMenu, or %NULL to unset and disable the button"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_set_popup" gtk_menu_button_set_popup :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    Ptr Gtk.Widget.Widget ->                -- menu : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Sets the t'GI.Gtk.Objects.Menu.Menu' that will be popped up when the /@menuButton@/ is clicked, or
-- 'P.Nothing' to dissociate any existing menu and disable the button.
-- 
-- If t'GI.Gtk.Objects.MenuButton.MenuButton':@/menu-model/@ or t'GI.Gtk.Objects.MenuButton.MenuButton':@/popover/@ are set, those objects
-- are dissociated from the /@menuButton@/, and those properties are set to 'P.Nothing'.
menuButtonSetPopup ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> Maybe (b)
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu', or 'P.Nothing' to unset and disable the button
    -> m ()
menuButtonSetPopup :: a -> Maybe b -> m ()
menuButtonSetPopup menuButton :: a
menuButton menu :: Maybe b
menu = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    Ptr Widget
maybeMenu <- case Maybe b
menu of
        Nothing -> Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just jMenu :: b
jMenu -> do
            Ptr Widget
jMenu' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMenu
            Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jMenu'
    Ptr MenuButton -> Ptr Widget -> IO ()
gtk_menu_button_set_popup Ptr MenuButton
menuButton' Ptr Widget
maybeMenu
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
menu b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuButtonSetPopupMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsMenuButton a, Gtk.Widget.IsWidget b) => O.MethodInfo MenuButtonSetPopupMethodInfo a signature where
    overloadedMethod = menuButtonSetPopup

#endif

-- method MenuButton::set_use_popover
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu_button"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuButton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenuButton" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "use_popover"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE to construct a popover from the menu model"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_button_set_use_popover" gtk_menu_button_set_use_popover :: 
    Ptr MenuButton ->                       -- menu_button : TInterface (Name {namespace = "Gtk", name = "MenuButton"})
    CInt ->                                 -- use_popover : TBasicType TBoolean
    IO ()

-- | Sets whether to construct a t'GI.Gtk.Objects.Popover.Popover' instead of t'GI.Gtk.Objects.Menu.Menu'
-- when 'GI.Gtk.Objects.MenuButton.menuButtonSetMenuModel' is called. Note that
-- this property is only consulted when a new menu model is set.
menuButtonSetUsePopover ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuButton a) =>
    a
    -- ^ /@menuButton@/: a t'GI.Gtk.Objects.MenuButton.MenuButton'
    -> Bool
    -- ^ /@usePopover@/: 'P.True' to construct a popover from the menu model
    -> m ()
menuButtonSetUsePopover :: a -> Bool -> m ()
menuButtonSetUsePopover menuButton :: a
menuButton usePopover :: Bool
usePopover = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuButton
menuButton' <- a -> IO (Ptr MenuButton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menuButton
    let usePopover' :: CInt
usePopover' = (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
usePopover
    Ptr MenuButton -> CInt -> IO ()
gtk_menu_button_set_use_popover Ptr MenuButton
menuButton' CInt
usePopover'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menuButton
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuButtonSetUsePopoverMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsMenuButton a) => O.MethodInfo MenuButtonSetUsePopoverMethodInfo a signature where
    overloadedMethod = menuButtonSetUsePopover

#endif