{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Interfaces.Root.Root' is the interface implemented by all widgets that can act as a toplevel
-- widget to a hierarchy of widgets. The root widget takes care of providing the
-- connection to the windowing system and manages layout, drawing and event delivery
-- for its widget hierarchy.
-- 
-- The obvious example of a t'GI.Gtk.Interfaces.Root.Root' is t'GI.Gtk.Objects.Window.Window'.

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

module GI.Gtk.Interfaces.Root
    ( 

-- * Exported types
    Root(..)                                ,
    noRoot                                  ,
    IsRoot                                  ,
    toRoot                                  ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveRootMethod                       ,
#endif


-- ** getFocus #method:getFocus#

#if defined(ENABLE_OVERLOADING)
    RootGetFocusMethodInfo                  ,
#endif
    rootGetFocus                            ,


-- ** getForSurface #method:getForSurface#

    rootGetForSurface                       ,


-- ** setFocus #method:setFocus#

#if defined(ENABLE_OVERLOADING)
    RootSetFocusMethodInfo                  ,
#endif
    rootSetFocus                            ,




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

#if defined(ENABLE_OVERLOADING)
    RootFocusWidgetPropertyInfo             ,
#endif
    clearRootFocusWidget                    ,
    constructRootFocusWidget                ,
    getRootFocusWidget                      ,
#if defined(ENABLE_OVERLOADING)
    rootFocusWidget                         ,
#endif
    setRootFocusWidget                      ,




    ) 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.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.Surface as Gdk.Surface
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

-- interface Root 
-- | Memory-managed wrapper type.
newtype Root = Root (ManagedPtr Root)
    deriving (Root -> Root -> Bool
(Root -> Root -> Bool) -> (Root -> Root -> Bool) -> Eq Root
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Root -> Root -> Bool
$c/= :: Root -> Root -> Bool
== :: Root -> Root -> Bool
$c== :: Root -> Root -> Bool
Eq)
-- | A convenience alias for `Nothing` :: `Maybe` `Root`.
noRoot :: Maybe Root
noRoot :: Maybe Root
noRoot = Maybe Root
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Root = RootSignalList
type RootSignalList = ('[ '("accelClosuresChanged", Gtk.Widget.WidgetAccelClosuresChangedSignalInfo), '("canActivateAccel", Gtk.Widget.WidgetCanActivateAccelSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("dragBegin", Gtk.Widget.WidgetDragBeginSignalInfo), '("dragDataDelete", Gtk.Widget.WidgetDragDataDeleteSignalInfo), '("dragDataGet", Gtk.Widget.WidgetDragDataGetSignalInfo), '("dragDataReceived", Gtk.Widget.WidgetDragDataReceivedSignalInfo), '("dragDrop", Gtk.Widget.WidgetDragDropSignalInfo), '("dragEnd", Gtk.Widget.WidgetDragEndSignalInfo), '("dragFailed", Gtk.Widget.WidgetDragFailedSignalInfo), '("dragLeave", Gtk.Widget.WidgetDragLeaveSignalInfo), '("dragMotion", Gtk.Widget.WidgetDragMotionSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("popupMenu", Gtk.Widget.WidgetPopupMenuSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("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

foreign import ccall "gtk_root_get_type"
    c_gtk_root_get_type :: IO GType

instance GObject Root where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_root_get_type
    

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

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

instance O.HasParentTypes Root
type instance O.ParentTypes Root = '[GObject.Object.Object, Gtk.Widget.Widget]

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

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

-- | Get the value of the “@focus-widget@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' root #focusWidget
-- @
getRootFocusWidget :: (MonadIO m, IsRoot o) => o -> m (Maybe Gtk.Widget.Widget)
getRootFocusWidget :: o -> m (Maybe Widget)
getRootFocusWidget obj :: o
obj = IO (Maybe Widget) -> m (Maybe Widget)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ 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 "focus-widget" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

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

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

-- | Set the value of the “@focus-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' #focusWidget
-- @
clearRootFocusWidget :: (MonadIO m, IsRoot o) => o -> m ()
clearRootFocusWidget :: o -> m ()
clearRootFocusWidget 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 "focus-widget" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data RootFocusWidgetPropertyInfo
instance AttrInfo RootFocusWidgetPropertyInfo where
    type AttrAllowedOps RootFocusWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint RootFocusWidgetPropertyInfo = IsRoot
    type AttrSetTypeConstraint RootFocusWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint RootFocusWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType RootFocusWidgetPropertyInfo = Gtk.Widget.Widget
    type AttrGetType RootFocusWidgetPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel RootFocusWidgetPropertyInfo = "focus-widget"
    type AttrOrigin RootFocusWidgetPropertyInfo = Root
    attrGet = getRootFocusWidget
    attrSet = setRootFocusWidget
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructRootFocusWidget
    attrClear = clearRootFocusWidget
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Root
type instance O.AttributeList Root = RootAttributeList
type RootAttributeList = ('[ '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("expand", Gtk.Widget.WidgetExpandPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusWidget", RootFocusWidgetPropertyInfo), '("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), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("surface", Gtk.Widget.WidgetSurfacePropertyInfo), '("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)
rootFocusWidget :: AttrLabelProxy "focusWidget"
rootFocusWidget = AttrLabelProxy

#endif

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

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

#endif

-- method Root::get_focus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Root" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRoot" , 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_root_get_focus" gtk_root_get_focus :: 
    Ptr Root ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Root"})
    IO (Ptr Gtk.Widget.Widget)

-- | Retrieves the current focused widget within the root.
-- 
-- Note that this is the widget that would have the focus
-- if the root is active; if the root is not focused then
-- @gtk_widget_has_focus (widget)@ will be 'P.False' for the
-- widget.
rootGetFocus ::
    (B.CallStack.HasCallStack, MonadIO m, IsRoot a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Interfaces.Root.Root'
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ the currently focused widget,
    --    or 'P.Nothing' if there is none.
rootGetFocus :: a -> m (Maybe Widget)
rootGetFocus self :: a
self = IO (Maybe Widget) -> m (Maybe Widget)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Root
self' <- a -> IO (Ptr Root)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr Root -> IO (Ptr Widget)
gtk_root_get_focus Ptr Root
self'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Widget -> IO (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

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

#endif

-- method Root::set_focus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Root" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRoot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "focus"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "widget to be the new focus widget, or %NULL\n   to unset the focus widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_root_set_focus" gtk_root_set_focus :: 
    Ptr Root ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Root"})
    Ptr Gtk.Widget.Widget ->                -- focus : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | If /@focus@/ is not the current focus widget, and is focusable, sets
-- it as the focus widget for the root. If /@focus@/ is 'P.Nothing', unsets
-- the focus widget for the root.
-- 
-- To set the focus to a particular widget in the root, it is usually
-- more convenient to use 'GI.Gtk.Objects.Widget.widgetGrabFocus' instead of this function.
rootSetFocus ::
    (B.CallStack.HasCallStack, MonadIO m, IsRoot a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Interfaces.Root.Root'
    -> Maybe (b)
    -- ^ /@focus@/: widget to be the new focus widget, or 'P.Nothing'
    --    to unset the focus widget
    -> m ()
rootSetFocus :: a -> Maybe b -> m ()
rootSetFocus self :: a
self focus :: Maybe b
focus = 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 Root
self' <- a -> IO (Ptr Root)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
maybeFocus <- case Maybe b
focus of
        Nothing -> Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just jFocus :: b
jFocus -> do
            Ptr Widget
jFocus' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFocus
            Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jFocus'
    Ptr Root -> Ptr Widget -> IO ()
gtk_root_set_focus Ptr Root
self' Ptr Widget
maybeFocus
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
focus b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- method Root::get_for_surface
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkSurface" , 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_root_get_for_surface" gtk_root_get_for_surface :: 
    Ptr Gdk.Surface.Surface ->              -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO (Ptr Gtk.Widget.Widget)

-- | Finds the GtkRoot associated with the surface.
rootGetForSurface ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Surface.IsSurface a) =>
    a
    -- ^ /@surface@/: a t'GI.Gdk.Objects.Surface.Surface'
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ the t'GI.Gtk.Interfaces.Root.Root' that is associated with /@surface@/
rootGetForSurface :: a -> m Widget
rootGetForSurface surface :: a
surface = 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 Surface
surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    Ptr Widget
result <- Ptr Surface -> IO (Ptr Widget)
gtk_root_get_for_surface Ptr Surface
surface'
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "rootGetForSurface" 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
surface
    Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
#endif