{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gtk.Objects.Menu.Menu' is a t'GI.Gtk.Objects.MenuShell.MenuShell' that implements a drop down menu
-- consisting of a list of t'GI.Gtk.Objects.MenuItem.MenuItem' objects which can be navigated
-- and activated by the user to perform application functions.
-- 
-- A t'GI.Gtk.Objects.Menu.Menu' is most commonly dropped down by activating a
-- t'GI.Gtk.Objects.MenuItem.MenuItem' in a t'GI.Gtk.Objects.MenuBar.MenuBar' or popped up by activating a
-- t'GI.Gtk.Objects.MenuItem.MenuItem' in another t'GI.Gtk.Objects.Menu.Menu'.
-- 
-- A t'GI.Gtk.Objects.Menu.Menu' can also be popped up by activating a t'GI.Gtk.Objects.ComboBox.ComboBox'.
-- Other composite widgets such as the t'GI.Gtk.Objects.Notebook.Notebook' can pop up a
-- t'GI.Gtk.Objects.Menu.Menu' as well.
-- 
-- Applications can display a t'GI.Gtk.Objects.Menu.Menu' as a popup menu by calling one of the
-- gtk_menu_popup_*() function. The example below shows how an application can
-- pop up a menu when the 3rd mouse button is pressed.
-- 
-- == Connecting the popup signal handler.
-- 
-- 
-- === /C code/
-- >
-- >  // connect our handler which will popup the menu
-- >  gesture = gtk_gesture_multi_press_new (window);
-- >  gtk_gesture_single_set_button (GTK_GESTURE_SINGLE (gesture),
-- >                                 GDK_BUTTON_SECONDARY);
-- >  g_signal_connect (gesture, "begin", G_CALLBACK (my_popup_handler), menu);
-- 
-- 
-- == Signal handler which displays a popup menu.
-- 
-- 
-- === /C code/
-- >
-- >static void
-- >my_popup_handler (GtkGesture       *gesture,
-- >                  GdkEventSequence *sequence
-- >                  gpointer          data)
-- >{
-- >  GtkMenu *menu = data;
-- >  const GdkEvent *event;
-- >
-- >  event = gtk_gesture_get_last_event (gesture, sequence);
-- >  gtk_menu_popup_at_pointer (menu, event);
-- >}
-- 
-- 
-- = CSS nodes
-- 
-- 
-- === /plain code/
-- >
-- >menu
-- >├── arrow.top
-- >├── <child>
-- >┊
-- >├── <child>
-- >╰── arrow.bottom
-- 
-- 
-- The main CSS node of GtkMenu has name menu, and there are two subnodes
-- with name arrow, for scrolling menu arrows. These subnodes get the
-- .top and .bottom style classes.

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

module GI.Gtk.Objects.Menu
    ( 

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


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

#if defined(ENABLE_OVERLOADING)
    ResolveMenuMethod                       ,
#endif


-- ** attachToWidget #method:attachToWidget#

#if defined(ENABLE_OVERLOADING)
    MenuAttachToWidgetMethodInfo            ,
#endif
    menuAttachToWidget                      ,


-- ** detach #method:detach#

#if defined(ENABLE_OVERLOADING)
    MenuDetachMethodInfo                    ,
#endif
    menuDetach                              ,


-- ** getAccelGroup #method:getAccelGroup#

#if defined(ENABLE_OVERLOADING)
    MenuGetAccelGroupMethodInfo             ,
#endif
    menuGetAccelGroup                       ,


-- ** getAccelPath #method:getAccelPath#

#if defined(ENABLE_OVERLOADING)
    MenuGetAccelPathMethodInfo              ,
#endif
    menuGetAccelPath                        ,


-- ** getActive #method:getActive#

#if defined(ENABLE_OVERLOADING)
    MenuGetActiveMethodInfo                 ,
#endif
    menuGetActive                           ,


-- ** getAttachWidget #method:getAttachWidget#

#if defined(ENABLE_OVERLOADING)
    MenuGetAttachWidgetMethodInfo           ,
#endif
    menuGetAttachWidget                     ,


-- ** getForAttachWidget #method:getForAttachWidget#

    menuGetForAttachWidget                  ,


-- ** getMonitor #method:getMonitor#

#if defined(ENABLE_OVERLOADING)
    MenuGetMonitorMethodInfo                ,
#endif
    menuGetMonitor                          ,


-- ** getReserveToggleSize #method:getReserveToggleSize#

#if defined(ENABLE_OVERLOADING)
    MenuGetReserveToggleSizeMethodInfo      ,
#endif
    menuGetReserveToggleSize                ,


-- ** new #method:new#

    menuNew                                 ,


-- ** newFromModel #method:newFromModel#

    menuNewFromModel                        ,


-- ** placeOnMonitor #method:placeOnMonitor#

#if defined(ENABLE_OVERLOADING)
    MenuPlaceOnMonitorMethodInfo            ,
#endif
    menuPlaceOnMonitor                      ,


-- ** popdown #method:popdown#

#if defined(ENABLE_OVERLOADING)
    MenuPopdownMethodInfo                   ,
#endif
    menuPopdown                             ,


-- ** popupAtPointer #method:popupAtPointer#

#if defined(ENABLE_OVERLOADING)
    MenuPopupAtPointerMethodInfo            ,
#endif
    menuPopupAtPointer                      ,


-- ** popupAtRect #method:popupAtRect#

#if defined(ENABLE_OVERLOADING)
    MenuPopupAtRectMethodInfo               ,
#endif
    menuPopupAtRect                         ,


-- ** popupAtWidget #method:popupAtWidget#

#if defined(ENABLE_OVERLOADING)
    MenuPopupAtWidgetMethodInfo             ,
#endif
    menuPopupAtWidget                       ,


-- ** reorderChild #method:reorderChild#

#if defined(ENABLE_OVERLOADING)
    MenuReorderChildMethodInfo              ,
#endif
    menuReorderChild                        ,


-- ** reposition #method:reposition#

#if defined(ENABLE_OVERLOADING)
    MenuRepositionMethodInfo                ,
#endif
    menuReposition                          ,


-- ** setAccelGroup #method:setAccelGroup#

#if defined(ENABLE_OVERLOADING)
    MenuSetAccelGroupMethodInfo             ,
#endif
    menuSetAccelGroup                       ,


-- ** setAccelPath #method:setAccelPath#

#if defined(ENABLE_OVERLOADING)
    MenuSetAccelPathMethodInfo              ,
#endif
    menuSetAccelPath                        ,


-- ** setActive #method:setActive#

#if defined(ENABLE_OVERLOADING)
    MenuSetActiveMethodInfo                 ,
#endif
    menuSetActive                           ,


-- ** setMonitor #method:setMonitor#

#if defined(ENABLE_OVERLOADING)
    MenuSetMonitorMethodInfo                ,
#endif
    menuSetMonitor                          ,


-- ** setReserveToggleSize #method:setReserveToggleSize#

#if defined(ENABLE_OVERLOADING)
    MenuSetReserveToggleSizeMethodInfo      ,
#endif
    menuSetReserveToggleSize                ,




 -- * Properties
-- ** accelGroup #attr:accelGroup#
-- | The accel group holding accelerators for the menu.

#if defined(ENABLE_OVERLOADING)
    MenuAccelGroupPropertyInfo              ,
#endif
    clearMenuAccelGroup                     ,
    constructMenuAccelGroup                 ,
    getMenuAccelGroup                       ,
#if defined(ENABLE_OVERLOADING)
    menuAccelGroup                          ,
#endif
    setMenuAccelGroup                       ,


-- ** accelPath #attr:accelPath#
-- | An accel path used to conveniently construct accel paths of child items.

#if defined(ENABLE_OVERLOADING)
    MenuAccelPathPropertyInfo               ,
#endif
    clearMenuAccelPath                      ,
    constructMenuAccelPath                  ,
    getMenuAccelPath                        ,
#if defined(ENABLE_OVERLOADING)
    menuAccelPath                           ,
#endif
    setMenuAccelPath                        ,


-- ** active #attr:active#
-- | The index of the currently selected menu item, or -1 if no
-- menu item is selected.

#if defined(ENABLE_OVERLOADING)
    MenuActivePropertyInfo                  ,
#endif
    constructMenuActive                     ,
    getMenuActive                           ,
#if defined(ENABLE_OVERLOADING)
    menuActive                              ,
#endif
    setMenuActive                           ,


-- ** anchorHints #attr:anchorHints#
-- | Positioning hints for aligning the menu relative to a rectangle.
-- 
-- These hints determine how the menu should be positioned in the case that
-- the menu would fall off-screen if placed in its ideal position.
-- 
-- <<https://developer.gnome.org/gtk4/stable/popup-flip.png>>
-- 
-- For example, 'GI.Gdk.Flags.AnchorHintsFlipY' will replace 'GI.Gdk.Enums.GravityNorthWest' with
-- 'GI.Gdk.Enums.GravitySouthWest' and vice versa if the menu extends beyond the
-- bottom edge of the monitor.
-- 
-- See gtk_menu_popup_at_rect (), gtk_menu_popup_at_widget (),
-- gtk_menu_popup_at_pointer (), t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dx/@,
-- t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dy/@, t'GI.Gtk.Objects.Menu.Menu':@/menu-type-hint/@, and [poppedUp]("GI.Gtk.Objects.Menu#signal:poppedUp").

#if defined(ENABLE_OVERLOADING)
    MenuAnchorHintsPropertyInfo             ,
#endif
    constructMenuAnchorHints                ,
    getMenuAnchorHints                      ,
#if defined(ENABLE_OVERLOADING)
    menuAnchorHints                         ,
#endif
    setMenuAnchorHints                      ,


-- ** attachWidget #attr:attachWidget#
-- | The widget the menu is attached to. Setting this property attaches
-- the menu without a t'GI.Gtk.Callbacks.MenuDetachFunc'. If you need to use a detacher,
-- use 'GI.Gtk.Objects.Menu.menuAttachToWidget' directly.

#if defined(ENABLE_OVERLOADING)
    MenuAttachWidgetPropertyInfo            ,
#endif
    clearMenuAttachWidget                   ,
    constructMenuAttachWidget               ,
    getMenuAttachWidget                     ,
#if defined(ENABLE_OVERLOADING)
    menuAttachWidget                        ,
#endif
    setMenuAttachWidget                     ,


-- ** menuTypeHint #attr:menuTypeHint#
-- | The t'GI.Gdk.Enums.SurfaceTypeHint' to use for the menu\'s t'GI.Gdk.Objects.Surface.Surface'.
-- 
-- See gtk_menu_popup_at_rect (), gtk_menu_popup_at_widget (),
-- gtk_menu_popup_at_pointer (), t'GI.Gtk.Objects.Menu.Menu':@/anchor-hints/@,
-- t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dx/@, t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dy/@, and [poppedUp]("GI.Gtk.Objects.Menu#signal:poppedUp").

#if defined(ENABLE_OVERLOADING)
    MenuMenuTypeHintPropertyInfo            ,
#endif
    constructMenuMenuTypeHint               ,
    getMenuMenuTypeHint                     ,
#if defined(ENABLE_OVERLOADING)
    menuMenuTypeHint                        ,
#endif
    setMenuMenuTypeHint                     ,


-- ** monitor #attr:monitor#
-- | The monitor the menu will be popped up on.

#if defined(ENABLE_OVERLOADING)
    MenuMonitorPropertyInfo                 ,
#endif
    constructMenuMonitor                    ,
    getMenuMonitor                          ,
#if defined(ENABLE_OVERLOADING)
    menuMonitor                             ,
#endif
    setMenuMonitor                          ,


-- ** rectAnchorDx #attr:rectAnchorDx#
-- | Horizontal offset to apply to the menu, i.e. the rectangle or widget
-- anchor.
-- 
-- See gtk_menu_popup_at_rect (), gtk_menu_popup_at_widget (),
-- gtk_menu_popup_at_pointer (), t'GI.Gtk.Objects.Menu.Menu':@/anchor-hints/@,
-- t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dy/@, t'GI.Gtk.Objects.Menu.Menu':@/menu-type-hint/@, and [poppedUp]("GI.Gtk.Objects.Menu#signal:poppedUp").

#if defined(ENABLE_OVERLOADING)
    MenuRectAnchorDxPropertyInfo            ,
#endif
    constructMenuRectAnchorDx               ,
    getMenuRectAnchorDx                     ,
#if defined(ENABLE_OVERLOADING)
    menuRectAnchorDx                        ,
#endif
    setMenuRectAnchorDx                     ,


-- ** rectAnchorDy #attr:rectAnchorDy#
-- | Vertical offset to apply to the menu, i.e. the rectangle or widget anchor.
-- 
-- See gtk_menu_popup_at_rect (), gtk_menu_popup_at_widget (),
-- gtk_menu_popup_at_pointer (), t'GI.Gtk.Objects.Menu.Menu':@/anchor-hints/@,
-- t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dx/@, t'GI.Gtk.Objects.Menu.Menu':@/menu-type-hint/@, and [poppedUp]("GI.Gtk.Objects.Menu#signal:poppedUp").

#if defined(ENABLE_OVERLOADING)
    MenuRectAnchorDyPropertyInfo            ,
#endif
    constructMenuRectAnchorDy               ,
    getMenuRectAnchorDy                     ,
#if defined(ENABLE_OVERLOADING)
    menuRectAnchorDy                        ,
#endif
    setMenuRectAnchorDy                     ,


-- ** reserveToggleSize #attr:reserveToggleSize#
-- | A boolean that indicates whether the menu reserves space for
-- toggles and icons, regardless of their actual presence.
-- 
-- This property should only be changed from its default value
-- for special-purposes such as tabular menus. Regular menus that
-- are connected to a menu bar or context menus should reserve
-- toggle space for consistency.

#if defined(ENABLE_OVERLOADING)
    MenuReserveToggleSizePropertyInfo       ,
#endif
    constructMenuReserveToggleSize          ,
    getMenuReserveToggleSize                ,
#if defined(ENABLE_OVERLOADING)
    menuReserveToggleSize                   ,
#endif
    setMenuReserveToggleSize                ,




 -- * Signals
-- ** moveScroll #signal:moveScroll#

    C_MenuMoveScrollCallback                ,
    MenuMoveScrollCallback                  ,
#if defined(ENABLE_OVERLOADING)
    MenuMoveScrollSignalInfo                ,
#endif
    afterMenuMoveScroll                     ,
    genClosure_MenuMoveScroll               ,
    mk_MenuMoveScrollCallback               ,
    noMenuMoveScrollCallback                ,
    onMenuMoveScroll                        ,
    wrap_MenuMoveScrollCallback             ,


-- ** poppedUp #signal:poppedUp#

    C_MenuPoppedUpCallback                  ,
    MenuPoppedUpCallback                    ,
#if defined(ENABLE_OVERLOADING)
    MenuPoppedUpSignalInfo                  ,
#endif
    afterMenuPoppedUp                       ,
    genClosure_MenuPoppedUp                 ,
    mk_MenuPoppedUpCallback                 ,
    noMenuPoppedUpCallback                  ,
    onMenuPoppedUp                          ,
    wrap_MenuPoppedUpCallback               ,




    ) 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.Gdk.Enums as Gdk.Enums
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Objects.Event as Gdk.Event
import qualified GI.Gdk.Objects.Monitor as Gdk.Monitor
import qualified GI.Gdk.Objects.Surface as Gdk.Surface
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Objects.AccelGroup as Gtk.AccelGroup
import {-# SOURCE #-} qualified GI.Gtk.Objects.Container as Gtk.Container
import {-# SOURCE #-} qualified GI.Gtk.Objects.MenuShell as Gtk.MenuShell
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

instance GObject Menu where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_menu_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `Menu`.
noMenu :: Maybe Menu
noMenu :: Maybe Menu
noMenu = Maybe Menu
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveMenuMethod (t :: Symbol) (o :: *) :: * where
    ResolveMenuMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveMenuMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveMenuMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveMenuMethod "activateItem" o = Gtk.MenuShell.MenuShellActivateItemMethodInfo
    ResolveMenuMethod "add" o = Gtk.Container.ContainerAddMethodInfo
    ResolveMenuMethod "addAccelerator" o = Gtk.Widget.WidgetAddAcceleratorMethodInfo
    ResolveMenuMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveMenuMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveMenuMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveMenuMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveMenuMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveMenuMethod "append" o = Gtk.MenuShell.MenuShellAppendMethodInfo
    ResolveMenuMethod "attachToWidget" o = MenuAttachToWidgetMethodInfo
    ResolveMenuMethod "bindModel" o = Gtk.MenuShell.MenuShellBindModelMethodInfo
    ResolveMenuMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMenuMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMenuMethod "canActivateAccel" o = Gtk.Widget.WidgetCanActivateAccelMethodInfo
    ResolveMenuMethod "cancel" o = Gtk.MenuShell.MenuShellCancelMethodInfo
    ResolveMenuMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveMenuMethod "childType" o = Gtk.Container.ContainerChildTypeMethodInfo
    ResolveMenuMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveMenuMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveMenuMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveMenuMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveMenuMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveMenuMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveMenuMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveMenuMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveMenuMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveMenuMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveMenuMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveMenuMethod "deactivate" o = Gtk.MenuShell.MenuShellDeactivateMethodInfo
    ResolveMenuMethod "deselect" o = Gtk.MenuShell.MenuShellDeselectMethodInfo
    ResolveMenuMethod "destroy" o = Gtk.Widget.WidgetDestroyMethodInfo
    ResolveMenuMethod "destroyed" o = Gtk.Widget.WidgetDestroyedMethodInfo
    ResolveMenuMethod "detach" o = MenuDetachMethodInfo
    ResolveMenuMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveMenuMethod "dragBegin" o = Gtk.Widget.WidgetDragBeginMethodInfo
    ResolveMenuMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveMenuMethod "dragDestAddImageTargets" o = Gtk.Widget.WidgetDragDestAddImageTargetsMethodInfo
    ResolveMenuMethod "dragDestAddTextTargets" o = Gtk.Widget.WidgetDragDestAddTextTargetsMethodInfo
    ResolveMenuMethod "dragDestAddUriTargets" o = Gtk.Widget.WidgetDragDestAddUriTargetsMethodInfo
    ResolveMenuMethod "dragDestFindTarget" o = Gtk.Widget.WidgetDragDestFindTargetMethodInfo
    ResolveMenuMethod "dragDestGetTargetList" o = Gtk.Widget.WidgetDragDestGetTargetListMethodInfo
    ResolveMenuMethod "dragDestGetTrackMotion" o = Gtk.Widget.WidgetDragDestGetTrackMotionMethodInfo
    ResolveMenuMethod "dragDestSet" o = Gtk.Widget.WidgetDragDestSetMethodInfo
    ResolveMenuMethod "dragDestSetTargetList" o = Gtk.Widget.WidgetDragDestSetTargetListMethodInfo
    ResolveMenuMethod "dragDestSetTrackMotion" o = Gtk.Widget.WidgetDragDestSetTrackMotionMethodInfo
    ResolveMenuMethod "dragDestUnset" o = Gtk.Widget.WidgetDragDestUnsetMethodInfo
    ResolveMenuMethod "dragGetData" o = Gtk.Widget.WidgetDragGetDataMethodInfo
    ResolveMenuMethod "dragHighlight" o = Gtk.Widget.WidgetDragHighlightMethodInfo
    ResolveMenuMethod "dragSourceAddImageTargets" o = Gtk.Widget.WidgetDragSourceAddImageTargetsMethodInfo
    ResolveMenuMethod "dragSourceAddTextTargets" o = Gtk.Widget.WidgetDragSourceAddTextTargetsMethodInfo
    ResolveMenuMethod "dragSourceAddUriTargets" o = Gtk.Widget.WidgetDragSourceAddUriTargetsMethodInfo
    ResolveMenuMethod "dragSourceGetTargetList" o = Gtk.Widget.WidgetDragSourceGetTargetListMethodInfo
    ResolveMenuMethod "dragSourceSet" o = Gtk.Widget.WidgetDragSourceSetMethodInfo
    ResolveMenuMethod "dragSourceSetIconGicon" o = Gtk.Widget.WidgetDragSourceSetIconGiconMethodInfo
    ResolveMenuMethod "dragSourceSetIconName" o = Gtk.Widget.WidgetDragSourceSetIconNameMethodInfo
    ResolveMenuMethod "dragSourceSetIconPaintable" o = Gtk.Widget.WidgetDragSourceSetIconPaintableMethodInfo
    ResolveMenuMethod "dragSourceSetTargetList" o = Gtk.Widget.WidgetDragSourceSetTargetListMethodInfo
    ResolveMenuMethod "dragSourceUnset" o = Gtk.Widget.WidgetDragSourceUnsetMethodInfo
    ResolveMenuMethod "dragUnhighlight" o = Gtk.Widget.WidgetDragUnhighlightMethodInfo
    ResolveMenuMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveMenuMethod "event" o = Gtk.Widget.WidgetEventMethodInfo
    ResolveMenuMethod "forall" o = Gtk.Container.ContainerForallMethodInfo
    ResolveMenuMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMenuMethod "foreach" o = Gtk.Container.ContainerForeachMethodInfo
    ResolveMenuMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMenuMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMenuMethod "grabAdd" o = Gtk.Widget.WidgetGrabAddMethodInfo
    ResolveMenuMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveMenuMethod "grabRemove" o = Gtk.Widget.WidgetGrabRemoveMethodInfo
    ResolveMenuMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveMenuMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveMenuMethod "hasGrab" o = Gtk.Widget.WidgetHasGrabMethodInfo
    ResolveMenuMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveMenuMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveMenuMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveMenuMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveMenuMethod "inputShapeCombineRegion" o = Gtk.Widget.WidgetInputShapeCombineRegionMethodInfo
    ResolveMenuMethod "insert" o = Gtk.MenuShell.MenuShellInsertMethodInfo
    ResolveMenuMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveMenuMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveMenuMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveMenuMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveMenuMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveMenuMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMenuMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveMenuMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveMenuMethod "isToplevel" o = Gtk.Widget.WidgetIsToplevelMethodInfo
    ResolveMenuMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveMenuMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveMenuMethod "listAccelClosures" o = Gtk.Widget.WidgetListAccelClosuresMethodInfo
    ResolveMenuMethod "listActionPrefixes" o = Gtk.Widget.WidgetListActionPrefixesMethodInfo
    ResolveMenuMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveMenuMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveMenuMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveMenuMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveMenuMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMenuMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMenuMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveMenuMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveMenuMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveMenuMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveMenuMethod "placeOnMonitor" o = MenuPlaceOnMonitorMethodInfo
    ResolveMenuMethod "popdown" o = MenuPopdownMethodInfo
    ResolveMenuMethod "popupAtPointer" o = MenuPopupAtPointerMethodInfo
    ResolveMenuMethod "popupAtRect" o = MenuPopupAtRectMethodInfo
    ResolveMenuMethod "popupAtWidget" o = MenuPopupAtWidgetMethodInfo
    ResolveMenuMethod "prepend" o = Gtk.MenuShell.MenuShellPrependMethodInfo
    ResolveMenuMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveMenuMethod "queueComputeExpand" o = Gtk.Widget.WidgetQueueComputeExpandMethodInfo
    ResolveMenuMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveMenuMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveMenuMethod "queueResizeNoRedraw" o = Gtk.Widget.WidgetQueueResizeNoRedrawMethodInfo
    ResolveMenuMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveMenuMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMenuMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMenuMethod "registerSurface" o = Gtk.Widget.WidgetRegisterSurfaceMethodInfo
    ResolveMenuMethod "remove" o = Gtk.Container.ContainerRemoveMethodInfo
    ResolveMenuMethod "removeAccelerator" o = Gtk.Widget.WidgetRemoveAcceleratorMethodInfo
    ResolveMenuMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveMenuMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveMenuMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveMenuMethod "reorderChild" o = MenuReorderChildMethodInfo
    ResolveMenuMethod "reposition" o = MenuRepositionMethodInfo
    ResolveMenuMethod "resetStyle" o = Gtk.Widget.WidgetResetStyleMethodInfo
    ResolveMenuMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMenuMethod "selectFirst" o = Gtk.MenuShell.MenuShellSelectFirstMethodInfo
    ResolveMenuMethod "selectItem" o = Gtk.MenuShell.MenuShellSelectItemMethodInfo
    ResolveMenuMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveMenuMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveMenuMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveMenuMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMenuMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMenuMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMenuMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveMenuMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveMenuMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveMenuMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveMenuMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveMenuMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMenuMethod "unregisterSurface" o = Gtk.Widget.WidgetUnregisterSurfaceMethodInfo
    ResolveMenuMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveMenuMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMenuMethod "getAccelGroup" o = MenuGetAccelGroupMethodInfo
    ResolveMenuMethod "getAccelPath" o = MenuGetAccelPathMethodInfo
    ResolveMenuMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveMenuMethod "getActionGroup" o = Gtk.Widget.WidgetGetActionGroupMethodInfo
    ResolveMenuMethod "getActive" o = MenuGetActiveMethodInfo
    ResolveMenuMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveMenuMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveMenuMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveMenuMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveMenuMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveMenuMethod "getAttachWidget" o = MenuGetAttachWidgetMethodInfo
    ResolveMenuMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveMenuMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveMenuMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveMenuMethod "getChildren" o = Gtk.Container.ContainerGetChildrenMethodInfo
    ResolveMenuMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveMenuMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveMenuMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMenuMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveMenuMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveMenuMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveMenuMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveMenuMethod "getFocusHadjustment" o = Gtk.Container.ContainerGetFocusHadjustmentMethodInfo
    ResolveMenuMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveMenuMethod "getFocusVadjustment" o = Gtk.Container.ContainerGetFocusVadjustmentMethodInfo
    ResolveMenuMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveMenuMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveMenuMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveMenuMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveMenuMethod "getHasSurface" o = Gtk.Widget.WidgetGetHasSurfaceMethodInfo
    ResolveMenuMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveMenuMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveMenuMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveMenuMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveMenuMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveMenuMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveMenuMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveMenuMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveMenuMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveMenuMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveMenuMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveMenuMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveMenuMethod "getModifierMask" o = Gtk.Widget.WidgetGetModifierMaskMethodInfo
    ResolveMenuMethod "getMonitor" o = MenuGetMonitorMethodInfo
    ResolveMenuMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveMenuMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveMenuMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveMenuMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveMenuMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveMenuMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveMenuMethod "getParentShell" o = Gtk.MenuShell.MenuShellGetParentShellMethodInfo
    ResolveMenuMethod "getPath" o = Gtk.Widget.WidgetGetPathMethodInfo
    ResolveMenuMethod "getPathForChild" o = Gtk.Container.ContainerGetPathForChildMethodInfo
    ResolveMenuMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveMenuMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveMenuMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveMenuMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMenuMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMenuMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveMenuMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveMenuMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveMenuMethod "getReserveToggleSize" o = MenuGetReserveToggleSizeMethodInfo
    ResolveMenuMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveMenuMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveMenuMethod "getSelectedItem" o = Gtk.MenuShell.MenuShellGetSelectedItemMethodInfo
    ResolveMenuMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveMenuMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveMenuMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveMenuMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveMenuMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveMenuMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveMenuMethod "getSurface" o = Gtk.Widget.WidgetGetSurfaceMethodInfo
    ResolveMenuMethod "getTakeFocus" o = Gtk.MenuShell.MenuShellGetTakeFocusMethodInfo
    ResolveMenuMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveMenuMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveMenuMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveMenuMethod "getTooltipWindow" o = Gtk.Widget.WidgetGetTooltipWindowMethodInfo
    ResolveMenuMethod "getToplevel" o = Gtk.Widget.WidgetGetToplevelMethodInfo
    ResolveMenuMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveMenuMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveMenuMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveMenuMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveMenuMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveMenuMethod "setAccelGroup" o = MenuSetAccelGroupMethodInfo
    ResolveMenuMethod "setAccelPath" o = MenuSetAccelPathMethodInfo
    ResolveMenuMethod "setActive" o = MenuSetActiveMethodInfo
    ResolveMenuMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveMenuMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveMenuMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveMenuMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveMenuMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveMenuMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveMenuMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMenuMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMenuMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveMenuMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveMenuMethod "setFocusHadjustment" o = Gtk.Container.ContainerSetFocusHadjustmentMethodInfo
    ResolveMenuMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveMenuMethod "setFocusVadjustment" o = Gtk.Container.ContainerSetFocusVadjustmentMethodInfo
    ResolveMenuMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveMenuMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveMenuMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveMenuMethod "setHasSurface" o = Gtk.Widget.WidgetSetHasSurfaceMethodInfo
    ResolveMenuMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveMenuMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveMenuMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveMenuMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveMenuMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveMenuMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveMenuMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveMenuMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveMenuMethod "setMonitor" o = MenuSetMonitorMethodInfo
    ResolveMenuMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveMenuMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveMenuMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveMenuMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveMenuMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMenuMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveMenuMethod "setReserveToggleSize" o = MenuSetReserveToggleSizeMethodInfo
    ResolveMenuMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveMenuMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveMenuMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveMenuMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveMenuMethod "setSurface" o = Gtk.Widget.WidgetSetSurfaceMethodInfo
    ResolveMenuMethod "setTakeFocus" o = Gtk.MenuShell.MenuShellSetTakeFocusMethodInfo
    ResolveMenuMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveMenuMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveMenuMethod "setTooltipWindow" o = Gtk.Widget.WidgetSetTooltipWindowMethodInfo
    ResolveMenuMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveMenuMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveMenuMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveMenuMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveMenuMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Menu::move-scroll
-- | /No description available in the introspection data./
type MenuMoveScrollCallback =
    Gtk.Enums.ScrollType
    -- ^ /@scrollType@/: a t'GI.Gtk.Enums.ScrollType'
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `MenuMoveScrollCallback`@.
noMenuMoveScrollCallback :: Maybe MenuMoveScrollCallback
noMenuMoveScrollCallback :: Maybe MenuMoveScrollCallback
noMenuMoveScrollCallback = Maybe MenuMoveScrollCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_MenuMoveScrollCallback =
    Ptr () ->                               -- object
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_MenuMoveScroll :: MonadIO m => MenuMoveScrollCallback -> m (GClosure C_MenuMoveScrollCallback)
genClosure_MenuMoveScroll :: MenuMoveScrollCallback -> m (GClosure C_MenuMoveScrollCallback)
genClosure_MenuMoveScroll cb :: MenuMoveScrollCallback
cb = IO (GClosure C_MenuMoveScrollCallback)
-> m (GClosure C_MenuMoveScrollCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_MenuMoveScrollCallback)
 -> m (GClosure C_MenuMoveScrollCallback))
-> IO (GClosure C_MenuMoveScrollCallback)
-> m (GClosure C_MenuMoveScrollCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MenuMoveScrollCallback
cb' = MenuMoveScrollCallback -> C_MenuMoveScrollCallback
wrap_MenuMoveScrollCallback MenuMoveScrollCallback
cb
    C_MenuMoveScrollCallback -> IO (FunPtr C_MenuMoveScrollCallback)
mk_MenuMoveScrollCallback C_MenuMoveScrollCallback
cb' IO (FunPtr C_MenuMoveScrollCallback)
-> (FunPtr C_MenuMoveScrollCallback
    -> IO (GClosure C_MenuMoveScrollCallback))
-> IO (GClosure C_MenuMoveScrollCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_MenuMoveScrollCallback
-> IO (GClosure C_MenuMoveScrollCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `MenuMoveScrollCallback` into a `C_MenuMoveScrollCallback`.
wrap_MenuMoveScrollCallback ::
    MenuMoveScrollCallback ->
    C_MenuMoveScrollCallback
wrap_MenuMoveScrollCallback :: MenuMoveScrollCallback -> C_MenuMoveScrollCallback
wrap_MenuMoveScrollCallback _cb :: MenuMoveScrollCallback
_cb _ scrollType :: CUInt
scrollType _ = do
    let scrollType' :: ScrollType
scrollType' = (Int -> ScrollType
forall a. Enum a => Int -> a
toEnum (Int -> ScrollType) -> (CUInt -> Int) -> CUInt -> ScrollType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
scrollType
    MenuMoveScrollCallback
_cb  ScrollType
scrollType'


-- | Connect a signal handler for the [moveScroll](#signal:moveScroll) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menu #moveScroll callback
-- @
-- 
-- 
onMenuMoveScroll :: (IsMenu a, MonadIO m) => a -> MenuMoveScrollCallback -> m SignalHandlerId
onMenuMoveScroll :: a -> MenuMoveScrollCallback -> m SignalHandlerId
onMenuMoveScroll obj :: a
obj cb :: MenuMoveScrollCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MenuMoveScrollCallback
cb' = MenuMoveScrollCallback -> C_MenuMoveScrollCallback
wrap_MenuMoveScrollCallback MenuMoveScrollCallback
cb
    FunPtr C_MenuMoveScrollCallback
cb'' <- C_MenuMoveScrollCallback -> IO (FunPtr C_MenuMoveScrollCallback)
mk_MenuMoveScrollCallback C_MenuMoveScrollCallback
cb'
    a
-> Text
-> FunPtr C_MenuMoveScrollCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "move-scroll" FunPtr C_MenuMoveScrollCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [moveScroll](#signal:moveScroll) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menu #moveScroll callback
-- @
-- 
-- 
afterMenuMoveScroll :: (IsMenu a, MonadIO m) => a -> MenuMoveScrollCallback -> m SignalHandlerId
afterMenuMoveScroll :: a -> MenuMoveScrollCallback -> m SignalHandlerId
afterMenuMoveScroll obj :: a
obj cb :: MenuMoveScrollCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MenuMoveScrollCallback
cb' = MenuMoveScrollCallback -> C_MenuMoveScrollCallback
wrap_MenuMoveScrollCallback MenuMoveScrollCallback
cb
    FunPtr C_MenuMoveScrollCallback
cb'' <- C_MenuMoveScrollCallback -> IO (FunPtr C_MenuMoveScrollCallback)
mk_MenuMoveScrollCallback C_MenuMoveScrollCallback
cb'
    a
-> Text
-> FunPtr C_MenuMoveScrollCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "move-scroll" FunPtr C_MenuMoveScrollCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MenuMoveScrollSignalInfo
instance SignalInfo MenuMoveScrollSignalInfo where
    type HaskellCallbackType MenuMoveScrollSignalInfo = MenuMoveScrollCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuMoveScrollCallback cb
        cb'' <- mk_MenuMoveScrollCallback cb'
        connectSignalFunPtr obj "move-scroll" cb'' connectMode detail

#endif

-- signal Menu::popped-up
-- | Emitted when the position of /@menu@/ is finalized after being popped up
-- using gtk_menu_popup_at_rect (), gtk_menu_popup_at_widget (), or
-- gtk_menu_popup_at_pointer ().
-- 
-- /@menu@/ might be flipped over the anchor rectangle in order to keep it
-- on-screen, in which case /@flippedX@/ and /@flippedY@/ will be set to 'P.True'
-- accordingly.
-- 
-- /@flippedRect@/ is the ideal position of /@menu@/ after any possible flipping,
-- but before any possible sliding. /@finalRect@/ is /@flippedRect@/, but possibly
-- translated in the case that flipping is still ineffective in keeping /@menu@/
-- on-screen.
-- 
-- <<https://developer.gnome.org/gtk4/stable/popup-slide.png>>
-- 
-- The blue menu is /@menu@/\'s ideal position, the green menu is /@flippedRect@/,
-- and the red menu is /@finalRect@/.
-- 
-- See gtk_menu_popup_at_rect (), gtk_menu_popup_at_widget (),
-- gtk_menu_popup_at_pointer (), t'GI.Gtk.Objects.Menu.Menu':@/anchor-hints/@,
-- t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dx/@, t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dy/@, and
-- t'GI.Gtk.Objects.Menu.Menu':@/menu-type-hint/@.
type MenuPoppedUpCallback =
    Ptr ()
    -- ^ /@flippedRect@/: the position of /@menu@/ after any possible
    --                flipping or 'P.Nothing' if the backend can\'t obtain it
    -> Ptr ()
    -- ^ /@finalRect@/: the final position of /@menu@/ or 'P.Nothing' if the
    --              backend can\'t obtain it
    -> Bool
    -- ^ /@flippedX@/: 'P.True' if the anchors were flipped horizontally
    -> Bool
    -- ^ /@flippedY@/: 'P.True' if the anchors were flipped vertically
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `MenuPoppedUpCallback`@.
noMenuPoppedUpCallback :: Maybe MenuPoppedUpCallback
noMenuPoppedUpCallback :: Maybe MenuPoppedUpCallback
noMenuPoppedUpCallback = Maybe MenuPoppedUpCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_MenuPoppedUpCallback =
    Ptr () ->                               -- object
    Ptr () ->
    Ptr () ->
    CInt ->
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_MenuPoppedUp :: MonadIO m => MenuPoppedUpCallback -> m (GClosure C_MenuPoppedUpCallback)
genClosure_MenuPoppedUp :: MenuPoppedUpCallback -> m (GClosure C_MenuPoppedUpCallback)
genClosure_MenuPoppedUp cb :: MenuPoppedUpCallback
cb = IO (GClosure C_MenuPoppedUpCallback)
-> m (GClosure C_MenuPoppedUpCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_MenuPoppedUpCallback)
 -> m (GClosure C_MenuPoppedUpCallback))
-> IO (GClosure C_MenuPoppedUpCallback)
-> m (GClosure C_MenuPoppedUpCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MenuPoppedUpCallback
cb' = MenuPoppedUpCallback -> C_MenuPoppedUpCallback
wrap_MenuPoppedUpCallback MenuPoppedUpCallback
cb
    C_MenuPoppedUpCallback -> IO (FunPtr C_MenuPoppedUpCallback)
mk_MenuPoppedUpCallback C_MenuPoppedUpCallback
cb' IO (FunPtr C_MenuPoppedUpCallback)
-> (FunPtr C_MenuPoppedUpCallback
    -> IO (GClosure C_MenuPoppedUpCallback))
-> IO (GClosure C_MenuPoppedUpCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_MenuPoppedUpCallback
-> IO (GClosure C_MenuPoppedUpCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `MenuPoppedUpCallback` into a `C_MenuPoppedUpCallback`.
wrap_MenuPoppedUpCallback ::
    MenuPoppedUpCallback ->
    C_MenuPoppedUpCallback
wrap_MenuPoppedUpCallback :: MenuPoppedUpCallback -> C_MenuPoppedUpCallback
wrap_MenuPoppedUpCallback _cb :: MenuPoppedUpCallback
_cb _ flippedRect :: Ptr ()
flippedRect finalRect :: Ptr ()
finalRect flippedX :: CInt
flippedX flippedY :: CInt
flippedY _ = do
    let flippedX' :: Bool
flippedX' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
flippedX
    let flippedY' :: Bool
flippedY' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
flippedY
    MenuPoppedUpCallback
_cb  Ptr ()
flippedRect Ptr ()
finalRect Bool
flippedX' Bool
flippedY'


-- | Connect a signal handler for the [poppedUp](#signal:poppedUp) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' menu #poppedUp callback
-- @
-- 
-- 
onMenuPoppedUp :: (IsMenu a, MonadIO m) => a -> MenuPoppedUpCallback -> m SignalHandlerId
onMenuPoppedUp :: a -> MenuPoppedUpCallback -> m SignalHandlerId
onMenuPoppedUp obj :: a
obj cb :: MenuPoppedUpCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MenuPoppedUpCallback
cb' = MenuPoppedUpCallback -> C_MenuPoppedUpCallback
wrap_MenuPoppedUpCallback MenuPoppedUpCallback
cb
    FunPtr C_MenuPoppedUpCallback
cb'' <- C_MenuPoppedUpCallback -> IO (FunPtr C_MenuPoppedUpCallback)
mk_MenuPoppedUpCallback C_MenuPoppedUpCallback
cb'
    a
-> Text
-> FunPtr C_MenuPoppedUpCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "popped-up" FunPtr C_MenuPoppedUpCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [poppedUp](#signal:poppedUp) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' menu #poppedUp callback
-- @
-- 
-- 
afterMenuPoppedUp :: (IsMenu a, MonadIO m) => a -> MenuPoppedUpCallback -> m SignalHandlerId
afterMenuPoppedUp :: a -> MenuPoppedUpCallback -> m SignalHandlerId
afterMenuPoppedUp obj :: a
obj cb :: MenuPoppedUpCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MenuPoppedUpCallback
cb' = MenuPoppedUpCallback -> C_MenuPoppedUpCallback
wrap_MenuPoppedUpCallback MenuPoppedUpCallback
cb
    FunPtr C_MenuPoppedUpCallback
cb'' <- C_MenuPoppedUpCallback -> IO (FunPtr C_MenuPoppedUpCallback)
mk_MenuPoppedUpCallback C_MenuPoppedUpCallback
cb'
    a
-> Text
-> FunPtr C_MenuPoppedUpCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "popped-up" FunPtr C_MenuPoppedUpCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MenuPoppedUpSignalInfo
instance SignalInfo MenuPoppedUpSignalInfo where
    type HaskellCallbackType MenuPoppedUpSignalInfo = MenuPoppedUpCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MenuPoppedUpCallback cb
        cb'' <- mk_MenuPoppedUpCallback cb'
        connectSignalFunPtr obj "popped-up" cb'' connectMode detail

#endif

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

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

-- | Set the value of the “@accel-group@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menu [ #accelGroup 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuAccelGroup :: (MonadIO m, IsMenu o, Gtk.AccelGroup.IsAccelGroup a) => o -> a -> m ()
setMenuAccelGroup :: o -> a -> m ()
setMenuAccelGroup 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 "accel-group" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@accel-group@” 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' #accelGroup
-- @
clearMenuAccelGroup :: (MonadIO m, IsMenu o) => o -> m ()
clearMenuAccelGroup :: o -> m ()
clearMenuAccelGroup 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 AccelGroup -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "accel-group" (Maybe AccelGroup
forall a. Maybe a
Nothing :: Maybe Gtk.AccelGroup.AccelGroup)

#if defined(ENABLE_OVERLOADING)
data MenuAccelGroupPropertyInfo
instance AttrInfo MenuAccelGroupPropertyInfo where
    type AttrAllowedOps MenuAccelGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MenuAccelGroupPropertyInfo = IsMenu
    type AttrSetTypeConstraint MenuAccelGroupPropertyInfo = Gtk.AccelGroup.IsAccelGroup
    type AttrTransferTypeConstraint MenuAccelGroupPropertyInfo = Gtk.AccelGroup.IsAccelGroup
    type AttrTransferType MenuAccelGroupPropertyInfo = Gtk.AccelGroup.AccelGroup
    type AttrGetType MenuAccelGroupPropertyInfo = Gtk.AccelGroup.AccelGroup
    type AttrLabel MenuAccelGroupPropertyInfo = "accel-group"
    type AttrOrigin MenuAccelGroupPropertyInfo = Menu
    attrGet = getMenuAccelGroup
    attrSet = setMenuAccelGroup
    attrTransfer _ v = do
        unsafeCastTo Gtk.AccelGroup.AccelGroup v
    attrConstruct = constructMenuAccelGroup
    attrClear = clearMenuAccelGroup
#endif

-- VVV Prop "accel-path"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just True)

-- | Get the value of the “@accel-path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' menu #accelPath
-- @
getMenuAccelPath :: (MonadIO m, IsMenu o) => o -> m T.Text
getMenuAccelPath :: o -> m Text
getMenuAccelPath obj :: o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getMenuAccelPath" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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 "accel-path"

-- | Set the value of the “@accel-path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menu [ #accelPath 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuAccelPath :: (MonadIO m, IsMenu o) => o -> T.Text -> m ()
setMenuAccelPath :: o -> Text -> m ()
setMenuAccelPath obj :: o
obj val :: 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 "accel-path" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@accel-path@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuAccelPath :: (IsMenu o) => T.Text -> IO (GValueConstruct o)
constructMenuAccelPath :: Text -> IO (GValueConstruct o)
constructMenuAccelPath val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "accel-path" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data MenuAccelPathPropertyInfo
instance AttrInfo MenuAccelPathPropertyInfo where
    type AttrAllowedOps MenuAccelPathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MenuAccelPathPropertyInfo = IsMenu
    type AttrSetTypeConstraint MenuAccelPathPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint MenuAccelPathPropertyInfo = (~) T.Text
    type AttrTransferType MenuAccelPathPropertyInfo = T.Text
    type AttrGetType MenuAccelPathPropertyInfo = T.Text
    type AttrLabel MenuAccelPathPropertyInfo = "accel-path"
    type AttrOrigin MenuAccelPathPropertyInfo = Menu
    attrGet = getMenuAccelPath
    attrSet = setMenuAccelPath
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuAccelPath
    attrClear = clearMenuAccelPath
#endif

-- VVV Prop "active"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@active@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menu [ #active 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuActive :: (MonadIO m, IsMenu o) => o -> Int32 -> m ()
setMenuActive :: o -> Int32 -> m ()
setMenuActive obj :: o
obj val :: Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj "active" Int32
val

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

#if defined(ENABLE_OVERLOADING)
data MenuActivePropertyInfo
instance AttrInfo MenuActivePropertyInfo where
    type AttrAllowedOps MenuActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MenuActivePropertyInfo = IsMenu
    type AttrSetTypeConstraint MenuActivePropertyInfo = (~) Int32
    type AttrTransferTypeConstraint MenuActivePropertyInfo = (~) Int32
    type AttrTransferType MenuActivePropertyInfo = Int32
    type AttrGetType MenuActivePropertyInfo = Int32
    type AttrLabel MenuActivePropertyInfo = "active"
    type AttrOrigin MenuActivePropertyInfo = Menu
    attrGet = getMenuActive
    attrSet = setMenuActive
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuActive
    attrClear = undefined
#endif

-- VVV Prop "anchor-hints"
   -- Type: TInterface (Name {namespace = "Gdk", name = "AnchorHints"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@anchor-hints@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' menu #anchorHints
-- @
getMenuAnchorHints :: (MonadIO m, IsMenu o) => o -> m [Gdk.Flags.AnchorHints]
getMenuAnchorHints :: o -> m [AnchorHints]
getMenuAnchorHints obj :: o
obj = IO [AnchorHints] -> m [AnchorHints]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AnchorHints] -> m [AnchorHints])
-> IO [AnchorHints] -> m [AnchorHints]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [AnchorHints]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj "anchor-hints"

-- | Set the value of the “@anchor-hints@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menu [ #anchorHints 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuAnchorHints :: (MonadIO m, IsMenu o) => o -> [Gdk.Flags.AnchorHints] -> m ()
setMenuAnchorHints :: o -> [AnchorHints] -> m ()
setMenuAnchorHints obj :: o
obj val :: [AnchorHints]
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 -> [AnchorHints] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj "anchor-hints" [AnchorHints]
val

-- | Construct a `GValueConstruct` with valid value for the “@anchor-hints@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuAnchorHints :: (IsMenu o) => [Gdk.Flags.AnchorHints] -> IO (GValueConstruct o)
constructMenuAnchorHints :: [AnchorHints] -> IO (GValueConstruct o)
constructMenuAnchorHints val :: [AnchorHints]
val = String -> [AnchorHints] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags "anchor-hints" [AnchorHints]
val

#if defined(ENABLE_OVERLOADING)
data MenuAnchorHintsPropertyInfo
instance AttrInfo MenuAnchorHintsPropertyInfo where
    type AttrAllowedOps MenuAnchorHintsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MenuAnchorHintsPropertyInfo = IsMenu
    type AttrSetTypeConstraint MenuAnchorHintsPropertyInfo = (~) [Gdk.Flags.AnchorHints]
    type AttrTransferTypeConstraint MenuAnchorHintsPropertyInfo = (~) [Gdk.Flags.AnchorHints]
    type AttrTransferType MenuAnchorHintsPropertyInfo = [Gdk.Flags.AnchorHints]
    type AttrGetType MenuAnchorHintsPropertyInfo = [Gdk.Flags.AnchorHints]
    type AttrLabel MenuAnchorHintsPropertyInfo = "anchor-hints"
    type AttrOrigin MenuAnchorHintsPropertyInfo = Menu
    attrGet = getMenuAnchorHints
    attrSet = setMenuAnchorHints
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuAnchorHints
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@attach-widget@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menu [ #attachWidget 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuAttachWidget :: (MonadIO m, IsMenu o, Gtk.Widget.IsWidget a) => o -> a -> m ()
setMenuAttachWidget :: o -> a -> m ()
setMenuAttachWidget 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 "attach-widget" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@attach-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' #attachWidget
-- @
clearMenuAttachWidget :: (MonadIO m, IsMenu o) => o -> m ()
clearMenuAttachWidget :: o -> m ()
clearMenuAttachWidget 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 Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "attach-widget" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data MenuAttachWidgetPropertyInfo
instance AttrInfo MenuAttachWidgetPropertyInfo where
    type AttrAllowedOps MenuAttachWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MenuAttachWidgetPropertyInfo = IsMenu
    type AttrSetTypeConstraint MenuAttachWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint MenuAttachWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType MenuAttachWidgetPropertyInfo = Gtk.Widget.Widget
    type AttrGetType MenuAttachWidgetPropertyInfo = Gtk.Widget.Widget
    type AttrLabel MenuAttachWidgetPropertyInfo = "attach-widget"
    type AttrOrigin MenuAttachWidgetPropertyInfo = Menu
    attrGet = getMenuAttachWidget
    attrSet = setMenuAttachWidget
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructMenuAttachWidget
    attrClear = clearMenuAttachWidget
#endif

-- VVV Prop "menu-type-hint"
   -- Type: TInterface (Name {namespace = "Gdk", name = "SurfaceTypeHint"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@menu-type-hint@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menu [ #menuTypeHint 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuMenuTypeHint :: (MonadIO m, IsMenu o) => o -> Gdk.Enums.SurfaceTypeHint -> m ()
setMenuMenuTypeHint :: o -> SurfaceTypeHint -> m ()
setMenuMenuTypeHint obj :: o
obj val :: SurfaceTypeHint
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 -> SurfaceTypeHint -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj "menu-type-hint" SurfaceTypeHint
val

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

#if defined(ENABLE_OVERLOADING)
data MenuMenuTypeHintPropertyInfo
instance AttrInfo MenuMenuTypeHintPropertyInfo where
    type AttrAllowedOps MenuMenuTypeHintPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MenuMenuTypeHintPropertyInfo = IsMenu
    type AttrSetTypeConstraint MenuMenuTypeHintPropertyInfo = (~) Gdk.Enums.SurfaceTypeHint
    type AttrTransferTypeConstraint MenuMenuTypeHintPropertyInfo = (~) Gdk.Enums.SurfaceTypeHint
    type AttrTransferType MenuMenuTypeHintPropertyInfo = Gdk.Enums.SurfaceTypeHint
    type AttrGetType MenuMenuTypeHintPropertyInfo = Gdk.Enums.SurfaceTypeHint
    type AttrLabel MenuMenuTypeHintPropertyInfo = "menu-type-hint"
    type AttrOrigin MenuMenuTypeHintPropertyInfo = Menu
    attrGet = getMenuMenuTypeHint
    attrSet = setMenuMenuTypeHint
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuMenuTypeHint
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@monitor@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menu [ #monitor 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuMonitor :: (MonadIO m, IsMenu o) => o -> Int32 -> m ()
setMenuMonitor :: o -> Int32 -> m ()
setMenuMonitor obj :: o
obj val :: Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj "monitor" Int32
val

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

#if defined(ENABLE_OVERLOADING)
data MenuMonitorPropertyInfo
instance AttrInfo MenuMonitorPropertyInfo where
    type AttrAllowedOps MenuMonitorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MenuMonitorPropertyInfo = IsMenu
    type AttrSetTypeConstraint MenuMonitorPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint MenuMonitorPropertyInfo = (~) Int32
    type AttrTransferType MenuMonitorPropertyInfo = Int32
    type AttrGetType MenuMonitorPropertyInfo = Int32
    type AttrLabel MenuMonitorPropertyInfo = "monitor"
    type AttrOrigin MenuMonitorPropertyInfo = Menu
    attrGet = getMenuMonitor
    attrSet = setMenuMonitor
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuMonitor
    attrClear = undefined
#endif

-- VVV Prop "rect-anchor-dx"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@rect-anchor-dx@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menu [ #rectAnchorDx 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuRectAnchorDx :: (MonadIO m, IsMenu o) => o -> Int32 -> m ()
setMenuRectAnchorDx :: o -> Int32 -> m ()
setMenuRectAnchorDx obj :: o
obj val :: Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj "rect-anchor-dx" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@rect-anchor-dx@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuRectAnchorDx :: (IsMenu o) => Int32 -> IO (GValueConstruct o)
constructMenuRectAnchorDx :: Int32 -> IO (GValueConstruct o)
constructMenuRectAnchorDx val :: Int32
val = String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 "rect-anchor-dx" Int32
val

#if defined(ENABLE_OVERLOADING)
data MenuRectAnchorDxPropertyInfo
instance AttrInfo MenuRectAnchorDxPropertyInfo where
    type AttrAllowedOps MenuRectAnchorDxPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MenuRectAnchorDxPropertyInfo = IsMenu
    type AttrSetTypeConstraint MenuRectAnchorDxPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint MenuRectAnchorDxPropertyInfo = (~) Int32
    type AttrTransferType MenuRectAnchorDxPropertyInfo = Int32
    type AttrGetType MenuRectAnchorDxPropertyInfo = Int32
    type AttrLabel MenuRectAnchorDxPropertyInfo = "rect-anchor-dx"
    type AttrOrigin MenuRectAnchorDxPropertyInfo = Menu
    attrGet = getMenuRectAnchorDx
    attrSet = setMenuRectAnchorDx
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuRectAnchorDx
    attrClear = undefined
#endif

-- VVV Prop "rect-anchor-dy"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@rect-anchor-dy@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menu [ #rectAnchorDy 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuRectAnchorDy :: (MonadIO m, IsMenu o) => o -> Int32 -> m ()
setMenuRectAnchorDy :: o -> Int32 -> m ()
setMenuRectAnchorDy obj :: o
obj val :: Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj "rect-anchor-dy" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@rect-anchor-dy@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMenuRectAnchorDy :: (IsMenu o) => Int32 -> IO (GValueConstruct o)
constructMenuRectAnchorDy :: Int32 -> IO (GValueConstruct o)
constructMenuRectAnchorDy val :: Int32
val = String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 "rect-anchor-dy" Int32
val

#if defined(ENABLE_OVERLOADING)
data MenuRectAnchorDyPropertyInfo
instance AttrInfo MenuRectAnchorDyPropertyInfo where
    type AttrAllowedOps MenuRectAnchorDyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MenuRectAnchorDyPropertyInfo = IsMenu
    type AttrSetTypeConstraint MenuRectAnchorDyPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint MenuRectAnchorDyPropertyInfo = (~) Int32
    type AttrTransferType MenuRectAnchorDyPropertyInfo = Int32
    type AttrGetType MenuRectAnchorDyPropertyInfo = Int32
    type AttrLabel MenuRectAnchorDyPropertyInfo = "rect-anchor-dy"
    type AttrOrigin MenuRectAnchorDyPropertyInfo = Menu
    attrGet = getMenuRectAnchorDy
    attrSet = setMenuRectAnchorDy
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuRectAnchorDy
    attrClear = undefined
#endif

-- VVV Prop "reserve-toggle-size"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@reserve-toggle-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' menu #reserveToggleSize
-- @
getMenuReserveToggleSize :: (MonadIO m, IsMenu o) => o -> m Bool
getMenuReserveToggleSize :: o -> m Bool
getMenuReserveToggleSize 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 "reserve-toggle-size"

-- | Set the value of the “@reserve-toggle-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' menu [ #reserveToggleSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setMenuReserveToggleSize :: (MonadIO m, IsMenu o) => o -> Bool -> m ()
setMenuReserveToggleSize :: o -> Bool -> m ()
setMenuReserveToggleSize 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 "reserve-toggle-size" Bool
val

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

#if defined(ENABLE_OVERLOADING)
data MenuReserveToggleSizePropertyInfo
instance AttrInfo MenuReserveToggleSizePropertyInfo where
    type AttrAllowedOps MenuReserveToggleSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MenuReserveToggleSizePropertyInfo = IsMenu
    type AttrSetTypeConstraint MenuReserveToggleSizePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MenuReserveToggleSizePropertyInfo = (~) Bool
    type AttrTransferType MenuReserveToggleSizePropertyInfo = Bool
    type AttrGetType MenuReserveToggleSizePropertyInfo = Bool
    type AttrLabel MenuReserveToggleSizePropertyInfo = "reserve-toggle-size"
    type AttrOrigin MenuReserveToggleSizePropertyInfo = Menu
    attrGet = getMenuReserveToggleSize
    attrSet = setMenuReserveToggleSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructMenuReserveToggleSize
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Menu
type instance O.AttributeList Menu = MenuAttributeList
type MenuAttributeList = ('[ '("accelGroup", MenuAccelGroupPropertyInfo), '("accelPath", MenuAccelPathPropertyInfo), '("active", MenuActivePropertyInfo), '("anchorHints", MenuAnchorHintsPropertyInfo), '("attachWidget", MenuAttachWidgetPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("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), '("isFocus", Gtk.Widget.WidgetIsFocusPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("margin", Gtk.Widget.WidgetMarginPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("menuTypeHint", MenuMenuTypeHintPropertyInfo), '("monitor", MenuMonitorPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("rectAnchorDx", MenuRectAnchorDxPropertyInfo), '("rectAnchorDy", MenuRectAnchorDyPropertyInfo), '("reserveToggleSize", MenuReserveToggleSizePropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("surface", Gtk.Widget.WidgetSurfacePropertyInfo), '("takeFocus", Gtk.MenuShell.MenuShellTakeFocusPropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("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)
menuAccelGroup :: AttrLabelProxy "accelGroup"
menuAccelGroup = AttrLabelProxy

menuAccelPath :: AttrLabelProxy "accelPath"
menuAccelPath = AttrLabelProxy

menuActive :: AttrLabelProxy "active"
menuActive = AttrLabelProxy

menuAnchorHints :: AttrLabelProxy "anchorHints"
menuAnchorHints = AttrLabelProxy

menuAttachWidget :: AttrLabelProxy "attachWidget"
menuAttachWidget = AttrLabelProxy

menuMenuTypeHint :: AttrLabelProxy "menuTypeHint"
menuMenuTypeHint = AttrLabelProxy

menuMonitor :: AttrLabelProxy "monitor"
menuMonitor = AttrLabelProxy

menuRectAnchorDx :: AttrLabelProxy "rectAnchorDx"
menuRectAnchorDx = AttrLabelProxy

menuRectAnchorDy :: AttrLabelProxy "rectAnchorDy"
menuRectAnchorDy = AttrLabelProxy

menuReserveToggleSize :: AttrLabelProxy "reserveToggleSize"
menuReserveToggleSize = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Menu = MenuSignalList
type MenuSignalList = ('[ '("accelClosuresChanged", Gtk.Widget.WidgetAccelClosuresChangedSignalInfo), '("activateCurrent", Gtk.MenuShell.MenuShellActivateCurrentSignalInfo), '("add", Gtk.Container.ContainerAddSignalInfo), '("canActivateAccel", Gtk.Widget.WidgetCanActivateAccelSignalInfo), '("cancel", Gtk.MenuShell.MenuShellCancelSignalInfo), '("cycleFocus", Gtk.MenuShell.MenuShellCycleFocusSignalInfo), '("deactivate", Gtk.MenuShell.MenuShellDeactivateSignalInfo), '("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), '("insert", Gtk.MenuShell.MenuShellInsertSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveCurrent", Gtk.MenuShell.MenuShellMoveCurrentSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("moveScroll", MenuMoveScrollSignalInfo), '("moveSelected", Gtk.MenuShell.MenuShellMoveSelectedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("poppedUp", MenuPoppedUpSignalInfo), '("popupMenu", Gtk.Widget.WidgetPopupMenuSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("remove", Gtk.Container.ContainerRemoveSignalInfo), '("selectionDone", Gtk.MenuShell.MenuShellSelectionDoneSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("sizeAllocate", Gtk.Widget.WidgetSizeAllocateSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("styleUpdated", Gtk.Widget.WidgetStyleUpdatedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

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

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

-- | Creates a new t'GI.Gtk.Objects.Menu.Menu'
menuNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Menu
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Menu.Menu'
menuNew :: m Menu
menuNew  = IO Menu -> m Menu
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Menu -> m Menu) -> IO Menu -> m Menu
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menu
result <- IO (Ptr Menu)
gtk_menu_new
    Text -> Ptr Menu -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "menuNew" Ptr Menu
result
    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
Menu) Ptr Menu
result
    Menu -> IO Menu
forall (m :: * -> *) a. Monad m => a -> m a
return Menu
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Menu::new_from_model
-- 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Menu" })
-- throws : False
-- Skip return : False

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

-- | Creates a t'GI.Gtk.Objects.Menu.Menu' and populates it with menu items and
-- submenus according to /@model@/.
-- 
-- The created menu items are connected to actions found in the
-- t'GI.Gtk.Objects.ApplicationWindow.ApplicationWindow' to which the menu belongs - typically
-- by means of being attached to a widget (see 'GI.Gtk.Objects.Menu.menuAttachToWidget')
-- that is contained within the @/GtkApplicationWindows/@ widget hierarchy.
-- 
-- Actions can also be added using 'GI.Gtk.Objects.Widget.widgetInsertActionGroup' on the menu\'s
-- attach widget or on any of its parent widgets.
menuNewFromModel ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.MenuModel.IsMenuModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gio.Objects.MenuModel.MenuModel'
    -> m Menu
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Menu.Menu'
menuNewFromModel :: a -> m Menu
menuNewFromModel model :: a
model = IO Menu -> m Menu
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Menu -> m Menu) -> IO Menu -> m Menu
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
    Ptr Menu
result <- Ptr MenuModel -> IO (Ptr Menu)
gtk_menu_new_from_model Ptr MenuModel
model'
    Text -> Ptr Menu -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "menuNewFromModel" Ptr Menu
result
    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
Menu) Ptr Menu
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    Menu -> IO Menu
forall (m :: * -> *) a. Monad m => a -> m a
return Menu
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Menu::attach_to_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attach_widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GtkWidget that the menu will be attached to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detacher"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuDetachFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the user supplied callback function\n            that will be called when the menu calls gtk_menu_detach()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_menu_attach_to_widget" gtk_menu_attach_to_widget :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    Ptr Gtk.Widget.Widget ->                -- attach_widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    FunPtr Gtk.Callbacks.C_MenuDetachFunc -> -- detacher : TInterface (Name {namespace = "Gtk", name = "MenuDetachFunc"})
    IO ()

-- | Attaches the menu to the widget and provides a callback function
-- that will be invoked when the menu calls 'GI.Gtk.Objects.Menu.menuDetach' during
-- its destruction.
-- 
-- If the menu is attached to the widget then it will be destroyed
-- when the widget is destroyed, as if it was a child widget.
-- An attached menu will also move between screens correctly if the
-- widgets moves between screens.
menuAttachToWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> b
    -- ^ /@attachWidget@/: the t'GI.Gtk.Objects.Widget.Widget' that the menu will be attached to
    -> Maybe (Gtk.Callbacks.MenuDetachFunc)
    -- ^ /@detacher@/: the user supplied callback function
    --             that will be called when the menu calls 'GI.Gtk.Objects.Menu.menuDetach'
    -> m ()
menuAttachToWidget :: a -> b -> Maybe MenuDetachFunc -> m ()
menuAttachToWidget menu :: a
menu attachWidget :: b
attachWidget detacher :: Maybe MenuDetachFunc
detacher = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Widget
attachWidget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
attachWidget
    FunPtr C_MenuDetachFunc
maybeDetacher <- case Maybe MenuDetachFunc
detacher of
        Nothing -> FunPtr C_MenuDetachFunc -> IO (FunPtr C_MenuDetachFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_MenuDetachFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jDetacher :: MenuDetachFunc
jDetacher -> do
            Ptr (FunPtr C_MenuDetachFunc)
ptrdetacher <- IO (Ptr (FunPtr C_MenuDetachFunc))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gtk.Callbacks.C_MenuDetachFunc))
            FunPtr C_MenuDetachFunc
jDetacher' <- C_MenuDetachFunc -> IO (FunPtr C_MenuDetachFunc)
Gtk.Callbacks.mk_MenuDetachFunc (Maybe (Ptr (FunPtr C_MenuDetachFunc))
-> MenuDetachFunc -> C_MenuDetachFunc
Gtk.Callbacks.wrap_MenuDetachFunc (Ptr (FunPtr C_MenuDetachFunc)
-> Maybe (Ptr (FunPtr C_MenuDetachFunc))
forall a. a -> Maybe a
Just Ptr (FunPtr C_MenuDetachFunc)
ptrdetacher) MenuDetachFunc
jDetacher)
            Ptr (FunPtr C_MenuDetachFunc) -> FunPtr C_MenuDetachFunc -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_MenuDetachFunc)
ptrdetacher FunPtr C_MenuDetachFunc
jDetacher'
            FunPtr C_MenuDetachFunc -> IO (FunPtr C_MenuDetachFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_MenuDetachFunc
jDetacher'
    Ptr Menu -> Ptr Widget -> FunPtr C_MenuDetachFunc -> IO ()
gtk_menu_attach_to_widget Ptr Menu
menu' Ptr Widget
attachWidget' FunPtr C_MenuDetachFunc
maybeDetacher
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
attachWidget
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuAttachToWidgetMethodInfo
instance (signature ~ (b -> Maybe (Gtk.Callbacks.MenuDetachFunc) -> m ()), MonadIO m, IsMenu a, Gtk.Widget.IsWidget b) => O.MethodInfo MenuAttachToWidgetMethodInfo a signature where
    overloadedMethod = menuAttachToWidget

#endif

-- method Menu::detach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , 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_detach" gtk_menu_detach :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    IO ()

-- | Detaches the menu from the widget to which it had been attached.
-- This function will call the callback function, /@detacher@/, provided
-- when the 'GI.Gtk.Objects.Menu.menuAttachToWidget' function was called.
menuDetach ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> m ()
menuDetach :: a -> m ()
menuDetach menu :: a
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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Menu -> IO ()
gtk_menu_detach Ptr Menu
menu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuDetachMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMenu a) => O.MethodInfo MenuDetachMethodInfo a signature where
    overloadedMethod = menuDetach

#endif

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

foreign import ccall "gtk_menu_get_accel_group" gtk_menu_get_accel_group :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    IO (Ptr Gtk.AccelGroup.AccelGroup)

-- | Gets the t'GI.Gtk.Objects.AccelGroup.AccelGroup' which holds global accelerators for the
-- menu. See 'GI.Gtk.Objects.Menu.menuSetAccelGroup'.
menuGetAccelGroup ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> m Gtk.AccelGroup.AccelGroup
    -- ^ __Returns:__ the t'GI.Gtk.Objects.AccelGroup.AccelGroup' associated with the menu
menuGetAccelGroup :: a -> m AccelGroup
menuGetAccelGroup menu :: a
menu = IO AccelGroup -> m AccelGroup
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AccelGroup -> m AccelGroup) -> IO AccelGroup -> m AccelGroup
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr AccelGroup
result <- Ptr Menu -> IO (Ptr AccelGroup)
gtk_menu_get_accel_group Ptr Menu
menu'
    Text -> Ptr AccelGroup -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "menuGetAccelGroup" Ptr AccelGroup
result
    AccelGroup
result' <- ((ManagedPtr AccelGroup -> AccelGroup)
-> Ptr AccelGroup -> IO AccelGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AccelGroup -> AccelGroup
Gtk.AccelGroup.AccelGroup) Ptr AccelGroup
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    AccelGroup -> IO AccelGroup
forall (m :: * -> *) a. Monad m => a -> m a
return AccelGroup
result'

#if defined(ENABLE_OVERLOADING)
data MenuGetAccelGroupMethodInfo
instance (signature ~ (m Gtk.AccelGroup.AccelGroup), MonadIO m, IsMenu a) => O.MethodInfo MenuGetAccelGroupMethodInfo a signature where
    overloadedMethod = menuGetAccelGroup

#endif

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

foreign import ccall "gtk_menu_get_accel_path" gtk_menu_get_accel_path :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    IO CString

-- | Retrieves the accelerator path set on the menu.
menuGetAccelPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a valid t'GI.Gtk.Objects.Menu.Menu'
    -> m T.Text
    -- ^ __Returns:__ the accelerator path set on the menu.
menuGetAccelPath :: a -> m Text
menuGetAccelPath menu :: a
menu = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    CString
result <- Ptr Menu -> IO CString
gtk_menu_get_accel_path Ptr Menu
menu'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "menuGetAccelPath" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MenuGetAccelPathMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsMenu a) => O.MethodInfo MenuGetAccelPathMethodInfo a signature where
    overloadedMethod = menuGetAccelPath

#endif

-- method Menu::get_active
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , 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_get_active" gtk_menu_get_active :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    IO (Ptr Gtk.Widget.Widget)

-- | Returns the selected menu item from the menu.  This is used by the
-- t'GI.Gtk.Objects.ComboBox.ComboBox'.
menuGetActive ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ the t'GI.Gtk.Objects.MenuItem.MenuItem' that was last selected
    --          in the menu.  If a selection has not yet been made, the
    --          first menu item is selected.
menuGetActive :: a -> m Widget
menuGetActive menu :: a
menu = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Widget
result <- Ptr Menu -> IO (Ptr Widget)
gtk_menu_get_active Ptr Menu
menu'
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "menuGetActive" Ptr Widget
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
data MenuGetActiveMethodInfo
instance (signature ~ (m Gtk.Widget.Widget), MonadIO m, IsMenu a) => O.MethodInfo MenuGetActiveMethodInfo a signature where
    overloadedMethod = menuGetActive

#endif

-- method Menu::get_attach_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , 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_get_attach_widget" gtk_menu_get_attach_widget :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    IO (Ptr Gtk.Widget.Widget)

-- | Returns the t'GI.Gtk.Objects.Widget.Widget' that the menu is attached to.
menuGetAttachWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ the t'GI.Gtk.Objects.Widget.Widget' that the menu is attached to
menuGetAttachWidget :: a -> m Widget
menuGetAttachWidget menu :: a
menu = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Widget
result <- Ptr Menu -> IO (Ptr Widget)
gtk_menu_get_attach_widget Ptr Menu
menu'
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "menuGetAttachWidget" Ptr Widget
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
data MenuGetAttachWidgetMethodInfo
instance (signature ~ (m Gtk.Widget.Widget), MonadIO m, IsMenu a) => O.MethodInfo MenuGetAttachWidgetMethodInfo a signature where
    overloadedMethod = menuGetAttachWidget

#endif

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

foreign import ccall "gtk_menu_get_monitor" gtk_menu_get_monitor :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    IO Int32

-- | Retrieves the number of the monitor on which to show the menu.
menuGetMonitor ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> m Int32
    -- ^ __Returns:__ the number of the monitor on which the menu should
    --    be popped up or -1, if no monitor has been set
menuGetMonitor :: a -> m Int32
menuGetMonitor menu :: a
menu = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Int32
result <- Ptr Menu -> IO Int32
gtk_menu_get_monitor Ptr Menu
menu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MenuGetMonitorMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsMenu a) => O.MethodInfo MenuGetMonitorMethodInfo a signature where
    overloadedMethod = menuGetMonitor

#endif

-- method Menu::get_reserve_toggle_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , 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_get_reserve_toggle_size" gtk_menu_get_reserve_toggle_size :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    IO CInt

-- | Returns whether the menu reserves space for toggles and
-- icons, regardless of their actual presence.
menuGetReserveToggleSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> m Bool
    -- ^ __Returns:__ Whether the menu reserves toggle space
menuGetReserveToggleSize :: a -> m Bool
menuGetReserveToggleSize menu :: a
menu = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    CInt
result <- Ptr Menu -> IO CInt
gtk_menu_get_reserve_toggle_size Ptr Menu
menu'
    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
menu
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MenuGetReserveToggleSizeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMenu a) => O.MethodInfo MenuGetReserveToggleSizeMethodInfo a signature where
    overloadedMethod = menuGetReserveToggleSize

#endif

-- method Menu::place_on_monitor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the monitor to place the menu on"
--                 , 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_place_on_monitor" gtk_menu_place_on_monitor :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    Ptr Gdk.Monitor.Monitor ->              -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    IO ()

-- | Places /@menu@/ on the given monitor.
menuPlaceOnMonitor ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gdk.Monitor.IsMonitor b) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> b
    -- ^ /@monitor@/: the monitor to place the menu on
    -> m ()
menuPlaceOnMonitor :: a -> b -> m ()
menuPlaceOnMonitor menu :: a
menu monitor :: b
monitor = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Monitor
monitor' <- b -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
monitor
    Ptr Menu -> Ptr Monitor -> IO ()
gtk_menu_place_on_monitor Ptr Menu
menu' Ptr Monitor
monitor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
monitor
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuPlaceOnMonitorMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMenu a, Gdk.Monitor.IsMonitor b) => O.MethodInfo MenuPlaceOnMonitorMethodInfo a signature where
    overloadedMethod = menuPlaceOnMonitor

#endif

-- method Menu::popdown
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , 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_popdown" gtk_menu_popdown :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    IO ()

-- | Removes the menu from the screen.
menuPopdown ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> m ()
menuPopdown :: a -> m ()
menuPopdown menu :: a
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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Menu -> IO ()
gtk_menu_popdown Ptr Menu
menu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuPopdownMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMenu a) => O.MethodInfo MenuPopdownMethodInfo a signature where
    overloadedMethod = menuPopdown

#endif

-- method Menu::popup_at_pointer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkMenu to pop up"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "trigger_event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GdkEvent that initiated this request or\n                %NULL if it's the current event"
--                 , 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_popup_at_pointer" gtk_menu_popup_at_pointer :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    Ptr Gdk.Event.Event ->                  -- trigger_event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO ()

-- | Displays /@menu@/ and makes it available for selection.
-- 
-- See gtk_menu_popup_at_widget () to pop up a menu at a widget.
-- gtk_menu_popup_at_rect () also allows you to position a menu at an arbitrary
-- rectangle.
-- 
-- /@menu@/ will be positioned at the pointer associated with /@triggerEvent@/.
-- 
-- Properties that influence the behaviour of this function are
-- t'GI.Gtk.Objects.Menu.Menu':@/anchor-hints/@, t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dx/@, t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dy/@, and
-- t'GI.Gtk.Objects.Menu.Menu':@/menu-type-hint/@. Connect to the [poppedUp]("GI.Gtk.Objects.Menu#signal:poppedUp") signal to find
-- out how it was actually positioned.
menuPopupAtPointer ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gdk.Event.IsEvent b) =>
    a
    -- ^ /@menu@/: the t'GI.Gtk.Objects.Menu.Menu' to pop up
    -> Maybe (b)
    -- ^ /@triggerEvent@/: the @/GdkEvent/@ that initiated this request or
    --                 'P.Nothing' if it\'s the current event
    -> m ()
menuPopupAtPointer :: a -> Maybe b -> m ()
menuPopupAtPointer menu :: a
menu triggerEvent :: Maybe b
triggerEvent = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Event
maybeTriggerEvent <- case Maybe b
triggerEvent of
        Nothing -> Ptr Event -> IO (Ptr Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Event
forall a. Ptr a
nullPtr
        Just jTriggerEvent :: b
jTriggerEvent -> do
            Ptr Event
jTriggerEvent' <- b -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jTriggerEvent
            Ptr Event -> IO (Ptr Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Event
jTriggerEvent'
    Ptr Menu -> Ptr Event -> IO ()
gtk_menu_popup_at_pointer Ptr Menu
menu' Ptr Event
maybeTriggerEvent
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
triggerEvent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuPopupAtPointerMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsMenu a, Gdk.Event.IsEvent b) => O.MethodInfo MenuPopupAtPointerMethodInfo a signature where
    overloadedMethod = menuPopupAtPointer

#endif

-- method Menu::popup_at_rect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkMenu to pop up"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect_surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkSurface @rect is relative to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkRectangle to align @menu with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect_anchor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Gravity" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the point on @rect to align with @menu's anchor point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu_anchor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Gravity" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the point on @menu to align with @rect's anchor point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "trigger_event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GdkEvent that initiated this request or\n                %NULL if it's the current event"
--                 , 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_popup_at_rect" gtk_menu_popup_at_rect :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    Ptr Gdk.Surface.Surface ->              -- rect_surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr Gdk.Rectangle.Rectangle ->          -- rect : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    CUInt ->                                -- rect_anchor : TInterface (Name {namespace = "Gdk", name = "Gravity"})
    CUInt ->                                -- menu_anchor : TInterface (Name {namespace = "Gdk", name = "Gravity"})
    Ptr Gdk.Event.Event ->                  -- trigger_event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO ()

-- | Displays /@menu@/ and makes it available for selection.
-- 
-- See gtk_menu_popup_at_widget () and gtk_menu_popup_at_pointer (), which
-- handle more common cases for popping up menus.
-- 
-- /@menu@/ will be positioned at /@rect@/, aligning their anchor points. /@rect@/ is
-- relative to the top-left corner of /@rectSurface@/. /@rectAnchor@/ and
-- /@menuAnchor@/ determine anchor points on /@rect@/ and /@menu@/ to pin together.
-- /@menu@/ can optionally be offset by t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dx/@ and
-- t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dy/@.
-- 
-- Anchors should be specified under the assumption that the text direction is
-- left-to-right; they will be flipped horizontally automatically if the text
-- direction is right-to-left.
-- 
-- Other properties that influence the behaviour of this function are
-- t'GI.Gtk.Objects.Menu.Menu':@/anchor-hints/@ and t'GI.Gtk.Objects.Menu.Menu':@/menu-type-hint/@. Connect to the
-- [poppedUp]("GI.Gtk.Objects.Menu#signal:poppedUp") signal to find out how it was actually positioned.
menuPopupAtRect ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gdk.Surface.IsSurface b, Gdk.Event.IsEvent c) =>
    a
    -- ^ /@menu@/: the t'GI.Gtk.Objects.Menu.Menu' to pop up
    -> b
    -- ^ /@rectSurface@/: the t'GI.Gdk.Objects.Surface.Surface' /@rect@/ is relative to
    -> Gdk.Rectangle.Rectangle
    -- ^ /@rect@/: the t'GI.Gdk.Structs.Rectangle.Rectangle' to align /@menu@/ with
    -> Gdk.Enums.Gravity
    -- ^ /@rectAnchor@/: the point on /@rect@/ to align with /@menu@/\'s anchor point
    -> Gdk.Enums.Gravity
    -- ^ /@menuAnchor@/: the point on /@menu@/ to align with /@rect@/\'s anchor point
    -> Maybe (c)
    -- ^ /@triggerEvent@/: the @/GdkEvent/@ that initiated this request or
    --                 'P.Nothing' if it\'s the current event
    -> m ()
menuPopupAtRect :: a -> b -> Rectangle -> Gravity -> Gravity -> Maybe c -> m ()
menuPopupAtRect menu :: a
menu rectSurface :: b
rectSurface rect :: Rectangle
rect rectAnchor :: Gravity
rectAnchor menuAnchor :: Gravity
menuAnchor triggerEvent :: Maybe c
triggerEvent = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Surface
rectSurface' <- b -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
rectSurface
    Ptr Rectangle
rect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
rect
    let rectAnchor' :: CUInt
rectAnchor' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Gravity -> Int) -> Gravity -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
rectAnchor
    let menuAnchor' :: CUInt
menuAnchor' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Gravity -> Int) -> Gravity -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
menuAnchor
    Ptr Event
maybeTriggerEvent <- case Maybe c
triggerEvent of
        Nothing -> Ptr Event -> IO (Ptr Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Event
forall a. Ptr a
nullPtr
        Just jTriggerEvent :: c
jTriggerEvent -> do
            Ptr Event
jTriggerEvent' <- c -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jTriggerEvent
            Ptr Event -> IO (Ptr Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Event
jTriggerEvent'
    Ptr Menu
-> Ptr Surface
-> Ptr Rectangle
-> CUInt
-> CUInt
-> Ptr Event
-> IO ()
gtk_menu_popup_at_rect Ptr Menu
menu' Ptr Surface
rectSurface' Ptr Rectangle
rect' CUInt
rectAnchor' CUInt
menuAnchor' Ptr Event
maybeTriggerEvent
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
rectSurface
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
rect
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
triggerEvent c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuPopupAtRectMethodInfo
instance (signature ~ (b -> Gdk.Rectangle.Rectangle -> Gdk.Enums.Gravity -> Gdk.Enums.Gravity -> Maybe (c) -> m ()), MonadIO m, IsMenu a, Gdk.Surface.IsSurface b, Gdk.Event.IsEvent c) => O.MethodInfo MenuPopupAtRectMethodInfo a signature where
    overloadedMethod = menuPopupAtRect

#endif

-- method Menu::popup_at_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkMenu to pop up"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkWidget to align @menu with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget_anchor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Gravity" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the point on @widget to align with @menu's anchor point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu_anchor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Gravity" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the point on @menu to align with @widget's anchor point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "trigger_event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GdkEvent that initiated this request or\n                %NULL if it's the current event"
--                 , 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_popup_at_widget" gtk_menu_popup_at_widget :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    CUInt ->                                -- widget_anchor : TInterface (Name {namespace = "Gdk", name = "Gravity"})
    CUInt ->                                -- menu_anchor : TInterface (Name {namespace = "Gdk", name = "Gravity"})
    Ptr Gdk.Event.Event ->                  -- trigger_event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO ()

-- | Displays /@menu@/ and makes it available for selection.
-- 
-- See gtk_menu_popup_at_pointer () to pop up a menu at the master pointer.
-- gtk_menu_popup_at_rect () also allows you to position a menu at an arbitrary
-- rectangle.
-- 
-- <<https://developer.gnome.org/gtk4/stable/popup-anchors.png>>
-- 
-- /@menu@/ will be positioned at /@widget@/, aligning their anchor points.
-- /@widgetAnchor@/ and /@menuAnchor@/ determine anchor points on /@widget@/ and /@menu@/
-- to pin together. /@menu@/ can optionally be offset by t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dx/@
-- and t'GI.Gtk.Objects.Menu.Menu':@/rect-anchor-dy/@.
-- 
-- Anchors should be specified under the assumption that the text direction is
-- left-to-right; they will be flipped horizontally automatically if the text
-- direction is right-to-left.
-- 
-- Other properties that influence the behaviour of this function are
-- t'GI.Gtk.Objects.Menu.Menu':@/anchor-hints/@ and t'GI.Gtk.Objects.Menu.Menu':@/menu-type-hint/@. Connect to the
-- [poppedUp]("GI.Gtk.Objects.Menu#signal:poppedUp") signal to find out how it was actually positioned.
menuPopupAtWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gtk.Widget.IsWidget b, Gdk.Event.IsEvent c) =>
    a
    -- ^ /@menu@/: the t'GI.Gtk.Objects.Menu.Menu' to pop up
    -> b
    -- ^ /@widget@/: the t'GI.Gtk.Objects.Widget.Widget' to align /@menu@/ with
    -> Gdk.Enums.Gravity
    -- ^ /@widgetAnchor@/: the point on /@widget@/ to align with /@menu@/\'s anchor point
    -> Gdk.Enums.Gravity
    -- ^ /@menuAnchor@/: the point on /@menu@/ to align with /@widget@/\'s anchor point
    -> Maybe (c)
    -- ^ /@triggerEvent@/: the @/GdkEvent/@ that initiated this request or
    --                 'P.Nothing' if it\'s the current event
    -> m ()
menuPopupAtWidget :: a -> b -> Gravity -> Gravity -> Maybe c -> m ()
menuPopupAtWidget menu :: a
menu widget :: b
widget widgetAnchor :: Gravity
widgetAnchor menuAnchor :: Gravity
menuAnchor triggerEvent :: Maybe c
triggerEvent = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    let widgetAnchor' :: CUInt
widgetAnchor' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Gravity -> Int) -> Gravity -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
widgetAnchor
    let menuAnchor' :: CUInt
menuAnchor' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Gravity -> Int) -> Gravity -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
menuAnchor
    Ptr Event
maybeTriggerEvent <- case Maybe c
triggerEvent of
        Nothing -> Ptr Event -> IO (Ptr Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Event
forall a. Ptr a
nullPtr
        Just jTriggerEvent :: c
jTriggerEvent -> do
            Ptr Event
jTriggerEvent' <- c -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jTriggerEvent
            Ptr Event -> IO (Ptr Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Event
jTriggerEvent'
    Ptr Menu -> Ptr Widget -> CUInt -> CUInt -> Ptr Event -> IO ()
gtk_menu_popup_at_widget Ptr Menu
menu' Ptr Widget
widget' CUInt
widgetAnchor' CUInt
menuAnchor' Ptr Event
maybeTriggerEvent
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
triggerEvent c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuPopupAtWidgetMethodInfo
instance (signature ~ (b -> Gdk.Enums.Gravity -> Gdk.Enums.Gravity -> Maybe (c) -> m ()), MonadIO m, IsMenu a, Gtk.Widget.IsWidget b, Gdk.Event.IsEvent c) => O.MethodInfo MenuPopupAtWidgetMethodInfo a signature where
    overloadedMethod = menuPopupAtWidget

#endif

-- method Menu::reorder_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkMenuItem to move"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the new position to place @child.\n    Positions are numbered from 0 to n - 1"
--                 , 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_reorder_child" gtk_menu_reorder_child :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    Int32 ->                                -- position : TBasicType TInt
    IO ()

-- | Moves /@child@/ to a new /@position@/ in the list of /@menu@/
-- children.
menuReorderChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> b
    -- ^ /@child@/: the t'GI.Gtk.Objects.MenuItem.MenuItem' to move
    -> Int32
    -- ^ /@position@/: the new position to place /@child@/.
    --     Positions are numbered from 0 to n - 1
    -> m ()
menuReorderChild :: a -> b -> Int32 -> m ()
menuReorderChild menu :: a
menu child :: b
child position :: Int32
position = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr Menu -> Ptr Widget -> Int32 -> IO ()
gtk_menu_reorder_child Ptr Menu
menu' Ptr Widget
child' Int32
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuReorderChildMethodInfo
instance (signature ~ (b -> Int32 -> m ()), MonadIO m, IsMenu a, Gtk.Widget.IsWidget b) => O.MethodInfo MenuReorderChildMethodInfo a signature where
    overloadedMethod = menuReorderChild

#endif

-- method Menu::reposition
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , 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_reposition" gtk_menu_reposition :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    IO ()

-- | Repositions the menu according to its position function.
menuReposition ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> m ()
menuReposition :: a -> m ()
menuReposition menu :: a
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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Menu -> IO ()
gtk_menu_reposition Ptr Menu
menu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuRepositionMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMenu a) => O.MethodInfo MenuRepositionMethodInfo a signature where
    overloadedMethod = menuReposition

#endif

-- method Menu::set_accel_group
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accel_group"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelGroup" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GtkAccelGroup to be associated\n              with the menu."
--                 , 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_set_accel_group" gtk_menu_set_accel_group :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    Ptr Gtk.AccelGroup.AccelGroup ->        -- accel_group : TInterface (Name {namespace = "Gtk", name = "AccelGroup"})
    IO ()

-- | Set the t'GI.Gtk.Objects.AccelGroup.AccelGroup' which holds global accelerators for the
-- menu.  This accelerator group needs to also be added to all windows
-- that this menu is being used in with 'GI.Gtk.Objects.Window.windowAddAccelGroup',
-- in order for those windows to support all the accelerators
-- contained in this group.
menuSetAccelGroup ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gtk.AccelGroup.IsAccelGroup b) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> Maybe (b)
    -- ^ /@accelGroup@/: the t'GI.Gtk.Objects.AccelGroup.AccelGroup' to be associated
    --               with the menu.
    -> m ()
menuSetAccelGroup :: a -> Maybe b -> m ()
menuSetAccelGroup menu :: a
menu accelGroup :: Maybe b
accelGroup = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr AccelGroup
maybeAccelGroup <- case Maybe b
accelGroup of
        Nothing -> Ptr AccelGroup -> IO (Ptr AccelGroup)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AccelGroup
forall a. Ptr a
nullPtr
        Just jAccelGroup :: b
jAccelGroup -> do
            Ptr AccelGroup
jAccelGroup' <- b -> IO (Ptr AccelGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jAccelGroup
            Ptr AccelGroup -> IO (Ptr AccelGroup)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AccelGroup
jAccelGroup'
    Ptr Menu -> Ptr AccelGroup -> IO ()
gtk_menu_set_accel_group Ptr Menu
menu' Ptr AccelGroup
maybeAccelGroup
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
accelGroup b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuSetAccelGroupMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsMenu a, Gtk.AccelGroup.IsAccelGroup b) => O.MethodInfo MenuSetAccelGroupMethodInfo a signature where
    overloadedMethod = menuSetAccelGroup

#endif

-- method Menu::set_accel_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a valid #GtkMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accel_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a valid accelerator path, or %NULL to unset the path"
--                 , 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_set_accel_path" gtk_menu_set_accel_path :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    CString ->                              -- accel_path : TBasicType TUTF8
    IO ()

-- | Sets an accelerator path for this menu from which accelerator paths
-- for its immediate children, its menu items, can be constructed.
-- The main purpose of this function is to spare the programmer the
-- inconvenience of having to call 'GI.Gtk.Objects.MenuItem.menuItemSetAccelPath' on
-- each menu item that should support runtime user changable accelerators.
-- Instead, by just calling 'GI.Gtk.Objects.Menu.menuSetAccelPath' on their parent,
-- each menu item of this menu, that contains a label describing its
-- purpose, automatically gets an accel path assigned.
-- 
-- For example, a menu containing menu items “New” and “Exit”, will, after
-- @gtk_menu_set_accel_path (menu, \"\<Gnumeric-Sheet>\/File\");@ has been
-- called, assign its items the accel paths: @\"\<Gnumeric-Sheet>\/File\/New\"@
-- and @\"\<Gnumeric-Sheet>\/File\/Exit\"@.
-- 
-- Assigning accel paths to menu items then enables the user to change
-- their accelerators at runtime. More details about accelerator paths
-- and their default setups can be found at 'GI.Gtk.Objects.AccelMap.accelMapAddEntry'.
-- 
-- Note that /@accelPath@/ string will be stored in a @/GQuark/@. Therefore,
-- if you pass a static string, you can save some memory by interning
-- it first with 'GI.GLib.Functions.internStaticString'.
menuSetAccelPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a valid t'GI.Gtk.Objects.Menu.Menu'
    -> Maybe (T.Text)
    -- ^ /@accelPath@/: a valid accelerator path, or 'P.Nothing' to unset the path
    -> m ()
menuSetAccelPath :: a -> Maybe Text -> m ()
menuSetAccelPath menu :: a
menu accelPath :: Maybe Text
accelPath = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    CString
maybeAccelPath <- case Maybe Text
accelPath of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jAccelPath :: Text
jAccelPath -> do
            CString
jAccelPath' <- Text -> IO CString
textToCString Text
jAccelPath
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jAccelPath'
    Ptr Menu -> CString -> IO ()
gtk_menu_set_accel_path Ptr Menu
menu' CString
maybeAccelPath
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeAccelPath
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuSetAccelPathMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsMenu a) => O.MethodInfo MenuSetAccelPathMethodInfo a signature where
    overloadedMethod = menuSetAccelPath

#endif

-- method Menu::set_active
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the index of the menu item to select.  Index values are\n        from 0 to n-1"
--                 , 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_set_active" gtk_menu_set_active :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    Word32 ->                               -- index : TBasicType TUInt
    IO ()

-- | Selects the specified menu item within the menu.  This is used by
-- the t'GI.Gtk.Objects.ComboBox.ComboBox' and should not be used by anyone else.
menuSetActive ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> Word32
    -- ^ /@index@/: the index of the menu item to select.  Index values are
    --         from 0 to n-1
    -> m ()
menuSetActive :: a -> Word32 -> m ()
menuSetActive menu :: a
menu index :: Word32
index = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Menu -> Word32 -> IO ()
gtk_menu_set_active Ptr Menu
menu' Word32
index
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuSetActiveMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsMenu a) => O.MethodInfo MenuSetActiveMethodInfo a signature where
    overloadedMethod = menuSetActive

#endif

-- method Menu::set_monitor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "monitor_num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the number of the monitor on which the menu should\n   be popped up"
--                 , 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_set_monitor" gtk_menu_set_monitor :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    Int32 ->                                -- monitor_num : TBasicType TInt
    IO ()

-- | Informs GTK+ on which monitor a menu should be popped up.
-- See 'GI.Gdk.Objects.Monitor.monitorGetGeometry'.
-- 
-- This function should be called from a @/GtkMenuPositionFunc/@
-- if the menu should not appear on the same monitor as the pointer.
-- This information can’t be reliably inferred from the coordinates
-- returned by a @/GtkMenuPositionFunc/@, since, for very long menus,
-- these coordinates may extend beyond the monitor boundaries or even
-- the screen boundaries.
menuSetMonitor ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> Int32
    -- ^ /@monitorNum@/: the number of the monitor on which the menu should
    --    be popped up
    -> m ()
menuSetMonitor :: a -> Int32 -> m ()
menuSetMonitor menu :: a
menu monitorNum :: Int32
monitorNum = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Menu -> Int32 -> IO ()
gtk_menu_set_monitor Ptr Menu
menu' Int32
monitorNum
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuSetMonitorMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsMenu a) => O.MethodInfo MenuSetMonitorMethodInfo a signature where
    overloadedMethod = menuSetMonitor

#endif

-- method Menu::set_reserve_toggle_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reserve_toggle_size"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to reserve size for toggles"
--                 , 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_set_reserve_toggle_size" gtk_menu_set_reserve_toggle_size :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    CInt ->                                 -- reserve_toggle_size : TBasicType TBoolean
    IO ()

-- | Sets whether the menu should reserve space for drawing toggles
-- or icons, regardless of their actual presence.
menuSetReserveToggleSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gtk.Objects.Menu.Menu'
    -> Bool
    -- ^ /@reserveToggleSize@/: whether to reserve size for toggles
    -> m ()
menuSetReserveToggleSize :: a -> Bool -> m ()
menuSetReserveToggleSize menu :: a
menu reserveToggleSize :: Bool
reserveToggleSize = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    let reserveToggleSize' :: CInt
reserveToggleSize' = (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
reserveToggleSize
    Ptr Menu -> CInt -> IO ()
gtk_menu_set_reserve_toggle_size Ptr Menu
menu' CInt
reserveToggleSize'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuSetReserveToggleSizeMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsMenu a) => O.MethodInfo MenuSetReserveToggleSizeMethodInfo a signature where
    overloadedMethod = menuSetReserveToggleSize

#endif

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

foreign import ccall "gtk_menu_get_for_attach_widget" gtk_menu_get_for_attach_widget :: 
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO (Ptr (GList (Ptr Gtk.Widget.Widget)))

-- | Returns a list of the menus which are attached to this widget.
-- This list is owned by GTK+ and must not be modified.
menuGetForAttachWidget ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Widget.IsWidget a) =>
    a
    -- ^ /@widget@/: a t'GI.Gtk.Objects.Widget.Widget'
    -> m [Gtk.Widget.Widget]
    -- ^ __Returns:__ the list
    --     of menus attached to his widget.
menuGetForAttachWidget :: a -> m [Widget]
menuGetForAttachWidget widget :: a
widget = IO [Widget] -> m [Widget]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Widget] -> m [Widget]) -> IO [Widget] -> m [Widget]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Widget
widget' <- a -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
widget
    Ptr (GList (Ptr Widget))
result <- Ptr Widget -> IO (Ptr (GList (Ptr Widget)))
gtk_menu_get_for_attach_widget Ptr Widget
widget'
    [Ptr Widget]
result' <- Ptr (GList (Ptr Widget)) -> IO [Ptr Widget]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Widget))
result
    [Widget]
result'' <- (Ptr Widget -> IO Widget) -> [Ptr Widget] -> IO [Widget]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((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'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
widget
    [Widget] -> IO [Widget]
forall (m :: * -> *) a. Monad m => a -> m a
return [Widget]
result''

#if defined(ENABLE_OVERLOADING)
#endif