{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gtk.Structs.WidgetPath
(
WidgetPath(..) ,
#if defined(ENABLE_OVERLOADING)
ResolveWidgetPathMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
WidgetPathAppendForWidgetMethodInfo ,
#endif
widgetPathAppendForWidget ,
#if defined(ENABLE_OVERLOADING)
WidgetPathAppendTypeMethodInfo ,
#endif
widgetPathAppendType ,
#if defined(ENABLE_OVERLOADING)
WidgetPathAppendWithSiblingsMethodInfo ,
#endif
widgetPathAppendWithSiblings ,
#if defined(ENABLE_OVERLOADING)
WidgetPathCopyMethodInfo ,
#endif
widgetPathCopy ,
#if defined(ENABLE_OVERLOADING)
WidgetPathFreeMethodInfo ,
#endif
widgetPathFree ,
#if defined(ENABLE_OVERLOADING)
WidgetPathGetObjectTypeMethodInfo ,
#endif
widgetPathGetObjectType ,
#if defined(ENABLE_OVERLOADING)
WidgetPathHasParentMethodInfo ,
#endif
widgetPathHasParent ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIsTypeMethodInfo ,
#endif
widgetPathIsType ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterAddClassMethodInfo ,
#endif
widgetPathIterAddClass ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterAddRegionMethodInfo ,
#endif
widgetPathIterAddRegion ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterClearClassesMethodInfo ,
#endif
widgetPathIterClearClasses ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterClearRegionsMethodInfo ,
#endif
widgetPathIterClearRegions ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterGetNameMethodInfo ,
#endif
widgetPathIterGetName ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterGetObjectNameMethodInfo ,
#endif
widgetPathIterGetObjectName ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterGetObjectTypeMethodInfo ,
#endif
widgetPathIterGetObjectType ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterGetSiblingIndexMethodInfo ,
#endif
widgetPathIterGetSiblingIndex ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterGetSiblingsMethodInfo ,
#endif
widgetPathIterGetSiblings ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterGetStateMethodInfo ,
#endif
widgetPathIterGetState ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterHasClassMethodInfo ,
#endif
widgetPathIterHasClass ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterHasNameMethodInfo ,
#endif
widgetPathIterHasName ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterHasQclassMethodInfo ,
#endif
widgetPathIterHasQclass ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterHasQnameMethodInfo ,
#endif
widgetPathIterHasQname ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterHasQregionMethodInfo ,
#endif
widgetPathIterHasQregion ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterHasRegionMethodInfo ,
#endif
widgetPathIterHasRegion ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterListClassesMethodInfo ,
#endif
widgetPathIterListClasses ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterListRegionsMethodInfo ,
#endif
widgetPathIterListRegions ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterRemoveClassMethodInfo ,
#endif
widgetPathIterRemoveClass ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterRemoveRegionMethodInfo ,
#endif
widgetPathIterRemoveRegion ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterSetNameMethodInfo ,
#endif
widgetPathIterSetName ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterSetObjectNameMethodInfo ,
#endif
widgetPathIterSetObjectName ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterSetObjectTypeMethodInfo ,
#endif
widgetPathIterSetObjectType ,
#if defined(ENABLE_OVERLOADING)
WidgetPathIterSetStateMethodInfo ,
#endif
widgetPathIterSetState ,
#if defined(ENABLE_OVERLOADING)
WidgetPathLengthMethodInfo ,
#endif
widgetPathLength ,
widgetPathNew ,
#if defined(ENABLE_OVERLOADING)
WidgetPathPrependTypeMethodInfo ,
#endif
widgetPathPrependType ,
#if defined(ENABLE_OVERLOADING)
WidgetPathRefMethodInfo ,
#endif
widgetPathRef ,
#if defined(ENABLE_OVERLOADING)
WidgetPathToStringMethodInfo ,
#endif
widgetPathToString ,
#if defined(ENABLE_OVERLOADING)
WidgetPathUnrefMethodInfo ,
#endif
widgetPathUnref ,
) 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.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT
#if MIN_VERSION_base(4,18,0)
import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.Atk.Objects.Object as Atk.Object
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.Cairo.Structs.Region as Cairo.Region
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.MarkupParser as GLib.MarkupParser
import qualified GI.GObject.Callbacks as GObject.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Enums as Gdk.Enums
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Objects.Device as Gdk.Device
import qualified GI.Gdk.Objects.Display as Gdk.Display
import qualified GI.Gdk.Objects.DragContext as Gdk.DragContext
import qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import qualified GI.Gdk.Objects.Screen as Gdk.Screen
import qualified GI.Gdk.Objects.Visual as Gdk.Visual
import qualified GI.Gdk.Objects.Window as Gdk.Window
import qualified GI.Gdk.Structs.Atom as Gdk.Atom
import qualified GI.Gdk.Structs.Color as Gdk.Color
import qualified GI.Gdk.Structs.EventAny as Gdk.EventAny
import qualified GI.Gdk.Structs.EventButton as Gdk.EventButton
import qualified GI.Gdk.Structs.EventConfigure as Gdk.EventConfigure
import qualified GI.Gdk.Structs.EventCrossing as Gdk.EventCrossing
import qualified GI.Gdk.Structs.EventExpose as Gdk.EventExpose
import qualified GI.Gdk.Structs.EventFocus as Gdk.EventFocus
import qualified GI.Gdk.Structs.EventGrabBroken as Gdk.EventGrabBroken
import qualified GI.Gdk.Structs.EventKey as Gdk.EventKey
import qualified GI.Gdk.Structs.EventMotion as Gdk.EventMotion
import qualified GI.Gdk.Structs.EventOwnerChange as Gdk.EventOwnerChange
import qualified GI.Gdk.Structs.EventProperty as Gdk.EventProperty
import qualified GI.Gdk.Structs.EventProximity as Gdk.EventProximity
import qualified GI.Gdk.Structs.EventScroll as Gdk.EventScroll
import qualified GI.Gdk.Structs.EventSelection as Gdk.EventSelection
import qualified GI.Gdk.Structs.EventVisibility as Gdk.EventVisibility
import qualified GI.Gdk.Structs.EventWindowState as Gdk.EventWindowState
import qualified GI.Gdk.Structs.Geometry as Gdk.Geometry
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gdk.Unions.Event as Gdk.Event
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup
import qualified GI.Gio.Interfaces.ActionMap as Gio.ActionMap
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Objects.Application as Gio.Application
import qualified GI.Gio.Objects.Menu as Gio.Menu
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.StyleProvider as Gtk.StyleProvider
import {-# SOURCE #-} qualified GI.Gtk.Objects.AccelGroup as Gtk.AccelGroup
import {-# SOURCE #-} qualified GI.Gtk.Objects.Adjustment as Gtk.Adjustment
import {-# SOURCE #-} qualified GI.Gtk.Objects.Application as Gtk.Application
import {-# SOURCE #-} qualified GI.Gtk.Objects.Bin as Gtk.Bin
import {-# SOURCE #-} qualified GI.Gtk.Objects.Builder as Gtk.Builder
import {-# SOURCE #-} qualified GI.Gtk.Objects.Clipboard as Gtk.Clipboard
import {-# SOURCE #-} qualified GI.Gtk.Objects.Container as Gtk.Container
import {-# SOURCE #-} qualified GI.Gtk.Objects.IconFactory as Gtk.IconFactory
import {-# SOURCE #-} qualified GI.Gtk.Objects.RcStyle as Gtk.RcStyle
import {-# SOURCE #-} qualified GI.Gtk.Objects.Settings as Gtk.Settings
import {-# SOURCE #-} qualified GI.Gtk.Objects.Style as Gtk.Style
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleProperties as Gtk.StyleProperties
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextBuffer as Gtk.TextBuffer
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextChildAnchor as Gtk.TextChildAnchor
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextMark as Gtk.TextMark
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextTag as Gtk.TextTag
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextTagTable as Gtk.TextTagTable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Tooltip as Gtk.Tooltip
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.Gtk.Objects.Window as Gtk.Window
import {-# SOURCE #-} qualified GI.Gtk.Objects.WindowGroup as Gtk.WindowGroup
import {-# SOURCE #-} qualified GI.Gtk.Structs.AccelGroupEntry as Gtk.AccelGroupEntry
import {-# SOURCE #-} qualified GI.Gtk.Structs.AccelKey as Gtk.AccelKey
import {-# SOURCE #-} qualified GI.Gtk.Structs.Border as Gtk.Border
import {-# SOURCE #-} qualified GI.Gtk.Structs.CssSection as Gtk.CssSection
import {-# SOURCE #-} qualified GI.Gtk.Structs.IconSet as Gtk.IconSet
import {-# SOURCE #-} qualified GI.Gtk.Structs.IconSource as Gtk.IconSource
import {-# SOURCE #-} qualified GI.Gtk.Structs.Requisition as Gtk.Requisition
import {-# SOURCE #-} qualified GI.Gtk.Structs.SelectionData as Gtk.SelectionData
import {-# SOURCE #-} qualified GI.Gtk.Structs.SettingsValue as Gtk.SettingsValue
import {-# SOURCE #-} qualified GI.Gtk.Structs.SymbolicColor as Gtk.SymbolicColor
import {-# SOURCE #-} qualified GI.Gtk.Structs.TargetEntry as Gtk.TargetEntry
import {-# SOURCE #-} qualified GI.Gtk.Structs.TargetList as Gtk.TargetList
import {-# SOURCE #-} qualified GI.Gtk.Structs.TextAppearance as Gtk.TextAppearance
import {-# SOURCE #-} qualified GI.Gtk.Structs.TextAttributes as Gtk.TextAttributes
import {-# SOURCE #-} qualified GI.Gtk.Structs.TextIter as Gtk.TextIter
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Objects.Context as Pango.Context
import qualified GI.Pango.Objects.FontMap as Pango.FontMap
import qualified GI.Pango.Objects.Layout as Pango.Layout
import qualified GI.Pango.Structs.FontDescription as Pango.FontDescription
import qualified GI.Pango.Structs.Language as Pango.Language
import qualified GI.Pango.Structs.TabArray as Pango.TabArray
#else
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
#endif
newtype WidgetPath = WidgetPath (SP.ManagedPtr WidgetPath)
deriving (WidgetPath -> WidgetPath -> Bool
(WidgetPath -> WidgetPath -> Bool)
-> (WidgetPath -> WidgetPath -> Bool) -> Eq WidgetPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WidgetPath -> WidgetPath -> Bool
== :: WidgetPath -> WidgetPath -> Bool
$c/= :: WidgetPath -> WidgetPath -> Bool
/= :: WidgetPath -> WidgetPath -> Bool
Eq)
instance SP.ManagedPtrNewtype WidgetPath where
toManagedPtr :: WidgetPath -> ManagedPtr WidgetPath
toManagedPtr (WidgetPath ManagedPtr WidgetPath
p) = ManagedPtr WidgetPath
p
foreign import ccall "gtk_widget_path_get_type" c_gtk_widget_path_get_type ::
IO GType
type instance O.ParentTypes WidgetPath = '[]
instance O.HasParentTypes WidgetPath
instance B.Types.TypedObject WidgetPath where
glibType :: IO GType
glibType = IO GType
c_gtk_widget_path_get_type
instance B.Types.GBoxed WidgetPath
instance B.GValue.IsGValue (Maybe WidgetPath) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_widget_path_get_type
gvalueSet_ :: Ptr GValue -> Maybe WidgetPath -> IO ()
gvalueSet_ Ptr GValue
gv Maybe WidgetPath
P.Nothing = Ptr GValue -> Ptr WidgetPath -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr WidgetPath
forall a. Ptr a
FP.nullPtr :: FP.Ptr WidgetPath)
gvalueSet_ Ptr GValue
gv (P.Just WidgetPath
obj) = WidgetPath -> (Ptr WidgetPath -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr WidgetPath
obj (Ptr GValue -> Ptr WidgetPath -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe WidgetPath)
gvalueGet_ Ptr GValue
gv = do
Ptr WidgetPath
ptr <- Ptr GValue -> IO (Ptr WidgetPath)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr WidgetPath)
if Ptr WidgetPath
ptr Ptr WidgetPath -> Ptr WidgetPath -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr WidgetPath
forall a. Ptr a
FP.nullPtr
then WidgetPath -> Maybe WidgetPath
forall a. a -> Maybe a
P.Just (WidgetPath -> Maybe WidgetPath)
-> IO WidgetPath -> IO (Maybe WidgetPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr WidgetPath -> WidgetPath)
-> Ptr WidgetPath -> IO WidgetPath
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr WidgetPath -> WidgetPath
WidgetPath Ptr WidgetPath
ptr
else Maybe WidgetPath -> IO (Maybe WidgetPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe WidgetPath
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList WidgetPath
type instance O.AttributeList WidgetPath = WidgetPathAttributeList
type WidgetPathAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "gtk_widget_path_new" gtk_widget_path_new ::
IO (Ptr WidgetPath)
widgetPathNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
m WidgetPath
widgetPathNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m WidgetPath
widgetPathNew = IO WidgetPath -> m WidgetPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WidgetPath -> m WidgetPath) -> IO WidgetPath -> m WidgetPath
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
result <- IO (Ptr WidgetPath)
gtk_widget_path_new
Text -> Ptr WidgetPath -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"widgetPathNew" Ptr WidgetPath
result
WidgetPath
result' <- ((ManagedPtr WidgetPath -> WidgetPath)
-> Ptr WidgetPath -> IO WidgetPath
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr WidgetPath -> WidgetPath
WidgetPath) Ptr WidgetPath
result
WidgetPath -> IO WidgetPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WidgetPath
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "gtk_widget_path_append_for_widget" gtk_widget_path_append_for_widget ::
Ptr WidgetPath ->
Ptr Gtk.Widget.Widget ->
IO Int32
widgetPathAppendForWidget ::
(B.CallStack.HasCallStack, MonadIO m, Gtk.Widget.IsWidget a) =>
WidgetPath
-> a
-> m Int32
widgetPathAppendForWidget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
WidgetPath -> a -> m Int32
widgetPathAppendForWidget WidgetPath
path a
widget = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr Widget
widget' <- a -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
widget
Int32
result <- Ptr WidgetPath -> Ptr Widget -> IO Int32
gtk_widget_path_append_for_widget Ptr WidgetPath
path' Ptr Widget
widget'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
widget
Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data WidgetPathAppendForWidgetMethodInfo
instance (signature ~ (a -> m Int32), MonadIO m, Gtk.Widget.IsWidget a) => O.OverloadedMethod WidgetPathAppendForWidgetMethodInfo WidgetPath signature where
overloadedMethod = widgetPathAppendForWidget
instance O.OverloadedMethodInfo WidgetPathAppendForWidgetMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathAppendForWidget",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathAppendForWidget"
})
#endif
foreign import ccall "gtk_widget_path_append_type" gtk_widget_path_append_type ::
Ptr WidgetPath ->
CGType ->
IO Int32
widgetPathAppendType ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> GType
-> m Int32
widgetPathAppendType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> GType -> m Int32
widgetPathAppendType WidgetPath
path GType
type_ = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
Int32
result <- Ptr WidgetPath -> CGType -> IO Int32
gtk_widget_path_append_type Ptr WidgetPath
path' CGType
type_'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data WidgetPathAppendTypeMethodInfo
instance (signature ~ (GType -> m Int32), MonadIO m) => O.OverloadedMethod WidgetPathAppendTypeMethodInfo WidgetPath signature where
overloadedMethod = widgetPathAppendType
instance O.OverloadedMethodInfo WidgetPathAppendTypeMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathAppendType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathAppendType"
})
#endif
foreign import ccall "gtk_widget_path_append_with_siblings" gtk_widget_path_append_with_siblings ::
Ptr WidgetPath ->
Ptr WidgetPath ->
Word32 ->
IO Int32
widgetPathAppendWithSiblings ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> WidgetPath
-> Word32
-> m Int32
widgetPathAppendWithSiblings :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> WidgetPath -> Word32 -> m Int32
widgetPathAppendWithSiblings WidgetPath
path WidgetPath
siblings Word32
siblingIndex = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr WidgetPath
siblings' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
siblings
Int32
result <- Ptr WidgetPath -> Ptr WidgetPath -> Word32 -> IO Int32
gtk_widget_path_append_with_siblings Ptr WidgetPath
path' Ptr WidgetPath
siblings' Word32
siblingIndex
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
siblings
Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data WidgetPathAppendWithSiblingsMethodInfo
instance (signature ~ (WidgetPath -> Word32 -> m Int32), MonadIO m) => O.OverloadedMethod WidgetPathAppendWithSiblingsMethodInfo WidgetPath signature where
overloadedMethod = widgetPathAppendWithSiblings
instance O.OverloadedMethodInfo WidgetPathAppendWithSiblingsMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathAppendWithSiblings",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathAppendWithSiblings"
})
#endif
foreign import ccall "gtk_widget_path_copy" gtk_widget_path_copy ::
Ptr WidgetPath ->
IO (Ptr WidgetPath)
widgetPathCopy ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> m WidgetPath
widgetPathCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> m WidgetPath
widgetPathCopy WidgetPath
path = IO WidgetPath -> m WidgetPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WidgetPath -> m WidgetPath) -> IO WidgetPath -> m WidgetPath
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr WidgetPath
result <- Ptr WidgetPath -> IO (Ptr WidgetPath)
gtk_widget_path_copy Ptr WidgetPath
path'
Text -> Ptr WidgetPath -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"widgetPathCopy" Ptr WidgetPath
result
WidgetPath
result' <- ((ManagedPtr WidgetPath -> WidgetPath)
-> Ptr WidgetPath -> IO WidgetPath
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr WidgetPath -> WidgetPath
WidgetPath) Ptr WidgetPath
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
WidgetPath -> IO WidgetPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WidgetPath
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathCopyMethodInfo
instance (signature ~ (m WidgetPath), MonadIO m) => O.OverloadedMethod WidgetPathCopyMethodInfo WidgetPath signature where
overloadedMethod = widgetPathCopy
instance O.OverloadedMethodInfo WidgetPathCopyMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathCopy",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathCopy"
})
#endif
foreign import ccall "gtk_widget_path_free" gtk_widget_path_free ::
Ptr WidgetPath ->
IO ()
widgetPathFree ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> m ()
widgetPathFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> m ()
widgetPathFree WidgetPath
path = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr WidgetPath -> IO ()
gtk_widget_path_free Ptr WidgetPath
path'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod WidgetPathFreeMethodInfo WidgetPath signature where
overloadedMethod = widgetPathFree
instance O.OverloadedMethodInfo WidgetPathFreeMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathFree",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathFree"
})
#endif
foreign import ccall "gtk_widget_path_get_object_type" gtk_widget_path_get_object_type ::
Ptr WidgetPath ->
IO CGType
widgetPathGetObjectType ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> m GType
widgetPathGetObjectType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> m GType
widgetPathGetObjectType WidgetPath
path = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CGType
result <- Ptr WidgetPath -> IO CGType
gtk_widget_path_get_object_type Ptr WidgetPath
path'
let result' :: GType
result' = CGType -> GType
GType CGType
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathGetObjectTypeMethodInfo
instance (signature ~ (m GType), MonadIO m) => O.OverloadedMethod WidgetPathGetObjectTypeMethodInfo WidgetPath signature where
overloadedMethod = widgetPathGetObjectType
instance O.OverloadedMethodInfo WidgetPathGetObjectTypeMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathGetObjectType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathGetObjectType"
})
#endif
foreign import ccall "gtk_widget_path_has_parent" gtk_widget_path_has_parent ::
Ptr WidgetPath ->
CGType ->
IO CInt
widgetPathHasParent ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> GType
-> m Bool
widgetPathHasParent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> GType -> m Bool
widgetPathHasParent WidgetPath
path GType
type_ = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
CInt
result <- Ptr WidgetPath -> CGType -> IO CInt
gtk_widget_path_has_parent Ptr WidgetPath
path' CGType
type_'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathHasParentMethodInfo
instance (signature ~ (GType -> m Bool), MonadIO m) => O.OverloadedMethod WidgetPathHasParentMethodInfo WidgetPath signature where
overloadedMethod = widgetPathHasParent
instance O.OverloadedMethodInfo WidgetPathHasParentMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathHasParent",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathHasParent"
})
#endif
foreign import ccall "gtk_widget_path_is_type" gtk_widget_path_is_type ::
Ptr WidgetPath ->
CGType ->
IO CInt
widgetPathIsType ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> GType
-> m Bool
widgetPathIsType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> GType -> m Bool
widgetPathIsType WidgetPath
path GType
type_ = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
CInt
result <- Ptr WidgetPath -> CGType -> IO CInt
gtk_widget_path_is_type Ptr WidgetPath
path' CGType
type_'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathIsTypeMethodInfo
instance (signature ~ (GType -> m Bool), MonadIO m) => O.OverloadedMethod WidgetPathIsTypeMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIsType
instance O.OverloadedMethodInfo WidgetPathIsTypeMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIsType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIsType"
})
#endif
foreign import ccall "gtk_widget_path_iter_add_class" gtk_widget_path_iter_add_class ::
Ptr WidgetPath ->
Int32 ->
CString ->
IO ()
widgetPathIterAddClass ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> T.Text
-> m ()
widgetPathIterAddClass :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Text -> m ()
widgetPathIterAddClass WidgetPath
path Int32
pos Text
name = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr WidgetPath -> Int32 -> CString -> IO ()
gtk_widget_path_iter_add_class Ptr WidgetPath
path' Int32
pos CString
name'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterAddClassMethodInfo
instance (signature ~ (Int32 -> T.Text -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathIterAddClassMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterAddClass
instance O.OverloadedMethodInfo WidgetPathIterAddClassMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterAddClass",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterAddClass"
})
#endif
foreign import ccall "gtk_widget_path_iter_add_region" gtk_widget_path_iter_add_region ::
Ptr WidgetPath ->
Int32 ->
CString ->
CUInt ->
IO ()
{-# DEPRECATED widgetPathIterAddRegion ["(Since version 3.14)","The use of regions is deprecated."] #-}
widgetPathIterAddRegion ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> T.Text
-> [Gtk.Flags.RegionFlags]
-> m ()
widgetPathIterAddRegion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Text -> [RegionFlags] -> m ()
widgetPathIterAddRegion WidgetPath
path Int32
pos Text
name [RegionFlags]
flags = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
name' <- Text -> IO CString
textToCString Text
name
let flags' :: CUInt
flags' = [RegionFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [RegionFlags]
flags
Ptr WidgetPath -> Int32 -> CString -> CUInt -> IO ()
gtk_widget_path_iter_add_region Ptr WidgetPath
path' Int32
pos CString
name' CUInt
flags'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterAddRegionMethodInfo
instance (signature ~ (Int32 -> T.Text -> [Gtk.Flags.RegionFlags] -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathIterAddRegionMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterAddRegion
instance O.OverloadedMethodInfo WidgetPathIterAddRegionMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterAddRegion",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterAddRegion"
})
#endif
foreign import ccall "gtk_widget_path_iter_clear_classes" gtk_widget_path_iter_clear_classes ::
Ptr WidgetPath ->
Int32 ->
IO ()
widgetPathIterClearClasses ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> m ()
widgetPathIterClearClasses :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> m ()
widgetPathIterClearClasses WidgetPath
path Int32
pos = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr WidgetPath -> Int32 -> IO ()
gtk_widget_path_iter_clear_classes Ptr WidgetPath
path' Int32
pos
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterClearClassesMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathIterClearClassesMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterClearClasses
instance O.OverloadedMethodInfo WidgetPathIterClearClassesMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterClearClasses",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterClearClasses"
})
#endif
foreign import ccall "gtk_widget_path_iter_clear_regions" gtk_widget_path_iter_clear_regions ::
Ptr WidgetPath ->
Int32 ->
IO ()
{-# DEPRECATED widgetPathIterClearRegions ["(Since version 3.14)","The use of regions is deprecated."] #-}
widgetPathIterClearRegions ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> m ()
widgetPathIterClearRegions :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> m ()
widgetPathIterClearRegions WidgetPath
path Int32
pos = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr WidgetPath -> Int32 -> IO ()
gtk_widget_path_iter_clear_regions Ptr WidgetPath
path' Int32
pos
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterClearRegionsMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathIterClearRegionsMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterClearRegions
instance O.OverloadedMethodInfo WidgetPathIterClearRegionsMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterClearRegions",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterClearRegions"
})
#endif
foreign import ccall "gtk_widget_path_iter_get_name" gtk_widget_path_iter_get_name ::
Ptr WidgetPath ->
Int32 ->
IO CString
widgetPathIterGetName ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> m (Maybe T.Text)
widgetPathIterGetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> m (Maybe Text)
widgetPathIterGetName WidgetPath
path Int32
pos = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
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
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
result <- Ptr WidgetPath -> Int32 -> IO CString
gtk_widget_path_iter_get_name Ptr WidgetPath
path' Int32
pos
Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterGetNameMethodInfo
instance (signature ~ (Int32 -> m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod WidgetPathIterGetNameMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterGetName
instance O.OverloadedMethodInfo WidgetPathIterGetNameMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterGetName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterGetName"
})
#endif
foreign import ccall "gtk_widget_path_iter_get_object_name" gtk_widget_path_iter_get_object_name ::
Ptr WidgetPath ->
Int32 ->
IO CString
widgetPathIterGetObjectName ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> m (Maybe T.Text)
widgetPathIterGetObjectName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> m (Maybe Text)
widgetPathIterGetObjectName WidgetPath
path Int32
pos = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
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
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
result <- Ptr WidgetPath -> Int32 -> IO CString
gtk_widget_path_iter_get_object_name Ptr WidgetPath
path' Int32
pos
Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterGetObjectNameMethodInfo
instance (signature ~ (Int32 -> m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod WidgetPathIterGetObjectNameMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterGetObjectName
instance O.OverloadedMethodInfo WidgetPathIterGetObjectNameMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterGetObjectName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterGetObjectName"
})
#endif
foreign import ccall "gtk_widget_path_iter_get_object_type" gtk_widget_path_iter_get_object_type ::
Ptr WidgetPath ->
Int32 ->
IO CGType
widgetPathIterGetObjectType ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> m GType
widgetPathIterGetObjectType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> m GType
widgetPathIterGetObjectType WidgetPath
path Int32
pos = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CGType
result <- Ptr WidgetPath -> Int32 -> IO CGType
gtk_widget_path_iter_get_object_type Ptr WidgetPath
path' Int32
pos
let result' :: GType
result' = CGType -> GType
GType CGType
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterGetObjectTypeMethodInfo
instance (signature ~ (Int32 -> m GType), MonadIO m) => O.OverloadedMethod WidgetPathIterGetObjectTypeMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterGetObjectType
instance O.OverloadedMethodInfo WidgetPathIterGetObjectTypeMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterGetObjectType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterGetObjectType"
})
#endif
foreign import ccall "gtk_widget_path_iter_get_sibling_index" gtk_widget_path_iter_get_sibling_index ::
Ptr WidgetPath ->
Int32 ->
IO Word32
widgetPathIterGetSiblingIndex ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> m Word32
widgetPathIterGetSiblingIndex :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> m Word32
widgetPathIterGetSiblingIndex WidgetPath
path Int32
pos = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Word32
result <- Ptr WidgetPath -> Int32 -> IO Word32
gtk_widget_path_iter_get_sibling_index Ptr WidgetPath
path' Int32
pos
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterGetSiblingIndexMethodInfo
instance (signature ~ (Int32 -> m Word32), MonadIO m) => O.OverloadedMethod WidgetPathIterGetSiblingIndexMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterGetSiblingIndex
instance O.OverloadedMethodInfo WidgetPathIterGetSiblingIndexMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterGetSiblingIndex",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterGetSiblingIndex"
})
#endif
foreign import ccall "gtk_widget_path_iter_get_siblings" gtk_widget_path_iter_get_siblings ::
Ptr WidgetPath ->
Int32 ->
IO (Ptr WidgetPath)
widgetPathIterGetSiblings ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> m WidgetPath
widgetPathIterGetSiblings :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> m WidgetPath
widgetPathIterGetSiblings WidgetPath
path Int32
pos = IO WidgetPath -> m WidgetPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WidgetPath -> m WidgetPath) -> IO WidgetPath -> m WidgetPath
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr WidgetPath
result <- Ptr WidgetPath -> Int32 -> IO (Ptr WidgetPath)
gtk_widget_path_iter_get_siblings Ptr WidgetPath
path' Int32
pos
Text -> Ptr WidgetPath -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"widgetPathIterGetSiblings" Ptr WidgetPath
result
WidgetPath
result' <- ((ManagedPtr WidgetPath -> WidgetPath)
-> Ptr WidgetPath -> IO WidgetPath
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr WidgetPath -> WidgetPath
WidgetPath) Ptr WidgetPath
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
WidgetPath -> IO WidgetPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WidgetPath
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterGetSiblingsMethodInfo
instance (signature ~ (Int32 -> m WidgetPath), MonadIO m) => O.OverloadedMethod WidgetPathIterGetSiblingsMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterGetSiblings
instance O.OverloadedMethodInfo WidgetPathIterGetSiblingsMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterGetSiblings",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterGetSiblings"
})
#endif
foreign import ccall "gtk_widget_path_iter_get_state" gtk_widget_path_iter_get_state ::
Ptr WidgetPath ->
Int32 ->
IO CUInt
widgetPathIterGetState ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> m [Gtk.Flags.StateFlags]
widgetPathIterGetState :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> m [StateFlags]
widgetPathIterGetState WidgetPath
path Int32
pos = IO [StateFlags] -> m [StateFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [StateFlags] -> m [StateFlags])
-> IO [StateFlags] -> m [StateFlags]
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CUInt
result <- Ptr WidgetPath -> Int32 -> IO CUInt
gtk_widget_path_iter_get_state Ptr WidgetPath
path' Int32
pos
let result' :: [StateFlags]
result' = CUInt -> [StateFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
[StateFlags] -> IO [StateFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [StateFlags]
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterGetStateMethodInfo
instance (signature ~ (Int32 -> m [Gtk.Flags.StateFlags]), MonadIO m) => O.OverloadedMethod WidgetPathIterGetStateMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterGetState
instance O.OverloadedMethodInfo WidgetPathIterGetStateMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterGetState",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterGetState"
})
#endif
foreign import ccall "gtk_widget_path_iter_has_class" gtk_widget_path_iter_has_class ::
Ptr WidgetPath ->
Int32 ->
CString ->
IO CInt
widgetPathIterHasClass ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> T.Text
-> m Bool
widgetPathIterHasClass :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Text -> m Bool
widgetPathIterHasClass WidgetPath
path Int32
pos Text
name = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
name' <- Text -> IO CString
textToCString Text
name
CInt
result <- Ptr WidgetPath -> Int32 -> CString -> IO CInt
gtk_widget_path_iter_has_class Ptr WidgetPath
path' Int32
pos CString
name'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterHasClassMethodInfo
instance (signature ~ (Int32 -> T.Text -> m Bool), MonadIO m) => O.OverloadedMethod WidgetPathIterHasClassMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterHasClass
instance O.OverloadedMethodInfo WidgetPathIterHasClassMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterHasClass",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterHasClass"
})
#endif
foreign import ccall "gtk_widget_path_iter_has_name" gtk_widget_path_iter_has_name ::
Ptr WidgetPath ->
Int32 ->
CString ->
IO CInt
widgetPathIterHasName ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> T.Text
-> m Bool
widgetPathIterHasName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Text -> m Bool
widgetPathIterHasName WidgetPath
path Int32
pos Text
name = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
name' <- Text -> IO CString
textToCString Text
name
CInt
result <- Ptr WidgetPath -> Int32 -> CString -> IO CInt
gtk_widget_path_iter_has_name Ptr WidgetPath
path' Int32
pos CString
name'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterHasNameMethodInfo
instance (signature ~ (Int32 -> T.Text -> m Bool), MonadIO m) => O.OverloadedMethod WidgetPathIterHasNameMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterHasName
instance O.OverloadedMethodInfo WidgetPathIterHasNameMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterHasName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterHasName"
})
#endif
foreign import ccall "gtk_widget_path_iter_has_qclass" gtk_widget_path_iter_has_qclass ::
Ptr WidgetPath ->
Int32 ->
Word32 ->
IO CInt
widgetPathIterHasQclass ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> Word32
-> m Bool
widgetPathIterHasQclass :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Word32 -> m Bool
widgetPathIterHasQclass WidgetPath
path Int32
pos Word32
qname = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CInt
result <- Ptr WidgetPath -> Int32 -> Word32 -> IO CInt
gtk_widget_path_iter_has_qclass Ptr WidgetPath
path' Int32
pos Word32
qname
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterHasQclassMethodInfo
instance (signature ~ (Int32 -> Word32 -> m Bool), MonadIO m) => O.OverloadedMethod WidgetPathIterHasQclassMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterHasQclass
instance O.OverloadedMethodInfo WidgetPathIterHasQclassMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterHasQclass",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterHasQclass"
})
#endif
foreign import ccall "gtk_widget_path_iter_has_qname" gtk_widget_path_iter_has_qname ::
Ptr WidgetPath ->
Int32 ->
Word32 ->
IO CInt
widgetPathIterHasQname ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> Word32
-> m Bool
widgetPathIterHasQname :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Word32 -> m Bool
widgetPathIterHasQname WidgetPath
path Int32
pos Word32
qname = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CInt
result <- Ptr WidgetPath -> Int32 -> Word32 -> IO CInt
gtk_widget_path_iter_has_qname Ptr WidgetPath
path' Int32
pos Word32
qname
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterHasQnameMethodInfo
instance (signature ~ (Int32 -> Word32 -> m Bool), MonadIO m) => O.OverloadedMethod WidgetPathIterHasQnameMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterHasQname
instance O.OverloadedMethodInfo WidgetPathIterHasQnameMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterHasQname",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterHasQname"
})
#endif
foreign import ccall "gtk_widget_path_iter_has_qregion" gtk_widget_path_iter_has_qregion ::
Ptr WidgetPath ->
Int32 ->
Word32 ->
Ptr CUInt ->
IO CInt
{-# DEPRECATED widgetPathIterHasQregion ["(Since version 3.14)","The use of regions is deprecated."] #-}
widgetPathIterHasQregion ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> Word32
-> m ((Bool, [Gtk.Flags.RegionFlags]))
widgetPathIterHasQregion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Word32 -> m (Bool, [RegionFlags])
widgetPathIterHasQregion WidgetPath
path Int32
pos Word32
qname = IO (Bool, [RegionFlags]) -> m (Bool, [RegionFlags])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, [RegionFlags]) -> m (Bool, [RegionFlags]))
-> IO (Bool, [RegionFlags]) -> m (Bool, [RegionFlags])
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr CUInt
flags <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
CInt
result <- Ptr WidgetPath -> Int32 -> Word32 -> Ptr CUInt -> IO CInt
gtk_widget_path_iter_has_qregion Ptr WidgetPath
path' Int32
pos Word32
qname Ptr CUInt
flags
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
CUInt
flags' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
flags
let flags'' :: [RegionFlags]
flags'' = CUInt -> [RegionFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
flags
(Bool, [RegionFlags]) -> IO (Bool, [RegionFlags])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', [RegionFlags]
flags'')
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterHasQregionMethodInfo
instance (signature ~ (Int32 -> Word32 -> m ((Bool, [Gtk.Flags.RegionFlags]))), MonadIO m) => O.OverloadedMethod WidgetPathIterHasQregionMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterHasQregion
instance O.OverloadedMethodInfo WidgetPathIterHasQregionMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterHasQregion",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterHasQregion"
})
#endif
foreign import ccall "gtk_widget_path_iter_has_region" gtk_widget_path_iter_has_region ::
Ptr WidgetPath ->
Int32 ->
CString ->
Ptr CUInt ->
IO CInt
{-# DEPRECATED widgetPathIterHasRegion ["(Since version 3.14)","The use of regions is deprecated."] #-}
widgetPathIterHasRegion ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> T.Text
-> m ((Bool, [Gtk.Flags.RegionFlags]))
widgetPathIterHasRegion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Text -> m (Bool, [RegionFlags])
widgetPathIterHasRegion WidgetPath
path Int32
pos Text
name = IO (Bool, [RegionFlags]) -> m (Bool, [RegionFlags])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, [RegionFlags]) -> m (Bool, [RegionFlags]))
-> IO (Bool, [RegionFlags]) -> m (Bool, [RegionFlags])
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr CUInt
flags <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
CInt
result <- Ptr WidgetPath -> Int32 -> CString -> Ptr CUInt -> IO CInt
gtk_widget_path_iter_has_region Ptr WidgetPath
path' Int32
pos CString
name' Ptr CUInt
flags
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
CUInt
flags' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
flags
let flags'' :: [RegionFlags]
flags'' = CUInt -> [RegionFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
flags
(Bool, [RegionFlags]) -> IO (Bool, [RegionFlags])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', [RegionFlags]
flags'')
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterHasRegionMethodInfo
instance (signature ~ (Int32 -> T.Text -> m ((Bool, [Gtk.Flags.RegionFlags]))), MonadIO m) => O.OverloadedMethod WidgetPathIterHasRegionMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterHasRegion
instance O.OverloadedMethodInfo WidgetPathIterHasRegionMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterHasRegion",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterHasRegion"
})
#endif
foreign import ccall "gtk_widget_path_iter_list_classes" gtk_widget_path_iter_list_classes ::
Ptr WidgetPath ->
Int32 ->
IO (Ptr (GSList CString))
widgetPathIterListClasses ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> m [T.Text]
widgetPathIterListClasses :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> m [Text]
widgetPathIterListClasses WidgetPath
path Int32
pos = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr (GSList CString)
result <- Ptr WidgetPath -> Int32 -> IO (Ptr (GSList CString))
gtk_widget_path_iter_list_classes Ptr WidgetPath
path' Int32
pos
[CString]
result' <- Ptr (GSList CString) -> IO [CString]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList CString)
result
[Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
Ptr (GSList CString) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList CString)
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
[Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterListClassesMethodInfo
instance (signature ~ (Int32 -> m [T.Text]), MonadIO m) => O.OverloadedMethod WidgetPathIterListClassesMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterListClasses
instance O.OverloadedMethodInfo WidgetPathIterListClassesMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterListClasses",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterListClasses"
})
#endif
foreign import ccall "gtk_widget_path_iter_list_regions" gtk_widget_path_iter_list_regions ::
Ptr WidgetPath ->
Int32 ->
IO (Ptr (GSList CString))
{-# DEPRECATED widgetPathIterListRegions ["(Since version 3.14)","The use of regions is deprecated."] #-}
widgetPathIterListRegions ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> m [T.Text]
widgetPathIterListRegions :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> m [Text]
widgetPathIterListRegions WidgetPath
path Int32
pos = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr (GSList CString)
result <- Ptr WidgetPath -> Int32 -> IO (Ptr (GSList CString))
gtk_widget_path_iter_list_regions Ptr WidgetPath
path' Int32
pos
[CString]
result' <- Ptr (GSList CString) -> IO [CString]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList CString)
result
[Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
Ptr (GSList CString) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList CString)
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
[Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterListRegionsMethodInfo
instance (signature ~ (Int32 -> m [T.Text]), MonadIO m) => O.OverloadedMethod WidgetPathIterListRegionsMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterListRegions
instance O.OverloadedMethodInfo WidgetPathIterListRegionsMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterListRegions",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterListRegions"
})
#endif
foreign import ccall "gtk_widget_path_iter_remove_class" gtk_widget_path_iter_remove_class ::
Ptr WidgetPath ->
Int32 ->
CString ->
IO ()
widgetPathIterRemoveClass ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> T.Text
-> m ()
widgetPathIterRemoveClass :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Text -> m ()
widgetPathIterRemoveClass WidgetPath
path Int32
pos Text
name = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr WidgetPath -> Int32 -> CString -> IO ()
gtk_widget_path_iter_remove_class Ptr WidgetPath
path' Int32
pos CString
name'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterRemoveClassMethodInfo
instance (signature ~ (Int32 -> T.Text -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathIterRemoveClassMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterRemoveClass
instance O.OverloadedMethodInfo WidgetPathIterRemoveClassMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterRemoveClass",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterRemoveClass"
})
#endif
foreign import ccall "gtk_widget_path_iter_remove_region" gtk_widget_path_iter_remove_region ::
Ptr WidgetPath ->
Int32 ->
CString ->
IO ()
{-# DEPRECATED widgetPathIterRemoveRegion ["(Since version 3.14)","The use of regions is deprecated."] #-}
widgetPathIterRemoveRegion ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> T.Text
-> m ()
widgetPathIterRemoveRegion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Text -> m ()
widgetPathIterRemoveRegion WidgetPath
path Int32
pos Text
name = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr WidgetPath -> Int32 -> CString -> IO ()
gtk_widget_path_iter_remove_region Ptr WidgetPath
path' Int32
pos CString
name'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterRemoveRegionMethodInfo
instance (signature ~ (Int32 -> T.Text -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathIterRemoveRegionMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterRemoveRegion
instance O.OverloadedMethodInfo WidgetPathIterRemoveRegionMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterRemoveRegion",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterRemoveRegion"
})
#endif
foreign import ccall "gtk_widget_path_iter_set_name" gtk_widget_path_iter_set_name ::
Ptr WidgetPath ->
Int32 ->
CString ->
IO ()
widgetPathIterSetName ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> T.Text
-> m ()
widgetPathIterSetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Text -> m ()
widgetPathIterSetName WidgetPath
path Int32
pos Text
name = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr WidgetPath -> Int32 -> CString -> IO ()
gtk_widget_path_iter_set_name Ptr WidgetPath
path' Int32
pos CString
name'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterSetNameMethodInfo
instance (signature ~ (Int32 -> T.Text -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathIterSetNameMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterSetName
instance O.OverloadedMethodInfo WidgetPathIterSetNameMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterSetName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterSetName"
})
#endif
foreign import ccall "gtk_widget_path_iter_set_object_name" gtk_widget_path_iter_set_object_name ::
Ptr WidgetPath ->
Int32 ->
CString ->
IO ()
widgetPathIterSetObjectName ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> Maybe (T.Text)
-> m ()
widgetPathIterSetObjectName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> Maybe Text -> m ()
widgetPathIterSetObjectName WidgetPath
path Int32
pos Maybe Text
name = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
maybeName <- case Maybe Text
name of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
Just Text
jName -> do
CString
jName' <- Text -> IO CString
textToCString Text
jName
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jName'
Ptr WidgetPath -> Int32 -> CString -> IO ()
gtk_widget_path_iter_set_object_name Ptr WidgetPath
path' Int32
pos CString
maybeName
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeName
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterSetObjectNameMethodInfo
instance (signature ~ (Int32 -> Maybe (T.Text) -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathIterSetObjectNameMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterSetObjectName
instance O.OverloadedMethodInfo WidgetPathIterSetObjectNameMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterSetObjectName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterSetObjectName"
})
#endif
foreign import ccall "gtk_widget_path_iter_set_object_type" gtk_widget_path_iter_set_object_type ::
Ptr WidgetPath ->
Int32 ->
CGType ->
IO ()
widgetPathIterSetObjectType ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> GType
-> m ()
widgetPathIterSetObjectType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> GType -> m ()
widgetPathIterSetObjectType WidgetPath
path Int32
pos GType
type_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
Ptr WidgetPath -> Int32 -> CGType -> IO ()
gtk_widget_path_iter_set_object_type Ptr WidgetPath
path' Int32
pos CGType
type_'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterSetObjectTypeMethodInfo
instance (signature ~ (Int32 -> GType -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathIterSetObjectTypeMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterSetObjectType
instance O.OverloadedMethodInfo WidgetPathIterSetObjectTypeMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterSetObjectType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterSetObjectType"
})
#endif
foreign import ccall "gtk_widget_path_iter_set_state" gtk_widget_path_iter_set_state ::
Ptr WidgetPath ->
Int32 ->
CUInt ->
IO ()
widgetPathIterSetState ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> Int32
-> [Gtk.Flags.StateFlags]
-> m ()
widgetPathIterSetState :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> Int32 -> [StateFlags] -> m ()
widgetPathIterSetState WidgetPath
path Int32
pos [StateFlags]
state = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
let state' :: CUInt
state' = [StateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [StateFlags]
state
Ptr WidgetPath -> Int32 -> CUInt -> IO ()
gtk_widget_path_iter_set_state Ptr WidgetPath
path' Int32
pos CUInt
state'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathIterSetStateMethodInfo
instance (signature ~ (Int32 -> [Gtk.Flags.StateFlags] -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathIterSetStateMethodInfo WidgetPath signature where
overloadedMethod = widgetPathIterSetState
instance O.OverloadedMethodInfo WidgetPathIterSetStateMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathIterSetState",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathIterSetState"
})
#endif
foreign import ccall "gtk_widget_path_length" gtk_widget_path_length ::
Ptr WidgetPath ->
IO Int32
widgetPathLength ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> m Int32
widgetPathLength :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> m Int32
widgetPathLength WidgetPath
path = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Int32
result <- Ptr WidgetPath -> IO Int32
gtk_widget_path_length Ptr WidgetPath
path'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data WidgetPathLengthMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod WidgetPathLengthMethodInfo WidgetPath signature where
overloadedMethod = widgetPathLength
instance O.OverloadedMethodInfo WidgetPathLengthMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathLength",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathLength"
})
#endif
foreign import ccall "gtk_widget_path_prepend_type" gtk_widget_path_prepend_type ::
Ptr WidgetPath ->
CGType ->
IO ()
widgetPathPrependType ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> GType
-> m ()
widgetPathPrependType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> GType -> m ()
widgetPathPrependType WidgetPath
path GType
type_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
Ptr WidgetPath -> CGType -> IO ()
gtk_widget_path_prepend_type Ptr WidgetPath
path' CGType
type_'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathPrependTypeMethodInfo
instance (signature ~ (GType -> m ()), MonadIO m) => O.OverloadedMethod WidgetPathPrependTypeMethodInfo WidgetPath signature where
overloadedMethod = widgetPathPrependType
instance O.OverloadedMethodInfo WidgetPathPrependTypeMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathPrependType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathPrependType"
})
#endif
foreign import ccall "gtk_widget_path_ref" gtk_widget_path_ref ::
Ptr WidgetPath ->
IO (Ptr WidgetPath)
widgetPathRef ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> m WidgetPath
widgetPathRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> m WidgetPath
widgetPathRef WidgetPath
path = IO WidgetPath -> m WidgetPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WidgetPath -> m WidgetPath) -> IO WidgetPath -> m WidgetPath
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr WidgetPath
result <- Ptr WidgetPath -> IO (Ptr WidgetPath)
gtk_widget_path_ref Ptr WidgetPath
path'
Text -> Ptr WidgetPath -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"widgetPathRef" Ptr WidgetPath
result
WidgetPath
result' <- ((ManagedPtr WidgetPath -> WidgetPath)
-> Ptr WidgetPath -> IO WidgetPath
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr WidgetPath -> WidgetPath
WidgetPath) Ptr WidgetPath
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
WidgetPath -> IO WidgetPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WidgetPath
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathRefMethodInfo
instance (signature ~ (m WidgetPath), MonadIO m) => O.OverloadedMethod WidgetPathRefMethodInfo WidgetPath signature where
overloadedMethod = widgetPathRef
instance O.OverloadedMethodInfo WidgetPathRefMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathRef",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathRef"
})
#endif
foreign import ccall "gtk_widget_path_to_string" gtk_widget_path_to_string ::
Ptr WidgetPath ->
IO CString
widgetPathToString ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> m T.Text
widgetPathToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> m Text
widgetPathToString WidgetPath
path = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
CString
result <- Ptr WidgetPath -> IO CString
gtk_widget_path_to_string Ptr WidgetPath
path'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"widgetPathToString" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data WidgetPathToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod WidgetPathToStringMethodInfo WidgetPath signature where
overloadedMethod = widgetPathToString
instance O.OverloadedMethodInfo WidgetPathToStringMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathToString",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathToString"
})
#endif
foreign import ccall "gtk_widget_path_unref" gtk_widget_path_unref ::
Ptr WidgetPath ->
IO ()
widgetPathUnref ::
(B.CallStack.HasCallStack, MonadIO m) =>
WidgetPath
-> m ()
widgetPathUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WidgetPath -> m ()
widgetPathUnref WidgetPath
path = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr WidgetPath
path' <- WidgetPath -> IO (Ptr WidgetPath)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WidgetPath
path
Ptr WidgetPath -> IO ()
gtk_widget_path_unref Ptr WidgetPath
path'
WidgetPath -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WidgetPath
path
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data WidgetPathUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod WidgetPathUnrefMethodInfo WidgetPath signature where
overloadedMethod = widgetPathUnref
instance O.OverloadedMethodInfo WidgetPathUnrefMethodInfo WidgetPath where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Structs.WidgetPath.widgetPathUnref",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-WidgetPath.html#v:widgetPathUnref"
})
#endif
#if defined(ENABLE_OVERLOADING)
type family ResolveWidgetPathMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveWidgetPathMethod "appendForWidget" o = WidgetPathAppendForWidgetMethodInfo
ResolveWidgetPathMethod "appendType" o = WidgetPathAppendTypeMethodInfo
ResolveWidgetPathMethod "appendWithSiblings" o = WidgetPathAppendWithSiblingsMethodInfo
ResolveWidgetPathMethod "copy" o = WidgetPathCopyMethodInfo
ResolveWidgetPathMethod "free" o = WidgetPathFreeMethodInfo
ResolveWidgetPathMethod "hasParent" o = WidgetPathHasParentMethodInfo
ResolveWidgetPathMethod "isType" o = WidgetPathIsTypeMethodInfo
ResolveWidgetPathMethod "iterAddClass" o = WidgetPathIterAddClassMethodInfo
ResolveWidgetPathMethod "iterAddRegion" o = WidgetPathIterAddRegionMethodInfo
ResolveWidgetPathMethod "iterClearClasses" o = WidgetPathIterClearClassesMethodInfo
ResolveWidgetPathMethod "iterClearRegions" o = WidgetPathIterClearRegionsMethodInfo
ResolveWidgetPathMethod "iterGetName" o = WidgetPathIterGetNameMethodInfo
ResolveWidgetPathMethod "iterGetObjectName" o = WidgetPathIterGetObjectNameMethodInfo
ResolveWidgetPathMethod "iterGetObjectType" o = WidgetPathIterGetObjectTypeMethodInfo
ResolveWidgetPathMethod "iterGetSiblingIndex" o = WidgetPathIterGetSiblingIndexMethodInfo
ResolveWidgetPathMethod "iterGetSiblings" o = WidgetPathIterGetSiblingsMethodInfo
ResolveWidgetPathMethod "iterGetState" o = WidgetPathIterGetStateMethodInfo
ResolveWidgetPathMethod "iterHasClass" o = WidgetPathIterHasClassMethodInfo
ResolveWidgetPathMethod "iterHasName" o = WidgetPathIterHasNameMethodInfo
ResolveWidgetPathMethod "iterHasQclass" o = WidgetPathIterHasQclassMethodInfo
ResolveWidgetPathMethod "iterHasQname" o = WidgetPathIterHasQnameMethodInfo
ResolveWidgetPathMethod "iterHasQregion" o = WidgetPathIterHasQregionMethodInfo
ResolveWidgetPathMethod "iterHasRegion" o = WidgetPathIterHasRegionMethodInfo
ResolveWidgetPathMethod "iterListClasses" o = WidgetPathIterListClassesMethodInfo
ResolveWidgetPathMethod "iterListRegions" o = WidgetPathIterListRegionsMethodInfo
ResolveWidgetPathMethod "iterRemoveClass" o = WidgetPathIterRemoveClassMethodInfo
ResolveWidgetPathMethod "iterRemoveRegion" o = WidgetPathIterRemoveRegionMethodInfo
ResolveWidgetPathMethod "iterSetName" o = WidgetPathIterSetNameMethodInfo
ResolveWidgetPathMethod "iterSetObjectName" o = WidgetPathIterSetObjectNameMethodInfo
ResolveWidgetPathMethod "iterSetObjectType" o = WidgetPathIterSetObjectTypeMethodInfo
ResolveWidgetPathMethod "iterSetState" o = WidgetPathIterSetStateMethodInfo
ResolveWidgetPathMethod "length" o = WidgetPathLengthMethodInfo
ResolveWidgetPathMethod "prependType" o = WidgetPathPrependTypeMethodInfo
ResolveWidgetPathMethod "ref" o = WidgetPathRefMethodInfo
ResolveWidgetPathMethod "toString" o = WidgetPathToStringMethodInfo
ResolveWidgetPathMethod "unref" o = WidgetPathUnrefMethodInfo
ResolveWidgetPathMethod "getObjectType" o = WidgetPathGetObjectTypeMethodInfo
ResolveWidgetPathMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveWidgetPathMethod t WidgetPath, O.OverloadedMethod info WidgetPath p) => OL.IsLabel t (WidgetPath -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.overloadedMethod @info
#else
fromLabel _ = O.overloadedMethod @info
#endif
#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveWidgetPathMethod t WidgetPath, O.OverloadedMethod info WidgetPath p, R.HasField t WidgetPath p) => R.HasField t WidgetPath p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveWidgetPathMethod t WidgetPath, O.OverloadedMethodInfo info WidgetPath) => OL.IsLabel t (O.MethodProxy info WidgetPath) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif