{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GtkPopoverMenu is a subclass of t'GI.Gtk.Objects.Popover.Popover' that treats its
-- children like menus and allows switching between them. It
-- can open submenus as traditional, nested submenus, or in a
-- more touch-friendly sliding fashion.
-- 
-- GtkPopoverMenu is meant to be used primarily with menu models,
-- using 'GI.Gtk.Objects.PopoverMenu.popoverMenuNewFromModel'. If you need to put other
-- widgets such as t'GI.Gtk.Objects.SpinButton.SpinButton' or t'GI.Gtk.Objects.Switch.Switch' into a popover,
-- use a plain t'GI.Gtk.Objects.Popover.Popover'.
-- 
-- == Menu models
-- 
-- The XML format understood by t'GI.Gtk.Objects.Builder.Builder' for t'GI.Gio.Objects.MenuModel.MenuModel' consists
-- of a toplevel @\<menu>@ element, which contains one or more @\<item>@
-- elements. Each @\<item>@ element contains @\<attribute>@ and @\<link>@
-- elements with a mandatory name attribute. @\<link>@ elements have the
-- same content model as @\<menu>@. Instead of @\<link name=\"submenu>@ or
-- @\<link name=\"section\">@, you can use @\<submenu>@ or @\<section>@
-- elements.
-- 
-- ><!--language: xml -->
-- ><menu id='app-menu'>
-- >  <section>
-- >    <item>
-- >      <attribute name='label' translatable='yes'>_New Window</attribute>
-- >      <attribute name='action'>app.new</attribute>
-- >    </item>
-- >    <item>
-- >      <attribute name='label' translatable='yes'>_About Sunny</attribute>
-- >      <attribute name='action'>app.about</attribute>
-- >    </item>
-- >    <item>
-- >      <attribute name='label' translatable='yes'>_Quit</attribute>
-- >      <attribute name='action'>app.quit</attribute>
-- >    </item>
-- >  </section>
-- ></menu>
-- 
-- 
-- Attribute values can be translated using gettext, like other t'GI.Gtk.Objects.Builder.Builder'
-- content. @\<attribute>@ elements can be marked for translation with a
-- @translatable=\"yes\"@ attribute. It is also possible to specify message
-- context and translator comments, using the context and comments attributes.
-- To make use of this, the t'GI.Gtk.Objects.Builder.Builder' must have been given the gettext
-- domain to use.
-- 
-- The following attributes are used when constructing menu items:
-- 
-- * \"label\": a user-visible string to display
-- * \"action\": the prefixed name of the action to trigger
-- * \"target\": the parameter to use when activating the action
-- * \"icon\" and \"verb-icon\": names of icons that may be displayed
-- * \"submenu-action\": name of an action that may be used to determine
--    if a submenu can be opened
-- * \"hidden-when\": a string used to determine when the item will be hidden.
--    Possible values include \"action-disabled\", \"action-missing\", \"macos-menubar\".
--    This is mainly useful for exported menus, see 'GI.Gtk.Objects.Application.applicationSetMenubar'.
-- 
-- 
-- The following attributes are used when constructing sections:
-- 
-- * \"label\": a user-visible string to use as section heading
-- * \"display-hint\": a string used to determine special formatting for the section.
--   Possible values include \"horizontal-buttons\", \"circular-buttons\" and \"inline-buttons\". They all indicate that section should be
--   displayed as a horizontal row of buttons.
-- * \"text-direction\": a string used to determine the t'GI.Gtk.Enums.TextDirection' to use
--   when \"display-hint\" is set to \"horizontal-buttons\". Possible values
--   include \"rtl\", \"ltr\", and \"none\".
-- 
-- 
-- The following attributes are used when constructing submenus:
-- 
-- * \"label\": a user-visible string to display
-- * \"icon\": icon name to display
-- 
-- 
-- Menu items will also show accelerators, which are usually associated
-- with actions via 'GI.Gtk.Objects.Application.applicationSetAccelsForAction',
-- @/gtk_widget_class_add_binding_action()/@ or 'GI.Gtk.Objects.ShortcutController.shortcutControllerAddShortcut'.
-- 
-- = CSS Nodes
-- 
-- t'GI.Gtk.Objects.PopoverMenu.PopoverMenu' is just a subclass of t'GI.Gtk.Objects.Popover.Popover' that adds
-- custom content to it, therefore it has the same CSS nodes.
-- It is one of the cases that add a .menu style class to
-- the popover\'s main node.

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

module GI.Gtk.Objects.PopoverMenu
    ( 

-- * Exported types
    PopoverMenu(..)                         ,
    IsPopoverMenu                           ,
    toPopoverMenu                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePopoverMenuMethod                ,
#endif


-- ** getMenuModel #method:getMenuModel#

#if defined(ENABLE_OVERLOADING)
    PopoverMenuGetMenuModelMethodInfo       ,
#endif
    popoverMenuGetMenuModel                 ,


-- ** newFromModel #method:newFromModel#

    popoverMenuNewFromModel                 ,


-- ** newFromModelFull #method:newFromModelFull#

    popoverMenuNewFromModelFull             ,


-- ** setMenuModel #method:setMenuModel#

#if defined(ENABLE_OVERLOADING)
    PopoverMenuSetMenuModelMethodInfo       ,
#endif
    popoverMenuSetMenuModel                 ,




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

#if defined(ENABLE_OVERLOADING)
    PopoverMenuMenuModelPropertyInfo        ,
#endif
    clearPopoverMenuMenuModel               ,
    constructPopoverMenuMenuModel           ,
    getPopoverMenuMenuModel                 ,
#if defined(ENABLE_OVERLOADING)
    popoverMenuMenuModel                    ,
#endif
    setPopoverMenuMenuModel                 ,


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

#if defined(ENABLE_OVERLOADING)
    PopoverMenuVisibleSubmenuPropertyInfo   ,
#endif
    clearPopoverMenuVisibleSubmenu          ,
    constructPopoverMenuVisibleSubmenu      ,
    getPopoverMenuVisibleSubmenu            ,
#if defined(ENABLE_OVERLOADING)
    popoverMenuVisibleSubmenu               ,
#endif
    setPopoverMenuVisibleSubmenu            ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.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 Control.Monad.IO.Class as MIO
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.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Native as Gtk.Native
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ShortcutManager as Gtk.ShortcutManager
import {-# SOURCE #-} qualified GI.Gtk.Objects.Popover as Gtk.Popover
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "gtk_popover_menu_get_type"
    c_gtk_popover_menu_get_type :: IO B.Types.GType

instance B.Types.TypedObject PopoverMenu where
    glibType :: IO GType
glibType = IO GType
c_gtk_popover_menu_get_type

instance B.Types.GObject PopoverMenu

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

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

instance O.HasParentTypes PopoverMenu
type instance O.ParentTypes PopoverMenu = '[Gtk.Popover.Popover, Gtk.Widget.Widget, GObject.Object.Object, Atk.ImplementorIface.ImplementorIface, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget, Gtk.Native.Native, Gtk.ShortcutManager.ShortcutManager]

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePopoverMenuMethod (t :: Symbol) (o :: *) :: * where
    ResolvePopoverMenuMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolvePopoverMenuMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolvePopoverMenuMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolvePopoverMenuMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolvePopoverMenuMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolvePopoverMenuMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolvePopoverMenuMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolvePopoverMenuMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolvePopoverMenuMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolvePopoverMenuMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolvePopoverMenuMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePopoverMenuMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePopoverMenuMethod "checkResize" o = Gtk.Native.NativeCheckResizeMethodInfo
    ResolvePopoverMenuMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolvePopoverMenuMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolvePopoverMenuMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolvePopoverMenuMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolvePopoverMenuMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolvePopoverMenuMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolvePopoverMenuMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolvePopoverMenuMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolvePopoverMenuMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolvePopoverMenuMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolvePopoverMenuMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolvePopoverMenuMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolvePopoverMenuMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolvePopoverMenuMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolvePopoverMenuMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolvePopoverMenuMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePopoverMenuMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePopoverMenuMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePopoverMenuMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolvePopoverMenuMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolvePopoverMenuMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolvePopoverMenuMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolvePopoverMenuMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolvePopoverMenuMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolvePopoverMenuMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolvePopoverMenuMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolvePopoverMenuMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolvePopoverMenuMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolvePopoverMenuMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolvePopoverMenuMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolvePopoverMenuMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolvePopoverMenuMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePopoverMenuMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolvePopoverMenuMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolvePopoverMenuMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolvePopoverMenuMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolvePopoverMenuMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolvePopoverMenuMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolvePopoverMenuMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolvePopoverMenuMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolvePopoverMenuMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePopoverMenuMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePopoverMenuMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolvePopoverMenuMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolvePopoverMenuMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolvePopoverMenuMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolvePopoverMenuMethod "popdown" o = Gtk.Popover.PopoverPopdownMethodInfo
    ResolvePopoverMenuMethod "popup" o = Gtk.Popover.PopoverPopupMethodInfo
    ResolvePopoverMenuMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolvePopoverMenuMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolvePopoverMenuMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolvePopoverMenuMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolvePopoverMenuMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePopoverMenuMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePopoverMenuMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolvePopoverMenuMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolvePopoverMenuMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolvePopoverMenuMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolvePopoverMenuMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePopoverMenuMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolvePopoverMenuMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolvePopoverMenuMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolvePopoverMenuMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolvePopoverMenuMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePopoverMenuMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePopoverMenuMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePopoverMenuMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolvePopoverMenuMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolvePopoverMenuMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolvePopoverMenuMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolvePopoverMenuMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolvePopoverMenuMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePopoverMenuMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolvePopoverMenuMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePopoverMenuMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolvePopoverMenuMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolvePopoverMenuMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolvePopoverMenuMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolvePopoverMenuMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolvePopoverMenuMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolvePopoverMenuMethod "getAutohide" o = Gtk.Popover.PopoverGetAutohideMethodInfo
    ResolvePopoverMenuMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolvePopoverMenuMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolvePopoverMenuMethod "getChild" o = Gtk.Popover.PopoverGetChildMethodInfo
    ResolvePopoverMenuMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolvePopoverMenuMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolvePopoverMenuMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolvePopoverMenuMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolvePopoverMenuMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolvePopoverMenuMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePopoverMenuMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolvePopoverMenuMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolvePopoverMenuMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolvePopoverMenuMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolvePopoverMenuMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolvePopoverMenuMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolvePopoverMenuMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolvePopoverMenuMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolvePopoverMenuMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolvePopoverMenuMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolvePopoverMenuMethod "getHasArrow" o = Gtk.Popover.PopoverGetHasArrowMethodInfo
    ResolvePopoverMenuMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolvePopoverMenuMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolvePopoverMenuMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolvePopoverMenuMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolvePopoverMenuMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolvePopoverMenuMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolvePopoverMenuMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolvePopoverMenuMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolvePopoverMenuMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolvePopoverMenuMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolvePopoverMenuMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolvePopoverMenuMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolvePopoverMenuMethod "getMenuModel" o = PopoverMenuGetMenuModelMethodInfo
    ResolvePopoverMenuMethod "getMnemonicsVisible" o = Gtk.Popover.PopoverGetMnemonicsVisibleMethodInfo
    ResolvePopoverMenuMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolvePopoverMenuMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolvePopoverMenuMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolvePopoverMenuMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolvePopoverMenuMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolvePopoverMenuMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolvePopoverMenuMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolvePopoverMenuMethod "getPointingTo" o = Gtk.Popover.PopoverGetPointingToMethodInfo
    ResolvePopoverMenuMethod "getPosition" o = Gtk.Popover.PopoverGetPositionMethodInfo
    ResolvePopoverMenuMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolvePopoverMenuMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolvePopoverMenuMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolvePopoverMenuMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePopoverMenuMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePopoverMenuMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolvePopoverMenuMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolvePopoverMenuMethod "getRenderer" o = Gtk.Native.NativeGetRendererMethodInfo
    ResolvePopoverMenuMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolvePopoverMenuMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolvePopoverMenuMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolvePopoverMenuMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolvePopoverMenuMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolvePopoverMenuMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolvePopoverMenuMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolvePopoverMenuMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolvePopoverMenuMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolvePopoverMenuMethod "getSurface" o = Gtk.Native.NativeGetSurfaceMethodInfo
    ResolvePopoverMenuMethod "getSurfaceTransform" o = Gtk.Native.NativeGetSurfaceTransformMethodInfo
    ResolvePopoverMenuMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolvePopoverMenuMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolvePopoverMenuMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolvePopoverMenuMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolvePopoverMenuMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolvePopoverMenuMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolvePopoverMenuMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolvePopoverMenuMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolvePopoverMenuMethod "setAutohide" o = Gtk.Popover.PopoverSetAutohideMethodInfo
    ResolvePopoverMenuMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolvePopoverMenuMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolvePopoverMenuMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolvePopoverMenuMethod "setChild" o = Gtk.Popover.PopoverSetChildMethodInfo
    ResolvePopoverMenuMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolvePopoverMenuMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolvePopoverMenuMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolvePopoverMenuMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolvePopoverMenuMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePopoverMenuMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePopoverMenuMethod "setDefaultWidget" o = Gtk.Popover.PopoverSetDefaultWidgetMethodInfo
    ResolvePopoverMenuMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolvePopoverMenuMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolvePopoverMenuMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolvePopoverMenuMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolvePopoverMenuMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolvePopoverMenuMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolvePopoverMenuMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolvePopoverMenuMethod "setHasArrow" o = Gtk.Popover.PopoverSetHasArrowMethodInfo
    ResolvePopoverMenuMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolvePopoverMenuMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolvePopoverMenuMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolvePopoverMenuMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolvePopoverMenuMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolvePopoverMenuMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolvePopoverMenuMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolvePopoverMenuMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolvePopoverMenuMethod "setMenuModel" o = PopoverMenuSetMenuModelMethodInfo
    ResolvePopoverMenuMethod "setMnemonicsVisible" o = Gtk.Popover.PopoverSetMnemonicsVisibleMethodInfo
    ResolvePopoverMenuMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolvePopoverMenuMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolvePopoverMenuMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolvePopoverMenuMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolvePopoverMenuMethod "setPointingTo" o = Gtk.Popover.PopoverSetPointingToMethodInfo
    ResolvePopoverMenuMethod "setPosition" o = Gtk.Popover.PopoverSetPositionMethodInfo
    ResolvePopoverMenuMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePopoverMenuMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolvePopoverMenuMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolvePopoverMenuMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolvePopoverMenuMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolvePopoverMenuMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolvePopoverMenuMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolvePopoverMenuMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolvePopoverMenuMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolvePopoverMenuMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolvePopoverMenuMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolvePopoverMenuMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolvePopoverMenuMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "menu-model"
   -- Type: TInterface (Name {namespace = "Gio", name = "MenuModel"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,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' popoverMenu #menuModel
-- @
getPopoverMenuMenuModel :: (MonadIO m, IsPopoverMenu o) => o -> m Gio.MenuModel.MenuModel
getPopoverMenuMenuModel :: o -> m MenuModel
getPopoverMenuMenuModel o
obj = IO MenuModel -> m MenuModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MenuModel -> m MenuModel) -> IO MenuModel -> m MenuModel
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe MenuModel) -> IO MenuModel
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getPopoverMenuMenuModel" (IO (Maybe MenuModel) -> IO MenuModel)
-> IO (Maybe MenuModel) -> IO 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 String
"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' popoverMenu [ #menuModel 'Data.GI.Base.Attributes.:=' value ]
-- @
setPopoverMenuMenuModel :: (MonadIO m, IsPopoverMenu o, Gio.MenuModel.IsMenuModel a) => o -> a -> m ()
setPopoverMenuMenuModel :: o -> a -> m ()
setPopoverMenuMenuModel o
obj 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 String
"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`.
constructPopoverMenuMenuModel :: (IsPopoverMenu o, MIO.MonadIO m, Gio.MenuModel.IsMenuModel a) => a -> m (GValueConstruct o)
constructPopoverMenuMenuModel :: a -> m (GValueConstruct o)
constructPopoverMenuMenuModel a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"menu-model" (a -> Maybe a
forall a. a -> Maybe a
P.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
-- @
clearPopoverMenuMenuModel :: (MonadIO m, IsPopoverMenu o) => o -> m ()
clearPopoverMenuMenuModel :: o -> m ()
clearPopoverMenuMenuModel 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 String
"menu-model" (Maybe MenuModel
forall a. Maybe a
Nothing :: Maybe Gio.MenuModel.MenuModel)

#if defined(ENABLE_OVERLOADING)
data PopoverMenuMenuModelPropertyInfo
instance AttrInfo PopoverMenuMenuModelPropertyInfo where
    type AttrAllowedOps PopoverMenuMenuModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PopoverMenuMenuModelPropertyInfo = IsPopoverMenu
    type AttrSetTypeConstraint PopoverMenuMenuModelPropertyInfo = Gio.MenuModel.IsMenuModel
    type AttrTransferTypeConstraint PopoverMenuMenuModelPropertyInfo = Gio.MenuModel.IsMenuModel
    type AttrTransferType PopoverMenuMenuModelPropertyInfo = Gio.MenuModel.MenuModel
    type AttrGetType PopoverMenuMenuModelPropertyInfo = Gio.MenuModel.MenuModel
    type AttrLabel PopoverMenuMenuModelPropertyInfo = "menu-model"
    type AttrOrigin PopoverMenuMenuModelPropertyInfo = PopoverMenu
    attrGet = getPopoverMenuMenuModel
    attrSet = setPopoverMenuMenuModel
    attrTransfer _ v = do
        unsafeCastTo Gio.MenuModel.MenuModel v
    attrConstruct = constructPopoverMenuMenuModel
    attrClear = clearPopoverMenuMenuModel
#endif

-- VVV Prop "visible-submenu"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@visible-submenu@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' popoverMenu #visibleSubmenu
-- @
getPopoverMenuVisibleSubmenu :: (MonadIO m, IsPopoverMenu o) => o -> m (Maybe T.Text)
getPopoverMenuVisibleSubmenu :: o -> m (Maybe Text)
getPopoverMenuVisibleSubmenu o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"visible-submenu"

-- | Set the value of the “@visible-submenu@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' popoverMenu [ #visibleSubmenu 'Data.GI.Base.Attributes.:=' value ]
-- @
setPopoverMenuVisibleSubmenu :: (MonadIO m, IsPopoverMenu o) => o -> T.Text -> m ()
setPopoverMenuVisibleSubmenu :: o -> Text -> m ()
setPopoverMenuVisibleSubmenu o
obj Text
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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"visible-submenu" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@visible-submenu@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPopoverMenuVisibleSubmenu :: (IsPopoverMenu o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructPopoverMenuVisibleSubmenu :: Text -> m (GValueConstruct o)
constructPopoverMenuVisibleSubmenu Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"visible-submenu" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@visible-submenu@” 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' #visibleSubmenu
-- @
clearPopoverMenuVisibleSubmenu :: (MonadIO m, IsPopoverMenu o) => o -> m ()
clearPopoverMenuVisibleSubmenu :: o -> m ()
clearPopoverMenuVisibleSubmenu 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"visible-submenu" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data PopoverMenuVisibleSubmenuPropertyInfo
instance AttrInfo PopoverMenuVisibleSubmenuPropertyInfo where
    type AttrAllowedOps PopoverMenuVisibleSubmenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PopoverMenuVisibleSubmenuPropertyInfo = IsPopoverMenu
    type AttrSetTypeConstraint PopoverMenuVisibleSubmenuPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint PopoverMenuVisibleSubmenuPropertyInfo = (~) T.Text
    type AttrTransferType PopoverMenuVisibleSubmenuPropertyInfo = T.Text
    type AttrGetType PopoverMenuVisibleSubmenuPropertyInfo = (Maybe T.Text)
    type AttrLabel PopoverMenuVisibleSubmenuPropertyInfo = "visible-submenu"
    type AttrOrigin PopoverMenuVisibleSubmenuPropertyInfo = PopoverMenu
    attrGet = getPopoverMenuVisibleSubmenu
    attrSet = setPopoverMenuVisibleSubmenu
    attrTransfer _ v = do
        return v
    attrConstruct = constructPopoverMenuVisibleSubmenu
    attrClear = clearPopoverMenuVisibleSubmenu
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PopoverMenu
type instance O.AttributeList PopoverMenu = PopoverMenuAttributeList
type PopoverMenuAttributeList = ('[ '("autohide", Gtk.Popover.PopoverAutohidePropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("child", Gtk.Popover.PopoverChildPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("defaultWidget", Gtk.Popover.PopoverDefaultWidgetPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasArrow", Gtk.Popover.PopoverHasArrowPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("menuModel", PopoverMenuMenuModelPropertyInfo), '("mnemonicsVisible", Gtk.Popover.PopoverMnemonicsVisiblePropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("pointingTo", Gtk.Popover.PopoverPointingToPropertyInfo), '("position", Gtk.Popover.PopoverPositionPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("visibleSubmenu", PopoverMenuVisibleSubmenuPropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
popoverMenuMenuModel :: AttrLabelProxy "menuModel"
popoverMenuMenuModel = AttrLabelProxy

popoverMenuVisibleSubmenu :: AttrLabelProxy "visibleSubmenu"
popoverMenuVisibleSubmenu = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList PopoverMenu = PopoverMenuSignalList
type PopoverMenuSignalList = ('[ '("activateDefault", Gtk.Popover.PopoverActivateDefaultSignalInfo), '("closed", Gtk.Popover.PopoverClosedSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("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), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

-- method PopoverMenu::new_from_model
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuModel, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "PopoverMenu" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_popover_menu_new_from_model" gtk_popover_menu_new_from_model :: 
    Ptr Gio.MenuModel.MenuModel ->          -- model : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO (Ptr PopoverMenu)

-- | Creates a t'GI.Gtk.Objects.PopoverMenu.PopoverMenu' and populates it according to
-- /@model@/.
-- 
-- The created buttons are connected to actions found in the
-- t'GI.Gtk.Objects.ApplicationWindow.ApplicationWindow' to which the popover belongs - typically
-- by means of being attached to a widget that is contained within
-- the @/GtkApplicationWindows/@ widget hierarchy.
-- 
-- Actions can also be added using 'GI.Gtk.Objects.Widget.widgetInsertActionGroup'
-- on the menus attach widget or on any of its parent widgets.
-- 
-- This function creates menus with sliding submenus.
-- See 'GI.Gtk.Objects.PopoverMenu.popoverMenuNewFromModelFull' for a way
-- to control this.
popoverMenuNewFromModel ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.MenuModel.IsMenuModel a) =>
    Maybe (a)
    -- ^ /@model@/: a t'GI.Gio.Objects.MenuModel.MenuModel', or 'P.Nothing'
    -> m PopoverMenu
    -- ^ __Returns:__ the new t'GI.Gtk.Objects.PopoverMenu.PopoverMenu'
popoverMenuNewFromModel :: Maybe a -> m PopoverMenu
popoverMenuNewFromModel Maybe a
model = IO PopoverMenu -> m PopoverMenu
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PopoverMenu -> m PopoverMenu)
-> IO PopoverMenu -> m PopoverMenu
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuModel
maybeModel <- case Maybe a
model of
        Maybe a
Nothing -> Ptr MenuModel -> IO (Ptr MenuModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MenuModel
forall a. Ptr a
nullPtr
        Just a
jModel -> do
            Ptr MenuModel
jModel' <- a -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jModel
            Ptr MenuModel -> IO (Ptr MenuModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MenuModel
jModel'
    Ptr PopoverMenu
result <- Ptr MenuModel -> IO (Ptr PopoverMenu)
gtk_popover_menu_new_from_model Ptr MenuModel
maybeModel
    Text -> Ptr PopoverMenu -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"popoverMenuNewFromModel" Ptr PopoverMenu
result
    PopoverMenu
result' <- ((ManagedPtr PopoverMenu -> PopoverMenu)
-> Ptr PopoverMenu -> IO PopoverMenu
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PopoverMenu -> PopoverMenu
PopoverMenu) Ptr PopoverMenu
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
model a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    PopoverMenu -> IO PopoverMenu
forall (m :: * -> *) a. Monad m => a -> m a
return PopoverMenu
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PopoverMenu::new_from_model_full
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PopoverMenuFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags that affect how the menu is created"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "PopoverMenu" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_popover_menu_new_from_model_full" gtk_popover_menu_new_from_model_full :: 
    Ptr Gio.MenuModel.MenuModel ->          -- model : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gtk", name = "PopoverMenuFlags"})
    IO (Ptr PopoverMenu)

-- | Creates a t'GI.Gtk.Objects.PopoverMenu.PopoverMenu' and populates it according to
-- /@model@/.
-- 
-- The created buttons are connected to actions found in the
-- action groups that are accessible from the parent widget.
-- This includes the t'GI.Gtk.Objects.ApplicationWindow.ApplicationWindow' to which the popover
-- belongs. Actions can also be added using 'GI.Gtk.Objects.Widget.widgetInsertActionGroup'
-- on the parent widget or on any of its parent widgets.
-- 
-- The only flag that is supported currently is
-- @/GTK_POPOVER_MENU_NESTED/@, which makes GTK create traditional,
-- nested submenus instead of the default sliding submenus.
popoverMenuNewFromModelFull ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.MenuModel.IsMenuModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gio.Objects.MenuModel.MenuModel'
    -> [Gtk.Flags.PopoverMenuFlags]
    -- ^ /@flags@/: flags that affect how the menu is created
    -> m PopoverMenu
    -- ^ __Returns:__ the new t'GI.Gtk.Objects.PopoverMenu.PopoverMenu'
popoverMenuNewFromModelFull :: a -> [PopoverMenuFlags] -> m PopoverMenu
popoverMenuNewFromModelFull a
model [PopoverMenuFlags]
flags = IO PopoverMenu -> m PopoverMenu
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PopoverMenu -> m PopoverMenu)
-> IO PopoverMenu -> m PopoverMenu
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuModel
model' <- a -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    let flags' :: CUInt
flags' = [PopoverMenuFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PopoverMenuFlags]
flags
    Ptr PopoverMenu
result <- Ptr MenuModel -> CUInt -> IO (Ptr PopoverMenu)
gtk_popover_menu_new_from_model_full Ptr MenuModel
model' CUInt
flags'
    Text -> Ptr PopoverMenu -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"popoverMenuNewFromModelFull" Ptr PopoverMenu
result
    PopoverMenu
result' <- ((ManagedPtr PopoverMenu -> PopoverMenu)
-> Ptr PopoverMenu -> IO PopoverMenu
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PopoverMenu -> PopoverMenu
PopoverMenu) Ptr PopoverMenu
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    PopoverMenu -> IO PopoverMenu
forall (m :: * -> *) a. Monad m => a -> m a
return PopoverMenu
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PopoverMenu::get_menu_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "popover"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PopoverMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPopoverMenu" , 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_popover_menu_get_menu_model" gtk_popover_menu_get_menu_model :: 
    Ptr PopoverMenu ->                      -- popover : TInterface (Name {namespace = "Gtk", name = "PopoverMenu"})
    IO (Ptr Gio.MenuModel.MenuModel)

-- | Returns the menu model used to populate the popover.
popoverMenuGetMenuModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsPopoverMenu a) =>
    a
    -- ^ /@popover@/: a t'GI.Gtk.Objects.PopoverMenu.PopoverMenu'
    -> m Gio.MenuModel.MenuModel
    -- ^ __Returns:__ the menu model of /@popover@/
popoverMenuGetMenuModel :: a -> m MenuModel
popoverMenuGetMenuModel a
popover = IO MenuModel -> m MenuModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MenuModel -> m MenuModel) -> IO MenuModel -> m MenuModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr PopoverMenu
popover' <- a -> IO (Ptr PopoverMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popover
    Ptr MenuModel
result <- Ptr PopoverMenu -> IO (Ptr MenuModel)
gtk_popover_menu_get_menu_model Ptr PopoverMenu
popover'
    Text -> Ptr MenuModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"popoverMenuGetMenuModel" Ptr MenuModel
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popover
    MenuModel -> IO MenuModel
forall (m :: * -> *) a. Monad m => a -> m a
return MenuModel
result'

#if defined(ENABLE_OVERLOADING)
data PopoverMenuGetMenuModelMethodInfo
instance (signature ~ (m Gio.MenuModel.MenuModel), MonadIO m, IsPopoverMenu a) => O.MethodInfo PopoverMenuGetMenuModelMethodInfo a signature where
    overloadedMethod = popoverMenuGetMenuModel

#endif

-- method PopoverMenu::set_menu_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "popover"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PopoverMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPopoverMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuModel, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_popover_menu_set_menu_model" gtk_popover_menu_set_menu_model :: 
    Ptr PopoverMenu ->                      -- popover : TInterface (Name {namespace = "Gtk", name = "PopoverMenu"})
    Ptr Gio.MenuModel.MenuModel ->          -- model : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Sets a new menu model on /@popover@/.
-- 
-- The existing contents of /@popover@/ are removed, and
-- the /@popover@/ is populated with new contents according
-- to /@model@/.
popoverMenuSetMenuModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsPopoverMenu a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@popover@/: a t'GI.Gtk.Objects.PopoverMenu.PopoverMenu'
    -> Maybe (b)
    -- ^ /@model@/: a t'GI.Gio.Objects.MenuModel.MenuModel', or 'P.Nothing'
    -> m ()
popoverMenuSetMenuModel :: a -> Maybe b -> m ()
popoverMenuSetMenuModel a
popover Maybe b
model = 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 PopoverMenu
popover' <- a -> IO (Ptr PopoverMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popover
    Ptr MenuModel
maybeModel <- case Maybe b
model of
        Maybe b
Nothing -> Ptr MenuModel -> IO (Ptr MenuModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MenuModel
forall a. Ptr a
nullPtr
        Just b
jModel -> do
            Ptr MenuModel
jModel' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jModel
            Ptr MenuModel -> IO (Ptr MenuModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MenuModel
jModel'
    Ptr PopoverMenu -> Ptr MenuModel -> IO ()
gtk_popover_menu_set_menu_model Ptr PopoverMenu
popover' Ptr MenuModel
maybeModel
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popover
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
model b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif