{-# LINE 2 "./Graphics/UI/Gtk/OSX/Application.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) SourceBuffer
--
-- Author : Peter Gavin
-- derived from sourceview bindings by Axel Simon and Duncan Coutts
--
-- Created: 18 December 2008
--
-- Copyright (C) 2003-2008 Peter Gavin, Duncan Coutts, Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
module Graphics.UI.Gtk.OSX.Application (
  Application,
  ApplicationClass,
  castToApplication,
  gTypeApplication,
  toApplication,

  applicationNew,
  applicationReady,
  applicationSetUseQuartsAccelerators,
  applicationSetMenuBar,
  applicationSyncMenuBar,
  applicationInsertAppMenuItem,
  applicationSetWindowMenu,
  applicationSetHelpMenu,
  GtkosxApplicationAttentionType(..),
  applicationSetDockMenu,
  applicationSetDockIconPixbuf,
  applicationSetDockIconResource,
  AttentionRequestID(..),
  applicationAttentionRequest,
  applicationCancelAttentionRequest,
  applicationGetBundlePath,
  applicationGetResourcePath,
  applicationGetExecutablePath,
  applicationGetBundleId,
  applicationGetBundleInfo,
  didBecomeActive,
  willResignActive,
  blockTermination,
  willTerminate,
  openFile
 ) where

import Control.Monad (liftM)
import Data.Maybe (fromMaybe)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject (objectNew, makeNewGObject)
import System.Glib.Properties
{-# LINE 68 "./Graphics/UI/Gtk/OSX/Application.chs" #-}
import System.Glib.Attributes
import Graphics.UI.Gtk.OSX.Types
{-# LINE 70 "./Graphics/UI/Gtk/OSX/Application.chs" #-}
import Graphics.UI.Gtk.OSX.Signals
{-# LINE 71 "./Graphics/UI/Gtk/OSX/Application.chs" #-}


{-# LINE 73 "./Graphics/UI/Gtk/OSX/Application.chs" #-}

-- methods

applicationNew :: IO Application
applicationNew = makeNewGObject mkApplication $ liftM castPtr $
    objectNew gTypeApplication []

-- |
--
applicationReady :: ApplicationClass self => self -> IO ()
applicationReady self =
    (\(Application arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtkosx_application_ready argPtr1) (toApplication self)

-- |
--
applicationSetUseQuartsAccelerators :: ApplicationClass self => self -> Bool -> IO ()
applicationSetUseQuartsAccelerators self b =
    (\(Application arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtkosx_application_set_use_quartz_accelerators argPtr1 arg2) (toApplication self) (fromBool b)

-- |
--
applicationGetUseQuartsAccelerators :: ApplicationClass self => self -> IO Bool
applicationGetUseQuartsAccelerators self = liftM toBool $
    (\(Application arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtkosx_application_use_quartz_accelerators argPtr1) (toApplication self)

-- |
--
applicationSetMenuBar :: (ApplicationClass self, MenuShellClass menu) => self -> menu -> IO ()
applicationSetMenuBar self menu =
    (\(Application arg1) (MenuShell arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtkosx_application_set_menu_bar argPtr1 argPtr2) (toApplication self) (toMenuShell menu)

-- |
--
applicationSyncMenuBar :: ApplicationClass self => self -> IO ()
applicationSyncMenuBar self =
    (\(Application arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtkosx_application_sync_menubar argPtr1) (toApplication self)

-- |
--
applicationInsertAppMenuItem :: (ApplicationClass self, WidgetClass menu_item) => self -> menu_item -> Int -> IO ()
applicationInsertAppMenuItem self menu_item index =
    (\(Application arg1) (Widget arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtkosx_application_insert_app_menu_item argPtr1 argPtr2 arg3) (toApplication self) (toWidget menu_item) (fromIntegral index)

-- |
--
applicationSetWindowMenu :: (ApplicationClass self, MenuItemClass menuItem)
    => self -> menuItem -> IO ()
applicationSetWindowMenu self menuItem =
    (\(Application arg1) (MenuItem arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtkosx_application_set_window_menu argPtr1 argPtr2) (toApplication self) (toMenuItem menuItem)

-- |
--
applicationSetHelpMenu :: (ApplicationClass self, MenuItemClass menuItem)
    => self -> menuItem -> IO ()
applicationSetHelpMenu self menuItem =
    (\(Application arg1) (MenuItem arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtkosx_application_set_help_menu argPtr1 argPtr2) (toApplication self) (toMenuItem menuItem)

data GtkosxApplicationAttentionType = CriticalRequest
                                    | InfoRequest
                                    deriving (Eq,Show)
instance Enum GtkosxApplicationAttentionType where
  fromEnum CriticalRequest = 0
  fromEnum InfoRequest = 10

  toEnum 0 = CriticalRequest
  toEnum 10 = InfoRequest
  toEnum unmatched = error ("GtkosxApplicationAttentionType.toEnum: Cannot match " ++ show unmatched)

  succ CriticalRequest = InfoRequest
  succ _ = undefined

  pred InfoRequest = CriticalRequest
  pred _ = undefined

  enumFromTo x y | fromEnum x == fromEnum y = [ y ]
                 | otherwise = x : enumFromTo (succ x) y
  enumFrom x = enumFromTo x InfoRequest
  enumFromThen _ _ =     error "Enum GtkosxApplicationAttentionType: enumFromThen not implemented"
  enumFromThenTo _ _ _ =     error "Enum GtkosxApplicationAttentionType: enumFromThenTo not implemented"

{-# LINE 131 "./Graphics/UI/Gtk/OSX/Application.chs" #-}

-- |
--
applicationSetDockMenu :: (ApplicationClass self, MenuShellClass menu) => self -> menu -> IO ()
applicationSetDockMenu self menu =
    (\(Application arg1) (MenuShell arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtkosx_application_set_dock_menu argPtr1 argPtr2) (toApplication self) (toMenuShell menu)

-- |
--
applicationSetDockIconPixbuf :: (ApplicationClass self, PixbufClass pixbuf) => self -> Maybe pixbuf -> IO ()
applicationSetDockIconPixbuf self mbPixbuf =
    (\(Application arg1) (Pixbuf arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtkosx_application_set_dock_icon_pixbuf argPtr1 argPtr2) (toApplication self)
        (maybe (Pixbuf nullForeignPtr) toPixbuf mbPixbuf)

-- |
--
applicationSetDockIconResource :: (ApplicationClass self, GlibString string)
    => self -> string -> string -> string -> IO ()
applicationSetDockIconResource self name rType subdir =
    withUTFString name $ \namePtr ->
    withUTFString rType $ \typePtr ->
    withUTFString subdir $ \subdirPtr ->
    (\(Application arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gtkosx_application_set_dock_icon_resource argPtr1 arg2 arg3 arg4) (toApplication self) namePtr typePtr subdirPtr

newtype AttentionRequestID = AttentionRequestID CInt

-- |
--
applicationAttentionRequest :: ApplicationClass self => self -> GtkosxApplicationAttentionType -> IO AttentionRequestID
applicationAttentionRequest self rType = liftM AttentionRequestID $
    (\(Application arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtkosx_application_attention_request argPtr1 arg2) (toApplication self) (fromIntegral $ fromEnum rType)

-- |
--
applicationCancelAttentionRequest :: ApplicationClass self => self -> AttentionRequestID -> IO ()
applicationCancelAttentionRequest self (AttentionRequestID id) =
    (\(Application arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtkosx_application_cancel_attention_request argPtr1 arg2) (toApplication self) id

-- |
--
applicationGetBundlePath :: GlibString string => IO string
applicationGetBundlePath =
    gtkosx_application_get_bundle_path >>= peekUTFString

-- |
--
applicationGetResourcePath :: GlibString string => IO string
applicationGetResourcePath =
    gtkosx_application_get_resource_path >>= peekUTFString

-- |
--
applicationGetExecutablePath :: GlibString string => IO string
applicationGetExecutablePath =
    gtkosx_application_get_executable_path >>= peekUTFString

-- |
--
applicationGetBundleId :: GlibString string => IO string
applicationGetBundleId =
    gtkosx_application_get_bundle_id >>= peekUTFString

-- |
--
applicationGetBundleInfo :: GlibString string => string -> IO string
applicationGetBundleInfo key =
    withUTFString key $ \keyPtr ->
    gtkosx_application_get_bundle_info keyPtr >>= peekUTFString

-- |
--
didBecomeActive :: ApplicationClass self => Signal self (IO ())
didBecomeActive = Signal (connect_NONE__NONE "NSApplicationDidBecomeActive")

-- |
--
willResignActive :: ApplicationClass self => Signal self (IO ())
willResignActive = Signal (connect_NONE__NONE "NSApplicationWillResignActive")

-- |
--
blockTermination :: ApplicationClass self => Signal self (IO Bool)
blockTermination = Signal (connect_NONE__BOOL "NSApplicationBlockTermination")

-- |
--
willTerminate :: ApplicationClass self => Signal self (IO ())
willTerminate = Signal (connect_NONE__NONE "NSApplicationWillTerminate")

-- |
--
openFile :: (ApplicationClass self, GlibString string) => Signal self (string -> IO ())
openFile = Signal (connect_GLIBSTRING__NONE "NSApplicationOpenFile")

foreign import ccall unsafe "gtkosx_application_ready"
  gtkosx_application_ready :: ((Ptr Application) -> (IO ()))

foreign import ccall unsafe "gtkosx_application_set_use_quartz_accelerators"
  gtkosx_application_set_use_quartz_accelerators :: ((Ptr Application) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtkosx_application_use_quartz_accelerators"
  gtkosx_application_use_quartz_accelerators :: ((Ptr Application) -> (IO CInt))

foreign import ccall unsafe "gtkosx_application_set_menu_bar"
  gtkosx_application_set_menu_bar :: ((Ptr Application) -> ((Ptr MenuShell) -> (IO ())))

foreign import ccall unsafe "gtkosx_application_sync_menubar"
  gtkosx_application_sync_menubar :: ((Ptr Application) -> (IO ()))

foreign import ccall unsafe "gtkosx_application_insert_app_menu_item"
  gtkosx_application_insert_app_menu_item :: ((Ptr Application) -> ((Ptr Widget) -> (CInt -> (IO ()))))

foreign import ccall unsafe "gtkosx_application_set_window_menu"
  gtkosx_application_set_window_menu :: ((Ptr Application) -> ((Ptr MenuItem) -> (IO ())))

foreign import ccall unsafe "gtkosx_application_set_help_menu"
  gtkosx_application_set_help_menu :: ((Ptr Application) -> ((Ptr MenuItem) -> (IO ())))

foreign import ccall unsafe "gtkosx_application_set_dock_menu"
  gtkosx_application_set_dock_menu :: ((Ptr Application) -> ((Ptr MenuShell) -> (IO ())))

foreign import ccall unsafe "gtkosx_application_set_dock_icon_pixbuf"
  gtkosx_application_set_dock_icon_pixbuf :: ((Ptr Application) -> ((Ptr Pixbuf) -> (IO ())))

foreign import ccall unsafe "gtkosx_application_set_dock_icon_resource"
  gtkosx_application_set_dock_icon_resource :: ((Ptr Application) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO ())))))

foreign import ccall unsafe "gtkosx_application_attention_request"
  gtkosx_application_attention_request :: ((Ptr Application) -> (CInt -> (IO CInt)))

foreign import ccall unsafe "gtkosx_application_cancel_attention_request"
  gtkosx_application_cancel_attention_request :: ((Ptr Application) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtkosx_application_get_bundle_path"
  gtkosx_application_get_bundle_path :: (IO (Ptr CChar))

foreign import ccall unsafe "gtkosx_application_get_resource_path"
  gtkosx_application_get_resource_path :: (IO (Ptr CChar))

foreign import ccall unsafe "gtkosx_application_get_executable_path"
  gtkosx_application_get_executable_path :: (IO (Ptr CChar))

foreign import ccall unsafe "gtkosx_application_get_bundle_id"
  gtkosx_application_get_bundle_id :: (IO (Ptr CChar))

foreign import ccall unsafe "gtkosx_application_get_bundle_info"
  gtkosx_application_get_bundle_info :: ((Ptr CChar) -> (IO (Ptr CChar)))