{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The “system tray” or notification area is normally used for transient icons
-- that indicate some special state. For example, a system tray icon might
-- appear to tell the user that they have new mail, or have an incoming instant
-- message, or something along those lines. The basic idea is that creating an
-- icon in the notification area is less annoying than popping up a dialog.
-- 
-- A t'GI.Gtk.Objects.StatusIcon.StatusIcon' object can be used to display an icon in a “system tray”.
-- The icon can have a tooltip, and the user can interact with it by
-- activating it or popping up a context menu.
-- 
-- It is very important to notice that status icons depend on the existence
-- of a notification area being available to the user; you should not use status
-- icons as the only way to convey critical information regarding your application,
-- as the notification area may not exist on the user\'s environment, or may have
-- been removed. You should always check that a status icon has been embedded into
-- a notification area by using 'GI.Gtk.Objects.StatusIcon.statusIconIsEmbedded', and gracefully
-- recover if the function returns 'P.False'.
-- 
-- On X11, the implementation follows the
-- <http://www.freedesktop.org/wiki/Specifications/systemtray-spec FreeDesktop System Tray Specification>.
-- Implementations of the “tray” side of this specification can
-- be found e.g. in the GNOME 2 and KDE panel applications.
-- 
-- Note that a GtkStatusIcon is not a widget, but just a t'GI.GObject.Objects.Object.Object'. Making it a
-- widget would be impractical, since the system tray on Windows doesn’t allow
-- to embed arbitrary widgets.
-- 
-- GtkStatusIcon has been deprecated in 3.14. You should consider using
-- notifications or more modern platform-specific APIs instead. GLib provides
-- the t'GI.Gio.Objects.Notification.Notification' API which works well with t'GI.Gtk.Objects.Application.Application' on multiple
-- platforms and environments, and should be the preferred mechanism to notify
-- the users of transient status updates. See this <https://wiki.gnome.org/HowDoI/GNotification HowDoI>
-- for code examples.

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

module GI.Gtk.Objects.StatusIcon
    ( 

-- * Exported types
    StatusIcon(..)                          ,
    IsStatusIcon                            ,
    toStatusIcon                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveStatusIconMethod                 ,
#endif


-- ** getGeometry #method:getGeometry#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetGeometryMethodInfo         ,
#endif
    statusIconGetGeometry                   ,


-- ** getGicon #method:getGicon#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetGiconMethodInfo            ,
#endif
    statusIconGetGicon                      ,


-- ** getHasTooltip #method:getHasTooltip#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetHasTooltipMethodInfo       ,
#endif
    statusIconGetHasTooltip                 ,


-- ** getIconName #method:getIconName#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetIconNameMethodInfo         ,
#endif
    statusIconGetIconName                   ,


-- ** getPixbuf #method:getPixbuf#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetPixbufMethodInfo           ,
#endif
    statusIconGetPixbuf                     ,


-- ** getScreen #method:getScreen#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetScreenMethodInfo           ,
#endif
    statusIconGetScreen                     ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetSizeMethodInfo             ,
#endif
    statusIconGetSize                       ,


-- ** getStock #method:getStock#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetStockMethodInfo            ,
#endif
    statusIconGetStock                      ,


-- ** getStorageType #method:getStorageType#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetStorageTypeMethodInfo      ,
#endif
    statusIconGetStorageType                ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetTitleMethodInfo            ,
#endif
    statusIconGetTitle                      ,


-- ** getTooltipMarkup #method:getTooltipMarkup#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetTooltipMarkupMethodInfo    ,
#endif
    statusIconGetTooltipMarkup              ,


-- ** getTooltipText #method:getTooltipText#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetTooltipTextMethodInfo      ,
#endif
    statusIconGetTooltipText                ,


-- ** getVisible #method:getVisible#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetVisibleMethodInfo          ,
#endif
    statusIconGetVisible                    ,


-- ** getX11WindowId #method:getX11WindowId#

#if defined(ENABLE_OVERLOADING)
    StatusIconGetX11WindowIdMethodInfo      ,
#endif
    statusIconGetX11WindowId                ,


-- ** isEmbedded #method:isEmbedded#

#if defined(ENABLE_OVERLOADING)
    StatusIconIsEmbeddedMethodInfo          ,
#endif
    statusIconIsEmbedded                    ,


-- ** new #method:new#

    statusIconNew                           ,


-- ** newFromFile #method:newFromFile#

    statusIconNewFromFile                   ,


-- ** newFromGicon #method:newFromGicon#

    statusIconNewFromGicon                  ,


-- ** newFromIconName #method:newFromIconName#

    statusIconNewFromIconName               ,


-- ** newFromPixbuf #method:newFromPixbuf#

    statusIconNewFromPixbuf                 ,


-- ** newFromStock #method:newFromStock#

    statusIconNewFromStock                  ,


-- ** positionMenu #method:positionMenu#

    statusIconPositionMenu                  ,


-- ** setFromFile #method:setFromFile#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetFromFileMethodInfo         ,
#endif
    statusIconSetFromFile                   ,


-- ** setFromGicon #method:setFromGicon#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetFromGiconMethodInfo        ,
#endif
    statusIconSetFromGicon                  ,


-- ** setFromIconName #method:setFromIconName#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetFromIconNameMethodInfo     ,
#endif
    statusIconSetFromIconName               ,


-- ** setFromPixbuf #method:setFromPixbuf#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetFromPixbufMethodInfo       ,
#endif
    statusIconSetFromPixbuf                 ,


-- ** setFromStock #method:setFromStock#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetFromStockMethodInfo        ,
#endif
    statusIconSetFromStock                  ,


-- ** setHasTooltip #method:setHasTooltip#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetHasTooltipMethodInfo       ,
#endif
    statusIconSetHasTooltip                 ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetNameMethodInfo             ,
#endif
    statusIconSetName                       ,


-- ** setScreen #method:setScreen#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetScreenMethodInfo           ,
#endif
    statusIconSetScreen                     ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetTitleMethodInfo            ,
#endif
    statusIconSetTitle                      ,


-- ** setTooltipMarkup #method:setTooltipMarkup#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetTooltipMarkupMethodInfo    ,
#endif
    statusIconSetTooltipMarkup              ,


-- ** setTooltipText #method:setTooltipText#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetTooltipTextMethodInfo      ,
#endif
    statusIconSetTooltipText                ,


-- ** setVisible #method:setVisible#

#if defined(ENABLE_OVERLOADING)
    StatusIconSetVisibleMethodInfo          ,
#endif
    statusIconSetVisible                    ,




 -- * Properties
-- ** embedded #attr:embedded#
-- | 'P.True' if the statusicon is embedded in a notification area.
-- 
-- /Since: 2.12/

#if defined(ENABLE_OVERLOADING)
    StatusIconEmbeddedPropertyInfo          ,
#endif
    getStatusIconEmbedded                   ,
#if defined(ENABLE_OVERLOADING)
    statusIconEmbedded                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StatusIconFilePropertyInfo              ,
#endif
    clearStatusIconFile                     ,
    constructStatusIconFile                 ,
    setStatusIconFile                       ,
#if defined(ENABLE_OVERLOADING)
    statusIconFile                          ,
#endif


-- ** gicon #attr:gicon#
-- | The t'GI.Gio.Interfaces.Icon.Icon' displayed in the t'GI.Gtk.Objects.StatusIcon.StatusIcon'. For themed icons,
-- the image will be updated automatically if the theme changes.
-- 
-- /Since: 2.14/

#if defined(ENABLE_OVERLOADING)
    StatusIconGiconPropertyInfo             ,
#endif
    clearStatusIconGicon                    ,
    constructStatusIconGicon                ,
    getStatusIconGicon                      ,
    setStatusIconGicon                      ,
#if defined(ENABLE_OVERLOADING)
    statusIconGicon                         ,
#endif


-- ** hasTooltip #attr:hasTooltip#
-- | Enables or disables the emission of [queryTooltip]("GI.Gtk.Objects.StatusIcon#g:signal:queryTooltip") on
-- /@statusIcon@/.  A value of 'P.True' indicates that /@statusIcon@/ can have a
-- tooltip, in this case the status icon will be queried using
-- [queryTooltip]("GI.Gtk.Objects.StatusIcon#g:signal:queryTooltip") to determine whether it will provide a
-- tooltip or not.
-- 
-- Note that setting this property to 'P.True' for the first time will change
-- the event masks of the windows of this status icon to include leave-notify
-- and motion-notify events. This will not be undone when the property is set
-- to 'P.False' again.
-- 
-- Whether this property is respected is platform dependent.
-- For plain text tooltips, use t'GI.Gtk.Objects.StatusIcon.StatusIcon':@/tooltip-text/@ in preference.
-- 
-- /Since: 2.16/

#if defined(ENABLE_OVERLOADING)
    StatusIconHasTooltipPropertyInfo        ,
#endif
    constructStatusIconHasTooltip           ,
    getStatusIconHasTooltip                 ,
    setStatusIconHasTooltip                 ,
#if defined(ENABLE_OVERLOADING)
    statusIconHasTooltip                    ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StatusIconIconNamePropertyInfo          ,
#endif
    clearStatusIconIconName                 ,
    constructStatusIconIconName             ,
    getStatusIconIconName                   ,
    setStatusIconIconName                   ,
#if defined(ENABLE_OVERLOADING)
    statusIconIconName                      ,
#endif


-- ** orientation #attr:orientation#
-- | The orientation of the tray in which the statusicon
-- is embedded.
-- 
-- /Since: 2.12/

#if defined(ENABLE_OVERLOADING)
    StatusIconOrientationPropertyInfo       ,
#endif
    getStatusIconOrientation                ,
#if defined(ENABLE_OVERLOADING)
    statusIconOrientation                   ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StatusIconPixbufPropertyInfo            ,
#endif
    clearStatusIconPixbuf                   ,
    constructStatusIconPixbuf               ,
    getStatusIconPixbuf                     ,
    setStatusIconPixbuf                     ,
#if defined(ENABLE_OVERLOADING)
    statusIconPixbuf                        ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StatusIconScreenPropertyInfo            ,
#endif
    constructStatusIconScreen               ,
    getStatusIconScreen                     ,
    setStatusIconScreen                     ,
#if defined(ENABLE_OVERLOADING)
    statusIconScreen                        ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StatusIconSizePropertyInfo              ,
#endif
    getStatusIconSize                       ,
#if defined(ENABLE_OVERLOADING)
    statusIconSize                          ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StatusIconStockPropertyInfo             ,
#endif
    clearStatusIconStock                    ,
    constructStatusIconStock                ,
    getStatusIconStock                      ,
    setStatusIconStock                      ,
#if defined(ENABLE_OVERLOADING)
    statusIconStock                         ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StatusIconStorageTypePropertyInfo       ,
#endif
    getStatusIconStorageType                ,
#if defined(ENABLE_OVERLOADING)
    statusIconStorageType                   ,
#endif


-- ** title #attr:title#
-- | The title of this tray icon. This should be a short, human-readable,
-- localized string describing the tray icon. It may be used by tools
-- like screen readers to render the tray icon.
-- 
-- /Since: 2.18/

#if defined(ENABLE_OVERLOADING)
    StatusIconTitlePropertyInfo             ,
#endif
    constructStatusIconTitle                ,
    getStatusIconTitle                      ,
    setStatusIconTitle                      ,
#if defined(ENABLE_OVERLOADING)
    statusIconTitle                         ,
#endif


-- ** tooltipMarkup #attr:tooltipMarkup#
-- | Sets the text of tooltip to be the given string, which is marked up
-- with the [Pango text markup language][PangoMarkupFormat].
-- Also see 'GI.Gtk.Objects.Tooltip.tooltipSetMarkup'.
-- 
-- This is a convenience property which will take care of getting the
-- tooltip shown if the given string is not 'P.Nothing'.
-- t'GI.Gtk.Objects.StatusIcon.StatusIcon':@/has-tooltip/@ will automatically be set to 'P.True' and
-- the default handler for the [queryTooltip]("GI.Gtk.Objects.StatusIcon#g:signal:queryTooltip") signal
-- will take care of displaying the tooltip.
-- 
-- On some platforms, embedded markup will be ignored.
-- 
-- /Since: 2.16/

#if defined(ENABLE_OVERLOADING)
    StatusIconTooltipMarkupPropertyInfo     ,
#endif
    clearStatusIconTooltipMarkup            ,
    constructStatusIconTooltipMarkup        ,
    getStatusIconTooltipMarkup              ,
    setStatusIconTooltipMarkup              ,
#if defined(ENABLE_OVERLOADING)
    statusIconTooltipMarkup                 ,
#endif


-- ** tooltipText #attr:tooltipText#
-- | Sets the text of tooltip to be the given string.
-- 
-- Also see 'GI.Gtk.Objects.Tooltip.tooltipSetText'.
-- 
-- This is a convenience property which will take care of getting the
-- tooltip shown if the given string is not 'P.Nothing'.
-- t'GI.Gtk.Objects.StatusIcon.StatusIcon':@/has-tooltip/@ will automatically be set to 'P.True' and
-- the default handler for the [queryTooltip]("GI.Gtk.Objects.StatusIcon#g:signal:queryTooltip") signal
-- will take care of displaying the tooltip.
-- 
-- Note that some platforms have limitations on the length of tooltips
-- that they allow on status icons, e.g. Windows only shows the first
-- 64 characters.
-- 
-- /Since: 2.16/

#if defined(ENABLE_OVERLOADING)
    StatusIconTooltipTextPropertyInfo       ,
#endif
    constructStatusIconTooltipText          ,
    getStatusIconTooltipText                ,
    setStatusIconTooltipText                ,
#if defined(ENABLE_OVERLOADING)
    statusIconTooltipText                   ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StatusIconVisiblePropertyInfo           ,
#endif
    constructStatusIconVisible              ,
    getStatusIconVisible                    ,
    setStatusIconVisible                    ,
#if defined(ENABLE_OVERLOADING)
    statusIconVisible                       ,
#endif




 -- * Signals
-- ** activate #signal:activate#

    C_StatusIconActivateCallback            ,
    StatusIconActivateCallback              ,
#if defined(ENABLE_OVERLOADING)
    StatusIconActivateSignalInfo            ,
#endif
    afterStatusIconActivate                 ,
    genClosure_StatusIconActivate           ,
    mk_StatusIconActivateCallback           ,
    noStatusIconActivateCallback            ,
    onStatusIconActivate                    ,
    wrap_StatusIconActivateCallback         ,


-- ** buttonPressEvent #signal:buttonPressEvent#

    C_StatusIconButtonPressEventCallback    ,
    StatusIconButtonPressEventCallback      ,
#if defined(ENABLE_OVERLOADING)
    StatusIconButtonPressEventSignalInfo    ,
#endif
    afterStatusIconButtonPressEvent         ,
    genClosure_StatusIconButtonPressEvent   ,
    mk_StatusIconButtonPressEventCallback   ,
    noStatusIconButtonPressEventCallback    ,
    onStatusIconButtonPressEvent            ,
    wrap_StatusIconButtonPressEventCallback ,


-- ** buttonReleaseEvent #signal:buttonReleaseEvent#

    C_StatusIconButtonReleaseEventCallback  ,
    StatusIconButtonReleaseEventCallback    ,
#if defined(ENABLE_OVERLOADING)
    StatusIconButtonReleaseEventSignalInfo  ,
#endif
    afterStatusIconButtonReleaseEvent       ,
    genClosure_StatusIconButtonReleaseEvent ,
    mk_StatusIconButtonReleaseEventCallback ,
    noStatusIconButtonReleaseEventCallback  ,
    onStatusIconButtonReleaseEvent          ,
    wrap_StatusIconButtonReleaseEventCallback,


-- ** popupMenu #signal:popupMenu#

    C_StatusIconPopupMenuCallback           ,
    StatusIconPopupMenuCallback             ,
#if defined(ENABLE_OVERLOADING)
    StatusIconPopupMenuSignalInfo           ,
#endif
    afterStatusIconPopupMenu                ,
    genClosure_StatusIconPopupMenu          ,
    mk_StatusIconPopupMenuCallback          ,
    noStatusIconPopupMenuCallback           ,
    onStatusIconPopupMenu                   ,
    wrap_StatusIconPopupMenuCallback        ,


-- ** queryTooltip #signal:queryTooltip#

    C_StatusIconQueryTooltipCallback        ,
    StatusIconQueryTooltipCallback          ,
#if defined(ENABLE_OVERLOADING)
    StatusIconQueryTooltipSignalInfo        ,
#endif
    afterStatusIconQueryTooltip             ,
    genClosure_StatusIconQueryTooltip       ,
    mk_StatusIconQueryTooltipCallback       ,
    noStatusIconQueryTooltipCallback        ,
    onStatusIconQueryTooltip                ,
    wrap_StatusIconQueryTooltipCallback     ,


-- ** scrollEvent #signal:scrollEvent#

    C_StatusIconScrollEventCallback         ,
    StatusIconScrollEventCallback           ,
#if defined(ENABLE_OVERLOADING)
    StatusIconScrollEventSignalInfo         ,
#endif
    afterStatusIconScrollEvent              ,
    genClosure_StatusIconScrollEvent        ,
    mk_StatusIconScrollEventCallback        ,
    noStatusIconScrollEventCallback         ,
    onStatusIconScrollEvent                 ,
    wrap_StatusIconScrollEventCallback      ,


-- ** sizeChanged #signal:sizeChanged#

    C_StatusIconSizeChangedCallback         ,
    StatusIconSizeChangedCallback           ,
#if defined(ENABLE_OVERLOADING)
    StatusIconSizeChangedSignalInfo         ,
#endif
    afterStatusIconSizeChanged              ,
    genClosure_StatusIconSizeChanged        ,
    mk_StatusIconSizeChangedCallback        ,
    noStatusIconSizeChangedCallback         ,
    onStatusIconSizeChanged                 ,
    wrap_StatusIconSizeChangedCallback      ,




    ) 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.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 qualified GI.Gdk.Objects.Screen as Gdk.Screen
import qualified GI.Gdk.Structs.EventButton as Gdk.EventButton
import qualified GI.Gdk.Structs.EventScroll as Gdk.EventScroll
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Objects.Menu as Gtk.Menu
import {-# SOURCE #-} qualified GI.Gtk.Objects.Tooltip as Gtk.Tooltip

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

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

foreign import ccall "gtk_status_icon_get_type"
    c_gtk_status_icon_get_type :: IO B.Types.GType

instance B.Types.TypedObject StatusIcon where
    glibType :: IO GType
glibType = IO GType
c_gtk_status_icon_get_type

instance B.Types.GObject StatusIcon

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveStatusIconMethod (t :: Symbol) (o :: *) :: * where
    ResolveStatusIconMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveStatusIconMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveStatusIconMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveStatusIconMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveStatusIconMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveStatusIconMethod "isEmbedded" o = StatusIconIsEmbeddedMethodInfo
    ResolveStatusIconMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveStatusIconMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveStatusIconMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveStatusIconMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveStatusIconMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveStatusIconMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveStatusIconMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveStatusIconMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveStatusIconMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveStatusIconMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveStatusIconMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveStatusIconMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveStatusIconMethod "getGeometry" o = StatusIconGetGeometryMethodInfo
    ResolveStatusIconMethod "getGicon" o = StatusIconGetGiconMethodInfo
    ResolveStatusIconMethod "getHasTooltip" o = StatusIconGetHasTooltipMethodInfo
    ResolveStatusIconMethod "getIconName" o = StatusIconGetIconNameMethodInfo
    ResolveStatusIconMethod "getPixbuf" o = StatusIconGetPixbufMethodInfo
    ResolveStatusIconMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveStatusIconMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveStatusIconMethod "getScreen" o = StatusIconGetScreenMethodInfo
    ResolveStatusIconMethod "getSize" o = StatusIconGetSizeMethodInfo
    ResolveStatusIconMethod "getStock" o = StatusIconGetStockMethodInfo
    ResolveStatusIconMethod "getStorageType" o = StatusIconGetStorageTypeMethodInfo
    ResolveStatusIconMethod "getTitle" o = StatusIconGetTitleMethodInfo
    ResolveStatusIconMethod "getTooltipMarkup" o = StatusIconGetTooltipMarkupMethodInfo
    ResolveStatusIconMethod "getTooltipText" o = StatusIconGetTooltipTextMethodInfo
    ResolveStatusIconMethod "getVisible" o = StatusIconGetVisibleMethodInfo
    ResolveStatusIconMethod "getX11WindowId" o = StatusIconGetX11WindowIdMethodInfo
    ResolveStatusIconMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveStatusIconMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveStatusIconMethod "setFromFile" o = StatusIconSetFromFileMethodInfo
    ResolveStatusIconMethod "setFromGicon" o = StatusIconSetFromGiconMethodInfo
    ResolveStatusIconMethod "setFromIconName" o = StatusIconSetFromIconNameMethodInfo
    ResolveStatusIconMethod "setFromPixbuf" o = StatusIconSetFromPixbufMethodInfo
    ResolveStatusIconMethod "setFromStock" o = StatusIconSetFromStockMethodInfo
    ResolveStatusIconMethod "setHasTooltip" o = StatusIconSetHasTooltipMethodInfo
    ResolveStatusIconMethod "setName" o = StatusIconSetNameMethodInfo
    ResolveStatusIconMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveStatusIconMethod "setScreen" o = StatusIconSetScreenMethodInfo
    ResolveStatusIconMethod "setTitle" o = StatusIconSetTitleMethodInfo
    ResolveStatusIconMethod "setTooltipMarkup" o = StatusIconSetTooltipMarkupMethodInfo
    ResolveStatusIconMethod "setTooltipText" o = StatusIconSetTooltipTextMethodInfo
    ResolveStatusIconMethod "setVisible" o = StatusIconSetVisibleMethodInfo
    ResolveStatusIconMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal StatusIcon::activate
-- | Gets emitted when the user activates the status icon.
-- If and how status icons can activated is platform-dependent.
-- 
-- Unlike most G_SIGNAL_ACTION signals, this signal is meant to
-- be used by applications and should be wrapped by language bindings.
-- 
-- /Since: 2.10/
type StatusIconActivateCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `StatusIconActivateCallback`@.
noStatusIconActivateCallback :: Maybe StatusIconActivateCallback
noStatusIconActivateCallback :: Maybe (IO ())
noStatusIconActivateCallback = Maybe (IO ())
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_StatusIconActivate :: MonadIO m => StatusIconActivateCallback -> m (GClosure C_StatusIconActivateCallback)
genClosure_StatusIconActivate :: IO () -> m (GClosure C_StatusIconActivateCallback)
genClosure_StatusIconActivate IO ()
cb = IO (GClosure C_StatusIconActivateCallback)
-> m (GClosure C_StatusIconActivateCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_StatusIconActivateCallback)
 -> m (GClosure C_StatusIconActivateCallback))
-> IO (GClosure C_StatusIconActivateCallback)
-> m (GClosure C_StatusIconActivateCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconActivateCallback
cb' = IO () -> C_StatusIconActivateCallback
wrap_StatusIconActivateCallback IO ()
cb
    C_StatusIconActivateCallback
-> IO (FunPtr C_StatusIconActivateCallback)
mk_StatusIconActivateCallback C_StatusIconActivateCallback
cb' IO (FunPtr C_StatusIconActivateCallback)
-> (FunPtr C_StatusIconActivateCallback
    -> IO (GClosure C_StatusIconActivateCallback))
-> IO (GClosure C_StatusIconActivateCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_StatusIconActivateCallback
-> IO (GClosure C_StatusIconActivateCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `StatusIconActivateCallback` into a `C_StatusIconActivateCallback`.
wrap_StatusIconActivateCallback ::
    StatusIconActivateCallback ->
    C_StatusIconActivateCallback
wrap_StatusIconActivateCallback :: IO () -> C_StatusIconActivateCallback
wrap_StatusIconActivateCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [activate](#signal:activate) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' statusIcon #activate callback
-- @
-- 
-- 
onStatusIconActivate :: (IsStatusIcon a, MonadIO m) => a -> StatusIconActivateCallback -> m SignalHandlerId
onStatusIconActivate :: a -> IO () -> m SignalHandlerId
onStatusIconActivate a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconActivateCallback
cb' = IO () -> C_StatusIconActivateCallback
wrap_StatusIconActivateCallback IO ()
cb
    FunPtr C_StatusIconActivateCallback
cb'' <- C_StatusIconActivateCallback
-> IO (FunPtr C_StatusIconActivateCallback)
mk_StatusIconActivateCallback C_StatusIconActivateCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"activate" FunPtr C_StatusIconActivateCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [activate](#signal:activate) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' statusIcon #activate callback
-- @
-- 
-- 
afterStatusIconActivate :: (IsStatusIcon a, MonadIO m) => a -> StatusIconActivateCallback -> m SignalHandlerId
afterStatusIconActivate :: a -> IO () -> m SignalHandlerId
afterStatusIconActivate a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconActivateCallback
cb' = IO () -> C_StatusIconActivateCallback
wrap_StatusIconActivateCallback IO ()
cb
    FunPtr C_StatusIconActivateCallback
cb'' <- C_StatusIconActivateCallback
-> IO (FunPtr C_StatusIconActivateCallback)
mk_StatusIconActivateCallback C_StatusIconActivateCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"activate" FunPtr C_StatusIconActivateCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data StatusIconActivateSignalInfo
instance SignalInfo StatusIconActivateSignalInfo where
    type HaskellCallbackType StatusIconActivateSignalInfo = StatusIconActivateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_StatusIconActivateCallback cb
        cb'' <- mk_StatusIconActivateCallback cb'
        connectSignalFunPtr obj "activate" cb'' connectMode detail

#endif

-- signal StatusIcon::button-press-event
-- | The [buttonPressEvent](#g:signal:buttonPressEvent) signal will be emitted when a button
-- (typically from a mouse) is pressed.
-- 
-- Whether this event is emitted is platform-dependent.  Use the [activate](#g:signal:activate)
-- and [popupMenu](#g:signal:popupMenu) signals in preference.
-- 
-- /Since: 2.14/
type StatusIconButtonPressEventCallback =
    Gdk.EventButton.EventButton
    -- ^ /@event@/: the t'GI.Gdk.Structs.EventButton.EventButton' which triggered
    --                                 this signal
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to stop other handlers from being invoked
    -- for the event. 'P.False' to propagate the event further.

-- | A convenience synonym for @`Nothing` :: `Maybe` `StatusIconButtonPressEventCallback`@.
noStatusIconButtonPressEventCallback :: Maybe StatusIconButtonPressEventCallback
noStatusIconButtonPressEventCallback :: Maybe StatusIconButtonPressEventCallback
noStatusIconButtonPressEventCallback = Maybe StatusIconButtonPressEventCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_StatusIconButtonPressEvent :: MonadIO m => StatusIconButtonPressEventCallback -> m (GClosure C_StatusIconButtonPressEventCallback)
genClosure_StatusIconButtonPressEvent :: StatusIconButtonPressEventCallback
-> m (GClosure C_StatusIconButtonPressEventCallback)
genClosure_StatusIconButtonPressEvent StatusIconButtonPressEventCallback
cb = IO (GClosure C_StatusIconButtonPressEventCallback)
-> m (GClosure C_StatusIconButtonPressEventCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_StatusIconButtonPressEventCallback)
 -> m (GClosure C_StatusIconButtonPressEventCallback))
-> IO (GClosure C_StatusIconButtonPressEventCallback)
-> m (GClosure C_StatusIconButtonPressEventCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconButtonPressEventCallback
cb' = StatusIconButtonPressEventCallback
-> C_StatusIconButtonPressEventCallback
wrap_StatusIconButtonPressEventCallback StatusIconButtonPressEventCallback
cb
    C_StatusIconButtonPressEventCallback
-> IO (FunPtr C_StatusIconButtonPressEventCallback)
mk_StatusIconButtonPressEventCallback C_StatusIconButtonPressEventCallback
cb' IO (FunPtr C_StatusIconButtonPressEventCallback)
-> (FunPtr C_StatusIconButtonPressEventCallback
    -> IO (GClosure C_StatusIconButtonPressEventCallback))
-> IO (GClosure C_StatusIconButtonPressEventCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_StatusIconButtonPressEventCallback
-> IO (GClosure C_StatusIconButtonPressEventCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `StatusIconButtonPressEventCallback` into a `C_StatusIconButtonPressEventCallback`.
wrap_StatusIconButtonPressEventCallback ::
    StatusIconButtonPressEventCallback ->
    C_StatusIconButtonPressEventCallback
wrap_StatusIconButtonPressEventCallback :: StatusIconButtonPressEventCallback
-> C_StatusIconButtonPressEventCallback
wrap_StatusIconButtonPressEventCallback StatusIconButtonPressEventCallback
_cb Ptr ()
_ Ptr EventButton
event Ptr ()
_ = do
    EventButton
event' <- ((ManagedPtr EventButton -> EventButton)
-> Ptr EventButton -> IO EventButton
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr EventButton -> EventButton
Gdk.EventButton.EventButton) Ptr EventButton
event
    Bool
result <- StatusIconButtonPressEventCallback
_cb  EventButton
event'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [buttonPressEvent](#signal:buttonPressEvent) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' statusIcon #buttonPressEvent callback
-- @
-- 
-- 
onStatusIconButtonPressEvent :: (IsStatusIcon a, MonadIO m) => a -> StatusIconButtonPressEventCallback -> m SignalHandlerId
onStatusIconButtonPressEvent :: a -> StatusIconButtonPressEventCallback -> m SignalHandlerId
onStatusIconButtonPressEvent a
obj StatusIconButtonPressEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconButtonPressEventCallback
cb' = StatusIconButtonPressEventCallback
-> C_StatusIconButtonPressEventCallback
wrap_StatusIconButtonPressEventCallback StatusIconButtonPressEventCallback
cb
    FunPtr C_StatusIconButtonPressEventCallback
cb'' <- C_StatusIconButtonPressEventCallback
-> IO (FunPtr C_StatusIconButtonPressEventCallback)
mk_StatusIconButtonPressEventCallback C_StatusIconButtonPressEventCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconButtonPressEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"button-press-event" FunPtr C_StatusIconButtonPressEventCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [buttonPressEvent](#signal:buttonPressEvent) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' statusIcon #buttonPressEvent callback
-- @
-- 
-- 
afterStatusIconButtonPressEvent :: (IsStatusIcon a, MonadIO m) => a -> StatusIconButtonPressEventCallback -> m SignalHandlerId
afterStatusIconButtonPressEvent :: a -> StatusIconButtonPressEventCallback -> m SignalHandlerId
afterStatusIconButtonPressEvent a
obj StatusIconButtonPressEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconButtonPressEventCallback
cb' = StatusIconButtonPressEventCallback
-> C_StatusIconButtonPressEventCallback
wrap_StatusIconButtonPressEventCallback StatusIconButtonPressEventCallback
cb
    FunPtr C_StatusIconButtonPressEventCallback
cb'' <- C_StatusIconButtonPressEventCallback
-> IO (FunPtr C_StatusIconButtonPressEventCallback)
mk_StatusIconButtonPressEventCallback C_StatusIconButtonPressEventCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconButtonPressEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"button-press-event" FunPtr C_StatusIconButtonPressEventCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data StatusIconButtonPressEventSignalInfo
instance SignalInfo StatusIconButtonPressEventSignalInfo where
    type HaskellCallbackType StatusIconButtonPressEventSignalInfo = StatusIconButtonPressEventCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_StatusIconButtonPressEventCallback cb
        cb'' <- mk_StatusIconButtonPressEventCallback cb'
        connectSignalFunPtr obj "button-press-event" cb'' connectMode detail

#endif

-- signal StatusIcon::button-release-event
-- | The [buttonReleaseEvent](#g:signal:buttonReleaseEvent) signal will be emitted when a button
-- (typically from a mouse) is released.
-- 
-- Whether this event is emitted is platform-dependent.  Use the [activate](#g:signal:activate)
-- and [popupMenu](#g:signal:popupMenu) signals in preference.
-- 
-- /Since: 2.14/
type StatusIconButtonReleaseEventCallback =
    Gdk.EventButton.EventButton
    -- ^ /@event@/: the t'GI.Gdk.Structs.EventButton.EventButton' which triggered
    --                                 this signal
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to stop other handlers from being invoked
    -- for the event. 'P.False' to propagate the event further.

-- | A convenience synonym for @`Nothing` :: `Maybe` `StatusIconButtonReleaseEventCallback`@.
noStatusIconButtonReleaseEventCallback :: Maybe StatusIconButtonReleaseEventCallback
noStatusIconButtonReleaseEventCallback :: Maybe StatusIconButtonPressEventCallback
noStatusIconButtonReleaseEventCallback = Maybe StatusIconButtonPressEventCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_StatusIconButtonReleaseEvent :: MonadIO m => StatusIconButtonReleaseEventCallback -> m (GClosure C_StatusIconButtonReleaseEventCallback)
genClosure_StatusIconButtonReleaseEvent :: StatusIconButtonPressEventCallback
-> m (GClosure C_StatusIconButtonPressEventCallback)
genClosure_StatusIconButtonReleaseEvent StatusIconButtonPressEventCallback
cb = IO (GClosure C_StatusIconButtonPressEventCallback)
-> m (GClosure C_StatusIconButtonPressEventCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_StatusIconButtonPressEventCallback)
 -> m (GClosure C_StatusIconButtonPressEventCallback))
-> IO (GClosure C_StatusIconButtonPressEventCallback)
-> m (GClosure C_StatusIconButtonPressEventCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconButtonPressEventCallback
cb' = StatusIconButtonPressEventCallback
-> C_StatusIconButtonPressEventCallback
wrap_StatusIconButtonReleaseEventCallback StatusIconButtonPressEventCallback
cb
    C_StatusIconButtonPressEventCallback
-> IO (FunPtr C_StatusIconButtonPressEventCallback)
mk_StatusIconButtonReleaseEventCallback C_StatusIconButtonPressEventCallback
cb' IO (FunPtr C_StatusIconButtonPressEventCallback)
-> (FunPtr C_StatusIconButtonPressEventCallback
    -> IO (GClosure C_StatusIconButtonPressEventCallback))
-> IO (GClosure C_StatusIconButtonPressEventCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_StatusIconButtonPressEventCallback
-> IO (GClosure C_StatusIconButtonPressEventCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `StatusIconButtonReleaseEventCallback` into a `C_StatusIconButtonReleaseEventCallback`.
wrap_StatusIconButtonReleaseEventCallback ::
    StatusIconButtonReleaseEventCallback ->
    C_StatusIconButtonReleaseEventCallback
wrap_StatusIconButtonReleaseEventCallback :: StatusIconButtonPressEventCallback
-> C_StatusIconButtonPressEventCallback
wrap_StatusIconButtonReleaseEventCallback StatusIconButtonPressEventCallback
_cb Ptr ()
_ Ptr EventButton
event Ptr ()
_ = do
    EventButton
event' <- ((ManagedPtr EventButton -> EventButton)
-> Ptr EventButton -> IO EventButton
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr EventButton -> EventButton
Gdk.EventButton.EventButton) Ptr EventButton
event
    Bool
result <- StatusIconButtonPressEventCallback
_cb  EventButton
event'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [buttonReleaseEvent](#signal:buttonReleaseEvent) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' statusIcon #buttonReleaseEvent callback
-- @
-- 
-- 
onStatusIconButtonReleaseEvent :: (IsStatusIcon a, MonadIO m) => a -> StatusIconButtonReleaseEventCallback -> m SignalHandlerId
onStatusIconButtonReleaseEvent :: a -> StatusIconButtonPressEventCallback -> m SignalHandlerId
onStatusIconButtonReleaseEvent a
obj StatusIconButtonPressEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconButtonPressEventCallback
cb' = StatusIconButtonPressEventCallback
-> C_StatusIconButtonPressEventCallback
wrap_StatusIconButtonReleaseEventCallback StatusIconButtonPressEventCallback
cb
    FunPtr C_StatusIconButtonPressEventCallback
cb'' <- C_StatusIconButtonPressEventCallback
-> IO (FunPtr C_StatusIconButtonPressEventCallback)
mk_StatusIconButtonReleaseEventCallback C_StatusIconButtonPressEventCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconButtonPressEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"button-release-event" FunPtr C_StatusIconButtonPressEventCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [buttonReleaseEvent](#signal:buttonReleaseEvent) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' statusIcon #buttonReleaseEvent callback
-- @
-- 
-- 
afterStatusIconButtonReleaseEvent :: (IsStatusIcon a, MonadIO m) => a -> StatusIconButtonReleaseEventCallback -> m SignalHandlerId
afterStatusIconButtonReleaseEvent :: a -> StatusIconButtonPressEventCallback -> m SignalHandlerId
afterStatusIconButtonReleaseEvent a
obj StatusIconButtonPressEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconButtonPressEventCallback
cb' = StatusIconButtonPressEventCallback
-> C_StatusIconButtonPressEventCallback
wrap_StatusIconButtonReleaseEventCallback StatusIconButtonPressEventCallback
cb
    FunPtr C_StatusIconButtonPressEventCallback
cb'' <- C_StatusIconButtonPressEventCallback
-> IO (FunPtr C_StatusIconButtonPressEventCallback)
mk_StatusIconButtonReleaseEventCallback C_StatusIconButtonPressEventCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconButtonPressEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"button-release-event" FunPtr C_StatusIconButtonPressEventCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data StatusIconButtonReleaseEventSignalInfo
instance SignalInfo StatusIconButtonReleaseEventSignalInfo where
    type HaskellCallbackType StatusIconButtonReleaseEventSignalInfo = StatusIconButtonReleaseEventCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_StatusIconButtonReleaseEventCallback cb
        cb'' <- mk_StatusIconButtonReleaseEventCallback cb'
        connectSignalFunPtr obj "button-release-event" cb'' connectMode detail

#endif

-- signal StatusIcon::popup-menu
-- | Gets emitted when the user brings up the context menu
-- of the status icon. Whether status icons can have context
-- menus and how these are activated is platform-dependent.
-- 
-- The /@button@/ and /@activateTime@/ parameters should be
-- passed as the last to arguments to 'GI.Gtk.Objects.Menu.menuPopup'.
-- 
-- Unlike most G_SIGNAL_ACTION signals, this signal is meant to
-- be used by applications and should be wrapped by language bindings.
-- 
-- /Since: 2.10/
type StatusIconPopupMenuCallback =
    Word32
    -- ^ /@button@/: the button that was pressed, or 0 if the
    --   signal is not emitted in response to a button press event
    -> Word32
    -- ^ /@activateTime@/: the timestamp of the event that
    --   triggered the signal emission
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `StatusIconPopupMenuCallback`@.
noStatusIconPopupMenuCallback :: Maybe StatusIconPopupMenuCallback
noStatusIconPopupMenuCallback :: Maybe StatusIconPopupMenuCallback
noStatusIconPopupMenuCallback = Maybe StatusIconPopupMenuCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_StatusIconPopupMenu :: MonadIO m => StatusIconPopupMenuCallback -> m (GClosure C_StatusIconPopupMenuCallback)
genClosure_StatusIconPopupMenu :: StatusIconPopupMenuCallback
-> m (GClosure C_StatusIconPopupMenuCallback)
genClosure_StatusIconPopupMenu StatusIconPopupMenuCallback
cb = IO (GClosure C_StatusIconPopupMenuCallback)
-> m (GClosure C_StatusIconPopupMenuCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_StatusIconPopupMenuCallback)
 -> m (GClosure C_StatusIconPopupMenuCallback))
-> IO (GClosure C_StatusIconPopupMenuCallback)
-> m (GClosure C_StatusIconPopupMenuCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconPopupMenuCallback
cb' = StatusIconPopupMenuCallback -> C_StatusIconPopupMenuCallback
wrap_StatusIconPopupMenuCallback StatusIconPopupMenuCallback
cb
    C_StatusIconPopupMenuCallback
-> IO (FunPtr C_StatusIconPopupMenuCallback)
mk_StatusIconPopupMenuCallback C_StatusIconPopupMenuCallback
cb' IO (FunPtr C_StatusIconPopupMenuCallback)
-> (FunPtr C_StatusIconPopupMenuCallback
    -> IO (GClosure C_StatusIconPopupMenuCallback))
-> IO (GClosure C_StatusIconPopupMenuCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_StatusIconPopupMenuCallback
-> IO (GClosure C_StatusIconPopupMenuCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `StatusIconPopupMenuCallback` into a `C_StatusIconPopupMenuCallback`.
wrap_StatusIconPopupMenuCallback ::
    StatusIconPopupMenuCallback ->
    C_StatusIconPopupMenuCallback
wrap_StatusIconPopupMenuCallback :: StatusIconPopupMenuCallback -> C_StatusIconPopupMenuCallback
wrap_StatusIconPopupMenuCallback StatusIconPopupMenuCallback
_cb Ptr ()
_ Word32
button Word32
activateTime Ptr ()
_ = do
    StatusIconPopupMenuCallback
_cb  Word32
button Word32
activateTime


-- | Connect a signal handler for the [popupMenu](#signal:popupMenu) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' statusIcon #popupMenu callback
-- @
-- 
-- 
onStatusIconPopupMenu :: (IsStatusIcon a, MonadIO m) => a -> StatusIconPopupMenuCallback -> m SignalHandlerId
onStatusIconPopupMenu :: a -> StatusIconPopupMenuCallback -> m SignalHandlerId
onStatusIconPopupMenu a
obj StatusIconPopupMenuCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconPopupMenuCallback
cb' = StatusIconPopupMenuCallback -> C_StatusIconPopupMenuCallback
wrap_StatusIconPopupMenuCallback StatusIconPopupMenuCallback
cb
    FunPtr C_StatusIconPopupMenuCallback
cb'' <- C_StatusIconPopupMenuCallback
-> IO (FunPtr C_StatusIconPopupMenuCallback)
mk_StatusIconPopupMenuCallback C_StatusIconPopupMenuCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconPopupMenuCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"popup-menu" FunPtr C_StatusIconPopupMenuCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [popupMenu](#signal:popupMenu) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' statusIcon #popupMenu callback
-- @
-- 
-- 
afterStatusIconPopupMenu :: (IsStatusIcon a, MonadIO m) => a -> StatusIconPopupMenuCallback -> m SignalHandlerId
afterStatusIconPopupMenu :: a -> StatusIconPopupMenuCallback -> m SignalHandlerId
afterStatusIconPopupMenu a
obj StatusIconPopupMenuCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconPopupMenuCallback
cb' = StatusIconPopupMenuCallback -> C_StatusIconPopupMenuCallback
wrap_StatusIconPopupMenuCallback StatusIconPopupMenuCallback
cb
    FunPtr C_StatusIconPopupMenuCallback
cb'' <- C_StatusIconPopupMenuCallback
-> IO (FunPtr C_StatusIconPopupMenuCallback)
mk_StatusIconPopupMenuCallback C_StatusIconPopupMenuCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconPopupMenuCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"popup-menu" FunPtr C_StatusIconPopupMenuCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data StatusIconPopupMenuSignalInfo
instance SignalInfo StatusIconPopupMenuSignalInfo where
    type HaskellCallbackType StatusIconPopupMenuSignalInfo = StatusIconPopupMenuCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_StatusIconPopupMenuCallback cb
        cb'' <- mk_StatusIconPopupMenuCallback cb'
        connectSignalFunPtr obj "popup-menu" cb'' connectMode detail

#endif

-- signal StatusIcon::query-tooltip
-- | Emitted when the hover timeout has expired with the
-- cursor hovering above /@statusIcon@/; or emitted when /@statusIcon@/ got
-- focus in keyboard mode.
-- 
-- Using the given coordinates, the signal handler should determine
-- whether a tooltip should be shown for /@statusIcon@/. If this is
-- the case 'P.True' should be returned, 'P.False' otherwise. Note that if
-- /@keyboardMode@/ is 'P.True', the values of /@x@/ and /@y@/ are undefined and
-- should not be used.
-- 
-- The signal handler is free to manipulate /@tooltip@/ with the therefore
-- destined function calls.
-- 
-- Whether this signal is emitted is platform-dependent.
-- For plain text tooltips, use t'GI.Gtk.Objects.StatusIcon.StatusIcon':@/tooltip-text/@ in preference.
-- 
-- /Since: 2.16/
type StatusIconQueryTooltipCallback =
    Int32
    -- ^ /@x@/: the x coordinate of the cursor position where the request has been
    --     emitted, relative to /@statusIcon@/
    -> Int32
    -- ^ /@y@/: the y coordinate of the cursor position where the request has been
    --     emitted, relative to /@statusIcon@/
    -> Bool
    -- ^ /@keyboardMode@/: 'P.True' if the tooltip was trigged using the keyboard
    -> Gtk.Tooltip.Tooltip
    -- ^ /@tooltip@/: a t'GI.Gtk.Objects.Tooltip.Tooltip'
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if /@tooltip@/ should be shown right now, 'P.False' otherwise.

-- | A convenience synonym for @`Nothing` :: `Maybe` `StatusIconQueryTooltipCallback`@.
noStatusIconQueryTooltipCallback :: Maybe StatusIconQueryTooltipCallback
noStatusIconQueryTooltipCallback :: Maybe StatusIconQueryTooltipCallback
noStatusIconQueryTooltipCallback = Maybe StatusIconQueryTooltipCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_StatusIconQueryTooltip :: MonadIO m => StatusIconQueryTooltipCallback -> m (GClosure C_StatusIconQueryTooltipCallback)
genClosure_StatusIconQueryTooltip :: StatusIconQueryTooltipCallback
-> m (GClosure C_StatusIconQueryTooltipCallback)
genClosure_StatusIconQueryTooltip StatusIconQueryTooltipCallback
cb = IO (GClosure C_StatusIconQueryTooltipCallback)
-> m (GClosure C_StatusIconQueryTooltipCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_StatusIconQueryTooltipCallback)
 -> m (GClosure C_StatusIconQueryTooltipCallback))
-> IO (GClosure C_StatusIconQueryTooltipCallback)
-> m (GClosure C_StatusIconQueryTooltipCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconQueryTooltipCallback
cb' = StatusIconQueryTooltipCallback -> C_StatusIconQueryTooltipCallback
wrap_StatusIconQueryTooltipCallback StatusIconQueryTooltipCallback
cb
    C_StatusIconQueryTooltipCallback
-> IO (FunPtr C_StatusIconQueryTooltipCallback)
mk_StatusIconQueryTooltipCallback C_StatusIconQueryTooltipCallback
cb' IO (FunPtr C_StatusIconQueryTooltipCallback)
-> (FunPtr C_StatusIconQueryTooltipCallback
    -> IO (GClosure C_StatusIconQueryTooltipCallback))
-> IO (GClosure C_StatusIconQueryTooltipCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_StatusIconQueryTooltipCallback
-> IO (GClosure C_StatusIconQueryTooltipCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `StatusIconQueryTooltipCallback` into a `C_StatusIconQueryTooltipCallback`.
wrap_StatusIconQueryTooltipCallback ::
    StatusIconQueryTooltipCallback ->
    C_StatusIconQueryTooltipCallback
wrap_StatusIconQueryTooltipCallback :: StatusIconQueryTooltipCallback -> C_StatusIconQueryTooltipCallback
wrap_StatusIconQueryTooltipCallback StatusIconQueryTooltipCallback
_cb Ptr ()
_ Int32
x Int32
y CInt
keyboardMode Ptr Tooltip
tooltip Ptr ()
_ = do
    let keyboardMode' :: Bool
keyboardMode' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
keyboardMode
    Tooltip
tooltip' <- ((ManagedPtr Tooltip -> Tooltip) -> Ptr Tooltip -> IO Tooltip
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Tooltip -> Tooltip
Gtk.Tooltip.Tooltip) Ptr Tooltip
tooltip
    Bool
result <- StatusIconQueryTooltipCallback
_cb  Int32
x Int32
y Bool
keyboardMode' Tooltip
tooltip'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [queryTooltip](#signal:queryTooltip) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' statusIcon #queryTooltip callback
-- @
-- 
-- 
onStatusIconQueryTooltip :: (IsStatusIcon a, MonadIO m) => a -> StatusIconQueryTooltipCallback -> m SignalHandlerId
onStatusIconQueryTooltip :: a -> StatusIconQueryTooltipCallback -> m SignalHandlerId
onStatusIconQueryTooltip a
obj StatusIconQueryTooltipCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconQueryTooltipCallback
cb' = StatusIconQueryTooltipCallback -> C_StatusIconQueryTooltipCallback
wrap_StatusIconQueryTooltipCallback StatusIconQueryTooltipCallback
cb
    FunPtr C_StatusIconQueryTooltipCallback
cb'' <- C_StatusIconQueryTooltipCallback
-> IO (FunPtr C_StatusIconQueryTooltipCallback)
mk_StatusIconQueryTooltipCallback C_StatusIconQueryTooltipCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconQueryTooltipCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"query-tooltip" FunPtr C_StatusIconQueryTooltipCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [queryTooltip](#signal:queryTooltip) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' statusIcon #queryTooltip callback
-- @
-- 
-- 
afterStatusIconQueryTooltip :: (IsStatusIcon a, MonadIO m) => a -> StatusIconQueryTooltipCallback -> m SignalHandlerId
afterStatusIconQueryTooltip :: a -> StatusIconQueryTooltipCallback -> m SignalHandlerId
afterStatusIconQueryTooltip a
obj StatusIconQueryTooltipCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconQueryTooltipCallback
cb' = StatusIconQueryTooltipCallback -> C_StatusIconQueryTooltipCallback
wrap_StatusIconQueryTooltipCallback StatusIconQueryTooltipCallback
cb
    FunPtr C_StatusIconQueryTooltipCallback
cb'' <- C_StatusIconQueryTooltipCallback
-> IO (FunPtr C_StatusIconQueryTooltipCallback)
mk_StatusIconQueryTooltipCallback C_StatusIconQueryTooltipCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconQueryTooltipCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"query-tooltip" FunPtr C_StatusIconQueryTooltipCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data StatusIconQueryTooltipSignalInfo
instance SignalInfo StatusIconQueryTooltipSignalInfo where
    type HaskellCallbackType StatusIconQueryTooltipSignalInfo = StatusIconQueryTooltipCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_StatusIconQueryTooltipCallback cb
        cb'' <- mk_StatusIconQueryTooltipCallback cb'
        connectSignalFunPtr obj "query-tooltip" cb'' connectMode detail

#endif

-- signal StatusIcon::scroll-event
-- | The [scrollEvent](#g:signal:scrollEvent) signal is emitted when a button in the 4 to 7
-- range is pressed. Wheel mice are usually configured to generate
-- button press events for buttons 4 and 5 when the wheel is turned.
-- 
-- Whether this event is emitted is platform-dependent.
-- 
-- /Since: 2.16/
type StatusIconScrollEventCallback =
    Gdk.EventScroll.EventScroll
    -- ^ /@event@/: the t'GI.Gdk.Structs.EventScroll.EventScroll' which triggered
    --                                 this signal
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to stop other handlers from being invoked for the event.
    --   'P.False' to propagate the event further.

-- | A convenience synonym for @`Nothing` :: `Maybe` `StatusIconScrollEventCallback`@.
noStatusIconScrollEventCallback :: Maybe StatusIconScrollEventCallback
noStatusIconScrollEventCallback :: Maybe StatusIconScrollEventCallback
noStatusIconScrollEventCallback = Maybe StatusIconScrollEventCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_StatusIconScrollEvent :: MonadIO m => StatusIconScrollEventCallback -> m (GClosure C_StatusIconScrollEventCallback)
genClosure_StatusIconScrollEvent :: StatusIconScrollEventCallback
-> m (GClosure C_StatusIconScrollEventCallback)
genClosure_StatusIconScrollEvent StatusIconScrollEventCallback
cb = IO (GClosure C_StatusIconScrollEventCallback)
-> m (GClosure C_StatusIconScrollEventCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_StatusIconScrollEventCallback)
 -> m (GClosure C_StatusIconScrollEventCallback))
-> IO (GClosure C_StatusIconScrollEventCallback)
-> m (GClosure C_StatusIconScrollEventCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconScrollEventCallback
cb' = StatusIconScrollEventCallback -> C_StatusIconScrollEventCallback
wrap_StatusIconScrollEventCallback StatusIconScrollEventCallback
cb
    C_StatusIconScrollEventCallback
-> IO (FunPtr C_StatusIconScrollEventCallback)
mk_StatusIconScrollEventCallback C_StatusIconScrollEventCallback
cb' IO (FunPtr C_StatusIconScrollEventCallback)
-> (FunPtr C_StatusIconScrollEventCallback
    -> IO (GClosure C_StatusIconScrollEventCallback))
-> IO (GClosure C_StatusIconScrollEventCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_StatusIconScrollEventCallback
-> IO (GClosure C_StatusIconScrollEventCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `StatusIconScrollEventCallback` into a `C_StatusIconScrollEventCallback`.
wrap_StatusIconScrollEventCallback ::
    StatusIconScrollEventCallback ->
    C_StatusIconScrollEventCallback
wrap_StatusIconScrollEventCallback :: StatusIconScrollEventCallback -> C_StatusIconScrollEventCallback
wrap_StatusIconScrollEventCallback StatusIconScrollEventCallback
_cb Ptr ()
_ Ptr EventScroll
event Ptr ()
_ = do
    EventScroll
event' <- ((ManagedPtr EventScroll -> EventScroll)
-> Ptr EventScroll -> IO EventScroll
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr EventScroll -> EventScroll
Gdk.EventScroll.EventScroll) Ptr EventScroll
event
    Bool
result <- StatusIconScrollEventCallback
_cb  EventScroll
event'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [scrollEvent](#signal:scrollEvent) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' statusIcon #scrollEvent callback
-- @
-- 
-- 
onStatusIconScrollEvent :: (IsStatusIcon a, MonadIO m) => a -> StatusIconScrollEventCallback -> m SignalHandlerId
onStatusIconScrollEvent :: a -> StatusIconScrollEventCallback -> m SignalHandlerId
onStatusIconScrollEvent a
obj StatusIconScrollEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconScrollEventCallback
cb' = StatusIconScrollEventCallback -> C_StatusIconScrollEventCallback
wrap_StatusIconScrollEventCallback StatusIconScrollEventCallback
cb
    FunPtr C_StatusIconScrollEventCallback
cb'' <- C_StatusIconScrollEventCallback
-> IO (FunPtr C_StatusIconScrollEventCallback)
mk_StatusIconScrollEventCallback C_StatusIconScrollEventCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconScrollEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"scroll-event" FunPtr C_StatusIconScrollEventCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [scrollEvent](#signal:scrollEvent) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' statusIcon #scrollEvent callback
-- @
-- 
-- 
afterStatusIconScrollEvent :: (IsStatusIcon a, MonadIO m) => a -> StatusIconScrollEventCallback -> m SignalHandlerId
afterStatusIconScrollEvent :: a -> StatusIconScrollEventCallback -> m SignalHandlerId
afterStatusIconScrollEvent a
obj StatusIconScrollEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconScrollEventCallback
cb' = StatusIconScrollEventCallback -> C_StatusIconScrollEventCallback
wrap_StatusIconScrollEventCallback StatusIconScrollEventCallback
cb
    FunPtr C_StatusIconScrollEventCallback
cb'' <- C_StatusIconScrollEventCallback
-> IO (FunPtr C_StatusIconScrollEventCallback)
mk_StatusIconScrollEventCallback C_StatusIconScrollEventCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconScrollEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"scroll-event" FunPtr C_StatusIconScrollEventCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data StatusIconScrollEventSignalInfo
instance SignalInfo StatusIconScrollEventSignalInfo where
    type HaskellCallbackType StatusIconScrollEventSignalInfo = StatusIconScrollEventCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_StatusIconScrollEventCallback cb
        cb'' <- mk_StatusIconScrollEventCallback cb'
        connectSignalFunPtr obj "scroll-event" cb'' connectMode detail

#endif

-- signal StatusIcon::size-changed
-- | Gets emitted when the size available for the image
-- changes, e.g. because the notification area got resized.
-- 
-- /Since: 2.10/
type StatusIconSizeChangedCallback =
    Int32
    -- ^ /@size@/: the new size
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the icon was updated for the new
    -- size. Otherwise, GTK+ will scale the icon as necessary.

-- | A convenience synonym for @`Nothing` :: `Maybe` `StatusIconSizeChangedCallback`@.
noStatusIconSizeChangedCallback :: Maybe StatusIconSizeChangedCallback
noStatusIconSizeChangedCallback :: Maybe StatusIconSizeChangedCallback
noStatusIconSizeChangedCallback = Maybe StatusIconSizeChangedCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_StatusIconSizeChanged :: MonadIO m => StatusIconSizeChangedCallback -> m (GClosure C_StatusIconSizeChangedCallback)
genClosure_StatusIconSizeChanged :: StatusIconSizeChangedCallback
-> m (GClosure C_StatusIconSizeChangedCallback)
genClosure_StatusIconSizeChanged StatusIconSizeChangedCallback
cb = IO (GClosure C_StatusIconSizeChangedCallback)
-> m (GClosure C_StatusIconSizeChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_StatusIconSizeChangedCallback)
 -> m (GClosure C_StatusIconSizeChangedCallback))
-> IO (GClosure C_StatusIconSizeChangedCallback)
-> m (GClosure C_StatusIconSizeChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconSizeChangedCallback
cb' = StatusIconSizeChangedCallback -> C_StatusIconSizeChangedCallback
wrap_StatusIconSizeChangedCallback StatusIconSizeChangedCallback
cb
    C_StatusIconSizeChangedCallback
-> IO (FunPtr C_StatusIconSizeChangedCallback)
mk_StatusIconSizeChangedCallback C_StatusIconSizeChangedCallback
cb' IO (FunPtr C_StatusIconSizeChangedCallback)
-> (FunPtr C_StatusIconSizeChangedCallback
    -> IO (GClosure C_StatusIconSizeChangedCallback))
-> IO (GClosure C_StatusIconSizeChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_StatusIconSizeChangedCallback
-> IO (GClosure C_StatusIconSizeChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `StatusIconSizeChangedCallback` into a `C_StatusIconSizeChangedCallback`.
wrap_StatusIconSizeChangedCallback ::
    StatusIconSizeChangedCallback ->
    C_StatusIconSizeChangedCallback
wrap_StatusIconSizeChangedCallback :: StatusIconSizeChangedCallback -> C_StatusIconSizeChangedCallback
wrap_StatusIconSizeChangedCallback StatusIconSizeChangedCallback
_cb Ptr ()
_ Int32
size Ptr ()
_ = do
    Bool
result <- StatusIconSizeChangedCallback
_cb  Int32
size
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [sizeChanged](#signal:sizeChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' statusIcon #sizeChanged callback
-- @
-- 
-- 
onStatusIconSizeChanged :: (IsStatusIcon a, MonadIO m) => a -> StatusIconSizeChangedCallback -> m SignalHandlerId
onStatusIconSizeChanged :: a -> StatusIconSizeChangedCallback -> m SignalHandlerId
onStatusIconSizeChanged a
obj StatusIconSizeChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconSizeChangedCallback
cb' = StatusIconSizeChangedCallback -> C_StatusIconSizeChangedCallback
wrap_StatusIconSizeChangedCallback StatusIconSizeChangedCallback
cb
    FunPtr C_StatusIconSizeChangedCallback
cb'' <- C_StatusIconSizeChangedCallback
-> IO (FunPtr C_StatusIconSizeChangedCallback)
mk_StatusIconSizeChangedCallback C_StatusIconSizeChangedCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconSizeChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"size-changed" FunPtr C_StatusIconSizeChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [sizeChanged](#signal:sizeChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' statusIcon #sizeChanged callback
-- @
-- 
-- 
afterStatusIconSizeChanged :: (IsStatusIcon a, MonadIO m) => a -> StatusIconSizeChangedCallback -> m SignalHandlerId
afterStatusIconSizeChanged :: a -> StatusIconSizeChangedCallback -> m SignalHandlerId
afterStatusIconSizeChanged a
obj StatusIconSizeChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_StatusIconSizeChangedCallback
cb' = StatusIconSizeChangedCallback -> C_StatusIconSizeChangedCallback
wrap_StatusIconSizeChangedCallback StatusIconSizeChangedCallback
cb
    FunPtr C_StatusIconSizeChangedCallback
cb'' <- C_StatusIconSizeChangedCallback
-> IO (FunPtr C_StatusIconSizeChangedCallback)
mk_StatusIconSizeChangedCallback C_StatusIconSizeChangedCallback
cb'
    a
-> Text
-> FunPtr C_StatusIconSizeChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"size-changed" FunPtr C_StatusIconSizeChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data StatusIconSizeChangedSignalInfo
instance SignalInfo StatusIconSizeChangedSignalInfo where
    type HaskellCallbackType StatusIconSizeChangedSignalInfo = StatusIconSizeChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_StatusIconSizeChangedCallback cb
        cb'' <- mk_StatusIconSizeChangedCallback cb'
        connectSignalFunPtr obj "size-changed" cb'' connectMode detail

#endif

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

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

#if defined(ENABLE_OVERLOADING)
data StatusIconEmbeddedPropertyInfo
instance AttrInfo StatusIconEmbeddedPropertyInfo where
    type AttrAllowedOps StatusIconEmbeddedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint StatusIconEmbeddedPropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconEmbeddedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint StatusIconEmbeddedPropertyInfo = (~) ()
    type AttrTransferType StatusIconEmbeddedPropertyInfo = ()
    type AttrGetType StatusIconEmbeddedPropertyInfo = Bool
    type AttrLabel StatusIconEmbeddedPropertyInfo = "embedded"
    type AttrOrigin StatusIconEmbeddedPropertyInfo = StatusIcon
    attrGet = getStatusIconEmbedded
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

-- | Construct a `GValueConstruct` with valid value for the “@file@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconFile :: (IsStatusIcon o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructStatusIconFile :: Text -> m (GValueConstruct o)
constructStatusIconFile 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
"file" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@file@” 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' #file
-- @
clearStatusIconFile :: (MonadIO m, IsStatusIcon o) => o -> m ()
clearStatusIconFile :: o -> m ()
clearStatusIconFile 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
"file" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data StatusIconFilePropertyInfo
instance AttrInfo StatusIconFilePropertyInfo where
    type AttrAllowedOps StatusIconFilePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint StatusIconFilePropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconFilePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StatusIconFilePropertyInfo = (~) T.Text
    type AttrTransferType StatusIconFilePropertyInfo = T.Text
    type AttrGetType StatusIconFilePropertyInfo = ()
    type AttrLabel StatusIconFilePropertyInfo = "file"
    type AttrOrigin StatusIconFilePropertyInfo = StatusIcon
    attrGet = undefined
    attrSet = setStatusIconFile
    attrTransfer _ v = do
        return v
    attrConstruct = constructStatusIconFile
    attrClear = clearStatusIconFile
#endif

-- VVV Prop "gicon"
   -- Type: TInterface (Name {namespace = "Gio", name = "Icon"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@gicon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' statusIcon #gicon
-- @
getStatusIconGicon :: (MonadIO m, IsStatusIcon o) => o -> m (Maybe Gio.Icon.Icon)
getStatusIconGicon :: o -> m (Maybe Icon)
getStatusIconGicon o
obj = IO (Maybe Icon) -> m (Maybe Icon)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Icon -> Icon) -> IO (Maybe Icon)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"gicon" ManagedPtr Icon -> Icon
Gio.Icon.Icon

-- | Set the value of the “@gicon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' statusIcon [ #gicon 'Data.GI.Base.Attributes.:=' value ]
-- @
setStatusIconGicon :: (MonadIO m, IsStatusIcon o, Gio.Icon.IsIcon a) => o -> a -> m ()
setStatusIconGicon :: o -> a -> m ()
setStatusIconGicon o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"gicon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@gicon@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconGicon :: (IsStatusIcon o, MIO.MonadIO m, Gio.Icon.IsIcon a) => a -> m (GValueConstruct o)
constructStatusIconGicon :: a -> m (GValueConstruct o)
constructStatusIconGicon 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
"gicon" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@gicon@” 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' #gicon
-- @
clearStatusIconGicon :: (MonadIO m, IsStatusIcon o) => o -> m ()
clearStatusIconGicon :: o -> m ()
clearStatusIconGicon 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 Icon -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"gicon" (Maybe Icon
forall a. Maybe a
Nothing :: Maybe Gio.Icon.Icon)

#if defined(ENABLE_OVERLOADING)
data StatusIconGiconPropertyInfo
instance AttrInfo StatusIconGiconPropertyInfo where
    type AttrAllowedOps StatusIconGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StatusIconGiconPropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconGiconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferTypeConstraint StatusIconGiconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferType StatusIconGiconPropertyInfo = Gio.Icon.Icon
    type AttrGetType StatusIconGiconPropertyInfo = (Maybe Gio.Icon.Icon)
    type AttrLabel StatusIconGiconPropertyInfo = "gicon"
    type AttrOrigin StatusIconGiconPropertyInfo = StatusIcon
    attrGet = getStatusIconGicon
    attrSet = setStatusIconGicon
    attrTransfer _ v = do
        unsafeCastTo Gio.Icon.Icon v
    attrConstruct = constructStatusIconGicon
    attrClear = clearStatusIconGicon
#endif

-- VVV Prop "has-tooltip"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@has-tooltip@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconHasTooltip :: (IsStatusIcon o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructStatusIconHasTooltip :: Bool -> m (GValueConstruct o)
constructStatusIconHasTooltip 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
"has-tooltip" Bool
val

#if defined(ENABLE_OVERLOADING)
data StatusIconHasTooltipPropertyInfo
instance AttrInfo StatusIconHasTooltipPropertyInfo where
    type AttrAllowedOps StatusIconHasTooltipPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StatusIconHasTooltipPropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconHasTooltipPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StatusIconHasTooltipPropertyInfo = (~) Bool
    type AttrTransferType StatusIconHasTooltipPropertyInfo = Bool
    type AttrGetType StatusIconHasTooltipPropertyInfo = Bool
    type AttrLabel StatusIconHasTooltipPropertyInfo = "has-tooltip"
    type AttrOrigin StatusIconHasTooltipPropertyInfo = StatusIcon
    attrGet = getStatusIconHasTooltip
    attrSet = setStatusIconHasTooltip
    attrTransfer _ v = do
        return v
    attrConstruct = constructStatusIconHasTooltip
    attrClear = undefined
#endif

-- VVV Prop "icon-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' statusIcon #iconName
-- @
getStatusIconIconName :: (MonadIO m, IsStatusIcon o) => o -> m (Maybe T.Text)
getStatusIconIconName :: o -> m (Maybe Text)
getStatusIconIconName 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
"icon-name"

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

-- | Construct a `GValueConstruct` with valid value for the “@icon-name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconIconName :: (IsStatusIcon o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructStatusIconIconName :: Text -> m (GValueConstruct o)
constructStatusIconIconName 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
"icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@icon-name@” 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' #iconName
-- @
clearStatusIconIconName :: (MonadIO m, IsStatusIcon o) => o -> m ()
clearStatusIconIconName :: o -> m ()
clearStatusIconIconName 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
"icon-name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data StatusIconIconNamePropertyInfo
instance AttrInfo StatusIconIconNamePropertyInfo where
    type AttrAllowedOps StatusIconIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StatusIconIconNamePropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StatusIconIconNamePropertyInfo = (~) T.Text
    type AttrTransferType StatusIconIconNamePropertyInfo = T.Text
    type AttrGetType StatusIconIconNamePropertyInfo = (Maybe T.Text)
    type AttrLabel StatusIconIconNamePropertyInfo = "icon-name"
    type AttrOrigin StatusIconIconNamePropertyInfo = StatusIcon
    attrGet = getStatusIconIconName
    attrSet = setStatusIconIconName
    attrTransfer _ v = do
        return v
    attrConstruct = constructStatusIconIconName
    attrClear = clearStatusIconIconName
#endif

-- VVV Prop "orientation"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Orientation"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data StatusIconOrientationPropertyInfo
instance AttrInfo StatusIconOrientationPropertyInfo where
    type AttrAllowedOps StatusIconOrientationPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint StatusIconOrientationPropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconOrientationPropertyInfo = (~) ()
    type AttrTransferTypeConstraint StatusIconOrientationPropertyInfo = (~) ()
    type AttrTransferType StatusIconOrientationPropertyInfo = ()
    type AttrGetType StatusIconOrientationPropertyInfo = Gtk.Enums.Orientation
    type AttrLabel StatusIconOrientationPropertyInfo = "orientation"
    type AttrOrigin StatusIconOrientationPropertyInfo = StatusIcon
    attrGet = getStatusIconOrientation
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "pixbuf"
   -- Type: TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@pixbuf@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' statusIcon #pixbuf
-- @
getStatusIconPixbuf :: (MonadIO m, IsStatusIcon o) => o -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)
getStatusIconPixbuf :: o -> m (Maybe Pixbuf)
getStatusIconPixbuf o
obj = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Pixbuf -> Pixbuf) -> IO (Maybe Pixbuf)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"pixbuf" ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf

-- | Set the value of the “@pixbuf@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' statusIcon [ #pixbuf 'Data.GI.Base.Attributes.:=' value ]
-- @
setStatusIconPixbuf :: (MonadIO m, IsStatusIcon o, GdkPixbuf.Pixbuf.IsPixbuf a) => o -> a -> m ()
setStatusIconPixbuf :: o -> a -> m ()
setStatusIconPixbuf o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"pixbuf" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@pixbuf@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconPixbuf :: (IsStatusIcon o, MIO.MonadIO m, GdkPixbuf.Pixbuf.IsPixbuf a) => a -> m (GValueConstruct o)
constructStatusIconPixbuf :: a -> m (GValueConstruct o)
constructStatusIconPixbuf 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
"pixbuf" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@pixbuf@” 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' #pixbuf
-- @
clearStatusIconPixbuf :: (MonadIO m, IsStatusIcon o) => o -> m ()
clearStatusIconPixbuf :: o -> m ()
clearStatusIconPixbuf 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 Pixbuf -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"pixbuf" (Maybe Pixbuf
forall a. Maybe a
Nothing :: Maybe GdkPixbuf.Pixbuf.Pixbuf)

#if defined(ENABLE_OVERLOADING)
data StatusIconPixbufPropertyInfo
instance AttrInfo StatusIconPixbufPropertyInfo where
    type AttrAllowedOps StatusIconPixbufPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StatusIconPixbufPropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconPixbufPropertyInfo = GdkPixbuf.Pixbuf.IsPixbuf
    type AttrTransferTypeConstraint StatusIconPixbufPropertyInfo = GdkPixbuf.Pixbuf.IsPixbuf
    type AttrTransferType StatusIconPixbufPropertyInfo = GdkPixbuf.Pixbuf.Pixbuf
    type AttrGetType StatusIconPixbufPropertyInfo = (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    type AttrLabel StatusIconPixbufPropertyInfo = "pixbuf"
    type AttrOrigin StatusIconPixbufPropertyInfo = StatusIcon
    attrGet = getStatusIconPixbuf
    attrSet = setStatusIconPixbuf
    attrTransfer _ v = do
        unsafeCastTo GdkPixbuf.Pixbuf.Pixbuf v
    attrConstruct = constructStatusIconPixbuf
    attrClear = clearStatusIconPixbuf
#endif

-- VVV Prop "screen"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Screen"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@screen@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' statusIcon [ #screen 'Data.GI.Base.Attributes.:=' value ]
-- @
setStatusIconScreen :: (MonadIO m, IsStatusIcon o, Gdk.Screen.IsScreen a) => o -> a -> m ()
setStatusIconScreen :: o -> a -> m ()
setStatusIconScreen o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"screen" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@screen@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconScreen :: (IsStatusIcon o, MIO.MonadIO m, Gdk.Screen.IsScreen a) => a -> m (GValueConstruct o)
constructStatusIconScreen :: a -> m (GValueConstruct o)
constructStatusIconScreen 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
"screen" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data StatusIconScreenPropertyInfo
instance AttrInfo StatusIconScreenPropertyInfo where
    type AttrAllowedOps StatusIconScreenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StatusIconScreenPropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconScreenPropertyInfo = Gdk.Screen.IsScreen
    type AttrTransferTypeConstraint StatusIconScreenPropertyInfo = Gdk.Screen.IsScreen
    type AttrTransferType StatusIconScreenPropertyInfo = Gdk.Screen.Screen
    type AttrGetType StatusIconScreenPropertyInfo = Gdk.Screen.Screen
    type AttrLabel StatusIconScreenPropertyInfo = "screen"
    type AttrOrigin StatusIconScreenPropertyInfo = StatusIcon
    attrGet = getStatusIconScreen
    attrSet = setStatusIconScreen
    attrTransfer _ v = do
        unsafeCastTo Gdk.Screen.Screen v
    attrConstruct = constructStatusIconScreen
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data StatusIconSizePropertyInfo
instance AttrInfo StatusIconSizePropertyInfo where
    type AttrAllowedOps StatusIconSizePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint StatusIconSizePropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconSizePropertyInfo = (~) ()
    type AttrTransferTypeConstraint StatusIconSizePropertyInfo = (~) ()
    type AttrTransferType StatusIconSizePropertyInfo = ()
    type AttrGetType StatusIconSizePropertyInfo = Int32
    type AttrLabel StatusIconSizePropertyInfo = "size"
    type AttrOrigin StatusIconSizePropertyInfo = StatusIcon
    attrGet = getStatusIconSize
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "stock"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@stock@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' statusIcon #stock
-- @
getStatusIconStock :: (MonadIO m, IsStatusIcon o) => o -> m (Maybe T.Text)
getStatusIconStock :: o -> m (Maybe Text)
getStatusIconStock 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
"stock"

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

-- | Construct a `GValueConstruct` with valid value for the “@stock@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconStock :: (IsStatusIcon o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructStatusIconStock :: Text -> m (GValueConstruct o)
constructStatusIconStock 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
"stock" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@stock@” 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' #stock
-- @
clearStatusIconStock :: (MonadIO m, IsStatusIcon o) => o -> m ()
clearStatusIconStock :: o -> m ()
clearStatusIconStock 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
"stock" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data StatusIconStockPropertyInfo
instance AttrInfo StatusIconStockPropertyInfo where
    type AttrAllowedOps StatusIconStockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StatusIconStockPropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconStockPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StatusIconStockPropertyInfo = (~) T.Text
    type AttrTransferType StatusIconStockPropertyInfo = T.Text
    type AttrGetType StatusIconStockPropertyInfo = (Maybe T.Text)
    type AttrLabel StatusIconStockPropertyInfo = "stock"
    type AttrOrigin StatusIconStockPropertyInfo = StatusIcon
    attrGet = getStatusIconStock
    attrSet = setStatusIconStock
    attrTransfer _ v = do
        return v
    attrConstruct = constructStatusIconStock
    attrClear = clearStatusIconStock
#endif

-- VVV Prop "storage-type"
   -- Type: TInterface (Name {namespace = "Gtk", name = "ImageType"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data StatusIconStorageTypePropertyInfo
instance AttrInfo StatusIconStorageTypePropertyInfo where
    type AttrAllowedOps StatusIconStorageTypePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint StatusIconStorageTypePropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconStorageTypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint StatusIconStorageTypePropertyInfo = (~) ()
    type AttrTransferType StatusIconStorageTypePropertyInfo = ()
    type AttrGetType StatusIconStorageTypePropertyInfo = Gtk.Enums.ImageType
    type AttrLabel StatusIconStorageTypePropertyInfo = "storage-type"
    type AttrOrigin StatusIconStorageTypePropertyInfo = StatusIcon
    attrGet = getStatusIconStorageType
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@title@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconTitle :: (IsStatusIcon o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructStatusIconTitle :: Text -> m (GValueConstruct o)
constructStatusIconTitle 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
"title" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data StatusIconTitlePropertyInfo
instance AttrInfo StatusIconTitlePropertyInfo where
    type AttrAllowedOps StatusIconTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StatusIconTitlePropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StatusIconTitlePropertyInfo = (~) T.Text
    type AttrTransferType StatusIconTitlePropertyInfo = T.Text
    type AttrGetType StatusIconTitlePropertyInfo = T.Text
    type AttrLabel StatusIconTitlePropertyInfo = "title"
    type AttrOrigin StatusIconTitlePropertyInfo = StatusIcon
    attrGet = getStatusIconTitle
    attrSet = setStatusIconTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructStatusIconTitle
    attrClear = undefined
#endif

-- VVV Prop "tooltip-markup"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just True)

-- | Get the value of the “@tooltip-markup@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' statusIcon #tooltipMarkup
-- @
getStatusIconTooltipMarkup :: (MonadIO m, IsStatusIcon o) => o -> m (Maybe T.Text)
getStatusIconTooltipMarkup :: o -> m (Maybe Text)
getStatusIconTooltipMarkup 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
"tooltip-markup"

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

-- | Construct a `GValueConstruct` with valid value for the “@tooltip-markup@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconTooltipMarkup :: (IsStatusIcon o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructStatusIconTooltipMarkup :: Text -> m (GValueConstruct o)
constructStatusIconTooltipMarkup 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
"tooltip-markup" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@tooltip-markup@” 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' #tooltipMarkup
-- @
clearStatusIconTooltipMarkup :: (MonadIO m, IsStatusIcon o) => o -> m ()
clearStatusIconTooltipMarkup :: o -> m ()
clearStatusIconTooltipMarkup 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
"tooltip-markup" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data StatusIconTooltipMarkupPropertyInfo
instance AttrInfo StatusIconTooltipMarkupPropertyInfo where
    type AttrAllowedOps StatusIconTooltipMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StatusIconTooltipMarkupPropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconTooltipMarkupPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StatusIconTooltipMarkupPropertyInfo = (~) T.Text
    type AttrTransferType StatusIconTooltipMarkupPropertyInfo = T.Text
    type AttrGetType StatusIconTooltipMarkupPropertyInfo = (Maybe T.Text)
    type AttrLabel StatusIconTooltipMarkupPropertyInfo = "tooltip-markup"
    type AttrOrigin StatusIconTooltipMarkupPropertyInfo = StatusIcon
    attrGet = getStatusIconTooltipMarkup
    attrSet = setStatusIconTooltipMarkup
    attrTransfer _ v = do
        return v
    attrConstruct = constructStatusIconTooltipMarkup
    attrClear = clearStatusIconTooltipMarkup
#endif

-- VVV Prop "tooltip-text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@tooltip-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' statusIcon #tooltipText
-- @
getStatusIconTooltipText :: (MonadIO m, IsStatusIcon o) => o -> m (Maybe T.Text)
getStatusIconTooltipText :: o -> m (Maybe Text)
getStatusIconTooltipText 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
"tooltip-text"

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

-- | Construct a `GValueConstruct` with valid value for the “@tooltip-text@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconTooltipText :: (IsStatusIcon o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructStatusIconTooltipText :: Text -> m (GValueConstruct o)
constructStatusIconTooltipText 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
"tooltip-text" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data StatusIconTooltipTextPropertyInfo
instance AttrInfo StatusIconTooltipTextPropertyInfo where
    type AttrAllowedOps StatusIconTooltipTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StatusIconTooltipTextPropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconTooltipTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StatusIconTooltipTextPropertyInfo = (~) T.Text
    type AttrTransferType StatusIconTooltipTextPropertyInfo = T.Text
    type AttrGetType StatusIconTooltipTextPropertyInfo = (Maybe T.Text)
    type AttrLabel StatusIconTooltipTextPropertyInfo = "tooltip-text"
    type AttrOrigin StatusIconTooltipTextPropertyInfo = StatusIcon
    attrGet = getStatusIconTooltipText
    attrSet = setStatusIconTooltipText
    attrTransfer _ v = do
        return v
    attrConstruct = constructStatusIconTooltipText
    attrClear = undefined
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@visible@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStatusIconVisible :: (IsStatusIcon o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructStatusIconVisible :: Bool -> m (GValueConstruct o)
constructStatusIconVisible 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
"visible" Bool
val

#if defined(ENABLE_OVERLOADING)
data StatusIconVisiblePropertyInfo
instance AttrInfo StatusIconVisiblePropertyInfo where
    type AttrAllowedOps StatusIconVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StatusIconVisiblePropertyInfo = IsStatusIcon
    type AttrSetTypeConstraint StatusIconVisiblePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StatusIconVisiblePropertyInfo = (~) Bool
    type AttrTransferType StatusIconVisiblePropertyInfo = Bool
    type AttrGetType StatusIconVisiblePropertyInfo = Bool
    type AttrLabel StatusIconVisiblePropertyInfo = "visible"
    type AttrOrigin StatusIconVisiblePropertyInfo = StatusIcon
    attrGet = getStatusIconVisible
    attrSet = setStatusIconVisible
    attrTransfer _ v = do
        return v
    attrConstruct = constructStatusIconVisible
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList StatusIcon
type instance O.AttributeList StatusIcon = StatusIconAttributeList
type StatusIconAttributeList = ('[ '("embedded", StatusIconEmbeddedPropertyInfo), '("file", StatusIconFilePropertyInfo), '("gicon", StatusIconGiconPropertyInfo), '("hasTooltip", StatusIconHasTooltipPropertyInfo), '("iconName", StatusIconIconNamePropertyInfo), '("orientation", StatusIconOrientationPropertyInfo), '("pixbuf", StatusIconPixbufPropertyInfo), '("screen", StatusIconScreenPropertyInfo), '("size", StatusIconSizePropertyInfo), '("stock", StatusIconStockPropertyInfo), '("storageType", StatusIconStorageTypePropertyInfo), '("title", StatusIconTitlePropertyInfo), '("tooltipMarkup", StatusIconTooltipMarkupPropertyInfo), '("tooltipText", StatusIconTooltipTextPropertyInfo), '("visible", StatusIconVisiblePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
statusIconEmbedded :: AttrLabelProxy "embedded"
statusIconEmbedded = AttrLabelProxy

statusIconFile :: AttrLabelProxy "file"
statusIconFile = AttrLabelProxy

statusIconGicon :: AttrLabelProxy "gicon"
statusIconGicon = AttrLabelProxy

statusIconHasTooltip :: AttrLabelProxy "hasTooltip"
statusIconHasTooltip = AttrLabelProxy

statusIconIconName :: AttrLabelProxy "iconName"
statusIconIconName = AttrLabelProxy

statusIconOrientation :: AttrLabelProxy "orientation"
statusIconOrientation = AttrLabelProxy

statusIconPixbuf :: AttrLabelProxy "pixbuf"
statusIconPixbuf = AttrLabelProxy

statusIconScreen :: AttrLabelProxy "screen"
statusIconScreen = AttrLabelProxy

statusIconSize :: AttrLabelProxy "size"
statusIconSize = AttrLabelProxy

statusIconStock :: AttrLabelProxy "stock"
statusIconStock = AttrLabelProxy

statusIconStorageType :: AttrLabelProxy "storageType"
statusIconStorageType = AttrLabelProxy

statusIconTitle :: AttrLabelProxy "title"
statusIconTitle = AttrLabelProxy

statusIconTooltipMarkup :: AttrLabelProxy "tooltipMarkup"
statusIconTooltipMarkup = AttrLabelProxy

statusIconTooltipText :: AttrLabelProxy "tooltipText"
statusIconTooltipText = AttrLabelProxy

statusIconVisible :: AttrLabelProxy "visible"
statusIconVisible = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList StatusIcon = StatusIconSignalList
type StatusIconSignalList = ('[ '("activate", StatusIconActivateSignalInfo), '("buttonPressEvent", StatusIconButtonPressEventSignalInfo), '("buttonReleaseEvent", StatusIconButtonReleaseEventSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("popupMenu", StatusIconPopupMenuSignalInfo), '("queryTooltip", StatusIconQueryTooltipSignalInfo), '("scrollEvent", StatusIconScrollEventSignalInfo), '("sizeChanged", StatusIconSizeChangedSignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_status_icon_new" gtk_status_icon_new :: 
    IO (Ptr StatusIcon)

{-# DEPRECATED statusIconNew ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications"] #-}
-- | Creates an empty status icon object.
-- 
-- /Since: 2.10/
statusIconNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m StatusIcon
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.StatusIcon.StatusIcon'
statusIconNew :: m StatusIcon
statusIconNew  = IO StatusIcon -> m StatusIcon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StatusIcon -> m StatusIcon) -> IO StatusIcon -> m StatusIcon
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
result <- IO (Ptr StatusIcon)
gtk_status_icon_new
    Text -> Ptr StatusIcon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"statusIconNew" Ptr StatusIcon
result
    StatusIcon
result' <- ((ManagedPtr StatusIcon -> StatusIcon)
-> Ptr StatusIcon -> IO StatusIcon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StatusIcon -> StatusIcon
StatusIcon) Ptr StatusIcon
result
    StatusIcon -> IO StatusIcon
forall (m :: * -> *) a. Monad m => a -> m a
return StatusIcon
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method StatusIcon::new_from_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a filename" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "StatusIcon" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_new_from_file" gtk_status_icon_new_from_file :: 
    CString ->                              -- filename : TBasicType TFileName
    IO (Ptr StatusIcon)

{-# DEPRECATED statusIconNewFromFile ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications"] #-}
-- | Creates a status icon displaying the file /@filename@/.
-- 
-- The image will be scaled down to fit in the available
-- space in the notification area, if necessary.
-- 
-- /Since: 2.10/
statusIconNewFromFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@filename@/: a filename
    -> m StatusIcon
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.StatusIcon.StatusIcon'
statusIconNewFromFile :: String -> m StatusIcon
statusIconNewFromFile String
filename = IO StatusIcon -> m StatusIcon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StatusIcon -> m StatusIcon) -> IO StatusIcon -> m StatusIcon
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- String -> IO CString
stringToCString String
filename
    Ptr StatusIcon
result <- CString -> IO (Ptr StatusIcon)
gtk_status_icon_new_from_file CString
filename'
    Text -> Ptr StatusIcon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"statusIconNewFromFile" Ptr StatusIcon
result
    StatusIcon
result' <- ((ManagedPtr StatusIcon -> StatusIcon)
-> Ptr StatusIcon -> IO StatusIcon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StatusIcon -> StatusIcon
StatusIcon) Ptr StatusIcon
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    StatusIcon -> IO StatusIcon
forall (m :: * -> *) a. Monad m => a -> m a
return StatusIcon
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method StatusIcon::new_from_gicon
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "StatusIcon" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_new_from_gicon" gtk_status_icon_new_from_gicon :: 
    Ptr Gio.Icon.Icon ->                    -- icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    IO (Ptr StatusIcon)

{-# DEPRECATED statusIconNewFromGicon ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications"] #-}
-- | Creates a status icon displaying a t'GI.Gio.Interfaces.Icon.Icon'. If the icon is a
-- themed icon, it will be updated when the theme changes.
-- 
-- /Since: 2.14/
statusIconNewFromGicon ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Icon.IsIcon a) =>
    a
    -- ^ /@icon@/: a t'GI.Gio.Interfaces.Icon.Icon'
    -> m StatusIcon
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.StatusIcon.StatusIcon'
statusIconNewFromGicon :: a -> m StatusIcon
statusIconNewFromGicon a
icon = IO StatusIcon -> m StatusIcon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StatusIcon -> m StatusIcon) -> IO StatusIcon -> m StatusIcon
forall a b. (a -> b) -> a -> b
$ do
    Ptr Icon
icon' <- a -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
icon
    Ptr StatusIcon
result <- Ptr Icon -> IO (Ptr StatusIcon)
gtk_status_icon_new_from_gicon Ptr Icon
icon'
    Text -> Ptr StatusIcon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"statusIconNewFromGicon" Ptr StatusIcon
result
    StatusIcon
result' <- ((ManagedPtr StatusIcon -> StatusIcon)
-> Ptr StatusIcon -> IO StatusIcon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StatusIcon -> StatusIcon
StatusIcon) Ptr StatusIcon
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
icon
    StatusIcon -> IO StatusIcon
forall (m :: * -> *) a. Monad m => a -> m a
return StatusIcon
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method StatusIcon::new_from_icon_name
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an icon name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "StatusIcon" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_new_from_icon_name" gtk_status_icon_new_from_icon_name :: 
    CString ->                              -- icon_name : TBasicType TUTF8
    IO (Ptr StatusIcon)

{-# DEPRECATED statusIconNewFromIconName ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications"] #-}
-- | Creates a status icon displaying an icon from the current icon theme.
-- If the current icon theme is changed, the icon will be updated
-- appropriately.
-- 
-- /Since: 2.10/
statusIconNewFromIconName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@iconName@/: an icon name
    -> m StatusIcon
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.StatusIcon.StatusIcon'
statusIconNewFromIconName :: Text -> m StatusIcon
statusIconNewFromIconName Text
iconName = IO StatusIcon -> m StatusIcon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StatusIcon -> m StatusIcon) -> IO StatusIcon -> m StatusIcon
forall a b. (a -> b) -> a -> b
$ do
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    Ptr StatusIcon
result <- CString -> IO (Ptr StatusIcon)
gtk_status_icon_new_from_icon_name CString
iconName'
    Text -> Ptr StatusIcon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"statusIconNewFromIconName" Ptr StatusIcon
result
    StatusIcon
result' <- ((ManagedPtr StatusIcon -> StatusIcon)
-> Ptr StatusIcon -> IO StatusIcon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StatusIcon -> StatusIcon
StatusIcon) Ptr StatusIcon
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    StatusIcon -> IO StatusIcon
forall (m :: * -> *) a. Monad m => a -> m a
return StatusIcon
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method StatusIcon::new_from_pixbuf
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "pixbuf"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbuf" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "StatusIcon" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_new_from_pixbuf" gtk_status_icon_new_from_pixbuf :: 
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- pixbuf : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO (Ptr StatusIcon)

{-# DEPRECATED statusIconNewFromPixbuf ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications"] #-}
-- | Creates a status icon displaying /@pixbuf@/.
-- 
-- The image will be scaled down to fit in the available
-- space in the notification area, if necessary.
-- 
-- /Since: 2.10/
statusIconNewFromPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, GdkPixbuf.Pixbuf.IsPixbuf a) =>
    a
    -- ^ /@pixbuf@/: a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf'
    -> m StatusIcon
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.StatusIcon.StatusIcon'
statusIconNewFromPixbuf :: a -> m StatusIcon
statusIconNewFromPixbuf a
pixbuf = IO StatusIcon -> m StatusIcon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StatusIcon -> m StatusIcon) -> IO StatusIcon -> m StatusIcon
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pixbuf
pixbuf' <- a -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pixbuf
    Ptr StatusIcon
result <- Ptr Pixbuf -> IO (Ptr StatusIcon)
gtk_status_icon_new_from_pixbuf Ptr Pixbuf
pixbuf'
    Text -> Ptr StatusIcon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"statusIconNewFromPixbuf" Ptr StatusIcon
result
    StatusIcon
result' <- ((ManagedPtr StatusIcon -> StatusIcon)
-> Ptr StatusIcon -> IO StatusIcon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StatusIcon -> StatusIcon
StatusIcon) Ptr StatusIcon
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pixbuf
    StatusIcon -> IO StatusIcon
forall (m :: * -> *) a. Monad m => a -> m a
return StatusIcon
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method StatusIcon::new_from_stock
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "stock_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a stock icon id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "StatusIcon" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_new_from_stock" gtk_status_icon_new_from_stock :: 
    CString ->                              -- stock_id : TBasicType TUTF8
    IO (Ptr StatusIcon)

{-# DEPRECATED statusIconNewFromStock ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications"] #-}
-- | Creates a status icon displaying a stock icon. Sample stock icon
-- names are 'GI.Gtk.Constants.STOCK_OPEN', 'GI.Gtk.Constants.STOCK_QUIT'. You can register your
-- own stock icon names, see 'GI.Gtk.Objects.IconFactory.iconFactoryAddDefault' and
-- 'GI.Gtk.Objects.IconFactory.iconFactoryAdd'.
-- 
-- /Since: 2.10/
statusIconNewFromStock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@stockId@/: a stock icon id
    -> m StatusIcon
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.StatusIcon.StatusIcon'
statusIconNewFromStock :: Text -> m StatusIcon
statusIconNewFromStock Text
stockId = IO StatusIcon -> m StatusIcon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StatusIcon -> m StatusIcon) -> IO StatusIcon -> m StatusIcon
forall a b. (a -> b) -> a -> b
$ do
    CString
stockId' <- Text -> IO CString
textToCString Text
stockId
    Ptr StatusIcon
result <- CString -> IO (Ptr StatusIcon)
gtk_status_icon_new_from_stock CString
stockId'
    Text -> Ptr StatusIcon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"statusIconNewFromStock" Ptr StatusIcon
result
    StatusIcon
result' <- ((ManagedPtr StatusIcon -> StatusIcon)
-> Ptr StatusIcon -> IO StatusIcon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StatusIcon -> StatusIcon
StatusIcon) Ptr StatusIcon
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stockId'
    StatusIcon -> IO StatusIcon
forall (m :: * -> *) a. Monad m => a -> m a
return StatusIcon
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method StatusIcon::get_geometry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for\n         the screen, or %NULL if the information is not needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "area"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the area occupied by\n       the status icon, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "orientation"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Orientation" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the\n   orientation of the panel in which the status icon is embedded,\n   or %NULL. A panel at the top or bottom of the screen is\n   horizontal, a panel at the left or right is vertical."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_get_geometry" gtk_status_icon_get_geometry :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    Ptr (Ptr Gdk.Screen.Screen) ->          -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    Ptr Gdk.Rectangle.Rectangle ->          -- area : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    Ptr CUInt ->                            -- orientation : TInterface (Name {namespace = "Gtk", name = "Orientation"})
    IO CInt

{-# DEPRECATED statusIconGetGeometry ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function, as the platform is responsible for the","  presentation of notifications"] #-}
-- | Obtains information about the location of the status icon
-- on screen. This information can be used to e.g. position
-- popups like notification bubbles.
-- 
-- See 'GI.Gtk.Objects.StatusIcon.statusIconPositionMenu' for a more convenient
-- alternative for positioning menus.
-- 
-- Note that some platforms do not allow GTK+ to provide
-- this information, and even on platforms that do allow it,
-- the information is not reliable unless the status icon
-- is embedded in a notification area, see
-- 'GI.Gtk.Objects.StatusIcon.statusIconIsEmbedded'.
-- 
-- /Since: 2.10/
statusIconGetGeometry ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m ((Bool, Gdk.Screen.Screen, Gdk.Rectangle.Rectangle, Gtk.Enums.Orientation))
    -- ^ __Returns:__ 'P.True' if the location information has
    --               been filled in
statusIconGetGeometry :: a -> m (Bool, Screen, Rectangle, Orientation)
statusIconGetGeometry a
statusIcon = IO (Bool, Screen, Rectangle, Orientation)
-> m (Bool, Screen, Rectangle, Orientation)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Screen, Rectangle, Orientation)
 -> m (Bool, Screen, Rectangle, Orientation))
-> IO (Bool, Screen, Rectangle, Orientation)
-> m (Bool, Screen, Rectangle, Orientation)
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    Ptr (Ptr Screen)
screen <- IO (Ptr (Ptr Screen))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gdk.Screen.Screen))
    Ptr Rectangle
area <- Int -> IO (Ptr Rectangle)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Gdk.Rectangle.Rectangle)
    Ptr CUInt
orientation <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr StatusIcon
-> Ptr (Ptr Screen) -> Ptr Rectangle -> Ptr CUInt -> IO CInt
gtk_status_icon_get_geometry Ptr StatusIcon
statusIcon' Ptr (Ptr Screen)
screen Ptr Rectangle
area Ptr CUInt
orientation
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Screen
screen' <- Ptr (Ptr Screen) -> IO (Ptr Screen)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Screen)
screen
    Screen
screen'' <- ((ManagedPtr Screen -> Screen) -> Ptr Screen -> IO Screen
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Screen -> Screen
Gdk.Screen.Screen) Ptr Screen
screen'
    Rectangle
area' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Gdk.Rectangle.Rectangle) Ptr Rectangle
area
    CUInt
orientation' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
orientation
    let orientation'' :: Orientation
orientation'' = (Int -> Orientation
forall a. Enum a => Int -> a
toEnum (Int -> Orientation) -> (CUInt -> Int) -> CUInt -> Orientation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
orientation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Ptr (Ptr Screen) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Screen)
screen
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
orientation
    (Bool, Screen, Rectangle, Orientation)
-> IO (Bool, Screen, Rectangle, Orientation)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Screen
screen'', Rectangle
area', Orientation
orientation'')

#if defined(ENABLE_OVERLOADING)
data StatusIconGetGeometryMethodInfo
instance (signature ~ (m ((Bool, Gdk.Screen.Screen, Gdk.Rectangle.Rectangle, Gtk.Enums.Orientation))), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetGeometryMethodInfo a signature where
    overloadedMethod = statusIconGetGeometry

#endif

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

foreign import ccall "gtk_status_icon_get_gicon" gtk_status_icon_get_gicon :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO (Ptr Gio.Icon.Icon)

{-# DEPRECATED statusIconGetGicon ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Retrieves the t'GI.Gio.Interfaces.Icon.Icon' being displayed by the t'GI.Gtk.Objects.StatusIcon.StatusIcon'.
-- The storage type of the status icon must be 'GI.Gtk.Enums.ImageTypeEmpty' or
-- 'GI.Gtk.Enums.ImageTypeGicon' (see 'GI.Gtk.Objects.StatusIcon.statusIconGetStorageType').
-- The caller of this function does not own a reference to the
-- returned t'GI.Gio.Interfaces.Icon.Icon'.
-- 
-- If this function fails, /@icon@/ is left unchanged;
-- 
-- /Since: 2.14/
statusIconGetGicon ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m (Maybe Gio.Icon.Icon)
    -- ^ __Returns:__ the displayed icon, or 'P.Nothing' if the image is empty
statusIconGetGicon :: a -> m (Maybe Icon)
statusIconGetGicon a
statusIcon = IO (Maybe Icon) -> m (Maybe Icon)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    Ptr Icon
result <- Ptr StatusIcon -> IO (Ptr Icon)
gtk_status_icon_get_gicon Ptr StatusIcon
statusIcon'
    Maybe Icon
maybeResult <- Ptr Icon -> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Icon
result ((Ptr Icon -> IO Icon) -> IO (Maybe Icon))
-> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ \Ptr Icon
result' -> do
        Icon
result'' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result'
        Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Maybe Icon -> IO (Maybe Icon)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Icon
maybeResult

#if defined(ENABLE_OVERLOADING)
data StatusIconGetGiconMethodInfo
instance (signature ~ (m (Maybe Gio.Icon.Icon)), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetGiconMethodInfo a signature where
    overloadedMethod = statusIconGetGicon

#endif

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

foreign import ccall "gtk_status_icon_get_has_tooltip" gtk_status_icon_get_has_tooltip :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO CInt

{-# DEPRECATED statusIconGetHasTooltip ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Returns the current value of the has-tooltip property.
-- See t'GI.Gtk.Objects.StatusIcon.StatusIcon':@/has-tooltip/@ for more information.
-- 
-- /Since: 2.16/
statusIconGetHasTooltip ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m Bool
    -- ^ __Returns:__ current value of has-tooltip on /@statusIcon@/.
statusIconGetHasTooltip :: a -> m Bool
statusIconGetHasTooltip a
statusIcon = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CInt
result <- Ptr StatusIcon -> IO CInt
gtk_status_icon_get_has_tooltip Ptr StatusIcon
statusIcon'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StatusIconGetHasTooltipMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetHasTooltipMethodInfo a signature where
    overloadedMethod = statusIconGetHasTooltip

#endif

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

foreign import ccall "gtk_status_icon_get_icon_name" gtk_status_icon_get_icon_name :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO CString

{-# DEPRECATED statusIconGetIconName ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Gets the name of the icon being displayed by the t'GI.Gtk.Objects.StatusIcon.StatusIcon'.
-- The storage type of the status icon must be 'GI.Gtk.Enums.ImageTypeEmpty' or
-- 'GI.Gtk.Enums.ImageTypeIconName' (see 'GI.Gtk.Objects.StatusIcon.statusIconGetStorageType').
-- The returned string is owned by the t'GI.Gtk.Objects.StatusIcon.StatusIcon' and should not
-- be freed or modified.
-- 
-- /Since: 2.10/
statusIconGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ name of the displayed icon, or 'P.Nothing' if the image is empty.
statusIconGetIconName :: a -> m (Maybe Text)
statusIconGetIconName a
statusIcon = 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
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
result <- Ptr StatusIcon -> IO CString
gtk_status_icon_get_icon_name Ptr StatusIcon
statusIcon'
    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 (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data StatusIconGetIconNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetIconNameMethodInfo a signature where
    overloadedMethod = statusIconGetIconName

#endif

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

foreign import ccall "gtk_status_icon_get_pixbuf" gtk_status_icon_get_pixbuf :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

{-# DEPRECATED statusIconGetPixbuf ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Gets the t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' being displayed by the t'GI.Gtk.Objects.StatusIcon.StatusIcon'.
-- The storage type of the status icon must be 'GI.Gtk.Enums.ImageTypeEmpty' or
-- 'GI.Gtk.Enums.ImageTypePixbuf' (see 'GI.Gtk.Objects.StatusIcon.statusIconGetStorageType').
-- The caller of this function does not own a reference to the
-- returned pixbuf.
-- 
-- /Since: 2.10/
statusIconGetPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    -- ^ __Returns:__ the displayed pixbuf,
    --     or 'P.Nothing' if the image is empty.
statusIconGetPixbuf :: a -> m (Maybe Pixbuf)
statusIconGetPixbuf a
statusIcon = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    Ptr Pixbuf
result <- Ptr StatusIcon -> IO (Ptr Pixbuf)
gtk_status_icon_get_pixbuf Ptr StatusIcon
statusIcon'
    Maybe Pixbuf
maybeResult <- Ptr Pixbuf -> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pixbuf
result ((Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf))
-> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
result' -> do
        Pixbuf
result'' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result'
        Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Maybe Pixbuf -> IO (Maybe Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
maybeResult

#if defined(ENABLE_OVERLOADING)
data StatusIconGetPixbufMethodInfo
instance (signature ~ (m (Maybe GdkPixbuf.Pixbuf.Pixbuf)), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetPixbufMethodInfo a signature where
    overloadedMethod = statusIconGetPixbuf

#endif

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

foreign import ccall "gtk_status_icon_get_screen" gtk_status_icon_get_screen :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO (Ptr Gdk.Screen.Screen)

{-# DEPRECATED statusIconGetScreen ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function, as notifications are managed by the platform"] #-}
-- | Returns the t'GI.Gdk.Objects.Screen.Screen' associated with /@statusIcon@/.
-- 
-- /Since: 2.12/
statusIconGetScreen ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m Gdk.Screen.Screen
    -- ^ __Returns:__ a t'GI.Gdk.Objects.Screen.Screen'.
statusIconGetScreen :: a -> m Screen
statusIconGetScreen a
statusIcon = IO Screen -> m Screen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Screen -> m Screen) -> IO Screen -> m Screen
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    Ptr Screen
result <- Ptr StatusIcon -> IO (Ptr Screen)
gtk_status_icon_get_screen Ptr StatusIcon
statusIcon'
    Text -> Ptr Screen -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"statusIconGetScreen" Ptr Screen
result
    Screen
result' <- ((ManagedPtr Screen -> Screen) -> Ptr Screen -> IO Screen
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Screen -> Screen
Gdk.Screen.Screen) Ptr Screen
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Screen -> IO Screen
forall (m :: * -> *) a. Monad m => a -> m a
return Screen
result'

#if defined(ENABLE_OVERLOADING)
data StatusIconGetScreenMethodInfo
instance (signature ~ (m Gdk.Screen.Screen), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetScreenMethodInfo a signature where
    overloadedMethod = statusIconGetScreen

#endif

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

foreign import ccall "gtk_status_icon_get_size" gtk_status_icon_get_size :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO Int32

{-# DEPRECATED statusIconGetSize ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function, as the representation of a notification","  is left to the platform"] #-}
-- | Gets the size in pixels that is available for the image.
-- Stock icons and named icons adapt their size automatically
-- if the size of the notification area changes. For other
-- storage types, the size-changed signal can be used to
-- react to size changes.
-- 
-- Note that the returned size is only meaningful while the
-- status icon is embedded (see 'GI.Gtk.Objects.StatusIcon.statusIconIsEmbedded').
-- 
-- /Since: 2.10/
statusIconGetSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m Int32
    -- ^ __Returns:__ the size that is available for the image
statusIconGetSize :: a -> m Int32
statusIconGetSize a
statusIcon = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    Int32
result <- Ptr StatusIcon -> IO Int32
gtk_status_icon_get_size Ptr StatusIcon
statusIcon'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data StatusIconGetSizeMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetSizeMethodInfo a signature where
    overloadedMethod = statusIconGetSize

#endif

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

foreign import ccall "gtk_status_icon_get_stock" gtk_status_icon_get_stock :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO CString

{-# DEPRECATED statusIconGetStock ["(Since version 3.10)","Use 'GI.Gtk.Objects.StatusIcon.statusIconGetIconName' instead."] #-}
-- | Gets the id of the stock icon being displayed by the t'GI.Gtk.Objects.StatusIcon.StatusIcon'.
-- The storage type of the status icon must be 'GI.Gtk.Enums.ImageTypeEmpty' or
-- 'GI.Gtk.Enums.ImageTypeStock' (see 'GI.Gtk.Objects.StatusIcon.statusIconGetStorageType').
-- The returned string is owned by the t'GI.Gtk.Objects.StatusIcon.StatusIcon' and should not
-- be freed or modified.
-- 
-- /Since: 2.10/
statusIconGetStock ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ stock id of the displayed stock icon,
    --   or 'P.Nothing' if the image is empty.
statusIconGetStock :: a -> m (Maybe Text)
statusIconGetStock a
statusIcon = 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
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
result <- Ptr StatusIcon -> IO CString
gtk_status_icon_get_stock Ptr StatusIcon
statusIcon'
    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 (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data StatusIconGetStockMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetStockMethodInfo a signature where
    overloadedMethod = statusIconGetStock

#endif

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

foreign import ccall "gtk_status_icon_get_storage_type" gtk_status_icon_get_storage_type :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO CUInt

{-# DEPRECATED statusIconGetStorageType ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function, and t'GI.Gio.Objects.Notification.Notification' only supports t'GI.Gio.Interfaces.Icon.Icon'","  instances"] #-}
-- | Gets the type of representation being used by the t'GI.Gtk.Objects.StatusIcon.StatusIcon'
-- to store image data. If the t'GI.Gtk.Objects.StatusIcon.StatusIcon' has no image data,
-- the return value will be 'GI.Gtk.Enums.ImageTypeEmpty'.
-- 
-- /Since: 2.10/
statusIconGetStorageType ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m Gtk.Enums.ImageType
    -- ^ __Returns:__ the image representation being used
statusIconGetStorageType :: a -> m ImageType
statusIconGetStorageType a
statusIcon = IO ImageType -> m ImageType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImageType -> m ImageType) -> IO ImageType -> m ImageType
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CUInt
result <- Ptr StatusIcon -> IO CUInt
gtk_status_icon_get_storage_type Ptr StatusIcon
statusIcon'
    let result' :: ImageType
result' = (Int -> ImageType
forall a. Enum a => Int -> a
toEnum (Int -> ImageType) -> (CUInt -> Int) -> CUInt -> ImageType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    ImageType -> IO ImageType
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
result'

#if defined(ENABLE_OVERLOADING)
data StatusIconGetStorageTypeMethodInfo
instance (signature ~ (m Gtk.Enums.ImageType), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetStorageTypeMethodInfo a signature where
    overloadedMethod = statusIconGetStorageType

#endif

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

foreign import ccall "gtk_status_icon_get_title" gtk_status_icon_get_title :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO CString

{-# DEPRECATED statusIconGetTitle ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Gets the title of this tray icon. See 'GI.Gtk.Objects.StatusIcon.statusIconSetTitle'.
-- 
-- /Since: 2.18/
statusIconGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m T.Text
    -- ^ __Returns:__ the title of the status icon
statusIconGetTitle :: a -> m Text
statusIconGetTitle a
statusIcon = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
result <- Ptr StatusIcon -> IO CString
gtk_status_icon_get_title Ptr StatusIcon
statusIcon'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"statusIconGetTitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data StatusIconGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetTitleMethodInfo a signature where
    overloadedMethod = statusIconGetTitle

#endif

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

foreign import ccall "gtk_status_icon_get_tooltip_markup" gtk_status_icon_get_tooltip_markup :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO CString

{-# DEPRECATED statusIconGetTooltipMarkup ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Gets the contents of the tooltip for /@statusIcon@/.
-- 
-- /Since: 2.16/
statusIconGetTooltipMarkup ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the tooltip text, or 'P.Nothing'. You should free the
    --   returned string with 'GI.GLib.Functions.free' when done.
statusIconGetTooltipMarkup :: a -> m (Maybe Text)
statusIconGetTooltipMarkup a
statusIcon = 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
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
result <- Ptr StatusIcon -> IO CString
gtk_status_icon_get_tooltip_markup Ptr StatusIcon
statusIcon'
    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'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data StatusIconGetTooltipMarkupMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetTooltipMarkupMethodInfo a signature where
    overloadedMethod = statusIconGetTooltipMarkup

#endif

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

foreign import ccall "gtk_status_icon_get_tooltip_text" gtk_status_icon_get_tooltip_text :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO CString

{-# DEPRECATED statusIconGetTooltipText ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Gets the contents of the tooltip for /@statusIcon@/.
-- 
-- /Since: 2.16/
statusIconGetTooltipText ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the tooltip text, or 'P.Nothing'. You should free the
    --   returned string with 'GI.GLib.Functions.free' when done.
statusIconGetTooltipText :: a -> m (Maybe Text)
statusIconGetTooltipText a
statusIcon = 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
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
result <- Ptr StatusIcon -> IO CString
gtk_status_icon_get_tooltip_text Ptr StatusIcon
statusIcon'
    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'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data StatusIconGetTooltipTextMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetTooltipTextMethodInfo a signature where
    overloadedMethod = statusIconGetTooltipText

#endif

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

foreign import ccall "gtk_status_icon_get_visible" gtk_status_icon_get_visible :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO CInt

{-# DEPRECATED statusIconGetVisible ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Returns whether the status icon is visible or not.
-- Note that being visible does not guarantee that
-- the user can actually see the icon, see also
-- 'GI.Gtk.Objects.StatusIcon.statusIconIsEmbedded'.
-- 
-- /Since: 2.10/
statusIconGetVisible ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the status icon is visible
statusIconGetVisible :: a -> m Bool
statusIconGetVisible a
statusIcon = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CInt
result <- Ptr StatusIcon -> IO CInt
gtk_status_icon_get_visible Ptr StatusIcon
statusIcon'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StatusIconGetVisibleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetVisibleMethodInfo a signature where
    overloadedMethod = statusIconGetVisible

#endif

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

foreign import ccall "gtk_status_icon_get_x11_window_id" gtk_status_icon_get_x11_window_id :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO Word32

{-# DEPRECATED statusIconGetX11WindowId ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | This function is only useful on the X11\/freedesktop.org platform.
-- 
-- It returns a window ID for the widget in the underlying
-- status icon implementation.  This is useful for the Galago
-- notification service, which can send a window ID in the protocol
-- in order for the server to position notification windows
-- pointing to a status icon reliably.
-- 
-- This function is not intended for other use cases which are
-- more likely to be met by one of the non-X11 specific methods, such
-- as 'GI.Gtk.Objects.StatusIcon.statusIconPositionMenu'.
-- 
-- /Since: 2.14/
statusIconGetX11WindowId ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m Word32
    -- ^ __Returns:__ An 32 bit unsigned integer identifier for the
    -- underlying X11 Window
statusIconGetX11WindowId :: a -> m Word32
statusIconGetX11WindowId a
statusIcon = IO Word32 -> m Word32
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 StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    Word32
result <- Ptr StatusIcon -> IO Word32
gtk_status_icon_get_x11_window_id Ptr StatusIcon
statusIcon'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data StatusIconGetX11WindowIdMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconGetX11WindowIdMethodInfo a signature where
    overloadedMethod = statusIconGetX11WindowId

#endif

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

foreign import ccall "gtk_status_icon_is_embedded" gtk_status_icon_is_embedded :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO CInt

{-# DEPRECATED statusIconIsEmbedded ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Returns whether the status icon is embedded in a notification
-- area.
-- 
-- /Since: 2.10/
statusIconIsEmbedded ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the status icon is embedded in
    --   a notification area.
statusIconIsEmbedded :: a -> m Bool
statusIconIsEmbedded a
statusIcon = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CInt
result <- Ptr StatusIcon -> IO CInt
gtk_status_icon_is_embedded Ptr StatusIcon
statusIcon'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StatusIconIsEmbeddedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconIsEmbeddedMethodInfo a signature where
    overloadedMethod = statusIconIsEmbedded

#endif

-- method StatusIcon::set_from_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a filename" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_from_file" gtk_status_icon_set_from_file :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    CString ->                              -- filename : TBasicType TFileName
    IO ()

{-# DEPRECATED statusIconSetFromFile ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; you can use 'GI.Gio.Objects.Notification.notificationSetIcon'","  to associate a t'GI.Gio.Interfaces.Icon.Icon' with a notification"] #-}
-- | Makes /@statusIcon@/ display the file /@filename@/.
-- See 'GI.Gtk.Objects.StatusIcon.statusIconNewFromFile' for details.
-- 
-- /Since: 2.10/
statusIconSetFromFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> [Char]
    -- ^ /@filename@/: a filename
    -> m ()
statusIconSetFromFile :: a -> String -> m ()
statusIconSetFromFile a
statusIcon String
filename = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
filename' <- String -> IO CString
stringToCString String
filename
    Ptr StatusIcon -> CString -> IO ()
gtk_status_icon_set_from_file Ptr StatusIcon
statusIcon' CString
filename'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetFromFileMethodInfo
instance (signature ~ ([Char] -> m ()), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconSetFromFileMethodInfo a signature where
    overloadedMethod = statusIconSetFromFile

#endif

-- method StatusIcon::set_from_gicon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_from_gicon" gtk_status_icon_set_from_gicon :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    Ptr Gio.Icon.Icon ->                    -- icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    IO ()

{-# DEPRECATED statusIconSetFromGicon ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; you can use 'GI.Gio.Objects.Notification.notificationSetIcon'","  to associate a t'GI.Gio.Interfaces.Icon.Icon' with a notification"] #-}
-- | Makes /@statusIcon@/ display the t'GI.Gio.Interfaces.Icon.Icon'.
-- See 'GI.Gtk.Objects.StatusIcon.statusIconNewFromGicon' for details.
-- 
-- /Since: 2.14/
statusIconSetFromGicon ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a, Gio.Icon.IsIcon b) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> b
    -- ^ /@icon@/: a GIcon
    -> m ()
statusIconSetFromGicon :: a -> b -> m ()
statusIconSetFromGicon a
statusIcon b
icon = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    Ptr Icon
icon' <- b -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
icon
    Ptr StatusIcon -> Ptr Icon -> IO ()
gtk_status_icon_set_from_gicon Ptr StatusIcon
statusIcon' Ptr Icon
icon'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
icon
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetFromGiconMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsStatusIcon a, Gio.Icon.IsIcon b) => O.MethodInfo StatusIconSetFromGiconMethodInfo a signature where
    overloadedMethod = statusIconSetFromGicon

#endif

-- method StatusIcon::set_from_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an icon name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_from_icon_name" gtk_status_icon_set_from_icon_name :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    CString ->                              -- icon_name : TBasicType TUTF8
    IO ()

{-# DEPRECATED statusIconSetFromIconName ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; you can use 'GI.Gio.Objects.Notification.notificationSetIcon'","  to associate a t'GI.Gio.Interfaces.Icon.Icon' with a notification"] #-}
-- | Makes /@statusIcon@/ display the icon named /@iconName@/ from the
-- current icon theme.
-- See 'GI.Gtk.Objects.StatusIcon.statusIconNewFromIconName' for details.
-- 
-- /Since: 2.10/
statusIconSetFromIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> T.Text
    -- ^ /@iconName@/: an icon name
    -> m ()
statusIconSetFromIconName :: a -> Text -> m ()
statusIconSetFromIconName a
statusIcon Text
iconName = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    Ptr StatusIcon -> CString -> IO ()
gtk_status_icon_set_from_icon_name Ptr StatusIcon
statusIcon' CString
iconName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetFromIconNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconSetFromIconNameMethodInfo a signature where
    overloadedMethod = statusIconSetFromIconName

#endif

-- method StatusIcon::set_from_pixbuf
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixbuf"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbuf or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_from_pixbuf" gtk_status_icon_set_from_pixbuf :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- pixbuf : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO ()

{-# DEPRECATED statusIconSetFromPixbuf ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; you can use 'GI.Gio.Objects.Notification.notificationSetIcon'","  to associate a t'GI.Gio.Interfaces.Icon.Icon' with a notification"] #-}
-- | Makes /@statusIcon@/ display /@pixbuf@/.
-- See 'GI.Gtk.Objects.StatusIcon.statusIconNewFromPixbuf' for details.
-- 
-- /Since: 2.10/
statusIconSetFromPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a, GdkPixbuf.Pixbuf.IsPixbuf b) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> Maybe (b)
    -- ^ /@pixbuf@/: a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' or 'P.Nothing'
    -> m ()
statusIconSetFromPixbuf :: a -> Maybe b -> m ()
statusIconSetFromPixbuf a
statusIcon Maybe b
pixbuf = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    Ptr Pixbuf
maybePixbuf <- case Maybe b
pixbuf of
        Maybe b
Nothing -> Ptr Pixbuf -> IO (Ptr Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
forall a. Ptr a
nullPtr
        Just b
jPixbuf -> do
            Ptr Pixbuf
jPixbuf' <- b -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPixbuf
            Ptr Pixbuf -> IO (Ptr Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
jPixbuf'
    Ptr StatusIcon -> Ptr Pixbuf -> IO ()
gtk_status_icon_set_from_pixbuf Ptr StatusIcon
statusIcon' Ptr Pixbuf
maybePixbuf
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
pixbuf b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetFromPixbufMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsStatusIcon a, GdkPixbuf.Pixbuf.IsPixbuf b) => O.MethodInfo StatusIconSetFromPixbufMethodInfo a signature where
    overloadedMethod = statusIconSetFromPixbuf

#endif

-- method StatusIcon::set_from_stock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stock_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a stock icon id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_from_stock" gtk_status_icon_set_from_stock :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    CString ->                              -- stock_id : TBasicType TUTF8
    IO ()

{-# DEPRECATED statusIconSetFromStock ["(Since version 3.10)","Use 'GI.Gtk.Objects.StatusIcon.statusIconSetFromIconName' instead."] #-}
-- | Makes /@statusIcon@/ display the stock icon with the id /@stockId@/.
-- See 'GI.Gtk.Objects.StatusIcon.statusIconNewFromStock' for details.
-- 
-- /Since: 2.10/
statusIconSetFromStock ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> T.Text
    -- ^ /@stockId@/: a stock icon id
    -> m ()
statusIconSetFromStock :: a -> Text -> m ()
statusIconSetFromStock a
statusIcon Text
stockId = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
stockId' <- Text -> IO CString
textToCString Text
stockId
    Ptr StatusIcon -> CString -> IO ()
gtk_status_icon_set_from_stock Ptr StatusIcon
statusIcon' CString
stockId'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stockId'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetFromStockMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconSetFromStockMethodInfo a signature where
    overloadedMethod = statusIconSetFromStock

#endif

-- method StatusIcon::set_has_tooltip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "has_tooltip"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether or not @status_icon has a tooltip"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_has_tooltip" gtk_status_icon_set_has_tooltip :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    CInt ->                                 -- has_tooltip : TBasicType TBoolean
    IO ()

{-# DEPRECATED statusIconSetHasTooltip ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function, but notifications can display an arbitrary","  amount of text using 'GI.Gio.Objects.Notification.notificationSetBody'"] #-}
-- | Sets the has-tooltip property on /@statusIcon@/ to /@hasTooltip@/.
-- See t'GI.Gtk.Objects.StatusIcon.StatusIcon':@/has-tooltip/@ for more information.
-- 
-- /Since: 2.16/
statusIconSetHasTooltip ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> Bool
    -- ^ /@hasTooltip@/: whether or not /@statusIcon@/ has a tooltip
    -> m ()
statusIconSetHasTooltip :: a -> Bool -> m ()
statusIconSetHasTooltip a
statusIcon Bool
hasTooltip = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    let hasTooltip' :: CInt
hasTooltip' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
hasTooltip
    Ptr StatusIcon -> CInt -> IO ()
gtk_status_icon_set_has_tooltip Ptr StatusIcon
statusIcon' CInt
hasTooltip'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetHasTooltipMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconSetHasTooltipMethodInfo a signature where
    overloadedMethod = statusIconSetHasTooltip

#endif

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

foreign import ccall "gtk_status_icon_set_name" gtk_status_icon_set_name :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

{-# DEPRECATED statusIconSetName ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function, as notifications are associated with a","  unique application identifier by t'GI.Gio.Objects.Application.Application'"] #-}
-- | Sets the name of this tray icon.
-- This should be a string identifying this icon. It is may be
-- used for sorting the icons in the tray and will not be shown to
-- the user.
-- 
-- /Since: 2.20/
statusIconSetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> T.Text
    -- ^ /@name@/: the name
    -> m ()
statusIconSetName :: a -> Text -> m ()
statusIconSetName a
statusIcon Text
name = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr StatusIcon -> CString -> IO ()
gtk_status_icon_set_name Ptr StatusIcon
statusIcon' CString
name'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconSetNameMethodInfo a signature where
    overloadedMethod = statusIconSetName

#endif

-- method StatusIcon::set_screen
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_screen" gtk_status_icon_set_screen :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    Ptr Gdk.Screen.Screen ->                -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO ()

{-# DEPRECATED statusIconSetScreen ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function, as GTK typically only has one t'GI.Gdk.Objects.Screen.Screen'","  and notifications are managed by the platform"] #-}
-- | Sets the t'GI.Gdk.Objects.Screen.Screen' where /@statusIcon@/ is displayed; if
-- the icon is already mapped, it will be unmapped, and
-- then remapped on the new screen.
-- 
-- /Since: 2.12/
statusIconSetScreen ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a, Gdk.Screen.IsScreen b) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> b
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m ()
statusIconSetScreen :: a -> b -> m ()
statusIconSetScreen a
statusIcon b
screen = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    Ptr Screen
screen' <- b -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
screen
    Ptr StatusIcon -> Ptr Screen -> IO ()
gtk_status_icon_set_screen Ptr StatusIcon
statusIcon' Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
screen
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetScreenMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsStatusIcon a, Gdk.Screen.IsScreen b) => O.MethodInfo StatusIconSetScreenMethodInfo a signature where
    overloadedMethod = statusIconSetScreen

#endif

-- method StatusIcon::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the title" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_title" gtk_status_icon_set_title :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

{-# DEPRECATED statusIconSetTitle ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; you should use 'GI.Gio.Objects.Notification.notificationSetTitle'","  and 'GI.Gio.Objects.Notification.notificationSetBody' to present text inside your notification"] #-}
-- | Sets the title of this tray icon.
-- This should be a short, human-readable, localized string
-- describing the tray icon. It may be used by tools like screen
-- readers to render the tray icon.
-- 
-- /Since: 2.18/
statusIconSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> T.Text
    -- ^ /@title@/: the title
    -> m ()
statusIconSetTitle :: a -> Text -> m ()
statusIconSetTitle a
statusIcon Text
title = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr StatusIcon -> CString -> IO ()
gtk_status_icon_set_title Ptr StatusIcon
statusIcon' CString
title'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetTitleMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconSetTitleMethodInfo a signature where
    overloadedMethod = statusIconSetTitle

#endif

-- method StatusIcon::set_tooltip_markup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "markup"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the contents of the tooltip for @status_icon, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_tooltip_markup" gtk_status_icon_set_tooltip_markup :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    CString ->                              -- markup : TBasicType TUTF8
    IO ()

{-# DEPRECATED statusIconSetTooltipMarkup ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Sets /@markup@/ as the contents of the tooltip, which is marked up with
--  the [Pango text markup language][PangoMarkupFormat].
-- 
-- This function will take care of setting t'GI.Gtk.Objects.StatusIcon.StatusIcon':@/has-tooltip/@ to 'P.True'
-- and of the default handler for the [queryTooltip]("GI.Gtk.Objects.StatusIcon#g:signal:queryTooltip") signal.
-- 
-- See also the t'GI.Gtk.Objects.StatusIcon.StatusIcon':@/tooltip-markup/@ property and
-- 'GI.Gtk.Objects.Tooltip.tooltipSetMarkup'.
-- 
-- /Since: 2.16/
statusIconSetTooltipMarkup ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> Maybe (T.Text)
    -- ^ /@markup@/: the contents of the tooltip for /@statusIcon@/, or 'P.Nothing'
    -> m ()
statusIconSetTooltipMarkup :: a -> Maybe Text -> m ()
statusIconSetTooltipMarkup a
statusIcon Maybe Text
markup = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
maybeMarkup <- case Maybe Text
markup of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jMarkup -> do
            CString
jMarkup' <- Text -> IO CString
textToCString Text
jMarkup
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jMarkup'
    Ptr StatusIcon -> CString -> IO ()
gtk_status_icon_set_tooltip_markup Ptr StatusIcon
statusIcon' CString
maybeMarkup
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeMarkup
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- method StatusIcon::set_tooltip_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the contents of the tooltip for @status_icon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_tooltip_text" gtk_status_icon_set_tooltip_text :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    CString ->                              -- text : TBasicType TUTF8
    IO ()

{-# DEPRECATED statusIconSetTooltipText ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function"] #-}
-- | Sets /@text@/ as the contents of the tooltip.
-- 
-- This function will take care of setting t'GI.Gtk.Objects.StatusIcon.StatusIcon':@/has-tooltip/@ to
-- 'P.True' and of the default handler for the [queryTooltip]("GI.Gtk.Objects.StatusIcon#g:signal:queryTooltip")
-- signal.
-- 
-- See also the t'GI.Gtk.Objects.StatusIcon.StatusIcon':@/tooltip-text/@ property and
-- 'GI.Gtk.Objects.Tooltip.tooltipSetText'.
-- 
-- /Since: 2.16/
statusIconSetTooltipText ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> T.Text
    -- ^ /@text@/: the contents of the tooltip for /@statusIcon@/
    -> m ()
statusIconSetTooltipText :: a -> Text -> m ()
statusIconSetTooltipText a
statusIcon Text
text = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr StatusIcon -> CString -> IO ()
gtk_status_icon_set_tooltip_text Ptr StatusIcon
statusIcon' CString
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetTooltipTextMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconSetTooltipTextMethodInfo a signature where
    overloadedMethod = statusIconSetTooltipText

#endif

-- method StatusIcon::set_visible
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "status_icon"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStatusIcon" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "visible"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE to show the status icon, %FALSE to hide it"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_set_visible" gtk_status_icon_set_visible :: 
    Ptr StatusIcon ->                       -- status_icon : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    CInt ->                                 -- visible : TBasicType TBoolean
    IO ()

{-# DEPRECATED statusIconSetVisible ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; there is no direct replacement","  for this function, as notifications are managed by the platform"] #-}
-- | Shows or hides a status icon.
-- 
-- /Since: 2.10/
statusIconSetVisible ::
    (B.CallStack.HasCallStack, MonadIO m, IsStatusIcon a) =>
    a
    -- ^ /@statusIcon@/: a t'GI.Gtk.Objects.StatusIcon.StatusIcon'
    -> Bool
    -- ^ /@visible@/: 'P.True' to show the status icon, 'P.False' to hide it
    -> m ()
statusIconSetVisible :: a -> Bool -> m ()
statusIconSetVisible a
statusIcon Bool
visible = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StatusIcon
statusIcon' <- a -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
statusIcon
    let visible' :: CInt
visible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
visible
    Ptr StatusIcon -> CInt -> IO ()
gtk_status_icon_set_visible Ptr StatusIcon
statusIcon' CInt
visible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
statusIcon
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StatusIconSetVisibleMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsStatusIcon a) => O.MethodInfo StatusIconSetVisibleMethodInfo a signature where
    overloadedMethod = statusIconSetVisible

#endif

-- method StatusIcon::position_menu
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the x position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the y position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "push_in"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether the first menu item should be offset\n          (pushed in) to be aligned with the menu popup position\n          (only useful for GtkOptionMenu)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StatusIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the status icon to position the menu on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_status_icon_position_menu" gtk_status_icon_position_menu :: 
    Ptr Gtk.Menu.Menu ->                    -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    Ptr Int32 ->                            -- x : TBasicType TInt
    Ptr Int32 ->                            -- y : TBasicType TInt
    Ptr CInt ->                             -- push_in : TBasicType TBoolean
    Ptr StatusIcon ->                       -- user_data : TInterface (Name {namespace = "Gtk", name = "StatusIcon"})
    IO ()

{-# DEPRECATED statusIconPositionMenu ["(Since version 3.14)","Use t'GI.Gio.Objects.Notification.Notification' and t'GI.Gtk.Objects.Application.Application' to","  provide status notifications; notifications do not have menus,","  but can have buttons, and actions associated with each button"] #-}
-- | Menu positioning function to use with 'GI.Gtk.Objects.Menu.menuPopup'
-- to position /@menu@/ aligned to the status icon /@userData@/.
-- 
-- /Since: 2.10/
statusIconPositionMenu ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Menu.IsMenu a, IsStatusIcon b) =>
    a
    -- ^ /@menu@/: the t'GI.Gtk.Objects.Menu.Menu'
    -> Int32
    -- ^ /@x@/: return location for the x position
    -> Int32
    -- ^ /@y@/: return location for the y position
    -> b
    -- ^ /@userData@/: the status icon to position the menu on
    -> m ((Int32, Int32, Bool))
statusIconPositionMenu :: a -> Int32 -> Int32 -> b -> m (Int32, Int32, Bool)
statusIconPositionMenu a
menu Int32
x Int32
y b
userData = IO (Int32, Int32, Bool) -> m (Int32, Int32, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32, Bool) -> m (Int32, Int32, Bool))
-> IO (Int32, Int32, Bool) -> m (Int32, Int32, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Int32
x' <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int32
x' Int32
x
    Ptr Int32
y' <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int32
y' Int32
y
    Ptr CInt
pushIn <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr StatusIcon
userData' <- b -> IO (Ptr StatusIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
userData
    Ptr Menu
-> Ptr Int32 -> Ptr Int32 -> Ptr CInt -> Ptr StatusIcon -> IO ()
gtk_status_icon_position_menu Ptr Menu
menu' Ptr Int32
x' Ptr Int32
y' Ptr CInt
pushIn Ptr StatusIcon
userData'
    Int32
x'' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
    Int32
y'' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
    CInt
pushIn' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pushIn
    let pushIn'' :: Bool
pushIn'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
pushIn'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
userData
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
x'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
y'
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
pushIn
    (Int32, Int32, Bool) -> IO (Int32, Int32, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
x'', Int32
y'', Bool
pushIn'')

#if defined(ENABLE_OVERLOADING)
#endif