{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Exposes to the Gtk+ program important functions of
-- OS X\'s NSApplication class for use by Gtk+ applications running with
-- the quartz Gdk backend and provides addtional functions for
-- integrating a Gtk+ program into the OS X user environment.
-- 
-- Using GtkosxApplication is pretty simple.
-- First, create an instance at startup:
-- 
-- 
-- === /C code/
-- >
-- >GtkosxApplication *theApp = g_object_new(GTKOSX_TYPE_APPLICATION, NULL);
-- 
-- 
-- Do this early in your program, shortly after you run
-- >
-- >gtk_init()
-- 
-- Don\'t forget to guard it, and all other calls into the library, with
-- >
-- >#ifdef MAC_INTEGRATION
-- 
-- 
-- You don\'t want your Linux users\' builds failing because of this.
-- The application object is a singleton, so you can call g_object_new
-- as often as you like. You\'ll always get the same pointer
-- back. There\'s no need to pass it around as an argument. Do note
-- that all of the GtkosxApplication functions take theApp as an
-- argument, even if they don\'t use it. This seems silly in C, and
-- perhaps it is, but it\'s needed to make the Python binding logic
-- recognize that they\'re class methods.
-- 
-- Just having the application object created will get you some
-- benefits, like having the Quit menu item in the dock menu work. But
-- you\'ll obviously want more. So the next place to visit is your main
-- window code. If you have a simple application, you might be
-- constructing the menu by hand, but you\'re more likely to be using
-- GtkBuilder. In either case, you need to get a pointer to the
-- menubar. If you\'re building by hand, you\'ve already got it lying
-- around because you needed it to add the menus to. With GtkBuilder,
-- you need to ask the GtkUIManager for a pointer. Once everything is
-- more-or-less set up on the Gtk+ side, you need only hide the menu
-- and call @/gtkosx_application_set_main_menu()/@. Here\'s an example with
-- GtkBuilder:
-- 
-- == Setting the MenuBar
-- 
-- === /C code/
-- >
-- >  GtkUIManager *mgr = gtk_ui_manager_new();
-- >  GtkosxApplication *theApp = g_object_new(GTKOSX_TYPE_APPLICATION, NULL);
-- >  ...
-- >  mergeid = gtk_ui_manager_add_ui_from_file(mgr, "src/testui.xml", &err);
-- >  ...
-- >  menubar = gtk_ui_manager_get_widget(mgr, "/menubar");
-- >  gtk_widget_hide (menubar);
-- >  gtkosx_application_set_menu_bar(theApp, GTK_MENU_SHELL(menubar));
-- 
-- 
-- There are a couple of wrinkles, though, if you use
-- accelerators. First off, there are two event paths for
-- accelerators: Quartz, where the keystroke is processed by OS X and
-- the menu item action event is placed on the event queue by OS X, or
-- Gtk, where the accelerator key event is passed through to Gtk to
-- recognize. This is controlled by
-- 'GI.GtkosxApplication.Objects.Application.applicationSetUseQuartzAccelerators' (you can test the
-- value with 'GI.GtkosxApplication.Objects.Application.applicationUseQuartzAccelerators'), and the
-- default is to use Quartz handling. This has two advantages:
-- 
-- * It works without any extra steps
-- * It changes stock accelerators (like Ctrl-O for open file) to
-- 
-- the stock OS X keyEquivalent (Cmd-O in that case).
-- 
-- If you need to use Gtk+ keyboard accelerator handling *and*
-- you\'re using GtkMenuItems instead of GtkActions, you\'ll need to
-- connect a special handler as shown in the following example:
-- == Enabling Accelerators on Hidden Menus
-- 
-- === /C code/
-- >
-- >static gboolean
-- >can_activate_cb(GtkWidget* widget, guint signal_id, gpointer data)
-- >{
-- >  return gtk_widget_is_sensitive(widget);
-- >}
-- >...
-- >  g_signal_connect(menubar, "can-activate-accel",
-- >                   G_CALLBACK(can_activate_cb), NULL);
-- 
-- 
-- The next task to make your application appear more normal for Mac
-- users is to move some menu items from their normal Gtk locations to
-- the so-called \"App\" menu. That\'s the menu all the way at the left
-- of the menubar that has the currently-running application\'s
-- name. There are 3 menu items that normally go there:
-- 
-- * Help|About
-- * Edit|Preferences
-- * File|Quit
-- 
-- 
-- File|Quit is a special case, because OS X handles it itself and
-- automatically includes it, so the only thing you need do is hide it
-- on the File menu so that it doesn\'t show up twice:
-- >
-- >gtk_widget_hide(GTK_WIDGET(file_quit_menu_item));
-- 
-- The other two must be moved in code, and there are two functions
-- for doing that. The first one creates \"goups\", which is just an
-- easy way to manage separators, and the second adds the actual menu
-- items to the groups. Here\'s an example:
-- >
-- > GtkosxApplicationMenuGroup *group;
-- > GtkMenuItem *about_item, *preferences_item;
-- > about_item = gtk_ui_manager_get_widget(mgr, "/menubar/Help/About");
-- > preferences_item = gtk_ui_manager_get_widget(mgr, "/menubar/Edit/Preferences");
-- >
-- > group = gtkosx_application_add_app_menu_group (theApp);
-- > gtkosx_application_add_app_menu_item  (theApp, group,
-- >                                        GTK_MENU_ITEM (about_item));
-- >
-- > group = gtkosx_application_add_app_menu_group (theApp);
-- > gtkosx_application_add_app_menu_item  (theApp, group,
-- >                                        GTK_MENU_ITEM (preferences_item));
-- 
-- Once we have everything set up for as many windows as we\'re going
-- to open before we call @/gtk_main_loop()/@, we need to tell OS X that
-- we\'re ready:
-- >
-- >gtkosx_application_ready(theApp);
-- 
-- 
-- If you add other windows later, you must do everything above for
-- each one\'s menubar. Most of the time the internal notifictations
-- will ensure that the GtkosxApplication is able to keep everything
-- in sync. However, if you at any time disconnect or block signals
-- and change the menu (perhaps because of a context change within a
-- window, as with changing pages in a GtkNotebook) you need to call
-- >
-- >gtkosx_application_sync_menubar(theApp)
-- 
-- 
-- N.B.: One GtkMenu function, 'GI.Gtk.Objects.Menu.menuReorderChild', changes the
-- menu appearance without emitting a signal, so if you use that
-- function in your code you\'ll need to call
-- 'GI.GtkosxApplication.Objects.Application.applicationSyncMenubar' afterwards.
-- 
-- == Dock Support
-- The dock is that bar of icons that normally lives at the bottom of
-- the display on a Mac (though it can be moved to one of the other
-- sides; this author likes his on the left, which is where it was
-- originally on a NeXT). Each running application has a \"dock tile\",
-- an icon on the dock. Users can, if they like, add application (or
-- document) icons to the dock, and those can be used to launch the
-- application. Apple allows limited customization of the dock tile,
-- and GtkosxApplication has an interface for adding to the dock\'s
-- menu and for changing the icon that is displayed for the the
-- application. GtkosxApplication also provides an interface to
-- AttentionRequest, which bounces the dock tile if the application
-- doesn\'t have focus. You might want to do that at the end of a long
-- task so that the user will know that it\'s finished if she\'s
-- switched to another application while she waits for yours.
-- They\'re all pretty simple, so you can just read the details below.
-- 
-- * @/gtkosx_application_set_doc_menu()/@
-- * @/gtkosx_application_set_doc_icon_pixbuf()/@
-- * 'GI.GtkosxApplication.Objects.Application.applicationSetDockIconResource'
-- * 'GI.GtkosxApplication.Objects.Application.applicationAttentionRequest'
-- * 'GI.GtkosxApplication.Objects.Application.applicationCancelAttentionRequest'
-- 
-- 
-- == Bundle Support
-- The last feature to which GtkosxApplication provides an interface
-- is the bundle. Normally in OS X, graphical applications are packaged
-- along with their non-standard dependencies and their resources
-- (graphical elements, translations, and such) in special directory
-- structures called \"bundles\". To easily package your Gtk+
-- application, have a look at gtk-mac-bundler, also available from
-- the Gtk-OSX project.
-- 
-- OS X provides a variety of functions pertaining to bundles, most of
-- which are not likely to interest someone porting a Gtk+
-- application. GtkosxApplication has wrapped a few that might be:
-- 
-- * 'GI.GtkosxApplication.Objects.Application.applicationGetBundlePath'
-- * 'GI.GtkosxApplication.Objects.Application.applicationGetResourcePath'
-- * 'GI.GtkosxApplication.Objects.Application.applicationGetExecutablePath'
-- * 'GI.GtkosxApplication.Objects.Application.applicationGetBundleId'
-- * 'GI.GtkosxApplication.Objects.Application.applicationGetBundleInfo'
-- 
-- 
-- The first three just get a UTF8-encoded path. An interesting note
-- is that they\'ll return the path to the executable or the folder
-- it\'s in regardless of whether it\'s actually in a bundle. To find
-- out if one is actually dealing with a bundle,
-- 'GI.GtkosxApplication.Objects.Application.applicationGetBundleId' will return \"\" if it can\'t find
-- the key @/CFBundleIdentifier/@ from the bundle\'s Info.plist -- which it
-- won\'t if the application isn\'t in a bundle or wasn\'t launched by
-- opening the bundle. (In other words, even if you have your
-- application installed in Foo.app, if you launch it from the command
-- line as
-- >
-- >$ Foo.app/Contents/MacOS/Foo
-- 
-- the Info.plist won\'t have been opened and
-- 'GI.GtkosxApplication.Objects.Application.applicationGetBundleId' will return \"\". Of course, it
-- will also return \"\" if you didn\'t set @/CFBundleIdentifier/@ in the
-- Info.plist, so make sure that you do!
-- 
-- The last function, 'GI.GtkosxApplication.Objects.Application.applicationGetBundleInfo', will
-- return the value associated with an arbitrary key from Info.plist
-- as long as that value is a string. If it isn\'t, then the function
-- returns a null string (\"\").
-- 
-- == Notifications
-- Finally, notice the signals. These are emitted in response to the
-- indicated OS X notifications. Except for
-- [NSApplicationBlockTermination]("GI.GtkosxApplication.Objects.Application#signal:NSApplicationBlockTermination"), most programs
-- won\'t need to do anything with
-- them. [NSApplicationBlockTermination]("GI.GtkosxApplication.Objects.Application#signal:NSApplicationBlockTermination") is telling
-- you that OS X is planning to shut down your program. If you have any
-- cleanup to do (like saving open files), or if you want to ask the
-- user if it\'s OK, you should connect to the signal and do your
-- cleanup. Your handler can return 'P.True' to prevent the application
-- from quitting.

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

module GI.GtkosxApplication.Objects.Application
    (

-- * Exported types
    Application(..)                         ,
    IsApplication                           ,
    toApplication                           ,
    noApplication                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveApplicationMethod                ,
#endif


-- ** attentionRequest #method:attentionRequest#

#if defined(ENABLE_OVERLOADING)
    ApplicationAttentionRequestMethodInfo   ,
#endif
    applicationAttentionRequest             ,


-- ** cancelAttentionRequest #method:cancelAttentionRequest#

#if defined(ENABLE_OVERLOADING)
    ApplicationCancelAttentionRequestMethodInfo,
#endif
    applicationCancelAttentionRequest       ,


-- ** get #method:get#

    applicationGet                          ,


-- ** getBundleId #method:getBundleId#

    applicationGetBundleId                  ,


-- ** getBundleInfo #method:getBundleInfo#

    applicationGetBundleInfo                ,


-- ** getBundlePath #method:getBundlePath#

    applicationGetBundlePath                ,


-- ** getExecutablePath #method:getExecutablePath#

    applicationGetExecutablePath            ,


-- ** getResourcePath #method:getResourcePath#

    applicationGetResourcePath              ,


-- ** insertAppMenuItem #method:insertAppMenuItem#

#if defined(ENABLE_OVERLOADING)
    ApplicationInsertAppMenuItemMethodInfo  ,
#endif
    applicationInsertAppMenuItem            ,


-- ** ready #method:ready#

#if defined(ENABLE_OVERLOADING)
    ApplicationReadyMethodInfo              ,
#endif
    applicationReady                        ,


-- ** setAboutItem #method:setAboutItem#

#if defined(ENABLE_OVERLOADING)
    ApplicationSetAboutItemMethodInfo       ,
#endif
    applicationSetAboutItem                 ,


-- ** setDockIconPixbuf #method:setDockIconPixbuf#

#if defined(ENABLE_OVERLOADING)
    ApplicationSetDockIconPixbufMethodInfo  ,
#endif
    applicationSetDockIconPixbuf            ,


-- ** setDockIconResource #method:setDockIconResource#

#if defined(ENABLE_OVERLOADING)
    ApplicationSetDockIconResourceMethodInfo,
#endif
    applicationSetDockIconResource          ,


-- ** setDockMenu #method:setDockMenu#

#if defined(ENABLE_OVERLOADING)
    ApplicationSetDockMenuMethodInfo        ,
#endif
    applicationSetDockMenu                  ,


-- ** setHelpMenu #method:setHelpMenu#

#if defined(ENABLE_OVERLOADING)
    ApplicationSetHelpMenuMethodInfo        ,
#endif
    applicationSetHelpMenu                  ,


-- ** setMenuBar #method:setMenuBar#

#if defined(ENABLE_OVERLOADING)
    ApplicationSetMenuBarMethodInfo         ,
#endif
    applicationSetMenuBar                   ,


-- ** setUseQuartzAccelerators #method:setUseQuartzAccelerators#

#if defined(ENABLE_OVERLOADING)
    ApplicationSetUseQuartzAcceleratorsMethodInfo,
#endif
    applicationSetUseQuartzAccelerators     ,


-- ** setWindowMenu #method:setWindowMenu#

#if defined(ENABLE_OVERLOADING)
    ApplicationSetWindowMenuMethodInfo      ,
#endif
    applicationSetWindowMenu                ,


-- ** syncMenubar #method:syncMenubar#

#if defined(ENABLE_OVERLOADING)
    ApplicationSyncMenubarMethodInfo        ,
#endif
    applicationSyncMenubar                  ,


-- ** useQuartzAccelerators #method:useQuartzAccelerators#

#if defined(ENABLE_OVERLOADING)
    ApplicationUseQuartzAcceleratorsMethodInfo,
#endif
    applicationUseQuartzAccelerators        ,




 -- * Signals
-- ** nSApplicationBlockTermination #signal:nSApplicationBlockTermination#

    ApplicationNSApplicationBlockTerminationCallback,
#if defined(ENABLE_OVERLOADING)
    ApplicationNSApplicationBlockTerminationSignalInfo,
#endif
    C_ApplicationNSApplicationBlockTerminationCallback,
    afterApplicationNSApplicationBlockTermination,
    genClosure_ApplicationNSApplicationBlockTermination,
    mk_ApplicationNSApplicationBlockTerminationCallback,
    noApplicationNSApplicationBlockTerminationCallback,
    onApplicationNSApplicationBlockTermination,
    wrap_ApplicationNSApplicationBlockTerminationCallback,


-- ** nSApplicationDidBecomeActive #signal:nSApplicationDidBecomeActive#

    ApplicationNSApplicationDidBecomeActiveCallback,
#if defined(ENABLE_OVERLOADING)
    ApplicationNSApplicationDidBecomeActiveSignalInfo,
#endif
    C_ApplicationNSApplicationDidBecomeActiveCallback,
    afterApplicationNSApplicationDidBecomeActive,
    genClosure_ApplicationNSApplicationDidBecomeActive,
    mk_ApplicationNSApplicationDidBecomeActiveCallback,
    noApplicationNSApplicationDidBecomeActiveCallback,
    onApplicationNSApplicationDidBecomeActive,
    wrap_ApplicationNSApplicationDidBecomeActiveCallback,


-- ** nSApplicationOpenFile #signal:nSApplicationOpenFile#

    ApplicationNSApplicationOpenFileCallback,
#if defined(ENABLE_OVERLOADING)
    ApplicationNSApplicationOpenFileSignalInfo,
#endif
    C_ApplicationNSApplicationOpenFileCallback,
    afterApplicationNSApplicationOpenFile   ,
    genClosure_ApplicationNSApplicationOpenFile,
    mk_ApplicationNSApplicationOpenFileCallback,
    noApplicationNSApplicationOpenFileCallback,
    onApplicationNSApplicationOpenFile      ,
    wrap_ApplicationNSApplicationOpenFileCallback,


-- ** nSApplicationWillResignActive #signal:nSApplicationWillResignActive#

    ApplicationNSApplicationWillResignActiveCallback,
#if defined(ENABLE_OVERLOADING)
    ApplicationNSApplicationWillResignActiveSignalInfo,
#endif
    C_ApplicationNSApplicationWillResignActiveCallback,
    afterApplicationNSApplicationWillResignActive,
    genClosure_ApplicationNSApplicationWillResignActive,
    mk_ApplicationNSApplicationWillResignActiveCallback,
    noApplicationNSApplicationWillResignActiveCallback,
    onApplicationNSApplicationWillResignActive,
    wrap_ApplicationNSApplicationWillResignActiveCallback,


-- ** nSApplicationWillTerminate #signal:nSApplicationWillTerminate#

    ApplicationNSApplicationWillTerminateCallback,
#if defined(ENABLE_OVERLOADING)
    ApplicationNSApplicationWillTerminateSignalInfo,
#endif
    C_ApplicationNSApplicationWillTerminateCallback,
    afterApplicationNSApplicationWillTerminate,
    genClosure_ApplicationNSApplicationWillTerminate,
    mk_ApplicationNSApplicationWillTerminateCallback,
    noApplicationNSApplicationWillTerminateCallback,
    onApplicationNSApplicationWillTerminate ,
    wrap_ApplicationNSApplicationWillTerminateCallback,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gtk.Objects.MenuItem as Gtk.MenuItem
import qualified GI.Gtk.Objects.MenuShell as Gtk.MenuShell
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.GtkosxApplication.Enums as GtkosxApplication.Enums

-- | Memory-managed wrapper type.
newtype Application = Application (ManagedPtr Application)
    deriving (Eq)
foreign import ccall "gtkosx_application_get_type"
    c_gtkosx_application_get_type :: IO GType

instance GObject Application where
    gobjectType = c_gtkosx_application_get_type


-- | Convert 'Application' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Application where
    toGValue o = do
        gtype <- c_gtkosx_application_get_type
        B.ManagedPtr.withManagedPtr o (B.GValue.buildGValue gtype B.GValue.set_object)

    fromGValue gv = do
        ptr <- B.GValue.get_object gv :: IO (Ptr Application)
        B.ManagedPtr.newObject Application ptr



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

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

-- | Cast to `Application`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toApplication :: (MonadIO m, IsApplication o) => o -> m Application
toApplication = liftIO . unsafeCastTo Application

-- | A convenience alias for `Nothing` :: `Maybe` `Application`.
noApplication :: Maybe Application
noApplication = Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveApplicationMethod (t :: Symbol) (o :: *) :: * where
    ResolveApplicationMethod "attentionRequest" o = ApplicationAttentionRequestMethodInfo
    ResolveApplicationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveApplicationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveApplicationMethod "cancelAttentionRequest" o = ApplicationCancelAttentionRequestMethodInfo
    ResolveApplicationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveApplicationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveApplicationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveApplicationMethod "insertAppMenuItem" o = ApplicationInsertAppMenuItemMethodInfo
    ResolveApplicationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveApplicationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveApplicationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveApplicationMethod "ready" o = ApplicationReadyMethodInfo
    ResolveApplicationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveApplicationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveApplicationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveApplicationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveApplicationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveApplicationMethod "syncMenubar" o = ApplicationSyncMenubarMethodInfo
    ResolveApplicationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveApplicationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveApplicationMethod "useQuartzAccelerators" o = ApplicationUseQuartzAcceleratorsMethodInfo
    ResolveApplicationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveApplicationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveApplicationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveApplicationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveApplicationMethod "setAboutItem" o = ApplicationSetAboutItemMethodInfo
    ResolveApplicationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveApplicationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveApplicationMethod "setDockIconPixbuf" o = ApplicationSetDockIconPixbufMethodInfo
    ResolveApplicationMethod "setDockIconResource" o = ApplicationSetDockIconResourceMethodInfo
    ResolveApplicationMethod "setDockMenu" o = ApplicationSetDockMenuMethodInfo
    ResolveApplicationMethod "setHelpMenu" o = ApplicationSetHelpMenuMethodInfo
    ResolveApplicationMethod "setMenuBar" o = ApplicationSetMenuBarMethodInfo
    ResolveApplicationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveApplicationMethod "setUseQuartzAccelerators" o = ApplicationSetUseQuartzAcceleratorsMethodInfo
    ResolveApplicationMethod "setWindowMenu" o = ApplicationSetWindowMenuMethodInfo
    ResolveApplicationMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Application::NSApplicationBlockTermination
-- | /No description available in the introspection data./
type ApplicationNSApplicationBlockTerminationCallback =
    IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `ApplicationNSApplicationBlockTerminationCallback`@.
noApplicationNSApplicationBlockTerminationCallback :: Maybe ApplicationNSApplicationBlockTerminationCallback
noApplicationNSApplicationBlockTerminationCallback = Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_ApplicationNSApplicationBlockTermination :: MonadIO m => ApplicationNSApplicationBlockTerminationCallback -> m (GClosure C_ApplicationNSApplicationBlockTerminationCallback)
genClosure_ApplicationNSApplicationBlockTermination cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationBlockTerminationCallback cb
    mk_ApplicationNSApplicationBlockTerminationCallback cb' >>= B.GClosure.newGClosure


-- | Wrap a `ApplicationNSApplicationBlockTerminationCallback` into a `C_ApplicationNSApplicationBlockTerminationCallback`.
wrap_ApplicationNSApplicationBlockTerminationCallback ::
    ApplicationNSApplicationBlockTerminationCallback ->
    C_ApplicationNSApplicationBlockTerminationCallback
wrap_ApplicationNSApplicationBlockTerminationCallback _cb _ _ = do
    result <- _cb
    let result' = (fromIntegral . fromEnum) result
    return result'


-- | Connect a signal handler for the [NSApplicationBlockTermination](#signal:NSApplicationBlockTermination) 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' application #NSApplicationBlockTermination callback
-- @
-- 
-- 
onApplicationNSApplicationBlockTermination :: (IsApplication a, MonadIO m) => a -> ApplicationNSApplicationBlockTerminationCallback -> m SignalHandlerId
onApplicationNSApplicationBlockTermination obj cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationBlockTerminationCallback cb
    cb'' <- mk_ApplicationNSApplicationBlockTerminationCallback cb'
    connectSignalFunPtr obj "NSApplicationBlockTermination" cb'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [NSApplicationBlockTermination](#signal:NSApplicationBlockTermination) 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' application #NSApplicationBlockTermination callback
-- @
-- 
-- 
afterApplicationNSApplicationBlockTermination :: (IsApplication a, MonadIO m) => a -> ApplicationNSApplicationBlockTerminationCallback -> m SignalHandlerId
afterApplicationNSApplicationBlockTermination obj cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationBlockTerminationCallback cb
    cb'' <- mk_ApplicationNSApplicationBlockTerminationCallback cb'
    connectSignalFunPtr obj "NSApplicationBlockTermination" cb'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data ApplicationNSApplicationBlockTerminationSignalInfo
instance SignalInfo ApplicationNSApplicationBlockTerminationSignalInfo where
    type HaskellCallbackType ApplicationNSApplicationBlockTerminationSignalInfo = ApplicationNSApplicationBlockTerminationCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ApplicationNSApplicationBlockTerminationCallback cb
        cb'' <- mk_ApplicationNSApplicationBlockTerminationCallback cb'
        connectSignalFunPtr obj "NSApplicationBlockTermination" cb'' connectMode detail

#endif

-- signal Application::NSApplicationDidBecomeActive
-- | /No description available in the introspection data./
type ApplicationNSApplicationDidBecomeActiveCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ApplicationNSApplicationDidBecomeActiveCallback`@.
noApplicationNSApplicationDidBecomeActiveCallback :: Maybe ApplicationNSApplicationDidBecomeActiveCallback
noApplicationNSApplicationDidBecomeActiveCallback = Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_ApplicationNSApplicationDidBecomeActive :: MonadIO m => ApplicationNSApplicationDidBecomeActiveCallback -> m (GClosure C_ApplicationNSApplicationDidBecomeActiveCallback)
genClosure_ApplicationNSApplicationDidBecomeActive cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationDidBecomeActiveCallback cb
    mk_ApplicationNSApplicationDidBecomeActiveCallback cb' >>= B.GClosure.newGClosure


-- | Wrap a `ApplicationNSApplicationDidBecomeActiveCallback` into a `C_ApplicationNSApplicationDidBecomeActiveCallback`.
wrap_ApplicationNSApplicationDidBecomeActiveCallback ::
    ApplicationNSApplicationDidBecomeActiveCallback ->
    C_ApplicationNSApplicationDidBecomeActiveCallback
wrap_ApplicationNSApplicationDidBecomeActiveCallback _cb _ _ = do
    _cb


-- | Connect a signal handler for the [NSApplicationDidBecomeActive](#signal:NSApplicationDidBecomeActive) 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' application #NSApplicationDidBecomeActive callback
-- @
-- 
-- 
onApplicationNSApplicationDidBecomeActive :: (IsApplication a, MonadIO m) => a -> ApplicationNSApplicationDidBecomeActiveCallback -> m SignalHandlerId
onApplicationNSApplicationDidBecomeActive obj cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationDidBecomeActiveCallback cb
    cb'' <- mk_ApplicationNSApplicationDidBecomeActiveCallback cb'
    connectSignalFunPtr obj "NSApplicationDidBecomeActive" cb'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [NSApplicationDidBecomeActive](#signal:NSApplicationDidBecomeActive) 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' application #NSApplicationDidBecomeActive callback
-- @
-- 
-- 
afterApplicationNSApplicationDidBecomeActive :: (IsApplication a, MonadIO m) => a -> ApplicationNSApplicationDidBecomeActiveCallback -> m SignalHandlerId
afterApplicationNSApplicationDidBecomeActive obj cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationDidBecomeActiveCallback cb
    cb'' <- mk_ApplicationNSApplicationDidBecomeActiveCallback cb'
    connectSignalFunPtr obj "NSApplicationDidBecomeActive" cb'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data ApplicationNSApplicationDidBecomeActiveSignalInfo
instance SignalInfo ApplicationNSApplicationDidBecomeActiveSignalInfo where
    type HaskellCallbackType ApplicationNSApplicationDidBecomeActiveSignalInfo = ApplicationNSApplicationDidBecomeActiveCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ApplicationNSApplicationDidBecomeActiveCallback cb
        cb'' <- mk_ApplicationNSApplicationDidBecomeActiveCallback cb'
        connectSignalFunPtr obj "NSApplicationDidBecomeActive" cb'' connectMode detail

#endif

-- signal Application::NSApplicationOpenFile
-- | /No description available in the introspection data./
type ApplicationNSApplicationOpenFileCallback =
    T.Text
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `ApplicationNSApplicationOpenFileCallback`@.
noApplicationNSApplicationOpenFileCallback :: Maybe ApplicationNSApplicationOpenFileCallback
noApplicationNSApplicationOpenFileCallback = Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_ApplicationNSApplicationOpenFile :: MonadIO m => ApplicationNSApplicationOpenFileCallback -> m (GClosure C_ApplicationNSApplicationOpenFileCallback)
genClosure_ApplicationNSApplicationOpenFile cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationOpenFileCallback cb
    mk_ApplicationNSApplicationOpenFileCallback cb' >>= B.GClosure.newGClosure


-- | Wrap a `ApplicationNSApplicationOpenFileCallback` into a `C_ApplicationNSApplicationOpenFileCallback`.
wrap_ApplicationNSApplicationOpenFileCallback ::
    ApplicationNSApplicationOpenFileCallback ->
    C_ApplicationNSApplicationOpenFileCallback
wrap_ApplicationNSApplicationOpenFileCallback _cb _ object _ = do
    object' <- cstringToText object
    result <- _cb  object'
    let result' = (fromIntegral . fromEnum) result
    return result'


-- | Connect a signal handler for the [NSApplicationOpenFile](#signal:NSApplicationOpenFile) 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' application #NSApplicationOpenFile callback
-- @
-- 
-- 
onApplicationNSApplicationOpenFile :: (IsApplication a, MonadIO m) => a -> ApplicationNSApplicationOpenFileCallback -> m SignalHandlerId
onApplicationNSApplicationOpenFile obj cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationOpenFileCallback cb
    cb'' <- mk_ApplicationNSApplicationOpenFileCallback cb'
    connectSignalFunPtr obj "NSApplicationOpenFile" cb'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [NSApplicationOpenFile](#signal:NSApplicationOpenFile) 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' application #NSApplicationOpenFile callback
-- @
-- 
-- 
afterApplicationNSApplicationOpenFile :: (IsApplication a, MonadIO m) => a -> ApplicationNSApplicationOpenFileCallback -> m SignalHandlerId
afterApplicationNSApplicationOpenFile obj cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationOpenFileCallback cb
    cb'' <- mk_ApplicationNSApplicationOpenFileCallback cb'
    connectSignalFunPtr obj "NSApplicationOpenFile" cb'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data ApplicationNSApplicationOpenFileSignalInfo
instance SignalInfo ApplicationNSApplicationOpenFileSignalInfo where
    type HaskellCallbackType ApplicationNSApplicationOpenFileSignalInfo = ApplicationNSApplicationOpenFileCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ApplicationNSApplicationOpenFileCallback cb
        cb'' <- mk_ApplicationNSApplicationOpenFileCallback cb'
        connectSignalFunPtr obj "NSApplicationOpenFile" cb'' connectMode detail

#endif

-- signal Application::NSApplicationWillResignActive
-- | /No description available in the introspection data./
type ApplicationNSApplicationWillResignActiveCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ApplicationNSApplicationWillResignActiveCallback`@.
noApplicationNSApplicationWillResignActiveCallback :: Maybe ApplicationNSApplicationWillResignActiveCallback
noApplicationNSApplicationWillResignActiveCallback = Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_ApplicationNSApplicationWillResignActive :: MonadIO m => ApplicationNSApplicationWillResignActiveCallback -> m (GClosure C_ApplicationNSApplicationWillResignActiveCallback)
genClosure_ApplicationNSApplicationWillResignActive cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationWillResignActiveCallback cb
    mk_ApplicationNSApplicationWillResignActiveCallback cb' >>= B.GClosure.newGClosure


-- | Wrap a `ApplicationNSApplicationWillResignActiveCallback` into a `C_ApplicationNSApplicationWillResignActiveCallback`.
wrap_ApplicationNSApplicationWillResignActiveCallback ::
    ApplicationNSApplicationWillResignActiveCallback ->
    C_ApplicationNSApplicationWillResignActiveCallback
wrap_ApplicationNSApplicationWillResignActiveCallback _cb _ _ = do
    _cb


-- | Connect a signal handler for the [NSApplicationWillResignActive](#signal:NSApplicationWillResignActive) 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' application #NSApplicationWillResignActive callback
-- @
-- 
-- 
onApplicationNSApplicationWillResignActive :: (IsApplication a, MonadIO m) => a -> ApplicationNSApplicationWillResignActiveCallback -> m SignalHandlerId
onApplicationNSApplicationWillResignActive obj cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationWillResignActiveCallback cb
    cb'' <- mk_ApplicationNSApplicationWillResignActiveCallback cb'
    connectSignalFunPtr obj "NSApplicationWillResignActive" cb'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [NSApplicationWillResignActive](#signal:NSApplicationWillResignActive) 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' application #NSApplicationWillResignActive callback
-- @
-- 
-- 
afterApplicationNSApplicationWillResignActive :: (IsApplication a, MonadIO m) => a -> ApplicationNSApplicationWillResignActiveCallback -> m SignalHandlerId
afterApplicationNSApplicationWillResignActive obj cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationWillResignActiveCallback cb
    cb'' <- mk_ApplicationNSApplicationWillResignActiveCallback cb'
    connectSignalFunPtr obj "NSApplicationWillResignActive" cb'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data ApplicationNSApplicationWillResignActiveSignalInfo
instance SignalInfo ApplicationNSApplicationWillResignActiveSignalInfo where
    type HaskellCallbackType ApplicationNSApplicationWillResignActiveSignalInfo = ApplicationNSApplicationWillResignActiveCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ApplicationNSApplicationWillResignActiveCallback cb
        cb'' <- mk_ApplicationNSApplicationWillResignActiveCallback cb'
        connectSignalFunPtr obj "NSApplicationWillResignActive" cb'' connectMode detail

#endif

-- signal Application::NSApplicationWillTerminate
-- | /No description available in the introspection data./
type ApplicationNSApplicationWillTerminateCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ApplicationNSApplicationWillTerminateCallback`@.
noApplicationNSApplicationWillTerminateCallback :: Maybe ApplicationNSApplicationWillTerminateCallback
noApplicationNSApplicationWillTerminateCallback = Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_ApplicationNSApplicationWillTerminate :: MonadIO m => ApplicationNSApplicationWillTerminateCallback -> m (GClosure C_ApplicationNSApplicationWillTerminateCallback)
genClosure_ApplicationNSApplicationWillTerminate cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationWillTerminateCallback cb
    mk_ApplicationNSApplicationWillTerminateCallback cb' >>= B.GClosure.newGClosure


-- | Wrap a `ApplicationNSApplicationWillTerminateCallback` into a `C_ApplicationNSApplicationWillTerminateCallback`.
wrap_ApplicationNSApplicationWillTerminateCallback ::
    ApplicationNSApplicationWillTerminateCallback ->
    C_ApplicationNSApplicationWillTerminateCallback
wrap_ApplicationNSApplicationWillTerminateCallback _cb _ _ = do
    _cb


-- | Connect a signal handler for the [NSApplicationWillTerminate](#signal:NSApplicationWillTerminate) 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' application #NSApplicationWillTerminate callback
-- @
-- 
-- 
onApplicationNSApplicationWillTerminate :: (IsApplication a, MonadIO m) => a -> ApplicationNSApplicationWillTerminateCallback -> m SignalHandlerId
onApplicationNSApplicationWillTerminate obj cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationWillTerminateCallback cb
    cb'' <- mk_ApplicationNSApplicationWillTerminateCallback cb'
    connectSignalFunPtr obj "NSApplicationWillTerminate" cb'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [NSApplicationWillTerminate](#signal:NSApplicationWillTerminate) 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' application #NSApplicationWillTerminate callback
-- @
-- 
-- 
afterApplicationNSApplicationWillTerminate :: (IsApplication a, MonadIO m) => a -> ApplicationNSApplicationWillTerminateCallback -> m SignalHandlerId
afterApplicationNSApplicationWillTerminate obj cb = liftIO $ do
    let cb' = wrap_ApplicationNSApplicationWillTerminateCallback cb
    cb'' <- mk_ApplicationNSApplicationWillTerminateCallback cb'
    connectSignalFunPtr obj "NSApplicationWillTerminate" cb'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data ApplicationNSApplicationWillTerminateSignalInfo
instance SignalInfo ApplicationNSApplicationWillTerminateSignalInfo where
    type HaskellCallbackType ApplicationNSApplicationWillTerminateSignalInfo = ApplicationNSApplicationWillTerminateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ApplicationNSApplicationWillTerminateCallback cb
        cb'' <- mk_ApplicationNSApplicationWillTerminateCallback cb'
        connectSignalFunPtr obj "NSApplicationWillTerminate" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Application
type instance O.AttributeList Application = ApplicationAttributeList
type ApplicationAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Application = ApplicationSignalList
type ApplicationSignalList = ('[ '("nSApplicationBlockTermination", ApplicationNSApplicationBlockTerminationSignalInfo), '("nSApplicationDidBecomeActive", ApplicationNSApplicationDidBecomeActiveSignalInfo), '("nSApplicationOpenFile", ApplicationNSApplicationOpenFileSignalInfo), '("nSApplicationWillResignActive", ApplicationNSApplicationWillResignActiveSignalInfo), '("nSApplicationWillTerminate", ApplicationNSApplicationWillTerminateSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Application::attention_request
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GtkosxApplication"
--                   , name = "ApplicationAttentionType"
--                   }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "gtkosx_application_attention_request" gtkosx_application_attention_request ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    CUInt ->                                -- type : TInterface (Name {namespace = "GtkosxApplication", name = "ApplicationAttentionType"})
    IO Int32

-- | /No description available in the introspection data./
applicationAttentionRequest ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a) =>
    a
    -> GtkosxApplication.Enums.ApplicationAttentionType
    -> m Int32
applicationAttentionRequest self type_ = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    let type_' = (fromIntegral . fromEnum) type_
    result <- gtkosx_application_attention_request self' type_'
    touchManagedPtr self
    return result

#if defined(ENABLE_OVERLOADING)
data ApplicationAttentionRequestMethodInfo
instance (signature ~ (GtkosxApplication.Enums.ApplicationAttentionType -> m Int32), MonadIO m, IsApplication a) => O.MethodInfo ApplicationAttentionRequestMethodInfo a signature where
    overloadedMethod = applicationAttentionRequest

#endif

-- method Application::cancel_attention_request
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_cancel_attention_request" gtkosx_application_cancel_attention_request ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    Int32 ->                                -- id : TBasicType TInt
    IO ()

-- | /No description available in the introspection data./
applicationCancelAttentionRequest ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a) =>
    a
    -> Int32
    -> m ()
applicationCancelAttentionRequest self id = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    gtkosx_application_cancel_attention_request self' id
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationCancelAttentionRequestMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsApplication a) => O.MethodInfo ApplicationCancelAttentionRequestMethodInfo a signature where
    overloadedMethod = applicationCancelAttentionRequest

#endif

-- method Application::insert_app_menu_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu_item"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_insert_app_menu_item" gtkosx_application_insert_app_menu_item ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    Ptr Gtk.Widget.Widget ->                -- menu_item : TInterface (Name {namespace = "Gtk", name = "Widget"})
    Int32 ->                                -- index : TBasicType TInt
    IO ()

-- | /No description available in the introspection data./
applicationInsertAppMenuItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a, Gtk.Widget.IsWidget b) =>
    a
    -> b
    -> Int32
    -> m ()
applicationInsertAppMenuItem self menuItem index = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    menuItem' <- unsafeManagedPtrCastPtr menuItem
    gtkosx_application_insert_app_menu_item self' menuItem' index
    touchManagedPtr self
    touchManagedPtr menuItem
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationInsertAppMenuItemMethodInfo
instance (signature ~ (b -> Int32 -> m ()), MonadIO m, IsApplication a, Gtk.Widget.IsWidget b) => O.MethodInfo ApplicationInsertAppMenuItemMethodInfo a signature where
    overloadedMethod = applicationInsertAppMenuItem

#endif

-- method Application::ready
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_ready" gtkosx_application_ready ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    IO ()

-- | /No description available in the introspection data./
applicationReady ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a) =>
    a
    -> m ()
applicationReady self = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    gtkosx_application_ready self'
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationReadyMethodInfo
instance (signature ~ (m ()), MonadIO m, IsApplication a) => O.MethodInfo ApplicationReadyMethodInfo a signature where
    overloadedMethod = applicationReady

#endif

-- method Application::set_about_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_set_about_item" gtkosx_application_set_about_item ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    Ptr Gtk.Widget.Widget ->                -- item : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | /No description available in the introspection data./
applicationSetAboutItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a, Gtk.Widget.IsWidget b) =>
    a
    -> b
    -> m ()
applicationSetAboutItem self item = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    item' <- unsafeManagedPtrCastPtr item
    gtkosx_application_set_about_item self' item'
    touchManagedPtr self
    touchManagedPtr item
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationSetAboutItemMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsApplication a, Gtk.Widget.IsWidget b) => O.MethodInfo ApplicationSetAboutItemMethodInfo a signature where
    overloadedMethod = applicationSetAboutItem

#endif

-- method Application::set_dock_icon_pixbuf
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_set_dock_icon_pixbuf" gtkosx_application_set_dock_icon_pixbuf ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- pixbuf : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO ()

-- | /No description available in the introspection data./
applicationSetDockIconPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a, GdkPixbuf.Pixbuf.IsPixbuf b) =>
    a
    -> b
    -> m ()
applicationSetDockIconPixbuf self pixbuf = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    pixbuf' <- unsafeManagedPtrCastPtr pixbuf
    gtkosx_application_set_dock_icon_pixbuf self' pixbuf'
    touchManagedPtr self
    touchManagedPtr pixbuf
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationSetDockIconPixbufMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsApplication a, GdkPixbuf.Pixbuf.IsPixbuf b) => O.MethodInfo ApplicationSetDockIconPixbufMethodInfo a signature where
    overloadedMethod = applicationSetDockIconPixbuf

#endif

-- method Application::set_dock_icon_resource
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subdir"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_set_dock_icon_resource" gtkosx_application_set_dock_icon_resource ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- type : TBasicType TUTF8
    CString ->                              -- subdir : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
applicationSetDockIconResource ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a) =>
    a
    -> T.Text
    -> T.Text
    -> T.Text
    -> m ()
applicationSetDockIconResource self name type_ subdir = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    name' <- textToCString name
    type_' <- textToCString type_
    subdir' <- textToCString subdir
    gtkosx_application_set_dock_icon_resource self' name' type_' subdir'
    touchManagedPtr self
    freeMem name'
    freeMem type_'
    freeMem subdir'
    return ()

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

#endif

-- method Application::set_dock_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu_shell"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuShell" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_set_dock_menu" gtkosx_application_set_dock_menu ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    Ptr Gtk.MenuShell.MenuShell ->          -- menu_shell : TInterface (Name {namespace = "Gtk", name = "MenuShell"})
    IO ()

-- | /No description available in the introspection data./
applicationSetDockMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a, Gtk.MenuShell.IsMenuShell b) =>
    a
    -> b
    -> m ()
applicationSetDockMenu self menuShell = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    menuShell' <- unsafeManagedPtrCastPtr menuShell
    gtkosx_application_set_dock_menu self' menuShell'
    touchManagedPtr self
    touchManagedPtr menuShell
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationSetDockMenuMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsApplication a, Gtk.MenuShell.IsMenuShell b) => O.MethodInfo ApplicationSetDockMenuMethodInfo a signature where
    overloadedMethod = applicationSetDockMenu

#endif

-- method Application::set_help_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu_item"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_set_help_menu" gtkosx_application_set_help_menu ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    Ptr Gtk.MenuItem.MenuItem ->            -- menu_item : TInterface (Name {namespace = "Gtk", name = "MenuItem"})
    IO ()

-- | /No description available in the introspection data./
applicationSetHelpMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a, Gtk.MenuItem.IsMenuItem b) =>
    a
    -> b
    -> m ()
applicationSetHelpMenu self menuItem = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    menuItem' <- unsafeManagedPtrCastPtr menuItem
    gtkosx_application_set_help_menu self' menuItem'
    touchManagedPtr self
    touchManagedPtr menuItem
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationSetHelpMenuMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsApplication a, Gtk.MenuItem.IsMenuItem b) => O.MethodInfo ApplicationSetHelpMenuMethodInfo a signature where
    overloadedMethod = applicationSetHelpMenu

#endif

-- method Application::set_menu_bar
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu_shell"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuShell" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_set_menu_bar" gtkosx_application_set_menu_bar ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    Ptr Gtk.MenuShell.MenuShell ->          -- menu_shell : TInterface (Name {namespace = "Gtk", name = "MenuShell"})
    IO ()

-- | /No description available in the introspection data./
applicationSetMenuBar ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a, Gtk.MenuShell.IsMenuShell b) =>
    a
    -> b
    -> m ()
applicationSetMenuBar self menuShell = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    menuShell' <- unsafeManagedPtrCastPtr menuShell
    gtkosx_application_set_menu_bar self' menuShell'
    touchManagedPtr self
    touchManagedPtr menuShell
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationSetMenuBarMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsApplication a, Gtk.MenuShell.IsMenuShell b) => O.MethodInfo ApplicationSetMenuBarMethodInfo a signature where
    overloadedMethod = applicationSetMenuBar

#endif

-- method Application::set_use_quartz_accelerators
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The GtkosxApplication pointer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "use_quartz_accelerators"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Gboolean" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_set_use_quartz_accelerators" gtkosx_application_set_use_quartz_accelerators ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    CInt ->                                 -- use_quartz_accelerators : TBasicType TBoolean
    IO ()

-- | Set quartz accelerator handling; TRUE (default) uses quartz; FALSE
-- uses Gtk+. Quartz accelerator handling is required for normal OS X
-- accelerators (e.g., command-q to quit) to work.
applicationSetUseQuartzAccelerators ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a) =>
    a
    -- ^ /@self@/: The GtkosxApplication pointer.
    -> Bool
    -- ^ /@useQuartzAccelerators@/: Gboolean
    -> m ()
applicationSetUseQuartzAccelerators self useQuartzAccelerators = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    let useQuartzAccelerators' = (fromIntegral . fromEnum) useQuartzAccelerators
    gtkosx_application_set_use_quartz_accelerators self' useQuartzAccelerators'
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationSetUseQuartzAcceleratorsMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsApplication a) => O.MethodInfo ApplicationSetUseQuartzAcceleratorsMethodInfo a signature where
    overloadedMethod = applicationSetUseQuartzAccelerators

#endif

-- method Application::set_window_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu_item"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_set_window_menu" gtkosx_application_set_window_menu ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    Ptr Gtk.MenuItem.MenuItem ->            -- menu_item : TInterface (Name {namespace = "Gtk", name = "MenuItem"})
    IO ()

-- | /No description available in the introspection data./
applicationSetWindowMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a, Gtk.MenuItem.IsMenuItem b) =>
    a
    -> b
    -> m ()
applicationSetWindowMenu self menuItem = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    menuItem' <- unsafeManagedPtrCastPtr menuItem
    gtkosx_application_set_window_menu self' menuItem'
    touchManagedPtr self
    touchManagedPtr menuItem
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationSetWindowMenuMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsApplication a, Gtk.MenuItem.IsMenuItem b) => O.MethodInfo ApplicationSetWindowMenuMethodInfo a signature where
    overloadedMethod = applicationSetWindowMenu

#endif

-- method Application::sync_menubar
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_sync_menubar" gtkosx_application_sync_menubar ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    IO ()

-- | /No description available in the introspection data./
applicationSyncMenubar ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a) =>
    a
    -> m ()
applicationSyncMenubar self = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    gtkosx_application_sync_menubar self'
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationSyncMenubarMethodInfo
instance (signature ~ (m ()), MonadIO m, IsApplication a) => O.MethodInfo ApplicationSyncMenubarMethodInfo a signature where
    overloadedMethod = applicationSyncMenubar

#endif

-- method Application::use_quartz_accelerators
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkosxApplication" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The GtkosxApplication pointer."
--                 , 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 "gtkosx_application_use_quartz_accelerators" gtkosx_application_use_quartz_accelerators ::
    Ptr Application ->                      -- self : TInterface (Name {namespace = "GtkosxApplication", name = "Application"})
    IO CInt

-- | Are we using Quartz or Gtk+ accelerator handling?
applicationUseQuartzAccelerators ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a) =>
    a
    -- ^ /@self@/: The GtkosxApplication pointer.
    -> m Bool
    -- ^ __Returns:__ a gboolean
applicationUseQuartzAccelerators self = liftIO $ do
    self' <- unsafeManagedPtrCastPtr self
    result <- gtkosx_application_use_quartz_accelerators self'
    let result' = (/= 0) result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data ApplicationUseQuartzAcceleratorsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsApplication a) => O.MethodInfo ApplicationUseQuartzAcceleratorsMethodInfo a signature where
    overloadedMethod = applicationUseQuartzAccelerators

#endif

-- method Application::get
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkosxApplication" , name = "Application" })
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_get" gtkosx_application_get ::
    IO (Ptr Application)

-- | /No description available in the introspection data./
applicationGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Application
    -- ^ __Returns:__ the singleton application object.
applicationGet  = liftIO $ do
    result <- gtkosx_application_get
    checkUnexpectedReturnNULL "applicationGet" result
    result' <- (newObject Application) result
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Application::get_bundle_id
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_get_bundle_id" gtkosx_application_get_bundle_id ::
    IO CString

-- | /No description available in the introspection data./
applicationGetBundleId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m T.Text
applicationGetBundleId  = liftIO $ do
    result <- gtkosx_application_get_bundle_id
    checkUnexpectedReturnNULL "applicationGetBundleId" result
    result' <- cstringToText result
    freeMem result
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Application::get_bundle_info
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "gtkosx_application_get_bundle_info" gtkosx_application_get_bundle_info ::
    CString ->                              -- key : TBasicType TUTF8
    IO CString

-- | /No description available in the introspection data./
applicationGetBundleInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> m T.Text
applicationGetBundleInfo key = liftIO $ do
    key' <- textToCString key
    result <- gtkosx_application_get_bundle_info key'
    checkUnexpectedReturnNULL "applicationGetBundleInfo" result
    result' <- cstringToText result
    freeMem result
    freeMem key'
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Application::get_bundle_path
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_get_bundle_path" gtkosx_application_get_bundle_path ::
    IO CString

-- | /No description available in the introspection data./
applicationGetBundlePath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m T.Text
applicationGetBundlePath  = liftIO $ do
    result <- gtkosx_application_get_bundle_path
    checkUnexpectedReturnNULL "applicationGetBundlePath" result
    result' <- cstringToText result
    freeMem result
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Application::get_executable_path
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_get_executable_path" gtkosx_application_get_executable_path ::
    IO CString

-- | /No description available in the introspection data./
applicationGetExecutablePath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m T.Text
applicationGetExecutablePath  = liftIO $ do
    result <- gtkosx_application_get_executable_path
    checkUnexpectedReturnNULL "applicationGetExecutablePath" result
    result' <- cstringToText result
    freeMem result
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Application::get_resource_path
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtkosx_application_get_resource_path" gtkosx_application_get_resource_path ::
    IO CString

-- | /No description available in the introspection data./
applicationGetResourcePath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m T.Text
applicationGetResourcePath  = liftIO $ do
    result <- gtkosx_application_get_resource_path
    checkUnexpectedReturnNULL "applicationGetResourcePath" result
    result' <- cstringToText result
    freeMem result
    return result'

#if defined(ENABLE_OVERLOADING)
#endif