{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Gtk.Objects.NotebookPage
    ( 

-- * Exported types
    NotebookPage(..)                        ,
    IsNotebookPage                          ,
    toNotebookPage                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveNotebookPageMethod               ,
#endif


-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    NotebookPageGetChildMethodInfo          ,
#endif
    notebookPageGetChild                    ,




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

#if defined(ENABLE_OVERLOADING)
    NotebookPageChildPropertyInfo           ,
#endif
    constructNotebookPageChild              ,
    getNotebookPageChild                    ,
#if defined(ENABLE_OVERLOADING)
    notebookPageChild                       ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    NotebookPageDetachablePropertyInfo      ,
#endif
    constructNotebookPageDetachable         ,
    getNotebookPageDetachable               ,
#if defined(ENABLE_OVERLOADING)
    notebookPageDetachable                  ,
#endif
    setNotebookPageDetachable               ,


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

#if defined(ENABLE_OVERLOADING)
    NotebookPageMenuPropertyInfo            ,
#endif
    constructNotebookPageMenu               ,
    getNotebookPageMenu                     ,
#if defined(ENABLE_OVERLOADING)
    notebookPageMenu                        ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    NotebookPageMenuLabelPropertyInfo       ,
#endif
    clearNotebookPageMenuLabel              ,
    constructNotebookPageMenuLabel          ,
    getNotebookPageMenuLabel                ,
#if defined(ENABLE_OVERLOADING)
    notebookPageMenuLabel                   ,
#endif
    setNotebookPageMenuLabel                ,


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

#if defined(ENABLE_OVERLOADING)
    NotebookPagePositionPropertyInfo        ,
#endif
    constructNotebookPagePosition           ,
    getNotebookPagePosition                 ,
#if defined(ENABLE_OVERLOADING)
    notebookPagePosition                    ,
#endif
    setNotebookPagePosition                 ,


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

#if defined(ENABLE_OVERLOADING)
    NotebookPageReorderablePropertyInfo     ,
#endif
    constructNotebookPageReorderable        ,
    getNotebookPageReorderable              ,
#if defined(ENABLE_OVERLOADING)
    notebookPageReorderable                 ,
#endif
    setNotebookPageReorderable              ,


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

#if defined(ENABLE_OVERLOADING)
    NotebookPageTabPropertyInfo             ,
#endif
    constructNotebookPageTab                ,
    getNotebookPageTab                      ,
#if defined(ENABLE_OVERLOADING)
    notebookPageTab                         ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    NotebookPageTabExpandPropertyInfo       ,
#endif
    constructNotebookPageTabExpand          ,
    getNotebookPageTabExpand                ,
#if defined(ENABLE_OVERLOADING)
    notebookPageTabExpand                   ,
#endif
    setNotebookPageTabExpand                ,


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

#if defined(ENABLE_OVERLOADING)
    NotebookPageTabFillPropertyInfo         ,
#endif
    constructNotebookPageTabFill            ,
    getNotebookPageTabFill                  ,
#if defined(ENABLE_OVERLOADING)
    notebookPageTabFill                     ,
#endif
    setNotebookPageTabFill                  ,


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

#if defined(ENABLE_OVERLOADING)
    NotebookPageTabLabelPropertyInfo        ,
#endif
    clearNotebookPageTabLabel               ,
    constructNotebookPageTabLabel           ,
    getNotebookPageTabLabel                 ,
#if defined(ENABLE_OVERLOADING)
    notebookPageTabLabel                    ,
#endif
    setNotebookPageTabLabel                 ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "gtk_notebook_page_get_type"
    c_gtk_notebook_page_get_type :: IO B.Types.GType

instance B.Types.TypedObject NotebookPage where
    glibType :: IO GType
glibType = IO GType
c_gtk_notebook_page_get_type

instance B.Types.GObject NotebookPage

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

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

instance O.HasParentTypes NotebookPage
type instance O.ParentTypes NotebookPage = '[GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveNotebookPageMethod (t :: Symbol) (o :: *) :: * where
    ResolveNotebookPageMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveNotebookPageMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveNotebookPageMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveNotebookPageMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveNotebookPageMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveNotebookPageMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveNotebookPageMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveNotebookPageMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveNotebookPageMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveNotebookPageMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveNotebookPageMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveNotebookPageMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveNotebookPageMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveNotebookPageMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveNotebookPageMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveNotebookPageMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveNotebookPageMethod "getChild" o = NotebookPageGetChildMethodInfo
    ResolveNotebookPageMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveNotebookPageMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveNotebookPageMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveNotebookPageMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveNotebookPageMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveNotebookPageMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveNotebookPageMethod l o = O.MethodResolutionFailed l o

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

#endif

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

-- | Get the value of the “@child@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' notebookPage #child
-- @
getNotebookPageChild :: (MonadIO m, IsNotebookPage o) => o -> m Gtk.Widget.Widget
getNotebookPageChild :: o -> m Widget
getNotebookPageChild 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 Text
"getNotebookPageChild" (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 String
"child" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

-- | Construct a `GValueConstruct` with valid value for the “@child@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNotebookPageChild :: (IsNotebookPage o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructNotebookPageChild :: a -> m (GValueConstruct o)
constructNotebookPageChild a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"child" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data NotebookPageChildPropertyInfo
instance AttrInfo NotebookPageChildPropertyInfo where
    type AttrAllowedOps NotebookPageChildPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotebookPageChildPropertyInfo = IsNotebookPage
    type AttrSetTypeConstraint NotebookPageChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint NotebookPageChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType NotebookPageChildPropertyInfo = Gtk.Widget.Widget
    type AttrGetType NotebookPageChildPropertyInfo = Gtk.Widget.Widget
    type AttrLabel NotebookPageChildPropertyInfo = "child"
    type AttrOrigin NotebookPageChildPropertyInfo = NotebookPage
    attrGet = getNotebookPageChild
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructNotebookPageChild
    attrClear = undefined
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@detachable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNotebookPageDetachable :: (IsNotebookPage o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructNotebookPageDetachable :: Bool -> m (GValueConstruct o)
constructNotebookPageDetachable Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"detachable" Bool
val

#if defined(ENABLE_OVERLOADING)
data NotebookPageDetachablePropertyInfo
instance AttrInfo NotebookPageDetachablePropertyInfo where
    type AttrAllowedOps NotebookPageDetachablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NotebookPageDetachablePropertyInfo = IsNotebookPage
    type AttrSetTypeConstraint NotebookPageDetachablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint NotebookPageDetachablePropertyInfo = (~) Bool
    type AttrTransferType NotebookPageDetachablePropertyInfo = Bool
    type AttrGetType NotebookPageDetachablePropertyInfo = Bool
    type AttrLabel NotebookPageDetachablePropertyInfo = "detachable"
    type AttrOrigin NotebookPageDetachablePropertyInfo = NotebookPage
    attrGet = getNotebookPageDetachable
    attrSet = setNotebookPageDetachable
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotebookPageDetachable
    attrClear = undefined
#endif

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

-- | Get the value of the “@menu@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' notebookPage #menu
-- @
getNotebookPageMenu :: (MonadIO m, IsNotebookPage o) => o -> m (Maybe Gtk.Widget.Widget)
getNotebookPageMenu :: o -> m (Maybe Widget)
getNotebookPageMenu 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 String
"menu" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

-- | Construct a `GValueConstruct` with valid value for the “@menu@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNotebookPageMenu :: (IsNotebookPage o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructNotebookPageMenu :: a -> m (GValueConstruct o)
constructNotebookPageMenu a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"menu" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data NotebookPageMenuPropertyInfo
instance AttrInfo NotebookPageMenuPropertyInfo where
    type AttrAllowedOps NotebookPageMenuPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotebookPageMenuPropertyInfo = IsNotebookPage
    type AttrSetTypeConstraint NotebookPageMenuPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint NotebookPageMenuPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType NotebookPageMenuPropertyInfo = Gtk.Widget.Widget
    type AttrGetType NotebookPageMenuPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel NotebookPageMenuPropertyInfo = "menu"
    type AttrOrigin NotebookPageMenuPropertyInfo = NotebookPage
    attrGet = getNotebookPageMenu
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructNotebookPageMenu
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@menu-label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' notebookPage [ #menuLabel 'Data.GI.Base.Attributes.:=' value ]
-- @
setNotebookPageMenuLabel :: (MonadIO m, IsNotebookPage o) => o -> T.Text -> m ()
setNotebookPageMenuLabel :: o -> Text -> m ()
setNotebookPageMenuLabel o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"menu-label" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@menu-label@” 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' #menuLabel
-- @
clearNotebookPageMenuLabel :: (MonadIO m, IsNotebookPage o) => o -> m ()
clearNotebookPageMenuLabel :: o -> m ()
clearNotebookPageMenuLabel o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"menu-label" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data NotebookPageMenuLabelPropertyInfo
instance AttrInfo NotebookPageMenuLabelPropertyInfo where
    type AttrAllowedOps NotebookPageMenuLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotebookPageMenuLabelPropertyInfo = IsNotebookPage
    type AttrSetTypeConstraint NotebookPageMenuLabelPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NotebookPageMenuLabelPropertyInfo = (~) T.Text
    type AttrTransferType NotebookPageMenuLabelPropertyInfo = T.Text
    type AttrGetType NotebookPageMenuLabelPropertyInfo = (Maybe T.Text)
    type AttrLabel NotebookPageMenuLabelPropertyInfo = "menu-label"
    type AttrOrigin NotebookPageMenuLabelPropertyInfo = NotebookPage
    attrGet = getNotebookPageMenuLabel
    attrSet = setNotebookPageMenuLabel
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotebookPageMenuLabel
    attrClear = clearNotebookPageMenuLabel
#endif

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

-- | Get the value of the “@position@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' notebookPage #position
-- @
getNotebookPagePosition :: (MonadIO m, IsNotebookPage o) => o -> m Int32
getNotebookPagePosition :: o -> m Int32
getNotebookPagePosition 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 String
"position"

-- | Set the value of the “@position@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' notebookPage [ #position 'Data.GI.Base.Attributes.:=' value ]
-- @
setNotebookPagePosition :: (MonadIO m, IsNotebookPage o) => o -> Int32 -> m ()
setNotebookPagePosition :: o -> Int32 -> m ()
setNotebookPagePosition o
obj 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 String
"position" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@position@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNotebookPagePosition :: (IsNotebookPage o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructNotebookPagePosition :: Int32 -> m (GValueConstruct o)
constructNotebookPagePosition Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"position" Int32
val

#if defined(ENABLE_OVERLOADING)
data NotebookPagePositionPropertyInfo
instance AttrInfo NotebookPagePositionPropertyInfo where
    type AttrAllowedOps NotebookPagePositionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NotebookPagePositionPropertyInfo = IsNotebookPage
    type AttrSetTypeConstraint NotebookPagePositionPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint NotebookPagePositionPropertyInfo = (~) Int32
    type AttrTransferType NotebookPagePositionPropertyInfo = Int32
    type AttrGetType NotebookPagePositionPropertyInfo = Int32
    type AttrLabel NotebookPagePositionPropertyInfo = "position"
    type AttrOrigin NotebookPagePositionPropertyInfo = NotebookPage
    attrGet = getNotebookPagePosition
    attrSet = setNotebookPagePosition
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotebookPagePosition
    attrClear = undefined
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@reorderable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNotebookPageReorderable :: (IsNotebookPage o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructNotebookPageReorderable :: Bool -> m (GValueConstruct o)
constructNotebookPageReorderable Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"reorderable" Bool
val

#if defined(ENABLE_OVERLOADING)
data NotebookPageReorderablePropertyInfo
instance AttrInfo NotebookPageReorderablePropertyInfo where
    type AttrAllowedOps NotebookPageReorderablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NotebookPageReorderablePropertyInfo = IsNotebookPage
    type AttrSetTypeConstraint NotebookPageReorderablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint NotebookPageReorderablePropertyInfo = (~) Bool
    type AttrTransferType NotebookPageReorderablePropertyInfo = Bool
    type AttrGetType NotebookPageReorderablePropertyInfo = Bool
    type AttrLabel NotebookPageReorderablePropertyInfo = "reorderable"
    type AttrOrigin NotebookPageReorderablePropertyInfo = NotebookPage
    attrGet = getNotebookPageReorderable
    attrSet = setNotebookPageReorderable
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotebookPageReorderable
    attrClear = undefined
#endif

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

-- | Get the value of the “@tab@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' notebookPage #tab
-- @
getNotebookPageTab :: (MonadIO m, IsNotebookPage o) => o -> m (Maybe Gtk.Widget.Widget)
getNotebookPageTab :: o -> m (Maybe Widget)
getNotebookPageTab 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 String
"tab" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

-- | Construct a `GValueConstruct` with valid value for the “@tab@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNotebookPageTab :: (IsNotebookPage o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructNotebookPageTab :: a -> m (GValueConstruct o)
constructNotebookPageTab a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"tab" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data NotebookPageTabPropertyInfo
instance AttrInfo NotebookPageTabPropertyInfo where
    type AttrAllowedOps NotebookPageTabPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotebookPageTabPropertyInfo = IsNotebookPage
    type AttrSetTypeConstraint NotebookPageTabPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint NotebookPageTabPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType NotebookPageTabPropertyInfo = Gtk.Widget.Widget
    type AttrGetType NotebookPageTabPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel NotebookPageTabPropertyInfo = "tab"
    type AttrOrigin NotebookPageTabPropertyInfo = NotebookPage
    attrGet = getNotebookPageTab
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructNotebookPageTab
    attrClear = undefined
#endif

-- VVV Prop "tab-expand"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@tab-expand@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' notebookPage #tabExpand
-- @
getNotebookPageTabExpand :: (MonadIO m, IsNotebookPage o) => o -> m Bool
getNotebookPageTabExpand :: o -> m Bool
getNotebookPageTabExpand 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 String
"tab-expand"

-- | Set the value of the “@tab-expand@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' notebookPage [ #tabExpand 'Data.GI.Base.Attributes.:=' value ]
-- @
setNotebookPageTabExpand :: (MonadIO m, IsNotebookPage o) => o -> Bool -> m ()
setNotebookPageTabExpand :: o -> Bool -> m ()
setNotebookPageTabExpand o
obj 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 String
"tab-expand" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@tab-expand@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNotebookPageTabExpand :: (IsNotebookPage o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructNotebookPageTabExpand :: Bool -> m (GValueConstruct o)
constructNotebookPageTabExpand Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"tab-expand" Bool
val

#if defined(ENABLE_OVERLOADING)
data NotebookPageTabExpandPropertyInfo
instance AttrInfo NotebookPageTabExpandPropertyInfo where
    type AttrAllowedOps NotebookPageTabExpandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NotebookPageTabExpandPropertyInfo = IsNotebookPage
    type AttrSetTypeConstraint NotebookPageTabExpandPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint NotebookPageTabExpandPropertyInfo = (~) Bool
    type AttrTransferType NotebookPageTabExpandPropertyInfo = Bool
    type AttrGetType NotebookPageTabExpandPropertyInfo = Bool
    type AttrLabel NotebookPageTabExpandPropertyInfo = "tab-expand"
    type AttrOrigin NotebookPageTabExpandPropertyInfo = NotebookPage
    attrGet = getNotebookPageTabExpand
    attrSet = setNotebookPageTabExpand
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotebookPageTabExpand
    attrClear = undefined
#endif

-- VVV Prop "tab-fill"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@tab-fill@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' notebookPage #tabFill
-- @
getNotebookPageTabFill :: (MonadIO m, IsNotebookPage o) => o -> m Bool
getNotebookPageTabFill :: o -> m Bool
getNotebookPageTabFill 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 String
"tab-fill"

-- | Set the value of the “@tab-fill@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' notebookPage [ #tabFill 'Data.GI.Base.Attributes.:=' value ]
-- @
setNotebookPageTabFill :: (MonadIO m, IsNotebookPage o) => o -> Bool -> m ()
setNotebookPageTabFill :: o -> Bool -> m ()
setNotebookPageTabFill o
obj 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 String
"tab-fill" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@tab-fill@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNotebookPageTabFill :: (IsNotebookPage o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructNotebookPageTabFill :: Bool -> m (GValueConstruct o)
constructNotebookPageTabFill Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"tab-fill" Bool
val

#if defined(ENABLE_OVERLOADING)
data NotebookPageTabFillPropertyInfo
instance AttrInfo NotebookPageTabFillPropertyInfo where
    type AttrAllowedOps NotebookPageTabFillPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NotebookPageTabFillPropertyInfo = IsNotebookPage
    type AttrSetTypeConstraint NotebookPageTabFillPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint NotebookPageTabFillPropertyInfo = (~) Bool
    type AttrTransferType NotebookPageTabFillPropertyInfo = Bool
    type AttrGetType NotebookPageTabFillPropertyInfo = Bool
    type AttrLabel NotebookPageTabFillPropertyInfo = "tab-fill"
    type AttrOrigin NotebookPageTabFillPropertyInfo = NotebookPage
    attrGet = getNotebookPageTabFill
    attrSet = setNotebookPageTabFill
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotebookPageTabFill
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@tab-label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' notebookPage [ #tabLabel 'Data.GI.Base.Attributes.:=' value ]
-- @
setNotebookPageTabLabel :: (MonadIO m, IsNotebookPage o) => o -> T.Text -> m ()
setNotebookPageTabLabel :: o -> Text -> m ()
setNotebookPageTabLabel o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"tab-label" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@tab-label@” 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' #tabLabel
-- @
clearNotebookPageTabLabel :: (MonadIO m, IsNotebookPage o) => o -> m ()
clearNotebookPageTabLabel :: o -> m ()
clearNotebookPageTabLabel o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"tab-label" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data NotebookPageTabLabelPropertyInfo
instance AttrInfo NotebookPageTabLabelPropertyInfo where
    type AttrAllowedOps NotebookPageTabLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotebookPageTabLabelPropertyInfo = IsNotebookPage
    type AttrSetTypeConstraint NotebookPageTabLabelPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NotebookPageTabLabelPropertyInfo = (~) T.Text
    type AttrTransferType NotebookPageTabLabelPropertyInfo = T.Text
    type AttrGetType NotebookPageTabLabelPropertyInfo = (Maybe T.Text)
    type AttrLabel NotebookPageTabLabelPropertyInfo = "tab-label"
    type AttrOrigin NotebookPageTabLabelPropertyInfo = NotebookPage
    attrGet = getNotebookPageTabLabel
    attrSet = setNotebookPageTabLabel
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotebookPageTabLabel
    attrClear = clearNotebookPageTabLabel
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList NotebookPage
type instance O.AttributeList NotebookPage = NotebookPageAttributeList
type NotebookPageAttributeList = ('[ '("child", NotebookPageChildPropertyInfo), '("detachable", NotebookPageDetachablePropertyInfo), '("menu", NotebookPageMenuPropertyInfo), '("menuLabel", NotebookPageMenuLabelPropertyInfo), '("position", NotebookPagePositionPropertyInfo), '("reorderable", NotebookPageReorderablePropertyInfo), '("tab", NotebookPageTabPropertyInfo), '("tabExpand", NotebookPageTabExpandPropertyInfo), '("tabFill", NotebookPageTabFillPropertyInfo), '("tabLabel", NotebookPageTabLabelPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
notebookPageChild :: AttrLabelProxy "child"
notebookPageChild = AttrLabelProxy

notebookPageDetachable :: AttrLabelProxy "detachable"
notebookPageDetachable = AttrLabelProxy

notebookPageMenu :: AttrLabelProxy "menu"
notebookPageMenu = AttrLabelProxy

notebookPageMenuLabel :: AttrLabelProxy "menuLabel"
notebookPageMenuLabel = AttrLabelProxy

notebookPagePosition :: AttrLabelProxy "position"
notebookPagePosition = AttrLabelProxy

notebookPageReorderable :: AttrLabelProxy "reorderable"
notebookPageReorderable = AttrLabelProxy

notebookPageTab :: AttrLabelProxy "tab"
notebookPageTab = AttrLabelProxy

notebookPageTabExpand :: AttrLabelProxy "tabExpand"
notebookPageTabExpand = AttrLabelProxy

notebookPageTabFill :: AttrLabelProxy "tabFill"
notebookPageTabFill = AttrLabelProxy

notebookPageTabLabel :: AttrLabelProxy "tabLabel"
notebookPageTabLabel = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList NotebookPage = NotebookPageSignalList
type NotebookPageSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method NotebookPage::get_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "NotebookPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkNotebookPage" , 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_notebook_page_get_child" gtk_notebook_page_get_child :: 
    Ptr NotebookPage ->                     -- page : TInterface (Name {namespace = "Gtk", name = "NotebookPage"})
    IO (Ptr Gtk.Widget.Widget)

-- | Returns the notebook child to which /@page@/ belongs.
notebookPageGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotebookPage a) =>
    a
    -- ^ /@page@/: a t'GI.Gtk.Objects.NotebookPage.NotebookPage'
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ the child to which /@page@/ belongs
notebookPageGetChild :: a -> m Widget
notebookPageGetChild a
page = 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 NotebookPage
page' <- a -> IO (Ptr NotebookPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Widget
result <- Ptr NotebookPage -> IO (Ptr Widget)
gtk_notebook_page_get_child Ptr NotebookPage
page'
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"notebookPageGetChild" 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
page
    Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
data NotebookPageGetChildMethodInfo
instance (signature ~ (m Gtk.Widget.Widget), MonadIO m, IsNotebookPage a) => O.MethodInfo NotebookPageGetChildMethodInfo a signature where
    overloadedMethod = notebookPageGetChild

#endif