{- | 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.Interfaces.FileChooser ( -- * Exported types FileChooser(..) , noFileChooser , FileChooserK , toFileChooser , -- * Methods -- ** fileChooserAddFilter fileChooserAddFilter , -- ** fileChooserAddShortcutFolder fileChooserAddShortcutFolder , -- ** fileChooserAddShortcutFolderUri fileChooserAddShortcutFolderUri , -- ** fileChooserGetAction fileChooserGetAction , -- ** fileChooserGetCreateFolders fileChooserGetCreateFolders , -- ** fileChooserGetCurrentFolder fileChooserGetCurrentFolder , -- ** fileChooserGetCurrentFolderFile fileChooserGetCurrentFolderFile , -- ** fileChooserGetCurrentFolderUri fileChooserGetCurrentFolderUri , -- ** fileChooserGetCurrentName fileChooserGetCurrentName , -- ** fileChooserGetDoOverwriteConfirmation fileChooserGetDoOverwriteConfirmation , -- ** fileChooserGetExtraWidget fileChooserGetExtraWidget , -- ** fileChooserGetFile fileChooserGetFile , -- ** fileChooserGetFilename fileChooserGetFilename , -- ** fileChooserGetFilenames fileChooserGetFilenames , -- ** fileChooserGetFiles fileChooserGetFiles , -- ** fileChooserGetFilter fileChooserGetFilter , -- ** fileChooserGetLocalOnly fileChooserGetLocalOnly , -- ** fileChooserGetPreviewFile fileChooserGetPreviewFile , -- ** fileChooserGetPreviewFilename fileChooserGetPreviewFilename , -- ** fileChooserGetPreviewUri fileChooserGetPreviewUri , -- ** fileChooserGetPreviewWidget fileChooserGetPreviewWidget , -- ** fileChooserGetPreviewWidgetActive fileChooserGetPreviewWidgetActive , -- ** fileChooserGetSelectMultiple fileChooserGetSelectMultiple , -- ** fileChooserGetShowHidden fileChooserGetShowHidden , -- ** fileChooserGetUri fileChooserGetUri , -- ** fileChooserGetUris fileChooserGetUris , -- ** fileChooserGetUsePreviewLabel fileChooserGetUsePreviewLabel , -- ** fileChooserListFilters fileChooserListFilters , -- ** fileChooserListShortcutFolderUris fileChooserListShortcutFolderUris , -- ** fileChooserListShortcutFolders fileChooserListShortcutFolders , -- ** fileChooserRemoveFilter fileChooserRemoveFilter , -- ** fileChooserRemoveShortcutFolder fileChooserRemoveShortcutFolder , -- ** fileChooserRemoveShortcutFolderUri fileChooserRemoveShortcutFolderUri , -- ** fileChooserSelectAll fileChooserSelectAll , -- ** fileChooserSelectFile fileChooserSelectFile , -- ** fileChooserSelectFilename fileChooserSelectFilename , -- ** fileChooserSelectUri fileChooserSelectUri , -- ** fileChooserSetAction fileChooserSetAction , -- ** fileChooserSetCreateFolders fileChooserSetCreateFolders , -- ** fileChooserSetCurrentFolder fileChooserSetCurrentFolder , -- ** fileChooserSetCurrentFolderFile fileChooserSetCurrentFolderFile , -- ** fileChooserSetCurrentFolderUri fileChooserSetCurrentFolderUri , -- ** fileChooserSetCurrentName fileChooserSetCurrentName , -- ** fileChooserSetDoOverwriteConfirmation fileChooserSetDoOverwriteConfirmation , -- ** fileChooserSetExtraWidget fileChooserSetExtraWidget , -- ** fileChooserSetFile fileChooserSetFile , -- ** fileChooserSetFilename fileChooserSetFilename , -- ** fileChooserSetFilter fileChooserSetFilter , -- ** fileChooserSetLocalOnly fileChooserSetLocalOnly , -- ** fileChooserSetPreviewWidget fileChooserSetPreviewWidget , -- ** fileChooserSetPreviewWidgetActive fileChooserSetPreviewWidgetActive , -- ** fileChooserSetSelectMultiple fileChooserSetSelectMultiple , -- ** fileChooserSetShowHidden fileChooserSetShowHidden , -- ** fileChooserSetUri fileChooserSetUri , -- ** fileChooserSetUsePreviewLabel fileChooserSetUsePreviewLabel , -- ** fileChooserUnselectAll fileChooserUnselectAll , -- ** fileChooserUnselectFile fileChooserUnselectFile , -- ** fileChooserUnselectFilename fileChooserUnselectFilename , -- ** fileChooserUnselectUri fileChooserUnselectUri , -- * Properties -- ** Action FileChooserActionPropertyInfo , constructFileChooserAction , getFileChooserAction , setFileChooserAction , -- ** CreateFolders FileChooserCreateFoldersPropertyInfo , constructFileChooserCreateFolders , getFileChooserCreateFolders , setFileChooserCreateFolders , -- ** DoOverwriteConfirmation FileChooserDoOverwriteConfirmationPropertyInfo, constructFileChooserDoOverwriteConfirmation, getFileChooserDoOverwriteConfirmation , setFileChooserDoOverwriteConfirmation , -- ** ExtraWidget FileChooserExtraWidgetPropertyInfo , constructFileChooserExtraWidget , getFileChooserExtraWidget , setFileChooserExtraWidget , -- ** Filter FileChooserFilterPropertyInfo , constructFileChooserFilter , getFileChooserFilter , setFileChooserFilter , -- ** LocalOnly FileChooserLocalOnlyPropertyInfo , constructFileChooserLocalOnly , getFileChooserLocalOnly , setFileChooserLocalOnly , -- ** PreviewWidget FileChooserPreviewWidgetPropertyInfo , constructFileChooserPreviewWidget , getFileChooserPreviewWidget , setFileChooserPreviewWidget , -- ** PreviewWidgetActive FileChooserPreviewWidgetActivePropertyInfo, constructFileChooserPreviewWidgetActive , getFileChooserPreviewWidgetActive , setFileChooserPreviewWidgetActive , -- ** SelectMultiple FileChooserSelectMultiplePropertyInfo , constructFileChooserSelectMultiple , getFileChooserSelectMultiple , setFileChooserSelectMultiple , -- ** ShowHidden FileChooserShowHiddenPropertyInfo , constructFileChooserShowHidden , getFileChooserShowHidden , setFileChooserShowHidden , -- ** UsePreviewLabel FileChooserUsePreviewLabelPropertyInfo , constructFileChooserUsePreviewLabel , getFileChooserUsePreviewLabel , setFileChooserUsePreviewLabel , -- * Signals -- ** ConfirmOverwrite FileChooserConfirmOverwriteCallback , FileChooserConfirmOverwriteCallbackC , FileChooserConfirmOverwriteSignalInfo , afterFileChooserConfirmOverwrite , fileChooserConfirmOverwriteCallbackWrapper, fileChooserConfirmOverwriteClosure , mkFileChooserConfirmOverwriteCallback , noFileChooserConfirmOverwriteCallback , onFileChooserConfirmOverwrite , -- ** CurrentFolderChanged FileChooserCurrentFolderChangedCallback , FileChooserCurrentFolderChangedCallbackC, FileChooserCurrentFolderChangedSignalInfo, afterFileChooserCurrentFolderChanged , fileChooserCurrentFolderChangedCallbackWrapper, fileChooserCurrentFolderChangedClosure , mkFileChooserCurrentFolderChangedCallback, noFileChooserCurrentFolderChangedCallback, onFileChooserCurrentFolderChanged , -- ** FileActivated FileChooserFileActivatedCallback , FileChooserFileActivatedCallbackC , FileChooserFileActivatedSignalInfo , afterFileChooserFileActivated , fileChooserFileActivatedCallbackWrapper , fileChooserFileActivatedClosure , mkFileChooserFileActivatedCallback , noFileChooserFileActivatedCallback , onFileChooserFileActivated , -- ** SelectionChanged FileChooserSelectionChangedCallback , FileChooserSelectionChangedCallbackC , FileChooserSelectionChangedSignalInfo , afterFileChooserSelectionChanged , fileChooserSelectionChangedCallbackWrapper, fileChooserSelectionChangedClosure , mkFileChooserSelectionChangedCallback , noFileChooserSelectionChangedCallback , onFileChooserSelectionChanged , -- ** UpdatePreview FileChooserUpdatePreviewCallback , FileChooserUpdatePreviewCallbackC , FileChooserUpdatePreviewSignalInfo , afterFileChooserUpdatePreview , fileChooserUpdatePreviewCallbackWrapper , fileChooserUpdatePreviewClosure , mkFileChooserUpdatePreviewCallback , noFileChooserUpdatePreviewCallback , onFileChooserUpdatePreview , ) 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.GObject as GObject import qualified GI.Gio as Gio -- interface FileChooser newtype FileChooser = FileChooser (ForeignPtr FileChooser) noFileChooser :: Maybe FileChooser noFileChooser = Nothing -- signal FileChooser::confirm-overwrite type FileChooserConfirmOverwriteCallback = IO FileChooserConfirmation noFileChooserConfirmOverwriteCallback :: Maybe FileChooserConfirmOverwriteCallback noFileChooserConfirmOverwriteCallback = Nothing type FileChooserConfirmOverwriteCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO CUInt foreign import ccall "wrapper" mkFileChooserConfirmOverwriteCallback :: FileChooserConfirmOverwriteCallbackC -> IO (FunPtr FileChooserConfirmOverwriteCallbackC) fileChooserConfirmOverwriteClosure :: FileChooserConfirmOverwriteCallback -> IO Closure fileChooserConfirmOverwriteClosure cb = newCClosure =<< mkFileChooserConfirmOverwriteCallback wrapped where wrapped = fileChooserConfirmOverwriteCallbackWrapper cb fileChooserConfirmOverwriteCallbackWrapper :: FileChooserConfirmOverwriteCallback -> Ptr () -> Ptr () -> IO CUInt fileChooserConfirmOverwriteCallbackWrapper _cb _ _ = do result <- _cb let result' = (fromIntegral . fromEnum) result return result' onFileChooserConfirmOverwrite :: (GObject a, MonadIO m) => a -> FileChooserConfirmOverwriteCallback -> m SignalHandlerId onFileChooserConfirmOverwrite obj cb = liftIO $ connectFileChooserConfirmOverwrite obj cb SignalConnectBefore afterFileChooserConfirmOverwrite :: (GObject a, MonadIO m) => a -> FileChooserConfirmOverwriteCallback -> m SignalHandlerId afterFileChooserConfirmOverwrite obj cb = connectFileChooserConfirmOverwrite obj cb SignalConnectAfter connectFileChooserConfirmOverwrite :: (GObject a, MonadIO m) => a -> FileChooserConfirmOverwriteCallback -> SignalConnectMode -> m SignalHandlerId connectFileChooserConfirmOverwrite obj cb after = liftIO $ do cb' <- mkFileChooserConfirmOverwriteCallback (fileChooserConfirmOverwriteCallbackWrapper cb) connectSignalFunPtr obj "confirm-overwrite" cb' after -- signal FileChooser::current-folder-changed type FileChooserCurrentFolderChangedCallback = IO () noFileChooserCurrentFolderChangedCallback :: Maybe FileChooserCurrentFolderChangedCallback noFileChooserCurrentFolderChangedCallback = Nothing type FileChooserCurrentFolderChangedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkFileChooserCurrentFolderChangedCallback :: FileChooserCurrentFolderChangedCallbackC -> IO (FunPtr FileChooserCurrentFolderChangedCallbackC) fileChooserCurrentFolderChangedClosure :: FileChooserCurrentFolderChangedCallback -> IO Closure fileChooserCurrentFolderChangedClosure cb = newCClosure =<< mkFileChooserCurrentFolderChangedCallback wrapped where wrapped = fileChooserCurrentFolderChangedCallbackWrapper cb fileChooserCurrentFolderChangedCallbackWrapper :: FileChooserCurrentFolderChangedCallback -> Ptr () -> Ptr () -> IO () fileChooserCurrentFolderChangedCallbackWrapper _cb _ _ = do _cb onFileChooserCurrentFolderChanged :: (GObject a, MonadIO m) => a -> FileChooserCurrentFolderChangedCallback -> m SignalHandlerId onFileChooserCurrentFolderChanged obj cb = liftIO $ connectFileChooserCurrentFolderChanged obj cb SignalConnectBefore afterFileChooserCurrentFolderChanged :: (GObject a, MonadIO m) => a -> FileChooserCurrentFolderChangedCallback -> m SignalHandlerId afterFileChooserCurrentFolderChanged obj cb = connectFileChooserCurrentFolderChanged obj cb SignalConnectAfter connectFileChooserCurrentFolderChanged :: (GObject a, MonadIO m) => a -> FileChooserCurrentFolderChangedCallback -> SignalConnectMode -> m SignalHandlerId connectFileChooserCurrentFolderChanged obj cb after = liftIO $ do cb' <- mkFileChooserCurrentFolderChangedCallback (fileChooserCurrentFolderChangedCallbackWrapper cb) connectSignalFunPtr obj "current-folder-changed" cb' after -- signal FileChooser::file-activated type FileChooserFileActivatedCallback = IO () noFileChooserFileActivatedCallback :: Maybe FileChooserFileActivatedCallback noFileChooserFileActivatedCallback = Nothing type FileChooserFileActivatedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkFileChooserFileActivatedCallback :: FileChooserFileActivatedCallbackC -> IO (FunPtr FileChooserFileActivatedCallbackC) fileChooserFileActivatedClosure :: FileChooserFileActivatedCallback -> IO Closure fileChooserFileActivatedClosure cb = newCClosure =<< mkFileChooserFileActivatedCallback wrapped where wrapped = fileChooserFileActivatedCallbackWrapper cb fileChooserFileActivatedCallbackWrapper :: FileChooserFileActivatedCallback -> Ptr () -> Ptr () -> IO () fileChooserFileActivatedCallbackWrapper _cb _ _ = do _cb onFileChooserFileActivated :: (GObject a, MonadIO m) => a -> FileChooserFileActivatedCallback -> m SignalHandlerId onFileChooserFileActivated obj cb = liftIO $ connectFileChooserFileActivated obj cb SignalConnectBefore afterFileChooserFileActivated :: (GObject a, MonadIO m) => a -> FileChooserFileActivatedCallback -> m SignalHandlerId afterFileChooserFileActivated obj cb = connectFileChooserFileActivated obj cb SignalConnectAfter connectFileChooserFileActivated :: (GObject a, MonadIO m) => a -> FileChooserFileActivatedCallback -> SignalConnectMode -> m SignalHandlerId connectFileChooserFileActivated obj cb after = liftIO $ do cb' <- mkFileChooserFileActivatedCallback (fileChooserFileActivatedCallbackWrapper cb) connectSignalFunPtr obj "file-activated" cb' after -- signal FileChooser::selection-changed type FileChooserSelectionChangedCallback = IO () noFileChooserSelectionChangedCallback :: Maybe FileChooserSelectionChangedCallback noFileChooserSelectionChangedCallback = Nothing type FileChooserSelectionChangedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkFileChooserSelectionChangedCallback :: FileChooserSelectionChangedCallbackC -> IO (FunPtr FileChooserSelectionChangedCallbackC) fileChooserSelectionChangedClosure :: FileChooserSelectionChangedCallback -> IO Closure fileChooserSelectionChangedClosure cb = newCClosure =<< mkFileChooserSelectionChangedCallback wrapped where wrapped = fileChooserSelectionChangedCallbackWrapper cb fileChooserSelectionChangedCallbackWrapper :: FileChooserSelectionChangedCallback -> Ptr () -> Ptr () -> IO () fileChooserSelectionChangedCallbackWrapper _cb _ _ = do _cb onFileChooserSelectionChanged :: (GObject a, MonadIO m) => a -> FileChooserSelectionChangedCallback -> m SignalHandlerId onFileChooserSelectionChanged obj cb = liftIO $ connectFileChooserSelectionChanged obj cb SignalConnectBefore afterFileChooserSelectionChanged :: (GObject a, MonadIO m) => a -> FileChooserSelectionChangedCallback -> m SignalHandlerId afterFileChooserSelectionChanged obj cb = connectFileChooserSelectionChanged obj cb SignalConnectAfter connectFileChooserSelectionChanged :: (GObject a, MonadIO m) => a -> FileChooserSelectionChangedCallback -> SignalConnectMode -> m SignalHandlerId connectFileChooserSelectionChanged obj cb after = liftIO $ do cb' <- mkFileChooserSelectionChangedCallback (fileChooserSelectionChangedCallbackWrapper cb) connectSignalFunPtr obj "selection-changed" cb' after -- signal FileChooser::update-preview type FileChooserUpdatePreviewCallback = IO () noFileChooserUpdatePreviewCallback :: Maybe FileChooserUpdatePreviewCallback noFileChooserUpdatePreviewCallback = Nothing type FileChooserUpdatePreviewCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkFileChooserUpdatePreviewCallback :: FileChooserUpdatePreviewCallbackC -> IO (FunPtr FileChooserUpdatePreviewCallbackC) fileChooserUpdatePreviewClosure :: FileChooserUpdatePreviewCallback -> IO Closure fileChooserUpdatePreviewClosure cb = newCClosure =<< mkFileChooserUpdatePreviewCallback wrapped where wrapped = fileChooserUpdatePreviewCallbackWrapper cb fileChooserUpdatePreviewCallbackWrapper :: FileChooserUpdatePreviewCallback -> Ptr () -> Ptr () -> IO () fileChooserUpdatePreviewCallbackWrapper _cb _ _ = do _cb onFileChooserUpdatePreview :: (GObject a, MonadIO m) => a -> FileChooserUpdatePreviewCallback -> m SignalHandlerId onFileChooserUpdatePreview obj cb = liftIO $ connectFileChooserUpdatePreview obj cb SignalConnectBefore afterFileChooserUpdatePreview :: (GObject a, MonadIO m) => a -> FileChooserUpdatePreviewCallback -> m SignalHandlerId afterFileChooserUpdatePreview obj cb = connectFileChooserUpdatePreview obj cb SignalConnectAfter connectFileChooserUpdatePreview :: (GObject a, MonadIO m) => a -> FileChooserUpdatePreviewCallback -> SignalConnectMode -> m SignalHandlerId connectFileChooserUpdatePreview obj cb after = liftIO $ do cb' <- mkFileChooserUpdatePreviewCallback (fileChooserUpdatePreviewCallbackWrapper cb) connectSignalFunPtr obj "update-preview" cb' after -- VVV Prop "action" -- Type: TInterface "Gtk" "FileChooserAction" -- Flags: [PropertyReadable,PropertyWritable] getFileChooserAction :: (MonadIO m, FileChooserK o) => o -> m FileChooserAction getFileChooserAction obj = liftIO $ getObjectPropertyEnum obj "action" setFileChooserAction :: (MonadIO m, FileChooserK o) => o -> FileChooserAction -> m () setFileChooserAction obj val = liftIO $ setObjectPropertyEnum obj "action" val constructFileChooserAction :: FileChooserAction -> IO ([Char], GValue) constructFileChooserAction val = constructObjectPropertyEnum "action" val data FileChooserActionPropertyInfo instance AttrInfo FileChooserActionPropertyInfo where type AttrAllowedOps FileChooserActionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserActionPropertyInfo = (~) FileChooserAction type AttrBaseTypeConstraint FileChooserActionPropertyInfo = FileChooserK type AttrGetType FileChooserActionPropertyInfo = FileChooserAction type AttrLabel FileChooserActionPropertyInfo = "FileChooser::action" attrGet _ = getFileChooserAction attrSet _ = setFileChooserAction attrConstruct _ = constructFileChooserAction -- VVV Prop "create-folders" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserCreateFolders :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserCreateFolders obj = liftIO $ getObjectPropertyBool obj "create-folders" setFileChooserCreateFolders :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserCreateFolders obj val = liftIO $ setObjectPropertyBool obj "create-folders" val constructFileChooserCreateFolders :: Bool -> IO ([Char], GValue) constructFileChooserCreateFolders val = constructObjectPropertyBool "create-folders" val data FileChooserCreateFoldersPropertyInfo instance AttrInfo FileChooserCreateFoldersPropertyInfo where type AttrAllowedOps FileChooserCreateFoldersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserCreateFoldersPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserCreateFoldersPropertyInfo = FileChooserK type AttrGetType FileChooserCreateFoldersPropertyInfo = Bool type AttrLabel FileChooserCreateFoldersPropertyInfo = "FileChooser::create-folders" attrGet _ = getFileChooserCreateFolders attrSet _ = setFileChooserCreateFolders attrConstruct _ = constructFileChooserCreateFolders -- VVV Prop "do-overwrite-confirmation" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserDoOverwriteConfirmation :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserDoOverwriteConfirmation obj = liftIO $ getObjectPropertyBool obj "do-overwrite-confirmation" setFileChooserDoOverwriteConfirmation :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserDoOverwriteConfirmation obj val = liftIO $ setObjectPropertyBool obj "do-overwrite-confirmation" val constructFileChooserDoOverwriteConfirmation :: Bool -> IO ([Char], GValue) constructFileChooserDoOverwriteConfirmation val = constructObjectPropertyBool "do-overwrite-confirmation" val data FileChooserDoOverwriteConfirmationPropertyInfo instance AttrInfo FileChooserDoOverwriteConfirmationPropertyInfo where type AttrAllowedOps FileChooserDoOverwriteConfirmationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserDoOverwriteConfirmationPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserDoOverwriteConfirmationPropertyInfo = FileChooserK type AttrGetType FileChooserDoOverwriteConfirmationPropertyInfo = Bool type AttrLabel FileChooserDoOverwriteConfirmationPropertyInfo = "FileChooser::do-overwrite-confirmation" attrGet _ = getFileChooserDoOverwriteConfirmation attrSet _ = setFileChooserDoOverwriteConfirmation attrConstruct _ = constructFileChooserDoOverwriteConfirmation -- VVV Prop "extra-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getFileChooserExtraWidget :: (MonadIO m, FileChooserK o) => o -> m Widget getFileChooserExtraWidget obj = liftIO $ getObjectPropertyObject obj "extra-widget" Widget setFileChooserExtraWidget :: (MonadIO m, FileChooserK o, WidgetK a) => o -> a -> m () setFileChooserExtraWidget obj val = liftIO $ setObjectPropertyObject obj "extra-widget" val constructFileChooserExtraWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructFileChooserExtraWidget val = constructObjectPropertyObject "extra-widget" val data FileChooserExtraWidgetPropertyInfo instance AttrInfo FileChooserExtraWidgetPropertyInfo where type AttrAllowedOps FileChooserExtraWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserExtraWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint FileChooserExtraWidgetPropertyInfo = FileChooserK type AttrGetType FileChooserExtraWidgetPropertyInfo = Widget type AttrLabel FileChooserExtraWidgetPropertyInfo = "FileChooser::extra-widget" attrGet _ = getFileChooserExtraWidget attrSet _ = setFileChooserExtraWidget attrConstruct _ = constructFileChooserExtraWidget -- VVV Prop "filter" -- Type: TInterface "Gtk" "FileFilter" -- Flags: [PropertyReadable,PropertyWritable] getFileChooserFilter :: (MonadIO m, FileChooserK o) => o -> m FileFilter getFileChooserFilter obj = liftIO $ getObjectPropertyObject obj "filter" FileFilter setFileChooserFilter :: (MonadIO m, FileChooserK o, FileFilterK a) => o -> a -> m () setFileChooserFilter obj val = liftIO $ setObjectPropertyObject obj "filter" val constructFileChooserFilter :: (FileFilterK a) => a -> IO ([Char], GValue) constructFileChooserFilter val = constructObjectPropertyObject "filter" val data FileChooserFilterPropertyInfo instance AttrInfo FileChooserFilterPropertyInfo where type AttrAllowedOps FileChooserFilterPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserFilterPropertyInfo = FileFilterK type AttrBaseTypeConstraint FileChooserFilterPropertyInfo = FileChooserK type AttrGetType FileChooserFilterPropertyInfo = FileFilter type AttrLabel FileChooserFilterPropertyInfo = "FileChooser::filter" attrGet _ = getFileChooserFilter attrSet _ = setFileChooserFilter attrConstruct _ = constructFileChooserFilter -- VVV Prop "local-only" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserLocalOnly :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserLocalOnly obj = liftIO $ getObjectPropertyBool obj "local-only" setFileChooserLocalOnly :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserLocalOnly obj val = liftIO $ setObjectPropertyBool obj "local-only" val constructFileChooserLocalOnly :: Bool -> IO ([Char], GValue) constructFileChooserLocalOnly val = constructObjectPropertyBool "local-only" val data FileChooserLocalOnlyPropertyInfo instance AttrInfo FileChooserLocalOnlyPropertyInfo where type AttrAllowedOps FileChooserLocalOnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserLocalOnlyPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserLocalOnlyPropertyInfo = FileChooserK type AttrGetType FileChooserLocalOnlyPropertyInfo = Bool type AttrLabel FileChooserLocalOnlyPropertyInfo = "FileChooser::local-only" attrGet _ = getFileChooserLocalOnly attrSet _ = setFileChooserLocalOnly attrConstruct _ = constructFileChooserLocalOnly -- VVV Prop "preview-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getFileChooserPreviewWidget :: (MonadIO m, FileChooserK o) => o -> m Widget getFileChooserPreviewWidget obj = liftIO $ getObjectPropertyObject obj "preview-widget" Widget setFileChooserPreviewWidget :: (MonadIO m, FileChooserK o, WidgetK a) => o -> a -> m () setFileChooserPreviewWidget obj val = liftIO $ setObjectPropertyObject obj "preview-widget" val constructFileChooserPreviewWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructFileChooserPreviewWidget val = constructObjectPropertyObject "preview-widget" val data FileChooserPreviewWidgetPropertyInfo instance AttrInfo FileChooserPreviewWidgetPropertyInfo where type AttrAllowedOps FileChooserPreviewWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserPreviewWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint FileChooserPreviewWidgetPropertyInfo = FileChooserK type AttrGetType FileChooserPreviewWidgetPropertyInfo = Widget type AttrLabel FileChooserPreviewWidgetPropertyInfo = "FileChooser::preview-widget" attrGet _ = getFileChooserPreviewWidget attrSet _ = setFileChooserPreviewWidget attrConstruct _ = constructFileChooserPreviewWidget -- VVV Prop "preview-widget-active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserPreviewWidgetActive :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserPreviewWidgetActive obj = liftIO $ getObjectPropertyBool obj "preview-widget-active" setFileChooserPreviewWidgetActive :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserPreviewWidgetActive obj val = liftIO $ setObjectPropertyBool obj "preview-widget-active" val constructFileChooserPreviewWidgetActive :: Bool -> IO ([Char], GValue) constructFileChooserPreviewWidgetActive val = constructObjectPropertyBool "preview-widget-active" val data FileChooserPreviewWidgetActivePropertyInfo instance AttrInfo FileChooserPreviewWidgetActivePropertyInfo where type AttrAllowedOps FileChooserPreviewWidgetActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserPreviewWidgetActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserPreviewWidgetActivePropertyInfo = FileChooserK type AttrGetType FileChooserPreviewWidgetActivePropertyInfo = Bool type AttrLabel FileChooserPreviewWidgetActivePropertyInfo = "FileChooser::preview-widget-active" attrGet _ = getFileChooserPreviewWidgetActive attrSet _ = setFileChooserPreviewWidgetActive attrConstruct _ = constructFileChooserPreviewWidgetActive -- VVV Prop "select-multiple" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserSelectMultiple :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserSelectMultiple obj = liftIO $ getObjectPropertyBool obj "select-multiple" setFileChooserSelectMultiple :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserSelectMultiple obj val = liftIO $ setObjectPropertyBool obj "select-multiple" val constructFileChooserSelectMultiple :: Bool -> IO ([Char], GValue) constructFileChooserSelectMultiple val = constructObjectPropertyBool "select-multiple" val data FileChooserSelectMultiplePropertyInfo instance AttrInfo FileChooserSelectMultiplePropertyInfo where type AttrAllowedOps FileChooserSelectMultiplePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserSelectMultiplePropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserSelectMultiplePropertyInfo = FileChooserK type AttrGetType FileChooserSelectMultiplePropertyInfo = Bool type AttrLabel FileChooserSelectMultiplePropertyInfo = "FileChooser::select-multiple" attrGet _ = getFileChooserSelectMultiple attrSet _ = setFileChooserSelectMultiple attrConstruct _ = constructFileChooserSelectMultiple -- VVV Prop "show-hidden" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserShowHidden :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserShowHidden obj = liftIO $ getObjectPropertyBool obj "show-hidden" setFileChooserShowHidden :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserShowHidden obj val = liftIO $ setObjectPropertyBool obj "show-hidden" val constructFileChooserShowHidden :: Bool -> IO ([Char], GValue) constructFileChooserShowHidden val = constructObjectPropertyBool "show-hidden" val data FileChooserShowHiddenPropertyInfo instance AttrInfo FileChooserShowHiddenPropertyInfo where type AttrAllowedOps FileChooserShowHiddenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserShowHiddenPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserShowHiddenPropertyInfo = FileChooserK type AttrGetType FileChooserShowHiddenPropertyInfo = Bool type AttrLabel FileChooserShowHiddenPropertyInfo = "FileChooser::show-hidden" attrGet _ = getFileChooserShowHidden attrSet _ = setFileChooserShowHidden attrConstruct _ = constructFileChooserShowHidden -- VVV Prop "use-preview-label" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserUsePreviewLabel :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserUsePreviewLabel obj = liftIO $ getObjectPropertyBool obj "use-preview-label" setFileChooserUsePreviewLabel :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserUsePreviewLabel obj val = liftIO $ setObjectPropertyBool obj "use-preview-label" val constructFileChooserUsePreviewLabel :: Bool -> IO ([Char], GValue) constructFileChooserUsePreviewLabel val = constructObjectPropertyBool "use-preview-label" val data FileChooserUsePreviewLabelPropertyInfo instance AttrInfo FileChooserUsePreviewLabelPropertyInfo where type AttrAllowedOps FileChooserUsePreviewLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserUsePreviewLabelPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserUsePreviewLabelPropertyInfo = FileChooserK type AttrGetType FileChooserUsePreviewLabelPropertyInfo = Bool type AttrLabel FileChooserUsePreviewLabelPropertyInfo = "FileChooser::use-preview-label" attrGet _ = getFileChooserUsePreviewLabel attrSet _ = setFileChooserUsePreviewLabel attrConstruct _ = constructFileChooserUsePreviewLabel type instance AttributeList FileChooser = FileChooserAttributeList type FileChooserAttributeList = ('[ '("action", FileChooserActionPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("create-folders", FileChooserCreateFoldersPropertyInfo), '("do-overwrite-confirmation", FileChooserDoOverwriteConfirmationPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("extra-widget", FileChooserExtraWidgetPropertyInfo), '("filter", FileChooserFilterPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("local-only", FileChooserLocalOnlyPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("preview-widget", FileChooserPreviewWidgetPropertyInfo), '("preview-widget-active", FileChooserPreviewWidgetActivePropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("select-multiple", FileChooserSelectMultiplePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-hidden", FileChooserShowHiddenPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-preview-label", FileChooserUsePreviewLabelPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] :: [(Symbol, *)]) data FileChooserConfirmOverwriteSignalInfo instance SignalInfo FileChooserConfirmOverwriteSignalInfo where type HaskellCallbackType FileChooserConfirmOverwriteSignalInfo = FileChooserConfirmOverwriteCallback connectSignal _ = connectFileChooserConfirmOverwrite data FileChooserCurrentFolderChangedSignalInfo instance SignalInfo FileChooserCurrentFolderChangedSignalInfo where type HaskellCallbackType FileChooserCurrentFolderChangedSignalInfo = FileChooserCurrentFolderChangedCallback connectSignal _ = connectFileChooserCurrentFolderChanged data FileChooserFileActivatedSignalInfo instance SignalInfo FileChooserFileActivatedSignalInfo where type HaskellCallbackType FileChooserFileActivatedSignalInfo = FileChooserFileActivatedCallback connectSignal _ = connectFileChooserFileActivated data FileChooserSelectionChangedSignalInfo instance SignalInfo FileChooserSelectionChangedSignalInfo where type HaskellCallbackType FileChooserSelectionChangedSignalInfo = FileChooserSelectionChangedCallback connectSignal _ = connectFileChooserSelectionChanged data FileChooserUpdatePreviewSignalInfo instance SignalInfo FileChooserUpdatePreviewSignalInfo where type HaskellCallbackType FileChooserUpdatePreviewSignalInfo = FileChooserUpdatePreviewCallback connectSignal _ = connectFileChooserUpdatePreview type instance SignalList FileChooser = FileChooserSignalList type FileChooserSignalList = ('[ '("accel-closures-changed", WidgetAccelClosuresChangedSignalInfo), '("button-press-event", WidgetButtonPressEventSignalInfo), '("button-release-event", WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", WidgetCanActivateAccelSignalInfo), '("child-notify", WidgetChildNotifySignalInfo), '("composited-changed", WidgetCompositedChangedSignalInfo), '("configure-event", WidgetConfigureEventSignalInfo), '("confirm-overwrite", FileChooserConfirmOverwriteSignalInfo), '("current-folder-changed", FileChooserCurrentFolderChangedSignalInfo), '("damage-event", WidgetDamageEventSignalInfo), '("delete-event", WidgetDeleteEventSignalInfo), '("destroy", WidgetDestroySignalInfo), '("destroy-event", WidgetDestroyEventSignalInfo), '("direction-changed", WidgetDirectionChangedSignalInfo), '("drag-begin", WidgetDragBeginSignalInfo), '("drag-data-delete", WidgetDragDataDeleteSignalInfo), '("drag-data-get", WidgetDragDataGetSignalInfo), '("drag-data-received", WidgetDragDataReceivedSignalInfo), '("drag-drop", WidgetDragDropSignalInfo), '("drag-end", WidgetDragEndSignalInfo), '("drag-failed", WidgetDragFailedSignalInfo), '("drag-leave", WidgetDragLeaveSignalInfo), '("drag-motion", WidgetDragMotionSignalInfo), '("draw", WidgetDrawSignalInfo), '("enter-notify-event", WidgetEnterNotifyEventSignalInfo), '("event", WidgetEventSignalInfo), '("event-after", WidgetEventAfterSignalInfo), '("file-activated", FileChooserFileActivatedSignalInfo), '("focus", WidgetFocusSignalInfo), '("focus-in-event", WidgetFocusInEventSignalInfo), '("focus-out-event", WidgetFocusOutEventSignalInfo), '("grab-broken-event", WidgetGrabBrokenEventSignalInfo), '("grab-focus", WidgetGrabFocusSignalInfo), '("grab-notify", WidgetGrabNotifySignalInfo), '("hide", WidgetHideSignalInfo), '("hierarchy-changed", WidgetHierarchyChangedSignalInfo), '("key-press-event", WidgetKeyPressEventSignalInfo), '("key-release-event", WidgetKeyReleaseEventSignalInfo), '("keynav-failed", WidgetKeynavFailedSignalInfo), '("leave-notify-event", WidgetLeaveNotifyEventSignalInfo), '("map", WidgetMapSignalInfo), '("map-event", WidgetMapEventSignalInfo), '("mnemonic-activate", WidgetMnemonicActivateSignalInfo), '("motion-notify-event", WidgetMotionNotifyEventSignalInfo), '("move-focus", WidgetMoveFocusSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("parent-set", WidgetParentSetSignalInfo), '("popup-menu", WidgetPopupMenuSignalInfo), '("property-notify-event", WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", WidgetProximityInEventSignalInfo), '("proximity-out-event", WidgetProximityOutEventSignalInfo), '("query-tooltip", WidgetQueryTooltipSignalInfo), '("realize", WidgetRealizeSignalInfo), '("screen-changed", WidgetScreenChangedSignalInfo), '("scroll-event", WidgetScrollEventSignalInfo), '("selection-changed", FileChooserSelectionChangedSignalInfo), '("selection-clear-event", WidgetSelectionClearEventSignalInfo), '("selection-get", WidgetSelectionGetSignalInfo), '("selection-notify-event", WidgetSelectionNotifyEventSignalInfo), '("selection-received", WidgetSelectionReceivedSignalInfo), '("selection-request-event", WidgetSelectionRequestEventSignalInfo), '("show", WidgetShowSignalInfo), '("show-help", WidgetShowHelpSignalInfo), '("size-allocate", WidgetSizeAllocateSignalInfo), '("state-changed", WidgetStateChangedSignalInfo), '("state-flags-changed", WidgetStateFlagsChangedSignalInfo), '("style-set", WidgetStyleSetSignalInfo), '("style-updated", WidgetStyleUpdatedSignalInfo), '("touch-event", WidgetTouchEventSignalInfo), '("unmap", WidgetUnmapSignalInfo), '("unmap-event", WidgetUnmapEventSignalInfo), '("unrealize", WidgetUnrealizeSignalInfo), '("update-preview", FileChooserUpdatePreviewSignalInfo), '("visibility-notify-event", WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", WidgetWindowStateEventSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)]) foreign import ccall "gtk_file_chooser_get_type" c_gtk_file_chooser_get_type :: IO GType type instance ParentTypes FileChooser = FileChooserParentTypes type FileChooserParentTypes = '[Widget, GObject.Object] instance GObject FileChooser where gobjectIsInitiallyUnowned _ = True gobjectType _ = c_gtk_file_chooser_get_type class GObject o => FileChooserK o instance (GObject o, IsDescendantOf FileChooser o) => FileChooserK o toFileChooser :: FileChooserK o => o -> IO FileChooser toFileChooser = unsafeCastTo FileChooser -- method FileChooser::add_filter -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter", argType = TInterface "Gtk" "FileFilter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter", argType = TInterface "Gtk" "FileFilter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_add_filter" gtk_file_chooser_add_filter :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" Ptr FileFilter -> -- filter : TInterface "Gtk" "FileFilter" IO () fileChooserAddFilter :: (MonadIO m, FileChooserK a, FileFilterK b) => a -> -- _obj b -> -- filter m () fileChooserAddFilter _obj filter = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj filter' <- refObject filter gtk_file_chooser_add_filter _obj' filter' touchManagedPtr _obj touchManagedPtr filter return () -- method FileChooser::add_shortcut_folder -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "folder", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "folder", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "gtk_file_chooser_add_shortcut_folder" gtk_file_chooser_add_shortcut_folder :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- folder : TBasicType TFileName Ptr (Ptr GError) -> -- error IO CInt fileChooserAddShortcutFolder :: (MonadIO m, FileChooserK a) => a -> -- _obj [Char] -> -- folder m () fileChooserAddShortcutFolder _obj folder = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj folder' <- stringToCString folder onException (do _ <- propagateGError $ gtk_file_chooser_add_shortcut_folder _obj' folder' touchManagedPtr _obj freeMem folder' return () ) (do freeMem folder' ) -- method FileChooser::add_shortcut_folder_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "gtk_file_chooser_add_shortcut_folder_uri" gtk_file_chooser_add_shortcut_folder_uri :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt fileChooserAddShortcutFolderUri :: (MonadIO m, FileChooserK a) => a -> -- _obj T.Text -> -- uri m () fileChooserAddShortcutFolderUri _obj uri = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri onException (do _ <- propagateGError $ gtk_file_chooser_add_shortcut_folder_uri _obj' uri' touchManagedPtr _obj freeMem uri' return () ) (do freeMem uri' ) -- method FileChooser::get_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gtk" "FileChooserAction" -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_action" gtk_file_chooser_get_action :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CUInt fileChooserGetAction :: (MonadIO m, FileChooserK a) => a -> -- _obj m FileChooserAction fileChooserGetAction _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_action _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method FileChooser::get_create_folders -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_create_folders" gtk_file_chooser_get_create_folders :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CInt fileChooserGetCreateFolders :: (MonadIO m, FileChooserK a) => a -> -- _obj m Bool fileChooserGetCreateFolders _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_create_folders _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileChooser::get_current_folder -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TFileName -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_current_folder" gtk_file_chooser_get_current_folder :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CString fileChooserGetCurrentFolder :: (MonadIO m, FileChooserK a) => a -> -- _obj m [Char] fileChooserGetCurrentFolder _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_current_folder _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_current_folder" result result' <- cstringToString result freeMem result touchManagedPtr _obj return result' -- method FileChooser::get_current_folder_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_current_folder_file" gtk_file_chooser_get_current_folder_file :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr Gio.File) fileChooserGetCurrentFolderFile :: (MonadIO m, FileChooserK a) => a -> -- _obj m Gio.File fileChooserGetCurrentFolderFile _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_current_folder_file _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_current_folder_file" result result' <- (wrapObject Gio.File) result touchManagedPtr _obj return result' -- method FileChooser::get_current_folder_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_current_folder_uri" gtk_file_chooser_get_current_folder_uri :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CString fileChooserGetCurrentFolderUri :: (MonadIO m, FileChooserK a) => a -> -- _obj m T.Text fileChooserGetCurrentFolderUri _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_current_folder_uri _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_current_folder_uri" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method FileChooser::get_current_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_current_name" gtk_file_chooser_get_current_name :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CString fileChooserGetCurrentName :: (MonadIO m, FileChooserK a) => a -> -- _obj m T.Text fileChooserGetCurrentName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_current_name _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_current_name" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method FileChooser::get_do_overwrite_confirmation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_do_overwrite_confirmation" gtk_file_chooser_get_do_overwrite_confirmation :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CInt fileChooserGetDoOverwriteConfirmation :: (MonadIO m, FileChooserK a) => a -> -- _obj m Bool fileChooserGetDoOverwriteConfirmation _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_do_overwrite_confirmation _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileChooser::get_extra_widget -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gtk" "Widget" -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_extra_widget" gtk_file_chooser_get_extra_widget :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr Widget) fileChooserGetExtraWidget :: (MonadIO m, FileChooserK a) => a -> -- _obj m Widget fileChooserGetExtraWidget _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_extra_widget _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_extra_widget" result result' <- (newObject Widget) result touchManagedPtr _obj return result' -- method FileChooser::get_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_file" gtk_file_chooser_get_file :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr Gio.File) fileChooserGetFile :: (MonadIO m, FileChooserK a) => a -> -- _obj m Gio.File fileChooserGetFile _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_file _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_file" result result' <- (wrapObject Gio.File) result touchManagedPtr _obj return result' -- method FileChooser::get_filename -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TFileName -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_filename" gtk_file_chooser_get_filename :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CString fileChooserGetFilename :: (MonadIO m, FileChooserK a) => a -> -- _obj m [Char] fileChooserGetFilename _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_filename _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_filename" result result' <- cstringToString result freeMem result touchManagedPtr _obj return result' -- method FileChooser::get_filenames -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGSList (TBasicType TFileName) -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_filenames" gtk_file_chooser_get_filenames :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr (GSList CString)) fileChooserGetFilenames :: (MonadIO m, FileChooserK a) => a -> -- _obj m [[Char]] fileChooserGetFilenames _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_filenames _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_filenames" result result' <- unpackGSList result result'' <- mapM cstringToString result' mapGSList freeMem result g_slist_free result touchManagedPtr _obj return result'' -- method FileChooser::get_files -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGSList (TInterface "Gio" "File") -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_files" gtk_file_chooser_get_files :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr (GSList (Ptr Gio.File))) fileChooserGetFiles :: (MonadIO m, FileChooserK a) => a -> -- _obj m [Gio.File] fileChooserGetFiles _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_files _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_files" result result' <- unpackGSList result result'' <- mapM (wrapObject Gio.File) result' g_slist_free result touchManagedPtr _obj return result'' -- method FileChooser::get_filter -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gtk" "FileFilter" -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_filter" gtk_file_chooser_get_filter :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr FileFilter) fileChooserGetFilter :: (MonadIO m, FileChooserK a) => a -> -- _obj m FileFilter fileChooserGetFilter _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_filter _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_filter" result result' <- (newObject FileFilter) result touchManagedPtr _obj return result' -- method FileChooser::get_local_only -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_local_only" gtk_file_chooser_get_local_only :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CInt fileChooserGetLocalOnly :: (MonadIO m, FileChooserK a) => a -> -- _obj m Bool fileChooserGetLocalOnly _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_local_only _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileChooser::get_preview_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_preview_file" gtk_file_chooser_get_preview_file :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr Gio.File) fileChooserGetPreviewFile :: (MonadIO m, FileChooserK a) => a -> -- _obj m Gio.File fileChooserGetPreviewFile _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_preview_file _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_preview_file" result result' <- (wrapObject Gio.File) result touchManagedPtr _obj return result' -- method FileChooser::get_preview_filename -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TFileName -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_preview_filename" gtk_file_chooser_get_preview_filename :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CString fileChooserGetPreviewFilename :: (MonadIO m, FileChooserK a) => a -> -- _obj m [Char] fileChooserGetPreviewFilename _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_preview_filename _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_preview_filename" result result' <- cstringToString result freeMem result touchManagedPtr _obj return result' -- method FileChooser::get_preview_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_preview_uri" gtk_file_chooser_get_preview_uri :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CString fileChooserGetPreviewUri :: (MonadIO m, FileChooserK a) => a -> -- _obj m T.Text fileChooserGetPreviewUri _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_preview_uri _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_preview_uri" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method FileChooser::get_preview_widget -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gtk" "Widget" -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_preview_widget" gtk_file_chooser_get_preview_widget :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr Widget) fileChooserGetPreviewWidget :: (MonadIO m, FileChooserK a) => a -> -- _obj m Widget fileChooserGetPreviewWidget _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_preview_widget _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_preview_widget" result result' <- (newObject Widget) result touchManagedPtr _obj return result' -- method FileChooser::get_preview_widget_active -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_preview_widget_active" gtk_file_chooser_get_preview_widget_active :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CInt fileChooserGetPreviewWidgetActive :: (MonadIO m, FileChooserK a) => a -> -- _obj m Bool fileChooserGetPreviewWidgetActive _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_preview_widget_active _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileChooser::get_select_multiple -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_select_multiple" gtk_file_chooser_get_select_multiple :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CInt fileChooserGetSelectMultiple :: (MonadIO m, FileChooserK a) => a -> -- _obj m Bool fileChooserGetSelectMultiple _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_select_multiple _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileChooser::get_show_hidden -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_show_hidden" gtk_file_chooser_get_show_hidden :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CInt fileChooserGetShowHidden :: (MonadIO m, FileChooserK a) => a -> -- _obj m Bool fileChooserGetShowHidden _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_show_hidden _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileChooser::get_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_uri" gtk_file_chooser_get_uri :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CString fileChooserGetUri :: (MonadIO m, FileChooserK a) => a -> -- _obj m T.Text fileChooserGetUri _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_uri _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_uri" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method FileChooser::get_uris -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGSList (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_uris" gtk_file_chooser_get_uris :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr (GSList CString)) fileChooserGetUris :: (MonadIO m, FileChooserK a) => a -> -- _obj m [T.Text] fileChooserGetUris _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_uris _obj' checkUnexpectedReturnNULL "gtk_file_chooser_get_uris" result result' <- unpackGSList result result'' <- mapM cstringToText result' mapGSList freeMem result g_slist_free result touchManagedPtr _obj return result'' -- method FileChooser::get_use_preview_label -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_get_use_preview_label" gtk_file_chooser_get_use_preview_label :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO CInt fileChooserGetUsePreviewLabel :: (MonadIO m, FileChooserK a) => a -> -- _obj m Bool fileChooserGetUsePreviewLabel _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_get_use_preview_label _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileChooser::list_filters -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGSList (TInterface "Gtk" "FileFilter") -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_list_filters" gtk_file_chooser_list_filters :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr (GSList (Ptr FileFilter))) fileChooserListFilters :: (MonadIO m, FileChooserK a) => a -> -- _obj m [FileFilter] fileChooserListFilters _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_list_filters _obj' checkUnexpectedReturnNULL "gtk_file_chooser_list_filters" result result' <- unpackGSList result result'' <- mapM (newObject FileFilter) result' g_slist_free result touchManagedPtr _obj return result'' -- method FileChooser::list_shortcut_folder_uris -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGSList (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_list_shortcut_folder_uris" gtk_file_chooser_list_shortcut_folder_uris :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr (GSList CString)) fileChooserListShortcutFolderUris :: (MonadIO m, FileChooserK a) => a -> -- _obj m [T.Text] fileChooserListShortcutFolderUris _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_list_shortcut_folder_uris _obj' checkUnexpectedReturnNULL "gtk_file_chooser_list_shortcut_folder_uris" result result' <- unpackGSList result result'' <- mapM cstringToText result' mapGSList freeMem result g_slist_free result touchManagedPtr _obj return result'' -- method FileChooser::list_shortcut_folders -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGSList (TBasicType TFileName) -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_list_shortcut_folders" gtk_file_chooser_list_shortcut_folders :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO (Ptr (GSList CString)) fileChooserListShortcutFolders :: (MonadIO m, FileChooserK a) => a -> -- _obj m [[Char]] fileChooserListShortcutFolders _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_file_chooser_list_shortcut_folders _obj' checkUnexpectedReturnNULL "gtk_file_chooser_list_shortcut_folders" result result' <- unpackGSList result result'' <- mapM cstringToString result' mapGSList freeMem result g_slist_free result touchManagedPtr _obj return result'' -- method FileChooser::remove_filter -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter", argType = TInterface "Gtk" "FileFilter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter", argType = TInterface "Gtk" "FileFilter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_remove_filter" gtk_file_chooser_remove_filter :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" Ptr FileFilter -> -- filter : TInterface "Gtk" "FileFilter" IO () fileChooserRemoveFilter :: (MonadIO m, FileChooserK a, FileFilterK b) => a -> -- _obj b -> -- filter m () fileChooserRemoveFilter _obj filter = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let filter' = unsafeManagedPtrCastPtr filter gtk_file_chooser_remove_filter _obj' filter' touchManagedPtr _obj touchManagedPtr filter return () -- method FileChooser::remove_shortcut_folder -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "folder", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "folder", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "gtk_file_chooser_remove_shortcut_folder" gtk_file_chooser_remove_shortcut_folder :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- folder : TBasicType TFileName Ptr (Ptr GError) -> -- error IO CInt fileChooserRemoveShortcutFolder :: (MonadIO m, FileChooserK a) => a -> -- _obj [Char] -> -- folder m () fileChooserRemoveShortcutFolder _obj folder = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj folder' <- stringToCString folder onException (do _ <- propagateGError $ gtk_file_chooser_remove_shortcut_folder _obj' folder' touchManagedPtr _obj freeMem folder' return () ) (do freeMem folder' ) -- method FileChooser::remove_shortcut_folder_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "gtk_file_chooser_remove_shortcut_folder_uri" gtk_file_chooser_remove_shortcut_folder_uri :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt fileChooserRemoveShortcutFolderUri :: (MonadIO m, FileChooserK a) => a -> -- _obj T.Text -> -- uri m () fileChooserRemoveShortcutFolderUri _obj uri = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri onException (do _ <- propagateGError $ gtk_file_chooser_remove_shortcut_folder_uri _obj' uri' touchManagedPtr _obj freeMem uri' return () ) (do freeMem uri' ) -- method FileChooser::select_all -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_select_all" gtk_file_chooser_select_all :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO () fileChooserSelectAll :: (MonadIO m, FileChooserK a) => a -> -- _obj m () fileChooserSelectAll _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj gtk_file_chooser_select_all _obj' touchManagedPtr _obj return () -- method FileChooser::select_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "gtk_file_chooser_select_file" gtk_file_chooser_select_file :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" Ptr Gio.File -> -- file : TInterface "Gio" "File" Ptr (Ptr GError) -> -- error IO CInt fileChooserSelectFile :: (MonadIO m, FileChooserK a, Gio.FileK b) => a -> -- _obj b -> -- file m () fileChooserSelectFile _obj file = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let file' = unsafeManagedPtrCastPtr file onException (do _ <- propagateGError $ gtk_file_chooser_select_file _obj' file' touchManagedPtr _obj touchManagedPtr file return () ) (do return () ) -- method FileChooser::select_filename -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_select_filename" gtk_file_chooser_select_filename :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- filename : TBasicType TFileName IO CInt fileChooserSelectFilename :: (MonadIO m, FileChooserK a) => a -> -- _obj [Char] -> -- filename m Bool fileChooserSelectFilename _obj filename = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj filename' <- stringToCString filename result <- gtk_file_chooser_select_filename _obj' filename' let result' = (/= 0) result touchManagedPtr _obj freeMem filename' return result' -- method FileChooser::select_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", 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_file_chooser_select_uri" gtk_file_chooser_select_uri :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- uri : TBasicType TUTF8 IO CInt fileChooserSelectUri :: (MonadIO m, FileChooserK a) => a -> -- _obj T.Text -> -- uri m Bool fileChooserSelectUri _obj uri = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri result <- gtk_file_chooser_select_uri _obj' uri' let result' = (/= 0) result touchManagedPtr _obj freeMem uri' return result' -- method FileChooser::set_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TInterface "Gtk" "FileChooserAction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TInterface "Gtk" "FileChooserAction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_action" gtk_file_chooser_set_action :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CUInt -> -- action : TInterface "Gtk" "FileChooserAction" IO () fileChooserSetAction :: (MonadIO m, FileChooserK a) => a -> -- _obj FileChooserAction -> -- action m () fileChooserSetAction _obj action = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let action' = (fromIntegral . fromEnum) action gtk_file_chooser_set_action _obj' action' touchManagedPtr _obj return () -- method FileChooser::set_create_folders -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "create_folders", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "create_folders", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_create_folders" gtk_file_chooser_set_create_folders :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CInt -> -- create_folders : TBasicType TBoolean IO () fileChooserSetCreateFolders :: (MonadIO m, FileChooserK a) => a -> -- _obj Bool -> -- create_folders m () fileChooserSetCreateFolders _obj create_folders = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let create_folders' = (fromIntegral . fromEnum) create_folders gtk_file_chooser_set_create_folders _obj' create_folders' touchManagedPtr _obj return () -- method FileChooser::set_current_folder -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_current_folder" gtk_file_chooser_set_current_folder :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- filename : TBasicType TFileName IO CInt fileChooserSetCurrentFolder :: (MonadIO m, FileChooserK a) => a -> -- _obj [Char] -> -- filename m Bool fileChooserSetCurrentFolder _obj filename = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj filename' <- stringToCString filename result <- gtk_file_chooser_set_current_folder _obj' filename' let result' = (/= 0) result touchManagedPtr _obj freeMem filename' return result' -- method FileChooser::set_current_folder_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "gtk_file_chooser_set_current_folder_file" gtk_file_chooser_set_current_folder_file :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" Ptr Gio.File -> -- file : TInterface "Gio" "File" Ptr (Ptr GError) -> -- error IO CInt fileChooserSetCurrentFolderFile :: (MonadIO m, FileChooserK a, Gio.FileK b) => a -> -- _obj b -> -- file m () fileChooserSetCurrentFolderFile _obj file = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let file' = unsafeManagedPtrCastPtr file onException (do _ <- propagateGError $ gtk_file_chooser_set_current_folder_file _obj' file' touchManagedPtr _obj touchManagedPtr file return () ) (do return () ) -- method FileChooser::set_current_folder_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", 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_file_chooser_set_current_folder_uri" gtk_file_chooser_set_current_folder_uri :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- uri : TBasicType TUTF8 IO CInt fileChooserSetCurrentFolderUri :: (MonadIO m, FileChooserK a) => a -> -- _obj T.Text -> -- uri m Bool fileChooserSetCurrentFolderUri _obj uri = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri result <- gtk_file_chooser_set_current_folder_uri _obj' uri' let result' = (/= 0) result touchManagedPtr _obj freeMem uri' return result' -- method FileChooser::set_current_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "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_file_chooser_set_current_name" gtk_file_chooser_set_current_name :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- name : TBasicType TFileName IO () fileChooserSetCurrentName :: (MonadIO m, FileChooserK a) => a -> -- _obj [Char] -> -- name m () fileChooserSetCurrentName _obj name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name' <- stringToCString name gtk_file_chooser_set_current_name _obj' name' touchManagedPtr _obj freeMem name' return () -- method FileChooser::set_do_overwrite_confirmation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "do_overwrite_confirmation", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "do_overwrite_confirmation", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_do_overwrite_confirmation" gtk_file_chooser_set_do_overwrite_confirmation :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CInt -> -- do_overwrite_confirmation : TBasicType TBoolean IO () fileChooserSetDoOverwriteConfirmation :: (MonadIO m, FileChooserK a) => a -> -- _obj Bool -> -- do_overwrite_confirmation m () fileChooserSetDoOverwriteConfirmation _obj do_overwrite_confirmation = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let do_overwrite_confirmation' = (fromIntegral . fromEnum) do_overwrite_confirmation gtk_file_chooser_set_do_overwrite_confirmation _obj' do_overwrite_confirmation' touchManagedPtr _obj return () -- method FileChooser::set_extra_widget -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "extra_widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "extra_widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_extra_widget" gtk_file_chooser_set_extra_widget :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" Ptr Widget -> -- extra_widget : TInterface "Gtk" "Widget" IO () fileChooserSetExtraWidget :: (MonadIO m, FileChooserK a, WidgetK b) => a -> -- _obj b -> -- extra_widget m () fileChooserSetExtraWidget _obj extra_widget = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let extra_widget' = unsafeManagedPtrCastPtr extra_widget gtk_file_chooser_set_extra_widget _obj' extra_widget' touchManagedPtr _obj touchManagedPtr extra_widget return () -- method FileChooser::set_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "gtk_file_chooser_set_file" gtk_file_chooser_set_file :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" Ptr Gio.File -> -- file : TInterface "Gio" "File" Ptr (Ptr GError) -> -- error IO CInt fileChooserSetFile :: (MonadIO m, FileChooserK a, Gio.FileK b) => a -> -- _obj b -> -- file m () fileChooserSetFile _obj file = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let file' = unsafeManagedPtrCastPtr file onException (do _ <- propagateGError $ gtk_file_chooser_set_file _obj' file' touchManagedPtr _obj touchManagedPtr file return () ) (do return () ) -- method FileChooser::set_filename -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_filename" gtk_file_chooser_set_filename :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- filename : TBasicType TFileName IO CInt fileChooserSetFilename :: (MonadIO m, FileChooserK a) => a -> -- _obj [Char] -> -- filename m Bool fileChooserSetFilename _obj filename = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj filename' <- stringToCString filename result <- gtk_file_chooser_set_filename _obj' filename' let result' = (/= 0) result touchManagedPtr _obj freeMem filename' return result' -- method FileChooser::set_filter -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter", argType = TInterface "Gtk" "FileFilter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter", argType = TInterface "Gtk" "FileFilter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_filter" gtk_file_chooser_set_filter :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" Ptr FileFilter -> -- filter : TInterface "Gtk" "FileFilter" IO () fileChooserSetFilter :: (MonadIO m, FileChooserK a, FileFilterK b) => a -> -- _obj b -> -- filter m () fileChooserSetFilter _obj filter = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let filter' = unsafeManagedPtrCastPtr filter gtk_file_chooser_set_filter _obj' filter' touchManagedPtr _obj touchManagedPtr filter return () -- method FileChooser::set_local_only -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "local_only", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "local_only", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_local_only" gtk_file_chooser_set_local_only :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CInt -> -- local_only : TBasicType TBoolean IO () fileChooserSetLocalOnly :: (MonadIO m, FileChooserK a) => a -> -- _obj Bool -> -- local_only m () fileChooserSetLocalOnly _obj local_only = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let local_only' = (fromIntegral . fromEnum) local_only gtk_file_chooser_set_local_only _obj' local_only' touchManagedPtr _obj return () -- method FileChooser::set_preview_widget -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "preview_widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "preview_widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_preview_widget" gtk_file_chooser_set_preview_widget :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" Ptr Widget -> -- preview_widget : TInterface "Gtk" "Widget" IO () fileChooserSetPreviewWidget :: (MonadIO m, FileChooserK a, WidgetK b) => a -> -- _obj b -> -- preview_widget m () fileChooserSetPreviewWidget _obj preview_widget = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let preview_widget' = unsafeManagedPtrCastPtr preview_widget gtk_file_chooser_set_preview_widget _obj' preview_widget' touchManagedPtr _obj touchManagedPtr preview_widget return () -- method FileChooser::set_preview_widget_active -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "active", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "active", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_preview_widget_active" gtk_file_chooser_set_preview_widget_active :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CInt -> -- active : TBasicType TBoolean IO () fileChooserSetPreviewWidgetActive :: (MonadIO m, FileChooserK a) => a -> -- _obj Bool -> -- active m () fileChooserSetPreviewWidgetActive _obj active = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let active' = (fromIntegral . fromEnum) active gtk_file_chooser_set_preview_widget_active _obj' active' touchManagedPtr _obj return () -- method FileChooser::set_select_multiple -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "select_multiple", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "select_multiple", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_select_multiple" gtk_file_chooser_set_select_multiple :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CInt -> -- select_multiple : TBasicType TBoolean IO () fileChooserSetSelectMultiple :: (MonadIO m, FileChooserK a) => a -> -- _obj Bool -> -- select_multiple m () fileChooserSetSelectMultiple _obj select_multiple = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let select_multiple' = (fromIntegral . fromEnum) select_multiple gtk_file_chooser_set_select_multiple _obj' select_multiple' touchManagedPtr _obj return () -- method FileChooser::set_show_hidden -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_hidden", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_hidden", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_show_hidden" gtk_file_chooser_set_show_hidden :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CInt -> -- show_hidden : TBasicType TBoolean IO () fileChooserSetShowHidden :: (MonadIO m, FileChooserK a) => a -> -- _obj Bool -> -- show_hidden m () fileChooserSetShowHidden _obj show_hidden = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let show_hidden' = (fromIntegral . fromEnum) show_hidden gtk_file_chooser_set_show_hidden _obj' show_hidden' touchManagedPtr _obj return () -- method FileChooser::set_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", 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_file_chooser_set_uri" gtk_file_chooser_set_uri :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- uri : TBasicType TUTF8 IO CInt fileChooserSetUri :: (MonadIO m, FileChooserK a) => a -> -- _obj T.Text -> -- uri m Bool fileChooserSetUri _obj uri = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri result <- gtk_file_chooser_set_uri _obj' uri' let result' = (/= 0) result touchManagedPtr _obj freeMem uri' return result' -- method FileChooser::set_use_preview_label -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_label", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_label", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_set_use_preview_label" gtk_file_chooser_set_use_preview_label :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CInt -> -- use_label : TBasicType TBoolean IO () fileChooserSetUsePreviewLabel :: (MonadIO m, FileChooserK a) => a -> -- _obj Bool -> -- use_label m () fileChooserSetUsePreviewLabel _obj use_label = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let use_label' = (fromIntegral . fromEnum) use_label gtk_file_chooser_set_use_preview_label _obj' use_label' touchManagedPtr _obj return () -- method FileChooser::unselect_all -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_unselect_all" gtk_file_chooser_unselect_all :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" IO () fileChooserUnselectAll :: (MonadIO m, FileChooserK a) => a -> -- _obj m () fileChooserUnselectAll _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj gtk_file_chooser_unselect_all _obj' touchManagedPtr _obj return () -- method FileChooser::unselect_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_file_chooser_unselect_file" gtk_file_chooser_unselect_file :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" Ptr Gio.File -> -- file : TInterface "Gio" "File" IO () fileChooserUnselectFile :: (MonadIO m, FileChooserK a, Gio.FileK b) => a -> -- _obj b -> -- file m () fileChooserUnselectFile _obj file = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let file' = unsafeManagedPtrCastPtr file gtk_file_chooser_unselect_file _obj' file' touchManagedPtr _obj touchManagedPtr file return () -- method FileChooser::unselect_filename -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", 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_file_chooser_unselect_filename" gtk_file_chooser_unselect_filename :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- filename : TBasicType TFileName IO () fileChooserUnselectFilename :: (MonadIO m, FileChooserK a) => a -> -- _obj [Char] -> -- filename m () fileChooserUnselectFilename _obj filename = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj filename' <- stringToCString filename gtk_file_chooser_unselect_filename _obj' filename' touchManagedPtr _obj freeMem filename' return () -- method FileChooser::unselect_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "FileChooser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", 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_file_chooser_unselect_uri" gtk_file_chooser_unselect_uri :: Ptr FileChooser -> -- _obj : TInterface "Gtk" "FileChooser" CString -> -- uri : TBasicType TUTF8 IO () fileChooserUnselectUri :: (MonadIO m, FileChooserK a) => a -> -- _obj T.Text -> -- uri m () fileChooserUnselectUri _obj uri = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri gtk_file_chooser_unselect_uri _obj' uri' touchManagedPtr _obj freeMem uri' return ()