{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (garetxe@gmail.com) -} module GI.Gtk.Objects.PlacesSidebar ( -- * Exported types PlacesSidebar(..) , PlacesSidebarK , toPlacesSidebar , noPlacesSidebar , -- * Methods -- ** placesSidebarAddShortcut placesSidebarAddShortcut , -- ** placesSidebarGetLocalOnly placesSidebarGetLocalOnly , -- ** placesSidebarGetLocation placesSidebarGetLocation , -- ** placesSidebarGetNthBookmark placesSidebarGetNthBookmark , -- ** placesSidebarGetOpenFlags placesSidebarGetOpenFlags , -- ** placesSidebarGetShowConnectToServer placesSidebarGetShowConnectToServer , -- ** placesSidebarGetShowDesktop placesSidebarGetShowDesktop , -- ** placesSidebarGetShowEnterLocation placesSidebarGetShowEnterLocation , -- ** placesSidebarListShortcuts placesSidebarListShortcuts , -- ** placesSidebarNew placesSidebarNew , -- ** placesSidebarRemoveShortcut placesSidebarRemoveShortcut , -- ** placesSidebarSetLocalOnly placesSidebarSetLocalOnly , -- ** placesSidebarSetLocation placesSidebarSetLocation , -- ** placesSidebarSetOpenFlags placesSidebarSetOpenFlags , -- ** placesSidebarSetShowConnectToServer placesSidebarSetShowConnectToServer , -- ** placesSidebarSetShowDesktop placesSidebarSetShowDesktop , -- ** placesSidebarSetShowEnterLocation placesSidebarSetShowEnterLocation , -- * Properties -- ** LocalOnly PlacesSidebarLocalOnlyPropertyInfo , constructPlacesSidebarLocalOnly , getPlacesSidebarLocalOnly , setPlacesSidebarLocalOnly , -- ** Location PlacesSidebarLocationPropertyInfo , constructPlacesSidebarLocation , getPlacesSidebarLocation , setPlacesSidebarLocation , -- ** OpenFlags PlacesSidebarOpenFlagsPropertyInfo , constructPlacesSidebarOpenFlags , getPlacesSidebarOpenFlags , setPlacesSidebarOpenFlags , -- ** ShowConnectToServer PlacesSidebarShowConnectToServerPropertyInfo, constructPlacesSidebarShowConnectToServer, getPlacesSidebarShowConnectToServer , setPlacesSidebarShowConnectToServer , -- ** ShowDesktop PlacesSidebarShowDesktopPropertyInfo , constructPlacesSidebarShowDesktop , getPlacesSidebarShowDesktop , setPlacesSidebarShowDesktop , -- ** ShowEnterLocation PlacesSidebarShowEnterLocationPropertyInfo, constructPlacesSidebarShowEnterLocation , getPlacesSidebarShowEnterLocation , setPlacesSidebarShowEnterLocation , -- * Signals -- ** DragActionAsk PlacesSidebarDragActionAskCallback , PlacesSidebarDragActionAskCallbackC , PlacesSidebarDragActionAskSignalInfo , afterPlacesSidebarDragActionAsk , mkPlacesSidebarDragActionAskCallback , noPlacesSidebarDragActionAskCallback , onPlacesSidebarDragActionAsk , placesSidebarDragActionAskCallbackWrapper, placesSidebarDragActionAskClosure , -- ** DragActionRequested PlacesSidebarDragActionRequestedCallback, PlacesSidebarDragActionRequestedCallbackC, PlacesSidebarDragActionRequestedSignalInfo, afterPlacesSidebarDragActionRequested , mkPlacesSidebarDragActionRequestedCallback, noPlacesSidebarDragActionRequestedCallback, onPlacesSidebarDragActionRequested , placesSidebarDragActionRequestedCallbackWrapper, placesSidebarDragActionRequestedClosure , -- ** DragPerformDrop PlacesSidebarDragPerformDropCallback , PlacesSidebarDragPerformDropCallbackC , PlacesSidebarDragPerformDropSignalInfo , afterPlacesSidebarDragPerformDrop , mkPlacesSidebarDragPerformDropCallback , noPlacesSidebarDragPerformDropCallback , onPlacesSidebarDragPerformDrop , placesSidebarDragPerformDropCallbackWrapper, placesSidebarDragPerformDropClosure , -- ** OpenLocation PlacesSidebarOpenLocationCallback , PlacesSidebarOpenLocationCallbackC , PlacesSidebarOpenLocationSignalInfo , afterPlacesSidebarOpenLocation , mkPlacesSidebarOpenLocationCallback , noPlacesSidebarOpenLocationCallback , onPlacesSidebarOpenLocation , placesSidebarOpenLocationCallbackWrapper, placesSidebarOpenLocationClosure , -- ** PopulatePopup PlacesSidebarPopulatePopupCallback , PlacesSidebarPopulatePopupCallbackC , PlacesSidebarPopulatePopupSignalInfo , afterPlacesSidebarPopulatePopup , mkPlacesSidebarPopulatePopupCallback , noPlacesSidebarPopulatePopupCallback , onPlacesSidebarPopulatePopup , placesSidebarPopulatePopupCallbackWrapper, placesSidebarPopulatePopupClosure , -- ** ShowConnectToServer PlacesSidebarShowConnectToServerCallback, PlacesSidebarShowConnectToServerCallbackC, PlacesSidebarShowConnectToServerSignalInfo, afterPlacesSidebarShowConnectToServer , mkPlacesSidebarShowConnectToServerCallback, noPlacesSidebarShowConnectToServerCallback, onPlacesSidebarShowConnectToServer , placesSidebarShowConnectToServerCallbackWrapper, placesSidebarShowConnectToServerClosure , -- ** ShowEnterLocation PlacesSidebarShowEnterLocationCallback , PlacesSidebarShowEnterLocationCallbackC , PlacesSidebarShowEnterLocationSignalInfo, afterPlacesSidebarShowEnterLocation , mkPlacesSidebarShowEnterLocationCallback, noPlacesSidebarShowEnterLocationCallback, onPlacesSidebarShowEnterLocation , placesSidebarShowEnterLocationCallbackWrapper, placesSidebarShowEnterLocationClosure , -- ** ShowErrorMessage PlacesSidebarShowErrorMessageCallback , PlacesSidebarShowErrorMessageCallbackC , PlacesSidebarShowErrorMessageSignalInfo , afterPlacesSidebarShowErrorMessage , mkPlacesSidebarShowErrorMessageCallback , noPlacesSidebarShowErrorMessageCallback , onPlacesSidebarShowErrorMessage , placesSidebarShowErrorMessageCallbackWrapper, placesSidebarShowErrorMessageClosure , ) 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.Atk as Atk import qualified GI.GObject as GObject import qualified GI.Gdk as Gdk import qualified GI.Gio as Gio newtype PlacesSidebar = PlacesSidebar (ForeignPtr PlacesSidebar) foreign import ccall "gtk_places_sidebar_get_type" c_gtk_places_sidebar_get_type :: IO GType type instance ParentTypes PlacesSidebar = PlacesSidebarParentTypes type PlacesSidebarParentTypes = '[ScrolledWindow, Bin, Container, Widget, GObject.Object, Atk.ImplementorIface, Buildable] instance GObject PlacesSidebar where gobjectIsInitiallyUnowned _ = True gobjectType _ = c_gtk_places_sidebar_get_type class GObject o => PlacesSidebarK o instance (GObject o, IsDescendantOf PlacesSidebar o) => PlacesSidebarK o toPlacesSidebar :: PlacesSidebarK o => o -> IO PlacesSidebar toPlacesSidebar = unsafeCastTo PlacesSidebar noPlacesSidebar :: Maybe PlacesSidebar noPlacesSidebar = Nothing -- signal PlacesSidebar::drag-action-ask type PlacesSidebarDragActionAskCallback = Int32 -> IO Int32 noPlacesSidebarDragActionAskCallback :: Maybe PlacesSidebarDragActionAskCallback noPlacesSidebarDragActionAskCallback = Nothing type PlacesSidebarDragActionAskCallbackC = Ptr () -> -- object Int32 -> Ptr () -> -- user_data IO Int32 foreign import ccall "wrapper" mkPlacesSidebarDragActionAskCallback :: PlacesSidebarDragActionAskCallbackC -> IO (FunPtr PlacesSidebarDragActionAskCallbackC) placesSidebarDragActionAskClosure :: PlacesSidebarDragActionAskCallback -> IO Closure placesSidebarDragActionAskClosure cb = newCClosure =<< mkPlacesSidebarDragActionAskCallback wrapped where wrapped = placesSidebarDragActionAskCallbackWrapper cb placesSidebarDragActionAskCallbackWrapper :: PlacesSidebarDragActionAskCallback -> Ptr () -> Int32 -> Ptr () -> IO Int32 placesSidebarDragActionAskCallbackWrapper _cb _ actions _ = do result <- _cb actions return result onPlacesSidebarDragActionAsk :: (GObject a, MonadIO m) => a -> PlacesSidebarDragActionAskCallback -> m SignalHandlerId onPlacesSidebarDragActionAsk obj cb = liftIO $ connectPlacesSidebarDragActionAsk obj cb SignalConnectBefore afterPlacesSidebarDragActionAsk :: (GObject a, MonadIO m) => a -> PlacesSidebarDragActionAskCallback -> m SignalHandlerId afterPlacesSidebarDragActionAsk obj cb = connectPlacesSidebarDragActionAsk obj cb SignalConnectAfter connectPlacesSidebarDragActionAsk :: (GObject a, MonadIO m) => a -> PlacesSidebarDragActionAskCallback -> SignalConnectMode -> m SignalHandlerId connectPlacesSidebarDragActionAsk obj cb after = liftIO $ do cb' <- mkPlacesSidebarDragActionAskCallback (placesSidebarDragActionAskCallbackWrapper cb) connectSignalFunPtr obj "drag-action-ask" cb' after -- signal PlacesSidebar::drag-action-requested type PlacesSidebarDragActionRequestedCallback = Gdk.DragContext -> Gio.File -> [Gio.File] -> IO Int32 noPlacesSidebarDragActionRequestedCallback :: Maybe PlacesSidebarDragActionRequestedCallback noPlacesSidebarDragActionRequestedCallback = Nothing type PlacesSidebarDragActionRequestedCallbackC = Ptr () -> -- object Ptr Gdk.DragContext -> Ptr Gio.File -> Ptr (GList (Ptr Gio.File)) -> Ptr () -> -- user_data IO Int32 foreign import ccall "wrapper" mkPlacesSidebarDragActionRequestedCallback :: PlacesSidebarDragActionRequestedCallbackC -> IO (FunPtr PlacesSidebarDragActionRequestedCallbackC) placesSidebarDragActionRequestedClosure :: PlacesSidebarDragActionRequestedCallback -> IO Closure placesSidebarDragActionRequestedClosure cb = newCClosure =<< mkPlacesSidebarDragActionRequestedCallback wrapped where wrapped = placesSidebarDragActionRequestedCallbackWrapper cb placesSidebarDragActionRequestedCallbackWrapper :: PlacesSidebarDragActionRequestedCallback -> Ptr () -> Ptr Gdk.DragContext -> Ptr Gio.File -> Ptr (GList (Ptr Gio.File)) -> Ptr () -> IO Int32 placesSidebarDragActionRequestedCallbackWrapper _cb _ context dest_file source_file_list _ = do context' <- (newObject Gdk.DragContext) context dest_file' <- (newObject Gio.File) dest_file source_file_list' <- unpackGList source_file_list source_file_list'' <- mapM (newObject Gio.File) source_file_list' result <- _cb context' dest_file' source_file_list'' return result onPlacesSidebarDragActionRequested :: (GObject a, MonadIO m) => a -> PlacesSidebarDragActionRequestedCallback -> m SignalHandlerId onPlacesSidebarDragActionRequested obj cb = liftIO $ connectPlacesSidebarDragActionRequested obj cb SignalConnectBefore afterPlacesSidebarDragActionRequested :: (GObject a, MonadIO m) => a -> PlacesSidebarDragActionRequestedCallback -> m SignalHandlerId afterPlacesSidebarDragActionRequested obj cb = connectPlacesSidebarDragActionRequested obj cb SignalConnectAfter connectPlacesSidebarDragActionRequested :: (GObject a, MonadIO m) => a -> PlacesSidebarDragActionRequestedCallback -> SignalConnectMode -> m SignalHandlerId connectPlacesSidebarDragActionRequested obj cb after = liftIO $ do cb' <- mkPlacesSidebarDragActionRequestedCallback (placesSidebarDragActionRequestedCallbackWrapper cb) connectSignalFunPtr obj "drag-action-requested" cb' after -- signal PlacesSidebar::drag-perform-drop type PlacesSidebarDragPerformDropCallback = Gio.File -> [Gio.File] -> Int32 -> IO () noPlacesSidebarDragPerformDropCallback :: Maybe PlacesSidebarDragPerformDropCallback noPlacesSidebarDragPerformDropCallback = Nothing type PlacesSidebarDragPerformDropCallbackC = Ptr () -> -- object Ptr Gio.File -> Ptr (GList (Ptr Gio.File)) -> Int32 -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkPlacesSidebarDragPerformDropCallback :: PlacesSidebarDragPerformDropCallbackC -> IO (FunPtr PlacesSidebarDragPerformDropCallbackC) placesSidebarDragPerformDropClosure :: PlacesSidebarDragPerformDropCallback -> IO Closure placesSidebarDragPerformDropClosure cb = newCClosure =<< mkPlacesSidebarDragPerformDropCallback wrapped where wrapped = placesSidebarDragPerformDropCallbackWrapper cb placesSidebarDragPerformDropCallbackWrapper :: PlacesSidebarDragPerformDropCallback -> Ptr () -> Ptr Gio.File -> Ptr (GList (Ptr Gio.File)) -> Int32 -> Ptr () -> IO () placesSidebarDragPerformDropCallbackWrapper _cb _ dest_file source_file_list action _ = do dest_file' <- (newObject Gio.File) dest_file source_file_list' <- unpackGList source_file_list source_file_list'' <- mapM (newObject Gio.File) source_file_list' _cb dest_file' source_file_list'' action onPlacesSidebarDragPerformDrop :: (GObject a, MonadIO m) => a -> PlacesSidebarDragPerformDropCallback -> m SignalHandlerId onPlacesSidebarDragPerformDrop obj cb = liftIO $ connectPlacesSidebarDragPerformDrop obj cb SignalConnectBefore afterPlacesSidebarDragPerformDrop :: (GObject a, MonadIO m) => a -> PlacesSidebarDragPerformDropCallback -> m SignalHandlerId afterPlacesSidebarDragPerformDrop obj cb = connectPlacesSidebarDragPerformDrop obj cb SignalConnectAfter connectPlacesSidebarDragPerformDrop :: (GObject a, MonadIO m) => a -> PlacesSidebarDragPerformDropCallback -> SignalConnectMode -> m SignalHandlerId connectPlacesSidebarDragPerformDrop obj cb after = liftIO $ do cb' <- mkPlacesSidebarDragPerformDropCallback (placesSidebarDragPerformDropCallbackWrapper cb) connectSignalFunPtr obj "drag-perform-drop" cb' after -- signal PlacesSidebar::open-location type PlacesSidebarOpenLocationCallback = Gio.File -> [PlacesOpenFlags] -> IO () noPlacesSidebarOpenLocationCallback :: Maybe PlacesSidebarOpenLocationCallback noPlacesSidebarOpenLocationCallback = Nothing type PlacesSidebarOpenLocationCallbackC = Ptr () -> -- object Ptr Gio.File -> CUInt -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkPlacesSidebarOpenLocationCallback :: PlacesSidebarOpenLocationCallbackC -> IO (FunPtr PlacesSidebarOpenLocationCallbackC) placesSidebarOpenLocationClosure :: PlacesSidebarOpenLocationCallback -> IO Closure placesSidebarOpenLocationClosure cb = newCClosure =<< mkPlacesSidebarOpenLocationCallback wrapped where wrapped = placesSidebarOpenLocationCallbackWrapper cb placesSidebarOpenLocationCallbackWrapper :: PlacesSidebarOpenLocationCallback -> Ptr () -> Ptr Gio.File -> CUInt -> Ptr () -> IO () placesSidebarOpenLocationCallbackWrapper _cb _ location open_flags _ = do location' <- (newObject Gio.File) location let open_flags' = wordToGFlags open_flags _cb location' open_flags' onPlacesSidebarOpenLocation :: (GObject a, MonadIO m) => a -> PlacesSidebarOpenLocationCallback -> m SignalHandlerId onPlacesSidebarOpenLocation obj cb = liftIO $ connectPlacesSidebarOpenLocation obj cb SignalConnectBefore afterPlacesSidebarOpenLocation :: (GObject a, MonadIO m) => a -> PlacesSidebarOpenLocationCallback -> m SignalHandlerId afterPlacesSidebarOpenLocation obj cb = connectPlacesSidebarOpenLocation obj cb SignalConnectAfter connectPlacesSidebarOpenLocation :: (GObject a, MonadIO m) => a -> PlacesSidebarOpenLocationCallback -> SignalConnectMode -> m SignalHandlerId connectPlacesSidebarOpenLocation obj cb after = liftIO $ do cb' <- mkPlacesSidebarOpenLocationCallback (placesSidebarOpenLocationCallbackWrapper cb) connectSignalFunPtr obj "open-location" cb' after -- signal PlacesSidebar::populate-popup type PlacesSidebarPopulatePopupCallback = Menu -> Maybe Gio.File -> Maybe Gio.Volume -> IO () noPlacesSidebarPopulatePopupCallback :: Maybe PlacesSidebarPopulatePopupCallback noPlacesSidebarPopulatePopupCallback = Nothing type PlacesSidebarPopulatePopupCallbackC = Ptr () -> -- object Ptr Menu -> Ptr Gio.File -> Ptr Gio.Volume -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkPlacesSidebarPopulatePopupCallback :: PlacesSidebarPopulatePopupCallbackC -> IO (FunPtr PlacesSidebarPopulatePopupCallbackC) placesSidebarPopulatePopupClosure :: PlacesSidebarPopulatePopupCallback -> IO Closure placesSidebarPopulatePopupClosure cb = newCClosure =<< mkPlacesSidebarPopulatePopupCallback wrapped where wrapped = placesSidebarPopulatePopupCallbackWrapper cb placesSidebarPopulatePopupCallbackWrapper :: PlacesSidebarPopulatePopupCallback -> Ptr () -> Ptr Menu -> Ptr Gio.File -> Ptr Gio.Volume -> Ptr () -> IO () placesSidebarPopulatePopupCallbackWrapper _cb _ menu selected_item selected_volume _ = do menu' <- (newObject Menu) menu maybeSelected_item <- if selected_item == nullPtr then return Nothing else do selected_item' <- (newObject Gio.File) selected_item return $ Just selected_item' maybeSelected_volume <- if selected_volume == nullPtr then return Nothing else do selected_volume' <- (newObject Gio.Volume) selected_volume return $ Just selected_volume' _cb menu' maybeSelected_item maybeSelected_volume onPlacesSidebarPopulatePopup :: (GObject a, MonadIO m) => a -> PlacesSidebarPopulatePopupCallback -> m SignalHandlerId onPlacesSidebarPopulatePopup obj cb = liftIO $ connectPlacesSidebarPopulatePopup obj cb SignalConnectBefore afterPlacesSidebarPopulatePopup :: (GObject a, MonadIO m) => a -> PlacesSidebarPopulatePopupCallback -> m SignalHandlerId afterPlacesSidebarPopulatePopup obj cb = connectPlacesSidebarPopulatePopup obj cb SignalConnectAfter connectPlacesSidebarPopulatePopup :: (GObject a, MonadIO m) => a -> PlacesSidebarPopulatePopupCallback -> SignalConnectMode -> m SignalHandlerId connectPlacesSidebarPopulatePopup obj cb after = liftIO $ do cb' <- mkPlacesSidebarPopulatePopupCallback (placesSidebarPopulatePopupCallbackWrapper cb) connectSignalFunPtr obj "populate-popup" cb' after -- signal PlacesSidebar::show-connect-to-server type PlacesSidebarShowConnectToServerCallback = IO () noPlacesSidebarShowConnectToServerCallback :: Maybe PlacesSidebarShowConnectToServerCallback noPlacesSidebarShowConnectToServerCallback = Nothing type PlacesSidebarShowConnectToServerCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkPlacesSidebarShowConnectToServerCallback :: PlacesSidebarShowConnectToServerCallbackC -> IO (FunPtr PlacesSidebarShowConnectToServerCallbackC) placesSidebarShowConnectToServerClosure :: PlacesSidebarShowConnectToServerCallback -> IO Closure placesSidebarShowConnectToServerClosure cb = newCClosure =<< mkPlacesSidebarShowConnectToServerCallback wrapped where wrapped = placesSidebarShowConnectToServerCallbackWrapper cb placesSidebarShowConnectToServerCallbackWrapper :: PlacesSidebarShowConnectToServerCallback -> Ptr () -> Ptr () -> IO () placesSidebarShowConnectToServerCallbackWrapper _cb _ _ = do _cb onPlacesSidebarShowConnectToServer :: (GObject a, MonadIO m) => a -> PlacesSidebarShowConnectToServerCallback -> m SignalHandlerId onPlacesSidebarShowConnectToServer obj cb = liftIO $ connectPlacesSidebarShowConnectToServer obj cb SignalConnectBefore afterPlacesSidebarShowConnectToServer :: (GObject a, MonadIO m) => a -> PlacesSidebarShowConnectToServerCallback -> m SignalHandlerId afterPlacesSidebarShowConnectToServer obj cb = connectPlacesSidebarShowConnectToServer obj cb SignalConnectAfter connectPlacesSidebarShowConnectToServer :: (GObject a, MonadIO m) => a -> PlacesSidebarShowConnectToServerCallback -> SignalConnectMode -> m SignalHandlerId connectPlacesSidebarShowConnectToServer obj cb after = liftIO $ do cb' <- mkPlacesSidebarShowConnectToServerCallback (placesSidebarShowConnectToServerCallbackWrapper cb) connectSignalFunPtr obj "show-connect-to-server" cb' after -- signal PlacesSidebar::show-enter-location type PlacesSidebarShowEnterLocationCallback = IO () noPlacesSidebarShowEnterLocationCallback :: Maybe PlacesSidebarShowEnterLocationCallback noPlacesSidebarShowEnterLocationCallback = Nothing type PlacesSidebarShowEnterLocationCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkPlacesSidebarShowEnterLocationCallback :: PlacesSidebarShowEnterLocationCallbackC -> IO (FunPtr PlacesSidebarShowEnterLocationCallbackC) placesSidebarShowEnterLocationClosure :: PlacesSidebarShowEnterLocationCallback -> IO Closure placesSidebarShowEnterLocationClosure cb = newCClosure =<< mkPlacesSidebarShowEnterLocationCallback wrapped where wrapped = placesSidebarShowEnterLocationCallbackWrapper cb placesSidebarShowEnterLocationCallbackWrapper :: PlacesSidebarShowEnterLocationCallback -> Ptr () -> Ptr () -> IO () placesSidebarShowEnterLocationCallbackWrapper _cb _ _ = do _cb onPlacesSidebarShowEnterLocation :: (GObject a, MonadIO m) => a -> PlacesSidebarShowEnterLocationCallback -> m SignalHandlerId onPlacesSidebarShowEnterLocation obj cb = liftIO $ connectPlacesSidebarShowEnterLocation obj cb SignalConnectBefore afterPlacesSidebarShowEnterLocation :: (GObject a, MonadIO m) => a -> PlacesSidebarShowEnterLocationCallback -> m SignalHandlerId afterPlacesSidebarShowEnterLocation obj cb = connectPlacesSidebarShowEnterLocation obj cb SignalConnectAfter connectPlacesSidebarShowEnterLocation :: (GObject a, MonadIO m) => a -> PlacesSidebarShowEnterLocationCallback -> SignalConnectMode -> m SignalHandlerId connectPlacesSidebarShowEnterLocation obj cb after = liftIO $ do cb' <- mkPlacesSidebarShowEnterLocationCallback (placesSidebarShowEnterLocationCallbackWrapper cb) connectSignalFunPtr obj "show-enter-location" cb' after -- signal PlacesSidebar::show-error-message type PlacesSidebarShowErrorMessageCallback = T.Text -> T.Text -> IO () noPlacesSidebarShowErrorMessageCallback :: Maybe PlacesSidebarShowErrorMessageCallback noPlacesSidebarShowErrorMessageCallback = Nothing type PlacesSidebarShowErrorMessageCallbackC = Ptr () -> -- object CString -> CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkPlacesSidebarShowErrorMessageCallback :: PlacesSidebarShowErrorMessageCallbackC -> IO (FunPtr PlacesSidebarShowErrorMessageCallbackC) placesSidebarShowErrorMessageClosure :: PlacesSidebarShowErrorMessageCallback -> IO Closure placesSidebarShowErrorMessageClosure cb = newCClosure =<< mkPlacesSidebarShowErrorMessageCallback wrapped where wrapped = placesSidebarShowErrorMessageCallbackWrapper cb placesSidebarShowErrorMessageCallbackWrapper :: PlacesSidebarShowErrorMessageCallback -> Ptr () -> CString -> CString -> Ptr () -> IO () placesSidebarShowErrorMessageCallbackWrapper _cb _ primary secondary _ = do primary' <- cstringToText primary secondary' <- cstringToText secondary _cb primary' secondary' onPlacesSidebarShowErrorMessage :: (GObject a, MonadIO m) => a -> PlacesSidebarShowErrorMessageCallback -> m SignalHandlerId onPlacesSidebarShowErrorMessage obj cb = liftIO $ connectPlacesSidebarShowErrorMessage obj cb SignalConnectBefore afterPlacesSidebarShowErrorMessage :: (GObject a, MonadIO m) => a -> PlacesSidebarShowErrorMessageCallback -> m SignalHandlerId afterPlacesSidebarShowErrorMessage obj cb = connectPlacesSidebarShowErrorMessage obj cb SignalConnectAfter connectPlacesSidebarShowErrorMessage :: (GObject a, MonadIO m) => a -> PlacesSidebarShowErrorMessageCallback -> SignalConnectMode -> m SignalHandlerId connectPlacesSidebarShowErrorMessage obj cb after = liftIO $ do cb' <- mkPlacesSidebarShowErrorMessageCallback (placesSidebarShowErrorMessageCallbackWrapper cb) connectSignalFunPtr obj "show-error-message" cb' after -- VVV Prop "local-only" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarLocalOnly :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarLocalOnly obj = liftIO $ getObjectPropertyBool obj "local-only" setPlacesSidebarLocalOnly :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarLocalOnly obj val = liftIO $ setObjectPropertyBool obj "local-only" val constructPlacesSidebarLocalOnly :: Bool -> IO ([Char], GValue) constructPlacesSidebarLocalOnly val = constructObjectPropertyBool "local-only" val data PlacesSidebarLocalOnlyPropertyInfo instance AttrInfo PlacesSidebarLocalOnlyPropertyInfo where type AttrAllowedOps PlacesSidebarLocalOnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarLocalOnlyPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarLocalOnlyPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarLocalOnlyPropertyInfo = Bool type AttrLabel PlacesSidebarLocalOnlyPropertyInfo = "PlacesSidebar::local-only" attrGet _ = getPlacesSidebarLocalOnly attrSet _ = setPlacesSidebarLocalOnly attrConstruct _ = constructPlacesSidebarLocalOnly -- VVV Prop "location" -- Type: TInterface "Gio" "File" -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarLocation :: (MonadIO m, PlacesSidebarK o) => o -> m Gio.File getPlacesSidebarLocation obj = liftIO $ getObjectPropertyObject obj "location" Gio.File setPlacesSidebarLocation :: (MonadIO m, PlacesSidebarK o, Gio.FileK a) => o -> a -> m () setPlacesSidebarLocation obj val = liftIO $ setObjectPropertyObject obj "location" val constructPlacesSidebarLocation :: (Gio.FileK a) => a -> IO ([Char], GValue) constructPlacesSidebarLocation val = constructObjectPropertyObject "location" val data PlacesSidebarLocationPropertyInfo instance AttrInfo PlacesSidebarLocationPropertyInfo where type AttrAllowedOps PlacesSidebarLocationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarLocationPropertyInfo = Gio.FileK type AttrBaseTypeConstraint PlacesSidebarLocationPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarLocationPropertyInfo = Gio.File type AttrLabel PlacesSidebarLocationPropertyInfo = "PlacesSidebar::location" attrGet _ = getPlacesSidebarLocation attrSet _ = setPlacesSidebarLocation attrConstruct _ = constructPlacesSidebarLocation -- VVV Prop "open-flags" -- Type: TInterface "Gtk" "PlacesOpenFlags" -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarOpenFlags :: (MonadIO m, PlacesSidebarK o) => o -> m [PlacesOpenFlags] getPlacesSidebarOpenFlags obj = liftIO $ getObjectPropertyFlags obj "open-flags" setPlacesSidebarOpenFlags :: (MonadIO m, PlacesSidebarK o) => o -> [PlacesOpenFlags] -> m () setPlacesSidebarOpenFlags obj val = liftIO $ setObjectPropertyFlags obj "open-flags" val constructPlacesSidebarOpenFlags :: [PlacesOpenFlags] -> IO ([Char], GValue) constructPlacesSidebarOpenFlags val = constructObjectPropertyFlags "open-flags" val data PlacesSidebarOpenFlagsPropertyInfo instance AttrInfo PlacesSidebarOpenFlagsPropertyInfo where type AttrAllowedOps PlacesSidebarOpenFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarOpenFlagsPropertyInfo = (~) [PlacesOpenFlags] type AttrBaseTypeConstraint PlacesSidebarOpenFlagsPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarOpenFlagsPropertyInfo = [PlacesOpenFlags] type AttrLabel PlacesSidebarOpenFlagsPropertyInfo = "PlacesSidebar::open-flags" attrGet _ = getPlacesSidebarOpenFlags attrSet _ = setPlacesSidebarOpenFlags attrConstruct _ = constructPlacesSidebarOpenFlags -- VVV Prop "show-connect-to-server" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarShowConnectToServer :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarShowConnectToServer obj = liftIO $ getObjectPropertyBool obj "show-connect-to-server" setPlacesSidebarShowConnectToServer :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarShowConnectToServer obj val = liftIO $ setObjectPropertyBool obj "show-connect-to-server" val constructPlacesSidebarShowConnectToServer :: Bool -> IO ([Char], GValue) constructPlacesSidebarShowConnectToServer val = constructObjectPropertyBool "show-connect-to-server" val data PlacesSidebarShowConnectToServerPropertyInfo instance AttrInfo PlacesSidebarShowConnectToServerPropertyInfo where type AttrAllowedOps PlacesSidebarShowConnectToServerPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarShowConnectToServerPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarShowConnectToServerPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarShowConnectToServerPropertyInfo = Bool type AttrLabel PlacesSidebarShowConnectToServerPropertyInfo = "PlacesSidebar::show-connect-to-server" attrGet _ = getPlacesSidebarShowConnectToServer attrSet _ = setPlacesSidebarShowConnectToServer attrConstruct _ = constructPlacesSidebarShowConnectToServer -- VVV Prop "show-desktop" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarShowDesktop :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarShowDesktop obj = liftIO $ getObjectPropertyBool obj "show-desktop" setPlacesSidebarShowDesktop :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarShowDesktop obj val = liftIO $ setObjectPropertyBool obj "show-desktop" val constructPlacesSidebarShowDesktop :: Bool -> IO ([Char], GValue) constructPlacesSidebarShowDesktop val = constructObjectPropertyBool "show-desktop" val data PlacesSidebarShowDesktopPropertyInfo instance AttrInfo PlacesSidebarShowDesktopPropertyInfo where type AttrAllowedOps PlacesSidebarShowDesktopPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarShowDesktopPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarShowDesktopPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarShowDesktopPropertyInfo = Bool type AttrLabel PlacesSidebarShowDesktopPropertyInfo = "PlacesSidebar::show-desktop" attrGet _ = getPlacesSidebarShowDesktop attrSet _ = setPlacesSidebarShowDesktop attrConstruct _ = constructPlacesSidebarShowDesktop -- VVV Prop "show-enter-location" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarShowEnterLocation :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarShowEnterLocation obj = liftIO $ getObjectPropertyBool obj "show-enter-location" setPlacesSidebarShowEnterLocation :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarShowEnterLocation obj val = liftIO $ setObjectPropertyBool obj "show-enter-location" val constructPlacesSidebarShowEnterLocation :: Bool -> IO ([Char], GValue) constructPlacesSidebarShowEnterLocation val = constructObjectPropertyBool "show-enter-location" val data PlacesSidebarShowEnterLocationPropertyInfo instance AttrInfo PlacesSidebarShowEnterLocationPropertyInfo where type AttrAllowedOps PlacesSidebarShowEnterLocationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarShowEnterLocationPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarShowEnterLocationPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarShowEnterLocationPropertyInfo = Bool type AttrLabel PlacesSidebarShowEnterLocationPropertyInfo = "PlacesSidebar::show-enter-location" attrGet _ = getPlacesSidebarShowEnterLocation attrSet _ = setPlacesSidebarShowEnterLocation attrConstruct _ = constructPlacesSidebarShowEnterLocation type instance AttributeList PlacesSidebar = PlacesSidebarAttributeList type PlacesSidebarAttributeList = ('[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("hadjustment", ScrolledWindowHadjustmentPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hscrollbar-policy", ScrolledWindowHscrollbarPolicyPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("kinetic-scrolling", ScrolledWindowKineticScrollingPropertyInfo), '("local-only", PlacesSidebarLocalOnlyPropertyInfo), '("location", PlacesSidebarLocationPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("min-content-height", ScrolledWindowMinContentHeightPropertyInfo), '("min-content-width", ScrolledWindowMinContentWidthPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("open-flags", PlacesSidebarOpenFlagsPropertyInfo), '("overlay-scrolling", ScrolledWindowOverlayScrollingPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", ScrolledWindowShadowTypePropertyInfo), '("show-connect-to-server", PlacesSidebarShowConnectToServerPropertyInfo), '("show-desktop", PlacesSidebarShowDesktopPropertyInfo), '("show-enter-location", PlacesSidebarShowEnterLocationPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("vadjustment", ScrolledWindowVadjustmentPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("vscrollbar-policy", ScrolledWindowVscrollbarPolicyPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-placement", ScrolledWindowWindowPlacementPropertyInfo), '("window-placement-set", ScrolledWindowWindowPlacementSetPropertyInfo)] :: [(Symbol, *)]) data PlacesSidebarDragActionAskSignalInfo instance SignalInfo PlacesSidebarDragActionAskSignalInfo where type HaskellCallbackType PlacesSidebarDragActionAskSignalInfo = PlacesSidebarDragActionAskCallback connectSignal _ = connectPlacesSidebarDragActionAsk data PlacesSidebarDragActionRequestedSignalInfo instance SignalInfo PlacesSidebarDragActionRequestedSignalInfo where type HaskellCallbackType PlacesSidebarDragActionRequestedSignalInfo = PlacesSidebarDragActionRequestedCallback connectSignal _ = connectPlacesSidebarDragActionRequested data PlacesSidebarDragPerformDropSignalInfo instance SignalInfo PlacesSidebarDragPerformDropSignalInfo where type HaskellCallbackType PlacesSidebarDragPerformDropSignalInfo = PlacesSidebarDragPerformDropCallback connectSignal _ = connectPlacesSidebarDragPerformDrop data PlacesSidebarOpenLocationSignalInfo instance SignalInfo PlacesSidebarOpenLocationSignalInfo where type HaskellCallbackType PlacesSidebarOpenLocationSignalInfo = PlacesSidebarOpenLocationCallback connectSignal _ = connectPlacesSidebarOpenLocation data PlacesSidebarPopulatePopupSignalInfo instance SignalInfo PlacesSidebarPopulatePopupSignalInfo where type HaskellCallbackType PlacesSidebarPopulatePopupSignalInfo = PlacesSidebarPopulatePopupCallback connectSignal _ = connectPlacesSidebarPopulatePopup data PlacesSidebarShowConnectToServerSignalInfo instance SignalInfo PlacesSidebarShowConnectToServerSignalInfo where type HaskellCallbackType PlacesSidebarShowConnectToServerSignalInfo = PlacesSidebarShowConnectToServerCallback connectSignal _ = connectPlacesSidebarShowConnectToServer data PlacesSidebarShowEnterLocationSignalInfo instance SignalInfo PlacesSidebarShowEnterLocationSignalInfo where type HaskellCallbackType PlacesSidebarShowEnterLocationSignalInfo = PlacesSidebarShowEnterLocationCallback connectSignal _ = connectPlacesSidebarShowEnterLocation data PlacesSidebarShowErrorMessageSignalInfo instance SignalInfo PlacesSidebarShowErrorMessageSignalInfo where type HaskellCallbackType PlacesSidebarShowErrorMessageSignalInfo = PlacesSidebarShowErrorMessageCallback connectSignal _ = connectPlacesSidebarShowErrorMessage type instance SignalList PlacesSidebar = PlacesSidebarSignalList type PlacesSidebarSignalList = ('[ '("accel-closures-changed", WidgetAccelClosuresChangedSignalInfo), '("add", ContainerAddSignalInfo), '("button-press-event", WidgetButtonPressEventSignalInfo), '("button-release-event", WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", WidgetCanActivateAccelSignalInfo), '("check-resize", ContainerCheckResizeSignalInfo), '("child-notify", WidgetChildNotifySignalInfo), '("composited-changed", WidgetCompositedChangedSignalInfo), '("configure-event", WidgetConfigureEventSignalInfo), '("damage-event", WidgetDamageEventSignalInfo), '("delete-event", WidgetDeleteEventSignalInfo), '("destroy", WidgetDestroySignalInfo), '("destroy-event", WidgetDestroyEventSignalInfo), '("direction-changed", WidgetDirectionChangedSignalInfo), '("drag-action-ask", PlacesSidebarDragActionAskSignalInfo), '("drag-action-requested", PlacesSidebarDragActionRequestedSignalInfo), '("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), '("drag-perform-drop", PlacesSidebarDragPerformDropSignalInfo), '("draw", WidgetDrawSignalInfo), '("edge-overshot", ScrolledWindowEdgeOvershotSignalInfo), '("edge-reached", ScrolledWindowEdgeReachedSignalInfo), '("enter-notify-event", WidgetEnterNotifyEventSignalInfo), '("event", WidgetEventSignalInfo), '("event-after", WidgetEventAfterSignalInfo), '("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), '("move-focus-out", ScrolledWindowMoveFocusOutSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("open-location", PlacesSidebarOpenLocationSignalInfo), '("parent-set", WidgetParentSetSignalInfo), '("populate-popup", PlacesSidebarPopulatePopupSignalInfo), '("popup-menu", WidgetPopupMenuSignalInfo), '("property-notify-event", WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", WidgetProximityInEventSignalInfo), '("proximity-out-event", WidgetProximityOutEventSignalInfo), '("query-tooltip", WidgetQueryTooltipSignalInfo), '("realize", WidgetRealizeSignalInfo), '("remove", ContainerRemoveSignalInfo), '("screen-changed", WidgetScreenChangedSignalInfo), '("scroll-child", ScrolledWindowScrollChildSignalInfo), '("scroll-event", WidgetScrollEventSignalInfo), '("selection-clear-event", WidgetSelectionClearEventSignalInfo), '("selection-get", WidgetSelectionGetSignalInfo), '("selection-notify-event", WidgetSelectionNotifyEventSignalInfo), '("selection-received", WidgetSelectionReceivedSignalInfo), '("selection-request-event", WidgetSelectionRequestEventSignalInfo), '("set-focus-child", ContainerSetFocusChildSignalInfo), '("show", WidgetShowSignalInfo), '("show-connect-to-server", PlacesSidebarShowConnectToServerSignalInfo), '("show-enter-location", PlacesSidebarShowEnterLocationSignalInfo), '("show-error-message", PlacesSidebarShowErrorMessageSignalInfo), '("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), '("visibility-notify-event", WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", WidgetWindowStateEventSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)]) -- method PlacesSidebar::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gtk" "PlacesSidebar" -- throws : False -- Skip return : False foreign import ccall "gtk_places_sidebar_new" gtk_places_sidebar_new :: IO (Ptr PlacesSidebar) placesSidebarNew :: (MonadIO m) => m PlacesSidebar placesSidebarNew = liftIO $ do result <- gtk_places_sidebar_new checkUnexpectedReturnNULL "gtk_places_sidebar_new" result result' <- (newObject PlacesSidebar) result return result' -- method PlacesSidebar::add_shortcut -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", 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_places_sidebar_add_shortcut" gtk_places_sidebar_add_shortcut :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" Ptr Gio.File -> -- location : TInterface "Gio" "File" IO () placesSidebarAddShortcut :: (MonadIO m, PlacesSidebarK a, Gio.FileK b) => a -> -- _obj b -> -- location m () placesSidebarAddShortcut _obj location = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let location' = unsafeManagedPtrCastPtr location gtk_places_sidebar_add_shortcut _obj' location' touchManagedPtr _obj touchManagedPtr location return () -- method PlacesSidebar::get_local_only -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_places_sidebar_get_local_only" gtk_places_sidebar_get_local_only :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" IO CInt placesSidebarGetLocalOnly :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj m Bool placesSidebarGetLocalOnly _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_places_sidebar_get_local_only _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method PlacesSidebar::get_location -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", 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_places_sidebar_get_location" gtk_places_sidebar_get_location :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" IO (Ptr Gio.File) placesSidebarGetLocation :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj m Gio.File placesSidebarGetLocation _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_places_sidebar_get_location _obj' checkUnexpectedReturnNULL "gtk_places_sidebar_get_location" result result' <- (wrapObject Gio.File) result touchManagedPtr _obj return result' -- method PlacesSidebar::get_nth_bookmark -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TInt32, 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_places_sidebar_get_nth_bookmark" gtk_places_sidebar_get_nth_bookmark :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" Int32 -> -- n : TBasicType TInt32 IO (Ptr Gio.File) placesSidebarGetNthBookmark :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj Int32 -> -- n m Gio.File placesSidebarGetNthBookmark _obj n = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_places_sidebar_get_nth_bookmark _obj' n checkUnexpectedReturnNULL "gtk_places_sidebar_get_nth_bookmark" result result' <- (wrapObject Gio.File) result touchManagedPtr _obj return result' -- method PlacesSidebar::get_open_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gtk" "PlacesOpenFlags" -- throws : False -- Skip return : False foreign import ccall "gtk_places_sidebar_get_open_flags" gtk_places_sidebar_get_open_flags :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" IO CUInt placesSidebarGetOpenFlags :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj m [PlacesOpenFlags] placesSidebarGetOpenFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_places_sidebar_get_open_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method PlacesSidebar::get_show_connect_to_server -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_places_sidebar_get_show_connect_to_server" gtk_places_sidebar_get_show_connect_to_server :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" IO CInt placesSidebarGetShowConnectToServer :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj m Bool placesSidebarGetShowConnectToServer _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_places_sidebar_get_show_connect_to_server _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method PlacesSidebar::get_show_desktop -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_places_sidebar_get_show_desktop" gtk_places_sidebar_get_show_desktop :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" IO CInt placesSidebarGetShowDesktop :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj m Bool placesSidebarGetShowDesktop _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_places_sidebar_get_show_desktop _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method PlacesSidebar::get_show_enter_location -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_places_sidebar_get_show_enter_location" gtk_places_sidebar_get_show_enter_location :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" IO CInt placesSidebarGetShowEnterLocation :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj m Bool placesSidebarGetShowEnterLocation _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_places_sidebar_get_show_enter_location _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method PlacesSidebar::list_shortcuts -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", 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_places_sidebar_list_shortcuts" gtk_places_sidebar_list_shortcuts :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" IO (Ptr (GSList (Ptr Gio.File))) placesSidebarListShortcuts :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj m [Gio.File] placesSidebarListShortcuts _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_places_sidebar_list_shortcuts _obj' checkUnexpectedReturnNULL "gtk_places_sidebar_list_shortcuts" result result' <- unpackGSList result result'' <- mapM (wrapObject Gio.File) result' g_slist_free result touchManagedPtr _obj return result'' -- method PlacesSidebar::remove_shortcut -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", 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_places_sidebar_remove_shortcut" gtk_places_sidebar_remove_shortcut :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" Ptr Gio.File -> -- location : TInterface "Gio" "File" IO () placesSidebarRemoveShortcut :: (MonadIO m, PlacesSidebarK a, Gio.FileK b) => a -> -- _obj b -> -- location m () placesSidebarRemoveShortcut _obj location = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let location' = unsafeManagedPtrCastPtr location gtk_places_sidebar_remove_shortcut _obj' location' touchManagedPtr _obj touchManagedPtr location return () -- method PlacesSidebar::set_local_only -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", 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" "PlacesSidebar", 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_places_sidebar_set_local_only" gtk_places_sidebar_set_local_only :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" CInt -> -- local_only : TBasicType TBoolean IO () placesSidebarSetLocalOnly :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj Bool -> -- local_only m () placesSidebarSetLocalOnly _obj local_only = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let local_only' = (fromIntegral . fromEnum) local_only gtk_places_sidebar_set_local_only _obj' local_only' touchManagedPtr _obj return () -- method PlacesSidebar::set_location -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_places_sidebar_set_location" gtk_places_sidebar_set_location :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" Ptr Gio.File -> -- location : TInterface "Gio" "File" IO () placesSidebarSetLocation :: (MonadIO m, PlacesSidebarK a, Gio.FileK b) => a -> -- _obj Maybe (b) -> -- location m () placesSidebarSetLocation _obj location = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLocation <- case location of Nothing -> return nullPtr Just jLocation -> do let jLocation' = unsafeManagedPtrCastPtr jLocation return jLocation' gtk_places_sidebar_set_location _obj' maybeLocation touchManagedPtr _obj whenJust location touchManagedPtr return () -- method PlacesSidebar::set_open_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gtk" "PlacesOpenFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gtk" "PlacesOpenFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_places_sidebar_set_open_flags" gtk_places_sidebar_set_open_flags :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" CUInt -> -- flags : TInterface "Gtk" "PlacesOpenFlags" IO () placesSidebarSetOpenFlags :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj [PlacesOpenFlags] -> -- flags m () placesSidebarSetOpenFlags _obj flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags gtk_places_sidebar_set_open_flags _obj' flags' touchManagedPtr _obj return () -- method PlacesSidebar::set_show_connect_to_server -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_connect_to_server", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_connect_to_server", 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_places_sidebar_set_show_connect_to_server" gtk_places_sidebar_set_show_connect_to_server :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" CInt -> -- show_connect_to_server : TBasicType TBoolean IO () placesSidebarSetShowConnectToServer :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj Bool -> -- show_connect_to_server m () placesSidebarSetShowConnectToServer _obj show_connect_to_server = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let show_connect_to_server' = (fromIntegral . fromEnum) show_connect_to_server gtk_places_sidebar_set_show_connect_to_server _obj' show_connect_to_server' touchManagedPtr _obj return () -- method PlacesSidebar::set_show_desktop -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_desktop", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_desktop", 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_places_sidebar_set_show_desktop" gtk_places_sidebar_set_show_desktop :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" CInt -> -- show_desktop : TBasicType TBoolean IO () placesSidebarSetShowDesktop :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj Bool -> -- show_desktop m () placesSidebarSetShowDesktop _obj show_desktop = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let show_desktop' = (fromIntegral . fromEnum) show_desktop gtk_places_sidebar_set_show_desktop _obj' show_desktop' touchManagedPtr _obj return () -- method PlacesSidebar::set_show_enter_location -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_enter_location", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_enter_location", 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_places_sidebar_set_show_enter_location" gtk_places_sidebar_set_show_enter_location :: Ptr PlacesSidebar -> -- _obj : TInterface "Gtk" "PlacesSidebar" CInt -> -- show_enter_location : TBasicType TBoolean IO () placesSidebarSetShowEnterLocation :: (MonadIO m, PlacesSidebarK a) => a -> -- _obj Bool -> -- show_enter_location m () placesSidebarSetShowEnterLocation _obj show_enter_location = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let show_enter_location' = (fromIntegral . fromEnum) show_enter_location gtk_places_sidebar_set_show_enter_location _obj' show_enter_location' touchManagedPtr _obj return ()