{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gtk.Objects.RecentAction.RecentAction' represents a list of recently used files, which
-- can be shown by widgets such as t'GI.Gtk.Objects.RecentChooserDialog.RecentChooserDialog' or
-- t'GI.Gtk.Objects.RecentChooserMenu.RecentChooserMenu'.
-- 
-- To construct a submenu showing recently used files, use a t'GI.Gtk.Objects.RecentAction.RecentAction'
-- as the action for a \<menuitem>. To construct a menu toolbutton showing
-- the recently used files in the popup menu, use a t'GI.Gtk.Objects.RecentAction.RecentAction' as the
-- action for a \<toolitem> element.

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

module GI.Gtk.Objects.RecentAction
    ( 

-- * Exported types
    RecentAction(..)                        ,
    IsRecentAction                          ,
    toRecentAction                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveRecentActionMethod               ,
#endif


-- ** getShowNumbers #method:getShowNumbers#

#if defined(ENABLE_OVERLOADING)
    RecentActionGetShowNumbersMethodInfo    ,
#endif
    recentActionGetShowNumbers              ,


-- ** new #method:new#

    recentActionNew                         ,


-- ** newForManager #method:newForManager#

    recentActionNewForManager               ,


-- ** setShowNumbers #method:setShowNumbers#

#if defined(ENABLE_OVERLOADING)
    RecentActionSetShowNumbersMethodInfo    ,
#endif
    recentActionSetShowNumbers              ,




 -- * Properties
-- ** showNumbers #attr:showNumbers#
-- | Whether the items should be displayed with a number.

#if defined(ENABLE_OVERLOADING)
    RecentActionShowNumbersPropertyInfo     ,
#endif
    constructRecentActionShowNumbers        ,
    getRecentActionShowNumbers              ,
#if defined(ENABLE_OVERLOADING)
    recentActionShowNumbers                 ,
#endif
    setRecentActionShowNumbers              ,




    ) 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 {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.RecentChooser as Gtk.RecentChooser
import {-# SOURCE #-} qualified GI.Gtk.Objects.Action as Gtk.Action
import {-# SOURCE #-} qualified GI.Gtk.Objects.RecentManager as Gtk.RecentManager

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

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

foreign import ccall "gtk_recent_action_get_type"
    c_gtk_recent_action_get_type :: IO B.Types.GType

instance B.Types.TypedObject RecentAction where
    glibType :: IO GType
glibType = IO GType
c_gtk_recent_action_get_type

instance B.Types.GObject RecentAction

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

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

instance O.HasParentTypes RecentAction
type instance O.ParentTypes RecentAction = '[Gtk.Action.Action, GObject.Object.Object, Gtk.Buildable.Buildable, Gtk.RecentChooser.RecentChooser]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveRecentActionMethod (t :: Symbol) (o :: *) :: * where
    ResolveRecentActionMethod "activate" o = Gtk.Action.ActionActivateMethodInfo
    ResolveRecentActionMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveRecentActionMethod "addFilter" o = Gtk.RecentChooser.RecentChooserAddFilterMethodInfo
    ResolveRecentActionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRecentActionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRecentActionMethod "blockActivate" o = Gtk.Action.ActionBlockActivateMethodInfo
    ResolveRecentActionMethod "connectAccelerator" o = Gtk.Action.ActionConnectAcceleratorMethodInfo
    ResolveRecentActionMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveRecentActionMethod "createIcon" o = Gtk.Action.ActionCreateIconMethodInfo
    ResolveRecentActionMethod "createMenu" o = Gtk.Action.ActionCreateMenuMethodInfo
    ResolveRecentActionMethod "createMenuItem" o = Gtk.Action.ActionCreateMenuItemMethodInfo
    ResolveRecentActionMethod "createToolItem" o = Gtk.Action.ActionCreateToolItemMethodInfo
    ResolveRecentActionMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveRecentActionMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveRecentActionMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveRecentActionMethod "disconnectAccelerator" o = Gtk.Action.ActionDisconnectAcceleratorMethodInfo
    ResolveRecentActionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRecentActionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRecentActionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRecentActionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRecentActionMethod "isSensitive" o = Gtk.Action.ActionIsSensitiveMethodInfo
    ResolveRecentActionMethod "isVisible" o = Gtk.Action.ActionIsVisibleMethodInfo
    ResolveRecentActionMethod "listFilters" o = Gtk.RecentChooser.RecentChooserListFiltersMethodInfo
    ResolveRecentActionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRecentActionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRecentActionMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveRecentActionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRecentActionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRecentActionMethod "removeFilter" o = Gtk.RecentChooser.RecentChooserRemoveFilterMethodInfo
    ResolveRecentActionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRecentActionMethod "selectAll" o = Gtk.RecentChooser.RecentChooserSelectAllMethodInfo
    ResolveRecentActionMethod "selectUri" o = Gtk.RecentChooser.RecentChooserSelectUriMethodInfo
    ResolveRecentActionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRecentActionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRecentActionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRecentActionMethod "unblockActivate" o = Gtk.Action.ActionUnblockActivateMethodInfo
    ResolveRecentActionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRecentActionMethod "unselectAll" o = Gtk.RecentChooser.RecentChooserUnselectAllMethodInfo
    ResolveRecentActionMethod "unselectUri" o = Gtk.RecentChooser.RecentChooserUnselectUriMethodInfo
    ResolveRecentActionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRecentActionMethod "getAccelClosure" o = Gtk.Action.ActionGetAccelClosureMethodInfo
    ResolveRecentActionMethod "getAccelPath" o = Gtk.Action.ActionGetAccelPathMethodInfo
    ResolveRecentActionMethod "getAlwaysShowImage" o = Gtk.Action.ActionGetAlwaysShowImageMethodInfo
    ResolveRecentActionMethod "getCurrentItem" o = Gtk.RecentChooser.RecentChooserGetCurrentItemMethodInfo
    ResolveRecentActionMethod "getCurrentUri" o = Gtk.RecentChooser.RecentChooserGetCurrentUriMethodInfo
    ResolveRecentActionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRecentActionMethod "getFilter" o = Gtk.RecentChooser.RecentChooserGetFilterMethodInfo
    ResolveRecentActionMethod "getGicon" o = Gtk.Action.ActionGetGiconMethodInfo
    ResolveRecentActionMethod "getIconName" o = Gtk.Action.ActionGetIconNameMethodInfo
    ResolveRecentActionMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveRecentActionMethod "getIsImportant" o = Gtk.Action.ActionGetIsImportantMethodInfo
    ResolveRecentActionMethod "getItems" o = Gtk.RecentChooser.RecentChooserGetItemsMethodInfo
    ResolveRecentActionMethod "getLabel" o = Gtk.Action.ActionGetLabelMethodInfo
    ResolveRecentActionMethod "getLimit" o = Gtk.RecentChooser.RecentChooserGetLimitMethodInfo
    ResolveRecentActionMethod "getLocalOnly" o = Gtk.RecentChooser.RecentChooserGetLocalOnlyMethodInfo
    ResolveRecentActionMethod "getName" o = Gtk.Action.ActionGetNameMethodInfo
    ResolveRecentActionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRecentActionMethod "getProxies" o = Gtk.Action.ActionGetProxiesMethodInfo
    ResolveRecentActionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRecentActionMethod "getSelectMultiple" o = Gtk.RecentChooser.RecentChooserGetSelectMultipleMethodInfo
    ResolveRecentActionMethod "getSensitive" o = Gtk.Action.ActionGetSensitiveMethodInfo
    ResolveRecentActionMethod "getShortLabel" o = Gtk.Action.ActionGetShortLabelMethodInfo
    ResolveRecentActionMethod "getShowIcons" o = Gtk.RecentChooser.RecentChooserGetShowIconsMethodInfo
    ResolveRecentActionMethod "getShowNotFound" o = Gtk.RecentChooser.RecentChooserGetShowNotFoundMethodInfo
    ResolveRecentActionMethod "getShowNumbers" o = RecentActionGetShowNumbersMethodInfo
    ResolveRecentActionMethod "getShowPrivate" o = Gtk.RecentChooser.RecentChooserGetShowPrivateMethodInfo
    ResolveRecentActionMethod "getShowTips" o = Gtk.RecentChooser.RecentChooserGetShowTipsMethodInfo
    ResolveRecentActionMethod "getSortType" o = Gtk.RecentChooser.RecentChooserGetSortTypeMethodInfo
    ResolveRecentActionMethod "getStockId" o = Gtk.Action.ActionGetStockIdMethodInfo
    ResolveRecentActionMethod "getTooltip" o = Gtk.Action.ActionGetTooltipMethodInfo
    ResolveRecentActionMethod "getUris" o = Gtk.RecentChooser.RecentChooserGetUrisMethodInfo
    ResolveRecentActionMethod "getVisible" o = Gtk.Action.ActionGetVisibleMethodInfo
    ResolveRecentActionMethod "getVisibleHorizontal" o = Gtk.Action.ActionGetVisibleHorizontalMethodInfo
    ResolveRecentActionMethod "getVisibleVertical" o = Gtk.Action.ActionGetVisibleVerticalMethodInfo
    ResolveRecentActionMethod "setAccelGroup" o = Gtk.Action.ActionSetAccelGroupMethodInfo
    ResolveRecentActionMethod "setAccelPath" o = Gtk.Action.ActionSetAccelPathMethodInfo
    ResolveRecentActionMethod "setAlwaysShowImage" o = Gtk.Action.ActionSetAlwaysShowImageMethodInfo
    ResolveRecentActionMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveRecentActionMethod "setCurrentUri" o = Gtk.RecentChooser.RecentChooserSetCurrentUriMethodInfo
    ResolveRecentActionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRecentActionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRecentActionMethod "setFilter" o = Gtk.RecentChooser.RecentChooserSetFilterMethodInfo
    ResolveRecentActionMethod "setGicon" o = Gtk.Action.ActionSetGiconMethodInfo
    ResolveRecentActionMethod "setIconName" o = Gtk.Action.ActionSetIconNameMethodInfo
    ResolveRecentActionMethod "setIsImportant" o = Gtk.Action.ActionSetIsImportantMethodInfo
    ResolveRecentActionMethod "setLabel" o = Gtk.Action.ActionSetLabelMethodInfo
    ResolveRecentActionMethod "setLimit" o = Gtk.RecentChooser.RecentChooserSetLimitMethodInfo
    ResolveRecentActionMethod "setLocalOnly" o = Gtk.RecentChooser.RecentChooserSetLocalOnlyMethodInfo
    ResolveRecentActionMethod "setName" o = Gtk.Buildable.BuildableSetNameMethodInfo
    ResolveRecentActionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRecentActionMethod "setSelectMultiple" o = Gtk.RecentChooser.RecentChooserSetSelectMultipleMethodInfo
    ResolveRecentActionMethod "setSensitive" o = Gtk.Action.ActionSetSensitiveMethodInfo
    ResolveRecentActionMethod "setShortLabel" o = Gtk.Action.ActionSetShortLabelMethodInfo
    ResolveRecentActionMethod "setShowIcons" o = Gtk.RecentChooser.RecentChooserSetShowIconsMethodInfo
    ResolveRecentActionMethod "setShowNotFound" o = Gtk.RecentChooser.RecentChooserSetShowNotFoundMethodInfo
    ResolveRecentActionMethod "setShowNumbers" o = RecentActionSetShowNumbersMethodInfo
    ResolveRecentActionMethod "setShowPrivate" o = Gtk.RecentChooser.RecentChooserSetShowPrivateMethodInfo
    ResolveRecentActionMethod "setShowTips" o = Gtk.RecentChooser.RecentChooserSetShowTipsMethodInfo
    ResolveRecentActionMethod "setSortFunc" o = Gtk.RecentChooser.RecentChooserSetSortFuncMethodInfo
    ResolveRecentActionMethod "setSortType" o = Gtk.RecentChooser.RecentChooserSetSortTypeMethodInfo
    ResolveRecentActionMethod "setStockId" o = Gtk.Action.ActionSetStockIdMethodInfo
    ResolveRecentActionMethod "setTooltip" o = Gtk.Action.ActionSetTooltipMethodInfo
    ResolveRecentActionMethod "setVisible" o = Gtk.Action.ActionSetVisibleMethodInfo
    ResolveRecentActionMethod "setVisibleHorizontal" o = Gtk.Action.ActionSetVisibleHorizontalMethodInfo
    ResolveRecentActionMethod "setVisibleVertical" o = Gtk.Action.ActionSetVisibleVerticalMethodInfo
    ResolveRecentActionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data RecentActionShowNumbersPropertyInfo
instance AttrInfo RecentActionShowNumbersPropertyInfo where
    type AttrAllowedOps RecentActionShowNumbersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint RecentActionShowNumbersPropertyInfo = IsRecentAction
    type AttrSetTypeConstraint RecentActionShowNumbersPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint RecentActionShowNumbersPropertyInfo = (~) Bool
    type AttrTransferType RecentActionShowNumbersPropertyInfo = Bool
    type AttrGetType RecentActionShowNumbersPropertyInfo = Bool
    type AttrLabel RecentActionShowNumbersPropertyInfo = "show-numbers"
    type AttrOrigin RecentActionShowNumbersPropertyInfo = RecentAction
    attrGet = getRecentActionShowNumbers
    attrSet = setRecentActionShowNumbers
    attrTransfer _ v = do
        return v
    attrConstruct = constructRecentActionShowNumbers
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList RecentAction
type instance O.AttributeList RecentAction = RecentActionAttributeList
type RecentActionAttributeList = ('[ '("actionGroup", Gtk.Action.ActionActionGroupPropertyInfo), '("alwaysShowImage", Gtk.Action.ActionAlwaysShowImagePropertyInfo), '("filter", Gtk.RecentChooser.RecentChooserFilterPropertyInfo), '("gicon", Gtk.Action.ActionGiconPropertyInfo), '("hideIfEmpty", Gtk.Action.ActionHideIfEmptyPropertyInfo), '("iconName", Gtk.Action.ActionIconNamePropertyInfo), '("isImportant", Gtk.Action.ActionIsImportantPropertyInfo), '("label", Gtk.Action.ActionLabelPropertyInfo), '("limit", Gtk.RecentChooser.RecentChooserLimitPropertyInfo), '("localOnly", Gtk.RecentChooser.RecentChooserLocalOnlyPropertyInfo), '("name", Gtk.Action.ActionNamePropertyInfo), '("recentManager", Gtk.RecentChooser.RecentChooserRecentManagerPropertyInfo), '("selectMultiple", Gtk.RecentChooser.RecentChooserSelectMultiplePropertyInfo), '("sensitive", Gtk.Action.ActionSensitivePropertyInfo), '("shortLabel", Gtk.Action.ActionShortLabelPropertyInfo), '("showIcons", Gtk.RecentChooser.RecentChooserShowIconsPropertyInfo), '("showNotFound", Gtk.RecentChooser.RecentChooserShowNotFoundPropertyInfo), '("showNumbers", RecentActionShowNumbersPropertyInfo), '("showPrivate", Gtk.RecentChooser.RecentChooserShowPrivatePropertyInfo), '("showTips", Gtk.RecentChooser.RecentChooserShowTipsPropertyInfo), '("sortType", Gtk.RecentChooser.RecentChooserSortTypePropertyInfo), '("stockId", Gtk.Action.ActionStockIdPropertyInfo), '("tooltip", Gtk.Action.ActionTooltipPropertyInfo), '("visible", Gtk.Action.ActionVisiblePropertyInfo), '("visibleHorizontal", Gtk.Action.ActionVisibleHorizontalPropertyInfo), '("visibleOverflown", Gtk.Action.ActionVisibleOverflownPropertyInfo), '("visibleVertical", Gtk.Action.ActionVisibleVerticalPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
recentActionShowNumbers :: AttrLabelProxy "showNumbers"
recentActionShowNumbers = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList RecentAction = RecentActionSignalList
type RecentActionSignalList = ('[ '("activate", Gtk.Action.ActionActivateSignalInfo), '("itemActivated", Gtk.RecentChooser.RecentChooserItemActivatedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("selectionChanged", Gtk.RecentChooser.RecentChooserSelectionChangedSignalInfo)] :: [(Symbol, *)])

#endif

-- method RecentAction::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a unique name for the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the label displayed in menu items and on buttons,\n  or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tooltip"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tooltip for the action, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stock_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the stock icon to display in widgets representing\n  the action, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "RecentAction" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_recent_action_new" gtk_recent_action_new :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- label : TBasicType TUTF8
    CString ->                              -- tooltip : TBasicType TUTF8
    CString ->                              -- stock_id : TBasicType TUTF8
    IO (Ptr RecentAction)

{-# DEPRECATED recentActionNew ["(Since version 3.10)"] #-}
-- | Creates a new t'GI.Gtk.Objects.RecentAction.RecentAction' object. To add the action to
-- a t'GI.Gtk.Objects.ActionGroup.ActionGroup' and set the accelerator for the action,
-- call 'GI.Gtk.Objects.ActionGroup.actionGroupAddActionWithAccel'.
-- 
-- /Since: 2.12/
recentActionNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: a unique name for the action
    -> Maybe (T.Text)
    -- ^ /@label@/: the label displayed in menu items and on buttons,
    --   or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@tooltip@/: a tooltip for the action, or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@stockId@/: the stock icon to display in widgets representing
    --   the action, or 'P.Nothing'
    -> m RecentAction
    -- ^ __Returns:__ the newly created t'GI.Gtk.Objects.RecentAction.RecentAction'.
recentActionNew :: Text -> Maybe Text -> Maybe Text -> Maybe Text -> m RecentAction
recentActionNew Text
name Maybe Text
label Maybe Text
tooltip Maybe Text
stockId = IO RecentAction -> m RecentAction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RecentAction -> m RecentAction)
-> IO RecentAction -> m RecentAction
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            CString
jLabel' <- Text -> IO CString
textToCString Text
jLabel
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jLabel'
    CString
maybeTooltip <- case Maybe Text
tooltip of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jTooltip -> do
            CString
jTooltip' <- Text -> IO CString
textToCString Text
jTooltip
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTooltip'
    CString
maybeStockId <- case Maybe Text
stockId of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jStockId -> do
            CString
jStockId' <- Text -> IO CString
textToCString Text
jStockId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jStockId'
    Ptr RecentAction
result <- CString -> CString -> CString -> CString -> IO (Ptr RecentAction)
gtk_recent_action_new CString
name' CString
maybeLabel CString
maybeTooltip CString
maybeStockId
    Text -> Ptr RecentAction -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"recentActionNew" Ptr RecentAction
result
    RecentAction
result' <- ((ManagedPtr RecentAction -> RecentAction)
-> Ptr RecentAction -> IO RecentAction
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr RecentAction -> RecentAction
RecentAction) Ptr RecentAction
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeLabel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTooltip
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeStockId
    RecentAction -> IO RecentAction
forall (m :: * -> *) a. Monad m => a -> m a
return RecentAction
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method RecentAction::new_for_manager
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a unique name for the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the label displayed in menu items and on buttons,\n  or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tooltip"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tooltip for the action, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stock_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the stock icon to display in widgets representing\n  the action, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "RecentManager" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GtkRecentManager, or %NULL for using the default\n  #GtkRecentManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "RecentAction" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_recent_action_new_for_manager" gtk_recent_action_new_for_manager :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- label : TBasicType TUTF8
    CString ->                              -- tooltip : TBasicType TUTF8
    CString ->                              -- stock_id : TBasicType TUTF8
    Ptr Gtk.RecentManager.RecentManager ->  -- manager : TInterface (Name {namespace = "Gtk", name = "RecentManager"})
    IO (Ptr RecentAction)

{-# DEPRECATED recentActionNewForManager ["(Since version 3.10)"] #-}
-- | Creates a new t'GI.Gtk.Objects.RecentAction.RecentAction' object. To add the action to
-- a t'GI.Gtk.Objects.ActionGroup.ActionGroup' and set the accelerator for the action,
-- call 'GI.Gtk.Objects.ActionGroup.actionGroupAddActionWithAccel'.
-- 
-- /Since: 2.12/
recentActionNewForManager ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.RecentManager.IsRecentManager a) =>
    T.Text
    -- ^ /@name@/: a unique name for the action
    -> Maybe (T.Text)
    -- ^ /@label@/: the label displayed in menu items and on buttons,
    --   or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@tooltip@/: a tooltip for the action, or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@stockId@/: the stock icon to display in widgets representing
    --   the action, or 'P.Nothing'
    -> Maybe (a)
    -- ^ /@manager@/: a t'GI.Gtk.Objects.RecentManager.RecentManager', or 'P.Nothing' for using the default
    --   t'GI.Gtk.Objects.RecentManager.RecentManager'
    -> m RecentAction
    -- ^ __Returns:__ the newly created t'GI.Gtk.Objects.RecentAction.RecentAction'
recentActionNewForManager :: Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe a
-> m RecentAction
recentActionNewForManager Text
name Maybe Text
label Maybe Text
tooltip Maybe Text
stockId Maybe a
manager = IO RecentAction -> m RecentAction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RecentAction -> m RecentAction)
-> IO RecentAction -> m RecentAction
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            CString
jLabel' <- Text -> IO CString
textToCString Text
jLabel
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jLabel'
    CString
maybeTooltip <- case Maybe Text
tooltip of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jTooltip -> do
            CString
jTooltip' <- Text -> IO CString
textToCString Text
jTooltip
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTooltip'
    CString
maybeStockId <- case Maybe Text
stockId of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jStockId -> do
            CString
jStockId' <- Text -> IO CString
textToCString Text
jStockId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jStockId'
    Ptr RecentManager
maybeManager <- case Maybe a
manager of
        Maybe a
Nothing -> Ptr RecentManager -> IO (Ptr RecentManager)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RecentManager
forall a. Ptr a
nullPtr
        Just a
jManager -> do
            Ptr RecentManager
jManager' <- a -> IO (Ptr RecentManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jManager
            Ptr RecentManager -> IO (Ptr RecentManager)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RecentManager
jManager'
    Ptr RecentAction
result <- CString
-> CString
-> CString
-> CString
-> Ptr RecentManager
-> IO (Ptr RecentAction)
gtk_recent_action_new_for_manager CString
name' CString
maybeLabel CString
maybeTooltip CString
maybeStockId Ptr RecentManager
maybeManager
    Text -> Ptr RecentAction -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"recentActionNewForManager" Ptr RecentAction
result
    RecentAction
result' <- ((ManagedPtr RecentAction -> RecentAction)
-> Ptr RecentAction -> IO RecentAction
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr RecentAction -> RecentAction
RecentAction) Ptr RecentAction
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
manager a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeLabel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTooltip
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeStockId
    RecentAction -> IO RecentAction
forall (m :: * -> *) a. Monad m => a -> m a
return RecentAction
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method RecentAction::get_show_numbers
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "RecentAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRecentAction" , 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_recent_action_get_show_numbers" gtk_recent_action_get_show_numbers :: 
    Ptr RecentAction ->                     -- action : TInterface (Name {namespace = "Gtk", name = "RecentAction"})
    IO CInt

{-# DEPRECATED recentActionGetShowNumbers ["(Since version 3.10)"] #-}
-- | Returns the value set by 'GI.Gtk.Objects.RecentChooserMenu.recentChooserMenuSetShowNumbers'.
-- 
-- /Since: 2.12/
recentActionGetShowNumbers ::
    (B.CallStack.HasCallStack, MonadIO m, IsRecentAction a) =>
    a
    -- ^ /@action@/: a t'GI.Gtk.Objects.RecentAction.RecentAction'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if numbers should be shown.
recentActionGetShowNumbers :: a -> m Bool
recentActionGetShowNumbers a
action = 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 RecentAction
action' <- a -> IO (Ptr RecentAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    CInt
result <- Ptr RecentAction -> IO CInt
gtk_recent_action_get_show_numbers Ptr RecentAction
action'
    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
action
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RecentActionGetShowNumbersMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRecentAction a) => O.MethodInfo RecentActionGetShowNumbersMethodInfo a signature where
    overloadedMethod = recentActionGetShowNumbers

#endif

-- method RecentAction::set_show_numbers
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "RecentAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRecentAction" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "show_numbers"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if the shown items should be numbered"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_recent_action_set_show_numbers" gtk_recent_action_set_show_numbers :: 
    Ptr RecentAction ->                     -- action : TInterface (Name {namespace = "Gtk", name = "RecentAction"})
    CInt ->                                 -- show_numbers : TBasicType TBoolean
    IO ()

{-# DEPRECATED recentActionSetShowNumbers ["(Since version 3.10)"] #-}
-- | Sets whether a number should be added to the items shown by the
-- widgets representing /@action@/. The numbers are shown to provide
-- a unique character for a mnemonic to be used inside the menu item\'s
-- label. Only the first ten items get a number to avoid clashes.
-- 
-- /Since: 2.12/
recentActionSetShowNumbers ::
    (B.CallStack.HasCallStack, MonadIO m, IsRecentAction a) =>
    a
    -- ^ /@action@/: a t'GI.Gtk.Objects.RecentAction.RecentAction'
    -> Bool
    -- ^ /@showNumbers@/: 'P.True' if the shown items should be numbered
    -> m ()
recentActionSetShowNumbers :: a -> Bool -> m ()
recentActionSetShowNumbers a
action Bool
showNumbers = 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 RecentAction
action' <- a -> IO (Ptr RecentAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    let showNumbers' :: CInt
showNumbers' = (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
showNumbers
    Ptr RecentAction -> CInt -> IO ()
gtk_recent_action_set_show_numbers Ptr RecentAction
action' CInt
showNumbers'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RecentActionSetShowNumbersMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsRecentAction a) => O.MethodInfo RecentActionSetShowNumbersMethodInfo a signature where
    overloadedMethod = recentActionSetShowNumbers

#endif