{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (garetxe@gmail.com) -} module GI.Gtk.Objects.AccelMap ( -- * Exported types AccelMap(..) , AccelMapK , toAccelMap , noAccelMap , -- * Methods -- ** accelMapAddEntry accelMapAddEntry , -- ** accelMapAddFilter accelMapAddFilter , -- ** accelMapChangeEntry accelMapChangeEntry , -- ** accelMapForeach accelMapForeach , -- ** accelMapForeachUnfiltered accelMapForeachUnfiltered , -- ** accelMapGet accelMapGet , -- ** accelMapLoad accelMapLoad , -- ** accelMapLoadFd accelMapLoadFd , -- ** accelMapLoadScanner accelMapLoadScanner , -- ** accelMapLockPath accelMapLockPath , -- ** accelMapLookupEntry accelMapLookupEntry , -- ** accelMapSave accelMapSave , -- ** accelMapSaveFd accelMapSaveFd , -- ** accelMapUnlockPath accelMapUnlockPath , -- * Signals -- ** Changed AccelMapChangedCallback , AccelMapChangedCallbackC , AccelMapChangedSignalInfo , accelMapChangedCallbackWrapper , accelMapChangedClosure , afterAccelMapChanged , mkAccelMapChangedCallback , noAccelMapChangedCallback , onAccelMapChanged , ) where import Prelude () import Data.GI.Base.ShortPrelude import qualified Data.Text as T import qualified Data.ByteString.Char8 as B import qualified Data.Map as Map import GI.Gtk.Types import GI.Gtk.Callbacks import qualified GI.GLib as GLib import qualified GI.GObject as GObject import qualified GI.Gdk as Gdk newtype AccelMap = AccelMap (ForeignPtr AccelMap) foreign import ccall "gtk_accel_map_get_type" c_gtk_accel_map_get_type :: IO GType type instance ParentTypes AccelMap = AccelMapParentTypes type AccelMapParentTypes = '[GObject.Object] instance GObject AccelMap where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_gtk_accel_map_get_type class GObject o => AccelMapK o instance (GObject o, IsDescendantOf AccelMap o) => AccelMapK o toAccelMap :: AccelMapK o => o -> IO AccelMap toAccelMap = unsafeCastTo AccelMap noAccelMap :: Maybe AccelMap noAccelMap = Nothing -- signal AccelMap::changed type AccelMapChangedCallback = T.Text -> Word32 -> [Gdk.ModifierType] -> IO () noAccelMapChangedCallback :: Maybe AccelMapChangedCallback noAccelMapChangedCallback = Nothing type AccelMapChangedCallbackC = Ptr () -> -- object CString -> Word32 -> CUInt -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkAccelMapChangedCallback :: AccelMapChangedCallbackC -> IO (FunPtr AccelMapChangedCallbackC) accelMapChangedClosure :: AccelMapChangedCallback -> IO Closure accelMapChangedClosure cb = newCClosure =<< mkAccelMapChangedCallback wrapped where wrapped = accelMapChangedCallbackWrapper cb accelMapChangedCallbackWrapper :: AccelMapChangedCallback -> Ptr () -> CString -> Word32 -> CUInt -> Ptr () -> IO () accelMapChangedCallbackWrapper _cb _ accel_path accel_key accel_mods _ = do accel_path' <- cstringToText accel_path let accel_mods' = wordToGFlags accel_mods _cb accel_path' accel_key accel_mods' onAccelMapChanged :: (GObject a, MonadIO m) => a -> AccelMapChangedCallback -> m SignalHandlerId onAccelMapChanged obj cb = liftIO $ connectAccelMapChanged obj cb SignalConnectBefore afterAccelMapChanged :: (GObject a, MonadIO m) => a -> AccelMapChangedCallback -> m SignalHandlerId afterAccelMapChanged obj cb = connectAccelMapChanged obj cb SignalConnectAfter connectAccelMapChanged :: (GObject a, MonadIO m) => a -> AccelMapChangedCallback -> SignalConnectMode -> m SignalHandlerId connectAccelMapChanged obj cb after = liftIO $ do cb' <- mkAccelMapChangedCallback (accelMapChangedCallbackWrapper cb) connectSignalFunPtr obj "changed" cb' after type instance AttributeList AccelMap = AccelMapAttributeList type AccelMapAttributeList = ('[ ] :: [(Symbol, *)]) data AccelMapChangedSignalInfo instance SignalInfo AccelMapChangedSignalInfo where type HaskellCallbackType AccelMapChangedSignalInfo = AccelMapChangedCallback connectSignal _ = connectAccelMapChanged type instance SignalList AccelMap = AccelMapSignalList type AccelMapSignalList = ('[ '("changed", AccelMapChangedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)]) -- method AccelMap::add_entry -- method type : MemberFunction -- Args : [Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_add_entry" gtk_accel_map_add_entry :: CString -> -- accel_path : TBasicType TUTF8 Word32 -> -- accel_key : TBasicType TUInt32 CUInt -> -- accel_mods : TInterface "Gdk" "ModifierType" IO () accelMapAddEntry :: (MonadIO m) => T.Text -> -- accel_path Word32 -> -- accel_key [Gdk.ModifierType] -> -- accel_mods m () accelMapAddEntry accel_path accel_key accel_mods = liftIO $ do accel_path' <- textToCString accel_path let accel_mods' = gflagsToWord accel_mods gtk_accel_map_add_entry accel_path' accel_key accel_mods' freeMem accel_path' return () -- method AccelMap::add_filter -- method type : MemberFunction -- Args : [Arg {argName = "filter_pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "filter_pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_add_filter" gtk_accel_map_add_filter :: CString -> -- filter_pattern : TBasicType TUTF8 IO () accelMapAddFilter :: (MonadIO m) => T.Text -> -- filter_pattern m () accelMapAddFilter filter_pattern = liftIO $ do filter_pattern' <- textToCString filter_pattern gtk_accel_map_add_filter filter_pattern' freeMem filter_pattern' return () -- method AccelMap::change_entry -- method type : MemberFunction -- Args : [Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replace", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replace", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_change_entry" gtk_accel_map_change_entry :: CString -> -- accel_path : TBasicType TUTF8 Word32 -> -- accel_key : TBasicType TUInt32 CUInt -> -- accel_mods : TInterface "Gdk" "ModifierType" CInt -> -- replace : TBasicType TBoolean IO CInt accelMapChangeEntry :: (MonadIO m) => T.Text -> -- accel_path Word32 -> -- accel_key [Gdk.ModifierType] -> -- accel_mods Bool -> -- replace m Bool accelMapChangeEntry accel_path accel_key accel_mods replace = liftIO $ do accel_path' <- textToCString accel_path let accel_mods' = gflagsToWord accel_mods let replace' = (fromIntegral . fromEnum) replace result <- gtk_accel_map_change_entry accel_path' accel_key accel_mods' replace' let result' = (/= 0) result freeMem accel_path' return result' -- method AccelMap::foreach -- method type : MemberFunction -- Args : [Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "foreach_func", argType = TInterface "Gtk" "AccelMapForeach", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "foreach_func", argType = TInterface "Gtk" "AccelMapForeach", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_foreach" gtk_accel_map_foreach :: Ptr () -> -- data : TBasicType TVoid FunPtr AccelMapForeachC -> -- foreach_func : TInterface "Gtk" "AccelMapForeach" IO () accelMapForeach :: (MonadIO m) => Maybe (Ptr ()) -> -- data AccelMapForeach -> -- foreach_func m () accelMapForeach data_ foreach_func = liftIO $ do maybeData_ <- case data_ of Nothing -> return nullPtr Just jData_ -> do return jData_ foreach_func' <- mkAccelMapForeach (accelMapForeachWrapper Nothing foreach_func) gtk_accel_map_foreach maybeData_ foreach_func' safeFreeFunPtr $ castFunPtrToPtr foreach_func' return () -- method AccelMap::foreach_unfiltered -- method type : MemberFunction -- Args : [Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "foreach_func", argType = TInterface "Gtk" "AccelMapForeach", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "foreach_func", argType = TInterface "Gtk" "AccelMapForeach", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_foreach_unfiltered" gtk_accel_map_foreach_unfiltered :: Ptr () -> -- data : TBasicType TVoid FunPtr AccelMapForeachC -> -- foreach_func : TInterface "Gtk" "AccelMapForeach" IO () accelMapForeachUnfiltered :: (MonadIO m) => Ptr () -> -- data AccelMapForeach -> -- foreach_func m () accelMapForeachUnfiltered data_ foreach_func = liftIO $ do foreach_func' <- mkAccelMapForeach (accelMapForeachWrapper Nothing foreach_func) gtk_accel_map_foreach_unfiltered data_ foreach_func' safeFreeFunPtr $ castFunPtrToPtr foreach_func' return () -- method AccelMap::get -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gtk" "AccelMap" -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_get" gtk_accel_map_get :: IO (Ptr AccelMap) accelMapGet :: (MonadIO m) => m AccelMap accelMapGet = liftIO $ do result <- gtk_accel_map_get checkUnexpectedReturnNULL "gtk_accel_map_get" result result' <- (newObject AccelMap) result return result' -- method AccelMap::load -- method type : MemberFunction -- Args : [Arg {argName = "file_name", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file_name", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_load" gtk_accel_map_load :: CString -> -- file_name : TBasicType TFileName IO () accelMapLoad :: (MonadIO m) => [Char] -> -- file_name m () accelMapLoad file_name = liftIO $ do file_name' <- stringToCString file_name gtk_accel_map_load file_name' freeMem file_name' return () -- method AccelMap::load_fd -- method type : MemberFunction -- Args : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_load_fd" gtk_accel_map_load_fd :: Int32 -> -- fd : TBasicType TInt32 IO () accelMapLoadFd :: (MonadIO m) => Int32 -> -- fd m () accelMapLoadFd fd = liftIO $ do gtk_accel_map_load_fd fd return () -- method AccelMap::load_scanner -- method type : MemberFunction -- Args : [Arg {argName = "scanner", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "scanner", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_load_scanner" gtk_accel_map_load_scanner :: Ptr GLib.Scanner -> -- scanner : TInterface "GLib" "Scanner" IO () accelMapLoadScanner :: (MonadIO m) => GLib.Scanner -> -- scanner m () accelMapLoadScanner scanner = liftIO $ do let scanner' = unsafeManagedPtrGetPtr scanner gtk_accel_map_load_scanner scanner' touchManagedPtr scanner return () -- method AccelMap::lock_path -- method type : MemberFunction -- Args : [Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_lock_path" gtk_accel_map_lock_path :: CString -> -- accel_path : TBasicType TUTF8 IO () accelMapLockPath :: (MonadIO m) => T.Text -> -- accel_path m () accelMapLockPath accel_path = liftIO $ do accel_path' <- textToCString accel_path gtk_accel_map_lock_path accel_path' freeMem accel_path' return () -- method AccelMap::lookup_entry -- method type : MemberFunction -- Args : [Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TInterface "Gtk" "AccelKey", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_lookup_entry" gtk_accel_map_lookup_entry :: CString -> -- accel_path : TBasicType TUTF8 Ptr AccelKey -> -- key : TInterface "Gtk" "AccelKey" IO CInt accelMapLookupEntry :: (MonadIO m) => T.Text -> -- accel_path m (Bool,AccelKey) accelMapLookupEntry accel_path = liftIO $ do accel_path' <- textToCString accel_path key <- callocBytes 12 :: IO (Ptr AccelKey) result <- gtk_accel_map_lookup_entry accel_path' key let result' = (/= 0) result key' <- (wrapPtr AccelKey) key freeMem accel_path' return (result', key') -- method AccelMap::save -- method type : MemberFunction -- Args : [Arg {argName = "file_name", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file_name", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_save" gtk_accel_map_save :: CString -> -- file_name : TBasicType TFileName IO () accelMapSave :: (MonadIO m) => [Char] -> -- file_name m () accelMapSave file_name = liftIO $ do file_name' <- stringToCString file_name gtk_accel_map_save file_name' freeMem file_name' return () -- method AccelMap::save_fd -- method type : MemberFunction -- Args : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_save_fd" gtk_accel_map_save_fd :: Int32 -> -- fd : TBasicType TInt32 IO () accelMapSaveFd :: (MonadIO m) => Int32 -> -- fd m () accelMapSaveFd fd = liftIO $ do gtk_accel_map_save_fd fd return () -- method AccelMap::unlock_path -- method type : MemberFunction -- Args : [Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_accel_map_unlock_path" gtk_accel_map_unlock_path :: CString -> -- accel_path : TBasicType TUTF8 IO () accelMapUnlockPath :: (MonadIO m) => T.Text -> -- accel_path m () accelMapUnlockPath accel_path = liftIO $ do accel_path' <- textToCString accel_path gtk_accel_map_unlock_path accel_path' freeMem accel_path' return ()